module Drasil.SWHS.Unitals where -- all of this file is exported

import Language.Drasil
import Language.Drasil.Display (Symbol(Atop), Decoration(Delta))
import Language.Drasil.ShortHands
import Language.Drasil.Chunk.Concept.NamedCombinators

import Data.Drasil.Concepts.Documentation (simulation)
import Data.Drasil.Constraints (gtZeroConstr)
import Data.Drasil.Quantities.Math (gradient, pi_, surArea, surface, uNormalVect)
import Data.Drasil.Quantities.PhysicalProperties (mass, density, vol)
import Data.Drasil.Quantities.Physics (subMax, subMin, supMax, supMin, time)
import Data.Drasil.Quantities.Thermodynamics (sensHeat, temp, meltPt,
  htFlux, latentHeat, boilPt, heatCapSpec)
import Data.Drasil.SI_Units (m_2, second, kilogram, metre, joule,
  centigrade, m_3, specificE)
import Data.Drasil.Units.PhysicalProperties (densityU)
import qualified Data.Drasil.Units.Thermodynamics as UT (heatTransferCoef,
  heatCapSpec, thermalFlux, volHtGenU)

import Drasil.SWHS.Concepts (water)

import Control.Lens ((^.))

symbols :: [DefinedQuantityDict]
symbols :: [DefinedQuantityDict]
symbols = DefinedQuantityDict
pi_ forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [UnitalChunk]
units forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [DefinedQuantityDict]
unitless forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [ConstrConcept]
constrained

symbolsAll :: [QuantityDict]
symbolsAll :: [QuantityDict]
symbolsAll = forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [DefinedQuantityDict]
symbols forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [ConstQDef]
specParamValList forall a. [a] -> [a] -> [a]
++
  forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [ConstQDef
htFusionMin, ConstQDef
htFusionMax, ConstQDef
coilSAMax] forall a. [a] -> [a] -> [a]
++
  forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [UncertainChunk
absTol, UncertainChunk
relTol]

-- Symbols with Units --

units :: [UnitalChunk]
units :: [UnitalChunk]
units = forall a b. (a -> b) -> [a] -> [b]
map forall c. (Unitary c, Concept c, MayHaveUnit c) => c -> UnitalChunk
ucw [UnitalChunk
inSA, UnitalChunk
outSA, UnitalChunk
heatCapSpec, UnitalChunk
htCapL,
  UnitalChunk
htCapS, UnitalChunk
htCapV, UnitalChunk
sensHeat, UnitalChunk
pcmInitMltE,
  UnitalChunk
volHtGen, UnitalChunk
htTransCoeff, UnitalChunk
pcmMass, UnitalChunk
wMass, UnitalChunk
htFlux, UnitalChunk
latentHeat,
  UnitalChunk
thFluxVect, UnitalChunk
htFluxC, UnitalChunk
htFluxIn, UnitalChunk
htFluxOut, UnitalChunk
htFluxP, UnitalChunk
latentEP,
  UnitalChunk
temp, UnitalChunk
boilPt, UnitalChunk
tempEnv, UnitalChunk
meltPt, UnitalChunk
tInitMelt,
  UnitalChunk
tFinalMelt, UnitalChunk
vol, UnitalChunk
tankVol, UnitalChunk
wVol, UnitalChunk
deltaT,
  UnitalChunk
density, UnitalChunk
tau, UnitalChunk
tauLP, UnitalChunk
tauSP, UnitalChunk
tauW, UnitalChunk
thickness] forall a. [a] -> [a] -> [a]
++
  forall a b. (a -> b) -> [a] -> [b]
map forall c. (Unitary c, Concept c, MayHaveUnit c) => c -> UnitalChunk
ucw [UnitalChunk
mass, UnitalChunk
time] -- ++ [tankLength, diam, coilSA]

unitalChuncks :: [UnitalChunk]
unitalChuncks :: [UnitalChunk]
unitalChuncks = [UnitalChunk
inSA, UnitalChunk
outSA, UnitalChunk
htCapL, UnitalChunk
htCapS, UnitalChunk
htCapV,
  UnitalChunk
pcmInitMltE, UnitalChunk
volHtGen, UnitalChunk
htTransCoeff,
  UnitalChunk
pcmMass, UnitalChunk
wMass,
  UnitalChunk
thFluxVect, UnitalChunk
htFluxC, UnitalChunk
htFluxIn, UnitalChunk
htFluxOut, UnitalChunk
htFluxP, UnitalChunk
latentEP,
  UnitalChunk
tempEnv, UnitalChunk
tInitMelt,
  UnitalChunk
tFinalMelt, UnitalChunk
tankVol, UnitalChunk
wVol, UnitalChunk
deltaT,
  UnitalChunk
tau, UnitalChunk
tauLP, UnitalChunk
tauSP, UnitalChunk
tauW, UnitalChunk
simTime, UnitalChunk
thickness]

inSA, outSA, htCapL, htCapS, htCapV,
  pcmInitMltE, volHtGen, htTransCoeff,
  pcmMass, wMass,
  thFluxVect, htFluxC, htFluxIn, htFluxOut, htFluxP, latentEP,
  tempEnv, tInitMelt,
  tFinalMelt, tankVol, wVol, deltaT,
  tau, tauLP, tauSP, tauW, simTime, thickness:: UnitalChunk

---------------------
-- Regular Symbols --
---------------------

--symbol names can't begin with a capital

inSA :: UnitalChunk
inSA = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"inSA" (String -> NP
nounPhraseSP
  String
"surface area over which heat is transferred in")
  (String -> Sentence
S String
"surface area over which thermal energy is transferred into an object")
  (Symbol -> Symbol -> Symbol
sub Symbol
cA Symbol
lIn) Space
Real UnitDefn
m_2

outSA :: UnitalChunk
outSA = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"outSA" (String -> NP
nounPhraseSP
  String
"surface area over which heat is transferred out")
  (String -> Sentence
S String
"surface area over which thermal energy is transferred out of an object")
  (Symbol -> Symbol -> Symbol
sub Symbol
cA Symbol
lOut) Space
Real UnitDefn
m_2

htCapL :: UnitalChunk
htCapL = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"htCapL" (String -> NP
nounPhraseSP String
"specific heat capacity of a liquid")
  (String -> Sentence
S forall a b. (a -> b) -> a -> b
$ String
"the amount of energy required to raise the temperature of a given " forall a. [a] -> [a] -> [a]
++
  String
"unit mass of a given liquid by a given amount")
  (Symbol -> Symbol -> Symbol
sup (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
heatCapSpec) Symbol
lLiquid) Space
Real UnitDefn
UT.heatCapSpec

htCapS :: UnitalChunk
htCapS = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"htCapS"
  (String -> NP
nounPhraseSP String
"specific heat capacity of a solid")
  (String -> Sentence
S forall a b. (a -> b) -> a -> b
$ String
"the amount of energy required to raise the temperature of " forall a. [a] -> [a] -> [a]
++
  String
"a given unit mass of a given solid by a given amount")
  (Symbol -> Symbol -> Symbol
sup (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
heatCapSpec) Symbol
lSolid) Space
Real UnitDefn
UT.heatCapSpec

htCapV :: UnitalChunk
htCapV = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"htCapV"
  (String -> NP
nounPhraseSP String
"specific heat capacity of a vapour")
  (String -> Sentence
S forall a b. (a -> b) -> a -> b
$ String
"the amount of energy required to raise the temperature of a given " forall a. [a] -> [a] -> [a]
++
  String
"unit mass of vapour by a given amount")
  (Symbol -> Symbol -> Symbol
sup (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
heatCapSpec) Symbol
lVapour) Space
Real UnitDefn
UT.heatCapSpec

pcmInitMltE :: UnitalChunk
pcmInitMltE = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"pcmInitMltE" (String -> NP
nounPhraseSP
  String
"change in heat energy in the PCM at the instant when melting begins")
  (String -> Sentence
S String
"change in thermal energy in the phase change material at the melting point")
  (Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
sensHeat) Symbol
lPCM) Symbol
lMelt) Symbol
lInit) Space
Real UnitDefn
joule

volHtGen :: UnitalChunk
volHtGen = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"volHtGen"
  (String -> NP
nounPhraseSP String
"volumetric heat generation per unit volume")
  (String -> Sentence
S String
"amount of thermal energy generated per unit volume") Symbol
lG Space
Real UnitDefn
UT.volHtGenU

htTransCoeff :: UnitalChunk
htTransCoeff = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"htTransCoeff"
  (String -> NP
nounPhraseSP String
"convective heat transfer coefficient")
  (String -> Sentence
S forall a b. (a -> b) -> a -> b
$ String
"the proportionality constant between the heat flux and the " forall a. [a] -> [a] -> [a]
++
  String
"thermodynamic driving force for the flow of thermal energy")
  Symbol
lH Space
Real UnitDefn
UT.heatTransferCoef

pcmMass :: UnitalChunk
pcmMass = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"pcmMass" (String -> NP
nounPhraseSP String
"mass of phase change material")
  (String -> Sentence
S String
"the quantity of matter within the phase change material")
  (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
mass) Symbol
lPCM) Space
Real UnitDefn
kilogram

wMass :: UnitalChunk
wMass = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"wMass" (String -> NP
nounPhraseSP String
"mass of water")
  (String -> Sentence
S String
"the quantity of matter within the water") (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
mass) Symbol
lWater) Space
Real UnitDefn
kilogram

thFluxVect :: UnitalChunk
thFluxVect = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"thFluxVect" (String -> NP
nounPhraseSP String
"thermal flux vector")
  (String -> Sentence
S String
"vector denoting the direction of thermal flux through a surface")
  (Symbol -> Symbol
vec Symbol
lQ) Space
Real UnitDefn
UT.thermalFlux

htFluxC :: UnitalChunk
htFluxC = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"htFluxC"
  (String -> NP
nounPhraseSP String
"heat flux into the water from the coil")
  (String -> Sentence
S String
"the rate of heat energy transfer into the water from the coil per unit time")
  (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
htFlux) Symbol
lCoil) Space
Real UnitDefn
UT.thermalFlux

htFluxIn :: UnitalChunk
htFluxIn = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"htFluxIn" (String -> NP
nounPhraseSP String
"heat flux input")
  (String -> Sentence
S String
"the rate of heat energy transfer into an object per unit time")
  (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
htFlux) Symbol
lIn) Space
Real UnitDefn
UT.thermalFlux

htFluxOut :: UnitalChunk
htFluxOut = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"htFluxOut" (String -> NP
nounPhraseSP String
"heat flux output")
  (String -> Sentence
S String
"the rate of heat energy transfer into an object per unit time")
  (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
htFlux) Symbol
lOut) Space
Real UnitDefn
UT.thermalFlux

htFluxP :: UnitalChunk
htFluxP = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"htFluxP" (String -> NP
nounPhraseSP String
"heat flux into the PCM from water")
  (String -> Sentence
S forall a b. (a -> b) -> a -> b
$ String
"the rate of heat energy transfer into the phase" forall a. [a] -> [a] -> [a]
++
  String
"change material from the water per unit time")
  (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
htFlux) Symbol
lPCM) Space
Real UnitDefn
UT.thermalFlux

latentEP :: UnitalChunk
latentEP = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"latentEP" (String -> NP
nounPhraseSP String
"latent heat energy added to PCM")
  (String -> Sentence
S forall a b. (a -> b) -> a -> b
$ String
"energy released or absorbed, by a body or a thermodynamic system, "forall a. [a] -> [a] -> [a]
++
  String
"during a constant-temperature process and absorbed by the phase" forall a. [a] -> [a] -> [a]
++
  String
"change material") (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
latentHeat) Symbol
lPCM) Space
Real UnitDefn
joule

tempEnv :: UnitalChunk
tempEnv = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"tempEnv" (String -> NP
nounPhraseSP String
"temperature of the environment")
  (String -> Sentence
S String
"the tempature of a given environment")
  (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
temp) Symbol
lEnv) Space
Real UnitDefn
centigrade

tInitMelt :: UnitalChunk
tInitMelt = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"tInitMelt"
  (String -> NP
nounPhraseSP String
"time at which melting of PCM begins")
  (String -> Sentence
S forall a b. (a -> b) -> a -> b
$ String
"time at which the phase change material " forall a. [a] -> [a] -> [a]
++
    String
"begins changing from a solid to a liquid")
  (Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
time) Symbol
lMelt) Symbol
lInit) Space
Real UnitDefn
second

tFinalMelt :: UnitalChunk
tFinalMelt = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"tFinalMelt"
  (String -> NP
nounPhraseSP String
"time at which melting of PCM ends")
  (String -> Sentence
S forall a b. (a -> b) -> a -> b
$ String
"time at which the phase change material " forall a. [a] -> [a] -> [a]
++
    String
"finishes changes from a solid to a liquid")
  (Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
time) Symbol
lMelt) Symbol
lFinal) Space
Real UnitDefn
second
  
tankVol :: UnitalChunk
tankVol = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"tankVol" (String -> NP
nounPhraseSP String
"volume of the cylindrical tank")
  (String -> Sentence
S String
"the amount of space encompassed by a tank")
  (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
vol) Symbol
lTank) Space
Real UnitDefn
m_3

wVol :: UnitalChunk
wVol = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"wVol" (UnitalChunk
vol forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` ConceptChunk
water)
  (String -> Sentence
S String
"the amount of space occupied by a given quantity of water")
  (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
vol) Symbol
lWater) Space
Real UnitDefn
m_3

deltaT :: UnitalChunk
deltaT = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"deltaT" (String -> NP
nounPhraseSP String
"change in temperature")
  (String -> Sentence
S String
"change in the average kinetic energy of a given material")
  (Decoration -> Symbol -> Symbol
Atop Decoration
Delta forall a b. (a -> b) -> a -> b
$ forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
temp) Space
Real UnitDefn
centigrade

tau :: UnitalChunk
tau = forall u.
IsUnit u =>
String
-> NP -> Sentence -> (Stage -> Symbol) -> Space -> u -> UnitalChunk
ucStaged' String
"tau" (String -> NP
nounPhraseSP String
"dummy variable for integration over time")
  (String -> Sentence
S String
"binary value representing the presence or absence of integration over time")
  (Symbol -> Stage -> Symbol
autoStage Symbol
lTau) Space
Real UnitDefn
second
--Not sure how to define anything after this point

tauLP :: UnitalChunk
tauLP = forall u.
IsUnit u =>
String
-> NP -> Sentence -> (Stage -> Symbol) -> Space -> u -> UnitalChunk
ucStaged' String
"tauLP" (String -> NP
nounPhraseSP String
"ODE parameter for liquid PCM")
  (String -> Sentence
S forall a b. (a -> b) -> a -> b
$ String
"derived through melting of phase change material, which " forall a. [a] -> [a] -> [a]
++
  String
"changes ODE parameter for solid PCM into parameter for liquid")
  (Symbol -> Stage -> Symbol
autoStage forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol -> Symbol
sub Symbol
lTau Symbol
lPCM) Symbol
lLiquid) Space
Real UnitDefn
second

tauSP :: UnitalChunk
tauSP = forall u.
IsUnit u =>
String
-> NP -> Sentence -> (Stage -> Symbol) -> Space -> u -> UnitalChunk
ucStaged' String
"tauSP" (String -> NP
nounPhraseSP String
"ODE parameter for solid PCM")
  (String -> Sentence
S String
"derived parameter based on rate of change of temperature of phase change material")
  (Symbol -> Stage -> Symbol
autoStage forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol -> Symbol
sub Symbol
lTau Symbol
lPCM) Symbol
lSolid) Space
Real UnitDefn
second

tauW :: UnitalChunk
tauW = forall u.
IsUnit u =>
String
-> NP -> Sentence -> (Stage -> Symbol) -> Space -> u -> UnitalChunk
ucStaged' String
"tauW" (String -> NP
nounPhraseSP String
"ODE parameter for water related to decay time")
  (String -> Sentence
S String
"derived parameter based on rate of change of temperature of water")
  (Symbol -> Stage -> Symbol
autoStage forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol -> Symbol
sub Symbol
lTau Symbol
lWater) Space
Real UnitDefn
second

simTime :: UnitalChunk
simTime = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"simTime" (NP -> NP -> NP
compoundPhrase' (IdeaDict
simulation forall s a. s -> Getting a s a -> a
^. forall c. NamedIdea c => Lens' c NP
term)
  (UnitalChunk
time forall s a. s -> Getting a s a -> a
^. forall c. NamedIdea c => Lens' c NP
term)) (String -> Sentence
S String
"time over which the simulation runs")
  Symbol
lT Space
Real UnitDefn
second

thickness :: UnitalChunk
thickness = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc'  String
"thickness" (String -> NP
nounPhraseSP String
"Minimum thickness of a sheet of PCM")
  (String -> Sentence
S String
"the minimum thickness of a sheet of PCM")
  (Symbol -> Symbol
subMin Symbol
lH) Space
Real UnitDefn
metre
----------------------
-- Unitless symbols --
----------------------

-- FIXME: this list should not be hand-constructed
unitless :: [DefinedQuantityDict]
unitless :: [DefinedQuantityDict]
unitless = [DefinedQuantityDict
uNormalVect, forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr UnitalChunk
surface, DefinedQuantityDict
eta, DefinedQuantityDict
meltFrac, DefinedQuantityDict
gradient, DefinedQuantityDict
fracMin, DefinedQuantityDict
consTol,
            DefinedQuantityDict
aspectRatio, DefinedQuantityDict
aspectRatioMin, DefinedQuantityDict
aspectRatioMax]

eta, meltFrac, fracMin, consTol, aspectRatio, aspectRatioMin, aspectRatioMax :: DefinedQuantityDict

-- FIXME: should this have units?
eta :: DefinedQuantityDict
eta = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> String -> ConceptChunk
dcc String
"eta" (String -> NP
nounPhraseSP String
"ODE parameter related to decay rate")
  String
"derived parameter based on rate of change of temperature of water")
  (forall a b. a -> b -> a
const Symbol
lEta) Space
Real forall a. Maybe a
Nothing

meltFrac :: DefinedQuantityDict
meltFrac = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> String -> ConceptChunk
dcc String
"meltFrac" (String -> NP
nounPhraseSP String
"melt fraction")
  String
"ratio of thermal energy to amount of mass melted")
  --FIXME: Not sure if definition is exactly correct
  (forall a b. a -> b -> a
const Symbol
lPhi) Space
Real forall a. Maybe a
Nothing

fracMin :: DefinedQuantityDict
fracMin = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> String -> ConceptChunk
dcc String
"fracMin" 
  (String -> NP
nounPhraseSP String
"minimum fraction of the tank volume taken up by the PCM")
  String
"minimum fraction of the tank volume taken up by the PCM")
   (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ String -> Symbol
variable String
"MINFRACT") Space
Real forall a. Maybe a
Nothing

consTol :: DefinedQuantityDict
consTol = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> String -> ConceptChunk
dcc String
"consTol" 
  (String -> NP
nounPhraseSP String
"relative tolerance for conservation of energy") 
  String
"relative tolerance for conservation of energy")
  (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol -> Symbol
sub Symbol
cC Symbol
lTol) Space
Real forall a. Maybe a
Nothing

aspectRatio :: DefinedQuantityDict
aspectRatio = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> String -> ConceptChunk
dcc String
"aspectRatio" 
  (String -> NP
nounPhraseSP String
"aspect ratio")
  String
"ratio of tank diameter to tank length")
   (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ String -> Symbol
variable String
"AR") Space
Real forall a. Maybe a
Nothing

aspectRatioMin :: DefinedQuantityDict
aspectRatioMin = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> String -> ConceptChunk
dcc String
"aspectRatioMin" 
  (String -> NP
nounPhraseSP String
"minimum aspect ratio") String
"minimum aspect ratio")
   (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol
subMin (forall q. HasSymbol q => q -> Symbol
eqSymb DefinedQuantityDict
aspectRatio)) Space
Real forall a. Maybe a
Nothing

aspectRatioMax :: DefinedQuantityDict
aspectRatioMax = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> String -> ConceptChunk
dcc String
"aspectRatioMax" 
  (String -> NP
nounPhraseSP String
"maximum aspect ratio") String
"maximum aspect ratio")
   (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol
subMax (forall q. HasSymbol q => q -> Symbol
eqSymb DefinedQuantityDict
aspectRatio)) Space
Real forall a. Maybe a
Nothing

-----------------
-- Constraints --
-----------------

constrained :: [ConstrConcept]
constrained :: [ConstrConcept]
constrained = forall a b. (a -> b) -> [a] -> [b]
map forall c.
(Quantity c, Concept c, Constrained c, HasReasVal c,
 MayHaveUnit c) =>
c -> ConstrConcept
cnstrw' [UncertQ]
inputConstraints forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c.
(Quantity c, Concept c, Constrained c, HasReasVal c,
 MayHaveUnit c) =>
c -> ConstrConcept
cnstrw' [ConstrConcept]
outputs

-- Input Constraints
inputs :: [QuantityDict]
inputs :: [QuantityDict]
inputs = forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [UncertQ]
inputConstraints forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [UncertainChunk
absTol, UncertainChunk
relTol]

inputConstraints :: [UncertQ]
inputConstraints :: [UncertQ]
inputConstraints = [UncertQ
tankLength, UncertQ
diam, UncertQ
pcmVol, UncertQ
pcmSA, UncertQ
pcmDensity,
  UncertQ
tempMeltP, UncertQ
htCapSP, UncertQ
htCapLP, UncertQ
htFusion, UncertQ
coilSA, UncertQ
tempC,
  UncertQ
wDensity, UncertQ
htCapW, UncertQ
coilHTC, UncertQ
pcmHTC, UncertQ
tempInit, UncertQ
timeStep, UncertQ
timeFinal]

tankLength, diam, pcmVol, pcmSA, pcmDensity, tempMeltP,
  htCapSP, htCapLP, htFusion, coilSA, tempC, wDensity,
  htCapW, coilHTC, pcmHTC, tempInit, timeStep, timeFinal :: UncertQ

tempPCM, tempW, watE, pcmE :: ConstrConcept

-- Constraint 1
tankLength :: UncertQ
tankLength = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"tankLength" (String -> NP
nounPhraseSP String
"length of tank")
  String
"the length of the tank" Symbol
cL UnitDefn
metre Space
Real
  [ConstraintE
gtZeroConstr,
  RealInterval Expr Expr -> ConstraintE
sfwrc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Inc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
tankLengthMin) (Inclusive
Inc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
tankLengthMax)] (forall r. LiteralC r => Double -> r
dbl Double
1.5)
  Uncertainty
defaultUncrt

-- Constraint 2
diam :: UncertQ
diam = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"diam" (String -> NP
nounPhraseSP String
"diameter of tank")
  String
"the diameter of the tank" Symbol
cD UnitDefn
metre Space
Real
  [ConstraintE
gtZeroConstr, RealInterval Expr Expr -> ConstraintE
sfwrc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Inc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
arMin) (Inclusive
Inc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
arMax)]
  (forall r. LiteralC r => Double -> r
dbl Double
0.412) Uncertainty
defaultUncrt

-- Constraint 3
pcmVol :: UncertQ
pcmVol = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"pcmVol" (String -> NP
nounPhraseSP String
"volume of PCM")
  String
"the amount of space occupied by a given quantity of phase change material"
  (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
vol) Symbol
lPCM) UnitDefn
m_3 Space
Real
  [RealInterval Expr Expr -> ConstraintE
physc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
tankVol),
   RealInterval Expr Expr -> ConstraintE
sfwrc forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Inc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
fracMin forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
tankVol)] 
  (forall r. LiteralC r => Double -> r
dbl Double
0.05) Uncertainty
defaultUncrt
  -- needs to add (D,L)*minfract to end of last constraint

-- Constraint 4
-- Capitalization Issue here too.
pcmSA :: UncertQ
pcmSA = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"pcmSA"
  (forall a b. (NounPhrase a, NounPhrase b) => a -> b -> NP
compoundPhrase (Sentence
-> Sentence -> CapitalizationRule -> CapitalizationRule -> NP
nounPhrase'' (String -> Sentence
S String
"phase change material")
  (String -> Sentence
S String
"phase change material")
  CapitalizationRule
CapFirst CapitalizationRule
CapWords) (Sentence
-> Sentence -> CapitalizationRule -> CapitalizationRule -> NP
nounPhrase'' (forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
surArea) (forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
surArea)
  CapitalizationRule
CapFirst CapitalizationRule
CapWords))
  String
"area covered by the outermost layer of the phase change material"
  (Symbol -> Symbol -> Symbol
sub Symbol
cA Symbol
lPCM) UnitDefn
m_2 Space
Real
  [ConstraintE
gtZeroConstr,
  RealInterval Expr Expr -> ConstraintE
sfwrc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Inc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
pcmVol) (Inclusive
Inc, (forall r. LiteralC r => Integer -> r
exactDbl Integer
2 forall r. ExprC r => r -> r -> r
$/ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
thickness) forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
tankVol)]
  (forall r. LiteralC r => Double -> r
dbl Double
1.2) Uncertainty
defaultUncrt

-- Constraint 5
pcmDensity :: UncertQ
pcmDensity = forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
uq (forall u.
IsUnit u =>
String
-> NP
-> String
-> (Stage -> Symbol)
-> u
-> Space
-> [ConstraintE]
-> Expr
-> ConstrConcept
cuc'' String
"pcmDensity" (String -> NP
nounPhraseSP String
"density of PCM")
  String
"Mass per unit volume of the phase change material"
  (Symbol -> Stage -> Symbol
autoStage forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
density) Symbol
lPCM) UnitDefn
densityU Space
Real
  [ConstraintE
gtZeroConstr, RealInterval Expr Expr -> ConstraintE
sfwrc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
pcmDensityMin) (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
pcmDensityMax)]
  (forall r. LiteralC r => Integer -> r
exactDbl Integer
1007)) Uncertainty
defaultUncrt

-- Constraint 6
tempMeltP :: UncertQ
tempMeltP = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"tempMeltP"
  (String -> NP
nounPhraseSP String
"melting point temperature for PCM")
  String
"temperature at which the phase change material transitions from a solid to a liquid"
  (Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
temp) Symbol
lMelt) Symbol
lPCM) UnitDefn
centigrade Space
Real
  [RealInterval Expr Expr -> ConstraintE
physc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempC)] (forall r. LiteralC r => Double -> r
dbl Double
44.2) Uncertainty
defaultUncrt

-- Constraint 7
htCapSP :: UncertQ
htCapSP = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"htCapSP"
  (String -> NP
nounPhraseSP String
"specific heat capacity of PCM as a solid")
  (String
"the amount of energy required to raise the temperature of a " forall a. [a] -> [a] -> [a]
++
  String
"given unit mass of solid phase change material by a given amount")
  (Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
heatCapSpec) Symbol
lPCM) Symbol
lSolid) UnitDefn
UT.heatCapSpec Space
Real
  [ConstraintE
gtZeroConstr,
  RealInterval Expr Expr -> ConstraintE
sfwrc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
htCapSPMin) (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
htCapSPMax)]
  (forall r. LiteralC r => Integer -> r
exactDbl Integer
1760) Uncertainty
defaultUncrt

-- Constraint 8
htCapLP :: UncertQ
htCapLP = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"htCapLP"
  (String -> NP
nounPhraseSP String
"specific heat capacity of PCM as a liquid")
  (String
"the amount of energy required to raise the temperature of a " forall a. [a] -> [a] -> [a]
++
  String
"given unit mass of liquid phase change material by a given amount")
  (Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
heatCapSpec) Symbol
lPCM) Symbol
lLiquid) UnitDefn
UT.heatCapSpec Space
Real
  [ConstraintE
gtZeroConstr,
  RealInterval Expr Expr -> ConstraintE
sfwrc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
htCapLPMin) (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
htCapLPMax )]
  (forall r. LiteralC r => Integer -> r
exactDbl Integer
2270) Uncertainty
defaultUncrt

--Constraint 9
htFusion :: UncertQ
htFusion = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"htFusion" (String -> NP
nounPhraseSP String
"specific latent heat of fusion")
  String
"amount of thermal energy required to completely melt a unit mass of a substance"
  (Symbol -> Symbol -> Symbol
sub Symbol
cH Symbol
lFusion) UnitDefn
specificE Space
Real
  [ConstraintE
gtZeroConstr,
  RealInterval Expr Expr -> ConstraintE
sfwrc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
htFusionMin) (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
htFusionMax)] (forall r. LiteralC r => Integer -> r
exactDbl Integer
211600) Uncertainty
defaultUncrt

-- Constraint 10
-- The "S "heating coil" " should be replaced by "phrase coil",
-- Since the capitalization issue, they are replaced by S so far.
coilSA :: UncertQ
coilSA = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"coilSA"
  (forall a b. (NounPhrase a, NounPhrase b) => a -> b -> NP
compoundPhrase (Sentence
-> Sentence -> CapitalizationRule -> CapitalizationRule -> NP
nounPhrase'' (String -> Sentence
S String
"heating coil") (String -> Sentence
S String
"heating coil") CapitalizationRule
CapFirst CapitalizationRule
CapWords)
  (Sentence
-> Sentence -> CapitalizationRule -> CapitalizationRule -> NP
nounPhrase'' (forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
surArea) (forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
surArea) CapitalizationRule
CapFirst CapitalizationRule
CapWords))
  String
"area covered by the outermost layer of the coil" (Symbol -> Symbol -> Symbol
sub Symbol
cA Symbol
lCoil) UnitDefn
m_2 Space
Real
  [ConstraintE
gtZeroConstr,
  RealInterval Expr Expr -> ConstraintE
sfwrc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> RealInterval a b
UpTo (Inclusive
Inc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
coilSAMax)] (forall r. LiteralC r => Double -> r
dbl Double
0.12) Uncertainty
defaultUncrt

-- Constraint 11
tempC :: UncertQ
tempC = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"tempC" (String -> NP
nounPhraseSP String
"temperature of the heating coil")
  String
"the average kinetic energy of the particles within the coil"
  (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
temp) Symbol
lCoil) UnitDefn
centigrade Space
Real
  [RealInterval Expr Expr -> ConstraintE
physc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
100)] (forall r. LiteralC r => Integer -> r
exactDbl Integer
50) Uncertainty
defaultUncrt

-- Constraint 12
wDensity :: UncertQ
wDensity = forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
uq (forall u.
IsUnit u =>
String
-> NP
-> String
-> (Stage -> Symbol)
-> u
-> Space
-> [ConstraintE]
-> Expr
-> ConstrConcept
cuc'' String
"wDensity" (UnitalChunk
density forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` ConceptChunk
water)
  String
"mass per unit volume of water" (Symbol -> Stage -> Symbol
autoStage forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
density) Symbol
lWater) UnitDefn
densityU Space
Real
  [ConstraintE
gtZeroConstr, RealInterval Expr Expr -> ConstraintE
sfwrc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
wDensityMin) (Inclusive
Inc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
wDensityMax)]
  (forall r. LiteralC r => Integer -> r
exactDbl Integer
1000)) Uncertainty
defaultUncrt

-- Constraint 13
htCapW :: UncertQ
htCapW = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"htCapW" (UnitalChunk
heatCapSpec forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` ConceptChunk
water)
  (String
"the amount of energy required to raise the " forall a. [a] -> [a] -> [a]
++
   String
"temperature of a given unit mass of water by a given amount")
  (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
heatCapSpec) Symbol
lWater) UnitDefn
UT.heatCapSpec Space
Real
  [ConstraintE
gtZeroConstr,
  RealInterval Expr Expr -> ConstraintE
sfwrc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
htCapWMin) (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
htCapWMax)] (forall r. LiteralC r => Integer -> r
exactDbl Integer
4186) Uncertainty
defaultUncrt
  
-- Constraint 14
coilHTC :: UncertQ
coilHTC = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"coilHTC" (String -> NP
nounPhraseSP
  String
"convective heat transfer coefficient between coil and water")
  (String
"the convective heat transfer coefficient that models " forall a. [a] -> [a] -> [a]
++
  String
"the thermal flux from the coil to the surrounding water")
  (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
htTransCoeff) Symbol
lCoil)
  UnitDefn
UT.heatTransferCoef Space
Real
  [ConstraintE
gtZeroConstr,
  RealInterval Expr Expr -> ConstraintE
sfwrc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Inc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
coilHTCMin) (Inclusive
Inc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
coilHTCMax)] (forall r. LiteralC r => Integer -> r
exactDbl Integer
1000) Uncertainty
defaultUncrt

-- Constraint 15
pcmHTC :: UncertQ
pcmHTC = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"pcmHTC"
  (String -> NP
nounPhraseSP String
"convective heat transfer coefficient between PCM and water")
  (String
"the convective heat transfer coefficient that models " forall a. [a] -> [a] -> [a]
++
   String
"the thermal flux from the phase change material to the surrounding water")
  (Symbol -> Symbol -> Symbol
sub Symbol
lH Symbol
lPCM) UnitDefn
UT.heatTransferCoef Space
Real
  [ConstraintE
gtZeroConstr,
  RealInterval Expr Expr -> ConstraintE
sfwrc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Inc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
pcmHTCMin) (Inclusive
Inc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
pcmHTCMax)] (forall r. LiteralC r => Integer -> r
exactDbl Integer
1000) Uncertainty
defaultUncrt
  
-- Constraint 16
tempInit :: UncertQ
tempInit = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"tempInit" (String -> NP
nounPhraseSP String
"initial temperature")
  String
"the temperature at the beginning of the simulation"
  (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
temp) Symbol
lInit) UnitDefn
centigrade Space
Real
  [RealInterval Expr Expr -> ConstraintE
physc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
meltPt)] (forall r. LiteralC r => Integer -> r
exactDbl Integer
40) Uncertainty
defaultUncrt
  
-- Constraint 17
timeFinal :: UncertQ
timeFinal = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"timeFinal" (String -> NP
nounPhraseSP String
"final time")
  (String
"the amount of time elapsed from the beginning of the " forall a. [a] -> [a] -> [a]
++
   String
"simulation to its conclusion") (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
time) 
  Symbol
lFinal) UnitDefn
second Space
Real
  [ConstraintE
gtZeroConstr,
  RealInterval Expr Expr -> ConstraintE
sfwrc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> RealInterval a b
UpTo (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
timeFinalMax)] (forall r. LiteralC r => Integer -> r
exactDbl Integer
50000) Uncertainty
defaultUncrt

timeStep :: UncertQ
timeStep = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"timeStep" (String -> NP
nounPhraseSP String
"time step for simulation")
  (String
"the finite discretization of time used in the numerical method " forall a. [a] -> [a] -> [a]
++
   String
"for solving the computational model")
  (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
time) Symbol
lStep) UnitDefn
second Space
Real
  [RealInterval Expr Expr -> ConstraintE
physc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
timeFinal)]
  (forall r. LiteralC r => Double -> r
dbl Double
0.01) Uncertainty
defaultUncrt
  
-- Output Constraints
outputs :: [ConstrConcept]
--FIXME: Add typical values or use Nothing if not known
outputs :: [ConstrConcept]
outputs = [ConstrConcept
tempW, ConstrConcept
tempPCM, ConstrConcept
watE, ConstrConcept
pcmE]

-- Constraint 18
tempW :: ConstrConcept
tempW = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> ConstrConcept
cuc' String
"tempW"
  (String -> NP
nounPhraseSP String
"temperature of the water")
  String
"the average kinetic energy of the particles within the water" 
  (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
temp) Symbol
lWater) UnitDefn
centigrade (Space -> Space
Vect Space
Real)
  [RealInterval Expr Expr -> ConstraintE
physc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Inc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempInit) (Inclusive
Inc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempC)] (forall r. LiteralC r => Integer -> r
exactDbl Integer
0)

-- Constraint 19
tempPCM :: ConstrConcept
tempPCM = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> ConstrConcept
cuc' String
"tempPCM"
  (String -> NP
nounPhraseSP String
"temperature of the phase change material")
  String
"the average kinetic energy of the particles within the phase change material"
  (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
temp) Symbol
lPCM) UnitDefn
centigrade Space
Real
  [RealInterval Expr Expr -> ConstraintE
physc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Inc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempInit) (Inclusive
Inc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempC)] (forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  
-- Constraint 20
watE :: ConstrConcept
watE = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> ConstrConcept
cuc' String
"watE" (String -> NP
nounPhraseSP String
"change in heat energy in the water")
  String
"change in thermal energy within the water" 
  (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
sensHeat) Symbol
lWater) UnitDefn
joule Space
Real
  [RealInterval Expr Expr -> ConstraintE
physc forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Inc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)] (forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  
-- Constraint 21
pcmE :: ConstrConcept
pcmE = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> ConstrConcept
cuc' String
"pcmE" (String -> NP
nounPhraseSP String
"change in heat energy in the PCM")
  String
"change in thermal energy within the phase change material" 
  (Symbol -> Symbol -> Symbol
sub (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
sensHeat) Symbol
lPCM) UnitDefn
joule Space
Real
  [RealInterval Expr Expr -> ConstraintE
physc forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Inc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)] (forall r. LiteralC r => Integer -> r
exactDbl Integer
0)

---------------------------------
-- Uncertainties with no Units --
---------------------------------

absTol, relTol :: UncertainChunk

absTol :: UncertainChunk
absTol = String
-> NP
-> Symbol
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertainChunk
uvc String
"absTol" (String -> NP
nounPhraseSP String
"absolute tolerance") 
  (Symbol -> Symbol -> Symbol
sub Symbol
cA Symbol
lTol) Space
Real
  [RealInterval Expr Expr -> ConstraintE
physc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
1)] 
   (forall r. LiteralC r => Double -> r
dbl (Double
10.0forall a. Floating a => a -> a -> a
**(-Double
10))) (Double -> Maybe Int -> Uncertainty
uncty Double
0.01 forall a. Maybe a
Nothing)

relTol :: UncertainChunk
relTol = String
-> NP
-> Symbol
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertainChunk
uvc String
"relTol" (String -> NP
nounPhraseSP String
"relative tolerance") 
  (Symbol -> Symbol -> Symbol
sub Symbol
cR Symbol
lTol) Space
Real
  [RealInterval Expr Expr -> ConstraintE
physc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
1)] 
  (forall r. LiteralC r => Double -> r
dbl (Double
10.0forall a. Floating a => a -> a -> a
**(-Double
10))) (Double -> Maybe Int -> Uncertainty
uncty Double
0.01 forall a. Maybe a
Nothing)

-------------------------
-- Max / Min Variables --
-------------------------

specParamValList :: [ConstQDef]
specParamValList :: [ConstQDef]
specParamValList = [ConstQDef
tankLengthMin, ConstQDef
tankLengthMax, ConstQDef
pcmDensityMin, ConstQDef
pcmDensityMax,
  ConstQDef
wDensityMin, ConstQDef
wDensityMax, ConstQDef
htCapSPMin, ConstQDef
htCapSPMax, ConstQDef
htCapLPMin, ConstQDef
htCapLPMax,
  ConstQDef
htFusionMin, ConstQDef
htFusionMax, ConstQDef
coilSAMax, ConstQDef
htCapWMin, ConstQDef
htCapWMax, ConstQDef
coilHTCMin,
  ConstQDef
coilHTCMax, ConstQDef
pcmHTCMin, ConstQDef
pcmHTCMax, ConstQDef
timeFinalMax, ConstQDef
fracMinAux, ConstQDef
consTolAux,
  ConstQDef
arMin, ConstQDef
arMax]

tankLengthMin, tankLengthMax, pcmDensityMin, 
  pcmDensityMax, wDensityMin, wDensityMax, htCapSPMin, htCapSPMax, htCapLPMin,
  htCapLPMax, htFusionMin, htFusionMax, coilSAMax, htCapWMin, htCapWMax,
  coilHTCMin, coilHTCMax, pcmHTCMin, pcmHTCMax, timeFinalMax, fracMinAux,
  consTolAux, arMin, arMax :: ConstQDef

consTolAux :: ConstQDef
consTolAux = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef DefinedQuantityDict
consTol forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> Integer -> r
perc Integer
1 Integer
5

-- Used in Constraint 1
tankLengthMin :: ConstQDef
tankLengthMin = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> Symbol -> u -> Space -> UnitaryChunk
unitary String
"tankLengthMin"
  (String -> NP
nounPhraseSP String
"minimum length of tank")
  (Symbol -> Symbol
subMin (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
tankLength)) UnitDefn
metre Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Double -> r
dbl Double
0.1

tankLengthMax :: ConstQDef
tankLengthMax = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> Symbol -> u -> Space -> UnitaryChunk
unitary String
"tankLengthMax"
  (String -> NP
nounPhraseSP String
"maximum length of tank")
  (Symbol -> Symbol
subMax (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
tankLength)) UnitDefn
metre Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
50

fracMinAux :: ConstQDef
fracMinAux = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef DefinedQuantityDict
fracMin forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Double -> r
dbl Double
1.0e-6

arMin :: ConstQDef
arMin = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef DefinedQuantityDict
aspectRatioMin forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Double -> r
dbl Double
0.01
arMax :: ConstQDef
arMax = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef DefinedQuantityDict
aspectRatioMax forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
100

-- Used in Constraint 5
pcmDensityMin :: ConstQDef
pcmDensityMin = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> (Stage -> Symbol) -> u -> Space -> UnitaryChunk
unitary' String
"pcmDensityMin"
  (String -> NP
nounPhraseSP String
"minimum density of PCM") (Symbol -> Symbol -> Stage -> Symbol
staged (Symbol -> Symbol
supMin (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
pcmDensity)) 
  (Symbol -> Symbol
subMin (Symbol -> Symbol
unicodeConv forall a b. (a -> b) -> a -> b
$ forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
pcmDensity))) UnitDefn
densityU Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
500

pcmDensityMax :: ConstQDef
pcmDensityMax = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> (Stage -> Symbol) -> u -> Space -> UnitaryChunk
unitary' String
"pcmDensityMax"
  (String -> NP
nounPhraseSP String
"maximum density of PCM") (Symbol -> Symbol -> Stage -> Symbol
staged (Symbol -> Symbol
supMax (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
pcmDensity)) 
  (Symbol -> Symbol
subMax (Symbol -> Symbol
unicodeConv forall a b. (a -> b) -> a -> b
$ forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
pcmDensity))) UnitDefn
densityU Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
20000

-- Used in Constraint 7
htCapSPMin :: ConstQDef
htCapSPMin = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> Symbol -> u -> Space -> UnitaryChunk
unitary String
"htCapSPMin"
  (String -> NP
nounPhraseSP String
"minimum specific heat capacity of PCM as a solid")
  (Symbol -> Symbol
subMin (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
htCapSP)) UnitDefn
UT.heatCapSpec Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
100

htCapSPMax :: ConstQDef
htCapSPMax = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> Symbol -> u -> Space -> UnitaryChunk
unitary String
"htCapSPMax"
  (String -> NP
nounPhraseSP String
"maximum specific heat capacity of PCM as a solid")
  (Symbol -> Symbol
subMax (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
htCapSP)) UnitDefn
UT.heatCapSpec Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
4000

-- Used in Constraint 8
htCapLPMin :: ConstQDef
htCapLPMin = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> Symbol -> u -> Space -> UnitaryChunk
unitary String
"htCapLPMin"
  (String -> NP
nounPhraseSP String
"minimum specific heat capacity of PCM as a liquid")
  (Symbol -> Symbol
subMin (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
htCapLP)) UnitDefn
UT.heatCapSpec Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
100

htCapLPMax :: ConstQDef
htCapLPMax = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> Symbol -> u -> Space -> UnitaryChunk
unitary String
"htCapLPMax"
  (String -> NP
nounPhraseSP String
"maximum specific heat capacity of PCM as a liquid")
  (Symbol -> Symbol
subMax (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
htCapLP)) UnitDefn
UT.heatCapSpec Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
5000

-- Used in Constraint 9
htFusionMin :: ConstQDef
htFusionMin = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> Symbol -> u -> Space -> UnitaryChunk
unitary String
"htFusionMin"
  (String -> NP
nounPhraseSP String
"minimum specific latent heat of fusion")
  (Symbol -> Symbol
subMin (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
htFusion)) UnitDefn
UT.heatCapSpec Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
0 

htFusionMax :: ConstQDef
htFusionMax = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> Symbol -> u -> Space -> UnitaryChunk
unitary String
"htFusionMax"
  (String -> NP
nounPhraseSP String
"maximum specific latent heat of fusion")
  (Symbol -> Symbol
subMax (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
htFusion)) UnitDefn
UT.heatCapSpec Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
1000000 

-- Used in Constraint 10
coilSAMax :: ConstQDef
coilSAMax = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> (Stage -> Symbol) -> u -> Space -> UnitaryChunk
unitary' String
"coilSAMax"
  (String -> NP
nounPhraseSP String
"maximum surface area of coil") (Symbol -> Symbol -> Stage -> Symbol
staged (Symbol -> Symbol
supMax (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
coilSA))
  (Symbol -> Symbol
subMax (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
coilSA))) UnitDefn
m_2 Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
100000

-- Used in Constraint 12
wDensityMin :: ConstQDef
wDensityMin = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> (Stage -> Symbol) -> u -> Space -> UnitaryChunk
unitary' String
"wDensityMin"
  (String -> NP
nounPhraseSP String
"minimum density of water") (Symbol -> Symbol -> Stage -> Symbol
staged (Symbol -> Symbol
supMin (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
wDensity)) 
  (Symbol -> Symbol
subMin (Symbol -> Symbol
unicodeConv forall a b. (a -> b) -> a -> b
$ forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
wDensity))) UnitDefn
densityU Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
950

wDensityMax :: ConstQDef
wDensityMax = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> (Stage -> Symbol) -> u -> Space -> UnitaryChunk
unitary' String
"wDensityMax"
  (String -> NP
nounPhraseSP String
"maximum density of water") (Symbol -> Symbol -> Stage -> Symbol
staged (Symbol -> Symbol
supMax (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
wDensity)) 
  (Symbol -> Symbol
subMax (Symbol -> Symbol
unicodeConv forall a b. (a -> b) -> a -> b
$ forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
wDensity))) UnitDefn
densityU Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
1000
  
-- Used in Constraint 13
htCapWMin :: ConstQDef
htCapWMin = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> (Stage -> Symbol) -> u -> Space -> UnitaryChunk
unitary' String
"htCapWMin"
  (String -> NP
nounPhraseSP String
"minimum specific heat capacity of water")
  (Symbol -> Symbol -> Stage -> Symbol
staged (Symbol -> Symbol
supMin (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
htCapW)) (Symbol -> Symbol
subMin (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
htCapW))) UnitDefn
UT.heatCapSpec 
  Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
4170

htCapWMax :: ConstQDef
htCapWMax = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> (Stage -> Symbol) -> u -> Space -> UnitaryChunk
unitary' String
"htCapWMax"
  (String -> NP
nounPhraseSP String
"maximum specific heat capacity of water")
  (Symbol -> Symbol -> Stage -> Symbol
staged (Symbol -> Symbol
supMax (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
htCapW)) (Symbol -> Symbol
subMax (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
htCapW))) UnitDefn
UT.heatCapSpec 
  Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
4210

-- Used in Constraint 14
coilHTCMin :: ConstQDef
coilHTCMin = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> (Stage -> Symbol) -> u -> Space -> UnitaryChunk
unitary' String
"coilHTCMin"
  (String -> NP
nounPhraseSP forall a b. (a -> b) -> a -> b
$ String
"minimum convective heat " forall a. [a] -> [a] -> [a]
++
  String
"transfer coefficient between coil and water")
  (Symbol -> Symbol -> Stage -> Symbol
staged (Symbol -> Symbol
supMin (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
coilHTC)) (Symbol -> Symbol
subMin (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
coilHTC))) 
  UnitDefn
UT.heatTransferCoef Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
10

coilHTCMax :: ConstQDef
coilHTCMax = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> (Stage -> Symbol) -> u -> Space -> UnitaryChunk
unitary' String
"coilHTCMax"
  (String -> NP
nounPhraseSP forall a b. (a -> b) -> a -> b
$ String
"maximum convective heat " forall a. [a] -> [a] -> [a]
++
  String
"transfer coefficient between coil and water")
  (Symbol -> Symbol -> Stage -> Symbol
staged (Symbol -> Symbol
supMax (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
coilHTC)) (Symbol -> Symbol
subMax (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
coilHTC))) 
  UnitDefn
UT.heatTransferCoef Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
10000
  
-- Used in Constraint 15
pcmHTCMin :: ConstQDef
pcmHTCMin = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> (Stage -> Symbol) -> u -> Space -> UnitaryChunk
unitary' String
"pcmHTCMin"
  (String -> NP
nounPhraseSP forall a b. (a -> b) -> a -> b
$ String
"minimum convective heat " forall a. [a] -> [a] -> [a]
++
  String
"transfer coefficient between PCM and water")
  (Symbol -> Symbol -> Stage -> Symbol
staged (Symbol -> Symbol
supMin (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
pcmHTC)) (Symbol -> Symbol
subMin (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
pcmHTC))) 
  UnitDefn
UT.heatTransferCoef Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
10

pcmHTCMax :: ConstQDef
pcmHTCMax = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> (Stage -> Symbol) -> u -> Space -> UnitaryChunk
unitary' String
"pcmHTCMax"
  (String -> NP
nounPhraseSP forall a b. (a -> b) -> a -> b
$ String
"maximum convective heat " forall a. [a] -> [a] -> [a]
++
  String
"transfer coefficient between PCM and water")
  (Symbol -> Symbol -> Stage -> Symbol
staged (Symbol -> Symbol
supMax (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
pcmHTC)) (Symbol -> Symbol
subMax (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
pcmHTC))) 
  UnitDefn
UT.heatTransferCoef Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
10000
  
-- Used in Constraint 17
timeFinalMax :: ConstQDef
timeFinalMax = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef (forall u.
IsUnit u =>
String -> NP -> (Stage -> Symbol) -> u -> Space -> UnitaryChunk
unitary' String
"timeFinalMax"
  (String -> NP
nounPhraseSP String
"maximum final time")
  (Symbol -> Symbol -> Stage -> Symbol
staged (Symbol -> Symbol
supMax (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
timeFinal)) (Symbol -> Symbol
subMax (forall q. HasSymbol q => q -> Symbol
eqSymb UncertQ
timeFinal))) UnitDefn
second 
  Space
Real) forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> r
exactDbl Integer
86400

-- Labels
lCoil, lEnv, lFinal, lFusion, lIn, lInit, lLiquid, lMelt, lOut, lPCM, lSolid,
  lStep, lTank, lTol, lVapour, lWater :: Symbol
lCoil :: Symbol
lCoil   = String -> Symbol
label String
"C"
lEnv :: Symbol
lEnv    = String -> Symbol
label String
"env"
lFinal :: Symbol
lFinal  = String -> Symbol
label String
"final"
lFusion :: Symbol
lFusion = String -> Symbol
label String
"f"
lIn :: Symbol
lIn     = String -> Symbol
label String
"in"
lInit :: Symbol
lInit   = String -> Symbol
label String
"init"
lLiquid :: Symbol
lLiquid = String -> Symbol
label String
"L"
lMelt :: Symbol
lMelt   = String -> Symbol
label String
"melt"
lOut :: Symbol
lOut    = String -> Symbol
label String
"out"
lPCM :: Symbol
lPCM    = String -> Symbol
label String
"P"
lSolid :: Symbol
lSolid  = String -> Symbol
label String
"S"
lStep :: Symbol
lStep   = String -> Symbol
label String
"step"
lTank :: Symbol
lTank   = String -> Symbol
label String
"tank"
lTol :: Symbol
lTol    = String -> Symbol
label String
"tol"
lVapour :: Symbol
lVapour = String -> Symbol
label String
"V"
lWater :: Symbol
lWater  = String -> Symbol
label String
"W"