Functions | |
FLA_Error | FLA_Triangularize (FLA_Uplo uplo, FLA_Diag diag, FLA_Obj A) |
void FLA_F2C() | fla_triangularize_f (F_INT *uplo, F_INT *diag, F_INT *A, F_INT *IERROR) |
References FLA_Check_error_level(), FLA_Obj_datatype(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_width(), FLA_ONE, FLA_Triangularize_check(), and FLA_ZERO.
Referenced by FLA_SA_LU_unb(), fla_triangularize_f(), and FLASH_Triangularize().
00036 { 00037 FLA_Datatype datatype; 00038 int i, j; 00039 int m_A, n_A, ldim_A; 00040 00041 if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING ) 00042 FLA_Triangularize_check( uplo, diag, A ); 00043 00044 datatype = FLA_Obj_datatype( A ); 00045 00046 m_A = FLA_Obj_length( A ); 00047 n_A = FLA_Obj_width( A ); 00048 ldim_A = FLA_Obj_ldim( A ); 00049 00050 switch ( datatype ){ 00051 00052 case FLA_FLOAT: 00053 { 00054 float *buff_A = ( float * ) FLA_FLOAT_PTR( A ); 00055 float *buff_0 = ( float * ) FLA_FLOAT_PTR( FLA_ZERO ); 00056 float *buff_1 = ( float * ) FLA_FLOAT_PTR( FLA_ONE ); 00057 00058 if ( uplo == FLA_LOWER_TRIANGULAR ) 00059 { 00060 for ( j = 0; j < n_A; j++ ) 00061 { 00062 for ( i = 0; i < j; i++ ) 00063 buff_A[ j*ldim_A + i ] = *buff_0; 00064 00065 if ( diag == FLA_UNIT_DIAG ) 00066 buff_A[ j*ldim_A + j ] = *buff_1; 00067 else if ( diag == FLA_ZERO_DIAG ) 00068 buff_A[ j*ldim_A + j ] = *buff_0; 00069 } 00070 } 00071 else if ( uplo == FLA_UPPER_TRIANGULAR ) 00072 { 00073 for ( j = 0; j < n_A; j++ ) 00074 { 00075 if ( diag == FLA_UNIT_DIAG ) 00076 buff_A[ j*ldim_A + j ] = *buff_1; 00077 else if ( diag == FLA_ZERO_DIAG ) 00078 buff_A[ j*ldim_A + j ] = *buff_0; 00079 00080 for ( i = j + 1; i < m_A; i++ ) 00081 buff_A[ j*ldim_A + i ] = *buff_0; 00082 } 00083 } 00084 00085 break; 00086 } 00087 00088 case FLA_DOUBLE: 00089 { 00090 double *buff_A = ( double * ) FLA_DOUBLE_PTR( A ); 00091 double *buff_0 = ( double * ) FLA_DOUBLE_PTR( FLA_ZERO ); 00092 double *buff_1 = ( double * ) FLA_DOUBLE_PTR( FLA_ONE ); 00093 00094 if ( uplo == FLA_LOWER_TRIANGULAR ) 00095 { 00096 for ( j = 0; j < n_A; j++ ) 00097 { 00098 for ( i = 0; i < j; i++ ) 00099 buff_A[ j*ldim_A + i ] = *buff_0; 00100 00101 if ( diag == FLA_UNIT_DIAG ) 00102 buff_A[ j*ldim_A + j ] = *buff_1; 00103 else if ( diag == FLA_ZERO_DIAG ) 00104 buff_A[ j*ldim_A + j ] = *buff_0; 00105 } 00106 } 00107 else if ( uplo == FLA_UPPER_TRIANGULAR ) 00108 { 00109 for ( j = 0; j < n_A; j++ ) 00110 { 00111 if ( diag == FLA_UNIT_DIAG ) 00112 buff_A[ j*ldim_A + j ] = *buff_1; 00113 else if ( diag == FLA_ZERO_DIAG ) 00114 buff_A[ j*ldim_A + j ] = *buff_0; 00115 00116 for ( i = j + 1; i < m_A; i++ ) 00117 buff_A[ j*ldim_A + i ] = *buff_0; 00118 } 00119 } 00120 00121 break; 00122 } 00123 00124 case FLA_COMPLEX: 00125 { 00126 scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); 00127 scomplex *buff_0 = ( scomplex * ) FLA_COMPLEX_PTR( FLA_ZERO ); 00128 scomplex *buff_1 = ( scomplex * ) FLA_COMPLEX_PTR( FLA_ONE ); 00129 00130 if ( uplo == FLA_LOWER_TRIANGULAR ) 00131 { 00132 for ( j = 0; j < n_A; j++ ) 00133 { 00134 for ( i = 0; i < j; i++ ) 00135 buff_A[ j*ldim_A + i ] = *buff_0; 00136 00137 if ( diag == FLA_UNIT_DIAG ) 00138 buff_A[ j*ldim_A + j ] = *buff_1; 00139 else if ( diag == FLA_ZERO_DIAG ) 00140 buff_A[ j*ldim_A + j ] = *buff_0; 00141 } 00142 } 00143 else if ( uplo == FLA_UPPER_TRIANGULAR ) 00144 { 00145 for ( j = 0; j < n_A; j++ ) 00146 { 00147 if ( diag == FLA_UNIT_DIAG ) 00148 buff_A[ j*ldim_A + j ] = *buff_1; 00149 else if ( diag == FLA_ZERO_DIAG ) 00150 buff_A[ j*ldim_A + j ] = *buff_0; 00151 00152 for ( i = j + 1; i < m_A; i++ ) 00153 buff_A[ j*ldim_A + i ] = *buff_0; 00154 } 00155 } 00156 00157 break; 00158 } 00159 00160 case FLA_DOUBLE_COMPLEX: 00161 { 00162 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); 00163 dcomplex *buff_0 = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( FLA_ZERO ); 00164 dcomplex *buff_1 = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( FLA_ONE ); 00165 00166 if ( uplo == FLA_LOWER_TRIANGULAR ) 00167 { 00168 for ( j = 0; j < n_A; j++ ) 00169 { 00170 for ( i = 0; i < j; i++ ) 00171 buff_A[ j*ldim_A + i ] = *buff_0; 00172 00173 if ( diag == FLA_UNIT_DIAG ) 00174 buff_A[ j*ldim_A + j ] = *buff_1; 00175 else if ( diag == FLA_ZERO_DIAG ) 00176 buff_A[ j*ldim_A + j ] = *buff_0; 00177 } 00178 } 00179 else if ( uplo == FLA_UPPER_TRIANGULAR ) 00180 { 00181 for ( j = 0; j < n_A; j++ ) 00182 { 00183 if ( diag == FLA_UNIT_DIAG ) 00184 buff_A[ j*ldim_A + j ] = *buff_1; 00185 else if ( diag == FLA_ZERO_DIAG ) 00186 buff_A[ j*ldim_A + j ] = *buff_0; 00187 00188 for ( i = j + 1; i < m_A; i++ ) 00189 buff_A[ j*ldim_A + i ] = *buff_0; 00190 } 00191 } 00192 00193 break; 00194 } 00195 00196 } 00197 00198 return FLA_SUCCESS; 00199 }
void FLA_F2C() fla_triangularize_f | ( | F_INT * | uplo, | |
F_INT * | diag, | |||
F_INT * | A, | |||
F_INT * | IERROR | |||
) |
References FLA_Triangularize().
00203 { 00204 *IERROR = FLA_Triangularize( *( ( FLA_Uplo * ) uplo ), 00205 *( ( FLA_Diag * ) diag ), 00206 *( ( FLA_Obj * ) A ) ); 00207 }