;;;;"coherence.scm" FreeSnell optics validation suite	-*-scheme-*-
;;; Copyright (C) 2004, 2005 Aubrey Jaffer

;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.

;;; http://people.csail.mit.edu/jaffer/FreeSnell/coherence.html

(require 'FreeSnell)
(require 'databases)
(require 'database-interpolate)
(require 'eps-graph)
(require 'printf)

;;(define nk (open-database "nk.rwb" 'rwb-isam))
;;(define nk (open-database "/home/jaffer/cool/nk-sopra.rwb" 'rwb-isam))
(define nk (open-database (or (getenv "NK_DATABASE_PATH") "nk.rwb") 'rwb-isam))
(define HDPE (interpolate-from-table (open-table nk 'HDPE) 2))

(define (PE-3x14-co)
  ;;(define HDPE 1.54+.002i)
  (for-each
   (lambda (str k smp)
     (plot-response
      (title (sprintf #f "%s 14.um Coherent Polyethylene Films" str)
	     (sprintf #f "PE-%dx14-co" k))
      (output-format 'png 384 256)
      (font 'Times 13 "-15.3" "")
      ;;(IR HDPE 'real 'imag)
      (samples smp)
      (range 0 1)
      (marker 11e-6)
      ;;(range -60 0 'db)
      (logarithmic 3e-6 15e-6)
      (incident 4 'T)
      (stack-colors 'gigas)
      (optical-stack (nominal  6.7e-6)
		     (substrate 1)
		     (repeat k
			     (layer 1.0 1e-3)
			     (layer HDPE 14e-6))
		     (substrate 1)
		     )))
   '("One" "Two" "Three")
   '(1 2 3)
   '(200 1200 1200)))

(define (PE-3x14)
  ;;(define HDPE 1.54+.002i)
  (for-each
   (lambda (str k smp)
     (plot-response
      (title (sprintf #f "%s 14.um Polyethylene Films" str)
	     (sprintf #f "PE-%dx14" k))
      (output-format 'png 384 256)
      (font 13 "-15.3" "")
      ;;(IR HDPE 'real 'imag)
      (samples smp)
      (range 0 1)
      ;;(range -60 0 'db)
      (logarithmic 3e-6 15e-6)
      ;;(incident '(8 18 35 62) 'T)
      (incident 4 'T)
      (stack-colors 'gigas)
      (optical-stack (nominal  6.7e-6)
		     (substrate 1)
		     (repeat k
			     (layer* 1.0 1e-3)
			     (layer HDPE 14e-6))
		     (substrate 1)
		     )))
   '("One" "Two" "Three")
   '(1 2 3)
   '(200 200 200)))

(define (film-flat)
  (define FILM 1.54)
  (plot-response
   (title "50.um Film;  n = 1.54" "film-flat")
   (output-format 'png 600 184)
   (font 'Times 13 "-15.3" "")
   (samples 1200)
   (wavelengths 2.5e-6 25e-6)
   (incident 0 'T 'R)
   (range 0 1)
   (optical-stack
    (nominal 11e-6)
    (substrate 1)
    (layer FILM 50e-6)
    (substrate 1))))

(define (film-smooth)
  (define FILM 1.54)
  (plot-response
   (title "50.um Film;  n = 1.54" "film-smooth")
   (output-format 'png 600 184)
   (font 'Times 13 "-15.3" "")
   (samples 1200)
   (wavelengths 2.5e-6 25e-6)
   (smooth 0.05e-6)
   (incident 0 'T 'R)
   (range 0 1)
   (optical-stack
    (nominal 11e-6)
    (substrate 1)
    (layer FILM 50e-6)
    (substrate 1))))

(define (film-flat-wn)
  (define FILM 1.54)
  (plot-response
   (title "50.um Film;  n = 1.54" "film-flat-wn")
   (output-format 'png 600 184)
   (font 'Times 13 "-15.3" "")
   (samples 1200)
   (wavenumbers 4000 400)
   ;;(smooth 5)
   (incident 0 'T 'R)
   (range 0 1)
   (optical-stack
    (nominal 11e-6)
    (substrate 1)
    (layer FILM 50e-6)
    (substrate 1))))

(define H2O (interpolate-from-table (open-table nk 'H2O) 2))
(define ice (interpolate-from-table (open-table nk 'H2O-ice) 2))

(define (spect)
  (plot-response
   (title "H2O" "h2o")
   (font 14 "kk0.015" "0.4kk")
   (logarithmic 1e-6 100e-6)
   (IR H2O '(log_10 k))			; 'n
   ))
;;(spect)

(define (h2o-irs)
  (plot-response
   (title "H2O" "h2o-ir")
   (output-format 'png 350 250)
   (font 14 "kk0.015" "0.4kk")
   (wavenumbers (/ 0.01 4.5e-6) (/ 0.01 40e-6))
   (IR h2o 'k))
  (plot-response
   (title "H2O ice (-7 C)" "h2o-ice-ir")
   (output-format 'png 350 250)
   (font 14 "kk0.015" "0.4kk")
   (wavenumbers (/ 0.01 4.5e-6) (/ 0.01 40e-6))
   (IR ice 'k)))

;; http://ga.water.usgs.gov/edu/watercycleatmosphere.html says
;; dry air has a density of 1.007 kg/m^3
;; cloud has a density of 1.003 kg/m^3.

;; H2O 1 g/m^3 have volume ratio 1 cm^3/m^3 = 1e-6.

(define (clouds)
  (define cld01 (granular-IR h2o 1e-6 1))
  (define ice01 (granular-IR ice 1e-6 1))
  (plot-response
   (title "Cloud" "cloud")
   (output-format 'png 350 250)
   (stack-colors "Cloud Burst" "Raincloud")
   (font 14 "kk0.015" "0.4kk")
   (range 0 0.01)
   (wavenumbers (/ 0.01 4.5e-6) (/ 0.01 40e-6))
   (incident 0 'T)
   (optical-stack (layer* cld01 250))
   (optical-stack (layer* h2o .25e-3)))
  (plot-response
   (title "Ice Cloud (- 7 C)" "icloud")
   (output-format 'png 350 250)
   (stack-colors "Cloud Burst" "Raincloud")
   (font 14 "kk0.015" "0.4kk")
   (range 0 0.06)
   (wavenumbers (/ 0.01 4.5e-6) (/ 0.01 40e-6))
   (incident 0 'T)
   (optical-stack (layer* ice01 250))
   (optical-stack (layer* ice .25e-3))))

(define (coherence)
  (PE-3x14-co)
  (PE-3x14)
  (film-flat)
  (film-smooth)
  (film-flat-wn)
  (h2o-irs)
  (clouds))

;;(coherence)