consolidate pixel status & test functions (f2c735fe) · Commits · Zolnierczuk, Piotr / DrSPINE

sources/drspine_parameters.f90

+81 −29

Original line number	Diff line number	Diff line
		@@ -84,7 +84,7 @@ module drspine_parameters
		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
		integer, parameter :: PIXEL_COMBINATION_FAILED = INT(Z'008000') ! combination 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)
		@@ -480,68 +480,120 @@ CONTAINS
		end if
		end function cformat_fit_flag


		function is_pixel_ok(pixel_status, ignore_mask) result(res)
		logical :: res
		integer, intent(in) :: pixel_status
		logical, intent(in), optional :: ignore_mask
		!
		integer :: cmask
		cmask = NOT(PIXEL_OK)
		if (present(ignore_mask)) then
		if (ignore_mask) cmask = PIXEL_MASK_CLEAR
		end if
		res = IAND(pixel_status, cmask)==PIXEL_OK
		return
		end function is_pixel_ok



		!> function that formats the pixel status
		!! @param pixel_status pixel status flag
		function cformat_pixel_status(pixel_status) result(cresult)
		function cformat_pixel_status(pixel_status, short_format) result(cresult)
		character(len=MAX_LINE_LENGTH) :: cresult
		integer, intent(in) :: pixel_status
		logical, intent(in), optional :: short_format
		!
		character(len=MAX_LINE_LENGTH) :: ctmp
		integer :: clen
		logical :: short

		cresult = repeat(" ", MAX_LINE_LENGTH)
		ctmp = repeat(" ", MAX_LINE_LENGTH)
		short = .FALSE.
		if (present(short_format)) short = short_format

		if (pixel_status == PIXEL_OK) then
		cresult = "OK"
		return
		else if (short) then
		if(iand(pixel_status, PIXEL_STATISTICS )/=0) ctmp = trim(ctmp)//"C"
		if(iand(pixel_status, PIXEL_AMPLITUDE_RAW )/=0) ctmp = trim(ctmp)//"a"
		if(iand(pixel_status, PIXEL_AVERAGE_OUT_OF_BOUNDS )/=0) ctmp = trim(ctmp)//"A"
		if(iand(pixel_status, PIXEL_AVERAGE_INCONSISTENT )/=0) ctmp = trim(ctmp)//"U"
		!
		if(iand(pixel_status, PIXEL_FIT_FAILED )/=0) ctmp = trim(ctmp)//"F"
		if(iand(pixel_status, PIXEL_FIT_FAILED_CHISQUARED )/=0) ctmp = trim(ctmp)//"Q"
		if(iand(pixel_status, PIXEL_FIT_FAILED_AMPLITUDE )/=0) ctmp = trim(ctmp)//"l"
		if(iand(pixel_status, PIXEL_FIT_FAILED_NEGATIVE )/=0) ctmp = trim(ctmp)//"N"
		if(iand(pixel_status, PIXEL_FIT_FAILED_POSITIVE )/=0) ctmp = trim(ctmp)//"P"
		!
		if(iand(pixel_status, PIXEL_NO_RESOLUTION )/=0) ctmp = trim(ctmp)//"R"
		if(iand(pixel_status, PIXEL_NO_BACKGROUND )/=0) ctmp = trim(ctmp)//"B"
		if(iand(pixel_status, PIXEL_OFFSET_FAILED )/=0) ctmp = trim(ctmp)//"O"
		if(iand(pixel_status, PIXEL_COMBINATION_FAILED )/=0) ctmp = trim(ctmp)//"c"
		!
		if(iand(pixel_status, PIXEL_MASKED_TAU )/=0) ctmp = trim(ctmp)//"t"
		if(iand(pixel_status, PIXEL_MASKED_Q )/=0) ctmp = trim(ctmp)//"q"
		clen = len_trim(ctmp)
		write(cresult,'(a)') trim(ctmp)
		return
		else
		if(iand(pixel_status, PIXEL_STATISTICS )/=0) ctmp = trim(ctmp)//"not enough counts,"
		if(iand(pixel_status, PIXEL_AMPLITUDE_RAW )/=0) ctmp = trim(ctmp)//"raw amplitude,"
		if(iand(pixel_status, PIXEL_AVERAGE_OUT_OF_BOUNDS )/=0) ctmp = trim(ctmp)//"average is out of bounds,"
		if(iand(pixel_status, PIXEL_AVERAGE_INCONSISTENT )/=0) ctmp = trim(ctmp)//"average is not consistent with up/down,"
		!
		if(iand(pixel_status, PIXEL_FIT_FAILED )/=0) ctmp = trim(ctmp)//"fit failed,"
		if(iand(pixel_status, PIXEL_FIT_FAILED_CHISQUARED )/=0) ctmp = trim(ctmp)//"fit - chi2 too large,"
		if(iand(pixel_status, PIXEL_FIT_FAILED_AMPLITUDE )/=0) ctmp = trim(ctmp)//"fit - amplitude too small,"
		if(iand(pixel_status, PIXEL_FIT_FAILED_NEGATIVE )/=0) ctmp = trim(ctmp)//"fit - negative amplitude,"
		if(iand(pixel_status, PIXEL_FIT_FAILED_POSITIVE )/=0) ctmp = trim(ctmp)//"fit - negative amplitude,"
		!
		if(iand(pixel_status, PIXEL_NO_RESOLUTION )/=0) ctmp = trim(ctmp)//"no resolution,"
		if(iand(pixel_status, PIXEL_NO_BACKGROUND )/=0) ctmp = trim(ctmp)//"no background,"
		if(iand(pixel_status, PIXEL_OFFSET_FAILED )/=0) ctmp = trim(ctmp)//"offset failed,"
		end if
		if(iand(pixel_status, PIXEL_COMBINATION_FAILED )/=0) ctmp = trim(ctmp)//"combination failed,"
		!
		if(iand(pixel_status, PIXEL_MASKED_TAU )/=0) ctmp = trim(ctmp)//"masked tau,"
		if(iand(pixel_status, PIXEL_MASKED_Q )/=0) ctmp = trim(ctmp)//"masked q,"
		clen = len_trim(ctmp)
		write(cresult,'(a,1x,"(",z8,")")') ctmp(1:clen-1), pixel_status
		write(cresult,'(a,1x,"(0x",z0.8,")")') ctmp(1:clen-1), pixel_status
		return
		end if
		end function cformat_pixel_status




		!> function that formats the pixel status in a short string
		!! @param pixel_status pixel status flag
		function cformat_pixel_status_short(pixel_status) result(cresult)
		character(len=MAX_LINE_LENGTH) :: cresult
		integer, intent(in) :: pixel_status
		!
		character(len=MAX_LINE_LENGTH) :: ctmp

		cresult = repeat(" ", MAX_LINE_LENGTH)
		ctmp = repeat(" ", MAX_LINE_LENGTH)
		if (pixel_status == PIXEL_OK) then
		cresult = "OK"
		return
		else
		if(iand(pixel_status, PIXEL_NO_RESOLUTION )/=0) ctmp = trim(ctmp)//"R"
		if(iand(pixel_status, PIXEL_NO_BACKGROUND )/=0) ctmp = trim(ctmp)//"B"
		if(iand(pixel_status, PIXEL_OFFSET_FAILED )/=0) ctmp = trim(ctmp)//"O"

		if(iand(pixel_status, PIXEL_FIT_FAILED )/=0) ctmp = trim(ctmp)//"F"
		if(iand(pixel_status, PIXEL_FIT_FAILED_CHISQUARED )/=0) ctmp = trim(ctmp)//"Q"
		if(iand(pixel_status, PIXEL_FIT_FAILED_AMPLITUDE )/=0) ctmp = trim(ctmp)//"l"
		if(iand(pixel_status, PIXEL_FIT_FAILED_NEGATIVE )/=0) ctmp = trim(ctmp)//"N"

		if(iand(pixel_status, PIXEL_STATISTICS )/=0) ctmp = trim(ctmp)//"C"
		if(iand(pixel_status, PIXEL_AMPLITUDE_RAW )/=0) ctmp = trim(ctmp)//"a"
		if(iand(pixel_status, PIXEL_AVERAGE_OUT_OF_BOUNDS )/=0) ctmp = trim(ctmp)//"A"
		if(iand(pixel_status, PIXEL_AVERAGE_INCONSISTENT )/=0) ctmp = trim(ctmp)//"U"

		end if
		write(cresult,'(a)') trim(ctmp)
		! consolidate with the function above
		cresult = cformat_pixel_status(pixel_status, short_format=.TRUE.)

		!character(len=MAX_LINE_LENGTH) :: ctmp
		!cresult = repeat(" ", MAX_LINE_LENGTH)
		!ctmp = repeat(" ", MAX_LINE_LENGTH)
		!if (pixel_status == PIXEL_OK) then
		! cresult = "OK"
		! return
		!else
		! if(iand(pixel_status, PIXEL_NO_RESOLUTION )/=0) ctmp = trim(ctmp)//"R"
		! if(iand(pixel_status, PIXEL_NO_BACKGROUND )/=0) ctmp = trim(ctmp)//"B"
		! if(iand(pixel_status, PIXEL_OFFSET_FAILED )/=0) ctmp = trim(ctmp)//"O"
		! if(iand(pixel_status, PIXEL_FIT_FAILED )/=0) ctmp = trim(ctmp)//"F"
		! if(iand(pixel_status, PIXEL_FIT_FAILED_CHISQUARED )/=0) ctmp = trim(ctmp)//"Q"
		! if(iand(pixel_status, PIXEL_FIT_FAILED_AMPLITUDE )/=0) ctmp = trim(ctmp)//"l"
		! if(iand(pixel_status, PIXEL_FIT_FAILED_NEGATIVE )/=0) ctmp = trim(ctmp)//"N"
		! if(iand(pixel_status, PIXEL_STATISTICS )/=0) ctmp = trim(ctmp)//"C"
		! if(iand(pixel_status, PIXEL_AMPLITUDE_RAW )/=0) ctmp = trim(ctmp)//"a"
		! if(iand(pixel_status, PIXEL_AVERAGE_OUT_OF_BOUNDS )/=0) ctmp = trim(ctmp)//"A"
		! if(iand(pixel_status, PIXEL_AVERAGE_INCONSISTENT )/=0) ctmp = trim(ctmp)//"U"
		!end if
		!write(cresult,'(a)') trim(ctmp)
		end function cformat_pixel_status_short

		end module drspine_parameters

tests/testbase.f90

+34 −13

Original line number	Diff line number	Diff line
		@@ -12,11 +12,11 @@ program testdata

		call loginit(LOG_TRACE, file_level=LOG_OFF)
		call test_parameters
		call test_data_sizes
		call test_constants
		call test_value_struct
		call test_namedvalue_struct
		call test_datetime
		!call test_data_sizes
		!call test_constants
		!call test_value_struct
		!call test_namedvalue_struct
		!call test_datetime

		contains

		@@ -51,14 +51,35 @@ 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)
		write(,) '== PIXEL_FORMAT'
		write(*,"(a16,1x,a)") "pixel ok:" , trim(cformat_pixel_status(PIXEL_OK))
		write(*,"(a16,1x,a)") "pixel not ok:" , trim(cformat_pixel_status(IOR(PIXEL_OK,PIXEL_FIT_FAILED)))
		write(*,"(a16,1x,a)") "pixel not ok:" , trim(cformat_pixel_status(IOR(PIXEL_OK,PIXEL_MASKED_TAU)))
		write(*,"(a16,1x,a)") "pixel not ok:" , trim(cformat_pixel_status(IOR(PIXEL_OK,&
		IOR(PIXEL_FIT_FAILED,PIXEL_MASKED_Q))))

		write(,) '== PIXEL_FORMAT/SHORT'
		write(*,"(a16,1x,a)") "pixel ok:" , trim(cformat_pixel_status_short(PIXEL_OK))
		write(*,"(a16,1x,a)") "pixel not ok:" , trim(cformat_pixel_status_short(IOR(PIXEL_OK,PIXEL_FIT_FAILED)))
		write(*,"(a16,1x,a)") "pixel not ok:" , trim(cformat_pixel_status_short(IOR(PIXEL_OK,PIXEL_MASKED_TAU)))
		write(*,"(a16,1x,a)") "pixel not ok:" , trim(cformat_pixel_status_short(IOR(PIXEL_OK,&
		IOR(PIXEL_FIT_FAILED,PIXEL_MASKED_Q))))

		write(,) '== PIXEL_STATUS'
		write(*,"(a16,1x,l1)") "pixel_ok T?" , is_pixel_ok(PIXEL_OK)
		write(*,"(a16,1x,l1)") "pixel_ok F?" , is_pixel_ok(IOR(PIXEL_OK, PIXEL_FIT_FAILED))
		write(*,"(a16,1x,l1)") "pixel_ok F?" , is_pixel_ok(IOR(PIXEL_OK, PIXEL_MASKED_Q))
		write(*,"(a16,1x,l1)") "pixel_ok T?" , is_pixel_ok(IOR(PIXEL_OK, PIXEL_MASKED_Q), ignore_mask=.TRUE.)

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



		end subroutine test_parameters