Changeset 25535 in project


Ignore:
Timestamp:
11/21/11 17:49:54 (9 years ago)
Author:
Ivan Raikov
Message:

9ML-toolkit: added sundials interface

Location:
release/4/9ML-toolkit/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/9ML-toolkit/trunk/9ML-toolkit.setup

    r25514 r25535  
    66(required-extension-version 'getopt-long 1.9)
    77(required-extension-version 'miniML 1.7)
    8 (required-extension-version 'signal-diagram 2.1)
    9 
    10 (define version 1.8)
     8(required-extension-version 'signal-diagram 2.2)
     9
     10(define version 1.9)
    1111
    1212(make (
  • release/4/9ML-toolkit/trunk/ivp-chicken.scm

    r25055 r25535  
    2323(module 9ML-ivp-chicken
    2424
    25         (ivp-chicken)
     25        (ivp-chicken ivp-chicken/cvode)
    2626
    2727        (import scheme chicken )
     
    4040(define-syntax run
    4141  (syntax-rules ()
    42     ((_ f indep dep end input parameters)
     42    ((_ f indep dep events end input parameters)
    4343     (let ((nstate input))
    4444       (printf "# ~A " indep)
     
    5757               (recur (append (f nstate) parameters))))))
    5858     )))
     59EOF
     60)
     61
     62
     63(define chicken/cvode-run
     64#<<EOF
     65
     66(define-syntax run
     67  (syntax-rules ()
     68    ((_ f h indep dep events end input parameters)
     69     (let ((nstate input))
     70       (printf "# ~A " indep)
     71       (for-each (lambda (x) (printf "~A " x)) dep)
     72       (printf "~%")
     73       (let recur ((nstate nstate) (hv (alist-ref h parameters)))
     74         (let ((ival (alist-ref indep nstate)))
     75           (printf "~A " ival)
     76           (for-each (lambda (x)
     77                       (let ((v (alist-ref x nstate)))
     78                         (printf "~A " (if (boolean? v) (or (and v 1) 0) v))))
     79                     dep)
     80           (printf "~%")
     81           (if (> ival end)
     82               (print "# All done!")
     83               (let ((nstate1 (f nstate)))
     84                 (if (any (lambda (x) (alist-ref x nstate1)) events)
     85                     (begin (alist-update! h 1e-4 nstate)
     86                            (alist-update! h 1e-4 parameters)
     87                            (recur (append (f nstate) parameters) 1e-4))
     88                     (let ((hv1 (and (fp< hv 0.25) (fp+ hv 1e-2))))
     89                       (if hv1 (alist-update! h hv1 parameters))
     90                       (recur (append nstate1 parameters) (or hv1 hv))))
     91           )))
     92       )))
     93    ))
     94
    5995EOF
    6096)
     
    97133
    98134
     135(define (ivp-chicken/cvode prefix ivp-id hvar ivar dvars pvars events start end ic sd)
     136
     137  (let* ((dir (or (pathname-directory prefix) "."))
     138         (solver-path (make-pathname dir (conc ivp-id "_solver.scm")))
     139         (run-path    (make-pathname dir (sprintf "~A_run.scm" ivp-id)))
     140         (exec-path   (make-pathname dir (sprintf "~A_run" ivp-id)))
     141         (log-path    (make-pathname dir (sprintf "~A_~A.log" (pathname-file prefix) ivp-id)))
     142         (csc-path    (make-pathname (program-path) "csc")))
     143   
     144    (make
     145        (
     146         (solver-path (prefix)
     147                      (with-output-to-file solver-path
     148                        (lambda () (codegen/scheme ivp-id sd solver: 'cvode))))
     149         
     150         (run-path (prefix)
     151                   (with-output-to-file run-path
     152                     (lambda ()
     153                       (print-fragments
     154                        (list
     155                         (sprintf "(include \"~A_solver.scm\")~%~%" ivp-id)
     156                         chicken/cvode-run nl
     157                         (sprintf "(define initial (quote ~A))~%~%" (cons (cons ivar start) ic))
     158                         (sprintf "(define parameters (quote ~A))~%~%" (map (lambda (x) (assoc x ic)) pvars))
     159                         (sprintf "(run ~A (quote ~A) (quote ~A) (quote ~A) (quote ~A) ~A initial parameters)~%~%" ivp-id hvar ivar dvars events end)
     160                         )))))
     161         
     162         (exec-path (run-path solver-path)
     163                    (run (,csc-path -w -I ,dir -b -S -d0 -O3 -disable-interrupts -heap-initial-size 1M ,run-path)))
     164         
     165         (log-path (exec-path) (run (,exec-path > ,log-path)))
     166         )
     167     
     168      (list log-path) )
     169    ))
     170
     171
    99172)
  • release/4/9ML-toolkit/trunk/ivp.scm

    r25514 r25535  
    2020;;
    2121
    22 (require-extension setup-api srfi-13 datatype static-modules miniML miniMLsyntax miniMLvalue miniMLeval)
     22(require-extension setup-api posix srfi-13 datatype static-modules miniML miniMLsyntax miniMLvalue miniMLeval)
    2323(require-extension getopt-long ssax sxml-transforms sxpath sxpath-lolevel object-graph signal-diagram)
    2424(require-extension 9ML-parse 9ML-repr )
     
    139139                    (single-char #\x))
    140140
    141     (platform        "simulation platform (one of chicken, mlton, octave, octave/mlton)"
     141    (platform        "simulation platform (one of chicken, chicken/cvode, mlton, octave, octave/mlton)"
    142142                     (value (required PLATFORM)
    143143                            (predicate
     
    145145                                (let ((s (string->symbol (string-downcase x))))
    146146                                  (case s
    147                                     ((chicken mlton octave octave/mlton) s)
     147                                    ((chicken chicken/cvode mlton octave octave/mlton) s)
    148148                                    (else (error 'ivp "unrecognized platform" x))))))
    149149                            (transformer ,string->symbol)
     
    254254                   
    255255                   ((octave)
    256                     (ivp-octave prefix ivp-id hvar ivar dvars pvars events start end ic sd)
     256                    (process-fork
     257                     (lambda () (ivp-octave prefix ivp-id hvar ivar dvars pvars events start end ic sd)))
    257258                    (list ivp-id ivar dvars) )
    258259
    259260                   ((octave/mlton octave-mlton)
    260                     (ivp-octave-mlton prefix ivp-id hvar ivar dvars pvars start end ic sd)
     261                    (process-fork
     262                     (lambda () (ivp-octave-mlton prefix ivp-id hvar ivar dvars pvars start end ic sd)))
    261263                    (list ivp-id ivar dvars) )
    262264                   
    263265                   ((mlton)
    264                     (ivp-mlton  prefix ivp-id ivar dvars pvars start end ic sd)
     266                    (process-fork
     267                     (lambda () (ivp-mlton  prefix ivp-id ivar dvars pvars start end ic sd)))
    265268                    (list ivp-id ivar dvars) )
    266269
    267270                   ((chicken)
    268                     (ivp-chicken  prefix ivp-id ivar dvars pvars start end ic sd)
     271                    (process-fork
     272                     (lambda () (ivp-chicken prefix ivp-id ivar dvars pvars start end ic sd)))
    269273                    (list ivp-id ivar dvars) )
    270274
     275                   ((chicken/cvode)
     276                    (process-fork
     277                     (lambda () (ivp-chicken/cvode prefix ivp-id hvar ivar dvars pvars events start end ic sd)))
     278                    (list ivp-id ivar dvars) )
    271279
    272280                   (else (error 'generate-ivp-table "unknown platform"  platform))
     
    329337                   (and (pair? label) (string=? (car label) "ivp")))) ;; value is an IVP
    330338      (let* ((ivp-id (gensym 'ivp))
    331              (ivp-plot-link `(img (@ (src ,(sprintf "~A_~A.png" (pathname-file prefix) ivp-id)) (alt "NineML IVP plot"))))
    332              (ivp-info (generate-ivp-table prefix ivp-id value platform: (simulation-platform))))
    333         (if ivp-plot (generate-ivp-plot prefix ivp-info format: plot-format index: plot-index))
    334         (and ivp-plot ivp-plot-link)
     339             (ivp-plot-link `(img (@ (src ,(sprintf "~A_~A.png" (pathname-file prefix) ivp-id)) (alt "NineML IVP plot")))))
     340
     341        (let ((ivp-info (generate-ivp-table prefix ivp-id value platform: (simulation-platform))))
     342          (if ivp-plot (generate-ivp-plot prefix ivp-info format: plot-format index: plot-index))
     343          (and ivp-plot ivp-plot-link))
    335344        ))
    336345     
Note: See TracChangeset for help on using the changeset viewer.