Merge branch 'dev/logger' into pztest (bc6e90e1) · Commits · Zolnierczuk, Piotr / DrSPINE

examples/macro_pts_missing

0 → 100644

+5 −0

Original line number	Diff line number	Diff line
		macro

		datapath /SNS/NSE//IPTS-27126/

		read s10934.echo

examples/match_test2

+1 −2

Original line number	Diff line number	Diff line
		@@ -36,6 +36,5 @@ match show
		! test fitting/collection
		fit res
		fit sam flag offset
		verbose dec ! warning
		verbose dec ! error
		verbose off ! only errors
		collect

sources/data_types.f90

+45 −19

Original line number	Diff line number	Diff line
		@@ -51,7 +51,8 @@ module data_types
		type(value_struct), dimension(:), allocatable :: counts_pixel_bin ! counts in pixel an lambda bin
		type(value_struct), dimension(:), allocatable :: monitor ! monitor counts

		! pixel "description"
		! parent scan and pixel description
		type(scan_data_struct), pointer :: parent ! pointer to the parent scan
		character(len=MAX_VAR_NAME_LENGTH) :: cpixel ! pixel description (mostly for debugging) [PAZ]

		!
		@@ -528,6 +529,12 @@ module data_types
		module procedure trap_div_dbl
		module procedure trap_div_int
		end interface

		interface cpixel
		module procedure cpixel_format1
		module procedure cpixel_format2
		end interface

		! =========================================================================================
		CONTAINS

		@@ -545,10 +552,11 @@ CONTAINS
		end subroutine init_sample_struct


		subroutine init_phase_scan_struct(this, nphases, cpixel)
		subroutine init_phase_scan_struct(this, nphases, cpixel, parent)
		type(phase_scan_struct), intent(out) :: this
		integer, intent(in) :: nphases
		character(len=*),intent(in), optional :: cpixel
		type(scan_data_struct), intent(in), target, optional :: parent
		!
		integer :: istat

		@@ -566,11 +574,10 @@ CONTAINS
		if (istat/=0) &
		call msg_fatal('init_scan_data_struct', 'memory exhausted')

		this%parent=>NULL()
		this%cpixel='<undefined>'
		if ( present(cpixel) ) then
		this%cpixel = cpixel(1:MIN(len_trim(cpixel),MAX_VAR_NAME_LENGTH))
		endif

		if (present(parent)) this%parent => parent
		if (present(cpixel)) this%cpixel = cpixel(1:MIN(len_trim(cpixel),MAX_VAR_NAME_LENGTH))
		this%max_phase = nphases

		call init_value(this%delta_j)
		@@ -714,7 +721,7 @@ CONTAINS


		subroutine init_scan_data_struct(this, nphases, nt, nx, ny)
		type(scan_data_struct), intent(out) :: this
		type(scan_data_struct), intent(out), target :: this
		integer, intent(in) :: nphases
		integer, intent(in) :: nt, nx, ny
		!
		@@ -748,7 +755,7 @@ CONTAINS
		call init_environment_parameters_struct(this%environment(i))
		end do

		call init_phase_scan_struct(this%centerbin, this%no_phases, "0:0-0")
		call init_phase_scan_struct(this%centerbin, this%no_phases, "0:0-0", this)

		if (allocated(this%pixelbin)) deallocate(this%pixelbin)
		allocate(this%pixelbin(0:this%no_lam, this%no_xpix, this%no_ypix), stat=istat)
		@@ -758,7 +765,7 @@ CONTAINS
		do ix=1,this%no_xpix
		do iy=1, this%no_ypix
		write(cpixel, '(i0,":",i0,"-",i0)') it, ix, iy
		call init_phase_scan_struct(this%pixelbin(it, ix, iy), this%no_phases, cpixel)
		call init_phase_scan_struct(this%pixelbin(it, ix, iy), this%no_phases, cpixel, this)
		end do
		end do
		end do
		@@ -867,6 +874,29 @@ CONTAINS
		end function is_pixel_ok


		!
		function cpixel_format1(this) result(cres)
		character(len=MAX_NAME_LENGTH) :: cres
		type(phase_scan_struct), intent(in) :: this
		write(cres,'("run=",i0,",tau=",i0,",pix=",a)') this%parent%id, this%parent%point, trim(this%cpixel)
		end function cpixel_format1

		!>
		!!
		function cpixel_format2(run, tau, pixel) result(cres)
		character(len=MAX_NAME_LENGTH) cres
		integer, intent(in), optional :: run
		integer, intent(in), optional :: tau
		character(len=*), intent(in), optional :: pixel
		!
		cres = ' '
		if (present(run )) write(cres,'(a,"run=",i0,",")') trim(cres), run
		if (present(tau )) write(cres,'(a,"tau=",i0,",")') trim(cres), tau
		if (present(pixel)) write(cres,'(a,"pix=",a ,",")') trim(cres), trim(pixel)
		if (len_trim(cres)>1) cres=cres(1:len_trim(cres)-1) ! remove trailing comma
		end function cpixel_format2


		!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
		!! from here stuff to deal with collecting results into a binned sqt structure !!
		!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
		@@ -1050,27 +1080,23 @@ CONTAINS
		!!!>>> preliminary hint >>> !!!
		if(present(ps_background)) then
		call msg_fatal('add_pix_to_sqt', "ATTENTION: in the present version we do not yet treat background at this level")
		!write(6,*)" >>>> This Message was issued in subroutine add_pix_to_sqt <<<<"
		!stop
		endif
		!!!<<< preliminary hint <<< !!!



		if( abs(ps_reference%J0 - ps_sample%J0)/ps_reference%J0 > matching_tolerance%J0_rel ) then
		call msg_warning('add_pix_to_sqt', "pixel "//trim(ps_sample%cpixel)//&
		": sample and reference field integral match is outside of tolerance")
		call msg_warning('add_pix_to_sqt,'//cpixel(ps_sample),&
		"sample and reference field integral match is outside of tolerance")
		endif

		if( (abs(ps_reference%lambda_1 - ps_sample%lambda_1) > matching_tolerance%lambda_min) .or. &
		(abs(ps_reference%lambda_2 - ps_sample%lambda_2) > matching_tolerance%lambda_max) ) then
		call msg_warning('add_pix_to_sqt', "pixel "//trim(ps_sample%cpixel)//&
		": sample and reference wavelength match is outside of tolerance")
		call msg_warning('add_pix_to_sqt,'//cpixel(ps_sample),&
		"sample and reference wavelength match is outside of tolerance")
		endif

		if( abs(ps_reference%scattering_angle_polar - ps_sample%scattering_angle_polar) > matching_tolerance%scattering_angle) then
		call msg_warning('add_pix_to_sqt', "pixel "//trim(ps_sample%cpixel)//&
		": sample and reference scattering angle match is outside of tolerance")
		call msg_warning('add_pix_to_sqt,'//cpixel(ps_sample),&
		"sample and reference scattering angle match is outside of tolerance")
		endif

		!> @note we still have to include further exclusion criteria

sources/drspine.f90

+3 −2

Original line number	Diff line number	Diff line
		@@ -2453,7 +2453,7 @@ CONTAINS
		case (E_ON)
		call set_loglevel(LOG_DEBUG)
		case (E_OFF)
		call set_loglevel(LOG_WARNING)
		call set_loglevel(LOG_ERROR)
		case (E_DEC)
		call dec_loglevel()
		case (E_INC)
		@@ -2463,9 +2463,10 @@ CONTAINS
		'and "default" are mutually exclusive')
		return
		case default
		write(output_unit,*) 'log level is: '//trim(get_cloglevel())
		write(output_unit,*) 'logging level is: '//trim(get_cloglevel())
		end select


		end subroutine cmd_verbose

		!-------------------------------------------------------------

sources/echo_shapes.f90

+2 −2

Original line number	Diff line number	Diff line
		@@ -641,7 +641,7 @@ contains
		call brent( delta_J0(1), delta_J0(2), dJ, stat, chisq, tolerance)
		if ( 0<stat .and. stat<MAX_NUMBER_OF_ITERATIONS ) cycle
		if ( stat >= MAX_NUMBER_OF_ITERATIONS ) then
		call msg_warning('linextpha1',trim(phase_scan%cpixel)//': '//&
		call msg_warning('linextpha1:'//trim(cpixel(phase_scan)),&
		trim(msg_fmt("('fit failed, max iterations exceeded=',i0)",stat)))
		stat = -MAX_NUMBER_OF_ITERATIONS
		endif