meep.scm.in

麻省理工的计算光子晶体的程序

  (delete-meep-structure structure) (set! structure '()))

(define (restart-fields)
  (if (not (null? fields))
      (begin
	(meep-fields-t-set fields 0)
	(meep-fields-zero-fields fields))
      (init-fields)))

; ****************************************************************
; Flux spectra

(define AUTOMATIC -1) ; special value for directions, when auto-determined
(define-class flux-region no-parent
  (define-property center no-default 'vector3)
  (define-property size (vector3 0 0 0) 'vector3)
  (define-property direction AUTOMATIC 'integer)
  (define-property weight 1.0 'cnumber))

(define (fields-add-flux fields fcen df nfreq . fluxes)
  (define gvl '()) ; geometric_volume_list of flux regions
  (map (lambda (f)
	 (let* ((gv (volume (center (object-property-value f 'center))
			    (size (object-property-value f 'size))))
		(d0 (object-property-value f 'direction))
		(d (if (negative? d0)
		       (meep-fields-normal-direction fields gv)
		       d0))
		(c (meep-direction-component Sx d)))
	   (set! gvl
		 (make-geometric-volume-list
		  (volume (center (object-property-value f 'center))
			  (size (object-property-value f 'size)))
		  c
		  (object-property-value f 'weight)
		  gvl))))
       fluxes)
  (let ((flux
	 (meep-fields-add-dft-flux fields gvl 
				   (- fcen (/ df 2)) (+ fcen (/ df 2)) nfreq)))
    (delete-meep-geometric-volume-list gvl)
    flux))

(define (add-flux fcen df nfreq . fluxes)
  (if (null? fields) (init-fields))
  (apply fields-add-flux (append (list fields fcen df nfreq) fluxes)))

(define (scale-flux-fields s f)
  (meep-dft-flux-scale-dfts f s))

(define (get-flux-freqs f)
  (arith-sequence
   (meep-dft-flux-freq-min-get f)
   (meep-dft-flux-dfreq-get f)
   (meep-dft-flux-Nfreq-get f)))

(export-type (make-list-type 'number))
(define (get-fluxes f)
  (dft-flux-flux f))

(define (display-fluxes . fluxes)
  (if (not (null? fluxes))
      (apply display-csv
	     (append (list "flux"
			   (get-flux-freqs (car fluxes)))
		     (map get-fluxes fluxes)))))

(define (load-flux fname flux)
  (if (null? fields) (init-fields))
  (meep-dft-flux-load-hdf5 flux fields fname "" (get-filename-prefix)))

(define (save-flux fname flux)
  (if (null? fields) (init-fields))
  (meep-dft-flux-save-hdf5 flux fields fname "" (get-filename-prefix)))

(define (load-minus-flux fname flux)
  (load-flux fname flux)
  (meep-dft-flux-scale-dfts flux -1.0))

; ****************************************************************
; Generic step functions: these are functions which are called
; (potentially) at every time step.  They can either be a thunk
; or they can take one argument, to-do.  to-do is either 'step
; or 'finish, where 'step means to output (or whatever)
; normally, and 'finish is passed once at the end of the run
; (and is used to close files, print summary output, etcetera).

; step functions can be either thunks (the common case), or
; can take a "to-do" argument that is currently either 'step
; or 'finish (so that they can clean up at the end of a run).
(define (eval-step-func func to-do)
  (if (= 0 (procedure-num-args func))
      (if (eq? to-do 'step) (func))
      (func to-do)))
 
; Some convenient wrappers for step functions passed to run.  e.g., these
; can be used to only output at certain times, instead of ata every time step.

(define (combine-step-funcs . step-funcs)
  (lambda (to-do)
    (map (lambda (f) (eval-step-func f to-do)) step-funcs)))

; generic wrapper
(define (when-true-funcs cond? step-funcs)
  (lambda (to-do)
    (if (or (eq? to-do 'finish) (cond?))
	(map (lambda (f) (eval-step-func f to-do)) step-funcs))))

; evaluate step-funcs whenever (cond?) is true/false.
(define (when-true cond? . step-funcs) (when-true-funcs cond? step-funcs))
(define (when-false cond? . step-funcs) 
  (when-true-funcs (lambda () (not (cond?))) step-funcs))

; output at an interval of dT (in meep/simulation time).
(define (at-every dT . step-funcs)
  (if (null? fields) (init-fields))
  (let ((Tlast (meep-time)))
    (lambda (to-do)
      (let ((T (meep-time)))
	(if (or (eq? to-do 'finish) (>= T (+ Tlast dT)))
	    (begin
	      (map (lambda (f) (eval-step-func f to-do)) step-funcs)
	      (set! Tlast T)))))))

(define (after-time T . step-funcs)
  (if (null? fields) (init-fields))
  (let ((T0 (meep-time)))
    (when-true-funcs (lambda () (>= (meep-time) (+ T0 T))) step-funcs)))

(define (before-time T . step-funcs)
  (if (null? fields) (init-fields))
  (let ((T0 (meep-time)))
    (when-true-funcs (lambda () (< (meep-time) (+ T0 T))) step-funcs)))

(define (at-time T . step-funcs)
  (let ((done? false))
    (after-time T (lambda (to-do)
		    (if (or (not done?) (eq? to-do 'finish))
			(map (lambda (f) (eval-step-func f to-do)) step-funcs))
		    (set! done? (or done? (eq? to-do 'step)))))))

(define (after-sources . step-funcs)
  (if (null? fields) (init-fields))
  (apply after-time
	 (cons (- (meep-fields-last-source-time fields) (meep-time))
	       step-funcs)))

; after sources plus a time T.
(define (after-sources+ T . step-funcs)
  (if (null? fields) (init-fields))
  (apply after-time
	 (cons (- (+ (meep-fields-last-source-time fields) T) (meep-time))
	       step-funcs)))

(define (during-sources . step-funcs)
  (if (null? fields) (init-fields))
  (apply before-time
	 (cons (- (meep-fields-last-source-time fields) (meep-time))
	       step-funcs)))

; the user could just call functions, but this functions saves the user
; from having to manually call init-fields
(define (at-beginning . step-funcs)
  (let ((done? false))
    (lambda (to-do)
      (if (not done?)
	  (begin
	    (map (lambda (f) (eval-step-func f to-do)) step-funcs)
	    (set! done? true))))))

; for completeness (although the user could just do this after running):
(define (at-end . step-funcs)
  (lambda (to-do)
    (if (eq? to-do 'finish)
	(begin
	  (map (lambda (f) (eval-step-func f 'step)) step-funcs)
	  (map (lambda (f) (eval-step-func f 'finish)) step-funcs)))))

; ****************************************************************
; File output functions (can only be called after init-fields).

(define-param filename-prefix "")
(define (get-filename-prefix)
  (if (eq? filename-prefix false)
      ""
      (if (and (not (null? include-files))
	       (string-null? filename-prefix))
	  (string-append
	   (strip-suffix ".scm"
	     (strip-suffix ".ctl" (cdr (split-pathname (car include-files))))))
	  filename-prefix)))

; Use output directory instead of outputting in same directory;
; uses init-fields-hooks to handle fields not yet initted.
(define (use-output-directory . dname_)
  (let ((dname (if (null? dname_)
		   (string-append (get-filename-prefix) "-out")
		   (car dname_))))
    (let ((hook
	   (let ((trashed? false)) ; only trash output directory once per run
	     (lambda ()
	       (print "Meep: using output directory \"" dname "\"\n")
	       (meep-fields-set-output-directory fields dname)
	       (if (not trashed?) (meep-trash-output-directory dname))
	       (set! trashed? true)))))
      (set! init-fields-hooks (cons hook init-fields-hooks))
      (if (not (null? fields)) (hook))
      (set! filename-prefix false)
      dname)))

(define-param output-volume '()) ; region to output; NULL for everywhere

(define output-append-h5 '()) ; h5 file to append data to (NULL if none)

; hook function called with the filename after every HDF5 files is created;
; this can be used to convert the file into other formats, etcetera.
(define output-h5-hook (lambda (fname) false)) ; default is no-op

(define output-single-precision? false) ; output single-prec to save space

(define meep-last-eps-filename "") ; most recent epsilon file outputted

(define (output-component c . h5file)
  (if (null? fields) (error "init-fields is required before output-component"))
  (meep-fields-output-hdf5 
   fields c 
   (if (null? output-volume)
       (meep-fields-total-volume fields)
       output-volume)
   (if (null? h5file) output-append-h5 (car h5file)) 
   (and (null? h5file) (not (null? output-append-h5)))
   output-single-precision? 
   (get-filename-prefix))
  (if (null? h5file)
      (let ((nm (meep-fields-h5file-name fields (meep-component-name c)
					 (get-filename-prefix) true)))
	(if (eq? c Dielectric) (set! meep-last-eps-filename nm))
	(output-h5-hook nm))))

; cs = list of components, and func is function of position & these components
(define (output-field-function-helper name cs func real-only? h5file)
  (if (null? fields) (error "init-fields is required before output-field-function"))
  (meep-fields-output-hdf5
   fields name
   (cons cs func)
   (if (null? output-volume)
       (meep-fields-total-volume fields)
       output-volume)
   (if (null? h5file) output-append-h5 (car h5file))
   (and (null? h5file) (not (null? output-append-h5)))
   output-single-precision?
   (get-filename-prefix)
   real-only?)
  (if (null? h5file)
      (output-h5-hook (meep-fields-h5file-name fields
                       name (get-filename-prefix) true))))

(define (output-field-function name cs func . h5file)
  (output-field-function-helper name cs func false h5file))

(define (output-real-field-function name cs func . h5file)
  (output-field-function-helper name cs func true h5file))

(define (output-components fname . cs)
  (if (null? fields) (error "init-fields is required before output-component"))
  (let ((f 
	 (if (null? output-append-h5)
	     (list (meep-fields-open-h5file fields fname (meep-h5file-WRITE)
					    (get-filename-prefix) true))
	     '())))
    (map (lambda (c) (apply output-component (cons c f))) cs)
    (if (null? output-append-h5) (delete-meep-h5file (car f))))
  (if (null? output-append-h5)
      (output-h5-hook (meep-fields-h5file-name 
		       fields fname (get-filename-prefix) true))))

; convenience functions, similar to MPB:
(define (output-epsilon) (output-component Dielectric))
(define (output-hpwr) (output-component H-EnergyDensity))
(define (output-dpwr) (output-component D-EnergyDensity))
(define (output-tot-pwr) (output-component EnergyDensity))
(defmacro-public define-output-field (name cp CP)
  `(begin
     (define (,(symbol-append 'output- cp))
       (output-components ,name
			  ,(symbol-append CP 'x)
			  ,(symbol-append CP 'y)
			  ,(symbol-append CP 'z)
			  ,(symbol-append CP 'r) ,(symbol-append CP 'p)))
     (define (,(symbol-append 'output- cp '-x))
       (output-component ,(symbol-append CP 'x)))
     (define (,(symbol-append 'output- cp '-y))
       (output-component ,(symbol-append CP 'y)))
     (define (,(symbol-append 'output- cp '-z))
       (output-component ,(symbol-append CP 'z)))
     (define (,(symbol-append 'output- cp '-r))
       (output-component ,(symbol-append CP 'r)))
     (define (,(symbol-append 'output- cp '-p))
       (output-component ,(symbol-append CP 'p)))))
(define-output-field "h" hfield H)
(define-output-field "e" efield E)
(define-output-field "d" dfield D)
(define-output-field "s" poynting S) ; compat. with MPB.
(define-output-field "s" sfield S)

(define (with-prefix pre . step-funcs)
  (lambda (to-do)
    (let ((pre-save filename-prefix))
      (set! filename-prefix (string-append pre (get-filename-prefix)))
      (map (lambda (f) (eval-step-func f to-do)) step-funcs)
      (set! filename-prefix pre-save))))

; change output-volume for a few step-funcs to gv
(define (in-volume gv . step-funcs)
  (let ((cur-eps "")) ; allow per-volume eps filenames
    (lambda (to-do)
      (let ((gv-save output-volume)
	    (eps-save meep-last-eps-filename))
	(set! output-volume gv)
	(if (not (string-null? cur-eps))
	    (set! meep-last-eps-filename cur-eps))
	(map (lambda (f) (eval-step-func f to-do)) step-funcs)