MAT *makeQ(const MAT *QR,const VEC *diag, MAT *Qout) #endif { STATIC VEC *tmp1=VNULL,*tmp2=VNULL; unsigned int i, limit; Real beta, r_ii, tmp_val; int j; limit = min(QR->m,QR->n); if ( ! QR || ! diag ) error(E_NULL,"makeQ"); if ( diag->dim < limit ) error(E_SIZES,"makeQ"); if ( Qout==(MAT *)NULL || Qout->m < QR->m || Qout->n < QR->m ) Qout = m_get(QR->m,QR->m); tmp1 = v_resize(tmp1,QR->m); /* contains basis vec & columns of Q */ tmp2 = v_resize(tmp2,QR->m); /* contains H/holder vectors */ MEM_STAT_REG(tmp1,TYPE_VEC); MEM_STAT_REG(tmp2,TYPE_VEC); for ( i=0; i<QR->m ; i++ ) { /* get i-th column of Q */ /* set up tmp1 as i-th basis vector */ for ( j=0; j<QR->m ; j++ ) tmp1->ve[j] = 0.0; tmp1->ve[i] = 1.0; /* apply H/h transforms in reverse order */ for ( j=limit-1; j>=0; j-- ) { get_col(QR,j,tmp2); r_ii = fabs(tmp2->ve[j]); tmp2->ve[j] = diag->ve[j]; tmp_val = (r_ii*fabs(diag->ve[j])); beta = ( tmp_val == 0.0 ) ? 0.0 : 1.0/tmp_val; /* hhtrvec(tmp2,beta->ve[j],j,tmp1,tmp1); */ hhtrvec(tmp2,beta,j,tmp1,tmp1); } /* insert into Q */ set_col(Qout,i,tmp1); } #ifdef THREADSAFE V_FREE(tmp1); V_FREE(tmp2); #endif return (Qout); }
MAT *makeHQ(MAT *H, VEC *diag, VEC *beta, MAT *Qout) #endif { int i, j, limit; STATIC VEC *tmp1 = VNULL, *tmp2 = VNULL; if ( H==(MAT *)NULL || diag==(VEC *)NULL || beta==(VEC *)NULL ) error(E_NULL,"makeHQ"); limit = H->m - 1; if ( diag->dim < limit || beta->dim < limit ) error(E_SIZES,"makeHQ"); if ( H->m != H->n ) error(E_SQUARE,"makeHQ"); Qout = m_resize(Qout,H->m,H->m); tmp1 = v_resize(tmp1,H->m); tmp2 = v_resize(tmp2,H->m); MEM_STAT_REG(tmp1,TYPE_VEC); MEM_STAT_REG(tmp2,TYPE_VEC); for ( i = 0; i < H->m; i++ ) { /* tmp1 = i'th basis vector */ for ( j = 0; j < H->m; j++ ) /* tmp1->ve[j] = 0.0; */ v_set_val(tmp1,j,0.0); /* tmp1->ve[i] = 1.0; */ v_set_val(tmp1,i,1.0); /* apply H/h transforms in reverse order */ for ( j = limit-1; j >= 0; j-- ) { get_col(H,(unsigned int)j,tmp2); /* tmp2->ve[j+1] = diag->ve[j]; */ v_set_val(tmp2,j+1,v_entry(diag,j)); hhtrvec(tmp2,beta->ve[j],j+1,tmp1,tmp1); } /* insert into Qout */ set_col(Qout,(unsigned int)i,tmp1); } #ifdef THREADSAFE V_FREE(tmp1); V_FREE(tmp2); #endif return (Qout); }
VEC *_Qsolve(const MAT *QR, const VEC *diag, const VEC *b, VEC *x, VEC *tmp) #endif { unsigned int dynamic; int k, limit; Real beta, r_ii, tmp_val; limit = min(QR->m,QR->n); dynamic = FALSE; if ( ! QR || ! diag || ! b ) error(E_NULL,"_Qsolve"); if ( diag->dim < limit || b->dim != QR->m ) error(E_SIZES,"_Qsolve"); x = v_resize(x,QR->m); if ( tmp == VNULL ) dynamic = TRUE; tmp = v_resize(tmp,QR->m); /* apply H/holder transforms in normal order */ x = v_copy(b,x); for ( k = 0 ; k < limit ; k++ ) { get_col(QR,k,tmp); r_ii = fabs(tmp->ve[k]); tmp->ve[k] = diag->ve[k]; tmp_val = (r_ii*fabs(diag->ve[k])); beta = ( tmp_val == 0.0 ) ? 0.0 : 1.0/tmp_val; /* hhtrvec(tmp,beta->ve[k],k,x,x); */ hhtrvec(tmp,beta,k,x,x); } if ( dynamic ) V_FREE(tmp); return (x); }
MAT *makeHQ(MAT *H, VEC *diag, VEC *beta, MAT *Qout) #endif { unsigned int i,/* j,*/ limit; int j; char MatrixTempBuffer[ 2000 ]; /*STATIC */VEC *tmp1 = VNULL, *tmp2 = VNULL; if ( H==(MAT *)NULL || diag==(VEC *)NULL || beta==(VEC *)NULL ) error(E_NULL,"makeHQ"); limit = H->m - 1; if ( diag->dim < limit || beta->dim < limit ) error(E_SIZES,"makeHQ"); if ( H->m != H->n ) error(E_SQUARE,"makeHQ"); Qout = m_resize(Qout,H->m,H->m); if( SET_VEC_SIZE( H->m ) < 1000 ) { vec_get( &tmp1, (void *)MatrixTempBuffer, H->m ); } else { tmp1 = v_get( H->m ); } if( SET_VEC_SIZE( H->m ) < 1000 ) { vec_get( &tmp2, (void *)(MatrixTempBuffer + 1000), H->m ); } else { tmp2 = v_get( H->m); } /*tmp1 = v_resize(tmp1,H->m); tmp2 = v_resize(tmp2,H->m); MEM_STAT_REG(tmp1,TYPE_VEC); MEM_STAT_REG(tmp2,TYPE_VEC);*/ for ( i = 0; i < H->m; i++ ) { /* tmp1 = i'th basis vector */ for ( j = 0; j < (int)H->m; j++ ) /* tmp1->ve[j] = 0.0; */ v_set_val(tmp1,j,0.0); /* tmp1->ve[i] = 1.0; */ v_set_val(tmp1,i,1.0); /* apply H/h transforms in reverse order */ for ( j = limit-1; j >= 0; j-- ) { get_col(H,(unsigned int)j,tmp2); /* tmp2->ve[j+1] = diag->ve[j]; */ v_set_val(tmp2,j+1,v_entry(diag,j)); hhtrvec(tmp2,beta->ve[j],j+1,tmp1,tmp1); } /* insert into Qout */ set_col(Qout,(unsigned int)i,tmp1); } /* #ifdef THREADSAFE V_FREE(tmp1); V_FREE(tmp2); #endif */ if( tmp1 != (VEC *)(MatrixTempBuffer ) ) // память выделялась, надо освободить V_FREE(tmp1); if( tmp2 != (VEC *)(MatrixTempBuffer + 1000) ) // память выделялась, надо освободить V_FREE(tmp2); return (Qout); }