Commit cc0c5200 authored by Zolnierczuk, Piotr's avatar Zolnierczuk, Piotr
Browse files

fixing command parsing, fit run <run> 

* fixing command parsing using new new_com
* keep (old) new_com.F90 as old_com.F90 and use Makefile flag to switch
  - default is (new) new_com.F90
  - will remove old_com as soon we are stable
* added new option to fit command to allow to fit a single run, e.g.
  fit run 1244 flag offset phase_offset 180.0
parent a49139a8

sources/Makefile

+8 −2
Original line number Diff line number Diff line
@@ -10,6 +10,7 @@ CFLAGS = 
FCFLAGS=-g -O2

ARFLAGS= cr

GRDIR  = /usr/local/gr

#OLDCOM =



MAKEDEPEND := $(shell command -v makedepend 2> /dev/null)

MAKEDEPF90 := $(shell command -v makedepf90 2> /dev/null)
@@ -36,8 +37,13 @@ PROGSRC=\ 


FSOURCES1=\

	drspine_version.F90 \

	os_utils.F90        \

	old_com.F90

	os_utils.F90



ifndef OLDCOM

FSOURCES1 += new_com.F90

else

FSOURCES1 += old_com.F90

endif



FSOURCES2=\

	drspine_parameters.f90 \

sources/Makefile.depend

+4 −4
Original line number Diff line number Diff line 
# Makefile.depend Wed Sep 18 22:48:10 EDT 2019

# Makefile.depend Thu Sep 19 13:42:27 EDT 2019

drspine_version.o : drspine_version.F90 

os_utils.o : os_utils.F90 strings_module.o drspine_parameters.o 

old_com.o : old_com.F90 os_utils.o 

new_com.o : new_com.F90 os_utils.o

drspine_parameters.o : drspine_parameters.f90 

constants_module.o : constants_module.f90 drspine_parameters.o 

strings_module.o : strings_module.f90 

regex_module.o : regex_module.f90 

logger.o : logger.f90 old_com.o 

logger.o : logger.f90 new_com.o 

getopt_m.o : getopt_m.f90 

mathutil.o : mathutil.f90 drspine_parameters.o 

statutil.o : statutil.f90
@@ -35,7 +35,7 @@ instrument_config.o : instrument_config.f90 echo_shapes.o binning.o geometry_typ 
module_gen_makro.o : module_gen_makro.f90 strings_module.o 

gr_interface.o : gr_interface.f90 drspine_parameters.o 

plot_utils.o : plot_utils.f90 texology.o dump_data.o data_types.o gr_interface.o 

drspine.o : drspine.f90 plot_utils.o module_gen_makro.o getopt_m.o texology.o os_utils.o file_utils.o write_utils.o reduce_data.o dump_data.o fit_data.o read_data.o instrument_config.o data_manager.o echo_shapes.o geometry_types.o data_types.o minimization.o matching.o binning.o constants_module.o drspine_version.o drspine_parameters.o old_com.o 

drspine.o : drspine.f90 plot_utils.o module_gen_makro.o getopt_m.o texology.o os_utils.o file_utils.o write_utils.o reduce_data.o dump_data.o fit_data.o read_data.o instrument_config.o data_manager.o echo_shapes.o geometry_types.o data_types.o minimization.o matching.o binning.o constants_module.o drspine_version.o drspine_parameters.o new_com.o 

extract_figures.o : extract_figures.f90 

plain_figures.o : plain_figures.f90 

mxx.o : mxx.f90

sources/drspine.f90

+30 −50
Original line number Diff line number Diff line
@@ -316,7 +316,12 @@ program drspine 
     !!> TO BE DONE: check here for errors issued in the last command and perform appropriate action if available

     !!> we may introduce an extraction function 'get_last_error_codes' reporting the error code accumulated in new_com either

     !!> during comand parsing/interpretation or obtained during calls of 'unused' and 'errsig'

     !!>>>>

     call unused( icmdus=2, ivnuse=2, irpuse=2, iretus=iunused)

     if(iunused .ne. 0) call msg_error('drspine', 'unknown option in last command', 9901)



     if(ierrs > 0) call close_all_macros()

     ierrs = 0





     !------------------------------------------------------------

     !> get the next command line from keyboard or makro file
@@ -863,18 +868,6 @@ program drspine 
     call unused( 1, 1, 1, ier)





 !!>>>>

 !!mmnc

    !call unused( icmdus=2, ivnuse=2, irpuse=2, iretus=iunused)

    !if(iunused .ne. 0) then

    ! call errsig(9901,"ERROR: unknown option in last command ! $")

    !endif 



    !if(ierrs > 0) call close_all_macros() 

    !ierrs = 0

!!mmnc





  enddo commandloop



  !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -1658,12 +1651,21 @@ CONTAINS 
    cwhat = repeat(' ', MAX_LINE_LENGTH)

    cflag = repeat(' ', MAX_LINE_LENGTH)



    ! parse run argument

    fit_run      = get_named_value('run ', fit_run, ier)

    if (ier>0 .and. fit_run >  0 ) then

       fit_resolution = .false.

       fit_sample     = .false.

       fit_background = .false.

    end if

    phase_offset = get_named_value('phase_offset',phase_offset, ier)



    ! now parse "what"

    cwhat = trim(chrnxt('fit', ier)) ! weird way of getting next parameter

    if (ier>0) then

        if (trim(cwhat)=='all'.or.trim(cwhat)=='flag'.or.trim(cwhat)=='run') then

            continue

        else

       select case(trim(cwhat))

          case ('fit','run','flag','all')

          case default

            fit_resolution = .false.

            fit_sample     = .false.

            fit_background = .false.
@@ -1680,15 +1682,7 @@ CONTAINS 
                               //trim(cwhat)//"'  - expected all, res, sam or bgr")

                return

            end select

        end if

    end if

    if ( found('run') ) then

       fit_run = get_named_value('run ', fit_run, ier)

       if (ier>0) then

          fit_resolution = .false.

          fit_sample     = .false.

          fit_background = .false.

       end if

        end select

    end if



    if ( found('flag') ) then
@@ -1705,7 +1699,6 @@ CONTAINS 
          fit_flag = get_named_value('flag ',fit_flag, ier) ! FIXME: never gets executed ier>0

       end if

    end if

    phase_offset = get_named_value('phase_offset',phase_offset, ier)



    if( fit_resolution ) &

         call msg_info('cmd_fit', "fitting data with role RESOLUTION using flag="//trim(cformat_fit_flag(fit_flag)))
@@ -1716,15 +1709,6 @@ CONTAINS 
    if( fit_run>0) &

         call msg_info('cmd_fit', "fitting "//trim(msg_fmt("('run =',i0)", fit_run))//" flag="//trim(cformat_fit_flag(fit_flag)))



    !fit_loop: do i=1, data_size

    !   if (.not. is_valid_scan(data_scan(i))) cycle fit_loop

    !   use_flag = 0

    !   if (fit_resolution .and. has_role(data_scan(i)%role, ROLE_REFERENCE )) fit_flag = PHASE_FIT_DEFAULT

    !   if (fit_sample     .and. has_role(data_scan(i)%role, ROLE_SAMPLE    )) fit_flag = PHASE_USE

    !   if (fit_background .and. has_role(data_scan(i)%role, ROLE_BACKGROUND)) fit_flag = PHASE_USE

    !end do fit_loop





    if ( fit_resolution ) then

!!<!mm       if (fit_flag<0) fit_flag = PHASE_FIT_DEFAULT ! fit and amplitude positive

       call msg_info('fit', '===> fitting resolution')
@@ -1780,10 +1764,6 @@ CONTAINS 
          end if

       end do

    end if





    call unused( 1, 1, 1, ier)



  end subroutine cmd_fit

tests/testnewcom.f90

+20 −9
Original line number Diff line number Diff line 
program testnewcom



  use drspine_parameters

  use new_com

  use logger

  use strings_module



  implicit none



  character(len=256)  :: mycommand

  double precision  :: x

  integer           :: ier, istat, iflag

  integer           :: istat, iflag

  integer           :: ier, iunused

  external          :: myextract
@@ -20,6 +23,9 @@ program testnewcom 
  info = 0

  commandloop: do



     call unused( icmdus=0, ivnuse=1, irpuse=1, iretus=iunused)

     if(iunused.ne. 0) call msg_error('main','unknown option in last command!',9901)



     if(info == 0) then

        call get_newcom(mycommand, istat)  !!! read and parse command line

        if (istat<0) exit commandloop
@@ -33,7 +39,6 @@ program testnewcom 
        write(6,*)'vlc: '

        x = getval('a12345678910     ',x,ier)

        write(6,*) x, ier

        call unused( 1, 1, 1, ier)

        cycle commandloop

     endif
@@ -41,15 +46,14 @@ program testnewcom 
        write(6,*)'tstcom: '

        x = getval('a123',x,ier)

        write(6,*) x, ier

        call unused( 1, 1, 1, ier)

        cycle commandloop

     endif





     if(command('c1      ','test my name is command c1 and my parameter is xval, c2 illustrate the other form $')) then

        write(6,*)'c1: '

        x = get_named_value('xval     ',x,ier)

        write(6,*) x, ier

        call unused( 1, 1, 1, ier)

        cycle commandloop

     endif
@@ -62,14 +66,14 @@ program testnewcom 


     if(command('mflag ', 'mflag [one|two|three] (multiple flag)$')) then

        write(6,*)'flag: '

        iflag = parse_flags('one,two,three', multiple=.true.)

        iflag = parse_flags('one|two|three', multiple=.true.)

        write(6,*)'flag => ', iflag

        cycle commandloop

     endif



     if(command('xflag ', 'xflag [one|two|three] (exclusive flag)$')) then

        write(6,*)'flag: '

        iflag = parse_flags('one,two,three', multiple=.false.)

        iflag = parse_flags('one|two|three', multiple=.false.)

        write(6,*)'flag => ', iflag

        cycle commandloop

     endif
@@ -94,7 +98,10 @@ program testnewcom 
     !-------------------------------------------------------------

     !> finally check for makro files

     call makro(mycommand)

     call unused( 1, 1, 1, ier)



     !call unused( icmdus=2, ivnuse=2, irpuse=2, iretus=iunused)

     !if(iunused.ne. 0) call errsig(9901,"ERROR: unknown option in last command ! $")



  enddo commandloop



contains
@@ -111,12 +118,15 @@ contains 


        iflag  = 0

        nflags = 0

        call split(cflags,",", words, nwords, par_len, par_size)

        call split(cflags,"|", words, nwords, par_len, par_size)

        do i=1, nwords

            write(*,'(a)', advance='no') 'word '//trim(words(i))

            if ( found(trim(words(i))) ) then

                write(*,'(a)', advance='no')' found'

                iflag  = IBSET(iflag, i-1)

                nflags = nflags + 1

            endif

            write(*,*)

        end do

        ! if multiple is present and set to true allow for multiple flags

        if (present(multiple)) then
@@ -125,6 +135,7 @@ contains 
        if (nflags>1) iflag=-1

    end function parse_flags





end program testnewcom



subroutine myextract(name,x,ier)