From 7405b82c72a3eff40141d0be6063dbffdafede8c Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Wed, 14 Jan 2004 04:53:11 +0000
Subject: [PATCH] r8514: initial upload

---
 main.lisp | 131 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 131 insertions(+)
 create mode 100644 main.lisp

diff --git a/main.lisp b/main.lisp
new file mode 100644
index 0000000..171b518
--- /dev/null
+++ b/main.lisp
@@ -0,0 +1,131 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          rlc.lisp
+;;;; Purpose:       RLC Functions
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Jan 2003
+;;;;
+;;;; $Id: kboot.lisp 8414 2003-12-28 19:46:57Z kevin $
+;;;; *************************************************************************
+
+(in-package #:rlc)
+
+(defun plot-series-rlc-current (v r l c t-inc t-end &optional (t-start 0))
+  (let ((path (make-pathname
+	       :directory '(:absolute "tmp")
+	       :name
+	       (concatenate 'string "rlc-data-"
+			    (write-to-string (get-universal-time)))
+	       :type "dat")))
+    (write-series-rlc-graph path v r l c t-inc t-end t-start)
+    (run-xgraph path)
+    (sleep 2)
+    (delete-file path)))
+
+(defun run-xgraph (path)
+  (kl::run-shell-command "xgraph ~A" (namestring path)))
+    
+(defun write-series-rlc-current-graph (path v r l c t-inc t-end
+				       &optional (t-start 0))
+  (multiple-value-bind (x y)
+      (series-rlc-current-graph-data v r l c t-inc t-end t-start)
+    (with-open-file (out path :direction :output :if-exists :supersede
+			 :if-does-not-exist :create)
+      (dotimes (i (length x))
+	(format out "~D ~D~%" (aref x i) (aref y i))))))
+
+(defun series-rlc-current-graph-data (v r l c t-inc t-end &optional (t-start 0))
+  (let* ((formula-list (series-rlc-current-formula v r l c))
+	 (formula-eval (eval formula-list))
+	 (formula (compile nil formula-eval))
+	 (n (ceiling (- t-end t-start) t-inc)))
+    (do ((i 0 (1+ i))
+	 (tm t-start (+ tm t-inc))
+	 (x-pts (make-array n))
+	 (y-pts (make-array n)))
+	((= i n)
+	 (values x-pts y-pts))
+      (setf (aref x-pts i) tm)
+      (setf (aref y-pts i) (funcall formula tm)))))
+
+(defun series-rlc-current-time (v r l c tm)
+  (let* ((formula-list (series-rlc-current-formula v r l c))
+	 (formula (eval formula-list)))
+    (funcall formula tm)))
+
+(defun circuit-type (r l c)
+   (cond
+    ((and (zerop r) (zerop l) (zerop c))
+     :null)
+    ((and (/= 0 r) (zerop l) (zerop c))
+     :r)
+    ((and (zerop r) (/= 0 l) (zerop c))
+     :l)
+    ((and (zerop r) (zerop l) (/= 0 c))
+     :c)
+    ((and (/= 0 r) (/= 0 l) (zerop c))
+     :rl)
+    ((and (/= 0 r) (zerop l) (/= 0 c)) 
+     :rc)
+    ((and (zerop r) (/= 0 l) (/= 0 c))
+     :lc)
+    (t
+     :rlc)))
+  
+(defun series-rlc-current-formula (v r l c)
+  "Returns formula for currrent through a series RLC circuit with a step-voltage applied at time 0."
+  (ecase (circuit-type r l c)
+    (:null
+     `(lambda (tm) ,v))
+    (:r
+     `(lambda (tm) ,(/ v r)))
+    (:c
+     `(lambda (tm)
+	(if (zerop rm)
+	    ,(* v c)
+	  0)))
+    (:l
+     `(lambda (tm)
+	(* ,(/ v l) t)))
+    (:rl
+      `(lambda (tm)
+	 (* ,(/ v r) (- 1 (exp (- (* tm ,(/ r l))))))))
+    (:rc
+     `(lambda (tm) (* ,(/ v r) (exp (- (* tm ,(/ 1 r c)))))))
+     (:lc
+      (let ((lc-root (sqrt (* l c))))
+	`(lambda (tm)
+	   (* ,(/ (* v lc-root) l) (sin (* tm ,(/ 1 lc-root)))))))
+     (:rlc
+      (let* ((r/2l (when (/= 0 l) (/ r (+ l l))))
+	     (rr/4ll (when r/2l (* r/2l r/2l)))
+	     (v/l (when (/= 0 l) (/ v l)))
+	     (1/lc (when (and (/= 0 l) (/= 0 c)) (/ 1 (* l c)))))
+	
+	(cond
+	 ;; RLC over-damped
+	 ((> rr/4ll 1/lc)
+	  (let* ((root (sqrt (- rr/4ll 1/lc)))
+		 (p1 (+ (- r/2l) root))
+		 (p2 (- (- r/2l) root)))
+	    `(lambda (tm)
+	       (* ,(/ v/l (- p1 p2))
+		  (- (exp (* ,p1 tm)) (exp (* ,p2 tm)))))))
+	 ;; RLC critcally-damped
+	 ((= rr/4ll 1/lc)
+	  `(lambda (tm)
+	     (* tm
+		,v/l
+		(exp (- (* tm ,r/2l))))))
+	 ;; RLC under-damped
+	 (t
+	  (let ((diff (- 1/lc rr/4ll)))
+	    `(lambda (tm)
+	       (* ,(/ v/l (sqrt diff))
+		  (exp (- (* tm ,r/2l)))
+		  (sin (* tm ,(sqrt diff))))))))))))
+  
+
+	
-- 
2.34.1