; $Id: lattice__define.pro,v 1.6 2007/02/17 00:10:33 kneller Exp $
;###############################################################################
;
;
;CLASS NAME:
;    lattice
;
;PURPOSE:
;
;CATEGORY:
;
;
;SUPERCLASSES:
;
;
;METHODS:
;    lattice::display
;    lattice::metrictensor
;    lattice::scalar
;    lattice::modvec
;    lattice::cross
;    lattice::standardsystem
;    lattice::tmatrix
;    lattice::rtransform
;    lattice::setLattice
;    lattice::getproperty
;    lattice::set_a
;    lattice::set_b
;    lattice::set_c
;    lattice::set_alpha
;    lattice::set_beta
;    lattice::set_gamma
;    lattice::setproperty
;    lattice::cleanup
;    lattice::reciplattice
;    lattice::init
;    lattice__define
;
;
; AUTHOR:
; Larry Kneller
; NIST Center for Neutron Research
; 100 Bureau Drive, Gaithersburg, MD 20899
; United States
; kneller@nist.gov  301-975-8839
; Thu May 18 15:20:57 2006
;
; LICENSE:
; The software in this file is written by an employee of
; National Institute of Standards and Technology
; as part of the DAVE software project.
;
; The DAVE software package is not subject to copyright protection
; and is in the public domain. It should be considered as an
; experimental neutron scattering data reduction, visualization, and
; analysis system. As such, the authors assume no responsibility
; whatsoever for its use, and make no guarantees, expressed or
; implied, about its quality, reliability, or any other
; characteristic. The use of certain trade names or commercial
; products does not imply any endorsement of a particular product,
; nor does it imply that the named product is necessarily the best
; product for the stated purpose. We would appreciate acknowledgment
; if the DAVE software is used or if the code in this file is
; included in another product.
;
;###############################################################################
;###############################################################################
;
;NAME:
;        lattice::display
;
;PURPOSE:
;       DISPLAY RESULTS FOR TESTING
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;###############################################################################
pro lattice::display
    print, 'direct params',self.la,self.lb,self.lc,self.alpha,self.beta,self.gamma, format='(a, 5f7.3,5f7.3,5f7.3,5f7.3,5f7.3,5f7.3)'
    print, 'reciprocal params', self.astar,self.bstar,self.cstar,self.alphastar,self.betastar,self.gammastar, format='(a,5f7.3,5f7.3,5f7.3,5f7.3,5f7.3,5f7.3)'
end;display

;###############################################################################
;
;NAME:
;        lattice::metrictensor
;
;PURPOSE:
;
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;RETURN VALUE:
;
;###############################################################################
function lattice::metrictensor
    g=dblarr(3,3)
;    dtor=!pi/180
    a=self.astar
    b=self.bstar
    c=self.cstar
    alphar=self.alphastar*!dtor
    betar=self.betastar*!dtor
    gammar=self.gammastar*!dtor
    g=[[a^2,a*b*cos(gammar),a*c*cos(betar)], $
       [a*b*cos(gammar),b^2,b*c*cos(alphar)], $
       [a*c*cos(betar),b*c*cos(alphar),c^2]]
    return, g
end;metrictensor

;###############################################################################
;
;NAME:
;        lattice::scalar
;
;PURPOSE:
;
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;RETURN VALUE:
;
;###############################################################################
function lattice::scalar,x,y
    g=self->metrictensor()
    prod=0.0d
    for i=0,2 do begin
        for j=0,2 do begin
        	prod=prod+x[i]*g[i,j]*y[j]
        end
    end

    return, prod
end;scalar

;###############################################################################
;
;NAME:
;        lattice::modvec
;
;PURPOSE:
;       RETURN THE MODULUS OF THE VECTOR.
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;RETURN VALUE:
;
;###############################################################################
function lattice::modvec,x
    modx=sqrt(self->scalar(x,x))
    return, modx
end;modvec


;###############################################################################
;
;NAME:
;        lattice::cross
;
;PURPOSE:
;       RETURN THE CROSS PRODUCT
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;RETURN VALUE:
;
;###############################################################################
function lattice::cross,x,y
;    z=[0.,0.,0.]
;    z(0)=x(1)*y(2)-y(1)*x(2)
;    z(1)=x(2)*y(0)-y(2)*x(0)
;    z(2)=-x(1)*y(0)+y(1)*x(0)

    z = crossp(double(x),double(y))
;    print,z
    return, z
end;cross


;###############################################################################
;
;NAME:
;        lattice::standardsystem
;
;PURPOSE:
;
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;RETURN VALUE:
;
;###############################################################################
function lattice::standardsystem,orient1,orient2

    x=orient1/self->modvec(orient1)
    proj=self->scalar(orient2,x)
    y=orient2;
    y=y-x*proj ; element by element
    y=y/self->modvec(y)
    z=self->cross(x,y)
    proj=self->scalar(z,y)
    z=z-y*proj
    z=z/self->modvec(z)

    self.x=x
    self.y=y
    self.z=z

    ;print, x,y, z
    return, 1
end;standardsystem




;###############################################################################
;
;NAME:
;        lattice::tmatrix
;
;PURPOSE:
;
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;RETURN VALUE:
;
;###############################################################################
function lattice::tmatrix, orient1,orient2,q


    dum=self->standardsystem(orient1,orient2)
    unitq=q/self->modvec(q)
    xq=self->scalar(self.x,unitq)
    yq=self->scalar(self.y,unitq)
    zq=0
    tmatrix=dblarr(4,4)
    tmatrix(0,0)=xq
    tmatrix(1,1)=xq
    tmatrix(0,1)=yq
    tmatrix(1,0)=-yq
    tmatrix(2,2)=1
    tmatrix(3,3)=1
    return, tmatrix
end;tmatrix

;###############################################################################
;
;NAME:
;        lattice::rtransform
;
;PURPOSE:
;
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;RETURN VALUE:
;
;###############################################################################
function lattice::rtransform, orient1,orient2,q,r

    tmatrix=self->tmatrix(orient1,orient2,q)
;    print,'lattice::rtransform'
;    print,'tmatrix = '
;    print,tmatrix
    rt=(tmatrix)##(r##transpose(tmatrix))

    return, rt

end;rtransform

;###############################################################################
;
;NAME:
;        lattice::setLattice
;
;PURPOSE:
;
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;###############################################################################
pro lattice::setLattice,a,b,c,alpha,beta,gamma,orient1,orient2

    self->setproperty,  la=a,$
                		lb=b,$
                		lc=c,$
                		alpha=alpha,$
                		beta=beta,$
            	    	gamma=gamma

    ret = self->standardsystem(orient1,orient2)

end;calculate
;###############################################################################
;
;NAME:
;        lattice::getproperty
;
;PURPOSE:
;
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;###############################################################################
pro lattice::getproperty,$
		la=la,$
		lb=lb,$
		lc=lc,$
		alpha=alpha,$
		beta=beta,$
		gamma=gamma,$
		astar=astar,$
		bstar=bstar,$
		cstar=cstar,$
		alphastar=alphastar,$
		betastar=betastar,$
		gammastar=gammastar,$
		x=x,$
		y=y,$
		z=z

		if arg_present(la) ne 0 then la=self.la
		if arg_present(lb) ne 0 then lb=self.lb
		if arg_present(lc) ne 0 then lc=self.lc
		if arg_present(alpha) ne 0 then alpha=self.alpha
		if arg_present(beta) ne 0 then beta=self.beta
		if arg_present(gamma) ne 0 then gamma=self.gamma

		if arg_present(astar) ne 0 then astar=self.astar
		if arg_present(bstar) ne 0 then bstar=self.bstar
		if arg_present(cstar) ne 0 then cstar=self.cstar
		if arg_present(alphastar) ne 0 then alphastar=self.alphastar
		if arg_present(betastar) ne 0 then betastar=self.betastar
		if arg_present(gammastar) ne 0 then gammastar=self.gammastar

		if arg_present(x) ne 0 then x=self.x
		if arg_present(y) ne 0 then y=self.y
		if arg_present(z) ne 0 then z=self.z

end;getproperty

function lattice::getValues

    return,{ $
    		a:self.la, $
    		b:self.lb, $
    		c:self.lc, $
    		alpha:self.alpha, $
    		beta:self.beta, $
    		gamma:self.gamma, $
    		astar:self.astar, $
    		bstar:self.bstar, $
    		cstar:self.cstar, $
    		alphastar:self.alphastar, $
    		betastar:self.betastar, $
    		gammastar:self.gammastar, $
    		x:self.x, $
    		y:self.y, $
    		z:self.z}



end;getValues
;###############################################################################
;
;NAME:
;        lattice::set_a
;
;PURPOSE:
;
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;###############################################################################
pro lattice::set_a,a
    self->setproperty,la=a
end;set_a
;###############################################################################
;
;NAME:
;        lattice::set_b
;
;PURPOSE:
;
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;###############################################################################
pro lattice::set_b,b
    self->setproperty,lb=b
end;set_b
;###############################################################################
;
;NAME:
;        lattice::set_c
;
;PURPOSE:
;
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;###############################################################################
pro lattice::set_c,c
    self->setproperty,lc=c
end;set_c
;###############################################################################
;
;NAME:
;        lattice::set_alpha
;
;PURPOSE:
;
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;###############################################################################
pro lattice::set_alpha,alpha
    self->setproperty,alpha=alpha
end;set_alpha
;###############################################################################
;
;NAME:
;        lattice::set_beta
;
;PURPOSE:
;
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;###############################################################################
pro lattice::set_beta,beta
    self->setproperty,beta=beta
end;set_beta
;###############################################################################
;
;NAME:
;        lattice::set_gamma
;
;PURPOSE:
;
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;###############################################################################
pro lattice::set_gamma,gamma
    self->setproperty,gamma=gamma
end;set_gamma


;###############################################################################
;
;NAME:
;        lattice::setproperty
;
;PURPOSE:
;
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;###############################################################################
pro lattice::setproperty,$
		la=la,$
		lb=lb,$
		lc=lc,$
		alpha=alpha,$
		beta=beta,$
		gamma=gamma,$
		x=x,$
		y=y,$
		z=z


		if n_elements(la) ne 0 then self.la=la
		if n_elements(lb) ne 0 then self.lb=lb
		if n_elements(lc) ne 0 then self.lc=lc
		if n_elements(alpha) ne 0 then self.alpha=alpha
		if n_elements(beta) ne 0 then self.beta=beta
		if n_elements(gamma) ne 0 then self.gamma=gamma
		if n_elements(x) ne 0 then self.x=x
		if n_elements(y) ne 0 then self.y=y
		if n_elements(z) ne 0 then self.z=z

        self->reciplattice  ;SETS astar,bstar,cstar,alphastar,betastar,gammastar
end;setproperty

;###############################################################################
;
;NAME:
;        lattice::cleanup
;
;PURPOSE:
;
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;###############################################################################
pro lattice::cleanup
    ;print,'lattice::cleanup'
end;cleanup

;###############################################################################
;
;NAME:
;        lattice::reciplattice
;
;PURPOSE:
;
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;###############################################################################
pro lattice::reciplattice

    a = self.la
    b = self.lb
    c = self.lc
    alpha = self.alpha
    beta = self.beta
    gamma = self.gamma

	alphar=alpha*!dtor
	betar=beta*!dtor
	gammar=gamma*!dtor



	V=a*b*c*sqrt(1-cos(alphar)^2-cos(betar)^2-cos(gammar)^2+2*cos(alphar)*cos(betar)*cos(gammar))
	self.astar=b*c*sin(alphar)/V
	self.bstar=a*c*sin(betar)/V
	self.cstar=a*b*sin(gammar)/V
	self.alphastar=acos((cos(betar)*cos(gammar)-cos(alphar))/sin(betar)/sin(gammar))/!dtor
	 self.betastar=acos((cos(alphar)*cos(gammar)-cos(betar))/sin(alphar)/sin(gammar))/!dtor
	self.gammastar=acos((cos(alphar)*cos(betar)-cos(gammar))/sin(alphar)/sin(betar))/!dtor


end;reciplattice

;###############################################################################
;
;NAME:
;        lattice::init
;
;PURPOSE:
;
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;RETURN VALUE:
;
;###############################################################################
function lattice::init, la,lb, lc, alpha, beta, gamma
	if (n_params() ne 6) then return, 0

	self.la=la
	self.lb=lb
	self.lc=lc
	self.alpha=alpha
	self.beta=beta
	self.gamma=gamma

    self->reciplattice  ;SETS recip lattice

    ;self->display

    ;void = dialog_message('Wait',/question)

	return,1
end;init


;###############################################################################
;
;NAME:
;        lattice__define
;
;PURPOSE:
;
;PARAMETERS:
;
;KEYWORDS:
;
;_EXTRA - is used to pass keywords meant for the superclass.
;
;###############################################################################
pro lattice__define

    define={lattice, $
    		la:0.0d, $
    		lb:0.0d, $
    		lc:0.0d, $
    		alpha:0.0d, $
    		beta:0.0d, $
    		gamma:0.0d, $
    		astar:0.0d, $
    		bstar:0.0d, $
    		cstar:0.0d, $
    		alphastar:0.0d, $
    		betastar:0.0d, $
    		gammastar:0.0d, $
    		x:[0.0d,0.0d,0.0d], $
    		y:[0.0d,0.0d,0.0d], $
    		z:[0.0d,0.0d,0.0d]}

end;lattice__define
