; $Id: dm_basis_r.pro,v 1.6 2005/02/07 20:03:58 qiuym Exp $
;#######################################################################
;
; NAME:
;  dm_basis_r
;
; PURPOSE:
;  construct basis vectors from the direct lattice parameters
;
; CATEGORY:
;  dcs_mslice
;
; AUTHOR:
;  Yiming Qiu
;  NIST Center for Neutron Research
;  100 Bureau Drive, Gaithersburg, MD 20899-8562
;  United States
;  yiming.qiu@nist.gov
;  Feb, 2005
;
; 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.
;
;#######################################################################

; usage:
;   abc_r=dm_basis_r([a,b,c,alpha,beta,gamma],error=error)
; parameter:
;   dir_parm: [a,b,c,alpha,beta,gamma]
; keyword:
;   error:    1 if error encountered
; return:
;   abc_r:    reciprocal lattice vectors in a reference where a//(100) and axb //(001)
function dm_basis_r,dir_parm,error=error
    abc=dblarr(3,3)
    abc_r=dblarr(3,3)
    dirparm=double(dir_parm)
    error=0    ;no error
    cosabg=dblarr(3)
    sinabg=dblarr(3)
    mydtor=!dpi/180
    for i=0,2 do begin
       cosabg[i]=cos(mydtor*dirparm[3+i])
       sinabg[i]=sin(mydtor*dirparm[3+i])
    endfor
    itmp   = where(abs(cosabg) lt 1e-15,count)
    if count ne 0 then cosabg[itmp]=0d
    itmp   = where(abs(sinabg) lt 1e-15,count)
    if count ne 0 then sinabg[itmp]=0d
    vol=dirparm[0]*dirparm[1]*dirparm[2]*sqrt(1.+$
       2.*cosabg[0]*cosabg[1]*cosabg[2]-cosabg[0]*cosabg[0]-$
       cosabg[1]*cosabg[1]-cosabg[2]*cosabg[2])
    if abs(vol) lt 1e-10 then begin
       error=1
       ok=dialog_message(['The volume of the given lattice cell is 0.','Please check lattice parameters.'],/error)
       return,abc_r
    endif
    abc[*,0]=dirparm[0]*[1.0d,0.0d,0.0d]
    abc[*,1]=dirparm[1]*[cosabg[2],sinabg[2],0.0d]
    abc[0,2]=dirparm[2]*cosabg[1]
    abc[1,2]=dirparm[2]*(cosabg[0]-cosabg[1]*cosabg[2])/sinabg[2];
    abc[2,2]=vol/(dirparm[0]*dirparm[1]*sinabg[2])
    tmp=where(abs(abc) le 1e-15,count)
    if count ne 0 then abc[tmp]=0.0d
    for i=0,2 do $
       for j=0,2 do $
         abc_r[j,i]=2.*!dpi/vol*(abc[(j+1) mod 3,(i+1) mod 3]*abc[(j+2) mod 3,(i+2) mod 3]- $
                        abc[(j+2) mod 3,(i+1) mod 3]*abc[(j+1) mod 3,(i+2) mod 3])
    tmp=where(abs(abc_r) le 1e-15,count)
    if count ne 0 then abc_r[tmp]=0.0d
    return,abc_r
end


