/* Overwrites A. Can only handle full-rank problems with m>=n
* A in column-major format
* Ainv in row-major format
* tau has length m
* worksize must be >= max(1,n)
*/
static PetscErrorCode PetscDTPseudoInverseQR(PetscInt m,PetscInt mstride,PetscInt n,PetscReal *A_in,PetscReal *Ainv_out,PetscScalar *tau,PetscInt worksize,PetscScalar *work)
{
PetscErrorCode ierr;
PetscBLASInt M,N,K,lda,ldb,ldwork,info;
PetscScalar *A,*Ainv,*R,*Q,Alpha;
PetscFunctionBegin;
#if defined(PETSC_USE_COMPLEX)
{
PetscInt i,j;
ierr = PetscMalloc2(m*n,PetscScalar,&A,m*n,PetscScalar,&Ainv);CHKERRQ(ierr);
for (j=0; j<n; j++) {
for (i=0; i<m; i++) A[i+m*j] = A_in[i+mstride*j];
}
mstride = m;
}
#else
A = A_in;
Ainv = Ainv_out;
#endif
ierr = PetscBLASIntCast(m,&M);CHKERRQ(ierr);
ierr = PetscBLASIntCast(n,&N);CHKERRQ(ierr);
ierr = PetscBLASIntCast(mstride,&lda);CHKERRQ(ierr);
ierr = PetscBLASIntCast(worksize,&ldwork);CHKERRQ(ierr);
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
LAPACKgeqrf_(&M,&N,A,&lda,tau,work,&ldwork,&info);
ierr = PetscFPTrapPop();CHKERRQ(ierr);
if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"xGEQRF error");
R = A; /* Upper triangular part of A now contains R, the rest contains the elementary reflectors */
/* Extract an explicit representation of Q */
Q = Ainv;
ierr = PetscMemcpy(Q,A,mstride*n*sizeof(PetscScalar));CHKERRQ(ierr);
K = N; /* full rank */
LAPACKungqr_(&M,&N,&K,Q,&lda,tau,work,&ldwork,&info);
if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"xORGQR/xUNGQR error");
/* Compute A^{-T} = (R^{-1} Q^T)^T = Q R^{-T} */
Alpha = 1.0;
ldb = lda;
BLAStrsm_("Right","Upper","ConjugateTranspose","NotUnitTriangular",&M,&N,&Alpha,R,&lda,Q,&ldb);
/* Ainv is Q, overwritten with inverse */
#if defined(PETSC_USE_COMPLEX)
{
PetscInt i;
for (i=0; i<m*n; i++) Ainv_out[i] = PetscRealPart(Ainv[i]);
ierr = PetscFree2(A,Ainv);CHKERRQ(ierr);
}
#endif
PetscFunctionReturn(0);
}
int getQ1(Mat *pA){
int i,j;
PetscInt m,n;
PetscBLASInt M,N,K,lda,ldwork,info;
PetscScalar *tau,*work;
PetscInt worksize;
PetscErrorCode ierr;
ierr = MatGetSize(*pA,&m,&n);CHKERRQ(ierr);
PetscBLASIntCast(m,&M);
PetscBLASIntCast(n,&N);
worksize=m;
PetscBLASIntCast(worksize,&ldwork);
PetscMalloc1(m, &tau);//worksize,&work);
PetscMalloc1(worksize,&work);
K = N; /*full rank*/
lda = M ; //N - row domain M - col domain
//ierr = PetscPrintf (PETSC_COMM_SELF,"L72\n");CHKERRQ(ierr);
//ierr = MatView(*pA,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
//ierr = PetscPrintf (PETSC_COMM_SELF,"L74\n");CHKERRQ(ierr);
PetscScalar *v;//[4]={0};
PetscInt *Is; //[4]={0,1,2,3};
PetscInt nC;// = 4;
PetscReal arr[10*4];
for(i=0; i<10; i++){
ierr = MatGetRow(*pA,i,&nC,(const PetscInt **)&Is,(const PetscScalar **)&v); CHKERRQ(ierr);
//ierr = PetscPrintf (PETSC_COMM_SELF,"get row %d %d\n", i, nC);CHKERRQ(ierr);
for(j=0; j<nC; j++){
arr[i+10*Is[j]]=v[j];
}
ierr = MatRestoreRow(*pA,i,&nC,(const PetscInt**)&Is,(const PetscScalar**)&v); CHKERRQ(ierr);
}
//ierr = PetscPrintf (PETSC_COMM_SELF,"new L72\n");CHKERRQ(ierr);
//ierr = MatView(*pA,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
//ierr = PetscPrintf (PETSC_COMM_SELF,"new L74\n");CHKERRQ(ierr);
//for(i=0;i<40; i++){
// ierr = PetscPrintf (PETSC_COMM_SELF,"arr[%d] = %f\n",i,arr[i]);CHKERRQ(ierr);
//}
/* Do QR */
PetscFPTrapPush(PETSC_FP_TRAP_OFF);
LAPACKgeqrf_(&M,&N,arr,&lda,tau,work,&ldwork,&info);
PetscFPTrapPop();
if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"xGEQRF error");
/*Extract an explicit representation of Q */
//PetscMemcpy(Q,A,mstride*n*sizeof(PetscScalar));
LAPACKungqr_(&M,&N,&K,arr,&lda,tau,work,&ldwork,&info);
if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"xORGQR/xUNGQR error");
//ierr = PetscPrintf (PETSC_COMM_SELF,"\nWe store Q1 in arr:\n");CHKERRQ(ierr);
//for(i=0;i<40; i++){
// ierr = PetscPrintf (PETSC_COMM_SELF,"arr[%d] = %f\n",i,arr[i]);CHKERRQ(ierr);
//}
for (i=0; i<10; i++) {
for(j=0; j<4; j++) {
ierr = MatSetValues(*pA,1,&i,1,&j,&arr[i+j*10],INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(*pA,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*pA,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
//ierr = PetscPrintf (PETSC_COMM_SELF,"\nThe Q1 we are going to return is\n");CHKERRQ(ierr);
//ierr = MatView(*pA,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
//ierr = PetscFree(arr);CHKERRQ(ierr);
return 0;
}
