[Maxima-commits] CVS: maxima/share/contrib f90.lisp,1.4,1.5

[James A. <amu...@us...>]

Update of /cvsroot/maxima/maxima/share/contrib
In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv2523

Modified Files:
	f90.lisp 
Log Message:
fix for bug 2176843 -- wrong format was used when printing elements of a matrix.

Index: f90.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/share/contrib/f90.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- f90.lisp	28 Mar 2007 21:55:45 -0000	1.4
+++ f90.lisp	24 Nov 2008 17:03:13 -0000	1.5
@@ -75,13 +75,29 @@
   (terpri)
   '$done)
 
+;; Takes a name and a matrix and prints a sequence of F90 assignment
+;; statements of the form
+;;  NAME(I,J) = <corresponding matrix element>
+
+(defmfun $f90mx (name mat)
+  (cond ((not (symbolp name))
+	 (merror "~%First argument to `f90mx' must be a symbol."))
+	((not ($matrixp mat))
+	 (merror "Second argument to `f90mx' not a matrix: ~M" mat)))
+  (do ((mat (cdr mat) (cdr mat)) (i 1 (1+ i)))
+      ((null mat))
+    (do ((m (cdar mat) (cdr m)) (j 1 (1+ j)))
+	((null m))
+      (f90-print `((mequal) ((,name) ,i ,j) ,(car m)))))
+  '$done)
+
 (defmspec $f90 (l)
   (setq l (fexprcheck l))
   (let ((value (strmeval l)))
     (cond ((msetqp l) (setq value `((mequal) ,(cadr l) ,(meval l)))))
     (cond ((and (symbolp l) ($matrixp value))
-	   ($fortmx l value))
+	   ($f90mx l value))
 	  ((and (not (atom value)) (eq (caar value) 'mequal)
 		(symbolp (cadr value)) ($matrixp (caddr value)))
-	   ($fortmx (cadr value) (caddr value)))
+	   ($f90mx (cadr value) (caddr value)))
 	  (t (f90-print value)))))