[LIBISIS-code-svn] r942 - in trunk: bindings/matlab bindings/matlab/classes/@IXTdataset_1d bindings/matlab/classes/@IXTdataset_2d bindings/matlab/classes/@IXTunits libclasses libcore
apache at libisis.org
apache at libisis.org
Tue Dec 12 16:26:42 GMT 2006
Author: Dickon Champion
Date: Tue Dec 12 16:26:39 2006
New Revision: 942
Added:
trunk/bindings/matlab/classes/@IXTdataset_1d/make_label.m
trunk/bindings/matlab/classes/@IXTdataset_2d/make_label.m
trunk/bindings/matlab/classes/@IXTunits/make_label.m
Modified:
trunk/bindings/matlab/IXMdataset_1d_m.f90
trunk/bindings/matlab/IXMdataset_2d_m.f90
trunk/bindings/matlab/IXMunits_m.f90
trunk/bindings/matlab/classes/@IXTunits/IXTunits.m
trunk/bindings/matlab/libisisexc.txt
trunk/libclasses/IXMdataset_1d.f90
trunk/libclasses/IXMdataset_2d.f90
trunk/libclasses/IXMunits.f90
trunk/libcore/IXMneutron_units.f90
Log:
make label function and units from code:fixes refs #3
Modified: trunk/bindings/matlab/IXMdataset_1d_m.f90
Url: http://svn.libisis.org/viewvc/LIBISISCode/trunk/bindings/matlab/IXMdataset_1d_m.f90?r1=941&r2=942
==============================================================================
--- trunk/bindings/matlab/IXMdataset_1d_m.f90 (original)
+++ trunk/bindings/matlab/IXMdataset_1d_m.f90 Tue Dec 12 16:26:39 2006
@@ -149,6 +149,26 @@
endif
end subroutine IXBrebin_dataset_1d
+subroutine IXBmake_label_dataset_1d(nlhs, plhs, nrhs, prhs, status)
+ use IXMm_dataset_1d
+ implicit none
+ integer :: nlhs,nrhs
+ integer(cpointer_t) :: plhs(nlhs),prhs(nrhs)
+ type(IXTstatus) :: status
+ type(IXTdataset_1d) :: d1d
+ character(len=long_len) :: x_label, s_label
+ call IXBgetFromBinding(prhs(1),' ', 1, 0, d1d,status)
+ if (status == IXCseverity_error) return
+ call IXFmake_label_dataset_1d(d1d,x_label,s_label,status)
+ if (status == IXCseverity_error) then
+ plhs(1)=ixDuplicateArray(prhs(1))
+ else
+ call IXBsendToBinding(plhs(1), ' ', 1, 0, x_label, status)
+ call IXBsendToBinding(plhs(2), ' ', 1, 0, s_label, status)
+ endif
+end subroutine IXBmake_label_dataset_1d
+
+
subroutine IXBregroup_dataset_1d(nlhs, plhs, nrhs, prhs, status)
use IXMm_dataset_1d
Modified: trunk/bindings/matlab/IXMdataset_2d_m.f90
Url: http://svn.libisis.org/viewvc/LIBISISCode/trunk/bindings/matlab/IXMdataset_2d_m.f90?r1=941&r2=942
==============================================================================
--- trunk/bindings/matlab/IXMdataset_2d_m.f90 (original)
+++ trunk/bindings/matlab/IXMdataset_2d_m.f90 Tue Dec 12 16:26:39 2006
@@ -692,15 +692,13 @@
type(IXTdataset_2d) :: wres,w1
type(IXTstatus) :: status
real(dp),pointer :: xparams(:),yparams(:)
-
-
- call IXBgetFromBindingPtr(prhs(3), ' ', 1, 0, xparams, status)
- call IXBgetFromBindingPtr(prhs(4), ' ', 1, 0, yparams, status)
+ call IXBgetFromBindingPtr(prhs(3), ' ', 1, 0, xparams, status)
+ call IXBgetFromBindingPtr(prhs(4), ' ', 1, 0, yparams, status)
! read dataset_2d class
- call IXBgetFromBinding(prhs(2),' ', 1, 0, w1, status)
- if (status == IXCseverity_error) return
+ call IXBgetFromBinding(prhs(2),' ', 1, 0, w1, status)
+ if (status == IXCseverity_error) return
- call IXFregroup_xy_dataset_2d(wres,w1,xparams,yparams,status)
+ call IXFregroup_xy_dataset_2d(wres,w1,xparams,yparams,status)
if (status == IXCseverity_error) then
plhs(1)=ixDuplicateArray(prhs(1))
@@ -709,4 +707,24 @@
endif
end subroutine IXBregroup_xy_dataset_2d
+subroutine IXBmake_label_dataset_2d(nlhs, plhs, nrhs, prhs, status)
+ use IXMm_dataset_2d
+ implicit none
+ integer :: nlhs,nrhs
+ integer(cpointer_t) :: plhs(nlhs),prhs(nrhs)
+ type(IXTstatus) :: status
+ type(IXTdataset_2d) :: d2d
+ character(len=long_len) :: x_label, s_label
+ call IXBgetFromBinding(prhs(1),' ', 1, 0, d2d,status)
+ if (status == IXCseverity_error) return
+ call IXFmake_label_dataset_2d(d2d,x_label,s_label,status)
+ if (status == IXCseverity_error) then
+ plhs(1)=ixDuplicateArray(prhs(1))
+ else
+ call IXBsendToBinding(plhs(1), ' ', 1, 0, x_label, status)
+ call IXBsendToBinding(plhs(2), ' ', 1, 0, s_label, status)
+ endif
+
+end subroutine IXBmake_label_dataset_2d
+
Modified: trunk/bindings/matlab/IXMunits_m.f90
Url: http://svn.libisis.org/viewvc/LIBISISCode/trunk/bindings/matlab/IXMunits_m.f90?r1=941&r2=942
==============================================================================
--- trunk/bindings/matlab/IXMunits_m.f90 (original)
+++ trunk/bindings/matlab/IXMunits_m.f90 Tue Dec 12 16:26:39 2006
@@ -12,3 +12,49 @@
#define IXD_TYPE units
#include "bindings_extra.f90"
+
+subroutine IXBmake_label_units(nlhs, plhs, nrhs, prhs, status)
+ use IXMm_units
+ implicit none
+ integer :: nlhs,nrhs
+ integer(cpointer_t) :: plhs(nlhs),prhs(nrhs)
+ type(IXTstatus) :: status
+ type(IXTunits) :: x_unit,s_unit
+ logical :: x_dist
+ character(len=long_len) :: x_label, s_label
+ call IXBgetFromBinding(prhs(1),' ', 1, 0, x_unit,status)
+ call IXBgetFromBinding(prhs(2),' ', 1, 0, s_unit, status)
+! next line does not seem to work
+ call IXBgetFromBinding(prhs(3),' ', 1, 0, x_dist, status)
+ if (status == IXCseverity_error) return
+ call IXFmake_label_units(x_unit,s_unit,x_dist,x_label,s_label,status)
+ if (status == IXCseverity_error) then
+ plhs(1)=ixDuplicateArray(prhs(1))
+ else
+ call IXBsendToBinding(plhs(1), ' ', 1, 0, x_label, status)
+ call IXBsendToBinding(plhs(2), ' ', 1, 0, s_label, status)
+ endif
+ end subroutine IXBmake_label_units
+
+subroutine IXBcreate_code_units(nlhs, plhs, nrhs, prhs, status)
+ use IXMm_units
+ implicit none
+ integer :: nlhs,nrhs
+ integer(cpointer_t) :: plhs(nlhs),prhs(nrhs)
+ type(IXTstatus) :: status
+ type(IXTunits) :: units
+ character(len=4)::code
+ ! read in parameters from matlab
+ call IXBgetFromBinding(prhs(1), ' ', 1, 0, units, status)
+ call IXBgetFromBinding(prhs(2), ' ', 1, 0, code, status)
+
+ if (status == IXCseverity_error) return
+
+ call IXFcreate_code_units(units,code,status)
+
+ if (status == IXCseverity_error) then
+ plhs(1)=ixDuplicateArray(prhs(1))
+ else
+ call IXBsendToBinding(plhs(1), prhs(1), ' ', 1, 0, units, status)
+ endif
+end subroutine IXBcreate_code_units
\ No newline at end of file
Added: trunk/bindings/matlab/classes/@IXTdataset_1d/make_label.m
Url: http://svn.libisis.org/viewvc/LIBISISCode/trunk/bindings/matlab/classes/%40IXTdataset_1d/make_label.m&view=markup&revision=942
Added: trunk/bindings/matlab/classes/@IXTdataset_2d/make_label.m
Url: http://svn.libisis.org/viewvc/LIBISISCode/trunk/bindings/matlab/classes/%40IXTdataset_2d/make_label.m&view=markup&revision=942
Modified: trunk/bindings/matlab/classes/@IXTunits/IXTunits.m
Url: http://svn.libisis.org/viewvc/LIBISISCode/trunk/bindings/matlab/classes/%40IXTunits/IXTunits.m?r1=941&r2=942
==============================================================================
--- trunk/bindings/matlab/classes/@IXTunits/IXTunits.m (original)
+++ trunk/bindings/matlab/classes/@IXTunits/IXTunits.m Tue Dec 12 16:26:39 2006
@@ -9,7 +9,9 @@
% and also check its arguments
if (nargin == 1) && ischar(varargin{1})
- units = libisisexc('IXTunits','create',units,{IXTbase('entry',false,true),' ',varargin{1}});
+% constructor for user-defined units only
+ % units = libisisexc('IXTunits','create',units,{IXTbase('entry',false,true),' ',varargin{1}});
+units = libisisexc('IXTunits','create_code_varargin',units,varargin);
elseif (nargin == 2) && iscellstr(varargin)
units = libisisexc('IXTunits','create',units,{IXTbase('entry',false,true),varargin{1},varargin{2}});
elseif (nargin > 0)
Added: trunk/bindings/matlab/classes/@IXTunits/make_label.m
Url: http://svn.libisis.org/viewvc/LIBISISCode/trunk/bindings/matlab/classes/%40IXTunits/make_label.m&view=markup&revision=942
Modified: trunk/bindings/matlab/libisisexc.txt
Url: http://svn.libisis.org/viewvc/LIBISISCode/trunk/bindings/matlab/libisisexc.txt?r1=941&r2=942
==============================================================================
--- trunk/bindings/matlab/libisisexc.txt (original)
+++ trunk/bindings/matlab/libisisexc.txt Tue Dec 12 16:26:39 2006
@@ -72,6 +72,7 @@
IXTdataset_1d array_minus
IXTdataset_1d array_times
IXTdataset_1d array_divide
+IXTdataset_1d make_label
#
# IXTdataset_2d
#
@@ -141,7 +142,7 @@
IXTdataset_2d array_Y_minus
IXTdataset_2d array_Y_times
IXTdataset_2d array_Y_divide
-
+IXTdataset_2d make_label
#
# IXTdataset_3d
@@ -285,6 +286,8 @@
IXTunits create
IXTunits display
IXTunits check
+IXTunits make_label
+IXTunits create_code
#
# IXTrunfile
#
Modified: trunk/libclasses/IXMdataset_1d.f90
Url: http://svn.libisis.org/viewvc/LIBISISCode/trunk/libclasses/IXMdataset_1d.f90?r1=941&r2=942
==============================================================================
--- trunk/libclasses/IXMdataset_1d.f90 (original)
+++ trunk/libclasses/IXMdataset_1d.f90 Tue Dec 12 16:26:39 2006
@@ -854,6 +854,15 @@
call IXFreport_status(status)
end function IXFdataset_1dPlusAAop
+!! this will create an x_label and an s_label from an IXTdataset_1d object
+ subroutine IXFmake_label_dataset_1d(d1d,x_label,s_label,status)
+ implicit none
+ type(IXTdataset_1d),intent(in)::d1d
+ character(len=long_len),intent(out)::x_label,s_label
+ type(IXTstatus)::status
+ call IXFmake_label_units(d1d%x_units,d1d%s_units,d1d%x_distribution,x_label,s_label,status)
+ end subroutine IXFmake_label_dataset_1d
+
!-----------------------------------------------------------------------------------------------------------------------
#define IXD_NAME plus_dataset_1d
#define IXD_TYPE dataset_1d
Modified: trunk/libclasses/IXMdataset_2d.f90
Url: http://svn.libisis.org/viewvc/LIBISISCode/trunk/libclasses/IXMdataset_2d.f90?r1=941&r2=942
==============================================================================
--- trunk/libclasses/IXMdataset_2d.f90 (original)
+++ trunk/libclasses/IXMdataset_2d.f90 Tue Dec 12 16:26:39 2006
@@ -2358,7 +2358,14 @@
call finish_op_dataset_2d (d2dout,d2d,status)
end subroutine IXFunspike_dataset_2d
-
+!! this will create an x_label and an s_label from an IXTdataset_2d object
+ subroutine IXFmake_label_dataset_2d(d2d,x_label,s_label,status)
+ implicit none
+ type(IXTdataset_2d),intent(in)::d2d
+ character(len=long_len),intent(out)::x_label,s_label
+ type(IXTstatus)::status
+ call IXFmake_label_units(d2d%x_units,d2d%s_units,d2d%x_distribution,x_label,s_label,status)
+ end subroutine IXFmake_label_dataset_2d
!-----------------------------------------------------------------------------------------------------------------------
Modified: trunk/libclasses/IXMunits.f90
Url: http://svn.libisis.org/viewvc/LIBISISCode/trunk/libclasses/IXMunits.f90?r1=941&r2=942
==============================================================================
--- trunk/libclasses/IXMunits.f90 (original)
+++ trunk/libclasses/IXMunits.f90 Tue Dec 12 16:26:39 2006
@@ -82,8 +82,10 @@
call IXFmark_valid(arg)
i=1
do while ((found .eqv. .false.) .and. (i<=list_len) )
- if ( trim(code) == trim(c_list(i)) ) units=u_list(i)
- found=.true.
+ if ( trim(code) == trim(code_list(i)) )then
+ units=units_list(i)
+ found=.true.
+ endif
i=i+1
end do
@@ -96,33 +98,44 @@
end subroutine IXFcreate_code_units
-!! this will create an IXTunits object given a standard units code, and fail otherwise
- subroutine IXFcreate_label_units(arg,code,status)
+!! this will create an x_label and an s_label from IXTunits (x & y) and x_distribution flag
+!! will work for standard or user defined units
+ subroutine IXFmake_label_units(x_unit,s_unit,x_dist,x_label,s_label,status)
implicit none
- type(IXTunits),intent(out)::arg
- type(IXTstatus)::status
- character(len=*),intent(in) :: code
- character(len=long_len) :: units
+ type(IXTunits),intent(in)::x_unit,s_unit
+ type(IXTstatus)::status
+ character(len=long_len),intent(out) :: x_label,s_label
+ logical,intent(in)::x_dist
logical::found
- integer(i4b)::i
- found=.false.
+ integer(i4b)::i
+ found=.false.
- call IXFmark_valid(arg)
+ x_label=''
+ s_label=''
i=1
+ ! check if x_units is standard
do while ((found .eqv. .false.) .and. (i<=list_len) )
- if ( trim(code) == trim(c_list(i)) ) units=u_list(i)
- found=.true.
+ if ( trim(x_unit%code) == trim(code_list(i)) ) found=.true.
i=i+1
end do
- if(found .eqv. .true.) then
- call IXFset_units(arg,status,code,units)
+ if(found)then
+ x_label=trim(cap_list(i-1))//'('//trim(x_unit%units)//')'
+ if(x_dist)then
+ s_label=trim(s_unit%units)//' per '//trim(x_unit%units)
+ else
+ s_label=trim(s_unit%units)
+ endif
else
- call IXFadd_status(status, IXCfacility_libisis, IXCseverity_fatal, &
- IXCerr_invparam,'Invalid units code supplied(IXFcreate_code_units)')
+ x_label=trim(x_unit%units)
+ if(x_dist)then
+ s_label=trim(s_unit%units)//' per '//trim(x_unit%units)
+ else
+ s_label=trim(s_unit%units)
+ endif
endif
-
- end subroutine IXFcreate_label_units
+
+ end subroutine IXFmake_label_units
recursive subroutine IXFset_units(arg,status,code,units,ref)
implicit none
Modified: trunk/libcore/IXMneutron_units.f90
Url: http://svn.libisis.org/viewvc/LIBISISCode/trunk/libcore/IXMneutron_units.f90?r1=941&r2=942
==============================================================================
--- trunk/libcore/IXMneutron_units.f90 (original)
+++ trunk/libcore/IXMneutron_units.f90 Tue Dec 12 16:26:39 2006
@@ -22,23 +22,28 @@
character(len=4),parameter::IXCcode_q='q ',IXCcode_qplus='q+ ',IXCcode_qminus='q- ', &
& IXCcode_sq='sq ',IXCcode_sqplus='sq+ ',IXCcode_sqminus='sq- '
- character(len=long_len),parameter:: IXCunit_microsecond='Microseconds', &
+ character(len=long_len),parameter:: IXCunit_microsecond='Microsecond', &
& IXCunit_meter_per_sec='m/s', IXCunit_sec_per_meter='s/m', &
- & IXCunit_angstrom='Angstroms', IXCunit_angstrom2='Angstrom^2', &
+ & IXCunit_angstrom='Angstrom', IXCunit_angstrom2='Angstrom^2', &
& IXCunit_inv_angstrom='Angstrom^-1', IXCunit_inv_angstrom2='Angstrom^-2', &
& IXCunit_mev='meV', IXCunit_thz='THz', IXCunit_wn='cm^-1'
! Exhaustive list of all unit codes and associated units.
! When a new code is added this array *must* be updated
integer(i4b),parameter::list_len=26
- character(len=4):: c_list(list_len)= (/ 't ','v ','tau ','lam ','k ','e ','d ', &
+ character(len=4),parameter:: code_list(list_len)= (/ 't ','v ','tau ','lam ','k ','e ','d ', &
& 'v2 ','tau2','lam2','k2 ','e2 ','v1 ','tau1','lam1','k1 ','e1 ', &
& 'w ','wn ','thz ', &
& 'q ','q+ ','q- ','sq ','sq+ ','sq- ' /)
- character(len=long_len):: u_list(list_len)= (/'microseconds','m/s','s/m','Angstroms','Angstrom^-1','meV', 'Angstroms', &
- & 'm/s','s/m','Angstroms','Angstrom^-1','meV','m/s','s/m','Angstroms','Angstrom^-1','meV', &
+ character(len=long_len),parameter:: units_list(list_len)= (/'Microsecond','m/s','s/m','Angstrom','Angstrom^-1','meV', 'Angstroms', &
+ & 'm/s','s/m','Angstrom','Angstrom^-1','meV','m/s','s/m','Angstrom','Angstrom^-1','meV', &
& 'meV','cm^-1','THz', &
& 'Angstrom^-1','Angstrom^-1','Angstrom^-1','Angstrom^2','Angstrom^2','Angstrom^2'/)
+ character(len=long_len),parameter::cap_list(list_len)=(/'time-of-flight', 'neutron speed','neutron inverse speed', 'wavelength', &
+ & 'wavevector','Energy','d-spacing', 'final neutron speed', 'final neutron inverse speed', 'final wavelength', 'final wavevector', &
+ & 'final energy','final neutron speed','final neutron inverse speed','final wavelength','final wavevector','incident energy',&
+ & 'energy transfer', 'energy transfer','energy transfer', 'momentum transfer', 'momentum transfer','momentum transfer',&
+ & 'square of momentum transfer', 'square of momentum transfer', 'square of momentum transfer'/)
! Special units definitions:
character(len=4),parameter::IXCspecnoC='spno',IXCworknoC='wkno',IXCcountsC='cts '
More information about the LIBISIS-code-svn
mailing list