lapacke_zbbcsd.c File Reference

#include "lapacke_utils.h"

Go to the source code of this file.

Functions

lapack_int

LAPACKE_zbbcsd (int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, lapack_int m, lapack_int p, lapack_int q, double *theta, double *phi, lapack_complex_double *u1, lapack_int ldu1, lapack_complex_double *u2, lapack_int ldu2, lapack_complex_double *v1t, lapack_int ldv1t, lapack_complex_double *v2t, lapack_int ldv2t, double *b11d, double *b11e, double *b12d, double *b12e, double *b21d, double *b21e, double *b22d, double *b22e)

Function Documentation

LAPACKE_zbbcsd()

lapack_int LAPACKE_zbbcsd	(	int	matrix_layout,
		char	jobu1,
		char	jobu2,
		char	jobv1t,
		char	jobv2t,
		char	trans,
		lapack_int	m,
		lapack_int	p,
		lapack_int	q,
		double *	theta,
		double *	phi,
		lapack_complex_double *	u1,
		lapack_int	ldu1,
		lapack_complex_double *	u2,
		lapack_int	ldu2,
		lapack_complex_double *	v1t,
		lapack_int	ldv1t,
		lapack_complex_double *	v2t,
		lapack_int	ldv2t,
		double *	b11d,
		double *	b11e,
		double *	b12d,
		double *	b12e,
		double *	b21d,
		double *	b21e,
		double *	b22d,
		double *	b22e )

Definition at line 35 of file lapacke_zbbcsd.c.

{
    lapack_int info = 0;
    lapack_int lrwork = -1;
    double* rwork = NULL;
    double rwork_query;
    int lapack_layout;
    if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
        LAPACKE_xerbla( "LAPACKE_zbbcsd", -1 );
        return -1;
    }
    if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) {
        lapack_layout = LAPACK_COL_MAJOR;
    } else {
        lapack_layout = LAPACK_ROW_MAJOR;
    }
#ifndef LAPACK_DISABLE_NAN_CHECK
    if( LAPACKE_get_nancheck() ) {
        /* Optionally check input matrices for NaNs */
        if( LAPACKE_d_nancheck( q-1, phi, 1 ) ) {
            return -11;
        }
        if( LAPACKE_d_nancheck( q, theta, 1 ) ) {
            return -10;
        }
        if( LAPACKE_lsame( jobu1, 'y' ) ) {
            if( LAPACKE_zge_nancheck( lapack_layout, p, p, u1, ldu1 ) ) {
                return -12;
            }
        }
        if( LAPACKE_lsame( jobu2, 'y' ) ) {
            if( LAPACKE_zge_nancheck( lapack_layout, m-p, m-p, u2, ldu2 ) ) {
                return -14;
            }
        }
        if( LAPACKE_lsame( jobv1t, 'y' ) ) {
            if( LAPACKE_zge_nancheck( lapack_layout, q, q, v1t, ldv1t ) ) {
                return -16;
            }
        }
        if( LAPACKE_lsame( jobv2t, 'y' ) ) {
            if( LAPACKE_zge_nancheck( lapack_layout, m-q, m-q, v2t, ldv2t ) ) {
                return -18;
            }
        }
    }
#endif
    /* Query optimal working array(s) size */
    info = LAPACKE_zbbcsd_work( matrix_layout, jobu1, jobu2, jobv1t, jobv2t,
                                trans, m, p, q, theta, phi, u1, ldu1, u2, ldu2,
                                v1t, ldv1t, v2t, ldv2t, b11d, b11e, b12d, b12e,
                                b21d, b21e, b22d, b22e, &rwork_query, lrwork );
    if( info != 0 ) {
        goto exit_level_0;
    }
    lrwork = (lapack_int)rwork_query;
    /* Allocate memory for work arrays */
    rwork = (double*)LAPACKE_malloc( sizeof(double) * lrwork );
    if( rwork == NULL ) {
        info = LAPACK_WORK_MEMORY_ERROR;
        goto exit_level_0;
    }
    /* Call middle-level interface */
    info = LAPACKE_zbbcsd_work( matrix_layout, jobu1, jobu2, jobv1t, jobv2t,
                                trans, m, p, q, theta, phi, u1, ldu1, u2, ldu2,
                                v1t, ldv1t, v2t, ldv2t, b11d, b11e, b12d, b12e,
                                b21d, b21e, b22d, b22e, rwork, lrwork );
    /* Release memory and exit */
    LAPACKE_free( rwork );
exit_level_0:
    if( info == LAPACK_WORK_MEMORY_ERROR ) {
        LAPACKE_xerbla( "LAPACKE_zbbcsd", info );
    }
    return info;
}