tebdol

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

mbl.lisp (2945B)

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