[Matlisp-commit] [matlisp-git]matlisp branch matlisp-cffi updated. 2012-02-23-81-gb69c4cb

[Raymond T. <rt...@us...>]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "matlisp".

The branch, matlisp-cffi has been updated
       via  b69c4cba35a5d7644c60cdc8b830f60bea9f4b1e (commit)
      from  21d8ce7bad4335a01727786b8114af348c31d3c9 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit b69c4cba35a5d7644c60cdc8b830f60bea9f4b1e
Author: Raymond Toy <toy...@gm...>
Date:   Fri Mar 30 20:16:18 2012 -0700

    Use with-fortran-matrices.

diff --git a/src/colnew-demo2.lisp b/src/colnew-demo2.lisp
index f358b9c..f5ad007 100644
--- a/src/colnew-demo2.lisp
+++ b/src/colnew-demo2.lisp
@@ -9,95 +9,100 @@
 (defvar *xt* (sqrt (/ (* 2 (- *gamma* 1)) *gamma*)))
 
 
-(defun fsub (x z f)
-  (setf (fv-ref f 0)
-	(+ (/ (fv-ref z 0) x x)
-	   (- (/ (fv-ref z 1) x))
-	   (/ (- (fv-ref z 0)
-		 (* (fv-ref z 2)
-		    (- 1 (/ (fv-ref z 0)
-			    x)))
-		 (* *gamma* x (- 1
-				 (* x x 0.5d0))))
-	      *eps4mu*)))
-  (setf (fv-ref f 1)
-	(+ (/ (fv-ref z 2) x x)
-	   (/ (- (fv-ref z 3)) x)
-	   (* (fv-ref z 0)
-	      (/ (- 1 (/ (fv-ref z 0) 2 x))
-		 *dmu*)))))
+(defun fsub (x a-z a-f)
+  (utilities::with-fortran-matrices ((z a-z (1 2))
+				     (f a-f (1 4)))
+    (setf (f 1)
+	  (+ (/ (z 1) x x)
+	     (- (/ (z 2) x))
+	     (/ (- (z 1)
+		   (* (z 3)
+		      (- 1 (/ (z 1)
+			      x)))
+		   (* *gamma* x (- 1
+				   (* x x 0.5d0))))
+		*eps4mu*)))
+    (setf (f 2)
+	  (+ (/ (z 3) x x)
+	     (/ (- (z 4)) x)
+	     (* (z 1)
+		(/ (- 1 (/ (z 1) 2 x))
+		   *dmu*))))))
 
-(defun dfsub (x z df)
-  (let ((nrows 2))
-    (flet ((column-major-index (r c)
-	     (+ (- r 1)
-		(* (- c 1) nrows))))
-      (setf (fv-ref df (column-major-index 1 1))
-	    (+ (/ 1 x x)
-	       (/ (+ 1
-		     (/ (fv-ref z 2)
+(defun dfsub (x a-z a-df)
+  (utilities::with-fortran-matrices ((d a-df (1 2) (1 4))
+				     (z a-z (1 4)))
+    (setf (d 1 1)
+	  (+ (/ 1 x x)
+	     (/ (+ 1
+		   (/ (z 3)
+		      x))
+		*eps4mu*)))
+    (setf (d 1 2)
+	  (/ -1 x))
+    (setf (d 1 3)
+	  (- (/ (- 1 (/ (z 1)
 			x))
-		  *eps4mu*)))
-      (setf (fv-ref df (column-major-index 1 2))
-	    (/ -1 x))
-      (setf (fv-ref df (column-major-index 1 3))
-	    (- (/ (- 1 (/ (fv-ref z 0)
-			  x))
-		  *eps4mu*)))
-      (setf (fv-ref df (column-major-index 1 4))
-	    0d0)
-      (setf (fv-ref df (column-major-index 2 1))
-	    (/ (- 1
-		  (/ (fv-ref z 0)
-		     x))
-	       *dmu*))
-      (setf (fv-ref df (column-major-index 2 2))
-	    0d0)
-      (setf (fv-ref df (column-major-index 2 3))
-	    (/ 1 x x))
-      (setf (fv-ref df (column-major-index 2 4))
-	    (/ -1 x)))))
+		*eps4mu*)))
+    (setf (d 1 4)
+	  0d0)
+    (setf (d 2 1)
+	  (/ (- 1
+		(/ (z 1)
+		   x))
+	     *dmu*))
+    (setf (d 2 2)
+	  0d0)
+    (setf (d 2 3)
+	  (/ 1 x x))
+    (setf (d 2 4)
+	  (/ -1 x))))
 
-(defun gsub (i z g)
-  (case i
-    ((or 1 3)
-     (setf (fv-ref g 0) (fv-ref z 0)))
-    (2
-     (setf (fv-ref g 0) (fv-ref z 2)))
-    (4
-     (setf (fv-ref g 0) (+ (fv-ref z 3)
-			   (* -0.3d0 (fv-ref z 2))
-			   0.7d0)))))
+(defun gsub (i a-z a-g)
+  (utilities::with-fortran-matrices ((z a-z (1 4))
+				     (g a-g (1 4)))
+    (case i
+      ((or 1 3)
+       (setf (g 1) (z 1)))
+      (2
+       (setf (g 1) (z 3)))
+      (4
+       (setf (g 1) (+ (z 4)
+		       (* -0.3d0 (z 3))
+		       0.7d0))))))
 
-(defun dgsub (i z dg)
-  (dotimes (k 4)
-    (setf (fv-ref dg k) 0d0))
-  (case i
-    ((or 1 3)
-     (setf (fv-ref dg 0) 1d0))
-    (2
-     (setf (fv-ref dg 2) 1d0))
-    (4
-     (setf (fv-ref dg 3) 1d0)
-     (setf (fv-ref dg 2) -0.3d0))))
+(defun dgsub (i a-z a-dg)
+  (utilities::with-fortran-matrices ((dg a-dg (1 4)))
+    (loop for k from 1 upto 4 do
+      (setf (dg k) 0d0))
+    (case i
+      ((or 1 3)
+       (setf (dg 1) 1d0))
+      (2
+       (setf (dg 3) 1d0))
+      (4
+       (setf (dg 4) 1d0)
+       (setf (dg 3) -0.3d0)))))
 
 (defun guess (x z dmval)
   (let ((con (* *gamma* x (- 1 (* 0.5d0 x x))))
 	(dcon (* *gamma* (- 1 (* 1.5d0 x x))))
 	(d2con (* -3 *gamma* x)))
-    (cond ((<= x *xt*)
-	   (setf (fv-ref z 0) (* 2 x))
-	   (setf (fv-ref z 1) 2d0)
-	   (setf (fv-ref z 2) (+ (* -2 x) con))
-	   (setf (fv-ref z 3) (+ dcon -2d0))
-	   (setf (fv-ref dmval 1) d2con))
-	  (t
-	   (setf (fv-ref z 0) 0d0)
-	   (setf (fv-ref z 1) 0d0)
-	   (setf (fv-ref z 2) (- con))
-	   (setf (fv-ref z 3) (- dcon))
-	   (setf (fv-ref dmval 1) (- d2con))))
-    (setf (fv-ref dmval 0) 0d0)))
+    (utilities::with-fortran-matrices ((z z (1 4))
+				       (dmval dmval (1 2)))
+      (cond ((<= x *xt*)
+	     (setf (z 1) (* 2 x))
+	     (setf (z 2) 2d0)
+	     (setf (z 3) (+ (* -2 x) con))
+	     (setf (z 4) (+ dcon -2d0))
+	     (setf (dmval 2) d2con))
+	    (t
+	     (setf (z 1) 0d0)
+	     (setf (z 2) 0d0)
+	     (setf (z 3) (- con))
+	     (setf (z 4) (- dcon))
+	     (setf (dmval 2) (- d2con))))
+      (setf (dmval 1) 0d0))))
 
 
 (defun colnew-prob2 ()

-----------------------------------------------------------------------

Summary of changes:
 src/colnew-demo2.lisp |  165 +++++++++++++++++++++++++------------------------
 1 files changed, 85 insertions(+), 80 deletions(-)


hooks/post-receive
-- 
matlisp