root/packages/colnew.asd @ 1096:d520cc7f12d9

Revision 1096:d520cc7f12d9, 4.8 KB (checked in by rtoy, 3 years ago)

Can now run test 2 and 3 together because the blank common blocks in
the main programs were renamed so they don't conflict.

Line 
1;;; -*- Mode: lisp; Package: CL-USER -*-
2
3(defpackage colnew-system
4  (:use #:cl #:asdf))
5
6(in-package #:colnew-system)
7
8
9(defclass colnew-fortran-file (cl-source-file)
10  ()
11  (:default-initargs :type "f"))
12
13(defun fortran-compile (op c &key (array-slicing t) (array-type :array) (package "COLNEW")
14                        declare-common (common-as-array t))
15  (let ((file (component-pathname c)))
16    (f2cl:f2cl-compile file
17                       :output-file (first (output-files op c))
18                       :array-slicing array-slicing
19                       :array-type array-type
20                       :package package
21                       :declare-common declare-common
22                       :common-as-array common-as-array
23                       )))
24
25(defmethod perform ((op compile-op) (c colnew-fortran-file))
26  (fortran-compile op c :package "COLNEW"))
27
28(defmethod perform ((op load-op) (c colnew-fortran-file))
29  (load (first (input-files op c))))
30
31
32
33;; Defsystem for colnew.
34(defsystem colnew
35  :components
36  ((:module package
37            :pathname "colnew"
38            :components
39            ((:file "package")))
40   (:module "colnew"
41            :depends-on ("package")
42            :default-component-class colnew-fortran-file
43            :components
44            (
45             ;; Linpack routines needed by colnew
46             (:file "dgesl"
47                    :depends-on ("daxpy" "ddot"))
48             (:file "dgefa"
49                    :depends-on ("idamax" "dscal" "daxpy"))
50             ;; BLAS routines needed by above
51             (:file "daxpy")
52             (:file "ddot")
53             (:file "dscal")
54             (:file "idamax")
55             ;; Simple compatibility to define all of the needed
56             ;; common blocks in one place.
57             (:file "compat"
58                    :perform (compile-op :around (op c)
59                                         (fortran-compile op c
60                                                          :declare-common t :common-as-array t)))
61             ;; COLNEW itself, broken down into one subroutine per
62             ;; file.
63             (:file "colnew"
64                    :depends-on ("compat" "consts" "newmsh" "contrl"))
65             (:file "contrl"
66                    :depends-on ("compat" "lsyslv" "skale" "errchk" "newmsh"))
67             (:file "skale"
68                    :depends-on ("compat"))
69             (:file "newmsh"
70                    :depends-on ("compat" "approx" "horder"))
71             (:file "consts"
72                    :depends-on ("compat" "vmonde" "rkbas"))
73             (:file "errchk")
74             (:file "lsyslv"
75                    :depends-on ("compat" "vwblok" "gblock" "gderiv" "fcblok"
76                                          "sbblok" "dmzsol"))
77             (:file "gderiv")
78             (:file "vwblok"
79                    :depends-on ("compat" "dgesl" "dgefa"))
80             (:file "gblock"
81                    :depends-on ("compat" "dgesl"))
82             (:file "appsln")
83             (:file "approx"
84                    :depends-on ("compat"))
85             (:file "rkbas"
86                    :depends-on ("compat"))
87             (:file "vmonde"
88                    :depends-on ("compat"))
89             (:file "horder")
90             (:file "dmzsol"
91                    :depends-on ("factrb" "shiftb"))
92             (:file "fcblok"
93                    :depends-on ("factrb" "shiftb"))
94             (:file "factrb")
95             (:file "shiftb")
96             (:file "sbblok"
97                    :depends-on ("subfor" "subbak"))
98             (:file "subfor")
99             (:file "subbak")))))
100
101(defmethod perform ((op test-op) (c (eql (find-system "colnew"))))
102  (oos 'test-op "colnew-test-1")
103  (oos 'test-op "colnew-test-2")
104  (oos 'test-op "colnew-test-3"))
105
106
107;; Test problem 1 from TOMS 569.
108;;
109;; Run (*main*).  Appears to work since the error tolerance is satisfied.
110(defsystem colnew-test-1
111  :depends-on ("colnew")
112  :pathname "colnew/"
113  :components
114  ((:module problem-1
115            :default-component-class colnew-fortran-file
116            :components
117            ((:file "prob1"
118                    :depends-on ("fsub" "dfsub" "gsub" "dgsub" "exact"))
119             (:file "fsub")
120             (:file "gsub")
121             (:file "dfsub")
122             (:file "dgsub")
123             (:file "exact")))))
124
125(defmethod perform ((op test-op) (c (eql (find-system "colnew-test-1"))))
126  (funcall (intern "PROB1" (find-package '#:colnew))))
127
128
129;; Test problem 2 from TOMS 569.  Appears to work.
130(defsystem colnew-test-2
131  :depends-on ("colnew")
132  :pathname "colnew/"
133  :components
134  ((:module problem-2
135            :default-component-class colnew-fortran-file
136            :components
137            ((:file "prob2"
138                    :perform (compile-op :around (op c)
139                                         (fortran-compile op c
140                                                          :declare-common t :common-as-array t))
141                    :depends-on ("fsub" "dfsub" "gsub" "dgsub" "solutn"))
142             (:file "fsub")
143             (:file "gsub")
144             (:file "dfsub")
145             (:file "dgsub")
146             (:file "solutn")))))
147
148(defmethod perform ((op test-op) (c (eql (find-system "colnew-test-2"))))
149  (funcall (intern "PROB2" (find-package '#:colnew))))
150
151
152;; Test problem 3 from TOMS 569.
153(defsystem colnew-test-3
154  :depends-on ("colnew")
155  :pathname "colnew/"
156  :components
157  ((:module problem-3
158            :default-component-class colnew-fortran-file
159            :components
160            ((:file "prob3"
161                    :perform (compile-op :around (op c)
162                                         (fortran-compile op c
163                                                          :declare-common t :common-as-array t))
164                    :depends-on ("fsub" "dfsub" "gsub" "dgsub" "solutn"))
165             (:file "fsub")
166             (:file "gsub")
167             (:file "dfsub")
168             (:file "dgsub")
169             (:file "solutn")))))
170
171(defmethod perform ((op test-op) (c (eql (find-system "colnew-test-3"))))
172  (funcall (intern "PROB3" (find-package '#:colnew))))
Note: See TracBrowser for help on using the browser.