multiple matches with bgr and ref, matcing and reoprting, no influnence on evaluation yet ! (ed5398ce) · Commits · Zolnierczuk, Piotr / DrSPINE

sources/data_types.f90

+71 −0

Original line number	Diff line number	Diff line
		@@ -2176,6 +2176,77 @@ endif

		end subroutine consolidate_colldata

		! type scan_data_struct_pointer
		! type(scan_data_struct), pointer :: ptr => null()
		! end type scan_data_struct_pointer


		! >>new>> mm
		subroutine add_matching_ptr( matches, ptr_to_add )
		implicit none
		type(scan_data_struct_pointer) , intent(inout) :: matches(:)
		type(scan_data_struct), pointer, intent(inout) :: ptr_to_add

		integer :: i

		if(.not.associated(ptr_to_add)) then
		write(,)"TEST ERR PTR NOT ASSOCIATED"
		return
		endif

		d1: do i=1, size(matches)
		if(associated(matches(i)%ptr,ptr_to_add)) cycle
		if(.not.associated(matches(i)%ptr) ) then
		!!TEST!! write(,)"TESTMATCH ADD : ",i, ptr_to_add%id
		matches(i)%ptr => ptr_to_add
		!!TEST!! write(,)"TESTMATCH ADDc: ",i, matches(i)%ptr%id
		return
		endif
		enddo d1

		call msg_error('matching', 'to many matches to one point ', ERROR_DATA_PROCESSING)

		end subroutine add_matching_ptr


		subroutine clear_matches( matches )
		implicit none
		type(scan_data_struct_pointer) , intent(inout) :: matches(:)

		integer :: i


		do i=1, size(matches)
		matches(i)%ptr => null()
		enddo

		end subroutine clear_matches



		function list_matching_ids( matches) result(clist)
		implicit none
		integer, parameter :: idfmt_width = 10
		type(scan_data_struct_pointer) , intent(in) :: matches(:)
		character(len=(idfmt_width+1)*size(matches)) :: clist
		character(len=idfmt_width) :: idbuf

		integer :: i

		clist = " "
		d1: do i=1, size(matches)
		if(.not. associated(matches(i)%ptr) ) then
		!!TEST!! write(,)"TMATCHLIST0:", i," is not associated!"
		cycle d1
		endif
		write(idbuf,'(i0)') matches(i)%ptr%id
		clist = trim(clist)//" "//idbuf
		!!TEST!! write(,)"TMATCHLIST1:", i, matches(i)%ptr%id
		enddo d1

		end function list_matching_ids


		! <<new<< mm

		end module data_types

sources/drspine.f90

+44 −1

Original line number	Diff line number	Diff line
		@@ -1593,12 +1593,22 @@ CONTAINS
		subroutine cmd_match()
		! ===========
		implicit none
		!integer :: i, j
		integer :: i, j
		integer :: match_role

		call msg_info('match', '===> matching datasets')
		match_role = ROLE_UNDEFINED

		!! >>TEST>>
		do i= 1, size(data_scan)
		do j=1, data_scan(i)%number_of_points
		call clear_matches(data_scan(i)%scan_point(j)%matching_ref_arr)
		call clear_matches(data_scan(i)%scan_point(j)%matching_bgr_arr)
		enddo
		enddo
		!! <<TEST>>


		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))
		@@ -2610,17 +2620,50 @@ d2: do i=1, data_manager_size()
		call tex_pbox( " \hfill " ,"12ex")
		if (associated(data_scan(i)%scan_point(1)%matching_ref) ) then
		call tex_pbox( "matching reference: " // tex_integer_number_fmt(data_scan(i)%scan_point(1)%matching_ref%id,8),"6cm")
		! >>new>> mm
		do j=1,data_scan(i)%number_of_points
		! data_scan(i)%scan_point(j)%matching_ref_arr(1)%ptr => data_scan(i)%scan_point(1)%matching_ref
		buf = trim(list_matching_ids( data_scan(i)%scan_point(j)%matching_ref_arr))
		!!TEST!! write(,)"TEST-REFLIST: ",i,j,data_scan(i)%number_of_points ,&
		!!TEST!! " : ", trim(buf)
		!!TEST!! write(,)"TLIST=", data_scan(i)%scan_point(j)%matching_ref_arr(1)%ptr%id, data_scan(i)%scan_point(j)%matching_ref%id
		if(len_trim(buf) > 0) then
		call tex(" \\ ")
		call tex_pbox( " \hfill " ,"12ex")
		call tex_pbox( "\tiny matching reference(" // &
		tex_integer_number_fmt(j,2)//" ): " // trim(buf),"12cm")
		endif

		enddo
		! <<new<<
		else
		call tex_pbox( "matching reference: -- ","6cm")
		end if
		call tex(" \\ ")
		call tex(" \normalsize ")
		call tex_pbox( " \hfill " ,"12ex")
		if (associated(data_scan(i)%scan_point(1)%matching_bgr) ) then
		call tex_pbox( "matching background: " // tex_integer_number_fmt(data_scan(i)%scan_point(1)%matching_bgr%id,8),"6cm")
		! >>new>> mm
		do j=1,data_scan(i)%number_of_points
		! data_scan(i)%scan_point(j)%matching_ref_arr(1)%ptr => data_scan(i)%scan_point(1)%matching_ref
		buf = trim(list_matching_ids( data_scan(i)%scan_point(j)%matching_bgr_arr))
		!!TEST!! write(,)"TEST-BGRLIST: ",i,j,data_scan(i)%number_of_points , " : ", trim(buf) !!TEST!!
		!!TEST!! write(,)"TLIST=", data_scan(i)%scan_point(j)%matching_ref_arr(1)%ptr%id, data_scan(i)%scan_point(j)%matching_ref%id !!TEST!!
		if(len_trim(buf) > 0) then
		call tex(" \\ ")
		call tex_pbox( " \hfill " ,"12ex")
		call tex_pbox( "\tiny matching background(" // &
		tex_integer_number_fmt(j,2)//" ): " // trim(buf),"12cm")
		endif

		enddo
		! <<new<<
		else
		call tex_pbox( "matching background: -- ","6cm")
		end if
		call tex(" \\ ")
		call tex(" \normalsize ")

		call tex_pbox( " \hfill " ,"12ex")

sources/matching.f90

+47 −2

Original line number	Diff line number	Diff line
		@@ -181,15 +181,46 @@ contains
		integer :: i, j
		character(len=MAX_NAME_LENGTH) :: cmsg

		integer :: l !>>test

		source_loop: do i=1, source_data%number_of_points
		! >>new>> mm
		if(has_role(target_data%role, ROLE_REFERENCE)) then
		if(.not. associated( source_data%scan_point(i)%matching_ref)) &
		call clear_matches(source_data%scan_point(i)%matching_ref_arr)
		elseif(has_role(target_data%role, ROLE_BACKGROUND)) then
		if(.not. associated( source_data%scan_point(i)%matching_bgr)) &
		call clear_matches(source_data%scan_point(i)%matching_bgr_arr)
		endif
		write(,)"TESTTAUMATCH 1 : clear ", i !!TEST!!
		! <<new <<
		target_loop: do j=1, target_data%number_of_points
		if (taupoint_match(source_data%scan_point(i), target_data%scan_point(j))) then
		! FIXME: implicit assumption that role is either ROLE_REFERENCE or ROLE_BACKGROUND HERE
		if(has_role(target_data%role, ROLE_REFERENCE)) then
		source_data%scan_point(i)%matching_ref => target_data%scan_point(j) ! >>new>> mm HERE
		source_data%scan_point(i)%matching_ref => target_data%scan_point(j)
		! >>new>> mm
		call add_matching_ptr(source_data%scan_point(i)%matching_ref_arr, &
		source_data%scan_point(i)%matching_ref )
		!!TEST!! write(,)"TESTTAUMATCH 2 : ref ", i, j, target_data%scan_point(j)%id, & !!TEST!!
		!!TEST!! source_data%scan_point(i)%matching_ref_arr(1)%ptr%id !!TEST!!
		!>TEST
		do l=1,size(source_data%scan_point(i)%matching_ref_arr)
		if(.not.associated(source_data%scan_point(i)%matching_ref_arr(l)%ptr)) then
		write(,) l, " not assoc"
		else
		write(,) l,source_data%scan_point(i)%matching_ref_arr(l)%ptr%id
		endif
		enddo
		!>TEST
		! <<new<<
		cmsg = 'res'
		else if(has_role(target_data%role, ROLE_BACKGROUND)) then
		source_data%scan_point(i)%matching_bgr => target_data%scan_point(j) ! >>new>> mm HERE
		source_data%scan_point(i)%matching_bgr => target_data%scan_point(j)
		! >>new>> mm
		call add_matching_ptr(source_data%scan_point(i)%matching_bgr_arr, &
		source_data%scan_point(i)%matching_bgr )
		! <<new<<
		cmsg = 'bgr'
		else
		cycle target_loop
		@@ -220,6 +251,7 @@ contains
		integer, intent(in) :: match_role
		!
		integer :: i, j
		integer :: l,lp ! TEST
		!
		source_loop: do i=1, scan_size
		if ( .not. is_valid_scan(scan_data(i)) ) cycle source_loop
		@@ -229,6 +261,19 @@ contains
		call tau_match_data(scan_data(i), scan_data(j))
		end if
		end do target_loop

		!>TEST
		!!TEST!! do l=1,size(scan_data(i)%scan_point(1)%matching_ref_arr)
		!!TEST!! do lp=1,scan_data(i)%number_of_points
		!!TEST!! if(.not.associated(scan_data(i)%scan_point(lp)%matching_ref_arr(l)%ptr)) then
		!!TEST!! write(,) "TEST TPMS",i, lp, l," not assoc"
		!!TEST!! else
		!!TEST!! write(,) "TEST TPMS", i, lp, l, scan_data(i)%scan_point(lp)%matching_ref_arr(l)%ptr%id
		!!TEST!! endif
		!!TEST!! enddo
		!!TEST!! enddo
		!>TEST

		end do source_loop
		end subroutine match_scans