/*
    -- MAGMA (version 2.6.2) --
       Univ. of Tennessee, Knoxville
       Univ. of California, Berkeley
       Univ. of Colorado, Denver
       @date March 2022

       @author Stan Tomov

       @generated from src/dsidi.cpp, normal d -> s, Mon Mar 21 16:51:14 2022
*/
#include "magma_internal.h"

#ifdef LAPACK_RETURN_DOUBLE
typedef float RETURN_FLOAT;
#else
typedef float  RETURN_FLOAT;
#endif

// -------------------------------------------------------------
#ifdef __cplusplus
extern "C" {
#endif

#define blasf77_sdot     FORTRAN_NAME( sdot,   SDOT   )

RETURN_FLOAT
blasf77_sdot(   const magma_int_t *n,
                const float *x, const magma_int_t *incx,
                const float *y, const magma_int_t *incy );

float
blasf77_sdot(   const magma_int_t *n,
                const float *x, const magma_int_t *incx,
                const float *y, const magma_int_t *incy );

#ifdef __cplusplus
}
#endif
// ------------------------------------------------------------

// To do: add complex version for determinant & inverse, if needed (no intertia)  

/***************************************************************************//**
    Purpose
    -------
    ssidi computes the determinant, inertia and inverse
    of a float precision symmetric matrix using the factors from
    ssytrf.

    Arguments
    ---------
    @param[in]
    uplo    magma_uplo_t
      -     = MagmaUpper:  Upper triangle of A is stored;
      -     = MagmaLower:  Lower triangle of A is stored.

    @param[in,out]
    A       REAL array, dimension (LDA,N)
            On entry, the output from ssytrf.
            On exit, the upper triangle of the inverse of
            the original matrix. The strict lower triangle
            is never referenced.  

    @param[in]
    lda     INTEGER
            The leading dimension of the array A.  LDA >= max(1,N). 

    @param[in]
    n       INTEGER
            The order of the matrix A.  N >= 0.

    @param[in]
    ipiv    INTEGER array, dimension (N) 
            The pivot vector from ssytrf.

    @param[out]
    det     REAL array, dimension (2)
            Determinant of the original matrix:
            Determinant = det(0) * 10^det(1) 
            with 1<=fabsf(det(0))<10 or det(0) = 0.

    @param[out]
    inert   INTEGER array, dimension (3)
            The inertia of the original matrix:
            inert(0)  =  number of positive eigenvalues.
            inert(1)  =  number of negative eigenvalues.
            inert(2)  =  number of zero eigenvalues.

    @param[in]
    work    (workspace) REAL array, dimension (N)
            Work vector.  Contents destroyed.

    @param[in]
    job     INTEGER 
            JOB has the decimal expansion  abc  where
            if  c != 0, the inverse is computed,
            if  b != 0, the determinant is computed,
            if  a != 0, the inertia is computed.

            for example, job = 111  gives all three.

    Further Details 
    ===============
    Error condition: a division by zero may occur if the inverse is requested
    and ssytrf has set info != 0.

    This routine is based on the LINPACK ssidi routine 
    (see also LINPACK USERS' guide, page 5.15).

    @ingroup magma_hetrf
*******************************************************************************/
extern "C" magma_int_t
magma_ssidi(
    magma_uplo_t uplo,
    float *A, magma_int_t lda, magma_int_t n, magma_int_t *ipiv, 
    float *det, magma_int_t *inert, 
    float *work, magma_int_t job,
    magma_int_t *info)
{
    #define  A(i_, j_) ( A + (i_) + (j_)*lda )

    /* .. Local variables .. */
    float akkp1, temp;
    float ten, d, t, ak, akp1;
    magma_int_t j, jb, k, ks, kstep, ione = 1;
    bool noinv, nodet, noert;

    bool upper = (uplo == MagmaUpper);

    /* Test the input parameters. */
    *info = 0;
    if (! upper && uplo != MagmaLower) {
        *info = -1;
    } else if ( lda < 0 ) {
        *info = -3; 
    } else if ( n < 0 ) {
        *info = -4;
    }
    if ( *info != 0 ) {
        magma_xerbla( __func__, -(*info) );
        return *info;
    }   

    noinv = ( (job  %10)      == 0);
    nodet = (((job %100)/ 10) == 0);
    noert = (((job%1000)/100) == 0);

    if (!nodet || !noert) {
        if (!noert) {
            inert[0] = inert[1] = inert[2] = 0;
        }
        if (!nodet) {
            det[0] = 1.0;
            det[1] = 0.0;
            ten = 10.0;
        }

        t = 0.0;
        for(k = 0; k<n; k++) {
            d = *A(k,k);
            
            /* check if 1 by 1 */
            if (ipiv[k]-1 < 0) {
                /* 2 by 2 block
                   use det (d  s)  =  (d/t * c - t) * t  ,  t = fabsf(s)
                           (s  c)
                   to avoid underflow/overflow troubles.
                   take two passes through scaling. Use t for flag. */
                if (t != 0.) {
                    d = t;
                    t = 0.;
                } else {
                    if (upper)
                        t = fabsf(*A(k,k+1));
                    else
                        t = fabsf(*A(k+1,k));
                    d = (d/t)*(*A(k+1,k+1)) - t;
                }
            }

            if (!noert) {
                if (d > 0.) inert[0]++;
                if (d < 0.) inert[1]++;
                if (d ==0.) inert[2]++;
            }
            
            if (!nodet) {
                det[0] *= d;
                if (det[0] != 0.) {
                    while (fabsf(det[0]) < 1.0) {
                        det[0] *= ten;
                        det[1] -= 1.0;
                    }
                    while (fabsf(det[0]) >= ten) {
                        det[0] /= ten;
                        det[1] += 1.0;
                    }
                }
            }
        }
    }
    
    /* compute inverse(a) */
    if (!noinv) {
        k = 0;
        while (k < n) {
            //fprintf(stderr, "k = %4d ipiv = %4d\n", k, ipiv[k]);
            if (ipiv[k]-1 >= 0) {
                /* 1 by 1 */
                *A(k,k) = 1. / *A(k,k);
                if (k > 0) {
                    blasf77_scopy(&k, A(0, k), &ione, work, &ione);
                    for(j = 0; j<k; j++) {
                        const magma_int_t jp1 = j+1;
                        *A(j,k) = blasf77_sdot(&jp1, A(0,j),&ione, work,&ione);
                        blasf77_saxpy(&j, &work[j], A(0,j),&ione, A(0,k),&ione);
                    }
                    *A(k,k) += blasf77_sdot(&k, work,&ione, A(0,k),&ione);
                }
                kstep = 1;
            } else {
                /* 2 by 2 */
                t = fabsf(*A(k,k+1));
                ak = *A(k,k)/t;
                akp1 = *A(k+1,k+1)/t;
                akkp1 = *A(k,k+1)/t;
                d = t*(ak*akp1 - 1.);
                *A(k,k) = akp1/d;
                *A(k+1,k+1) = ak/d;
                *A(k,k+1) = -akkp1/d;
                if (k > 0) {
                    blasf77_scopy(&k, A(0,k+1),&ione, work,&ione);
                    for(j = 0; j<k; j++) {
                        const magma_int_t jp1 = j+1;
                        *A(j,k+1) = blasf77_sdot(&jp1, A(0,j),&ione, work,&ione);
                        blasf77_saxpy(&j, &work[j], A(0,j),&ione, A(0,k+1),&ione);
                    }
                    *A(k+1,k+1) += blasf77_sdot(&k, work,&ione, A(0,k+1),&ione);
                    *A(k  ,k+1) += blasf77_sdot(&k, A(0,k),&ione, A(0,k+1),&ione);
                    blasf77_scopy(&k, A(0,k),&ione, work,&ione);
                    
                    for(j = 0; j<k; j++) {
                        const magma_int_t jp1 = j+1;
                        *A(j,k) = blasf77_sdot(&jp1, A(0,j),&ione, work,&ione);
                        blasf77_saxpy(&j, &work[j], A(0,j),&ione, A(0,k),&ione);
                    }
                    *A(k,k) += blasf77_sdot(&k, work,&ione, A(0,k),&ione);
                }
                kstep = 2;
            }
            /* swap */
            ks = abs(ipiv[k])-1;
            if (ks != k) {
                const magma_int_t ksp1 = ks+1;
                blasf77_sswap(&ksp1, A(0,ks),&ione, A(0,k),&ione);
                for(jb = ks; jb<=k; jb++) {
                    j = k + ks - jb;
                    temp = *A(j,k);
                    *A(j,k) = *A(ks,j);
                    *A(ks,j) = temp;
                }
                if (kstep != 1) {
                    temp = *A(ks,k+1);
                    *A(ks,k+1) = *A(k,k+1);
                    *A(k,k+1) = temp;
                }
            }
            k = k + kstep;
        }
    }

    return *info;
}  /* End of SSIDI */
