program abskor3

*     absorption correction for full or double-walled cylinders
*     replaces old ABSKOR and ABSKOR2
*     uses FIT subroutines written by M. Zolliker
*     30.11.01
*
*     > myfit abskor3.f  
*     > mv a.out abskor3 

      implicit none

      integer l
      character*256 file, outfile, line
      character*32 spec, value
      character*5 flag
      real mur, rira, rarc
      logical found
      
      external extract_option, cvt_ratio
      logical extract_option
      real cvt_ratio
      
      call sys_get_cmdpar(line, l)

      if (line .eq. ' ') then
        call fit_init_silent
        call sys_getenv('dat_defspec',spec)
        if (spec.eq.' ') spec='DMC'
        call str_trim(spec,spec,l)        

  100   write(*,*)
        write(*,'(x,a)')'DMC = 1 / HRPT = 2'
        write(*,'(x,3a,$)')'Instrument (default: ',spec(1:l),'): '
        read(*,'(a)')flag                  

        call str_upcase(flag, flag)    

        if (flag.eq.'1') flag='DMC'
        if (flag.eq.'2') flag='HRPT'
        if (flag.ne.' ') then
          if (flag.ne.'DMC' .and. flag.ne.'HRPT') goto 100
          spec=flag
        endif

        call sys_setenv('dat_defspec',spec)
        file=' '
        outfile=' '
      else
        mur=0
        rira=0
        rarc=0
        if (extract_option('m', line, value)) then
          read(value, *, err=999,end=999) mur
        endif
        if (extract_option('r', line, value)) then
          rira=cvt_ratio(value, -1.0)
          if (rarc .lt. 0) goto 999
        endif
        if (extract_option('c', line, value)) then
          rarc=cvt_ratio(value, -1.0)
          if (rarc .lt. 0) goto 999
        endif
        found=extract_option(' ', line, file)
        found=extract_option('o', line, outfile)
        if (line .ne. ' ') goto 999
        call fit_init_silent
      endif

      call fit_dat_merge(file,0.025)
      write(*,*)
      call fit_abskor2(mur,rira,rarc)
      write(*,*)

C      call fit_auto_mon
C      write(*,*)
C      call fit_mon(0)

      if (outfile .eq. ' ') then
  101   write(*,'(x,a,$)')'Name of output file: '
        read(*,'(a)') outfile
        if (outfile.eq.' ') goto 101
      endif
      
      call fit_export(0.0,'lnsp',outfile)

      write(*,*)
      write(*,'(x,2a)')'new file:   ',outfile
      write(*,*)

      goto 9999
      
999   write (*,*) ' '
      write (*,*) 'Usage:'
      write (*,*) ' '
      write (*,'(x,2a)') '  abskor3 -m <m> [ -r <ri>/<ra> ]'
     *,' [ -c <ra>/<rc> ] [ -o <out> ] <inp>'
      write (*,*) ' '
      write (*,*) 'where <m>  mu*R'
      write (*,*) '     <ri>  inner sample radius'
      write (*,*) '     <ra>  outer sample radius'
      write (*,*) '     <rc>  radial collimator fwhm'
      write (*,*) '    <inp>  input file(s) or number of run(s)'
      write (*,*) '    <out>  output file'
      
9999  end


	logical function extract_option(optchar, line, value)

! extract an option from commandline
! options are single chars preceded by 

	character optchar*1, line*(*), value*(*)
	
	integer i, state, j

	state=0 ! beginning or between options
	do i=1,len(line)
	  if (state .eq. 0) then
	    if (line(i:i) .le. ' ') then
	      continue
	    elseif (line(i:i) .eq. '-') then
	      state=2 ! option started
	    elseif (optchar .eq. ' ') then ! argument
	      state=5 ! argument started
	      j=i
	    endif
	  elseif (state .eq. 2) then
	    if (line(i:i) .eq. optchar) then
	      line(i-1:i)=' '
	      state=3 ! option matches
	    else
	      state=1 ! option does not match
	    endif
	  elseif (state .eq. 1) then
	    if (line(i:i) .gt. ' ') then
	      state=4 ! unmatching option value
	    elseif (line(i:i) .eq. '-') then
	      state=2 ! option has started
	    endif
	  elseif (state .eq. 4) then
	    if (line(i:i) .le. ' ') then
	      state=0 ! between options
	    endif
	  elseif (state .eq. 3) then
	    if (line(i:i) .gt. ' ') then
	      j=i
	      state=6
	    endif
	  elseif (state .ge. 6) then
	    if (state .eq. 6) then
	      if (line(i:i) .eq. '-' .and. len(value) .eq. 1) then
	        value=' '
	        extract_option=.true.
	        return
	      endif
	      if (line(i:i) .le. ' ') then
	        value=line(j:i)
	        line(j:i)=' '
	        extract_option=.true.
	        return
	      endif
	    endif
	  endif
	enddo
	if (state .lt. 5) then
	  value=' '
	  extract_option=.false.
	  return
	endif
	value=line(j:)
	line(j:)=' '
	extract_option=.true.
	end