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

small updates to new_com 

- new module procedures to allow setting/extracting integer and real variables
  extract_dbl, extract_int setudf_dbl, setudf_int
  they are mapped to extract and setudf

- errsig can now be called without "say" argument, just to signal the error

- removed lvused (old new_com)
parent b1955410

sources/drspine.f90

+6 −19
Original line number Diff line number Diff line
@@ -1309,7 +1309,7 @@ CONTAINS 
          if (len_trim(filename) == 0) exit read_loop

       else

          if ( inamf() < i  ) exit  read_loop

          if ( lvused(i)   ) cycle read_loop

          if ( item_used(i) ) cycle read_loop

          filename = trim(vnamef(i))

          if (len_trim(filename) == 0) exit read_loop

          filename = format_path(data_path, filename=filename)
@@ -4347,19 +4347,6 @@ ntl2: do i=0, nt 
  end function parse_fit_flag





  ! TODO: move it to the new_com (PAZ)

  subroutine extract_int(varname, intval, ierror)

    character(len=*), intent(in) :: varname

    integer, intent(inout)       :: intval

    integer, intent(inout), optional :: ierror

    !

    real(kind=DBL) :: tmpval

    integer :: ier

    call extract(varname, tmpval, ier)

    intval = INT(tmpval)

    if (present(ierror)) ierror=ier

  end subroutine extract_int





  !> @brief set user defined variables

  subroutine set_progvar()
@@ -4380,7 +4367,7 @@ ntl2: do i=0, nt 
    call setudf("r.phase_minoff "  , reduction_parameters%symmetry_phase_min_offset, ier)

    !

    call setudf("r.max_chisq "     , reduction_parameters%max_chisquare, ier)

    call setudf("r.center_size "   , real(reduction_parameters%central_detector_area_size, kind=DBL), ier)

    call setudf("r.center_size "   , reduction_parameters%central_detector_area_size, ier)

    !

    !

    call setudf("r.postcoll_qcat ", reduction_parameters%post_collection_qcatch, ier)
@@ -4389,7 +4376,7 @@ ntl2: do i=0, nt 
    call set_instrument_vars()



    ! program config

    call setudf("c.last_run "     , real(program_param%last_run, kind=DBL), ier)

    call setudf("c.last_run "     , program_param%last_run, ier)

  end subroutine set_progvar



  !> get user defined variables
@@ -4411,7 +4398,7 @@ ntl2: do i=0, nt 
    !

    call extract("r.max_chisq "     , reduction_parameters%max_chisquare, ier)



    call extract_int("r.center_size "   , reduction_parameters%central_detector_area_size)

    call extract("r.center_size "   , reduction_parameters%central_detector_area_size, ier)



    call extract("r.postcoll_qcat ", reduction_parameters%post_collection_qcatch, ier)
@@ -4419,7 +4406,7 @@ ntl2: do i=0, nt 
    call get_instrument_vars()



    ! program config

    call extract_int("c.last_run "     , program_param%last_run)

    call extract("c.last_run "     , program_param%last_run, ier)



    ! show parameters

    call msg_debug('get_progvar', msg_fmt("('r.min_counts    =', g12.5)", reduction_parameters%min_counts_per_pixel))

sources/logger.f90

+2 −2
Original line number Diff line number Diff line
@@ -214,7 +214,7 @@ contains 
    integer, intent(in), optional :: ierror

    call logmsg(LOG_ERROR, subrou, messg)

    if (present(ierror))&

         call errsig(ierror,trim(messg)//' $') !signal command interpreter

         call errsig(ierror) !,trim(messg)//' $') !signal command interpreter

    return

  end subroutine msg_error
@@ -225,7 +225,7 @@ contains 
    integer, intent(in), optional :: ierror

    call logmsg(LOG_FATAL, subrou, messg)

    if (present(ierror))&

         call errsig(ierror,trim(messg)//' $') !signal command interpreter

         call errsig(ierror) !,trim(messg)//' $') !signal command interpreter

    return

  end subroutine msg_fatal

sources/new_com.F90

+52 −33
Original line number Diff line number Diff line
@@ -57,6 +57,15 @@ MODULE new_com 
     module procedure  getval, intval, chrval

  end interface



  interface extract

    module procedure   extract_dbl

    module procedure   extract_int

  end interface



  interface setudf

    module procedure   setudf_dbl

    module procedure   setudf_int

  end interface



#ifdef USE_LINENOISE

  !----------------------------------------------------------------------------
@@ -320,8 +329,10 @@ MODULE new_com 
  public :: getitem

  public :: evaluate

  public :: cappend

  public  :: extract

  public  :: setudf

  public  :: extract_dbl

  public  :: extract_int

  public  :: setudf_dbl

  public  :: setudf_int

  public  :: clrudf

  public  :: shwudf

  public  :: settit
@@ -357,8 +368,6 @@ MODULE new_com 
  public  ::  inamf

  public  ::  inapf

  !

  public  ::  lvused ! whether the parameter has already been "used"





  public :: close_all_macros
@@ -500,7 +509,7 @@ CONTAINS 


    character*1024 ma_fil

    integer       ilma, i, j, k, l, ii, ipmlen, isum, ioold

    integer       ier, ierr, ioldna, inew, iival

    integer       ier, ierr, ioldna, iival !, inew is unused



    integer :: init_run = 1, irc=0

    double precision   val
@@ -1895,13 +1904,15 @@ CONTAINS 
    !     ===========================

    implicit none

    integer, intent(in)      ::ierr

    character(*), intent(in), optional :: say

    !

    integer                  ::lsay

    character(*), intent(in) :: say

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

    !  error signalisierung

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

    ierrr = ierr

    ierrs = ierrs+1                 ! check which one we need 

    if (.not.present(say)) return

    lsay = laenge(say,cmd_len,'$')

    write(6,*)'error:',ierr,' ',say(1:lsay)

    if(iot.gt.0) then
@@ -2021,8 +2032,8 @@ CONTAINS 
    double precision, intent(in)              ::  defval

    integer,          intent(out), optional   ::  inew0



    double precision ::  inew, ev_val

    integer          ::  ev_err

    double precision ::  ev_val

    integer          ::  inew, ev_err



    inew      = 0

    valnxt    = defval
@@ -3300,14 +3311,14 @@ CONTAINS 
  END function compare





  subroutine extract(nam,val,ier)

  subroutine extract_dbl(nam,val,ier)

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



    implicit none

    integer i, ier

    character(*)     :: nam

    double precision   val



    double precision :: val

    integer          :: ier

    !

    integer :: i



    ier = 0

    ! --- look in uservars ---
@@ -3325,10 +3336,24 @@ CONTAINS 
    ! --- user defined vals ---

    call newcom_usrextr(nam,val,ier)

    return

  END subroutine extract

  END subroutine extract_dbl



  subroutine extract_int(nam,val,ier)

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



    implicit none

    character(*) :: nam

    integer :: val

    integer :: ier

    !

    double precision :: tmpval



    call extract_dbl(nam, tmpval, ier)

    val = int(tmpval)

    return

  end subroutine extract_int



  subroutine setudf(nam,val,ier)

  subroutine setudf_dbl(nam,val,ier)

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

    implicit none

    character(len=*), intent(in) :: nam
@@ -3372,7 +3397,17 @@ CONTAINS 
       ier = 200

    endif

    return

  END subroutine setudf

  END subroutine setudf_dbl



  subroutine setudf_int(nam,val,ier)

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

    implicit none

    character(len=*), intent(in) :: nam

    integer, intent(in)  :: val

    integer, intent(out) :: ier



    call setudf_dbl(nam, real(val, kind=8), ier)

  end subroutine setudf_int





  subroutine clrudf(nam)
@@ -3894,22 +3929,6 @@ END SUBROUTINE intnva 
   s = prompt

  end function get_prompt









  ! (paz) whether "name" has been used

  function lvused(iname) result(res)

    integer, intent(in) :: iname

    logical :: res

    res = vused(iname)

  end function lvused















 ! =========================================================================

 !> convert blanks between quoites to ~ (aux function to enable newcom to deal 

 !> with quote strings as nametype items