do not use (bb6e678d) · Commits · Zolnierczuk, Piotr / DrSPINE

sources/drspine.f90

+50 −18

Original line number	Diff line number	Diff line
		@@ -1451,7 +1451,6 @@ CONTAINS
		end if
		end subroutine cmd_moni


		!-------------------------------------------------------------
		!> Implementation COMMAND: group
		!! Examples:
		@@ -1464,6 +1463,8 @@ CONTAINS
		! call unused( 1, 1, 1, ier)
		!end subroutine cmd_group



		!-------------------------------------------------------------
		!> COMMAND: mask
		!! mask [options] - mask pixel or tau
		@@ -1496,11 +1497,13 @@ CONTAINS
		integer, parameter :: E_PIX = 1,&
		E_TAU = 2,&
		E_QVEC = 4
		logical :: do_set, do_win, do_ring
		logical :: do_set, do_clear, do_win, do_ring
		integer :: iwhat
		integer :: ival, itau, irun
		integer :: inew, i
		real(kind=SGL), dimension(4) :: xmask ! pixel mask limits
		real(kind=DBL), dimension(6) :: qmask ! q-vector mask qx, qy, qz
		real(kind=DBL), dimension(3) :: dqmask ! q-vector mask dqx, dqy,dqz
		!
		!do_pix = .false.
		!do_tau = .false.
		@@ -1566,34 +1569,33 @@ CONTAINS
		call msg_info("drspine/mask", 'mask - no data in memory')
		exit case_what
		end if

		do_set = found('set')
		do_clear = found('clear')
		if (do_set .and. do_clear ) then
		call msg_warning("drspine/mask", 'mask - set and clear are mutually exclusive')
		exit case_what
		end if
		irun = get_named_value('run', irun, inew)
		if (found('set')) then

		if (do_set) then
		itau = get_named_value('set', itau, inew)
		ival = SCAN_MASKED
		do i=1, data_manager_size()
		if ( .not. is_valid_scan(data_scan(i)) ) cycle
		if ( data_scan(i)%id /= irun ) cycle
		data_scan(i)%scan_point(itau)%flag = ival
		call mask_tau_set(data_scan(i), itau)
		enddo
		else if (found('clear')) then
		else if (do_clear) then
		itau = get_named_value('clear', itau, inew)
		ival = SCAN_OK
		do i=1, data_manager_size()
		if ( .not. is_valid_scan(data_scan(i)) ) cycle
		if ( data_scan(i)%id /= irun ) cycle
		data_scan(i)%scan_point(itau)%flag = ival
		call mask_tau_clear(data_scan(i), itau)
		enddo
		else
		do i=1, data_manager_size()
		if ( .not. is_valid_scan(data_scan(i)) ) cycle
		write(output_unit,'(i3,":",i8,1x,a,"(",i3,") \|",a,"\| mode=",a9," role=",a10)') &
		i, data_scan(i)%id, &
		data_scan(i)%file(1:12), &
		data_scan(i)%number_of_points, &
		data_scan(i)%name(1:12), &
		cformat_mode(data_scan(i)%mode), &
		cformat_role(data_scan(i)%role)
		call print_details(data_scan(i), output_unit)
		call mask_tau_list(data_scan(i), i)
		enddo
		end if
		!! -------------------------------------------------------------------------
		@@ -1605,7 +1607,37 @@ CONTAINS
		exit case_what
		end if

		call msg_warning("drspine/mask", 'mask - q mask not yet implemented')
		do_set = found('set')
		do_clear = found('clear')
		if (do_set .and. do_clear ) then
		call msg_warning("drspine/mask", 'mask - set and clear are mutually exclusive')
		exit case_what
		end if

		if (do_set) then
		qmask(1) = rparf(1)
		dqmask(1) = rparf(2)
		qmask(2) = rparf(3)
		dqmask(2) = rparf(4)
		qmask(3) = rparf(5)
		dqmask(3) = rparf(6)
		do i=1, data_manager_size()
		if ( .not. is_valid_scan(data_scan(i)) ) cycle
		if ( data_scan(i)%id /= irun ) cycle
		call mask_qvec_set(data_scan(i), qmask, dqmask)
		enddo
		else if (do_clear) then
		do i=1, data_manager_size()
		if ( .not. is_valid_scan(data_scan(i)) ) cycle
		if ( data_scan(i)%id /= irun ) cycle
		call mask_qvec_clear(data_scan(i))
		enddo
		else
		do i=1, data_manager_size()
		if ( .not. is_valid_scan(data_scan(i)) ) cycle
		call mask_qvec_list(data_scan(i))
		enddo
		end if
		!! -------------------------------------------------------------------------
		!! default case (warning)
		!! -------------------------------------------------------------------------

sources/drspine_parameters.f90

+20 −14

Original line number	Diff line number	Diff line
		@@ -72,20 +72,25 @@ module drspine_parameters
		integer, parameter :: GROUP_INVALID = -1
		integer, parameter :: GROUP_DEFAULT = 0 !
		! pixel flags
		integer, parameter :: PIXEL_OK = INT(Z'0000') ! pixel ok (implied)
		integer, parameter :: PIXEL_STATISTICS = INT(Z'0001') ! not enough statistics
		integer, parameter :: PIXEL_AMPLITUDE_RAW = INT(Z'0002') ! raw echo amplitude too small
		integer, parameter :: PIXEL_AVERAGE_OUT_OF_BOUNDS = INT(Z'0004') ! signal average is out of bounds
		integer, parameter :: PIXEL_AVERAGE_INCONSISTENT = INT(Z'0008') ! signal average is not consistent with up/down average
		integer, parameter :: PIXEL_FIT_FAILED = INT(Z'0010') ! fit failed
		integer, parameter :: PIXEL_FIT_FAILED_CHISQUARED = INT(Z'0020') ! fit failed (chisquare)
		integer, parameter :: PIXEL_FIT_FAILED_AMPLITUDE = INT(Z'0040') ! fit echo amplitude too small
		integer, parameter :: PIXEL_FIT_FAILED_NEGATIVE = INT(Z'0100') ! fit echo amplitude negative (when positive is required)
		integer, parameter :: PIXEL_FIT_FAILED_POSITIVE = INT(Z'0200') ! fit echo amplitude positive (when negative is required)
		integer, parameter :: PIXEL_NO_RESOLUTION = INT(Z'1000') ! no resolution for pixel
		integer, parameter :: PIXEL_NO_BACKGROUND = INT(Z'2000') ! no background for pixel
		integer, parameter :: PIXEL_OFFSET_FAILED = INT(Z'4000') ! offset optimization failed
		integer, parameter :: PIXEL_COMBINATION_FAILED = INT(Z'8000') ! offset optimization failed
		integer, parameter :: PIXEL_OK = INT(Z'000000') ! pixel ok (implied)
		integer, parameter :: PIXEL_STATISTICS = INT(Z'000001') ! not enough statistics
		integer, parameter :: PIXEL_AMPLITUDE_RAW = INT(Z'000002') ! raw echo amplitude too small
		integer, parameter :: PIXEL_AVERAGE_OUT_OF_BOUNDS = INT(Z'000004') ! signal average is out of bounds
		integer, parameter :: PIXEL_AVERAGE_INCONSISTENT = INT(Z'000008') ! signal average is not consistent with up/down average
		integer, parameter :: PIXEL_FIT_FAILED = INT(Z'000010') ! fit failed
		integer, parameter :: PIXEL_FIT_FAILED_CHISQUARED = INT(Z'000020') ! fit failed (chisquare)
		integer, parameter :: PIXEL_FIT_FAILED_AMPLITUDE = INT(Z'000040') ! fit echo amplitude too small
		integer, parameter :: PIXEL_FIT_FAILED_NEGATIVE = INT(Z'000100') ! fit echo amplitude negative (when positive is required)
		integer, parameter :: PIXEL_FIT_FAILED_POSITIVE = INT(Z'000200') ! fit echo amplitude positive (when negative is required)
		integer, parameter :: PIXEL_NO_RESOLUTION = INT(Z'001000') ! no resolution for pixel
		integer, parameter :: PIXEL_NO_BACKGROUND = INT(Z'002000') ! no background for pixel
		integer, parameter :: PIXEL_OFFSET_FAILED = INT(Z'004000') ! offset optimization failed
		integer, parameter :: PIXEL_COMBINATION_FAILED = INT(Z'008000') ! offset optimization failed
		! ! masks bits 16-23
		integer, parameter :: PIXEL_MASKED_TAU = INT(Z'010000') ! pixel masked (tau)
		integer, parameter :: PIXEL_MASKED_Q = INT(Z'020000') ! pixel masked (q)
		integer, parameter :: PIXEL_MASK_ISSET = INT(Z'FF0000') ! convenience flag to test if mask is set
		integer, parameter :: PIXEL_MASK_CLEAR = INT(Z'00FFFF') ! convenience flag to clear mask
		! scan flags
		integer, parameter :: SCAN_OK = INT(Z'0000') ! scan ok (implied)
		integer, parameter :: SCAN_MASKED = INT(Z'0008') ! scan masked
		@@ -370,6 +375,7 @@ CONTAINS
		end function get_data_role



		!> add fit flag
		function add_fit_flag(cflag, myflag) result(res)
		!----------------------------------

sources/reduce_data.f90

+95 −0

Original line number	Diff line number	Diff line
		@@ -5,6 +5,7 @@ module reduce_data
		use iso_fortran_env, only : output_unit !, error_unit
		use constants_module
		use data_types
		use dump_data
		use instrument_config

		implicit none
		@@ -17,6 +18,9 @@ module reduce_data
		public :: collect_resolution
		public :: direct_bgr_subtraction
		public :: collect_stats
		!
		public :: mask_tau_set, mask_tau_clear, mask_tau_list
		public :: mask_qvec_set, mask_qvec_clear, mask_qvec_list

		contains

		@@ -638,4 +642,95 @@ bgr_pixel_bin(l)
		close(iunit)
		end subroutine dump_sqt_collection


		! ===================================================================================================
		! tau and q masking goes here (for now)
		! ===================================================================================================
		subroutine mask_tau_set(data_scan, itau)
		type(scan_struct), intent(inout) :: data_scan
		integer, intent(in) :: itau
		!
		associate(scan_pt => data_scan%scan_point(itau))
		scan_pt%flag = SCAN_MASKED !! this is for "display purpose"
		scan_pt%pixelbin%status = IOR(scan_pt%pixelbin%status, PIXEL_MASKED_TAU)
		end associate
		end subroutine mask_tau_set

		subroutine mask_tau_clear(data_scan, itau)
		type(scan_struct), intent(inout) :: data_scan
		integer, intent(in) :: itau
		!
		associate(scan_pt => data_scan%scan_point(itau))
		scan_pt%flag = SCAN_OK !! this is for "display purpose"
		scan_pt%pixelbin%status = IAND(scan_pt%pixelbin%status, NOT(PIXEL_MASKED_TAU))
		end associate
		end subroutine mask_tau_clear

		subroutine mask_tau_list(data_scan, id)
		type(scan_struct), intent(in) :: data_scan
		integer, intent(in) :: id
		write(output_unit,'(i3,":",i8,1x,a,"(",i3,") \|",a,"\| mode=",a9," role=",a10)') &
		id,&
		data_scan%id, &
		data_scan%file(1:12), &
		data_scan%number_of_points, &
		data_scan%name(1:12), &
		cformat_mode(data_scan%mode), &
		cformat_role(data_scan%role)
		call print_details(data_scan, output_unit)
		end subroutine mask_tau_list

		subroutine mask_qvec_set(data_scan, qmask, dqmask)
		type(scan_struct), intent(inout) :: data_scan
		real(kind=DBL), dimension(3), intent(in) :: qmask
		real(kind=DBL), dimension(3), intent(in) :: dqmask
		!
		real(kind=DBL), dimension(3) :: dq
		integer :: iscan, it, ix, iy
		do iscan=1, data_scan%number_of_points
		associate(scan_point => data_scan%scan_point(iscan))
		do it=1, scan_point%no_lam
		do ix=1, scan_point%no_xpix
		do iy=1, scan_point%no_ypix
		dq = ABS(scan_point%pixelbin(it, ix, iy)%Q_vec - qmask)
		if ( ANY( dq .gt. dqmask) ) &
		scan_point%pixelbin(it, ix, iy)%status = IOR(scan_point%pixelbin(it, ix, iy)%status, PIXEL_MASKED_Q)
		end do
		end do
		end do
		end associate
		end do
		end subroutine mask_qvec_set

		subroutine mask_qvec_clear(data_scan)
		type(scan_struct), intent(inout) :: data_scan
		!
		integer :: iscan
		do iscan=1, data_scan%number_of_points
		associate(scan_point => data_scan%scan_point(iscan))
		scan_point%pixelbin%status = IAND(scan_point%pixelbin%status, NOT(PIXEL_MASKED_Q))
		end associate
		end do
		end subroutine mask_qvec_clear

		subroutine mask_qvec_list(data_scan)
		type(scan_struct), intent(inout) :: data_scan
		!
		integer :: iscan, it, ix, iy
		do iscan=1, data_scan%number_of_points
		associate(scan_point => data_scan%scan_point(iscan))
		do it=1, scan_point%no_lam
		do ix=1, scan_point%no_xpix
		do iy=1, scan_point%no_ypix
		if (IAND(scan_point%pixelbin(it, ix, iy)%status, PIXEL_MASKED_Q) /= 0 ) then
		print *, data_scan%id, iscan, it, ix, iy, 'is masked'
		end if
		end do
		end do
		end do
		end associate
		end do
		end subroutine mask_qvec_list


		end module reduce_data

tests/testbase.f90

+9 −0

Original line number	Diff line number	Diff line
		@@ -47,6 +47,15 @@ contains
		write(,) "add flag: smooth ", add_fit_flag("smooth",0)
		write(,) "add flag: default ", add_fit_flag("default",0)

		write(,) '== PIXEL_FLAG'
		write(*,"(a16,z8)") "pixel_ok" , PIXEL_OK
		write(*,"(a16,z8)") "pixel_masked_q" , IOR (PIXEL_OK, PIXEL_MASKED_Q)
		write(*,"(a16,z8)") "pixel_ok" , IAND(PIXEL_OK, PIXEL_MASK_CLEAR)
		write(*,"(a16,z8)") "pixel_masked_tau" , IOR (PIXEL_OK, PIXEL_MASKED_TAU)
		write(*,"(a16,z8)") "pixel_ok" , IAND(PIXEL_OK, NOT(PIXEL_MASKED_TAU))
		write(*,"(a16,z8)") "pixel_masked_q\|tau", IOR (PIXEL_OK, IOR(PIXEL_MASKED_TAU, PIXEL_MASKED_Q))
		write(*,"(a16,z8)") "pixel_ok" , IAND(PIXEL_OK, PIXEL_MASK_CLEAR)


		end subroutine test_parameters

tests/testdrspine.sh

+14 −2

Original line number	Diff line number	Diff line
		@@ -11,8 +11,20 @@ if [ $? -eq 0 ]; then echo "drspine run OK"; fi
		# verify
		diff -wubq ./last_sqt.dat macro_test.last_sqt.dat.1_0
		if [ $? -eq 0 ]; then echo "last_sqt.dat OK"; fi
		diff -wubq ./last_sqt_bin.dat macro_test.last_sqt_bin.dat.1_0
		if [ $? -eq 0 ]; then echo "last_sqt_bin.dat OK"; fi

		# we kept adding to the bin file
		#diff -wubq ./last_sqt_bin.dat macro_test.last_sqt_bin.dat.1_0
		clen=216 # line length of the old last_sqt_bin.dat
		file1=`mktemp`
		file2=`mktemp`
		cut -c 1-${clen} ./last_sqt_bin.dat > $file1
		cut -c 1-${clen} ./macro_test.last_sqt_bin.dat.1_0 > $file2
		# verify
		diff -wubq $file1 $file2
		if [ $? -eq 0 ]; then
		echo "last_sqt_bin.dat OK";
		rm -f $file1 $file2
		fi

		# return to previous directory
		cd -