{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE Safe #-}

{- | 
Module      :  Physics.Learn.Current
Copyright   :  (c) Scott N. Walck 2012-2019
License     :  BSD3 (see LICENSE)
Maintainer  :  Scott N. Walck <walck@lvc.edu>
Stability   :  experimental

This module contains functions for working with current, magnetic field,
and magnetic flux.
-}

module Physics.Learn.Current
    (
    -- * Current
      Current
    , CurrentDistribution(..)
    -- * Magnetic Field
    , bField
    , bFieldFromLineCurrent
    , bFieldFromSurfaceCurrent
    , bFieldFromVolumeCurrent
    -- * Magnetic Flux
    , magneticFlux
    )
    where

import Physics.Learn.CarrotVec
    ( magnitude
    , (*^)
    , (^/)
    , (><)
    )
import Physics.Learn.Position
    ( VectorField
    , displacement
    , addFields
    )
import Physics.Learn.Curve
    ( Curve(..)
    , crossedLineIntegral
    )
import Physics.Learn.Surface
    ( Surface(..)
    , surfaceIntegral
    , dottedSurfaceIntegral
    )
import Physics.Learn.Volume
    ( Volume(..)
    , volumeIntegral
    )

-- | Electric current, in units of Amperes (A)
type Current = Double

-- | A current distribution is a line current (current through a wire), a surface current,
--   a volume current, or a combination of these.
--   The 'VectorField' describes a surface current density
--   or a volume current density.
data CurrentDistribution = LineCurrent Current Curve               -- ^ current through a wire
                         | SurfaceCurrent VectorField Surface      -- ^ 'VectorField' is surface current density (A/m)
                         | VolumeCurrent VectorField Volume        -- ^ 'VectorField' is volume current density (A/m^2)
                         | MultipleCurrents [CurrentDistribution]  -- ^ combination of current distributions

-- | Magnetic field produced by a line current (current through a wire).
--   The function 'bField' calls this function
--   to evaluate the magnetic field produced by a line current.
bFieldFromLineCurrent
    :: Current      -- ^ current (in Amps)
    -> Curve        -- ^ geometry of the line current
    -> VectorField  -- ^ magnetic field (in Tesla)
bFieldFromLineCurrent :: Double -> Curve -> VectorField
bFieldFromLineCurrent Double
i Curve
c Position
r
    = Double
k forall v. VectorSpace v => Scalar v -> v -> v
*^ Int -> VectorField -> Curve -> Vec
crossedLineIntegral Int
1000 VectorField
integrand Curve
c
      where
        k :: Double
k = Double
1e-7  -- mu0 / (4 * pi)
        integrand :: VectorField
integrand Position
r' = (-Double
i) forall v. VectorSpace v => Scalar v -> v -> v
*^ Vec
d forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ forall v s. (InnerSpace v, s ~ Scalar v, Floating s) => v -> s
magnitude Vec
d forall a. Floating a => a -> a -> a
** Double
3
            where
              d :: Vec
d = Position -> VectorField
displacement Position
r' Position
r

-- | Magnetic field produced by a surface current.
--   The function 'bField' calls this function
--   to evaluate the magnetic field produced by a surface current.
--   This function assumes that surface current density
--   will be specified parallel to the surface, and does
--   not check if that is true.
bFieldFromSurfaceCurrent
    :: VectorField  -- ^ surface current density
    -> Surface      -- ^ geometry of the surface current
    -> VectorField  -- ^ magnetic field (in T)
bFieldFromSurfaceCurrent :: VectorField -> Surface -> VectorField
bFieldFromSurfaceCurrent VectorField
kCurrent Surface
c Position
r
    = Double
k forall v. VectorSpace v => Scalar v -> v -> v
*^ forall v.
(VectorSpace v, Scalar v ~ Double) =>
Int -> Int -> Field v -> Surface -> v
surfaceIntegral Int
100 Int
100 VectorField
integrand Surface
c
      where
        k :: Double
k = Double
1e-7  -- mu0 / (4 * pi)
        integrand :: VectorField
integrand Position
r' = (VectorField
kCurrent Position
r' Vec -> Vec -> Vec
>< Vec
d) forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ forall v s. (InnerSpace v, s ~ Scalar v, Floating s) => v -> s
magnitude Vec
d forall a. Floating a => a -> a -> a
** Double
3
            where
              d :: Vec
d = Position -> VectorField
displacement Position
r' Position
r

-- | Magnetic field produced by a volume current.
--   The function 'bField' calls this function
--   to evaluate the magnetic field produced by a volume current.
bFieldFromVolumeCurrent
    :: VectorField  -- ^ volume current density
    -> Volume       -- ^ geometry of the volume current
    -> VectorField  -- ^ magnetic field (in T)
bFieldFromVolumeCurrent :: VectorField -> Volume -> VectorField
bFieldFromVolumeCurrent VectorField
j Volume
c Position
r
    = Double
k forall v. VectorSpace v => Scalar v -> v -> v
*^ forall v.
(VectorSpace v, Scalar v ~ Double) =>
Int -> Int -> Int -> Field v -> Volume -> v
volumeIntegral Int
50 Int
50 Int
50 VectorField
integrand Volume
c
      where
        k :: Double
k = Double
1e-7  -- mu0 / (4 * pi)
        integrand :: VectorField
integrand Position
r' = (VectorField
j Position
r' Vec -> Vec -> Vec
>< Vec
d) forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ forall v s. (InnerSpace v, s ~ Scalar v, Floating s) => v -> s
magnitude Vec
d forall a. Floating a => a -> a -> a
** Double
3
            where
              d :: Vec
d = Position -> VectorField
displacement Position
r' Position
r

-- | The magnetic field produced by a current distribution.
--   This is the simplest way to find the magnetic field, because it
--   works for any current distribution (line, surface, volume, or combination).
bField :: CurrentDistribution -> VectorField
bField :: CurrentDistribution -> VectorField
bField (LineCurrent Double
i Curve
c) = Double -> Curve -> VectorField
bFieldFromLineCurrent Double
i Curve
c
bField (SurfaceCurrent VectorField
kC Surface
s) = VectorField -> Surface -> VectorField
bFieldFromSurfaceCurrent VectorField
kC Surface
s
bField (VolumeCurrent VectorField
j Volume
v) = VectorField -> Volume -> VectorField
bFieldFromVolumeCurrent VectorField
j Volume
v
bField (MultipleCurrents [CurrentDistribution]
cds) = forall v. AdditiveGroup v => [Field v] -> Field v
addFields forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map CurrentDistribution -> VectorField
bField [CurrentDistribution]
cds

-------------------
-- Magnetic Flux --
-------------------

-- | The magnetic flux through a surface produced by a current distribution.
magneticFlux :: Surface -> CurrentDistribution -> Double
magneticFlux :: Surface -> CurrentDistribution -> Double
magneticFlux Surface
surf CurrentDistribution
dist = Int -> Int -> VectorField -> Surface -> Double
dottedSurfaceIntegral Int
100 Int
100 (CurrentDistribution -> VectorField
bField CurrentDistribution
dist) Surface
surf