;
; NAME:
; hamiltoniangenerator
; DATE of WORKING VERSION: 16 May 2008
;
;PD Dr. Philip Tregenna-Piggott,
;Laboratory for Neutron Scattering,
;ETHZ and Paul-Scherrer Institute,
;CH-5232 Villigen PSI,
;Switzerland.
;
;Tel. :+41 56 310 54 05
;Fax. :+41 56 310 29 39
;Email:philip.tregenna@psi.ch
;
;
;
;
; INPUT FIELDS:
;
;
; EXAMPLES FOR POTENTIALS (must use IDL syntax as shown below):
;
;
; DISCLAIMER
;
;     This software is provided as is without any warranty whatsoever.
;     Permission to use, copy, modify, and distribute modified or
;     unmodified copies is granted, provided this disclaimer
;     is included unchanged.
;
; MODIFICATION HISTORY:
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HG_exit,event
widget_control,event.top,/destroy
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HG_cleanup,tlb
widget_control,tlb,get_uvalue = pState
heap_free,pState
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro Initialisation_Events,event
widget_control,event.top,get_uvalue = pState
uname=widget_info(event.id,/uname)

case uname of
'InitialisationAccept':    $
begin
widget_control,(*pState).MatrixName_Field,get_value = MatrixName
if MatrixName eq '' then return
(*pState).MatrixName=MatrixName
widget_control,(*pState).SourcesAM_Field,get_value = SourcesAM
if SourcesAM eq '' then return
(*pState).SourcesAM=long(SourcesAM)
if SourcesAM lt 1 then begin
    void=dialog_message(dialog_parent=event.top,/error, $
    'The number of sources of angular momenta must be at least 1')
return
endif

widget_control,event.top,/destroy
return
end
'InitialisationCancel':    $
begin
(*pState).cancel=1
widget_control,event.top,/destroy
return
end
endcase
end

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro Initialisation,MatrixName,SourcesAM,cancel,main_event

   CATCH, Error_status
if Error_status ne 0 then begin
catch, /cancel
msg=strarr(1)
msg[0]='Error Message from IDL: '+!ERROR_STATE.MSG
    void=dialog_message(dialog_parent=main_event.top,/error,msg)
return
endif



geom = widget_info(main_event.top, /geometry)
xpos = geom.xoffset + geom.xsize/2 - 100
ypos = geom.yoffset + geom.ysize/2 - 50



tlb = widget_base(title='New Hamiltonian Matrix',/col,group_leader=main_event.top, $
       xoffset=xpos,yoffset=ypos,tlb_frame_attr = 3,/modal,/align_center)



MatrixName_Field=cw_field(tlb,/col,title='Matrix Name')
SourcesAM_Field=cw_field(tlb,/col,title='Number of Sources of Angular Momenta')



void = widget_button(tlb,value = 'Accept', uname='InitialisationAccept')
void = widget_button(tlb,value = 'Cancel', uname='InitialisationCancel')


state={MatrixName_Field:MatrixName_Field, $
       SourcesAM_Field:SourcesAM_Field, $
       MatrixName:MatrixName, $
       SourcesAM:SourcesAM, $
       cancel:cancel}

widget_control,tlb,/realize

pState = ptr_new(state,/no_copy)
widget_control,tlb,set_uvalue = pState
xmanager, 'Initialisation',tlb,event_handler = 'Initialisation_Events' ;register with the xmanager

MatrixName=(*pState).MatrixName
SourcesAM=(*pState).SourcesAM
cancel=(*pState).cancel
ptr_free,pState
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
function integertest,value
remainder=fix(value)-value
if float(remainder) eq 0.0 then begin
return,1
endif else begin
return,0
endelse
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HG_save,event
widget_control,event.top,get_uvalue = pState
workdir=(*pstate).workdir
widget_control,(*pstate).HamitonianName,get_value=HamitonianName
if HamitonianName eq '' then return
widget_control,(*pstate).Parameter_Table,get_value=Parameter_Table
widget_control,(*pstate).code_text,get_value=code_text
AM=*(*pstate).AM
StringMatch=*(*pstate).StringMatch
Save_Info = {Parameter_Table:Parameter_Table, $
         HamitonianName:HamitonianName, $
         code_text:code_text, $
         StringMatch:StringMatch, $
         AM:AM}
print,'workdir: ',workdir
;
filename = DIALOG_PICKFILE(title = 'Save Settings',file='HamSession.HAM', $
         /write,filter="*.HAM",/fix_filter,path=workdir)

if filename eq '' then return
save, filename=filename, Save_Info


end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HG_restore,event
widget_control,event.top,get_uvalue = pState

workdir=(*pstate).workdir
filename=dialog_pickfile(path=workdir,/read,filter="*.HAM",/fix_filter)
if filename eq '' then return
restore,filename=filename

widget_control,(*pState).HamitonianName,set_value = Save_Info.HamitonianName
AM=save_info.AM
*(*pstate).AM=AM
*(*pstate).StringMatch=save_info.StringMatch

Multiplicity=2*AM.AMQNS+1
MatrixDimension=product(Multiplicity,/integer)
widget_control,(*pState).MatrixDimension,set_value = MatrixDimension
widget_control,(*pstate).Parameter_Table,set_value=Save_Info.Parameter_Table
widget_control,(*pstate).code_text,set_value=Save_Info.code_text

CreateZeemanDropList,event

ReadOperatorFiles,event

CreateSingleTermDropList,event
CreateCODropList,event
DisplayCompoundOperatorTerms,event

end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
function NumOrDenom,ConvertedString,number,pos
DivSearch=strpos(ConvertedString,'/')
if DivSearch eq -1 then return,1
if DivSearch gt pos then return,1
if pos eq 0 then return,1
char=strmid(ConvertedString,pos-1,1)
if char ne '/' then begin
return,1
endif else begin
return,0
endelse
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HG_ConvertStrings,event
widget_control,event.top,get_uvalue = pState
(*pstate).TranslatedStrings=strarr(100)
widget_control,(*pstate).Parameter_Table,get_value=Parameter_Table
whereentry=where(Parameter_Table[1,*] ne '', n_entries)
;
if n_entries eq 0 then return
InitialStrings=Parameter_Table[1,[whereentry]]
;print,'InitialStrings: ',InitialStrings
numbers=['0','1','2','3','4','5','6','7','8','9','.']
operators=['*','/','+','-','(','#']
;operators=['*','/','+','-','(']

FOR i = 0, n_entries-1 DO BEGIN
ConvertedString=strtrim(InitialStrings[i],2)
wherepower=strpos(ConvertedString, '^')
    while wherepower ne -1 do begin
    PowerPos=wherepower[0]
    j=0
    Number=strmid(ConvertedString,PowerPos+1,1)
    found = 1
    k=2
    while found ne 0 do begin
    char=strmid(ConvertedString,PowerPos+k,1)
        if (char eq '*') or (char eq '') then begin ;'*' recognised as a wild card character, which is not what we want
        found=0
        endif else begin
        found=strmatch(numbers,char)
        endelse
    found=total(temporary(found))
    if found ne 0 then number=number+char
    k+=1
    numberlength=k-2
    endwhile
    symbol=strmid(ConvertedString,PowerPos-1,1)
    k=0 ; k now corresponds to the length of the string to be exponated
    if symbol eq ')' then begin ;
    finish=0
    while finish eq 0 do begin
    k+=1
    char=strmid(ConvertedString,PowerPos-1-k,1)
    if char eq '(' then finish = 1
    endwhile
    k+=1
    endif else begin
    found=0
    while (found eq 0) and (PowerPos-1-k ge 0) do begin
    k+=1
    char=strmid(ConvertedString,PowerPos-1-k,1)
    if char ne '' then begin
    found=strmatch(operators,char) ; '*' will give found=1 due to wild card but this is what we want anyway
    endif else begin
    found=0
    endelse
    found=total(temporary(found))
    endwhile
    endelse


    matstring=strmid(ConvertedString,PowerPos-k,k)
    strput,ConvertedString,' ',PowerPos
    components=strsplit(ConvertedString,/extract,/preserve_null)


    components[1]=strmid(components[1],numberlength)
;    operatorlength=strlen(components[0])
;    components[0]=strmid(components[0],0,strlen(components[0])-strlen(matstring))
;    components[0]+='MATRIX_POWER('+matstring+','+strtrim(number,2)+')'
;    print,'strlen(components[0]) ',strlen(components[0])
       for m=0,fix(number)-2 do begin
       components[0]+='##'+matstring
       endfor
    NewName=strjoin(components)
    ConvertedString=NewName
    j+=1
    wherepower=strpos(ConvertedString,'^')
    endwhile
    ;
    components=strsplit(ConvertedString,'*',/extract,/preserve_null)
;    print,'ConvertedString= ',ConvertedString
    ConvertedString=strjoin(components,'##')
    ;
    ;print,'ConvertedString= ',ConvertedString

;   convert numbers to matrices
    finished=0
    k=0
    number=''
    NumberPositionIndex=0
    len=strlen(ConvertedString)
    numberstart=0
    while finished eq 0 do begin
    char=strmid(ConvertedString,k,1)
;    print,'char= ',char
        if (char eq '*') or (char eq '') then begin ;'*' recognised as a wild card character, which is not what we want
        found=0
        endif else begin
        found=strmatch(numbers,char)
;    print,'numbers= ',numbers
;    print,'found= ',found
        if total(found) ne 0 then begin
       ;this code is needed in case the number is part of a symbol
        kk=k
            while kk ne 0 do begin
             kk-=1
            charkk=strmid(ConvertedString,kk,1)
            foundkk=strmatch(numbers,charkk)
;            print,'charkk: ',charkk
;            print,'foundkkn: ',foundkk
               if total(temporary(foundkk)) eq 0 then begin
               foundkk=strmatch(operators,charkk)
;            print,'foundkko: ',foundkk
                  if total(temporary(foundkk)) ne 0 then begin
                  kk=0
                  endif else begin
                  found=0 ;part of expression, phew!
                  kk=0
                  endelse
                endif
         endwhile
        endif
      endelse
    found=total(temporary(found))
        if found ne 0 then begin
        number+=char
       if numberstart eq 0 then NumberPositionIndex=[NumberPositionIndex,k]
        numberstart=1
       k+=1
        endif else begin
        numberstart=0
        number+=' '
       k+=1
        endelse



    if k eq len then finished = 1



    endwhile

    numb=strtrim(strsplit(number,/extract),2)

    num=n_elements(numb)

if numb[0] eq '' then num=0

    if num ne 0 then begin
    NumberPositionIndex=NumberPositionIndex[1:*]
    treatment=bytarr(num)
    components=strarr(2)
       for j=0,num-1 do begin
       treatment[j]=NumOrDenom(ConvertedString,numb[j],NumberPositionIndex[j])
       endfor
    ;
       for j=0,num-1 do begin
       k=NumberPositionIndex[j]
       numberlen=strlen(numb[j])
       k+=10*j
       components[0]=strmid(ConvertedString,0,k)
       components[1]=strmid(ConvertedString,k+numberlen)
         if treatment[j] eq 1 then begin
       components[0]+='(unitary*'+numb[j]+')'
         endif else begin
         temp=components[0]
       strput,temp,' ',strlen(temp)-1
      temp+='(unitary/'+numb[j]+')'
         components[0]=temp
         endelse
        ConvertedString=strjoin(components)
       endfor
         if total(treatment) ne num then begin; must be a / sign
           components=strsplit(ConvertedString,/extract,/preserve_null)
           ConvertedString=strjoin(components,'##')
           endif
    endif
(*pstate).TranslatedStrings[i]=ConvertedString
ENDFOR



end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;+
; NAME:
;      KnK
;
; PURPOSE:
;      This function computes the Kronecker product
;
; CALLING SEQUENCE:
;       Result = KnK(A,B)
;
; INPUTS:
;   A:    array of values
;   B:    array of values
;
; EXAMPLE:
;  a = [0,1,0,1,0,1,0,1]
;  basechess = BYTARR(8,8)
;  for i=0, 7 do basechess[0,i]= SHIFT(a,i)
;  matrix = BYTARR(64,64)+255
;  chessboard = KNK(basechess,matrix)
;  WINDOW,1, XSIZE=512, YSIZE=512
;  TV,chessboard
;
; MODIFICATION HISTORY:
;   Written by:  Stefano Gagliano, RSI,  1-2003
;   Modified:
;
;-
function KnK, A,B
  sA = SIZE(A,/DIM)
  sB = SIZE(B,/DIM)

    if (N_ELEMENTS(sA) lt 2) then sA = [sA,1]
  if (N_ELEMENTS(sB) lt 2) then sB = [sB,1]

  code = SIZE(A[0]*B[0],/TYPE)
  Result = FIX(BYTARR(sA[0]*sB[0],sA[1]*sB[1]),TYPE=code)

  for i=0ul, N_ELEMENTS(A)-1 do $
    Result[(i mod sA[0])*sB[0],(i/sA[0])*sB[1]] = A[i]*B

 
  RETURN, Result
  

end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
function HG_Create_AM_Matrix,AMQNS,type=type
AMQNS=double(AMQNS)
Multiplicity=2.0*AMQNS+1.0
matrix=dblarr(Multiplicity,Multiplicity)
case type of
'AM':   $
begin
for i = 0, Multiplicity-1 do begin
matrix[i,i]=AMQNS
endfor
end
'AMp':   $
begin
for i = 0, Multiplicity-1 do begin
ColQN=AMQNS-double(i)
RowQN=ColQN+1.0
if RowQN le AMQNS then matrix[i,i-1]=sqrt(AMQNS*(AMQNS+1.0)-ColQN*(ColQN+1.0))
endfor
end
'AMm':   $
begin
for i = 0, Multiplicity-1 do begin
ColQN=AMQNS-double(i)
RowQN=ColQN-1.0
if RowQN ge -AMQNS then matrix[i,i+1]=sqrt(AMQNS*(AMQNS+1.0)-ColQN*(ColQN-1.0))
endfor
end
'AMz':   $
begin
for i = 0, Multiplicity-1 do begin
matrix[i,i]=AMQNS-double(i)
endfor
end
else:
endcase
;print,'type: ',type
;print,'matrix: ',matrix
;print,''
return,matrix
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro ExpressionMatrices__define
void={ExpressionMatrices   ,$
      Designation:''   ,$
      Operator:''  ,$
      Type:''  ,$
      tname:''  ,$
      Dimension:''  ,$
      Matrix:ptr_new() }
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro AM_Matrices__define
void={AM_Matrices   ,$
      Name_AM:''   ,$
      Name_AMp:''  ,$
      Name_AMm:''  ,$
      Name_AMx:''  ,$
      Name_AMy:''  ,$
      Name_AMz:''  ,$
      Matrix_AM:ptr_new()     ,$
      Matrix_AMp:ptr_new()    ,$
      Matrix_AMm:ptr_new()    ,$
      Matrix_AMx:ptr_new()    ,$
      Matrix_AMy:ptr_new()    ,$
      Matrix_AMz:ptr_new()    }
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
function Create_BasisMatrix, matrix,j,event
widget_control,event.top,get_uvalue = pState
;AM={Designations:Designations, $
;    AMQNS:AMQNS, $
;    n_AM:n_AM, $
;    VS:VS}
Multiplicity=2*(*(*pstate).AM).AMQNS+1
i=0
PreDim=1
PostDim=1
while i lt j do begin
PreDim*=Multiplicity[i]
i+=1
endwhile
i+=1
unitary=bytarr(PreDim,PreDim)
for k = 0, PreDim-1 do unitary[k,k]=1
PreBasisMatrix=KnK(unitary,matrix)
while i lt (*(*pstate).AM).n_AM do begin
PostDim*=Multiplicity[i]
i+=1
endwhile
unitary=bytarr(PostDim,PostDim)
for k = 0, PostDim-1 do unitary[k,k]=1
BasisMatrix=KnK(PreBasisMatrix,unitary)
return,BasisMatrix
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
function RemoveTrailingZeros,str

if size(str,/tname) ne 'STRING' then str=strtrim(string(str),2)

components_0=strsplit(str,'.',/preserve_null,/extract)
components_1=strmid(components_0[1],0,1)
components_2=strmid(components_0[1],1)
number=strjoin([components_0[0],components_1],'.' )
if components_2 eq '' then return,number
finished=0
i=1
len=strlen(components_2)
while finished eq 0 do begin
char=strmid(components_2,0,/reverse_offset)
    if char eq '0' then begin
    components_2=strmid(components_2,0,len-i)
    i+=1
    endif else begin
    finished=1
    endelse
endwhile
number=strjoin([temporary(number),components_2])
return,number
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro ShouldFilesBeGenerated_Events,event
widget_control,event.top,get_uvalue = pState
uname=widget_info(event.id,/uname)

case uname of
'Yes':    $
begin
(*pstate).result=1
widget_control,event.top,/destroy
return
end
'No':    $
begin
widget_control,event.top,/destroy
return
end
endcase


end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
function ShouldFilesBeGenerated,main_event

geom = widget_info(main_event.top, /geometry)
xpos = geom.xoffset + geom.xsize/2 - 100
ypos = geom.yoffset + geom.ysize/2 - 50

courier_font = get_font_name(/large, /courier)


tlb = widget_base(title='Success!',/col,group_leader=main_event.top, $
       xoffset=xpos,yoffset=ypos,tlb_frame_attr = 3,/modal)

Base1=widget_base(tlb,/col,/align_center)

str=strarr(3)
str[0]='The matrix files have been successfully generated and'
str[1]='passed to the program ''MagProp'''
str[2]='Would you like these matrices to be written to disk?'


void=widget_text(Base1,value = str,xsize = 50,ysize=3)


Base2=widget_base(tlb,/row,/align_center)

void = widget_button(Base2,value = 'Yes', uname='Yes',font = courier_font)
void = widget_button(Base2,value = 'No', uname='No',font = courier_font)


state={result:0}

widget_control,tlb,/realize

pState = ptr_new(state,/no_copy)
widget_control,tlb,set_uvalue = pState
xmanager, 'ShouldFilesBeGenerated',tlb,event_handler = 'ShouldFilesBeGenerated_Events' ;register with the xmanager

result=(*pstate).result
ptr_free,pState

return,result


end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HG_Create_Matrices,event


   CATCH, Error_status
if Error_status ne 0 then begin
catch, /cancel
msg=strarr(1)
msg[0]='Error Message from IDL: '+!ERROR_STATE.MSG
    void=dialog_message(dialog_parent=event.top,/error,msg)
widget_control,(*pstate).Create_Matrix_Button,sensitive=1
return
endif


widget_control,event.top,get_uvalue = pState
;AM={Designations:Designations, $
;    AMQNS:AMQNS, $
;    n_AM:n_AM, $
;    VS:VS}
;starttime=systime(/seconds)
widget_control,(*pstate).Parameter_Table,get_value=Parameter_Table

WhereNames=where(Parameter_Table[0,*] ne '', n_entries)
if n_entries eq 0 then return
Names=reform(Parameter_Table[0,WhereNames])

for ii = 0, n_entries-1 do begin
name=Names[ii]
void=where(name eq names, count)
    if count gt 1 then begin
    str=strarr(2)
    str[0]='Error for entry '+strtrim(string(ii+1),2)
    str[1]='The Matrix File Designations must be unique'
    void=dialog_message(dialog_parent=event.top,/error, str)
     return
    endif
if name eq 'lambda' then names[ii]='Lambda'
endfor


if strlowcase(size(*(*pstate).AM,/tname)) eq 'undefined' then return
widget_control,(*pstate).Create_Matrix_Button,sensitive=0
HG_ConvertStrings,event
;print,'(*pstate).TranslatedStrings: ',(*pstate).TranslatedStrings
AM_Matrices_array=replicate({AM_Matrices},(*(*pstate).AM).n_AM)
ExpressionMatrices_array=replicate({ExpressionMatrices},n_entries)

FOR ii=0,(*(*pstate).AM).n_AM-1 DO BEGIN
Multiplicity=2*(*(*pstate).AM).AMQNS[ii]+1
AM_Matrices_array[ii].Name_AM=(*(*pstate).AM).Designations[ii]
AM_Matrices_array[ii].Name_AMp=(*(*pstate).AM).Designations[ii]+'p'
AM_Matrices_array[ii].Name_AMm=(*(*pstate).AM).Designations[ii]+'m'
AM_Matrices_array[ii].Name_AMx=(*(*pstate).AM).Designations[ii]+'x'
AM_Matrices_array[ii].Name_AMy=(*(*pstate).AM).Designations[ii]+'y'
AM_Matrices_array[ii].Name_AMz=(*(*pstate).AM).Designations[ii]+'z'
;
matrix=HG_Create_AM_Matrix((*(*pstate).AM).AMQNS[ii],type='AM')
BasisMatrix=Create_BasisMatrix(matrix,ii,event)
AM_Matrices_array[ii].Matrix_AM=ptr_new(/allocate_heap)
*AM_Matrices_array[ii].Matrix_AM=BasisMatrix
;
matrix=HG_Create_AM_Matrix((*(*pstate).AM).AMQNS[ii],type='AMp')
BasisMatrix=Create_BasisMatrix(matrix,ii,event)
AM_Matrices_array[ii].Matrix_AMp=ptr_new(/allocate_heap)
*AM_Matrices_array[ii].Matrix_AMp=BasisMatrix

matrix=HG_Create_AM_Matrix((*(*pstate).AM).AMQNS[ii],type='AMm')
BasisMatrix=Create_BasisMatrix(matrix,ii,event)
AM_Matrices_array[ii].Matrix_AMm=ptr_new(/allocate_heap)
*AM_Matrices_array[ii].Matrix_AMm=BasisMatrix

matrix=HG_Create_AM_Matrix((*(*pstate).AM).AMQNS[ii],type='AMz')
BasisMatrix=Create_BasisMatrix(matrix,ii,event)
AM_Matrices_array[ii].Matrix_AMz=ptr_new(/allocate_heap)
*AM_Matrices_array[ii].Matrix_AMz=BasisMatrix
;
BasisMatrix=0.5*(*AM_Matrices_array[ii].Matrix_AMp+*AM_Matrices_array[ii].Matrix_AMm)
AM_Matrices_array[ii].Matrix_AMx=ptr_new(/allocate_heap)
*AM_Matrices_array[ii].Matrix_AMx=BasisMatrix

BasisMatrix=complex(0,-0.5)*(*AM_Matrices_array[ii].Matrix_AMp-*AM_Matrices_array[ii].Matrix_AMm)
AM_Matrices_array[ii].Matrix_AMy=ptr_new(/allocate_heap)
*AM_Matrices_array[ii].Matrix_AMy=BasisMatrix

ENDFOR
;print,'Time Elapsed1: ',systime(/seconds)-starttime

widget_control,(*pState).MatrixDimension,get_value = MatrixDimension
MatrixDimension=long(MatrixDimension[0])
unitary=dblarr(MatrixDimension,MatrixDimension)
for ii = 0 , MatrixDimension-1 do unitary[ii,ii]=1.0
im=dcomplexarr(MatrixDimension,MatrixDimension)
for ii = 0 , MatrixDimension-1 do im[ii,ii]=complex(0,1.0,/double)


TranslatedStrings=(*pstate).TranslatedStrings
wherenotblank=where(TranslatedStrings ne '',count)
if count eq 0 then return
TranslatedStrings=TranslatedStrings[wherenotblank]
nn=n_elements(TranslatedStrings)

Hx=unitary
Hy=unitary
Hz=unitary
Bx=unitary
By=unitary
Bz=unitary


for ii = 0 ,nn-1 do begin
ConvertedString=strlowcase(TranslatedStrings[ii])

       result=strpos(ConvertedString,'unitary')
      if result ne -1 then begin
        components=strsplit(ConvertedString,'unitary' ,/extract,/regex,/preserve_null)
       ConvertedString=strjoin(components,'UNITARY') 
      endif 

    for jj=0,(*(*pstate).AM).n_AM-1 do begin
       AM_Matrices_array[jj].Name_AMz=strlowcase(AM_Matrices_array[jj].Name_AMz)
       result=strpos(ConvertedString,AM_Matrices_array[jj].Name_AMz)
       if result ne -1 then begin
       components=strsplit(ConvertedString,AM_Matrices_array[jj].Name_AMz,/extract,/regex,/preserve_null)
       ConvertedString=strjoin(components,'(*AM_MATRICES_ARRAY['+strtrim(string(jj),2)+'].MATRIX_AMZ)')
       endif
       ;
       AM_Matrices_array[jj].Name_AMx=strlowcase(AM_Matrices_array[jj].Name_AMx)
       result=strpos(ConvertedString,AM_Matrices_array[jj].Name_AMx)
       if result ne -1 then begin
       components=strsplit(ConvertedString,AM_Matrices_array[jj].Name_AMx,/extract,/regex,/preserve_null)
;print,'components am x: ',components
       ConvertedString=strjoin(components,'(*AM_MATRICES_ARRAY['+strtrim(string(jj),2)+'].MATRIX_AMX)')
       endif
       ;
       AM_Matrices_array[jj].Name_AMy=strlowcase(AM_Matrices_array[jj].Name_AMy)
       result=strpos(ConvertedString,AM_Matrices_array[jj].Name_AMy)
       if result ne -1 then begin
       components=strsplit(ConvertedString,AM_Matrices_array[jj].Name_AMy,/extract,/regex,/preserve_null)
       ConvertedString=strjoin(components,'(*AM_MATRICES_ARRAY['+strtrim(string(jj),2)+'].MATRIX_AMY)')
       endif
       ;
       AM_Matrices_array[jj].Name_AMp=strlowcase(AM_Matrices_array[jj].Name_AMp)
       result=strpos(ConvertedString,AM_Matrices_array[jj].Name_AMp)
       if result ne -1 then begin
       components=strsplit(ConvertedString,AM_Matrices_array[jj].Name_AMp,/extract,/regex,/preserve_null)
       ConvertedString=strjoin(components,'(*AM_MATRICES_ARRAY['+strtrim(string(jj),2)+'].MATRIX_AMP)')
       endif
       ;
       AM_Matrices_array[jj].Name_AMm=strlowcase(AM_Matrices_array[jj].Name_AMm)
       result=strpos(ConvertedString,AM_Matrices_array[jj].Name_AMm)
       if result ne -1 then begin
       components=strsplit(ConvertedString,AM_Matrices_array[jj].Name_AMm,/extract,/regex,/preserve_null)
       ConvertedString=strjoin(components,'(*AM_MATRICES_ARRAY['+strtrim(string(jj),2)+'].MATRIX_AMM)')
       endif
       ;
       AM_Matrices_array[jj].Name_AM=strlowcase(AM_Matrices_array[jj].Name_AM)
       result=strpos(ConvertedString,AM_Matrices_array[jj].Name_AM)
       if result ne -1 then begin
       components=strsplit(ConvertedString,AM_Matrices_array[jj].Name_AM,/extract,/regex,/preserve_null)
       ConvertedString=strjoin(components,'(*AM_MATRICES_ARRAY['+strtrim(string(jj),2)+'].MATRIX_AM)')
       endif
       ;
    endfor

;print,'ConvertedString: ',ConvertedString

ConvertedString='matrix='+ConvertedString
;print,'Time Elapsed2: ',systime(/seconds)-starttime
result=execute(ConvertedString)
;print,'Time Elapsed3: ',systime(/seconds)-starttime

if result eq 0 then begin
msg=strarr(1)
msg[0]='Unable to create matrix for entry '+strtrim(string(ii+1),2)+' '+!ERROR_STATE.MSG
    void=dialog_message(dialog_parent=event.top,/error,msg)
heap_free,AM_Matrices_array
heap_free,ExpressionMatrices_array
widget_control,(*pstate).Create_Matrix_Button,sensitive=1
return
endif


ExpressionMatrices_array[ii].Designation=Parameter_Table[0,ii]
if ExpressionMatrices_array[ii].Designation eq 'lambda' then $
ExpressionMatrices_array[ii].Designation = 'Lambda'
ExpressionMatrices_array[ii].Operator=Parameter_Table[1,ii]
ExpressionMatrices_array[ii].Type=Parameter_Table[2,ii]
ExpressionMatrices_array[ii].tname=size(matrix,/tname)
ExpressionMatrices_array[ii].Dimension=MatrixDimension
ExpressionMatrices_array[ii].Matrix=ptr_new(matrix)

;print,'ExpressionMatrices_array[ii].Designation: ',ExpressionMatrices_array[ii].Designation
;print,'ExpressionMatrices_array[ii].Operator: ',ExpressionMatrices_array[ii].Operator
;print,'ExpressionMatrices_array[ii].Type: ',ExpressionMatrices_array[ii].Type
;print,'ExpressionMatrices_array[ii].Dimension: ',ExpressionMatrices_array[ii].Dimension
;print,'ExpressionMatrices_array[ii].tname: ',ExpressionMatrices_array[ii].tname
;print,''
endfor
;print,'Time Elapsed4: ',systime(/seconds)-starttime


;*(*pstate).MatricesInMemory=create_struct(*(*pstate).MatricesInMemory,designation,matrix)

if ((*pstate).ExternalEvent).ID eq -1 then begin ;write to disk
    format_real = '(ii-10,2x,ii-10,2x,d-20.10)'
        str=strarr(11)
    str[1]='# The file was generated using the program ''Hamiltonian Matrix Generator'''
    str[2]='# written by Philip Tregenna-Piggott (philip.tregenna@psi.ch).'
    str[3]='# The non-zero matrix elements in the format ''RowIndex ColumnIndex MatrixElement'' are provided'
    str[4]='# The format follows that set out by Høgni Weihe (weihe@kiku.dk).'
    str[5]='# The matrix details are as follows:'
    str[6]='# Matrix Dimension: '+strtrim(string(MatrixDimension),2)
    str[7]='# Number of Sources of Angular Momenta: '+strtrim(string((*(*pstate).AM).n_AM),2)
    str[8]='# Designations: '+strjoin(strtrim(string((*(*pstate).AM).Designations),2),' ')
    str[9]='# Corresponding Angular Momenta Quantum Numbers: '+strjoin(strtrim(string((*(*pstate).AM).AMQNS),2),' ')
    ;
    for ii = 0 ,nn-1 do begin
    FileName=(*pstate).workdir+strtrim(ExpressionMatrices_array[ii].Designation,2)+'.mat'
    str[0]='# This is file '+strtrim(ExpressionMatrices_array[ii].Designation,2)+'.mat generated on '+systime()
    str[10]='# Operator: '+ExpressionMatrices_array[ii].Operator
    openw,lun,FileName,/get_lun
       for jj=0,10 do begin
       printf,lun,str[jj]
       endfor
    ;
       if ExpressionMatrices_array[ii].tname ne 'DCOMPLEX' then begin
         for kk = 0, MatrixDimension-1 do begin
         Elements=(*ExpressionMatrices_array[ii].Matrix)[kk:*,kk]
         wherenonzero=where(Elements ne 0.0,count)
          if count ne 0 then begin
              for ll = 0, count-1 do begin
              printf,lun,strjoin([strtrim(string(kk+1),2),$
                           strtrim(string(wherenonzero[ll]+1+kk),2), $
                            RemoveTrailingZeros(Elements[wherenonzero[ll]])],'  ')
              endfor
          endif
         endfor
       endif else begin
         for kk = 0, MatrixDimension-1 do begin
         Elements=(*ExpressionMatrices_array[ii].Matrix)[kk:*,kk]
         wherenonzero=where(Elements ne 0.0,count)
          if count ne 0 then begin
              for ll = 0, count-1 do begin
           RealPart=real_part(Elements[wherenonzero[ll]])
           ImaginaryPart=imaginary(Elements[wherenonzero[ll]])
              if ImaginaryPart eq 0.0 then begin
                    printf,lun,strjoin([strtrim(string(kk+1),2),$
                    strtrim(string(wherenonzero[ll]+1+kk),2), $
                    RemoveTrailingZeros(RealPart)],'  ')
              endif
              if RealPart eq 0.0 then begin
                    printf,lun,strjoin([strtrim(string(kk+1),2),$
                    strtrim(string(wherenonzero[ll]+1+kk),2), $
                    RemoveTrailingZeros(ImaginaryPart)+'i'],'  ')
              endif
              if (RealPart ne 0.0) and (ImaginaryPart ne 0.0)  then begin
              RealPart=RemoveTrailingZeros(RealPart)
              ImaginaryPart=RemoveTrailingZeros(ImaginaryPart)+'i'
           if float(ImaginaryPart) gt 0.0 then ImaginaryPart='+'+ImaginaryPart
           stri=RealPart+ImaginaryPart
              printf,lun,strjoin([strtrim(string(kk+1),2),$
              strtrim(string(wherenonzero[ll]+1+kk),2), stri],'  ')
              endif
              endfor
          endif
         endfor
       endelse
    free_lun,lun,/force
    endfor

    void=dialog_message(dialog_parent=event.top,/information, $
    'All files have been sucessfully written to disk!')


endif else begin ; send to main program and give option to write to disk
Parameter_Table_Input=strarr(5,100)


    for ii = 0 ,nn-1 do begin
    Parameter_Table_Input[0,ii]=ExpressionMatrices_array[ii].Designation
    Parameter_Table_Input[1,ii]='Matrix Generator
    Parameter_Table_Input[2,ii]=ExpressionMatrices_array[ii].Type+'_m'
    if (ExpressionMatrices_array[ii].Type eq 'Bx') or $
       (ExpressionMatrices_array[ii].Type eq 'By') or $
       (ExpressionMatrices_array[ii].Type eq 'Bz') then begin
        Parameter_Table_Input[3,ii]=2.0
        endif else begin
        Parameter_Table_Input[3,ii]=0.0
        endelse
    endfor
widget_control,(*pstate).ExternalEvent.top,get_uvalue = pStateExternal
(*pStateExternal).Parameter_Table_Input=Parameter_Table_Input

widget_control,(*pStateExternal).Parameter_Table,set_value=Parameter_Table_Input


    for ii = 0 ,nn-1 do begin
if ii ne 0 then begin
*(*pStateExternal).MatricesInMemory=create_struct(*(*pStateExternal).MatricesInMemory,$
strtrim(ExpressionMatrices_array[ii].Designation,2),*ExpressionMatrices_array[ii].Matrix)
endif else begin
*(*pStateExternal).MatricesInMemory=create_struct(strtrim(ExpressionMatrices_array[ii].Designation,2),$
    *ExpressionMatrices_array[ii].Matrix)
endelse

endfor

;if MatrixDimension gt (*pStateExternal).Matrix_Dimension then $
 (*pStateExternal).Matrix_Dimension=MatrixDimension


ParameterInfoUpdate,(*pstate).ExternalEvent,/NewTable

result=ShouldFilesBeGenerated(event)


    if result eq 1 then begin
    format_real = '(ii-10,2x,ii-10,2x,d-20.10)'
        str=strarr(11)
    str[1]='# The file was generated using the program ''Hamiltonian Matrix Generator'''
    str[2]='# written by Philip Tregenna-Piggott (philip.tregenna@psi.ch).'
    str[3]='# The non-zero matrix elements in the format ''RowIndex ColumnIndex MatrixElement'' are provided'
    str[4]='# The format follows that set out by Høgni Weihe (weihe@kiku.dk).'
    str[5]='# The matrix details are as follows:'
    str[6]='# Matrix Dimension: '+strtrim(string(MatrixDimension),2)
    str[7]='# Number of Sources of Angular Momenta: '+strtrim(string((*(*pstate).AM).n_AM),2)
    str[8]='# Designations: '+strjoin(strtrim(string((*(*pstate).AM).Designations),2),' ')
    str[9]='# Corresponding Angular Momenta Quantum Numbers: '+strjoin(strtrim(string((*(*pstate).AM).AMQNS),2),' ')
    ;
    for ii = 0 ,nn-1 do begin
    FileName=(*pstate).workdir+strtrim(ExpressionMatrices_array[ii].Designation,2)+'.mat'
    str[0]='# This is file '+strtrim(ExpressionMatrices_array[ii].Designation,2)+'.mat generated on '+systime()
    str[10]='# Operator: '+ExpressionMatrices_array[ii].Operator
    openw,lun,FileName,/get_lun
       for jj=0,10 do begin
       printf,lun,str[jj]
       endfor
    ;
       if ExpressionMatrices_array[ii].tname ne 'DCOMPLEX' then begin
         for kk = 0, MatrixDimension-1 do begin
         Elements=(*ExpressionMatrices_array[ii].Matrix)[kk:*,kk]
;         print,'elements1: ',Elements
         wherenonzero=where(Elements ne 0.0,count)
;         print,'wherenonzero1: ',wherenonzero
          if count ne 0 then begin
              for ll = 0, count-1 do begin
              printf,lun,strjoin([strtrim(string(kk+1),2),$
                           strtrim(string(wherenonzero[ll]+1+kk),2), $
                            RemoveTrailingZeros(Elements[wherenonzero[ll]])],'  ')
              endfor
          endif
         endfor
       endif else begin
         for kk = 0, MatrixDimension-1 do begin
         Elements=(*ExpressionMatrices_array[ii].Matrix)[kk:*,kk]
;         print,'elements2: ',Elements
         wherenonzero=where(Elements ne 0.0,count)
;         print,'wherenonzero2: ',wherenonzero
          if count ne 0 then begin
              for ll = 0, count-1 do begin
           RealPart=real_part(Elements[wherenonzero[ll]])
           ImaginaryPart=imaginary(Elements[wherenonzero[ll]])
              if ImaginaryPart eq 0.0 then begin
                    printf,lun,strjoin([strtrim(string(kk+1),2),$
                    strtrim(string(wherenonzero[ll]+1+kk),2), $
                    RemoveTrailingZeros(RealPart)],'  ')
              endif
              if RealPart eq 0.0 then begin
                    printf,lun,strjoin([strtrim(string(kk+1),2),$
                    strtrim(string(wherenonzero[ll]+1+kk),2), $
                    RemoveTrailingZeros(ImaginaryPart)+'i'],'  ')
              endif
              if (RealPart ne 0.0) and (ImaginaryPart ne 0.0)  then begin
              RealPart=RemoveTrailingZeros(RealPart)
              ImaginaryPart=RemoveTrailingZeros(ImaginaryPart)+'i'
           if float(ImaginaryPart) gt 0.0 then ImaginaryPart='+'+ImaginaryPart
           stri=RealPart+ImaginaryPart
              printf,lun,strjoin([strtrim(string(kk+1),2),$
              strtrim(string(wherenonzero[ll]+1+kk),2), stri],'  ')
              endif
              endfor
          endif
         endfor
       endelse
    free_lun,lun,/force
    endfor

    endif

endelse

heap_free,AM_Matrices_array
heap_free,ExpressionMatrices_array
widget_control,(*pstate).Create_Matrix_Button,sensitive=1
;print,'Time Elapsed5: ',systime(/seconds)-starttime

end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro DesignationandValues_Events,event
widget_control,event.top,get_uvalue = pState
uname=widget_info(event.id,/uname)
case uname of
'DesignationandValuesAccept':    $
begin
n=n_elements((*pstate).Designations)
for i=0,n-1 do begin
widget_control,(*pstate).DesignationStruc.(i),get_value=Designation
if Designation eq '' then begin
    void=dialog_message(dialog_parent=event.top,/error, $
    'Please enter a symbol for entry '+strtrim(string(i+1),2))
return
endif
;
if (strupcase(Designation) eq 'B') or (strupcase(Designation) eq 'H') then begin
str=strarr(2)
str[0]='Error detected for entry '+strtrim(string(i+1),2)
str[1]='The symbols ''B'' and ''H'' are reserved to represent the magnetic field'
    void=dialog_message(dialog_parent=event.top,/error,str)
return
endif
;
if strmatch(strlowcase(designation),'im') eq 1 then begin
str=strarr(3)
str[0]='Error detected for entry '+strtrim(string(i+1),2)
str[1]='The symbol ''im'' is reserved to designate'
str[2]='the square root of -1.'
    void=dialog_message(dialog_parent=event.top,/error,str)
return
endif
;
pos=strpos(strupcase(Designation), 'Z')
if pos ne -1 then begin
str=strarr(3)
str[0]='Error detected for entry '+strtrim(string(i+1),2)
str[1]='For reasons of clarity, the symbol defining the total'
str[2]='angular momentum should not contain the letter ''z'''
    void=dialog_message(dialog_parent=event.top,/error,str)
return
endif
;
pos=strpos(strupcase(Designation), 'Y')
if pos ne -1 then begin
str=strarr(3)
str[0]='Error detected for entry '+strtrim(string(i+1),2)
str[1]='For reasons of clarity, the symbol defining the total'
str[2]='angular momentum should not contain the letter ''y'''
    void=dialog_message(dialog_parent=event.top,/error,str)
return
endif
;
pos=strpos(strupcase(Designation), 'X')
if pos ne -1 then begin
str=strarr(3)
str[0]='Error detected for entry '+strtrim(string(i+1),2)
str[1]='For reasons of clarity, the symbol defining the total'
str[2]='angular momentum should not contain the letter ''x'''
    void=dialog_message(dialog_parent=event.top,/error,str)
return
endif
;
pos=strpos(Designation, '+')
if pos ne -1 then begin
str=strarr(3)
str[0]='Error detected for entry '+strtrim(string(i+1),2)
str[1]='For reasons of clarity, the symbol defining the total'
str[2]='angular momentum should not contain the symbol ''+'''
    void=dialog_message(dialog_parent=event.top,/error,str)
return
endif
;
pos=strpos(Designation, '-')
if pos ne -1 then begin
str=strarr(3)
str[0]='Error detected for entry '+strtrim(string(i+1),2)
str[1]='For reasons of clarity, the symbol defining the total'
str[2]='angular momentum should not contain the symbol ''-'''
    void=dialog_message(dialog_parent=event.top,/error,str)
return
endif

;
if strmatch(strlowcase(designation),'ii') eq 1 then begin
str=strarr(3)
str[0]='Error detected for entry '+strtrim(string(i+1),2)
str[1]='The symbol ''ii'' is a reserved'
str[2]='program variable.'
    void=dialog_message(dialog_parent=event.top,/error,str)
return
endif
;
;
if strmatch(strlowcase(designation),'ll') eq 1 then begin
str=strarr(3)
str[0]='Error detected for entry '+strtrim(string(i+1),2)
str[1]='The symbol ''ll'' is a reserved'
str[2]='program variable.'
    void=dialog_message(dialog_parent=event.top,/error,str)
return
endif
;
;
if strmatch(strlowcase(designation),'kk') eq 1 then begin
str=strarr(3)
str[0]='Error detected for entry '+strtrim(string(i+1),2)
str[1]='The symbol ''kk'' is a reserved'
str[2]='program variable.'
    void=dialog_message(dialog_parent=event.top,/error,str)
return
endif
;
;
if strmatch(strlowcase(designation),'nn') eq 1 then begin
str=strarr(3)
str[0]='Error detected for entry '+strtrim(string(i+1),2)
str[1]='The symbol ''nn'' is a reserved'
str[2]='program variable.'
    void=dialog_message(dialog_parent=event.top,/error,str)
return
endif
;
if strmatch(strlowcase(designation),'mm') eq 1 then begin
str=strarr(3)
str[0]='Error detected for entry '+strtrim(string(i+1),2)
str[1]='The symbol ''mm'' is a reserved'
str[2]='program variable.'
    void=dialog_message(dialog_parent=event.top,/error,str)
return
endif
;
;
if strmatch(strlowcase(designation),'jj') eq 1 then begin
str=strarr(3)
str[0]='Error detected for entry '+strtrim(string(i+1),2)
str[1]='The symbol ''jj'' is a reserved'
str[2]='program variable.'
    void=dialog_message(dialog_parent=event.top,/error,str)
return
endif
;


if strmatch(strlowcase(designation),'unitary') eq 1 then begin
str=strarr(3)
str[0]='Error detected for entry '+strtrim(string(i+1),2)
str[1]='The word ''unitary'' is reserved'
str[2]='to designate the unit matrix'
    void=dialog_message(dialog_parent=event.top,/error,str)
return
endif

numbers=['0','1','2','3','4','5','6','7','8','9','.']

FirstCharacter=strmid(Designation,0,1)
found=strmatch(numbers,FirstCharacter)
found=total(temporary(found))
if found ne 0 then begin
str=strarr(3)
str[0]='Error detected for entry '+strtrim(string(i+1),2)
str[1]='The character defining the total angular momentum'
str[2]='should not begin with a number'
    void=dialog_message(dialog_parent=event.top,/error,str)
return
endif

for k=0,6 do begin
brackets=['(',')','[',']','{','}','|']
pos=strpos(Designation,brackets[k])
if pos ne -1 then begin
str=strarr(3)
str[0]='Error detected for entry '+strtrim(string(i+1),2)
str[1]='Sorry, but the symbol denoting the total angular'
str[2]='momentum should not contain brackets of any kind'
    void=dialog_message(dialog_parent=event.top,/error,str)
return
endif
endfor

;
widget_control,(*pstate).AMQNStruc.(i),get_value=AMQN
if AMQN eq 0.0 then begin
str=strarr(2)
str[0]='Error detected for entry '+strtrim(string(i+1),2)
str[1]='Please enter a value for the total angular momentum other than zero'
    void=dialog_message(dialog_parent=event.top,/error,str)
return
endif
;

if integertest(AMQN*2.0) eq 0 then begin
str=strarr(2)
str[0]='Error detected for entry '+strtrim(string(i+1),2)
str[1]='Total angular momentum must be integer or half integer'
    void=dialog_message(dialog_parent=event.top,/error,str)
return
endif

(*pstate).Designations[i]=Designation
(*pstate).AMQNS[i]=AMQN
endfor
if n_elements((*pstate).Designations) ne n_elements(uniq((*pstate).Designations)) then begin
    void=dialog_message(dialog_parent=event.top,/error, $
    'The angular momenta designations must be unique')
return
endif

;check to see whether the name of each designation
;is contained in the names of the others

if n gt 1 then begin
for i=0,n-1 do begin
designation=(*pstate).Designations[i]
designations=reform((*pstate).Designations[where((*pstate).Designations ne designation)])
wherefound=where(strpos(Designations,designation) ne -1,count)
  if count ne 0 then begin
  desmatch=designations[wherefound[0]]
  str=strarr(3)
  str[0]='Error detected for entry '+strtrim(string(i+1),2)
  str[1]='The designation '''+designation+''' is contained in '''+desmatch+'''.'
  str[2]='Sorry, but this is not allowed.'  
    void=dialog_message(dialog_parent=event.top,/error,str)
    return
  endif
endfor
endif
;
;



(*pstate).cancel=0
widget_control,event.top,/destroy
return
end
'DesignationandValuesCancel':    $
begin
widget_control,event.top,/destroy
return
end
else:
endcase
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro DesignationandValues,Designations,AMQNS,cancel,main_event
geom = widget_info(main_event.top, /geometry)
xpos = geom.xoffset + geom.xsize/2 - 100
ypos = geom.yoffset + geom.ysize/2 - 50

tlb = widget_base(title='Angular Momentum Designations and Quantum Numbers ',/col,group_leader=main_event.top, $
       xoffset=xpos,yoffset=ypos,tlb_frame_attr = 3,/align_center,/modal)
space='                '
void=widget_text(tlb,value='          Designation'+space+'Total Angular Momentum')
n=n_elements(Designations)
suffix=strtrim(string(0),2)
Basestruc=create_struct('Base'+suffix,0L)
DesignationStruc=create_struct('Designation'+suffix,0L)
AMQNStruc=create_struct('AMQN'+suffix,0L)
;
if n gt 1 then begin
    for i = 1, n-1 do begin
    suffix=strtrim(string(i),2)
    Basestruc=create_struct(Basestruc,'Base'+suffix,0L)
    DesignationStruc=create_struct(DesignationStruc,'Designation'+suffix,0L)
    AMQNStruc=create_struct(AMQNStruc,'AMQN'+suffix,0L)
    endfor
endif

for i = 0, n-1 do begin
Basestruc.(i)=widget_base(tlb,/row,/align_center)
DesignationStruc.(i)=cw_field(Basestruc.(i),/col,title='', $
       value=Designations[i])
AMQNStruc.(i)=cw_field(Basestruc.(i),/col,title='', $
       value=AMQNS[i])
endfor


void = widget_button(tlb,value = 'Accept', uname='DesignationandValuesAccept')
void = widget_button(tlb,value = 'Cancel', uname='DesignationandValuesCancel')

state={DesignationStruc:DesignationStruc, $
       AMQNStruc:AMQNStruc, $
       Designations:Designations, $
       AMQNS:AMQNS, $
       cancel:1}

widget_control,tlb,/realize

pState = ptr_new(state,/no_copy)
widget_control,tlb,set_uvalue = pState
xmanager, 'DesignationandValues',tlb,event_handler = 'DesignationandValues_Events' ;register with the xmanager

Designations=(*pstate).Designations
AMQNS=(*pstate).AMQNS
cancel=(*pstate).cancel
ptr_free,pState
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro AddtoExpression,entry,event
widget_control,event.top,get_uvalue = pState
widget_control,(*pstate).code_text,get_value=code_text
if code_text eq '' then begin
widget_control,(*pstate).code_text,set_value=entry
return
endif
Plusend=strpos(code_text,'+',/reverse_search)
Minusend=strpos(code_text,'-',/reverse_search)
length=strlen(code_text)-1
;
if (Plusend eq length) or (Minusend eq length) then begin
code_text+=entry
endif else begin
code_text+='+'
code_text+=entry
endelse
widget_control,(*pstate).code_text,set_value=code_text
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro CreateZeemanDropList,event
widget_control,event.top,get_uvalue = pState
;AM={Designations:Designations, $
;    AMQNS:AMQNS, $
;    n_AM:n_AM, $
;    VS:VS}
;AM=*(*pstate).AM ;it's easier than working with pointers
str=strarr(3*(*(*pstate).AM).n_AM)
j=0
i=0
while i le (3*(*(*pstate).AM).n_AM)-1 do begin
str[i]='Bx*'+(*(*pstate).AM).Designations[j]+'x'
str[i+1]='By*'+(*(*pstate).AM).Designations[j]+'y'
str[i+2]='Bz*'+(*(*pstate).AM).Designations[j]+'z
i+=3
j+=1
endwhile
widget_control,(*pstate).Zeeman_Droplist,set_value=str
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro SingleOperatorTermsStringMatch,event
widget_control,event.top,get_uvalue = pState

;AM={Designations:Designations, $
;    AMQNS:AMQNS, $
;    n_AM:n_AM, $
;    VS:VS}
;
;AM=*(*pstate).AM ;it's easier than working with pointers

FOR j=0,(*(*pstate).AM).n_AM-1 DO BEGIN
d=(*(*pstate).AM).Designations[j]
RedRep=fix(2*(*(*pstate).AM).AMQNS[j])
;
case RedRep of
1   : $
begin
str=''
end
2   : $ ; second order terms
begin
SecondOrderTerms=*(*pstate).SecondOrderTerms
for i = 0, n_elements(SecondOrderTerms)-1 do begin
term=strsplit(SecondOrderTerms[i],'=',/extract)
components=strtrim(strsplit(term[0],'O',/extract,/preserve_null),2)
line=strjoin(components,d)
if n_elements(term) eq 2 then begin
term[1]=strjoin(strtrim(strsplit(term[1],'O',/extract,/preserve_null),2),d)
 *(*pstate).StringMatch=[*(*pstate).StringMatch,strjoin([line,term[1]],'=')]
endif
    if i eq 0 then begin
    str=line
    endif else begin
    str=[str,line]
    endelse
endfor
end
3   : $ ; second order terms
begin
SecondOrderTerms=*(*pstate).SecondOrderTerms
for i = 0, n_elements(SecondOrderTerms)-1 do begin
term=strsplit(SecondOrderTerms[i],'=',/extract)
components=strtrim(strsplit(term[0],'O',/extract,/preserve_null),2)
line=strjoin(components,d)
if n_elements(term) eq 2 then begin
term[1]=strjoin(strtrim(strsplit(term[1],'O',/extract,/preserve_null),2),d)
 *(*pstate).StringMatch=[*(*pstate).StringMatch,strjoin([line,term[1]],'=')]
endif
    if i eq 0 then begin
    str=line
    endif else begin
    str=[str,line]
    endelse
endfor
end
4   : $ ; second and fourth order terms
begin
SecondOrderTerms=*(*pstate).SecondOrderTerms
for i = 0, n_elements(SecondOrderTerms)-1 do begin
term=strsplit(SecondOrderTerms[i],'=',/extract)
components=strtrim(strsplit(term[0],'O',/extract,/preserve_null),2)
line=strjoin(components,d)
if n_elements(term) eq 2 then begin
term[1]=strjoin(strtrim(strsplit(term[1],'O',/extract,/preserve_null),2),d)
 *(*pstate).StringMatch=[*(*pstate).StringMatch,strjoin([line,term[1]],'=')]
endif
    if i eq 0 then begin
    str=line
    endif else begin
    str=[str,line]
    endelse
endfor
;
FourthOrderTerms=*(*pstate).FourthOrderTerms
for i = 0, n_elements(FourthOrderTerms)-1 do begin
term=strsplit(FourthOrderTerms[i],'=',/extract)
components=strtrim(strsplit(term[0],'O',/extract,/preserve_null),2)
line=strjoin(components,d)
if n_elements(term) eq 2 then begin
term[1]=strjoin(strtrim(strsplit(term[1],'O',/extract,/preserve_null),2),d)
 *(*pstate).StringMatch=[*(*pstate).StringMatch,strjoin([line,term[1]],'=')]
endif
    if n_elements(str) eq 0 then begin
    str=line
    endif else begin
    str=[str,line]
    endelse
endfor
end
5   : $ ; second and fourth order terms
begin
SecondOrderTerms=*(*pstate).SecondOrderTerms
for i = 0, n_elements(SecondOrderTerms)-1 do begin
term=strsplit(SecondOrderTerms[i],'=',/extract)
components=strtrim(strsplit(term[0],'O',/extract,/preserve_null),2)
line=strjoin(components,d)
if n_elements(term) eq 2 then begin
term[1]=strjoin(strtrim(strsplit(term[1],'O',/extract,/preserve_null),2),d)
 *(*pstate).StringMatch=[*(*pstate).StringMatch,strjoin([line,term[1]],'=')]
endif
    if i eq 0 then begin
    str=line
    endif else begin
    str=[str,line]
    endelse
endfor
;
FourthOrderTerms=*(*pstate).FourthOrderTerms
for i = 0, n_elements(FourthOrderTerms)-1 do begin
term=strsplit(FourthOrderTerms[i],'=',/extract)
components=strtrim(strsplit(term[0],'O',/extract,/preserve_null),2)
line=strjoin(components,d)
if n_elements(term) eq 2 then begin
term[1]=strjoin(strtrim(strsplit(term[1],'O',/extract,/preserve_null),2),d)
 *(*pstate).StringMatch=[*(*pstate).StringMatch,strjoin([line,term[1]],'=')]
endif
    if n_elements(str) eq 0 then begin
    str=line
    endif else begin
    str=[str,line]
    endelse
endfor
end
else:   $ ; second, fourth and sixth order terms
begin
SecondOrderTerms=*(*pstate).SecondOrderTerms
for i = 0, n_elements(SecondOrderTerms)-1 do begin
term=strsplit(SecondOrderTerms[i],'=',/extract)
components=strtrim(strsplit(term[0],'O',/extract,/preserve_null),2)
line=strjoin(components,d)
if n_elements(term) eq 2 then begin
term[1]=strjoin(strtrim(strsplit(term[1],'O',/extract,/preserve_null),2),d)
 *(*pstate).StringMatch=[*(*pstate).StringMatch,strjoin([line,term[1]],'=')]
endif
    if i eq 0 then begin
    str=line
    endif else begin
    str=[str,line]
    endelse
endfor
;
FourthOrderTerms=*(*pstate).FourthOrderTerms
for i = 0, n_elements(FourthOrderTerms)-1 do begin
term=strsplit(FourthOrderTerms[i],'=',/extract)
components=strtrim(strsplit(term[0],'O',/extract,/preserve_null),2)
line=strjoin(components,d)
if n_elements(term) eq 2 then begin
term[1]=strjoin(strtrim(strsplit(term[1],'O',/extract,/preserve_null),2),d)
 *(*pstate).StringMatch=[*(*pstate).StringMatch,strjoin([line,term[1]],'=')]
endif
    if n_elements(str) eq 0 then begin
    str=line
    endif else begin
    str=[str,line]
    endelse
endfor
;
SixthOrderTerms=*(*pstate).SixthOrderTerms
for i = 0, n_elements(SixthOrderTerms)-1 do begin
term=strsplit(SixthOrderTerms[i],'=',/extract)
components=strtrim(strsplit(term[0],'O',/extract,/preserve_null),2)
line=strjoin(components,d)
if n_elements(term) eq 2 then begin
term[1]=strjoin(strtrim(strsplit(term[1],'O',/extract,/preserve_null),2),d)
 *(*pstate).StringMatch=[*(*pstate).StringMatch,strjoin([line,term[1]],'=')]
endif
    if n_elements(str) eq 0 then begin
    str=line
    endif else begin
    str=[str,line]
    endelse
endfor
end
endcase
ENDFOR
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
function SingleOperatorTerms,RedRep,d,event
widget_control,event.top,get_uvalue = pState
case RedRep of
1   : $
begin
str=''
return,str
end
2   : $ ; second order terms
begin
SecondOrderTerms=*(*pstate).SecondOrderTerms
for i = 0, n_elements(SecondOrderTerms)-1 do begin
term=strsplit(SecondOrderTerms[i],'=',/extract)
components=strtrim(strsplit(term[0],'O',/extract,/preserve_null),2)
line=strjoin(components,d)
    if i eq 0 then begin
    str=line
    endif else begin
    str=[str,line]
    endelse
endfor
return,str
end
3   : $ ; second order terms
begin
SecondOrderTerms=*(*pstate).SecondOrderTerms
for i = 0, n_elements(SecondOrderTerms)-1 do begin
term=strsplit(SecondOrderTerms[i],'=',/extract)
components=strtrim(strsplit(term[0],'O',/extract,/preserve_null),2)
line=strjoin(components,d)
    if i eq 0 then begin
    str=line
    endif else begin
    str=[str,line]
    endelse
endfor
return,str
end
4   : $ ; second and fourth order terms
begin
SecondOrderTerms=*(*pstate).SecondOrderTerms
for i = 0, n_elements(SecondOrderTerms)-1 do begin
term=strsplit(SecondOrderTerms[i],'=',/extract)
components=strtrim(strsplit(term[0],'O',/extract,/preserve_null),2)
line=strjoin(components,d)
    if i eq 0 then begin
    str=line
    endif else begin
    str=[str,line]
    endelse
endfor
;
FourthOrderTerms=*(*pstate).FourthOrderTerms
for i = 0, n_elements(FourthOrderTerms)-1 do begin
term=strsplit(FourthOrderTerms[i],'=',/extract)
components=strtrim(strsplit(term[0],'O',/extract,/preserve_null),2)
line=strjoin(components,d)
    if n_elements(str) eq 0 then begin
    str=line
    endif else begin
    str=[str,line]
    endelse
endfor
return,str
end
5   : $ ; second and fourth order terms
begin
SecondOrderTerms=*(*pstate).SecondOrderTerms
for i = 0, n_elements(SecondOrderTerms)-1 do begin
term=strsplit(SecondOrderTerms[i],'=',/extract)
components=strtrim(strsplit(term[0],'O',/extract,/preserve_null),2)
line=strjoin(components,d)
    if i eq 0 then begin
    str=line
    endif else begin
    str=[str,line]
    endelse
endfor
;
FourthOrderTerms=*(*pstate).FourthOrderTerms
for i = 0, n_elements(FourthOrderTerms)-1 do begin
term=strsplit(FourthOrderTerms[i],'=',/extract)
components=strtrim(strsplit(term[0],'O',/extract,/preserve_null),2)
line=strjoin(components,d)
    if n_elements(str) eq 0 then begin
    str=line
    endif else begin
    str=[str,line]
    endelse
endfor
return,str
end
else:   $ ; second, fourth and sixth order terms
begin
SecondOrderTerms=*(*pstate).SecondOrderTerms
for i = 0, n_elements(SecondOrderTerms)-1 do begin
term=strsplit(SecondOrderTerms[i],'=',/extract)
components=strtrim(strsplit(term[0],'O',/extract,/preserve_null),2)
line=strjoin(components,d)
    if i eq 0 then begin
    str=line
    endif else begin
    str=[str,line]
    endelse
endfor
;
FourthOrderTerms=*(*pstate).FourthOrderTerms
for i = 0, n_elements(FourthOrderTerms)-1 do begin
term=strsplit(FourthOrderTerms[i],'=',/extract)
components=strtrim(strsplit(term[0],'O',/extract,/preserve_null),2)
line=strjoin(components,d)
    if n_elements(str) eq 0 then begin
    str=line
    endif else begin
    str=[str,line]
    endelse
endfor
;
SixthOrderTerms=*(*pstate).SixthOrderTerms
for i = 0, n_elements(SixthOrderTerms)-1 do begin
term=strsplit(SixthOrderTerms[i],'=',/extract)
components=strtrim(strsplit(term[0],'O',/extract,/preserve_null),2)
line=strjoin(components,d)
    if n_elements(str) eq 0 then begin
    str=line
    endif else begin
    str=[str,line]
    endelse
endfor
return,str
end
endcase
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro DisplayCompoundOperatorTerms,event
widget_control,event.top,get_uvalue = pState
index1=widget_info((*pstate).CT_Droplist_1,/droplist_select)
index2=widget_info((*pstate).CT_Droplist_2,/droplist_select)
if index1 eq index2 then begin
widget_control,(*pstate).ScalarProduct_Droplist,set_value=''
widget_control,(*pstate).CrossProduct_Droplist,set_value=''
return
endif
des1=(*(*pstate).AM).Designations[index1]
des2=(*(*pstate).AM).Designations[index2]
ScalarTerms=strarr(4)
ScalarTerms[0]=des1+'x*'+des2+'x+'+des1+'y*'+des2+'y+'+des1+'z*'+des2+'z'
ScalarTerms[1]=des1+'x*'+des2+'x'
ScalarTerms[2]=des1+'y*'+des2+'y'
ScalarTerms[3]=des1+'z*'+des2+'z'
widget_control,(*pstate).ScalarProduct_Droplist,set_value=ScalarTerms
CrossTerms=strarr(4)
CrossTerms[0]=des1+'y*'+des2+'z-'+des1+'z*'+des2+'y+'+$
           des1+'z*'+des2+'x-'+des1+'x*'+des2+'z+'+$
           des1+'x*'+des2+'y-'+des1+'y*'+des2+'x'
CrossTerms[1]=des1+'y*'+des2+'z-'+des1+'z*'+des2+'y'
CrossTerms[2]=des1+'z*'+des2+'x-'+des1+'x*'+des2+'z'
CrossTerms[3]=des1+'x*'+des2+'y-'+des1+'y*'+des2+'x'
widget_control,(*pstate).CrossProduct_Droplist,set_value=CrossTerms
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro DisplaySingleOperatorTerms,event
widget_control,event.top,get_uvalue = pState
index=widget_info((*pstate).SingleTermSelect_Droplist,/droplist_select)
;AM={Designations:Designations, $
;    AMQNS:AMQNS, $
;    n_AM:n_AM, $
;    VS:VS}
;
;AM=*(*pstate).AM ;it's easier than working with pointers
d=(*(*pstate).AM).Designations[index]
RedRep=fix(2*(*(*pstate).AM).AMQNS[index])

str=SingleOperatorTerms(RedRep,d,event)

widget_control,(*pstate).SingleTerm_Droplist,set_value=str
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro CreateSingleTermDropList,event
widget_control,event.top,get_uvalue = pState
;AM={Designations:Designations, $
;    AMQNS:AMQNS, $
;    n_AM:n_AM, $
;    VS:VS}
;AM=*(*pstate).AM ;it's easier than working with pointers
WhereHalf=where((*(*pstate).AM).AMQNS gt 0.5, count)
if count eq 0 then begin
widget_control,(*pstate).SingleTermBase,sensitive=0
return
endif
widget_control,(*pstate).SingleTermBase,sensitive=1
str=strarr((*(*pstate).AM).n_AM)
for i = 0, (*(*pstate).AM).n_AM-1 do begin
str[i]=(*(*pstate).AM).Designations[i]+'='+strmid(strtrim(string((*(*pstate).AM).AMQNS[i]),2),0,3)
endfor
widget_control,(*pstate).SingleTermSelect_Droplist,set_value=str

DisplaySingleOperatorTerms,event

end


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro CreateCODropList,event
widget_control,event.top,get_uvalue = pState
;AM={Designations:Designations, $
;    AMQNS:AMQNS, $
;    n_AM:n_AM, $
;    VS:VS}
;AM=*(*pstate).AM ;it's easier than working with pointers
if (*(*pstate).AM).n_AM eq 1 then begin
;if AM.n_AM eq 1 then begin
widget_control,(*pstate).CT_Droplist_1,set_value=''
widget_control,(*pstate).CT_Droplist_2,set_value=''
widget_control,(*pstate).CompoundTermBase,sensitive=0
endif else begin
widget_control,(*pstate).CT_Droplist_1,set_value=(*(*pstate).AM).Designations
widget_control,(*pstate).CT_Droplist_2,set_value=(*(*pstate).AM).Designations
widget_control,(*pstate).CompoundTermBase,sensitive=1
endelse
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro ReadOperatorFiles,event
widget_control,event.top,get_uvalue = pState
delim=(*pstate).delim
;
;second terms order
;
filename=!DAVE_AUXILIARY_DIR+'PSI'+delim+'MagProp'+delim+'SingleOperatorSecondOrderTerms.txt'
if file_test(filename) eq 1 then begin
line=''
nlines=file_lines(filename)
str=strarr(nlines)
openr,lun,filename,/get_lun
for i = 0, nlines-1 do begin
readf,lun,line
str[i]=line
endfor
free_lun,lun,/force
whereComment=where(strpos(str, ';') ne 0,count)
if count ne 0 then begin
str=str[whereComment]
endif else begin
str=''
endelse
*(*pstate).SecondOrderTerms=str
endif else begin
str=strarr(2)
str[0]='Oz^2-(1/3)*O*(O+1)'
str[1]='Ox^2-Oy^2'
*(*pstate).SecondOrderTerms=str
openw,lun,filename,/get_lun
for i = 0, 1 do begin
printf,lun,str[i]
endfor
free_lun,lun,/force
endelse
;
;fourth terms order
;
filename=!DAVE_AUXILIARY_DIR+'PSI'+delim+'MagProp'+delim+'SingleOperatorFourthOrderTerms.txt'
if file_test(filename) eq 1 then begin
line=''
nlines=file_lines(filename)
str=strarr(nlines)
openr,lun,filename,/get_lun
for i = 0, nlines-1 do begin
readf,lun,line
str[i]=line
endfor
free_lun,lun,/force
whereComment=where(strpos(str, ';') ne 0,count)
if count ne 0 then begin
str=str[whereComment]
endif else begin
str=''
endelse
*(*pstate).FourthOrderTerms=str
endif else begin
str=strarr(4)
str[0]='O(0,4)=35*Oz^4-30*O*(O+1)*Oz^2+25*Oz^2-6*O*(O+1)+3*O^2*(O+1)^2'
str[1]='O(2,4)=0.25*((7*Oz^2-O*(O+1)-5)*(Op^2+Om^2)+(Op^2+Om^2)*(7*Oz^2-O*(O+1)-5))'
str[2]='O(3,4)=0.25*(Oz*(Op^3+Om^3)+(Op^3+Om^3)*Oz)'
str[3]='O(4,4)=0.5*(Op^4+Om^4)'
*(*pstate).FourthOrderTerms=str
openw,lun,filename,/get_lun
for i = 0, 3 do begin
printf,lun,str[i]
endfor
free_lun,lun,/force
endelse
;
;sixth terms order
;
filename=!DAVE_AUXILIARY_DIR+'PSI'+delim+'MagProp'+delim+'SingleOperatorSixthOrderTerms.txt'
if file_test(filename) eq 1 then begin
line=''
nlines=file_lines(filename)
str=strarr(nlines)
openr,lun,filename,/get_lun
for i = 0, nlines-1 do begin
readf,lun,line
str[i]=line
endfor
free_lun,lun,/force
whereComment=where(strpos(str, ';') ne 0,count)
if count ne 0 then begin
str=str[whereComment]
endif else begin
str=''
endelse
*(*pstate).SixthOrderTerms=str
endif else begin
str=strarr(4)
str[0]='O(0,6)=231*Oz^6-315*O*(O+1)*Oz^4+735*Oz^4+105*O^2*(O+1)^2*Sz^2-525*O*(O+1)*Oz^2+'+ $
        '294*Oz^2-5*S^3*(O+1)^3+40*O^2*(O+1)^2-60*O*(O+1)'
str[1]='O(3,6)=0.25*((11*Oz^3-3*O*(O+1)*Oz-59*Oz)*(Op^3+Om^3)+(Op^3+Om^3)*(11*Oz^3-3*O*(O+1)*Oz-59*Oz))'
str[2]='O(4,6)=0.25*((11*Oz^2-O*(O+1)-38)*(O+^4+O-^4)+(O+^4+O-^4)*(11*Oz^2-O*(O+1)-38))'
str[3]='O(6,6)=0.5*(Op^6+Om^6)'
*(*pstate).SixthOrderTerms=str
openw,lun,filename,/get_lun
for i = 0, 3 do begin
printf,lun,str[i]
endfor
free_lun,lun,/force
;
endelse
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HG_NewHam,event
widget_control,event.top,get_uvalue = pState

MatrixName=''
SourcesAM=0L
cancel=0
HG_Clear_Table,event
HG_Clear_Palette,event
Initialisation,MatrixName,SourcesAM,cancel,event
if cancel eq 1 then return
widget_control,(*pState).HamitonianName,set_value = MatrixName
;
cancel=0
Designations=strarr(SourcesAM)
AMQNS=fltarr(SourcesAM)
DesignationandValues,Designations,AMQNS,cancel,event
if cancel eq 1 then return
n_AM=n_elements(Designations)

VS=strarr(7+n_AM*6)
VS[0]='i'
VS[1]='Bx'
VS[2]='By'
VS[3]='Bz'
VS[4]='Hx'
VS[5]='Hy'
VS[6]='Hz'
;
j=7
for i=0,n_AM-1 do begin
VS[j]=Designations[i]
j+=1
VS[j]=Designations[i]+'p'
j+=1
VS[j]=Designations[i]+'m'
j+=1
VS[j]=Designations[i]+'x'
j+=1
VS[j]=Designations[i]+'y'
j+=1
VS[j]=Designations[i]+'z
j+=1
endfor

AM={Designations:Designations, $
    AMQNS:AMQNS, $
    n_AM:n_AM, $
    VS:VS}
*(*pstate).AM=AM
;print,(*(*pstate).AM).AMQNS[3]
Multiplicity=2*AMQNS+1
MatrixDimension=product(Multiplicity,/integer)
widget_control,(*pState).MatrixDimension,set_value = MatrixDimension

CreateZeemanDropList,event

ReadOperatorFiles,event
*(*pstate).StringMatch='void'
SingleOperatorTermsStringMatch,event
CreateSingleTermDropList,event
CreateCODropList,event
DisplayCompoundOperatorTerms,event

;print,'*(*pstate).StringMatch: ',*(*pstate).StringMatch
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HG_Cross_Product_Terms,event
widget_control,event.top,get_uvalue = pState
index=widget_info((*pstate).CrossProduct_Droplist,/droplist_select)
widget_control,(*pstate).CrossProduct_Droplist,get_value=str
entry=str[index]

AddtoExpression,entry,event

end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HG_Scalar_Product_Terms,event
widget_control,event.top,get_uvalue = pState
index=widget_info((*pstate).ScalarProduct_Droplist,/droplist_select)
widget_control,(*pstate).ScalarProduct_Droplist,get_value=str
entry=str[index]

AddtoExpression,entry,event

end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HG_Single_Operator_Terms,event
widget_control,event.top,get_uvalue = pState
index=widget_info((*pstate).SingleTerm_Droplist,/droplist_select)
widget_control,(*pstate).SingleTerm_Droplist,get_value=str
entry=str[index]

AddtoExpression,entry,event

end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HG_Zeeman_Terms_Parameters,event
widget_control,event.top,get_uvalue = pState
index=widget_info((*pstate).Zeeman_Droplist,/droplist_select)
widget_control,(*pstate).Zeeman_Droplist,get_value=str
entry=str[index]

AddtoExpression,entry,event

end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HG_Delete_Entries,event
widget_control,event.top,get_uvalue = pState
selected_cells = WIDGET_INFO((*pstate).Parameter_Table, /TABLE_SELECT)
;print,'selected_cells = ',selected_cells
StartRow=selected_cells[1]
EndRow=selected_cells[3]
widget_control,(*pstate).Parameter_Table,get_value=Parameter_Table
Parameter_Table[*,StartRow:EndRow]=''
LinePositions=where(reform(Parameter_Table[1,*]) ne '',count)
if count eq 0 then begin
widget_control,(*pstate).Parameter_Table,set_value=Parameter_Table
return
endif else begin
if count ne (LinePositions[count-1]+1) then begin ;reorder
Parameter_Table[*,0:count-1]=temporary(Parameter_Table[*,LinePositions])
if LinePositions[count-1] le 98 then Parameter_Table[*,count:*]=''
endif
widget_control,(*pstate).Parameter_Table,set_value=Parameter_Table
endelse
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HG_Clear_Table,event
widget_control,event.top,get_uvalue = pState
widget_control,(*pstate).Parameter_Table,set_value=strarr(3,100)
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HG_AddToTable,expression,type,event
widget_control,event.top,get_uvalue = pState
;Parameter_Table_Input=strarr(3,100)
widget_control,(*pstate).Parameter_Table,get_value=Parameter_Table
LinePositions=where(reform(Parameter_Table[1,*]) ne '',count)

if count eq 0 then begin
Parameter_Table[1,0]=expression
if type eq 0 then Parameter_Table[2,0]='Parameter'
if type eq 1 then Parameter_Table[2,0]='Bx'
if type eq 2 then Parameter_Table[2,0]='By'
if type eq 3 then Parameter_Table[2,0]='Bz'
Parameter_Table[0,0]='P1'
widget_control,(*pstate).Parameter_Table,set_value=Parameter_Table
return
endif
if count ne (LinePositions[count-1]+1) then begin ;reorder
Parameter_Table[*,0:count-1]=temporary(Parameter_Table[*,LinePositions])
if LinePositions[count-1] le 98 then Parameter_Table[*,count:*]=''
endif
Parameter_Table[1,count]=expression
if type eq 0 then Parameter_Table[2,count]='Parameter'
if type eq 1 then Parameter_Table[2,count]='Bx'
if type eq 2 then Parameter_Table[2,count]='By'
if type eq 3 then Parameter_Table[2,count]='Bz'
Parameter_Table[0,count]='P'+strtrim(string(count+1),2)


widget_control,(*pstate).Parameter_Table,set_value=Parameter_Table

end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HG_Add_Expression,event
widget_control,event.top,get_uvalue = pState
;AM={Designations:Designations, $
;    AMQNS:AMQNS, $
;    n_AM:n_AM, $
;    VS:VS}
   CATCH, Error_status
if Error_status ne 0 then begin
catch, /cancel
msg=strarr(1)
msg[0]='Error Message from IDL: '+!ERROR_STATE.MSG
    void=dialog_message(dialog_parent=event.top,/error,msg)
return
endif

widget_control,(*pstate).code_text,get_value=expression
expression=expression[0]
if expression eq '' then return
char=strmid(expression,0,1)
operators=['/','*']
numbers=['1','2','3','4','5','6','7','8','9']
void=where(char eq operators,count)
if count ne 0 then begin
    void=dialog_message(dialog_parent=event.top,/error, $
    'The expression cannot begin with operators ''*'' or ''/''')
return
endif
finished=0
k=0
ex=expression
    while finished eq 0 do begin
    result=strpos(ex,'/',k)
       if result ne -1 then begin
       char=strmid(expression,result+1,1)
       void=where(char eq numbers,count)
         if count eq 0 then begin
           void=dialog_message(dialog_parent=event.top,/error, $
           'The ''/'' operator must be followed immediately by a number')
         return
         endif
       k=result+1
       endif else begin
       finished=1
       endelse
    endwhile

expression=strtrim(expression,2)
if n_elements(*(*pstate).StringMatch) gt 1 then begin
StringMatch=(*(*pstate).StringMatch)[1:*]
mm=n_elements(StringMatch)
    for ii=0,mm-1 do begin
    StringMatchArr=strsplit(StringMatch[ii],'=',/extract)
    result=strpos(expression,StringMatchArr[0])
       if result ne -1 then begin
       components=strsplit(expression,StringMatchArr[0],/extract,/regex,/preserve_null)
       expression=strjoin(components,StringMatchArr[1])
       endif
    endfor
endif


nn=n_elements((*(*pstate).AM).VS)
for jj=0,nn-1 do begin
a=(*(*pstate).AM).VS[jj]+'=1.0'
void=execute((*(*pstate).AM).VS[jj]+'=1.0')
endfor
im=complex(0,1.0,/double)
;print,'expression = ',expression
result=execute('void='+expression)
;print,'result = ',result
if result eq 1 then begin
ZeemanIdentifiers=['Bx','Hx','By','Hy','Bz','Hz']
type=0
match=intarr(6)
    for ii = 0, 5 do begin
    match[ii]=strpos(expression,ZeemanIdentifiers[ii])
    endfor
wherematch=where(match ne -1,count)
    if count ne 0 then begin
    wm=wherematch[0]
       if (wm eq 0) or (wm eq 1) then type = 1
       if (wm eq 2) or (wm eq 3) then type = 2
       if (wm eq 4) or (wm eq 5) then type = 3
    endif
endif else begin
msg=strarr(1)
msg[0]='Unable to decipher the expression. '+!ERROR_STATE.MSG
    void=dialog_message(dialog_parent=event.top,/error,msg)
return
endelse

HG_AddToTable,expression,type,event
HG_Clear_Palette,event
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HG_Clear_Palette,event
widget_control,event.top,get_uvalue = pState
widget_control,(*pstate).code_text,set_value=''
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HG_Launch_Help,event
pdf_file = !DAVE_AUXILIARY_DIR+'\PSI\MagProp\HamiltonianMatrixGeneratorHelp.pdf'
void = launch_help(pdf_file,tlb = event.top)
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HG_Events,event

   CATCH, Error_status
if Error_status ne 0 then begin
catch, /cancel
msg=strarr(1)
msg[0]='Error Message from IDL: '+!ERROR_STATE.MSG
    void=dialog_message(dialog_parent=event.top,/error,msg)
return
endif
;

widget_control,event.top,get_uvalue = pState
uname=widget_info(event.id,/uname)
case uname of
'HG_exit':   $
begin
HG_exit,event
end
'HG_NewHam':   $
begin
HG_NewHam,event
end
'HG_save':   $
begin
HG_save,event
end
'HG_restore':   $
begin
HG_restore,event
end
'HG_Delete_Entries':   $
begin
HG_Delete_Entries,event
end
'HG_Clear_Table':   $
begin
HG_Clear_Table,event
end
'HG_Create_Matrices':   $
begin
HG_Create_Matrices,event
end
'HG_Zeeman_Terms_Parameters':   $
begin
HG_Zeeman_Terms_Parameters,event
end
'HG_SingleTermSelect_Droplist':   $
begin
DisplaySingleOperatorTerms,event
end
'HG_Single_Operator_Terms':   $
begin
HG_Single_Operator_Terms,event
end
'HG_CO_Droplist_1':   $
begin
DisplayCompoundOperatorTerms,event
end
'HG_CO_Droplist_2':   $
begin
DisplayCompoundOperatorTerms,event
end
'HG_Scalar_Product_Terms':   $
begin
HG_Scalar_Product_Terms,event
end
'HG_Cross_Product_Terms':   $
begin
HG_Cross_Product_Terms,event
end
'HG_Add_Expression':   $
begin
HG_Add_Expression,event
end
'HG_Clear_Palette':   $
begin
HG_Clear_Palette,event
end
'HG_Launch_Help':   $
begin
HG_Launch_Help,event
end
else:
endcase
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro HamiltonianGenerator,tlb,group_leader = group_leader,notify_ids = notify_ids,  $
        register_name = register_name,workDir = workDir,ExternalEvent = ExternalEvent, $
        ExternalProgramName=ExternalProgramName
if n_elements(group_leader) eq 0 then group_leader = 0L
if n_elements(ExternalProgramName) eq 0 then ExternalProgramName=''
if n_elements(register_name) eq 0 then register_name='HamiltonianGenerator'


if xregistered(register_name) then return

if n_elements(ExternalEvent) eq 0 then begin
ExternalEvent={ID:-1}
tlb = widget_base(/row,title = 'Hamiltonian Matrix Generator',mbar=bar,group_leader = group_leader)
endif else begin
;widget_control,ExternalEvent.top,get_uvalue = pStateExternal
;workdir=(*pStateExternal).workdir
tlb = widget_base(group_leader = group_leader,/row,$
          title = 'Hamiltonian Matrix Generator Started from '+ExternalProgramName,mbar=bar)
endelse

delim=path_sep()

if n_elements(workdir) eq 0 then workdir='c:'+delim
courier_font = get_font_name(/large, /courier)


       filebuttons=widget_button(bar,value='File',/menu)
          void=widget_button(filebuttons,$
              value='New Hamiltonian',uname='HG_NewHam')
          void=widget_button(filebuttons,$
              value='Save Session',uname='HG_save')
          void=widget_button(filebuttons,$
              value='Restore Session',uname='HG_restore')
          void=widget_button(filebuttons,$
              value='EXIT',uname='HG_exit')
       tablebuttons=widget_button(bar,value='Table',/menu)
          void=widget_button(tablebuttons,$
              value='Delete Selected Entries',uname='HG_Delete_Entries')
          void=widget_button(tablebuttons,$
              value='Clear Table',uname='HG_Clear_Table')
       helpbuttons=widget_button(bar,value='Help',/menu)
          void=widget_button(helpbuttons,$
              value='Display Help File',uname='HG_Launch_Help')


Base_table=widget_base(tlb,/col,/align_center)
Base_table_upper=widget_base(Base_table,/row,/align_left)


column_labels=['Designation','Operator','Type']
row_labels='Term '+strtrim(string(indgen(100)+1),2)

Parameter_Table_Input=strarr(3,100)

Parameter_Table=widget_table(Base_table_upper,column_widths=[100,500,100],$
       column_labels=column_labels,row_labels=row_labels,xsize=3,ysize=100,$
       alignment=0,scr_ysize=290,value=Parameter_Table_Input,/editable)

Base_table_upper_widgetcol=widget_base(Base_table_upper,/col,/align_left)

Base_table_upper_widgetrow=widget_base(Base_table_upper_widgetcol,/row)

HamitonianName=cw_field(Base_table_upper_widgetrow,/col,title='Hamiltonian',value='',/noedit)
MatrixDimension=cw_field(Base_table_upper_widgetrow,/col,title='Dimension',value='',xsize=10,/noedit)

;void = widget_label(Base_table_upper_widgetcol,value = '')
;void = widget_label(Base_table_upper_widgetcol,value = '')

Base_table_upper_widgetcol1=widget_base(Base_table_upper_widgetcol,/col,/align_center)


;Base_table_lower_widgetcol=widget_base(Base_table_lower,/col,/align_left)
Base_table_lower_widgetcol=Base_table_upper_widgetcol1

Zeeman_Droplist=widget_Droplist(Base_table_lower_widgetcol,value='',/dynamic_resize, $
       title='Common Zeeman Terms',uname='HG_Zeeman_Terms_Parameters',/frame)

SingleTermBase=widget_base(Base_table_lower_widgetcol,/col,/base_align_left,/frame,sensitive=0)
void = widget_label(SingleTermBase,value = 'Single Operator Terms', font = courier_font)


SingleTermSelect_Droplist=widget_Droplist(SingleTermBase,value='',/dynamic_resize, $
       title='Select Operator',uname='HG_SingleTermSelect_Droplist')

SingleTerm_Droplist=widget_Droplist(SingleTermBase,value='',/dynamic_resize, $
       title='Common Terms',uname='HG_Single_Operator_Terms')

CompoundTermBase=widget_base(Base_table_lower_widgetcol,/col,/base_align_left,/frame,sensitive=0)
void = widget_label(CompoundTermBase,value = 'Compound Operator Terms', font = courier_font)

CompoundTermBase_row=widget_base(CompoundTermBase,/row,/align_left)


CT_Droplist_1=widget_Droplist(CompoundTermBase_row,value='',title='Select Operators',/dynamic_resize, $
       uname='HG_CO_Droplist_1')

CT_Droplist_2=widget_Droplist(CompoundTermBase_row,value='',/dynamic_resize, $
       uname='HG_CO_Droplist_2')

ScalarProduct_Droplist=widget_Droplist(CompoundTermBase,value='',/dynamic_resize, $
       title='Scalar Products',uname='HG_Scalar_Product_Terms')

CrossProduct_Droplist=widget_Droplist(CompoundTermBase,value='',/dynamic_resize, $
       title='Cross Products',uname='HG_Cross_Product_Terms')



Create_Matrix_Button = widget_button(Base_table_upper_widgetcol1,value = 'Create Matrices', $
       uname='HG_Create_Matrices', font = courier_font)

Base_table_lower=widget_base(Base_table,/col)
Base_table_lower_row1=widget_base(Base_table_lower,/row)
code_text = widget_text(Base_table_lower_row1,value = '',xsize = 85,ysize=1,/editable, font = courier_font,/scroll)
Base_table_lower_col1=widget_base(Base_table_lower_row1,/col)
void = widget_button(Base_table_lower_col1,value = 'Add Expression to Table', uname='HG_Add_Expression')
void = widget_button(Base_table_lower_col1,value = 'Clear Palette', uname='HG_Clear_Palette')






state = {Parameter_Table:Parameter_Table, $
         HamitonianName:HamitonianName, $
         MatrixDimension:MatrixDimension, $
         code_text:code_text, $
         Zeeman_Droplist:Zeeman_Droplist, $
         SingleTermBase:SingleTermBase, $
         SingleTermSelect_Droplist:SingleTermSelect_Droplist, $
         SingleTerm_Droplist:SingleTerm_Droplist, $
         CompoundTermBase:CompoundTermBase, $
         CT_Droplist_1:CT_Droplist_1, $
         CT_Droplist_2:CT_Droplist_2, $
         ScalarProduct_Droplist:ScalarProduct_Droplist, $
         CrossProduct_Droplist:CrossProduct_Droplist, $
         SingleTermSelect_vals:ptr_new(/allocate_heap), $
         SingleTerm_vals:ptr_new(/allocate_heap), $
         SecondOrderTerms:ptr_new(/allocate_heap), $
         FourthOrderTerms:ptr_new(/allocate_heap), $
         SixthOrderTerms:ptr_new(/allocate_heap), $
         AM:ptr_new(/allocate_heap), $
         delim:delim, $
         Create_Matrix_Button:Create_Matrix_Button, $
         TranslatedStrings:strarr(100), $
         StringMatch:ptr_new(/allocate_heap), $
         ExternalEvent:ExternalEvent, $
         ExternalProgramName:ExternalProgramName, $
         workdir:workdir $
         }


pState = ptr_new(state,/no_copy)


widget_control,tlb,set_uvalue = pState



centertlb,tlb
widget_control,tlb,/realize


xmanager,register_name,tlb,event_handler = 'HG_Events',cleanup= 'HG_cleanup'

end