root/packages/colnew.asd @ 1118:d1aa847b0433

Revision 1118:d1aa847b0433, 5.0 KB (checked in by Raymond Toy <toy.raymond@…>, 3 years ago)

Make sure f2cl is loaded before processing the file.

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