void _Ppc_PointGravity_Init( void* _self, int alphaTag, double x, double y, double z )
{
Ppc_PointGravity* self = (Ppc_PointGravity*)_self;
#if 0
#endif
/* Sanity check */
Journal_Firewall( alphaTag >= 0,
self->error_stream, "\n\n\n"
"Error in configuration of Ppc_PointGravity %s\n"
"Alpha not set"
"\n\n\n", self->name );
self->alphaTag = alphaTag;
self->point[0] = x;
self->point[1] = y;
self->point[2] = z;
}
void _FileParticleLayout_InitialiseParticles( void* particleLayout, void* _swarm ) {
FileParticleLayout* self = (FileParticleLayout*)particleLayout;
self->file = fopen( self->filename, "rb" );
Journal_Firewall(
self->file != NULL,
self->errorStream,
"Error in %s for %s '%s' - Cannot open file %s.\n",
__func__,
self->type,
self->name,
self->filename );
_GlobalParticleLayout_InitialiseParticles( self, _swarm );
fclose( self->file );
self->file = NULL;
}
void SROpGenerator_GenLevelTopMap( SROpGenerator* self, unsigned level ) {
Stream* errorStream = Journal_Register( ErrorStream_Type, (Name)"SROpGenerator::GenLevelTopMap" );
Mesh *fMesh, *cMesh;
unsigned nDomainNodes;
unsigned nLevels;
unsigned nDims;
unsigned nearest;
double *cVert, *fVert;
unsigned d_i, n_i;
assert( self && Stg_CheckType( self, SROpGenerator ) );
assert( self->meshes );
assert( level < self->nLevels );
fMesh = self->meshes[level + 1];
cMesh = self->meshes[level];
nDims = Mesh_GetDimSize( fMesh );
nLevels = self->nLevels;
nDomainNodes = Mesh_GetDomainSize( cMesh, MT_VERTEX );
self->topMaps[level] = ReallocArray( self->topMaps[level], unsigned, nDomainNodes );
for( n_i = 0; n_i < nDomainNodes; n_i++ ) {
cVert = Mesh_GetVertex( cMesh, n_i );
nearest = Mesh_NearestVertex( fMesh, cVert );
fVert = Mesh_GetVertex( fMesh, nearest );
for( d_i = 0; d_i < nDims; d_i++ ) {
if( !Num_Approx( cVert[d_i], fVert[d_i] ) )
break;
}
Journal_Firewall( d_i == nDims,
errorStream,
"\n" \
"*****************************************************************\n" \
"* Error: The finest grid could not be sub-sampled to all coarse *\n" \
"* levels. This is due to the size of the finest grid. *\n" \
"*****************************************************************\n" \
"\n" );
if( level < nLevels - 2 )
self->topMaps[level][n_i] = self->topMaps[level + 1][nearest];
else
self->topMaps[level][n_i] = nearest;
}
}
void _GALENonNewtonian_AssignFromXML( void* rheology, Stg_ComponentFactory* cf, void* data ){
GALENonNewtonian* self = (GALENonNewtonian*)rheology;
FeVariable *strainRateInvField, *temperatureField;
double refStrainRate;
Stream* errorStream = Journal_Register( Error_Type,
GALENonNewtonian_Type );
/* Construct Parent */
_Rheology_AssignFromXML( self, cf, data );
/* TODO: 'Keyfallback' soon to be deprecated/updated */
strainRateInvField = Stg_ComponentFactory_ConstructByNameWithKeyFallback(
cf,
self->name,
(Name)"StrainRateInvariantField",
(Name)"StrainRateInvariantField",
FeVariable,
True,
data );
temperatureField = Stg_ComponentFactory_ConstructByKey(
cf,
self->name,
"TemperatureField",
FeVariable,
True,
data );
refStrainRate=Stg_ComponentFactory_GetDouble( cf, self->name,
"refStrainRate", 0.0 );
if(refStrainRate==0.0)
Journal_Firewall(0,errorStream,
"refStrainRate must be set to a non-zero number in a GALENonNewtonian rheology");
_GALENonNewtonian_Init(
self,
strainRateInvField,
temperatureField,
Stg_ComponentFactory_GetDouble( cf, self->name, "n", 1.0 ),
Stg_ComponentFactory_GetDouble( cf, self->name, "T_0", 1.0 ),
Stg_ComponentFactory_GetDouble( cf, self->name, "A", 1.0 ),
refStrainRate,
Stg_ComponentFactory_GetDouble( cf, self->name, "minViscosity", 0.0 ) ,
Stg_ComponentFactory_GetDouble( cf, self->name, "maxViscosity", 0.0 ) );
}
void SROpGenerator_GenLevelMesh( SROpGenerator* self, unsigned level ) {
Stream* errorStream = Journal_Register( ErrorStream_Type, (Name)"SROpGenerator::GenLevelMesh" );
Mesh *fMesh, *cMesh;
CartesianGenerator *fGen, *cGen;
unsigned nDims;
unsigned* cSize;
double crdMin[3], crdMax[3];
unsigned d_i;
assert( self && Stg_CheckType( self, SROpGenerator ) );
assert( self->meshes );
assert( level < self->nLevels );
fMesh = self->meshes[level + 1];
nDims = Mesh_GetDimSize( fMesh );
fGen = (CartesianGenerator*)fMesh->generator;
Journal_Firewall( fGen && !strcmp( fGen->type, CartesianGenerator_Type ),
errorStream,
"\n" \
"****************************************************************\n" \
"* Error: Simple regular multigrid operator generation requires *\n" \
"* a fine mesh that has been generated with a *\n" \
"* cartesian generator. *\n" \
"****************************************************************\n" \
"\n" );
cGen = CartesianGenerator_New( "", NULL );
CartesianGenerator_SetDimSize( cGen, nDims );
cSize = AllocArray( unsigned, nDims );
for( d_i = 0; d_i < nDims; d_i++ )
cSize[d_i] = fGen->elGrid->sizes[d_i] / 2;
CartesianGenerator_SetTopologyParams( cGen, cSize, fGen->maxDecompDims, fGen->minDecomp, fGen->maxDecomp );
Mesh_GetGlobalCoordRange( fMesh, crdMin, crdMax );
CartesianGenerator_SetGeometryParams( cGen, crdMin, crdMax );
CartesianGenerator_SetShadowDepth( cGen, 0 );
FreeArray( cSize );
cMesh = (Mesh*)FeMesh_New( "" );
Mesh_SetGenerator( cMesh, cGen );
FeMesh_SetElementFamily( cMesh, ((FeMesh*)fMesh)->feElFamily );
Stg_Component_Build( cMesh, NULL, False );
Stg_Component_Initialise( cMesh, NULL, False );
self->meshes[level] = cMesh;
}
void _MaterialPointsSwarm_Initialise( void* swarm, void* data ) {
MaterialPointsSwarm* self = (MaterialPointsSwarm*) swarm;
AbstractContext* context = (AbstractContext*)self->context;
Index var_I = 0;
Particle_Index lParticle_I=0;
MaterialPoint* matPoint=NULL;
_GeneralSwarm_Initialise( self, data );
if( self->material != NULL) Stg_Component_Initialise( self->material, data , False );
/* Now setup the material properties */
if( (False == context->loadFromCheckPoint) || False == (context->loadSwarmsFromCheckpoint) ) {
/* Beforehand, set each particle to have UNDEFINED_MATERIAL */
for ( lParticle_I = 0; lParticle_I < self->particleLocalCount; lParticle_I++ ) {
matPoint = (MaterialPoint*)Swarm_ParticleAt( self, lParticle_I );
matPoint->materialIndex = UNDEFINED_MATERIAL;
}
if( self->material == NULL ) {
/* Do it by the layout of all known materials */
Materials_Register_SetupSwarm( self->materials_Register, self );
}
else {
Material_Layout( self->material, self );
Materials_Register_AssignParticleProperties(
self->materials_Register,
self,
self->swarmVariable_Register->variable_Register );
}
}
if( self->overrideMaterialCheck == False ) {
/* Check to ensure all particles have a valid material */
for ( lParticle_I = 0; lParticle_I < self->particleLocalCount; lParticle_I++ ) {
matPoint = (MaterialPoint*)Swarm_ParticleAt( self, lParticle_I );
Journal_Firewall( (matPoint->materialIndex != UNDEFINED_MATERIAL), Journal_MyStream( Error_Type, self ),
"Error in function %s for swarm '%s'. Material point at (%.5g, %.5g, %.5g), has no material assigned to it.\n"
"This is most likely because the material geometries don't cover the entire domain - check material/geometry definitions\n\n"
"To check: visualise the material index field initialisation by running your model with the commandline options\n"
"\t\'--maxTimeSteps=-1 --components.%s.overrideMaterialCheck=True\'\n", __func__, self->name, matPoint->coord[0], matPoint->coord[1], matPoint->coord[2], self->name);
}
}
}
Encoding Dictionary_Entry_Value_GetEncoding( Dictionary_Entry_Value* self ) {
switch( self->type ) {
case Dictionary_Entry_Value_Type_List:
return self->as.typeList->encoding;
case Dictionary_Entry_Value_Type_Struct:
case Dictionary_Entry_Value_Type_String:
case Dictionary_Entry_Value_Type_Bool:
case Dictionary_Entry_Value_Type_Double:
case Dictionary_Entry_Value_Type_UnsignedInt:
case Dictionary_Entry_Value_Type_Int:
case Dictionary_Entry_Value_Type_UnsignedLong:
return Default;
default: {
Stream* errorStream = Journal_Register( Error_Type, "Dictionary_Entry_Value" );
Journal_Firewall( False, errorStream, "In func %s: self->type '%d' is invalid.\n", __func__, self->type );
}
}
return Default;
}
void _TimeIntegrator_Execute( void* timeIntegrator, void* data ) {
TimeIntegrator* self = (TimeIntegrator*)timeIntegrator;
double wallTime,tmin,tmax;
Journal_DPrintf( self->debug, "In %s for %s '%s'\n", __func__, self->type, self->name );
wallTime = MPI_Wtime();
/* Set function pointer */
switch (self->order) {
case 1:
self->_execute = _TimeIntegrator_ExecuteEuler;
break;
case 2:
if (self->simultaneous)
self->_execute = _TimeIntegrator_ExecuteRK2Simultaneous;
else
self->_execute = _TimeIntegrator_ExecuteRK2;
break;
case 4:
if (self->simultaneous)
self->_execute = _TimeIntegrator_ExecuteRK4Simultaneous;
else
self->_execute = _TimeIntegrator_ExecuteRK4;
break;
default:
Journal_Firewall( False, Journal_Register( Error_Type, (Name)self->type ),
"%s '%s' cannot handle order %u\n", self->type, self->name, self->order );
}
/* Call real function */
Journal_RPrintf( self->info, "Time Integration\n" );
self->_execute( self, data );
wallTime = MPI_Wtime()-wallTime;
MPI_Reduce( &wallTime, &tmin, 1, MPI_DOUBLE, MPI_MIN, 0, MPI_COMM_WORLD );
MPI_Reduce( &wallTime, &tmax, 1, MPI_DOUBLE, MPI_MAX, 0, MPI_COMM_WORLD );
Journal_RPrintf(self->info,"Time Integration - %.6g [min] / %.6g [max] (secs)\n", tmin, tmax);
}
/** Create Identity SymmetricTensor */
void SymmetricTensor_Identity(Dimension_Index dim, SymmetricTensor symmetricTensor) {
Dimension_Index index;
/* Check dimension */
if ( (dim != 2)&&(dim != 3) ) {
Stream* error = Journal_Register( ErrorStream_Type, (Name)"TensorMultMath" );
Journal_Printf( error, "Cannot get tensor value for dimension %d in %s.\n", dim, __func__);
Journal_Firewall( dim, error,
"In func '%s' don't understand dim = %u\n", __func__, dim );
}
/* Calculate indentity matrix: zero max = (0.5 * ((dim) * ((dim) + 1)) [Triangular number]*/
for (index = 0; index < (0.5 * (dim * (dim + 1 )) ); index++){
symmetricTensor[index] = 0.0;
}
for (index = 0; index < dim; index++ ){
symmetricTensor[SymmetricTensor_TensorMap(index, index, dim)] = 1.0;
}
return;
}
/** Create Identity Tensor */
void TensorArray_Identity(Dimension_Index dim, TensorArray tensorArray){
Dimension_Index index;
/* Check dimension */
if ( (dim != 2)&&(dim != 3) ) {
Stream* error = Journal_Register( ErrorStream_Type, (Name)"TensorMultMath" );
Journal_Printf( error, "Cannot get tensor value for dimension %d in %s.\n", dim, __func__);
Journal_Firewall( dim, error,
"In func '%s' don't understand dim = %u\n", __func__, dim );
}
/* Calculate indentity matrix */
for (index = 0; index < (dim * dim); index++){
tensorArray[index] = 0.0;
}
for (index = 0; index < dim; index++ ){
tensorArray[TensorArray_TensorMap(index, index, dim)] = 1.0;
}
return;
}
void _GALEDruckerPrager_AssignFromXML( void* druckerPrager, Stg_ComponentFactory* cf, void* data ){
GALEDruckerPrager* self = (GALEDruckerPrager*)druckerPrager;
FeVariable* pressureField = NULL;
SwarmVariable* swarmPressure = NULL;
MaterialPointsSwarm* materialPointsSwarm = NULL;
/* Construct Parent */
_GALEVonMises_AssignFromXML( self, cf, data );
pressureField = (FeVariable *)
Stg_ComponentFactory_ConstructByKey( cf, self->name, (Dictionary_Entry_Key)"PressureField", FeVariable, False, data );
swarmPressure = Stg_ComponentFactory_ConstructByKey( cf, self->name, (Dictionary_Entry_Key)"swarmPressure", SwarmVariable, False, data );
Journal_Firewall(
( pressureField || swarmPressure ),
Journal_Register( Error_Type, (Name)self->type ),
"\n Error in component type %s, name '%s'.\n Must specify a PressureField OR a swarmPressure, but not both. \n", self->type, self->name );
materialPointsSwarm = (MaterialPointsSwarm*)
Stg_ComponentFactory_ConstructByKey( cf, self->name, (Dictionary_Entry_Key)"MaterialPointsSwarm", MaterialPointsSwarm, True, data );
_GALEDruckerPrager_Init( self,
pressureField,
swarmPressure,
materialPointsSwarm,
Stg_ComponentFactory_GetDouble( cf, self->name, (Dictionary_Entry_Key)"frictionCoefficient", 0.0 ),
Stg_ComponentFactory_GetDouble( cf, self->name, (Dictionary_Entry_Key)"frictionCoefficientAfterSoftening", 0.0 ),
Stg_ComponentFactory_GetDouble( cf, self->name, (Dictionary_Entry_Key)"boundaryCohesion", 0.0 ),
Stg_ComponentFactory_GetDouble( cf, self->name, (Dictionary_Entry_Key)"boundaryCohesionAfterSoftening", 0.0 ),
Stg_ComponentFactory_GetDouble( cf, self->name, (Dictionary_Entry_Key)"boundaryFrictionCoefficient", 0.0 ),
Stg_ComponentFactory_GetDouble( cf, self->name, (Dictionary_Entry_Key)"boundaryFrictionCoefficientAfterSoftening", 0.0 ),
Stg_ComponentFactory_GetBool( cf, self->name, (Dictionary_Entry_Key)"boundaryBottom", False ),
Stg_ComponentFactory_GetBool( cf, self->name, (Dictionary_Entry_Key)"boundaryTop", False ),
Stg_ComponentFactory_GetBool( cf, self->name, (Dictionary_Entry_Key)"boundaryLeft", False ),
Stg_ComponentFactory_GetBool( cf, self->name, (Dictionary_Entry_Key)"boundaryRight", False ),
Stg_ComponentFactory_GetBool( cf, self->name, (Dictionary_Entry_Key)"boundaryFront", False ),
Stg_ComponentFactory_GetBool( cf, self->name, (Dictionary_Entry_Key)"boundaryBack", False ),
Stg_ComponentFactory_GetDouble( cf, self->name, (Dictionary_Entry_Key)"minimumYieldStress", 0.0 ),
Stg_ComponentFactory_GetDouble( cf, self->name, (Dictionary_Entry_Key)"minimumViscosity", 0.0),
Stg_ComponentFactory_ConstructByKey( cf, self->name,
(Dictionary_Entry_Key)"HydrostaticTerm", HydrostaticTerm, False, data ) );
}
void _IntegrationPointsSwarm_AssignFromXML( void* integrationPoints, Stg_ComponentFactory* cf, void* data ) {
IntegrationPointsSwarm* self = (IntegrationPointsSwarm*) integrationPoints;
FeMesh* mesh;
TimeIntegrator* timeIntegrator;
WeightsCalculator* weights;
IntegrationPointMapper* mapper;
Materials_Register* materials_Register;
Bool recalculateWeights;
PICelleratorContext* context;
/* This will also call _Swarm_Init */
_Swarm_AssignFromXML( self, cf, data );
mesh = Stg_ComponentFactory_ConstructByKey( cf, self->name, (Dictionary_Entry_Key)"FeMesh", FeMesh, True, data );
timeIntegrator = Stg_ComponentFactory_ConstructByKey( cf, self->name, (Dictionary_Entry_Key)"TimeIntegrator", TimeIntegrator, False, data );
weights = Stg_ComponentFactory_ConstructByKey( cf, self->name, (Dictionary_Entry_Key)"WeightsCalculator", WeightsCalculator, False, data );
mapper = Stg_ComponentFactory_ConstructByKey( cf, self->name, (Dictionary_Entry_Key)"IntegrationPointMapper", IntegrationPointMapper, False, data );
recalculateWeights = Stg_ComponentFactory_GetBool( cf, self->name, (Dictionary_Entry_Key)"recalculateWeights", True );
if( mapper !=NULL ) {
Journal_Firewall (
weights != NULL ||
(weights == NULL && (Stg_Class_IsInstance( mapper, GaussMapper_Type ) ||
Stg_Class_IsInstance( mapper, GaussCoincidentMapper_Type) ||
!strcmp( mapper->type, "PCDVCGaussMapper"))),
Journal_MyStream( Error_Type, self ),
"In func %s, %s which is a %s must either have a %s or use %s\n",
__func__,
self->name,
self->type,
WeightsCalculator_Type,
GaussMapper_Type );
}
context = (PICelleratorContext*)self->context;
assert( Stg_CheckType( context, PICelleratorContext ) );
materials_Register = context->materials_Register;
assert( materials_Register );
_IntegrationPointsSwarm_Init( self, mesh, timeIntegrator, weights, mapper, materials_Register, recalculateWeights );
}
/* 2D Functions */
void DVCWeightsSuite_TestConstructGrid2D( DVCWeightsSuiteData* data ) {
FILE *fp;
unsigned int ii = 0;
const char* gridFilename = "DVCWeightsSuite_testConstructGrid2D.txt";
char expectedGridFilename[PCU_PATH_MAX];
char line[100];
float x,y,dx,dy;
int N,S,E,W;
float tol = 1e-6;
_DVCWeights_ConstructGrid2D(&data->cells2D,data->numy,data->numx, BBXMIN,BBYMIN,BBXMAX,BBYMAX);
pcu_filename_expected( gridFilename, expectedGridFilename );/* get the expected filename to open */
fp = fopen(expectedGridFilename,"r");
if(!fp){
pcu_check_true(0);
Journal_Firewall( 0 , Journal_Register( Error_Type, (Name)"DVCWeightsSuite_TestConstructGrid2D" ),"expected test File %s Not Found in function %s\n" ,expectedGridFilename, __func__);
}
else{
/* Print out the grid */
for (ii = 0; ii < (data->numx * data->numy); ii++ ) {
pcu_check_true( data->cells2D[ii].p == -1 ); /* Particle index: shouldn't be set up yet */
pcu_check_true( data->cells2D[ii].done == 0 );
fgets(line,100,fp); fgets(line,100,fp);
sscanf(line,"\t\tValues: (N: %d, S: %d, E: %d, W: %d)\n",&N,&S,&E,&W);
pcu_check_true( data->cells2D[ii].N == N );
pcu_check_true( data->cells2D[ii].S == S );
pcu_check_true( data->cells2D[ii].E == E );
pcu_check_true( data->cells2D[ii].W == W );
fgets(line,100,fp);
sscanf(line,"\t\tCoords: ( %f, %f)\n",&x,&y);
dx = (data->cells2D[ii].x - x)*(data->cells2D[ii].x - x);
dy = (data->cells2D[ii].y - y)*(data->cells2D[ii].y - y);
pcu_check_true( dx < tol );
pcu_check_true( dy < tol );
}
}
fclose(fp);
}
void* _NamedObject_Register_Copy(
void* namedObjectRegister,
void* dest,
Bool deep,
Name nameExt,
struct PtrMap* ptrMap ) {
NamedObject_Register* self = (NamedObject_Register*)namedObjectRegister;
NamedObject_Register* newNamedObjectRegister;
newNamedObjectRegister = (NamedObject_Register*)_Stg_Class_Copy( self, dest, deep, nameExt, ptrMap );
Journal_Firewall(
deep,
Journal_Register( Error_Type, NamedObject_Register_Type ),
"Shallow copy not yet implemented\n" );
if( deep ) {
newNamedObjectRegister->objects = (Stg_ObjectList*)Stg_Class_Copy( self->objects, NULL, deep, nameExt, ptrMap );
}
return newNamedObjectRegister;
}
void _ImportersToolbox_SurfaceProcessCoupler_write_L( ImportersToolbox_SurfaceProcessCoupler* self ) {
MPI_Barrier( self->context->communicator );
if( self->context->rank == 0 ) {
Journal_Printf( global_info_stream,
"\nUnderworld has written file %s for the Surface Process simulation\n", self->ascii_path);
FILE *fPtr=NULL;
fPtr = fopen( self->maestro_path, "w" );
// check if file exists
Journal_Firewall( fPtr!=NULL, global_debug_stream,
"Error: in %s. Can't open the maestro file. Path expected is '%s'. Possibly solution is to change the 'sync_folder' parameter",
__func__, self->sync_folder);
// put the character
fputc( 'L', fPtr );
fclose( fPtr );
}
}
void Dictionary_Entry_Value_SetMemberWithSource( Dictionary_Entry_Value* self,
Dictionary_Entry_Key name, Dictionary_Entry_Value* member, Dictionary_Entry_Source source ) {
Stream* errorStream = Journal_Register( Error_Type, "Dictionary_Entry_Value" );
switch( self->type ) {
case Dictionary_Entry_Value_Type_Struct:
self->as.typeStruct->setWithSource( self->as.typeStruct, name, member, source );
return;
case Dictionary_Entry_Value_Type_List:
case Dictionary_Entry_Value_Type_String:
case Dictionary_Entry_Value_Type_Bool:
case Dictionary_Entry_Value_Type_Double:
case Dictionary_Entry_Value_Type_UnsignedInt:
case Dictionary_Entry_Value_Type_Int:
case Dictionary_Entry_Value_Type_UnsignedLong:
/* should print a warning once journal set up */
Journal_Printf( errorStream, "Func %s does not support Dictionary_Entry_Values of type '%d'.\n", __func__, self->type );
return;
default:
Journal_Firewall( False, errorStream, "In func %s: self->type '%d' is invalid.\n", __func__, self->type );
};
}
void _lucVectorArrowCrossSection_DrawCrossSection( void* drawingObject, lucDatabase* database, Dimension_Index dim )
{
lucVectorArrowCrossSection* self = (lucVectorArrowCrossSection*)drawingObject;
FieldVariable* vectorVariable = self->fieldVariable;
double min = 0.0, max = self->maximum;
Index aIndex, bIndex;
Journal_Firewall( vectorVariable->fieldComponentCount == vectorVariable->dim, lucError,
"Error - in %s(): provided FieldVariable \"%s\" has %u components - but %s Component "
"can only visualse FieldVariables with %d components.\n", __func__, vectorVariable->name,
vectorVariable->fieldComponentCount, self->type, vectorVariable->dim );
if ( True == self->dynamicRange )
{
min = FieldVariable_GetMinGlobalFieldMagnitude( vectorVariable );
max = FieldVariable_GetMaxGlobalFieldMagnitude( vectorVariable );
}
/* Force 3d vectors */
lucCrossSection_AllocateSampleData(self, 3);
/* Sample the 2d cross-section */
lucCrossSection_SampleField(self, False);
/* Write only values that have data on this processor! */
for ( aIndex = 0 ; aIndex < self->resolutionA ; aIndex++ )
{
for ( bIndex = 0 ; bIndex < self->resolutionB ; bIndex++ )
{
if (self->values[aIndex][bIndex][0] != HUGE_VAL)
{
lucDatabase_AddVertices(database, 1, lucVectorType, &self->vertices[aIndex][bIndex][0]);
lucDatabase_AddVectors(database, 1, lucVectorType, min, max, &self->values[aIndex][bIndex][0]);
}
}
}
lucCrossSection_FreeSampleData(self);
}
void _FileParticleLayout_InitialiseParticle(
void* particleLayout,
void* _swarm,
Particle_Index newParticle_I,
void* particle )
{
FileParticleLayout* self = (FileParticleLayout*)particleLayout;
Swarm* swarm = (Swarm*)_swarm;
SizeT particleSize = swarm->particleExtensionMgr->finalSize;
int result;
result = fread( particle, particleSize, 1, self->file );
Journal_Firewall(
result == 1,
self->errorStream,
"Error in func %s for %s '%s':\n"
"\tCouldn't read in particle %u - May have reached end-of-file.\n",
__func__,
self->type,
self->name,
newParticle_I );
}
void _VoxelDataHandler_Geomodeller_AssignFromXML( void* voxelDataHandler, Stg_ComponentFactory *cf, void* data ) {
VoxelDataHandler_Geomodeller* self = (VoxelDataHandler_Geomodeller*) voxelDataHandler;
/** config parent */
_VoxelDataHandler_Abstract_AssignFromXML( voxelDataHandler, cf, data );
/** open file */
self->fileMeta = CFile_NewRead( self->filename );
Journal_Firewall( self->fileMeta != NULL,
self->errorStream,
"Error in %s for %s '%s' - Cannot find or open file '%s'.",
__func__,
self->type,
self->name,
self->filename );
/** open a second copy */
self->fileData = CFile_NewRead( self->filename );
/** go ahead and load meta data */
_VoxelDataHandler_Geomodeller_LoadMetaData( voxelDataHandler );
/** now that we've loaded required information, setup auxilliary quantities */
_VoxelDataHandler_Abstract_CompleteSetup( voxelDataHandler );
}
void _SolutionVector_Build( void* solutionVector, void* data ) {
SolutionVector* self = (SolutionVector*)solutionVector;
Journal_DPrintf( self->debug, "In %s - for \"%s\"\n", __func__, self->name );
Stream_IndentBranch( StgFEM_Debug );
/* ensure variables are built */
if( self->feVariable )
Stg_Component_Build( self->feVariable, data, False );
Journal_Firewall( (self->eqNum!=NULL), NULL, "Solution vector could not be built as provided FeVariable does not appear to have an equation number object.\nPlease contact developers." );
/* Allocate the vector */
VecCreate( self->comm, &self->vector );
VecSetSizes( self->vector, self->eqNum->localEqNumsOwnedCount, PETSC_DECIDE );
VecSetFromOptions( self->vector );
#if( PETSC_VERSION_MAJOR <= 2 && PETSC_VERSION_MINOR >= 3 && PETSC_VERSION_SUBMINOR >= 3 )
VecSetOption( self->vector, VEC_IGNORE_NEGATIVE_INDICES );
#elif( PETSC_VERSION_MAJOR >= 3 )
VecSetOption( self->vector, VEC_IGNORE_NEGATIVE_INDICES, PETSC_TRUE );
#endif
Stream_UnIndentBranch( StgFEM_Debug );
}
void Dictionary_Entry_Value_SetFromStringKeepCurrentType( Dictionary_Entry_Value* self, char* string ) {
Dictionary_Entry_Value_Type currType = self->type;
Dictionary_Entry_Value_DeleteContents( self );
self->type = Dictionary_Entry_Value_Type_String;
self->as.typeString = string;
switch (currType) {
case Dictionary_Entry_Value_Type_String:
Dictionary_Entry_Value_SetValueString( self, string );
break;
case Dictionary_Entry_Value_Type_Double:
Dictionary_Entry_Value_SetValueDouble( self, Dictionary_Entry_Value_AsDouble( self ) );
break;
case Dictionary_Entry_Value_Type_UnsignedInt:
Dictionary_Entry_Value_SetValueUnsignedInt( self, Dictionary_Entry_Value_AsUnsignedInt( self ) );
break;
case Dictionary_Entry_Value_Type_Int:
Dictionary_Entry_Value_SetValueInt( self, Dictionary_Entry_Value_AsInt( self ) );
break;
case Dictionary_Entry_Value_Type_UnsignedLong:
Dictionary_Entry_Value_SetValueUnsignedLong( self, Dictionary_Entry_Value_AsUnsignedLong( self ) );
break;
case Dictionary_Entry_Value_Type_Bool:
Dictionary_Entry_Value_SetValueBool( self, Dictionary_Entry_Value_AsBool( self ) );
break;
case Dictionary_Entry_Value_Type_Struct:
Dictionary_Entry_Value_SetValueNewStruct( self );
break;
case Dictionary_Entry_Value_Type_List:
Dictionary_Entry_Value_SetValueNewList( self );
break;
default: {
Stream* errorStream = Journal_Register( Error_Type, "Dictionary_Entry_Value" );
Journal_Firewall( False, errorStream, "In func %s: self->type '%d' is invalid.\n", __func__, self->type );
}
}
}
void _RateFieldTimeIntegrator_Build( void* rateFieldTimeIntegrator, void* data ) {
RateFieldTimeIntegrator* self = (RateFieldTimeIntegrator*) rateFieldTimeIntegrator;
ExtensionInfo_Index handle;
Stg_Component_Build( self->swarm, data, False );
Stg_Component_Build( self->rateField, data, False );
handle = ExtensionManager_GetHandle( self->swarm->particleExtensionMgr, (Name)self->name );
if ( handle == (ExtensionInfo_Index) -1 ) {
ArithPointer offset;
handle = ExtensionManager_Add( self->swarm->particleExtensionMgr, (Name)RateFieldTimeIntegrator_Type, self->rateField->fieldComponentCount*sizeof(double) );
/* Adding required increment variable */
offset = (ArithPointer ) ExtensionManager_Get( self->swarm->particleExtensionMgr, NULL, handle );
/* Add variables for vizualization / analysis purposes */
self->particleTimeIntegral = Swarm_NewVectorVariable( self->swarm, self->name, offset, Variable_DataType_Double, self->rateField->fieldComponentCount, "STG_AUTONAME" );
LiveComponentRegister_Add( LiveComponentRegister_GetLiveComponentRegister(), (Stg_Component*)self->particleTimeIntegral->variable );
LiveComponentRegister_Add( LiveComponentRegister_GetLiveComponentRegister(), (Stg_Component*)self->particleTimeIntegral );
/* The RateFieldTimeIntegrator class inherits from the TimeIntegrand class - this class needs a 'Variable' to
* integrate through time. */
self->variable = self->particleTimeIntegral->variable;
} else
Journal_Firewall(False, Journal_Register( Error_Type, (Name)"RateFieldTimeIntegrator" ),
"\n\nError in '%s' - Extension with name %s should not already exists.\n"
"An error has occurred. Please contact developers.", __func__, self->name);
/* Build parent. Note that this needs to go last because it assumes that a variable has been set, which only just happens above */
/* Another example where the build/init/etc phases don't work */
_TimeIntegrand_Build( self, data );
Stg_Component_Build( self->particleTimeIntegral, data, False );
}
int _VoxelDataHandler_Geomodeller_LoadMetaData( void* voxelDataHandler ){
VoxelDataHandler_Geomodeller* self = (VoxelDataHandler_Geomodeller*)voxelDataHandler;
int jj;
char* identifier;
/** rewind file to top */
rewind( CFile_Ptr( self->fileMeta ) );
/** skip blank lines (if any) */
_VoxelDataHandler_Geomodeller_SkipBlank( self->fileMeta );
/** now read in data from file */
/** tokenize string */
for(jj=0; jj<10 ; jj++) {
/** get string from file */
fgets( self->currentString, VOXELMAX_LINE_LENGTH_DEFINE, CFile_Ptr( self->fileMeta ) );
/** get row identifier */
identifier = strtok_r(self->currentString, self->delim, &self->currentStrtokKey );
if( !strcmp(identifier, "nx")) sscanf( strtok_r(NULL, self->delim, &self->currentStrtokKey ), "%u", &self->numCells[0] );
else if (!strcmp(identifier, "ny")) sscanf( strtok_r(NULL, self->delim, &self->currentStrtokKey ), "%u", &self->numCells[1] );
else if (!strcmp(identifier, "nz")) sscanf( strtok_r(NULL, self->delim, &self->currentStrtokKey ), "%u", &self->numCells[2] );
else if (!strcmp(identifier, "x0")) sscanf( strtok_r(NULL, self->delim, &self->currentStrtokKey ), "%lg", &self->startCrd[0] );
else if (!strcmp(identifier, "y0")) sscanf( strtok_r(NULL, self->delim, &self->currentStrtokKey ), "%lg", &self->startCrd[1] );
else if (!strcmp(identifier, "z0")) sscanf( strtok_r(NULL, self->delim, &self->currentStrtokKey ), "%lg", &self->startCrd[2] );
else if (!strcmp(identifier, "dx")) sscanf( strtok_r(NULL, self->delim, &self->currentStrtokKey ), "%lg", &self->voxelSize[0] );
else if (!strcmp(identifier, "dy")) sscanf( strtok_r(NULL, self->delim, &self->currentStrtokKey ), "%lg", &self->voxelSize[1] );
else if (!strcmp(identifier, "dz")) sscanf( strtok_r(NULL, self->delim, &self->currentStrtokKey ), "%lg", &self->voxelSize[2] );
else if (!strcmp(identifier, "nodata_value")) sscanf( strtok_r(NULL, self->delim, &self->currentStrtokKey ), "%s", self->nodata_string );
else Journal_Firewall( 0,
self->errorStream,
"Error in %s for %s '%s' - The string \'%s\' within Geomodeller Voxel file %s is not recognised.\n The first 10 lines of your file must specifiy all of nx,ny,nz,x0,y0,z0,dx,dy,dz,nodata_value and nothing else",
__func__,
self->type,
self->name,
identifier,
self->filename);
}
return 1;
}
unsigned long Dictionary_Entry_Value_AsUnsignedLong( Dictionary_Entry_Value* self ) {
if( !self ) {
return 0.0;
}
switch( self->type ) {
case Dictionary_Entry_Value_Type_Struct:
/* Do nothing (later will print a warning) */
return 0;
case Dictionary_Entry_Value_Type_List:
/* returns the first element as an unsigned long */
if (self->as.typeList->first) {
return Dictionary_Entry_Value_AsUnsignedLong( self->as.typeList->first );
} else {
return 0;
}
case Dictionary_Entry_Value_Type_String:
return strtod( self->as.typeString, 0 );
case Dictionary_Entry_Value_Type_Double:
return self->as.typeDouble;
case Dictionary_Entry_Value_Type_UnsignedInt:
return (double)self->as.typeUnsignedInt;
case Dictionary_Entry_Value_Type_Int:
return self->as.typeInt;
case Dictionary_Entry_Value_Type_UnsignedLong:
return self->as.typeUnsignedLong;
case Dictionary_Entry_Value_Type_Bool:
return (double)self->as.typeBool;
default: {
Stream* errorStream = Journal_Register( Error_Type, "Dictionary_Entry_Value" );
Journal_Firewall( False, errorStream, "In func %s: self->type '%d' is invalid.\n", __func__, self->type );
}
}
return 0.0;
}
void _lucMeshCrossSection_Build( void* drawingObject, void* data )
{
lucMeshCrossSection* self = (lucMeshCrossSection*)drawingObject;
FeVariable* feVariable;
Mesh* mesh;
/* Build field variable in parent */
_lucCrossSection_Build(self, data);
(void)Stg_CheckType(self->fieldVariable, FeVariable);
feVariable = (FeVariable*)self->fieldVariable;
mesh = (Mesh*)feVariable->feMesh;
/* Store the Vertex Grid */
self->vertexGridHandle =mesh->vertGridId;
if ( self->vertexGridHandle == (ExtensionInfo_Index)-1 )
Journal_Firewall( self->vertexGridHandle != (ExtensionInfo_Index )-1, lucError,
"Error - in %s(): provided FieldVariable \"%s\" doesn't have a Vertex Grid.\n"
"Try visualising with lucScalarField instead.\n", __func__, self->fieldVariable->name );
self->fieldDim = self->fieldVariable->fieldComponentCount;
}
/** Calculate double dot product of two tensors */
double TensorArray_DoubleContraction(TensorArray tensorA,TensorArray tensorB, Dimension_Index dim){
double contraction;
Dimension_Index i, j;
/** \[\sigma:\epsilon=\sum_{i=1}^{n}\sum_{i=1}^{n}\sigma_{ij}\epsilon_{ij}\] */
/* Check dimension */
if ( (dim != 2)&&(dim != 3) ) {
Stream* error = Journal_Register( ErrorStream_Type, (Name)"TensorMultMath" );
Journal_Printf( error, "Cannot get tensor value for dimension %d in %s.\n", dim, __func__);
Journal_Firewall( dim, error,
"In func '%s' don't understand dim = %u\n", __func__, dim );
}
/* Calculate contraction */
contraction = 0.0;
for ( i = 0; i < dim; i++) {
for (j = 0; j < dim; j++) {
contraction = contraction +
tensorA[ TensorArray_TensorMap(i, j, dim) ] *
tensorB[ TensorArray_TensorMap(i, j, dim) ];
}
}
return contraction;
}
void _GeneralSwarm_Build( void* swarm, void* data )
{
GeneralSwarm* self = (GeneralSwarm*) swarm;
int commHandler_I;
Bool movementCommHandlerFound = False;
Stream* errorStream = Journal_Register( Error_Type, (Name)self->type );
int var_I;
_Swarm_Build( self, data );
if( self->escapedRoutine != NULL) Stg_Component_Build( self->escapedRoutine, data , False );
/* Since this swarm is being set up to advect a PICellerator material, it should make sure
* at least one ParticleMovementHandler-type ParticleCommHandler has been added to the base
* Swarm. */
for( commHandler_I=0; commHandler_I < self->commHandlerList->count; commHandler_I++ )
{
ParticleCommHandler *pComm = NULL;
pComm = (ParticleCommHandler*)(Stg_ObjectList_At( self->commHandlerList, commHandler_I ));
if( pComm->type == ParticleMovementHandler_Type )
{
movementCommHandlerFound = True;
break;
}
}
Journal_Firewall( (Stg_ObjectList_Count(self->commHandlerList) >= 1) && (movementCommHandlerFound == True),
errorStream, "Error: for GeneralSwarm Swarms, at least one ParticleMovementHandler"
" commHandler must be registered. Please rectify this in your XML / code.\n" );
for( var_I = 0 ; var_I < self->nSwarmVars ; var_I++ )
{
Stg_Component_Build( self->swarmVars[var_I], data , False );
}
}
double _Byerlee_GetYieldCriterion(
void* rheology,
ConstitutiveMatrix* constitutiveMatrix,
MaterialPointsSwarm* materialPointsSwarm,
Element_LocalIndex lElement_I,
MaterialPoint* materialPoint,
Coord xi )
{
Byerlee* self = (Byerlee*) rheology;
double depth = 0.0;
double height;
int err;
Coord coord;
/* stupid way to recover the integration point from the materialPoint
* TODO: FIXCONSTITUTIVE use integration point only */
IntegrationPoint* integrationPoint = (IntegrationPoint*) Swarm_ParticleAt( constitutiveMatrix->integrationSwarm,
constitutiveMatrix->currentParticleIndex );
/* Calculate Depth */
if( self->height_id != -1 ) {
err = PpcManager_Get( self->mgr, lElement_I, integrationPoint, self->height_id, &height );
Journal_Firewall( !err, global_error_stream,
"Error in file %s. Cannot get reference height for '%s'. Ensure you have passed in the correct input with a line like\n\t<param name=\"HeightReferenceInput\">someInputfunction</param>\n", __func__, self->name );
} else {
double min[3], max[3];
Mesh_GetGlobalCoordRange( self->mesh, min, max );
height = max[ J_AXIS ];
}
/* This rheology assumes particle is an integration points thats can be mapped to a particle
* that has no meaningful coord. Best to re-calc the global from local */
FeMesh_CoordLocalToGlobal( self->mesh, lElement_I, xi, coord );
depth = height - coord[ J_AXIS ];
return self->cohesion + self->depthCoefficient * depth;
}
Bool Dictionary_Entry_Value_AsBool( Dictionary_Entry_Value* self ) {
if( !self ) {
return 0;
}
switch( self->type ) {
case Dictionary_Entry_Value_Type_Struct:
/* Do nothing (later will print a warning) */
return 0;
case Dictionary_Entry_Value_Type_List:
/* returns the first element as an unsigned int */
if (self->as.typeList->first) {
return Dictionary_Entry_Value_AsBool( self->as.typeList->first );
} else {
return 0;
}
case Dictionary_Entry_Value_Type_String:
if( !strcmp( "1", self->as.typeString ) ) {
return True;
}
else if( !strcmp( "0", self->as.typeString ) ) {
return False;
}
else if( !strcasecmp( "true", self->as.typeString ) ) {
return True;
}
else if( !strcasecmp( "false", self->as.typeString ) ) {
return False;
}
else if( !strcasecmp( "t", self->as.typeString ) ) {
return True;
}
else if( !strcasecmp( "f", self->as.typeString ) ) {
return False;
}
else if( !strcasecmp( "yes", self->as.typeString ) ) {
return True;
}
else if( !strcasecmp( "no", self->as.typeString ) ) {
return False;
}
else if( !strcasecmp( "y", self->as.typeString ) ) {
return True;
}
else if( !strcasecmp( "n", self->as.typeString ) ) {
return False;
}
else if( !strcasecmp( "on", self->as.typeString ) ) {
return True;
}
else if( !strcasecmp( "off", self->as.typeString ) ) {
return False;
}
else {
Stream* errorStream = Journal_Register( Error_Type, "Dictionary_Entry_Value" );
Journal_Firewall( False, errorStream, "In func %s: Cannot convert string '%s' to Bool.\n", __func__, self->as.typeString );
}
case Dictionary_Entry_Value_Type_Double:
if( (Bool)self->as.typeDouble ) {
return True;
}
else {
return False;
}
case Dictionary_Entry_Value_Type_UnsignedInt:
if( (Bool)self->as.typeUnsignedInt ) {
return True;
}
else {
return False;
}
case Dictionary_Entry_Value_Type_Int:
if( (Bool)self->as.typeInt ) {
return True;
}
else {
return False;
}
case Dictionary_Entry_Value_Type_UnsignedLong:
if( (Bool)self->as.typeUnsignedLong ) {
return True;
}
else {
return False;
}
case Dictionary_Entry_Value_Type_Bool:
return self->as.typeBool;
default: {
Stream* errorStream = Journal_Register( Error_Type, "Dictionary_Entry_Value" );
Journal_Firewall( False, errorStream, "In func %s: self->type '%d' is invalid.\n", __func__, self->type );
}
}
return False;
}
/** This function will call the blas-lapack library and calculate the eigenvalues and eigenvectors
For a given tensorArray and return the answers in a ComplexEigenvector structure.*/
void TensorArray_CalcAllEigenFunctions(TensorArray tensor, Dimension_Index dim, Bool eigenFlag, ComplexEigenvector* eigenvectorList) {
/**This function will call the blas-lapack library and calculate the eigenvalues and eigenvectors */
/* Define functions needed to pass to blaslapack library function */
char jobVecLeft='V';
char jobVecRight='N';
double* arrayA;
int leadDimVL, leadDimVR, dimWorkSpace, INFO;
double errorValue;
double* workSpace;
double* outputReal;
double* outputImag;
double* leftEigenVec;
double* rightEigenVec;
int row_I, col_I;
//char* errorStringValues;
Stream* errorStream = Journal_Register( ErrorStream_Type, "FullTensorMath" );
/* Set size of workspace to pass to function */
dimWorkSpace = 10*dim;
/* define array size */
arrayA = Memory_Alloc_Array( double, dim * dim, "ArrayA" );
/* define output eigenvalue matrices */
outputReal = Memory_Alloc_Array( double, dim, "OutputReal" );
outputImag = Memory_Alloc_Array( double, dim, "OutputImag" );
for (row_I = 0; row_I < dim; row_I++) {
outputReal[row_I] = 0;
outputImag[row_I] = 0;
}
/* Define workspace */
workSpace = Memory_Alloc_Array( double, dimWorkSpace, "DimWorkSpace" );
/* Transpose array so that it is in Fortran-style indexing */
for( row_I = 0 ; row_I < dim ; row_I++ ) {
for( col_I = 0 ; col_I < dim ; col_I++ ) {
arrayA[ ( row_I * dim ) + col_I ] = tensor[TensorArray_TensorMap(row_I, col_I, dim)];
}
}
/* Turn off eigenvector calculations if eigenvector flag is not set */
if (eigenFlag == False) {
jobVecLeft = 'N';
}
/* Set sizes for eigenvectors */
if (jobVecLeft=='V') {
/* times size by 2 to account for complex eigenvectors */
leadDimVL = 2*dim;
}
else {
leadDimVL = 1;
}
/* Set sizes for alternate eigenvectors
This is currently always turned off since calculating right eigenvectors
as well is redundant */
if (jobVecRight=='V') {
/* times 2 to account for complex eigenvectors */
leadDimVR = 2*dim;
}
else {
leadDimVR = 1;
}
/* set size of eigenvector arrays */
leftEigenVec = Memory_Alloc_Array( double, leadDimVL * dim, "LeftEigenVec" );
rightEigenVec = Memory_Alloc_Array( double, leadDimVR * dim, "RightEigenVec" );
for (row_I = 0; row_I < leadDimVL * dim; row_I++) {
leftEigenVec[row_I] = 0;
}
for (row_I = 0; row_I < leadDimVR * dim; row_I++) {
rightEigenVec[row_I] = 0;
}
/* Definitions of lapack call inputs (from dgeev man page):
JOBVL (input) CHARACTER*1
= 'N': left eigenvectors of A are not computed;
= 'V': left eigenvectors of A are computed.
JOBVR (input) CHARACTER*1
= 'N': right eigenvectors of A are not computed;
= 'V': right eigenvectors of A are computed
N (input) INTEGER
The order of the matrix A. N >= 0.
A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
On entry, the N-by-N matrix A.
On exit, A has been overwritten.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,N).
WR (output) DOUBLE PRECISION array, dimension (N)
WI (output) DOUBLE PRECISION array, dimension (N)
WR and WI contain the real and imaginary parts,
respectively, of the computed eigenvalues. Complex
conjugate pairs of eigenvalues appear consecutively
with the eigenvalue having the positive imaginary part
first.
VL (output) DOUBLE PRECISION array, dimension (LDVL,N)
If JOBVL = 'V', the left eigenvectors u(j) are stored one
after another in the columns of VL, in the same order
as their eigenvalues.
If JOBVL = 'N', VL is not referenced.
If the j-th eigenvalue is real, then u(j) = VL(:,j),
the j-th column of VL.
If the j-th and (j+1)-st eigenvalues form a complex
conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
u(j+1) = VL(:,j) - i*VL(:,j+1).
LDVL (input) INTEGER
The leading dimension of the array VL. LDVL >= 1; if
JOBVL = 'V', LDVL >= N.
VR (output) DOUBLE PRECISION array, dimension (LDVR,N)
If JOBVR = 'V', the right eigenvectors v(j) are stored one
after another in the columns of VR, in the same order
as their eigenvalues.
If JOBVR = 'N', VR is not referenced.
If the j-th eigenvalue is real, then v(j) = VR(:,j),
the j-th column of VR.
If the j-th and (j+1)-st eigenvalues form a complex
conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
v(j+1) = VR(:,j) - i*VR(:,j+1).
LDVR (input) INTEGER
The leading dimension of the array VR. LDVR >= 1; if
JOBVR = 'V', LDVR >= N.
WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
LWORK (input) INTEGER
The dimension of the array WORK. LWORK >= max(1,3*N), and
if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N. For good
performance, LWORK must generally be larger.
If LWORK = -1, a workspace query is assumed. The optimal
size for the WORK array is calculated and stored in WORK(1),
and no other work except argument checking is performed.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value.
> 0: if INFO = i, the QR algorithm failed to compute all the
eigenvalues, and no eigenvectors have been computed;
elements i+1:N of WR and WI contain eigenvalues which
have converged.
*/
/** Passes into blaslapack function dgeev:
From Man page:
1. JOBVL 2. JOBVR 3. N
4. A 5. LDA 6. WR
7. WI 8. VL 9. LDVL
10. VR 11. LDVR 12. WORK
13. LWORK 14. INFO
In this code:
1. &jobVecLeft 2. &jobVecRight 3. &dimOrderN
4. arrayA 5. &dim 6. outputReal
7. outputImag 8. leftEigenVec 9. &dimOrderN
10. rightEigenVec 11. &dimOrderN 12. workSpace
13. &dimWorkSpace 14. &INFO
*/
/** Calls blas-lapack function, dgeev through stg_lapack header file substitution
to take account of different Fortran compilers */
stg_dgeev( &jobVecLeft, &jobVecRight, &dim, arrayA, &dim,
outputReal, outputImag, leftEigenVec, &leadDimVL,
rightEigenVec, &leadDimVR, workSpace, &dimWorkSpace, &INFO );
/* Check flag for succesful calculation */
if (INFO < 0) {
Journal_Printf( errorStream, "Error in %s, Blas-Lapack failed at %f-th argument for tensor:",
__func__, fabs(INFO));
Journal_PrintTensorArray( errorStream, tensor, dim );
Journal_Firewall(INFO , errorStream, "Error.\n" );
}
else if (INFO > 0) {
Journal_Printf( errorStream, "Error in %s, Blas-Lapack function failed for tensor:", __func__ );
Journal_PrintTensorArray( errorStream, tensor, dim );
Journal_Firewall(INFO, errorStream, "Error.\n" );
}
/*Pass values back */
errorValue = STG_TENSOR_ERROR;
/* Assign eigenvalues */
for (col_I=0; col_I < dim; col_I++) {
eigenvectorList[col_I].eigenvalue[REAL_PART] = outputReal[col_I];
eigenvectorList[col_I].eigenvalue[IMAG_PART] = outputImag[col_I];
if (fabs(eigenvectorList[col_I].eigenvalue[REAL_PART]) < errorValue) {
eigenvectorList[col_I].eigenvalue[REAL_PART] = 0;
}
if (fabs(eigenvectorList[col_I].eigenvalue[IMAG_PART]) < errorValue) {
eigenvectorList[col_I].eigenvalue[IMAG_PART] = 0;
}
}
/* If eigenvectors have been calculated */
if (eigenFlag == True ) {
int index_K;
int numSign;
/* Assign eigenvectors - see format for VL in comments for lapack pass above*/
for (col_I=0; col_I < dim; col_I++) {
if (outputImag[col_I] == 0.0) {
for (row_I = 0; row_I < dim; row_I++) {
eigenvectorList[col_I].vector[row_I][REAL_PART] = leftEigenVec[col_I * leadDimVL + row_I];
eigenvectorList[col_I].vector[row_I][IMAG_PART] = 0;
}
}
else {
for (index_K = col_I; index_K <= col_I + 1; index_K++) {
/* set sign of complex vector components */
if (index_K == col_I) {
numSign = -1;
}
else {
numSign = 1;
}
for (row_I = 0; row_I < dim; row_I++) {
/* u(col, row) = v(row, col)
\+- i * v(row, col + 1) */
eigenvectorList[index_K].vector[row_I][REAL_PART] =
leftEigenVec[col_I * leadDimVL + row_I];
eigenvectorList[index_K].vector[row_I][IMAG_PART] =
numSign * leftEigenVec[(col_I + 1) * leadDimVL + row_I];
}
}
col_I++;
}
}
}
/* Round up values that are less than the error bar */
for (row_I = 0; row_I < dim; row_I++) {
for (col_I = 0; col_I <dim; col_I++) {
if (fabs(eigenvectorList[row_I].vector[col_I][REAL_PART]) < errorValue) {
eigenvectorList[row_I].vector[col_I][REAL_PART] = 0.0;
}
if (fabs(eigenvectorList[row_I].vector[col_I][IMAG_PART]) < errorValue) {
eigenvectorList[row_I].vector[col_I][IMAG_PART] = 0.0;
}
}
}
/* Free memory and exit function */
Memory_Free( arrayA );
Memory_Free( outputReal );
Memory_Free( outputImag );
Memory_Free( leftEigenVec );
Memory_Free( rightEigenVec );
Memory_Free( workSpace );
}
