module TBit.Systems.HoneycombLattice (defaultParams, kaneMele, parameters) where

import TBit.Types
import TBit.Parameterization 
import Numeric.LinearAlgebra.HMatrix
import qualified Data.Map as M

-- |The default set of scalar parameters is:
-- 
--      * "t" = 1, the hopping parameter
--      * "soc" = 1, the intrinsic spin-orbit coupling
--      * "r" = 1, the Rashba spin-orbit coupling
--      * "v" = 1, the staggered on-site energy
--      * "hz" = 1, the out-of-plane AF parameter
--
--  These can be changed by using 'parameters' to set
--  all of them explicitly.
defaultParams :: Parameters
defaultParams = parameters [ ("t"  , 1.0 :+ 0.0)
                           , ("soc", 1.0 :+ 0.0)
                           , ("r"  , 1.0 :+ 0.0)
                           , ("v"  , 1.0 :+ 0.0)
                           , ("hz" , 1.0 :+ 0.0) ]

-- | Set the named parameters to their given complex values.
--   This function is used to implement 'defaultParams' as
-- 
--   > defaultParams = parameters [ ("t"  , 1.0 :+ 0.0)
--   >                            , ("soc", 1.0 :+ 0.0)
--   >                            , ("r"  , 1.0 :+ 0.0)
--   >                            , ("v"  , 1.0 :+ 0.0)
--   >                            , ("hz" , 1.0 :+ 0.0) ]
--
--   but you can use it to generate your own parameter list. For
--   more advanced manipulation, like setting the mesh size or the
--   primitive lattice vectors, you'll have to constuct a 'Types.Parameters'
--   type explicitly.
parameters :: [(String, Complex Double)] -> Parameters
parameters ps = Parameters { latticeData  = [ vector [ 0.5, 0.5 * sqrt 3] 
                                            , vector [-0.5, 0.5 * sqrt 3] ] 
                           , scalarParams = loadParams ps
                           , vectorParams = M.empty 
                           , meshingData  = Spacing 0.1 }

-- | Exported directly from a Mathematica and hard-coded into this module.
--   Uses the exact conventions of Kane Mele, excep that the Gamma_15 term
--   also includes a constant value for AF order. This AF order is taken
--   in the large Hubbard U limit by construction.
kaneMele :: Parameterized Hamiltonian
kaneMele = do
    t   <- getScalar "t"
    v   <- getScalar "v"
    hz  <- getScalar "hz"
    r   <- getScalar "r"
    soc <- getScalar "soc"
    return $ \k -> let kx = (k!0) :+ 0.0
                       ky = (k!1) :+ 0.0
                       y  = realPart ky
                    in (4 >< 4) 

            -- NBs: cis(t) === exp(i*t)
            --    : iC === i === sqrt(-1)
            -- Row 1:
            [ hz + v - 4*soc*cos((sqrt(3)*ky)/2)*sin(kx/2) + 2*soc*sin(kx) 
            , 0
            , t + (2*t*cos(kx/2))/cis(0.5*sqrt(3)*y)
            , r*(negate iC + (iC*(cos(kx/2) + sqrt(3)*sin(kx/2)))/cis(0.5*sqrt(3)*y))

            -- Row 2:
            , 0
            , -hz + v + 4*soc*cos((sqrt(3)*ky)/2)*sin(kx/2) - 2*soc*sin(kx)
            , r*(negate iC + (iC*(cos(kx/2) - sqrt(3)*sin(kx/2)))/cis(0.5*sqrt(3)*y))
            , t + (2*t*cos(kx/2))/cis(0.5*sqrt(3)*y) 

            -- Row 3:
            , t + 2*cis(0.5*sqrt(3)*y)*t*cos(kx/2)
            , r*(iC - iC*cis(0.5*sqrt(3)*y)*(cos(kx/2) - sqrt(3)*sin(kx/2)))
            , -hz - v + 4*soc*cos((sqrt(3)*ky)/2)*sin(kx/2) - 2*soc*sin(kx)
            , 0

            -- Row 4:
            , r*(iC - iC*cis(0.5*sqrt(3)*y)*(cos(kx/2) + sqrt(3)*sin(kx/2)))
            , t + 2*cis(0.5*sqrt(3)*y)*t*cos(kx/2)
            , 0
            , hz - v - 4*soc*cos((sqrt(3)*ky)/2)*sin(kx/2) + 2*soc*sin(kx) ]