/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:33:10 */ /*FOR_C Options SET: ftn=u io=c no=p op=aimnv pf=,p_dhtcc s=dbov str=l x=f - prototypes */ #include #include "fcrt.h" #include #include #include "p_dhtcc.h" /* program DRDHTCC *>> 1994-10-19 DRDHTCC Krogh Changes to use M77CON *>> 1987-12-09 DRDHTCC Lawson Initial Code. * Demo driver for DHTCC, Householder transformations. *--D replaces "?": DR?HTCC, ?HTCC, ?MATP */ /* PARAMETER translations */ #define IDIM 3 #define JDIM 5 #define M 3 #define N 2 #define ZERO 0.0e0 /* end of PARAMETER translations */ int main( ) { long int j, _i, _r; double uparam; static double d[JDIM][IDIM]; static int _aini = 1; if( _aini ){ /* Do 1 TIME INITIALIZATIONS! */ { static double _itmp0[] = {0.870e0,0.796e0,1.0e0,0.0e0,0.0e0}; for (j = 1, _r = 0; j <= 5; j++) { d[j - 1][0] = _itmp0[_r++]; } } { static double _itmp1[] = {0.571e0,-0.804e0,0.0e0,1.0e0,0.0e0}; for (j = 1, _r = 0; j <= 5; j++) { d[j - 1][1] = _itmp1[_r++]; } } { static double _itmp2[] = {-0.960e0,0.346e0,0.0e0,0.0e0,1.0e0}; for (j = 1, _r = 0; j <= 5; j++) { d[j - 1][2] = _itmp2[_r++]; } } _aini = 0; } /* ------------------------------------------------------------------ */ printf("DRDHTCC.. Demonstrate computation of a QR decomposition.\n"); printf("Given matrix A, compute orthogonal Q and triangular R\n"); printf("such that A = Q * R.\n"); dmatp( (double*)d, IDIM, M, N, "0 A =" ); for (j = 1; j <= N; j++) { dhtcc( 1, j, j + 1, M, &d[j - 1][0], &uparam, &d[j][0], IDIM, M + N - j ); } dmatp( &d[N][0], IDIM, M, M, "0 Q [Transposed] =" ); d[0][1] = ZERO; d[0][2] = ZERO; d[1][2] = ZERO; dmatp( (double*)d, IDIM, M, N, "0 R =" ); exit(0); } /* end of function */