Browse code

Функционал для задания полей и первые тесты

Dmitrii Kashin authored on 04/05/2015 06:08:12
Showing 7 changed files
... ...
@@ -1,5 +1,10 @@
1 1
 (in-package :clf)
2 2
 
3
+;; граничные условия, что для примитивных, что для консервативных переменных - почти одинаковые.
4
+;; я решил не выделять отдельный файл
5
+
6
+;; -------------------- ДЛЯ ПРИМИТИВНЫХ ПЕРЕМЕННЫХ
7
+
3 8
 (defmethod update-boundary-cells ((grid grid2d-pv))
4 9
   (loop for i from 0 to (cells-max-x grid) do
5 10
        (funcall (symbol-function (bottom-boundary-condition grid))
... ...
@@ -24,11 +29,14 @@
24 24
   (let ((i (x-index index))
25 25
 	(j (y-index index)))
26 26
     (setf (cell grid index)
27
-	  (var-vector (cell grid (case border
28
-				   ((left) (index (1+ i) j))
29
-				   ((right) (index (1- i) j))
30
-				   ((bottom) (index i (1+ j)))
31
-				   ((top) (index i (1- j)))))))))
27
+	  (cell grid (case border
28
+		       ((left) (index (1+ i) j))
29
+		       ((right) (index (1- i) j))
30
+		       ((bottom) (index i (1+ j)))
31
+		       ((top) (index i (1- j))))))))
32
+
33
+;; todo: эта функция должна проверять, не начальное ли это значение
34
+;; возможно, фиксированное поле надо откуда-то задавать
32 35
 
33 36
 (defmethod fixed ((grid grid2d-pv) (index cell-index) border)
34 37
   (noop))
... ...
@@ -50,3 +58,38 @@
50 50
 
51 51
 
52 52
 
53
+
54
+;; -------------------- ДЛЯ КОНСЕРВАТИВНЫХ ПЕРЕМЕННЫХ
55
+
56
+(defmethod update-boundary-cells ((grid grid2d-cv))
57
+  (loop for i from 0 to (cells-max-x grid) do
58
+       (funcall (symbol-function (bottom-boundary-condition grid))
59
+		grid
60
+		(index i -1)
61
+		'bottom)
62
+       (funcall (symbol-function (top-boundary-condition grid))
63
+		grid
64
+		(index i (1+ (cells-max-y grid)))
65
+		'top))
66
+  (loop for j from 0 to (cells-max-y grid) do
67
+       (funcall (symbol-function (left-boundary-condition grid))
68
+		grid
69
+		(index -1 j)
70
+		'left)
71
+       (funcall (symbol-function (right-boundary-condition grid))
72
+		grid
73
+		(index (1+ (cells-max-x grid)) j)
74
+		'right)))
75
+
76
+(defmethod zeroe ((grid grid2d-cv) (index cell-index) border)
77
+  (let ((i (x-index index))
78
+	(j (y-index index)))
79
+    (setf (cell grid index)
80
+	  (cell grid (case border
81
+		       ((left) (index (1+ i) j))
82
+		       ((right) (index (1- i) j))
83
+		       ((bottom) (index i (1+ j)))
84
+		       ((top) (index i (1- j))))))))
85
+
86
+(defmethod fixed ((grid grid2d-cv) (index cell-index) border)
87
+  (noop))
... ...
@@ -18,22 +18,18 @@
18 18
 	       (:file "cells-primitive" :depends-on ("variables-primitive" "cell-coordinates" "cell-size"))
19 19
 	       (:file "cell-index")
20 20
 	       (:file "grid2d-primitive" :depends-on ("cells-primitive" "cell-index"))
21
-	       (:file "boundary-conditions" :depends-on ("grid2d-primitive"))
22
-
23 21
 	       (:file "variables-conservative" :depends-on ("variables-primitive"))
24 22
 	       (:file "cells-conservative" :depends-on ("cells-primitive" "variables-conservative"))
25 23
 	       (:file "grid2d-conservative" :depends-on ("cells-primitive" "cell-index"))
24
+	       (:file "field2d-conservative" :depends-on ("grid2d-conservative"))
25
+	       (:file "boundary-conditions" :depends-on ("grid2d-primitive"))
26 26
 	       
27
-;;	       (:file "grid" :depends-on ("package" "cells"))
28
-;;	       (:file "grid2d" :depends-on ("package" "cells"))
29
-;;	       (:file "field" :depends-on ("package" "grid"))
30
-;;	       (:file "field2d" :depends-on ("package" "grid2d"))
31 27
 ;;	       (:file "solver" :depends-on ("package" "field"))
32 28
 ;;	       (:file "solver2d" :depends-on ("package" "field2d"))
33 29
 ;;	       (:file "march" :depends-on ("package"))
34 30
 ;;	       (:file "march2d" :depends-on ("package" "solver" "grid" "field"))
35
-;;	       (:file "tests" :depends-on ("package" "march" "solver" "grid" "field"))
36
-;;	       (:file "tests2d" :depends-on ("package" "framework" "field2d"))
31
+
32
+	       (:file "test2d-conservative" :depends-on ("field2d-conservative" "boundary-conditions"))
37 33
 	       (:file "output-functions")
38 34
 	       ))
39 35
   
... ...
@@ -4,6 +4,7 @@
4 4
 
5 5
 ;;(defparameter *Cg* (sqrt (* *kappa* *Ro* *T*))) ;; sos = 340.0
6 6
 (defparameter *Cg* 340.0)
7
+(defparameter *sos* *Cg*) ; для совместимости со старым кодом
7 8
 (defparameter *rl* 800.0) ; kg/m^3
8 9
 (defparameter *kappa* 1.4)
9 10
 (defparameter *Ro* 287.065476372)
10 11
new file mode 100644
... ...
@@ -0,0 +1,50 @@
0
+(in-package :clf)
1
+
2
+;; монотонное поле
3
+
4
+(defmacro set-whole-field-2d (grid pv)
5
+  `(loop for i from 0 to (cells-max-x grid) do
6
+	(loop for j from 0 to (cells-max-y grid) do
7
+	     (setf (var-vector (cell grid (index i j)))
8
+		   (var-vector (primitive->conservative ,pv))))))
9
+
10
+(defun set-constant-field-2d (grid)
11
+  "Задаёт в сетке `grid' постоянное поле"
12
+  )
13
+
14
+
15
+;; этот макрос принимает левые и правые консервативные переменные, а
16
+;; потому задаёт поле, линейно изменяющееся от левых параметров к
17
+;; правым.
18
+
19
+;; todo: надо бы сделать проверки на случай не задания left-vars и right-vars
20
+
21
+(defmacro set-monotonous-field-2d-x (grid &key left-vars right-vars)
22
+  "Задаёт в сетке `grid' линейно изменяющееся поле"
23
+  `(let ((pv-grad (pvar/ (pvar- ,right-vars ,left-vars)
24
+			 (cells-amount-x grid))))
25
+     (loop for i from 0 to (cells-max-x grid) do
26
+	  (let ((pv (pvar+ ,left-vars
27
+			   (pvar* (+ i 0.5) pv-grad))))
28
+	    (loop for j from 0 to (cells-max-y grid) do
29
+	       (setf (cell grid (index i j))
30
+		     (primitive->conservative pv)))))))
31
+
32
+
33
+;; этот макрос нужен для тестов на скачах
34
+
35
+(defmacro set-splitted-field-2d-x (grid &key left-vars right-vars)
36
+  `(progn
37
+     (format t "Задаём поле, разделённое по оси x~%")
38
+     (format t "Колонки: ~T") (print-headers t ,left-vars) (newline)
39
+     (format t "left:~T") (print-content t ,left-vars :with-headers nil) (newline)
40
+     (format t "right:~T") (print-content t ,right-vars :with-headers nil) (newline)
41
+     (let* ((mid-x-index (round (/ (cells-amount-x ,grid) 2)))
42
+	    (left-vars (primitive->conservative ,left-vars))
43
+	    (right-vars (primitive->conservative ,right-vars)))
44
+       (loop for i from 0 to (cells-max-x grid) do
45
+	    (loop for j from 0 to (cells-max-y grid) do
46
+		 (setf (cell grid (index i j))
47
+		       (if (< i mid-x-index)
48
+			   left-vars
49
+			   right-vars)))))))
... ...
@@ -7,6 +7,20 @@
7 7
 
8 8
 ;; макросы
9 9
 
10
+(defun complain-key (function key)
11
+  (error "Функция ~a требует задания ключа ~a" function key))
12
+
13
+(defmacro check-mandatory-keys (function &rest keys)
14
+  `(progn ,@(loop for key in keys
15
+	       collect (let ((key-name (or (and (consp key)
16
+						(car key))
17
+					   key))
18
+			     (key-sym (or (and (consp key)
19
+					       (cadr key))
20
+					  key)))
21
+			 `(unless ,key-sym
22
+			    (complain-key ',function ',key-name))))))
23
+
10 24
 (defmacro send-output-to-file (filename &body body)
11 25
   (let ((file (gensym)))
12 26
     `(with-open-file (,file ,filename
... ...
@@ -61,7 +61,7 @@
61 61
   (setf (aref (cells grid) (1+ (x-index index)) (1+ (y-index index)))
62 62
 	(clone new)))
63 63
 
64
-(defmethod (setf cell) ((new primitive-variables) (grid grid2d-cv) (index cell-index))
64
+(defmethod (setf cell) ((new conservative-variables) (grid grid2d-cv) (index cell-index))
65 65
   (setf (var-vector (cell grid index))
66 66
 	(var-vector new)))
67 67
 
68 68
new file mode 100644
... ...
@@ -0,0 +1,117 @@
0
+(in-package :clf)
1
+
2
+(defun test-cv-constant (&key (cells-nx 20) (cells-ny 1) (output-dir #P"~/prog/clfpv/test-cv-constant/"))
3
+  "Тест на постоянном поле"
4
+  (ensure-directories-exist output-dir)
5
+  (let ((*DEFAULT-PATHNAME-DEFAULTS* output-dir))
6
+    (let ((grid (make-instance 'grid2d-cv
7
+			       :cells-amount-x cells-nx
8
+			       :cells-amount-y cells-ny
9
+			       :left-boundary-condition 'zeroe
10
+			       :right-boundary-condition 'zeroe
11
+			       :bottom-boundary-condition 'zeroe
12
+			       :top-boundary-condition 'zeroe)))
13
+      (init-grid grid
14
+		 :left-border-coord 0
15
+		 :right-border-coord 1
16
+		 :top-border-line (constant-function 1)
17
+		 :bottom-border-line (constant-function 0)
18
+		 :thickening-coef-x 1
19
+		 :thickening-coef-y 1)
20
+      (set-whole-field-2d grid
21
+			  (make-instance 'conservative-variables
22
+					 :phi 0.999999
23
+					 :P 100000.0
24
+					 :ug 25.0
25
+					 :ul 25.0))
26
+      (set-constant-field-2d grid)
27
+      (update-boundary-cells grid)
28
+
29
+;      (march grid
30
+;	     :output-every-step 10
31
+;	     :finish-step 100)
32
+      grid
33
+      )))
34
+
35
+(defun test-cv-mono (&key (cells-nx 20) (cells-ny 1) (output-dir #P"~/prog/clfpv/test-cv-mono/"))
36
+  "Тест на монотонном поле, для отладки задания сетки"
37
+  (let ((*DEFAULT-PATHNAME-DEFAULTS* output-dir))
38
+    (let ((grid (make-instance 'grid2d-cv
39
+			       :cells-amount-x cells-nx
40
+			       :cells-amount-y cells-ny
41
+			       :left-boundary-condition 'zeroe
42
+			       :right-boundary-condition 'zeroe
43
+			       :bottom-boundary-condition 'zeroe
44
+			       :top-boundary-condition 'zeroe)))
45
+      (init-grid grid
46
+		 :left-border-coord 0
47
+		 :right-border-coord 1
48
+		 :top-border-line (constant-function 1)
49
+		 :bottom-border-line (constant-function 0)
50
+		 :thickening-coef-x 1
51
+		 :thickening-coef-y 1)
52
+      (let* ((left-vars (make-instance 'primitive-variables
53
+				       :phi 0.999999
54
+				       :rg 1.0
55
+				       :ug 400.0
56
+				       :ul 400.0))
57
+	     (right-vars (make-instance 'primitive-variables
58
+					:phi (phi left-vars)
59
+					:ug (/ (* *sos* *sos*)
60
+					       (* *kappa* (ug left-vars)))
61
+					:ul (/ (* *sos* *sos*)
62
+					       (* *kappa* (ul left-vars)))
63
+					:rg (/ (* (rg left-vars) (ug left-vars))
64
+					       ;; на ug справа
65
+					       (/ (* *sos* *sos*)
66
+						  (* *kappa* (ug left-vars)))))))
67
+	(set-monotonous-field-2d-x grid
68
+				   :left-vars left-vars
69
+				   :right-vars right-vars))
70
+      (update-boundary-cells grid)
71
+      grid
72
+      )))
73
+
74
+(defun test-cv-split-1 (&key (cells-nx 20) (cells-ny 1) (output-dir #P"~/prog/clfpv/test-cv-split-1/"))
75
+  "Тест на скачке"
76
+  (ensure-directories-exist output-dir)
77
+  (let ((*DEFAULT-PATHNAME-DEFAULTS* output-dir))
78
+    (let ((grid (make-instance 'grid2d-cv
79
+			       :cells-amount-x cells-nx
80
+			       :cells-amount-y cells-ny
81
+			       :left-boundary-condition 'zeroe
82
+			       :right-boundary-condition 'zeroe
83
+			       :bottom-boundary-condition 'zeroe
84
+			       :top-boundary-condition 'zeroe)))
85
+      (init-grid grid
86
+		 :left-border-coord 0
87
+		 :right-border-coord 1
88
+		 :top-border-line (constant-function 1)
89
+		 :bottom-border-line (constant-function 0)
90
+		 :thickening-coef-x 1
91
+		 :thickening-coef-y 1)
92
+      (let* ((left-vars (make-instance 'primitive-variables
93
+				       :phi 0.999999
94
+				       :rg 1.0
95
+				       :ug 400.0
96
+				       :ul 400.0))
97
+	     (right-vars (make-instance 'primitive-variables
98
+					:phi (phi left-vars)
99
+					:ug (/ (* *sos* *sos*)
100
+					       (* *kappa* (ug left-vars)))
101
+					:ul (/ (* *sos* *sos*)
102
+					       (* *kappa* (ul left-vars)))
103
+					:rg (/ (* (rg left-vars) (ug left-vars))
104
+					       ;; на ug справа
105
+					       (/ (* *sos* *sos*)
106
+						  (* *kappa* (ug left-vars)))))))
107
+	(set-splitted-field-2d-x grid
108
+				 :left-vars left-vars
109
+				 :right-vars right-vars))
110
+      (update-boundary-cells grid)
111
+;      (march grid
112
+;	     :output-every-step 10
113
+;	     :finish-step 100)
114
+
115
+      grid
116
+      )))