working version of custom matching, issue #20 (57bde5bf) · Commits · Zolnierczuk, Piotr / DrSPINE

Makefile.version

+1 −1

Original line number	Diff line number	Diff line
		@@ -3,7 +3,7 @@ export PROJECT=drspine

		export VERSION_MAJOR=1
		export VERSION_MINOR=3
		export VERSION_RELEASE=4
		export VERSION_RELEASE=5

		export PROJLIB=lib$(PROJECT).a
		export PROJARCH=$(PROJECT)-$(VERSION_MAJOR).$(VERSION_MINOR)

examples/match_test2

+14 −0

Original line number	Diff line number	Diff line
		@@ -18,3 +18,17 @@ match show
		!
		match clear
		match show
		!
		! match all taus (res)
		match run 10875 to 10879 ! 11A res to 8A sample
		match show
		! match all taus (bgr)
		match run 10875 to 10903 ! 11A bgr to 8A sample
		match show
		! match tau 2 run 10875 => tau 2 10903 (bgr)
		match run 10875 tau 2 to 10903 ! 11A bgr to 8A sample
		match show
		!
		! match tau 2 run 10875 => tau 3 run 10903 (bgr)
		match run 10875 tau 2 to 10903 tau2 3 ! 11A bgr to 8A sample
		match show

sources/drspine.f90

+63 −25

Original line number	Diff line number	Diff line
		@@ -281,6 +281,9 @@ program drspine
		istat = add_tab_expansion('match all' )
		istat = add_tab_expansion('match resolution' )
		istat = add_tab_expansion('match background' )
		istat = add_tab_expansion('match clear' )
		istat = add_tab_expansion('match show' )
		istat = add_tab_expansion('match run' )
		!
		istat = add_tab_expansion('fit')
		istat = add_tab_expansion('fit all')
		@@ -613,7 +616,10 @@ program drspine
		' res\|ref\|resolution - matches sample/background to resolution'//LF//&
		' bgr\|background - matches sample to background'//LF//&
		' clear - clear all matching data'//LF//&
		' show - show all matching data $' )) then
		' show - show all matching data '//LF//&
		' run <run> [tau <tau>] to <run> [tau2 <tau>] '//LF//&
		' NOTE: '//LF//&
		" 'match run' comand is experimental$" )) then

		! ===============
		call cmd_match()
		@@ -1860,37 +1866,69 @@ CONTAINS
		subroutine cmd_match()
		! ===========
		implicit none
		integer, parameter :: E_GLOBAL= 0,&
		E_RUN = 1,&
		E_CLEAR = 2,&
		E_SHOW = 4
		integer :: match_role
		integer :: iwhat, inew
		!
		integer :: isource, itarget
		integer :: isource_pt, itarget_pt

		call msg_info('match', '===> matching datasets')
		match_role = ROLE_UNDEFINED
		isource = -1
		itarget = -1
		isource_pt = 0 ! 0 means all taus
		itarget_pt = 0 ! 0 means use isource_pt

		if (found('show')) then
		call match_show(data_scan, data_manager_size())
		call unused( 1, 1, 1, ier)
		return
		end if
		iwhat = parse_command_flags("run,clear,show") ! comma separated, no spaces

		if (found('clear')) then
		call match_clear(data_scan, data_manager_size())
		call unused( 1, 1, 1, ier)
		if (iwhat<0) then ! error
		call msg_error('drspine', 'command match: keywords force, clear and show are mutually exclusive', ERROR_OPTION_SYNTAX)
		return
		end if


		if( found('resolution') .or. found('res') ) match_role = ior(match_role, ROLE_REFERENCE )
		if( found('background') .or. found('bgr') ) match_role = ior(match_role, ROLE_BACKGROUND)
		if( found("all") ) match_role = ior(match_role, ior(ROLE_REFERENCE,ROLE_BACKGROUND))

		what: select case(iwhat)
		! match "global"
		case (E_GLOBAL)
		! global matching
		! source target
		! match data_scan(i) => data_scan(j)
		! sample -> resolution
		! background -> resolution
		! sample -> background
		if( found('resolution') .or. found('res') .or. found('ref' ) ) &
		match_role = ior(match_role, ROLE_REFERENCE )
		if( found('background') .or. found('bgr') ) &
		match_role = ior(match_role, ROLE_BACKGROUND)
		if( found("all") ) match_role = ior(match_role, ior(ROLE_REFERENCE,ROLE_BACKGROUND))
		call msg_info('match', ' ==> matching datasets: ' //trim(cformat_role(match_role)))
		call match_scan_global(data_scan, data_manager_size(), match_role)
		!
		! match run
		case (E_RUN)
		isource = get_named_value('run' , isource, inew)
		isource_pt = get_named_value('tau' , isource_pt, inew)
		itarget = get_named_value('to' , itarget, inew)
		itarget_pt = get_named_value('tau2' , itarget_pt, inew)

		!! here: cleare the match pointer arrays !! HERE >>new>> mm TBD

		call match_scans(data_scan, data_manager_size(), match_role)
		if (isource>0 .and. isource_pt>=0 ) then ! 0 means all "taus"
		isource = data_manager_find(isource)
		if (itarget>0 .and. itarget_pt>=0) then ! 0 means use isource_pt
		itarget = data_manager_find(itarget)
		call match_scan_force(data_scan(isource), isource_pt, data_scan(itarget), itarget_pt)
		end if
		endif
		!
		case (E_CLEAR)
		call match_clear(data_scan, data_manager_size())
		!
		case (E_SHOW)
		call match_show(data_scan, data_manager_size())
		!
		case default
		end select what
		call unused( 1, 1, 1, ier)

		end subroutine cmd_match

sources/matching.f90

+71 −7

Original line number	Diff line number	Diff line
		@@ -37,7 +37,7 @@ module matching

		public :: taupoint_match, taupoint_mismatch, cformat_match_accuracy
		public :: clear_matches, list_matching_ids
		public :: match_scans, match_show, match_clear
		public :: match_scan_global, match_scan_force, match_show, match_clear
		public :: matching_tolerance

		contains
		@@ -201,7 +201,7 @@ contains
		endif
		if (full_match) then
		write(idbuf,'(i0,":",i0.2)') matches(i)%ptr%id, matches(i)%ptr%point
		clist = trim(clist)//trim(idbuf)//" "
		clist = trim(clist)//" "//trim(idbuf)
		else
		write(idbuf,'(i0)') matches(i)%ptr%id
		clist = trim(clist)//" "//idbuf
		@@ -257,6 +257,7 @@ contains
		endif
		target_loop: do j=1, target_data%number_of_points
		! FIXME: implicit assumption that the target role is either ROLE_REFERENCE or ROLE_BACKGROUND
		! otherwise the target is ignored
		if (taupoint_match(source_data%scan_point(i), target_data%scan_point(j))) then
		if(has_role(target_data%role, ROLE_REFERENCE)) then
		source_data%scan_point(i)%matching_ref => target_data%scan_point(j)
		@@ -288,7 +289,69 @@ contains
		!! @param scan_size - size of scan_data
		!! @param match_role - target data role
		!! @note
		subroutine match_scans(scan_data, scan_size, match_role)
		subroutine match_scan_force(source_data, source_pt, target_data, target_pt)
		type(scan_struct), intent(inout) :: source_data
		type(scan_struct), intent(in), target :: target_data ! resolution, background
		integer, intent(in) :: source_pt
		integer, intent(in) :: target_pt
		!
		integer :: src_pt, tgt_pt
		!
		if ( .not. is_valid_scan(source_data) ) then
		call msg_warning('match_scan_force', 'matching: invalid source scan')
		return
		end if
		if ( .not. is_valid_scan(target_data) ) then
		call msg_warning('match_scan_force', 'matching: invalid target scan')
		return
		end if
		if(source_pt<0 .or. source_data%number_of_points<source_pt) then
		call msg_warning('match_scan_force', 'matching: invalid source scan point')
		return
		end if
		if(target_pt<0 .or. target_data%number_of_points<target_pt) then
		call msg_warning('match_scan_force', 'matching: invalid target scan point')
		return
		end if


		! FIXME (paz) - this is a convoluted loop and test condition
		source_loop: do src_pt=1, source_data%number_of_points
		if (source_pt>0 .and. src_pt/=source_pt) cycle source_loop
		target_loop: do tgt_pt=1, target_data%number_of_points

		if (target_pt==0) then
		if(source_pt==0 .and. src_pt /= tgt_pt) cycle target_loop
		if(source_pt>0 .and. source_pt /= tgt_pt) cycle target_loop
		end if
		if (target_pt>0 .and. target_pt/=tgt_pt) cycle target_loop !

		if(has_role(target_data%role, ROLE_REFERENCE)) then
		source_data%scan_point(src_pt)%matching_ref => target_data%scan_point(tgt_pt)
		call clear_matches(source_data%scan_point(src_pt)%matching_ref_arr)
		call add_matching_ptr(source_data%scan_point(src_pt)%matching_ref_arr, &
		source_data%scan_point(src_pt)%matching_ref)
		else if(has_role(target_data%role, ROLE_BACKGROUND)) then
		source_data%scan_point(src_pt)%matching_bgr => target_data%scan_point(tgt_pt)
		call clear_matches(source_data%scan_point(src_pt)%matching_bgr_arr)
		call add_matching_ptr(source_data%scan_point(src_pt)%matching_bgr_arr, &
		source_data%scan_point(src_pt)%matching_bgr )
		else
		call msg_warning('match_scan_force',&
		'matching: expecting reference or background as matching target')
		exit source_loop
		end if
		end do target_loop
		end do source_loop
		end subroutine match_scan_force

		!> match scans based on role
		!! This subroutine matches scans in scan_data array based on match_role.
		!! @param scan_data - array of scan_struct data
		!! @param scan_size - size of scan_data
		!! @param match_role - target data role
		!! @note
		subroutine match_scan_global(scan_data, scan_size, match_role)
		type(scan_struct), dimension(:) :: scan_data
		integer, intent(in) :: scan_size
		integer, intent(in) :: match_role
		@@ -304,7 +367,8 @@ contains
		end if
		end do target_loop
		end do source_loop
		end subroutine match_scans
		end subroutine match_scan_global



		!> show current matches

tests/data_helper.f90

+7 −1

Original line number	Diff line number	Diff line
		@@ -29,7 +29,11 @@ contains
		call random_seed()

		do i=1,nscan
		if (i==1) then
		call init_scan_struct(scan_data(i), npoints+2, nphases, nt, nx, ny) ! two extra points for resolution
		else
		call init_scan_struct(scan_data(i), npoints, nphases, nt, nx, ny)
		end if
		scan_data(i)%id = 1000+i
		write(scan_data(i)%file,'("./s",i4,".echo")') scan_data(i)%id
		do j=1, scan_data(i)%number_of_points
		@@ -39,6 +43,8 @@ contains
		phi = phi0 + 0.05*err(2)
		psi = 90.0-phi/2.0

		scan_data(i)%scan_point(j)%id = scan_data(i)%id
		scan_data(i)%scan_point(j)%point = j
		scan_data(i)%scan_point(j)%spectrum(0)%no_lambda_bins = ntof
		scan_data(i)%scan_point(j)%spectrum(0)%lambda_bin(1:ntof) = &
		[( (set_wavelength(k, ntof, 8.0, 3.0)+0.05err(k))ANGSTROEM , k=1,ntof )]