{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE GADTs #-}
module Numeric.LAPACK.Matrix.Hermitian.Eigen (
   values,
   decompose,
   ) where

import qualified Numeric.LAPACK.Matrix.Layout.Private as Layout
import qualified Numeric.LAPACK.Scalar as Scalar
import qualified Numeric.LAPACK.Shape as ExtShape
import Numeric.LAPACK.Matrix.Hermitian.Basic (Hermitian, HermitianP)
import Numeric.LAPACK.Matrix.Square.Basic (Square)
import Numeric.LAPACK.Matrix.Layout.Private (Order(ColumnMajor), uploFromOrder)
import Numeric.BLAS.Matrix.Modifier (conjugatedOnRowMajor)
import Numeric.LAPACK.Vector (Vector)
import Numeric.LAPACK.Scalar (RealOf)
import Numeric.LAPACK.Private
         (copyToTemp, copyCondConjugate, copyCondConjugateToTemp,
          withAutoWorkspaceInfo, withInfo, eigenMsg)

import qualified Numeric.LAPACK.FFI.Complex as LapackComplex
import qualified Numeric.LAPACK.FFI.Real as LapackReal
import qualified Numeric.Netlib.Utility as Call
import qualified Numeric.Netlib.Class as Class

import qualified Data.Array.Comfort.Storable.Unchecked.Monadic as ArrayIO
import qualified Data.Array.Comfort.Storable.Unchecked as Array
import Data.Array.Comfort.Storable.Unchecked (Array(Array))
import Data.Array.Comfort.Shape (triangleSize)

import Foreign.C.Types (CInt, CChar)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Storable (Storable)

import Control.Monad.Trans.Cont (ContT(ContT), evalContT)
import Control.Monad.IO.Class (liftIO)


values ::
   (ExtShape.Permutable sh, Class.Floating a) =>
   HermitianP pack sh a -> Vector sh (RealOf a)
values :: forall sh a pack.
(Permutable sh, Floating a) =>
HermitianP pack sh a -> Vector sh (RealOf a)
values HermitianP pack sh a
a =
   case Mosaic pack ConjugateMirror Upper sh -> PackingSingleton pack
forall pack mirror uplo size.
Mosaic pack mirror uplo size -> PackingSingleton pack
Layout.mosaicPack (Mosaic pack ConjugateMirror Upper sh -> PackingSingleton pack)
-> Mosaic pack ConjugateMirror Upper sh -> PackingSingleton pack
forall a b. (a -> b) -> a -> b
$ HermitianP pack sh a -> Mosaic pack ConjugateMirror Upper sh
forall sh a. Array sh a -> sh
Array.shape HermitianP pack sh a
a of
      PackingSingleton pack
Layout.Packed ->
         case HermitianP pack sh a -> ComplexSingleton a
forall a (f :: * -> *). Floating a => f a -> ComplexSingleton a
Scalar.complexSingletonOfFunctor HermitianP pack sh a
a of
            ComplexSingleton a
Scalar.Real -> Hermitian sh a -> Vector sh a
forall sh a ar.
(Permutable sh, Floating a, RealOf a ~ ar, Storable ar) =>
Hermitian sh a -> Vector sh ar
valuesPacked HermitianP pack sh a
Hermitian sh a
a
            ComplexSingleton a
Scalar.Complex -> Hermitian sh a -> Vector sh a1
forall sh a ar.
(Permutable sh, Floating a, RealOf a ~ ar, Storable ar) =>
Hermitian sh a -> Vector sh ar
valuesPacked HermitianP pack sh a
Hermitian sh a
a
      PackingSingleton pack
Layout.Unpacked ->
         case HermitianP pack sh a -> ComplexSingleton a
forall a (f :: * -> *). Floating a => f a -> ComplexSingleton a
Scalar.complexSingletonOfFunctor HermitianP pack sh a
a of
            ComplexSingleton a
Scalar.Real -> HermitianP Unpacked sh a -> Vector sh a
forall sh a ar.
(Permutable sh, Floating a, RealOf a ~ ar, Storable ar) =>
HermitianP Unpacked sh a -> Vector sh ar
valuesUnpacked HermitianP pack sh a
HermitianP Unpacked sh a
a
            ComplexSingleton a
Scalar.Complex -> HermitianP Unpacked sh a -> Vector sh a1
forall sh a ar.
(Permutable sh, Floating a, RealOf a ~ ar, Storable ar) =>
HermitianP Unpacked sh a -> Vector sh ar
valuesUnpacked HermitianP pack sh a
HermitianP Unpacked sh a
a

valuesPacked ::
   (ExtShape.Permutable sh, Class.Floating a, RealOf a ~ ar, Storable ar) =>
   Hermitian sh a -> Vector sh ar
valuesPacked :: forall sh a ar.
(Permutable sh, Floating a, RealOf a ~ ar, Storable ar) =>
Hermitian sh a -> Vector sh ar
valuesPacked (Array (Layout.Mosaic PackingSingleton Packed
_pack MirrorSingleton ConjugateMirror
_mirror UpLoSingleton Upper
_upper Order
order sh
size) ForeignPtr a
a) =
   sh -> (Int -> Ptr ar -> IO ()) -> Array sh ar
forall sh a.
(C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO ()) -> Array sh a
Array.unsafeCreateWithSize sh
size ((Int -> Ptr ar -> IO ()) -> Array sh ar)
-> (Int -> Ptr ar -> IO ()) -> Array sh ar
forall a b. (a -> b) -> a -> b
$ \Int
n Ptr ar
wPtr ->
   ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> IO ()) -> ContT () IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Ptr CChar
jobzPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char Char
'N'
      Ptr CChar
uploPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char (Char -> FortranIO () (Ptr CChar))
-> Char -> FortranIO () (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Order -> Char
uploFromOrder Order
order
      Ptr a
aPtr <- Int -> ForeignPtr a -> ContT () IO (Ptr a)
forall a r. Storable a => Int -> ForeignPtr a -> ContT r IO (Ptr a)
copyToTemp (Int -> Int
triangleSize Int
n) ForeignPtr a
a
      let zPtr :: Ptr a
zPtr = Ptr a
forall a. Ptr a
nullPtr
      Ptr CInt
ldzPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
n
      IO () -> ContT () IO ()
forall a. IO a -> ContT () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> (Ptr CInt -> IO ()) -> IO ()
withInfo String
eigenMsg String
"hpev" ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
         Ptr CChar
-> Ptr CChar
-> Int
-> Ptr a
-> Ptr (RealOf a)
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CChar
-> Int
-> Ptr a
-> Ptr (RealOf a)
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
hpev Ptr CChar
jobzPtr Ptr CChar
uploPtr Int
n Ptr a
aPtr Ptr ar
Ptr (RealOf a)
wPtr Ptr a
forall a. Ptr a
zPtr Ptr CInt
ldzPtr

valuesUnpacked ::
   (ExtShape.Permutable sh, Class.Floating a, RealOf a ~ ar, Storable ar) =>
   HermitianP Layout.Unpacked sh a -> Vector sh ar
valuesUnpacked :: forall sh a ar.
(Permutable sh, Floating a, RealOf a ~ ar, Storable ar) =>
HermitianP Unpacked sh a -> Vector sh ar
valuesUnpacked (Array (Layout.Mosaic PackingSingleton Unpacked
_pack MirrorSingleton ConjugateMirror
_mirror UpLoSingleton Upper
_upper Order
order sh
size) ForeignPtr a
a) =
   sh -> (Int -> Ptr ar -> IO ()) -> Array sh ar
forall sh a.
(C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO ()) -> Array sh a
Array.unsafeCreateWithSize sh
size ((Int -> Ptr ar -> IO ()) -> Array sh ar)
-> (Int -> Ptr ar -> IO ()) -> Array sh ar
forall a b. (a -> b) -> a -> b
$ \Int
n Ptr ar
wPtr ->
   ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> IO ()) -> ContT () IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Ptr CChar
jobzPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char Char
'N'
      Ptr CChar
uploPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char (Char -> FortranIO () (Ptr CChar))
-> Char -> FortranIO () (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Order -> Char
uploFromOrder Order
order
      Ptr a
aPtr <- Int -> ForeignPtr a -> ContT () IO (Ptr a)
forall a r. Storable a => Int -> ForeignPtr a -> ContT r IO (Ptr a)
copyToTemp (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n) ForeignPtr a
a
      Ptr CInt
ldaPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
n
      IO () -> ContT () IO ()
forall a. IO a -> ContT () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$
         String
-> String -> (Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) -> IO ()
forall a.
Floating a =>
String
-> String -> (Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) -> IO ()
withAutoWorkspaceInfo String
eigenMsg String
"heev" ((Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) -> IO ())
-> (Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr CChar
-> Ptr CChar
-> Int
-> Ptr a
-> Ptr CInt
-> Ptr (RealOf a)
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CChar
-> Int
-> Ptr a
-> Ptr CInt
-> Ptr (RealOf a)
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
heev Ptr CChar
jobzPtr Ptr CChar
uploPtr Int
n Ptr a
aPtr Ptr CInt
ldaPtr Ptr ar
Ptr (RealOf a)
wPtr


decompose ::
   (ExtShape.Permutable sh, Class.Floating a) =>
   HermitianP pack sh a -> (Square sh a, Vector sh (RealOf a))
decompose :: forall sh a pack.
(Permutable sh, Floating a) =>
HermitianP pack sh a -> (Square sh a, Vector sh (RealOf a))
decompose HermitianP pack sh a
a =
   case Mosaic pack ConjugateMirror Upper sh -> PackingSingleton pack
forall pack mirror uplo size.
Mosaic pack mirror uplo size -> PackingSingleton pack
Layout.mosaicPack (Mosaic pack ConjugateMirror Upper sh -> PackingSingleton pack)
-> Mosaic pack ConjugateMirror Upper sh -> PackingSingleton pack
forall a b. (a -> b) -> a -> b
$ HermitianP pack sh a -> Mosaic pack ConjugateMirror Upper sh
forall sh a. Array sh a -> sh
Array.shape HermitianP pack sh a
a of
      PackingSingleton pack
Layout.Packed ->
         case HermitianP pack sh a -> ComplexSingleton a
forall a (f :: * -> *). Floating a => f a -> ComplexSingleton a
Scalar.complexSingletonOfFunctor HermitianP pack sh a
a of
            ComplexSingleton a
Scalar.Real -> Hermitian sh a -> (Square sh a, Vector sh (RealOf a))
forall sh a ar.
(Permutable sh, Floating a, RealOf a ~ ar, Storable ar) =>
Hermitian sh a -> (Square sh a, Vector sh (RealOf a))
decomposePacked HermitianP pack sh a
Hermitian sh a
a
            ComplexSingleton a
Scalar.Complex -> Hermitian sh a -> (Square sh a, Vector sh (RealOf a))
forall sh a ar.
(Permutable sh, Floating a, RealOf a ~ ar, Storable ar) =>
Hermitian sh a -> (Square sh a, Vector sh (RealOf a))
decomposePacked HermitianP pack sh a
Hermitian sh a
a
      PackingSingleton pack
Layout.Unpacked ->
         case HermitianP pack sh a -> ComplexSingleton a
forall a (f :: * -> *). Floating a => f a -> ComplexSingleton a
Scalar.complexSingletonOfFunctor HermitianP pack sh a
a of
            ComplexSingleton a
Scalar.Real -> HermitianP Unpacked sh a -> (Square sh a, Vector sh (RealOf a))
forall sh a ar.
(Permutable sh, Floating a, RealOf a ~ ar, Storable ar) =>
HermitianP Unpacked sh a -> (Square sh a, Vector sh (RealOf a))
decomposeUnpacked HermitianP pack sh a
HermitianP Unpacked sh a
a
            ComplexSingleton a
Scalar.Complex -> HermitianP Unpacked sh a -> (Square sh a, Vector sh (RealOf a))
forall sh a ar.
(Permutable sh, Floating a, RealOf a ~ ar, Storable ar) =>
HermitianP Unpacked sh a -> (Square sh a, Vector sh (RealOf a))
decomposeUnpacked HermitianP pack sh a
HermitianP Unpacked sh a
a

decomposePacked ::
   (ExtShape.Permutable sh, Class.Floating a, RealOf a ~ ar, Storable ar) =>
   Hermitian sh a -> (Square sh a, Vector sh (RealOf a))
decomposePacked :: forall sh a ar.
(Permutable sh, Floating a, RealOf a ~ ar, Storable ar) =>
Hermitian sh a -> (Square sh a, Vector sh (RealOf a))
decomposePacked (Array (Layout.Mosaic PackingSingleton Packed
_pack MirrorSingleton ConjugateMirror
_mirror UpLoSingleton Upper
_upper Order
order sh
size) ForeignPtr a
a) =
   Square sh
-> (Int -> Ptr a -> IO (Vector sh (RealOf a)))
-> (Array (Square sh) a, Vector sh (RealOf a))
forall sh a b.
(C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO b) -> (Array sh a, b)
Array.unsafeCreateWithSizeAndResult (Order -> sh -> Square sh
forall sh. Order -> sh -> Square sh
Layout.square Order
ColumnMajor sh
size) ((Int -> Ptr a -> IO (Vector sh (RealOf a)))
 -> (Array (Square sh) a, Vector sh (RealOf a)))
-> (Int -> Ptr a -> IO (Vector sh (RealOf a)))
-> (Array (Square sh) a, Vector sh (RealOf a))
forall a b. (a -> b) -> a -> b
$
      \Int
_ Ptr a
zPtr ->
   sh -> (Int -> Ptr (RealOf a) -> IO ()) -> IO (Vector sh (RealOf a))
forall (m :: * -> *) sh a.
(PrimMonad m, C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO ()) -> m (Array sh a)
ArrayIO.unsafeCreateWithSize sh
size ((Int -> Ptr (RealOf a) -> IO ()) -> IO (Vector sh (RealOf a)))
-> (Int -> Ptr (RealOf a) -> IO ()) -> IO (Vector sh (RealOf a))
forall a b. (a -> b) -> a -> b
$ \Int
n Ptr (RealOf a)
wPtr ->
   ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> IO ()) -> ContT () IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Ptr CChar
jobzPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char Char
'V'
      Ptr CChar
uploPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char (Char -> FortranIO () (Ptr CChar))
-> Char -> FortranIO () (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Order -> Char
uploFromOrder Order
order
      Ptr a
aPtr <-
         Conjugation -> Int -> ForeignPtr a -> ContT () IO (Ptr a)
forall a r.
Floating a =>
Conjugation -> Int -> ForeignPtr a -> ContT r IO (Ptr a)
copyCondConjugateToTemp (Order -> Conjugation
conjugatedOnRowMajor Order
order) (Int -> Int
triangleSize Int
n) ForeignPtr a
a
      Ptr CInt
ldzPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
n
      IO () -> ContT () IO ()
forall a. IO a -> ContT () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> (Ptr CInt -> IO ()) -> IO ()
withInfo String
eigenMsg String
"hpev" ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
         Ptr CChar
-> Ptr CChar
-> Int
-> Ptr a
-> Ptr (RealOf a)
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CChar
-> Int
-> Ptr a
-> Ptr (RealOf a)
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
hpev Ptr CChar
jobzPtr Ptr CChar
uploPtr Int
n Ptr a
aPtr Ptr (RealOf a)
wPtr Ptr a
zPtr Ptr CInt
ldzPtr

hpev ::
   (Class.Floating a) =>
   Ptr CChar -> Ptr CChar -> Int -> Ptr a -> Ptr (RealOf a) ->
   Ptr a -> Ptr CInt -> Ptr CInt -> IO ()
hpev :: forall a.
Floating a =>
Ptr CChar
-> Ptr CChar
-> Int
-> Ptr a
-> Ptr (RealOf a)
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
hpev Ptr CChar
jobzPtr Ptr CChar
uploPtr Int
n Ptr a
apPtr Ptr (RealOf a)
wPtr Ptr a
zPtr Ptr CInt
ldzPtr Ptr CInt
infoPtr = ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> IO ()) -> ContT () IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
   Ptr CInt
nPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
   case Ptr a -> ComplexSingleton a
forall a (f :: * -> *). Floating a => f a -> ComplexSingleton a
Scalar.complexSingletonOfFunctor Ptr a
apPtr of
      ComplexSingleton a
Scalar.Real -> do
         Ptr a
workPtr <- Int -> FortranIO () (Ptr a)
forall a r. Storable a => Int -> FortranIO r (Ptr a)
Call.allocaArray (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n)
         IO () -> ContT () IO ()
forall a. IO a -> ContT () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> IO ()
forall a.
Real a =>
Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> IO ()
LapackReal.spev Ptr CChar
jobzPtr Ptr CChar
uploPtr
               Ptr CInt
nPtr Ptr a
apPtr Ptr a
Ptr (RealOf a)
wPtr Ptr a
zPtr Ptr CInt
ldzPtr Ptr a
workPtr Ptr CInt
infoPtr
      ComplexSingleton a
Scalar.Complex -> do
         Ptr (Complex a1)
workPtr <- Int -> FortranIO () (Ptr (Complex a1))
forall a r. Storable a => Int -> FortranIO r (Ptr a)
Call.allocaArray (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
         Ptr a1
rworkPtr <- Int -> FortranIO () (Ptr a1)
forall a r. Storable a => Int -> FortranIO r (Ptr a)
Call.allocaArray (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2))
         IO () -> ContT () IO ()
forall a. IO a -> ContT () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr (Complex a1)
-> Ptr a1
-> Ptr (Complex a1)
-> Ptr CInt
-> Ptr (Complex a1)
-> Ptr a1
-> Ptr CInt
-> IO ()
forall a.
Real a =>
Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr a
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr a
-> Ptr CInt
-> IO ()
LapackComplex.hpev Ptr CChar
jobzPtr Ptr CChar
uploPtr
               Ptr CInt
nPtr Ptr a
Ptr (Complex a1)
apPtr Ptr a1
Ptr (RealOf a)
wPtr Ptr a
Ptr (Complex a1)
zPtr Ptr CInt
ldzPtr Ptr (Complex a1)
workPtr Ptr a1
rworkPtr Ptr CInt
infoPtr


decomposeUnpacked ::
   (ExtShape.Permutable sh, Class.Floating a, RealOf a ~ ar, Storable ar) =>
   HermitianP Layout.Unpacked sh a -> (Square sh a, Vector sh (RealOf a))
decomposeUnpacked :: forall sh a ar.
(Permutable sh, Floating a, RealOf a ~ ar, Storable ar) =>
HermitianP Unpacked sh a -> (Square sh a, Vector sh (RealOf a))
decomposeUnpacked
      (Array (Layout.Mosaic PackingSingleton Unpacked
_pack MirrorSingleton ConjugateMirror
_mirror UpLoSingleton Upper
_upper Order
order sh
size) ForeignPtr a
a) =
   Square sh
-> (Int -> Ptr a -> IO (Vector sh (RealOf a)))
-> (Array (Square sh) a, Vector sh (RealOf a))
forall sh a b.
(C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO b) -> (Array sh a, b)
Array.unsafeCreateWithSizeAndResult (Order -> sh -> Square sh
forall sh. Order -> sh -> Square sh
Layout.square Order
ColumnMajor sh
size) ((Int -> Ptr a -> IO (Vector sh (RealOf a)))
 -> (Array (Square sh) a, Vector sh (RealOf a)))
-> (Int -> Ptr a -> IO (Vector sh (RealOf a)))
-> (Array (Square sh) a, Vector sh (RealOf a))
forall a b. (a -> b) -> a -> b
$
      \Int
squareSize Ptr a
vPtr ->
   sh -> (Int -> Ptr (RealOf a) -> IO ()) -> IO (Vector sh (RealOf a))
forall (m :: * -> *) sh a.
(PrimMonad m, C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO ()) -> m (Array sh a)
ArrayIO.unsafeCreateWithSize sh
size ((Int -> Ptr (RealOf a) -> IO ()) -> IO (Vector sh (RealOf a)))
-> (Int -> Ptr (RealOf a) -> IO ()) -> IO (Vector sh (RealOf a))
forall a b. (a -> b) -> a -> b
$ \Int
n Ptr (RealOf a)
wPtr ->
   ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> IO ()) -> ContT () IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Ptr CChar
jobzPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char Char
'V'
      Ptr CChar
uploPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char (Char -> FortranIO () (Ptr CChar))
-> Char -> FortranIO () (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Order -> Char
uploFromOrder Order
order
      Ptr CInt
sizePtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
squareSize
      Ptr a
aPtr <- ((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a))
-> ((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
a
      Ptr CInt
ldaPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
n
      Ptr CInt
incPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
1
      IO () -> ContT () IO ()
forall a. IO a -> ContT () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ do
         Conjugation
-> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
forall a.
Floating a =>
Conjugation
-> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
copyCondConjugate (Order -> Conjugation
conjugatedOnRowMajor Order
order)
            Ptr CInt
sizePtr Ptr a
aPtr Ptr CInt
incPtr Ptr a
vPtr Ptr CInt
incPtr
         String
-> String -> (Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) -> IO ()
forall a.
Floating a =>
String
-> String -> (Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) -> IO ()
withAutoWorkspaceInfo String
eigenMsg String
"heev" ((Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) -> IO ())
-> (Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr CChar
-> Ptr CChar
-> Int
-> Ptr a
-> Ptr CInt
-> Ptr (RealOf a)
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CChar
-> Int
-> Ptr a
-> Ptr CInt
-> Ptr (RealOf a)
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
heev Ptr CChar
jobzPtr Ptr CChar
uploPtr Int
n Ptr a
vPtr Ptr CInt
ldaPtr Ptr (RealOf a)
wPtr

heev ::
   (Class.Floating a) =>
   Ptr CChar -> Ptr CChar -> Int -> Ptr a -> Ptr CInt ->
   Ptr (RealOf a) -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ()
heev :: forall a.
Floating a =>
Ptr CChar
-> Ptr CChar
-> Int
-> Ptr a
-> Ptr CInt
-> Ptr (RealOf a)
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
heev Ptr CChar
jobzPtr Ptr CChar
uploPtr Int
n Ptr a
aPtr Ptr CInt
ldaPtr Ptr (RealOf a)
wPtr Ptr a
workPtr Ptr CInt
lworkPtr Ptr CInt
infoPtr =
      ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> IO ()) -> ContT () IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
   Ptr CInt
nPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
   IO () -> ContT () IO ()
forall a. IO a -> ContT () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ case Ptr a -> ComplexSingleton a
forall a (f :: * -> *). Floating a => f a -> ComplexSingleton a
Scalar.complexSingletonOfFunctor Ptr a
aPtr of
      ComplexSingleton a
Scalar.Real ->
         Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
forall a.
Real a =>
Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
LapackReal.syev Ptr CChar
jobzPtr Ptr CChar
uploPtr Ptr CInt
nPtr Ptr a
aPtr Ptr CInt
ldaPtr Ptr a
Ptr (RealOf a)
wPtr
            Ptr a
workPtr Ptr CInt
lworkPtr Ptr CInt
infoPtr
      ComplexSingleton a
Scalar.Complex -> ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> IO ()) -> ContT () IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
         Ptr a1
rworkPtr <- Int -> FortranIO () (Ptr a1)
forall a r. Storable a => Int -> FortranIO r (Ptr a)
Call.allocaArray (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2))
         IO () -> ContT () IO ()
forall a. IO a -> ContT () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr (Complex a1)
-> Ptr CInt
-> Ptr a1
-> Ptr (Complex a1)
-> Ptr CInt
-> Ptr a1
-> Ptr CInt
-> IO ()
forall a.
Real a =>
Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr a
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> IO ()
LapackComplex.heev Ptr CChar
jobzPtr Ptr CChar
uploPtr Ptr CInt
nPtr Ptr a
Ptr (Complex a1)
aPtr Ptr CInt
ldaPtr Ptr a1
Ptr (RealOf a)
wPtr
               Ptr a
Ptr (Complex a1)
workPtr Ptr CInt
lworkPtr Ptr a1
rworkPtr Ptr CInt
infoPtr