cleaning up error handling (df9def92) · Commits · Zolnierczuk, Piotr / DrSPINE

Makefile.version

+1 −1

Original line number	Diff line number	Diff line
		@@ -6,7 +6,7 @@ export PROJARCH=$(PROJECT)-$(VERSION_MAJOR).$(VERSION_MINOR)


		export VERSION_MAJOR=0
		export VERSION_MINOR=62
		export VERSION_MINOR=63

		git_rev=$(shell git rev-parse --short HEAD 2> /dev/null)
		ifeq "$(git_rev)" ""

sources/data_manager.f90

+9 −9

Original line number	Diff line number	Diff line
		@@ -45,13 +45,13 @@ contains
		if (present(stat)) stat = istat
		allocate(data_scan(max_size), stat=istat, errmsg=cmsg)
		if (istat/=0 ) then
		call msg_error('data_manager_init', 'data_manager: '//trim(cmsg))
		call msg_error('data_manager_init', 'data_manager: '//trim(cmsg), ERROR_NO_MEMORY)
		if (present(stat)) stat=istat
		return
		end if
		allocate(data_table(max_size), stat=istat, errmsg=cmsg)
		if (istat/=0 ) then
		call msg_error('data_manager_init', 'data_manager: '//trim(cmsg))
		call msg_error('data_manager_init', 'data_manager: '//trim(cmsg), ERROR_NO_MEMORY)
		if (present(stat)) stat=istat
		deallocate(data_scan)
		!deallocate(data_group)
		@@ -79,13 +79,13 @@ contains
		if (present(stat)) stat = istat
		if (allocated(data_table)) deallocate(data_table, stat=istat, errmsg=cmsg)
		if (istat/=0 ) then
		call msg_error('data_manager_init', 'data_manager: '//trim(cmsg))
		call msg_error('data_manager_init', 'data_manager: '//trim(cmsg), ERROR_NO_MEMORY)
		if (present(stat)) stat=istat
		return
		end if
		if (allocated(data_scan )) deallocate(data_scan , stat=istat, errmsg=cmsg)
		if (istat/=0 ) then
		call msg_error('data_manager_init', 'data_manager: '//trim(cmsg))
		call msg_error('data_manager_init', 'data_manager: '//trim(cmsg), ERROR_NO_MEMORY)
		if (present(stat)) stat=istat
		return
		end if
		@@ -117,7 +117,7 @@ contains
		!
		integer :: i
		if (data_size <=0 ) then
		call msg_error('data_manager_print', 'data manager: memory not initialized')
		call msg_error('data_manager_print', 'data manager: memory not initialized', ERROR_MEMORY_INVALID)
		return
		end if

		@@ -162,12 +162,12 @@ contains
		!
		iaddr = DATA_MANAGER_OK
		if (data_size <= 0 ) then
		call msg_error('data_manager_next', 'data manager: memory not initialized')
		call msg_error('data_manager_next', 'data manager: memory not initialized', ERROR_MEMORY_INVALID)
		iaddr = DATA_MANAGER_NOTINIT
		return
		end if
		if (data_manager_used() >= data_size ) then
		call msg_error('data_manager_next', 'data manager: memory full')
		call msg_error('data_manager_next', 'data manager: memory full', ERROR_NO_MEMORY)
		iaddr = DATA_MANAGER_MEMFULL
		return
		end if
		@@ -189,12 +189,12 @@ contains
		!
		isuccess = DATA_MANAGER_OK
		if (data_size <= 0 ) then
		call msg_error('data_manager_free', 'data manager: memory not initialized')
		call msg_error('data_manager_free', 'data manager: memory not initialized', ERROR_MEMORY_INVALID)
		isuccess = DATA_MANAGER_NOTINIT
		return
		end if
		if ( iaddr<0 .or. data_size<iaddr) then
		call msg_error('data_manager_free', 'data manager: invalid address')
		call msg_error('data_manager_free', 'data manager: invalid address', ERROR_MEMORY_INVALID)
		isuccess = DATA_MANAGER_INVADDR
		return
		end if

sources/data_types.f90

+15 −14

Original line number	Diff line number	Diff line
		@@ -1859,7 +1859,7 @@ dotau: do it=it1,it2
		nedges = 0

		if(sqtinfo%n_entries <= 0) then
		call msg_error('tau_histogramming', 'run collect prior to iterate histogramming!')
		call msg_error('tau_histogramming', 'run collect prior to iterate histogramming!', ERROR_DATA_PROCESSING)
		return
		endif

		@@ -1936,7 +1936,7 @@ i1: if( xhisto(i) > 0 .and. histo(i) > 0) then
		nedges = nedges + 1
		if(nedges > mxedges) then
		!write(6,*)"tau_histogramming: too many edges!"
		call msg_error('tau_histogramming', 'too many edges in tau_histogramming!')
		call msg_error('tau_histogramming', 'too many edges in tau_histogramming!', ERROR_DATA_PROCESSING)
		return
		endif
		edges(nedges) = cedges(ith)
		@@ -1955,10 +1955,11 @@ i1: if( xhisto(i) > 0 .and. histo(i) > 0) then
		edges(nedges) = edges(nedges) * (1d0 + xcatch)


		write(6,'(a)')"Result from automatic (iterated) tau_histogramming (still experimental):"
		write(6,'(a)')" edge # tau/ns "
		call msg_debug('tau_histogramming',"Result from automatic (iterated) tau_histogramming (still experimental):")
		call msg_debug('tau_histogramming', " edge # tau/ns ")
		do i = 1, nedges
		write(6,'(i5,": ",es14.5)') i, edges(i)
		call msg_debug('tau_histogramming', trim(msg_fmt("(i5)",i))//": "//trim(msg_fmt("(es14.5)",edges(i))))
		!write(6,'(i5,": ",es14.5)') i, edges(i)
		edges(i) = edges(i) * NS ! back to SI values
		enddo

sources/drspine.f90

+267 −253

Original line number	Diff line number	Diff line
		@@ -318,7 +318,7 @@ program drspine
		!!> we may introduce an extraction function 'get_last_error_codes' reporting the error code accumulated in new_com either
		!!> during comand parsing/interpretation or obtained during calls of 'unused' and 'errsig'
		call unused( icmdus=2, ivnuse=2, irpuse=2, iretus=iunused)
		if(iunused .ne. 0) call msg_error('drspine', 'unknown option in last command', 9901)
		if(iunused .ne. 0) call msg_error('drspine', 'unknown option in last command', ERROR_OPTION_UNKNOWN)

		if(ierrs > 0) call close_all_macros()
		ierrs = 0
		@@ -780,7 +780,7 @@ program drspine
		getval("temperature" ,0d0 ), &
		ier)
		if(ier .ne. 0) then
		call errsig(1000,"directory not found in:"//trim(MXX_ECHO_DIR)//"$")
		call msg_error('drspine',"directory not found in:"//trim(MXX_ECHO_DIR), ERROR_DIR_NOT_FOUND)
		cycle commandloop
		endif

		@@ -930,7 +930,7 @@ CONTAINS
		!!mmnc
		call unused( icmdus=0, ivnuse=2, irpuse=2, iretus=iunused)
		if(iunused .ne. 0) then
		call errsig(9901,"ERROR: unknown option in command clear! $")
		call msg_error('drspine', "unknown option in command clear", ERROR_OPTION_UNKNOWN)
		return
		endif
		!!mmnc
		@@ -986,11 +986,11 @@ CONTAINS
		ibins = parse_command_flags('nbins,custom')

		if (iwhat<0) then ! error
		call msg_error('drspine', 'command bins: keywords "tof" and "pix" are mutually exclusive')
		call msg_error('drspine', 'command bins: keywords "tof" and "pix" are mutually exclusive', ERROR_OPTION_SYNTAX)
		return
		endif
		if (ibins<0) then ! error
		call msg_error('drspine', 'command bins: keywords "nbins" and "custom" are mutually exclusive')
		call msg_error('drspine', 'command bins: keywords "nbins" and "custom" are mutually exclusive', ERROR_OPTION_SYNTAX)
		return
		endif

		@@ -1013,10 +1013,10 @@ CONTAINS
		else
		call msg_error('drspine', &
		msg_fmt("('command bins: nbins must be a power of 2 in the range [1,',i0,']')",&
		MAX_NO_PIX))
		MAX_NO_PIX), ERROR_OPTION_ARG)
		end if
		else
		call msg_error('drspine', 'command bins: missing argument to nbins')
		call msg_error('drspine', 'command bins: missing argument to nbins', ERROR_OPTION_ARG)
		end if
		case (E_TOF)
		nrange = get_named_value('range ', MAX_NO_LAMBDA_BINS, inew)
		@@ -1027,16 +1027,16 @@ CONTAINS
		else
		call msg_error('drspine', &
		msg_fmt("('command bins: need a divisor of ',i0, ' or use custom binning')",&
		nrange))
		nrange), ERROR_OPTION_ARG)
		end if
		else
		call msg_error('drspine', 'command bins: missing argument to nbins')
		call msg_error('drspine', 'command bins: missing argument to nbins', ERROR_OPTION_ARG)
		end if
		end select
		case(E_CUSTOM)
		select case(iwhat)
		case (E_PIX)
		call msg_error('drspine', 'command bins: keywords "custom" is not valid for "pix"')
		call msg_error('drspine', 'command bins: keywords "custom" is not valid for "pix"', ERROR_OPTION_SYNTAX)
		return
		case (E_TOF)
		nbins = iparf()
		@@ -1045,7 +1045,7 @@ CONTAINS
		if ( tedges(i)<1 .or. MAX_NO_LAMBDA_BINS<tedges(i)) then
		call msg_error('drspine', &
		msg_fmt("('command bins: TOF need a number between 1 and ',i3)",&
		MAX_NO_LAMBDA_BINS))
		MAX_NO_LAMBDA_BINS), ERROR_OPTION_ARG)
		return
		end if
		end do
		@@ -1057,14 +1057,11 @@ CONTAINS
		!!mmnc
		call unused( icmdus=0, ivnuse=2, irpuse=2, iretus=iunused)
		if(iunused .ne. 0) then
		call errsig(9901,"ERROR: unknown option in command bins! $")
		call msg_error('drspine', "unknown option in command bins", ERROR_OPTION_UNKNOWN)
		return
		endif
		!!mmnc




		end subroutine cmd_bins

		!> helper subroutine for cmd_histo and cmd_collect
		@@ -1135,6 +1132,7 @@ CONTAINS
		integer :: iwhat, ibins
		integer :: iunused
		logical :: log_scale
		!logical :: customary_units
		!
		real(kind=DBL), save :: xcatch = 0.15d0
		integer , save :: maxbins = MAX_NO_T_BINS+1
		@@ -1149,20 +1147,26 @@ CONTAINS
		iwhat = parse_command_flags('tau,q')
		ibins = parse_command_flags('nbins,custom,auto,iterate')
		log_scale = found('log')
		!customary_units = found('customary')

		! process q/tau binning
		if (iwhat<0) then ! error both are present
		call msg_error('drspine', 'command histo: keywords "tof" and "q" are mutually exclusive')
		call msg_error('drspine', 'command histo: keywords "tof" and "q" are mutually exclusive', ERROR_OPTION_SYNTAX)
		return
		endif
		if (ibins<0) then
		call msg_error('drspine', 'command histo: keywords "nbins", "custom" and "auto" are mutually exclusive')
		call msg_error('drspine', 'command histo: keywords "nbins", "custom" and "auto" are mutually exclusive', ERROR_OPTION_SYNTAX)
		return
		endif

		if (iwhat==0.or.ibins==0) then ! no action or neither tau nor q present
		write(output_unit,'(a)') 'tau histo: '//trim(cformat_bin_struct(tau_bins))
		write(output_unit,'(a)') 'q histo: '//trim(cformat_bin_struct(q_bins ))
		!if (customary_units) then
		! write(output_unit,'(a)') 'histo tau/ns: '//trim(cformat_bin_struct(tau_bins, scal=1/NS))
		! write(output_unit,'(a)') 'histo q*A : '//trim(cformat_bin_struct(q_bins , scal=ANGSTROEM))
		!else
		write(output_unit,'(a)') 'histo tau: '//trim(cformat_bin_struct(tau_bins))
		write(output_unit,'(a)') 'histo q : '//trim(cformat_bin_struct(q_bins ))
		!end if
		return
		endif

		@@ -1172,7 +1176,7 @@ CONTAINS
		case(E_Q)
		xbins = q_bins
		case default
		call msg_error('drspine', 'command histo: unknown selection')
		call msg_error('drspine', 'command histo: unknown selection', ERROR_OPTION_UNKNOWN)
		return
		end select

		@@ -1207,7 +1211,7 @@ CONTAINS
		call tau_histogramming(xedges, maxbins, nbins, xcatch, .not. log_scale)
		if (nbins<=0 .or. maxbins<nbins) return ! paz avoid empty histos
		call create_bin_struct(xbins, xedges(1:nbins))
		call msg_info('cmd_histo', 'histo: tau(iterated): '//trim(cformat_bin_struct(xbins)))
		call msg_debug('cmd_histo', 'histo: tau(iterated): '//trim(cformat_bin_struct(xbins)))
		case default
		return
		end select
		@@ -1223,7 +1227,7 @@ CONTAINS
		!!mmnc
		call unused( icmdus=0, ivnuse=2, irpuse=2, iretus=iunused)
		if(iunused .ne. 0) then
		call errsig(9901,"ERROR: unknown option in command bins! $")
		call msg_error('drspine', "unknown option in command histo", ERROR_OPTION_UNKNOWN)
		return
		endif
		!!mmnc
		@@ -1248,7 +1252,7 @@ CONTAINS
		nselect = parse_command_flags('basic,b,gaussian,g,flux_weighted,fw,triangular,t')

		if (nselect < 0 ) then
		call msg_error('drspine', 'command eshape: echo shape keywords are mutually exclusive')
		call msg_error('drspine', 'command eshape: echo shape keywords are mutually exclusive', ERROR_OPTION_SYNTAX)
		return
		else if (nselect==0) then
		write(output_unit,'(a, i0, a)') ' current echo shape: '//trim(cformat_eshape())//' [', eshape_get(), ']'
		@@ -1287,6 +1291,7 @@ CONTAINS
		integer :: inewtfac, inewphoff
		real(kind=DBL) :: tfac
		real(kind=DBL) :: phase_offset
		logical :: fexists ! flag to check whether file exists

		call msg_info('drspine', '===> reading')
		chrole = ' '
		@@ -1296,7 +1301,7 @@ CONTAINS
		tfac = get_named_value('tfac', tfac, inewtfac)
		phase_offset = get_named_value('phase_offset', phase_offset, inewphoff)

		!
		! make sure we have all the geometry right
		call configure_instrument_geometry()

		i = 0 ! parameter index
		@@ -1312,11 +1317,17 @@ CONTAINS
		if (len_trim(filename) == 0) exit read_loop
		filename = format_path(data_path, filename=filename)
		end if
		! test if file exists
		inquire( file=filename, exist=fexists)
		if ( .not. fexists ) then
		call msg_error('drspine', 'file '//trim(filename)//' does not exist', ERROR_FILE_NOT_FOUND)
		exit read_loop
		end if
		! reading data
		call msg_info('drspine', '===> filename: '//trim(filename))
		call data_manager_add(k)
		if (k<=0) then
		call msg_error('drspine', 'not enough room to read data')
		call msg_error('drspine', 'not enough room to read data', ERROR_NO_MEMORY)
		exit read_loop
		end if
		call read_echo_data(data_scan(k), filename, instrument_parameters, tbins)
		@@ -1445,7 +1456,7 @@ CONTAINS
		val = get_named_value('val', val, inew)

		if ( do_win .and. do_ring ) then
		call msg_error('drspine/mask', 'mask ring and win are mutually exclusive')
		call msg_error('drspine/mask', 'mask ring and win are mutually exclusive', ERROR_OPTION_SYNTAX)
		return
		end if

		@@ -1461,7 +1472,7 @@ CONTAINS
		! set a rectangular mask
		if ( do_win ) then
		if (iparf()<4) then
		call msg_error('drspine/mask', 'mask win - need 4 window parameters (x1,y1,x2,y2)')
		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)
		@@ -1474,7 +1485,7 @@ CONTAINS
		! set a ring mask
		if ( do_ring ) then
		if (iparf()<4) then
		call msg_error('drspine/mask', 'mask ring - need 4 ring parameters (x0,y0,r1,r2)')
		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)
		@@ -1843,7 +1854,9 @@ CONTAINS
		!! create output directory
		call create_directory(save_path, writable=.true., stat=ier)
		if (ier/=0) then
		call msg_error('drspine/collect', 'cannot create directory '//trim(save_path), ier)
		call msg_error('drspine/collect', 'cannot create directory '//trim(save_path)//&
		' '//trim(msg_fmt("('(ier =', i0,')')", ier)),&
		ERROR_DIR_ACCESS)
		return
		end if

		@@ -2243,7 +2256,7 @@ CONTAINS
		! initializing with header
		s0: if(found('start') .or. found('init')) then
		if(tex_output .ne. 0) then
		call msg_error('drspine',"tex_output already active!")
		call msg_error('drspine',"tex_output already active!", ERROR_DATA_PROCESSING)
		return
		endif

		@@ -2265,7 +2278,8 @@ d1: do i=1, data_manager_size()


		if(numor == 0) then
		call msg_error('drspine',"no scans with role=sample loaded, reporting not started! Load data and try again!")
		call msg_error('drspine',"no scans with role=sample loaded, reporting not started! Load data and try again!",&
		ERROR_DATA_PROCESSING)
		return
		endif
		if (len_trim(report_name)<=0)then
		@@ -4325,13 +4339,13 @@ ntl2: do i=0, nt
		chrole = chrval('as',chrole, res)
		if ( res==0 ) return ! not found
		if ( res<0 ) then ! found keyword, but not value
		call msg_error("parse_role_arg", "role argument is missing")
		call msg_error("parse_role_arg", "role argument is missing", ERROR_OPTION_ARG)
		return
		else
		chrole = tolower(chrole)
		if ( trim(chrole) == 'auto' ) return ! special keyword
		if (get_data_role(tolower(chrole))==ROLE_UNDEFINED) then
		call msg_error("parse_role_arg", "role '"//trim(chrole)//"' is unknown")
		call msg_error("parse_role_arg", "role '"//trim(chrole)//"' is unknown", ERROR_OPTION_ARG)
		res = -res
		return
		endif

sources/logger.f90

+5 −2

Original line number	Diff line number	Diff line
		@@ -212,9 +212,12 @@ contains
		subroutine msg_error(subrou, messg, ierror)
		character(len=*), intent(in) :: subrou, messg
		integer, intent(in), optional :: ierror
		!
		integer :: error_code
		call logmsg(LOG_ERROR, subrou, messg)
		if (present(ierror))&
		call errsig(ierror) !,trim(messg)//' $') !signal command interpreter
		error_code = ERROR_UNKNOWN
		if (present(ierror)) error_code = ierror
		call errsig(error_code) !,trim(messg)//' $') !signal command interpreter
		return
		end subroutine msg_error