tebdol

Simulation of ultracold atoms in optical lattices
git clone https://miroslavurbanek.com/git/tebdol.git
Log | Files | Refs | README

expans.lisp (2843B)

      1 ;; hard-core boson expansion in a two-dimensional optical lattice
      2 
      3 ;; parameters
      4 
      5 (defparameter *width* 6)
      6 (defparameter *height* 6)
      7 (defparameter *diameter* 2)
      8 
      9 (defparameter *jy* 5d-1) ;; *jx* = 1
     10 
     11 (defparameter *step* (/ 16d0))
     12 
     13 (defparameter *maxdim*
     14   (list (* (expt 2 32) double-float-epsilon) nil 128))
     15 
     16 ;; libraries
     17 
     18 (load "conf.lisp")
     19 (require :tebdol)
     20 
     21 (use-package '(:blas :ttns :tebd :bhm))
     22 (setf *print-level* 2)
     23 
     24 ;; functions
     25 
     26 (defun radius-x (pn n)
     27   (loop
     28      with w = (array-dimension pn 0)
     29      with h = (array-dimension pn 1)
     30      with c = (- (/ w 2) 5d-1)
     31      for i below w
     32      sum (* (expt (- i c) 2)
     33 	    (loop
     34 	       for j below h
     35 	       sum (aref pn i j)))
     36      into s
     37      finally (return (sqrt (/ s n)))))
     38 
     39 (defun radius-y (pn n)
     40   (loop
     41      with w = (array-dimension pn 0)
     42      with h = (array-dimension pn 1)
     43      with c = (- (/ h 2) 5d-1)
     44      for j below h
     45      sum (* (expt (- j c) 2)
     46             (loop
     47 	       for i below w
     48 	       sum (aref pn i j)))
     49      into s
     50      finally (return (sqrt (/ s n)))))
     51 
     52 (defun make-square-ttns (width height diameter dimension)
     53   (loop
     54      with p = (make-vacuum-ttns width height dimension)
     55      with xshift = (ceiling (- width diameter) 2)
     56      with yshift = (floor (- height diameter) 2)
     57      for i below diameter
     58      do
     59        (loop
     60 	  for j below diameter
     61 	  do (ttns-create-particle p (+ i xshift) (+ j yshift) dimension))
     62      finally
     63        (compress-ttns p nil)
     64        (return p)))
     65 
     66 ;; main
     67 
     68 ;; hard-core bosons
     69 (defparameter *dimension* 2)
     70 (defparameter *particles* (expt *diameter* 2))
     71 (defparameter *potential* (make-array (list *width* *height*) :initial-element 0d0))
     72 
     73 (defparameter *tbhsh* (bose-hubbard-site-hamiltonian *dimension* *jy* 0d0 0d0))
     74 (defparameter *ssps* (make-ssps *width* *height* *dimension* 0d0 *potential* (/ *step* 2)))
     75 (defparameter *dsps* (make-dsps *width* *height* *dimension* 0d0 *potential* (/ *step* 2)))
     76 (defparameter *dspy* (make-double-site-propagator *tbhsh* *tbhsh* (/ *step* 2)))
     77 
     78 (defparameter *ttns* (make-square-ttns *width* *height* *diameter* *dimension*))
     79 (defparameter *pn* (all-pn-operators *width* *height* *dimension*))
     80 
     81 (format t "# width = ~A~%" *width*)
     82 (format t "# height = ~A~%" *height*)
     83 (format t "# diameter = ~A~%" *diameter*)
     84 (format t "# jy = ~A~%" *jy*)
     85 (format t "# step = ~A~%" *step*)
     86 (format t "# maxdim = ~A~%" *maxdim*)
     87 (format t "~%# time radius-y radius-y imbalance norm~%# ----~%# density~%# ----~%~%")
     88 
     89 (loop
     90    for i to 32
     91    do
     92      (unless (zerop i)
     93        (ttns-tebd-evolve *ttns* *ssps* *dsps* *dspy* *maxdim*))
     94      (let* ((n (realpart (ttns-overlap *ttns* *ttns*)))
     95 	    (p (all-pn *ttns* n *pn*)))
     96        (format
     97 	t
     98 	"~,4F ~F ~F ~F~%"
     99 	(* i *step*)
    100 	(radius-x p *particles*)
    101 	(radius-y p *particles*)
    102 	n)
    103        (format t "----~%")
    104        (print-pn p)
    105        (format t "----~%")))