tebdol

commit e314eb37d13058deffafbe97dd725026146f00eb
parent 621b566fb4c305d4ab8dcc1f214ea5e16ace0502
Author: Miroslav Urbanek <mu@miroslavurbanek.com>
Date:   Wed,  2 Dec 2015 04:26:19 +0100

Add functions for saving distributed MPS

Diffstat:
tebdol/mps.lisp
 | 
44
++++++++++++++++++++++++++++++--------------

1 file changed, 30 insertions(+), 14 deletions(-)
diff --git a/tebdol/mps.lisp b/tebdol/mps.lisp
@@ -10,6 +10,8 @@
 	   :mps-prepare
 	   :mps-overlap
 	   :mps-expectation-value
+	   :save-metadata
+	   :save-submps
 	   :save-mps
 	   :state-parameter
 	   :state-tensor
@@ -146,26 +148,40 @@
 	(val l)
 	(mpi-send-object l (1+ rank)))))
 
+(defun save-metadata (dimension length particles pathname)
+  (with-open-file (s (ensure-directories-exist (merge-pathnames #p"metadata" pathname))
+		     :direction :output
+		     :if-exists :supersede)
+    (prin1 (list
+	    (cons :site-dimension dimension)
+	    (cons :model-length length)
+	    (cons :particle-number particles))
+	   s)
+    (terpri s)))
+
+(defun save-tensor (tensor pathname index)
+  (with-open-file (s (merge-pathnames (pathname (format nil "tensor.~A" index)) pathname)
+		     :direction :output
+		     :if-exists :supersede)
+    (prin1 tensor s)
+    (terpri s)))
+
+(defun save-submps (submps pathname)
+  (with-standard-io-syntax
+    (loop
+       repeat (submps-size submps)
+       for i from (submps-start submps)
+       for a across (submps-tensors submps)
+       do (save-tensor a pathname i))))
+
 (defun save-mps (mps dimension particles pathname)
   (with-standard-io-syntax
     (let ((*print-pretty* t))
       (when (or (not (probe-file pathname)) (y-or-n-p "Overwrite state ~S?" pathname))
-	(with-open-file (s (ensure-directories-exist (merge-pathnames #p"metadata" pathname))
-			   :direction :output
-			   :if-exists :supersede)
-	  (prin1 (list
-		  (cons :site-dimension dimension)
-		  (cons :model-length (length mps))
-		  (cons :particle-number particles))
-		 s)
-	  (terpri s))
+	(save-metadata dimension (length mps) particles pathname)
 	(loop
 	   for i below (length mps)
-	   do (with-open-file (s (merge-pathnames (pathname (format nil "tensor.~A" i)) pathname)
-				 :direction :output
-				 :if-exists :supersede)
-		(prin1 (svref mps i) s)
-		(terpri s)))))))
+	   do (save-tensor (svref mps i) pathname i))))))
 
 (defun state-parameter (pathname parameter)
   (cdr (assoc parameter