first take at tau mask (84e1a2b2) · Commits · Zolnierczuk, Piotr / DrSPINE

sources/data_types.f90

+9 −4

Original line number	Diff line number	Diff line
		@@ -200,7 +200,9 @@ module data_types
		integer :: no_magnetic_sensors
		end type environment_parameters_struct

		!--------------------------------------------------------------------------------------------
		!> array pointer type (new mm)
		!! we need this as Fortran does not have a notion of array of pointers (paz)
		! >>new>>
		type scan_data_struct_pointer
		type(scan_data_struct), pointer :: ptr => null()
		@@ -214,24 +216,26 @@ module data_types
		!! @note
		!! It is the central feature of the new concept to have a
		!! pixel(binned) wise representation of the phase scans
		!! @note
		!! 2. This structure correspond to single tau data for a standard NSE scan.
		type scan_data_struct
		integer :: id ! id of the "parent" scan
		integer :: point ! scan point (self)
		integer :: flag ! flag
		integer :: no_xpix
		integer :: no_ypix
		integer :: no_lam
		integer :: no_phases
		integer :: no_mon ! number of actual monitors

		!! TODO: merge these (i.e. matching_ref and matching_ref_arr)
		type(scan_data_struct), pointer :: matching_ref => null() ! matching resolution (reference)
		type(scan_data_struct), pointer :: matching_bgr => null() ! matching bac
		type(scan_data_struct), pointer :: matching_cal => null() ! matching calibration

		! >>new>>
		type(scan_data_struct_pointer), dimension(MAX_NO_OF_MATCHES) :: matching_ref_arr ! new replaces single ptr
		type(scan_data_struct_pointer), dimension(MAX_NO_OF_MATCHES) :: matching_bgr_arr ! nullify at clear or
		type(scan_data_struct_pointer), dimension(MAX_NO_OF_MATCHES) :: matching_cal_arr ! beginning of matching
		! <<new<<

		type(spectrum_struct), dimension(0:MAX_NO_MONITORS) :: spectrum !0: detector, 1.. monitors
		type(technical_parameters_struct) :: technical !PAZ
		@@ -725,6 +729,7 @@ CONTAINS
		this%no_mon = 0
		this%id = 0
		this%point = 0
		this%flag = SCAN_OK

		nullify(this%matching_ref)
		nullify(this%matching_bgr)

sources/drspine.f90

+89 −53

Original line number	Diff line number	Diff line
		@@ -1441,75 +1441,111 @@ CONTAINS

		!-------------------------------------------------------------
		!> COMMAND: mask
		!! mask [options] - mask pixel
		!! mask [options] - mask pixel or tau
		!-------------------------------------------------------------
		!! mask [show]
		!! mask pix [show]
		!! - show mask
		!! mask set [val value]
		!! mask pix set [val value]
		!! - set all pixels to mask value (default 0=enable)
		!! mask [set] win x1 x2 y1 y2 [val v]
		!! mask pix win x1 x2 y1 y2 [val value]
		!! - set a rectangular mask
		!! mask [set] ring x0 y0 r1 r2 [val v]
		!! mask pix ring x0 y0 r1 r2 [val value]
		!! - set a ring mask with center (x0,y0) and inner/outer radius r1/r2
		!!
		!! mask tau [show]
		!!
		!! mask tau set [itau] run [numor] [clear]
		!! - set tau mask
		subroutine cmd_mask()
		logical :: do_show, do_set, do_win, do_ring
		integer :: val, inew, i
		real(kind=SGL), dimension(4) :: xmask ! mask limits

		do_show = .true.
		logical :: do_pix, do_tau
		logical :: do_set, do_win, do_ring
		integer :: ival, itau, irun
		integer :: inew, i
		real(kind=SGL), dimension(4) :: xmask ! pixel mask limits
		!
		do_pix = .false.
		do_tau = .false.
		! pixel flags
		do_set = .false.
		do_win = .false.
		do_ring = .false.
		val = 0
		!
		ival = 0
		itau = 0
		irun = int(program_param%last_run)
		xmask = 0

		do_set = found('set')
		do_win = found('win')
		do_ring = found('ring')
		val = get_named_value('val', val, inew)
		do_pix = found('pix')
		do_tau = found('tau')

		if ( do_win .and. do_ring ) then
		call msg_error('drspine/mask', 'mask ring and win are mutually exclusive', ERROR_OPTION_SYNTAX)
		if ( do_pix .and. do_tau) then
		call msg_error('drspine/mask', 'mask pix(el) and tau are mutually exclusive', ERROR_OPTION_SYNTAX)
		return
		endif

		if ( do_win.or.do_ring.or.do_set ) then
		do_show = .false.
		end if

		if ( do_show ) then
		call print_detector_mask(instrument_parameters%detector,output_unit)
		return
		end if
		! process pixel mask
		if (do_pix) then
		do_set = found('set')
		do_win = found('win')
		do_ring = found('ring')
		ival = get_named_value('val', ival, inew)
		! check parameters
		!if ( do_win .and. do_ring ) then
		! call msg_error('drspine/mask', 'mask ring and win are mutually exclusive', ERROR_OPTION_SYNTAX)
		! return
		!end if

		! set a rectangular mask
		if ( do_win ) then
		if ( do_win ) then ! set a rectangular mask
		if (iparf()<4) then
		call msg_error('drspine/mask', 'mask win - need 4 window parameters (x1,y1,x2,y2)', ERROR_OPTION_ARG)
		else
		do i=1,4
		xmask(i) = real(rparf(i), kind=SGL)
		end do
		call set_detector_mask(instrument_parameters%detector, 'win', val, xmask)
		call set_detector_mask(instrument_parameters%detector, 'win', ival, xmask)
		end if
		return
		end if

		! set a ring mask
		if ( do_ring ) then
		else if ( do_ring ) then ! set a ring mask
		if (iparf()<4) then
		call msg_error('drspine/mask', 'mask ring - need 4 ring parameters (x0,y0,r1,r2)', ERROR_OPTION_ARG)
		else
		do i=1,4
		xmask(i) = real(rparf(i), kind=SGL)
		end do
		call set_detector_mask(instrument_parameters%detector, 'ring', val, xmask)
		call set_detector_mask(instrument_parameters%detector, 'ring', ival, xmask)
		end if
		return
		else if ( do_set ) then ! set to a constant value
		call set_detector_mask(instrument_parameters%detector, 'const', ival, xmask)
		else
		call print_detector_mask(instrument_parameters%detector,output_unit)
		end if

		! set to a constant value
		call set_detector_mask(instrument_parameters%detector, 'const', val, xmask)
		else if (do_tau) then
		itau = get_named_value('set', itau, inew)
		print *, inew, itau
		if (inew>0) then
		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)%number_of_points, &
		data_scan(i)%scan_point(itau)%flag = SCAN_MASKED
		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)
		enddo
		endif
		else
		call msg_warning("drspine/mask", 'mask - need at least one of pix or tau')
		end if
		call unused( icmdus=1, ivnuse=1, irpuse=1, iretus=iunused)

		end subroutine cmd_mask

sources/drspine_parameters.f90

+5 −3

Original line number	Diff line number	Diff line
		@@ -71,7 +71,7 @@ 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
		@@ -86,8 +86,10 @@ module drspine_parameters
		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

		!
		! scan flags
		integer, parameter :: SCAN_OK = INT(Z'0000') ! scan ok (implied)
		integer, parameter :: SCAN_MASKED = INT(Z'0008') ! scan masked
		! phase fit flags
		integer, parameter :: PHASE_USE = INT(Z'000000') ! use given phase (do not fit)
		integer, parameter :: PHASE_FIT = INT(Z'000001') ! fit phase (full wavelength band)
		integer, parameter :: PHASE_FIT_HOPPING = INT(Z'000002') ! fit phase (full wavelength band) with "hopping"

sources/dump_data.f90

+139 −134

Original line number	Diff line number	Diff line
		@@ -593,6 +593,7 @@ contains
		integer, dimension(-7:7) :: j_histo
		logical :: do_histo
		integer :: kbin, isc1, isc2
		integer :: iflag

		do_histo = .false.
		if (present(show_histo)) then
		@@ -620,8 +621,6 @@ contains
		endif
		end if



		if(isc1 == 1) then
		!! write header
		write(kout,'(1x,a3)' ,advance='no') " # "
		@@ -649,18 +648,20 @@ contains
		endif

		isc: do iscan=isc1, isc2
		nx = scan_data%scan_point(iscan)%no_xpix
		ny = scan_data%scan_point(iscan)%no_ypix
		nt = scan_data%scan_point(iscan)%spectrum(0)%no_lambda_bins
		nl = scan_data%scan_point(iscan)%no_lam
		! lam1 = scan_data%scan_point(iscan)%spectrum(0)%lambda_bin(1)
		! lam2 = scan_data%scan_point(iscan)%spectrum(0)%lambda_bin(nt)
		associate(cur_point => scan_data%scan_point(iscan))
		nx = cur_point%no_xpix
		ny = cur_point%no_ypix
		nt = cur_point%spectrum(0)%no_lambda_bins
		nl = cur_point%no_lam
		! lam1 = cur_point%spectrum(0)%lambda_bin(1)
		! lam2 = cur_point%spectrum(0)%lambda_bin(nt)
		lam1 = scan_data % scan_point(iscan) % pixelbin(kbin,1,1) % lambda_1
		lam2 = scan_data % scan_point(iscan) % pixelbin(kbin,1,1) % lambda_2
		j0 = scan_data%scan_point(iscan)%physics%field_integral%value
		theta = RAD2DEG(scan_data%scan_point(iscan)%physics%scattering_angle%value)
		temp = scan_data%scan_point(iscan)%technical%sample_temperature%value
		dj_symm = scan_data%scan_point(iscan)%pixelbin(kbin,nx/2,ny/2)%delta_J_symm%value
		j0 = cur_point%physics%field_integral%value
		theta = RAD2DEG(cur_point%physics%scattering_angle%value)
		temp = cur_point%technical%sample_temperature%value
		dj_symm = cur_point%pixelbin(kbin,nx/2,ny/2)%delta_J_symm%value
		iflag = cur_point%flag

		nactive = 0
		dj_ave = 0
		@@ -669,12 +670,12 @@ isc: do iscan=isc1, isc2
		ave = 0
		pl1: do ix=1,nx
		do iy=1,ny
		if(scan_data%scan_point(iscan)%pixelbin(kbin, ix, iy)%status.eq.PIXEL_OK ) then
		if(cur_point%pixelbin(kbin, ix, iy)%status.eq.PIXEL_OK ) then
		nactive = nactive + 1
		dj_ave = dj_ave + scan_data%scan_point(iscan)%pixelbin(kbin,ix,iy)%delta_J_symm%value
		dj_var = dj_var + scan_data%scan_point(iscan)%pixelbin(kbin,ix,iy)%delta_J_symm%value**2
		amp = amp + scan_data%scan_point(iscan)%pixelbin(kbin,ix,iy)%amplitude%value
		ave = ave + scan_data%scan_point(iscan)%pixelbin(kbin,ix,iy)%average%value
		dj_ave = dj_ave + cur_point%pixelbin(kbin,ix,iy)%delta_J_symm%value
		dj_var = dj_var + cur_point%pixelbin(kbin,ix,iy)%delta_J_symm%value**2
		amp = amp + cur_point%pixelbin(kbin,ix,iy)%amplitude%value
		ave = ave + cur_point%pixelbin(kbin,ix,iy)%average%value
		endif
		enddo
		enddo pl1
		@@ -690,8 +691,8 @@ isc: do iscan=isc1, isc2

		pl2: do ix=1,nx
		do iy=1,ny
		if(scan_data%scan_point(iscan)%pixelbin(kbin, ix, iy)%status.eq.PIXEL_OK ) then
		djj = scan_data%scan_point(iscan)%pixelbin(kbin,ix,iy)%delta_J_symm%value - dj_ave
		if(cur_point%pixelbin(kbin, ix, iy)%status.eq.PIXEL_OK ) then
		djj = cur_point%pixelbin(kbin,ix,iy)%delta_J_symm%value - dj_ave
		ijj = nint(djj*1d6)
		if(ijj < lbound(j_histo,1)) ijj = lbound(j_histo,1)
		if(ijj > ubound(j_histo,1)) ijj = ubound(j_histo,1)
		@@ -700,32 +701,36 @@ isc: do iscan=isc1, isc2
		enddo
		enddo pl2


		write(kout,'(1x,i3)' ,advance='no') iscan
		write(kout,'(1x,f12.2)' ,advance='no') J0*1d6
		if (iflag==SCAN_OK) then
		write(kout,'(1x)' ,advance='no')
		else
		write(kout,'(a1)' ,advance='no') 'M'
		endif
		write(kout,'(i3)' ,advance='no') iscan
		write(kout,'(1x,f12.2)' ,advance='no') J0/UTESLA ! uTm
		write(kout,'(1x,f6.2)' ,advance='no') theta
		! write(kout,'(1x,f8.3)' ,advance='no') temp
		write(kout,'(1x,i3)' ,advance='no') nl
		write(kout,'(1x,i4)' ,advance='no') nx*ny
		write(kout,'(1x,i4)' ,advance='no') nactive
		write(kout,'(1x,es12.5)' ,advance='no') scan_data%scan_point(iscan)%pixelbin(kbin,nx/2,ny/2)%average%value&
		write(kout,'(1x,es12.5)' ,advance='no') cur_point%pixelbin(kbin,nx/2,ny/2)%average%value&
		* intensity_scale_pixel
		write(kout,'(1x,es12.5)' ,advance='no') ave * intensity_scale_pixel
		write(kout,'(1x,es12.5)' ,advance='no') amp * intensity_scale_pixel
		write(kout,'(1x,f8.4)' ,advance='no') dj_symm/MICRO_
		write(kout,'(1x,f8.4)' ,advance='no') dj_ave/MICRO_
		write(kout,'(1x,f8.4)' ,advance='no') dj_var/MICRO_
		write(kout,'(1x,f8.4)' ,advance='no') dj_symm/UTESLA ! uTm
		write(kout,'(1x,f8.4)' ,advance='no') dj_ave/UTESLA ! uTm
		write(kout,'(1x,f8.4)' ,advance='no') dj_var/UTESLA ! uTm
		write(kout,'(1x,f8.3)' ,advance='no') lam1/ANGSTROEM
		write(kout,'(1x,f8.3)' ,advance='no') lam2/ANGSTROEM
		if (associated(scan_data%scan_point(iscan)%matching_ref)) then
		write(kout,'(1x,i6,1x,i2)',advance='no') scan_data%scan_point(iscan)%matching_ref%id,&
		scan_data%scan_point(iscan)%matching_ref%point
		if (associated(cur_point%matching_ref)) then
		write(kout,'(1x,i6,1x,i2)',advance='no') cur_point%matching_ref%id,&
		cur_point%matching_ref%point
		else
		write(kout,'(1x,a6,1x,a2)',advance='no') '--','--'
		end if
		if (associated(scan_data%scan_point(iscan)%matching_bgr)) then
		write(kout,'(1x,i6,1x,i2)',advance='no') scan_data%scan_point(iscan)%matching_bgr%id,&
		scan_data%scan_point(iscan)%matching_bgr%point
		if (associated(cur_point%matching_bgr)) then
		write(kout,'(1x,i6,1x,i2)',advance='no') cur_point%matching_bgr%id,&
		cur_point%matching_bgr%point
		else
		write(kout,'(1x,a6,1x,a2)',advance='no') '--','--'
		end if
		@@ -737,7 +742,7 @@ isc: do iscan=isc1, isc2
		write(kout,'(a)' ,advance='no') "\|"
		end if
		write(kout,*)

		end associate
		enddo isc

sources/geometry_types.f90

+18 −5

Original line number	Diff line number	Diff line
		@@ -188,10 +188,10 @@ contains
		do j=1, size(this%pixel,2)
		write(iunit, '(1x,i3,1x)', advance='no') j
		do i=1, size(this%pixel,1)
		if(this%mask(i,j)/=0) then
		if(this%mask(i,j)>0) then
		write(iunit,'(i2)', advance='no') this%mask(i,j)
		else
		write(iunit,'(a2)', advance='no') '__'
		write(iunit,'(a2)', advance='no') '--'
		end if
		end do
		write(iunit,*)
		@@ -219,7 +219,15 @@ contains
		y1 = max(int(lims(2)),1)
		x2 = min(int(lims(3)),size(this%pixel,1))
		y2 = min(int(lims(4)),size(this%pixel,2))
		if (val>=0) then
		this%mask(x1:x2,y1:y2) = val
		else
		! set the complement
		this%mask(x2+1: , : ) = abs(val)
		this%mask( :x1-1, : ) = abs(val)
		this%mask( : ,y2+1: ) = abs(val)
		this%mask( : , :y1-1) = abs(val)
		end if
		case('ring')
		! ring
		x0 = lims(1)
		@@ -229,8 +237,13 @@ contains
		do i=1, size(this%pixel,1)
		do j=1, size(this%pixel,2)
		r = sqrt((i-x0)2 + (j-y0)2)
		if (val>=0) then
		if ( r<r1 .or. r2<r ) cycle
		this%mask(i,j)=val
		else
		if ( r1<=r .and. r<=r2 ) cycle
		this%mask(i,j)=abs(val)
		end if
		end do
		end do
		case default