LAPACKE_zlarfb_work()

lapack_int LAPACKE_zlarfb_work	(	int	matrix_layout,
		char	side,
		char	trans,
		char	direct,
		char	storev,
		lapack_int	m,
		lapack_int	n,
		lapack_int	k,
		const lapack_complex_double *	v,
		lapack_int	ldv,
		const lapack_complex_double *	t,
		lapack_int	ldt,
		lapack_complex_double *	c,
		lapack_int	ldc,
		lapack_complex_double *	work,
		lapack_int	ldwork
	)

Definition at line 35 of file lapacke_zlarfb_work.c.

{
    lapack_int info = 0;
    lapack_int nrows_v, ncols_v;
    lapack_logical left, col, forward;
    char uplo;
    lapack_int ldc_t, ldt_t, ldv_t;
    lapack_complex_double *v_t = NULL, *t_t = NULL, *c_t = NULL;
    if( matrix_layout == LAPACK_COL_MAJOR ) {
        /* Call LAPACK function and adjust info */
        LAPACK_zlarfb( &side, &trans, &direct, &storev, &m, &n, &k, v, &ldv, t,
                       &ldt, c, &ldc, work, &ldwork );
        if( info < 0 ) {
            info = info - 1;
        }
    } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
        left = LAPACKE_lsame( side, 'l' );
        col = LAPACKE_lsame( storev, 'c' );
        forward = LAPACKE_lsame( direct, 'f' );
 
        nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) );
        ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) );
        uplo = ( ( left && col ) || !( left || col ) ) ? 'l' : 'u';
 
        ldc_t = MAX(1,m);
        ldt_t = MAX(1,k);
        ldv_t = MAX(1,nrows_v);
        /* Check leading dimension(s) */
        if( ldc < n ) {
            info = -14;
            LAPACKE_xerbla( "LAPACKE_zlarfb_work", info );
            return info;
        }
        if( ldt < k ) {
            info = -12;
            LAPACKE_xerbla( "LAPACKE_zlarfb_work", info );
            return info;
        }
        if( ldv < ncols_v ) {
            info = -10;
            LAPACKE_xerbla( "LAPACKE_zlarfb_work", info );
            return info;
        }
        if( !forward && ( col && k > nrows_v ) || ( !col && k > ncols_v )) {
            info = -8;
            LAPACKE_xerbla( "LAPACKE_zlarfb_work", info );
            return info;
        }
        /* Allocate memory for temporary array(s) */
        v_t = (lapack_complex_double*)
            LAPACKE_malloc( sizeof(lapack_complex_double) *
                            ldv_t * MAX(1,ncols_v) );
        if( v_t == NULL ) {
            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
            goto exit_level_0;
        }
        t_t = (lapack_complex_double*)
            LAPACKE_malloc( sizeof(lapack_complex_double) * ldt_t * MAX(1,k) );
        if( t_t == NULL ) {
            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
            goto exit_level_1;
        }
        c_t = (lapack_complex_double*)
            LAPACKE_malloc( sizeof(lapack_complex_double) * ldc_t * MAX(1,n) );
        if( c_t == NULL ) {
            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
            goto exit_level_2;
        }
        /* Transpose input matrices */
        LAPACKE_ztz_trans( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v,
                           v, ldv, v_t, ldv_t );
        LAPACKE_zge_trans( matrix_layout, k, k, t, ldt, t_t, ldt_t );
        LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
        /* Call LAPACK function and adjust info */
        LAPACK_zlarfb( &side, &trans, &direct, &storev, &m, &n, &k, v_t, &ldv_t,
                       t_t, &ldt_t, c_t, &ldc_t, work, &ldwork );
        info = 0;  /* LAPACK call is ok! */
        /* Transpose output matrices */
        LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
        /* Release memory and exit */
        LAPACKE_free( c_t );
exit_level_2:
        LAPACKE_free( t_t );
exit_level_1:
        LAPACKE_free( v_t );
exit_level_0:
        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
            LAPACKE_xerbla( "LAPACKE_zlarfb_work", info );
        }
    } else {
        info = -1;
        LAPACKE_xerbla( "LAPACKE_zlarfb_work", info );
    }
    return info;
}

Here is the call graph for this function:

Here is the caller graph for this function: