#!../src/tops  -s ../sys  -u ../usr

time seedset

"zggev" missing
IF 
    "tops not compiled with LAPACK; cannot run lapack" . nl
    halt 
THEN

"Running cases from " syspath "lapack.v:" cat cat . nl
   syspath "lapack.v" cat "dgemm: D = A * B + C" msource
   syspath "lapack.v" cat "zgemm: D = A * B + C" msource
   syspath "lapack.v" cat "dgeev: complex eigenanalysis" msource
   syspath "lapack.v" cat "dgeev2: complex eigenanalysis" msource
   syspath "lapack.v" cat "dgesv: 500-by-500 inverse" msource
   syspath "lapack.v" cat "zgesv: 500-by-500 inverse" msource
"lapack.v cases done." . nl

"modes"   missing 
IF 
    "mmath.v" source 
THEN

define: n_zggev_tests ( nIter nSize  --- ) # {{{1
    \ Invokes chk_zggev nIter times for a nSize x nSize sized system.
    into nSize
    1 DO nSize 
        I "%5.0f.  " format .
        chk_zggev 
    LOOP
    ; # 1}}}
define: n_dgetrf_dgetrs_tests ( nIter nSize  --- ) # {{{1
    into nSize
    1 DO nSize 
        I "%5.0f.  " format .
        chk_dgetrf_dgetrs
    LOOP
    ; # 1}}}
define: n_dgetrf_dgetri_tests ( nIter nSize  --- ) # {{{1
    into nSize
    1 DO nSize 
        I "%5.0f.  " format .
        chk_dgetrf_dgetri
    LOOP
    ; # 1}}}
define: chk_zggev ( n --- ) # {{{1
    \ Create two n x n random complex matrices, then computes its complex
    \ eigensolution with the LAPACK zggev routine.  Checks both the
    \ left and right eigenvector solutions.
    \ 
    is Size
    Size Size random Size Size random complex is A
    Size Size random Size Size random complex is B
    A B zggev  ( A B --- Alpha Beta VL VR )
    is VR
    is VL
    is Beta
    is Alpha
    Alpha Beta /by is eigval

    # A*VR - B*VR*diag(eigval)
    A real-imag VR real-imag *c complex                                  
    B real-imag VR real-imag *c eigval real-imag diagpost_complex complex
    -
    abs maxfetch drop drop
    dup
    1.0e-10
    > IF 
        . " VR zggev ERROR " . nl halt 
    ELSE 
        . " VR zggev OK " .
    THEN
    xx

    # VL'*A - diag(eigval)*VL'*B
    VL bend real-imag -1 *f A real-imag *c complex
    eigval real-imag VL bend real-imag -1 *f B real-imag *c diagpre_complex 
    complex
    -
    abs maxfetch drop drop 
    dup
    1.0e-10
    > IF 
        . " VL zggev ERROR " . nl halt 
    ELSE 
        . " VL zggev OK " . nl 
    THEN
    xx

    ; # 1}}}
define: chk_dgetrf_dgetrs ( n --- ) # {{{1
    # Create a random square matrix A and a random right hand side B
    # with the same number of rows as A.  Factor A into LU with dgetrf
    # then do fbs with dgetrs, then compute | A * X - B |
    # 
    is nRows
    nRows nRows random is A
    nRows rand * integer 1 + is nCols
    nRows "%4.0f x " format . nRows "%4.0f \ " format .  nRows "%4.0f x " format . nCols "%4.0f" format .
    nRows nCols random is B
    A dgetrf ( LU P ) B dgetrs ( X ) is X
    A X * B -
    abs maxfetch drop drop
    dup
    1.0e-11
    > IF 
        . " dgetrf/dgetrs ERROR " . nl halt 
    ELSE 
        . " dgetrf/dgetrs OK " . nl
    THEN
    xx
    ; # 1}}}
define: chk_dgetrf_dgetri ( n --- ) # {{{1
    # Create a random square matrix A.  Factor A into LU with dgetrf
    # then find A's inverse with with dgetri, then compute | A * A' - I |
    # 
    is nRows
    nRows nRows random is A
    nRows "%4.0f x " format . nRows "%4.0f inv " format . 
    A dgetrf ( LU P ) dgetri ( A^-1 ) is Ainv
    A Ainv * 
    nRows identity -
    abs maxfetch drop drop
    dup
    1.0e-11
    > IF 
        . " dgetrf/dgetri ERROR " . nl halt 
    ELSE 
        . " dgetrf/dgetri OK " . nl
    THEN
    xx
    ; # 1}}}

# Iter Size
  10    50  n_zggev_tests           nl 
  10    200 n_dgetrf_dgetrs_tests   nl 
  10    200 n_dgetrf_dgetri_tests   nl 
