inline MKL_INT lu_factor(MKL_INT m, T a[], MKL_INT ipiv[],
void (*getrf)(const MKL_INT*, const MKL_INT*, T*, const MKL_INT*, MKL_INT*, MKL_INT*))
{
std::complex<double> x = 5;
MKL_INT info = 0;
getrf(&m, &m, a, &m, ipiv, &info);
shift_ipiv_down(m, ipiv);
return info;
};
double
lu_determinant(MatrixType a)
{
// factorize
const size_t n = linalg::num_rows(a);
std::vector<int> ipiv(n, 0);
int info = getrf(a, ipiv);
if (info)
throw std::runtime_error("getrf failed in lu_determinant" +
std::to_string(info));
return getrfdet(a, ipiv);
}
VectorType
lu_solve(MatrixType a, const VectorType& y)
{
const size_t n = linalg::size(y);
MatrixType y1(n, 1, 0);
column(y1, 0) = y;
std::vector<int> ipiv(n, 0);
int info = getrf(a, ipiv);
if (info != 0)
{
throw std::runtime_error("getrf failed in lu_solve " +
std::to_string(info));
}
getrs(a, ipiv, y1);
return linalg::column(y1, 0);
}
inline MKL_INT lu_inverse(MKL_INT n, T a[], T work[], MKL_INT lwork,
void (*getrf)(const MKL_INT*, const MKL_INT*, T*, const MKL_INT*, MKL_INT*, MKL_INT*),
void (*getri)(const MKL_INT*, T*, const MKL_INT*, const MKL_INT*, T*, const MKL_INT*, MKL_INT*))
{
MKL_INT* ipiv = new MKL_INT[n];
MKL_INT info = 0;
getrf(&n, &n, a, &n, ipiv, &info);
if (info != 0)
{
delete[] ipiv;
return info;
}
getri(&n, a, &n, ipiv, work, &lwork, &info);
delete[] ipiv;
return info;
};
MatrixType
lu_invert(MatrixType a)
{
const size_t n = linalg::num_rows(a);
std::vector<int> ipiv(n, 0);
int info = getrf(a, ipiv);
if (info)
{
throw std::runtime_error("getrf failed in lu_invert " +
std::to_string(info));
}
info = getri(a, ipiv);
if (info != 0)
{
throw std::runtime_error("getri failed in lu_invert " +
std::to_string(info));
}
return a;
}
inline MKL_INT lu_solve(MKL_INT n, MKL_INT nrhs, T a[], T b[],
void (*getrf)(const MKL_INT*, const MKL_INT*, T*, const MKL_INT*, MKL_INT*, MKL_INT*),
void (*getrs)(const char*, const MKL_INT*, const MKL_INT*, const T*, const MKL_INT*, const MKL_INT*, T*, const MKL_INT*, MKL_INT*))
{
T* clone = Clone(n, n, a);
MKL_INT* ipiv = new MKL_INT[n];
MKL_INT info = 0;
getrf(&n, &n, clone, &n, ipiv, &info);
if (info != 0)
{
delete[] ipiv;
delete[] clone;
return info;
}
char trans ='N';
getrs(&trans, &n, &nrhs, clone, &n, ipiv, b, &n, &info);
delete[] ipiv;
delete[] clone;
return info;
}
vdatum *parse_vdatum_def ( input_string_def *is,
ref_frame *(*getrf)(const char *code, int loadref ),
vdatum *(*gethrs)(const char *code, int loadref )
)
{
char hrscode[CRDSYS_CODE_LEN+1];
char hrsname[CRDSYS_NAME_LEN+1];
char basecode[CRDSYS_CODE_LEN+1];
char geoidname[MAX_FILENAME_LEN+1];
const char *geoidfile;
double offset;
int isgeoid;
int isgrid;
vdatum *hrs = 0;
ref_frame *baserf = 0;
vdatum *basehrs = 0;
vdatum_func *hrf = 0;
int sts;
sts = OK;
isgeoid = 0;
isgrid = 0;
READ_STRING( "code",hrscode,CRDSYS_CODE_LEN );
READ_STRING( "name",hrsname,CRDSYS_NAME_LEN );
READ_STRING( "base height surface code",basecode,CRDSYS_CODE_LEN );
if( test_next_string_field(is,"geoid") )
{
isgeoid=1;
isgrid=1;
READ_STRING("geoid name",geoidname,MAX_FILENAME_LEN);
}
else if( test_next_string_field(is,"grid") )
{
isgrid=1;
READ_STRING("offset grid name",geoidname,MAX_FILENAME_LEN);
}
else
{
/* Skip optional string "offset" - as originally implemented with
* offset assumed and just a float value
*/
test_next_string_field(is, "offset");
READ_DOUBLE("offset",&offset);
}
if( isgrid )
{
geoidfile = find_relative_file( is->sourcename, geoidname, ".grd" );
if( ! geoidfile )
{
char errmess[255];
sprintf(errmess,"Cannot locate geoid file %.120s for vertical datum %.20s",
geoidname,hrscode);
report_string_error( is, INVALID_DATA, errmess );
sts = INVALID_DATA;
}
else
{
hrf=create_grid_vdatum_func( geoidfile, isgeoid );
}
}
else
{
hrf=create_offset_vdatum_func( offset );
}
if( sts == OK )
{
if( isgeoid && getrf )
{
baserf=getrf(basecode,1);
if( ! baserf )
{
char errmess[255];
sprintf(errmess,"Cannot load reference datum %.20s for vertical datum %.20s",
basecode,hrscode);
report_string_error( is, INVALID_DATA, errmess );
sts = INVALID_DATA;
}
}
else if( gethrs )
{
basehrs=gethrs(basecode,1);
if( ! basehrs )
{
char errmess[255];
sprintf(errmess,"Cannot load underlying vertical datum %.20s for %.20s",
basecode,hrscode);
report_string_error( is, INVALID_DATA, errmess );
sts = INVALID_DATA;
}
else
{
vdatum *base=basehrs;
while( base )
{
if( _stricmp(base->code,hrscode) == 0 )
{
char errmess[80+CRDSYS_CODE_LEN];
strcpy( errmess, "Vertical datum ");
strcat( errmess, hrscode );
strcat( errmess, " has a cyclic dependency");
report_string_error( is, INVALID_DATA, errmess );
sts = INVALID_DATA;
break;
}
base=base->basehrs;
}
}
}
}
if( sts == OK )
{
hrs=create_vdatum( hrscode, hrsname, basehrs, baserf, hrf );
if( ! hrs )
{
char errmess[80+CRDSYS_CODE_LEN];
strcpy( errmess, "Cannot create vertical datum ");
strcat( errmess, hrscode );
report_string_error( is, INVALID_DATA, errmess );
sts=INVALID_DATA;
}
}
if( ! hrs )
{
if( basehrs ) delete_vdatum( basehrs );
if( baserf ) delete_ref_frame( baserf );
if( hrf ) delete_vdatum_func( hrf );
}
return hrs;
}
inline
int lu_factor (MatrA& a, IVec& ipiv) {
return getrf (a, ipiv);
}
