	PROGRAM PROPREP
C	*************** 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C
C                                                                             C
C	Retrive data from ascii data files and rearrange the intensities,     C
C	sorted by detectors.                                                  C
C                                                                             C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C
C extensively revised B. Toby, J. Stalick 12/6/95
C propogate monitor preset
C
      IMPLICIT      none
      integer i,j,nargs,nfiles,ln,k,nout,iin
	integer k1,k2,k3
      character*50 arg
      character*20 files(50)
	integer droplist(32)/32*0/
      integer lench
      integer iargc
      logical sumflag, keepflag, errorflag, keepone, pipeflag,
	1  filterflag,dropflag,cutflag
	real cutval
C maximum number of points/detector
	INTEGER MAX_DATA
	PARAMETER (MAX_DATA=1100)
C
	CHARACTER*4   mtyp
	CHARACTER*5   mono
	CHARACTER*3   dtyp
	CHARACTER*11  datum
	CHARACTER*12  filename, outfile, filenam2
C	CHARACTER*28  date
	CHARACTER*50  label, dummy
	CHARACTER*90  line, linein ! allow for lines > 80 chars
	integer       iline
	INTEGER*4     idata(MAX_DATA, 32), idata2
	INTEGER*4     ang1, ang2, dang, ival
	INTEGER*4     typ, ipram(5),npts, coll(4), mos(3), scl
	INTEGER*4     i1, j1, m, npts2, mpre, mpre2
	REAL*4	      mon, mon2, wl, tmp, itmp, hf
	REAL*4 	      delta, scale(32), offset(32)
	REAL*4	      abeg(2), ainc(2), aend(2)
	REAL*4	      abeg2(2),ainc2(2)
	REAL a4,a4t,cmin,cmax,tmin,tmax,tavg,t
	mpre2 = 0
	mon2 = 0.0
C get commandline options--------------------------------------------------
      nargs =  iargc()
	dropflag = .false.
      sumflag = .false.
      keepflag = .false.
      cutflag = .false.
      errorflag = .false.
      keepone = .false.
      pipeflag = .false.
      filterflag = .false.
      nfiles = 0
      do I=1,nargs
         call getarg(I,arg)
         ln = lench(arg) 
C is this a flag?
         if (arg(1:1) .eq. '-') then
            do j=2,ln
               if (arg(j:j) .eq. 's' .or. arg(j:j) .eq. 'S') then
                  sumflag = .true.
               elseif (arg(j:j) .eq. 'k' .or. arg(j:j) .eq. 'K') then
                  keepflag = .true.
		  cutval = 0
               elseif (arg(j:j) .eq. '1') then
                  keepone = .true.
               elseif (arg(j:j) .eq. 'p' .or. arg(j:j) .eq. 'P') then
                  pipeflag = .true.
		  cutval = 0
               elseif (arg(j:j) .eq. 'f' .or. arg(j:j) .eq. 'F') then
                  filterflag = .true.
		  pipeflag = .true.
		  cutval = 0
               elseif (arg(j:j) .eq. 'd' .or. arg(j:j) .eq. 'D') then
                  dropflag = .true.
		  read (arg(J+1:),*,end=323) droplist
		  goto 323
               elseif (arg(j:j) .eq. 'c' .or. arg(j:j) .eq. 'C') then
                  cutflag = .true.
		  read (arg(J+1:),*,end=323) cutval
		  goto 323
               else
                  write(0,'(/,5x,2a,/)')
     $                 'Invalid command line flag: -',arg(j:j)
                  nargs = 0
                  goto 100
               endif
            enddo
 323	    continue
         else
C remove the .bt1, if present
            if (arg(ln-3:ln) .eq. '.bt1') then 
               ln = ln - 4
            endif
C is this a valid file?
            open (unit=1,file=arg(1:ln)//'.bt1',status='old',
     $        iostat=j)
            if (j .ne. 0) then
               write(0,'(/,5x,2a)') 'Error opening file ',
     $              arg(1:ln)//'.bt1'
               errorflag = .true.
            else
               nfiles = nfiles + 1
               if (nfiles .gt. 50) then
                  write(0,*)
     $              'Sorry, this program can only process 50 files'
                  stop
               endif
               files(nfiles) = arg(:ln)
            endif
            close(unit=1)
         endif
      enddo
      if (nfiles .eq. 1 .and. sumflag) then
         write (0,*) 'Only 1 file to process, ignoring -s flag'
         sumflag = .false.
      endif
	if (nfiles .ne. 0 .and. filterflag) then
	   write (0,*) 'You cannot specify -f and a input file'
	   filterflag = .false.
	   nfiles = 0
	elseif (filterflag) then
	   nfiles = 1
	endif
	if (keepflag .and. cutflag) then
	   write (0,*) 'You cannot specify -c and -k together'
	   nfiles = 0
	endif
 100	if (nargs .le. 0 .or. errorflag .or. nfiles .le. 0) then
	   write(0,'(/,1x,a)') 'Usage:'
	   write(0,'(5x,a)')
	1	'proprep [-s] [-k] [-1] [-p] [-dx,y] [-cx.x] '
	1	//'file1[.bt1] [file2[.bt1]] ...',
	2	'proprep -f [-k] [-1] [-dx,y] [-cx.x] '//
	3	'< file1.bt1 > file1.raw'
	   write(0,'(9x,2a)') '-s: ',
	1 'sum multiple files [default: process each file independently'
	   write(0,'(9x,2a)')
	1	'-p: write .raw output to stdout rather than file'
	   write(0,'(9x,2a)')
	1	'-f: run as filter: read from stdin and write to stdout'
	   write(0,'(9x,2a)') '-k: keep all data (same as -c0.0)'
	   write(0,'(9x,2a)') '-cx.x: ',
	1	'cut data below x.x degrees in detectors 1,2,3'
	   write(0,'(9x,3a)') '-1: ',
	1 'keep all data from detector 1 & cut data from detectors 2,3'
	   write(0,'(9x,3a,/)') '-dx,y,z...: ',
	1	'drop all data from detectors x, y and z'
	   stop
	endif
C done getting commandline options-----------------------------------------

C status messages
	if (.not. (pipeflag .or. keepflag .or. cutflag)) then
	   write(6,'(A,$)') ' Enter a cutoff value for dropping data [3]: '
	   read(5,'(A)') label
	   if (label .eq. ' ') then
	      cutval = 3.0
	   else
	      read(label,*) cutval
	   endif
	elseif (.not. cutflag) then
	   cutval = 3.0
	endif
	if (sumflag) write (0,'(6A)') 'Adding files: ',
	1    (files(i)(:lench(files(i))+1),i=1,nfiles)
	if (keepflag) then
	   write (0,'(A)') 'Writing all data to file'
	elseif (keepone .and. .not. keepflag) then
	   write (0,'(A,f5.1,a)') 'Dropping data <',cutval
	1	,' deg. in detectors 2-3'
	else
	   write (0,'(A,f5.1,a)') 'Dropping data <',cutval
	1	,' deg. in detectors 1-3'
	endif
	if (dropflag) then
	   write (0,'(A)') 'Dropping detectors:'
	   do 321 i=1,32
	      do j=1,32
		 if (droplist(j) .eq. i) then
		    write (0,*) '   ',i
		    goto 321
		 endif
	      enddo
 321	   continue
	endif
	do i=1,nfiles
 	   if ((i .eq. 1 .or. .not. sumflag) .and. .not. pipeflag) then
C open output file
	      nout = 1
	      WRITE (0,'(2a)') ' Creating ',outfile(:lench(outfile))
	      outfile = files(i)(:lench(files(i))) // '.raw'
	      OPEN (UNIT=nout, FILE= outfile, STATUS= 'NEW', iostat=j)
	      if (j .ne. 0) then
		 WRITE(0,'(3a)') '  ***ERROR***  Unable to create ',
	1	      outfile(:lench(outfile)),
	2	      ' Does it already exist?'
		 stop
	      endif
	   elseif (pipeflag) then
	      WRITE (0,'(a)') ' Sending output to stdout'
	      nout = 6
	   endif
C       open the input file
	   if (.not. filterflag) then
	      iin = 2
	      filename = files(i)(:lench(files(i))) // '.bt1'
	      write(0,*) 'Opening file ',filename(:lench(filename))
	      OPEN (UNIT=2, FILE= filename, STATUS= 'OLD',
	1	   iostat=j)
	      if (j .ne. 0) then
		 write(0,'(/,5x,2a)') 'Error opening file ',
	1	      files(i)(:lench(files(i))) // '.bt1'
		 stop
	      endif
	   else
	      filename = 'stdin'
	      iin = 5
	   endif
C-----------------------COPY AND TRANSPOSE INPUTFILE ------------------------
	   if (i .eq. 1 .or. .not. sumflag) then
	      READ (iin,
     $     '(1x,a12,3x,a11,1x,i2,3i4,2i2,f9.0,i5,3x,a4,1x,i5,3x,a3)')
	1    filenam2, datum, typ, ipram, mon, mpre, mtyp, npts, dtyp
! test the number of points
           if (npts .gt. MAX_DATA) then
              write (0,*) 'File: ',filename(:lench(filename))
     $             ,' contains too many points (',npts,')'
              write (0,*) 'Increase MAX_DATA (',MAX_DATA,')'
              stop
           endif
        else
           READ (iin,
     $     '(1x,a12,3x,a11,1x,i2,3i4,2i2,f9.0,i5,3x,a4,1x,i5,3x,a3)')
	1    filenam2, datum, typ, ipram, mon2, mpre2, mtyp, npts2, dtyp
           if (npts2 .gt. MAX_DATA) then
              write (0,*) 'File: ',filename(:lench(filename))
     $             ,' contains too many points (',npts,')'
              write (0,*) 'Increase MAX_DATA (',MAX_DATA,')'
              stop
           endif
           if (npts .ne. npts2) then
              write(0,'(A)') ' Warning: files are not the same length'
              write(0,'(A,i5,A)') ' Dropping',abs(npts-npts2),' points'
              npts = min(npts,npts2)           
           endif
        endif
	READ (iin, '(a)') dummy
	READ (iin, '(a)') label
	READ (iin, *) coll, mos, wl, tmp, itmp, hf, scl
	READ (iin, '(a)') dummy
! test the number of points
	if (npts .gt. MAX_DATA)
	1    STOP 'Sorry the arrays are too small. Increase MAX_DATA'
! is this old or new BT-1 data?
	IF (scl .EQ. 5) THEN
	   delta = 20.
	ELSE
	   delta =  5.
	END IF
! read scan range for motor 3 (theta) & 4 (2theta) as abeg(1) & abeg(2)...
        if (i .eq. 1 .or. .not. sumflag) then
           READ (iin, '(i3,3x,3f9.3)')
     $          m, abeg(m-2), ainc(m-2), aend(m-2)
           READ (iin, '(i3,3x,3f9.3)')
     $          m, abeg(m-2), ainc(m-2), aend(m-2)
        else
           READ (iin, '(i3,3x,3f8.3)')
     $          m, abeg2(m-2), ainc(m-2), aend(m-2)
           READ (iin, '(i3,3x,3f8.3)')
     $          m, abeg2(m-2), ainc2(m-2), aend(m-2)
           if (abeg2(2) .ne. abeg(2)) then
              write (0,'(A)') 'Cannot add file ',filename
              write (0,'(A,2(f6.3,A))') 'Motor 4 start value (',
     $             abeg2(2),') differs from previous (',abeg(2),')'
              stop
           endif
           if (ainc2(2) .ne. ainc(2)) then
              write (0,'(A)') 'Cannot add file ',filename
              write (0,'(A,2(f5.3,A))') 'Motor 4 increment value (',
     $             ainc2(2),') differs from previous (',ainc(2),')'
              stop
           endif
        endif
 	READ (iin, '(a)') dummy
	READ (iin, '(11f7.0)') (scale(i1), i1= 1, scl)
	READ (iin, '(a)') dummy
        mono = dummy(37:42)
	READ (iin, '(11f7.0)') (offset(i1), i1= 1, scl)
	READ (iin, '(a)') dummy
	READ (iin, '(a)') dummy

	iline = 17
	line = '$'
	cmin = -1.
	cmax = -1.
	tmin = -1.
	tmax = -1.
	tavg = 0.
	do i1 = 1, npts
	   a4t = abeg(2) + (i1-1.) * ainc(2)
	   do j1 = 1, scl
C read a line if needed, skip over lines beginning with a $ sign
	      do while (line(1:1) .eq. '$' .or. line .eq. ' ')
		 read(iin,'(A)',end=999) linein
		 iline = iline + 1
		 line = linein
		 ln = lench(line)
C remove carriage returns at end of line
		 if (line(ln:ln) .eq. char(13)) line(ln:ln) = ' '
C parse the comments -- check for missing points and get temperatures
		 if (line(1:1) .eq. '$' .and. line(3:5) .eq. 'M4=') then
c       parse out the angle
		    k1 = 6
		    do while (line(k1:k1) .eq. ' ' .and. k1 .lt. ln)
		       k1 = k1 + 1
		    enddo
		    k2 = k1
		    do while (line(k2:k2) .ne. ' ' .and. k2 .lt. ln)
		       k2 = k2 + 1
		    enddo
		    read (line(k1:k2),*,err=212) a4
 212		    continue
		    if (abs(a4 - a4t) .gt. 0.001) write (0,*)
	1		 'Incorrect or angle at point '//line(3:)
		    k3 = k2 + 1
c       parse out the data collection time
		    k1 = k3
		    do while (line(k1:K1+1) .ne. 'C=' .and. k1 .lt. ln)
		       K1 = K1+1
		    enddo
		    if (line(K1:K1+1) .eq. 'C=') then
		       k1 = k1 + 2
		       do while (line(k1:k1) .eq. ' ' .and. k1 .lt. ln)
			  k1 = k1 + 1
		       enddo
		       k2 = k1
		       do while (line(k2:k2) .ne. ' ' .and. k2 .lt. ln)
			  k2 = k2 + 1
		       enddo
		       read (line(k1:k2),*,err=213) t
		       if (cmax .lt. 0) then
			  cmin = t
			  cmax = t
		       elseif (t .gt. cmax) then
			  cmax = t
		       elseif (t .lt. cmin) then
			  cmin = t
		       endif
 213		       continue
		    endif
c       parse out the temperature (if present)
		    k1 = k3
		    do while (line(k1:K1+1) .ne. 'T=' .and. k1 .lt. ln)
		       K1 = K1+1
		    enddo
		    if (line(K1:K1+1) .eq. 'T=') then
		       k1 = k1 + 2
		       do while (line(k1:k1) .eq. ' ' .and. k1 .lt. ln)
			  k1 = k1 + 1
		       enddo
		       k2 = k1
		       do while (line(k2:k2) .ne. ' ' .and. k2 .lt. ln)
			  k2 = k2 + 1
		       enddo
		       read (line(k1:k2),*,err=214) t
		       if (tmax .lt. 0) then
			  tmin = t
			  tmax = t
		       elseif (t .gt. tmax) then
			  tmax = t
		       elseif (t .lt. tmin) then
			  tmin = t
		       endif
		       tavg = tavg + t
 214		       continue
		    endif
		 endif
	      enddo
C read a number from the beginning of the line
	      if (i .eq. 1 .or. .not. sumflag) then
		 READ (line, *, err=998) idata(i1,j1)
	      else
		 READ (line, *, err=998) idata2
                 idata(i1,j1)=idata(i1,j1)+idata2
	      endif
C drop characters up to the next comma or end of the line
	      j = 1
	      do while (line(j:j) .ne. ',' .and. line(j:) .ne. ' ')
		 j = j + 1
	      enddo
	      line = line(j+1:)
	   enddo
	enddo
	goto 997
C error handling code
 999	write (0,*) 'Error reading file: '//filename
	write (0,*) 'Unexpected end of file'
	write (0,*) 'line #',iline,'  detector#',j1,'  point #',i1
	write (0,*) 'file will be truncated to match available data'
	npts = i1-1
	goto 997
 998	write (0,*) 'Error reading file: '//filename
	write (0,*) 'Error reading number: ',line(:lench(line))
	write (0,*) 'entire line: ',linein
	write (0,*) 'line #',iline,'  detector#',j1,'  point #',i1
	write (0,*) 'remainer of file will be ignored'
	npts = i1-1
C end of error code
 997	if (i .eq. 1 .or. .not. sumflag) then
	   mon=mpre*mon + mpre2*mon2
	   mtyp='coll'
        endif
	if (npts .gt. 0) tavg = tavg / npts
	if (.not. filterflag) CLOSE (iin)
C write out the file
        IF (i .eq. nfiles .or. .not. sumflag) THEN
           dang = NINT(ainc(2) * 100.)
           DO j= 1, scl 
	      ival = 1
	      if (dropflag) then
		 do k=1,32
		    if (droplist(k) .eq. j) ival = -1
		 enddo
	      endif
              IF (j .EQ. 1) then
                 WRITE (nout,'(a50,f8.4,2i3,1x,a5,g14.7)')
     $                label, wl, coll(1), coll(2), mono, mon
                 WRITE (nout,'(5i6)')  ipram
              endif
              if (.not. keepflag .and. (j .eq. 2 .or. j .eq. 3 .or.
     $             (j .eq. 1. .and. .not. keepone) ) ) then 
C drop data below cutval degrees in detectors 1, 2 &/or 3
                 k = nint((cutval - abeg(2)) / ainc(2)) + 1
                 k = max(1,k)
                 write (0,'(A,i5,a,i3)') 'Dropping first ',k-1,
     $                ' points from detector',j
              else
                 k = 1
              endif
              ang1= NINT(100. *
     $             (abeg(2) + (k-1.)*ainc(2) + (j-1)*delta))
              ang2= ang1 + NINT((npts-k)*ainc(2)*100.)
              WRITE (nout,'(3i8,2f8.4,2i5,5x,a)') ang1, dang, ang2,
     $             scale(j), offset(j), j, npts-k+1, datum
	      if (ival .eq. 1) then
		 WRITE (nout,'(12i6)') (idata(i1,j), i1= k, npts)
	      else
		 WRITE (nout,'(12i6)') (-1*max(1,idata(i1,j)),
	1	      i1= k, npts)
	      endif
           ENDDO
           CLOSE (nout)
           if (.not. pipeflag) then
	      WRITE (6, '(1x,a)') outfile(:lench(outfile))
	      if (cmax .gt. 0) write (0,'(A,2f8.2)')
	1	   ' Minimum and maximum count times: ',cmin,cmax
	      if (tmax .gt. 0) write (0,'(A,3f8.2)')
	1	   ' Minimum, maximum & avg temperature: ',tmin,tmax,tavg
	      WRITE (0, '(3a)') ' File complete'
	   endif
        endif
      enddo
      stop
      end
C---------------------------------------------------------------------------
C---------------------------------------------------------------------------
c       Function LENCH
c
c This function takes a character string and finds out how long the
c "actual" string is (i.e. not including padded blanks on the right).
c
C---------------------------------------------------------------------------
        integer function lench(string)
        character*(*) string
        character*1 nul
        data nul/0/
        lench=0
        if (string.eq.' '.or.string(1:1).eq.nul) return
        do lench=len(string),1,-1
          if (string(lench:lench).ne.' '.and.string(lench:lench).ne.nul)
     $          return
        enddo
        lench=0
        return
        end
