00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034 #include "lapacke.h"
00035 #include "lapacke_utils.h"
00036
00037 lapack_int LAPACKE_zggsvd( int matrix_order, char jobu, char jobv, char jobq,
00038 lapack_int m, lapack_int n, lapack_int p,
00039 lapack_int* k, lapack_int* l,
00040 lapack_complex_double* a, lapack_int lda,
00041 lapack_complex_double* b, lapack_int ldb,
00042 double* alpha, double* beta,
00043 lapack_complex_double* u, lapack_int ldu,
00044 lapack_complex_double* v, lapack_int ldv,
00045 lapack_complex_double* q, lapack_int ldq,
00046 lapack_int* iwork )
00047 {
00048 lapack_int info = 0;
00049 double* rwork = NULL;
00050 lapack_complex_double* work = NULL;
00051 if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
00052 LAPACKE_xerbla( "LAPACKE_zggsvd", -1 );
00053 return -1;
00054 }
00055 #ifndef LAPACK_DISABLE_NAN_CHECK
00056
00057 if( LAPACKE_zge_nancheck( matrix_order, m, n, a, lda ) ) {
00058 return -10;
00059 }
00060 if( LAPACKE_zge_nancheck( matrix_order, p, n, b, ldb ) ) {
00061 return -12;
00062 }
00063 #endif
00064
00065 rwork = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*n) );
00066 if( rwork == NULL ) {
00067 info = LAPACK_WORK_MEMORY_ERROR;
00068 goto exit_level_0;
00069 }
00070 work = (lapack_complex_double*)
00071 LAPACKE_malloc( sizeof(lapack_complex_double) *
00072 MAX(1,MAX3(3*n,m,p)+n) );
00073 if( work == NULL ) {
00074 info = LAPACK_WORK_MEMORY_ERROR;
00075 goto exit_level_1;
00076 }
00077
00078 info = LAPACKE_zggsvd_work( matrix_order, jobu, jobv, jobq, m, n, p, k, l,
00079 a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q,
00080 ldq, work, rwork, iwork );
00081
00082 LAPACKE_free( work );
00083 exit_level_1:
00084 LAPACKE_free( rwork );
00085 exit_level_0:
00086 if( info == LAPACK_WORK_MEMORY_ERROR ) {
00087 LAPACKE_xerbla( "LAPACKE_zggsvd", info );
00088 }
00089 return info;
00090 }