getdp-2.7.0-source/CTestConfig.cmake000644 001750 001750 00000001137 12473553042 020762 0ustar00geuzainegeuzaine000000 000000 # GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege # # See the LICENSE.txt file for license information. Please report all # bugs and problems to the public mailing list . set(CTEST_PROJECT_NAME "GetDP") set(CTEST_DROP_METHOD "http") set(CTEST_DROP_SITE_CDASH TRUE) set(CTEST_DROP_SITE "onelab.info") set(CTEST_DROP_LOCATION "/CDash/submit.php?project=GetDP") set(CTEST_TRIGGER_SITE "") set(SITE ${GETDP_HOST}) set(BUILDNAME "${GETDP_OS}-${GETDP_PACKAGER}") set(CTEST_CUSTOM_MAXIMUM_NUMBER_OF_WARNINGS "1000") set(CTEST_CUSTOM_MAXIMUM_NUMBER_OF_ERRORS "1000") getdp-2.7.0-source/utils/misc/getdp_gallery.sh000755 001750 001750 00000000471 12566010503 023055 0ustar00geuzainegeuzaine000000 000000 #!/bin/sh # This creates all the gallery images for the getdp website, from the images in # the benchmark directory for i in `find ../../benchmarks -name "screenshot?.png"`; do d=`dirname $i`; p=`basename $d`; f=`basename $i`; echo creating ${p}_${f}; convert -resize 256 $i ${p}_${f}; done getdp-2.7.0-source/utils/misc/onelab_screenshot.sh000755 001750 001750 00000001012 12514011104 023707 0ustar00geuzainegeuzaine000000 000000 #!/bin/sh # Run this once you have a nice view of the model to generate the screenshots # used in the ONELAB wiki, e.g.: # # > gmsh main.pro # ... get nice view with Gmsh window maximized ... # > onelab_screenshot 1 # ... get nice second view ... # > onelab_screenshot 2 if [ $# -lt 1 ]; then echo "Usage: $0 number" 1>&2; exit 1; fi NUMBER=$1 screencapture -Wi screenshot${NUMBER}.png # create miniature image with width of 512 pixels convert -resize 512 screenshot${NUMBER}.png screenshot${NUMBER}_512.png getdp-2.7.0-source/utils/misc/pyram.c000644 001750 001750 00000002627 11266605602 021203 0ustar00geuzainegeuzaine000000 000000 /* $Id: pyram.c,v 1.1 2008-07-10 10:27:47 geuzaine Exp $ */ /* Calcul des points de Gauss pour une pyramide cf. ../Integration/Gauss_Pyramid.h ref.: Coulomb et al., IEEE tr.mag. 32(3) May 1996, p.1395 Note: Pyramid de reference de sommets [(0,0,0),(1,0,0),(0,1,0),(0,0,1)] a la difference de l'article de Coulomb */ #include "stdlib.h" #include "math.h" #include "../Integration/Gauss_Quadrangle.h" /* double x[1] = {0.75}; double b[1] = {0.33}; */ double x[2] = {0.455848155988775, 0.877485177344559}; double b[2] = {0.100785882079825, 0.232547451253508}; /* double x[4] = {0.204148582103227, 0.482952704895632, 0.761399262448138, 0.951499450553003}; double b[4] = {0.010352240749918, 0.068633887172923, 0.143458789799214, 0.110888415611278}; */ void printout(int i, double * s, char * item){ int m; printf("double %s%d[%d] = {",item,i,i); for(m=0 ; m $file.tmp echo modified $file rm -f $file mv $file.tmp $file done getdp-2.7.0-source/utils/misc/getdp_framework.plist000644 001750 001750 00000001040 12010200204 024101 0ustar00geuzainegeuzaine000000 000000 CFBundleNameGetDP CFBundleExecutableGetDP CFBundlePackageTypeFMWK CFBundleVersionGETDP_VERSION CFBundleSignatureGETDP CFBundleIdentifierorg.geuz.GetDP getdp-2.7.0-source/utils/misc/onelab_screenshot.geo000644 001750 001750 00000001047 12514011104 024054 0ustar00geuzainegeuzaine000000 000000 // Merge this once you have a nice view of the model to generate the master // 1024x1024 screenshot for the mobile app, as well as the scaled 128x128 thumbnail // // > cd getdp/utils/misc // > gmsh ../../benchmarks/test/test.pro // > Print.Width = 1014; Print.Height = 1014; Print.Background = 1; Save StrCat("screenshot_", StrPrefix(StrRelative(General.FileName)), ".png") ; SystemCall StrCat("convert -scale 128 screenshot_", StrPrefix(StrRelative(General.FileName)), ".png screenshot_", StrPrefix(StrRelative(General.FileName)), "_128.png"); getdp-2.7.0-source/utils/post/deriv.awk000644 001750 001750 00000000612 11266605602 021546 0ustar00geuzainegeuzaine000000 000000 # the file should contain nbtimestep lines, and n results per line # we compute (nbtimestep-1) time derivatives BEGIN { dt=1; n=0; time=0; } { if(!time) n = $NF; for(j=0; j. #include #include "Gauss.h" #include "Gauss_Line.h" #include "Message.h" #include "MallocUtils.h" /* Gauss integration over a line */ static int gll[MAX_LINE_POINTS] = {-1}; static double *glxl[MAX_LINE_POINTS], *glpl[MAX_LINE_POINTS]; void Gauss_Line(int Nbr_Points, int Num, double *u, double *v, double *w, double *wght) { int i ; switch (Nbr_Points) { case 1 : *u = lx1 [Num] ; *v = 0. ; *w = 0. ; *wght = lp1 [Num] ; break ; case 2 : *u = lx2 [Num] ; *v = 0. ; *w = 0. ; *wght = lp2 [Num] ; break ; case 3 : *u = lx3 [Num] ; *v = 0. ; *w = 0. ; *wght = lp3 [Num] ; break ; case 4 : *u = lx4 [Num] ; *v = 0. ; *w = 0. ; *wght = lp4 [Num] ; break ; case 5 : *u = lx5 [Num] ; *v = 0. ; *w = 0. ; *wght = lp5 [Num] ; break ; case 6 : *u = lx6 [Num] ; *v = 0. ; *w = 0. ; *wght = lp6 [Num] ; break ; case 7 : *u = lx7 [Num] ; *v = 0. ; *w = 0. ; *wght = lp7 [Num] ; break ; case 8 : *u = lx8 [Num] ; *v = 0. ; *w = 0. ; *wght = lp8 [Num] ; break ; case 9 : *u = lx9 [Num] ; *v = 0. ; *w = 0. ; *wght = lp9 [Num] ; break ; case 10 : *u = lx10[Num] ; *v = 0. ; *w = 0. ; *wght = lp10[Num] ; break ; case 11 : *u = lx11[Num] ; *v = 0. ; *w = 0. ; *wght = lp11[Num] ; break ; case 12 : *u = lx12[Num] ; *v = 0. ; *w = 0. ; *wght = lp12[Num] ; break ; case 13 : *u = lx13[Num] ; *v = 0. ; *w = 0. ; *wght = lp13[Num] ; break ; case 14 : *u = lx14[Num] ; *v = 0. ; *w = 0. ; *wght = lp14[Num] ; break ; case 15 : *u = lx15[Num] ; *v = 0. ; *w = 0. ; *wght = lp15[Num] ; break ; case 16 : *u = lx16[Num] ; *v = 0. ; *w = 0. ; *wght = lp16[Num] ; break ; case 17 : *u = lx17[Num] ; *v = 0. ; *w = 0. ; *wght = lp17[Num] ; break ; case 18 : *u = lx18[Num] ; *v = 0. ; *w = 0. ; *wght = lp18[Num] ; break ; case 19 : *u = lx19[Num] ; *v = 0. ; *w = 0. ; *wght = lp19[Num] ; break ; case 20 : *u = lx20[Num] ; *v = 0. ; *w = 0. ; *wght = lp20[Num] ; break ; default : if(Nbr_Points <= MAX_LINE_POINTS){ if(gll[0] < 0) for(i = 0; i < MAX_LINE_POINTS; i++) gll[i] = 0 ; if(!gll[Nbr_Points - 1]){ Message::Info("Computing GaussLegendre %d for Line", Nbr_Points); glxl[Nbr_Points - 1] = (double*)Malloc(Nbr_Points * sizeof(double)); glpl[Nbr_Points - 1] = (double*)Malloc(Nbr_Points * sizeof(double)); GaussLegendre(-1., 1., glxl[Nbr_Points - 1], glpl[Nbr_Points - 1], Nbr_Points); gll[Nbr_Points - 1] = 1; } *u = glxl[Nbr_Points - 1][Num] ; *v = *w = 0. ; *wght = glpl[Nbr_Points - 1][Num] ; } else Message::Error("Maximum number of integration points exceeded (%d > %d)", Nbr_Points, MAX_LINE_POINTS) ; break ; } } #define EPS 3.0e-11 void GaussLegendre(double x1, double x2, double x[], double w[], int n) { int m, j, i; double z1, z, xm, xl, pp, p3, p2, p1; m = (n + 1) / 2; xm = 0.5 * (x2 + x1); xl = 0.5 * (x2 - x1); for (i = 1; i <= m; i++) { z = cos(3.141592654 * (i - 0.25) / (n + 0.5)); do { p1 = 1.0; p2 = 0.0; for (j = 1; j <= n; j++) { p3 = p2; p2 = p1; p1 = ((2.0 * j - 1.0) * z * p2 - (j - 1.0) * p3) / j; } pp = n * (z * p1 - p2) / (z * z - 1.0); z1 = z; z = z1 - p1 / pp; } while (fabs(z - z1) > EPS); x[i - 1] = xm - xl * z; x[n - i] = xm + xl * z; w[i - 1] = 2.0 * xl/((1.0 - z * z) * pp * pp); w[n - i] = w[i - 1]; } } getdp-2.7.0-source/Legacy/Get_DofOfElement.h000644 001750 001750 00000003514 12473553042 022274 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _GET_DOF_OF_ELEMENT_H_ #define _GET_DOF_OF_ELEMENT_H_ #include "ProData.h" void Get_InitDofOfElement(struct Element * Element) ; void Get_DofOfElement(struct Element * Element, struct FunctionSpace * FunctionSpace_P, struct QuantityStorage * QuantityStorage_P, List_T * BasisFunctionIndex_L) ; void Get_GroupsOfElementaryEntitiesOfElement (struct Element * Element, int * StartingIndex, int Nbr_ElementaryEntities, int Num_ElementaryEntities[], struct BasisFunction * BasisFunction_P) ; void Get_GroupsOfEdgesOnNodesOfElement (struct Element * Element, int * StartingIndex) ; void Get_RegionForElement(struct Element * Element, int * StartingIndex, struct BasisFunction * BasisFunction_P) ; void Get_GroupOfRegionsForElement(struct Element * Element, int * StartingIndex, struct BasisFunction * BasisFunction_P); void Get_GlobalForElement(struct Element * Element, int * StartingIndex, struct BasisFunction * BasisFunction_P) ; void Get_CodesOfElement(struct FunctionSpace * FunctionSpace_P, struct QuantityStorage * QuantityStorage_P, int Nbr_Entity, int Num_Entity[], int StartingIndex, int i_BFunction, int TypeConstraint, int * Num_SubFunction) ; void Get_PreResolutionForGlobalBasisFunction(int Nbr_Global, int StartingIndex, struct Element * Element) ; void Get_DofOfRegion(int Num_Region, struct GlobalQuantity * GlobalQuantity_P, struct FunctionSpace * FunctionSpace_P, struct QuantityStorage * QuantityStorage_P) ; #endif getdp-2.7.0-source/Legacy/Gauss_Quadrangle.h000644 001750 001750 00000004064 12473553042 022414 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . /* 1 integration point */ static double xq1[1] = {0.}; static double yq1[1] = {0.}; static double pq1[1] = {4.}; /* 3 integration points */ static double xq3[3] = {0.816496580928,-0.408248290464,-0.408248290464}; static double yq3[3] = {0.0,0.840896415255,-0.840896415255}; static double pq3[3] = {1.33333333333,1.33333333333,1.33333333333}; /* 4 integration points */ static double xq4[4] = {0.577350269189,-0.577350269189,0.577350269189,-0.577350269189}; static double yq4[4] = {0.577350269189,0.577350269189,-0.577350269189,-0.577350269189}; static double pq4[4] = {1.,1.,1.,1.}; /* 7 integration points */ static double xq7[7] = {0.0,-0.683130051064,0.683130051064,0.890654421782, -0.890654421782,0.374256642286,-0.374256642286}; static double yq7[7] = {0.0,-0.683130051064,0.683130051064,-0.374256642286,0.374256642286, -0.890654421782,0.890654421782}; static double pq7[7] = {1.142857142857,0.595238095238,0.595238095238, 0.416666666666,0.416666666666,0.416666666666,0.416666666666}; /* GAUSS QUADRANGLE WITH 1/R SINGULARITY OVER NODE (-1,-1,0) ref.: H. L. G. Pina, J. L. M. Fernandes, C. A. Brebbia, Some numerical integration formulae over triangles and squares with a 1/R singularity, Appl. Math. Modelling, Vol 5, June 1981, pp 209--211 */ /* 1 integration point */ static double xqs1[1] = {-0.26501817}; static double yqs1[1] = {-0.26501817}; static double pqs1[1] = {3.52549435}; /* 3 integration points */ static double xqs3[3] = {-0.58105530,1.0,-0.21877566}; static double yqs3[3] = {-0.58105530,-0.21877566,1.0}; static double pqs3[3] = {2.37881900,0.57333767,0.57333767}; /* 4 integration points */ static double xqs4[4] = {-0.37512304,0.69629093,-0.92928746,-0.15602536}; static double yqs4[4] = {-0.92928746,-0.15602536,-0.37512304,0.69629093}; static double pqs4[4] = {1.02276580,0.73998134,1.02276580,0.73998134}; getdp-2.7.0-source/Legacy/LinAlg_PETSC.cpp000644 001750 001750 00000120453 12552147335 021631 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // David Colignon // Ruth Sabariego // Jose Geraldo A. Brito Neto // #include #include #include #include #include #include #include "GetDPConfig.h" #include "LinAlg.h" #include "MallocUtils.h" #include "Message.h" #include "OS.h" #if defined(HAVE_SLEPC) #include #endif // Johan, we curse you for a thousand generations! #include "ProData.h" #include "DofData.h" extern struct CurrentData Current ; #if defined(HAVE_PETSC) // Options for PETSc can be provided on the command line, or in the file // ~/.petscrc. // // By default we use a direct solver (MUMPS, UMFPACK or the PETSc LU). // // All these options can be changed at runtime. For example you could // use // // -pc_type ilu // -pc_factor_levels 0 // -ksp_type gmres // -ksp_rtol 1.e-6 // -ksp_gmres_restart 500 // -ksp_monitor // // for GMRES with ILU(0), with a restart of 500 and a stopping // criterion of 1e-6. static MPI_Comm MyComm = MPI_COMM_SELF; static PetscViewer MyPetscViewer; static void _try(int ierr) { CHKERRCONTINUE(ierr); if(PetscUnlikely(ierr)){ const char *text; PetscErrorMessage(ierr, &text, 0); // Do not produce an error in case of a PETSc-crash when we are in // TimeLoopAdaptive loop if (Message::GetOperatingInTimeLoopAdaptive()) Message::Warning("PETSc error: %s", text); else Message::Error("PETSc error: %s", text); Message::SetLastPETScError(ierr); } } static int SolverInitialized = 0; #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) #define PetscTruth PetscBool #define PetscOptionsGetTruth PetscOptionsGetBool #endif void LinAlg_InitializeSolver(int* argc, char*** argv) { if(SolverInitialized) return; SolverInitialized = 1; // This function detects if MPI is initialized PetscInitialize(argc, argv, PETSC_NULL, PETSC_NULL); PetscPopSignalHandler(); MyPetscViewer = PETSC_VIEWER_STDOUT_SELF; MyComm = PETSC_COMM_WORLD; #if defined(HAVE_SLEPC) SlepcInitialize(argc, argv, PETSC_NULL, PETSC_NULL); #endif // get additional petsc options from specified file (useful e.g. on // Windows where we don't know where to search for ~/.petscrc) for(int i = 0; i < *argc - 1; i++){ if (!strcmp((*argv)[i], "-solver")){ #if (PETSC_VERSION_MAJOR == 2) PetscOptionsInsertFile((*argv)[i+1]); #else PetscOptionsInsertFile(MyComm, (*argv)[i+1], PETSC_FALSE); #endif } } } void LinAlg_FinalizeSolver() { // this causes random crashes when doing several initialize/finalize calls // (when using getdp as a library). Until we figure out what's happening, // let's simply initialize petsc/slepc once, and never finalize. return; if(SolverInitialized){ #if defined(HAVE_SLEPC) SlepcFinalize(); #endif PetscFinalize(); SolverInitialized = 0; } } void LinAlg_SetCommSelf() { Message::Info("Set communicator to SELF"); MyComm = PETSC_COMM_SELF; Message::SetIsCommWorld(0); } void LinAlg_SetCommWorld() { Message::Info("Set communicator to WORLD"); MyComm = PETSC_COMM_WORLD; Message::SetIsCommWorld(1); } void LinAlg_CreateSolver(gSolver *Solver, const char *SolverDataFileName) { for(int i = 0; i < 10; i++){ Solver->ksp[i] = NULL; Solver->snes[i] = NULL; } } void LinAlg_CreateVector(gVector *V, gSolver *Solver, int n) { _try(VecCreate(MyComm, &V->V)); _try(VecSetSizes(V->V, PETSC_DECIDE, n)); // override the default options with the ones from the option // database (if any) _try(VecSetFromOptions(V->V)); // create sequential vector that will contain all the values on all // the procs if(Message::GetCommSize() > 1 && MyComm != PETSC_COMM_SELF){ _try(VecCreateSeq(PETSC_COMM_SELF, n, &V->Vseq)); V->haveSeq = 1; } else{ V->haveSeq = 0; } } void _fillseq(Vec &V, Vec &Vseq) { // collect all the values from the parallel petsc vector into a sequential // vector on each processor VecScatter ctx; VecScatterCreateToAll(V, &ctx, NULL); #if (PETSC_VERSION_MAJOR == 2) && (PETSC_VERSION_MINOR == 3) && (PETSC_VERSION_SUBMINOR < 3) VecScatterBegin(V, Vseq, INSERT_VALUES, SCATTER_FORWARD, ctx); VecScatterEnd(V, Vseq, INSERT_VALUES, SCATTER_FORWARD, ctx); #else VecScatterBegin(ctx, V, Vseq, INSERT_VALUES, SCATTER_FORWARD); VecScatterEnd(ctx, V, Vseq, INSERT_VALUES, SCATTER_FORWARD); #endif #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) VecScatterDestroy(&ctx); #else VecScatterDestroy(ctx); #endif } static void _fillseq(gVector *V) { if(V->haveSeq) _fillseq(V->V, V->Vseq); } void LinAlg_CreateMatrix(gMatrix *M, gSolver *Solver, int n, int m) { PetscInt prealloc = 100; PetscInt prealloc_full = n; int nonloc = Current.DofData->NonLocalEquations.size(); // heuristic for preallocation of global rows: don't prelloc more than 100 Mb int onegig = (int)(100 * 1024 * 1024 / (gSCALAR_SIZE * sizeof(double))); if(nonloc * n > onegig){ prealloc_full = (int)(onegig / nonloc); Message::Debug("Heuristic -petsc_prealloc_full changed to %d", prealloc_full); } PetscTruth set; PetscOptionsGetInt(PETSC_NULL, "-petsc_prealloc", &prealloc, &set); PetscOptionsGetInt(PETSC_NULL, "-petsc_prealloc_full", &prealloc_full, &set); // prealloc cannot be bigger than the number of rows! prealloc = (n < prealloc) ? n : prealloc; prealloc_full = (n < prealloc_full) ? n : prealloc_full; std::vector nnz(n, prealloc); // preallocate non local equations as full lines (this is not // optimal, but preallocating too few elements leads to horrible // assembly performance: petsc really sucks at dynamic reallocation // in the AIJ matrix format) for(int i = 0; i < nonloc; i++) nnz[Current.DofData->NonLocalEquations[i] - 1] = prealloc_full; if(Message::GetCommSize() > 1){ // FIXME: alloc full lines... #if ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 3)) _try(MatCreateAIJ(MyComm, PETSC_DECIDE, PETSC_DECIDE, n, m, prealloc, PETSC_NULL, prealloc, PETSC_NULL, &M->M)); #else _try(MatCreateMPIAIJ(MyComm, PETSC_DECIDE, PETSC_DECIDE, n, m, prealloc, PETSC_NULL, prealloc, PETSC_NULL, &M->M)); #endif } else{ _try(MatCreateSeqAIJ(PETSC_COMM_SELF, n, m, 0, &nnz[0], &M->M)); // PETSc (I)LU does not like matrices with empty (non assembled) diagonals for(int i = 0; i < n; i++){ PetscScalar d = 0.; _try(MatSetValues(M->M, 1, &i, 1, &i, &d, INSERT_VALUES)); } _try(MatAssemblyBegin(M->M, MAT_FLUSH_ASSEMBLY)); _try(MatAssemblyEnd(M->M, MAT_FLUSH_ASSEMBLY)); } //MatSetOption(M->M, MAT_NEW_NONZERO_ALLOCATION_ERR, PETSC_FALSE); #if ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 3)) // Preallocation routines automatically set now MAT_NEW_NONZERO_ALLOCATION_ERR, // what causes a problem when the mask of the matrix changes (e.g. moving band) // We must disable the error generation and allow new allocation (if needed) _try(MatSetOption(M->M,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE)); #endif // override the default options with the ones from the option // database (if any) _try(MatSetFromOptions(M->M)); } void LinAlg_DestroySolver(gSolver *Solver) { for(int i = 0; i < 10; i++){ #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) if(Solver->ksp[i]) _try(KSPDestroy(&Solver->ksp[i])); if(Solver->snes[i]) _try(SNESDestroy(&Solver->snes[i])); #else if(Solver->ksp[i]) _try(KSPDestroy(Solver->ksp[i])); if(Solver->snes[i]) _try(SNESDestroy(Solver->snes[i])); #endif } } void LinAlg_DestroyVector(gVector *V) { #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) _try(VecDestroy(&V->V)); if(V->haveSeq) _try(VecDestroy(&V->Vseq)); #else _try(VecDestroy(V->V)); if(V->haveSeq) _try(VecDestroy(V->Vseq)); #endif } void LinAlg_DestroyMatrix(gMatrix *M) { #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) _try(MatDestroy(&M->M)); #else _try(MatDestroy(M->M)); #endif } void LinAlg_CopyScalar(gScalar *S1, gScalar *S2) { S1->s = S2->s; } void LinAlg_CopyVector(gVector *V1, gVector *V2) { _try(VecCopy(V1->V, V2->V)); if(V1->haveSeq) _try(VecCopy(V1->Vseq, V2->Vseq)); } void LinAlg_SwapVector(gVector *V1, gVector *V2) { _try(VecSwap(V1->V, V2->V)); if(V1->haveSeq) _try(VecSwap(V1->Vseq, V2->Vseq)); } void LinAlg_CopyMatrix(gMatrix *M1, gMatrix *M2) { _try(MatCopy(M1->M, M2->M, DIFFERENT_NONZERO_PATTERN)); } void LinAlg_ZeroScalar(gScalar *S) { S->s = 0.; } void LinAlg_ZeroVector(gVector *V) { PetscScalar zero = 0.0; _try(VecSet(V->V, zero)); if(V->haveSeq) _try(VecSet(V->Vseq, zero)); } void LinAlg_ZeroMatrix(gMatrix *M) { _try(MatZeroEntries(M->M)); } void LinAlg_ScanScalar(FILE *file, gScalar *S) { #if defined(PETSC_USE_COMPLEX) double a, b; fscanf(file, "%lf %lf", &a, &b); S->s = a + PETSC_i * b; #else fscanf(file, "%lf", &S->s); #endif } void LinAlg_ScanVector(FILE *file, gVector *V) { PetscInt n; _try(VecGetSize(V->V, &n)); for(PetscInt i = 0; i < n; i++){ PetscScalar tmp; #if defined(PETSC_USE_COMPLEX) double a, b; fscanf(file, "%lf %lf", &a, &b); tmp = a + PETSC_i * b; #else double a; fscanf(file, "%lf", &a); tmp = a; #endif _try(VecSetValues(V->V, 1, &i, &tmp, INSERT_VALUES)); } LinAlg_AssembleVector(V); } void LinAlg_ScanMatrix(FILE *file, gMatrix *M) { Message::Error("ScanMatrix not yet implemented"); } void LinAlg_ReadScalar(FILE *file, gScalar *S) { Message::Error("ReadScalar not yet implemented"); } void LinAlg_ReadVector(FILE *file, gVector *V) { PetscInt n; _try(VecGetSize(V->V, &n)); PetscScalar *tmp = (PetscScalar*)Malloc(n*sizeof(PetscScalar)); fread(tmp, sizeof(PetscScalar), n, file); for(PetscInt i = 0; i < n; i++) _try(VecSetValues(V->V, 1, &i, &tmp[i], INSERT_VALUES)); LinAlg_AssembleVector(V); Free(tmp); } void LinAlg_ReadMatrix(FILE *file, gMatrix *M) { Message::Error("ReadMatrix not yet implemented"); } void LinAlg_PrintScalar(FILE *file, gScalar *S) { #if defined(PETSC_USE_COMPLEX) fprintf(file, "%.16g %.16g", real(S->s), imag(S->s)); #else fprintf(file, "%.16g", S->s); #endif } void LinAlg_PrintVector(FILE *file, gVector *V, bool matlab, const char* fileName, const char* varName) { if(!matlab){ PetscInt n; _try(VecGetSize(V->V, &n)); Vec VV = V->haveSeq ? V->Vseq : V->V; PetscScalar *tmp; _try(VecGetArray(VV, &tmp)); for (int i = 0; i < n; i++){ #if defined(PETSC_USE_COMPLEX) fprintf(file, "%.16g %.16g\n", real(tmp[i]), imag(tmp[i])); #else fprintf(file, "%.16g\n", tmp[i]); #endif } fflush(file); _try(VecRestoreArray(VV, &tmp)); } else{ PetscViewer fd; _try(PetscViewerASCIIOpen(MyComm, fileName, &fd)); _try(PetscViewerSetFormat(fd, PETSC_VIEWER_ASCII_MATLAB)); _try(PetscObjectSetName((PetscObject)V->V, varName)); _try(VecView(V->V, fd)); #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) _try(PetscViewerDestroy(&fd)); #else _try(PetscViewerDestroy(fd)); #endif } } void LinAlg_PrintMatrix(FILE *file, gMatrix *M, bool matlab, const char* fileName, const char* varName) { if(!matlab){ PetscInt n, m; _try(MatGetSize(M->M, &n, &m)); for(int i = 0; i < n; i++){ PetscInt ncols; const PetscInt *cols; const PetscScalar *vals; _try(MatGetRow(M->M, i, &ncols, &cols, &vals)); for(int j = 0; j < m; j++){ #if defined(PETSC_USE_COMPLEX) fprintf(file, "[%d, %d] %.16g %.16g\n", i, j, real(vals[j]), imag(vals[j]) ); #else fprintf(file, "[%d, %d] %.16g\n", i, j, vals[j]); #endif } _try(MatRestoreRow(M->M, i, &ncols, &cols, &vals)); } } else{ // ASCII PetscViewer fd; _try(PetscViewerASCIIOpen(MyComm, fileName, &fd)); _try(PetscViewerSetFormat(fd, PETSC_VIEWER_ASCII_MATLAB)); _try(PetscObjectSetName((PetscObject)M->M, varName)); _try(MatView(M->M, fd)); // Binary PetscViewer fd2; std::string tmp(fileName); _try(PetscViewerBinaryOpen(MyComm, (tmp + ".bin").c_str(), FILE_MODE_WRITE, &fd2)); _try(PetscViewerSetFormat(fd2, PETSC_VIEWER_DEFAULT)); _try(MatView(M->M, fd2)); #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) _try(PetscViewerDestroy(&fd)); _try(PetscViewerDestroy(&fd2)); #else _try(PetscViewerDestroy(fd)); _try(PetscViewerDestroy(fd2)); #endif } } void LinAlg_WriteScalar(FILE *file, gScalar *S) { Message::Error("WriteScalar not yet implemented"); } void LinAlg_WriteVector(FILE *file, gVector *V) { PetscInt n; _try(VecGetSize(V->V, &n)); Vec VV = V->haveSeq ? V->Vseq : V->V; PetscScalar *tmp; _try(VecGetArray(VV, &tmp)); fwrite(tmp, sizeof(PetscScalar), n, file); fprintf(file, "\n"); _try(VecRestoreArray(VV, &tmp)); } void LinAlg_WriteMatrix(FILE *file, gMatrix *M) { Message::Error("WriteMatrix not yet implemented"); } void LinAlg_GetVectorSize(gVector *V, int *i) { PetscInt t; _try(VecGetSize(V->V, &t)); if(t > INT_MAX) Message::Error("Problem too big"); *i = t; } void LinAlg_GetLocalVectorRange(gVector *V, int *low, int *high) { PetscInt tlow, thigh; _try(VecGetOwnershipRange(V->V, &tlow, &thigh)); if(tlow > INT_MAX || thigh > INT_MAX) Message::Error("Problem too big"); *low = tlow; *high = thigh; } static bool _isInLocalRange(gVector *V, int i) { if(Message::GetCommSize() == 1) return true; int imin, imax; LinAlg_GetLocalVectorRange(V, &imin, &imax); return (i >= imin && i < imax); } void LinAlg_GetMatrixSize(gMatrix *M, int *i, int *j) { PetscInt ti, tj; _try(MatGetSize(M->M, &ti, &tj)); if(ti > INT_MAX || tj > INT_MAX) Message::Error("Problem too big"); *i = ti; *j = tj; } void LinAlg_GetLocalMatrixRange(gMatrix *M, int *low, int *high) { PetscInt tlow, thigh; _try(MatGetOwnershipRange(M->M, &tlow, &thigh)); if(tlow > INT_MAX || thigh > INT_MAX) Message::Error("Problem too big"); *low = tlow; *high = thigh; } static bool _isInLocalRange(gMatrix *M, int i) { if(Message::GetCommSize() == 1) return true; int imin, imax; LinAlg_GetLocalMatrixRange(M, &imin, &imax); return (i >= imin && i < imax); } void LinAlg_GetDoubleInScalar(double *d, gScalar *S) { #if defined(PETSC_USE_COMPLEX) *d = real(S->s); #else *d = S->s; #endif } void LinAlg_GetComplexInScalar(double *d1, double *d2, gScalar *S) { #if defined(PETSC_USE_COMPLEX) *d1 = real(S->s); *d2 = imag(S->s); #else Message::Error("'LinAlg_GetComplexInScalar' not available with this Solver"); #endif } void LinAlg_GetScalarInVector(gScalar *S, gVector *V, int i) { Vec VV = V->haveSeq ? V->Vseq : V->V; PetscScalar *tmp; _try(VecGetArray(VV, &tmp)); S->s = tmp[i]; _try(VecRestoreArray(VV, &tmp)); } void LinAlg_GetDoubleInVector(double *d, gVector *V, int i) { Vec VV = V->haveSeq ? V->Vseq : V->V; PetscScalar *tmp; _try(VecGetArray(VV, &tmp)); #if defined(PETSC_USE_COMPLEX) *d = real(tmp[i]); #else *d = tmp[i]; #endif _try(VecRestoreArray(VV, &tmp)); } void LinAlg_GetAbsDoubleInVector(double *d, gVector *V, int i) { Vec VV = V->haveSeq ? V->Vseq : V->V; PetscScalar *tmp; _try(VecGetArray(VV, &tmp)); #if defined(PETSC_USE_COMPLEX) *d = fabs(real(tmp[i])); #else *d = fabs(tmp[i]); #endif _try(VecRestoreArray(VV, &tmp)); } void LinAlg_GetComplexInVector(double *d1, double *d2, gVector *V, int i, int j) { Vec VV = V->haveSeq ? V->Vseq : V->V; PetscScalar *tmp; _try(VecGetArray(VV, &tmp)); #if defined(PETSC_USE_COMPLEX) *d1 = real(tmp[i]); *d2 = imag(tmp[i]); #else *d1 = (double)tmp[i]; *d2 = (double)tmp[j]; #endif _try(VecRestoreArray(VV, &tmp)); } void LinAlg_GetScalarInMatrix(gScalar *S, gMatrix *M, int i, int j) { if(!_isInLocalRange(M, i)) return; PetscInt ti = i, tj = j; _try(MatGetValues(M->M, 1, &ti, 1, &tj, &S->s)); } void LinAlg_GetDoubleInMatrix(double *d, gMatrix *M, int i, int j) { if(!_isInLocalRange(M, i)) return; PetscInt ti = i, tj = j; _try(MatGetValues(M->M, 1, &ti, 1, &tj, (PetscScalar*)d)); } void LinAlg_GetComplexInMatrix(double *d1, double *d2, gMatrix *M, int i, int j, int k, int l) { #if defined(PETSC_USE_COMPLEX) PetscScalar tmp; PetscInt ti = i, tj = j; if(_isInLocalRange(M, i)){ _try(MatGetValues(M->M, 1, &ti, 1, &tj, &tmp)); *d1 = real(tmp) ; *d2 = imag(tmp) ; } #else PetscInt ti = i, tj = j, tk = k, tl = l; if(_isInLocalRange(M, i)) _try(MatGetValues(M->M, 1, &ti, 1, &tj, (PetscScalar*)d1)); if(_isInLocalRange(M, k)) _try(MatGetValues(M->M, 1, &tk, 1, &tl, (PetscScalar*)d2)); #endif } void LinAlg_GetColumnInMatrix(gMatrix *M, int col, gVector *V1) { Message::Error("GetColumnInMatrix not yet implemented"); } void LinAlg_SetScalar(gScalar *S, double *d) { #if defined(PETSC_USE_COMPLEX) S->s = d[0] + (PETSC_i * d[1]); #else S->s = d[0]; #endif } void LinAlg_SetVector(gVector *V, double *v) { PetscScalar tmp = *v; _try(VecSet(V->V, tmp)); if(V->haveSeq) _try(VecSet(V->Vseq, tmp)); } void LinAlg_SetScalarInVector(gScalar *S, gVector *V, int i) { if(!_isInLocalRange(V, i)) return; PetscInt ti = i; _try(VecSetValues(V->V, 1, &ti, &S->s, INSERT_VALUES)); } void LinAlg_SetDoubleInVector(double d, gVector *V, int i) { if(!_isInLocalRange(V, i)) return; PetscScalar tmp = d; PetscInt ti = i; _try(VecSetValues(V->V, 1, &ti, &tmp, INSERT_VALUES)); } void LinAlg_SetComplexInVector(double d1, double d2, gVector *V, int i, int j) { PetscScalar tmp; #if defined(PETSC_USE_COMPLEX) if(_isInLocalRange(V, i)){ PetscInt ti = i; tmp = d1 + PETSC_i * d2; _try(VecSetValues(V->V, 1, &ti, &tmp, INSERT_VALUES)); } #else PetscInt ti = i, tj = j; if(_isInLocalRange(V, i)){ tmp = d1; _try(VecSetValues(V->V, 1, &ti, &tmp, INSERT_VALUES)); } if(_isInLocalRange(V, j)){ tmp = d2; _try(VecSetValues(V->V, 1, &tj, &tmp, INSERT_VALUES)); } #endif } void LinAlg_SetScalarInMatrix(gScalar *S, gMatrix *M, int i, int j) { if(!_isInLocalRange(M, i)) return; PetscInt ti = i, tj = j; _try(MatSetValues(M->M, 1, &ti, 1, &tj, &S->s, INSERT_VALUES)); } void LinAlg_SetDoubleInMatrix(double d, gMatrix *M, int i, int j) { if(!_isInLocalRange(M, i)) return; PetscInt ti = i, tj = j; _try(MatSetValues(M->M, 1, &ti, 1, &tj, (PetscScalar*)&d, INSERT_VALUES)); } void LinAlg_SetComplexInMatrix(double d1, double d2, gMatrix *M, int i, int j, int k, int l) { PetscScalar tmp; #if defined(PETSC_USE_COMPLEX) PetscInt ti = i, tj = j; if(_isInLocalRange(M, i)){ tmp = d1 + PETSC_i * d2; _try(MatSetValues(M->M, 1, &ti, 1, &tj, &tmp, INSERT_VALUES)); } #else PetscInt ti = i, tj = j, tk = k, tl = l; if(d1){ tmp = d1; if(_isInLocalRange(M, i)) _try(MatSetValues(M->M, 1, &ti, 1, &tj, &tmp, INSERT_VALUES)); if(_isInLocalRange(M, k)) _try(MatSetValues(M->M, 1, &tk, 1, &tl, &tmp, INSERT_VALUES)); } if(d2){ if(_isInLocalRange(M, i)){ tmp = -d2; _try(MatSetValues(M->M, 1, &ti, 1, &tl, &tmp, INSERT_VALUES)); } if(_isInLocalRange(M, k)){ tmp = d2; _try(MatSetValues(M->M, 1, &tk, 1, &tj, &tmp, INSERT_VALUES)); } } #endif } void LinAlg_AddScalarScalar(gScalar *S1, gScalar *S2, gScalar *S3) { S3->s = S1->s + S2->s; } void LinAlg_DummyVector(gVector *V) { PetscInt n; PetscScalar zero = 0.0; if (Current.DofData->DummyDof == NULL) return ; _try(VecGetSize(V->V, &n)); for(PetscInt i = 0; i < n; i++) if (Current.DofData->DummyDof[i]==1) _try(VecSetValues(V->V, 1, &i, &zero, INSERT_VALUES)); } void LinAlg_AddScalarInVector(gScalar *S, gVector *V, int i) { if(!_isInLocalRange(V, i)) return; if(Current.DofData->DummyDof) if(Current.DofData->DummyDof[i]==1) return ; PetscInt ti = i; _try(VecSetValues(V->V, 1, &ti, &S->s, ADD_VALUES)); } void LinAlg_AddDoubleInVector(double d, gVector *V, int i) { if(!_isInLocalRange(V, i)) return; if(Current.DofData->DummyDof) if(Current.DofData->DummyDof[i]==1) return ; PetscScalar tmp = d; PetscInt ti = i; _try(VecSetValues(V->V, 1, &ti, &tmp, ADD_VALUES)); } void LinAlg_AddComplexInVector(double d1, double d2, gVector *V, int i, int j) { PetscScalar tmp; int iok=1, jok=1; if(Current.DofData->DummyDof){ if(Current.DofData->DummyDof[i]==1) iok=0; if(Current.DofData->DummyDof[j]==1) jok=0; } #if defined(PETSC_USE_COMPLEX) if(_isInLocalRange(V, i) && iok && jok){ PetscInt ti = i; tmp = d1 + PETSC_i * d2; _try(VecSetValues(V->V, 1, &ti, &tmp, ADD_VALUES)); } #else PetscInt ti = i, tj = j; if(_isInLocalRange(V, i) && iok){ tmp = d1; _try(VecSetValues(V->V, 1, &ti, &tmp, ADD_VALUES)); } if(_isInLocalRange(V, j) && jok){ tmp = d2; _try(VecSetValues(V->V, 1, &tj, &tmp, ADD_VALUES)); } #endif } void LinAlg_AddScalarInMatrix(gScalar *S, gMatrix *M, int i, int j) { if(!_isInLocalRange(M, i)) return; if (Current.DofData->DummyDof) if ( (Current.DofData->DummyDof[i]==1 || Current.DofData->DummyDof[j]==1) && (i!=j) ) return; PetscInt ti = i, tj = j; _try(MatSetValues(M->M, 1, &ti, 1, &tj, &S->s, ADD_VALUES)); } void LinAlg_AddDoubleInMatrix(double d, gMatrix *M, int i, int j) { if(!_isInLocalRange(M, i)) return; if (Current.DofData->DummyDof) if ( (Current.DofData->DummyDof[i]==1 || Current.DofData->DummyDof[j]==1) && (i!=j) ) return; PetscScalar tmp = d; PetscInt ti = i, tj = j; _try(MatSetValues(M->M, 1, &ti, 1, &tj, &tmp, ADD_VALUES)); } void LinAlg_AddComplexInMatrix(double d1, double d2, gMatrix *M, int i, int j, int k, int l) { PetscScalar tmp; #if defined(PETSC_USE_COMPLEX) PetscInt ti = i, tj = j; if(_isInLocalRange(M, i)){ tmp = d1 + PETSC_i * d2; _try(MatSetValues(M->M, 1, &ti, 1, &tj, &tmp, ADD_VALUES)); } #else PetscInt ti = i, tj = j, tk = k, tl = l; if(d1){ tmp = d1; if(_isInLocalRange(M, i)) _try(MatSetValues(M->M, 1, &ti, 1, &tj, &tmp, ADD_VALUES)); if(_isInLocalRange(M, k)) _try(MatSetValues(M->M, 1, &tk, 1, &tl, &tmp, ADD_VALUES)); } if(d2){ if(_isInLocalRange(M, i)){ tmp = -d2; _try(MatSetValues(M->M, 1, &ti, 1, &tl, &tmp, ADD_VALUES)); } if(_isInLocalRange(M, k)){ tmp = d2; _try(MatSetValues(M->M, 1, &tk, 1, &tj, &tmp, ADD_VALUES)); } } #endif } void LinAlg_AddVectorVector(gVector *V1, gVector *V2, gVector *V3) { PetscScalar tmp = 1.0; if(V3 == V1){ _try(VecAXPY(V1->V, tmp, V2->V)); _fillseq(V1); } else if(V3 == V2){ _try(VecAXPY(V2->V, tmp, V1->V)); _fillseq(V2); } else Message::Error("Wrong arguments in 'LinAlg_AddVectorVector'"); } void LinAlg_AddVectorProdVectorDouble(gVector *V1, gVector *V2, double d, gVector *V3) { PetscScalar tmp = d; if(V3 == V1){ _try(VecAXPY(V1->V, tmp, V2->V)); _fillseq(V1); } else if(V3 == V2){ _try(VecAYPX(V2->V, tmp, V1->V)); _fillseq(V2); } else Message::Error("Wrong arguments in 'LinAlg_AddVectorProdVectorDouble'"); } void LinAlg_AddMatrixMatrix(gMatrix *M1, gMatrix *M2, gMatrix *M3) { PetscScalar tmp = 1.0; if(M3 == M1) _try(MatAXPY(M1->M, tmp, M2->M, DIFFERENT_NONZERO_PATTERN)); else if(M3 == M2) _try(MatAXPY(M2->M, tmp, M1->M, DIFFERENT_NONZERO_PATTERN)); else Message::Error("Wrong arguments in 'LinAlg_AddMatrixMatrix'"); } void LinAlg_AddMatrixProdMatrixDouble(gMatrix *M1, gMatrix *M2, double d, gMatrix *M3) { PetscScalar tmp = d; if(M3 == M1) _try(MatAXPY(M1->M, tmp, M2->M, DIFFERENT_NONZERO_PATTERN)); else if(M3 == M2) #if (PETSC_VERSION_MAJOR == 2) && (PETSC_VERSION_MINOR == 3) && (PETSC_VERSION_SUBMINOR < 2) _try(MatAYPX(M2->M, tmp, M1->M)); #else _try(MatAYPX(M2->M, tmp, M1->M, DIFFERENT_NONZERO_PATTERN)); #endif else Message::Error("Wrong arguments in 'LinAlg_AddMatrixProdMatrixDouble'"); } void LinAlg_SubScalarScalar(gScalar *S1, gScalar *S2, gScalar *S3) { S3->s = S1->s - S2->s; } void LinAlg_SubVectorVector(gVector *V1, gVector *V2, gVector *V3) { PetscScalar tmp = -1.0; if(V3 == V1){ _try(VecAXPY(V1->V, tmp, V2->V)); // V1->V = V1->V - V2->V _fillseq(V1); } else if(V3 == V2){ _try(VecAYPX(V2->V, tmp, V1->V)); // V2->V = V1->V - V2->V _fillseq(V2); } else Message::Error("Wrong arguments in 'LinAlg_SubVectorVector'"); } void LinAlg_SubMatrixMatrix(gMatrix *M1, gMatrix *M2, gMatrix *M3) { PetscScalar tmp = -1.0; if(M3 == M1) // M1->M = M1->M - M2->M _try(MatAXPY(M1->M, tmp, M2->M, DIFFERENT_NONZERO_PATTERN)); else if(M3 == M2) // M2->M = M1->M - M2->M _try(MatAYPX(M2->M, tmp, M1->M, DIFFERENT_NONZERO_PATTERN)); else Message::Error("Wrong arguments in 'LinAlg_SubMatrixMatrix'"); } void LinAlg_ProdScalarScalar(gScalar *S1, gScalar *S2, gScalar *S3) { S3->s = S1->s * S2->s; } void LinAlg_ProdScalarDouble(gScalar *S1, double d, gScalar *S2) { S2->s = S1->s * d; } void LinAlg_ProdScalarComplex(gScalar *S, double d1, double d2, double *d3, double *d4) { #if defined(PETSC_USE_COMPLEX) PetscScalar tmp; #endif #if defined(PETSC_USE_COMPLEX) tmp = S->s * (d1 + PETSC_i * d2); *d3 = real(tmp); *d4 = imag(tmp); #else *d3 = S->s * d1; *d4 = S->s * d2; #endif } void LinAlg_ProdVectorScalar(gVector *V1, gScalar *S, gVector *V2) { if(V2 == V1){ _try(VecScale(V1->V, S->s)); _fillseq(V1); } else Message::Error("Wrong arguments in 'LinAlg_ProdVectorScalar'"); } void LinAlg_ProdVectorDouble(gVector *V1, double d, gVector *V2) { PetscScalar tmp = d; if(V2 == V1){ _try(VecScale(V1->V, tmp)); _fillseq(V1); } else Message::Error("Wrong arguments in 'LinAlg_ProdVectorDouble'"); } void LinAlg_ProdVectorComplex(gVector *V1, double d1, double d2, gVector *V2) { Message::Error("ProdVectorComplex not yet implemented"); } void LinAlg_ProdVectorVector(gVector *V1, gVector *V2, double *d) { PetscScalar tmp; _try(VecDot(V1->V, V2->V, &tmp)); #if defined(PETSC_USE_COMPLEX) *d = real(tmp); #else *d = tmp; #endif } void LinAlg_ProdMatrixVector(gMatrix *M, gVector *V1, gVector *V2) { if(V2 == V1) Message::Error("Wrong arguments in 'LinAlg_ProdMatrixVector'"); else{ _try(MatMult(M->M, V1->V, V2->V)); _fillseq(V2); } } void LinAlg_ProdMatrixScalar(gMatrix *M1, gScalar *S, gMatrix *M2) { if(M2 == M1) _try(MatScale(M1->M, S->s)); else Message::Error("Wrong arguments in 'LinAlg_ProdMatrixScalar'"); } void LinAlg_ProdMatrixDouble(gMatrix *M1, double d, gMatrix *M2) { PetscScalar tmp = d; if(M2 == M1) _try(MatScale(M1->M, tmp)); else Message::Error("Wrong arguments in 'LinAlg_ProdMatrixDouble'"); } void LinAlg_ProdMatrixComplex(gMatrix *M1, double d1, double d2, gMatrix *M2) { #if defined(PETSC_USE_COMPLEX) if(M2 == M1){ PetscScalar tmp = d1 + (PETSC_i * d2); _try(MatScale(M1->M, tmp)); } else Message::Error("Wrong arguments in 'LinAlg_ProdMatrixDouble'"); #else Message::Error("ProdMatrixComplex not yet implemented"); #endif } void LinAlg_DivScalarScalar(gScalar *S1, gScalar *S2, gScalar *S3) { S3->s = S1->s / S2->s; } void LinAlg_DivScalarDouble(gScalar *S1, double d, gScalar *S2) { S2->s = S1->s / d; } void LinAlg_VectorNorm2(gVector *V1, double *norm) { PetscReal tmp; _try(VecNorm(V1->V, NORM_2, &tmp)); *norm = tmp; } void LinAlg_VectorNormInf(gVector *V1, double *norm) { PetscReal tmp; _try(VecNorm(V1->V, NORM_INFINITY, &tmp)); *norm = tmp; } void LinAlg_AssembleMatrix(gMatrix *M) { Message::Barrier(); _try(MatAssemblyBegin(M->M, MAT_FINAL_ASSEMBLY)); _try(MatAssemblyEnd(M->M, MAT_FINAL_ASSEMBLY)); } void LinAlg_AssembleVector(gVector *V) { Message::Barrier(); _try(VecAssemblyBegin(V->V)); _try(VecAssemblyEnd(V->V)); _fillseq(V); } #if defined(HAVE_ZITSOL) extern "C" { int getdp_zitsol(int n, int nnz, int *row, int *col, double *valr, double *vali, double *rhsr, double *rhsi, double *solr, double *soli, int precond, int lfil, double tol0, double tol, int im, int maxits); } static void _zitsol(gMatrix *A, gVector *B, gVector *X) { int precond = 1, lfil = 30, im = 100, maxits = 200; double tol0 = 0.01, tol = 1e-10; PetscTruth set; PetscOptionsGetInt(PETSC_NULL, "-zitsol_precond", &precond, &set); PetscOptionsGetInt(PETSC_NULL, "-zitsol_lfil", &lfil, &set); PetscOptionsGetInt(PETSC_NULL, "-zitsol_im", &im, &set); PetscOptionsGetInt(PETSC_NULL, "-zitsol_maxits", &maxits, &set); PetscOptionsGetReal(PETSC_NULL, "-zitsol_tol0", &tol0, &set); PetscOptionsGetReal(PETSC_NULL, "-zitsol_tol", &tol, &set); MatInfo info; _try(MatGetInfo(A->M, MAT_LOCAL, &info)); int nnz = info.nz_used; //int n = info.rows_local; PetscInt n; _try(VecGetLocalSize(B->V, &n)); int *row = (int*)Malloc(nnz * sizeof(int)); int *col = (int*)Malloc(nnz * sizeof(int)); double *valr = (double*)Malloc(nnz * sizeof(double)); double *vali = (double*)Malloc(nnz * sizeof(double)); double *rhsr = (double*)Malloc(n * sizeof(double)); double *rhsi = (double*)Malloc(n * sizeof(double)); double *solr = (double*)Malloc(n * sizeof(double)); double *soli = (double*)Malloc(n * sizeof(double)); int k = 0; for(int i = 0; i < n; i++){ PetscInt ncols; const PetscInt *cols; const PetscScalar *vals; _try(MatGetRow(A->M, i, &ncols, &cols, &vals)); for(int j = 0; j < ncols; j++){ if(k >= nnz){ Message::Error("Something wrong in nnz: %d >= %d", k, nnz); return; } row[k] = i; col[k] = cols[j]; Message::Debug("A[%d][%d] = ", row[k], col[k]); #if defined(PETSC_USE_COMPLEX) valr[k] = real(vals[j]); vali[k] = imag(vals[j]); Message::Debug("%g+i*%g", valr[k], vali[k]); #else valr[k] = vals[j]; vali[k] = 0.; Message::Debug("%g", valr[k]); #endif k++; } _try(MatRestoreRow(A->M, i, &ncols, &cols, &vals)); } Message::Info("n = %d, nnz = %d (check k = %d)", n, nnz, k); PetscScalar *b, *x; _try(VecGetArray(B->V, &b)); _try(VecGetArray(X->V, &x)); for(int i = 0; i < n; i++){ #if defined(PETSC_USE_COMPLEX) rhsr[i] = real(b[i]); rhsi[i] = imag(b[i]); solr[i] = real(x[i]); soli[i] = imag(x[i]); #else rhsr[i] = b[i]; rhsi[i] = 0.; solr[i] = x[i]; soli[i] = 0.; #endif } _try(VecRestoreArray(B->V, &b)); _try(VecRestoreArray(X->V, &x)); int its = getdp_zitsol(n, nnz, row, col, valr, vali, rhsr, rhsi, solr, soli, precond, lfil, tol0, tol, im, maxits); if(its >= maxits) Message::Error("Did not converge in %d iterations", maxits); else Message::Info("Converged in %d iterations", its); Current.KSPIts = its; for(PetscInt i = 0; i < n; i++){ PetscScalar d; #if defined(PETSC_USE_COMPLEX) d = solr[i] + PETSC_i * soli[i]; #else d = solr[i]; #endif _try(VecSetValues(X->V, 1, &i, &d, INSERT_VALUES)); } Free(row); Free(col); Free(valr); Free(vali); Free(rhsr); Free(rhsi); Free(solr); Free(soli); } #endif static PetscErrorCode _myKspMonitor(KSP ksp, PetscInt it, PetscReal rnorm, void *mctx) { Message::Info("%3ld KSP Residual norm %14.12e", (long)it, rnorm); // Current.KSPResidual = rnorm; return 0; } static void _solve(gMatrix *A, gVector *B, gSolver *Solver, gVector *X, int precond, int kspIndex) { #if defined(HAVE_ZITSOL) // testing Yousef's new preconditioners and solvers PetscTruth set, zitsol = PETSC_FALSE; PetscOptionsGetTruth(PETSC_NULL, "-zitsol", &zitsol, &set); if(zitsol){ _zitsol(A, B, X); return; } #endif if(kspIndex < 0 || kspIndex > 9){ Message::Error("Linear Solver index out of range (%d)", kspIndex); return; } PetscInt i, j; _try(MatGetSize(A->M, &i, &j)); if(!i){ Message::Warning("Zero-size system: skipping solve!"); return; } int view = !Solver->ksp[kspIndex]; if(kspIndex != 0) Message::Info("Using solver index %d", kspIndex); if(!Solver->ksp[kspIndex]) { _try(KSPCreate(MyComm, &Solver->ksp[kspIndex])); #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 5))) _try(KSPSetOperators(Solver->ksp[kspIndex], A->M, A->M)); #else _try(KSPSetOperators(Solver->ksp[kspIndex], A->M, A->M, DIFFERENT_NONZERO_PATTERN)); #endif _try(KSPMonitorSet(Solver->ksp[kspIndex], _myKspMonitor, PETSC_NULL, PETSC_NULL)); PC pc; _try(KSPGetPC(Solver->ksp[kspIndex], &pc)); // set some default options: use direct solver (PARDISO, MUMPS, UMFPACK, or // native PETSc LU) _try(KSPSetType(Solver->ksp[kspIndex], "preonly")); _try(PCSetType(pc, PCLU)); #if (PETSC_VERSION_MAJOR > 2) && defined(PETSC_HAVE_MUMPS) _try(PCFactorSetMatSolverPackage(pc, "mumps")); #elif (PETSC_VERSION_MAJOR > 2) && defined(PETSC_HAVE_MKL_PARDISO) _try(PCFactorSetMatSolverPackage(pc, "mkl_pardiso")); #elif (PETSC_VERSION_MAJOR > 2) && (defined(PETSC_HAVE_UMFPACK) || defined(PETSC_HAVE_SUITESPARSE)) _try(PCFactorSetMatSolverPackage(pc, "umfpack")); #else _try(PetscOptionsSetValue("-pc_factor_nonzeros_along_diagonal", "1e-12")); #if (PETSC_VERSION_MAJOR == 2) && (PETSC_VERSION_MINOR == 3) && (PETSC_VERSION_SUBMINOR < 3) _try(PCFactorSetMatOrdering(pc, MATORDERING_RCM)); #else _try(PCFactorSetMatOrderingType(pc, MATORDERINGRCM)); #endif #endif // override the default options with the ones from the option database (if // any) _try(KSPSetFromOptions(Solver->ksp[kspIndex])); if(view && (!Message::GetCommRank() || !Message::GetIsCommWorld())){ // either we are on parallel (!GetIsCommWorld) or in sequential with rank // = 0 (GetIsCommWorld) #if (PETSC_VERSION_RELEASE == 0) || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 4)) const char *ksptype = ""; _try(KSPGetType(Solver->ksp[kspIndex], &ksptype)); const char *pctype = ""; _try(PCGetType(pc, &pctype)); #else const KSPType ksptype; _try(KSPGetType(Solver->ksp[kspIndex], &ksptype)); const PCType pctype; _try(PCGetType(pc, &pctype)); #endif #if (PETSC_VERSION_MAJOR > 2) const MatSolverPackage stype; _try(PCFactorGetMatSolverPackage(pc, &stype)); #else const char *stype = ""; #endif Message::Info("N: %ld - %s %s %s", (long)i, ksptype, pctype, stype); } } else if(precond){ #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 5))) _try(KSPSetOperators(Solver->ksp[kspIndex], A->M, A->M)); #else _try(KSPSetOperators(Solver->ksp[kspIndex], A->M, A->M, DIFFERENT_NONZERO_PATTERN)); #endif } else{ #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 5))) _try(KSPSetReusePreconditioner(Solver->ksp[kspIndex], PETSC_TRUE)); #endif } _try(KSPSolve(Solver->ksp[kspIndex], B->V, X->V)); // copy result on all procs _fillseq(X); if(view && Message::GetVerbosity() > 5) _try(KSPView(Solver->ksp[kspIndex], MyPetscViewer)); PetscInt its; _try(KSPGetIterationNumber(Solver->ksp[kspIndex], &its)); if(!Message::GetCommRank() || !Message::GetIsCommWorld()){ if(its > 1) Message::Info("%d iterations", its); } Current.KSPIts = its; } void LinAlg_Solve(gMatrix *A, gVector *B, gSolver *Solver, gVector *X, int solverIndex) { _solve(A, B, Solver, X, 1, solverIndex); } void LinAlg_SolveAgain(gMatrix *A, gVector *B, gSolver *Solver, gVector *X, int solverIndex) { _solve(A, B, Solver, X, 0, solverIndex); } void LinAlg_SetGlobalSolverOptions(const std::string &opt) { _try(PetscOptionsInsertString(opt.c_str())); } extern void Generate_Residual (gVector *x, gVector *f) ; extern void Generate_FullJacobian (gVector *x, gMatrix *Jac) ; static PetscErrorCode _NLFormFunction(SNES snes, Vec x, Vec f, void *mctx) { gVector gx, gf ; gx.V = x ; gx.haveSeq = 0; gf.V = f ; gf.haveSeq = 0; Generate_Residual(&gx, &gf) ; PetscScalar *ff ; _try(VecGetArray(gf.V, &ff)) ; PetscInt n; _try(VecGetSize(f, &n)) ; for(PetscInt i = 0; i < n; i++) _try(VecSetValues(f, 1, &i, &ff[i], INSERT_VALUES)); _try(VecGetArray(f, &ff)); return 0; } #if (PETSC_VERSION_MAJOR == 2) || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR < 5)) static PetscErrorCode _NLFormJacobian(SNES snes, Vec x, Mat *J, Mat *PC, MatStructure *flag, void *mctx) { gVector gx ; gx.V = x ; gx.haveSeq = 0; gMatrix gJ ; gJ.M = *J ; Generate_FullJacobian(&gx, &gJ); *J = gJ.M ; *flag = DIFFERENT_NONZERO_PATTERN ; Message::Barrier(); _try(MatAssemblyBegin(*J, MAT_FINAL_ASSEMBLY)); _try(MatAssemblyEnd(*J, MAT_FINAL_ASSEMBLY)); if (*PC != *J){ _try(MatAssemblyBegin(*PC, MAT_FINAL_ASSEMBLY)); _try(MatAssemblyEnd(*PC, MAT_FINAL_ASSEMBLY)); } return 0; } #else static PetscErrorCode _NLFormJacobian(SNES snes, Vec x, Mat J, Mat PC, void *mctx) { gVector gx ; gx.V = x ; gx.haveSeq = 0; gMatrix gJ ; Generate_FullJacobian(&gx, &gJ); //J = gJ.M; MatCopy(gJ.M, J, SAME_NONZERO_PATTERN); //Message::Barrier(); return 0; } #endif static PetscErrorCode _mySnesMonitor(SNES snes, PetscInt it, PetscReal rnorm, void *mctx) { Message::Info("%3ld SNES Residual norm %14.12e", (long)it, rnorm); return 0; } static void _solveNL(gMatrix *A, gVector *B, gMatrix *J, gVector *R, gSolver *Solver, gVector *X, int precond, int solverIndex) { if(solverIndex < 0 || solverIndex > 9){ Message::Error("NonLinear Solver index out of range (%d)", solverIndex); return; } PetscInt n, m; _try(MatGetSize(J->M, &n, &m)); if(!n){ Message::Warning("Zero-size jacobian: skipping solve!"); return; } bool view = !Solver->snes[solverIndex]; // either we are on sequential (!GetIsCommWorld) or in parallel with rank = 0 // (GetIsCommWorld) if(view && (!Message::GetCommRank() || !Message::GetIsCommWorld())) Message::Info("N: %ld", (long)n); if(solverIndex != 0) Message::Info("Using nonlinear solver index %d", solverIndex); // Setting nonlinear solver defaults if(!Solver->snes[solverIndex]) { _try(SNESCreate(MyComm, &Solver->snes[solverIndex])); _try(SNESMonitorSet(Solver->snes[solverIndex], _mySnesMonitor, PETSC_NULL, PETSC_NULL)); _try(SNESSetTolerances(Solver->snes[solverIndex], 1.e-12, PETSC_DEFAULT, PETSC_DEFAULT, PETSC_DEFAULT, PETSC_DEFAULT)); // override default options with those from database (if any) _try(SNESSetFromOptions(Solver->snes[solverIndex])); PetscTruth fd_jacobian = PETSC_FALSE, snes_fd = PETSC_FALSE ; PetscOptionsGetTruth(PETSC_NULL, "-fd_jacobian", &fd_jacobian, 0); PetscOptionsGetTruth(PETSC_NULL, "-snes_fd", &snes_fd, 0); if (fd_jacobian || snes_fd) { // Message::Error("Finite Difference Jacobian not yet implemented"); #if (PETSC_VERSION_RELEASE == 0) || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 4)) _try(SNESSetJacobian(Solver->snes[solverIndex], J->M, J->M, SNESComputeJacobianDefault, PETSC_NULL)); #else _try(SNESSetJacobian(Solver->snes[solverIndex], J->M, J->M, SNESDefaultComputeJacobian, PETSC_NULL)); #endif } else { Message::Info("Jacobian computed by GetDP"); _try(SNESSetJacobian(Solver->snes[solverIndex], J->M, J->M, _NLFormJacobian, PETSC_NULL)); } _try(SNESSetFunction(Solver->snes[solverIndex], R->V, _NLFormFunction, PETSC_NULL)); // R(x) = A(x)*x-b } KSP ksp; SNESGetKSP(Solver->snes[solverIndex], &ksp); PC pc; _try(KSPGetPC(ksp, &pc)); _try(KSPSetType(ksp, "preonly")); _try(PCSetType(pc, PCLU)); #if (PETSC_VERSION_MAJOR > 2) && defined(PETSC_HAVE_MUMPS) _try(PCFactorSetMatSolverPackage(pc, "mumps")); #endif _try(SNESSolve(Solver->snes[solverIndex], PETSC_NULL, X->V)); // copy result on all procs _fillseq(X); if(view && Message::GetVerbosity() > 5) _try(SNESView(Solver->snes[solverIndex], MyPetscViewer)); if(!Message::GetCommRank() || !Message::GetIsCommWorld()){ PetscInt its; _try(SNESGetIterationNumber(Solver->snes[solverIndex], &its)); Message::Info("Number of Newton iterations %d", its); } } void LinAlg_SolveNL(gMatrix *A, gVector *B, gMatrix *J, gVector *R, gSolver *Solver, gVector *X, int solverIndex) { _solveNL(A, B, J, R, Solver, X, 1, solverIndex); } #endif getdp-2.7.0-source/Legacy/BF_Volume.cpp000644 001750 001750 00000004466 12473553042 021346 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "ProData.h" #include "Message.h" /* ------------------------------------------------------------------------ */ /* B F _ V o l u m e */ /* ------------------------------------------------------------------------ */ #define WrongNumVolume Message::Error("Wrong Volume number in 'BF_Volume'") void BF_Volume(struct Element * Element, int NumVolume, double u, double v, double w, double *s) { switch (Element->Type) { case POINT : switch(NumVolume) { case 1 : *s = 1. ; break ; default : WrongNumVolume ; } break ; case LINE : switch(NumVolume) { case 1 : *s = 0.5 ; break ; default : WrongNumVolume ; } break ; case TRIANGLE : switch(NumVolume) { case 1 : *s = 2. ; break ; default : WrongNumVolume ; } break ; case QUADRANGLE : switch(NumVolume) { case 1 : *s = 0.25 ; break ; default : WrongNumVolume ; } break ; case TETRAHEDRON : switch(NumVolume) { case 1 : *s = 6. ; break ; default : WrongNumVolume ; } break ; case HEXAHEDRON : switch(NumVolume) { case 1 : *s = 0.125 ; break ; default : WrongNumVolume ; } break ; case PRISM : switch(NumVolume) { case 1 : *s = 1. ; break ; default : WrongNumVolume ; } break ; case PYRAMID : switch(NumVolume) { case 1 : *s = 3./4. ; break ; default : WrongNumVolume ; } break ; default : Message::Error("Unknown type of Element in BF_Volume"); break ; } } #undef WrongNumVolume void BF_VolumeX(struct Element * Element, int NumVolume, double u, double v, double w, double *s) { s[1] = s[2] = 0.; BF_Volume (Element, NumVolume, u, v, w, &s[0]) ; } void BF_VolumeY(struct Element * Element, int NumVolume, double u, double v, double w, double *s) { s[0] = s[2] = 0.; BF_Volume (Element, NumVolume, u, v, w, &s[1]) ; } void BF_VolumeZ(struct Element * Element, int NumVolume, double u, double v, double w, double *s) { s[0] = s[1] = 0.; BF_Volume (Element, NumVolume, u, v, w, &s[2]) ; } getdp-2.7.0-source/Legacy/Cal_Quantity.cpp000644 001750 001750 00000120667 12531661502 022123 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include #include #include "ProData.h" #include "GeoData.h" #include "DofData.h" #include "F.h" #include "Cal_Quantity.h" #include "Cal_Value.h" #include "Get_Geometry.h" #include "Pos_FemInterpolation.h" #include "Pos_Search.h" #include "Get_FunctionValue.h" #include "MallocUtils.h" #include "Message.h" #include "Pos_Format.h" extern struct Problem Problem_S ; extern struct CurrentData Current ; extern int TreatmentStatus ; /* ------------------------------------------------------------------------ */ /* G e t _ V a l u e O f E x p r e s s i o n */ /* ------------------------------------------------------------------------ */ void Get_ValueOfExpression(struct Expression * Expression_P, struct QuantityStorage * QuantityStorage_P0, double u, double v, double w, struct Value * Value, int NbrArguments, char *CallingExpressionName) { int k ; struct ExpressionPerRegion * ExpressionPerRegion_P ; static char *Flag_WarningUndefined = NULL ; switch (Expression_P->Type) { case CONSTANT : if (Current.NbrHar == 1) { Value->Val[0] = Expression_P->Case.Constant ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { Value->Val[MAX_DIM* k ] = Expression_P->Case.Constant ; Value->Val[MAX_DIM*(k+1)] = 0. ; } } Value->Type = SCALAR ; break ; case WHOLEQUANTITY : Cal_WholeQuantity(Current.Element, QuantityStorage_P0, Expression_P->Case.WholeQuantity, u,v,w, -1, 0, Value, NbrArguments, CallingExpressionName ? CallingExpressionName : Expression_P->Name) ; break ; case PIECEWISEFUNCTION : if (Current.Region != Expression_P->Case.PieceWiseFunction.NumLastRegion) { if ((ExpressionPerRegion_P = (struct ExpressionPerRegion*) List_PQuery(Expression_P->Case.PieceWiseFunction.ExpressionPerRegion, &Current.Region, fcmp_int))) { Expression_P->Case.PieceWiseFunction.NumLastRegion = Current.Region ; Expression_P->Case.PieceWiseFunction.ExpressionForLastRegion = (struct Expression*)List_Pointer(Problem_S.Expression, ExpressionPerRegion_P->ExpressionIndex) ; } else { if(Current.Region == NO_REGION) Message::Error("Function '%s' undefined in expressions without support", Expression_P->Name); else Message::Error("Function '%s' undefined in Region %d", Expression_P->Name, Current.Region); } } Get_ValueOfExpression (Expression_P->Case.PieceWiseFunction.ExpressionForLastRegion, QuantityStorage_P0, u, v, w, Value, NbrArguments, Expression_P->Name) ; break ; case UNDEFINED_EXP : if(!Flag_WarningUndefined || strcmp(Flag_WarningUndefined, Expression_P->Name)){ Message::Warning("Undefined expression '%s' (assuming zero)", Expression_P->Name) ; Flag_WarningUndefined = Expression_P->Name; } Cal_ZeroValue(Value); Value->Type = SCALAR ; break; default : Message::Error("Unknown type (%d) of Expression (%s)", Expression_P->Type, Expression_P->Name) ; break; } } /* ------------------------------------------------------------------------ */ /* G e t _ V a l u e O f E x p r e s s i o n B y I n d e x */ /* ------------------------------------------------------------------------ */ void Get_ValueOfExpressionByIndex(int Index_Expression, struct QuantityStorage * QuantityStorage_P0, double u, double v, double w, struct Value * Value) { Get_ValueOfExpression ((struct Expression *)List_Pointer(Problem_S.Expression, Index_Expression), QuantityStorage_P0, u, v, w, Value) ; } /* ------------------------------------------------------------------------ */ /* C a l _ S o l i d A n g l e */ /* ------------------------------------------------------------------------ */ void Cal_SolidAngle(int Source, struct Element *Element, struct QuantityStorage *QuantityStorage, int Nbr_Dof, int Index, struct Value **Stack) { struct Element *Elt ; struct Geo_Element *GeoElement ; struct Geo_Node *GeoNode1, *GeoNode2, *GeoNode3 ; double X, Y, Atan ; int In, TypEnt, NumNode, NbrElements, *NumElements ; int i, j ; if(Nbr_Dof != QuantityStorage->NbrElementaryBasisFunction){ Message::Error("Uncompatible Quantity (%s) in SolidAngle computation", QuantityStorage->DefineQuantity->Name); return; } if(Source){ Elt = Element->ElementSource ; In = Current.SourceIntegrationSupportIndex ; } else{ Elt = Element ; In = Current.IntegrationSupportIndex ; } if (Elt->NumLastElementForSolidAngle == Elt->Num) { for(i=0 ; iangle[i] ; } return; } for(i=0 ; iBasisFunction[i]. BasisFunction->EntityIndex))->FunctionType ; if(TypEnt != NODESOF){ if(Elt->Type == LINE){ Stack[i][Index].Val[0] = M_PI ; } else{ Stack[i][Index].Val[0] = 2.*M_PI ; } } else{ NumNode = Elt->GeoElement-> NumNodes[QuantityStorage->BasisFunction[i].NumEntityInElement] ; Geo_CreateNodesXElements(NumNode, In, &NbrElements, &NumElements) ; if(NbrElements != 2){ Message::Error("SolidAngle not done for incidence != 2 (%d)", NbrElements); return; } GeoNode2 = Geo_GetGeoNodeOfNum(NumNode) ; GeoElement = Geo_GetGeoElementOfNum(abs(NumElements[0])) ; if(GeoElement->Type != LINE){ Message::Error("SolidAngle not done for Elements other than LINE"); return; } if(NumElements[0]>0){ GeoNode1 = Geo_GetGeoNodeOfNum(GeoElement->NumNodes[0]) ; GeoElement = Geo_GetGeoElementOfNum(abs(NumElements[1])) ; GeoNode3 = Geo_GetGeoNodeOfNum(GeoElement->NumNodes[1]) ; } else{ GeoNode3 = Geo_GetGeoNodeOfNum(GeoElement->NumNodes[1]) ; GeoElement = Geo_GetGeoElementOfNum(NumElements[1]) ; GeoNode1 = Geo_GetGeoNodeOfNum(GeoElement->NumNodes[0]) ; } Y = (GeoNode1->y - GeoNode2->y) * (GeoNode3->x - GeoNode2->x) - (GeoNode1->x - GeoNode2->x) * (GeoNode3->y - GeoNode2->y) ; X = (GeoNode1->x - GeoNode2->x) * (GeoNode3->x - GeoNode2->x) + (GeoNode1->y - GeoNode2->y) * (GeoNode3->y - GeoNode2->y) ; Atan = atan2(Y,X) ; Stack[i][Index].Val[0] = (Atan >= 0) ? Atan : (Atan+2.*M_PI) ; if(Message::GetVerbosity() > 5){ printf("Solid angle=%g node=%d, region=%s, elms=", Stack[i][Index].Val[0] * 180/M_PI, NumNode, ((struct Group*)List_Pointer(Problem_S.Group, In))->Name); for(j=0 ; jNumLastElementForSolidAngle != Elt->Num) { Elt->NumLastElementForSolidAngle = Elt->Num ; for(i=0 ; iangle[i] = Stack[i][Index].Val[0] ; } } /* ------------------------------------------------------------------------ */ /* C a l _ W h o l e Q u a n t i t y */ /* ------------------------------------------------------------------------ */ #define CAST3V void(*)(struct Value*, struct Value*, struct Value*) #define CAST1V void(*)(struct Value*) #define CASTF2V void(*)(struct Function*, struct Value*, struct Value*) // There can be at max one "Dof{op qty}" per WholeQuantity, but as // many {op qty} as you want. static std::map ValueSaved ; static std::map NamedValueSaved ; void Cal_WholeQuantity(struct Element * Element, struct QuantityStorage * QuantityStorage_P0, List_T * WholeQuantity_L, double u, double v, double w, int DofIndexInWholeQuantity, int Nbr_Dof, struct Value DofValue[], int NbrArguments, char *ExpressionName) { static int Flag_WarningMissSolForDt = 0 ; static int Flag_WarningMissSolForTime_ntime = 0 ; static int Flag_InfoForTime_ntime = 0 ; int i_WQ, j, k, Flag_True, Index, DofIndex, Multi[MAX_STACK_SIZE] ; int Save_NbrHar, Save_Region, Type_Dimension, ntime ; double Save_Time, Save_TimeImag, Save_TimeStep, X, Y, Z, Order ; double Save_x, Save_y, Save_z ; struct WholeQuantity *WholeQuantity_P0, *WholeQuantity_P ; struct DofData *Save_DofData ; struct Solution *Solution_P0, *Solution_PN ; struct Element* Save_CurrentElement ; // we could make this dynamic (with std::vector) to reduce stack usage, but // the performance hit is important struct Value Stack[8][MAX_STACK_SIZE] ; WholeQuantity_P0 = (struct WholeQuantity*)List_Pointer(WholeQuantity_L, 0) ; Index = 0 ; DofIndex = -1 ; for (i_WQ = 0 ; i_WQ < List_Nbr(WholeQuantity_L) ; i_WQ++) { if(Index >= MAX_STACK_SIZE){ Message::Error("Stack size exceeded (%d)", MAX_STACK_SIZE); return; } WholeQuantity_P = WholeQuantity_P0 + i_WQ ; switch (WholeQuantity_P->Type) { case WQ_OPERATORANDQUANTITY : /* {op qty} Dof{op qty} BF{op qty} */ Save_Region = Current.Region ; Save_CurrentElement = Current.Element ; if (i_WQ != DofIndexInWholeQuantity){ /* Attention!!! || TreatmentStatus == _POS){ */ Pos_FemInterpolation (Element, QuantityStorage_P0, QuantityStorage_P0 + WholeQuantity_P->Case.OperatorAndQuantity.Index, WholeQuantity_P->Case.OperatorAndQuantity.TypeQuantity, WholeQuantity_P->Case.OperatorAndQuantity.TypeOperator, -1, 0, u, v, w, 0, 0, 0, Stack[0][Index].Val, &Stack[0][Index].Type, 1) ; Multi[Index] = 0 ; } else { DofIndex = Index ; } Index++ ; Current.Element = Save_CurrentElement ; Current.Region = Save_Region ; break ; case WQ_ORDER : /* Order[{qty}] */ Order = Cal_InterpolationOrder (Element, QuantityStorage_P0 + WholeQuantity_P->Case.OperatorAndQuantity.Index) ; for (k = 0 ; k < Current.NbrHar ; k += 2) { Stack[0][Index].Val[MAX_DIM* k ] = Order ; Stack[0][Index].Val[MAX_DIM*(k+1)] = 0. ; } Stack[0][Index].Type = SCALAR ; Multi[Index] = 0 ; Index++ ; break ; case WQ_OPERATORANDQUANTITYEVAL : Save_Region = Current.Region ; Save_CurrentElement = Current.Element ; /* {op qty}[x,y,z], {op qty}[x,y,z,dimension] or {op qty}[Vector[x,y,x],dimension] or {op qty}[ntime] */ if (i_WQ != DofIndexInWholeQuantity || TreatmentStatus == _POS){ j = WholeQuantity_P->Case.OperatorAndQuantity.NbrArguments; if (j == 2 || j == 3 || j == 4) { if (j == 3 || j == 4) { Index -= j ; X = Stack[0][Index ].Val[0] ; Y = Stack[0][Index+1].Val[0] ; Z = Stack[0][Index+2].Val[0] ; if(j == 4) Type_Dimension = (int)Stack[0][Index+3].Val[0] ; else Type_Dimension = -1 ; } else { /* j==2 */ Index -= j ; X = Stack[0][Index ].Val[0] ; Y = Stack[0][Index ].Val[1] ; Z = Stack[0][Index ].Val[2] ; Type_Dimension = (int)Stack[0][Index+1].Val[0] ; } Pos_FemInterpolation (Element, QuantityStorage_P0, QuantityStorage_P0 + WholeQuantity_P->Case.OperatorAndQuantity.Index, WholeQuantity_P->Case.OperatorAndQuantity.TypeQuantity, WholeQuantity_P->Case.OperatorAndQuantity.TypeOperator, Type_Dimension, 1, u, v, w, X, Y, Z, Stack[0][Index].Val, &Stack[0][Index].Type, 1) ; Multi[Index] = 0 ; Index++ ; } else if (j == 1) { Index -= j ; ntime = (int)Stack[0][Index].Val[0] ; for (k = 0 ; k < Current.NbrSystem ; k++){ Solution_P0 = (struct Solution*)List_Pointer((Current.DofData_P0+k)->Solutions, 0); if(((Current.DofData_P0+k)->CurrentSolution - Solution_P0) >= ntime){ ((Current.DofData_P0+k)->CurrentSolution) -= ntime ; if (Flag_InfoForTime_ntime != List_Nbr((Current.DofData_P0+k)->Solutions)) { Message::Debug("Accessing solution from %d time steps ago", ntime); Message::Debug(" -> System %d/%d: TimeStep = %d, Time = %g + i * %g", k+1, Current.NbrSystem, (Current.DofData_P0+k)->CurrentSolution->TimeStep, (Current.DofData_P0+k)->CurrentSolution->Time, (Current.DofData_P0+k)->CurrentSolution->TimeImag); Flag_InfoForTime_ntime = List_Nbr((Current.DofData_P0+k)->Solutions); } } else { if (!Flag_WarningMissSolForTime_ntime) { Message::Warning("Missing solution for time step -%d computation (System #%d/%d)", ntime, k+1, Current.NbrSystem); Flag_WarningMissSolForTime_ntime = 1 ; } } } Pos_FemInterpolation (Element, QuantityStorage_P0, QuantityStorage_P0 + WholeQuantity_P->Case.OperatorAndQuantity.Index, WholeQuantity_P->Case.OperatorAndQuantity.TypeQuantity, WholeQuantity_P->Case.OperatorAndQuantity.TypeOperator, -1, 0, u, v, w, 0, 0, 0, Stack[0][Index].Val, &Stack[0][Index].Type, 1) ; Multi[Index] = 0 ; Index++ ; for (k = 0 ; k < Current.NbrSystem ; k++){ Solution_PN = (struct Solution*) List_Pointer((Current.DofData_P0+k)->Solutions, List_Nbr((Current.DofData_P0+k)->Solutions)-1); if((Solution_PN - (Current.DofData_P0+k)->CurrentSolution) >= ntime) ((Current.DofData_P0+k)->CurrentSolution) += ntime ; } } else Message::Error("Explicit (x,y,z,time) evaluation not implemented"); } else{ Message::Error("Explicit Dof{} evaluation out of context"); } Current.Element = Save_CurrentElement ; Current.Region = Save_Region ; break ; case WQ_TRACE : /* Trace[WholeQuantity, Group] */ Save_Region = Current.Region ; if(!Element->ElementTrace){ Message::Error("Trace must act on discrete quantity (and not in post-processing)"); break; } Current.Region = Element->ElementTrace->Region ; if(WholeQuantity_P->Case.Trace.DofIndexInWholeQuantity >= 0){ Cal_WholeQuantity(Element->ElementTrace, QuantityStorage_P0, WholeQuantity_P->Case.Trace.WholeQuantity, Current.ut, Current.vt, Current.wt, WholeQuantity_P->Case.Trace.DofIndexInWholeQuantity, Nbr_Dof, DofValue, NbrArguments, ExpressionName) ; DofIndexInWholeQuantity = DofIndex = Index ; } else{ Current.x = Current.y = Current.z = 0. ; for (j = 0 ; j < Element->GeoElement->NbrNodes ; j++) { Current.x += Element->x[j] * Element->n[j] ; Current.y += Element->y[j] * Element->n[j] ; Current.z += Element->z[j] * Element->n[j] ; } xyz2uvwInAnElement(Element->ElementTrace, Current.x, Current.y, Current.z, &Current.ut, &Current.vt, &Current.wt) ; for (j=0; jElementTrace, QuantityStorage_P0, WholeQuantity_P->Case.Trace.WholeQuantity, Current.ut, Current.vt, Current.wt, -1, 0, &Stack[0][Index], NbrArguments, ExpressionName) ; } Current.Region = Save_Region ; Multi[Index] = 0 ; Index++ ; break ; case WQ_SOLIDANGLE : /* SolidAngle[{qty}] */ Cal_SolidAngle(0, Element, QuantityStorage_P0 + WholeQuantity_P->Case.OperatorAndQuantity.Index, Nbr_Dof, Index, (struct Value **)Stack); Multi[Index] = 1 ; Index++ ; break ; case WQ_BINARYOPERATOR : /* + - * x / % ^ < > <= >= == != && || */ if (Index-2 != DofIndex && Index-1 != DofIndex){ if(!Multi[Index-1] && !Multi[Index-2]) ((CAST3V)WholeQuantity_P->Case.Operator.Function) (&Stack[0][Index-2], &Stack[0][Index-1], &Stack[0][Index-2]) ; else if(Multi[Index-1] && Multi[Index-2]) for(j=0 ; jCase.Operator.Function) (&Stack[j][Index-2], &Stack[j][Index-1], &Stack[j][Index-2]) ; else if(Multi[Index-2]) for(j=0 ; jCase.Operator.Function) (&Stack[j][Index-2], &Stack[0][Index-1], &Stack[j][Index-2]) ; else { for(j=0 ; jCase.Operator.Function) (&Stack[0][Index-2], &Stack[j][Index-1], &Stack[j][Index-2]) ; Multi[Index-2] = 1 ; } } else if (Index-1 == DofIndex) { if(Multi[Index-2]) for (j = 0 ; j < Nbr_Dof ; j++) ((CAST3V)WholeQuantity_P->Case.Operator.Function) (&Stack[j][Index-2], &DofValue[j], &DofValue[j]) ; else for (j = 0 ; j < Nbr_Dof ; j++) ((CAST3V)WholeQuantity_P->Case.Operator.Function) (&Stack[0][Index-2], &DofValue[j], &DofValue[j]) ; DofIndex-- ; } else { /* Index-2 == DofIndex */ if(Multi[Index-1]) for (j = 0 ; j < Nbr_Dof ; j++) ((CAST3V)WholeQuantity_P->Case.Operator.Function) (&DofValue[j], &Stack[j][Index-1], &DofValue[j]) ; else for (j = 0 ; j < Nbr_Dof ; j++) ((CAST3V)WholeQuantity_P->Case.Operator.Function) (&DofValue[j], &Stack[0][Index-1], &DofValue[j]) ; } Index-- ; break ; case WQ_UNARYOPERATOR : /* + - ! */ if (Index-1 == DofIndex) for (j = 0 ; j < Nbr_Dof ; j++) ((CAST1V)WholeQuantity_P->Case.Operator.Function)(&DofValue[j]) ; else if(Multi[Index-1]) for(j=0 ; jCase.Operator.Function)(&Stack[j][Index-1]) ; else ((CAST1V)WholeQuantity_P->Case.Operator.Function)(&Stack[0][Index-1]) ; break ; /* WARNING: all the rest assumes 0 multi status */ case WQ_TEST : Flag_True = (Stack[0][Index-1].Val[0] != 0.) ; for (j=0; jCase.Test.WholeQuantity_True : WholeQuantity_P->Case.Test.WholeQuantity_False, u, v, w, -1, 0, &Stack[0][Index-1], NbrArguments, ExpressionName) ; break ; case WQ_EXPRESSION : Index -= WholeQuantity_P->Case.Expression.NbrArguments ; Get_ValueOfExpression ((struct Expression*)List_Pointer (Problem_S.Expression, WholeQuantity_P->Case.Expression.Index), QuantityStorage_P0, u, v, w, &Stack[0][Index], WholeQuantity_P->Case.Expression.NbrArguments) ; Multi[Index] = 0 ; Index++ ; break ; case WQ_BUILTINFUNCTION : Index -= WholeQuantity_P->Case.Function.NbrArguments ; if (Index != DofIndex) ((CASTF2V)WholeQuantity_P->Case.Function.Fct) (&WholeQuantity_P->Case.Function, &Stack[0][Index], &Stack[0][Index]) ; else /* Dof must be the only argument, only valid with linear functions */ for (j = 0 ; j < Nbr_Dof ; j++) { Current.NumEntity = Current.NumEntities[j]; /* temp */ ((CASTF2V)WholeQuantity_P->Case.Function.Fct) (&WholeQuantity_P->Case.Function, &DofValue[j], &DofValue[j]) ; } Multi[Index] = 0 ; Index++ ; break ; case WQ_EXTERNBUILTINFUNCTION : ((CASTF2V)WholeQuantity_P->Case.Function.Fct) (&WholeQuantity_P->Case.Function, DofValue, &Stack[0][Index]) ; Multi[Index] = 0 ; Index++ ; break ; case WQ_CONSTANT : if (Current.NbrHar == 1) { Stack[0][Index].Val[0] = WholeQuantity_P->Case.Constant ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { Stack[0][Index].Val[MAX_DIM* k ] = WholeQuantity_P->Case.Constant ; Stack[0][Index].Val[MAX_DIM*(k+1)] = 0. ; } } Stack[0][Index].Type = SCALAR ; Multi[Index] = 0 ; Index++ ; break ; case WQ_CURRENTVALUE : if (Current.NbrHar == 1) { Stack[0][Index].Val[0] = *(WholeQuantity_P->Case.CurrentValue.Value) ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { Stack[0][Index].Val[MAX_DIM* k ] = *(WholeQuantity_P->Case.CurrentValue.Value) ; Stack[0][Index].Val[MAX_DIM*(k+1)] = 0. ; } } Stack[0][Index].Type = SCALAR ; Multi[Index] = 0 ; Index++ ; break ; case WQ_ARGUMENT : if (WholeQuantity_P->Case.Argument.Index > NbrArguments){ Message::Error("Function %s called with too few arguments.", ExpressionName); } Cal_CopyValue(DofValue + WholeQuantity_P->Case.Argument.Index - 1, &Stack[0][Index]) ; Multi[Index] = 0 ; Index++ ; break ; case WQ_TIMEDERIVATIVE : if (Current.TypeTime == TIME_GEAR) { for (j=0; jCase.TimeDerivative.WholeQuantity, u, v, w, -1, 0, &Stack[0][Index], NbrArguments, ExpressionName); for (k = 0 ; k < Current.NbrSystem ; k++) (Current.DofData_P0+k)->Save_CurrentSolution = (Current.DofData_P0+k)->CurrentSolution; Save_TimeStep = Current.TimeStep ; Save_Time = Current.Time ; Save_TimeImag = Current.TimeImag ; for (int n = 0; n < Current.CorrOrder; n++) { for (k = 0 ; k < Current.NbrSystem ; k++){ Solution_P0 = (struct Solution*)List_Pointer ((Current.DofData_P0+k)->Solutions, 0); if(((Current.DofData_P0+k)->CurrentSolution - Solution_P0) > 0) ((Current.DofData_P0+k)->CurrentSolution) -= 1 ; else{ Message::Error("Too few solutions for Dt with Gear's method"); break; } } Current.TimeStep = Current.DofData->CurrentSolution->TimeStep ; Current.Time = Current.DofData->CurrentSolution->Time ; Current.TimeImag = Current.DofData->CurrentSolution->TimeImag ; for (j=0; jCase.TimeDerivative.WholeQuantity, u, v, w, -1, 0, &Stack[0][Index+1], NbrArguments, ExpressionName); Cal_AddMultValue(&Stack[0][Index], &Stack[0][Index+1], -Current.aCorrCoeff[n], &Stack[0][Index]); } Cal_MultValue(&Stack[0][Index], 1./(Current.bCorrCoeff*Current.DTime), &Stack[0][Index]); for (k = 0 ; k < Current.NbrSystem ; k++) (Current.DofData_P0+k)->CurrentSolution = (Current.DofData_P0+k)->Save_CurrentSolution; Current.TimeStep = Save_TimeStep ; Current.Time = Save_Time ; Current.TimeImag = Save_TimeImag ; } else if (Current.NbrHar == 1) { for (j=0; jCase.TimeDerivative.WholeQuantity, u, v, w, -1, 0, &Stack[0][Index], NbrArguments, ExpressionName) ; for (k = 0 ; k < Current.NbrSystem ; k++){ (Current.DofData_P0+k)->Save_CurrentSolution = (Current.DofData_P0+k)->CurrentSolution; if(List_Nbr((Current.DofData_P0+k)->Solutions) > 1){ Solution_P0 = (struct Solution*)List_Pointer ((Current.DofData_P0+k)->Solutions, 0); if ((Current.DofData_P0+k)->CurrentSolution != Solution_P0) ((Current.DofData_P0+k)->CurrentSolution) -- ; } else { if (!Flag_WarningMissSolForDt) { Message::Warning("Missing solution for time derivative computation " "(Sys#%d/%d)", k+1, Current.NbrSystem); Flag_WarningMissSolForDt = 1 ; } } } Save_TimeStep = Current.TimeStep ; Save_Time = Current.Time ; Save_TimeImag = Current.TimeImag ; Current.TimeStep = Current.DofData->CurrentSolution->TimeStep ; Current.Time = Current.DofData->CurrentSolution->Time ; Current.TimeImag = Current.DofData->CurrentSolution->TimeImag ; for (j=0; jCase.TimeDerivative.WholeQuantity, u, v, w, -1, 0, &Stack[0][Index+1], NbrArguments, ExpressionName) ; Cal_SubstractValue(&Stack[0][Index], &Stack[0][Index+1], &Stack[0][Index]) ; Stack[0][Index+1].Val[0] = Save_Time - Current.Time ; Stack[0][Index+1].Type = SCALAR ; if(Stack[0][Index+1].Val[0]) Cal_DivideValue(&Stack[0][Index], &Stack[0][Index+1], &Stack[0][Index]) ; else Cal_ZeroValue(&Stack[0][Index]); for (k = 0 ; k < Current.NbrSystem ; k++) (Current.DofData_P0+k)->CurrentSolution = (Current.DofData_P0+k)->Save_CurrentSolution; Current.TimeStep = Save_TimeStep ; Current.Time = Save_Time ; Current.TimeImag = Save_TimeImag ; } else { for (j=0; jCase.TimeDerivative.WholeQuantity, u, v, w, -1, 0, &Stack[0][Index], NbrArguments, ExpressionName) ; for (k = 0 ; k < Current.NbrHar ; k += 2) { Stack[0][Index+1].Val[MAX_DIM* k ] = 0. ; Stack[0][Index+1].Val[MAX_DIM*(k+1)] = Current.DofData->Val_Pulsation[k/2] ; } Stack[0][Index+1].Type = SCALAR ; Cal_ProductValue(&Stack[0][Index], &Stack[0][Index+1], &Stack[0][Index]) ; } Multi[Index] = 0 ; Index++ ; break ; case WQ_ATANTERIORTIMESTEP : ntime = WholeQuantity_P->Case.AtAnteriorTimeStep.TimeStep ; for (k = 0 ; k < Current.NbrSystem ; k++){ Solution_P0 = (struct Solution*)List_Pointer((Current.DofData_P0+k)->Solutions, 0); if(((Current.DofData_P0+k)->CurrentSolution - Solution_P0) >= ntime){ ((Current.DofData_P0+k)->CurrentSolution) -= ntime ; if (Flag_InfoForTime_ntime != List_Nbr((Current.DofData_P0+k)->Solutions)) { Message::Info("Accessing solution from %d time steps ago", ntime); Message::Info(" -> System %d/%d: TimeStep = %d, Time = %g + i * %g", k+1, Current.NbrSystem, (Current.DofData_P0+k)->CurrentSolution->TimeStep, (Current.DofData_P0+k)->CurrentSolution->Time, (Current.DofData_P0+k)->CurrentSolution->TimeImag); Flag_InfoForTime_ntime = List_Nbr((Current.DofData_P0+k)->Solutions); } } else { if (!Flag_WarningMissSolForTime_ntime) { Message::Warning("Missing solution for time step -%d computation " "(System #%d/%d)", ntime, k+1, Current.NbrSystem); Flag_WarningMissSolForTime_ntime = 1 ; } } } Save_TimeStep = Current.TimeStep ; Save_Time = Current.Time ; Save_TimeImag = Current.TimeImag ; Current.TimeStep = Current.DofData->CurrentSolution->TimeStep ; Current.Time = Current.DofData->CurrentSolution->Time ; Current.TimeImag = Current.DofData->CurrentSolution->TimeImag ; for (j=0; jCase.AtAnteriorTimeStep.WholeQuantity, u, v, w, -1, 0, &Stack[0][Index], NbrArguments, ExpressionName) ; Current.TimeStep = Save_TimeStep ; Current.Time = Save_Time ; Current.TimeImag = Save_TimeImag ; for (k = 0 ; k < Current.NbrSystem ; k++){ Solution_PN = (struct Solution*) List_Pointer((Current.DofData_P0+k)->Solutions, List_Nbr((Current.DofData_P0+k)->Solutions)-1); if((Solution_PN - (Current.DofData_P0+k)->CurrentSolution) >= ntime) ((Current.DofData_P0+k)->CurrentSolution) += ntime ; } Multi[Index] = 0 ; Index++ ; break ; case WQ_MAXOVERTIME : if (Current.NbrHar == 1) { double time_init = WholeQuantity_P->Case.MaxOverTime.TimeInit; double time_final = WholeQuantity_P->Case.MaxOverTime.TimeFinal; /* for (k = 0 ; k < Current.NbrSystem ; k++) (Current.DofData_P0+k)->Save_CurrentSolution = (Current.DofData_P0+k)->CurrentSolution; */ Save_TimeStep = Current.TimeStep ; Save_Time = Current.Time ; Save_TimeImag = Current.TimeImag ; for (j=0; jSolutions); j++) { Current.DofData->CurrentSolution = (struct Solution*)List_Pointer((Current.DofData)->Solutions, j); //++++ Add: also for other systems! Current.TimeStep = Current.DofData->CurrentSolution->TimeStep ; Current.Time = Current.DofData->CurrentSolution->Time ; Current.TimeImag = Current.DofData->CurrentSolution->TimeImag ; //++++ test to do more accurately! if (Current.Time >= time_init && Current.Time <= time_final) { Cal_WholeQuantity(Element, QuantityStorage_P0, WholeQuantity_P->Case.MaxOverTime.WholeQuantity, u, v, w, -1, 0, &Stack[0][Index], NbrArguments, ExpressionName) ; if (Stack[0][Index].Type == SCALAR) { if (Stack[0][Index].Val[0] > val_maxInTime){ val_maxInTime = Stack[0][Index].Val[0]; } } else { Message::Error("MaxOverTime can only be applied on scalar values") ; } } } Stack[0][Index].Val[0] = val_maxInTime; /* for (k = 0 ; k < Current.NbrSystem ; k++) (Current.DofData_P0+k)->CurrentSolution = (Current.DofData_P0+k)->Save_CurrentSolution; */ Current.TimeStep = Save_TimeStep ; Current.Time = Save_Time ; Current.TimeImag = Save_TimeImag ; Multi[Index] = 0 ; Index++ ; } else { Message::Error("MaxOverTime can only be used in time domain") ; break; } break ; case WQ_FOURIERSTEINMETZ : if (Current.NbrHar == 1) { double time_init = WholeQuantity_P->Case.FourierSteinmetz.TimeInit; double time_final = WholeQuantity_P->Case.FourierSteinmetz.TimeFinal; int nbrFrequencyInFormula = WholeQuantity_P->Case.FourierSteinmetz.NbrFrequency; double exponent_f = WholeQuantity_P->Case.FourierSteinmetz.Exponent_f; double exponent_b = WholeQuantity_P->Case.FourierSteinmetz.Exponent_b; /* for (k = 0 ; k < Current.NbrSystem ; k++) (Current.DofData_P0+k)->Save_CurrentSolution = (Current.DofData_P0+k)->CurrentSolution; */ Save_TimeStep = Current.TimeStep ; Save_Time = Current.Time ; Save_TimeImag = Current.TimeImag ; for (j=0; jSolutions); j++) { Current.DofData->CurrentSolution = (struct Solution*)List_Pointer((Current.DofData)->Solutions, j); Current.Time = Current.DofData->CurrentSolution->Time ; if (Current.Time >= time_init && i_Solution_init < 0) i_Solution_init = j; if (Current.Time <= time_final) { i_Solution_final = j; } if (Current.Time > time_final) { break; } } NbrTimeStep = i_Solution_final-i_Solution_init+1; if (NbrTimeStep < 2) Message::Error("Wrong time interval in Function FourierSteinmetz (%d,%d)", i_Solution_init, i_Solution_final) ; double *Times = (double *)Malloc(NbrTimeStep*sizeof(double)); struct Value *TmpValues = (struct Value *)Malloc(NbrTimeStep*sizeof(struct Value)); for (j=0; jCurrentSolution = (struct Solution*)List_Pointer((Current.DofData)->Solutions, i_Solution_init+j); //++++ Add: also for other systems! Current.TimeStep = Current.DofData->CurrentSolution->TimeStep ; Current.Time = Current.DofData->CurrentSolution->Time ; Current.TimeImag = Current.DofData->CurrentSolution->TimeImag ; Cal_WholeQuantity(Element, QuantityStorage_P0, WholeQuantity_P->Case.MaxOverTime.WholeQuantity, u, v, w, -1, 0, &Stack[0][Index], NbrArguments, ExpressionName) ; Times[j] = Current.Time ; Cal_CopyValue(&Stack[0][Index], &TmpValues[j]) ; if (Stack[0][Index].Type == SCALAR) Size = 1; else if (Stack[0][Index].Type == VECTOR) Size = 3; else Message::Error("FourierSteinmetz can only be applied on scalar or vector values") ; } // FourierTransform int NbrFreq ; double *Frequencies; struct Value *FourierValues; Pos_FourierTransform(NbrTimeStep, 1, Times, TmpValues, Size, 2, &NbrFreq, &Frequencies, &FourierValues); /* we calculate the Sum for all frequencies of frequency_i^exponent_f * b_i^exponent_b */ if (nbrFrequencyInFormula > NbrFreq-1) Message::Error("FourierSteinmetz: too many frequencies asked " "(%d asked and only %d available)", nbrFrequencyInFormula, NbrFreq-1) ; double val=0.; for (j=0; jCurrentSolution = (Current.DofData_P0+k)->Save_CurrentSolution; */ Current.TimeStep = Save_TimeStep ; Current.Time = Save_Time ; Current.TimeImag = Save_TimeImag ; Multi[Index] = 0 ; Index++ ; } else { Message::Error("FourierSteinmetz can only be used in time domain") ; break; } break ; case WQ_MHTRANSFORM : if(Current.NbrHar == 1){ Message::Error("MHTransform can only be used in complex (multi-harmonic)" " calculations") ; break; } for (j=0; jCase.MHTransform.WholeQuantity, u, v, w, -1, 0, &Stack[0][Index], NbrArguments, ExpressionName) ; MHTransform(Element, QuantityStorage_P0, u, v, w, &Stack[0][Index], (struct Expression *)List_Pointer(Problem_S.Expression, WholeQuantity_P->Case.MHTransform.Index), WholeQuantity_P->Case.MHTransform.NbrPoints) ; Multi[Index] = 0 ; Index++ ; break ; case WQ_CAST : /* This should be changed... */ Save_NbrHar = Current.NbrHar ; Save_DofData = Current.DofData ; if (!WholeQuantity_P->Case.Cast.NbrHar){ Current.DofData = ((struct FunctionSpace *) List_Pointer(Problem_S.FunctionSpace, WholeQuantity_P->Case.Cast.FunctionSpaceIndexForType)) ->DofData ; Current.NbrHar = Current.DofData->NbrHar ; } else{ Current.NbrHar = WholeQuantity_P->Case.Cast.NbrHar ; } for (j=0; jCase.Cast.WholeQuantity, u, v, w, -1, 0, &Stack[0][Index], NbrArguments, ExpressionName) ; if (Current.NbrHar < Save_NbrHar) /* ne plus a completer ...?? */ Cal_SetZeroHarmonicValue(&Stack[0][Index], Save_NbrHar) ; Current.NbrHar = Save_NbrHar ; Current.DofData = Save_DofData ; Multi[Index] = 0 ; Index++ ; break ; case WQ_CHANGECURRENTPOSITION : Save_x = Current.x ; Save_y = Current.y ; Save_z = Current.z ; Current.x = Stack[0][Index-1].Val[0] ; Current.y = Stack[0][Index-1].Val[1] ; Current.z = Stack[0][Index-1].Val[2] ; for (j=0; jCase.ChangeCurrentPosition.WholeQuantity, u, v, w, -1, 0, &Stack[0][Index-1], NbrArguments, ExpressionName) ; Current.x = Save_x ; Current.y = Save_y ; Current.z = Save_z ; break ; case WQ_SAVEVALUE : Cal_CopyValue(&Stack[0][Index-1], &ValueSaved[WholeQuantity_P->Case.SaveValue.Index]) ; break ; case WQ_VALUESAVED : if(ValueSaved.count(WholeQuantity_P->Case.ValueSaved.Index)) Cal_CopyValue(&ValueSaved[WholeQuantity_P->Case.ValueSaved.Index], &Stack[0][Index]) ; else{ if(TreatmentStatus != _PRE) Message::Warning("Empty register %d: assuming zero value", WholeQuantity_P->Case.ValueSaved.Index); Cal_ZeroValue(&Stack[0][Index]); Stack[0][Index].Type = SCALAR ; } Multi[Index] = 0 ; Index++ ; break ; case WQ_SAVENAMEDVALUE : Cal_CopyValue(&Stack[0][Index-1], &NamedValueSaved[WholeQuantity_P->Case.NamedValue.Name]) ; break ; case WQ_NAMEDVALUESAVED : if(NamedValueSaved.count(WholeQuantity_P->Case.NamedValue.Name)) Cal_CopyValue(&NamedValueSaved[WholeQuantity_P->Case.NamedValue.Name], &Stack[0][Index]) ; else{ if(TreatmentStatus != _PRE) Message::Warning("Unknown current value '$%s': assuming zero value", WholeQuantity_P->Case.NamedValue.Name); Cal_ZeroValue(&Stack[0][Index]); Stack[0][Index].Type = SCALAR ; } Multi[Index] = 0 ; Index++ ; break ; case WQ_SHOWVALUE : if (Index-1 == DofIndex) { for(j=0 ; jCase.ShowValue.Index, j+1); Show_Value(&DofValue[j]); } } else { fprintf(stderr, "##%d ", WholeQuantity_P->Case.ShowValue.Index); Show_Value(&Stack[0][Index-1]); } break ; default : Message::Error("Unknown type of WholeQuantity (%d)", WholeQuantity_P->Type); break; } } if (DofIndexInWholeQuantity < 0) Cal_CopyValue(&Stack[0][0], &DofValue[0]) ; } /* ------------------------------------------------------------------------ */ /* C a l _ S t o r e I n R e g i s t e r */ /* ------------------------------------------------------------------------ */ void Cal_StoreInRegister(struct Value *Value, int RegisterIndex) { Cal_CopyValue(Value, &ValueSaved[RegisterIndex]) ; } /* ------------------------------------------------------------------------ */ /* C a l _ S t o r e I n V a r i a b l e */ /* ------------------------------------------------------------------------ */ void Cal_StoreInVariable(struct Value *Value, const char *name) { Cal_CopyValue(Value, &NamedValueSaved[name]) ; } getdp-2.7.0-source/Legacy/Gauss_Prism.cpp000644 001750 001750 00000001762 12473553042 021760 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "Gauss_Prism.h" #include "Message.h" /* Gauss integration over a prism */ void Gauss_Prism(int Nbr_Points, int Num, double *u, double *v, double *w, double *wght) { switch (Nbr_Points) { case 6 : *u = upri6 [Num] ; *v = vpri6 [Num] ; *w = wpri6 [Num] ; *wght = ppri6 [Num] ; break ; case 9 : *u = upri9 [Num] ; *v = vpri9 [Num] ; *w = wpri9 [Num] ; *wght = ppri9 [Num] ; break ; case 21 : *u = upri21[Num] ; *v = vpri21[Num] ; *w = wpri21[Num] ; *wght = ppri21[Num] ; break ; case 42 : *u = upri42[Num] ; *v = vpri42[Num] ; *w = wpri42[Num] ; *wght = ppri42[Num] ; break ; default : Message::Error("Wrong number of Gauss points for Prism: " "valid choices: 6, 9, 21, 42"); break; } } getdp-2.7.0-source/Legacy/Cal_GalerkinTermOfFemEquation.cpp000644 001750 001750 00000101775 12473553042 025317 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Johan Gyselinck // Ruth Sabariego // #include #include #include "ProData.h" #include "ProDefine.h" #include "GeoData.h" #include "DofData.h" #include "Cal_Quantity.h" #include "Cal_Value.h" #include "Cal_IntegralQuantity.h" #include "Cal_AnalyticIntegration.h" #include "Cal_AssembleTerm.h" #include "Cal_GalerkinTermOfFemEquation.h" #include "Get_DofOfElement.h" #include "Get_ElementSource.h" #include "Get_Geometry.h" #include "Get_FunctionValue.h" #include "Pos_Search.h" #include "Message.h" extern struct Problem Problem_S ; extern struct CurrentData Current ; std::map assDiag_done; /* ------------------------------------------------------------------------ */ /* C a l _ I n i t G a l e r k i n T e r m O f F e m E q u a t i o n */ /* ------------------------------------------------------------------------ */ void Cal_InitGalerkinTermOfFemEquation(struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0, struct QuantityStorage * QuantityStorageNoDof, struct Dof * DofForNoDof_P) { struct FemLocalTermActive * FI ; //extern int MH_Moving_Matrix_simple, MH_Moving_Matrix_probe, MH_Moving_Matrix_separate; extern int MHMoving_assemblyType ; FI = EquationTerm_P->Case.LocalTerm.Active ; FI->QuantityStorageEqu_P = QuantityStorage_P0 + EquationTerm_P->Case.LocalTerm.Term.DefineQuantityIndexEqu ; Get_InitFunctionValue(EquationTerm_P->Case.LocalTerm.Term.TypeOperatorEqu, FI->QuantityStorageEqu_P, &FI->Type_FormEqu) ; if (EquationTerm_P->Case.LocalTerm.Term.DefineQuantityIndexDof >= 0) { FI->QuantityStorageDof_P = QuantityStorage_P0 + EquationTerm_P->Case.LocalTerm.Term.DefineQuantityIndexDof ; FI->Type_DefineQuantityDof = FI->QuantityStorageDof_P->DefineQuantity->Type ; } else { FI->QuantityStorageDof_P = QuantityStorageNoDof ; FI->Type_DefineQuantityDof = NODOF ; FI->DofForNoDof_P = DofForNoDof_P ; Dof_InitDofForNoDof(DofForNoDof_P, Current.NbrHar) ; QuantityStorageNoDof->BasisFunction[0].Dof = DofForNoDof_P ; } /* Warning: not correct if nonsymmetrical tensor in expression */ FI->SymmetricalMatrix = (EquationTerm_P->Case.LocalTerm.Term.DefineQuantityIndexEqu == EquationTerm_P->Case.LocalTerm.Term.DefineQuantityIndexDof) && (EquationTerm_P->Case.LocalTerm.Term.TypeOperatorEqu == EquationTerm_P->Case.LocalTerm.Term.TypeOperatorDof) ; assDiag_done.clear(); if(EquationTerm_P->Case.LocalTerm.Term.CanonicalWholeQuantity_Equ != CWQ_NONE) FI->SymmetricalMatrix = 0 ; if (FI->SymmetricalMatrix) { FI->Type_FormDof = FI->Type_FormEqu ; } else { switch (FI->Type_DefineQuantityDof) { case LOCALQUANTITY : Get_InitFunctionValue(EquationTerm_P->Case.LocalTerm.Term.TypeOperatorDof, FI->QuantityStorageDof_P, &FI->Type_FormDof) ; break ; case INTEGRALQUANTITY : if(EquationTerm_P->Case.LocalTerm.Term.TypeOperatorDof != NOOP){ Message::Error("No operator can act on an Integral Quantity"); } FI->Type_FormDof = VECTOR ; /* we don't know the type a priori */ FI->IntegralQuantityActive.IntegrationCase_L = ((struct IntegrationMethod *) List_Pointer(Problem_S.IntegrationMethod, FI->QuantityStorageDof_P->DefineQuantity-> IntegralQuantity.IntegrationMethodIndex)) ->IntegrationCase ; FI->IntegralQuantityActive.CriterionIndex = ((struct IntegrationMethod *) List_Pointer(Problem_S.IntegrationMethod, FI->QuantityStorageDof_P->DefineQuantity-> IntegralQuantity.IntegrationMethodIndex)) ->CriterionIndex ; FI->IntegralQuantityActive.JacobianCase_L = ((struct JacobianMethod *) List_Pointer(Problem_S.JacobianMethod, FI->QuantityStorageDof_P->DefineQuantity-> IntegralQuantity.JacobianMethodIndex)) ->JacobianCase ; break ; case NODOF : FI->Type_FormDof = SCALAR ; break ; } } FI->Type_ValueDof = Get_ValueFromForm(FI->Type_FormDof); /* G e t I n t e g r a t i o n M e t h o d */ /* -------------------------------------------- */ if(EquationTerm_P->Case.LocalTerm.IntegrationMethodIndex < 0){ Message::Error("Integration method missing in equation term"); FI->IntegrationCase_L = 0; } else{ FI->IntegrationCase_L = ((struct IntegrationMethod *) List_Pointer(Problem_S.IntegrationMethod, EquationTerm_P->Case.LocalTerm.IntegrationMethodIndex)) ->IntegrationCase ; FI->CriterionIndex = ((struct IntegrationMethod *) List_Pointer(Problem_S.IntegrationMethod, EquationTerm_P->Case.LocalTerm.IntegrationMethodIndex)) ->CriterionIndex ; } /* G e t J a c o b i a n M e t h o d */ /* -------------------------------------- */ if(EquationTerm_P->Case.LocalTerm.JacobianMethodIndex < 0){ Message::Error("Jacobian method missing in equation term"); FI->JacobianCase_L = 0; } else{ FI->JacobianCase_L = ((struct JacobianMethod *) List_Pointer(Problem_S.JacobianMethod, EquationTerm_P->Case.LocalTerm.JacobianMethodIndex)) ->JacobianCase ; FI->JacobianCase_P0 = (FI->NbrJacobianCase = List_Nbr(FI->JacobianCase_L)) ? (struct JacobianCase*)List_Pointer(FI->JacobianCase_L, 0) : NULL ; } FI->Flag_ChangeCoord = ( FI->SymmetricalMatrix || !( ( (FI->Type_FormEqu == FORM0 || FI->Type_FormEqu == FORM0P) && (FI->Type_FormDof == FORM3 || FI->Type_FormDof == FORM3P) ) || /* ( (FI->Type_FormEqu == FORM1 || FI->Type_FormEqu == FORM1P) && (FI->Type_FormDof == FORM2 || FI->Type_FormDof == FORM2P) ) || ( (FI->Type_FormEqu == FORM2 || FI->Type_FormEqu == FORM2P) && (FI->Type_FormDof == FORM1 || FI->Type_FormDof == FORM1P) ) || */ ( (FI->Type_FormEqu == FORM3 || FI->Type_FormEqu == FORM3P) && (FI->Type_FormDof == FORM0 || FI->Type_FormDof == FORM0P) ) ) ) || /* For operators on VECTOR's (To be extended) */ (FI->Type_FormEqu == VECTOR || FI->Type_FormDof == VECTOR) || (FI->Type_DefineQuantityDof == INTEGRALQUANTITY) ; if (FI->Flag_ChangeCoord){ FI->Flag_InvJac = ( (FI->Type_FormEqu == FORM1) || (!FI->SymmetricalMatrix && (FI->Type_FormDof == FORM1)) || /* For operators on VECTOR's (To be extended) */ (FI->Type_FormEqu == VECTOR || FI->Type_FormDof == VECTOR) || (EquationTerm_P->Case.LocalTerm.Term.QuantityIndexPost == 1) ) ; } /* G e t C h a n g e O f C o o r d i n a t e s */ /* ---------------------------------------------- */ FI->xChangeOfCoordinatesEqu = (void (*)())Get_ChangeOfCoordinates(FI->Flag_ChangeCoord, FI->Type_FormEqu) ; if (!FI->SymmetricalMatrix) FI->xChangeOfCoordinatesDof = (void (*)())Get_ChangeOfCoordinates(FI->Flag_ChangeCoord, FI->Type_FormDof) ; else FI->xChangeOfCoordinatesDof = (void (*)())Get_ChangeOfCoordinates(0, FI->Type_FormDof) ; /* Used only for transfer */ /* G e t C a l _ P r o d u c t x */ /* -------------------------------- */ switch (FI->Type_FormEqu) { case FORM1 : case FORM1S : case FORM2 : case FORM2P : case FORM2S : case VECTOR : FI->Cal_Productx = (double (*)())Cal_Product123 ; break ; case FORM1P : case VECTORP : FI->Cal_Productx = (double (*)())Cal_Product3 ; break ; case FORM0 : case FORM3 : case FORM3P : case SCALAR : FI->Cal_Productx = (double (*)())Cal_Product1 ; break ; default : Message::Error("Unknown type of Form (%d)", FI->Type_FormEqu); FI->Cal_Productx = (double (*)())Cal_Product123 ; break ; } /* G e t F u n c t i o n _ A s s e m b l e T e r m */ /* ------------------------------------------------- */ switch (EquationTerm_P->Case.LocalTerm.Term.TypeTimeDerivative) { case NODT_ : FI->Function_AssembleTerm = (void (*)())Cal_AssembleTerm_NoDt ; break; case DT_ : FI->Function_AssembleTerm = (void (*)())Cal_AssembleTerm_Dt ; break; case DTDOF_ : FI->Function_AssembleTerm = (void (*)())Cal_AssembleTerm_DtDof ; break; case DTDT_ : FI->Function_AssembleTerm = (void (*)())Cal_AssembleTerm_DtDt ; break; case DTDTDOF_ : FI->Function_AssembleTerm = (void (*)())Cal_AssembleTerm_DtDtDof ; break; case DTDTDTDOF_ : FI->Function_AssembleTerm = (void (*)())Cal_AssembleTerm_DtDtDtDof ; break; case DTDTDTDTDOF_ : FI->Function_AssembleTerm = (void (*)())Cal_AssembleTerm_DtDtDtDtDof ; break; case DTDTDTDTDTDOF_ : FI->Function_AssembleTerm = (void (*)())Cal_AssembleTerm_DtDtDtDtDtDof; break; case JACNL_ : FI->Function_AssembleTerm = (void (*)())Cal_AssembleTerm_JacNL ; break; case DTDOFJACNL_ : FI->Function_AssembleTerm = (void (*)())Cal_AssembleTerm_DtDofJacNL ; break; case NEVERDT_ : FI->Function_AssembleTerm = (void (*)())Cal_AssembleTerm_NeverDt ; break; case DTNL_ : FI->Function_AssembleTerm = (void (*)())Cal_AssembleTerm_DtNL ; break; default : Message::Error("Unknown type of Operator for Galerkin term (%d)", EquationTerm_P->Case.LocalTerm.Term.TypeTimeDerivative); FI->Function_AssembleTerm = (void (*)())Cal_AssembleTerm_NoDt ; break; } if(MHMoving_assemblyType) FI->Function_AssembleTerm = (void (*)())Cal_AssembleTerm_MHMoving; /* if (MH_Moving_Matrix_simple) { FI->Function_AssembleTerm = (void (*)())Cal_AssembleTerm_MH_Moving_simple ; } if (MH_Moving_Matrix_probe) { FI->Function_AssembleTerm = (void (*)())Cal_AssembleTerm_MH_Moving_probe ; } if (MH_Moving_Matrix_separate) { FI->Function_AssembleTerm = (void (*)())Cal_AssembleTerm_MH_Moving_separate ; } */ /* initialisation of MHJacNL-term (nonlinear multi-harmonics) if necessary */ Cal_InitGalerkinTermOfFemEquation_MHJacNL(EquationTerm_P); /* Full_Matrix */ if (EquationTerm_P->Case.LocalTerm.Full_Matrix) { FI->Full_Matrix = 1; FI->FirstElements = List_Create(20, 10, sizeof(struct FirstElement)) ; } } /* ------------------------------------------------------------------------ */ /* C a l _ E n d G a l e r k i n T e r m O f F e m E q u a t i o n */ /* ------------------------------------------------------------------------ */ void Cal_EndGalerkinTermOfFemEquation() { assDiag_done.clear(); } /* ------------------------------------------------------------------------ */ /* C a l _ a p p l y M e t r i c T e n s o r */ /* ------------------------------------------------------------------------ */ void Cal_applyMetricTensor(struct EquationTerm * EquationTerm_P, struct FemLocalTermActive * FI, struct QuantityStorage * QuantityStorage_P0, int Nbr_Dof, struct Value vBFxDof[]) { int j; int mi; struct Value S; struct Value detS; mi = EquationTerm_P->Case.LocalTerm.ExpressionIndexForMetricTensor; if(mi == -1) return; Get_ValueOfExpression ((struct Expression*)List_Pointer(Problem_S.Expression, mi), QuantityStorage_P0, Current.u, Current.v, Current.w, &S) ; if(S.Type == SCALAR) { S.Type = TENSOR_DIAG; S.Val[1] = S.Val[0]; S.Val[2] = S.Val[0]; } if(S.Type != TENSOR_SYM && S.Type != TENSOR && S.Type != TENSOR_DIAG) { Message::Error("Cannot interpret field type %s as metric tensor", Get_StringForDefine(Field_Type, S.Type)); return; } Cal_DetValue(&S, &detS); detS.Val[0] = sqrt(fabs(detS.Val[0])); switch (FI->Type_FormDof) { case FORM1 : case FORM1S : case FORM1P : Cal_InvertValue(&S, &S); for (j = 0 ; j < Nbr_Dof ; j++) { Cal_ProductValue(&S, &vBFxDof[j], &vBFxDof[j]); Cal_ProductValue(&detS, &vBFxDof[j], &vBFxDof[j]); } break; case FORM2 : case FORM2S : case FORM2P : Cal_InvertValue(&detS, &detS); for (j = 0 ; j < Nbr_Dof ; j++) { Cal_ProductValue(&S, &vBFxDof[j], &vBFxDof[j]); Cal_ProductValue(&detS, &vBFxDof[j], &vBFxDof[j]); } break; case FORM3 : case FORM3S : case FORM3P : Cal_InvertValue(&detS, &detS); for (j = 0 ; j < Nbr_Dof ; j++) { Cal_ProductValue(&detS, &vBFxDof[j], &vBFxDof[j]); } break; case FORM0 : case FORM0S : case FORM0P : for (j = 0 ; j < Nbr_Dof ; j++) { Cal_ProductValue(&detS, &vBFxDof[j], &vBFxDof[j]); } break; default: Message::Error("Cannot use metric tensor with field type %s", Get_StringForDefine(Field_Type, FI->Type_FormDof)); break; } } /* ------------------------------------------------------------------------ */ /* C a l _ v B F x D o f */ /* ------------------------------------------------------------------------ */ void Cal_vBFxDof(struct EquationTerm * EquationTerm_P, struct FemLocalTermActive * FI, struct QuantityStorage * QuantityStorage_P0, struct QuantityStorage * QuantityStorageDof_P, int Nbr_Dof, void (*xFunctionBFDof[NBR_MAX_BASISFUNCTIONS]) (struct Element * Element, int NumEntity, double u, double v, double w, double Value[]), double vBFxEqu[][MAX_DIM], struct Value vBFxDof[]) { double vBFuDof[NBR_MAX_BASISFUNCTIONS] [MAX_DIM] ; double u, v, w ; struct Value CoefPhys ; struct Element *E ; int i, j ; if(EquationTerm_P->Case.LocalTerm.Term.DofInTrace){ E = Current.Element->ElementTrace ; Current.x = Current.y = Current.z = 0. ; for (i = 0 ; i < Current.Element->GeoElement->NbrNodes ; i++) { Current.x += Current.Element->x[i] * Current.Element->n[i] ; Current.y += Current.Element->y[i] * Current.Element->n[i] ; Current.z += Current.Element->z[i] * Current.Element->n[i] ; } xyz2uvwInAnElement(E, Current.x, Current.y, Current.z, &Current.ut, &Current.vt, &Current.wt) ; u = Current.ut ; v = Current.vt ; w = Current.wt ; } else{ E = Current.Element ; u = Current.u ; v = Current.v ; w = Current.w ; } // initialize vBFxDof to zero; this allows to perform e.g. [0, {d u}] without // having to explicitly use [Vector[0,0,0], {d u}] ; if this is too slow, we // should check vBFxDof[j].Type against FI->Type_FormEqu before calling // FI->Cal_Productx to report errors for (j = 0 ; j < Nbr_Dof ; j++) Cal_ZeroValue(&vBFxDof[j]); // shape functions, integral quantity or dummy if (!FI->SymmetricalMatrix) { switch (FI->Type_DefineQuantityDof) { case LOCALQUANTITY : for (j = 0 ; j < Nbr_Dof ; j++) { xFunctionBFDof[j] (E, QuantityStorageDof_P->BasisFunction[j].NumEntityInElement+1, u, v, w, vBFuDof[j]) ; ((void (*)(struct Element*, double*, double*)) FI->xChangeOfCoordinatesDof) (E, vBFuDof[j], vBFxDof[j].Val) ; vBFxDof[j].Type = FI->Type_ValueDof ; if(Current.NbrHar > 1) Cal_SetHarmonicValue(&vBFxDof[j]) ; /* temp (rather add QuantityStorage_P to CurrentData) */ Current.NumEntities[j] = QuantityStorageDof_P->BasisFunction[j].CodeEntity; } break ; case INTEGRALQUANTITY : if (FI->IntegralQuantityActive.IntegrationCase_P->Type == ANALYTIC) Cal_AnalyticIntegralQuantity (Current.Element, QuantityStorageDof_P, Nbr_Dof, (void (**)())xFunctionBFDof, vBFxDof) ; else Cal_NumericalIntegralQuantity (Current.Element, &FI->IntegralQuantityActive, QuantityStorage_P0, QuantityStorageDof_P, FI->Type_DefineQuantityDof, Nbr_Dof, (void (**)())xFunctionBFDof, vBFxDof) ; FI->Type_ValueDof = FI->Type_FormDof = vBFxDof[0].Type; /* now this type is correct */ break ; case NODOF : /* Supprimer le DofForNoDof_P de la structure dans Data_Active.h */ /* QuantityStorageDof_P->BasisFunction[0].Dof = FI->DofForNoDof_P ; */ break ; } } else { for (j = 0 ; j < Nbr_Dof ; j++){ ((void (*)(struct Element*, double*, double*)) FI->xChangeOfCoordinatesDof) (Current.Element, vBFxEqu[j], vBFxDof[j].Val) ; vBFxDof[j].Type = FI->Type_ValueDof ; if(Current.NbrHar > 1) Cal_SetHarmonicValue(&vBFxDof[j]) ; } } /* Compute remaining factors in the term */ if (EquationTerm_P->Case.LocalTerm.Term.CanonicalWholeQuantity == CWQ_DOF) { } else if (EquationTerm_P->Case.LocalTerm.Term.CanonicalWholeQuantity == CWQ_EXP_TIME_DOF) { Get_ValueOfExpression ((struct Expression*)List_Pointer (Problem_S.Expression, EquationTerm_P->Case.LocalTerm.Term.ExpressionIndexForCanonical), QuantityStorage_P0, Current.u, Current.v, Current.w, &CoefPhys) ; for (j = 0 ; j < Nbr_Dof ; j++) Cal_ProductValue(&CoefPhys, &vBFxDof[j], &vBFxDof[j]) ; } else Cal_WholeQuantity (Current.Element, QuantityStorage_P0, EquationTerm_P->Case.LocalTerm.Term.WholeQuantity, Current.u, Current.v, Current.w, EquationTerm_P->Case.LocalTerm.Term.DofIndexInWholeQuantity, Nbr_Dof, vBFxDof) ; /* Compute using metric tensor if defined */ Cal_applyMetricTensor(EquationTerm_P, FI, QuantityStorage_P0, Nbr_Dof, vBFxDof); } /* ------------------------------------------------------------------------ */ /* C a l _ T e r m O f F e m E q u a t i o n */ /* ------------------------------------------------------------------------ */ void Cal_GalerkinTermOfFemEquation(struct Element * Element, struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0) { struct FemLocalTermActive * FI ; struct QuantityStorage * QuantityStorageEqu_P, * QuantityStorageDof_P ; struct IntegrationCase * IntegrationCase_P ; struct Quadrature * Quadrature_P ; struct Value vBFxDof [NBR_MAX_BASISFUNCTIONS], CoefPhys ; struct Value CanonicExpression_Equ, V1, V2; int Nbr_Equ, Nbr_Dof = 0; int i, j, k, Type_Dimension, Nbr_IntPoints, i_IntPoint ; int NextElement ; double weight, Factor = 1. ; double vBFuEqu [NBR_MAX_BASISFUNCTIONS] [MAX_DIM] ; double vBFxEqu [NBR_MAX_BASISFUNCTIONS] [MAX_DIM] ; double Ek [NBR_MAX_BASISFUNCTIONS] [NBR_MAX_BASISFUNCTIONS] [NBR_MAX_HARMONIC] ; void (*xFunctionBFEqu[NBR_MAX_BASISFUNCTIONS]) (struct Element * Element, int NumEntity, double u, double v, double w, double Value[] ) ; void (*xFunctionBFDof[NBR_MAX_BASISFUNCTIONS]) (struct Element * Element, int NumEntity, double u, double v, double w, double Value[] ) ; double (*Get_Jacobian)(struct Element*, MATRIX3x3*) ; void (*Get_IntPoint)(int,int,double*,double*,double*,double*); extern int Flag_RHS; Current.flagAssDiag = 0; /*+++prov*/ FI = EquationTerm_P->Case.LocalTerm.Active ; /* treatment of MHJacNL-term in separate routine */ if (FI->MHJacNL) { /* if only the RHS of the system is to be calculated (in case of adaptive relaxation of the Newton-Raphson scheme) the (expensive and redundant) calculation of this term can be skipped */ if (!Flag_RHS) Cal_GalerkinTermOfFemEquation_MHJacNL(Element, EquationTerm_P, QuantityStorage_P0) ; return; } QuantityStorageEqu_P = FI->QuantityStorageEqu_P ; QuantityStorageDof_P = FI->QuantityStorageDof_P ; /* skip computation completely if term does not contribute to RHS. This is OK, but the speed-up is not the best, due to the time-consuming--but necessary-- initializations that still need to be done before arriving at this point in the assembly process. For best performance use GenerateRHSGroup instead of GenerateRHS, and include any RHS-contributions (elements containing fixed dofs or non-dof expressions) in the given groups */ if(Current.DofData->Flag_RHS){ if(FI->Type_DefineQuantityDof == LOCALQUANTITY){ bool skip = true; int Nbr_Dof = FI->SymmetricalMatrix ? QuantityStorageEqu_P->NbrElementaryBasisFunction : QuantityStorageDof_P->NbrElementaryBasisFunction; for (int j = 0 ; j < Nbr_Dof ; j++){ Dof *Dof_P = QuantityStorageDof_P->BasisFunction[j].Dof; if(Dof_P->Type != DOF_UNKNOWN){ skip = false; break; } } if(skip) return; } } /* ---------------------------------------------------------------------- */ /* G e t F u n c t i o n V a l u e f o r t e s t f u n c t i o n s */ /* ---------------------------------------------------------------------- */ if (!(Nbr_Equ = QuantityStorageEqu_P->NbrElementaryBasisFunction)) { return ; } if(Nbr_Equ > NBR_MAX_BASISFUNCTIONS) Message::Fatal("Number of basis functions (%d) exceeds NBR_MAX_BASISFUNCTIONS: " "please recompile after changing Interface/ProData.h", Nbr_Equ); Get_FunctionValue(Nbr_Equ, (void (**)())xFunctionBFEqu, EquationTerm_P->Case.LocalTerm.Term.TypeOperatorEqu, QuantityStorageEqu_P, &FI->Type_FormEqu) ; /* ---------------------------------------------------------------------- */ /* G e t F u n c t i o n V a l u e f o r s h a p e f u n c t i o n s */ /* ---------------------------------------------------------------------- */ if (FI->SymmetricalMatrix){ Nbr_Dof = Nbr_Equ ; } else{ switch (FI->Type_DefineQuantityDof) { case LOCALQUANTITY : Nbr_Dof = QuantityStorageDof_P->NbrElementaryBasisFunction ; Get_FunctionValue(Nbr_Dof, (void (**)())xFunctionBFDof, EquationTerm_P->Case.LocalTerm.Term.TypeOperatorDof, QuantityStorageDof_P, &FI->Type_FormDof) ; break ; case INTEGRALQUANTITY : Get_InitElementSource(Element, QuantityStorageDof_P->DefineQuantity->IntegralQuantity.InIndex) ; break ; case NODOF : Nbr_Dof = 1 ; break ; } } /* ------------------------------------------------------------------- */ /* G e t I n t e g r a t i o n M e t h o d */ /* ------------------------------------------------------------------- */ IntegrationCase_P = Get_IntegrationCase(Element, FI->IntegrationCase_L, FI->CriterionIndex); /* ------------------------------------------------------------------- */ /* G e t J a c o b i a n M e t h o d */ /* ------------------------------------------------------------------- */ i = 0 ; while ((i < FI->NbrJacobianCase) && ((j = (FI->JacobianCase_P0 + i)->RegionIndex) >= 0) && !List_Search (((struct Group *)List_Pointer(Problem_S.Group, j)) ->InitialList, &Element->Region, fcmp_int) ) i++ ; if (i == FI->NbrJacobianCase){ Message::Error("Undefined Jacobian in Region %d", Element->Region); return; } Element->JacobianCase = FI->JacobianCase_P0 + i ; Get_Jacobian = (double (*)(struct Element*, MATRIX3x3*)) Get_JacobianFunction(Element->JacobianCase->TypeJacobian, Element->Type, &Type_Dimension) ; if (FI->Flag_ChangeCoord) Get_NodesCoordinatesOfElement(Element) ; /* ------------------------------------------------------------------------ */ /* ------------------------------------------------------------------------ */ /* C o m p u t a t i o n o f E l e m e n t a r y m a t r i x */ /* ------------------------------------------------------------------------ */ /* ------------------------------------------------------------------------ */ /* Loop on source elements (> 1 only if integral quantity) */ while (1) { if (FI->Type_DefineQuantityDof == INTEGRALQUANTITY) { NextElement = Get_NextElementSource(Element->ElementSource) ; if (NextElement) { /* Get DOF of source element */ Get_DofOfElement(Element->ElementSource, QuantityStorageDof_P->FunctionSpace, QuantityStorageDof_P, NULL) ; /* Get function value for shape function */ Get_NodesCoordinatesOfElement(Element->ElementSource) ; Nbr_Dof = QuantityStorageDof_P->NbrElementaryBasisFunction ; Get_FunctionValue (Nbr_Dof, (void (**)())xFunctionBFDof, QuantityStorageDof_P->DefineQuantity->IntegralQuantity.TypeOperatorDof, QuantityStorageDof_P, &FI->IntegralQuantityActive.Type_FormDof) ; /* Initialize Integral Quantity (integration & jacobian) */ Cal_InitIntegralQuantity(Element, &FI->IntegralQuantityActive, QuantityStorageDof_P); } else { break ; } /* if NextElement */ } /* if INTEGRALQUANTITY */ if (FI->SymmetricalMatrix) for (i = 0 ; i < Nbr_Equ ; i++) for (j = 0 ; j <= i ; j++) for (k = 0 ; k < Current.NbrHar ; k++) Ek[i][j][k] = 0. ; else for (i = 0 ; i < Nbr_Equ ; i++) for (j = 0 ; j < Nbr_Dof ; j++) for (k = 0 ; k < Current.NbrHar ; k++) Ek[i][j][k] = 0. ; switch (IntegrationCase_P->Type) { /* ------------------------------------- */ /* Q U A D R A T U R E */ /* ------------------------------------- */ case GAUSS : case GAUSSLEGENDRE : Quadrature_P = (struct Quadrature*) List_PQuery(IntegrationCase_P->Case, &Element->Type, fcmp_int); if(!Quadrature_P) Message::Error ("Unknown type of Element (%s) for Integration method (%s)", Get_StringForDefine(Element_Type, Element->Type), ((struct IntegrationMethod *) List_Pointer(Problem_S.IntegrationMethod, EquationTerm_P->Case.LocalTerm.IntegrationMethodIndex))->Name); Nbr_IntPoints = Quadrature_P->NumberOfPoints ; Get_IntPoint = (void(*)(int,int,double*,double*,double*,double*)) Quadrature_P->Function ; for (i_IntPoint = 0 ; i_IntPoint < Nbr_IntPoints ; i_IntPoint++) { Current.QuadraturePointIndex = i_IntPoint; Get_IntPoint(Nbr_IntPoints, i_IntPoint, &Current.u, &Current.v, &Current.w, &weight) ; if (FI->Flag_ChangeCoord) { Get_BFGeoElement(Element, Current.u, Current.v, Current.w) ; Element->DetJac = Get_Jacobian(Element, &Element->Jac) ; if (FI->Flag_InvJac) Get_InverseMatrix(Type_Dimension, Element->Type, Element->DetJac, &Element->Jac, &Element->InvJac) ; } /* Test Functions */ if(EquationTerm_P->Case.LocalTerm.Term.CanonicalWholeQuantity_Equ == CWQ_EXP_TIME_DOF) Get_ValueOfExpressionByIndex (EquationTerm_P->Case.LocalTerm.Term.ExpressionIndexForCanonical_Equ, QuantityStorage_P0, Current.u, Current.v, Current.w, &CanonicExpression_Equ) ; for (i = 0 ; i < Nbr_Equ ; i++) { xFunctionBFEqu[i] (Element, QuantityStorageEqu_P->BasisFunction[i].NumEntityInElement+1, Current.u, Current.v, Current.w, vBFuEqu[i]) ; ((void (*)(struct Element*, double*, double*)) FI->xChangeOfCoordinatesEqu) (Element, vBFuEqu[i], vBFxEqu[i]) ; if(EquationTerm_P->Case.LocalTerm.Term.CanonicalWholeQuantity_Equ != CWQ_NONE){ V1.Type = Get_ValueFromForm(FI->Type_FormEqu); V1.Val[0] = vBFxEqu[i][0] ; V1.Val[1] = vBFxEqu[i][1] ; V1.Val[2] = vBFxEqu[i][2] ; V1.Val[MAX_DIM] = 0; V1.Val[MAX_DIM+1] = 0; V1.Val[MAX_DIM+2] = 0; if(EquationTerm_P->Case.LocalTerm.Term.CanonicalWholeQuantity_Equ == CWQ_EXP_TIME_DOF){ switch(EquationTerm_P->Case.LocalTerm.Term.OperatorTypeForCanonical_Equ){ case OP_TIME : Cal_ProductValue (&CanonicExpression_Equ,&V1,&V2); break; case OP_CROSSPRODUCT : Cal_CrossProductValue (&CanonicExpression_Equ,&V1,&V2); break; default : Message::Error("Unknown operation in Equation"); break; } } else if(EquationTerm_P->Case.LocalTerm.Term.CanonicalWholeQuantity_Equ == CWQ_FCT_DOF){ ((void(*)(struct Function*, struct Value*, struct Value*)) EquationTerm_P->Case.LocalTerm.Term.BuiltInFunction_Equ) (NULL, &V1, &V2) ; } vBFxEqu[i][0] = V2.Val[0]; vBFxEqu[i][1] = V2.Val[1]; vBFxEqu[i][2] = V2.Val[2]; } } /* for Nbr_Equ */ /* Shape Functions (+ surrounding expression) */ Current.Element = Element ; Cal_vBFxDof(EquationTerm_P, FI, QuantityStorage_P0, QuantityStorageDof_P, Nbr_Dof, xFunctionBFDof, vBFxEqu, vBFxDof); Factor = (FI->Flag_ChangeCoord) ? weight * fabs(Element->DetJac) : weight ; /* Product and assembly in elementary submatrix (k?-1.:1.)* */ if (FI->SymmetricalMatrix) for (i = 0 ; i < Nbr_Equ ; i++) for (j = 0 ; j <= i ; j++) for (k = 0 ; k < Current.NbrHar ; k++) Ek[i][j][k] += Factor * ((double (*)(double*, double*)) FI->Cal_Productx) (vBFxEqu[i], &(vBFxDof[j].Val[MAX_DIM*k])) ; else for (i = 0 ; i < Nbr_Equ ; i++) for (j = 0 ; j < Nbr_Dof ; j++) for (k = 0 ; k < Current.NbrHar ; k++) Ek[i][j][k] += Factor * ((double (*)(double*, double*)) FI->Cal_Productx) (vBFxEqu[i], &(vBFxDof[j].Val[MAX_DIM*k])); } /* for i_IntPoint ... */ break ; /* case GAUSS */ /* ------------------------------------- */ /* A N A L Y T I C */ /* ------------------------------------- */ case ANALYTIC : if (EquationTerm_P->Case.LocalTerm.Term.CanonicalWholeQuantity == CWQ_DOF) { Factor = 1. ; } if (EquationTerm_P->Case.LocalTerm.Term.CanonicalWholeQuantity == CWQ_EXP_TIME_DOF) { if (EquationTerm_P->Case.LocalTerm.Term.ExpressionIndexForCanonical >= 0) { Get_ValueOfExpression ((struct Expression *)List_Pointer (Problem_S.Expression, EquationTerm_P->Case.LocalTerm.Term.ExpressionIndexForCanonical), QuantityStorage_P0, 0., 0., 0., &CoefPhys) ; Factor = CoefPhys.Val[0] ; } } else { Message::Error("Bad expression for full analytic integration"); } if (FI->SymmetricalMatrix) { for (i = 0 ; i < Nbr_Equ ; i++) for (j = 0 ; j <= i ; j++) Ek[i][j][0] = Factor * Cal_AnalyticIntegration (Element, (void (*)())xFunctionBFEqu[i], (void (*)())xFunctionBFEqu[j], i, j, FI->Cal_Productx) ; } else { switch (FI->Type_DefineQuantityDof) { case LOCALQUANTITY : for (i = 0 ; i < Nbr_Equ ; i++) for (j = 0 ; j < Nbr_Dof ; j++) Ek[i][j][0] = Factor * Cal_AnalyticIntegration (Element, (void (*)())xFunctionBFEqu[i], (void (*)())xFunctionBFDof[j], i, j, FI->Cal_Productx) ; break; default : Message::Error("Exterior analytical integration not implemented"); break; } } break ; /* case ANALYTIC */ default : Message::Error ("Unknown type of Integration method (%s)", ((struct IntegrationMethod *) List_Pointer(Problem_S.IntegrationMethod, EquationTerm_P->Case.LocalTerm.IntegrationMethodIndex))->Name); break; } /* Complete elementary matrix if symmetrical */ /* ----------------------------------------- */ if (FI->SymmetricalMatrix) for (i = 1 ; i < Nbr_Equ ; i++) for (j = 0 ; j < i ; j++) for (k = 0 ; k < Current.NbrHar ; k++) Ek[j][i][k] = Ek[i][j][k] ; if(Message::GetVerbosity() == 10) { printf("Galerkin = ") ; for (j = 0 ; j < Nbr_Dof ; j++) Print_DofNumber(QuantityStorageDof_P->BasisFunction[j].Dof) ; printf("\n") ; for (i = 0 ; i < Nbr_Equ ; i++) { Print_DofNumber(QuantityStorageEqu_P->BasisFunction[i].Dof) ; printf("[ ") ; for (j = 0 ; j < Nbr_Dof ; j++) { printf("(") ; for(k = 0 ; k < Current.NbrHar ; k++) printf("% .5e ", Ek[i][j][k]) ; printf(")") ; } printf("]\n") ; } } /* Assembly in global matrix */ /* ------------------------- */ if (!Current.flagAssDiag) /*+++prov*/ for (i = 0 ; i < Nbr_Equ ; i++) for (j = 0 ; j < Nbr_Dof ; j++) ((void (*)(struct Dof*, struct Dof*, double*)) FI->Function_AssembleTerm) (QuantityStorageEqu_P->BasisFunction[i].Dof, QuantityStorageDof_P->BasisFunction[j].Dof, Ek[i][j]) ; else if (Current.flagAssDiag == 1) { for (i = 0 ; i < Nbr_Equ ; i++) { /* for (j = 0 ; j < Nbr_Dof ; j++)*/ j = i; ((void (*)(struct Dof*, struct Dof*, double*)) FI->Function_AssembleTerm) (QuantityStorageEqu_P->BasisFunction[i].Dof, QuantityStorageDof_P->BasisFunction[j].Dof, Ek[i][j]) ; } } else if (Current.flagAssDiag == 2) { for (i = 0 ; i < Nbr_Equ ; i++) { /* for (j = 0 ; j < Nbr_Dof ; j++)*/ j = i; if (QuantityStorageEqu_P->BasisFunction[i].Dof->Type == DOF_UNKNOWN && assDiag_done.find (QuantityStorageEqu_P->BasisFunction[i].Dof->Case.Unknown.NumDof-1) == assDiag_done.end()) { assDiag_done [QuantityStorageEqu_P->BasisFunction[i].Dof->Case.Unknown.NumDof-1] = true; Ek[i][j][0] = 1.; for (k = 1 ; k < Current.NbrHar ; k++) Ek[i][j][k] = 0. ; ((void (*)(struct Dof*, struct Dof*, double*)) FI->Function_AssembleTerm) (QuantityStorageEqu_P->BasisFunction[i].Dof, QuantityStorageDof_P->BasisFunction[j].Dof, Ek[i][j]) ; } } } /* Exit while(1) directly if not integral quantity */ if (FI->Type_DefineQuantityDof != INTEGRALQUANTITY) break ; } /* while (1) ... */ Current.flagAssDiag = 0; /*+++prov*/ } getdp-2.7.0-source/Legacy/Pos_Format.h000644 001750 001750 00000002600 12473553042 021232 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _POS_FORMAT_H_ #define _POS_FORMAT_H_ #include "ProData.h" #include "ListUtils.h" void Format_PostFormat(struct PostSubOperation * PSO_P) ; void Format_PostHeader(struct PostSubOperation * PSO_P, int NbTimeStep, int Order, char *Name1, char *Name2) ; void Format_PostFooter(struct PostSubOperation * PSO_P, int Store) ; void Format_PostElement(struct PostSubOperation * PSO_P, int Contour, int Store, double Time, int TimeStep, int NbTimeStep, int NbrHarmonics, int HarmonicToTime, double *Dummy, struct PostElement *PE); void Format_PostValue(int Format, int Flag_Comma, int Group_FunctionType, int iTime, double Time, int NbrTimeStep, int iRegion, int numRegion, int NbrRegion, int NbrHarmonics, int HarmonicToTime, int FourierTransform, int Flag_NoNewLine, struct Value * Value) ; void Pos_FourierTransform(int NbrTimeStep, int NbrRegion, double *Times, struct Value *TmpValues, int Size, int TypeOutput, int *NbrFreq, double **Frequencies, struct Value **OutValues); #endif getdp-2.7.0-source/Legacy/BF_NodeXYZ.cpp000644 001750 001750 00000017022 12473553042 021367 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "ProData.h" #include "BF.h" #include "Get_Geometry.h" #include "Message.h" #define ARGS \ struct Element * Element, int NumNode, \ double u, double v, double w, double s[] /* ------------------------------------------------------------------------ */ /* B F _ N o d e X , Y , Z */ /* ------------------------------------------------------------------------ */ #define BF(BF_NodeX_, BF_Node_, use_, dum1_, dum2_) \ s[dum1_] = s[dum2_] = 0. ; \ (BF_Node_)(Element, NumNode, u, v, w, &s[use_]); void BF_NodeX(ARGS) { BF("BF_NodeX", BF_Node, 0, 1, 2) ; } void BF_NodeX_2E(ARGS) { BF("BF_NodeX_2E", BF_Node_2E, 0, 1, 2) ; } void BF_NodeX_2F(ARGS) { BF("BF_NodeX_2F", BF_Node_2F, 0, 1, 2) ; } void BF_NodeX_2V(ARGS) { BF("BF_NodeX_2V", BF_Node_2V, 0, 1, 2) ; } void BF_NodeX_3E(ARGS) { BF("BF_NodeX_3E", BF_Node_3E, 0, 1, 2) ; } void BF_NodeX_3F(ARGS) { BF("BF_NodeX_3F", BF_Node_3F, 0, 1, 2) ; } void BF_NodeX_3V(ARGS) { BF("BF_NodeX_3V", BF_Node_3V, 0, 1, 2) ; } void BF_NodeY(ARGS) { BF("BF_NodeY", BF_Node, 1, 0, 2) ; } void BF_NodeY_2E(ARGS) { BF("BF_NodeY_2E", BF_Node_2E, 1, 0, 2) ; } void BF_NodeY_2F(ARGS) { BF("BF_NodeY_2F", BF_Node_2F, 1, 0, 2) ; } void BF_NodeY_2V(ARGS) { BF("BF_NodeY_2V", BF_Node_2V, 1, 0, 2) ; } void BF_NodeY_3E(ARGS) { BF("BF_NodeY_3E", BF_Node_3E, 1, 0, 2) ; } void BF_NodeY_3F(ARGS) { BF("BF_NodeY_3F", BF_Node_3F, 1, 0, 2) ; } void BF_NodeY_3V(ARGS) { BF("BF_NodeY_3V", BF_Node_3V, 1, 0, 2) ; } void BF_NodeZ(ARGS) { BF("BF_NodeZ", BF_Node, 2, 0, 1) ; } void BF_NodeZ_2E(ARGS) { BF("BF_NodeZ_2E", BF_Node_2E, 2, 0, 1) ; } void BF_NodeZ_2F(ARGS) { BF("BF_NodeZ_2F", BF_Node_2F, 2, 0, 1) ; } void BF_NodeZ_2V(ARGS) { BF("BF_NodeZ_2V", BF_Node_2V, 2, 0, 1) ; } void BF_NodeZ_3E(ARGS) { BF("BF_NodeZ_3E", BF_Node_3E, 2, 0, 1) ; } void BF_NodeZ_3F(ARGS) { BF("BF_NodeZ_3F", BF_Node_3F, 2, 0, 1) ; } void BF_NodeZ_3V(ARGS) { BF("BF_NodeZ_3V", BF_Node_3V, 2, 0, 1) ; } #undef BF /* ------------------------------------------------------------------------ */ /* B F _ N o d e X , Y , Z _ D . . . */ /* ------------------------------------------------------------------------ */ void BF_NodeX_D12(struct Element * Element, int NumNode, double u, double v, double w, double s[]) { double su[3] ; BF_GradNode(Element, NumNode, u, v, w, su) ; ChangeOfCoord_Form1(Element, su, s) ; s[2] = s[1] ; s[1] = 0. ; } void BF_NodeY_D12(struct Element * Element, int NumNode, double u, double v, double w, double s[]) { double su[3] ; BF_GradNode(Element, NumNode, u, v, w, su) ; ChangeOfCoord_Form1(Element, su, s) ; s[2] = s[0] ; s[0] = 0. ; } void BF_NodeZ_D12(struct Element * Element, int NumNode, double u, double v, double w, double s[]) { s[0] = s[1] = s[2] = 0. ; } void BF_NodeX_D12_2E(struct Element * Element, int NumEdge, double u, double v, double w, double s[]) { double su[3] ; BF_GradNode_2E(Element, NumEdge, u, v, w, su) ; ChangeOfCoord_Form1(Element, su, s) ; s[2] = s[1] ; s[1] = 0. ; } void BF_NodeY_D12_2E(struct Element * Element, int NumEdge, double u, double v, double w, double s[]) { double su[3] ; BF_GradNode_2E(Element, NumEdge, u, v, w, su) ; ChangeOfCoord_Form1(Element, su, s) ; s[2] = s[0] ; s[0] = 0. ; } void BF_NodeZ_D12_2E(struct Element * Element, int NumEdge, double u, double v, double w, double s[]) { s[0] = s[1] = s[2] = 0. ; } void BF_GradNodeRealCoord(struct Element * Element, int NumNode, double u, double v, double w, double s[]) { double su[3] ; BF_GradNode(Element, NumNode, u, v, w, su) ; ChangeOfCoord_Form1(Element, su, s) ; } /* ------------------------------------------------------------------------ */ #define BF(BF_NodeX_D1_, BF_GradNode_, zero1_, zero2_) \ double su[3] ; \ (BF_GradNode_)(Element, NumNode, u, v, w, su) ; \ ChangeOfCoord_Form1(Element, su, s) ; \ s[zero1_] = s[zero2_] = 0; void BF_NodeX_D1(ARGS) { BF("BF_NodeX_D1", BF_GradNode, 1, 2) ; } void BF_NodeX_D1_2E(ARGS) { BF("BF_NodeX_D1_2E", BF_GradNode_2E, 1, 2) ; } void BF_NodeX_D1_2F(ARGS) { BF("BF_NodeX_D1_2F", BF_GradNode_2F, 1, 2) ; } void BF_NodeX_D1_2V(ARGS) { BF("BF_NodeX_D1_2V", BF_GradNode_2V, 1, 2) ; } void BF_NodeX_D1_3E(ARGS) { BF("BF_NodeX_D1_3E", BF_GradNode_3E, 1, 2) ; } void BF_NodeX_D1_3F(ARGS) { BF("BF_NodeX_D1_3F", BF_GradNode_3F, 1, 2) ; } void BF_NodeX_D1_3V(ARGS) { BF("BF_NodeX_D1_3V", BF_GradNode_3V, 1, 2) ; } void BF_NodeY_D1(ARGS) { BF("BF_NodeY_D1", BF_GradNode, 0, 2) ; } void BF_NodeY_D1_2E(ARGS) { BF("BF_NodeY_D1_2E", BF_GradNode_2E, 0, 2) ; } void BF_NodeY_D1_2F(ARGS) { BF("BF_NodeY_D1_2F", BF_GradNode_2F, 0, 2) ; } void BF_NodeY_D1_2V(ARGS) { BF("BF_NodeY_D1_2V", BF_GradNode_2V, 0, 2) ; } void BF_NodeY_D1_3E(ARGS) { BF("BF_NodeY_D1_3E", BF_GradNode_3E, 0, 2) ; } void BF_NodeY_D1_3F(ARGS) { BF("BF_NodeY_D1_3F", BF_GradNode_3F, 0, 2) ; } void BF_NodeY_D1_3V(ARGS) { BF("BF_NodeY_D1_3V", BF_GradNode_3V, 0, 2) ; } void BF_NodeZ_D1(ARGS) { BF("BF_NodeZ_D1", BF_GradNode, 0, 1) ; } void BF_NodeZ_D1_2E(ARGS) { BF("BF_NodeZ_D1_2E", BF_GradNode_2E, 0, 1) ; } void BF_NodeZ_D1_2F(ARGS) { BF("BF_NodeZ_D1_2F", BF_GradNode_2F, 0, 1) ; } void BF_NodeZ_D1_2V(ARGS) { BF("BF_NodeZ_D1_2V", BF_GradNode_2V, 0, 1) ; } void BF_NodeZ_D1_3E(ARGS) { BF("BF_NodeZ_D1_3E", BF_GradNode_3E, 0, 1) ; } void BF_NodeZ_D1_3F(ARGS) { BF("BF_NodeZ_D1_3F", BF_GradNode_3F, 0, 1) ; } void BF_NodeZ_D1_3V(ARGS) { BF("BF_NodeZ_D1_3V", BF_GradNode_3V, 0, 1) ; } #undef BF /* ------------------------------------------------------------------------ */ #define BF(BF_NodeX_D2_, BF_GradNode_, idx1_, idx2_) \ double su[3] ; \ (BF_GradNode_)(Element, NumNode, u, v, w, su) ; \ ChangeOfCoord_Form1(Element, su, s) ; \ s[idx1_] = s[idx2_] ; s[idx2_] = 0 ; void BF_NodeX_D2(ARGS) { BF("BF_NodeX_D2", BF_GradNode, 0, 1) ; } void BF_NodeX_D2_2E(ARGS) { BF("BF_NodeX_D2_2E", BF_GradNode_2E, 0, 1) ; } void BF_NodeX_D2_2F(ARGS) { BF("BF_NodeX_D2_2F", BF_GradNode_2F, 0, 1) ; } void BF_NodeX_D2_2V(ARGS) { BF("BF_NodeX_D2_2V", BF_GradNode_2V, 0, 1) ; } void BF_NodeX_D2_3E(ARGS) { BF("BF_NodeX_D2_3E", BF_GradNode_3E, 0, 1) ; } void BF_NodeX_D2_3F(ARGS) { BF("BF_NodeX_D2_3F", BF_GradNode_3F, 0, 1) ; } void BF_NodeX_D2_3V(ARGS) { BF("BF_NodeX_D2_3V", BF_GradNode_3V, 0, 1) ; } void BF_NodeY_D2(ARGS) { BF("BF_NodeY_D2", BF_GradNode, 1, 2) ; } void BF_NodeY_D2_2E(ARGS) { BF("BF_NodeY_D2_2E", BF_GradNode_2E, 1, 2) ; } void BF_NodeY_D2_2F(ARGS) { BF("BF_NodeY_D2_2F", BF_GradNode_2F, 1, 2) ; } void BF_NodeY_D2_2V(ARGS) { BF("BF_NodeY_D2_2V", BF_GradNode_2V, 1, 2) ; } void BF_NodeY_D2_3E(ARGS) { BF("BF_NodeY_D2_3E", BF_GradNode_3E, 1, 2) ; } void BF_NodeY_D2_3F(ARGS) { BF("BF_NodeY_D2_3F", BF_GradNode_3F, 1, 2) ; } void BF_NodeY_D2_3V(ARGS) { BF("BF_NodeY_D2_3V", BF_GradNode_3V, 1, 2) ; } void BF_NodeZ_D2(ARGS) { BF("BF_NodeZ_D2", BF_GradNode, 2, 0) ; } void BF_NodeZ_D2_2E(ARGS) { BF("BF_NodeZ_D2_2E", BF_GradNode_2E, 2, 0) ; } void BF_NodeZ_D2_2F(ARGS) { BF("BF_NodeZ_D2_2F", BF_GradNode_2F, 2, 0) ; } void BF_NodeZ_D2_2V(ARGS) { BF("BF_NodeZ_D2_2V", BF_GradNode_2V, 2, 0) ; } void BF_NodeZ_D2_3E(ARGS) { BF("BF_NodeZ_D2_3E", BF_GradNode_3E, 2, 0) ; } void BF_NodeZ_D2_3F(ARGS) { BF("BF_NodeZ_D2_3F", BF_GradNode_3F, 2, 0) ; } void BF_NodeZ_D2_3V(ARGS) { BF("BF_NodeZ_D2_3V", BF_GradNode_3V, 2, 0) ; } #undef BF getdp-2.7.0-source/Legacy/F_ExtMath.cpp000644 001750 001750 00000114052 12473553042 021340 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Johan Gyselinck // Ruth Sabariego #include #include "F.h" #include "GeoData.h" #include "DofData.h" #include "Cal_Value.h" #include "Message.h" extern struct CurrentData Current ; #define SQU(a) ((a)*(a)) #define TWO_PI 6.2831853071795865 /* ------------------------------------------------------------------------ */ /* Simple Extended Math */ /* ------------------------------------------------------------------------ */ void F_Hypot(F_ARG) { int k; double tmp; if(A->Type != SCALAR || (A+1)->Type != SCALAR) Message::Error("Non scalar argument(s) for function 'Hypot'"); if (Current.NbrHar == 1){ V->Val[0] = sqrt(A->Val[0]*A->Val[0]+(A+1)->Val[0]*(A+1)->Val[0]) ; } else { tmp = sqrt(A->Val[0]*A->Val[0]+(A+1)->Val[0]*(A+1)->Val[0]) ; for (k = 0 ; k < Current.NbrHar ; k += 2) { V->Val[MAX_DIM* k ] = tmp ; V->Val[MAX_DIM*(k+1)] = 0. ; } } V->Type = SCALAR; } void F_TanhC2(F_ARG) { double denom = SQU(cosh(A->Val[0])*cos(A->Val[MAX_DIM])) + SQU(sinh(A->Val[0])*sin(A->Val[MAX_DIM])); V->Val[0] = sinh(A->Val[0])*cosh(A->Val[0]) / denom ; V->Val[MAX_DIM] = sin(A->Val[MAX_DIM])*cos(A->Val[MAX_DIM]) / denom ; V->Type = SCALAR ; } /* ------------------------------------------------------------------------ */ /* General Tensor Functions */ /* ------------------------------------------------------------------------ */ void F_Transpose(F_ARG) { if(A->Type != TENSOR_DIAG && A->Type != TENSOR_SYM && A->Type != TENSOR) Message::Error("Wrong type of argument for function 'Transpose'"); Cal_TransposeValue(A,V); } void F_Inv(F_ARG) { if(A->Type != TENSOR_DIAG && A->Type != TENSOR_SYM && A->Type != TENSOR) Message::Error("Wrong type of argument for function 'Inverse'"); Cal_InvertValue(A,V); } void F_Det(F_ARG) { if(A->Type != TENSOR_DIAG && A->Type != TENSOR_SYM && A->Type != TENSOR) Message::Error("Wrong type of argument for function 'Det'"); Cal_DetValue(A,V); } void F_Trace(F_ARG) { if(A->Type != TENSOR_DIAG && A->Type != TENSOR_SYM && A->Type != TENSOR) Message::Error("Wrong type of argument for function 'Trace'"); Cal_TraceValue(A,V); } void F_RotateXYZ(F_ARG) { // Apply a (X_1 Y_2 Z_3) rotation matrix using Euler (Tait-Bryan) angles double ca, sa, cb, sb, cc, sc ; struct Value Rot ; if((A->Type != TENSOR_DIAG && A->Type != TENSOR_SYM && A->Type != TENSOR && A->Type != VECTOR) || (A+1)->Type != SCALAR || (A+2)->Type != SCALAR || (A+3)->Type != SCALAR) Message::Error("Wrong type of argument(s) for function 'Rotate'"); ca = cos((A+1)->Val[0]) ; sa = sin((A+1)->Val[0]) ; cb = cos((A+2)->Val[0]) ; sb = sin((A+2)->Val[0]) ; cc = cos((A+3)->Val[0]) ; sc = sin((A+3)->Val[0]) ; Rot.Type = TENSOR ; Cal_ZeroValue(&Rot); Rot.Val[0] = cb*cc; Rot.Val[1] = -cb*sc; Rot.Val[2] = sb; Rot.Val[3] = sa*sb*cc+ca*sc; Rot.Val[4] = -sa*sb*sc+ca*cc; Rot.Val[5] = -sa*cb; Rot.Val[6] = -ca*sb*cc+sa*sc; Rot.Val[7] = ca*sb*sc+sa*cc; Rot.Val[8] = ca*cb; Cal_RotateValue(&Rot,A,V); } /* ------------------------------------------------------------------------ */ /* Norm */ /* ------------------------------------------------------------------------ */ void F_Norm(F_ARG) { int k ; switch(A->Type) { case SCALAR : if (Current.NbrHar == 1) { V->Val[0] = fabs(A->Val[0]) ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2 ) { V->Val[MAX_DIM*k] = sqrt(SQU(A->Val[MAX_DIM*k]) + SQU(A->Val[MAX_DIM*(k+1)])); V->Val[MAX_DIM*(k+1)] = 0. ; } } break ; case VECTOR : if (Current.NbrHar == 1) { V->Val[0] = sqrt(SQU(A->Val[0]) + SQU(A->Val[1]) + SQU(A->Val[2])) ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2 ) { V->Val[MAX_DIM*k] = sqrt(SQU(A->Val[MAX_DIM* k ]) + SQU(A->Val[MAX_DIM* k +1]) + SQU(A->Val[MAX_DIM* k +2]) + SQU(A->Val[MAX_DIM*(k+1) ]) + SQU(A->Val[MAX_DIM*(k+1)+1]) + SQU(A->Val[MAX_DIM*(k+1)+2])) ; V->Val[MAX_DIM*(k+1)] = 0. ; } } break ; default : Message::Error("Wrong type of argument for function 'Norm'"); break; } V->Type = SCALAR ; } /* ------------------------------------------------------------------------ */ /* Square Norm */ /* ------------------------------------------------------------------------ */ void F_SquNorm(F_ARG) { int k ; switch(A->Type) { case SCALAR : if (Current.NbrHar == 1) { V->Val[0] = SQU(A->Val[0]) ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2 ) { V->Val[MAX_DIM*k] = SQU(A->Val[MAX_DIM*k]) + SQU(A->Val[MAX_DIM*(k+1)]); V->Val[MAX_DIM*(k+1)] = 0. ; } } break ; case VECTOR : if (Current.NbrHar == 1) { V->Val[0] = SQU(A->Val[0]) + SQU(A->Val[1]) + SQU(A->Val[2]) ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2 ) { V->Val[MAX_DIM*k] = SQU(A->Val[MAX_DIM* k ]) + SQU(A->Val[MAX_DIM* k +1]) + SQU(A->Val[MAX_DIM* k +2]) + SQU(A->Val[MAX_DIM*(k+1) ]) + SQU(A->Val[MAX_DIM*(k+1)+1]) + SQU(A->Val[MAX_DIM*(k+1)+2]) ; V->Val[MAX_DIM*(k+1)] = 0. ; } } break ; default : Message::Error("Wrong type of argument for function 'SquNorm'"); break; } V->Type = SCALAR ; } /* ------------------------------------------------------------------------ */ /* Unit */ /* ------------------------------------------------------------------------ */ void F_Unit(F_ARG) { int k ; double Norm ; switch(A->Type) { case SCALAR : if (Current.NbrHar == 1) { V->Val[0] = 1. ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2 ) { V->Val[MAX_DIM* k ] = 1. ; V->Val[MAX_DIM*(k+1)] = 0. ; } } V->Type = SCALAR ; break ; case VECTOR : if (Current.NbrHar == 1) { Norm = sqrt(SQU(A->Val[0]) + SQU(A->Val[1]) + SQU(A->Val[2])) ; if (Norm > 1.e-30) { /* Attention: tolerance */ V->Val[0] = A->Val[0]/Norm ; V->Val[1] = A->Val[1]/Norm ; V->Val[2] = A->Val[2]/Norm ; } else { V->Val[0] = 0. ; V->Val[1] = 0. ; V->Val[2] = 0. ; } } else { for (k = 0 ; k < Current.NbrHar ; k += 2 ) { Norm = sqrt(SQU(A->Val[MAX_DIM* k ]) + SQU(A->Val[MAX_DIM* k +1]) + SQU(A->Val[MAX_DIM* k +2]) + SQU(A->Val[MAX_DIM*(k+1) ]) + SQU(A->Val[MAX_DIM*(k+1)+1]) + SQU(A->Val[MAX_DIM*(k+1)+2])) ; if (Norm > 1.e-30) { /* Attention: tolerance */ V->Val[MAX_DIM* k ] = A->Val[MAX_DIM* k ]/Norm ; V->Val[MAX_DIM* k +1] = A->Val[MAX_DIM* k +1]/Norm ; V->Val[MAX_DIM* k +2] = A->Val[MAX_DIM* k +2]/Norm ; V->Val[MAX_DIM*(k+1) ] = A->Val[MAX_DIM*(k+1) ]/Norm ; V->Val[MAX_DIM*(k+1)+1] = A->Val[MAX_DIM*(k+1)+1]/Norm ; V->Val[MAX_DIM*(k+1)+2] = A->Val[MAX_DIM*(k+1)+2]/Norm ; } else { V->Val[MAX_DIM* k ] = 0 ; V->Val[MAX_DIM* k +1] = 0 ; V->Val[MAX_DIM* k +2] = 0 ; V->Val[MAX_DIM*(k+1) ] = 0 ; V->Val[MAX_DIM*(k+1)+1] = 0 ; V->Val[MAX_DIM*(k+1)+2] = 0 ; } } } V->Type = VECTOR ; break ; default : Message::Error("Wrong type of argument for function 'Unit'"); break; } } /* ------------------------------------------------------------------------ */ /* ScalarUnit */ /* ------------------------------------------------------------------------ */ void F_ScalarUnit(F_ARG) { int k ; if (Current.NbrHar == 1) { V->Val[0] = 1. ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2 ) { V->Val[MAX_DIM* k ] = 1. ; V->Val[MAX_DIM*(k+1)] = 0. ; } } V->Type = SCALAR ; } /* ------------------------------------------------------------------------ */ /* Time Functions */ /* ------------------------------------------------------------------------ */ /* Interesting only because it allows the same formal expression in both Time and Frequency domains ! */ /* cos ( w * $Time + phi ) */ void F_Cos_wt_p (F_ARG) { if (Current.NbrHar == 1) V->Val[0] = cos(Fct->Para[0] * Current.Time + Fct->Para[1]) ; else if (Current.NbrHar == 2) { V->Val[0] = cos(Fct->Para[1]) ; V->Val[MAX_DIM] = sin(Fct->Para[1]) ; } else { Message::Error("Too many harmonics for function 'Cos_wt_p'") ; } V->Type = SCALAR ; } /* sin ( w * $Time + phi ) */ void F_Sin_wt_p (F_ARG) { if (Current.NbrHar == 1) V->Val[0] = sin(Fct->Para[0] * Current.Time + Fct->Para[1]) ; else if (Current.NbrHar == 2){ V->Val[0] = sin(Fct->Para[1]) ; V->Val[MAX_DIM] = -cos(Fct->Para[1]) ; } else { Message::Error("Too many harmonics for function 'Sin_wt_p'") ; } V->Type = SCALAR ; } void F_Complex_MH(F_ARG) { int NbrFreq, NbrComp, i, j, k, l ; struct Value R; double * Val_Pulsation ; NbrFreq = Fct->NbrParameters ; NbrComp = Fct->NbrArguments ; if (NbrComp != 2*NbrFreq) Message::Error("Number of components does not equal twice the number " "of frequencies in Complex_MH") ; R.Type = A->Type ; Cal_ZeroValue(&R); if (Current.NbrHar != 1) { Val_Pulsation = Current.DofData->Val_Pulsation ; for (i=0 ; iPara[i]) <= 1e-10 * Val_Pulsation[j]) { for (k=2*j,l=2*i ; k<2*j+2 ; k++,l++) { switch(A->Type){ case SCALAR : R.Val[MAX_DIM*k ] += (A+l)->Val[0] ; break; case VECTOR : case TENSOR_DIAG : R.Val[MAX_DIM*k ] += (A+l)->Val[0] ; R.Val[MAX_DIM*k+1] += (A+l)->Val[1] ; R.Val[MAX_DIM*k+2] += (A+l)->Val[2] ; break; case TENSOR_SYM : R.Val[MAX_DIM*k ] += (A+l)->Val[0] ; R.Val[MAX_DIM*k+1] += (A+l)->Val[1] ; R.Val[MAX_DIM*k+2] += (A+l)->Val[2] ; R.Val[MAX_DIM*k+3] += (A+l)->Val[3] ; R.Val[MAX_DIM*k+4] += (A+l)->Val[4] ; R.Val[MAX_DIM*k+5] += (A+l)->Val[5] ; break; case TENSOR : R.Val[MAX_DIM*k ] += (A+l)->Val[0] ; R.Val[MAX_DIM*k+1] += (A+l)->Val[1] ; R.Val[MAX_DIM*k+2] += (A+l)->Val[2] ; R.Val[MAX_DIM*k+3] += (A+l)->Val[3] ; R.Val[MAX_DIM*k+4] += (A+l)->Val[4] ; R.Val[MAX_DIM*k+5] += (A+l)->Val[5] ; R.Val[MAX_DIM*k+6] += (A+l)->Val[6] ; R.Val[MAX_DIM*k+7] += (A+l)->Val[7] ; R.Val[MAX_DIM*k+8] += (A+l)->Val[8] ; break; default : Message::Error("Unknown type of arguments in function 'Complex_MH'"); break; } } } } } else { /* time domain */ for (i=0 ; iPara[i]*Current.Time), &R) ; Cal_AddMultValue (&R, A+2*i+1, -sin(TWO_PI*Fct->Para[i]*Current.Time), &R) ; } } Cal_CopyValue(&R,V); } /* ------------------------------------------------------------------------ */ /* Period */ /* ------------------------------------------------------------------------ */ void F_Period (F_ARG) { if (Current.NbrHar == 1) V->Val[0] = fmod(A->Val[0], Fct->Para[0]) + ((A->Val[0] < 0.)? Fct->Para[0] : 0.) ; else Message::Error("Function 'F_Period' not valid for Complex"); V->Type = SCALAR ; } /* ------------------------------------------------------------------------ */ /* Interval */ /* ------------------------------------------------------------------------ */ void F_Interval (F_ARG) { int k; double tmp; if (Current.NbrHar == 1) { V->Val[0] = A->Val[0] > (A+1)->Val[0] + Fct->Para[0] * Fct->Para[2] && A->Val[0] < (A+2)->Val[0] + Fct->Para[1] * Fct->Para[2] ; } else { tmp = A->Val[0] > (A+1)->Val[0] + Fct->Para[0] * Fct->Para[2] && A->Val[0] < (A+2)->Val[0] + Fct->Para[1] * Fct->Para[2] ; for (k = 0 ; k < Current.NbrHar ; k += 2) { V->Val[MAX_DIM* k ] = tmp ; V->Val[MAX_DIM*(k+1)] = 0. ; } } V->Type = SCALAR ; } /* ------------------------------------------------------------------------ */ /* Create a Complex Value from k Real Values (of same type!) */ /* ------------------------------------------------------------------------ */ void F_Complex(F_ARG) { /* Warning: this function takes a variable number of arguments (depending on Current.NbrHar). There is no test to check if this number is correct (it just has to be a multiple of 2). */ int k ; switch(A->Type){ case SCALAR : for (k = 0 ; k < Current.NbrHar ; k++) { if((A+k)->Type != A->Type) Message::Error("Mixed type of arguments in function 'Complex'"); V->Val[MAX_DIM*k] = (A+k)->Val[0] ; } break; case VECTOR : case TENSOR_DIAG : for (k = 0 ; k < Current.NbrHar ; k++) { if((A+k)->Type != A->Type) Message::Error("Mixed type of arguments in function 'Complex'"); V->Val[MAX_DIM*k ] = (A+k)->Val[0] ; V->Val[MAX_DIM*k+1] = (A+k)->Val[1] ; V->Val[MAX_DIM*k+2] = (A+k)->Val[2] ; } break; case TENSOR_SYM : for (k = 0 ; k < Current.NbrHar ; k++) { if((A+k)->Type != A->Type) Message::Error("Mixed type of arguments in function 'Complex'"); V->Val[MAX_DIM*k ] = (A+k)->Val[0] ; V->Val[MAX_DIM*k+1] = (A+k)->Val[1] ; V->Val[MAX_DIM*k+2] = (A+k)->Val[2] ; V->Val[MAX_DIM*k+3] = (A+k)->Val[3] ; V->Val[MAX_DIM*k+4] = (A+k)->Val[4] ; V->Val[MAX_DIM*k+5] = (A+k)->Val[5] ; } break; case TENSOR : for (k = 0 ; k < Current.NbrHar ; k++) { if((A+k)->Type != A->Type) Message::Error("Mixed type of arguments in function 'Complex'"); V->Val[MAX_DIM*k ] = (A+k)->Val[0] ; V->Val[MAX_DIM*k+1] = (A+k)->Val[1] ; V->Val[MAX_DIM*k+2] = (A+k)->Val[2] ; V->Val[MAX_DIM*k+3] = (A+k)->Val[3] ; V->Val[MAX_DIM*k+4] = (A+k)->Val[4] ; V->Val[MAX_DIM*k+5] = (A+k)->Val[5] ; V->Val[MAX_DIM*k+6] = (A+k)->Val[6] ; V->Val[MAX_DIM*k+7] = (A+k)->Val[7] ; V->Val[MAX_DIM*k+8] = (A+k)->Val[8] ; } break; default : Message::Error("Unknown type of arguments in function 'Complex'"); break; } V->Type = A->Type ; } /* ----------------------------------------------------------------------- */ /* Get the Real Part of a Value */ /* ------------------------------------------------------------------------ */ void F_Re(F_ARG) { int k ; switch (A->Type) { case SCALAR : for (k = 0 ; k < Current.NbrHar ; k+=2) { V->Val[MAX_DIM*k] = A->Val[MAX_DIM*k] ; V->Val[MAX_DIM*(k+1)] = 0. ; } break; case VECTOR : case TENSOR_DIAG : for (k = 0 ; k < Current.NbrHar ; k+=2) { V->Val[MAX_DIM*k ] = A->Val[MAX_DIM*k ] ; V->Val[MAX_DIM*k+1] = A->Val[MAX_DIM*k+1] ; V->Val[MAX_DIM*k+2] = A->Val[MAX_DIM*k+2] ; V->Val[MAX_DIM*(k+1) ] = 0. ; V->Val[MAX_DIM*(k+1)+1] = 0. ; V->Val[MAX_DIM*(k+1)+2] = 0. ; } break; case TENSOR_SYM : for (k = 0 ; k < Current.NbrHar ; k+=2) { V->Val[MAX_DIM*k ] = A->Val[MAX_DIM*k ] ; V->Val[MAX_DIM*k+1] = A->Val[MAX_DIM*k+1] ; V->Val[MAX_DIM*k+2] = A->Val[MAX_DIM*k+2] ; V->Val[MAX_DIM*k+3] = A->Val[MAX_DIM*k+3] ; V->Val[MAX_DIM*k+4] = A->Val[MAX_DIM*k+4] ; V->Val[MAX_DIM*k+5] = A->Val[MAX_DIM*k+5] ; V->Val[MAX_DIM*(k+1) ] = 0. ; V->Val[MAX_DIM*(k+1)+1] = 0. ; V->Val[MAX_DIM*(k+1)+2] = 0. ; V->Val[MAX_DIM*(k+1)+3] = 0. ; V->Val[MAX_DIM*(k+1)+4] = 0. ; V->Val[MAX_DIM*(k+1)+5] = 0. ; } break; case TENSOR : for (k = 0 ; k < Current.NbrHar ; k+=2) { V->Val[MAX_DIM*k ] = A->Val[MAX_DIM*k ] ; V->Val[MAX_DIM*k+1] = A->Val[MAX_DIM*k+1] ; V->Val[MAX_DIM*k+2] = A->Val[MAX_DIM*k+2] ; V->Val[MAX_DIM*k+3] = A->Val[MAX_DIM*k+3] ; V->Val[MAX_DIM*k+4] = A->Val[MAX_DIM*k+4] ; V->Val[MAX_DIM*k+5] = A->Val[MAX_DIM*k+5] ; V->Val[MAX_DIM*k+6] = A->Val[MAX_DIM*k+6] ; V->Val[MAX_DIM*k+7] = A->Val[MAX_DIM*k+7] ; V->Val[MAX_DIM*k+8] = A->Val[MAX_DIM*k+8] ; V->Val[MAX_DIM*(k+1) ] = 0. ; V->Val[MAX_DIM*(k+1)+1] = 0. ; V->Val[MAX_DIM*(k+1)+2] = 0. ; V->Val[MAX_DIM*(k+1)+3] = 0. ; V->Val[MAX_DIM*(k+1)+4] = 0. ; V->Val[MAX_DIM*(k+1)+5] = 0. ; V->Val[MAX_DIM*(k+1)+6] = 0. ; V->Val[MAX_DIM*(k+1)+7] = 0. ; V->Val[MAX_DIM*(k+1)+8] = 0. ; } break; default : Message::Error("Unknown type of arguments in function 'Re'"); break; } V->Type = A->Type ; } /* ------------------------------------------------------------------------ */ /* Get the Imaginary Part of a Value */ /* ------------------------------------------------------------------------ */ void F_Im(F_ARG) { int k ; switch (A->Type) { case SCALAR : for (k = 0 ; k < Current.NbrHar ; k+=2) { V->Val[MAX_DIM*k] = A->Val[MAX_DIM*(k+1)] ; V->Val[MAX_DIM*(k+1)] = 0. ; } break; case VECTOR : case TENSOR_DIAG : for (k = 0 ; k < Current.NbrHar ; k+=2) { V->Val[MAX_DIM*k ] = A->Val[MAX_DIM*(k+1) ] ; V->Val[MAX_DIM*k+1] = A->Val[MAX_DIM*(k+1)+1] ; V->Val[MAX_DIM*k+2] = A->Val[MAX_DIM*(k+1)+2] ; V->Val[MAX_DIM*(k+1) ] = 0. ; V->Val[MAX_DIM*(k+1)+1] = 0. ; V->Val[MAX_DIM*(k+1)+2] = 0. ; } break; case TENSOR_SYM : for (k = 0 ; k < Current.NbrHar ; k+=2) { V->Val[MAX_DIM*k ] = A->Val[MAX_DIM*(k+1) ] ; V->Val[MAX_DIM*k+1] = A->Val[MAX_DIM*(k+1)+1] ; V->Val[MAX_DIM*k+2] = A->Val[MAX_DIM*(k+1)+2] ; V->Val[MAX_DIM*k+3] = A->Val[MAX_DIM*(k+1)+3] ; V->Val[MAX_DIM*k+4] = A->Val[MAX_DIM*(k+1)+4] ; V->Val[MAX_DIM*k+5] = A->Val[MAX_DIM*(k+1)+5] ; V->Val[MAX_DIM*(k+1) ] = 0. ; V->Val[MAX_DIM*(k+1)+1] = 0. ; V->Val[MAX_DIM*(k+1)+2] = 0. ; V->Val[MAX_DIM*(k+1)+3] = 0. ; V->Val[MAX_DIM*(k+1)+4] = 0. ; V->Val[MAX_DIM*(k+1)+5] = 0. ; } break; case TENSOR : for (k = 0 ; k < Current.NbrHar ; k+=2) { V->Val[MAX_DIM*k ] = A->Val[MAX_DIM*(k+1) ] ; V->Val[MAX_DIM*k+1] = A->Val[MAX_DIM*(k+1)+1] ; V->Val[MAX_DIM*k+2] = A->Val[MAX_DIM*(k+1)+2] ; V->Val[MAX_DIM*k+3] = A->Val[MAX_DIM*(k+1)+3] ; V->Val[MAX_DIM*k+4] = A->Val[MAX_DIM*(k+1)+4] ; V->Val[MAX_DIM*k+5] = A->Val[MAX_DIM*(k+1)+5] ; V->Val[MAX_DIM*k+6] = A->Val[MAX_DIM*(k+1)+6] ; V->Val[MAX_DIM*k+7] = A->Val[MAX_DIM*(k+1)+7] ; V->Val[MAX_DIM*k+8] = A->Val[MAX_DIM*(k+1)+8] ; V->Val[MAX_DIM*(k+1) ] = 0. ; V->Val[MAX_DIM*(k+1)+1] = 0. ; V->Val[MAX_DIM*(k+1)+2] = 0. ; V->Val[MAX_DIM*(k+1)+3] = 0. ; V->Val[MAX_DIM*(k+1)+4] = 0. ; V->Val[MAX_DIM*(k+1)+5] = 0. ; V->Val[MAX_DIM*(k+1)+6] = 0. ; V->Val[MAX_DIM*(k+1)+7] = 0. ; V->Val[MAX_DIM*(k+1)+8] = 0. ; } break; default : Message::Error("Unknown type of arguments in function 'Re'"); break; } V->Type = A->Type ; } /* ------------------------------------------------------------------------ */ /* Conjugate */ /* ------------------------------------------------------------------------ */ void F_Conj(F_ARG) { int k ; switch (A->Type) { case SCALAR : for (k = 0 ; k < Current.NbrHar ; k+=2) { V->Val[MAX_DIM*k] = A->Val[MAX_DIM*k] ; V->Val[MAX_DIM*(k+1)] = -A->Val[MAX_DIM*(k+1)] ; } break; case VECTOR : case TENSOR_DIAG : for (k = 0 ; k < Current.NbrHar ; k+=2) { V->Val[MAX_DIM*k ] = A->Val[MAX_DIM*k ] ; V->Val[MAX_DIM*k+1] = A->Val[MAX_DIM*k+1] ; V->Val[MAX_DIM*k+2] = A->Val[MAX_DIM*k+2] ; V->Val[MAX_DIM*(k+1) ] = -A->Val[MAX_DIM*(k+1) ] ; V->Val[MAX_DIM*(k+1)+1] = -A->Val[MAX_DIM*(k+1)+1] ; V->Val[MAX_DIM*(k+1)+2] = -A->Val[MAX_DIM*(k+1)+2] ; } break; case TENSOR_SYM : for (k = 0 ; k < Current.NbrHar ; k+=2) { V->Val[MAX_DIM*k ] = A->Val[MAX_DIM*k ] ; V->Val[MAX_DIM*k+1] = A->Val[MAX_DIM*k+1] ; V->Val[MAX_DIM*k+2] = A->Val[MAX_DIM*k+2] ; V->Val[MAX_DIM*k+3] = A->Val[MAX_DIM*k+3] ; V->Val[MAX_DIM*k+4] = A->Val[MAX_DIM*k+4] ; V->Val[MAX_DIM*k+5] = A->Val[MAX_DIM*k+5] ; V->Val[MAX_DIM*(k+1) ] = -A->Val[MAX_DIM*(k+1) ] ; V->Val[MAX_DIM*(k+1)+1] = -A->Val[MAX_DIM*(k+1)+1] ; V->Val[MAX_DIM*(k+1)+2] = -A->Val[MAX_DIM*(k+1)+2] ; V->Val[MAX_DIM*(k+1)+3] = -A->Val[MAX_DIM*(k+1)+3] ; V->Val[MAX_DIM*(k+1)+4] = -A->Val[MAX_DIM*(k+1)+4] ; V->Val[MAX_DIM*(k+1)+5] = -A->Val[MAX_DIM*(k+1)+5] ; } break; case TENSOR : for (k = 0 ; k < Current.NbrHar ; k+=2) { V->Val[MAX_DIM*k ] = A->Val[MAX_DIM*k ] ; V->Val[MAX_DIM*k+1] = A->Val[MAX_DIM*k+1] ; V->Val[MAX_DIM*k+2] = A->Val[MAX_DIM*k+2] ; V->Val[MAX_DIM*k+3] = A->Val[MAX_DIM*k+3] ; V->Val[MAX_DIM*k+4] = A->Val[MAX_DIM*k+4] ; V->Val[MAX_DIM*k+5] = A->Val[MAX_DIM*k+5] ; V->Val[MAX_DIM*k+6] = A->Val[MAX_DIM*k+6] ; V->Val[MAX_DIM*k+7] = A->Val[MAX_DIM*k+7] ; V->Val[MAX_DIM*k+8] = A->Val[MAX_DIM*k+8] ; V->Val[MAX_DIM*(k+1) ] = -A->Val[MAX_DIM*(k+1) ] ; V->Val[MAX_DIM*(k+1)+1] = -A->Val[MAX_DIM*(k+1)+1] ; V->Val[MAX_DIM*(k+1)+2] = -A->Val[MAX_DIM*(k+1)+2] ; V->Val[MAX_DIM*(k+1)+3] = -A->Val[MAX_DIM*(k+1)+3] ; V->Val[MAX_DIM*(k+1)+4] = -A->Val[MAX_DIM*(k+1)+4] ; V->Val[MAX_DIM*(k+1)+5] = -A->Val[MAX_DIM*(k+1)+5] ; V->Val[MAX_DIM*(k+1)+6] = -A->Val[MAX_DIM*(k+1)+6] ; V->Val[MAX_DIM*(k+1)+7] = -A->Val[MAX_DIM*(k+1)+7] ; V->Val[MAX_DIM*(k+1)+8] = -A->Val[MAX_DIM*(k+1)+8] ; } break; default : Message::Error("Unknown type of arguments in function 'Conj'"); break; } V->Type = A->Type ; } /* -------------------------------------------------------------------------------- */ /* Cartesian coordinates (Re,Im) to polar coordinates (Amplitude,phase[Radians]) */ /* -------------------------------------------------------------------------------- */ void F_Cart2Pol(F_ARG) { int k ; double Re, Im; switch (A->Type) { case SCALAR : for (k = 0 ; k < Current.NbrHar ; k+=2) { Re = A->Val[MAX_DIM*k] ; Im = A->Val[MAX_DIM*(k+1)] ; V->Val[MAX_DIM*k] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1)] = atan2(Im,Re); } break; case VECTOR : case TENSOR_DIAG : for (k = 0 ; k < Current.NbrHar ; k+=2) { Re = A->Val[MAX_DIM*k ] ; Im = A->Val[MAX_DIM*(k+1) ] ; V->Val[MAX_DIM*k ] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1) ] = atan2(Im,Re); Re = A->Val[MAX_DIM*k+1] ; Im = A->Val[MAX_DIM*(k+1)+1] ; V->Val[MAX_DIM*k+1] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1)+1] = atan2(Im,Re); Re = A->Val[MAX_DIM*k+2] ; Im = A->Val[MAX_DIM*(k+1)+2] ; V->Val[MAX_DIM*k+2] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1)+2] = atan2(Im,Re); } break; case TENSOR_SYM : for (k = 0 ; k < Current.NbrHar ; k+=2) { Re = A->Val[MAX_DIM*k ] ; Im = A->Val[MAX_DIM*(k+1) ] ; V->Val[MAX_DIM*k ] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1) ] = atan2(Im,Re); Re = A->Val[MAX_DIM*k+1] ; Im = A->Val[MAX_DIM*(k+1)+1] ; V->Val[MAX_DIM*k+1] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1)+1] = atan2(Im,Re); Re = A->Val[MAX_DIM*k+2] ; Im = A->Val[MAX_DIM*(k+1)+2] ; V->Val[MAX_DIM*k+2] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1)+2] = atan2(Im,Re); Re = A->Val[MAX_DIM*k+3] ; Im = A->Val[MAX_DIM*(k+1)+3] ; V->Val[MAX_DIM*k+3] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1)+3] = atan2(Im,Re); Re = A->Val[MAX_DIM*k+4] ; Im = A->Val[MAX_DIM*(k+1)+4] ; V->Val[MAX_DIM*k+4] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1)+4] = atan2(Im,Re); Re = A->Val[MAX_DIM*k+5] ; Im = A->Val[MAX_DIM*(k+1)+5] ; V->Val[MAX_DIM*k+5] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1)+5] = atan2(Im,Re); } break; case TENSOR : for (k = 0 ; k < Current.NbrHar ; k+=2) { Re = A->Val[MAX_DIM*k ] ; Im = A->Val[MAX_DIM*(k+1) ] ; V->Val[MAX_DIM*k ] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1) ] = atan2(Im,Re); Re = A->Val[MAX_DIM*k+1] ; Im = A->Val[MAX_DIM*(k+1)+1] ; V->Val[MAX_DIM*k+1] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1)+1] = atan2(Im,Re); Re = A->Val[MAX_DIM*k+2] ; Im = A->Val[MAX_DIM*(k+1)+2] ; V->Val[MAX_DIM*k+2] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1)+2] = atan2(Im,Re); Re = A->Val[MAX_DIM*k+3] ; Im = A->Val[MAX_DIM*(k+1)+3] ; V->Val[MAX_DIM*k+3] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1)+3] = atan2(Im,Re); Re = A->Val[MAX_DIM*k+4] ; Im = A->Val[MAX_DIM*(k+1)+4] ; V->Val[MAX_DIM*k+4] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1)+4] = atan2(Im,Re); Re = A->Val[MAX_DIM*k+5] ; Im = A->Val[MAX_DIM*(k+1)+5] ; V->Val[MAX_DIM*k+5] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1)+5] = atan2(Im,Re); Re = A->Val[MAX_DIM*k+6] ; Im = A->Val[MAX_DIM*(k+1)+6] ; V->Val[MAX_DIM*k+6] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1)+6] = atan2(Im,Re); Re = A->Val[MAX_DIM*k+7] ; Im = A->Val[MAX_DIM*(k+1)+7] ; V->Val[MAX_DIM*k+7] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1)+7] = atan2(Im,Re); Re = A->Val[MAX_DIM*k+8] ; Im = A->Val[MAX_DIM*(k+1)+8] ; V->Val[MAX_DIM*k+8] = sqrt(SQU(Re)+SQU(Im)) ; V->Val[MAX_DIM*(k+1)+8] = atan2(Im,Re); } break; default : Message::Error("Unknown type of arguments in function 'Cart2Pol'"); break; } V->Type = A->Type ; } /* ------------------------------------------------------------------------ */ /* Create 1 Vector from 3 Scalar */ /* ------------------------------------------------------------------------ */ void F_Vector(F_ARG) { int k ; if(A->Type != SCALAR || (A+1)->Type != SCALAR || (A+2)->Type != SCALAR) Message::Error("Non scalar argument(s) for function 'Vector'"); for (k = 0 ; k < Current.NbrHar ; k++) { V->Val[MAX_DIM*k ] = (A )->Val[MAX_DIM*k] ; V->Val[MAX_DIM*k+1] = (A+1)->Val[MAX_DIM*k] ; V->Val[MAX_DIM*k+2] = (A+2)->Val[MAX_DIM*k] ; } V->Type = VECTOR ; } /* ------------------------------------------------------------------------ */ /* Create 1 Tensor from 9 Scalar */ /* ------------------------------------------------------------------------ */ void F_Tensor(F_ARG) { int k ; if( (A)->Type != SCALAR || (A+1)->Type != SCALAR || (A+2)->Type != SCALAR || (A+3)->Type != SCALAR || (A+4)->Type != SCALAR || (A+5)->Type != SCALAR || (A+6)->Type != SCALAR || (A+7)->Type != SCALAR || (A+8)->Type != SCALAR ) Message::Error("Non scalar argument(s) for function 'Tensor'"); for (k = 0 ; k < Current.NbrHar ; k++) { V->Val[MAX_DIM*k ] = (A )->Val[MAX_DIM*k] ; V->Val[MAX_DIM*k+1] = (A+1)->Val[MAX_DIM*k] ; V->Val[MAX_DIM*k+2] = (A+2)->Val[MAX_DIM*k] ; V->Val[MAX_DIM*k+3] = (A+3)->Val[MAX_DIM*k] ; V->Val[MAX_DIM*k+4] = (A+4)->Val[MAX_DIM*k] ; V->Val[MAX_DIM*k+5] = (A+5)->Val[MAX_DIM*k] ; V->Val[MAX_DIM*k+6] = (A+6)->Val[MAX_DIM*k] ; V->Val[MAX_DIM*k+7] = (A+7)->Val[MAX_DIM*k] ; V->Val[MAX_DIM*k+8] = (A+8)->Val[MAX_DIM*k] ; } V->Type = TENSOR ; } /* ------------------------------------------------------------------------ */ /* Create 1 Symmetric Tensor from 6 Scalar */ /* ------------------------------------------------------------------------ */ void F_TensorSym(F_ARG) { int k ; if( (A)->Type != SCALAR || (A+1)->Type != SCALAR || (A+2)->Type != SCALAR || (A+3)->Type != SCALAR || (A+4)->Type != SCALAR || (A+5)->Type != SCALAR ) Message::Error("Non scalar argument(s) for function 'TensorSym'"); for (k = 0 ; k < Current.NbrHar ; k++) { V->Val[MAX_DIM*k ] = (A )->Val[MAX_DIM*k] ; V->Val[MAX_DIM*k+1] = (A+1)->Val[MAX_DIM*k] ; V->Val[MAX_DIM*k+2] = (A+2)->Val[MAX_DIM*k] ; V->Val[MAX_DIM*k+3] = (A+3)->Val[MAX_DIM*k] ; V->Val[MAX_DIM*k+4] = (A+4)->Val[MAX_DIM*k] ; V->Val[MAX_DIM*k+5] = (A+5)->Val[MAX_DIM*k] ; } V->Type = TENSOR_SYM ; } /* ------------------------------------------------------------------------ */ /* Create 1 Diagonal Tensor from 3 Scalar */ /* ------------------------------------------------------------------------ */ void F_TensorDiag(F_ARG) { int k ; if(A->Type != SCALAR || (A+1)->Type != SCALAR || (A+2)->Type != SCALAR) Message::Error("Non scalar argument(s) for function 'TensorDiag'"); for (k = 0 ; k < Current.NbrHar ; k++) { V->Val[MAX_DIM*k ] = A->Val[MAX_DIM*k] ; V->Val[MAX_DIM*k+1] = (A+1)->Val[MAX_DIM*k] ; V->Val[MAX_DIM*k+2] = (A+2)->Val[MAX_DIM*k] ; } V->Type = TENSOR_DIAG ; } /* ------------------------------------------------------------------------ */ /* Create 1 Tensor from 3 Vector */ /* ------------------------------------------------------------------------ */ void F_TensorV(F_ARG) { int k ; if((A)->Type != VECTOR || (A+1)->Type != VECTOR || (A+2)->Type != VECTOR) Message::Error("Non scalar argument(s) for function 'TensorV'"); for (k = 0 ; k < Current.NbrHar ; k++) { V->Val[MAX_DIM*k ] = (A )->Val[MAX_DIM*k ] ; V->Val[MAX_DIM*k+1] = (A )->Val[MAX_DIM*k+1] ; V->Val[MAX_DIM*k+2] = (A )->Val[MAX_DIM*k+2] ; V->Val[MAX_DIM*k+3] = (A+1)->Val[MAX_DIM*k ] ; V->Val[MAX_DIM*k+4] = (A+1)->Val[MAX_DIM*k+1] ; V->Val[MAX_DIM*k+5] = (A+1)->Val[MAX_DIM*k+2] ; V->Val[MAX_DIM*k+6] = (A+2)->Val[MAX_DIM*k ] ; V->Val[MAX_DIM*k+7] = (A+2)->Val[MAX_DIM*k+1] ; V->Val[MAX_DIM*k+8] = (A+2)->Val[MAX_DIM*k+2] ; } V->Type = TENSOR ; } /* ------------------------------------------------------------------------ */ /* Dyadic product */ /* ------------------------------------------------------------------------ */ void F_SquDyadicProduct(F_ARG) { int k ; double t11, t12, t13, t22, t23, t33 ; if (A->Type != VECTOR) Message::Error("Non vector argument for function 'TensorDyadic'"); t11 = SQU(A->Val[0]) ; t22 = SQU(A->Val[1]) ; t33 = SQU(A->Val[2]) ; t12 = A->Val[0] * A->Val[1] ; t13 = A->Val[0] * A->Val[2] ; t23 = A->Val[1] * A->Val[2] ; V->Val[0] = t11 ; V->Val[1] = t12 ; V->Val[2] = t13 ; V->Val[3] = t22 ; V->Val[4] = t23 ; V->Val[5] = t33 ; /* Attention : a revoir */ if (Current.NbrHar > 1) { V->Val[MAX_DIM ] = V->Val[MAX_DIM+1] = V->Val[MAX_DIM+2] = V->Val[MAX_DIM+3] = V->Val[MAX_DIM+4] = V->Val[MAX_DIM+5] = 0. ; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k++) { V->Val[MAX_DIM*k ] = V->Val[MAX_DIM*k+1] = V->Val[MAX_DIM*k+2] = V->Val[MAX_DIM*k+3] = V->Val[MAX_DIM*k+4] = V->Val[MAX_DIM*k+5] = 0. ; } } V->Type = TENSOR_SYM ; } /* ------------------------------------------------------------------------ */ /* Get Vector Components */ /* ------------------------------------------------------------------------ */ #define get_comp_vector(index, string) \ int k ; \ \ if(A->Type != VECTOR) \ Message::Error("Non vector argument for function '" string "'"); \ \ for (k = 0 ; k < Current.NbrHar ; k++) { \ V->Val[MAX_DIM*k ] = A->Val[MAX_DIM*k+index] ; \ } \ V->Type = SCALAR ; void F_CompX(F_ARG){ get_comp_vector(0, "CompX") } void F_CompY(F_ARG){ get_comp_vector(1, "CompY") } void F_CompZ(F_ARG){ get_comp_vector(2, "CompZ") } void F_Comp(F_ARG){ if (Fct->NbrParameters != 1) Message::Error("Function 'Comp': one parameter needed to define component index"); if ((int)(Fct->Para[0]) < 0 || (int)(Fct->Para[0]) > 2) Message::Error("Function 'Comp': parameter (%g) out of range (must be 0, 1 or 2)", Fct->Para[0]); get_comp_vector((int)(Fct->Para[0]), "Comp") } #undef get_comp_vector /* ------------------------------------------------------------------------ */ /* Get Tensor Components */ /* ------------------------------------------------------------------------ */ #define get_comp_tensor(i, is, id, string) \ int k ; \ \ switch(A->Type) { \ case TENSOR : \ for (k=0; kVal[MAX_DIM*k] = A->Val[MAX_DIM*k+(i)] ; \ break ; \ case TENSOR_SYM : \ for (k=0; kVal[MAX_DIM*k] = A->Val[MAX_DIM*k+(is)] ; \ break ; \ case TENSOR_DIAG : \ if(id >= 0) \ for (k=0; kVal[MAX_DIM*k] = A->Val[MAX_DIM*k+(id)] ; \ else \ for (k=0; kVal[MAX_DIM*k] = 0.; \ break ; \ default : \ Message::Error("Non tensor argument for function '" string "'"); \ break; \ } \ V->Type = SCALAR ; void F_CompXX(F_ARG){ get_comp_tensor(0,0, 0,"CompXX") } void F_CompXY(F_ARG){ get_comp_tensor(1,1,-1,"CompXY") } void F_CompXZ(F_ARG){ get_comp_tensor(2,2,-1,"CompXZ") } void F_CompYX(F_ARG){ get_comp_tensor(3,1,-1,"CompYX") } void F_CompYY(F_ARG){ get_comp_tensor(4,3, 1,"CompYY") } void F_CompYZ(F_ARG){ get_comp_tensor(5,4,-1,"CompYZ") } void F_CompZX(F_ARG){ get_comp_tensor(6,2,-1,"CompZX") } void F_CompZY(F_ARG){ get_comp_tensor(7,4,-1,"CompZY") } void F_CompZZ(F_ARG){ get_comp_tensor(8,5, 2,"CompZZ") } #undef get_comp_tensor /* ------------------------------------------------------------------------ */ /* Get Tensor for transformation of vector */ /* from cartesian to spherical coordinate system */ /* ------------------------------------------------------------------------ */ void F_Cart2Sph(F_ARG) { int k ; double theta, phi ; if((A)->Type != VECTOR) Message::Error("Vector argument required for Function 'Cart2Sph'"); /* Warning! This is the physic's convention. For the math convention, switch theta and phi. */ theta = atan2( sqrt(SQU(A->Val[0])+ SQU(A->Val[1])) , A->Val[2] ) ; phi = atan2( A->Val[1] , A->Val[0] ) ; /* r basis vector */ V->Val[0] = sin(theta) * cos(phi) ; V->Val[1] = sin(theta) * sin(phi) ; V->Val[2] = cos(theta) ; /* theta basis vector */ V->Val[3] = cos(theta) * cos(phi) ; V->Val[4] = cos(theta) * sin(phi) ; V->Val[5] = - sin(theta) ; /* phi basis vector */ V->Val[6] = - sin(phi) ; V->Val[7] = cos(phi) ; V->Val[8] = 0. ; for (k = 0 ; k < Current.NbrHar ; k+=2) { V->Val[MAX_DIM*k ] = V->Val[0] ; V->Val[MAX_DIM*k+1] = V->Val[1] ; V->Val[MAX_DIM*k+2] = V->Val[2] ; V->Val[MAX_DIM*k+3] = V->Val[3] ; V->Val[MAX_DIM*k+4] = V->Val[4] ; V->Val[MAX_DIM*k+5] = V->Val[5] ; V->Val[MAX_DIM*k+6] = V->Val[6] ; V->Val[MAX_DIM*k+7] = V->Val[7] ; V->Val[MAX_DIM*k+8] = V->Val[8] ; V->Val[MAX_DIM*(k+1) ] = 0. ; V->Val[MAX_DIM*(k+1)+1] = 0. ; V->Val[MAX_DIM*(k+1)+2] = 0. ; V->Val[MAX_DIM*(k+1)+3] = 0. ; V->Val[MAX_DIM*(k+1)+4] = 0. ; V->Val[MAX_DIM*(k+1)+5] = 0. ; V->Val[MAX_DIM*(k+1)+6] = 0. ; V->Val[MAX_DIM*(k+1)+7] = 0. ; V->Val[MAX_DIM*(k+1)+8] = 0. ; } V->Type = TENSOR ; } /* ------------------------------------------------------------------------ */ /* Get Tensor for transformation of vector */ /* from cartesian to cylindric coordinate system */ /* vector -> Cart2Cyl[XYZ[]] * vector */ /* (x,y,z)-components -> (radial, tangential, axial)-components */ /* ------------------------------------------------------------------------ */ void F_Cart2Cyl(F_ARG) { int k ; double theta ; if((A)->Type != VECTOR) Message::Error("Vector argument required for Function 'Cart2Cyl'"); theta = atan2(A->Val[1] , A->Val[0]) ; V->Val[0] = cos(theta) ; V->Val[1] = sin(theta) ; V->Val[2] = 0 ; V->Val[3] = -sin(theta) ; V->Val[4] = cos(theta) ; V->Val[5] = 0 ; V->Val[6] = 0 ; V->Val[7] = 0 ; V->Val[8] = 1. ; for (k = 0 ; k < Current.NbrHar ; k+=2) { V->Val[MAX_DIM*k ] = V->Val[0] ; V->Val[MAX_DIM*k+1] = V->Val[1] ; V->Val[MAX_DIM*k+2] = V->Val[2] ; V->Val[MAX_DIM*k+3] = V->Val[3] ; V->Val[MAX_DIM*k+4] = V->Val[4] ; V->Val[MAX_DIM*k+5] = V->Val[5] ; V->Val[MAX_DIM*k+6] = V->Val[6] ; V->Val[MAX_DIM*k+7] = V->Val[7] ; V->Val[MAX_DIM*k+8] = V->Val[8] ; V->Val[MAX_DIM*(k+1) ] = 0. ; V->Val[MAX_DIM*(k+1)+1] = 0. ; V->Val[MAX_DIM*(k+1)+2] = 0. ; V->Val[MAX_DIM*(k+1)+3] = 0. ; V->Val[MAX_DIM*(k+1)+4] = 0. ; V->Val[MAX_DIM*(k+1)+5] = 0. ; V->Val[MAX_DIM*(k+1)+6] = 0. ; V->Val[MAX_DIM*(k+1)+7] = 0. ; V->Val[MAX_DIM*(k+1)+8] = 0. ; } V->Type = TENSOR ; } /* ------------------------------------------------------------------------ */ /* U n i t V e c t o r X, Y, Z */ /* ------------------------------------------------------------------------ */ void F_UnitVectorX(F_ARG) { int k ; for (k = 0 ; k < Current.NbrHar ; k++) { V->Val[MAX_DIM*k ] = (k)? 0.:1. ; V->Val[MAX_DIM*k+1] = 0. ; V->Val[MAX_DIM*k+2] = 0. ; } V->Type = VECTOR ; } void F_UnitVectorY(F_ARG) { int k ; for (k = 0 ; k < Current.NbrHar ; k++) { V->Val[MAX_DIM*k ] = 0. ; V->Val[MAX_DIM*k+1] = (k)? 0.:1. ; V->Val[MAX_DIM*k+2] = 0. ; } V->Type = VECTOR ; } void F_UnitVectorZ(F_ARG) { int k ; for (k = 0 ; k < Current.NbrHar ; k++) { V->Val[MAX_DIM*k ] = 0. ; V->Val[MAX_DIM*k+1] = 0. ; V->Val[MAX_DIM*k+2] = (k)? 0.:1. ; } V->Type = VECTOR ; } getdp-2.7.0-source/Legacy/F_Analytic.cpp000644 001750 001750 00000164773 12473553042 021551 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Ruth Sabariego // Xavier Antoine // #include #include "ProData.h" #include "F.h" #include "Legendre.h" #include "Bessel.h" #include "MallocUtils.h" #include "Message.h" #define SQU(a) ((a)*(a)) /* some utility functions to deal with complex numbers */ typedef struct { double r; double i; } cplx; static cplx Csum(cplx a, cplx b) { cplx s; s.r = a.r + b.r; s.i = a.i + b.i; return(s); } static cplx Csub(cplx a, cplx b) { cplx s; s.r = a.r - b.r; s.i = a.i - b.i; return(s); } static cplx Csubr(double a, cplx b) { cplx s; s.r = a - b.r; s.i = - b.i; return(s); } static cplx Cprod(cplx a, cplx b) { cplx s; s.r = a.r * b.r - a.i * b.i; s.i = a.r * b.i + a.i * b.r; return(s); } static cplx Cdiv(cplx a, cplx b) { cplx s; double den; den = b.r * b.r + b.i * b.i; s.r = (a.r * b.r + a.i * b.i) / den; s.i = (a.i * b.r - a.r * b.i) / den; return(s); } static cplx Cdivr(double a, cplx b) { cplx s; double den; den = b.r * b.r + b.i * b.i; s.r = (a * b.r) / den; s.i = (- a * b.i) / den; return(s); } static cplx Cconj(cplx a) { cplx s; s.r = a.r; s.i = -a.i; return(s); } static cplx Cneg(cplx a) { cplx s; s.r = -a.r; s.i = -a.i; return(s); } static double Cmodu(cplx a) { return(sqrt(a.r * a.r + a.i * a.i)); } static cplx Cpow(cplx a, double b) { cplx s; double mod, arg; mod = a.r * a.r + a.i * a.i; arg = atan2(a.i,a.r); mod = pow(mod,0.5*b); arg *= b; s.r = mod * cos(arg); s.i = mod * sin(arg); return(s); } static cplx Cprodr(double a, cplx b) { cplx s; s.r = a * b.r; s.i = a * b.i; return(s); } /* ------------------------------------------------------------------------ */ /* Exact solutions for spheres */ /* ------------------------------------------------------------------------ */ /* Scattering by solid PEC sphere. Returns theta-component of surface current */ void F_JFIE_SphTheta(F_ARG) { double k0, r, kr, e0, eta, theta, phi, a1, b1, c1, d1, den1, P, P0, dP ; double ctheta, stheta, cteRe1, cteRe2, a2, b2, c2, d2, den2 ; int i, n ; theta = atan2(sqrt( A->Val[0]* A->Val[0] + A->Val[1]*A->Val[1] ), A->Val[2]); phi = atan2( A->Val[1], A->Val[0] ) ; k0 = Fct->Para[0] ; eta = Fct->Para[1] ; e0 = Fct->Para[2] ; r = Fct->Para[3] ; kr = k0*r ; n = 50 ; V->Val[0] = 0.; V->Val[MAX_DIM] = 0. ; if ( theta == 0. ) theta += 1e-7; /* Warning! This is an approximation. */ if ( theta == M_PI || theta == -M_PI ) theta -= 1e-7; for (i = 1 ; i <= n ; i++ ){ ctheta = cos(theta); stheta = sin(theta); P = Legendre(i,1,ctheta); P0 = Legendre(i,0,ctheta); dP = (i+1)*i* P0/stheta-(ctheta/(ctheta*ctheta-1))* P; cteRe1 = (2*i+1) * stheta * dP/i/(i+1); cteRe2 = (2*i+1) * P/stheta/i/(i+1); a1 = cos((1-i)*M_PI/2) ; b1 = sin((1-i)*M_PI/2) ; c1 = -AltSpherical_j_n(i+1, kr) + (i+1) * AltSpherical_j_n(i, kr)/kr ; /* Derivative */ d1 = -(-AltSpherical_y_n(i+1, kr) + (i+1) * AltSpherical_y_n(i, kr)/kr) ; a2 = cos((2-i)*M_PI/2) ; b2 = sin((2-i)*M_PI/2) ; c2 = AltSpherical_j_n(i, kr) ; d2 = -AltSpherical_y_n(i, kr) ; den1 = c1*c1+d1*d1 ; den2 = c2*c2+d2*d2 ; V->Val[0] += cteRe1*(a1*c1+b1*d1)/den1 + cteRe2*(a2*c2+b2*d2)/den2 ; V->Val[MAX_DIM] += cteRe1*(b1*c1-a1*d1)/den1 + cteRe2*(b2*c2-a2*d2)/den2 ; } V->Val[0] *= e0*cos(phi)/eta/kr ; V->Val[MAX_DIM] *= e0*cos(phi)/eta/kr ; V->Type = SCALAR ; } /* Scattering by solid PEC sphere. Returns theta-component of RCS */ void F_RCS_SphTheta(F_ARG) { double k0, r, kr, e0, rinf, krinf, theta, phi, a1 =0., b1=0., d1, den1, P, P0, dP ; double J, J_1, dJ, ctheta, stheta, cteRe1, cteRe2, a2, b2, d2, den2, lambda ; int i, n ; theta = atan2(sqrt( A->Val[0]* A->Val[0] + A->Val[1]*A->Val[1] ), A->Val[2]); phi = atan2( A->Val[1], A->Val[0] ) ; k0 = Fct->Para[0] ; e0 = Fct->Para[1] ; r = Fct->Para[2] ; rinf = Fct->Para[3] ; kr = k0*r ; krinf = k0*rinf ; lambda = 2*M_PI/k0 ; n = 50 ; if ( theta == 0. ) theta += 1e-7; /* Warning! This is an approximation. */ if ( theta == M_PI || theta == -M_PI ) theta -= 1e-7; for (i = 1 ; i <= n ; i++ ){ ctheta = cos(theta); stheta = sin(theta); P = Legendre(i,1,ctheta); P0 = Legendre(i,0,ctheta); dP = (i+1)*i* P0/stheta-(ctheta/(ctheta*ctheta-1))* P; J = AltSpherical_j_n(i, kr) ; J_1 = AltSpherical_j_n(i+1, kr) ; dJ = -J_1 + (i + 1) * J/kr ; cteRe1 = -(2*i+1) * stheta * dP * dJ /i/(i+1); cteRe2 = (2*i+1) * P * J /stheta/i/(i+1); d1 = -(-AltSpherical_y_n(i+1, kr) + (i+1) * AltSpherical_y_n(i, kr)/kr) ; d2 = -AltSpherical_y_n(i, kr) ; den1 = dJ*dJ+d1*d1 ; den2 = J*J+d2*d2 ; a1 += cteRe1 * dJ /den1 + cteRe2 * J /den2 ; b1 += cteRe1*(-d1) /den1 + cteRe2*(-d2) /den2 ; } a2 = e0*cos(phi)*sin(krinf)/krinf ; b2 = e0*cos(phi)*cos(krinf)/krinf ; V->Val[0] = 10*log10( 4*M_PI*SQU(rinf/lambda)*(SQU(a1*a2-b1*b2) + SQU(a1*b2+a2*b1)) ); V->Val[MAX_DIM] = 0. ; V->Type = SCALAR ; } /* Scattering by solid PEC sphere. Returns phi-component of surface current */ void F_JFIE_SphPhi(F_ARG) { double k0, r, kr, e0, eta, theta, phi, a1, b1, c1, d1, den1, P, P0, dP ; double ctheta, stheta, cteRe1, cteRe2, a2, b2, c2, d2, den2 ; int i, n ; theta = atan2( sqrt( A->Val[0]*A->Val[0] + A->Val[1]*A->Val[1] ), A->Val[2]); phi = atan2( A->Val[1], A->Val[0] ) ; k0 = Fct->Para[0] ; eta = Fct->Para[1] ; e0 = Fct->Para[2] ; r = Fct->Para[3] ; kr = k0*r ; n = 50 ; V->Val[0] = 0.; V->Val[MAX_DIM] = 0. ; if ( theta == 0. ) theta += 1e-7; /* Warning! This is an approximation. */ if ( theta == M_PI || theta == -M_PI ) theta -= 1e-7; for (i = 1 ; i <= n ; i++ ){ ctheta = cos(theta); stheta = sin(theta); P = Legendre(i,1,ctheta); P0 = Legendre(i,0,ctheta); dP = (i+1)*i* P0/stheta - ctheta/(ctheta*ctheta-1)*P; /* Derivative */ cteRe1 = (2*i+1) * P /i/(i+1)/stheta; cteRe2 = (2*i+1) * stheta * dP/i/(i+1); a1 = cos((1-i)*M_PI/2) ; b1 = sin((1-i)*M_PI/2) ; c1 = -AltSpherical_j_n(i+1, kr) + (i+1)*AltSpherical_j_n(i, kr)/kr ; /* Derivative */ d1 = -(-AltSpherical_y_n(i+1, kr) + (i+1)*AltSpherical_y_n(i, kr)/kr) ; a2 = cos((2-i)*M_PI/2) ; b2 = sin((2-i)*M_PI/2) ; c2 = AltSpherical_j_n(i, kr) ; d2 = -AltSpherical_y_n(i, kr) ; den1 = c1*c1+d1*d1 ; den2 = c2*c2+d2*d2 ; V->Val[0] += cteRe1*(a1*c1+b1*d1)/den1 + cteRe2*(a2*c2+b2*d2)/den2 ; V->Val[MAX_DIM] += cteRe1*(b1*c1-a1*d1)/den1 + cteRe2*(b2*c2-a2*d2)/den2 ; } V->Val[0] *= e0*sin(phi)/eta/kr ; V->Val[MAX_DIM] *= e0*sin(phi)/eta/kr ; V->Type = SCALAR ; } /* Scattering by solid PEC sphere. Returns phi-component of RCS */ void F_RCS_SphPhi(F_ARG) { double k0, r, kr, e0, rinf, krinf, theta, phi, a1 =0., b1=0., d1, den1, P, P0, dP ; double J, J_1, dJ, ctheta, stheta, cteRe1, cteRe2, a2, b2, d2, den2, lambda ; int i, n ; theta = atan2(sqrt( A->Val[0]* A->Val[0] + A->Val[1]*A->Val[1] ), A->Val[2]); phi = M_PI/2 ; k0 = Fct->Para[0] ; e0 = Fct->Para[1] ; r = Fct->Para[2] ; rinf = Fct->Para[3] ; kr = k0*r ; krinf = k0*rinf ; lambda = 2*M_PI/k0 ; n = 50 ; if ( theta == 0. ) theta += 1e-7; /* Warning! This is an approximation. */ if ( theta == M_PI || theta == -M_PI ) theta -= 1e-7; for (i = 1 ; i <= n ; i++ ){ ctheta = cos(theta); stheta = sin(theta); P = Legendre(i,1,ctheta); P0 = Legendre(i,0,ctheta); dP = (i+1)*i* P0/stheta-(ctheta/(ctheta*ctheta-1))* P; J = AltSpherical_j_n(i, kr) ; J_1 = AltSpherical_j_n(i+1, kr) ; dJ = -J_1 + (i + 1) * J/kr ; cteRe1 = -(2*i+1) * P * dJ /stheta/i/(i+1); cteRe2 = (2*i+1) * stheta * dP * J/i/(i+1); d1 = -(-AltSpherical_y_n(i+1, kr) + (i+1) * AltSpherical_y_n(i, kr)/kr) ; d2 = -AltSpherical_y_n(i, kr) ; den1 = dJ*dJ+d1*d1 ; den2 = J*J+d2*d2 ; a1 += cteRe1 * dJ /den1 + cteRe2 * J /den2 ; b1 += cteRe1*(-d1) /den1 + cteRe2*(-d2) /den2 ; } a2 = e0*sin(phi)*sin(krinf)/krinf ; b2 = e0*sin(phi)*cos(krinf)/krinf ; V->Val[0] = 10*log10( 4*M_PI*SQU(rinf/lambda)*(SQU(a1*a2-b1*b2) + SQU(a1*b2+a2*b1)) ); V->Val[MAX_DIM] = 0. ; V->Type = SCALAR ; } /* Scattering by a perfectly conducting sphere of radius a, under plane wave incidence pol*e^{ik \alpha\dot\r}, with alpha = (0,0,-1) and pol = (1,0,0). Returns the scattered electric field anywhere outside the sphere (From Balanis, Advanced Engineering Electromagnetics, sec 11.8, p. 660) Warning This is probably wring :-) */ // diffraction onde plane par une sphere diectrique en -iwt void F_ElectricFieldDielectricSphereMwt(F_ARG) { double x = A->Val[0]; double y = A->Val[1]; double z = A->Val[2]; double r = sqrt(x * x + y * y + z * z); double theta = atan2(sqrt(x * x + y * y), z); double phi = atan2(y, x); double k = Fct->Para[0] ; double a = Fct->Para[1] ; double kr = k * r; double ka = k * a; double epsi = 2.25; double ki = k*sqrt(epsi); double Zi = 1.0 / sqrt(epsi); double kia = ki * a; double kir = ki * r; int ns = (int)k + 12; std::vector > Hnkr(ns + 1), Hnka(ns + 1), Hnkir(ns + 1), Hnkia(ns + 1); for (int n = 1 ; n <= ns ; n++){ Hnkr[n] = std::complex(AltSpherical_j_n(n, kr), AltSpherical_y_n(n, kr)); Hnka[n] = std::complex(AltSpherical_j_n(n, ka), AltSpherical_y_n(n, ka)); Hnkia[n] = std::complex(AltSpherical_j_n(n, kia), AltSpherical_y_n(n, kia)); Hnkir[n] = std::complex(AltSpherical_j_n(n, kir), AltSpherical_y_n(n, kir)); } double ctheta = cos(theta); double stheta = sin(theta); std::complex Er(0.,0), Etheta(0.,0), Ephi(0.,0), I(0, 1.); if( theta == 0.) { if (r >= a ) { for (int n = 1 ; n < ns ; n++){ std::complex an = pow(-I, n) * (2. * n + 1.) / (n * (n + 1.)); double A1 = -n * (n + 1.) / 2.; std::complex dHnka = - Hnka[n + 1] + (n + 1.) * Hnka[n] / ka; std::complex dHnkia = - Hnkia[n + 1] + (n + 1.) * Hnkia[n] / kia; std::complex aln = (dHnka.real() * Hnkia[n].real() - Zi * dHnkia.real() * Hnka[n].real() ) / (Zi*dHnkia.real() * Hnka[n] - dHnka * Hnkia[n].real()) ; std::complex ben = (dHnkia.real() * Hnka[n].real() - Zi * dHnka.real() * Hnkia[n].real() ) / (Zi*Hnkia[n].real() * dHnka - dHnkia.real() * Hnka[n]) ; std::complex dn = aln*an; std::complex dHnkr = - Hnkr[n + 1] + (n + 1.) * Hnkr[n] / kr; std::complex d2Hnkr = Hnkr[n] / kr; std::complex jnkr = Hnkr[n].real() / kr; double Pn1 = Legendre(n, 1, ctheta); Er += (n * (n + 1.) * d2Hnkr * dn + n * (n + 1.) * jnkr * an ) * Pn1; Etheta += an * (I * aln * dHnkr * A1 + ben * Hnkr[n] * A1 + I * dHnkr.real() * A1 + Hnkr[n].real() * A1 ); Ephi += an * (I * aln * dHnkr * A1 + ben * Hnkr[n] * A1 + I * dHnkr.real() * A1 + Hnkr[n].real() * A1 ); } Er *= I * cos(phi) / kr; Etheta *= (1. / kr) * (cos(phi)); Ephi *= (-1. / kr) * (sin(phi)); } else { for (int n = 1 ; n < ns ; n++){ std::complex an = pow(-I, n) * (2. * n + 1.) / (n * (n + 1.)); double A1 = -n * (n + 1.) / 2.; std::complex dHnka = - Hnka[n + 1] + (n + 1.) * Hnka[n] / ka; std::complex dHnkia = - Hnkia[n + 1] + (n + 1.) * Hnkia[n] / kia; std::complex dHnkir = - Hnkir[n + 1] + (n + 1.) * Hnkir[n] / kir; std::complex den = (ki * Zi / k) * (dHnka * Hnka[n].real() - dHnka.real() * Hnka[n] ) / (Zi*Hnkia[n].real() * dHnka - dHnkia.real() * Hnka[n]) ; std::complex gan = (ki * Zi / k) * (dHnka.real() * Hnka[n] - dHnka * Hnka[n].real() ) / (Zi*dHnkia.real() * Hnka[n] - dHnka * Hnkia[n].real()) ; std::complex dn = gan*an; std::complex jnkir = Hnkir[n].real() / kir; double Pn1 = Legendre(n, 1, ctheta); Er += (n * (n + 1.) * jnkir * dn ) * Pn1; Etheta += an * (I * gan * dHnkir.real() * A1 + den * Hnkir[n].real() * A1 ); Ephi += an * (I * gan * dHnkir.real() * A1 + den * Hnkir[n].real() * A1 ); } Er *= I * cos(phi) / kir; Etheta *= (1. / kir) * (cos(phi)); Ephi *= (-1. / kir) * (sin(phi)); } } else if( theta == M_PI ) { if (r >= a ) { for (int n = 1 ; n < ns ; n++){ std::complex an = pow(-I, n) * (2. * n + 1.) / (n * (n + 1.)); double A2 = -pow(-1, n + 1) * n * (n + 1.) / 2.; double A3 = -pow(-1, n ) * n * (n + 1.) / 2.; std::complex dHnka = - Hnka[n + 1] + (n + 1.) * Hnka[n] / ka; std::complex dHnkia = - Hnkia[n + 1] + (n + 1.) * Hnkia[n] / kia; std::complex aln = (dHnka.real() * Hnkia[n].real() - Zi * dHnkia.real() * Hnka[n].real() ) / (Zi*dHnkia.real() * Hnka[n] - dHnka * Hnkia[n].real()) ; std::complex ben = (dHnkia.real() * Hnka[n].real() - Zi * dHnka.real() * Hnkia[n].real() ) / (Zi*Hnkia[n].real() * dHnka - dHnkia.real() * Hnka[n]) ; std::complex dn = aln*an; std::complex dHnkr = - Hnkr[n + 1] + (n + 1.) * Hnkr[n] / kr; std::complex d2Hnkr = Hnkr[n] / kr; std::complex jnkr = Hnkr[n].real() / kr; double Pn1 = Legendre(n, 1, ctheta); Er += (n * (n + 1.) * d2Hnkr * dn + n * (n + 1.) * jnkr * an ) * Pn1; Etheta += an * (I * aln * dHnkr * A3 + ben * Hnkr[n] * A2 + I * dHnkr.real() * A3 + Hnkr[n].real() * A2 ); Ephi += an * (I * aln * dHnkr * A2 + ben * Hnkr[n] * A3 + I * dHnkr.real() * A2 + Hnkr[n].real() * A3 ); } Er *= I * cos(phi) / kr; Etheta *= (1. / kr) * (cos(phi)); Ephi *= (-1. / kr) * (sin(phi)); } else { for (int n = 1 ; n < ns ; n++){ std::complex an = pow(-I, n) * (2. * n + 1.) / (n * (n + 1.)); double A2 = -pow(-1, n + 1) * n * (n + 1.) / 2.; double A3 = -pow(-1, n ) * n * (n + 1.) / 2.; std::complex dHnka = - Hnka[n + 1] + (n + 1.) * Hnka[n] / ka; std::complex dHnkia = - Hnkia[n + 1] + (n + 1.) * Hnkia[n] / kia; std::complex dHnkir = - Hnkir[n + 1] + (n + 1.) * Hnkir[n] / kir; std::complex den = (ki * Zi / k) * (dHnka * Hnka[n].real() - dHnka.real() * Hnka[n] ) / (Zi*Hnkia[n].real() * dHnka - dHnkia.real() * Hnka[n]) ; std::complex gan = (ki * Zi / k) * (dHnka.real() * Hnka[n] - dHnka * Hnka[n].real() ) / (Zi*dHnkia.real() * Hnka[n] - dHnka * Hnkia[n].real()) ; std::complex dn = gan*an; std::complex jnkir = Hnkir[n].real() / kir; double Pn1 = Legendre(n, 1, ctheta); Er += (n * (n + 1.) * jnkir * dn ) * Pn1; Etheta += an * (I * gan * dHnkir.real() * A3 + den * Hnkir[n].real() * A2 ); Ephi += an * (I * gan * dHnkir.real() * A2 + den * Hnkir[n].real() * A3 ); } Er *= I * cos(phi) / kir; Etheta *= (1. / kir) * (cos(phi)); Ephi *= (-1. / kir) * (sin(phi)); } } else { if (r >= a ) { for (int n = 1 ; n < ns ; n++){ std::complex an = pow(-I, n) * (2. * n + 1.) / (n * (n + 1.)); std::complex dHnka = - Hnka[n + 1] + (n + 1.) * Hnka[n] / ka; std::complex dHnkia = - Hnkia[n + 1] + (n + 1.) * Hnkia[n] / kia; std::complex aln = (dHnka.real() * Hnkia[n].real() - Zi * dHnkia.real() * Hnka[n].real() ) / (Zi*dHnkia.real() * Hnka[n] - dHnka * Hnkia[n].real()) ; std::complex ben = (dHnkia.real() * Hnka[n].real() - Zi * dHnka.real() * Hnkia[n].real() ) / (Zi*Hnkia[n].real() * dHnka - dHnkia.real() * Hnka[n]) ; std::complex dn = aln*an; std::complex dHnkr = - Hnkr[n + 1] + (n + 1.) * Hnkr[n] / kr; std::complex d2Hnkr = Hnkr[n] / kr; std::complex jnkr = Hnkr[n].real() / kr; double Pn1 = Legendre(n, 1, ctheta); double Pn11 = Legendre(n+1, 1, ctheta); double dPn1 = n * Pn11 - (n + 1) * ctheta * Pn1 ; Er += (n * (n + 1.) * d2Hnkr * dn + n * (n + 1.) * jnkr * an ) * Pn1; Etheta += an * (I * aln * dHnkr * dPn1 + ben * Hnkr[n] * Pn1 + I * dHnkr.real() * dPn1 + Hnkr[n].real() * Pn1 ); Ephi += an * (I * aln * dHnkr * Pn1 + ben * Hnkr[n] * dPn1 + I * dHnkr.real() * Pn1 + Hnkr[n].real() * dPn1 ); } Er *= I * cos(phi) / kr; Etheta *= (1. / kr) * (cos(phi)/stheta); Ephi *= (-1. / kr) * (sin(phi)/stheta); } else { for (int n = 1 ; n < ns ; n++){ std::complex an = pow(-I, n) * (2. * n + 1.) / (n * (n + 1.)); std::complex dHnka = - Hnka[n + 1] + (n + 1.) * Hnka[n] / ka; std::complex dHnkia = - Hnkia[n + 1] + (n + 1.) * Hnkia[n] / kia; std::complex dHnkir = - Hnkir[n + 1] + (n + 1.) * Hnkir[n] / kir; std::complex den = (ki * Zi / k) * (dHnka * Hnka[n].real() - dHnka.real() * Hnka[n] ) / (Zi*Hnkia[n].real() * dHnka - dHnkia.real() * Hnka[n]) ; std::complex gan = (ki * Zi / k) * (dHnka.real() * Hnka[n] - dHnka * Hnka[n].real() ) / (Zi*dHnkia.real() * Hnka[n] - dHnka * Hnkia[n].real()) ; std::complex dn = gan*an; std::complex jnkir = Hnkir[n].real() / kir; double Pn1 = Legendre(n, 1, ctheta); double Pn11 = Legendre(n+1, 1, ctheta); double dPn1 = n * Pn11 - (n + 1) * ctheta * Pn1 ; Er += (n * (n + 1.) * jnkir * dn ) * Pn1; Etheta += an * (I * gan * dHnkir.real() * dPn1 + den * Hnkir[n].real() * Pn1 ); Ephi += an * (I * gan * dHnkir.real() * Pn1 + den * Hnkir[n].real() * dPn1 ); } Er *= I * cos(phi) / kir; Etheta *= (1. / kir) * (cos(phi)/stheta); Ephi *= (-1. / kir) * (sin(phi)/stheta); } } // r, theta, phi components std::complex rtp[3] = {Er, Etheta, Ephi}; double mat[3][3]; // r basis vector mat[0][0] = sin(theta) * cos(phi) ; mat[0][1] = sin(theta) * sin(phi) ; mat[0][2] = cos(theta) ; // theta basis vector mat[1][0] = cos(theta) * cos(phi) ; mat[1][1] = cos(theta) * sin(phi) ; mat[1][2] = - sin(theta) ; // phi basis vector mat[2][0] = - sin(phi) ; mat[2][1] = cos(phi); mat[2][2] = 0.; // x, y, z components std::complex xyz[3] = {0., 0., 0.}; for(int i = 0; i < 3; i++) for(int j = 0; j < 3; j++) xyz[i] = xyz[i] + mat[j][i] * rtp[j]; V->Val[0] = xyz[0].real(); V->Val[1] = xyz[1].real(); V->Val[2] = xyz[2].real(); V->Val[MAX_DIM] = xyz[0].imag(); V->Val[MAX_DIM+1] = xyz[1].imag(); V->Val[MAX_DIM+2] = xyz[2].imag(); V->Type = VECTOR ; } // diffraction onde plane par une sphere PEC en -iwt void F_ElectricFieldPerfectlyConductingSphereMwt(F_ARG) { double x = A->Val[0]; double y = A->Val[1]; double z = A->Val[2]; double r = sqrt(x * x + y * y + z * z); double theta = atan2(sqrt(x * x + y * y), z); double phi = atan2(y, x); double k = Fct->Para[0] ; double a = Fct->Para[1] ; double kr = k * r; double ka = k * a; int ns = (int)k + 12; std::vector > Hnkr(ns + 1), Hnka(ns + 1); for (int n = 1 ; n <= ns ; n++){ Hnkr[n] = std::complex(AltSpherical_j_n(n, kr), AltSpherical_y_n(n, kr)); Hnka[n] = std::complex(AltSpherical_j_n(n, ka), AltSpherical_y_n(n, ka)); } double ctheta = cos(theta); double stheta = sin(theta); std::complex Er(0.,0), Etheta(0.,0), Ephi(0.,0), I(0, 1.); if( theta == 0.) { for (int n = 1 ; n < ns ; n++){ std::complex an = pow(-I, n) * (2. * n + 1.) / (n * (n + 1.)); double A1 = n * (n + 1.) / 2.; // PS: the following is correct (Hn(z) = z hn(z) is not a standard spherical // bessel function!) std::complex dHnka = - Hnka[n + 1] + (n + 1.) * Hnka[n] / ka; std::complex bn = - dHnka.real() / dHnka; std::complex cn = - Hnka[n].real() / Hnka[n]; std::complex dn = bn*an; std::complex dHnkr = - Hnkr[n + 1] + (n + 1.) * Hnkr[n] / kr; std::complex d2Hnkr = Hnkr[n] / kr; double Pn1 = Legendre(n, 1, ctheta); Er += n * (n + 1.) * d2Hnkr * Pn1 * dn; Etheta += an * (I * bn * dHnkr * A1 + cn * Hnkr[n] * A1); Ephi += an * (I * bn * dHnkr * A1 + cn * Hnkr[n] * A1); } Er *= I * cos(phi) / kr; Etheta *= (1. / kr) * (cos(phi)); Ephi *= (-1. / kr) * (sin(phi)); } else if( theta == M_PI ) { for (int n = 1 ; n < ns ; n++){ std::complex an = std::pow(-I, n) * (2. * n + 1.) / (n * (n + 1.)); double A2 = pow(-1, n + 1) * n * (n + 1.) / 2.; double A3 = pow(-1, n ) * n * (n + 1.) / 2.; // PS: the following is correct (Hn(z) = z hn(z) is not a standard spherical // bessel function!) std::complex dHnka = - Hnka[n + 1] + (n + 1.) * Hnka[n] / ka; std::complex bn = - dHnka.real() / dHnka; std::complex cn = - Hnka[n].real() / Hnka[n]; std::complex dn = bn*an; std::complex dHnkr = - Hnkr[n + 1] + (n + 1.) * Hnkr[n] / kr; std::complex d2Hnkr = Hnkr[n] / kr; double Pn1 = Legendre(n, 1, ctheta); Er += n * (n + 1.) * d2Hnkr * Pn1 * dn; Etheta += an * (I * bn * dHnkr * A3 + cn * Hnkr[n] * A2 ); Ephi += an * (I * bn * dHnkr * A2 + cn * Hnkr[n] * A3); } Er *= I * cos(phi) / kr; Etheta *= (1.0 / kr) * cos(phi); Ephi *= (-1.0 / kr) * sin(phi); } else { for (int n = 1 ; n < ns ; n++){ std::complex an = std::pow(-I, n) * (2. * n + 1.) / (n * (n + 1.)); // PS: the following is correct (Hn(z) = z hn(z) is not a standard spherical // bessel function!) std::complex dHnka = - Hnka[n + 1] + (n + 1.) * Hnka[n] / ka; std::complex bn = - dHnka.real() / dHnka; std::complex cn = - Hnka[n].real() / Hnka[n]; std::complex dn = bn * an; std::complex dHnkr = - Hnkr[n + 1] + (n + 1.) * Hnkr[n] / kr; std::complex d2Hnkr = Hnkr[n] / kr; double Pn1 = Legendre(n, 1, ctheta); double Pn11 = Legendre(n+1, 1, ctheta); double dPn1 = n * Pn11 - (n + 1) * ctheta * Pn1 ; Er += n * (n + 1.) * d2Hnkr * Pn1 * dn; Etheta += an * (I * bn * dHnkr * dPn1 + cn * Hnkr[n] * Pn1 ); Ephi += an * (I * bn * dHnkr * Pn1 + cn * Hnkr[n] * dPn1); } Er *= I * cos(phi) / kr; Etheta *= (1. / kr) * (cos(phi)/stheta); Ephi *= (-1. / kr) * (sin(phi)/stheta); } // r, theta, phi components std::complex rtp[3] = {Er, Etheta, Ephi}; double mat[3][3]; // r basis vector mat[0][0] = sin(theta) * cos(phi) ; mat[0][1] = sin(theta) * sin(phi) ; mat[0][2] = cos(theta) ; // theta basis vector mat[1][0] = cos(theta) * cos(phi) ; mat[1][1] = cos(theta) * sin(phi) ; mat[1][2] = - sin(theta) ; // phi basis vector mat[2][0] = - sin(phi) ; mat[2][1] = cos(phi); mat[2][2] = 0.; // x, y, z components std::complex xyz[3] = {0., 0., 0.}; for(int i = 0; i < 3; i++) for(int j = 0; j < 3; j++) xyz[i] = xyz[i] + mat[j][i] * rtp[j]; V->Val[0] = xyz[0].real(); V->Val[1] = xyz[1].real(); V->Val[2] = xyz[2].real(); V->Val[MAX_DIM] = xyz[0].imag(); V->Val[MAX_DIM+1] = xyz[1].imag(); V->Val[MAX_DIM+2] = xyz[2].imag(); V->Type = VECTOR ; } // calcul la solution exact de OSRC sur la sphere void F_ExactOsrcSolutionPerfectlyConductingSphereMwt(F_ARG) { double x = A->Val[0]; double y = A->Val[1]; double z = A->Val[2]; double theta = atan2(sqrt(x * x + y * y), z); double phi = atan2(y, x); double k = Fct->Para[0] ; double a = Fct->Para[1] ; double ka = k * a; int ns = (int)k + 10; std::vector > Hnka(ns + 1); for (int n = 1 ; n <= ns ; n++){ Hnka[n] = std::complex(AltSpherical_j_n(n, ka), AltSpherical_y_n(n, ka)); } double ctheta = cos(theta); double stheta = sin(theta); std::complex Er(0.,0), Etheta(0.,0), Ephi(0.,0), I(0, 1.); if( theta == 0.) { for (int n = 1 ; n < ns ; n++){ std::complex an = pow(-I, n) * (2. * n + 1.) / (n * (n + 1.)); double A1 = n * (n + 1.0) / 2.; double mu_n = 1 - n * (n + 1.0) / (k * k); std::complex dHnka = - Hnka[n + 1] + (n + 1.) * Hnka[n] / ka; std::complex bn = dHnka.real() ; std::complex cn = Hnka[n].real(); if ( k * k >= n * (n + 1) ) { Etheta += an * (-I * cn * A1 * sqrt(mu_n) + bn * A1 / sqrt(mu_n)); Ephi += an * ( I * cn * A1 * sqrt(mu_n) - bn * A1 / sqrt(mu_n)); } else{ Etheta += an * (-I * cn * A1 * I * sqrt(-mu_n) - I * bn * A1 / sqrt(-mu_n)); Ephi += an * ( I * cn * A1 * I * sqrt(-mu_n) + I * bn * A1 / sqrt(-mu_n)); } } Etheta *= cos(phi); Ephi *= sin(phi); } else if( theta == M_PI) { for (int n = 1 ; n < ns ; n++){ std::complex an = std::pow(-I, n) * (2. * n + 1.) / (n * (n + 1.)); double A2 = pow(-1.0, n + 1.0) * n * (n + 1.) / 2.; double A3 = pow(-1.0, n + 0.0) * n * (n + 1.) / 2.; double mu_n = 1 - n * (n + 1.0) / (k * k); std::complex dHnka = - Hnka[n + 1] + (n + 1.) * Hnka[n] / ka; std::complex bn = dHnka.real(); std::complex cn = Hnka[n].real(); if ( k * k >= n * (n+1)) { Etheta += an * (-I * cn * A2 * sqrt(mu_n) + bn * A3 / sqrt(mu_n)); Ephi += an * ( I * cn * A3 * sqrt(mu_n) - bn * A2 / sqrt(mu_n));} else { Etheta += an * (-I * cn * A2 * I * sqrt(-mu_n) - I * bn * A3 / sqrt(-mu_n)); Ephi += an * ( I * cn * A3 * I * sqrt(-mu_n) + I * bn * A2 / sqrt(-mu_n)); } } Etheta *= cos(phi); Ephi *= sin(phi); } else{ for (int n = 1 ; n < ns ; n++){ std::complex an = std::pow(-I, n) * (2. * n + 1.) / (n * (n + 1.)); std::complex dHnka = - Hnka[n + 1] + (n + 1.) * Hnka[n] / ka; std::complex bn = dHnka.real(); std::complex cn = Hnka[n].real(); double mu_n = 1 - n * (n + 1.0) / (k * k); double Pn1 = Legendre(n, 1, ctheta); double Pn11 = Legendre(n+1, 1, ctheta); double dPn1 = n * Pn11 - (n + 1) * ctheta * Pn1 ; if ( k * k >= n * (n+1)) { Etheta += an * (-I * cn * Pn1 * sqrt(mu_n) + bn * dPn1 / sqrt(mu_n)); Ephi += an * ( I * cn * dPn1 * sqrt(mu_n) - bn * Pn1 / sqrt(mu_n));} else { Etheta += an * (-I * cn * Pn1 * I * sqrt(-mu_n) -I * bn * dPn1 / sqrt(-mu_n)); Ephi += an * ( I * cn * dPn1 * I * sqrt(-mu_n) + I * bn * Pn1 / sqrt(-mu_n)); } } Etheta *= cos(phi)/stheta; Ephi *= sin(phi) /stheta; } Etheta *= -I / k; Ephi *= -I / k; // r, theta, phi components std::complex rtp[3] = {Er, Etheta, Ephi}; double mat[3][3]; // r basis vector mat[0][0] = sin(theta) * cos(phi) ; mat[0][1] = sin(theta) * sin(phi) ; mat[0][2] = cos(theta) ; // theta basis vector mat[1][0] = cos(theta) * cos(phi) ; mat[1][1] = cos(theta) * sin(phi) ; mat[1][2] = - sin(theta) ; // phi basis vector mat[2][0] = - sin(phi) ; mat[2][1] = cos(phi); mat[2][2] = 0.; // x, y, z components std::complex xyz[3] = {0., 0., 0.}; for(int i = 0; i < 3; i++) for(int j = 0; j < 3; j++) xyz[i] = xyz[i] + mat[j][i] * rtp[j]; V->Val[0] = xyz[0].real(); V->Val[1] = xyz[1].real(); V->Val[2] = xyz[2].real(); V->Val[MAX_DIM] = xyz[0].imag(); V->Val[MAX_DIM+1] = xyz[1].imag(); V->Val[MAX_DIM+2] = xyz[2].imag(); V->Type = VECTOR ; } // returne n /\ H en -iwt void F_CurrentPerfectlyConductingSphereMwt(F_ARG) { double x = A->Val[0]; double y = A->Val[1]; double z = A->Val[2]; double theta = atan2(sqrt(x * x + y * y), z); double phi = atan2(y, x); double k = Fct->Para[0] ; double a = Fct->Para[1] ; double Z0 = Fct->Para[2] ; double ka = k * a; int ns = (int)k + 10; std::vector > Hnka(ns + 1); for (int n = 1 ; n <= ns ; n++){ Hnka[n] = std::complex(AltSpherical_j_n(n, ka), AltSpherical_y_n(n, ka)); } double ctheta = cos(theta); double stheta = sin(theta); std::complex Er(0.,0), Etheta(0.,0), Ephi(0.,0), I(0, 1.); if( theta == 0.) { for (int n = 1 ; n < ns ; n++){ std::complex an = pow(-I, n) * (2. * n + 1.) / (n * (n + 1.)); double A1 = n * (n + 1.0) / 2.; std::complex dHnka = - Hnka[n + 1] + (n + 1.) * Hnka[n] / ka; std::complex bn = - dHnka.real() / dHnka; std::complex cn = - Hnka[n].real() / Hnka[n]; Etheta += an * (I * cn * dHnka * A1 + bn * Hnka[n] * A1); Ephi += an * (I * cn * dHnka * A1 + bn * Hnka[n] * A1); } Etheta *= (-1. / (Z0*ka)) * (sin(phi)); Ephi *= (-1. / (Z0*ka)) * (cos(phi)); } else if( theta == M_PI) { for (int n = 1 ; n < ns ; n++){ std::complex an = std::pow(-I, n) * (2. * n + 1.) / (n * (n + 1.)); double A2 = pow(-1.0, n + 1.0) * n * (n + 1.) / 2.; double A3 = pow(-1.0, n + 0.0) * n * (n + 1.) / 2.; std::complex dHnka = - Hnka[n + 1] + (n + 1.) * Hnka[n] / ka; std::complex bn = - dHnka.real() / dHnka; std::complex cn = - Hnka[n].real() / Hnka[n]; Etheta += an * (I * cn * dHnka * A3 + bn * Hnka[n] * A2); Ephi += an * (I * cn * dHnka * A2 + bn * Hnka[n] * A3); } Etheta *= (-1.0 / (Z0*ka)) * sin(phi); Ephi *= (-1.0 / (Z0*ka)) * cos(phi); } else{ for (int n = 1 ; n < ns ; n++){ std::complex an = std::pow(-I, n) * (2. * n + 1.) / (n * (n + 1.)); std::complex dHnka = - Hnka[n + 1] + (n + 1.) * Hnka[n] / ka; std::complex bn = - dHnka.real() / dHnka; std::complex cn = - Hnka[n].real() / Hnka[n]; double Pn1 = Legendre(n, 1, ctheta); double Pn11 = Legendre(n+1, 1, ctheta); double dPn1 = n * Pn11 - (n + 1) * ctheta * Pn1 ; Etheta += an * (I * cn * dHnka * dPn1 + bn * Hnka[n] * Pn1 ); Ephi += an * (I * cn * dHnka * Pn1 + bn * Hnka[n] * dPn1); } Etheta *= (-1. / (Z0*ka)) * (sin(phi)/stheta); Ephi *= (-1. / (Z0*ka)) * (cos(phi) /stheta); } // r, theta, phi components std::complex rtp[3] = {Er, -Ephi, Etheta}; double mat[3][3]; // r basis vector mat[0][0] = sin(theta) * cos(phi) ; mat[0][1] = sin(theta) * sin(phi) ; mat[0][2] = cos(theta) ; // theta basis vector mat[1][0] = cos(theta) * cos(phi) ; mat[1][1] = cos(theta) * sin(phi) ; mat[1][2] = - sin(theta) ; // phi basis vector mat[2][0] = - sin(phi) ; mat[2][1] = cos(phi); mat[2][2] = 0.; // x, y, z components std::complex xyz[3] = {0., 0., 0.}; for(int i = 0; i < 3; i++) for(int j = 0; j < 3; j++) xyz[i] = xyz[i] + mat[j][i] * rtp[j]; V->Val[0] = xyz[0].real(); V->Val[1] = xyz[1].real(); V->Val[2] = xyz[2].real(); V->Val[MAX_DIM] = xyz[0].imag(); V->Val[MAX_DIM+1] = xyz[1].imag(); V->Val[MAX_DIM+2] = xyz[2].imag(); V->Type = VECTOR ; } // version avec +iwt /* Scattering by a perfectly conducting sphere of radius R, under plane wave incidence pol*e^{ik \alpha\dot\r}, with alpha = (0,0,-1) and pol = (1,0,0). Returns surface current (From Harrington, Time-harmonic electromagnetic fields, p. 294) */ void F_CurrentPerfectlyConductingSphere(F_ARG) { cplx I = {0., 1.}, tmp, *hn, coef1, coef2, an, jtheta, jphi, rtp[3], xyz[3]; double k, R, r, kR, theta, phi, Z0, ctheta, stheta, Pn0, Pn1, dPn1, mat[3][3], x, y, z ; int n, ns, i, j ; x = A->Val[0]; y = A->Val[1]; z = A->Val[2]; r = sqrt(x*x+y*y+z*z); theta = atan2(sqrt(x*x+y*y), z); phi = atan2(y,x); // warning: approximation if (theta == 0. ) theta += 1e-6; if (theta == M_PI || theta == -M_PI) theta -= 1e-6; k = Fct->Para[0] ; R = Fct->Para[1] ; Z0 = Fct->Para[2] ; // impedance of vacuum = sqrt(mu_0/eps_0) \approx 120*pi kR = k * R; // test position to check if on sphere if(fabs(r - R) > 1.e-3) Message::Error("Evaluation point not on sphere"); V->Val[0] = 0.; V->Val[MAX_DIM] = 0. ; ns = (int)k + 10; hn = (cplx*)Malloc((ns + 1)*sizeof(cplx)); for (n = 0 ; n < ns + 1 ; n++){ hn[n].r = AltSpherical_j_n(n, kR); hn[n].i = - AltSpherical_y_n(n, kR); } ctheta = cos(theta); stheta = sin(theta); jtheta.r = 0; jtheta.i = 0; jphi.r = 0; jphi.i = 0; for (n = 1 ; n < ns ; n++){ // 1 / \hat{H}_n^2 (ka) coef1 = Cdivr( 1.0 , hn[n] ); // 1 / \hat{H}_n^2' (ka) coef2 = Cdivr( 1.0 , Csub( Cprodr( (double)(n+1) / kR , hn[n]) , hn[n+1] ) ); Pn0 = Legendre(n, 0, ctheta); Pn1 = Legendre(n, 1, ctheta); dPn1 = (n+1)*n* Pn0/stheta - (ctheta/(ctheta*ctheta-1))* Pn1; an = Cprodr( (2.*n+1.) / (double)(n * (n+1.)) , Cpow(I, -n) ); tmp = Cprod( an , Csum( Cprodr( stheta * dPn1 , coef2 ) , Cprodr( Pn1 / stheta , Cprod( I , coef1 )) ) ); jtheta = Csum( jtheta, tmp ); tmp = Cprod( an , Csub( Cprodr( Pn1 / stheta , coef2 ) , Cprodr( dPn1 * stheta , Cdiv(coef1 , I)) ) ); jphi = Csum( jphi, tmp ); } Free(hn); tmp = Cprodr( cos(phi)/(kR*Z0), I); jtheta = Cprod( jtheta, tmp ); tmp = Cprodr( sin(phi)/(kR*Z0), I ); jphi = Cprod( jphi, tmp ); // r, theta, phi components rtp[0].r = 0; rtp[0].i = 0; rtp[1] = jtheta; rtp[2] = jphi; // r basis vector mat[0][0] = sin(theta) * cos(phi) ; mat[0][1] = sin(theta) * sin(phi) ; mat[0][2] = cos(theta) ; // theta basis vector mat[1][0] = cos(theta) * cos(phi) ; mat[1][1] = cos(theta) * sin(phi) ; mat[1][2] = - sin(theta) ; // phi basis vector mat[2][0] = - sin(phi) ; mat[2][1] = cos(phi); mat[2][2] = 0.; // x, y, z components for(i = 0; i < 3; i++){ xyz[i].r = 0; xyz[i].i = 0; for(j = 0; j < 3; j++) xyz[i] = Csum( xyz[i] , Cprodr(mat[j][i] , rtp[j]) ); } V->Val[0] = xyz[0].r; V->Val[1] = xyz[1].r; V->Val[2] = xyz[2].r; V->Val[MAX_DIM] = xyz[0].i; V->Val[MAX_DIM+1] = xyz[1].i; V->Val[MAX_DIM+2] = xyz[2].i; V->Type = VECTOR ; } /* Scattering by an acoustically soft sphere (exterior Dirichlet problem) of radius R, under plane wave incidence e^{ikx}. Returns scattered field outside. (Colton and Kress, Inverse Acoustic..., p 51, eq. 3.29) */ void F_AcousticFieldSoftSphere(F_ARG) { cplx I = {0.,1.}, hnkR, hnkr, tmp; double k, R, r, kr, kR, theta, fact ; int n, ns ; r = sqrt(A->Val[0]*A->Val[0] + A->Val[1]*A->Val[1] + A->Val[2]*A->Val[2]) ; theta = acos(A->Val[0] / r); // angle between position vector and (1,0,0) k = Fct->Para[0] ; R = Fct->Para[1] ; kr = k*r; kR = k*R; V->Val[0] = 0.; V->Val[MAX_DIM] = 0. ; ns = (int)k + 10; for (n = 0 ; n < ns ; n++){ hnkR.r = Spherical_j_n(n, kR); hnkR.i = Spherical_y_n(n, kR); hnkr.r = Spherical_j_n(n, kr); hnkr.i = Spherical_y_n(n, kr); tmp = Cdiv( Cprod( Cpow(I,n) , Cprodr(hnkR.r, hnkr) ) , hnkR ); fact = (2*n+1) * Legendre(n, 0, cos(theta)); V->Val[0] += fact * tmp.r; V->Val[MAX_DIM] += fact * tmp.i; } V->Val[0] *= -1; V->Val[MAX_DIM] *= -1; V->Type = SCALAR ; } cplx Dhn_Spherical(cplx *hntab, int n, double x) { return Csub( Cprodr( (double)n/x, hntab[n] ) , hntab[n+1] ); } /* Scattering by an acoustically soft sphere (exterior Dirichlet problem) of radius R, under plane wave incidence e^{ikx}. Returns radial derivative of scattered field outside */ void F_DrAcousticFieldSoftSphere(F_ARG) { cplx I = {0.,1.}, hnkR, tmp, *hnkrtab; double k, R, r, kr, kR, theta, fact ; int n, ns ; r = sqrt(A->Val[0]*A->Val[0] + A->Val[1]*A->Val[1] + A->Val[2]*A->Val[2]) ; theta = acos(A->Val[0] / r); // angle between position vector and (1,0,0) k = Fct->Para[0] ; R = Fct->Para[1] ; kr = k*r; kR = k*R; V->Val[0] = 0.; V->Val[MAX_DIM] = 0. ; ns = (int)k + 10; hnkrtab = (cplx*)Malloc((ns + 1)*sizeof(cplx)); for (n = 0 ; n < ns + 1 ; n++){ hnkrtab[n].r = Spherical_j_n(n, kr); hnkrtab[n].i = Spherical_y_n(n, kr); } for (n = 0 ; n < ns ; n++){ hnkR.r = Spherical_j_n(n, kR); hnkR.i = Spherical_y_n(n, kR); tmp = Cdiv( Cprod( Cpow(I,n) , Cprodr(hnkR.r * k, Dhn_Spherical(hnkrtab, n, kr)) ) , hnkR ); fact = (2*n+1) * Legendre(n, 0, cos(theta)); V->Val[0] += fact * tmp.r; V->Val[MAX_DIM] += fact * tmp.i; } Free(hnkrtab); V->Val[0] *= -1; V->Val[MAX_DIM] *= -1; V->Type = SCALAR ; } /* Scattering by an acoustically soft sphere (exterior Dirichlet problem) of radius R, under plane wave incidence e^{ikx}. Returns RCS. (Colton and Kress, Inverse Acoustic..., p 52, eq. 3.30) */ void F_RCSSoftSphere(F_ARG) { cplx I = {0.,1.}, hnkR, tmp, res; double k, R, r, kR, theta, fact, val ; int n, ns ; r = sqrt(A->Val[0]*A->Val[0] + A->Val[1]*A->Val[1] + A->Val[2]*A->Val[2]) ; theta = acos(A->Val[0] / r); // angle between position vector and (1,0,0) k = Fct->Para[0] ; R = Fct->Para[1] ; kR = k*R; res.r = 0.; res.i = 0. ; ns = (int)k + 10; for (n = 0 ; n < ns ; n++){ hnkR.r = Spherical_j_n(n, kR); hnkR.i = Spherical_y_n(n, kR); tmp = Cdivr( hnkR.r, hnkR ); fact = (2*n+1) * Legendre(n, 0, cos(theta)); res.r += fact * tmp.r; res.i += fact * tmp.i; } val = Cmodu( Cprodr( 1./k , Cprod(res, I) ) ); val *= val; val *= 4. * M_PI; val = 10. * log10(val); V->Val[0] = val; V->Val[MAX_DIM] = 0.; V->Type = SCALAR ; } /* Scattering by an acoustically hard sphere (exterior Neumann problem) of radius R, under plane wave incidence e^{ikx}. Returns scattered field outside */ void F_AcousticFieldHardSphere(F_ARG) { cplx I = {0.,1.}, hnkr, tmp, DhnkR, *hnkRtab; double k, R, r, kr, kR, theta, fact ; int n, ns ; r = sqrt(A->Val[0]*A->Val[0] + A->Val[1]*A->Val[1] + A->Val[2]*A->Val[2]) ; theta = acos(A->Val[0] / r); // angle between position vector and (1,0,0) k = Fct->Para[0] ; R = Fct->Para[1] ; kr = k*r; kR = k*R; V->Val[0] = 0.; V->Val[MAX_DIM] = 0. ; ns = (int)k + 10; hnkRtab = (cplx*)Malloc((ns + 1)*sizeof(cplx)); for (n = 0 ; n < ns + 1 ; n++){ hnkRtab[n].r = Spherical_j_n(n, kR); hnkRtab[n].i = Spherical_y_n(n, kR); } for (n = 0 ; n < ns ; n++){ hnkr.r = Spherical_j_n(n, kr); hnkr.i = Spherical_y_n(n, kr); DhnkR = Dhn_Spherical(hnkRtab, n, kR); tmp = Cdiv( Cprod( Cpow(I,n) , Cprodr(DhnkR.r, hnkr) ) , DhnkR ); fact = (2*n+1) * Legendre(n, 0, cos(theta)); V->Val[0] += fact * tmp.r; V->Val[MAX_DIM] += fact * tmp.i; } Free(hnkRtab); V->Val[0] *= -1; V->Val[MAX_DIM] *= -1; V->Type = SCALAR ; } /* Scattering by an acoustically hard sphere (exterior Dirichlet problem) of radius R, under plane wave incidence e^{ikx}. Returns RCS */ void F_RCSHardSphere(F_ARG) { cplx I = {0.,1.}, DhnkR, tmp, res, *hnkRtab; double k, R, r, kR, theta, fact, val ; int n, ns ; r = sqrt(A->Val[0]*A->Val[0] + A->Val[1]*A->Val[1] + A->Val[2]*A->Val[2]) ; theta = acos(A->Val[0] / r); // angle between position vector and (1,0,0) k = Fct->Para[0] ; R = Fct->Para[1] ; kR = k*R; res.r = 0.; res.i = 0. ; ns = (int)k + 10; hnkRtab = (cplx*)Malloc((ns + 1)*sizeof(cplx)); for (n = 0 ; n < ns + 1 ; n++){ hnkRtab[n].r = Spherical_j_n(n, kR); hnkRtab[n].i = Spherical_y_n(n, kR); } for (n = 0 ; n < ns ; n++){ DhnkR = Dhn_Spherical(hnkRtab, n, kR); tmp = Cdivr( DhnkR.r, DhnkR ); fact = (2*n+1) * Legendre(n, 0, cos(theta)); res.r += fact * tmp.r; res.i += fact * tmp.i; } Free(hnkRtab); val = Cmodu( Cprodr( 1./k , Cprod(res, I) ) ); val *= val; val *= 4. * M_PI; val = 10. * log10(val); V->Val[0] = val; V->Val[MAX_DIM] = 0.; V->Type = SCALAR ; } /* ------------------------------------------------------------------------ */ /* Exact solutions for cylinders */ /* ------------------------------------------------------------------------ */ /* Scattering by solid PEC cylinder, incident wave z-polarized. Returns current on cylinder surface */ void F_JFIE_ZPolCyl(F_ARG) { double k0, r, kr, e0, eta, phi, a, b, c, d, den ; int i, ns ; phi = atan2( A->Val[1], A->Val[0] ) ; k0 = Fct->Para[0] ; eta = Fct->Para[1] ; e0 = Fct->Para[2] ; r = Fct->Para[3] ; kr = k0*r ; ns = 100 ; V->Val[0] = 0.; V->Val[MAX_DIM] = 0. ; for (i = -ns ; i <= ns ; i++ ){ a = cos(i*(phi-(M_PI/2))) ; b = sin(i*(phi-(M_PI/2))) ; c = jn(i,kr) ; d = -yn(i,kr) ; den = c*c+d*d ; V->Val[0] += (a*c+b*d)/den ; V->Val[MAX_DIM] += (b*c-a*d)/den ; } V->Val[0] *= -2*e0/kr/eta/M_PI ; V->Val[MAX_DIM] *= -2*e0/kr/eta/M_PI ; V->Type = SCALAR ; } /* Scattering by solid PEC cylinder, incident wave z-polarized. Returns RCS */ void F_RCS_ZPolCyl(F_ARG) { double k0, r, kr, rinf, krinf, phi, a, b, d,den ; double lambda, bjn, rr = 0., ri = 0. ; int i, ns ; phi = atan2( A->Val[1], A->Val[0] ) ; k0 = Fct->Para[0] ; r = Fct->Para[1] ; rinf = Fct->Para[2] ; kr = k0*r ; krinf = k0*rinf ; lambda = 2*M_PI/k0 ; ns = 100 ; for (i = -ns ; i <= ns ; i++ ){ bjn = jn(i,kr) ; a = bjn * cos(i*phi) ; b = bjn * sin(i*phi) ; d = -yn(i,kr) ; den = bjn*bjn+d*d ; rr += (a*bjn+b*d)/den ; ri += (b*bjn-a*d)/den ; } V->Val[0] = 10*log10( 4*M_PI*SQU(rinf/lambda) * 2/krinf/M_PI *(SQU(rr)+SQU(ri)) ) ; V->Val[MAX_DIM] = 0. ; V->Type = SCALAR ; } /* Scattering by solid PEC cylinder, incident wave polarized transversely to z. Returns current on cylinder surface */ void F_JFIE_TransZPolCyl(F_ARG) { double k0, r, kr, h0, phi, a, b, c, d, den ; int i, ns ; phi = atan2( A->Val[1], A->Val[0] ) ; k0 = Fct->Para[0] ; h0 = Fct->Para[1] ; r = Fct->Para[2] ; kr = k0*r ; ns = 100 ; V->Val[0] = 0.; V->Val[MAX_DIM] = 0. ; for (i = -ns ; i <= ns ; i++ ){ a = cos(M_PI/2 +i*(phi-(M_PI/2))) ; b = sin(M_PI/2 +i*(phi-(M_PI/2))) ; c = -jn(i+1,kr) + (i/kr)*jn(i,kr) ; d = yn(i+1,kr) - (i/kr)*yn(i,kr) ; den = c*c+d*d ; V->Val[0] += (a*c+b*d)/den ; V->Val[MAX_DIM] += (b*c-a*d)/den ; } V->Val[0] *= 2*h0/kr/M_PI ; V->Val[MAX_DIM] *= 2*h0/kr/M_PI ; V->Type = SCALAR ; } /* Scattering by acoustically soft circular cylinder of radius R, under plane wave incidence e^{ikx}. Returns scatterered field outside */ void F_AcousticFieldSoftCylinder(F_ARG) { cplx I = {0.,1.}, HnkR, Hnkr, tmp; double k, R, r, kr, kR, theta, cost ; int n, ns ; theta = atan2(A->Val[1], A->Val[0]) ; r = sqrt(A->Val[0]*A->Val[0] + A->Val[1]*A->Val[1]) ; k = Fct->Para[0] ; R = Fct->Para[1] ; kr = k*r; kR = k*R; V->Val[0] = 0.; V->Val[MAX_DIM] = 0. ; ns = (int)k + 10; for (n = 0 ; n < ns ; n++){ HnkR.r = jn(n,kR); HnkR.i = yn(n,kR); Hnkr.r = jn(n,kr); Hnkr.i = yn(n,kr); tmp = Cdiv( Cprod( Cpow(I,n) , Cprodr( HnkR.r, Hnkr) ) , HnkR ); cost = cos(n*theta); V->Val[0] += cost * tmp.r * (!n ? 0.5 : 1.); V->Val[MAX_DIM] += cost * tmp.i * (!n ? 0.5 : 1.); } V->Val[0] *= -2; V->Val[MAX_DIM] *= -2; V->Type = SCALAR ; } cplx DHn(cplx *Hnkrtab, int n, double x) { if(n == 0){ return Cneg(Hnkrtab[1]); } else{ return Csub( Hnkrtab[n-1] , Cprodr((double)n/x, Hnkrtab[n]) ); } } /* Scattering by acoustically soft circular cylinder of radius R0, under plane wave incidence e^{ikx}, with artificial boundary condition at R1. Returns exact solution of the (interior!) problem between R0 and R1. */ void F_AcousticFieldSoftCylinderABC(F_ARG) { cplx I = {0.,1.}, tmp, alpha1, alpha2, delta, am, bm, lambda, coef; cplx H1nkR0, *H1nkR1tab, *H2nkR1tab, H1nkr, alphaBT, betaBT, keps = {0., 0.}; double k, R0, R1, r, kr, kR0, kR1, theta, cost, sint, kappa ; int n, ns, ABCtype, SingleMode ; theta = atan2(A->Val[1], A->Val[0]) ; r = sqrt(A->Val[0] * A->Val[0] + A->Val[1] * A->Val[1]) ; k = Fct->Para[0] ; R0 = Fct->Para[1] ; R1 = Fct->Para[2] ; ABCtype = (int)Fct->Para[3] ; SingleMode = (int)Fct->Para[4] ; kr = k * r; kR0 = k * R0; kR1 = k * R1; if(ABCtype == 1){ /* Sommerfeld */ lambda = Cprodr(-k, I); } else if(ABCtype == 2){ /* Bayliss-Turkel */ /* alphaBT[] = 1/(2*R1) - I[]/(8*k*R1^2*(1+I[]/(k*R1))); betaBT[] = - 1/(2*I[]*k*(1+I[]/(k*R1))); */ coef.r = 2*k; coef.i = 2/R1; alphaBT = Csubr( 1/(2*R1) , Cdiv(I , Cprodr(4*R1*R1 , coef) ) ); betaBT = Cdiv(I , coef); } else if(ABCtype == 3){ /* Pade */ kappa = 1./R1; /* for circular boundary only! */ keps.r = k; keps.i = 0.4 * pow(k, 1./3.) * pow(kappa, 2./3.); } else{ Message::Error("Unknown ABC type"); } V->Val[0] = 0.; V->Val[MAX_DIM] = 0. ; ns = (int)k + 10; H1nkR1tab = (cplx*)Malloc(ns * sizeof(cplx)); for (n = 0 ; n < ns ; n++){ H1nkR1tab[n].r = jn(n, kR1); H1nkR1tab[n].i = yn(n, kR1); } H2nkR1tab = (cplx*)Malloc(ns * sizeof(cplx)); for (n = 0 ; n < ns ; n++){ H2nkR1tab[n] = Cconj(H1nkR1tab[n]); } for (n = 0 ; n < ns ; n++){ if(SingleMode >= 0 && SingleMode != n) continue; H1nkR0.r = jn(n, kR0); H1nkR0.i = yn(n, kR0); H1nkr.r = jn(n,kr); H1nkr.i = yn(n,kr); if(ABCtype == 2){ lambda = Csum( Csum( Cprodr(-k, I) , alphaBT ) , Cprodr( n*n/(R1*R1) , betaBT ) ); } else if(ABCtype == 3){ lambda = Cprod( Cprodr(-k, I) , Cpow( Csubr(1 , Cdivr(n*n/(R1*R1) , Cprod(keps , keps))) , 0.5)); } alpha1 = Csum( Cprodr(k, DHn(H1nkR1tab, n, kR1)) , Cprod(lambda, H1nkR1tab[n]) ); alpha2 = Csum( Cprodr(k, DHn(H2nkR1tab, n, kR1)) , Cprod(lambda, H2nkR1tab[n]) ); delta = Csub( Cprod( alpha1 , Cconj(H1nkR0) ) , Cprod( alpha2 , H1nkR0 ) ); if(Cmodu(delta) < 1.e-6) break; am = Cdiv( Cprodr(H1nkR0.r, alpha2) , delta ); bm = Cdiv( Cprodr(-H1nkR0.r, alpha1) , delta ); if(SingleMode >= 0 && SingleMode == n){ tmp = Csum( Cprod( am , H1nkr ) , Cprod( bm , Cconj(H1nkr) ) ); cost = cos(n * theta); sint = sin(n * theta); V->Val[0] += cost * tmp.r - sint * tmp.i; V->Val[MAX_DIM] += cost * tmp.i + sint * tmp.r; } else{ tmp = Cprod( Cpow(I,n) , Csum( Cprod( am , H1nkr ) , Cprod( bm , Cconj(H1nkr) ) ) ); cost = cos(n * theta); V->Val[0] += cost * tmp.r * (!n ? 0.5 : 1.); V->Val[MAX_DIM] += cost * tmp.i * (!n ? 0.5 : 1.); } } Free(H1nkR1tab); Free(H2nkR1tab); if(SingleMode < 0){ V->Val[0] *= 2; V->Val[MAX_DIM] *= 2; } V->Type = SCALAR ; } /* Scattering by acoustically soft circular cylinder of radius R, under plane wave incidence e^{ikx}. Returns radial derivative of the solution of the Helmholtz equation outside */ void F_DrAcousticFieldSoftCylinder(F_ARG) { cplx I = {0.,1.}, HnkR, tmp, *Hnkrtab; double k, R, r, kr, kR, theta, cost ; int n, ns ; theta = atan2(A->Val[1], A->Val[0]) ; r = sqrt(A->Val[0]*A->Val[0] + A->Val[1]*A->Val[1]) ; k = Fct->Para[0] ; R = Fct->Para[1] ; kr = k*r; kR = k*R; V->Val[0] = 0.; V->Val[MAX_DIM] = 0. ; ns = (int)k + 10; Hnkrtab = (cplx*)Malloc(ns*sizeof(cplx)); for (n = 0 ; n < ns ; n++){ Hnkrtab[n].r = jn(n,kr); Hnkrtab[n].i = yn(n,kr); } for (n = 0 ; n < ns ; n++){ HnkR.r = jn(n,kR); HnkR.i = yn(n,kR); tmp = Cdiv( Cprod( Cpow(I,n) , Cprodr( HnkR.r, DHn(Hnkrtab, n, kr) ) ) , HnkR ); cost = cos(n*theta); V->Val[0] += cost * tmp.r * (!n ? 0.5 : 1.); V->Val[MAX_DIM] += cost * tmp.i * (!n ? 0.5 : 1.); } Free(Hnkrtab); V->Val[0] *= -2 * k; V->Val[MAX_DIM] *= -2 * k; V->Type = SCALAR ; } /* Scattering by acoustically soft circular cylinder of radius R, under plane wave incidence e^{ikx}. Returns RCS */ void F_RCSSoftCylinder(F_ARG) { cplx I = {0.,1.}, HnkR, Hnkr, res, tmp; double k, R, r, kR, theta, cost, val ; int n, ns ; theta = atan2(A->Val[1], A->Val[0]) ; r = sqrt(A->Val[0]*A->Val[0] + A->Val[1]*A->Val[1]) ; k = Fct->Para[0] ; R = Fct->Para[1] ; kR = k*R; res.r = 0.; res.i = 0. ; ns = (int)k + 10; for (n = 0 ; n < ns ; n++){ HnkR.r = jn(n,kR); HnkR.i = yn(n,kR); /* leaving r in following asymptotic formula for clarity (see Colton and Kress, Inverse Acoustic..., p. 65, eq. 3.59) */ Hnkr.r = cos(k*r - n*M_PI/2. - M_PI/4.) / sqrt(k*r) * sqrt(2./M_PI); Hnkr.i = sin(k*r - n*M_PI/2. - M_PI/4.) / sqrt(k*r) * sqrt(2./M_PI); tmp = Cdiv( Cprod( Cpow(I,n) , Cprodr( HnkR.r, Hnkr) ) , HnkR ); cost = cos(n*theta); res.r += cost * tmp.r * (!n ? 0.5 : 1.); res.i += cost * tmp.i * (!n ? 0.5 : 1.); } res.r *= -2; res.i *= -2; val = Cmodu(res); val *= val; val *= 2. * M_PI * r; val = 10. * log10(val); V->Val[0] = val; V->Val[MAX_DIM] = 0.; V->Type = SCALAR ; } /* Scattering by acoustically hard circular cylinder of radius R, under plane wave incidence e^{ikx}. Returns scatterered field outside */ void F_AcousticFieldHardCylinder(F_ARG) { cplx I = {0.,1.}, Hnkr, dHnkR, tmp, *HnkRtab; double k, R, r, kr, kR, theta, cost ; int n, ns ; theta = atan2(A->Val[1], A->Val[0]) ; r = sqrt(A->Val[0]*A->Val[0] + A->Val[1]*A->Val[1]) ; k = Fct->Para[0] ; R = Fct->Para[1] ; kr = k*r; kR = k*R; V->Val[0] = 0.; V->Val[MAX_DIM] = 0. ; ns = (int)k + 10; HnkRtab = (cplx*)Malloc(ns*sizeof(cplx)); for (n = 0 ; n < ns ; n++){ HnkRtab[n].r = jn(n,kR); HnkRtab[n].i = yn(n,kR); } for (n = 0 ; n < ns ; n++){ Hnkr.r = jn(n,kr); Hnkr.i = yn(n,kr); dHnkR = DHn(HnkRtab, n, kR); tmp = Cdiv( Cprod( Cpow(I,n) , Cprodr( dHnkR.r, Hnkr) ) , dHnkR ); cost = cos(n*theta); V->Val[0] += cost * tmp.r * (!n ? 0.5 : 1.); V->Val[MAX_DIM] += cost * tmp.i * (!n ? 0.5 : 1.); } Free(HnkRtab); V->Val[0] *= -2; V->Val[MAX_DIM] *= -2; V->Type = SCALAR ; } /* Scattering by acoustically hard circular cylinder of radius R, under plane wave incidence e^{ikx}. Returns the angular derivative of the solution outside */ void F_DthetaAcousticFieldHardCylinder(F_ARG) { cplx I = {0.,1.}, Hnkr, dHnkR, tmp, *HnkRtab; double k, R, r, kr, kR, theta, sint ; int n, ns ; theta = atan2(A->Val[1], A->Val[0]) ; r = sqrt(A->Val[0]*A->Val[0] + A->Val[1]*A->Val[1]) ; k = Fct->Para[0] ; R = Fct->Para[1] ; kr = k*r; kR = k*R; V->Val[0] = 0.; V->Val[MAX_DIM] = 0. ; ns = (int)k + 10; HnkRtab = (cplx*)Malloc(ns*sizeof(cplx)); for (n = 0 ; n < ns ; n++){ HnkRtab[n].r = jn(n,kR); HnkRtab[n].i = yn(n,kR); } for (n = 0 ; n < ns ; n++){ Hnkr.r = jn(n,kr); Hnkr.i = yn(n,kr); dHnkR = DHn(HnkRtab, n, kR); tmp = Cdiv( Cprod( Cpow(I,n) , Cprodr( dHnkR.r, Hnkr) ) , dHnkR ); sint = sin(n*theta); V->Val[0] += - n * sint * tmp.r * (!n ? 0.5 : 1.); V->Val[MAX_DIM] += - n * sint * tmp.i * (!n ? 0.5 : 1.); } Free(HnkRtab); V->Val[0] *= -2 ; V->Val[MAX_DIM] *= -2 ; V->Type = SCALAR ; } /* Scattering by acoustically hard circular cylinder of radius R0, under plane wave incidence e^{ikx}, with artificial boundary condition at R1. Returns exact solution of the (interior!) problem between R0 and R1. */ void F_AcousticFieldHardCylinderABC(F_ARG) { cplx I = {0.,1.}, tmp, alpha1, alpha2, delta, am, bm, lambda, coef; cplx *H1nkR0tab, *H2nkR0tab, *H1nkR1tab, *H2nkR1tab, H1nkr, alphaBT, betaBT; double k, R0, R1, r, kr, kR0, kR1, theta, cost, sint ; int n, ns, ABCtype, SingleMode ; theta = atan2(A->Val[1], A->Val[0]) ; r = sqrt(A->Val[0] * A->Val[0] + A->Val[1] * A->Val[1]) ; k = Fct->Para[0] ; R0 = Fct->Para[1] ; R1 = Fct->Para[2] ; ABCtype = (int)Fct->Para[3] ; SingleMode = (int)Fct->Para[4] ; kr = k * r; kR0 = k * R0; kR1 = k * R1; if(ABCtype == 1){ /* Sommerfeld */ lambda = Cprodr(-k, I); } else if(ABCtype == 2){ /* Bayliss-Turkel */ /* alphaBT[] = 1/(2*R1) - I[]/(8*k*R1^2*(1+I[]/(k*R1))); betaBT[] = - 1/(2*I[]*k*(1+I[]/(k*R1))); */ coef.r = 2*k; coef.i = 2/R1; alphaBT = Csubr( 1/(2*R1) , Cdiv(I , Cprodr(4*R1*R1 , coef) ) ); betaBT = Cdiv(I , coef); } else{ Message::Error("Unknown ABC type"); } V->Val[0] = 0.; V->Val[MAX_DIM] = 0. ; ns = (int)k + 10; H1nkR0tab = (cplx*)Malloc(ns * sizeof(cplx)); for (n = 0 ; n < ns ; n++){ H1nkR0tab[n].r = jn(n, kR0); H1nkR0tab[n].i = yn(n, kR0); } H2nkR0tab = (cplx*)Malloc(ns * sizeof(cplx)); for (n = 0 ; n < ns ; n++){ H2nkR0tab[n] = Cconj(H1nkR0tab[n]); } H1nkR1tab = (cplx*)Malloc(ns * sizeof(cplx)); for (n = 0 ; n < ns ; n++){ H1nkR1tab[n].r = jn(n, kR1); H1nkR1tab[n].i = yn(n, kR1); } H2nkR1tab = (cplx*)Malloc(ns * sizeof(cplx)); for (n = 0 ; n < ns ; n++){ H2nkR1tab[n] = Cconj(H1nkR1tab[n]); } for (n = 0 ; n < ns ; n++){ if(SingleMode >= 0 && SingleMode != n) continue; H1nkr.r = jn(n,kr); H1nkr.i = yn(n,kr); if(ABCtype == 2){ lambda = Csum( Csum( Cprodr(-k, I) , alphaBT ) , Cprodr( n*n/(R1*R1) , betaBT ) ); } alpha1 = Csum( Cprodr(k, DHn(H1nkR1tab, n, kR1)) , Cprod(lambda, H1nkR1tab[n]) ); alpha2 = Csum( Cprodr(k, DHn(H2nkR1tab, n, kR1)) , Cprod(lambda, H2nkR1tab[n]) ); delta = Cprodr( k , Csub( Cprod( alpha1 , DHn(H2nkR0tab, n, kR0) ) , Cprod( alpha2 , DHn(H1nkR0tab, n, kR0) ) ) ); if(Cmodu(delta) < 1.e-6) break; am = Cdiv( Cprodr(k * DHn(H1nkR0tab, n, kR0).r, alpha2) , delta ); bm = Cdiv( Cprodr(-k * DHn(H1nkR0tab, n, kR0).r, alpha1) , delta ); if(SingleMode >= 0 && SingleMode == n){ tmp = Csum( Cprod( am , H1nkr ) , Cprod( bm , Cconj(H1nkr) ) ) ; cost = cos(n * theta); sint = sin(n * theta); V->Val[0] += cost * tmp.r - sint * tmp.i; V->Val[MAX_DIM] += cost * tmp.i + sint * tmp.r; } else{ tmp = Cprod( Cpow(I,n) , Csum( Cprod( am , H1nkr ) , Cprod( bm , Cconj(H1nkr) ) ) ); cost = cos(n * theta); V->Val[0] += cost * tmp.r * (!n ? 0.5 : 1.); V->Val[MAX_DIM] += cost * tmp.i * (!n ? 0.5 : 1.); } } Free(H1nkR0tab); Free(H2nkR0tab); Free(H1nkR1tab); Free(H2nkR1tab); if(SingleMode < 0){ V->Val[0] *= 2; V->Val[MAX_DIM] *= 2; } V->Type = SCALAR ; } /* Scattering by acoustically hard circular cylinder of radius R, under plane wave incidence e^{ikx}. Returns RCS. */ void F_RCSHardCylinder(F_ARG) { cplx I = {0.,1.}, Hnkr, dHnkR, res, tmp, *HnkRtab; double k, R, r, kR, theta, cost, val ; int n, ns ; theta = atan2(A->Val[1], A->Val[0]) ; r = sqrt(A->Val[0]*A->Val[0] + A->Val[1]*A->Val[1]) ; k = Fct->Para[0] ; R = Fct->Para[1] ; kR = k*R; res.r = 0.; res.i = 0. ; ns = (int)k + 10; HnkRtab = (cplx*)Malloc(ns*sizeof(cplx)); for (n = 0 ; n < ns ; n++){ HnkRtab[n].r = jn(n,kR); HnkRtab[n].i = yn(n,kR); } for (n = 0 ; n < ns ; n++){ /* leaving r in following asymptotic formula for clarity (see Colton and Kress, Inverse Acoustic..., p. 65, eq. 3.59) */ Hnkr.r = cos(k*r - n*M_PI/2. - M_PI/4.) / sqrt(k*r) * sqrt(2./M_PI); Hnkr.i = sin(k*r - n*M_PI/2. - M_PI/4.) / sqrt(k*r) * sqrt(2./M_PI); dHnkR = DHn(HnkRtab, n, kR); tmp = Cdiv( Cprod( Cpow(I,n) , Cprodr( dHnkR.r, Hnkr) ) , dHnkR ); cost = cos(n*theta); res.r += cost * tmp.r * (!n ? 0.5 : 1.); res.i += cost * tmp.i * (!n ? 0.5 : 1.); } Free(HnkRtab); res.r *= -2; res.i *= -2; val = Cmodu(res); val *= val; val *= 2. * M_PI * r; val = 10. * log10(val); V->Val[0] = val; V->Val[MAX_DIM] = 0.; V->Type = SCALAR ; } /* ------------------------------------------------------------------------ */ /* On Surface Radiation Conditions (OSRC) */ /* ------------------------------------------------------------------------ */ /* Coefficients C0, Aj and Bj: see papers 1) Kechroud, Antoine & Soulaimani, Nuemrical accuracy of a Pade-type non-reflecting..., IJNME 2005 2) Antoine, Darbas & Lu, An improved surface radiation condition... CMAME, 2006(?) */ static double aj(int j, int N) { return 2./(2.*N + 1.) * SQU(sin((double)j * M_PI/(2.*N + 1.))) ; } static double bj(int j, int N) { return SQU(cos((double)j * M_PI/(2.*N + 1.))) ; } static std::complex padeC0(int N, double theta){ std::complex sum = std::complex(1, 0); std::complex one = std::complex(1, 0); std::complex z = std::complex(cos(-theta) - 1, sin(-theta)); for(int j = 1; j <= N; j++) sum += (z * aj(j, N)) / (one + z * bj(j, N)); z = std::complex(cos(theta / 2.), sin(theta / 2.)); return sum * z; } static std::complex padeA(int j, int N, double theta){ std::complex one = std::complex(1, 0); std::complex res; std::complex z; z = std::complex(cos(-theta / 2.), sin(-theta / 2.)); res = z * aj(j, N); z = std::complex(cos(-theta) - 1., sin(-theta)); res = res / ((one + z * bj(j, N)) * (one + z * bj(j, N))); return res; } static std::complex padeB(int j, int N, double theta){ std::complex one = std::complex(1, 0); std::complex res; std::complex z; z = std::complex(cos(-theta), sin(-theta)); res = z * bj(j, N); z = std::complex(cos(-theta) - 1., sin(-theta)); res = res / (one + z * bj(j, N)); return res; } static std::complex padeR0(int N, double theta){ std::complex sum = padeC0(N, theta); for(int j = 1; j <= N; j++) sum += padeA(j, N, theta) / padeB(j, N, theta); return sum; } void F_OSRC_C0(F_ARG) { int N; double theta; N = (int)Fct->Para[0]; theta = Fct->Para[1]; std::complex C0 = padeC0(N, theta); V->Val[0] = C0.real(); V->Val[MAX_DIM] = C0.imag(); V->Type = SCALAR; } void F_OSRC_R0(F_ARG) { int N; double theta; N = (int)Fct->Para[0]; theta = Fct->Para[1]; std::complex C0 = padeR0(N, theta); V->Val[0] = C0.real(); V->Val[MAX_DIM] = C0.imag(); V->Type = SCALAR; } void F_OSRC_Aj(F_ARG) { int j, N; double theta; j = (int)Fct->Para[0]; N = (int)Fct->Para[1]; theta = Fct->Para[2]; std::complex Aj = padeA(j, N, theta); V->Val[0] = Aj.real(); V->Val[MAX_DIM] = Aj.imag(); V->Type = SCALAR; } void F_OSRC_Bj(F_ARG) { int j, N; double theta; j = (int)Fct->Para[0]; N = (int)Fct->Para[1]; theta = Fct->Para[2]; std::complex Bj = padeB(j, N, theta); V->Val[0] = Bj.real(); V->Val[MAX_DIM] = Bj.imag(); V->Type = SCALAR; } #undef F_ARG getdp-2.7.0-source/Legacy/Operation_IterativeLinearSolver.cpp000644 001750 001750 00000132163 12606421314 026020 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributed by Bertrand Thierry #include #include #include "GetDPConfig.h" #include "ProData.h" #include "SolvingOperations.h" #include "Message.h" #include "OS.h" extern struct CurrentData Current ; // for performance tests //#define TIMER #if defined(HAVE_PETSC) && defined(HAVE_GMSH) #include "petscksp.h" #include #include #include static void _try(int ierr) { CHKERRCONTINUE(ierr); if(PetscUnlikely(ierr)){ const char *text; PetscErrorMessage(ierr, &text, 0); Message::Error("PETSc error: %s", text); Message::SetLastPETScError(ierr); } } class ILS{ // A new communicator can be created. If some processes have no work they must // be excluded from the communicator to avoir dead-lock private: // current cpu number and total number of cpus static MPI_Comm _comm; static int _commRank, _commSize; public: static int GetCommRank(){ return _commRank; } static int GetCommSize(){ return _commSize; } static MPI_Comm GetComm(){ return _comm; } }; MPI_Comm ILS::_comm = MPI_COMM_WORLD; int ILS::_commRank = 0; int ILS::_commSize = 1; class ILSField{ public: // number of Fields in this class PetscInt nb_field; // total number of elements of all fields in this class PetscInt n_elem; // GmshTag[j] = tag of field j (in getdp/gmsh, ie : outside IterativeLinearSolver) std::vector GmshTag; // ILSTag[j] = local tag of field j in the function IterativeLinearSolver // (usefull for MyField). std::vector ILSTag; // rank[j] is the mpi_rank of the process that owns field j std::vector rank; // size[j] = nb of elements in the field j std::vector size; // starting index in the Petsc Vec containing all the fields std::vector iStart; // same as iStart but ending (a priori useless) std::vector iEnd; // variables for transfering data with neighbors static bool areNeighbor; // number of field that this process must receive int nb_field_to_receive; std::vector > myN; // sizes of vectors of PView that this process is in charge std::vector > mySizeV; std::vector > theirN; std::vector > theirSizeV; // GmshTag of the fields that must be received by the current MPI processe // (concatenation of myNeighbor) std::vector FieldToReceive; // RankToSend[j] returns the rank to which the j^th local field must be sent std::vector > RankToSend; // CPU Time std::vector TimeBcast, TimeIt, TimeTreatment; // The below function is useful to do a reverse search: Given the GmshTag of a // field (GetDP/GMSH) it returns its local tag in IterativeLinearSolver // (ILSTag) Indeed, ILS can renumber the field in another way than gmsh/getdp int GetILSTagFromGmshTag(int gTag) { for (int j = 0; j < nb_field ; j++) if(GmshTag[j] == gTag) return ILSTag[j]; return -1; //error } int GetRankFromGmshTag(int gTag) { for (int j = 0; j < nb_field ; j++) if(GmshTag[j] == gTag) return rank[j]; return -1; //error } int GetRankFromILSTag(int ilsTag) { for (int j = 0; j < nb_field ; j++) if(ILSTag[j] == ilsTag) return rank[j]; return -1; //error } int GetGmshTagFromRank(int irank) { for (int j = 0; j < nb_field ; j++) if(rank[j] == irank) return GmshTag[j]; return -1; //error } }; bool ILSField::areNeighbor = false; // pointers to MyField and AllField, valid while Operation_LinearIterativeSolver // is running; This is used by Operation_BroadcastFields to explicitely // braodcast the fields in the middle of an ILSMatVec call. static ILSField *MyStaticField = 0, *AllStaticField = 0; // Matrix Free structure (Matrix Shell) typedef struct{ char *LinearSystemType; ILSField *MyField; ILSField *AllField; struct Resolution *Resolution_P; struct Operation *Operation_P; struct DofData *DofData_P0; struct GeoData *GeoData_P0; } ILSMat; static PView *GetViewByTag(int tag) { PView *view = PView::getViewByTag(tag); if(!view) Message::Error("View %d does not exist"); return view; } static PetscErrorCode InitData(ILSField *MyField, ILSField *AllField, struct Operation *Operation_P, std::vector > > *B_std) { int mpi_comm_size = Message::GetCommSize(); int mpi_comm_rank = Message::GetCommRank(); std::vector tab_nb_field_loc; std::vector displs(mpi_comm_size); int counter = 0; // number of fields owned by me and the other tasks MyField->nb_field = List_Nbr(Operation_P->Case.IterativeLinearSolver.MyFieldTag); tab_nb_field_loc.resize(mpi_comm_size); MPI_Allgather(&MyField->nb_field, 1, MPI_INT, &tab_nb_field_loc[0], 1, MPI_INT, PETSC_COMM_WORLD); AllField->nb_field = 0; for (int irank = 0 ; irank < mpi_comm_size ; irank ++) AllField->nb_field += tab_nb_field_loc[irank]; // displacement vector (for MPI_AllGatherV) displs[0] = 0; for (int irank = 1 ; irank < mpi_comm_size ; irank ++) displs[irank] = tab_nb_field_loc[irank-1] + displs[irank-1]; // Tag of the fields owned by me .... MyField->GmshTag.resize(MyField->nb_field); MyField->ILSTag.resize(MyField->nb_field); MyField->rank.resize(MyField->nb_field); for(int iField = 0; iField < MyField->nb_field; iField++) { double d; List_Read(Operation_P->Case.IterativeLinearSolver.MyFieldTag, iField, &d); MyField->GmshTag[iField] = (int)d; MyField->rank[iField] = mpi_comm_rank; MyField->ILSTag[iField] = displs[mpi_comm_rank] + iField; } // ...and by the other tasks AllField->GmshTag.resize(AllField->nb_field); AllField->rank.resize(AllField->nb_field); AllField->ILSTag.resize(AllField->nb_field); for (int iField = 0; iField < AllField->nb_field ; iField ++) AllField->ILSTag[iField] = iField; MPI_Allgatherv(&MyField->GmshTag[0], MyField->nb_field, MPI_INT, &AllField->GmshTag[0], &tab_nb_field_loc[0], &displs[0], MPI_INT, PETSC_COMM_WORLD); MPI_Allgatherv(&MyField->rank[0], MyField->nb_field, MPI_INT, &AllField->rank[0], &tab_nb_field_loc[0], &displs[0], MPI_INT, PETSC_COMM_WORLD); // Now the (local) fields in RAM must be read (*B_std).resize(MyField->nb_field); MyField->n_elem = 0; MyField->size.resize(MyField->nb_field); for(int iField = 0; iField < MyField->nb_field; iField ++) { (*B_std)[iField].resize(2); int d; PView *view = GetViewByTag(MyField->GmshTag[iField]); view->getData()->toVector((*B_std)[iField]); d = (*B_std)[iField][0].size(); MyField->size[iField] = d; MyField->n_elem += d; } // Share information on the size of the local fields with other tasks MPI_Allreduce(&MyField->n_elem, &AllField->n_elem, 1, MPI_INT, MPI_SUM, PETSC_COMM_WORLD); AllField->size.resize(AllField->nb_field); MPI_Allgatherv(&MyField->size[0], MyField->nb_field, MPI_INT, &AllField->size[0], &tab_nb_field_loc[0], &displs[0], MPI_INT, PETSC_COMM_WORLD); // Compute the starting/ending index in the futur Petsc Vec containing all the Gmsh fields AllField->iStart.resize(AllField->nb_field); AllField->iEnd.resize(AllField->nb_field); MyField->iStart.resize(MyField->nb_field); MyField->iEnd.resize(MyField->nb_field); AllField->iStart[0] = 0; counter = 0; for(int j = 0; j < AllField->nb_field; j++){ if(j > 0) AllField->iStart[j] = AllField->iEnd[j-1] + 1; AllField->iEnd[j] = AllField->iStart[j] + AllField->size[j] - 1; // Store in MyField if I am in charge of the Field if(AllField->rank[j] == mpi_comm_rank){ MyField->iStart[counter] = AllField->iStart[j]; MyField->iEnd[counter] = AllField->iEnd[j]; counter++; } } // Who are my Neighbors for the Broadcast ? At the time of writing, GetDP does // not manage 2D Lists. Thus, to act as-if, the list of neighbors is composed // as follows: // NeighborFieldTag = {n_0, ... n_0 GmshTag ... , n_1, ... n_1 GmshTag, ...} // For example, if // MyFieldTag = {0, 3} // NeighborFieldTag = {2, 5, 1, 3, 2, 4, 6} // This mean that current process is in charge of Field with GmshTag 0 and 7. // Field of GmshTag 0 has 2 neighbors : fields of GmshTag 5 and 1 // Field of GmshTag 7 has 3 neighbors : fields of GmshTag 2, 4 and 6 // (if GetDP changes and accepts lists of lists, then this trick should be useless // and changed !) int nNeighbor_aux = 0; nNeighbor_aux = List_Nbr(Operation_P->Case.IterativeLinearSolver.NeighborFieldTag); // make every process agreed on whether there is neighbor or not if(mpi_comm_size < 2){ ILSField::areNeighbor = false; } else{ //suppose it's true ILSField::areNeighbor = true; //share info on neighbor int bool_neigh = (nNeighbor_aux > 0); std::vector tab_bool_neigh(mpi_comm_size); MPI_Allgather(&bool_neigh, 1, MPI_INT, &tab_bool_neigh[0], 1, MPI_INT, MPI_COMM_WORLD); for(int irank = 0; irank < mpi_comm_size ; irank ++) if(tab_bool_neigh[irank] == 0 && AllField->GetGmshTagFromRank(irank) >= 0) // if one process has no neighbord AND is charge of some fields (=is a worker) ILSField::areNeighbor = false; } if(ILSField::areNeighbor){ int cpt_neigh = 0; // counter in list IterativeLinearSolver.NeighborFieldTag // for every field, RankToSend contain the rank of the process in need of // the field MyField->RankToSend.resize(MyField->nb_field); int cpt_send = 0; // over-sizing FieldToReceive, which contains the field that are needed by // this mpi process MyField->FieldToReceive.resize(AllField->nb_field - MyField->nb_field); int cpt_recv = 0; // read through every neighbors for(int ifield = 0 ; ifield < MyField->nb_field ; ifield++){ double d; List_Read(Operation_P->Case.IterativeLinearSolver.NeighborFieldTag, cpt_neigh, &d); int n_neigh = (int)d; cpt_send = 0; //at maximum n_neigh process to send this view MyField->RankToSend[ifield].resize(n_neigh); for(int j = 0; j < n_neigh ; j++){ //counter in list NeighborFieldTag cpt_neigh ++; List_Read(Operation_P->Case.IterativeLinearSolver.NeighborFieldTag, cpt_neigh, &d); int GmshTag_newneigh = (int)d; // Check if not already stored (either because this process is in charge // of the field or due to a doublon) bool isStored = false; for(int i = 0; i < MyField->nb_field ; i++){ if(GmshTag_newneigh == MyField->GmshTag[i]){ isStored = true; break; } } for(int i = 0; i < cpt_recv ; i++){ if(GmshTag_newneigh == MyField->FieldToReceive[i]){ isStored = true; break; } } // in case it's not already store if(!isStored){ MyField->FieldToReceive[cpt_recv] = GmshTag_newneigh; cpt_recv++; } // check if stored in the table of Mpi processes which will receive this field isStored = false; int rank_new_neigh = AllField->rank[AllField->GetILSTagFromGmshTag(GmshTag_newneigh)]; MyField->RankToSend[ifield].resize(n_neigh); // Maybe this process is in charge of this field.. if(rank_new_neigh == mpi_comm_rank) isStored = true; else{ //...or maybe it is already stored ... for(int i = 0; i < cpt_send ; i++){ if(rank_new_neigh == MyField->RankToSend[ifield][i]){ isStored = true; break; } } } if(!isStored){ // not already stored MyField->RankToSend[ifield][cpt_send] = rank_new_neigh; cpt_send++; } } // resize MyField->RankToSend[ifield].resize(cpt_send); cpt_neigh++; } // resize MyField->FieldToReceive.resize(cpt_recv); MyField->nb_field_to_receive = cpt_recv; // Check and exchange information on the size of the PView // Exchange information on the size of the PView (Field) with the neighbors MyField->myN.resize(MyField->nb_field); MyField->mySizeV.resize(MyField->nb_field); std::vector< MPI_Request > tab_request(0); for (int mfield = 0 ; mfield < MyField->nb_field ; mfield ++){ // Measure the size of the vectors of Field of local number mfield std::vector< std::vector* > V(24); MyField->myN[mfield].resize(24); MyField->mySizeV[mfield].resize(24); int GmshTag = MyField->GmshTag[mfield]; PView *view = GetViewByTag(GmshTag); view->getData()->getListPointers(&(MyField->myN[mfield][0]), &V[0]); for(int j = 0 ; j < 24 ; j++) MyField->mySizeV[mfield][j] = (*(V[j])).size(); // Exchange information about the sizes (mySizeV and myN) int n_proc_to_send = MyField->RankToSend[mfield].size(); for(int j = 0 ; j < n_proc_to_send ; j++){ MPI_Request sendN, sendSizeV; int tagN = 10*GmshTag + 1; int tagSizeV = 10*GmshTag + 2; // send vector myN and mysizeV MPI_Isend(&(MyField->myN[mfield][0]), 24, MPI_INT, MyField->RankToSend[mfield][j], tagN, MPI_COMM_WORLD, &sendN); MPI_Isend(&(MyField->mySizeV[mfield][0]), 24, MPI_INT, MyField->RankToSend[mfield][j], tagSizeV, MPI_COMM_WORLD, &sendSizeV); tab_request.push_back(sendN); tab_request.push_back(sendSizeV); } } // Receive information from the other process MyField->theirN.resize(MyField->nb_field_to_receive); MyField->theirSizeV.resize(MyField->nb_field_to_receive); for (int ifield = 0 ; ifield < MyField->nb_field_to_receive ; ifield ++){ MPI_Request recvN, recvSizeV; // receive information on vectors N and sizeV from the other int fieldGmshTag = MyField->FieldToReceive[ifield]; int fieldILSTag = AllField->GetILSTagFromGmshTag(fieldGmshTag); int rank_emiter = AllField->rank[fieldILSTag]; int tagN = 10*fieldGmshTag + 1; int tagSizeV = 10*fieldGmshTag + 2; // resize before receiving MyField->theirN[ifield].resize(24); MyField->theirSizeV[ifield].resize(24); // Receive MPI_Irecv(&(MyField->theirN[ifield][0]), 24, MPI_INT, rank_emiter, tagN, MPI_COMM_WORLD, &recvN); MPI_Irecv(&(MyField->theirSizeV[ifield][0]), 24, MPI_INT, rank_emiter, tagSizeV, MPI_COMM_WORLD, &recvSizeV); tab_request.push_back(recvN); tab_request.push_back(recvSizeV); } // check if reception is ok std::vector< MPI_Status > tab_status; MPI_Waitall(tab_request.size(), &tab_request[0], &tab_status[0]); } // keep track of fields for external use MyStaticField = MyField; AllStaticField = AllField; PetscFunctionReturn(0); } // Communicate PViews static PetscErrorCode PViewBCast(ILSField MyField, ILSField AllField, const std::set &fieldsToSkip=std::set()) { if(Message::GetCommSize() == 1) // serial: all views are available to everyone PetscFunctionReturn(0); if(!(ILSField::areNeighbor)){ // broadcast all views for (int iField = 0 ; iField < AllField.nb_field ; iField++){ int GmshTag = AllField.GmshTag[iField]; int fieldRank = AllField.rank[iField]; std::vector< std::vector* > V(24); std::vector sizeV(24); std::vector N(24); int masterRank = fieldRank; MPI_Comm fieldcomm = MPI_COMM_WORLD; int mpi_fieldcomm_rank = Message::GetCommRank(); if(mpi_fieldcomm_rank == fieldRank){ PView *view = GetViewByTag(GmshTag); view->getData()->getListPointers(&N[0], &V[0]); for(int j = 0 ; j < 24 ; j++) sizeV[j] = (*(V[j])).size(); } // Transfer PView MPI_Bcast(&N[0], 24, MPI_INT, masterRank, fieldcomm); MPI_Bcast(&sizeV[0], 24, MPI_INT, masterRank, fieldcomm); for(int j = 0; j < 24 ; j ++){ if(mpi_fieldcomm_rank != masterRank){ V[j] = new std::vector; (*(V[j])).resize(sizeV[j]); } if(sizeV[j] > 0) //avoid useless BCast MPI_Bcast(&(*(V[j]))[0], sizeV[j], MPI_DOUBLE, masterRank, fieldcomm); } // All other tasks of the communicator create/update the views if(mpi_fieldcomm_rank != masterRank){ PView *view = new PView(GmshTag); view->getData()->importLists(&N[0], &V[0]); for(int j = 0 ; j < 24 ; j++) delete V[j] ; } } } else{ // With a specification on the neighbors, asynchronous Send/Recv (only with // the neighbors) std::vector< MPI_Request > tab_request(0); // send my PView to my neighbors for (int ifield = 0 ; ifield < MyField.nb_field ; ifield ++){ int GmshTag = MyField.GmshTag[ifield]; // don't send field if explicitely asked to skip it if(fieldsToSkip.find(GmshTag) != fieldsToSkip.end()) continue; PView *view = GetViewByTag(GmshTag); std::vector< std::vector* > V_send(24); std::vector N(24); view->getData()->getListPointers(&N[0], &V_send[0]); for (int j = 0 ; j < 24 ; j ++){ int tag = 100 * GmshTag + j; int n_data = MyField.mySizeV[ifield][j]; if(n_data > 0){ //Loop on the receiver for (unsigned int ineigh = 0 ; ineigh < MyField.RankToSend[ifield].size() ; ineigh ++){ MPI_Request sendV; int receiver = MyField.RankToSend[ifield][ineigh]; MPI_Isend(&(*(V_send[j]))[0], n_data, MPI_DOUBLE, receiver, tag, MPI_COMM_WORLD, &sendV); tab_request.push_back(sendV); Message::Debug("Rank %d has sent %d", Message::GetCommRank(), GmshTag); } } } } //receive all the PView I need std::vector< std::vector< std::vector* > > V_recv(MyField.nb_field_to_receive); for (int ifield = 0 ; ifield < MyField.nb_field_to_receive ; ifield ++){ int GmshTag = MyField.FieldToReceive[ifield]; // don't receive field if explicitely asked to skip it if(fieldsToSkip.find(GmshTag) != fieldsToSkip.end()) continue; int sender = AllField.GetRankFromGmshTag(GmshTag); V_recv[ifield].resize(24); std::vector N(24); // allocate memory for (int j = 0 ; j < 24 ; j ++){ V_recv[ifield][j] = new std::vector; (*(V_recv[ifield][j])).resize(MyField.theirSizeV[ifield][j]); } for (int j = 0 ; j < 24 ; j ++){ int n_data = MyField.theirSizeV[ifield][j]; if(n_data > 0){ MPI_Request recvV; int tag = 100*GmshTag + j; MPI_Irecv(&(*(V_recv[ifield][j]))[0], n_data, MPI_DOUBLE, sender, tag, MPI_COMM_WORLD, &recvV); tab_request.push_back(recvV); Message::Debug("Rank %d has received %d", Message::GetCommRank(), GmshTag); } } } // check if reception is ok std::vector< MPI_Status > tab_status(tab_request.size()); MPI_Waitall(tab_request.size(), &tab_request[0], &tab_status[0]); for (int ifield = 0 ; ifield < MyField.nb_field_to_receive ; ifield ++){ int GmshTag = MyField.FieldToReceive[ifield]; if(fieldsToSkip.find(GmshTag) != fieldsToSkip.end()) continue; PView *view = new PView(GmshTag); view->getData()->importLists(&MyField.theirN[ifield][0], &V_recv[ifield][0]); for (int j = 0 ; j < 24 ; j ++){ delete V_recv[ifield][j]; } } } PetscFunctionReturn(0); } // Copy a STD Vector (std_vec) to a PETSc VEc (petsc_vec) // In fact, copy the local part only of the PETSc Vec static PetscErrorCode STD_vector_to_PETSc_Vec (std::vector > > std_vec, Vec petsc_vec, ILSField *Local) { PetscInt nb_view = Local->nb_field; for (int cpt_view = 0; cpt_view < nb_view; cpt_view++){ int nb_element = Local->size[cpt_view]; std::vector val; std::vector ix; if(Current.NbrHar == 2){ #if defined(PETSC_USE_COMPLEX) val.resize(nb_element); ix.resize(nb_element); #else val.resize(2*nb_element); ix.resize(2*nb_element); #endif } else{ val.resize(nb_element); ix.resize(nb_element); } for (int i = 0 ; i < nb_element ; i++){ if(Current.NbrHar == 2){ #if defined(PETSC_USE_COMPLEX) ix[i] = Local->iStart[cpt_view] + i; val[i] = std_vec[cpt_view][0][i] + PETSC_i*std_vec[cpt_view][1][i]; #else ix[2*i] = 2*Local->iStart[cpt_view] + 2*i; ix[2*i+1] = 2*Local->iStart[cpt_view] + 2*i+1; val[2*i] = std_vec[cpt_view][0][i]; val[2*i+1] = std_vec[cpt_view][1][i]; #endif } else{ ix[i] = Local->iStart[cpt_view] + i; val[i] = std_vec[cpt_view][0][i]; } } if(Current.NbrHar == 2){ #if defined(PETSC_USE_COMPLEX) _try(VecSetValues(petsc_vec, nb_element, &ix[0], &val[0], INSERT_VALUES)); #else _try(VecSetValues(petsc_vec, 2*nb_element, &ix[0], &val[0], INSERT_VALUES)); #endif } else{ _try(VecSetValues(petsc_vec, nb_element, &ix[0], &val[0], INSERT_VALUES)); } } _try(VecAssemblyBegin(petsc_vec)); _try(VecAssemblyEnd(petsc_vec)); PetscBarrier((PetscObject)petsc_vec); PetscFunctionReturn(0); } // Copy Petsc Vec to a std::vector // Send ONLY THE LOCAL Part of the PETSC VEC ! static PetscErrorCode PETSc_Vec_to_STD_Vec (Vec petsc_vec, ILSField *Local, std::vector > > *std_vec) { PetscScalar val; int nb_view = Local->nb_field; // initializing std_vec (*std_vec).resize(Local->nb_field); for (int cpt_view = 0 ; cpt_view < nb_view ; cpt_view++){ int nb_elem = Local->size[cpt_view]; if(Current.NbrHar == 2){ (*std_vec)[cpt_view].resize(2); (*std_vec)[cpt_view][0].resize(nb_elem); (*std_vec)[cpt_view][1].resize(nb_elem); } else{ (*std_vec)[cpt_view].resize(1); (*std_vec)[cpt_view][0].resize(nb_elem); } } for (int cpt_view = 0 ; cpt_view < nb_view ; cpt_view++){ int nb_element = Local->size[cpt_view]; int iStart = Local->iStart[cpt_view]; for (int j = 0 ; j < nb_element ; j++) { int cpt = iStart + j; if(Current.NbrHar == 2){ #if defined(PETSC_USE_COMPLEX) _try(VecGetValues(petsc_vec, 1, &cpt, &val)); (*std_vec)[cpt_view][0][j] = (double)PetscRealPart(val); (*std_vec)[cpt_view][1][j] = (double)PetscImaginaryPart(val); #else int cpt2 = 2*iStart + 2*j; _try(VecGetValues(petsc_vec, 1, &cpt2, &val)); (*std_vec)[cpt_view][0][j] = (double)(val); int cpt3 = 2*iStart + 2*j+1; _try(VecGetValues(petsc_vec, 1, &cpt3, &val)); (*std_vec)[cpt_view][1][j] = (double)(val); #endif } else{ _try(VecGetValues(petsc_vec, 1, &cpt, &val)); (*std_vec)[cpt_view][0][j] = (double)PetscRealPart(val); } } } PetscFunctionReturn(0); } // Initialize the MatShell Matrix // Preallocate the memory static PetscErrorCode CreateILSMat(ILSMat **shell) { ILSMat *newctx; std::vector vec_indice, vec_size; newctx = (ILSMat*)malloc(sizeof(ILSMat)); newctx->MyField = NULL; newctx->AllField = NULL; newctx->LinearSystemType = NULL; newctx->Resolution_P = NULL; newctx->Operation_P = NULL; newctx->DofData_P0 = NULL; newctx->GeoData_P0 = NULL; *shell = newctx; PetscFunctionReturn(0); } // Set data to the shell matrix contex static PetscErrorCode SetILSMat(ILSMat **shell, char *LinearSystemType, ILSField *MyField, ILSField *AllField, struct Resolution *Resolution_P, struct Operation *Operation_P, struct DofData *DofData_P0, struct GeoData *GeoData_P0) { (*shell)->LinearSystemType = LinearSystemType; (*shell)->MyField = MyField; (*shell)->AllField = AllField; (*shell)->Resolution_P = Resolution_P; (*shell)->Operation_P = Operation_P; (*shell)->DofData_P0 = DofData_P0; (*shell)->GeoData_P0 = GeoData_P0; PetscFunctionReturn(0); } // User Matrix-vector product static PetscErrorCode MatMultILSMat(Mat A, Vec X, Vec Y) { std::vector > > std_vec; ILSField MyField, AllField; ILSMat *ctx; char *LinearSystemType; #ifdef TIMER double tBcast_start, tBcast_end; double tTreatment_start, tTreatment_end; double t_start = MPI_Wtime(), t_end; #endif _try(MatShellGetContext(A, (void**)&ctx)); LinearSystemType = ctx->LinearSystemType; // convert X to a std vector _try(PETSc_Vec_to_STD_Vec(X, ctx->MyField, &std_vec)); // Update PViews for (int cpt_view = 0; cpt_view < ctx->MyField->nb_field; cpt_view++){ PView *view = GetViewByTag(ctx->MyField->GmshTag[cpt_view]); view->getData()->fromVector(std_vec[cpt_view]); } // PVIEW BCAST #ifdef TIMER tBcast_start = MPI_Wtime(); #endif PViewBCast(*(ctx->MyField), *(ctx->AllField)); #ifdef TIMER tBcast_end = MPI_Wtime(); #endif // Getdp resolution (contained in the matrix context) // Barrier to ensure that every process have the good data in RAM #ifdef TIMER tTreatment_start = MPI_Wtime(); #endif Treatment_Operation(ctx->Resolution_P, ctx->Operation_P->Case.IterativeLinearSolver.Operations_Ax, ctx->DofData_P0, ctx->GeoData_P0, NULL, NULL); #ifdef TIMER tTreatment_end = MPI_Wtime(); #endif // Extract the (std) vector from the (new) .pos files // This assumes that every process reads every .pos files for(int cpt_view = 0; cpt_view < ctx->MyField->nb_field; cpt_view++) { PView *view = GetViewByTag(ctx->MyField->GmshTag[cpt_view]); view->getData()->toVector(std_vec[cpt_view]); } // Convert the obtained vector to a Petsc Vec _try(STD_vector_to_PETSc_Vec(std_vec, Y, ctx->MyField)); // Set Y = X - Y if(!strcmp(LinearSystemType,"I-A")) _try(VecAYPX(Y, -1.,X)); else if(!strcmp(LinearSystemType,"I+A")) _try(VecAYPX(Y, 1.,X)); #ifdef TIMER // time computation t_end = MPI_Wtime(); double t_MatMult, t_Bcast, t_Treatment; t_MatMult = t_end - t_start; t_Bcast = tBcast_end - tBcast_start; t_Treatment = tTreatment_end - tTreatment_start; ctx->MyField->TimeTreatment.push_back(t_Treatment); ctx->MyField->TimeBcast.push_back(t_Bcast); ctx->MyField->TimeIt.push_back(t_MatMult); Message::Info(3, "Processus %d ended iteration in %g seconds with %g for communication", Message::GetCommRank(), t_MatMult, t_Bcast); #endif _try(PetscBarrier((PetscObject)PETSC_NULL)); PetscFunctionReturn(0); } // Build the iteration matrix of the Matrix-free vector-product. // Used to, e.g., study eigenvalues of the operators static PetscErrorCode BuildIterationMatrix(Mat A, Mat *IterationMatrix) { const PetscScalar one = 1., zero = 0.; PetscInt n_proc, m,n, m_loc, n_loc; PetscInt m_start, m_end, vec_m_start, vec_m_end; _try(MPI_Comm_size(PETSC_COMM_WORLD, &n_proc)); _try(MatGetSize(A, &m, &n)); _try(MatCreate(PETSC_COMM_WORLD, IterationMatrix)); _try(MatSetSizes((*IterationMatrix), PETSC_DECIDE, PETSC_DECIDE, m, n)); _try(MatSetType((*IterationMatrix), MATMPIAIJ)); _try(MatSetFromOptions((*IterationMatrix))); _try(MatSetUp((*IterationMatrix))); _try(MatGetOwnershipRange((*IterationMatrix), &m_start, &m_end)); _try(MatGetLocalSize((*IterationMatrix), &m_loc, &n_loc)); _try(MatMPIAIJSetPreallocation((*IterationMatrix), m_loc, PETSC_NULL, n-m_loc, PETSC_NULL)); std::vector ix(m); for(PetscInt i = 0; i vec_temp(n); _try(VecSet(ej, zero)); if(cpt >= vec_m_start && cpt= 2))) _try(PetscViewerDestroy(&viewer)); #else _try(PetscViewerDestroy(viewer)); #endif } else{ Message::Warning("Matrix is too large, no ASCII Output (m=%d>%d)", m, m_max); } // BINARY // Add the petscfolder/bin/matlab path to your matlab paths and // type the following command in matlab, for real arithmetic : // A = PetscBinaryRead(filename) ; // and for complex arithmetic : // A = PetscBinaryRead(filename , 'complex', true) ; PetscViewer viewer_bin; _try(PetscViewerBinaryOpen(PETSC_COMM_WORLD, (tmp + ".bin").c_str(), FILE_MODE_WRITE, &viewer_bin)); _try(PetscViewerSetFormat(viewer_bin, PETSC_VIEWER_DEFAULT)); _try(MatView(A, viewer_bin)); #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) _try(PetscViewerDestroy(&viewer_bin)); #else _try(PetscViewerDestroy(viewer_bin)); #endif PetscFunctionReturn(0); } // Print a SEQUENTIAL Petsc Vec into a Matlab File static PetscErrorCode PrintVecSeq(Vec b, const char* filename, const char* varname) { std::string tmp(filename); PetscViewer viewer, viewer_bin; _try(PetscObjectSetName((PetscObject)b, varname)); _try(PetscViewerASCIIOpen(PETSC_COMM_SELF, filename, &viewer)); _try(PetscViewerSetFormat(viewer, PETSC_VIEWER_ASCII_MATLAB)); // see PrintMat function for the how-to use it _try(PetscViewerBinaryOpen(PETSC_COMM_SELF, (tmp + ".bin").c_str(), FILE_MODE_WRITE, &viewer_bin)); _try(PetscViewerSetFormat(viewer_bin, PETSC_VIEWER_DEFAULT)); VecView(b, viewer); VecView(b, viewer_bin); #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) _try(PetscViewerDestroy(&viewer)); _try(PetscViewerDestroy(&viewer_bin)); #else _try(PetscViewerDestroy(viewer)); _try(PetscViewerDestroy(viewer_bin)); #endif PetscFunctionReturn(0); } // Print a Petsc Vec into a Matlab File - FIXME: to be changed! static PetscErrorCode PrintVec(Vec b, const char* filename, const char* varname) { // This function is copy/paste of function LinAlg_PrintMatrix function // located in Legacy/LinAlg_PETSC.cpp #if (PETSC_VERSION_MAJOR == 0) || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 4)) const char *type = ""; #else const VecType type; #endif _try(VecGetType(b, &type)); if(!strcmp(type, "seq")){ // AND NUM_PROC > 1 ! _try(PrintVecSeq(b, filename, varname)); PetscFunctionReturn(0); } PetscViewer viewer, viewer_bin; std::string tmp(filename); _try(PetscObjectSetName((PetscObject)b, varname)); // ASCII _try(PetscViewerASCIIOpen(PETSC_COMM_WORLD, filename, &viewer)); _try(PetscViewerSetFormat(viewer, PETSC_VIEWER_ASCII_MATLAB)); // see PrintMat function for the how-to use it _try(PetscViewerBinaryOpen(PETSC_COMM_WORLD, (tmp + ".bin").c_str(), FILE_MODE_WRITE, &viewer_bin)); _try(PetscViewerSetFormat(viewer_bin, PETSC_VIEWER_DEFAULT)); VecView(b, viewer); VecView(b, viewer_bin); #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) _try(PetscViewerDestroy(&viewer)); _try(PetscViewerDestroy(&viewer_bin)); #else _try(PetscViewerDestroy(viewer)); _try(PetscViewerDestroy(viewer_bin)); #endif PetscFunctionReturn(0); } static PetscErrorCode Jacobi_Solver(Mat A, Vec X, Vec B, double Tol, int MaxIter) { Vec X_old, W; double residu; _try(VecSet(X, 0.)); _try(VecDuplicate(X, &X_old)); _try(VecDuplicate(X, &W)); _try(VecCopy(X, W)); for (int j=1; j < MaxIter; j++){ _try(VecCopy(X, X_old)); _try(MatMultILSMat(A, X_old, X)); _try(VecAYPX(X, 1.,B)); // X = X + B //convergence test _try(VecWAXPY(W, -1.,X_old, X)); //W = X-X_old _try(VecNorm(W, NORM_2, &residu)); Message::Info(3, "Jacobi iteration %d residual %g", j, residu); if(residu < Tol) break; } PetscFunctionReturn(0); } // matrix-free preconditionning // Matrix-vector product for the preconditioning. Quite a copy/past of MatMultILSMat static PetscErrorCode MatMultPC(PC pc, Vec X, Vec Y) { std::vector > > std_vec; ILSField MyField, AllField; ILSMat *ctx; _try(PCShellGetContext(pc, (void**)&ctx)); //convert X to a std vector _try(PETSc_Vec_to_STD_Vec(X, ctx->MyField, &std_vec)); // Update PViews for (int cpt_view = 0; cpt_view < ctx->MyField->nb_field; cpt_view++){ PView *view = GetViewByTag(ctx->MyField->GmshTag[cpt_view]); view->getData()->fromVector(std_vec[cpt_view]); } // PVIEW BCAST ! PViewBCast(*(ctx->MyField), *(ctx->AllField)); // Getdp resolution (contained in the matrix context) Treatment_Operation(ctx->Resolution_P, ctx->Operation_P->Case.IterativeLinearSolver.Operations_Mx, ctx->DofData_P0, ctx->GeoData_P0, NULL, NULL); // Extract the (std) vector from the (new) .pos files // This assumes that every process reads every .pos files for(int cpt_view = 0; cpt_view < ctx->MyField->nb_field; cpt_view++) { PView *view = GetViewByTag(ctx->MyField->GmshTag[cpt_view]); view->getData()->toVector(std_vec[cpt_view]); } //Convert the obtained vector to a Petsc Vec _try(STD_vector_to_PETSc_Vec(std_vec, Y, ctx->MyField)); _try(PetscBarrier((PetscObject)PETSC_NULL)); PetscFunctionReturn(0); } static int KspMonitor(KSP ksp, PetscInt it, PetscReal rnorm, void *mctx) { Message::Cpu(3, false, true, true, true, "%3ld KSP Residual norm %14.12e", (long)it, rnorm); return 0; } int Operation_IterativeLinearSolver(struct Resolution *Resolution_P, struct Operation *Operation_P, struct DofData *DofData_P0, struct GeoData *GeoData_P0) { int mpi_comm_size = Message::GetCommSize(); int mpi_comm_rank = Message::GetCommRank(); ILSMat *ctx, *ctx_pc; // Matrix Shell context and PC context Mat A; KSP ksp; std::string Solver; int MaxIter, Restart; double Tol; std::vector > > B_std; // rhs (std version) Vec B, X; // rhs and Solution PC pc; MPI_Comm ILSComm = PETSC_COMM_WORLD; // by default, KSP is launched in parallel char *LinearSystemType; ILSField MyField, AllField; #if defined(TIMER) double time_total = 0.; double time_start = MPI_Wtime(); #endif // Initializing MPI_Barrier(PETSC_COMM_WORLD); Message::Info("Initializing Iterative Linear Solver"); InitData(&MyField, &AllField, Operation_P, &B_std); // Print Information Tol = Operation_P->Case.IterativeLinearSolver.Tolerance; MaxIter = Operation_P->Case.IterativeLinearSolver.MaxIter; Restart = Operation_P->Case.IterativeLinearSolver.Restart; Solver = Operation_P->Case.IterativeLinearSolver.Type; LinearSystemType = Operation_P->Case.IterativeLinearSolver.OpMatMult; if(strcmp(LinearSystemType, "I-A") && strcmp(LinearSystemType, "I+A") && strcmp(LinearSystemType, "A")){ Message::Error("Linear system type \"%s\" unknown. Try \"A\", \"I-A\" or \"I+A\".", LinearSystemType); } Message::Info(3, "Linear system type: (%s)X = B", LinearSystemType); Message::Info(3, "Number of Processes: %d", mpi_comm_size); Message::Info(3, "Iterative solver: %s", Solver.c_str()); Message::Info(3, "Tolerance: %g", Tol); Message::Info(3, "Max. numb. of iterations: %i", MaxIter); Message::Info(3, "Restart: %i", Restart); // if jacobi then MatMult(A,X) = A*X for linear system (I-A)*X=B if(Solver == "jacobi"){ if(strcmp(LinearSystemType, "I-A")) Message::Error("Jacobi method implemented only for linear system of type \"I-A\""); LinearSystemType = (char *)"A"; } Message::Info(3, "Number of Fields: %d", AllField.nb_field); if(ILSField::areNeighbor) Message::Info(3, "Neighbors are specified: Fast exchange between process"); for(int iField = 0; iField < AllField.nb_field; iField++) Message::Info(3, "Size of Field %d: %d (on CPU %d)", AllField.GmshTag[iField], AllField.size[iField], AllField.rank[iField]); Message::Info(3, "Total system size: %d", AllField.n_elem); #if !defined(PETSC_USE_COMPLEX) if(Current.NbrHar == 2){ AllField.n_elem *= 2; MyField.n_elem *= 2; Message::Info(3, "PETSc REAL arithmetic: system size is doubled: n=%d", AllField.n_elem); } #endif // Creating the vector/matrix // Petsc Vec of unknown _try(VecCreate(ILSComm, &X)); _try(VecSetSizes(X, MyField.n_elem, AllField.n_elem)); _try(VecSetFromOptions(X)); // Petsc Vec Right Hand Side _try(VecDuplicate(X, &B)); STD_vector_to_PETSc_Vec(B_std, B, &MyField); // context of the shell matrix _try(CreateILSMat(&ctx)); _try(SetILSMat(&ctx, LinearSystemType, &MyField, &AllField, Resolution_P, Operation_P, DofData_P0, GeoData_P0)); // Shell matrix containg the indices of the unknown field (on which the // iterative solver works) _try(MatCreateShell(ILSComm, MyField.n_elem, MyField.n_elem, AllField.n_elem, AllField.n_elem, ctx, &A)); _try(MatShellSetContext(A, ctx)); _try(MatShellSetOperation(A, MATOP_MULT, (void(*)(void))MatMultILSMat)); _try(PetscBarrier((PetscObject)PETSC_NULL)); // Creation of the iterative solver + solving if(Solver == "print"){ // Print the iteration matrix Message::Info(3, "Launching Print mode (no resolution):"); Message::Info(3, "Building Iteration Matrix..."); Mat IterationMatrix; _try(BuildIterationMatrix(A, &IterationMatrix)); Message::Info(3, "Printing Iteration Matrix..."); _try(PrintMatrix(IterationMatrix, "file_mat_itmat.m", "IterationMatrix")); Message::Info(3, "Printing Right Hand Side..."); _try(PrintVec(B, "file_vec_rhs.m", "RightHandSide")); Message::Info(3, "done"); #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) _try(VecDestroy(&X)); _try(VecDestroy(&B)); _try(MatDestroy(&A)); #else _try(VecDestroy(X)); _try(VecDestroy(B)); _try(MatDestroy(A)); #endif PetscFunctionReturn(0); } else if(Solver == "jacobi"){ _try(Jacobi_Solver(A, X, B, Tol, MaxIter)); } else{ // Krylov subspace solver _try(KSPCreate(ILSComm,&ksp)); #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 5))) _try(KSPSetOperators(ksp, A, A)); #else _try(KSPSetOperators(ksp, A, A, DIFFERENT_NONZERO_PATTERN)); #endif _try(KSPSetTolerances(ksp, Tol, PETSC_DEFAULT, PETSC_DEFAULT, MaxIter)); _try(KSPMonitorSet(ksp, KspMonitor, PETSC_NULL, PETSC_NULL)); //Preconditioning bool pcright = true; std::string match = "_pcleft"; int pos = (int)Solver.find(match.c_str()); if(pos != (int)std::string::npos){ Solver.replace(pos, match.size(), ""); pcright = false; } _try(KSPGetPC(ksp, &pc)); // check if a preconditioner is specified int nb_pc = List_Nbr(Operation_P->Case.IterativeLinearSolver.Operations_Mx); if(nb_pc == 0) { _try(PCSetType(pc, PCNONE)); } else{ Message::Info(3, "%s preconditioner detected", pcright ? "Right" : "Left"); // context of the shell PC _try(CreateILSMat(&ctx_pc)); _try(SetILSMat(&ctx_pc, LinearSystemType, &MyField, &AllField, Resolution_P, Operation_P, DofData_P0, GeoData_P0)); // Shell PC _try(PCSetType(pc,PCSHELL)); _try(PCShellSetContext(pc, ctx_pc)); _try(PCShellSetApply(pc, MatMultPC)); #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) _try(KSPSetPCSide(ksp, pcright ? PC_RIGHT : PC_LEFT)); #else _try(KSPSetPreconditionerSide(ksp, pcright ? PC_RIGHT : PC_LEFT)); #endif } _try(KSPSetType(ksp, Solver.c_str())); if(Restart > 0 && Solver.find("gmres") != std::string::npos) _try(KSPGMRESSetRestart(ksp, Restart)); // set ksp _try(KSPSetFromOptions(ksp)); // Solve _try(KSPSolve(ksp, B, X)); _try(KSPView(ksp, PETSC_VIEWER_STDOUT_WORLD)); PetscInt its; _try(KSPGetIterationNumber(ksp, &its)); Current.KSPIts = its; #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) _try(KSPDestroy(&ksp)); #else _try(KSPDestroy(ksp)); #endif } // computing solution // we reuse B_std to avoid the creation of a new std::vector ... _try(PETSc_Vec_to_STD_Vec(X, &MyField, &B_std)); // update views for (int cpt_view = 0 ; cpt_view < MyField.nb_field; cpt_view++){ PView *view = GetViewByTag(MyField.GmshTag[cpt_view]); view->getData()->fromVector(B_std[cpt_view]); } // Transfer PView #ifdef TIMER double tbcast_start = MPI_Wtime(); #endif PViewBCast(MyField, AllField); #ifdef TIMER double tbcast_end = MPI_Wtime(); double t_bcast = tbcast_end - tbcast_start; Message::Info(3, "Process %d: tbcast = %g", mpi_comm_rank, t_bcast); #endif // cleaning #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) _try(VecDestroy(&X)); _try(VecDestroy(&B)); _try(MatDestroy(&A)); #else _try(VecDestroy(X)); _try(VecDestroy(B)); _try(MatDestroy(A)); #endif #ifdef TIMER time_total = MPI_Wtime() - time_start; #endif if(MyField.TimeBcast.size()){ // CPU Times double aver_it = 0, aver_com = 0; char filename[50]; FILE *fid; sprintf(filename, "log_cpu_%d", mpi_comm_rank); fid = FOpen(filename, "w"); fprintf(fid, "Process rank %d\n", mpi_comm_rank); fprintf(fid, "it. CPU Total \t ... Treatment \t ... Communication\n"); for (unsigned int i = 0; i < MyField.TimeBcast.size() ; i ++){ fprintf(fid, "%d \t%g\t %g\t %g\t (%g%%)\n", i+1, MyField.TimeIt[i], MyField.TimeTreatment[i], MyField.TimeBcast[i], MyField.TimeBcast[i]/MyField.TimeIt[i]*100); aver_com += MyField.TimeBcast[i]/MyField.TimeBcast.size(); aver_it += MyField.TimeIt[i]/MyField.TimeIt.size(); } fprintf(fid, "Average: %g %g\n", aver_it, aver_com); fprintf(fid, "Percent of communication in average: %g%%\n", aver_com/aver_it*100); fclose(fid); #ifdef TIMER Message::Info(3, "Processus %d: ended in %g", mpi_comm_rank, time_total); Message::Info(3, "Processus %d: Average iteration time %g with %g for communication (%g%%)", mpi_comm_rank, aver_it, aver_com, aver_com/aver_it*100); #endif } // reset pointers to static fields MyStaticField = AllStaticField = 0; _try(PetscBarrier((PetscObject)PETSC_NULL)); PetscFunctionReturn(0); } int Operation_BroadcastFields(struct Resolution *Resolution_P, struct Operation *Operation_P, struct DofData *DofData_P0, struct GeoData *GeoData_P0) { std::set fieldsToSkip; for(int i = 0; i < List_Nbr(Operation_P->Case.BroadcastFields.FieldsToSkip); i++){ double j; List_Read(Operation_P->Case.BroadcastFields.FieldsToSkip, i, &j); fieldsToSkip.insert((int) j); } PViewBCast(*MyStaticField, *AllStaticField, fieldsToSkip); return 0; } #else int Operation_IterativeLinearSolver(struct Resolution *Resolution_P, struct Operation *Operation_P, struct DofData *DofData_P0, struct GeoData *GeoData_P0) { Message::Error("IterativeLinearSolver requires PETSc and Gmsh"); return 0; } int Operation_BroadcastFields(struct Resolution *Resolution_P, struct Operation *Operation_P, struct DofData *DofData_P0, struct GeoData *GeoData_P0) { Message::Error("BroadcastFields requires PETSc and Gmsh"); return 0; } #endif getdp-2.7.0-source/Legacy/GF_HelmholtzxForm.cpp000644 001750 001750 00000013221 12473553042 023053 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Ruth Sabariego // #include #include "ProData.h" #include "ProDefine.h" #include "BF.h" #include "GF.h" #include "Gauss.h" #include "GeoData.h" #include "Message.h" #define SQU(a) ((a)*(a)) #define CUB(a) ((a)*(a)*(a)) #define ONE_OVER_TWO_PI 1.5915494309189534E-01 #define MAX_NODES 6 #define EPSILON 1.e-10 /* ------------------------------------------------------------------------ */ /* G F _ H e l m h o l t z x F o r m */ /* ------------------------------------------------------------------------ */ void GF_HelmholtzxForm(GF_ARGX) { double xs[MAX_NODES], ys[MAX_NODES], zs[MAX_NODES], u[3], v[3], n[3], l2[2]; double xl, yl, zl ; int i, j = 1 ; int i_IntPoint, NGT_Points = 7; double a, b, c, d, us, vs, ws, usi, vsi, wsi, Ri, wghti; double s0m, s0p, s1m, s1p, s2m, s2p, t00, t10, t20, t0m, t0p, t1p; double r00, r10, r20, r0p, r0m, r1p, f0, f1, f2, B0, B1, B2 ; double IS, valr, vali ; switch ((int)Fct->Para[0]) { case _3D : switch (Element->ElementSource->Type) { case TRIANGLE : case QUADRANGLE : xs[0] = Element->ElementSource->x[0] ; ys[0] = Element->ElementSource->y[0] ; zs[0] = Element->ElementSource->z[0] ; xs[1] = Element->ElementSource->x[1] ; ys[1] = Element->ElementSource->y[1] ; zs[1] = Element->ElementSource->z[1] ; xs[2] = Element->ElementSource->x[2] ; ys[2] = Element->ElementSource->y[2] ; zs[2] = Element->ElementSource->z[2] ; valr = 0. ; vali = 0. ; IS = 0. ; if (Element->ElementSource->Type == QUADRANGLE) { xs[3] = Element->ElementSource->x[3] ; ys[3] = Element->ElementSource->y[3] ; zs[3] = Element->ElementSource->z[3] ; j = 0 ; }; for(i = j; i < 2; i++){ /* triangle side lengths */ a = sqrt(SQU(xs[1]-xs[0]) + SQU(ys[1]-ys[0]) + SQU(zs[1]-zs[0])); b = sqrt(SQU(xs[2]-xs[1]) + SQU(ys[2]-ys[1]) + SQU(zs[2]-zs[1])); c = sqrt(SQU(xs[2]-xs[0]) + SQU(ys[2]-ys[0]) + SQU(zs[2]-zs[0])); /* local system (u,v,w) centered at (xs[0],ys[0],zs[0]) */ u[0] = (xs[1]-xs[0])/a; u[1] = (ys[1]-ys[0])/a; u[2] = (zs[1]-zs[0])/a; /* triangle normal */ Geo_CreateNormal(Element->ElementSource->Type,xs,ys,zs,n); v[0] = n[1]*u[2]-n[2]*u[1]; v[1] = n[2]*u[0]-n[0]*u[2]; v[2] = n[0]*u[1]-n[1]*u[0]; l2[0] = (xs[2]-xs[0])*u[0] + (ys[2]-ys[0])*u[1] + (zs[2]-zs[0])*u[2]; /*u2 coordinate*/ l2[1] = (xs[2]-xs[0])*v[0] + (ys[2]-ys[0])*v[1] + (zs[2]-zs[0])*v[2]; /*triangle height, v2 coordinate*/ /* local coordinates of the observation point (xl, yl, zl)*/ xl = u[0] * (x-xs[0]) + u[1] * (y-ys[0]) + u[2] * (z-zs[0]); yl = v[0] * (x-xs[0]) + v[1] * (y-ys[0]) + v[2] * (z-zs[0]); zl = n[0] * (x-xs[0]) + n[1] * (y-ys[0]) + n[2] * (z-zs[0]); s0m = -( (a-xl) * (a-l2[0]) + yl*l2[1] ) / b; s0p = s0m + b; s1p = ( xl * l2[0] + yl * l2[1] ) / c; s1m = s1p - c; s2m = - xl; s2p = a - xl; /*distance observation point projection on triangle plane to triangle local vertices*/ t00 = (yl * (l2[0]-a) + l2[1] * (a-xl)) / b; t10 = (xl * l2[1] - yl * l2[0]) / c; t20 = yl; t0m = sqrt((a-xl)*(a-xl) + yl*yl); t0p = sqrt((l2[0]-xl)*(l2[0]-xl) + (l2[1]-yl)*(l2[1]-yl)); t1p = sqrt(xl*xl + yl*yl); /* minimum distances from the observation point to each triangle side*/ r00 = sqrt(SQU(t00) + SQU(zl)); r10 = sqrt(SQU(t10) + SQU(zl)); r20 = sqrt(SQU(t20) + SQU(zl)); /* distances from observation point to the vertices*/ r0p = sqrt(SQU(t0p) + SQU(zl)); r0m = sqrt(SQU(t0m) + SQU(zl)); r1p = sqrt(SQU(t1p) + SQU(zl)); /* intermediate functions */ f0 = r00 <= EPSILON ? 0 : log((r0p + s0p) / (r0m + s0m)); f1 = r10 <= EPSILON ? 0 : log((r1p + s1p) / (r0p + s1m)); f2 = r20 <= EPSILON ? 0 : log((r0m + s2p) / (r1p + s2m)); B0 = fabs(t00) <= EPSILON ? 0 : atan(t00*s0p/(SQU(r00)+fabs(zl)*r0p))-atan(t00*s0m/(SQU(r00)+fabs(zl)*r0m)); B1 = fabs(t10) <= EPSILON ? 0 : atan(t10*s1p/(SQU(r10)+fabs(zl)*r1p))-atan(t10*s1m/(SQU(r10)+fabs(zl)*r0p)); B2 = fabs(t20) <= EPSILON ? 0 : atan(t20*s2p/(SQU(r20)+fabs(zl)*r0m))-atan(t20*s2m/(SQU(r20)+fabs(zl)*r1p)); d = a * l2[1]; /* Double aire a cause de normalization */ IS += ONE_OVER_TWO_PI * (-fabs(zl)*(B0+B1+B2) + t00*f0+t10*f1+t20*f2)/d; /* 1/r integral solution*/ /* Gauss Numerical Integration of (exp(Fct->Para[1]*R)-1)/R */ for (i_IntPoint = 1; i_IntPoint <= NGT_Points; i_IntPoint++){ Gauss_Triangle(NGT_Points,i_IntPoint,&us,&vs,&ws,&wghti); usi = u[0]*us + u[1]*vs + u[2]*ws ; vsi = v[0]*us + v[1]*vs + v[2]*ws ; wsi = n[0]*us + n[1]*vs + n[2]*ws ; Ri = sqrt( SQU(xl-usi) + SQU(yl-vsi) + SQU(zl-wsi) ) ; valr += Ri > EPSILON ? (wghti*(cos(Fct->Para[1]*Ri)-1)/Ri): 0 ; vali += Ri > EPSILON ? (-wghti*sin(Fct->Para[1]*Ri)/Ri): (-wghti * Fct->Para[1]); } valr = d * valr/2; vali = d * vali/2; Val->Val[0] = IS + valr ; Val->Val[MAX_DIM] = vali ; /* Imaginary part. Numerical integral */ if (j == 0){ xs[1] = xs[2]; ys[1] = ys[2]; zs[1] = zs[2]; xs[2] = xs[3]; ys[2] = ys[3]; zs[2] = zs[3]; } } if (j == 0){ Val->Val[0] = (Val->Val[0])/2; } Val->Type = SCALAR; break ; default : Message::Error("Unknown Element Type (%s) for 'GF_HelmholtzxForm'", Get_StringForDefine(Element_Type, Element->ElementSource->Type)); } break ; default : Message::Error("Unknown Dimension (%d) for 'GF_HelmholtzxForm'", (int)Fct->Para[0]); } } getdp-2.7.0-source/Legacy/Get_Geometry.cpp000644 001750 001750 00000122231 12542221511 022077 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Patrick Lefevre // #include #include "GetDPConfig.h" #include "ProData.h" #include "ProDefine.h" #include "Get_Geometry.h" #include "GeoData.h" #include "BF.h" #include "Gauss.h" #include "Message.h" #define THESIGN(a) ((a)>=0 ? 1 : -1) #define SQU(a) ((a)*(a)) #define HYPOT(a,b) (sqrt((a)*(a)+(b)*(b))) /* ------------------------------------------------------------------------ */ /* G e t _ N o d e s C o o r d i n a t e s O f E l e m e n t */ /* ------------------------------------------------------------------------ */ void Get_NodesCoordinatesOfElement(struct Element * Element) { if (Element->NumLastElementForNodesCoordinates != Element->Num) { Element->NumLastElementForNodesCoordinates = Element->Num ; Geo_GetNodesCoordinates (Element->GeoElement->NbrNodes, Element->GeoElement->NumNodes, Element->x, Element->y, Element->z) ; } } /* ------------------------------------------------------------------------ */ /* G e t _ B F G e o E l e m e n t */ /* ------------------------------------------------------------------------ */ void Get_BFGeoElement(struct Element * Element, double u, double v, double w) { int i ; for (i = 0 ; i < Element->GeoElement->NbrNodes ; i++) { BF_Node (Element, i+1, u, v, w, &(Element->n[i])) ; BF_GradNode(Element, i+1, u, v, w, Element->dndu[i]) ; } } /* ------------------------------------------------------------------------ */ /* G e t _ J a c o b i a n F u n c t i o n */ /* ------------------------------------------------------------------------ */ void * Get_JacobianFunction (int Type_Jacobian, int Type_Element, int * Type_Dimension) { switch (Type_Jacobian) { case JACOBIAN_VOL : switch (Type_Element) { case POINT : *Type_Dimension = _0D ; return((void *)JacobianVol0D) ; case LINE : case LINE_2 : *Type_Dimension = _1D ; return((void *)JacobianVol1D) ; case TRIANGLE : case TRIANGLE_2 : case QUADRANGLE : case QUADRANGLE_2 : case QUADRANGLE_2_8N : *Type_Dimension = _2D ; return((void *)JacobianVol2D) ; case TETRAHEDRON : case TETRAHEDRON_2 : case HEXAHEDRON : case HEXAHEDRON_2 : case PRISM : case PRISM_2 : case PYRAMID : case PYRAMID_2 : *Type_Dimension = _3D ; return((void *)JacobianVol3D) ; default : Message::Error("Unknown Jacobian Vol for Element Type (%s)", Get_StringForDefine(Element_Type, Type_Element)); } case JACOBIAN_VOL_SPH_SHELL : switch (Type_Element) { case TRIANGLE : case TRIANGLE_2 : case QUADRANGLE : case QUADRANGLE_2 : case QUADRANGLE_2_8N : *Type_Dimension = _2D ; return((void *)JacobianVolSphShell2D) ; case TETRAHEDRON : case TETRAHEDRON_2 : case HEXAHEDRON : case HEXAHEDRON_2 : case PRISM : case PRISM_2 : case PYRAMID : case PYRAMID_2 : *Type_Dimension = _3D ; return((void *)JacobianVolSphShell3D) ; default : Message::Error("Unknown Jacobian VolSphShell for Element Type (%s)", Get_StringForDefine(Element_Type, Type_Element)); } case JACOBIAN_VOL_RECT_SHELL : switch (Type_Element) { case TRIANGLE : case TRIANGLE_2 : case QUADRANGLE : case QUADRANGLE_2 : case QUADRANGLE_2_8N : *Type_Dimension = _2D ; return((void *)JacobianVolRectShell2D) ; case TETRAHEDRON : case TETRAHEDRON_2 : case HEXAHEDRON : case HEXAHEDRON_2 : case PRISM : case PRISM_2 : case PYRAMID : case PYRAMID_2 : *Type_Dimension = _3D ; return((void *)JacobianVolRectShell3D) ; default : Message::Error("Unknown Jacobian VolRectShell for Element Type (%s)", Get_StringForDefine(Element_Type, Type_Element)); } case JACOBIAN_VOL_PLPD_X : switch (Type_Element) { case TRIANGLE : case TRIANGLE_2 : case QUADRANGLE : case QUADRANGLE_2 : case QUADRANGLE_2_8N : *Type_Dimension = _2D ; return((void *)JacobianVolPlpdX2D) ; default : Message::Error("Unknown Jacobian VolPlpdX for Element Type (%s)", Get_StringForDefine(Element_Type, Type_Element)); } case JACOBIAN_VOL_AXI : switch (Type_Element) { case LINE : case LINE_2 : *Type_Dimension = _1D ; return((void *)JacobianVolAxi1D) ; case TRIANGLE : case TRIANGLE_2 : case QUADRANGLE : case QUADRANGLE_2 : case QUADRANGLE_2_8N : *Type_Dimension = _2D ; return((void *)JacobianVolAxi2D) ; default : Message::Error("Unknown Jacobian VolAxi for Element Type (%s)", Get_StringForDefine(Element_Type, Type_Element)); } case JACOBIAN_VOL_AXI_SPH_SHELL : switch (Type_Element) { case TRIANGLE : case TRIANGLE_2 : case QUADRANGLE : case QUADRANGLE_2 : case QUADRANGLE_2_8N : *Type_Dimension = _2D ; return((void *)JacobianVolAxiSphShell2D) ; default : Message::Error("Unknown Jacobian VolAxiSphShell for Element Type (%s)", Get_StringForDefine(Element_Type, Type_Element)); } case JACOBIAN_VOL_AXI_RECT_SHELL : switch (Type_Element) { case TRIANGLE : case TRIANGLE_2 : case QUADRANGLE : case QUADRANGLE_2 : case QUADRANGLE_2_8N : *Type_Dimension = _2D ; return((void *)JacobianVolAxiRectShell2D) ; default : Message::Error("Unknown Jacobian VolAxiRectShell for Element Type (%s)", Get_StringForDefine(Element_Type, Type_Element)); } case JACOBIAN_VOL_AXI_PLPD_X : switch (Type_Element) { case TRIANGLE : case TRIANGLE_2 : case QUADRANGLE : case QUADRANGLE_2 : case QUADRANGLE_2_8N : *Type_Dimension = _2D ; return((void *)JacobianVolAxiPlpdX2D) ; default : Message::Error("Unknown Jacobian VolAxiPlpdX for Element Type (%s)", Get_StringForDefine(Element_Type, Type_Element)); } case JACOBIAN_VOL_AXI_SQU : switch (Type_Element) { case LINE : case LINE_2 : *Type_Dimension = _1D ; return((void *)JacobianVolAxiSqu1D) ; case TRIANGLE : case TRIANGLE_2 : case QUADRANGLE : case QUADRANGLE_2 : case QUADRANGLE_2_8N : *Type_Dimension = _2D ; return((void *)JacobianVolAxiSqu2D) ; default : Message::Error("Unknown Jacobian VolAxiSqu for Element Type (%s)", Get_StringForDefine(Element_Type, Type_Element)); } case JACOBIAN_VOL_AXI_SQU_SPH_SHELL : switch (Type_Element) { case TRIANGLE : case TRIANGLE_2 : case QUADRANGLE : case QUADRANGLE_2 : case QUADRANGLE_2_8N : *Type_Dimension = _2D ; return((void *)JacobianVolAxiSquSphShell2D) ; default : Message::Error("Unknown Jacobian VolAxiSquSphShell for Element Type (%s)", Get_StringForDefine(Element_Type, Type_Element)); } case JACOBIAN_VOL_AXI_SQU_RECT_SHELL : switch (Type_Element) { case TRIANGLE : case TRIANGLE_2 : case QUADRANGLE : case QUADRANGLE_2 : case QUADRANGLE_2_8N : *Type_Dimension = _2D ; return((void *)JacobianVolAxiSquRectShell2D) ; default : Message::Error("Unknown Jacobian VolAxiSquRectShell for Element Type (%s)", Get_StringForDefine(Element_Type, Type_Element)); } case JACOBIAN_SUR : switch (Type_Element) { case POINT : *Type_Dimension = _1D ; return((void *)JacobianVol0D) ; case LINE : case LINE_2 : *Type_Dimension = _2D ; return((void *)JacobianSur2D) ; case TRIANGLE : case TRIANGLE_2 : case QUADRANGLE : case QUADRANGLE_2 : case QUADRANGLE_2_8N : *Type_Dimension = _3D ; return((void *)JacobianSur3D) ; default : Message::Error("Unknown Jacobian Sur for element Type (%s)", Get_StringForDefine(Element_Type, Type_Element)); } case JACOBIAN_SUR_SPH_SHELL : switch (Type_Element) { case LINE : case LINE_2 : *Type_Dimension = _2D ; return((void *)JacobianSurSphShell2D) ; default : Message::Error("Unknown Jacobian SurSphShell for element Type (%s)", Get_StringForDefine(Element_Type, Type_Element)); } case JACOBIAN_SUR_AXI : switch (Type_Element) { case LINE : case LINE_2 : *Type_Dimension = _2D ; return((void *)JacobianSurAxi2D) ; // for integrals on surfaces in the study plane in axisymm. problems // e.g. the computation of the area of a region case TRIANGLE : case TRIANGLE_2 : case QUADRANGLE : case QUADRANGLE_2 : case QUADRANGLE_2_8N : *Type_Dimension = _2D ; return((void *)JacobianVol2D) ; default : Message::Error("Unknown Jacobian SurAxi for Element Type (%s)", Get_StringForDefine(Element_Type, Type_Element)); } case JACOBIAN_LIN : switch (Type_Element) { case POINT : *Type_Dimension = _2D ; return((void *)JacobianVol0D) ; case LINE : case LINE_2 : *Type_Dimension = _3D ; return((void *)JacobianLin3D) ; default : Message::Error("Unknown Jacobian Lin for Element Type (%s)", Get_StringForDefine(Element_Type, Type_Element)); } default : Message::Error("Unknown Jacobian"); return(NULL) ; } } /* ------------------------------------------------------------------------ */ /* G e t _ J a c o b i a n F u n c t i o n A u t o */ /* ------------------------------------------------------------------------ */ void * Get_JacobianFunctionAuto (int Type_Element, int Dimension) { switch(Type_Element){ case POINT : return((void *)JacobianVol0D) ; case LINE : case LINE_2 : switch(Dimension){ case _3D : return((void *)JacobianLin3D) ; case _2D : return((void *)JacobianSur2D) ; default : return((void *)JacobianVol1D) ; } case TRIANGLE : case TRIANGLE_2 : case QUADRANGLE : case QUADRANGLE_2 : case QUADRANGLE_2_8N : switch(Dimension){ case _3D : return((void *)JacobianSur3D) ; default : return((void *)JacobianVol2D) ; } case TETRAHEDRON : case TETRAHEDRON_2 : case HEXAHEDRON : case HEXAHEDRON_2 : case PRISM : case PRISM_2 : case PYRAMID : case PYRAMID_2 : default: return((void *)JacobianVol3D) ; } } /* ------------------------------------------------------------------------ */ /* G e t _ I n t e g r a t i o n F u n c t i o n A u t o */ /* ------------------------------------------------------------------------ */ void * Get_IntegrationFunctionAuto (int Type_Element, int Order, int *NumPoints) { // TODO : compute correct number of points switch(Type_Element){ case POINT : *NumPoints = 1; return ((void *)Gauss_Point) ; case LINE : case LINE_2 : *NumPoints = 3; return ((void *)Gauss_Line) ; case TRIANGLE : case TRIANGLE_2 : *NumPoints = 6; return ((void*)Gauss_Triangle) ; case QUADRANGLE : case QUADRANGLE_2 : case QUADRANGLE_2_8N : *NumPoints = 7; return ((void*)Gauss_Quadrangle) ; case TETRAHEDRON : case TETRAHEDRON_2 : *NumPoints = 15; return ((void*)Gauss_Tetrahedron) ; case HEXAHEDRON : case HEXAHEDRON_2 : *NumPoints = 34; return ((void*)Gauss_Hexahedron) ; case PRISM : case PRISM_2 : *NumPoints = 21; return ((void*)Gauss_Prism) ; case PYRAMID : case PYRAMID_2 : *NumPoints = 8; return ((void*)Gauss_Pyramid) ; default: Message::Error("Unknown type of element for integration function"); return 0; } } /* ------------------------------------------------------------------------ */ /* G e o m e t r i c a l T r a n s f o r m a t i o n s */ /* ------------------------------------------------------------------------ */ double PlpdX2D (struct Element * Element, MATRIX3x3 * Jac) { int i ; double CoorX, CoorY, A, B, R, theta, f ; double DetJac ; CoorX = CoorY = 0. ; for (i = 0 ; i < Element->GeoElement->NbrNodes ; i++) { CoorX += Element->x[i] * Element->n[i] ; CoorY += Element->y[i] * Element->n[i] ; } A = Element->JacobianCase->Para[0] ; B = Element->JacobianCase->Para[1] ; R = CoorX ; if ( (R > B+1.e-12*B) || (R < A-1.e-12*A) ) Message::Error("Bad parameters for unidirectional transformation Jacobian: " "Rint=%g, Rext=%g, R=%g", A, B, R) ; if (B == R) { Jac->c11 = 1. ; Jac->c12 = 0. ; Jac->c21 = 0. ; Jac->c22 = 1. ; return(1.) ; } f = (A*(B-A)) / (R*(B-R)) ; theta = (B-2.*R) / (B-R) ; Jac->c11 = f * (1.- theta) ; Jac->c12 = 0. ; Jac->c21 = 0. ; Jac->c22 = 1. ; DetJac = f*( 1.-theta) ; return(DetJac) ; } double power(double x, double y) { if (y == 1.0) return (x); else if (y == 2.0) return (x*x); else if (y == 0.5) return (sqrt(x)); else return (pow(x,y)); } double Transformation (int Dim, int Type, struct Element * Element, MATRIX3x3 * Jac) { int i, Axis = 0 ; double X = 0., Y = 0., Z = 0. ; double p = 1., L= 0. ; double Cx = 0., Cy = 0., Cz = 0., A = 0., B = 0., R = 0. ; double theta, XR, YR, ZR, f, dRdx = 0., dRdy = 0., dRdz = 0. ; double DetJac ; /* A = interior radius B = exterior radius Cx, Cy, Cz = coord of centre Axis = direction of the transformation p = exponant 1/L = f(B) */ for (i = 0 ; i < Element->GeoElement->NbrNodes ; i++) { X += Element->x[i] * Element->n[i] ; Y += Element->y[i] * Element->n[i] ; Z += Element->z[i] * Element->n[i] ; } if(Element->JacobianCase->NbrParameters >= 2){ A = Element->JacobianCase->Para[0] ; B = Element->JacobianCase->Para[1] ; } else Message::Error("Missing interior and/or exterior radius for transformation Jacobian"); if(Type == JACOBIAN_RECT){ if(Element->JacobianCase->NbrParameters >= 3) Axis = (int)Element->JacobianCase->Para[2] ; if(Element->JacobianCase->NbrParameters >= 4) Cx = Element->JacobianCase->Para[3] ; if(Element->JacobianCase->NbrParameters >= 5) Cy = Element->JacobianCase->Para[4] ; if(Element->JacobianCase->NbrParameters >= 6) Cz = Element->JacobianCase->Para[5] ; if(Element->JacobianCase->NbrParameters >= 7) p = Element->JacobianCase->Para[6] ; if(Element->JacobianCase->NbrParameters >= 8) L = Element->JacobianCase->Para[7] ; if(Element->JacobianCase->NbrParameters >= 9){ Message::Error("Too many parameters for rectangular transformation Jacobian. " "Valid parameters: Dist1 Dist2 Axis CenterX CenterY CenterZ Power 1/Infinity"); } } else if(Type == JACOBIAN_SPH){ if(Element->JacobianCase->NbrParameters >= 3) Cx = Element->JacobianCase->Para[2] ; if(Element->JacobianCase->NbrParameters >= 4) Cy = Element->JacobianCase->Para[3] ; if(Element->JacobianCase->NbrParameters >= 5) Cz = Element->JacobianCase->Para[4] ; if(Element->JacobianCase->NbrParameters >= 6) p = Element->JacobianCase->Para[5] ; if(Element->JacobianCase->NbrParameters >= 7) L = Element->JacobianCase->Para[6] ; if(Element->JacobianCase->NbrParameters >= 8){ Message::Error("Too many parameters for spherical transformation Jacobian. " "Valid parameters: Radius1 Radius2 CenterX CenterY CenterZ Power 1/Infinity"); } } else Message::Error("Unknown type of transformation Jacobian"); if(L) B = (B*B-A*A*L)/(B-A*L); if(Type == JACOBIAN_SPH){ R = sqrt( SQU(X-Cx) + SQU(Y-Cy) + SQU(Z-Cz) ) ; dRdx = (X-Cx)/R ; dRdy = (Y-Cy)/R ; dRdz = (Z-Cz)/R ; } else{ switch(Axis) { case 1: R = fabs(X-Cx) ; dRdx =THESIGN(X-Cx) ; dRdy =0.0 ; dRdz =0.0 ; break; case 2: R = fabs(Y-Cy) ; dRdx =0.0 ; dRdy =THESIGN(Y-Cy) ; dRdz =0.0 ; break; case 3: R = fabs(Z-Cz) ; dRdx =0.0 ; dRdy =0.0 ; dRdz =THESIGN(Z-Cz) ; break; default: Message::Error("Bad axis specification: 1 for X, 2 for Y and 3 for Z"); } } if ( (fabs(R) > fabs(B) + 1.e-2*fabs(B)) || (fabs(R) < fabs(A) - 1.e-2*fabs(A)) ) Message::Error("Bad parameters for transformation Jacobian: %g not in [%g,%g]", R, A, B) ; if (B == R) { Jac->c11 = 1. ; Jac->c12 = 0. ; Jac->c13 = 0. ; Jac->c21 = 0. ; Jac->c22 = 1. ; Jac->c23 = 0. ; Jac->c31 = 0. ; Jac->c32 = 0. ; Jac->c33 = 1. ; return(1.) ; } f = power((A*(B-A))/(R*(B-R)), p) ; theta = p * (B-2.*R) / (B-R) ; XR = (X-Cx)/R ; YR = (Y-Cy)/R ; ZR = (Z-Cz)/R ; Jac->c11 = f * (1.0 - theta * XR * dRdx) ; Jac->c12 = f * ( - theta * XR * dRdy) ; Jac->c13 = f * ( - theta * XR * dRdz) ; Jac->c21 = f * ( - theta * YR * dRdx) ; Jac->c22 = f * (1.0 - theta * YR * dRdy) ; Jac->c23 = f * ( - theta * YR * dRdz) ; Jac->c31 = f * ( - theta * ZR * dRdx) ; Jac->c32 = f * ( - theta * ZR * dRdy) ; Jac->c33 = f * (1.0 - theta * ZR * dRdz) ; switch (Dim) { case _2D : Jac->c33 = 1. ; DetJac = f * f * (1.0 - theta) ; /* DetJac = Jac->c11 * Jac->c22 - Jac->c12 * Jac->c21; */ break; case _AXI : DetJac = f * f * f * (1.0 - theta) ; break; default : DetJac = f * f * f * (1.0 - theta); /* DetJac = Jac->c11 * (Jac->c22 * Jac->c33 - Jac->c23*Jac->c32) - Jac->c12 * (Jac->c21 * Jac->c33 - Jac->c23*Jac->c31) + Jac->c13 * (Jac->c21 * Jac->c32 - Jac->c22*Jac->c31); */ break ; } return(DetJac) ; } /* ------------------------------------------------------------------------ */ /* J a c o b i a n V o l */ /* ------------------------------------------------------------------------ */ /* 0D */ double JacobianVol0D (struct Element * Element, MATRIX3x3 * Jac) { Jac->c11 = 1. ; Jac->c12 = 0. ; Jac->c13 = 0. ; Jac->c21 = 0. ; Jac->c22 = 1. ; Jac->c23 = 0. ; Jac->c31 = 0. ; Jac->c32 = 0. ; Jac->c33 = 1. ; return(1.) ; } /* 1D */ double JacobianVol1D (struct Element * Element, MATRIX3x3 * Jac) { int i ; double DetJac ; Jac->c11 = 0. ; Jac->c12 = 0. ; Jac->c13 = 0. ; Jac->c21 = 0. ; Jac->c22 = 1. ; Jac->c23 = 0. ; Jac->c31 = 0. ; Jac->c32 = 0. ; Jac->c33 = 1. ; for ( i = 0 ; i < Element->GeoElement->NbrNodes ; i++ ) { Jac->c11 += Element->x[i] * Element->dndu[i][0] ; } DetJac = Jac->c11 ; return(DetJac) ; } /* 2D */ double JacobianVol2D (struct Element * Element, MATRIX3x3 * Jac) { int i ; double DetJac ; Jac->c11 = 0. ; Jac->c12 = 0. ; Jac->c13 = 0. ; Jac->c21 = 0. ; Jac->c22 = 0. ; Jac->c23 = 0. ; Jac->c31 = 0. ; Jac->c32 = 0. ; Jac->c33 = 1. ; for ( i = 0 ; i < Element->GeoElement->NbrNodes ; i++ ) { Jac->c11 += Element->x[i] * Element->dndu[i][0] ; Jac->c21 += Element->x[i] * Element->dndu[i][1] ; Jac->c12 += Element->y[i] * Element->dndu[i][0] ; Jac->c22 += Element->y[i] * Element->dndu[i][1] ; } DetJac = Jac->c11 * Jac->c22 - Jac->c12 * Jac->c21 ; return(DetJac) ; } double JacobianVolSphShell2D (struct Element * Element, MATRIX3x3 * Jac) { MATRIX3x3 Jac1, Jac2 ; double DetJac1, DetJac2 ; DetJac1 = JacobianVol2D (Element, &Jac1) ; DetJac2 = Transformation(_2D, JACOBIAN_SPH, Element, &Jac2) ; Get_ProductMatrix( _2D, &Jac1, &Jac2, Jac) ; Jac->c13 = 0. ; Jac->c23 = 0. ; Jac->c31 = 0. ; Jac->c32 = 0. ; Jac->c33 = 1. ; return(DetJac1 * DetJac2) ; } double JacobianVolRectShell2D (struct Element * Element, MATRIX3x3 * Jac) { MATRIX3x3 Jac1, Jac2 ; double DetJac1, DetJac2 ; DetJac1 = JacobianVol2D (Element, &Jac1) ; DetJac2 = Transformation (_2D, JACOBIAN_RECT, Element, &Jac2) ; Get_ProductMatrix( _2D, &Jac1, &Jac2, Jac) ; Jac->c13 = 0. ; Jac->c23 = 0. ; Jac->c31 = 0. ; Jac->c32 = 0. ; Jac->c33 = 1. ; return(DetJac1 * DetJac2) ; } double JacobianVolPlpdX2D (struct Element * Element, MATRIX3x3 * Jac) { MATRIX3x3 Jac1, Jac2 ; double DetJac1, DetJac2 ; DetJac1 = JacobianVol2D (Element, &Jac1) ; DetJac2 = PlpdX2D (Element, &Jac2) ; Get_ProductMatrix( _2D, &Jac1, &Jac2, Jac) ; Jac->c13 = 0. ; Jac->c23 = 0. ; Jac->c31 = 0. ; Jac->c32 = 0. ; Jac->c33 = 1. ; return(DetJac1 * DetJac2) ; } /* 1D & 2D Axi (Attention, l'axe doit etre x=z=0) */ double JacobianVolAxi1D (struct Element * Element, MATRIX3x3 * Jac) { int i ; double s = 0., DetJac ; DetJac = JacobianVol1D(Element, Jac) ; for (i = 0 ; i < Element->GeoElement->NbrNodes ; i++) s += Element->x[i] * Element->n[i] ; /* Warning! For evaluations on the symmetry axis */ if (s==0.0) { for (i = 0 ; i < Element->GeoElement->NbrNodes ; i++) s += Element->x[i] ; s /= (double)Element->GeoElement->NbrNodes ; } Jac->c33 = s ; return(DetJac * Jac->c33) ; } double JacobianVolAxi2D (struct Element * Element, MATRIX3x3 * Jac) { int i ; double s = 0., DetJac ; DetJac = JacobianVol2D(Element, Jac) ; for (i = 0 ; i < Element->GeoElement->NbrNodes ; i++) s += Element->x[i] * Element->n[i] ; /* Warning! For evaluations on the symmetry axis */ if (s==0.0) { for (i = 0 ; i < Element->GeoElement->NbrNodes ; i++) s += Element->x[i] ; s /= (double)Element->GeoElement->NbrNodes ; } Jac->c33 = s ; return(DetJac * Jac->c33) ; } double JacobianVolAxiSphShell2D (struct Element * Element, MATRIX3x3 * Jac) { MATRIX3x3 Jac1, Jac2 ; double DetJac1, DetJac2 ; DetJac1 = JacobianVolAxi2D (Element, &Jac1) ; DetJac2 = Transformation (_AXI, JACOBIAN_SPH, Element, &Jac2) ; Get_ProductMatrix( _2D, &Jac1, &Jac2, Jac) ; Jac->c13 = 0. ; Jac->c23 = 0. ; Jac->c31 = 0. ; Jac->c32 = 0. ; Jac->c33 = Jac1.c33 * Jac2.c33 ; return(DetJac1 * DetJac2) ; } double JacobianVolAxiRectShell2D (struct Element * Element, MATRIX3x3 * Jac) { MATRIX3x3 Jac1, Jac2 ; double DetJac1, DetJac2 ; DetJac1 = JacobianVolAxi2D (Element, &Jac1) ; DetJac2 = Transformation (_AXI, JACOBIAN_RECT, Element, &Jac2) ; Get_ProductMatrix( _2D, &Jac1, &Jac2, Jac) ; Jac->c13 = 0. ; Jac->c23 = 0. ; Jac->c31 = 0. ; Jac->c32 = 0. ; Jac->c33 = Jac1.c33 * Jac2.c33 ; return(DetJac1 * DetJac2) ; } double JacobianVolAxiPlpdX2D (struct Element * Element, MATRIX3x3 * Jac) { MATRIX3x3 Jac1, Jac2 ; double DetJac1, DetJac2 ; DetJac1 = JacobianVolAxi2D (Element, &Jac1) ; DetJac2 = PlpdX2D (Element, &Jac2) ; Get_ProductMatrix( _2D, &Jac1, &Jac2, Jac) ; Jac->c13 = 0. ; Jac->c23 = 0. ; Jac->c31 = 0. ; Jac->c32 = 0. ; Jac->c33 = Jac1.c33 ; return(DetJac1 * DetJac2) ; } /* 1D & 2D Axi avec transformation quadratique (Attention, l'axe doit etre x=z=0) */ double JacobianVolAxiSqu1D (struct Element * Element, MATRIX3x3 * Jac) { int i ; double s = 0., r, DetJac ; Jac->c11 = 0. ; Jac->c12 = 0. ; Jac->c13 = 0. ; Jac->c21 = 0. ; Jac->c22 = 1. ; Jac->c23 = 0. ; Jac->c31 = 0. ; Jac->c32 = 0. ; Jac->c33 = 1. ; for (i = 0 ; i < Element->GeoElement->NbrNodes ; i++) s += SQU(Element->x[i]) * Element->n[i] ; /* Warning! For evaluations on the symmetry axis */ if (s==0.0) { for (i = 0 ; i < Element->GeoElement->NbrNodes ; i++) s += Element->x[i] * Element->x[i] ; s /= (double)Element->GeoElement->NbrNodes ; } r = sqrt(s); for ( i = 0 ; i < Element->GeoElement->NbrNodes ; i++ ) { Jac->c11 += 0.5/r * SQU(Element->x[i]) * Element->dndu[i][0] ; } Jac->c33 = r ; DetJac = Jac->c11 * Jac->c33 ; return(DetJac) ; } double JacobianVolAxiSqu2D (struct Element * Element, MATRIX3x3 * Jac) { int i ; double s = 0., r, DetJac ; Jac->c11 = 0. ; Jac->c12 = 0. ; Jac->c13 = 0. ; Jac->c21 = 0. ; Jac->c22 = 0. ; Jac->c23 = 0. ; Jac->c31 = 0. ; Jac->c32 = 0. ; Jac->c33 = 1. ; for (i = 0 ; i < Element->GeoElement->NbrNodes ; i++) s += SQU(Element->x[i]) * Element->n[i] ; /* Warning! For evaluations on the symmetry axis */ if (s==0.0) { for (i = 0 ; i < Element->GeoElement->NbrNodes ; i++) s += Element->x[i] * Element->x[i] ; s /= (double)Element->GeoElement->NbrNodes ; } r = sqrt(s); for ( i = 0 ; i < Element->GeoElement->NbrNodes ; i++ ) { Jac->c11 += 0.5/r * SQU(Element->x[i]) * Element->dndu[i][0] ; Jac->c21 += 0.5/r * SQU(Element->x[i]) * Element->dndu[i][1] ; Jac->c12 += Element->y[i] * Element->dndu[i][0] ; Jac->c22 += Element->y[i] * Element->dndu[i][1] ; } Jac->c33 = r ; DetJac = (Jac->c11 * Jac->c22 - Jac->c12 * Jac->c21) * Jac->c33 ; return(DetJac) ; } double JacobianVolAxiSquSphShell2D (struct Element * Element, MATRIX3x3 * Jac) { MATRIX3x3 Jac1, Jac2 ; double DetJac1, DetJac2 ; DetJac1 = JacobianVolAxiSqu2D(Element, &Jac1) ; DetJac2 = Transformation (_AXI, JACOBIAN_SPH, Element, &Jac2) ; Get_ProductMatrix( _2D, &Jac1, &Jac2, Jac) ; Jac->c13 = 0. ; Jac->c23 = 0. ; Jac->c31 = 0. ; Jac->c32 = 0. ; Jac->c33 = Jac1.c33 * Jac2.c33 ; return(DetJac1 * DetJac2) ; } double JacobianVolAxiSquRectShell2D (struct Element * Element, MATRIX3x3 * Jac) { MATRIX3x3 Jac1, Jac2 ; double DetJac1, DetJac2 ; DetJac1 = JacobianVolAxiSqu2D(Element, &Jac1) ; DetJac2 = Transformation (_AXI, JACOBIAN_RECT, Element, &Jac2) ; Get_ProductMatrix( _2D, &Jac1, &Jac2, Jac) ; Jac->c13 = 0. ; Jac->c23 = 0. ; Jac->c31 = 0. ; Jac->c32 = 0. ; Jac->c33 = Jac1.c33 * Jac2.c33 ; return(DetJac1 * DetJac2) ; } /* 3D */ double JacobianVol3D (struct Element * Element, MATRIX3x3 * Jac) { int i ; double DetJac ; Jac->c11 = 0. ; Jac->c12 = 0. ; Jac->c13 = 0. ; Jac->c21 = 0. ; Jac->c22 = 0. ; Jac->c23 = 0. ; Jac->c31 = 0. ; Jac->c32 = 0. ; Jac->c33 = 0. ; for ( i = 0 ; i < Element->GeoElement->NbrNodes ; i++ ) { Jac->c11 += Element->x[i] * Element->dndu[i][0] ; Jac->c21 += Element->x[i] * Element->dndu[i][1] ; Jac->c31 += Element->x[i] * Element->dndu[i][2] ; Jac->c12 += Element->y[i] * Element->dndu[i][0] ; Jac->c22 += Element->y[i] * Element->dndu[i][1] ; Jac->c32 += Element->y[i] * Element->dndu[i][2] ; Jac->c13 += Element->z[i] * Element->dndu[i][0] ; Jac->c23 += Element->z[i] * Element->dndu[i][1] ; Jac->c33 += Element->z[i] * Element->dndu[i][2] ; } DetJac = Jac->c11 * Jac->c22 * Jac->c33 + Jac->c13 * Jac->c21 * Jac->c32 + Jac->c12 * Jac->c23 * Jac->c31 - Jac->c13 * Jac->c22 * Jac->c31 - Jac->c11 * Jac->c23 * Jac->c32 - Jac->c12 * Jac->c21 * Jac->c33 ; return(DetJac) ; } double JacobianVolSphShell3D (struct Element * Element, MATRIX3x3 * Jac) { MATRIX3x3 Jac1, Jac2 ; double DetJac1, DetJac2 ; DetJac1 = JacobianVol3D (Element, &Jac1) ; DetJac2 = Transformation(_3D, JACOBIAN_SPH, Element, &Jac2) ; Get_ProductMatrix( _3D, &Jac1, &Jac2, Jac) ; return(DetJac1 * DetJac2) ; } double JacobianVolRectShell3D (struct Element * Element, MATRIX3x3 * Jac) { MATRIX3x3 Jac1, Jac2 ; double DetJac1, DetJac2 ; DetJac1 = JacobianVol3D (Element, &Jac1) ; DetJac2 = Transformation (_3D, JACOBIAN_RECT, Element, &Jac2) ; Get_ProductMatrix( _3D, &Jac1, &Jac2, Jac) ; return(DetJac1 * DetJac2) ; } /* ------------------------------------------------------------------------ */ /* J a c o b i a n S u r */ /* ------------------------------------------------------------------------ */ void prodve(double a[3], double b[3], double c[3]) { c[2] = a[0] * b[1] - a[1] * b[0]; c[1] = -a[0] * b[2] + a[2] * b[0]; c[0] = a[1] * b[2] - a[2] * b[1]; } void prosca(double a[3], double b[3], double *c) { *c = a[0] * b[0] + a[1] * b[1] + a[2] * b[2]; } double norm3(double a[3]) { return sqrt(a[0] * a[0] + a[1] * a[1] + a[2] * a[2]); } double norme(double a[3]) { const double mod = norm3(a); if(mod != 0.0){ const double one_over_mod = 1./mod; a[0] *= one_over_mod; a[1] *= one_over_mod; a[2] *= one_over_mod; } return mod; } double JacobianSur2D (struct Element * Element, MATRIX3x3 * Jac) { int i ; double DetJac ; Jac->c11 = 0. ; Jac->c12 = 0. ; Jac->c13 = 0. ; Jac->c21 = 0. ; Jac->c22 = 0. ; Jac->c23 = 0. ; Jac->c31 = 0. ; Jac->c32 = 0. ; Jac->c33 = 1. ; for ( i = 0 ; i < Element->GeoElement->NbrNodes ; i++ ) { Jac->c11 += Element->x[i] * Element->dndu[i][0] ; Jac->c12 += Element->y[i] * Element->dndu[i][0] ; } DetJac = HYPOT(Jac->c11, Jac->c12) ; // regularize matrix double b[3] = {Jac->c12, -Jac->c11, 0.}; norme(b); Jac->c21 = b[0]; Jac->c22 = b[1]; // make sure DetJac > 0: this is not necessary in theory, but it is // required here because we use DetJac when we invert the matrix double realDetJac = Jac->c11 * Jac->c22 - Jac->c12 * Jac->c21; if(realDetJac < 0.){ Jac->c21 = - Jac->c21; Jac->c22 = - Jac->c22; } return(DetJac) ; } double JacobianSurSphShell2D (struct Element * Element, MATRIX3x3 * Jac) { MATRIX3x3 Jac1, Jac2 ; double DetJac1, DetJac2 ; DetJac1 = JacobianSur2D(Element, &Jac1) ; DetJac2 = Transformation(_2D, JACOBIAN_SPH, Element, &Jac2) ; Get_ProductMatrix(_3D, &Jac1, &Jac2, Jac) ; return(DetJac1 * DetJac2) ; } double JacobianSurRectShell2D (struct Element * Element, MATRIX3x3 * Jac) { MATRIX3x3 Jac1, Jac2 ; double DetJac1, DetJac2 ; DetJac1 = JacobianSur2D(Element, &Jac1) ; DetJac2 = Transformation(_2D, JACOBIAN_RECT, Element, &Jac2) ; Get_ProductMatrix( _3D, &Jac1, &Jac2, Jac) ; return(DetJac1 * DetJac2) ; } double JacobianSurAxi2D (struct Element * Element, MATRIX3x3 * Jac) { int i ; double DetJac ; DetJac = JacobianSur2D(Element, Jac) ; Jac->c33 = 0. ; for (i = 0 ; i < Element->GeoElement->NbrNodes ; i++) Jac->c33 += Element->x[i] * Element->n[i] ; return(DetJac * Jac->c33) ; } double JacobianSur3D (struct Element * Element, MATRIX3x3 * Jac) { int i ; double DetJac ; Jac->c11 = 0. ; Jac->c12 = 0. ; Jac->c13 = 0. ; Jac->c21 = 0. ; Jac->c22 = 0. ; Jac->c23 = 0. ; Jac->c31 = 0. ; Jac->c32 = 0. ; Jac->c33 = 0. ; for ( i = 0 ; i < Element->GeoElement->NbrNodes ; i++ ) { Jac->c11 += Element->x[i] * Element->dndu[i][0] ; Jac->c21 += Element->x[i] * Element->dndu[i][1] ; Jac->c12 += Element->y[i] * Element->dndu[i][0] ; Jac->c22 += Element->y[i] * Element->dndu[i][1] ; Jac->c13 += Element->z[i] * Element->dndu[i][0] ; Jac->c23 += Element->z[i] * Element->dndu[i][1] ; } DetJac = sqrt( SQU(Jac->c11 * Jac->c22 - Jac->c12 * Jac->c21) + SQU(Jac->c13 * Jac->c21 - Jac->c11 * Jac->c23) + SQU(Jac->c12 * Jac->c23 - Jac->c13 * Jac->c22) ) ; // regularize matrix double a[3] = {Jac->c11, Jac->c12, Jac->c13}; double b[3] = {Jac->c21, Jac->c22, Jac->c23}; double c[3]; prodve(a, b, c); norme(c); Jac->c31 = c[0]; Jac->c32 = c[1]; Jac->c33 = c[2]; // make sure DetJac > 0: this is not necessary in theory, but it is // required here because we use DetJac when we invert the matrix double realDetJac = Jac->c11 * Jac->c22 * Jac->c33 + Jac->c13 * Jac->c21 * Jac->c32 + Jac->c12 * Jac->c23 * Jac->c31 - Jac->c13 * Jac->c22 * Jac->c31 - Jac->c11 * Jac->c23 * Jac->c32 - Jac->c12 * Jac->c21 * Jac->c33; if(realDetJac < 0.){ Jac->c31 = - Jac->c31; Jac->c32 = - Jac->c32; Jac->c33 = - Jac->c33; } return(DetJac) ; } /* ------------------------------------------------------------------------ */ /* J a c o b i a n L i n */ /* ------------------------------------------------------------------------ */ double JacobianLin3D (struct Element * Element, MATRIX3x3 * Jac) { int i ; double DetJac ; Jac->c11 = 0. ; Jac->c12 = 0. ; Jac->c13 = 0. ; Jac->c21 = 0. ; Jac->c22 = 0. ; Jac->c23 = 0. ; Jac->c31 = 0. ; Jac->c32 = 0. ; Jac->c33 = 0. ; for ( i = 0 ; i < Element->GeoElement->NbrNodes ; i++ ) { Jac->c11 += Element->x[i] * Element->dndu[i][0] ; Jac->c12 += Element->y[i] * Element->dndu[i][0] ; Jac->c13 += Element->z[i] * Element->dndu[i][0] ; } DetJac = sqrt(SQU(Jac->c11)+SQU(Jac->c12)+SQU(Jac->c13)) ; // regularize matrix double a[3] = {Jac->c11, Jac->c12, Jac->c13}; double b[3]; if((fabs(a[0]) >= fabs(a[1]) && fabs(a[0]) >= fabs(a[2])) || (fabs(a[1]) >= fabs(a[0]) && fabs(a[1]) >= fabs(a[2]))) { b[0] = a[1]; b[1] = -a[0]; b[2] = 0.; } else { b[0] = 0.; b[1] = a[2]; b[2] = -a[1]; } norme(b); double c[3]; prodve(a, b, c); norme(c); Jac->c21 = b[0]; Jac->c22 = b[1]; Jac->c23 = b[2]; Jac->c31 = c[0]; Jac->c32 = c[1]; Jac->c33 = c[2]; // make sure DetJac > 0: this is not necessary in theory, but it is // required here because we use DetJac when we invert the matrix double realDetJac = Jac->c11 * Jac->c22 * Jac->c33 + Jac->c13 * Jac->c21 * Jac->c32 + Jac->c12 * Jac->c23 * Jac->c31 - Jac->c13 * Jac->c22 * Jac->c31 - Jac->c11 * Jac->c23 * Jac->c32 - Jac->c12 * Jac->c21 * Jac->c33; if(realDetJac < 0.){ Jac->c31 = - Jac->c31; Jac->c32 = - Jac->c32; Jac->c33 = - Jac->c33; } return(DetJac) ; } /* ------------------------------------------------------------------------ */ /* G e t _ I n v e r s e M a t r i x */ /* ------------------------------------------------------------------------ */ void Get_InverseMatrix(int Type_Dimension, int Type_Element, double DetMat, MATRIX3x3 * Mat, MATRIX3x3 * InvMat) { switch (Type_Dimension) { case _0D : InvMat->c11 = InvMat->c22 = InvMat->c33 = 1. ; InvMat->c12 = InvMat->c21 = 0. ; InvMat->c13 = InvMat->c31 = 0. ; InvMat->c23 = InvMat->c32 = 0. ; break ; case _1D : InvMat->c11 = 1. / Mat->c11 ; InvMat->c22 = 1. / Mat->c22 ; InvMat->c33 = 1. / Mat->c33 ; InvMat->c12 = InvMat->c21 = 0. ; InvMat->c13 = InvMat->c31 = 0. ; InvMat->c23 = InvMat->c32 = 0. ; break ; case _2D : if(!DetMat) Message::Error("Null determinant in 'Get_InverseMatrix' (%d)", Type_Dimension); InvMat->c11 = Mat->c22 * Mat->c33 / DetMat ; InvMat->c21 = - Mat->c21 * Mat->c33 / DetMat ; InvMat->c12 = - Mat->c12 * Mat->c33 / DetMat ; InvMat->c22 = Mat->c11 * Mat->c33 / DetMat ; InvMat->c13 = InvMat->c23 = InvMat->c31 = InvMat->c32 = 0. ; InvMat->c33 = 1. / Mat->c33 ; break; case _3D : if(!DetMat) Message::Error("Null determinant in 'Get_InverseMatrix' (%d)", Type_Dimension); InvMat->c11 = ( Mat->c22 * Mat->c33 - Mat->c23 * Mat->c32 ) / DetMat ; InvMat->c21 = -( Mat->c21 * Mat->c33 - Mat->c23 * Mat->c31 ) / DetMat ; InvMat->c31 = ( Mat->c21 * Mat->c32 - Mat->c22 * Mat->c31 ) / DetMat ; InvMat->c12 = -( Mat->c12 * Mat->c33 - Mat->c13 * Mat->c32 ) / DetMat ; InvMat->c22 = ( Mat->c11 * Mat->c33 - Mat->c13 * Mat->c31 ) / DetMat ; InvMat->c32 = -( Mat->c11 * Mat->c32 - Mat->c12 * Mat->c31 ) / DetMat ; InvMat->c13 = ( Mat->c12 * Mat->c23 - Mat->c13 * Mat->c22 ) / DetMat ; InvMat->c23 = -( Mat->c11 * Mat->c23 - Mat->c13 * Mat->c21 ) / DetMat ; InvMat->c33 = ( Mat->c11 * Mat->c22 - Mat->c12 * Mat->c21 ) / DetMat ; break; default : Message::Error("Wrong dimension in 'Get_InverseMatrix'"); break ; } } /* ------------------------------------------------------------------------ */ /* G e t _ P r o d u c t M a t r i x */ /* ------------------------------------------------------------------------ */ void Get_ProductMatrix(int Type_Dimension, MATRIX3x3 * A, MATRIX3x3 * B, MATRIX3x3 * AB) { switch (Type_Dimension) { case _2D : AB->c11 = A->c11 * B->c11 + A->c12 * B->c21 ; AB->c12 = A->c11 * B->c12 + A->c12 * B->c22 ; AB->c21 = A->c21 * B->c11 + A->c22 * B->c21 ; AB->c22 = A->c21 * B->c12 + A->c22 * B->c22 ; break ; case _3D : AB->c11 = A->c11 * B->c11 + A->c12 * B->c21 + A->c13 * B->c31 ; AB->c12 = A->c11 * B->c12 + A->c12 * B->c22 + A->c13 * B->c32 ; AB->c13 = A->c11 * B->c13 + A->c12 * B->c23 + A->c13 * B->c33 ; AB->c21 = A->c21 * B->c11 + A->c22 * B->c21 + A->c23 * B->c31 ; AB->c22 = A->c21 * B->c12 + A->c22 * B->c22 + A->c23 * B->c32 ; AB->c23 = A->c21 * B->c13 + A->c22 * B->c23 + A->c23 * B->c33 ; AB->c31 = A->c31 * B->c11 + A->c32 * B->c21 + A->c33 * B->c31 ; AB->c32 = A->c31 * B->c12 + A->c32 * B->c22 + A->c33 * B->c32 ; AB->c33 = A->c31 * B->c13 + A->c32 * B->c23 + A->c33 * B->c33 ; break ; } } /* ------------------------------------------------------------------------ */ /* G e t _ C h a n g e O f C o o r d i n a t e s */ /* ------------------------------------------------------------------------ */ void *Get_ChangeOfCoordinates(int Flag_ChangeCoord, int Type_Form) { switch (Type_Form) { case SCALAR : case FORM0 : return((void *)ChangeOfCoord_No1) ; case FORM1 : return((Flag_ChangeCoord) ? (void *)ChangeOfCoord_Form1 : (void *)ChangeOfCoord_No123) ; case FORM2 : return((Flag_ChangeCoord) ? (void *)ChangeOfCoord_Form2 : (void *)ChangeOfCoord_No123) ; case FORM3 : case FORM3P : return((Flag_ChangeCoord) ? (void *)ChangeOfCoord_Form3 : (void *)ChangeOfCoord_No1) ; case FORM1P : return((Flag_ChangeCoord) ? (void *)ChangeOfCoord_Form1P : (void *)ChangeOfCoord_No123) ; case FORM2P : return((Flag_ChangeCoord) ? (void *)ChangeOfCoord_Form2P : (void *)ChangeOfCoord_No123) ; case VECTOR : return((void *)ChangeOfCoord_No123) ; case FORM1S : return((Flag_ChangeCoord) ? (void *)ChangeOfCoord_Form1S : (void *)ChangeOfCoord_No123) ; default : Message::Error("Unknown type of field (%s)", Get_StringForDefine(Field_Type, Type_Form)) ; return(NULL) ; } } /* ------------------------------------------------------------------------ */ /* C h a n g e O f C o o r d _ X X X */ /* ------------------------------------------------------------------------ */ void ChangeOfCoord_No1(struct Element * Element, double vBFu[], double vBFx[]) { vBFx[0] = vBFu[0] ; } void ChangeOfCoord_No123(struct Element * Element, double vBFu[], double vBFx[]) { vBFx[0] = vBFu[0] ; vBFx[1] = vBFu[1] ; vBFx[2] = vBFu[2] ; } void ChangeOfCoord_Form1(struct Element * Element, double vBFu[], double vBFx[]) { vBFx[0] = vBFu[0] * Element->InvJac.c11 + vBFu[1] * Element->InvJac.c12 + vBFu[2] * Element->InvJac.c13 ; vBFx[1] = vBFu[0] * Element->InvJac.c21 + vBFu[1] * Element->InvJac.c22 + vBFu[2] * Element->InvJac.c23 ; vBFx[2] = vBFu[0] * Element->InvJac.c31 + vBFu[1] * Element->InvJac.c32 + vBFu[2] * Element->InvJac.c33 ; } void ChangeOfCoord_Form2(struct Element * Element, double vBFu[], double vBFx[]) { if(!Element->DetJac) Message::Error("Null determinant in 'ChangeOfCoord_Form2'"); vBFx[0] = (vBFu[0] * Element->Jac.c11 + vBFu[1] * Element->Jac.c21 + vBFu[2] * Element->Jac.c31) / Element->DetJac ; vBFx[1] = (vBFu[0] * Element->Jac.c12 + vBFu[1] * Element->Jac.c22 + vBFu[2] * Element->Jac.c32) / Element->DetJac ; vBFx[2] = (vBFu[0] * Element->Jac.c13 + vBFu[1] * Element->Jac.c23 + vBFu[2] * Element->Jac.c33) / Element->DetJac ; } void ChangeOfCoord_Form3(struct Element * Element, double vBFu[], double vBFx[]) { if(!Element->DetJac) Message::Error("Null determinant in 'ChangeOfCoord_Form3'"); vBFx[0] = vBFu[0] / Element->DetJac ; } /* Form1P, 2P, 1S : valid in 2D only ! */ void ChangeOfCoord_Form1P(struct Element * Element, double vBFu[], double vBFx[]) { vBFx[0] = 0. ; vBFx[1] = 0. ; vBFx[2] = vBFu[2] / Element->Jac.c33 ; /* ... * Element->InvJac.c33 */ } void ChangeOfCoord_Form2P(struct Element * Element, double vBFu[], double vBFx[]) { if(!Element->DetJac) Message::Error("Null determinant in 'ChangeOfCoord_Form2P' %d %d %d", Element->Num, Element->Type, Element->Region); vBFx[0] = (vBFu[0] * Element->Jac.c11 + vBFu[1] * Element->Jac.c21) / Element->DetJac ; vBFx[1] = (vBFu[0] * Element->Jac.c12 + vBFu[1] * Element->Jac.c22) / Element->DetJac ; vBFx[2] = 0. ; } void ChangeOfCoord_Form1S(struct Element * Element, double vBFu[], double vBFx[]) { if(!Element->DetJac) Message::Error("Null determinant in 'ChangeOfCoord_Form1S'"); vBFx[0] = 0. ; vBFx[1] = 0. ; vBFx[2] = vBFu[0] / Element->DetJac ; } /* ------------------------------------------------------------------------ */ /* C a l _ P r o d u c t X X X */ /* ------------------------------------------------------------------------ */ double Cal_Product123(double v1[], double v2[]) { return v1[0]*v2[0] + v1[1]*v2[1] + v1[2]*v2[2] ; } double Cal_Product12 (double v1[], double v2[]) { return v1[0]*v2[0] + v1[1]*v2[1] ; } double Cal_Product3 (double v1[], double v2[]) { return v1[2]*v2[2] ; } double Cal_Product1 (double v1[], double v2[]) { return v1[0]*v2[0] ; } getdp-2.7.0-source/Legacy/Cal_IntegralQuantity.cpp000644 001750 001750 00000027614 12473553042 023613 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "ProData.h" #include "ProDefine.h" #include "BF.h" #include "Cal_Quantity.h" #include "Cal_Value.h" #include "Get_Geometry.h" #include "Get_FunctionValue.h" #include "Message.h" extern struct Problem Problem_S ; extern struct CurrentData Current ; /* ----------------------------------------------------------------------------- */ /* C a l _ I n i t I n t e g r a l Q u a n t i t y */ /* ----------------------------------------------------------------------------- */ void Cal_InitIntegralQuantity(struct Element *Element, struct IntegralQuantityActive *IQA, struct QuantityStorage *QuantityStorage_P) { struct Quadrature *Quadrature_P ; int ElementSourceType ; int i,j ; ElementSourceType = Element->ElementSource->Type ; /* Get integration method */ IQA->IntegrationCase_P = Get_IntegrationCase(Element, IQA->IntegrationCase_L, IQA->CriterionIndex); switch(IQA->IntegrationCase_P->Type) { /* Numerical Integration */ case GAUSS : case GAUSSLEGENDRE : Quadrature_P = (struct Quadrature*) List_PQuery(IQA->IntegrationCase_P->Case, &ElementSourceType, fcmp_int) ; if(!Quadrature_P){ Message::Error("Unknown type of Element (%s) for Integration method (%s)", Get_StringForDefine(Element_Type, ElementSourceType), ((struct IntegrationMethod *) List_Pointer(Problem_S.IntegrationMethod, QuantityStorage_P->DefineQuantity->IntegralQuantity. IntegrationMethodIndex))->Name); return; } IQA->Nbr_IntPoints = Quadrature_P->NumberOfPoints ; IQA->Get_IntPoint = Quadrature_P->Function ; IQA->xChangeOfCoordinates = (void (*)())Get_ChangeOfCoordinates(1, IQA->Type_FormDof) ; i = 0 ; while ((i < List_Nbr(IQA->JacobianCase_L)) && ((j = ((struct JacobianCase *)List_Pointer(IQA->JacobianCase_L, i)) ->RegionIndex) >= 0) && !List_Search (((struct Group *)List_Pointer(Problem_S.Group, j)) ->InitialList, &Element->ElementSource->Region, fcmp_int) ) i++ ; if (i == List_Nbr(IQA->JacobianCase_L)){ Message::Error("Undefined Jacobian in Region %d", Element->ElementSource->Region); return; } Element->ElementSource->JacobianCase = (struct JacobianCase*)List_Pointer(IQA->JacobianCase_L, i) ; IQA->Get_Jacobian = (double (*)())Get_JacobianFunction (Element->ElementSource->JacobianCase->TypeJacobian, ElementSourceType, &IQA->Type_Dimension) ; if(QuantityStorage_P->DefineQuantity->IntegralQuantity.Symmetry){ Message::Error("Symmetries of integral kernels not ready with numerical integration"); return; } break; /* Analytical Integration (the jacobian method is not defined, since we also express the basis functions analytically) */ case ANALYTIC : switch(QuantityStorage_P->DefineQuantity->IntegralQuantity.CanonicalWholeQuantity){ case CWQ_GF : case CWQ_GF_PSCA_DOF : case CWQ_GF_PSCA_EXP : case CWQ_GF_PVEC_EXP : case CWQ_EXP_TIME_GF_PSCA_DOF : break ; case CWQ_GF_PVEC_DOF : case CWQ_EXP_TIME_GF_PVEC_DOF : default : Message::Error("Unrecognized Integral Quantity to integrate analytically"); return; } break ; default : Message::Error("Unknown type of Integration method (%s) for Integral Quantity", ((struct IntegrationMethod *) List_Pointer(Problem_S.IntegrationMethod, QuantityStorage_P->DefineQuantity->IntegralQuantity. IntegrationMethodIndex))->Name); return; } IQA->Type_ValueDof = Get_ValueFromForm(IQA->Type_FormDof); } /* ----------------------------------------------------------------------------- */ /* A p p l y _ C o n s t a n t F a c t o r */ /* ----------------------------------------------------------------------------- */ void Apply_ConstantFactor(struct QuantityStorage * QuantityStorage_P, struct Value * vBFxDof, struct Value * Val) { switch(QuantityStorage_P->DefineQuantity->IntegralQuantity.CanonicalWholeQuantity){ case CWQ_GF : case CWQ_GF_PSCA_DOF : case CWQ_GF_PVEC_DOF : case CWQ_DOF_PVEC_GF : break ; case CWQ_GF_PSCA_EXP : case CWQ_EXP_TIME_GF_PSCA_DOF : case CWQ_EXP_TIME_GF_PVEC_DOF : case CWQ_FCT_TIME_GF_PSCA_DOF : case CWQ_FCT_TIME_GF_PVEC_DOF : Cal_ProductValue(Val, vBFxDof, vBFxDof); break; case CWQ_GF_PVEC_EXP : Cal_CrossProductValue(vBFxDof, Val, vBFxDof); break; case CWQ_EXP_PVEC_GF : case CWQ_EXP_PVEC_GF_PSCA_DOF : case CWQ_EXP_PVEC_GF_PVEC_DOF : case CWQ_FCT_PVEC_GF_PSCA_DOF : case CWQ_FCT_PVEC_GF_PVEC_DOF : Cal_CrossProductValue(Val, vBFxDof, vBFxDof); break; default : Message::Error("Unknown type of canonical Integral Quantity"); return; } } /* ------------------------------------------------------------------------------- */ /* C a l _ N u m e r i c a l I n t e g r a l Q u a n t i t y */ /* ------------------------------------------------------------------------------- */ void Cal_NumericalIntegralQuantity(struct Element *Element, struct IntegralQuantityActive *IQA, struct QuantityStorage *QuantityStorage_P0, struct QuantityStorage *QuantityStorage_P, int Type_DefineQuantity, int Nbr_Dof, void (*xFunctionBF[])(), struct Value vBFxDof[]) { struct Value vBFx[NBR_MAX_BASISFUNCTIONS] ; int i, j, i_IntPoint ; double Factor, weight ; double vBFu[NBR_MAX_BASISFUNCTIONS] [MAX_DIM] ; struct Element *ES ; /* This routine is valid for all QUADRATURE cases: GAUSS, GAUSSLEGENDRE */ if (Element->Num != NO_ELEMENT) { Current.x = Current.y = Current.z = 0. ; for (i = 0 ; i < Element->GeoElement->NbrNodes ; i++) { Current.x += Element->x[i] * Element->n[i] ; Current.y += Element->y[i] * Element->n[i] ; Current.z += Element->z[i] * Element->n[i] ; } } Current.Element = Element ; Current.ElementSource = Element->ElementSource ; for (j = 0 ; j < Nbr_Dof ; j++) Cal_ZeroValue(&vBFxDof[j]); ES = Element->ElementSource ; for (i_IntPoint = 0 ; i_IntPoint < IQA->Nbr_IntPoints ; i_IntPoint++) { ((void (*)(int,int,double*,double*,double*,double*)) IQA->Get_IntPoint) (IQA->Nbr_IntPoints, i_IntPoint, &Current.us, &Current.vs, &Current.ws, &weight) ; Get_BFGeoElement (ES, Current.us, Current.vs, Current.ws) ; ES->DetJac = ((double (*)(struct Element*, MATRIX3x3*)) IQA->Get_Jacobian) (ES, &ES->Jac) ; if(IQA->Type_FormDof == FORM1) Get_InverseMatrix(IQA->Type_Dimension, ES->Type, ES->DetJac, &ES->Jac, &ES->InvJac) ; Current.xs = Current.ys = Current.zs = 0. ; for (i = 0 ; i < ES->GeoElement->NbrNodes ; i++) { Current.xs += ES->x[i] * ES->n[i] ; Current.ys += ES->y[i] * ES->n[i] ; Current.zs += ES->z[i] * ES->n[i] ; } if(Type_DefineQuantity != NODOF){ for (j = 0 ; j < Nbr_Dof ; j++) { ((void (*)(struct Element*, int, double, double, double, double*)) xFunctionBF[j]) (Element->ElementSource, QuantityStorage_P->BasisFunction[j].NumEntityInElement+1, Current.us, Current.vs, Current.ws, vBFu[j]) ; ((void (*)(struct Element*, double*, double*)) IQA->xChangeOfCoordinates) (Element->ElementSource, vBFu[j], vBFx[j].Val) ; vBFx[j].Type = IQA->Type_ValueDof ; Cal_SetHarmonicValue(&vBFx[j]); } } Factor = weight * fabs(ES->DetJac) ; Current.Region = Element->ElementSource->Region ; /* Il faudrait definir le cas canonique Function[] * Dof */ Cal_WholeQuantity (Element->ElementSource, QuantityStorage_P0, QuantityStorage_P->DefineQuantity->IntegralQuantity.WholeQuantity, Current.us, Current.vs, Current.ws, QuantityStorage_P->DefineQuantity->IntegralQuantity.DofIndexInWholeQuantity, Nbr_Dof, vBFx) ; Current.Region = Element->Region ; for (j = 0 ; j < Nbr_Dof ; j++) { vBFxDof[j].Type = vBFx[j].Type ; Cal_AddMultValue(&vBFxDof[j],&vBFx[j],Factor,&vBFxDof[j]); } } } /* ------------------------------------------------------------------------------- */ /* C a l _ A n a l y t i c I n t e g r a l Q u a n t i t y */ /* ------------------------------------------------------------------------------- */ void Cal_AnalyticIntegralQuantity(struct Element *Element, struct QuantityStorage *QuantityStorage_P, int Nbr_Dof, void (*xFunctionBF[])(), struct Value vBFxDof[]) { struct Value Val0 ; int i, j ; if (Element->Num != NO_ELEMENT) { Current.x = Current.y = Current.z = 0. ; for (i = 0 ; i < Element->GeoElement->NbrNodes ; i++) { Current.x += Element->x[i] * Element->n[i] ; Current.y += Element->y[i] * Element->n[i] ; Current.z += Element->z[i] * Element->n[i] ; } } Current.Element = Element ; Current.ElementSource = Element->ElementSource ; switch(QuantityStorage_P->DefineQuantity->IntegralQuantity.CanonicalWholeQuantity){ case CWQ_GF : case CWQ_GF_PSCA_DOF : break ; case CWQ_GF_PVEC_DOF : case CWQ_EXP_TIME_GF_PVEC_DOF : Message::Error("Vector product of GF_Function and Dof{} not done for analytic integration"); return ; case CWQ_GF_PSCA_EXP : case CWQ_GF_PVEC_EXP : case CWQ_EXP_TIME_GF_PSCA_DOF : Current.ElementSource = Element->ElementSource ; Current.Region = Element->ElementSource->Region ; Get_ValueOfExpression((struct Expression *) List_Pointer(Problem_S.Expression, QuantityStorage_P->DefineQuantity->IntegralQuantity. ExpressionIndexForCanonical), NULL, 0., 0., 0., &Val0) ; Current.Region = Element->Region ; break ; default : Message::Error("Unknown type of canonical Integral Quantity"); return; } for (j = 0 ; j < Nbr_Dof ; j++) { ((void (*)(struct Element*, struct Function *, void(*)(), int, double, double, double, struct Value *)) QuantityStorage_P->DefineQuantity->IntegralQuantity.FunctionForCanonical.Fct) (Element, &QuantityStorage_P->DefineQuantity->IntegralQuantity.FunctionForCanonical, xFunctionBF[j], QuantityStorage_P->BasisFunction[j].NumEntityInElement+1, Current.x, Current.y, Current.z, &vBFxDof[j]) ; Apply_ConstantFactor(QuantityStorage_P, &vBFxDof[j], &Val0) ; } switch(QuantityStorage_P->DefineQuantity->IntegralQuantity.Symmetry) { case 0 : /* No Symmetry */ break; case 1 : /* y -> -y */ for (i = 0 ; i < Element->ElementSource->GeoElement->NbrNodes ; i++) Element->ElementSource->y[i] *= -1. ; for (j = 0 ; j < Nbr_Dof ; j++) { ((void (*)(struct Element*, struct Function *, void(*)(), int, double, double, double, struct Value *)) QuantityStorage_P->DefineQuantity->IntegralQuantity.FunctionForCanonical.Fct) (Element, &QuantityStorage_P->DefineQuantity->IntegralQuantity.FunctionForCanonical, xFunctionBF[j], QuantityStorage_P->BasisFunction[j].NumEntityInElement+1, Current.x, Current.y, Current.z, &Val0) ; Apply_ConstantFactor(QuantityStorage_P, &vBFxDof[j], &Val0) ; if (vBFxDof[j].Type == SCALAR) { vBFxDof[j].Val[0] -= Val0.Val[0] ; } else { vBFxDof[j].Val[0] -= Val0.Val[0] ; vBFxDof[j].Val[1] -= Val0.Val[1] ; vBFxDof[j].Val[2] -= Val0.Val[2] ; } } for (i = 0 ; i < Element->ElementSource->GeoElement->NbrNodes ; i++) Element->ElementSource->y[i] *= -1. ; break; default: Message::Error("Unknown type of symmetry in Integral Quantity"); break; } } getdp-2.7.0-source/Legacy/GeoData.cpp000644 001750 001750 00000104616 12611677027 021036 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include #include "GeoData.h" #include "ProData.h" #include "Pos_Search.h" #include "MallocUtils.h" #include "Message.h" #include "OS.h" #define SQU(a) ((a)*(a)) extern double Flag_ORDER ; FILE * File_GEO ; struct GeoData * CurrentGeoData ; static void swapBytes(char *array, int size, int n) { int i, c; char *x = (char *)Malloc(size * sizeof(char)) ; for(i = 0; i < n; i++) { char *a = &array[i * size]; memcpy(x, a, size); for(c = 0; c < size; c++) a[size - 1 - c] = x[c]; } Free(x); } /* ------------------------------------------------------------------------ */ /* G e o _ A d d G e o D a t a */ /* ------------------------------------------------------------------------ */ int Geo_AddGeoData(List_T * GeoData_L, char * Name_MshFile, char * Name_DefaultMshFile, char * Name_AdaptFile, char * Name_DefaultAdaptFile) { struct GeoData GeoData_S ; int i ; if (!Name_MshFile) Name_MshFile = Name_DefaultMshFile ; if ((i = List_ISearchSeq(GeoData_L, Name_MshFile, fcmp_GeoData_Name)) < 0) { Message::Info("Loading Geometric data '%s'", Name_MshFile) ; i = List_Nbr(GeoData_L) ; Geo_InitGeoData(&GeoData_S, i, Name_MshFile) ; Geo_OpenFile(Name_MshFile, "rb") ; Geo_ReadFile(&GeoData_S) ; Geo_CloseFile() ; if (!Name_AdaptFile) Name_AdaptFile = Name_DefaultAdaptFile ; if (Name_AdaptFile) { Message::Info("Loading Adaptation data '%s'", Name_AdaptFile) ; Geo_OpenFile(Name_AdaptFile, "r") ; Geo_SetCurrentGeoData(&GeoData_S) ; Geo_ReadFileAdapt(&GeoData_S) ; Geo_CloseFile() ; } List_Add(GeoData_L, &GeoData_S) ; } return(i) ; } int fcmp_GeoData_Name(const void * a, const void * b) { return ( strcmp((char *)a, ((struct GeoData *)b)->Name ) ) ; } /* ------------------------------------------------------------------------ */ /* G e o _ I n i t G e o D a t a */ /* ------------------------------------------------------------------------ */ void Geo_InitGeoData(struct GeoData * GeoData_P, int Num, char * Name) { GeoData_P->Num = Num ; GeoData_P->Name = Name ; GeoData_P->Nodes = NULL ; GeoData_P->Elements = NULL ; GeoData_P->NbrElementsWithEdges = GeoData_P->NbrElementsWithFacets = 0 ; GeoData_P->NumCurrentEdge = GeoData_P->NumCurrentFacet = 0 ; GeoData_P->EdgesXNodes = Tree_Create(sizeof(struct Entity2XEntity1), fcmp_E2XE1) ; GeoData_P->FacetsXEdges = Tree_Create(sizeof(struct Entity2XEntity1), fcmp_E2XE1) ; GeoData_P->NodesXElements = NULL ; GeoData_P->Normals = Tree_Create(sizeof(struct EntityXVector), fcmp_EXVector) ; GeoData_P->GroupForPRE = NULL ; GeoData_P->Grid.Init = 0 ; GeoData_P->H = GeoData_P->P = NULL ; } /* ------------------------------------------------------------------------ */ /* G e o _ F r e e G e o D a t a */ /* ------------------------------------------------------------------------ */ void Geo_FreeGeoData(struct GeoData * GeoData_P) { Message::Debug("Freeing GeoData %d", GeoData_P->Num); List_Delete(GeoData_P->Nodes); if(GeoData_P->Elements){ for(int i = 0; i < List_Nbr(GeoData_P->Elements); i++){ Geo_Element *e = (Geo_Element*)List_Pointer(GeoData_P->Elements, i); Free(e->NumNodes); Free(e->NumEdges); Free(e->NumFacets); } List_Delete(GeoData_P->Elements); } if(GeoData_P->EdgesXNodes){ Tree_Action(GeoData_P->EdgesXNodes, free_E2XE1); Tree_Delete(GeoData_P->EdgesXNodes); } if(GeoData_P->FacetsXEdges){ Tree_Action(GeoData_P->FacetsXEdges, free_E2XE1); Tree_Delete(GeoData_P->FacetsXEdges); } if(GeoData_P->NodesXElements){ Tree_Action(GeoData_P->NodesXElements, free_E2XE1); Tree_Delete(GeoData_P->NodesXElements); } Tree_Delete(GeoData_P->Normals); List_Delete(GeoData_P->GroupForPRE); Free_SearchGrid(&GeoData_P->Grid); Free(GeoData_P->H); Free(GeoData_P->P); } /* ------------------------------------------------------------------------ */ /* G e o _ S e t C u r r e n t G e o D a t a B a s e */ /* ------------------------------------------------------------------------ */ void Geo_SetCurrentGeoData(struct GeoData * GeoData_P) { CurrentGeoData = GeoData_P ; } /* ------------------------------------------------------------------------ */ /* G e o _ O p e n F i l e */ /* ------------------------------------------------------------------------ */ void Geo_OpenFile(char * Name, const char * Mode) { File_GEO = FOpen(Name, Mode) ; if (!File_GEO) Message::Error("Unable to open file '%s'", Name); } /* ------------------------------------------------------------------------ */ /* G e o _ C l o s e F i l e */ /* ------------------------------------------------------------------------ */ void Geo_CloseFile(void) { fclose(File_GEO) ; } /* ------------------------------------------------------------------------ */ /* G e o _ R e a d F i l e */ /* ------------------------------------------------------------------------ */ int Geo_GetElementType(int Format, int Type) { switch(Format){ case FORMAT_GMSH : switch(Type){ case 15 : return POINT; case 1 : return LINE; case 2 : return TRIANGLE; case 3 : return QUADRANGLE; case 4 : return TETRAHEDRON; case 5 : return HEXAHEDRON; case 6 : return PRISM; case 7 : return PYRAMID; case 8 : return LINE_2; case 9 : return TRIANGLE_2; case 10 : return QUADRANGLE_2; case 11 : return TETRAHEDRON_2; case 12 : return HEXAHEDRON_2; case 13 : return PRISM_2; case 14 : return PYRAMID_2; case 16 : return QUADRANGLE_2_8N; default : Message::Error("Unknown type of Element in Gmsh format (%d)", FORMAT_GMSH); return -1; } break ; default : Message::Error("Unknown mesh format (%d)", Format); return -1; } } int Geo_GetElementTypeInv(int Format, int Type) { switch(Format){ case FORMAT_GMSH : switch(Type){ case POINT : return 15; case LINE : return 1; case TRIANGLE : return 2; case QUADRANGLE : return 3; case TETRAHEDRON : return 4; case HEXAHEDRON : return 5; case PRISM : return 6; case PYRAMID : return 7; case LINE_2 : return 8; case TRIANGLE_2 : return 9; case QUADRANGLE_2 : return 10; case TETRAHEDRON_2 : return 11; case HEXAHEDRON_2 : return 12; case PRISM_2 : return 13; case PYRAMID_2 : return 14; case QUADRANGLE_2_8N: return 16; default : Message::Error("Unknown type of Element in Gmsh format"); return -1; } break ; default : Message::Error("Unknown mesh format"); return -1; } } int Geo_GetNbNodesPerElement(int Type) { switch(Type){ case POINT : return 1; case LINE : return 2; case TRIANGLE : return 3; case QUADRANGLE : return 4; case TETRAHEDRON : return 4; case HEXAHEDRON : return 8; case PRISM : return 6; case PYRAMID : return 5; case LINE_2 : return 3; case TRIANGLE_2 : return 6; case QUADRANGLE_2 : return 9; case TETRAHEDRON_2 : return 10; case HEXAHEDRON_2 : return 20; case PRISM_2 : return 15; case PYRAMID_2 : return 13; case QUADRANGLE_2_8N: return 8; default : Message::Error("Unknown type of Element"); return -1; } } int Geo_GetDimOfElement(int Type) { switch(Type){ case POINT : return 0; case LINE : return 1; case TRIANGLE : return 2; case QUADRANGLE : return 2; case TETRAHEDRON : return 3; case HEXAHEDRON : return 3; case PRISM : return 3; case PYRAMID : return 3; case LINE_2 : return 1; case TRIANGLE_2 : return 2; case QUADRANGLE_2 : return 2; case TETRAHEDRON_2 : return 3; case HEXAHEDRON_2 : return 3; case PRISM_2 : return 3; case PYRAMID_2 : return 3; case QUADRANGLE_2_8N: return 2; default : Message::Error("Unknown type of Element"); return -1; } } void Geo_ReverseElement(Geo_Element *Geo_Element) { int tmp; switch(Geo_Element->Type){ case LINE : case LINE_2 : tmp = Geo_Element->NumNodes[0]; Geo_Element->NumNodes[0] = Geo_Element->NumNodes[1]; Geo_Element->NumNodes[1] = tmp; break; case TRIANGLE : tmp = Geo_Element->NumNodes[1]; Geo_Element->NumNodes[1] = Geo_Element->NumNodes[2]; Geo_Element->NumNodes[2] = tmp; break; case TRIANGLE_2 : tmp = Geo_Element->NumNodes[1]; Geo_Element->NumNodes[1] = Geo_Element->NumNodes[2]; Geo_Element->NumNodes[2] = tmp; tmp = Geo_Element->NumNodes[3+0]; Geo_Element->NumNodes[3] = Geo_Element->NumNodes[5]; Geo_Element->NumNodes[5] = tmp; break; case QUADRANGLE : tmp = Geo_Element->NumNodes[1]; Geo_Element->NumNodes[1] = Geo_Element->NumNodes[3]; Geo_Element->NumNodes[3] = tmp; break; case QUADRANGLE_2 : case QUADRANGLE_2_8N: tmp = Geo_Element->NumNodes[1]; Geo_Element->NumNodes[1] = Geo_Element->NumNodes[3]; Geo_Element->NumNodes[3] = tmp; tmp = Geo_Element->NumNodes[4+0]; Geo_Element->NumNodes[4] = Geo_Element->NumNodes[7]; Geo_Element->NumNodes[7] = tmp; tmp = Geo_Element->NumNodes[5]; Geo_Element->NumNodes[5] = Geo_Element->NumNodes[6]; Geo_Element->NumNodes[6] = tmp; break; default : break; } } void Geo_SaveMesh(struct GeoData * GeoData_P, List_T * InitialList, char * FileName) { FILE * file; struct Geo_Node Geo_Node ; struct Geo_Node * Geo_Node_P ; struct Geo_Element Geo_Element ; struct GeoData GeoData ; int i, j, Type; int fcmp_int(const void * a, const void * b); GeoData.Nodes = List_Create(1000, 1000, sizeof(struct Geo_Node)) ; GeoData.Elements = List_Create(1000, 1000, sizeof(struct Geo_Node)) ; for (i = 0 ; i < List_Nbr(GeoData_P->Elements) ; i++) { List_Read(GeoData_P->Elements, i, &Geo_Element) ; if (List_Search(InitialList, &Geo_Element.Region, fcmp_int) ) { List_Add(GeoData.Elements, &Geo_Element) ; for (j = 0 ; j < Geo_Element.NbrNodes ; j++) if (!List_Search(GeoData.Nodes, Geo_Node_P = Geo_GetGeoNodeOfNum(Geo_Element.NumNodes[j]), fcmp_Nod) ) List_Add(GeoData.Nodes, Geo_Node_P) ; } } file = FOpen(FileName,"w"); Message::Info("Saving mesh in file \"%s\" (%d nodes, %d elements)", FileName, List_Nbr(GeoData.Nodes), List_Nbr(GeoData.Elements)); fprintf(file, "$NOD\n%d\n", List_Nbr(GeoData.Nodes)); for (i = 0 ; i < List_Nbr(GeoData.Nodes) ; i++) { List_Read(GeoData.Nodes, i, &Geo_Node) ; fprintf(file, "%d %.16g %.16g %.16g\n", Geo_Node.Num, Geo_Node.x, Geo_Node.y, Geo_Node.z) ; } fprintf(file, "$ENDNOD\n$ELM\n%d\n", List_Nbr(GeoData.Elements)); for (i = 0 ; i < List_Nbr(GeoData.Elements) ; i++) { List_Read(GeoData.Elements, i, &Geo_Element) ; Type = Geo_GetElementTypeInv(FORMAT_GMSH, Geo_Element.Type) ; fprintf(file, "%d %d %d %d %d ", Geo_Element.Num, Type, Geo_Element.Region, Geo_Element.Region, Geo_Element.NbrNodes) ; for (j = 0 ; j < Geo_Element.NbrNodes ; j++) fprintf(file, "%d ", Geo_Element.NumNodes[j]) ; fprintf(file, "\n") ; } fprintf(file, "$ENDELM\n"); fclose(file); List_Delete(GeoData.Nodes); List_Delete(GeoData.Elements); } static std::string ExtractDoubleQuotedString(const char *str, int len) { char *c = strstr((char*)str, "\""); if(!c) return ""; std::string ret; for(int i = 1; i < len; i++) { if(c[i] == '"' || c[i] == EOF || c[i] == '\n' || c[i] == '\r') break; ret.push_back(c[i]); } return ret; } void Geo_ReadFile(struct GeoData * GeoData_P) { int Nbr, i, j, Type, iDummy, Format, Size, NbTags ; double Version = 1.0 ; struct Geo_Node Geo_Node ; struct Geo_Element Geo_Element ; char String[256] = "" ; int binary = 0, swap = 0; std::map > entities[4]; while (1) { do { if(!fgets(String, sizeof(String), File_GEO) || feof(File_GEO)) break; } while (String[0] != '$') ; if (feof(File_GEO)) break ; /* F O R M A T */ if(!strncmp(&String[1], "MeshFormat", 10)) { if(!fgets(String, sizeof(String), File_GEO)) return; if(sscanf(String, "%lf %d %d", &Version, &Format, &Size) != 3) return; if(Version < 2.0 || Version >= 3.1){ Message::Error("Unsupported or unknown mesh file version (%g)", Version); return; } if(Format){ binary = 1; Message::Info("Mesh is in binary format"); int one; if(fread(&one, sizeof(int), 1, File_GEO) != 1) return; if(one != 1){ swap = 1; Message::Info("Swapping bytes from binary file"); } } } /* P H Y S I C A L N A M E S */ else if(!strncmp(&String[1], "PhysicalNames", 13)) { // GetDP does not currently use the name information if(!fgets(String, sizeof(String), File_GEO)) return ; int numNames; if(sscanf(String, "%d", &numNames) != 1) return ; for(int i = 0; i < numNames; i++) { int dim = -1, num; if(Version > 2.0){ if(fscanf(File_GEO, "%d", &dim) != 1) return ; } if(fscanf(File_GEO, "%d", &num) != 1) return ; if(!fgets(String, sizeof(String), File_GEO)) return ; std::string name = ExtractDoubleQuotedString(String, 256); Message::Debug("Physical group %d (dim %d) has name %s", num, dim, name.c_str()); } } /* E N T I T I E S */ else if(!strncmp(&String[1], "Entities", 8)) { if(!fgets(String, sizeof(String), File_GEO)) return; int num[4]; if(sscanf(String, "%d %d %d %d", &num[0], &num[1], &num[2], &num[3]) != 4) return; for(int dim = 0; dim < 4; dim++) { for(int j = 0; j < num[dim]; j++) { int num; if(fscanf(File_GEO, "%d", &num) != 1) return; int nbound = 0; if(dim > 0){ if(fscanf(File_GEO, "%d", &nbound) != 1) return; for(int k = 0; k < nbound; k++){ int dummy; if(fscanf(File_GEO, "%d", &dummy) != 1) return; } } int nphys; if(fscanf(File_GEO, "%d", &nphys) != 1) return; std::vector physicals(nphys); for(int k = 0; k < nphys; k++){ if(fscanf(File_GEO, "%d", &physicals[k]) != 1) return; } entities[dim][num] = physicals; if(nphys > 1){ Message::Error("GetDP does not support multiple physical groups per element:" " elementary entity %d belongs to %d physical groups", num, nphys); return; } } } } /* N O D E S */ else if (!strncmp(&String[1], "NOE", 3) || !strncmp(&String[1], "NOD", 3) || !strncmp(&String[1], "Nodes", 5) || !strncmp(&String[1], "ParametricNodes", 15)) { bool parametric = !strncmp(&String[1], "ParametricNodes", 15) || (Version >= 3.0); if(!fgets(String, sizeof(String), File_GEO)) return; if(sscanf(String, "%d", &Nbr) != 1) return; Message::Debug("%d nodes", Nbr); if (GeoData_P->Nodes == NULL) GeoData_P->Nodes = List_Create(Nbr, 1000, sizeof(struct Geo_Node)) ; for (i = 0 ; i < Nbr ; i++) { if(!parametric){ if(!binary){ if(fscanf(File_GEO, "%d %lf %lf %lf", &Geo_Node.Num, &Geo_Node.x, &Geo_Node.y, &Geo_Node.z) != 4) return; } else { if(fread(&Geo_Node.Num, sizeof(int), 1, File_GEO) != 1) return; if(swap) swapBytes((char*)&Geo_Node.Num, sizeof(int), 1); double xyz[3]; if(fread(xyz, sizeof(double), 3, File_GEO) != 3) return; if(swap) swapBytes((char*)xyz, sizeof(double), 3); Geo_Node.x = xyz[0]; Geo_Node.y = xyz[1]; Geo_Node.z = xyz[2]; } } else{ int dim = -1, entity; if(!binary){ if(Version < 3.0){ if(fscanf(File_GEO, "%d %lf %lf %lf %d %d", &Geo_Node.Num, &Geo_Node.x, &Geo_Node.y, &Geo_Node.z, &dim, &entity) != 6) return; } else{ if(fscanf(File_GEO, "%d %lf %lf %lf %d", &Geo_Node.Num, &Geo_Node.x, &Geo_Node.y, &Geo_Node.z, &entity) != 5) return; if(entity){ if(fscanf(File_GEO, "%d", &dim) != 1) return; } } } else{ if(fread(&Geo_Node.Num, sizeof(int), 1, File_GEO) != 1) return; if(swap) swapBytes((char*)&Geo_Node.Num, sizeof(int), 1); double xyz[3]; if(fread(xyz, sizeof(double), 3, File_GEO) != 3) return; if(swap) swapBytes((char*)xyz, sizeof(double), 3); if(Version < 3.0){ if(fread(&dim, sizeof(int), 1, File_GEO) != 1) return; if(swap) swapBytes((char*)&dim, sizeof(int), 1); if(fread(&entity, sizeof(int), 1, File_GEO) != 1) return; if(swap) swapBytes((char*)&entity, sizeof(int), 1); } else{ if(fread(&entity, sizeof(int), 1, File_GEO) != 1) return; if(swap) swapBytes((char*)&entity, sizeof(int), 1); if(entity){ if(fread(&dim, sizeof(int), 1, File_GEO) != 1) return; if(swap) swapBytes((char*)&dim, sizeof(int), 1); } } Geo_Node.x = xyz[0]; Geo_Node.y = xyz[1]; Geo_Node.z = xyz[2]; } if(dim == 1 && (Version < 3.0 || entity)){ double u[1]; if(!binary){ if(fscanf(File_GEO, "%lf", &u[0]) != 1) return; } else{ if(fread(u, sizeof(double), 1, File_GEO) != 1) return; if(swap) swapBytes((char*)u, sizeof(double), 1); } } else if(dim == 2 && (Version < 3.0 || entity)){ double uv[2]; if(!binary){ if(fscanf(File_GEO, "%lf %lf", &uv[0], &uv[1]) != 2) return; } else{ if(fread(uv, sizeof(double), 2, File_GEO) != 2) return; if(swap) swapBytes((char*)uv, sizeof(double), 2); } } else if(dim == 3 && Version >= 3.0 && entity){ double uvw[3]; if(!binary){ if(fscanf(File_GEO, "%lf %lf %lf", &uvw[0], &uvw[1], &uvw[2]) != 3) return; } else{ if(fread(uvw, sizeof(double), 3, File_GEO) != 2) return; if(swap) swapBytes((char*)uvw, sizeof(double), 3); } } } List_Add(GeoData_P->Nodes, &Geo_Node) ; if(!i){ GeoData_P->Xmin = GeoData_P->Xmax = Geo_Node.x; GeoData_P->Ymin = GeoData_P->Ymax = Geo_Node.y; GeoData_P->Zmin = GeoData_P->Zmax = Geo_Node.z; } else{ GeoData_P->Xmin = std::min(GeoData_P->Xmin, Geo_Node.x); GeoData_P->Xmax = std::max(GeoData_P->Xmax, Geo_Node.x); GeoData_P->Ymin = std::min(GeoData_P->Ymin, Geo_Node.y); GeoData_P->Ymax = std::max(GeoData_P->Ymax, Geo_Node.y); GeoData_P->Zmin = std::min(GeoData_P->Zmin, Geo_Node.z); GeoData_P->Zmax = std::max(GeoData_P->Zmax, Geo_Node.z); } } if(GeoData_P->Xmin != GeoData_P->Xmax && GeoData_P->Ymin != GeoData_P->Ymax && GeoData_P->Zmin != GeoData_P->Zmax) GeoData_P->Dimension = _3D; else if(GeoData_P->Xmin != GeoData_P->Xmax && GeoData_P->Ymin != GeoData_P->Ymax) GeoData_P->Dimension = _2D; else if(GeoData_P->Xmin != GeoData_P->Xmax && GeoData_P->Zmin != GeoData_P->Zmax) GeoData_P->Dimension = _2D; else if(GeoData_P->Ymin != GeoData_P->Ymax && GeoData_P->Zmin != GeoData_P->Zmax) GeoData_P->Dimension = _2D; else if(GeoData_P->Xmin != GeoData_P->Xmax) GeoData_P->Dimension = _1D; else if(GeoData_P->Ymin != GeoData_P->Ymax) GeoData_P->Dimension = _1D; else if(GeoData_P->Zmin != GeoData_P->Zmax) GeoData_P->Dimension = _1D; else GeoData_P->Dimension = _0D; GeoData_P->CharacteristicLength = sqrt(SQU(GeoData_P->Xmax - GeoData_P->Xmin) + SQU(GeoData_P->Ymax - GeoData_P->Ymin) + SQU(GeoData_P->Zmax - GeoData_P->Zmin)); if(!GeoData_P->CharacteristicLength) GeoData_P->CharacteristicLength = 1.; } /* E L E M E N T S */ else if (!strncmp(&String[1], "ELM", 3) || !strncmp(&String[1], "Elements", 8)) { if(!fgets(String, sizeof(String), File_GEO)) return; if(sscanf(String, "%d", &Nbr) != 1) return; Message::Debug("%d elements", Nbr); if (GeoData_P->Elements == NULL) GeoData_P->Elements = List_Create(Nbr, 1000, sizeof(struct Geo_Element)) ; Geo_Element.NbrEdges = Geo_Element.NbrFacets = 0 ; Geo_Element.NumEdges = Geo_Element.NumFacets = NULL ; if (!binary){ for (i = 0 ; i < Nbr ; i++) { if(Version == 1.0){ if(fscanf(File_GEO, "%d %d %d %d %d", &Geo_Element.Num, &Type, &Geo_Element.Region, &Geo_Element.ElementaryRegion, &Geo_Element.NbrNodes) != 5) return; Geo_Element.Type = Geo_GetElementType(FORMAT_GMSH, Type) ; } else if(Version < 3.0){ if(fscanf(File_GEO, "%d %d %d", &Geo_Element.Num, &Type, &NbTags) != 3) return; Geo_Element.Region = Geo_Element.ElementaryRegion = 1; for(j = 0; j < NbTags; j++){ if(fscanf(File_GEO, "%d", &iDummy) != 1) return; if(j == 0) Geo_Element.Region = iDummy; else if(j == 1) Geo_Element.ElementaryRegion = iDummy; /* ignore any other tags for now */ } Geo_Element.Type = Geo_GetElementType(FORMAT_GMSH, Type) ; Geo_Element.NbrNodes = Geo_GetNbNodesPerElement(Geo_Element.Type); } else{ int numData; if(fscanf(File_GEO, "%d %d %d %d", &Geo_Element.Num, &Type, &Geo_Element.ElementaryRegion, &numData) != 4) return; Geo_Element.Type = Geo_GetElementType(FORMAT_GMSH, Type) ; Geo_Element.NbrNodes = Geo_GetNbNodesPerElement(Geo_Element.Type); std::vector phys = entities[Geo_GetDimOfElement(Geo_Element.Type)] [Geo_Element.ElementaryRegion]; if(phys.empty()){ Message::Error("No physical group provided for element %d", Geo_Element.Num); return; } else Geo_Element.Region = phys[0]; /* ignore any other tags for now */ for(j = 0; j < numData - Geo_Element.NbrNodes; j++){ if(fscanf(File_GEO, "%d", &iDummy) != 1) return; } } Geo_Element.NumNodes = (int *)Malloc(Geo_Element.NbrNodes * sizeof(int)) ; for (j = 0 ; j < Geo_Element.NbrNodes ; j++) fscanf(File_GEO, "%d", &Geo_Element.NumNodes[j]) ; if(Geo_Element.Region < 0){ Geo_ReverseElement(&Geo_Element); Geo_Element.Region = -Geo_Element.Region; } List_Add(GeoData_P->Elements, &Geo_Element) ; } } else { if(Version < 3.0){ int numElementsPartial = 0; while(numElementsPartial < Nbr){ int header[3]; if(fread(header, sizeof(int), 3, File_GEO) != 3) return; if(swap) swapBytes((char*)header, sizeof(int), 3); Type = header[0]; int numElms = header[1]; int numTags = header[2]; Geo_Element.Type = Geo_GetElementType(FORMAT_GMSH, Type) ; Geo_Element.NbrNodes = Geo_GetNbNodesPerElement(Geo_Element.Type); unsigned int n = 1 + numTags + Geo_Element.NbrNodes; int *data = (int *)Malloc(n * sizeof(int)) ; for(i = 0; i < numElms; i++) { if(fread(data, sizeof(int), n, File_GEO) != n) return; if(swap) swapBytes((char*)data, sizeof(int), n); Geo_Element.Num = data[0]; Geo_Element.Region = (numTags > 0) ? data[1] : 0; Geo_Element.ElementaryRegion = (numTags > 1) ? data[2] : 0; Geo_Element.NumNodes = (int *)Malloc(Geo_Element.NbrNodes * sizeof(int)) ; for (j = 0 ; j < Geo_Element.NbrNodes ; j++) Geo_Element.NumNodes[j] = data[numTags + 1 + j] ; List_Add(GeoData_P->Elements, &Geo_Element) ; } Free(data); numElementsPartial += numElms; } } else{ for (i = 0 ; i < Nbr ; i++) { int numData; if(fread(&Geo_Element.Num, sizeof(int), 1, File_GEO) != 1) return; if(swap) swapBytes((char*)&Geo_Element.Num, sizeof(int), 1); if(fread(&Type, sizeof(int), 1, File_GEO) != 1) return; if(swap) swapBytes((char*)&Type, sizeof(int), 1); if(fread(&Geo_Element.ElementaryRegion, sizeof(int), 1, File_GEO) != 1) return; if(swap) swapBytes((char*)&Geo_Element.ElementaryRegion, sizeof(int), 1); if(fread(&numData, sizeof(int), 1, File_GEO) != 1) return; if(swap) swapBytes((char*)&numData, sizeof(int), 1); std::vector data; if(numData > 0){ data.resize(numData); if((int)fread(&data[0], sizeof(int), numData, File_GEO) != numData) return; if(swap) swapBytes((char*)&data[0], sizeof(int), numData); } Geo_Element.Type = Geo_GetElementType(FORMAT_GMSH, Type) ; Geo_Element.NbrNodes = Geo_GetNbNodesPerElement(Geo_Element.Type); Geo_Element.NumNodes = (int *)Malloc(Geo_Element.NbrNodes * sizeof(int)) ; if((int)data.size() >= Geo_Element.NbrNodes){ for (j = 0 ; j < Geo_Element.NbrNodes ; j++){ Geo_Element.NumNodes[j] = data[numData - Geo_Element.NbrNodes + j] ; } } else{ Message::Error("Missing node tags in element %d", Geo_Element.Num); return; } std::vector phys = entities[Geo_GetDimOfElement(Geo_Element.Type)] [Geo_Element.ElementaryRegion]; if(phys.empty()){ Message::Error("No physical group provided for element %d", Geo_Element.Num); return; } else Geo_Element.Region = phys[0]; if(Geo_Element.Region < 0){ Geo_ReverseElement(&Geo_Element); Geo_Element.Region = -Geo_Element.Region; } List_Add(GeoData_P->Elements, &Geo_Element) ; } } } List_Sort(GeoData_P->Elements, fcmp_Elm) ; } do { if(!fgets(String, sizeof(String), File_GEO) || feof(File_GEO)) break; } while (String[0] != '$') ; } /* while 1 ... */ } void Geo_ReadFileAdapt(struct GeoData * GeoData_P) { struct Geo_Element Geo_Element, * Geo_Element_P ; int Nbr, i, Index_GeoElement ; double E, H, P, Max_Order = -1.0 ; char String[256] ; Nbr = List_Nbr(GeoData_P->Elements) ; if(!GeoData_P->H){ GeoData_P->H = (double*)Malloc((Nbr+2)*sizeof(double)) ; for (i = 0 ; i < Nbr ; i++) GeoData_P->H[i+1] = -1.0 ; } if(!GeoData_P->P){ GeoData_P->P = (double*)Malloc((Nbr+2)*sizeof(double)) ; for (i = 0 ; i < Nbr ; i++) GeoData_P->P[i+1] = -1.0 ; } while (1) { do { if(!fgets(String, sizeof(String), File_GEO) || feof(File_GEO)) break ; } while (String[0] != '$') ; if (feof(File_GEO)) break ; if (!strncmp(&String[1], "Adapt", 5)) { fscanf(File_GEO, "%d", &Nbr) ; for (i = 0 ; i < Nbr ; i++) { fscanf(File_GEO, "%d %lf %lf %lf", &Geo_Element.Num, &E, &H, &P) ; if(!(Geo_Element_P = (struct Geo_Element *) List_PQuery(GeoData_P->Elements, &Geo_Element, fcmp_Elm))){ Message::Error("Element %d not found in database", Geo_Element.Num) ; break; } Index_GeoElement = Geo_GetGeoElementIndex(Geo_Element_P) ; GeoData_P->H[Index_GeoElement+1] = H ; GeoData_P->P[Index_GeoElement+1] = P ; if(P > Max_Order) Max_Order = P ; } } do { if(!fgets(String, sizeof(String), File_GEO) || feof(File_GEO)) break; } while (String[0] != '$') ; } /* while 1 ... */ if(Flag_ORDER < 0) Flag_ORDER = Max_Order ; Message::Info("Maximum interpolation order = %g", Flag_ORDER) ; } /* ------------------------------------------------------------------------ */ /* f c m p _ E l m & f c m p _ N o d */ /* ------------------------------------------------------------------------ */ int fcmp_Elm(const void * a, const void * b) { return ((struct Geo_Element *)a)->Num - ((struct Geo_Element *)b)->Num ; } int fcmp_Nod(const void * a, const void * b) { return ((struct Geo_Node *)a)->Num - ((struct Geo_Node *)b)->Num ; } /* ------------------------------------------------------------------------ */ /* G e o _ G e t N b r G e o E l e m e n t s */ /* ------------------------------------------------------------------------ */ int Geo_GetNbrGeoElements(void) { return(List_Nbr(CurrentGeoData->Elements)) ; } /* ------------------------------------------------------------------------ */ /* G e o _ G e t G e o E l e m e n t */ /* ------------------------------------------------------------------------ */ struct Geo_Element *Geo_GetGeoElement(int Index_Element) { return((struct Geo_Element *)List_Pointer(CurrentGeoData->Elements, Index_Element)) ; } /* ------------------------------------------------------------------------ */ /* G e o _ G e t G e o E l e m e n t I n d e x */ /* ------------------------------------------------------------------------ */ int Geo_GetGeoElementIndex(struct Geo_Element * GeoElement) { return(GeoElement - (struct Geo_Element*)List_Pointer(CurrentGeoData->Elements, 0)) ; } /* ------------------------------------------------------------------------ */ /* G e o _ G e t G e o E l e m e n t O f N u m */ /* ------------------------------------------------------------------------ */ struct Geo_Element *Geo_GetGeoElementOfNum(int Num_Element) { struct Geo_Element elm ; elm.Num = Num_Element ; return((struct Geo_Element*)List_PQuery(CurrentGeoData->Elements, &elm, fcmp_Elm)) ; } /* ------------------------------------------------------------------------ */ /* G e o _ G e t N b r G e o N o d e s */ /* ------------------------------------------------------------------------ */ int Geo_GetNbrGeoNodes(void) { return(List_Nbr(CurrentGeoData->Nodes)) ; } /* ------------------------------------------------------------------------ */ /* G e o _ G e t G e o N o d e */ /* ------------------------------------------------------------------------ */ struct Geo_Node *Geo_GetGeoNode(int Index_Node) { return((struct Geo_Node *)List_Pointer(CurrentGeoData->Nodes, Index_Node)) ; } /* ------------------------------------------------------------------------ */ /* G e o _ G e t G e o N o d e O f N u m */ /* ------------------------------------------------------------------------ */ struct Geo_Node *Geo_GetGeoNodeOfNum(int Num_Node) { struct Geo_Node node ; node.Num = Num_Node ; return((struct Geo_Node*)List_PQuery(CurrentGeoData->Nodes, &node, fcmp_Nod)) ; } /* ------------------------------------------------------------------------ */ /* G e o _ G e t N o d e s C o o r d i n a t e s */ /* ------------------------------------------------------------------------ */ void Geo_GetNodesCoordinates(int Nbr_Node, int * Num_Node, double * x, double * y, double * z) { int i ; struct Geo_Node Geo_Node, * Geo_Node_P ; for (i = 0 ; i < Nbr_Node ; i++) { Geo_Node.Num = abs(Num_Node[i]) ; if(!(Geo_Node_P = (struct Geo_Node*) List_PQuery(CurrentGeoData->Nodes, &Geo_Node, fcmp_Nod))){ Message::Error("Node %d does not exist", Geo_Node.Num) ; break; } x[i] = Geo_Node_P->x ; y[i] = Geo_Node_P->y ; z[i] = Geo_Node_P->z ; } } /* ------------------------------------------------------------------------ */ /* G e o _ S e t N o d e s C o o r d i n a t e s */ /* ------------------------------------------------------------------------ */ void Geo_SetNodesCoordinates(int Nbr_Node, int * Num_Node, double * x, double * y, double * z) { int i ; struct Geo_Node Geo_Node, * Geo_Node_P ; for (i = 0 ; i < Nbr_Node ; i++) { Geo_Node.Num = abs(Num_Node[i]) ; if(!(Geo_Node_P = (struct Geo_Node*) List_PQuery(CurrentGeoData->Nodes, &Geo_Node, fcmp_Nod))){ Message::Error("Node %d does not exist", Geo_Node.Num) ; break; } Geo_Node_P->x = x[i] ; Geo_Node_P->y = y[i] ; Geo_Node_P->z = z[i] ; } } void Geo_SetNodesCoordinatesX(int Nbr_Node, int * Num_Node, double *x) { int i ; struct Geo_Node Geo_Node, * Geo_Node_P ; for (i = 0 ; i < Nbr_Node ; i++) { Geo_Node.Num = abs(Num_Node[i]) ; if(!(Geo_Node_P = (struct Geo_Node*) List_PQuery(CurrentGeoData->Nodes, &Geo_Node, fcmp_Nod))){ Message::Error("Node %d does not exist", Geo_Node.Num) ; break; } Geo_Node_P->x = x[i] ; } } void Geo_SetNodesCoordinatesY(int Nbr_Node, int * Num_Node, double *y) { int i ; struct Geo_Node Geo_Node, * Geo_Node_P ; for (i = 0 ; i < Nbr_Node ; i++) { Geo_Node.Num = abs(Num_Node[i]) ; if(!(Geo_Node_P = (struct Geo_Node*) List_PQuery(CurrentGeoData->Nodes, &Geo_Node, fcmp_Nod))){ Message::Error("Node %d does not exist", Geo_Node.Num) ; break; } Geo_Node_P->y = y[i] ; } } void Geo_SetNodesCoordinatesZ(int Nbr_Node, int * Num_Node, double *z) { int i ; struct Geo_Node Geo_Node, * Geo_Node_P ; for (i = 0 ; i < Nbr_Node ; i++) { Geo_Node.Num = abs(Num_Node[i]) ; if(!(Geo_Node_P = (struct Geo_Node*) List_PQuery(CurrentGeoData->Nodes, &Geo_Node, fcmp_Nod))){ Message::Error("Node %d does not exist", Geo_Node.Num) ; break; } Geo_Node_P->z = z[i] ; } } getdp-2.7.0-source/Legacy/Treatment_Formulation.cpp000644 001750 001750 00000062335 12547137403 024052 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2013 P. Dular, C. Geuzaine // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "ProData.h" #include "GeoData.h" #include "DofData.h" #include "Get_DofOfElement.h" #include "Get_ElementSource.h" #include "Pre_TermOfFemEquation.h" #include "Cal_GalerkinTermOfFemEquation.h" #include "Cal_GlobalTermOfFemEquation.h" #include "Cal_AssembleTerm.h" #include "Generate_Network.h" #include "ExtendedGroup.h" #include "Message.h" extern struct Problem Problem_S ; extern struct CurrentData Current ; extern int TreatmentStatus ; extern List_T * GeoData_L ; /* ------------------------------------------------------------------------ */ /* C a l _ F e m G l o b a l E q u a t i o n */ /* ------------------------------------------------------------------------ */ struct Dof * Cal_FemGlobalEquation2(int Index_DefineQuantity, int Num_Region, struct DefineQuantity * DefineQuantity_P0, struct QuantityStorage * QuantityStorage_P0) { struct DefineQuantity * DefineQuantity_P ; struct QuantityStorage * QuantityStorage_P ; struct GlobalQuantity * GlobalQuantity_P ; struct QuantityStorage QuaSto_S ; DefineQuantity_P = DefineQuantity_P0 + Index_DefineQuantity ; QuantityStorage_P = QuantityStorage_P0 + Index_DefineQuantity ; GlobalQuantity_P = (struct GlobalQuantity*) List_Pointer(QuantityStorage_P->FunctionSpace->GlobalQuantity, *(int *)List_Pointer(DefineQuantity_P->IndexInFunctionSpace, 0)) ; Get_DofOfRegion(Num_Region, GlobalQuantity_P, QuantityStorage_P->FunctionSpace, &QuaSto_S) ; if (QuaSto_S.NbrElementaryBasisFunction == 1){ return QuaSto_S.BasisFunction[0].Dof ; } else { Message::Error( "Not 1 Dof associated with GlobalQuantity (Region #%d)", Num_Region) ; return NULL ; } } void Cal_FemGlobalEquation(struct EquationTerm * EquationTerm_P, struct DefineQuantity * DefineQuantity_P0, struct QuantityStorage * QuantityStorage_P0) { int Nbr_GlobalEquationTerm, i_GlobalEquationTerm ; struct Constraint * Constraint_P ; struct GlobalEquationTerm * GlobalEquationTerm_P ; int Nbr_EquAndDof ; List_T * InitialListInIndex_L, * RegionIndex_L ; int Nbr_Region, i_Region, Num_Region, k ; int Nbr_MCPR, i_MCPR, Nbr_CPR, i_CPR, i_Node, i_Loop, j_Branch, Num_Equ ; struct MultiConstraintPerRegion * MCPR_P ; struct ConstraintPerRegion * CPR_P ; struct Group * Group_P ; double Val[NBR_MAX_HARMONIC] ; struct DofGlobal { int NumRegion ; struct Dof * Dof ; } ; List_T * DofGlobal_Equ_L, * DofGlobal_DofNode_L, * DofGlobal_DofLoop_L ; struct DofGlobal * DofGlobal_Equ, * DofGlobal_DofNode, * DofGlobal_DofLoop ; struct DofGlobal DofGlobal_S, * DofGlobal_P ; /* Liste des Regions auxquelles on associe des Equations de Type 'Network' */ RegionIndex_L = List_Create(50,50, sizeof(int)) ; Constraint_P = (struct Constraint*) List_Pointer(Problem_S.Constraint, EquationTerm_P->Case.GlobalEquation.ConstraintIndex) ; Nbr_MCPR = List_Nbr(Constraint_P->MultiConstraintPerRegion) ; for (i_MCPR = 0 ; i_MCPR < Nbr_MCPR ; i_MCPR++) { MCPR_P = (struct MultiConstraintPerRegion*) List_Pointer(Constraint_P->MultiConstraintPerRegion, i_MCPR) ; Nbr_CPR = List_Nbr(MCPR_P->ConstraintPerRegion) ; for (i_CPR = 0 ; i_CPR < Nbr_CPR ; i_CPR++) { CPR_P = (struct ConstraintPerRegion*) List_Pointer(MCPR_P->ConstraintPerRegion, i_CPR) ; Group_P = (struct Group *) List_Pointer(Problem_S.Group, CPR_P->RegionIndex) ; List_Read(Group_P->InitialList, 0, &Num_Region) ; if (!List_Search(RegionIndex_L, &Num_Region, fcmp_int)) List_Add(RegionIndex_L, &Num_Region) ; else { Message::Error("2 occurences of Elementary Region #%d in Contraint '%s'", Num_Region, Constraint_P->Name); return; } } } Nbr_EquAndDof = List_Nbr(RegionIndex_L) ; if (!Nbr_EquAndDof){ return ; } DofGlobal_Equ_L = List_Create(Nbr_EquAndDof, 1, sizeof(struct DofGlobal)) ; DofGlobal_DofNode_L = List_Create(Nbr_EquAndDof, 1, sizeof(struct DofGlobal)) ; DofGlobal_DofLoop_L = List_Create(Nbr_EquAndDof, 1, sizeof(struct DofGlobal)) ; /* Construction des listes de Dof globaux pour Equ, DofNode, DofLoop */ Nbr_GlobalEquationTerm = List_Nbr(EquationTerm_P->Case.GlobalEquation.GlobalEquationTerm) ; for (i_GlobalEquationTerm = 0 ; i_GlobalEquationTerm < Nbr_GlobalEquationTerm ; i_GlobalEquationTerm++) { GlobalEquationTerm_P = (struct GlobalEquationTerm*) List_Pointer(EquationTerm_P->Case.GlobalEquation.GlobalEquationTerm, i_GlobalEquationTerm) ; InitialListInIndex_L = ((struct Group *)List_Pointer(Problem_S.Group, GlobalEquationTerm_P->InIndex))->InitialList ; Nbr_Region = List_Nbr(InitialListInIndex_L) ; List_Sort(InitialListInIndex_L, fcmp_int) ; for (i_Region = 0 ; i_Region < Nbr_Region ; i_Region++) { List_Read(InitialListInIndex_L, i_Region, &Num_Region) ; if (List_Search(RegionIndex_L, &Num_Region, fcmp_int)) { DofGlobal_S.NumRegion = Num_Region ; DofGlobal_S.Dof = Cal_FemGlobalEquation2 (GlobalEquationTerm_P->DefineQuantityIndexEqu, Num_Region, DefineQuantity_P0, QuantityStorage_P0) ; List_Add(DofGlobal_Equ_L, &DofGlobal_S) ; DofGlobal_S.Dof = Cal_FemGlobalEquation2 (GlobalEquationTerm_P->DefineQuantityIndexNode, Num_Region, DefineQuantity_P0, QuantityStorage_P0) ; List_Add(DofGlobal_DofNode_L, &DofGlobal_S) ; DofGlobal_S.Dof = Cal_FemGlobalEquation2 (GlobalEquationTerm_P->DefineQuantityIndexLoop, Num_Region, DefineQuantity_P0, QuantityStorage_P0) ; List_Add(DofGlobal_DofLoop_L, &DofGlobal_S) ; } } } if (List_Nbr(DofGlobal_Equ_L) != Nbr_EquAndDof) { Message::Error("Incompatible number of equations with Contraint '%s' " "(%d equations obtained while %d branches are defined)", Constraint_P->Name, List_Nbr(DofGlobal_Equ_L), Nbr_EquAndDof); return; } DofGlobal_Equ = (struct DofGlobal*)List_Pointer(DofGlobal_Equ_L , 0) ; DofGlobal_DofNode = (struct DofGlobal*)List_Pointer(DofGlobal_DofNode_L, 0) ; DofGlobal_DofLoop = (struct DofGlobal*)List_Pointer(DofGlobal_DofLoop_L, 0) ; for (k = 0 ; k < List_Nbr(DofGlobal_Equ_L) ; k++) { if (DofGlobal_Equ[k].Dof->Type == DOF_FIXED || DofGlobal_Equ[k].Dof->Type == DOF_LINK) { if (DofGlobal_Equ[k].Dof == DofGlobal_DofNode[k].Dof) DofGlobal_Equ[k].Dof = DofGlobal_DofLoop[k].Dof ; else DofGlobal_Equ[k].Dof = DofGlobal_DofNode[k].Dof ; } } /* Construction des equations (assemblage) */ Num_Equ = 0 ; Nbr_MCPR = List_Nbr(Constraint_P->MultiConstraintPerRegion) ; for (i_MCPR = 0 ; i_MCPR < Nbr_MCPR ; i_MCPR++) { MCPR_P = (struct MultiConstraintPerRegion*) List_Pointer(Constraint_P->MultiConstraintPerRegion, i_MCPR) ; if (!MCPR_P->Active) MCPR_P->Active = Generate_Network(MCPR_P->Name, MCPR_P->ConstraintPerRegion) ; for (i_Node = 0 ; i_Node < MCPR_P->Active->Case.Network.NbrNode ; i_Node++) { for (j_Branch = 0 ; j_Branch < MCPR_P->Active->Case.Network.NbrBranch ; j_Branch++) { if (MCPR_P->Active->Case.Network.MatNode[i_Node][j_Branch]) { Group_P = (struct Group *) List_Pointer (Problem_S.Group, ((struct ConstraintPerRegion *) List_Pointer(MCPR_P->ConstraintPerRegion, j_Branch))->RegionIndex) ; List_Read(Group_P->InitialList, 0, &Num_Region) ; DofGlobal_P = (struct DofGlobal*) List_PQuery(DofGlobal_DofNode_L, &Num_Region, fcmp_int) ; Val[0] = (double)(MCPR_P->Active->Case.Network.MatNode[i_Node][j_Branch]) ; if (Current.NbrHar > 1) { Val[1] = 0. ; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) { Val[k] = Val[0] ; Val[k+1] = 0. ; } } /* Message::Info("Node: eq.(%d) [%d, %d], dof [%d, %d] : %.16g\n", Num_Equ, DofGlobal_Equ[Num_Equ].Dof->NumType, DofGlobal_Equ[Num_Equ].Dof->Entity, DofGlobal_P->Dof->NumType, DofGlobal_P->Dof->Entity, Val[0] ) ; */ Cal_AssembleTerm_NeverDt(DofGlobal_Equ[Num_Equ].Dof, DofGlobal_P->Dof, Val) ; } } Num_Equ++ ; } /* for i_Node ... */ for (i_Loop = 0 ; i_Loop < MCPR_P->Active->Case.Network.NbrLoop ; i_Loop++) { for (j_Branch = 0 ; j_Branch < MCPR_P->Active->Case.Network.NbrBranch ; j_Branch++) { if (MCPR_P->Active->Case.Network.MatLoop[i_Loop][j_Branch]) { Group_P = (struct Group *) List_Pointer (Problem_S.Group, ((struct ConstraintPerRegion *) List_Pointer(MCPR_P->ConstraintPerRegion, j_Branch))->RegionIndex) ; List_Read(Group_P->InitialList, 0, &Num_Region) ; DofGlobal_P = (struct DofGlobal*) List_PQuery(DofGlobal_DofLoop_L, &Num_Region, fcmp_int) ; Val[0] = (double)(MCPR_P->Active->Case.Network.MatLoop[i_Loop][j_Branch]) ; if (Current.NbrHar > 1) { Val[1] = 0. ; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) { Val[k] = Val[0] ; Val[k+1] = 0. ; } } /* Message::Info("Loop: eq.(%d) [%d, %d], dof [%d, %d] : %.16g\n", Num_Equ, DofGlobal_Equ[Num_Equ].Dof->NumType, DofGlobal_Equ[Num_Equ].Dof->Entity, DofGlobal_P->Dof->NumType, DofGlobal_P->Dof->Entity, Val[0] ) ; */ Cal_AssembleTerm_NeverDt(DofGlobal_Equ[Num_Equ].Dof, DofGlobal_P->Dof, Val) ; } } Num_Equ++ ; } /* for i_Loop ... */ } /* for i_MCPR ... */ List_Delete(DofGlobal_Equ_L) ; List_Delete(DofGlobal_DofNode_L) ; List_Delete(DofGlobal_DofLoop_L) ; List_Delete(RegionIndex_L) ; } /* ------------------------------------------------------------------------ */ /* T r e a t m e n t _ F e m F o r m u l a t i o n */ /* ------------------------------------------------------------------------ */ void Treatment_FemFormulation(struct Formulation * Formulation_P) { struct Element Element ; struct QuantityStorage * QuantityStorage_P0, * QuantityStorage_P ; struct QuantityStorage QuantityStorage_S ; struct Dof DofForNoDof_P [NBR_MAX_HARMONIC] ; struct EquationTerm * EquationTerm_P0 , * EquationTerm_P ; struct GlobalQuantity * GlobalQuantity_P ; int Nbr_DefineQuantity ; struct DefineQuantity * DefineQuantity_P0 , * DefineQuantity_P ; List_T * FemLocalTermActive_L ; struct FemLocalTermActive FemLocalTermActive_S ; List_T * QuantityStorage_L ; struct Group * GroupIn_P ; int i, j, Nbr_Element, i_Element, Nbr_EquationTerm, i_EquTerm ; int Index_DefineQuantity, TraceGroupIndex_DefineQuantity ; List_T * InitialListInIndex_L ; int Nbr_Region, i_Region, Num_Region ; extern struct Group * Generate_Group ; extern double ** MH_Moving_Matrix ; gMatrix A = Current.DofData->A ; gVector b = Current.DofData->b ; int Flag_Only ; /* --------------------------------------------------------------- */ /* 0. Initialization of an active zone (QuantityStorage) for each */ /* DefineQuantity */ /* --------------------------------------------------------------- */ if (!(Nbr_EquationTerm = List_Nbr(Formulation_P->Equation))){ Message::Error("No equation in Formulation '%s'", Formulation_P->Name); return; } if (!(Nbr_DefineQuantity = List_Nbr(Formulation_P->DefineQuantity))){ Message::Error("No Quantity in Formulation '%s'", Formulation_P->Name); return; } DefineQuantity_P0 = (struct DefineQuantity*) List_Pointer(Formulation_P->DefineQuantity, 0) ; QuantityStorage_L = List_Create(Nbr_DefineQuantity, 1, sizeof (struct QuantityStorage) ) ; QuantityStorage_S.NumLastElementForFunctionSpace = QuantityStorage_S.NumLastElementForDofDefinition = QuantityStorage_S.NumLastElementForEquDefinition = 0 ; for (i = 0 ; i < Nbr_DefineQuantity ; i++) { QuantityStorage_S.DefineQuantity = DefineQuantity_P0 + i ; if(QuantityStorage_S.DefineQuantity->Type == INTEGRALQUANTITY && QuantityStorage_S.DefineQuantity->IntegralQuantity.DefineQuantityIndexDof < 0){ QuantityStorage_S.FunctionSpace = NULL ; QuantityStorage_S.TypeQuantity = VECTOR ; /* to change */ } else{ QuantityStorage_S.FunctionSpace = (struct FunctionSpace*) List_Pointer(Problem_S.FunctionSpace, QuantityStorage_S.DefineQuantity->FunctionSpaceIndex) ; QuantityStorage_S.TypeQuantity = QuantityStorage_S.FunctionSpace->Type ; } List_Add(QuantityStorage_L, &QuantityStorage_S) ; } QuantityStorage_P0 = (struct QuantityStorage*)List_Pointer(QuantityStorage_L, 0) ; Get_InitDofOfElement(&Element) ; /* --------------------------------------------------------------- */ /* 1. Initialization of equation terms */ /* --------------------------------------------------------------- */ EquationTerm_P0 = (struct EquationTerm*)List_Pointer(Formulation_P->Equation, 0) ; FemLocalTermActive_L = List_Create(Nbr_EquationTerm, 1, sizeof (struct FemLocalTermActive) ) ; for (i_EquTerm = 0 ; i_EquTerm < Nbr_EquationTerm ; i_EquTerm++) { List_Add(FemLocalTermActive_L, &FemLocalTermActive_S) ; EquationTerm_P = EquationTerm_P0 + i_EquTerm ; switch(EquationTerm_P->Type){ case GALERKIN : EquationTerm_P->Case.LocalTerm.Active = (struct FemLocalTermActive*) List_Pointer(FemLocalTermActive_L, i_EquTerm) ; switch (TreatmentStatus) { case _PRE : Pre_InitTermOfFemEquation(EquationTerm_P, QuantityStorage_P0) ; break ; case _CAL : Cal_InitGalerkinTermOfFemEquation(EquationTerm_P, QuantityStorage_P0, &QuantityStorage_S, DofForNoDof_P) ; break ; } break; case GLOBALTERM : switch (TreatmentStatus) { case _PRE : Pre_InitGlobalTermOfFemEquation(EquationTerm_P, QuantityStorage_P0) ; break ; } break; case GLOBALEQUATION : break ; default : Message::Error("Unknown type of equation term") ; break ; } } /* ---------------------------------------------------------- */ /* 2. Loop on geometrical elements : */ /* Treatment of eventual GALERKIN terms */ /* --------------------------------------------------------- */ Nbr_Element = Geo_GetNbrGeoElements() ; Message::ResetProgressMeter(); for (i_Element = 0 ; i_Element < Nbr_Element; i_Element++) { if (Generate_Group) { Element.Region = Geo_GetGeoElement(i_Element)->Region ; while (i_Element < Nbr_Element && !List_Search(Generate_Group->InitialList, &Element.Region, fcmp_int) ) { i_Element++ ; if (i_Element < Nbr_Element) Element.Region = Geo_GetGeoElement(i_Element)->Region ; } if (i_Element == Nbr_Element) break ; } Element.GeoElement = Geo_GetGeoElement(i_Element) ; Element.Num = Element.GeoElement->Num ; Element.Type = Element.GeoElement->Type ; Current.Region = Element.Region = Element.GeoElement->Region ; /* ---------------------------- */ /* 2.1. Loop on equation terms */ /* ---------------------------- */ for (i_EquTerm = 0 ; i_EquTerm < Nbr_EquationTerm ; i_EquTerm++) { EquationTerm_P = EquationTerm_P0 + i_EquTerm ; if (EquationTerm_P->Type == GALERKIN) { /* if the element is in the support of integration of the term */ /* ----------------------------------------------------------- */ GroupIn_P = (struct Group *) List_Pointer(Problem_S.Group, EquationTerm_P->Case.LocalTerm.InIndex); if ((GroupIn_P->Type != ELEMENTLIST && List_Search(GroupIn_P->InitialList, &Element.Region, fcmp_int)) || (GroupIn_P->Type == ELEMENTLIST && Check_IsEntityInExtendedGroup(GroupIn_P, Element.Num, 0)) ) { /* if (List_Search(((struct Group *) List_Pointer(Problem_S.Group, EquationTerm_P->Case. LocalTerm.InIndex))->InitialList, &Element.Region, fcmp_int ) ) { */ if(Message::GetVerbosity() == 10) printf("==> Element #%d, EquationTerm #%d/%d\n", Element.Num, i_EquTerm+1, Nbr_EquationTerm) ; Current.IntegrationSupportIndex = EquationTerm_P->Case.LocalTerm.InIndex ; /* ---------------------------------------------------------- */ /* 2.1.1. Loop on quantities (test fcts and shape functions) */ /* ---------------------------------------------------------- */ for (i = 0 ; i < EquationTerm_P->Case.LocalTerm.Term.NbrQuantityIndex ; i++) { Index_DefineQuantity = EquationTerm_P->Case.LocalTerm.Term.QuantityIndexTable[i] ; DefineQuantity_P = DefineQuantity_P0 + Index_DefineQuantity ; QuantityStorage_P = QuantityStorage_P0 + Index_DefineQuantity ; TraceGroupIndex_DefineQuantity = EquationTerm_P->Case.LocalTerm.Term.QuantityTraceGroupIndexTable[i] ; /* Only one analysis for each function space */ /* * Attention : l'operateur de trace ne fonctionne que si le champ * dont on prend la trace n'intervient qu'une seule fois dans le terme. * du a - manque de generalite du code au niveau de la gestion des * espaces fonctionnels des fcts tests pour 'Trace de Dof' * - et Christophe fatigue */ if (QuantityStorage_P->NumLastElementForFunctionSpace != Element.Num || TraceGroupIndex_DefineQuantity >= 0 ) { QuantityStorage_P->NumLastElementForFunctionSpace = Element.Num ; switch (DefineQuantity_P->Type) { case LOCALQUANTITY : if(TraceGroupIndex_DefineQuantity >= 0){ Get_ElementTrace(&Element, TraceGroupIndex_DefineQuantity) ; QuantityStorage_P->NumLastElementForFunctionSpace = Element.ElementTrace->Num ; Get_DofOfElement (Element.ElementTrace, QuantityStorage_P->FunctionSpace, QuantityStorage_P, DefineQuantity_P->IndexInFunctionSpace) ; } else{ Get_DofOfElement (&Element, QuantityStorage_P->FunctionSpace, QuantityStorage_P, DefineQuantity_P->IndexInFunctionSpace) ; } break ; case INTEGRALQUANTITY : QuantityStorage_P->NbrElementaryBasisFunction = 0 ; break ; default : Message::Error("Bad kind of Quantity in Formulation '%s'", Formulation_P->Name); break; } } } /* for i = 0, 1 ... */ /* -------------------------------------- */ /* 2.1.2. Treatment of the equation term */ /* -------------------------------------- */ switch (TreatmentStatus) { case _PRE : Pre_TermOfFemEquation(&Element, EquationTerm_P, QuantityStorage_P0) ; break ; case _CAL : Flag_Only = 0 ; if (Current.DofData->Flag_Only){ A = Current.DofData->A ; b = Current.DofData->b ; if (EquationTerm_P->Case.LocalTerm.MatrixIndex == -1) EquationTerm_P->Case.LocalTerm.MatrixIndex = 0 ; j = List_ISearch(Current.DofData->OnlyTheseMatrices, &EquationTerm_P->Case.LocalTerm.MatrixIndex, fcmp_int) ; if(j!=-1){ Flag_Only = 1 ; switch(EquationTerm_P->Case.LocalTerm.MatrixIndex){ case 1 : Current.DofData->A = Current.DofData->A1 ; Current.DofData->b = Current.DofData->b1 ; break; case 2 : Current.DofData->A = Current.DofData->A2 ; Current.DofData->b = Current.DofData->b2 ; break; case 3 : Current.DofData->A = Current.DofData->A3 ; Current.DofData->b = Current.DofData->b3 ; break; } } }/* Only the matrices that vary are recalculated */ if (!Current.DofData->Flag_Only || (Current.DofData->Flag_Only && Flag_Only) ){ QuantityStorage_P = QuantityStorage_P0 + EquationTerm_P->Case.LocalTerm.Term.DefineQuantityIndexEqu ; if(EquationTerm_P->Type == GALERKIN) Cal_GalerkinTermOfFemEquation(&Element, EquationTerm_P, QuantityStorage_P0) ; if (Current.DofData->Flag_Only && Flag_Only){ Current.DofData->A = A ; Current.DofData->b = b ; } }/* Flag_Only */ break ; case _CST : Cst_TermOfFemEquation(&Element, EquationTerm_P, QuantityStorage_P0) ; break ; } }/* if Support ... */ } /* if GALERKIN ... */ } /* for i_EquTerm ... */ Message::ProgressMeter(i_Element + 1, Nbr_Element, (TreatmentStatus == _PRE) ? "Pre-processing" : "Processing (Generate)"); if(Message::GetErrorCount()) break; } /* for i_Element ... */ if (MH_Moving_Matrix) { List_Delete(FemLocalTermActive_L) ; List_Delete(QuantityStorage_L) ; return; } /* ------------------------------------------------------ */ /* 3. Loop on equation terms : */ /* Treatment of eventual GLOBAL terms */ /* ------------------------------------------------------ */ for (i_EquTerm = 0 ; i_EquTerm < Nbr_EquationTerm ; i_EquTerm++) { EquationTerm_P = EquationTerm_P0 + i_EquTerm ; if (EquationTerm_P->Type == GLOBALTERM) { InitialListInIndex_L = ((struct Group *)List_Pointer(Problem_S.Group, EquationTerm_P->Case.GlobalTerm.InIndex)) ->InitialList ; List_Sort(InitialListInIndex_L, fcmp_int) ; Nbr_Region = List_Nbr(InitialListInIndex_L) ; /* ---------------------------------------------- */ /* 3.1. Loop on Regions belonging to the support */ /* ---------------------------------------------- */ for (i_Region = 0 ; i_Region < Nbr_Region ; i_Region++) { List_Read(InitialListInIndex_L, i_Region, &Num_Region) ; Current.Region = Num_Region ; /* ---------------------------------------------------------------- */ /* 3.1.1. Loop on Quantities (test functions and shape functions) */ /* ---------------------------------------------------------------- */ for (i = 0 ; i < EquationTerm_P->Case.GlobalTerm.Term.NbrQuantityIndex ; i++) { Index_DefineQuantity = EquationTerm_P->Case.GlobalTerm.Term.QuantityIndexTable[i] ; DefineQuantity_P = DefineQuantity_P0 + Index_DefineQuantity ; QuantityStorage_P = QuantityStorage_P0 + Index_DefineQuantity ; GlobalQuantity_P = (struct GlobalQuantity*) List_Pointer(QuantityStorage_P->FunctionSpace->GlobalQuantity, *(int*)List_Pointer(DefineQuantity_P->IndexInFunctionSpace, 0)) ; /* Only one Function space analysis */ /* -------------------------------- */ if (QuantityStorage_P->NumLastElementForFunctionSpace != Num_Region) { QuantityStorage_P->NumLastElementForFunctionSpace = Num_Region ; switch (DefineQuantity_P->Type) { case GLOBALQUANTITY : Get_DofOfRegion (Num_Region, GlobalQuantity_P, QuantityStorage_P->FunctionSpace, QuantityStorage_P) ; break ; default : Message::Error("Bad kind of Quantity in Formulation '%s'", Formulation_P->Name); break; } } } /* for i = 0, 1 ... */ /* ------------------------------ */ /* 3.1.2. Treatment of the term */ /* ------------------------------ */ switch (TreatmentStatus) { case _PRE : Pre_GlobalTermOfFemEquation(Num_Region, EquationTerm_P, QuantityStorage_P0) ; break ; case _CAL : Cal_GlobalTermOfFemEquation(Num_Region, EquationTerm_P, QuantityStorage_P0, &QuantityStorage_S, DofForNoDof_P) ; break ; case _CST : Cst_GlobalTermOfFemEquation(Num_Region, EquationTerm_P, QuantityStorage_P0) ; break ; } } } /* if GLOBALTERM ... */ } /* for i_EquTerm ... */ /* --------------------------------------------------------- */ /* 4. Loop on equation terms : */ /* Treatment of eventual GLOBAL EQUATION terms */ /* --------------------------------------------------------- */ for (i_EquTerm = 0 ; i_EquTerm < Nbr_EquationTerm ; i_EquTerm++) { EquationTerm_P = EquationTerm_P0 + i_EquTerm ; if (EquationTerm_P->Type == GLOBALEQUATION) { if (EquationTerm_P->Case.GlobalEquation.ConstraintIndex >= 0) switch (TreatmentStatus) { case _PRE : Pre_FemGlobalEquation(EquationTerm_P, DefineQuantity_P0, QuantityStorage_P0) ; break ; case _CAL : Cal_FemGlobalEquation(EquationTerm_P, DefineQuantity_P0, QuantityStorage_P0) ; break ; } } /* if GLOBALEQUATION ... */ } /* for i_EquTerm ... */ /* -------------------------- */ /* 5. End of FEM treatment */ /* -------------------------- */ List_Delete(FemLocalTermActive_L) ; List_Delete(QuantityStorage_L) ; Cal_EndGalerkinTermOfFemEquation(); } /* ------------------------------------------------------------------------ */ /* T r e a t m e n t _ G l o b a l F o r m u l a t i o n */ /* ------------------------------------------------------------------------ */ void Treatment_GlobalFormulation(struct Formulation * Formulation_P) { Message::Error("You should not be here!") ; } /* ------------------------------------------------------------------------ */ /* T r e a t m e n t _ F o r m u l a t i o n */ /* ------------------------------------------------------------------------ */ void Treatment_Formulation(struct Formulation * Formulation_P) { switch (Formulation_P->Type) { case FEMEQUATION : Treatment_FemFormulation(Formulation_P) ; break ; case GLOBALEQUATION : Treatment_GlobalFormulation(Formulation_P) ; break ; default : Message::Error("Unknown type for Formulation '%s'", Formulation_P->Name) ; break ; } } getdp-2.7.0-source/Legacy/Get_Geometry.h000644 001750 001750 00000006222 12542221511 021545 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _GET_GEOMETRY_H_ #define _GET_GEOMETRY_H_ #include "ProData.h" /* Get_Geometry & co */ /* ----------------- */ void Get_NodesCoordinatesOfElement(struct Element * Element) ; void Get_BFGeoElement(struct Element * Element, double u, double v, double w) ; void * Get_JacobianFunction (int Type_Jacobian, int Type_Element, int * Type_Dimension) ; void * Get_JacobianFunctionAuto (int Type_Element, int Dimension) ; void * Get_IntegrationFunctionAuto (int Type_Element, int Order, int *NumPoints) ; /* Jacobian */ /* -------- */ #define JACOBIAN_ARG struct Element * Element, MATRIX3x3 * Jac /* Vol */ double JacobianVol0D (JACOBIAN_ARG); double JacobianVol1D (JACOBIAN_ARG); double JacobianVol2D (JACOBIAN_ARG); double JacobianVolSphShell2D (JACOBIAN_ARG); double JacobianVolRectShell2D (JACOBIAN_ARG); double JacobianVolPlpdX2D (JACOBIAN_ARG); double JacobianVolAxi1D (JACOBIAN_ARG); double JacobianVolAxi2D (JACOBIAN_ARG); double JacobianVolAxiSphShell2D (JACOBIAN_ARG); double JacobianVolAxiRectShell2D (JACOBIAN_ARG); double JacobianVolAxiPlpdX2D (JACOBIAN_ARG); double JacobianVolAxiSqu1D (JACOBIAN_ARG); double JacobianVolAxiSqu2D (JACOBIAN_ARG); double JacobianVolAxiSquSphShell2D (JACOBIAN_ARG); double JacobianVolAxiSquRectShell2D (JACOBIAN_ARG); double JacobianVol3D (JACOBIAN_ARG); double JacobianVolSphShell3D (JACOBIAN_ARG); double JacobianVolRectShell3D (JACOBIAN_ARG); /* Sur */ double JacobianSur2D (JACOBIAN_ARG); double JacobianSurSphShell2D (JACOBIAN_ARG); double JacobianSurRectShell2D (JACOBIAN_ARG); double JacobianSurAxi2D (JACOBIAN_ARG); double JacobianSur3D (JACOBIAN_ARG); /* Lin */ double JacobianLin3D (JACOBIAN_ARG); #undef JACOBIAN_ARG /* -------- */ void Get_InverseMatrix(int Type_Dimension, int Type_Element, double DetMat, MATRIX3x3 * Mat, MATRIX3x3 * InvMat) ; void Get_ProductMatrix(int Type_Dimension, MATRIX3x3 * A, MATRIX3x3 * B, MATRIX3x3 * AB) ; /* -------- */ void *Get_ChangeOfCoordinates(int Flag_ChangeCoord, int Type_Form) ; void ChangeOfCoord_No1(struct Element * Element, double vBFu[], double vBFx[]) ; void ChangeOfCoord_No123(struct Element * Element, double vBFu[], double vBFx[]) ; void ChangeOfCoord_Form1(struct Element * Element, double vBFu[], double vBFx[]) ; void ChangeOfCoord_Form2(struct Element * Element, double vBFu[], double vBFx[]) ; void ChangeOfCoord_Form3(struct Element * Element, double vBFu[], double vBFx[]) ; void ChangeOfCoord_Form1P(struct Element * Element, double vBFu[], double vBFx[]) ; void ChangeOfCoord_Form2P(struct Element * Element, double vBFu[], double vBFx[]) ; void ChangeOfCoord_Form1S(struct Element * Element, double vBFu[], double vBFx[]) ; /* -------- */ double Cal_Product123 (double v1[], double v2[]) ; double Cal_Product12 (double v1[], double v2[]) ; double Cal_Product3 (double v1[], double v2[]) ; double Cal_Product1 (double v1[], double v2[]) ; #endif getdp-2.7.0-source/Legacy/SolvingAnalyse.cpp000644 001750 001750 00000060761 12473553042 022466 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Johan Gyselinck // Ruth Sabariego // #include "ProData.h" #include "GeoData.h" #include "DofData.h" #include "Treatment_Formulation.h" #include "Cal_Quantity.h" #include "Get_DofOfElement.h" #include "Pos_Formulation.h" #include "SolvingOperations.h" #include "MallocUtils.h" #include "Message.h" #define TWO_PI 6.2831853071795865 extern struct Problem Problem_S ; extern struct CurrentData Current ; extern int Flag_PRE, Flag_CAL, Flag_POS ; extern int Flag_RESTART ; extern char *Name_Generic ; extern char *Name_Resolution ; extern char *Name_PostOperation[NBR_MAX_POS] ; extern char *Name_MshFile, *Name_ResFile[NBR_MAX_RES], *Name_AdaptFile ; int TreatmentStatus = 0 ; List_T *GeoData_L = 0, *PreResolutionIndex_L = 0; /* ------------------------------------------------------------------------ */ /* I n i t _ D o f D a t a I n F u n c t i o n S p a c e */ /* ------------------------------------------------------------------------ */ /*! Links between FunctionSpace's and DofData's (one-to-one mapping) */ void Init_DofDataInFunctionSpace(int Nbr_DefineSystem, struct DofData *DofData_P0) { struct DofData * DofData_P ; struct FunctionSpace * FunctionSpace_P ; int i, j ; for (i = 0 ; i < Nbr_DefineSystem ; i++) { DofData_P = DofData_P0 + i ; for (j = 0 ; j < List_Nbr(DofData_P->FunctionSpaceIndex) ; j++){ FunctionSpace_P = (struct FunctionSpace *) List_Pointer(Problem_S.FunctionSpace, *((int *)List_Pointer(DofData_P->FunctionSpaceIndex, j))) ; FunctionSpace_P->DofData = FunctionSpace_P->MainDofData = DofData_P ; } } } /* ------------------------------------------------------------------------ */ /* I n i t _ D o f D a t a I n D e f i n e Q u a n t i t y */ /* ------------------------------------------------------------------------ */ /*! For setting the DofData of a DefineQuantity if explicitly specified */ void Init_DofDataInDefineQuantity(struct DefineSystem *DefineSystem_P, struct DofData *DofData_P0, struct Formulation *Formulation_P) { struct DefineQuantity *DefineQuantity_P; int i, j ; for(i = 0 ; i < List_Nbr(Formulation_P->DefineQuantity) ; i++){ DefineQuantity_P = (struct DefineQuantity *) List_Pointer(Formulation_P->DefineQuantity, i); if(DefineQuantity_P->DofDataIndex >= 0){ if(DefineQuantity_P->DofDataIndex >= List_Nbr(DefineSystem_P->OriginSystemIndex)){ Message::Error("Invalid System index (%d) in discrete Quantity (%s)", DefineQuantity_P->DofDataIndex, DefineQuantity_P->Name); break; } List_Read(DefineSystem_P->OriginSystemIndex, DefineQuantity_P->DofDataIndex, &j) ; DefineQuantity_P->DofData = DofData_P0 + j ; } else DefineQuantity_P->DofData = NULL ; } } /* ------------------------------------------------------------------------ */ /* T r e a t m e n t _ P r e p r o c e s s i n g */ /* ------------------------------------------------------------------------ */ /*! For each DefineSystem: For each Formulation: Definition of Dof's in associated DofData */ void Treatment_Preprocessing(int Nbr_DefineSystem, struct DofData * DofData_P0, struct DefineSystem * DefineSystem_P0, struct GeoData * GeoData_P0) { struct DefineSystem * DefineSystem_P ; struct DofData * DofData_P ; struct Formulation * Formulation_P ; int i, k, Nbr_Formulation, Index_Formulation; for (i = 0 ; i < Nbr_DefineSystem ; i++) { DefineSystem_P = DefineSystem_P0 + i ; DofData_P = DofData_P0 + i ; Dof_SetCurrentDofData(Current.DofData = DofData_P) ; Geo_SetCurrentGeoData(Current.GeoData = GeoData_P0 + DofData_P->GeoDataIndex) ; Current.NbrHar = Current.DofData->NbrHar ; Nbr_Formulation = List_Nbr(DefineSystem_P->FormulationIndex) ; for (k = 0 ; k < Nbr_Formulation ; k++) { List_Read(DefineSystem_P->FormulationIndex, k, &Index_Formulation) ; Formulation_P = (struct Formulation*) List_Pointer(Problem_S.Formulation, Index_Formulation) ; Message::Info("Treatment Formulation '%s'", Formulation_P->Name) ; Init_DofDataInDefineQuantity(DefineSystem_P, DofData_P0, Formulation_P) ; Treatment_Formulation(Formulation_P) ; } Dof_NumberUnknownDof() ; Message::Info(-3, "System %d/%d: %d Dofs", i+1, Nbr_DefineSystem, DofData_P->NbrDof); } } /* ------------------------------------------------------------------------ */ /* T r e a t m e n t _ P o s t O p e r a t i o n */ /* ------------------------------------------------------------------------ */ /*! Prepare the treatment of a PostOperation. Then does it outside */ void Treatment_PostOperation(struct Resolution * Resolution_P, struct DofData * DofData_P0, struct DefineSystem * DefineSystem_P0, struct GeoData * GeoData_P0, struct PostProcessing * PostProcessing_P, struct PostOperation * PostOperation_P) { struct PostSubOperation * PostSubOperation_P ; struct Formulation * Formulation_P ; struct DefineSystem * DefineSystem_P ; List_T * SaveSolutions_L=NULL; struct Solution * SaveCurrentSolution_P=NULL; int Nbr_PostSubOperation, i_POP, i ; if (!List_Nbr(PostProcessing_P->PostQuantity)){ Message::Error("No Quantity available for PostProcessing '%s'", PostProcessing_P->Name) ; return; } Formulation_P = (struct Formulation *) List_Pointer(Problem_S.Formulation, PostProcessing_P->FormulationIndex) ; if (!List_Nbr(Formulation_P->DefineQuantity)){ Message::Error("No discrete Quantity in Formulation '%s'", Formulation_P->Name); return; } /* Choice of Current DofData */ Current.DofData = 0; if(PostProcessing_P->NameOfSystem){ if ((i = List_ISearchSeq(Resolution_P->DefineSystem, PostProcessing_P->NameOfSystem, fcmp_DefineSystem_Name)) < 0){ Message::Error("Unknown System name (%s) in PostProcessing (%s)", PostProcessing_P->NameOfSystem, PostProcessing_P->Name) ; return; } Current.DofData = DofData_P0 + i; /* (Re)creation des liens entre FunctionSpace et DofData: seuls les FS n'intervenant pas dans le DD courant peuvent pointer vers un autre DD */ Init_DofDataInFunctionSpace(1, Current.DofData) ; } else{ for(i = 0 ; i < List_Nbr(Formulation_P->DefineQuantity) ; i++){ Current.DofData = ((struct FunctionSpace *) List_Pointer(Problem_S.FunctionSpace, ((struct DefineQuantity *) List_Pointer(Formulation_P->DefineQuantity, i)) ->FunctionSpaceIndex)) ->DofData ; if(Current.DofData) break; } if(Current.DofData) Message::Info("NameOfSystem not set in PostProcessing: selected '%s'", (DefineSystem_P0 + Current.DofData->Num)->Name) ; } if(!Current.DofData){ Message::Error("PostProcessing not compatible with Resolution"); return; } DefineSystem_P = DefineSystem_P0 + Current.DofData->Num ; Current.NbrHar = Current.DofData->NbrHar ; Geo_SetCurrentGeoData(Current.GeoData = GeoData_P0 + Current.DofData->GeoDataIndex) ; Message::Info("Selected PostProcessing '%s'", PostProcessing_P->Name); Message::Info("Selected Mesh '%s'", Current.GeoData->Name); Init_DofDataInDefineQuantity(DefineSystem_P,DofData_P0,Formulation_P); if (PostOperation_P->ResampleTime) { SaveSolutions_L = Current.DofData->Solutions; SaveCurrentSolution_P = Current.DofData->CurrentSolution; Pos_ResampleTime(PostOperation_P); } Nbr_PostSubOperation = List_Nbr(PostOperation_P->PostSubOperation) ; for (i_POP = 0 ; i_POP < Nbr_PostSubOperation ; i_POP++) { Message::Info("PostOperation %d/%d ", i_POP+1, Nbr_PostSubOperation) ; PostSubOperation_P = (struct PostSubOperation*) List_Pointer(PostOperation_P->PostSubOperation, i_POP) ; Pos_Formulation(Formulation_P, PostProcessing_P, PostSubOperation_P) ; } if (PostOperation_P->ResampleTime) { for(int i = 0; i < List_Nbr(Current.DofData->Solutions); i++) { Solution *Solution_P = (struct Solution*)List_Pointer(Current.DofData->Solutions, i); LinAlg_DestroyVector(&Solution_P->x); Free(Solution_P->TimeFunctionValues); } List_Delete(Current.DofData->Solutions); Current.DofData->Solutions = SaveSolutions_L; Current.DofData->CurrentSolution = SaveCurrentSolution_P; } } /* ------------------------------------------------------------------------ */ /* I n i t _ H a r I n D o f D a t a */ /* ------------------------------------------------------------------------ */ /*! For a DefineSystem: Fill harmonic data in the associated DofData */ void Init_HarInDofData(struct DefineSystem * DefineSystem_P, struct DofData * DofData_P) { int j ; if (DefineSystem_P->Type == VAL_COMPLEX){ if(!DefineSystem_P->FrequencyValue) Dof_AddPulsation(DofData_P,0.0) ; else for (j = 0 ; j < List_Nbr(DefineSystem_P->FrequencyValue) ; j++) Dof_AddPulsation (DofData_P, *((double *)List_Pointer(DefineSystem_P->FrequencyValue, j)) * TWO_PI) ; } if (!List_Nbr(DofData_P->Pulsation)){ DofData_P->NbrHar = 1 ; } else { DofData_P->NbrHar = 2 * List_Nbr(DofData_P->Pulsation) ; DofData_P->Val_Pulsation = (double*)List_Pointer(DofData_P->Pulsation, 0) ; } if (DofData_P->NbrHar > NBR_MAX_HARMONIC){ Message::Error("Too many harmonics to generate system (%d > %d)", DofData_P->NbrHar/2, NBR_MAX_HARMONIC/2) ; return; } if (DofData_P->NbrHar > 1) { for (j = 0 ; j < DofData_P->NbrHar/2 ; j++) Message::Info("System '%s' : Complex, Frequency = %.8g Hz", DefineSystem_P->Name, DofData_P->Val_Pulsation[j]/TWO_PI) ; } else{ Message::Info("System '%s' : Real", DefineSystem_P->Name) ; } } /* ------------------------------------------------------------------------ */ /* T r e a t m e n t _ R e s o l u t i o n */ /* ------------------------------------------------------------------------ */ /*! For each DefineSystem: Init the associated DofData */ void Treatment_Resolution(int ResolutionIndex, int * Nbr_DefineSystem, int * Nbr_OtherSystem, struct Resolution ** Resolution_P, struct DefineSystem ** DefineSystem_P0, struct DofData ** DofData_P0, List_T ** DofData_L, List_T * GeoData_L, struct GeoData ** GeoData_P0) { struct DefineSystem * DefineSystem_P ; struct DofData DofData_S ; int i ; *Resolution_P = (struct Resolution*)List_Pointer(Problem_S.Resolution, ResolutionIndex) ; Message::Info("Selected Resolution '%s'", (*Resolution_P)->Name) ; *Nbr_DefineSystem = List_Nbr((*Resolution_P)->DefineSystem) ; if (!*Nbr_DefineSystem){ Message::Error("No System exists for Resolution '%s'", (*Resolution_P)->Name) ; return; } if (*Nbr_OtherSystem) *Nbr_OtherSystem -= *Nbr_DefineSystem ; *DofData_L = List_Create(*Nbr_DefineSystem + *Nbr_OtherSystem, 6, sizeof(struct DofData)) ; *DefineSystem_P0 = (struct DefineSystem*) List_Pointer((*Resolution_P)->DefineSystem, 0) ; for (i = 0 ; i < *Nbr_DefineSystem ; i++) { DefineSystem_P = *DefineSystem_P0 + i ; Dof_InitDofData(&DofData_S, i, ResolutionIndex, i, DefineSystem_P->SolverDataFileName) ; DofData_S.GeoDataIndex = Geo_AddGeoData(GeoData_L, DefineSystem_P->MeshName, Name_MshFile, DefineSystem_P->AdaptName, Name_AdaptFile) ; Init_HarInDofData(DefineSystem_P, &DofData_S) ; List_Add(*DofData_L, &DofData_S) ; } for (i = 0 ; i < *Nbr_OtherSystem ; i++) { Dof_InitDofData(&DofData_S, i + *Nbr_DefineSystem, -1, -1, NULL) ; List_Add(*DofData_L, &DofData_S) ; } *DofData_P0 = (struct DofData*)List_Pointer(*DofData_L, 0) ; *GeoData_P0 = (struct GeoData*)List_Pointer(GeoData_L, 0) ; } /* ------------------------------------------------------------------------ */ /* G e t _ T i m e F u n c t i o n V a l u e s */ /* ------------------------------------------------------------------------ */ /*! For a DofData: Fill the vector of the considered time function values */ double * Get_TimeFunctionValues(struct DofData * DofData_P) { int Nbr_Expression, Nbr_TimeFunction, i, Index ; double * Values ; struct Value Val_Expression ; Nbr_Expression = List_Nbr(Problem_S.Expression) ; Values = (double *)Malloc((Nbr_Expression + 1) * sizeof(double)) ; Nbr_TimeFunction = List_Nbr(DofData_P->TimeFunctionIndex) ; for (i = 0 ; i < Nbr_TimeFunction ; i++) { List_Read(DofData_P->TimeFunctionIndex, i, &Index) ; if ((DofData_P->NbrHar == 1) && (Index > 0)) { Get_ValueOfExpressionByIndex(Index - 1, NULL, 0., 0., 0., &Val_Expression) ; Values[Index] = Val_Expression.Val[0] ; } else Values[Index] = 1. ; } return(Values) ; } /* ------------------------------------------------------------------------ */ /* S o l v i n g A n a l y s e */ /* ------------------------------------------------------------------------ */ /*! Global analyse of a problem */ void SolvingAnalyse() { struct Resolution * Resolution_P , * Resolution2_P ; struct DefineSystem * DefineSystem_P0 , * DefineSystem2_P0, * DefineSystem_P ; struct Solution * Solution_P , Solution_S ; struct GeoData * GeoData_P0 ; struct DofData * DofData_P0 , * DofData2_P0 ; List_T * DofData_L , * DofData2_L ; int Num_Resolution = 0, Num_Resolution2 ; int Nbr_DefineSystem , Nbr_DefineSystem2 ; int Nbr_Solution ; struct DofData * DofData_P ; struct Dof * Dof_P ; struct PostOperation * PostOperation_P[NBR_MAX_POS] ; struct PostProcessing * PostProcessing_P[NBR_MAX_POS] ; struct PreResolutionInfo PreResolutionInfo_S ; double d; int i, j ; int Num, Nbr_GeoData = 0; int Nbr_PreResolution, Nbr_OtherSystem ; DofData_L = 0; // in case of errors before it is created GeoData_L = List_Create( 1, 5, sizeof(struct GeoData)) ; /* -------------------- */ /* Treatment Resolution */ /* -------------------- */ if (Flag_PRE) { Nbr_OtherSystem = 0 ; if (Name_Resolution) Num_Resolution = List_ISearchSeq(Problem_S.Resolution, Name_Resolution, fcmp_Resolution_Name) ; else{ Message::Error("Missing Resolution"); goto end; } } else if (Flag_CAL || Flag_POS) { Dof_OpenFile(DOF_PRE, Name_Generic, "r") ; Dof_ReadFilePRE0(&Num_Resolution, &Nbr_DefineSystem) ; Nbr_OtherSystem = Nbr_DefineSystem ; } if (Num_Resolution < 0 || Num_Resolution + 1 > List_Nbr(Problem_S.Resolution)){ Message::Error("Unknown Resolution (%s)", Name_Resolution); goto end; } Treatment_Resolution(Num_Resolution, &Nbr_DefineSystem, &Nbr_OtherSystem, &Resolution_P, &DefineSystem_P0, &DofData_P0, &DofData_L, GeoData_L, &GeoData_P0) ; if(Message::GetOnelabAction() == "stop" || Message::GetErrorCount()) goto end; /* -------------- */ /* Pre-processing */ /* -------------- */ TreatmentStatus = _PRE ; Message::Direct("P r e - P r o c e s s i n g . . .") ; Message::ProgressMeter(0, 0, "Pre-processing"); if (Flag_PRE) { PreResolutionIndex_L = List_Create(10, 10, sizeof(struct PreResolutionInfo)) ; Treatment_Preprocessing(Nbr_DefineSystem, DofData_P0, DefineSystem_P0, GeoData_P0) ; Nbr_PreResolution = List_Nbr(PreResolutionIndex_L) ; for (i = 0 ; i < Nbr_PreResolution ; i++) { Message::Direct("P r e - R e s o l u t i o n (%d/%d) . . .", i+1, Nbr_PreResolution) ; List_Read(PreResolutionIndex_L, i, &PreResolutionInfo_S) ; Num_Resolution2 = PreResolutionInfo_S.Index ; Nbr_OtherSystem = 0 ; Treatment_Resolution(Num_Resolution2, &Nbr_DefineSystem2, &Nbr_OtherSystem, &Resolution2_P, &DefineSystem2_P0, &DofData2_P0, &DofData2_L, GeoData_L, &GeoData_P0) ; TreatmentStatus = _PRE ; Treatment_Preprocessing(Nbr_DefineSystem2, DofData2_P0, DefineSystem2_P0, GeoData_P0) ; for (j = 0 ; j < Nbr_DefineSystem2 ; j++) Dof_TransferDofTreeToList(DofData2_P0 + j) ; Init_DofDataInFunctionSpace(Nbr_DefineSystem2, DofData2_P0) ; Current.TypeTime = TIME_STATIC ; Current.Time = 0. ; Current.TimeImag = 0. ; Current.TimeStep = 0. ; Current.Iteration = 0 ; Current.RelativeDifference = 0. ; Current.RelaxationFactor = 1. ; Current.Breakpoint = -1; TreatmentStatus = _CAL ; Current.NbrSystem = Nbr_DefineSystem2 ; /* Attention: init for Dt[] */ Current.DofData_P0 = DofData2_P0 ; Treatment_Operation(Resolution2_P, Resolution2_P->Operation, DofData2_P0, GeoData_P0, Resolution_P, DofData_P0) ; if (PreResolutionInfo_S.Type == PR_GLOBALBASISFUNCTION) { for (j = 0 ; j < Nbr_DefineSystem2 ; j++) { DofData_P = DofData2_P0 + j ; Dof_TransferSolutionToConstraint(DofData_P) ; DofData_P->Num += Nbr_DefineSystem ; List_Add(DofData_L, DofData_P) ; } Nbr_DefineSystem = List_Nbr(DofData_L) ; /* New Value ... */ DofData_P0 = (struct DofData*)List_Pointer(DofData_L, 0) ; /* New Value ... */ } Message::Direct("E n d P r e - R e s o l u t i o n (%d/%d)", i+1, Nbr_PreResolution) ; } Dof_OpenFile(DOF_PRE, Name_Generic, "w+") ; Dof_WriteFilePRE0(Num_Resolution, Resolution_P->Name, Nbr_DefineSystem) ; for (i = 0 ; i < Nbr_DefineSystem ; i++){ Dof_WriteFilePRE(DofData_P0 + i) ; } Nbr_GeoData = List_Nbr(GeoData_L) ; for (i = 0 ; i < Nbr_GeoData ; i++) Geo_WriteFilePRE(GeoData_P0 + i, Problem_S.Group) ; Dof_CloseFile(DOF_PRE) ; if (Flag_CAL || Flag_POS) for (i = 0 ; i < Nbr_DefineSystem ; i++) Dof_TransferDofTreeToList(DofData_P0 + i) ; } else if (Flag_CAL || Flag_POS) { Message::Info("Loading Pre-Processing data '%s.pre'", Name_Generic) ; for(i = 0 ; i < Nbr_DefineSystem ; i++) Dof_ReadFilePRE(DofData_P0 + i) ; for(i = 0 ; i < Nbr_OtherSystem ; i++) { DofData_P = DofData_P0 + Nbr_DefineSystem + i ; Dof_ReadFilePRE(DofData_P) ; DefineSystem_P = (struct DefineSystem*) List_Pointer((((struct Resolution*)List_Pointer(Problem_S.Resolution, DofData_P->ResolutionIndex)) ->DefineSystem), DofData_P->SystemIndex) ; DofData_P->GeoDataIndex = Geo_AddGeoData(GeoData_L, DefineSystem_P->MeshName, Name_MshFile, DefineSystem_P->AdaptName, Name_AdaptFile) ; Init_HarInDofData(DefineSystem_P, DofData_P) ; } Nbr_DefineSystem = List_Nbr(DofData_L) ; /* New Value ... */ Nbr_GeoData = List_Nbr(GeoData_L) ; Geo_ReadFilePRE(GeoData_P0, Nbr_GeoData, Problem_S.Group) ; Dof_CloseFile(DOF_PRE) ; } Message::Cpu(""); Message::Direct("E n d P r e - P r o c e s s i n g"); if(Message::GetOnelabAction() == "stop" || Message::GetErrorCount()) goto end; /* ---------- */ /* Processing */ /* ---------- */ if (Flag_CAL) { TreatmentStatus = _CAL ; Message::Direct("P r o c e s s i n g . . .") ; Message::ProgressMeter(0, 0, "Processing"); Init_DofDataInFunctionSpace(Nbr_DefineSystem, DofData_P0) ; if(Flag_RESTART) { i = 0 ; while(Name_ResFile[i]){ Message::Info("Loading Processing data '%s'", Name_ResFile[i]) ; Dof_OpenFile(DOF_RES, Name_ResFile[i], "rb"); Dof_ReadFileRES(DofData_L, NULL, -1, &Current.Time, &Current.TimeImag, &Current.TimeStep) ; Dof_CloseFile(DOF_RES); i++ ; } Message::Info("Restarting computation (time = %g) s (TimeStep %g)", Current.Time, Current.TimeStep) ; } else{ Current.Time = Current.TimeImag = Current.TimeStep = 0. ; } Current.NbrHar = 1 ; /* Bug : peut ne pas etre initialise si -cal sans -pre et evaluation d'expression sans init de systeme avant */ Current.TypeTime = TIME_STATIC ; Current.RelativeDifference = 0. ; Current.RelaxationFactor = 1. ; Current.NbrSystem = Nbr_DefineSystem ; /* Attention: init for Dt[] */ Current.DofData_P0 = DofData_P0 ; Current.Breakpoint = -1; Treatment_Operation(Resolution_P, Resolution_P->Operation, DofData_P0, GeoData_P0, NULL, NULL) ; Message::Cpu(""); Message::Direct("E n d P r o c e s s i n g"); } if(Message::GetOnelabAction() == "stop" || Message::GetErrorCount()) goto end; /* --------------- */ /* Post-processing */ /* --------------- */ if (Flag_POS) { TreatmentStatus = _POS ; Message::Direct("P o s t - P r o c e s s i n g . . .") ; Message::ProgressMeter(0, 0, "Post-processing"); i = 0 ; while(Name_PostOperation[i]){ if((Num = List_ISearchSeq(Problem_S.PostOperation, Name_PostOperation[i], fcmp_PostOperation_Name)) < 0){ Message::Error("Unknown PostOperation (%s)", Name_PostOperation[i]) ; goto end; } PostOperation_P[i] = (struct PostOperation*) List_Pointer(Problem_S.PostOperation, Num) ; PostProcessing_P[i] = (struct PostProcessing *) List_Pointer(Problem_S.PostProcessing, PostOperation_P[i]->PostProcessingIndex) ; i++ ; } PostProcessing_P[i] = NULL ; if (!Flag_CAL) { i = 0 ; while(Name_ResFile[i]){ Message::Info("Loading Processing data '%s'", Name_ResFile[i]) ; Dof_OpenFile(DOF_RES, Name_ResFile[i], "rb"); Dof_ReadFileRES(DofData_L, NULL, -1, &d, &d, &d) ; Dof_CloseFile(DOF_RES) ; i++ ; } } for (i = 0 ; i < Nbr_DefineSystem ; i++) { Current.DofData = DofData_P = DofData_P0 + i ; for(j=0 ; jNbrAnyDof ; j++){ Dof_P = (struct Dof *)List_Pointer(DofData_P->DofList, j) ; if(Dof_P->Type == DOF_UNKNOWN_INIT){ Dof_P->Type = DOF_UNKNOWN ; LinAlg_ZeroScalar(&Dof_P->Val) ; } } Current.NbrHar = Current.DofData->NbrHar ; Nbr_Solution = List_Nbr(DofData_P->Solutions) ; if (Nbr_Solution == 0) { /* en cas de pos sans cal, apres calcul de function de base globale... a reorganiser */ if (DofData_P->Solutions == NULL) DofData_P->Solutions = List_Create( 1, 1, sizeof(struct Solution)) ; Solution_S.Time = 0. ; Solution_S.SolutionExist = 0 ; Solution_S.TimeFunctionValues = NULL ; List_Add(DofData_P->Solutions, &Solution_S) ; Nbr_Solution = 1 ; } if (!Flag_CAL) { /* Pas necessaire si Flag_CAL */ for (j = 0 ; j < Nbr_Solution ; j++) { Solution_P = (struct Solution*)List_Pointer(DofData_P->Solutions, j) ; Current.Time = Solution_P->Time ; Current.TimeImag = Solution_P->TimeImag ; Current.TimeStep = 0.; Current.Breakpoint = -1; Free(Solution_P->TimeFunctionValues); Solution_P->TimeFunctionValues = Get_TimeFunctionValues(DofData_P) ; } } DofData_P->CurrentSolution = (Nbr_Solution)? (struct Solution*)List_Pointer(DofData_P->Solutions, 0) : NULL ; /* La solution courante est la 1ere. A mieux gerer ? */ } Init_DofDataInFunctionSpace(Nbr_DefineSystem, DofData_P0) ; Current.NbrSystem = Nbr_DefineSystem ; /* Attention: init for Dt[] */ Current.DofData_P0 = DofData_P0 ; i = 0 ; while(PostProcessing_P[i]){ Treatment_PostOperation(Resolution_P, DofData_P0, DefineSystem_P0, GeoData_P0, PostProcessing_P[i], PostOperation_P[i]) ; i++ ; } Message::Cpu(""); Message::Direct("E n d P o s t - P r o c e s s i n g"); } end: for(int i = 0; i < List_Nbr(DofData_L); i++) Dof_FreeDofData((DofData*)List_Pointer(DofData_L, i)); List_Delete(DofData_L) ; for(int i = 0; i < List_Nbr(GeoData_L); i++) Geo_FreeGeoData((GeoData*)List_Pointer(GeoData_L, i)); List_Delete(GeoData_L); } getdp-2.7.0-source/Legacy/BF_Edge_3.cpp000644 001750 001750 00000021364 12473553042 021161 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "ProData.h" #include "GeoData.h" #include "Message.h" /* The non-symmetric facet functions are selected according to the NumIndex^th smallest global node number */ int fcmp_Int2(const void * a, const void * b) { return ((struct TwoInt *)a)->Int2 - ((struct TwoInt *)b)->Int2 ; } int Get_FacetFunctionIndex(struct Element * Element, int NumEntity, int NumIndex) { int i, j, *NumNodes ; if(Element->NumLastElementForSortedNodesByFacet != Element->Num){ for(i = 0 ; i < Element->GeoElement->NbrFacets ; i++){ NumNodes = Geo_GetNodesOfFacetInElement(Element->GeoElement, i); j = 0 ; while(NumNodes[j]){ Element->SortedNodesByFacet[i][j].Int1 = NumNodes[j] ; Element->SortedNodesByFacet[i][j].Int2 = Element->GeoElement->NumNodes[NumNodes[j]-1] ; j++ ; } qsort(Element->SortedNodesByFacet[i], j, sizeof(struct TwoInt), fcmp_Int2); } Element->NumLastElementForSortedNodesByFacet = Element->Num ; } return Element->SortedNodesByFacet[NumEntity-1][NumIndex-1].Int1; } /* ------------------------------------------------------------------------ */ /* B F _ E d g e _ 3 */ /* ------------------------------------------------------------------------ */ /* ------- */ /* Edges */ /* ------- */ #define WrongNumEntity Message::Error("Wrong Edge number in 'BF_Edge_3E'") void BF_Edge_3E(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { Message::Error("You should never end up here!") ; } #undef WrongNumEntity /* -------- */ /* Facets */ /* -------- */ #define WrongNumEntity Message::Error("Wrong Face number in 'BF_Edge_3F'") void BF_Edge_3F(struct Element * Element, int NumEntity, int Index, double u, double v, double w, double s[]) { switch (Element->Type) { case LINE : Message::Error("You should never end up here!") ; break; case TRIANGLE : switch(NumEntity) { case 1 : switch(Get_FacetFunctionIndex(Element, NumEntity, Index)){ case 3 : s[0] = 0. ; s[1] = (1-u-v)*u ; s[2] = 0. ; break ; case 1 : s[0] = -u*v ; s[1] = -u*v ; s[2] = 0. ; break ; case 2 : s[0] = (1-u-v)*v ; s[1] = 0. ; s[2] = 0. ; break ; } break ; default : WrongNumEntity ; } break ; case QUADRANGLE : switch(NumEntity) { default : Message::Error("BF_Edge_3F not ready for QUADRANGLE"); } break ; case TETRAHEDRON : switch(NumEntity) { case 1 : switch(Get_FacetFunctionIndex(Element, NumEntity, Index)){ case 4: s[0] = 0. ; s[1] = 0. ; s[2] = u*(1.-u-v-w) ; break ; case 1: s[0] = -u*w ; s[1] = -u*w ; s[2] = -u*w ; break ; case 2: s[0] = (1.-u-v-w)*w ; s[1] = 0. ; s[2] = 0. ; break ; } break ; case 2 : switch(Get_FacetFunctionIndex(Element, NumEntity, Index)){ case 2: s[0] = v*(1-u-v-w) ; s[1] = 0. ; s[2] = 0. ; break ; case 1: s[0] = -u*v ; s[1] = -u*v ; s[2] = -u*v ; break ; case 3: s[0] = 0. ; s[1] = u*(1.-u-v-w) ; s[2] = 0. ; break ; } break ; case 3 : switch(Get_FacetFunctionIndex(Element, NumEntity, Index)){ case 3: s[0] = 0. ; s[1] = (1.-u-v-w)*w ; s[2] = 0. ; break ; case 1: s[0] = -v*w ; s[1] = -v*w ; s[2] = -v*w ; break ; case 4: s[0] = 0. ; s[1] = 0. ; s[2] = v*(1.-u-v-w) ; break ; } break ; case 4 : switch(Get_FacetFunctionIndex(Element, NumEntity, Index)){ case 4: s[0] = 0. ; s[1] = 0. ; s[2] = u*v ; break ; case 2: s[0] = v*w ; s[1] = 0. ; s[2] = 0. ; break ; case 3: s[0] = 0. ; s[1] = u*w ; s[2] = 0. ; break ; } break ; default : WrongNumEntity ; } break ; case HEXAHEDRON : switch(NumEntity) { default : Message::Error("BF_Edge_3F not ready for HEXAHEDRON"); } break ; case PRISM : switch(NumEntity) { default : Message::Error("BF_Edge_3F not ready for PRISM"); } break ; case PYRAMID : switch(NumEntity) { default : Message::Error("BF_Edge_3F not ready for PYRAMID"); } break ; default : Message::Error("Unknown type of Element in BF_Edge_3F"); break ; } } #undef WrongNumEntity void BF_Edge_3F_a(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { BF_Edge_3F(Element, NumEntity, 1, u, v, w, s) ; } void BF_Edge_3F_b(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { BF_Edge_3F(Element, NumEntity, 2, u, v, w, s) ; } void BF_Edge_3F_c(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { BF_Edge_3F(Element, NumEntity, 3, u, v, w, s) ; } /* -------- */ /* Volume */ /* -------- */ void BF_Edge_3V(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { Message::Error("You should never end up here!") ; } /* ------------------------------------------------------------------------ */ /* B F _ C u r l E d g e _ 3 */ /* ------------------------------------------------------------------------ */ /* ------- */ /* Edges */ /* ------- */ #define WrongNumEntity Message::Error("Wrong Edge number in 'BF_CurlEdge_3E'") void BF_CurlEdge_3E(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { Message::Error("You should never end up here!") ; } #undef WrongNumEntity /* -------- */ /* Facets */ /* -------- */ #define WrongNumEntity Message::Error("Wrong Face number in 'BF_CurlEdge_3F'") void BF_CurlEdge_3F(struct Element * Element, int NumEntity, int Index, double u, double v, double w, double s[]) { switch (Element->Type) { case LINE : Message::Error("You should never end up here!") ; break; case TRIANGLE : switch(NumEntity) { case 1 : switch(Get_FacetFunctionIndex(Element, NumEntity, Index)){ case 3 : s[0] = 0. ; s[1] = 0. ; s[2] = -2.0*u+1.0-v ; break ; case 1 : s[0] = 0. ; s[1] = 0. ; s[2] = -v+u; break ; case 2 : s[0] = 0. ; s[1] = 0. ; s[2] = 2.0*v-1.0+u ; break ; } break ; default : WrongNumEntity ; } break ; case QUADRANGLE : switch(NumEntity) { default : Message::Error("BF_CurlEdge_3F not ready for QUADRANGLE"); } break ; case TETRAHEDRON : switch(NumEntity) { case 1 : switch(Get_FacetFunctionIndex(Element, NumEntity, Index)){ case 4: s[0] = -u ; s[1] = -1.+2.*u+v+w ; s[2] = 0. ; break ; case 1: s[0] = u ; s[1] = -u+w ; s[2] = -w ; break ; case 2: s[0] = 0. ; s[1] = 1.-u-v-2.*w ; s[2] = w ; break ; } break ; case 2 : switch(Get_FacetFunctionIndex(Element, NumEntity, Index)){ case 2: s[0] = 0. ; s[1] = -v ; s[2] = -1.+u+2.*v+w ; break ; case 1: s[0] = -u ; s[1] = v ; s[2] = u-v ; break ; case 3: s[0] = u ; s[1] = 0. ; s[2] = 1.-2.*u-v-w ; break ; } break ; case 3 : switch(Get_FacetFunctionIndex(Element, NumEntity, Index)){ case 3: s[0] = -1.+u+v+2.*w ; s[1] = 0. ; s[2] = -w ; break ; case 1: s[0] = v-w ; s[1] = -v ; s[2] = w ; break ; case 4: s[0] = 1.-u-2.*v-w ; s[1] = v ; s[2] = 0. ; break ; } break ; case 4 : switch(Get_FacetFunctionIndex(Element, NumEntity, Index)){ case 4: s[0] = u ; s[1] = -v ; s[2] = 0. ; break ; case 2: s[0] = 0. ; s[1] = v ; s[2] = -w ; break ; case 3: s[0] = -u ; s[1] = 0. ; s[2] = w ; break ; } break ; default : WrongNumEntity ; } break ; case HEXAHEDRON : switch(NumEntity) { default : Message::Error("BF_CurlEdge_3F not ready for HAXAHEDRON"); } break ; case PRISM : switch(NumEntity) { default : Message::Error("BF_CurlEdge_3F not ready for PRISM"); } break ; default : Message::Error("Unknown type of Element in BF_CurlEdge_3F"); break ; } } #undef WrongNumEntity void BF_CurlEdge_3F_a(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { BF_CurlEdge_3F(Element, NumEntity, 1, u, v, w, s) ; } void BF_CurlEdge_3F_b(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { BF_CurlEdge_3F(Element, NumEntity, 2, u, v, w, s) ; } void BF_CurlEdge_3F_c(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { BF_CurlEdge_3F(Element, NumEntity, 3, u, v, w, s) ; } /* -------- */ /* Volume */ /* -------- */ void BF_CurlEdge_3V(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { Message::Error("You should never end up here!") ; } getdp-2.7.0-source/Legacy/Cal_GalerkinTermOfFemEquation.h000644 001750 001750 00000002144 12473553042 024752 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _CAL_GALERKIN_TERM_OF_FEM_EQUATION_H_ #define _CAL_GALERKIN_TERM_OF_FEM_EQUATION_H_ #include "ProData.h" void Cal_InitGalerkinTermOfFemEquation(struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0, struct QuantityStorage * QuantityStorageNoDof, struct Dof * DofForNoDof_P); void Cal_GalerkinTermOfFemEquation(struct Element * Element, struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0); void Cal_EndGalerkinTermOfFemEquation(); /* In F_MultiHar */ void Cal_InitGalerkinTermOfFemEquation_MHJacNL(struct EquationTerm * EquationTerm_P); void Cal_GalerkinTermOfFemEquation_MHJacNL(struct Element * Element, struct EquationTerm * EquationTerm_P, struct QuantityStorage *QuantityStorage_P0); #endif getdp-2.7.0-source/Legacy/Gauss_Hexahedron.cpp000644 001750 001750 00000005211 12473553042 022744 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "Gauss.h" #include "Gauss_Hexahedron.h" #include "Message.h" #include "MallocUtils.h" /* Gauss integration over a hexahedron */ void Gauss_Hexahedron(int Nbr_Points, int Num, double *u, double *v, double *w, double *wght) { switch (Nbr_Points) { case 6 : *u = xhex6 [Num] ; *v = yhex6 [Num] ; *w = zhex6 [Num] ; *wght = phex6 [Num] ; break ; case 14 : *u = xhex14 [Num] ; *v = yhex14 [Num] ; *w = zhex14 [Num] ; *wght = phex14 [Num] ; break ; case 34 : *u = xhex34[Num] ; *v = yhex34[Num] ; *w = zhex34[Num] ; *wght = phex34[Num] ; break ; case 77 : *u = xhex77[Num] ; *v = yhex77[Num] ; *w = zhex77[Num] ; *wght = phex77[Num] ; break ; default : Message::Error("Wrong number of Gauss points for Hexahedron: " "valid choices: 6, 14, 34, 77"); break; } } /* Gauss-Legendre scheme to integrate over a hexahedron */ static int glhex[MAX_LINE_POINTS] = {-1}; static double *glxhex[MAX_LINE_POINTS], *glyhex[MAX_LINE_POINTS]; static double *glzhex[MAX_LINE_POINTS], *glphex[MAX_LINE_POINTS]; void GaussLegendre_Hexahedron(int Nbr_Points, int Num, double *u, double *v, double *w, double *wght) { int i, j, k, index = 0, nb; double pt1, pt2, pt3, wt1, wt2, wt3, dum; nb = (int)cbrt((double)Nbr_Points); if(nb * nb * nb != Nbr_Points || nb > MAX_LINE_POINTS){ Message::Error("Number of points should be n^3 with n in [1,%d]", MAX_LINE_POINTS) ; return; } if(glhex[0] < 0) for(i = 0; i < MAX_LINE_POINTS; i++) glhex[i] = 0 ; if(!glhex[nb - 1]){ Message::Info("Computing GaussLegendre %dx%dx%d for Hexahedron", nb, nb, nb); glxhex[nb - 1] = (double*)Malloc(Nbr_Points * sizeof(double)); glyhex[nb - 1] = (double*)Malloc(Nbr_Points * sizeof(double)); glzhex[nb - 1] = (double*)Malloc(Nbr_Points * sizeof(double)); glphex[nb - 1] = (double*)Malloc(Nbr_Points * sizeof(double)); for(i = 0; i < nb; i++) { Gauss_Line(nb, i, &pt1, &dum, &dum, &wt1); for(j = 0; j < nb; j++) { Gauss_Line(nb, j, &pt2, &dum, &dum, &wt2); for(k = 0; k < nb; k++) { Gauss_Line(nb, k, &pt3, &dum, &dum, &wt3); glxhex[nb - 1][index] = pt1; glyhex[nb - 1][index] = pt2; glzhex[nb - 1][index] = pt3; glphex[nb - 1][index++] = wt1 * wt2 * wt3; } } } glhex[nb - 1] = 1; } *u = glxhex[nb - 1][Num] ; *v = glyhex[nb - 1][Num] ; *w = glzhex[nb - 1][Num] ; *wght = glphex[nb - 1][Num] ; } getdp-2.7.0-source/Legacy/Cal_AssembleTerm.cpp000644 001750 001750 00000055027 12473553042 022671 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Johan Gyselinck // #include "ProData.h" #include "DofData.h" #include "Message.h" #include #define SQU(a) ((a)*(a)) extern struct CurrentData Current ; static int Warning_Dt = 0, Warning_DtStatic = 0 ; static int Warning_DtDt = 0, Warning_DtDtStatic = 0, Warning_DtDtFirstOrder = 0 ; /* ------------------------------------------------------------------------ */ /* No Time Derivative */ /* ------------------------------------------------------------------------ */ void Cal_AssembleTerm_NoDt(struct Dof * Equ, struct Dof * Dof, double Val[]) { int k ; double tmp[2] ; if(Current.TypeAssembly == ASSEMBLY_SEPARATE){ if (!Current.DofData->Flag_Init[1]) { Current.DofData->Flag_Init[1] = 1 ; LinAlg_CreateMatrix(&Current.DofData->M1, &Current.DofData->Solver, Current.DofData->NbrDof, Current.DofData->NbrDof) ; LinAlg_CreateVector(&Current.DofData->m1, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroMatrix(&Current.DofData->M1); LinAlg_ZeroVector(&Current.DofData->m1); Current.DofData->m1s = List_Create(10, 10, sizeof(gVector)); for(int i = 0; i < List_Nbr(Current.DofData->TimeFunctionIndex); i++){ gVector m; LinAlg_CreateVector(&m, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroVector(&m); List_Add(Current.DofData->m1s, &m); } } for (k = 0 ; k < Current.NbrHar ; k += 2) Dof_AssembleInMat(Equ+k, Dof+k, Current.NbrHar, &Val[k], &Current.DofData->M1, &Current.DofData->m1, Current.DofData->m1s) ; } else { if (Current.NbrHar == 1) { switch (Current.TypeTime) { case TIME_STATIC : Dof_AssembleInMat(Equ, Dof, Current.NbrHar, &Val[0], &Current.DofData->A, &Current.DofData->b) ; break ; case TIME_THETA : tmp[0] = Val[0]*Current.Theta ; Dof_AssembleInMat(Equ, Dof, Current.NbrHar, tmp, &Current.DofData->A, &Current.DofData->b) ; tmp[0] = Val[0]*(Current.Theta-1.) ; Dof_AssembleInVec(Equ, Dof, Current.NbrHar, tmp, Current.DofData->CurrentSolution-1, &(Current.DofData->CurrentSolution-1)->x, &Current.DofData->b) ; break ; case TIME_NEWMARK : tmp[0] = Val[0]*Current.Beta ; Dof_AssembleInMat(Equ, Dof, Current.NbrHar, tmp, &Current.DofData->A, &Current.DofData->b) ; tmp[0] = Val[0]*(2*Current.Beta-Current.Gamma-0.5) ; Dof_AssembleInVec(Equ, Dof, Current.NbrHar, tmp, Current.DofData->CurrentSolution-1, &(Current.DofData->CurrentSolution-1)->x, &Current.DofData->b) ; tmp[0] = Val[0]*(Current.Gamma-Current.Beta-0.5) ; Dof_AssembleInVec(Equ, Dof, Current.NbrHar, tmp, Current.DofData->CurrentSolution-2, &(Current.DofData->CurrentSolution-2)->x, &Current.DofData->b) ; break ; case TIME_GEAR : Dof_AssembleInMat(Equ, Dof, Current.NbrHar, Val, &Current.DofData->A, &Current.DofData->b) ; break ; } } else { /* for (k = 0 ; k < Current.NbrHar ; k += 2) Dof_AssembleInMat(Equ+k, Dof+k, Current.NbrHar, &Val[k], &Current.DofData->A, &Current.DofData->b) ; // Ruth -> Current.NbrHar */ for (k = 0 ; k < Current.NbrHar ; k += 2) { tmp[0] = Val[k] ; tmp[1] = Val[k+1] ; //printf("Val[%d]= %g Val[%d]=%g\n",k, Val[k], k+1, Val[k+1]); // Ruth Dof_AssembleInMat(Equ+k, Dof+k, 2, tmp, &Current.DofData->A, &Current.DofData->b) ; /* If the Current.NbrHar > 2 we must indicate just the size of tmp for assembling, i.e. 2 instead of Current.NbrHar*/ } } } } /* ------------------------------------------------------------------------ */ /* First order Time Derivative */ /* ------------------------------------------------------------------------ */ void Cal_AssembleTerm_DtDof(struct Dof * Equ, struct Dof * Dof, double Val[]) { int k ; double tmp[2] ; if(Current.TypeAssembly == ASSEMBLY_SEPARATE){ if (!Current.DofData->Flag_Init[2]) { Current.DofData->Flag_Init[2] = 1 ; LinAlg_CreateMatrix(&Current.DofData->M2, &Current.DofData->Solver, Current.DofData->NbrDof, Current.DofData->NbrDof) ; LinAlg_CreateVector(&Current.DofData->m2, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroMatrix(&Current.DofData->M2); LinAlg_ZeroVector(&Current.DofData->m2); Current.DofData->m2s = List_Create(10, 10, sizeof(gVector)); for(int i = 0; i < List_Nbr(Current.DofData->TimeFunctionIndex); i++){ gVector m; LinAlg_CreateVector(&m, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroVector(&m); List_Add(Current.DofData->m2s, &m); } } for (k = 0 ; k < Current.NbrHar ; k += 2) Dof_AssembleInMat(Equ+k, Dof+k, Current.NbrHar, &Val[k], &Current.DofData->M2, &Current.DofData->m2, Current.DofData->m2s) ; } else { if (Current.NbrHar == 1) { switch (Current.TypeTime) { case TIME_STATIC : if(!Warning_DtStatic){ Message::Info(3, "Discarded DtDof term in static analysis"); Warning_DtStatic = 1 ; } break; case TIME_THETA : tmp[0] = Val[0]/Current.DTime ; Dof_AssembleInMat(Equ, Dof, Current.NbrHar, tmp, &Current.DofData->A, &Current.DofData->b) ; Dof_AssembleInVec(Equ, Dof, Current.NbrHar, tmp, Current.DofData->CurrentSolution-1, &(Current.DofData->CurrentSolution-1)->x, &Current.DofData->b) ; break ; case TIME_NEWMARK : tmp[0] = Val[0]*Current.Gamma/Current.DTime ; Dof_AssembleInMat(Equ, Dof, Current.NbrHar, tmp, &Current.DofData->A, &Current.DofData->b) ; tmp[0] = Val[0]*(2.*Current.Gamma-1.)/Current.DTime ; Dof_AssembleInVec(Equ, Dof, Current.NbrHar, tmp, Current.DofData->CurrentSolution-1, &(Current.DofData->CurrentSolution-1)->x, &Current.DofData->b) ; tmp[0] = Val[0]*(1.-Current.Gamma)/Current.DTime ; Dof_AssembleInVec(Equ, Dof, Current.NbrHar, tmp, Current.DofData->CurrentSolution-2, &(Current.DofData->CurrentSolution-2)->x, &Current.DofData->b) ; break ; case TIME_GEAR : tmp[0] = Val[0]/(Current.bCorrCoeff*Current.DTime); Dof_AssembleInMat(Equ, Dof, Current.NbrHar, tmp, &Current.DofData->A, &Current.DofData->b) ; for (int i=0; iCurrentSolution-1, &(Current.DofData->CurrentSolution-1-i)->x, &Current.DofData->b) ; } break ; } } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { tmp[0] = -Val[k+1] * Current.DofData->Val_Pulsation[k/2] ; tmp[1] = Val[k] * Current.DofData->Val_Pulsation[k/2] ; Dof_AssembleInMat(Equ+k, Dof+k, 2, tmp, &Current.DofData->A, &Current.DofData->b) ; /* If the Current.NbrHar > 2 we must indicate just the size of tmp for assembling, i.e. 2 instead of Current.NbrHar*/ } } } } void Cal_AssembleTerm_Dt(struct Dof * Equ, struct Dof * Dof, double Val[]) { if(!Warning_Dt){ Message::Warning("Dt not implemented, using DtDof instead"); Warning_Dt = 1 ; } Cal_AssembleTerm_DtDof(Equ, Dof, Val); } /* En preparation ... */ void Cal_AssembleTerm_DtNL(struct Dof * Equ, struct Dof * Dof, double Val[]) { double tmp[2] ; if(Current.TypeAssembly == ASSEMBLY_SEPARATE){ Message::Error("DtNL not implemented for separate assembly"); } else { if (Current.NbrHar == 1) { switch (Current.TypeTime) { case TIME_STATIC : if(!Warning_DtStatic){ Message::Info(3, "Discarded DtDof term in static analysis"); Warning_DtStatic = 1 ; } break; case TIME_THETA : tmp[0] = Val[0]/Current.DTime ; Dof_AssembleInMat(Equ, Dof, Current.NbrHar, tmp, &Current.DofData->A, &Current.DofData->b) ; Dof_AssembleInVec(Equ, Dof, Current.NbrHar, tmp, Current.DofData->CurrentSolution-1, &(Current.DofData->CurrentSolution-1)->x, &Current.DofData->b) ; break ; case TIME_NEWMARK : Message::Error("DtNL not implemented for separate assembly with Newmark scheme"); return ; case TIME_GEAR : Message::Error("DtNL not implemented for Gear's method"); return ; } } else { Message::Error("DtNL not implemented for separate assembly in harmonic analysis"); /* for (k = 0 ; k < Current.NbrHar ; k += 2) { tmp[0] = -Val[k+1] * Current.DofData->Val_Pulsation[k/2] ; tmp[1] = Val[k] * Current.DofData->Val_Pulsation[k/2] ; Dof_AssembleInMat(Equ+k, Dof+k, Current.NbrHar, tmp, &Current.DofData->A, &Current.DofData->b) ; } */ } } } /* ------------------------------------------------------------------------ */ /* Second order Time Derivative */ /* ------------------------------------------------------------------------ */ void Cal_AssembleTerm_DtDtDof(struct Dof * Equ, struct Dof * Dof, double Val[]) { int k ; double tmp[2] ; if(Current.TypeAssembly == ASSEMBLY_SEPARATE){ if (!Current.DofData->Flag_Init[3]) { Current.DofData->Flag_Init[3] = 1 ; LinAlg_CreateMatrix(&Current.DofData->M3, &Current.DofData->Solver, Current.DofData->NbrDof, Current.DofData->NbrDof) ; LinAlg_CreateVector(&Current.DofData->m3, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroMatrix(&Current.DofData->M3); LinAlg_ZeroVector(&Current.DofData->m3); Current.DofData->m3s = List_Create(10, 10, sizeof(gVector)); for(int i = 0; i < List_Nbr(Current.DofData->TimeFunctionIndex); i++){ gVector m; LinAlg_CreateVector(&m, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroVector(&m); List_Add(Current.DofData->m3s, &m); } } for (k = 0 ; k < Current.NbrHar ; k += 2) { Dof_AssembleInMat(Equ+k, Dof+k, Current.NbrHar, &Val[k], &Current.DofData->M3, &Current.DofData->m3, Current.DofData->m3s) ; } } else { if (Current.NbrHar == 1) { switch (Current.TypeTime) { case TIME_STATIC : if(!Warning_DtDtStatic){ Message::Info(3, "Discarded DtDtDof term in static analysis"); Warning_DtDtStatic = 1 ; } break; case TIME_THETA : if(!Warning_DtDtFirstOrder){ Message::Info(3, "Discarded DtDtDof term in Theta time scheme"); Warning_DtDtFirstOrder = 1 ; } break; case TIME_GEAR : Message::Error("DtDtDof not implemented for Gear's method"); return ; case TIME_NEWMARK : tmp[0] = Val[0]/SQU(Current.DTime) ; Dof_AssembleInMat(Equ, Dof, Current.NbrHar, tmp, &Current.DofData->A, &Current.DofData->b) ; tmp[0] = 2*Val[0]/SQU(Current.DTime) ; Dof_AssembleInVec(Equ, Dof, Current.NbrHar, tmp, Current.DofData->CurrentSolution-1, &(Current.DofData->CurrentSolution-1)->x, &Current.DofData->b) ; tmp[0] = -Val[0]/SQU(Current.DTime) ; Dof_AssembleInVec(Equ, Dof, Current.NbrHar, tmp, Current.DofData->CurrentSolution-2, &(Current.DofData->CurrentSolution-2)->x, &Current.DofData->b) ; break ; } } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { tmp[0] = - Val[k] * SQU(Current.DofData->Val_Pulsation[k/2]) ; tmp[1] = - Val[k+1] * SQU(Current.DofData->Val_Pulsation[k/2]) ; Dof_AssembleInMat(Equ+k, Dof+k, 2, tmp, &Current.DofData->A, &Current.DofData->b) ; // Current.NbrHar->2 } } } } void Cal_AssembleTerm_DtDt(struct Dof * Equ, struct Dof * Dof, double Val[]) { if(!Warning_DtDt){ Message::Warning("DtDt not implemented, using DtDtDof instead"); Warning_DtDt = 1 ; } Cal_AssembleTerm_DtDtDof(Equ, Dof, Val); } /* ------------------------------------------------- */ /* higher order Time Derivative for Polynomial EVP */ /* ------------------------------------------------- */ void Cal_AssembleTerm_DtDtDtDof(struct Dof * Equ, struct Dof * Dof, double Val[]) { int k ; if(Current.TypeAssembly == ASSEMBLY_SEPARATE){ if (!Current.DofData->Flag_Init[4]) { Current.DofData->Flag_Init[4] = 1 ; LinAlg_CreateMatrix(&Current.DofData->M4, &Current.DofData->Solver, Current.DofData->NbrDof, Current.DofData->NbrDof) ; LinAlg_CreateVector(&Current.DofData->m4, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroMatrix(&Current.DofData->M4); LinAlg_ZeroVector(&Current.DofData->m4); Current.DofData->m4s = List_Create(10, 10, sizeof(gVector)); for(int i = 0; i < List_Nbr(Current.DofData->TimeFunctionIndex); i++){ gVector m; LinAlg_CreateVector(&m, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroVector(&m); List_Add(Current.DofData->m4s, &m); } } for (k = 0 ; k < Current.NbrHar ; k += 2) { Dof_AssembleInMat(Equ+k, Dof+k, Current.NbrHar, &Val[k], &Current.DofData->M4, &Current.DofData->m4, Current.DofData->m4s) ; } } else { Message::Error("DtDtDtDof only available with GenerateSeparate"); return ; } } void Cal_AssembleTerm_DtDtDtDtDof(struct Dof * Equ, struct Dof * Dof, double Val[]) { int k ; if(Current.TypeAssembly == ASSEMBLY_SEPARATE){ if (!Current.DofData->Flag_Init[5]) { Current.DofData->Flag_Init[5] = 1 ; LinAlg_CreateMatrix(&Current.DofData->M5, &Current.DofData->Solver, Current.DofData->NbrDof, Current.DofData->NbrDof) ; LinAlg_CreateVector(&Current.DofData->m5, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroMatrix(&Current.DofData->M5); LinAlg_ZeroVector(&Current.DofData->m5); Current.DofData->m5s = List_Create(10, 10, sizeof(gVector)); for(int i = 0; i < List_Nbr(Current.DofData->TimeFunctionIndex); i++){ gVector m; LinAlg_CreateVector(&m, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroVector(&m); List_Add(Current.DofData->m5s, &m); } } for (k = 0 ; k < Current.NbrHar ; k += 2) { Dof_AssembleInMat(Equ+k, Dof+k, Current.NbrHar, &Val[k], &Current.DofData->M5, &Current.DofData->m5, Current.DofData->m5s) ; } } else { Message::Error("DtDtDtDtDof only available with GenerateSeparate"); return ; } } void Cal_AssembleTerm_DtDtDtDtDtDof(struct Dof * Equ, struct Dof * Dof, double Val[]) { int k ; if(Current.TypeAssembly == ASSEMBLY_SEPARATE){ if (!Current.DofData->Flag_Init[6]) { Current.DofData->Flag_Init[6] = 1 ; LinAlg_CreateMatrix(&Current.DofData->M6, &Current.DofData->Solver, Current.DofData->NbrDof, Current.DofData->NbrDof) ; LinAlg_CreateVector(&Current.DofData->m6, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroMatrix(&Current.DofData->M6); LinAlg_ZeroVector(&Current.DofData->m6); Current.DofData->m6s = List_Create(10, 10, sizeof(gVector)); for(int i = 0; i < List_Nbr(Current.DofData->TimeFunctionIndex); i++){ gVector m; LinAlg_CreateVector(&m, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroVector(&m); List_Add(Current.DofData->m6s, &m); } } for (k = 0 ; k < Current.NbrHar ; k += 2) { Dof_AssembleInMat(Equ+k, Dof+k, Current.NbrHar, &Val[k], &Current.DofData->M6, &Current.DofData->m6, Current.DofData->m6s) ; } } else { Message::Error("DtDtDtDtDtDof only available with GenerateSeparate"); return ; } } /* ------------------------------------------------------------------------ */ /* Jacobian NonLinear */ /* ------------------------------------------------------------------------ */ void Cal_AssembleTerm_JacNL(struct Dof * Equ, struct Dof * Dof, double Val[]) { int k ; if(Current.TypeAssembly == ASSEMBLY_SEPARATE){ Message::Error("JacNL not implemented for separate assembly"); } else{ if (Current.NbrHar == 1) { switch (Current.TypeTime) { case TIME_STATIC : case TIME_THETA : Dof_AssembleInMat(Equ, Dof, Current.NbrHar, &Val[0], &Current.DofData->Jac, NULL) ; break ; case TIME_GEAR : Dof_AssembleInMat(Equ, Dof, Current.NbrHar, &Val[0], &Current.DofData->Jac, NULL) ; break ; case TIME_NEWMARK : Message::Error("JacNL not implemented for Newmark's method"); return ; } } else { for (k = 0 ; k < Current.NbrHar ; k += 2) Dof_AssembleInMat(Equ+k, Dof+k, Current.NbrHar, &Val[k], &Current.DofData->Jac, NULL) ; } } } void Cal_AssembleTerm_DtDofJacNL(struct Dof * Equ, struct Dof * Dof, double Val[]) { double tmp[2] ; if(Current.TypeAssembly == ASSEMBLY_SEPARATE) Message::Error("DtDofJacNL not implemented for separate assembly"); else { if (Current.NbrHar == 1) { switch (Current.TypeTime) { case TIME_STATIC : if(!Warning_DtStatic){ Message::Info(3, "Discarded DtDofJacNL term in static analysis"); Warning_DtStatic = 1 ; } break; case TIME_THETA : if ( fabs(Current.Theta - 1.0) > 1e-3 ){ Message::Error("Theta method not implemented for nonlinear problems when " "Theta != 1.0"); return; } tmp[0] = Val[0]/Current.DTime; Dof_AssembleInMat(Equ, Dof, Current.NbrHar, tmp, &Current.DofData->Jac, NULL); break ; case TIME_NEWMARK : Message::Error("DtDofJacNL not implemented for Newmark scheme"); return ; case TIME_GEAR : tmp[0] = Val[0] / (Current.bCorrCoeff * Current.DTime); Dof_AssembleInMat(Equ, Dof, Current.NbrHar, tmp, &Current.DofData->Jac, NULL); break ; } } else Message::Error("DtDofJacNL not implemented for multi-harmonic analysis"); } } /* ------------------------------------------------------------------------ */ /* Never Time Derivative (provisoire mais tres important ... Patrick) */ /* ------------------------------------------------------------------------ */ void Cal_AssembleTerm_NeverDt(struct Dof * Equ, struct Dof * Dof, double Val[]) { int k ; if(Current.TypeAssembly == ASSEMBLY_SEPARATE){ Message::Error("NeverDt not implemented for separate assembly"); } else{ if (Current.NbrHar == 1) { switch (Current.TypeTime) { case TIME_STATIC : case TIME_THETA : case TIME_NEWMARK : case TIME_GEAR : Dof_AssembleInMat(Equ, Dof, Current.NbrHar, &Val[0], &Current.DofData->A, &Current.DofData->b) ; break ; } } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { Dof_AssembleInMat(Equ+k, Dof+k, Current.NbrHar, &Val[k], &Current.DofData->A, &Current.DofData->b) ; } } } } /* ------------------------------------------------------------------------ */ /* Multi-Harmonic with movement */ /* ------------------------------------------------------------------------ */ void Cal_AssembleTerm_MHMoving(struct Dof * Equ, struct Dof * Dof, double Val[]) { // MHMoving_assemblyType = 1 => Use current system A,b // MHMoving_assemblyType = 2 => Use dedicated system A_MH_Moving, b_MH_Moving // MHMoving_assemblyType = 3 => Look for unknowns and constraints in Moving Group extern int MHMoving_assemblyType ; extern double ** MH_Moving_Matrix ; extern Tree_T * DofTree_MH_moving ; if(MHMoving_assemblyType==1){ for (int k = 0 ; k < Current.NbrHar ; k++) for (int l = 0 ; l < Current.NbrHar ; l++) { double tmp = Val[0] * MH_Moving_Matrix[k][l] ; /* if (k==l) */ Dof_AssembleInMat(Equ+k, Dof+l, 1, &tmp, &Current.DofData->A, &Current.DofData->b) ; } } if(MHMoving_assemblyType==2){ for (int k = 0 ; k < Current.NbrHar ; k++) for (int l = 0 ; l < Current.NbrHar ; l++) { double tmp = Val[0] * MH_Moving_Matrix[k][l] ; // if (k==l) Dof_AssembleInMat(Equ+k, Dof+l, 1, &tmp, &Current.DofData->A_MH_moving, &Current.DofData->b_MH_moving) ; } } if(MHMoving_assemblyType==3){ if (Dof->Type == DOF_UNKNOWN && !Tree_PQuery(DofTree_MH_moving, Dof)) Tree_Add(DofTree_MH_moving,Dof) ; else if (Dof->Type == DOF_LINK && !Tree_PQuery(DofTree_MH_moving, Dof->Case.Link.Dof)) Tree_Add(DofTree_MH_moving,Dof->Case.Link.Dof) ; if (Equ->Type == DOF_UNKNOWN && !Tree_PQuery(DofTree_MH_moving, Equ)) Tree_Add(DofTree_MH_moving,Equ) ; else if (Equ->Type == DOF_LINK && !Tree_PQuery(DofTree_MH_moving, Equ->Case.Link.Dof)) Tree_Add(DofTree_MH_moving,Equ->Case.Link.Dof) ; } } /* void Cal_AssembleTerm_MH_Moving_simple(struct Dof * Equ, struct Dof * Dof, double Val[]) { int k, l ; double tmp ; extern double ** MH_Moving_Matrix ; for (k = 0 ; k < Current.NbrHar ; k++) for (l = 0 ; l < Current.NbrHar ; l++) { tmp = Val[0] * MH_Moving_Matrix[k][l] ; // if (k==l) Dof_AssembleInMat(Equ+k, Dof+l, 1, &tmp, &Current.DofData->A, &Current.DofData->b) ; } } void Cal_AssembleTerm_MH_Moving_separate(struct Dof * Equ, struct Dof * Dof, double Val[]) { int k, l ; double tmp ; extern double ** MH_Moving_Matrix ; for (k = 0 ; k < Current.NbrHar ; k++) for (l = 0 ; l < Current.NbrHar ; l++) { tmp = Val[0] * MH_Moving_Matrix[k][l] ; // if (k==l) Dof_AssembleInMat(Equ+k, Dof+l, 1, &tmp, &Current.DofData->A_MH_moving, &Current.DofData->b_MH_moving) ; } } void Cal_AssembleTerm_MH_Moving_probe(struct Dof * Equ, struct Dof * Dof, double Val[]) { extern Tree_T * DofTree_MH_moving ; if (Dof->Type == DOF_UNKNOWN && !Tree_PQuery(DofTree_MH_moving, Dof)) Tree_Add(DofTree_MH_moving,Dof) ; else if (Dof->Type == DOF_LINK && !Tree_PQuery(DofTree_MH_moving, Dof->Case.Link.Dof)) Tree_Add(DofTree_MH_moving,Dof->Case.Link.Dof) ; if (Equ->Type == DOF_UNKNOWN && !Tree_PQuery(DofTree_MH_moving, Equ)) Tree_Add(DofTree_MH_moving,Equ) ; else if (Equ->Type == DOF_LINK && !Tree_PQuery(DofTree_MH_moving, Equ->Case.Link.Dof)) Tree_Add(DofTree_MH_moving,Equ->Case.Link.Dof) ; } */ getdp-2.7.0-source/Legacy/F_Raytracing.cpp000644 001750 001750 00000013024 12473553042 022066 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "GetDPConfig.h" #include "ProData.h" #include "F.h" #include "Message.h" #if !defined(HAVE_GSL) void F_CylinderPhase(F_ARG) { Message::Error("F_CylinderPhase requires the GSL"); } void F_DiamondPhase(F_ARG) { Message::Error("F_DiamondPhase requires the GSL"); } #else #include #include struct f_context { double x1, y1; }; static int f(const gsl_vector *ts, void *param, gsl_vector *f) { struct f_context * c = (struct f_context *)param; double t = gsl_vector_get(ts, 0); double s = gsl_vector_get(ts, 1); double x = c->x1; double y = c->y1; gsl_vector_set(f, 0, cos(t) - s*cos(2*t) - x); gsl_vector_set(f, 1, sin(t) - s*sin(2*t) - y); return GSL_SUCCESS; } static int df(const gsl_vector *ts, void* param, gsl_matrix *j) { double t = gsl_vector_get(ts, 0); double s = gsl_vector_get(ts, 1); double j1dt = -sin(t) + s*2*sin(2*t); double j2dt = cos(t) - 2*s*cos(2*t); double j1ds = -cos(2*t); double j2ds = -sin(2*t); gsl_matrix_set(j, 0, 0, j1dt); gsl_matrix_set(j, 1, 1, j2ds); gsl_matrix_set(j, 1, 0, j2dt); gsl_matrix_set(j, 0, 1, j1ds); return GSL_SUCCESS; } static int fdf(const gsl_vector *uv, void *param, gsl_vector *func, gsl_matrix *jac) { f(uv, param, func); df(uv, param, jac); return GSL_SUCCESS; } static int newton(gsl_multiroot_function_fdf FDF, double *u, double *v) { const int MAX_ITER = 25; const gsl_multiroot_fdfsolver_type* TYPE = gsl_multiroot_fdfsolver_gnewton; int iter = 0, status; gsl_multiroot_fdfsolver* solver = gsl_multiroot_fdfsolver_alloc(TYPE, 2); /* u, v contains initial guess */ gsl_vector *X = gsl_vector_alloc(2); gsl_vector_set(X, 0, *u); gsl_vector_set(X, 1, *v); gsl_multiroot_fdfsolver_set(solver, &FDF, X); do { iter++; status = gsl_multiroot_fdfsolver_iterate(solver); *u = gsl_vector_get(solver->x, 0); *v = gsl_vector_get(solver->x, 1); if(*v < 0 || *v > 15 || fabs(*u) > 7){ status= GSL_FAILURE; break; } status = gsl_multiroot_test_residual(solver->f, 1.e-12); } while(status == GSL_CONTINUE && iter < MAX_ITER); gsl_multiroot_fdfsolver_free(solver); gsl_vector_free(X); if(status == GSL_SUCCESS) return 1; else return 0; } void F_CylinderPhase(F_ARG) { double initGuess, tau[2], phase; double x = A->Val[0], y = A->Val[1]; struct f_context context = {x, y}; gsl_multiroot_function_fdf FDF; if(x > 0 && y < 1 && y > -1) { V->Val[0] = x; V->Type = SCALAR; return; } if(x > 0){ tau[1] = sqrt(x * x + y * y); if(y > 0){ initGuess = (atan2(y, -x) + 3.14 / 2) / 2; } else{ initGuess = (atan2(y, -x) - 3.14 / 2) / 2; } } else{ tau[1] = sqrt(x * x + y * y) - 1; initGuess = atan2(y, x); } if(fabs(x) < 1 && fabs(y) > 6.5){ if(y < 0){ initGuess = initGuess - 3.14 / 8; } else{ initGuess = initGuess + 3.14 / 8; } } tau[0] = initGuess; if(tau[1] == 0){ V->Val[0] = x; V->Type = SCALAR; return; } FDF.f = &f; FDF.df = &df; FDF.fdf = &fdf; FDF.n = 2; FDF.params = &context; if(!newton(FDF, &tau[0], &tau[1])) Message::Error("Newton did not converge: %lf, %lf \n", tau[0], tau[1]); /* now we just go on to calculate the phase from this */ phase = cos(tau[0]) + tau[1]; if(phase > abs(13)){ phase = 13; } V->Val[0] = phase; V->Type = SCALAR; } void F_DiamondPhase(F_ARG) { double x, y, phase, theta, xtrans, ytrans; x = A->Val[0]; y = A->Val[1]; /* if(x < 0 &&){ phase = -x; V-Val[0] = phase; V->Type = SCALAR; return; } */ x = -x; /* just a temp investigation */ /*partition up the space into a couple of pieces*/ if(x >= 0 && (y-.1 <= 1 && y+.1 >= -1)){ V->Val[0] = x; V->Type = SCALAR; return; } /* if( x <= 0 && (y>=-1 && y<=0) ) { phase = -y-1 + (-x+(-y-1)); V->Val[0] = phase; V->Type = SCALAR; return; } */ /*check to see if the point is in the cone made by the x-corner*/ xtrans = x + 1; ytrans = y; theta = atan2(ytrans,xtrans); if( theta >= 3.14/2 || theta <= -3.14/2){ phase = -1 + sqrt( pow(xtrans,2.0) + pow(ytrans,2.0) ); V->Val[0] = phase; V->Type = SCALAR; return; } /*check to see if the point is in the upper corner cone*/ xtrans = x; ytrans = y - 1; theta = atan2(ytrans,xtrans); if( theta <= 3.14/2 && theta >= 0 ){ phase = sqrt( pow(x,2.0) + pow(ytrans,2.0) ); V->Val[0] = phase; V->Type = SCALAR; return; } /*lower corner cone*/ xtrans = x; ytrans = y + 1; theta = atan2(ytrans,xtrans); if( theta >= -3.14/2 && theta <= 0 ){ phase = sqrt( pow(x,2.0) + pow(ytrans,2.0) ); V->Val[0] = phase; V->Type = SCALAR; return; } /*the point must be in one of the two reflections caused by the sides facing the incoming wave*/ /* xtrans = x; ytrans = y; */ if(y<0){ /* xtrans = (x+y+1)/2; ytrans = (xtrans)-1; phase = xtrans + sqrt( pow(x-xtrans,2.0) + pow(y-ytrans,2.0) ); */ phase = -x + ( -y + (x-1) ); } else{ /* xtrans = (1+x-y)/2; ytrans = xtrans-1; phase = xtrans + sqrt( pow(x-xtrans,2.0) + pow(-y-ytrans,2.0) ); */ phase = -x + ( y - (1-x) ); } V->Val[0] = phase; V->Type = SCALAR; } #endif getdp-2.7.0-source/Legacy/Treatment_ConstraintByLocalProjection.cpp000644 001750 001750 00000007144 12473553042 027176 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "GetDPConfig.h" #include "ProData.h" #include "GeoData.h" #include "DofData.h" #include "Get_Geometry.h" #include "Get_DofOfElement.h" #include "Message.h" #include "Gauss.h" #if defined(HAVE_GMSH) #include #endif extern struct CurrentData Current ; void Treatment_ConstraintByLocalProjection(struct Element *Element, struct FunctionSpace *FunctionSpace_P, struct QuantityStorage *QuantityStorage_P) { int Nbr_Equ = QuantityStorage_P->NbrElementaryBasisFunction ; int i_Constraint = -1; for(int i = 0; i < Nbr_Equ; i++){ if((QuantityStorage_P->BasisFunction[i].Constraint == ASSIGN_LOCALPROJ || QuantityStorage_P->BasisFunction[i].Constraint == INIT_LOCALPROJ) && QuantityStorage_P->BasisFunction[i].Constraint_Index >=0){ if(i_Constraint >= 0 && i_Constraint != QuantityStorage_P->BasisFunction[i].Constraint_Index){ Message::Error("More than one constraint per element for local projection"); return; } i_Constraint = QuantityStorage_P->BasisFunction[i].Constraint_Index; } } if(i_Constraint < 0) return; #if defined(HAVE_GMSH) struct ConstraintInFS *Constraint_P = (struct ConstraintInFS*)List_Pointer(FunctionSpace_P->Constraint, i_Constraint) ; struct ConstraintPerRegion *ConstraintPerRegion_P = Constraint_P->ConstraintPerRegion ; void (*Mapping)(struct Element * Element, double vBFu[], double vBFx[]) = (void (*)(struct Element * Element, double vBFu[], double vBFx[])) Get_ChangeOfCoordinates(1, QuantityStorage_P->TypeQuantity) ; double (*Jacobian)(struct Element*, MATRIX3x3*) = (double (*)(struct Element*, MATRIX3x3*)) Get_JacobianFunctionAuto(Element->Type, Current.GeoData->Dimension); int Nbr_IntPoints = 0; void (*Integration)(int,int,double*,double*,double*,double*) = (void (*)(int,int,double*,double*,double*,double*)) Get_IntegrationFunctionAuto(Element->Type, 1, &Nbr_IntPoints); Current.Element = Element; double vBFu[NBR_MAX_BASISFUNCTIONS][MAX_DIM] ; double vBFx[NBR_MAX_BASISFUNCTIONS][MAX_DIM] ; fullMatrix E; fullVector rhs; for (int i_IntPoint = 0 ; i_IntPoint < Nbr_IntPoints ; i_IntPoint++) { double weight; Integration(Nbr_IntPoints, i_IntPoint, &Current.u, &Current.v, &Current.w, &weight) ; Get_BFGeoElement(Element, Current.u, Current.v, Current.w) ; Element->DetJac = Jacobian(Element, &Element->Jac) ; Get_InverseMatrix(Current.GeoData->Dimension, Element->Type, Element->DetJac, &Element->Jac, &Element->InvJac) ; double Factor = weight * fabs(Element->DetJac) ; for(int i = 0; i < Nbr_Equ; i++){ ((void (*)(struct Element * Element, int NumEntity, double u, double v, double w, double Value[])) QuantityStorage_P->BasisFunction[i].BasisFunction->Function) (Element, QuantityStorage_P->BasisFunction[i].NumEntityInElement + 1, Current.u, Current.v, Current.w, vBFu[i]) ; ((void (*)(struct Element*, double*, double*)) Mapping) (Element, vBFu[i], vBFx[i]) ; } for (int i = 0 ; i < Nbr_Equ ; i++) for (int j = 0 ; j < Nbr_Equ ; j++) E(i, j) += Factor * Cal_Product123(vBFx[i], vBFx[j]) ; } #else Message::Error("Local projection constraints require Gmsh"); #endif } getdp-2.7.0-source/Legacy/BF_Node_3.cpp000644 001750 001750 00000022222 12473553042 021174 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "ProData.h" #include "Message.h" /* ------------------------------------------------------------------------ */ /* B F _ N o d e _ 3 */ /* ------------------------------------------------------------------------ */ /* ------- */ /* Edges */ /* ------- */ #define WrongNumEntity Message::Error("Wrong Edge number in 'BF_Node_3E'") void BF_Node_3E(struct Element * Element, int NumEntity, double u, double v, double w, double *s) { switch (Element->Type) { case LINE : switch(NumEntity) { case 1 : *s = 0.25 * (1.-u) * (1.+u) * (-u) ; break ; default : WrongNumEntity ; } break ; case TRIANGLE : switch(NumEntity) { case 1 : *s = (1.-u-v) * u * (1.-2*u-v) ; break ; case 2 : *s = (1.-u-v) * v * (1.-u-2*v) ; break ; case 3 : *s = u * v * (u-v) ; break ; default : WrongNumEntity ; } break ; case QUADRANGLE : switch(NumEntity) { default : Message::Error("BF_Node_3E not ready for QUADRANGLE"); } break ; case TETRAHEDRON : switch(NumEntity) { case 1 : *s = (1.-u-v-w) * u * (1.-2*u-v-w) ; break ; case 2 : *s = (1.-u-v-w) * v * (1.-u-2*v-w) ; break ; case 3 : *s = (1.-u-v-w) * w * (1.-u-v-2*w) ; break ; case 4 : *s = u * v * (u-v) ; break ; case 5 : *s = u * w * (u-w) ; break ; case 6 : *s = v * w * (v-w) ; break ; default : WrongNumEntity ; } break ; case HEXAHEDRON : switch(NumEntity) { default : Message::Error("BF_Node_3E not ready for HEXAHEDRON"); } break ; case PRISM : switch(NumEntity) { default : Message::Error("BF_Node_3E not ready for PRISM"); } break ; case PYRAMID : switch(NumEntity) { default : Message::Error("BF_Node_3E not ready for PYRAMID"); } break ; default : Message::Error("Unknown type of Element in BF_Node_3E"); break ; } if (Element->GeoElement->NumEdges[NumEntity-1] < 0) *s = -*s ; } #undef WrongNumEntity /* -------- */ /* Facets */ /* -------- */ #define WrongNumEntity Message::Error("Wrong Face number in 'BF_Node_3F'") void BF_Node_3F(struct Element * Element, int NumEntity, double u, double v, double w, double *s) { switch (Element->Type) { case LINE : Message::Error("BF_Node_3F cannot be associated with this type of element"); break; case TRIANGLE : switch(NumEntity) { case 1 : *s = (1.-u-v) * u * v ; break ; default : WrongNumEntity ; } break ; case QUADRANGLE : switch(NumEntity) { default : Message::Error("BF_Node_3F not ready for QUADRANGLE"); } break ; case TETRAHEDRON : switch(NumEntity) { case 1 : *s = (1.-u-v-w) * u * w ; break ; case 2 : *s = (1.-u-v-w) * v * u ; break ; case 3 : *s = (1.-u-v-w) * w * v ; break ; case 4 : *s = u * v * w ; break ; default : WrongNumEntity ; } break ; case HEXAHEDRON : switch(NumEntity) { default : Message::Error("BF_Node_3F not ready for HEXAHEDRON"); } break ; case PRISM : switch(NumEntity) { default : Message::Error("BF_Node_3F not ready for PRISM"); } break ; default : Message::Error("Unknown Element Type in BF_Node_3F"); break ; } } #undef WrongNumEntity /* -------- */ /* Volume */ /* -------- */ void BF_Node_3V(struct Element * Element, int NumEntity, double u, double v, double w, double *s) { switch (Element->Type) { case LINE : case TRIANGLE : case QUADRANGLE : case TETRAHEDRON : Message::Error("BF_Node_3V cannot be associated with this type of element"); break; case HEXAHEDRON : switch(NumEntity) { default : Message::Error("BF_Node_3V not ready for HEXAHEDRON"); } break ; case PRISM : switch(NumEntity) { default : Message::Error("BF_Node_3V not ready for PRISM"); } break ; default : Message::Error("Unknown type of Element in BF_Node_3V"); break ; } } /* ------------------------------------------------------------------------ */ /* B F _ G r a d N o d e _ 3 */ /* ------------------------------------------------------------------------ */ /* ------- */ /* Edges */ /* ------- */ #define WrongNumEntity Message::Error("Wrong Edge number in 'BF_GradNode_3E'") void BF_GradNode_3E(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { switch (Element->Type) { case LINE : switch(NumEntity) { case 1 : s[0] = -0.25 + 0.75 * u * u ; s[1] = 0. ; s[2] = 0. ; break ; default : WrongNumEntity ; } break ; case TRIANGLE : switch(NumEntity) { case 1 : s[0] = 1.0-6.0*u-2.0*v+6.0*u*u+6.0*u*v+v*v ; s[1] = -2.0*u+3.0*u*u+2.0*u*v ; s[2] = 0. ; break ; case 2 : s[0] = -2.0*v+2.0*u*v+3.0*v*v ; s[1] = 1.0-2.0*u-6.0*v+u*u+6.0*u*v+6.0*v*v ; s[2] = 0. ; break ; case 3 : s[0] = 2.0*u*v-v*v ; s[1] = u*u-2.0*u*v ; s[2] = 0. ; break ; default : WrongNumEntity ; } break ; case QUADRANGLE : switch(NumEntity) { default : Message::Error("BF_GradNode_3E not ready for QUADRANGLE"); } break ; case TETRAHEDRON : switch(NumEntity) { case 1 : s[0] = 1.0-6.0*u-2.0*v-2.0*w+6.0*u*u+6.0*u*v+6.0*u*w+v*v+2.0*v*w+w*w ; s[1] = -2.0*u+3.0*u*u+2.0*u*v+2.0*u*w ; s[2] = -2.0*u+3.0*u*u+2.0*u*v+2.0*u*w ; break ; case 2 : s[0] = -2.0*v+2.0*u*v+3.0*v*v+2.0*v*w ; s[1] = 1.0-2.0*u-6.0*v-2.0*w+u*u+6.0*u*v+2.0*u*w+6.0*v*v+6.0*v*w+w*w ; s[2] = -2.0*v+2.0*u*v+3.0*v*v+2.0*v*w ; break ; case 3 : s[0] = -2.0*w+2.0*u*w+2.0*v*w+3.0*w*w ; s[1] = -2.0*w+2.0*u*w+2.0*v*w+3.0*w*w ; s[2] = 1.0-2.0*u-2.0*v-6.0*w+u*u+2.0*u*v+6.0*u*w+v*v+6.0*v*w+6.0*w*w ; break ; case 4 : s[0] = 2.0*u*v-v*v ; s[1] = u*u-2.0*u*v ; s[2] = 0.0 ; break ; case 5 : s[0] = 2.0*u*w-w*w ; s[1] = 0.0 ; s[2] = u*u-2.0*u*w ; break ; case 6 : s[0] = 0.0 ; s[1] = 2.0*v*w-w*w ; s[2] = v*v-2.0*v*w ; break ; default : WrongNumEntity ; } break ; case HEXAHEDRON : switch(NumEntity) { default : Message::Error("BF_GradNode_3E not ready for HEXAHEDRON"); } break ; case PRISM : switch(NumEntity) { default : Message::Error("BF_GradNode_3E not ready for PRISM"); } break ; default : Message::Error("Unknown type of Element in BF_GradNode_3E"); break ; } if (Element->GeoElement->NumEdges[NumEntity-1] < 0) { s[0] = - s[0] ; s[1] = - s[1] ; s[2] = - s[2] ; } } #undef WrongNumEntity /* -------- */ /* Facets */ /* -------- */ #define WrongNumEntity Message::Error("Wrong Face number in 'BF_GradNode_3F'") void BF_GradNode_3F(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { switch (Element->Type) { case LINE : Message::Error("BF_GradNode_3F cannot be associated with this type of element"); break ; case TRIANGLE : switch(NumEntity) { case 1 : s[0] = v-2.0*u*v-v*v ; s[1] = u-u*u-2.0*u*v ; s[2] = 0. ; break ; default : WrongNumEntity ; } break ; case QUADRANGLE : switch(NumEntity) { default : Message::Error("BF_GradNode_3F not ready for QUADRANGLE"); } break ; case TETRAHEDRON : switch(NumEntity) { case 1 : s[0] = w-2.0*u*w-v*w-w*w ; s[1] = -u*w ; s[2] = u-u*u-u*v-2.0*u*w ; break ; case 2 : s[0] = v-2.0*u*v-v*v-v*w ; s[1] = u-u*u-2.0*u*v-u*w ; s[2] = -u*v ; break ; case 3 : s[0] = -v*w ; s[1] = w-u*w-2.0*v*w-w*w ; s[2] = v-u*v-v*v-2.0*v*w ; break ; case 4 : s[0] = v*w ; s[1] = u*w ; s[2] = u*v ; break ; default : WrongNumEntity ; } break ; case HEXAHEDRON : switch(NumEntity) { default : Message::Error("BF_GradNode_3F not ready for HEXAHEDRON"); } break ; case PRISM : switch(NumEntity) { default : Message::Error("BF_GradNode_3F not ready for PRISM"); } break ; default : Message::Error("Unknown type of Element in BF_GradNode_3F"); break ; } } #undef WrongNumEntity /* -------- */ /* Volume */ /* -------- */ void BF_GradNode_3V(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { switch (Element->Type) { case LINE : case TRIANGLE : case QUADRANGLE : case TETRAHEDRON : Message::Error("BF_GradNode_3V cannot be associated with this type of element"); break; case HEXAHEDRON : switch(NumEntity) { default : Message::Error("BF_GradNode_3V not ready for HEXAHEDRON"); } break ; case PRISM : switch(NumEntity) { default : Message::Error("BF_GradNode_3V not ready for PRISM"); } break ; default : Message::Error("Unknown type of Element in BF_GradNode_3V"); break ; } } getdp-2.7.0-source/Legacy/GF_Helmholtz.cpp000644 001750 001750 00000020267 12473553042 022047 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Ruth Sabariego // #include #include "ProData.h" #include "GF.h" #include "Cal_Value.h" #include "GeoData.h" #include "Message.h" #define SQU(a) ((a)*(a)) #define CUB(a) ((a)*(a)*(a)) #define ONE_OVER_FOUR_PI 7.9577471545947668E-02 extern struct CurrentData Current ; /* ------------------------------------------------------------------------ */ /* G F _ H e l m h o l t z */ /* ------------------------------------------------------------------------ */ void GF_Helmholtz(GF_ARG) { double r, kr ; if(Current.NbrHar != 2) Message::Error("Wrong Number of Harmonics in 'GF_Helmholtz'"); V->Type = SCALAR ; switch((int)Fct->Para[0]){ case _2D : r = sqrt(SQU(Current.x-Current.xs)+ SQU(Current.y-Current.ys) ) ; if(!r) Message::Error("1/0 in 'GF_Helmholtz'") ; kr = Fct->Para[1]*r; V->Val[0] = -y0(kr)/4 ; V->Val[MAX_DIM] = -j0(kr)/4 ; break ; case _3D : r = sqrt(SQU(Current.x-Current.xs)+ SQU(Current.y-Current.ys)+ SQU(Current.z-Current.zs)) ; if(!r) Message::Error("1/0 in 'GF_Helmholtz'") ; kr = Fct->Para[1]*r; V->Val[0] = ONE_OVER_FOUR_PI * cos(kr) / r ; V->Val[MAX_DIM] = -ONE_OVER_FOUR_PI * sin(kr) / r ; break ; default : Message::Error("Bad Parameter for 'GF_Helmholtz' (%d)", (int)Fct->Para[0]); break; } } /* ------------------------------------------------------------------------ */ /* G F _ H e l m h o l t z T h i n W i r e */ /* ------------------------------------------------------------------------ */ void GF_HelmholtzThinWire(GF_ARG) { double a , r, kr ; if(Current.NbrHar != 2) Message::Error("Wrong Number of Harmonics in 'GF_HelmholtzThinWire'"); V->Type = SCALAR ; switch((int)Fct->Para[0]){ case _2D : a = Fct->Para[2] ; r = sqrt(SQU(Current.x-Current.xs)+ SQU(Current.y-Current.ys)+SQU(a)) ; if(!r) Message::Error("1/0 in 'GF_HelmholtzThinWire'") ; kr = Fct->Para[1]*r; V->Val[0] = -y0(kr)/4 ; V->Val[MAX_DIM] = -j0(kr)/4 ; break ; case _3D : a = Fct->Para[2] ; r = sqrt(SQU(Current.x-Current.xs)+ SQU(Current.y-Current.ys)+ SQU(Current.z-Current.zs)+SQU(a)) ; if(!r) Message::Error("1/0 in 'GF_HelmholtzThinWire'") ; kr = Fct->Para[1]*r; V->Val[0] = ONE_OVER_FOUR_PI * cos(kr) / r ; V->Val[MAX_DIM] = -ONE_OVER_FOUR_PI * sin(kr) / r ; break ; default : Message::Error("Bad Parameter for 'GF_HelmholtzThinWire' (%d)", (int)Fct->Para[0]); break; } } /* ------------------------------------------------------------------------ */ /* G F _ G r a d H e l m h o l t z */ /* ------------------------------------------------------------------------ */ /* the gradient is taken relative to the destination point (x,y,z) */ void GF_GradHelmholtz(GF_ARG) { double xxs, yys, zzs, r, kr, k0r ; double c1, c2, cr, ci ; if(Current.NbrHar != 2) Message::Error("Wrong Number of Harmonics in 'GF_GradHelmholtz'"); V->Type = VECTOR ; switch((int)Fct->Para[0]){ case _2D : xxs = Current.x-Current.xs ; yys = Current.y-Current.ys ; r = sqrt(SQU(xxs)+SQU(yys)) ; k0r = Fct->Para[1]*r; if (!r) Cal_ZeroValue(V); else { c1 = Fct->Para[1]/4/r ; cr = c1 * y1(k0r); ci = c1 * j1(k0r); V->Val[0] = xxs * cr ; V->Val[MAX_DIM ] = xxs * ci ; V->Val[1] = yys * cr ; V->Val[MAX_DIM+1] = yys * ci ; } break ; case _3D : xxs = Current.x-Current.xs ; yys = Current.y-Current.ys ; zzs = Current.z-Current.zs ; r = sqrt(SQU(xxs)+SQU(yys)+SQU(zzs)) ; kr = Fct->Para[1] * r ; if (!r) Cal_ZeroValue(V); else { c1 = - ONE_OVER_FOUR_PI / CUB(r) ; c2 = ONE_OVER_FOUR_PI * Fct->Para[1] / SQU(r) ; cr = c1 * cos(kr) - c2 * sin(kr) ; ci = -c1 * sin(kr) - c2 * cos(kr) ; V->Val[0] = xxs * cr ; V->Val[MAX_DIM ] = xxs * ci ; V->Val[1] = yys * cr ; V->Val[MAX_DIM+1] = yys * ci ; V->Val[2] = zzs * cr ; V->Val[MAX_DIM+2] = zzs * ci ; } break ; default : Message::Error("Bad Parameter for 'GF_GradHelmholtz' (%d)", (int)Fct->Para[0]); break; } } /* ------------------------------------------------------------------------ */ /* G F _ N P x G r a d H e l m h o l t z */ /* ------------------------------------------------------------------------ */ void GF_NPxGradHelmholtz(GF_ARG) { double N[3] ; struct Value ValGrad ; /* Vectorial product N[] /\ Grad G */ if(Current.NbrHar != 2) Message::Error("Wrong Number of Harmonics in 'GF_NPxGradHelmholtz'"); V->Type = VECTOR ; if (Current.Element->Num == Current.ElementSource->Num) { Cal_ZeroValue(V); return ; } switch((int)Fct->Para[0]){ case _3D : Geo_CreateNormal(Current.Element->Type, Current.Element->x,Current.Element->y,Current.Element->z, N); GF_GradHelmholtz(Fct, &ValGrad, &ValGrad) ; V->Val[0] = N[1]*ValGrad.Val[2] - N[2]*ValGrad.Val[1]; V->Val[1] =-N[0]*ValGrad.Val[2] + N[2]*ValGrad.Val[0]; V->Val[2] = N[0]*ValGrad.Val[1] - N[1]*ValGrad.Val[0]; V->Val[MAX_DIM ] = N[1]*ValGrad.Val[MAX_DIM+2] - N[2]*ValGrad.Val[MAX_DIM+1]; V->Val[MAX_DIM+1] =-N[0]*ValGrad.Val[MAX_DIM+2] + N[2]*ValGrad.Val[MAX_DIM]; V->Val[MAX_DIM+2] = N[0]*ValGrad.Val[MAX_DIM+1] - N[1]*ValGrad.Val[MAX_DIM]; break ; default : Message::Error("Bad Parameter for 'GF_NPxGradHelmholtz' (%d)", (int)Fct->Para[0]); break; } } /* ------------------------------------------------------------------------ */ /* G F _ N S x G r a d H e l m h o l t z */ /* ------------------------------------------------------------------------ */ void GF_NSxGradHelmholtz(GF_ARG) { double x1x0, x2x0, y1y0, y2y0, z1z0, z2z0, xxs, yys, zzs, r ; double nx, ny, nz, n, c1, c2, cr, ci ; if(Current.NbrHar != 2) Message::Error("Wrong Number of Harmonics in 'GF_NSxGradHelmholtz'"); V->Type = SCALAR ; switch((int)Fct->Para[0]){ case _2D : xxs = Current.x-Current.xs ; yys = Current.y-Current.ys ; r = sqrt(SQU(xxs)+SQU(yys)) ; if(Current.Element->Num == NO_ELEMENT) Current.Element = Current.ElementSource ; ny = - Current.Element->x[1] + Current.Element->x[0] ; nx = Current.Element->y[1] - Current.Element->y[0] ; n = sqrt(SQU(nx)+SQU(ny)) ; nx = nx / n ; ny = ny / n ; if (!r) Cal_ZeroValue(V); else { c1 = Fct->Para[1]/4/r ; cr = c1 * y1(Fct->Para[1]*r); ci = c1 * j1(Fct->Para[1]*r); V->Val[0] = nx * xxs * cr + ny * yys * cr ; V->Val[MAX_DIM ] = nx * xxs * ci + ny * yys * ci ; } break ; case _3D : xxs = Current.x-Current.xs ; yys = Current.y-Current.ys ; zzs = Current.z-Current.zs ; r = sqrt(SQU(xxs)+SQU(yys)+SQU(zzs)) ; if (!r) Cal_ZeroValue(V); else { x1x0 = Current.Element->x[1] - Current.Element->x[0] ; y1y0 = Current.Element->y[1] - Current.Element->y[0] ; z1z0 = Current.Element->z[1] - Current.Element->z[0] ; x2x0 = Current.Element->x[2] - Current.Element->x[0] ; y2y0 = Current.Element->y[2] - Current.Element->y[0] ; z2z0 = Current.Element->z[2] - Current.Element->z[0] ; nx = y1y0 * z2z0 - z1z0 * y2y0 ; ny = z1z0 * x2x0 - x1x0 * z2z0 ; nz = x1x0 * y2y0 - y1y0 * x2x0 ; n = sqrt(SQU(nx)+SQU(ny)+SQU(nz)) ; nx = nx/n ; ny = ny/n ; nz = nz/n ; c1 = - ONE_OVER_FOUR_PI / CUB(r) ; c2 = ONE_OVER_FOUR_PI * Fct->Para[1] / SQU(r) ; cr = (c1 * cos(Fct->Para[1]*r) - c2 * sin(Fct->Para[1]*r)) ; ci = (c1 * sin(Fct->Para[1]*r) + c2 * cos(Fct->Para[1]*r)) ; V->Val[0] =nx * xxs * cr + ny * yys * cr + nz * zzs * cr ; V->Val[MAX_DIM ] = nx* xxs * ci + ny * yys * ci + nz * zzs * ci; } break ; default : Message::Error("Bad Parameter for 'GF_NSxGradHelmholtz' (%d)", (int)Fct->Para[0]); break; } } getdp-2.7.0-source/Legacy/Pos_Print.h000644 001750 001750 00000001631 12473553042 021101 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _POS_PRINT_H_ #define _POS_PRINT_H_ #include "ProData.h" #define ARG struct PostQuantity *NCPQ_P, \ struct PostQuantity *CPQ_P, \ int Order, \ struct DefineQuantity *DefineQuantity_P0, \ struct QuantityStorage *QuantityStorage_P0, \ struct PostSubOperation *PostSubOperation_P void Pos_PrintOnRegion (ARG); void Pos_PrintOnElementsOf (ARG); void Pos_PrintOnSection (ARG); void Pos_PrintOnGrid (ARG); void Pos_PrintWithArgument (ARG); #undef ARG void Pos_PrintGroup(struct PostSubOperation *PostSubOperation_P); void Pos_PrintExpression(struct PostSubOperation *PostSubOperation_P); #endif getdp-2.7.0-source/Legacy/EigenSolve_SLEPC.cpp000644 001750 001750 00000066047 12542221511 022507 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "GetDPConfig.h" #if defined(HAVE_SLEPC) // SLEPc interface for solving eigenvalue problems // // SLEPc can solve both linear and quadratic eigenvalue // problems. SLEPc options can be specified in the .petscrc file, or // directly on the command line. // // For example, to use MUMPs for a linear evp: // -eps_type krylovschur // -st_ksp_type preonly -st_pc_type lu // -st_pc_factor_mat_solver_package mumps // // With SLEPc < 3.5, to solve a quadratic evp by linearization, using the first // canonic form, and building the operator explicitly so we can use a direct // solver: // -qep_type linear -qep_linear_cform 1 -qep_linear_explicitmatrix // -qep_eps_type krylovschur // -qep_st_ksp_type preonly -qep_st_pc_type lu // -qep_st_pc_factor_mat_solver_package mumps // Or to solve the quadratic evp directly using arnoldi iter: // -qep_type qarnoldi -qep_eps_type krylovschur // -qep_st_ksp_type gmres -qep_st_pc_type ilu // // SLEPc >= 3.5 options are similar, but with pep instead of qep #include #include #include #include #include "ProData.h" #include "DofData.h" #include "Cal_Quantity.h" #include "Message.h" #include "MallocUtils.h" #include #if (PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR < 5) #include #else #include #endif extern struct CurrentData Current ; extern void _fillseq(Vec &V, Vec &Vseq); // from LinAlg_PETsc.cpp static void _try(int ierr){ CHKERRABORT(PETSC_COMM_WORLD, ierr); } static PetscErrorCode _myMonitor(const char *str, int its, int nconv, PetscScalar *eigr, PetscScalar *eigi, PetscReal* errest) { if(!its) return 0; std::ostringstream sstream; sstream << " " << its << " " << str << " nconv=" << nconv << " first unconverged value " #if defined(PETSC_USE_COMPLEX) << PetscRealPart(eigr[nconv]) << " + i * (" << PetscImaginaryPart(eigr[nconv]) << ")" #else << eigr[nconv] << " + i * (" << eigi[nconv] << ")" #endif << " error " << errest[nconv]; Message::Info("%s", sstream.str().c_str()); return 0; } static PetscErrorCode _myEpsMonitor(EPS eps, int its, int nconv, PetscScalar *eigr, PetscScalar *eigi, PetscReal* errest, int nest, void *mctx) { return _myMonitor("EPS", its, nconv, eigr, eigi, errest); } #if (PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR < 5) static PetscErrorCode _myQepMonitor(QEP qep, int its, int nconv, PetscScalar *eigr, PetscScalar *eigi, PetscReal* errest, int nest, void *mctx) { return _myMonitor("QEP", its, nconv, eigr, eigi, errest); } #else static PetscErrorCode _myPepMonitor(PEP pep, int its, int nconv, PetscScalar *eigr, PetscScalar *eigi, PetscReal* errest, int nest, void *mctx) { return _myMonitor("PEP", its, nconv, eigr, eigi, errest); } #endif static void _storeEigenVectors(struct DofData *DofData_P, int nconv, EPS eps, #if (PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR < 5) QEP qep, #else PEP pep, #endif int filterExpressionIndex) { if (nconv <= 0) return; // temporary (parallel) vectors to store real and imaginary part of eigenvectors Vec xr, xi; #if (PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR < 6) _try(MatGetVecs(DofData_P->M1.M, PETSC_NULL, &xr)); _try(MatGetVecs(DofData_P->M1.M, PETSC_NULL, &xi)); #else _try(MatCreateVecs(DofData_P->M1.M, PETSC_NULL, &xr)); _try(MatCreateVecs(DofData_P->M1.M, PETSC_NULL, &xi)); #endif // temporary sequential vectors to transfer eigenvectors to getdp Vec xr_seq, xi_seq; if(Message::GetCommSize() > 1){ PetscInt n; _try(VecGetSize(xr, &n)); _try(VecCreateSeq(PETSC_COMM_SELF, n, &xr_seq)); _try(VecCreateSeq(PETSC_COMM_SELF, n, &xi_seq)); } Message::Info(" %-24s%-24s%-12s", "Re", "Im", "Relative error"); bool newsol = false; for (int i = 0; i < nconv; i++){ PetscScalar kr, ki; PetscReal error; if(eps){ _try(EPSGetEigenpair(eps, i, &kr, &ki, xr, xi)); #if (PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR < 6) _try(EPSComputeRelativeError(eps, i, &error)); #else _try(EPSComputeError(eps, i, EPS_ERROR_RELATIVE, &error)); #endif } else{ #if (PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR < 5) _try(QEPGetEigenpair(qep, i, &kr, &ki, xr, xi)); _try(QEPComputeRelativeError(qep, i, &error)); #else _try(PEPGetEigenpair(pep, i, &kr, &ki, xr, xi)); #if (PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR < 6) _try(PEPComputeRelativeError(pep, i, &error)); #else _try(PEPComputeError(pep, i, PEP_ERROR_RELATIVE, &error)); #endif #endif } #if defined(PETSC_USE_COMPLEX) PetscReal re = PetscRealPart(kr), im = PetscImaginaryPart(kr); #else PetscReal re = kr, im = ki; #endif double ore, oim; if(eps){ Message::Info("EIG %03d w^2 = %s%.16e %s%.16e %3.6e", i, (re < 0) ? "" : " ", re, (im < 0) ? "" : " ", im, error); double abs = sqrt(re * re + im * im), arg = atan2(im, re); ore = sqrt(abs) * cos(0.5*arg); oim = sqrt(abs) * sin(0.5*arg); double fre = ore / 2. / M_PI, fim = oim / 2. / M_PI; Message::Info(" w = %s%.16e %s%.16e", (ore < 0) ? "" : " ", ore, (oim < 0) ? "" : " ", oim); Message::Info(" f = %s%.16e %s%.16e", (fre < 0) ? "" : " ", fre, (fim < 0) ? "" : " ", fim); } else{ // lambda == iw ore = im; oim = -re; Message::Info("EIG %03d w = %s%.16e %s%.16e %3.6e", i, (ore < 0) ? "" : " ", ore, (oim < 0) ? "" : " ", oim, error); double fre = ore / 2. / M_PI, fim = oim / 2. / M_PI; Message::Info(" f = %s%.16e %s%.16e", (fre < 0) ? "" : " ", fre, (fim < 0) ? "" : " ", fim); } // update the current value of Time and TimeImag so that // $EigenvalueReal and $EigenvalueImag are up-to-date Current.Time = ore; Current.TimeImag = oim; // test filter expression and continue without storing if false if(filterExpressionIndex >= 0){ struct Value val; Get_ValueOfExpressionByIndex(filterExpressionIndex, NULL, 0., 0., 0., &val); if(!val.Val[0]){ Message::Debug("Skipping eigenvalue %g + i * %g", ore, oim); continue; } } Message::AddOnelabNumberChoice(Message::GetOnelabClientName() + "/Re(Omega)", ore); Message::AddOnelabNumberChoice(Message::GetOnelabClientName() + "/Im(Omega)", oim); // create new solution vector if necessary if(newsol) { struct Solution Solution_S; Solution_S.TimeFunctionValues = NULL; LinAlg_CreateVector(&Solution_S.x, &DofData_P->Solver, DofData_P->NbrDof); List_Add(DofData_P->Solutions, &Solution_S); DofData_P->CurrentSolution = (struct Solution*) List_Pointer(DofData_P->Solutions, List_Nbr(DofData_P->Solutions)-1); } newsol = true; DofData_P->CurrentSolution->Time = ore; DofData_P->CurrentSolution->TimeImag = oim; DofData_P->CurrentSolution->TimeStep = (int)Current.TimeStep; Free(DofData_P->CurrentSolution->TimeFunctionValues); DofData_P->CurrentSolution->TimeFunctionValues = NULL; DofData_P->CurrentSolution->SolutionExist = 1; // store eigenvector PetscScalar *tmpr, *tmpi; if(Message::GetCommSize() == 1){ _try(VecGetArray(xr, &tmpr)); _try(VecGetArray(xi, &tmpi)); } else{ _fillseq(xr, xr_seq); _fillseq(xi, xi_seq); _try(VecGetArray(xr_seq, &tmpr)); _try(VecGetArray(xi_seq, &tmpi)); } int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; for(int l = 0; l < DofData_P->NbrDof; l += incr){ #if defined(PETSC_USE_COMPLEX) double var_r = (double)PetscRealPart(tmpr[l]); double var_i = (double)PetscImaginaryPart(tmpr[l]); #else double var_r = (double)tmpr[l]; double var_i = (double)tmpi[l]; #endif if(Current.NbrHar == 2) LinAlg_SetComplexInVector(var_r, var_i, &DofData_P->CurrentSolution->x, l, l+1); else LinAlg_SetDoubleInVector(var_r, &DofData_P->CurrentSolution->x, l); } if(Message::GetCommSize() == 1){ _try(VecRestoreArray(xr, &tmpr)); _try(VecRestoreArray(xi, &tmpi)); } else{ _try(VecRestoreArray(xr_seq, &tmpr)); _try(VecRestoreArray(xi_seq, &tmpi)); } LinAlg_AssembleVector(&DofData_P->CurrentSolution->x); // SLEPc returns eigenvectors normalized in L-2 norm. Renormalize them in // L-infty norm so that the absolute value of the largest element is 1 double norm = 0; LinAlg_VectorNormInf(&DofData_P->CurrentSolution->x, &norm); if(norm > 1.e-16) LinAlg_ProdVectorDouble(&DofData_P->CurrentSolution->x, 1. / norm, &DofData_P->CurrentSolution->x); // increment the global timestep counter so that a future // GenerateSystem knows which solutions exist Current.TimeStep += 1.; } #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) _try(VecDestroy(&xr)); _try(VecDestroy(&xi)); if(Message::GetCommSize() > 1){ _try(VecDestroy(&xr_seq)); _try(VecDestroy(&xi_seq)); } #else _try(VecDestroy(xr)); _try(VecDestroy(xi)); if(Message::GetCommSize() > 1){ _try(VecDestroy(xr_seq)); _try(VecDestroy(xi_seq)); } #endif } static void _linearEVP(struct DofData * DofData_P, int numEigenValues, double shift_r, double shift_i, int filterExpressionIndex) { Message::Info("Solving linear eigenvalue problem"); // GetDP notation: -w^2 M3 x (+ iw M2 x) + M1 x = 0 // SLEPC notation for generalized linear EVP: A x - \lambda B x = 0 Mat A = DofData_P->M1.M; Mat B = DofData_P->M3.M; EPS eps; _try(EPSCreate(PETSC_COMM_WORLD, &eps)); _try(EPSSetOperators(eps, A, B)); _try(EPSSetProblemType(eps, EPS_GNHEP)); // set some default options _try(EPSSetDimensions(eps, numEigenValues, PETSC_DECIDE, PETSC_DECIDE)); _try(EPSSetTolerances(eps, 1.e-6, 100)); _try(EPSSetType(eps, EPSKRYLOVSCHUR)); _try(EPSSetWhichEigenpairs(eps, EPS_SMALLEST_MAGNITUDE)); _try(EPSMonitorSet(eps, _myEpsMonitor, PETSC_NULL, PETSC_NULL)); // override these options at runtime, petsc-style _try(EPSSetFromOptions(eps)); // force options specified directly as arguments if(numEigenValues) _try(EPSSetDimensions(eps, numEigenValues, PETSC_DECIDE, PETSC_DECIDE)); ST st; _try(EPSGetST(eps, &st)); _try(STSetType(st, STSINVERT)); // apply shift-and-invert transformation if(shift_r || shift_i){ #if defined(PETSC_USE_COMPLEX) PetscScalar shift = shift_r + PETSC_i * shift_i; #else PetscScalar shift = shift_r; if(shift_i) Message::Warning("Imaginary part of shift discarded: use PETSc with complex numbers"); #endif //_try(STSetShift(st, shift)); _try(EPSSetTarget(eps, shift)); _try(EPSSetWhichEigenpairs(eps, EPS_TARGET_MAGNITUDE)); } KSP ksp; _try(STGetKSP(st, &ksp)); _try(KSPSetType(ksp, "preonly")); PC pc; _try(KSPGetPC(ksp, &pc)); _try(PCSetType(pc, PCLU)); #if (PETSC_VERSION_MAJOR > 2) && defined(PETSC_HAVE_MUMPS) _try(PCFactorSetMatSolverPackage(pc, "mumps")); #endif // print info #if (PETSC_VERSION_RELASE == 0) || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR == 4)) const char *type = ""; #else const EPSType type; #endif _try(EPSGetType(eps, &type)); Message::Info("SLEPc solution method: %s", type); PetscInt nev; _try(EPSGetDimensions(eps, &nev, PETSC_NULL, PETSC_NULL)); Message::Info("SLEPc number of requested eigenvalues: %d", nev); PetscReal tol; PetscInt maxit; _try(EPSGetTolerances(eps, &tol, &maxit)); Message::Info("SLEPc stopping condition: tol=%g, maxit=%d", tol, maxit); // solve Message::Info("SLEPc solving..."); _try(EPSSolve(eps)); // check convergence int its; _try(EPSGetIterationNumber(eps, &its)); EPSConvergedReason reason; _try(EPSGetConvergedReason(eps, &reason)); if(reason == EPS_CONVERGED_TOL) Message::Info("SLEPc converged in %d iterations", its); else if(reason == EPS_DIVERGED_ITS) Message::Error("SLEPc diverged after %d iterations", its); else if(reason == EPS_DIVERGED_BREAKDOWN) Message::Error("SLEPc generic breakdown in method"); #if !(PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) else if(reason == EPS_DIVERGED_NONSYMMETRIC) Message::Error("The operator is nonsymmetric"); #endif // get number of converged approximate eigenpairs PetscInt nconv; _try(EPSGetConverged(eps, &nconv)); Message::Info("SLEPc number of converged eigenpairs: %d", nconv); // ignore additional eigenvalues if we get more than what we asked if(nconv > nev) nconv = nev; // print eigenvalues and store eigenvectors in DofData _storeEigenVectors(DofData_P, nconv, eps, PETSC_NULL, filterExpressionIndex); #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) _try(EPSDestroy(&eps)); #else _try(EPSDestroy(eps)); #endif } #if (PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR < 5) // SLEPc < 3.5 interface using QEP static void _quadraticEVP(struct DofData * DofData_P, int numEigenValues, double shift_r, double shift_i, int filterExpressionIndex) { Message::Info("Solving quadratic eigenvalue problem using QEP"); // GetDP notation: -w^2 M3 x + iw M2 x + M1 x = 0 // SLEPC notations for quadratic EVP: (\lambda^2 M + \lambda C + K) x = 0 Mat M = DofData_P->M3.M; Mat C = DofData_P->M2.M; Mat K = DofData_P->M1.M; QEP qep; _try(QEPCreate(PETSC_COMM_WORLD, &qep)); _try(QEPSetOperators(qep, M, C, K)); _try(QEPSetProblemType(qep, QEP_GENERAL)); // set some default options _try(QEPSetDimensions(qep, numEigenValues, PETSC_DECIDE, PETSC_DECIDE)); _try(QEPSetTolerances(qep, 1.e-6, 100)); _try(QEPSetType(qep, QEPLINEAR)); _try(QEPSetWhichEigenpairs(qep, QEP_SMALLEST_MAGNITUDE)); _try(QEPMonitorSet(qep, _myQepMonitor, PETSC_NULL, PETSC_NULL)); // if we linearize we can set additional options #if (PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR == 4) const char *type = ""; #else const QEPType type; #endif _try(QEPGetType(qep, &type)); if(!strcmp(type, QEPLINEAR)){ EPS eps; _try(QEPLinearGetEPS(qep, &eps)); _try(EPSSetType(eps, EPSKRYLOVSCHUR)); ST st; _try(EPSGetST(eps, &st)); _try(STSetType(st, STSINVERT)); // apply shift-and-invert transformation if(shift_r || shift_i){ #if defined(PETSC_USE_COMPLEX) PetscScalar shift = shift_r + PETSC_i * shift_i; #else PetscScalar shift = shift_r; if(shift_i) Message::Warning("Imaginary part of shift discarded: use PETSc with complex numbers"); #endif _try(EPSSetTarget(eps, shift)); _try(EPSSetWhichEigenpairs(eps, EPS_TARGET_MAGNITUDE)); } _try(QEPLinearSetExplicitMatrix(qep, PETSC_TRUE)); Message::Info("SLEPc forcing explicit construction of matrix"); KSP ksp; _try(STGetKSP(st, &ksp)); _try(KSPSetType(ksp, "preonly")); PC pc; _try(KSPGetPC(ksp, &pc)); _try(PCSetType(pc, PCLU)); #if (PETSC_VERSION_MAJOR > 2) && defined(PETSC_HAVE_MUMPS) _try(PCFactorSetMatSolverPackage(pc, "mumps")); #endif } // override these options at runtime, if necessary _try(QEPSetFromOptions(qep)); // force options specified directly as arguments if(numEigenValues) _try(QEPSetDimensions(qep, numEigenValues, PETSC_DECIDE, PETSC_DECIDE)); // print info Message::Info("SLEPc solution method: %s", type); PetscInt nev; _try(QEPGetDimensions(qep, &nev, PETSC_NULL, PETSC_NULL)); Message::Info("SLEPc number of requested eigenvalues: %d", nev); PetscReal tol; PetscInt maxit; _try(QEPGetTolerances(qep, &tol, &maxit)); Message::Info("SLEPc stopping condition: tol=%g, maxit=%d", tol, maxit); // solve _try(QEPSolve(qep)); // check convergence int its; _try(QEPGetIterationNumber(qep, &its)); QEPConvergedReason reason; _try(QEPGetConvergedReason(qep, &reason)); if(reason == QEP_CONVERGED_TOL) Message::Info("SLEPc converged in %d iterations", its); else if(reason == QEP_DIVERGED_ITS) Message::Error("SLEPc diverged after %d iterations", its); else if(reason == QEP_DIVERGED_BREAKDOWN) Message::Error("SLEPc generic breakdown in method"); else if(reason == QEP_CONVERGED_ITERATING) Message::Error("QEP converged interating"); // get number of converged approximate eigenpairs PetscInt nconv; _try(QEPGetConverged(qep, &nconv)); Message::Info("SLEPc number of converged eigenpairs: %d", nconv); // ignore additional eigenvalues if we get more than what we asked if(nconv > nev) nconv = nev; // print eigenvalues and store eigenvectors in DofData _storeEigenVectors(DofData_P, nconv, PETSC_NULL, qep, filterExpressionIndex); #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) _try(QEPDestroy(&qep)); #else _try(QEPDestroy(qep)); #endif } #else // SLEPc >= 3.5 interface using PEP static void _quadraticEVP(struct DofData * DofData_P, int numEigenValues, double shift_r, double shift_i, int filterExpressionIndex) { Message::Info("Solving quadratic eigenvalue problem using PEP"); // GetDP notation: -w^2 M3 x + iw M2 x + M1 x = 0 // SLEPC notations for quadratic EVP: (\lambda^2 A[2] + \lambda A[1] + A[0]) x = 0 Mat A[3] = {DofData_P->M1.M, DofData_P->M2.M, DofData_P->M3.M}; PEP pep; _try(PEPCreate(PETSC_COMM_WORLD, &pep)); _try(PEPSetOperators(pep, 3, A)); _try(PEPSetProblemType(pep, PEP_GENERAL)); // set some default options _try(PEPSetDimensions(pep, numEigenValues, PETSC_DECIDE, PETSC_DECIDE)); _try(PEPSetTolerances(pep, 1.e-6, 100)); _try(PEPSetType(pep, PEPLINEAR)); _try(PEPSetWhichEigenpairs(pep, PEP_SMALLEST_MAGNITUDE)); _try(PEPMonitorSet(pep, _myPepMonitor, PETSC_NULL, PETSC_NULL)); // if we linearize we can set additional options const char *type = ""; _try(PEPGetType(pep, &type)); if(!strcmp(type, PEPLINEAR)){ EPS eps; _try(PEPLinearGetEPS(pep, &eps)); _try(EPSSetType(eps, EPSKRYLOVSCHUR)); ST st; _try(EPSGetST(eps, &st)); _try(STSetType(st, STSINVERT)); if(shift_r || shift_i){ #if defined(PETSC_USE_COMPLEX) PetscScalar shift = shift_r + PETSC_i * shift_i; #else PetscScalar shift = shift_r; if(shift_i) Message::Warning("Imaginary part of shift discarded: use PETSc with complex numbers"); #endif _try(EPSSetTarget(eps, shift)); _try(EPSSetWhichEigenpairs(eps, EPS_TARGET_MAGNITUDE)); } _try(PEPLinearSetExplicitMatrix(pep, PETSC_TRUE)); Message::Info("SLEPc forcing explicit construction of matrix"); KSP ksp; _try(STGetKSP(st, &ksp)); _try(KSPSetType(ksp, "preonly")); PC pc; _try(KSPGetPC(ksp, &pc)); _try(PCSetType(pc, PCLU)); #if (PETSC_VERSION_MAJOR > 2) && defined(PETSC_HAVE_MUMPS) _try(PCFactorSetMatSolverPackage(pc, "mumps")); #endif } #if (PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR < 6) _try(PEPSetScale(pep, PEP_SCALE_SCALAR, PETSC_DECIDE, PETSC_DECIDE, PETSC_DECIDE)); #else _try(PEPSetScale(pep, PEP_SCALE_SCALAR, PETSC_DECIDE, PETSC_NULL, PETSC_NULL, PETSC_DECIDE, PETSC_DECIDE)); #endif // override these options at runtime, petsc-style _try(PEPSetFromOptions(pep)); // force options specified directly as arguments if(numEigenValues){ _try(PEPSetDimensions(pep, numEigenValues, PETSC_DECIDE, PETSC_DECIDE)); } // print info Message::Info("SLEPc solution method: %s", type); PetscInt nev; _try(PEPGetDimensions(pep, &nev, PETSC_NULL, PETSC_NULL)); Message::Info("SLEPc number of requested eigenvalues: %d", nev); PetscReal tol; PetscInt maxit; _try(PEPGetTolerances(pep, &tol, &maxit)); Message::Info("SLEPc stopping condition: tol=%g, maxit=%d", tol, maxit); // solve _try(PEPSolve(pep)); // check convergence int its; _try(PEPGetIterationNumber(pep, &its)); PEPConvergedReason reason; _try(PEPGetConvergedReason(pep, &reason)); if(reason == PEP_CONVERGED_TOL) Message::Info("SLEPc converged in %d iterations", its); else if(reason == PEP_DIVERGED_ITS) Message::Error("SLEPc diverged after %d iterations", its); else if(reason == PEP_DIVERGED_BREAKDOWN) Message::Error("SLEPc generic breakdown in method"); // get number of converged approximate eigenpairs PetscInt nconv; _try(PEPGetConverged(pep, &nconv)); Message::Info("SLEPc number of converged eigenpairs: %d", nconv); // ignore additional eigenvalues if we get more than what we asked if(nconv > nev) nconv = nev; // print eigenvalues and store eigenvectors in DofData _storeEigenVectors(DofData_P, nconv, PETSC_NULL, pep, filterExpressionIndex); _try(PEPDestroy(&pep)); } static void _polynomialEVP(struct DofData * DofData_P, int numEigenValues, double shift_r, double shift_i, int filterExpressionIndex) { Message::Info("Solving polynomial eigenvalue problem using PEP"); PEP pep; _try(PEPCreate(PETSC_COMM_WORLD, &pep)); if(DofData_P->Flag_Init[6]){ Message::Info("Solving polynomial i*w^5 M6 x + w^4 M5 x + -iw^3 M4 x +" " -w^2 M3 x + iw M2 x + M1 x = 0 eigenvalue problem using PEP"); Mat A[6] = {DofData_P->M1.M, DofData_P->M2.M, DofData_P->M3.M, DofData_P->M4.M, DofData_P->M5.M, DofData_P->M6.M}; _try(PEPSetOperators(pep, 6, A)); } if(DofData_P->Flag_Init[5] && !DofData_P->Flag_Init[6]){ Message::Info("Solving polynomial w^4 M5 x + -iw^3 M4 x + -w^2 M3 x + " "iw M2 x + M1 x = 0 eigenvalue problem using PEP"); Mat A[5] = {DofData_P->M1.M, DofData_P->M2.M, DofData_P->M3.M, DofData_P->M4.M, DofData_P->M5.M}; _try(PEPSetOperators(pep, 5, A)); } if(!DofData_P->Flag_Init[5] && !DofData_P->Flag_Init[6]){ Message::Info("Solving polynomial -iw^3 M4 x + -w^2 M3 x + iw M2 x + " "M1 x = 0 eigenvalue problem using PEP"); Mat A[4] = {DofData_P->M1.M, DofData_P->M2.M, DofData_P->M3.M, DofData_P->M4.M}; _try(PEPSetOperators(pep, 4, A)); } _try(PEPSetProblemType(pep, PEP_GENERAL)); // set some default options _try(PEPSetDimensions(pep, numEigenValues, PETSC_DECIDE, PETSC_DECIDE)); _try(PEPSetTolerances(pep, 1.e-6, 100)); _try(PEPSetType(pep, PEPTOAR)); _try(PEPSetWhichEigenpairs(pep, PEP_SMALLEST_MAGNITUDE)); _try(PEPMonitorSet(pep, _myPepMonitor, PETSC_NULL, PETSC_NULL)); #if defined(PETSC_USE_COMPLEX) PetscScalar shift = shift_r + PETSC_i * shift_i; #else PetscScalar shift = shift_r; #endif _try(PEPSetTarget(pep, shift)); // _try(PEPSetScale(pep,PEP_SCALE_BOTH,PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE)); _try(PEPSetFromOptions(pep)); // -pc_factor_shift_type NONZERO -pc_factor_shift_amount [amount] // or // '-pc_factor_shift_type POSITIVE_DEFINITE' // '-[level]_pc_factor_shift_type NONZERO -pc_factor_shift_amount [amount]' // or // '-[level]_pc_factor_shift_type POSITIVE_DEFINITE' to prevent the zero pivot. // [level] is "sub" when lu, ilu, cholesky, or icc are employed in each // individual block of the bjacobi or ASM preconditioner; and // [level] is "mg_levels" or "mg_coarse" when lu, ilu, cholesky, or icc are // used insi // Message::Info("Polynomial eigenvalue problem solved using PEP using the " // "following options:"); // _try(PEPView(pep, PETSC_VIEWER_STDOUT_SELF)); // force options specified directly as arguments if(numEigenValues){ _try(PEPSetDimensions(pep, numEigenValues, PETSC_DECIDE, PETSC_DECIDE)); } // print info // Message::Info("SLEPc solution method: %s", type); PetscInt nev; _try(PEPGetDimensions(pep, &nev, PETSC_NULL, PETSC_NULL)); Message::Info("SLEPc number of requested eigenvalues: %d", nev); PetscReal tol; PetscInt maxit; _try(PEPGetTolerances(pep, &tol, &maxit)); Message::Info("SLEPc stopping condition: tol=%g, maxit=%d", tol, maxit); #if (PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR < 6) _try(PEPSetScale(pep, PEP_SCALE_SCALAR, PETSC_DECIDE, PETSC_DECIDE, PETSC_DECIDE)); #else _try(PEPSetScale(pep, PEP_SCALE_SCALAR, PETSC_DECIDE, PETSC_NULL, PETSC_NULL, PETSC_DECIDE, PETSC_DECIDE)); #endif // solve _try(PEPSolve(pep)); // check convergence int its; _try(PEPGetIterationNumber(pep, &its)); PEPConvergedReason reason; _try(PEPGetConvergedReason(pep, &reason)); if(reason == PEP_CONVERGED_TOL) Message::Info("SLEPc converged in %d iterations", its); else if(reason == PEP_DIVERGED_ITS) Message::Error("SLEPc diverged after %d iterations", its); else if(reason == PEP_DIVERGED_BREAKDOWN) Message::Error("SLEPc generic breakdown in method"); _try(PEPView(pep, PETSC_VIEWER_STDOUT_SELF)); // get number of converged approximate eigenpairs PetscInt nconv; _try(PEPGetConverged(pep, &nconv)); Message::Info("SLEPc number of converged eigenpairs: %d", nconv); // ignore additional eigenvalues if we get more than what we asked if(nconv > nev) nconv = nev; // print eigenvalues and store eigenvectors in DofData _storeEigenVectors(DofData_P, nconv, PETSC_NULL, pep, filterExpressionIndex); _try(PEPDestroy(&pep)); } #endif void EigenSolve_SLEPC(struct DofData * DofData_P, int numEigenValues, double shift_r, double shift_i, int FilterExpressionIndex) { // Warn if we are not in harmonic regime (we won't be able to compute/store // complex eigenvectors). if(Current.NbrHar != 2){ Message::Info("EigenSolve will only store the real part of the eigenvectors; " "Define the system with \"Type Complex\" if this is an issue"); } #if !defined(PETSC_USE_COMPLEX) if(Current.NbrHar == 2){ Message::Warning("Using PETSc in real arithmetic for complex-simulated-real matrices"); } #endif // GenerateSeparate[] can create up to six matrices M6, M5, M4, M3, M2, M1 such that // i*w^5 M6 x + w^4 M5 x + -iw^3 M4 x + -w^2 M3 x + iw M2 x + M1 x = 0 // check Flag_Init[i] to see which operators exist. if(!DofData_P->Flag_Init[1] || !DofData_P->Flag_Init[3]){ Message::Error("No System available for EigenSolve: check 'DtDt' and 'GenerateSeparate'"); return; } if(!DofData_P->Flag_Init[4]&& !DofData_P->Flag_Init[5]&& !DofData_P->Flag_Init[6]){ if(!DofData_P->Flag_Init[2]){ // the shift refers to w^2 _linearEVP(DofData_P, numEigenValues, shift_r, shift_i, FilterExpressionIndex); } else{ // the shift refers to w _quadraticEVP(DofData_P, numEigenValues, shift_r, shift_i, FilterExpressionIndex); } } else{ #if (PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR < 5) Message::Error("Please upgrade to slepc >= 3.5.1 for polynomial EVP support!"); return; #else // the shift refers to w _polynomialEVP(DofData_P, numEigenValues, shift_r, shift_i, FilterExpressionIndex); #endif } } #endifgetdp-2.7.0-source/Legacy/Cal_Value.cpp000644 001750 001750 00000260020 12531661502 021345 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Johan Gyselinck // #include #include #include #include "ProData.h" #include "ProDefine.h" #include "Cal_Value.h" #include "Message.h" extern struct CurrentData Current ; #define SQU(a) ((a)*(a)) /* ------------------------------------------------------------------------ */ /* O p e r a t o r s o n V a l u e s */ /* ------------------------------------------------------------------------ */ /* Warning: the pointers V1 and R or V2 and R can be identical. You must */ /* use temporary variables in your computations: you can only */ /* affect to R at the very last time (when you're sure you will */ /* not use V1 or V2 any more). */ /* ------------------------------------------------------------------------ */ static double a0; static double a1 [NBR_MAX_HARMONIC * MAX_DIM] ; static double a2 [NBR_MAX_HARMONIC * MAX_DIM] ; static double b1 [NBR_MAX_HARMONIC * MAX_DIM] ; static double b2 [NBR_MAX_HARMONIC * MAX_DIM] ; static double b3 [NBR_MAX_HARMONIC * MAX_DIM] ; static double c1 [NBR_MAX_HARMONIC * MAX_DIM] ; static double c2 [NBR_MAX_HARMONIC * MAX_DIM] ; static double c3 [NBR_MAX_HARMONIC * MAX_DIM] ; static double tmp[27][NBR_MAX_HARMONIC * MAX_DIM] ; static int TENSOR_SYM_MAP[] = {0,1,2,1,3,4,2,4,5}; static int TENSOR_DIAG_MAP[] = {0,-1,-1,-1,1,-1,-1,-1,2}; void Cal_ComplexProduct(double V1[], double V2[], double P[]) { P[0] = V1[0] * V2[0] - V1[MAX_DIM] * V2[MAX_DIM] ; P[MAX_DIM] = V1[0] * V2[MAX_DIM] + V1[MAX_DIM] * V2[0] ; } void Cal_ComplexDivision(double V1[], double V2[], double P[]) { double Mod2 ; Mod2 = SQU(V2[0]) + SQU(V2[MAX_DIM]) ; if(!Mod2){ Message::Error("Division by zero in 'Cal_ComplexDivision'"); return; } P[0] = ( V1[0] * V2[0] + V1[MAX_DIM] * V2[MAX_DIM]) / Mod2 ; P[MAX_DIM] = (- V1[0] * V2[MAX_DIM] + V1[MAX_DIM] * V2[0]) / Mod2 ; } void Cal_ComplexInvert(double V1[], double P[]) { double Mod2 ; Mod2 = SQU(V1[0]) + SQU(V1[MAX_DIM]) ; if(!Mod2){ Message::Error("Division by zero in 'Cal_ComplexInvert'"); return; } P[0] = V1[0] / Mod2 ; P[MAX_DIM] = - V1[MAX_DIM] / Mod2 ; } /* ------------------------------------------------------------------------ R <- V1 ------------------------------------------------------------------------ */ void Cal_CopyValue(struct Value * V1, struct Value * R) { int k ; if (V1->Type == SCALAR) { R->Type = SCALAR ; for (k = 0 ; k < Current.NbrHar ; k++) R->Val[MAX_DIM*k ] = V1->Val[MAX_DIM*k ] ; } else if (V1->Type == VECTOR || V1->Type == TENSOR_DIAG){ R->Type = V1->Type ; for (k = 0 ; k < Current.NbrHar ; k++) { R->Val[MAX_DIM*k ] = V1->Val[MAX_DIM*k ] ; R->Val[MAX_DIM*k+1] = V1->Val[MAX_DIM*k+1] ; R->Val[MAX_DIM*k+2] = V1->Val[MAX_DIM*k+2] ; } } else if (V1->Type == TENSOR_SYM){ R->Type = TENSOR_SYM ; for (k = 0 ; k < Current.NbrHar ; k++) { R->Val[MAX_DIM*k ] = V1->Val[MAX_DIM*k ] ; R->Val[MAX_DIM*k+1] = V1->Val[MAX_DIM*k+1] ; R->Val[MAX_DIM*k+2] = V1->Val[MAX_DIM*k+2] ; R->Val[MAX_DIM*k+3] = V1->Val[MAX_DIM*k+3] ; R->Val[MAX_DIM*k+4] = V1->Val[MAX_DIM*k+4] ; R->Val[MAX_DIM*k+5] = V1->Val[MAX_DIM*k+5] ; } } else if (V1->Type == TENSOR){ R->Type = TENSOR ; for (k = 0 ; k < Current.NbrHar ; k++) { R->Val[MAX_DIM*k ] = V1->Val[MAX_DIM*k ] ; R->Val[MAX_DIM*k+1] = V1->Val[MAX_DIM*k+1] ; R->Val[MAX_DIM*k+2] = V1->Val[MAX_DIM*k+2] ; R->Val[MAX_DIM*k+3] = V1->Val[MAX_DIM*k+3] ; R->Val[MAX_DIM*k+4] = V1->Val[MAX_DIM*k+4] ; R->Val[MAX_DIM*k+5] = V1->Val[MAX_DIM*k+5] ; R->Val[MAX_DIM*k+6] = V1->Val[MAX_DIM*k+6] ; R->Val[MAX_DIM*k+7] = V1->Val[MAX_DIM*k+7] ; R->Val[MAX_DIM*k+8] = V1->Val[MAX_DIM*k+8] ; } } } /* ------------------------------------------------------------------------ R <- V1 ------------------------------------------------------------------------ */ void Cal_CopyValueArray(struct Value *V1, struct Value *R, int Nbr_Values) { int k, i; if (V1[0].Type == SCALAR) { for (i = 0 ; i < Nbr_Values ; i++){ R[i].Type = SCALAR ; for (k = 0 ; k < Current.NbrHar ; k++) R[i].Val[MAX_DIM*k ] = V1[i].Val[MAX_DIM*k ] ; } } else if (V1[0].Type == VECTOR || V1[0].Type == TENSOR_DIAG){ for (i = 0 ; i < Nbr_Values ; i++){ R[i].Type = V1[i].Type ; for (k = 0 ; k < Current.NbrHar ; k++) { R[i].Val[MAX_DIM*k ] = V1[i].Val[MAX_DIM*k ] ; R[i].Val[MAX_DIM*k+1] = V1[i].Val[MAX_DIM*k+1] ; R[i].Val[MAX_DIM*k+2] = V1[i].Val[MAX_DIM*k+2] ; } } } else if (V1[0].Type == TENSOR_SYM){ for (i = 0 ; i < Nbr_Values ; i++){ R[i].Type = TENSOR_SYM ; for (k = 0 ; k < Current.NbrHar ; k++) { R[i].Val[MAX_DIM*k ] = V1[i].Val[MAX_DIM*k ] ; R[i].Val[MAX_DIM*k+1] = V1[i].Val[MAX_DIM*k+1] ; R[i].Val[MAX_DIM*k+2] = V1[i].Val[MAX_DIM*k+2] ; R[i].Val[MAX_DIM*k+3] = V1[i].Val[MAX_DIM*k+3] ; R[i].Val[MAX_DIM*k+4] = V1[i].Val[MAX_DIM*k+4] ; R[i].Val[MAX_DIM*k+5] = V1[i].Val[MAX_DIM*k+5] ; } } } else if (V1[0].Type == TENSOR){ for (i = 0 ; i < Nbr_Values ; i++){ R[i].Type = TENSOR ; for (k = 0 ; k < Current.NbrHar ; k++) { R[i].Val[MAX_DIM*k ] = V1[i].Val[MAX_DIM*k ] ; R[i].Val[MAX_DIM*k+1] = V1[i].Val[MAX_DIM*k+1] ; R[i].Val[MAX_DIM*k+2] = V1[i].Val[MAX_DIM*k+2] ; R[i].Val[MAX_DIM*k+3] = V1[i].Val[MAX_DIM*k+3] ; R[i].Val[MAX_DIM*k+4] = V1[i].Val[MAX_DIM*k+4] ; R[i].Val[MAX_DIM*k+5] = V1[i].Val[MAX_DIM*k+5] ; R[i].Val[MAX_DIM*k+6] = V1[i].Val[MAX_DIM*k+6] ; R[i].Val[MAX_DIM*k+7] = V1[i].Val[MAX_DIM*k+7] ; R[i].Val[MAX_DIM*k+8] = V1[i].Val[MAX_DIM*k+8] ; } } } } void Cal_ValueArray2DoubleArray(struct Value *V1, double *R, int Nbr_Values) { int k, i; if (V1[0].Type == SCALAR) { for (i = 0 ; i < Nbr_Values ; i++){ for (k = 0 ; k < Current.NbrHar ; k++) R[Current.NbrHar*i+k] = V1[i].Val[MAX_DIM*k ] ; } } else if (V1[0].Type == VECTOR){ for (i = 0 ; i < Nbr_Values ; i++){ for (k = 0 ; k < Current.NbrHar ; k++) { R[3*(Current.NbrHar*i+k) ] = V1[i].Val[MAX_DIM*k ] ; R[3*(Current.NbrHar*i+k)+1] = V1[i].Val[MAX_DIM*k+1] ; R[3*(Current.NbrHar*i+k)+2] = V1[i].Val[MAX_DIM*k+2] ; } } } else { Message::Error("Wrong type conversion: %s ", Get_StringForDefine(Field_Type, V1[0].Type)); } } void Cal_AddValueArray2DoubleArray(struct Value *V1, double *R, int Nbr_Values) { int k, i; if (V1[0].Type == SCALAR) { for (i = 0 ; i < Nbr_Values ; i++){ for (k = 0 ; k < Current.NbrHar ; k++){ R[Current.NbrHar*i+k] += V1[i].Val[MAX_DIM*k ] ; } } } else if (V1[0].Type == VECTOR){ for (i = 0 ; i < Nbr_Values ; i++){ for (k = 0 ; k < Current.NbrHar ; k++) { R[3*(Current.NbrHar*i+k) ] += V1[i].Val[MAX_DIM*k ] ; R[3*(Current.NbrHar*i+k)+1] += V1[i].Val[MAX_DIM*k+1] ; R[3*(Current.NbrHar*i+k)+2] += V1[i].Val[MAX_DIM*k+2] ; } } } else { Message::Error("Wrong type conversion: %s ", Get_StringForDefine(Field_Type, V1[0].Type)); } } /* ------------------------------------------------------------------------ R <- 0 ------------------------------------------------------------------------ */ //static double VALUE_ZERO [NBR_MAX_HARMONIC * MAX_DIM] = // {0.,0.,0., 0.,0.,0., // 0.,0.,0., 0.,0.,0., // 0.,0.,0., 0.,0.,0.} ; void Cal_ZeroValue(struct Value * R) { //memcpy(R->Val, VALUE_ZERO, Current.NbrHar*MAX_DIM*sizeof(double)); for(int i = 0; i < Current.NbrHar*MAX_DIM; i++) R->Val[i] = 0.; } /* ------------------------------------------------------------------------ R <- V1 + V2 ------------------------------------------------------------------------ */ #define ADD(i) R->Val[i] = V1->Val[i] + V2->Val[i] #define CADD(i) R->Val[MAX_DIM*k+i] = V1->Val[MAX_DIM*k+i] + V2->Val[MAX_DIM*k+i] void Cal_AddValue(struct Value * V1, struct Value * V2, struct Value * R) { int i, k; int i1,i2; struct Value A; if (V1->Type == SCALAR && V2->Type == SCALAR) { if (Current.NbrHar == 1) { ADD(0); } else { for (k = 0 ; k < Current.NbrHar ; k++) { CADD(0); } } R->Type = SCALAR ; } else if ((V1->Type == VECTOR && V2->Type == VECTOR) || (V1->Type == TENSOR_DIAG && V2->Type == TENSOR_DIAG)) { if (Current.NbrHar == 1) { ADD(0); ADD(1); ADD(2); } else { for (k = 0 ; k < Current.NbrHar ; k++) { CADD(0); CADD(1); CADD(2); } } R->Type = V1->Type; } else if (V1->Type == TENSOR_SYM && V2->Type == TENSOR_SYM) { if (Current.NbrHar == 1) { ADD(0); ADD(1); ADD(2); ADD(3); ADD(4); ADD(5); } else { for (k = 0 ; k < Current.NbrHar ; k++) { CADD(0); CADD(1); CADD(2); CADD(3); CADD(4); CADD(5); } } R->Type = TENSOR_SYM; } else if (V1->Type == TENSOR && V2->Type == TENSOR) { if (Current.NbrHar == 1) { ADD(0); ADD(1); ADD(2); ADD(3); ADD(4); ADD(5); ADD(6); ADD(7); ADD(8); } else { for (k = 0 ; k < Current.NbrHar ; k++) { CADD(0); CADD(1); CADD(2); CADD(3); CADD(4); CADD(5); CADD(6); CADD(7); CADD(8); } } R->Type = TENSOR; } else if ((V1->Type == TENSOR && V2->Type == TENSOR_SYM) || (V1->Type == TENSOR && V2->Type == TENSOR_DIAG)|| (V1->Type == TENSOR_SYM && V2->Type == TENSOR_DIAG)){ A.Type = V1->Type; for (k = 0 ; k < Current.NbrHar ; k++) { for(i=0 ; i<9 ; i++){ i1 = (V1->Type==TENSOR)?i:TENSOR_SYM_MAP[i]; i2 = (V2->Type==TENSOR_SYM)?TENSOR_SYM_MAP[i]:TENSOR_DIAG_MAP[i]; A.Val[MAX_DIM*k+i1] = V1->Val[MAX_DIM*k+i1] + ((i2<0)?0.0:V2->Val[MAX_DIM*k+i2]); } } Cal_CopyValue(&A,R); } else if ((V1->Type == TENSOR_SYM && V2->Type == TENSOR) || (V1->Type == TENSOR_DIAG && V2->Type == TENSOR) || (V1->Type == TENSOR_DIAG && V2->Type == TENSOR_SYM)){ A.Type = V2->Type; for (k = 0 ; k < Current.NbrHar ; k++) { for(i=0 ; i<9 ; i++){ i1 = (V1->Type==TENSOR_SYM)?TENSOR_SYM_MAP[i]:TENSOR_DIAG_MAP[i]; i2 = (V2->Type==TENSOR)?i:TENSOR_SYM_MAP[i]; A.Val[MAX_DIM*k+i2] = ((i1<0)?0.0:V1->Val[MAX_DIM*k+i1]) + V2->Val[MAX_DIM*k+i2]; } } Cal_CopyValue(&A,R); } else { Message::Error("Addition of different quantities: %s + %s", Get_StringForDefine(Field_Type, V1->Type), Get_StringForDefine(Field_Type, V2->Type)); } } #undef ADD #undef CADD /* ------------------------------------------------------------------------ R <- V1 + V2 ------------------------------------------------------------------------ */ #define ADD(i,j) R[i].Val[j] = V1[i].Val[j] + V2[i].Val[j] #define CADD(i,j) R[i].Val[MAX_DIM*k+j] = V1[i].Val[MAX_DIM*k+j] + V2[i].Val[MAX_DIM*k+j] void Cal_AddValueArray (struct Value *V1, struct Value *V2, struct Value *R, int Nbr_Values) { int i, ii, k, i1,i2; struct Value A; if (V1[0].Type == SCALAR && V2[0].Type == SCALAR){ if (Current.NbrHar == 1) for(i = 0 ; i < Nbr_Values; i++){ R[i].Type = SCALAR ; ADD(i,0); } else for(i = 0 ; i < Nbr_Values; i++){ R[i].Type = SCALAR ; for (k = 0 ; k < Current.NbrHar ; k++) CADD(i,0); } } else if ((V1[0].Type == VECTOR && V2[0].Type == VECTOR) || (V1[0].Type == TENSOR_DIAG && V2[0].Type == TENSOR_DIAG)){ if (Current.NbrHar == 1) for(i = 0 ; i < Nbr_Values; i++){ R[i].Type = V1[i].Type; ADD(i,0); ADD(i,1); ADD(i,2); } else for(i = 0 ; i < Nbr_Values; i++){ R[i].Type = V1[i].Type; for (k = 0 ; k < Current.NbrHar ; k++) { CADD(i,0); CADD(i,1); CADD(i,2); } } } else if (V1[0].Type == TENSOR_SYM && V2[0].Type == TENSOR_SYM){ if (Current.NbrHar == 1) for(i = 0 ; i < Nbr_Values; i++){ R[i].Type = TENSOR_SYM; ADD(i,0); ADD(i,1); ADD(i,2); ADD(i,3); ADD(i,4); ADD(i,5); } else for(i = 0 ; i < Nbr_Values; i++){ R[i].Type = TENSOR_SYM; for (k = 0 ; k < Current.NbrHar ; k++) { CADD(i,0); CADD(i,1); CADD(i,2); CADD(i,3); CADD(i,4); CADD(i,5); } } } else if (V1[0].Type == TENSOR && V2[0].Type == TENSOR){ if (Current.NbrHar == 1) for(i = 0 ; i < Nbr_Values; i++){ R[i].Type = TENSOR; ADD(i,0); ADD(i,1); ADD(i,2); ADD(i,3); ADD(i,4); ADD(i,5); ADD(i,6); ADD(i,7); ADD(i,8); } else for(i = 0 ; i < Nbr_Values; i++){ R[i].Type = TENSOR; for (k = 0 ; k < Current.NbrHar ; k++) { CADD(i,0); CADD(i,1); CADD(i,2); CADD(i,3); CADD(i,4); CADD(i,5); CADD(i,6); CADD(i,7); CADD(i,8); } } } else if ((V1[0].Type == TENSOR && V2[0].Type == TENSOR_SYM) || (V1[0].Type == TENSOR && V2[0].Type == TENSOR_DIAG)|| (V1[0].Type == TENSOR_SYM && V2[0].Type == TENSOR_DIAG)){ A.Type = V1[0].Type; for(i = 0 ; i < Nbr_Values; i++){ for (k = 0 ; k < Current.NbrHar ; k++) { for(ii=0 ; ii<9 ; ii++){ i1 = (V1[0].Type==TENSOR)?ii:TENSOR_SYM_MAP[ii]; i2 = (V2[0].Type==TENSOR_SYM)?TENSOR_SYM_MAP[ii]:TENSOR_DIAG_MAP[ii]; A.Val[MAX_DIM*k+i1] = V1[i].Val[MAX_DIM*k+i1] + ((i2<0)?0.0:V2[i].Val[MAX_DIM*k+i2]); } } Cal_CopyValue(&A,&R[i]); } } else if ((V1[0].Type == TENSOR_SYM && V2[0].Type == TENSOR) || (V1[0].Type == TENSOR_DIAG && V2[0].Type == TENSOR) || (V1[0].Type == TENSOR_DIAG && V2[0].Type == TENSOR_SYM)){ A.Type = V2[0].Type; for(i = 0 ; i < Nbr_Values; i++){ for (k = 0 ; k < Current.NbrHar ; k++) { for(ii=0 ; ii<9 ; ii++){ i1 = (V1[i].Type==TENSOR_SYM)?TENSOR_SYM_MAP[ii]:TENSOR_DIAG_MAP[ii]; i2 = (V2[i].Type==TENSOR)?ii:TENSOR_SYM_MAP[ii]; A.Val[MAX_DIM*k+i2] = ((i1<0)?0.0:V1[i].Val[MAX_DIM*k+i1]) + V2[i].Val[MAX_DIM*k+i2]; } } Cal_CopyValue(&A,&R[i]); } } else Message::Error("Addition of different quantities: %s + %s", Get_StringForDefine(Field_Type, V1->Type), Get_StringForDefine(Field_Type, V2->Type)); } #undef ADD #undef CADD /* ------------------------------------------------------------------------ R <- V1 * d , where d is a double ------------------------------------------------------------------------ */ void Cal_MultValue(struct Value * V1, double d, struct Value * R) { int k; R->Type = V1->Type ; switch(V1->Type){ case SCALAR : if (Current.NbrHar == 1) { R->Val[0] = V1->Val[0] * d; } else{ for (k = 0 ; k < Current.NbrHar ; k++) { R->Val[MAX_DIM*k] = V1->Val[MAX_DIM*k] * d; } } break; case VECTOR : case TENSOR_DIAG : if (Current.NbrHar == 1) { R->Val[0] = V1->Val[0] * d; R->Val[1] = V1->Val[1] * d; R->Val[2] = V1->Val[2] * d; } else{ for (k = 0 ; k < Current.NbrHar ; k++) { R->Val[MAX_DIM*k ] = V1->Val[MAX_DIM*k ] * d; R->Val[MAX_DIM*k+1] = V1->Val[MAX_DIM*k+1] * d; R->Val[MAX_DIM*k+2] = V1->Val[MAX_DIM*k+2] * d; } } break; case TENSOR_SYM : if (Current.NbrHar == 1) { R->Val[0] = V1->Val[0] * d; R->Val[1] = V1->Val[1] * d; R->Val[2] = V1->Val[2] * d; R->Val[3] = V1->Val[3] * d; R->Val[4] = V1->Val[4] * d; R->Val[5] = V1->Val[5] * d; } else{ for (k = 0 ; k < Current.NbrHar ; k++) { R->Val[MAX_DIM*k ] = V1->Val[MAX_DIM*k ] * d; R->Val[MAX_DIM*k+1] = V1->Val[MAX_DIM*k+1] * d; R->Val[MAX_DIM*k+2] = V1->Val[MAX_DIM*k+2] * d; R->Val[MAX_DIM*k+3] = V1->Val[MAX_DIM*k+3] * d; R->Val[MAX_DIM*k+4] = V1->Val[MAX_DIM*k+4] * d; R->Val[MAX_DIM*k+5] = V1->Val[MAX_DIM*k+5] * d; } } break; case TENSOR : if (Current.NbrHar == 1) { R->Val[0] = V1->Val[0] * d; R->Val[1] = V1->Val[1] * d; R->Val[2] = V1->Val[2] * d; R->Val[3] = V1->Val[3] * d; R->Val[4] = V1->Val[4] * d; R->Val[5] = V1->Val[5] * d; R->Val[6] = V1->Val[6] * d; R->Val[7] = V1->Val[7] * d; R->Val[8] = V1->Val[8] * d; } else{ for (k = 0 ; k < Current.NbrHar ; k++) { R->Val[MAX_DIM*k ] = V1->Val[MAX_DIM*k ] * d; R->Val[MAX_DIM*k+1] = V1->Val[MAX_DIM*k+1] * d; R->Val[MAX_DIM*k+2] = V1->Val[MAX_DIM*k+2] * d; R->Val[MAX_DIM*k+3] = V1->Val[MAX_DIM*k+3] * d; R->Val[MAX_DIM*k+4] = V1->Val[MAX_DIM*k+4] * d; R->Val[MAX_DIM*k+5] = V1->Val[MAX_DIM*k+5] * d; R->Val[MAX_DIM*k+6] = V1->Val[MAX_DIM*k+6] * d; R->Val[MAX_DIM*k+7] = V1->Val[MAX_DIM*k+7] * d; R->Val[MAX_DIM*k+8] = V1->Val[MAX_DIM*k+8] * d; } } break; default : Message::Error("Wrong argument type for 'Cal_MultValue'"); break; } } /* ------------------------------------------------------------------------ R <- V1 + V2 * d , where d is a double ------------------------------------------------------------------------ */ void Cal_AddMultValue(struct Value * V1, struct Value * V2, double d, struct Value * R) { int k; struct Value A ; A.Type = V2->Type ; switch(V2->Type){ case SCALAR : if (Current.NbrHar == 1) { A.Val[0] = V2->Val[0] * d; } else{ for (k = 0 ; k < Current.NbrHar ; k++) { A.Val[MAX_DIM*k] = V2->Val[MAX_DIM*k] * d; } } break; case VECTOR : case TENSOR_DIAG : if (Current.NbrHar == 1) { A.Val[0] = V2->Val[0] * d; A.Val[1] = V2->Val[1] * d; A.Val[2] = V2->Val[2] * d; } else{ for (k = 0 ; k < Current.NbrHar ; k++) { A.Val[MAX_DIM*k ] = V2->Val[MAX_DIM*k ] * d; A.Val[MAX_DIM*k+1] = V2->Val[MAX_DIM*k+1] * d; A.Val[MAX_DIM*k+2] = V2->Val[MAX_DIM*k+2] * d; } } break; case TENSOR_SYM : if (Current.NbrHar == 1) { A.Val[0] = V2->Val[0] * d; A.Val[1] = V2->Val[1] * d; A.Val[2] = V2->Val[2] * d; A.Val[3] = V2->Val[3] * d; A.Val[4] = V2->Val[4] * d; A.Val[5] = V2->Val[5] * d; } else{ for (k = 0 ; k < Current.NbrHar ; k++) { A.Val[MAX_DIM*k ] = V2->Val[MAX_DIM*k ] * d; A.Val[MAX_DIM*k+1] = V2->Val[MAX_DIM*k+1] * d; A.Val[MAX_DIM*k+2] = V2->Val[MAX_DIM*k+2] * d; A.Val[MAX_DIM*k+3] = V2->Val[MAX_DIM*k+3] * d; A.Val[MAX_DIM*k+4] = V2->Val[MAX_DIM*k+4] * d; A.Val[MAX_DIM*k+5] = V2->Val[MAX_DIM*k+5] * d; } } break; case TENSOR : if (Current.NbrHar == 1) { A.Val[0] = V2->Val[0] * d; A.Val[1] = V2->Val[1] * d; A.Val[2] = V2->Val[2] * d; A.Val[3] = V2->Val[3] * d; A.Val[4] = V2->Val[4] * d; A.Val[5] = V2->Val[5] * d; A.Val[6] = V2->Val[6] * d; A.Val[7] = V2->Val[7] * d; A.Val[8] = V2->Val[8] * d; } else{ for (k = 0 ; k < Current.NbrHar ; k++) { A.Val[MAX_DIM*k ] = V2->Val[MAX_DIM*k ] * d; A.Val[MAX_DIM*k+1] = V2->Val[MAX_DIM*k+1] * d; A.Val[MAX_DIM*k+2] = V2->Val[MAX_DIM*k+2] * d; A.Val[MAX_DIM*k+3] = V2->Val[MAX_DIM*k+3] * d; A.Val[MAX_DIM*k+4] = V2->Val[MAX_DIM*k+4] * d; A.Val[MAX_DIM*k+5] = V2->Val[MAX_DIM*k+5] * d; A.Val[MAX_DIM*k+6] = V2->Val[MAX_DIM*k+6] * d; A.Val[MAX_DIM*k+7] = V2->Val[MAX_DIM*k+7] * d; A.Val[MAX_DIM*k+8] = V2->Val[MAX_DIM*k+8] * d; } } break; default : Message::Error("Wrong argument type for 'Cal_AddMultValue'"); return; } Cal_AddValue(V1,&A,R); } /* ------------------------------------------------------------------------ R <- V1 + V2 * d , where d is a double ------------------------------------------------------------------------ */ void Cal_AddMultValueArray(struct Value * V1, struct Value * V2, double d, struct Value * R,int Nbr_Values) { int k,i; switch(V2[0].Type){ case SCALAR : if (Current.NbrHar == 1) { for(i = 0 ; i < Nbr_Values ; i++) V2[i].Val[0] = V2[i].Val[0] * d; } else{ for (k = 0 ; k < Current.NbrHar ; k++) { for(i = 0 ; i < Nbr_Values ; i++) V2[i].Val[MAX_DIM*k] = V2[i].Val[MAX_DIM*k] * d; } } break; case VECTOR : case TENSOR_DIAG : if (Current.NbrHar == 1) { for(i = 0 ; i < Nbr_Values ; i++){ V2[i].Val[0] = V2[i].Val[0] * d; V2[i].Val[1] = V2[i].Val[1] * d; V2[i].Val[2] = V2[i].Val[2] * d; } } else{ for (k = 0 ; k < Current.NbrHar ; k++) { for(i = 0 ; i < Nbr_Values ; i++){ V2[i].Val[MAX_DIM*k ] = V2[i].Val[MAX_DIM*k ] * d; V2[i].Val[MAX_DIM*k+1] = V2[i].Val[MAX_DIM*k+1] * d; V2[i].Val[MAX_DIM*k+2] = V2[i].Val[MAX_DIM*k+2] * d; } } } break; case TENSOR_SYM : if (Current.NbrHar == 1) { for(i = 0 ; i < Nbr_Values ; i++){ V2[i].Val[0] = V2[i].Val[0] * d; V2[i].Val[1] = V2[i].Val[1] * d; V2[i].Val[2] = V2[i].Val[2] * d; V2[i].Val[3] = V2[i].Val[3] * d; V2[i].Val[4] = V2[i].Val[4] * d; V2[i].Val[5] = V2[i].Val[5] * d; } } else{ for (k = 0 ; k < Current.NbrHar ; k++) { for(i = 0 ; i < Nbr_Values ; i++){ V2[i].Val[MAX_DIM*k ] = V2[i].Val[MAX_DIM*k ] * d; V2[i].Val[MAX_DIM*k+1] = V2[i].Val[MAX_DIM*k+1] * d; V2[i].Val[MAX_DIM*k+2] = V2[i].Val[MAX_DIM*k+2] * d; V2[i].Val[MAX_DIM*k+3] = V2[i].Val[MAX_DIM*k+3] * d; V2[i].Val[MAX_DIM*k+4] = V2[i].Val[MAX_DIM*k+4] * d; V2[i].Val[MAX_DIM*k+5] = V2[i].Val[MAX_DIM*k+5] * d; } } } break; case TENSOR : if (Current.NbrHar == 1) { for(i = 0 ; i < Nbr_Values ; i++){ V2[i].Val[0] = V2[i].Val[0] * d; V2[i].Val[1] = V2[i].Val[1] * d; V2[i].Val[2] = V2[i].Val[2] * d; V2[i].Val[3] = V2[i].Val[3] * d; V2[i].Val[4] = V2[i].Val[4] * d; V2[i].Val[5] = V2[i].Val[5] * d; V2[i].Val[6] = V2[i].Val[6] * d; V2[i].Val[7] = V2[i].Val[7] * d; V2[i].Val[8] = V2[i].Val[8] * d; } } else{ for (k = 0 ; k < Current.NbrHar ; k++) { for(i = 0 ; i < Nbr_Values ; i++){ V2[i].Val[MAX_DIM*k ] = V2[i].Val[MAX_DIM*k ] * d; V2[i].Val[MAX_DIM*k+1] = V2[i].Val[MAX_DIM*k+1] * d; V2[i].Val[MAX_DIM*k+2] = V2[i].Val[MAX_DIM*k+2] * d; V2[i].Val[MAX_DIM*k+3] = V2[i].Val[MAX_DIM*k+3] * d; V2[i].Val[MAX_DIM*k+4] = V2[i].Val[MAX_DIM*k+4] * d; V2[i].Val[MAX_DIM*k+5] = V2[i].Val[MAX_DIM*k+5] * d; V2[i].Val[MAX_DIM*k+6] = V2[i].Val[MAX_DIM*k+6] * d; V2[i].Val[MAX_DIM*k+7] = V2[i].Val[MAX_DIM*k+7] * d; V2[i].Val[MAX_DIM*k+8] = V2[i].Val[MAX_DIM*k+8] * d; } } } break; default : Message::Error("Wrong argument type for 'Cal_AddMultValueArray'"); return; } Cal_AddValueArray(V1, V2, R,Nbr_Values); } /* ------------------------------------------------------------------------ V1 <- V1 * d1 + V2 * d2 , where d1, d2 are doubles ------------------------------------------------------------------------ */ void Cal_AddMultValue2(struct Value * V1, double d1, struct Value * V2, double d2) { int k; switch(V1->Type){ case SCALAR : if (Current.NbrHar == 1) { V1->Val[0] = V1->Val[0] * d1 + V2->Val[0] * d2; } else{ for (k = 0 ; k < Current.NbrHar ; k++) { V1->Val[MAX_DIM*k] = V1->Val[MAX_DIM*k] * d1 + V2->Val[MAX_DIM*k] * d2; } } break; case VECTOR : case TENSOR_DIAG : if (Current.NbrHar == 1) { V1->Val[0] = V1->Val[0] * d1 + V2->Val[0] * d2; V1->Val[1] = V1->Val[1] * d1 + V2->Val[1] * d2; V1->Val[2] = V1->Val[2] * d1 + V2->Val[2] * d2; } else{ for (k = 0 ; k < Current.NbrHar ; k++) { V1->Val[MAX_DIM*k ] = V1->Val[MAX_DIM*k ] * d1 + V2->Val[MAX_DIM*k ] * d2; V1->Val[MAX_DIM*k+1] = V1->Val[MAX_DIM*k+1] * d1 + V2->Val[MAX_DIM*k+1] * d2; V1->Val[MAX_DIM*k+2] = V1->Val[MAX_DIM*k+2] * d1 + V2->Val[MAX_DIM*k+2] * d2; } } break; default : Message::Error("Wrong argument type for 'Cal_AddMultValue2'"); break; } } /* ------------------------------------------------------------------------ R <- V1 - V2 ------------------------------------------------------------------------ */ #define SUB(i) R->Val[i] = V1->Val[i] - V2->Val[i] #define CSUB(i) R->Val[MAX_DIM*k+i] = V1->Val[MAX_DIM*k+i] - V2->Val[MAX_DIM*k+i] void Cal_SubstractValue(struct Value * V1, struct Value * V2, struct Value * R) { int i, k; int i1, i2; struct Value A; if (V1->Type == SCALAR && V2->Type == SCALAR) { if (Current.NbrHar == 1) { SUB(0); } else { for (k = 0 ; k < Current.NbrHar ; k++) { CSUB(0); } } R->Type = SCALAR ; } else if ((V1->Type == VECTOR && V2->Type == VECTOR) || (V1->Type == TENSOR_DIAG && V2->Type == TENSOR_DIAG)) { if (Current.NbrHar == 1) { SUB(0); SUB(1); SUB(2); } else { for (k = 0 ; k < Current.NbrHar ; k++) { CSUB(0); CSUB(1); CSUB(2); } } R->Type = V1->Type ; } else if (V1->Type == TENSOR_SYM && V2->Type == TENSOR_SYM) { if (Current.NbrHar == 1) { SUB(0); SUB(1); SUB(2); SUB(3); SUB(4); SUB(5); } else { for (k = 0 ; k < Current.NbrHar ; k++) { CSUB(0); CSUB(1); CSUB(2); CSUB(3); CSUB(4); CSUB(5); } } R->Type = TENSOR_SYM; } else if (V1->Type == TENSOR && V2->Type == TENSOR) { if (Current.NbrHar == 1) { SUB(0); SUB(1); SUB(2); SUB(3); SUB(4); SUB(5); SUB(6); SUB(7); SUB(8); } else { for (k = 0 ; k < Current.NbrHar ; k++) { CSUB(0); CSUB(1); CSUB(2); CSUB(3); CSUB(4); CSUB(5); CSUB(6); CSUB(7); CSUB(8); } } R->Type = TENSOR; } else if ((V1->Type == TENSOR && V2->Type == TENSOR_SYM) || (V1->Type == TENSOR && V2->Type == TENSOR_DIAG)|| (V1->Type == TENSOR_SYM && V2->Type == TENSOR_DIAG)){ A.Type = V1->Type; for (k = 0 ; k < Current.NbrHar ; k++) { for(i=0 ; i<9 ; i++){ i1 = (V1->Type==TENSOR)?i:TENSOR_SYM_MAP[i]; i2 = (V2->Type==TENSOR_SYM)?TENSOR_SYM_MAP[i]:TENSOR_DIAG_MAP[i]; A.Val[MAX_DIM*k+i1] = V1->Val[MAX_DIM*k+i1] - ((i2<0)?0.0:V2->Val[MAX_DIM*k+i2]); } } Cal_CopyValue(&A,R); } else if ((V1->Type == TENSOR_SYM && V2->Type == TENSOR) || (V1->Type == TENSOR_DIAG && V2->Type == TENSOR) || (V1->Type == TENSOR_DIAG && V2->Type == TENSOR_SYM)){ A.Type = V2->Type; for (k = 0 ; k < Current.NbrHar ; k++) { for(i=0 ; i<9 ; i++){ i1 = (V1->Type==TENSOR_SYM)?TENSOR_SYM_MAP[i]:TENSOR_DIAG_MAP[i]; i2 = (V2->Type==TENSOR)?i:TENSOR_SYM_MAP[i]; A.Val[MAX_DIM*k+i2] = ((i1<0)?0.0:V1->Val[MAX_DIM*k+i1]) - V2->Val[MAX_DIM*k+i2]; } } Cal_CopyValue(&A,R); } else { Message::Error("Substraction of different quantities: %s - %s", Get_StringForDefine(Field_Type, V1->Type), Get_StringForDefine(Field_Type, V2->Type)); } } #undef SUB #undef CSUB /* ------------------------------------------------------------------------ R <- V1 * V2 ------------------------------------------------------------------------ */ #define CMULT(a,b,c) \ Cal_ComplexProduct(&(V1->Val[MAX_DIM*k+a]), &(V2->Val[MAX_DIM*k+b]), tmp[c]) #define CPUT(a) \ R->Val[MAX_DIM* k +a] = tmp[a][0] ; \ R->Val[MAX_DIM*(k+1)+a] = tmp[a][MAX_DIM] #define CPUT3(a,b,c,d) \ R->Val[MAX_DIM* k +d] = tmp[a][0] +tmp[b][0] +tmp[c][0] ; \ R->Val[MAX_DIM*(k+1)+d] = tmp[a][MAX_DIM]+tmp[b][MAX_DIM]+tmp[c][MAX_DIM] void Cal_ProductValue(struct Value * V1, struct Value * V2, struct Value * R) { int k; if (V1->Type == SCALAR && V2->Type == SCALAR) { if (Current.NbrHar == 1) { R->Val[0] = V1->Val[0]*V2->Val[0]; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CMULT(0,0,0); CPUT(0); } } R->Type = SCALAR ; } else if (V1->Type == SCALAR && (V2->Type == VECTOR || V2->Type == TENSOR_DIAG)) { if (Current.NbrHar == 1) { a0 = V1->Val[0] ; R->Val[0] = a0 * V2->Val[0] ; R->Val[1] = a0 * V2->Val[1] ; R->Val[2] = a0 * V2->Val[2] ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CMULT(0,0,0); CMULT(0,1,1); CMULT(0,2,2); CPUT(0); CPUT(1); CPUT(2); } } R->Type = V2->Type ; } else if (V1->Type == SCALAR && V2->Type == TENSOR_SYM) { if (Current.NbrHar == 1) { a0 = V1->Val[0] ; R->Val[0] = a0 * V2->Val[0] ; R->Val[1] = a0 * V2->Val[1] ; R->Val[2] = a0 * V2->Val[2] ; R->Val[3] = a0 * V2->Val[3] ; R->Val[4] = a0 * V2->Val[4] ; R->Val[5] = a0 * V2->Val[5] ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CMULT(0,0,0); CMULT(0,1,1); CMULT(0,2,2); CMULT(0,3,3); CMULT(0,4,4); CMULT(0,5,5); CPUT(0); CPUT(1); CPUT(2); CPUT(3); CPUT(4); CPUT(5); } } R->Type = TENSOR_SYM ; } else if (V1->Type == SCALAR && V2->Type == TENSOR) { if (Current.NbrHar == 1) { a0 = V1->Val[0] ; R->Val[0] = a0 * V2->Val[0] ; R->Val[1] = a0 * V2->Val[1] ; R->Val[2] = a0 * V2->Val[2] ; R->Val[3] = a0 * V2->Val[3] ; R->Val[4] = a0 * V2->Val[4] ; R->Val[5] = a0 * V2->Val[5] ; R->Val[6] = a0 * V2->Val[6] ; R->Val[7] = a0 * V2->Val[7] ; R->Val[8] = a0 * V2->Val[8] ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CMULT(0,0,0); CMULT(0,1,1); CMULT(0,2,2); CMULT(0,3,3); CMULT(0,4,4); CMULT(0,5,5); CMULT(0,6,6); CMULT(0,7,7); CMULT(0,8,8); CPUT(0); CPUT(1); CPUT(2); CPUT(3); CPUT(4); CPUT(5); CPUT(6); CPUT(7); CPUT(8); } } R->Type = TENSOR ; } else if ((V1->Type == VECTOR || V1->Type == TENSOR_DIAG) && V2->Type == SCALAR) { if (Current.NbrHar == 1) { a0 = V2->Val[0] ; R->Val[0] = V1->Val[0] * a0 ; R->Val[1] = V1->Val[1] * a0 ; R->Val[2] = V1->Val[2] * a0 ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CMULT(0,0,0); CMULT(1,0,1); CMULT(2,0,2); CPUT(0); CPUT(1); CPUT(2); } } R->Type = V1->Type ; } else if (V1->Type == TENSOR_SYM && V2->Type == SCALAR) { if (Current.NbrHar == 1) { a0 = V2->Val[0] ; R->Val[0] = V1->Val[0] * a0 ; R->Val[1] = V1->Val[1] * a0 ; R->Val[2] = V1->Val[2] * a0 ; R->Val[3] = V1->Val[3] * a0 ; R->Val[4] = V1->Val[4] * a0 ; R->Val[5] = V1->Val[5] * a0 ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CMULT(0,0,0); CMULT(1,0,1); CMULT(2,0,2); CMULT(3,0,3); CMULT(4,0,4); CMULT(5,0,5); CPUT(0); CPUT(1); CPUT(2); CPUT(3); CPUT(4); CPUT(5); } } R->Type = TENSOR_SYM ; } else if (V1->Type == TENSOR && V2->Type == SCALAR) { if (Current.NbrHar == 1) { a0 = V2->Val[0] ; R->Val[0] = V1->Val[0] * a0 ; R->Val[1] = V1->Val[1] * a0 ; R->Val[2] = V1->Val[2] * a0 ; R->Val[3] = V1->Val[3] * a0 ; R->Val[4] = V1->Val[4] * a0 ; R->Val[5] = V1->Val[5] * a0 ; R->Val[6] = V1->Val[6] * a0 ; R->Val[7] = V1->Val[7] * a0 ; R->Val[8] = V1->Val[8] * a0 ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CMULT(0,0,0); CMULT(1,0,1); CMULT(2,0,2); CMULT(3,0,3); CMULT(4,0,4); CMULT(5,0,5); CMULT(6,0,6); CMULT(7,0,7); CMULT(8,0,8); CPUT(0); CPUT(1); CPUT(2); CPUT(3); CPUT(4); CPUT(5); CPUT(6); CPUT(7); CPUT(8); } } R->Type = TENSOR ; } /* Scalar Product. See 'Cal_CrossProductValue' for the Vector Product */ else if (V1->Type == VECTOR && V2->Type == VECTOR) { if (Current.NbrHar == 1) { R->Val[0] = V1->Val[0] * V2->Val[0] + V1->Val[1] * V2->Val[1] + V1->Val[2] * V2->Val[2] ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CMULT(0,0,0); CMULT(1,1,1); CMULT(2,2,2); CPUT3(0,1,2,0); } } R->Type = SCALAR ; } else if ( (V1->Type == TENSOR_DIAG && V2->Type == VECTOR) || (V2->Type == TENSOR_DIAG && V1->Type == VECTOR) ) { /* WARNING WARNING! */ if (Current.NbrHar == 1) { R->Val[0] = V1->Val[0]*V2->Val[0]; R->Val[1] = V1->Val[1]*V2->Val[1]; R->Val[2] = V1->Val[2]*V2->Val[2]; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CMULT(0,0,0); CMULT(1,1,1); CMULT(2,2,2); CPUT(0); CPUT(1); CPUT(2); } } R->Type = VECTOR ; } else if (V1->Type == TENSOR_SYM && V2->Type == VECTOR) { if (Current.NbrHar == 1) { a1[0] = V1->Val[0]*V2->Val[0] + V1->Val[1]*V2->Val[1] + V1->Val[2]*V2->Val[2]; a1[1] = V1->Val[1]*V2->Val[0] + V1->Val[3]*V2->Val[1] + V1->Val[4]*V2->Val[2]; a1[2] = V1->Val[2]*V2->Val[0] + V1->Val[4]*V2->Val[1] + V1->Val[5]*V2->Val[2]; R->Val[0] = a1[0]; R->Val[1] = a1[1]; R->Val[2] = a1[2]; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CMULT(0,0,0); CMULT(1,1,1); CMULT(2,2,2); CMULT(1,0,3); CMULT(3,1,4); CMULT(4,2,5); CMULT(2,0,6); CMULT(4,1,7); CMULT(5,2,8); CPUT3(0,1,2,0); CPUT3(3,4,5,1); CPUT3(6,7,8,2); } } R->Type = VECTOR ; } else if (V1->Type == TENSOR && V2->Type == VECTOR) { if (Current.NbrHar == 1) { a1[0] = V1->Val[0]*V2->Val[0] + V1->Val[1]*V2->Val[1] + V1->Val[2]*V2->Val[2]; a1[1] = V1->Val[3]*V2->Val[0] + V1->Val[4]*V2->Val[1] + V1->Val[5]*V2->Val[2]; a1[2] = V1->Val[6]*V2->Val[0] + V1->Val[7]*V2->Val[1] + V1->Val[8]*V2->Val[2]; R->Val[0] = a1[0]; R->Val[1] = a1[1]; R->Val[2] = a1[2]; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CMULT(0,0,0); CMULT(1,1,1); CMULT(2,2,2); CMULT(3,0,3); CMULT(4,1,4); CMULT(5,2,5); CMULT(6,0,6); CMULT(7,1,7); CMULT(8,2,8); CPUT3(0,1,2,0); CPUT3(3,4,5,1); CPUT3(6,7,8,2); } } R->Type = VECTOR ; } else if (V1->Type == TENSOR_DIAG && V2->Type == TENSOR_DIAG) { if (Current.NbrHar == 1) { R->Val[0] = V1->Val[0]*V2->Val[0]; R->Val[1] = V1->Val[1]*V2->Val[1]; R->Val[2] = V1->Val[2]*V2->Val[2]; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CMULT(0,0,0); CMULT(1,1,1); CMULT(2,2,2); CPUT(0); CPUT(1); CPUT(2); } } R->Type = TENSOR_DIAG; } else if (V1->Type == TENSOR_SYM && V2->Type == TENSOR_SYM) { if (Current.NbrHar == 1) { a1[0] = V1->Val[0]*V2->Val[0] + V1->Val[1]*V2->Val[1] + V1->Val[2]*V2->Val[2]; a1[1] = V1->Val[0]*V2->Val[1] + V1->Val[1]*V2->Val[3] + V1->Val[2]*V2->Val[4]; a1[2] = V1->Val[0]*V2->Val[2] + V1->Val[1]*V2->Val[4] + V1->Val[2]*V2->Val[5]; a1[3] = V1->Val[1]*V2->Val[0] + V1->Val[3]*V2->Val[1] + V1->Val[4]*V2->Val[2]; a1[4] = V1->Val[1]*V2->Val[1] + V1->Val[3]*V2->Val[3] + V1->Val[4]*V2->Val[4]; a1[5] = V1->Val[1]*V2->Val[2] + V1->Val[3]*V2->Val[4] + V1->Val[4]*V2->Val[5]; a1[6] = V1->Val[2]*V2->Val[0] + V1->Val[4]*V2->Val[1] + V1->Val[5]*V2->Val[2]; a1[7] = V1->Val[2]*V2->Val[1] + V1->Val[4]*V2->Val[3] + V1->Val[5]*V2->Val[4]; a1[8] = V1->Val[2]*V2->Val[2] + V1->Val[4]*V2->Val[4] + V1->Val[5]*V2->Val[5]; R->Val[0] = a1[0]; R->Val[1] = a1[1]; R->Val[2] = a1[2]; R->Val[3] = a1[3]; R->Val[4] = a1[4]; R->Val[5] = a1[5]; R->Val[6] = a1[6]; R->Val[7] = a1[7]; R->Val[8] = a1[8]; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CMULT(0,0,0); CMULT(1,1,1); CMULT(2,2,2); CMULT(0,1,3); CMULT(1,3,4); CMULT(2,4,5); CMULT(0,2,6); CMULT(1,4,7); CMULT(2,5,8); CMULT(1,0,9); CMULT(3,1,10); CMULT(4,2,11); CMULT(1,1,12); CMULT(3,3,13); CMULT(4,4,14); CMULT(1,2,15); CMULT(3,4,16); CMULT(4,5,17); CMULT(2,0,18); CMULT(4,1,19); CMULT(5,2,20); CMULT(2,1,21); CMULT(4,3,22); CMULT(5,4,23); CMULT(2,2,24); CMULT(4,4,25); CMULT(5,5,26); CPUT3(0,1,2,0); CPUT3(3,4,5,1); CPUT3(6,7,8,2); CPUT3(9,10,11,3); CPUT3(12,13,14,4); CPUT3(15,16,17,5); CPUT3(18,19,20,6); CPUT3(21,22,23,7); CPUT3(24,25,26,8); } } R->Type = TENSOR; } else if (V1->Type == TENSOR && V2->Type == TENSOR) { if (Current.NbrHar == 1) { a1[0] = V1->Val[0]*V2->Val[0] + V1->Val[1]*V2->Val[3] + V1->Val[2]*V2->Val[6]; a1[1] = V1->Val[0]*V2->Val[1] + V1->Val[1]*V2->Val[4] + V1->Val[2]*V2->Val[7]; a1[2] = V1->Val[0]*V2->Val[2] + V1->Val[1]*V2->Val[5] + V1->Val[2]*V2->Val[8]; a1[3] = V1->Val[3]*V2->Val[0] + V1->Val[4]*V2->Val[3] + V1->Val[5]*V2->Val[6]; a1[4] = V1->Val[3]*V2->Val[1] + V1->Val[4]*V2->Val[4] + V1->Val[5]*V2->Val[7]; a1[5] = V1->Val[3]*V2->Val[2] + V1->Val[4]*V2->Val[5] + V1->Val[5]*V2->Val[8]; a1[6] = V1->Val[6]*V2->Val[0] + V1->Val[7]*V2->Val[3] + V1->Val[8]*V2->Val[6]; a1[7] = V1->Val[6]*V2->Val[1] + V1->Val[7]*V2->Val[4] + V1->Val[8]*V2->Val[7]; a1[8] = V1->Val[6]*V2->Val[2] + V1->Val[7]*V2->Val[5] + V1->Val[8]*V2->Val[8]; R->Val[0] = a1[0]; R->Val[1] = a1[1]; R->Val[2] = a1[2]; R->Val[3] = a1[3]; R->Val[4] = a1[4]; R->Val[5] = a1[5]; R->Val[6] = a1[6]; R->Val[7] = a1[7]; R->Val[8] = a1[8]; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CMULT(0,0,0); CMULT(1,3,1); CMULT(2,6,2); CMULT(0,1,3); CMULT(1,4,4); CMULT(2,7,5); CMULT(0,2,6); CMULT(1,5,7); CMULT(2,8,8); CMULT(3,0,9); CMULT(4,3,10); CMULT(5,6,11); CMULT(3,1,12); CMULT(4,4,13); CMULT(5,7,14); CMULT(3,2,15); CMULT(4,5,16); CMULT(5,8,17); CMULT(6,0,18); CMULT(7,3,19); CMULT(8,6,20); CMULT(6,1,21); CMULT(7,4,22); CMULT(8,7,23); CMULT(6,2,24); CMULT(7,5,25); CMULT(8,8,26); CPUT3(0,1,2,0); CPUT3(3,4,5,1); CPUT3(6,7,8,2); CPUT3(9,10,11,3); CPUT3(12,13,14,4); CPUT3(15,16,17,5); CPUT3(18,19,20,6); CPUT3(21,22,23,7); CPUT3(24,25,26,8); } } R->Type = TENSOR; } else if (V1->Type == TENSOR_SYM && V2->Type == TENSOR) { if (Current.NbrHar == 1) { a1[0] = V1->Val[0]*V2->Val[0] + V1->Val[1]*V2->Val[3] + V1->Val[2]*V2->Val[6]; a1[1] = V1->Val[0]*V2->Val[1] + V1->Val[1]*V2->Val[4] + V1->Val[2]*V2->Val[7]; a1[2] = V1->Val[0]*V2->Val[2] + V1->Val[1]*V2->Val[5] + V1->Val[2]*V2->Val[8]; a1[3] = V1->Val[1]*V2->Val[0] + V1->Val[3]*V2->Val[3] + V1->Val[4]*V2->Val[6]; a1[4] = V1->Val[1]*V2->Val[1] + V1->Val[3]*V2->Val[4] + V1->Val[4]*V2->Val[7]; a1[5] = V1->Val[1]*V2->Val[2] + V1->Val[3]*V2->Val[5] + V1->Val[4]*V2->Val[8]; a1[6] = V1->Val[2]*V2->Val[0] + V1->Val[4]*V2->Val[3] + V1->Val[5]*V2->Val[6]; a1[7] = V1->Val[2]*V2->Val[1] + V1->Val[4]*V2->Val[4] + V1->Val[5]*V2->Val[7]; a1[8] = V1->Val[2]*V2->Val[2] + V1->Val[4]*V2->Val[5] + V1->Val[5]*V2->Val[8]; R->Val[0] = a1[0]; R->Val[1] = a1[1]; R->Val[2] = a1[2]; R->Val[3] = a1[3]; R->Val[4] = a1[4]; R->Val[5] = a1[5]; R->Val[6] = a1[6]; R->Val[7] = a1[7]; R->Val[8] = a1[8]; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CMULT(0,0,0); CMULT(1,3,1); CMULT(2,6,2); CMULT(0,1,3); CMULT(1,4,4); CMULT(2,7,5); CMULT(0,2,6); CMULT(1,5,7); CMULT(2,8,8); CMULT(1,0,9); CMULT(2,3,10); CMULT(4,6,11); CMULT(1,1,12); CMULT(2,4,13); CMULT(4,7,14); CMULT(1,2,15); CMULT(2,5,16); CMULT(4,8,17); CMULT(3,0,18); CMULT(4,3,19); CMULT(5,6,20); CMULT(3,1,21); CMULT(4,4,22); CMULT(5,7,23); CMULT(3,2,24); CMULT(4,5,25); CMULT(5,8,26); CPUT3(0,1,2,0); CPUT3(3,4,5,1); CPUT3(6,7,8,2); CPUT3(9,10,11,3); CPUT3(12,13,14,4); CPUT3(15,16,17,5); CPUT3(18,19,20,6); CPUT3(21,22,23,7); CPUT3(24,25,26,8); } } R->Type = TENSOR; } else if (V1->Type == TENSOR && V2->Type == TENSOR_SYM) { if (Current.NbrHar == 1) { a1[0] = V1->Val[0]*V2->Val[0] + V1->Val[1]*V2->Val[1] + V1->Val[2]*V2->Val[2]; a1[1] = V1->Val[0]*V2->Val[1] + V1->Val[1]*V2->Val[3] + V1->Val[2]*V2->Val[4]; a1[2] = V1->Val[0]*V2->Val[2] + V1->Val[1]*V2->Val[4] + V1->Val[2]*V2->Val[5]; a1[3] = V1->Val[3]*V2->Val[0] + V1->Val[4]*V2->Val[1] + V1->Val[5]*V2->Val[2]; a1[4] = V1->Val[3]*V2->Val[1] + V1->Val[4]*V2->Val[3] + V1->Val[5]*V2->Val[4]; a1[5] = V1->Val[3]*V2->Val[2] + V1->Val[4]*V2->Val[4] + V1->Val[5]*V2->Val[5]; a1[6] = V1->Val[6]*V2->Val[0] + V1->Val[7]*V2->Val[1] + V1->Val[8]*V2->Val[2]; a1[7] = V1->Val[6]*V2->Val[1] + V1->Val[7]*V2->Val[3] + V1->Val[8]*V2->Val[4]; a1[8] = V1->Val[6]*V2->Val[2] + V1->Val[7]*V2->Val[4] + V1->Val[8]*V2->Val[5]; R->Val[0] = a1[0]; R->Val[1] = a1[1]; R->Val[2] = a1[2]; R->Val[3] = a1[3]; R->Val[4] = a1[4]; R->Val[5] = a1[5]; R->Val[6] = a1[6]; R->Val[7] = a1[7]; R->Val[8] = a1[8]; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CMULT(0,0,0); CMULT(1,1,1); CMULT(2,2,2); CMULT(0,1,3); CMULT(1,3,4); CMULT(2,4,5); CMULT(0,2,6); CMULT(1,4,7); CMULT(2,5,8); CMULT(3,0,9); CMULT(4,1,10); CMULT(5,2,11); CMULT(3,1,12); CMULT(4,3,13); CMULT(5,4,14); CMULT(3,2,15); CMULT(4,4,16); CMULT(5,5,17); CMULT(6,0,18); CMULT(7,1,19); CMULT(8,2,20); CMULT(6,1,21); CMULT(7,3,22); CMULT(8,4,23); CMULT(6,2,24); CMULT(7,4,25); CMULT(8,5,26); CPUT3(0,1,2,0); CPUT3(3,4,5,1); CPUT3(6,7,8,2); CPUT3(9,10,11,3); CPUT3(12,13,14,4); CPUT3(15,16,17,5); CPUT3(18,19,20,6); CPUT3(21,22,23,7); CPUT3(24,25,26,8); } } R->Type = TENSOR; } /* a faire: differents tenseurs entre eux */ else { Message::Error("Product of non adapted quantities: %s * %s", Get_StringForDefine(Field_Type, V1->Type), Get_StringForDefine(Field_Type, V2->Type)); } } #undef CMULT #undef CPUT #undef CPUT3 /* ------------------------------------------------------------------------ R <- V1 / V2 ------------------------------------------------------------------------ */ #define CDIVI(a,b,c) \ Cal_ComplexDivision(&(V1->Val[MAX_DIM*k+a]), &(V2->Val[MAX_DIM*k+b]), tmp[c]) #define CPUT(a) \ R->Val[MAX_DIM* k +a] = tmp[a][0] ; \ R->Val[MAX_DIM*(k+1)+a] = tmp[a][MAX_DIM] void Cal_DivideValue(struct Value * V1, struct Value * V2, struct Value * R) { int k ; struct Value V3 ; if ( (V1->Type == SCALAR) && (V2->Type == SCALAR) ) { if (Current.NbrHar == 1) { R->Val[0] = V1->Val[0]/V2->Val[0]; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { /* meaning in multi-harmonics ??? */ CDIVI(0,0,0); CPUT(0); } } R->Type = SCALAR ; } else if ( (V1->Type == VECTOR || V1->Type == TENSOR_DIAG) && (V2->Type == SCALAR) ) { if (Current.NbrHar == 1) { a0 = V2->Val[0] ; R->Val[0] = V1->Val[0] / a0 ; R->Val[1] = V1->Val[1] / a0 ; R->Val[2] = V1->Val[2] / a0 ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CDIVI(0,0,0); CDIVI(1,0,1); CDIVI(2,0,2); CPUT(0); CPUT(1); CPUT(2); } } R->Type = V1->Type ; } else if ( (V1->Type == TENSOR_SYM) && (V2->Type == SCALAR) ) { if (Current.NbrHar == 1) { a0 = V2->Val[0] ; R->Val[0] = V1->Val[0] / a0 ; R->Val[1] = V1->Val[1] / a0 ; R->Val[2] = V1->Val[2] / a0 ; R->Val[3] = V1->Val[3] / a0 ; R->Val[4] = V1->Val[4] / a0 ; R->Val[5] = V1->Val[5] / a0 ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CDIVI(0,0,0); CDIVI(1,0,1); CDIVI(2,0,2); CDIVI(3,0,3); CDIVI(4,0,4); CDIVI(5,0,5); CPUT(0); CPUT(1); CPUT(2); CPUT(3); CPUT(4); CPUT(5); } } R->Type = TENSOR_SYM ; } else if ( (V1->Type == TENSOR) && (V2->Type == SCALAR) ) { if (Current.NbrHar == 1) { a0 = V2->Val[0] ; R->Val[0] = V1->Val[0] / a0 ; R->Val[1] = V1->Val[1] / a0 ; R->Val[2] = V1->Val[2] / a0 ; R->Val[3] = V1->Val[3] / a0 ; R->Val[4] = V1->Val[4] / a0 ; R->Val[5] = V1->Val[5] / a0 ; R->Val[6] = V1->Val[6] / a0 ; R->Val[7] = V1->Val[7] / a0 ; R->Val[8] = V1->Val[8] / a0 ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { CDIVI(0,0,0); CDIVI(1,0,1); CDIVI(2,0,2); CDIVI(3,0,3); CDIVI(4,0,4); CDIVI(5,0,5); CDIVI(6,0,6); CDIVI(7,0,7); CDIVI(8,0,8); CPUT(0); CPUT(1); CPUT(2); CPUT(3); CPUT(4); CPUT(5); CPUT(6); CPUT(7); CPUT(8); } } R->Type = TENSOR ; } else if ( (V1->Type == SCALAR) && (V2->Type == TENSOR || V2->Type == TENSOR_SYM || V2->Type == TENSOR_DIAG) ) { Cal_InvertValue(V2,&V3); Cal_ProductValue(V1,&V3,R); } else { Message::Error("Division of non adapted quantities: %s / %s", Get_StringForDefine(Field_Type, V1->Type), Get_StringForDefine(Field_Type, V2->Type)); } } #undef CDIVI #undef CPUT /* ------------------------------------------------------------------------ R <- V1 % V2 ------------------------------------------------------------------------ */ void Cal_ModuloValue(struct Value * V1, struct Value * V2, struct Value * R) { int k ; if ( (V1->Type == SCALAR) && (V2->Type == SCALAR) ) { for (k = 0 ; k < Current.NbrHar ; k += 2) { R->Val[MAX_DIM* k ] = (int)V1->Val[MAX_DIM*k] % (int)V2->Val[MAX_DIM*k] ; R->Val[MAX_DIM*(k+1)] = 0. ; } R->Type = SCALAR ; } else if ( (V1->Type == VECTOR) && (V2->Type == SCALAR) ) { for (k = 0 ; k < Current.NbrHar ; k += 2) { R->Val[MAX_DIM* k ] = (int)V1->Val[MAX_DIM*k ] % (int)V2->Val[MAX_DIM*k ] ; R->Val[MAX_DIM* k +1] = (int)V1->Val[MAX_DIM*k+1] % (int)V2->Val[MAX_DIM*k+1] ; R->Val[MAX_DIM* k +2] = (int)V1->Val[MAX_DIM*k+2] % (int)V2->Val[MAX_DIM*k+2] ; R->Val[MAX_DIM*(k+1)] = 0. ; R->Val[MAX_DIM*(k+1)+1] = 0. ; R->Val[MAX_DIM*(k+1)+2] = 0. ; } R->Type = VECTOR ; } else { Message::Error("Modulo of non adapted quantities: %s %% %s", Get_StringForDefine(Field_Type, V1->Type), Get_StringForDefine(Field_Type, V2->Type)); } } /* ------------------------------------------------------------------------ R <- V1 X V2 ------------------------------------------------------------------------ */ void Cal_CrossProductValue (struct Value * V1, struct Value * V2, struct Value * R) { int k ; if ( (V1->Type == VECTOR) && (V2->Type == VECTOR) ) { if (Current.NbrHar == 1) { a1[0] = V1->Val[1] * V2->Val[2] - V1->Val[2] * V2->Val[1] ; a1[1] = V1->Val[2] * V2->Val[0] - V1->Val[0] * V2->Val[2] ; a1[2] = V1->Val[0] * V2->Val[1] - V1->Val[1] * V2->Val[0] ; R->Val[0] = a1[0] ; R->Val[1] = a1[1] ; R->Val[2] = a1[2] ; } else { for (k = 0 ; k < Current.NbrHar ; k += 2) { Cal_ComplexProduct(&(V1->Val[MAX_DIM*k+1]), &(V2->Val[MAX_DIM*k+2]), a1) ; Cal_ComplexProduct(&(V1->Val[MAX_DIM*k+2]), &(V2->Val[MAX_DIM*k+1]), a2) ; b1[0] = a1[0] - a2[0] ; b1[MAX_DIM] = a1[MAX_DIM] - a2[MAX_DIM] ; Cal_ComplexProduct(&(V1->Val[MAX_DIM*k+2]), &(V2->Val[MAX_DIM*k ]), a1) ; Cal_ComplexProduct(&(V1->Val[MAX_DIM*k ]), &(V2->Val[MAX_DIM*k+2]), a2) ; b2[0] = a1[0] - a2[0] ; b2[MAX_DIM] = a1[MAX_DIM] - a2[MAX_DIM] ; Cal_ComplexProduct(&(V1->Val[MAX_DIM*k ]), &(V2->Val[MAX_DIM*k+1]), a1) ; Cal_ComplexProduct(&(V1->Val[MAX_DIM*k+1]), &(V2->Val[MAX_DIM*k ]), a2) ; b3[0] = a1[0] - a2[0] ; b3[MAX_DIM] = a1[MAX_DIM] - a2[MAX_DIM] ; R->Val[MAX_DIM*k ] = b1[0] ; R->Val[MAX_DIM*(k+1) ] = b1[MAX_DIM] ; R->Val[MAX_DIM*k+1] = b2[0] ; R->Val[MAX_DIM*(k+1)+1] = b2[MAX_DIM] ; R->Val[MAX_DIM*k+2] = b3[0] ; R->Val[MAX_DIM*(k+1)+2] = b3[MAX_DIM] ; } } R->Type = VECTOR ; } else { Message::Error("Cross product of non vector quantities: %s /\\ %s", Get_StringForDefine(Field_Type, V1->Type), Get_StringForDefine(Field_Type, V2->Type)); } } /* ------------------------------------------------------------------------ R <- SQRT(V1) ------------------------------------------------------------------------ */ void Cal_SqrtValue(struct Value *V1, struct Value *R) { if( V1->Type == SCALAR ){ struct Value P; P.Type = SCALAR; P.Val[0] = 0.5; Cal_PowerValue(V1, &P, R); } else { Message::Error("Square root of non scalar quantity: %s", Get_StringForDefine(Field_Type, V1->Type)); } } /* ------------------------------------------------------------------------ R <- V1 ^ V2 ------------------------------------------------------------------------ */ void Cal_PowerValue(struct Value * V1, struct Value * V2, struct Value * R) { int k; double arg, abs ; if ( V1->Type == SCALAR && V2->Type == SCALAR ){ if(V2->Val[0] == 1.){ Cal_CopyValue(V1,R) ; } if(V2->Val[0] == 2.){ if (Current.NbrHar == 1) { R->Val[0] = SQU(V1->Val[0]) ; } else{ for (k = 0 ; k < Current.NbrHar ; k+=2) { Cal_ComplexProduct(&(V1->Val[MAX_DIM*k]), &(V1->Val[MAX_DIM*k]), a1) ; R->Val[MAX_DIM* k ] = a1[0]; R->Val[MAX_DIM*(k+1)] = a1[MAX_DIM]; } } } else{ if (Current.NbrHar == 1) { R->Val[0] = pow(V1->Val[0],V2->Val[0]) ; } else{ for (k = 0 ; k < Current.NbrHar ; k+=2) { abs = pow(sqrt(SQU(V1->Val[MAX_DIM*k])+SQU(V1->Val[MAX_DIM*(k+1)])), V2->Val[0]) ; arg = atan2(V1->Val[MAX_DIM*(k+1)], V1->Val[MAX_DIM*k]) ; R->Val[MAX_DIM* k ] = abs * cos(V2->Val[0] * arg) ; R->Val[MAX_DIM*(k+1)] = abs * sin(V2->Val[0] * arg) ; } } } R->Type = SCALAR ; } else { Message::Error("Power of non scalar quantities: %s ^ %s", Get_StringForDefine(Field_Type, V1->Type), Get_StringForDefine(Field_Type, V2->Type)); } } /* ------------------------------------------------------------------------ R <- V1 < V2 ------------------------------------------------------------------------ */ void Cal_LessValue(struct Value * V1, struct Value * V2, struct Value * R) { if ( (V1->Type == SCALAR) && (V2->Type == SCALAR) ) { R->Val[0] = (V1->Val[0] < V2->Val[0]) ; R->Type = SCALAR ; } else { Message::Error("Comparison of non scalar quantities: %s < %s", Get_StringForDefine(Field_Type, V1->Type), Get_StringForDefine(Field_Type, V2->Type)); } } /* ------------------------------------------------------------------------ R <- V1 <= V2 ------------------------------------------------------------------------ */ void Cal_LessOrEqualValue(struct Value * V1, struct Value * V2, struct Value * R) { if ( (V1->Type == SCALAR) && (V2->Type == SCALAR) ) { R->Val[0] = (V1->Val[0] <= V2->Val[0]) ; R->Type = SCALAR ; } else { Message::Error("Comparison of non scalar quantities: %s <= %s", Get_StringForDefine(Field_Type, V1->Type), Get_StringForDefine(Field_Type, V2->Type)); } } /* ------------------------------------------------------------------------ R <- V1 > V2 ------------------------------------------------------------------------ */ void Cal_GreaterValue(struct Value * V1, struct Value * V2, struct Value * R) { if ( (V1->Type == SCALAR) && (V2->Type == SCALAR) ) { R->Val[0] = (V1->Val[0] > V2->Val[0]) ; R->Type = SCALAR ; } else { Message::Error("Comparison of non scalar quantities: %s > %s", Get_StringForDefine(Field_Type, V1->Type), Get_StringForDefine(Field_Type, V2->Type)); } } /* ------------------------------------------------------------------------ R <- V1 >= V2 ------------------------------------------------------------------------ */ void Cal_GreaterOrEqualValue(struct Value * V1, struct Value * V2, struct Value * R) { if ( (V1->Type == SCALAR) && (V2->Type == SCALAR) ) { R->Val[0] = (V1->Val[0] >= V2->Val[0]) ; R->Type = SCALAR ; } else { Message::Error("Comparison of non scalar quantities: %s >= %s", Get_StringForDefine(Field_Type, V1->Type), Get_StringForDefine(Field_Type, V2->Type)); } } /* ------------------------------------------------------------------------ R <- V1 == V2 ------------------------------------------------------------------------ */ void Cal_EqualValue(struct Value * V1, struct Value * V2, struct Value * R) { int k; if ( (V1->Type == SCALAR) && (V2->Type == SCALAR) ) { R->Val[0] = (V1->Val[0] == V2->Val[0]) ; for (k = 1 ; k < Current.NbrHar ; k++){ if(!R->Val[0]) break; R->Val[0] = (V1->Val[MAX_DIM*k] == V2->Val[MAX_DIM*k]) ; } R->Type = SCALAR ; } else if ( ( (V1->Type == VECTOR) && (V2->Type == VECTOR) ) || ( (V1->Type == TENSOR_DIAG) && (V2->Type == TENSOR_DIAG) ) ) { R->Val[0] = (V1->Val[0] == V2->Val[0] && V1->Val[1] == V2->Val[1] && V1->Val[2] == V2->Val[2]) ; for (k = 0 ; k < Current.NbrHar ; k++) { if(!R->Val[0]) break; R->Val[0] = (V1->Val[MAX_DIM*k ] == V2->Val[MAX_DIM*k ] && V1->Val[MAX_DIM*k+1] == V2->Val[MAX_DIM*k+1] && V1->Val[MAX_DIM*k+2] == V2->Val[MAX_DIM*k+2]) ; } R->Type = SCALAR ; } else if ( (V1->Type == TENSOR_SYM) && (V2->Type == TENSOR_SYM) ) { R->Val[0] = (V1->Val[0] == V2->Val[0] && V1->Val[1] == V2->Val[1] && V1->Val[2] == V2->Val[2] && V1->Val[3] == V2->Val[3] && V1->Val[4] == V2->Val[4] && V1->Val[5] == V2->Val[5]) ; for (k = 0 ; k < Current.NbrHar ; k++) { if(!R->Val[0]) break; R->Val[0] = (V1->Val[MAX_DIM*k ] == V2->Val[MAX_DIM*k ] && V1->Val[MAX_DIM*k+1] == V2->Val[MAX_DIM*k+1] && V1->Val[MAX_DIM*k+2] == V2->Val[MAX_DIM*k+2] && V1->Val[MAX_DIM*k+3] == V2->Val[MAX_DIM*k+3] && V1->Val[MAX_DIM*k+4] == V2->Val[MAX_DIM*k+4] && V1->Val[MAX_DIM*k+5] == V2->Val[MAX_DIM*k+5]) ; } R->Type = SCALAR ; } else if ( (V1->Type == TENSOR) && (V2->Type == TENSOR) ) { R->Val[0] = (V1->Val[0] == V2->Val[0] && V1->Val[1] == V2->Val[1] && V1->Val[2] == V2->Val[2] && V1->Val[3] == V2->Val[3] && V1->Val[4] == V2->Val[4] && V1->Val[5] == V2->Val[5] && V1->Val[6] == V2->Val[6] && V1->Val[7] == V2->Val[7] && V1->Val[8] == V2->Val[8]) ; for (k = 0 ; k < Current.NbrHar ; k++) { if(!R->Val[0]) break; R->Val[0] = (V1->Val[MAX_DIM*k ] == V2->Val[MAX_DIM*k ] && V1->Val[MAX_DIM*k+1] == V2->Val[MAX_DIM*k+1] && V1->Val[MAX_DIM*k+2] == V2->Val[MAX_DIM*k+2] && V1->Val[MAX_DIM*k+3] == V2->Val[MAX_DIM*k+3] && V1->Val[MAX_DIM*k+4] == V2->Val[MAX_DIM*k+4] && V1->Val[MAX_DIM*k+5] == V2->Val[MAX_DIM*k+5] && V1->Val[MAX_DIM*k+6] == V2->Val[MAX_DIM*k+6] && V1->Val[MAX_DIM*k+7] == V2->Val[MAX_DIM*k+7] && V1->Val[MAX_DIM*k+8] == V2->Val[MAX_DIM*k+8]) ; } R->Type = SCALAR ; } else { Message::Error("Comparison of different quantities: %s == %s", Get_StringForDefine(Field_Type, V1->Type), Get_StringForDefine(Field_Type, V2->Type)); } } /* ------------------------------------------------------------------------ R <- V1 != V2 ------------------------------------------------------------------------ */ void Cal_NotEqualValue(struct Value * V1, struct Value * V2, struct Value * R) { int k; if ( (V1->Type == SCALAR) && (V2->Type == SCALAR) ) { R->Val[0] = (V1->Val[0] != V2->Val[0]) ; for (k = 1 ; k < Current.NbrHar ; k++){ if(R->Val[0]) break; R->Val[0] = (V1->Val[MAX_DIM*k] != V2->Val[MAX_DIM*k]) ; } R->Type = SCALAR ; } else if ( ( (V1->Type == VECTOR) && (V2->Type == VECTOR) ) || ( (V1->Type == TENSOR_DIAG) && (V2->Type == TENSOR_DIAG) ) ) { R->Val[0] = (V1->Val[0] != V2->Val[0] || V1->Val[1] != V2->Val[1] || V1->Val[2] != V2->Val[2]) ; for (k = 0 ; k < Current.NbrHar ; k++) { if(R->Val[0]) break; R->Val[0] = (V1->Val[MAX_DIM*k ] != V2->Val[MAX_DIM*k ] || V1->Val[MAX_DIM*k+1] != V2->Val[MAX_DIM*k+1] || V1->Val[MAX_DIM*k+2] != V2->Val[MAX_DIM*k+2]) ; } R->Type = SCALAR ; } else if ( (V1->Type == TENSOR_SYM) && (V2->Type == TENSOR_SYM) ) { R->Val[0] = (V1->Val[0] != V2->Val[0] || V1->Val[1] != V2->Val[1] || V1->Val[2] != V2->Val[2] || V1->Val[3] != V2->Val[3] || V1->Val[4] != V2->Val[4] || V1->Val[5] != V2->Val[5]) ; for (k = 0 ; k < Current.NbrHar ; k++) { if(R->Val[0]) break; R->Val[0] = (V1->Val[MAX_DIM*k ] != V2->Val[MAX_DIM*k ] || V1->Val[MAX_DIM*k+1] != V2->Val[MAX_DIM*k+1] || V1->Val[MAX_DIM*k+2] != V2->Val[MAX_DIM*k+2] || V1->Val[MAX_DIM*k+3] != V2->Val[MAX_DIM*k+3] || V1->Val[MAX_DIM*k+4] != V2->Val[MAX_DIM*k+4] || V1->Val[MAX_DIM*k+5] != V2->Val[MAX_DIM*k+5]) ; } R->Type = SCALAR ; } else if ( (V1->Type == TENSOR) && (V2->Type == TENSOR) ) { R->Val[0] = (V1->Val[0] != V2->Val[0] || V1->Val[1] != V2->Val[1] || V1->Val[2] != V2->Val[2] || V1->Val[3] != V2->Val[3] || V1->Val[4] != V2->Val[4] || V1->Val[5] != V2->Val[5] || V1->Val[6] != V2->Val[6] || V1->Val[7] != V2->Val[7] || V1->Val[8] != V2->Val[8]) ; for (k = 0 ; k < Current.NbrHar ; k++) { if(R->Val[0]) break; R->Val[0] = (V1->Val[MAX_DIM*k ] != V2->Val[MAX_DIM*k ] || V1->Val[MAX_DIM*k+1] != V2->Val[MAX_DIM*k+1] || V1->Val[MAX_DIM*k+2] != V2->Val[MAX_DIM*k+2] || V1->Val[MAX_DIM*k+3] != V2->Val[MAX_DIM*k+3] || V1->Val[MAX_DIM*k+4] != V2->Val[MAX_DIM*k+4] || V1->Val[MAX_DIM*k+5] != V2->Val[MAX_DIM*k+5] || V1->Val[MAX_DIM*k+6] != V2->Val[MAX_DIM*k+6] || V1->Val[MAX_DIM*k+7] != V2->Val[MAX_DIM*k+7] || V1->Val[MAX_DIM*k+8] != V2->Val[MAX_DIM*k+8]) ; } R->Type = SCALAR ; } else { Message::Error("Comparison of different quantities: %s != %s", Get_StringForDefine(Field_Type, V1->Type), Get_StringForDefine(Field_Type, V2->Type)); } } /* ------------------------------------------------------------------------ R <- V1 ~= V2 ------------------------------------------------------------------------ */ void Cal_ApproxEqualValue(struct Value * V1, struct Value * V2, struct Value * R) { if ( (V1->Type == SCALAR) && (V2->Type == SCALAR) ) { R->Val[0] = (fabs(V1->Val[0] - V2->Val[0]) < 1.e-10) ; R->Type = SCALAR ; } else { Message::Error("Comparison of non scalar quantities: %s ~= %s", Get_StringForDefine(Field_Type, V1->Type), Get_StringForDefine(Field_Type, V2->Type)); } } /* ------------------------------------------------------------------------ R <- V1 && V2 ------------------------------------------------------------------------ */ void Cal_AndValue(struct Value * V1, struct Value * V2, struct Value * R) { if ( (V1->Type == SCALAR) && (V2->Type == SCALAR) ) { R->Val[0] = (V1->Val[0] && V2->Val[0]) ; R->Type = SCALAR ; } else { Message::Error("And of non scalar quantities: %s && %s", Get_StringForDefine(Field_Type, V1->Type), Get_StringForDefine(Field_Type, V2->Type)); } } /* ------------------------------------------------------------------------ R <- V1 || V2 ------------------------------------------------------------------------ */ void Cal_OrValue(struct Value * V1, struct Value * V2, struct Value * R) { if ( (V1->Type == SCALAR) && (V2->Type == SCALAR) ) { R->Val[0] = (V1->Val[0] || V2->Val[0]) ; R->Type = SCALAR ; } else { Message::Error("Or of non scalar quantities: %s || %s", Get_StringForDefine(Field_Type, V1->Type), Get_StringForDefine(Field_Type, V2->Type)); } } /* ------------------------------------------------------------------------ R <- -R ------------------------------------------------------------------------ */ void Cal_NegValue(struct Value * R) { int k ; switch(R->Type) { case SCALAR : for (k = 0 ; k < Current.NbrHar ; k++){ R->Val[MAX_DIM*k] = -R->Val[MAX_DIM*k] ; } break; case VECTOR : case TENSOR_DIAG : for (k = 0 ; k < Current.NbrHar ; k++){ R->Val[MAX_DIM*k ] = -R->Val[MAX_DIM*k ] ; R->Val[MAX_DIM*k+1] = -R->Val[MAX_DIM*k+1] ; R->Val[MAX_DIM*k+2] = -R->Val[MAX_DIM*k+2] ; } break; case TENSOR_SYM : for (k = 0 ; k < Current.NbrHar ; k++){ R->Val[MAX_DIM*k ] = -R->Val[MAX_DIM*k ] ; R->Val[MAX_DIM*k+1] = -R->Val[MAX_DIM*k+1] ; R->Val[MAX_DIM*k+2] = -R->Val[MAX_DIM*k+2] ; R->Val[MAX_DIM*k+3] = -R->Val[MAX_DIM*k+3] ; R->Val[MAX_DIM*k+4] = -R->Val[MAX_DIM*k+4] ; R->Val[MAX_DIM*k+5] = -R->Val[MAX_DIM*k+5] ; } break; case TENSOR : for (k = 0 ; k < Current.NbrHar ; k++){ R->Val[MAX_DIM*k ] = -R->Val[MAX_DIM*k ] ; R->Val[MAX_DIM*k+1] = -R->Val[MAX_DIM*k+1] ; R->Val[MAX_DIM*k+2] = -R->Val[MAX_DIM*k+2] ; R->Val[MAX_DIM*k+3] = -R->Val[MAX_DIM*k+3] ; R->Val[MAX_DIM*k+4] = -R->Val[MAX_DIM*k+4] ; R->Val[MAX_DIM*k+5] = -R->Val[MAX_DIM*k+5] ; R->Val[MAX_DIM*k+6] = -R->Val[MAX_DIM*k+6] ; R->Val[MAX_DIM*k+7] = -R->Val[MAX_DIM*k+7] ; R->Val[MAX_DIM*k+8] = -R->Val[MAX_DIM*k+8] ; } break; default : Message::Error("Wrong argument type for Operator (-)"); break; } } /* ------------------------------------------------------------------------ R <- !R ------------------------------------------------------------------------ */ void Cal_NotValue(struct Value * R) { if (R->Type == SCALAR){ R->Val[0] = !R->Val[0] ; } else { Message::Error("Negation of non scalar quantity: ! %s", Get_StringForDefine(Field_Type, R->Type)); } } /* ------------------------------------------------------------------------ R <- V1^T ------------------------------------------------------------------------ */ void Cal_TransposeValue(struct Value *V1, struct Value *R) { int k; switch(V1->Type){ case TENSOR_DIAG : case TENSOR_SYM : Cal_CopyValue(V1,R); break; case TENSOR : R->Type = TENSOR; if(Current.NbrHar==1){ R->Val[0] = V1->Val[0]; R->Val[4] = V1->Val[4]; R->Val[8] = V1->Val[8]; a1[0] = V1->Val[1]; a1[1] = V1->Val[2]; a1[2] = V1->Val[5]; R->Val[1] = V1->Val[3]; R->Val[2] = V1->Val[6]; R->Val[5] = V1->Val[7]; R->Val[3] = a1[0]; R->Val[6] = a1[1]; R->Val[7] = a1[2]; } else{ for(k=0 ; kVal[MAX_DIM*k+0] = V1->Val[MAX_DIM*k+0]; R->Val[MAX_DIM*k+4] = V1->Val[MAX_DIM*k+4]; R->Val[MAX_DIM*k+8] = V1->Val[MAX_DIM*k+8]; a1[0] = V1->Val[MAX_DIM*k+1]; a1[1] = V1->Val[MAX_DIM*k+2]; a1[2] = V1->Val[MAX_DIM*k+5]; R->Val[MAX_DIM*k+1] = V1->Val[MAX_DIM*k+3]; R->Val[MAX_DIM*k+2] = V1->Val[MAX_DIM*k+6]; R->Val[MAX_DIM*k+5] = V1->Val[MAX_DIM*k+7]; R->Val[MAX_DIM*k+3] = a1[0]; R->Val[MAX_DIM*k+6] = a1[1]; R->Val[MAX_DIM*k+7] = a1[2]; } } break; default: Message::Error("Wrong argument in 'Cal_TransposeValue'"); break; } } /* ------------------------------------------------------------------------ R <- Trace(V1) ------------------------------------------------------------------------ */ void Cal_TraceValue(struct Value *V1, struct Value *R) { int k; switch(V1->Type){ case TENSOR_DIAG : if (Current.NbrHar == 1) { R->Val[0] = V1->Val[0]+V1->Val[1]+V1->Val[2]; } else { for (k = 0 ; k < Current.NbrHar ; k++) { R->Val[MAX_DIM*k] = V1->Val[MAX_DIM*k ]+ V1->Val[MAX_DIM*k+1]+ V1->Val[MAX_DIM*k+2]; } } R->Type = SCALAR ; break; case TENSOR_SYM : if (Current.NbrHar == 1) { R->Val[0] = V1->Val[0]+V1->Val[3]+V1->Val[5]; } else { for (k = 0 ; k < Current.NbrHar ; k++) { R->Val[MAX_DIM*k] = V1->Val[MAX_DIM*k ]+ V1->Val[MAX_DIM*k+3]+ V1->Val[MAX_DIM*k+5]; } } R->Type = SCALAR ; break; case TENSOR : if (Current.NbrHar == 1) { R->Val[0] = V1->Val[0]+V1->Val[4]+V1->Val[8]; } else { for (k = 0 ; k < Current.NbrHar ; k++) { R->Val[MAX_DIM*k] = V1->Val[MAX_DIM*k ]+ V1->Val[MAX_DIM*k+4]+ V1->Val[MAX_DIM*k+8]; } } R->Type = SCALAR ; break; default: Message::Error("Wrong argument type in 'Cal_TraceValue'"); break; } } /* ------------------------------------------------------------------------ R <- V1^T * V2 * V1 , V1 real ------------------------------------------------------------------------ */ #define A0 V1->Val[0] #define A1 V1->Val[1] #define A2 V1->Val[2] #define A3 V1->Val[3] #define A4 V1->Val[4] #define A5 V1->Val[5] #define A6 V1->Val[6] #define A7 V1->Val[7] #define A8 V1->Val[8] void Cal_RotateValue(struct Value *V1, struct Value *V2, struct Value *R) { int k; double t0,t1,t2,t3,t4,t5,t6,t7,t8; struct Value A; switch(V2->Type){ case VECTOR : if(Current.NbrHar == 1){ #define B0 V2->Val[0] #define B1 V2->Val[1] #define B2 V2->Val[2] A.Val[0]= A0*B0+A1*B1+A2*B2; A.Val[1]= A3*B0+A4*B1+A5*B2; A.Val[2]= A6*B0+A7*B1+A8*B2; A.Type = VECTOR; Cal_CopyValue(&A,R); #undef B0 #undef B1 #undef B2 } else{ /* Attention: a modifier */ #define B0 V2->Val[0] #define B1 V2->Val[1] #define B2 V2->Val[2] A.Val[0]= A0*B0+A1*B1+A2*B2; A.Val[1]= A3*B0+A4*B1+A5*B2; A.Val[2]= A6*B0+A7*B1+A8*B2; A.Type = VECTOR; Cal_CopyValue(&A,R); #undef B0 #undef B1 #undef B2 } break ; case TENSOR_DIAG : if(Current.NbrHar == 1){ #define B0 V2->Val[0] #define B1 V2->Val[1] #define B2 V2->Val[2] A.Val[0]= A0*A0*B0+A3*A3*B1+A6*A6*B2; A.Val[1]= A1*A0*B0+A3*A4*B1+A6*A7*B2; A.Val[2]= A2*A0*B0+A3*A5*B1+A6*A8*B2; A.Val[3]= A1*A0*B0+A3*A4*B1+A6*A7*B2; A.Val[4]= A1*A1*B0+A4*A4*B1+A7*A7*B2; A.Val[5]= A2*A1*B0+A4*A5*B1+A7*A8*B2; A.Val[6]= A2*A0*B0+A3*A5*B1+A6*A8*B2; A.Val[7]= A2*A1*B0+A4*A5*B1+A7*A8*B2; A.Val[8]= A2*A2*B0+A5*A5*B1+A8*A8*B2; A.Type = TENSOR; Cal_CopyValue(&A,R); #undef B0 #undef B1 #undef B2 } else{ #define B0r V2->Val[MAX_DIM* k +0] #define B1r V2->Val[MAX_DIM* k +1] #define B2r V2->Val[MAX_DIM* k +2] #define B0i V2->Val[MAX_DIM*(k+1)+0] #define B1i V2->Val[MAX_DIM*(k+1)+1] #define B2i V2->Val[MAX_DIM*(k+1)+2] #define AFFECT(i) \ A.Val[MAX_DIM* k +i] = t0*B0r+t1*B1r+t2*B2r; \ A.Val[MAX_DIM*(k+1)+i] = t0*B0i+t1*B1i+t2*B2i for(k=0 ; kVal[0] #define B1 V2->Val[1] #define B2 V2->Val[2] #define B3 V2->Val[1] #define B4 V2->Val[3] #define B5 V2->Val[4] #define B6 V2->Val[2] #define B7 V2->Val[4] #define B8 V2->Val[5] COMPUTE_A; A.Type = TENSOR; Cal_CopyValue(&A,R); #undef B0 #undef B1 #undef B2 #undef B3 #undef B4 #undef B5 #undef B6 #undef B7 #undef B8 } else{ #define B0r V2->Val[MAX_DIM* k +0] #define B1r V2->Val[MAX_DIM* k +1] #define B2r V2->Val[MAX_DIM* k +2] #define B3r V2->Val[MAX_DIM* k +3] #define B4r V2->Val[MAX_DIM* k +4] #define B5r V2->Val[MAX_DIM* k +5] #define B6r V2->Val[MAX_DIM* k +6] #define B7r V2->Val[MAX_DIM* k +7] #define B8r V2->Val[MAX_DIM* k +8] #define B0i V2->Val[MAX_DIM*(k+1)+0] #define B1i V2->Val[MAX_DIM*(k+1)+1] #define B2i V2->Val[MAX_DIM*(k+1)+2] #define B3i V2->Val[MAX_DIM*(k+1)+3] #define B4i V2->Val[MAX_DIM*(k+1)+4] #define B5i V2->Val[MAX_DIM*(k+1)+5] #define B6i V2->Val[MAX_DIM*(k+1)+6] #define B7i V2->Val[MAX_DIM*(k+1)+7] #define B8i V2->Val[MAX_DIM*(k+1)+8] #define AFFECT(i) \ A.Val[MAX_DIM* k +i] = t0*B0r+t1*B3r+t2*B6r+t3*B1r+t4*B4r+t5*B7r+t6*B2r+t7*B5r+t8*B8r; \ A.Val[MAX_DIM*(k+1)+i] = t0*B0i+t1*B3i+t2*B6i+t3*B1i+t4*B4i+t5*B7i+t6*B2i+t7*B5i+t8*B8i for(k=0 ; kVal[0] #define B1 V2->Val[1] #define B2 V2->Val[2] #define B3 V2->Val[3] #define B4 V2->Val[4] #define B5 V2->Val[5] #define B6 V2->Val[6] #define B7 V2->Val[7] #define B8 V2->Val[8] COMPUTE_A; A.Type = TENSOR; Cal_CopyValue(&A,R); #undef B0 #undef B1 #undef B2 #undef B3 #undef B4 #undef B5 #undef B6 #undef B7 #undef B8 } else{ #define B0r V2->Val[MAX_DIM* k +0] #define B1r V2->Val[MAX_DIM* k +1] #define B2r V2->Val[MAX_DIM* k +2] #define B3r V2->Val[MAX_DIM* k +3] #define B4r V2->Val[MAX_DIM* k +4] #define B5r V2->Val[MAX_DIM* k +5] #define B6r V2->Val[MAX_DIM* k +6] #define B7r V2->Val[MAX_DIM* k +7] #define B8r V2->Val[MAX_DIM* k +8] #define B0i V2->Val[MAX_DIM*(k+1)+0] #define B1i V2->Val[MAX_DIM*(k+1)+1] #define B2i V2->Val[MAX_DIM*(k+1)+2] #define B3i V2->Val[MAX_DIM*(k+1)+3] #define B4i V2->Val[MAX_DIM*(k+1)+4] #define B5i V2->Val[MAX_DIM*(k+1)+5] #define B6i V2->Val[MAX_DIM*(k+1)+6] #define B7i V2->Val[MAX_DIM*(k+1)+7] #define B8i V2->Val[MAX_DIM*(k+1)+8] #define AFFECT(i) \ A.Val[MAX_DIM* k +i] = t0*B0r+t1*B3r+t2*B6r+t3*B1r+t4*B4r+t5*B7r+t6*B2r+t7*B5r+t8*B8r; \ A.Val[MAX_DIM*(k+1)+i] = t0*B0i+t1*B3i+t2*B6i+t3*B1i+t4*B4i+t5*B7i+t6*B2i+t7*B5i+t8*B8i for(k=0 ; kType; R->Type = SCALAR; switch(V1Type){ case TENSOR_DIAG : if(Current.NbrHar==1){ R->Val[0] = V1->Val[0]*V1->Val[1]*V1->Val[2]; } else{ for(k=0 ; kVal[MAX_DIM*k+0], &V1->Val[MAX_DIM*k+1], a1); Cal_ComplexProduct(&V1->Val[MAX_DIM*k+2], a1, a2); R->Val[MAX_DIM* k ] = a2[0]; R->Val[MAX_DIM*(k+1)] = a2[MAX_DIM]; } } break; case TENSOR_SYM : if(Current.NbrHar==1){ R->Val[0] = V1->Val[0]*(V1->Val[3]*V1->Val[5]-V1->Val[4]*V1->Val[4]) - V1->Val[1]*(V1->Val[1]*V1->Val[5]-V1->Val[2]*V1->Val[4]) + V1->Val[2]*(V1->Val[1]*V1->Val[4]-V1->Val[2]*V1->Val[3]); } else{ for(k=0 ; kVal[MAX_DIM*k+3], &V1->Val[MAX_DIM*k+5], a1); Cal_ComplexProduct(&V1->Val[MAX_DIM*k+4], &V1->Val[MAX_DIM*k+4], a2); b1[0] = a1[0] - a2[0] ; b1[MAX_DIM] = a1[MAX_DIM] - a2[MAX_DIM] ; Cal_ComplexProduct(&V1->Val[MAX_DIM*k+0], b1, c1); Cal_ComplexProduct(&V1->Val[MAX_DIM*k+1], &V1->Val[MAX_DIM*k+5], a1); Cal_ComplexProduct(&V1->Val[MAX_DIM*k+2], &V1->Val[MAX_DIM*k+4], a2); b1[0] = a1[0] - a2[0] ; b1[MAX_DIM] = a1[MAX_DIM] - a2[MAX_DIM] ; Cal_ComplexProduct(&V1->Val[MAX_DIM*k+1], b1, c2); Cal_ComplexProduct(&V1->Val[MAX_DIM*k+1], &V1->Val[MAX_DIM*k+4], a1); Cal_ComplexProduct(&V1->Val[MAX_DIM*k+2], &V1->Val[MAX_DIM*k+3], a2); b1[0] = a1[0] - a2[0] ; b1[MAX_DIM] = a1[MAX_DIM] - a2[MAX_DIM] ; Cal_ComplexProduct(&V1->Val[MAX_DIM*k+2], b1, c3); R->Val[MAX_DIM* k ] = c1[0] -c2[0] +c3[0]; R->Val[MAX_DIM*(k+1)] = c1[MAX_DIM]-c2[MAX_DIM]+c3[MAX_DIM]; } } break; case TENSOR : if(Current.NbrHar==1){ R->Val[0] = V1->Val[0]*(V1->Val[4]*V1->Val[8]-V1->Val[7]*V1->Val[5]) - V1->Val[1]*(V1->Val[3]*V1->Val[8]-V1->Val[6]*V1->Val[5]) + V1->Val[2]*(V1->Val[3]*V1->Val[7]-V1->Val[6]*V1->Val[4]); } else{ for(k=0 ; kVal[MAX_DIM*k+4], &V1->Val[MAX_DIM*k+8], a1); Cal_ComplexProduct(&V1->Val[MAX_DIM*k+7], &V1->Val[MAX_DIM*k+5], a2); b1[0] = a1[0] - a2[0] ; b1[MAX_DIM] = a1[MAX_DIM] - a2[MAX_DIM] ; Cal_ComplexProduct(&V1->Val[MAX_DIM*k+0], b1, c1); Cal_ComplexProduct(&V1->Val[MAX_DIM*k+3], &V1->Val[MAX_DIM*k+8], a1); Cal_ComplexProduct(&V1->Val[MAX_DIM*k+6], &V1->Val[MAX_DIM*k+5], a2); b1[0] = a1[0] - a2[0] ; b1[MAX_DIM] = a1[MAX_DIM] - a2[MAX_DIM] ; Cal_ComplexProduct(&V1->Val[MAX_DIM*k+1], b1, c2); Cal_ComplexProduct(&V1->Val[MAX_DIM*k+3], &V1->Val[MAX_DIM*k+7], a1); Cal_ComplexProduct(&V1->Val[MAX_DIM*k+6], &V1->Val[MAX_DIM*k+4], a2); b1[0] = a1[0] - a2[0] ; b1[MAX_DIM] = a1[MAX_DIM] - a2[MAX_DIM] ; Cal_ComplexProduct(&V1->Val[MAX_DIM*k+2], b1, c3); R->Val[MAX_DIM* k ] = c1[0] -c2[0] +c3[0]; R->Val[MAX_DIM*(k+1)] = c1[MAX_DIM]-c2[MAX_DIM]+c3[MAX_DIM]; } } break; default: Message::Error("Wrong argument type in 'Cal_DetValue'"); break; } } /* ------------------------------------------------------------------------ R <- 1/V1 ------------------------------------------------------------------------ */ void Cal_InvertValue(struct Value *V1, struct Value *R) { int k; struct Value Det,A; switch(V1->Type){ case SCALAR : R->Type = SCALAR; if(Current.NbrHar==1){ if(!V1->Val[0]){ Message::Error("Division by zero in 'Cal_InvertValue'"); return; } R->Val[0] = 1./V1->Val[0]; } else{ for(k=0 ; kVal[MAX_DIM*k], &R->Val[MAX_DIM*k]); } } break; case TENSOR_DIAG : R->Type = TENSOR_DIAG; if(Current.NbrHar==1){ if(V1->Val[0] && V1->Val[1] && V1->Val[2]){ R->Val[0] = 1./V1->Val[0]; R->Val[1] = 1./V1->Val[1]; R->Val[2] = 1./V1->Val[2]; } else{ Message::Error("Null determinant in 'Cal_InvertValue'"); return; } } else{ for(k=0 ; kVal[MAX_DIM*k ], &R->Val[MAX_DIM*k ]); Cal_ComplexInvert(&V1->Val[MAX_DIM*k+1], &R->Val[MAX_DIM*k+1]); Cal_ComplexInvert(&V1->Val[MAX_DIM*k+2], &R->Val[MAX_DIM*k+2]); } } break; case TENSOR_SYM : Cal_DetValue(V1,&Det); if(!Det.Val[0]){ Message::Error("Null determinant in 'Cal_InvertValue'"); return; } if(Current.NbrHar==1){ A.Val[0] = (V1->Val[3]*V1->Val[5]-V1->Val[4]*V1->Val[4])/Det.Val[0]; A.Val[1] = -(V1->Val[1]*V1->Val[5]-V1->Val[4]*V1->Val[2])/Det.Val[0]; A.Val[2] = (V1->Val[1]*V1->Val[4]-V1->Val[3]*V1->Val[2])/Det.Val[0]; A.Val[3] = -(V1->Val[1]*V1->Val[5]-V1->Val[2]*V1->Val[4])/Det.Val[0]; A.Val[4] = (V1->Val[0]*V1->Val[5]-V1->Val[2]*V1->Val[2])/Det.Val[0]; A.Val[5] = -(V1->Val[0]*V1->Val[4]-V1->Val[2]*V1->Val[1])/Det.Val[0]; A.Val[6] = (V1->Val[1]*V1->Val[4]-V1->Val[2]*V1->Val[3])/Det.Val[0]; A.Val[7] = -(V1->Val[0]*V1->Val[4]-V1->Val[1]*V1->Val[2])/Det.Val[0]; A.Val[8] = (V1->Val[0]*V1->Val[3]-V1->Val[1]*V1->Val[1])/Det.Val[0]; A.Type = TENSOR; Cal_CopyValue(&A,R); } else{ #define PRODSUBDIV(a,b,c,d,e) \ Cal_ComplexProduct(&V1->Val[MAX_DIM*k+a], &V1->Val[MAX_DIM*k+b], a1); \ Cal_ComplexProduct(&V1->Val[MAX_DIM*k+c], &V1->Val[MAX_DIM*k+d], a2); \ b1[0] = a1[0] - a2[0] ; b1[MAX_DIM] = a1[MAX_DIM] - a2[MAX_DIM]; \ Cal_ComplexDivision(b1, &Det.Val[MAX_DIM*k], &A.Val[e]) #define ASSIGN1(i) \ R->Val[MAX_DIM* k +i] = A.Val[MAX_DIM* k +i]; \ R->Val[MAX_DIM*(k+1)+i] = A.Val[MAX_DIM*(k+1)+i] #define ASSIGN2(i) \ R->Val[MAX_DIM* k +i] = -A.Val[MAX_DIM* k +i]; \ R->Val[MAX_DIM*(k+1)+i] = -A.Val[MAX_DIM*(k+1)+i] for(k=0 ; kType = TENSOR; #undef PRODSUBDIV #undef ASSIGN1 #undef ASSIGN2 } break; case TENSOR : Cal_DetValue(V1,&Det); if(!Det.Val[0]){ Message::Error("Null determinant in 'Cal_InvertValue'"); return; } if(Current.NbrHar==1){ A.Val[0] = (V1->Val[4]*V1->Val[8]-V1->Val[5]*V1->Val[7])/Det.Val[0]; A.Val[1] = -(V1->Val[1]*V1->Val[8]-V1->Val[7]*V1->Val[2])/Det.Val[0]; A.Val[2] = (V1->Val[1]*V1->Val[5]-V1->Val[4]*V1->Val[2])/Det.Val[0]; A.Val[3] = -(V1->Val[3]*V1->Val[8]-V1->Val[6]*V1->Val[5])/Det.Val[0]; A.Val[4] = (V1->Val[0]*V1->Val[8]-V1->Val[2]*V1->Val[6])/Det.Val[0]; A.Val[5] = -(V1->Val[0]*V1->Val[5]-V1->Val[2]*V1->Val[3])/Det.Val[0]; A.Val[6] = (V1->Val[3]*V1->Val[7]-V1->Val[6]*V1->Val[4])/Det.Val[0]; A.Val[7] = -(V1->Val[0]*V1->Val[7]-V1->Val[1]*V1->Val[6])/Det.Val[0]; A.Val[8] = (V1->Val[0]*V1->Val[4]-V1->Val[1]*V1->Val[3])/Det.Val[0]; A.Type = TENSOR; Cal_CopyValue(&A,R); } else{ #define PRODSUBDIV(a,b,c,d,e) \ Cal_ComplexProduct(&V1->Val[MAX_DIM*k+a], &V1->Val[MAX_DIM*k+b], a1); \ Cal_ComplexProduct(&V1->Val[MAX_DIM*k+c], &V1->Val[MAX_DIM*k+d], a2); \ b1[0] = a1[0] - a2[0] ; b1[MAX_DIM] = a1[MAX_DIM] - a2[MAX_DIM]; \ Cal_ComplexDivision(b1, &Det.Val[MAX_DIM*k], &A.Val[e]) #define ASSIGN1(i) \ R->Val[MAX_DIM* k +i] = A.Val[MAX_DIM* k +i]; \ R->Val[MAX_DIM*(k+1)+i] = A.Val[MAX_DIM*(k+1)+i] #define ASSIGN2(i) \ R->Val[MAX_DIM* k +i] = -A.Val[MAX_DIM* k +i]; \ R->Val[MAX_DIM*(k+1)+i] = -A.Val[MAX_DIM*(k+1)+i] for(k=0 ; kType = TENSOR; #undef PRODSUBDIV #undef ASSIGN1 #undef ASSIGN2 } break; default : Message::Error("Wrong type of argument in 'Cal_InvertValue'"); break; } } /* ------------------------------------------------------- */ /* --> P r i n t _ V a l u e */ /* ------------------------------------------------------- */ std::string Print_Value_ToString(struct Value *A) { int i, j, k, index = 0; std::ostringstream sstream; sstream.precision(16); switch(A->Type){ case SCALAR : if(Current.NbrHar>1) sstream << "("; for (k = 0 ; k < Current.NbrHar ; k++) { if(k) sstream << ","; sstream << A->Val[MAX_DIM*k]; } if(Current.NbrHar>1) sstream << ")"; break; case VECTOR : sstream << "["; for (i = 0 ; i < 3 ; i++) { if(i) sstream << " "; if(Current.NbrHar>1) sstream << "("; for (k = 0 ; k < Current.NbrHar ; k++) { if(k) sstream << ","; sstream << A->Val[MAX_DIM*k+i]; } if(Current.NbrHar>1) sstream << ")"; } sstream << "]"; break; case TENSOR_DIAG : case TENSOR_SYM : case TENSOR : sstream << "[["; for (i = 0 ; i < 3 ; i++) { if(i) sstream << "]["; for (j = 0 ; j < 3 ; j++) { if(j) sstream << " "; if(Current.NbrHar>1) sstream << "("; switch(A->Type){ case TENSOR_DIAG : index = TENSOR_DIAG_MAP[3*i+j]; break; case TENSOR_SYM : index = TENSOR_SYM_MAP[3*i+j]; break; case TENSOR : index = 3*i+j; break; } for (k = 0 ; k < Current.NbrHar ; k++) { if(k) sstream << ","; if(index<0) sstream << "0"; else sstream << A->Val[MAX_DIM*k+index]; } if(Current.NbrHar>1) sstream << ")"; } } sstream << "]]"; break; default : Message::Error("Unknown type of argument in function 'Printf'"); break; } std::string ret(sstream.str()); return ret; } void Print_Value(struct Value *A, FILE *fp) { std::string s = Print_Value_ToString(A); if(fp && fp != stdout && fp != stderr) fprintf(fp, "%s\n", s.c_str()); else Message::Direct("%s", s.c_str()); } /* ------------------------------------------------------------------------ Complete harmonics ------------------------------------------------------------------------ */ void Cal_SetHarmonicValue(struct Value *R) { int k ; switch(R->Type){ case SCALAR : R->Val[MAX_DIM] = 0. ; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) { R->Val[MAX_DIM*k ] = R->Val[0] ; R->Val[MAX_DIM*(k+1)] = 0. ; } break; case VECTOR : R->Val[MAX_DIM] = R->Val[MAX_DIM+1] = R->Val[MAX_DIM+2] = 0. ; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) { R->Val[MAX_DIM*k ] = R->Val[0] ; R->Val[MAX_DIM*k+1] = R->Val[1] ; R->Val[MAX_DIM*k+2] = R->Val[2] ; R->Val[MAX_DIM*(k+1) ] = 0. ; R->Val[MAX_DIM*(k+1)+1] = 0. ; R->Val[MAX_DIM*(k+1)+2] = 0. ; } break; default : Message::Error("Unknown type of argument in function 'Cal_SetHarmonicValue'"); } } /* ------------------------------------------------------------------------ Set superfluous harmonics to zero (in case of CASTing) ------------------------------------------------------------------------ */ void Cal_SetZeroHarmonicValue(struct Value *R, int Save_NbrHar) { int k ; switch(R->Type) { case SCALAR : for (k = Current.NbrHar ; k < Save_NbrHar ; k++) { R->Val[k*MAX_DIM ] = 0. ; } break ; case VECTOR : case TENSOR_DIAG : for (k = Current.NbrHar ; k < Save_NbrHar ; k++) { R->Val[k*MAX_DIM ] = 0. ; R->Val[k*MAX_DIM+1] = 0. ; R->Val[k*MAX_DIM+2] = 0. ; } break ; case TENSOR_SYM : for (k = Current.NbrHar ; k < Save_NbrHar ; k++) { R->Val[k*MAX_DIM ] = 0. ; R->Val[k*MAX_DIM+1] = 0. ; R->Val[k*MAX_DIM+2] = 0. ; R->Val[k*MAX_DIM+3] = 0. ; R->Val[k*MAX_DIM+4] = 0. ; R->Val[k*MAX_DIM+5] = 0. ; } break ; case TENSOR : for (k = Current.NbrHar ; k < Save_NbrHar ; k++) { R->Val[k*MAX_DIM ] = 0. ; R->Val[k*MAX_DIM+1] = 0. ; R->Val[k*MAX_DIM+2] = 0. ; R->Val[k*MAX_DIM+3] = 0. ; R->Val[k*MAX_DIM+4] = 0. ; R->Val[k*MAX_DIM+5] = 0. ; R->Val[k*MAX_DIM+6] = 0. ; R->Val[k*MAX_DIM+7] = 0. ; R->Val[k*MAX_DIM+8] = 0. ; } break ; default : Message::Error("Unknown type of argument in function 'Cal_SetZeroHarmonicValue'"); } } /* ------------------------------------------------------- */ /* --> S h o w _ V a l u e */ /* ------------------------------------------------------- */ #define W(i,j) A->Val[MAX_DIM*(i)+j] int NonZeroHar(int NbrComp, double Val[]) { int iComp, nz, nh; nh=Current.NbrHar-1; while( nh >= 0 ){ nz=0; for (iComp=0 ; iCompType){ case SCALAR : if((nzh=NonZeroHar(1,A->Val)) == 0){ fprintf(stderr, "zero scalar \n") ; } else if(nzh == 1){ fprintf(stderr, "real scalar %e \n", W(0,0) ) ; } else if (nzh == 2){ fprintf(stderr, "complex scalar %e +j %e \n", W(0,0), W(1,0) ) ; } else { fprintf(stderr, "multi-freq scalar "); for (k = 0 ; k < Current.NbrHar ; k += 2) fprintf(stderr, " Freq %d : %e + j %e",k/2+1, W(k,0), W(k+1,0) ) ; fprintf(stderr, "\n"); } break; case VECTOR : if((nzh=NonZeroHar(3,A->Val)) == 0){ fprintf(stderr, "zero vector \n") ; } else if (nzh == 1){ fprintf(stderr, "real vector x %e y %e z %e \n", W(0,0), W(0,1), W(0,2)); } else if (nzh == 2){ fprintf(stderr, "complex vector x %e +j %e y %e +j %e z %e +j %e \n", W(0,0), W(1,0), W(0,1), W(1,1), W(0,2), W(1,2) ); } else{ fprintf(stderr, "multi-freq vector "); for (k = 0 ; k < Current.NbrHar ; k += 2) fprintf(stderr, " Freq %d : x %e +j %e y %e +j %e z %e +j %e", k/2+1, W(k,0), W(k+1,0), W(k,1), W(k+1,1), W(k,2), W(k+1,2) ); fprintf(stderr, "\n"); } break; case TENSOR : if((nzh=NonZeroHar(9,A->Val)) == 0){ fprintf(stderr, "zero tensor \n") ; } else if (nzh == 1){ fprintf(stderr, "real tensor " " xx %e xy %e xz %e " " yx %e yy %e yz %e " " zx %e zy %e zz %e \n", W(0,0), W(0,1), W(0,2), W(0,3), W(0,4), W(0,5), W(0,6), W(0,7), W(0,8)); } else if (nzh == 2){ fprintf(stderr, "complex tensor " " xx %e +j %e xy %e +j %e xz %e +j %e " " yx %e +j %e yy %e +j %e yz %e +j %e " " zx %e +j %e zy %e +j %e zz %e +j %e\n", W(0,0), W(1,0), W(0,1), W(1,1), W(0,2), W(1,2), W(0,3), W(1,3), W(0,4), W(1,4), W(0,5), W(1,5), W(0,6), W(1,6), W(0,7), W(1,7), W(0,8), W(1,8)); } else { fprintf(stderr, "multi-freq tensor "); for (k = 0 ; k < Current.NbrHar ; k += 2) fprintf(stderr, " Freq %d : " " xx %e +j %e xy %e +j %e xz %e +j %e " " yx %e +j %e yy %e +j %e yz %e +j %e " " zx %e +j %e zy %e +j %e zz %e +j %e", k/2+1, W(k,0), W(k+1,0), W(k,1), W(k+1,1), W(k,2), W(k+1,2), W(k,3), W(k+1,3), W(k,4), W(k+1,4), W(k,5), W(k+1,5), W(k,6), W(k+1,6), W(k,7), W(k+1,7), W(k,8), W(k+1,8)); fprintf(stderr, "\n"); } break; case TENSOR_SYM : if((nzh=NonZeroHar(6,A->Val)) == 0){ fprintf(stderr, "zero sym tensor \n") ; } else if (nzh == 1){ fprintf(stderr, "real sym tensor " " xx %e xy %e xz %e " " yy %e yz %e zz %e \n", W(0,0), W(0,1), W(0,2), W(0,3), W(0,4), W(0,5)); } else if (nzh == 2){ fprintf(stderr, "complex sym tensor " " xx %e +j %e xy %e +j %e xz %e +j %e " " yy %e +j %e yz %e +j %e zz %e +j %e\n", W(0,0), W(1,0), W(0,1), W(1,1), W(0,2), W(1,2), W(0,3), W(1,3), W(0,4), W(1,4), W(0,5), W(1,5)); } else { fprintf(stderr, "multi-freq sym tensor "); for (k = 0 ; k < Current.NbrHar ; k += 2) fprintf(stderr, " Freq %d : " " xx %e +j %e xy %e +j %e xz %e +j %e " " yy %e +j %e yz %e +j %e zz %e +j %e", k/2+1, W(k,0), W(k+1,0), W(k,1), W(k+1,1), W(k,2), W(k+1,2), W(k,3), W(k+1,3), W(k,4), W(k+1,4), W(k,5), W(k+1,5)); fprintf(stderr, "\n"); } break; case TENSOR_DIAG : if((nzh=NonZeroHar(3,A->Val)) == 0){ fprintf(stderr, "zero sym tensor \n") ; } else if (nzh == 1){ fprintf(stderr, "real diag tensor xx %e yy %e zz %e \n", W(0,0), W(0,1), W(0,2)); } else if (nzh == 2){ fprintf(stderr, "complex diag tensor xx %e +j %e yy %e +j %e zz %e +j %e", W(0,0), W(1,0), W(0,1), W(1,1), W(0,2), W(1,2)); } else { fprintf(stderr, "multi-freq diag tensor "); for (k = 0 ; k < Current.NbrHar ; k += 2) fprintf(stderr, " Freq %d : xx %e +j %e yy %e +j %e zz %e +j %e", k/2+1, W(k,0), W(k+1,0), W(k,1), W(k+1,1), W(k,2), W(k+1,2)); fprintf(stderr, "\n"); } break; default : Message::Error("Unknown value type in Show_Value"); } } #undef W getdp-2.7.0-source/Legacy/Cal_Quantity.h000644 001750 001750 00000002213 12531661502 021552 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _CAL_QUANTITY_H_ #define _CAL_QUANTITY_H_ #include "ProData.h" #include "ListUtils.h" void Get_ValueOfExpression(struct Expression * Expression_P, struct QuantityStorage * QuantityStorage_P0, double u, double v, double w, struct Value * Value, int NbrArguments=0, char *CallingExpressionName=NULL) ; void Get_ValueOfExpressionByIndex(int Index_Expression, struct QuantityStorage * QuantityStorage_P0, double u, double v, double w, struct Value * Value) ; void Cal_WholeQuantity(struct Element * Element, struct QuantityStorage * QuantityStorage_P0, List_T * WholeQuantity_L, double u, double v, double w, int Index_Dof, int Nbr_Dof, struct Value DofValue[], int NbrArguments=0, char *ExpressionName=NULL) ; void Cal_StoreInRegister(struct Value *Value, int RegisterIndex) ; void Cal_StoreInVariable(struct Value *Value, const char *name) ; #endif getdp-2.7.0-source/Legacy/SolvingOperations.cpp000644 001750 001750 00000346005 12606421314 023205 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Johan Gyselinck // Ruth Sabariego // #include #include #include "GetDPConfig.h" #include "ProData.h" #include "ProDefine.h" #include "ProParser.h" #include "GeoData.h" #include "DofData.h" #include "Cal_Quantity.h" #include "Cal_Value.h" #include "MovingBand2D.h" #include "EigenSolve.h" #include "Treatment_Formulation.h" #include "SolvingAnalyse.h" #include "SolvingOperations.h" #include "MallocUtils.h" #include "OS.h" #include "Message.h" #if defined(HAVE_GMSH) #include #include #endif #define TWO_PI 6.2831853071795865 // for performance tests #if !defined(WIN32) //#define TIMER #endif extern struct Problem Problem_S ; extern struct CurrentData Current ; extern int TreatmentStatus ; extern int Flag_POS ; extern int Flag_RESTART ; extern int Flag_BIN, Flag_SPLIT ; extern char *Name_Generic, *Name_Path ; extern char *Name_MshFile, *Name_ResFile[NBR_MAX_RES] ; extern List_T *GeoData_L ; static int Flag_IterativeLoop = 0 ; /* Attention: phase de test */ struct Group * Generate_Group = NULL; static int Flag_Break = 0; // For adaptive time stepper (ugly, I know...) int Flag_IterativeLoopConverged = 1; int Flag_IterativeLoopN = 0; // For IterativeTimeReduction (ugly also...) int Flag_NextThetaFixed = 0 ; // For Update int Init_Update = 0 ; // For Johan's multi-harmonic stuff (even uglier :-) int Flag_RHS = 0, *DummyDof ; double **MH_Moving_Matrix = NULL ; int MHMoving_assemblyType = 0 ; Tree_T * DofTree_MH_moving ; /* ------------------------------------------------------------------------ */ /* F r e e _ U n u s e d S o l u t i o n s */ /* ------------------------------------------------------------------------ */ void Free_UnusedSolutions(struct DofData * DofData_P) { struct Solution * Solution_P ; int index = -1; // We store 1 solution too much (to allow for an imbricated iterative loop) if(!Flag_POS){ switch (Current.TypeTime) { case TIME_THETA : index = List_Nbr(DofData_P->Solutions)-4 ; // Fore TimeLoopAdaptive (Trapezoidal) we need 3 past solutions for the predictor index = Message::GetOperatingInTimeLoopAdaptive() ? index - 1 : index; break; case TIME_GEAR : // With -9 we store 7 past solutions (for Gear_6) index = List_Nbr(DofData_P->Solutions)-9 ; break; case TIME_NEWMARK : index = List_Nbr(DofData_P->Solutions)-4 ; break; } if(index >= 0){ Solution_P = (struct Solution*)List_Pointer(DofData_P->Solutions, index); if(Solution_P->SolutionExist){ Message::Info("Freeing Solution %d", index); LinAlg_DestroyVector(&Solution_P->x); Free(Solution_P->TimeFunctionValues) ; Solution_P->SolutionExist = 0 ; } } } } /* ------------------------------------------------------------------------ */ /* I n i t _ S y s t e m D a t a */ /* ------------------------------------------------------------------------ */ void Init_SystemData(struct DofData * DofData_P, int Flag_Jac) { if (DofData_P->Flag_Init[0] < 1) { DofData_P->Flag_Init[0] = 1 ; LinAlg_CreateSolver(&DofData_P->Solver, DofData_P->SolverDataFileName) ; LinAlg_CreateMatrix(&DofData_P->A, &DofData_P->Solver, DofData_P->NbrDof, DofData_P->NbrDof) ; LinAlg_CreateVector(&DofData_P->b, &DofData_P->Solver, DofData_P->NbrDof) ; LinAlg_CreateVector(&DofData_P->res, &DofData_P->Solver, DofData_P->NbrDof) ; } /* GenerateOnly: Taking advantage of the invariant parts of the matrix in every time-step */ if(DofData_P->Flag_InitOnly[0] == 1){ DofData_P->Flag_InitOnly[0] = 2; Message::Info("Initializing System {A1,b1}"); LinAlg_CreateMatrix(&DofData_P->A1, &DofData_P->Solver, DofData_P->NbrDof, DofData_P->NbrDof) ; LinAlg_CreateVector(&DofData_P->b1, &DofData_P->Solver, DofData_P->NbrDof) ; } if(DofData_P->Flag_InitOnly[1] == 1){ DofData_P->Flag_InitOnly[1] = 2; Message::Info("Initializing System {A2,b2}"); LinAlg_CreateMatrix(&DofData_P->A2, &DofData_P->Solver, DofData_P->NbrDof, DofData_P->NbrDof) ; LinAlg_CreateVector(&DofData_P->b2, &DofData_P->Solver, DofData_P->NbrDof) ; } if(DofData_P->Flag_InitOnly[2] == 1){ DofData_P->Flag_InitOnly[2] = 2; Message::Info("Initializing System {A3,b3}"); LinAlg_CreateMatrix(&DofData_P->A3, &DofData_P->Solver, DofData_P->NbrDof, DofData_P->NbrDof) ; LinAlg_CreateVector(&DofData_P->b3, &DofData_P->Solver, DofData_P->NbrDof) ; } if (DofData_P->Flag_Init[0] < 2 && Flag_Jac) { DofData_P->Flag_Init[0] = 2 ; LinAlg_CreateMatrix(&DofData_P->Jac, &DofData_P->Solver, DofData_P->NbrDof, DofData_P->NbrDof) ; LinAlg_CreateVector(&DofData_P->dx, &DofData_P->Solver, DofData_P->NbrDof) ; } } /* ------------------------------------------------------------------------ */ /* G e n e r a t e _ S y s t e m */ /* ------------------------------------------------------------------------ */ static void ZeroMatrix(gMatrix *M, gSolver *S, int N) { // We destroy and recreate the matrix to avoid filling-in the mask when // generating systems on meshes with changing topologies (remeshing, moving // band, ..., e.g. in time loops) or when constraints are updated. Using // LinAlg_ZeroMatrix preserves the mask from iteration to iteration, which // increases memory every time we reassemble. LinAlg_DestroyMatrix(M); LinAlg_CreateMatrix(M, S, N, N); } void Generate_System(struct DefineSystem * DefineSystem_P, struct DofData * DofData_P, struct DofData * DofData_P0, int Flag_Jac, int Flag_Separate, int Flag_Cumulative = 0) { int Nbr_Formulation, Index_Formulation, i_TimeStep, iMat ; struct Solution * Solution_P, Solution_S ; struct Formulation * Formulation_P ; /* (Re)creation des liens entre FunctionSpace et DofData: seuls les FS n'intervenant pas dans le DD courant peuvent pointer vers un autre DD */ Init_DofDataInFunctionSpace(1, DofData_P) ; if (!DofData_P->Solutions) DofData_P->Solutions = List_Create(20, 20, sizeof(struct Solution)) ; i_TimeStep = (int)Current.TimeStep ; if (!(Solution_P = (struct Solution*) List_PQuery(DofData_P->Solutions, &i_TimeStep, fcmp_int))) { Solution_S.TimeStep = (int)Current.TimeStep ; Solution_S.Time = Current.Time ; Solution_S.TimeImag = Current.TimeImag ; Solution_S.TimeFunctionValues = Get_TimeFunctionValues(DofData_P) ; Solution_S.SolutionExist = 1 ; LinAlg_CreateVector(&Solution_S.x, &DofData_P->Solver, DofData_P->NbrDof) ; if (List_Nbr(DofData_P->Solutions)) { LinAlg_CopyVector(&((struct Solution *) List_Pointer(DofData_P->Solutions, List_Nbr(DofData_P->Solutions)-1))->x, &Solution_S.x) ; } else { LinAlg_ZeroVector(&Solution_S.x) ; } List_Add(DofData_P->Solutions, &Solution_S) ; DofData_P->CurrentSolution = (struct Solution*) List_Pointer(DofData_P->Solutions, List_Nbr(DofData_P->Solutions)-1) ; } else if (Solution_P != DofData_P->CurrentSolution && !Flag_Separate) { /* the test on Flag_Separate is necessary for high order time schemes, where InitSolution[] gets called multiple times, resulting in multiple stored solutions with the same TimeStep number. Since GenerateSeparate[] is called outside the time loop (i.e. before TimeStep+=1), the List_PQuery may return (in an unpredictable way) any of the initial solutions. */ Message::Error("Incompatible time") ; } else{ // fix time values if we recompute the same step (with different time) Solution_P->Time = Current.Time ; Solution_P->TimeImag = Current.TimeImag ; Free(Solution_P->TimeFunctionValues) ; Solution_P->TimeFunctionValues = Get_TimeFunctionValues(DofData_P) ; } if(Flag_Separate){ for(int i = 0; i < List_Nbr(DofData_P->TimeFunctionIndex); i++) if(*(int*)List_Pointer(DofData_P->TimeFunctionIndex, i) > 0) Message::Warning("Ignored TimeFunction in Constraint for GenerateSeparate") ; for(int i = 0; i < List_Nbr(Problem_S.Expression); i++){ DofData_P->CurrentSolution->TimeFunctionValues[i] = 1. ; } if(Current.DofData->Flag_Init[1] && !Flag_Cumulative){ ZeroMatrix(&Current.DofData->M1, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroVector(&Current.DofData->m1); for(int i = 0; i < List_Nbr(DofData_P->m1s); i++) LinAlg_ZeroVector((gVector*)List_Pointer(DofData_P->m1s, i)); } if(Current.DofData->Flag_Init[2] && !Flag_Cumulative){ ZeroMatrix(&Current.DofData->M2, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroVector(&Current.DofData->m2); for(int i = 0; i < List_Nbr(DofData_P->m2s); i++) LinAlg_ZeroVector((gVector*)List_Pointer(DofData_P->m2s, i)); } if(Current.DofData->Flag_Init[3] && !Flag_Cumulative){ ZeroMatrix(&Current.DofData->M3, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroVector(&Current.DofData->m3); for(int i = 0; i < List_Nbr(DofData_P->m3s); i++) LinAlg_ZeroVector((gVector*)List_Pointer(DofData_P->m3s, i)); } if(Current.DofData->Flag_Init[4] && !Flag_Cumulative){ ZeroMatrix(&Current.DofData->M4, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroVector(&Current.DofData->m4); for(int i = 0; i < List_Nbr(DofData_P->m4s); i++) LinAlg_ZeroVector((gVector*)List_Pointer(DofData_P->m4s, i)); } if(Current.DofData->Flag_Init[5] && !Flag_Cumulative){ ZeroMatrix(&Current.DofData->M5, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroVector(&Current.DofData->m5); for(int i = 0; i < List_Nbr(DofData_P->m5s); i++) LinAlg_ZeroVector((gVector*)List_Pointer(DofData_P->m5s, i)); } if(Current.DofData->Flag_Init[6] && !Flag_Cumulative){ ZeroMatrix(&Current.DofData->M6, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroVector(&Current.DofData->m6); for(int i = 0; i < List_Nbr(DofData_P->m6s); i++) LinAlg_ZeroVector((gVector*)List_Pointer(DofData_P->m6s, i)); } } else{ if(!Current.DofData->Flag_RHS && !Flag_Cumulative){ ZeroMatrix(&Current.DofData->A, &Current.DofData->Solver, Current.DofData->NbrDof); } if(!Flag_Cumulative) LinAlg_ZeroVector(&Current.DofData->b) ; if(DofData_P->Flag_Only){ for(int i = 0 ; i < List_Nbr( DofData_P->OnlyTheseMatrices ); i++){ List_Read(DofData_P->OnlyTheseMatrices, i, &iMat); if(iMat && !Flag_Cumulative){ switch(iMat){ case 1 : ZeroMatrix(&Current.DofData->A1, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroVector(&Current.DofData->b1) ; break; case 2 : ZeroMatrix(&Current.DofData->A2, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroVector(&Current.DofData->b2) ; break; case 3 : ZeroMatrix(&Current.DofData->A3, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroVector(&Current.DofData->b3) ; break; } } } } } if(Flag_Jac && !Flag_Cumulative) ZeroMatrix(&Current.DofData->Jac, &Current.DofData->Solver, Current.DofData->NbrDof) ; Nbr_Formulation = List_Nbr(DefineSystem_P->FormulationIndex) ; for (int i = 0 ; i < Nbr_Formulation ; i++) { List_Read(DefineSystem_P->FormulationIndex, i, &Index_Formulation) ; Formulation_P = (struct Formulation*) List_Pointer(Problem_S.Formulation, Index_Formulation) ; Init_DofDataInDefineQuantity(DefineSystem_P, DofData_P0, Formulation_P); Treatment_Formulation(Formulation_P) ; } if(Flag_Separate){ DofData_P->CurrentSolution->TimeFunctionValues = Get_TimeFunctionValues(DofData_P) ; if(DofData_P->Flag_Init[1]){ LinAlg_AssembleMatrix(&DofData_P->M1) ; LinAlg_AssembleVector(&DofData_P->m1) ; for(int i = 0; i < List_Nbr(DofData_P->m1s); i++) LinAlg_AssembleVector((gVector*)List_Pointer(DofData_P->m1s, i)); } if(DofData_P->Flag_Init[2]){ LinAlg_AssembleMatrix(&DofData_P->M2) ; LinAlg_AssembleVector(&DofData_P->m2) ; for(int i = 0; i < List_Nbr(DofData_P->m2s); i++) LinAlg_AssembleVector((gVector*)List_Pointer(DofData_P->m2s, i)); } if(DofData_P->Flag_Init[3]){ LinAlg_AssembleMatrix(&DofData_P->M3) ; LinAlg_AssembleVector(&DofData_P->m3) ; for(int i = 0; i < List_Nbr(DofData_P->m3s); i++) LinAlg_AssembleVector((gVector*)List_Pointer(DofData_P->m3s, i)); } if(DofData_P->Flag_Init[4]){ LinAlg_AssembleMatrix(&DofData_P->M4) ; LinAlg_AssembleVector(&DofData_P->m4) ; for(int i = 0; i < List_Nbr(DofData_P->m4s); i++) LinAlg_AssembleVector((gVector*)List_Pointer(DofData_P->m4s, i)); } if(DofData_P->Flag_Init[5]){ LinAlg_AssembleMatrix(&DofData_P->M5) ; LinAlg_AssembleVector(&DofData_P->m5) ; for(int i = 0; i < List_Nbr(DofData_P->m5s); i++) LinAlg_AssembleVector((gVector*)List_Pointer(DofData_P->m5s, i)); } if(DofData_P->Flag_Init[6]){ LinAlg_AssembleMatrix(&DofData_P->M6) ; LinAlg_AssembleVector(&DofData_P->m6) ; for(int i = 0; i < List_Nbr(DofData_P->m6s); i++) LinAlg_AssembleVector((gVector*)List_Pointer(DofData_P->m6s, i)); } } else{ LinAlg_AssembleMatrix(&DofData_P->A) ; LinAlg_AssembleVector(&DofData_P->b) ; int i; LinAlg_GetVectorSize(&DofData_P->b, &i) ; if(!i) Message::Warning("Generated system is of dimension zero"); if(DofData_P->Flag_Only){ for(int i = 0 ; i < List_Nbr( DofData_P->OnlyTheseMatrices ); i++){ List_Read(DofData_P->OnlyTheseMatrices, i, &iMat); switch(iMat){ case 1 : LinAlg_AssembleMatrix(&Current.DofData->A1) ; LinAlg_AssembleVector(&Current.DofData->b1) ; break; case 2 : LinAlg_AssembleMatrix(&Current.DofData->A2) ; LinAlg_AssembleVector(&Current.DofData->b2) ; break; case 3: LinAlg_AssembleMatrix(&Current.DofData->A3) ; LinAlg_AssembleVector(&Current.DofData->b3) ; break; } } } } if(Flag_Jac){ /* This should in fact only be done if a JacNL term exists in the formulation... */ LinAlg_AssembleMatrix(&DofData_P->Jac) ; } Free_UnusedSolutions(DofData_P); } void ReGenerate_System(struct DefineSystem * DefineSystem_P, struct DofData * DofData_P, struct DofData * DofData_P0, int Flag_Jac=0) { int Nbr_Formulation, Index_Formulation ; struct Formulation * Formulation_P ; ZeroMatrix(&Current.DofData->A, &Current.DofData->Solver, Current.DofData->NbrDof) ; LinAlg_ZeroVector(&Current.DofData->b) ; if(Flag_Jac) ZeroMatrix(&Current.DofData->Jac, &Current.DofData->Solver, Current.DofData->NbrDof) ; Nbr_Formulation = List_Nbr(DefineSystem_P->FormulationIndex) ; for (int i = 0 ; i < Nbr_Formulation ; i++) { List_Read(DefineSystem_P->FormulationIndex, i, &Index_Formulation) ; Formulation_P = (struct Formulation*) List_Pointer(Problem_S.Formulation, Index_Formulation) ; Init_DofDataInDefineQuantity(DefineSystem_P, DofData_P0, Formulation_P); Treatment_Formulation(Formulation_P) ; } LinAlg_AssembleMatrix(&DofData_P->A) ; LinAlg_AssembleVector(&DofData_P->b) ; int i; LinAlg_GetVectorSize(&DofData_P->b, &i) ; if(!i) Message::Warning("ReGenerated system is of dimension zero"); if(Flag_Jac){ /* This should in fact only be done if a JacNL term exists in the formulation... */ LinAlg_AssembleMatrix(&DofData_P->Jac) ; } } void Generate_Residual(gVector *x, gVector *f) { struct DefineSystem * DefineSystem_P ; struct DofData * DofData_P ; struct DofData * DofData_P0 ; if(Message::GetVerbosity() == 10) Message::Info("Generating Residual = b(xn)-A(xn)*xn"); DofData_P = Current.DofData ; DofData_P0 = Current.DofData_P0; DefineSystem_P = Current.DefineSystem_P ; if(!DofData_P->CurrentSolution){ Message::Error("No current solution available"); return; } // new trial solution LinAlg_CopyVector(x, &DofData_P->dx); LinAlg_AddVectorProdVectorDouble(&DofData_P->CurrentSolution->x, &DofData_P->dx, -1., &DofData_P->CurrentSolution->x); // calculate residual with new solution ReGenerate_System(DefineSystem_P, DofData_P, DofData_P0, 1) ; // calculate residual with new solution LinAlg_ProdMatrixVector(&DofData_P->A, &DofData_P->CurrentSolution->x, &DofData_P->res) ; // res = b(xn)-A(xn)*xn LinAlg_SubVectorVector(&DofData_P->b, &DofData_P->res, &DofData_P->res) ; if(Message::GetVerbosity() == 10){ Message::Info("dx"); LinAlg_PrintVector(stdout, &DofData_P->dx) ; Message::Info("A"); LinAlg_PrintMatrix(stdout, &DofData_P->A) ; } *f = DofData_P->res ; LinAlg_AssembleVector(f) ; } void Generate_FullJacobian(gVector *x, gMatrix *Jac) { struct DofData * DofData_P ; Message::Debug("Generating Full Jacobian = A(x) + DofData_P->Jac"); DofData_P = Current.DofData ; if(!DofData_P->CurrentSolution){ Message::Error("No current solution available"); return; } LinAlg_CopyVector(x, &DofData_P->dx); LinAlg_AddVectorVector(&DofData_P->CurrentSolution->x, &DofData_P->dx, &DofData_P->CurrentSolution->x); // updating solution solution LinAlg_AddMatrixMatrix(&DofData_P->A, &DofData_P->Jac, &DofData_P->Jac) ; *Jac = DofData_P->Jac ; LinAlg_AssembleMatrix(Jac) ; } /* ------------------------------------------------------------------------ */ /* U p d a t e _ C o n s t r a i n t S y s t e m */ /* ------------------------------------------------------------------------ */ void UpdateConstraint_System(struct DefineSystem * DefineSystem_P, struct DofData * DofData_P, struct DofData * DofData_P0, int GroupIndex, int Type_Constraint, int Flag_Jac) { // Update constraints, i.e. new preprocessing of _CST type int Nbr_Formulation, Index_Formulation, Save_TreatmentStatus ; struct Formulation * Formulation_P ; Save_TreatmentStatus = TreatmentStatus ; TreatmentStatus = _CST ; Nbr_Formulation = List_Nbr(DefineSystem_P->FormulationIndex) ; for (int k = 0; k < Nbr_Formulation; k++) { List_Read(DefineSystem_P->FormulationIndex, k, &Index_Formulation) ; Formulation_P = (struct Formulation*) List_Pointer(Problem_S.Formulation, Index_Formulation) ; Message::Info("UpdateConstraint: Treatment Formulation '%s'", Formulation_P->Name) ; Init_DofDataInDefineQuantity(DefineSystem_P, DofData_P0, Formulation_P) ; Treatment_Formulation(Formulation_P) ; } Dof_InitDofType(DofData_P) ; /* Attention: Init for only one DofData */ TreatmentStatus = Save_TreatmentStatus ; } /* ------------------------------------------------------------------------ */ /* I n i t _ O p e r a t i o n O n S y s t e m */ /* ------------------------------------------------------------------------ */ void Init_OperationOnSystem(const char * Name, struct Resolution * Resolution_P, struct Operation * Operation_P , struct DofData * DofData_P0, struct GeoData * GeoData_P0, struct DefineSystem ** DefineSystem_P, struct DofData ** DofData_P, struct Resolution * Resolution2_P) { *DefineSystem_P = (struct DefineSystem*) List_Pointer(Resolution_P->DefineSystem,Operation_P->DefineSystemIndex) ; Current.DefineSystem_P = *DefineSystem_P ; *DofData_P = DofData_P0 + Operation_P->DefineSystemIndex ; Dof_SetCurrentDofData(Current.DofData = *DofData_P) ; Current.NbrHar = Current.DofData->NbrHar ; Geo_SetCurrentGeoData(Current.GeoData = GeoData_P0 + (*DofData_P)->GeoDataIndex) ; if((*DefineSystem_P)->DestinationSystemName && (*DefineSystem_P)->DestinationSystemIndex == -1){ int i ; if(Resolution2_P){ /* pre-resolution */ if ((i = List_ISearchSeq(Resolution2_P->DefineSystem, (*DefineSystem_P)->DestinationSystemName, fcmp_DefineSystem_Name)) < 0){ Message::Error("Unknown DestinationSystem (%s) in System (%s)", (*DefineSystem_P)->DestinationSystemName, (*DefineSystem_P)->Name) ; return; } (*DefineSystem_P)->DestinationSystemIndex = i ; Dof_DefineUnknownDofFromSolveOrInitDof(DofData_P) ; } else { /* a changer !!! */ if ((i = List_ISearchSeq(Resolution_P->DefineSystem, (*DefineSystem_P)->DestinationSystemName, fcmp_DefineSystem_Name)) < 0){ Message::Error("Unknown DestinationSystem (%s) in System (%s)", (*DefineSystem_P)->DestinationSystemName, (*DefineSystem_P)->Name) ; return; } (*DefineSystem_P)->DestinationSystemIndex = i ; } } const char *str = Name ? Name : Get_StringForDefine(Operation_Type, Operation_P->Type); Message::Info("%s[%s]", str, (*DefineSystem_P)->Name) ; Message::ProgressMeter(0, 0, "Processing (%s)", str); } /* ------------------------------------------------------------------------ */ /* T r e a t m e n t _ O p e r a t i o n */ /* ------------------------------------------------------------------------ */ void Treatment_Operation(struct Resolution * Resolution_P, List_T * Operation_L, struct DofData * DofData_P0, struct GeoData * GeoData_P0, struct Resolution * Resolution2_P, struct DofData * DofData2_P0) { double d, d1, d2, *Scales ; int Nbr_Operation, Nbr_Sol, i_Operation, Num_Iteration ; int Flag_Jac, Flag_CPU, Flag_Binary = 0 ; int Save_TypeTime ; double Save_Time, Save_DTime ; double Save_Iteration ; double MeanError, RelFactor_Modified ; char ResName[256], ResNum[256] ; char FileName[256]; char FileName_exMH[256]; gScalar tmp ; FILE *fp = stdout; struct Operation * Operation_P ; struct DefineSystem * DefineSystem_P ; struct DofData * DofData_P, * DofData2_P ; struct Solution * Solution_P, Solution_S ; struct Dof Dof, * Dof_P ; struct Value Value ; int N ; static int RES0 = -1 ; /* adaptive relaxation */ gVector x_Save; int NbrSteps_relax; double Norm; double Frelax, Frelax_Opt, Error_Prev; int istep; int Nbr_Formulation, Index_Formulation ; struct Formulation * Formulation_P ; int iTime ; double *Val_Pulsation ; double hop[NBR_MAX_HARMONIC][NBR_MAX_HARMONIC] ; double DCfactor ; int NbrHar1, NbrHar2, NbrDof1, NbrDof2 ; double dd ; int NumDof, iMat ; int row_old, row_new, col_old, col_new; double aii, ajj; int nnz__; List_T *DofList_MH_moving; static int NbrDof_MH_moving; static int *NumDof_MH_moving; static struct Dof ** Dof_MH_moving; gMatrix A_MH_moving_tmp ; //gVector b_MH_moving_tmp ; Nbr_Operation = List_Nbr(Operation_L) ; for (i_Operation = 0 ; i_Operation < Nbr_Operation ; i_Operation++) { Operation_P = (struct Operation*)List_Pointer(Operation_L, i_Operation) ; Flag_CPU = 0 ; Flag_Jac = 0 ; if(Message::GetOnelabAction() == "stop" || Message::GetErrorCount()) break; switch (Operation_P->Type) { /* --> S y s t e m C o m m a n d */ /* ------------------------------------------ */ case OPERATION_SYSTEMCOMMAND : BlockingSystemCall(Operation_P->Case.SystemCommand.String); break ; /* --> E r r o r */ /* ------------------------------------------ */ case OPERATION_ERROR : Message::Error(Operation_P->Case.Error.String); break ; /* --> G e n e r a t e */ /* ------------------------------------------ */ case OPERATION_GENERATEJAC : Flag_Jac = 1 ; case OPERATION_GENERATEJAC_CUMULATIVE : Flag_Jac = 1 ; case OPERATION_GENERATERHS : case OPERATION_GENERATERHS_CUMULATIVE : case OPERATION_GENERATE : case OPERATION_GENERATE_CUMULATIVE : { #ifdef TIMER double tstart = MPI_Wtime(); #endif int cumulative = (Operation_P->Type == OPERATION_GENERATEJAC_CUMULATIVE || Operation_P->Type == OPERATION_GENERATERHS_CUMULATIVE || Operation_P->Type == OPERATION_GENERATE_CUMULATIVE); Init_OperationOnSystem(Get_StringForDefine(Operation_Type, Operation_P->Type), Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if(Operation_P->Type == OPERATION_GENERATERHS) DofData_P->Flag_RHS = 1; Current.TypeAssembly = ASSEMBLY_AGGREGATE ; Init_SystemData(DofData_P, Flag_Jac) ; if(Operation_P->Case.Generate.GroupIndex >= 0){ Generate_Group = (struct Group *) List_Pointer(Problem_S.Group, Operation_P->Case.Generate.GroupIndex) ; } Generate_System(DefineSystem_P, DofData_P, DofData_P0, Flag_Jac, 0, cumulative) ; if(Flag_Jac && !DofData_P->Flag_Only){ // compute full Jacobian J = A + JacNL, and store it in Jac LinAlg_AddMatrixMatrix(&DofData_P->A, &DofData_P->Jac, &DofData_P->Jac) ; // res = b(xn)-A(xn)*xn LinAlg_ProdMatrixVector(&DofData_P->A, &DofData_P->CurrentSolution->x, &DofData_P->res) ; LinAlg_SubVectorVector(&DofData_P->b, &DofData_P->res, &DofData_P->res) ; LinAlg_DummyVector(&DofData_P->res) ; } if(Operation_P->Case.Generate.GroupIndex >= 0) Generate_Group = NULL ; DofData_P->Flag_RHS = 0; if(!Flag_Jac) Flag_CPU = 1 ; #ifdef TIMER double timer = MPI_Wtime() - tstart; if(Operation_P->Type == OPERATION_GENERATERHS) printf("Proc %d, time spent in Generate_RHS %.16g\n", Message::GetCommRank(), timer); else printf("Proc %d, time spent in Generate %.16g\n", Message::GetCommRank(), timer); #endif } break ; /* --> G e n e r a t e S e p a r a t e */ /* ------------------------------------------ */ case OPERATION_GENERATESEPARATE : Init_OperationOnSystem("GenerateSeparate", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if (Operation_P->Case.Generate.GroupIndex >= 0) Generate_Group = (struct Group *) List_Pointer(Problem_S.Group, Operation_P->Case.Generate.GroupIndex) ; Current.TypeAssembly = ASSEMBLY_SEPARATE ; Init_Update = 0 ; /* modif... ! */ Init_SystemData(DofData_P, Flag_Jac) ; Generate_System(DefineSystem_P, DofData_P, DofData_P0, Flag_Jac, 1) ; if (Operation_P->Case.Generate.GroupIndex >= 0) Generate_Group = NULL ; Flag_CPU = 1 ; break ; /* --> G e n e r a t e O n l y */ /* ------------------------------------------ */ case OPERATION_GENERATEONLYJAC : Flag_Jac = 1 ; case OPERATION_GENERATEONLY: Init_OperationOnSystem(Get_StringForDefine(Operation_Type, Operation_P->Type), Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if(DofData_P->Flag_Only < 2) DofData_P->Flag_Only += 1 ; DofData_P->OnlyTheseMatrices = Operation_P->Case.GenerateOnly.MatrixIndex_L ; if (DofData_P->Flag_Only <= 2) for (int i = 0; i < List_Nbr(DofData_P->OnlyTheseMatrices); i++){ List_Read( DofData_P->OnlyTheseMatrices, i, &iMat); switch(iMat){ case 1: DofData_P->Flag_InitOnly[0] = 1 ; break ; case 2: DofData_P->Flag_InitOnly[1] = 1 ; break ; case 3: DofData_P->Flag_InitOnly[2] = 1 ; break ; } } Current.TypeAssembly = ASSEMBLY_AGGREGATE ; Init_SystemData(DofData_P, Flag_Jac) ; Generate_System(DefineSystem_P, DofData_P, DofData_P0, Flag_Jac, 0) ; if(!Flag_Jac) Flag_CPU = 1 ; break; /* --> U p d a t e */ /* ------------------------------------------ */ case OPERATION_UPDATE : Init_OperationOnSystem("Update", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; Operation_Update(DefineSystem_P, DofData_P, DofData_P0, Operation_P->Case.Update.ExpressionIndex) ; Flag_CPU = 1 ; break ; /* --> U p d a t e C o n s t r a i n t */ /* ------------------------------------------ */ case OPERATION_UPDATECONSTRAINT : Init_OperationOnSystem("UpdateConstraint", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; UpdateConstraint_System(DefineSystem_P, DofData_P, DofData_P0, Operation_P->Case.UpdateConstraint.GroupIndex, Operation_P->Case.UpdateConstraint.Type, Flag_Jac) ; Flag_CPU = 1 ; break ; /* --> S e l e c t C o r r e c t i o n */ /* ------------------------------------------ */ case OPERATION_SELECTCORRECTION : Init_OperationOnSystem("SelectCorrection", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if (!Operation_P->Case.SelectCorrection.Iteration) { /* Full solution to be considered again */ Message::Info(" Full solution to be considered again"); if (DofData_P->CorrectionSolutions.Flag) { DofData_P->CorrectionSolutions.Flag = 0; DofData_P->Solutions = DofData_P->CorrectionSolutions.Save_FullSolutions ; DofData_P->CurrentSolution = DofData_P->CorrectionSolutions.Save_CurrentFullSolution ; } else { Message::Error("SelectCorrection: DofData #%d already selected as a full solution", DofData_P->Num); } } else { /* Last correction to be considered */ if (!DofData_P->CorrectionSolutions.Flag) { DofData_P->CorrectionSolutions.Flag = 1; DofData_P->CorrectionSolutions.Save_FullSolutions = DofData_P->Solutions ; DofData_P->CorrectionSolutions.Save_CurrentFullSolution = DofData_P->CurrentSolution ; /* last correction solutions */ int i; if ((i = List_Nbr(DofData_P->CorrectionSolutions.AllSolutions)-1) >= 0) { List_Read(DofData_P->CorrectionSolutions.AllSolutions, i, &DofData_P->Solutions); } else { DofData_P->CorrectionSolutions.AllSolutions = List_Create(10, 10, sizeof(List_T*)); DofData_P->Solutions = List_Create(20, 20, sizeof(struct Solution)) ; List_Add(DofData_P->CorrectionSolutions.AllSolutions, &DofData_P->Solutions); } /* last time step correction */ if ((i = List_Nbr(DofData_P->Solutions)-1) >= 0) { DofData_P->CurrentSolution = (struct Solution*) List_Pointer(DofData_P->Solutions, i) ; } else { DofData_P->CurrentSolution = NULL; /* CurrentSolution will be defined later */ } } else { Message::Error("SelectCorrection: DofData #%d already selected as a correction", DofData_P->Num); } } break ; /* --> A d d C o r r e c t i o n */ /* ------------------------------------------ */ case OPERATION_ADDCORRECTION : Init_OperationOnSystem("AddCorrection", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if (DofData_P->CorrectionSolutions.Flag) { if (DofData_P->CorrectionSolutions.Save_CurrentFullSolution->TimeStep != DofData_P->CurrentSolution->TimeStep) { Solution_S.TimeStep = (int)Current.TimeStep ; Solution_S.Time = Current.Time ; Solution_S.TimeImag = Current.TimeImag ; Solution_S.TimeFunctionValues = Get_TimeFunctionValues(DofData_P) ; Solution_S.SolutionExist = 1 ; LinAlg_CreateVector(&Solution_S.x, &DofData_P->Solver, DofData_P->NbrDof) ; LinAlg_ZeroVector(&Solution_S.x) ; List_Add(DofData_P->CorrectionSolutions.Save_FullSolutions, &Solution_S) ; DofData_P->CorrectionSolutions.Save_CurrentFullSolution = (struct Solution*) List_Pointer(DofData_P->CorrectionSolutions.Save_FullSolutions, List_Nbr(DofData_P->CorrectionSolutions.Save_FullSolutions)-1) ; } Cal_SolutionError (&DofData_P->CurrentSolution->x, &DofData_P->CorrectionSolutions.Save_CurrentFullSolution->x, 0, &MeanError) ; //LinAlg_VectorNorm2(&DofData_P->CurrentSolution->x, &MeanError); Message::Info("Mean error: %.3e (after %d iteration%s)", MeanError, (int)Current.Iteration, ((int)Current.Iteration==1)?"":"s") ; if(Message::GetProgressMeterStep() > 0 && Message::GetProgressMeterStep() < 100) Message::AddOnelabNumberChoice(Message::GetOnelabClientName() + "/Residual", MeanError); Current.RelativeDifference += MeanError * Operation_P->Case.AddCorrection.Alpha ; LinAlg_AddVectorVector (&DofData_P->CorrectionSolutions.Save_CurrentFullSolution->x, &DofData_P->CurrentSolution->x, &DofData_P->CorrectionSolutions.Save_CurrentFullSolution->x) ; } else { Message::Error("AddCorrection: DofData #%d is not selected as a correction", DofData_P->Num); } break ; /* --> I n i t C o r r e c t i o n */ /* ------------------------------------------ */ case OPERATION_INITCORRECTION : Init_OperationOnSystem("InitCorrection", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if (DofData_P->CorrectionSolutions.Flag) { Solution_S.TimeStep = (int)Current.TimeStep ; Solution_S.Time = Current.Time ; Solution_S.TimeImag = Current.TimeImag ; Solution_S.TimeFunctionValues = Get_TimeFunctionValues(DofData_P) ; Solution_S.SolutionExist = 1 ; LinAlg_CreateVector(&Solution_S.x, &DofData_P->Solver, DofData_P->NbrDof) ; /* The last full solution, if any, initializes the current correction */ if (List_Nbr(DofData_P->CorrectionSolutions.Save_FullSolutions)) { LinAlg_CopyVector (&((struct Solution *) List_Pointer (DofData_P->CorrectionSolutions.Save_FullSolutions, List_Nbr(DofData_P->CorrectionSolutions.Save_FullSolutions)-1))->x, &Solution_S.x) ; } else { LinAlg_ZeroVector(&Solution_S.x) ; } List_Add(DofData_P->Solutions, &Solution_S) ; DofData_P->CurrentSolution = (struct Solution*) List_Pointer(DofData_P->Solutions, List_Nbr(DofData_P->Solutions)-1) ; } else { Message::Error("InitCorrection: DofData #%d is not selected as a correction", DofData_P->Num); } break ; /* --> M u l t i p l y S o l u t i o n */ /* ------------------------------------------ */ case OPERATION_MULTIPLYSOLUTION : Init_OperationOnSystem("MultiplySolution", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; LinAlg_ProdVectorDouble(&DofData_P->CurrentSolution->x, Operation_P->Case.MultiplySolution.Alpha, &DofData_P->CurrentSolution->x) ; break ; /* --> A d d O p p o s i t e F u l l S o l u t i o n */ /* -------------------------------------------------- */ case OPERATION_ADDOPPOSITEFULLSOLUTION : Init_OperationOnSystem("AddOppositeFullSolution", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; LinAlg_AddVectorProdVectorDouble (&DofData_P->CurrentSolution->x, &DofData_P->CorrectionSolutions.Save_CurrentFullSolution->x, -1., &DofData_P->CurrentSolution->x) ; break ; /* --> S e t R H S A s S o l u t i o n */ /* ---------------------------------------- */ case OPERATION_SETRHSASSOLUTION : { /* Compute : x <- b */ Init_OperationOnSystem("SetRHSAsSolution", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if(DofData_P->CurrentSolution) LinAlg_CopyVector(&DofData_P->b, &DofData_P->CurrentSolution->x); else Message::Error("No current solution available"); Flag_CPU = 1 ; } break ; /* --> S e t S o l u t i o n A s R H S */ /* ---------------------------------------- */ case OPERATION_SETSOLUTIONASRHS : { /* Compute : b <- x */ Init_OperationOnSystem("SetSolutionAsRHS", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if(DofData_P->CurrentSolution) LinAlg_CopyVector(&DofData_P->CurrentSolution->x, &DofData_P->b); else Message::Error("No current solution available"); Flag_CPU = 1 ; } break ; /* --> S w a p S o l u t i o n */ /* ---------------------------------------- */ case OPERATION_SWAPSOLUTIONANDRHS : { Init_OperationOnSystem("SwapSolutionAndRHS", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if(DofData_P->CurrentSolution) LinAlg_SwapVector(&DofData_P->CurrentSolution->x, &DofData_P->b); else Message::Error("No current solution available"); Flag_CPU = 1 ; } break ; case OPERATION_SWAPSOLUTIONANDRESIDUAL : { Init_OperationOnSystem("SwapSolutionAndResidual", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if(DofData_P->CurrentSolution) LinAlg_SwapVector(&DofData_P->CurrentSolution->x, &DofData_P->res); else Message::Error("No current solution available"); Flag_CPU = 1 ; } break ; /* --> A p p l y */ /* ------------------------------------------ */ case OPERATION_APPLY : { /* Compute : x <- A x */ Init_OperationOnSystem("Apply", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if(DofData_P->CurrentSolution){ LinAlg_ProdMatrixVector(&DofData_P->A, &DofData_P->CurrentSolution->x, &DofData_P->res); LinAlg_CopyVector(&DofData_P->res, &DofData_P->CurrentSolution->x); } else Message::Error("No current solution available"); Flag_CPU = 1 ; } break ; /* --> G e t R e s i d u a l */ /* ------------------------------------------ */ case OPERATION_GETRESIDUAL : { /* Compute : b - A x */ Init_OperationOnSystem("GetResidual", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if(DofData_P->CurrentSolution){ LinAlg_ProdMatrixVector(&DofData_P->A, &DofData_P->CurrentSolution->x, &DofData_P->res); LinAlg_SubVectorVector(&DofData_P->b, &DofData_P->res, &DofData_P->res); double residual; LinAlg_VectorNorm2(&DofData_P->res, &residual); Cal_ZeroValue(&Value); Value.Type = SCALAR; Value.Val[0] = residual; Cal_StoreInVariable(&Value, Operation_P->Case.GetResidual.VariableName); if(Message::GetProgressMeterStep() > 0 && Message::GetProgressMeterStep() < 100) Message::AddOnelabNumberChoice(Message::GetOnelabClientName() + "/Residual", residual); } else Message::Error("No current solution available"); Flag_CPU = 1 ; } break ; /* --> S e t S o l v e r O p t i o n s */ /* ------------------------------------------ */ case OPERATION_SETGLOBALSOLVEROPTIONS : { Message::Info("SetGlobalSolverOptions[\"%s\"]", Operation_P->Case.SetGlobalSolverOptions.String); LinAlg_SetGlobalSolverOptions(Operation_P->Case.SetGlobalSolverOptions.String); } break ; /* --> S o l v e */ /* ------------------------------------------ */ case OPERATION_SOLVEAGAINWITHOTHER : case OPERATION_SOLVEAGAIN : case OPERATION_SOLVE : { int again = (Operation_P->Type == OPERATION_SOLVEAGAINWITHOTHER) ? 2 : (Operation_P->Type == OPERATION_SOLVEAGAIN) ? 1 : 0; #ifdef TIMER double tstart = MPI_Wtime(); #endif /* Solve : A x = b */ Init_OperationOnSystem((again == 2) ? "SolveAgainWithOther" : (again == 1) ? "SolveAgain" : "Solve", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if(!DofData_P->CurrentSolution){ Message::Error("No current solution available"); break; } if (DofData_P->Flag_Only){ // FIXME: this should move to a separate operation, so that solve // does just solve... if(DofData_P->Flag_InitOnly[0]){ LinAlg_AddMatrixMatrix(&DofData_P->A, &DofData_P->A1, &DofData_P->A); LinAlg_AddVectorVector(&DofData_P->b, &DofData_P->b1, &DofData_P->b) ; } if(DofData_P->Flag_InitOnly[1]){ LinAlg_AddMatrixMatrix(&DofData_P->A, &DofData_P->A2, &DofData_P->A) ; LinAlg_AddVectorVector(&DofData_P->b, &DofData_P->b2, &DofData_P->b) ; } if(DofData_P->Flag_InitOnly[2]){ LinAlg_AddMatrixMatrix(&DofData_P->A, &DofData_P->A3, &DofData_P->A) ; LinAlg_AddVectorVector(&DofData_P->b, &DofData_P->b3, &DofData_P->b) ; } LinAlg_AssembleMatrix(&DofData_P->A) ; LinAlg_AssembleVector(&DofData_P->b) ; } if(!again){ LinAlg_Solve(&DofData_P->A, &DofData_P->b, &DofData_P->Solver, &DofData_P->CurrentSolution->x, (Operation_P->Flag < 0) ? 0 : Operation_P->Flag) ; } else{ DofData *d = (again == 1) ? DofData_P : DofData_P0 + Operation_P->Case.SolveAgainWithOther.DefineSystemIndex; LinAlg_SolveAgain(&d->A, &DofData_P->b, &d->Solver, &DofData_P->CurrentSolution->x, (Operation_P->Flag < 0) ? 0 : Operation_P->Flag) ; } Flag_CPU = 1 ; #ifdef TIMER double timer = MPI_Wtime() - tstart; printf("Proc %d, time spent in %s %.16g\n", again ? "SolveAgain" : "Solve", Message::GetCommRank(), timer); #endif } break ; /* --> S o l v e N L */ /* ------------------------------------------ */ case OPERATION_SOLVENL : Init_OperationOnSystem("Using PETSc SNES: SolveNL", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; Init_SystemData(DofData_P, 1); LinAlg_SolveNL(&DofData_P->A, &DofData_P->b, &DofData_P->Jac, &DofData_P->res, &DofData_P->Solver, &DofData_P->dx, (Operation_P->Flag < 0) ? 0 : Operation_P->Flag) ; Flag_CPU = 1 ; break ; /* case OPERATION_SOLVENLTS : Init_OperationOnSystem("Using PETSc SNES and TS: SolveNL", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; LinAlg_SolveNLTS(&DofData_P->A, &DofData_P->b, &DofData_P->Jac, &DofData_P->res, &DofData_P->Solver, &DofData_P->dx, (Operation_P->Flag < 0) ? 0 : Operation_P->Flag) ; break; */ /* --> S o l v e J a c */ /* ------------------------------------------ */ case OPERATION_SOLVEJACAGAIN : case OPERATION_SOLVEJAC : { /* SolveJac : J(xn) dx = b(xn) - A(xn) xn ; x = xn + dx */ int again = (Operation_P->Type == OPERATION_SOLVEJACAGAIN) ? 1 : 0; Flag_Jac = 1 ; Init_OperationOnSystem(again ? "SolveJacAgain" : "SolveJac", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if(DofData_P->Flag_Init[0] < 2){ Message::Error("Jacobian system not initialized (missing GenerateJac?)"); break; } if(!DofData_P->CurrentSolution){ Message::Error("No current solution available"); break; } if (DofData_P->Flag_Only){ // FIXME: this should move to a separate operation, so that solve // does just solve... if(DofData_P->Flag_InitOnly[0]){ LinAlg_AddMatrixMatrix(&DofData_P->A, &DofData_P->A1, &DofData_P->A); LinAlg_AddVectorVector(&DofData_P->b, &DofData_P->b1, &DofData_P->b) ; } if(DofData_P->Flag_InitOnly[1]){ LinAlg_AddMatrixMatrix(&DofData_P->A, &DofData_P->A2, &DofData_P->A) ; LinAlg_AddVectorVector(&DofData_P->b, &DofData_P->b2, &DofData_P->b) ; } if(DofData_P->Flag_InitOnly[2]){ LinAlg_AddMatrixMatrix(&DofData_P->A, &DofData_P->A3, &DofData_P->A) ; LinAlg_AddVectorVector(&DofData_P->b, &DofData_P->b3, &DofData_P->b) ; } LinAlg_AssembleMatrix(&DofData_P->A) ; LinAlg_AssembleVector(&DofData_P->b) ; // for normal (without Flag_Only) assemblies, the full Jacobian is // computed at the end of GenerateJac, as it should be. LinAlg_AddMatrixMatrix(&DofData_P->A, &DofData_P->Jac, &DofData_P->Jac) ; LinAlg_ProdMatrixVector(&DofData_P->A, &DofData_P->CurrentSolution->x, &DofData_P->res) ; LinAlg_SubVectorVector(&DofData_P->b, &DofData_P->res, &DofData_P->res) ; LinAlg_DummyVector(&DofData_P->res) ; } if(!again) LinAlg_Solve(&DofData_P->Jac, &DofData_P->res, &DofData_P->Solver, &DofData_P->dx) ; else LinAlg_SolveAgain(&DofData_P->Jac, &DofData_P->res, &DofData_P->Solver, &DofData_P->dx) ; Cal_SolutionError(&DofData_P->dx, &DofData_P->CurrentSolution->x, 0, &MeanError) ; //LinAlg_VectorNorm2(&DofData_P->dx, &MeanError); if(!Flag_IterativeLoopN){ Message::Info("%3ld Nonlinear Residual norm %14.12e", (int)Current.Iteration, MeanError); if(Message::GetProgressMeterStep() > 0 && Message::GetProgressMeterStep() < 100) Message::AddOnelabNumberChoice(Message::GetOnelabClientName() + "/Residual", MeanError); } Current.RelativeDifference += MeanError ; if (!Flag_IterativeLoop) { LinAlg_ProdVectorDouble(&DofData_P->dx, Current.RelaxationFactor, &DofData_P->dx) ; } else { // Attention: phase test ... Technique bricolee ... provisoire if (Current.Iteration == 1. || MeanError < Current.RelativeDifferenceOld) LinAlg_ProdVectorDouble(&DofData_P->dx, Current.RelaxationFactor, &DofData_P->dx) ; else { RelFactor_Modified = Current.RelaxationFactor / (MeanError / Current.RelativeDifferenceOld) ; Message::Info("RelFactor modified = %g", RelFactor_Modified) ; LinAlg_ProdVectorDouble(&DofData_P->dx, RelFactor_Modified, &DofData_P->dx) ; Cal_SolutionError(&DofData_P->dx, &DofData_P->CurrentSolution->x, 0, &MeanError) ; //LinAlg_VectorNorm2(&DofData_P->dx, &MeanError); Message::Info("Mean error: %.3e", MeanError) ; } } LinAlg_AddVectorVector(&DofData_P->CurrentSolution->x, &DofData_P->dx, &DofData_P->CurrentSolution->x) ; Flag_CPU = 1 ; } break ; /* --> S o l v e J a c _ A d a p t R e l a x */ /* ------------------------------------------ */ case OPERATION_SOLVEJACADAPTRELAX : /* get increment dx by solving : J(xn) dx = b(xn) - A(xn) xn */ Flag_Jac = 1 ; Init_OperationOnSystem("SolveJacAdaptRelax", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if(DofData_P->Flag_Init[0] < 2){ Message::Error("Jacobian system not initialized (missing GenerateJac?)"); break; } if(!DofData_P->CurrentSolution){ Message::Error("No current solution available"); break; } LinAlg_Solve(&DofData_P->Jac, &DofData_P->res, &DofData_P->Solver, &DofData_P->dx) ; Message::Cpu(""); /* save CurrentSolution */ LinAlg_CreateVector(&x_Save, &DofData_P->Solver, DofData_P->NbrDof) ; LinAlg_CopyVector(&DofData_P->CurrentSolution->x, &x_Save); Flag_RHS = 1; /* MHJacNL-terms do not contribute to the RHS and residu, and are thus disregarded */ Error_Prev = 1e99 ; Frelax_Opt = 1. ; if (!(NbrSteps_relax = List_Nbr(Operation_P->Case.SolveJac_AdaptRelax.Factor_L))){ Message::Error("No factors provided for Adaptive Relaxation"); break; } for( istep = 0 ; istep < NbrSteps_relax ; istep++ ){ if(Message::GetOnelabAction() == "stop" || Message::GetErrorCount()) break; List_Read(Operation_P->Case.SolveJac_AdaptRelax.Factor_L, istep, &Frelax); /* new trial solution = x + Frelax * dx */ LinAlg_CopyVector(&x_Save, &DofData_P->CurrentSolution->x); LinAlg_AddVectorProdVectorDouble(&DofData_P->CurrentSolution->x, &DofData_P->dx, Frelax, &DofData_P->CurrentSolution->x); /* LinAlg_PrintVector(stdout, &DofData_P->CurrentSolution->x); */ /* calculate residual with trial solution */ ReGenerate_System(DefineSystem_P, DofData_P, DofData_P0) ; LinAlg_ProdMatrixVector(&DofData_P->A, &DofData_P->CurrentSolution->x, &DofData_P->res) ; LinAlg_SubVectorVector(&DofData_P->b, &DofData_P->res, &DofData_P->res) ; /* check whether norm of residual is smaller than previous ones */ LinAlg_VectorNorm2(&DofData_P->res, &Norm); LinAlg_GetVectorSize(&DofData_P->res, &N); Norm /= (double)N; if(Message::GetVerbosity() == 10) Message::Info(" adaptive relaxation factor = %8f Residual norm = %10.4e", Frelax, Norm) ; if (Norm < Error_Prev) { Error_Prev = Norm; Frelax_Opt = Frelax; } else if ( !Operation_P->Case.SolveJac_AdaptRelax.CheckAll && istep > 0 ) break ; } //Message::Info(" => optimal relaxation factor = %f", Frelax_Opt) ; /* solution = x + Frelax_Opt * dx */ LinAlg_CopyVector(&x_Save, &DofData_P->CurrentSolution->x); LinAlg_AddVectorProdVectorDouble(&DofData_P->CurrentSolution->x, &DofData_P->dx, Frelax_Opt, &DofData_P->CurrentSolution->x); MeanError = Error_Prev ; Message::Info("%3ld Nonlinear Residual norm %14.12e (optimal relaxation factor = %f)", (int)Current.Iteration, MeanError, Frelax_Opt); if(Message::GetProgressMeterStep() > 0 && Message::GetProgressMeterStep() < 100) Message::AddOnelabNumberChoice(Message::GetOnelabClientName() + "/Residual", MeanError); Current.RelativeDifference = MeanError; Flag_CPU = 1 ; Flag_RHS = 0 ; LinAlg_DestroyVector(&x_Save); break ; /* --> EigenSolve */ /* ------------------------------------------ */ case OPERATION_EIGENSOLVE : Init_OperationOnSystem("EigenSolve", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; EigenSolve(DofData_P, Operation_P->Case.EigenSolve.NumEigenvalues, Operation_P->Case.EigenSolve.Shift_r, Operation_P->Case.EigenSolve.Shift_i, Operation_P->Case.EigenSolve.FilterExpressionIndex) ; Flag_CPU = 1 ; break ; /* --> EigenSolveJac */ /* ------------------------------------------ */ case OPERATION_EIGENSOLVEJAC : Init_OperationOnSystem("EigenSolveJac", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; EigenSolve(DofData_P, Operation_P->Case.EigenSolve.NumEigenvalues, Operation_P->Case.EigenSolve.Shift_r, Operation_P->Case.EigenSolve.Shift_i, Operation_P->Case.EigenSolve.FilterExpressionIndex) ; /* Insert intelligent convergence test here :-) */ Current.RelativeDifference = 1.0 ; Flag_CPU = 1 ; break ; /* --> Perturbation */ /* ------------------------------------------ */ case OPERATION_PERTURBATION : Init_OperationOnSystem("Perturbation", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; /* Perturbation(DofData_P, DofData_P0+Operation_P->Case.Perturbation.DefineSystemIndex2, DofData_P0+Operation_P->Case.Perturbation.DefineSystemIndex3, Operation_P->Case.Perturbation.Size, Operation_P->Case.Perturbation.Save, Operation_P->Case.Perturbation.Shift, Operation_P->Case.Perturbation.PertFreq) ; */ Flag_CPU = 1 ; break ; /* --> S e t C u r r e n t S y s t e m */ /* ------------------------------------------ */ case OPERATION_SETCURRENTSYSTEM : Init_OperationOnSystem("SetCurrentSystem", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; break ; /* --> C r e a t e S o l u t i o n */ /* ------------------------------------------ */ case OPERATION_CREATESOLUTION : Init_OperationOnSystem("CreateSolution", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if (!DofData_P->Solutions) DofData_P->Solutions = List_Create( 20, 20, sizeof(struct Solution)) ; Solution_S.TimeStep = (int)Current.TimeStep ; Solution_S.Time = Current.Time ; Solution_S.TimeImag = Current.TimeImag ; Solution_S.TimeFunctionValues = Get_TimeFunctionValues(DofData_P) ; Solution_S.SolutionExist = 1 ; LinAlg_CreateVector(&Solution_S.x, &DofData_P->Solver, DofData_P->NbrDof) ; LinAlg_ZeroVector(&Solution_S.x) ; { int ts = Operation_P->Case.CreateSolution.CopyFromTimeStep; if(ts >= 0){ // FIXME Inno: maybe better to search for the actual // timestep instead of assuming we provide an index if(ts < List_Nbr(DofData_P->Solutions)){ LinAlg_CopyVector(&((struct Solution *) List_Pointer(DofData_P->Solutions, ts))->x, &Solution_S.x) ; } else{ Message::Error("Solution at step %d does not exist", ts); } } } LinAlg_AssembleVector(&Solution_S.x) ; List_Add(DofData_P->Solutions, &Solution_S) ; DofData_P->CurrentSolution = (struct Solution*) List_Pointer(DofData_P->Solutions, List_Nbr(DofData_P->Solutions)-1) ; break ; /* --> I n i t S o l u t i o n */ /* ------------------------------------------ */ case OPERATION_INITSOLUTION : case OPERATION_INITSOLUTION1 : Init_OperationOnSystem("InitSolution", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if(Flag_RESTART){ if (!DofData_P->Solutions){ Message::Error("No solution to restart the computation"); break; } for(int i = 0; i < DofData_P->NbrAnyDof; i++){ Dof_P = (struct Dof *)List_Pointer(DofData_P->DofList, i) ; if(Dof_P->Type == DOF_UNKNOWN_INIT) Dof_P->Type = DOF_UNKNOWN ; } for(int i = 0; i < List_Nbr(DofData_P->Solutions); i++){ Solution_P = (struct Solution*)List_Pointer(DofData_P->Solutions, i); Free(Solution_P->TimeFunctionValues); Solution_P->TimeFunctionValues = Get_TimeFunctionValues(DofData_P) ; /* The last solution is the current one */ if(i == List_Nbr(DofData_P->Solutions) - 1) DofData_P->CurrentSolution = Solution_P; } RES0 = (int)Current.TimeStep ; } else{ if (!DofData_P->Solutions) DofData_P->Solutions = List_Create( 20, 20, sizeof(struct Solution)) ; Solution_S.TimeStep = (int)Current.TimeStep ; Solution_S.Time = Current.Time ; Solution_S.TimeImag = Current.TimeImag ; Solution_S.TimeFunctionValues = Get_TimeFunctionValues(DofData_P) ; Solution_S.SolutionExist = 1 ; LinAlg_CreateVector(&Solution_S.x, &DofData_P->Solver, DofData_P->NbrDof) ; /* The last solution, if any, initializes the current one. Otherwise a null solution is used. a revoir qd les conditions initiales multiples seront mieux traitees */ if (List_Nbr(DofData_P->Solutions)) { LinAlg_CopyVector(&((struct Solution *) List_Pointer(DofData_P->Solutions, List_Nbr(DofData_P->Solutions)-1))->x, &Solution_S.x) ; } else { LinAlg_ZeroVector(&Solution_S.x) ; } for(int i = 0; i < DofData_P->NbrAnyDof; i++){ Dof_P = (struct Dof *)List_Pointer(DofData_P->DofList, i) ; if(Dof_P->Type == DOF_UNKNOWN_INIT){ /* Init values loaded */ if(Operation_P->Type == OPERATION_INITSOLUTION){ Dof_P->Type = DOF_UNKNOWN ; LinAlg_SetScalarInVector (&Dof_P->Val, &Solution_S.x, Dof_P->Case.Unknown.NumDof-1) ; } else{ LinAlg_SetScalarInVector (&Dof_P->Val2, &Solution_S.x, Dof_P->Case.Unknown.NumDof-1) ; } } } LinAlg_AssembleVector(&Solution_S.x) ; List_Add(DofData_P->Solutions, &Solution_S) ; DofData_P->CurrentSolution = (struct Solution*) List_Pointer(DofData_P->Solutions, List_Nbr(DofData_P->Solutions)-1) ; } break ; /* --> S a v e S o l u t i o n */ /* ------------------------------------------ */ case OPERATION_SAVESOLUTION : Init_OperationOnSystem("SaveSolution", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; strcpy(ResName, Name_Generic) ; if(!Flag_SPLIT){ strcat(ResName, ".res") ; if(RES0 < 0){ Dof_WriteFileRES0(ResName, Flag_BIN) ; RES0 = 1 ; } } else{ strcat(ResName, "-") ; sprintf(ResNum, "%d.res", (int)Current.TimeStep) ; for(int i = 0; i < 5+4-(int)strlen(ResNum); i++) strcat(ResName, "0") ; strcat(ResName, ResNum) ; if(RES0 != (int)Current.TimeStep){ Dof_WriteFileRES0(ResName, Flag_BIN) ; RES0 = (int)Current.TimeStep ; } } Dof_WriteFileRES(ResName, DofData_P, Flag_BIN, Current.Time, Current.TimeImag, (int)Current.TimeStep) ; break ; /* --> S a v e S o l u t i o n W i t h E n t i t y N u m */ /* ------------------------------------------------ */ case OPERATION_SAVESOLUTION_WITH_ENTITY_NUM : Init_OperationOnSystem("SaveSolutionWithEntityNum", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; strcpy(ResName, Name_Generic) ; //strcat(ResName, ".txt") ; { int num = Operation_P->Case.SaveSolutionWithEntityNum.GroupIndex; Group *g = 0; if (num >= 0) g = (Group*)List_Pointer(Problem_S.Group, num); bool saveFixed = Operation_P->Case.SaveSolutionWithEntityNum.SaveFixed; Dof_WriteFileRES_WithEntityNum(ResName, DofData_P, GeoData_P0, g, saveFixed) ; } break ; /* --> S a v e S o l u t i o n s */ /* ------------------------------------------ */ case OPERATION_SAVESOLUTIONS : Init_OperationOnSystem("SaveSolutions", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; strcpy(ResName, Name_Generic) ; strcat(ResName, ".res") ; if(RES0 < 0){ Dof_WriteFileRES0(ResName, Flag_BIN) ; RES0 = 1 ; } for(int i = 0; i < List_Nbr(DofData_P->Solutions); i++){ DofData_P->CurrentSolution = (struct Solution*) List_Pointer(DofData_P->Solutions, i) ; if (!DofData_P->CurrentSolution->SolutionExist) Message::Warning("Solution #%d doesn't exist anymore: skipping", i) ; else Dof_WriteFileRES(ResName, DofData_P, Flag_BIN, DofData_P->CurrentSolution->Time, DofData_P->CurrentSolution->TimeImag, i) ; } break ; /* --> M o v i n g B a n d */ /* ------------------------------------------ */ case OPERATION_INIT_MOVINGBAND2D : Message::Info("InitMovingBand2D") ; Init_MovingBand2D( (struct Group *) List_Pointer(Problem_S.Group, Operation_P->Case.Init_MovingBand2D.GroupIndex)) ; break ; case OPERATION_MESH_MOVINGBAND2D : if(Message::GetVerbosity() == 10) // +++ Message::Info("MeshMovingBand2D") ; Mesh_MovingBand2D( (struct Group *) List_Pointer(Problem_S.Group, Operation_P->Case.Mesh_MovingBand2D.GroupIndex)) ; break ; case OPERATION_GENERATE_MH_MOVING : Init_OperationOnSystem("GenerateMHMoving", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if(gSCALAR_SIZE == 2){ Message::Error("FIXME: GenerateMHMoving will not work in complex arithmetic"); break; } if (!(Val_Pulsation = Current.DofData->Val_Pulsation)){ Message::Error("GenerateMHMoving can only be used for harmonic problems"); break; } Nbr_Formulation = List_Nbr(DefineSystem_P->FormulationIndex) ; Generate_Group = (struct Group *) List_Pointer(Problem_S.Group, Operation_P->Case.Generate_MH_Moving.GroupIndex) ; MH_Moving_Matrix = (double **) Malloc(Current.NbrHar*sizeof(double *)) ; for (int k = 0; k < Current.NbrHar; k++) MH_Moving_Matrix[k] = (double *) Malloc(Current.NbrHar*sizeof(double)) ; for (int k = 0; k < Current.NbrHar; k++) for (int l = 0; l < Current.NbrHar; l++) hop[k][l] = 0.; Save_Time = Current.Time; Save_DTime = Current.DTime; MHMoving_assemblyType = 1; // Assembly done in current system: A, b for (iTime = 0 ; iTime < Operation_P->Case.Generate_MH_Moving.NbrStep ; iTime++) { Current.Time = (double)iTime/(double)Operation_P->Case.Generate_MH_Moving.NbrStep * Operation_P->Case.Generate_MH_Moving.Period ; Current.DTime = 1./(double)Operation_P->Case.Generate_MH_Moving.NbrStep * Operation_P->Case.Generate_MH_Moving.Period ; Current.TimeStep = iTime; if(Message::GetVerbosity() == 10) Message::Info("GenerateMHMoving: Step %d/%d (Time = %e DTime %e)", (int)(Current.TimeStep+1), Operation_P->Case.Generate_MH_Moving.NbrStep, Current.Time, Current.DTime) ; Treatment_Operation(Resolution_P, Operation_P->Case.Generate_MH_Moving.Operation, DofData_P0, GeoData_P0, NULL, NULL) ; for (int k = 0; k < Current.NbrHar; k++) for (int l = 0; l < Current.NbrHar; l++) { if (Val_Pulsation[k/2]) DCfactor = 2. ; else DCfactor = 1. ; MH_Moving_Matrix[k][l] = DCfactor / (double)Operation_P->Case.Generate_MH_Moving.NbrStep * ( fmod(k,2) ? -sin(Val_Pulsation[k/2]*Current.Time) : cos(Val_Pulsation[k/2]*Current.Time) ) * ( fmod(l,2) ? -sin(Val_Pulsation[l/2]*Current.Time) : cos(Val_Pulsation[l/2]*Current.Time) ) ; hop[k][l] += MH_Moving_Matrix[k][l] ; } for (int k = 0; k < Current.NbrHar/2; k++) if (!Val_Pulsation[k]) MH_Moving_Matrix[2*k+1][2*k+1] = 1. ; for (int i = 0; i < Nbr_Formulation; i++) { List_Read(DefineSystem_P->FormulationIndex, i, &Index_Formulation) ; Formulation_P = (struct Formulation*) List_Pointer(Problem_S.Formulation, Index_Formulation) ; Treatment_Formulation(Formulation_P) ; } } Current.Time = Save_Time; Current.DTime = Save_DTime; for (int k = 0; k < Current.NbrHar; k++) Free(MH_Moving_Matrix[k]) ; Free(MH_Moving_Matrix) ; MH_Moving_Matrix = NULL ; Generate_Group = NULL; LinAlg_AssembleMatrix(&DofData_P->A) ; LinAlg_AssembleVector(&DofData_P->b) ; LinAlg_AssembleMatrix(&DofData_P->Jac) ; MHMoving_assemblyType = 0; Message::Cpu("GenerateMHMoving (%d steps)", Operation_P->Case.Generate_MH_Moving.NbrStep); break ; case OPERATION_GENERATE_MH_MOVING_S : Init_OperationOnSystem("GenerateMHMovingSeparate", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if(gSCALAR_SIZE == 2){ Message::Error("FIXME: GenerateMHMovingSeparate will not work in complex arithmetic"); break; } if (!(Val_Pulsation = Current.DofData->Val_Pulsation)){ Message::Error("GenerateMHMovingSeparate can only be used for harmonic problems"); break; } Nbr_Formulation = List_Nbr(DefineSystem_P->FormulationIndex) ; Generate_Group = (struct Group *) List_Pointer(Problem_S.Group, Operation_P->Case.Generate_MH_Moving_S.GroupIndex) ; MH_Moving_Matrix = (double **) Malloc(Current.NbrHar*sizeof(double *)) ; for (int k = 0; k < Current.NbrHar; k++) MH_Moving_Matrix[k] = (double *) Malloc(Current.NbrHar*sizeof(double)) ; for (int k = 0; k < Current.NbrHar; k++) for (int l = 0; l < Current.NbrHar; l++) hop[k][l] = 0.; DummyDof = DofData_P->DummyDof ; DofData_P->DummyDof = NULL ; Save_Time = Current.Time; Save_DTime = Current.DTime; for (iTime = 0 ; iTime < Operation_P->Case.Generate_MH_Moving_S.NbrStep ; iTime++) { Current.Time = (double)iTime/(double)Operation_P->Case.Generate_MH_Moving_S.NbrStep * Operation_P->Case.Generate_MH_Moving_S.Period ; Current.DTime = 1./(double)Operation_P->Case.Generate_MH_Moving_S.NbrStep * Operation_P->Case.Generate_MH_Moving_S.Period ; Current.TimeStep = iTime; if (!iTime) { //Message::Info("GenerateMHMovingSeparate: probing for any degrees of freedom"); DofTree_MH_moving = Tree_Create(sizeof(struct Dof), fcmp_Dof) ; // probing assembly MHMoving_assemblyType = 3; // Constraints - Dofs: Unknown or Link for (int i = 0; i < Nbr_Formulation; i++) { List_Read(DefineSystem_P->FormulationIndex, i, &Index_Formulation) ; Formulation_P = (struct Formulation*) List_Pointer(Problem_S.Formulation, Index_Formulation) ; Treatment_Formulation(Formulation_P) ; } DofList_MH_moving = Tree2List(DofTree_MH_moving) ; Tree_Delete(DofTree_MH_moving) ; NbrDof_MH_moving = List_Nbr(DofList_MH_moving) ; Message::Info("GenerateMHMovingSeparate: NbrDof_MHMoving = %d", NbrDof_MH_moving); Dof_MH_moving = (struct Dof **)Malloc(NbrDof_MH_moving * sizeof(struct Dof *)) ; NumDof_MH_moving = (int *)Malloc(NbrDof_MH_moving * sizeof(int)) ; for (int i = 0; i < NbrDof_MH_moving; i++) { Dof_P = (struct Dof*)List_Pointer(DofList_MH_moving,i) ; if (Dof_P->Type != DOF_UNKNOWN){ Message::Error("Dof_MH_moving not of type unknown !?"); break; } NumDof_MH_moving[i] = Dof_P->Case.Unknown.NumDof; if(!(Dof_MH_moving[i] = (struct Dof *)List_PQuery(Current.DofData->DofList, Dof_P, fcmp_Dof))){ Message::Error("GenerateMHMovingSeparate: Dof_MH_moving[%d]=%d not in Current.DofData->DofList!!!", i, Dof_MH_moving[i]) ; break; } for (int k = 0; k < Current.NbrHar; k++) { (Dof_MH_moving[i]+k)->Case.Unknown.NumDof = i*Current.NbrHar+k+1 ; } } /* if (!iTime) */ LinAlg_CreateMatrix(&DofData_P->A_MH_moving, &DofData_P->Solver, NbrDof_MH_moving*Current.NbrHar, NbrDof_MH_moving*Current.NbrHar) ; // LinAlg_CreateVector(&DofData_P->b_MH_moving, &DofData_P->Solver, // NbrDof_MH_moving*Current.NbrHar) ; LinAlg_ZeroMatrix(&DofData_P->A_MH_moving) ; //LinAlg_ZeroVector(&DofData_P->b_MH_moving) ; } if(Message::GetVerbosity() == 10) Message::Info("GenerateMHMovingSeparate : Step %d/%d (Time = %e DTime %e)", (int)(Current.TimeStep+1), Operation_P->Case.Generate_MH_Moving_S.NbrStep, Current.Time, Current.DTime) ; Treatment_Operation(Resolution_P, Operation_P->Case.Generate_MH_Moving.Operation, DofData_P0, GeoData_P0, NULL, NULL) ; for (int k = 0; k < Current.NbrHar; k++) for (int l = 0; l < Current.NbrHar; l++) { if (Val_Pulsation[k/2]) DCfactor = 2. ; else DCfactor = 1. ; MH_Moving_Matrix[k][l] = DCfactor / (double)Operation_P->Case.Generate_MH_Moving.NbrStep * ( fmod(k,2) ? -sin(Val_Pulsation[k/2]*Current.Time) : cos(Val_Pulsation[k/2]*Current.Time) ) * ( fmod(l,2) ? -sin(Val_Pulsation[l/2]*Current.Time) : cos(Val_Pulsation[l/2]*Current.Time) ) ; hop[k][l] += MH_Moving_Matrix[k][l] ; } for (int k = 0; k < Current.NbrHar/2; k++) if (!Val_Pulsation[k]) MH_Moving_Matrix[2*k+1][2*k+1] = 1. ; /* separate assembly */ // Assembly in dedicated system: A_MH_Moving, b_MH_moving MHMoving_assemblyType = 2; for (int i = 0; i < Nbr_Formulation; i++) { List_Read(DefineSystem_P->FormulationIndex, i, &Index_Formulation) ; Formulation_P = (struct Formulation*) List_Pointer(Problem_S.Formulation, Index_Formulation) ; Treatment_Formulation(Formulation_P) ; } } /* for iTime */ LinAlg_AssembleMatrix(&DofData_P->A_MH_moving) ; //LinAlg_AssembleVector(&DofData_P->b_MH_moving) ; Message::Cpu("GenerateMHMovingSeparate (%d steps): Full matrix assembled", Operation_P->Case.Generate_MH_Moving.NbrStep); for (int k = 0; k < Current.NbrHar; k++) Free(MH_Moving_Matrix[k]) ; Free(MH_Moving_Matrix) ; MH_Moving_Matrix = NULL ; Generate_Group = NULL; for (int i = 0; i < NbrDof_MH_moving; i++) { for (int k = 0; k < Current.NbrHar; k++) (Dof_MH_moving[i]+k)->Case.Unknown.NumDof = NumDof_MH_moving[i] + k ; } LinAlg_CreateMatrix(&A_MH_moving_tmp, &DofData_P->Solver, DofData_P->NbrDof, DofData_P->NbrDof) ; //LinAlg_CreateVector(&b_MH_moving_tmp, &DofData_P->Solver, // Current.DofData->NbrDof) ; LinAlg_ZeroMatrix(&A_MH_moving_tmp) ; //LinAlg_ZeroVector(&b_MH_moving_tmp) ; nnz__=0; for (int i = 0; i < NbrDof_MH_moving; i++) { for (int k = 0; k < Current.NbrHar; k++) { row_old = Current.NbrHar*i+k ; row_new = NumDof_MH_moving[i]+k-1 ; //LinAlg_GetDoubleInVector(&d, &DofData_P->b_MH_moving, row_old) ; //LinAlg_SetDoubleInVector( d, &b_MH_moving_tmp, row_new) ; for (int j = 0; j < NbrDof_MH_moving; j++) { for (int l = 0; l < Current.NbrHar; l++) { col_old = Current.NbrHar*j+l ; col_new = NumDof_MH_moving[j]+l-1 ; LinAlg_GetDoubleInMatrix(&d, &DofData_P->A_MH_moving, col_old, row_old) ; LinAlg_GetDoubleInMatrix(&aii, &DofData_P->A_MH_moving, row_old, row_old) ; LinAlg_GetDoubleInMatrix(&ajj, &DofData_P->A_MH_moving, col_old, col_old) ; if(DummyDof==NULL){ if(d*d > 1e-12*aii*ajj){ LinAlg_AddDoubleInMatrix(d, &A_MH_moving_tmp, col_new, row_new) ; nnz__++; } } else{ if(d*d > 1e-12*aii*ajj && ( (DummyDof[row_new]==0 && DummyDof[col_new] == 0) || (row_new == col_new) ) ){ LinAlg_AddDoubleInMatrix(d, &A_MH_moving_tmp, col_new, row_new) ; nnz__++; } } } } } } LinAlg_DestroyMatrix(&DofData_P->A_MH_moving); //LinAlg_DestroyVector(&DofData_P->b_MH_moving); DofData_P->A_MH_moving = A_MH_moving_tmp; //DofData_P->b_MH_moving = b_MH_moving_tmp; LinAlg_AssembleMatrix(&DofData_P->A_MH_moving); //LinAlg_AssembleVector(&DofData_P->b_MH_moving); Current.Time = Save_Time; Current.DTime = Save_DTime; Current.TimeStep = 0; // Inner time iteration for integral, no solution in time DofData_P->DummyDof = DummyDof ; MHMoving_assemblyType = 0; Message::Cpu("GenerateMHMovingSeparate: MH Matrix in MHMovingGroup converted (%d nnz)", nnz__); break; case OPERATION_DOFSFREQUENCYSPECTRUM : Dof_GetDummies(DefineSystem_P, DofData_P); Message::Info("DofsFrequencySpectrum"); //Message::Cpu("DofsFrequencySpectrum"); break ; case OPERATION_ADDMHMOVING : LinAlg_AddMatrixMatrix(&DofData_P->A, &DofData_P->A_MH_moving, &DofData_P->A) ; Message::Info("AddMHMoving"); //Message::Cpu("AddMHMoving"); break ; /* --> S a v e S o l u t i o n E x t e n d e d M H */ /* ----------------------------------------------------------- */ case OPERATION_SAVESOLUTIONEXTENDEDMH : if (Current.NbrHar == 1) { Message::Warning("ExtendSolutionMH can only to be used with multi-harmonics") ; break ; } else if (!List_Nbr(DofData_P->Solutions)) { Message::Warning("No solution available for ExtendSolutionMH"); break ; } else if (List_Nbr(DofData_P->Solutions) > 1) { Message::Warning("Only last solution will be extended multi-harmonically and saved"); } Init_OperationOnSystem("SaveSolutionExtendedMH", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; strcpy(FileName_exMH, Name_Generic) ; strcat(FileName_exMH, Operation_P->Case.SaveSolutionExtendedMH.ResFile) ; strcat(FileName_exMH, ".res") ; Dof_WriteFileRES0(FileName_exMH, Flag_BIN) ; Dof_WriteFileRES_ExtendMH(FileName_exMH, DofData_P, Flag_BIN, Current.NbrHar + 2*Operation_P->Case.SaveSolutionExtendedMH.NbrFreq); Message::Direct(" > '%s' (%d to %d frequencies)", FileName_exMH, Current.NbrHar/2, Current.NbrHar/2 + Operation_P->Case.SaveSolutionExtendedMH.NbrFreq) ; DofData_P->CurrentSolution = (struct Solution*) List_Pointer(DofData_P->Solutions, List_Nbr(DofData_P->Solutions)-1); break ; /* --> S a v e S o l u t i o n M H T o T i m e */ /* ----------------------------------------------------------- */ case OPERATION_SAVESOLUTIONMHTOTIME : if (Current.NbrHar == 1) { Message::Warning("SaveSolutionMHtoTime can only to be used with multi-harmonics") ; break ; } else if (!List_Nbr(DofData_P->Solutions)) { Message::Warning("No solution available for SaveSolutionMHtoTime"); break ; } else if (List_Nbr(DofData_P->Solutions) > 1) { Message::Warning("Only last mult-harmonic solution will be saved for time X"); } Init_OperationOnSystem("SaveSolutionMHtoTime", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; strcpy(FileName_exMH, Name_Generic) ; strcat(FileName_exMH, Operation_P->Case.SaveSolutionMHtoTime.ResFile) ; strcat(FileName_exMH, ".res") ; Dof_WriteFileRES0(FileName_exMH, Flag_BIN) ; Dof_WriteFileRES_MHtoTime(FileName_exMH, DofData_P, Flag_BIN, Operation_P->Case.SaveSolutionMHtoTime.Time) ; Message::Direct(" > '%s' (time = %e)", FileName_exMH, Operation_P->Case.SaveSolutionMHtoTime.Time) ; DofData_P->CurrentSolution = (struct Solution*) List_Pointer(DofData_P->Solutions, List_Nbr(DofData_P->Solutions)-1); break ; /* --> R e a d S o l u t i o n */ /* ------------------------------------------ */ case OPERATION_READSOLUTION : { Init_OperationOnSystem("ReadSolution", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; int i = 0 ; while(Name_ResFile[i]){ Message::Info("Loading Processing data '%s'", Name_ResFile[i]) ; Dof_OpenFile(DOF_TMP, Name_ResFile[i], "rb"); Dof_ReadFileRES(NULL, DofData_P, DofData_P->Num, &Current.Time, &Current.TimeImag, &Current.TimeStep) ; Dof_CloseFile(DOF_TMP); i++ ; } if(!List_Nbr(DofData_P->Solutions)){ Message::Error("No valid data found for ReadSolution[%s]", DefineSystem_P->Name); break; } DofData_P->CurrentSolution = (struct Solution*) List_Pointer(DofData_P->Solutions, List_Nbr(DofData_P->Solutions)-1) ; Free(DofData_P->CurrentSolution->TimeFunctionValues); DofData_P->CurrentSolution->TimeFunctionValues = Get_TimeFunctionValues(DofData_P) ; } break ; /* --> G m s h R e a d */ /* ------------------------------------------ */ case OPERATION_GMSHREAD : #if defined(HAVE_GMSH) if(Operation_P->Case.GmshRead.ViewTag >= 0){ PView::setGlobalTag(Operation_P->Case.GmshRead.ViewTag); Message::Info("GmshRead[%s] -> View[%d]", Operation_P->Case.GmshRead.FileName, Operation_P->Case.GmshRead.ViewTag); } else{ Message::Info("GmshRead[%s]", Operation_P->Case.GmshRead.FileName); } GmshMergePostProcessingFile(Operation_P->Case.GmshRead.FileName); #else Message::Error("You need to compile GetDP with Gmsh support to use 'GmshRead'"); #endif break ; case OPERATION_GMSHMERGE : #if defined(HAVE_GMSH) if(Operation_P->Case.GmshRead.ViewTag >= 0){ PView::setGlobalTag(Operation_P->Case.GmshRead.ViewTag); Message::Info("GmshMerge[%s] -> View[%d]", Operation_P->Case.GmshRead.FileName, Operation_P->Case.GmshRead.ViewTag); } else{ Message::Info("GmshMerge[%s]", Operation_P->Case.GmshRead.FileName); } GmshMergeFile(Operation_P->Case.GmshRead.FileName); #else Message::Error("You need to compile GetDP with Gmsh support to use 'GmshMerge'"); #endif break ; case OPERATION_GMSHOPEN : #if defined(HAVE_GMSH) if(Operation_P->Case.GmshRead.ViewTag >= 0){ PView::setGlobalTag(Operation_P->Case.GmshRead.ViewTag); Message::Info("GmshOpen[%s] -> View[%d]", Operation_P->Case.GmshRead.FileName, Operation_P->Case.GmshRead.ViewTag); } else{ Message::Info("GmshOpen[%s]", Operation_P->Case.GmshRead.FileName); } GmshOpenProject(Operation_P->Case.GmshRead.FileName); #else Message::Error("You need to compile GetDP with Gmsh support to use 'GmshOpen'"); #endif break ; case OPERATION_GMSHCLEARALL : #if defined(HAVE_GMSH) Message::Info("GmshClearAll[]"); while(PView::list.size()) delete PView::list[0]; PView::setGlobalTag(0); #else Message::Error("You need to compile GetDP with Gmsh support to use 'GmshClearAll'"); #endif break ; case OPERATION_GMSHWRITE : #if defined(HAVE_GMSH) { Message::Info("GmshWrite[%s]", Operation_P->Case.GmshRead.FileName); PView *view = PView::getViewByTag(Operation_P->Case.GmshRead.ViewTag); if(view) view->write(Operation_P->Case.GmshRead.FileName, 10); else Message::Error("View %d does not exist"); } #else Message::Error("You need to compile GetDP with Gmsh support to use 'GmshWrite'"); #endif break ; /* --> S a v e M e s h */ /* ------------------------------------------ */ case OPERATION_SAVEMESH : Init_OperationOnSystem("SaveMesh", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if(Operation_P->Case.SaveMesh.FileName[0] == '/' || Operation_P->Case.SaveMesh.FileName[0] == '\\'){ strcpy(FileName, Operation_P->Case.SaveMesh.FileName); } else { strcpy(FileName, Name_Path); strcat(FileName, Operation_P->Case.SaveMesh.FileName); } if (Operation_P->Case.SaveMesh.ExprIndex >= 0) { Get_ValueOfExpressionByIndex(Operation_P->Case.SaveMesh.ExprIndex, NULL, 0., 0., 0., &Value) ; char fmt[256]; strcpy(fmt, FileName); sprintf(FileName, fmt, Value.Val[0]); } Geo_SaveMesh(Current.GeoData, ((struct Group*) List_Pointer(Problem_S.Group, Operation_P->Case.SaveMesh.GroupIndex))->InitialList, FileName) ; break ; /* --> T r a n s f e r S o l u t i o n */ /* ------------------------------------------ */ case OPERATION_TRANSFERSOLUTION : Init_OperationOnSystem("TransferSolution", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; if(Resolution2_P){ /* pre-resolution */ DofData2_P = DofData2_P0 + DefineSystem_P->DestinationSystemIndex ; Dof_TransferDof(DofData_P, &DofData2_P); } else{ /* a changer!!! Il faut se mettre d'accord sur ce que doit faire Dof_TransferDof. Ceci sert a transferer la derniere solution d'un DofData dans un autre (ds la meme resolution), base sur le meme espace fonctionnel. */ DofData2_P = DofData_P0 + DefineSystem_P->DestinationSystemIndex ; if(DofData_P->NbrAnyDof != DofData2_P->NbrAnyDof){ Message::Error("Dimensions do not match for TransferSolution"); break; } Solution_S.TimeStep = (int)Current.TimeStep ; Solution_S.Time = Current.Time ; Solution_S.TimeImag = Current.TimeImag ; Solution_S.TimeFunctionValues = Get_TimeFunctionValues(DofData2_P) ; Solution_S.SolutionExist = 1 ; LinAlg_CreateVector(&Solution_S.x, &DofData2_P->Solver, DofData2_P->NbrDof) ; LinAlg_ZeroVector(&Solution_S.x) ; if (List_Nbr(DofData_P->Solutions)) { Solution_P = (struct Solution *)List_Pointer(DofData_P->Solutions, List_Nbr(DofData_P->Solutions)-1) ; for(int i = 0; i < DofData_P->NbrAnyDof; i++){ Dof = *(struct Dof *)List_Pointer(DofData_P->DofList, i) ; if(Dof.Type == DOF_UNKNOWN){ LinAlg_GetScalarInVector(&tmp, &Solution_P->x, Dof.Case.Unknown.NumDof-1) ; if((Dof_P = (struct Dof*)List_PQuery(DofData2_P->DofList, &Dof, fcmp_Dof))){ LinAlg_SetScalarInVector(&tmp, &Solution_S.x, Dof_P->Case.Unknown.NumDof-1) ; Dof_P->Type = DOF_UNKNOWN ; } else{ Message::Warning("Unknown Dof in TransferSolution") ; } } else{ // Message::Warning("Trying to transfer a non symmetrical Dof (type %d)", // Dof.Type); } } LinAlg_AssembleVector(&Solution_S.x) ; if (!DofData2_P->Solutions) DofData2_P->Solutions = List_Create(20, 20, sizeof(struct Solution)) ; List_Add(DofData2_P->Solutions, &Solution_S) ; DofData2_P->CurrentSolution = (struct Solution*) List_Pointer(DofData2_P->Solutions, List_Nbr(DofData2_P->Solutions)-1) ; } } break ; /* --> E v a l u a t e */ /* ------------------------------------------ */ case OPERATION_EVALUATE : for(int i = 0 ; i < List_Nbr(Operation_P->Case.Evaluate.Expressions); i++){ int j; List_Read(Operation_P->Case.Evaluate.Expressions, i, &j) ; Get_ValueOfExpressionByIndex(j, NULL, 0., 0., 0., &Value) ; } break ; /* --> S e t T i m e */ /* ------------------------------------------ */ case OPERATION_SETTIME : Get_ValueOfExpressionByIndex(Operation_P->Case.SetTime.ExpressionIndex, NULL, 0., 0., 0., &Value) ; Current.Time = Value.Val[0] ; break ; /* --> S e t T i m e S t e p */ /* ------------------------------------------ */ case OPERATION_SETTIMESTEP : Get_ValueOfExpressionByIndex(Operation_P->Case.SetTime.ExpressionIndex, NULL, 0., 0., 0., &Value) ; Current.TimeStep = Value.Val[0] ; break ; /* --> S e t F r e q u e n c y */ /* ------------------------------------------ */ case OPERATION_SETFREQUENCY : DefineSystem_P = (struct DefineSystem*) List_Pointer(Resolution_P->DefineSystem, Operation_P->DefineSystemIndex) ; DofData_P = DofData_P0 + Operation_P->DefineSystemIndex ; if (DefineSystem_P->Type == VAL_COMPLEX){ if(DefineSystem_P->FrequencyValue) List_Reset(DefineSystem_P->FrequencyValue); else DefineSystem_P->FrequencyValue = List_Create(1, 1, sizeof(double)) ; /* Provisoire: une seule frequence */ Get_ValueOfExpressionByIndex(Operation_P->Case.SetFrequency.ExpressionIndex, NULL, 0., 0., 0., &Value) ; List_Add(DefineSystem_P->FrequencyValue, &Value.Val[0]); if (DofData_P->Pulsation == NULL) DofData_P->Pulsation = List_Create(1, 2, sizeof(double)) ; List_Reset(DofData_P->Pulsation); Init_HarInDofData(DefineSystem_P, DofData_P) ; } else Message::Error("Invalid SetFrequency for real system '%s'", DefineSystem_P->Name) ; break; /* --> T i m e L o o p T h e t a */ /* ------------------------------------------ */ case OPERATION_TIMELOOPTHETA : if(!List_Nbr(Current.DofData->Solutions)){ Message::Error("Not enough initial solutions for TimeLoopTheta"); break; } Message::Info("TimeLoopTheta ...") ; Save_TypeTime = Current.TypeTime ; Save_DTime = Current.DTime ; Flag_NextThetaFixed = 0 ; /* Attention: Test */ Current.TypeTime = TIME_THETA ; if(Flag_RESTART) { if (Current.Time < Operation_P->Case.TimeLoopTheta.TimeMax * 0.999999) Flag_RESTART = 0 ; } else Current.Time = Operation_P->Case.TimeLoopTheta.Time0 ; while (Current.Time < Operation_P->Case.TimeLoopTheta.TimeMax * 0.999999) { if(Message::GetOnelabAction() == "stop" || Message::GetErrorCount()) break; if (!Flag_NextThetaFixed) { /* Attention: Test */ Get_ValueOfExpressionByIndex(Operation_P->Case.TimeLoopTheta.ThetaIndex, NULL, 0., 0., 0., &Value) ; Current.Theta = Value.Val[0] ; } if (Flag_NextThetaFixed != 2) { /* Attention: Test */ Get_ValueOfExpressionByIndex(Operation_P->Case.TimeLoopTheta.DTimeIndex, NULL, 0., 0., 0., &Value) ; Current.DTime = Value.Val[0] ; } Flag_NextThetaFixed = 0 ; Current.Time += Current.DTime ; Current.TimeStep += 1. ; Message::Info(3, "Theta Time = %.8g s (TimeStep %d)", Current.Time, (int)Current.TimeStep) ; if(Message::GetProgressMeterStep() > 0 && Message::GetProgressMeterStep() < 100) Message::AddOnelabNumberChoice(Message::GetOnelabClientName() + "/Time", Current.Time); Save_Time = Current.Time ; Treatment_Operation(Resolution_P, Operation_P->Case.TimeLoopTheta.Operation, DofData_P0, GeoData_P0, NULL, NULL) ; Current.Time = Save_Time ; if(Flag_Break){ Flag_Break = 0; break; } } Current.TypeTime = Save_TypeTime ; Current.DTime = Save_DTime ; break ; /* --> T i m e L o o p N e w m a r k */ /* ------------------------------------------ */ case OPERATION_TIMELOOPNEWMARK : if(List_Nbr(Current.DofData->Solutions) < 2){ Message::Error("Not enough initial solutions for TimeLoopNewmark"); break; } Message::Info("TimeLoopNewmark ...") ; Save_TypeTime = Current.TypeTime ; Save_DTime = Current.DTime ; Current.Beta = Operation_P->Case.TimeLoopNewmark.Beta ; Current.Gamma = Operation_P->Case.TimeLoopNewmark.Gamma ; Current.TypeTime = TIME_NEWMARK ; if(Flag_RESTART){ if (Current.Time < Operation_P->Case.TimeLoopNewmark.TimeMax * 0.999999) Flag_RESTART = 0 ; } else Current.Time = Operation_P->Case.TimeLoopNewmark.Time0 ; while (Current.Time < Operation_P->Case.TimeLoopNewmark.TimeMax * 0.999999) { if(Message::GetOnelabAction() == "stop" || Message::GetErrorCount()) break; Get_ValueOfExpressionByIndex(Operation_P->Case.TimeLoopNewmark.DTimeIndex, NULL, 0., 0., 0., &Value) ; Current.DTime = Value.Val[0] ; Current.Time += Current.DTime ; Current.TimeStep += 1. ; Message::Info(3, "Newmark Time = %.8g s (TimeStep %d)", Current.Time, (int)Current.TimeStep) ; if(Message::GetProgressMeterStep() > 0 && Message::GetProgressMeterStep() < 100) Message::AddOnelabNumberChoice(Message::GetOnelabClientName() + "/Time", Current.Time); Treatment_Operation(Resolution_P, Operation_P->Case.TimeLoopNewmark.Operation, DofData_P0, GeoData_P0, NULL, NULL) ; if(Flag_Break){ Flag_Break = 0; break; } } Current.TypeTime = Save_TypeTime ; Current.DTime = Save_DTime ; break ; /* --> I t e r a t i v e L o o p */ /* ------------------------------------------ */ case OPERATION_ITERATIVELOOP : Message::Info("IterativeLoop ...") ; Save_Iteration = Current.Iteration ; for (Num_Iteration = 1 ; Num_Iteration <= Operation_P->Case.IterativeLoop.NbrMaxIteration ; Num_Iteration++) { if(Message::GetOnelabAction() == "stop" || Message::GetErrorCount()) break; Current.Iteration = (double)Num_Iteration ; Current.RelativeDifference = 0. ; Get_ValueOfExpressionByIndex (Operation_P->Case.IterativeLoop.RelaxationFactorIndex, NULL, 0., 0., 0., &Value) ; if(Current.RelaxationFactor != Value.Val[0] || Num_Iteration == 1){ Current.RelaxationFactor = Value.Val[0] ; Message::Info("Nonlinear Iteration Relaxation %g", Current.RelaxationFactor) ; } Flag_IterativeLoop = Operation_P->Case.IterativeLoop.Flag ; /* Attention: Test */ // Resolution2_P and DofData2_P0 added as arguments for allowing // TransferSolution of a nonlinear resolution Treatment_Operation(Resolution_P, Operation_P->Case.IterativeLoop.Operation, DofData_P0, GeoData_P0, Resolution2_P, DofData2_P0) ; if (Current.RelativeDifference <= Operation_P->Case.IterativeLoop.Criterion) break ; if(Flag_Break){ Flag_Break = 0; break; } Current.RelativeDifferenceOld = Current.RelativeDifference ; /* Attention: pt */ } if (Num_Iteration > Operation_P->Case.IterativeLoop.NbrMaxIteration){ Num_Iteration = Operation_P->Case.IterativeLoop.NbrMaxIteration ; Flag_IterativeLoopConverged = 0; Message::Info(3, "IterativeLoop did not converge (%d iterations, residual %g)", Num_Iteration, Current.RelativeDifference); } else{ Message::Info(3, "IterativeLoop converged (%d iteration%s, residual %g)", Num_Iteration, Num_Iteration > 1 ? "s" : "", Current.RelativeDifference); } Current.Iteration = Save_Iteration ; break ; case OPERATION_ITERATIVELINEARSOLVER : Message::Info("IterativeLinearSolver ...") ; Operation_IterativeLinearSolver (Resolution_P, Operation_P, DofData_P0, GeoData_P0) ; break; case OPERATION_BROADCASTFIELDS : Message::Info("BroadCastFields ...") ; Operation_BroadcastFields (Resolution_P, Operation_P, DofData_P0, GeoData_P0) ; break; /* --> I t e r a t i v e T i m e R e d u c t i o n */ /* ------------------------------------------------ */ case OPERATION_ITERATIVETIMEREDUCTION : Message::Info("IterativeTimeReduction ...") ; Operation_IterativeTimeReduction (Resolution_P, Operation_P, DofData_P0, GeoData_P0) ; break ; /* --> T e s t */ /* ------------------------------------------ */ case OPERATION_TEST : Message::Info("Test") ; Get_ValueOfExpressionByIndex(Operation_P->Case.Test.ExpressionIndex, NULL, 0., 0., 0., &Value) ; if(Value.Val[0]){ Treatment_Operation(Resolution_P, Operation_P->Case.Test.Operation_True, DofData_P0, GeoData_P0, NULL, NULL) ; } else{ if(Operation_P->Case.Test.Operation_False) Treatment_Operation(Resolution_P, Operation_P->Case.Test.Operation_False, DofData_P0, GeoData_P0, NULL, NULL) ; } break ; /* --> W h i l e */ /* ------------------------------------------ */ case OPERATION_WHILE : Message::Info("While...") ; while(1){ if(Message::GetOnelabAction() == "stop" || Message::GetErrorCount()) break; Get_ValueOfExpressionByIndex(Operation_P->Case.While.ExpressionIndex, NULL, 0., 0., 0., &Value) ; if(!Value.Val[0]) break; Treatment_Operation(Resolution_P, Operation_P->Case.While.Operation, DofData_P0, GeoData_P0, NULL, NULL) ; if(Flag_Break){ Flag_Break = 0; break; } } break ; /* --> F o u r i e r T r a n s f o r m */ /* ------------------------------------------ */ case OPERATION_FOURIERTRANSFORM2 : Message::Info("FourierTransform") ; if(gSCALAR_SIZE == 2){ Message::Error("FIXME: FourierTransform2 will not work in complex arithmetic"); break; } DofData_P = DofData_P0 + Operation_P->Case.FourierTransform2.DefineSystemIndex[0] ; DofData2_P = DofData_P0 + Operation_P->Case.FourierTransform2.DefineSystemIndex[1] ; NbrHar1 = DofData_P->NbrHar ; NbrDof1 = List_Nbr(DofData_P->DofList) ; NbrHar2 = DofData2_P->NbrHar ; NbrDof2 = List_Nbr(DofData2_P->DofList) ; if (NbrHar1 != 1 || NbrHar2 < 2 || NbrDof2 != (NbrDof1*NbrHar2)){ Message::Error("Uncompatible System definitions for FourierTransform" " (NbrHar = %d|%d NbrDof = %d|%d)", NbrHar1, NbrHar2, NbrDof1, NbrDof2) ; break; } if(!DofData2_P->Solutions){ DofData2_P->Solutions = List_Create(1, 1, sizeof(struct Solution)) ; Operation_P->Case.FourierTransform2.Scales = (double *)Malloc(NbrHar2*sizeof(double)) ; } Nbr_Sol = List_Nbr(DofData2_P->Solutions) ; Scales = Operation_P->Case.FourierTransform2.Scales ; if ( (Operation_P->Case.FourierTransform2.Period_sofar + Current.DTime > Operation_P->Case.FourierTransform2.Period) && Nbr_Sol ) { Message::Info("Normalizing and finalizing Fourier Analysis" " (solution %d) (Period: %e out of %e)", Nbr_Sol, Operation_P->Case.FourierTransform2.Period_sofar, Operation_P->Case.FourierTransform2.Period); for (int i = 0; i < NbrHar2; i++) Message::Info("Har %d : Scales %e ", i, Scales[i]) ; Solution_P = (struct Solution*)List_Pointer(DofData2_P->Solutions, Nbr_Sol-1); for(int j = 0; jNbrDof; j += NbrHar2){ NumDof = ((struct Dof *)List_Pointer(DofData2_P->DofList,j))->Case.Unknown.NumDof - 1 ; for(int k = 0; kx, NumDof+k) ; if (Scales[k]) d1 /= Scales[k] ; LinAlg_SetDoubleInVector(d1, &Solution_P->x, NumDof+k) ; } } Operation_P->Case.FourierTransform2.Period_sofar = 0 ; break; } if (Operation_P->Case.FourierTransform2.Period_sofar == 0) { Message::Info("Starting new Fourier Analysis : solution %d ", Nbr_Sol); Solution_S.TimeStep = Nbr_Sol; Solution_S.Time = Nbr_Sol; Solution_S.TimeFunctionValues = NULL; Solution_S.SolutionExist = 1 ; LinAlg_CreateVector(&Solution_S.x, &DofData2_P->Solver, DofData2_P->NbrDof) ; LinAlg_ZeroVector(&Solution_S.x) ; List_Add(DofData2_P->Solutions, &Solution_S) ; Nbr_Sol++ ; for (int k = 0; kCurrentSolution = Solution_P = (struct Solution*)List_Pointer(DofData2_P->Solutions, Nbr_Sol-1) ; for (int k = 0; kVal_Pulsation[k/2] * Current.Time ; Scales[k ] += cos(d) * cos(d) * Current.DTime ; Scales[k+1] += sin(d) * sin(d) * Current.DTime ; } for(int j = 0; j < NbrDof1; j++){ Dof_GetRealDofValue(DofData_P, (struct Dof *)List_Pointer(DofData_P->DofList,j), &dd) ; NumDof = ((struct Dof *)List_Pointer(DofData2_P->DofList, j*NbrHar2))->Case.Unknown.NumDof - 1 ; if (((struct Dof *)List_Pointer(DofData2_P->DofList,j*NbrHar2))->Type != DOF_UNKNOWN) Message::Info("Dof not unknown %d", j) ; for (int k = 0; k < NbrHar2; k+=2) { d = DofData2_P->Val_Pulsation[k/2] * Current.Time ; LinAlg_AddDoubleInVector( dd*cos(d)*Current.DTime, &Solution_P->x, NumDof+k ) ; LinAlg_AddDoubleInVector(-dd*sin(d)*Current.DTime, &Solution_P->x, NumDof+k+1) ; } } Operation_P->Case.FourierTransform2.Period_sofar += Current.DTime ; break; case OPERATION_FOURIERTRANSFORM : Message::Info("FourierTransform") ; DofData_P = DofData_P0 + Operation_P->Case.FourierTransform.DefineSystemIndex[0] ; DofData2_P = DofData_P0 + Operation_P->Case.FourierTransform.DefineSystemIndex[1] ; if(!DofData2_P->Solutions){ int k = List_Nbr(Operation_P->Case.FourierTransform.Frequency) ; if(DofData2_P->NbrDof != gCOMPLEX_INCREMENT * DofData_P->NbrDof){ Message::Error("Uncompatible System definitions for FourierTransform") ; break; } DofData2_P->Solutions = List_Create(k, 1, sizeof(struct Solution)) ; for(int i = 0; i < k; i++){ List_Read(Operation_P->Case.FourierTransform.Frequency, i, &d) ; Solution_S.TimeStep = i ; Solution_S.Time = TWO_PI * d; Solution_S.TimeImag = 0.; Solution_S.TimeFunctionValues = NULL; Solution_S.SolutionExist = 1 ; LinAlg_CreateVector(&Solution_S.x, &DofData2_P->Solver, DofData2_P->NbrDof) ; LinAlg_ZeroVector(&Solution_S.x) ; List_Add(DofData2_P->Solutions, &Solution_S) ; } DofData2_P->CurrentSolution = (struct Solution*)List_Pointer(DofData2_P->Solutions, k/2) ; } for(int i = 0; i < List_Nbr(DofData2_P->Solutions); i++){ Solution_P = (struct Solution*)List_Pointer(DofData2_P->Solutions, i); d = Solution_P->Time * Current.Time ; for(int j=0,k=0 ; jNbrDof ; j++,k+=gCOMPLEX_INCREMENT){ LinAlg_GetDoubleInVector(&d2, &DofData_P->CurrentSolution->x, j); LinAlg_AddComplexInVector( d2 * cos(d) * Current.DTime, -d2 * sin(d) * Current.DTime, &Solution_P->x, k, k+1) ; } } break; /* --> P r i n t / W r i t e */ /* ------------------------------------------ */ case OPERATION_WRITE : Flag_Binary = 1 ; case OPERATION_PRINT : if(Operation_P->Case.Print.FileOut){ if(Operation_P->Case.Print.FileOut[0] == '/' || Operation_P->Case.Print.FileOut[0] == '\\'){ strcpy(FileName, Operation_P->Case.Print.FileOut); } else{ strcpy(FileName, Name_Path); strcat(FileName, Operation_P->Case.Print.FileOut); } if(!(fp = FOpen(FileName, "ab"))){ Message::Error("Unable to open file '%s'", FileName) ; break; } Message::Info("Print -> '%s'", FileName) ; } else{ fp = stdout ; Message::Info("Print") ; } if(Operation_P->Case.Print.Expressions){ List_T *list = 0; if(Operation_P->Case.Print.FormatString) list = List_Create(10, 10, sizeof(double)); for(int i = 0; i < List_Nbr(Operation_P->Case.Print.Expressions); i++){ int j; List_Read(Operation_P->Case.Print.Expressions, i, &j) ; Get_ValueOfExpressionByIndex(j, NULL, 0., 0., 0., &Value) ; if(list) List_Add(list, &Value.Val[0]); else Print_Value(&Value, fp) ; } if(list){ char buffer[1024]; Print_ListOfDouble(Operation_P->Case.Print.FormatString, list, buffer); Message::Direct(3, buffer); if(fp != stdout) fprintf(fp, "%s\n", buffer); List_Delete(list); } } else if (Operation_P->Case.Print.DofNumber){ DofData_P = DofData_P0 + Operation_P->DefineSystemIndex ; for(int i = 0; i < List_Nbr(Operation_P->Case.Print.DofNumber); i++){ int j = *(int*)List_Pointer(Operation_P->Case.Print.DofNumber, i) ; if(j >= 0 && j < DofData_P->NbrDof){ if(Operation_P->Case.Print.TimeStep) for(int k = 0 ; k < List_Nbr(Operation_P->Case.Print.TimeStep); k++){ int l = *(int*)List_Pointer(Operation_P->Case.Print.TimeStep, k) ; if(l >= 0 && l < List_Nbr(DofData_P->Solutions)){ Solution_P = (struct Solution*)List_Pointer(DofData_P->Solutions, l) ; LinAlg_GetScalarInVector(&tmp, &Solution_P->x, j) ; if(Flag_Binary){ LinAlg_WriteScalar(fp, &tmp) ; } else{ LinAlg_PrintScalar(fp, &tmp) ; fprintf(fp, " ") ; } } else Message::Warning("Print of Dof out of TimeStep range [0,%d]", List_Nbr(DofData_P->Solutions)-1); } else{ LinAlg_GetScalarInVector(&tmp, &DofData_P->CurrentSolution->x, j) ; if(Flag_Binary){ LinAlg_WriteScalar(fp, &tmp) ; } else{ LinAlg_PrintScalar(fp, &tmp) ; fprintf(fp, " ") ; } } } else Message::Warning("Wrong number of Dof to Print (%d is out of [0,%d])", j, DofData_P->NbrDof-1); } fprintf(fp, "\n") ; } else{ DofData_P = DofData_P0 + Operation_P->DefineSystemIndex ; if(Flag_Binary){ LinAlg_WriteMatrix(fp, &DofData_P->A) ; LinAlg_WriteVector(fp, &DofData_P->b) ; } else{ // use matlab format if available DefineSystem_P = (struct DefineSystem*) List_Pointer(Resolution_P->DefineSystem, Operation_P->DefineSystemIndex) ; std::string path(Name_Path), file("file_"); std::string mat("mat_"), vec("vec_"), sol("sol_"); std::string jac("jac_"), res("res_"), dx("dx_"); std::string name(Operation_P->Case.Print.FileOut ? Operation_P->Case.Print.FileOut : DefineSystem_P->Name); if(DofData_P->Flag_Init[1] || DofData_P->Flag_Init[2] || DofData_P->Flag_Init[3] || DofData_P->Flag_Init[4] || DofData_P->Flag_Init[5] || DofData_P->Flag_Init[6]){ if(DofData_P->Flag_Init[1]){ std::string name1 = name + "1"; LinAlg_PrintMatrix(fp, &DofData_P->M1, true, (path + file + mat + name1 + ".m").c_str(), (mat + name).c_str()) ; LinAlg_PrintVector(fp, &DofData_P->m1, true, (path + file + vec + name1 + ".m").c_str(), (vec + name1).c_str()) ; } if(DofData_P->Flag_Init[2]){ std::string name1 = name + "2"; LinAlg_PrintMatrix(fp, &DofData_P->M2, true, (path + file + mat + name1 + ".m").c_str(), (mat + name1).c_str()) ; LinAlg_PrintVector(fp, &DofData_P->m2, true, (path + file + vec + name1 + ".m").c_str(), (vec + name1).c_str()) ; } if(DofData_P->Flag_Init[3]){ std::string name1 = name + "3"; LinAlg_PrintMatrix(fp, &DofData_P->M3, true, (path + file + mat + name1 + ".m").c_str(), (mat + name1).c_str()) ; LinAlg_PrintVector(fp, &DofData_P->m3, true, (path + file + vec + name1 + ".m").c_str(), (vec + name1).c_str()) ; } if(DofData_P->Flag_Init[4]){ std::string name1 = name + "4"; LinAlg_PrintMatrix(fp, &DofData_P->M4, true, (path + file + mat + name1 + ".m").c_str(), (mat + name1).c_str()) ; LinAlg_PrintVector(fp, &DofData_P->m4, true, (path + file + vec + name1 + ".m").c_str(), (vec + name1).c_str()) ; } if(DofData_P->Flag_Init[5]){ std::string name1 = name + "5"; LinAlg_PrintMatrix(fp, &DofData_P->M5, true, (path + file + mat + name1 + ".m").c_str(), (mat + name1).c_str()) ; LinAlg_PrintVector(fp, &DofData_P->m5, true, (path + file + vec + name1 + ".m").c_str(), (vec + name1).c_str()) ; } if(DofData_P->Flag_Init[6]){ std::string name1 = name + "6"; LinAlg_PrintMatrix(fp, &DofData_P->M6, true, (path + file + mat + name1 + ".m").c_str(), (mat + name1).c_str()) ; LinAlg_PrintVector(fp, &DofData_P->m6, true, (path + file + vec + name1 + ".m").c_str(), (vec + name1).c_str()) ; } } else{ if(DofData_P->Flag_Init[0]){ LinAlg_PrintMatrix(fp, &DofData_P->A, true, (path + file + mat + name + ".m").c_str(), (mat + name).c_str()) ; LinAlg_PrintVector(fp, &DofData_P->b, true, (path + file + vec + name + ".m").c_str(), (vec + name).c_str()) ; } if(DofData_P->Flag_Init[0] == 2){ LinAlg_PrintMatrix(fp, &DofData_P->Jac, true, (path + file + jac + name + ".m").c_str(), (jac + name).c_str()) ; LinAlg_PrintVector(fp, &DofData_P->res, true, (path + file + res + name + ".m").c_str(), (res + name).c_str()) ; LinAlg_PrintVector(fp, &DofData_P->dx, true, (path + file + dx + name + ".m").c_str(), (dx + name).c_str()) ; } } if(DofData_P->CurrentSolution) LinAlg_PrintVector(fp, &DofData_P->CurrentSolution->x, true, (path + file + sol + name + ".m").c_str(), (sol + name).c_str()) ; } } fflush(fp); if(Operation_P->Case.Print.FileOut){ fclose(fp); fp = stdout ; } Flag_Binary = 0; break; /* --> C h a n g e O f C o o r d i n a t e s */ /* ------------------------------------------ */ case OPERATION_CHANGEOFCOORDINATES : if(Message::GetVerbosity() == 10) // +++ Message::Info("ChangeOfCoordinates") ; /* Geo_SetCurrentGeoData(Current.GeoData = GeoData_P0) ; */ Operation_ChangeOfCoordinates (Resolution_P, Operation_P, DofData_P0, GeoData_P0) ; break ; /* --> D e f o r m e M e s h */ /* ------------------------------------------ */ case OPERATION_DEFORMEMESH : { if (Operation_P->Case.DeformeMesh.Name_MshFile == NULL) Operation_P->Case.DeformeMesh.Name_MshFile = Name_MshFile ; Message::Info("DeformeMesh[%s, %s, '%s']", ((struct DefineSystem *) List_Pointer(Resolution_P->DefineSystem, Operation_P->DefineSystemIndex))->Name, Operation_P->Case.DeformeMesh.Quantity, Operation_P->Case.DeformeMesh.Name_MshFile) ; int i; if ((i = List_ISearchSeq(GeoData_L, Operation_P->Case.DeformeMesh.Name_MshFile, fcmp_GeoData_Name)) < 0){ Message::Error("DeformeMesh: Wrong NameOfMeshFile %s", Operation_P->Case.DeformeMesh.Name_MshFile); break; } Operation_P->Case.DeformeMesh.GeoDataIndex = i ; Operation_DeformeMesh (Resolution_P, Operation_P, DofData_P0, GeoData_P0) ; } break; /* --> P o s t O p e r a t i o n */ /* ------------------------------- */ case OPERATION_POSTOPERATION : #ifdef TIMER {double tstart = MPI_Wtime(); #endif Message::Info("PostOperation") ; Operation_PostOperation(Resolution_P, DofData_P0, GeoData_P0, Operation_P->Case.PostOperation.PostOperations); #ifdef TIMER double timer = MPI_Wtime() - tstart; printf("Proc %d, time spent in PostOperation %.16g\n", Message::GetCommRank(), timer); } #endif break ; /* --> D e l e t e F i l e */ /* ------------------------- */ case OPERATION_DELETEFILE : Message::Info("DeleteFile[%s]", Operation_P->Case.DeleteFile.FileName) ; RemoveFile(Operation_P->Case.DeleteFile.FileName); break ; /* --> R e n a m e F i l e */ /* ------------------------- */ case OPERATION_RENAMEFILE : Message::Info("RenameFile[%s, %s]", Operation_P->Case.RenameFile.OldFileName, Operation_P->Case.RenameFile.NewFileName) ; RenameFile(Operation_P->Case.RenameFile.OldFileName, Operation_P->Case.RenameFile.NewFileName); break ; /* --> C r e a t e D i r */ /* ------------------------ */ case OPERATION_CREATEDIR : Message::Info("CreateDir[%s]", Operation_P->Case.CreateDir.DirName) ; CreateDirs(Operation_P->Case.CreateDir.DirName); break ; /* --> T i m e L o o p A d a p t i v e */ /* ------------------------------------- */ case OPERATION_TIMELOOPADAPTIVE : Message::Info("TimeLoopAdaptve ...") ; Save_TypeTime = Current.TypeTime ; Save_DTime = Current.DTime ; Operation_TimeLoopAdaptive(Resolution_P, Operation_P, DofData_P0, GeoData_P0, &Flag_Break) ; Current.TypeTime = Save_TypeTime ; Current.DTime = Save_DTime ; break; /* --> I t e r a t i v e L o o p N */ /* ------------------------------------------ */ case OPERATION_ITERATIVELOOPN : Message::Info("IterativeLoopN ...") ; Save_Iteration = Current.Iteration ; Operation_IterativeLoopN(Resolution_P, Operation_P, DofData_P0, GeoData_P0, Resolution2_P, DofData2_P0, &Flag_Break) ; Current.Iteration = Save_Iteration ; break; /* --> T i m e L o o p R u n g e K u t t a */ /* ----------------------------------------- */ case OPERATION_TIMELOOPRUNGEKUTTA : { Init_OperationOnSystem("TimeLoopRungeKutta", Resolution_P, Operation_P, DofData_P0, GeoData_P0, &DefineSystem_P, &DofData_P, Resolution2_P) ; int numStepRK = List_Nbr(Operation_P->Case.TimeLoopRungeKutta.ButcherC); if(numStepRK != List_Nbr(Operation_P->Case.TimeLoopRungeKutta.ButcherB) || numStepRK * numStepRK != List_Nbr(Operation_P->Case.TimeLoopRungeKutta.ButcherA)){ Message::Error("Incompatible sizes of Butcher Tableaux"); break; } Current.Time = Operation_P->Case.TimeLoopRungeKutta.Time0 ; gVector xn, rhs; LinAlg_CreateVector(&xn, &DofData_P->Solver, Current.DofData->NbrDof); LinAlg_CreateVector(&rhs, &DofData_P->Solver, Current.DofData->NbrDof); std::vector ki(numStepRK); for(int i = 0; i < numStepRK; i++) LinAlg_CreateVector(&ki[i], &DofData_P->Solver, Current.DofData->NbrDof); while (Current.Time < Operation_P->Case.TimeLoopRungeKutta.TimeMax * 0.9999999) { if(Message::GetOnelabAction() == "stop" || Message::GetErrorCount()) break; double tn = Current.Time; LinAlg_CopyVector(&DofData_P->CurrentSolution->x, &xn); Get_ValueOfExpressionByIndex(Operation_P->Case.TimeLoopRungeKutta.DTimeIndex, NULL, 0., 0., 0., &Value) ; Current.DTime = Value.Val[0]; Current.TimeStep += 1.; for(int i = 0; i < numStepRK; i++){ double ci; List_Read(Operation_P->Case.TimeLoopRungeKutta.ButcherC, i, &ci); Current.Time = tn + ci * Current.DTime; LinAlg_CopyVector(&xn, &DofData_P->CurrentSolution->x); // FIXME: warning, this assumes an explicit RK scheme! for(int j = 0; j < i; j++){ double aij; List_Read(Operation_P->Case.TimeLoopRungeKutta.ButcherA, i * numStepRK + j, &aij); LinAlg_AddVectorProdVectorDouble(&DofData_P->CurrentSolution->x, &ki[j], aij, &DofData_P->CurrentSolution->x); } Current.TypeAssembly = ASSEMBLY_SEPARATE ; Init_SystemData(DofData_P, Flag_Jac) ; Generate_System(DefineSystem_P, DofData_P, DofData_P0, Flag_Jac, 1); LinAlg_ProdMatrixVector(&DofData_P->M1, &DofData_P->CurrentSolution->x, &rhs); LinAlg_ProdVectorDouble(&rhs, -1., &rhs); LinAlg_AddVectorProdVectorDouble(&rhs, &DofData_P->b, 1., &rhs); LinAlg_ProdVectorDouble(&rhs, Current.DTime, &rhs); LinAlg_Solve(&DofData_P->M2, &rhs, &DofData_P->Solver, &ki[i]) ; } // restore previous time step LinAlg_CopyVector(&xn, &((struct Solution*) List_Pointer(DofData_P->Solutions, List_Nbr(DofData_P->Solutions)-2))->x) ; LinAlg_CopyVector(&xn, &DofData_P->CurrentSolution->x); for(int i = 0; i < numStepRK; i++){ double bi; List_Read(Operation_P->Case.TimeLoopRungeKutta.ButcherB, i, &bi); LinAlg_AddVectorProdVectorDouble(&DofData_P->CurrentSolution->x, &ki[i], bi, &DofData_P->CurrentSolution->x); } Current.Time = tn + Current.DTime; if(Flag_Break){ Flag_Break = 0; break; } } } break ; case OPERATION_BREAK : Flag_Break = 1; break ; case OPERATION_SLEEP : Get_ValueOfExpressionByIndex(Operation_P->Case.Sleep.ExpressionIndex, NULL, 0., 0., 0., &Value) ; Message::Info("Sleeping for %g seconds", Value.Val[0]); SleepSeconds(Value.Val[0]); break ; /* --> P a r a l l e l C o m p u t i n g */ /* ------------------------------------------ */ case OPERATION_SETCOMMSELF : LinAlg_SetCommSelf(); break ; case OPERATION_SETCOMMWORLD : LinAlg_SetCommWorld(); break ; case OPERATION_BARRIER : #if defined(HAVE_PETSC) Message::Info("Barrier: waiting"); MPI_Barrier(PETSC_COMM_WORLD); Message::Info("Barrier: let's continue"); #endif break ; /* --> O t h e r */ /* ------------------------------------------ */ default : Message::Warning("Operation: ? ? ?") ; break ; } if(Flag_CPU) Message::Cpu(""); } Message::Barrier(); } getdp-2.7.0-source/Legacy/F_Hysteresis.cpp000644 001750 001750 00000147051 12531661502 022131 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Johan Gyselinck // #include #include "ProData.h" #include "F.h" #include "Message.h" #include #define SQU(a) ((a)*(a)) #define CUB(a) ((a)*(a)*(a)) #define MU0 1.25663706144e-6 /* ------------------------------------------------------------------------ */ /* Vectorized Jiles-Atherton hysteresis model J. Gyselinck, P. Dular, N. Sadowski, J. Leite and J.P.A. Bastos, "Incorporation of a Jiles-Atherton vector hysteresis model in 2D FE magnetic field computations. Application of the Newton-Raphson method", Vol. 23, No. 3, pp. 685-693, 2004. */ double F_Man (double He, double Ms, double a) { // Anhysteretic magnetisation if (fabs(He) < 0.01*a) //return Ms*He/(3.*a) ; // Aprox. up to 1st order return Ms*(He/(3.*a)-1/45*CUB(He/a)) ; // Approx. up to 3rd order else return Ms*(cosh(He/a)/sinh(He/a)-a/He) ; } double F_dMandHe (double He, double Ms, double a) { // Derivative of the magnetisation Man with respect to the effective field He if (fabs(He) < 0.01*a) //return Ms/(3.*a) ; // Aprox. up to 1st order return Ms/(3.*a)-Ms/(15*a)*SQU(He/a) ; // Approx. up to 3rd order else return Ms/a*(1-SQU(cosh(He/a)/sinh(He/a))+SQU(a/He)) ; } void FV_Man (double He[3], double Ms, double a, double Man[3]) { double nHe = sqrt(He[0]*He[0]+He[1]*He[1]+He[2]*He[2]) ; if ( !nHe ) { Man[0] = Man[1] = Man[2]= 0. ; } else { double auxMan = F_Man(nHe, Ms, a) ; Man[0] = auxMan * He[0]/nHe ; Man[1] = auxMan * He[1]/nHe ; Man[2] = auxMan * He[2]/nHe ; } } void FV_dMandHe(double He[3], double Ms, double a, double dMandHe[6]) { double nHe = sqrt(He[0]*He[0]+He[1]*He[1]+He[2]*He[2]) ; double Man = F_Man(nHe, Ms, a) ; double ndMandHe = F_dMandHe(nHe,Ms,a) ; if ( !nHe ) { dMandHe[0] = dMandHe[3] = dMandHe[5] = ndMandHe ; dMandHe[1] = dMandHe[2] = dMandHe[4] = 0. ; } else { dMandHe[0] = Man/nHe + (ndMandHe - Man/nHe)*He[0]*He[0]/(nHe*nHe) ; dMandHe[3] = Man/nHe + (ndMandHe - Man/nHe)*He[1]*He[1]/(nHe*nHe) ; dMandHe[5] = Man/nHe + (ndMandHe - Man/nHe)*He[2]*He[2]/(nHe*nHe) ; dMandHe[1] = (ndMandHe - Man/nHe)*He[0]*He[1]/(nHe*nHe) ; dMandHe[2] = (ndMandHe - Man/nHe)*He[0]*He[2]/(nHe*nHe) ; dMandHe[4] = (ndMandHe - Man/nHe)*He[1]*He[2]/(nHe*nHe) ; } } void FV_dMidHe(double He[3], double Man[3], double Mi[3], double dH[3], double k, double dMidHe[6]) { double dM = sqrt( (Man[0]-Mi[0])*(Man[0]-Mi[0]) + (Man[1]-Mi[1])*(Man[1]-Mi[1]) + (Man[2]-Mi[2])*(Man[2]-Mi[2]) ) ; if ( !dM || (Man[0]-Mi[0])*dH[0] + (Man[1]-Mi[1])*dH[1] + (Man[2]-Mi[2])*dH[2] <= 0 ) { dMidHe[0] = dMidHe[3] = dMidHe[5] = dMidHe[1] = dMidHe[2] = dMidHe[4] = 0. ; } else { double kdM = k * dM; dMidHe[0] = (Man[0]-Mi[0])*(Man[0]-Mi[0]) / kdM ; dMidHe[3] = (Man[1]-Mi[1])*(Man[1]-Mi[1]) / kdM ; dMidHe[5] = (Man[2]-Mi[2])*(Man[2]-Mi[2]) / kdM ; dMidHe[1] = (Man[0]-Mi[0])*(Man[1]-Mi[1]) / kdM ; dMidHe[2] = (Man[0]-Mi[0])*(Man[2]-Mi[2]) / kdM ; dMidHe[4] = (Man[1]-Mi[1])*(Man[2]-Mi[2]) / kdM ; } } void Vector_dBdH(double H[3], double B[3], double dH[3], struct FunctionActive *D, double dBdH[6]) { double M[3], He[3], Man[3], Mi[3] ; double dMandHe[6], dMidHe[6], dMdH[6] ; double d[6], e[6], f[6] ; if (D->Case.Interpolation.NbrPoint != 5) Message::Error("Jiles-Atherton parameters missing: {List[{Ms, a, k, c, alpha}]}"); double Ms = D->Case.Interpolation.x[0] ; double a = D->Case.Interpolation.x[1] ; double kk = D->Case.Interpolation.x[2] ; double c = D->Case.Interpolation.x[3] ; double alpha = D->Case.Interpolation.x[4] ; for (int i=0 ; i<3 ; i++){ M[i] = B[i]/MU0 - H[i] ; // Magnetisation He[i] = H[i] + alpha * M[i] ; // Effective field } FV_Man (He, Ms, a, Man) ; for (int i=0 ; i<3 ; i++) Mi[i] = (M[i]-c*Man[i]) / (1-c) ; // Irreversible magnetisation FV_dMandHe(He, Ms, a, dMandHe) ; FV_dMidHe(He, Man, Mi, dH, kk, dMidHe) ; d[0] = 1 - alpha*c*dMandHe[0] - alpha*(1-c)*dMidHe[0] ; // xx d[3] = 1 - alpha*c*dMandHe[3] - alpha*(1-c)*dMidHe[3] ; // yy d[5] = 1 - alpha*c*dMandHe[5] - alpha*(1-c)*dMidHe[5] ; // zz d[1] = - alpha*c*dMandHe[1] - alpha*(1-c)*dMidHe[1] ; // xy d[2] = - alpha*c*dMandHe[2] - alpha*(1-c)*dMidHe[2] ; // xz d[4] = - alpha*c*dMandHe[4] - alpha*(1-c)*dMidHe[4] ; // yz double dd = d[0] * (d[3] *d[5] - d[4] *d[4]) - d[1] * (d[1] *d[5] - d[4] *d[2]) + d[2] * (d[1] *d[4] - d[3] *d[2]); if (!dd) Message::Error("Null determinant of denominator of dm/dh!"); e[0] = (d[3]*d[5]-d[4]*d[4])/dd ; e[1] = -(d[1]*d[5]-d[2]*d[4])/dd ; e[2] = (d[1]*d[4]-d[2]*d[3])/dd ; e[3] = (d[0]*d[5]-d[2]*d[2])/dd ; e[4] = -(d[0]*d[4]-d[1]*d[2])/dd ; e[5] = (d[0]*d[3]-d[1]*d[1])/dd ; for (int i=0 ; i<6 ; i++) f[i] = c*dMandHe[i] + (1-c)*dMidHe[i] ; dMdH[0] = e[0]*f[0]+e[1]*f[1]+e[2]*f[2] ; dMdH[1] = e[0]*f[1]+e[1]*f[3]+e[2]*f[4] ; dMdH[2] = e[0]*f[2]+e[1]*f[4]+e[2]*f[5] ; dMdH[3] = e[1]*f[1]+e[3]*f[3]+e[4]*f[4] ; dMdH[4] = e[1]*f[2]+e[3]*f[4]+e[4]*f[5] ; dMdH[5] = e[2]*f[2]+e[4]*f[4]+e[5]*f[5] ; dBdH[0] = MU0 * (1.0 + dMdH[0]) ; // 100 for better convergence, forcing a bit of slope in NR iterations dBdH[3] = MU0 * (1.0 + dMdH[3]) ; dBdH[5] = MU0 * (1.0 + dMdH[5]) ; dBdH[1] = MU0 * dMdH[1] ; dBdH[2] = MU0 * dMdH[2] ; dBdH[4] = MU0 * dMdH[4] ; } void Vector_dHdB(double H[3], double B[3], double dH[3], struct FunctionActive *D, double dHdB[6]) { double dBdH[6] ; // Inverting the matrix representation of the db/dh we get dh/db Vector_dBdH (H, B, dH, D, dBdH) ; double det = dBdH[0] * (dBdH[3] *dBdH[5] - dBdH[4] *dBdH[4]) - dBdH[1] * (dBdH[1] *dBdH[5] - dBdH[4] *dBdH[2]) + dBdH[2] * (dBdH[1] *dBdH[4] - dBdH[3] *dBdH[2]); if (!det) Message::Error("Null determinant of db/dh!"); dHdB[0] = (dBdH[3]*dBdH[5]-dBdH[4]*dBdH[4])/det ; dHdB[1] = -(dBdH[1]*dBdH[5]-dBdH[2]*dBdH[4])/det ; dHdB[2] = (dBdH[1]*dBdH[4]-dBdH[2]*dBdH[3])/det ; dHdB[3] = (dBdH[0]*dBdH[5]-dBdH[2]*dBdH[2])/det ; dHdB[4] = -(dBdH[0]*dBdH[4]-dBdH[1]*dBdH[2])/det ; dHdB[5] = (dBdH[0]*dBdH[3]-dBdH[1]*dBdH[1])/det ; } void F_dhdb_Jiles(F_ARG) { // #define F_ARG struct Function * Fct, struct Value * A, struct Value * V // input : h, b ,dh // dhdb_Jiles[{h}, {d a}, {h}-{h}[1] ]{List[hyst_FeSi]} // Material parameters: e.g. hyst_FeSi = { Msat, a, k, c, alpha};==> struct FunctionActive *D double H[3], B[3], dH[3], dHdB[6] ; struct FunctionActive * D ; if( (A+0)->Type != VECTOR || (A+1)->Type != VECTOR || (A+2)->Type != VECTOR ) Message::Error("Three vector arguments required"); if (!Fct->Active) Fi_InitListX (Fct, A, V) ; D = Fct->Active ; for (int k=0 ; k<3 ; k++){ H[k] = (A+0)->Val[k] ; B[k] = (A+1)->Val[k] ; dH[k] = (A+2)->Val[k] ; } Vector_dHdB (H, B, dH, D, dHdB) ; V->Type = TENSOR_SYM ;// xx, xy, xz, yy, yz, zz for (int k=0 ; k<6 ; k++) V->Val[k] = dHdB[k] ; } void F_dbdh_Jiles(F_ARG) { // #define F_ARG struct Function * Fct, struct Value * A, struct Value * V // input : h, b, dh // dbdh_Jiles[{h}, {b}, {h}-{h}[1] ]{List[hyst_FeSi]} // Material parameters: e.g. hyst_FeSi = { Msat, a, k, c, alpha};==> struct FunctionActive *D double H[3], B[3], dH[3], dBdH[6] ; struct FunctionActive *D; if( (A+0)->Type != VECTOR || (A+1)->Type != VECTOR || (A+2)->Type != VECTOR ) Message::Error("dbdh_Jiles requires three vector: {h} at t_i, {b} at t_i and ({h}-{h}[1]), i.e {h} at t_i - {h} at t_{i-1}"); if (!Fct->Active) Fi_InitListX (Fct, A, V) ; D = Fct->Active ; for (int k=0 ; k<3 ; k++){ H[k] = (A+0)->Val[k] ; B[k] = (A+1)->Val[k] ; dH[k] = (A+2)->Val[k] ; } Vector_dBdH (H, B, dH, D, dBdH) ; V->Type = TENSOR_SYM ; for (int k=0 ; k<6 ; k++) V->Val[k] = dBdH[k] ; } void F_h_Jiles(F_ARG) { // #define F_ARG struct Function * Fct, struct Value * A, struct Value * V // input : h1, b1, b2 // h_Jiles[ {h}[1], {b}[1], {b} ]{List[hyst_FeSi]} // Material parameters: e.g. hyst_FeSi = { Msat, a, k, c, alpha}; double Hone[3], Bone[3], Btwo[3], Htwo[3] ; struct FunctionActive *D; void Vector_H2 (double Hone[3], double Bone[3], double Btwo[3], int n, struct FunctionActive *D, double Htwo[3]) ; if( (A+0)->Type != VECTOR || (A+1)->Type != VECTOR || (A+2)->Type != VECTOR ) Message::Error("h_Jiles requires three vector arguments: {h} at t_{i-1}, {b} at t_{i-1} and {b} at t_i"); if (!Fct->Active) Fi_InitListX (Fct, A, V) ; D = Fct->Active ; for (int k=0 ; k<3 ; k++) { Hone[k] = (A+0)->Val[k] ; Bone[k] = (A+1)->Val[k] ; Btwo[k] = (A+2)->Val[k] ; } Vector_H2 (Hone, Bone, Btwo, 10, D, Htwo) ; V->Type = VECTOR ; for (int k=0 ; k<3 ; k++) V->Val[k] = Htwo[k] ; } void F_b_Jiles(F_ARG) { // #define F_ARG struct Function * Fct, struct Value * A, struct Value * V // input : b1, h1, h2 // b_Jiles[ {b}[1], {h}[1], {h} ]{List[hyst_FeSi]} // Material parameters: e.g. hyst_FeSi = { Msat, a, k, c, alpha}; double Bone[3], Hone[3], Btwo[3], Htwo[3] ; struct FunctionActive * D ; void Vector_B2 (double Bone[3], double Hone[3], double Htwo[3], int n, struct FunctionActive *D, double Btwo[3]) ; if( (A+0)->Type != VECTOR || (A+1)->Type != VECTOR || (A+2)->Type != VECTOR ) Message::Error("b_Jiles requires three vector arguments: {b} at t_{i-1}, " "{h} at t_{i-1} and {h} at t_i"); if (!Fct->Active) Fi_InitListX (Fct, A, V) ; D = Fct->Active ; for (int k = 0; k < 3 ; k++){ Bone[k] = (A+0)->Val[k] ; Hone[k] = (A+1)->Val[k] ; Htwo[k] = (A+2)->Val[k] ; } Vector_B2 (Bone, Hone, Htwo, 10, D, Btwo) ; V->Type = VECTOR ; for (int k = 0; k < 3 ; k++) V->Val[k] = Btwo[k] ; } void Vector_H2 (double Hone[3], double Bone[3], double Btwo[3], int n, struct FunctionActive *D, double Htwo[3]) { double H[3], dH[3], B[3], dB[3] ; double dHdB[6] ; for (int k=0 ; k<3 ; k++) { H[k] = Hone[k]; dB[k] = (Btwo[k] - Bone[k])/(double)n ; } for (int i=0 ; i (b,h) The final flux density b is imposed. In practice, the magnetic field is given by: /b h(b) = | (dh/db).db /b0 where the values of (dh/db) are functions of (b,h) and are interpolated from a provided table {bi, hi, M, NL, NC}, obtained e.g. experimentally. bi Flux density (T) for the tabulated values hi Magnetic field (A/m) for the tabulated values M Matrix with the slopes of reversal paths NL Number of lines NC Number of columns b0 Initial flux density (T) h0 Initial magnetic field (A/m) b Final flux density (T) */ /* ------------------------------------------------------------------------ */ double Fi_h_Ducharne (double *hi, double *bi, double *M, int NL, int NC, double h0, double b0, double b) { double db, dh, dHdB, s; int i, N = 200 ; // fixed number of steps for numerical integration db = (b - b0)/N ; s = (b - b0 < 0) ? -1. : 1. ; for (i=0 ; i < N ; ++i) { bool IsInGrid = Fi_InterpolationBilinear(hi, bi, M, NL, NC, s*h0, s*b0, &dHdB); if (!IsInGrid) dHdB = MU0 ; dh = dHdB * db; h0 += dh; b0 += db; } return h0 ; } void F_h_Ducharne(F_ARG) { int NL, NC, i; double b0, h0, b, h, *bi, *hi, *M; struct FunctionActive * D; if (!Fct->Active) Fi_InitListMatrix (Fct, A, V) ; D = Fct->Active ; NL = D->Case.ListMatrix.NbrLines ; NC = D->Case.ListMatrix.NbrColumns ; hi = D->Case.ListMatrix.x ; bi = D->Case.ListMatrix.y ; M = D->Case.ListMatrix.data ; for (i=0 ; i<3 ; ++i) { // (h0,b0) = state of the model, and b h0 = (A+0)->Val[i] ; b0 = (A+1)->Val[i] ; b = (A+2)->Val[i] ; // Compute the magnetic field h = Fi_h_Ducharne (hi, bi, M, NL, NC, h0, b0, b); V->Val[i] = h; } V->Type = VECTOR ; } void F_nu_Ducharne(F_ARG) { int NL, NC, i; double b0, h0, b[3], h[3], *bi, *hi, *M; struct FunctionActive * D; if (!Fct->Active) Fi_InitListMatrix (Fct, A, V) ; D = Fct->Active ; NL = D->Case.ListMatrix.NbrLines ; NC = D->Case.ListMatrix.NbrColumns ; hi = D->Case.ListMatrix.x ; bi = D->Case.ListMatrix.y ; M = D->Case.ListMatrix.data ; for (i=0 ; i<3 ; ++i) { // Get (h0,b0) = state of the model, and b h0 = (A+0)->Val[i] ; b0 = (A+1)->Val[i] ; b[i] = (A+2)->Val[i] ; // Compute h h[i] = Fi_h_Ducharne (hi, bi, M, NL, NC, h0, b0, b[i]); } V->Type = TENSOR_SYM ; V->Val[0] = (b[0] == 0) ? 1/(1e4*MU0) : h[0]/b[0] ; V->Val[1] = 0.0 ; V->Val[2] = 0 ; V->Val[3] = (b[1] == 0) ? 1/(1e4*MU0) : h[1]/b[1] ; V->Val[4] = 0 ; V->Val[5] = (b[2] == 0) ? 1/(1e4*MU0) : h[2]/b[2] ; } void F_dhdb_Ducharne(F_ARG) { int NL, NC, i; double b0, h0, b[3], *bi, *hi, *M, dHdB[3], s; struct FunctionActive * D; if (!Fct->Active) Fi_InitListMatrix (Fct, A, V) ; D = Fct->Active ; NL = D->Case.ListMatrix.NbrLines ; NC = D->Case.ListMatrix.NbrColumns ; hi = D->Case.ListMatrix.x ; bi = D->Case.ListMatrix.y ; M = D->Case.ListMatrix.data ; for (i=0 ; i<3 ; ++i) { // Get (h0,b0) = state of the model, and b h0 = (A+0)->Val[i] ; b0 = (A+1)->Val[i] ; b[i] = (A+2)->Val[i] ; s = (b[i] - b0 < 0) ? -1 : +1; bool IsInGrid = Fi_InterpolationBilinear (hi, bi, M, NL, NC, s*h0, s*b0, &(dHdB[i])); if (!IsInGrid) dHdB[i] = MU0 ; } V->Type = TENSOR_SYM ; V->Val[0] = dHdB[0] ; V->Val[1] = 0.0 ; V->Val[2] = 0 ; V->Val[3] = dHdB[1] ; V->Val[4] = 0 ; V->Val[5] = dHdB[2] ; } // Functions for Vectorial Incremental Nonconservative Consistent Hysteresis // Model double norm(double a[3]) { return sqrt(a[0]*a[0] + a[1]*a[1] + a[2]*a[2]); } double chi_mag_Vinch(double b_rev, double Js0, double alpha) { double h = 0.; double chi_mag ; if(!b_rev) chi_mag = Js0/alpha/MU0 ; // value at the limit else { // Newton iteration to find h double TOL=1e-7; double r, drdh, dh; int MAX_ITER=50, iter=0; do { iter++; r = MU0 * h + Js0 * tanh(h/alpha) - b_rev ; drdh = MU0 + Js0/alpha/SQU(cosh(h/alpha)) ; dh = -r/drdh ; h += dh ; } while( (fabs(dh) > TOL) && (iter < MAX_ITER) ); //Message::Info("%d %.2f %.2f NR iterations in chi_mag_Vinch", iter, b_rev, h); if(iter>=MAX_ITER) Message::Error("Newton did not converge: h = %lf \n", h); chi_mag = Js0/MU0* ((fabs(h)<1e-4) ? 1/alpha : tanh(h/alpha)/h ) ; } return chi_mag ; } void F_nu_Vinch(F_ARG) { // input : // (A+0)->Val[0] = norm of the reversible inductance // -- norm(b_rev) = norm(b_tot-sum(\Js_k)) // (A+1)->Val[0] = saturation magnetisation of the reversible case // -- Js_0 // (A+2)->Val[0] = characteristic magnetic field inversely proportional to the // slope of the curve at origin -- alpha // output : nu double vb_rev[3] = {(A+0)->Val[0], (A+0)->Val[1], (A+0)->Val[2]}; double b_rev = norm(vb_rev); //double b_rev = (A+0)->Val[1]; // I am taking just the Y-component, so I keep track of the sign.. double Js0 = (A+1)->Val[0]; double alpha = (A+2)->Val[0]; double chi_mag = chi_mag_Vinch(b_rev, Js0, alpha); //printf("chi_mag %.3f h %.3f nu_vinch %.3f \n", chi_mag, h, 1/MU0/(1+chi_mag) ); //V->Type = SCALAR; //V->Val[0] = 1/MU0/(1+chi_mag); // reluctivity V->Type = TENSOR_SYM ; // For extension to vectorial case ... Now it does not make any difference, of course. V->Val[0] = 1/MU0/(1+chi_mag) ; V->Val[1] = 0.0 ; V->Val[2] = 0.0 ; V->Val[3] = 1/MU0/(1+chi_mag) ; V->Val[4] = 0.0 ; V->Val[5] = 1/MU0/(1+chi_mag) ; } void F_mu_Vinch(F_ARG) { // input : // (A+0)->Val[0] = norm of the reversible inductance // -- norm(b_rev) = norm(b_tot-sum(\Js_k)) // (A+1)->Val[0] = saturation magnetisation of the reversible case // -- Js_0 // (A+2)->Val[0] = characteristic magnetic field inversely proportional to the // slope of the curve at origin -- alpha // output : nu double vb_rev[3] = {(A+0)->Val[0], (A+0)->Val[1], (A+0)->Val[2]}; double b_rev = norm(vb_rev); //double b_rev = (A+0)->Val[1]; // I am taking just the Y-component, so I keep track of the sign.. double Js0 = (A+1)->Val[0]; double alpha = (A+2)->Val[0]; double chi_mag = chi_mag_Vinch(b_rev, Js0, alpha); //printf("chi_mag %.3f h %.3f nu_vinch %.3f \n", chi_mag, h, 1/MU0/(1+chi_mag) ); //V->Type = SCALAR; //V->Val[0] = 1/MU0/(1+chi_mag); // reluctivity V->Type = TENSOR_SYM ; // For extension to vectorial case ... Now it does not make any difference, of course. V->Val[0] = MU0*(1+chi_mag) ; V->Val[1] = 0.0 ; V->Val[2] = 0 ; V->Val[3] = MU0*(1+chi_mag) ; V->Val[4] = 0 ; V->Val[5] = MU0*(1+chi_mag) ; } double F_Man_Vinch (double h, double Js0, double alpha) { // Anhysteretic magnetisation double chi_mag = Js0/MU0* ((fabs(h)<1e-4) ? 1/alpha : tanh(h/alpha)/h ) ; return chi_mag ; } double F_dMandH_Vinch (double h, double Js0, double alpha) { double dmdh = Js0/MU0 * ( (fabs(h)<1e-4) ? 0. : 1/alpha/SQU(cosh(h/alpha))/h - tanh(h/alpha)/h/h) ; return dmdh ; } void FV_Man_Vinch (double H[3], double Js0, double alpha, double Man[3]) { double nH = sqrt(H[0]*H[0]+H[1]*H[1]+H[2]*H[2]) ; if ( !nH ) { Man[0] = Man[1] = Man[2]= 0. ; } else { double auxMan = F_Man_Vinch(nH, Js0, alpha) ; Man[0] = auxMan * H[0]/nH ; Man[1] = auxMan * H[1]/nH ; Man[2] = auxMan * H[2]/nH ; } } void FV_dMandH_Vinch(double H[3], double Js0, double alpha, double dMandH[6]) { double nH2 = H[0]*H[0]+H[1]*H[1]+H[2]*H[2] ; double nH = sqrt(nH2) ; double Man = F_Man_Vinch(nH, Js0, alpha) ; double ndMandH = F_dMandH_Vinch(nH,Js0,alpha) ; if ( !nH ) { dMandH[0] = dMandH[3] = dMandH[5] = ndMandH ; dMandH[1] = dMandH[2] = dMandH[4] = 0 ; } else { dMandH[0] = Man/nH + (ndMandH - Man/nH)*H[0]*H[0]/nH2 ; dMandH[3] = Man/nH + (ndMandH - Man/nH)*H[1]*H[1]/nH2 ; dMandH[5] = Man/nH + (ndMandH - Man/nH)*H[2]*H[2]/nH2 ; dMandH[1] = (ndMandH - Man/nH)*H[0]*H[1]/nH2 ; dMandH[2] = (ndMandH - Man/nH)*H[0]*H[2]/nH2 ; dMandH[4] = (ndMandH - Man/nH)*H[1]*H[2]/nH2 ; } } void F_dbdh_Vinch(F_ARG) { // input : // (A+0)->Val = magnetic field // (A+1)->Val[0] = saturation magnetisation of the reversible case // -- Js_0 // (A+2)->Val[0] = characteristic magnetic field inversely proportional to the // slope of the curve at origin -- alpha // output : dnudb2 double H[3] = {(A+0)->Val[0], (A+0)->Val[1], (A+0)->Val[2]}; double Js0 = (A+1)->Val[0]; double alpha = (A+2)->Val[0]; double dMdH[6] ; // differential susceptibility db/dh = MU0 (1 + dm/dh) // m = chi = Js0*tanh(h/alpha)/(MU0*h); FV_dMandH_Vinch(H, Js0, alpha, dMdH) ; V->Type = TENSOR_SYM ; // Vectorial extension or not does not make any difference for the time being... V->Val[0] = MU0 * (1 + dMdH[0]) ; V->Val[1] = MU0 *dMdH[1] ; V->Val[2] = MU0 *dMdH[2] ; V->Val[3] = MU0 * (1 + dMdH[3]) ; V->Val[4] = MU0 *dMdH[3] ; V->Val[5] = MU0 * (1 + dMdH[5]) ; } void F_h_Vinch(F_ARG) { // input : // (A+0)->Val = Curl a // (A+1)->Val = \sum J_k // (A+2)->Val[0] = saturation magnetisation of the reversible case // -- Js_0 // (A+3)->Val[0] = characteristic magnetic field inversely proportional to the // slope of the curve at origin -- alpha double B[3] = {(A+0)->Val[0], (A+0)->Val[1], (A+0)->Val[2]}; double Jk[3] = {(A+1)->Val[0], (A+1)->Val[1], (A+1)->Val[2]}; double Js0 = (A+2)->Val[0]; double alpha = (A+3)->Val[0]; double Brev[3] = {B[0]-Jk[0], B[1]-Jk[1], B[2]-Jk[2]}; double nBrev = norm(Brev); double chi_mag = chi_mag_Vinch(nBrev, Js0, alpha); V->Type = VECTOR ; for (int k=0 ; k<3 ; k++) V->Val[k] = 1/MU0/(1+chi_mag) * (B[k]-Jk[k]) ; } void F_dhdb_Vinch(F_ARG) { // input : // (A+0)->Val = magnetic field // (A+1)->Val[0] = saturation magnetisation of the reversible case // -- Js_0 // (A+2)->Val[0] = characteristic magnetic field inversely proportional to the // slope of the curve at origin -- alpha // output : dnudb2 double H[3] = {(A+0)->Val[0], (A+0)->Val[1], (A+0)->Val[2]}; double Js0 = (A+1)->Val[0]; double alpha = (A+2)->Val[0]; double dMdH[6], dBdH[6], dHdB[6] ; // differential susceptibility db/dh = MU0 (1 + dm/dh) // m = chi = Js0*tanh(h/alpha)/(MU0*h); FV_dMandH_Vinch(H, Js0, alpha, dMdH) ; dBdH[0] = MU0 * (1 + dMdH[0]) ; dBdH[3] = MU0 * (1 + dMdH[3]) ; dBdH[5] = MU0 * (1 + dMdH[5]) ; dBdH[1] = MU0 * dMdH[1] ; dBdH[2] = MU0 * dMdH[2] ; dBdH[4] = MU0 * dMdH[4] ; double det = dBdH[0] * (dBdH[3] *dBdH[5] - dBdH[4] *dBdH[4]) - dBdH[1] * (dBdH[1] *dBdH[5] - dBdH[4] *dBdH[2]) + dBdH[2] * (dBdH[1] *dBdH[4] - dBdH[3] *dBdH[2]); if (!det) Message::Error("Null determinant of db/dh!"); dHdB[0] = (dBdH[3]*dBdH[5]-dBdH[4]*dBdH[4])/det ; dHdB[1] = -(dBdH[1]*dBdH[5]-dBdH[2]*dBdH[4])/det ; dHdB[2] = (dBdH[1]*dBdH[4]-dBdH[2]*dBdH[3])/det ; dHdB[3] = (dBdH[0]*dBdH[5]-dBdH[2]*dBdH[2])/det ; dHdB[4] = -(dBdH[0]*dBdH[4]-dBdH[1]*dBdH[2])/det ; dHdB[5] = (dBdH[0]*dBdH[3]-dBdH[1]*dBdH[1])/det ; V->Type = TENSOR_SYM ; for (int i=0 ; i<6 ; i++) V->Val[i] = dHdB[i] ; } bool limiter(const double Js, double v[3]) { double max = 0.999*Js ; //0.9999 // SENSITIVE_PARAM (0.999) double mod = norm(v); if(mod >= max){ for (int n=0; n<3; n++) v[n] *= max/mod; return true; //Message::Warning("Js=%g, norm(J)=%g", Js, mod); } return false; return false; } // pour info // #define F_ARG struct Function * Fct, struct Value * A, struct Value * V // http://www.gnu.org/software/gsl/manual/html_node/Multimin-Examples.html #if !defined(HAVE_GSL) void F_Update_Jk(F_ARG) { Message::Error("F_Update_Jk requires the GSL"); } #else #include #include #include struct omega_f_context { double h[3], Jp[3]; double chi, Js, alpha; } ; double omega_f(const gsl_vector *v, void *params) { double J[3], dJ[3] ; struct omega_f_context * p = (struct omega_f_context *)params; double h[3] = { p->h[0] , p->h[1] , p->h[2] }; double Jp[3] = { p->Jp[0], p->Jp[1], p->Jp[2] }; double chi = p->chi; double Js = p->Js; double alpha = p->alpha; for (int i=0; i<3; i++) J[i] = gsl_vector_get(v, i); limiter(Js, J) ; double nJ = norm(J); for (int i=0; i<3; i++) dJ[i] = J[i]-Jp[i]; // J-Jp double val = Js*alpha*( nJ/Js*atanh(nJ/Js) + 0.5*log(1-SQU(nJ/Js)) ) // u(J) - (J[0]*h[0] + J[1]*h[1] + J[2]*h[2]) // -J.h + chi * norm(dJ); // chi | J-Jp | return(val); } void omega_df (const gsl_vector *v, void *params, gsl_vector *df) { double J[3], dJ[3] ; struct omega_f_context * p = (struct omega_f_context *)params; double h[3] = {p->h[0] , p->h[1] , p->h[2] }; double Jp[3] = {p->Jp[0], p->Jp[1], p->Jp[2]}; double chi = p->chi; double Js = p->Js; double alpha = p->alpha; double grad[3] = {0.,0.,0.}; for (int i=0; i<3; i++) J[i] = gsl_vector_get(v, i); limiter(Js, J); double nJ = norm(J); for (int i=0; i<3; i++) dJ[i] = J[i]-Jp[i]; // J-Jp double ndJ = norm(dJ); for (int i=0; i<3; i++) { if (nJ) grad[i] += alpha*atanh(nJ/Js)*J[i]/nJ; grad[i] -= h[i]; if (ndJ) grad[i] += chi*dJ[i]/ndJ; gsl_vector_set(df, i, grad[i]); } } void omega_fdf (const gsl_vector *x, void *params, double *f, gsl_vector *df) { *f = omega_f(x, params); omega_df(x, params, df); } void F_Update_Jk(F_ARG) { const int MAX_ITER = 100; int iter = 0, status; double step_size = 0.01; double TOL = 1e-4; double omegap; struct omega_f_context context ; context.h[0] = (A+0)->Val[0]; context.h[1] = (A+0)->Val[1]; context.h[2] = (A+0)->Val[2]; double J[3] = { (A+1)->Val[0], (A+1)->Val[1], (A+1)->Val[2] }; context.Jp[0] = (A+2)->Val[0]; context.Jp[1] = (A+2)->Val[1]; context.Jp[2] = (A+2)->Val[2]; context.chi = (A+3)->Val[0]; context.Js = (A+4)->Val[0]; context.alpha = (A+5)->Val[0]; //http://www.gnu.org/software/gsl/manual/html_node/Multimin-Algorithms-with-Derivatives.html const gsl_multimin_fdfminimizer_type *TYPE = gsl_multimin_fdfminimizer_conjugate_fr; //const gsl_multimin_fdfminimizer_type *TYPE = gsl_multimin_fdfminimizer_conjugate_pr; //const gsl_multimin_fdfminimizer_type *TYPE = gsl_multimin_fdfminimizer_vector_bfgs2; //const gsl_multimin_fdfminimizer_type *TYPE = gsl_multimin_fdfminimizer_vector_bfgs; //const gsl_multimin_fdfminimizer_type *TYPE = gsl_multimin_fdfminimizer_steepest_descent; gsl_multimin_function_fdf my_func; my_func.n = 3; my_func.f = omega_f ; my_func.df = omega_df ; my_func.fdf = omega_fdf; my_func.params = &context; gsl_vector* x = gsl_vector_alloc (3); for (int i=0; i<3; i++) gsl_vector_set(x, i, J[i]) ; // initial value for the minimizer gsl_multimin_fdfminimizer *solver = gsl_multimin_fdfminimizer_alloc(TYPE, 3); gsl_multimin_fdfminimizer_set (solver, &my_func, x, step_size, TOL); do { iter++; omegap = solver->f; status = gsl_multimin_fdfminimizer_iterate (solver); if (status) break; // check if solver is stuck } while( fabs(solver->f-omegap)>1e-2 && iter < MAX_ITER); V->Type = VECTOR ; for (int i=0 ; i<3 ; i++) V->Val[i] = gsl_vector_get (solver->x, i) ; /* for (int i=0 ; i<3 ; i++) J[i] = gsl_vector_get (solver->x, i) ; limiter(0.9999*context.Js, J) ; for (int i=0 ; i<3 ; i++) V->Val[i] = J[i]; */ gsl_multimin_fdfminimizer_free (solver); gsl_vector_free (x); } #endif //=================================================== // V. Francois original implementation with steepest descent //=================================================== double fct_omega(double h[3], double Jk[3], double Jkp[3], double chi, double Js, double alpha) { double diff[3]; double nJk = norm(Jk); // magnetisation Jk assumed to be < the saturation magnetisation Js for (int n=0; n<3; n++) diff[n] = Jk[n]-Jkp[n]; // J-Jp double g2 = alpha*Js *( nJk/Js*atanh(nJk/Js) + 0.5*log(fabs(SQU(nJk/Js)-1)) ); // magnetic energy u(J) double g3 = Jk[0] * h[0] + Jk[1] * h[1] + Jk[2] * h[2]; // -J.h double Dissip = chi * norm(diff) ; // chi | J-Jp | return(g2-g3+Dissip); } void fct_d_omega (double h[3], double Jk[3], double Jkp[3], double chi, double Js, double alpha, double *d_omega) { d_omega[0] = d_omega[1] = d_omega[2] = 0.; double dJk[3]; for (int n=0; n<3; n++) dJk[n] = Jk[n]-Jkp[n]; double nJk = norm(Jk); double ndJk = norm(dJk); for (int n = 0; n < 3; n++) { if(nJk) d_omega[n] += alpha * atanh(nJk/Js) * Jk[n]/nJk; d_omega[n] -= h[n]; if(ndJk) d_omega[n] += chi * dJk[n]/ndJk ; } } //=================================================== // K. Jacques modified function //=================================================== void F_Update_Jk_sd(F_ARG) { // Updating Jk with a steepest descent algorithm // --------------------------------------------- // input: // (A+0)->Val = magnetic field -- h // (A+1)->Val = material magnetization -- Jk // (A+2)->Val = material magnetization at previous time step -- Jkp // (A+3)->Val = limit force related to the dissipation -- chi // (A+4)->Val = saturation magnetization -- Js // (A+5)->Val = characteristic magnetic field inversely proportional to the slope at origin -- alpha // --------------------------------------------- // output: updated Jk double h[3], Jk[3], Jkp[3] ; if( (A+0)->Type != VECTOR || (A+1)->Type != VECTOR || (A+2)->Type != VECTOR || (A+3)->Type != SCALAR || (A+4)->Type != SCALAR || (A+5)->Type != SCALAR ) Message::Error("Function 'Update_Jk_sd' requires three vector arguments (h, Jk, Jkp) and three scalar arguments (chi, Js, alpha)"); for (int n=0; n<3; n++) { h[n] = (A+0)->Val[n]; Jk[n] = (A+1)->Val[n]; Jkp[n] = (A+2)->Val[n]; } double chi =(A+3)->Val[0]; double Js =(A+4)->Val[0]; double alpha=(A+5)->Val[0]; Vector_Update_Jk_sd_K(h, Jk, Jkp, chi, Js, alpha); V->Type = VECTOR ; for (int n=0 ; n<3 ; n++) V->Val[n] = Jk[n]; } //=================================================== // K. Jacques additional functions //=================================================== void Vector_Update_Jk_sd_K(double h[3], double Jk[3], double Jkp[3], double chi, double Js, double alpha) { // Updating Jk with a steepest descent algorithm double min_Jk[3] ; double d_omega[3] ; double sdfactor = 0.1; //suitable value of tol for most applications double TOL = 1e-11; //11 SENSITIVE_PARAM (1e-11) limiter(Js, Jk ); // avoiding possible NaN with atanh //limiter(Js, Jkp); // Ruth: Why doing it for previous step? fct_d_omega(h, Jk, Jkp, chi, Js, alpha, d_omega) ; // updating the derivative of omega double omega = fct_omega(h, Jk, Jkp, chi, Js, alpha) ; // updating omega double min_omega = 1e+22 ; int iter = 0 ; const int MAX_ITER = 700; // SENSITIVE_PARAM (700) while( iter < MAX_ITER && (fabs(d_omega[0])/(1+fabs(omega))*sdfactor > TOL || fabs(d_omega[1])/(1+fabs(omega))*sdfactor > TOL || fabs(d_omega[2])/(1+fabs(omega))*sdfactor > TOL )) { for (int n = 0; n < 3; n++) min_Jk[n] = Jk[n] - sdfactor * d_omega[n] ; // gradient descent algorithm limiter(Js, min_Jk); min_omega = fct_omega(h, min_Jk, Jkp, chi, Js, alpha); //updating omega if (iter>MAX_ITER) Message::Warning("iter %d : Too many iterations to find the minimum of omega: min_omega %g, omega-TOL/10 %g", iter, min_omega, omega-TOL/10); if( min_omega < omega-TOL/10 && norm(min_Jk) < Js ){ fct_d_omega(h, min_Jk, Jkp, chi, Js, alpha, d_omega); //update the derivative d_omega omega = min_omega; //if(Jk[0]==Jkp[0] && Jk[1]==Jkp[1] && Jk[2]==Jkp[2]) if(fabs(Jk[0]-Jkp[0])<1e-16 && fabs(Jk[1]-Jkp[1])<1e-16 && fabs(Jk[2]-Jkp[2])<1e-16 ) sdfactor=0.1; // re-initialize rfactor which may have become very small due to an angulous starting point for (int n=0; n<3; n++) Jk[n] = min_Jk[n]; } else sdfactor = sdfactor/2 ; iter++ ; } for (int n=0 ; n<3 ; n++) Jk[n] = min_Jk[n]; } void Vector_b_Vinch_K(int N, double h[3], double alpha, double *Jk_all, double *Jkp_all, double *chi_all, double *Js_all, double b[3]) { double Jk[3], Jkp[3] ; double chi, Js; for (int n=0; n<3; n++) b[n] = MU0 * h[n]; for (int k=0; kEPSILON) ? (fabs(h[0])) * delta0 : delta0, (fabs(h[1])>EPSILON) ? (fabs(h[1])) * delta0 : delta0, (fabs(h[2])>EPSILON) ? (fabs(h[2])) * delta0 : delta0 } ; /* double delta[3] = {((norm(h)>EPSILON) ? (norm(h)+1) * delta0 : delta0), ((norm(h)>EPSILON) ? (norm(h)+1) * delta0 : delta0), ((norm(h)>EPSILON) ? (norm(h)+1) * delta0 : delta0) } ; */ /* double delta[3] = {((norm(h)>EPSILON) ? norm(h) * delta0 : delta0), ((norm(h)>EPSILON) ? norm(h) * delta0 : delta0), ((norm(h)>EPSILON) ? norm(h) * delta0 : delta0) } ; */ //double delta[3]={delta0,delta0,delta0}; double hxr[3]={h[0]+delta[0], h[1] ,h[2]}; double hxl[3]={h[0]-delta[0], h[1], h[2]}; double hyr[3]={h[0], h[1]+delta[1] ,h[2]}; double hyl[3]={h[0], h[1]-delta[1], h[2]}; double hzr[3]={h[0], h[1] ,h[2]+delta[2]}; double hzl[3]={h[0], h[1], h[2]-delta[2]}; double Jkxr[3], Jkxl[3]; double Jkyr[3], Jkyl[3]; double Jkzr[3], Jkzl[3]; Vector_Update_Jk_sd_K(hxr, Jkxr, Jkp, chi, Js, alpha); Vector_Update_Jk_sd_K(hxl, Jkxl, Jkp, chi, Js, alpha); Vector_Update_Jk_sd_K(hyr, Jkyr, Jkp, chi, Js, alpha); Vector_Update_Jk_sd_K(hyl, Jkyl, Jkp, chi, Js, alpha); // Symmetric tensor dJkdh[0]= (Jkxr[0]-Jkxl[0])/(2*delta[0]); //xx dJkdh[3]= (Jkyr[1]-Jkyl[1])/(2*delta[1]); //yy dJkdh[1]= (Jkxr[1]-Jkxl[1])/(2*delta[0]); //yx switch(dim) { case 2: // 2D case dJkdh[5] = 1.; dJkdh[2] = dJkdh[4]= 0.; break; case 3: //3D case Vector_Update_Jk_sd_K(hzr, Jkzr, Jkp, chi, Js, alpha); Vector_Update_Jk_sd_K(hzl, Jkzl, Jkp, chi, Js, alpha); dJkdh[5]= (Jkzr[2]-Jkzl[2])/(2*delta[2]); //zz dJkdh[2]= (Jkxr[2]-Jkxl[2])/(2*delta[0]); //zx dJkdh[4]= (Jkyr[2]-Jkyl[2])/(2*delta[1]); //zy break; default: Message::Error("Invalid parameter (dimension = 2 or 3) for function 'dhdb_Vinch_'. Numeric Jacobian computation."); break; } } } void Inv_Tensor3x3_K(double T[9], double invT[9]) { double det= T[0]*T[4]*T[8]+T[1]*T[5]*T[6]+T[2]*T[3]*T[7] -T[2]*T[4]*T[6]-T[0]*T[5]*T[7]-T[1]*T[3]*T[8]; if (!det) Message::Error("Null determinant of db/dh! : dbdh=[%g,%g,%g;%g,%g,%g;%g,%g,%g]", T[0],T[1],T[2],T[3],T[4],T[5],T[6],T[7],T[8]); invT[0]=(T[4]*T[8]-T[5]*T[7])/det; invT[1]=(T[2]*T[7]-T[1]*T[8])/det; invT[2]=(T[1]*T[5]-T[2]*T[4])/det; invT[3]=(T[5]*T[6]-T[3]*T[8])/det; invT[4]=(T[0]*T[8]-T[2]*T[6])/det; invT[5]=(T[2]*T[3]-T[0]*T[5])/det; invT[6]=(T[3]*T[7]-T[4]*T[6])/det; invT[7]=(T[1]*T[6]-T[0]*T[7])/det; invT[8]=(T[0]*T[4]-T[1]*T[3])/det; } void Inv_TensorSym3x3_K(int dim, double T[6], double invT[6]) { double det ; switch(dim) { case 2: det = T[0] * T[3] - T[1] * T[1]; if (!det) Message::Error("Null determinant of invT! Case %d", dim); invT[0] = T[3]/det ; invT[1] = -T[1]/det ; invT[3] = T[0]/det ; invT[2] = invT[4] = 0. ; invT[5] = 1.; break; case 3: det = T[0] * (T[3] * T[5] - T[4] * T[4]) - T[1] * (T[1] * T[5] - T[4] * T[2]) + T[2] * (T[1] * T[4] - T[3] * T[2]); if (!det) Message::Error("Null determinant of invT! Case %d", dim); invT[0] = (T[3]*T[5]-T[4]*T[4])/det ; invT[1] = -(T[1]*T[5]-T[2]*T[4])/det ; invT[2] = (T[1]*T[4]-T[2]*T[3])/det ; invT[3] = (T[0]*T[5]-T[2]*T[2])/det ; invT[4] = -(T[0]*T[4]-T[1]*T[2])/det ; invT[5] = (T[0]*T[3]-T[1]*T[1])/det ; break; default: Message::Error("Invalid parameter for function 'dhdb_Vinch_'"); break; } } void Vector_h_Vinch_K(int dim, int N, double b[3], double bc[3], double alpha, double *Jk_all, double *Jkp_all, double *chi_all, double *Js_all, double h[3] ) { double tempbc[3], tempJk_all[3*N], bprev[3]; double dh[3] ; double dbdh[6]; double dhdb[6]; double TOL = 1e-7; //-8,-5 // SENSITIVE_PARAM (1e-7) double sumchi = 0. ; for (int n=0; n<3; n++) tempbc[n] = bc[n]; for (int k=0; k TOL || (fabs(tempbc[1]-b[1])/(1+fabs(b[1]))) > TOL || (fabs(tempbc[2]-b[2])/(1+fabs(b[2]))) > TOL )){ Tensor_dbdh_Vinch_K(dim, N, h, alpha, tempJk_all, Jkp_all, chi_all, Js_all, dbdh); // eval dbdh Inv_TensorSym3x3_K(dim, dbdh, dhdb); // eval (dbdh)^-1=dhdb dh[0] = dhdb[0]*(b[0]-tempbc[0]) + dhdb[1]*(b[1]-tempbc[1]) + dhdb[2]*(b[2]-tempbc[2]); dh[1] = dhdb[1]*(b[0]-tempbc[0]) + dhdb[3]*(b[1]-tempbc[1]) + dhdb[4]*(b[2]-tempbc[2]); dh[2] = dhdb[2]*(b[0]-tempbc[0]) + dhdb[4]*(b[1]-tempbc[1]) + dhdb[5]*(b[2]-tempbc[2]); /* //-------------------------------------------------------- // Méthodes de relaxation envisagées : if (norm(dh)>1e3*sumchi) { for (int n=0 ; n<3 ; n++) dh[n]=(1.0/(iter+1))*dh[n]; // Relaxation //Message::Warning("!!!!!!!!!!!!!!relax : before : dhx= %g, after : dhx=%g, bx=%g", (iter+1)*dh[0], dh[0], b[0]); } if iter<8 { for (int n=0 ; n<3 ; n++) dh[n]=0.25*dh[n]; // Relaxation } //------------------------------------------------------- */ for (int n=0 ; n<3 ; n++){ h[n] += dh[n]; bprev[n] = tempbc[n]; } Vector_b_Vinch_K(N, h, alpha, tempJk_all, Jkp_all, chi_all, Js_all, tempbc); // Update bc, Jk_all // Affichage de l'évolution de b et h à chaque itération : /* // if (iter>=MAX_ITER-1){ Message::Warning("At iter %d : b_desired = [%g, %g, %g]", iter, b[0],b[1],b[2]); Message::Warning("At iter %d : b_get = [%g, %g, %g]", iter, tempbc[0],tempbc[1],tempbc[2]); Message::Warning("At iter %d : h_get = [%g, %g, %g]", iter, h[0],h[1],h[2]); } */ iter++; } // Affichage de b et h obtenu à la fin de la boucle de NR : /* Message::Warning("-------NR-loop in h_Vinch_K stopped after %d iteration(s) :-------",iter); Message::Warning("b_desired : [%g, %g, %g]", b[0],b[1],b[2]); Message::Warning("b_get : [%g, %g, %g]",tempbc[0],tempbc[1],tempbc[2]); Message::Warning("h_get : [%g, %g, %g]", h[0],h[1],h[2]); */ // Message d'erreur pour solution invalide (NaN ou Inf) : /* for (int i=0 ; i<3 ; i++){ if ( //iter==MAX_ITER || h[i] != h[i] || // Solution h is NaN h[i] == -std::numeric_limits::infinity() || // Solution h is -Inf h[i] == std::numeric_limits::infinity() || // Solution h is Inf tempbc[i] != tempbc[i] || // Solution b is NaN tempbc[i] == -std::numeric_limits::infinity() || // Solution b is -Inf tempbc[i] == std::numeric_limits::infinity() ) // Solution b is Inf { Message::Warning("^^^^^^^^^^^^^^iter %d : dbdh : [%g, %g, %g; %g, %g, %g; %g, %g, %g]", iter, dbdh[0], dbdh[1],dbdh[2],dbdh[3], dbdh[4],dbdh[5],dbdh[6], dbdh[7],dbdh[8]); Message::Warning("^^^^^^^^^^^^^^iter %d : dhdb : [%g, %g, %g; %g, %g, %g; %g, %g, %g]", iter, dhdb[0], dhdb[1], dhdb[2],dhdb[3], dhdb[4], dhdb[5],dhdb[6], dhdb[7], dhdb[8]); Message::Warning("--------------iter %d : J1_p : [%g, %g, %g]", iter, Jkp_all[0],Jkp_all[1],Jkp_all[2]); Message::Warning("--------------iter %d : J2_p : [%g, %g, %g]", iter, Jkp_all[3],Jkp_all[4],Jkp_all[5]); Message::Warning("--------------iter %d : J3_p : [%g, %g, %g]", iter, Jkp_all[6],Jkp_all[7],Jkp_all[8]); Message::Warning(">>>>>>>>>>>>>>iter %d : J1 : [%g, %g, %g]", iter, tempJk_all[0],tempJk_all[1],tempJk_all[2]); Message::Warning(">>>>>>>>>>>>>>iter %d : J2 : [%g, %g, %g]", iter, tempJk_all[3],tempJk_all[4],tempJk_all[5]); Message::Warning(">>>>>>>>>>>>>>iter %d : J3 : [%g, %g, %g]", iter, tempJk_all[6],tempJk_all[7],tempJk_all[8]); Message::Warning("''''''''''''''iter %d : b : [%g, %g, %g]", iter, b[0],b[1],b[2]); Message::Warning("''''''''''''''iter %d : b_get: [%g, %g, %g]", iter, tempbc[0],tempbc[1],tempbc[2]); Message::Warning("''''''''''''''iter %d : h_get: [%g, %g, %g]", iter, h[0],h[1],h[2]); Message::Warning("!!!!!!!!!!!!!!iter %d : dh : [%g, %g, %g]", iter, dh[0],dh[1],dh[2]); Message::Error("No valid solution found (NaN or Inf)! at Iteration %d of NR-loop in h_Vinch_K",iter); } } */ } void F_h_Vinch_K(F_ARG) { // #define F_ARG struct Function * Fct, struct Value * A, struct Value * V // input : // (A+0) ->Val = number of cells -- N // (A+1) ->Val = magnetic field at previous time step -- hp // (A+2) ->Val = magnetic induction -- b // (A+3) ->Val = magnetic induction at previous time step -- bp // (A+4) ->Val = characteristic magnetic field inversely proportional to the slope at origin -- alpha // (A+5+4*k)->Val = material magnetization -- Jk // (A+6+4*k)->Val = material magnetization at previous time step -- Jkp // (A+7+4*k)->Val = limit force related to the dissipation -- chi // (A+8+4*k)->Val = saturation magnetization -- Js // --------------------------------------------- // output: magnetic field -- h int dim = Fct->Para[0]; int N = (A+0)->Val[0]; double h[3], b[3], bc[3], Jk_all[3*N], Jkp_all[3*N], chi_all[N], Js_all[N] ; for (int n=0; n<3; n++) { h[n] = (A+1)->Val[n]; b[n] = (A+2)->Val[n]; bc[n] = (A+3)->Val[n]; } double alpha = (A+4)->Val[0]; for (int k=0; kVal[0]; Js_all[k] =(A+8+4*k)->Val[0]; for (int n=0; n<3; n++) { Jk_all[n+3*k] = (A+5+4*k)->Val[n]; Jkp_all[n+3*k] = (A+6+4*k)->Val[n]; } } Vector_h_Vinch_K(dim, N, b, bc, alpha, Jk_all, Jkp_all, chi_all, Js_all, h); V->Type = VECTOR ; for (int n=0 ; n<3 ; n++) V->Val[n] = h[n]; } void F_b_Vinch_K(F_ARG) { // #define F_ARG struct Function * Fct, struct Value * A, struct Value * V // input : // (A+0) ->Val = number of cells -- N // (A+1) ->Val = magnetic field -- h // (A+2) ->Val = characteristic magnetic field inversely proportional to the slope at origin -- alpha // (A+3+4*k)->Val = material magnetization -- Jk // (A+4+4*k)->Val = material magnetization at previous time step -- Jkp // (A+5+4*k)->Val = limit force related to the dissipation -- chi // (A+6+4*k)->Val = saturation magnetization -- Js // --------------------------------------------- // output: magnetic induction -- b int N = (A+0)->Val[0]; double h[3], b[3], Jk_all[3*N], Jkp_all[3*N], chi_all[N], Js_all[N] ; double alpha = (A+2)->Val[0]; for (int n=0; n<3; n++) h[n] = (A+1)->Val[n]; for (int k=0; kVal[0]; Js_all[k] =(A+6+4*k)->Val[0]; for (int n=0; n<3; n++) { Jk_all[n+3*k] = (A+3+4*k)->Val[n]; Jkp_all[n+3*k] = (A+4+4*k)->Val[n]; } } Vector_b_Vinch_K(N, h, alpha, Jk_all, Jkp_all, chi_all, Js_all, b); V->Type = VECTOR ; for (int n=0 ; n<3 ; n++) V->Val[n] = b[n]; } void F_dbdh_Vinch_K(F_ARG) { // #define F_ARG struct Function * Fct, struct Value * A, struct Value * V // input : // Fct->Para[0] = 2=> 2D problem; 3=>3D problem // (A+0) ->Val = number of cells -- N // (A+1) ->Val = magnetic field -- h // (A+2) ->Val = characteristic magnetic field inversely proportional to the slope at origin -- alpha // (A+3+4*k)->Val = material magnetization -- Jk // (A+4+4*k)->Val = material magnetization at previous time step -- Jkp // (A+5+4*k)->Val = limit force related to the dissipation -- chi // (A+6+4*k)->Val = saturation magnetization -- Js // --------------------------------------------- // output: differential reluctivity -- dbdh int dim = Fct->Para[0]; int N = (A+0)->Val[0]; double alpha = (A+2)->Val[0]; double h[3], Jk_all[3*N], Jkp_all[3*N], chi_all[N], Js_all[N] ; double dbdh[6]; for (int n=0; n<3; n++) h[n] = (A+1)->Val[n]; for (int k=0; kVal[0]; Js_all[k] =(A+6+4*k)->Val[0]; for (int n=0; n<3; n++) { Jk_all[n+3*k] = (A+3+4*k)->Val[n]; Jkp_all[n+3*k] = (A+4+4*k)->Val[n]; } } Tensor_dbdh_Vinch_K(dim, N, h, alpha, Jk_all, Jkp_all, chi_all, Js_all, dbdh); V->Type = TENSOR_SYM ; for (int k=0 ; k<6 ; k++) V->Val[k] = dbdh[k] ; } void F_dhdb_Vinch_K(F_ARG) { // #define F_ARG struct Function * Fct, struct Value * A, struct Value * V // input : // Fct->Para[0] = 2=> 2D problem; 3=>3D problem // (A+0) ->Val = number of cells -- N // (A+1) ->Val = magnetic field -- h // (A+2) ->Val = characteristic magnetic field inversely proportional to the slope at origin -- alpha // (A+3+4*k)->Val = material magnetization -- Jk // (A+4+4*k)->Val = material magnetization at previous time step -- Jkp // (A+5+4*k)->Val = limit force related to the dissipation -- chi // (A+6+4*k)->Val = saturation magnetization -- Js // --------------------------------------------- // output: differential reluctivity -- dhdb int dim = Fct->Para[0]; int N = (A+0)->Val[0]; double alpha = (A+2)->Val[0]; double h[3], Jk_all[3*N], Jkp_all[3*N], chi_all[N], Js_all[N] ; double dbdh[6], dhdb[6]; for (int n=0; n<3; n++) h[n] = (A+1)->Val[n]; for (int k=0; kVal[0]; Js_all[k] =(A+6+4*k)->Val[0]; for (int n=0; n<3; n++) { Jk_all[n+3*k] = (A+3+4*k)->Val[n]; Jkp_all[n+3*k] = (A+4+4*k)->Val[n]; } } Tensor_dbdh_Vinch_K(dim, N, h, alpha, Jk_all, Jkp_all, chi_all, Js_all, dbdh); Inv_TensorSym3x3_K(dim, dbdh, dhdb); // dimension, T, invT V->Type = TENSOR_SYM ; for (int k=0 ; k<6 ; k++) V->Val[k] = dhdb[k] ; } void F_nu_Vinch_K(F_ARG) // NOT USED { // #define F_ARG struct Function * Fct, struct Value * A, struct Value * V // input : // (A+0) ->Val = number of cells -- N // (A+1) ->Val = magnetic field at previous time step -- hp // (A+2) ->Val = magnetic induction -- b // (A+3) ->Val = magnetic induction at previous time step -- bp // (A+4) ->Val = characteristic magnetic field inversely proportional to the slope at origin -- alpha // (A+5+4*k)->Val = material magnetization -- Jk // (A+6+4*k)->Val = material magnetization at previous time step -- Jkp // (A+7+4*k)->Val = limit force related to the dissipation -- chi // (A+8+4*k)->Val = saturation magnetization -- Js // --------------------------------------------- // output: reluctivity -- nu int dim = Fct->Para[0]; int N = (A+0)->Val[0]; double alpha = (A+4)->Val[0]; double h[3], b[3], bc[3], Jk_all[3*N], Jkp_all[3*N], chi_all[N], Js_all[N] ; for (int n=0; n<3; n++) { h[n] = (A+1)->Val[n]; b[n] = (A+2)->Val[n]; bc[n] = (A+3)->Val[n]; } for (int k=0; kVal[0]; Js_all[k] =(A+8+4*k)->Val[0]; for (int n=0; n<3; n++) { Jk_all[n+3*k] = (A+5+4*k)->Val[n]; Jkp_all[n+3*k] = (A+6+4*k)->Val[n]; } } Vector_h_Vinch_K(dim, N, b, bc, alpha, Jk_all, Jkp_all, chi_all, Js_all, h ); V->Type = TENSOR_SYM ; V->Val[0] = (!b[0]) ? (1/(1e3*MU0)): h[0]/b[0] ; V->Val[1] = 0.0 ; V->Val[2] = 0.0 ; V->Val[3] = (!b[1]) ? (1/(1e3*MU0)): h[1]/b[1] ; V->Val[4] = 0.0 ; V->Val[5] = (!b[2]) ? (1/(1e3*MU0)): h[2]/b[2] ; } getdp-2.7.0-source/Legacy/GF_LaplacexForm.cpp000644 001750 001750 00000060271 12473553042 022455 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Ruth Sabariego // #include #include "ProData.h" #include "ProDefine.h" #include "BF.h" #include "GF.h" #include "GeoData.h" #include "Message.h" #define SQU(a) ((a)*(a)) #define THESIGN(a) ((a)>=0 ? 1 : -1) #define ONE_OVER_TWO_PI 1.5915494309189534E-01 #define ONE_OVER_FOUR_PI 7.9577471545947668E-02 #define MAX_NODES 6 #define EPSILON 1.e-8 #define EPSILON2 1.e-20 #define RADIUS 0.154797 /* this is a hack... */ /* ------------------------------------------------------------------------ */ /* G F _ L a p l a c e x F o r m */ /* ------------------------------------------------------------------------ */ void GF_LaplacexForm(GF_ARGX) { double xs[MAX_NODES], ys[MAX_NODES], zs[MAX_NODES], u[3], v[3], n[3]; double u2=0., v2=0., xl=0., yl=0., zl=0., zl_2=0. ; double Area, m0[3], m1[3], m2[3] ; int Type_Int=0, i, j = 1 ; double a=0., b=0., c=0., d, e, f, i1, I1 = 0., Iua, Iva, r2; double s0m=0., s0p=0., s1m=0., s1p=0., s2m=0., s2p=0., t00, t10, t20, t0m_2, t0p_2, t1p_2; double r00_2=0., r10_2=0., r20_2=0., r00, r10, r20, r0p=0., r0m=0., r1p=0.; double f20=0., f21=0., f22=0., B0, B1, B2 ; double f30, f31, f32, N10, N20, N30 ; Val->Val[MAX_DIM] = 0.0 ; switch ((int)Fct->Para[0]) { case _2D : switch (Element->ElementSource->Type) { case POINT : xs[0] = Element->ElementSource->x[0] ; ys[0] = Element->ElementSource->y[0] ; r2 = SQU(x-xs[0])+SQU(y-ys[0]) ; if (r2 > SQU(RADIUS)){ Val->Type = SCALAR ; Val->Val[0] = - ONE_OVER_FOUR_PI * log(r2) ; } else{ Val->Type = SCALAR ; Val->Val[0] = - ONE_OVER_FOUR_PI * log(SQU(RADIUS)) ; } break ; case LINE : xs[0] = Element->ElementSource->x[0] ; ys[0] = Element->ElementSource->y[0] ; xs[1] = Element->ElementSource->x[1] ; ys[1] = Element->ElementSource->y[1] ; if(xFunctionBF == (void(*)())BF_Volume) { a = SQU(xs[0]-xs[1]) + SQU(ys[0]-ys[1]) ; b = 2. * ((x-xs[0])*(xs[0]-xs[1]) + (y-ys[0])*(ys[0]-ys[1])) ; c = SQU(x-xs[0]) + SQU(y-ys[0]) ; d = 0.5 * b / a ; e = c / a ; f = e - d*d ; if (f > EPSILON) { Type_Int = 1; } else if (fabs(f) < EPSILON){ Type_Int = 0; } else { Type_Int = -1; f = -f; } if (Element->Num == Element->ElementSource->Num) Type_Int = 2 ; if ((c == 0) || ((b == -2*a) && (c == a))) Type_Int = 3 ; switch (Type_Int) { case -1 : I1 = log(a) + ( (d+1.) * log(SQU(d+1.) - f) - 2.*(d+1.) + sqrt(f) * log((d+1.+sqrt(f))/(d+1.-sqrt(f))) ) - ( d*log(d*d-f) - 2.*d + sqrt(f)*log((d+sqrt(f))/(d-sqrt(f))) ) ; break ; case 0 : I1 = log(a) + (d+1.)*log(SQU(d+1.)) - d*log(SQU(d)) - 2. ; break ; case 1 : I1 = log(a) + ( (d+1.) * log(SQU(d+1.) + f) - 2.*(d+1.) + 2.*sqrt(f) * atan((d+1.)/sqrt(f)) ) - ( d*log(d*d+f) - 2.*d + 2.*sqrt(f)*atan(d/sqrt(f)) ) ; break ; case 2 : i1 = -b / (2.*a) ; I1 = 2. * i1 * (log(i1) - 1.) + 2. * (1.-i1) * (log(1.-i1) - 1.) + log(a) ; break ; case 3 : I1 = .5 * log(a) - 1. ; break ; } Val->Type = SCALAR ; Val->Val[0] = - ONE_OVER_FOUR_PI * I1 ; } else { Message::Error("Unknown Basis Function Type for 'GF_LaplacexForm'"); } break ; default : Message::Error("Unknown Element Type (%s) for 'GF_LaplacexForm'", Get_StringForDefine(Element_Type, Element->ElementSource->Type)); } break; case _3D : switch (Element->ElementSource->Type) { case LINE : xs[0] = Element->ElementSource->x[0] ; ys[0] = Element->ElementSource->y[0] ; zs[0] = Element->ElementSource->z[0] ; xs[1] = Element->ElementSource->x[1] ; ys[1] = Element->ElementSource->y[1] ; zs[1] = Element->ElementSource->z[1] ; a = SQU(xs[0]-xs[1]) + SQU(ys[0]-ys[1]) + SQU(zs[0]-zs[1]) ; b = 2. * ((x-xs[0])*(xs[0]-xs[1]) + (y-ys[0])*(ys[0]-ys[1]) + (z-zs[0])*(zs[0]-zs[1])) ; c = SQU(x-xs[0]) + SQU(y-ys[0]) + SQU(z-zs[0]) + SQU(RADIUS) ; Val->Val[0] = ONE_OVER_FOUR_PI * log( ( 2.*sqrt(a*(a+b+c))+2.*a+b ) / ( 2.*sqrt(a*c)+b ) ) ; Val->Type = SCALAR ; break ; case TRIANGLE : case QUADRANGLE : if(xFunctionBF == (void(*)())BF_Volume) Type_Int = 1 ; if(xFunctionBF == (void(*)())BF_Node) Type_Int = 2 ; xs[0] = Element->ElementSource->x[0] ; ys[0] = Element->ElementSource->y[0] ; zs[0] = Element->ElementSource->z[0] ; xs[1] = Element->ElementSource->x[1] ; ys[1] = Element->ElementSource->y[1] ; zs[1] = Element->ElementSource->z[1] ; xs[2] = Element->ElementSource->x[2] ; ys[2] = Element->ElementSource->y[2] ; zs[2] = Element->ElementSource->z[2] ; if (Element->ElementSource->Type == QUADRANGLE) { xs[3] = Element->ElementSource->x[3] ; ys[3] = Element->ElementSource->y[3] ; zs[3] = Element->ElementSource->z[3] ; j = 0 ; }; for(i = j; i < 2; i++){ /* triangle side lengths */ a = sqrt(SQU(xs[1]-xs[0]) + SQU(ys[1]-ys[0]) + SQU(zs[1]-zs[0])); b = sqrt(SQU(xs[2]-xs[1]) + SQU(ys[2]-ys[1]) + SQU(zs[2]-zs[1])); c = sqrt(SQU(xs[2]-xs[0]) + SQU(ys[2]-ys[0]) + SQU(zs[2]-zs[0])); /* local system (u,v,w) centered at (xs[0],ys[0],zs[0]) */ u[0] = (xs[1]-xs[0])/a; u[1] = (ys[1]-ys[0])/a; u[2] = (zs[1]-zs[0])/a; /* triangle normal */ Geo_CreateNormal(Element->ElementSource->Type,xs,ys,zs,n); /* v = n /\ u */ v[0] = n[1]*u[2]-n[2]*u[1]; v[1] = n[2]*u[0]-n[0]*u[2]; v[2] = n[0]*u[1]-n[1]*u[0]; u2 = (xs[2]-xs[0])*u[0] + (ys[2]-ys[0])*u[1] + (zs[2]-zs[0])*u[2]; /* u2 coordinate */ v2 = (xs[2]-xs[0])*v[0] + (ys[2]-ys[0])*v[1] + (zs[2]-zs[0])*v[2]; /* triangle height, v2 coordinate */ /* local coordinates of the observation point (xl, yl, zl) */ xl = u[0] * (x-xs[0]) + u[1] * (y-ys[0]) + u[2] * (z-zs[0]); yl = v[0] * (x-xs[0]) + v[1] * (y-ys[0]) + v[2] * (z-zs[0]); zl = n[0] * (x-xs[0]) + n[1] * (y-ys[0]) + n[2] * (z-zs[0]); s0m = -( (a-xl) * (a-u2) + yl*v2 ) / b; s0p = s0m + b; s1p = ( xl * u2 + yl * v2 ) / c; s1m = s1p - c; s2m = - xl; s2p = a - xl; /* distance observation point projection on triangle plane to triangle local vertices*/ /* t1m = t0p ; t2p = t0m ; t2m = t1p ; */ t00 = (yl * (u2-a) + v2 * (a-xl)) / b; t10 = (xl * v2 - yl * u2) / c; t20 = yl; t0m_2 = (a-xl)*(a-xl) + yl*yl; t0p_2 = (u2-xl)*(u2-xl) + (v2-yl)*(v2-yl); t1p_2 = xl*xl + yl*yl; /* minimum distances^2 from the observation point to each triangle side*/ zl_2 = SQU(zl) ; r00_2 = SQU(t00) + zl_2 ; r10_2 = SQU(t10) + zl_2 ; r20_2 = SQU(t20) + zl_2 ; /* distances from observation point to the vertices*/ r0p = sqrt(t0p_2 + zl_2); r0m = sqrt(t0m_2 + zl_2); r1p = sqrt(t1p_2 + zl_2); r00 = sqrt(r00_2); r10 = sqrt(r10_2); r20 = sqrt(r20_2); /* intermediate functions */ if(r00 <= EPSILON*(fabs(s0m)+fabs(s0p)) ){ f20 = log(s0m/s0p) ; B0 = 0; } else{ if (!(r0m + s0m)) Message::Error("1/0 in GF_LaplacexForm (case _3D TRIANGLE) Num %d Obs %.15e %.15e %.15e", Element->ElementSource->Num, x, y, z) ; f20 = log((r0p + s0p) / (r0m + s0m)); B0 = atan(t00*s0p/(r00_2+fabs(zl)*r0p))-atan(t00*s0m/(r00_2+fabs(zl)*r0m)); } if(r10 <= EPSILON*(fabs(s1m)+fabs(s1p)) ){ f21 = log(s1m/s1p); B1 = 0; } else{ if(!(r0p + s1m)) Message::Error("1/0 in GF_LaplacexForm (case _3D TRIANGLE) Num %d Obs %.15e %.15e %.15e", Element->ElementSource->Num, x, y, z) ; f21 = log((r1p + s1p) / (r0p + s1m)); B1 = atan(t10*s1p/(r10_2+fabs(zl)*r1p))-atan(t10*s1m/(r10_2+fabs(zl)*r0p)); } if(r20 <= EPSILON*(fabs(s2m)+fabs(s2p)) ){ f22 = log(s2m/s2p); B2 = 0; } else{ if(!(r1p+s2m)) Message::Error("1/0 in GF_LaplacexForm (case _3D TRIANGLE) Num %d Obs %.15e %.15e %.15e", Element->ElementSource->Num, x, y, z) ; f22 = log((r0m + s2p) / (r1p + s2m)); B2 = atan(t20*s2p/(r20_2+fabs(zl)*r0m))-atan(t20*s2m/(r20_2+fabs(zl)*r1p)); } I1 += -fabs(zl)*(B0+B1+B2) + t00*f20+t10*f21+t20*f22 ; /* 1/r integral solution*/ if (j == 0){ xs[1] = xs[2]; ys[1] = ys[2]; zs[1] = zs[2]; xs[2] = xs[3]; ys[2] = ys[3]; zs[2] = zs[3];} } switch ( Type_Int ){ case 1 : /* BF_Volume */ Area = a * v2/2 ;/* Triangle area */ Val->Val[0] = I1 /Area ; break; case 2 : /* BF_Node */ if (!v2) Message::Error("1/0 in GF_LaplacexForm (case _3D TRIANGLE) v2 %e", v2); f30 = (s0p*r0p-s0m*r0m) + r00_2 * f20 ; /* f3i */ f31 = (s1p*r1p-s1m*r0p) + r10_2 * f21 ; f32 = (s2p*r0m-s2m*r1p) + r20_2 * f22 ; m0[0] = ((ys[2] - ys[1]) * n[2] - (zs[2] - zs[1]) * n[1])*f30/b ; m0[1] = ((zs[2] - zs[1]) * n[0] - (xs[2] - xs[1]) * n[2])*f30/b ; m0[2] = ((xs[2] - xs[1]) * n[1] - (ys[2] - ys[1]) * n[0])*f30/b ; m1[0] = ((ys[0] - ys[2]) * n[2] - (zs[0] - zs[2]) * n[1])*f31/c ; m1[1] = ((zs[0] - zs[2]) * n[0] - (xs[0] - xs[2]) * n[2])*f31/c ; m1[2] = ((xs[0] - xs[2]) * n[1] - (ys[0] - ys[2]) * n[0])*f31/c ; m2[0] = (u[1] * n[2] - u[2]* n[1])*f32 ; m2[1] = (u[2] * n[0] - u[0]* n[2])*f32 ; m2[2] = (u[0] * n[1] - u[1]* n[0])*f32 ; Iua = (u[0] * (m0[0] + m1[0] + m2[0]) + u[1] * (m0[1] + m1[1] + m2[1]) + u[2] * (m0[2] + m1[2] + m2[2]))/2 ; Iva = (v[0] * (m0[0] + m1[0] + m2[0]) + v[1] * (m0[1] + m1[1] + m2[1]) + v[2] * (m0[2] + m1[2] + m2[2]))/2 ; switch(EntityNum){ case 1 : N10 = 1 - xl/a + (u2/a -1) * yl/v2 ; Val->Val[0] = N10 * I1 - Iua/a + (u2/a-1) * Iva/v2 ; break; case 2 : N20 = xl/a - u2/a * yl/v2 ; Val->Val[0] = N20 * I1 + Iua/a - u2/a * Iva/v2 ; break; case 3 : N30 = yl/v2 ; Val->Val[0] = N30 * I1 + Iva/v2 ; break; } break; default : Message::Error("Unknown Basis Function Type for 'GF_LaplacexForm'"); } Val->Val[0] *= ONE_OVER_FOUR_PI ; if (j == 0){ Val->Val[0] /= 2; } Val->Type = SCALAR ; break ; default : Message::Error("Unknown Element Type (%s) for 'GF_LaplacexForm'", Get_StringForDefine(Element_Type, Element->ElementSource->Type)); } break ; default : Message::Error("Unknown Dimension (%d) for 'GF_LaplacexForm'", (int)Fct->Para[0]); } } /* ------------------------------------------------------------------------ */ /* G F _ G r a d L a p l a c e x F o r m */ /* ------------------------------------------------------------------------ */ void GF_GradLaplacexForm(GF_ARGX) { double xs[MAX_NODES], ys[MAX_NODES], zs[MAX_NODES] ; double xxs, yys, r2, EPS ; double a, b, c, a2, I1, I2 ; double f0[3], f1[3], f2[3], N10, N20, N30 ; double m0[3], m1[3], m2[3], s0[3], s1[3] ; double umf2i, us0, us1, us2, vmf2i, vs0, vs1, vs2 ; double u[3], v[3], n[3], u2, v2, xl, yl, zl, zl_2 ; double area, I[3], Iua[3], Iva[3] ; double s0m, s0p, s1m, s1p, s2m, s2p, t00, t10, t20, t0m_2, t0p_2, t1p_2; double r00_2, r10_2, r20_2, r00, r10, r20, r0p, r0m, r1p, f20, f21, f22, B0, B1, B2, B ; int Type_Int=0 ; Val->Val[MAX_DIM] = Val->Val[MAX_DIM + 1] = Val->Val[MAX_DIM + 2] = 0. ; switch ((int)Fct->Para[0]) { case _2D : switch (Element->ElementSource->Type) { case POINT : Val->Type = VECTOR ; if (Element->Num == Element->ElementSource->Num) { Val->Val[0] = Val->Val[1] = Val->Val[2] = 0. ; return ; } xxs = x - Element->ElementSource->x[0] ; yys = y - Element->ElementSource->y[0] ; r2 = SQU(xxs)+SQU(yys) ; if (r2 > EPSILON2) { Val->Val[0] = - ONE_OVER_TWO_PI * xxs / r2 ; Val->Val[1] = - ONE_OVER_TWO_PI * yys / r2 ; Val->Val[2] = 0. ; } else { Val->Val[0] = Val->Val[1] = Val->Val[2] = 0. ; } break ; default : Message::Error("Unknown Element Type (%s) for 'GF_GradLaplacexForm'", Get_StringForDefine(Element_Type, Element->ElementSource->Type)); } break ; case _3D : switch (Element->ElementSource->Type) { case LINE : Val->Type = VECTOR ; xs[0] = Element->ElementSource->x[0] ; ys[0] = Element->ElementSource->y[0] ; zs[0] = Element->ElementSource->z[0] ; xs[1] = Element->ElementSource->x[1] ; ys[1] = Element->ElementSource->y[1] ; zs[1] = Element->ElementSource->z[1] ; a = SQU(xs[0]-xs[1]) + SQU(ys[0]-ys[1]) + SQU(zs[0]-zs[1]) ; b = 2. * ((x-xs[0])*(xs[0]-xs[1]) + (y-ys[0])*(ys[0]-ys[1]) + (z-zs[0])*(zs[0]-zs[1])) ; c = SQU(x-xs[0]) + SQU(y-ys[0]) + SQU(z-zs[0]) + SQU(RADIUS) ; I1 = 2./(4.*a*c-b*b) * ( (2.*a+b)/sqrt(a+b+c) - b/sqrt(c) ) ; I2 = 2./(-4.*a*c+b*b) * ( (2.*c+b)/sqrt(a+b+c) - 2.*sqrt(c) ) ; a2 = sqrt(a) ; Val->Val[0] = ONE_OVER_FOUR_PI * ( (xs[0]-x) * I1 + (xs[1]-xs[0]) * I2 ) * a2 ; Val->Val[1] = ONE_OVER_FOUR_PI * ( (ys[0]-y) * I1 + (ys[1]-ys[0]) * I2 ) * a2 ; Val->Val[2] = ONE_OVER_FOUR_PI * ( (zs[0]-z) * I1 + (zs[1]-zs[0]) * I2 ) * a2 ; break ; case TRIANGLE : Val->Type = VECTOR ; xs[0] = Element->ElementSource->x[0] ; ys[0] = Element->ElementSource->y[0] ; zs[0] = Element->ElementSource->z[0] ; xs[1] = Element->ElementSource->x[1] ; ys[1] = Element->ElementSource->y[1] ; zs[1] = Element->ElementSource->z[1] ; xs[2] = Element->ElementSource->x[2] ; ys[2] = Element->ElementSource->y[2] ; zs[2] = Element->ElementSource->z[2] ; if(xFunctionBF == (void(*)())BF_Volume) Type_Int = 1 ; if(xFunctionBF == (void(*)())BF_Node) Type_Int = 2 ; /* triangle side lengths */ a = sqrt(SQU(xs[1]-xs[0]) + SQU(ys[1]-ys[0]) + SQU(zs[1]-zs[0])); b = sqrt(SQU(xs[2]-xs[1]) + SQU(ys[2]-ys[1]) + SQU(zs[2]-zs[1])); c = sqrt(SQU(xs[2]-xs[0]) + SQU(ys[2]-ys[0]) + SQU(zs[2]-zs[0])); /* local system (u,v,w) centered at (xs[0],ys[0],zs[0]) */ u[0] = (xs[1]-xs[0])/a; u[1] = (ys[1]-ys[0])/a; u[2] = (zs[1]-zs[0])/a; /* triangle normal */ Geo_CreateNormal(Element->ElementSource->Type,xs,ys,zs,n); v[0] = n[1]*u[2]-n[2]*u[1]; v[1] = n[2]*u[0]-n[0]*u[2]; v[2] = n[0]*u[1]-n[1]*u[0]; u2 = (xs[2]-xs[0])*u[0] + (ys[2]-ys[0])*u[1] + (zs[2]-zs[0])*u[2]; /* u2 coordinate */ v2 = (xs[2]-xs[0])*v[0] + (ys[2]-ys[0])*v[1] + (zs[2]-zs[0])*v[2]; /* triangle height, v2 coordinate*/ /* local coordinates of the observation point (xl, yl, zl)*/ xl = u[0] * (x-xs[0]) + u[1] * (y-ys[0]) + u[2] * (z-zs[0]); yl = v[0] * (x-xs[0]) + v[1] * (y-ys[0]) + v[2] * (z-zs[0]); zl = n[0] * (x-xs[0]) + n[1] * (y-ys[0]) + n[2] * (z-zs[0]); area = a * v2/2 ;/* Triangle area */ if (!zl) zl = sqrt(area) * 1e-15 ; s0m = -( (a-xl) * (a-u2) + yl*v2 ) / b; s0p = s0m + b; s1p = ( xl * u2 + yl * v2 ) / c; s1m = s1p - c; s2m = - xl; s2p = a - xl; /* distance observation point projection on triangle plane to triangle local vertices*/ t00 = (yl * (u2-a) + v2 * (a-xl)) / b; t10 = (xl * v2 - yl * u2) / c; t20 = yl; t0m_2 = ((a-xl)*(a-xl) + yl*yl); t0p_2 = ((u2-xl)*(u2-xl) + (v2-yl)*(v2-yl)); t1p_2 = (xl*xl + yl*yl); /* minimum distances^2 from the observation point to each triangle side*/ zl_2 = SQU(zl) ; r00_2 = SQU(t00) + zl_2 ; r10_2 = SQU(t10) + zl_2 ; r20_2 = SQU(t20) + zl_2 ; r00 = sqrt(r00_2); r10 = sqrt(r10_2); r20 = sqrt(r20_2); /* distances from observation point to the vertices*/ r0p = sqrt(t0p_2 + zl_2); r0m = sqrt(t0m_2 + zl_2); r1p = sqrt(t1p_2 + zl_2); EPS = EPSILON*(fabs(s0m)+fabs(s0p)); B0 = (r00 <= EPS) ? 0. : atan(t00*s0p/(r00_2+fabs(zl)*r0p))-atan(t00*s0m/(r00_2+fabs(zl)*r0m)); f20 = ((r0m + s0m) <= EPS) ? log(s0m/s0p) : log((r0p + s0p) / (r0m + s0m)) ; EPS = EPSILON*(fabs(s1m)+fabs(s1p)) ; B1 = (r10 <=EPS) ? 0. : atan(t10*s1p/(r10_2+fabs(zl)*r1p))-atan(t10*s1m/(r10_2+fabs(zl)*r0p)); f21 = ((r0p + s1m)<=EPS) ? log(s1m/s1p) : log((r1p + s1p) / (r0p + s1m)); EPS = EPSILON*(fabs(s2m)+fabs(s2p)) ; B2 = (r20 <= EPS) ? 0. : atan(t20*s2p/(r20_2+fabs(zl)*r0m))-atan(t20*s2m/(r20_2+fabs(zl)*r1p)); f22 = ((r1p + s2m)< EPS) ? log(s2m/s2p): log((r0m + s2p) / (r1p + s2m)); B = B0 + B1 + B2 ; s0[0] = (xs[2] - xs[1])/b ; s0[1] = (ys[2] - ys[1])/b ; s0[2] = (zs[2] - zs[1])/b ; s1[0] = (xs[0] - xs[2])/c ; s1[1] = (ys[0] - ys[2])/c ; s1[2] = (zs[0] - zs[2])/c ; m0[0] = s0[1] * n[2] - s0[2]* n[1] ; m0[1] = s0[2] * n[0] - s0[0]* n[2] ; m0[2] = s0[0] * n[1] - s0[1]* n[0] ; m1[0] = s1[1]* n[2] - s1[2] * n[1] ; m1[1] = s1[2]* n[0] - s1[0] * n[2] ; m1[2] = s1[0]* n[1] - s1[1] * n[0] ; m2[0] = u[1] * n[2] - u[2]* n[1] ; m2[1] = u[2] * n[0] - u[0]* n[2] ; m2[2] = u[0] * n[1] - u[1]* n[0] ; /* Grad(1/r) integral solution*/ I[0] = -n[0] * THESIGN(zl) * B - (m0[0]*f20 + m1[0]*f21 + m2[0]*f22) ; I[1] = -n[1] * THESIGN(zl) * B - (m0[1]*f20 + m1[1]*f21 + m2[1]*f22) ; I[2] = -n[2] * THESIGN(zl) * B - (m0[2]*f20 + m1[2]*f21 + m2[2]*f22) ; switch ( Type_Int ){ case 1 : /* BF_Volume */ Val->Val[0] = I[0]/area ; Val->Val[1] = I[1]/area ; Val->Val[2] = I[2]/area ; break; case 2 : /* BF_Node */ if (!v2 ) Message::Error("1/0 in GF_LaplacexForm (case _3D TRIANGLE) v2 %e", v2); f0[0] = s0[0] * t00 * f20 - m0[0]*(r0p-r0m) ; /* fi */ f0[1] = s0[1] * t00 * f20 - m0[1]*(r0p-r0m) ; f0[2] = s0[2] * t00 * f20 - m0[2]*(r0p-r0m) ; f1[0] = s1[0] * t10 * f21 - m1[0]*(r1p-r0p) ; f1[1] = s1[1] * t10 * f21 - m1[1]*(r1p-r0p) ; f1[2] = s1[2] * t10 * f21 - m1[2]*(r1p-r0p) ; f2[0] = u[0] * t20 * f22 - m2[0]*(r0m-r1p) ; f2[1] = u[1] * t20 * f22 - m2[1]*(r0m-r1p) ; f2[2] = u[2] * t20 * f22 - m2[2]*(r0m-r1p) ; umf2i = u[0]*(m0[0]*f20 + m1[0]*f21 + m2[0]*f22) + u[1]*(m0[1]*f20 + m1[1]*f21 + m2[1]*f22) + u[2]*(m0[2]*f20 + m1[2]*f21 + m2[2]*f22) ; us0 = u[0] * s0[0] + u[1] * s0[1] + u[2] * s0[2] ; us1 = u[0] * s1[0] + u[1] * s1[1] + u[2] * s1[2] ; us2 = u[0] * u[0] + u[1] * u[1] + u[2] * u[2] ; vmf2i = v[0]*(m0[0]*f20 + m1[0]*f21 + m2[0]*f22) + v[1]*(m0[1]*f20 + m1[1]*f21 + m2[1]*f22) + v[2]*(m0[2]*f20 + m1[2]*f21 + m2[2]*f22) ; vs0 = v[0] * s0[0] + v[1] * s0[1] + v[2] * s0[2] ; vs1 = v[0] * s1[0] + v[1] * s1[1] + v[2] * s1[2] ; vs2 = v[0] * u[0] + v[1] * u[1] + v[2] * u[2] ; B *= fabs(zl); umf2i *= zl ; vmf2i *= zl ; Iua[0] = n[0] * umf2i - B * u[0] + f0[0] * us0 + f1[0] * us1 + f2[0] * us2 ; Iua[1] = n[1] * umf2i - B * u[1] + f0[1] * us0 + f1[1] * us1 + f2[1] * us2 ; Iua[2] = n[2] * umf2i - B * u[2] + f0[2] * us0 + f1[2] * us1 + f2[2] * us2 ; Iva[0] = n[0] * vmf2i - B * v[0] + f0[0] * vs0 + f1[0] * vs1 + f2[0] * vs2 ; Iva[1] = n[1] * vmf2i - B * v[1] + f0[1] * vs0 + f1[1] * vs1 + f2[1] * vs2 ; Iva[2] = n[2] * vmf2i - B * v[2] + f0[2] * vs0 + f1[2] * vs1 + f2[2] * vs2 ; switch(EntityNum){ case 1 : N10 = 1 - xl/a + (u2/a -1) * yl/v2 ; Val->Val[0] = N10 * I[0] - Iua[0]/a + (u2/a-1) * Iva[0]/v2 ; Val->Val[1] = N10 * I[1] - Iua[1]/a + (u2/a-1) * Iva[1]/v2 ; Val->Val[2] = N10 * I[2] - Iua[2]/a + (u2/a-1) * Iva[2]/v2 ; break; case 2 : N20 = xl/a - u2/a * yl/v2 ; Val->Val[0] = N20 * I[0] + Iua[0]/a - u2/a * Iva[0]/v2 ; Val->Val[1] = N20 * I[1] + Iua[1]/a - u2/a * Iva[1]/v2 ; Val->Val[2] = N20 * I[2] + Iua[2]/a - u2/a * Iva[2]/v2 ; break; case 3 : N30 = yl/v2 ; Val->Val[0] = N30 * I[0] + Iva[0]/v2 ; Val->Val[1] = N30 * I[1] + Iva[1]/v2 ; Val->Val[2] = N30 * I[2] + Iva[2]/v2 ; break; } break; } Val->Val[0] *= ONE_OVER_FOUR_PI ; Val->Val[1] *= ONE_OVER_FOUR_PI ; Val->Val[2] *= ONE_OVER_FOUR_PI ; break ; default : Message::Error("Unknown Element Type (%s) for 'GF_GradLaplacexForm'", Get_StringForDefine(Element_Type, Element->ElementSource->Type)); } break ; default : Message::Error("Unknown Dimension (%d) for 'GF_GradLaplacexForm'", (int)Fct->Para[0]); } } /* ------------------------------------------------------------------------ */ /* G F _ N P x G r a d L a p l a c e x F o r m */ /* ------------------------------------------------------------------------ */ void GF_NPxGradLaplacexForm(GF_ARGX) { double xs[MAX_NODES], ys[MAX_NODES] ; double xp[MAX_NODES], yp[MAX_NODES], N[3] ; int Type_Int; double a, b, c, d, m, n, Jp, i1, Is, I1=0 ; struct Value ValGrad ; Val->Type = SCALAR ; Val->Val[MAX_DIM] = 0.0 ; if (Element->Num == Element->ElementSource->Num) { Val->Val[0] = 0.0 ; return ; } switch ((int)Fct->Para[0]) { case _2D : switch (Element->ElementSource->Type) { case LINE : if (Element->Type != LINE) Message::Error("GF_NPxGradLaplacexForm not ready for mixed geometrical elements"); xs[0] = Element->ElementSource->x[0] ; ys[0] = Element->ElementSource->y[0] ; xs[1] = Element->ElementSource->x[1] ; ys[1] = Element->ElementSource->y[1] ; if(xFunctionBF == (void(*)())BF_Volume) { if ((x == xs[0]) && (y == ys[0])) Type_Int = 1 ; else if ((x == xs[1]) && (y == ys[1])) Type_Int = 2 ; else Type_Int = 3 ; xp[0] = Element->x[0] ; yp[0] = Element->y[0] ; xp[1] = Element->x[1] ; yp[1] = Element->y[1] ; a = SQU(xs[0]-xs[1]) + SQU(ys[0]-ys[1]) ; b = 2. * ((x-xs[0]) * (xs[0]-xs[1]) + (y-ys[0]) * (ys[0]-ys[1])) ; c = SQU(x-xs[0]) + SQU(y-ys[0]) ; d = 4.*a*c - b*b ; switch (Type_Int) { case 1 : case 2 : Message::Error("Degenerate case not done in 'GF_NPxGradLaplacexForm'"); break ; case 3 : if (fabs(d) < EPSILON2) { I1 = 0.0 ; } else { if(d<0) Message::Error("Unexpected value in 'GF_NPxGradLaplacexForm'"); i1 = sqrt(d) ; Is = 2. / i1 * (atan((2.*a+b)/i1) - atan(b/i1)) ; Jp = sqrt(SQU(xp[0]-xp[1])+SQU(yp[0]-yp[1])) ; m = ((ys[0]-ys[1]) * (xp[0]-xp[1]) + (xs[0]-xs[1]) * (yp[1]-yp[0])) / Jp ; n = ((yp[1]-yp[0]) * (x-xs[0]) + (xp[0]-xp[1]) * (y-ys[0])) / Jp ; I1 = m /(2.*a) * log((a+b)/c+1.) + (n - m*b/(2.*a)) * Is ; } break ; } Val->Val[0] = - ONE_OVER_TWO_PI * I1 ; } else { Message::Error("Unknown Basis Function Type for 'GF_NPxGradLaplacexForm'"); } break ; default : Message::Error("Unknown Element Type (%s) for 'GF_NPxGradLaplacexForm'", Get_StringForDefine(Element_Type, Element->ElementSource->Type)); } break ; case _3D: switch (Element->ElementSource->Type) { case TRIANGLE : Geo_CreateNormal(Element->Type, Element->x,Element->y,Element->z, N); GF_GradLaplacexForm(Element, Fct, xFunctionBF, EntityNum, x, y, z, &ValGrad) ; Val->Val[0] = N[0]*ValGrad.Val[0] + N[1]*ValGrad.Val[1] + N[2]*ValGrad.Val[2] ; break ; default : Message::Error("Unknown Element Type (%s) for 'GF_NPxGradLaplacexForm'", Get_StringForDefine(Element_Type, Element->ElementSource->Type)); } break ; default : Message::Error("Unknown Dimension (%d) for 'GF_NPxGradLaplacexForm'", (int)Fct->Para[0]); } } /* ------------------------------------------------------------------------ */ /* G F _ N S x G r a d L a p l a c e x F o r m */ /* ------------------------------------------------------------------------ */ void GF_NSxGradLaplacexForm(GF_ARGX) { Message::Error("Not done: 'GF_NSxGradLaplacexForm'"); } /* ------------------------------------------------------------------------ */ /* G F _ A p p r o x i m a t e L a p l a c e x F o r m */ /* ------------------------------------------------------------------------ */ void GF_ApproximateLaplacexForm(GF_ARGX) { switch ((int)Fct->Para[1]) { case 0 : GF_LaplacexForm(Element, Fct, (void(*)())BF_Volume, 1, x, y, z, Val); break ; default : Message::Error("Bad Parameter Value in 'GF_ApproximateLaplacexForm'"); break; } } getdp-2.7.0-source/Legacy/Operation_Update.cpp000644 001750 001750 00000033541 12473553042 022766 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include #include #include "ProData.h" #include "DofData.h" #include "SolvingAnalyse.h" #include "SolvingOperations.h" #include "Cal_Quantity.h" #include "Message.h" extern struct CurrentData Current ; extern int Init_Update ; #define SQU(a) ((a)*(a)) void Cal_ThetaCoefficients(double *coef) { coef[0] = 1./Current.DTime ; coef[1] = Current.Theta ; coef[2] = -1./Current.DTime ; coef[3] = 1.-Current.Theta ; } void Cal_ThetaMatrix(int *init, double *coef, gMatrix *M1, gMatrix *M2, gMatrix *A) { Message::Info("Generate Theta Iteration Matrix (Theta=%g, DTime=%g)", Current.Theta, Current.DTime) ; LinAlg_AssembleMatrix(A) ; LinAlg_ZeroMatrix(A); // A = c0 * M2 + c1 * M1 if(init[2] && coef[0]) LinAlg_AddMatrixProdMatrixDouble(A, M2, coef[0], A) ; if(init[1] && coef[1]) LinAlg_AddMatrixProdMatrixDouble(A, M1, coef[1], A) ; } void Cal_ThetaRHS(int *init, double *coef, gMatrix *M1, gMatrix *M2, gVector *m1, gVector *m2, List_T *m1s, List_T *m2s, gVector *tmp, gVector *b, bool explicitTimeFunction) { double tfval, val ; LinAlg_ZeroVector(b) ; // b = [-c2 * M2 - c3 * M1 ] * x(n-1) if(init[2] && coef[2]){ LinAlg_ProdMatrixVector(M2, &(Current.DofData->CurrentSolution-1)->x, tmp); LinAlg_AddVectorProdVectorDouble(b, tmp, -coef[2], b) ; } if(init[1] && coef[3]){ LinAlg_ProdMatrixVector(M1, &(Current.DofData->CurrentSolution-1)->x, tmp); LinAlg_AddVectorProdVectorDouble(b, tmp, -coef[3], b) ; } if(explicitTimeFunction){ // + [ c0 * m2 + c1 * m1 ] * TimeFct(n) tfval = Current.DofData->CurrentSolution->ExplicitTimeFunctionValue ; if(init[2] && (val=coef[0]*tfval)) LinAlg_AddVectorProdVectorDouble(b, m2, val, b) ; if(init[1] && (val=coef[1]*tfval)) LinAlg_AddVectorProdVectorDouble(b, m1, val, b) ; // + [ c2 * m2 + c3 * m1 ] * TimeFct(n-1) tfval = (Current.DofData->CurrentSolution-1)->ExplicitTimeFunctionValue ; if(init[2] && (val=coef[2]*tfval)) LinAlg_AddVectorProdVectorDouble(b, m2, val, b) ; if(init[1] && (val=coef[3]*tfval)) LinAlg_AddVectorProdVectorDouble(b, m1, val, b) ; } else{ for(int i = 0; i < List_Nbr(Current.DofData->TimeFunctionIndex); i++){ gVector *mm1 = 0, *mm2 = 0; if(init[1]) mm1 = (gVector*)List_Pointer(m1s, i); if(init[2]) mm2 = (gVector*)List_Pointer(m2s, i); int tfindex; List_Read(Current.DofData->TimeFunctionIndex, i, &tfindex) ; // + [ c0 * m2 + c1 * m1 ] * TimeFct(n) tfval = Current.DofData->CurrentSolution->TimeFunctionValues[tfindex] ; if(init[2] && (val=coef[0]*tfval)) LinAlg_AddVectorProdVectorDouble(b, mm2, val, b) ; if(init[1] && (val=coef[1]*tfval)) LinAlg_AddVectorProdVectorDouble(b, mm1, val, b) ; // + [ c2 * m2 + c3 * m1 ] * TimeFct(n-1) tfval = (Current.DofData->CurrentSolution-1)->TimeFunctionValues[tfindex] ; if(init[2] && (val=coef[2]*tfval)) LinAlg_AddVectorProdVectorDouble(b, mm2, val, b) ; if(init[1] && (val=coef[3]*tfval)) LinAlg_AddVectorProdVectorDouble(b, mm1, val, b) ; } } } void Cal_NewmarkCoefficients(double *coef) { coef[0] = 1./SQU(Current.DTime) ; coef[1] = Current.Gamma/Current.DTime ; coef[2] = Current.Beta ; coef[3] = -2./SQU(Current.DTime) ; coef[4] = (1.-2.*Current.Gamma)/Current.DTime ; coef[5] = 0.5+Current.Gamma-2.*Current.Beta ; coef[6] = 1./SQU(Current.DTime) ; coef[7] = (Current.Gamma-1.)/Current.DTime ; coef[8] = 0.5-Current.Gamma+Current.Beta ; } void Cal_NewmarkMatrix(int *init, double *coef, gMatrix *M1, gMatrix *M2, gMatrix *M3, gMatrix *A) { Message::Info("Generate Newmark Iteration Matrix (Beta=%g, Gamma=%g, DTime=%g)", Current.Beta, Current.Gamma, Current.DTime) ; LinAlg_AssembleMatrix(A) ; LinAlg_ZeroMatrix(A); // A = c0 * M3 + c1 * M2 + c2 * M3 if(init[3] && coef[0]) LinAlg_AddMatrixProdMatrixDouble(A, M3, coef[0], A); if(init[2] && coef[1]) LinAlg_AddMatrixProdMatrixDouble(A, M2, coef[1], A) ; if(init[1] && coef[2]) LinAlg_AddMatrixProdMatrixDouble(A, M1, coef[2], A) ; } void Cal_NewmarkRHS(int *init, double *coef, gMatrix *M1, gMatrix *M2, gMatrix *M3, gVector *m1, gVector *m2, gVector *m3, List_T *m1s, List_T *m2s, List_T *m3s, gVector *tmp, gVector *b, bool explicitTimeFunction) { double tfval, val ; LinAlg_ZeroVector(b) ; // b = [-c3 * M3 - c4 * M2 - c5 * M1] * x(n-1) if(init[3] && coef[3]){ LinAlg_ProdMatrixVector(M3, &(Current.DofData->CurrentSolution-1)->x, tmp); LinAlg_AddVectorProdVectorDouble(b, tmp, -coef[3], b) ; } if(init[2] && coef[4]){ LinAlg_ProdMatrixVector(M2, &(Current.DofData->CurrentSolution-1)->x, tmp); LinAlg_AddVectorProdVectorDouble(b, tmp, -coef[4], b) ; } if(init[1] && coef[5]){ LinAlg_ProdMatrixVector(M1, &(Current.DofData->CurrentSolution-1)->x, tmp); LinAlg_AddVectorProdVectorDouble(b, tmp, -coef[5], b) ; } // + [-c6 * M3 - c7 * M2 - c8 * M1] * x(n-2) if(init[3] && coef[6]){ LinAlg_ProdMatrixVector(M3, &(Current.DofData->CurrentSolution-2)->x, tmp); LinAlg_AddVectorProdVectorDouble(b, tmp, -coef[6], b) ; } if(init[2] && coef[7]){ LinAlg_ProdMatrixVector(M2, &(Current.DofData->CurrentSolution-2)->x, tmp); LinAlg_AddVectorProdVectorDouble(b, tmp, -coef[7], b) ; } if(init[1] && coef[8]){ LinAlg_ProdMatrixVector(M1, &(Current.DofData->CurrentSolution-2)->x, tmp); LinAlg_AddVectorProdVectorDouble(b, tmp, -coef[8], b) ; } if(explicitTimeFunction){ // + [ c0 * m3 + c1 * m2 + c2 * m1 ] * TimeFct(n) tfval = Current.DofData->CurrentSolution->ExplicitTimeFunctionValue ; if(init[3] && (val=coef[0]*tfval)) LinAlg_AddVectorProdVectorDouble(b, m3, val, b) ; if(init[2] && (val=coef[1]*tfval)) LinAlg_AddVectorProdVectorDouble(b, m2, val, b) ; if(init[1] && (val=coef[2]*tfval)) LinAlg_AddVectorProdVectorDouble(b, m1, val, b) ; // + [ c3 * m3 + c4 * m2 + c5 * m1 ] * TimeFct(n-1) tfval = (Current.DofData->CurrentSolution-1)->ExplicitTimeFunctionValue ; if(init[3] && (val=coef[3]*tfval)) LinAlg_AddVectorProdVectorDouble(b, m3, val, b) ; if(init[2] && (val=coef[4]*tfval)) LinAlg_AddVectorProdVectorDouble(b, m2, val, b) ; if(init[1] && (val=coef[5]*tfval)) LinAlg_AddVectorProdVectorDouble(b, m1, val, b) ; // + [ c6 * m3 + c7 * m2 + c8 * m1 ] * TimeFct(n-2) tfval = (Current.DofData->CurrentSolution-2)->ExplicitTimeFunctionValue ; if(init[3] && (val=coef[6]*tfval)) LinAlg_AddVectorProdVectorDouble(b, m3, val, b) ; if(init[2] && (val=coef[7]*tfval)) LinAlg_AddVectorProdVectorDouble(b, m2, val, b) ; if(init[1] && (val=coef[8]*tfval)) LinAlg_AddVectorProdVectorDouble(b, m1, val, b) ; } else{ for(int i = 0; i < List_Nbr(Current.DofData->TimeFunctionIndex); i++){ gVector *mm1 = 0, *mm2 = 0, *mm3 = 0; if(init[1]) mm1 = (gVector*)List_Pointer(m1s, i); if(init[2]) mm2 = (gVector*)List_Pointer(m2s, i); if(init[3]) mm3 = (gVector*)List_Pointer(m3s, i); int tfindex; List_Read(Current.DofData->TimeFunctionIndex, i, &tfindex) ; // + [ c0 * m3 + c1 * m2 + c2 * m1 ] * TimeFct(n) tfval = Current.DofData->CurrentSolution->TimeFunctionValues[tfindex] ; if(init[3] && (val=coef[0]*tfval)) LinAlg_AddVectorProdVectorDouble(b, mm3, val, b) ; if(init[2] && (val=coef[1]*tfval)) LinAlg_AddVectorProdVectorDouble(b, mm2, val, b) ; if(init[1] && (val=coef[2]*tfval)) LinAlg_AddVectorProdVectorDouble(b, mm1, val, b) ; // + [ c3 * m3 + c4 * m2 + c5 * m1 ] * TimeFct(n-1) tfval = (Current.DofData->CurrentSolution-1)->TimeFunctionValues[tfindex] ; if(init[3] && (val=coef[3]*tfval)) LinAlg_AddVectorProdVectorDouble(b, mm3, val, b) ; if(init[2] && (val=coef[4]*tfval)) LinAlg_AddVectorProdVectorDouble(b, mm2, val, b) ; if(init[1] && (val=coef[5]*tfval)) LinAlg_AddVectorProdVectorDouble(b, mm1, val, b) ; // + [ c6 * m3 + c7 * m2 + c8 * m1 ] * TimeFct(n-2) tfval = (Current.DofData->CurrentSolution-2)->TimeFunctionValues[tfindex] ; if(init[3] && (val=coef[6]*tfval)) LinAlg_AddVectorProdVectorDouble(b, mm3, val, b) ; if(init[2] && (val=coef[7]*tfval)) LinAlg_AddVectorProdVectorDouble(b, mm2, val, b) ; if(init[1] && (val=coef[8]*tfval)) LinAlg_AddVectorProdVectorDouble(b, mm1, val, b) ; } } } void Operation_Update(struct DefineSystem * DefineSystem_P, struct DofData * DofData_P, struct DofData * DofData_P0, int TimeFunctionIndex) { int i, i_TimeStep ; struct Solution * Solution_P, Solution_S ; struct Value Value ; static gVector TmpVect ; static double coef[9] ; static double Save_Num, Save_DTime, Save_Theta, Save_Beta, Save_Gamma ; if (!DofData_P->Solutions) Message::Error("No initialized solution available for update") ; i_TimeStep = (int)Current.TimeStep ; if (!(Solution_P = (struct Solution*) List_PQuery(DofData_P->Solutions, &i_TimeStep, fcmp_int))) { Solution_S.TimeStep = (int)Current.TimeStep ; Solution_S.Time = Current.Time ; Solution_S.TimeImag = Current.TimeImag ; Solution_S.TimeFunctionValues = Get_TimeFunctionValues(DofData_P); if(TimeFunctionIndex >= 0){ Get_ValueOfExpressionByIndex(TimeFunctionIndex, NULL, 0., 0., 0., &Value) ; Solution_S.ExplicitTimeFunctionValue = Value.Val[0] ; } Solution_S.SolutionExist = 1 ; LinAlg_CreateVector(&Solution_S.x, &DofData_P->Solver, DofData_P->NbrDof) ; LinAlg_ZeroVector(&Solution_S.x) ; List_Add(DofData_P->Solutions, &Solution_S) ; DofData_P->CurrentSolution = (struct Solution*) List_Pointer(DofData_P->Solutions, List_Nbr(DofData_P->Solutions)-1) ; } else if (Solution_P != DofData_P->CurrentSolution) { Message::Error("Incompatible time") ; } switch (Current.TypeTime) { case TIME_THETA : if(!DofData_P->Flag_Init[1] && !DofData_P->Flag_Init[2]) Message::Error("No system available for Update") ; if(!Init_Update){ Init_Update = 1; /* bidouillage provisoire : a revoir qd les conditions initiales multiples seront mieux traitees */ Current.Time -= Current.DTime ; Current.TimeStep -= 1. ; if(TimeFunctionIndex >= 0){ Get_ValueOfExpressionByIndex(TimeFunctionIndex, NULL, 0., 0., 0., &Value) ; (DofData_P->CurrentSolution-1)->ExplicitTimeFunctionValue = Value.Val[0] ; } Current.Time += Current.DTime ; Current.TimeStep += 1. ; /* */ LinAlg_CreateVector(&TmpVect, &DofData_P->Solver, DofData_P->NbrDof) ; Save_Num = DofData_P->Num ; Save_DTime = Current.DTime ; Save_Theta = Current.Theta ; Cal_ThetaCoefficients(coef) ; Cal_ThetaMatrix(DofData_P->Flag_Init, coef, &DofData_P->M1, &DofData_P->M2, &DofData_P->A) ; LinAlg_AssembleMatrix(&DofData_P->A) ; } if(Save_Num != DofData_P->Num || Current.DTime != Save_DTime || Current.Theta != Save_Theta){ Save_Num = DofData_P->Num ; Save_DTime = Current.DTime ; Save_Theta = Current.Theta ; Cal_ThetaCoefficients(coef) ; Cal_ThetaMatrix(DofData_P->Flag_Init, coef, &DofData_P->M1, &DofData_P->M2, &DofData_P->A) ; LinAlg_AssembleMatrix(&DofData_P->A) ; } Cal_ThetaRHS(DofData_P->Flag_Init, coef, &DofData_P->M1, &DofData_P->M2, &DofData_P->m1, &DofData_P->m2, DofData_P->m1s, DofData_P->m2s, &TmpVect, &DofData_P->b, (TimeFunctionIndex >= 0)); LinAlg_AssembleVector(&DofData_P->b) ; break ; case TIME_NEWMARK : if(!DofData_P->Flag_Init[1] && !DofData_P->Flag_Init[2] && !DofData_P->Flag_Init[3]) Message::Error("No system available for Update") ; if(!Init_Update){ Init_Update = 1; /* bidouillage provisoire : a revoir qd les conditions initiales multiples seront mieux traitees */ Current.Time -= Current.DTime ; Current.TimeStep -= 1. ; if(TimeFunctionIndex >= 0){ Get_ValueOfExpressionByIndex(TimeFunctionIndex, NULL, 0., 0., 0., &Value) ; (DofData_P->CurrentSolution-1)->ExplicitTimeFunctionValue = Value.Val[0] ; (DofData_P->CurrentSolution-2)->ExplicitTimeFunctionValue = Value.Val[0] ; } Current.Time += Current.DTime ; Current.TimeStep += 1. ; /* */ LinAlg_CreateVector(&TmpVect, &DofData_P->Solver, DofData_P->NbrDof) ; Save_Num = DofData_P->Num ; Save_DTime = Current.DTime ; Save_Beta = Current.Beta ; Save_Gamma = Current.Gamma ; Cal_NewmarkCoefficients(coef) ; Cal_NewmarkMatrix(DofData_P->Flag_Init, coef, &DofData_P->M1, &DofData_P->M2, &DofData_P->M3, &DofData_P->A) ; LinAlg_AssembleMatrix(&DofData_P->A) ; } if(Save_Num != DofData_P->Num || Current.DTime != Save_DTime || Current.Beta != Save_Beta || Current.Gamma != Save_Gamma){ Save_Num = DofData_P->Num ; Save_DTime = Current.DTime ; Save_Beta = Current.Beta ; Save_Gamma = Current.Gamma ; Cal_NewmarkCoefficients(coef) ; Cal_NewmarkMatrix(DofData_P->Flag_Init, coef, &DofData_P->M1, &DofData_P->M2, &DofData_P->M3, &DofData_P->A) ; LinAlg_AssembleMatrix(&DofData_P->A) ; } Cal_NewmarkRHS(DofData_P->Flag_Init, coef, &DofData_P->M1, &DofData_P->M2, &DofData_P->M3, &DofData_P->m1, &DofData_P->m2, &DofData_P->m3, DofData_P->m1s, DofData_P->m2s, DofData_P->m3s, &TmpVect, &DofData_P->b, (TimeFunctionIndex >= 0)); LinAlg_AssembleVector(&DofData_P->b) ; break ; default : Message::Error("Wrong type of analysis for update") ; } LinAlg_GetVectorSize(&DofData_P->b, &i) ; if(!i) Message::Error("Generated system is of dimension zero"); Free_UnusedSolutions(DofData_P); } getdp-2.7.0-source/Legacy/Gauss_Pyramid.cpp000644 001750 001750 00000001235 12473553042 022266 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "Gauss_Pyramid.h" #include "Message.h" /* Gauss integration over a pyramid */ void Gauss_Pyramid(int Nbr_Points, int Num, double *u, double *v, double *w, double *wght) { switch (Nbr_Points) { case 8 : *u = upyr8[Num]; *v = vpyr8[Num]; *w = wpyr8[Num]; *wght = ppyr8[Num]; break ; default : Message::Error("Wrong number of Gauss points for Pyramid: " "valid choice: 8"); break; } } getdp-2.7.0-source/Legacy/Operation_PostOperation.cpp000644 001750 001750 00000026455 12473553042 024360 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // #include #include #include #include #include "GetDPConfig.h" #include "ProData.h" #include "DofData.h" #include "SolvingOperations.h" #include "SolvingAnalyse.h" #include "Message.h" #include "MallocUtils.h" extern struct CurrentData Current; extern struct Problem Problem_S; /* ------------------------------------------------------------------------ */ /* O p e r a t i o n _ P o s t O p e r a t i o n */ /* ------------------------------------------------------------------------ */ void Operation_PostOperation(Resolution *Resolution_P, DofData *DofData_P0, GeoData *GeoData_P0, List_T *PostOperationNames) { double Save_Time, Save_TimeImag, Save_TimeStep; char *str; int i, j, k; Element *Save_Element; PostOperation *PostOperation_P; PostProcessing *PostProcessing_P ; Save_Time = Current.Time ; Save_TimeImag = Current.TimeImag ; Save_TimeStep = Current.TimeStep ; Save_Element = Current.Element; for(int i=0 ; iPostProcessingIndex) ; Current.PostOpDataIndex = i; Treatment_PostOperation(Resolution_P, DofData_P0, (struct DefineSystem *)List_Pointer(Resolution_P->DefineSystem, 0), GeoData_P0, PostProcessing_P, PostOperation_P) ; } } /* the post-processing can (and usually will) change the current timestep, current time and current solution pointers: we need to reset them */ Current.Time = Save_Time ; Current.TimeImag = Save_TimeImag ; Current.TimeStep = Save_TimeStep ; for (k = 0 ; k < Current.NbrSystem ; k++){ i = List_Nbr((Current.DofData_P0+k)->Solutions) - 1; if(i >= 0) (Current.DofData_P0+k)->CurrentSolution = (struct Solution*) List_Pointer((Current.DofData_P0+k)->Solutions, i); } Current.Element = Save_Element; Current.PostOpDataIndex = -1; } /* ------------------------------------------------------------------------ */ /* I n i t L E P o s t O p e r a t i o n */ /* ------------------------------------------------------------------------ */ void InitLEPostOperation(Resolution *Resolution_P, DofData *DofData_P0, GeoData *GeoData_P0, List_T *LEPostOp_L, List_T *LEPostOpNames_L, List_T *PostOpSolution_L) { int NbrPostOps, Index, NbrPostSubOperation, PostOpSolLength; int *Save_Format_P, *Save_LastTimeStepOnly_P; char **Save_FileOut_P; PostOpSolutions *PostOpSolutions_P, PostOpSolutions_S; LoopErrorPostOperation *LEPostOp_P; PostSubOperation *PostSubOperation_P; List_T *PostSubOperation_L; gVector PostOpSolution_S; Current.PostOpData_L = NULL; NbrPostOps = List_Nbr(LEPostOp_L); if (NbrPostOps) { Current.PostOpData_L = List_Create(NbrPostOps,1,sizeof(PostOpSolutions)); for (int i=0; i < NbrPostOps; i++) { LEPostOp_P = (struct LoopErrorPostOperation*)List_Pointer(LEPostOp_L, i); Index = List_ISearchSeq(Problem_S.PostOperation, LEPostOp_P->PostOperationName, fcmp_PostOperation_Name); LEPostOp_P->PostOperationIndex = Index; if(Index < 0) Message::Error("Unknown PostOperation %s in TimeLoopAdaptive", LEPostOp_P->PostOperationName); PostOpSolutions_S.PostOperation_P = (struct PostOperation*) List_Pointer(Problem_S.PostOperation, Index) ; PostSubOperation_L = PostOpSolutions_S.PostOperation_P->PostSubOperation; NbrPostSubOperation = List_Nbr(PostSubOperation_L); if (NbrPostSubOperation) { LEPostOp_P->Save_Format_L = List_Create(NbrPostSubOperation,2, sizeof(int)); LEPostOp_P->Save_LastTimeStepOnly_L = List_Create(NbrPostSubOperation, 2,sizeof(int)); LEPostOp_P->Save_FileOut_L = List_Create(NbrPostSubOperation, 2,sizeof(char *)); } for (int j=0; jFormat; Save_LastTimeStepOnly_P = &PostSubOperation_P->LastTimeStepOnly; Save_FileOut_P = &PostSubOperation_P->FileOut; List_Add(LEPostOp_P->Save_Format_L, Save_Format_P); List_Add(LEPostOp_P->Save_LastTimeStepOnly_L, Save_LastTimeStepOnly_P); List_Add(LEPostOp_P->Save_FileOut_L, Save_FileOut_P); *Save_Format_P = FORMAT_LOOP_ERROR; *Save_LastTimeStepOnly_P = 1; *Save_FileOut_P = NULL; } PostOpSolutions_S.Solutions_L = List_Create(2,2,sizeof(Solution)); List_Add(Current.PostOpData_L, &PostOpSolutions_S); List_Add(LEPostOpNames_L, &LEPostOp_P->PostOperationName); } // Execute the PostOperations Operation_PostOperation(Resolution_P, DofData_P0, GeoData_P0, LEPostOpNames_L); // Creating vectors for the PostOperation-solution for (int i=0; i < NbrPostOps; i++) { PostOpSolutions_P = (struct PostOpSolutions*) List_Pointer(Current.PostOpData_L, i); LinAlg_GetVectorSize (&((struct Solution*)List_Pointer(PostOpSolutions_P->Solutions_L, 0))->x, &PostOpSolLength); LinAlg_CreateVector(&PostOpSolution_S, &DofData_P0->Solver, PostOpSolLength); List_Add(PostOpSolution_L, &PostOpSolution_S); } } } /* ------------------------------------------------------------------------ */ /* F r e e _ U n u s e d P o s t O p e r a t i o n R e s u l t s */ /* ------------------------------------------------------------------------ */ void Free_UnusedPOresults() { struct Solution *Solution_P; int index = -1; PostOpSolutions *PostOpSolutions_P; for(int i = 0; i < List_Nbr(Current.PostOpData_L); i++) { PostOpSolutions_P = (struct PostOpSolutions*) List_Pointer(Current.PostOpData_L, i); // We store 1 solution too much (to allow for an imbricated iterative loop) switch (Current.TypeTime) { case TIME_THETA : index = List_Nbr(PostOpSolutions_P->Solutions_L)-4 ; // Fore TimeLoopAdaptive (Trapezoidal) we need 3 past solutions for the predictor index = Message::GetOperatingInTimeLoopAdaptive() ? index - 1 : index; break; case TIME_GEAR : // With -9 we store 7 past solutions (for Gear_6) index = List_Nbr(PostOpSolutions_P->Solutions_L)-9 ; break; case TIME_NEWMARK : index = List_Nbr(PostOpSolutions_P->Solutions_L)-4 ; break; } if(index >= 0){ Solution_P = (struct Solution*) List_Pointer(PostOpSolutions_P->Solutions_L, index); if(Solution_P->SolutionExist){ Message::Info("Freeing PostOperationResult %d", index); LinAlg_DestroyVector(&Solution_P->x); if (Solution_P->TimeFunctionValues) Free(Solution_P->TimeFunctionValues); Solution_P->SolutionExist = 0 ; } } } } /* ------------------------------------------------------------------------ */ /* F r e e _ A l l P o s t O p e r a t i o n R e s u l t s */ /* ------------------------------------------------------------------------ */ void Free_AllPOresults() { PostOpSolutions *PostOpSolutions_P; Solution *Solution_P; for (int i=0; i < List_Nbr(Current.PostOpData_L); i++) { PostOpSolutions_P = (struct PostOpSolutions*)List_Pointer(Current.PostOpData_L, i); for (int j=0; j < List_Nbr(PostOpSolutions_P->Solutions_L); j++) { Solution_P = (struct Solution*)List_Pointer(PostOpSolutions_P->Solutions_L, j); if (Solution_P->SolutionExist) LinAlg_DestroyVector(&Solution_P->x); if (Solution_P->TimeFunctionValues) Free(Solution_P->TimeFunctionValues); } List_Delete(PostOpSolutions_P->Solutions_L); } List_Delete(Current.PostOpData_L); Current.PostOpData_L = NULL; Current.PostOpDataIndex = -1; } /* ------------------------------------------------------------------------ */ /* C l e a r L E P o s t O p e r a t i o n */ /* ------------------------------------------------------------------------ */ void ClearLEPostOperation(Resolution *Resolution_P, DofData *DofData_P0, GeoData *GeoData_P0, List_T *LEPostOp_L, List_T *LEPostOpNames_L, List_T *PostOpSolution_L, bool Delete_LEPostOp_L) { int Index, NbrPostSubOperation; int *Format_P, *LastTimeStepOnly_P; char **FileOut_P; LoopErrorPostOperation *LEPostOp_P; PostSubOperation *PostSubOperation_P; List_T *PostSubOperation_L; for(int i = 0; i < List_Nbr(LEPostOp_L); i++) { LEPostOp_P = (struct LoopErrorPostOperation*)List_Pointer(LEPostOp_L, i); NbrPostSubOperation = List_Nbr(LEPostOp_P->Save_Format_L); Index = LEPostOp_P->PostOperationIndex; PostSubOperation_L = ((struct PostOperation*) List_Pointer(Problem_S.PostOperation, Index)) ->PostSubOperation; // Restore variables Format, LastTimeStepOnly and FileOut of all used PostOperations for (int j=0; jFormat; LastTimeStepOnly_P = &PostSubOperation_P->LastTimeStepOnly; FileOut_P = &PostSubOperation_P->FileOut; List_Read(LEPostOp_P->Save_Format_L, j, Format_P); List_Read(LEPostOp_P->Save_LastTimeStepOnly_L, j, LastTimeStepOnly_P); List_Read(LEPostOp_P->Save_FileOut_L, j, FileOut_P); } if (Delete_LEPostOp_L) free(LEPostOp_P->PostOperationName); LinAlg_DestroyVector((gVector*)List_Pointer(PostOpSolution_L, i)); } if (Delete_LEPostOp_L) List_Delete(LEPostOp_L); List_Delete(PostOpSolution_L); Free_AllPOresults(); List_Delete(LEPostOpNames_L); } getdp-2.7.0-source/Legacy/Cal_GlobalTermOfFemEquation.cpp000644 001750 001750 00000026333 12473553042 024757 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "ProData.h" #include "GeoData.h" #include "DofData.h" #include "Cal_Quantity.h" #include "Cal_Value.h" #include "Cal_AssembleTerm.h" #include "Get_DofOfElement.h" #include "Get_Geometry.h" #include "Message.h" extern struct Problem Problem_S ; extern struct CurrentData Current ; /* ------------------------------------------------------------------------ */ /* C a l _ G l o b a l T e r m O f F e m F o r m u l a t i o n */ /* ------------------------------------------------------------------------ */ #define OFFSET (iHar < NbrHar-OffSet)? 0 : iHar-NbrHar+OffSet+2-iHar%2 void MH_Get_InitData(int Case, int NbrPoints, int *NbrPointsX_P, double ***H_P, double ****HH_P, double **t_P, double **w_P); void Cal_GlobalTermOfFemEquation(int Num_Region, struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0, struct QuantityStorage * QuantityStorageNoDof, struct Dof * DofForNoDof_P) { struct QuantityStorage * QuantityStorageEqu_P, * QuantityStorageDof_P ; struct Value vBFxDof [1] ; struct Element Element ; int k ; double Coefficient [NBR_MAX_HARMONIC] ; void (*Function_AssembleTerm)(struct Dof * Equ, struct Dof * Dof, double Val[])=0 ; List_T * WholeQuantity_L; struct WholeQuantity *WholeQuantity_P0 ; int i_WQ ; struct Expression * Expression_P; int NbrPointsX ; double **H, ***HH, *time, *weight, Factor=1., plus, plus0; double one=1.0 ; int j=0,iPul, ZeroHarmonic, DcHarmonic; int NbrHar, iTime, iHar, jHar, OffSet=0 ; double Val_Dof [NBR_MAX_HARMONIC] ; double E_D [NBR_MAX_HARMONIC][NBR_MAX_HARMONIC] ; struct Dof * Dof; struct Value t_Value; gMatrix * Jac; struct QuantityStorage * QuantityStorage_P; Element.Num = NO_ELEMENT ; switch (EquationTerm_P->Case.GlobalTerm.Term.TypeTimeDerivative) { case NODT_ : Function_AssembleTerm = Cal_AssembleTerm_NoDt ; break ; case DTDOF_ : Function_AssembleTerm = Cal_AssembleTerm_DtDof ; break ; case DT_ : Function_AssembleTerm = Cal_AssembleTerm_Dt ; break ; case DTDTDOF_ : Function_AssembleTerm = Cal_AssembleTerm_DtDtDof ; break ; case DTDT_ : Function_AssembleTerm = Cal_AssembleTerm_DtDt ; break ; case DTDTDTDOF_ : Function_AssembleTerm = Cal_AssembleTerm_DtDtDtDof ; break ; case DTDTDTDTDOF_ : Function_AssembleTerm = Cal_AssembleTerm_DtDtDtDtDof ; break ; case DTDTDTDTDTDOF_ : Function_AssembleTerm = Cal_AssembleTerm_DtDtDtDtDtDof ; break ; case NEVERDT_ : Function_AssembleTerm = Cal_AssembleTerm_NeverDt ; break ; case JACNL_ : Function_AssembleTerm = Cal_AssembleTerm_JacNL ; break ; case DTDOFJACNL_ : Function_AssembleTerm = Cal_AssembleTerm_DtDofJacNL ; break ; default : Message::Error("Unknown type of operator for Global term"); return; } QuantityStorageEqu_P = QuantityStorage_P0 + EquationTerm_P->Case.GlobalTerm.Term.DefineQuantityIndexEqu ; if (EquationTerm_P->Case.GlobalTerm.Term.DefineQuantityIndexDof >= 0) { QuantityStorageDof_P = QuantityStorage_P0 + EquationTerm_P->Case.GlobalTerm.Term.DefineQuantityIndexDof ; } else { QuantityStorageDof_P = QuantityStorageNoDof ; Dof_InitDofForNoDof(DofForNoDof_P, Current.NbrHar) ; QuantityStorageDof_P->BasisFunction[0].Dof = DofForNoDof_P ; } /* search for MHJacNL-term(s) */ WholeQuantity_L = EquationTerm_P->Case.GlobalTerm.Term.WholeQuantity ; WholeQuantity_P0 = (struct WholeQuantity*)List_Pointer(WholeQuantity_L, 0) ; i_WQ = 0 ; while ( i_WQ < List_Nbr(WholeQuantity_L) && (WholeQuantity_P0 + i_WQ)->Type != WQ_MHJACNL) i_WQ++ ; if (i_WQ < List_Nbr(WholeQuantity_L) ) { if(Message::GetVerbosity() == 10) Message::Info("MHJacNL in Global term"); if (QuantityStorageEqu_P != QuantityStorageDof_P){ Message::Error("Global term with MHJacNL is not symmetric ?!"); return; } QuantityStorage_P = QuantityStorageEqu_P ; if (List_Nbr(WholeQuantity_L) == 4){ if (i_WQ != 1 || EquationTerm_P->Case.GlobalTerm.Term.DofIndexInWholeQuantity != 2 || (WholeQuantity_P0 + 3)->Type != WQ_BINARYOPERATOR || (WholeQuantity_P0 + 3)->Case.Operator.TypeOperator != OP_TIME){ Message::Error("Not allowed expression in Global term with MHJacNL (case 1)"); return; } Factor = 1.; } else if (List_Nbr(WholeQuantity_L) == 6){ if ((WholeQuantity_P0 + 0)->Type != WQ_CONSTANT || i_WQ != 2 || (WholeQuantity_P0 + 3)->Type != WQ_BINARYOPERATOR || (WholeQuantity_P0 + 3)->Case.Operator.TypeOperator != OP_TIME || EquationTerm_P->Case.GlobalTerm.Term.DofIndexInWholeQuantity != 3 || (WholeQuantity_P0 + 5)->Type != WQ_BINARYOPERATOR || (WholeQuantity_P0 + 5)->Case.Operator.TypeOperator != OP_TIME){ Message::Error("Not allowed expression in Global term with MHJacNL (case 2)"); return; } Factor = WholeQuantity_P0->Case.Constant ; } else { Message::Error("Not allowed expression in Global term with MHJacNL (%d terms) ", List_Nbr(WholeQuantity_L)); return; } if (EquationTerm_P->Case.GlobalTerm.Term.TypeTimeDerivative != JACNL_){ Message::Error("MHJacNL can only be used with JACNL") ; return; } Expression_P = (struct Expression *)List_Pointer (Problem_S.Expression, (WholeQuantity_P0 + i_WQ)->Case.MHJacNL.Index) ; MH_Get_InitData(2, (WholeQuantity_P0 + i_WQ)->Case.MHJacNL.NbrPoints, &NbrPointsX, &H, &HH, &time, &weight) ; NbrHar = Current.NbrHar ; /* special treatment of DC-term and associated dummy sinus-term */ DcHarmonic = NbrHar; ZeroHarmonic = 0; for (iPul = 0 ; iPul < NbrHar/2 ; iPul++) if (!Current.DofData->Val_Pulsation[iPul]){ DcHarmonic = 2*iPul ; ZeroHarmonic = 2*iPul+1 ; break; } for (k = 0 ; k < Current.NbrHar ; k+=2) Dof_GetComplexDofValue (QuantityStorage_P->FunctionSpace->DofData, QuantityStorage_P->BasisFunction[j].Dof + k/2*gCOMPLEX_INCREMENT, &Val_Dof[k], &Val_Dof[k+1]) ; /* time integration over fundamental period */ for (iHar = 0 ; iHar < NbrHar ; iHar++) for (jHar = OFFSET ; jHar <= iHar ; jHar++) E_D[iHar][jHar] = 0. ; Current.NbrHar = 1; /* evaluation in time domain */ for (iTime = 0 ; iTime < NbrPointsX ; iTime++) { t_Value.Type = SCALAR; t_Value.Val[0] = 0; for (iHar = 0 ; iHar < NbrHar ; iHar++) t_Value.Val[0] += H[iTime][iHar] * Val_Dof[iHar] ; Get_ValueOfExpression(Expression_P, QuantityStorage_P0, Current.u, Current.v, Current.w, &t_Value, 1); //To generalize: Function in MHJacNL has 1 argument (e.g. Resistance[{Iz}]) for (iHar = 0 ; iHar < NbrHar ; iHar++) for (jHar = OFFSET ; jHar <= iHar ; jHar++) E_D[iHar][jHar] += HH[iTime][iHar][jHar] * t_Value.Val[0] ; } /* for i_IntPoint ... */ Current.NbrHar = NbrHar ; Jac = &Current.DofData->Jac; Dof = QuantityStorage_P->BasisFunction[0].Dof ; for (iHar = 0 ; iHar < NbrHar ; iHar++) for (jHar = OFFSET ; jHar <= iHar ; jHar++){ plus = plus0 = Factor * E_D[iHar][jHar] ; if(jHar==DcHarmonic && iHar!=DcHarmonic) { plus0 *= 1. ; plus *= 2. ;} Dof_AssembleInMat(Dof+iHar, Dof+jHar, 1, &plus, Jac, NULL) ; if(iHar != jHar) Dof_AssembleInMat(Dof+jHar, Dof+iHar, 1, &plus0, Jac, NULL) ; } /* dummy 1's on the diagonal for sinus-term of dc-component */ if (ZeroHarmonic) { Dof = QuantityStorage_P->BasisFunction[0].Dof + ZeroHarmonic ; Dof_AssembleInMat(Dof, Dof, 1, &one, Jac, NULL) ; } } else { vBFxDof[0].Type = SCALAR ; vBFxDof[0].Val[0] = 1. ; if(Current.NbrHar > 1) Cal_SetHarmonicValue(&vBFxDof[0]) ; Cal_WholeQuantity (Current.Element = &Element, QuantityStorage_P0, EquationTerm_P->Case.GlobalTerm.Term.WholeQuantity, Current.u = 0., Current.v = 0., Current.w = 0., EquationTerm_P->Case.GlobalTerm.Term.DofIndexInWholeQuantity, 1, vBFxDof) ; for (k = 0 ; k < Current.NbrHar ; k++) Coefficient[k] = vBFxDof[0].Val[MAX_DIM*k] ; Function_AssembleTerm (QuantityStorageEqu_P->BasisFunction[0].Dof, QuantityStorageDof_P->BasisFunction[0].Dof, Coefficient) ; } } #undef OFFSET void Cal_GlobalTermOfFemEquation_old(int Num_Region, struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0, struct QuantityStorage * QuantityStorageNoDof, struct Dof * DofForNoDof_P) { struct QuantityStorage * QuantityStorageEqu_P, * QuantityStorageDof_P ; struct Value vBFxDof [1] ; struct Element Element ; int k ; double Coefficient [NBR_MAX_HARMONIC] ; void (*Function_AssembleTerm)(struct Dof * Equ, struct Dof * Dof, double Val[]) = 0; Element.Num = NO_ELEMENT ; switch (EquationTerm_P->Case.GlobalTerm.Term.TypeTimeDerivative) { case NODT_ : Function_AssembleTerm = Cal_AssembleTerm_NoDt ; break ; case DTDOF_ : Function_AssembleTerm = Cal_AssembleTerm_DtDof ; break ; case DT_ : Function_AssembleTerm = Cal_AssembleTerm_Dt ; break ; case DTDTDOF_ : Function_AssembleTerm = Cal_AssembleTerm_DtDtDof ; break ; case DTDT_ : Function_AssembleTerm = Cal_AssembleTerm_DtDt ; break ; case DTDTDTDOF_ : Function_AssembleTerm = Cal_AssembleTerm_DtDtDtDof ; break ; case DTDTDTDTDOF_ : Function_AssembleTerm = Cal_AssembleTerm_DtDtDtDtDof ; break ; case DTDTDTDTDTDOF_: Function_AssembleTerm = Cal_AssembleTerm_DtDtDtDtDtDof ; break ; case NEVERDT_ : Function_AssembleTerm = Cal_AssembleTerm_NeverDt ; break ; case JACNL_ : Function_AssembleTerm = Cal_AssembleTerm_JacNL ; break ; case DTDOFJACNL_ : Function_AssembleTerm = Cal_AssembleTerm_DtDofJacNL ; break ; default : Message::Error("Unknown type of operator for Global term") ; return ; } QuantityStorageEqu_P = QuantityStorage_P0 + EquationTerm_P->Case.GlobalTerm.Term.DefineQuantityIndexEqu ; if (EquationTerm_P->Case.GlobalTerm.Term.DefineQuantityIndexDof >= 0) { QuantityStorageDof_P = QuantityStorage_P0 + EquationTerm_P->Case.GlobalTerm.Term.DefineQuantityIndexDof ; } else { QuantityStorageDof_P = QuantityStorageNoDof ; Dof_InitDofForNoDof(DofForNoDof_P, Current.NbrHar) ; QuantityStorageDof_P->BasisFunction[0].Dof = DofForNoDof_P ; } vBFxDof[0].Type = SCALAR ; vBFxDof[0].Val[0] = 1. ; if(Current.NbrHar > 1) Cal_SetHarmonicValue(&vBFxDof[0]) ; Cal_WholeQuantity (Current.Element = &Element, QuantityStorage_P0, EquationTerm_P->Case.GlobalTerm.Term.WholeQuantity, Current.u = 0., Current.v = 0., Current.w = 0., EquationTerm_P->Case.GlobalTerm.Term.DofIndexInWholeQuantity, 1, vBFxDof) ; for (k = 0 ; k < Current.NbrHar ; k++) Coefficient[k] = vBFxDof[0].Val[MAX_DIM*k] ; Function_AssembleTerm (QuantityStorageEqu_P->BasisFunction[0].Dof, QuantityStorageDof_P->BasisFunction[0].Dof, Coefficient) ; } getdp-2.7.0-source/Legacy/Generate_Network.h000644 001750 001750 00000000617 12473553042 022432 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _GENERATE_NETWORK_H_ #define _GENERATE_NETWORK_H_ #include "ProData.h" struct ConstraintActive * Generate_Network(char *Name, List_T * ConstraintPerRegion_L); #endif getdp-2.7.0-source/Legacy/BF_Edge.cpp000644 001750 001750 00000030412 12473553042 020731 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Christophe Trophime // #include "ProData.h" #include "Message.h" #define SQU(a) ((a)*(a)) #define NoEdge Message::Error("Missing Edge Entity in Element %d", Element->Num) /* ------------------------------------------------------------------------ */ /* B F _ E d g e */ /* ------------------------------------------------------------------------ */ #define WrongNumEdge Message::Error("Wrong Edge number in 'BF_Edge'") void BF_Edge(struct Element * Element, int NumEdge, double u, double v, double w, double s[]) { switch (Element->Type) { case LINE : switch(NumEdge) { case 1 : s[0] = 0.5 ; s[1] = 0. ; s[2] = 0. ; break ; default : WrongNumEdge ; } break ; case TRIANGLE : switch(NumEdge) { case 1 : s[0] = 1.-v ; s[1] = u ; s[2] = 0. ; break ; case 2 : s[0] = v ; s[1] = 1.-u ; s[2] = 0. ; break ; case 3 : s[0] = -v ; s[1] = u ; s[2] = 0. ; break ; default : WrongNumEdge ; } break ; case QUADRANGLE : switch(NumEdge) { case 1 : s[0] = 0.25 * (1.-v) ; s[1] = 0. ; s[2] = 0. ; break ; case 2 : s[0] = 0. ; s[1] = 0.25 * (1.-u) ; s[2] = 0. ; break ; case 3 : s[0] = 0. ; s[1] = 0.25 * (1.+u) ; s[2] = 0. ; break ; case 4 : s[0] = -0.25 * (1.+v) ; s[1] = 0. ; s[2] = 0. ; break ; default : WrongNumEdge ; } break ; case TETRAHEDRON : switch(NumEdge) { case 1 : s[0] = 1.-v-w ; s[1] = u ; s[2] = u ; break ; case 2 : s[0] = v ; s[1] = 1.-u-w ; s[2] = v ; break ; case 3 : s[0] = w ; s[1] = w ; s[2] = 1.-u-v ; break ; case 4 : s[0] = -v ; s[1] = u ; s[2] = 0. ; break ; case 5 : s[0] = -w ; s[1] = 0. ; s[2] = u ; break ; case 6 : s[0] = 0. ; s[1] = -w ; s[2] = v ; break ; default : WrongNumEdge ; } break ; case HEXAHEDRON : switch(NumEdge) { case 1 : s[0] = 0.125 * (1.-v) * (1.-w) ; s[1] = 0. ; s[2] = 0. ; break ; case 6 : s[0] = -0.125 * (1.+v) * (1.-w) ; s[1] = 0. ; s[2] = 0. ; break ; case 9 : s[0] = 0.125 * (1.-v) * (1.+w) ; s[1] = 0. ; s[2] = 0. ; break ; case 12 : s[0] = -0.125 * (1.+v) * (1.+w) ; s[1] = 0. ; s[2] = 0. ; break ; case 2 : s[0] = 0. ; s[1] = 0.125 * (1.-u) * (1.-w) ; s[2] = 0. ; break ; case 4 : s[0] = 0. ; s[1] = 0.125 * (1.+u) * (1.-w) ; s[2] = 0. ; break ; case 10 : s[0] = 0. ; s[1] = 0.125 * (1.-u) * (1.+w) ; s[2] = 0. ; break ; case 11 : s[0] = 0. ; s[1] = 0.125 * (1.+u) * (1.+w) ; s[2] = 0. ; break ; case 3 : s[0] = 0. ; s[1] = 0. ; s[2] = 0.125 * (1.-u) * (1.-v) ; break ; case 5 : s[0] = 0. ; s[1] = 0. ; s[2] = 0.125 * (1.+u) * (1.-v) ; break ; case 7 : s[0] = 0. ; s[1] = 0. ; s[2] = 0.125 * (1.+u) * (1.+v) ; break ; case 8 : s[0] = 0. ; s[1] = 0. ; s[2] = 0.125 * (1.-u) * (1.+v) ; break ; default : WrongNumEdge ; } break ; case PRISM : switch(NumEdge) { case 1 : s[0] = 0.5 * (1.-v) * (1.-w) ; s[1] = 0.5 * u * (1.-w) ; s[2] = 0. ; break ; case 2 : s[0] = 0.5 * v * (1.-w) ; s[1] = 0.5 * (1.-u) * (1.-w) ; s[2] = 0. ; break ; case 3 : s[0] = 0. ; s[1] = 0. ; s[2] = 0.5 * (1.-u-v) ; break ; case 4 : s[0] = -0.5 * v * (1.-w) ; s[1] = 0.5 * u * (1.-w) ; s[2] = 0. ; break ; case 5 : s[0] = 0. ; s[1] = 0. ; s[2] = 0.5 * u ; break ; case 6 : s[0] = 0. ; s[1] = 0. ; s[2] = 0.5 * v ; break ; case 7 : s[0] = 0.5 * (1.-v) * (1.+w) ; s[1] = 0.5 * u * (1.+w) ; s[2] = 0. ; break ; case 8 : s[0] = 0.5 * v * (1.+w) ; s[1] = 0.5 * (1.-u) * (1.+w) ; s[2] = 0. ; break ; case 9 : s[0] = -0.5 * v * (1.+w) ; s[1] = 0.5 * u * (1.+w) ; s[2] = 0. ; break ; default : WrongNumEdge ; } break ; case PYRAMID : if (w != 1){ switch(NumEdge) { case 1 : s[0] = 0.25 * (1 - v - w) ; s[1] = 0. ; s[2] = 0.25 * (u - u * v / (1. - w)) ; break ; case 2 : s[0] = 0. ; s[1] = 0.25 * (1 - u - w) ; s[2] = 0.25 * (v - u * v / (1. - w)) ; break ; case 4 : s[0] = 0. ; s[1] = 0.25 * (1 + u - w) ; s[2] = 0.25 * (v + u * v / (1. - w)) ; break ; case 6 : s[0] = -0.25 * (1 + v - w) ; s[1] = 0. ; s[2] = -0.25 * (u + u * v / (1. - w)) ; break ; case 3 : s[0] = 0.25 * (w - v * w / (1. - w)) ; s[1] = 0.25 * (w - u * w / (1. - w)) ; s[2] = 0.25 * (1. - u - v + u * v / SQU(1. - w) - 2 * u * v * w / SQU(1. - w)) ; break ; case 5 : s[0] = -0.25 * (w - v * w / (1. - w)) ; s[1] = 0.25 * (w + u * w / (1. - w)) ; s[2] = 0.25 * (1. + u - v - u * v / SQU(1. - w) + 2 * u * v * w / SQU(1. - w)) ; break ; case 7 : s[0] = -0.25 * (w + v * w / (1. - w)) ; s[1] = -0.25 * (w + u * w / (1. - w)) ; s[2] = 0.25 * (1. + u + v + u * v / SQU(1. - w) - 2 * u * v * w / SQU(1. - w)) ; break ; case 8 : s[0] = 0.25 * (w + v * w / (1. - w)) ; s[1] = -0.25 * (w - u * w / (1. - w)) ; s[2] = 0.25 * (1. - u + v - u * v / SQU(1. - w) + 2 * u * v * w / SQU(1. - w)) ; break ; default : WrongNumEdge ; } } else switch(NumEdge) { case 1 : s[0] = -0.25 * v ; s[1] = 0. ; s[2] = 0.25 * u ; break ; case 2 : s[0] = 0. ; s[1] = -0.25 * u ; s[2] = 0.25 * v ; break ; case 4 : s[0] = 0. ; s[1] = 0.25 * u ; s[2] = 0.25 * v ; break ; case 6 : s[0] = -0.25 * v ; s[1] = 0. ; s[2] = -0.25 * u ; break ; case 3 : s[0] = 0.25 ; s[1] = 0.25 ; s[2] = 0.25 * (1. - u - v) ; break ; case 5 : s[0] = -0.25 ; s[1] = 0.25 ; s[2] = 0.25 * (1. + u - v) ; break ; case 7 : s[0] = -0.25 ; s[1] = -0.25 ; s[2] = 0.25 * (1. + u + v) ; break ; case 8 : s[0] = 0.25 ; s[1] = -0.25 ; s[2] = 0.25 * (1. - u + v) ; break ; default : WrongNumEdge ; } break ; default : Message::Error("Unknown type of Element in BF_Edge"); break; } if (!Element->GeoElement->NumEdges) NoEdge ; if (Element->GeoElement->NumEdges[NumEdge-1] < 0) { s[0] = - s[0] ; s[1] = - s[1] ; s[2] = - s[2] ; } } #undef WrongNumEdge /* ------------------------------------------------------------------------ */ /* B F _ C u r l E d g e */ /* ------------------------------------------------------------------------ */ #define WrongNumEdge Message::Error("Wrong Edge number in 'BF_CurlEdge'") void BF_CurlEdge(struct Element * Element, int NumEdge, double u, double v, double w, double s[]) { switch (Element->Type) { case LINE : switch(NumEdge) { case 1 : s[0] = 0. ; s[1] = 0. ; s[2] = 0. ; break ; default : WrongNumEdge ; } break ; case TRIANGLE : switch(NumEdge) { case 1 : s[0] = 0. ; s[1] = 0. ; s[2] = 2. ; break ; case 2 : s[0] = 0. ; s[1] = 0. ; s[2] = -2. ; break ; case 3 : s[0] = 0. ; s[1] = 0. ; s[2] = 2. ; break ; default : WrongNumEdge ; } break ; case QUADRANGLE : switch(NumEdge) { case 1 : s[0] = 0. ; s[1] = 0. ; s[2] = 0.25 ; break ; case 2 : s[0] = 0. ; s[1] = 0. ; s[2] = -0.25 ; break ; case 3 : s[0] = 0. ; s[1] = 0. ; s[2] = 0.25 ; break ; case 4 : s[0] = 0. ; s[1] = 0. ; s[2] = 0.25 ; break ; default : WrongNumEdge ; } break ; case TETRAHEDRON : switch(NumEdge) { case 1 : s[0] = 0. ; s[1] = -2. ; s[2] = 2. ; break ; case 2 : s[0] = 2. ; s[1] = 0. ; s[2] = -2. ; break ; case 3 : s[0] = -2. ; s[1] = 2. ; s[2] = 0. ; break ; case 4 : s[0] = 0. ; s[1] = 0. ; s[2] = 2. ; break ; case 5 : s[0] = 0. ; s[1] = -2. ; s[2] = 0. ; break ; case 6 : s[0] = 2. ; s[1] = 0. ; s[2] = 0. ; break ; default : WrongNumEdge ; } break ; case HEXAHEDRON : switch(NumEdge) { case 1 : s[0] = 0. ; s[1] = 0.125*(v-1.) ; s[2] = 0.125*(1.-w) ; break ; case 6 : s[0] = 0. ; s[1] = 0.125*(v+1.) ; s[2] = 0.125*(1.-w) ; break ; case 9 : s[0] = 0. ; s[1] = 0.125*(1.-v) ; s[2] = 0.125*(1.+w) ; break ; case 12 : s[0] = 0. ; s[1] =-0.125*(v+1.) ; s[2] = 0.125*(1.+w) ; break ; case 2 : s[0] = 0.125*(1.-u) ; s[1] = 0. ; s[2] = 0.125*(w-1.) ; break ; case 4 : s[0] = 0.125*(1.+u) ; s[1] = 0. ; s[2] = 0.125*(1.-w) ; break ; case 10 : s[0] = 0.125*(u-1.) ; s[1] = 0. ; s[2] =-0.125*(w+1.) ; break ; case 11 : s[0] =-0.125*(1.+u) ; s[1] = 0. ; s[2] = 0.125*(w+1.) ; break ; case 3 : s[0] = 0.125*(u-1.) ; s[1] = 0.125*(1.-v) ; s[2] = 0. ; break ; case 5 : s[0] =-0.125*(u+1.) ; s[1] = 0.125*(v-1.) ; s[2] = 0. ; break ; case 7 : s[0] = 0.125*(u+1.) ; s[1] =-0.125*(1.+v) ; s[2] = 0. ; break ; case 8 : s[0] = 0.125*(1.-u) ; s[1] = 0.125*(1.+v) ; s[2] = 0. ; break ; default : WrongNumEdge ; } break ; case PRISM : switch(NumEdge) { case 1 : s[0] = 0.5*u ; s[1] = 0.5*(v-1.) ; s[2] = 1.-w ; break ; case 2 : s[0] = 0.5*(1.-u) ; s[1] = -0.5*v ; s[2] = w-1. ; break ; case 3 : s[0] = -0.5 ; s[1] = 0.5 ; s[2] = 0. ; break ; case 4 : s[0] = 0.5*u ; s[1] = 0.5*v ; s[2] = 1.-w ; break ; case 5 : s[0] = 0. ; s[1] = -0.5 ; s[2] = 0. ; break ; case 6 : s[0] = 0.5 ; s[1] = 0. ; s[2] = 0. ; break ; case 7 : s[0] = -0.5*u ; s[1] = 0.5*(1.-v) ; s[2] = 1.+w ; break ; case 8 : s[0] = 0.5*(u-1.) ; s[1] = 0.5*v ; s[2] = -1.-w ; break ; case 9 : s[0] = -0.5*u ; s[1] = -0.5*v ; s[2] = 1.+w ; break ; default : WrongNumEdge ; } break ; case PYRAMID : if (w != 1){ switch(NumEdge) { case 1 : s[0] = -0.25 * u / (1. - w) ; s[1] = -0.5 + 0.25 * v / (1. - w) ; s[2] = 0.25 ; break ; case 2 : s[0] = 0.5 - 0.25 * u / (1. - w) ; s[1] = 0.25 * v / (1. - w) ; s[2] = -0.25 ; break ; case 4 : s[0] = 0.5 + 0.25 * u / (1. - w) ; s[1] = -0.25 * v / (1. - w) ; s[2] = 0.25 ; break ; case 6 : s[0] = -0.25 * u / (1. - w) ; s[1] = 0.5 + 0.25 * v / (1. - w) ; s[2] = 0.25 ; break ; case 3 : s[0] = -0.5 * (1. - u / (1. - w)) ; s[1] = 0.5 * (1. - v / (1. - w)) ; s[2] = 0. ; break; case 5 : s[0] = -0.5 * (1. + u / (1. - w)) ; s[1] = -0.5 * (1. - v / (1. - w)) ; s[2] = 0. ; break; case 7 : s[0] = 0.5 * (1. + u / (1. - w)) ; s[1] = -0.5 * (1. + v / (1. - w)) ; s[2] = 0. ; break; case 8 : s[0] = 0.5 * (1. - u / (1. - w)) ; s[1] = 0.5 * (1. + v / (1. - w)) ; s[2] = 0. ; break; default : WrongNumEdge ; } } else { switch(NumEdge) { case 1 : s[0] = 0. ; s[1] = -0.5 ; s[2] = 0.25 ; break ; case 2 : s[0] = 0.5 ; s[1] = 0. ; s[2] = -0.25 ; break ; case 4 : s[0] = 0.5 ; s[1] = 0. ; s[2] = 0.25 ; break ; case 6 : s[0] = 0. ; s[1] = 0.5 ; s[2] = 0.25 ; break ; case 3 : s[0] = -0.5 ; s[1] = 0.5 ; s[2] = 0. ; break; case 5 : s[0] = -0.5 ; s[1] = -0.5 ; s[2] = 0. ; break; case 7 : s[0] = 0.5 ; s[1] = -0.5 ; s[2] = 0. ; break; case 8 : s[0] = 0.5 ; s[1] = 0.5 ; s[2] = 0. ; break; default : WrongNumEdge ; } } break ; default : Message::Error("Unknown type of Element in BF_CurlEdge"); break; } if (!Element->GeoElement->NumEdges) NoEdge ; if (Element->GeoElement->NumEdges[NumEdge-1] < 0) { s[0] = - s[0] ; s[1] = - s[1] ; s[2] = - s[2] ; } } #undef WrongNumEdge #undef NoEdge getdp-2.7.0-source/Legacy/Pos_Iso.cpp000644 001750 001750 00000014065 12473553042 021077 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "ProData.h" #include "Pos_Element.h" #include "Message.h" #define PSCA3(a,b) ((a)[0]*(b)[0] + (a)[1]*(b)[1] + (a)[2]*(b)[2]) extern struct CurrentData Current ; /* ------------------------------------------------------------------------ */ /* C a l _ I s o */ /* ------------------------------------------------------------------------ */ void Interpolate(double *X, double *Y, double *Z, struct Value *Val, double V, int I1, int I2, double *XI, double *YI ,double *ZI) { if(Val[I1].Val[0] == Val[I2].Val[0]){ *XI = X[I1]; *YI = Y[I1]; *ZI = Z[I1]; } else{ *XI= (V - Val[I1].Val[0])*(X[I2]-X[I1])/(Val[I2].Val[0]-Val[I1].Val[0]) + X[I1]; *YI= (V - Val[I1].Val[0])*(Y[I2]-Y[I1])/(Val[I2].Val[0]-Val[I1].Val[0]) + Y[I1]; *ZI= (V - Val[I1].Val[0])*(Z[I2]-Z[I1])/(Val[I2].Val[0]-Val[I1].Val[0]) + Z[I1]; } } void Cal_IsoTetrahedron(double *X, double *Y, double *Z, struct Value *Val, double V, double Vmin, double Vmax, double *Xp, double *Yp, double *Zp, int *nb) { *nb = 0; if((Val[0].Val[0] >= V && Val[1].Val[0] <= V) || (Val[1].Val[0] >= V && Val[0].Val[0] <= V)){ Interpolate(X,Y,Z,Val,V,0,1,&Xp[*nb],&Yp[*nb],&Zp[*nb]); (*nb)++; } if((Val[0].Val[0] >= V && Val[2].Val[0] <= V) || (Val[2].Val[0] >= V && Val[0].Val[0] <= V)){ Interpolate(X,Y,Z,Val,V,0,2,&Xp[*nb],&Yp[*nb],&Zp[*nb]); (*nb)++; } if((Val[0].Val[0] >= V && Val[3].Val[0] <= V) || (Val[3].Val[0] >= V && Val[0].Val[0] <= V)){ Interpolate(X,Y,Z,Val,V,0,3,&Xp[*nb],&Yp[*nb],&Zp[*nb]); (*nb)++; } if((Val[1].Val[0] >= V && Val[2].Val[0] <= V) || (Val[2].Val[0] >= V && Val[1].Val[0] <= V)){ Interpolate(X,Y,Z,Val,V,1,2,&Xp[*nb],&Yp[*nb],&Zp[*nb]); (*nb)++; } if((Val[1].Val[0] >= V && Val[3].Val[0] <= V) || (Val[3].Val[0] >= V && Val[1].Val[0] <= V)){ Interpolate(X,Y,Z,Val,V,1,3,&Xp[*nb],&Yp[*nb],&Zp[*nb]); (*nb)++; } if((Val[2].Val[0] >= V && Val[3].Val[0] <= V) || (Val[3].Val[0] >= V && Val[2].Val[0] <= V)){ Interpolate(X,Y,Z,Val,V,2,3,&Xp[*nb],&Yp[*nb],&Zp[*nb]); (*nb)++; } } void Cal_IsoTriangle(double *X, double *Y, double *Z, struct Value *Val, double V, double Vmin, double Vmax, double *Xp, double *Yp, double *Zp, int *nb) { *nb = 0; if((Val[0].Val[0] >= V && Val[1].Val[0] <= V) || (Val[1].Val[0] >= V && Val[0].Val[0] <= V)){ Interpolate(X,Y,Z,Val,V,0,1,&Xp[*nb],&Yp[*nb],&Zp[*nb]); (*nb)++; } if((Val[0].Val[0] >= V && Val[2].Val[0] <= V) || (Val[2].Val[0] >= V && Val[0].Val[0] <= V)){ Interpolate(X,Y,Z,Val,V,0,2,&Xp[*nb],&Yp[*nb],&Zp[*nb]); (*nb)++; } if((Val[1].Val[0] >= V && Val[2].Val[0] <= V) || (Val[2].Val[0] >= V && Val[1].Val[0] <= V)){ Interpolate(X,Y,Z,Val,V,1,2,&Xp[*nb],&Yp[*nb],&Zp[*nb]); (*nb)++; } } void Fill_Iso(struct PostElement *PE, int nb, int *index, double *x, double *y, double *z, double val) { int i, k ; for (i = 0 ; i < nb ; i++){ PE->x[i] = x[index[i]] ; PE->y[i] = y[index[i]] ; PE->z[i] = z[index[i]] ; PE->Value[i].Type = SCALAR ; PE->Value[i].Val[0] = val ; for (k = 1 ; k < Current.NbrHar ; k++) PE->Value[i].Val[MAX_DIM*k] = 0. ; } } void normvec(double *a); void Cal_Iso(struct PostElement *PE, List_T *list, double val, double vmin, double vmax, int DecomposeInSimplex) { struct PostElement *PE2 ; double x[5], y[5], z[5] ; double d1[3], d2[3], d3[3], a1, a2, a3 ; int nb, index[5], index_default[] = {0,1,2,3} ; switch(PE->Type){ case TRIANGLE : case TRIANGLE_2 : Cal_IsoTriangle(PE->x, PE->y, PE->z, PE->Value, val, vmin, vmax, x, y, z, &nb) ; if(nb == 2){ PE2 = Create_PostElement(PE->Index, LINE, 2, 1) ; Fill_Iso(PE2, nb, index_default, x, y, z, val) ; List_Add(list, &PE2); } break ; case TETRAHEDRON : Cal_IsoTetrahedron(PE->x, PE->y, PE->z, PE->Value, val, vmin, vmax, x, y, z, &nb) ; if(nb == 3){ PE2 = Create_PostElement(PE->Index, TRIANGLE, 3, 1) ; Fill_Iso(PE2, nb, index_default, x, y, z, val) ; List_Add(list, &PE2); } else if(nb == 4){ if(DecomposeInSimplex){ d1[0] = x[0] - x[1] ; d1[1] = y[0] - y[1] ; d1[2] = z[0] - z[1] ; d2[0] = x[0] - x[2] ; d2[1] = y[0] - y[2] ; d2[2] = z[0] - z[2] ; d3[0] = x[0] - x[3] ; d3[1] = y[0] - y[3] ; d3[2] = z[0] - z[3] ; normvec(d1) ; normvec(d2) ; normvec(d3) ; a1 = acos(PSCA3(d1,d2)) ; a2 = acos(PSCA3(d1,d3)) ; a3 = acos(PSCA3(d2,d3)) ; if(a1 >= a2 && a1 >= a3){ PE2 = Create_PostElement(PE->Index, TRIANGLE, 3, 1) ; index[0] = 0 ; index[1] = 1 ; index[2] = 2 ; Fill_Iso(PE2, 3, index, x, y, z, val) ; List_Add(list, &PE2); PE2 = Create_PostElement(PE->Index, TRIANGLE, 3, 1) ; index[0] = 3 ; index[1] = 2 ; index[2] = 1 ; Fill_Iso(PE2, 3, index, x, y, z, val) ; List_Add(list, &PE2); } else if(a2 >= a1 && a2 >= a3){ PE2 = Create_PostElement(PE->Index, TRIANGLE, 3, 1) ; index[0] = 0 ; index[1] = 1 ; index[2] = 3 ; Fill_Iso(PE2, 3, index, x, y, z, val) ; List_Add(list, &PE2); PE2 = Create_PostElement(PE->Index, TRIANGLE, 3, 1) ; index[0] = 2 ; index[1] = 3 ; index[2] = 1 ; Fill_Iso(PE2, 3, index, x, y, z, val) ; List_Add(list, &PE2); } else{ PE2 = Create_PostElement(PE->Index, TRIANGLE, 3, 1) ; index[0] = 0 ; index[1] = 2 ; index[2] = 3 ; Fill_Iso(PE2, 3, index, x, y, z, val) ; List_Add(list, &PE2); PE2 = Create_PostElement(PE->Index, TRIANGLE, 3, 1) ; index[0] = 1 ; index[1] = 3 ; index[2] = 2 ; Fill_Iso(PE2, 3, index, x, y, z, val) ; List_Add(list, &PE2); } } else{ PE2 = Create_PostElement(PE->Index, QUADRANGLE, 4, 1) ; Fill_Iso(PE2, nb, index_default, x, y, z, val) ; List_Add(list, &PE2); } } break ; default : Message::Error("Iso computation not done for this type of element"); break ; } } getdp-2.7.0-source/Legacy/F_Math.cpp000644 001750 001750 00000014202 12554352207 020653 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "ProData.h" #include "F.h" #include "MallocUtils.h" #include "Message.h" extern struct CurrentData Current ; /* ------------------------------------------------------------------------ */ /* C math functions (scalar, 1 argument, imaginary part set to zero) */ /* ------------------------------------------------------------------------ */ #define scalar_real_1_arg(func, string) \ int k; \ \ if(A->Type != SCALAR) \ Message::Error("Non scalar argument for function '" string "'"); \ \ V->Val[0] = func(A->Val[0]) ; \ if (Current.NbrHar != 1){ \ V->Val[MAX_DIM] = 0. ; \ for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) \ V->Val[MAX_DIM*k] = V->Val[MAX_DIM*(k+1)] = 0. ; \ } \ V->Type = SCALAR; void F_Exp (F_ARG) { scalar_real_1_arg (exp, "Exp") } void F_Log (F_ARG) { scalar_real_1_arg (log, "Log") } void F_Log10 (F_ARG) { scalar_real_1_arg (log10,"Log10") } void F_Sqrt (F_ARG) { scalar_real_1_arg (sqrt, "Sqrt") } void F_Sin (F_ARG) { scalar_real_1_arg (sin, "Sin") } void F_Asin (F_ARG) { scalar_real_1_arg (asin, "Asin") } void F_Cos (F_ARG) { scalar_real_1_arg (cos, "Cos" ) } void F_Acos (F_ARG) { scalar_real_1_arg (acos, "Acos") } void F_Tan (F_ARG) { scalar_real_1_arg (tan, "Tan") } void F_Atan (F_ARG) { scalar_real_1_arg (atan, "Atan") } void F_Sinh (F_ARG) { scalar_real_1_arg (sinh, "Sinh") } void F_Cosh (F_ARG) { scalar_real_1_arg (cosh, "Cosh") } void F_Tanh (F_ARG) { scalar_real_1_arg (tanh, "Tanh") } void F_Fabs (F_ARG) { scalar_real_1_arg (fabs, "Fabs") } void F_Floor (F_ARG) { scalar_real_1_arg (floor,"Floor") } void F_Ceil (F_ARG) { scalar_real_1_arg (ceil, "Ceil") } #undef scalar_real_1_arg /* ------------------------------------------------------------------------ */ /* C math functions (scalar, 2 arguments, imaginary part set to zero) */ /* ------------------------------------------------------------------------ */ #define scalar_real_2_arg(func, string) \ int k; \ \ if(A->Type != SCALAR || (A+1)->Type != SCALAR) \ Message::Error("Non scalar argument(s) for function '" string "'"); \ \ V->Val[0] = func(A->Val[0], (A+1)->Val[0]) ; \ if (Current.NbrHar != 1){ \ V->Val[MAX_DIM] = 0. ; \ for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) \ V->Val[MAX_DIM*k] = V->Val[MAX_DIM*(k+1)] = 0. ; \ } \ V->Type = SCALAR; void F_Atan2 (F_ARG) { scalar_real_2_arg (atan2, "Atan2") } void F_Fmod (F_ARG) { scalar_real_2_arg (fmod, "Fmod") } #undef scalar_real_2_arg /* ------------------------------------------------------------------------ */ /* Sign function */ /* ------------------------------------------------------------------------ */ void F_Sign(F_ARG) { int k; double x; if(A->Type != SCALAR) Message::Error("Non scalar argument for function 'Sign'"); x = A->Val[0]; if(x >= 0.) V->Val[0] = 1.; else if(x < 0.) V->Val[0] = -1.; else V->Val[0] = 0.; if (Current.NbrHar != 1){ V->Val[MAX_DIM] = 0. ; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) V->Val[MAX_DIM*k] = V->Val[MAX_DIM*(k+1)] = 0. ; } V->Type = SCALAR; } /* ------------------------------------------------------------------------ */ /* Bessel functions jn, yn and their derivatives */ /* ------------------------------------------------------------------------ */ void F_Jn(F_ARG) { int k, n; double x; if(A->Type != SCALAR || (A+1)->Type != SCALAR) Message::Error("Non scalar argument(s) for Bessel function of the first kind 'Jn'"); n = (int)A->Val[0]; x = (A+1)->Val[0]; V->Val[0] = jn(n, x); if (Current.NbrHar != 1){ V->Val[MAX_DIM] = 0. ; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) V->Val[MAX_DIM*k] = V->Val[MAX_DIM*(k+1)] = 0. ; } V->Type = SCALAR; } void F_Yn(F_ARG) { int k, n; double x; if(A->Type != SCALAR || (A+1)->Type != SCALAR) Message::Error("Non scalar argument(s) for Bessel function of the second 'Yn'"); n = (int)A->Val[0]; x = (A+1)->Val[0]; V->Val[0] = yn(n, x); if (Current.NbrHar != 1){ V->Val[MAX_DIM] = 0. ; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) V->Val[MAX_DIM*k] = V->Val[MAX_DIM*(k+1)] = 0. ; } V->Type = SCALAR; } double dBessel(double *tab, int n, double x) { if(n == 0){ return - tab[1]; } else{ return tab[n-1] - (double)n/x * tab[n]; } } void F_dJn(F_ARG) { int k, n; double x, *jntab; if(A->Type != SCALAR || (A+1)->Type != SCALAR) Message::Error("Non scalar argument(s) for the derivative of the Bessel " "function of the first kind 'dJn'"); n = (int)A->Val[0]; x = (A+1)->Val[0]; jntab = (double*)Malloc((n + 2) * sizeof(double)); for(k = 0; k < n + 2; k++){ jntab[k] = jn(k, x); } V->Val[0] = dBessel(jntab, n, x); Free(jntab); if (Current.NbrHar != 1){ V->Val[MAX_DIM] = 0. ; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) V->Val[MAX_DIM*k] = V->Val[MAX_DIM*(k+1)] = 0. ; } V->Type = SCALAR; } void F_dYn(F_ARG) { int k, n; double x, *yntab; if(A->Type != SCALAR || (A+1)->Type != SCALAR) Message::Error("Non scalar argument(s) for the derivative of the Bessel " "function of the second kind 'dYn'"); n = (int)A->Val[0]; x = (A+1)->Val[0]; yntab = (double*)Malloc((n + 2) * sizeof(double)); for(k = 0; k < n + 2; k++){ yntab[k] = yn(k, x); } V->Val[0] = dBessel(yntab, n, x); Free(yntab); if (Current.NbrHar != 1){ V->Val[MAX_DIM] = 0. ; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) V->Val[MAX_DIM*k] = V->Val[MAX_DIM*(k+1)] = 0. ; } V->Type = SCALAR; } getdp-2.7.0-source/Legacy/Operation_IterativeLoopN.cpp000644 001750 001750 00000031277 12553357400 024453 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Michael Asam #include #include "ProData.h" #include "DofData.h" #include "SolvingOperations.h" #include "SolvingAnalyse.h" #include "Message.h" #include "Cal_Quantity.h" extern struct CurrentData Current; extern int Flag_IterativeLoopN; extern int Flag_IterativeLoopConverged; /* ------------------------------------------------------------------------ */ /* C a l M a x E r r o r R a t i o */ /* ------------------------------------------------------------------------ */ double CalcMaxErrorRatio(Resolution *Resolution_P, DofData *DofData_P0, List_T *ILsystems_L, List_T *LEPostOp_L, List_T *xPrevious_L, List_T *PostOpSolutionPrevious_L) { DofData *DofData_P=NULL; DefineSystem *DefineSystem_P; IterativeLoopSystem ILsystem; LoopErrorPostOperation ILPostOp; PostOpSolutions *PostOpSolutions_P; Solution *Solution_P; gVector *xPrevious_P, *xCurrent_P; // new and last solution vector gVector xError; // Local Truncation Error vector int NbrSolutions, PostOpSolLength; double ErrorRatio, MaxErrorRatio; MaxErrorRatio = 0.; // Loop through all given systems for(int i = 0; i < List_Nbr(ILsystems_L); i++){ List_Read(ILsystems_L, i, &ILsystem); DofData_P = DofData_P0 + ILsystem.SystemIndex; DefineSystem_P = (DefineSystem*)List_Pointer(Resolution_P->DefineSystem, ILsystem.SystemIndex); xPrevious_P = (gVector*)List_Pointer(xPrevious_L, i); xCurrent_P = &DofData_P->CurrentSolution->x; LinAlg_CreateVector(&xError, &DofData_P->Solver, DofData_P->NbrDof); switch (ILsystem.NormOf) { case SOLUTION: // Vector of errors: xError = xCurrent - xPrevious LinAlg_CopyVector(xCurrent_P, &xError); LinAlg_SubVectorVector(&xError, xPrevious_P, &xError); Cal_SolutionErrorRatio(&xError, xCurrent_P, ILsystem.SystemILreltol, ILsystem.SystemILabstol, ILsystem.NormType, &ErrorRatio); break; case RECALCRESIDUAL: // Calculating the actual residual: xError = b(xn)-A(xn)*xn // Works also for "Solve" but its computational expensive ReGenerate_System(DefineSystem_P, DofData_P, DofData_P0, 1); LinAlg_ProdMatrixVector(&DofData_P->A, &DofData_P->CurrentSolution->x, &xError); LinAlg_SubVectorVector(&DofData_P->b, &xError, &xError); Cal_SolutionErrorRatio(&xError, &DofData_P->b, ILsystem.SystemILreltol, ILsystem.SystemILabstol, ILsystem.NormType, &ErrorRatio); break; case RESIDUAL: // Or alternatively look at the old residual (from e.g. SolveJac) // -> More efficient but causes one extra iteration Cal_SolutionErrorRatio(&DofData_P->res, &DofData_P->b, ILsystem.SystemILreltol, ILsystem.SystemILabstol, ILsystem.NormType, &ErrorRatio); break; default: Message::Error("Unknown object for error norm"); break; } LinAlg_DestroyVector(&xError); if (ErrorRatio != ErrorRatio) { // If ErrorRatio = NaN MaxErrorRatio = ErrorRatio; break; } else if (ErrorRatio > MaxErrorRatio) MaxErrorRatio = ErrorRatio; if (Message::GetVerbosity() > 5) { Message::Info("IterativeLoopN: %s of %s error ratio from system %s: %.3g", ILsystem.NormTypeString, ILsystem.NormOfString, DefineSystem_P->Name, ErrorRatio); } } // Loop through all specified PostOperations for(int i = 0; i < List_Nbr(LEPostOp_L); i++){ List_Read(LEPostOp_L, i, &ILPostOp); PostOpSolutions_P = (struct PostOpSolutions*) List_Pointer(Current.PostOpData_L, i); NbrSolutions = List_Nbr(PostOpSolutions_P->Solutions_L); Solution_P = (struct Solution*)List_Pointer(PostOpSolutions_P->Solutions_L, NbrSolutions-1); xPrevious_P = (gVector*)List_Pointer(PostOpSolutionPrevious_L, i); xCurrent_P = &Solution_P->x; LinAlg_AssembleVector(&Solution_P->x); LinAlg_GetVectorSize(xCurrent_P, &PostOpSolLength); LinAlg_CreateVector(&xError, &DofData_P0->Solver, PostOpSolLength); // Vector of errors: xError = xCurrent - xPrevious LinAlg_CopyVector(xCurrent_P, &xError); LinAlg_SubVectorVector(&xError, xPrevious_P, &xError); Cal_SolutionErrorRatio(&xError, xCurrent_P, ILPostOp.PostOperationReltol, ILPostOp.PostOperationAbstol, ILPostOp.NormType, &ErrorRatio); LinAlg_DestroyVector(&xError); if (ErrorRatio != ErrorRatio) { // If ErrorRatio = NaN MaxErrorRatio = ErrorRatio; break; } else if (ErrorRatio > MaxErrorRatio) MaxErrorRatio = ErrorRatio; if (Message::GetVerbosity() > 5) { Message::Info("IterativeLoopN: %s error ratio from PostOperation %s: %.3g", ILPostOp.NormTypeString, ILPostOp.PostOperationName, ErrorRatio); } } return MaxErrorRatio; } /* ------------------------------------------------------------------------ */ /* O p e r a t i o n _ I t e r a t i v e L o o p N */ /* ------------------------------------------------------------------------ */ void Operation_IterativeLoopN(Resolution *Resolution_P, Operation *Operation_P, DofData *DofData_P0, GeoData *GeoData_P0, Resolution *Resolution2_P, DofData *DofData2_P0, int *Flag_Break) { int NbrMaxIteration, RelaxationFactorIndex; int Num_Iteration, NbrPostOps, SavePostOpDataIndex, NbrSolutions; double Save_Iteration, MaxErrorRatio = 0.; List_T *ILsystems_L, *LEPostOp_L, *xPrevious_L; List_T *LEPostOpNames_L, *PostOpSolutionPrevious_L; List_T *SavePostOpData_L; gVector *xPrevious_P, *PostOpResultPrevious_P; Value Value; DofData *DofData_P=NULL; IterativeLoopSystem ILsystem; PostOpSolutions *PostOpSolutions_P; Solution *Solution_P; NbrMaxIteration = Operation_P->Case.IterativeLoop.NbrMaxIteration; RelaxationFactorIndex = Operation_P->Case.IterativeLoop.RelaxationFactorIndex; ILsystems_L = Operation_P->Case.IterativeLoop.IterativeLoopSystems_L; LEPostOp_L = Operation_P->Case.IterativeLoop.IterativeLoopPOs_L; if (ILsystems_L == NULL) ILsystems_L = List_Create(1,1,sizeof(TimeLoopAdaptiveSystem)); if (LEPostOp_L == NULL) LEPostOp_L = List_Create(1,1,sizeof(LoopErrorPostOperation)); xPrevious_L = List_Create(4,4,sizeof(gVector)); PostOpSolutionPrevious_L = List_Create(4,4,sizeof(gVector)); // Just some checks and initialization // ----------------------------------- // Check if initial solutions for all specified systems are available for(int i = 0; i < List_Nbr(ILsystems_L); i++){ List_Read(ILsystems_L, i, &ILsystem); DefineSystem *sys = (DefineSystem*)List_Pointer(Resolution_P->DefineSystem, ILsystem.SystemIndex); DofData_P = DofData_P0 + ILsystem.SystemIndex; if(!List_Nbr(DofData_P->Solutions)) Message::Error("No initial solution for system %s", sys->Name); gVector xPrevious_S; LinAlg_CreateVector(&xPrevious_S, &DofData_P->Solver, DofData_P->NbrDof); List_Add(xPrevious_L, &xPrevious_S); } // Initializing stuff for PostOperations SavePostOpData_L = Current.PostOpData_L; Current.PostOpData_L = NULL; SavePostOpDataIndex = Current.PostOpDataIndex; Current.PostOpDataIndex = -1; NbrPostOps = List_Nbr(LEPostOp_L); LEPostOpNames_L = List_Create(NbrPostOps,1,sizeof(char *)); InitLEPostOperation(Resolution_P, DofData_P0, GeoData_P0, LEPostOp_L, LEPostOpNames_L, PostOpSolutionPrevious_L); // Iterative loop // ---------------- Save_Iteration = Current.Iteration ; for (Num_Iteration = 1; Num_Iteration <= NbrMaxIteration; Num_Iteration++) { Flag_IterativeLoopN = 1; if(Message::GetOnelabAction() == "stop" || Message::GetErrorCount()) break; Current.Iteration = (double)Num_Iteration; Get_ValueOfExpressionByIndex(RelaxationFactorIndex, NULL, 0., 0., 0., &Value); Current.RelaxationFactor = Value.Val[0]; // Store the current solutions in xPrevious_L for(int i = 0; i < List_Nbr(ILsystems_L); i++){ List_Read(ILsystems_L, i, &ILsystem); DofData_P = DofData_P0 + ILsystem.SystemIndex; xPrevious_P = (gVector*)List_Pointer(xPrevious_L, i); LinAlg_CopyVector(&DofData_P->CurrentSolution->x, xPrevious_P); } // Store the current PostOperation results in PostOpSolutionPrevious_L if (NbrPostOps != List_Nbr(Current.PostOpData_L)) Message::Error("Current.PostOpData_L list is not up to date"); for(int i = 0; i < NbrPostOps; i++){ PostOpSolutions_P = (struct PostOpSolutions*) List_Pointer(Current.PostOpData_L, i); NbrSolutions = List_Nbr(PostOpSolutions_P->Solutions_L); if (!NbrSolutions) Message::Error("No initial result for PostOperation %s", PostOpSolutions_P->PostOperation_P->Name); Solution_P = (struct Solution*)List_Pointer(PostOpSolutions_P->Solutions_L, NbrSolutions-1); PostOpResultPrevious_P = (gVector*)List_Pointer(PostOpSolutionPrevious_L, i); LinAlg_AssembleVector(&Solution_P->x); LinAlg_CopyVector(&Solution_P->x, PostOpResultPrevious_P); } Message::Info("IterativeLoopN: Non linear iteration %d (Relaxation = %g)", (int)Current.Iteration, Current.RelaxationFactor) ; Treatment_Operation(Resolution_P, Operation_P->Case.IterativeLoop.Operation, DofData_P0, GeoData_P0, Resolution2_P, DofData2_P0) ; if(*Flag_Break) { *Flag_Break = 0; Message::Info("Flag Break detected. Aborting IterativeLoop"); break; } else if (Message::GetLastPETScError()) { Message::Warning("No valid solution found (PETSc-Error: %d)! " "Aborting IterativeLoopN", Message::GetLastPETScError()); break; } else if (NbrPostOps) // Execute the PostOperations if necessary Operation_PostOperation(Resolution_P, DofData_P0, GeoData_P0, LEPostOpNames_L); // Check if converged MaxErrorRatio = CalcMaxErrorRatio(Resolution_P,DofData_P0, ILsystems_L, LEPostOp_L, xPrevious_L, PostOpSolutionPrevious_L); if (MaxErrorRatio != MaxErrorRatio) { // If ErrorRatio = NaN => There was no valid solution! Flag_IterativeLoopConverged = 0; break; } Message::Info("IterativeLoopN: Largest error ratio: %.3g (after %d iteration%s)", MaxErrorRatio, (int)Current.Iteration, ((int)Current.Iteration == 1) ? "" : "s"); if(Message::GetProgressMeterStep() > 0 && Message::GetProgressMeterStep() < 100) Message::AddOnelabNumberChoice(Message::GetOnelabClientName() + "/IterativeLoop/ILmaxErrorRatio", MaxErrorRatio); if (MaxErrorRatio < 1.) { Message::Info(3, "IterativeLoopN converged (%d iterations, error ratio %g)", (int)Current.Iteration, MaxErrorRatio); break; } } if (Num_Iteration > NbrMaxIteration) { Num_Iteration = NbrMaxIteration; Flag_IterativeLoopConverged = 0; Message::Info(3, "IterativeLoopN did NOT converge (%d iterations, error ratio %g)", (int)Current.Iteration, MaxErrorRatio); } Current.Iteration = Save_Iteration ; Flag_IterativeLoopN = 0; // Finally destroy vectors and delete Lists // ---------------------------------------- for(int i = 0; i < List_Nbr(ILsystems_L); i++) LinAlg_DestroyVector((gVector*)List_Pointer(xPrevious_L, i)); List_Delete(xPrevious_L); ClearLEPostOperation(Resolution_P, DofData_P0, GeoData_P0, LEPostOp_L, LEPostOpNames_L, PostOpSolutionPrevious_L, false); Current.PostOpData_L = SavePostOpData_L; Current.PostOpDataIndex = SavePostOpDataIndex; } getdp-2.7.0-source/Legacy/Get_DofOfElement.cpp000644 001750 001750 00000057077 12473553042 022644 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "ProData.h" #include "GeoData.h" #include "DofData.h" #include "Get_DofOfElement.h" #include "Get_ConstraintOfElement.h" #include "ExtendedGroup.h" #include "Cal_Quantity.h" #include "Message.h" extern struct Problem Problem_S ; extern struct CurrentData Current ; extern int TreatmentStatus ; extern double Flag_ORDER ; extern List_T *PreResolutionIndex_L ; struct BasisFunction * BasisFunction_P ; int Nbr_ElementaryBF, Flag_SubSpace ; struct Group * GroupSupport_P, * GroupEntity_P ; /* ------------------------------------------------------------------------ */ /* G e t _ I n i t D o f O f E l e m e n t */ /* ------------------------------------------------------------------------ */ void Get_InitDofOfElement(struct Element * Element) { Element->ElementTrace = NULL ; Element->NumLastElementForNodesCoordinates = -1 ; Element->NumLastElementForGroupsOfEntities = -1 ; Element->NumLastElementForSolidAngle = -1 ; Element->NumLastElementForSortedNodesByFacet = -1 ; } /* ------------------------------------------------------------------------ */ /* G e t _ D o f O f E l e m e n t */ /* ------------------------------------------------------------------------ */ void Get_DofOfElement(struct Element * Element, struct FunctionSpace * FunctionSpace_P, struct QuantityStorage * QuantityStorage_P, List_T * BasisFunctionIndex_L) { struct BasisFunction * BasisFunction_P0 ; int Nbr_BasisFunction, Nbr_BasisFunctionAll, i_BFunction, StartingIndex, i ; int * BasisFunctionIndex_P0 = NULL ; Current.Element = Element ; Nbr_ElementaryBF = 0 ; /* Get the SubSpace */ Nbr_BasisFunctionAll = List_Nbr(FunctionSpace_P->BasisFunction) ; BasisFunction_P0 = (Nbr_BasisFunctionAll) ? (struct BasisFunction*)List_Pointer(FunctionSpace_P->BasisFunction, 0) : NULL ; if (!BasisFunctionIndex_L) { Flag_SubSpace = 0 ; Nbr_BasisFunction = Nbr_BasisFunctionAll ; } else { Flag_SubSpace = 1 ; Nbr_BasisFunction = List_Nbr(BasisFunctionIndex_L) ; BasisFunctionIndex_P0 = (Nbr_BasisFunction) ? (int*)List_Pointer(BasisFunctionIndex_L, 0) : NULL ; } /* Set the DofData if explicitely specified */ switch (TreatmentStatus) { case _CAL : case _POS : if(QuantityStorage_P->DefineQuantity->DofData) FunctionSpace_P->DofData = QuantityStorage_P->DefineQuantity->DofData ; else FunctionSpace_P->DofData = FunctionSpace_P->MainDofData ; break; } /* For each subset of Basis Functions */ for (i = 0 ; i < Nbr_BasisFunction ; i++) { i_BFunction = (!Flag_SubSpace)? i : BasisFunctionIndex_P0[i] ; BasisFunction_P = BasisFunction_P0 + i_BFunction ; GroupSupport_P = (struct Group*) List_Pointer(Problem_S.Group, BasisFunction_P->SupportIndex) ; /* If the BasisFunction exists for this kind of element the interpolation order is lower or equal to the maximum order allowed the element is in the support of the BasisFunction */ if ( ( BasisFunction_P->ElementType & Current.Element->Type ) && ( Flag_ORDER < 0. || BasisFunction_P->Order <= Flag_ORDER ) && ( (GroupSupport_P->Type == REGIONLIST && List_Search(GroupSupport_P->InitialList, &Element->Region, fcmp_int)) || (GroupSupport_P->Type == ELEMENTLIST && Check_IsEntityInExtendedGroup(GroupSupport_P, Element->Num, 0)) ) ) { GroupEntity_P = (struct Group*) List_Pointer(Problem_S.Group, BasisFunction_P->EntityIndex) ; switch (GroupEntity_P->FunctionType) { case NODESOF : Get_CodesOfElement (FunctionSpace_P, QuantityStorage_P, Element->GeoElement->NbrNodes, Element->GeoElement->NumNodes, 0, i_BFunction, NODESOF, NULL) ; break ; case EDGESOF : case EDGESOFTREEIN : if (Element->GeoElement->NbrEdges == 0) Geo_CreateEdgesOfElement(Element->GeoElement) ; Get_CodesOfElement (FunctionSpace_P, QuantityStorage_P, Element->GeoElement->NbrEdges, Element->GeoElement->NumEdges, 0, i_BFunction, EDGESOF, NULL) ; break ; case FACETSOF : case FACETSOFTREEIN : if (Element->GeoElement->NbrEdges == 0) Geo_CreateEdgesOfElement(Element->GeoElement) ; if (Element->GeoElement->NbrFacets == 0) Geo_CreateFacetsOfElement(Element->GeoElement) ; Get_CodesOfElement (FunctionSpace_P, QuantityStorage_P, Element->GeoElement->NbrFacets, Element->GeoElement->NumFacets, 0, i_BFunction, FACETSOF, NULL) ; break ; case VOLUMESOF : Get_CodesOfElement(FunctionSpace_P, QuantityStorage_P, 1, &Element->GeoElement->Num, 0, i_BFunction, VOLUMESOF, NULL) ; break ; case GROUPSOFNODESOF : Get_GroupsOfElementaryEntitiesOfElement (Element, &StartingIndex, Element->GeoElement->NbrNodes, Element->GeoElement->NumNodes, BasisFunction_P) ; Get_CodesOfElement (FunctionSpace_P, QuantityStorage_P, Element->NbrGroupsOfEntities, Element->NumGroupsOfEntities, StartingIndex, i_BFunction, GROUPSOFNODESOF, Element->NumSubFunction[1]) ; break ; case GROUPSOFEDGESONNODESOF : if (Element->GeoElement->NbrEdges == 0) Geo_CreateEdgesOfElement(Element->GeoElement) ; Get_GroupsOfEdgesOnNodesOfElement(Element, &StartingIndex) ; Get_CodesOfElement (FunctionSpace_P, QuantityStorage_P, Element->NbrGroupsOfEntities, Element->NumGroupsOfEntities, StartingIndex, i_BFunction, GROUPSOFEDGESONNODESOF, NULL) ; break ; case GROUPSOFEDGESOF : if (Element->GeoElement->NbrEdges == 0) Geo_CreateEdgesOfElement(Element->GeoElement) ; Get_GroupsOfElementaryEntitiesOfElement (Element, &StartingIndex, Element->GeoElement->NbrEdges, Element->GeoElement->NumEdges, BasisFunction_P) ; Get_CodesOfElement (FunctionSpace_P, QuantityStorage_P, Element->NbrGroupsOfEntities, Element->NumGroupsOfEntities, StartingIndex, i_BFunction, GROUPSOFEDGESOF, NULL) ; break ; case GROUPSOFFACETSOF : if (Element->GeoElement->NbrFacets == 0) Geo_CreateFacetsOfElement(Element->GeoElement) ; Get_GroupsOfElementaryEntitiesOfElement (Element, &StartingIndex, Element->GeoElement->NbrFacets, Element->GeoElement->NumFacets, BasisFunction_P) ; Get_CodesOfElement (FunctionSpace_P, QuantityStorage_P, Element->NbrGroupsOfEntities, Element->NumGroupsOfEntities, StartingIndex, i_BFunction, GROUPSOFFACETSOF, NULL) ; break ; case REGION : Get_RegionForElement(Element, &StartingIndex, BasisFunction_P) ; Get_CodesOfElement (FunctionSpace_P, QuantityStorage_P, Element->NbrGroupsOfEntities, Element->NumGroupsOfEntities, StartingIndex, i_BFunction, REGION, Element->NumSubFunction[1]) ; break ; case GROUPOFREGIONSOF : Get_GroupOfRegionsForElement(Element, &StartingIndex, BasisFunction_P) ; Get_CodesOfElement (FunctionSpace_P, QuantityStorage_P, Element->NbrGroupsOfEntities, Element->NumGroupsOfEntities, StartingIndex, i_BFunction, GROUPOFREGIONSOF, Element->NumSubFunction[1]) ; break ; case GLOBAL : Get_GlobalForElement(Element, &StartingIndex, BasisFunction_P) ; Get_CodesOfElement (FunctionSpace_P, QuantityStorage_P, Element->NbrGroupsOfEntities, Element->NumGroupsOfEntities, StartingIndex, i_BFunction, GLOBAL, NULL) ; break ; } } /* if Region ... */ } /* for i ... */ QuantityStorage_P->NbrElementaryBasisFunction = Nbr_ElementaryBF ; // FIXME: just for testing - this should be called in a separate loop with // appropriate initializations in Treatment_Formulation if (TreatmentStatus == _PRE) Treatment_ConstraintByLocalProjection(Element, FunctionSpace_P, QuantityStorage_P); } /* ------------------------------------------------------------------------ */ /* G e t _ G r o u p s O f E l e m e n t a r y E n t i t i e s */ /* O f E l e m e n t */ /* ------------------------------------------------------------------------ */ void Get_GroupsOfElementaryEntitiesOfElement (struct Element * Element, int * StartingIndex, int Nbr_ElementaryEntities, int Num_ElementaryEntities[], struct BasisFunction * BasisFunction_P) { /* external input/output : GroupEntity_P : In */ int i, j, Num_Entity, Nbr_SubFunction, i_SF ; struct TwoInt * Key_P ; if (Element->NumLastElementForGroupsOfEntities != Element->Num) { Element->NumLastElementForGroupsOfEntities = Element->Num ; Element->NbrGroupsOfEntities = 0 ; } *StartingIndex = Element->NbrGroupsOfEntities ; if (GroupEntity_P->ExtendedList == NULL) Generate_ExtendedGroup(GroupEntity_P) ; for (i = 0 ; i < Nbr_ElementaryEntities ; i++) { Num_Entity = abs(Num_ElementaryEntities[i]) ; for (std::multimap::iterator it = GroupEntity_P->ExtendedListForSearch.lower_bound(Num_Entity); it != GroupEntity_P->ExtendedListForSearch.upper_bound(Num_Entity); ++it) { Key_P = &it->second; j = *StartingIndex ; while ((j < Element->NbrGroupsOfEntities) && (Element->NumGroupsOfEntities[j] != Key_P->Int2)) j++ ; if (!BasisFunction_P->SubFunction) { if (j == Element->NbrGroupsOfEntities) { Element->NumSubFunction[1][j] = 0 ; Element->NumSubFunction[0][j] = -1 ; Element->NumGroupsOfEntities[j] = Key_P->Int2 ; Element->NbrEntitiesInGroups[Element->NbrGroupsOfEntities++] = 0 ; } Element->NumEntitiesInGroups[j][Element->NbrEntitiesInGroups[j]++] = (Key_P->Int1 > 0)? (i+1) : -(i+1) ; } else { /* For SubFunctions (basis functions for a global function) */ Nbr_SubFunction = List_Nbr(BasisFunction_P->SubFunction) ; if (j == Element->NbrGroupsOfEntities) { for (i_SF = 0 ; i_SF < Nbr_SubFunction ; i_SF++) { Element->NumSubFunction[1][j+i_SF] = i_SF ; Element->NumSubFunction[0][j+i_SF] = *((int *)List_Pointer(BasisFunction_P->SubFunction, i_SF)) ; if (BasisFunction_P->SubdFunction) Element->NumSubFunction[2][j+i_SF] = *((int *)List_Pointer(BasisFunction_P->SubdFunction, i_SF)) ; Element->NumGroupsOfEntities[j+i_SF] = Key_P->Int2 ; Element->NbrEntitiesInGroups[Element->NbrGroupsOfEntities++] = 0 ; } } for (i_SF = 0 ; i_SF < Nbr_SubFunction ; i_SF++) Element->NumEntitiesInGroups[j+i_SF][Element->NbrEntitiesInGroups[j+i_SF]++] = (Key_P->Int1 > 0)? (i+1) : -(i+1) ; } } } } /* ------------------------------------------------------------------------ */ /* G e t _ G r o u p s O f E d g e s O n N o d e s O f E l e m e n t */ /* ------------------------------------------------------------------------ */ void Get_GroupsOfEdgesOnNodesOfElement(struct Element * Element, int * StartingIndex) { /* external input/output : GroupEntity_P : In */ int i, j, Num_Edge, * Num_Nodes, Num_Node ; if (Element->NumLastElementForGroupsOfEntities != Element->Num) { Element->NumLastElementForGroupsOfEntities = Element->Num ; Element->NbrGroupsOfEntities = 0 ; } *StartingIndex = Element->NbrGroupsOfEntities ; if (GroupEntity_P->ExtendedList == NULL) Generate_ExtendedGroup(GroupEntity_P) ; for (i = 0 ; i < Element->GeoElement->NbrEdges ; i++) { Num_Edge = abs(Element->GeoElement->NumEdges[i]) ; if (List_Search(GroupEntity_P->ExtendedList, &Num_Edge, fcmp_int )) { Num_Nodes = Geo_GetNodesOfEdgeInElement(Element->GeoElement, i) ; Num_Node = Element->GeoElement->NumNodes[abs(Num_Nodes[0])-1] ; j = *StartingIndex ; while ((j < Element->NbrGroupsOfEntities) && (Element->NumGroupsOfEntities[j] != Num_Node)) j++ ; if (j == Element->NbrGroupsOfEntities) { Element->NumGroupsOfEntities[Element->NbrGroupsOfEntities++] = Num_Node ; Element->NbrEntitiesInGroups[j] = 0 ; } Element->NumEntitiesInGroups[j] [Element->NbrEntitiesInGroups[j]++] = (Element->GeoElement->NumEdges[i] > 0)? -(i+1) : (i+1) ; /*- edge node 1 o--->---o node 2 => (Phi2 - Phi1) s12 ... -> minus sign associated with node 1 for positive edge from node 1 to node 2 */ Num_Node = Element->GeoElement->NumNodes[abs(Num_Nodes[1])-1] ; j = *StartingIndex ; while ((j < Element->NbrGroupsOfEntities) && (Element->NumGroupsOfEntities[j] != Num_Node)) j++ ; if (j == Element->NbrGroupsOfEntities) { Element->NumGroupsOfEntities[Element->NbrGroupsOfEntities++] = Num_Node ; Element->NbrEntitiesInGroups[j] = 0 ; } Element->NumEntitiesInGroups[j] [Element->NbrEntitiesInGroups[j]++] = (Element->GeoElement->NumEdges[i] > 0)? (i+1) : -(i+1) ; } } } /* ------------------------------------------------------------------------ */ /* G e t _ R e g i o n F o r E l e m e n t */ /* ------------------------------------------------------------------------ */ void Get_RegionForElement(struct Element * Element, int * StartingIndex, struct BasisFunction * BasisFunction_P) { int Nbr_SubFunction, i_SF ; if (Element->NumLastElementForGroupsOfEntities != Element->Num) { Element->NumLastElementForGroupsOfEntities = Element->Num ; Element->NbrGroupsOfEntities = 0 ; } *StartingIndex = Element->NbrGroupsOfEntities ; if (!BasisFunction_P->SubFunction) { Element->NumSubFunction[1][Element->NbrGroupsOfEntities] = 0 ; Element->NumSubFunction[0][Element->NbrGroupsOfEntities] = -1 ; Element->NumGroupsOfEntities[Element->NbrGroupsOfEntities++] = Element->Region ; } else { /* For SubFunctions (basis functions for a global function) */ Nbr_SubFunction = List_Nbr(BasisFunction_P->SubFunction) ; for (i_SF = 0 ; i_SF < Nbr_SubFunction ; i_SF++) { Element->NumSubFunction[1][Element->NbrGroupsOfEntities] = i_SF ; /* Index SF */ Element->NumSubFunction[0][Element->NbrGroupsOfEntities] = *((int *)List_Pointer(BasisFunction_P->SubFunction, i_SF)) ; /* Index Expression */ if (BasisFunction_P->SubdFunction) Element->NumSubFunction[2][Element->NbrGroupsOfEntities] = *((int *)List_Pointer(BasisFunction_P->SubdFunction, i_SF)) ; /* Index Expression */ Element->NumGroupsOfEntities[Element->NbrGroupsOfEntities++] = Element->Region ; } } } /* ------------------------------------------------------------------------ */ /* G e t _ G r o u p O f R e g i o n s F o r E l e m e n t */ /* ------------------------------------------------------------------------ */ void Get_GroupOfRegionsForElement(struct Element * Element, int * StartingIndex, struct BasisFunction * BasisFunction_P) { int Nbr_SubFunction, i_SF ; if (Element->NumLastElementForGroupsOfEntities != Element->Num) { Element->NumLastElementForGroupsOfEntities = Element->Num ; Element->NbrGroupsOfEntities = 0 ; } *StartingIndex = Element->NbrGroupsOfEntities ; if (!BasisFunction_P->SubFunction) { Element->NumSubFunction[1][Element->NbrGroupsOfEntities] = 0 ; Element->NumSubFunction[0][Element->NbrGroupsOfEntities] = -1 ; Element->NumGroupsOfEntities[Element->NbrGroupsOfEntities++] = GroupEntity_P->Num ; } else { /* For SubFunctions (basis functions for a global function) */ Nbr_SubFunction = List_Nbr(BasisFunction_P->SubFunction) ; for (i_SF = 0 ; i_SF < Nbr_SubFunction ; i_SF++) { Element->NumSubFunction[1][Element->NbrGroupsOfEntities] = i_SF ; /* Index SF */ Element->NumSubFunction[0][Element->NbrGroupsOfEntities] = *((int *)List_Pointer(BasisFunction_P->SubFunction, i_SF)) ; /* Index Expression */ if (BasisFunction_P->SubdFunction) Element->NumSubFunction[2][Element->NbrGroupsOfEntities] = *((int *)List_Pointer(BasisFunction_P->SubdFunction, i_SF)) ; /* Index Expression */ Element->NumGroupsOfEntities[Element->NbrGroupsOfEntities++] = GroupEntity_P->Num ; } } } /* ------------------------------------------------------------------------ */ /* G e t _ G l o b a l F o r E l e m e n t */ /* ------------------------------------------------------------------------ */ void Get_GlobalForElement(struct Element * Element, int * StartingIndex, struct BasisFunction * BasisFunction_P) { int Nbr_Global, i, * Num_Global ; if (Element->NumLastElementForGroupsOfEntities != Element->Num) { Element->NumLastElementForGroupsOfEntities = Element->Num ; Element->NbrGroupsOfEntities = 0 ; } *StartingIndex = Element->NbrGroupsOfEntities ; Nbr_Global = List_Nbr(GroupEntity_P->InitialList) ; Num_Global = (Nbr_Global)? (int*)List_Pointer(GroupEntity_P->InitialList, 0) : NULL ; if (BasisFunction_P->GlobalBasisFunction) { for (i = 0 ; i < Nbr_Global ; i++) { Element->GlobalBasisFunction[Element->NbrGroupsOfEntities ] = (struct GlobalBasisFunction *) List_Pointer(BasisFunction_P->GlobalBasisFunction, i) ; /* Attention: correspondance i-i si liste triee ! fait dans yacc */ Element->NumGroupsOfEntities[Element->NbrGroupsOfEntities++] = Num_Global[i] ; } if (TreatmentStatus == _PRE) Get_PreResolutionForGlobalBasisFunction(Nbr_Global, *StartingIndex, Element) ; } else { for (i = 0 ; i < Nbr_Global ; i++) { Element->NumGroupsOfEntities[Element->NbrGroupsOfEntities++] = Num_Global[i] ; } } } /* ------------------------------------------------------------------------ */ /* G e t _ C o d e s O f E l e m e n t */ /* ------------------------------------------------------------------------ */ void Get_CodesOfElement(struct FunctionSpace * FunctionSpace_P, struct QuantityStorage * QuantityStorage_P, int Nbr_Entity, int Num_Entity[], int StartingIndex, int i_BFunction, int TypeConstraint, int * Num_SubFunction) { /* external input/output : GroupSupport_P : In GroupEntity_P : In */ int i_Entity, CodeExist = 0, Code_BasisFunction ; struct Dof * Dof_P = NULL; /* 1. F o r e a c h e n t i t y t o w h i c h a b a s i s f u n c t i o n c o u l d b e a s s o c i a t e d : (Node, Edge, Facet, Volume, GroupOfNodes, Region, ...) */ for (i_Entity = StartingIndex ; i_Entity < Nbr_Entity ; i_Entity++) { Code_BasisFunction = BasisFunction_P->Num + (Num_SubFunction? Num_SubFunction[i_Entity] : 0) ; switch (TreatmentStatus) { case _CAL : case _POS : case _CST : if(!FunctionSpace_P->DofData){ Message::Error("Empty DofData in FunctionSpace '%s' (no unknowns?)", FunctionSpace_P->Name); return; } CodeExist = ((Dof_P = Dof_GetDofStruct(FunctionSpace_P->DofData, Code_BasisFunction, abs(Num_Entity[i_Entity]), 0)) != NULL) ; if (Flag_SubSpace && CodeExist && TreatmentStatus != _POS) CodeExist = Check_IsEntityInExtendedGroup(GroupEntity_P, abs(Num_Entity[i_Entity]), 0) ; /* ... parce que le code peut ne pas exister quand sous-espace ! */ break ; case _PRE : CodeExist = Check_IsEntityInExtendedGroup(GroupEntity_P, abs(Num_Entity[i_Entity]), 0) ; break ; default : Message::Error("Unknown TreatmentStatus (%d)", TreatmentStatus); return; } /* 2. O n e a s s o c i a t e s a b a s i s f u n c t i o n : */ if (CodeExist) { QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].Dof = Dof_P ; QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].NumEntityInElement = i_Entity ; QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].CodeBasisFunction = Code_BasisFunction ; QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].CodeEntity = abs(Num_Entity[i_Entity]) ; QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].BasisFunction = BasisFunction_P ; if (TreatmentStatus == _PRE || TreatmentStatus == _CST) /* Associated Contraints? */ Treatment_ConstraintForElement(FunctionSpace_P, QuantityStorage_P, Num_Entity, i_Entity, i_BFunction, TypeConstraint) ; Nbr_ElementaryBF++ ; } /* if CodeExist ... */ } /* for i_Entity ... */ } /* ------------------------------------------------------------------------ */ /* G e t _ D o f O f R e g i o n */ /* ------------------------------------------------------------------------ */ void Get_DofOfRegion(int Num_Region, struct GlobalQuantity * GlobalQuantity_P, struct FunctionSpace * FunctionSpace_P, struct QuantityStorage * QuantityStorage_P) { int CodeExist = 0, Num_BasisFunction, Num_AssociateBasisFunction ; int Num_Entity = -1; struct Dof * Dof_P = NULL; Nbr_ElementaryBF = 0 ; BasisFunction_P = (struct BasisFunction*) List_Pointer(FunctionSpace_P->BasisFunction, GlobalQuantity_P->ReferenceIndex) ; GroupEntity_P = (struct Group*) List_Pointer(Problem_S.Group, BasisFunction_P->EntityIndex) ; if (GroupEntity_P->Type == REGIONLIST && List_Search(GroupEntity_P->InitialList, &Num_Region, fcmp_int)) { if (GlobalQuantity_P->Type == ALIASOF) { Num_BasisFunction = BasisFunction_P->Num ; Num_AssociateBasisFunction = 0 ; } else { Num_BasisFunction = GlobalQuantity_P->Num ; Num_AssociateBasisFunction = BasisFunction_P->Num ; } if (GroupEntity_P->FunctionType == GROUPOFREGIONSOF) Num_Entity = GroupEntity_P->Num; else Num_Entity = Num_Region; switch (TreatmentStatus) { case _CAL : case _POS : case _CST : if(!FunctionSpace_P->DofData){ Message::Error("Empty DofData in FunctionSpace '%s' (no unknowns?)", FunctionSpace_P->Name); return; } CodeExist = ((Dof_P = Dof_GetDofStruct(FunctionSpace_P->DofData, Num_BasisFunction, Num_Entity, 0)) != NULL) ; break ; case _PRE : CodeExist = 1 ; break ; default : break ; } if (CodeExist) { QuantityStorage_P->BasisFunction[0].Dof = Dof_P ; QuantityStorage_P->BasisFunction[0].CodeBasisFunction = Num_BasisFunction ; QuantityStorage_P->BasisFunction[0].CodeEntity = Num_Entity ; QuantityStorage_P->BasisFunction[0].CodeAssociateBasisFunction = Num_AssociateBasisFunction ; if (TreatmentStatus == _PRE || TreatmentStatus == _CST) /* Contrainte associee ? */ Treatment_ConstraintForRegion(GlobalQuantity_P, FunctionSpace_P, QuantityStorage_P) ; Nbr_ElementaryBF = 1 ; } /* if CodeExist ... */ } /* if REGIONLIST ... */ QuantityStorage_P->NbrElementaryBasisFunction = Nbr_ElementaryBF ; } /* ------------------------------------------------------------------------ */ /* G e t _ P r e R e s o l u t i o n F o r GlobalBasisFunction */ /* ------------------------------------------------------------------------ */ void Get_PreResolutionForGlobalBasisFunction(int Nbr_Global, int StartingIndex, struct Element * Element) { int i ; struct PreResolutionInfo PreResolutionInfo_S ; for (i = 0 ; i < Nbr_Global ; i++) if(List_ISearchSeq(PreResolutionIndex_L, &(Element->GlobalBasisFunction[StartingIndex + i]-> ResolutionIndex), fcmp_int) < 0) { PreResolutionInfo_S.Index = Element->GlobalBasisFunction[StartingIndex + i]->ResolutionIndex ; PreResolutionInfo_S.Type = PR_GLOBALBASISFUNCTION ; List_Add(PreResolutionIndex_L, &PreResolutionInfo_S) ; Message::Info(" Adding Resolution '%s' for Pre-Resolution (Global BF)", ((struct Resolution*)List_Pointer(Problem_S.Resolution, PreResolutionInfo_S.Index))->Name) ; } } getdp-2.7.0-source/Legacy/BF_GroupOfEntities.cpp000644 001750 001750 00000034552 12473553042 023164 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "ProData.h" #include "BF.h" #include "Get_Geometry.h" #define ARGS \ struct Element * Element, int NumGroup, \ double u, double v, double w, double *s void BF_SubFunction(struct Element * Element, int NumExpression, int Dim, double s[]); /* ------------------------------------------------------------------------ */ /* B F _ G r o u p O f N o d e s */ /* ------------------------------------------------------------------------ */ #define BF(BF_GroupOfNodes_X,BF_Node_X) \ int i ; \ double val ; \ \ *s = 0. ; \ for (i = 0; i < Element->NbrEntitiesInGroups[NumGroup-1]; i++) { \ (BF_Node_X) \ (Element, Element->NumEntitiesInGroups[NumGroup-1][i], u, v, w, &val) ; \ *s += val ; \ } \ \ if (Element->NumSubFunction[0][NumGroup-1] >= 0) \ BF_SubFunction(Element, Element->NumSubFunction[0][NumGroup-1], 1, s) ; void BF_GroupOfNodes(ARGS) { BF("BF_GroupOfNodes",BF_Node) ; } void BF_GroupOfNodes_2E(ARGS) { BF("BF_GroupOfNodes_2E",BF_Node_2E) ; } void BF_GroupOfNodes_2F(ARGS) { BF("BF_GroupOfNodes_2F",BF_Node_2F) ; } void BF_GroupOfNodes_2V(ARGS) { BF("BF_GroupOfNodes_2V",BF_Node_2V) ; } void BF_GroupOfNodes_3E(ARGS) { BF("BF_GroupOfNodes_3E",BF_Node_3E) ; } void BF_GroupOfNodes_3F(ARGS) { BF("BF_GroupOfNodes_3F",BF_Node_3F) ; } void BF_GroupOfNodes_3V(ARGS) { BF("BF_GroupOfNodes_3V",BF_Node_3V) ; } #undef BF /* ------------------------------------------------------------------------ */ /* B F _ G r a d G r o u p O f N o d e s */ /* ------------------------------------------------------------------------ */ #define BF(BF_GradGroupOfNodes_X,BF_GradNode_X) \ int i ; \ double val[3] ; \ \ s[0] = s[1] = s[2] = 0. ; \ for (i = 0; i < Element->NbrEntitiesInGroups[NumGroup-1]; i++) { \ (BF_GradNode_X) \ (Element, Element->NumEntitiesInGroups[NumGroup-1][i], u, v, w, val) ; \ s[0] += val[0] ; s[1] += val[1] ; s[2] += val[2] ; \ } \ \ if (Element->NumSubFunction[0][NumGroup-1] >= 0) \ BF_SubFunction(Element, Element->NumSubFunction[0][NumGroup-1], 3, s) ; void BF_GradGroupOfNodes (ARGS) { BF("BF_GradGroupOfNodes",BF_GradNode) ; } void BF_GradGroupOfNodes_2E(ARGS) { BF("BF_GradGroupOfNodes_2E",BF_GradNode_2E) ; } void BF_GradGroupOfNodes_2F(ARGS) { BF("BF_GradGroupOfNodes_2F",BF_GradNode_2F) ; } void BF_GradGroupOfNodes_2V(ARGS) { BF("BF_GradGroupOfNodes_2V",BF_GradNode_2V) ; } void BF_GradGroupOfNodes_3E(ARGS) { BF("BF_GradGroupOfNodes_3E",BF_GradNode_3E) ; } void BF_GradGroupOfNodes_3F(ARGS) { BF("BF_GradGroupOfNodes_3F",BF_GradNode_3F) ; } void BF_GradGroupOfNodes_3V(ARGS) { BF("BF_GradGroupOfNodes_3V",BF_GradNode_3V) ; } #undef BF /* ------------------------------------------------------------------------ */ /* B F _ G r o u p O f P e r p e n d i c u l a r E d g e s */ /* ------------------------------------------------------------------------ */ #define BF(BF_GroupOfPerpendicularEdges_X,BF_Node_X) \ int i ; \ double val ; \ \ s[0] = s[1] = s[2] = 0. ; \ for (i = 0; i < Element->NbrEntitiesInGroups[NumGroup-1]; i++) { \ (BF_Node_X) \ (Element, Element->NumEntitiesInGroups[NumGroup-1][i], u, v, w, &val) ; \ s[2] += val ; \ } \ \ if (Element->NumSubFunction[0][NumGroup-1] >= 0) \ BF_SubFunction(Element, Element->NumSubFunction[0][NumGroup-1], 3, s) ; void BF_GroupOfPerpendicularEdges (ARGS){ BF("BF_GroupOfPerpendicularEdges",BF_Node) ; } void BF_GroupOfPerpendicularEdges_2E(ARGS){ BF("BF_GroupOfPerpendicularEdges_2E",BF_Node_2E) ; } void BF_GroupOfPerpendicularEdges_2F(ARGS){ BF("BF_GroupOfPerpendicularEdges_2F",BF_Node_2F) ; } void BF_GroupOfPerpendicularEdges_2V(ARGS){ BF("BF_GroupOfPerpendicularEdges_2V",BF_Node_2V) ; } void BF_GroupOfPerpendicularEdges_3E(ARGS){ BF("BF_GroupOfPerpendicularEdges_3E",BF_Node_3E) ; } void BF_GroupOfPerpendicularEdges_3F(ARGS){ BF("BF_GroupOfPerpendicularEdges_3F",BF_Node_3F) ; } void BF_GroupOfPerpendicularEdges_3V(ARGS){ BF("BF_GroupOfPerpendicularEdges_3V",BF_Node_3V) ; } #undef BF /* ------------------------------------------------------------------------ */ /* B F _ C u r l G r o u p O f P e r p e n d i c u l a r E d g e s */ /* ------------------------------------------------------------------------ */ #define BF(BF_CurlGroupOfPerpendicularEdges_X,BF_GradNode_X) \ int i ; \ double val[3] ; \ \ s[0] = s[1] = s[2] = 0. ; \ for (i = 0; i < Element->NbrEntitiesInGroups[NumGroup-1]; i++) { \ (BF_GradNode_X) \ (Element, Element->NumEntitiesInGroups[NumGroup-1][i], u, v, w, val) ; \ s[0] += val[1] ; s[1] += -val[0] ; \ } \ \ if (Element->NumSubFunction[0][NumGroup-1] >= 0) \ BF_SubFunction(Element, Element->NumSubFunction[0][NumGroup-1], 3, s) ; void BF_CurlGroupOfPerpendicularEdges (ARGS){ BF("BF_CurlGroupOfPerpendicularEdges",BF_GradNode) ; } void BF_CurlGroupOfPerpendicularEdges_2E(ARGS){ BF("BF_CurlGroupOfPerpendicularEdges_2E",BF_GradNode_2E) ; } void BF_CurlGroupOfPerpendicularEdges_2F(ARGS){ BF("BF_CurlGroupOfPerpendicularEdges_2F",BF_GradNode_2F) ; } void BF_CurlGroupOfPerpendicularEdges_2V(ARGS){ BF("BF_CurlGroupOfPerpendicularEdges_2V",BF_GradNode_2V) ; } void BF_CurlGroupOfPerpendicularEdges_3E(ARGS){ BF("BF_CurlGroupOfPerpendicularEdges_3E",BF_GradNode_3E) ; } void BF_CurlGroupOfPerpendicularEdges_3F(ARGS){ BF("BF_CurlGroupOfPerpendicularEdges_3F",BF_GradNode_3F) ; } void BF_CurlGroupOfPerpendicularEdges_3V(ARGS){ BF("BF_CurlGroupOfPerpendicularEdges_3V",BF_GradNode_3V) ; } #undef BF /* ------------------------------------------------------------------------ */ /* B F _ G r o u p O f E d g e s */ /* ------------------------------------------------------------------------ */ #define BF(BF_GroupOfEdges_X,BF_Edge_X) \ int i, Num ; \ double val[3] ; \ \ s[0] = s[1] = s[2] = 0. ; \ for (i = 0; i < Element->NbrEntitiesInGroups[NumGroup-1]; i++) { \ (BF_Edge_X) \ (Element, abs(Num = Element->NumEntitiesInGroups[NumGroup-1][i]), \ u, v, w, val) ; \ if (Num > 0) { s[0] += val[0] ; s[1] += val[1] ; s[2] += val[2] ; } \ else { s[0] -= val[0] ; s[1] -= val[1] ; s[2] -= val[2] ; } \ } void BF_GroupOfEdges (ARGS){ BF("BF_GroupOfEdges",BF_Edge) ; } void BF_GroupOfEdges_2E(ARGS){ BF("BF_GroupOfEdges_2E",BF_Edge_2E) ; } void BF_GroupOfEdges_2F(ARGS){ BF("BF_GroupOfEdges_2F",BF_Edge_2F) ; } void BF_GroupOfEdges_2V(ARGS){ BF("BF_GroupOfEdges_2V",BF_Edge_2V) ; } void BF_GroupOfEdges_3E(ARGS){ BF("BF_GroupOfEdges",BF_Edge_3E) ; } void BF_GroupOfEdges_3F_a(ARGS){ BF("BF_GroupOfEdges_3F_a",BF_Edge_3F_a) ; } void BF_GroupOfEdges_3F_b(ARGS){ BF("BF_GroupOfEdges_3F_b", BF_Edge_3F_b) ; } void BF_GroupOfEdges_3F_c(ARGS){ BF("BF_GroupOfEdges_3F_c", BF_Edge_3F_c) ; } void BF_GroupOfEdges_3V(ARGS){ BF("BF_GroupOfEdges_3V",BF_Edge_3V) ; } void BF_GroupOfEdges_4E(ARGS){ BF("BF_GroupOfEdges_4E",BF_Edge_4E) ; } void BF_GroupOfEdges_4F(ARGS){ BF("BF_GroupOfEdges_4F",BF_Edge_4F) ; } void BF_GroupOfEdges_4V(ARGS){ BF("BF_GroupOfEdges_4V",BF_Edge_4V) ; } #undef BF /* ------------------------------------------------------------------------ */ /* B F _ C u r l G r o u p O f E d g e s */ /* ------------------------------------------------------------------------ */ #define BF(BF_CurlGroupOfEdges_X,BF_CurlEdge_X) \ int i, Num ; \ double val[3] ; \ \ s[0] = s[1] = s[2] = 0. ; \ for (i = 0; i < Element->NbrEntitiesInGroups[NumGroup-1]; i++) { \ (BF_CurlEdge_X) \ (Element, abs(Num = Element->NumEntitiesInGroups[NumGroup-1][i]), \ u, v, w, val) ; \ if (Num > 0) { s[0] += val[0] ; s[1] += val[1] ; s[2] += val[2] ; } \ else { s[0] -= val[0] ; s[1] -= val[1] ; s[2] -= val[2] ; } \ } void BF_CurlGroupOfEdges(ARGS){ BF("BF_CurlGroupOfEdges",BF_CurlEdge) ; } void BF_CurlGroupOfEdges_2E(ARGS){ BF("BF_CurlGroupOfEdges_2E",BF_CurlEdge_2E) ; } void BF_CurlGroupOfEdges_2F(ARGS){ BF("BF_CurlGroupOfEdges_2F",BF_CurlEdge_2F) ; } void BF_CurlGroupOfEdges_2V(ARGS){ BF("BF_CurlGroupOfEdges_2V",BF_CurlEdge_2V) ; } void BF_CurlGroupOfEdges_3E(ARGS){ BF("BF_CurlGroupOfEdges_3E",BF_CurlEdge_3E) ; } void BF_CurlGroupOfEdges_3F_a(ARGS){ BF("BF_CurlGroupOfEdges_3F_a",BF_CurlEdge_3F_a) ; } void BF_CurlGroupOfEdges_3F_b(ARGS){ BF("BF_CurlGroupOfEdges_3F_b",BF_CurlEdge_3F_b) ; } void BF_CurlGroupOfEdges_3F_c(ARGS){ BF("BF_CurlGroupOfEdges_3F_c",BF_CurlEdge_3F_c) ; } void BF_CurlGroupOfEdges_3V(ARGS){ BF("BF_CurlGroupOfEdges_3V",BF_CurlEdge_3V) ; } void BF_CurlGroupOfEdges_4E(ARGS){ BF("BF_CurlGroupOfEdges_4E",BF_CurlEdge_4E) ; } void BF_CurlGroupOfEdges_4F(ARGS){ BF("BF_CurlGroupOfEdges_4F",BF_CurlEdge_4F) ; } void BF_CurlGroupOfEdges_4V(ARGS){ BF("BF_CurlGroupOfEdges_4V",BF_CurlEdge_4V) ; } #undef BF /* ------------------------------------------------------------------------ */ /* B F _ G r o u p O f F a c e t s */ /* ------------------------------------------------------------------------ */ #define BF(BF_GroupOfFacets_X,BF_Facet_X) \ int i, Num ; \ double val[3] ; \ \ s[0] = s[1] = s[2] = 0. ; \ for (i = 0; i < Element->NbrEntitiesInGroups[NumGroup-1]; i++) { \ (BF_Facet_X) \ (Element, abs(Num = Element->NumEntitiesInGroups[NumGroup-1][i]), \ u, v, w, val) ; \ if (Num > 0) { s[0] += val[0] ; s[1] += val[1] ; s[2] += val[2] ; } \ else { s[0] -= val[0] ; s[1] -= val[1] ; s[2] -= val[2] ; } \ } void BF_GroupOfFacets (ARGS){ BF("BF_GroupOfFacets",BF_Facet) ; } #undef BF /* ------------------------------------------------------------------------ */ /* B F _ D i v G r o u p O f F a c e t s */ /* ------------------------------------------------------------------------ */ #define BF(BF_DivGroupOfFacets_X,BF_DivFacet_X) \ int i, Num ; \ double val ; \ \ *s = 0. ; \ for (i = 0; i < Element->NbrEntitiesInGroups[NumGroup-1]; i++) { \ (BF_DivFacet_X) \ (Element, abs(Num = Element->NumEntitiesInGroups[NumGroup-1][i]), \ u, v, w, &val) ; \ if (Num > 0) { *s += val ; } \ else { *s -= val ; } \ } void BF_DivGroupOfFacets(ARGS){ BF("BF_DivGroupOfFacets",BF_DivFacet) ; } #undef BF /* ------------------------------------------------------------------------ */ /* B F _ G r o u p O f N o d e s X , Y , Z */ /* ------------------------------------------------------------------------ */ void BF_GroupOfNodesX(struct Element * Element, int NumGroup, double u, double v, double w, double s[]) { s[1] = s[2] = 0. ; BF_GroupOfNodes(Element, NumGroup, u, v, w, &s[0]) ; } void BF_GroupOfNodesY(struct Element * Element, int NumGroup, double u, double v, double w, double s[]) { s[0] = s[2] = 0. ; BF_GroupOfNodes(Element, NumGroup, u, v, w, &s[1]) ; } void BF_GroupOfNodesZ(struct Element * Element, int NumGroup, double u, double v, double w, double s[]) { s[0] = s[1] = 0. ; BF_GroupOfNodes(Element, NumGroup, u, v, w, &s[2]) ; } /* ------------------------------------------------------------------------ */ /* B F _ G r o u p O f N o d e X , Y , Z _ D . . . */ /* ------------------------------------------------------------------------ */ void BF_GroupOfNodesX_D12(struct Element * Element, int NumNode, double u, double v, double w, double s[]) { double su[3] ; BF_GradGroupOfNodes(Element, NumNode, u, v, w, su) ; ChangeOfCoord_Form1(Element, su, s) ; s[2] = s[1] ; s[1] = 0. ; } void BF_GroupOfNodesY_D12(struct Element * Element, int NumNode, double u, double v, double w, double s[]) { double su[3] ; BF_GradGroupOfNodes(Element, NumNode, u, v, w, su) ; ChangeOfCoord_Form1(Element, su, s) ; s[2] = s[0] ; s[0] = 0. ; } void BF_GroupOfNodesZ_D12(struct Element * Element, int NumNode, double u, double v, double w, double s[]) { s[0] = s[1] = s[2] = 0. ; } /* ------------------------------------------------------------------------ */ void BF_GroupOfNodesX_D1(struct Element * Element, int NumNode, double u, double v, double w, double s[]) { double su[3] ; BF_GradGroupOfNodes(Element, NumNode, u, v, w, su) ; ChangeOfCoord_Form1(Element, su, s) ; s[1] = s[2] = 0; } void BF_GroupOfNodesY_D1(struct Element * Element, int NumNode, double u, double v, double w, double s[]) { double su[3] ; BF_GradGroupOfNodes(Element, NumNode, u, v, w, su) ; ChangeOfCoord_Form1(Element, su, s) ; s[0] = s[2] = 0; } void BF_GroupOfNodesZ_D1(struct Element * Element, int NumNode, double u, double v, double w, double s[]) { double su[3] ; BF_GradGroupOfNodes(Element, NumNode, u, v, w, su) ; ChangeOfCoord_Form1(Element, su, s) ; s[0] = s[1] = 0; } /* ------------------------------------------------------------------------ */ void BF_GroupOfNodesX_D2(struct Element * Element, int NumNode, double u, double v, double w, double s[]) { double su[3] ; BF_GradGroupOfNodes(Element, NumNode, u, v, w, su) ; ChangeOfCoord_Form1(Element, su, s) ; s[0] = s[1] ; s[1] = 0 ; } void BF_GroupOfNodesY_D2(struct Element * Element, int NumNode, double u, double v, double w, double s[]) { double su[3] ; BF_GradGroupOfNodes(Element, NumNode, u, v, w, su) ; ChangeOfCoord_Form1(Element, su, s) ; s[1] = s[2] ; s[2] = 0 ; } void BF_GroupOfNodesZ_D2(struct Element * Element, int NumNode, double u, double v, double w, double s[]) { double su[3] ; BF_GradGroupOfNodes(Element, NumNode, u, v, w, su) ; ChangeOfCoord_Form1(Element, su, s) ; s[2] = s[0] ; s[0] = 0 ; } getdp-2.7.0-source/Legacy/F_MultiHar.cpp000644 001750 001750 00000063075 12473553042 021523 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Johan Gyselinck // #include #include "ProData.h" #include "ProDefine.h" #include "DofData.h" #include "F.h" #include "Get_Geometry.h" #include "Get_FunctionValue.h" #include "Cal_Quantity.h" #include "MallocUtils.h" #include "Message.h" #define TWO_PI 6.2831853071795865 extern struct Problem Problem_S ; extern struct CurrentData Current ; struct MH_InitData{ int Case ; int NbrPoints, NbrPointsX; /* number of samples per smallest and fundamental period resp. */ struct DofData *DofData ; double **H, ***HH ; double *t, *w; }; List_T * MH_InitData_L = NULL; int fcmp_MH_InitData(const void * a, const void * b) { int Result ; if ((Result = ((struct MH_InitData *)a)->DofData - ((struct MH_InitData *)b)->DofData) != 0) return Result ; if ((Result = ((struct MH_InitData *)a)->Case - ((struct MH_InitData *)b)->Case) != 0) return Result ; if (((struct MH_InitData *)a)->Case != 3) return ((struct MH_InitData *)a)->NbrPoints - ((struct MH_InitData *)b)->NbrPoints ; else return ((struct MH_InitData *)a)->NbrPointsX - ((struct MH_InitData *)b)->NbrPointsX ; } int NbrValues_Type (int Type) { switch (Type){ case SCALAR : return 1 ; case VECTOR : case TENSOR_DIAG : return 3 ; case TENSOR_SYM : return 6 ; case TENSOR : return 9 ; default : Message::Error("Unknown type in NbrValues_Type"); return 0; } } double Product_SCALARxSCALARxSCALAR (double *V1, double *V2, double *V3) { return V1[0] * V2[0] * V3[0] ; } double Product_VECTORxTENSOR_SYMxVECTOR (double *V1, double *V2, double *V3) { return V3[0] * (V1[0] * V2[0] + V1[1] * V2[1] + V1[2] * V2[2]) + V3[1] * (V1[0] * V2[1] + V1[1] * V2[3] + V1[2] * V2[4]) + V3[2] * (V1[0] * V2[2] + V1[1] * V2[4] + V1[2] * V2[5]) ; } double Product_VECTORxTENSOR_DIAGxVECTOR (double *V1, double *V2, double *V3) { return V1[0] * V2[0] * V3[0] + V1[1] * V2[1] * V3[1] + V1[2] * V2[2] * V3[2] ; } double Product_VECTORxSCALARxVECTOR (double *V1, double *V2, double *V3) { return V2[0] * (V1[0] * V3[0] + V1[1] * V3[1] + V1[2] * V3[2]) ; } void *Get_RealProductFunction_Type1xType2xType1 (int Type1, int Type2) { if (Type1 == SCALAR && Type2 == SCALAR) { return (void *)Product_SCALARxSCALARxSCALAR; } else if (Type1 == VECTOR && Type2 == TENSOR_SYM) { return (void *)Product_VECTORxTENSOR_SYMxVECTOR; } else if (Type1 == VECTOR && Type2 == TENSOR_DIAG) { return (void *)Product_VECTORxTENSOR_DIAGxVECTOR; } else if (Type1 == VECTOR && Type1 == SCALAR) { return (void *)Product_VECTORxSCALARxVECTOR; } else { Message::Error("Not allowed types in Get_RealProductFunction_Type1xType2xType1"); return 0; } } /* ------------------------------------------------------------------------ */ /* MH_Get_InitData */ /* ------------------------------------------------------------------------ */ /* Case = 1 : MHTransform NbrPoints (samples per smallest period) is given, NbrPointsX (samples per fundamental period) is derived Case = 2 : MHJacNL NbrPoints given, NbrPointsX derived Case = 3 : HarmonicToTime NbrPointsX given, NbrPoints derived */ void MH_Get_InitData(int Case, int NbrPoints, int *NbrPointsX_P, double ***H_P, double ****HH_P, double **t_P, double **w_P) { int NbrHar, iPul, iTime, iHar, jHar, NbrPointsX ; double *Val_Pulsation, MaxPuls, MinPuls ; double **H, ***HH = 0, *t, *w ; struct MH_InitData MH_InitData_S, *MH_InitData_P ; MH_InitData_S.Case = Case; MH_InitData_S.DofData = Current.DofData; MH_InitData_S.NbrPoints = NbrPoints; MH_InitData_S.NbrPointsX = NbrPointsX = *NbrPointsX_P; if (MH_InitData_L == NULL) MH_InitData_L = List_Create(1, 1, sizeof(struct MH_InitData)) ; if ((MH_InitData_P = (struct MH_InitData *) List_PQuery(MH_InitData_L, &MH_InitData_S, fcmp_MH_InitData))){ *H_P = MH_InitData_P->H; *HH_P = MH_InitData_P->HH; *t_P = MH_InitData_P->t; *w_P = MH_InitData_P->w; *NbrPointsX_P = MH_InitData_P->NbrPointsX; return; } NbrHar = Current.NbrHar; Val_Pulsation = Current.DofData->Val_Pulsation; MaxPuls = 0. ; MinPuls = 1.e99 ; for (iPul = 0 ; iPul < NbrHar/2 ; iPul++) { if (Val_Pulsation[iPul] && Val_Pulsation[iPul] < MinPuls) MinPuls = Val_Pulsation[iPul] ; if (Val_Pulsation[iPul] && Val_Pulsation[iPul] > MaxPuls) MaxPuls = Val_Pulsation[iPul] ; } if (Case != 3) NbrPointsX = (int)((MaxPuls/MinPuls*(double)NbrPoints)); else NbrPoints = (int)((MinPuls/MaxPuls*(double)NbrPointsX)); if(Case==1) Message::Info("MH_Get_InitData (MHTransform) => NbrHar = %d NbrPoints = %d|%d", NbrHar, NbrPoints, NbrPointsX); if(Case==2) Message::Info("MH_Get_InitData (MHJacNL) => NbrHar = %d NbrPoints = %d|%d", NbrHar, NbrPoints, NbrPointsX); if(Case==3) Message::Info("MH_Get_InitData (HarmonicToTime) => NbrHar = %d NbrPoints = %d|%d", NbrHar, NbrPoints, NbrPointsX); t = (double *)Malloc(sizeof(double)*NbrPointsX) ; if (Case != 3) for (iTime = 0 ; iTime < NbrPointsX ; iTime++) t[iTime] = (double)iTime/(double)NbrPointsX/(MinPuls/TWO_PI) ; else for (iTime = 0 ; iTime < NbrPointsX ; iTime++) t[iTime] = (double)iTime/((double)NbrPointsX-1.)/(MinPuls/TWO_PI) ; w = (double *)Malloc(sizeof(double)*NbrHar) ; for (iPul = 0 ; iPul < NbrHar/2 ; iPul++) if (Val_Pulsation[iPul]){ w[2*iPul ] = 2. / (double)NbrPointsX ; w[2*iPul+1] = 2. / (double)NbrPointsX ; } else{ w[2*iPul ] = 1. / (double)NbrPointsX ; w[2*iPul+1] = 1. / (double)NbrPointsX ; } H = (double **)Malloc(sizeof(double *)*NbrPointsX) ; for (iTime = 0 ; iTime < NbrPointsX ; iTime++){ H[iTime] = (double *)Malloc(sizeof(double)*NbrHar) ; for (iPul = 0 ; iPul < NbrHar/2 ; iPul++) { H[iTime][2*iPul ] = cos(Val_Pulsation[iPul] * t[iTime]) ; H[iTime][2*iPul+1] = - sin(Val_Pulsation[iPul] * t[iTime]) ; } } /* for (iHar = 0 ; iHar < NbrHar ; iHar++) for (jHar = iHar ; jHar < NbrHar ; jHar++){ sum = 0.; for (iTime = 0 ; iTime < NbrPointsX ; iTime++) sum += w[iTime] * H[iTime][iHar] * H[iTime][jHar] ; sum -= (iHar==jHar)? 1. : 0. ; printf("iHar %d jHar %d sum %e\n", iHar, jHar, sum); } */ if (Case == 2) { if(Current.DofData->Flag_Init[0] < 2) Message::Error("Jacobian system not initialized (missing GenerateJac?)"); HH = (double ***)Malloc(sizeof(double **)*NbrPointsX) ; for (iTime = 0 ; iTime < NbrPointsX ; iTime++){ HH[iTime] = (double **)Malloc(sizeof(double *)*NbrHar) ; for (iHar = 0 ; iHar < NbrHar ; iHar++){ HH[iTime][iHar] = (double *)Malloc(sizeof(double)*NbrHar) ; for (jHar = 0 ; jHar < NbrHar ; jHar++){ if (Val_Pulsation [iHar/2] && Val_Pulsation [jHar/2] ) HH[iTime][iHar][jHar] = 2. / (double)NbrPointsX * H[iTime][iHar] * H[iTime][jHar] ; else HH[iTime][iHar][jHar] = 1. / (double)NbrPointsX * H[iTime][iHar] * H[iTime][jHar] ; } } } } *H_P = MH_InitData_S.H = H; *t_P = MH_InitData_S.t = t; *w_P = MH_InitData_S.w = w; *HH_P = MH_InitData_S.HH = HH; *NbrPointsX_P = MH_InitData_S.NbrPointsX = NbrPointsX; List_Add (MH_InitData_L, &MH_InitData_S); } /* ------------------------------------------------------------------------ */ /* F_MHToTime0 (HarmonicToTime in PostOperation) */ /* ------------------------------------------------------------------------ */ void F_MHToTime0(int init, struct Value * A, struct Value * V, int iTime, int NbrPointsX, double * TimeMH) { static double **H, ***HH, *t, *weight; int iVal, nVal, iHar; if (Current.NbrHar == 1) return; if (!init) MH_Get_InitData(3, 0, &NbrPointsX, &H, &HH, &t, &weight); *TimeMH = t[iTime] ; V->Type = A->Type ; nVal = NbrValues_Type (A->Type) ; for (iVal = 0 ; iVal < nVal ; iVal++){ V->Val[iVal] = 0; for (iHar = 0 ; iHar < Current.NbrHar ; iHar++) V->Val[iVal] += H[iTime][iHar] * A->Val[iHar*MAX_DIM+iVal] ; } } /* ---------------------------------------------------------------------- */ /* F_MHToTime */ /* ---------------------------------------------------------------------- */ void F_MHToTime (struct Function * Fct, struct Value * A, struct Value * V) { int iHar, iVal, nVal ; double time, H[NBR_MAX_HARMONIC]; struct Value Vtemp; if (Current.NbrHar == 1) Message::Error("'F_MHToTime' only for Multi-Harmonic stuff") ; if((A+1)->Type != SCALAR) Message::Error("'F_MHToTime' requires second scalar argument (time)"); time = (A+1)->Val[0] ; for (iHar = 0 ; iHar < Current.NbrHar/2 ; iHar++) { /* if (Current.DofData->Val_Pulsation [iHar]){ */ H[2*iHar ] = cos(Current.DofData->Val_Pulsation[iHar] * time) ; H[2*iHar+1] = - sin(Current.DofData->Val_Pulsation[iHar] * time) ; /* } else { H[2*iHar ] = 0.5 ; H[2*iHar+1] = 0 ; } */ } nVal = NbrValues_Type (A->Type) ; for (iVal = 0 ; iVal < MAX_DIM ; iVal++) for (iHar = 0 ; iHar < Current.NbrHar ; iHar++) Vtemp.Val[iHar*MAX_DIM+iVal] = 0.; for (iVal = 0 ; iVal < nVal ; iVal++) for (iHar = 0 ; iHar < Current.NbrHar ; iHar++) Vtemp.Val[iVal] += H[iHar] * A->Val[iHar*MAX_DIM+iVal] ; V->Type = A->Type ; for (iVal = 0 ; iVal < MAX_DIM ; iVal++) for (iHar = 0 ; iHar < Current.NbrHar ; iHar++) V->Val[iHar*MAX_DIM+iVal] = Vtemp.Val[iHar*MAX_DIM+iVal] ; } /* ------------------------------------------------------------------------ */ /* MHTransform */ /* ------------------------------------------------------------------------ */ void MHTransform(struct Element * Element, struct QuantityStorage * QuantityStorage_P0, double u, double v, double w, struct Value *MH_Value, struct Expression * Expression_P, int NbrPoints) { double **H, ***HH, *t, *weight ; int NbrHar; struct Value t_Value, MH_Value_Tr; int NbrPointsX, iVal, nVal1, nVal2 = 0, iHar, iTime; MH_Get_InitData(1, NbrPoints, &NbrPointsX, &H, &HH, &t, &weight); nVal1 = NbrValues_Type (MH_Value->Type) ; t_Value.Type = MH_Value_Tr.Type = MH_Value->Type; NbrHar = Current.NbrHar; /* save NbrHar */ Current.NbrHar = 1; /* evaluation in time domain ! */ for (iVal = 0 ; iVal < MAX_DIM ; iVal++) for (iHar = 0 ; iHar < NbrHar ; iHar++) MH_Value_Tr.Val[iHar*MAX_DIM+iVal] = 0. ; for (iTime = 0 ; iTime < NbrPointsX ; iTime++) { for (iVal = 0 ; iVal < nVal1 ; iVal++){ /* evaluation of MH_Value at iTime-th time point */ t_Value.Val[iVal] = 0; for (iHar = 0 ; iHar < NbrHar ; iHar++) t_Value.Val[iVal] += H[iTime][iHar] * MH_Value->Val[iHar*MAX_DIM+iVal] ; } /* evaluation of the function */ Get_ValueOfExpression(Expression_P, QuantityStorage_P0, u, v, w, &t_Value, 1); //To generalize: Function in MHTransform (e.g. h[{d a}]) has 1 argument if (!iTime) nVal2 = NbrValues_Type (t_Value.Type) ; for (iVal = 0 ; iVal < nVal2 ; iVal++) for (iHar = 0 ; iHar < NbrHar ; iHar++) MH_Value_Tr.Val[iHar*MAX_DIM+iVal] += weight[iHar] * H[iTime][iHar] * t_Value.Val[iVal] ; /* weight[iTime] * H[iTime][iHar] * t_Value.Val[iVal] ; */ } /* for iTime */ for (iVal = 0 ; iVal < nVal2 ; iVal++) for (iHar = 0 ; iHar < NbrHar ; iHar++) MH_Value->Val[iHar*MAX_DIM+iVal] = MH_Value_Tr.Val[iHar*MAX_DIM+iVal] ; MH_Value->Type = t_Value.Type ; Current.NbrHar = NbrHar ; } /* ----------------------------------------------------------------------------------- */ /* C a l _ I n i t G a l e r k i n T e r m O f F e m E q u a t i o n _ M H J a c N L */ /* ----------------------------------------------------------------------------------- */ void Cal_InitGalerkinTermOfFemEquation_MHJacNL(struct EquationTerm * EquationTerm_P) { struct FemLocalTermActive * FI ; List_T * WholeQuantity_L; struct WholeQuantity *WholeQuantity_P0 ; int i_WQ ; FI = EquationTerm_P->Case.LocalTerm.Active ; FI->MHJacNL = 0 ; /* search for MHJacNL-term(s) */ WholeQuantity_L = EquationTerm_P->Case.LocalTerm.Term.WholeQuantity ; WholeQuantity_P0 = (struct WholeQuantity*)List_Pointer(WholeQuantity_L, 0) ; i_WQ = 0 ; while ( i_WQ < List_Nbr(WholeQuantity_L) && (WholeQuantity_P0 + i_WQ)->Type != WQ_MHJACNL) i_WQ++ ; if (i_WQ == List_Nbr(WholeQuantity_L) ) return; /* no MHJacNL stuff, let's get the hell out of here ! */ /* check if Galerkin term produces symmetrical contribution to system matrix */ if (!FI->SymmetricalMatrix) Message::Error("Galerkin term with MHJacNL must be symmetrical"); if(EquationTerm_P->Case.LocalTerm.Term.CanonicalWholeQuantity_Equ != CWQ_NONE) Message::Error("Not allowed expression in Galerkin term with MHJacNL"); if(EquationTerm_P->Case.LocalTerm.Term.TypeTimeDerivative != JACNL_) Message::Error("MHJacNL can only be used with JACNL") ; if (List_Nbr(WholeQuantity_L) == 4){ if (i_WQ != 1 || EquationTerm_P->Case.LocalTerm.Term.DofIndexInWholeQuantity != 2 || (WholeQuantity_P0 + 3)->Type != WQ_BINARYOPERATOR || (WholeQuantity_P0 + 3)->Case.Operator.TypeOperator != OP_TIME) Message::Error("Not allowed expression in Galerkin term with MHJacNL"); FI->MHJacNL_Factor = 1.; } else if (List_Nbr(WholeQuantity_L) == 6){ if ((WholeQuantity_P0 + 0)->Type != WQ_CONSTANT || i_WQ != 2 || (WholeQuantity_P0 + 3)->Type != WQ_BINARYOPERATOR || (WholeQuantity_P0 + 3)->Case.Operator.TypeOperator != OP_TIME || EquationTerm_P->Case.LocalTerm.Term.DofIndexInWholeQuantity != 3 || (WholeQuantity_P0 + 5)->Type != WQ_BINARYOPERATOR || (WholeQuantity_P0 + 5)->Case.Operator.TypeOperator != OP_TIME) Message::Error("Not allowed expression in Galerkin term with MHJacNL"); FI->MHJacNL_Factor = WholeQuantity_P0->Case.Constant ; /* printf(" Factor = %e \n" , FI->MHJacNL_Factor); */ } else { Message::Error("Not allowed expression in Galerkin term with MHJacNL (%d terms) ", List_Nbr(WholeQuantity_L)); } /* // Moving this check up... if(EquationTerm_P->Case.LocalTerm.Term.CanonicalWholeQuantity_Equ != CWQ_NONE) Message::Error("Not allowed expression in Galerkin term with MHJacNL"); if (EquationTerm_P->Case.LocalTerm.Term.TypeTimeDerivative != JACNL_) Message::Error("MHJacNL can only be used with JACNL") ; */ FI->MHJacNL = 1 ; FI->MHJacNL_Index = (WholeQuantity_P0 + i_WQ)->Case.MHJacNL.Index ; /* index of function for jacobian, e.g. dhdb[{d a}]*/ if(Message::GetVerbosity() == 10) Message::Info("FreqOffSet in 'MHJacNL' == %d ", (WholeQuantity_P0 + i_WQ)->Case.MHJacNL.FreqOffSet) ; FI->MHJacNL_HarOffSet = 2 * (WholeQuantity_P0 + i_WQ)->Case.MHJacNL.FreqOffSet ; if (FI->MHJacNL_HarOffSet > Current.NbrHar-2){ Message::Warning("FreqOffSet in 'MHJacNL' cannot exceed %d => set to %d ", Current.NbrHar/2-1, Current.NbrHar/2-1) ; FI->MHJacNL_HarOffSet = Current.NbrHar-2 ; } MH_Get_InitData(2, (WholeQuantity_P0 + i_WQ)->Case.MHJacNL.NbrPoints, &FI->MHJacNL_NbrPointsX, &FI->MHJacNL_H, &FI->MHJacNL_HH, &FI->MHJacNL_t, &FI->MHJacNL_w) ; } #define OFFSET (iHar < NbrHar-OffSet)? 0 : iHar-NbrHar+OffSet+2-iHar%2 /* --------------------------------------------------------------------------- */ /* C a l _ G a l e r k i n T e r m O f F e m E q u a t i o n _ M H J a c N L */ /* --------------------------------------------------------------------------- */ void Cal_GalerkinTermOfFemEquation_MHJacNL(struct Element * Element, struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0) { struct FemLocalTermActive * FI ; struct QuantityStorage * QuantityStorage_P; struct IntegrationCase * IntegrationCase_P ; struct Quadrature * Quadrature_P ; int Nbr_Dof, NbrHar ; double vBFuDof [NBR_MAX_BASISFUNCTIONS][MAX_DIM] ; double vBFxDof [NBR_MAX_BASISFUNCTIONS][MAX_DIM] ; double Val_Dof [NBR_MAX_BASISFUNCTIONS][NBR_MAX_HARMONIC] ; double Val [3*NBR_MAX_BASISFUNCTIONS]; int i, j, k, Type_Dimension, Nbr_IntPoints, i_IntPoint ; int iTime, iDof, jDof, iHar, jHar, nVal1, nVal2 = 0, iVal1, iVal2, Type1; double **H, ***HH, Factor, plus, plus0, weightIntPoint; int NbrPointsX, OffSet; struct Expression * Expression_P; struct Dof * Dofi, *Dofj; struct Value t_Value; gMatrix * Jac; double one=1.0 ; int iPul, ZeroHarmonic, DcHarmonic; // test! //double E_MH[NBR_MAX_BASISFUNCTIONS][NBR_MAX_BASISFUNCTIONS][NBR_MAX_HARMONIC][NBR_MAX_HARMONIC]; double E_D[NBR_MAX_HARMONIC][NBR_MAX_HARMONIC][MAX_DIM]; void (*xFunctionBFDof[NBR_MAX_BASISFUNCTIONS]) (struct Element * Element, int NumEntity, double u, double v, double w, double Value[] ) ; double (*Get_Jacobian)(struct Element*, MATRIX3x3*) ; void (*Get_IntPoint)(int,int,double*,double*,double*,double*); double (*Get_Product)(double*,double*,double*) = 0; FI = EquationTerm_P->Case.LocalTerm.Active ; QuantityStorage_P = FI->QuantityStorageDof_P ; /* ---------------------------------------------------------------------- */ /* G e t F u n c t i o n V a l u e f o r t e s t f u n c t i o n s */ /* ---------------------------------------------------------------------- */ if (!(Nbr_Dof = QuantityStorage_P->NbrElementaryBasisFunction)){ return; } // test! std::vector > > > E_MH(Nbr_Dof); for(unsigned int i = 0; i < E_MH.size(); i++){ E_MH[i].resize(Nbr_Dof); for(unsigned int j = 0; j < E_MH[i].size(); j++){ E_MH[i][j].resize(Current.NbrHar); for(unsigned int k = 0; k < E_MH[i][j].size(); k++){ E_MH[i][j][k].resize(Current.NbrHar, 0.); } } } Get_FunctionValue(Nbr_Dof, (void (**)())xFunctionBFDof, EquationTerm_P->Case.LocalTerm.Term.TypeOperatorDof, QuantityStorage_P, &FI->Type_FormDof) ; for (j = 0 ; j < Nbr_Dof ; j++) for (k = 0 ; k < Current.NbrHar ; k+=2) Dof_GetComplexDofValue (QuantityStorage_P->FunctionSpace->DofData, QuantityStorage_P->BasisFunction[j].Dof + k/2*gCOMPLEX_INCREMENT, &Val_Dof[j][k], &Val_Dof[j][k+1]) ; /* printf("Type1 = %d\n", FI->Type_FormDof); */ nVal1 = NbrValues_Type (Type1 = Get_ValueFromForm(FI->Type_FormDof)) ; /* ------------------------------------------------------------------- */ /* G e t J a c o b i a n M e t h o d */ /* ------------------------------------------------------------------- */ i = 0 ; while ((i < FI->NbrJacobianCase) && ((j = (FI->JacobianCase_P0 + i)->RegionIndex) >= 0) && !List_Search (((struct Group *)List_Pointer(Problem_S.Group, j)) ->InitialList, &Element->Region, fcmp_int) ) i++ ; if (i == FI->NbrJacobianCase) Message::Error("Undefined Jacobian in Region %d", Element->Region); Element->JacobianCase = FI->JacobianCase_P0 + i ; Get_Jacobian = (double (*)(struct Element*, MATRIX3x3*)) Get_JacobianFunction(Element->JacobianCase->TypeJacobian, Element->Type, &Type_Dimension) ; if (FI->Flag_ChangeCoord) Get_NodesCoordinatesOfElement(Element) ; /* integration in space */ IntegrationCase_P = Get_IntegrationCase(Element, FI->IntegrationCase_L, FI->CriterionIndex); switch (IntegrationCase_P->Type) { case ANALYTIC : Message::Error("Analytical integration not implemented for MHJacNL"); } Quadrature_P = (struct Quadrature*) List_PQuery(IntegrationCase_P->Case, &Element->Type, fcmp_int); if(!Quadrature_P) Message::Error("Unknown type of Element (%s) for Integration method (%s)", Get_StringForDefine(Element_Type, Element->Type), ((struct IntegrationMethod *) List_Pointer(Problem_S.IntegrationMethod, EquationTerm_P->Case.LocalTerm.IntegrationMethodIndex))->Name); Nbr_IntPoints = Quadrature_P->NumberOfPoints ; Get_IntPoint = (void(*)(int,int,double*,double*,double*,double*)) Quadrature_P->Function ; /* integration in fundamental time period */ NbrPointsX = FI->MHJacNL_NbrPointsX; HH = FI->MHJacNL_HH; H = FI->MHJacNL_H ; Expression_P = (struct Expression*)List_Pointer(Problem_S.Expression, FI->MHJacNL_Index); OffSet = FI->MHJacNL_HarOffSet; Factor = FI->MHJacNL_Factor; /* ------------------------------------------------------------------------ */ /* ------------------------------------------------------------------------ */ /* C o m p u t a t i o n o f E l e m e n t a r y m a t r i x */ /* ------------------------------------------------------------------------ */ /* ------------------------------------------------------------------------ */ NbrHar = Current.NbrHar ; /* special treatment of DC-term and associated dummy sinus-term */ DcHarmonic = NbrHar; ZeroHarmonic = 0; for (iPul = 0 ; iPul < NbrHar/2 ; iPul++) if (!Current.DofData->Val_Pulsation[iPul]){ DcHarmonic = 2*iPul ; ZeroHarmonic = 2*iPul+1 ; break; } /* volume integration over element */ for (i_IntPoint = 0 ; i_IntPoint < Nbr_IntPoints ; i_IntPoint++) { Get_IntPoint(Nbr_IntPoints, i_IntPoint, &Current.u, &Current.v, &Current.w, &weightIntPoint) ; if (FI->Flag_ChangeCoord) { Get_BFGeoElement(Element, Current.u, Current.v, Current.w) ; Element->DetJac = Get_Jacobian(Element, &Element->Jac) ; weightIntPoint *= fabs(Element->DetJac) ; if (FI->Flag_InvJac) Get_InverseMatrix(Type_Dimension, Element->Type, Element->DetJac, &Element->Jac, &Element->InvJac) ; } /* Test and shape Functions (are the same) */ for (i = 0 ; i < Nbr_Dof ; i++) { xFunctionBFDof[i] (Element, QuantityStorage_P->BasisFunction[i].NumEntityInElement+1, Current.u, Current.v, Current.w, vBFuDof[i]) ; ((void (*)(struct Element*, double*, double*)) FI->xChangeOfCoordinatesEqu) (Element, vBFuDof[i], vBFxDof[i]) ; } switch (Type1) { case SCALAR : for (k = 0 ; k < NbrHar ; k++){ Val[k] = 0.; for (j = 0 ; j < Nbr_Dof ; j++) Val[k] += vBFxDof[j][0] * Val_Dof[j][k] ; } break ; case VECTOR : for (k = 0 ; k < NbrHar ; k++){ Val[3*k] = Val[3*k+1] = Val[3*k+2] = 0.; for (j = 0 ; j < Nbr_Dof ; j++){ Val[3*k ] += vBFxDof[j][0] * Val_Dof[j][k] ; Val[3*k+1] += vBFxDof[j][1] * Val_Dof[j][k] ; Val[3*k+2] += vBFxDof[j][2] * Val_Dof[j][k] ; } } break ; } Current.NbrHar = 1; /* evaluation in time domain */ /* time integration over fundamental period */ for (iTime = 0 ; iTime < NbrPointsX ; iTime++) { t_Value.Type = Type1 ; for (iVal1 = 0 ; iVal1 < nVal1 ; iVal1++){ t_Value.Val[iVal1] = 0; for (iHar = 0 ; iHar < NbrHar ; iHar++) t_Value.Val[iVal1] += H[iTime][iHar] * Val[iHar*nVal1+iVal1] ; } Get_ValueOfExpression(Expression_P, QuantityStorage_P0, Current.u, Current.v, Current.w, &t_Value, 1); //To generalize: Function in MHJacNL has 1 argument (e.g. dhdb[{d a}]) if (!iTime){ if (!i_IntPoint){ nVal2 = NbrValues_Type (t_Value.Type) ; Get_Product = (double(*)(double*,double*,double*)) Get_RealProductFunction_Type1xType2xType1 (Type1, t_Value.Type) ; } for (iHar = 0 ; iHar < NbrHar ; iHar++) for (jHar = OFFSET ; jHar <= iHar ; jHar++) for (iVal2 = 0 ; iVal2 < nVal2 ; iVal2++) E_D[iHar][jHar][iVal2] = 0. ; } for (iHar = 0 ; iHar < NbrHar ; iHar++) for (jHar = OFFSET ; jHar <= iHar ; jHar++){ for (iVal2 = 0 ; iVal2 < nVal2 ; iVal2++) E_D[iHar][jHar][iVal2] += HH[iTime][iHar][jHar] * t_Value.Val[iVal2] ; } } /* for iTime ... */ for (iDof = 0 ; iDof < Nbr_Dof ; iDof++) for (jDof = 0 ; jDof <= iDof ; jDof++) for (iHar = 0 ; iHar < NbrHar ; iHar++) for (jHar = OFFSET ; jHar <= iHar ; jHar++){ E_MH[iDof][jDof][iHar][jHar] += weightIntPoint * Get_Product(vBFxDof[iDof], E_D[iHar][jHar], vBFxDof[jDof]) ; Message::Debug("E_MH[%d][%d][%d][%d] = %e", iDof, jDof, iHar, jHar, E_MH[iDof][jDof][iHar][jHar]) ; } Current.NbrHar = NbrHar ; } /* for i_IntPoint ... */ /* -------------------------------------------------------------------- */ /* A d d c o n t r i b u t i o n t o J a c o b i a n M a t r i x */ /* -------------------------------------------------------------------- */ Jac = &Current.DofData->Jac; for (iDof = 0 ; iDof < Nbr_Dof ; iDof++){ Dofi = QuantityStorage_P->BasisFunction[iDof].Dof ; for (jDof = 0 ; jDof <= iDof ; jDof++){ Dofj = QuantityStorage_P->BasisFunction[jDof].Dof ; for (iHar = 0 ; iHar < NbrHar ; iHar++) for (jHar = OFFSET ; jHar <= iHar ; jHar++){ plus = plus0 = Factor * E_MH[iDof][jDof][iHar][jHar] ; if(jHar==DcHarmonic && iHar!=DcHarmonic) { plus0 *= 1. ; plus *= 2. ;} Dof_AssembleInMat(Dofi+iHar, Dofj+jHar, 1, &plus, Jac, NULL) ; if(iHar != jHar) Dof_AssembleInMat(Dofi+jHar, Dofj+iHar, 1, &plus0, Jac, NULL) ; if(iDof != jDof){ Dof_AssembleInMat(Dofj+iHar, Dofi+jHar, 1, &plus, Jac, NULL) ; if(iHar != jHar) Dof_AssembleInMat(Dofj+jHar, Dofi+iHar, 1, &plus0, Jac, NULL) ; } } } } /* dummy 1's on the diagonal for sinus-term of dc-component */ if (ZeroHarmonic) { for (iDof = 0 ; iDof < Nbr_Dof ; iDof++){ Dofi = QuantityStorage_P->BasisFunction[iDof].Dof + ZeroHarmonic ; Dof_AssembleInMat(Dofi, Dofi, 1, &one, Jac, NULL) ; } } } #undef OFFSET getdp-2.7.0-source/Legacy/Cal_AnalyticIntegration.h000644 001750 001750 00000000731 12473553042 023713 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _CAL_ANALYTIC_INTEGRATION_H_ #define _CAL_ANALYTIC_INTEGRATION_H_ #include "ProData.h" double Cal_AnalyticIntegration(struct Element * E, void (*BFEqu)(), void (*BFDof)(), int i, int j, double (*Cal_Productx)()); #endif getdp-2.7.0-source/Legacy/Pos_FemInterpolation.h000644 001750 001750 00000001274 12473553042 023267 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _POS_FEM_INTERPOLATION_H_ #define _POS_FEM_INTERPOLATION_H_ #include "ProData.h" void Pos_FemInterpolation(struct Element * Element, struct QuantityStorage * QuantityStorage_P0, struct QuantityStorage * QuantityStorage_P, int Type_Quantity, int Type_Operator, int Type_Dimension, int UseXYZ, double u, double v, double w, double x, double y, double z, double Val[], int * Type_Value, int Flag_ChangeOfCoordinates); #endif getdp-2.7.0-source/Legacy/BF_Edge_4.cpp000644 001750 001750 00000013165 12473553042 021162 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "ProData.h" #include "Message.h" /* ------------------------------------------------------------------------ */ /* B F _ E d g e _ 4 */ /* ------------------------------------------------------------------------ */ /* ------- */ /* Edges */ /* ------- */ #define WrongNumEntity Message::Error("Wrong Edge number in 'BF_Edge_4E'") void BF_Edge_4E(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { switch (Element->Type) { case LINE : switch(NumEntity) { case 1 : s[0] = u*u ; s[1] = 0. ; s[2] = 0. ; break ; default : WrongNumEntity ; } break ; case TRIANGLE : switch(NumEntity) { case 1 : s[0] = -6.0*u+1.0-2.0*v+6.0*u*u+6.0*u*v+v*v ; s[1] = -2.0*u+3.0*u*u+2.0*u*v ; s[2] = 0. ; break ; case 2 : s[0] = -2.0*v+3.0*v*v+2.0*u*v ; s[1] = -6.0*v+1.0-2.0*u+6.0*u*v+u*u+6.0*v*v ; s[2] = 0. ; break ; case 3 : s[0] = 2.0*u*v-v*v ; s[1] = u*u-2.0*u*v ; s[2] = 0. ; break ; default : WrongNumEntity ; } break ; case QUADRANGLE : switch(NumEntity) { default : Message::Error("BF_Edge_4E not ready for QUADRANGLE"); } break ; case TETRAHEDRON : switch(NumEntity) { case 1 : s[0] = -6.0*u+1.0-2.0*v-2.0*w+6.0*u*u+6.0*u*v+6.0*u*w+v*v+2.0*v*w+w*w; s[1] = -2.0*u+3.0*u*u+2.0*u*v+2.0*u*w; s[2] = -2.0*u+3.0*u*u+2.0*u*v+2.0*u*w; break ; case 2 : s[0] = -2.0*v+3.0*v*v+2.0*u*v+2.0*v*w; s[1] = -6.0*v+1.0-2.0*u-2.0*w+6.0*u*v+u*u+2.0*u*w+6.0*v*v+6.0*v*w+w*w; s[2] = -2.0*v+3.0*v*v+2.0*u*v+2.0*v*w; break ; case 3 : s[0] = -2.0*w+3.0*w*w+2.0*u*w+2.0*v*w; s[1] = -2.0*w+3.0*w*w+2.0*u*w+2.0*v*w; s[2] = -6.0*w+1.0-2.0*u-2.0*v+6.0*u*w+u*u+2.0*u*v+6.0*v*w+v*v+6.0*w*w; break ; case 4 : s[0] = 2.0*u*v-v*v; s[1] = u*u-2.0*u*v; s[2] = 0.0; break ; case 5 : s[0] = 2.0*u*w-w*w; s[1] = 0.0; s[2] = u*u-2.0*u*w; break ; case 6 : s[0] = 0.0; s[1] = 2.0*v*w-w*w; s[2] = v*v-2.0*v*w; break ; default : WrongNumEntity ; } break ; case HEXAHEDRON : switch(NumEntity) { default : Message::Error("BF_Edge_4E not ready for HEXAHEDRON"); } break ; case PRISM : switch(NumEntity) { default : Message::Error("BF_Edge_4E not ready for PRISM"); } break ; case PYRAMID : switch(NumEntity) { default : Message::Error("BF_Edge_4E not ready for PYRAMID"); } break ; default : Message::Error("Unknown type of Element in BF_Edge_4E"); break ; } if (Element->GeoElement->NumEdges[NumEntity-1] < 0) { s[0] = - s[0] ; s[1] = - s[1] ; s[2] = - s[2] ; } } #undef WrongNumEntity /* -------- */ /* Facets */ /* -------- */ #define WrongNumEntity Message::Error("Wrong Face number in 'BF_Edge_4F'") void BF_Edge_4F(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { switch (Element->Type) { case LINE : Message::Error("You should never end up here!") ; break; case TRIANGLE : switch(NumEntity) { case 1 : s[0] = v-2.0*u*v-v*v ; s[1] = u-u*u-2.0*u*v ; s[2] = 0. ; break ; default : WrongNumEntity ; } break ; case QUADRANGLE : switch(NumEntity) { default : Message::Error("BF_Edge_4F not ready for QUADRANGLE"); } break ; case TETRAHEDRON : switch(NumEntity) { case 1 : s[0] = w-2.0*u*w-v*w-w*w ; s[1] = -u*w ; s[2] = u-u*u-u*v-2.0*u*w ; break ; case 2 : s[0] = v-2.0*u*v-v*v-v*w ; s[1] = u-u*u-2.0*u*v-u*w ; s[2] = -u*v ; break ; case 3 : s[0] = -v*w ; s[1] = w-u*w-2.0*v*w-w*w ; s[2] = v-u*v-v*v-2.0*v*w ; break ; case 4 : s[0] = v*w ; s[1] = u*w ; s[2] = u*v ; break ; default : WrongNumEntity ; } break ; case HEXAHEDRON : switch(NumEntity) { default : Message::Error("BF_Edge_4F not ready for QUADRANGLE"); } break ; case PRISM : switch(NumEntity) { default : Message::Error("BF_Edge_4F not ready for PRISM"); } break ; default : Message::Error("Unknown type of Element in BF_Edge_4F"); break ; } } #undef WrongNumEntity /* -------- */ /* Volume */ /* -------- */ void BF_Edge_4V(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { Message::Error("You should never end up here!") ; } /* ------------------------------------------------------------------------ */ /* B F _ C u r l E d g e _ 4 */ /* ------------------------------------------------------------------------ */ /* ------- */ /* Edges */ /* ------- */ void BF_CurlEdge_4E(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { s[0] = 0. ; s[1] = 0. ; s[2] = 0. ; } /* -------- */ /* Facets */ /* -------- */ void BF_CurlEdge_4F(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { s[0] = 0. ; s[1] = 0. ; s[2] = 0. ; } /* -------- */ /* Volume */ /* -------- */ void BF_CurlEdge_4V(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { s[0] = 0. ; s[1] = 0. ; s[2] = 0. ; } getdp-2.7.0-source/Legacy/Operation_IterativeTimeReduction.cpp000644 001750 001750 00000046411 12473553042 026174 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include #include #include "ProData.h" #include "DofData.h" #include "SolvingOperations.h" #include "Message.h" #include "MallocUtils.h" #include "Cal_Quantity.h" #include "Get_DofOfElement.h" #define TWO_PI 6.2831853071795865 extern struct Problem Problem_S ; extern struct CurrentData Current ; extern int Flag_NextThetaFixed ; /* ------------------------------------------------------------------------ */ /* C a l _ S o l u t i o n E r r o r X */ /* ------------------------------------------------------------------------ */ void Cal_SolutionErrorX(int Nbr, double * xNew, double * x, double * MeanError) { int i; double errsqr = 0., xmoy = 0., dxmoy = 0., tol ; if(0 && gSCALAR_SIZE == 2) Message::Error("FIXME: Cal_SolutionErrorX might return strange results" " in complex arithmetic"); for (i = 0 ; i < Nbr ; i++) { xmoy += fabs( x[i])/(double)Nbr ; dxmoy += fabs(xNew[i]-x[i])/(double)Nbr ; } if (xmoy > 1.e-30) { tol = xmoy*1.e-10 ; for (i = 0 ; i < Nbr ; i++) if ( fabs(x[i]) > tol ) errsqr += fabs((xNew[i]-x[i]) / x[i]) ; else errsqr += fabs(xNew[i]-x[i]) ; *MeanError = errsqr / (double)Nbr ; } else if (dxmoy > 1.e-30) *MeanError = 1. ; else *MeanError = 0. ; } /* ------------------------------------------------------------------------ */ /* C a l _ C o m p a r e G l o b a l Q u a n t i t y */ /* ------------------------------------------------------------------------ */ #define COMPARE_CHANGE 1 #define COMPARE_CONVERGENCE 2 void Cal_CompareGlobalQuantity(struct Operation * Operation_P, int Type_Analyse, int * Type_ChangeOfState, int * FlagIndex, int Flag_First) { List_T *Region_L = NULL ; int i, Nbr_Region = 0, Num_Region ; int Nbr_ChangeOfState, i_COS ; struct ChangeOfState *ChangeOfState_P = NULL; struct Formulation *Formulation_P ; struct FunctionSpace *FunctionSpace_P ; struct GlobalQuantity *GlobalQuantity_P ; struct DefineQuantity *DefineQuantity_P ; struct QuantityStorage QuantityStorage_S ; double Val0_Dof, Val1_Dof ; double *val0 = NULL, *val1 = NULL, MeanError, v0, v1 ; struct Value Value ; double Val1_E, Val0_E, Val_S, Val0_Ref, Val1_Ref, v_fz, v_k, v_ke, v_sat ; double Save_Time ; if(0 && gSCALAR_SIZE == 2) Message::Error("FIXME: Cal_CompareGlobalQuantity might return strange results" " in complex arithmetic"); /* test */ v_k = 1./27.2836 ; v_ke = 18.518519 ; v_fz = 1. / (5.e3 * 1.5e-9) ; v_sat = 6. ; *Type_ChangeOfState = CHANGEOFSTATE_NOCHANGE ; Nbr_ChangeOfState = List_Nbr(Operation_P->Case.IterativeTimeReduction.ChangeOfState) ; for (i_COS = 0 ; i_COS < Nbr_ChangeOfState ; i_COS++) { ChangeOfState_P = (struct ChangeOfState *) List_Pointer(Operation_P->Case.IterativeTimeReduction.ChangeOfState, i_COS) ; Region_L = ((struct Group *)List_Pointer(Problem_S.Group, ChangeOfState_P->InIndex)) ->InitialList ; List_Sort(Region_L, fcmp_int) ; Nbr_Region = List_Nbr(Region_L) ; if (Nbr_Region > 0) { Formulation_P = (struct Formulation *) List_Pointer(Problem_S.Formulation, ChangeOfState_P->FormulationIndex) ; DefineQuantity_P = (struct DefineQuantity *) List_Pointer(Formulation_P->DefineQuantity, ChangeOfState_P->QuantityIndex) ; QuantityStorage_S.FunctionSpace = FunctionSpace_P = (struct FunctionSpace*)List_Pointer(Problem_S.FunctionSpace, DefineQuantity_P->FunctionSpaceIndex) ; GlobalQuantity_P = (struct GlobalQuantity*) List_Pointer(FunctionSpace_P->GlobalQuantity, *(int *)List_Pointer(DefineQuantity_P->IndexInFunctionSpace, 0)) ; if (!ChangeOfState_P->ActiveList[0]) { ChangeOfState_P->ActiveList[0] =(double *)Malloc(Nbr_Region * sizeof(double)) ; ChangeOfState_P->ActiveList[1] =(double *)Malloc(Nbr_Region * sizeof(double)) ; } val0 = ChangeOfState_P->ActiveList[0] ; val1 = ChangeOfState_P->ActiveList[1] ; /* debug */ if (Type_Analyse == 999 && i_COS == 0 && ChangeOfState_P->Type == CHANGEOFSTATE_CHANGEREFERENCE2) { List_Read(Region_L, 0, &Num_Region) ; Current.Region = Num_Region ; Get_DofOfRegion(Current.Region, GlobalQuantity_P, FunctionSpace_P, &QuantityStorage_S) ; QuantityStorage_S.FunctionSpace->DofData->CurrentSolution -- ; Save_Time = Current.Time ; Current.Time = QuantityStorage_S.FunctionSpace->DofData->CurrentSolution->Time ; Dof_GetRealDofValue(QuantityStorage_S.FunctionSpace->DofData, QuantityStorage_S.BasisFunction[0].Dof, &Val0_Dof) ; Get_ValueOfExpressionByIndex(ChangeOfState_P->ExpressionIndex, NULL, 0., 0., 0., &Value) ; Val0_Ref = Value.Val[0] ; Current.Time = Save_Time ; QuantityStorage_S.FunctionSpace->DofData->CurrentSolution ++ ; Dof_GetRealDofValue(QuantityStorage_S.FunctionSpace->DofData, QuantityStorage_S.BasisFunction[0].Dof, &Val1_Dof) ; Get_ValueOfExpressionByIndex(ChangeOfState_P->ExpressionIndex, NULL, 0., 0., 0., &Value) ; Val1_Ref = Value.Val[0] ; Val1_E = (Val1_Ref - v_k * Val1_Dof) * v_ke ; Val0_E = (Val0_Ref - v_k * Val0_Dof) * v_ke ; Val_S = Val1_E + (Val1_E-Val0_E)/Current.DTime / (TWO_PI*v_fz) ; /* fprintf(FilePWM, "%.16g %g %g", Current.Time, Val1_E, Val_S) ; */ Val_S += Val1_Ref ; if (Val_S > v_sat) Val_S = v_sat ; else if (Val_S < -v_sat) Val_S = -v_sat ; /* fprintf(FilePWM, " %g %g\n", Val_S, ((struct Expression *) List_Pointer(Problem_S.Expression, ChangeOfState_P->FlagIndex)) ->Case.Constant ) ; fflush(FilePWM) ; */ break ; } /* else if (Type_Analyse == 999 && i_COS > 0) break ; */ /* ----- */ /* C a l c u l v a l e u r s . . . */ for (i = 0 ; i < Nbr_Region ; i++) { List_Read(Region_L, i, &Num_Region) ; Current.Region = Num_Region ; if (DefineQuantity_P->Type == GLOBALQUANTITY) { Get_DofOfRegion(Current.Region, GlobalQuantity_P, FunctionSpace_P, &QuantityStorage_S) ; switch (Type_Analyse) { case COMPARE_CHANGE : /* Compare values at times t-dt and t */ Dof_GetRealDofValue(QuantityStorage_S.FunctionSpace->DofData, QuantityStorage_S.BasisFunction[0].Dof, &Val1_Dof) ; switch (ChangeOfState_P->Type) { case CHANGEOFSTATE_CHANGESIGN : case CHANGEOFSTATE_CHANGELEVEL : QuantityStorage_S.FunctionSpace->DofData->CurrentSolution -- ; Dof_GetRealDofValue(QuantityStorage_S.FunctionSpace->DofData, QuantityStorage_S.BasisFunction[0].Dof, &Val0_Dof) ; QuantityStorage_S.FunctionSpace->DofData->CurrentSolution ++ ; break ; case CHANGEOFSTATE_CHANGEREFERENCE : Get_ValueOfExpressionByIndex(ChangeOfState_P->ExpressionIndex, NULL, 0., 0., 0., &Value) ; Val0_Dof = Value.Val[0] ; break ; case CHANGEOFSTATE_CHANGEREFERENCE2 : QuantityStorage_S.FunctionSpace->DofData->CurrentSolution -- ; Save_Time = Current.Time ; Current.Time = QuantityStorage_S.FunctionSpace->DofData->CurrentSolution->Time ; Dof_GetRealDofValue(QuantityStorage_S.FunctionSpace->DofData, QuantityStorage_S.BasisFunction[0].Dof, &Val0_Dof) ; Get_ValueOfExpressionByIndex(ChangeOfState_P->ExpressionIndex, NULL, 0., 0., 0., &Value) ; Val0_Ref = Value.Val[0] ; Current.Time = Save_Time ; QuantityStorage_S.FunctionSpace->DofData->CurrentSolution ++ ; Get_ValueOfExpressionByIndex(ChangeOfState_P->ExpressionIndex, NULL, 0., 0., 0., &Value) ; Val1_Ref = Value.Val[0] ; Val1_E = (Val1_Ref - v_k * Val1_Dof) * v_ke ; Val0_E = (Val0_Ref - v_k * Val0_Dof) * v_ke ; Val_S = Val1_E + (Val1_E-Val0_E)/Current.DTime / (TWO_PI*v_fz) ; Val_S += Val1_Ref ; if (Val_S > v_sat) Val_S = v_sat ; else if (Val_S < -v_sat) Val_S = -v_sat ; Val1_Dof = Val_S ; Get_ValueOfExpressionByIndex(ChangeOfState_P->ExpressionIndex2, NULL, 0., 0., 0., &Value) ; Val0_Dof = Value.Val[0] ; break ; } break ; case COMPARE_CONVERGENCE : /* Compare values at time t, for 2 iterations */ Val0_Dof = val1[i] ; Dof_GetRealDofValue(QuantityStorage_S.FunctionSpace->DofData, QuantityStorage_S.BasisFunction[0].Dof, &Val1_Dof) ; break ; } } else Val0_Dof = Val1_Dof = 0. ; val0[i] = Val0_Dof ; val1[i] = Val1_Dof ; } /* for i -> Nbr_Region ... */ /* A n a l y s e v a l e u r s . . . */ switch (Type_Analyse) { case COMPARE_CHANGE : switch (ChangeOfState_P->Type) { case CHANGEOFSTATE_CHANGESIGN : for (i = 0 ; i < Nbr_Region ; i++) { if (val0[i] * val1[i] <= 0.) { *Type_ChangeOfState = CHANGEOFSTATE_CHANGESIGN ; break ; } } break ; case CHANGEOFSTATE_CHANGELEVEL : for (i = 0 ; i < Nbr_Region ; i++) { if (ChangeOfState_P->Criterion > 0) { v0 = fabs(val0[i]) ; v1 = fabs(val1[i]) ; if (((v0 < v1) && (v0*ChangeOfState_P->Criterion < v1)) || ((v0 > v1) && (v1*ChangeOfState_P->Criterion < v0))) { *Type_ChangeOfState = CHANGEOFSTATE_CHANGELEVEL ; break ; } } else { /* New: Absolute change (Criterion < 0) */ v0 = (val0[i]) ; v1 = (val1[i]) ; if ( fabs(v1-v0) > fabs(ChangeOfState_P->Criterion) ) { *Type_ChangeOfState = CHANGEOFSTATE_CHANGELEVEL ; break ; } } } /* Attention: test a affiner ... choix du Criterion ... */ break ; case CHANGEOFSTATE_CHANGEREFERENCE : if (Nbr_Region != 1) Message::Error("More than 1 Region for ChangeReference not done yet") ; for (i = 0 ; i < Nbr_Region ; i++) { if (fabs(val1[i] - val0[i]) > fabs(ChangeOfState_P->Criterion) * ((ChangeOfState_P->Criterion > 0.)? fabs(val0[i]) : 1.)) { *Type_ChangeOfState = ChangeOfState_P->Type ; *FlagIndex = ChangeOfState_P->FlagIndex ; if (val1[i] > val0[i]) *FlagIndex *= -1 ; break ; } } break ; case CHANGEOFSTATE_CHANGEREFERENCE2 : if (Nbr_Region != 1) Message::Error("More than 1 Region for ChangeReference2 not done yet") ; for (i = 0 ; i < Nbr_Region ; i++) { *FlagIndex = ChangeOfState_P->FlagIndex ; if (val1[i] > val0[i]) *FlagIndex *= -1 ; if (((struct Expression *) List_Pointer(Problem_S.Expression, abs(*FlagIndex))) ->Case.Constant != (*FlagIndex > 0)? 1. : 0. ) { *Type_ChangeOfState = ChangeOfState_P->Type ; break ; } } break ; } break ; case COMPARE_CONVERGENCE : Cal_SolutionErrorX(Nbr_Region, val1, val0, &MeanError) ; if (MeanError > 1.e-8) *Type_ChangeOfState = !CHANGEOFSTATE_NOCHANGE ; break ; /* critere a revoir, avant 1.e-14 */ } if (*Type_ChangeOfState != CHANGEOFSTATE_NOCHANGE) break ; } /* if Nbr_Region > 0 ... */ } /* for i_COS ... */ /* Attention: d e b u g (fprintf)*/ if ((Type_Analyse == COMPARE_CHANGE && (*Type_ChangeOfState != CHANGEOFSTATE_NOCHANGE || !Flag_First)) || (Type_Analyse == COMPARE_CONVERGENCE)) { if (Flag_First) { for (i = 0 ; i < Nbr_Region ; i++) { List_Read(Region_L, i, &Num_Region) ; Message::Debug(" %10d",Num_Region) ; } for (i = 0 ; i < Nbr_Region ; i++) Message::Debug(" %.8g", val0[i]) ; } for (i = 0 ; i < Nbr_Region ; i++) Message::Debug(" %.8g", val1[i]) ; Message::Debug(" t = %.16g, dt = %.16g", Current.Time, Current.DTime) ; if (*Type_ChangeOfState == CHANGEOFSTATE_CHANGESIGN) Message::Debug(" *Sign") ; else if (*Type_ChangeOfState == CHANGEOFSTATE_CHANGELEVEL) Message::Debug(" *Level") ; else if (*Type_ChangeOfState == CHANGEOFSTATE_CHANGEREFERENCE) Message::Debug(" *Ref (%g %g)", val0[0]-fabs(ChangeOfState_P->Criterion), val0[0]+fabs(ChangeOfState_P->Criterion)) ; else if (*Type_ChangeOfState == CHANGEOFSTATE_CHANGEREFERENCE2) Message::Debug(" *Ref2 (%g)", val0[0]) ; } } /* ------------------------------------------------------------------------ */ /* O p e r a t i o n _ I t e r a t i v e T i m e R e d u c t i o n */ /* ------------------------------------------------------------------------ */ void Operation_IterativeTimeReduction(struct Resolution * Resolution_P, struct Operation * Operation_P, struct DofData * DofData_P0, struct GeoData * GeoData_P0) { int Num_Iteration, i ; int Type_ChangeOfState, Flag_TimeLimLo, Type_LimitHi, FlagIndex ; double Time_Previous, DTime0, DTime1 ; double Time_LimitLo, DTime_LimitLo, Time_LimitHi ; struct Solution * Solution_P ; struct Expression * Expression_P ; #define TIMELO_OLD 0 #define TIMELO_NEW 1 Time_Previous = Current.Time - Current.DTime ; DTime0 = 0. ; DTime1 = Current.DTime ; Flag_TimeLimLo = TIMELO_OLD ; Time_LimitLo = Time_Previous ; DTime_LimitLo = Current.DTime ; Message::Debug("T I M E %g (TS #%d, DT %g, Theta %g)", Current.Time, (int)Current.TimeStep, Current.DTime, Current.Theta) ; Current.SubTimeStep = 0 ; Treatment_Operation(Resolution_P, Operation_P->Case.IterativeTimeReduction.Operation, DofData_P0, GeoData_P0, NULL, NULL) ; Cal_CompareGlobalQuantity(Operation_P, COMPARE_CHANGE, &Type_ChangeOfState, &FlagIndex, 1) ; if (Type_ChangeOfState == CHANGEOFSTATE_NOCHANGE) { Treatment_Operation(Resolution_P, Operation_P->Case.IterativeTimeReduction.OperationEnd, DofData_P0, GeoData_P0, NULL, NULL) ; /* debug */ Cal_CompareGlobalQuantity (Operation_P, 999, &Type_ChangeOfState, &FlagIndex, 1) ; return ; } Time_LimitHi = Current.Time ; /* Sera initialise correctement par apres. */ Type_LimitHi = Type_ChangeOfState ; /* Mais boin, c'est pour la rigueur */ /* Recherche de l'intervalle de temps [Time_LimitLo, Time_LimitHi] < Criterion sur lequel un changement d'etat de grandeurs globales specifiees a lieu (e.g. utilisation pour les circuits avec diodes et thyristors) */ for (Num_Iteration = 1 ; Num_Iteration <= Operation_P->Case.IterativeTimeReduction.NbrMaxIteration ; Num_Iteration++) { if (Type_ChangeOfState == CHANGEOFSTATE_NOCHANGE) { Flag_TimeLimLo = TIMELO_NEW ; Time_LimitLo = Current.Time ; DTime_LimitLo = Current.DTime ; } else { Time_LimitHi = Current.Time ; Type_LimitHi = Type_ChangeOfState ; } if (Time_LimitHi - Time_LimitLo < Operation_P->Case.IterativeTimeReduction.Criterion) { if (Type_ChangeOfState != CHANGEOFSTATE_NOCHANGE) { if (!(Flag_TimeLimLo == TIMELO_OLD && Type_ChangeOfState == CHANGEOFSTATE_CHANGELEVEL) && !(Flag_TimeLimLo == TIMELO_OLD)) { Solution_P = (struct Solution *) List_Pointer(Current.DofData->Solutions, List_Nbr(Current.DofData->Solutions)-1) ; LinAlg_DestroyVector(&Solution_P->x) ; Free(Solution_P->TimeFunctionValues) ; Solution_P->SolutionExist = 0 ; List_Pop(Current.DofData->Solutions) ; /* Attention: a changer ! */ } if (Flag_TimeLimLo == TIMELO_NEW) { /* Recalcul en Time_LimitLo */ /* Attention: a changer... plutot recuperer solution en Time_LimitLo... */ Message::Debug("==> Re-calculation at Time_LimitLo ... (%.16g)", Time_LimitLo) ; Current.Time = Time_LimitLo ; Current.DTime = DTime_LimitLo ; Current.SubTimeStep++ ; Treatment_Operation(Resolution_P, Operation_P->Case.IterativeTimeReduction.Operation, DofData_P0, GeoData_P0, NULL, NULL) ; } } if (Flag_TimeLimLo == TIMELO_NEW || (Flag_TimeLimLo == TIMELO_OLD && Type_ChangeOfState == CHANGEOFSTATE_CHANGELEVEL)) { Treatment_Operation(Resolution_P, Operation_P->Case.IterativeTimeReduction.OperationEnd, DofData_P0, GeoData_P0, NULL, NULL) ; /* debug */ Cal_CompareGlobalQuantity (Operation_P, 999, &Type_ChangeOfState, &FlagIndex, 1) ; } if (Type_LimitHi == CHANGEOFSTATE_CHANGESIGN || Type_LimitHi == CHANGEOFSTATE_CHANGEREFERENCE || Type_LimitHi == CHANGEOFSTATE_CHANGEREFERENCE2) { if (Flag_TimeLimLo == TIMELO_NEW) Current.TimeStep += 1. ; if (Type_LimitHi == CHANGEOFSTATE_CHANGEREFERENCE || Type_LimitHi == CHANGEOFSTATE_CHANGEREFERENCE2) { Expression_P = (struct Expression *) List_Pointer(Problem_S.Expression, abs(FlagIndex)) ; Expression_P->Case.Constant = (FlagIndex > 0)? 1. : 0. ; /* Expression_P->Case.Constant = (double)(!((int)Expression_P->Case.Constant)) ; */ Message::Debug("===> Flag -> %g", Expression_P->Case.Constant) ; } if (Operation_P->Case.IterativeTimeReduction.Flag) Current.Theta = 1. ; /* New: Theta is also changed for this time ! OK because dt is then very small also in this case ! */ Current.Time = Time_LimitHi ; Current.DTime = Time_LimitHi - Time_LimitLo ; Current.SubTimeStep++ ; Message::Debug("==> iterations for TimeHi ...") ; i = 0 ; do { i ++ ; Treatment_Operation(Resolution_P, Operation_P->Case.IterativeTimeReduction.Operation, DofData_P0, GeoData_P0, NULL, NULL) ; Cal_CompareGlobalQuantity (Operation_P, COMPARE_CONVERGENCE, &Type_ChangeOfState, &FlagIndex, 0) ; } while ((Flag_TimeLimLo == TIMELO_NEW && i == 1) || (Type_ChangeOfState != CHANGEOFSTATE_NOCHANGE && i < 9)) ; /* Attention: critere (NbrMax 9) a revoir */ Treatment_Operation(Resolution_P, Operation_P->Case.IterativeTimeReduction.OperationEnd, DofData_P0, GeoData_P0, NULL, NULL) ; /* debug */ Cal_CompareGlobalQuantity (Operation_P, 999, &Type_ChangeOfState, &FlagIndex, 1) ; if (Operation_P->Case.IterativeTimeReduction.Flag) { /* Attention: Test */ Message::Debug("=====> Theta = %g -> 1.", Current.Theta) ; Flag_NextThetaFixed = 1 ; Current.Theta = 1. ; if (Operation_P->Case.IterativeTimeReduction.Flag > 0) { Current.DTime *= (double)Operation_P->Case.IterativeTimeReduction.Flag ; Flag_NextThetaFixed = 2 ; /* Theta is fixed, DTime is also fixed */ } } } break ; /* Out of loop 'for Num_Iteration' */ } /* if Time_LimitHi - Time_LimitLo << ... */ if (Operation_P->Case.IterativeTimeReduction.DivisionCoefficient > 0.) { if (Type_ChangeOfState == CHANGEOFSTATE_NOCHANGE) DTime0 += DTime1 ; DTime1 /= Operation_P->Case.IterativeTimeReduction.DivisionCoefficient ; } else { /* Technique de Pkp ... "un peu trop prudente" */ if (Type_ChangeOfState == CHANGEOFSTATE_NOCHANGE) DTime0 += DTime1 ; else DTime1 /= fabs(Operation_P->Case.IterativeTimeReduction.DivisionCoefficient) ; } Current.DTime = DTime0 + DTime1 ; Current.Time = Time_Previous + Current.DTime ; Current.SubTimeStep++ ; Solution_P = (struct Solution *) List_Pointer(Current.DofData->Solutions, List_Nbr(Current.DofData->Solutions)-1) ; LinAlg_DestroyVector(&Solution_P->x) ; Free(Solution_P->TimeFunctionValues) ; Solution_P->SolutionExist = 0 ; List_Pop(Current.DofData->Solutions) ; /* Attention: a changer ! */ Treatment_Operation(Resolution_P, Operation_P->Case.IterativeTimeReduction.Operation, DofData_P0, GeoData_P0, NULL, NULL) ; Cal_CompareGlobalQuantity(Operation_P, COMPARE_CHANGE, &Type_ChangeOfState, &FlagIndex, 0) ; } /* for Num_Iteration ... */ } getdp-2.7.0-source/Legacy/Pos_Search.h000644 001750 001750 00000001622 12473553042 021212 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _POS_SEARCH_H_ #define _POS_SEARCH_H_ #include "ProData.h" #include "GeoData.h" #include "ListUtils.h" struct Brick { List_T *p[3]; } ; struct ElementBox { double Xmin, Xmax ; double Ymin, Ymax ; double Zmin, Zmax ; } ; struct PointElement { double d; double xp, yp, zp; int ElementIndex; } ; void Free_SearchGrid(struct Grid * Grid); void InWhichElement(struct Grid *Grid, List_T *ExcludeRegion, struct Element * Element, int Flag, double x, double y, double z, double *u, double *v, double *w); void xyz2uvwInAnElement(struct Element *Element, double x, double y, double z, double *u, double *v, double *w); #endif getdp-2.7.0-source/Legacy/Pos_Iso.h000644 001750 001750 00000000701 12473553042 020534 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _POS_ISO_H_ #define _POS_ISO_H_ #include "Pos_Element.h" #include "ListUtils.h" void Cal_Iso(struct PostElement *PE, List_T *list, double val, double vmin, double vmax, int DecomposeInSimplex) ; #endif getdp-2.7.0-source/Legacy/Get_ConstraintOfElement.cpp000644 001750 001750 00000133414 12614106256 024244 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "ProData.h" #include "GeoData.h" #include "Get_DofOfElement.h" #include "Get_ConstraintOfElement.h" #include "ExtendedGroup.h" #include "Cal_Quantity.h" #include "Cal_Value.h" #include "MallocUtils.h" #include "Message.h" extern struct Problem Problem_S ; extern struct CurrentData Current ; extern List_T *PreResolutionIndex_L ; extern int Nbr_ElementaryBF ; /* ------------------------------------------------------------------------ */ /* T r e a t m e n t _ C o n s t r a i n t F o r E l e m e n t */ /* ------------------------------------------------------------------------ */ void Treatment_ConstraintForElement(struct FunctionSpace * FunctionSpace_P, struct QuantityStorage * QuantityStorage_P, int Num_Entity[], int i_Entity, int i_BFunction, int TypeConstraint) { int Nbr_Constraint, i_Constraint, k, Index_GeoElement ; List_T * Constraint_L ; struct ConstraintInFS * Constraint_P ; struct ConstraintPerRegion * ConstraintPerRegion_P ; struct GlobalQuantity * GlobalQuantity_P ; struct Group * GroupEntity_Pr ; QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].Constraint = NONE ; QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].Constraint_Index = -1; Constraint_L = FunctionSpace_P->Constraint ; Nbr_Constraint = List_Nbr(Constraint_L) ; for (i_Constraint = 0 ; i_Constraint < Nbr_Constraint && ! QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].Constraint ; i_Constraint++) { Constraint_P = (struct ConstraintInFS*)List_Pointer(Constraint_L, i_Constraint) ; ConstraintPerRegion_P = Constraint_P->ConstraintPerRegion ; switch(ConstraintPerRegion_P->Type) { case ASSIGN : case INIT : case ASSIGNFROMRESOLUTION : case INITFROMRESOLUTION : case ASSIGN_LOCALPROJ : case INIT_LOCALPROJ : case CST_LINK : case CST_LINKCPLX : switch(Constraint_P->QuantityType) { case LOCALQUANTITY : if(Constraint_P->ReferenceIndex == i_BFunction) { GroupEntity_Pr = (struct Group*) List_Pointer(Problem_S.Group, Constraint_P->EntityIndex) ; if(Check_IsEntityInExtendedGroup(GroupEntity_Pr, abs(Num_Entity[i_Entity]), 1)) { QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].Constraint = ConstraintPerRegion_P->Type ; QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].Constraint_Index = i_Constraint; if (ConstraintPerRegion_P->Type == ASSIGN || ConstraintPerRegion_P->Type == INIT) { switch (TypeConstraint) { case NODESOF : case GROUPSOFEDGESONNODESOF : Current.NumEntity = abs(Num_Entity[i_Entity]) ; // Note: Current.Element will be set to 0 in Get_ValueForConstraint // so that Current.{x,y,z} will be used in CoordXYZ[] functions Geo_GetNodesCoordinates(1, &Current.NumEntity, &Current.x, &Current.y, &Current.z) ; break ; case VOLUMESOF : Current.NumEntity = abs(Num_Entity[i_Entity]) ; break; case EDGESOF : Current.NumEntity = abs(Num_Entity[i_Entity]) ; Current.NumEntityInElement = i_Entity ; break ; } Get_ValueForConstraint (Constraint_P, QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].Value, QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].Value2, &QuantityStorage_P->BasisFunction[Nbr_ElementaryBF]. TimeFunctionIndex) ; } else if (ConstraintPerRegion_P->Type == ASSIGN_LOCALPROJ || ConstraintPerRegion_P->Type == INIT_LOCALPROJ) { // nothing to do now (per entity): we will do the projection // later, per element } else if (ConstraintPerRegion_P->Type == CST_LINK || ConstraintPerRegion_P->Type == CST_LINKCPLX) { Get_LinkForConstraint (Constraint_P, abs(Num_Entity[i_Entity]), &QuantityStorage_P->BasisFunction[Nbr_ElementaryBF]. CodeEntity_Link, QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].BasisFunction->Orient, QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].Value) ; if (abs(Num_Entity[i_Entity]) == QuantityStorage_P->BasisFunction[Nbr_ElementaryBF]. CodeEntity_Link) QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].Constraint = NONE ; // Code linked with itself not allowed } else { Get_PreResolutionForConstraint (Constraint_P, &QuantityStorage_P->BasisFunction[Nbr_ElementaryBF]. TimeFunctionIndex) ; } } } break ; /* LOCALQUANTITY */ case GLOBALQUANTITY : GlobalQuantity_P = (struct GlobalQuantity*) List_Pointer(FunctionSpace_P->GlobalQuantity, Constraint_P->ReferenceIndex) ; if ((GlobalQuantity_P->Type == ALIASOF) && (GlobalQuantity_P->ReferenceIndex == i_BFunction)) { GroupEntity_Pr = (struct Group*) List_Pointer(Problem_S.Group, Constraint_P->EntityIndex) ; if (List_Search(GroupEntity_Pr->InitialList, &Num_Entity[i_Entity], fcmp_int)) { QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].Constraint = ConstraintPerRegion_P->Type ; if (ConstraintPerRegion_P->Type == ASSIGN || ConstraintPerRegion_P->Type == INIT) { Get_ValueForConstraint (Constraint_P, QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].Value, QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].Value2, &QuantityStorage_P->BasisFunction[Nbr_ElementaryBF]. TimeFunctionIndex) ; } else if (ConstraintPerRegion_P->Type == CST_LINK || ConstraintPerRegion_P->Type == CST_LINKCPLX) { // Message::Error("CST_LINK for GlobalQuantity not done yet") ; // FIXME: to be validated Get_LinkForConstraint (Constraint_P, abs(Num_Entity[i_Entity]), &QuantityStorage_P->BasisFunction[Nbr_ElementaryBF]. CodeEntity_Link, QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].BasisFunction->Orient, QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].Value) ; if (abs(Num_Entity[i_Entity]) == QuantityStorage_P->BasisFunction[Nbr_ElementaryBF]. CodeEntity_Link) QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].Constraint = NONE ; } else { Get_PreResolutionForConstraint (Constraint_P, &QuantityStorage_P->BasisFunction[Nbr_ElementaryBF]. TimeFunctionIndex) ; } } } break ; /* GLOBALQUANTITY */ default : Message::Error("Unknown type of Quantity in Constraint of type Fixed"); break; } break ; /* ASSIGN || INIT || ASSIGN_LOCALPROJ || INIT_LOCALPROJ || ASSIGNFROMRESOLUTION || INITFROMRESOLUTION */ default : Message::Error("Unknown type of Constraint"); break; } } /* for i_Constraint ... */ /* Constraints due to P-refinement */ if(Current.GeoData->P) { Index_GeoElement = Geo_GetGeoElementIndex(Current.Element->GeoElement) ; if (Current.GeoData->P[Index_GeoElement+1] >= 0 && Current.GeoData->P[Index_GeoElement+1] < QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].BasisFunction->Order){ QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].Constraint = ASSIGN ; for (k = 0 ; k < Current.NbrHar ; k++) QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].Value[k] = 0. ; QuantityStorage_P->BasisFunction[Nbr_ElementaryBF].TimeFunctionIndex = -1 ; } } } /* ------------------------------------------------------------------------ */ /* G e t _ V a l u e F o r C o n s t r a i n t */ /* ------------------------------------------------------------------------ */ void Get_ValueForConstraint(struct ConstraintInFS * Constraint_P, double Value[], double Value2[], int * Index_TimeFunction) { int k ; struct Value Val_Modulus, Val_Modulus2, Val_TimeFunction ; // Note: Current.{u,v,w} is not defined, so we cannot interpolate expressions // in the reference element. We thus set Current.Element=0 and rely on // Current.{x,y,z}. struct Element *old = Current.Element; Current.Element = 0; Get_ValueOfExpression ((struct Expression *) List_Pointer(Problem_S.Expression, Constraint_P->ConstraintPerRegion->Case.Fixed.ExpressionIndex), NULL, 0., 0., 0., &Val_Modulus) ; int idx2 = Constraint_P->ConstraintPerRegion->Case.Fixed.ExpressionIndex2; if(idx2 >= 0){ Get_ValueOfExpression ((struct Expression *) List_Pointer(Problem_S.Expression, idx2), NULL, 0., 0., 0., &Val_Modulus2) ; } else{ Cal_ZeroValue(&Val_Modulus2); } *Index_TimeFunction = Constraint_P->ConstraintPerRegion->TimeFunctionIndex ; if (Current.NbrHar > 1) { if (*Index_TimeFunction >= 0) { Get_ValueOfExpression ((struct Expression *) List_Pointer(Problem_S.Expression, Constraint_P->ConstraintPerRegion->TimeFunctionIndex), NULL, 0., 0., 0., &Val_TimeFunction) ; Cal_ProductValue(&Val_Modulus, &Val_TimeFunction, &Val_Modulus) ; } for (k = 0 ; k < Current.NbrHar ; k++){ Value[k] = Val_Modulus.Val[MAX_DIM*k] ; Value2[k] = Val_Modulus2.Val[MAX_DIM*k] ; } } else{ Value[0] = Val_Modulus.Val[0] ; Value2[0] = Val_Modulus2.Val[0] ; // Set this to zero to avoid having an uninitialized imaginary part if you // use a complex arithmetic solver (on a real matrix) -- // cf. LinAlg_SetScalar() calls in DofData.cpp Value[1] = 0. ; Value2[1] = 0. ; } Current.Element = old; } /* ------------------------------------------------------------------------ */ /* T r e a t m e n t _ C o n s t r a i n t F o r R e g i o n */ /* ------------------------------------------------------------------------ */ void Treatment_ConstraintForRegion(struct GlobalQuantity * GlobalQuantity_P, struct FunctionSpace * FunctionSpace_P, struct QuantityStorage * QuantityStorage_P) { int Nbr_Constraint, i_Constraint ; List_T * Constraint_L ; struct ConstraintInFS * Constraint_P ; struct ConstraintPerRegion * ConstraintPerRegion_P ; struct Group * GroupEntity_Pr ; struct GlobalQuantity * GlobalQuantity_Pr ; QuantityStorage_P->BasisFunction[0].Constraint = NONE ; Constraint_L = FunctionSpace_P->Constraint ; Nbr_Constraint = List_Nbr(Constraint_L) ; for (i_Constraint = 0 ; i_Constraint < Nbr_Constraint && ! QuantityStorage_P->BasisFunction[0].Constraint ; i_Constraint++) { Constraint_P = (struct ConstraintInFS*)List_Pointer(Constraint_L, i_Constraint) ; ConstraintPerRegion_P = Constraint_P->ConstraintPerRegion ; if (Constraint_P->QuantityType == GLOBALQUANTITY) { switch(ConstraintPerRegion_P->Type) { case ASSIGN : case INIT : case ASSIGNFROMRESOLUTION : case INITFROMRESOLUTION : case CST_LINK : case CST_LINKCPLX : GlobalQuantity_Pr = (struct GlobalQuantity*) List_Pointer(FunctionSpace_P->GlobalQuantity, Constraint_P->ReferenceIndex) ; if (GlobalQuantity_Pr == GlobalQuantity_P) { GroupEntity_Pr = (struct Group*) List_Pointer(Problem_S.Group, Constraint_P->EntityIndex) ; if (/*(GroupEntity_Pr->FunctionType == ((struct Group *)List_Pointer(Problem_S.Group, BasisFunction_P->EntityIndex)) ->FunctionType) && */ List_Search (GroupEntity_Pr->InitialList, &QuantityStorage_P->BasisFunction[0].CodeEntity, fcmp_int) ) { QuantityStorage_P->BasisFunction[0].Constraint = ConstraintPerRegion_P->Type ; if (ConstraintPerRegion_P->Type == ASSIGN || ConstraintPerRegion_P->Type == INIT) { Get_ValueForConstraint (Constraint_P, QuantityStorage_P->BasisFunction[0].Value, QuantityStorage_P->BasisFunction[0].Value2, &QuantityStorage_P->BasisFunction[0].TimeFunctionIndex) ; } else if (ConstraintPerRegion_P->Type == CST_LINK || ConstraintPerRegion_P->Type == CST_LINKCPLX) { Get_LinkForConstraint (Constraint_P, QuantityStorage_P->BasisFunction[0].CodeEntity, &QuantityStorage_P->BasisFunction[0].CodeEntity_Link, QuantityStorage_P->BasisFunction[0].BasisFunction->Orient, QuantityStorage_P->BasisFunction[0].Value) ; if (QuantityStorage_P->BasisFunction[0].CodeEntity == QuantityStorage_P->BasisFunction[0].CodeEntity_Link) QuantityStorage_P->BasisFunction[0].Constraint = NONE ; /* Code linked with itself not allowed */ } else Get_PreResolutionForConstraint (Constraint_P, &QuantityStorage_P->BasisFunction[0].TimeFunctionIndex) ; } } break ; /* ASSIGN || INIT || ASSIGNFROMRESOLUTION || INITFROMRESOLUTION */ default : Message::Error("Unknown type of Constraint"); break; } } /* if (GLOBALQUANTITY) ... */ } /* for i_Constraint ... */ } /* ------------------------------------------------------------------------ */ /* G e t _ P r e R e s o l u t i o n F o r C o n s t r a i n t */ /* ------------------------------------------------------------------------ */ void Get_PreResolutionForConstraint(struct ConstraintInFS * Constraint_P, int * Index_TimeFunction) { struct PreResolutionInfo PreResolutionInfo_S ; int fcmp_Resolution_Name(const void * a, const void * b) ; *Index_TimeFunction = Constraint_P->ConstraintPerRegion->TimeFunctionIndex ; if (Constraint_P->Active.ResolutionIndex < 0) if ((Constraint_P->Active.ResolutionIndex = List_ISearchSeq(Problem_S.Resolution, Constraint_P->ConstraintPerRegion-> Case.Solve.ResolutionName, fcmp_Resolution_Name)) < 0) { Message::Error("Unknown ResolutionName '%s' in Constraint", Constraint_P->ConstraintPerRegion->Case.Solve.ResolutionName) ; } if(List_ISearchSeq(PreResolutionIndex_L, &Constraint_P->Active.ResolutionIndex, fcmp_int) < 0) { PreResolutionInfo_S.Index = Constraint_P->Active.ResolutionIndex ; PreResolutionInfo_S.Type = PR_CONSTRAINT ; List_Add(PreResolutionIndex_L, &PreResolutionInfo_S) ; Message::Info(" Adding Resolution '%s' for Pre-Resolution (Constraint)", Constraint_P->ConstraintPerRegion->Case.Solve.ResolutionName) ; } } /* ------------------------------------------------------------------------ */ /* ------------------------------------------------------------------------ */ /* G e t _ L i n k F o r C o n s t r a i n t & C o */ /* ------------------------------------------------------------------------ */ struct TwoIntOneDouble { int Int1, Int2 ; double Double, Double2 ; } ; void Get_LinkForConstraint(struct ConstraintInFS * Constraint_P, int Num_Entity, int * CodeEntity_Link, int Orient, double Value[]) { // Note: Current.{u,v,w} is not defined, so we cannot interpolate expressions // in the reference element. We thus set Current.Element=0 and rely on // Current.{x,y,z}. struct Element *old = Current.Element; Current.Element = 0; struct TwoIntOneDouble * TwoIntOneDouble_P ; List_T * Couples_L ; void Generate_Link(struct ConstraintInFS * Constraint_P, int Flag_New) ; if (!Constraint_P->Active.Active) Generate_Link(Constraint_P, 1) ; else if (Constraint_P->Active.Active->TimeStep != (int)Current.TimeStep) Generate_Link(Constraint_P, 0) ; else if (Constraint_P->Active.Active->SubTimeStep != Current.SubTimeStep) Generate_Link(Constraint_P, 0) ; /* +++ */ TwoIntOneDouble_P = (struct TwoIntOneDouble *) ((Couples_L = Constraint_P->Active.Active->Case.Link.Couples)? List_PQuery(Couples_L, &Num_Entity, fcmp_absint) : NULL) ; if (TwoIntOneDouble_P) { *CodeEntity_Link = abs(TwoIntOneDouble_P->Int2) ; Value[0] = TwoIntOneDouble_P->Double ; if (Orient && TwoIntOneDouble_P->Int1 < 0) Value[0] *= -1. ; Value[1] = TwoIntOneDouble_P->Double2 ; /* LinkCplx */ if (Orient && TwoIntOneDouble_P->Int1 < 0) Value[1] *= -1. ; } Current.Element = old; } /* Data... */ struct NodeXYZ { int NumNode ; double x, y, z ; } ; struct EdgeNN { int NumEdge ; int Node1, Node2 ; double Coef, Coef2 ; } ; struct FacetNNN { int NumFacet ; int Node1, Node2, Node3 ; double Coef, Coef2 ; } ; void Generate_LinkNodes(struct ConstraintInFS * Constraint_P, List_T * ExtendedList_L, List_T * ExtendedSuppList_L, struct Group * RegionRef_P, struct Group * SubRegionRef_P, int Index_Filter, int Index_Function, int Index_Coef, double ToleranceFactor, List_T * Couples_L) ; void Generate_LinkEdges(struct ConstraintInFS * Constraint_P, struct Group * Group_P, struct Group * RegionRef_P, struct Group * SubRegionRef_P, List_T * Couples_L) ; void Generate_LinkFacets(struct ConstraintInFS * Constraint_P, struct Group * Group_P, struct Group * RegionRef_P, struct Group * SubRegionRef_P, List_T * Couples_L) ; int fcmp_XYZ(const void * a, const void * b) ; int fcmp_NN(const void * a, const void * b) ; int fcmp_NNN(const void * a, const void * b) ; void Generate_LinkRegions(struct ConstraintInFS * Constraint_P, List_T * Region_L, List_T * RegionRef_L, int Index_Coef, List_T * Couples_L) ; void Generate_ElementaryEntities_EdgeNN (List_T * InitialList, List_T ** ExtendedList, int Type_Entity) ; void Generate_ElementaryEntities_FacetNNN (List_T * InitialList, List_T ** ExtendedList, int Type_Entity) ; /* ----- */ void Generate_Link(struct ConstraintInFS * Constraint_P, int Flag_New) { struct ConstraintActive * Active ; struct Group * Group_P, * RegionRef_P, * SubRegionRef_P ; int Nbr_Entity ; Message::Debug("C o n s t r a i n t ( L i n k )") ; if (Flag_New) Constraint_P->Active.Active = (struct ConstraintActive *)Malloc(sizeof(struct ConstraintActive)) ; Active = Constraint_P->Active.Active ; Active->TimeStep = (int)Current.TimeStep ; Active->SubTimeStep = Current.SubTimeStep ; Group_P = (struct Group*) List_Pointer(Problem_S.Group, Constraint_P->EntityIndex) ; RegionRef_P = (struct Group*) List_Pointer(Problem_S.Group, Constraint_P->ConstraintPerRegion->Case.Link.RegionRefIndex) ; SubRegionRef_P = (Constraint_P->ConstraintPerRegion->Case.Link.SubRegionRefIndex >= 0)? (struct Group*) List_Pointer(Problem_S.Group, Constraint_P->ConstraintPerRegion->Case.Link.SubRegionRefIndex) : NULL ; if (Group_P->FunctionType == REGION){ Nbr_Entity = List_Nbr(Group_P->InitialList) ; } else{ Nbr_Entity = List_Nbr(Group_P->ExtendedList) ; } if (Nbr_Entity) { if (Flag_New) Active->Case.Link.Couples = List_Create(Nbr_Entity, 1, sizeof(struct TwoIntOneDouble)) ; else List_Reset(Active->Case.Link.Couples) ; } else { Active->Case.Link.Couples = NULL ; return ; } switch (Group_P->FunctionType) { case NODESOF : Generate_LinkNodes(Constraint_P, Group_P->ExtendedList, Group_P->ExtendedSuppList, RegionRef_P, SubRegionRef_P, Constraint_P->ConstraintPerRegion->Case.Link.FilterIndex, Constraint_P->ConstraintPerRegion->Case.Link.FunctionIndex, Constraint_P->ConstraintPerRegion->Case.Link.CoefIndex, Constraint_P->ConstraintPerRegion->Case.Link.ToleranceFactor, Active->Case.Link.Couples) ; break ; case EDGESOF : Generate_LinkEdges(Constraint_P, Group_P, RegionRef_P, SubRegionRef_P, Active->Case.Link.Couples) ; break ; case FACETSOF : Generate_LinkFacets(Constraint_P, Group_P, RegionRef_P, SubRegionRef_P, Active->Case.Link.Couples) ; /*Message::Error("Link not yet implemented for FACETSOF") ;*/ break ; case REGION : Generate_LinkRegions(Constraint_P, Group_P->InitialList, RegionRef_P->InitialList, Constraint_P->ConstraintPerRegion->Case.Link.CoefIndex, Active->Case.Link.Couples) ; break ; default : Message::Error("Bad function type for Constraint Link: %d", Group_P->FunctionType) ; break ; } } /* G e n e r a t e _ L i n k N o d e s */ void Generate_LinkNodes(struct ConstraintInFS * Constraint_P, List_T * ExtendedList_L, List_T * ExtendedSuppList_L, struct Group * RegionRef_P, struct Group * SubRegionRef_P, int Index_Filter, int Index_Function, int Index_Coef, double ToleranceFactor, List_T * Couples_L) { int Nbr_Entity, i, Nbr_EntityRef, Flag_Filter ; double TOL ; struct TwoIntOneDouble TwoIntOneDouble ; struct NodeXYZ NodeXYZ, NodeXYZRef ; List_T * NodeXYZ_L, * NodeXYZRef_L ; List_T * ExtendedListRef_L, * ExtendedSuppListRef_L ; struct Value Value ; TOL = Current.GeoData->CharacteristicLength * ToleranceFactor ; // by default, ToleranceFactor is 1.e-8 (to be defined with ToleranceFactor value; in the Link constraint /* Nodes with Constraint */ Nbr_Entity = List_Nbr(ExtendedList_L) ; NodeXYZ_L = List_Create(Nbr_Entity, 1, sizeof(struct NodeXYZ)) ; for (i = 0 ; i < Nbr_Entity ; i++) { List_Read(ExtendedList_L, i, &NodeXYZ.NumNode) ; if (!(ExtendedSuppList_L && List_Search(ExtendedSuppList_L, &NodeXYZ.NumNode, fcmp_int))) { Geo_GetNodesCoordinates( 1, &NodeXYZ.NumNode, &Current.x, &Current.y, &Current.z) ; Get_ValueOfExpressionByIndex(Index_Function, NULL, 0., 0., 0., &Value) ; Current.x = Value.Val[0] ; Current.y = Value.Val[1] ; Current.z = Value.Val[2] ; if (Index_Filter < 0) Flag_Filter = 1 ; else { Get_ValueOfExpressionByIndex(Index_Filter, NULL, 0., 0., 0., &Value) ; Flag_Filter = (int)Value.Val[0] ; } if (Flag_Filter) { NodeXYZ.x = Current.x ; NodeXYZ.y = Current.y ; NodeXYZ.z = Current.z ; List_Add(NodeXYZ_L, &NodeXYZ) ; } } } Nbr_Entity = List_Nbr(NodeXYZ_L) ; /* Nodes of reference (Link) */ Generate_ElementaryEntities (RegionRef_P->InitialList, &ExtendedListRef_L, NODESOF) ; if (SubRegionRef_P) Generate_ElementaryEntities (SubRegionRef_P->InitialList, &ExtendedSuppListRef_L, NODESOF) ; else ExtendedSuppListRef_L = NULL ; Nbr_EntityRef = List_Nbr(ExtendedListRef_L) ; NodeXYZRef_L = List_Create(Nbr_EntityRef, 1, sizeof(struct NodeXYZ)) ; for (i = 0 ; i < Nbr_EntityRef ; i++) { List_Read(ExtendedListRef_L, i, &NodeXYZRef.NumNode) ; if (!(ExtendedSuppListRef_L && List_Search(ExtendedSuppListRef_L, &NodeXYZRef.NumNode, fcmp_int))) { Geo_GetNodesCoordinates( 1, &NodeXYZRef.NumNode, &Current.x, &Current.y, &Current.z) ; if (Index_Filter < 0) Flag_Filter = 1 ; else { Get_ValueOfExpressionByIndex(Index_Filter, NULL, 0., 0., 0., &Value) ; Flag_Filter = (int)Value.Val[0] ; } if (Flag_Filter) { NodeXYZRef.x = Current.x ; NodeXYZRef.y = Current.y ; NodeXYZRef.z = Current.z ; List_Add(NodeXYZRef_L, &NodeXYZRef) ; } } } Nbr_EntityRef = List_Nbr(NodeXYZRef_L) ; List_Sort(NodeXYZ_L , fcmp_XYZ) ; List_Sort(NodeXYZRef_L, fcmp_XYZ) ; if (Nbr_EntityRef != Nbr_Entity){ Message::Error("Constraint Link: bad correspondance of number of Nodes (%d, %d)", Nbr_Entity, Nbr_EntityRef) ; return; } Message::Debug("==> List of link for nodes") ; for (i = 0 ; i < Nbr_Entity ; i++) { List_Read(NodeXYZ_L, i, &NodeXYZ) ; List_Read(NodeXYZRef_L, i, &NodeXYZRef) ; /* Attention: tolerance !!! */ if ((fabs(NodeXYZ.x-NodeXYZRef.x) > TOL) || (fabs(NodeXYZ.y-NodeXYZRef.y) > TOL) || (fabs(NodeXYZ.z-NodeXYZRef.z) > TOL)){ Message::Error("Constraint Link: bad correspondance of Nodes (%d, %d)" " (%e %e %e), TOL=%g", NodeXYZ.NumNode, NodeXYZRef.NumNode, fabs(NodeXYZ.x-NodeXYZRef.x), fabs(NodeXYZ.y-NodeXYZRef.y), fabs(NodeXYZ.z-NodeXYZRef.z), TOL) ; return; } TwoIntOneDouble.Int1 = NodeXYZ.NumNode ; TwoIntOneDouble.Int2 = NodeXYZRef.NumNode ; /* Calcul du coefficient base sur les coordonnees du noeud de ref ... */ Geo_GetNodesCoordinates(1, &NodeXYZRef.NumNode, &Current.x, &Current.y, &Current.z) ; Get_ValueOfExpressionByIndex(Index_Coef, NULL, 0., 0., 0., &Value) ; TwoIntOneDouble.Double = Value.Val[0] ; if (Current.NbrHar == 1) TwoIntOneDouble.Double2 = 0. ; else TwoIntOneDouble.Double2 = Value.Val[MAX_DIM] ; /* LinkCplx */ List_Add(Couples_L, &TwoIntOneDouble) ; Message::Debug("%d %d : coef %e %e", NodeXYZ.NumNode, NodeXYZRef.NumNode, TwoIntOneDouble.Double, TwoIntOneDouble.Double2) ; } List_Delete(NodeXYZ_L) ; List_Delete(NodeXYZRef_L) ; } int fcmp_XYZ(const void * a, const void * b) { double Result, TOL=Current.GeoData->CharacteristicLength * 1.e-8 ; if (fabs(Result = ((struct NodeXYZ *)a)->x - ((struct NodeXYZ *)b)->x) > TOL) return (Result > 0.)? 1 : -1 ; if (fabs(Result = ((struct NodeXYZ *)a)->y - ((struct NodeXYZ *)b)->y) > TOL) return (Result > 0.)? 1 : -1 ; if (fabs(Result = ((struct NodeXYZ *)a)->z - ((struct NodeXYZ *)b)->z) > TOL) return (Result > 0.)? 1 : -1 ; return 0 ; } /* G e n e r a t e _ L i n k E d g e s */ void Generate_LinkEdges(struct ConstraintInFS * Constraint_P, struct Group * Group_P, struct Group * RegionRef_P, struct Group * SubRegionRef_P, List_T * Couples_L) { int Nbr_Entity, Nbr_EntityRef ; List_T * ExtendedListNodes_L ; List_T * CouplesOfNodes_L, * CouplesOfNodes2_L ; struct EdgeNN EdgeNN, EdgeNNRef ; List_T * EdgeNN_L, * EdgeNNRef_L ; List_T * ExtendedListRef_L, * ExtendedSuppListRef_L ; int i ; struct TwoIntOneDouble *TwoIntOneDouble_P, *TwoIntOneDouble2_P, TwoIntOneDouble ; List_T * ExtendedList_L ; int Save_Num, Flag_Filter ; /* Couples of nodes */ Generate_ElementaryEntities (Group_P->InitialList, &ExtendedListNodes_L, NODESOF) ; if ((Nbr_Entity = List_Nbr(ExtendedListNodes_L))) CouplesOfNodes_L = List_Create(Nbr_Entity, 1, sizeof(struct TwoIntOneDouble)) ; else { return ; /* situation impossible... */ } if (Constraint_P->ConstraintPerRegion->Case.Link.FilterIndex2 < 0) { Flag_Filter = 0 ; CouplesOfNodes2_L = NULL ; Generate_LinkNodes(Constraint_P, ExtendedListNodes_L, NULL, RegionRef_P, NULL, Constraint_P->ConstraintPerRegion->Case.Link.FilterIndex, Constraint_P->ConstraintPerRegion->Case.Link.FunctionIndex, Constraint_P->ConstraintPerRegion->Case.Link.CoefIndex, Constraint_P->ConstraintPerRegion->Case.Link.ToleranceFactor, CouplesOfNodes_L) ; } else { Flag_Filter = 1 ; CouplesOfNodes2_L = List_Create(Nbr_Entity, 1, sizeof(struct TwoIntOneDouble)) ; Generate_LinkNodes(Constraint_P, ExtendedListNodes_L, NULL, RegionRef_P, NULL, Constraint_P->ConstraintPerRegion->Case.Link.FilterIndex, Constraint_P->ConstraintPerRegion->Case.Link.FunctionIndex, Constraint_P->ConstraintPerRegion->Case.Link.CoefIndex, Constraint_P->ConstraintPerRegion->Case.Link.ToleranceFactor, CouplesOfNodes_L) ; Generate_LinkNodes(Constraint_P, ExtendedListNodes_L, NULL, RegionRef_P, NULL, Constraint_P->ConstraintPerRegion->Case.Link.FilterIndex2, Constraint_P->ConstraintPerRegion->Case.Link.FunctionIndex2, Constraint_P->ConstraintPerRegion->Case.Link.CoefIndex2, Constraint_P->ConstraintPerRegion->Case.Link.ToleranceFactor, CouplesOfNodes2_L) ; } /* Couples of edges */ Message::Info("== Couples of edges ==") ; /* Edges with Constraint */ Nbr_Entity = List_Nbr(Group_P->ExtendedList) ; Generate_ElementaryEntities_EdgeNN (Group_P->InitialList, &ExtendedList_L, EDGESOF) ; if (Group_P->InitialSuppList) Generate_ElementaryEntities_EdgeNN (Group_P->InitialSuppList, &ExtendedSuppListRef_L, EDGESOF) ; else ExtendedSuppListRef_L = NULL ; EdgeNN_L = List_Create(Nbr_Entity, 1, sizeof(struct EdgeNN)) ; if (Nbr_Entity != List_Nbr(ExtendedList_L)){ Message::Error("Constraint Link: strange...") ; return; } for (i = 0 ; i < Nbr_Entity ; i++) { List_Read(ExtendedList_L, i, &EdgeNN) ; if (!(ExtendedSuppListRef_L && List_Search(ExtendedSuppListRef_L, &EdgeNN.NumEdge, fcmp_int))) { if (EdgeNN.Node2 < EdgeNN.Node1) { Save_Num = EdgeNN.Node2 ; EdgeNN.Node2 = EdgeNN.Node1 ; EdgeNN.Node1 = Save_Num ; } Message::Debug("Image %d: a%d, n%d - n%d", i, EdgeNN.NumEdge, EdgeNN.Node1, EdgeNN.Node2) ; TwoIntOneDouble_P = (struct TwoIntOneDouble *) List_PQuery(CouplesOfNodes_L, &EdgeNN.Node1, fcmp_int) ; TwoIntOneDouble2_P = (struct TwoIntOneDouble *) List_PQuery(CouplesOfNodes_L, &EdgeNN.Node2, fcmp_int) ; if (!(TwoIntOneDouble_P && TwoIntOneDouble2_P)) { if (Flag_Filter) { TwoIntOneDouble_P = (struct TwoIntOneDouble *) List_PQuery(CouplesOfNodes2_L, &EdgeNN.Node1, fcmp_int) ; TwoIntOneDouble2_P = (struct TwoIntOneDouble *) List_PQuery(CouplesOfNodes2_L, &EdgeNN.Node2, fcmp_int) ; if (!TwoIntOneDouble_P) Message::Error("Constraint Link: unknown node (%d)", EdgeNN.Node1) ; if (!TwoIntOneDouble2_P) Message::Error("Constraint Link: unknown node (%d)", EdgeNN.Node2) ; } else Message::Error("Constraint Link: bad correspondance for edges") ; } EdgeNN.Node1 = TwoIntOneDouble_P->Int2 ; EdgeNN.Node2 = TwoIntOneDouble2_P->Int2 ; if (fabs(TwoIntOneDouble_P->Double - TwoIntOneDouble2_P->Double) > 1.e-18){ Message::Error("Constraint Link: Bad Coefficient for Edges") ; return; } EdgeNN.Coef = TwoIntOneDouble_P->Double ; EdgeNN.Coef2 = TwoIntOneDouble_P->Double2 ; /* LinkCplx */ if (EdgeNN.Node2 < EdgeNN.Node1) { Save_Num = EdgeNN.Node2 ; EdgeNN.Node2 = EdgeNN.Node1 ; EdgeNN.Node1 = Save_Num ; EdgeNN.NumEdge *= -1 ; } List_Add(EdgeNN_L, &EdgeNN) ; Message::Debug(" --- (whose source is) ---> a%d, n%d - n%d", EdgeNN.NumEdge, EdgeNN.Node1, EdgeNN.Node2) ; } } Nbr_Entity = List_Nbr(EdgeNN_L) ; /* Edges of reference (Link) */ Generate_ElementaryEntities_EdgeNN (RegionRef_P->InitialList, &ExtendedListRef_L, EDGESOF) ; if (SubRegionRef_P) Generate_ElementaryEntities_EdgeNN (SubRegionRef_P->InitialList, &ExtendedSuppListRef_L, EDGESOF) ; else ExtendedSuppListRef_L = NULL ; Nbr_EntityRef = List_Nbr(ExtendedListRef_L) ; EdgeNNRef_L = List_Create(Nbr_EntityRef, 1, sizeof(struct EdgeNN)) ; for (i = 0 ; i < Nbr_EntityRef ; i++) { List_Read(ExtendedListRef_L, i, &EdgeNNRef.NumEdge) ; if (!(ExtendedSuppListRef_L && List_Search(ExtendedSuppListRef_L, &EdgeNNRef.NumEdge, fcmp_int))) { if (EdgeNNRef.Node2 < EdgeNNRef.Node1) { Save_Num = EdgeNNRef.Node2 ; EdgeNNRef.Node2 = EdgeNNRef.Node1 ; EdgeNNRef.Node1 = Save_Num ; } List_Add(EdgeNNRef_L, &EdgeNNRef) ; Message::Debug("Ref %d: a%d, n%d - n%d", i, EdgeNNRef.NumEdge, EdgeNNRef.Node1, EdgeNNRef.Node2) ; } } Nbr_EntityRef = List_Nbr(EdgeNNRef_L) ; if (Nbr_EntityRef != Nbr_Entity){ Message::Error("Constraint Link: bad correspondance of number of Edges (%d, %d)", Nbr_Entity, Nbr_EntityRef) ; return; } List_Sort(EdgeNN_L , fcmp_NN) ; List_Sort(EdgeNNRef_L, fcmp_NN) ; for (i = 0 ; i < Nbr_Entity ; i++) { List_Read(EdgeNN_L, i, &EdgeNN) ; List_Read(EdgeNNRef_L, i, &EdgeNNRef) ; Message::Debug("Final : %d: a%d, n%d - n%d (%.16g + %.16g i) / a%d, n%d - n%d", i, EdgeNN.NumEdge, EdgeNN.Node1, EdgeNN.Node2, EdgeNN.Coef, EdgeNN.Coef2, EdgeNNRef.NumEdge, EdgeNNRef.Node1, EdgeNNRef.Node2) ; if (EdgeNN.Node1 != EdgeNNRef.Node1 || EdgeNN.Node2 != EdgeNNRef.Node2){ Message::Error("Constraint Link: bad correspondance of Edges (%d, %d)", EdgeNN.NumEdge, EdgeNNRef.NumEdge) ; return; } TwoIntOneDouble.Int1 = EdgeNN.NumEdge ; TwoIntOneDouble.Int2 = EdgeNNRef.NumEdge ; TwoIntOneDouble.Double = EdgeNN.Coef ; TwoIntOneDouble.Double2 = EdgeNN.Coef2 ; /* LinkCplx */ List_Add(Couples_L, &TwoIntOneDouble) ; } List_Delete(EdgeNN_L) ; List_Delete(EdgeNNRef_L) ; List_Delete(CouplesOfNodes_L) ; List_Delete(CouplesOfNodes2_L) ; Message::Info("====> End Link Edge") ; } int fcmp_NN(const void * a, const void * b) { int Result ; if ((Result = ((struct EdgeNN *)a)->Node1 - ((struct EdgeNN *)b)->Node1) != 0) return Result ; return ((struct EdgeNN *)a)->Node2 - ((struct EdgeNN *)b)->Node2 ; } void Generate_ElementaryEntities_EdgeNN (List_T * InitialList, List_T ** ExtendedList, int Type_Entity) { Tree_T * Entity_Tr ; struct Geo_Element * GeoElement ; int Nbr_Element, i_Element ; int Nbr_Entity = 0, i_Entity, * Num_Entities = NULL; struct EdgeNN EdgeNN ; int * Num_Nodes ; if (InitialList != NULL) { Entity_Tr = Tree_Create(sizeof (struct EdgeNN), fcmp_int) ; Nbr_Element = Geo_GetNbrGeoElements() ; for (i_Element = 0 ; i_Element < Nbr_Element ; i_Element++) { GeoElement = Geo_GetGeoElement(i_Element) ; if (List_Search(InitialList, &GeoElement->Region, fcmp_int) ) { switch (Type_Entity) { case EDGESOF : if (GeoElement->NbrEdges == 0) Geo_CreateEdgesOfElement(GeoElement) ; Nbr_Entity = GeoElement->NbrEdges ; Num_Entities = GeoElement->NumEdges ; break ; } for (i_Entity = 0; i_Entity < Nbr_Entity ; i_Entity++) { EdgeNN.NumEdge = abs(Num_Entities[i_Entity]) ; Num_Nodes = Geo_GetNodesOfEdgeInElement(GeoElement, i_Entity) ; EdgeNN.Node1 = GeoElement->NumNodes[abs(Num_Nodes[0])-1] ; EdgeNN.Node2 = GeoElement->NumNodes[abs(Num_Nodes[1])-1] ; if ( ! Tree_Search(Entity_Tr, &EdgeNN) ) Tree_Add(Entity_Tr, &EdgeNN) ; } } } *ExtendedList = Tree2List(Entity_Tr) ; Tree_Delete(Entity_Tr) ; } else *ExtendedList = NULL ; } /*-----------------------------------------*/ /*| G e n e r a t e _ L i n k F a c e t s |*/ /*-----------------------------------------*/ void Generate_LinkFacets(struct ConstraintInFS * Constraint_P, struct Group * Group_P, struct Group * RegionRef_P, struct Group * SubRegionRef_P, List_T * Couples_L) { int Nbr_Entity, Nbr_EntityRef ; List_T * ExtendedListNodes_L ; List_T * CouplesOfNodes_L, * CouplesOfNodes2_L ; struct FacetNNN FacetNNN, FacetNNNRef ; List_T * FacetNNN_L, * FacetNNNRef_L ; List_T * ExtendedListRef_L, * ExtendedSuppListRef_L ; int i ; struct TwoIntOneDouble *TwoIntOneDouble_P, *TwoIntOneDouble2_P; struct TwoIntOneDouble *TwoIntOneDouble3_P, TwoIntOneDouble ; List_T * ExtendedList_L ; // int Save_Num1, Save_Num2, Save_Num3; int Flag_Filter ; /* Couples of nodes */ Generate_ElementaryEntities (Group_P->InitialList, &ExtendedListNodes_L, NODESOF) ; if ((Nbr_Entity = List_Nbr(ExtendedListNodes_L))) CouplesOfNodes_L = List_Create(Nbr_Entity, 1, sizeof(struct TwoIntOneDouble)) ; else { return ; /* situation impossible... */ } if (Constraint_P->ConstraintPerRegion->Case.Link.FilterIndex2 < 0) { Flag_Filter = 0 ; CouplesOfNodes2_L = NULL ; Generate_LinkNodes(Constraint_P, ExtendedListNodes_L, NULL, RegionRef_P, NULL, Constraint_P->ConstraintPerRegion->Case.Link.FilterIndex, Constraint_P->ConstraintPerRegion->Case.Link.FunctionIndex, Constraint_P->ConstraintPerRegion->Case.Link.CoefIndex, Constraint_P->ConstraintPerRegion->Case.Link.ToleranceFactor, CouplesOfNodes_L) ; } else { Flag_Filter = 1 ; CouplesOfNodes2_L = List_Create(Nbr_Entity, 1, sizeof(struct TwoIntOneDouble)) ; Generate_LinkNodes(Constraint_P, ExtendedListNodes_L, NULL, RegionRef_P, NULL, Constraint_P->ConstraintPerRegion->Case.Link.FilterIndex, Constraint_P->ConstraintPerRegion->Case.Link.FunctionIndex, Constraint_P->ConstraintPerRegion->Case.Link.CoefIndex, Constraint_P->ConstraintPerRegion->Case.Link.ToleranceFactor, CouplesOfNodes_L) ; Generate_LinkNodes(Constraint_P, ExtendedListNodes_L, NULL, RegionRef_P, NULL, Constraint_P->ConstraintPerRegion->Case.Link.FilterIndex2, Constraint_P->ConstraintPerRegion->Case.Link.FunctionIndex2, Constraint_P->ConstraintPerRegion->Case.Link.CoefIndex2, Constraint_P->ConstraintPerRegion->Case.Link.ToleranceFactor, CouplesOfNodes2_L) ; } /* Couples of facets */ Message::Info("== Couples of facets ==") ; /* Facets with Constraint */ Nbr_Entity = List_Nbr(Group_P->ExtendedList) ; Generate_ElementaryEntities_FacetNNN (Group_P->InitialList, &ExtendedList_L, FACETSOF) ; if (Group_P->InitialSuppList) Generate_ElementaryEntities_FacetNNN (Group_P->InitialSuppList, &ExtendedSuppListRef_L, FACETSOF) ; else ExtendedSuppListRef_L = NULL ; FacetNNN_L = List_Create(Nbr_Entity, 1, sizeof(struct FacetNNN)) ; if (Nbr_Entity != List_Nbr(ExtendedList_L)){ Message::Error("Constraint Link: strange...") ; return; } Message::Debug("(ajout) Image: f%d, n%d - n%d - n%d", FacetNNN.NumFacet, FacetNNN.Node1, FacetNNN.Node2, FacetNNN.Node3) ; for (i = 0 ; i < Nbr_Entity ; i++) { List_Read(ExtendedList_L, i, &FacetNNN) ; if (!(ExtendedSuppListRef_L && List_Search(ExtendedSuppListRef_L, &FacetNNN.NumFacet, fcmp_int))) { // FIXME TODO /*if (FacetNNN.Node3 < FacetNNN.Node2) { Save_Num1 = FacetNNN.Node3 ; FacetNNN.Node3 = FacetNNN.Node2 ; FacetNNN.Node2 = Save_Num1 ; } if (FacetNNN.Node3 < FacetNNN.Node1) { Save_Num3 = FacetNNN.Node3 ; FacetNNN.Node3 = FacetNNN.Node1 ; FacetNNN.Node1 = Save_Num2 ; } if (FacetNNN.Node2 < FacetNNN.Node1) { Save_Num3 = FacetNNN.Node2 ; FacetNNN.Node2 = FacetNNN.Node1 ; FacetNNN.Node1 = Save_Num3 ; }*/ Message::Debug("Image %d: f%d, n%d - n%d - n%d", i, FacetNNN.NumFacet, FacetNNN.Node1, FacetNNN.Node2, FacetNNN.Node3) ; TwoIntOneDouble_P = (struct TwoIntOneDouble *) List_PQuery(CouplesOfNodes_L, &FacetNNN.Node1, fcmp_int) ; TwoIntOneDouble2_P = (struct TwoIntOneDouble *) List_PQuery(CouplesOfNodes_L, &FacetNNN.Node2, fcmp_int) ; TwoIntOneDouble3_P = (struct TwoIntOneDouble *) List_PQuery(CouplesOfNodes_L, &FacetNNN.Node3, fcmp_int) ; if (!(TwoIntOneDouble_P && TwoIntOneDouble2_P && TwoIntOneDouble3_P)) { if (Flag_Filter) { TwoIntOneDouble_P = (struct TwoIntOneDouble *) List_PQuery(CouplesOfNodes2_L, &FacetNNN.Node1, fcmp_int) ; TwoIntOneDouble2_P = (struct TwoIntOneDouble *) List_PQuery(CouplesOfNodes2_L, &FacetNNN.Node2, fcmp_int) ; TwoIntOneDouble3_P = (struct TwoIntOneDouble *) List_PQuery(CouplesOfNodes2_L, &FacetNNN.Node3, fcmp_int) ; if (!TwoIntOneDouble_P) Message::Error("1-Constraint Link: unknown node (%d)", FacetNNN.Node1) ; if (!TwoIntOneDouble2_P) Message::Error("2-Constraint Link: unknown node (%d)", FacetNNN.Node2) ; if (!TwoIntOneDouble3_P) Message::Error("3-Constraint Link: unknown node (%d)", FacetNNN.Node3) ; } else Message::Error("4-Constraint Link: bad correspondance for facets") ; } FacetNNN.Node1 = TwoIntOneDouble_P->Int2 ; FacetNNN.Node2 = TwoIntOneDouble2_P->Int2 ; FacetNNN.Node3 = TwoIntOneDouble3_P->Int2 ; if ( (fabs(TwoIntOneDouble_P->Double - TwoIntOneDouble2_P->Double) > 1.e-18) || (fabs(TwoIntOneDouble2_P->Double - TwoIntOneDouble3_P->Double) > 1.e-18) || (fabs(TwoIntOneDouble3_P->Double - TwoIntOneDouble_P->Double ) > 1.e-18) ) Message::Error("5-Constraint Link: Bad Coefficient for Facets") ; FacetNNN.Coef = TwoIntOneDouble_P->Double ; FacetNNN.Coef2 = TwoIntOneDouble_P->Double2 ; /* LinkCplx */ // FIXME TODO /*if (FacetNNN.Node3 < FacetNNN.Node2) { Save_Num1 = FacetNNN.Node3 ; FacetNNN.Node3 = FacetNNN.Node2 ; FacetNNN.Node2 = Save_Num1 ; FacetNNN.NumFacet *= -1 ; } if (FacetNNN.Node3 < FacetNNN.Node1) { Save_Num2 = FacetNNN.Node3 ; FacetNNN.Node3 = FacetNNN.Node1 ; FacetNNN.Node1 = Save_Num2 ; FacetNNN.NumFacet *= -1 ; } if (FacetNNN.Node2 < FacetNNN.Node1) { Save_Num3 = FacetNNN.Node2 ; FacetNNN.Node2 = FacetNNN.Node1 ; FacetNNN.Node1 = Save_Num3 ; FacetNNN.NumFacet *= -1 ; } */ List_Add(FacetNNN_L, &FacetNNN) ; Message::Debug(" --- (whose source is) ---> f%d, n%d - n%d - n%d", FacetNNN.NumFacet, FacetNNN.Node1, FacetNNN.Node2, FacetNNN.Node3) ; } } Nbr_Entity = List_Nbr(FacetNNN_L) ; /* Facets of reference (Link) */ Generate_ElementaryEntities_FacetNNN (RegionRef_P->InitialList, &ExtendedListRef_L, FACETSOF) ; if (SubRegionRef_P) Generate_ElementaryEntities_FacetNNN (SubRegionRef_P->InitialList, &ExtendedSuppListRef_L, FACETSOF) ; else ExtendedSuppListRef_L = NULL ; Nbr_EntityRef = List_Nbr(ExtendedListRef_L) ; FacetNNNRef_L = List_Create(Nbr_EntityRef, 1, sizeof(struct FacetNNN)) ; for (i = 0 ; i < Nbr_EntityRef ; i++) { List_Read(ExtendedListRef_L, i, &FacetNNNRef.NumFacet) ; if (!(ExtendedSuppListRef_L && List_Search(ExtendedSuppListRef_L, &FacetNNNRef.NumFacet, fcmp_int))) { // FIXME TODO /*if (FacetNNNRef.Node3 < FacetNNNRef.Node2) { Save_Num1 = FacetNNNRef.Node3 ; FacetNNNRef.Node3 = FacetNNNRef.Node2 ; FacetNNNRef.Node2 = Save_Num1 ; } if (FacetNNNRef.Node3 < FacetNNNRef.Node1) { Save_Num2 = FacetNNNRef.Node3 ; FacetNNNRef.Node3 = FacetNNNRef.Node1 ; FacetNNNRef.Node1 = Save_Num2 ; } if (FacetNNNRef.Node2 < FacetNNNRef.Node1) { Save_Num3 = FacetNNNRef.Node2 ; FacetNNNRef.Node2 = FacetNNNRef.Node1 ; FacetNNNRef.Node1 = Save_Num3 ; } */ List_Add(FacetNNNRef_L, &FacetNNNRef) ; /* -- */ Message::Debug("Ref %d: f%d, n%d - n%d - n%d ", i, FacetNNNRef.NumFacet, FacetNNNRef.Node1, FacetNNNRef.Node2, FacetNNNRef.Node3) ; } } Nbr_EntityRef = List_Nbr(FacetNNNRef_L) ; if (Nbr_EntityRef != Nbr_Entity){ Message::Error("6-Constraint Link: bad correspondance of number of facets (%d, %d)", Nbr_Entity, Nbr_EntityRef) ; return; } List_Sort(FacetNNN_L , fcmp_NNN) ; List_Sort(FacetNNNRef_L, fcmp_NNN) ; for (i = 0 ; i < Nbr_Entity ; i++) { List_Read(FacetNNN_L, i, &FacetNNN) ; List_Read(FacetNNNRef_L, i, &FacetNNNRef) ; Message::Debug("Final : %d: a%d, n%d - n%d - n%d (%.16g + %.16g i) / a%d, n%d - n%d - n%d", i, FacetNNN.NumFacet, FacetNNN.Node1, FacetNNN.Node2, FacetNNN.Node3, FacetNNN.Coef, FacetNNN.Coef2, FacetNNNRef.NumFacet, FacetNNNRef.Node1, FacetNNNRef.Node2, FacetNNNRef.Node3) ; if (FacetNNN.Node1 != FacetNNNRef.Node1 || FacetNNN.Node2 != FacetNNNRef.Node2 || FacetNNN.Node3 != FacetNNNRef.Node3 ){ Message::Error("7-Constraint Link: bad correspondance of facets (%d, %d)", FacetNNN.NumFacet, FacetNNNRef.NumFacet) ; return; } TwoIntOneDouble.Int1 = FacetNNN.NumFacet ; TwoIntOneDouble.Int2 = FacetNNNRef.NumFacet ; TwoIntOneDouble.Double = FacetNNN.Coef ; TwoIntOneDouble.Double2 = FacetNNN.Coef2 ; /* LinkCplx */ List_Add(Couples_L, &TwoIntOneDouble) ; } List_Delete(FacetNNN_L) ; List_Delete(FacetNNNRef_L) ; List_Delete(CouplesOfNodes_L) ; List_Delete(CouplesOfNodes2_L) ; Message::Info("====> End Link Facet") ; } int fcmp_NNN(const void * a, const void * b) { int Result ; if ((Result = ((struct FacetNNN *)a)->Node1 - ((struct FacetNNN *)b)->Node1) != 0) return Result ; if ((Result = ((struct FacetNNN *)a)->Node2 - ((struct FacetNNN *)b)->Node2) != 0) return Result ; return ((struct FacetNNN *)a)->Node3 - ((struct FacetNNN *)b)->Node3 ; } void Generate_ElementaryEntities_FacetNNN (List_T * InitialList, List_T ** ExtendedList, int Type_Entity) { Tree_T * Entity_Tr ; struct Geo_Element * GeoElement ; int Nbr_Element, i_Element ; int Nbr_Entity = 0, i_Entity, * Num_Entities = NULL; struct FacetNNN FacetNNN ; int * Num_Nodes ; if (InitialList != NULL) { Entity_Tr = Tree_Create(sizeof (struct FacetNNN), fcmp_int) ; Nbr_Element = Geo_GetNbrGeoElements() ; for (i_Element = 0 ; i_Element < Nbr_Element ; i_Element++) { GeoElement = Geo_GetGeoElement(i_Element) ; if (List_Search(InitialList, &GeoElement->Region, fcmp_int) ) { switch (Type_Entity) { case FACETSOF : if (GeoElement->NbrFacets == 0) Geo_CreateFacetsOfElement(GeoElement) ; Nbr_Entity = GeoElement->NbrFacets ; Num_Entities = GeoElement->NumFacets ; break ; } for (i_Entity = 0; i_Entity < Nbr_Entity ; i_Entity++) { FacetNNN.NumFacet = abs(Num_Entities[i_Entity]) ; Num_Nodes = Geo_GetNodesOfFacetInElement(GeoElement, i_Entity) ; FacetNNN.Node1 = GeoElement->NumNodes[abs(Num_Nodes[0])-1] ; FacetNNN.Node2 = GeoElement->NumNodes[abs(Num_Nodes[1])-1] ; FacetNNN.Node3 = GeoElement->NumNodes[abs(Num_Nodes[2])-1] ; if ( ! Tree_Search(Entity_Tr, &FacetNNN) ) Tree_Add(Entity_Tr, &FacetNNN) ; } } } *ExtendedList = Tree2List(Entity_Tr) ; Tree_Delete(Entity_Tr) ; } else *ExtendedList = NULL ; } /* G e n e r a t e _ L i n k R e g i o n s */ void Generate_LinkRegions(struct ConstraintInFS * Constraint_P, List_T * Region_L, List_T * RegionRef_L, int Index_Coef, List_T * Couples_L) { struct TwoIntOneDouble TwoIntOneDouble ; struct Value Value ; if (List_Nbr(Region_L) > 1 || List_Nbr(RegionRef_L) > 1){ Message::Error("More than one region for link type constraint") ; return; } List_Read(Region_L, 0, &TwoIntOneDouble.Int1) ; List_Read(RegionRef_L, 0, &TwoIntOneDouble.Int2) ; Get_ValueOfExpressionByIndex(Index_Coef, NULL, 0., 0., 0., &Value) ; TwoIntOneDouble.Double = Value.Val[0] ; if (Current.NbrHar == 1) TwoIntOneDouble.Double2 = 0. ; else TwoIntOneDouble.Double2 = Value.Val[MAX_DIM] ; /* LinkCplx */ List_Add(Couples_L, &TwoIntOneDouble) ; } getdp-2.7.0-source/Legacy/Get_FunctionValue.h000644 001750 001750 00000001655 12473553042 022553 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _GET_FUNCTION_VALUE_H_ #define _GET_FUNCTION_VALUE_H_ #include "ProData.h" int Get_ValueFromForm(int Form); struct IntegrationCase * Get_IntegrationCase (struct Element * Element, List_T *IntegrationCase_L, int CriterionIndex); void Get_FunctionValue(int Nbr_Function, void (*xFunctionBF[])(), int Type_Operator, struct QuantityStorage * QuantityStorage_P, int * Type_Form); void Get_InitFunctionValue(int Type_Operator, struct QuantityStorage * QuantityStorage_P, int * Type_Form); double Cal_InterpolationOrder(struct Element * Element, struct QuantityStorage * QuantityStorage); double Cal_MaxEdgeLength(struct Element * Element); #endif getdp-2.7.0-source/Legacy/F_Gmsh.cpp000644 001750 001750 00000016473 12473553042 020674 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "GetDPConfig.h" #include "ProData.h" #include "F.h" #include "Message.h" extern struct CurrentData Current ; #if defined(HAVE_GMSH) #include #include #include void F_Field(F_ARG) { if(A->Type != VECTOR){ Message::Error("Field[] expects XYZ coordinates as argument"); return; } if(PView::list.empty()){ Message::Error("No views available to interpolate from"); return; } double x = A->Val[0]; double y = A->Val[1]; double z = A->Val[2]; if(Fct->NbrArguments > 1){ Message::Error("Time and additional arguments are not supported in Field: " "use {Scalar,Vector,Tensor}Field instead"); return; } for (int k = 0; k < Current.NbrHar; k++) for (int j = 0; j < 9; j++) V->Val[MAX_DIM * k + j] = 0. ; V->Type = SCALAR; std::vector iview; if(!Fct->NbrParameters){ // use last view by default iview.push_back(PView::list.back()->getTag()); } else{ for(int i = 0; i < Fct->NbrParameters; i++) iview.push_back(Fct->Para[i]); } double N = 0.; // add the values from all specified views for(unsigned int i = 0; i < iview.size(); i++){ PView *v = PView::getViewByTag(iview[i]); if(!v){ Message::Error("View with tag %d does not exist", iview[i]); return; } PViewData *data = v->getData(); std::vector val(9 * data->getNumTimeSteps()); if(data->searchScalar(x, y, z, &val[0])){ V->Val[0] += val[0]; if(Current.NbrHar == 2 && data->getNumTimeSteps() > 1) V->Val[MAX_DIM] += val[1]; V->Type = SCALAR; N += 1.; } else if(data->searchVector(x, y, z, &val[0])){ for(int j = 0; j < 3; j++) V->Val[j] += val[j]; if(Current.NbrHar == 2 && data->getNumTimeSteps() > 1){ for(int j = 0; j < 3; j++) V->Val[MAX_DIM + j] += val[3 + j]; } V->Type = VECTOR; N += 1.; } else if(data->searchTensor(x, y, z, &val[0])){ for(int j = 0; j < 9; j++) V->Val[j] += val[j]; if(Current.NbrHar == 2 && data->getNumTimeSteps() > 1){ for(int j = 0; j < 9; j++) V->Val[MAX_DIM + j] += val[9 + j]; } V->Type = TENSOR; N += 1.; } else{ Message::Error("Did not find data at point (%g,%g,%g) in View with tag %d", x, y, z, iview[i]); } } if(N > 1.){ Message::Debug("Averaging data %g times on vertex (%g,%g,%g)", N, x, y, z); for (int k = 0; k < Current.NbrHar; k++) for (int j = 0; j < 9; j++) V->Val[MAX_DIM * k + j] = 0. ; } } static void F_X_Field(F_ARG, int type, bool complex, bool grad=false) { if(A->Type != VECTOR){ Message::Error("Field[] expects XYZ coordinates as argument"); return; } if(PView::list.empty()){ Message::Error("No views available to interpolate from"); return; } double x = A->Val[0]; double y = A->Val[1]; double z = A->Val[2]; int numComp = (type == SCALAR) ? (grad ? 3 : 1) : (type == VECTOR) ? (grad ? 9 : 3) : 9; // TODO: grad of tensor int NbrArg = Fct->NbrArguments ; int TimeStep = 0, MatchElement = 0; if(NbrArg >= 2){ if((A+1)->Type != SCALAR){ Message::Error("Expected scalar second argument (time step)"); return; } TimeStep = (int)(A+1)->Val[0]; } if(NbrArg >= 3){ if((A+2)->Type != SCALAR){ Message::Error("Expected scalar second argument (element matching flag)"); return; } MatchElement = (int)(A+2)->Val[0]; } // TODO: we could treat the third arguement as a tolerance (and call // searchScalarWithTol & friends) // Complex{Scalar,Vector,Tensor}Field assume that the Gmsh view contains real // and imaginary parts for each step if(complex) TimeStep *= 2; for (int k = 0; k < Current.NbrHar; k++) for (int j = 0; j < numComp; j++) V->Val[MAX_DIM * k + j] = 0. ; V->Type = (numComp == 1) ? SCALAR : (numComp == 3) ? VECTOR : TENSOR; std::vector iview; if(!Fct->NbrParameters){ // use last view by default iview.push_back(PView::list.back()->getTag()); } else{ for(int i = 0; i < Fct->NbrParameters; i++) iview.push_back(Fct->Para[i]); } int qn = 0; double *qx = 0, *qy = 0, *qz = 0; if(Current.Element){ qn = MatchElement ? Current.Element->GeoElement->NbrNodes : 0; qx = Current.Element->x; qy = Current.Element->y; qz = Current.Element->z; } double N = 0.; // add the values from all specified views for(unsigned int i = 0; i < iview.size(); i++){ PView *v = PView::getViewByTag(iview[i]); if(!v){ Message::Error("View with tag %d does not exist", iview[i]); return; } PViewData *data = v->getData(); if(TimeStep < 0 || TimeStep >= data->getNumTimeSteps()){ Message::Error("Invalid step %d in View with tag %d", TimeStep, iview[i]); continue; } std::vector val(numComp * data->getNumTimeSteps()); bool found = false; switch(type){ case SCALAR : if(data->searchScalar(x, y, z, &val[0], -1, 0, qn, qx, qy, qz, grad)) found = true; break; case VECTOR : if(data->searchVector(x, y, z, &val[0], -1, 0, qn, qx, qy, qz, grad)) found = true; break; case TENSOR : // TODO: grad of tensor not allowed yet - not sure how we should return // the values; provide 3 routines that return 3 tensors, or add argumemt // to select what to return? if(data->searchTensor(x, y, z, &val[0], -1, 0, qn, qx, qy, qz, false)) found = true; break; } if(found){ for(int j = 0; j < numComp; j++) V->Val[j] += val[numComp * TimeStep + j]; if(complex && Current.NbrHar == 2 && data->getNumTimeSteps() > TimeStep + 1) for(int j = 0; j < numComp; j++) V->Val[MAX_DIM + j] += val[numComp * (TimeStep + 1) + j]; N += 1.; } } if(N > 1.){ Message::Debug("Averaging data %g times on vertex (%g,%g,%g)", N, x, y, z); for (int k = 0; k < Current.NbrHar; k++) for (int j = 0; j < numComp; j++) V->Val[MAX_DIM * k + j] /= N ; } } #else void F_Field(F_ARG) { Message::Error("You need to compile GetDP with Gmsh support to use 'Field'"); V->Val[0] = 0. ; V->Type = SCALAR ; } static void F_X_Field(F_ARG, int type, bool complex, bool grad=false) { Message::Error("You need to compile GetDP with Gmsh support to use 'Field'"); V->Val[0] = 0. ; V->Type = SCALAR ; } #endif void F_ScalarField(F_ARG){ F_X_Field(Fct, A, V, SCALAR, false); } void F_VectorField(F_ARG){ F_X_Field(Fct, A, V, VECTOR, false); } void F_TensorField(F_ARG){ F_X_Field(Fct, A, V, TENSOR, false); } void F_ComplexScalarField(F_ARG){ F_X_Field(Fct, A, V, SCALAR, true); } void F_ComplexVectorField(F_ARG){ F_X_Field(Fct, A, V, VECTOR, true); } void F_ComplexTensorField(F_ARG){ F_X_Field(Fct, A, V, TENSOR, true); } void F_GradScalarField(F_ARG){ F_X_Field(Fct, A, V, SCALAR, false, true); } void F_GradVectorField(F_ARG){ F_X_Field(Fct, A, V, VECTOR, false, true); } void F_GradComplexScalarField(F_ARG){ F_X_Field(Fct, A, V, SCALAR, true, true); } void F_GradComplexVectorField(F_ARG){ F_X_Field(Fct, A, V, VECTOR, true, true); } getdp-2.7.0-source/Legacy/GetDP.h000644 001750 001750 00000000553 12473553042 020131 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _GETDP_H_ #define _GETDP_H_ #include #include int GetDP(std::vector &args, void *ptr=NULL); #endif getdp-2.7.0-source/Legacy/ExtendedGroup.cpp000644 001750 001750 00000050360 12473553042 022277 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include #include "ProData.h" #include "ProDefine.h" #include "ExtendedGroup.h" #include "GeoData.h" #include "Message.h" extern struct Problem Problem_S ; int fcmp_int2(const void * a, const void * b) { static int result ; if ( ( result = ((struct TwoInt *)a)->Int1 - ((struct TwoInt *)b)->Int1 ) != 0 ) return result ; return ((struct TwoInt *)a)->Int2 - ((struct TwoInt *)b)->Int2 ; } int fcmp_absint2(const void * a, const void * b) { static int result ; if ( ( result = abs(((struct TwoInt *)a)->Int1) - abs(((struct TwoInt *)b)->Int1) ) != 0 ) return result ; return abs(((struct TwoInt *)a)->Int2) - abs(((struct TwoInt *)b)->Int2) ; } /* ------------------------------------------------------------------------ */ /* C h e c k _ I s E n t i t y I n E x t e n d e d G r o u p */ /* ------------------------------------------------------------------------ */ int Check_IsEntityInExtendedGroup(struct Group * Group_P, int Entity, int Flag) { switch (Group_P->FunctionType) { case NODESOF : case EDGESOF : case FACETSOF : case VOLUMESOF : if ((Group_P->InitialList && !Group_P->ExtendedList) || (Group_P->InitialSuppList && !Group_P->ExtendedSuppList)) Generate_ExtendedGroup(Group_P) ; return((!Group_P->InitialList || (List_Search(Group_P->ExtendedList, &Entity, fcmp_int))) && (!Group_P->InitialSuppList || (! List_Search(Group_P->ExtendedSuppList, &Entity, fcmp_int)))) ; case ELEMENTSOF : case EDGESOFTREEIN : case FACETSOFTREEIN : if (!Group_P->ExtendedList) Generate_ExtendedGroup(Group_P) ; return( List_Search(Group_P->ExtendedList, &Entity, fcmp_int) ) ; case GROUPSOFNODESOF : case GROUPSOFEDGESOF : case GROUPSOFFACETSOF : case REGION : case GROUPOFREGIONSOF : case GLOBAL : return( (Flag)? List_Search(Group_P->InitialList, &Entity, fcmp_int) : 1 ) ; case GROUPSOFEDGESONNODESOF : if (!Group_P->InitialSuppList){ return(1) ; } return(! List_Search(Group_P->ExtendedSuppList, &Entity, fcmp_int)) ; default : Message::Error("Unknown function type for Group '%s'", Group_P->Name); return(-1) ; } } /* ------------------------------------------------------------------------ */ /* G e n e r a t e _ E x t e n d e d G r o u p */ /* ------------------------------------------------------------------------ */ void Generate_ExtendedGroup(struct Group * Group_P) { Message::Info(" Generate ExtendedGroup '%s' (%s)", Group_P->Name, Get_StringForDefine(FunctionForGroup_Type, Group_P->FunctionType)) ; switch (Group_P->FunctionType) { case NODESOF : case EDGESOF : case FACETSOF : case VOLUMESOF : case GROUPOFREGIONSOF : Generate_ElementaryEntities(Group_P->InitialList, &Group_P->ExtendedList, Group_P->FunctionType) ; Generate_ElementaryEntities(Group_P->InitialSuppList, &Group_P->ExtendedSuppList, Group_P->FunctionType) ; break ; case GROUPSOFEDGESONNODESOF : Generate_ElementaryEntities(Group_P->InitialList, &Group_P->ExtendedList, EDGESOF) ; Generate_ElementaryEntities(Group_P->InitialSuppList, &Group_P->ExtendedSuppList, NODESOF) ; break ; case GROUPSOFNODESOF : Generate_GroupsOfNodes(Group_P->InitialList, &Group_P->ExtendedList) ; break ; case ELEMENTSOF : Generate_Elements(Group_P->InitialList, Group_P->SuppListType, Group_P->InitialSuppList, &Group_P->ExtendedList) ; break ; case GROUPSOFEDGESOF : Generate_GroupsOfEdges(Group_P->InitialList, Group_P->SuppListType, Group_P->InitialSuppList, &Group_P->ExtendedList) ; break ; case GROUPSOFFACETSOF : Generate_GroupsOfFacets(Group_P->InitialList, &Group_P->ExtendedList) ; break ; case EDGESOFTREEIN : Geo_GenerateEdgesOfTree(Group_P->InitialList, Group_P->InitialSuppList, &Group_P->ExtendedList) ; Geo_AddGroupForPRE(Group_P->Num) ; break ; case FACETSOFTREEIN : Geo_GenerateFacetsOfTree(Group_P->InitialList, Group_P->InitialSuppList, &Group_P->ExtendedList) ; Geo_AddGroupForPRE(Group_P->Num) ; break ; default : Message::Error("Unknown function type for Group '%s'", Group_P->Name) ; break; } switch (Group_P->FunctionType) { case GROUPSOFNODESOF : case GROUPSOFEDGESOF : case GROUPSOFFACETSOF : // create multimap for fast searches in the extended group, even when // multi-valued for(int i = 0; i < List_Nbr(Group_P->ExtendedList); i++){ TwoInt k; List_Read(Group_P->ExtendedList, i, &k); Group_P->ExtendedListForSearch.insert(std::make_pair(abs(k.Int1), k)); } break; } } /* ------------------------------------------------------------------------ */ /* G e n e r a t e _ E l e m e n t a r y E n t i t i e s */ /* ------------------------------------------------------------------------ */ void Generate_ElementaryEntities(List_T * InitialList, List_T ** ExtendedList, int Type_Entity) { Tree_T * Entity_Tr ; struct Geo_Element * GeoElement ; int Nbr_Element, i_Element, Num_Entity ; int Nbr_Entity = 0, i_Entity, * Num_Entities = NULL; if (InitialList != NULL) { Entity_Tr = Tree_Create(sizeof (int), fcmp_int) ; Nbr_Element = Geo_GetNbrGeoElements() ; for (i_Element = 0 ; i_Element < Nbr_Element ; i_Element++) { GeoElement = Geo_GetGeoElement(i_Element) ; if (List_Search(InitialList, &GeoElement->Region, fcmp_int) ) { switch (Type_Entity) { case NODESOF : Nbr_Entity = GeoElement->NbrNodes ; Num_Entities = GeoElement->NumNodes ; break ; case EDGESOF : if (GeoElement->NbrEdges == 0) Geo_CreateEdgesOfElement(GeoElement) ; Nbr_Entity = GeoElement->NbrEdges ; Num_Entities = GeoElement->NumEdges ; break ; case FACETSOF : if (GeoElement->NbrEdges == 0) Geo_CreateEdgesOfElement(GeoElement) ; if (GeoElement->NbrFacets == 0) Geo_CreateFacetsOfElement(GeoElement) ; Nbr_Entity = GeoElement->NbrFacets ; Num_Entities = GeoElement->NumFacets ; break ; case VOLUMESOF : case GROUPOFREGIONSOF : Nbr_Entity = 1 ; Num_Entities = &GeoElement->Num ; break ; } for (i_Entity = 0; i_Entity < Nbr_Entity ; i_Entity++) { Num_Entity = abs(Num_Entities[i_Entity]) ; if ( ! Tree_Search(Entity_Tr, &Num_Entity) ) Tree_Add(Entity_Tr, &Num_Entity) ; } } } *ExtendedList = Tree2List(Entity_Tr) ; Tree_Delete(Entity_Tr) ; } } /* ------------------------------------------------------------------------ */ /* G e n e r a t e _ G r o u p s O f N o d e s */ /* ------------------------------------------------------------------------ */ void Generate_GroupsOfNodes(List_T * InitialList, List_T ** ExtendedList) { Tree_T * Entity_Tr ; struct Geo_Element * GeoElement ; int Nbr_Element, i_Element, i_Entity ; struct TwoInt Num_GroupOfNodes ; Entity_Tr = Tree_Create(sizeof (struct TwoInt), fcmp_int2) ; Nbr_Element = Geo_GetNbrGeoElements() ; // Message::Info(" Add Node :"); for (i_Element = 0 ; i_Element < Nbr_Element ; i_Element++) { GeoElement = Geo_GetGeoElement(i_Element) ; if (List_Search(InitialList, &GeoElement->Region, fcmp_int) ) { Num_GroupOfNodes.Int2 = GeoElement->Region ; for (i_Entity = 0 ; i_Entity < GeoElement->NbrNodes ; i_Entity++) { Num_GroupOfNodes.Int1 = GeoElement->NumNodes[i_Entity] ; if ( ! Tree_Search(Entity_Tr, &Num_GroupOfNodes) ) { Tree_Add(Entity_Tr, &Num_GroupOfNodes) ; // Message::Info(" (%d, %d)", Num_GroupOfNodes.Int1, Num_GroupOfNodes.Int2); } } } } *ExtendedList = Tree2List(Entity_Tr) ; Tree_Delete(Entity_Tr) ; } /* ------------------------------------------------------------------------ */ /* G e n e r a t e _ G r o u p s O f E d g e s */ /* ------------------------------------------------------------------------ */ void Generate_GroupsOfEdges(List_T * InitialList, int Type_SuppList, List_T * InitialSuppList, List_T ** ExtendedList) { Tree_T * Entity_Tr ; struct Geo_Element * GeoElement ; int Nbr_Element, i_Element, i_Entity, Num_Element ; int * Num_Nodes, Num_Node ; struct TwoInt Num_GroupOfEdges, * Key1_P, * Key2_P ; List_T * ExtendedAuxList ; struct Group * GroupForSupport_P ; int MultiValuedGroup = 0; switch (Type_SuppList) { case SUPPLIST_INSUPPORT : Entity_Tr = Tree_Create(sizeof (struct TwoInt), fcmp_absint2) ; if (List_Nbr(InitialList)) { Generate_GroupsOfNodes(InitialList, &ExtendedAuxList) ; /* Attention : ici, le Support est une liste d'elements ! */ GroupForSupport_P = (struct Group*) List_Pointer(Problem_S.Group, *((int *)List_Pointer(InitialSuppList, 0))) ; if (!GroupForSupport_P->ExtendedList) Generate_ExtendedGroup(GroupForSupport_P) ; Nbr_Element = List_Nbr(GroupForSupport_P->ExtendedList) ; for (i_Element = 0 ; i_Element < Nbr_Element ; i_Element++) { List_Read(GroupForSupport_P->ExtendedList, i_Element, &Num_Element) ; GeoElement = Geo_GetGeoElementOfNum(Num_Element) ; if (GeoElement->NbrEdges == 0) Geo_CreateEdgesOfElement(GeoElement) ; for (i_Entity = 0 ; i_Entity < GeoElement->NbrEdges ; i_Entity++) { Num_Nodes = Geo_GetNodesOfEdgeInElement(GeoElement, i_Entity) ; Num_Node = GeoElement->NumNodes[abs(Num_Nodes[0])-1] ; Key1_P = (struct TwoInt*)List_PQuery(ExtendedAuxList, &Num_Node, fcmp_int) ; Num_Node = GeoElement->NumNodes[abs(Num_Nodes[1])-1] ; Key2_P = (struct TwoInt*)List_PQuery(ExtendedAuxList, &Num_Node, fcmp_int) ; if (Key1_P && (!Key2_P || (Key2_P->Int2 != Key1_P->Int2))) { Num_GroupOfEdges.Int1 = - GeoElement->NumEdges[i_Entity] ; Num_GroupOfEdges.Int2 = Key1_P->Int2 ; if ( ! Tree_Search(Entity_Tr, &Num_GroupOfEdges) ) Tree_Add(Entity_Tr, &Num_GroupOfEdges) ; } if (Key2_P && (!Key1_P || (Key1_P->Int2 != Key2_P->Int2))) { Num_GroupOfEdges.Int1 = GeoElement->NumEdges[i_Entity] ; Num_GroupOfEdges.Int2 = Key2_P->Int2 ; if ( ! Tree_Search(Entity_Tr, &Num_GroupOfEdges) ) Tree_Add(Entity_Tr, &Num_GroupOfEdges) ; } /* if (Key1_P && !Key2_P) { Num_GroupOfEdges.Int1 = - GeoElement->NumEdges[i_Entity] ; Num_GroupOfEdges.Int2 = Key1_P->Int2 ; if ( ! Tree_Search(Entity_Tr, &Num_GroupOfEdges) ) Tree_Add(Entity_Tr, &Num_GroupOfEdges) ; } else if (Key2_P && !Key1_P) { Num_GroupOfEdges.Int1 = GeoElement->NumEdges[i_Entity] ; Num_GroupOfEdges.Int2 = Key2_P->Int2 ; if ( ! Tree_Search(Entity_Tr, &Num_GroupOfEdges) ) Tree_Add(Entity_Tr, &Num_GroupOfEdges) ; } else { if (Key1_P && Key2_P && Key1_P->Int2 != Key2_P->Int2) { Num_GroupOfEdges.Int1 = - GeoElement->NumEdges[i_Entity] ; Num_GroupOfEdges.Int2 = Key1_P->Int2 ; if ( ! Tree_Search(Entity_Tr, &Num_GroupOfEdges) ){ Tree_Add(Entity_Tr, &Num_GroupOfEdges) ; fprintf(stderr, "ADD 1 <========= %d %d %d\n", GeoElement->NumNodes[abs(Num_Nodes[0])-1], Num_GroupOfEdges.Int1, Num_GroupOfEdges.Int2); } Num_GroupOfEdges.Int1 = GeoElement->NumEdges[i_Entity] ; Num_GroupOfEdges.Int2 = Key2_P->Int2 ; if ( ! Tree_Search(Entity_Tr, &Num_GroupOfEdges) ){ Tree_Add(Entity_Tr, &Num_GroupOfEdges) ; fprintf(stderr, "ADD 2 <========= %d %d %d \n", GeoElement->NumNodes[abs(Num_Nodes[1])-1], Num_GroupOfEdges.Int1, Num_GroupOfEdges.Int2); } } } */ } } List_Delete(ExtendedAuxList) ; } *ExtendedList = Tree2List(Entity_Tr) ; Tree_Delete(Entity_Tr) ; break ; case SUPPLIST_NONE : default : MultiValuedGroup = 1; *ExtendedList = List_Create(10,10,sizeof (struct TwoInt)) ; if (List_Nbr(InitialList)) { Generate_GroupsOfNodes(InitialList, &ExtendedAuxList) ; Nbr_Element = Geo_GetNbrGeoElements() ; for (i_Element = 0 ; i_Element < Nbr_Element ; i_Element++) { GeoElement = Geo_GetGeoElement(i_Element) ; if (List_Search(InitialList, &GeoElement->Region, fcmp_int) ) { // when generating edges of line elements, we assume that we want to // keep any multiple copy that might arise, with its sign; this is // required by the cohomology solver if(GeoElement->Type != LINE && GeoElement->Type != LINE_2) MultiValuedGroup = 0; if (GeoElement->NbrEdges == 0) Geo_CreateEdgesOfElement(GeoElement) ; for (i_Entity = 0 ; i_Entity < GeoElement->NbrEdges ; i_Entity++) { Num_Nodes = Geo_GetNodesOfEdgeInElement(GeoElement, i_Entity) ; Num_Node = GeoElement->NumNodes[abs(Num_Nodes[0])-1] ; Key1_P = (struct TwoInt*)List_PQuery(ExtendedAuxList, &Num_Node, fcmp_int) ; Num_Node = GeoElement->NumNodes[abs(Num_Nodes[1])-1] ; Key2_P = (struct TwoInt*)List_PQuery(ExtendedAuxList, &Num_Node, fcmp_int) ; if (Key1_P && Key2_P) { Num_GroupOfEdges.Int1 = GeoElement->NumEdges[i_Entity] ; Num_GroupOfEdges.Int2 = GeoElement->Region ; List_Add(*ExtendedList, &Num_GroupOfEdges); } } } } List_Delete(ExtendedAuxList) ; } // prune list if we are not in the "forced" multivalued case if(!MultiValuedGroup) { Entity_Tr = Tree_Create(sizeof (struct TwoInt), fcmp_absint2) ; for (i_Entity = 0; i_Entity < List_Nbr(*ExtendedList); i_Entity++) { List_Read(*ExtendedList, i_Entity, &Num_GroupOfEdges) ; if (!Tree_Search(Entity_Tr, &Num_GroupOfEdges)) Tree_Add(Entity_Tr, &Num_GroupOfEdges) ; } List_Delete(*ExtendedList) ; *ExtendedList = Tree2List(Entity_Tr); Tree_Delete(Entity_Tr) ; } break; } /* for (i_Entity = 0 ; i_Entity < List_Nbr(*ExtendedList) ; i_Entity++) { List_Read(*ExtendedList, i_Entity, &Num_GroupOfEdges) ; Message::Info(" (%d, %d)", Num_GroupOfEdges.Int1, Num_GroupOfEdges.Int2) ; } */ } /* ------------------------------------------------------------------------ */ /* G e n e r a t e _ G r o u p s O f F a c e s */ /* ------------------------------------------------------------------------ */ void Generate_GroupsOfFacets(List_T * InitialList, List_T ** ExtendedList) { Tree_T * Entity_Tr ; struct Geo_Element * GeoElement ; int Nbr_Element, i_Element, i_Entity ; int * Num_Nodes, Num_Node ; struct TwoInt Num_GroupOfFacets ; List_T * ExtendedAuxList ; int MultiValuedGroup = 1; *ExtendedList = List_Create(10,10,sizeof (struct TwoInt)) ; if (List_Nbr(InitialList)) { Generate_GroupsOfNodes(InitialList, &ExtendedAuxList) ; Nbr_Element = Geo_GetNbrGeoElements() ; for (i_Element = 0 ; i_Element < Nbr_Element ; i_Element++) { GeoElement = Geo_GetGeoElement(i_Element) ; if (List_Search(InitialList, &GeoElement->Region, fcmp_int) ) { // when generating facets of surface elements, we assume that we want to // keep any multiple copy that might arise, with its sign; this is // required by the cohomology solver if(GeoElement->Type != TRIANGLE && GeoElement->Type != TRIANGLE_2 && GeoElement->Type != QUADRANGLE && GeoElement->Type != QUADRANGLE_2 && GeoElement->Type != QUADRANGLE_2_8N) MultiValuedGroup = 0; if (GeoElement->NbrEdges == 0) Geo_CreateEdgesOfElement(GeoElement) ; if (GeoElement->NbrFacets == 0) Geo_CreateFacetsOfElement(GeoElement) ; for (i_Entity = 0 ; i_Entity < GeoElement->NbrFacets ; i_Entity++) { Num_Nodes = Geo_GetNodesOfFacetInElement(GeoElement, i_Entity) ; bool found = true; int i = 0; while(Num_Nodes[i]){ Num_Node = GeoElement->NumNodes[abs(Num_Nodes[i])-1] ; if(!List_PQuery(ExtendedAuxList, &Num_Node, fcmp_int)){ found = false; break; } i++; } if(found){ Num_GroupOfFacets.Int1 = GeoElement->NumFacets[i_Entity] ; Num_GroupOfFacets.Int2 = GeoElement->Region ; List_Add(*ExtendedList, &Num_GroupOfFacets); } } } } List_Delete(ExtendedAuxList) ; } // prune list if we are not in the "forced" multivalued case if(!MultiValuedGroup) { Entity_Tr = Tree_Create(sizeof (struct TwoInt), fcmp_absint2) ; for(i_Entity = 0; i_Entity < List_Nbr(*ExtendedList); i_Entity++) { List_Read(*ExtendedList, i_Entity, &Num_GroupOfFacets) ; if(!Tree_Search(Entity_Tr, &Num_GroupOfFacets)) Tree_Add(Entity_Tr, &Num_GroupOfFacets) ; } List_Delete(*ExtendedList) ; *ExtendedList = Tree2List(Entity_Tr) ; Tree_Delete(Entity_Tr) ; } /* for (i_Entity = 0 ; i_Entity < List_Nbr(*ExtendedList) ; i_Entity++) { List_Read(*ExtendedList, i_Entity, &Num_GroupOfFacets) ; Message::Info(" (%d, %d)", Num_GroupOfFacets.Int1, Num_GroupOfFacets.Int2) ; } */ } /* ------------------------------------------------------------------------ */ /* G e n e r a t e _ E l e m e n t s */ /* ------------------------------------------------------------------------ */ void Generate_Elements(List_T * InitialList, int Type_SuppList, List_T * InitialSuppList, List_T ** ExtendedList) { Tree_T * Entity_Tr ; struct Geo_Element * GeoElement, * GeoElement2 ; struct TwoInt Pair ; int k ; int Nbr_Element, i_Element, i_Element2, Nbr_Node, i_Node, i_Node2 ; List_T * ExtendedSuppList ; Nbr_Element = Geo_GetNbrGeoElements() ; switch (Type_SuppList) { case SUPPLIST_ONONESIDEOF : Entity_Tr = Tree_Create(sizeof(int), fcmp_int) ; if (List_Nbr(InitialSuppList)) { Generate_GroupsOfNodes(InitialSuppList, &ExtendedSuppList) ; for (i_Element = 0 ; i_Element < Nbr_Element ; i_Element++) { GeoElement = Geo_GetGeoElement(i_Element) ; if (List_Search(InitialList, &GeoElement->Region, fcmp_int)) { Nbr_Node = GeoElement->NbrNodes ; for (i_Node = 0 ; i_Node < Nbr_Node ; i_Node++) if (List_Search(ExtendedSuppList, &(GeoElement->NumNodes[i_Node]), fcmp_int)) { Tree_Add(Entity_Tr, &GeoElement->Num) ; break ; /* at least one node of element is on surface Supp */ } } } /* + ne conserver que certains des elements qui viennent d'etre groupes ... ! */ List_Delete(ExtendedSuppList) ; } break ; case SUPPLIST_CONNECTEDTO : Entity_Tr = Tree_Create(sizeof(struct TwoInt), fcmp_int2) ; ExtendedSuppList = List_Create(100,100,sizeof(int)); for (i_Element = 0 ; i_Element < Nbr_Element ; i_Element++) { GeoElement = Geo_GetGeoElement(i_Element) ; if (List_Search(InitialSuppList, &GeoElement->Region, fcmp_int)) List_Add(ExtendedSuppList, &i_Element); } for (i_Element = 0 ; i_Element < Nbr_Element ; i_Element++) { GeoElement = Geo_GetGeoElement(i_Element) ; if (List_Search(InitialList, &GeoElement->Region, fcmp_int)){ for(i_Element2 = 0 ; i_Element2 < List_Nbr(ExtendedSuppList) ; i_Element2++){ GeoElement2 = Geo_GetGeoElement(*(int*)List_Pointer(ExtendedSuppList, i_Element2)) ; k = 0 ; for(i_Node2 = 0 ; i_Node2 < GeoElement2->NbrNodes ; i_Node2++){ for(i_Node = 0 ; i_Node < GeoElement->NbrNodes ; i_Node++){ if(GeoElement2->NumNodes[i_Node2] == GeoElement->NumNodes[i_Node]) k++; } } if(k == GeoElement2->NbrNodes){ Pair.Int1 = GeoElement2->Num ; /* Number of the the element on the boundary */ Pair.Int2 = i_Element ; /* Index of the element connected to all the nodes of the element on the boundary */ Tree_Add(Entity_Tr, &Pair); } } } } List_Delete(ExtendedSuppList) ; break ; case SUPPLIST_NONE : default : Entity_Tr = Tree_Create(sizeof(int), fcmp_int) ; for (i_Element = 0 ; i_Element < Nbr_Element ; i_Element++) { GeoElement = Geo_GetGeoElement(i_Element) ; if (List_Search(InitialList, &GeoElement->Region, fcmp_int)) Tree_Add(Entity_Tr, &GeoElement->Num) ; } break ; } *ExtendedList = Tree2List(Entity_Tr) ; Tree_Delete(Entity_Tr) ; } getdp-2.7.0-source/Legacy/Gauss_Point.cpp000644 001750 001750 00000000625 12473553042 021754 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . /* Gauss integration over a point (!) */ void Gauss_Point(int Nbr_Points, int Num, double *u, double *v, double *w, double *wght) { *u = 0. ; *v = 0. ; *w = 0. ; *wght = 1. ; } getdp-2.7.0-source/Legacy/BF_Perpendicular.cpp000644 001750 001750 00000014031 12473553042 022661 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "ProData.h" #include "BF.h" #define ARGS \ struct Element * Element, int NumEntity, \ double u, double v, double w, double *s /* ------------------------------------------------------------------------ */ /* B F _ W i r e */ /* ------------------------------------------------------------------------ */ #define BF(BF_Wire_X,BF_Node_X) \ s[1] = s[2] = 0. ; \ (BF_Node_X)(Element, NumEntity, u, v, w, &s[0]) ; void BF_Wire(ARGS) { BF("BF_Wire",BF_Node) ; } #undef BF /* ------------------------------------------------------------------------ */ /* B F _ D i v W i r e */ /* ------------------------------------------------------------------------ */ #define BF(BF_DivWire_X,BF_GradNode_X) \ (BF_GradNode_X)(Element, NumEntity, u, v, w, &s[0]) ; void BF_DivWire(ARGS) { BF("BF_DivWire",BF_GradNode) ; } #undef BF /* ------------------------------------------------------------------------ */ /* B F _ P e r p e n d i c u l a r E d g e */ /* ------------------------------------------------------------------------ */ #define BF(BF_PerpendicularEdge_X,BF_Node_X) \ s[0] = s[1] = 0. ; \ (BF_Node_X)(Element, NumEntity, u, v, w, &s[2]) ; void BF_PerpendicularEdge(ARGS) { BF("BF_PerpendicularEdge",BF_Node) ; } void BF_PerpendicularEdge_2E(ARGS) { BF("BF_PerpendicularEdge_2E",BF_Node_2E) ; } void BF_PerpendicularEdge_2F(ARGS) { BF("BF_PerpendicularEdge_2F",BF_Node_2F) ; } void BF_PerpendicularEdge_2V(ARGS) { BF("BF_PerpendicularEdge_2V",BF_Node_2V) ; } void BF_PerpendicularEdge_3E(ARGS) { BF("BF_PerpendicularEdge_3E",BF_Node_3E) ; } void BF_PerpendicularEdge_3F(ARGS) { BF("BF_PerpendicularEdge_3F",BF_Node_3F) ; } void BF_PerpendicularEdge_3V(ARGS) { BF("BF_PerpendicularEdge_3V",BF_Node_3V) ; } #undef BF /* ------------------------------------------------------------------------ */ /* B F _ C u r l P e r p e n d i c u l a r E d g e */ /* ------------------------------------------------------------------------ */ #define BF(BF_CurlPerpendicularEdge_X,BF_GradNode_X) \ double ss ; \ (BF_GradNode_X)(Element, NumEntity, u, v, w, s) ; \ ss = s[0] ; s[0] = s[1] ; s[1] = -ss ; void BF_CurlPerpendicularEdge(ARGS) { BF("BF_CurlPerpendicularEdge",BF_GradNode) ; } void BF_CurlPerpendicularEdge_2E(ARGS) { BF("BF_CurlPerpendicularEdge_2E",BF_GradNode_2E) ; } void BF_CurlPerpendicularEdge_2F(ARGS) { BF("BF_CurlPerpendicularEdge_2F",BF_GradNode_2F) ; } void BF_CurlPerpendicularEdge_2V(ARGS) { BF("BF_CurlPerpendicularEdge_2V",BF_GradNode_2V) ; } void BF_CurlPerpendicularEdge_3E(ARGS) { BF("BF_CurlPerpendicularEdge_3E",BF_GradNode_3E) ; } void BF_CurlPerpendicularEdge_3F(ARGS) { BF("BF_CurlPerpendicularEdge_3F",BF_GradNode_3F) ; } void BF_CurlPerpendicularEdge_3V(ARGS) { BF("BF_CurlPerpendicularEdge_3V",BF_GradNode_3V) ; } #undef BF /* ------------------------------------------------------------------------ */ /* B F _ P e r p e n d i c u l a r F a c e t */ /* ------------------------------------------------------------------------ */ #define BF(BF_PerpendicularFacet_X,BF_Edge_X) \ double ss ; \ (BF_Edge_X)(Element, NumEntity, u, v, w, s) ; \ ss = s[0] ; s[0] = -s[1] ; s[1] = ss ; void BF_PerpendicularFacet(ARGS) { BF("BF_PerpendicularFacet",BF_Edge) ; } void BF_PerpendicularFacet_2E(ARGS) { BF("BF_PerpendicularFacet_2E",BF_Edge_2E) ; } void BF_PerpendicularFacet_2F(ARGS) { BF("BF_PerpendicularFacet_2F",BF_Edge_2F) ; } void BF_PerpendicularFacet_2V(ARGS) { BF("BF_PerpendicularFacet_2V",BF_Edge_2V) ; } void BF_PerpendicularFacet_3E(ARGS) { BF("BF_PerpendicularFacet_3E",BF_Edge_3E) ; } void BF_PerpendicularFacet_3F_a(ARGS) { BF("BF_PerpendicularFacet_3F_a",BF_Edge_3F_a) ; } void BF_PerpendicularFacet_3F_b(ARGS) { BF("BF_PerpendicularFacet_3F_b",BF_Edge_3F_b) ; } void BF_PerpendicularFacet_3F_c(ARGS) { BF("BF_PerpendicularFacet_3F_c",BF_Edge_3F_c) ; } void BF_PerpendicularFacet_3V(ARGS) { BF("BF_PerpendicularFacet_3V",BF_Edge_3V) ; } void BF_PerpendicularFacet_4E(ARGS) { BF("BF_PerpendicularFacet_4E",BF_Edge_4E) ; } void BF_PerpendicularFacet_4F(ARGS) { BF("BF_PerpendicularFacet_4F",BF_Edge_4F) ; } void BF_PerpendicularFacet_4V(ARGS) { BF("BF_PerpendicularFacet_4V",BF_Edge_4V) ; } #undef BF /* ------------------------------------------------------------------------ */ /* B F _ D i v P e r p e n d i c u l a r F a c e t */ /* ------------------------------------------------------------------------ */ #define BF(BF_DivPerpendicularFacet_X,BF_CurlEdge_X) \ (BF_CurlEdge_X)(Element, NumEntity, u, v, w, s) ; \ s[0] = -s[2] ; s[2] = 0. ; void BF_DivPerpendicularFacet(ARGS){ BF("BF_DivPerpendicularFacet",BF_CurlEdge) ; } void BF_DivPerpendicularFacet_2E(ARGS){ BF("BF_DivPerpendicularFacet_2E",BF_CurlEdge_2E) ; } void BF_DivPerpendicularFacet_2F(ARGS){ BF("BF_DivPerpendicularFacet_2F",BF_CurlEdge_2F) ; } void BF_DivPerpendicularFacet_2V(ARGS){ BF("BF_DivPerpendicularFacet_2V",BF_CurlEdge_2V) ; } void BF_DivPerpendicularFacet_3E(ARGS){ BF("BF_DivPerpendicularFacet_3E",BF_CurlEdge_3E) ; } void BF_DivPerpendicularFacet_3F_a(ARGS){ BF("BF_DivPerpendicularFacet_3F_a",BF_CurlEdge_3F_a) ; } void BF_DivPerpendicularFacet_3F_b(ARGS){ BF("BF_DivPerpendicularFacet_3F_b",BF_CurlEdge_3F_b) ; } void BF_DivPerpendicularFacet_3F_c(ARGS){ BF("BF_DivPerpendicularFacet_3F_c",BF_CurlEdge_3F_c) ; } void BF_DivPerpendicularFacet_3V(ARGS){ BF("BF_DivPerpendicularFacet_3V",BF_CurlEdge_3V) ; } void BF_DivPerpendicularFacet_4E(ARGS){ BF("BF_DivPerpendicularFacet_4E",BF_CurlEdge_4E) ; } void BF_DivPerpendicularFacet_4F(ARGS){ BF("BF_DivPerpendicularFacet_4F",BF_CurlEdge_4F) ; } void BF_DivPerpendicularFacet_4V(ARGS){ BF("BF_DivPerpendicularFacet_4V",BF_CurlEdge_4V) ; } #undef BF #undef ARGS getdp-2.7.0-source/Legacy/Pos_Element.h000644 001750 001750 00000003135 12473553042 021377 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _POS_ELEMENT_H_ #define _POS_ELEMENT_H_ #include "ProData.h" #include "ListUtils.h" /* ------------------------------------------------------------------------ */ /* P o s t E l e m e n t */ /* ------------------------------------------------------------------------ */ struct PostElement { int Index, Type, Depth; int NbrNodes, * NumNodes; double * u, * v, * w, * x, * y, * z; struct Value * Value; } ; struct PostElement * Create_PostElement(int Index, int Type, int NbrNodes, int Depth); void Destroy_PostElement(struct PostElement * PostElement) ; struct PostElement * NodeCopy_PostElement(struct PostElement *PostElement); struct PostElement * PartialCopy_PostElement(struct PostElement *PostElement); void Fill_PostElement(struct Geo_Element *GE, List_T *PostElement_L, int Index, int Depth, int Skin, List_T * EvaluationPoints_L, int DecomposeInSimplex) ; void Cut_PostElement(struct PostElement * PE, struct Geo_Element * GE, List_T * PE_L, int Index, int Depth, int Skin, int DecomposeInSimplex) ; void Sort_PostElement_Connectivity(List_T *PostElement_L); int fcmp_PostElement (const void *a, const void *b); int fcmp_PostElement_v0(const void *a, const void *b); int fcmp_PostElement_absu0(const void *a, const void *b); #endif getdp-2.7.0-source/Legacy/LinAlg.h000644 001750 001750 00000016351 12552147335 020341 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _LINALG_H_ #define _LINALG_H_ #include #include #include #include "GetDPConfig.h" // GetDP only uses a predefined set of acces routines to scalars // (double precision floating point real or complex values), vectors // of scalars and matrices of scalars. Thse routines are redefined for // each solver interface, currently Sparskit (LinAlg_SPARSKIT.cpp) and // PETSc (LinAlg_PETSC.cpp) #if defined(HAVE_SPARSKIT) #include "Sparskit.h" #define gSCALAR_SIZE 1 #define gCOMPLEX_INCREMENT 2 typedef struct { double s ; } gScalar ; typedef struct { Matrix M ; } gMatrix ; typedef struct { int N ; double *V ; } gVector ; typedef struct { Solver_Params Params ; } gSolver ; #elif defined(HAVE_PETSC) #include "petsc.h" #if (PETSC_VERSION_MAJOR < 2) || ((PETSC_VERSION_MAJOR == 2) && (PETSC_VERSION_MINOR < 3)) #error "GetDP requires PETSc version 2.3 or higher" #else #include "petscksp.h" #include "petscsnes.h" #endif #if defined(PETSC_USE_COMPLEX) #define gSCALAR_SIZE 2 #define gCOMPLEX_INCREMENT 1 #else #define gSCALAR_SIZE 1 #define gCOMPLEX_INCREMENT 2 #endif typedef struct { PetscScalar s ; } gScalar ; typedef struct { Mat M ; } gMatrix ; typedef struct { Vec V, Vseq ; int haveSeq ; } gVector ; typedef struct { KSP ksp[10] ; SNES snes[10] ; } gSolver ; #else #define gSCALAR_SIZE 1 #define gCOMPLEX_INCREMENT 2 typedef struct { double s; } gScalar ; typedef struct { double **m; } gMatrix ; typedef struct { double *m; } gVector ; typedef struct { int dummy; } gSolver ; #endif void LinAlg_InitializeSolver(int* argc, char*** argv); void LinAlg_FinalizeSolver(void); void LinAlg_SetCommSelf(); void LinAlg_SetCommWorld(); void LinAlg_CreateSolver(gSolver *Solver, const char * SolverDataFileName); void LinAlg_SetGlobalSolverOptions(const std::string &opt); void LinAlg_CreateVector(gVector *V, gSolver *Solver, int n); void LinAlg_CreateMatrix(gMatrix *M, gSolver *Solver, int n, int m); void LinAlg_DestroySolver(gSolver *Solver); void LinAlg_DestroyVector(gVector *V); void LinAlg_DestroyMatrix(gMatrix *M); void LinAlg_CopyScalar(gScalar *S1, gScalar *S2); void LinAlg_CopyVector(gVector *V1, gVector *V2); void LinAlg_CopyMatrix(gMatrix *M1, gMatrix *M2); void LinAlg_SwapVector(gVector *V1, gVector *V2); void LinAlg_ZeroScalar(gScalar *S); void LinAlg_ZeroVector(gVector *V); void LinAlg_ZeroMatrix(gMatrix *M); void LinAlg_ScanScalar(FILE *file, gScalar *S); void LinAlg_ScanVector(FILE *file, gVector *V); void LinAlg_ScanMatrix(FILE *file, gMatrix *M); void LinAlg_ReadScalar(FILE *file, gScalar *S); void LinAlg_ReadVector(FILE *file, gVector *V); void LinAlg_ReadMatrix(FILE *file, gMatrix *M); void LinAlg_PrintScalar(FILE *file, gScalar *S); void LinAlg_PrintVector(FILE *file, gVector *V, bool matlab=false, const char* fileName="vector.m", const char* varName="Vec_0"); void LinAlg_PrintMatrix(FILE *file, gMatrix *M, bool matlab=false, const char* fileName="matrix.m", const char* varName="Mat_0"); void LinAlg_WriteScalar(FILE *file, gScalar *S); void LinAlg_WriteVector(FILE *file, gVector *V); void LinAlg_WriteMatrix(FILE *file, gMatrix *M); void LinAlg_GetVectorSize(gVector *V, int *i); void LinAlg_GetLocalVectorRange(gVector *V, int *low, int *high); void LinAlg_GetMatrixSize(gMatrix *M, int *i, int *j); void LinAlg_GetLocalMatrixRange(gMatrix *M, int *low, int *high); void LinAlg_GetDoubleInScalar(double *d, gScalar *S); void LinAlg_GetComplexInScalar(double *d1, double *d2, gScalar *S); void LinAlg_GetScalarInVector(gScalar *S, gVector *V, int i); void LinAlg_GetDoubleInVector(double *d, gVector *V, int i); void LinAlg_GetAbsDoubleInVector(double *d, gVector *V, int i); void LinAlg_GetComplexInVector(double *d1, double *d2, gVector *V, int i, int j); void LinAlg_GetScalarInMatrix(gScalar *S, gMatrix *M, int i, int j); void LinAlg_GetDoubleInMatrix(double *d, gMatrix *M, int i, int j); void LinAlg_GetComplexInMatrix(double *d1, double *d2, gMatrix *M, int i, int j, int k, int l); void LinAlg_GetColumnInMatrix(gMatrix *M, int col, gVector *V1); void LinAlg_SetScalar(gScalar *S, double *d); void LinAlg_SetVector(gVector *V, double *v); void LinAlg_SetScalarInVector(gScalar *S, gVector *V, int i); void LinAlg_SetDoubleInVector(double d, gVector *V, int i); void LinAlg_SetComplexInVector(double d1, double d2, gVector *V, int i, int j); void LinAlg_SetScalarInMatrix(gScalar *S, gMatrix *M, int i, int j); void LinAlg_SetDoubleInMatrix(double d, gMatrix *M, int i, int j); void LinAlg_SetComplexInMatrix(double d1, double d2, gMatrix *M, int i, int j, int k, int l); void LinAlg_AddScalarScalar(gScalar *S1, gScalar *S2, gScalar *S3); void LinAlg_AddScalarInVector(gScalar *S, gVector *V, int i); void LinAlg_AddDoubleInVector(double d, gVector *V, int i); void LinAlg_AddComplexInVector(double d1, double d2, gVector *V, int i, int j); void LinAlg_AddScalarInMatrix(gScalar *S, gMatrix *M, int i, int j); void LinAlg_AddDoubleInMatrix(double d, gMatrix *M, int i, int j); void LinAlg_AddComplexInMatrix(double d1, double d2, gMatrix *M, int i, int j, int k, int l); void LinAlg_AddVectorVector(gVector *V1, gVector *V2, gVector *V3); void LinAlg_AddVectorProdVectorDouble(gVector *V1, gVector *V2, double d, gVector *V3); void LinAlg_AddMatrixMatrix(gMatrix *M1, gMatrix *M2, gMatrix *M3); void LinAlg_AddMatrixProdMatrixDouble(gMatrix *M1, gMatrix *M2, double d, gMatrix *M3); void LinAlg_SubScalarScalar(gScalar *S1, gScalar *S2, gScalar *S3); void LinAlg_SubVectorVector(gVector *V1, gVector *V2, gVector *V3); void LinAlg_SubMatrixMatrix(gMatrix *M1, gMatrix *M2, gMatrix *M3); void LinAlg_ProdScalarScalar(gScalar *S1, gScalar *S2, gScalar *S3); void LinAlg_ProdScalarDouble(gScalar *S1, double d, gScalar *S2); void LinAlg_ProdScalarComplex(gScalar *S, double d1, double d2, double *d3, double *d4); void LinAlg_ProdVectorScalar(gVector *V1, gScalar *S, gVector *V2); void LinAlg_ProdVectorDouble(gVector *V1, double d, gVector *V2); void LinAlg_ProdVectorComplex(gVector *V1, double d1, double d2, gVector *V2); void LinAlg_ProdVectorVector(gVector *V1, gVector *V2, double *d); void LinAlg_ProdMatrixVector(gMatrix *M, gVector *V1, gVector *V2); void LinAlg_ProdMatrixScalar(gMatrix *M1, gScalar *S, gMatrix *M2); void LinAlg_ProdMatrixDouble(gMatrix *M1, double d, gMatrix *M2); void LinAlg_ProdMatrixComplex(gMatrix *M1, double d1, double d2, gMatrix *M2); void LinAlg_DummyVector(gVector *V); void LinAlg_DivScalarScalar(gScalar *S1, gScalar *S2, gScalar *S3); void LinAlg_DivScalarDouble(gScalar *S1, double d, gScalar *S2); void LinAlg_VectorNorm2(gVector *V1, double *norm); void LinAlg_VectorNormInf(gVector *V1, double *norm); void LinAlg_AssembleMatrix(gMatrix *M); void LinAlg_AssembleVector(gVector *V); void LinAlg_Solve(gMatrix *A, gVector *B, gSolver *Solver, gVector *X, int solverIndex=0); void LinAlg_SolveAgain(gMatrix *A, gVector *B, gSolver *Solver, gVector *X, int solverIndex=0); void LinAlg_SolveNL(gMatrix *A, gVector *B, gMatrix *Jac, gVector *R, gSolver *Solver, gVector *X, int solverIndex=0); #endif getdp-2.7.0-source/Legacy/Gauss_Quadrangle.cpp000644 001750 001750 00000005531 12473553042 022747 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "Gauss.h" #include "Gauss_Quadrangle.h" #include "Message.h" #include "MallocUtils.h" /* Classic Gauss Integration over a quadrangle */ void Gauss_Quadrangle (int Nbr_Points, int Num, double *u, double *v, double *w, double *wght) { switch (Nbr_Points) { case 1 : *u= xq1 [Num] ; *v= yq1 [Num] ; *w= 0. ; *wght= pq1 [Num] ; break ; case 3 : *u= xq3 [Num] ; *v= yq3 [Num] ; *w= 0. ; *wght= pq3 [Num] ; break ; case 4 : *u= xq4 [Num] ; *v= yq4 [Num] ; *w= 0. ; *wght= pq4 [Num] ; break ; case 7 : *u= xq7 [Num] ; *v= yq7 [Num] ; *w= 0. ; *wght= pq7 [Num] ; break ; default : Message::Error("Wrong number of Gauss points for Quadrangle: " "valid choices: 1, 3, 4, 7"); break; } } /* Gauss-Legendre scheme to integrate over a quadrangle */ static int glq[MAX_LINE_POINTS] = {-1}; static double *glxq[MAX_LINE_POINTS], *glyq[MAX_LINE_POINTS], *glpq[MAX_LINE_POINTS]; void GaussLegendre_Quadrangle(int Nbr_Points, int Num, double *u, double *v, double *w, double *wght) { int i, j, index = 0, nb; double pt1, pt2, wt1, wt2, dum; nb = (int)sqrt((double)Nbr_Points); if(nb * nb != Nbr_Points || nb > MAX_LINE_POINTS){ Message::Error("Number of points should be n^2 with n in [1,%d]", MAX_LINE_POINTS) ; return; } if(glq[0] < 0) for(i = 0; i < MAX_LINE_POINTS; i++) glq[i] = 0; if(!glq[nb - 1]){ Message::Info("Computing GaussLegendre %dX%d for Quadrangle", nb, nb); glxq[nb - 1] = (double*)Malloc(Nbr_Points * sizeof(double)); glyq[nb - 1] = (double*)Malloc(Nbr_Points * sizeof(double)); glpq[nb - 1] = (double*)Malloc(Nbr_Points * sizeof(double)); for(i = 0; i < nb; i++) { Gauss_Line(nb, i, &pt1, &dum, &dum, &wt1); for(j = 0; j < nb; j++) { Gauss_Line(nb, j, &pt2, &dum, &dum, &wt2); glxq[nb - 1][index] = pt1; glyq[nb - 1][index] = pt2; glpq[nb - 1][index++] = wt1*wt2; } } glq[nb - 1] = 1; } *u = glxq[nb - 1][Num] ; *v = glyq[nb - 1][Num] ; *w = 0. ; *wght = glpq[nb - 1][Num] ; } /* Gauss Integration over a quadrangle with a 1/R singularity over node (-1,-1,0) */ void GaussSingularR_Quadrangle(int Nbr_Points, int Num, double *u, double *v, double *w, double *wght) { switch (Nbr_Points) { case 1 : *u= xqs1 [Num] ; *v= yqs1 [Num] ; *w= 0. ; *wght= pqs1 [Num] ; break ; case 3 : *u= xqs3 [Num] ; *v= yqs3 [Num] ; *w= 0. ; *wght= pqs3 [Num] ; break ; case 4 : *u= xqs4 [Num] ; *v= yqs4 [Num] ; *w= 0. ; *wght= pqs4 [Num] ; break ; default : Message::Error("Wrong number of (modified) Gauss Points for Quadrangle: " "valid choices: 1, 3, 4"); break; } } getdp-2.7.0-source/Legacy/SolvingOperations.h000644 001750 001750 00000010563 12473553042 022655 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _SOLVING_OPERATIONS_H_ #define _SOLVING_OPERATIONS_H_ #include "ProData.h" #include "LinAlg.h" void ReGenerate_System(struct DefineSystem *DefineSystem_P, struct DofData *DofData_P, struct DofData *DofData_P0, int Flag_Jac); void Treatment_Operation(struct Resolution * Resolution_P, List_T * Operation_L, struct DofData * DofData_P0, struct GeoData * GeoData_P0, struct Resolution * Resolution2_P, struct DofData * DofData2_P0); int Operation_IterativeLinearSolver(struct Resolution *Resolution_P, struct Operation *Operation_P, struct DofData *DofData_P0, struct GeoData *GeoData_P0) ; int Operation_BroadcastFields(struct Resolution *Resolution_P, struct Operation *Operation_P, struct DofData *DofData_P0, struct GeoData *GeoData_P0) ; void Operation_TimeLoopAdaptive(struct Resolution *Resolution_P, struct Operation *Operation_P, struct DofData *DofData_P0, struct GeoData *GeoData_P0, int *Flag_Break) ; void Operation_IterativeLoopN(struct Resolution *Resolution_P, struct Operation *Operation_P, struct DofData *DofData_P0, struct GeoData *GeoData_P0, struct Resolution *Resolution2_P, struct DofData *DofData2_P0, int *Flag_Break) ; void Operation_IterativeTimeReduction(struct Resolution * Resolution_P, struct Operation * Operation_P, struct DofData * DofData_P0, struct GeoData * GeoData_P0); void Operation_Update(struct DefineSystem * DefineSystem_P, struct DofData * DofData_P, struct DofData * DofData_P0, int TimeFunctionIndex); void Operation_ChangeOfCoordinates(struct Resolution * Resolution_P, struct Operation * Operation_P, struct DofData * DofData_P0, struct GeoData * GeoData_P0); void Operation_DeformeMesh(struct Resolution * Resolution_P, struct Operation * Operation_P, struct DofData * DofData_P0, struct GeoData * GeoData_P0); void Operation_PostOperation(Resolution *Resolution_P, DofData *DofData_P0, GeoData *GeoData_P0, List_T *PostOperations); void InitLEPostOperation(Resolution *Resolution_P, DofData *DofData_P0, GeoData *GeoData_P0, List_T *PostOp_L, List_T *LEPostOpNames_L, List_T *PostOpSolPredicted_L); void ClearLEPostOperation(Resolution *Resolution_P, DofData *DofData_P0, GeoData *GeoData_P0, List_T *LEPostOp_L, List_T *LEPostOpNames_L, List_T *PostOpSolPredicted_L, bool Delete_LEPostOp_L); void Cal_SolutionErrorRatio(gVector *dx, gVector *x, double reltol, double abstol, int NormType, double *ErrorRatio) ; void Cal_SolutionError(gVector *dx, gVector *x, int diff, double *MeanError); void Free_UnusedSolutions(struct DofData * DofData_P); void Free_UnusedPOresults(); void Free_AllPOresults(); #endif getdp-2.7.0-source/Legacy/Pos_FemInterpolation.cpp000644 001750 001750 00000036334 12473553042 023627 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "ProData.h" #include "GeoData.h" #include "DofData.h" #include "Get_DofOfElement.h" #include "Get_ElementSource.h" #include "Get_Geometry.h" #include "Get_FunctionValue.h" #include "Cal_IntegralQuantity.h" #include "Pos_Search.h" #include "Message.h" extern struct Problem Problem_S ; extern struct CurrentData Current ; extern List_T *GeoData_L ; /* ------------------------------------------------------------------------ */ /* P o s _ F e m I n t e r p o l a t i o n */ /* ------------------------------------------------------------------------ */ void Pos_FemInterpolation(struct Element * Element, struct QuantityStorage * QuantityStorage_P0, struct QuantityStorage * QuantityStorage_P, int Type_Quantity, int Type_Operator, int Type_Dimension, int UseXYZ, double u, double v, double w, double x, double y, double z, double Val[], int * Type_Value, int Flag_ChangeOfCoordinates) { void (*xFunctionBF[NBR_MAX_BASISFUNCTIONS]) (struct Element *, int, double, double, double, double []) ; void (*xChangeOfCoordinates) () = 0; struct IntegralQuantityActive IQA ; struct Value vBFxDof[NBR_MAX_BASISFUNCTIONS] ; struct GeoData * GeoData_P ; struct Element TheElement, * TheElement_P ; struct QuantityStorage * QS_P ; double vBFu[NBR_MAX_BASISFUNCTIONS][MAX_DIM] ; double Val_Dof, Val_Dof_r, Val_Dof_i ; int Type_DefineQuantity, SubType_DefineQuantity, Type_Form ; int i, j, k, Nbr_Dof = 0 ; int GeoDataNum = 0, UseNewGeo = 0 ; /* ------------- Quantity Type ------------- */ Type_DefineQuantity = QuantityStorage_P->DefineQuantity->Type ; if(Type_DefineQuantity == INTEGRALQUANTITY){ if(QuantityStorage_P->DefineQuantity->IntegralQuantity.DefineQuantityIndexDof < 0){ SubType_DefineQuantity = NODOF ; } else{ SubType_DefineQuantity = INTEGRALQUANTITY ; } } else{ SubType_DefineQuantity = Type_DefineQuantity ; } /* --------------- Get The Element --------------- */ if(SubType_DefineQuantity != NODOF) { if(!QuantityStorage_P->FunctionSpace){ Message::Error("No available function space for quantity"); return; } if(!QuantityStorage_P->FunctionSpace->DofData){ Message::Error("No available data to interpolate quantity"); return; } GeoDataNum = QuantityStorage_P->FunctionSpace->DofData->GeoDataIndex; UseNewGeo = (GeoDataNum != Current.GeoData->Num) ; if(UseXYZ || UseNewGeo){ if(UseNewGeo){ GeoData_P = (struct GeoData *)List_Pointer(GeoData_L, GeoDataNum); GeoDataNum = Current.GeoData->Num ; Geo_SetCurrentGeoData(Current.GeoData = GeoData_P) ; } if(!UseXYZ){ x = y = z = 0. ; for (i = 0 ; i < Element->GeoElement->NbrNodes ; i++) { x += Element->x[i] * Element->n[i] ; y += Element->y[i] * Element->n[i] ; z += Element->z[i] * Element->n[i] ; } } InWhichElement(&Current.GeoData->Grid, NULL, &TheElement, (Type_Dimension >= 0) ? Type_Dimension : _ALL, x, y, z, &u, &v, &w) ; TheElement_P = &TheElement ; Get_InitDofOfElement(&TheElement) ; Get_DofOfElement (&TheElement, QuantityStorage_P->FunctionSpace, QuantityStorage_P, QuantityStorage_P->DefineQuantity->IndexInFunctionSpace) ; } else{ TheElement_P = Element; } } else{ TheElement_P = Element ; } /* ------------------ Init LocalQuantity ------------------ */ if (Type_DefineQuantity == LOCALQUANTITY) { if (TheElement_P->Num != NO_ELEMENT) { Nbr_Dof = QuantityStorage_P->NbrElementaryBasisFunction ; Get_FunctionValue(Nbr_Dof, (void (**)())xFunctionBF, Type_Operator, QuantityStorage_P, &Type_Form) ; xChangeOfCoordinates = (void (*)())Get_ChangeOfCoordinates ((Flag_ChangeOfCoordinates && TheElement_P->Num != NO_ELEMENT), Type_Form) ; } else { Message::Warning("No element found in mesh for LocalQuantity interpolation"); Nbr_Dof = 0 ; Type_Form = VECTOR ; } } /* --------------------- Init IntegralQuantity --------------------- */ else if (Type_DefineQuantity == INTEGRALQUANTITY) { if(Type_Operator != NOOP){ Message::Error("Operator acting on Integral Quantity"); } Type_Form = VECTOR ; Get_InitElementSource(TheElement_P, QuantityStorage_P->DefineQuantity->IntegralQuantity.InIndex) ; IQA.IntegrationCase_L = ((struct IntegrationMethod *) List_Pointer(Problem_S.IntegrationMethod, QuantityStorage_P->DefineQuantity-> IntegralQuantity.IntegrationMethodIndex)) ->IntegrationCase ; IQA.CriterionIndex = ((struct IntegrationMethod *) List_Pointer(Problem_S.IntegrationMethod, QuantityStorage_P->DefineQuantity-> IntegralQuantity.IntegrationMethodIndex)) ->CriterionIndex ; IQA.JacobianCase_L = ((struct JacobianMethod *) List_Pointer(Problem_S.JacobianMethod, QuantityStorage_P->DefineQuantity-> IntegralQuantity.JacobianMethodIndex)) ->JacobianCase ; xChangeOfCoordinates = (void (*)())Get_ChangeOfCoordinates(0, Type_Form) ; } /* ---------------------- Compute GlobalQuantity ---------------------- */ if (Type_DefineQuantity == GLOBALQUANTITY) { if(Current.NbrHar==1){ if (Type_Quantity == QUANTITY_BF) Val[0] = (QuantityStorage_P->BasisFunction[0].Dof->Entity == Current.SubRegion)? 1. : 0. ; else Dof_GetRealDofValue (QuantityStorage_P->FunctionSpace->DofData, QuantityStorage_P->BasisFunction[0].Dof, &Val[0]) ; } else{ for (k = 0 ; k < Current.NbrHar ; k+=2) { if (Type_Quantity == QUANTITY_BF) { Val[MAX_DIM*k] = (QuantityStorage_P->BasisFunction[0].Dof->Entity == Current.SubRegion)? 1. : 0. ; Val[MAX_DIM*(k+1)] = 0. ; } else { Dof_GetComplexDofValue (QuantityStorage_P->FunctionSpace->DofData, QuantityStorage_P->BasisFunction[0].Dof + k/2*gCOMPLEX_INCREMENT, &Val[MAX_DIM*k], &Val[MAX_DIM*(k+1)]) ; } } } *Type_Value = SCALAR ; return ; } /* ----------------------------------- Compute Local / Integral Quantities ----------------------------------- */ i = Current.NbrHar * MAX_DIM ; for (k = 0 ; k < i ; k++) Val[k] = 0. ; while (1) { if (Type_DefineQuantity == INTEGRALQUANTITY) { if (Get_NextElementSource(TheElement_P->ElementSource)) { Get_NodesCoordinatesOfElement(TheElement_P->ElementSource) ; if(SubType_DefineQuantity != NODOF){ Get_DofOfElement(TheElement_P->ElementSource, QuantityStorage_P->FunctionSpace, QuantityStorage_P, QuantityStorage_P->DefineQuantity->IndexInFunctionSpace) ; Nbr_Dof = QuantityStorage_P->NbrElementaryBasisFunction ; Get_FunctionValue(Nbr_Dof, (void (**)())xFunctionBF, QuantityStorage_P->DefineQuantity->IntegralQuantity.TypeOperatorDof, QuantityStorage_P, &IQA.Type_FormDof) ; Type_Form = IQA.Type_FormDof ; /* good form */ } else{ Nbr_Dof = 1 ; xFunctionBF[0] = NULL ; /* for analytic integration tests */ Type_Form = IQA.Type_FormDof = VECTOR ; /* form type unknown */ for (j = 0 ; j < QuantityStorage_P->DefineQuantity->IntegralQuantity.NbrQuantityIndex ; j++) { QS_P = QuantityStorage_P0 + QuantityStorage_P->DefineQuantity->IntegralQuantity.QuantityIndexTable[j] ; Get_DofOfElement(TheElement_P->ElementSource, QS_P->FunctionSpace, QS_P, QS_P->DefineQuantity->IndexInFunctionSpace) ; } } Cal_InitIntegralQuantity (TheElement_P, &IQA, QuantityStorage_P); } else break ; } /* ----- Local ----- */ if (Type_DefineQuantity == LOCALQUANTITY) { if (TheElement_P->Num != NO_ELEMENT) { for (j = 0 ; j < Nbr_Dof ; j++) { xFunctionBF[j] (TheElement_P, QuantityStorage_P->BasisFunction[j].NumEntityInElement+1, u, v, w, vBFu[j]) ; ((void (*)(struct Element*, double*, double*)) xChangeOfCoordinates) (TheElement_P, vBFu[j], vBFxDof[j].Val) ; } } /* interpolate (vBFxDof is real-valued) */ switch (Type_Form) { case FORM0 : case FORM3 : case FORM3P : case SCALAR : if(Current.NbrHar==1){ for (j = 0 ; j < Nbr_Dof ; j++){ if (Type_Quantity == QUANTITY_BF) Val_Dof = (QuantityStorage_P->BasisFunction[j].Dof->Entity == Current.SubRegion)? 1. : 0. ; else Dof_GetRealDofValue (QuantityStorage_P->FunctionSpace->DofData, QuantityStorage_P->BasisFunction[j].Dof, &Val_Dof) ; Val[0] += vBFxDof[j].Val[0] * Val_Dof ; } } else{ for (j = 0 ; j < Nbr_Dof ; j++){ for (k = 0 ; k < Current.NbrHar ; k+=2) { if (Type_Quantity == QUANTITY_BF) { Val_Dof_r = (QuantityStorage_P->BasisFunction[j].Dof->Entity == Current.SubRegion)? 1. : 0. ; Val_Dof_i = 0. ; } else { Dof_GetComplexDofValue (QuantityStorage_P->FunctionSpace->DofData, QuantityStorage_P->BasisFunction[j].Dof + k/2*gCOMPLEX_INCREMENT, &Val_Dof_r, &Val_Dof_i) ; } Val[MAX_DIM*k] += vBFxDof[j].Val[0] * Val_Dof_r ; Val[MAX_DIM*(k+1)] += vBFxDof[j].Val[0] * Val_Dof_i ; } } } *Type_Value = SCALAR ; break ; case FORM1 : case FORM1P : case FORM2 : case FORM2P : case FORM1S : case FORM2S : case VECTOR : case VECTORP : if(Current.NbrHar==1){ for (j = 0 ; j < Nbr_Dof ; j++){ if (Type_Quantity == QUANTITY_BF) Val_Dof = (QuantityStorage_P->BasisFunction[j].Dof->Entity == Current.SubRegion)? 1. : 0. ; else Dof_GetRealDofValue (QuantityStorage_P->FunctionSpace->DofData, QuantityStorage_P->BasisFunction[j].Dof, &Val_Dof) ; Val[0] += vBFxDof[j].Val[0] * Val_Dof ; Val[1] += vBFxDof[j].Val[1] * Val_Dof ; Val[2] += vBFxDof[j].Val[2] * Val_Dof ; } } else{ for (j = 0 ; j < Nbr_Dof ; j++){ for (k = 0 ; k < Current.NbrHar ; k+=2) { if (Type_Quantity == QUANTITY_BF) { Val_Dof_r = (QuantityStorage_P->BasisFunction[j].Dof->Entity == Current.SubRegion)? 1. : 0. ; Val_Dof_i = 0. ; } else { Dof_GetComplexDofValue (QuantityStorage_P->FunctionSpace->DofData, QuantityStorage_P->BasisFunction[j].Dof + k/2*gCOMPLEX_INCREMENT, &Val_Dof_r, &Val_Dof_i) ; } Val[MAX_DIM*k ] += vBFxDof[j].Val[0] * Val_Dof_r ; Val[MAX_DIM*k+1] += vBFxDof[j].Val[1] * Val_Dof_r ; Val[MAX_DIM*k+2] += vBFxDof[j].Val[2] * Val_Dof_r ; Val[MAX_DIM*(k+1) ] += vBFxDof[j].Val[0] * Val_Dof_i ; Val[MAX_DIM*(k+1)+1] += vBFxDof[j].Val[1] * Val_Dof_i ; Val[MAX_DIM*(k+1)+2] += vBFxDof[j].Val[2] * Val_Dof_i ; } } } *Type_Value = VECTOR ; break ; default : Message::Error("Unknown Form type in 'Pos_FemInterpolation'"); break; } } /* -------- Integral -------- */ /* FIXME: Ce qu'il faut faire, c'est ne pas reinterpoler ici, mais laisser au Cal_Quantity dans Cal_IntegralQuantity le soin de reinterpoler directment la quantity local intervenant ds la qte integrale s'il y a lieu (mais, comment faire avec l'integration analytique ?) */ else { if (IQA.IntegrationCase_P->Type == ANALYTIC) Cal_AnalyticIntegralQuantity (Current.Element = TheElement_P, QuantityStorage_P, Nbr_Dof, (void (**)())xFunctionBF, vBFxDof) ; else Cal_NumericalIntegralQuantity (Current.Element = TheElement_P, &IQA, QuantityStorage_P0, QuantityStorage_P, SubType_DefineQuantity, Nbr_Dof, (void (**)())xFunctionBF, vBFxDof) ; Type_Form = vBFxDof[0].Type ; /* interpolate (vBFxDof can be complex-valued) */ if(SubType_DefineQuantity == NODOF){ switch (Type_Form) { case FORM0 : case FORM3 : case FORM3P : case SCALAR : for (k = 0 ; k < Current.NbrHar ; k++) Val[MAX_DIM*k] += vBFxDof[0].Val[MAX_DIM*k] ; *Type_Value = SCALAR ; break ; case FORM1 : case FORM1P : case FORM2 : case FORM2P : case FORM1S : case FORM2S : case VECTOR : case VECTORP : for (k = 0 ; k < Current.NbrHar ; k++) { Val[MAX_DIM*k] += vBFxDof[0].Val[MAX_DIM*k] ; Val[MAX_DIM*k+1] += vBFxDof[0].Val[MAX_DIM*k+1] ; Val[MAX_DIM*k+2] += vBFxDof[0].Val[MAX_DIM*k+2] ; } *Type_Value = VECTOR ; break ; default : Message::Error("Unknown Form type in 'Pos_FemInterpolation'"); break; } } else{ switch (Type_Form) { case FORM0 : case FORM3 : case FORM3P : case SCALAR : if(Current.NbrHar==1){ for (j = 0 ; j < Nbr_Dof ; j++){ Dof_GetRealDofValue (QuantityStorage_P->FunctionSpace->DofData, QuantityStorage_P->BasisFunction[j].Dof, &Val_Dof) ; Val[0] += vBFxDof[j].Val[0] * Val_Dof ; } } else{ for (j = 0 ; j < Nbr_Dof ; j++){ for (k = 0 ; k < Current.NbrHar ; k+=2) { Dof_GetComplexDofValue (QuantityStorage_P->FunctionSpace->DofData, QuantityStorage_P->BasisFunction[j].Dof + k/2*gCOMPLEX_INCREMENT, &Val_Dof_r, &Val_Dof_i) ; Val[MAX_DIM*k] += vBFxDof[j].Val[MAX_DIM*k] * Val_Dof_r - vBFxDof[j].Val[MAX_DIM*(k+1)] * Val_Dof_i ; Val[MAX_DIM*(k+1)] += vBFxDof[j].Val[MAX_DIM*k] * Val_Dof_i + vBFxDof[j].Val[MAX_DIM*(k+1)] * Val_Dof_r ; } } } *Type_Value = SCALAR ; break ; case FORM1 : case FORM1P : case FORM2 : case FORM2P : case FORM1S : case FORM2S : case VECTOR : case VECTORP : if(Current.NbrHar==1){ for (j = 0 ; j < Nbr_Dof ; j++){ Dof_GetRealDofValue (QuantityStorage_P->FunctionSpace->DofData, QuantityStorage_P->BasisFunction[j].Dof, &Val_Dof) ; Val[0] += vBFxDof[j].Val[0] * Val_Dof ; Val[1] += vBFxDof[j].Val[1] * Val_Dof ; Val[2] += vBFxDof[j].Val[2] * Val_Dof ; } } else{ for (j = 0 ; j < Nbr_Dof ; j++){ for (k = 0 ; k < Current.NbrHar ; k+=2) { Dof_GetComplexDofValue (QuantityStorage_P->FunctionSpace->DofData, QuantityStorage_P->BasisFunction[j].Dof + k/2*gCOMPLEX_INCREMENT, &Val_Dof_r, &Val_Dof_i) ; Val[MAX_DIM*k] += vBFxDof[j].Val[MAX_DIM*k] * Val_Dof_r - vBFxDof[j].Val[MAX_DIM*(k+1)] * Val_Dof_i ; Val[MAX_DIM*(k+1)] += vBFxDof[j].Val[MAX_DIM*k] * Val_Dof_i + vBFxDof[j].Val[MAX_DIM*(k+1)] * Val_Dof_r ; Val[MAX_DIM*k+1] += vBFxDof[j].Val[MAX_DIM*k+1] * Val_Dof_r - vBFxDof[j].Val[MAX_DIM*(k+1)+1] * Val_Dof_i ; Val[MAX_DIM*(k+1)+1] += vBFxDof[j].Val[MAX_DIM*k+1] * Val_Dof_i + vBFxDof[j].Val[MAX_DIM*(k+1)+1] * Val_Dof_r ; Val[MAX_DIM*k+2] += vBFxDof[j].Val[MAX_DIM*k+2] * Val_Dof_r - vBFxDof[j].Val[MAX_DIM*(k+1)+2] * Val_Dof_i ; Val[MAX_DIM*(k+1)+2] += vBFxDof[j].Val[MAX_DIM*k+2] * Val_Dof_i + vBFxDof[j].Val[MAX_DIM*(k+1)+2] * Val_Dof_r ; } } } *Type_Value = VECTOR ; break ; default : Message::Error("Unknown Form type in 'Pos_FemInterpolation'"); break; } } } if (Type_DefineQuantity != INTEGRALQUANTITY) break ; } /* while (1) ... */ if(UseNewGeo){ GeoData_P = (struct GeoData *)List_Pointer(GeoData_L, GeoDataNum); Geo_SetCurrentGeoData(Current.GeoData = GeoData_P) ; } } getdp-2.7.0-source/Legacy/LinAlg.cpp000644 001750 001750 00000014723 12552147335 020675 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "GetDPConfig.h" #include "LinAlg.h" #include "Message.h" // default dummy solver interface #if !defined(HAVE_PETSC) && !defined(HAVE_SPARSKIT) #define err Message::Error("No solver is compiled in this version of GetDP") void LinAlg_InitializeSolver(int* argc, char*** argv){} void LinAlg_FinalizeSolver(){} void LinAlg_SetCommSelf(){} void LinAlg_SetCommWorld(){} void LinAlg_CreateSolver(gSolver *Solver, const char * SolverDataFileName){ err; } void LinAlg_SetGlobalSolverOptions(const std::string &opt){ err; } void LinAlg_CreateVector(gVector *V, gSolver *Solver, int n){ err; } void LinAlg_CreateMatrix(gMatrix *M, gSolver *Solver, int n, int m){ err; } void LinAlg_DestroySolver(gSolver *Solver){ err; } void LinAlg_DestroyVector(gVector *V){ err; } void LinAlg_DestroyMatrix(gMatrix *M){ err; } void LinAlg_CopyScalar(gScalar *S1, gScalar *S2){ err; } void LinAlg_CopyVector(gVector *V1, gVector *V2){ err; } void LinAlg_SwapVector(gVector *V1, gVector *V2){ err; } void LinAlg_CopyMatrix(gMatrix *M1, gMatrix *M2){ err; } void LinAlg_ZeroScalar(gScalar *S){ err; } void LinAlg_ZeroVector(gVector *V){ err; } void LinAlg_ZeroMatrix(gMatrix *M){ err; } void LinAlg_ScanScalar(FILE *file, gScalar *S){ err; } void LinAlg_ScanVector(FILE *file, gVector *V){ err; } void LinAlg_ScanMatrix(FILE *file, gMatrix *M){ err; } void LinAlg_ReadScalar(FILE *file, gScalar *S){ err; } void LinAlg_ReadVector(FILE *file, gVector *V){ err; } void LinAlg_ReadMatrix(FILE *file, gMatrix *M){ err; } void LinAlg_PrintScalar(FILE *file, gScalar *S){ err; } void LinAlg_PrintVector(FILE *file, gVector *V, bool matlab, const char* fileName, const char* varName){ err; } void LinAlg_PrintMatrix(FILE *file, gMatrix *M, bool matlab, const char* fileName, const char*varName){ err; } void LinAlg_WriteScalar(FILE *file, gScalar *S){ err; } void LinAlg_WriteVector(FILE *file, gVector *V){ err; } void LinAlg_WriteMatrix(FILE *file, gMatrix *M){ err; } void LinAlg_GetVectorSize(gVector *V, int *i){ err; } void LinAlg_GetLocalVectorRange(gVector *V, int *low, int *high){ err; } void LinAlg_GetMatrixSize(gMatrix *M, int *i, int *j){ err; } void LinAlg_GetLocalMatrixRange(gMatrix *M, int *low, int *high){ err; } void LinAlg_GetDoubleInScalar(double *d, gScalar *S){ err; } void LinAlg_GetComplexInScalar(double *d1, double *d2, gScalar *S){ err; } void LinAlg_GetScalarInVector(gScalar *S, gVector *V, int i){ err; } void LinAlg_GetDoubleInVector(double *d, gVector *V, int i){ err; } void LinAlg_GetAbsDoubleInVector(double *d, gVector *V, int i){ err; } void LinAlg_GetComplexInVector(double *d1, double *d2, gVector *V, int i, int j){ err; } void LinAlg_GetScalarInMatrix(gScalar *S, gMatrix *M, int i, int j){ err; } void LinAlg_GetDoubleInMatrix(double *d, gMatrix *M, int i, int j){ err; } void LinAlg_GetComplexInMatrix(double *d1, double *d2, gMatrix *M, int i, int j, int k, int l){ err; } void LinAlg_GetColumnInMatrix(gMatrix *M, int col, gVector *V1){ err; } void LinAlg_GetMatrixContext(gMatrix *A, void **myCtx){ err; } void LinAlg_SetScalar(gScalar *S, double *d){ err; } void LinAlg_SetVector(gVector *V, double *v){ err; } void LinAlg_SetScalarInVector(gScalar *S, gVector *V, int i){ err; } void LinAlg_SetDoubleInVector(double d, gVector *V, int i){ err; } void LinAlg_SetComplexInVector(double d1, double d2, gVector *V, int i, int j){ err; } void LinAlg_SetScalarInMatrix(gScalar *S, gMatrix *M, int i, int j){ err; } void LinAlg_SetDoubleInMatrix(double d, gMatrix *M, int i, int j){ err; } void LinAlg_SetComplexInMatrix(double d1, double d2, gMatrix *M, int i, int j, int k, int l){ err; } void LinAlg_AddScalarScalar(gScalar *S1, gScalar *S2, gScalar *S3){ err; } void LinAlg_DummyVector(gVector *V){ err; } void LinAlg_AddScalarInVector(gScalar *S, gVector *V, int i){ err; } void LinAlg_AddDoubleInVector(double d, gVector *V, int i){ err; } void LinAlg_AddComplexInVector(double d1, double d2, gVector *V, int i, int j){ err; } void LinAlg_AddScalarInMatrix(gScalar *S, gMatrix *M, int i, int j){ err; } void LinAlg_AddDoubleInMatrix(double d, gMatrix *M, int i, int j){ err; } void LinAlg_AddComplexInMatrix(double d1, double d2, gMatrix *M, int i, int j, int k, int l){ err; } void LinAlg_AddVectorVector(gVector *V1, gVector *V2, gVector *V3){ err; } void LinAlg_AddVectorProdVectorDouble(gVector *V1, gVector *V2, double d, gVector *V3){ err; } void LinAlg_AddMatrixMatrix(gMatrix *M1, gMatrix *M2, gMatrix *M3){ err; } void LinAlg_AddMatrixProdMatrixDouble(gMatrix *M1, gMatrix *M2, double d, gMatrix *M3){ err; } void LinAlg_SubScalarScalar(gScalar *S1, gScalar *S2, gScalar *S3){ err; } void LinAlg_SubVectorVector(gVector *V1, gVector *V2, gVector *V3){ err; } void LinAlg_SubMatrixMatrix(gMatrix *M1, gMatrix *M2, gMatrix *M3){ err; } void LinAlg_ProdScalarScalar(gScalar *S1, gScalar *S2, gScalar *S3){ err; } void LinAlg_ProdScalarDouble(gScalar *S1, double d, gScalar *S2){ err; } void LinAlg_ProdScalarComplex(gScalar *S, double d1, double d2, double *d3, double *d4){ err; } void LinAlg_ProdVectorScalar(gVector *V1, gScalar *S, gVector *V2){ err; } void LinAlg_ProdVectorDouble(gVector *V1, double d, gVector *V2){ err; } void LinAlg_ProdVectorComplex(gVector *V1, double d1, double d2, gVector *V2){ err; } void LinAlg_ProdVectorVector(gVector *V1, gVector *V2, double *d){ err; } void LinAlg_ProdMatrixVector(gMatrix *M, gVector *V1, gVector *V2){ err; } void LinAlg_ProdMatrixScalar(gMatrix *M1, gScalar *S, gMatrix *M2){ err; } void LinAlg_ProdMatrixDouble(gMatrix *M1, double d, gMatrix *M2){ err; } void LinAlg_ProdMatrixComplex(gMatrix *M1, double d1, double d2, gMatrix *M2){ err; } void LinAlg_DivScalarScalar(gScalar *S1, gScalar *S2, gScalar *S3){ err; } void LinAlg_DivScalarDouble(gScalar *S1, double d, gScalar *S2){ err; } void LinAlg_VectorNorm2(gVector *V1, double *norm){ err; } void LinAlg_VectorNormInf(gVector *V1, double *norm){ err; } void LinAlg_AssembleMatrix(gMatrix *M){ err; } void LinAlg_AssembleVector(gVector *V){ err; } void LinAlg_Solve(gMatrix *A, gVector *B, gSolver *Solver, gVector *X, int solverIndex){ err; } void LinAlg_SolveAgain(gMatrix *A, gVector *B, gSolver *Solver, gVector *X, int solverIndex){ err; } void LinAlg_SolveNL(gMatrix *A, gVector *B, gMatrix *J, gVector *R, gSolver *Solver, gVector *X, int solverIndex){ err; } #endif getdp-2.7.0-source/Legacy/BF_Region.cpp000644 001750 001750 00000021316 12473553042 021313 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "ProData.h" #include "BF.h" #include "Get_DofOfElement.h" #include "Pos_FemInterpolation.h" #include "Cal_Quantity.h" #include "MallocUtils.h" #include "Message.h" extern struct Problem Problem_S ; extern struct CurrentData Current ; /* ------------------------------------------------------------------------ */ /* B F _ S u b F u n c t i o n */ /* ------------------------------------------------------------------------ */ void BF_SubFunction(struct Element * Element, int NumExpression, int Dim, double s[]) { struct Value Value ; Get_ValueOfExpressionByIndex(NumExpression, NULL, 0., 0., 0., &Value) ; switch (Dim) { case 1 : *s *= Value.Val[0] ; break ; case 3 : s[0] *= Value.Val[0] ; s[1] *= Value.Val[0] ; s[2] *= Value.Val[0] ; break ; } } /* ------------------------------------------------------------------------ */ /* B F _ R e g i o n */ /* ------------------------------------------------------------------------ */ void BF_Region(struct Element * Element, int NumRegion, double u, double v, double w, double *s) { *s = 1. ; if (Element->NumSubFunction[0][NumRegion-1] >= 0) BF_SubFunction(Element, Element->NumSubFunction[0][NumRegion-1], 1, s) ; } void BF_dRegion(struct Element * Element, int NumRegion, double u, double v, double w, double *s) { *s = 1. ; if (Element->NumSubFunction[0][NumRegion-1] >= 0) BF_SubFunction(Element, Element->NumSubFunction[2][NumRegion-1], 1, s) ; else *s = 0. ; } /* ------------------------------------------------------------------------ */ /* B F _ R e g i o n X , Y , Z */ /* ------------------------------------------------------------------------ */ void BF_RegionX(struct Element * Element, int NumRegion, double u, double v, double w, double s[]) { s[1] = s[2] = 0. ; s[0] = 1. ; if (Element->NumSubFunction[0][NumRegion-1] >= 0) BF_SubFunction(Element, Element->NumSubFunction[0][NumRegion-1], 3, s) ; } void BF_RegionY(struct Element * Element, int NumRegion, double u, double v, double w, double s[]) { s[0] = s[2] = 0. ; s[1] = 1. ; if (Element->NumSubFunction[0][NumRegion-1] >= 0) BF_SubFunction(Element, Element->NumSubFunction[0][NumRegion-1], 3, s) ; } void BF_RegionZ(struct Element * Element, int NumRegion, double u, double v, double w, double s[]) { s[0] = s[1] = 0. ; s[2] = 1. ; if (Element->NumSubFunction[0][NumRegion-1] >= 0) BF_SubFunction(Element, Element->NumSubFunction[0][NumRegion-1], 3, s) ; } void BF_dRegionX(struct Element * Element, int NumRegion, double u, double v, double w, double s[]) { s[1] = s[2] = 0. ; s[0] = 1. ; /* Patrick (a finaliser) */ if (Element->NumSubFunction[0][NumRegion-1] >= 0) BF_SubFunction(Element, Element->NumSubFunction[2][NumRegion-1], 3, s) ; else s[0] = 0. ; } void BF_dRegionY(struct Element * Element, int NumRegion, double u, double v, double w, double s[]) { s[0] = s[2] = 0. ; s[1] = 1. ; /* Patrick (a finaliser) */ if (Element->NumSubFunction[0][NumRegion-1] >= 0) BF_SubFunction(Element, Element->NumSubFunction[2][NumRegion-1], 3, s) ; else s[1] = 0. ; } void BF_dRegionZ(struct Element * Element, int NumRegion, double u, double v, double w, double s[]) { /* Patrick (a finaliser) s[0] = s[1] = 0. ; s[2] = 1. ; */ s[0] = s[2] = 0. ; s[1] = -1. ; if (Element->NumSubFunction[0][NumRegion-1] >= 0) BF_SubFunction(Element, Element->NumSubFunction[2][NumRegion-1], 3, s) ; else s[1] = 0. ; } /* ------------------------------------------------------------------------ */ /* B F _ Z e r o */ /* ------------------------------------------------------------------------ */ void BF_Zero(struct Element * Element, int Num, double u, double v, double w, double *s) { s[0] = s[1] = s[2] = 0. ; } void BF_One(struct Element * Element, int Num, double u, double v, double w, double *s) { s[0] = 1. ; s[1] = s[2] = 0. ; } void BF_OneZ(struct Element * Element, int Num, double u, double v, double w, double *s) { s[0] = s[1] = 0. ; s[2] = 1. ; } /* ------------------------------------------------------------------------ */ /* B F _ I n i t G l o b a l */ /* ------------------------------------------------------------------------ */ void BF_InitGlobal(struct GlobalBasisFunction * GlobalBasisFunction_P) { struct QuantityStorage * QuantityStorage_P ; struct Formulation * Formulation_P ; QuantityStorage_P = GlobalBasisFunction_P->QuantityStorage = (struct QuantityStorage *)Malloc(sizeof(struct QuantityStorage)) ; QuantityStorage_P->NumLastElementForFunctionSpace = 0 ; Formulation_P = (struct Formulation*) List_Pointer(Problem_S.Formulation, GlobalBasisFunction_P->FormulationIndex) ; QuantityStorage_P->DefineQuantity = (struct DefineQuantity*) List_Pointer(Formulation_P->DefineQuantity, GlobalBasisFunction_P->DefineQuantityIndex) ; QuantityStorage_P->FunctionSpace = (struct FunctionSpace*) List_Pointer(Problem_S.FunctionSpace, QuantityStorage_P->DefineQuantity->FunctionSpaceIndex) ; QuantityStorage_P->TypeQuantity = QuantityStorage_P->FunctionSpace->Type ; } /* ------------------------------------------------------------------------ */ /* B F _ G l o b a l */ /* ------------------------------------------------------------------------ */ void BF_Global(struct Element * Element, int NumGlobal, double u, double v, double w, double *s) { struct Value Value ; struct GlobalBasisFunction * GlobalBasisFunction_P ; struct QuantityStorage * QuantityStorage_P ; int Save_NbrHar; GlobalBasisFunction_P = Element->GlobalBasisFunction[NumGlobal-1] ; if (!GlobalBasisFunction_P->QuantityStorage) BF_InitGlobal(GlobalBasisFunction_P) ; /* Init QuantityStorage */ QuantityStorage_P = GlobalBasisFunction_P->QuantityStorage ; if (QuantityStorage_P->NumLastElementForFunctionSpace != Element->Num) { QuantityStorage_P->NumLastElementForFunctionSpace = Element->Num ; Get_DofOfElement (Element, QuantityStorage_P->FunctionSpace, QuantityStorage_P, QuantityStorage_P->DefineQuantity->IndexInFunctionSpace) ; } Save_NbrHar = Current.NbrHar; Current.NbrHar = 1; /* for real basis function */ Pos_FemInterpolation (Element, NULL, GlobalBasisFunction_P->QuantityStorage, QUANTITY_SIMPLE, NOOP, -1, 0, u, v, w, 0., 0., 0., Value.Val, &Value.Type, 0) ; Current.NbrHar = Save_NbrHar; switch (Value.Type) { case SCALAR : s[0] = Value.Val[0] ; break ; case VECTOR : s[0] = Value.Val[0] ; s[1] = Value.Val[1] ; s[2] = Value.Val[2] ; break ; default : Message::Error("Bad type of value for Global BasisFunction") ; } } /* ------------------------------------------------------------------------ */ /* B F _ d G l o b a l */ /* ------------------------------------------------------------------------ */ void BF_dGlobal(struct Element * Element, int NumGlobal, double u, double v, double w, double *s ) { struct Value Value ; struct GlobalBasisFunction * GlobalBasisFunction_P ; struct QuantityStorage * QuantityStorage_P ; int Save_NbrHar; GlobalBasisFunction_P = Element->GlobalBasisFunction[NumGlobal-1] ; if (!GlobalBasisFunction_P->QuantityStorage) BF_InitGlobal(GlobalBasisFunction_P) ; /* Init QuantityStorage */ QuantityStorage_P = GlobalBasisFunction_P->QuantityStorage ; if (QuantityStorage_P->NumLastElementForFunctionSpace != Element->Num) { QuantityStorage_P->NumLastElementForFunctionSpace = Element->Num ; Get_DofOfElement (Element, QuantityStorage_P->FunctionSpace, QuantityStorage_P, QuantityStorage_P->DefineQuantity->IndexInFunctionSpace) ; } Save_NbrHar = Current.NbrHar; Current.NbrHar = 1; /* for real basis function */ Pos_FemInterpolation (Element, NULL, GlobalBasisFunction_P->QuantityStorage, QUANTITY_SIMPLE, EXTDER, -1, 0, u, v, w, 0., 0., 0., Value.Val, &Value.Type, 0) ; Current.NbrHar = Save_NbrHar; switch (Value.Type) { case SCALAR : s[0] = Value.Val[0] ; break ; case VECTOR : s[0] = Value.Val[0] ; s[1] = Value.Val[1] ; s[2] = Value.Val[2] ; break ; default : Message::Error("Bad type of value for Global BasisFunction") ; } } getdp-2.7.0-source/Legacy/Pos_Search.cpp000644 001750 001750 00000040641 12473553042 021551 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Jean-Francois Remacle // #include "ProData.h" #include "GeoData.h" #include "Get_Geometry.h" #include "Pos_Search.h" #include "Get_DofOfElement.h" #include "Message.h" #define SQU(a) ((a)*(a)) extern struct CurrentData Current ; static struct Geo_Element * LastGeoElement; /* ------------------------------------------------------------------------ */ /* C o m p u t e E l e m e n t B o x */ /* ------------------------------------------------------------------------ */ static void ComputeElementBox(struct Element * Element, struct ElementBox * ElementBox) { int i; ElementBox->Xmin = ElementBox->Xmax = Element->x[0]; ElementBox->Ymin = ElementBox->Ymax = Element->y[0]; ElementBox->Zmin = ElementBox->Zmax = Element->z[0]; for (i = 1 ; i < Element->GeoElement->NbrNodes ; i++) { ElementBox->Xmin = std::min(ElementBox->Xmin, Element->x[i]); ElementBox->Xmax = std::max(ElementBox->Xmax, Element->x[i]); ElementBox->Ymin = std::min(ElementBox->Ymin, Element->y[i]); ElementBox->Ymax = std::max(ElementBox->Ymax, Element->y[i]); ElementBox->Zmin = std::min(ElementBox->Zmin, Element->z[i]); ElementBox->Zmax = std::max(ElementBox->Zmax, Element->z[i]); } } /* ------------------------------------------------------------------------ */ /* P o i n t I n X X X */ /* ------------------------------------------------------------------------ */ static int PointInElementBox(struct ElementBox ElementBox, double x, double y, double z, double tol) { if (x > ElementBox.Xmax + tol || x < ElementBox.Xmin - tol || y > ElementBox.Ymax + tol || y < ElementBox.Ymin - tol || z > ElementBox.Zmax + tol || z < ElementBox.Zmin - tol){ return(0); } else{ return(1); } } static int PointInRefElement (struct Element * Element, double u, double v, double w) { double ONE = 1. + 1.e-12; double ZERO = 1.e-12; switch(Element->Type) { case LINE : case LINE_2 : if (u<-ONE || u>ONE){ return(0); } return(1); case TRIANGLE : case TRIANGLE_2 : if (u<-ZERO || v<-ZERO || u>(ONE-v)){ return(0); } return(1); case QUADRANGLE : case QUADRANGLE_2 : case QUADRANGLE_2_8N : if (u<-ONE || v<-ONE || u>ONE || v>ONE){ return (0); } return(1); case TETRAHEDRON : case TETRAHEDRON_2 : if (u<-ZERO || v<-ZERO || w<-ZERO || u>(ONE-v-w)){ return(0); } return(1); case HEXAHEDRON : case HEXAHEDRON_2 : if (u<-ONE || v<-ONE || w<-ONE || u>ONE || v>ONE || w>ONE){ return(0); } return(1); case PRISM : case PRISM_2 : if (w>ONE || w<-ONE || u<-ZERO || v<-ZERO || u>(ONE-v)){ return(0); } return(1); case PYRAMID : case PYRAMID_2 : if (u<(w-ONE) || u>(ONE-w) || v<(w-ONE) || v>(ONE-w) || w<-ZERO || w>ONE){ return(0); } return(1); default : return(0); } } static int PointInElement (struct Element * Element, List_T *ExcludeRegion_L, double x, double y, double z, double *u, double *v, double *w, double tol) { struct ElementBox ElementBox ; if(ExcludeRegion_L) if(List_Search(ExcludeRegion_L, &Element->GeoElement->Region, fcmp_int)){ return(0); } Element->Num = Element->GeoElement->Num ; Element->Type = Element->GeoElement->Type ; Element->Region = Element->GeoElement->Region ; Get_NodesCoordinatesOfElement(Element) ; ComputeElementBox(Element, &ElementBox); if (!PointInElementBox(ElementBox, x, y, z, tol)){ return(0); } xyz2uvwInAnElement(Element, x, y, z, u, v, w); if(!PointInRefElement(Element, *u, *v, *w)){ /* Message::Info("Point was in box, but not in actual element"); */ return(0); } return(1); } /* ------------------------------------------------------------------------ */ /* I n i t _ S e a r c h G r i d */ /* ------------------------------------------------------------------------ */ static void Init_SearchGrid(struct Grid * Grid) { struct Element Element; struct ElementBox ElementBox; struct Brick Brick, *Brick_P; double Xc, Yc, Zc ; int NbrGeoElements, iElm; int Ix1, Ix2, Iy1, Iy2, Iz1, Iz2; int i, j, k, index; LastGeoElement = NULL; if(Grid->Init){ return; } Grid->Xmin = Current.GeoData->Xmin; Grid->Xmax = Current.GeoData->Xmax; Grid->Ymin = Current.GeoData->Ymin; Grid->Ymax = Current.GeoData->Ymax; Grid->Zmin = Current.GeoData->Zmin; Grid->Zmax = Current.GeoData->Zmax; #define NBB 20 #define FACT 0.1 if(Grid->Xmin != Grid->Xmax && Grid->Ymin != Grid->Ymax && Grid->Zmin != Grid->Zmax){ Grid->Nx = Grid->Ny = Grid->Nz = NBB; Xc = Grid->Xmax-Grid->Xmin; Yc = Grid->Ymax-Grid->Ymin; Zc = Grid->Zmax-Grid->Zmin; Grid->Xmin -= FACT * Xc ; Grid->Ymin -= FACT * Yc ; Grid->Zmin -= FACT * Zc ; Grid->Xmax += FACT * Xc ; Grid->Ymax += FACT * Yc ; Grid->Zmax += FACT * Zc ; } else if(Grid->Xmin != Grid->Xmax && Grid->Ymin != Grid->Ymax){ Grid->Nx = Grid->Ny = NBB ; Grid->Nz = 1 ; Xc = Grid->Xmax-Grid->Xmin; Yc = Grid->Ymax-Grid->Ymin; Grid->Xmin -= FACT * Xc ; Grid->Ymin -= FACT * Xc ; Grid->Zmin -= 1. ; Grid->Xmax += FACT * Xc ; Grid->Ymax += FACT * Xc ; Grid->Zmax += 1. ; } else if(Grid->Xmin != Grid->Xmax && Grid->Zmin != Grid->Zmax){ Grid->Nx = Grid->Nz = NBB ; Grid->Ny = 1 ; Xc = Grid->Xmax-Grid->Xmin; Zc = Grid->Zmax-Grid->Zmin; Grid->Xmin -= FACT * Xc ; Grid->Ymin -= 1. ; Grid->Zmin -= FACT * Zc ; Grid->Xmax += FACT * Xc ; Grid->Ymax += 1. ; Grid->Zmax += FACT * Zc ; } else if(Grid->Ymin != Grid->Ymax && Grid->Zmin != Grid->Zmax){ Grid->Nx = 1 ; Grid->Ny = Grid->Nz = NBB ; Yc = Grid->Ymax-Grid->Ymin; Zc = Grid->Zmax-Grid->Zmin; Grid->Xmin -= 1. ; Grid->Ymin -= FACT * Yc ; Grid->Zmin -= FACT * Zc ; Grid->Xmax += 1. ; Grid->Ymax += FACT * Yc ; Grid->Zmax += FACT * Zc ; } else if(Grid->Xmin != Grid->Xmax){ Grid->Nx = NBB ; Grid->Ny = Grid->Nz = 1 ; Xc = Grid->Xmax-Grid->Xmin; Grid->Xmin -= FACT * Xc ; Grid->Ymin -= 1. ; Grid->Zmin -= 1. ; Grid->Xmax += FACT * Xc ; Grid->Ymax += 1. ; Grid->Zmax += 1. ; } else if(Grid->Ymin != Grid->Ymax){ Grid->Nx = Grid->Nz = 1 ; Grid->Ny = NBB ; Yc = Grid->Ymax-Grid->Ymin; Grid->Xmin -= 1. ; Grid->Ymin -= FACT * Yc ; Grid->Zmin -= 1. ; Grid->Xmax += 1. ; Grid->Ymax += FACT * Yc ; Grid->Zmax += 1. ; } else if(Grid->Zmin != Grid->Zmax){ Grid->Nx = Grid->Ny = 1 ; Grid->Nz = NBB ; Zc = Grid->Zmax-Grid->Zmin; Grid->Xmin -= 1. ; Grid->Ymin -= 1. ; Grid->Zmin -= FACT * Zc ; Grid->Xmax += 1. ; Grid->Ymax += 1. ; Grid->Zmax += FACT * Zc ; } else{ Grid->Nx = Grid->Ny = Grid->Nz = 1; Grid->Xmin -= 1. ; Grid->Ymin -= 1. ; Grid->Zmin -= 1. ; Grid->Xmax += 1. ; Grid->Ymax += 1. ; Grid->Zmax += 1. ; } Message::Info("Initializing rapid search grid..."); Grid->Bricks = List_Create(Grid->Nx * Grid->Ny * Grid->Nz, 10, sizeof(Brick)); for(i = 0; i < Grid->Nx * Grid->Ny * Grid->Nz ; i++){ for(j = 0 ; j < 3 ; j++) Brick.p[j] = List_Create(2, 2, sizeof(struct Geo_Element*)); List_Add(Grid->Bricks, &Brick); } NbrGeoElements = Geo_GetNbrGeoElements(); Get_InitDofOfElement(&Element) ; for (iElm=0 ; iElm < NbrGeoElements ; iElm++ ){ Element.GeoElement = Geo_GetGeoElement(iElm) ; Element.Num = Element.GeoElement->Num ; Element.Type = Element.GeoElement->Type ; Current.Region = Element.Region = Element.GeoElement->Region ; if (Element.Region && Element.Type != POINT) { Get_NodesCoordinatesOfElement(&Element) ; ComputeElementBox(&Element, &ElementBox); Ix1 = (int)((double)Grid->Nx*(ElementBox.Xmin-Grid->Xmin)/(Grid->Xmax-Grid->Xmin)); Ix2 = (int)((double)Grid->Nx*(ElementBox.Xmax-Grid->Xmin)/(Grid->Xmax-Grid->Xmin)); Iy1 = (int)((double)Grid->Ny*(ElementBox.Ymin-Grid->Ymin)/(Grid->Ymax-Grid->Ymin)); Iy2 = (int)((double)Grid->Ny*(ElementBox.Ymax-Grid->Ymin)/(Grid->Ymax-Grid->Ymin)); Iz1 = (int)((double)Grid->Nz*(ElementBox.Zmin-Grid->Zmin)/(Grid->Zmax-Grid->Zmin)); Iz2 = (int)((double)Grid->Nz*(ElementBox.Zmax-Grid->Zmin)/(Grid->Zmax-Grid->Zmin)); Ix1 = std::max(Ix1, 0); Ix2 = std::min(Ix2, Grid->Nx-1); Iy1 = std::max(Iy1, 0); Iy2 = std::min(Iy2, Grid->Ny-1); Iz1 = std::max(Iz1, 0); Iz2 = std::min(Iz2, Grid->Nz-1); for(i = Ix1 ; i <= Ix2 ; i++){ for(j = Iy1 ; j <= Iy2 ; j++){ for(k = Iz1 ; k <= Iz2 ; k++){ index = i + j * Grid->Nx + k * Grid->Nx * Grid->Ny; Brick_P = (struct Brick*)List_Pointer(Grid->Bricks, index); switch(Element.GeoElement->Type){ case LINE : case LINE_2 : List_Add(Brick_P->p[0], &Element.GeoElement); break; case TRIANGLE : case TRIANGLE_2 : case QUADRANGLE : case QUADRANGLE_2 : case QUADRANGLE_2_8N : List_Add(Brick_P->p[1], &Element.GeoElement); break; case TETRAHEDRON : case TETRAHEDRON_2 : case HEXAHEDRON : case HEXAHEDRON_2 : case PRISM : case PRISM_2 : case PYRAMID : case PYRAMID_2 : List_Add(Brick_P->p[2], &Element.GeoElement); break; } } } } } } Grid->Init = 1; #if 0 for (i=0 ; iBricks) ; i++) { Brick_P = (struct Brick *)List_Pointer(Grid->Bricks, i) ; printf("BRICK %d : ", i) ; for (j=0 ; jp[2]) ; j++) { Element.GeoElement = *(struct Geo_Element **)List_Pointer(Brick_P->p[2], j) ; printf("%d ", Element.GeoElement->Num) ; } printf("\n"); } #endif Message::Info("...done: %dx%dx%d", Grid->Nx, Grid->Ny, Grid->Nz); } void Free_SearchGrid(struct Grid * Grid) { if(!Grid->Init) return; for(int i = 0; i < List_Nbr(Grid->Bricks); i++){ Brick *Brick_P = (struct Brick *)List_Pointer(Grid->Bricks, i) ; for(int j = 0 ; j < 3 ; j++) List_Delete(Brick_P->p[j]); } List_Delete(Grid->Bricks); Grid->Init = 0; } /* ------------------------------------------------------------------------ */ /* I n W h i c h X X X */ /* ------------------------------------------------------------------------ */ static int InWhichBrick (struct Grid *pGrid, double X, double Y, double Z) { int Ix, Iy, Iz; if(X > pGrid->Xmax || X < pGrid->Xmin || Y > pGrid->Ymax || Y < pGrid->Ymin || Z > pGrid->Zmax || Z < pGrid->Zmin){ return(NO_BRICK); } Ix = (int)((double)pGrid->Nx * (X-pGrid->Xmin) / (pGrid->Xmax-pGrid->Xmin)); Iy = (int)((double)pGrid->Ny * (Y-pGrid->Ymin) / (pGrid->Ymax-pGrid->Ymin)); Iz = (int)((double)pGrid->Nz * (Z-pGrid->Zmin) / (pGrid->Zmax-pGrid->Zmin)); Ix = std::min(Ix,pGrid->Nx-1); Iy = std::min(Iy,pGrid->Ny-1); Iz = std::min(Iz,pGrid->Nz-1); if(Ix < 0) Ix = 0; if(Iy < 0) Iy = 0; if(Iz < 0) Iz = 0; return(Ix + Iy * pGrid->Nx + Iz * pGrid->Nx * pGrid->Ny) ; } void InWhichElement (struct Grid * Grid, List_T *ExcludeRegion_L, struct Element * Element, int Dim, double x, double y, double z, double *u, double *v, double *w) { /* Note: Il est garanti en sortie que les fcts de forme geometriques sont initialisees en u,v,w */ struct Brick * Brick_P ; int i, dim, lowdim = 0, highdim = 0; double tol; if(!Grid->Init) Init_SearchGrid(Grid); /* Allow for some extra matches by increasing the size of the bounding box, and even more if we search for elements of dimension smaller than the current dimension. This way we can for example also find 1D elements with points not exactly on them. */ if ((Dim == _1D && Current.GeoData->Dimension == _3D) || (Dim == _1D && Current.GeoData->Dimension == _2D) || (Dim == _2D && Current.GeoData->Dimension == _3D)) tol = Current.GeoData->CharacteristicLength * 1.e-4; /* instead of 5.e-3 */ else tol = Current.GeoData->CharacteristicLength * 1.e-8; if(LastGeoElement){ Element->GeoElement = LastGeoElement ; if (PointInElement(Element, ExcludeRegion_L, x, y, z, u, v, w, tol)){ return; } } if ((i = InWhichBrick(Grid, x, y, z)) == NO_BRICK) { Element->Num = NO_ELEMENT ; Element->Region = NO_REGION ; return; } if (!(Brick_P = (struct Brick *)List_Pointer(Grid->Bricks, i))){ Message::Error("Brick %d not found in Grid", i) ; Element->Num = NO_ELEMENT ; Element->Region = NO_REGION ; return; } switch(Dim){ case _1D : lowdim = 0 ; highdim = 0 ; break; case _2D : lowdim = 1 ; highdim = 1 ; break; case _3D : lowdim = 2 ; highdim = 2 ; break; case _ALL : default : lowdim = 0 ; highdim = 2 ; break; } for(dim = highdim ; dim >= lowdim ; dim--) { for (i=0 ; i < List_Nbr(Brick_P->p[dim]) ; i++) { Element->GeoElement = *(struct Geo_Element**)List_Pointer(Brick_P->p[dim], i) ; if (PointInElement(Element, ExcludeRegion_L, x, y, z, u, v, w, tol)) { /* Message::Info("xyz(%g,%g,%g) -> Selected Element %d uvw(%g,%g,%g) (%g,%g,%g)->(%g,%g,%g)", x, y, z, Element->Num, *u, *v, *w, Element->x[0], Element->y[0], Element->z[0], Element->x[1], Element->y[1], Element->z[1]); */ LastGeoElement = Element->GeoElement; return; } } } Element->Num = NO_ELEMENT ; Element->Region = NO_REGION ; } /* ------------------------------------------------------------------------ */ /* x y z 2 u v w I n A n E l e m e n t */ /* ------------------------------------------------------------------------ */ #define NR_PRECISION 1.e-6 /* a comparer a l'intervalle de variation de uvw */ #define NR_MAX_ITER 50 void xyz2uvwInAnElement (struct Element *Element, double x, double y, double z, double *u, double *v, double *w) { double x_est, y_est, z_est; double u_new, v_new, w_new; double Error = 1.0 ; int i, iter = 1 ; int ChainDim = _3D, Type_Dimension, Type_Jacobian ; double (*Get_Jacobian)(struct Element*, MATRIX3x3*) ; *u = *v = *w = 0.0; if(Element->Type & (TETRAHEDRON|HEXAHEDRON|PRISM|PYRAMID)) ChainDim = _3D; else if(Element->Type & (TRIANGLE|QUADRANGLE|TRIANGLE_2|QUADRANGLE_2)) ChainDim = _2D; else if(Element->Type & (LINE|LINE_2)) ChainDim = _1D; else if(Element->Type & POINT) ChainDim = _0D; else{ Message::Error("Unknown type of element in xyz2uvwInAnElement"); return; } if (ChainDim == _1D && Current.GeoData->Dimension == _3D) Type_Jacobian = JACOBIAN_LIN; else if((ChainDim == _1D && Current.GeoData->Dimension == _2D) || (ChainDim == _2D && Current.GeoData->Dimension == _3D)) Type_Jacobian = JACOBIAN_SUR; else Type_Jacobian = JACOBIAN_VOL; while (Error > NR_PRECISION && iter < NR_MAX_ITER){ iter++ ; Get_BFGeoElement(Element, *u, *v, *w) ; Get_Jacobian = (double (*)(struct Element*, MATRIX3x3*)) Get_JacobianFunction(Type_Jacobian, Element->Type, &Type_Dimension) ; Element->DetJac = Get_Jacobian(Element, &Element->Jac) ; if (Element->DetJac != 0) { Get_InverseMatrix(Type_Dimension, Element->Type, Element->DetJac, &Element->Jac, &Element->InvJac) ; x_est = y_est = z_est = 0. ; for (i = 0 ; i < Element->GeoElement->NbrNodes ; i++) { x_est += Element->x[i] * Element->n[i] ; y_est += Element->y[i] * Element->n[i] ; z_est += Element->z[i] * Element->n[i] ; } u_new = *u + Element->InvJac.c11 * (x-x_est) + Element->InvJac.c21 * (y-y_est) + Element->InvJac.c31 * (z-z_est) ; v_new = *v + Element->InvJac.c12 * (x-x_est) + Element->InvJac.c22 * (y-y_est) + Element->InvJac.c32 * (z-z_est) ; w_new = *w + Element->InvJac.c13 * (x-x_est) + Element->InvJac.c23 * (y-y_est) + Element->InvJac.c33 * (z-z_est) ; Error = SQU(u_new - *u) + SQU(v_new - *v) + SQU(w_new - *w); *u = u_new; *v = v_new; *w = w_new; } else{ Message::Warning("Zero determinant in 'xyz2uvwInAnElement'") ; break; } } if(iter == NR_MAX_ITER) Message::Warning("Maximum number of iterations exceeded in xyz2uvwInAnElement") ; #if 0 Message::Info("%d iterations in xyz2uvw", iter); #endif } getdp-2.7.0-source/Legacy/Gauss_Hexahedron.h000644 001750 001750 00000016305 12473553042 022417 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . /* 6 integration points (DHATT ET TOUZOT, page 299) */ #define a1 0.40824826 #define a2 0.81649658 #define b1 0.70710678 #define c1 0.57735027 #define w1 1.3333333333 static double xhex6[6] = { a1, a1, -a1, -a1, -a2, a2}; static double yhex6[6] = { b1, -b1, b1, -b1, 0., 0.}; static double zhex6[6] = {-c1, -c1, c1, c1, -c1, c1}; static double phex6[6] = { w1, w1, w1, w1, w1, w1}; #undef a1 #undef a2 #undef b1 #undef c1 #undef w1 #define b 0.795822426 #define c 0.758786911 #define wb 0.886426593 #define wc 0.335180055 static double xhex14[14] = { b, -b, 0, 0, 0, 0, c, c, c, c, -c, -c, -c, -c }; static double yhex14[14] = { 0, 0, b, -b, 0, 0, c, c, -c, -c, c, c, -c, -c }; static double zhex14[14] = { 0, 0, 0, 0, b, -b, c, -c, c, -c, c, -c, c, -c }; static double phex14[14] = { wb, wb, wb, wb, wb, wb, wc, wc, wc, wc, wc, wc, wc, wc }; #undef b #undef c #undef wb #undef wc /* 34 integration points (DHATT ET TOUZOT, page 299) */ static double xhex34[34] = {0.9317380000,-0.9317380000,0., 0.,0.,0., 0.9167441779,-0.9167441779,0.9167441779, -0.9167441779,0.,0., 0.,0.,0.9167441779, -0.9167441779,0.9167441779,-0.9167441779, 0.4086003800,0.4086003800, 0.4086003800,0.4086003800, -0.4086003800,-0.4086003800, -0.4086003800,-0.4086003800, 0.7398529500,0.7398529500, 0.7398529500,0.7398529500, -0.7398529500,-0.7398529500, -0.7398529500,-0.7398529500}; static double yhex34[34] = {0.,0.,0.9317380000, -0.9317380000,0.,0., 0.9167441779,0.9167441779,-0.9167441779, -0.9167441779,0.9167441779,-0.9167441779, 0.9167441779,-0.9167441779,0., 0.,0.,0., 0.4086003800,0.4086003800, -0.4086003800,-0.4086003800, 0.4086003800,0.4086003800, -0.4086003800,-0.4086003800, 0.7398529500,0.7398529500, -0.7398529500,-0.7398529500, 0.7398529500,0.7398529500, -0.7398529500,-0.7398529500}; static double zhex34[34] = {0.,0.,0., 0.,0.9317380000,-0.9317380000, 0.,0.,0., 0.,0.9167441779,0.9167441779, -0.9167441779,-0.9167441779,0.9167441779, 0.9167441779,-0.9167441779,-0.9167441779, 0.4086003800,-0.4086003800, 0.4086003800,-0.4086003800, 0.4086003800,-0.4086003800, 0.4086003800,-0.4086003800, 0.7398529500,-0.7398529500, 0.7398529500,-0.7398529500, 0.7398529500,-0.7398529500, 0.7398529500,-0.7398529500}; static double phex34[34] = {0.28465447168,0.28465447168, 0.28465447168,0.28465447168, 0.28465447168,0.28465447168, 0.09983142160,0.09983142160, 0.09983142160,0.09983142160, 0.09983142160,0.09983142160, 0.09983142160,0.09983142160, 0.09983142160,0.09983142160, 0.09983142160,0.09983142160, 0.42294183928,0.42294183928, 0.42294183928,0.42294183928, 0.42294183928,0.42294183928, 0.42294183928,0.42294183928, 0.21382017456,0.21382017456, 0.21382017456,0.21382017456, 0.21382017456,0.21382017456, 0.21382017456,0.21382017456}; /* 77 integration points (STROUD, page 238) */ static double xhex77[77] = {0., 0.5384693101,-0.5384693101,0.,0.,0.,0., 0.9061798459,-0.9061798459,0.,0.,0.,0., 0.5384693101,0.5384693101,-0.5384693101,-0.5384693101, 0.5384693101,0.5384693101,-0.5384693101,-0.5384693101, 0.,0.,0.,0., 0.9061798459,0.9061798459,-0.9061798459,-0.9061798459, 0.9061798459,0.9061798459,-0.9061798459,-0.9061798459, 0.,0.,0.,0., 0.5384693101,0.5384693101,-0.5384693101,-0.5384693101, 0.9061798459,0.9061798459,-0.9061798459,-0.9061798459, 0.5384693101,0.5384693101,-0.5384693101,-0.5384693101, 0.9061798459,0.9061798459,-0.9061798459,-0.9061798459, 0.,0.,0.,0., 0.,0.,0.,0., 0.5384693101, 0.5384693101, 0.5384693101, 0.5384693101, -0.5384693101,-0.5384693101,-0.5384693101,-0.5384693101, 0.9061798459, 0.9061798459, 0.9061798459, 0.9061798459, -0.9061798459,-0.9061798459,-0.9061798459,-0.9061798459}; static double yhex77[77] = {0., 0.,0.,0.5384693101,-0.5384693101,0.,0., 0.,0.,0.9061798459,-0.9061798459,0.,0., 0.5384693101,-0.5384693101,0.5384693101,-0.5384693101, 0.,0.,0.,0., 0.5384693101, 0.5384693101,-0.5384693101,-0.5384693101, 0.9061798459,-0.9061798459,0.9061798459,-0.9061798459, 0.,0.,0.,0., 0.9061798459,0.9061798459,-0.9061798459,-0.9061798459, 0.9061798459,-0.9061798459,0.9061798459,-0.9061798459, 0.5384693101,-0.5384693101,0.5384693101,-0.5384693101, 0.,0.,0.,0., 0.,0.,0.,0., 0.5384693101,0.5384693101,-0.5384693101,-0.5384693101, 0.9061798459,0.9061798459,-0.9061798459,-0.9061798459, 0.5384693101,0.5384693101,-0.5384693101,-0.5384693101, 0.5384693101,0.5384693101,-0.5384693101,-0.5384693101, 0.9061798459,0.9061798459,-0.9061798459,-0.9061798459, 0.9061798459,0.9061798459,-0.9061798459,-0.9061798459}; static double zhex77[77] = {0., 0.,0.,0.,0.,0.5384693101,-0.5384693101, 0.,0.,0.,0.,0.9061798459,-0.9061798459, 0.,0.,0.,0., 0.5384693101,-0.5384693101,0.5384693101,-0.5384693101, 0.5384693101,-0.5384693101,0.5384693101,-0.5384693101, 0.,0.,0.,0., 0.9061798459,-0.9061798459,0.9061798459,-0.9061798459, 0.9061798459,-0.9061798459,0.9061798459,-0.9061798459, 0.,0.,0.,0., 0.,0.,0.,0., 0.9061798459,-0.9061798459,0.9061798459,-0.9061798459, 0.5384693101,-0.5384693101,0.5384693101,-0.5384693101, 0.9061798459,-0.9061798459,0.9061798459,-0.9061798459, 0.5384693101,-0.5384693101,0.5384693101,-0.5384693101, 0.5384693101,-0.5384693101,0.5384693101,-0.5384693101, 0.5384693101,-0.5384693101,0.5384693101,-0.5384693101, 0.9061798459,-0.9061798459,0.9061798459,-0.9061798459, 0.9061798459,-0.9061798459,0.9061798459,-0.9061798459}; static double phex77[77] = {-2.2577865569E+00, 1.704933503,1.704933503,1.704933503,1.704933503, 1.704933503,1.704933503, -0.2524056575,-0.2524056575,-0.2524056575,-0.2524056575, -0.2524056575,-0.2524056575, -0.8069802194,-0.8069802194,-0.8069802194,-0.8069802194, -0.8069802194,-0.8069802194,-0.8069802194,-0.8069802194, -0.8069802194,-0.8069802194,-0.8069802194,-0.8069802194, 3.4187901E-02,3.4187901E-02,3.4187901E-02,3.4187901E-02, 3.4187901E-02,3.4187901E-02,3.4187901E-02,3.4187901E-02, 3.4187901E-02,3.4187901E-02,3.4187901E-02,3.4187901E-02, 0.2268,0.2268,0.2268,0.2268,0.2268,0.2268,0.2268,0.2268, 0.2268,0.2268,0.2268,0.2268,0.2268,0.2268,0.2268,0.2268, 0.2268,0.2268,0.2268,0.2268,0.2268,0.2268,0.2268,0.2268, 0.6325755140,0.6325755140,0.6325755140,0.6325755140, 0.6325755140,0.6325755140,0.6325755140,0.6325755140, 3.9040398E-02,3.9040398E-02,3.9040398E-02,3.9040398E-02, 3.9040398E-02,3.9040398E-02,3.9040398E-02,3.9040398E-02}; getdp-2.7.0-source/Legacy/Cal_PostQuantity.cpp000644 001750 001750 00000042541 12473553042 022767 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "ProData.h" #include "ProDefine.h" #include "GeoData.h" #include "Get_DofOfElement.h" #include "Cal_Quantity.h" #include "Cal_Value.h" #include "Get_Geometry.h" #include "Get_FunctionValue.h" #include "ExtendedGroup.h" #include "Pos_Formulation.h" #include "MallocUtils.h" #include "Message.h" extern struct Problem Problem_S ; extern struct CurrentData Current ; /* ------------------------------------------------------------------------ */ /* P o s _ L o c a l O r I n t e g r a l Q u a n t i t y */ /* ------------------------------------------------------------------------ */ static int Warning_NoJacobian = 0 ; void Pos_LocalOrIntegralQuantity(struct PostQuantity *PostQuantity_P, struct DefineQuantity *DefineQuantity_P0, struct QuantityStorage *QuantityStorage_P0, struct PostQuantityTerm *PostQuantityTerm_P, struct Element *Element, int Type_Quantity, double u, double v, double w, struct Value *Value) { struct FunctionSpace *FunctionSpace_P ; struct DefineQuantity *DefineQuantity_P ; struct QuantityStorage *QuantityStorage_P ; struct Value TermValue, tmpValue; struct JacobianCase *JacobianCase_P0 ; struct IntegrationCase *IntegrationCase_P ; struct Quadrature *Quadrature_P ; List_T *IntegrationCase_L, *JacobianCase_L ; double ui, vi, wi, weight, Factor ; int Index_DefineQuantity ; int i, j, Type_Dimension ; int CriterionIndex, Nbr_IntPoints, i_IntPoint ; double (*Get_Jacobian) (struct Element * Element, MATRIX3x3 * Jac) = 0; void (*Get_IntPoint) (int Nbr_Points, int Num, double * u, double * v, double * w, double * wght) ; /* Get the functionspaces Get the DoF for local quantities */ for (i = 0 ; i < PostQuantityTerm_P->NbrQuantityIndex ; i++) { Index_DefineQuantity = PostQuantityTerm_P->QuantityIndexTable[i] ; DefineQuantity_P = DefineQuantity_P0 + Index_DefineQuantity ; QuantityStorage_P = QuantityStorage_P0 + Index_DefineQuantity ; if (QuantityStorage_P->NumLastElementForFunctionSpace != Element->Num) { QuantityStorage_P->NumLastElementForFunctionSpace = Element->Num ; if (Type_Quantity != INTEGRALQUANTITY){ QuantityStorage_P->FunctionSpace = FunctionSpace_P = (struct FunctionSpace*) List_Pointer(Problem_S.FunctionSpace, DefineQuantity_P->FunctionSpaceIndex) ; if (DefineQuantity_P->Type == LOCALQUANTITY) Get_DofOfElement(Element, FunctionSpace_P, QuantityStorage_P, DefineQuantity_P->IndexInFunctionSpace) ; } else{ /* INTEGRALQUANTITY */ if(DefineQuantity_P->IntegralQuantity.DefineQuantityIndexDof >= 0) QuantityStorage_P->FunctionSpace = (struct FunctionSpace*) List_Pointer(Problem_S.FunctionSpace, DefineQuantity_P->FunctionSpaceIndex) ; /* Get the function space for the associated local quantities */ for (j = 0 ; j < DefineQuantity_P->IntegralQuantity.NbrQuantityIndex ; j++) { Index_DefineQuantity = DefineQuantity_P->IntegralQuantity.QuantityIndexTable[j]; DefineQuantity_P = DefineQuantity_P0 + Index_DefineQuantity ; QuantityStorage_P = QuantityStorage_P0 + Index_DefineQuantity ; QuantityStorage_P->FunctionSpace = (struct FunctionSpace*) List_Pointer(Problem_S.FunctionSpace, DefineQuantity_P->FunctionSpaceIndex) ; } } } } /* get the jacobian */ if (Element->Num != NO_ELEMENT) { if (PostQuantityTerm_P->JacobianMethodIndex >= 0) { JacobianCase_L = ((struct JacobianMethod *) List_Pointer(Problem_S.JacobianMethod, PostQuantityTerm_P->JacobianMethodIndex)) ->JacobianCase ; JacobianCase_P0 = (struct JacobianCase*)List_Pointer(JacobianCase_L, 0); i = 0 ; while ((i < List_Nbr(JacobianCase_L)) && ((j = (JacobianCase_P0 + i)->RegionIndex) >= 0) && !List_Search (((struct Group *)List_Pointer(Problem_S.Group, j)) ->InitialList, &Element->Region, fcmp_int) ) i++ ; if (i == List_Nbr(JacobianCase_L)){ Message::Error("Undefined Jacobian in Region %d", Element->Region) ; return; } Element->JacobianCase = JacobianCase_P0 + i ; Get_Jacobian = (double (*)(struct Element*, MATRIX3x3*)) Get_JacobianFunction(Element->JacobianCase->TypeJacobian, Element->Type, &Type_Dimension) ; } else { if(!Warning_NoJacobian){ Message::Warning("No Jacobian method specification in PostProcessing quantity: " "using default Jacobian (Vol)"); Warning_NoJacobian = 1 ; } Get_Jacobian = (double (*)(struct Element*, MATRIX3x3*)) Get_JacobianFunction(JACOBIAN_VOL, Element->Type, &Type_Dimension) ; } Get_NodesCoordinatesOfElement(Element) ; } /* local evaluation at one point */ if(PostQuantityTerm_P->EvaluationType == LOCAL){ if (Element->Num != NO_ELEMENT) { Get_BFGeoElement(Element, u, v, w) ; Element->DetJac = Get_Jacobian(Element, &Element->Jac) ; if (Element->DetJac != 0.) Get_InverseMatrix(Type_Dimension, Element->Type, Element->DetJac, &Element->Jac, &Element->InvJac) ; } Cal_WholeQuantity (Current.Element = Element, QuantityStorage_P0, PostQuantityTerm_P->WholeQuantity, Current.u = u, Current.v = v, Current.w = w, -1, -1, &TermValue) ; } /* integral evaluation over the element */ else if(PostQuantityTerm_P->EvaluationType == INTEGRAL){ if(Element->Num == NO_ELEMENT){ Message::Error("No element in which to integrate"); return; } if(PostQuantityTerm_P->IntegrationMethodIndex < 0){ Message::Error("Missing Integration method in PostProcesssing Quantity '%s'", PostQuantity_P->Name); return; } IntegrationCase_L = ((struct IntegrationMethod *) List_Pointer(Problem_S.IntegrationMethod, PostQuantityTerm_P->IntegrationMethodIndex))->IntegrationCase ; CriterionIndex = ((struct IntegrationMethod *) List_Pointer(Problem_S.IntegrationMethod, PostQuantityTerm_P->IntegrationMethodIndex)) ->CriterionIndex ; IntegrationCase_P = Get_IntegrationCase(Element, IntegrationCase_L, CriterionIndex) ; if(IntegrationCase_P->Type != GAUSS){ Message::Error("Only numerical integration is available " "in Integral PostQuantities"); return; } Quadrature_P = (struct Quadrature*) List_PQuery(IntegrationCase_P->Case, &Element->Type, fcmp_int); if(!Quadrature_P){ Message::Error("Unknown type of Element (%s) for Integration method (%s) " " in PostProcessing Quantity (%s)", Get_StringForDefine(Element_Type, Element->Type), ((struct IntegrationMethod *) List_Pointer(Problem_S.IntegrationMethod, PostQuantityTerm_P->IntegrationMethodIndex))->Name, PostQuantity_P->Name); return; } Cal_ZeroValue(&TermValue); Nbr_IntPoints = Quadrature_P->NumberOfPoints ; Get_IntPoint = (void (*) (int,int,double*,double*,double*,double*)) Quadrature_P->Function ; for (i_IntPoint = 0 ; i_IntPoint < Nbr_IntPoints ; i_IntPoint++) { Current.QuadraturePointIndex = i_IntPoint; Get_IntPoint(Nbr_IntPoints, i_IntPoint, &ui, &vi, &wi, &weight) ; Get_BFGeoElement (Element, ui, vi, wi) ; Element->DetJac = Get_Jacobian(Element, &Element->Jac) ; if (Element->DetJac != 0.){ Get_InverseMatrix(Type_Dimension, Element->Type, Element->DetJac, &Element->Jac, &Element->InvJac) ; } else{ Message::Warning("Zero determinant in 'Cal_PostQuantity'"); } Current.x = Current.y = Current.z = 0. ; if (Type_Quantity == INTEGRALQUANTITY){ for (i = 0 ; i < Element->GeoElement->NbrNodes ; i++) { Current.x += Element->x[i] * Element->n[i] ; Current.y += Element->y[i] * Element->n[i] ; Current.z += Element->z[i] * Element->n[i] ; } } Cal_WholeQuantity (Current.Element = Element, QuantityStorage_P0, PostQuantityTerm_P->WholeQuantity, Current.u = ui, Current.v = vi, Current.w = wi, -1, -1, &tmpValue) ; Factor = weight * fabs(Element->DetJac) ; TermValue.Type = tmpValue.Type ; Cal_AddMultValue(&TermValue,&tmpValue,Factor,&TermValue); } } Value->Type = TermValue.Type; Cal_AddValue(Value,&TermValue,Value); } /* ------------------------------------------------------------------------ */ /* P o s _ G l o b a l Q u a n t i t y */ /* ------------------------------------------------------------------------ */ void Pos_GlobalQuantity(struct PostQuantity *PostQuantity_P, struct DefineQuantity *DefineQuantity_P0, struct QuantityStorage *QuantityStorage_P0, struct PostQuantityTerm *PostQuantityTerm_P, struct Element *ElementEmpty, List_T *InRegion_L, List_T *Support_L, struct Value *Value, int Type_InRegion) { struct DefineQuantity *DefineQuantity_P ; struct QuantityStorage *QuantityStorage_P ; struct FunctionSpace *FunctionSpace_P ; struct GlobalQuantity *GlobalQuantity_P ; struct Value TermValue ; int k, Index_DefineQuantity ; int Nbr_Element, i_Element ; struct Element Element ; int Type_Quantity ; if (PostQuantityTerm_P->EvaluationType == LOCAL && List_Search(InRegion_L, &Current.Region, fcmp_int)) { for (k = 0 ; k < PostQuantityTerm_P->NbrQuantityIndex ; k++) { Index_DefineQuantity = PostQuantityTerm_P->QuantityIndexTable[k] ; DefineQuantity_P = DefineQuantity_P0 + Index_DefineQuantity ; QuantityStorage_P = QuantityStorage_P0 + Index_DefineQuantity ; if (QuantityStorage_P->NumLastElementForFunctionSpace != Current.Region) { QuantityStorage_P->NumLastElementForFunctionSpace = Current.Region ; QuantityStorage_P->FunctionSpace = FunctionSpace_P = (struct FunctionSpace*) List_Pointer(Problem_S.FunctionSpace, DefineQuantity_P->FunctionSpaceIndex) ; GlobalQuantity_P = (struct GlobalQuantity*) List_Pointer (QuantityStorage_P->FunctionSpace->GlobalQuantity, *(int *)List_Pointer(DefineQuantity_P->IndexInFunctionSpace, 0)) ; if (DefineQuantity_P->Type == GLOBALQUANTITY) Get_DofOfRegion(Current.Region, GlobalQuantity_P, FunctionSpace_P, QuantityStorage_P) ; } } Cal_WholeQuantity (Current.Element = ElementEmpty, QuantityStorage_P0, PostQuantityTerm_P->WholeQuantity, Current.u = 0., Current.v = 0., Current.w = 0., -1, -1, &TermValue) ; Value->Type = TermValue.Type; Cal_AddValue(Value,&TermValue,Value); } /* if LOCAL && ... */ else if (PostQuantityTerm_P->EvaluationType == INTEGRAL) { Nbr_Element = Geo_GetNbrGeoElements() ; Get_InitDofOfElement(&Element) ; Type_Quantity = LOCALQUANTITY ; /* Attention... il faut se comprendre: */ /* il s'agit de grandeurs locales qui seront integrees */ for (i_Element = 0 ; i_Element < Nbr_Element; i_Element++) { Element.GeoElement = Geo_GetGeoElement(i_Element) ; Element.Num = Element.GeoElement->Num ; Element.Type = Element.GeoElement->Type ; Current.Region = Element.Region = Element.GeoElement->Region ; /* Filter: only elements in both InRegion_L and Support_L are considered */ if ((!InRegion_L || (List_Search(InRegion_L, (Type_InRegion==ELEMENTSOF ? &Element.Num : &Element.Region), fcmp_int))) && (!Support_L || List_Search(Support_L, &Element.Region, fcmp_int))) { Get_NodesCoordinatesOfElement(&Element) ; Current.x = Element.x[0]; Current.y = Element.y[0]; Current.z = Element.z[0]; Pos_LocalOrIntegralQuantity(PostQuantity_P, DefineQuantity_P0, QuantityStorage_P0, PostQuantityTerm_P, &Element, Type_Quantity, 0., 0., 0., Value) ; } } /* for i_Element ... */ } /* if INTEGRAL ... */ } /* ------------------------------------------------------------------------ */ /* C a l _ P o s t Q u a n t i t y */ /* ------------------------------------------------------------------------ */ void Cal_PostQuantity(struct PostQuantity *PostQuantity_P, struct DefineQuantity *DefineQuantity_P0, struct QuantityStorage *QuantityStorage_P0, List_T *Support_L, struct Element *Element, double u, double v, double w, struct Value *Value) { struct PostQuantityTerm PostQuantityTerm ; List_T *InRegion_L ; int i_PQT, Type_Quantity, Type_InRegion ; struct Group * Group_P ;/* For generating extended group */ /* mettre tout a zero: on ne connait pas a priori le type de retour */ /* (default type and value returned if Type_Quantity == -1) */ Cal_ZeroValue(Value); Value->Type = SCALAR; /* Loop on PostQuantity Terms */ /* ... with sum of results if common supports (In ...) */ for (i_PQT = 0 ; i_PQT < List_Nbr(PostQuantity_P->PostQuantityTerm) ; i_PQT++) { List_Read(PostQuantity_P->PostQuantityTerm, i_PQT, &PostQuantityTerm) ; /* InRegion_L = (PostQuantityTerm.InIndex < 0)? NULL : ((struct Group *)List_Pointer(Problem_S.Group, PostQuantityTerm.InIndex))->InitialList ; */ Group_P = (PostQuantityTerm.InIndex < 0)? NULL : (struct Group *)List_Pointer(Problem_S.Group, PostQuantityTerm.InIndex); InRegion_L = Group_P ? Group_P->InitialList : NULL ; Type_InRegion = Group_P ? Group_P->FunctionType : REGION; /* Generating Extended Group if necessary */ if (Group_P && Group_P->FunctionType == ELEMENTSOF){ if (!Group_P->ExtendedList) Generate_ExtendedGroup(Group_P) ; InRegion_L = Group_P->ExtendedList ; } if (!Support_L) Type_Quantity = PostQuantityTerm.Type ; else Type_Quantity = GLOBALQUANTITY ; /* Always if Support */ if (InRegion_L) { if (Element->Num != NO_ELEMENT) { /* not correct for ElementsOf (i.e. ELEMENTLIST) if (!List_Search(InRegion_L, &Element->Region, fcmp_int)) { Type_Quantity = -1 ; } */ if (!((Group_P->Type != ELEMENTLIST && List_Search(Group_P->InitialList, &Element->Region, fcmp_int)) || (Group_P->Type == ELEMENTLIST && Check_IsEntityInExtendedGroup(Group_P, Element->Num, 0)) )) { Type_Quantity = -1 ; } } else { if (Type_Quantity == GLOBALQUANTITY) { /* Plus de test ici... vu que le OnRegion de la PostOperation n'a rien a voir avec le support d'une integration ... if (!List_Search(InRegion_L, &Current.Region, fcmp_int)) { Type_Quantity = -1 ; } */ /* Il faut plutot voir si il existe au moins une region de InRegion_L qui soit dans Support_L ... cela est fait apres, pour chaque element */ } else if (Type_Quantity != INTEGRALQUANTITY) { Type_Quantity = -1 ; } } } /* else if !InRegion_L -> No filter, i.e. globally defined quantity */ /* ---------------------------- */ /* Local or Integral quantities */ /* ---------------------------- */ if (Type_Quantity == LOCALQUANTITY || Type_Quantity == INTEGRALQUANTITY) { Pos_LocalOrIntegralQuantity(PostQuantity_P, DefineQuantity_P0, QuantityStorage_P0, &PostQuantityTerm, Element, Type_Quantity, u, v, w, Value) ; } /* ----------------- */ /* Global quantities */ /* ----------------- */ else if (Type_Quantity == GLOBALQUANTITY) { Pos_GlobalQuantity(PostQuantity_P, DefineQuantity_P0, QuantityStorage_P0, &PostQuantityTerm, Element, InRegion_L, Support_L, Value, Type_InRegion) ; } } /* for i_PQT ... */ } /* ------------------------------------------------------------------------ */ /* C a l _ P o s t C u m u l a t i v e Q u a n t i t y */ /* ------------------------------------------------------------------------ */ void Cal_PostCumulativeQuantity(List_T *Region_L, int SupportIndex, List_T *TimeStep_L, struct PostQuantity *PostQuantity_P, struct DefineQuantity *DefineQuantity_P0, struct QuantityStorage *QuantityStorage_P0, struct Value **Values) { struct Element Element ; List_T *Support_L ; int i, NbrTimeStep ; Support_L = ((struct Group *) List_Pointer(Problem_S.Group, SupportIndex))->InitialList ; NbrTimeStep = List_Nbr(TimeStep_L) ; *Values = (struct Value *)Malloc(NbrTimeStep*sizeof(struct Value)) ; Element.Num = NO_ELEMENT ; for(i = 0 ; i < NbrTimeStep ; i++) { Pos_InitAllSolutions(TimeStep_L, i) ; Cal_PostQuantity(PostQuantity_P, DefineQuantity_P0, QuantityStorage_P0, Support_L, &Element, 0, 0, 0, &(*Values)[i]) ; } } /* ------------------------------------------------------------------------ */ /* C o m b i n e _ P o s t Q u a n t i t y */ /* ------------------------------------------------------------------------ */ void Combine_PostQuantity(int Type, int Order, struct Value *V1, struct Value *V2) { switch(Type){ case MULTIPLICATION : Cal_ProductValue(V1, V2, V1) ; break ; case ADDITION : Cal_AddValue(V1, V2, V1) ; break ; case DIVISION : Cal_DivideValue(Order?V1:V2, Order?V2:V1, V1) ; break; case SOUSTRACTION : Cal_SubstractValue(Order?V1:V2, Order?V2:V1, V1) ; break; } } getdp-2.7.0-source/Legacy/Cal_Value.h000644 001750 001750 00000006745 12473553042 021032 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _CAL_VALUE_H_ #define _CAL_VALUE_H_ #include #include "ProData.h" void Cal_CopyValue (struct Value *V1, struct Value *R); void Cal_CopyValueArray (struct Value *V1, struct Value *R, int Nbr_Values); void Cal_ZeroValue (struct Value *V1); void Cal_AddValue (struct Value *V1, struct Value *V2, struct Value *R) ; void Cal_AddValueArray (struct Value *V1, struct Value *V2, struct Value *R, int Nbr_Values); void Cal_SubstractValue (struct Value *V1, struct Value *V2, struct Value *R) ; void Cal_ProductValue (struct Value *V1, struct Value *V2, struct Value *R) ; void Cal_SqrtValue (struct Value *V1, struct Value *R) ; void Cal_DivideValue (struct Value *V1, struct Value *V2, struct Value *R) ; void Cal_ModuloValue (struct Value *V1, struct Value *V2, struct Value *R) ; void Cal_CrossProductValue (struct Value *V1, struct Value *V2, struct Value *R) ; void Cal_PowerValue (struct Value *V1, struct Value *V2, struct Value *R) ; void Cal_RotateValue (struct Value *V1, struct Value *V2, struct Value *R); void Cal_InvertValue (struct Value *V1, struct Value *R); void Cal_DetValue (struct Value *V1, struct Value *R); void Cal_TransposeValue (struct Value *V1, struct Value *R); void Cal_TraceValue (struct Value *V1, struct Value *R); void Cal_LessValue (struct Value *V1, struct Value *V2, struct Value *R) ; void Cal_GreaterValue (struct Value *V1, struct Value *V2, struct Value *R) ; void Cal_LessOrEqualValue (struct Value *V1, struct Value *V2, struct Value *R) ; void Cal_GreaterOrEqualValue (struct Value *V1, struct Value *V2, struct Value *R) ; void Cal_EqualValue (struct Value *V1, struct Value *V2, struct Value *R) ; void Cal_NotEqualValue (struct Value *V1, struct Value *V2, struct Value *R) ; void Cal_ApproxEqualValue (struct Value *V1, struct Value *V2, struct Value *R) ; void Cal_AndValue (struct Value *V1, struct Value *V2, struct Value *R) ; void Cal_OrValue (struct Value *V1, struct Value *V2, struct Value *R) ; void Cal_NegValue (struct Value *V1) ; void Cal_NotValue (struct Value *V1) ; void Cal_SetHarmonicValue (struct Value *R) ; void Cal_SetZeroHarmonicValue(struct Value *R, int Save_NbrHar) ; void Cal_MultValue (struct Value * V1, double d, struct Value * R) ; void Cal_AddMultValue (struct Value *V1, struct Value *V2, double d, struct Value *R) ; void Cal_AddMultValueArray (struct Value *V1, struct Value *V2, double d, struct Value *R,int Nbr_Values) ; void Cal_AddMultValue2 (struct Value *V1, double d1, struct Value *V2, double d2) ; void Cal_ComplexProduct (double V1[], double V2[], double P[]); void Cal_ComplexDivision (double V1[], double V2[], double P[]); void Cal_ComplexInvert (double V1[], double P[]); /* Debug */ std::string Print_Value_ToString(struct Value *A); void Print_Value (struct Value *A, FILE *fp=0); void Show_Value (struct Value *A); /* From struct Value to array of doubles */ void Cal_ValueArray2DoubleArray(struct Value *V1, double *R, int Nbr_Values) ; void Cal_AddValueArray2DoubleArray(struct Value *V1, double *R, int Nbr_Values) ; #endif getdp-2.7.0-source/Legacy/ExtendedGroup.h000644 001750 001750 00000001720 12473553042 021740 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _EXTENDED_GROUP_H_ #define _EXTENDED_GROUP_H_ #include "ProData.h" #include "ListUtils.h" int Check_IsEntityInExtendedGroup(struct Group * Group_P, int Entity, int Flag) ; void Generate_ExtendedGroup(struct Group * Group_P) ; void Generate_ElementaryEntities(List_T * InitialList, List_T ** ExtendedList, int Type_Entity) ; void Generate_GroupsOfNodes(List_T * InitialList, List_T ** ExtendedList) ; void Generate_GroupsOfEdges(List_T * InitialList, int Type_SuppList, List_T * InitialSuppList, List_T ** ExtendedList) ; void Generate_GroupsOfFacets(List_T * InitialList, List_T ** ExtendedList) ; void Generate_Elements(List_T * InitialList, int Type_SuppList, List_T * InitialSuppList, List_T ** ExtendedList) ; #endif getdp-2.7.0-source/Legacy/LinAlg_SPARSKIT.cpp000644 001750 001750 00000033050 12552147335 022207 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Ruth Sabariego // #include #include #include "GetDPConfig.h" #include "LinAlg.h" #include "ProData.h" #include "DofData.h" #include "MallocUtils.h" #include "Message.h" extern struct CurrentData Current ; extern char *Name_Path; #if defined(HAVE_SPARSKIT) static const char *Name_SolverFile = NULL, *Name_DefaultSolverFile = "solver.par" ; static char *SolverOptions[100]; void LinAlg_InitializeSolver(int* sargc, char*** sargv) { int i=1, argc, iopt=0; char **argv; argc = *sargc ; argv = *sargv ; SolverOptions[0] = NULL; while (i < argc) { if (argv[i][0] == '-') { if (!strcmp(argv[i]+1, "solver") || !strcmp(argv[i]+1, "s")) { i++ ; if (i absolute if it starts with '/' or '\' strcpy(FileName, SolverDataFileName); } else{ // -> relative otherwise strcat(FileName, SolverDataFileName); } } else if (Name_SolverFile){ // name on command line -> always absolute strcpy(FileName, Name_SolverFile); } else{ // default file name -> always relative strcat(FileName, Name_DefaultSolverFile); } Message::Info("Loading parameter file '%s'", FileName); init_solver(&Solver->Params, FileName) ; i = 0; while(SolverOptions[i] && SolverOptions[i+1]){ init_solver_option(&Solver->Params, SolverOptions[i], SolverOptions[i+1]) ; i+=2; } } void LinAlg_SetGlobalSolverOptions(const std::string &opt) { } void LinAlg_CreateVector(gVector *V, gSolver *Solver, int n) { init_vector(n, &V->V) ; V->N = n ; } void LinAlg_CreateMatrix(gMatrix *M, gSolver *Solver, int n, int m) { init_matrix(n, &M->M, &Solver->Params) ; } void LinAlg_DestroySolver(gSolver *Solver) { Message::Debug("'LinAlg_DestroySolver' not yet implemented"); } void LinAlg_DestroyVector(gVector *V) { Free(V->V); } void LinAlg_DestroyMatrix(gMatrix *M) { free_matrix(&M->M) ; } void LinAlg_CopyScalar(gScalar *S1, gScalar *S2) { S2->s = S1->s ; } void LinAlg_CopyVector(gVector *V1, gVector *V2) { memcpy(V2->V, V1->V, V1->N*sizeof(double)) ; } void LinAlg_SwapVector(gVector *V1, gVector *V2) { if(V1->N != V2->N){ Message::Error("Cannot swap vectors of different size"); return; } for(int i = 0; i < V1->N; i++){ double tmp = V1->V[i]; V1->V[i] = V2->V[i]; V2->V[i] = tmp; } } void LinAlg_CopyMatrix(gMatrix *M1, gMatrix *M2) { Message::Error("'LinAlg_CopyMatrix' not yet implemented"); } void LinAlg_ZeroScalar(gScalar *S) { S->s = 0. ; } void LinAlg_ZeroVector(gVector *V) { zero_vector(V->N, V->V) ; } void LinAlg_ZeroMatrix(gMatrix *M) { int i ; zero_matrix(&M->M) ; // la routine de produit matrice vecteur est buggee s'il existe des // lignes sans aucun element dans la matrice... for(i=0 ; iM.N ; i++) add_matrix_double(&M->M, i+1, i+1, 0.0) ; } void LinAlg_ScanScalar(FILE *file, gScalar *S) { fscanf(file, "%lf", &S->s) ; } void LinAlg_ScanVector(FILE *file, gVector *V) { int i ; for(i=0 ; iN ; i++) fscanf(file, "%lf", &V->V[i]) ; } void LinAlg_ScanMatrix(FILE *file, gMatrix *M) { Message::Error("'LinAlg_ScanMatrix' not yet implemented"); } void LinAlg_ReadScalar(FILE *file, gScalar *S) { Message::Error("'LinAlg_ReadScalar' not yet implemented"); } void LinAlg_ReadVector(FILE *file, gVector *V) { fread(V->V, sizeof(double), V->N, file); } void LinAlg_ReadMatrix(FILE *file, gMatrix *M) { Message::Error("'LinAlg_ReadMatrix' not yet implemented"); } void LinAlg_PrintScalar(FILE *file, gScalar *S) { fprintf(file, "%.16g", S->s) ; } void LinAlg_PrintVector(FILE *file, gVector *V, bool matlab, const char* fileName, const char* varName) { if(matlab) Message::Error("Matlab output not available for this vector"); formatted_write_vector(file, V->N, V->V, KUL) ; } void LinAlg_PrintMatrix(FILE *file, gMatrix *M, bool matlab, const char* fileName, const char* varName) { if(matlab) Message::Error("Matlab output not available for this matrix"); formatted_write_matrix(file, &M->M, KUL) ; } void LinAlg_WriteScalar(FILE *file, gScalar *S) { Message::Error("'LinAlg_WriteScalar' not yet implemented"); } void LinAlg_WriteVector(FILE *file, gVector *V) { fwrite(V->V, sizeof(double), V->N, file); fprintf(file, "\n"); } void LinAlg_WriteMatrix(FILE *file, gMatrix *M) { binary_write_matrix(&M->M, "A", ".mat") ; } void LinAlg_GetVectorSize(gVector *V, int *i) { *i = V->N ; } void LinAlg_GetLocalVectorRange(gVector *V, int *low, int *high) { *low = 0 ; *high = V->N ; } void LinAlg_GetMatrixSize(gMatrix *M, int *i, int *j) { *i = *j = M->M.N ; } void LinAlg_GetLocalMatrixRange(gMatrix *M, int *low, int *high) { *low = 0 ; *high = M->M.N ; } void LinAlg_GetDoubleInScalar(double *d, gScalar *S) { *d = S->s ; } void LinAlg_GetComplexInScalar(double *d1, double *d2, gScalar *S) { Message::Error("'LinAlg_GetComplexInScalar' not available with this Solver"); } void LinAlg_GetScalarInVector(gScalar *S, gVector *V, int i) { S->s = V->V[i] ; } void LinAlg_GetDoubleInVector(double *d, gVector *V, int i) { *d = V->V[i] ; } void LinAlg_GetAbsDoubleInVector(double *d, gVector *V, int i) { *d = fabs(V->V[i]) ; } void LinAlg_GetComplexInVector(double *d1, double *d2, gVector *V, int i, int j) { *d1 = V->V[i] ; *d2 = V->V[j] ; } void LinAlg_GetScalarInMatrix(gScalar *S, gMatrix *M, int i, int j) { Message::Error("'LinAlg_GetScalarInMatrix' not yet implemented"); } void LinAlg_GetDoubleInMatrix(double *d, gMatrix *M, int i, int j) { get_element_in_matrix(&M->M, i, j, d); } void LinAlg_GetComplexInMatrix(double *d1, double *d2, gMatrix *M, int i, int j, int k, int l) { Message::Error("'LinAlg_GetComplexInMatrix' not yet implemented"); } void LinAlg_GetColumnInMatrix(gMatrix *M, int col, gVector *V1) { get_column_in_matrix(&M->M, col, V1->V); } void LinAlg_SetScalar(gScalar *S, double *d) { S->s = d[0] ; } void LinAlg_SetVector(gVector *V, double *v) { int i; for(i=0; iN; i++) V->V[i] = *v ; } void LinAlg_SetScalarInVector(gScalar *S, gVector *V, int i) { V->V[i] = S->s ; } void LinAlg_SetDoubleInVector(double d, gVector *V, int i) { V->V[i] = d ; } void LinAlg_SetComplexInVector(double d1, double d2, gVector *V, int i, int j) { V->V[i] = d1 ; V->V[j] = d2 ; } void LinAlg_SetScalarInMatrix(gScalar *S, gMatrix *M, int i, int j) { Message::Error("'LinAlg_SetScalarInMatrix' not yet implemented"); } void LinAlg_SetDoubleInMatrix(double d, gMatrix *M, int i, int j) { Message::Error("'LinAlg_SetDoubleInMatrix' not yet implemented"); } void LinAlg_SetComplexInMatrix(double d1, double d2, gMatrix *M, int i, int j, int k, int l) { Message::Error("'LinAlg_SetComplexInMatrix' not yet implemented"); } void LinAlg_AddScalarScalar(gScalar *S1, gScalar *S2, gScalar *S3) { S3->s = S1->s + S2->s ; } void LinAlg_DummyVector(gVector *V) { int * DummyDof, i; DummyDof = Current.DofData->DummyDof; if (DummyDof == NULL) return ; for (i=0 ; iN ; i++) if (DummyDof[i] == 1) V->V[i] = 0 ; } void LinAlg_AddScalarInVector(gScalar *S, gVector *V, int i) { int * DummyDof; if ((DummyDof = Current.DofData->DummyDof)) if (DummyDof[i] == 1) return ; V->V[i] += S->s ; } void LinAlg_AddDoubleInVector(double d, gVector *V, int i) { int * DummyDof; if ((DummyDof = Current.DofData->DummyDof)) if (DummyDof[i] == 1) return ; V->V[i] += d ; } void LinAlg_AddComplexInVector(double d1, double d2, gVector *V, int i, int j) { int * DummyDof, iok,jok; iok=jok=1; if ((DummyDof = Current.DofData->DummyDof)) { if (DummyDof[i] == 1) iok=0; if (DummyDof[j] == 1) jok=0; } if (iok) V->V[i] += d1 ; if (jok) V->V[j] += d2 ; } void LinAlg_AddScalarInMatrix(gScalar *S, gMatrix *M, int i, int j) { int * DummyDof; if ((DummyDof = Current.DofData->DummyDof)) if ( (DummyDof[i] == 1 || DummyDof[j] == 1) && (i != j) ) return ; add_matrix_double(&M->M, i+1, j+1, S->s) ; } void LinAlg_AddDoubleInMatrix(double d, gMatrix *M, int i, int j) { int * DummyDof; if ((DummyDof = Current.DofData->DummyDof)) if ( (DummyDof[i] == 1 || DummyDof[j] == 1) && (i != j) ) return ; add_matrix_double(&M->M, i+1, j+1, d) ; } void LinAlg_AddComplexInMatrix(double d1, double d2, gMatrix *M, int i, int j, int k, int l) { if(d1){ add_matrix_double(&M->M, i+1, j+1, d1) ; add_matrix_double(&M->M, k+1, l+1, d1) ; } if(d2){ add_matrix_double(&M->M, i+1, l+1, -d2) ; add_matrix_double(&M->M, k+1, j+1, d2) ; } } void LinAlg_AddVectorVector(gVector *V1, gVector *V2, gVector *V3) { if(V3 == V1) add_vector_vector(V1->N, V1->V, V2->V) ; else Message::Error("Wrong arguments in 'LinAlg_AddVectorVector'"); } void LinAlg_AddVectorProdVectorDouble(gVector *V1, gVector *V2, double d, gVector *V3) { if(V3 == V1) add_vector_prod_vector_double(V1->N, V1->V, V2->V, d) ; else Message::Error("Wrong arguments in 'LinAlg_AddVectorProdVectorDouble'"); } void LinAlg_AddMatrixMatrix(gMatrix *M1, gMatrix *M2, gMatrix *M3) { if(M3 == M1) add_matrix_matrix(&M1->M, &M2->M) ; else Message::Error("Wrong arguments in 'LinAlg_AddMatrixMatrix'"); } void LinAlg_AddMatrixProdMatrixDouble(gMatrix *M1, gMatrix *M2, double d, gMatrix *M3) { if(M3 == M1) add_matrix_prod_matrix_double(&M1->M, &M2->M, d) ; else Message::Error("Wrong arguments in 'LinAlg_AddMatrixProdMatrixDouble'"); } void LinAlg_SubScalarScalar(gScalar *S1, gScalar *S2, gScalar *S3) { S3->s = S1->s - S2->s ; } void LinAlg_SubVectorVector(gVector *V1, gVector *V2, gVector *V3) { if(V3 == V1) sub_vector_vector_1(V1->N, V1->V, V2->V) ; else if (V3 == V2) sub_vector_vector_2(V1->N, V1->V, V2->V) ; else Message::Error("Wrong arguments in 'LinAlg_SubVectorVector'"); } void LinAlg_SubMatrixMatrix(gMatrix *M1, gMatrix *M2, gMatrix *M3) { Message::Error("'LinAlg_SubMatrixMatrix' not yet implemented"); } void LinAlg_ProdScalarScalar(gScalar *S1, gScalar *S2, gScalar *S3) { S3->s = S1->s * S2->s ; } void LinAlg_ProdScalarDouble(gScalar *S1, double d, gScalar *S2) { S2->s = S1->s * d ; } void LinAlg_ProdScalarComplex(gScalar *S, double d1, double d2, double *d3, double *d4) { *d3 = S->s * d1 ; *d4 = S->s * d2 ; } void LinAlg_ProdVectorScalar(gVector *V1, gScalar *S, gVector *V2) { Message::Error("'LinAlg_ProdVectorScalar' not yet implemented"); } void LinAlg_ProdVectorDouble(gVector *V1, double d, gVector *V2) { if(V2 == V1) prod_vector_double(V1->N, V1->V, d); else Message::Error("Wrong arguments in 'LinAlg_ProdVectorDouble'"); } void LinAlg_ProdVectorComplex(gVector *V1, double d1, double d2, gVector *V2) { Message::Error("'LinAlg_ProdVectorComplex' not yet implemented"); } void LinAlg_ProdVectorVector(gVector *V1, gVector *V2, double *d) { prodsc_vector_vector (V1->N, V1->V, V2->V, d) ; } void LinAlg_ProdMatrixVector(gMatrix *M, gVector *V1, gVector *V2) { if(V2 == V1) Message::Error("Wrong arguments in 'LinAlg_ProdMatrixVector'"); else prod_matrix_vector(&M->M, V1->V, V2->V); } void LinAlg_ProdMatrixScalar(gMatrix *M1, gScalar *S, gMatrix *M2) { if(M2 == M1) prod_matrix_double (&M1->M, S->s); else Message::Error("Wrong arguments in 'LinAlg_ProdMatrixScalar'"); } void LinAlg_ProdMatrixDouble(gMatrix *M1, double d, gMatrix *M2) { if(M2 == M1) prod_matrix_double (&M1->M, d); else Message::Error("Wrong arguments in 'LinAlg_ProdMatrixDouble'"); } void LinAlg_ProdMatrixComplex(gMatrix *M1, double d1, double d2, gMatrix *M2) { Message::Error("'LinAlg_ProdMatrixComplex' not yet implemented"); } void LinAlg_DivScalarScalar(gScalar *S1, gScalar *S2, gScalar *S3) { S3->s = S1->s / S2->s ; } void LinAlg_DivScalarDouble(gScalar *S1, double d, gScalar *S2) { S2->s = S1->s / d ; } void LinAlg_VectorNorm2(gVector *V1, double *norm) { norm2_vector(V1->N, V1->V, norm); } void LinAlg_VectorNormInf(gVector *V1, double *norm) { norminf_vector(V1->N, V1->V, norm); } void LinAlg_AssembleMatrix(gMatrix *M) { } void LinAlg_AssembleVector(gVector *V) { } void LinAlg_Solve(gMatrix *A, gVector *B, gSolver *Solver, gVector *X, int solverIndex) { solve_matrix(&A->M, &Solver->Params, B->V, X->V); } void LinAlg_SolveAgain(gMatrix *A, gVector *B, gSolver *Solver, gVector *X, int solverIndex) { int tmp = Solver->Params.Re_Use_LU; Solver->Params.Re_Use_LU = 1; solve_matrix(&A->M, &Solver->Params, B->V, X->V); Solver->Params.Re_Use_LU = tmp; } void LinAlg_SolveNL(gMatrix *A, gVector *B, gMatrix *J, gVector *R, gSolver *Solver, gVector *X, int solverIndex) { Message::Error("'LinAlg_SolveNL' not yet implemented for Sparskit"); } #endif getdp-2.7.0-source/Legacy/DofData.cpp000644 001750 001750 00000174333 12552147335 021035 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Johan Gyselinck // Ruth Sabariego // #include #include #include #include #include "GetDPVersion.h" #include "ProData.h" #include "DofData.h" #include "GeoData.h" #include "ExtendedGroup.h" #include "ListUtils.h" #include "TreeUtils.h" #include "MallocUtils.h" #include "Message.h" #include "OS.h" #define TWO_PI 6.2831853071795865 extern struct Problem Problem_S ; extern struct CurrentData Current ; FILE * File_PRE = 0, * File_RES = 0, * File_TMP = 0 ; struct DofData * CurrentDofData ; int fcmp_Dof(const void * a, const void * b) { int Result ; if ((Result = ((struct Dof *)a)->NumType - ((struct Dof *)b)->NumType) != 0) return Result ; if ((Result = ((struct Dof *)a)->Entity - ((struct Dof *)b)->Entity) != 0) return Result ; return ((struct Dof *)a)->Harmonic - ((struct Dof *)b)->Harmonic ; } /* ------------------------------------------------------------------------ */ /* D o f _ I n i t D o f D a t a */ /* ------------------------------------------------------------------------ */ void Dof_InitDofData(struct DofData * DofData_P, int Num, int ResolutionIndex, int SystemIndex, char * Name_SolverDataFile) { int Index ; DofData_P->Num = Num ; DofData_P->ResolutionIndex = ResolutionIndex ; DofData_P->SystemIndex = SystemIndex ; DofData_P->FunctionSpaceIndex = NULL ; DofData_P->TimeFunctionIndex = List_Create(10, 5, sizeof(int)) ; Index = 0 ; List_Add(DofData_P->TimeFunctionIndex, &Index) ; DofData_P->Pulsation = NULL ; DofData_P->Val_Pulsation = NULL ; DofData_P->NbrHar = 1 ; DofData_P->NbrAnyDof = 0 ; DofData_P->NbrDof = 0 ; DofData_P->DofTree = Tree_Create(sizeof(struct Dof), fcmp_Dof) ; DofData_P->DofList = NULL ; DofData_P->SolverDataFileName = Name_SolverDataFile ; DofData_P->Flag_RHS = 0 ; DofData_P->Flag_Init[0] = 0 ; DofData_P->Flag_Init[1] = 0 ; DofData_P->Flag_Init[2] = 0 ; DofData_P->Flag_Init[3] = 0 ; DofData_P->Flag_Init[4] = 0 ; DofData_P->Flag_Init[5] = 0 ; DofData_P->Flag_Init[6] = 0 ; DofData_P->Flag_Only = 0 ; DofData_P->Flag_InitOnly[0] = 0 ; DofData_P->Flag_InitOnly[1] = 0 ; DofData_P->Flag_InitOnly[2] = 0 ; DofData_P->OnlyTheseMatrices = NULL; DofData_P->Solutions = NULL ; DofData_P->CurrentSolution = NULL ; DofData_P->CorrectionSolutions.Flag = 0; DofData_P->CorrectionSolutions.AllSolutions = NULL; DofData_P->DummyDof = NULL ; } /* ------------------------------------------------------------------------ */ /* D o f _ F r e e D o f D a t a */ /* ------------------------------------------------------------------------ */ void Dof_FreeDofData(struct DofData * DofData_P) { Message::Debug("Freeing DofData %d", DofData_P->Num); List_Delete(DofData_P->FunctionSpaceIndex); List_Delete(DofData_P->TimeFunctionIndex); List_Delete(DofData_P->Pulsation); Tree_Delete(DofData_P->DofTree); List_Delete(DofData_P->DofList); Free(DofData_P->DummyDof); if(DofData_P->Solutions){ for(int i = 0; i < List_Nbr(DofData_P->Solutions); i++){ Solution *Solution_P = (struct Solution*)List_Pointer(DofData_P->Solutions, i); if(Solution_P->SolutionExist){ LinAlg_DestroyVector(&Solution_P->x); Free(Solution_P->TimeFunctionValues) ; Solution_P->TimeFunctionValues = NULL; Solution_P->SolutionExist = 0; } } List_Delete(DofData_P->Solutions); } List_Delete(DofData_P->OnlyTheseMatrices); if(DofData_P->Flag_Init[0] == 1 || DofData_P->Flag_Init[0] == 2){ LinAlg_DestroyMatrix(&DofData_P->A); LinAlg_DestroyVector(&DofData_P->b); LinAlg_DestroyVector(&DofData_P->res); LinAlg_DestroySolver(&DofData_P->Solver); } if(DofData_P->Flag_Init[0] == 2){ LinAlg_DestroyMatrix(&DofData_P->Jac); LinAlg_DestroyVector(&DofData_P->dx); } if(DofData_P->Flag_Init[1] == 1){ LinAlg_DestroyMatrix(&DofData_P->M1); LinAlg_DestroyVector(&DofData_P->m1); for(int i = 0; i < List_Nbr(DofData_P->m1s); i++) LinAlg_DestroyVector((gVector*)List_Pointer(DofData_P->m1s, i)); List_Delete(DofData_P->m1s); } if(DofData_P->Flag_Init[2] == 1){ LinAlg_DestroyMatrix(&DofData_P->M2); LinAlg_DestroyVector(&DofData_P->m2); for(int i = 0; i < List_Nbr(DofData_P->m2s); i++) LinAlg_DestroyVector((gVector*)List_Pointer(DofData_P->m2s, i)); List_Delete(DofData_P->m2s); } if(DofData_P->Flag_Init[3] == 1){ LinAlg_DestroyMatrix(&DofData_P->M3); LinAlg_DestroyVector(&DofData_P->m3); for(int i = 0; i < List_Nbr(DofData_P->m3s); i++) LinAlg_DestroyVector((gVector*)List_Pointer(DofData_P->m3s, i)); List_Delete(DofData_P->m3s); } if(DofData_P->Flag_Init[4] == 1){ LinAlg_DestroyMatrix(&DofData_P->M4); LinAlg_DestroyVector(&DofData_P->m4); for(int i = 0; i < List_Nbr(DofData_P->m4s); i++) LinAlg_DestroyVector((gVector*)List_Pointer(DofData_P->m4s, i)); List_Delete(DofData_P->m4s); } if(DofData_P->Flag_Init[5] == 1){ LinAlg_DestroyMatrix(&DofData_P->M5); LinAlg_DestroyVector(&DofData_P->m5); for(int i = 0; i < List_Nbr(DofData_P->m5s); i++) LinAlg_DestroyVector((gVector*)List_Pointer(DofData_P->m5s, i)); List_Delete(DofData_P->m5s); } if(DofData_P->Flag_Init[6] == 1){ LinAlg_DestroyMatrix(&DofData_P->M6); LinAlg_DestroyVector(&DofData_P->m6); for(int i = 0; i < List_Nbr(DofData_P->m6s); i++) LinAlg_DestroyVector((gVector*)List_Pointer(DofData_P->m6s, i)); List_Delete(DofData_P->m6s); } if(DofData_P->Flag_Only){ if(DofData_P->Flag_InitOnly[0] == 1){ LinAlg_DestroyMatrix(&DofData_P->A1); LinAlg_DestroyVector(&DofData_P->b1); } if(DofData_P->Flag_InitOnly[1] == 1){ LinAlg_DestroyMatrix(&DofData_P->A2); LinAlg_DestroyVector(&DofData_P->b2); } if(DofData_P->Flag_InitOnly[2] == 1){ LinAlg_DestroyMatrix(&DofData_P->A3); LinAlg_DestroyVector(&DofData_P->b3); } } // TODO: handle MH data and CorrectionSolutions } /* ------------------------------------------------------------------------ */ /* D o f _ S e t C u r r e n t D o f D a t a */ /* ------------------------------------------------------------------------ */ void Dof_SetCurrentDofData(struct DofData * DofData_P) { CurrentDofData = DofData_P ; } /* ------------------------------------------------------------------------ */ /* F i l e s . . . */ /* ------------------------------------------------------------------------ */ /* ------------------------------------------------------------------------ */ /* D o f _ O p e n F i l e */ /* ------------------------------------------------------------------------ */ void Dof_OpenFile(int Type, char * Name, const char * Mode) { if((Message::GetIsCommWorld() && Message::GetCommRank()) && (Mode[0] == 'w' || Mode[0] == 'a')){ switch (Type) { case DOF_PRE : File_PRE = 0 ; break ; case DOF_RES : File_RES = 0 ; break ; case DOF_TMP : File_RES = 0 ; break ; default : break ; } return; } const char * Extension; char FileName[256] ; FILE * File_X ; switch (Type) { case DOF_PRE : Extension = ".pre" ; break ; case DOF_RES : Extension = "" ; break ; case DOF_TMP : Extension = "" ; break ; default : Extension = ".pre" ; break ; } strcpy(FileName, Name) ; strcat(FileName, Extension) ; if (!(File_X = FOpen(FileName, Mode))) Message::Error("Unable to open file '%s'", FileName) ; switch (Type) { case DOF_PRE : File_PRE = File_X ; break ; case DOF_RES : File_RES = File_X ; break ; case DOF_TMP : File_TMP = File_RES ; File_RES = File_X ; break ; default : break ; } } /* ------------------------------------------------------------------------ */ /* D o f _ C l o s e F i l e */ /* ------------------------------------------------------------------------ */ void Dof_CloseFile(int Type) { switch (Type) { case DOF_PRE : if(File_PRE) fclose(File_PRE) ; break ; case DOF_RES : if(File_RES) fclose(File_RES) ; break ; case DOF_TMP : if(File_RES) fclose(File_RES) ; File_RES = File_TMP ; break ; } } /* ------------------------------------------------------------------------ */ /* D o f _ F l u s h F i l e */ /* ------------------------------------------------------------------------ */ void Dof_FlushFile(int Type) { switch (Type) { case DOF_PRE : fflush(File_PRE) ; break ; case DOF_RES : fflush(File_RES) ; break ; } } /* ------------------------------------------------------------------------ */ /* D o f _ W r i t e F i l e P R E 0 */ /* ------------------------------------------------------------------------ */ void Dof_WriteFilePRE0(int Num_Resolution, char * Name_Resolution, int Nbr_DofData) { if(Message::GetIsCommWorld() && Message::GetCommRank()) return; fprintf(File_PRE, "$Resolution /* '%s' */\n", Name_Resolution) ; fprintf(File_PRE, "%d %d\n", Num_Resolution, Nbr_DofData) ; fprintf(File_PRE, "$EndResolution\n") ; } /* ------------------------------------------------------------------------ */ /* D o f _ R e a d F i l e P R E 0 */ /* ------------------------------------------------------------------------ */ void Dof_ReadFilePRE0(int * Num_Resolution, int * Nbr_DofData) { Message::Barrier(); char String[256] ; do { fgets(String, sizeof(String), File_PRE) ; if (feof(File_PRE)) break ; } while (String[0] != '$') ; if (feof(File_PRE)){ Message::Error("$Resolution field not found in file"); return; } if (!strncmp(&String[1], "Resolution", 10)) { fscanf(File_PRE, "%d %d", Num_Resolution, Nbr_DofData) ; } do { fgets(String, sizeof(String), File_PRE) ; if (feof(File_PRE)){ Message::Error("Prematured end of file"); return; } } while (String[0] != '$') ; } /* ------------------------------------------------------------------------ */ /* D o f _ W r i t e F i l e P R E */ /* ------------------------------------------------------------------------ */ void Dof_WriteFilePRE(struct DofData * DofData_P) { if(Message::GetIsCommWorld() && Message::GetCommRank()) return; int i, Nbr_Index ; struct Dof * Dof_P0 ; fprintf(File_PRE, "$DofData /* #%d */\n", DofData_P->Num) ; fprintf(File_PRE, "%d %d\n", DofData_P->ResolutionIndex, DofData_P->SystemIndex) ; Nbr_Index = List_Nbr(DofData_P->FunctionSpaceIndex) ; fprintf(File_PRE, "%d", Nbr_Index) ; for (i = 0 ; i < Nbr_Index ; i++) fprintf(File_PRE, " %d", *((int *)List_Pointer(DofData_P->FunctionSpaceIndex, i))) ; fprintf(File_PRE, "\n") ; Nbr_Index = List_Nbr(DofData_P->TimeFunctionIndex) ; fprintf(File_PRE, "%d", Nbr_Index) ; for (i = 0 ; i < Nbr_Index ; i++) fprintf(File_PRE, " %d", *((int *)List_Pointer(DofData_P->TimeFunctionIndex, i))) ; fprintf(File_PRE, "\n") ; fprintf(File_PRE, "%d", 1) ; for(i = 0 ; i < 1 ; i++) fprintf(File_PRE, " %d", 0) ; fprintf(File_PRE, "\n") ; fprintf(File_PRE, "%d %d\n", (DofData_P->DofTree)? Tree_Nbr(DofData_P->DofTree) : DofData_P->NbrAnyDof, DofData_P->NbrDof) ; if (DofData_P->DofTree) Tree_Action(DofData_P->DofTree, Dof_WriteDofPRE) ; else { if (DofData_P->NbrAnyDof){ Dof_P0 = (struct Dof *)List_Pointer(DofData_P->DofList, 0) ; for (i = 0 ; i < DofData_P->NbrAnyDof ; i++) Dof_WriteDofPRE(Dof_P0 + i, NULL) ; } } fprintf(File_PRE, "$EndDofData\n") ; fflush(File_PRE) ; } /* ------------------------------- */ /* D o f _ W r i t e D o f P R E */ /* ------------------------------- */ void Dof_WriteDofPRE(void * a, void * b) { struct Dof * Dof_P ; Dof_P = (struct Dof *) a ; fprintf(File_PRE, "%d %d %d %d ", Dof_P->NumType, Dof_P->Entity, Dof_P->Harmonic, Dof_P->Type) ; switch (Dof_P->Type) { case DOF_UNKNOWN : fprintf(File_PRE, "%d %d\n", Dof_P->Case.Unknown.NumDof, Dof_P->Case.Unknown.NonLocal ? -1 : 1) ; break ; case DOF_FIXEDWITHASSOCIATE : fprintf(File_PRE, "%d ", Dof_P->Case.FixedAssociate.NumDof) ; LinAlg_PrintScalar(File_PRE, &Dof_P->Val); fprintf(File_PRE, " %d\n", Dof_P->Case.FixedAssociate.TimeFunctionIndex) ; break ; case DOF_FIXED : LinAlg_PrintScalar(File_PRE, &Dof_P->Val); fprintf(File_PRE, " %d\n", Dof_P->Case.FixedAssociate.TimeFunctionIndex) ; break ; case DOF_FIXED_SOLVE : fprintf(File_PRE, "%d\n", Dof_P->Case.FixedAssociate.TimeFunctionIndex) ; break ; case DOF_UNKNOWN_INIT : fprintf(File_PRE, "%d ", Dof_P->Case.Unknown.NumDof) ; LinAlg_PrintScalar(File_PRE, &Dof_P->Val); fprintf(File_PRE, " ") ; LinAlg_PrintScalar(File_PRE, &Dof_P->Val2); fprintf(File_PRE, " %d\n", Dof_P->Case.Unknown.NonLocal ? -1 : 1) ; break ; case DOF_LINK : fprintf(File_PRE, "%.16g %d\n", Dof_P->Case.Link.Coef, Dof_P->Case.Link.EntityRef) ; break ; case DOF_LINKCPLX : fprintf(File_PRE, "%.16g %.16g %d\n", Dof_P->Case.Link.Coef, Dof_P->Case.Link.Coef2, Dof_P->Case.Link.EntityRef) ; break ; } } /* ------------------------------------------------------------------------ */ /* D o f _ R e a d F i l e P R E */ /* ------------------------------------------------------------------------ */ void Dof_ReadFilePRE(struct DofData * DofData_P) { Message::Barrier(); int i, Nbr_Index, Int, Dummy ; struct Dof Dof ; char String[256] ; do { fgets(String, sizeof(String), File_PRE) ; if (feof(File_PRE)) break ; } while (String[0] != '$') ; if (feof(File_PRE)){ Message::Error("$DofData field not found in file"); return; } if (!strncmp(&String[1], "DofData", 7)) { fscanf(File_PRE, "%d %d", &DofData_P->ResolutionIndex, &DofData_P->SystemIndex) ; fscanf(File_PRE, "%d", &Nbr_Index) ; DofData_P->FunctionSpaceIndex = List_Create(Nbr_Index, 1, sizeof(int)) ; for (i = 0 ; i < Nbr_Index ; i++) { fscanf(File_PRE, "%d", &Int) ; List_Add(DofData_P->FunctionSpaceIndex, &Int) ; } fscanf(File_PRE, "%d", &Nbr_Index) ; DofData_P->TimeFunctionIndex = List_Create(Nbr_Index, 1, sizeof(int)) ; for (i = 0 ; i < Nbr_Index ; i++) { fscanf(File_PRE, "%d", &Int) ; List_Add(DofData_P->TimeFunctionIndex, &Int) ; } fscanf(File_PRE, "%d", &Dummy) ; for(i = 0 ; i < 1 ; i++) fscanf(File_PRE, "%d", &Dummy) ; fscanf(File_PRE, "%d %d", &DofData_P->NbrAnyDof, &DofData_P->NbrDof) ; DofData_P->DofList = List_Create(DofData_P->NbrAnyDof, 1, sizeof(struct Dof)) ; for (i = 0 ; i < DofData_P->NbrAnyDof ; i++) { fscanf(File_PRE, "%d %d %d %d", &Dof.NumType, &Dof.Entity, &Dof.Harmonic, &Dof.Type) ; switch (Dof.Type) { case DOF_UNKNOWN : fscanf(File_PRE, "%d", &Dof.Case.Unknown.NumDof) ; fscanf(File_PRE, "%d", &Dummy) ; Dof.Case.Unknown.NonLocal = (Dummy < 0) ? true : false; if(Dummy < 0) DofData_P->NonLocalEquations.push_back(Dof.Case.Unknown.NumDof); break ; case DOF_FIXEDWITHASSOCIATE : fscanf(File_PRE, "%d", &Dof.Case.FixedAssociate.NumDof) ; LinAlg_ScanScalar(File_PRE, &Dof.Val) ; fscanf(File_PRE, "%d", &Dof.Case.FixedAssociate.TimeFunctionIndex) ; break ; case DOF_FIXED : LinAlg_ScanScalar(File_PRE, &Dof.Val) ; fscanf(File_PRE, "%d", &Dof.Case.FixedAssociate.TimeFunctionIndex) ; break ; case DOF_FIXED_SOLVE : fscanf(File_PRE, "%d", &Dof.Case.FixedAssociate.TimeFunctionIndex) ; break ; case DOF_UNKNOWN_INIT : fscanf(File_PRE, "%d", &Dof.Case.Unknown.NumDof) ; LinAlg_ScanScalar(File_PRE, &Dof.Val) ; LinAlg_ScanScalar(File_PRE, &Dof.Val2) ; fscanf(File_PRE, "%d", &Dummy) ; Dof.Case.Unknown.NonLocal = (Dummy < 0) ? true : false; if(Dummy < 0) DofData_P->NonLocalEquations.push_back(Dof.Case.Unknown.NumDof); break ; case DOF_LINK : fscanf(File_PRE, "%lf %d", &Dof.Case.Link.Coef, &Dof.Case.Link.EntityRef) ; Dof.Case.Link.Dof = NULL ; break ; case DOF_LINKCPLX : fscanf(File_PRE, "%lf %lf %d", &Dof.Case.Link.Coef, &Dof.Case.Link.Coef2, &Dof.Case.Link.EntityRef) ; Dof.Case.Link.Dof = NULL ; break ; } List_Add(DofData_P->DofList, &Dof) ; } } do { fgets(String, sizeof(String), File_PRE) ; if (feof(File_PRE)){ Message::Error("Prematured end of file"); return; } } while (String[0] != '$') ; Dof_InitDofType(DofData_P) ; } /* ------------------------------------------------------------------------ */ /* D o f _ W r i t e F i l e R E S 0 */ /* ------------------------------------------------------------------------ */ void Dof_WriteFileRES0(char * Name_File, int Format) { if(Message::GetIsCommWorld() && Message::GetCommRank()) return; Dof_OpenFile(DOF_RES, Name_File, (char*)(Format ? "wb" : "w")) ; fprintf(File_RES, "$ResFormat /* GetDP %s, %s */\n", GETDP_VERSION, Format ? "binary" : "ascii") ; fprintf(File_RES, "1.1 %d\n", Format) ; fprintf(File_RES, "$EndResFormat\n") ; Dof_CloseFile(DOF_RES) ; } /* ------------------------------------------------------------------------ */ /* D o f _ W r i t e F i l e R E S _ E x t e n d M H */ /* ------------------------------------------------------------------------ */ void Dof_WriteFileRES_ExtendMH(char * Name_File, struct DofData * DofData_P, int Format, int NbrH) { if(Message::GetIsCommWorld() && Message::GetCommRank()) return; if(!DofData_P->CurrentSolution){ Message::Warning("No solution to save"); return; } gVector x; double d; int i, inew; Dof_OpenFile(DOF_RES, Name_File, (char*)(Format ? "ab" : "a")) ; fprintf(File_RES, "$Solution /* DofData #%d */\n", DofData_P->Num) ; fprintf(File_RES, "%d 0 0 0 \n", DofData_P->Num) ; LinAlg_CreateVector(&x, &DofData_P->Solver, (DofData_P->NbrDof / Current.NbrHar) * NbrH) ; LinAlg_ZeroVector(&x) ; for (i=0 ; iNbrDof ; i++){ LinAlg_GetDoubleInVector(&d, &DofData_P->CurrentSolution->x, i); inew = (i / Current.NbrHar) * NbrH + i % Current.NbrHar; LinAlg_SetDoubleInVector(d, &x, inew); } Format ? LinAlg_WriteVector(File_RES,&x) : LinAlg_PrintVector(File_RES,&x) ; fprintf(File_RES, "$EndSolution\n") ; Dof_CloseFile(DOF_RES) ; LinAlg_DestroyVector(&x) ; } void Dof_WriteFileRES_MHtoTime(char * Name_File, struct DofData * DofData_P, int Format, List_T * Time_L) { if(Message::GetIsCommWorld() && Message::GetCommRank()) return; if(!DofData_P->CurrentSolution){ Message::Warning("No solution to save"); return; } gVector x; double Time, d1, d2, d, *Pulsation; int iT, i, j, k; Dof_OpenFile(DOF_RES, Name_File, (char*)(Format ? "ab" : "a")) ; for(iT=0 ; iTNum) ; fprintf(File_RES, "%d %e 0 %d \n", DofData_P->Num,Time,iT) ; Pulsation = DofData_P->Val_Pulsation ; LinAlg_CreateVector(&x, &DofData_P->Solver, DofData_P->NbrDof/Current.NbrHar) ; LinAlg_ZeroVector(&x) ; for (i=0 ; iNbrDof/Current.NbrHar ; i++) { d = 0; for (k=0 ; kCurrentSolution->x, j) ; LinAlg_GetDoubleInVector(&d2, &DofData_P->CurrentSolution->x, j+1) ; d += d1 * cos(Pulsation[k]*Time) - d2 * sin(Pulsation[k]*Time) ; } LinAlg_SetDoubleInVector(d, &x, i) ; } Format ? LinAlg_WriteVector(File_RES,&x) : LinAlg_PrintVector(File_RES,&x) ; fprintf(File_RES, "$EndSolution\n") ; } Dof_CloseFile(DOF_RES) ; LinAlg_DestroyVector(&x) ; } /* ------------------------------------------------------------------------ */ /* D o f _ W r i t e F i l e R E S */ /* ------------------------------------------------------------------------ */ void Dof_WriteFileRES(char * Name_File, struct DofData * DofData_P, int Format, double Val_Time, double Val_TimeImag, int Val_TimeStep) { if(Message::GetIsCommWorld() && Message::GetCommRank()) return; if(!DofData_P->CurrentSolution){ Message::Warning("No solution to save"); return; } Dof_OpenFile(DOF_RES, Name_File, (char*)(Format ? "ab" : "a")) ; fprintf(File_RES, "$Solution /* DofData #%d */\n", DofData_P->Num) ; fprintf(File_RES, "%d %.16g %.16g %d\n", DofData_P->Num, Val_Time, Val_TimeImag, Val_TimeStep) ; Format ? LinAlg_WriteVector(File_RES, &DofData_P->CurrentSolution->x) : LinAlg_PrintVector(File_RES, &DofData_P->CurrentSolution->x) ; fprintf(File_RES, "$EndSolution\n") ; Dof_CloseFile(DOF_RES) ; } /* ------------------------------------------------------------------------ */ /* D o f _ W r i t e F i l e R E S _ W i t h E n t i t y N u m */ /* ------------------------------------------------------------------------ */ void Dof_WriteFileRES_WithEntityNum(char * Name_File, struct DofData * DofData_P, struct GeoData * GeoData_P0, struct Group *Group_P, bool saveFixed) { if(Message::GetIsCommWorld() && Message::GetCommRank()) return; if(!DofData_P->CurrentSolution){ Message::Warning("No solution to save"); return; } char FileCplx[256] ; char FileRe[256] ; char FileIm[256] ; strcpy(FileCplx, Name_File) ; strcat(FileCplx, ".txt") ; strcpy(FileRe, Name_File) ; strcat(FileRe, "_Re.txt") ; strcpy(FileIm, Name_File) ; strcat(FileIm, "_Im.txt") ; FILE *fp = FOpen(FileCplx, "w"); if(!fp){ Message::Error("Unable to open file '%s'", FileCplx) ; return; } FILE *fpRe = FOpen(FileRe, "w"); if(!fpRe){ Message::Error("Unable to open file '%s'", FileRe) ; return; } FILE *fpIm = FOpen(FileIm, "w"); if(!fpIm){ Message::Error("Unable to open file '%s'", FileIm) ; return; } std::map > unknowns; List_T *l = !DofData_P->DofList ? Tree2List(DofData_P->DofTree) : 0; int N = l ? List_Nbr(l) : List_Nbr(DofData_P->DofList); for(int i = 0; i < N; i++){ Dof *dof; if(l) List_Read(l, i, &dof); else dof = (Dof*)List_Pointer(DofData_P->DofList, i); if(dof->Type == DOF_UNKNOWN){ gScalar s; LinAlg_GetScalarInVector(&s, &DofData_P->CurrentSolution->x, dof->Case.Unknown.NumDof - 1); unknowns[dof->Entity] = s.s; } if(saveFixed && dof->Type == DOF_FIXED){ unknowns[dof->Entity] = dof->Val.s; } } if(!Group_P){ fprintf(fpRe, "%d\n", N);//Needed for ListFromFile fprintf(fpIm, "%d\n", N); for(std::map >::iterator it = unknowns.begin(); it != unknowns.end(); it++){ fprintf(fp , "%d %.16g %.16g\n", it->first, it->second.real(), it->second.imag()); fprintf(fpRe, "%d %.16g\n", it->first, it->second.real()); fprintf(fpIm, "%d %.16g\n", it->first, it->second.imag()); } } else{ Message::Info("Writing solution for all entities in group '%s'", Group_P->Name) ; // force generation of extended list (necessary when using // multiple meshes) List_Delete(Group_P->ExtendedList); Generate_ExtendedGroup(Group_P) ; fprintf(fpRe, "%d\n", List_Nbr(Group_P->ExtendedList));//Needed for ListFromFile fprintf(fpIm, "%d\n", List_Nbr(Group_P->ExtendedList)); for(int i = 0; i < List_Nbr(Group_P->ExtendedList); i++){ int num; List_Read(Group_P->ExtendedList, i, &num); if(!Group_P->InitialSuppList || (!List_Search(Group_P->ExtendedSuppList, &num, fcmp_int))){ // SuppList assumed to be "Not"! if(unknowns.count(num)){ std::complex s = unknowns[num]; fprintf(fp, "%d %.16g %.16g\n", num, s.real(), s.imag()); fprintf(fpRe, "%d %.16g\n", num, s.real()); fprintf(fpIm, "%d %.16g\n", num, s.imag()); } else{ // yes, write zero: that's on purpose for the iterative schemes fprintf(fp, "%d 0 0\n", num); fprintf(fpRe, "%d 0\n", num); fprintf(fpIm, "%d 0\n", num); } } } } List_Delete(l); fclose(fp); fclose(fpRe); fclose(fpIm); } /* ------------------------------------------------------------------------ */ /* D o f _ R e a d F i l e R E S */ /* ------------------------------------------------------------------------ */ void Dof_ReadFileRES(List_T * DofData_L, struct DofData * Read_DofData_P, int Read_DofData, double *Time, double *TimeImag, double *TimeStep) { Message::Barrier(); int Num_DofData, Val_TimeStep, Format = 0, Read ; double Val_Time, Val_TimeImag = 0., Version = 0.; struct DofData * DofData_P = NULL ; struct Solution Solution_S ; char String[256] ; while (1) { do { fgets(String, sizeof(String), File_RES) ; if (feof(File_RES)) break ; } while (String[0] != '$') ; if (feof(File_RES)) break ; /* F o r m a t */ if (!strncmp(&String[1], "ResFormat", 9)) { fscanf(File_RES, "%lf %d\n", &Version, &Format) ; } /* S o l u t i o n */ if (!strncmp(&String[1], "Solution", 8)) { /* don't use fscanf directly on the stream here: the data that follows can be binary, and the first character could be e.g. 0x0d, which would cause fscanf to eat-up one character too much, leading to an offset in fread */ fgets(String, sizeof(String), File_RES) ; if(Version <= 1.0) sscanf(String, "%d %lf %d", &Num_DofData, &Val_Time, &Val_TimeStep) ; else sscanf(String, "%d %lf %lf %d", &Num_DofData, &Val_Time, &Val_TimeImag, &Val_TimeStep) ; if (Read_DofData < 0){ Read = 1 ; DofData_P = (struct DofData*)List_Pointer(DofData_L, Num_DofData) ; } else if (Num_DofData == Read_DofData) { Read = 1 ; DofData_P = Read_DofData_P ; } else { Read = 0 ; } if(Read){ Solution_S.Time = Val_Time ; Solution_S.TimeImag = Val_TimeImag ; Solution_S.TimeStep = Val_TimeStep ; Solution_S.SolutionExist = 1 ; Solution_S.TimeFunctionValues = NULL ; LinAlg_CreateVector(&Solution_S.x, &DofData_P->Solver, DofData_P->NbrDof) ; Format ? LinAlg_ReadVector(File_RES, &Solution_S.x) : LinAlg_ScanVector(File_RES, &Solution_S.x) ; if (DofData_P->Solutions == NULL) DofData_P->Solutions = List_Create( 20, 20, sizeof(struct Solution)) ; List_Add(DofData_P->Solutions, &Solution_S) ; } } do { fgets(String, sizeof(String), File_RES) ; if (feof(File_RES)) Message::Warning("Prematured end of file (Time Step %d)", Val_TimeStep); } while (String[0] != '$') ; } /* while 1 ... */ *Time = Val_Time ; *TimeImag = Val_TimeImag ; *TimeStep = (double)Val_TimeStep ; } /* ------------------------------------------------------------------------ */ /* D o f _ T r a n s f e r D o f T r e e T o L i s t */ /* ------------------------------------------------------------------------ */ void Dof_TransferDofTreeToList(struct DofData * DofData_P) { if (DofData_P->DofTree) { DofData_P->DofList = Tree2List(DofData_P->DofTree) ; Tree_Delete(DofData_P->DofTree) ; DofData_P->DofTree = NULL ; DofData_P->NbrAnyDof = List_Nbr(DofData_P->DofList) ; } Dof_InitDofType(DofData_P) ; } /* ------------------------------------------------------------------------ */ /* D o f _ I n i t D o f T y p e */ /* ------------------------------------------------------------------------ */ void Dof_InitDofType(struct DofData * DofData_P) { struct Dof * Dof_P, * Dof_P0 ; int i ; if (!DofData_P->NbrAnyDof){ return; } Dof_P0 = (struct Dof *)List_Pointer(DofData_P->DofList, 0) ; for (i = 0 ; i < DofData_P->NbrAnyDof ; i++) { Dof_P = Dof_P0 + i ; switch (Dof_P->Type) { case DOF_LINK : case DOF_LINKCPLX : Dof_P->Case.Link.Dof = Dof_GetDofStruct(DofData_P, Dof_P->NumType, Dof_P->Case.Link.EntityRef, Dof_P->Harmonic) ; if (Dof_P->Case.Link.Dof == NULL || Dof_P->Case.Link.Dof == Dof_GetDofStruct(DofData_P, Dof_P->NumType, Dof_P->Entity, Dof_P->Harmonic) ) { Dof_P->Case.Link.Dof = /* Attention: bricolage ... */ Dof_GetDofStruct(DofData_P, Dof_P->NumType-1, Dof_P->Case.Link.EntityRef, Dof_P->Harmonic) ; if (Dof_P->Case.Link.Dof == NULL) Message::Error("Wrong Link Constraint: reference Dof (%d %d %d) does not exist", Dof_P->NumType, Dof_P->Case.Link.EntityRef, Dof_P->Harmonic); } /* if (Dof_P->Case.Link.Dof == NULL) Message::Error("Wrong Link Constraint: reference Dof (%d %d %d) does not exist", Dof_P->NumType, Dof_P->Case.Link.EntityRef, Dof_P->Harmonic); */ break ; default : break ; } } } /* ------------------------------------------------------------------------ */ /* P R E P R O C E S S I N G ( C o d e s i n T r e e ) */ /* ------------------------------------------------------------------------ */ /* ------------------------------------------------------------------------ */ /* D o f _ A d d F u n c t i o n S p a c e I n d e x */ /* ------------------------------------------------------------------------ */ void Dof_AddFunctionSpaceIndex(int Index_FunctionSpace) { if (CurrentDofData->FunctionSpaceIndex == NULL) CurrentDofData->FunctionSpaceIndex = List_Create(10, 5, sizeof(int)) ; if (List_PQuery (CurrentDofData->FunctionSpaceIndex, &Index_FunctionSpace, fcmp_int) == NULL) { List_Add(CurrentDofData->FunctionSpaceIndex, &Index_FunctionSpace) ; List_Sort(CurrentDofData->FunctionSpaceIndex, fcmp_int) ; } } /* ------------------------------------------------------------------------ */ /* D o f _ A d d T i m e F u n c t i o n I n d e x */ /* ------------------------------------------------------------------------ */ void Dof_AddTimeFunctionIndex(int Index_TimeFunction) { if (List_PQuery (CurrentDofData->TimeFunctionIndex, &Index_TimeFunction, fcmp_int) == NULL) { List_Add(CurrentDofData->TimeFunctionIndex, &Index_TimeFunction) ; List_Sort(CurrentDofData->TimeFunctionIndex, fcmp_int) ; } } /* ------------------------------------------------------------------------ */ /* D o f _ A d d P u l s a t i o n */ /* ------------------------------------------------------------------------ */ void Dof_AddPulsation(struct DofData * DofData_P, double Val_Pulsation) { if (DofData_P->Pulsation == NULL) DofData_P->Pulsation = List_Create(1, 2, sizeof(double)) ; if (List_PQuery (DofData_P->Pulsation, &Val_Pulsation, fcmp_double) == NULL) { List_Add(DofData_P->Pulsation, &Val_Pulsation) ; List_Sort(DofData_P->Pulsation, fcmp_double) ; } } /* ------------------------------------------------------------------------ */ /* D o f _ D e f i n e A s s i g n F i x e d D o f */ /* ------------------------------------------------------------------------ */ void Dof_DefineAssignFixedDof(int D1, int D2, int NbrHar, double *Val, int Index_TimeFunction) { struct Dof Dof, * Dof_P ; int k ; Dof.NumType = D1 ; Dof.Entity = D2 ; for(k=0 ; kDofTree, &Dof))) { Dof.Type = DOF_FIXED ; LinAlg_SetScalar(&Dof.Val, &Val[k]) ; Dof.Case.FixedAssociate.TimeFunctionIndex = Index_TimeFunction + 1 ; Dof_AddTimeFunctionIndex(Index_TimeFunction + 1) ; Tree_Add(CurrentDofData->DofTree, &Dof) ; } else if(Dof_P->Type == DOF_UNKNOWN) { if(Message::GetVerbosity() == 10) Message::Info("Overriding unknown Dof with fixed Dof"); Dof_P->Type = DOF_FIXED ; LinAlg_SetScalar(&Dof_P->Val, &Val[k]) ; Dof_P->Case.FixedAssociate.TimeFunctionIndex = Index_TimeFunction + 1 ; Dof_AddTimeFunctionIndex(Index_TimeFunction + 1) ; } } } /* ------------------------------------------------------------------------ */ /* D o f _ D e f i n e A s s i g n S o l v e D o f */ /* ------------------------------------------------------------------------ */ void Dof_DefineAssignSolveDof(int D1, int D2, int NbrHar, int Index_TimeFunction) { struct Dof Dof ; int k ; Dof.NumType = D1 ; Dof.Entity = D2 ; for(k=0 ; kDofTree, &Dof)) { Dof.Type = DOF_FIXED_SOLVE ; Dof.Case.FixedAssociate.TimeFunctionIndex = Index_TimeFunction + 1 ; Dof_AddTimeFunctionIndex(Index_TimeFunction + 1) ; Tree_Add(CurrentDofData->DofTree, &Dof) ; } } } /* ------------------------------------------------------------------------ */ /* D o f _ D e f i n e I n i t F i x e d D o f */ /* ------------------------------------------------------------------------ */ void Dof_DefineInitFixedDof(int D1, int D2, int NbrHar, double *Val, double *Val2, bool NonLocal) { struct Dof Dof ; int k ; Dof.NumType = D1 ; Dof.Entity = D2 ; for(k=0 ; kDofTree, &Dof)) { Dof.Type = DOF_UNKNOWN_INIT ; LinAlg_SetScalar(&Dof.Val, &Val[k]) ; LinAlg_SetScalar(&Dof.Val2, &Val2[k]) ; Dof.Case.Unknown.NumDof = ++(CurrentDofData->NbrDof) ; Dof.Case.Unknown.NonLocal = NonLocal; Tree_Add(CurrentDofData->DofTree, &Dof) ; } } } /* ------------------------------------------------------------------------ */ /* D o f _ D e f i n e I n i t S o l v e D o f */ /* ------------------------------------------------------------------------ */ void Dof_DefineInitSolveDof(int D1, int D2, int NbrHar) { struct Dof Dof ; int k ; Dof.NumType = D1 ; Dof.Entity = D2 ; for(k=0 ; kDofTree, &Dof)) { Dof.Type = DOF_UNKNOWN_INIT ; Dof.Case.Unknown.NumDof = ++(CurrentDofData->NbrDof) ; Dof.Case.Unknown.NonLocal = false ; Tree_Add(CurrentDofData->DofTree, &Dof) ; } } } /* ------------------------------------------------------------------------ */ /* D o f _ D e f i n e L i n k D o f */ /* ------------------------------------------------------------------------ */ void Dof_DefineLinkDof(int D1, int D2, int NbrHar, double Value[], int D2_Link) { struct Dof Dof ; int k ; Dof.NumType = D1 ; Dof.Entity = D2 ; for(k=0 ; kDofTree, &Dof)) { Dof.Type = DOF_LINK ; Dof.Case.Link.Coef = Value[0] ; Dof.Case.Link.EntityRef = D2_Link ; Dof.Case.Link.Dof = NULL ; Tree_Add(CurrentDofData->DofTree, &Dof) ; } } } void Dof_DefineLinkCplxDof(int D1, int D2, int NbrHar, double Value[], int D2_Link) { struct Dof Dof ; int k ; Dof.NumType = D1 ; Dof.Entity = D2 ; for(k=0 ; kDofTree, &Dof)) { Dof.Type = DOF_LINKCPLX ; Dof.Case.Link.Coef = Value[0] ; Dof.Case.Link.Coef2 = Value[1] ; Dof.Case.Link.EntityRef = D2_Link ; Dof.Case.Link.Dof = NULL ; Tree_Add(CurrentDofData->DofTree, &Dof) ; } } } /* ------------------------------------------------------------------------ */ /* D o f _ D e f i n e U n k n o w n D o f */ /* ------------------------------------------------------------------------ */ void Dof_DefineUnknownDof(int D1, int D2, int NbrHar, bool NonLocal) { struct Dof Dof ; int k ; Dof.NumType = D1 ; Dof.Entity = D2 ; for(k=0 ; kDofTree, &Dof)) { Dof.Type = DOF_UNKNOWN ; /* Dof.Case.Unknown.NumDof = ++(CurrentDofData->NbrDof) ; */ Dof.Case.Unknown.NumDof = -1 ; Dof.Case.Unknown.NonLocal = NonLocal ; Tree_Add(CurrentDofData->DofTree, &Dof) ; } } } static void NumberUnknownDof (void *a, void *b) { struct Dof * Dof_P ; Dof_P = (struct Dof *)a ; if(Dof_P->Type == DOF_UNKNOWN){ if(Dof_P->Case.Unknown.NumDof == -1) Dof_P->Case.Unknown.NumDof = ++(CurrentDofData->NbrDof) ; if(Dof_P->Case.Unknown.NonLocal) CurrentDofData->NonLocalEquations.push_back(Dof_P->Case.Unknown.NumDof); } } void Dof_NumberUnknownDof(void) { if(CurrentDofData->DofTree) Tree_Action(CurrentDofData->DofTree, NumberUnknownDof) ; else List_Action(CurrentDofData->DofList, NumberUnknownDof) ; } /* ------------------------------------------------------------------------ */ /* D o f _ D e f i n e A s s o c i a t e D o f */ /* ------------------------------------------------------------------------ */ void Dof_DefineAssociateDof(int E1, int E2, int D1, int D2, int NbrHar, int init, double *Val) { struct Dof Dof, Equ, * Equ_P ; int k ; Equ.NumType = E1 ; Equ.Entity = E2 ; for(k=0 ; kDofTree, &Equ))) { switch (Equ_P->Type) { case DOF_FIXED : Equ_P->Type = DOF_FIXEDWITHASSOCIATE ; Equ_P->Case.FixedAssociate.NumDof = ++(CurrentDofData->NbrDof) ; /* To be modified (Patrick): strange to define a new NumDof for Equ if associate-Dof already exists */ Dof.NumType = D1 ; Dof.Entity = D2 ; Dof.Harmonic = k ; if (!Tree_PQuery(CurrentDofData->DofTree, &Dof)) { if (!init) { Dof.Type = DOF_UNKNOWN ; } else { Dof.Type = DOF_UNKNOWN_INIT ; LinAlg_SetScalar(&Dof.Val, &Val[k]) ; LinAlg_ZeroScalar(&Dof.Val2) ; } Dof.Case.Unknown.NumDof = CurrentDofData->NbrDof ; Dof.Case.Unknown.NonLocal = true ; Tree_Add(CurrentDofData->DofTree, &Dof) ; } break ; case DOF_FIXED_SOLVE : Equ_P->Type = DOF_FIXEDWITHASSOCIATE_SOLVE ; Equ_P->Case.FixedAssociate.NumDof = ++(CurrentDofData->NbrDof) ; Dof.NumType = D1 ; Dof.Entity = D2 ; Dof.Harmonic = k ; if (!Tree_PQuery(CurrentDofData->DofTree, &Dof)) { if (!init) { Dof.Type = DOF_UNKNOWN ; } else { Dof.Type = DOF_UNKNOWN_INIT ; LinAlg_SetScalar(&Dof.Val, &Val[k]) ; LinAlg_ZeroScalar(&Dof.Val2) ; } Dof.Case.Unknown.NumDof = CurrentDofData->NbrDof ; Dof.Case.Unknown.NonLocal = true ; Tree_Add(CurrentDofData->DofTree, &Dof) ; } break ; case DOF_UNKNOWN : case DOF_UNKNOWN_INIT : Dof_DefineUnknownDof(D1, D2, NbrHar) ; break ; } } } } /* ------------------------------------------------------------------------ */ /* P R O C E S S I N G ( C o d e s i n L i s t ) */ /* ------------------------------------------------------------------------ */ /* ------------------------------------------------------------------------ */ /* D o f _ G e t D o f S t r u c t */ /* ------------------------------------------------------------------------ */ struct Dof *Dof_GetDofStruct(struct DofData * DofData_P, int D1, int D2, int D3) { struct Dof Dof ; Dof.NumType = D1 ; Dof.Entity = D2 ; Dof.Harmonic = D3 ; return (struct Dof *)List_PQuery(DofData_P->DofList, &Dof, fcmp_Dof); } /* ------------------------------------------------------------------------ */ /* D o f _ U p d a t e A s s i g n F i x e d D o f */ /* ------------------------------------------------------------------------ */ void Dof_UpdateAssignFixedDof(int D1, int D2, int NbrHar, double *Val) { struct Dof Dof, * Dof_P ; int k ; Dof.NumType = D1 ; Dof.Entity = D2 ; for(k=0 ; kDofTree) Dof_P = (struct Dof *)Tree_PQuery(CurrentDofData->DofTree, &Dof); else Dof_P = (struct Dof *)List_PQuery(CurrentDofData->DofList, &Dof, fcmp_Dof); LinAlg_SetScalar(&Dof_P->Val, &Val[Dof_P->Harmonic]) ; } } /* ------------------------------------------------------------------------ */ /* D o f _ U p d a t e L i n k D o f */ /* ------------------------------------------------------------------------ */ void Dof_UpdateLinkDof(int D1, int D2, int NbrHar, double Value[], int D2_Link) { struct Dof Dof, * Dof_P ; int k ; Dof.NumType = D1 ; Dof.Entity = D2 ; for(k=0 ; kDofTree) Dof_P = (struct Dof *)Tree_PQuery(CurrentDofData->DofTree, &Dof); else Dof_P = (struct Dof *)List_PQuery(CurrentDofData->DofList, &Dof, fcmp_Dof); if (Dof_P->Type == DOF_LINK || Dof_P->Type == DOF_LINKCPLX) { /* fprintf(stderr,"===> %d %d %.16g\n", Dof_P->NumType, Dof_P->Entity, Value[0]) ; */ Dof_P->Case.Link.Coef = Value[0] ; if (Dof_P->Type == DOF_LINKCPLX) Dof_P->Case.Link.Coef2 = Value[1] ; Dof_P->Case.Link.EntityRef = D2_Link ; Dof_P->Case.Link.Dof = NULL ; } } } /* ------------------------------------------------------------------------ */ /* D o f _ A s s e m b l e I n M a t */ /* ------------------------------------------------------------------------ */ void Dof_AssembleInMat(struct Dof * Equ_P, struct Dof * Dof_P, int NbrHar, double * Val, gMatrix * Mat, gVector * Vec, List_T * Vecs) { gScalar tmp, tmp2 ; double valtmp[2], d1, d2 ; switch (Equ_P->Type) { case DOF_UNKNOWN : case DOF_FIXEDWITHASSOCIATE : switch (Dof_P->Type) { case DOF_UNKNOWN : if(Current.DofData->Flag_RHS) break; if(NbrHar==1){ LinAlg_AddDoubleInMatrix (Val[0], Mat, Equ_P->Case.Unknown.NumDof-1, Dof_P->Case.Unknown.NumDof-1) ; } else LinAlg_AddComplexInMatrix (Val[0], Val[1], Mat, Equ_P->Case.Unknown.NumDof-1, Dof_P->Case.Unknown.NumDof-1, (gSCALAR_SIZE==1)?((Equ_P+1)->Case.Unknown.NumDof-1):-1, (gSCALAR_SIZE==1)?((Dof_P+1)->Case.Unknown.NumDof-1):-1) ; break ; case DOF_FIXED : case DOF_FIXEDWITHASSOCIATE : if(Vec){ if(NbrHar==1){ if(Val[0]){ LinAlg_ProdScalarDouble (&Dof_P->Val, CurrentDofData->CurrentSolution-> TimeFunctionValues[Dof_P->Case.FixedAssociate.TimeFunctionIndex], &tmp); LinAlg_ProdScalarDouble(&tmp, -Val[0], &tmp) ; LinAlg_AddScalarInVector(&tmp, Vec, Equ_P->Case.Unknown.NumDof-1) ; if(Vecs){ // experimental int index = List_ISearchSeq(Current.DofData->TimeFunctionIndex, &Dof_P->Case.FixedAssociate.TimeFunctionIndex, fcmp_int); if(index >= 0 && index < List_Nbr(Vecs)){ gVector *v = (gVector*)List_Pointer(Vecs, index); LinAlg_AddScalarInVector(&tmp, v, Equ_P->Case.Unknown.NumDof-1) ; } else{ Message::Error("Something wrong in multi-vec assembly"); } } } } else{ LinAlg_ProdScalarDouble (&Dof_P->Val, CurrentDofData->CurrentSolution-> TimeFunctionValues[Dof_P->Case.FixedAssociate.TimeFunctionIndex], &tmp); if(gSCALAR_SIZE == 2){ LinAlg_ProdScalarComplex(&tmp, -Val[0], -Val[1], &valtmp[0], &valtmp[1]) ; } else{ LinAlg_GetDoubleInScalar(&d1, &tmp); LinAlg_ProdScalarDouble (&(Dof_P+1)->Val, CurrentDofData->CurrentSolution-> TimeFunctionValues[Dof_P->Case.FixedAssociate.TimeFunctionIndex], &tmp2); LinAlg_GetDoubleInScalar(&d2, &tmp2); valtmp[0] = -d1*Val[0] + d2*Val[1] ; valtmp[1] = -d1*Val[1] - d2*Val[0] ; } LinAlg_AddComplexInVector (valtmp[0], valtmp[1], Vec, Equ_P->Case.Unknown.NumDof-1, (gSCALAR_SIZE==1)?((Equ_P+1)->Case.Unknown.NumDof-1):-1) ; } } break ; case DOF_LINK : if(NbrHar==1) valtmp[0] = Val[0] * Dof_P->Case.Link.Coef ; else{ valtmp[0] = Val[0] * Dof_P->Case.Link.Coef ; valtmp[1] = Val[1] * Dof_P->Case.Link.Coef ; } Dof_AssembleInMat(Equ_P, Dof_P->Case.Link.Dof, NbrHar, valtmp, Mat, Vec, Vecs) ; break ; case DOF_LINKCPLX : if(NbrHar==1) Message::Error("LinkCplx only valid for Complex systems") ; else{ valtmp[0] = Val[0] * Dof_P->Case.Link.Coef - Val[1] * Dof_P->Case.Link.Coef2 ; valtmp[1] = Val[1] * Dof_P->Case.Link.Coef + Val[0] * Dof_P->Case.Link.Coef2 ; } Dof_AssembleInMat(Equ_P, Dof_P->Case.Link.Dof, NbrHar, valtmp, Mat, Vec, Vecs) ; break ; case DOF_FIXED_SOLVE : case DOF_FIXEDWITHASSOCIATE_SOLVE : Message::Error("Wrong Constraints: " "remaining Dof(s) waiting to be fixed by a Resolution"); break; case DOF_UNKNOWN_INIT : Message::Error("Wrong Initial Constraints: " "remaining Dof(s) with non-fixed initial conditions"); break; } break ; case DOF_LINK : if(NbrHar==1) valtmp[0] = Val[0] * Equ_P->Case.Link.Coef ; else{ valtmp[0] = Val[0] * Equ_P->Case.Link.Coef ; valtmp[1] = Val[1] * Equ_P->Case.Link.Coef ; } Dof_AssembleInMat(Equ_P->Case.Link.Dof, Dof_P, NbrHar, valtmp, Mat, Vec, Vecs) ; break ; case DOF_LINKCPLX : if(NbrHar==1) Message::Error("LinkCplx only valid for Complex systems") ; else{ /* Warning: conjugate! */ valtmp[0] = Val[0] * Equ_P->Case.Link.Coef + Val[1] * Equ_P->Case.Link.Coef2 ; valtmp[1] = Val[1] * Equ_P->Case.Link.Coef - Val[0] * Equ_P->Case.Link.Coef2 ; } Dof_AssembleInMat(Equ_P->Case.Link.Dof, Dof_P, NbrHar, valtmp, Mat, Vec, Vecs) ; break ; } } /* ------------------------------------------------------------------------ */ /* D o f _ A s s e m b l e I n V e c */ /* ------------------------------------------------------------------------ */ void Dof_AssembleInVec(struct Dof * Equ_P, struct Dof * Dof_P, int NbrHar, double * Val, struct Solution * OtherSolution, gVector * Vec0, gVector * Vec) { gScalar tmp ; double valtmp[2] ; double a, b, c, d ; switch (Equ_P->Type) { case DOF_UNKNOWN : case DOF_FIXEDWITHASSOCIATE : switch (Dof_P->Type) { case DOF_UNKNOWN : if(NbrHar==1){ if(Val[0]){ LinAlg_GetDoubleInVector(&a, Vec0, Dof_P->Case.Unknown.NumDof-1) ; a *= Val[0] ; LinAlg_AddDoubleInVector(a, Vec, Equ_P->Case.Unknown.NumDof-1) ; } } else{ LinAlg_GetComplexInVector(&a, &b, Vec0, Dof_P->Case.Unknown.NumDof-1, (gSCALAR_SIZE==1)?((Dof_P+1)->Case.Unknown.NumDof-1):-1) ; c = a * Val[0] - b * Val[1] ; d = a * Val[1] + b * Val[0] ; LinAlg_AddComplexInVector(c, d, Vec, Equ_P->Case.Unknown.NumDof-1, (gSCALAR_SIZE==1)?((Equ_P+1)->Case.Unknown.NumDof-1):-1) ; } break ; case DOF_FIXED : case DOF_FIXEDWITHASSOCIATE : if(NbrHar==1){ if(Val[0]){ LinAlg_ProdScalarDouble (&Dof_P->Val, Val[0] * OtherSolution-> TimeFunctionValues[Dof_P->Case.FixedAssociate.TimeFunctionIndex], &tmp) ; LinAlg_AddScalarInVector(&tmp, Vec, Equ_P->Case.Unknown.NumDof-1) ; } } else{ if(gSCALAR_SIZE == 2){ LinAlg_ProdScalarComplex (&Dof_P->Val, Val[0] * OtherSolution-> TimeFunctionValues[Dof_P->Case.FixedAssociate.TimeFunctionIndex], Val[1] * OtherSolution-> TimeFunctionValues[Dof_P->Case.FixedAssociate.TimeFunctionIndex], &a, &b) ; LinAlg_AddComplexInVector(a, b, Vec, Equ_P->Case.Unknown.NumDof-1, (gSCALAR_SIZE==1)?((Equ_P+1)->Case.Unknown.NumDof-1):-1) ; } else{ Message::Error("Assemby in vectors with more than one harmonic not yet implemented") ; } } break ; case DOF_LINK : if(NbrHar==1) valtmp[0] = Val[0] * Dof_P->Case.Link.Coef ; else{ valtmp[0] = Val[0] * Dof_P->Case.Link.Coef ; valtmp[1] = Val[1] * Dof_P->Case.Link.Coef ; } Dof_AssembleInVec(Equ_P, Dof_P->Case.Link.Dof, NbrHar, valtmp, OtherSolution, Vec0, Vec) ; break ; case DOF_LINKCPLX : if(NbrHar==1) Message::Error("LinkCplx only valid for Complex systems") ; else{ valtmp[0] = Val[0] * Dof_P->Case.Link.Coef - Val[1] * Dof_P->Case.Link.Coef2 ; valtmp[1] = Val[1] * Dof_P->Case.Link.Coef + Val[0] * Dof_P->Case.Link.Coef2 ; } Dof_AssembleInVec(Equ_P, Dof_P->Case.Link.Dof, NbrHar, valtmp, OtherSolution, Vec0, Vec) ; break ; case DOF_FIXED_SOLVE : case DOF_FIXEDWITHASSOCIATE_SOLVE : Message::Error("Wrong Constraints: " "remaining Dof(s) waiting to be fixed by a Resolution"); break; case DOF_UNKNOWN_INIT : Message::Error("Wrong Initial Constraints: " "remaining Dof(s) with non-fixed initial conditions"); break; } break ; case DOF_LINK : if(NbrHar==1) valtmp[0] = Val[0] * Equ_P->Case.Link.Coef ; else{ valtmp[0] = Val[0] * Equ_P->Case.Link.Coef ; valtmp[1] = Val[1] * Equ_P->Case.Link.Coef ; } Dof_AssembleInVec(Equ_P->Case.Link.Dof, Dof_P, NbrHar, valtmp, OtherSolution, Vec0, Vec) ; break ; case DOF_LINKCPLX : if(NbrHar==1) Message::Error("LinkCplx only valid for Complex systems") ; else{ /* Warning: conjugate! */ valtmp[0] = Val[0] * Equ_P->Case.Link.Coef + Val[1] * Equ_P->Case.Link.Coef2 ; valtmp[1] = Val[1] * Equ_P->Case.Link.Coef - Val[0] * Equ_P->Case.Link.Coef2 ; } Dof_AssembleInVec(Equ_P->Case.Link.Dof, Dof_P, NbrHar, valtmp, OtherSolution, Vec0, Vec) ; break ; } } /* ------------------------------------------------------------------------ */ /* D o f _ T r a n s f e r S o l u t i o n T o C o n s t r a i n t */ /* ------------------------------------------------------------------------ */ void Dof_TransferSolutionToConstraint(struct DofData * DofData_P) { struct Dof * Dof_P, * Dof_P0 ; int i ; if (!DofData_P->NbrAnyDof){ return; } Dof_P0 = (struct Dof *)List_Pointer(DofData_P->DofList, 0) ; for (i = 0 ; i < DofData_P->NbrAnyDof ; i++) { Dof_P = Dof_P0 + i ; switch (Dof_P->Type) { case DOF_UNKNOWN : Dof_P->Type = DOF_FIXED ; LinAlg_GetScalarInVector(&Dof_P->Val, &DofData_P->CurrentSolution->x, Dof_P->Case.Unknown.NumDof-1) ; Dof_P->Case.FixedAssociate.TimeFunctionIndex = 0 ; break ; case DOF_FIXED : case DOF_FIXEDWITHASSOCIATE : case DOF_LINK : case DOF_LINKCPLX : break ; default : break ; } } DofData_P->NbrDof = 0 ; } /* ------------------------------------------------------------------------ */ /* D o f _ G e t D o f V a l u e */ /* ------------------------------------------------------------------------ */ gScalar Dof_GetDofValue(struct DofData * DofData_P, struct Dof * Dof_P) { gScalar tmp ; switch (Dof_P->Type) { case DOF_UNKNOWN : if(!DofData_P->CurrentSolution->SolutionExist) Message::Error("Empty solution in DofData %d", DofData_P->Num); else LinAlg_GetScalarInVector(&tmp, &DofData_P->CurrentSolution->x, Dof_P->Case.Unknown.NumDof-1) ; break ; case DOF_FIXED : case DOF_FIXEDWITHASSOCIATE : LinAlg_ProdScalarDouble(&Dof_P->Val, ((Dof_P->Case.FixedAssociate.TimeFunctionIndex)? DofData_P->CurrentSolution->TimeFunctionValues [Dof_P->Case.FixedAssociate.TimeFunctionIndex] : 1.), &tmp); break ; case DOF_LINK : tmp = Dof_GetDofValue(DofData_P, Dof_P->Case.Link.Dof) ; LinAlg_ProdScalarDouble(&tmp, Dof_P->Case.Link.Coef, &tmp) ; break ; case DOF_LINKCPLX : /* Too soon to treat LinkCplx: we need the real and imaginary parts */ Message::Error("Cannot call Dof_GetDofValue for LinkCplx"); break ; default : LinAlg_ZeroScalar(&tmp) ; break ; } return tmp ; } void Dof_GetRealDofValue(struct DofData * DofData_P, struct Dof * Dof_P, double *d) { gScalar tmp ; if (Dof_P->Type == DOF_LINKCPLX) { Message::Error("Cannot call Dof_GetRealDofValue for LinkCplx"); return; } tmp = Dof_GetDofValue(DofData_P, Dof_P) ; LinAlg_GetDoubleInScalar(d, &tmp) ; } void Dof_GetComplexDofValue(struct DofData * DofData_P, struct Dof * Dof_P, double *d1, double *d2) { gScalar tmp1, tmp2 ; double valtmp[2] ; if(gSCALAR_SIZE == 1){ if(Dof_P->Type == DOF_LINKCPLX) { /* Can only be done here */ if (Dof_P->Case.Link.Dof->Type == DOF_LINKCPLX) { /* recurse */ Dof_GetComplexDofValue(DofData_P, Dof_P->Case.Link.Dof, d1, d2); } else{ tmp1 = Dof_GetDofValue(DofData_P, Dof_P->Case.Link.Dof) ; tmp2 = Dof_GetDofValue(DofData_P, (Dof_P+1)->Case.Link.Dof) ; LinAlg_GetDoubleInScalar(d1, &tmp1) ; LinAlg_GetDoubleInScalar(d2, &tmp2) ; } } else{ tmp1 = Dof_GetDofValue(DofData_P, Dof_P) ; tmp2 = Dof_GetDofValue(DofData_P, Dof_P+1) ; LinAlg_GetDoubleInScalar(d1, &tmp1) ; LinAlg_GetDoubleInScalar(d2, &tmp2) ; } } else{ if (Dof_P->Type == DOF_LINKCPLX) { /* Can only be done here */ if (Dof_P->Case.Link.Dof->Type == DOF_LINKCPLX) { /* recurse */ Dof_GetComplexDofValue(DofData_P, Dof_P->Case.Link.Dof, d1, d2); } else{ tmp1 = Dof_GetDofValue(DofData_P, Dof_P->Case.Link.Dof) ; LinAlg_GetComplexInScalar(d1, d2, &tmp1) ; } } else{ tmp1 = Dof_GetDofValue(DofData_P, Dof_P) ; LinAlg_GetComplexInScalar(d1, d2, &tmp1) ; } } if(Dof_P->Type == DOF_LINKCPLX){ valtmp[0] = Dof_P->Case.Link.Coef*(*d1) - Dof_P->Case.Link.Coef2*(*d2) ; valtmp[1] = Dof_P->Case.Link.Coef*(*d2) + Dof_P->Case.Link.Coef2*(*d1) ; *d1 = valtmp[0] ; *d2 = valtmp[1] ; } } /* ------------------------------------------------------------------------- */ /* D o f _ D e f i n e Unknown D o f F r o m Solve o r Init D o f */ /* ------------------------------------------------------------------------- */ void Dof_DefineUnknownDofFromSolveOrInitDof(struct DofData ** DofData_P) { int i, Nbr_AnyDof ; struct Dof * Dof_P ; Nbr_AnyDof = List_Nbr((*DofData_P)->DofList) ; for(i = 0 ; i < Nbr_AnyDof ; i++) { Dof_P = (struct Dof*)List_Pointer((*DofData_P)->DofList, i) ; switch (Dof_P->Type) { case DOF_FIXED_SOLVE : case DOF_FIXEDWITHASSOCIATE_SOLVE : Dof_P->Type = DOF_UNKNOWN ; Dof_P->Case.Unknown.NumDof = ++((*DofData_P)->NbrDof) ; break ; case DOF_UNKNOWN_INIT : Dof_P->Type = DOF_UNKNOWN ; break ; } } } /* ------------------------------------------------------------------------ */ /* D o f _ T r a n s f e r D o f */ /* ------------------------------------------------------------------------ */ void Dof_TransferDof(struct DofData * DofData_P1, struct DofData ** DofData_P2) { int i, Nbr_AnyDof ; struct Dof Dof, * Dof_P ; struct Solution * Solutions_P0 ; Nbr_AnyDof = List_Nbr(DofData_P1->DofList) ; Solutions_P0 = (struct Solution*)List_Pointer(DofData_P1->Solutions, 0) ; DofData_P1->CurrentSolution = Solutions_P0 ; for(i = 0; i < Nbr_AnyDof; i++) { Dof = *(struct Dof *)List_Pointer(DofData_P1->DofList, i) ; if((Dof_P = (struct Dof*)Tree_PQuery((*DofData_P2)->DofTree, &Dof))){ switch (Dof_P->Type) { case DOF_FIXED_SOLVE : Dof_P->Type = DOF_FIXED ; Dof_P->Val = Dof_GetDofValue(DofData_P1, &Dof) ; break ; case DOF_FIXEDWITHASSOCIATE_SOLVE : Dof_P->Type = DOF_FIXEDWITHASSOCIATE ; Dof_P->Val = Dof_GetDofValue(DofData_P1, &Dof) ; break ; case DOF_UNKNOWN_INIT : /* A DOF_UNKNOWN_INIT will always use the value obtained by pre-resolution even if a simple Init contraint is given; we should introduce DOF_UNKNOWN_INIT_SOLVE */ Dof_P->Val = Dof_GetDofValue(DofData_P1, &Dof) ; if((DofData_P1->CurrentSolution - Solutions_P0) > 0){ DofData_P1->CurrentSolution -= 1 ; Dof_P->Val2 = Dof_GetDofValue(DofData_P1, &Dof) ; DofData_P1->CurrentSolution += 1 ; } else{ LinAlg_ZeroScalar(&Dof_P->Val2); } break ; } } } } /* ------------------------------------------------------------------------ */ /* D o f _ I n i t D o f F o r N o D o f */ /* ------------------------------------------------------------------------ */ void Dof_InitDofForNoDof(struct Dof * DofForNoDof, int NbrHar) { int k ; double Val[2] = {1.,0.} ; for (k=0 ; kType){ case DOF_UNKNOWN : printf("%d(%d) ", Dof_P->Case.Unknown.NumDof, Dof_P->Entity) ; break ; case DOF_FIXED : printf("Fixed(%d) ", Dof_P->Entity) ; break ; case DOF_FIXEDWITHASSOCIATE : printf("Assoc-%d ", Dof_P->Case.FixedAssociate.NumDof) ; break ; case DOF_LINK : printf("Link-"); Print_DofNumber(Dof_P->Case.Link.Dof); break ; case DOF_LINKCPLX : printf("LinkCplx-"); Print_DofNumber(Dof_P->Case.Link.Dof); break ; default : printf(" ? ") ; break ; } } /* ------------------------------------------------------- */ /* D u m m y D o f s */ /* ------------------------------------------------------- */ void Dof_GetDummies(struct DefineSystem * DefineSystem_P, struct DofData * DofData_P) { struct Formulation * Formulation_P ; struct DefineQuantity * DefineQuantity_P ; struct FunctionSpace * FunctionSpace_P ; struct BasisFunction * BasisFunction_P ; struct GlobalQuantity * GlobalQuantity_P ; struct Dof * Dof_P ; int i, j, k, l, iDof, ii, iit, iNum, iHar; int Nbr_Formulation, Index_Formulation ; int *DummyDof; double FrequencySpectrum, *Val_Pulsation; if (!(Val_Pulsation = Current.DofData->Val_Pulsation)){ Message::Error("Dof_GetDummies can only be used for harmonic problems"); return; } DummyDof = DofData_P->DummyDof = (int *)Malloc(DofData_P->NbrDof*sizeof(int)); for (iDof = 0 ; iDof < DofData_P->NbrDof ; iDof++) DummyDof[iDof]=0; Nbr_Formulation = List_Nbr(DefineSystem_P->FormulationIndex) ; for (i = 0 ; i < Nbr_Formulation ; i++) { List_Read(DefineSystem_P->FormulationIndex, i, &Index_Formulation) ; Formulation_P = (struct Formulation*) List_Pointer(Problem_S.Formulation, Index_Formulation) ; for (j = 0 ; j < List_Nbr(Formulation_P->DefineQuantity) ; j++) { DefineQuantity_P = (struct DefineQuantity*) List_Pointer(Formulation_P->DefineQuantity, j) ; for (l = 0 ; l < List_Nbr(DefineQuantity_P->FrequencySpectrum) ; l++) { FrequencySpectrum = *(double *)List_Pointer(DefineQuantity_P->FrequencySpectrum, l) ; iHar=-1; for (k = 0 ; k < Current.NbrHar/2 ; k++) if (fabs(Val_Pulsation[k]-TWO_PI*FrequencySpectrum) <= 1e-10*Val_Pulsation[k]) { iHar = 2*k; break; } if(iHar>=0) { FunctionSpace_P = (struct FunctionSpace*) List_Pointer(Problem_S.FunctionSpace, DefineQuantity_P->FunctionSpaceIndex) ; for (k = 0 ; k < List_Nbr(FunctionSpace_P->BasisFunction) ; k++) { BasisFunction_P = (struct BasisFunction *) List_Pointer(FunctionSpace_P->BasisFunction, k) ; iNum = ((struct BasisFunction *)BasisFunction_P)->Num; ii=iit=0; for (iDof = 0 ; iDof < List_Nbr(DofData_P->DofList) ; iDof++) { Dof_P = (struct Dof *)List_Pointer(DofData_P->DofList, iDof) ; if (Dof_P->Type == DOF_UNKNOWN && Dof_P->NumType == iNum) { iit++; if (Dof_P->Harmonic == iHar || Dof_P->Harmonic == iHar+1) { DummyDof[Dof_P->Case.Unknown.NumDof-1]=1; ii++; } } } if(ii) Message::Info("Freq %4lg (%d/%d) Formulation %s Quantity %s (BF %d) #DofsFreqSpectrum %d/%d", Val_Pulsation[iHar/2]/TWO_PI, iHar/2, Current.NbrHar/2, Formulation_P->Name, DefineQuantity_P->Name, ((struct BasisFunction *)BasisFunction_P)->Num, ii, iit) ; } for (k = 0 ; k < List_Nbr(FunctionSpace_P->GlobalQuantity) ; k++) { GlobalQuantity_P = (struct GlobalQuantity *) List_Pointer(FunctionSpace_P->GlobalQuantity, k) ; iNum = ((struct GlobalQuantity *)GlobalQuantity_P)->Num; ii=iit=0; for (iDof = 0 ; iDof < List_Nbr(DofData_P->DofList) ; iDof++) { Dof_P = (struct Dof *)List_Pointer(DofData_P->DofList, iDof) ; if (Dof_P->Type == DOF_UNKNOWN && Dof_P->NumType == iNum) { iit++; if (Dof_P->Harmonic == iHar || Dof_P->Harmonic == iHar+1) { DummyDof[Dof_P->Case.Unknown.NumDof-1]=1; ii++; } } } if(ii) Message::Info("Freq %4lg (%d/%d) Formulation %s GlobalQuantity %s (BF %d) #DofsWithSpectrum %d/%d", Val_Pulsation[iHar/2]/TWO_PI, iHar/2, Current.NbrHar/2, Formulation_P->Name, GlobalQuantity_P->Name, ((struct GlobalQuantity *)GlobalQuantity_P)->Num, ii, iit) ; } } /* end FrequencySpectrum in DofData */ } /* end FrequencySpectrum in Quantity */ } /* end Quantity */ } /* end Formulation */ i=0; for (iDof = 0 ; iDof < DofData_P->NbrDof ; iDof++) { if(DummyDof[iDof]) i++; if(Message::GetVerbosity() == 99){ Dof_P = (struct Dof *)List_Pointer(DofData_P->DofList, iDof) ; Message::Debug("Dof Num iHar, Entity %d %d %d", iDof, Dof_P->NumType, Dof_P->Harmonic, Dof_P->Entity); } } Message::Info("N: %d - N with FrequencySpectrum: %d", DofData_P->NbrDof, i) ; } getdp-2.7.0-source/Legacy/Pre_TermOfFemEquation.h000644 001750 001750 00000002563 12473553042 023331 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _PRE_TERM_OF_FEM_EQUATION_H_ #define _PRE_TERM_OF_FEM_EQUATION_H_ #include "ProData.h" void Pre_InitTermOfFemEquation(struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0); void Pre_TermOfFemEquation(struct Element * Element, struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0); void Pre_InitGlobalTermOfFemEquation(struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0); void Pre_GlobalTermOfFemEquation(int Num_Region, struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0); void Pre_FemGlobalEquation(struct EquationTerm * EquationTerm_P, struct DefineQuantity * DefineQuantity_P0, struct QuantityStorage * QuantityStorage_P0); void Cst_TermOfFemEquation(struct Element * Element, struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0); void Cst_GlobalTermOfFemEquation(int Num_Region, struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0); #endif getdp-2.7.0-source/Legacy/MainLegacy.h000644 001750 001750 00000000477 12473553042 021204 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _MAIN_LEGACY_H_ #define _MAIN_LEGACY_H_ int MainLegacy(int argc, char *argv[]); #endif getdp-2.7.0-source/Legacy/Get_ElementSource.cpp000644 001750 001750 00000007004 12473553042 023070 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "ProData.h" #include "GeoData.h" #include "ExtendedGroup.h" #include "Get_Geometry.h" #include "Message.h" extern struct Problem Problem_S ; extern struct CurrentData Current ; static int Nbr_ElementSource, i_ElementSource ; static List_T *RegionSource_L ; static struct Element ElementSource , ElementTrace; /* ------------------------------------------------------------------------ */ /* G e t _ I n i t E l e m e n t S o u r c e */ /* ------------------------------------------------------------------------ */ void Get_InitElementSource(struct Element *Element, int InIndex) { Element->ElementSource = &ElementSource ; Nbr_ElementSource = Geo_GetNbrGeoElements() ; i_ElementSource = -1 ; if(InIndex<0){ Message::Error("Missing support (Region Group) in Integral Quantity"); } else{ RegionSource_L = ((struct Group*) List_Pointer(Problem_S.Group, InIndex))->InitialList ; Current.SourceIntegrationSupportIndex = InIndex ; } } /* ------------------------------------------------------------------------ */ /* G e t _ N e x t E l e m e n t S o u r c e */ /* ------------------------------------------------------------------------ */ int Get_NextElementSource(struct Element *ElementSource) { while (++i_ElementSource < Nbr_ElementSource) { ElementSource->GeoElement = Geo_GetGeoElement(i_ElementSource) ; ElementSource->Region = ElementSource->GeoElement->Region ; if (List_Search(RegionSource_L, &ElementSource->Region, fcmp_int)) { ElementSource->Num = ElementSource->GeoElement->Num ; ElementSource->Type = ElementSource->GeoElement->Type ; return(1) ; } } return(0) ; } /* ------------------------------------------------------------------------ */ /* G e t _ E l e m e n t S o u r c e I n t e r p o l a t i o n */ /* ------------------------------------------------------------------------ */ int Get_ElementSourceInterpolation(struct Element *ElementSource, struct PostSubOperation *PostSubOperation) { return(0) ; } /* ------------------------------------------------------------------------ */ /* G e t _ E l e m e n t T r a c e */ /* ------------------------------------------------------------------------ */ void Get_ElementTrace(struct Element *Element, int InIndex) { struct Group * Group_P ; struct TwoInt * Pair_P ; Element->ElementTrace = &ElementTrace ; Group_P = (struct Group*)List_Pointer(Problem_S.Group, InIndex) ; if (!Group_P->ExtendedList) Generate_ExtendedGroup(Group_P) ; if(!(Pair_P = (struct TwoInt*)List_PQuery(Group_P->ExtendedList, &Element->Num, fcmp_int))) Message::Error("No Element connected to Element %d: check Group for Trace", Element->Num) ; Element->ElementTrace = &ElementTrace ; Element->ElementTrace->GeoElement = Geo_GetGeoElement(Pair_P->Int2) ; Element->ElementTrace->Region = Element->ElementTrace->GeoElement->Region ; Element->ElementTrace->Num = Element->ElementTrace->GeoElement->Num ; Element->ElementTrace->Type = Element->ElementTrace->GeoElement->Type ; Get_NodesCoordinatesOfElement(Element->ElementTrace) ; Message::Debug("Element %d -> Trace %d", Element->Num, Element->ElementTrace->Num); } getdp-2.7.0-source/Legacy/GeoEntity.h000644 001750 001750 00000037050 12473553042 021077 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _GEO_ENTITY_H_ #define _GEO_ENTITY_H_ /* Incidence Matrices : Den (EdgesXNodes), Dfe (FacetsXEdges) */ /* Xp stands for 'expanded' (used in discrete operators) */ /* ------------------------------------------------------------------------ POINT v | | -----1-----u | | ------------------------------------------------------------------------ */ static int NbrNodes_Point = 1 ; static int NbrEdges_Point = 0 ; static int NbrFacets_Point = 0 ; static double Nodes_Point [][3] = { {0., 0., 0.} } ; /* ------------------------------------------------------------------------ LINE edge 1: nodes 1 -> 2 v | | --1-----2--u | | ------------------------------------------------------------------------ */ static int NbrNodes_Line = 2 ; static int NbrEdges_Line = 1 ; static int NbrFacets_Line = 0 ; static double Nodes_Line [][3] = { {-1., 0., 0.} , {1., 0., 0.,} } ; static int Den_Line [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, -2, 0} } ; static int Den_Line_Xp [] = { -1, 1 } ; /* ------------------------------------------------------------------------ LINE_2 edge 1: nodes 1 -> 2 v | | --1--3--2--u | | ------------------------------------------------------------------------ */ static int NbrNodes_Line_2 = 3 ; static int NbrEdges_Line_2 = 1 ; static int NbrFacets_Line_2 = 0 ; static double Nodes_Line_2 [][3] = { {-1., 0., 0.} , {1., 0., 0.,} , {0., 0., 0.,} } ; static int Den_Line_2 [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, -2, 0} } ; static int Den_Line_2_Xp [] = { -1, 1 } ; /* ------------------------------------------------------------------------ TRIANGLE edge 1: nodes 1 -> 2 v 2: 1 -> 3 | 3: 2 -> 3 | 3 facet 1: edges 1 -2 3 nodes 1 2 3 |\ | \ |__\___u 1 2 ------------------------------------------------------------------------ */ static int NbrNodes_Triangle = 3 ; static int NbrEdges_Triangle = 3 ; static int NbrFacets_Triangle = 1 ; static double Nodes_Triangle [][3] = { {0., 0., 0.} , {1., 0., 0.} , {0., 1., 0.} } ; static int Den_Triangle [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, -2, 0}, { 1, -3, 0}, { 2, -3, 0} } ; static int Den_Triangle_Xp [] = { -1, 1, 0, -1, 0, 1, 0,-1, 1 } ; static int Dfe_Triangle [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, 3, -2, 0} } ; static int Dfe_Triangle_Xp [] = { 1,-1, 1 } ; static int Dfn_Triangle [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, 2, 3, 0} } ; /* ------------------------------------------------------------------------ TRIANGLE_2 edge 1: nodes 1 -> 2 v 2: 1 -> 3 | 3: 2 -> 3 | 3 facet 1: edges 1 -2 3 nodes 1 2 3 |\ 6 5 |__\___u 1 4 2 ------------------------------------------------------------------------ */ static int NbrNodes_Triangle_2 = 6 ; static int NbrEdges_Triangle_2 = 3 ; static int NbrFacets_Triangle_2 = 1 ; static double Nodes_Triangle_2 [][3] = { {0., 0., 0.} , {1., 0., 0.} , {0., 1., 0.} , {0.5, 0., 0.} , {0.5, 0.5, 0.} , {0., 0.5, 0.} } ; static int Den_Triangle_2 [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, -2, 0}, { 1, -3, 0}, { 2, -3, 0} } ; static int Den_Triangle_2_Xp [] = { -1, 1, 0, -1, 0, 1, 0,-1, 1 } ; static int Dfe_Triangle_2 [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, 3, -2, 0} } ; static int Dfe_Triangle_2_Xp [] = { 1,-1, 1 } ; static int Dfn_Triangle_2 [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, 2, 3, 0} } ; /* ------------------------------------------------------------------------ QUADRANGLE edge 1: nodes 1 -> 2 v 2: 1 -> 4 | 3: 2 -> 3 4--|--3 4: 3 -> 4 | | | -----------u facet 1: edges 1 -2 3 4 nodes 1 2 3 4 | | | 1--|--2 | ------------------------------------------------------------------------ */ static int NbrNodes_Quadrangle = 4 ; static int NbrEdges_Quadrangle = 4 ; static int NbrFacets_Quadrangle = 1 ; static double Nodes_Quadrangle [][3] = { {-1., -1., 0.} , {1., -1., 0.} , { 1., 1., 0.} , {-1., 1., 0.} } ; static int Den_Quadrangle [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, -2, 0}, { 1, -4, 0}, { 2, -3, 0}, { 3, -4, 0} } ; static int Den_Quadrangle_Xp [] = { -1, 1, 0, 0, -1, 0, 0, 1, 0,-1, 1, 0, 0, 0,-1, 1 } ; static int Dfe_Quadrangle [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, 3, 4, -2, 0} } ; static int Dfe_Quadrangle_Xp [] = { 1,-1, 1, 1 } ; static int Dfn_Quadrangle [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, 2, 3, 4, 0} } ; /* ------------------------------------------------------------------------ QUADRANGLE_2 edge 1: nodes 1 -> 2 v 2: 1 -> 4 | 3: 2 -> 3 4--7--3 4: 3 -> 4 | | | --8--9--6--u facet 1: edges 1 -2 3 4 nodes 1 2 3 4 | | | 1--5--2 | ------------------------------------------------------------------------ */ static int NbrNodes_Quadrangle_2 = 9 ; static int NbrEdges_Quadrangle_2 = 4 ; static int NbrFacets_Quadrangle_2 = 1 ; static double Nodes_Quadrangle_2 [][3] = { {-1., -1., 0.} , { 1.,-1., 0.} , { 1., 1., 0.} , {-1., 1., 0.} , { 0., -1., 0.} , { 1., 0., 0.} , { 0., 1., 0.} , {-1., 0., 0.} , { 0., 0., 0.} } ; static int Den_Quadrangle_2 [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, -2, 0}, { 1, -4, 0}, { 2, -3, 0}, { 3, -4, 0} } ; static int Den_Quadrangle_2_Xp [] = { -1, 1, 0, 0, -1, 0, 0, 1, 0,-1, 1, 0, 0, 0,-1, 1 } ; static int Dfe_Quadrangle_2 [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, 3, 4, -2, 0} } ; static int Dfe_Quadrangle_2_Xp [] = { 1,-1, 1, 1 } ; static int Dfn_Quadrangle_2 [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, 2, 3, 4, 0} } ; /* ------------------------------------------------------------------------ QUADRANGLE_2_8N edge 1: nodes 1 -> 3 v 2: 1 -> 7 | 3: 3 -> 5 7--6--5 4: 5 -> 7 | | | --8-----4--u facet 1: edges 1 -3 5 7 nodes 1 3 5 7 | | | 1--2--3 | ------------------------------------------------------------------------ */ static int NbrNodes_Quadrangle_2_8N = 8 ; static int NbrEdges_Quadrangle_2_8N = 4 ; static int NbrFacets_Quadrangle_2_8N = 1 ; static double Nodes_Quadrangle_2_8N [][3] = { {-1., -1., 0.} , { 1.,-1., 0.} , { 1., 1., 0.} , {-1., 1., 0.} , { 0., -1., 0.} , { 1., 0., 0.} , { 0., 1., 0.} , {-1., 0., 0.} , } ; static int Den_Quadrangle_2_8N [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, -2, 0}, { 1, -4, 0}, { 2, -3, 0}, { 3, -4, 0} } ; static int Den_Quadrangle_2_8N_Xp [] = { -1, 1, 0, 0, -1, 0, 0, 1, 0,-1, 1, 0, 0, 0,-1, 1 } ; static int Dfe_Quadrangle_2_8N [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, 3, 4, -2, 0} } ; static int Dfe_Quadrangle_2_8N_Xp [] = { 1,-1, 1, 1 } ; static int Dfn_Quadrangle_2_8N [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, 2, 3, 4, 0} } ; /* ------------------------------------------------------------------------ TETRAHEDRON edge 1: nodes 1 -> 2 v 2: 1 -> 3 | 3: 1 -> 4 | 4: 2 -> 3 | 5: 2 -> 4 3 6: 3 -> 4 |\ | \ facet 1: edges 1 -3 5 nodes 1 2 4 |__\2_____u 2: -1 2 -4 1 3 2 1\ / 3: -2 3 -6 1 4 3 \4 4: 4 -5 6 2 3 4 \ w ------------------------------------------------------------------------ */ static int NbrNodes_Tetrahedron = 4 ; static int NbrEdges_Tetrahedron = 6 ; static int NbrFacets_Tetrahedron = 4 ; static double Nodes_Tetrahedron [][3] = { {0., 0., 0.} , {1., 0., 0.}, {0., 1., 0.} , {0., 0., 1.} } ; static int Den_Tetrahedron [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, -2, 0}, { 1, -3, 0}, { 1, -4, 0}, { 2, -3, 0}, { 2, -4, 0}, { 3, -4, 0} } ; static int Den_Tetrahedron_Xp [] = { -1, 1, 0, 0, -1, 0, 1, 0, -1, 0, 0, 1, 0,-1, 1, 0, 0,-1, 0, 1, 0, 0,-1, 1 } ; static int Dfe_Tetrahedron [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, -3, 5, 0}, { -1, 2, -4, 0}, { -2, 3, -6, 0}, { 4, -5, 6, 0} } ; static int Dfe_Tetrahedron_Xp [] = { 1, 0,-1, 0, 1, 0, -1, 1, 0,-1, 0, 0, 0,-1, 1, 0, 0,-1, 0, 0, 0, 1,-1, 1 } ; static int Dfn_Tetrahedron [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, 2, 4, 0}, { 1, 3, 2, 0}, { 1, 4, 3, 0}, { 2, 3, 4, 0} } ; /* ------------------------------------------------------------------------ HEXAHEDRON edge 1: nodes 1 -> 2 v 2: 1 -> 4 | 3: 1 -> 5 | 4: 2 -> 3 4----|--3 5: 2 -> 6 |\ | |\ 6: 3 -> 4 | 8-------7 7: 3 -> 7 | | ----|---u 8: 4 -> 8 1-|---\-2 | 9: 5 -> 6 \| \ \| 10: 5 -> 8 5-----\-6 11: 6 -> 7 \ 12: 7 -> 8 w facet 1: edges 1 -3 5 -9 nodes 1 2 6 5 2: -1 2 -4 -6 1 4 3 2 3: -2 3 -8 10 1 5 8 4 4: 4 -5 7 -11 2 3 7 6 5: 6 -7 8 -12 3 4 8 7 6: 9 -10 11 12 5 6 7 8 ------------------------------------------------------------------------ */ static int NbrNodes_Hexahedron = 8 ; static int NbrEdges_Hexahedron = 12 ; static int NbrFacets_Hexahedron = 6 ; static double Nodes_Hexahedron [][3] = { {-1., -1., -1.} , {1., -1., -1.} , { 1., 1., -1.} , {-1., 1., -1.} , {-1., -1., 1.} , {1., -1., 1.} , { 1., 1., 1.} , {-1., 1., 1.} } ; static int Den_Hexahedron [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, -2, 0}, { 1, -4, 0}, { 1, -5, 0}, { 2, -3, 0}, { 2, -6, 0}, { 3, -4, 0}, { 3, -7, 0}, { 4, -8, 0}, { 5, -6, 0}, { 5, -8, 0}, { 6, -7, 0}, { 7, -8, 0} } ; static int Den_Hexahedron_Xp [] = { -1, 1, 0, 0, 0, 0, 0, 0, -1, 0, 0, 1, 0, 0, 0, 0, -1, 0, 0, 0, 1, 0, 0, 0, 0,-1, 1, 0, 0, 0, 0, 0, 0,-1, 0, 0, 0, 1, 0, 0, 0, 0,-1, 1, 0, 0, 0, 0, 0, 0,-1, 0, 0, 0, 1, 0, 0, 0, 0,-1, 0, 0, 0, 1, 0, 0, 0, 0,-1, 1, 0, 0, 0, 0, 0, 0,-1, 0, 0, 1, 0, 0, 0, 0, 0,-1, 1, 0, 0, 0, 0, 0, 0, 0,-1, 1 }; static int Dfe_Hexahedron [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, -3, 5, -9, 0}, {-1, 2, -4, -6, 0}, {-2, 3, -8, 10, 0}, { 4, -5, 7, -11, 0}, { 6, -7, 8, -12, 0}, { 9, -10, 11, 12, 0} } ; static int Dfe_Hexahedron_Xp [] = { 1, 0,-1, 0, 1, 0, 0, 0,-1, 0, 0, 0, -1, 1, 0,-1, 0,-1, 0, 0, 0, 0, 0, 0, 0,-1, 1, 0, 0, 0, 0,-1, 0, 1, 0, 0, 0, 0, 0, 1,-1, 0, 1, 0, 0, 0,-1, 0, 0, 0, 0, 0, 0, 1,-1, 1, 0, 0, 0,-1, 0, 0, 0, 0, 0, 0, 0, 0, 1,-1, 1, 1 }; static int Dfn_Hexahedron [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, 2, 6, 5, 0}, { 1, 4, 3, 2, 0}, { 1, 5, 8, 4, 0}, { 2, 3, 7, 6, 0}, { 3, 4, 8, 7, 0}, { 5, 6, 7, 8, 0} } ; /* ------------------------------------------------------------------------ PRISM edge 1: nodes 1 -> 2 v 2: 1 -> 3 3 | 3: 1 -> 4 |\| 4: 2 -> 3 | | 5: 2 -> 5 1_|2 6: 3 -> 6 \| 6 7: 4 -> 5 |_|_\___u 8: 4 -> 6 \| \ 9: 5 -> 6 4 __5 \ facet 1: edges 1 -3 5 -7 nodes 1 2 5 4 \ 2: -1 2 -4 1 3 2 w 3: -2 3 -6 8 1 4 6 3 4: 4 -5 6 -9 2 3 6 5 5: 7 -8 9 4 5 6 ------------------------------------------------------------------------ */ static int NbrNodes_Prism = 6 ; static int NbrEdges_Prism = 9 ; static int NbrFacets_Prism = 5 ; static double Nodes_Prism [][3] = { {0., 0., -1.} , {1., 0., -1.} , {0., 1., -1.} , {0., 0., 1.} , {1., 0., 1.} , {0., 1., 1.} } ; static int Den_Prism [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, -2, 0}, { 1, -3, 0}, { 1, -4, 0}, { 2, -3, 0}, { 2, -5, 0}, { 3, -6, 0}, { 4, -5, 0}, { 4, -6, 0}, { 5, -6, 0} } ; static int Den_Prism_Xp [] = { -1, 1, 0, 0, 0, 0, -1, 0, 1, 0, 0, 0, -1, 0, 0, 1, 0, 0, 0,-1, 1, 0, 0, 0, 0,-1, 0, 0, 1, 0, 0, 0,-1, 0, 0, 1, 0, 0, 0,-1, 1, 0, 0, 0, 0,-1, 0, 1, 0, 0, 0, 0,-1, 1 }; static int Dfe_Prism [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, -3, 5, -7, 0}, { -1, 2, -4, 0}, { -2, 3, -6, 8, 0}, { 4, -5, 6, -9, 0}, { 7, -8, 9, 0} } ; static int Dfe_Prism_Xp [] = { 1, 0,-1, 0, 1, 0,-1, 0, 0, -1, 1, 0,-1, 0, 0, 0, 0, 0, 0,-1, 1, 0, 0,-1, 0, 1, 0, 0, 0, 0, 1,-1, 1, 0, 0,-1, 0, 0, 0, 0, 0, 0, 1,-1, 1 }; static int Dfn_Prism [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, 2, 5, 4, 0}, { 1, 3, 2, 0}, { 1, 4, 6, 3, 0}, { 2, 3, 6, 5, 0}, { 4, 5, 6, 0} } ; /* ------------------------------------------------------------------------ PYRAMID edge 1: nodes 1 -> 2 v 2: 1 -> 4 | 3: 1 -> 5 | 4: 2 -> 3 4---|---3 5: 2 -> 5 | \ | /| 6: 3 -> 4 | \ -/-|---u 7: 3 -> 5 | / 5\ | 8: 4 -> 5 1/----\-2 \ facet 1: edges 1 5 -3 nodes 1 2 5 \ 2: 2 -6 -4 -1 1 4 3 2 w 3: 3 -8 -2 1 5 4 4: 4 7 -5 2 3 5 5: 6 8 -7 3 4 5 ------------------------------------------------------------------------ */ static int NbrNodes_Pyramid = 5 ; static int NbrEdges_Pyramid = 8 ; static int NbrFacets_Pyramid = 5 ; static double Nodes_Pyramid [][3] = { {-1., -1., 0.} , { 1., -1., 0.} , { 1., 1., 0.} , {-1., 1., 0.} , { 0., 0., 1.} } ; static int Den_Pyramid [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, -2, 0}, { 1, -4, 0}, { 1, -5, 0}, { 2, -3, 0}, { 2, -5, 0}, { 3, -4, 0}, { 3, -5, 0}, { 4, -5, 0} } ; static int Den_Pyramid_Xp [] = { -1, 1, 0, 0, 0, -1, 0, 0, 1, 0, -1, 0, 0, 0, 1, 0,-1, 1, 0, 0, 0,-1, 0, 0, 1, 0, 0,-1, 1, 0, 0, 0,-1, 0, 1, 0, 0, 0,-1, 1 }; static int Dfe_Pyramid [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, 5, -3, 0}, { 2, -6, -4, -1, 0}, { 3, -8, -2, 0}, { 4, 7, -5, 0}, { 6, 8, -7, 0} } ; static int Dfe_Pyramid_Xp [] = { 1, 0,-1, 0, 1, 0, 0, 0, -1, 1, 0,-1, 0,-1, 0, 0, 0,-1, 1, 0, 0, 0, 0,-1, 0, 0, 0, 1,-1, 0, 1, 0, 0, 0, 0, 0, 0, 1,-1, 1 }; static int Dfn_Pyramid [] [NBR_MAX_SUBENTITIES_IN_ELEMENT] = { { 1, 2, 5, 0}, { 1, 4, 3, 2, 0}, { 1, 5, 4, 0}, { 2, 3, 5, 0}, { 3, 4, 5, 0} } ; #endif getdp-2.7.0-source/Legacy/F_Interpolation.cpp000644 001750 001750 00000041641 12473553042 022620 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "ProData.h" #include "F.h" #include "MallocUtils.h" #include "Message.h" extern struct CurrentData Current ; /* ------------------------------------------------------------------------ */ /* Interpolation */ /* ------------------------------------------------------------------------ */ void F_InterpolationLinear(F_ARG) { int N, up, lo ; double xp, yp = 0., *x, *y, a ; struct FunctionActive * D ; if (!Fct->Active) Fi_InitListXY (Fct, A, V) ; D = Fct->Active ; N = D->Case.Interpolation.NbrPoint ; x = D->Case.Interpolation.x ; y = D->Case.Interpolation.y ; xp = A->Val[0] ; if (xp < x[0]) { Message::Error("Bad argument for linear interpolation (%g < %g)", xp, x[0]) ; } else if (xp > x[N-1]) { a = (y[N-1] - y[N-2]) / (x[N-1] - x[N-2]) ; yp = y[N-1] + ( xp - x[N-1] ) * a ; } else { up = 0 ; while (x[++up] < xp){} ; lo = up - 1 ; a = (y[up] - y[lo]) / (x[up] - x[lo]) ; yp = y[up] + ( xp - x[up] ) * a ; } if (Current.NbrHar == 1) V->Val[0] = yp ; else if (Current.NbrHar == 2) { V->Val[0] = yp ; V->Val[1] = 0. ; } else { Message::Error("Function 'Interpolation' not valid for Complex"); } V->Type = SCALAR ; } void F_dInterpolationLinear(F_ARG) { int N, up, lo ; double xp, dyp = 0., *x, *y ; struct FunctionActive * D ; if (!Fct->Active) Fi_InitListXY (Fct, A, V) ; D = Fct->Active ; N = D->Case.Interpolation.NbrPoint ; x = D->Case.Interpolation.x ; y = D->Case.Interpolation.y ; xp = A->Val[0] ; if (xp < x[0]) { Message::Error("Bad argument for linear Interpolation (%g < %g)", xp, x[0]) ; } else if (xp > x[N-1]) { dyp = (y[N-1] - y[N-2]) / (x[N-1] - x[N-2]) ; } else { up = 0 ; while (x[++up] < xp){} ; lo = up - 1 ; dyp = (y[up] - y[lo]) / (x[up] - x[lo]) ; } if (Current.NbrHar == 1) V->Val[0] = dyp ; else if (Current.NbrHar == 2) { V->Val[0] = dyp ; V->Val[1] = 0. ; } else { Message::Error("Function 'dInterpolation' not valid for Complex"); } V->Type = SCALAR ; } void F_dInterpolationLinear2(F_ARG) { int N, up, lo ; double xp, yp = 0., *x, *y, a ; struct FunctionActive * D ; if (!Fct->Active) { Fi_InitListXY (Fct, A, V) ; Fi_InitListXY2 (Fct, A, V) ; } D = Fct->Active ; N = D->Case.Interpolation.NbrPoint ; x = D->Case.Interpolation.xc ; y = D->Case.Interpolation.yc ; xp = A->Val[0] ; if (xp < x[0]) { Message::Error("Bad argument for linear interpolation (%g < %g)", xp, x[0]) ; } else if (xp > x[N-1]) { a = (y[N-1] - y[N-2]) / (x[N-1] - x[N-2]) ; yp = y[N-1] + ( xp - x[N-1] ) * a ; } else { up = 0 ; while (x[++up] < xp){} ; lo = up - 1 ; a = (y[up] - y[lo]) / (x[up] - x[lo]) ; yp = y[up] + ( xp - x[up] ) * a ; } if (Current.NbrHar == 1) V->Val[0] = yp ; else if (Current.NbrHar == 2) { V->Val[0] = yp ; V->Val[1] = 0. ; } else { Message::Error("Function 'dInterpolation' not valid for Complex"); } V->Type = SCALAR ; } void F_InterpolationAkima(F_ARG) { // Third order interpolation with slope control int N, up, lo ; double xp, yp = 0., *x, *y, a, a2, a3 ; struct FunctionActive * D ; if (!Fct->Active) { Fi_InitListXY (Fct, A, V) ; Fi_InitAkima (Fct, A, V) ; } D = Fct->Active ; N = D->Case.Interpolation.NbrPoint ; x = D->Case.Interpolation.x ; y = D->Case.Interpolation.y ; xp = A->Val[0] ; if (xp < x[0]) { Message::Error("Bad argument for linear interpolation (%g < %g)", xp, x[0]) ; } else if (xp > x[N-1]) { a = (y[N-1] - y[N-2]) / (x[N-1] - x[N-2]) ; yp = y[N-1] + ( xp - x[N-1] ) * a ; } else { up = 0 ; while (x[++up] < xp){} ; lo = up - 1 ; a = xp - x[lo] ; a2 = a*a ; a3 = a2*a ; yp = y[lo] + D->Case.Interpolation.bi[lo] * a + D->Case.Interpolation.ci[lo] * a2 + D->Case.Interpolation.di[lo] * a3 ; } if (Current.NbrHar == 1) V->Val[0] = yp ; else if (Current.NbrHar == 2) { V->Val[0] = yp ; V->Val[1] = 0. ; } else { Message::Error("Function 'InterpolationAkima' not valid for Complex"); } V->Type = SCALAR ; } void F_dInterpolationAkima(F_ARG) { int N, up, lo ; double xp, dyp = 0., *x, *y, a, a2 ; struct FunctionActive * D ; if (!Fct->Active) { Fi_InitListXY (Fct, A, V) ; Fi_InitAkima (Fct, A, V) ; } D = Fct->Active ; N = D->Case.Interpolation.NbrPoint ; x = D->Case.Interpolation.x ; y = D->Case.Interpolation.y ; xp = A->Val[0] ; if (xp < x[0]) { Message::Error("Bad argument for linear interpolation (%g < %g)", xp, x[0]) ; } else if (xp > x[N-1]) { dyp = (y[N-1] - y[N-2]) / (x[N-1] - x[N-2]) ; } else { up = 0 ; while (x[++up] < xp){} ; lo = up - 1 ; a = xp - x[lo] ; a2 = a*a ; dyp = D->Case.Interpolation.bi[lo] + D->Case.Interpolation.ci[lo] * 2. * a + D->Case.Interpolation.di[lo] * 3. * a2 ; } if (Current.NbrHar == 1) V->Val[0] = dyp ; else if (Current.NbrHar == 2) { V->Val[0] = dyp ; V->Val[1] = 0. ; } else { Message::Error("Function 'dInterpolationAkima' not valid for Complex"); } V->Type = SCALAR ; } bool Fi_InterpolationBilinear(double *x, double *y, double *M, int NL, int NC, double xp, double yp, double *zp) { double a11, a12, a21, a22; int i, j; // Interpolate point (xp,yp) in a regular grid // x[i] <= xp < x[i+1] // y[j] <= yp < y[j+1] *zp = 0.0 ; // When (xp,yp) lays outside the boundaries of the table: // the nearest border is taken if (xp < x[0]) xp = x[0]; else if (xp > x[NL-1]) xp = x[NL-1]; for (i=0 ; i= xp && xp >= x[i]) break; i = (i >= NL) ? NL-1 : i; if (yp < y[0]) yp = y[0]; else if (yp > y[NC-1]) yp = y[NC-1]; for (j=0 ; j= yp && yp >= y[j]) break; j = (j >= NC) ? NC-1 : j; a11 = M[ i + NL * j ]; a21 = M[(i+1) + NL * j ]; a12 = M[ i + NL * (j+1)]; a22 = M[(i+1) + NL * (j+1)]; *zp = 1/((x[i+1]-x[i])*(y[j+1]-y[j])) * ( a11 * ( x[i+1]-xp) * ( y[j+1]-yp) + a21 * (-x[i ]+xp) * ( y[j+1]-yp) + a12 * ( x[i+1]-xp) * (-y[j ]+yp) + a22 * (-x[i ]+xp) * (-y[j ]+yp) ); return true ; } bool Fi_dInterpolationBilinear(double *x, double *y, double *M, int NL, int NC, double xp, double yp, double *dzp_dx, double *dzp_dy) { double a11, a12, a21, a22; int i, j; // When (xp,yp) lays outside the boundaries of the table: // the nearest border is taken if (xp < x[0]) xp = x[0]; else if (xp > x[NL-1]) xp = x[NL-1]; for (i=0 ; i= xp && xp >= x[i]) break; i = (i >= NL) ? NL-1 : i; if (yp < y[0]) yp = y[0]; else if (yp > y[NC-1]) yp = y[NC-1]; for (j=0 ; j= yp && yp >= y[j]) break; j = (j >= NC) ? NC-1 : j; a11 = M[ i + NL * j ]; a21 = M[(i+1) + NL * j ]; a12 = M[ i + NL * (j+1)]; a22 = M[(i+1) + NL * (j+1)]; *dzp_dx = 1/((x[i+1]-x[i])*(y[j+1]-y[j])) * ( (a21-a11) * ( y[j+1]-yp) + (a22-a12) * (-y[j ]+yp) ); *dzp_dy = 1/((x[i+1]-x[i])*(y[j+1]-y[j])) * ( (a12-a11) * ( x[i+1]-xp) + (a22-a21) * (-x[i ]+xp) ); return true ; } void F_InterpolationBilinear(F_ARG) { /* It performs a bilinear interpolation at point (xp,yp) based on a two-dimensional table (sorted grid). Input parameters: NL Number of lines NC Number of columns x values (ascending order) linked to the NL lines of the table y values (ascending order) linked to the NC columns of the table M Matrix M(x,y) = M[x+NL*y] xp x coordinate of interpolation point yp y coordinate of interpolation point R. Scorretti */ int NL, NC; double xp, yp, zp = 0., *x, *y, *M; struct FunctionActive * D; if( (A+0)->Type != SCALAR || (A+1)->Type != SCALAR) Message::Error("Two Scalar arguments required!"); if (!Fct->Active) Fi_InitListMatrix (Fct, A, V) ; D = Fct->Active ; NL = D->Case.ListMatrix.NbrLines ; NC = D->Case.ListMatrix.NbrColumns ; x = D->Case.ListMatrix.x ; y = D->Case.ListMatrix.y ; M = D->Case.ListMatrix.data ; xp = (A+0)->Val[0] ; yp = (A+1)->Val[0] ; bool IsInGrid = Fi_InterpolationBilinear (x, y, M, NL, NC, xp, yp, &zp); if (!IsInGrid) Message::Error("Extrapolation not allowed (xp=%g ; yp=%g)", xp, yp) ; V->Type = SCALAR ; V->Val[0] = zp ; } void F_dInterpolationBilinear(F_ARG) { /* It delivers the derivative of the bilinear interpolation at point (xp, yp) based on a two-dimensional table (sorted grid). Input parameters: NL Number of lines NC Number of columns x values (ascending order) linked to the NL lines of the table y values (ascending order) linked to the NC columns of the table M Matrix M(x,y) = M[x+NL*y] xp x coordinate of interpolation point yp y coordinate of interpolation point */ int NL, NC; double xp, yp, dzp_dx = 0., dzp_dy = 0., *x, *y, *M; struct FunctionActive * D; if( (A+0)->Type != SCALAR || (A+1)->Type != SCALAR) Message::Error("Two Scalar arguments required!"); if (!Fct->Active) Fi_InitListMatrix (Fct, A, V) ; D = Fct->Active ; NL = D->Case.ListMatrix.NbrLines ; NC = D->Case.ListMatrix.NbrColumns ; x = D->Case.ListMatrix.x ; y = D->Case.ListMatrix.y ; M = D->Case.ListMatrix.data ; xp = (A+0)->Val[0] ; yp = (A+1)->Val[0] ; bool IsInGrid = Fi_dInterpolationBilinear (x, y, M, NL, NC, xp, yp, &dzp_dx, &dzp_dy); if (!IsInGrid) Message::Error("Extrapolation not allowed (xp=%g ; yp=%g)", xp, yp) ; V->Type = VECTOR ; V->Val[0] = dzp_dx ; V->Val[1] = dzp_dy ; V->Val[2] = 0. ; } void Fi_InitListMatrix(F_ARG) { int i=0, k, NL, NC, sz ; struct FunctionActive * D ; /* The original table structure: | y(1) y(2) ... y(NC) ------+-------------------------------------------- x(1) | data(1) data(NL+1) ... . x(2) | data(2) data(NL+2) . . . . . . . . x(NL) | data(NL) data(2*NL) ... data(NL*NC) is furnished with the following format: [ NL, NC, x(1..NL), y(1..NC), data(1..NL*NC) ] R. Scorretti */ D = Fct->Active = (struct FunctionActive *)Malloc(sizeof(struct FunctionActive)) ; NL = Fct->Para[i++]; NC = Fct->Para[i++]; sz = 2 + NL + NC + NL*NC ; // expected size of list matrix if (Fct->NbrParameters != sz) Message::Error("Bad size of input data (expected = %d ; found = %d). " "List with format: x(NbrLines=%d), y(NbrColumns=%d), " "matrix(NbrLines*NbrColumns=%d)", sz, Fct->NbrParameters, NL, NC, NL*NC); // Initialize structure and allocate memory D->Case.ListMatrix.NbrLines = NL; D->Case.ListMatrix.NbrColumns = NC; D->Case.ListMatrix.x = (double *) malloc (sizeof(double)*NL); D->Case.ListMatrix.y = (double *) malloc (sizeof(double)*NC); D->Case.ListMatrix.data = (double *) malloc (sizeof(double)*NL*NC); // Assign values for (k=0 ; kCase.ListMatrix.x[k] = Fct->Para[i++]; for (k=0 ; kCase.ListMatrix.y[k] = Fct->Para[i++]; for (k=0 ; kCase.ListMatrix.data[k] = Fct->Para[i++]; } void Fi_InitListX(F_ARG) { int i, N ; double *x ; struct FunctionActive * D ; D = Fct->Active = (struct FunctionActive *)Malloc(sizeof(struct FunctionActive)) ; N = D->Case.Interpolation.NbrPoint = Fct->NbrParameters ; x = D->Case.Interpolation.x = (double *)Malloc(sizeof(double)*N) ; for (i = 0 ; i < N ; i++) x[i] = Fct->Para[i] ; } void Fi_InitListXY(F_ARG) { int i, N ; double *x, *y ; struct FunctionActive * D ; D = Fct->Active = (struct FunctionActive *)Malloc(sizeof(struct FunctionActive)) ; N = D->Case.Interpolation.NbrPoint = Fct->NbrParameters / 2 ; x = D->Case.Interpolation.x = (double *)Malloc(sizeof(double)*N) ; y = D->Case.Interpolation.y = (double *)Malloc(sizeof(double)*N) ; for (i = 0 ; i < N ; i++) { x[i] = Fct->Para[i*2 ] ; y[i] = Fct->Para[i*2+1] ; } } void Fi_InitListXY2(F_ARG) { int i, N ; double *x, *y, *xc, *yc ; struct FunctionActive * D ; D = Fct->Active ; N = D->Case.Interpolation.NbrPoint ; x = D->Case.Interpolation.x ; y = D->Case.Interpolation.y ; xc = D->Case.Interpolation.xc = (double *)Malloc(sizeof(double)*N) ; yc = D->Case.Interpolation.yc = (double *)Malloc(sizeof(double)*N) ; xc[0] = 0. ; yc[0] = (x[1]*y[1]-x[0]*y[0]) / (x[1]*x[1]-x[0]*x[0]) ; for (i = 1 ; i < N ; i++) { xc[i] = 0.5 * (x[i]+x[i-1]) ; yc[i] = (x[i]*y[i]-x[i-1]*y[i-1]) / (x[i]*x[i]-x[i-1]*x[i-1]) ; /* xc[i] = x[i] ; yc[i] = (y[i]-y[i-1]) / (x[i]-x[i-1]) ; */ } } void Fi_InitAkima(F_ARG) { int i, N ; double *x, *y, *mi, *bi, *ci, *di, a ; struct FunctionActive * D ; D = Fct->Active ; N = D->Case.Interpolation.NbrPoint ; x = D->Case.Interpolation.x ; y = D->Case.Interpolation.y ; mi = D->Case.Interpolation.mi = (double *)Malloc(sizeof(double)*(N+4)) ; mi += 2 ; bi = D->Case.Interpolation.bi = (double *)Malloc(sizeof(double)*N) ; ci = D->Case.Interpolation.ci = (double *)Malloc(sizeof(double)*N) ; di = D->Case.Interpolation.di = (double *)Malloc(sizeof(double)*N) ; for (i = 0 ; i < N-1 ; i++) mi[i] = (y[i+1]-y[i]) / (x[i+1]-x[i]) ; mi[N-1] = 2.*mi[N-2] - mi[N-3] ; mi[N ] = 2.*mi[N-1] - mi[N-2] ; mi[ -1] = 2.*mi[ 0] - mi[ 1] ; mi[ -2] = 2.*mi[ -1] - mi[ 0] ; for (i = 0 ; i < N ; i++) if ( (a = fabs(mi[i+1]-mi[i]) + fabs(mi[i-1]-mi[i-2])) > 1.e-30 ) bi[i] = ( fabs(mi[i+1]-mi[i]) * mi[i-1] + fabs(mi[i-1]-mi[i-2]) * mi[i] ) / a ; else bi[i] = (mi[i] + mi[i-1]) / 2. ; for (i = 0 ; i < N-1 ; i++) { a = (x[i+1]-x[i]) ; ci[i] = ( 3.*mi[i] - 2.*bi[i] - bi[i+1] ) / a ; di[i] = ( bi[i] + bi[i+1] - 2.*mi[i] ) / (a*a) ; } } struct IntDouble { int Int; double Double; } ; struct IntVector { int Int; double Double[3]; } ; void F_ValueFromIndex (F_ARG) { struct FunctionActive * D ; struct IntDouble * IntDouble_P; if (!Fct->Active) Fi_InitValueFromIndex (Fct, A, V) ; D = Fct->Active ; IntDouble_P = (struct IntDouble *) List_PQuery(D->Case.ValueFromIndex.Table, &Current.NumEntity, fcmp_int); if (!IntDouble_P) Message::Error("Unknown Entity Index (%d) in ValueFromIndex Table", Current.NumEntity); /* printf("==> search %d --> found %g\n", Current.NumEntity, IntDouble_P->Double); */ V->Val[0] = IntDouble_P->Double ; V->Type = SCALAR ; } void F_VectorFromIndex(F_ARG) { struct FunctionActive * D ; struct IntVector * IntVector_P; if (!Fct->Active) Fi_InitVectorFromIndex (Fct, A, V) ; D = Fct->Active ; /* printf("%d \n", List_Nbr(D->Case.ValueFromIndex.Table)); */ if (List_Nbr(D->Case.ValueFromIndex.Table)){ IntVector_P = (struct IntVector *) List_PQuery(D->Case.ValueFromIndex.Table, &Current.NumEntity, fcmp_int); /* if (!IntVector_P) Message::Error("Unknown Entity Index in VectorFromIndex Table"); printf("==> search %d --> found %g\n", Current.NumEntity, IntVector_P->Double); */ V->Val[0] = IntVector_P->Double[0] ; V->Val[1] = IntVector_P->Double[1] ; V->Val[2] = IntVector_P->Double[2] ; V->Type = VECTOR; } else{ V->Val[0] = 0.; V->Val[1] = 0.; V->Val[2] = 0.; V->Type = VECTOR; /* WARNING, "Table empty: Uninitialized data or Unknown Entity Index in VectorFromIndex Table */ } } void Fi_InitValueFromIndex(F_ARG) { int i, N ; struct IntDouble IntDouble_s; struct FunctionActive * D ; N = (int)Fct->Para[0]; D = Fct->Active = (struct FunctionActive *)Malloc(sizeof(struct FunctionActive)) ; D->Case.ValueFromIndex.Table = List_Create(N, 1, sizeof(struct IntDouble)); for (i = 0 ; i < N ; i++) { IntDouble_s.Int = (int)(Fct->Para[i*2+1]+0.1); IntDouble_s.Double = Fct->Para[i*2+2]; List_Add(D->Case.ValueFromIndex.Table, &IntDouble_s); } } void Fi_InitVectorFromIndex(F_ARG) { int i, N ; struct IntVector IntVector_s; struct FunctionActive * D ; if ((Fct->NbrParameters)){ N = (int)Fct->Para[0]; D = Fct->Active = (struct FunctionActive *)Malloc(sizeof(struct FunctionActive)) ; D->Case.ValueFromIndex.Table = List_Create(N, 1, sizeof(struct IntVector[3])); for (i = 0 ; i < N ; i++) { IntVector_s.Int = (int)(Fct->Para[i*4+1]+0.1); IntVector_s.Double[0] = Fct->Para[i*4+2]; IntVector_s.Double[1] = Fct->Para[i*4+3]; IntVector_s.Double[2] = Fct->Para[i*4+4]; List_Add(D->Case.ValueFromIndex.Table, &IntVector_s); } } else{ D = Fct->Active = (struct FunctionActive *)Malloc(sizeof(struct FunctionActive)) ; D->Case.ValueFromIndex.Table = NULL; } } getdp-2.7.0-source/Legacy/F_DiffGeom.cpp000644 001750 001750 00000024215 12473553042 021447 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributed by Matti Pellikka . #include #include "GetDPConfig.h" #include "ProData.h" #include "F.h" #include "Cal_Value.h" #include "Message.h" // // Differential geometry operations on 3-dimensional manifold // // The user has the responsibility that the input values are in fact // coefficients of k-vector fields or differential k-forms on // 3-dimensional manifold in appropiate context // // Hodge operator of a k-form: // Arguments: // k-form coefficient vector // metric tensor coefficient matrix // // Parameters: // degree k of the form // // Output: // (3-k)-form coefficient vector // void F_Hodge(F_ARG) { int k; struct Value detS; struct Value *S; k = Fct->Para[0]; S = A+1; if( (A->Type != SCALAR && A->Type != VECTOR) || (S->Type != TENSOR_DIAG && S->Type != TENSOR_SYM && S->Type != TENSOR)) Message::Error("Wrong type of arguments for function 'Hodge'"); Cal_DetValue(S, &detS); detS.Val[0] = sqrt(fabs(detS.Val[0])); switch(k) { case 0: Cal_ProductValue(&detS, A, V); break; case 1: Cal_InvertValue(S, S); Cal_ProductValue(S, A, V); Cal_ProductValue(&detS, V, V); break; case 2: Cal_InvertValue(&detS, &detS); Cal_ProductValue(S, A, V); Cal_ProductValue(&detS, V, V); break; case 3: Cal_InvertValue(&detS, &detS); Cal_ProductValue(&detS, A, V); break; default: Message::Error("Invalid parameter for function 'Hodge'"); break; } } // Inner product of k-forms: // Arguments: // k-form coefficient vector // k-form coefficient vector // metric tensor coefficient matrix // // Parameters: // degree k of the forms // // Output: // scalar // void F_InnerProduct(F_ARG) { int k; struct Value detS; struct Value *S; struct Value *V1; struct Value *V2; k = Fct->Para[0]; V1 = A; V2 = A+1; S = A+2; if( (V1->Type != SCALAR && V1->Type != VECTOR) || (V2->Type != SCALAR && V2->Type != VECTOR) || (V2->Type != V1->Type) || (S->Type != TENSOR_DIAG && S->Type != TENSOR_SYM && S->Type != TENSOR)) Message::Error("Wrong type of arguments for function 'InnerProduct'"); switch(k) { case 0: Cal_CopyValue(V2, V); break; case 1: Cal_InvertValue(S, S); Cal_ProductValue(S, V2, V); break; case 2: Cal_InvertValue(&detS, &detS); Cal_ProductValue(S, V2, V); Cal_ProductValue(&detS, V, V); break; case 3: Cal_InvertValue(&detS, &detS); Cal_ProductValue(&detS, V2, V); break; default: Message::Error("Invalid parameter for function 'InnerProduct'"); break; } Cal_ProductValue(V1, V, V); } // Sharp operator of a k-form: // Arguments: // k-form coefficient vector // metric tensor coefficient matrix // // Parameters: // degree k of the form // // Output: // k-vector coefficient vector // void F_Sharp(F_ARG) { if( (A->Type != SCALAR && A->Type != VECTOR) || ((A+1)->Type != TENSOR_DIAG && (A+1)->Type != TENSOR_SYM && (A+1)->Type != TENSOR)) Message::Error("Wrong type of arguments for function 'Sharp'"); if( Fct->Para[0] > 3 || Fct->Para[0] < 0 ) Message::Error("Invalid parameter for function 'Sharp'"); Cal_InvertValue(A+1, A+1); F_Flat(Fct, A, V); } // Flat operator of a k-vector: // Arguments: // k-vector coefficient vector // metric tensor coefficient matrix // // Parameters: // degree k of the vector // // Output: // k-form coefficient vector // void F_Flat(F_ARG) { int k; struct Value detS; struct Value *S; k = Fct->Para[0]; S = A+1; if( (A->Type != SCALAR && A->Type != VECTOR) || (S->Type != TENSOR_DIAG && S->Type != TENSOR_SYM && S->Type != TENSOR)) Message::Error("Wrong type of arguments for function 'Flat'"); Cal_DetValue(S, &detS); detS.Val[0] = sqrt(fabs(detS.Val[0])); switch(k) { case 0: Cal_CopyValue(A, V); break; case 1: Cal_ProductValue(S, A, V); break; case 2: Cal_InvertValue(S, S); Cal_ProductValue(S, A, V); Cal_ProductValue(&detS, V, V); break; case 3: Cal_ProductValue(&detS, A, V); break; default: Message::Error("Invalid parameter for function 'Flat'"); break; } } // Wedge product of k-forms or k-vectors: // Arguments: // k1-form or k1-vector coefficient vector // k2-form or k2-vector coefficient vector // // Parameters: // degree k1 of the first argument // degree k2 of the second argument // // Output: // (k1+k2)-form or (k1+k2)-vector coefficient vector // void F_WedgeProduct(F_ARG) { int k1,k2; struct Value *V1; struct Value *V2; k1 = Fct->Para[0]; k2 = Fct->Para[0]; V1 = A; V2 = A+1; if( (V1->Type != SCALAR && V1->Type != VECTOR) || (V2->Type != SCALAR && V2->Type != VECTOR) ) Message::Error("Wrong type of arguments for function 'WedgeProduct'"); if(k1 < 0 || k1 > 3 || k2 < 0 || k2 > 3) Message::Error("Invalid parameter for function 'WedgeProduct'"); if( k1 == 0 || k2 == 0 || (k1 == 1 && k2 == 2) || (k1 == 2 && k2 == 1) ) Cal_ProductValue(V1, V2, V); else if( k1 == 1 && k2 == 1 ) Cal_CrossProductValue(V1, V2, V); else if( k1 + k2 > 3 ) Cal_ZeroValue(V); else Message::Error("Missing implementation in 'WedgeProduct'"); } void F_TensorProduct(F_ARG) { Message::Error("'TensorProduct' not implemented"); } // Interior product of a 1-vector and a k-form: // Arguments: // 1-vector coefficient vector // k-form coefficient vector // // Parameters: // degree k of the k-form // // Output: // (k-1)-form coefficient vector // void F_InteriorProduct(F_ARG) { int k; struct Value *V1; struct Value *V2; k = Fct->Para[0]; V1 = A; V2 = A+1; if( V1->Type != VECTOR || (V2->Type != SCALAR && V2->Type != VECTOR) ) Message::Error("Wrong type of arguments for function 'InteriorProduct'"); switch(k) { case 1: case 3: Cal_ProductValue(V1, V2, V); break; case 2: Cal_CrossProductValue(V1, V2, V); break; default: Message::Error("Invalid parameter for function 'InteriorProduct'"); break; } } // Pullback of a k-form: // Arguments: // k-form coefficient vector // Jacobian matrix of the transition map between charts of a manifold // // Parameters: // degree k of the form // // Output: // k-form coefficient vector // void F_PullBack(F_ARG) { if( (A->Type != SCALAR && A->Type != VECTOR) || ((A+1)->Type != TENSOR_DIAG && (A+1)->Type != TENSOR_SYM && (A+1)->Type != TENSOR)) Message::Error("Wrong type of arguments for function 'PullBack'"); if( Fct->Para[0] < 0 || Fct->Para[0] > 3 ) Message::Error("Invalid parameter for function 'PullBack'"); Cal_TransposeValue(A+1, A+1); F_PushForward(Fct, A, V); } // Pullback of a metric tensor: // Arguments: // metric tensor coefficient matrix // Jacobian matrix of the transition map between charts of a manifold // // Parameters: // none // // Output: // metric tensor coefficient matrix // void F_PullBackMetric(F_ARG) { struct Value *S; struct Value *J; J = A+1; S = A; if( (S->Type != TENSOR_DIAG && S->Type != TENSOR_SYM && S->Type != TENSOR) || (J->Type != TENSOR_DIAG && J->Type != TENSOR_SYM && J->Type != TENSOR)) Message::Error("Wrong type of arguments for function 'PullBackMetric'"); Cal_ProductValue(S, J, V); Cal_TransposeValue(J, J); Cal_ProductValue(J, V, V); } // Inverse pullback of a k-form: // Arguments: // k-form coefficient vector // Jacobian matrix of the transition map between charts of a manifold // // Parameters: // degree k of the form // // Output: // k-form coefficient vector // void F_InvPullBack(F_ARG) { if( (A->Type != SCALAR && A->Type != VECTOR) || ((A+1)->Type != TENSOR_DIAG && (A+1)->Type != TENSOR_SYM && (A+1)->Type != TENSOR)) Message::Error("Wrong type of arguments for function 'InvPullBack'"); if( Fct->Para[0] < 0 || Fct->Para[0] > 3 ) Message::Error("Invalid parameter for function 'InvPullBack'"); Cal_InvertValue(A+1, A+1); Cal_TransposeValue(A+1, A+1); F_PushForward(Fct, A, V); } // Pushforward of a k-vector: // Arguments: // k-vector coefficient vector // Jacobian matrix of the transition map between charts of a manifold // // Parameters: // degree k of the k-vector // // Output: // k-vector coefficient vector // void F_PushForward(F_ARG) { int k; struct Value *J; struct Value detJ; k = Fct->Para[0]; J = A+1; if( (A->Type != SCALAR && A->Type != VECTOR) || (J->Type != TENSOR_DIAG && J->Type != TENSOR_SYM && J->Type != TENSOR)) Message::Error("Wrong type of arguments for function 'PushForward'"); switch(k) { case 0: Cal_CopyValue(A, V); break; case 1: Cal_ProductValue(J, A, V); break; case 2: Cal_InvertValue(J, J); Cal_TransposeValue(J, J); Cal_DetValue(J, &detJ); Cal_ProductValue(J, A, V); Cal_ProductValue(&detJ, V, V); break; case 3: Cal_DetValue(J, &detJ); Cal_ProductValue(&detJ, A, V); break; default: Message::Error("Invalid parameter for function 'PushForward'"); break; } } // Inverse pushforward of a k-vector: // Arguments: // k-vector coefficient vector // Jacobian matrix of the transition map between charts of a manifold // // Parameters: // degree k of the k-vector // // Output: // k-vector coefficient vector // void F_InvPushForward(F_ARG) { if( (A->Type != SCALAR && A->Type != VECTOR) || ((A+1)->Type != TENSOR_DIAG && (A+1)->Type != TENSOR_SYM && (A+1)->Type != TENSOR)) Message::Error("Wrong type of arguments for function 'InvPushForward'"); if( Fct->Para[0] < 0 || Fct->Para[0] > 3 ) Message::Error("Invalid parameter for function 'InvPushForward'"); Cal_InvertValue(A+1, A+1); F_PushForward(Fct, A, V); } getdp-2.7.0-source/Legacy/F.h000644 001750 001750 00000024635 12606421314 017354 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _F_H_ #define _F_H_ #include "ProData.h" /* ------------------------------------------------------------------------ */ /* Warning: the pointers A and V can be identical. You must */ /* use temporary variables in your computations: you can only */ /* affect to V at the very last time (when you're sure you will */ /* not use A anymore). */ /* ------------------------------------------------------------------------ */ #define F_ARG struct Function * Fct, struct Value * A, struct Value * V /* F_Analytic */ // using +iwt convention void F_JFIE_ZPolCyl (F_ARG) ; void F_RCS_ZPolCyl (F_ARG) ; void F_JFIE_TransZPolCyl (F_ARG) ; void F_JFIE_SphTheta (F_ARG) ; void F_RCS_SphTheta (F_ARG) ; void F_JFIE_SphPhi (F_ARG) ; void F_RCS_SphPhi (F_ARG) ; void F_CurrentPerfectlyConductingSphere(F_ARG); // using -iwt convention void F_ElectricFieldPerfectlyConductingSphereMwt(F_ARG); void F_ElectricFieldDielectricSphereMwt(F_ARG); void F_ExactOsrcSolutionPerfectlyConductingSphereMwt(F_ARG); void F_CurrentPerfectlyConductingSphereMwt(F_ARG); void F_AcousticFieldSoftSphere(F_ARG) ; void F_DrAcousticFieldSoftSphere(F_ARG) ; void F_RCSSoftSphere(F_ARG) ; void F_AcousticFieldHardSphere(F_ARG) ; void F_RCSHardSphere(F_ARG) ; void F_AcousticFieldSoftCylinder(F_ARG) ; void F_AcousticFieldSoftCylinderABC(F_ARG) ; void F_DrAcousticFieldSoftCylinder(F_ARG) ; void F_RCSSoftCylinder(F_ARG) ; void F_AcousticFieldHardCylinder(F_ARG) ; void F_AcousticFieldHardCylinderABC(F_ARG) ; void F_DthetaAcousticFieldHardCylinder(F_ARG) ; void F_RCSHardCylinder(F_ARG) ; void F_OSRC_C0(F_ARG); void F_OSRC_R0(F_ARG); void F_OSRC_Aj(F_ARG); void F_OSRC_Bj(F_ARG); /* F_Geometry */ void F_ProjectPointOnEllipse(F_ARG); void F_Normal (F_ARG) ; void F_NormalSource (F_ARG) ; void F_Tangent (F_ARG) ; void F_TangentSource (F_ARG) ; void F_ElementVol (F_ARG) ; void F_SurfaceArea (F_ARG) ; void F_GetVolume (F_ARG) ; void F_GetNumElements (F_ARG) ; void F_CellSize (F_ARG) ; void F_SquNormEdgeValues(F_ARG) ; /* F_Raytracing */ void F_CylinderPhase(F_ARG); void F_DiamondPhase(F_ARG); /* F_Math */ void F_Exp (F_ARG) ; void F_Log (F_ARG) ; void F_Log10 (F_ARG) ; void F_Sqrt (F_ARG) ; void F_Sin (F_ARG) ; void F_Asin (F_ARG) ; void F_Cos (F_ARG) ; void F_Acos (F_ARG) ; void F_Tan (F_ARG) ; void F_Atan (F_ARG) ; void F_Sinh (F_ARG) ; void F_Cosh (F_ARG) ; void F_Tanh (F_ARG) ; void F_Fabs (F_ARG) ; void F_Floor (F_ARG) ; void F_Ceil (F_ARG) ; void F_Fmod (F_ARG) ; void F_Sign (F_ARG) ; void F_Jn (F_ARG) ; void F_Yn (F_ARG) ; void F_dJn (F_ARG) ; void F_dYn (F_ARG) ; /* F_ExtMath */ void F_Hypot (F_ARG) ; void F_Atan2 (F_ARG) ; void F_TanhC2 (F_ARG) ; void F_Transpose (F_ARG) ; void F_Inv (F_ARG) ; void F_Det (F_ARG) ; void F_Trace (F_ARG) ; void F_RotateXYZ (F_ARG) ; void F_Norm (F_ARG) ; void F_SquNorm (F_ARG) ; void F_Unit (F_ARG) ; void F_ScalarUnit (F_ARG) ; void F_Cos_wt_p (F_ARG) ; void F_Sin_wt_p (F_ARG) ; void F_Period (F_ARG) ; void F_Interval (F_ARG) ; void F_Complex (F_ARG) ; void F_Complex_MH (F_ARG) ; void F_Re (F_ARG) ; void F_Im (F_ARG) ; void F_Conj (F_ARG) ; void F_Cart2Pol (F_ARG) ; void F_Vector (F_ARG) ; void F_Tensor (F_ARG) ; void F_TensorV (F_ARG) ; void F_TensorSym (F_ARG) ; void F_TensorDiag (F_ARG) ; void F_SquDyadicProduct(F_ARG) ; void F_Comp (F_ARG) ; void F_CompX (F_ARG) ; void F_CompY (F_ARG) ; void F_CompZ (F_ARG) ; void F_CompXX (F_ARG) ; void F_CompXY (F_ARG) ; void F_CompXZ (F_ARG) ; void F_CompYX (F_ARG) ; void F_CompYY (F_ARG) ; void F_CompYZ (F_ARG) ; void F_CompZX (F_ARG) ; void F_CompZY (F_ARG) ; void F_CompZZ (F_ARG) ; void F_Cart2Sph (F_ARG) ; void F_Cart2Cyl (F_ARG) ; void F_UnitVectorX (F_ARG) ; void F_UnitVectorY (F_ARG) ; void F_UnitVectorZ (F_ARG) ; /* F_Coord */ // se basent sur le uvw courant (-> en cal) void F_CoordX (F_ARG) ; void F_CoordY (F_ARG) ; void F_CoordZ (F_ARG) ; void F_CoordXYZ (F_ARG) ; // se basent sur le xyz courant, i.e. les coord d'un noeud (-> en pre) void F_aX_bY_cZ (F_ARG) ; void F_aX21_bY21_cZ21 (F_ARG) ; void F_CoordXS (F_ARG) ; void F_CoordYS (F_ARG) ; void F_CoordZS (F_ARG) ; void F_CoordXYZS (F_ARG) ; /* F_Misc */ void F_Printf (F_ARG) ; void F_Rand (F_ARG) ; void F_CompElementNum (F_ARG) ; void F_ElementNum (F_ARG) ; void F_QuadraturePointIndex (F_ARG) ; void F_GetCpuTime (F_ARG) ; void F_GetWallClockTime(F_ARG) ; void F_GetMemory (F_ARG) ; void F_SetNumber (F_ARG) ; void F_GetNumber (F_ARG) ; void F_VirtualWork (F_ARG) ; void F_Felec (F_ARG) ; void F_dFxdux (F_ARG) ; void F_dFydux (F_ARG) ; void F_dFzdux (F_ARG) ; void F_dFxduy (F_ARG) ; void F_dFyduy (F_ARG) ; void F_dFzduy (F_ARG) ; void F_dFxduz (F_ARG) ; void F_dFyduz (F_ARG) ; void F_dFzduz (F_ARG) ; void F_dFxdv (F_ARG) ; void F_dFydv (F_ARG) ; void F_dFzdv (F_ARG) ; void F_dWedxdv (F_ARG) ; void F_dWedydv (F_ARG) ; void F_dWedzdv (F_ARG) ; void F_NodeForceDensity(F_ARG) ; void F_AssDiag (F_ARG) ; /* pour Patrick */ /* F_Interpolation */ void F_InterpolationLinear (F_ARG) ; void F_dInterpolationLinear (F_ARG) ; void F_dInterpolationLinear2 (F_ARG) ; void F_InterpolationAkima (F_ARG) ; void F_dInterpolationAkima (F_ARG) ; void F_InterpolationBilinear (F_ARG) ; void F_dInterpolationBilinear (F_ARG) ; bool Fi_InterpolationBilinear (double *x, double *y, double *M, int NL, int NC, double xp, double yp, double *zp); bool Fi_dInterpolationBilinear(double *x, double *y, double *M, int NL, int NC, double xp, double yp, double *dzp_dx, double *dzp_dy); void Fi_InitListX (F_ARG) ; // List void Fi_InitListXY (F_ARG) ; // ListAlt void Fi_InitListXY2 (F_ARG) ; void Fi_InitAkima (F_ARG) ; void Fi_InitListMatrix (F_ARG) ; void F_ValueFromIndex (F_ARG) ; void F_VectorFromIndex (F_ARG) ; void Fi_InitValueFromIndex (F_ARG) ; void Fi_InitVectorFromIndex (F_ARG) ; void F_TransformTensor (F_ARG) ; /* pour Tuan */ void F_TransformPerm (F_ARG) ; /* pour Tuan */ void F_TransformPiezo (F_ARG) ; /* pour Tuan */ void F_TransformPiezoT (F_ARG) ; /* pour Tuan */ /* F_Hysteresis */ void F_dhdb_Jiles (F_ARG) ; void F_dbdh_Jiles (F_ARG) ; void F_h_Jiles (F_ARG) ; void F_b_Jiles (F_ARG) ; void F_dhdb_Ducharne(F_ARG) ; void F_h_Ducharne (F_ARG) ; void F_nu_Ducharne(F_ARG) ; double Fi_h_Ducharne (double *hi, double *bi, double *M, int NL, int NC, double h0, double b0, double b); void F_nu_Vinch (F_ARG) ; void F_mu_Vinch (F_ARG) ; void F_h_Vinch (F_ARG) ; void F_dhdb_Vinch(F_ARG) ; void F_dbdh_Vinch(F_ARG) ; void F_Update_Jk (F_ARG) ; void F_Update_Jk_sd (F_ARG) ; void Vector_Update_Jk_sd_K(double h[3], double Jk[3], double Jkp[3], double chi, double Js, double alpha) ; void Vector_b_Vinch_K (int N, double h[3], double alpha, double *Jk_all, double *Jkp_all, double *chi_all, double *Js_all, double b[3] ) ; void Vector_h_Vinch_K (int dim, int N, double b[3], double bc[3], double alpha, double *Jk_all, double *Jkp_all, double *chi_all, double *Js_all, double h[3] ); void Tensor_dbdh_Vinch_K (int dim, int N, double h[3], double alpha, double *Jk_all, double *Jkp_all, double *chi_all, double *Js_all, double dbdh[6]); void Tensor_dJkdh_Vinch_K (int dim, double h[3], double Jk[3], double Jkp[3], double chi, double Js, double alpha, double dJkdh[6]); void Inv_Tensor3x3_K (double T[9], double invT[9]); void Inv_TensorSym3x3_K (int dim, double T[6], double invT[6]); void F_b_Vinch_K(F_ARG); void F_h_Vinch_K(F_ARG); void F_dbdh_Vinch_K(F_ARG); void F_dhdb_Vinch_K(F_ARG); void F_nu_Vinch_K(F_ARG); /* F_MultiHar */ void F_MHToTime (F_ARG) ; // the following should go somewhere else void Fi_MHTimeIntegration(int TypePsi, int NbrTimePoint, List_T * WholeQuantity_L, int FreqOffSet, struct Element * Element, struct QuantityStorage * QuantityStorage_P0, double u, double v, double w, struct Value *ValueOut) ; void F_MHToTime0 (int init, struct Value * A, struct Value * V, int iTime, int NbrTimePoint, double * TimeMH) ;/* OJO!!! int *init */ void MHTransform(struct Element * Element, struct QuantityStorage * QuantityStorage_P0, double u, double v, double w, struct Value *MH_Value, struct Expression * Expression_P, int NbrPoints); /* F_BiotSavart */ void F_BiotSavart (F_ARG) ; void F_Pocklington (F_ARG) ; /* F_Gmsh */ void F_Field(F_ARG) ; void F_ScalarField(F_ARG) ; void F_VectorField(F_ARG) ; void F_TensorField(F_ARG) ; void F_ComplexScalarField(F_ARG) ; void F_ComplexVectorField(F_ARG) ; void F_ComplexTensorField(F_ARG) ; void F_GradScalarField(F_ARG) ; void F_GradVectorField(F_ARG) ; void F_GradComplexScalarField(F_ARG) ; void F_GradComplexVectorField(F_ARG) ; /* F_DiffGeom */ void F_Hodge(F_ARG) ; void F_InnerProduct(F_ARG) ; void F_Sharp(F_ARG) ; void F_Flat(F_ARG) ; void F_WedgeProduct(F_ARG) ; void F_TensorProduct(F_ARG) ; void F_InteriorProduct(F_ARG) ; void F_PullBack(F_ARG) ; void F_PullBackMetric(F_ARG) ; void F_PushForward(F_ARG) ; void F_InvPullBack(F_ARG) ; void F_InvPushForward(F_ARG) ; /* F_Octave */ void F_Octave(F_ARG) ; /* F_Python */ void F_Python(F_ARG) ; #endif getdp-2.7.0-source/Legacy/EigenSolve_ARPACK.cpp000644 001750 001750 00000071151 12473553042 022604 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Alexandru Mustatea // Andre Nicolet // #include "GetDPConfig.h" #if defined(HAVE_ARPACK) #include #include #include "Message.h" #include "ProData.h" #include "DofData.h" #include "Cal_Quantity.h" #include "MallocUtils.h" #include "OS.h" #define SQU(a) ((a)*(a)) #define TWO_PI 6.2831853071795865 extern struct CurrentData Current ; extern char *Name_Path ; struct EigenPar { double prec; int size; int reortho; } ; #if defined(HAVE_NO_UNDERSCORE) #define znaupd_ znaupd #define zneupd_ zneupd #endif extern "C" { typedef struct {double re; double im;} complex_16; extern void znaupd_(int *ido, char *bmat, int *n, char *which, int *nev, double *tol, complex_16 resid[], int *ncv, complex_16 v[], int *ldv, int iparam[], int ipntr[], complex_16 workd[], complex_16 workl[], int *lworkl, double rwork[], int *info); extern void zneupd_(unsigned int *rvec, char *howmny, unsigned int select[], complex_16 d[], complex_16 z[], int *ldz, complex_16 *sigma, complex_16 workev[], char *bmat, int *n, char *which, int *nev, double *tol, complex_16 resid[], int *ncv, complex_16 v[], int *ldv, int iparam[], int ipntr[], complex_16 workd[], complex_16 workl[], int *lworkl, double rwork[], int *info); } static void EigenGetDouble(const char *text, double *d) { char str[256]; printf("%s (default=%.16g): ", text, *d); fgets(str, sizeof(str), stdin); if(strlen(str) && strcmp(str, "\n")) *d = atof(str); } static void EigenGetInt(const char *text, int *i) { char str[256]; printf("%s (default=%d): ", text, *i); fgets(str, sizeof(str), stdin); if(strlen(str) && strcmp(str, "\n")) *i = atoi(str); } void EigenPar(const char *filename, struct EigenPar *par) { char path[1024]; FILE *fp; /* set some defaults */ par->prec = 1.e-4; par->reortho = 0; par->size = 50; /* try to read parameters from file */ strcpy(path, Name_Path); strcat(path, filename); fp = FOpen(path, "r"); if(fp) { Message::Info("Loading eigenproblem parameter file '%s'", path); fscanf(fp, "%lf", &par->prec); fscanf(fp, "%d", &par->reortho); fscanf(fp, "%d", &par->size); fclose(fp); } else{ fp = FOpen(path, "w"); if(fp){ if(!Message::UseOnelab()){ /* get parameters from command line */ EigenGetDouble("Precision", &par->prec); EigenGetInt("Reorthogonalization", &par->reortho); EigenGetInt("Krylov basis size", &par->size); } /* write file */ fprintf(fp, "%.16g\n", par->prec); fprintf(fp, "%d\n", par->reortho); fprintf(fp, "%d\n", par->size); fprintf(fp, "/*\n" " The numbers above are the parameters for the numerical\n" " eigenvalue problem:\n" "\n" " prec = aimed accuracy for eigenvectors (default=1.e-4)\n" " reortho = reorthogonalisation of Krylov basis: yes=1, no=0 (default=0) \n" " size = size of the Krylov basis\n" "\n" " The shift is given in the .pro file because its choice relies\n" " on physical considerations.\n" "*/"); fclose(fp); } else{ Message::Error("Unable to open file '%s'", path); } } Message::Info("Eigenproblem parameters: prec = %g, reortho = %d, size = %d", par->prec, par->reortho, par->size); } /* This routine uses Arpack to solve Generalized Complex Non-Hermitian eigenvalue problems. We don't use the "Generalized" Arpack mode (bmat=='G') since it requires M to be Hermitian. Instead, we use the regular mode (bmat='I') and apply the shift "by hand", which allows us to use arbitrary matrices K and M. */ static void Arpack2GetDP(int N, complex_16 *in, gVector *out) { int i, j; double re, im; int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; for(i = 0; i < N; i++){ re = in[i].re; im = in[i].im; j = i * incr; if(Current.NbrHar == 2) LinAlg_SetComplexInVector(re, im, out, j, j+1); else LinAlg_SetDoubleInVector(re, out, j); } LinAlg_AssembleVector(out); } static void Arpack2GetDPSplit(int N, complex_16 *in, gVector *out1, gVector *out2) { int i, j; double re, im; int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; for(i = 0; i < N/2; i++){ j = i * incr; re = in[i].re; im = in[i].im; if(Current.NbrHar == 2) LinAlg_SetComplexInVector(re, im, out1, j, j+1); else LinAlg_SetDoubleInVector(re, out1, j); re = in[N/2+i].re; im = in[N/2+i].im; if(Current.NbrHar == 2) LinAlg_SetComplexInVector(re, im, out2, j, j+1); else LinAlg_SetDoubleInVector(re, out2, j); } LinAlg_AssembleVector(out1); LinAlg_AssembleVector(out2); } static void GetDP2Arpack(gVector *in, complex_16 *out) { int i, N; double re, im = 0.; int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; LinAlg_GetVectorSize(in, &N); for(i = 0; i < N; i += incr){ if(Current.NbrHar == 2) LinAlg_GetComplexInVector(&re, &im, in, i, i+1); else LinAlg_GetDoubleInVector(&re, in, i); out[i/incr].re = re; out[i/incr].im = im; } } static void GetDP2ArpackMerge(gVector *in1, gVector *in2, complex_16 *out) { int i, N; double re, im = 0.; int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; LinAlg_GetVectorSize(in1, &N); for(i = 0; i < N; i += incr){ if(Current.NbrHar == 2) LinAlg_GetComplexInVector(&re, &im, in1, i, i+1); else LinAlg_GetDoubleInVector(&re, in1, i); out[i/incr].re = re; out[i/incr].im = im; if(Current.NbrHar == 2) LinAlg_GetComplexInVector(&re, &im, in2, i, i+1); else LinAlg_GetDoubleInVector(&re, in2, i); out[N/incr + i/incr].re = re; out[N/incr + i/incr].im = im; } } void EigenSolve_ARPACK(struct DofData * DofData_P, int NumEigenvalues, double shift_r, double shift_i, int FilterExpressionIndex) { struct EigenPar eigenpar; struct Solution Solution_S; gVector v1, v2, w1, w2, x, y; int n, j, k, l, newsol, quad_evp = 0; double tmp, d1, d2, abs, arg; complex_16 f, omega, omega2; gMatrix *K = &DofData_P->M1; /* matrix associated with terms with no Dt nor DtDt */ gMatrix *L = &DofData_P->M2; /* matrix associated with Dt terms */ gMatrix *M = &DofData_P->M3; /* matrix associated with DtDt terms */ gMatrix D; /* temp matrix for quadratic eigenvalue problem */ /* Arpack parameters: see below for explanation */ int ido, nev, ncv, ldv, iparam[11], ipntr[14], lworkl, info, ldz; char bmat, *which, howmny; double tol, *rwork; unsigned int rvec, *select; complex_16 *resid, *v, *workd, *workl, *d, *z, sigma, *workev; /* Warn if we are not in harmonic regime (we won't be able to compute/store complex eigenvectors) */ if(Current.NbrHar != 2){ Message::Info("EigenSolve will only store the real part of the eigenvectors; " "Define the system with \"Type Complex\" if this is an issue"); } #if defined(HAVE_PETSC) && !defined(PETSC_USE_COMPLEX) if(Current.NbrHar == 2){ Message::Warning("Using PETSc in real arithmetic for complex-simulated-real matrices"); } #endif /* Sanity checks */ if(!DofData_P->Flag_Init[1] || !DofData_P->Flag_Init[3]){ Message::Error("No System available for EigenSolve: check 'DtDt' and 'GenerateSeparate'"); return; } /* Check if we have a "quadratic" evp (- w^2 M x + i w L x + K x = 0) */ if(DofData_P->Flag_Init[2]) quad_evp = 1; /* Get eigenproblem parameters */ EigenPar("eigen.par", &eigenpar); /* size of the system */ int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; n = DofData_P->NbrDof / incr; if(quad_evp) n *= 2; ido = 0; /* Reverse communication flag. IDO must be zero on the first call to znaupd. IDO will be set internally to indicate the type of operation to be performed. Control is then given back to the calling routine which has the responsibility to carry out the requested operation and call znaupd with the result. The operand is given in WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)). ------------------------------------------------------------- IDO = 0: first call to the reverse communication interface IDO = -1: compute Y = OP * X where IPNTR(1) is the pointer into WORKD for X, IPNTR(2) is the pointer into WORKD for Y. This is for the initialization phase to force the starting vector into the range of OP. IDO = 1: compute Y = OP * X where IPNTR(1) is the pointer into WORKD for X, IPNTR(2) is the pointer into WORKD for Y. In mode 3, the vector B * X is already available in WORKD(ipntr(3)). It does not need to be recomputed in forming OP * X. IDO = 2: compute Y = M * X where IPNTR(1) is the pointer into WORKD for X, IPNTR(2) is the pointer into WORKD for Y. IDO = 3: compute and return the shifts in the first NP locations of WORKL. IDO = 99: done ------------------------------------------------------------- After the initialization phase, when the routine is used in the "shift-and-invert" mode, the vector M * X is already available and does not need to be recomputed in forming OP*X. */ bmat = 'I'; /* BMAT specifies the type of the matrix B that defines the semi-inner product for the operator OP. BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*M*x */ which = (char*)"LM"; /* Which eigenvalues we want: SM = smallest magnitude ( magnitude = absolute value ) LM = largest magnitude SR = smallest real part LR = largest real part SI = smallest imaginary part LI = largest imaginary part */ nev = NumEigenvalues; /* Number of eigenvalues of OP to be computed. 0 < NEV < N-1. Therefore, you'll be able to compute AT MOST n-2 eigenvalues! */ /* sanity check */ if(nev >= n-1){ Message::Warning("NumEigenvalues too large (%d < %d): setting to %d", nev, n-1, n-2); nev = n-2; } tol = eigenpar.prec; /* 1.e-4; */ /* Stopping criteria: the relative accuracy of the Ritz value is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)) where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex. DEFAULT = dlamch('EPS') (machine precision as computed by the LAPACK auxiliary subroutine dlamch). */ resid = (complex_16*)Malloc(n * sizeof(complex_16)); /* On INPUT: If INFO .EQ. 0, a random initial residual vector is used. If INFO .NE. 0, RESID contains the initial residual vector, possibly from a previous run. On OUTPUT: RESID contains the final residual vector. */ ncv = eigenpar.size; /* Rule of thumb: NumEigenvalues * 2; */ /* Number of columns of the matrix V. NCV must satisfy the two inequalities 1 <= NCV-NEV and NCV <= N. This will indicate how many Arnoldi vectors are generated at each iteration. After the startup phase in which NEV Arnoldi vectors are generated, the algorithm generates approximately NCV-NEV Arnoldi vectors at each subsequent update iteration. Most of the cost in generating each Arnoldi vector is in the matrix-vector operation OP*x. */ /* sanity checks */ if(ncv <= nev){ Message::Warning("Krylov space size too small (%d <= %d), setting to %d", ncv, nev, nev*2); ncv = nev * 2; } if(ncv > n){ Message::Warning("Krylov space size too large (%d > %d), setting to %d", ncv, n, n); ncv = n; } v = (complex_16*)Malloc(n * ncv * sizeof(complex_16)); /* At the end of calculations, here will be stored the Arnoldi basis vectors */ ldv = n; /* Leading dimension of "v". In our case, the number of lines of "v". */ iparam[0] = 1; iparam[1] = 0; iparam[2] = 10000; iparam[3] = 1; iparam[4] = 0; iparam[5] = 0; iparam[6] = 1; iparam[7] = 0; iparam[8] = 0; iparam[9] = 0; iparam[10] = 0; /* IPARAM(1) = ISHIFT: method for selecting the implicit shifts. The shifts selected at each iteration are used to filter out the components of the unwanted eigenvector. ------------------------------------------------------------- ISHIFT = 0: the shifts are to be provided by the user via reverse communication. The NCV eigenvalues of the Hessenberg matrix H are returned in the part of WORKL array corresponding to RITZ. ISHIFT = 1: exact shifts with respect to the current Hessenberg matrix H. This is equivalent to restarting the iteration from the beginning after updating the starting vector with a linear combination of Ritz vectors associated with the "wanted" eigenvalues. ISHIFT = 2: other choice of internal shift to be defined. ------------------------------------------------------------- IPARAM(2) = No longer referenced IPARAM(3) = MXITER On INPUT: maximum number of Arnoldi update iterations allowed. On OUTPUT: actual number of Arnoldi update iterations taken. IPARAM(4) = NB: blocksize to be used in the recurrence. The code currently works only for NB = 1. IPARAM(5) = NCONV: number of "converged" Ritz values. This represents the number of Ritz values that satisfy the convergence criterion. IPARAM(6) = IUPD No longer referenced. Implicit restarting is ALWAYS used. IPARAM(7) = MODE On INPUT determines what type of eigenproblem is being solved. Must be 1,2,3; See under \Description of znaupd for the four modes available. IPARAM(8) = NP When ido = 3 and the user provides shifts through reverse communication (IPARAM(1)=0), _naupd returns NP, the number of shifts the user is to provide. 0 < NP < NCV-NEV. IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO, OUTPUT: NUMOP = total number of OP*x operations, NUMOPB = total number of B*x operations if BMAT='G', NUMREO = total number of steps of re-orthogonalization. */ ipntr[0] = 0; /* Pointer to mark the starting locations in the WORKD and WORKL arrays for matrices/vectors used by the Arnoldi iteration. ------------------------------------------------------------- IPNTR(1): pointer to the current operand vector X in WORKD. IPNTR(2): pointer to the current result vector Y in WORKD. IPNTR(3): pointer to the vector B * X in WORKD when used in the shift-and-invert mode. IPNTR(4): pointer to the next available location in WORKL that is untouched by the program. IPNTR(5): pointer to the NCV by NCV upper Hessenberg matrix H in WORKL. IPNTR(6): pointer to the ritz value array RITZ IPNTR(7): pointer to the (projected) ritz vector array Q IPNTR(8): pointer to the error BOUNDS array in WORKL. IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below. Note: IPNTR(9:13) is only referenced by zneupd. See Remark 2 below. IPNTR(9): pointer to the NCV RITZ values of the original system. IPNTR(10): Not Used IPNTR(11): pointer to the NCV corresponding error bounds. IPNTR(12): pointer to the NCV by NCV upper triangular Schur matrix for H. IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors of the upper Hessenberg matrix H. Only referenced by zneupd if RVEC = .TRUE. See Remark 2 below. */ workd = (complex_16*)Malloc(3 * n * sizeof(complex_16)); /* Distributed array to be used in the basic Arnoldi iteration for reverse communication. The user should not use WORKD as temporary workspace during the iteration !!!!!!!!!! See Data Distribution Note below. */ lworkl = 3*ncv*ncv + 5*ncv; /* Dimension of the "workl" vector (see below). On must have: lworkl >= 3*ncv*ncv + 5*ncv */ workl = (complex_16*)Malloc(lworkl * sizeof(complex_16)); /* Private (replicated) array on each PE or array allocated on the front end. See Data Distribution Note below. */ rwork = (double*)Malloc(ncv * sizeof(double)); /* Used as workspace */ info = 0; /* If INFO .EQ. 0, a randomly initial residual vector is used. If INFO .NE. 0, RESID contains the initial residual vector, possibly from a previous run. Error flag on output. = 0: Normal exit. = 1: Maximum number of iterations taken. All possible eigenvalues of OP has been found. IPARAM(5) returns the number of wanted converged Ritz values. = 2: No longer an informational error. Deprecated starting with release 2 of ARPACK. = 3: No shifts could be applied during a cycle of the Implicitly restarted Arnoldi iteration. One possibility is to increase the size of NCV relative to NEV. See remark 4 below. = -1: N must be positive. = -2: NEV must be positive. = -3: NCV-NEV >= 1 and less than or equal to N. = -4: The maximum number of Arnoldi update iteration must be greater than zero. = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI' = -6: BMAT must be one of 'I' or 'G'. = -7: Length of private work array is not sufficient. = -8: Error return from LAPACK eigenvalue calculation; = -9: Starting vector is zero. = -10: IPARAM(7) must be 1,2,3. = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible. = -12: IPARAM(1) must be equal to 0 or 1. = -9999: Could not build an Arnoldi factorization. User input error highly likely. Please check actual array dimensions and layout. IPARAM(5) returns the size of the current Arnoldi factorization. */ rvec = 1; /* .true. */ /* If we want Ritz vectors to be computed as well. */ howmny = 'A'; /* What do we want: Ritz or Schur vectors? For Schur, choose: howmny = 'P' */ select = (unsigned int*)Malloc(ncv * sizeof(unsigned int)); /* Internal workspace */ d = (complex_16*)Malloc(nev * sizeof(complex_16)); /* Vector containing the "nev" eigenvalues computed. VERY IMPORTANT: on line 69 of zneupd.f they say it should be nev+1; this is wrong, for see line 283 where it is declared as d(nev) */ z = (complex_16*)Malloc(n * nev * sizeof(complex_16)); /* On exit, if RVEC = .TRUE. and HOWMNY = 'A', then the columns of Z represents approximate eigenvectors (Ritz vectors) corresponding to the NCONV=IPARAM(5) Ritz values for eigensystem A*z = lambda*B*z. If RVEC = .FALSE. or HOWMNY = 'P', then Z is NOT REFERENCED. NOTE: If if RVEC = .TRUE. and a Schur basis is not required, the array Z may be set equal to first NEV+1 columns of the Arnoldi basis array V computed by ZNAUPD. In this case the Arnoldi basis will be destroyed and overwritten with the eigenvector basis. */ ldz = n; /* Leading dimension of "z". In our case, the number of lines of "z". */ sigma.re = 0.; sigma.im = 0.; /* The shift. Not used in this case: we deal with the shift "by hand". */ workev = (complex_16*)Malloc(2 * ncv * sizeof(complex_16)); /* Workspace */ if(bmat != 'I' || iparam[6] != 1){ Message::Error("General and/or shift-invert mode should not be used"); return; } /* Create temp vectors and matrices and apply shift. Warning: with PETSc, the shifting can be very slow if the masks are very different, for example if we are in real arithmetic and have one real matrix and one complex "simulated-real" matrix */ if(!quad_evp){ LinAlg_CreateVector(&v1, &DofData_P->Solver, DofData_P->NbrDof); LinAlg_CreateVector(&v2, &DofData_P->Solver, DofData_P->NbrDof); /* K = K - shift * M */ LinAlg_AddMatrixProdMatrixDouble(K, M, -shift_r, K) ; } else{ /* This is an explanation of our approach to a quadratic eigenvalue problem i.e. - w^2 M x + i w L x + K x = 0. This system is equivalent to (y = i w x) and (i w M y + i w L x + K x = 0), or, in matrix form: | L M | |x| |-K 0 | |x| | I 0 | |y| iw = | 0 I | |y| , or |x| |x| A |y| iw = B |y|. To apply Arpack with a shift 's' (but not in shift inverted mode to avoid the Hermitian constraint!), we build the following operator: (B- sA)^-1 A. To do this, the following computation is performed: (x,y) is transformed to (Solve(D,Lx+sMx+My),Solve(D,-Kx+sMy)) where Solve(D,v) means the solution of the Dx=v linear system and where D=-(s^2M+sL+K). Note that if the number of degrees of freedom is N, the matrix computations are still performed on NxN matrices but the Arpack vector is of size n=2*N. Only the x part of the (x,y) eigenvectors are retained as physical solutions. */ LinAlg_CreateVector(&x, &DofData_P->Solver, DofData_P->NbrDof); LinAlg_CreateVector(&y, &DofData_P->Solver, DofData_P->NbrDof); LinAlg_CreateVector(&v1, &DofData_P->Solver, DofData_P->NbrDof); LinAlg_CreateVector(&w1, &DofData_P->Solver, DofData_P->NbrDof); LinAlg_CreateVector(&w2, &DofData_P->Solver, DofData_P->NbrDof); LinAlg_CreateMatrix(&D, &DofData_P->Solver, DofData_P->NbrDof, DofData_P->NbrDof); /* D = -(shift^2 * M + shift * L + K) */ LinAlg_CopyMatrix(M, &D); LinAlg_AddMatrixProdMatrixDouble(L, &D, shift_r, &D); LinAlg_AddMatrixProdMatrixDouble(K, &D, shift_r, &D); LinAlg_ProdMatrixDouble(&D, -1., &D); } /* Keep calling znaupd again and again until ido == 99 */ k = 0; do { znaupd_(&ido, &bmat, &n, which, &nev, &tol, resid, &ncv, v, &ldv, iparam, ipntr, workd, workl, &lworkl, rwork, &info); if(ido == 1 || ido == -1){ Message::Info("Arpack iteration %d", k+1); if(!quad_evp){ Arpack2GetDP(n, &workd[ipntr[0]-1], &v1); LinAlg_ProdMatrixVector(M, &v1, &v2); if(!k) LinAlg_Solve(K, &v2, &DofData_P->Solver, &v1); else LinAlg_SolveAgain(K, &v2, &DofData_P->Solver, &v1); GetDP2Arpack(&v1, &workd[ipntr[1]-1]); } else{ Arpack2GetDPSplit(n, &workd[ipntr[0]-1], &x, &y); LinAlg_ProdMatrixVector(M, &y, &w2); LinAlg_ProdMatrixVector(L, &x, &v1); LinAlg_AddVectorVector(&v1, &w2, &v1); LinAlg_ProdMatrixVector(M, &x, &w1); LinAlg_AddVectorProdVectorDouble(&v1, &w1, shift_r, &v1); if(!k) LinAlg_Solve(&D, &v1, &DofData_P->Solver, &w1); else LinAlg_SolveAgain(&D, &v1, &DofData_P->Solver, &w1); LinAlg_ProdMatrixVector(K, &x, &v1); LinAlg_ProdVectorDouble(&v1, -1., &v1); LinAlg_AddVectorProdVectorDouble(&v1, &w2, shift_r, &v1); LinAlg_SolveAgain(&D, &v1, &DofData_P->Solver, &w2); GetDP2ArpackMerge(&w1, &w2, &workd[ipntr[1]-1]); } k++; } else if(ido == 99){ /* We're done! */ break; } else{ Message::Info("Arpack code = %d (ignored)", info); } } while (1); Message::Info("Arpack required %d iterations", k); /* Testing for errors */ if(info == 0){ /* OK */ } else if(info == 1){ Message::Warning("Maxmimum number of iteration reached in EigenSolve"); } else if(info == 2){ Message::Warning("No shifts could be applied during a cycle of the"); Message::Warning("Implicitly restarted Arnoldi iteration. One possibility"); Message::Warning("is to increase the size of NCV relative to NEV."); } else if(info < 0){ Message::Error("Arpack code = %d", info); } else{ Message::Warning("Arpack code = %d (unknown)", info); } /* Call to zneupd for post-processing */ zneupd_(&rvec, &howmny, select, d, z, &ldz, &sigma, workev, &bmat, &n, which, &nev, &tol, resid, &ncv, v, &ldv, iparam, ipntr, workd, workl, &lworkl, rwork, &info); /* Test for errors */ if(info != 0) Message::Error("Arpack code = %d (eigenvector post-processing)", info); /* Compute the unshifted eigenvalues and print them, and store the associated eigenvectors */ newsol = 0; for (k = 0; k < nev; k++){ /* Unshift the eigenvalues */ tmp = SQU(d[k].re) + SQU(d[k].im); d[k].re = shift_r + d[k].re/tmp; d[k].im = shift_i - d[k].im/tmp; if(!quad_evp){ /* Eigenvalue = omega^2 */ omega2.re = d[k].re; omega2.im = d[k].im; abs = sqrt(SQU(omega2.re) + SQU(omega2.im)); arg = atan2(omega2.im, omega2.re); omega.re = sqrt(abs) * cos(0.5*arg); omega.im = sqrt(abs) * sin(0.5*arg); f.re = omega.re / TWO_PI; f.im = omega.im / TWO_PI; } else{ /* Eigenvalue = i*omega */ omega.re = d[k].im; omega.im = -d[k].re; omega2.re = SQU(omega.re) - SQU(omega.im); omega2.im = 2. * omega.re * omega.im; f.re = omega.re / TWO_PI; f.im = omega.im / TWO_PI; } Message::Info("Eigenvalue %03d: w^2 = %.12e %s %.12e * i", k+1, omega2.re, (omega2.im > 0) ? "+" : "-", (omega2.im > 0) ? omega2.im : -omega2.im); Message::Info(" w = %.12e %s %.12e * i", omega.re, (omega.im > 0) ? "+" : "-", (omega.im > 0) ? omega.im : -omega.im); Message::Info(" f = %.12e %s %.12e * i", f.re, (f.im > 0) ? "+" : "-", (f.im > 0) ? f.im : -f.im); /* Update the current value of Time and TimeImag so that $EigenvalueReal and $EigenvalueImag are up-to-date */ Current.Time = omega.re; Current.TimeImag = omega.im; // test filter expression and continue without storing if false if(FilterExpressionIndex >= 0){ struct Value val; Get_ValueOfExpressionByIndex(FilterExpressionIndex, NULL, 0., 0., 0., &val); if(!val.Val[0]){ Message::Debug("Skipping eigenvalue %g + i * %g", omega.re, omega.im); continue; } } Message::AddOnelabNumberChoice(Message::GetOnelabClientName() + "/Re(Omega)", omega.re); Message::AddOnelabNumberChoice(Message::GetOnelabClientName() + "/Im(Omega)", omega.im); if(newsol) { /* Create new solution */ Solution_S.TimeFunctionValues = NULL; LinAlg_CreateVector(&Solution_S.x, &DofData_P->Solver, DofData_P->NbrDof); List_Add(DofData_P->Solutions, &Solution_S); DofData_P->CurrentSolution = (struct Solution*) List_Pointer(DofData_P->Solutions, List_Nbr(DofData_P->Solutions)-1); } newsol = 1; DofData_P->CurrentSolution->Time = omega.re; DofData_P->CurrentSolution->TimeImag = omega.im; DofData_P->CurrentSolution->TimeStep = (int)Current.TimeStep; Free(DofData_P->CurrentSolution->TimeFunctionValues); DofData_P->CurrentSolution->TimeFunctionValues = NULL; DofData_P->CurrentSolution->SolutionExist = 1; int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; for(l = 0; l < DofData_P->NbrDof; l += incr){ j = l / incr; if(Current.NbrHar == 2){ LinAlg_SetComplexInVector(z[k*n+j].re, z[k*n+j].im, &DofData_P->CurrentSolution->x, l, l+1); } else{ LinAlg_SetDoubleInVector(z[k*n+j].re, &DofData_P->CurrentSolution->x, l); } } LinAlg_AssembleVector(&DofData_P->CurrentSolution->x); /* Arpack returns eigenvectors normalized in L-2 norm. Renormalize them in L-infty norm so that the absolute value of the largest element is 1 */ tmp = 0.; for(l = 0; l < DofData_P->NbrDof; l += incr){ if(Current.NbrHar == 2){ LinAlg_GetComplexInVector(&d1, &d2, &DofData_P->CurrentSolution->x, l, l+1); abs = sqrt(SQU(d1) + SQU(d2)); } else{ LinAlg_GetDoubleInVector(&d1, &DofData_P->CurrentSolution->x, l); abs = sqrt(SQU(d1)); } if(abs > tmp) tmp = abs; } if(tmp > 1.e-16) LinAlg_ProdVectorDouble(&DofData_P->CurrentSolution->x, 1./tmp, &DofData_P->CurrentSolution->x); /* Increment the global timestep counter so that a future GenerateSystem knows which solutions exist */ Current.TimeStep += 1.; } /* Deallocate */ if(!quad_evp){ LinAlg_DestroyVector(&v1); LinAlg_DestroyVector(&v2); } else{ LinAlg_DestroyVector(&x); LinAlg_DestroyVector(&y); LinAlg_DestroyVector(&v1); LinAlg_DestroyVector(&w1); LinAlg_DestroyVector(&w2); LinAlg_DestroyMatrix(&D); } Free(resid); Free(v); Free(workd); Free(workl); Free(rwork); Free(select); Free(d); Free(z); Free(workev); } #endif getdp-2.7.0-source/Legacy/BF.h000644 001750 001750 00000021042 12473553042 017451 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _BF_H_ #define _BF_H_ #include "ProData.h" #define BF_ARG struct Element * Element, int NumEntity, \ double u, double v, double w, double Value[] /* H^1 Basis Functions and their gradients */ void BF_Node(BF_ARG) ; void BF_Node_2E(BF_ARG) ; void BF_Node_2F(BF_ARG) ; void BF_Node_2V(BF_ARG) ; void BF_Node_3E(BF_ARG) ; void BF_Node_3F(BF_ARG) ; void BF_Node_3V(BF_ARG) ; void BF_GradNode(BF_ARG) ; void BF_GradNode_2E(BF_ARG) ; void BF_GradNode_2F(BF_ARG) ; void BF_GradNode_2V(BF_ARG) ; void BF_GradNode_3E(BF_ARG) ; void BF_GradNode_3F(BF_ARG) ; void BF_GradNode_3V(BF_ARG) ; void BF_GroupOfNodes(BF_ARG) ; void BF_GroupOfNodes_2E(BF_ARG) ; void BF_GroupOfNodes_2F(BF_ARG) ; void BF_GroupOfNodes_2V(BF_ARG) ; void BF_GroupOfNodes_3E(BF_ARG) ; void BF_GroupOfNodes_3F(BF_ARG) ; void BF_GroupOfNodes_3V(BF_ARG) ; void BF_GradGroupOfNodes(BF_ARG) ; void BF_GradGroupOfNodes_2E(BF_ARG) ; void BF_GradGroupOfNodes_2F(BF_ARG) ; void BF_GradGroupOfNodes_2V(BF_ARG) ; void BF_GradGroupOfNodes_3E(BF_ARG) ; void BF_GradGroupOfNodes_3F(BF_ARG) ; void BF_GradGroupOfNodes_3V(BF_ARG) ; /* H(curl) basis Functions and their curls */ void BF_Edge(BF_ARG) ; void BF_Edge_2E(BF_ARG) ; void BF_Edge_2F(BF_ARG) ; void BF_Edge_2V(BF_ARG) ; void BF_Edge_3E(BF_ARG) ; void BF_Edge_3F_a(BF_ARG) ; void BF_Edge_3F_b(BF_ARG) ; void BF_Edge_3F_c(BF_ARG) ; void BF_Edge_3V(BF_ARG) ; void BF_Edge_4E(BF_ARG) ; void BF_Edge_4F(BF_ARG) ; void BF_Edge_4V(BF_ARG) ; void BF_CurlEdge(BF_ARG) ; void BF_CurlEdge_2E(BF_ARG) ; void BF_CurlEdge_2F(BF_ARG) ; void BF_CurlEdge_2V(BF_ARG) ; void BF_CurlEdge_3E(BF_ARG) ; void BF_CurlEdge_3F_a(BF_ARG) ; void BF_CurlEdge_3F_b(BF_ARG) ; void BF_CurlEdge_3F_c(BF_ARG) ; void BF_CurlEdge_3V(BF_ARG) ; void BF_CurlEdge_4E(BF_ARG) ; void BF_CurlEdge_4F(BF_ARG) ; void BF_CurlEdge_4V(BF_ARG) ; void BF_GroupOfEdges(BF_ARG) ; void BF_GroupOfEdges_2E(BF_ARG) ; void BF_GroupOfEdges_2F(BF_ARG) ; void BF_GroupOfEdges_2V(BF_ARG) ; void BF_GroupOfEdges_3E(BF_ARG) ; void BF_GroupOfEdges_3F_a(BF_ARG) ; void BF_GroupOfEdges_3F_b(BF_ARG) ; void BF_GroupOfEdges_3F_c(BF_ARG) ; void BF_GroupOfEdges_3V(BF_ARG) ; void BF_GroupOfEdges_4E(BF_ARG) ; void BF_GroupOfEdges_4F(BF_ARG) ; void BF_GroupOfEdges_4V(BF_ARG) ; void BF_CurlGroupOfEdges(BF_ARG) ; void BF_CurlGroupOfEdges_2E(BF_ARG) ; void BF_CurlGroupOfEdges_2F(BF_ARG) ; void BF_CurlGroupOfEdges_2V(BF_ARG) ; void BF_CurlGroupOfEdges_3E(BF_ARG) ; void BF_CurlGroupOfEdges_3F_a(BF_ARG) ; void BF_CurlGroupOfEdges_3F_b(BF_ARG) ; void BF_CurlGroupOfEdges_3F_c(BF_ARG) ; void BF_CurlGroupOfEdges_3V(BF_ARG) ; void BF_CurlGroupOfEdges_4E(BF_ARG) ; void BF_CurlGroupOfEdges_4F(BF_ARG) ; void BF_CurlGroupOfEdges_4V(BF_ARG) ; /* H(curl, perp) basis Functions and their curls */ void BF_PerpendicularEdge(BF_ARG) ; void BF_PerpendicularEdge_2E(BF_ARG) ; void BF_PerpendicularEdge_2F(BF_ARG) ; void BF_PerpendicularEdge_2V(BF_ARG) ; void BF_PerpendicularEdge_3E(BF_ARG) ; void BF_PerpendicularEdge_3F(BF_ARG) ; void BF_PerpendicularEdge_3V(BF_ARG) ; void BF_CurlPerpendicularEdge(BF_ARG) ; void BF_CurlPerpendicularEdge_2E(BF_ARG) ; void BF_CurlPerpendicularEdge_2F(BF_ARG) ; void BF_CurlPerpendicularEdge_2V(BF_ARG) ; void BF_CurlPerpendicularEdge_3E(BF_ARG) ; void BF_CurlPerpendicularEdge_3F(BF_ARG) ; void BF_CurlPerpendicularEdge_3V(BF_ARG) ; void BF_GroupOfPerpendicularEdges(BF_ARG) ; void BF_GroupOfPerpendicularEdges_2E(BF_ARG) ; void BF_GroupOfPerpendicularEdges_2F(BF_ARG) ; void BF_GroupOfPerpendicularEdges_2V(BF_ARG) ; void BF_GroupOfPerpendicularEdges_3E(BF_ARG) ; void BF_GroupOfPerpendicularEdges_3F(BF_ARG) ; void BF_GroupOfPerpendicularEdges_3V(BF_ARG) ; void BF_CurlGroupOfPerpendicularEdges(BF_ARG) ; void BF_CurlGroupOfPerpendicularEdges_2E(BF_ARG) ; void BF_CurlGroupOfPerpendicularEdges_2F(BF_ARG) ; void BF_CurlGroupOfPerpendicularEdges_2V(BF_ARG) ; void BF_CurlGroupOfPerpendicularEdges_3E(BF_ARG) ; void BF_CurlGroupOfPerpendicularEdges_3F(BF_ARG) ; void BF_CurlGroupOfPerpendicularEdges_3V(BF_ARG) ; /* H(div) basis Functions and their divergences */ void BF_Facet(BF_ARG) ; void BF_DivFacet(BF_ARG) ; void BF_GroupOfFacets(BF_ARG) ; void BF_DivGroupOfFacets(BF_ARG) ; /* H(div, perp) basis Functions and their divergences */ void BF_PerpendicularFacet(BF_ARG) ; void BF_PerpendicularFacet_2E(BF_ARG) ; void BF_PerpendicularFacet_2F(BF_ARG) ; void BF_PerpendicularFacet_2V(BF_ARG) ; void BF_PerpendicularFacet_3E(BF_ARG) ; void BF_PerpendicularFacet_3F_a(BF_ARG) ; void BF_PerpendicularFacet_3F_b(BF_ARG) ; void BF_PerpendicularFacet_3F_c(BF_ARG) ; void BF_PerpendicularFacet_3V(BF_ARG) ; void BF_PerpendicularFacet_4E(BF_ARG) ; void BF_PerpendicularFacet_4F(BF_ARG) ; void BF_PerpendicularFacet_4V(BF_ARG) ; void BF_DivPerpendicularFacet(BF_ARG) ; void BF_DivPerpendicularFacet_2E(BF_ARG) ; void BF_DivPerpendicularFacet_2F(BF_ARG) ; void BF_DivPerpendicularFacet_2V(BF_ARG) ; void BF_DivPerpendicularFacet_3E(BF_ARG) ; void BF_DivPerpendicularFacet_3F_a(BF_ARG) ; void BF_DivPerpendicularFacet_3F_b(BF_ARG) ; void BF_DivPerpendicularFacet_3F_c(BF_ARG) ; void BF_DivPerpendicularFacet_3V(BF_ARG) ; void BF_DivPerpendicularFacet_4E(BF_ARG) ; void BF_DivPerpendicularFacet_4F(BF_ARG) ; void BF_DivPerpendicularFacet_4V(BF_ARG) ; /* L^2 basis Functions */ void BF_Volume(BF_ARG) ; void BF_VolumeX(BF_ARG) ; void BF_VolumeY(BF_ARG) ; void BF_VolumeZ(BF_ARG) ; /* (H^1)^3 Basis Functions */ void BF_NodeX(BF_ARG) ; void BF_NodeY(BF_ARG) ; void BF_NodeZ(BF_ARG) ; void BF_NodeX_2E(BF_ARG) ; void BF_NodeY_2E(BF_ARG) ; void BF_NodeZ_2E(BF_ARG) ; void BF_NodeX_2F(BF_ARG) ; void BF_NodeY_2F(BF_ARG) ; void BF_NodeZ_2F(BF_ARG) ; void BF_NodeX_2V(BF_ARG) ; void BF_NodeY_2V(BF_ARG) ; void BF_NodeZ_2V(BF_ARG) ; void BF_NodeX_3E(BF_ARG) ; void BF_NodeY_3E(BF_ARG) ; void BF_NodeZ_3E(BF_ARG) ; void BF_NodeX_3F(BF_ARG) ; void BF_NodeY_3F(BF_ARG) ; void BF_NodeZ_3F(BF_ARG) ; void BF_NodeX_3V(BF_ARG) ; void BF_NodeY_3V(BF_ARG) ; void BF_NodeZ_3V(BF_ARG) ; void BF_NodeX_D1(BF_ARG) ; void BF_NodeY_D1(BF_ARG) ; void BF_NodeZ_D1(BF_ARG) ; void BF_NodeX_D1_2E(BF_ARG) ; void BF_NodeY_D1_2E(BF_ARG) ; void BF_NodeZ_D1_2E(BF_ARG) ; void BF_NodeX_D1_2F(BF_ARG) ; void BF_NodeY_D1_2F(BF_ARG) ; void BF_NodeZ_D1_2F(BF_ARG) ; void BF_NodeX_D1_2V(BF_ARG) ; void BF_NodeY_D1_2V(BF_ARG) ; void BF_NodeZ_D1_2V(BF_ARG) ; void BF_NodeX_D1_3E(BF_ARG) ; void BF_NodeY_D1_3E(BF_ARG) ; void BF_NodeZ_D1_3E(BF_ARG) ; void BF_NodeX_D1_3F(BF_ARG) ; void BF_NodeY_D1_3F(BF_ARG) ; void BF_NodeZ_D1_3F(BF_ARG) ; void BF_NodeX_D1_3V(BF_ARG) ; void BF_NodeY_D1_3V(BF_ARG) ; void BF_NodeZ_D1_3V(BF_ARG) ; void BF_NodeX_D2(BF_ARG) ; void BF_NodeY_D2(BF_ARG) ; void BF_NodeZ_D2(BF_ARG) ; void BF_NodeX_D2_2E(BF_ARG) ; void BF_NodeY_D2_2E(BF_ARG) ; void BF_NodeZ_D2_2E(BF_ARG) ; void BF_NodeX_D2_2F(BF_ARG) ; void BF_NodeY_D2_2F(BF_ARG) ; void BF_NodeZ_D2_2F(BF_ARG) ; void BF_NodeX_D2_2V(BF_ARG) ; void BF_NodeY_D2_2V(BF_ARG) ; void BF_NodeZ_D2_2V(BF_ARG) ; void BF_NodeX_D2_3E(BF_ARG) ; void BF_NodeY_D2_3E(BF_ARG) ; void BF_NodeZ_D2_3E(BF_ARG) ; void BF_NodeX_D2_3F(BF_ARG) ; void BF_NodeY_D2_3F(BF_ARG) ; void BF_NodeZ_D2_3F(BF_ARG) ; void BF_NodeX_D2_3V(BF_ARG) ; void BF_NodeY_D2_3V(BF_ARG) ; void BF_NodeZ_D2_3V(BF_ARG) ; void BF_NodeX_D12(BF_ARG) ; void BF_NodeY_D12(BF_ARG) ; void BF_NodeZ_D12(BF_ARG) ; void BF_NodeX_D12_2E(BF_ARG) ; void BF_NodeY_D12_2E(BF_ARG) ; void BF_NodeZ_D12_2E(BF_ARG) ; void BF_GradNodeRealCoord(BF_ARG) ; void BF_GroupOfNodesX(BF_ARG) ; void BF_GroupOfNodesY(BF_ARG) ; void BF_GroupOfNodesZ(BF_ARG) ; void BF_GroupOfNodesX_D1(BF_ARG) ; void BF_GroupOfNodesY_D1(BF_ARG) ; void BF_GroupOfNodesZ_D1(BF_ARG) ; void BF_GroupOfNodesX_D2(BF_ARG) ; void BF_GroupOfNodesY_D2(BF_ARG) ; void BF_GroupOfNodesZ_D2(BF_ARG) ; void BF_GroupOfNodesX_D12(BF_ARG) ; void BF_GroupOfNodesY_D12(BF_ARG) ; void BF_GroupOfNodesZ_D12(BF_ARG) ; /* Special basis Functions */ void BF_Zero(BF_ARG) ; void BF_One(BF_ARG) ; void BF_OneZ(BF_ARG) ; void BF_Region(BF_ARG) ; void BF_RegionX(BF_ARG) ; void BF_RegionY(BF_ARG) ; void BF_RegionZ(BF_ARG) ; void BF_dRegion(BF_ARG) ; void BF_dRegionX(BF_ARG) ; void BF_dRegionY(BF_ARG) ; void BF_dRegionZ(BF_ARG) ; void BF_Global(BF_ARG) ; void BF_dGlobal(BF_ARG) ; void BF_Wire(BF_ARG) ; void BF_DivWire(BF_ARG) ; #undef BF_ARG #endif getdp-2.7.0-source/Legacy/F_BiotSavart.cpp000644 001750 001750 00000004543 12473553042 022047 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Ruth Sabariego // #include #include "ProData.h" #include "F.h" #include "Message.h" #define ONE_OVER_TWO_PI 1.5915494309189534E-01 #define ONE_OVER_FOUR_PI 7.9577471545947668E-02 #define SQU(a) ((a)*(a)) #define CUB(a) ((a)*(a)*(a)) extern struct CurrentData Current ; /* ------------------------------------------------------------------------ */ /* F _ B i o t S a v a r t */ /* ------------------------------------------------------------------------ */ void F_BiotSavart(F_ARG) { double r, xxs, yys, zzs ; V->Type = VECTOR ; switch((int)Fct->Para[0]){ case _2D : xxs = Current.x-Current.xs ; yys = Current.y-Current.ys ; r = SQU(xxs)+SQU(yys) ; if(!r) Message::Error("1/0 in 'F_BiotSavart'") ; V->Val[0] = ONE_OVER_TWO_PI * xxs / r ; V->Val[1] = ONE_OVER_TWO_PI * yys / r ; V->Val[2] = 0. ; V->Val[MAX_DIM ] = V->Val[MAX_DIM + 1] = V->Val[MAX_DIM + 2] = 0. ; break; case _3D : xxs = Current.x-Current.xs ; yys = Current.y-Current.ys ; zzs = Current.z-Current.zs ; r = sqrt(SQU(xxs)+SQU(yys)+SQU(zzs)) ; if(!r) Message::Error("1/0 in 'F_BiotSavart'") ; V->Val[0] = ONE_OVER_FOUR_PI * xxs/ CUB(r) ; V->Val[1] = ONE_OVER_FOUR_PI * yys/ CUB(r) ; V->Val[2] = ONE_OVER_FOUR_PI * zzs/ CUB(r) ; V->Val[MAX_DIM] = V->Val[MAX_DIM + 1 ] = V->Val[MAX_DIM + 2 ] =0. ; break; default: Message::Error("Bad dimension for BiotSavart"); break; } } void F_Pocklington(F_ARG) { double r, xxs, yys, zzs ; double k , kr, cte, a, re, im ; V->Type = SCALAR ; k = Fct->Para[0] ; a = Fct->Para[1] ; xxs = Current.x-Current.xs ; yys = Current.y-Current.ys ; zzs = Current.z-Current.zs ; r = sqrt(SQU(xxs)+SQU(yys)+SQU(zzs)+ a*a ) ; if(!r) Message::Error("1/0 in 'F_Pocklington'") ; kr = k*r ; cte = ONE_OVER_FOUR_PI/(r*r*r*r*r); re = 2*SQU(r)-3*SQU(a) + SQU(kr*a); im = kr * (2*SQU(r)-3*SQU(a)) ; V->Val[0] = cte * (cos(kr)* re + sin(kr)*im) ; V->Val[MAX_DIM] = cte * (-sin(kr) * re + cos(kr)*im) ; } #undef F_ARG getdp-2.7.0-source/Legacy/GF.h000644 001750 001750 00000003013 12473553042 017454 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _GF_H_ #define _GF_H_ #include "ProData.h" /* ------------------------------------------------------------------------ */ /* G r e e n F u n c t i o n s */ /* ------------------------------------------------------------------------ */ #define GF_ARG struct Function * Fct, struct Value * A, struct Value * V void GF_Laplace (GF_ARG) ; void GF_GradLaplace (GF_ARG) ; void GF_NPxGradLaplace (GF_ARG) ; void GF_NSxGradLaplace (GF_ARG) ; void GF_ApproximateLaplace (GF_ARG) ; void GF_Helmholtz (GF_ARG) ; void GF_GradHelmholtz (GF_ARG) ; void GF_NSxGradHelmholtz (GF_ARG) ; void GF_NPxGradHelmholtz (GF_ARG) ; void GF_HelmholtzThinWire (GF_ARG) ; #define GF_ARGX \ struct Element * Element, struct Function * Fct, \ void (*xFunctionBF) (), int EntityNum, \ double x, double y, double z, struct Value * Val void GF_LaplacexForm (GF_ARGX) ; void GF_GradLaplacexForm (GF_ARGX) ; void GF_NPxGradLaplacexForm (GF_ARGX) ; void GF_NSxGradLaplacexForm (GF_ARGX) ; void GF_ApproximateLaplacexForm (GF_ARGX) ; void GF_HelmholtzxForm (GF_ARGX) ; #endif getdp-2.7.0-source/Legacy/Cal_SolutionErrorRatio.cpp000644 001750 001750 00000012454 12473553042 024130 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Michael Asam #include #include #include #include "ProData.h" #include "DofData.h" #include "SolvingOperations.h" #include "Message.h" void Cal_SolutionErrorRatio(gVector *dx, gVector *x, double reltol, double abstol, int NormType, double *ErrorRatio) { int xLength; double AbsVal_x, AbsVal_dx, ImagVal_x, ImagVal_dx; double *ErrorRatioVec; bool Is_NaN_or_Inf; LinAlg_GetVectorSize(dx, &xLength); ErrorRatioVec = new double[xLength]; *ErrorRatio = 0.; Is_NaN_or_Inf = false; for (int i = 0; i < xLength; i++) { if (gSCALAR_SIZE == 1) { LinAlg_GetAbsDoubleInVector(&AbsVal_x, x, i) ; LinAlg_GetAbsDoubleInVector(&AbsVal_dx, dx, i) ; } if (gSCALAR_SIZE == 2) { LinAlg_GetComplexInVector(&AbsVal_x, &ImagVal_x, x, i, -1); LinAlg_GetComplexInVector(&AbsVal_dx, &ImagVal_dx, dx, i, -1); AbsVal_x = sqrt( AbsVal_x*AbsVal_x + ImagVal_x*ImagVal_x); AbsVal_dx = sqrt( AbsVal_dx*AbsVal_dx + ImagVal_dx*ImagVal_dx); } ErrorRatioVec[i] = AbsVal_dx / (abstol + reltol * AbsVal_x); if ( ErrorRatioVec[i] != ErrorRatioVec[i] || // Solution is NaN ErrorRatioVec[i] == -std::numeric_limits::infinity() || // Solution is -Inf ErrorRatioVec[i] == std::numeric_limits::infinity() ) // Solution is Inf Is_NaN_or_Inf = true; } if ( Is_NaN_or_Inf ) { Message::Warning("No valid solution found (NaN or Inf)!"); *ErrorRatio = std::numeric_limits::quiet_NaN(); } else{ // Calculating the norm of the error ratio vector switch (NormType){ case LINFNORM: for (int i = 0; i < xLength; i++) { if (ErrorRatioVec[i] > *ErrorRatio) *ErrorRatio = ErrorRatioVec[i]; } break; case L1NORM: for (int i = 0; i < xLength; i++) { *ErrorRatio += ErrorRatioVec[i]; } break; case MEANL1NORM: for (int i = 0; i < xLength; i++) { *ErrorRatio += ErrorRatioVec[i]; } *ErrorRatio /= xLength; break; case L2NORM: for (int i = 0; i < xLength; i++) { *ErrorRatio += ErrorRatioVec[i] * ErrorRatioVec[i]; } *ErrorRatio = sqrt(*ErrorRatio); break; case MEANL2NORM: for (int i = 0; i < xLength; i++) { *ErrorRatio += ErrorRatioVec[i] * ErrorRatioVec[i]; } *ErrorRatio = sqrt(*ErrorRatio / xLength); break; default: Message::Error("Wrong error norm in Cal_SolutionErrorRatio"); break; } } delete [] ErrorRatioVec; } /* ------------------------------------------------------------------------ */ /* C a l _ S o l u t i o n E r r o r */ /* ------------------------------------------------------------------------ */ void Cal_SolutionError(gVector *dx, gVector *x, int diff, double *MeanError) { // This is not a very good implementation: it should be replaced with // Cal_SolutionErrorRatio above int i, n; double valx, valdx, valxi = 0., valdxi = 0.,errsqr = 0., xmoy = 0., dxmoy = 0.; double tol, nvalx, nvaldx ; LinAlg_GetVectorSize(dx, &n); if (gSCALAR_SIZE == 1) for (i=0 ; i 1.e-30) { tol = xmoy*1.e-10 ; if (gSCALAR_SIZE == 1) for (i=0 ; i tol) errsqr += fabs(valdx-valx)/valx ; else errsqr += fabs(valdx-valx) ; } else{ if (valx > tol) errsqr += valdx/valx ; else errsqr += valdx ; } } if (gSCALAR_SIZE == 2) for (i=0 ; i tol) errsqr += sqrt((valdx-valx)*(valdx-valx)+(valdxi-valxi)*(valdxi-valxi))/nvalx ; else errsqr += sqrt((valdx-valx)*(valdx-valx)+(valdxi-valxi)*(valdxi-valxi)); } else{ if (nvalx > tol) errsqr += nvaldx/nvalx ; else errsqr += nvaldx ; } } *MeanError = errsqr/(double)n ; } else{ if (dxmoy > 1.e-30) *MeanError = 1. ; else *MeanError = 0. ; } } getdp-2.7.0-source/Legacy/Gauss_Tetrahedron.cpp000644 001750 001750 00000006357 12473553042 023152 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "Gauss.h" #include "Gauss_Tetrahedron.h" #include "Message.h" #include "MallocUtils.h" /* Gauss integration over a tetrahedron */ void Gauss_Tetrahedron(int Nbr_Points, int Num, double *u, double *v, double *w, double *wght) { switch (Nbr_Points) { case 1 : *u = xtet1 [Num] ; *v = ytet1 [Num] ; *w = ztet1 [Num] ; *wght = ptet1 [Num] ; break ; case 4 : *u = xtet4 [Num] ; *v = ytet4 [Num] ; *w = ztet4 [Num] ; *wght = ptet4 [Num] ; break ; case 5 : *u = xtet5 [Num] ; *v = ytet5 [Num] ; *w = ztet5 [Num] ; *wght = ptet5 [Num] ; break ; case 15 : *u = xtet15[Num] ; *v = ytet15[Num] ; *w = ztet15[Num] ; *wght = ptet15[Num] ; break ; case 16 : *u = xtet16[Num] ; *v = ytet16[Num] ; *w = ztet16[Num] ; *wght = ptet16[Num] ; break ; case 17 : *u = xtet17[Num] ; *v = ytet17[Num] ; *w = ztet17[Num] ; *wght = ptet17[Num] ; break ; case 29 : *u = xtet29[Num] ; *v = ytet29[Num] ; *w = ztet29[Num] ; *wght = ptet29[Num] ; break ; default : Message::Error("Wrong number of Gauss Points for Tetrahedron: " "valid choices: 1, 4, 5, 15, 16, 17, 29"); break; } } /* Degenerate n1Xn2Xn3 Gauss-Legendre scheme to integrate over a tet */ static int gltet[MAX_LINE_POINTS] = {-1}; static double *glxtet[MAX_LINE_POINTS], *glytet[MAX_LINE_POINTS] ; static double *glztet[MAX_LINE_POINTS], *glptet[MAX_LINE_POINTS]; void hexToTet(double xi,double eta, double zeta, double *r, double *s, double *t, double *J) { double r1,rs1; *r = 0.5e0*(1.0e0+xi); r1 = 1.0e0-(*r); *s = 0.5e0*(1.0e0+eta)*r1; rs1 = 1.0e0-(*r)-(*s); *t = 0.5e0*(1.0e0+zeta)*rs1; *J = 0.125e0*r1*rs1; } void GaussLegendre_Tetrahedron(int Nbr_Points, int Num, double *u, double *v, double *w, double *wght) { int i,j,k,index=0,nb; double pt1,pt2,pt3,wt1,wt2,wt3,dJ,dum; nb = (int)pow((double)Nbr_Points, 1./3.); if(nb*nb*nb != Nbr_Points || nb > MAX_LINE_POINTS){ Message::Error("Number of points should be n^3 with n in [1,%d]", MAX_LINE_POINTS) ; return; } if(gltet[0] < 0) for(i=0 ; i < MAX_LINE_POINTS ; i++) gltet[i] = 0 ; if(!gltet[nb-1]){ Message::Info("Computing degenerate GaussLegendre %dX%dX%d for Tetrahedron", nb, nb, nb); glxtet[nb-1] = (double*)Malloc(Nbr_Points*sizeof(double)); glytet[nb-1] = (double*)Malloc(Nbr_Points*sizeof(double)); glztet[nb-1] = (double*)Malloc(Nbr_Points*sizeof(double)); glptet[nb-1] = (double*)Malloc(Nbr_Points*sizeof(double)); for(i=0; i < nb; i++) { Gauss_Line(nb, i, &pt1, &dum, &dum, &wt1); for(j=0; j < nb; j++) { Gauss_Line(nb, j, &pt2, &dum, &dum, &wt2); for(k=0; k < nb; k++) { Gauss_Line(nb, k, &pt3, &dum, &dum, &wt3); hexToTet(pt1, pt2, pt3, &glxtet[nb-1][index], &glytet[nb-1][index], &glztet[nb-1][index], &dJ); glptet[nb-1][index++] = dJ*wt1*wt2*wt3; } } } gltet[nb-1] = 1; } *u = glxtet[nb-1][Num] ; *v = glytet[nb-1][Num] ; *w = glztet[nb-1][Num] ; *wght = glptet[nb-1][Num] ; } getdp-2.7.0-source/Legacy/Pos_Formulation.h000644 001750 001750 00000001661 12473553042 022307 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _POS_FORMULATION_H_ #define _POS_FORMULATION_H_ #include "ProData.h" #include "ListUtils.h" void Pos_Formulation(struct Formulation *Formulation_P, struct PostProcessing *PostProcessing_P, struct PostSubOperation *PostSubOperation_P); void Pos_FemFormulation(struct Formulation * Formulation_P, struct PostQuantity * LocalPQ, struct PostQuantity * CummulativePQ, int Order, struct PostSubOperation * PostSubOperation_P) ; int Pos_InitTimeSteps(struct PostSubOperation * PostSubOperation_P) ; void Pos_InitAllSolutions(List_T * TimeStep_L, int Index_TimeStep) ; void Pos_ResampleTime(struct PostOperation *PostOperation_P); #endif getdp-2.7.0-source/Legacy/Treatment_Formulation.h000644 001750 001750 00000000603 12473553042 023504 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _TREATMENT_FORMULATION_H_ #define _TREATMENT_FORMULATION_H_ #include "ProData.h" void Treatment_Formulation(struct Formulation * Formulation_P) ; #endif getdp-2.7.0-source/Legacy/BF_Facet.cpp000644 001750 001750 00000015061 12473553042 021112 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "ProData.h" #include "Message.h" #define NoFace Message::Error("Missing Face Entity in Element %d", Element->Num) /* ------------------------------------------------------------------------ */ /* B F _ F a c e t */ /* ------------------------------------------------------------------------ */ #define WrongNumFacet Message::Error("Wrong Facet number in 'BF_Facet'") void BF_Facet(struct Element * Element, int NumFacet, double u, double v, double w, double s[]) { switch (Element->Type) { case LINE : switch(NumFacet) { case 1 : s[0] = 1. ; s[1] = 0. ; s[2] = 0. ; break ; default : WrongNumFacet ; } break ; case TRIANGLE : switch(NumFacet) { case 1 : s[0] = 0. ; s[1] = 0. ; s[2] = 2. ; break ; default : WrongNumFacet ; } break ; case QUADRANGLE : switch(NumFacet) { case 1 : s[0] = 0. ; s[1] = 0. ; s[2] = 0.5 ; break ; default : WrongNumFacet ; } break ; case TETRAHEDRON : switch(NumFacet) { case 1 : s[0] = 2. * u ; s[1] = -2. * (1.- v) ; s[2] = 2. * w ; break ; case 2 : s[0] = 2. * u ; s[1] = 2. * v ; s[2] = -2. * (1.- w) ; break ; case 3 : s[0] = -2. * (1.- u) ; s[1] = 2. * v ; s[2] = 2. * w ; break ; case 4 : s[0] = 2. * u ; s[1] = 2. * v ; s[2] = 2. * w ; break ; default : WrongNumFacet ; } break ; case HEXAHEDRON : switch(NumFacet) { case 1 : s[0] = 0. ; s[1] = -0.25 * (1. - v) ; s[2] = 0. ; break ; case 2 : s[0] = 0. ; s[1] = 0. ; s[2] = -0.25 * (1. - w) ; break ; case 3 : s[0] = -0.25 * (1. - u) ; s[1] = 0. ; s[2] = 0. ; break ; case 4 : s[0] = 0.25 * (1. + u) ; s[1] = 0. ; s[2] = 0. ; break ; case 5 : s[0] = 0. ; s[1] = 0.25 * (1. + v) ; s[2] = 0. ; break ; case 6 : s[0] = 0. ; s[1] = 0. ; s[2] = 0.25 * (1. + w) ; break ; default : WrongNumFacet ; } break ; case PRISM : switch(NumFacet) { case 1 : s[0] = u ; s[1] = -(1. - v) ; s[2] = 0. ; break ; case 2 : s[0] = 0. ; s[1] = 0. ; s[2] = -(1. - w) ; break ; case 3 : s[0] = -(1. - u) ; s[1] = v ; s[2] = 0. ; break ; case 4 : s[0] = u ; s[1] = v ; s[2] = 0. ; break ; case 5 : s[0] = 0. ; s[1] = 0. ; s[2] = (1. + w) ; break ; default : WrongNumFacet ; } break ; case PYRAMID : if ( w == 1){ switch(NumFacet) { case 1 : s[0] = 0. ; s[1] = -0.5 ; s[2] = 0.25 ; break ; case 2 : s[0] = 0. ; s[1] = 0. ; s[2] = 0. ; break ; case 3 : s[0] = -0.5 ; s[1] = 0. ; s[2] = 0.25 ; break ; case 4 : s[0] = 0.5 ; s[1] = 0. ; s[2] = 0.25 ; break ; case 5 : s[0] = 0. ; s[1] = 0.5 ; s[2] = 0.25 ; break ; default : WrongNumFacet ; } } else { switch(NumFacet) { case 1 : s[0] = -0.25 * u * w / (1. - w) ; s[1] = 0.25 * (-2. + v + v / (1. - w)) ; s[2] = 0.25 * w ; break ; case 2 : s[0] = 0.25 * u ; s[1] = 0.25 * v ; s[2] = -0.25 * (1. - w) ; break ; case 3 : s[0] = 0.25 * (-2. + u + u / (1. - w)) ; s[1] = -0.25 * v * w / (1. - w) ; s[2] = 0.25 * w ; break ; case 4 : s[0] = 0.25 * ( 2. + u + u / (1. - w)) ; s[1] = -0.25 * v * w / (1. - w); s[2] = 0.25 * w ; break ; case 5 : s[0] = -0.25 * u * w / (1. - w) ; s[1] = 0.25 * ( 2. + v + v / (1. - w)) ; s[2] = 0.25 * w ; break ; default : WrongNumFacet ; } } break ; default : Message::Error("Unknown type of Element in BF_Facet"); break; } if (!Element->GeoElement->NumFacets) NoFace ; if (Element->GeoElement->NumFacets[NumFacet-1] < 0) { s[0] = - s[0] ; s[1] = - s[1] ; s[2] = - s[2] ; } } #undef WrongNumFacet /* ------------------------------------------------------------------------ */ /* B F _ D i v F a c e t */ /* ------------------------------------------------------------------------ */ #define WrongNumFacet Message::Error("Wrong Facet number in 'BF_DivFacet'") void BF_DivFacet(struct Element * Element, int NumFacet, double u, double v, double w, double *s) { switch (Element->Type) { case LINE : switch(NumFacet) { case 1 : *s = 0. ; break ; default : WrongNumFacet ; } break ; case TRIANGLE : switch(NumFacet) { case 1 : *s = 0. ; break ; default : WrongNumFacet ; } break ; case QUADRANGLE : switch(NumFacet) { case 1 : *s = 0. ; break ; default : WrongNumFacet ; } break ; case TETRAHEDRON : switch(NumFacet) { case 1 : *s = 6. ; break ; case 2 : *s = 6. ; break ; case 3 : *s = 6. ; break ; case 4 : *s = 6. ; break ; default : WrongNumFacet ; } break ; case HEXAHEDRON : switch(NumFacet) { case 1 : *s = 0.25 ; break ; case 2 : *s = 0.25 ; break ; case 3 : *s = 0.25 ; break ; case 4 : *s = 0.25 ; break ; case 5 : *s = 0.25 ; break ; case 6 : *s = 0.25 ; break ; default : WrongNumFacet ; } break ; case PRISM : switch(NumFacet) { case 1 : *s = 2. ; break ; case 2 : *s = 1. ; break ; case 3 : *s = 2. ; break ; case 4 : *s = 2. ; break ; case 5 : *s = 1. ; break ; default : WrongNumFacet ; } break ; case PYRAMID : if ( w == 1){ *s = 0. ; } else { switch(NumFacet) { case 1 : *s = -0.25 * w/(1. - w) + 0.25/(1. - w) + 0.5 ; break ; case 2 : *s = 0.75 ; break ; case 3 : *s = -0.25 * w/(1. - w) + 0.25/(1. - w) + 0.5 ; break ; case 4 : *s = -0.25 * w/(1. - w) + 0.25/(1. - w) + 0.5 ; break ; case 5 : *s = -0.25 * w/(1. - w) + 0.25/(1. - w) + 0.5 ; break ; default : WrongNumFacet ; } } break ; default : Message::Error("Unknown type of Element in BF_DivFacet"); break ; } if (!Element->GeoElement->NumFacets) NoFace ; if (Element->GeoElement->NumFacets[NumFacet-1] < 0) { *s = - *s ; } } #undef WrongNumFacet #undef NoFace getdp-2.7.0-source/Legacy/Pos_Format.cpp000644 001750 001750 00000171122 12611677027 021577 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include #include #include #include #include #include "GetDPVersion.h" #include "ProData.h" #include "ProDefine.h" #include "GeoData.h" #include "DofData.h" #include "Pos_Iso.h" #include "Pos_Format.h" #include "Pos_Element.h" #include "Pos_Formulation.h" #include "F.h" #include "Cal_Value.h" #include "Cal_Quantity.h" #include "MallocUtils.h" #include "Message.h" #include "kissfft.hh" #if defined(HAVE_GMSH) #include #include #include #endif #define TWO_PI 6.2831853071795865 #define NBR_MAX_ISO 200 #define SQU(a) ((a)*(a)) extern struct Problem Problem_S ; extern struct CurrentData Current ; extern int Flag_BIN, Flag_GMSH_VERSION; extern FILE *PostStream ; static List_T *PostElement_L = NULL ; static List_T *TimeValue_L = NULL ; /* ------------------------------------------------------------------------ */ /* Gmsh formats */ /* ------------------------------------------------------------------------ */ // global static lists for new-style Gmsh output (cannot be saved incrementally // for each element) static int Gmsh_StartNewView = 0 ; static int NbSP, NbVP, NbTP, NbSL, NbVL, NbTL, NbST, NbVT, NbTT; static int NbSQ, NbVQ, NbTQ, NbSS, NbVS, NbTS, NbSH, NbVH, NbTH; static int NbSI, NbVI, NbTI, NbSY, NbVY, NbTY; static int NbT2; static std::vector SP, VP, TP, SL, VL, TL, ST, VT, TT, SQ, VQ, TQ; static std::vector SS, VS, TS1 /* for petsc */, SH, VH, TH; static std::vector SI, VI, TI, SY, VY, TY, T2D; static std::vector T2C; static char CurrentName[256] = ""; static int CurrentPartitionNumber = 0; static void Gmsh_ResetStaticLists() { NbSP = NbVP = NbTP = NbSL = NbVL = NbTL = 0; NbST = NbVT = NbTT = NbSQ = NbVQ = NbTQ = 0; NbSS = NbVS = NbTS = NbSH = NbVH = NbTH = 0; NbSI = NbVI = NbTI = NbSY = NbVY = NbTY = 0; NbT2 = 0; SP.clear(); VP.clear(); TP.clear(); SL.clear(); VL.clear(); TL.clear(); ST.clear(); VT.clear(); TT.clear(); SQ.clear(); VQ.clear(); TQ.clear(); SS.clear(); VS.clear(); TS1.clear(); SH.clear(); VH.clear(); TH.clear(); SI.clear(); VI.clear(); TI.clear(); SY.clear(); VY.clear(); TY.clear(); T2D.clear(); T2C.clear(); if(!TimeValue_L) TimeValue_L = List_Create(100,1000000,sizeof(double)); else List_Reset(TimeValue_L); } static void Gmsh_StringStart(int Format, double x, double y, double style) { if(Flag_BIN){ /* bricolage: should use Format instead */ T2D.push_back(x); T2D.push_back(y); T2D.push_back(style); T2D.push_back(T2C.size()); NbT2++; } else if(PostStream){ fprintf(PostStream, "T2(%g,%g,%g){", x, y, style); } } static void Gmsh_StringAdd(int Format, int first, char *text) { int i; if(Flag_BIN){ /* bricolage: should use Format instead */ for(i = 0; i < (int)strlen(text)+1; i++) T2C.push_back(text[i]); } else if(PostStream){ if(!first) fprintf(PostStream, ","); fprintf(PostStream, "\"%s\"", text); } } static void Gmsh_StringEnd(int Format) { if(Flag_BIN){ /* bricolage: should use Format instead */ } else if(PostStream){ fprintf(PostStream, "};\n") ; } } static int Gmsh_GetElementType(int Type) { switch(Type){ case POINT : return(15) ; case LINE : return(1) ; case TRIANGLE : return(2) ; case QUADRANGLE : return(3) ; case TETRAHEDRON : return(4) ; case HEXAHEDRON : return(5) ; case PRISM : return(6) ; case PYRAMID : return(7) ; case LINE_2 : return(8) ; case TRIANGLE_2 : return(9) ; case QUADRANGLE_2 : return(10) ; case TETRAHEDRON_2 : return(11) ; case HEXAHEDRON_2 : return(12) ; case PRISM_2 : return(13) ; case PYRAMID_2 : return(14) ; case QUADRANGLE_2_8N : return(16) ; default : Message::Error("Unknown type of element in Gmsh format") ; return(-1) ; } } static void Gmsh_PrintElementNodeData(struct PostSubOperation *PSO_P, int numTimeStep, int numComp, int Nb[8], std::vector *L[8]) { if(!PostStream) return; int N = 0; for(int i = 0; i < 8; i++) N += Nb[i]; if(!N) return; int step = 0; for (int ts = 0; ts < numTimeStep; ts++) { Pos_InitAllSolutions(PSO_P->TimeStep_L, ts); for(int har = 0; har < Current.NbrHar; har++){ fprintf(PostStream, "$ElementNodeData\n"); fprintf(PostStream, "1\n"); fprintf(PostStream, "\"%s\"\n", CurrentName); fprintf(PostStream, "1\n"); fprintf(PostStream, "%.16g\n", Current.Time); fprintf(PostStream, "4\n"); fprintf(PostStream, "%d\n", (PSO_P->OverrideTimeStepValue >= 0) ? PSO_P->OverrideTimeStepValue : (Current.NbrHar > 1 ? step : (int)Current.TimeStep)); fprintf(PostStream, "%d\n", numComp); fprintf(PostStream, "%d\n", N); fprintf(PostStream, "%d\n", CurrentPartitionNumber); for(int i = 0; i < 8; i++){ if(!Nb[i]) continue; int stride = (*L[i]).size() / Nb[i]; for(unsigned int j = 0; j < (*L[i]).size(); j += stride){ double *tmp = &(*L[i])[j]; int num = (int)tmp[0]; int mult = (stride - 1) / numTimeStep / Current.NbrHar / numComp; if(Flag_BIN){ fwrite(&num, sizeof(int), 1, PostStream); fwrite(&mult, sizeof(int), 1, PostStream); fwrite(&tmp[1 + step * mult * numComp], sizeof(double), mult * numComp, PostStream); } else{ fprintf(PostStream, "%d %d", num, mult); for(int k = 0; k < mult * numComp; k++) fprintf(PostStream, " %.16g", tmp[1 + step * mult * numComp + k]); fprintf(PostStream, "\n"); } } } fprintf(PostStream, "$EndElementNodeData\n"); step++; } } } static void GmshParsed_PrintElement(double Time, int TimeStep, int NbTimeStep, int NbHarmonic, int HarmonicToTime, int Type, int NbrNodes, double *x, double *y, double *z, struct Value *Value) { int i,j,k,jj ; double TimeMH ; struct Value TmpValue ; int symIndex[9] = {0, 1, 2, 1, 3, 4, 2, 4, 5} ; int diagIndex[9] = {0, -1, -1, -1, 1, -1, -1, -1, 2} ; if(Gmsh_StartNewView){ Gmsh_StartNewView = 0 ; Gmsh_ResetStaticLists(); } if (HarmonicToTime == 1){ if(NbHarmonic == 2 && NbTimeStep == 1){ // classical complex case double zero = 0., one = 1.; List_Put(TimeValue_L, 0, &zero); List_Put(TimeValue_L, 1, &one); } else{ for(k = 0 ; k < NbHarmonic ; k++) List_Put(TimeValue_L, NbHarmonic*TimeStep+k, &Time); } } else for(k = 0 ; k < HarmonicToTime ; k++) List_Put(TimeValue_L, HarmonicToTime*TimeStep+k, &Time); if(!PostStream) return; switch (Value[0].Type) { case SCALAR : if(TimeStep == 0){ switch(Type){ case POINT : fprintf(PostStream, "SP("); break; case LINE : fprintf(PostStream, "SL("); break; case TRIANGLE : fprintf(PostStream, "ST("); break; case QUADRANGLE : fprintf(PostStream, "SQ("); break; case TETRAHEDRON : fprintf(PostStream, "SS("); break; case HEXAHEDRON : fprintf(PostStream, "SH("); break; case PRISM : fprintf(PostStream, "SI("); break; case PYRAMID : fprintf(PostStream, "SY("); break; case LINE_2 : fprintf(PostStream, "SL("); break; case TRIANGLE_2 : fprintf(PostStream, "ST("); break; case QUADRANGLE_2: fprintf(PostStream, "SQ("); break; case QUADRANGLE_2_8N: fprintf(PostStream, "SQ("); break; } for(i = 0 ; i < NbrNodes ; i++){ if(i) fprintf(PostStream, ","); fprintf(PostStream, "%.16g,%.16g,%.16g", x[i], y[i], z[i]); } fprintf(PostStream, "){"); } if (HarmonicToTime == 1) { for(k = 0 ; k < NbHarmonic ; k++) { if(k || TimeStep) fprintf(PostStream, ","); for(i = 0 ; i < NbrNodes ; i++){ if(i) fprintf(PostStream, ","); fprintf(PostStream, "%.16g", Value[i].Val[MAX_DIM*k]); } } } else { for(k = 0 ; k < HarmonicToTime ; k++){ if(k || TimeStep) fprintf(PostStream, ","); for(i = 0 ; i < NbrNodes ; i++){ if(i) fprintf(PostStream, ","); F_MHToTime0(k+i, &Value[i], &TmpValue, k, HarmonicToTime, &TimeMH) ; fprintf(PostStream, "%.16g", TmpValue.Val[0]); } } } if(TimeStep == NbTimeStep-1){ fprintf(PostStream, "};\n") ; } break ; case VECTOR : if(TimeStep == 0){ switch(Type){ case POINT : fprintf(PostStream, "VP("); break; case LINE : fprintf(PostStream, "VL("); break; case TRIANGLE : fprintf(PostStream, "VT("); break; case QUADRANGLE : fprintf(PostStream, "VQ("); break; case TETRAHEDRON : fprintf(PostStream, "VS("); break; case HEXAHEDRON : fprintf(PostStream, "VH("); break; case PRISM : fprintf(PostStream, "VI("); break; case PYRAMID : fprintf(PostStream, "VY("); break; case LINE_2 : fprintf(PostStream, "VL("); break; case TRIANGLE_2 : fprintf(PostStream, "VT("); break; case QUADRANGLE_2: fprintf(PostStream, "VQ("); break; case QUADRANGLE_2_8N: fprintf(PostStream, "VQ("); break; } for(i = 0 ; i < NbrNodes ; i++){ if(i) fprintf(PostStream, ","); fprintf(PostStream, "%.16g,%.16g,%.16g", x[i], y[i], z[i]); } fprintf(PostStream, "){"); } if (HarmonicToTime == 1) { for(k = 0 ; k < NbHarmonic ; k++) { if(k || TimeStep) fprintf(PostStream, ","); for(i = 0 ; i < NbrNodes ; i++){ if(i) fprintf(PostStream, ","); for(j = 0 ; j < 3 ; j++){ if(j) fprintf(PostStream, ","); fprintf(PostStream, "%.16g", Value[i].Val[MAX_DIM*k+j]); } } } } else { for(k = 0 ; k < HarmonicToTime ; k++){ if(k || TimeStep) fprintf(PostStream, ","); for(i = 0 ; i < NbrNodes ; i++){ if(i) fprintf(PostStream, ","); F_MHToTime0(k+i, &Value[i], &TmpValue, k, HarmonicToTime, &TimeMH) ; for(j = 0 ; j < 3 ; j++){ if(j) fprintf(PostStream, ","); fprintf(PostStream, "%.16g", TmpValue.Val[j]); } } } } if(TimeStep == NbTimeStep-1){ fprintf(PostStream, "};\n") ; } break ; case TENSOR_DIAG : case TENSOR_SYM : case TENSOR : if(TimeStep == 0){ switch(Type){ case POINT : fprintf(PostStream, "TP("); break; case LINE : fprintf(PostStream, "TL("); break; case TRIANGLE : fprintf(PostStream, "TT("); break; case QUADRANGLE : fprintf(PostStream, "TQ("); break; case TETRAHEDRON : fprintf(PostStream, "TS("); break; case HEXAHEDRON : fprintf(PostStream, "TH("); break; case PRISM : fprintf(PostStream, "TI("); break; case PYRAMID : fprintf(PostStream, "TY("); break; case LINE_2 : fprintf(PostStream, "TL("); break; case TRIANGLE_2 : fprintf(PostStream, "TT("); break; case QUADRANGLE_2: fprintf(PostStream, "TQ("); break; case QUADRANGLE_2_8N: fprintf(PostStream, "TQ("); break; } for(i = 0 ; i < NbrNodes ; i++){ if(i) fprintf(PostStream, ","); fprintf(PostStream, "%.16g,%.16g,%.16g", x[i], y[i], z[i]); } fprintf(PostStream, "){"); } if (HarmonicToTime == 1) { for(k = 0 ; k < NbHarmonic ; k++) { if(k || TimeStep) fprintf(PostStream, ","); for(i = 0 ; i < NbrNodes ; i++){ if(i) fprintf(PostStream, ","); for(j = 0 ; j < 9 ; j++){ if(j) fprintf(PostStream, ","); if(Value[0].Type != TENSOR_DIAG) { if(Value[0].Type == TENSOR_SYM) jj = symIndex[j]; else jj = j; fprintf(PostStream, "%.16g", Value[i].Val[MAX_DIM*k+jj]); } else { jj = diagIndex[j]; if(jj == -1) fprintf(PostStream, "%.16g", 0.); else fprintf(PostStream, "%.16g", Value[i].Val[MAX_DIM*k+jj]); } } } } } else { for(k = 0 ; k < HarmonicToTime ; k++){ if(k || TimeStep) fprintf(PostStream, ","); for(i = 0 ; i < NbrNodes ; i++){ if(i) fprintf(PostStream, ","); F_MHToTime0(k+i, &Value[i], &TmpValue, k, HarmonicToTime, &TimeMH) ; for(j = 0 ; j < 9 ; j++){ if(j) fprintf(PostStream, ","); if(Value[0].Type != TENSOR_DIAG) { if(Value[0].Type == TENSOR_SYM) jj = symIndex[j]; else jj = j; jj = symIndex[j]; fprintf(PostStream, "%.16g", TmpValue.Val[jj]); } else { jj = diagIndex[j]; if(jj == -1) fprintf(PostStream, "%.16g", 0.); else fprintf(PostStream, "%.16g", TmpValue.Val[jj]); } } } } } if(TimeStep == NbTimeStep-1){ fprintf(PostStream, "};\n") ; } break ; } } static void Gmsh_PrintElement(double Time, int TimeStep, int NbTimeStep, int NbHarmonic, int HarmonicToTime, int Type, int ElementNum, int NbrNodes, double *x, double *y, double *z, struct Value *Value, struct PostSubOperation *PSO_P, int Store) { int i,j,k,jj ; double TimeMH ; struct Value TmpValue ; static std::vector *Current_L ; int symIndex[9] = {0, 1, 2, 1, 3, 4, 2, 4, 5} ; int diagIndex[9] = {0, -1, -1, -1, 1, -1, -1, -1, 2} ; if(Gmsh_StartNewView){ Gmsh_StartNewView = 0 ; Gmsh_ResetStaticLists(); } switch (Value[0].Type) { case SCALAR : if(TimeStep == 0){ switch(Type){ case POINT : Current_L = &SP ; NbSP++ ; break ; case LINE : Current_L = &SL ; NbSL++ ; break ; case TRIANGLE : Current_L = &ST ; NbST++ ; break ; case QUADRANGLE : Current_L = &SQ ; NbSQ++ ; break ; case TETRAHEDRON : Current_L = &SS ; NbSS++ ; break ; case HEXAHEDRON : Current_L = &SH ; NbSH++ ; break ; case PRISM : Current_L = &SI ; NbSI++ ; break ; case PYRAMID : Current_L = &SY ; NbSY++ ; break ; case LINE_2 : Current_L = &SL ; NbSL++ ; break ; case TRIANGLE_2 : Current_L = &ST ; NbST++ ; break ; case QUADRANGLE_2: Current_L = &SQ ; NbSQ++ ; break ; case QUADRANGLE_2_8N: Current_L = &SQ ; NbSQ++ ; break ; } if(Flag_GMSH_VERSION != 2){ for(i = 0 ; i < NbrNodes ; i++) Current_L->push_back(x[i]); for(i = 0 ; i < NbrNodes ; i++) Current_L->push_back(y[i]); for(i = 0 ; i < NbrNodes ; i++) Current_L->push_back(z[i]); } else{ double tmp = ElementNum; Current_L->push_back(tmp); } } if (HarmonicToTime == 1) for(k = 0 ; k < NbHarmonic ; k++){ List_Put(TimeValue_L, NbHarmonic*TimeStep+k, &Time); for(i = 0 ; i < NbrNodes ; i++) Current_L->push_back(Value[i].Val[MAX_DIM*k]); } else for(k = 0 ; k < HarmonicToTime ; k++){ List_Put(TimeValue_L, HarmonicToTime*TimeStep+k, &Time); for(i = 0 ; i < NbrNodes ; i++){ F_MHToTime0(k+i, &Value[i], &TmpValue, k, HarmonicToTime, &TimeMH) ; Current_L->push_back(TmpValue.Val[0]); } } break ; case VECTOR : if(TimeStep == 0){ switch(Type){ case POINT : Current_L = &VP ; NbVP++ ; break ; case LINE : Current_L = &VL ; NbVL++ ; break ; case TRIANGLE : Current_L = &VT ; NbVT++ ; break ; case QUADRANGLE : Current_L = &VQ ; NbVQ++ ; break ; case TETRAHEDRON : Current_L = &VS ; NbVS++ ; break ; case HEXAHEDRON : Current_L = &VH ; NbVH++ ; break ; case PRISM : Current_L = &VI ; NbVI++ ; break ; case PYRAMID : Current_L = &VY ; NbVY++ ; break ; case LINE_2 : Current_L = &VL ; NbVL++ ; break ; case TRIANGLE_2 : Current_L = &VT ; NbVT++ ; break ; case QUADRANGLE_2: Current_L = &VQ ; NbVQ++ ; break ; case QUADRANGLE_2_8N: Current_L = &VQ ; NbVQ++ ; break ; } if(Flag_GMSH_VERSION != 2){ for(i = 0 ; i < NbrNodes ; i++) Current_L->push_back(x[i]); for(i = 0 ; i < NbrNodes ; i++) Current_L->push_back(y[i]); for(i = 0 ; i < NbrNodes ; i++) Current_L->push_back(z[i]); } else{ double tmp = ElementNum; Current_L->push_back(tmp); } } if (HarmonicToTime == 1) for(k = 0 ; k < NbHarmonic ; k++){ List_Put(TimeValue_L, NbHarmonic*TimeStep+k, &Time); for(i = 0 ; i < NbrNodes ; i++) for(j = 0 ; j < 3 ; j++) Current_L->push_back(Value[i].Val[MAX_DIM*k+j]); } else for(k = 0 ; k < HarmonicToTime ; k++){ List_Put(TimeValue_L, HarmonicToTime*TimeStep+k, &Time); for(i = 0 ; i < NbrNodes ; i++){ F_MHToTime0(k+i, &Value[i], &TmpValue, k, HarmonicToTime, &TimeMH) ; for(j = 0 ; j < 3 ; j++) Current_L->push_back(TmpValue.Val[j]); } } break ; case TENSOR_DIAG : case TENSOR_SYM : case TENSOR : if(TimeStep == 0){ switch(Type){ case POINT : Current_L = &TP ; NbTP++ ; break ; case LINE : Current_L = &TL ; NbTL++ ; break ; case TRIANGLE : Current_L = &TT ; NbTT++ ; break ; case QUADRANGLE : Current_L = &TQ ; NbTQ++ ; break ; case TETRAHEDRON : Current_L = &TS1 ; NbTS++ ; break ; case HEXAHEDRON : Current_L = &TH ; NbTH++ ; break ; case PRISM : Current_L = &TI ; NbTI++ ; break ; case PYRAMID : Current_L = &TY ; NbTY++ ; break ; case LINE_2 : Current_L = &TL ; NbTL++ ; break ; case TRIANGLE_2 : Current_L = &TT ; NbTT++ ; break ; case QUADRANGLE_2: Current_L = &TQ ; NbTQ++ ; break ; case QUADRANGLE_2_8N: Current_L = &TQ ; NbTQ++ ; break ; } if(Flag_GMSH_VERSION != 2){ for(i = 0 ; i < NbrNodes ; i++) Current_L->push_back(x[i]); for(i = 0 ; i < NbrNodes ; i++) Current_L->push_back(y[i]); for(i = 0 ; i < NbrNodes ; i++) Current_L->push_back(z[i]); } else{ double tmp = ElementNum; Current_L->push_back(tmp); } } if (HarmonicToTime == 1) for(k = 0 ; k < NbHarmonic ; k++){ List_Put(TimeValue_L, NbHarmonic*TimeStep+k, &Time); for(i = 0 ; i < NbrNodes ; i++){ for(j = 0 ; j < 9 ; j++){ if(Value[0].Type != TENSOR_DIAG) { if(Value[0].Type == TENSOR_SYM) jj = symIndex[j]; else jj = j; Current_L->push_back(Value[i].Val[MAX_DIM*k+jj]); } else { jj = diagIndex[j]; if(jj == -1) Current_L->push_back(0.); else Current_L->push_back(Value[i].Val[MAX_DIM*k+jj]); } } } } else for(k = 0 ; k < HarmonicToTime ; k++){ List_Put(TimeValue_L, HarmonicToTime*TimeStep+k, &Time); for(i = 0 ; i < NbrNodes ; i++){ F_MHToTime0(k+i, &Value[i], &TmpValue, k, HarmonicToTime, &TimeMH) ; for(j = 0 ; j < 9 ; j++) { if(Value[0].Type != TENSOR_DIAG) { if(Value[0].Type == TENSOR_SYM) jj = symIndex[j]; else jj = j; Current_L->push_back(TmpValue.Val[jj]); } else { jj = diagIndex[j]; if(jj == -1) Current_L->push_back(0.); else Current_L->push_back(TmpValue.Val[jj]); } } } } } // reduce memory requirements by automatically partitioning large // output views into chunks not larger than 1Gb if(Flag_GMSH_VERSION == 2 && TimeStep == NbTimeStep - 1 && Current_L->size() > (int)(1024 * 1024 * 1024 / sizeof(double))){ Format_PostFooter(PSO_P, Store); CurrentPartitionNumber++; Gmsh_StartNewView = 1; } } static void dVecWrite(std::vector &v, FILE *fp, bool binary) { if(v.empty()) return; if(binary) fwrite(&v[0], sizeof(double), v.size(), fp); else for(unsigned i = 0; i < v.size(); i++) fprintf(fp, " %.16g", v[i]); } static void cVecWrite(std::vector &v, FILE *fp, bool binary) { if(v.empty()) return; if(binary) fwrite(&v[0], sizeof(char), v.size(), fp); else for(unsigned i = 0; i < v.size(); i++) fputc(v[i], fp); } /* ------------------------------------------------------------------------ */ /* Gnuplot format */ /* ------------------------------------------------------------------------ */ static void Gnuplot_PrintElement(int Format, double Time, int TimeStep, int NbrTimeSteps, int NbrHarmonics, int HarmonicToTime, int ElementType, int NumElement, int NbrNodes, double *x, double *y, double *z, double *Dummy, struct Value *Value) { static int Size, TmpIndex ; static double * TmpValues ; int i, j, k, t, i2, k2 ; double TimeMH ; struct Value TmpValue ; if(!PostStream) return; if(TimeStep == 0){ switch(Value->Type){ case SCALAR : Size = 1 ; break ; case VECTOR : Size = 3 ; break ; case TENSOR_DIAG : Size = 3 ; break ; case TENSOR_SYM : Size = 6 ; break ; case TENSOR : Size = 9 ; break ; } TmpValues = (double*) Malloc(NbrTimeSteps*NbrNodes*NbrHarmonics*Size*sizeof(double)); TmpIndex = 0; } for(i = 0 ; i < NbrNodes ; i++) for(k = 0 ; k < NbrHarmonics ; k++) for(j = 0 ; j < Size ; j++) TmpValues[TmpIndex++] = Value[i].Val[MAX_DIM*k+j]; if(TimeStep == NbrTimeSteps-1){ for(i = 0 ; i <= NbrNodes ; i++){ /* New line for each node, closed loop for tri/qua */ if(i != NbrNodes) i2 = i ; else{ if(NbrNodes < 3) break ; else i2 = 0 ; } fprintf(PostStream, "%d %d ", Gmsh_GetElementType(ElementType), NumElement); fprintf(PostStream, " %.16g %.16g %.16g ", x[i2], y[i2], z[i2]); if(Dummy){ if(Dummy[3]<0){ if(!i) fprintf(PostStream, " %.16g %.16g 0 ", Dummy[0], Dummy[2]); else fprintf(PostStream, " %.16g %.16g 0 ", Dummy[1], Dummy[2]); } else fprintf(PostStream, " %.16g %.16g %.16g ", Dummy[0], Dummy[1], Dummy[2]); } else fprintf(PostStream, " 0 0 0 "); for(t = 0 ; t < NbrTimeSteps ; t++){ if (HarmonicToTime == 1) { for(k = 0 ; k < NbrHarmonics ; k++) { for(j = 0 ; j < Size ; j++){ fprintf(PostStream, " %.16g", TmpValues[ t*NbrNodes*NbrHarmonics*Size + i2*NbrHarmonics*Size + k*Size + j ]); } fprintf(PostStream, " "); } } else { TmpValue.Type = Value->Type ; for(k = 0 ; k < HarmonicToTime ; k++){ for(k2 = 0 ; k2 < NbrHarmonics ; k2++) for(j = 0 ; j < Size ; j++) TmpValue.Val[MAX_DIM*k2+j] = TmpValues[ t*NbrNodes*NbrHarmonics*Size + i2*NbrHarmonics*Size + k2*Size + j ] ; F_MHToTime0(k, &TmpValue, &TmpValue, k, HarmonicToTime, &TimeMH) ; for(j = 0 ; j < Size ; j++) fprintf(PostStream, "%.16g", TmpValue.Val[0]); fprintf(PostStream, " "); } } fprintf(PostStream, " "); } /* for t */ fprintf(PostStream, "\n"); } /* for i */ if(NbrNodes > 1) fprintf(PostStream, "\n"); Free(TmpValues); } } /* ------------------------------------------------------------------------ */ /* Tabular format */ /* ------------------------------------------------------------------------ */ static void Tabular_PrintElement(struct PostSubOperation *PSO_P, int Format, double Time, int TimeStep, int NbrTimeSteps, int NbrHarmonics, int HarmonicToTime, int ElementType, int NumElement, int NbrNodes, double *x, double *y, double *z, double *Dummy, struct Value *Value) { static int Size ; int i,j,k ; double TimeMH ; struct Value TmpValue ; if(!PostStream) return; if(TimeStep == 0){ switch(Value->Type){ case SCALAR : Size = 1 ; break ; case VECTOR : Size = 3 ; break ; case TENSOR_DIAG : Size = 3 ; break ; case TENSOR_SYM : Size = 6 ; break ; case TENSOR : Size = 9 ; break ; } } if(Format == FORMAT_SPACE_TABLE || Format == FORMAT_SIMPLE_SPACE_TABLE || Format == FORMAT_VALUE_ONLY){ if(TimeStep == 0){ if(Format != FORMAT_SIMPLE_SPACE_TABLE && Format != FORMAT_VALUE_ONLY) fprintf(PostStream, "%d %d ", Gmsh_GetElementType(ElementType), NumElement); if(Format != FORMAT_VALUE_ONLY) for(i=0 ; iValueName, j, PSO_P->ValueIndex, Value[i].Val[MAX_DIM*k+j]); if (j > NodeTable; static void NodeTable_PrintElement(int TimeStep, int NbTimeStep, int NbrHarmonics, struct PostElement *PE) { if(NodeTable_StartNew){ NodeTable_StartNew = 0 ; NodeTable.clear(); } for(int i = 0 ; i < PE->NbrNodes ; i++){ int n = PE->NumNodes[i]; int Size = 0; switch(PE->Value[0].Type){ case SCALAR : Size = 1 ; break ; case VECTOR : Size = 3 ; break ; case TENSOR_DIAG : Size = 3 ; break ; case TENSOR_SYM : Size = 6 ; break ; case TENSOR : Size = 9 ; break ; } if(n > 0 && Size){ // we have data on an actual node NodeTable[n].resize(NbTimeStep * NbrHarmonics * Size, 0.); for(int k = 0 ; k < NbrHarmonics ; k++){ for(int j = 0 ; j < Size ; j++){ double val = PE->Value[i].Val[MAX_DIM * k + j]; int idx = NbrHarmonics * Size * TimeStep + k * Size + j; NodeTable[n][idx] = val; } } } } } /* ------------------------------------------------------------------------ */ /* S t o r e P o s t O p R e s u l t */ /* ------------------------------------------------------------------------ */ static List_T *PostOpResults_L=NULL; static void StorePostOpResult(int NbrHarmonics, struct PostElement *PE) { int Size; double val; if(!PostOpResults_L) PostOpResults_L = List_Create(1000,1000,sizeof(double)); for(int i = 0 ; i < PE->NbrNodes ; i++){ Size = 0; switch(PE->Value[0].Type){ case SCALAR : Size = 1 ; break ; case VECTOR : Size = 3 ; break ; case TENSOR_DIAG : Size = 3 ; break ; case TENSOR_SYM : Size = 6 ; break ; case TENSOR : Size = 9 ; break ; } if(Size){ // we have data for(int k = 0 ; k < NbrHarmonics ; k++){ for(int j = 0 ; j < Size ; j++){ val = PE->Value[i].Val[MAX_DIM * k + j]; List_Add(PostOpResults_L, &val); } } } } } static void StorePostOpResult(int NbrHarmonics, struct Value *Value) { int Size; double val; if(!PostOpResults_L) PostOpResults_L = List_Create(1000,1000,sizeof(double)); Size = 0; switch(Value[0].Type){ case SCALAR : Size = 1 ; break ; case VECTOR : Size = 3 ; break ; case TENSOR_DIAG : Size = 3 ; break ; case TENSOR_SYM : Size = 6 ; break ; case TENSOR : Size = 9 ; break ; } if(Size){ // we have data for(int k = 0 ; k < NbrHarmonics ; k++){ for(int j = 0 ; j < Size ; j++){ val = Value[0].Val[MAX_DIM * k + j]; List_Add(PostOpResults_L, &val); } } } } /* ------------------------------------------------------------------------ */ /* UNV format */ /* ------------------------------------------------------------------------ */ #if !defined(HAVE_NX) #define NX { Message::Error("UNV export not available in this version"); } #else #define NX ; #endif void Unv_PrintHeader(FILE *PostStream, char *name, int SubType, double Time, int TimeStep) NX void Unv_PrintFooter(FILE *PostStream) NX void Unv_PrintElement(FILE *PostStream, int Num_Element, int NbrNodes, struct Value *Value) NX void Unv_PrintRegion(FILE *PostStream, int Flag_Comma, int numRegion, int NbrHarmonics, int Size, struct Value *Value) NX #undef NX /* ------------------------------------------------------------------------ */ /* F o r m a t _ P o s t F o r m a t */ /* ------------------------------------------------------------------------ */ void Format_PostFormat(struct PostSubOperation *PSO_P) { if(!PostStream || PSO_P->Type == POP_EXPRESSION) return; int Format = PSO_P->Format; int NoMesh = PSO_P->NoMesh; switch(Format){ case FORMAT_GMSH : if((PSO_P->StoreInField >= 0 || PSO_P->StoreInMeshBasedField >= 0) && !PSO_P->FileOut) break; if(Flag_GMSH_VERSION == 2){ fprintf(PostStream, "$MeshFormat\n") ; fprintf(PostStream, "2.2 %d %d\n", Flag_BIN, (int)sizeof(double)) ; if(Flag_BIN){ int one=1; fwrite(&one, sizeof(int), 1, PostStream); fprintf(PostStream, "\n"); } fprintf(PostStream, "$EndMeshFormat\n") ; if(!NoMesh){ std::vector elements; std::set nodes; if(PSO_P->SubType == PRINT_ONELEMENTSOF){ List_T *Region_L = ((struct Group *)List_Pointer(Problem_S.Group, PSO_P->Case.OnRegion.RegionIndex))->InitialList ; for(int i = 0 ; i < Geo_GetNbrGeoElements() ; i++) { Geo_Element *Geo_Element = Geo_GetGeoElement(i) ; if(List_Search(Region_L, &Geo_Element->Region, fcmp_int)){ elements.push_back(Geo_Element); for (int j = 0 ; j < Geo_Element->NbrNodes ; j++) nodes.insert(Geo_Element->NumNodes[j]) ; } } } else{ for(int i = 0 ; i < Geo_GetNbrGeoElements() ; i++) { Geo_Element *Geo_Element = Geo_GetGeoElement(i) ; elements.push_back(Geo_Element); for (int j = 0 ; j < Geo_Element->NbrNodes ; j++) nodes.insert(Geo_Element->NumNodes[j]) ; } } fprintf(PostStream, "$Nodes\n%d\n", (int)nodes.size()); for (int i = 0 ; i < Geo_GetNbrGeoNodes() ; i++) { Geo_Node *Geo_Node = Geo_GetGeoNode(i); if(nodes.find(Geo_Node->Num) != nodes.end()){ if(Flag_BIN){ fwrite(&Geo_Node->Num, sizeof(int), 1, PostStream); double data[3] = {Geo_Node->x, Geo_Node->y, Geo_Node->z}; fwrite(data, sizeof(double), 3, PostStream); } else{ fprintf(PostStream, "%d %.16g %.16g %.16g\n", Geo_Node->Num, Geo_Node->x, Geo_Node->y, Geo_Node->z) ; } } } fprintf(PostStream, "$EndNodes\n$Elements\n%d\n", (int)elements.size()); for (unsigned int i = 0 ; i < elements.size() ; i++) { Geo_Element *Geo_Element = elements[i]; int Type = Geo_GetElementTypeInv(FORMAT_GMSH, Geo_Element->Type) ; if(Flag_BIN){ int blob[6] = {Type, 1, 2, Geo_Element->Num, Geo_Element->Region, Geo_Element->ElementaryRegion}; fwrite(blob, sizeof(int), 6, PostStream); std::vector verts(Geo_Element->NbrNodes); for (int j = 0 ; j < Geo_Element->NbrNodes ; j++) verts[j] = Geo_Element->NumNodes[j] ; fwrite(&verts[0], sizeof(int), Geo_Element->NbrNodes, PostStream); } else{ fprintf(PostStream, "%d %d 2 %d %d ", Geo_Element->Num, Type, Geo_Element->Region, Geo_Element->ElementaryRegion) ; for (int j = 0 ; j < Geo_Element->NbrNodes ; j++) fprintf(PostStream, "%d ", Geo_Element->NumNodes[j]) ; fprintf(PostStream, "\n") ; } } fprintf(PostStream, "$EndElements\n"); } } else if(PostStream && Flag_BIN){/* bricolage */ fprintf(PostStream, "$PostFormat /* Gmsh 1.2, %s */\n", Flag_BIN ? "binary" : "ascii") ; fprintf(PostStream, "1.2 %d %d\n", Flag_BIN, (int)sizeof(double)) ; fprintf(PostStream, "$EndPostFormat\n") ; } break ; case FORMAT_GNUPLOT : fprintf(PostStream, "# GetDP %s, %s\n", GETDP_VERSION, Flag_BIN ? "binary" : "ascii") ; break ; } } /* ------------------------------------------------------------------------ */ /* F o r m a t _ P o s t H e a d e r */ /* ------------------------------------------------------------------------ */ void Format_PostHeader(struct PostSubOperation *PSO_P, int NbTimeStep, int Order, char *Name1, char *Name2) { int Format = PSO_P->Format; int SubType = PSO_P->SubType; double Time = Current.Time; int TimeStep = Current.TimeStep; int Contour = PSO_P->Iso; int Type = PSO_P->CombinationType; char name[256] ; CurrentPartitionNumber = 0; if(Contour){ if(!PostElement_L) PostElement_L = List_Create(20, 20, sizeof(struct PostElement*)); else List_Reset(PostElement_L); } if(Name1 && Name2) { strcpy(name, Order ? Name1 : Name2) ; strcat(name, Get_StringForDefine(PostSubOperation_CombinationType, Type)) ; strcat(name, Order ? Name2 : Name1) ; } else if(Name1) strcpy(name, Name1) ; else if(Name2) strcpy(name, Name2) ; else strcpy(name, "unnamed"); strcpy(CurrentName, name); switch(Format){ case FORMAT_GMSH_PARSED : if(PostStream) fprintf(PostStream, "View \"%s\" {\n", name) ; Gmsh_StartNewView = 1 ; break ; case FORMAT_GMSH : Gmsh_StartNewView = 1 ; if((PSO_P->StoreInField >= 0 || PSO_P->StoreInMeshBasedField >= 0) && !PSO_P->FileOut) break; if(PostStream && Flag_GMSH_VERSION != 2){ if(Flag_BIN){ /* bricolage */ fprintf(PostStream, "$View /* %s */\n", name); fprintf(PostStream, "%s ", name); } else { fprintf(PostStream, "View \"%s\" {\n", name) ; } } break ; case FORMAT_UNV : if(PostStream) Unv_PrintHeader(PostStream, name, SubType, Time, TimeStep); break ; case FORMAT_GNUPLOT : if(PostStream){ fprintf(PostStream, "# PostData '%s'\n", name); fprintf(PostStream, "# Type Num X Y Z N1 N2 N3 Values ...\n"); } break ; case FORMAT_NODE_TABLE : NodeTable_StartNew = 1 ; break ; case FORMAT_ADAPT : if(PostStream) fprintf(PostStream, "$Adapt /* %s */\n", name) ; break ; } } /* ------------------------------------------------------------------------ */ /* F o r m a t _ P o s t F o o t e r */ /* ------------------------------------------------------------------------ */ void Format_PostFooter(struct PostSubOperation *PSO_P, int Store) { List_T *Iso_L[NBR_MAX_ISO], *Solutions_L; double IsoMin = 1.e200, IsoMax = -1.e200, IsoVal = 0.0, freq, valr, vali ; int NbrIso = 0 ; int iPost, iNode, iIso, iTime, One=1, i, j, NbTimeStep ; char tmp[1024]; bool PostOpSolutionGenerated; struct PostElement *PE ; struct Solution *Solution_P=NULL, Solution_S; if( !(NbTimeStep = List_Nbr(PSO_P->TimeStep_L)) ) NbTimeStep = List_Nbr(Current.DofData->Solutions); if ( (PSO_P->Format == FORMAT_GMSH || PSO_P->Format == FORMAT_GMSH_PARSED) && Flag_GMSH_VERSION != 2 ){ switch(PSO_P->Legend){ case LEGEND_TIME: Gmsh_StringStart(PSO_P->Format, PSO_P->LegendPosition[0], PSO_P->LegendPosition[1], PSO_P->LegendPosition[2]); for (i = 0 ; i < NbTimeStep ; i++) { Pos_InitAllSolutions(PSO_P->TimeStep_L, i) ; valr = Current.DofData->CurrentSolution->Time ; for (j = 0 ; j < Current.NbrHar ; j++){ sprintf(tmp, "Step %d/%d: Time = %g", i+1, NbTimeStep, valr); Gmsh_StringAdd(PSO_P->Format, (!i && !j), tmp); } } Gmsh_StringEnd(PSO_P->Format); break; case LEGEND_FREQUENCY: if(Current.NbrHar > 1) { Gmsh_StringStart(PSO_P->Format, PSO_P->LegendPosition[0], PSO_P->LegendPosition[1], PSO_P->LegendPosition[2]); for (i = 0 ; i < NbTimeStep ; i++) { Pos_InitAllSolutions(PSO_P->TimeStep_L, i) ; for (j = 0 ; j < Current.NbrHar ; j+=2) { freq = 0.5*Current.DofData->Val_Pulsation[j/2]/M_PI ; sprintf(tmp, "%g Hz (Real Part: COSINUS)", freq); Gmsh_StringAdd(PSO_P->Format, (!i && !j), tmp); sprintf(tmp, "%g Hz (Imaginary Part: -SINUS)", freq); Gmsh_StringAdd(PSO_P->Format, 0, tmp); } } Gmsh_StringEnd(PSO_P->Format); } break; case LEGEND_EIGENVALUES: Gmsh_StringStart(PSO_P->Format, PSO_P->LegendPosition[0], PSO_P->LegendPosition[1], PSO_P->LegendPosition[2]); for (i = 0 ; i < NbTimeStep ; i++) { Pos_InitAllSolutions(PSO_P->TimeStep_L, i) ; valr = Current.DofData->CurrentSolution->Time ; vali = Current.DofData->CurrentSolution->TimeImag ; if(Current.NbrHar == 1){ sprintf(tmp, "Eigenvalue %d/%d: %g", i+1, NbTimeStep, valr); Gmsh_StringAdd(PSO_P->Format, !i, tmp); } else{ for (j = 0 ; j < Current.NbrHar ; j++) { if(!(j % 2)){ sprintf(tmp, "Eigenvalue %d/%d: %g %s i * %g (Real Part)", i+1, NbTimeStep, valr, (vali > 0) ? "+" : "-", (vali > 0) ? vali : -vali); Gmsh_StringAdd(PSO_P->Format, (!i && !j), tmp); } else{ sprintf(tmp, "Eigenvalue %d/%d: %g %s i * %g (Imaginary Part)", i+1, NbTimeStep, valr, (vali > 0) ? "+" : "-", (vali > 0) ? vali : -vali); Gmsh_StringAdd(PSO_P->Format, 0, tmp); } } } } Gmsh_StringEnd(PSO_P->Format); break; } } if(PSO_P->Iso){ for(iPost = 0 ; iPost < List_Nbr(PostElement_L) ; iPost++){ PE = *(struct PostElement**)List_Pointer(PostElement_L, iPost); for (iNode = 0 ; iNode < PE->NbrNodes ; iNode++ ){ IsoMin = std::min(IsoMin, PE->Value[iNode].Val[0]) ; IsoMax = std::max(IsoMax, PE->Value[iNode].Val[0]) ; } } if((NbrIso = PSO_P->Iso) < 0) NbrIso = List_Nbr(PSO_P->Iso_L) ; if(NbrIso > NBR_MAX_ISO){ Message::Error("Too many Iso values"); NbrIso = NBR_MAX_ISO; } if(PostStream && PSO_P->Format == FORMAT_GNUPLOT) fprintf(PostStream, "# NbIso = %d, Min = %g, Max = %g\n", NbrIso, IsoMin, IsoMax) ; for(iIso = 0 ; iIso < NbrIso ; iIso++) Iso_L[iIso] = List_Create(10, 10, sizeof(struct PostElement*)) ; for(iPost = 0 ; iPost < List_Nbr(PostElement_L) ; iPost++){ PE = *(struct PostElement**)List_Pointer(PostElement_L, iPost); for(iIso = 0 ; iIso < NbrIso ; iIso++){ if(PSO_P->Iso > 0){ Cal_Iso(PE, Iso_L[iIso], IsoMin+iIso*(IsoMax-IsoMin)/(double)(NbrIso-1), IsoMin, IsoMax, PSO_P->DecomposeInSimplex) ; } else{ List_Read(PSO_P->Iso_L, iIso, &IsoVal) ; Cal_Iso(PE, Iso_L[iIso], IsoVal, IsoMin, IsoMax, PSO_P->DecomposeInSimplex) ; } } if(!Store) Destroy_PostElement(PE); } for(iIso = 0 ; iIso < NbrIso ; iIso++){ for(iPost = 0 ; iPost < List_Nbr(Iso_L[iIso]) ; iPost++){ PE = *(struct PostElement**)List_Pointer(Iso_L[iIso], iPost) ; Format_PostElement(PSO_P, 0, 0, Current.Time, 0, 1, Current.NbrHar, PSO_P->HarmonicToTime, NULL, PE); Destroy_PostElement(PE) ; } List_Delete(Iso_L[iIso]) ; if(PostStream && PSO_P->Format == FORMAT_GNUPLOT) fprintf(PostStream, "\n") ; } } switch(PSO_P->Format){ case FORMAT_GMSH_PARSED : if(PostStream && List_Nbr(TimeValue_L) > 1){ fprintf(PostStream, "TIME{"); for(iTime = 0; iTime < List_Nbr(TimeValue_L); iTime++){ if(iTime) fprintf(PostStream, ","); fprintf(PostStream, "%.16g", *(double*)List_Pointer(TimeValue_L, iTime)); } fprintf(PostStream, "};\n"); } fprintf(PostStream, "};\n") ; break ; case FORMAT_GMSH : if(Gmsh_StartNewView) Gmsh_ResetStaticLists(); // nothing to print! if(PSO_P->StoreInField >= 0 || PSO_P->StoreInMeshBasedField >= 0){ #if defined(HAVE_GMSH) int field = (PSO_P->StoreInField >= 0) ? PSO_P->StoreInField : PSO_P->StoreInMeshBasedField; Message::Info("Storing data in field %d (%s)", field, PSO_P->StoreInField >= 0 ? "list-based" : "mesh-based"); int NS[24] = {NbSP, NbVP, NbTP, NbSL, NbVL, NbTL, NbST, NbVT, NbTT, NbSQ, NbVQ, NbTQ, NbSS, NbVS, NbTS, NbSH, NbVH, NbTH, NbSI, NbVI, NbTI, NbSY, NbVY, NbTY}; std::vector *LS[24] = {&SP, &VP, &TP, &SL, &VL, &TL, &ST, &VT, &TT, &SQ, &VQ, &TQ, &SS, &VS, &TS1, &SH, &VH, &TH, &SI, &VI, &TI, &SY, &VY, &TY}; PViewData *data; if(PSO_P->StoreInField >= 0) data = new PViewDataList(); else data = new PViewDataGModel(PViewDataGModel::ElementNodeData); data->importLists(NS, LS); new PView(data, field); #else Message::Error("GetDP must be compiled with Gmsh support to store data as field"); #endif if(!PSO_P->FileOut) break; } if(Flag_GMSH_VERSION == 2){ int NS[8] = {NbSP, NbSL, NbST, NbSQ, NbSS, NbSH, NbSI, NbSY}; std::vector *LS[8] = {&SP, &SL, &ST, &SQ, &SS, &SH, &SI, &SY}; Gmsh_PrintElementNodeData(PSO_P, NbTimeStep, 1, NS, LS); int NV[8] = {NbVP, NbVL, NbVT, NbVQ, NbVS, NbVH, NbVI, NbVY}; std::vector *LV[8] = {&VP, &VL, &VT, &VQ, &VS, &VH, &VI, &VY}; Gmsh_PrintElementNodeData(PSO_P, NbTimeStep, 3, NV, LV); int NT[8] = {NbTP, NbTL, NbTT, NbTQ, NbTS, NbTH, NbTI, NbTY}; std::vector *LT[8] = {&TP, &TL, &TT, &TQ, &TS1, &TH, &TI, &TY}; Gmsh_PrintElementNodeData(PSO_P, NbTimeStep, 9, NT, LT); } else if(PostStream && Flag_BIN){ /* bricolage */ fprintf(PostStream, "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d " "%d %d %d %d %d %d %d %d %d %d %d 0 0\n", List_Nbr(TimeValue_L), NbSP, NbVP, NbTP, NbSL, NbVL, NbTL, NbST, NbVT, NbTT, NbSQ, NbVQ, NbTQ, NbSS, NbVS, NbTS, NbSH, NbVH, NbTH, NbSI, NbVI, NbTI, NbSY, NbVY, NbTY, NbT2, (int)T2C.size()); fwrite(&One, sizeof(int), 1, PostStream); List_WriteToFile(TimeValue_L, PostStream, LIST_FORMAT_BINARY); bool f = true; dVecWrite(SP, PostStream, f); dVecWrite(VP, PostStream, f); dVecWrite(TP, PostStream, f); dVecWrite(SL, PostStream, f); dVecWrite(VL, PostStream, f); dVecWrite(TL, PostStream, f); dVecWrite(ST, PostStream, f); dVecWrite(VT, PostStream, f); dVecWrite(TT, PostStream, f); dVecWrite(SQ, PostStream, f); dVecWrite(VQ, PostStream, f); dVecWrite(TQ, PostStream, f); dVecWrite(SS, PostStream, f); dVecWrite(VS, PostStream, f); dVecWrite(TS1, PostStream, f); dVecWrite(SH, PostStream, f); dVecWrite(VH, PostStream, f); dVecWrite(TH, PostStream, f); dVecWrite(SI, PostStream, f); dVecWrite(VI, PostStream, f); dVecWrite(TI, PostStream, f); dVecWrite(SY, PostStream, f); dVecWrite(VY, PostStream, f); dVecWrite(TY, PostStream, f); dVecWrite(T2D, PostStream, f); cVecWrite(T2C, PostStream, f); fprintf(PostStream, "\n"); fprintf(PostStream, "$EndView\n"); } else if(PostStream){ if(List_Nbr(TimeValue_L) > 1){ fprintf(PostStream, "TIME{"); for(iTime = 0; iTime < List_Nbr(TimeValue_L); iTime++){ if(iTime) fprintf(PostStream, ","); fprintf(PostStream, "%.16g", *(double*)List_Pointer(TimeValue_L, iTime)); } fprintf(PostStream, "};\n"); } fprintf(PostStream, "};\n") ; } break ; case FORMAT_ADAPT : if(PostStream) fprintf(PostStream, "$EndAdapt\n"); break ; case FORMAT_UNV : if(PostStream) Unv_PrintFooter(PostStream); break ; case FORMAT_NODE_TABLE : if(PostStream){ fprintf(PostStream, "%d\n", (int)NodeTable.size()); for(std::map >::iterator it = NodeTable.begin(); it != NodeTable.end(); it++){ fprintf(PostStream, "%d", it->first); for(unsigned int i = 0; i < it->second.size(); i++) fprintf(PostStream, " %.16g", it->second[i]); fprintf(PostStream, "\n"); } } break; case FORMAT_LOOP_ERROR : Solutions_L = ((struct PostOpSolutions*) List_Pointer(Current.PostOpData_L, Current.PostOpDataIndex))->Solutions_L; PostOpSolutionGenerated = false; if(List_Nbr(Solutions_L)>0) { Solution_P = (struct Solution*)List_Pointer(Solutions_L, List_Nbr(Solutions_L)-1); PostOpSolutionGenerated = (Solution_P->TimeStep == (int)Current.TimeStep); } if (!PostOpSolutionGenerated) { Solution_S.Time = Current.Time; Solution_S.TimeImag = Current.TimeImag; Solution_S.TimeStep = Current.TimeStep; Solution_S.SolutionExist = 1; Solution_S.TimeFunctionValues = NULL; LinAlg_CreateVector(&Solution_S.x, &Current.DofData->Solver, List_Nbr(PostOpResults_L)); for(int i=0; ix, i); } List_Delete(PostOpResults_L); PostOpResults_L = NULL; break; } } /* ------------------------------------------------------------------------ */ /* F o r m a t _ P o s t E l e m e n t */ /* ------------------------------------------------------------------------ */ void Format_PostElement(struct PostSubOperation *PSO_P, int Contour, int Store, double Time, int TimeStep, int NbTimeStep, int NbrHarmonics, int HarmonicToTime, double *Dummy, struct PostElement * PE) { int i, j, k, l, Num_Element ; struct PostElement * PE2 ; struct Value Value ; static int Warning_FirstHarmonic = 0 ; if(PE->Index != NO_ELEMENT) Num_Element = Geo_GetGeoElement(PE->Index)->Num ; else Num_Element = 0 ; if(Contour){ if(PE->Value[0].Type != SCALAR){ Message::Error("Non scalar Element %d in contour creation", Num_Element); return; } if(NbTimeStep != 1){ Message::Error("Contour creation not allowed for multiple time steps"); return; } if(Current.NbrHar != 1 && !Warning_FirstHarmonic){ Message::Warning("Contour creation done only for first harmonic (use Re[] or Im[])"); Warning_FirstHarmonic = 1 ; } if(Store) List_Add(PostElement_L, &PE) ; else{ PE2 = PartialCopy_PostElement(PE) ; List_Add(PostElement_L, &PE2) ; } return ; } if(PSO_P->ChangeOfCoordinates && PSO_P->ChangeOfCoordinates[0] >= 0){ for(i=0 ; iNbrNodes ; i++){ Current.x = PE->x[i]; Current.y = PE->y[i]; Current.z = PE->z[i]; for(j = 0; j<9 ; j++) Current.Val[j] = PE->Value[i].Val[j]; Get_ValueOfExpressionByIndex(PSO_P->ChangeOfCoordinates[0], NULL, 0., 0., 0., &Value) ; PE->x[i] = Value.Val[0]; Get_ValueOfExpressionByIndex(PSO_P->ChangeOfCoordinates[1], NULL, 0., 0., 0., &Value) ; PE->y[i] = Value.Val[0]; Get_ValueOfExpressionByIndex(PSO_P->ChangeOfCoordinates[2], NULL, 0., 0., 0., &Value) ; PE->z[i] = Value.Val[0]; } } if(PSO_P->ChangeOfValues && List_Nbr(PSO_P->ChangeOfValues) > 0){ for(i=0 ; iNbrNodes ; i++){ Current.x = PE->x[i]; Current.y = PE->y[i]; Current.z = PE->z[i]; for(k=0 ; kValue[i].Val[MAX_DIM*k+j]; for(l=0 ; lChangeOfValues) ; l++){ Get_ValueOfExpressionByIndex(*(int*)List_Pointer(PSO_P->ChangeOfValues, l), NULL, 0., 0., 0., &Value) ; PE->Value[i].Val[MAX_DIM*k+l] = Value.Val[0]; } } } } switch(PSO_P->Format){ case FORMAT_GMSH_PARSED : GmshParsed_PrintElement(Time, TimeStep, NbTimeStep, NbrHarmonics, HarmonicToTime, PE->Type, PE->NbrNodes, PE->x, PE->y, PE->z, PE->Value) ; break ; case FORMAT_UNV : if(PostStream) Unv_PrintElement(PostStream, Num_Element, PE->NbrNodes, PE->Value) ; break ; case FORMAT_GMSH : if(PSO_P->StoreInField >= 0 || PSO_P->StoreInMeshBasedField >= 0){ Gmsh_PrintElement(Time, TimeStep, NbTimeStep, NbrHarmonics, HarmonicToTime, PE->Type, Num_Element, PE->NbrNodes, PE->x, PE->y, PE->z, PE->Value, PSO_P, Store) ; if(!PSO_P->FileOut || Flag_GMSH_VERSION == 2 || Flag_BIN) break; } if(Flag_GMSH_VERSION == 2 || Flag_BIN){ /* bricolage */ Gmsh_PrintElement(Time, TimeStep, NbTimeStep, NbrHarmonics, HarmonicToTime, PE->Type, Num_Element, PE->NbrNodes, PE->x, PE->y, PE->z, PE->Value, PSO_P, Store) ; } else{ GmshParsed_PrintElement(Time, TimeStep, NbTimeStep, NbrHarmonics, HarmonicToTime, PE->Type, PE->NbrNodes, PE->x, PE->y, PE->z, PE->Value) ; } break ; case FORMAT_GNUPLOT : Gnuplot_PrintElement(PSO_P->Format, Time, TimeStep, NbTimeStep, NbrHarmonics, HarmonicToTime, PE->Type, Num_Element, PE->NbrNodes, PE->x, PE->y, PE->z, Dummy, PE->Value) ; break ; case FORMAT_SPACE_TABLE : case FORMAT_TIME_TABLE : case FORMAT_SIMPLE_SPACE_TABLE : case FORMAT_VALUE_ONLY : Tabular_PrintElement(PSO_P, PSO_P->Format, Time, TimeStep, NbTimeStep, NbrHarmonics, HarmonicToTime, PE->Type, Num_Element, PE->NbrNodes, PE->x, PE->y, PE->z, Dummy, PE->Value) ; break ; case FORMAT_NODE_TABLE : NodeTable_PrintElement(TimeStep, NbTimeStep, NbrHarmonics, PE); break; case FORMAT_LOOP_ERROR : StorePostOpResult(NbrHarmonics, PE); break; case FORMAT_ADAPT: if(PostStream){ if(Dummy[4]) fprintf(PostStream, "%d\n", (int)Dummy[4]) ; fprintf(PostStream, "%d %g %g %g\n", (int)Dummy[0], Dummy[1], Dummy[2], Dummy[3]); } break ; default : Message::Error("Unknown format in Format_PostElement"); } if (PSO_P->SendToServer && strcmp(PSO_P->SendToServer, "No")){ if(PE->Value[0].Type == SCALAR) Message::AddOnelabNumberChoice(PSO_P->SendToServer, PE->Value[0].Val[0], PSO_P->Color); else if(Message::UseOnelab()) Message::Warning("Cannot send non-scalar values to server (yet)"); } } /* ------------------------------------------------------------------------ */ /* F o r m a t _ P o s t V a l u e */ /* ------------------------------------------------------------------------ */ void Format_PostValue(int Format, int Flag_Comma, int Group_FunctionType, int iTime, double Time, int NbrTimeStep, int iRegion, int numRegion, int NbrRegion, int NbrHarmonics, int HarmonicToTime, int FourierTransform, int Flag_NoNewLine, struct Value * Value) { static int Size ; int j, k ; double TimeMH, Freq ; double x, y, z ; int flag_storeAllTimeResults, indexInTmpValues ; static struct Value TmpValue, *TmpValues ; static double *Times ; flag_storeAllTimeResults = FourierTransform ; indexInTmpValues = flag_storeAllTimeResults? iTime * NbrRegion : 0 ; if(iRegion == 0){ switch(Value->Type){ case SCALAR : Size = 1 ; break ; case VECTOR : Size = 3 ; break ; case TENSOR_DIAG : Size = 3 ; break ; case TENSOR_SYM : Size = 6 ; break ; case TENSOR : Size = 9 ; break ; } } if (Format == FORMAT_REGION_TABLE) { if(iRegion == 0){ if(PostStream == stdout || PostStream == stderr) Message::Direct("%d", NbrRegion); else if(PostStream) fprintf(PostStream, "%d\n", NbrRegion) ; } std::ostringstream sstream; sstream.precision(16); sstream << numRegion; for (k = 0 ; k < NbrHarmonics ; k++) { for(j = 0 ; j < Size ; j++) { if (Flag_Comma) sstream << ","; sstream << " " << Value->Val[MAX_DIM*k+j] ; } } if(PostStream == stdout || PostStream == stderr) Message::Direct(sstream.str().c_str()); else if(PostStream) fprintf(PostStream, "%s\n", sstream.str().c_str()) ; } else if (Format == FORMAT_GMSH && Flag_GMSH_VERSION != 2) { if (Group_FunctionType == NODESOF) Geo_GetNodesCoordinates(1, &numRegion, &x, &y, &z) ; else { x = y = z = 0.; Message::Warning("Post Format \'Gmsh\' not adapted for global quantities supported" " by Regions. Zero coordinates are considered.") ; } GmshParsed_PrintElement(Time, 0, 1, NbrHarmonics, HarmonicToTime, POINT, 1, &x, &y, &z, Value) ; } else if (Format == FORMAT_UNV) { if(PostStream) Unv_PrintRegion(PostStream, Flag_Comma, numRegion, NbrHarmonics, Size, Value); } else if (Format == FORMAT_LOOP_ERROR) { StorePostOpResult(NbrHarmonics, Value); } else { if(iRegion == 0){ if (!flag_storeAllTimeResults) TmpValues = (struct Value*) Malloc(NbrRegion*sizeof(struct Value)) ; else{ if (iTime == 0){ TmpValues = (struct Value*) Malloc(NbrTimeStep*NbrRegion*sizeof(struct Value)) ; Times = (double*) Malloc(NbrTimeStep*sizeof(double)) ; } Times[iTime] = Time ; } } Cal_CopyValue(Value, &TmpValues[indexInTmpValues+iRegion]) ; if (!flag_storeAllTimeResults && iRegion == NbrRegion-1) { if (PostStream && HarmonicToTime == 1) { switch (Format) { case FORMAT_FREQUENCY_TABLE : if (NbrHarmonics == 1){ Message::Error("FrequencyTable format not allowed (only one harmonic)") ; return; } break ; case FORMAT_VALUE_ONLY : break; default : fprintf(PostStream, "%.16g ", Time) ; break ; } for (iRegion = 0 ; iRegion < NbrRegion ; iRegion++) for (k = 0 ; k < NbrHarmonics ; k++) { if (Format == FORMAT_FREQUENCY_TABLE && !(k%2) && iRegion==0) { Freq = Current.DofData->Val_Pulsation[0] / TWO_PI ; fprintf(PostStream, "%.16g ", Freq) ; } for(j = 0 ; j < Size ; j++) if (Format != FORMAT_REGION_VALUE) fprintf(PostStream, " %.16g", TmpValues[indexInTmpValues+iRegion].Val[MAX_DIM*k+j]) ; } if (Flag_NoNewLine || Format == FORMAT_REGION_VALUE) fprintf(PostStream, " ") ; else fprintf(PostStream, "\n") ; } else if(PostStream){ for(k = 0 ; k < HarmonicToTime ; k++) { for (iRegion = 0 ; iRegion < NbrRegion ; iRegion++) { F_MHToTime0(k+iRegion, &TmpValues[indexInTmpValues+iRegion], &TmpValue, k, HarmonicToTime, &TimeMH) ; if (iRegion == 0) fprintf(PostStream, "%.16g ", TimeMH) ; for(j = 0 ; j < Size ; j++) fprintf(PostStream, " %.16g", TmpValue.Val[j]) ; } fprintf(PostStream, "\n") ; } } if (flag_storeAllTimeResults) Free(Times) ; Free(TmpValues) ; } else if (flag_storeAllTimeResults && iTime == NbrTimeStep-1 && iRegion == NbrRegion-1) { Pos_FourierTransform(NbrTimeStep, NbrRegion, Times, TmpValues, Size, 1, NULL, NULL, NULL); Free(Times); Free(TmpValues) ; } } } /* ------------------------------------------------------------------------ */ /* P o s _ F o u r i e r T r a n s f o r m */ /* ------------------------------------------------------------------------ */ void Pos_FourierTransform(int NbrTimeStep, int NbrRegion, double *Times, struct Value *TmpValues, int Size, int TypeOutput, int *NbrFreq, double **Frequencies, struct Value **OutValues) { #if NEW_CODE *NbrFreq = (NbrTimeStep-1)/2+1; *Frequencies = (double *)Malloc(*NbrFreq*sizeof(double)); *OutValues = (struct Value *)Malloc(*NbrFreq*sizeof(struct Value)); int nfft = *NbrFreq; kissfft fft(nfft, false); std::vector > inbuf(nfft); std::vector > outbuf(nfft); for (int k = 0; k < nfft; ++k) inbuf[k]= std::complex(rand()/(double)RAND_MAX - .5, rand()/(double)RAND_MAX - .5); fft.transform(&inbuf[0], &outbuf[0]); #else int iTime, iRegion, k_fc, i_k, j, k; int N, Nhalf, NbrFourierComps; double *val_FourierComps; double val, val_r, val_i, norm, Period, w, v_cos, v_sin; N = NbrTimeStep-1; Nhalf = N/2; // Nhalf = 2; NbrFourierComps = Nhalf*2; Period = Times[NbrTimeStep-1] - Times[0]; w = TWO_PI/Period; val_FourierComps = (double*) Malloc(NbrFourierComps*MAX_DIM*2*sizeof(double)) ; for (k_fc=-Nhalf; k_fc. /* 6 integration points (DHATT ET TOUZOT) */ static double upri6[6] = {0.166666666666666, 0.666666666666666, 0.166666666666666, 0.166666666666666, 0.666666666666666, 0.166666666666666}; static double vpri6[6] = {0.166666666666666, 0.166666666666666, 0.666666666666666, 0.166666666666666, 0.166666666666666, 0.666666666666666}; static double wpri6[6] = {-0.577350269189, -0.577350269189, -0.577350269189, 0.577350269189, 0.577350269189, 0.577350269189}; static double ppri6[6] = {0.166666666666666,0.166666666666666,0.166666666666666, 0.166666666666666,0.166666666666666,0.166666666666666}; /* 9 integration points (DHATT ET TOUZOT) */ static double upri9[9] = {0.166666666666666, 0.666666666666666, 0.166666666666666, 0.166666666666666, 0.666666666666666, 0.166666666666666, 0.166666666666666, 0.666666666666666, 0.166666666666666}; static double vpri9[9] = {0.166666666666666, 0.166666666666666, 0.666666666666666, 0.166666666666666, 0.166666666666666, 0.666666666666666, 0.166666666666666, 0.166666666666666, 0.666666666666666}; static double wpri9[9] = {-0.774596669241483, -0.774596669241483, -0.774596669241483, 0. , 0. , 0. , 0.774596669241483, 0.774596669241483, 0.774596669241483}; static double ppri9[9] = {0.0925925925929,0.0925925925929,0.0925925925929, 0.1481481481481,0.1481481481481,0.1481481481481, 0.0925925925929,0.0925925925929,0.0925925925929}; /* 21 integration points (DHATT ET TOUZOT) */ static double upri21[21] = {0.333333333333333, 0.470142064105115, 0.05971587179 , 0.470142064105115, 0.101286507323456, 0.79742698535 , 0.101286507323456, 0.333333333333333, 0.470142064105115, 0.05971587179 , 0.470142064105115, 0.101286507323456, 0.79742698535 , 0.101286507323456, 0.333333333333333, 0.470142064105115, 0.05971587179 , 0.470142064105115, 0.101286507323456, 0.79742698535 , 0.101286507323456}; static double vpri21[21] = {0.333333333333333, 0.470142064105115, 0.470142064105115, 0.05971587179 , 0.101286507323456, 0.101286507323456, 0.79742698535 , 0.333333333333333, 0.470142064105115, 0.470142064105115, 0.05971587179 , 0.101286507323456, 0.101286507323456, 0.79742698535 , 0.333333333333333, 0.470142064105115, 0.470142064105115, 0.05971587179 , 0.101286507323456, 0.101286507323456, 0.79742698535}; static double wpri21[21] = {-0.774596669241483,-0.774596669241483, -0.774596669241483,-0.774596669241483, -0.774596669241483,-0.774596669241483, -0.774596669241483, 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0.774596669241483, 0.774596669241483, 0.774596669241483, 0.774596669241483, 0.774596669241483, 0.774596669241483, 0.774596669241483}; static double ppri21[21] = {0.625000000000000E-01, 0.367761535523628E-01, 0.367761535523628E-01, 0.367761535523628E-01, 0.349831057068964E-01, 0.349831057068964E-01, 0.349831057068964E-01, 0.100000000000000E+00, 0.588418456837804E-01, 0.588418456837804E-01, 0.588418456837804E-01, 0.559729691310342E-01, 0.559729691310342E-01, 0.559729691310342E-01, 0.625000000000000E-01, 0.367761535523628E-01, 0.367761535523628E-01, 0.367761535523628E-01, 0.349831057068964E-01, 0.349831057068964E-01, 0.349831057068964E-01}; /* 42 integration points (DHATT ET TOUZOT) */ static double upri42[42] = {0.333333333333333, 0.470142064105115, 0.05971587179 , 0.470142064105115, 0.101286507323456, 0.79742698535 , 0.101286507323456, 0.333333333333333, 0.470142064105115, 0.05971587179 , 0.470142064105115, 0.101286507323456, 0.79742698535 , 0.101286507323456, 0.333333333333333, 0.470142064105115, 0.05971587179 , 0.470142064105115, 0.101286507323456, 0.79742698535 , 0.101286507323456, 0.333333333333333, 0.470142064105115, 0.05971587179 , 0.470142064105115, 0.101286507323456, 0.79742698535 , 0.101286507323456, 0.333333333333333, 0.470142064105115, 0.05971587179 , 0.470142064105115, 0.101286507323456, 0.79742698535 , 0.101286507323456, 0.333333333333333, 0.470142064105115, 0.05971587179 , 0.470142064105115, 0.101286507323456, 0.79742698535 , 0.101286507323456}; static double vpri42[42] = {0.333333333333333, 0.470142064105115, 0.470142064105115, 0.05971587179 , 0.101286507323456, 0.101286507323456, 0.79742698535 , 0.333333333333333, 0.470142064105115, 0.470142064105115, 0.05971587179 , 0.101286507323456, 0.101286507323456, 0.79742698535 , 0.333333333333333, 0.470142064105115, 0.470142064105115, 0.05971587179 , 0.101286507323456, 0.101286507323456, 0.79742698535 , 0.333333333333333, 0.470142064105115, 0.470142064105115, 0.05971587179 , 0.101286507323456, 0.101286507323456, 0.79742698535 , 0.333333333333333, 0.470142064105115, 0.470142064105115, 0.05971587179 , 0.101286507323456, 0.101286507323456, 0.79742698535 , 0.333333333333333, 0.470142064105115, 0.470142064105115, 0.05971587179 , 0.101286507323456, 0.101286507323456, 0.79742698535}; static double wpri42[42] = {-0.238619186083197, -0.238619186083197,-0.238619186083197, -0.238619186083197,-0.238619186083197, -0.238619186083197,-0.238619186083197, 0.238619186083197, 0.238619186083197, 0.238619186083197, 0.238619186083197, 0.238619186083197, 0.238619186083197, 0.238619186083197, -0.661209386466265, -0.661209386466265,-0.661209386466265, -0.661209386466265,-0.661209386466265, -0.661209386466265,-0.661209386466265, 0.661209386466265, 0.661209386466265, 0.661209386466265, 0.661209386466265, 0.661209386466265, 0.661209386466265, 0.661209386466265, -0.932469514203152, -0.932469514203152,-0.932469514203152, -0.932469514203152,-0.932469514203152, -0.932469514203152,-0.932469514203152, 0.932469514203152, 0.932469514203152, 0.932469514203152, 0.932469514203152, 0.932469514203152, 0.932469514203152, 0.932469514203152}; static double ppri42[42] = {0.5264031763942775E-01, 0.3097453447284393E-01, 0.3097453447284393E-01, 0.3097453447284393E-01, 0.2946434874279526E-01, 0.2946434874279526E-01, 0.2946434874279526E-01, 0.5264031763942775E-01, 0.3097453447284393E-01, 0.3097453447284393E-01, 0.3097453447284393E-01, 0.2946434874279526E-01, 0.2946434874279526E-01, 0.2946434874279526E-01, 0.4058567696791564E-01, 0.2388136141117854E-01, 0.2388136141117854E-01, 0.2388136141117854E-01, 0.2271700844087269E-01, 0.2271700844087269E-01, 0.2271700844087269E-01, 0.4058567696791564E-01, 0.2388136141117854E-01, 0.2388136141117854E-01, 0.2388136141117854E-01, 0.2271700844087269E-01, 0.2271700844087269E-01, 0.2271700844087269E-01, 0.1927400539265662E-01, 0.1134118051023053E-01, 0.1134118051023053E-01, 0.1134118051023053E-01, 0.1078823308874557E-01, 0.1078823308874557E-01, 0.1078823308874557E-01, 0.1927400539265662E-01, 0.1134118051023053E-01, 0.1134118051023053E-01, 0.1134118051023053E-01, 0.1078823308874557E-01, 0.1078823308874557E-01, 0.1078823308874557E-01}; getdp-2.7.0-source/Legacy/Operation_ChangeOfCoordinates.cpp000644 001750 001750 00000017574 12473553042 025421 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Johan Gyselinck // Ruth Sabariego // #include #include #include #include "ProData.h" #include "DofData.h" #include "GeoData.h" #include "Pos_Search.h" #include "SolvingOperations.h" #include "Cal_Quantity.h" #include "ExtendedGroup.h" #include "BF.h" #include "Message.h" extern struct Problem Problem_S ; extern struct CurrentData Current ; /* ------------------------------------------------------------------------ */ /* O p e r a t i o n _ C h a n g e O f C o o r d i n a t e s */ /* ------------------------------------------------------------------------ */ void Operation_ChangeOfCoordinates(struct Resolution * Resolution_P, struct Operation * Operation_P, struct DofData * DofData_P0, struct GeoData * GeoData_P0) { int i, Nbr_Node, Num_Node, ThisIsTheNode ; double x=0., y=0., z=0.; struct Value Value, Value1, Value2 ; struct Group * Group_P ; // Note: Current.{u,v,w} is not defined, so we cannot interpolate expressions // in the reference element. We thus set Current.Element=0 and rely on // Current.{x,y,z}. struct Element *old = Current.Element; Current.Element = 0; Group_P = (struct Group *) List_Pointer(Problem_S.Group, Operation_P->Case.ChangeOfCoordinates.GroupIndex) ; if (!Group_P->ExtendedList) Generate_ExtendedGroup(Group_P) ; if (Group_P->FunctionType != NODESOF) Message::Error("ChangeOfCoordinates: Group must be of NodesOf function type") ; Nbr_Node = List_Nbr(Group_P->ExtendedList) ; for (i=0 ; i < Nbr_Node ; i++) { List_Read(Group_P->ExtendedList, i, &Num_Node) ; if (!Group_P->InitialSuppList || ! List_Search(Group_P->ExtendedSuppList, &Num_Node, fcmp_int)) { Geo_GetNodesCoordinates(1, &Num_Node, &Current.x, &Current.y, &Current.z) ; if (Operation_P->Case.ChangeOfCoordinates.ExpressionIndex2 >= 0 && Num_Node == Operation_P->Case.ChangeOfCoordinates.NumNode) { x = Current.x ; y = Current.y ; z = Current.z ; Get_ValueOfExpressionByIndex (Operation_P->Case.ChangeOfCoordinates.ExpressionIndex2, NULL, 0., 0., 0., &Value1) ; ThisIsTheNode = 1 ; } else ThisIsTheNode = 0 ; Get_ValueOfExpressionByIndex (Operation_P->Case.ChangeOfCoordinates.ExpressionIndex, NULL, 0., 0., 0., &Value) ; if (ThisIsTheNode) { Current.x = Value.Val[0] ; Current.y = Value.Val[1] ; Current.z = Value.Val[2] ; Get_ValueOfExpressionByIndex (Operation_P->Case.ChangeOfCoordinates.ExpressionIndex2, NULL, 0., 0., 0., &Value2) ; Message::Debug("before x %e y %e z %e ||| after x %e y %e z %e\n", x, y, z, Value.Val[0], Value.Val[1], Value.Val[2]); Message::Debug(" before %e after %e", Value1.Val[0], Value2.Val[0]) ; } Geo_SetNodesCoordinates(1, &Num_Node, &Value.Val[0], &Value.Val[1], &Value.Val[2]) ; } } Current.Element = old; Free_SearchGrid(&Current.GeoData->Grid); } /* ------------------------------------------------------------------------ */ /* O p e r a t i o n _ D e f o r m e M e s h */ /* ------------------------------------------------------------------------ */ void Operation_DeformeMesh(struct Resolution * Resolution_P, struct Operation * Operation_P, struct DofData * DofData_P0, struct GeoData * GeoData_P0) { int i, Num_Node, NumBF_X=-1, NumBF_Y=-1, NumBF_Z=-1 ; double Value, un_x = 0., un_y = 0., un_z = 0. ; struct DefineSystem * DS ; struct Formulation * FO ; struct DefineQuantity * DQ_P ; struct FunctionSpace * FunctionSpace_P ; struct DofData * DofData_P ; struct Group * Group_P ; Group_P = (Operation_P->Case.DeformeMesh.GroupIndex >=0)? (struct Group *)List_Pointer(Problem_S.Group, Operation_P->Case.DeformeMesh.GroupIndex) : NULL; if (Group_P && Group_P->FunctionType != NODESOF) Message::Error("DeformeMesh: Group must be of NodesOf function type") ; DS = (struct DefineSystem*)List_Pointer(Resolution_P->DefineSystem, Operation_P->DefineSystemIndex) ; if( List_Nbr(DS->FormulationIndex) > 1 ) Message::Error("DeformeMesh: Only one formulation must be associated to the system %s", DS->Name) ; FO = (struct Formulation *) List_Pointer(Problem_S.Formulation, *((int *)List_Pointer(DS->FormulationIndex, 0))) ; if((i = List_ISearchSeq(FO->DefineQuantity, Operation_P->Case.DeformeMesh.Quantity, fcmp_DefineQuantity_Name)) < 0) Message::Error("Unknown Quantity '%s' in Formulation %s", Operation_P->Case.DeformeMesh.Quantity, FO->Name ) ; DQ_P = (struct DefineQuantity *) List_Pointer(FO->DefineQuantity, i) ; DofData_P = DofData_P0 + Operation_P->DefineSystemIndex ; FunctionSpace_P = (struct FunctionSpace*)List_Pointer(Problem_S.FunctionSpace, DQ_P->FunctionSpaceIndex) ; for(i = 0 ; i < List_Nbr(FunctionSpace_P->BasisFunction); i++){ if( (void(*)())((struct BasisFunction*)List_Pointer(FunctionSpace_P->BasisFunction, i))->Function == (void(*)())BF_NodeX ) NumBF_X = ((struct BasisFunction*)List_Pointer(FunctionSpace_P->BasisFunction, i))->Num; if( (void(*)())((struct BasisFunction*)List_Pointer(FunctionSpace_P->BasisFunction, i))->Function == (void(*)())BF_NodeY ) NumBF_Y = ((struct BasisFunction*)List_Pointer(FunctionSpace_P->BasisFunction, i))->Num; if( (void(*)())((struct BasisFunction*)List_Pointer(FunctionSpace_P->BasisFunction, i))->Function == (void(*)())BF_NodeZ ) NumBF_Z = ((struct BasisFunction*)List_Pointer(FunctionSpace_P->BasisFunction, i))->Num; } for(i = 0 ; i < List_Nbr(FunctionSpace_P->DofData->DofList) ; i++){ if (((struct Dof*)List_Pointer(FunctionSpace_P->DofData->DofList, i ))->NumType == NumBF_X || ((struct Dof*)List_Pointer(FunctionSpace_P->DofData->DofList, i ))->NumType == NumBF_Y || ((struct Dof*)List_Pointer(FunctionSpace_P->DofData->DofList, i ))->NumType == NumBF_Z ){ Num_Node = ((struct Dof*)List_Pointer(FunctionSpace_P->DofData->DofList, i ))->Entity ; if (!Group_P || Check_IsEntityInExtendedGroup(Group_P, Num_Node, 0)) { Dof_GetRealDofValue (FunctionSpace_P->DofData, ((struct Dof*)List_Pointer(FunctionSpace_P->DofData->DofList, i )) , &Value) ; /* Reference mesh */ Geo_SetCurrentGeoData(Current.GeoData = GeoData_P0 + Operation_P->Case.DeformeMesh.GeoDataIndex) ; Geo_GetNodesCoordinates(1, &Num_Node, &un_x, &un_y, &un_z) ; /* Mesh associated to the electromechanical system */ if( GeoData_P0 + DofData_P->GeoDataIndex != GeoData_P0 + Operation_P->Case.DeformeMesh.GeoDataIndex ) Geo_SetCurrentGeoData(Current.GeoData = GeoData_P0 + DofData_P->GeoDataIndex) ; if (((struct Dof*)List_Pointer(FunctionSpace_P->DofData->DofList, i))->NumType == NumBF_X){ un_x += Operation_P->Case.DeformeMesh.Factor * Value ; Geo_SetNodesCoordinatesX(1, &Num_Node, &un_x) ; } if (((struct Dof*)List_Pointer(FunctionSpace_P->DofData->DofList, i))->NumType == NumBF_Y){ un_y += Operation_P->Case.DeformeMesh.Factor * Value ; Geo_SetNodesCoordinatesY(1, &Num_Node, &un_y) ; } if (((struct Dof*)List_Pointer(FunctionSpace_P->DofData->DofList, i))->NumType == NumBF_Z){ un_z += Operation_P->Case.DeformeMesh.Factor * Value ; Geo_SetNodesCoordinatesZ(1, &Num_Node, &un_z) ; } } } } Current.GeoData = GeoData_P0 + Operation_P->Case.DeformeMesh.GeoDataIndex; Free_SearchGrid(&Current.GeoData->Grid); } getdp-2.7.0-source/Legacy/Cal_IntegralQuantity.h000644 001750 001750 00000002262 12473553042 023250 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _CAL_INTEGRAL_QUANTITY_H_ #define _CAL_INTEGRAL_QUANTITY_H_ #include "ProData.h" void Cal_InitIntegralQuantity(struct Element *Element, struct IntegralQuantityActive *IQA, struct QuantityStorage *QuantityStorage_P); void Cal_NumericalIntegralQuantity(struct Element *Element, struct IntegralQuantityActive *IQA, struct QuantityStorage *QuantityStorage_P0, struct QuantityStorage *QuantityStorage_P, int Type_DefineQuantity, int Nbr_Dof, void (*xFunctionBF[])(), struct Value vBFxDof[]); void Cal_AnalyticIntegralQuantity(struct Element *Element, struct QuantityStorage *QuantityStorage_P, int Nbr_Dof, void (*xFunctionBF[])(), struct Value vBFxDof[]); #endif getdp-2.7.0-source/Legacy/Gauss_Triangle.h000644 001750 001750 00000014235 12473553042 022077 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . /* 1 integration point */ static double xt1[1] = {0.333333333333333}; static double yt1[1] = {0.333333333333333}; static double pt1[1] = {0.5}; /* 3 integration points */ static double xt3[3] = {0.16666666666666,0.66666666666666,0.16666666666666}; static double yt3[3] = {0.16666666666666,0.16666666666666,0.66666666666666}; static double pt3[3] = {0.16666666666666,0.16666666666666,0.16666666666666}; /* 4 integration points */ static double xt4[4] = {0.333333333333333,0.6,0.2,0.2}; static double yt4[4] = {0.3333333333333333,0.2,0.6,0.2}; static double pt4[4] = {-0.28125,.260416666666,.260416666666,.260416666666}; /* 6 integration points */ static double xt6[6] = {0.816847572980459,0.091576213509771,0.091576213509771, 0.108103018168070,0.445948490915965,0.445948490915965}; static double yt6[6] = {0.091576213509771,0.816847572980459,0.091576213509771, 0.445948490915965,0.108103018168070,0.445948490915965}; static double pt6[6] = {0.054975871827661,0.054975871827661,0.054975871827661, 0.111690794839,0.111690794839,0.111690794839}; /* 7 integration points */ static double xt7[7] = {0.333333333333333,0.797426985353087,0.101286507323456, 0.101286507323456,0.470142064105115,0.059715871789770, 0.470142064105115}; static double yt7[7] = {0.333333333333333,0.101286507323456,0.797426985353087, 0.101286507323456,0.059715871789770,0.470142064105115, 0.470142064105115}; static double pt7[7] = {0.112500000000000,0.062969590272414,0.062969590272414, 0.062969590272414,0.066197076394253,0.066197076394253, 0.066197076394253}; /* 12 integration points */ static double xt12[12] = {0.873821971016996,0.063089014491502,0.063089014491502, 0.501426509658179,0.249286745170910,0.249286745170910, 0.636502499121399,0.310352451033785,0.636502499121399, 0.310352451033785,0.053145049844816,0.053145049844816}; static double yt12[12] = {0.063089014491502,0.873821971016996,0.063089014491502, 0.249286745170910,0.501426509658179,0.249286745170910, 0.310352451033785,0.636502499121399,0.053145049844816, 0.053145049844816,0.310352451033785,0.636502499121399}; static double pt12[12] = {0.025422453185104,0.025422453185104,0.025422453185104, 0.058393137863189,0.058393137863189,0.058393137863189, 0.041425537809187,0.041425537809187,0.041425537809187, 0.041425537809187,0.041425537809187,0.041425537809187}; /* 13 integration points */ static double xt13[13] = {0.333333333333333,0.479308067841920,0.260345966079040, 0.260345966079040,0.869739794195568,0.065130102902216, 0.065130102902216,0.048690315425316,0.312865496004874, 0.638444188569810,0.048690315425316,0.312865496004874, 0.638444188569810}; static double yt13[13] = {0.333333333333333,0.260345966079040,0.479308067841920, 0.260345966079040,0.065130102902216,0.869739794195568, 0.065130102902216,0.312865496004874,0.048690315425316, 0.048690315425316,0.638444188569810,0.638444188569810, 0.312865496004874}; static double pt13[13] = {-0.074785022233841,0.087807628716604,0.087807628716604, 0.087807628716604,0.026673617804419,0.026673617804419, 0.026673617804419,0.038556880445128,0.038556880445128, 0.038556880445128,0.038556880445128,0.038556880445128, 0.038556880445128}; /* 16 integration points */ static double xt16[16] = {0.333333333333333,0.081414823414554,0.459292588292723, 0.459292588292723,0.658861384496480,0.170569307751760, 0.170569307751760,0.898905543365938,0.050547228317031, 0.050547228317031,0.008394777409958,0.728492392955404, 0.263112829634638,0.008394777409958,0.263112829634638, 0.728492392955404}; static double yt16[16] = {0.333333333333333,0.459292588292723,0.081414823414554, 0.459292588292723,0.170569307751760,0.658861384496480, 0.170569307751760,0.050547228317031,0.898905543365938, 0.050547228317031,0.728492392955404,0.008394777409958, 0.008394777409958,0.263112829634638,0.728492392955404, 0.263112829634638}; static double pt16[16] = {0.072157803838894,0.047545817133643,0.047545817133643, 0.047545817133643,0.051608685267359,0.051608685267359, 0.051608685267359,0.016229248811599,0.016229248811599, 0.016229248811599,0.013615157087217,0.013615157087217, 0.013615157087217,0.013615157087217,0.013615157087217, 0.013615157087217}; /* GAUSS TRIANGLE WITH 1/R SINGULARITY OVER NODE (0,0,0) ref.: H. L. G. Pina, J. L. M. Fernandes, C. A. Brebbia, Some numerical integration formulae over triangles and squares with a 1/R singularity, Appl. Math. Modelling, Vol 5, June 1981, pp 209--211 */ /* 1 integration point */ static double xts1[1] = {0.25}; static double yts1[1] = {0.25}; static double pts1[1] = {1.24645048}; /* 3 integration points */ static double xts3[3] = {0.16666667,0.81742619,0.18257381}; static double yts3[3] = {0.16666667,0.18257381,0.81742619}; static double pts3[3] = {0.93483790,0.15580629,0.15580629}; /* 4 integration points */ static double xts4[4] = {0.16385495,0.61114353,0.04756957,0.17753138}; static double yts4[4] = {0.04756957,0.17753138,0.16385495,0.61114353}; static double pts4[4] = {0.31161231,0.31161293,0.31161231,0.31161293}; getdp-2.7.0-source/Legacy/Gauss.h000644 001750 001750 00000002211 12473553042 020241 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _GAUSS_H_ #define _GAUSS_H_ #define GAUSS_ARGS int Nbr_Points, int Num_Point, \ double *u, double *v, double *w, double *wght void Gauss_Point (GAUSS_ARGS) ; void Gauss_Line (GAUSS_ARGS) ; void Gauss_Triangle (GAUSS_ARGS) ; void GaussLegendre_Triangle (GAUSS_ARGS) ; void GaussSingularR_Triangle (GAUSS_ARGS) ; void Gauss_Quadrangle (GAUSS_ARGS) ; void GaussLegendre_Quadrangle (GAUSS_ARGS) ; void GaussSingularR_Quadrangle(GAUSS_ARGS) ; void Gauss_Tetrahedron (GAUSS_ARGS) ; void GaussLegendre_Tetrahedron(GAUSS_ARGS) ; void Gauss_Hexahedron (GAUSS_ARGS) ; void GaussLegendre_Hexahedron (GAUSS_ARGS) ; void Gauss_Prism (GAUSS_ARGS) ; void Gauss_Pyramid (GAUSS_ARGS) ; #undef GAUSS_ARGS #define MAX_LINE_POINTS 100 void GaussLegendre(double x1, double x2, double x[], double w[], int n) ; #endif getdp-2.7.0-source/Legacy/Cal_GlobalTermOfFemEquation.h000644 001750 001750 00000001121 12473553042 024410 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _CAL_GLOBAL_TERM_OF_FEM_EQUATION_H_ #define _CAL_GLOBAL_TERM_OF_FEM_EQUATION_H_ #include "ProData.h" void Cal_GlobalTermOfFemEquation(int Num_Region, struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0, struct QuantityStorage * QuantityStorageNoDof, struct Dof * DofForNoDof_P); #endif getdp-2.7.0-source/Legacy/BF_Node_2.cpp000644 001750 001750 00000042663 12473553042 021206 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "ProData.h" #include "Message.h" /* ------------------------------------------------------------------------ */ /* B F _ N o d e _ 2 */ /* ------------------------------------------------------------------------ */ /* ------- */ /* Edges */ /* ------- */ #define WrongNumEntity Message::Error("Wrong Edge number in 'BF_Node_2E'") void BF_Node_2E(struct Element * Element, int NumEntity, double u, double v, double w, double *s) { switch (Element->Type) { case LINE : switch(NumEntity) { case 1 : *s = 0.25 * (1.-u) * (1.+u) ; break ; default : WrongNumEntity ; } break ; case TRIANGLE : switch(NumEntity) { case 1 : *s = (1.-u-v) * u ; break ; case 2 : *s = (1.-u-v) * v ; break ; case 3 : *s = u * v ; break ; default : WrongNumEntity ; } break ; case QUADRANGLE : switch(NumEntity) { case 1 : *s = 0.0625 * (1.-u*u) * (1.-v)*(1.-v) ; break ; case 2 : *s = 0.0625 * (1.-u)*(1.-u) * (1.-v*v) ; break ; case 3 : *s = 0.0625 * (1.+u)*(1.+u) * (1.-v*v) ; break ; case 4 : *s = 0.0625 * (1.-u*u) * (1.+v)*(1.+v) ; break ; default : WrongNumEntity ; } break ; case TETRAHEDRON : switch(NumEntity) { case 1 : *s = (1.-u-v-w) * u ; break ; case 2 : *s = (1.-u-v-w) * v ; break ; case 3 : *s = (1.-u-v-w) * w ; break ; case 4 : *s = u * v ; break ; case 5 : *s = u * w ; break ; case 6 : *s = v * w ; break ; default : WrongNumEntity ; } break ; case HEXAHEDRON : switch(NumEntity) { case 1 : *s = 0.015625 * (1.-u) * (1.-v) * (1.-w) * (1.+u) * (1.-v) * (1.-w) ; break ; case 2 : *s = 0.015625 * (1.-u) * (1.-v) * (1.-w) * (1.-u) * (1.+v) * (1.-w) ; break ; case 3 : *s = 0.015625 * (1.-u) * (1.-v) * (1.-w) * (1.-u) * (1.-v) * (1.+w) ; break ; case 4 : *s = 0.015625 * (1.+u) * (1.-v) * (1.-w) * (1.+u) * (1.+v) * (1.-w) ; break ; case 5 : *s = 0.015625 * (1.+u) * (1.-v) * (1.-w) * (1.+u) * (1.-v) * (1.+w) ; break ; case 6 : *s = 0.015625 * (1.+u) * (1.+v) * (1.-w) * (1.-u) * (1.+v) * (1.-w) ; break ; case 7 : *s = 0.015625 * (1.+u) * (1.+v) * (1.-w) * (1.+u) * (1.+v) * (1.+w) ; break ; case 8 : *s = 0.015625 * (1.-u) * (1.+v) * (1.-w) * (1.-u) * (1.+v) * (1.+w) ; break ; case 9 : *s = 0.015625 * (1.-u) * (1.-v) * (1.+w) * (1.+u) * (1.-v) * (1.+w) ; break ; case 10 : *s = 0.015625 * (1.-u) * (1.-v) * (1.+w) * (1.-u) * (1.+v) * (1.+w) ; break ; case 11 : *s = 0.015625 * (1.+u) * (1.-v) * (1.+w) * (1.+u) * (1.+v) * (1.+w) ; break ; case 12 : *s = 0.015625 * (1.+u) * (1.+v) * (1.+w) * (1.-u) * (1.+v) * (1.+w) ; break ; default : WrongNumEntity ; } break ; case PRISM : // FIXME: not tested! switch(NumEntity) { case 1 : *s = 0.25 * (1.-u-v) * (1.-w) * u * (1.-w) ; break ; case 2 : *s = 0.25 * (1.-u-v) * (1.-w) * v * (1.-w) ; break ; case 3 : *s = 0.25 * (1.-u-v) * (1.-w) * (1.-u-v) * (1.+w) ; break ; case 4 : *s = 0.25 * u * (1.-w) * v * (1.-w) ; break ; case 5 : *s = 0.25 * u * (1.-w) * u * (1.+w) ; break ; case 6 : *s = 0.25 * v * (1.-w) * v * (1.+w) ; break ; case 7 : *s = 0.25 * (1.-u-v) * (1.+w) * u * (1.+w) ; break ; case 8 : *s = 0.25 * (1.-u-v) * (1.+w) * v * (1.+w) ; break ; case 9 : *s = 0.25 * u * (1.+w) * v * (1.+w) ; break ; default : WrongNumEntity ; } break ; case PYRAMID : switch(NumEntity) { default : Message::Error("BF_Node_2E not ready for PYRAMID"); } break ; default : Message::Error("Unknown type of Element in BF_Node_2E"); break ; } } #undef WrongNumEntity /* -------- */ /* Facets */ /* -------- */ #define WrongNumEntity Message::Error("Wrong Face number in 'BF_Node_2F'") void BF_Node_2F(struct Element * Element, int NumEntity, double u, double v, double w, double *s) { switch (Element->Type) { case LINE : case TRIANGLE : case TETRAHEDRON : Message::Error("BF_Node_2F cannot be associated with this type of element"); break; case QUADRANGLE : *s = 0.0625 * (1.-u) * (1.-v) * (1.+u) * (1.+v) ; break ; case HEXAHEDRON : switch(NumEntity) { case 1 : *s = 0.015625 * (1.-u) * (1.-v) * (1.-w) * (1.+u) * (1.-v) * (1.+w) ; break ; case 2 : *s = 0.015625 * (1.-u) * (1.-v) * (1.-w) * (1.+u) * (1.+v) * (1.-w) ; break ; case 3 : *s = 0.015625 * (1.-u) * (1.-v) * (1.-w) * (1.-u) * (1.+v) * (1.+w) ; break ; case 4 : *s = 0.015625 * (1.+u) * (1.-v) * (1.-w) * (1.+u) * (1.+v) * (1.+w) ; break ; case 5 : *s = 0.015625 * (1.+u) * (1.+v) * (1.-w) * (1.-u) * (1.+v) * (1.+w) ; break ; case 6 : *s = 0.015625 * (1.-u) * (1.-v) * (1.+w) * (1.+u) * (1.+v) * (1.+w) ; break ; default : WrongNumEntity ; } break ; case PRISM : switch(NumEntity) { default : Message::Error("BF_Node_2F not ready for PRISM"); // cannot do this yet in getdp, as dofs should only be // associated with quad-faces: if really necessary we could // implement actual 15 and 18-node prisms /* case 1 : *s = 0.25 * (1.-u-v) * (1.-w) * u * (1.+w) ; break ; case 3 : *s = 0.25 * (1.-u-v) * (1.-w) * v * (1.+w) ; break ; case 4 : *s = 0.25 * u * (1.-w) * v * (1.+w) ; break ; default : WrongNumEntity ; */ } break ; case PYRAMID : switch(NumEntity) { default : Message::Error("BF_Node_2F not ready for PYRAMID"); } break ; default : Message::Error("Unknown Element Type in BF_Node_2F"); break ; } } #undef WrongNumEntity /* -------- */ /* Volume */ /* -------- */ void BF_Node_2V(struct Element * Element, int NumEntity, double u, double v, double w, double *s) { switch (Element->Type) { case LINE : case TRIANGLE : case QUADRANGLE : case TETRAHEDRON : case PRISM : case PYRAMID : Message::Error("BF_Node_2V cannot be associated with this type of element"); break; case HEXAHEDRON : *s = 0.015625 * (1.-u) * (1.-v) * (1.-w) * (1.+u) * (1.+v) * (1.+w) ; break ; default : Message::Error("Unknown type of Element in BF_Node_2V"); break ; } } /* ------------------------------------------------------------------------ */ /* B F _ G r a d N o d e _ 2 */ /* ------------------------------------------------------------------------ */ /* ------- */ /* Edges */ /* ------- */ #define WrongNumEntity Message::Error("Wrong Edge number in 'BF_GradNode_2E'") void BF_GradNode_2E(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { switch (Element->Type) { case LINE : switch(NumEntity) { case 1 : s[0] = -0.5*u ; s[1] = 0. ; s[2] = 0. ; break ; default : WrongNumEntity ; } break ; case TRIANGLE : switch(NumEntity) { case 1 : s[0] = 1.-2.*u-v ; s[1] = -u ; s[2] = 0. ; break ; case 2 : s[0] = -v ; s[1] = 1.-u-2.*v ; s[2] = 0. ; break ; case 3 : s[0] = v ; s[1] = u ; s[2] = 0. ; break ; default : WrongNumEntity ; } break ; case QUADRANGLE : switch(NumEntity) { case 1 : s[0] = 0.0625 * (-2.*u) * (1.-v)*(1.-v) ; s[1] = 0.0625 * (1.-u*u) * (-2.)*(1.-v) ; s[2] = 0. ; break ; case 2 : s[0] = 0.0625 * (-2.)*(1.-u) * (1.-v*v) ; s[1] = 0.0625 * (1.-u)*(1.-u) * (-2.*v) ; s[2] = 0. ; break ; case 3 : s[0] = 0.0625 * (2.)*(1.+u) * (1.-v*v) ; s[1] = 0.0625 * (1.+u)*(1.+u) * (-2.*v) ; s[2] = 0. ; break ; case 4 : s[0] = 0.0625 * (-2.*u) * (1.+v)*(1.+v) ; s[1] = 0.0625 * (1.-u*u) * (2.)*(1.+v) ; s[2] = 0. ; break ; default : WrongNumEntity; } break ; case TETRAHEDRON : switch(NumEntity) { case 1 : s[0] = 1.-2.*u-v-w ; s[1] = -u ; s[2] = -u ; break ; case 2 : s[0] = -v ; s[1] = 1.-u-2.*v-w ; s[2] = -v ; break ; case 3 : s[0] = -w ; s[1] = -w ; s[2] = 1.-u-v-2.*w ; break ; case 4 : s[0] = v ; s[1] = u ; s[2] = 0. ; break ; case 5 : s[0] = w ; s[1] = 0. ; s[2] = u ; break ; case 6 : s[0] = 0. ; s[1] = w ; s[2] = v ; break ; default : WrongNumEntity ; } break ; case HEXAHEDRON : switch(NumEntity) { case 1 : s[0] = 0.015625 * (-2.*u) * (1.-v) * (1.-w) * (1.-v) * (1.-w) ; s[1] = 0.015625 * (1.-u) * (-2.)*(1.-v) * (1.-w) * (1.+u) * (1.-w) ; s[2] = 0.015625 * (1.-u) * (1.-v) * (-2.)*(1.-w) * (1.+u) * (1.-v) ; break ; case 2 : s[0] = 0.015625 * (-2.)*(1.-u) * (1.-v) * (1.-w) * (1.+v) * (1.-w) ; s[1] = 0.015625 * (1.-u) * (-2.*v) * (1.-w) * (1.-u) * (1.-w) ; s[2] = 0.015625 * (1.-u) * (1.-v) * (-2.)*(1.-w) * (1.-u) * (1.+v) ; break ; case 3 : s[0] = 0.015625 * (-2.)*(1.-u) * (1.-v) * (1.-w) * (1.-v) * (1.+w) ; s[1] = 0.015625 * (1.-u) * (-2.)*(1.-v) * (1.-w) * (1.-u) * (1.+w) ; s[2] = 0.015625 * (1.-u) * (1.-v) * (-2.*w) * (1.-u) * (1.-v) ; break ; case 4 : s[0] = 0.015625 * 2.*(1.+u) * (1.-v) * (1.-w) * (1.+v) * (1.-w) ; s[1] = 0.015625 * (1.+u) * (-2.*v) * (1.-w) * (1.+u) * (1.-w) ; s[2] = 0.015625 * (1.+u) * (1.-v) * (-2.)*(1.-w) * (1.+u) * (1.+v) ; break ; case 5 : s[0] = 0.015625 * 2.*(1.+u) * (1.-v) * (1.-w) * (1.-v) * (1.+w) ; s[1] = 0.015625 * (1.+u) * (-2.)*(1.-v) * (1.-w) * (1.+u) * (1.+w) ; s[2] = 0.015625 * (1.+u) * (1.-v) * (-2.*w) * (1.+u) * (1.-v) ; break ; case 6 : s[0] = 0.015625 * (-2.*u) * (1.+v) * (1.-w) * (1.+v) * (1.-w) ; s[1] = 0.015625 * (1.+u) * 2.*(1.+v) * (1.-w) * (1.-u) * (1.-w) ; s[2] = 0.015625 * (1.+u) * (1.+v) * (-2.)*(1.-w) * (1.-u) * (1.+v) ; break ; case 7 : s[0] = 0.015625 * 2.*(1.+u) * (1.+v) * (1.-w) * (1.+v) * (1.+w) ; s[1] = 0.015625 * (1.+u) * 2.*(1.+v) * (1.-w) * (1.+u) * (1.+w) ; s[2] = 0.015625 * (1.+u) * (1.+v) * (-2.*w) * (1.+u) * (1.+v) ; break ; case 8 : s[0] = 0.015625 * (-2.)*(1.-u) * (1.+v) * (1.-w) * (1.+v) * (1.+w) ; s[1] = 0.015625 * (1.-u) * 2.*(1.+v) * (1.-w) * (1.-u) * (1.+w) ; s[2] = 0.015625 * (1.-u) * (1.+v) * (-2.*w) * (1.-u) * (1.+v) ; break ; case 9 : s[0] = 0.015625 * (-2.*u) * (1.-v) * (1.+w) * (1.-v) * (1.+w) ; s[1] = 0.015625 * (1.-u) * (-2.)*(1.-v) * (1.+w) * (1.+u) * (1.+w) ; s[2] = 0.015625 * (1.-u) * (1.-v) * 2.*(1.+w) * (1.+u) * (1.-v) ; break ; case 10 : s[0] = 0.015625 * (-2.)*(1.-u) * (1.-v) * (1.+w) * (1.+v) * (1.+w) ; s[1] = 0.015625 * (1.-u) * (-2.*v) * (1.+w) * (1.-u) * (1.+w) ; s[2] = 0.015625 * (1.-u) * (1.-v) * 2.*(1.+w) * (1.-u) * (1.+v) ; break ; case 11 : s[0] = 0.015625 * 2.*(1.+u) * (1.-v) * (1.+w) * (1.+v) * (1.+w) ; s[1] = 0.015625 * (1.+u) * (-2.*v) * (1.+w) * (1.+u) * (1.+w) ; s[2] = 0.015625 * (1.+u) * (1.-v) * 2.*(1.+w) * (1.+u) * (1.+v) ; break ; case 12 : s[0] = 0.015625 * (-2.*u) * (1.+v) * (1.+w) * (1.+v) * (1.+w) ; s[1] = 0.015625 * (1.+u) * 2.*(1.+v) * (1.+w) * (1.-u) * (1.+w) ; s[2] = 0.015625 * (1.+u) * (1.+v) * 2.*(1.+w) * (1.-u) * (1.+v) ; break ; default : WrongNumEntity ; } break ; case PRISM : // FIXME: not tested! switch(NumEntity) { case 1 : s[0] = 0.25 * (1.-2.*u-v) * (1.-w) * (1.-w) ; s[1] = 0.25 * (-u) * (1.-w) * (1.-w) ; s[2] = 0.25 * (u-u*u-v*u) * (-2.)*(1.-w) ; break ; case 2 : s[0] = 0.25 * (-v) * (1.-w) * (1.-w) ; s[1] = 0.25 * (1-u-2*v) * (1.-w) * (1.-w) ; s[2] = 0.25 * (v-u*v-v*v) * (-2.) * (1.-w) ; break ; case 3 : s[0] = 0.25 * (-2. + 2.*u + 2.*v) * (1.-w) * (1.+w) ; s[1] = 0.25 * (-2. + 2.*u + 2.*v) * (1.-w) * (1.+w) ; s[2] = 0.25 * (1.- 2.*u - 2.*v + u*u + 2.*u*v + v*v) * (-2.*w) ; break ; case 4 : s[0] = 0.25 * (1.-w) * v * (1.-w) ; s[1] = 0.25 * u * (1.-w) * (1.-w) ; s[2] = 0.25 * u * (-2.) * (1.-w) * v ; break ; case 5 : s[0] = 0.25 * 2.*u * (1.-w) * (1.+w) ; s[1] = 0. ; s[2] = 0.25 * u*u * (-2.*w) ; break ; case 6 : s[0] = 0. ; s[1] = 0.25 * 2.*v * (1.-w) * (1.+w) ; s[2] = 0.25 * v*v * (-2.*w) ; break ; case 7 : s[0] = 0.25 * (1.-2.*u-v) * (1.+w) * (1.+w) ; s[1] = 0.25 * (-u) * (1.+w) * (1.+w) ; s[2] = 0.25 * (u-u*u-u*v) * 2.*(1.+w) ; break ; case 8 : s[0] = 0.25 * (-v) * (1.+w) * (1.+w) ; s[1] = 0.25 * (1.-u-2.*v) * (1.+w) * (1.+w) ; s[2] = 0.25 * (v-u*v-v*v) * 2.*(1.+w) ; break ; case 9 : s[0] = 0.25 * (1.+w) * v * (1.+w) ; s[1] = 0.25 * u * (1.+w) * (1.+w) ; s[2] = 0.25 * u * 2.*(1.+w) * v ; break ; default : WrongNumEntity ; } break ; case PYRAMID : switch(NumEntity) { default : Message::Error("BF_GradNode_2E not ready for PYRAMID"); } break ; default : Message::Error("Unknown type of Element in BF_GradNode_2E"); break ; } } #undef WrongNumEntity /* -------- */ /* Facets */ /* -------- */ #define WrongNumEntity Message::Error("Wrong Face number in 'BF_GradNode_2F'") void BF_GradNode_2F(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { switch (Element->Type) { case LINE : case TRIANGLE : case TETRAHEDRON : Message::Error("BF_GradNode_2F cannot be associated with this type of element"); break; case QUADRANGLE : s[0] = 0.0625 * (-2.*u) * (1.-v) * (1.+v) ; s[1] = 0.0625 * (1.-u) * (-2.*v) * (1.+u) ; s[2] = 0. ; break ; case HEXAHEDRON : switch(NumEntity) { case 1 : s[0] = 0.015625 * (-2.*u) * (1.-v) * (1.-w) * (1.-v) * (1.+w) ; s[1] = 0.015625 * (1.-u) * (-2.)*(1.-v) * (1.-w) * (1.+u) * (1.+w) ; s[2] = 0.015625 * (1.-u) * (1.-v) * (-2.*w) * (1.+u) * (1.-v) ; break ; case 2 : s[0] = 0.015625 * (-2.*u) * (1.-v) * (1.-w) * (1.+v) * (1.-w) ; s[1] = 0.015625 * (1.-u) * (-2.*v) * (1.-w) * (1.+u) * (1.-w) ; s[2] = 0.015625 * (1.-u) * (1.-v) * (-2.)*(1.-w) * (1.+u) * (1.+v) ; break; case 3 : s[0] = 0.015625 * (-2.)*(1.-u) * (1.-v) * (1.-w) * (1.+v) * (1.+w) ; s[1] = 0.015625 * (1.-u) * (-2.*v) * (1.-w) * (1.-u) * (1.+w) ; s[2] = 0.015625 * (1.-u) * (1.-v) * (-2.*w) * (1.-u) * (1.+v) ; break; case 4 : s[0] = 0.015625 * 2.*(1.+u) * (1.-v) * (1.-w) * (1.+v) * (1.+w) ; s[1] = 0.015625 * (1.+u) * (-2.*v) * (1.-w) * (1.+u) * (1.+w) ; s[2] = 0.015625 * (1.+u) * (1.-v) * (-2.*w) * (1.+u) * (1.+v) ; break; case 5 : s[0] = 0.015625 * (-2.*u) * (1.+v) * (1.-w) * (1.+v) * (1.+w) ; s[1] = 0.015625 * (1.+u) * 2.*(1.+v) * (1.-w) * (1.-u) * (1.+w) ; s[2] = 0.015625 * (1.+u) * (1.+v) * (-2.*w) * (1.-u) * (1.+v) ; break; case 6 : s[0] = 0.015625 * (-2.*u) * (1.-v) * (1.+w) * (1.+v) * (1.+w) ; s[1] = 0.015625 * (1.-u) * (-2.*v) * (1.+w) * (1.+u) * (1.+w) ; s[2] = 0.015625 * (1.-u) * (1.-v) * 2.*(1.+w) * (1.+u) * (1.+v) ; break; default : WrongNumEntity ; } break ; case PRISM : switch(NumEntity) { default : Message::Error("BF_GradNode_2F not ready for PRISM"); // cannot do this yet in getdp, as dofs should only be // associated with quad-faces: if really necessary we could // implement actual 15 and 18-node prisms /* case 1 : s[0] = 0.25 * (1.-2.*u-v) * (1.-w) * (1.+w) ; s[1] = 0.25 * (-u) * (1.-w) * (1.+w); s[2] = 0.25 * (u-u*u-u*v) * (-2.*w); break ; case 3 : s[0] = 0.25 * (-v) * (1.-w) * (1.+w) ; s[1] = 0.25 * (1.-u-2.*v) * (1.-w) * (1.+w) ; s[2] = 0.25 * (v-u*v-v*v) * (-2.*w) ; break; case 4 : s[0] = 0.25 * (1.-w) * v * (1.+w) ; s[1] = 0.25 * u * (1.-w) * (1.+w) ; s[2] = 0.25 * u * (-2.*w) * v ; break; */ } break ; case PYRAMID : switch(NumEntity) { default : Message::Error("BF_GradNode_2F not ready for PYRAMID"); } break ; default : Message::Error("Unknown type of Element in BF_GradNode_2F"); break ; } } #undef WrongNumEntity /* -------- */ /* Volume */ /* -------- */ void BF_GradNode_2V(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { switch (Element->Type) { case LINE : case TRIANGLE : case QUADRANGLE : case TETRAHEDRON : case PRISM : case PYRAMID : Message::Error("BF_GradNode_2V cannot be associated with this type of element"); break; case HEXAHEDRON : s[0] = 0.015625 * (-2.*u) * (1.-v) * (1.-w) * (1.+v) * (1.+w) ; s[1] = 0.015625 * (1.-u) * (-2.*v) * (1.-w) * (1.+u) * (1.+w) ; s[2] = 0.015625 * (1.-u) * (1.-v) * (-2.*w) * (1.+u) * (1.+v) ; break ; default : Message::Error("Unknown type of Element in BF_GradNode_2V"); break ; } } getdp-2.7.0-source/Legacy/MovingBand2D.cpp000644 001750 001750 00000032737 12473553042 021744 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Johan Gyselinck // #include #include "ProData.h" #include "ExtendedGroup.h" #include "GeoData.h" #include "ListUtils.h" #include "TreeUtils.h" #include "MallocUtils.h" #include "Message.h" #include "Pos_Search.h" #define SQU(a) ((a)*(a)) extern struct CurrentData Current ; /* ------------------------------------------------------------------------ */ /* M o v i n g B a n d 2 D */ /* ------------------------------------------------------------------------ */ struct ThreeInt { int Int1, Int2, Int3 ; } ; int fcmp_int3(const void * a, const void * b) { return ((struct ThreeInt *)a)->Int1 - ((struct ThreeInt *)b)->Int1 ; } int fcmp_int32(const void * a, const void * b) { return ((struct ThreeInt *)a)->Int2 - ((struct ThreeInt *)b)->Int2 ; } void Contour_MovingBand2D(List_T * InitialList, List_T ** ExtendedList, int * NbrNodes, int ** NumNodes) { Tree_T * Element_Tr ; struct Geo_Element * GeoElement ; struct ThreeInt *ThreeInt, ThreeInt1 ; int *Nodes, LeftNode, RightNode, LeftInt, RightInt, i_El, i ; Element_Tr = Tree_Create(sizeof(struct ThreeInt), fcmp_int3) ; for (i_El = 0 ; i_El < Geo_GetNbrGeoElements() ; i_El++) { GeoElement = Geo_GetGeoElement(i_El) ; if (List_Search(InitialList, &GeoElement->Region, fcmp_int)) { if (GeoElement->Type != LINE) Message::Error("MovingBand2D contour must contain only line elements") ; ThreeInt1.Int1 = i_El; ThreeInt1.Int2 = 0; ThreeInt1.Int3 = 0; Tree_Add(Element_Tr, &ThreeInt1) ; } } *ExtendedList = Tree2List(Element_Tr) ; Tree_Delete(Element_Tr) ; ThreeInt = (struct ThreeInt *)List_Pointer(*ExtendedList, 0) ; Nodes = Geo_GetGeoElement(ThreeInt->Int1)->NumNodes ; RightNode = Nodes[1] ; RightInt = 0 ; LeftNode = Nodes[0] ; LeftInt = 0 ; ThreeInt->Int2 = 0 ; ThreeInt->Int3 = 1 ; for (i = 1 ; i < List_Nbr(*ExtendedList) ; i++) { for (i_El = 1 ; i_El < List_Nbr(*ExtendedList) ; i_El++) { if ( ((ThreeInt = (struct ThreeInt *)List_Pointer(*ExtendedList, i_El))->Int3) == 0) { Nodes = Geo_GetGeoElement(ThreeInt->Int1)->NumNodes; if (Nodes[0] == RightNode) { ThreeInt->Int2 = ++RightInt ; ThreeInt->Int3 = 1 ; RightNode = Nodes[1] ; } else if (Nodes[1] == RightNode) { ThreeInt->Int2 = ++RightInt ; ThreeInt->Int3 = -1 ; RightNode = Nodes[0] ; } else if (Nodes[0] == LeftNode) { ThreeInt->Int2 = --LeftInt ; ThreeInt->Int3 = -1 ; LeftNode = Nodes[1] ; } else if (Nodes[1] == LeftNode) { ThreeInt->Int2 = --LeftInt ; ThreeInt->Int3 = 1 ; LeftNode = Nodes[0] ; } if (ThreeInt->Int3) break; } } if (!ThreeInt->Int3) Message::Error("Moving Band contour is not connected") ; } List_Sort(*ExtendedList, fcmp_int32) ; *NbrNodes = List_Nbr(*ExtendedList)+1 ; *NumNodes = (int *)Malloc(*NbrNodes*sizeof(int)) ; ThreeInt = (struct ThreeInt *)List_Pointer(*ExtendedList, 0) ; if (ThreeInt->Int3 == 1) { (*NumNodes)[0] = (Geo_GetGeoElement(ThreeInt->Int1)->NumNodes)[0]; (*NumNodes)[1] = (Geo_GetGeoElement(ThreeInt->Int1)->NumNodes)[1]; } else { (*NumNodes)[0] = (Geo_GetGeoElement(ThreeInt->Int1)->NumNodes)[1]; (*NumNodes)[1] = (Geo_GetGeoElement(ThreeInt->Int1)->NumNodes)[0]; } for (i_El = 1 ; i_El < List_Nbr(*ExtendedList) ; i_El++) { ThreeInt = (struct ThreeInt *)List_Pointer(*ExtendedList, i_El) ; if (ThreeInt->Int3 == 1) (*NumNodes)[i_El+1] = (Geo_GetGeoElement(ThreeInt->Int1)->NumNodes)[1]; else (*NumNodes)[i_El+1] = (Geo_GetGeoElement(ThreeInt->Int1)->NumNodes)[0]; } } void Init_MovingBand2D (struct Group * Group_P) { struct MovingBand2D * MB ; int i ; int Different_Sense_MB2D(int nth1, int nth2, int ntr1, int ntr2, int closed1, int closed2, double x1[], double y1[], double x2[], double y2[]) ; MB = Group_P->MovingBand2D ; if (MB->ExtendedList1 && MB->ExtendedList2) { Message::Warning("Init_MovingBand has already been done!: Skipping") ; return ; } Contour_MovingBand2D(MB->InitialList1, &MB->ExtendedList1, &MB->NbrNodes1, &MB->NumNodes1) ; Contour_MovingBand2D(MB->InitialList2, &MB->ExtendedList2, &MB->NbrNodes2, &MB->NumNodes2) ; MB->x1 = (double *)Malloc(MB->NbrNodes1*sizeof(double)) ; MB->y1 = (double *)Malloc(MB->NbrNodes1*sizeof(double)) ; MB->z1 = (double *)Malloc(MB->NbrNodes1*sizeof(double)) ; MB->x2 = (double *)Malloc(MB->NbrNodes2*sizeof(double)) ; MB->y2 = (double *)Malloc(MB->NbrNodes2*sizeof(double)) ; MB->z2 = (double *)Malloc(MB->NbrNodes2*sizeof(double)) ; MB->Closed1 = MB->Closed2 = 0 ; if (MB->NumNodes1[0] == MB->NumNodes1[MB->NbrNodes1-1]) MB->Closed1 = 1 ; if (MB->NumNodes2[0] == MB->NumNodes2[MB->NbrNodes2-1]) MB->Closed2 = 1 ; MB->ntr1 = MB->NbrNodes1-1 ; MB->ntr2 = MB->NbrNodes2-1 ; if (MB->Period2 != 1) { if ((MB->NbrNodes2-1)%MB->Period2 != 0.) Message::Warning("Strange periodicity stuff (%d %d)! Do you know what you're doing?", MB->NbrNodes2-1, MB->Period2); MB->ntr2 = (MB->NbrNodes2-1)/MB->Period2; Message::Info("Periodicity data (%d %d %d %d)", MB->ntr1, MB->NbrNodes2-1, MB->Period2, MB->ntr2); } Geo_GetNodesCoordinates (MB->NbrNodes1, MB->NumNodes1, MB->x1, MB->y1, MB->z1) ; Geo_GetNodesCoordinates (MB->NbrNodes2, MB->NumNodes2, MB->x2, MB->y2, MB->z2) ; if (Different_Sense_MB2D(MB->NbrNodes1, MB->NbrNodes2, MB->ntr1, MB->ntr2, MB->Closed1, MB->Closed2, MB->x1, MB->y1, MB->x2, MB->y2) ) { Message::Debug("Contours have a different sense: inverting!"); for (i=0 ; iNbrNodes2/2 ; i++) { int dummy = MB->NumNodes2[i]; MB->NumNodes2[i] = MB->NumNodes2[MB->NbrNodes2-1-i]; MB->NumNodes2[MB->NbrNodes2-1-i] = dummy; } } Message::Debug("Moving Band Contour 1 has %d nodes :", MB->NbrNodes1); for (i=0 ; iNbrNodes1 ; i++) Message::Debug(" %d ", MB->NumNodes1[i]); if (MB->Closed1) Message::Debug(" (closed)"); else Message::Debug(" (open)"); Message::Debug("Moving Band Contour 2 has %d nodes :", MB->NbrNodes2); for (i=0 ; iNbrNodes2 ; i++) Message::Debug(" %d ", MB->NumNodes2[i]); if (MB->Closed2) Message::Debug(" (closed, "); else Message::Debug(" (open, "); Message::Debug("periodicity 1/%d, ", MB->Period2); MB->b1_p1 = (int *)Malloc((MB->NbrNodes1-1)*sizeof(int)) ; MB->b1_p2 = (int *)Malloc((MB->NbrNodes1-1)*sizeof(int)) ; MB->b1_p3 = (int *)Malloc((MB->NbrNodes1-1)*sizeof(int)) ; MB->b2_p1 = (int *)Malloc((MB->NbrNodes2-1)*sizeof(int)) ; MB->b2_p2 = (int *)Malloc((MB->NbrNodes2-1)*sizeof(int)) ; MB->b2_p3 = (int *)Malloc((MB->NbrNodes2-1)*sizeof(int)) ; MB->StartIndexTr = Geo_GetNbrGeoElements() ; MB->StartNumTr = Geo_GetGeoElement(0)->Num ; for (i=1 ; iStartIndexTr ; i++) if (MB->StartNumTr < Geo_GetGeoElement(i)->Num) MB->StartNumTr = Geo_GetGeoElement(i)->Num ; (MB->StartNumTr)++; Message::Debug("StartNumTr %d StartIndexTr %d", MB->StartNumTr, MB->StartIndexTr); } int Different_Sense_MB2D(int nth1, int nth2, int ntr1, int ntr2, int closed1, int closed2, double x1[], double y1[], double x2[], double y2[]){ double xm = (x1[0]+x1[1])/2.; double ym = (y1[0]+y1[1])/2.; int imindist = 0; double mindist2 = SQU(xm-x2[0]) + SQU(ym-y2[0]); for (int i = 1 ; i < nth2 ; i++ ){ double dist2 = SQU(xm-x2[i]) + SQU(ym-y2[i]) ; if (dist2 < mindist2) { imindist = i; mindist2 = dist2; } } int itry2 = (closed2==1) ? ((imindist+1) % (nth2-1)) : std::min(imindist+1, nth2) ; int itry4 = (closed2==1) ? ((imindist-1+nth2-1) % (nth2-1)) : std::max(imindist-1,0) ; double dist1 = SQU(x1[2]-x2[itry2]) + SQU(y1[2]-y2[itry2]); double dist2 = SQU(x1[2]-x2[itry4]) + SQU(y1[2]-y2[itry4]); return( (dist1 < dist2) ? 0. : 1.) ; } void Mesh_MB2D(int nth1, int nth2, int ntr1, int ntr2, int closed1, int closed2, double x1[], double y1[], double x2[], double y2[], double * area_moving_band, int b1_p1[], int b1_p2[], int b1_p3[], int b2_p1[], int b2_p2[], int b2_p3[]) { double area_tr1,area_tr2; int Delauny_1234_MB(double, double, double, double, double, double, double, double, double *, double * ); double xm = (x1[0]+x1[1])/2.; double ym = (y1[0]+y1[1])/2.; int imindist = 0; double mindist2 = SQU(xm-x2[0]) + SQU(ym-y2[0]); for (int i = 1 ; i < nth2 ; i++ ){ double dist2 = SQU(xm-x2[i]) + SQU(ym-y2[i]) ; if (dist2 < mindist2) { imindist = i; mindist2 = dist2; } } int itry2 = (closed2==1) ? ((imindist+1) % (nth2-1)) : std::min(imindist+1, nth2) ; int itry4 = (closed2==1) ? ((imindist-1+nth2-1) % (nth2-1)) : std::max(imindist-1,0) ; double dist1 = SQU(x1[2]-x2[itry2]) + SQU(y1[2]-y2[itry2]); double dist2 = SQU(x1[2]-x2[itry4]) + SQU(y1[2]-y2[itry4]); int d2 = (dist1 < dist2) ? 1 : -1 ; Message::Debug("+++++++++++++++++++++++++++++++++++++++++++++++++ %d",d2); *area_moving_band = fabs( (x2[imindist]-x1[0])*(y1[1]-y1[0])-(x1[1]-x1[0])*(y2[imindist]-y1[0]) )/2. ; int itry1 = 1 ; int itry3 = 2 ; itry2 = imindist ; itry4 = (closed2==1) ? ((imindist + d2) % (nth2-1)) : imindist + d2 ; int n1 = 0; int n2 = 0; b1_p1[n1] = 0; b1_p2[n1] = 1; b1_p3[n1] = itry2; n1++; for (int i = 1 ; i < ntr1 + ntr2 ; i++ ){ if ( (Delauny_1234_MB (x1[itry1], y1[itry1], x2[itry2], y2[itry2], x1[itry3], y1[itry3], x2[itry4], y2[itry4], &area_tr1, &area_tr2) == 1) && itry1 < nth1 && itry1 ){ b1_p1[n1] = itry1; b1_p2[n1] = itry3; b1_p3[n1] = itry2; itry1++; itry3++; if (closed1) {itry1 = itry1 % (nth1-1); itry3 = itry3 % (nth1-1) ;} *area_moving_band += area_tr1; n1++; } else{ b2_p1[n2] = itry2; b2_p2[n2] = itry4; b2_p3[n2] = itry1; itry2+=d2; itry4+=d2; if (closed2) { itry2 = (nth2-1+itry2) % (nth2-1); itry4 = (nth2-1+itry4) % (nth2-1) ; } *area_moving_band += area_tr2; n2++; } } if(n1 != ntr1 || n2 != ntr2){ Message::Error("Meshing of 2D Moving Band failed (%d != %d || %d != %d)", n1, ntr1, n2, ntr2); } } void Mesh_MovingBand2D (struct Group * Group_P) { struct MovingBand2D * MB ; struct Geo_Element Geo_Element ; struct GeoData * GeoData ; int *n ; int *NumNodes1, *NumNodes2; int *b1_p1, *b1_p2, *b1_p3, *b2_p1, *b2_p2, *b2_p3; MB = Group_P->MovingBand2D ; if (!MB->ExtendedList1 || !MB->ExtendedList2) Init_MovingBand2D(Group_P) ; NumNodes1 = MB->NumNodes1; NumNodes2 = MB->NumNodes2; b1_p1 = MB->b1_p1; b1_p2 = MB->b1_p2; b1_p3 = MB->b1_p3; b2_p1 = MB->b2_p1; b2_p2 = MB->b2_p2; b2_p3 = MB->b2_p3; Geo_GetNodesCoordinates (MB->NbrNodes1, NumNodes1, MB->x1, MB->y1, MB->z1) ; Geo_GetNodesCoordinates (MB->NbrNodes2, NumNodes2, MB->x2, MB->y2, MB->z2) ; Mesh_MB2D(MB->NbrNodes1, MB->NbrNodes2, MB->ntr1, MB->ntr2, MB->Closed1, MB->Closed2, MB->x1, MB->y1, MB->x2, MB->y2, &MB->Area, b1_p1, b1_p2, b1_p3, b2_p1, b2_p2, b2_p3); GeoData = Current.GeoData ; Geo_Element.NbrEdges = Geo_Element.NbrFacets = 0 ; Geo_Element.NumEdges = Geo_Element.NumFacets = NULL ; Geo_Element.Region = MB->PhysNum ; Geo_Element.NbrNodes = 3 ; Geo_Element.Type = TRIANGLE ; int NbrGeo = Geo_GetNbrGeoElements(); for (int i = 0 ; i < MB->ntr1 ; i++){ int index = MB->StartIndexTr+i ; if (index < NbrGeo) { n = (int *)(((struct Geo_Element *)List_Pointer(GeoData->Elements, index))->NumNodes) ; n[0] = NumNodes1[b1_p1[i]] ; n[1] = NumNodes1[b1_p2[i]] ; n[2] = NumNodes2[b1_p3[i]] ; } else { Geo_Element.Num = MB->StartNumTr + i ; Geo_Element.NumNodes = n = (int *)Malloc(3 * sizeof(int)) ; n[0] = NumNodes1[b1_p1[i]] ; n[1] = NumNodes1[b1_p2[i]] ; n[2] = NumNodes2[b1_p3[i]] ; List_Put(GeoData->Elements, index, &Geo_Element) ; } // printf("Tr1 %d : %d %d %d \n",MB->StartNumTr+i, n[0], n[1], n[2]); } for (int i = 0 ; i < MB->ntr2 ; i++){ Geo_Element.Num = MB->StartNumTr + MB->ntr1 +i ; int index = MB->StartIndexTr+MB->ntr1+i ; if (index < NbrGeo) { n = (int *)(((struct Geo_Element *)List_Pointer(GeoData->Elements, index))->NumNodes) ; n[0] = NumNodes2[b2_p1[i]] ; n[1] = NumNodes2[b2_p2[i]] ; n[2] = NumNodes1[b2_p3[i]] ; } else { Geo_Element.Num = MB->StartNumTr + MB->ntr1 + i ; Geo_Element.NumNodes = n = (int *)Malloc(3 * sizeof(int)) ; n[0] = NumNodes2[b2_p1[i]] ; n[1] = NumNodes2[b2_p2[i]] ; n[2] = NumNodes1[b2_p3[i]] ; List_Put(GeoData->Elements, index, &Geo_Element) ; } Message::Debug("Tr2 %d : %d %d %d",MB->StartNumTr+MB->ntr1+i, n[0], n[1], n[2]); } Message::Debug("Moving band meshed (area = %e)", MB->Area); Free_SearchGrid(&Current.GeoData->Grid); } int Delauny_1234_MB (double x1, double y1, double x2, double y2, double x3, double y3, double x4, double y4, double * area1, double * area2) { double Det1 = (x3-x1)*(y2-y1)-(x2-x1)*(y3-y1); double Det2 = (x4-x1)*(y2-y1)-(x2-x1)*(y4-y1); if( !Det1 || !Det2 ) { Message::Error("Colinear points in Delauny_1234 (" "Det1 %g Det2 %g " "x1 %e y1 %e x2 %e y2 %e x3 %e y3 %e x4 %e y4 %e)", Det1, Det2, x1, y1, x2, y2, x3, y3, x4, y4); } double t1 = ( (x3-x1)*(x3-x2)+(y3-y1)*(y3-y2) ) / Det1 ; double t2 = ( (x4-x1)*(x4-x2)+(y4-y1)*(y4-y2) ) / Det2 ; if ( fabs(t1) < fabs(t2) ){ *area1 = fabs(Det1)/2.; return (1); } else{ *area2 = fabs(Det2)/2.; return (2); } } getdp-2.7.0-source/Legacy/GeoTree.cpp000644 001750 001750 00000016112 12473553042 021051 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "ProData.h" #include "GeoData.h" #include "TreeUtils.h" static int Tree_IndexToChange, Tree_NewIndex ; /* ------------------------------------------------------------------------ */ /* G e o _ G e n e r a t e E d g e s O f T r e e */ /* ------------------------------------------------------------------------ */ void Geo_GenerateEdgesOfTree(List_T * InitialList, List_T * InitialSuppList, List_T ** ExtendedList) { Tree_T * EntitiesInTree_T ; *ExtendedList = List_Create( 2000, 2000, sizeof(int)) ; EntitiesInTree_T = Tree_Create(2*sizeof(int), fcmp_int) ; if (InitialSuppList != NULL) Geo_GenerateEdgesOfSubTree(InitialSuppList, *ExtendedList, EntitiesInTree_T) ; if (InitialList != NULL) Geo_GenerateEdgesOfSubTree(InitialList, *ExtendedList, EntitiesInTree_T) ; Tree_Delete(EntitiesInTree_T) ; List_Sort(*ExtendedList, fcmp_int) ; } /* ------------------------------------------------------------------------ */ /* G e o _ G e n e r a t e F a c e t s O f T r e e */ /* ------------------------------------------------------------------------ */ void Geo_GenerateFacetsOfTree(List_T * InitialList, List_T * InitialSuppList, List_T ** ExtendedList) { Tree_T * EntitiesInTree_T ; *ExtendedList = List_Create( 2000, 2000, sizeof(int)) ; EntitiesInTree_T = Tree_Create(2*sizeof(int), fcmp_int) ; if (InitialSuppList != NULL) Geo_GenerateFacetsOfSubTree(InitialSuppList, *ExtendedList, EntitiesInTree_T) ; if (InitialList != NULL) Geo_GenerateFacetsOfSubTree(InitialList, *ExtendedList, EntitiesInTree_T) ; Tree_Delete(EntitiesInTree_T) ; List_Sort(*ExtendedList, fcmp_int) ; } /* ------------------------------------------------------------------------ */ /* G e o _ G e n e r a t e E d g e s O f S u b T r e e */ /* ------------------------------------------------------------------------ */ void Geo_GenerateEdgesOfSubTree(List_T * InitialList, List_T * ExtendedList, Tree_T * EntitiesInTree_T) { int Nbr_Element, i_Element, Nbr_Entities2, i, Num_Entity1 ; struct Geo_Element * Geo_Element ; int i_Entity2, Num_Entity2, * D_Element, * Entity_P, Entity, Flag_Change ; struct EntityInTree * EntitiesInTree_P[NBR_MAX_ENTITIES_IN_ELEMENT] ; struct EntityInTree EntityInTree_S ; Nbr_Element = Geo_GetNbrGeoElements() ; for (i_Element = 0 ; i_Element < Nbr_Element ; i_Element++) { Geo_Element = Geo_GetGeoElement(i_Element) ; if (List_Search(InitialList, &Geo_Element->Region, fcmp_int) ) { if (Geo_Element->NbrEdges == 0) Geo_CreateEdgesOfElement(Geo_Element) ; D_Element = Geo_GetIM_Den(Geo_Element->Type, &Nbr_Entities2) ; for (i = 0 ; i < Geo_Element->NbrNodes ; i++) { Num_Entity1 = abs(Geo_Element->NumNodes[i]) ; EntitiesInTree_P[i] = (struct EntityInTree*) Tree_PQuery(EntitiesInTree_T, &Num_Entity1) ; } for (i_Entity2 = 0 ; i_Entity2 < Geo_Element->NbrEdges ; i_Entity2++) { Entity_P = D_Element + i_Entity2 * NBR_MAX_SUBENTITIES_IN_ELEMENT ; i = 0 ; EntityInTree_S.Index = -1 ; while ((Entity = abs(Entity_P[i++])) && (EntityInTree_S.Index < 0)) if (EntitiesInTree_P[Entity-1] != NULL) EntityInTree_S.Index = EntitiesInTree_P[Entity-1]->Index ; if (EntityInTree_S.Index < 0) EntityInTree_S.Index = Geo_Element->Num ; Flag_Change = 0 ; while ((Entity = abs(*(Entity_P++)))) { if (EntitiesInTree_P[--Entity] != NULL) { if (EntitiesInTree_P[Entity]->Index != EntityInTree_S.Index) { Tree_IndexToChange = EntitiesInTree_P[Entity]->Index ; Tree_NewIndex = EntityInTree_S.Index ; Tree_Action(EntitiesInTree_T, Geo_ChangeTreeIndex) ; Flag_Change = 1 ; } } else { EntityInTree_S.Num = abs(Geo_Element->NumNodes[Entity]) ; EntitiesInTree_P[Entity] = (struct EntityInTree*) Tree_Add(EntitiesInTree_T, &EntityInTree_S) ; Flag_Change = 1 ; } } if (Flag_Change) { Num_Entity2 = abs(Geo_Element->NumEdges[i_Entity2]) ; List_Add(ExtendedList, &Num_Entity2) ; } } /* for i_Entity2 ... */ } /* if Region ... */ } /* for i_Element ... */ } /* ------------------------------------------------------------------------ */ /* G e o _ G e n e r a t e F a c e t s O f S u b T r e e */ /* ------------------------------------------------------------------------ */ void Geo_GenerateFacetsOfSubTree(List_T * InitialList, List_T * ExtendedList, Tree_T * EntitiesInTree_T) { int Nbr_Element, i_Element, Nbr_Entities2, i, Num_Entity1 ; struct Geo_Element * Geo_Element ; int i_Entity2, Num_Entity2, * D_Element, * Entity_P, Entity, Flag_Change ; struct EntityInTree * EntitiesInTree_P[NBR_MAX_ENTITIES_IN_ELEMENT] ; struct EntityInTree EntityInTree_S ; Nbr_Element = Geo_GetNbrGeoElements() ; for (i_Element = 0 ; i_Element < Nbr_Element ; i_Element++) { Geo_Element = Geo_GetGeoElement(i_Element) ; if (List_Search(InitialList, &Geo_Element->Region, fcmp_int) ) { if (Geo_Element->NbrEdges == 0) Geo_CreateEdgesOfElement(Geo_Element) ; if (Geo_Element->NbrFacets == 0) Geo_CreateFacetsOfElement(Geo_Element) ; D_Element = Geo_GetIM_Dfe(Geo_Element->Type, &Nbr_Entities2) ; for (i = 0 ; i < Geo_Element->NbrEdges ; i++) { Num_Entity1 = abs(Geo_Element->NumEdges[i]) ; EntitiesInTree_P[i] = (struct EntityInTree*) Tree_PQuery(EntitiesInTree_T, &Num_Entity1) ; } for (i_Entity2 = 0 ; i_Entity2 < Geo_Element->NbrFacets ; i_Entity2++) { Entity_P = D_Element + i_Entity2 * NBR_MAX_SUBENTITIES_IN_ELEMENT ; i = 0 ; EntityInTree_S.Index = -1 ; while ((Entity = abs(Entity_P[i++])) && (EntityInTree_S.Index < 0)) if (EntitiesInTree_P[Entity-1] != NULL) EntityInTree_S.Index = EntitiesInTree_P[Entity-1]->Index ; if (EntityInTree_S.Index < 0) EntityInTree_S.Index = Geo_Element->Num ; Flag_Change = 0 ; while ((Entity = abs(*(Entity_P++)))) { if (EntitiesInTree_P[--Entity] != NULL) { if (EntitiesInTree_P[Entity]->Index != EntityInTree_S.Index) { Tree_IndexToChange = EntitiesInTree_P[Entity]->Index ; Tree_NewIndex = EntityInTree_S.Index ; Tree_Action(EntitiesInTree_T, Geo_ChangeTreeIndex) ; Flag_Change = 1 ; } else if (Geo_Element->NbrFacets == 1) Flag_Change = 1 ; } else { EntityInTree_S.Num = abs(Geo_Element->NumEdges[Entity]) ; EntitiesInTree_P[Entity] = (struct EntityInTree*) Tree_Add(EntitiesInTree_T, &EntityInTree_S) ; Flag_Change = 1 ; } } if (Flag_Change) { Num_Entity2 = abs(Geo_Element->NumFacets[i_Entity2]) ; List_Add(ExtendedList, &Num_Entity2) ; } } /* for i_Entity2 ... */ } /* if Region ... */ } /* for i_Element ... */ } void Geo_ChangeTreeIndex(void * a, void * b) { if (((struct EntityInTree *)a)->Index == Tree_IndexToChange) ((struct EntityInTree *)a)->Index = Tree_NewIndex ; } getdp-2.7.0-source/Legacy/GF_Laplace.cpp000644 001750 001750 00000016063 12473553042 021441 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "ProData.h" #include "GF.h" #include "Message.h" #define SQU(a) ((a)*(a)) #define CUB(a) ((a)*(a)*(a)) #define ONE_OVER_TWO_PI 1.5915494309189534E-01 #define ONE_OVER_FOUR_PI 7.9577471545947668E-02 extern struct CurrentData Current ; /* ------------------------------------------------------------------------ */ /* G F _ L a p l a c e */ /* ------------------------------------------------------------------------ */ void GF_Laplace(GF_ARG) { double d; switch((int)Fct->Para[0]){ case _1D : /* r/2 */ V->Val[0] = 0.5 * sqrt(SQU(Current.x - Current.xs)) ; break; case _2D : /* 1/(2*Pi) * ln(1/r) = -1/(4*Pi)*ln(r^2) */ d = SQU(Current.x - Current.xs) + SQU(Current.y - Current.ys) ; if(!d) Message::Error("Log(0) in 'GF_Laplace'") ; V->Val[0] = - ONE_OVER_FOUR_PI * log(d) ; V->Val[MAX_DIM] = 0. ; break; case _3D : /* 1/(4*Pi*r) */ d = SQU(Current.x - Current.xs) + SQU(Current.y - Current.ys) + SQU(Current.z - Current.zs) ; if(!d) Message::Error("1/0 in 'GF_Laplace'") ; V->Val[0] = ONE_OVER_FOUR_PI / sqrt(d) ; V->Val[MAX_DIM] = 0. ; break; default : Message::Error("Bad Parameter for 'GF_Laplace' (%d)", (int)Fct->Para[0]); break; } V->Type = SCALAR ; V->Val[MAX_DIM] = 0. ; } /* ------------------------------------------------------------------------ */ /* G F _ G r a d L a p l a c e */ /* ------------------------------------------------------------------------ */ /* the gradient is taken relative to the destination point (x,y,z) */ void GF_GradLaplace(GF_ARG) { double xxs, yys, zzs, r; V->Type = VECTOR ; switch((int)Fct->Para[0]){ case _2D : xxs = Current.x-Current.xs ; yys = Current.y-Current.ys ; r = SQU(xxs) + SQU(yys) ; if(!r) Message::Error("1/0 in 'GF_GradLaplace'") ; V->Val[0] = - ONE_OVER_TWO_PI * xxs / r ; V->Val[1] = - ONE_OVER_TWO_PI * yys / r ; V->Val[2] = 0.0 ; V->Val[MAX_DIM ] = V->Val[MAX_DIM + 1] = V->Val[MAX_DIM + 2] = 0. ; break ; case _3D : xxs = Current.x-Current.xs ; yys = Current.y-Current.ys ; zzs = Current.z-Current.zs ; r = CUB(sqrt(SQU(xxs) + SQU(yys) + SQU(zzs))) ; if(!r) Message::Error("1/0 in 'GF_GradLaplace'") ; V->Val[0] = - ONE_OVER_FOUR_PI * xxs / r ; V->Val[1] = - ONE_OVER_FOUR_PI * yys / r ; V->Val[2] = - ONE_OVER_FOUR_PI * zzs / r ; V->Val[MAX_DIM ] = V->Val[MAX_DIM + 1] = V->Val[MAX_DIM + 2] = 0. ; break ; default : Message::Error("Bad Parameter for 'GF_GradLaplace' (%d)", (int)Fct->Para[0]); break; } V->Type = VECTOR ; V->Val[MAX_DIM+0] = 0. ; V->Val[MAX_DIM+1] = 0. ; V->Val[MAX_DIM+2] = 0. ; } /* ------------------------------------------------------------------------ */ /* G F _ N P x G r a d L a p l a c e */ /* ------------------------------------------------------------------------ */ void GF_NPxGradLaplace(GF_ARG) { double x1x0, x2x0, y1y0, y2y0, z1z0, z2z0, xxs, yys, zzs, a, b, c, r ; V->Type = SCALAR ; V->Val[MAX_DIM] = 0. ; if (Current.Element->Num == Current.ElementSource->Num) { V->Val[0 ] = 0. ; V->Val[MAX_DIM] = 0. ; return ; } switch((int)Fct->Para[0]){ case _2D : x1x0 = Current.Element->x[1] - Current.Element->x[0] ; y1y0 = Current.Element->y[1] - Current.Element->y[0] ; xxs = Current.x-Current.xs ; yys = Current.y-Current.ys ; r = SQU(xxs)+SQU(yys) ; if(!r) V->Val[0] = 0 ; else V->Val[0] = - ONE_OVER_TWO_PI * (y1y0 * xxs - x1x0 * yys) / (sqrt(SQU(x1x0)+SQU(y1y0)) * r) ; V->Val[MAX_DIM] = 0. ; break; case _3D : x1x0 = Current.Element->x[1] - Current.Element->x[0] ; y1y0 = Current.Element->y[1] - Current.Element->y[0] ; z1z0 = Current.Element->z[1] - Current.Element->z[0] ; x2x0 = Current.Element->x[2] - Current.Element->x[0] ; y2y0 = Current.Element->y[2] - Current.Element->y[0] ; z2z0 = Current.Element->z[2] - Current.Element->z[0] ; a = y1y0 * z2z0 - z1z0 * y2y0 ; b = z1z0 * x2x0 - x1x0 * z2z0 ; c = x1x0 * y2y0 - y1y0 * x2x0 ; xxs = Current.x-Current.xs ; yys = Current.y-Current.ys ; zzs = Current.z-Current.zs ; V->Val[0] = - ONE_OVER_FOUR_PI * (a * xxs + b * yys + c * zzs) / ( (sqrt(SQU(a) + SQU(b) + SQU(c)) * CUB(sqrt(SQU(xxs) + SQU(yys) + SQU(zzs)))) ) ; V->Val[MAX_DIM] = 0. ; break ; default : Message::Error("Bad Parameter for 'GF_NPxGradLaplace' (%d)", (int)Fct->Para[0]); break; } } /* ------------------------------------------------------------------------ */ /* G F _ N S x G r a d L a p l a c e */ /* ------------------------------------------------------------------------ */ void GF_NSxGradLaplace(GF_ARG) { double x1x0, x2x0, y1y0, y2y0, z1z0, z2z0, xxs, yys, zzs, a, b, c; V->Type = SCALAR ; V->Val[MAX_DIM] = 0. ; if (Current.Element->Num == Current.ElementSource->Num) { V->Val[0] = 0. ; V->Val[MAX_DIM] = 0. ; return ; } switch((int)Fct->Para[0]){ case _2D : x1x0 = Current.ElementSource->x[1] - Current.ElementSource->x[0] ; y1y0 = Current.ElementSource->y[1] - Current.ElementSource->y[0] ; xxs = Current.x-Current.xs ; yys = Current.y-Current.ys ; V->Val[0] = ONE_OVER_TWO_PI * (y1y0 * xxs - x1x0 * yys) / (sqrt(SQU(x1x0)+SQU(y1y0)) * (SQU(xxs)+SQU(yys)) ) ; V->Val[MAX_DIM] = 0. ; break ; case _3D : x1x0 = Current.ElementSource->x[1] - Current.ElementSource->x[0] ; y1y0 = Current.ElementSource->y[1] - Current.ElementSource->y[0] ; z1z0 = Current.ElementSource->z[1] - Current.ElementSource->z[0] ; x2x0 = Current.ElementSource->x[2] - Current.ElementSource->x[0] ; y2y0 = Current.ElementSource->y[2] - Current.ElementSource->y[0] ; z2z0 = Current.ElementSource->z[2] - Current.ElementSource->z[0] ; a = y1y0 * z2z0 - z1z0 * y2y0 ; b = z1z0 * x2x0 - x1x0 * z2z0 ; c = x1x0 * y2y0 - y1y0 * x2x0 ; xxs = Current.x-Current.xs ; yys = Current.y-Current.ys ; zzs = Current.z-Current.zs ; V->Val[0] = ONE_OVER_FOUR_PI * (a * xxs + b * yys + c * zzs) / ( (sqrt(SQU(a)+SQU(b)+SQU(c)) * CUB(sqrt(SQU(xxs)+SQU(yys)+SQU(zzs)))) ) ; V->Val[MAX_DIM] = 0. ; break ; default : Message::Error("Bad Parameter for 'GF_NSxGradLaplace' (%d)", (int)Fct->Para[0]); break; } } /* ------------------------------------------------------------------------ */ /* G F _ A p p r o x i m a t e L a p l a c e */ /* ------------------------------------------------------------------------ */ void GF_ApproximateLaplace(GF_ARG) { Message::Error("The Approximate Integral Kernels can only be Integrated Analytically"); } getdp-2.7.0-source/Legacy/Cal_AssembleTerm.h000644 001750 001750 00000003156 12473553042 022332 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _CAL_ASSEMBLE_TERM_H_ #define _CAL_ASSEMBLE_TERM_H_ #include "ProData.h" void Cal_AssembleTerm_NoDt(struct Dof * Equ, struct Dof * Dof, double Val[]); void Cal_AssembleTerm_DtDof(struct Dof * Equ, struct Dof * Dof, double Val[]); void Cal_AssembleTerm_Dt(struct Dof * Equ, struct Dof * Dof, double Val[]); void Cal_AssembleTerm_DtNL(struct Dof * Equ, struct Dof * Dof, double Val[]); void Cal_AssembleTerm_DtDtDof(struct Dof * Equ, struct Dof * Dof, double Val[]); void Cal_AssembleTerm_DtDtDtDof(struct Dof * Equ, struct Dof * Dof, double Val[]); void Cal_AssembleTerm_DtDtDtDtDof(struct Dof * Equ, struct Dof * Dof, double Val[]); void Cal_AssembleTerm_DtDtDtDtDtDof(struct Dof * Equ, struct Dof * Dof, double Val[]); void Cal_AssembleTerm_DtDt(struct Dof * Equ, struct Dof * Dof, double Val[]); void Cal_AssembleTerm_JacNL(struct Dof * Equ, struct Dof * Dof, double Val[]); void Cal_AssembleTerm_DtDofJacNL(struct Dof * Equ, struct Dof * Dof, double Val[]); void Cal_AssembleTerm_NeverDt(struct Dof * Equ, struct Dof * Dof, double Val[]); void Cal_AssembleTerm_MHMoving(struct Dof * Equ, struct Dof * Dof, double Val[]); //void Cal_AssembleTerm_MH_Moving_simple(struct Dof * Equ, struct Dof * Dof, double Val[]); //void Cal_AssembleTerm_MH_Moving_separate(struct Dof * Equ, struct Dof * Dof, double Val[]); //void Cal_AssembleTerm_MH_Moving_probe(struct Dof * Equ, struct Dof * Dof, double Val[]); #endif getdp-2.7.0-source/Legacy/EigenSolve.cpp000644 001750 001750 00000002673 12473553042 021566 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "GetDPConfig.h" #include "Message.h" #include "EigenSolve.h" #if (PETSC_VERSION_RELEASE == 0 || ((PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2))) #define PetscTruth PetscBool #define PetscOptionsGetTruth PetscOptionsGetBool #endif void EigenSolve(struct DofData * DofData_P, int NumEigenvalues, double shift_r, double shift_i, int FilterExpressionIndex) { #if defined(HAVE_ARPACK) && defined(HAVE_SLEPC) // if both Arpack and SLEPC are available, use Arpack by default // (set "-slepc" on the command line to force SLEPC) PetscTruth slepc = PETSC_FALSE, set; PetscOptionsGetTruth(PETSC_NULL, "-slepc", &slepc, &set); if(slepc) EigenSolve_SLEPC(DofData_P, NumEigenvalues, shift_r, shift_i, FilterExpressionIndex); else EigenSolve_ARPACK(DofData_P, NumEigenvalues, shift_r, shift_i, FilterExpressionIndex); #elif defined(HAVE_ARPACK) EigenSolve_ARPACK(DofData_P, NumEigenvalues, shift_r, shift_i, FilterExpressionIndex); #elif defined(HAVE_SLEPC) EigenSolve_SLEPC(DofData_P, NumEigenvalues, shift_r, shift_i, FilterExpressionIndex); #else Message::Error("EigenSolve not available without SLEPC or ARPACK"); #endif } getdp-2.7.0-source/Legacy/Generate_Network.cpp000644 001750 001750 00000014404 12473553042 022764 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "ProData.h" #include "ListUtils.h" #include "MallocUtils.h" #include "Message.h" extern int Flag_NETWORK_CACHE; extern char *Name_Path ; /* ------------------------------------------------------------------------ */ /* G e n e r a t e _ N e t w o r k */ /* ------------------------------------------------------------------------ */ /* Determination of the matrix 'Loop - Branch' from the matrix 'Node - Branch' */ struct ConstraintActive * Generate_Network(char *Name, List_T * ConstraintPerRegion_L) { /* List of the Nodes of the Network */ List_T *ListInt_L = List_Create(10, 10, sizeof(int)) ; int Nbr_Branch = List_Nbr(ConstraintPerRegion_L) ; if (!Nbr_Branch) Message::Error("No branch in Network") ; struct ConstraintPerRegion * CPR ; for (int j = 0 ; j < Nbr_Branch ; j++) { CPR = (struct ConstraintPerRegion *)List_Pointer(ConstraintPerRegion_L, j) ; List_Replace(ListInt_L, &(CPR->Case.Network.Node1), fcmp_int) ; List_Replace(ListInt_L, &(CPR->Case.Network.Node2), fcmp_int) ; } if (Nbr_Branch) List_Sort(ListInt_L, fcmp_int) ; int n = List_Nbr(ListInt_L) - 1 ; /* Nbr_Node - 1 */ int Nbr_Loop = Nbr_Branch - n ; /* Nbr of independent loops */ Message::Info("Network has %d branch(es), %d node(s) and %d loop(s)", Nbr_Branch, n + 1, Nbr_Loop); /* Active data */ struct ConstraintActive * Active = (struct ConstraintActive *)Malloc(sizeof(struct ConstraintActive)) ; Active->Case.Network.NbrNode = n ; Active->Case.Network.NbrBranch = Nbr_Branch ; Active->Case.Network.NbrLoop = Nbr_Loop ; int ** MatNode, ** MatLoop ; Active->Case.Network.MatNode = MatNode = (int **)Malloc(n*sizeof(int *)); for (int i=0 ; iCase.Network.MatLoop = MatLoop = (int **)Malloc(Nbr_Loop*sizeof(int *)); for (int i=0 ; iCase.Network.Node1), fcmp_int)) > 0) MatNode[i-1][j] = -1 ; /* skip index 0, i.e. node 1 */ if ((i = List_ISearch(ListInt_L, &(CPR->Case.Network.Node2), fcmp_int)) > 0) MatNode[i-1][j] = 1 ; } /* Transformation of MatNode -> MatA ... Welsh algorithm */ int ** MatA = (int **)Malloc(n*sizeof(int *)) ; for (int i=0 ; i. #include #include #include "ProData.h" #include "GeoData.h" #include "MallocUtils.h" #include "Message.h" #define SQU(a) ((a)*(a)) extern struct Problem Problem_S ; extern struct GeoData * CurrentGeoData ; int fcmp_NXE(const void * a, const void * b) { return ((struct Entity2XEntity1 *)a)->Num - ((struct Entity2XEntity1 *)b)->Num ; } int fcmp_EXVector(const void * a, const void * b) { return ((struct EntityXVector *)a)->Num - ((struct EntityXVector *)b)->Num ; } /* C'est une maniere un peu naive de creer cette BD. Mais elle a l'avantage de permettre une allocation simple (et minimum). L'autre possibilite (boucler sur les elemnts) est plus rapide, mais je ne vois pas bien comment obtenir un cout memoire minimum simplement, sans faire de nombreux realloc. */ #define MAX_NBR_NXE_INCIDENCE 20 static int RegionIndexForNXE = -1; void Geo_CreateNodesXElements(int NumNode, int InIndex, int *NbrElements, int **NumElements) { struct Entity2XEntity1 NXE, *NXE_P ; struct Geo_Element *GeoElement ; struct Group *Group_P ; int i, j, tmp[MAX_NBR_NXE_INCIDENCE] ; Group_P = (struct Group*)List_Pointer(Problem_S.Group, InIndex); if(InIndex != RegionIndexForNXE){ RegionIndexForNXE = InIndex ; Message::Info(" Generate NodesXElements information for Region '%s'", Group_P->Name); if(CurrentGeoData->NodesXElements) Tree_Delete(CurrentGeoData->NodesXElements); CurrentGeoData->NodesXElements = Tree_Create(sizeof(struct Entity2XEntity1), fcmp_NXE) ; } NXE.Num = NumNode ; if((NXE_P = (struct Entity2XEntity1*) Tree_PQuery(CurrentGeoData->NodesXElements, &NXE))) { *NbrElements = NXE_P->NbrEntities ; *NumElements = NXE_P->NumEntities ; } else{ NXE.NbrEntities = 0 ; for (i = 0 ; i < Geo_GetNbrGeoElements(); i++) { GeoElement = Geo_GetGeoElement(i) ; if (List_Search(Group_P->InitialList, &GeoElement->Region, fcmp_int)){ for(j=0 ; jNbrNodes ; j++){ if(GeoElement->NumNodes[j] == NumNode){ /* printf("Adding elm %d to node %d\n", GeoElement->Num, NumNode); */ /* this is to have orientation of elements adjacent to the node Only valid for line elemnts !!!!!!! */ tmp[NXE.NbrEntities] = ((!j)?-1:1) * GeoElement->Num ; NXE.NbrEntities++ ; } } } } NXE.NumEntities = (int*)Malloc(NXE.NbrEntities * sizeof(int)) ; memcpy(NXE.NumEntities, tmp, NXE.NbrEntities * sizeof(int)); Tree_Add(CurrentGeoData->NodesXElements, &NXE); *NbrElements = NXE.NbrEntities ; *NumElements = NXE.NumEntities ; } } void Geo_CreateNormal(int Type, double *x, double *y, double *z, double *N) { double x1x0, x2x0, y1y0, y2y0, z1z0, z2z0 ; double nx, ny, nz, norm ; switch (Type) { case LINE : nx = y[1] - y[0] ; ny = x[0] - x[1] ; norm = sqrt(SQU(nx)+SQU(ny)) ; N[0] = nx / norm ; N[1] = ny / norm ; N[2] = 0. ; break ; case TRIANGLE : case QUADRANGLE : x1x0 = x[1] - x[0] ; y1y0 = y[1] - y[0] ; z1z0 = z[1] - z[0] ; x2x0 = x[2] - x[0] ; y2y0 = y[2] - y[0] ; z2z0 = z[2] - z[0] ; nx = y1y0 * z2z0 - z1z0 * y2y0 ; ny = z1z0 * x2x0 - x1x0 * z2z0 ; nz = x1x0 * y2y0 - y1y0 * x2x0 ; norm = sqrt(SQU(nx)+SQU(ny)+SQU(nz)) ; N[0] = nx/norm ; N[1] = ny/norm ; N[2] = nz/norm ; break ; default : Message::Error("Normal computation not done (yet) for Element Type %d", Type); } } void Geo_CreateNormalOfElement(struct Geo_Element *GeoElement, double *Normal) { struct EntityXVector EXV, *EXV_P ; double x [NBR_MAX_NODES_IN_ELEMENT] ; double y [NBR_MAX_NODES_IN_ELEMENT] ; double z [NBR_MAX_NODES_IN_ELEMENT] ; EXV.Num = GeoElement->Num ; if((EXV_P = (struct EntityXVector*)Tree_PQuery(CurrentGeoData->Normals, &EXV))) { memcpy(Normal, EXV_P->Vector, 3*sizeof(double)); } else{ Geo_GetNodesCoordinates(GeoElement->NbrNodes, GeoElement->NumNodes, x, y, z) ; Geo_CreateNormal(GeoElement->Type, x, y, z, Normal); memcpy(EXV.Vector, Normal, 3*sizeof(double)); Tree_Add(CurrentGeoData->Normals, &EXV); } } getdp-2.7.0-source/Legacy/Gauss_Pyramid.h000644 001750 001750 00000002321 12473553042 021730 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . /* 8 integration points from Coulomb et al., IEEE tr.mag. 32(3) May 1996, p.1395 2 plans // a la base quadrangulaire, 4 points par plan suffisant pour integrer exactement nodal degre 2 cf. ../utils/pyram.c */ static double upyr8[8] = {0.2631840555694285,-0.2631840555694285, 0.2631840555694285,-0.2631840555694285, 0.5066163033492386,-0.5066163033492386, 0.5066163033492386,-0.5066163033492386}; static double vpyr8[8] = {0.2631840555694285,0.2631840555694285, -0.2631840555694285,-0.2631840555694285, 0.5066163033492386,0.5066163033492386, -0.5066163033492386,-0.5066163033492386}; static double wpyr8[8] = {0.544151844011225,0.544151844011225, 0.544151844011225,0.544151844011225, 0.122514822655441,0.122514822655441, 0.122514822655441,0.122514822655441}; static double ppyr8[8] = {0.100785882079825,0.100785882079825, 0.100785882079825,0.100785882079825, 0.232547451253508,0.232547451253508, 0.232547451253508,0.232547451253508}; getdp-2.7.0-source/Legacy/MovingBand2D.h000644 001750 001750 00000000623 12473553042 021376 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _MOVING_BAND_2D_H_ #define _MOVING_BAND_2D_H_ #include "ProData.h" void Init_MovingBand2D(struct Group * Group_P); void Mesh_MovingBand2D(struct Group * Group_P); #endif getdp-2.7.0-source/Legacy/Gauss_Tetrahedron.h000644 001750 001750 00000012040 12473553042 022601 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . /* 1 integration point */ static double xtet1[1] = {0.25}; static double ytet1[1] = {0.25}; static double ztet1[1] = {0.25}; static double ptet1[1] = {0.166666666667}; /* 4 integration points */ static double xtet4[4] = {0.138196601125,0.138196601125,0.138196601125,0.585410196625}; static double ytet4[4] = {0.138196601125,0.138196601125,0.585410196625,0.138196601125}; static double ztet4[4] = {0.138196601125,0.585410196625,0.138196601125,0.138196601125}; static double ptet4[4] = {0.0416666666667,0.0416666666667,0.0416666666667,0.0416666666667}; /* 5 integration points */ static double xtet5[5] = {0.25,0.166666666667,0.166666666667,0.166666666667,0.5}; static double ytet5[5] = {0.25,0.166666666667,0.166666666667,0.5,0.166666666667}; static double ztet5[5] = {0.25,0.166666666667,0.5,0.166666666667,0.166666666667}; static double ptet5[5] = {-0.133333333333,0.075,0.075,0.075,0.075}; /* 15 integration points */ static double xtet15[15] = {0.25, 0.0919710780526,0.0919710780526,0.0919710780526,0.724086765841, 0.319793627829,0.319793627829,0.319793627829,0.0406191165118, 0.0563508326895,0.0563508326895,0.44364916731,0.0563508326895, 0.44364916731,0.44364916731}; static double ytet15[15] = {0.25, 0.0919710780526,0.0919710780526,0.724086765841,0.0919710780526, 0.319793627829,0.319793627829,0.0406191165118,0.319793627829, 0.0563508326895,0.44364916731,0.0563508326895,0.44364916731, 0.0563508326895,0.44364916731}; static double ztet15[15] = {0.25, 0.0919710780526,0.724086765841,0.0919710780526,0.0919710780526, 0.319793627829,0.0406191165118,0.319793627829,0.319793627829, 0.44364916731,0.0563508326895,0.0563508326895,0.44364916731, 0.44364916731,0.0563508326895}; static double ptet15[15] = {0.0197530864198, 0.0119895139632,0.0119895139632,0.0119895139632,0.0119895139632, 0.011511367871,0.011511367871,0.011511367871,0.011511367871, 0.00881834215168,0.00881834215168,0.00881834215168,0.00881834215168, 0.00881834215168,0.00881834215168}; /* 16 integration points */ #define a16 0.0503737941001228 / 6.0 #define b16 0.0665420686332923 / 6.0 #define c16 0.7716429020672371 #define d16 0.0761190326442543 #define e16 0.1197005277978019 #define f16 0.0718316452676693 #define g16 0.4042339134672644 static double xtet16[16] = {c16,d16,d16,d16,e16,f16,e16,f16, g16,g16,g16,g16,e16,f16,g16,g16}; static double ytet16[16] = {d16,c16,d16,d16,f16,e16,g16,g16, g16,g16,e16,f16,g16,g16,e16,f16}; static double ztet16[16] = {d16,d16,c16,d16,g16,g16,g16,g16, e16,f16,f16,e16,f16,e16,g16,g16}; static double ptet16[16] = {a16,a16,a16,a16,b16,b16,b16,b16, b16,b16,b16,b16,b16,b16,b16,b16}; #undef a16 #undef b16 #undef c16 #undef d16 #undef e16 #undef f16 #undef g16 /* 17 integration points */ #define a17 0.1884185567365411 / 6.0 #define b17 0.0670385837260428 / 6.0 #define c17 0.0452855923632739 / 6.0 #define p17 0.7316369079576180 #define q17 0.0894543640141273 #define e17 0.1325810999384657 #define f17 0.0245400397290300 #define g17 0.4214394310662522 static double xtet17[17] = {0.25,p17,q17,q17,q17,e17,f17,e17,f17,g17, g17,g17,g17,e17,f17,g17,g17}; static double ytet17[17] = {0.25,q17,p17,q17,q17,f17,e17,g17,g17,g17, g17,e17,f17,g17,g17,e17,f17}; static double ztet17[17] = {0.25,q17,q17,p17,q17,g17,g17,g17,g17,e17, f17,f17,e17,f17,e17,g17,g17}; static double ptet17[17] = {a17,b17,b17,b17,b17,c17,c17,c17,c17,c17, c17,c17,c17,c17,c17,c17,c17}; #undef a17 #undef b17 #undef c17 #undef p17 #undef q17 #undef e17 #undef f17 #undef g17 /* 29 integration points */ #define a29 0.0904012904601475 / 6.0 #define b29 0.0191198342789912 / 6.0 #define c29 0.0436149384066657 / 6.0 #define d29 0.0258116759619916 / 6.0 #define p29 0.8277192480479295 #define q29 0.0574269173173568 #define e29 0.0513518841255634 #define f29 0.4860510285706072 #define g29 0.2312985436519147 #define h29 0.2967538129690260 #define i29 0.6081079894015281 #define j29 0.0475690988147229 static double xtet29[29] = {0.25,p29,q29,q29,q29,e29,f29,e29,f29,g29, g29,g29,g29,e29,f29,g29,g29,h29,i29,h29, i29,j29,j29,j29,j29,h29,i29,j29,j29}; static double ytet29[29] = {0.25,q29,p29,q29,q29,f29,e29,g29,g29,g29, g29,e29,f29,g29,g29,e29,f29,i29,h29,j29, j29,j29,j29,h29,i29,j29,j29,h29,i29}; static double ztet29[29] = {0.25,q29,q29,p29,q29,g29,g29,g29,g29,e29, f29,f29,e29,f29,e29,g29,g29,j29,j29,j29, j29,h29,i29,i29,h29,i29,h29,j29,j29}; static double ptet29[29] = {a29,b29,b29,b29,b29,c29,c29,c29,c29,c29, c29,c29,c29,c29,c29,c29,c29,d29,d29,d29, d29,d29,d29,d29,d29,d29,d29,d29,d29}; #undef a29 #undef b29 #undef c29 #undef d29 #undef p29 #undef q29 #undef e29 #undef f29 #undef g29 #undef h29 #undef i29 #undef j29 getdp-2.7.0-source/Legacy/BF_Node.cpp000644 001750 001750 00000032534 12473553042 020761 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Christophe Trophime // #include "ProData.h" #include "Message.h" #define SQU(a) ((a)*(a)) /* ------------------------------------------------------------------------ */ /* B F _ N o d e */ /* ------------------------------------------------------------------------ */ #define WrongNumNode Message::Error("Wrong Node number in 'BF_Node'") void BF_Node(struct Element * Element, int NumNode, double u, double v, double w, double *s ) { double r; switch (Element->Type) { case POINT : switch(NumNode) { case 1 : *s = 1. ; break ; default : WrongNumNode ; } break ; case LINE : switch(NumNode) { case 1 : *s = 0.5 * (1.-u) ; break ; case 2 : *s = 0.5 * (1.+u) ; break ; default : WrongNumNode ; } break ; case TRIANGLE : switch(NumNode) { case 1 : *s = 1.-u-v ; break ; case 2 : *s = u ; break ; case 3 : *s = v ; break ; default : WrongNumNode ; } break ; case QUADRANGLE : switch(NumNode) { case 1 : *s = 0.25 * (1.-u) * (1.-v) ; break ; case 2 : *s = 0.25 * (1.+u) * (1.-v) ; break ; case 3 : *s = 0.25 * (1.+u) * (1.+v) ; break ; case 4 : *s = 0.25 * (1.-u) * (1.+v) ; break ; default : WrongNumNode ; } break ; case TETRAHEDRON : switch(NumNode) { case 1 : *s = 1.-u-v-w ; break ; case 2 : *s = u ; break ; case 3 : *s = v ; break ; case 4 : *s = w ; break ; default : WrongNumNode ; } break ; case HEXAHEDRON : switch(NumNode) { case 1 : *s = (1.-u) * (1.-v) * (1.-w) * 0.125 ; break ; case 2 : *s = (1.+u) * (1.-v) * (1.-w) * 0.125 ; break ; case 3 : *s = (1.+u) * (1.+v) * (1.-w) * 0.125 ; break ; case 4 : *s = (1.-u) * (1.+v) * (1.-w) * 0.125 ; break ; case 5 : *s = (1.-u) * (1.-v) * (1.+w) * 0.125 ; break ; case 6 : *s = (1.+u) * (1.-v) * (1.+w) * 0.125 ; break ; case 7 : *s = (1.+u) * (1.+v) * (1.+w) * 0.125 ; break ; case 8 : *s = (1.-u) * (1.+v) * (1.+w) * 0.125 ; break ; default : WrongNumNode ; } break ; case PRISM : switch(NumNode) { case 1 : *s = (1.-u-v) * (1.-w) * 0.5 ; break ; case 2 : *s = u * (1.-w) * 0.5 ; break ; case 3 : *s = v * (1.-w) * 0.5 ; break ; case 4 : *s = (1.-u-v) * (1.+w) * 0.5 ; break ; case 5 : *s = u * (1.+w) * 0.5 ; break ; case 6 : *s = v * (1.+w) * 0.5 ; break ; default : WrongNumNode ; } break ; case PYRAMID : if(w != 1. && NumNode != 5) r = u*v*w / (1.-w) ; else r = 0. ; switch(NumNode) { case 1 : *s = 0.25 * ((1.-u) * (1.-v) - w + r); break ; case 2 : *s = 0.25 * ((1.+u) * (1.-v) - w - r); break ; case 3 : *s = 0.25 * ((1.+u) * (1.+v) - w + r); break ; case 4 : *s = 0.25 * ((1.-u) * (1.+v) - w - r); break ; case 5 : *s = w ; break ; default : WrongNumNode ; } break ; case LINE_2 : switch(NumNode) { case 1 : *s = 0.5*u*(u-1.) ; break ; case 2 : *s = 0.5*u*(1.+u) ; break ; case 3 : *s = 1.-u*u ; break ; default : WrongNumNode ; } break ; case TRIANGLE_2 : r = 1.-u-v ; switch(NumNode) { case 1 : *s = r*(2.*r-1.) ; break ; case 2 : *s = u*(2.*u-1.) ; break ; case 3 : *s = v*(2.*v-1.) ; break ; case 4 : *s = 4.*r*u ; break ; case 5 : *s = 4.*u*v ; break ; case 6 : *s = 4.*v*r ; break ; default : WrongNumNode ; } break ; case QUADRANGLE_2 : switch(NumNode) { case 1 : *s = 0.25 * (1.-u) * (1.-v) * u * v ; break ; case 2 : *s = -0.25 * (1.+u) * (1.-v) * u * v ; break ; case 3 : *s = 0.25 * (1.+u) * (1.+v) * u * v ; break ; case 4 : *s = -0.25 * (1.-u) * (1.+v) * u * v ; break ; case 5 : *s = -0.5 * (1.-u*u)* (1.-v) * v ; break ; case 6 : *s = 0.5 * (1.+u) * (1.-v*v)* u ; break ; case 7 : *s = 0.5 * (1.-u*u)* (1.+v) * v ; break ; case 8 : *s = -0.5 * (1.-u) * (1.-v*v)* u ; break ; case 9 : *s = (1.-u*u)* (1.-v*v) ; break ; default : WrongNumNode ; } break ; case QUADRANGLE_2_8N : switch(NumNode) { case 1 : *s = -0.25 * (1.-u) * (1.-v) * (1.+u+v) ; break ; case 2 : *s = -0.25 * (1.+u) * (1.-v) * (1.-u+v) ; break ; case 3 : *s = -0.25 * (1.+u) * (1.+v) * (1.-u-v) ; break ; case 4 : *s = -0.25 * (1.-u) * (1.+v) * (1.+u-v) ; break ; case 5 : *s = 0.5 * (1.-u*u)* (1.-v) ; break ; case 6 : *s = 0.5 * (1.+u) * (1.-v*v) ; break ; case 7 : *s = 0.5 * (1.-u*u)* (1.+v) ; break ; case 8 : *s = 0.5 * (1.-u) * (1.-v*v) ; break ; default : WrongNumNode ; } break ; default : Message::Error("Unknown type of Element in BF_Node"); break; } } #undef WrongNumNode /* ------------------------------------------------------------------------ */ /* B F _ G r a d N o d e */ /* ------------------------------------------------------------------------ */ #define WrongNumNode Message::Error("Wrong Node number in 'BF_GradNode'") void BF_GradNode(struct Element * Element, int NumNode, double u, double v, double w, double s[]) { double r; switch (Element->Type) { case POINT : switch(NumNode) { case 1 : s[0] = 0. ; s[1] = 0. ; s[2] = 0. ; break ; default : WrongNumNode ; } break ; case LINE : switch(NumNode) { case 1 : s[0] = -0.5 ; s[1] = 0. ; s[2] = 0. ; break ; case 2 : s[0] = 0.5 ; s[1] = 0. ; s[2] = 0. ; break ; default : WrongNumNode ; } break ; case TRIANGLE : switch(NumNode) { case 1 : s[0] = -1. ; s[1] = -1. ; s[2] = 0. ; break ; case 2 : s[0] = 1. ; s[1] = 0. ; s[2] = 0. ; break ; case 3 : s[0] = 0. ; s[1] = 1. ; s[2] = 0. ; break ; default : WrongNumNode ; } break ; case QUADRANGLE : switch(NumNode) { case 1 : s[0] = -0.25 * (1.-v) ; s[1] = -0.25 * (1.-u) ; s[2] = 0. ; break ; case 2 : s[0] = 0.25 * (1.-v) ; s[1] = -0.25 * (1.+u) ; s[2] = 0. ; break ; case 3 : s[0] = 0.25 * (1.+v) ; s[1] = 0.25 * (1.+u) ; s[2] = 0. ; break ; case 4 : s[0] = -0.25 * (1.+v) ; s[1] = 0.25 * (1.-u) ; s[2] = 0. ; break ; default : WrongNumNode ; } break ; case TETRAHEDRON : switch(NumNode) { case 1 : s[0] = -1. ; s[1] = -1. ; s[2] = -1. ; break ; case 2 : s[0] = 1. ; s[1] = 0. ; s[2] = 0. ; break ; case 3 : s[0] = 0. ; s[1] = 1. ; s[2] = 0. ; break ; case 4 : s[0] = 0. ; s[1] = 0. ; s[2] = 1. ; break ; default : WrongNumNode ; } break ; case HEXAHEDRON : switch(NumNode) { case 1 : s[0] = -0.125 * (1.-v) * (1.-w) ; s[1] = -0.125 * (1.-u) * (1.-w) ; s[2] = -0.125 * (1.-u) * (1.-v) ; break ; case 2 : s[0] = 0.125 * (1.-v) * (1.-w) ; s[1] = -0.125 * (1.+u) * (1.-w) ; s[2] = -0.125 * (1.+u) * (1.-v) ; break ; case 3 : s[0] = 0.125 * (1.+v) * (1.-w) ; s[1] = 0.125 * (1.+u) * (1.-w) ; s[2] = -0.125 * (1.+u) * (1.+v) ; break ; case 4 : s[0] = -0.125 * (1.+v) * (1.-w) ; s[1] = 0.125 * (1.-u) * (1.-w) ; s[2] = -0.125 * (1.-u) * (1.+v) ; break ; case 5 : s[0] = -0.125 * (1.-v) * (1.+w) ; s[1] = -0.125 * (1.-u) * (1.+w) ; s[2] = 0.125 * (1.-u) * (1.-v) ; break ; case 6 : s[0] = 0.125 * (1.-v) * (1.+w) ; s[1] = -0.125 * (1.+u) * (1.+w) ; s[2] = 0.125 * (1.+u) * (1.-v) ; break ; case 7 : s[0] = 0.125 * (1.+v) * (1.+w) ; s[1] = 0.125 * (1.+u) * (1.+w) ; s[2] = 0.125 * (1.+u) * (1.+v) ; break ; case 8 : s[0] = -0.125 * (1.+v) * (1.+w) ; s[1] = 0.125 * (1.-u) * (1.+w) ; s[2] = 0.125 * (1.-u) * (1.+v) ; break ; default : WrongNumNode ; } break ; case PRISM : switch(NumNode) { case 1 : s[0] = -0.5 * (1.-w) ; s[1] = -0.5 * (1.-w) ; s[2] = -0.5 * (1.-u-v) ; break ; case 2 : s[0] = 0.5 * (1.-w) ; s[1] = 0. ; s[2] = -0.5 * u ; break ; case 3 : s[0] = 0. ; s[1] = 0.5 * (1.-w) ; s[2] = -0.5 * v ; break ; case 4 : s[0] = -0.5 * (1.+w) ; s[1] = -0.5 * (1.+w) ; s[2] = 0.5 * (1.-u-v) ; break ; case 5 : s[0] = 0.5 * (1.+w) ; s[1] = 0. ; s[2] = 0.5 * u ; break ; case 6 : s[0] = 0. ; s[1] = 0.5 * (1.+w) ; s[2] = 0.5 * v ; break ; default : WrongNumNode ; } break ; case PYRAMID : if(w == 1. && NumNode != 5) { //When w = 1 => u=v=0 switch(NumNode) { case 1 : s[0] = -0.25 ; s[1] = -0.25 ; s[2] = -0.25 ; break ; case 2 : s[0] = 0.25 ; s[1] = -0.25 ; s[2] = -0.25 ; break ; case 3 : s[0] = 0.25 ; s[1] = 0.25 ; s[2] = -0.25 ; break ; case 4 : s[0] = -0.25 ; s[1] = 0.25 ; s[2] = -0.25 ; break ; case 5 : s[0] = 0. ; s[1] = 0. ; s[2] = 1. ; break ; default : WrongNumNode ; } } else{ switch(NumNode) { case 1 : s[0] = 0.25 * ( v/(1 - w) - 1) ; s[1] = 0.25 * ( u/(1 - w) - 1) ; s[2] = 0.25 * ( u*v/SQU(1 - w) - 1) ; break ; case 2 : s[0] = 0.25 * (-v/(1 - w) + 1) ; s[1] = 0.25 * (-u/(1 - w) - 1) ; s[2] = 0.25 * (-u*v/SQU(1 - w) - 1) ; break ; case 3 : s[0] = 0.25 * ( v/(1 - w) + 1) ; s[1] = 0.25 * ( u/(1 - w) + 1) ; s[2] = 0.25 * ( u*v/SQU(1 - w) - 1) ; break ; case 4 : s[0] = 0.25 * (-v/(1 - w) - 1) ; s[1] = 0.25 * (-u/(1 - w) + 1) ; s[2] = 0.25 * (-u*v/SQU(1 - w) - 1) ; break ; case 5 : s[0] = 0. ; s[1] = 0. ; s[2] = 1. ; break ; default : WrongNumNode ; } } break ; case LINE_2 : switch(NumNode) { case 1 : s[0] = -0.5+u ; s[1] = 0. ; s[2] = 0. ; break ; case 2 : s[0] = 0.5+u ; s[1] = 0. ; s[2] = 0. ; break ; case 3 : s[0] = -2.*u ; s[1] = 0. ; s[2] = 0. ; break ; default : WrongNumNode ; } break ; case TRIANGLE_2 : r = 1.-u-v ; switch(NumNode) { case 1 : s[0] = 1.-4.*r ; s[1] = 1.-4.*r ; s[2] = 0. ; break ; case 2 : s[0] =-1.+4.*u ; s[1] = 0. ; s[2] = 0. ; break ; case 3 : s[0] = 0. ; s[1] =-1.+4.*v ; s[2] = 0. ; break ; case 4 : s[0] = 4.*(r-u); s[1] = -4.*u ; s[2] = 0. ; break ; case 5 : s[0] = 4.*v ; s[1] = 4.*u ; s[2] = 0. ; break ; case 6 : s[0] =-4.*v ; s[1] = 4.*(r-v); s[2] = 0. ; break ; default : WrongNumNode ; } break ; case QUADRANGLE_2 : switch(NumNode) { case 1 : s[0] = 0.25 * (1.-2.*u) * (1.-v) * v ; s[1] = 0.25 * (1.-u) * (1.-2.*v) * u ; s[2] = 0. ; break ; case 2 : s[0] = -0.25 * (1.+2.*u) * (1.-v) * v ; s[1] = -0.25 * (1.+u) * (1.-2.*v) * u ; s[2] = 0. ; break ; case 3 : s[0] = 0.25 * (1.+2.*u) * (1.+v) * v ; s[1] = 0.25 * (1.+u) * (1.+2.*v) * u ; s[2] = 0. ; break ; case 4 : s[0] = -0.25 * (1.-2.*u) * (1.+v) * v ; s[1] = -0.25 * (1.-u) * (1.+2.*v) * u ; s[2] = 0. ; break ; case 5 : s[0] = (1.-v) * u * v ; s[1] = -0.5 * (1.-u*u) * (1.-2.*v) ; s[2] = 0. ; break ; case 6 : s[0] = 0.5 * (1.+2.*u) * (1.-v*v) ; s[1] = -(1.+u) * u * v ; s[2] = 0. ; break ; case 7 : s[0] = -(1.+v) * u * v ; s[1] = 0.5 * (1.-u*u) * (1.+2.*v) ; s[2] = 0. ; break ; case 8 : s[0] = -0.5 * (1.-2.*u) * (1.-v*v) ; s[1] = (1.-u) * u * v ; s[2] = 0. ; break ; case 9 : s[0] = -2. * (1.-v*v) * u ; s[1] = -2. * (1.-u*u) * v ; s[2] = 0. ; break ; default : WrongNumNode ; } break ; case QUADRANGLE_2_8N : switch(NumNode) { case 1 : s[0] = 0.25 * (1.-v) * (2.*u+v) ; s[1] = 0.25 * (1.-u) * (u+2.*v) ; s[2] = 0. ; break ; case 2 : s[0] = 0.25 * (1.-v) * (2.*u-v) ; s[1] = -0.25 * (1.+u) * (u-2.*v) ; s[2] = 0. ; break ; case 3 : s[0] = 0.25 * (1.+v) * (2.*u+v) ; s[1] = 0.25 * (1.+u) * (u+2.*v) ; s[2] = 0. ; break ; case 4 : s[0] = 0.25 * (1.+v) * (2.*u-v) ; s[1] = -0.25 * (1.-u) * (u-2.*v) ; s[2] = 0. ; break ; case 5 : s[0] = -(1.-v) * u ; s[1] = -0.5 * (1.-u*u) ; s[2] = 0. ; break ; case 6 : s[0] = 0.5 * (1.-v*v) ; s[1] = -(1.+u) * v ; s[2] = 0. ; break ; case 7 : s[0] = -(1.+v) * u ; s[1] = 0.5 * (1.-u*u) ; s[2] = 0. ; break ; case 8 : s[0] = -0.5 * (1.-v*v) ; s[1] = -(1.-u) * v ; s[2] = 0. ; break ; default : WrongNumNode ; } break ; default : Message::Error("Unknown type of Element in BF_GradNode"); break; } } #undef WrongNumNode getdp-2.7.0-source/Legacy/Operation_TimeLoopAdaptive.cpp000644 001750 001750 00000111632 12473553042 024750 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Michael Asam #include #include #include #include #include "GetDPConfig.h" #if defined(HAVE_GSL) #include #endif #include "ProData.h" #include "DofData.h" #include "SolvingOperations.h" #include "SolvingAnalyse.h" #include "Message.h" #include "MallocUtils.h" #include "Legendre.h" extern struct CurrentData Current; extern int Flag_IterativeLoopConverged; extern int Flag_RESTART; /* ------------------------------------------------------------------------ */ /* C a l c I n t e g r a t i o n C o e f f i c i e n t s */ /* ------------------------------------------------------------------------ */ #if !defined(HAVE_GSL) void CalcIntegrationCoefficients(Resolution *Resolution_P, DofData *DofData_P0, List_T *TLAsystems_L, List_T *TLAPostOp_L, int Order) { Message::Error("TimeLoopAdaptive requires the GSL"); } #else void CalcIntegrationCoefficients(Resolution *Resolution_P, DofData *DofData_P0, List_T *TLAsystems_L, List_T *TLAPostOp_L, int Order) { DefineSystem *System_P=NULL; DofData *DofData_P=NULL; Solution *Solution_P; TimeLoopAdaptiveSystem TLAsystem; List_T *Solutions_L=NULL; PostOpSolutions *PostOpSolutions_P0; int j, s, NbrOfSolutions=0; double t[8], temp; double A_data[49], b_data[7]; bool RecomputeTimeStep; gsl_matrix_view A; gsl_vector_view b; gsl_vector *coeff; gsl_permutation *p; // Initialization for (int i=0; i<7; i++) Current.aPredCoeff[i] = 0.0; for (int i=0; i<6; i++) Current.aCorrCoeff[i] = 0.0; Current.bCorrCoeff = 0.0; Current.PredErrorConst = 0.0; Current.CorrErrorConst = 0.0; if (Order < 1 || Order > 6) Message::Error("Order has to be in the range 1 .. 6"); // First get the past time points // ------------------------------ if (List_Nbr(TLAsystems_L)==0 && List_Nbr(TLAPostOp_L)==0) { Message::Error("Neither systems nor PostOperations are specified " "for TimeLoopAdaptive"); } if (List_Nbr(TLAsystems_L)) { List_Read(TLAsystems_L, 0, &TLAsystem); System_P = (DefineSystem*)List_Pointer(Resolution_P->DefineSystem, TLAsystem.SystemIndex); DofData_P = DofData_P0 + TLAsystem.SystemIndex; Solutions_L = DofData_P->Solutions; NbrOfSolutions = List_Nbr(Solutions_L); if (!NbrOfSolutions) Message::Error("No initial solution for system %s", System_P->Name); if (NbrOfSolutions <= Order && Order > 1) Message::Error("Too few past solutions for system %s", System_P->Name); } if (List_Nbr(TLAPostOp_L)) { PostOpSolutions_P0 = (PostOpSolutions *)List_Pointer(Current.PostOpData_L, 0); Solutions_L = PostOpSolutions_P0->Solutions_L; NbrOfSolutions = List_Nbr(Solutions_L); if (!NbrOfSolutions) Message::Error("No initial PostOperations"); if (NbrOfSolutions <= Order && Order > 1) Message::Error("Too few past PostOperations results"); } // Set the predictor's and corrector's order // ----------------------------------------- Solution_P = (struct Solution*)List_Pointer(Solutions_L, NbrOfSolutions-1); // Check if we recompute actual TimeStep RecomputeTimeStep = (Solution_P->TimeStep == (int)Current.TimeStep); if (NbrOfSolutions < (2 + (RecomputeTimeStep ? 1 : 0))){ Current.PredOrder = 0; // For 1st TimeStep just copy the initial solution Current.CorrOrder = 1; } else{ Current.PredOrder = Order; Current.CorrOrder = Order; } // Time values // t_n+1 -> t[0] // t_n -> t[1] // t_n-1 -> t[2] // ... // t_n-k -> t[k+1] k=Order t[0] = Current.Time; for(int i=1; i <= Current.PredOrder+1; i++) { j = RecomputeTimeStep ? i+1 : i; Solution_P = (struct Solution*)List_Pointer(Solutions_L, NbrOfSolutions-j); t[i] = Solution_P->Time; } // Calculation of predictor integration constants // ---------------------------------------------- /* The new solution is predicted by extrapolating the past solutions * by a polynom of order "PredOrder". The polynom coefficients * are calculated by solving a matrix equation A*coeff=b for the * exactness constraints. * E.g. for PredOder=3 we have: * * _ _ _ _ _ _ * | 1 1 1 1 | | a_0 | | 1 | * | (t_n)^1 (t_n-1)^1 (t_n-2)^1 (t_n-3)^1 | | a_1 | | (t_n+1)^1 | * | (t_n)^2 (t_n-1)^2 (t_n-2)^2 (t_n-3)^2 | * | a_2 | = | (t_n+1)^2 | * | (t_n)^3 (t_n-1)^3 (t_n-2)^3 (t_n-3)^3 | | a_3 | | (t_n+1)^3 | * |_ _| |_ _| |_ _| * */ if (Current.PredOrder == 0) Current.aPredCoeff[0] = 1.0; else { for (int c=0; c <= Current.PredOrder; c++) { A_data[c] = 1.0; for (int r=1; r <= Current.PredOrder; r++) A_data[c + r*((int)Current.PredOrder+1)] = pow(t[c+1],r); } A = gsl_matrix_view_array(A_data, Current.PredOrder+1, Current.PredOrder+1); b_data[0] = 1.0; for (int r=1; r <= Current.PredOrder; r++) b_data[r] = pow(t[0],r); b = gsl_vector_view_array(b_data, Current.PredOrder+1); coeff = gsl_vector_alloc(Current.PredOrder+1); p = gsl_permutation_alloc(Current.PredOrder+1); gsl_linalg_LU_decomp(&A.matrix, p, &s); gsl_linalg_LU_solve(&A.matrix, p, &b.vector, coeff); for (int i=0; i<=Current.PredOrder; i++) Current.aPredCoeff[i] = gsl_vector_get(coeff, i); gsl_permutation_free(p); gsl_vector_free(coeff); } // Calculation of corrector integration constants // ---------------------------------------------- /* * The coefficients for the Gear method (BDF) are also * calculated by solving a matrix equation A*coeff=b for the * exactness constraints. * E.g. for CorrOder=3 we have: * * _ _ _ _ _ _ * | 1 1 1 0 | | a_0 | | 1 | * | (t_n)^1 (t_n-1)^1 (t_n-2)^1 1*(t_n+1 - t_n) | | a_1 | | (t_n+1)^1 | * | (t_n)^2 (t_n-1)^2 (t_n-2)^2 2*(t_n+1 - t_n)*(t_n+1)^1 | * | a_2 | = | (t_n+1)^2 | * | (t_n)^3 (t_n-1)^3 (t_n-2)^3 3*(t_n+1 - t_n)*(t_n+1)^2 | | b_-1 | | (t_n+1)^3 | * |_ _| |_ _| |_ _| * */ if (Current.TypeTime == TIME_GEAR) { for (int c=0; c < Current.CorrOrder; c++) { A_data[c] = 1.0; for (int r=1; r <= Current.CorrOrder; r++) A_data[c + r*((int)Current.CorrOrder+1)] = pow(t[c+1],r); } A_data[(int)Current.CorrOrder] = 0.0; A_data[(int)Current.CorrOrder + 1*((int)Current.CorrOrder+1)] = t[0]-t[1]; for (int r=2; r <= Current.CorrOrder; r++) A_data[(int)Current.CorrOrder + r*((int)Current.CorrOrder+1)] = r*pow(t[0],r-1)*(t[0]-t[1]); A = gsl_matrix_view_array(A_data, Current.CorrOrder+1, Current.CorrOrder+1); b_data[0] = 1.0; for (int r=1; r <= Current.CorrOrder; r++) b_data[r] = pow(t[0],r); b = gsl_vector_view_array(b_data, Current.CorrOrder+1); coeff = gsl_vector_alloc(Current.CorrOrder+1); p = gsl_permutation_alloc(Current.CorrOrder+1); gsl_linalg_LU_decomp(&A.matrix, p, &s); gsl_linalg_LU_solve(&A.matrix, p, &b.vector, coeff); for (int i=0; iDefineSystem, TLAsystem.SystemIndex); DofData_P = DofData_P0 + TLAsystem.SystemIndex; if (!List_Nbr(DofData_P->Solutions)) Message::Error("No initial solution for system %s", System_P->Name); Solution_P = (struct Solution*) List_Pointer(DofData_P->Solutions, List_Nbr(DofData_P->Solutions)-1); TimeStep = (int)Current.TimeStep; if (Solution_P->TimeStep != TimeStep) { // if we compute a new time step Solution_S.TimeStep = TimeStep ; Solution_S.Time = Current.Time ; Solution_S.TimeImag = Current.TimeImag ; Solution_S.TimeFunctionValues = Get_TimeFunctionValues(DofData_P) ; Solution_S.SolutionExist = 1 ; LinAlg_CreateVector(&Solution_S.x, &DofData_P->Solver, DofData_P->NbrDof); List_Add(DofData_P->Solutions, &Solution_S); DofData_P->CurrentSolution = (struct Solution*) List_Pointer(DofData_P->Solutions, List_Nbr(DofData_P->Solutions)-1) ; Solution_P = DofData_P->CurrentSolution; } else { // fix time values if we recompute the same step (with different time) Solution_P->Time = Current.Time ; Solution_P->TimeImag = Current.TimeImag ; Free(Solution_P->TimeFunctionValues); Solution_P->TimeFunctionValues = Get_TimeFunctionValues(DofData_P) ; } NbrSolutions = List_Nbr(DofData_P->Solutions); if(NbrSolutions < Current.PredOrder + 2) Message::Error("Too few past solutions for system %s", System_P->Name); LinAlg_ZeroVector(&Solution_P->x); for (int j=0; j<=Current.PredOrder; j++) { PastSolution_P = (struct Solution*)List_Pointer(DofData_P->Solutions, NbrSolutions-2-j); if (!PastSolution_P->SolutionExist) Message::Error("Too few past solutions for system %s", System_P->Name); x_NminusJ_P = &PastSolution_P->x; LinAlg_AddVectorProdVectorDouble(&Solution_P->x, x_NminusJ_P, Current.aPredCoeff[j], &Solution_P->x); } xPredicted_P = (gVector*)List_Pointer(xPredicted_L, i); LinAlg_CopyVector(&Solution_P->x, xPredicted_P); } // Loop through all specified PostOperations if (List_Nbr(TLAPostOp_L) != List_Nbr(Current.PostOpData_L)) Message::Error("Current.PostOpData_L list is not up to date"); for(int i = 0; i < List_Nbr(TLAPostOp_L); i++){ PostOpSolutions_P = (struct PostOpSolutions*) List_Pointer(Current.PostOpData_L, i); NbrSolutions = List_Nbr(PostOpSolutions_P->Solutions_L); if (!NbrSolutions) Message::Error("No initial result for PostOperation %s", PostOpSolutions_P->PostOperation_P->Name); Solution_P = (struct Solution*)List_Pointer(PostOpSolutions_P->Solutions_L, NbrSolutions-1); TimeStep = (int)Current.TimeStep; if (Solution_P->TimeStep != TimeStep) { // if we compute a new time step Solution_S.TimeStep = TimeStep ; Solution_S.Time = Current.Time ; Solution_S.TimeImag = Current.TimeImag ; Solution_S.SolutionExist = 1 ; Solution_S.TimeFunctionValues = NULL; LinAlg_GetVectorSize(&Solution_P->x, &PostOpSolLength); LinAlg_CreateVector(&Solution_S.x, &DofData_P0->Solver, PostOpSolLength); List_Add(PostOpSolutions_P->Solutions_L, &Solution_S); Solution_P = (struct Solution*) List_Pointer(PostOpSolutions_P->Solutions_L, List_Nbr(PostOpSolutions_P->Solutions_L)-1); } else { // fix time values if we recompute the same step (with different time) Solution_P->Time = Current.Time ; Solution_P->TimeImag = Current.TimeImag ; } NbrSolutions = List_Nbr(PostOpSolutions_P->Solutions_L); if(NbrSolutions < Current.PredOrder + 2) Message::Error("Too few past results for PostOperation %s", PostOpSolutions_P->PostOperation_P->Name); PostOpSolPredicted_P = (gVector*)List_Pointer(PostOpSolPredicted_L, i); LinAlg_ZeroVector(PostOpSolPredicted_P); for (int j=0; j<=Current.PredOrder; j++) { PastSolution_P = (struct Solution*)List_Pointer(PostOpSolutions_P->Solutions_L, NbrSolutions-2-j); if (!PastSolution_P->SolutionExist) Message::Error("Too few past results for PostOperation %s", PostOpSolutions_P->PostOperation_P->Name); x_NminusJ_P = &PastSolution_P->x; LinAlg_AddVectorProdVectorDouble(PostOpSolPredicted_P, x_NminusJ_P, Current.aPredCoeff[j], PostOpSolPredicted_P); } } } /* ------------------------------------------------------------------------ */ /* C a l M a x L T E r a t i o */ /* ------------------------------------------------------------------------ */ double CalcMaxLTEratio(Resolution *Resolution_P, DofData *DofData_P0, List_T *TLAsystems_L, List_T *TLAPostOp_L, int Order, List_T *xPredicted_L, List_T *PostOpSolPredicted_L) { DefineSystem *DefineSystem_P; DofData *DofData_P; PostOpSolutions *PostOpSolutions_P; TimeLoopAdaptiveSystem TLAsystem; LoopErrorPostOperation TLAPostOp; Solution *Solution_P; gVector *xPredictor_P, *xCorrector_P; // predicted and actual solution vector gVector xLTE; // Local Truncation Error vector gVector *PostOpSolPred_P, *PostOpSolCorr_P; // predicted and actual solution vector gVector PostOpSolLTE; // Local Truncation Error vector double pec, cec; // predictor and corrector error constants double ErrorRatio, MaxErrorRatio; int NbrSolutions, PostOpSolLength; MaxErrorRatio = 0.; // Determine error constants pec = Current.PredErrorConst; // Predictor error constant cec = Current.CorrErrorConst; // Corrector error constant // Loop through all given systems for(int i = 0; i < List_Nbr(TLAsystems_L); i++) { List_Read(TLAsystems_L, i, &TLAsystem); DefineSystem_P = (DefineSystem*)List_Pointer(Resolution_P->DefineSystem, TLAsystem.SystemIndex); DofData_P = DofData_P0 + TLAsystem.SystemIndex; NbrSolutions = List_Nbr(DofData_P->Solutions); if(NbrSolutions < Order + 1) Message::Error("Too few past solutions for system %s", DefineSystem_P->Name); xPredictor_P = (gVector*)List_Pointer(xPredicted_L, i); xCorrector_P = &((struct Solution*)List_Pointer(DofData_P->Solutions, NbrSolutions-1))->x; // Vector of all local truncation errors // xLTE = cec / (pec - cec) * (xCorrector - xPredictor) LinAlg_CreateVector(&xLTE, &DofData_P->Solver, DofData_P->NbrDof); LinAlg_CopyVector(xCorrector_P, &xLTE); LinAlg_SubVectorVector(&xLTE, xPredictor_P, &xLTE); LinAlg_ProdVectorDouble(&xLTE, cec / (pec - cec), &xLTE); Cal_SolutionErrorRatio(&xLTE, xCorrector_P, TLAsystem.SystemLTEreltol, TLAsystem.SystemLTEabstol, TLAsystem.NormType, &ErrorRatio); LinAlg_DestroyVector(&xLTE); if (ErrorRatio != ErrorRatio) { // If ErrorRatio = NaN => There was no valid solution! MaxErrorRatio = ErrorRatio; break; } if (ErrorRatio > MaxErrorRatio) MaxErrorRatio = ErrorRatio; if(Message::GetVerbosity() > 5) { Message::Info("LTE %s of error ratio from system %s: %.3g", TLAsystem.NormTypeString, DefineSystem_P->Name, ErrorRatio); } } // Loop through all given PostOperations if (List_Nbr(TLAPostOp_L) != List_Nbr(Current.PostOpData_L)) Message::Error("Current PostOpData_L list is not up to date"); for(int i = 0; i < List_Nbr(TLAPostOp_L); i++) { List_Read(TLAPostOp_L, i, &TLAPostOp); PostOpSolutions_P = (struct PostOpSolutions*) List_Pointer(Current.PostOpData_L, i); NbrSolutions = List_Nbr(PostOpSolutions_P->Solutions_L); if(NbrSolutions < Order + 1) Message::Error("Too few past solutions for PostOperations %s", PostOpSolutions_P->PostOperation_P->Name); Solution_P = (struct Solution*) List_Pointer(PostOpSolutions_P->Solutions_L, NbrSolutions-1); PostOpSolPred_P = (gVector*)List_Pointer(PostOpSolPredicted_L, i); PostOpSolCorr_P = &Solution_P->x; // Vector of all local truncation errors // xLTE = cec / (pec - cec) * (xCorrector - xPredictor) LinAlg_GetVectorSize(PostOpSolCorr_P, &PostOpSolLength); LinAlg_CreateVector(&PostOpSolLTE, &DofData_P0->Solver, PostOpSolLength); LinAlg_CopyVector(PostOpSolCorr_P, &PostOpSolLTE); LinAlg_SubVectorVector(&PostOpSolLTE, PostOpSolPred_P, &PostOpSolLTE); LinAlg_ProdVectorDouble(&PostOpSolLTE, cec / (pec - cec), &PostOpSolLTE); Cal_SolutionErrorRatio(&PostOpSolLTE, PostOpSolCorr_P, TLAPostOp.PostOperationReltol, TLAPostOp.PostOperationAbstol, TLAPostOp.NormType, &ErrorRatio); LinAlg_DestroyVector(&PostOpSolLTE); if (ErrorRatio != ErrorRatio) { // If ErrorRatio = NaN => There was no valid solution! MaxErrorRatio = ErrorRatio; break; } if (ErrorRatio > MaxErrorRatio) MaxErrorRatio = ErrorRatio; if(Message::GetVerbosity() > 5) { Message::Info("LTE %s of error ratio from PostOperation %s: %.3g", TLAPostOp.NormTypeString, PostOpSolutions_P->PostOperation_P->Name, ErrorRatio); } } return MaxErrorRatio; } /* ------------------------------------------------------------------------ */ /* G e t I n t e g r a t i o n S c h e m e */ /* ------------------------------------------------------------------------ */ void GetIntegrationScheme(Operation *Operation_P, int *TypeTime, int *MaxOrder) { if (!strcmp(Operation_P->Case.TimeLoopAdaptive.Scheme, "Euler")) { *TypeTime = TIME_THETA; *MaxOrder = 1; } else if (!strcmp(Operation_P->Case.TimeLoopAdaptive.Scheme, "Trapezoidal")) { *TypeTime = TIME_THETA; *MaxOrder = 2; } else if (!strcmp(Operation_P->Case.TimeLoopAdaptive.Scheme, "Gear_2") || !strcmp(Operation_P->Case.TimeLoopAdaptive.Scheme, "BDF_2")) { *TypeTime = TIME_GEAR; *MaxOrder = 2; } else if (!strcmp(Operation_P->Case.TimeLoopAdaptive.Scheme, "Gear_3") || !strcmp(Operation_P->Case.TimeLoopAdaptive.Scheme, "BDF_3")) { *TypeTime = TIME_GEAR; *MaxOrder = 3; } else if (!strcmp(Operation_P->Case.TimeLoopAdaptive.Scheme, "Gear_4") || !strcmp(Operation_P->Case.TimeLoopAdaptive.Scheme, "BDF_4")) { *TypeTime = TIME_GEAR; *MaxOrder = 4; } else if (!strcmp(Operation_P->Case.TimeLoopAdaptive.Scheme, "Gear_5") || !strcmp(Operation_P->Case.TimeLoopAdaptive.Scheme, "BDF_5")) { *TypeTime = TIME_GEAR; *MaxOrder = 5; } else if (!strcmp(Operation_P->Case.TimeLoopAdaptive.Scheme, "Gear_6") || !strcmp(Operation_P->Case.TimeLoopAdaptive.Scheme, "BDF_6")) { *TypeTime = TIME_GEAR; *MaxOrder = 6; } else Message::Error("Unknown integration scheme: %s", Operation_P->Case.TimeLoopAdaptive.Scheme); } /* ------------------------------------------------------------------------ */ /* O p e r a t i o n _ T i m e L o o p A d a p t i v e */ /* ------------------------------------------------------------------------ */ void Operation_TimeLoopAdaptive(Resolution *Resolution_P, Operation *Operation_P, DofData *DofData_P0, GeoData *GeoData_P0, int *Flag_Break) { int TypeTime=0, MaxOrder=0, Order=0, TLATimeStep; int Try, BreakpointNum, NbrSolutions=0, NbrPostOps; double Save_Time, Save_DTime, Save_Theta, maxLTEratio=0, nextBreakpoint; double Save_TimeStep, FirstTimePoint, DTimeBeforeBreakpoint=1.; bool TimeStepAccepted=true, DTimeMinAtLastStep, BreakpointListCreated; bool BreakpointAtThisStep, BreakpointAtNextStep; double Time0, TimeMax, DTimeInit, DTimeMin, DTimeMax; double LTEtarget, DTimeMaxScal, DTimeScal_NotConverged, DTimeScal_PETScError; double DTimeScal=1.0; List_T *Breakpoints_L, *TLAsystems_L, *LEPostOp_L; List_T *LEPostOpNames_L; List_T *xPredicted_L, *PostOpSolPredicted_L; TimeLoopAdaptiveSystem TLAsystem; DofData *DofData_P=NULL; gVector xPredicted_S; // Some default values for constants influencing the time stepping LTEtarget = 0.8; // target LTE ratio for next step (should be below 1) DTimeMaxScal = 2.0; // maximum factor for increasing the time step DTime DTimeScal_NotConverged = 0.25; // step size scaling in case of a not converged iterative loop DTimeScal_PETScError = 0.25; // step size scaling in case of a PETSc error // Override default values if they are provided by the user LTEtarget = (Operation_P->Case.TimeLoopAdaptive.LTEtarget < 0) ? LTEtarget : Operation_P->Case.TimeLoopAdaptive.LTEtarget; DTimeMaxScal = (Operation_P->Case.TimeLoopAdaptive.DTimeMaxScal < 0 ) ? DTimeMaxScal : Operation_P->Case.TimeLoopAdaptive.DTimeMaxScal; DTimeScal_NotConverged = (Operation_P->Case.TimeLoopAdaptive.DTimeScal_NotConverged < 0) ? DTimeScal_NotConverged : Operation_P->Case.TimeLoopAdaptive.DTimeScal_NotConverged; DTimeScal_PETScError = (Operation_P->Case.TimeLoopAdaptive.DTimeScal_NotConverged < 0) ? DTimeScal_PETScError : Operation_P->Case.TimeLoopAdaptive.DTimeScal_NotConverged; Time0 = Operation_P->Case.TimeLoopAdaptive.Time0; TimeMax = Operation_P->Case.TimeLoopAdaptive.TimeMax; DTimeInit = Operation_P->Case.TimeLoopAdaptive.DTimeInit; DTimeMin = Operation_P->Case.TimeLoopAdaptive.DTimeMin; DTimeMax = Operation_P->Case.TimeLoopAdaptive.DTimeMax; Breakpoints_L = Operation_P->Case.TimeLoopAdaptive.Breakpoints_L; TLAsystems_L = Operation_P->Case.TimeLoopAdaptive.TimeLoopAdaptiveSystems_L; LEPostOp_L = Operation_P->Case.TimeLoopAdaptive.TimeLoopAdaptivePOs_L; GetIntegrationScheme(Operation_P, &TypeTime, &MaxOrder); xPredicted_L = List_Create(4,4,sizeof(gVector)); PostOpSolPredicted_L = List_Create(4,4,sizeof(gVector)); // Just some checks // ---------------- if (TLAsystems_L == NULL) TLAsystems_L = List_Create(1,1,sizeof(TimeLoopAdaptiveSystem)); if (LEPostOp_L == NULL) LEPostOp_L = List_Create(1,1,sizeof(LoopErrorPostOperation)); // Check the timing values if (Time0 > TimeMax) Message::Error("Time0 > TimeMax"); if (DTimeInit < DTimeMin) Message::Error("DTimeInit < DTimeMin"); if (DTimeInit > DTimeMax) Message::Error("DTimeInit > DTimeMax"); if (DTimeInit > TimeMax - Time0) Message::Error("DTimeInit > (TimeMax - Time0"); // Initialization before starting the time loop // -------------------------------------------- // Check if initial solutions for all specified systems are available // and create vectors for the predicted solutions for(int i = 0; i < List_Nbr(TLAsystems_L); i++){ List_Read(TLAsystems_L, i, &TLAsystem); DefineSystem *System_P = (DefineSystem*)List_Pointer(Resolution_P->DefineSystem, TLAsystem.SystemIndex); DofData_P = DofData_P0 + TLAsystem.SystemIndex; NbrSolutions = List_Nbr(DofData_P->Solutions); if(!NbrSolutions) Message::Error("No initial solution for system %s", System_P->Name); LinAlg_CreateVector(&xPredicted_S, &DofData_P->Solver, DofData_P->NbrDof); List_Add(xPredicted_L, &xPredicted_S); } // Initializing stuff for PostOperations NbrPostOps = List_Nbr(LEPostOp_L); LEPostOpNames_L = List_Create(NbrPostOps,1,sizeof(char *)); InitLEPostOperation(Resolution_P, DofData_P0, GeoData_P0, LEPostOp_L, LEPostOpNames_L, PostOpSolPredicted_L); // Some other necessary initializations if(Flag_RESTART && NbrSolutions > 1) Current.DTime = ((struct Solution*)List_Pointer(DofData_P->Solutions, NbrSolutions-1))->Time - ((struct Solution*)List_Pointer(DofData_P->Solutions, NbrSolutions-2))->Time; else Current.DTime = DTimeInit; if(Flag_RESTART) { if (Current.Time < TimeMax) Flag_RESTART = 0 ; } else Current.Time = Time0 ; Current.TimeStep += 1.0; TLATimeStep = 1; // Starting with 1st order (Backward Euler corrector) Order = 1; if (TypeTime == TIME_THETA) Current.Theta = 1.0; BreakpointListCreated = !Breakpoints_L; if (BreakpointListCreated) Breakpoints_L = List_Create(1,1,sizeof(double)); List_Add(Breakpoints_L, &TimeMax); List_Sort(Breakpoints_L, fcmp_double); BreakpointNum = 0; BreakpointAtNextStep = false; List_Read(Breakpoints_L, BreakpointNum, &nextBreakpoint); FirstTimePoint = Current.Time+Current.DTime; Current.Breakpoint = List_ISearchSeq(Breakpoints_L, &FirstTimePoint, fcmp_double); if (Current.Breakpoint >= 0) { BreakpointAtNextStep = true; DTimeBeforeBreakpoint = Current.DTime; } for (int i = 0; i < List_Nbr(Breakpoints_L); i++){ List_Read(Breakpoints_L, i, &nextBreakpoint); if (nextBreakpoint > (FirstTimePoint + DTimeMin)) { BreakpointNum = i; break; } } Try = 0; // Start the time loop // ------------------- while (Current.Time < TimeMax) { if(Message::GetOnelabAction() == "stop") break; Message::SetOperatingInTimeLoopAdaptive(true); Current.TypeTime = TypeTime; Current.Time += Current.DTime; Save_DTime = Current.DTime; Save_Time = Current.Time; Save_TimeStep = Current.TimeStep; Save_Theta = Current.Theta; Try++; BreakpointAtThisStep = BreakpointAtNextStep; Message::SetLastPETScError(0); Message::Info("Time step %d Try %d Time = %.8g s Stepsize = %.8g s Integr. Order = %d", (int)Current.TimeStep, Try, Current.Time, Current.DTime, Order); if(Message::GetProgressMeterStep() > 0 && Message::GetProgressMeterStep() < 100){ Message::AddOnelabNumberChoice(Message::GetOnelabClientName() + "/TimeLoopAdaptive/Time", Current.Time); Message::AddOnelabNumberChoice(Message::GetOnelabClientName() + "/TimeLoopAdaptive/DTime", Current.DTime); } // Calculate integration coefficients CalcIntegrationCoefficients(Resolution_P, DofData_P0,TLAsystems_L, LEPostOp_L, Order); // Execute predictor Predictor(Resolution_P, DofData_P0, TLAsystems_L, LEPostOp_L, Order, xPredicted_L, PostOpSolPredicted_L); if (NbrPostOps && TimeStepAccepted) Free_UnusedPOresults(); // Execute corrector // ----------------- Flag_IterativeLoopConverged = 1; Treatment_Operation(Resolution_P, Operation_P->Case.TimeLoopAdaptive.Operation, DofData_P0, GeoData_P0, NULL, NULL) ; Current.Time = Save_Time; Current.TypeTime = TypeTime; Current.DTime = Save_DTime; Current.TimeStep = Save_TimeStep; Current.Theta = Save_Theta; if(*Flag_Break) { *Flag_Break = 0; Message::Info("Flag Break detected. Aborting TimeLoopAdaptive"); break; } // Assessing the current time step and eventually // execute the 2nd set of operations // ---------------------------------------------- if (Flag_IterativeLoopConverged != 1){ TimeStepAccepted = false; DTimeScal = DTimeScal_NotConverged; Message::Info("Time step %d Try %d Time = %.8g s rejected (IterativeLoop not " "converged)", (int)Current.TimeStep, Try, Current.Time); } else if (Message::GetLastPETScError()) { TimeStepAccepted = false; Flag_IterativeLoopConverged = 0; DTimeScal = DTimeScal_PETScError; Message::Warning("Time step %d Try %d Time = %.8g s rejected:", (int)Current.TimeStep, Try, Current.Time); Message::Warning("No valid solution found (PETSc-Error: %d)!", Message::GetLastPETScError()); Message::SetLastPETScError(0); } else{ if (NbrPostOps) // Execute the PostOperations if necessary Operation_PostOperation(Resolution_P, DofData_P0, GeoData_P0, LEPostOpNames_L); maxLTEratio = CalcMaxLTEratio(Resolution_P, DofData_P0, TLAsystems_L, LEPostOp_L, Order, xPredicted_L, PostOpSolPredicted_L); if (maxLTEratio != maxLTEratio) { // If maxLTEratio = NaN => There was no valid solution! TimeStepAccepted = false; Flag_IterativeLoopConverged = 0; DTimeScal = DTimeScal_PETScError; Message::Info("Time step %d Try %d Time = %.8g s rejected: No valid solution " "found (NaN or Inf)!", (int)Current.TimeStep, Try, Current.Time); } else { if(Message::GetVerbosity() > 4) Message::AddOnelabNumberChoice(Message::GetOnelabClientName() + "/TimeLoopAdaptive/LTEmaxErrorRatio", maxLTEratio); if (maxLTEratio <= 1.0){ TimeStepAccepted = true; Message::Info("Time step %d Try %d Time = %.8g s accepted (max. LTE ratio = %.3g)", (int)Current.TimeStep, Try, Current.Time, maxLTEratio); } else{ TimeStepAccepted = false; Message::Info("Time step %d Try %d Time = %.8g s rejected (max. LTE ratio = %.3g)", (int)Current.TimeStep, Try, Current.Time, maxLTEratio); } } } if (TimeStepAccepted == true) { Treatment_Operation(Resolution_P, Operation_P->Case.TimeLoopAdaptive.OperationEnd, DofData_P0, GeoData_P0, NULL, NULL) ; Current.Time = Save_Time; Current.TypeTime = TypeTime; Current.DTime = Save_DTime; Current.TimeStep = Save_TimeStep; Current.Theta = Save_Theta; Current.TimeStep += 1.; TLATimeStep += 1; Try = 0; } else{ if (BreakpointAtThisStep) { BreakpointNum = List_ISearchSeq(Breakpoints_L, &Current.Time, fcmp_double); List_Read(Breakpoints_L, BreakpointNum, &nextBreakpoint); } Current.Time -= Current.DTime; BreakpointAtThisStep = (bool) List_Search(Breakpoints_L, &Current.Time, fcmp_double); } if(*Flag_Break) { *Flag_Break = 0; Message::Info("Flag Break detected. Aborting TimeLoopAdaptive"); break; } // Calculate new time step // ----------------------- DTimeMinAtLastStep = Current.DTime <= DTimeMin; if (TimeStepAccepted == false && DTimeMinAtLastStep && Order < 2) Message::Error("Time step too small! Simulation aborted!"); if (Flag_IterativeLoopConverged == 1){ // Milne's estimate if (maxLTEratio <= 0) DTimeScal = DTimeMaxScal; else { if (Current.TimeStep < 1.5 || (NbrPostOps > 0 && TLATimeStep <= 2) ) // linear adjustment because predictor is of order 0 DTimeScal = LTEtarget/maxLTEratio; else DTimeScal = pow(LTEtarget/maxLTEratio, 1./(Order+1.)); } if (DTimeScal >= DTimeMaxScal) { if (BreakpointAtThisStep) { double dt1, dt2, dtmax; dt1 = Current.DTime * DTimeMaxScal; dt2 = DTimeBeforeBreakpoint; dtmax = (dt1 > dt2) ? dt1 : dt2; DTimeScal = dtmax / Current.DTime; } else DTimeScal = DTimeMaxScal; } } Current.DTime *= DTimeScal; // Limit the max step size if (Current.DTime > DTimeMax) Current.DTime = DTimeMax; // Check that we do not jump over a breakpoint if ((Current.DTime + Current.Time >= nextBreakpoint - DTimeMin) && (BreakpointNum >= 0)){ DTimeBeforeBreakpoint = Current.DTime; Current.DTime = nextBreakpoint - Current.Time; BreakpointAtNextStep = true; Current.Breakpoint = BreakpointNum; if (BreakpointNum < List_Nbr(Breakpoints_L)-1){ // There are further breakpoints BreakpointNum++; List_Read(Breakpoints_L, BreakpointNum, &nextBreakpoint); } else //No further breakpoint BreakpointNum = -1; } else { BreakpointAtNextStep = false; Current.Breakpoint = -1.; } // Limit the min step size if (Current.DTime < DTimeMin) Current.DTime = DTimeMin; // Adjust order // ------------ if ( Flag_IterativeLoopConverged != 1 || // BreakpointAtThisStep || DTimeMinAtLastStep ) Order = 1; else if ( TLATimeStep > 2 && Current.DTime > DTimeMin && TimeStepAccepted && !BreakpointAtThisStep && Order < MaxOrder ) Order++; if (TypeTime == TIME_THETA) switch(Order){ case 1: Current.Theta = 1.0; // Corrector: Backward Euler break; case 2: Current.Theta = 0.5; // Corrector: Trapezoidal Method break; default : Message::Error("Order %d not allowed for Theta scheme.", Order); break; } } // while loop Message::SetOperatingInTimeLoopAdaptive(false); Current.TimeStep -= 1.; // Correct the time step counter // Finally clean up, destroy vectors and delete lists // -------------------------------------------------- for(int i = 0; i < List_Nbr(TLAsystems_L); i++) LinAlg_DestroyVector((gVector*)List_Pointer(xPredicted_L, i)); List_Delete(TLAsystems_L); List_Delete(xPredicted_L); ClearLEPostOperation(Resolution_P, DofData_P0, GeoData_P0, LEPostOp_L, LEPostOpNames_L, PostOpSolPredicted_L, true); if (BreakpointListCreated) List_Delete(Breakpoints_L); } getdp-2.7.0-source/Legacy/DofData.h000644 001750 001750 00000016727 12547137403 020503 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _DOFDATA_H_ #define _DOFDATA_H_ #include #include "ListUtils.h" #include "TreeUtils.h" #include "LinAlg.h" #define DOF_PRE 1 #define DOF_RES 2 #define DOF_TMP 3 struct Solution { int TimeStep ; /* Must be first member of struct (for searching purposes) */ double Time, TimeImag ; int SolutionExist ; double * TimeFunctionValues, ExplicitTimeFunctionValue ; gVector x ; } ; struct Dof { int NumType ; /* Key 1 */ int Entity ; /* Key 2 */ int Harmonic ; /* Key 3 */ int Type ; /* Val must be out of the union (a member with constructor (gScalar with PETSc) is not allowed in a union); Val holds the init value for Type==Unknown, and the assigned value for Type==FixedAssociate. Val is not used for Type==Link. Val2 potentially holds a second init value for Type==Unknown */ gScalar Val, Val2 ; union { struct { int NumDof ; /* Equation number - 1st position */ bool NonLocal ; /* Set to true if equation is non-local */ } Unknown ; struct { int NumDof ; /* Equation number (Associate) - 1st position */ int TimeFunctionIndex ; } FixedAssociate ; struct { int EntityRef ; double Coef, Coef2 ; struct Dof * Dof ; } Link ; } Case ; } ; /* Dof.Type */ /* definitive in preprocessing and processing */ #define DOF_UNKNOWN 1 /* unknown */ #define DOF_FIXED 2 /* spatial fixed */ #define DOF_FIXEDWITHASSOCIATE 3 /* associate */ #define DOF_LINK 7 /* link */ #define DOF_LINKCPLX 8 /* linkcplx */ /* definitive in a preprocessing */ #define DOF_UNKNOWN_INIT 5 /* initial condition */ /* temporary */ #define DOF_FIXED_SOLVE 4 /* waiting to be fixed by a resolution */ #define DOF_FIXEDWITHASSOCIATE_SOLVE 6 /* waiting to be fixed by a resolution */ struct CorrectionSolutions { List_T * Solutions ; } ; struct DofData { int Num ; int ResolutionIndex, SystemIndex ; int GeoDataIndex ; List_T * FunctionSpaceIndex ; List_T * TimeFunctionIndex ; List_T * Pulsation ; int NbrHar ; double * Val_Pulsation ; int NbrAnyDof, NbrDof ; Tree_T * DofTree ; List_T * DofList ; int * DummyDof ; char * SolverDataFileName ; List_T * Solutions ; struct Solution * CurrentSolution ; struct Solution * Save_CurrentSolution ; struct { int Flag ; List_T * Save_FullSolutions ; struct Solution * Save_CurrentFullSolution ; List_T * AllSolutions ; } CorrectionSolutions ; int Flag_RHS ; // only assemble RHS int Flag_Init[7] ; int Flag_Only ; int Flag_InitOnly[3] ; // For recalculating only the matrices that are required List_T *OnlyTheseMatrices ; // Flag_Init[0] == 1 || Flag_Init[0] == 2 gMatrix A; gVector b; gSolver Solver; // Flag_Init[0] == 2 gMatrix Jac ; gVector res, dx ; // Flag_Init[1,2,3,4,5,6] == 1 gMatrix M1, M2, M3, M4, M5, M6; gVector m1, m2, m3, m4, m5, m6; List_T *m1s, *m2s, *m3s, *m4s, *m5s, *m6s; // Flag_Only and Flag_InitOnly[0,1,2] gMatrix A1, A2, A3 ; gVector b1, b2, b3 ; gMatrix A_MH_moving ; gVector b_MH_moving ; std::vector NonLocalEquations; } ; int fcmp_Dof(const void * a, const void * b) ; void Dof_InitDofData(struct DofData * DofData_P, int Num, int ResolutionIndex, int SystemIndex, char * Name_SolverDataFile) ; void Dof_FreeDofData(struct DofData * DofData_P) ; void Dof_SetCurrentDofData(struct DofData * DofData_P) ; void Dof_OpenFile(int Type, char * Name, const char * Mode) ; void Dof_CloseFile(int Type) ; void Dof_FlushFile(int Type) ; void Dof_WriteFilePRE0(int Num_Resolution, char * Name_Resolution, int Nbr_DofData) ; void Dof_ReadFilePRE0(int * Num_Resolution, int * Nbr_DofData) ; void Dof_WriteFilePRE(struct DofData * DofData_P) ; void Dof_WriteDofPRE(void * a, void * b) ; void Dof_ReadFilePRE(struct DofData * DofData_P) ; void Dof_WriteFileRES0(char * Name_File, int Format) ; void Dof_ReadFileRES0(void) ; void Dof_WriteFileRES(char * Name_File, struct DofData * DofData_P, int Format, double Val_Time, double Val_TimeImag, int Val_TimeStep) ; void Dof_ReadFileRES(List_T * DofData_L, struct DofData * Read_DofData_P, int Read_DofData, double *Time, double *TimeImag, double *TimeStep) ; void Dof_WriteFileRES_ExtendMH(char * Name_File, struct DofData * DofData_P, int Format, int NbrH); void Dof_WriteFileRES_MHtoTime(char * Name_File, struct DofData * DofData_P, int Format, List_T * Time_L); void Dof_WriteFileRES_WithEntityNum(char * Name_File, struct DofData * DofData_P, struct GeoData * GeoData_P0, struct Group * Group_P, bool saveFixed); void Dof_TransferDofTreeToList(struct DofData * DofData_P) ; void Dof_InitDofType(struct DofData * DofData_P) ; void Dof_DeleteDofTree(struct DofData * DofData_P) ; void Dof_AddFunctionSpaceIndex(int Index_FunctionSpace) ; void Dof_AddTimeFunctionIndex(int Index_TimeFunction) ; void Dof_AddPulsation(struct DofData * DofData_P, double Val_Pulsation) ; void Dof_DefineAssignFixedDof(int D1, int D2, int NbrHar, double * Val, int Index_TimeFunction) ; void Dof_DefineInitFixedDof(int D1, int D2, int NbrHar, double * Val, double *Val2, bool NonLocal=false) ; void Dof_DefineAssignSolveDof(int D1, int D2, int NbrHar, int Index_TimeFunction) ; void Dof_DefineInitSolveDof(int D1, int D2, int NbrHar) ; void Dof_DefineLinkDof(int D1, int D2, int NbrHar, double Value[], int D2_Link) ; void Dof_DefineLinkCplxDof(int D1, int D2, int NbrHar, double Value[], int D2_Link) ; void Dof_DefineUnknownDof(int D1, int D2, int NbrHar, bool NonLocal=false) ; void Dof_DefineAssociateDof(int E1, int E2, int D1, int D2, int NbrHar, int init, double * Val) ; void Dof_DefineUnknownDofFromSolveOrInitDof(struct DofData ** DofData_P) ; void Dof_NumberUnknownDof(void) ; void Dof_UpdateAssignFixedDof(int D1, int D2, int NbrHar, double *Val) ; void Dof_UpdateLinkDof(int D1, int D2, int NbrHar, double Value[], int D2_Link) ; void Dof_AssembleInMat(struct Dof * Equ_P, struct Dof * Dof_P, int NbrHar, double * Val, gMatrix * Mat, gVector * Vec, List_T *Vecs=0) ; void Dof_AssembleInVec(struct Dof * Equ_P, struct Dof * Dof_P, int NbrHar, double * Val, struct Solution * OtherSolution, gVector * Vec0, gVector * Vec) ; void Dof_TransferSolutionToConstraint(struct DofData * DofData_P) ; void Dof_TransferDof(struct DofData * DofData1_P, struct DofData ** DofData2_P); struct Dof * Dof_GetDofStruct(struct DofData * DofData_P, int D1, int D2, int D3) ; gScalar Dof_GetDofValue(struct DofData * DofData_P, struct Dof * Dof_P) ; void Dof_GetRealDofValue(struct DofData * DofData_P, struct Dof * Dof_P, double *d) ; void Dof_GetComplexDofValue(struct DofData * DofData_P, struct Dof * Dof_P, double *d1, double *d2) ; void Dof_GetDummies(struct DefineSystem * DefineSystem_P, struct DofData * DofData_P) ; void Dof_InitDofForNoDof(struct Dof * DofForNoDof, int NbrHar) ; void Print_DofNumber(struct Dof *Dof_P) ; #endif getdp-2.7.0-source/Legacy/EigenSolve.h000644 001750 001750 00000001335 12473553042 021225 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _EIGEN_SOLVE_H_ #define _EIGEN_SOLVE_H_ #include "DofData.h" void EigenSolve(struct DofData * DofData_P, int NumEigenvalues, double shift_r, double shift_i, int FilterExpressionIndex); void EigenSolve_ARPACK(struct DofData * DofData_P, int NumEigenvalues, double shift_r, double shift_i, int FilterExpressionIndex); void EigenSolve_SLEPC(struct DofData * DofData_P, int NumEigenvalues, double shift_r, double shift_i, int FilterExpressionIndex); #endif getdp-2.7.0-source/Legacy/Pos_Formulation.cpp000644 001750 001750 00000050310 12553357400 022634 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include #include "ProData.h" #include "DofData.h" #include "GeoData.h" #include "Get_DofOfElement.h" #include "Cal_Quantity.h" #include "Pos_Print.h" #include "Pos_Format.h" #include "ListUtils.h" #include "Message.h" #include "OS.h" #if defined(HAVE_GMSH) #include #include #include #include #include #endif #include "MallocUtils.h" #include "SolvingAnalyse.h" #if defined(HAVE_GSL) #include #include #endif #define TWO_PI 6.2831853071795865 extern struct Problem Problem_S ; extern struct CurrentData Current ; extern int Flag_BIN, Flag_GMSH_VERSION ; extern char *Name_Path ; FILE *PostStream = stdout; char PostFileName[256]; /* ------------------------------------------------------------------------ */ /* P o s _ F e m F o r m u l a t i o n */ /* ------------------------------------------------------------------------ */ void Pos_FemFormulation(struct Formulation *Formulation_P, struct PostQuantity *NCPQ_P, struct PostQuantity *CPQ_P, int Order, struct PostSubOperation *PostSubOperation_P) { struct Element Element ; struct DefineQuantity *DefineQuantity_P0 ; struct QuantityStorage *QuantityStorage_P0, QuantityStorage ; List_T *QuantityStorage_L ; int i ; Get_InitDofOfElement(&Element) ; DefineQuantity_P0 = (struct DefineQuantity*) List_Pointer(Formulation_P->DefineQuantity, 0) ; QuantityStorage_L = List_Create(List_Nbr(Formulation_P->DefineQuantity), 1, sizeof (struct QuantityStorage) ) ; for(i = 0 ; i < List_Nbr(Formulation_P->DefineQuantity) ; i++) { QuantityStorage.DefineQuantity = DefineQuantity_P0 + i ; if(QuantityStorage.DefineQuantity->Type == INTEGRALQUANTITY && QuantityStorage.DefineQuantity->IntegralQuantity.DefineQuantityIndexDof < 0){ QuantityStorage.TypeQuantity = VECTOR ; /* on ne sait pas... */ } else{ QuantityStorage.TypeQuantity = ((struct FunctionSpace *) List_Pointer(Problem_S.FunctionSpace, (DefineQuantity_P0+i)->FunctionSpaceIndex))->Type ; } QuantityStorage.NumLastElementForFunctionSpace = 0 ; List_Add(QuantityStorage_L, &QuantityStorage) ; } QuantityStorage_P0 = (struct QuantityStorage*)List_Pointer(QuantityStorage_L, 0) ; switch (PostSubOperation_P->Type) { case POP_PRINT : switch (PostSubOperation_P->SubType) { case PRINT_ONREGION : Pos_PrintOnRegion(NCPQ_P, CPQ_P, Order, DefineQuantity_P0, QuantityStorage_P0, PostSubOperation_P) ; break ; case PRINT_ONELEMENTSOF : case PRINT_ONGRID : Pos_PrintOnElementsOf(NCPQ_P, CPQ_P, Order, DefineQuantity_P0, QuantityStorage_P0, PostSubOperation_P) ; break ; case PRINT_ONSECTION_1D : case PRINT_ONSECTION_2D : Pos_PrintOnSection(NCPQ_P, CPQ_P, Order, DefineQuantity_P0, QuantityStorage_P0, PostSubOperation_P) ; break ; case PRINT_ONGRID_0D : case PRINT_ONGRID_1D : case PRINT_ONGRID_2D : case PRINT_ONGRID_3D : case PRINT_ONGRID_PARAM : Pos_PrintOnGrid(NCPQ_P, CPQ_P, Order, DefineQuantity_P0, QuantityStorage_P0, PostSubOperation_P) ; break ; case PRINT_WITHARGUMENT : Pos_PrintWithArgument(NCPQ_P, CPQ_P, Order, DefineQuantity_P0, QuantityStorage_P0, PostSubOperation_P) ; break ; default : Message::Error("Unknown Operation type for Print"); break; } break ; case POP_EXPRESSION : Pos_PrintExpression(PostSubOperation_P); break; case POP_GROUP : Pos_PrintGroup(PostSubOperation_P); break; default : Message::Error("Unknown PostSubOperation type") ; break; } List_Delete(QuantityStorage_L); } /* ------------------------------------------------------------------------ */ /* P o s _ I n i t T i m e S t e p s */ /* ------------------------------------------------------------------------ */ int Pos_InitTimeSteps(struct PostSubOperation *PostSubOperation_P) { int iTime, NbTimeStep; // last time step only if(PostSubOperation_P->LastTimeStepOnly || PostSubOperation_P->AppendTimeStepToFileName){ iTime = List_Nbr(Current.DofData->Solutions) - 1; List_Reset(PostSubOperation_P->TimeStep_L); List_Add(PostSubOperation_P->TimeStep_L, &iTime); return 1; } // specific time values if(List_Nbr(PostSubOperation_P->TimeValue_L) || List_Nbr(PostSubOperation_P->TimeImagValue_L)){ List_Reset(PostSubOperation_P->TimeStep_L); for(int i = 0; i < List_Nbr(Current.DofData->Solutions); i++){ Solution *s = (struct Solution*)List_Pointer(Current.DofData->Solutions, i); int step = s->TimeStep; double time = s->Time, timeImag = s->TimeImag; for(int j = 0; j < List_Nbr(PostSubOperation_P->TimeValue_L); j++){ double t; List_Read(PostSubOperation_P->TimeValue_L, j, &t); if(fabs(t - time) < 1.e-15){ List_Insert(PostSubOperation_P->TimeStep_L, &step, fcmp_double); } } for(int j = 0; j < List_Nbr(PostSubOperation_P->TimeImagValue_L); j++){ double t; List_Read(PostSubOperation_P->TimeImagValue_L, j, &t); if(fabs(t - timeImag) < 1.e-15) List_Insert(PostSubOperation_P->TimeStep_L, &step, fcmp_double); } } NbTimeStep = List_Nbr(PostSubOperation_P->TimeStep_L); if(NbTimeStep) return NbTimeStep; } // specific time steps NbTimeStep = List_Nbr(PostSubOperation_P->TimeStep_L); if(!NbTimeStep || !PostSubOperation_P->FrozenTimeStepList){ NbTimeStep = List_Nbr(Current.DofData->Solutions); List_Reset(PostSubOperation_P->TimeStep_L); for(iTime = 0 ; iTime < NbTimeStep ; iTime++) List_Add(PostSubOperation_P->TimeStep_L, &iTime); } return NbTimeStep; } /* ------------------------------------------------------------------------ */ /* P o s _ I n i t A l l S o l u t i o n s */ /* ------------------------------------------------------------------------ */ void Pos_InitAllSolutions(List_T * TimeStep_L, int Index_TimeStep) { int TimeStepIndex, k, Num_Solution ; List_Read(TimeStep_L, Index_TimeStep, &TimeStepIndex) ; for(k = 0 ; k < Current.NbrSystem ; k++) if( (Num_Solution = std::min(List_Nbr((Current.DofData_P0+k)->Solutions)-1, TimeStepIndex)) >=0 ) (Current.DofData_P0+k)->CurrentSolution = (struct Solution*) List_Pointer((Current.DofData_P0+k)->Solutions, Num_Solution) ; if(TimeStepIndex >= 0 && TimeStepIndex < List_Nbr(Current.DofData->Solutions)){ Solution *Solution_P = ((struct Solution*)List_Pointer (Current.DofData->Solutions, TimeStepIndex)); Current.TimeStep = Solution_P->TimeStep ; Current.Time = Solution_P->Time ; Current.TimeImag = Solution_P->TimeImag ; } else{ // Warning: this can be wrong Current.TimeStep = TimeStepIndex; if(Current.DofData->CurrentSolution){ Current.Time = Current.DofData->CurrentSolution->Time; Current.TimeImag = Current.DofData->CurrentSolution->TimeImag; } } } /* ------------------------------------------------------------------------ */ /* P o s _ R e s a m p l e T i m e */ /* ------------------------------------------------------------------------ */ #if !defined(HAVE_GSL) void Pos_ResampleTime(struct PostOperation *PostOperation_P) { Message::Error("ResampleTime requires the GSL"); } #else void Pos_ResampleTime(struct PostOperation *PostOperation_P) { double ResampleTimeStart, ResampleTimeStop, ResampleTimeStep; double OriginalStopTime, *OriginalTime_P, *OriginalValueR_P, *OriginalValueI_P; double InterpValueRe, InterpValueIm; int OriginalNbrOfSolutions, NewNbrOfSolutions, xLength; Solution *Solution_P, Solution_S; List_T *NewSolutions_L; ResampleTimeStart = PostOperation_P->ResampleTimeStart; ResampleTimeStop = PostOperation_P->ResampleTimeStop; ResampleTimeStep = PostOperation_P->ResampleTimeStep; OriginalNbrOfSolutions = List_Nbr(Current.DofData->Solutions); OriginalTime_P = (double *)Malloc(OriginalNbrOfSolutions * sizeof(double)); OriginalValueR_P = (double *)Malloc(OriginalNbrOfSolutions * sizeof(double)); if (gSCALAR_SIZE == 2) OriginalValueI_P = (double *)Malloc(OriginalNbrOfSolutions * sizeof(double)); else OriginalValueI_P = NULL; Solution_P = (struct Solution*)List_Pointer(Current.DofData->Solutions, OriginalNbrOfSolutions-1); OriginalStopTime = Solution_P->Time; ResampleTimeStop = (OriginalStopTime < ResampleTimeStop) ? OriginalStopTime : ResampleTimeStop; for (int i=0; iSolutions, i); if (!Solution_P->SolutionExist) Message::Error("Empty solution(s) found"); OriginalTime_P[i] = Solution_P->Time; } LinAlg_GetVectorSize(&Solution_P->x, &xLength); NewNbrOfSolutions = floor((ResampleTimeStop-ResampleTimeStart) / ResampleTimeStep) + 1; if (NewNbrOfSolutions < 1) Message::Error("Invalid ResampleTime settings - t_start: %.6g t_stop: %.6g " "t_sample: %.6g", ResampleTimeStart, ResampleTimeStop, ResampleTimeStep); NewSolutions_L = List_Create(NewNbrOfSolutions, 1, sizeof(Solution)); for (int i=0; iSolver, xLength); List_Add(NewSolutions_L, &Solution_S); } for (int i=0; iSolutions, j); LinAlg_GetDoubleInVector(&OriginalValueR_P[j], &Solution_P->x, i); } gsl_interp_accel *acc = gsl_interp_accel_alloc (); gsl_spline *spline = gsl_spline_alloc (gsl_interp_cspline, OriginalNbrOfSolutions); gsl_spline_init (spline, OriginalTime_P, OriginalValueR_P, OriginalNbrOfSolutions); for (int j=0; jTime, acc); LinAlg_SetDoubleInVector(InterpValueRe, &Solution_P->x, i); } gsl_spline_free (spline); gsl_interp_accel_free (acc); } if (gSCALAR_SIZE == 2) { for (int j=0; jSolutions, j); LinAlg_GetComplexInVector(&OriginalValueR_P[j], &OriginalValueI_P[j], &Solution_P->x, i, -1); } gsl_interp_accel *accRe = gsl_interp_accel_alloc (); gsl_interp_accel *accIm = gsl_interp_accel_alloc (); gsl_spline *splineRe = gsl_spline_alloc (gsl_interp_cspline, OriginalNbrOfSolutions); gsl_spline *splineIm = gsl_spline_alloc (gsl_interp_cspline, OriginalNbrOfSolutions); gsl_spline_init (splineRe, OriginalTime_P, OriginalValueR_P, OriginalNbrOfSolutions); gsl_spline_init (splineIm, OriginalTime_P, OriginalValueI_P, OriginalNbrOfSolutions); for (int j=0; jTime, accRe); InterpValueIm = gsl_spline_eval (splineIm, Solution_P->Time, accIm); LinAlg_SetComplexInVector(InterpValueRe, InterpValueIm, &Solution_P->x, i, -1); } gsl_spline_free (splineRe); gsl_spline_free (splineIm); gsl_interp_accel_free (accRe); gsl_interp_accel_free (accIm); } } Current.DofData->Solutions = NewSolutions_L; Current.DofData->CurrentSolution = (struct Solution*) List_Pointer(NewSolutions_L, List_Nbr(NewSolutions_L)-1) ; for (int j=0; jSolutions, j); Solution_P->TimeFunctionValues = Get_TimeFunctionValues(Current.DofData) ; } Free(OriginalTime_P); Free(OriginalValueR_P); Free(OriginalValueI_P); } #endif /* ------------------------------------------------------------------------ */ /* P o s _ F o r m u l a t i o n */ /* ------------------------------------------------------------------------ */ void Pos_Formulation(struct Formulation *Formulation_P, struct PostProcessing *PostProcessing_P, struct PostSubOperation *PostSubOperation_P) { struct PostQuantity *NCPQ_P = NULL, *CPQ_P = NULL ; double Pulsation ; int i, Order = 0 ; if(PostSubOperation_P->Type == POP_MERGE){ Message::SendMergeFileRequest(PostSubOperation_P->FileOut); return; } if(PostSubOperation_P->FileOut){ if(PostSubOperation_P->FileOut[0] == '/' || PostSubOperation_P->FileOut[0] == '\\'){ strcpy(PostFileName, PostSubOperation_P->FileOut); } else{ strcpy(PostFileName, Name_Path); strcat(PostFileName, PostSubOperation_P->FileOut); } if(PostSubOperation_P->AppendExpressionToFileName >= 0) { struct Value Value ; Get_ValueOfExpressionByIndex(PostSubOperation_P->AppendExpressionToFileName, NULL, 0., 0., 0., &Value) ; char AddExt[100]; if(PostSubOperation_P->AppendExpressionFormat) sprintf(AddExt, PostSubOperation_P->AppendExpressionFormat, Value.Val[0]); else sprintf(AddExt, "%.16g", Value.Val[0]); strcat(PostFileName, AddExt); } if(PostSubOperation_P->AppendTimeStepToFileName) { char AddExt[100] ; sprintf(AddExt, "_%03d", (PostSubOperation_P->OverrideTimeStepValue >= 0) ? PostSubOperation_P->OverrideTimeStepValue : (int)Current.TimeStep) ; strcat(PostFileName, AddExt); } if(PostSubOperation_P->AppendStringToFileName) { strcat(PostFileName, PostSubOperation_P->AppendStringToFileName); } if(Message::GetIsCommWorld() && Message::GetCommRank()){ // in parallel mode (SetCommWorld), only rank 0 prints output PostStream = NULL ; } else if(!PostSubOperation_P->CatFile) { if((PostStream = FOpen(PostFileName, Flag_BIN ? "wb" : "w"))) Message::Direct(4, " > '%s'", PostFileName) ; else{ Message::Error("Unable to open file '%s'", PostFileName) ; PostStream = stdout ; } } else { if((PostStream = FOpen(PostFileName, Flag_BIN ? "ab" : "a"))) Message::Direct(4, " >> '%s'", PostFileName) ; else{ Message::Error("Unable to open file '%s'", PostFileName) ; PostStream = stdout ; } } } else{ PostStream = stdout ; } // force Gmsh version 1 for anything else than OnElementsOf, or if we store in // memory (which requires old-style list ordering) int oldVersion = Flag_GMSH_VERSION; if(PostSubOperation_P->SubType != PRINT_ONELEMENTSOF || PostSubOperation_P->Depth != 1 || PostSubOperation_P->StoreInField >= 0) Flag_GMSH_VERSION = 1; if(PostSubOperation_P->StoreInField >= 0 && PostSubOperation_P->Format != FORMAT_GMSH) Message::Warning("StoreInField only available with Gmsh output format"); if(PostSubOperation_P->StoreInMeshBasedField >= 0){ Flag_GMSH_VERSION = 2; if(PostSubOperation_P->SubType != PRINT_ONELEMENTSOF || PostSubOperation_P->Depth != 1) Message::Error("StoreInMeshBasedField not compatible with selected options"); } if(PostStream && PostSubOperation_P->CatFile == 2) fprintf(PostStream, "\n\n") ; /* two blanks lines for -index in gnuplot */ Format_PostFormat(PostSubOperation_P) ; if(PostSubOperation_P->PostQuantityIndex[0] >= 0) { if(PostSubOperation_P->PostQuantitySupport[0] < 0) { /* Noncumulative */ NCPQ_P = (struct PostQuantity *) List_Pointer(PostProcessing_P->PostQuantity, PostSubOperation_P->PostQuantityIndex[0]) ; CPQ_P = (PostSubOperation_P->PostQuantityIndex[1] >= 0) ? (struct PostQuantity *)List_Pointer(PostProcessing_P->PostQuantity, PostSubOperation_P->PostQuantityIndex[1]) : NULL ; Order = 1 ; } else { CPQ_P = (struct PostQuantity *) List_Pointer(PostProcessing_P->PostQuantity, PostSubOperation_P->PostQuantityIndex[0]) ; NCPQ_P = (PostSubOperation_P->PostQuantityIndex[1] >= 0) ? (struct PostQuantity *)List_Pointer(PostProcessing_P->PostQuantity, PostSubOperation_P->PostQuantityIndex[1]) : NULL ; Order = 0 ; } } if(List_Nbr(PostSubOperation_P->Frequency_L)){ if(List_Nbr(PostSubOperation_P->Frequency_L) > List_Nbr(Current.DofData->Pulsation)) Message::Error("Too many frequencies specified in PostOperation"); else{ for(i = 0 ; i < List_Nbr(PostSubOperation_P->Frequency_L) ; i++){ Pulsation = *((double *)List_Pointer(PostSubOperation_P->Frequency_L, i)) * TWO_PI ; List_Write(Current.DofData->Pulsation, i, &Pulsation) ; } } } switch (Formulation_P->Type) { case FEMEQUATION : Pos_FemFormulation(Formulation_P, NCPQ_P, CPQ_P, Order, PostSubOperation_P) ; break ; case GLOBALEQUATION : break ; default : Message::Error("Unknown Type for Formulation (%s)", Formulation_P->Name) ; break; } Flag_GMSH_VERSION = oldVersion; if(PostStream && PostSubOperation_P->FileOut){ fclose(PostStream) ; if(PostSubOperation_P->SendToServer == NULL || strcmp(PostSubOperation_P->SendToServer, "No")){ if(PostSubOperation_P->Format == FORMAT_GMSH_PARSED || PostSubOperation_P->Format == FORMAT_GMSH){ // send merge request Message::SendMergeFileRequest(PostFileName); } // Add link to file Message::AddOnelabStringChoice(Message::GetOnelabClientName() + "/9Output files", "file", PostFileName); } /* NewCoordinates print option: write a new mesh */ if(PostSubOperation_P->NewCoordinates){ #if defined(HAVE_GMSH) GmshMergeFile(std::string(PostFileName)); int iview = PView::list.size() - 1; PViewData *data = PView::list[iview]->getData(); GModel* m = new GModel(); m->readMSH(std::string(Current.GeoData->Name)); std::vector entities; m->getEntities(entities); std::map, MVertexLessThanNum> newcoords; for(unsigned int i = 0; i < entities.size(); i++) { for(unsigned int j = 0; j < entities[i]->mesh_vertices.size(); j++) { MVertex* v = entities[i]->mesh_vertices[j]; std::vector xyz(3); if(!data->searchVector(v->x(), v->y(), v->z(), &xyz[0])) Message::Error("Did not find new coordinate Vector at point (%g,%g,%g) " "from file %s", v->x(), v->y(), v->z(), PostFileName); newcoords[v] = xyz; } } for(std::map, MVertexLessThanNum>::iterator it = newcoords.begin(); it != newcoords.end(); it++) { it->first->x() = it->second[0]; it->first->y() = it->second[1]; it->first->z() = it->second[2]; } char NewCoordsFileName[256]; if(PostSubOperation_P->NewCoordinatesFile[0] == '/' || PostSubOperation_P->NewCoordinatesFile[0] == '\\'){ strcpy(NewCoordsFileName, PostSubOperation_P->NewCoordinatesFile); } else{ strcpy(NewCoordsFileName, Name_Path); strcat(NewCoordsFileName, PostSubOperation_P->NewCoordinatesFile); } m->writeMSH(NewCoordsFileName); Message::Info("Wrote new coordinates in file %s", NewCoordsFileName); delete m; delete PView::list[iview]; PView::list.pop_back(); #else Message::Error("You need to compile GetDP with Gmsh support to use 'NewCoordinates'"); #endif } } } getdp-2.7.0-source/Legacy/Cal_AnalyticIntegration.cpp000644 001750 001750 00000005564 12473553042 024257 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "ProData.h" #include "BF.h" #include "Message.h" /* ------------------------------------------------------------------------ */ /* C a l _ A n a l y t i c I n t e g r a t i o n */ /* ------------------------------------------------------------------------ */ double Cal_AnalyticIntegration(struct Element * E, void (*BFEqu)(), void (*BFDof)(), int i, int j, double (*Cal_Productx)()) { double DetJ ; if ((E->Type != TRIANGLE) || (BFEqu != (void (*)())BF_GradNode) || (BFDof != (void (*)())BF_GradNode) ) { Message::Error("Unknown analytic method for integration") ; return 0.; } DetJ = (E->x[2] - E->x[0]) * (E->y[1] - E->y[0]) - (E->x[1] - E->x[0]) * (E->y[2] - E->y[0]) ; switch (i) { case 0 : switch (j) { case 0 : return( ((E->y[2]-E->y[1])*(E->y[2]-E->y[1]) + (E->x[1]-E->x[2])*(E->x[1]-E->x[2])) * fabs(DetJ) / (2. * DetJ * DetJ) ) ; case 1 : return( ((E->y[2]-E->y[1])*(E->y[0]-E->y[2]) + (E->x[1]-E->x[2])*(E->x[2]-E->x[0])) * fabs(DetJ) / (2. * DetJ * DetJ) ) ; case 2 : return( ((E->y[2]-E->y[1])*(E->y[1]-E->y[0]) + (E->x[1]-E->x[2])*(E->x[0]-E->x[1])) * fabs(DetJ) / (2. * DetJ * DetJ) ) ; default : Message::Error("Something wrong in Cal_AnalyticIntegration"); return 0. ; } case 1 : switch (j) { case 0 : return( ((E->y[2]-E->y[1])*(E->y[0]-E->y[2]) + (E->x[1]-E->x[2])*(E->x[2]-E->x[0])) * fabs(DetJ) / (2. * DetJ * DetJ) ) ; case 1 : return( ((E->y[0]-E->y[2])*(E->y[0]-E->y[2]) + (E->x[2]-E->x[0])*(E->x[2]-E->x[0])) * fabs(DetJ) / (2. * DetJ * DetJ) ) ; case 2 : return( ((E->y[0]-E->y[2])*(E->y[1]-E->y[0]) + (E->x[2]-E->x[0])*(E->x[0]-E->x[1])) * fabs(DetJ) / (2. * DetJ * DetJ) ) ; default : Message::Error("Something wrong in Cal_AnalyticIntegration"); return 0. ; } case 2 : switch (j) { case 0 : return( ((E->y[2]-E->y[1])*(E->y[1]-E->y[0]) + (E->x[1]-E->x[2])*(E->x[0]-E->x[1])) * fabs(DetJ) / (2. * DetJ * DetJ) ) ; case 1 : return( ((E->y[0]-E->y[2])*(E->y[1]-E->y[0]) + (E->x[2]-E->x[0])*(E->x[0]-E->x[1])) * fabs(DetJ) / (2. * DetJ * DetJ) ) ; case 2 : return( ((E->y[1]-E->y[0])*(E->y[1]-E->y[0]) + (E->x[0]-E->x[1])*(E->x[0]-E->x[1])) * fabs(DetJ) / (2. * DetJ * DetJ) ) ; default : Message::Error("Something wrong in Cal_AnalyticIntegration"); return 0.; } default : Message::Error("Something wrong in Cal_AnalyticIntegration"); return 0. ; } } getdp-2.7.0-source/Legacy/Pre_TermOfFemEquation.cpp000644 001750 001750 00000073732 12547137403 023673 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "ProData.h" #include "DofData.h" #include "Get_DofOfElement.h" #include "ExtendedGroup.h" #include "BF.h" #include "Message.h" extern struct Problem Problem_S ; extern struct CurrentData Current ; /* ------------------------------------------------------------------------ */ /* P r e _ I n i t T e r m O f F e m F o r m u l a t i o n */ /* ------------------------------------------------------------------------ */ void Pre_InitTermOfFemEquation(struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0) { struct DefineQuantity * DefineQuantity_P ; if (EquationTerm_P->Case.LocalTerm.Term.DefineQuantityIndexDof >= 0) { DefineQuantity_P = (QuantityStorage_P0 + EquationTerm_P->Case.LocalTerm.Term.DefineQuantityIndexDof)->DefineQuantity ; Dof_AddFunctionSpaceIndex(DefineQuantity_P->FunctionSpaceIndex) ; } if (EquationTerm_P->Case.LocalTerm.Term.DefineQuantityIndexNoDof >= 0) { DefineQuantity_P = (QuantityStorage_P0 + EquationTerm_P->Case.LocalTerm.Term.DefineQuantityIndexNoDof)->DefineQuantity ; Dof_AddFunctionSpaceIndex(DefineQuantity_P->FunctionSpaceIndex) ; } } /* ------------------------------------------------------------------------ */ /* P r e _ T e r m O f F e m F o r m u l a t i o n */ /* ------------------------------------------------------------------------ */ bool IsEquationNonLocal(BasisFunction *bf) { if(!bf) return false; if(bf->Function == (void(*)())BF_Region || bf->Function == (void(*)())BF_RegionX || bf->Function == (void(*)())BF_RegionY || bf->Function == (void(*)())BF_RegionZ || bf->Function == (void(*)())BF_Global || bf->Function == (void(*)())BF_dGlobal || bf->Function == (void(*)())BF_Zero || bf->Function == (void(*)())BF_One || bf->Function == (void(*)())BF_GroupOfNodes || bf->Function == (void(*)())BF_GroupOfNodes_2E || bf->Function == (void(*)())BF_GroupOfNodes_2F || bf->Function == (void(*)())BF_GroupOfNodes_2V || bf->Function == (void(*)())BF_GroupOfNodes_3E || bf->Function == (void(*)())BF_GroupOfNodes_3F || bf->Function == (void(*)())BF_GroupOfNodes_3V || bf->Function == (void(*)())BF_GradGroupOfNodes || bf->Function == (void(*)())BF_GradGroupOfNodes_2E || bf->Function == (void(*)())BF_GradGroupOfNodes_2F || bf->Function == (void(*)())BF_GradGroupOfNodes_2V || bf->Function == (void(*)())BF_GradGroupOfNodes_3E || bf->Function == (void(*)())BF_GradGroupOfNodes_3F || bf->Function == (void(*)())BF_GradGroupOfNodes_3V || bf->Function == (void(*)())BF_GroupOfEdges || bf->Function == (void(*)())BF_GroupOfEdges_2E || bf->Function == (void(*)())BF_GroupOfEdges_2F || bf->Function == (void(*)())BF_GroupOfEdges_2V || bf->Function == (void(*)())BF_GroupOfEdges_3E || bf->Function == (void(*)())BF_GroupOfEdges_3F_a || bf->Function == (void(*)())BF_GroupOfEdges_3F_b || bf->Function == (void(*)())BF_GroupOfEdges_3F_c || bf->Function == (void(*)())BF_GroupOfEdges_3V || bf->Function == (void(*)())BF_GroupOfEdges_4E || bf->Function == (void(*)())BF_GroupOfEdges_4F || bf->Function == (void(*)())BF_GroupOfEdges_4V || bf->Function == (void(*)())BF_CurlGroupOfEdges || bf->Function == (void(*)())BF_CurlGroupOfEdges_2E || bf->Function == (void(*)())BF_CurlGroupOfEdges_2F || bf->Function == (void(*)())BF_CurlGroupOfEdges_2V || bf->Function == (void(*)())BF_CurlGroupOfEdges_3E || bf->Function == (void(*)())BF_CurlGroupOfEdges_3F_a || bf->Function == (void(*)())BF_CurlGroupOfEdges_3F_b || bf->Function == (void(*)())BF_CurlGroupOfEdges_3F_c || bf->Function == (void(*)())BF_CurlGroupOfEdges_3V || bf->Function == (void(*)())BF_CurlGroupOfEdges_4E || bf->Function == (void(*)())BF_CurlGroupOfEdges_4F || bf->Function == (void(*)())BF_CurlGroupOfEdges_4V || bf->Function == (void(*)())BF_GroupOfPerpendicularEdges || bf->Function == (void(*)())BF_GroupOfPerpendicularEdges_2E || bf->Function == (void(*)())BF_GroupOfPerpendicularEdges_2F || bf->Function == (void(*)())BF_GroupOfPerpendicularEdges_2V || bf->Function == (void(*)())BF_GroupOfPerpendicularEdges_3E || bf->Function == (void(*)())BF_GroupOfPerpendicularEdges_3F || bf->Function == (void(*)())BF_GroupOfPerpendicularEdges_3V || bf->Function == (void(*)())BF_CurlGroupOfPerpendicularEdges || bf->Function == (void(*)())BF_CurlGroupOfPerpendicularEdges_2E || bf->Function == (void(*)())BF_CurlGroupOfPerpendicularEdges_2F || bf->Function == (void(*)())BF_CurlGroupOfPerpendicularEdges_2V || bf->Function == (void(*)())BF_CurlGroupOfPerpendicularEdges_3E || bf->Function == (void(*)())BF_CurlGroupOfPerpendicularEdges_3F || bf->Function == (void(*)())BF_CurlGroupOfPerpendicularEdges_3V || bf->Function == (void(*)())BF_GroupOfNodesX || bf->Function == (void(*)())BF_GroupOfNodesY || bf->Function == (void(*)())BF_GroupOfNodesZ || bf->Function == (void(*)())BF_GroupOfNodesX_D1 || bf->Function == (void(*)())BF_GroupOfNodesY_D1 || bf->Function == (void(*)())BF_GroupOfNodesZ_D1 || bf->Function == (void(*)())BF_GroupOfNodesX_D2 || bf->Function == (void(*)())BF_GroupOfNodesY_D2 || bf->Function == (void(*)())BF_GroupOfNodesZ_D2 || bf->Function == (void(*)())BF_GroupOfNodesX_D12 || bf->Function == (void(*)())BF_GroupOfNodesY_D12 || bf->Function == (void(*)())BF_GroupOfNodesZ_D12) return true; return false; } void Pre_TermOfFemEquation(struct Element * Element, struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0) { struct QuantityStorage * QuantityStorageEqu_P, * QuantityStorageDof_P ; int i ; bool NonLocal=false; QuantityStorageEqu_P = QuantityStorage_P0 + EquationTerm_P->Case.LocalTerm.Term.DefineQuantityIndexEqu ; QuantityStorageDof_P = (EquationTerm_P->Case.LocalTerm.Term.DefineQuantityIndexDof >= 0)? QuantityStorage_P0 + EquationTerm_P->Case.LocalTerm.Term.DefineQuantityIndexDof : NULL ; if (QuantityStorageEqu_P->NumLastElementForEquDefinition != Element->Num) { QuantityStorageEqu_P->NumLastElementForEquDefinition = Element->Num ; for (i = 0 ; i < QuantityStorageEqu_P->NbrElementaryBasisFunction ; i++){ NonLocal = (QuantityStorageEqu_P->TypeQuantity == INTEGRALQUANTITY) || IsEquationNonLocal(QuantityStorageEqu_P->BasisFunction[i].BasisFunction); switch(QuantityStorageEqu_P->BasisFunction[i].Constraint){ case NONE: Dof_DefineUnknownDof (QuantityStorageEqu_P->BasisFunction[i].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[i].CodeEntity, Current.NbrHar, NonLocal) ; break; case ASSIGN: Dof_DefineAssignFixedDof (QuantityStorageEqu_P->BasisFunction[i].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[i].CodeEntity, Current.NbrHar, QuantityStorageEqu_P->BasisFunction[i].Value, QuantityStorageEqu_P->BasisFunction[i].TimeFunctionIndex) ; break; case INIT: Dof_DefineInitFixedDof (QuantityStorageEqu_P->BasisFunction[i].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[i].CodeEntity, Current.NbrHar, QuantityStorageEqu_P->BasisFunction[i].Value, QuantityStorageEqu_P->BasisFunction[i].Value2, NonLocal) ; break; case ASSIGNFROMRESOLUTION: Dof_DefineAssignSolveDof (QuantityStorageEqu_P->BasisFunction[i].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[i].CodeEntity, Current.NbrHar, QuantityStorageEqu_P->BasisFunction[i].TimeFunctionIndex) ; break; case INITFROMRESOLUTION: Dof_DefineInitSolveDof (QuantityStorageEqu_P->BasisFunction[i].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[i].CodeEntity, Current.NbrHar); break; case CST_LINK: Dof_DefineLinkDof (QuantityStorageEqu_P->BasisFunction[i].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[i].CodeEntity, Current.NbrHar, QuantityStorageEqu_P->BasisFunction[i].Value, QuantityStorageEqu_P->BasisFunction[i].CodeEntity_Link) ; break; case CST_LINKCPLX: Dof_DefineLinkCplxDof (QuantityStorageEqu_P->BasisFunction[i].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[i].CodeEntity, Current.NbrHar, QuantityStorageEqu_P->BasisFunction[i].Value, QuantityStorageEqu_P->BasisFunction[i].CodeEntity_Link) ; break; } } } if (QuantityStorageDof_P && (QuantityStorageDof_P != QuantityStorageEqu_P) && (QuantityStorageDof_P->NumLastElementForDofDefinition != Element->Num)) { QuantityStorageDof_P->NumLastElementForDofDefinition = Element->Num ; for (i = 0 ; i < QuantityStorageDof_P->NbrElementaryBasisFunction ; i++) { NonLocal = (QuantityStorageDof_P->TypeQuantity == INTEGRALQUANTITY) || IsEquationNonLocal(QuantityStorageDof_P->BasisFunction[i].BasisFunction); switch(QuantityStorageDof_P->BasisFunction[i].Constraint){ case ASSIGN: Dof_DefineAssignFixedDof (QuantityStorageDof_P->BasisFunction[i].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[i].CodeEntity, Current.NbrHar, QuantityStorageDof_P->BasisFunction[i].Value, QuantityStorageDof_P->BasisFunction[i].TimeFunctionIndex) ; break; case INIT: Dof_DefineInitFixedDof (QuantityStorageDof_P->BasisFunction[i].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[i].CodeEntity, Current.NbrHar, QuantityStorageDof_P->BasisFunction[i].Value, QuantityStorageDof_P->BasisFunction[i].Value2, NonLocal) ; break; case ASSIGNFROMRESOLUTION: Dof_DefineAssignSolveDof (QuantityStorageDof_P->BasisFunction[i].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[i].CodeEntity, Current.NbrHar, QuantityStorageDof_P->BasisFunction[i].TimeFunctionIndex) ; break; case INITFROMRESOLUTION: Dof_DefineInitSolveDof (QuantityStorageDof_P->BasisFunction[i].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[i].CodeEntity, Current.NbrHar); break; case CST_LINK: Dof_DefineLinkDof (QuantityStorageDof_P->BasisFunction[i].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[i].CodeEntity, Current.NbrHar, QuantityStorageDof_P->BasisFunction[i].Value, QuantityStorageDof_P->BasisFunction[i].CodeEntity_Link) ; break; case CST_LINKCPLX: Dof_DefineLinkCplxDof (QuantityStorageDof_P->BasisFunction[i].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[i].CodeEntity, Current.NbrHar, QuantityStorageDof_P->BasisFunction[i].Value, QuantityStorageDof_P->BasisFunction[i].CodeEntity_Link) ; break; } } } } /* ------------------------------------------------------------------------ */ /* P r e _ I n i t G l o b a l T e r m O f F e m F o r m u l a t i o n */ /* ------------------------------------------------------------------------ */ void Pre_InitGlobalTermOfFemEquation(struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0) { struct DefineQuantity * DefineQuantity_P ; if (EquationTerm_P->Case.GlobalTerm.Term.DefineQuantityIndexDof >= 0) { DefineQuantity_P = (QuantityStorage_P0 + EquationTerm_P->Case.GlobalTerm.Term.DefineQuantityIndexDof)->DefineQuantity ; Dof_AddFunctionSpaceIndex(DefineQuantity_P->FunctionSpaceIndex) ; } if (EquationTerm_P->Case.GlobalTerm.Term.DefineQuantityIndexNoDof >= 0) { DefineQuantity_P = (QuantityStorage_P0 + EquationTerm_P->Case.GlobalTerm.Term.DefineQuantityIndexNoDof)->DefineQuantity ; Dof_AddFunctionSpaceIndex(DefineQuantity_P->FunctionSpaceIndex) ; } } /* ------------------------------------------------------------------------ */ /* P r e _ G l o b a l T e r m O f F e m F o r m u l a t i o n */ /* ------------------------------------------------------------------------ */ void Pre_GlobalTermOfFemEquation(int Num_Region, struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0) { struct QuantityStorage * QuantityStorageEqu_P, * QuantityStorageDof_P ; QuantityStorageEqu_P = QuantityStorage_P0 + EquationTerm_P->Case.GlobalTerm.Term.DefineQuantityIndexEqu ; QuantityStorageDof_P = (EquationTerm_P->Case.GlobalTerm.Term.DefineQuantityIndexDof >= 0)? QuantityStorage_P0 + EquationTerm_P->Case.GlobalTerm.Term.DefineQuantityIndexDof : NULL ; if (QuantityStorageEqu_P->NbrElementaryBasisFunction == 1) { switch(QuantityStorageEqu_P->BasisFunction[0].Constraint) { case NONE: Dof_DefineUnknownDof (QuantityStorageEqu_P->BasisFunction[0].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[0].CodeEntity, Current.NbrHar, true) ; break ; case ASSIGN: Dof_DefineAssignFixedDof (QuantityStorageEqu_P->BasisFunction[0].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[0].CodeEntity, Current.NbrHar, QuantityStorageEqu_P->BasisFunction[0].Value, QuantityStorageEqu_P->BasisFunction[0].TimeFunctionIndex) ; break ; case INIT: Dof_DefineInitFixedDof (QuantityStorageEqu_P->BasisFunction[0].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[0].CodeEntity, Current.NbrHar, QuantityStorageEqu_P->BasisFunction[0].Value, QuantityStorageEqu_P->BasisFunction[0].Value2, true) ; break; case ASSIGNFROMRESOLUTION: Dof_DefineAssignSolveDof (QuantityStorageEqu_P->BasisFunction[0].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[0].CodeEntity, Current.NbrHar, QuantityStorageEqu_P->BasisFunction[0].TimeFunctionIndex) ; break; case INITFROMRESOLUTION: Dof_DefineInitSolveDof (QuantityStorageEqu_P->BasisFunction[0].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[0].CodeEntity, Current.NbrHar); break; case CST_LINK: Dof_DefineLinkDof (QuantityStorageEqu_P->BasisFunction[0].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[0].CodeEntity, Current.NbrHar, QuantityStorageEqu_P->BasisFunction[0].Value, QuantityStorageEqu_P->BasisFunction[0].CodeEntity_Link) ; break; case CST_LINKCPLX: Dof_DefineLinkCplxDof (QuantityStorageEqu_P->BasisFunction[0].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[0].CodeEntity, Current.NbrHar, QuantityStorageEqu_P->BasisFunction[0].Value, QuantityStorageEqu_P->BasisFunction[0].CodeEntity_Link) ; break; } } if (QuantityStorageDof_P && (QuantityStorageDof_P != QuantityStorageEqu_P)) { if (QuantityStorageDof_P->NbrElementaryBasisFunction == 1) { switch(QuantityStorageDof_P->BasisFunction[0].Constraint) { case NONE: if (!QuantityStorageDof_P->BasisFunction[0].CodeAssociateBasisFunction) Dof_DefineUnknownDof (QuantityStorageDof_P->BasisFunction[0].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[0].CodeEntity, Current.NbrHar, true) ; else Dof_DefineAssociateDof (QuantityStorageDof_P->BasisFunction[0].CodeAssociateBasisFunction, QuantityStorageDof_P->BasisFunction[0].CodeEntity, QuantityStorageDof_P->BasisFunction[0].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[0].CodeEntity, Current.NbrHar, 0, NULL) ; break ; case ASSIGN: Dof_DefineAssignFixedDof (QuantityStorageDof_P->BasisFunction[0].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[0].CodeEntity, Current.NbrHar, QuantityStorageDof_P->BasisFunction[0].Value, QuantityStorageDof_P->BasisFunction[0].TimeFunctionIndex) ; break ; case INIT: /* This was used instead of what follows... Why!!! Dof_DefineAssociateDof (QuantityStorageDof_P->BasisFunction[0].CodeAssociateBasisFunction, QuantityStorageDof_P->BasisFunction[0].CodeEntity, QuantityStorageDof_P->BasisFunction[0].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[0].CodeEntity, Current.NbrHar, 1, QuantityStorageDof_P->BasisFunction[0].Value) ; */ Dof_DefineInitFixedDof (QuantityStorageDof_P->BasisFunction[0].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[0].CodeEntity, Current.NbrHar, QuantityStorageDof_P->BasisFunction[0].Value, QuantityStorageDof_P->BasisFunction[0].Value2, true); break; case ASSIGNFROMRESOLUTION: Dof_DefineAssignSolveDof (QuantityStorageDof_P->BasisFunction[0].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[0].CodeEntity, Current.NbrHar, QuantityStorageDof_P->BasisFunction[0].TimeFunctionIndex) ; break; case INITFROMRESOLUTION: Dof_DefineInitSolveDof (QuantityStorageDof_P->BasisFunction[0].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[0].CodeEntity, Current.NbrHar); break; case CST_LINK: Dof_DefineLinkDof (QuantityStorageDof_P->BasisFunction[0].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[0].CodeEntity, Current.NbrHar, QuantityStorageDof_P->BasisFunction[0].Value, QuantityStorageDof_P->BasisFunction[0].CodeEntity_Link) ; break; case CST_LINKCPLX: Dof_DefineLinkCplxDof (QuantityStorageDof_P->BasisFunction[0].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[0].CodeEntity, Current.NbrHar, QuantityStorageDof_P->BasisFunction[0].Value, QuantityStorageDof_P->BasisFunction[0].CodeEntity_Link) ; break; } } } } /* ------------------------------------------------------------------------ */ /* C s t _ G l o b a l T e r m O f F e m F o r m u l a t i o n */ /* ------------------------------------------------------------------------ */ void Cst_GlobalTermOfFemEquation(int Num_Region, struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0) { struct QuantityStorage * QuantityStorageEqu_P, * QuantityStorageDof_P ; QuantityStorageEqu_P = QuantityStorage_P0 + EquationTerm_P->Case.GlobalTerm.Term.DefineQuantityIndexEqu ; QuantityStorageDof_P = (EquationTerm_P->Case.GlobalTerm.Term.DefineQuantityIndexDof >= 0)? QuantityStorage_P0 + EquationTerm_P->Case.GlobalTerm.Term.DefineQuantityIndexDof : NULL ; if (QuantityStorageEqu_P->NbrElementaryBasisFunction == 1) { switch(QuantityStorageEqu_P->BasisFunction[0].Constraint) { case ASSIGN: Dof_UpdateAssignFixedDof (QuantityStorageEqu_P->BasisFunction[0].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[0].CodeEntity, Current.NbrHar, QuantityStorageEqu_P->BasisFunction[0].Value) ; break ; case CST_LINK: case CST_LINKCPLX: Dof_UpdateLinkDof (QuantityStorageEqu_P->BasisFunction[0].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[0].CodeEntity, Current.NbrHar, QuantityStorageEqu_P->BasisFunction[0].Value, QuantityStorageEqu_P->BasisFunction[0].CodeEntity_Link) ; break; } } if (QuantityStorageDof_P && (QuantityStorageDof_P != QuantityStorageEqu_P)) { if (QuantityStorageDof_P->NbrElementaryBasisFunction == 1) { switch(QuantityStorageDof_P->BasisFunction[0].Constraint) { case ASSIGN: Dof_UpdateAssignFixedDof (QuantityStorageDof_P->BasisFunction[0].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[0].CodeEntity, Current.NbrHar, QuantityStorageDof_P->BasisFunction[0].Value) ; break ; case CST_LINK: case CST_LINKCPLX: Dof_UpdateLinkDof (QuantityStorageDof_P->BasisFunction[0].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[0].CodeEntity, Current.NbrHar, QuantityStorageDof_P->BasisFunction[0].Value, QuantityStorageDof_P->BasisFunction[0].CodeEntity_Link) ; break; } } } } /* ------------------------------------------------------------------------ */ /* P r e _ F e m G l o b a l E q u a t i o n */ /* ------------------------------------------------------------------------ */ void Pre_FemGlobalEquation2(int Index_DefineQuantity, int Num_Region, struct DefineQuantity * DefineQuantity_P0, struct QuantityStorage * QuantityStorage_P0) { struct DefineQuantity * DefineQuantity_P ; struct QuantityStorage * QuantityStorage_P ; struct GlobalQuantity * GlobalQuantity_P ; struct QuantityStorage QuaSto_S ; DefineQuantity_P = DefineQuantity_P0 + Index_DefineQuantity ; QuantityStorage_P = QuantityStorage_P0 + Index_DefineQuantity ; GlobalQuantity_P = (struct GlobalQuantity*) List_Pointer(QuantityStorage_P->FunctionSpace->GlobalQuantity, *(int *)List_Pointer(DefineQuantity_P->IndexInFunctionSpace, 0)) ; Get_DofOfRegion(Num_Region, GlobalQuantity_P, QuantityStorage_P->FunctionSpace, &QuaSto_S) ; if (QuaSto_S.NbrElementaryBasisFunction == 1) { switch(QuaSto_S.BasisFunction[0].Constraint) { case NONE: Dof_DefineUnknownDof (QuaSto_S.BasisFunction[0].CodeBasisFunction, QuaSto_S.BasisFunction[0].CodeEntity, Current.NbrHar, true) ; break ; case ASSIGN: Dof_DefineAssignFixedDof (QuaSto_S.BasisFunction[0].CodeBasisFunction, QuaSto_S.BasisFunction[0].CodeEntity, Current.NbrHar, QuaSto_S.BasisFunction[0].Value, QuaSto_S.BasisFunction[0].TimeFunctionIndex) ; break ; case INIT: Dof_DefineInitFixedDof (QuaSto_S.BasisFunction[0].CodeBasisFunction, QuaSto_S.BasisFunction[0].CodeEntity, Current.NbrHar, QuaSto_S.BasisFunction[0].Value, QuaSto_S.BasisFunction[0].Value2, true); break; case ASSIGNFROMRESOLUTION: Dof_DefineAssignSolveDof (QuaSto_S.BasisFunction[0].CodeBasisFunction, QuaSto_S.BasisFunction[0].CodeEntity, Current.NbrHar, QuaSto_S.BasisFunction[0].TimeFunctionIndex) ; break; case INITFROMRESOLUTION: Dof_DefineInitSolveDof (QuaSto_S.BasisFunction[0].CodeBasisFunction, QuaSto_S.BasisFunction[0].CodeEntity, Current.NbrHar); break; case CST_LINK: Dof_DefineLinkDof (QuaSto_S.BasisFunction[0].CodeBasisFunction, QuaSto_S.BasisFunction[0].CodeEntity, Current.NbrHar, QuaSto_S.BasisFunction[0].Value, QuaSto_S.BasisFunction[0].CodeEntity_Link) ; break; case CST_LINKCPLX: Dof_DefineLinkCplxDof (QuaSto_S.BasisFunction[0].CodeBasisFunction, QuaSto_S.BasisFunction[0].CodeEntity, Current.NbrHar, QuaSto_S.BasisFunction[0].Value, QuaSto_S.BasisFunction[0].CodeEntity_Link) ; break; } } } void Pre_FemGlobalEquation(struct EquationTerm * EquationTerm_P, struct DefineQuantity * DefineQuantity_P0, struct QuantityStorage * QuantityStorage_P0) { int Nbr_GlobalEquationTerm, i_GlobalEquationTerm ; struct Constraint * Constraint_P ; struct GlobalEquationTerm * GlobalEquationTerm_P ; int Nbr_EquAndDof ; List_T * InitialListInIndex_L, * RegionIndex_L ; int Nbr_Region, i_Region, Num_Region ; int Nbr_MCPR, i_MCPR, Nbr_CPR, i_CPR, Nbr_GlobalEqu ; struct MultiConstraintPerRegion * MCPR_P ; struct ConstraintPerRegion * CPR_P ; struct Group * Group_P ; struct DofGlobal { int NumRegion ; struct Dof * Dof ; } ; /* Liste des Regions auxquelles on associe des Equations de Type 'Network' */ RegionIndex_L = List_Create(50,50, sizeof(int)) ; Constraint_P = (struct Constraint*) List_Pointer(Problem_S.Constraint, EquationTerm_P->Case.GlobalEquation.ConstraintIndex) ; Nbr_MCPR = List_Nbr(Constraint_P->MultiConstraintPerRegion) ; for (i_MCPR = 0 ; i_MCPR < Nbr_MCPR ; i_MCPR++) { MCPR_P = (struct MultiConstraintPerRegion*) List_Pointer(Constraint_P->MultiConstraintPerRegion, i_MCPR) ; Nbr_CPR = List_Nbr(MCPR_P->ConstraintPerRegion) ; for (i_CPR = 0 ; i_CPR < Nbr_CPR ; i_CPR++) { CPR_P = (struct ConstraintPerRegion*) List_Pointer(MCPR_P->ConstraintPerRegion, i_CPR) ; Group_P = (struct Group *)List_Pointer(Problem_S.Group, CPR_P->RegionIndex) ; if (List_Nbr(Group_P->InitialList) == 1) { List_Read(Group_P->InitialList, 0, &Num_Region) ; if (!List_Search(RegionIndex_L, &Num_Region, fcmp_int)) List_Add(RegionIndex_L, &Num_Region) ; else Message::Error("2 occurences of Elementary Region #%d in Contraint '%s'", Num_Region, Constraint_P->Name); } else Message::Error("Not 1 Elementary Region in Group '%s'", Group_P->Name); } } Nbr_EquAndDof = List_Nbr(RegionIndex_L) ; if (!Nbr_EquAndDof){ return ; } /* Codes des Dof globaux pour Equ, DofNode, DofLoop */ Nbr_GlobalEqu = 0 ; Nbr_GlobalEquationTerm = List_Nbr(EquationTerm_P->Case.GlobalEquation.GlobalEquationTerm) ; for (i_GlobalEquationTerm = 0 ; i_GlobalEquationTerm < Nbr_GlobalEquationTerm ; i_GlobalEquationTerm++) { GlobalEquationTerm_P = (struct GlobalEquationTerm*) List_Pointer(EquationTerm_P->Case.GlobalEquation.GlobalEquationTerm, i_GlobalEquationTerm) ; InitialListInIndex_L = ((struct Group *)List_Pointer(Problem_S.Group, GlobalEquationTerm_P->InIndex))->InitialList ; Nbr_Region = List_Nbr(InitialListInIndex_L) ; List_Sort(InitialListInIndex_L, fcmp_int) ; for (i_Region = 0 ; i_Region < Nbr_Region ; i_Region++) { List_Read(InitialListInIndex_L, i_Region, &Num_Region) ; if (List_Search(RegionIndex_L, &Num_Region, fcmp_int)) { Pre_FemGlobalEquation2 (GlobalEquationTerm_P->DefineQuantityIndexEqu, Num_Region, DefineQuantity_P0, QuantityStorage_P0) ; Pre_FemGlobalEquation2 (GlobalEquationTerm_P->DefineQuantityIndexNode, Num_Region, DefineQuantity_P0, QuantityStorage_P0) ; Pre_FemGlobalEquation2 (GlobalEquationTerm_P->DefineQuantityIndexLoop, Num_Region, DefineQuantity_P0, QuantityStorage_P0) ; Nbr_GlobalEqu++ ; } } } if (Nbr_GlobalEqu != Nbr_EquAndDof){ Message::Error("Incompatible number of equations with Contraint '%s'", Constraint_P->Name); Message::Error("(%d equations obtained while %d branches are defined)", Nbr_GlobalEqu, Nbr_EquAndDof); } List_Delete(RegionIndex_L) ; } /* ------------------------------------------------------------------------ */ /* C s t _ T e r m O f F e m F o r m u l a t i o n */ /* ------------------------------------------------------------------------ */ void Cst_TermOfFemEquation(struct Element * Element, struct EquationTerm * EquationTerm_P, struct QuantityStorage * QuantityStorage_P0) { struct QuantityStorage * QuantityStorageEqu_P, * QuantityStorageDof_P ; int i ; QuantityStorageEqu_P = QuantityStorage_P0 + EquationTerm_P->Case.LocalTerm.Term.DefineQuantityIndexEqu ; QuantityStorageDof_P = (EquationTerm_P->Case.LocalTerm.Term.DefineQuantityIndexDof >= 0)? QuantityStorage_P0 + EquationTerm_P->Case.LocalTerm.Term.DefineQuantityIndexDof : NULL ; if (QuantityStorageEqu_P->NumLastElementForEquDefinition != Element->Num) { QuantityStorageEqu_P->NumLastElementForEquDefinition = Element->Num ; for (i = 0 ; i < QuantityStorageEqu_P->NbrElementaryBasisFunction ; i++) switch(QuantityStorageEqu_P->BasisFunction[i].Constraint){ /* case NONE: Dof_DefineUnknownDof (QuantityStorageEqu_P->BasisFunction[i].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[i].CodeEntity, Current.NbrHar) ; break; */ case ASSIGN: Dof_UpdateAssignFixedDof (QuantityStorageEqu_P->BasisFunction[i].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[i].CodeEntity, Current.NbrHar, QuantityStorageEqu_P->BasisFunction[i].Value) ; break; /* case INIT: Dof_DefineInitFixedDof (QuantityStorageEqu_P->BasisFunction[i].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[i].CodeEntity, Current.NbrHar, QuantityStorageEqu_P->BasisFunction[i].Value, QuantityStorageEqu_P->BasisFunction[i].Value2, false) ; break; case ASSIGNFROMRESOLUTION: Dof_DefineAssignSolveDof (QuantityStorageEqu_P->BasisFunction[i].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[i].CodeEntity, Current.NbrHar, QuantityStorageEqu_P->BasisFunction[i].TimeFunctionIndex) ; break; case INITFROMRESOLUTION: Dof_DefineInitSolveDof (QuantityStorageEqu_P->BasisFunction[i].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[i].CodeEntity, Current.NbrHar); break; */ case CST_LINK: case CST_LINKCPLX: Dof_UpdateLinkDof (QuantityStorageEqu_P->BasisFunction[i].CodeBasisFunction, QuantityStorageEqu_P->BasisFunction[i].CodeEntity, Current.NbrHar, QuantityStorageEqu_P->BasisFunction[i].Value, QuantityStorageEqu_P->BasisFunction[i].CodeEntity_Link) ; break; } } if (QuantityStorageDof_P && (QuantityStorageDof_P != QuantityStorageEqu_P) && (QuantityStorageDof_P->NumLastElementForDofDefinition != Element->Num)) { QuantityStorageDof_P->NumLastElementForDofDefinition = Element->Num ; for (i = 0 ; i < QuantityStorageDof_P->NbrElementaryBasisFunction ; i++) switch(QuantityStorageDof_P->BasisFunction[i].Constraint){ case ASSIGN: Dof_UpdateAssignFixedDof (QuantityStorageDof_P->BasisFunction[i].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[i].CodeEntity, Current.NbrHar, QuantityStorageDof_P->BasisFunction[i].Value) ; break; /* case INIT: Dof_DefineInitFixedDof (QuantityStorageDof_P->BasisFunction[i].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[i].CodeEntity, Current.NbrHar, QuantityStorageDof_P->BasisFunction[i].Value, QuantityStorageDof_P->BasisFunction[i].Value2) ; break; case ASSIGNFROMRESOLUTION: Dof_DefineAssignSolveDof (QuantityStorageDof_P->BasisFunction[i].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[i].CodeEntity, Current.NbrHar, QuantityStorageDof_P->BasisFunction[i].TimeFunctionIndex) ; break; case INITFROMRESOLUTION: Dof_DefineInitSolveDof (QuantityStorageDof_P->BasisFunction[i].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[i].CodeEntity, Current.NbrHar); break; */ case CST_LINK: case CST_LINKCPLX: Dof_UpdateLinkDof (QuantityStorageDof_P->BasisFunction[i].CodeBasisFunction, QuantityStorageDof_P->BasisFunction[i].CodeEntity, Current.NbrHar, QuantityStorageDof_P->BasisFunction[i].Value, QuantityStorageDof_P->BasisFunction[i].CodeEntity_Link) ; break; } } } getdp-2.7.0-source/Legacy/F_Python.cpp000644 001750 001750 00000012063 12513773211 021243 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "GetDPConfig.h" #include "ProData.h" #include "F.h" #include "Message.h" extern struct CurrentData Current ; extern char *Name_Path ; // This file defines a simple interface to Python. // // * The Python interpreter will be initialized when GetDP is started; you can // then use the Python[argument_list]{string} function in the same way as // other GetDP functions: // // - `argument_list' contains standard GetDP arguments, e.g. X[], Norm[{d a}], // etc. These arguments will be stored in Python as a list variable named // `input', which you can then access as a normal Python list // // - `string' contains either the Python expression that you want to evaluate, // or the name of a Python script file (if `string' ends with `.py'). Due to // conflicts in the GetDP syntax, to use a string variable, you need to use // Str[string_variable] // // - you should save the value you want to return to GetDP in a list named // `output' // // * Since the Python interpreter lives for the whole duration of the GetDP run, // you can make quite efficient Python calculations by precomputing things // outside the finite element assembly loop. The easiest way to to this is to // evaluate the Python code you need to precompute using // // Evaluate[ my_python_precomputation[] ] // // in the Operation field of a Resolution before Generate[] is called. #if defined(HAVE_PYTHON) #include void F_Python(F_ARG) { if(!Fct->String){ Message::Error("Missing Python expression: use Python[arguments]{\"expression\"}"); for (int k = 0; k < Current.NbrHar; k++) V->Val[MAX_DIM * k] = 0. ; V->Type = SCALAR; return; } // we could do this more efficiently by directly storing the values in python // (instead of parsing) std::string expr = "input = ["; for(int i = 0; i < Fct->NbrArguments; i++){ char tmp[256]; if((A + i)->Type == SCALAR){ if(Current.NbrHar == 2) sprintf(tmp, "%.16g+%.16gj", (A + i)->Val[0], (A + i)->Val[MAX_DIM]); else sprintf(tmp, "%.16g", (A + i)->Val[0]); } else if((A + i)->Type == VECTOR){ strcpy(tmp, "["); char tmp2[256]; for(int j = 0; j < 3; j++){ if(Current.NbrHar == 2) sprintf(tmp2, "%.16g+%.16gj", (A + i)->Val[j], (A + i)->Val[MAX_DIM + j]); else sprintf(tmp2, "%.16g", (A + i)->Val[j]); if(j != 2) strcat(tmp2, ","); strcat(tmp, tmp2); } strcat(tmp, "]"); } else{ Message::Error("Unsupported Python argument (should be scalar or vector"); } if(i) expr += ","; expr += tmp; } expr += std::string("];"); std::string str(Fct->String); if(str.size() > 3 && str.substr(str.size() - 3) == ".py"){ PyRun_SimpleString(expr.c_str()); std::string file = std::string(Name_Path) + str; FILE *fp = fopen(file.c_str(), "r"); if(fp){ PyRun_SimpleFile(fp, file.c_str()); fclose(fp); } else{ Message::Error("Could not open file `%s'", file.c_str()); } } else{ expr += std::string(Fct->String); PyRun_SimpleString(expr.c_str()); } for (int k = 0; k < Current.NbrHar; k++) for (int j = 0; j < 9; j++) V->Val[MAX_DIM * k + j] = 0. ; V->Type = SCALAR; PyObject* dict = PyModule_GetDict(PyImport_AddModule("__main__")); if(dict){ PyObject* out = PyDict_GetItemString(dict, "output"); if(out){ if(PyList_Check(out)){ Py_ssize_t size = PyList_Size(out); if(size == 1 || size == 3 || size == 9){ for(int i = 0; i < size; i++){ PyObject *item = PyList_GetItem(out, i); if(PyComplex_Check(item)){ double re = PyComplex_RealAsDouble(out); double im = PyComplex_ImagAsDouble(out); V->Val[i] = re; V->Val[MAX_DIM + i] = im; } else if(PyNumber_Check(item)){ V->Val[i] = PyFloat_AsDouble(item); } else{ Message::Error("Unknown type of Python output list item"); } } V->Type = (size == 1) ? SCALAR : (size == 3) ? VECTOR : TENSOR; } else{ Message::Error("Wrong number of components in Python output list " "(%d != 1, 3 or 9)", size); } } else if(PyComplex_Check(out)){ double re = PyComplex_RealAsDouble(out); double im = PyComplex_ImagAsDouble(out); V->Val[0] = re; V->Val[MAX_DIM] = im; } else if(PyNumber_Check(out)){ V->Val[0] = PyFloat_AsDouble(out); } else{ Message::Error("Unknown type of Python output value"); } } } } #else void F_Python(F_ARG) { Message::Error("You need to compile GetDP with Python support to use Python functions"); V->Val[0] = 0. ; V->Type = SCALAR ; } #endif getdp-2.7.0-source/Legacy/Get_FunctionValue.cpp000644 001750 001750 00000026611 12473553042 023105 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include #include "ProData.h" #include "GeoData.h" #include "DofData.h" #include "Cal_Quantity.h" #include "Get_Geometry.h" #include "Message.h" #define SQU(a) ((a)*(a)) extern struct Problem Problem_S ; extern struct CurrentData Current ; /* ------------------------------------------------------------------------ */ /* G e t _ V a l u e F r o m F o r m */ /* ------------------------------------------------------------------------ */ int Get_ValueFromForm(int Form) { switch (Form) { case FORM0 : case FORM3 : case FORM3P : case SCALAR : return(SCALAR) ; case FORM1 : case FORM1P : case FORM1S : case FORM2 : case FORM2P : case FORM2S : case VECTOR : case VECTORP : return(VECTOR) ; default : Message::Error("Unknown Form type in 'Get_ValueFromForm'"); return(-1) ; } } /* ------------------------------------------------------------------------ */ /* G e t _ I n t e g r a t i o n C a s e */ /* ------------------------------------------------------------------------ */ /* Il faudrait reorganiser les 'Current.XXX' Ca devient un peu le bordel. */ struct IntegrationCase * Get_IntegrationCase (struct Element * Element, List_T *IntegrationCase_L, int CriterionIndex) { struct Value Criterion ; if (CriterionIndex >= 0){ Current.Element = Element ; Current.ElementSource = Element->ElementSource ; Get_ValueOfExpression ((struct Expression *) List_Pointer(Problem_S.Expression, CriterionIndex), NULL, 0., 0., 0., &Criterion) ; if(Criterion.Val[0] < 0 || Criterion.Val[0] >= List_Nbr(IntegrationCase_L)) Message::Error("Integration criterion out of range"); } else { if(List_Nbr(IntegrationCase_L) > 1) Message::Error("Missing integration criterion"); Criterion.Val[0] = 0; } return((struct IntegrationCase*) List_Pointer(IntegrationCase_L, (int)Criterion.Val[0])) ; } /* ------------------------------------------------------------------------ */ /* G e t _ F u n c t i o n V a l u e */ /* ------------------------------------------------------------------------ */ void Get_FunctionValue(int Nbr_Function, void (*xFunctionBF[])(), int Type_Operator, struct QuantityStorage * QuantityStorage_P, int * Type_Form) { int i ; switch (Type_Operator) { case NOOP : *Type_Form = QuantityStorage_P->TypeQuantity ; for (i = 0 ; i < Nbr_Function ; i++) xFunctionBF[i] = QuantityStorage_P->BasisFunction[i].BasisFunction->Function ; break ; case EXTDER : *Type_Form = QuantityStorage_P->TypeQuantity + 1 ; for (i = 0 ; i < Nbr_Function ; i++) xFunctionBF[i] = QuantityStorage_P->BasisFunction[i].BasisFunction->dFunction ; break ; case EXTDERINV : *Type_Form = QuantityStorage_P->TypeQuantity - 1 ; for (i = 0 ; i < Nbr_Function ; i++) xFunctionBF[i] = QuantityStorage_P->BasisFunction[i].BasisFunction->dInvFunction ; break ; case GRAD : if (QuantityStorage_P->TypeQuantity == FORM0) { *Type_Form = QuantityStorage_P->TypeQuantity + 1 ; for (i = 0 ; i < Nbr_Function ; i++) xFunctionBF[i] = QuantityStorage_P->BasisFunction[i].BasisFunction->dFunction ; } else if (QuantityStorage_P->TypeQuantity == SCALAR) { *Type_Form = VECTOR ; } else{ Message::Error("Cannot apply Grad operator to quantity type %d", QuantityStorage_P->TypeQuantity); } break ; case CURL : if ((QuantityStorage_P->TypeQuantity == FORM1) || (QuantityStorage_P->TypeQuantity == FORM1P)) { *Type_Form = QuantityStorage_P->TypeQuantity + 1 ; for (i = 0 ; i < Nbr_Function ; i++) xFunctionBF[i] = QuantityStorage_P->BasisFunction[i].BasisFunction->dFunction ; } else if (QuantityStorage_P->TypeQuantity == VECTOR) { *Type_Form = VECTOR ; for (i = 0 ; i < Nbr_Function ; i++) xFunctionBF[i] = QuantityStorage_P->BasisFunction[i].BasisFunction->dFunction ; } else{ Message::Error("Cannot apply Curl operator to quantity type %d", QuantityStorage_P->TypeQuantity); } break ; case DIV : if (QuantityStorage_P->TypeQuantity == FORM2) { *Type_Form = QuantityStorage_P->TypeQuantity + 1 ; for (i = 0 ; i < Nbr_Function ; i++) xFunctionBF[i] = QuantityStorage_P->BasisFunction[i].BasisFunction->dFunction ; } else if (QuantityStorage_P->TypeQuantity == VECTOR) { *Type_Form = SCALAR ; for (i = 0 ; i < Nbr_Function ; i++) xFunctionBF[i] = QuantityStorage_P->BasisFunction[i].BasisFunction->dInvFunction ; } else{ Message::Error("Cannot apply Div operator to quantity type %d", QuantityStorage_P->TypeQuantity); } break ; case GRADINV : if (QuantityStorage_P->TypeQuantity == FORM1) { *Type_Form = QuantityStorage_P->TypeQuantity - 1 ; for (i = 0 ; i < Nbr_Function ; i++) xFunctionBF[i] = QuantityStorage_P->BasisFunction[i].BasisFunction->dInvFunction ; } else if (QuantityStorage_P->TypeQuantity == VECTOR) { *Type_Form = SCALAR ; } else{ Message::Error("Cannot apply GradInv operator to quantity type %d", QuantityStorage_P->TypeQuantity); } break ; case CURLINV : if (QuantityStorage_P->TypeQuantity == FORM2) { *Type_Form = QuantityStorage_P->TypeQuantity - 1 ; for (i = 0 ; i < Nbr_Function ; i++) xFunctionBF[i] = QuantityStorage_P->BasisFunction[i].BasisFunction->dInvFunction ; } else if (QuantityStorage_P->TypeQuantity == VECTOR) { *Type_Form = VECTOR ; } else{ Message::Error("Cannot apply CurlInv operator to quantity type %d", QuantityStorage_P->TypeQuantity); } break ; case DIVINV : if ((QuantityStorage_P->TypeQuantity == FORM3) || (QuantityStorage_P->TypeQuantity == FORM3P)) { *Type_Form = QuantityStorage_P->TypeQuantity - 1 ; for (i = 0 ; i < Nbr_Function ; i++) xFunctionBF[i] = QuantityStorage_P->BasisFunction[i].BasisFunction->dInvFunction ; } else if (QuantityStorage_P->TypeQuantity == SCALAR) { *Type_Form = VECTOR ; } else{ Message::Error("Cannot apply DivInv operator to quantity type %d", QuantityStorage_P->TypeQuantity); } break ; case _D1 : if (QuantityStorage_P->TypeQuantity == VECTOR) { *Type_Form = VECTOR ; for (i = 0 ; i < Nbr_Function ; i++) xFunctionBF[i] = QuantityStorage_P->BasisFunction[i].BasisFunction->dFunction ; } else{ Message::Error("Cannot apply D1 operator to quantity type %d", QuantityStorage_P->TypeQuantity); } break ; case _D2 : if (QuantityStorage_P->TypeQuantity == VECTOR) { *Type_Form = VECTOR ; for (i = 0 ; i < Nbr_Function ; i++) xFunctionBF[i] = QuantityStorage_P->BasisFunction[i].BasisFunction->dInvFunction ; } else{ Message::Error("Cannot apply D2 operator to quantity type %d", QuantityStorage_P->TypeQuantity); } break ; case _D3 : if (QuantityStorage_P->TypeQuantity == VECTOR) { *Type_Form = VECTOR ; for (i = 0 ; i < Nbr_Function ; i++) xFunctionBF[i] = QuantityStorage_P->BasisFunction[i].BasisFunction->dPlusFunction ; } else{ Message::Error("Cannot apply D3 operator to quantity type %d", QuantityStorage_P->TypeQuantity); } break ; default : Message::Error("Unknown operator in 'Get_FunctionValue'"); break; } } /* ------------------------------------------------------------------------ */ /* G e t _ I n i t F u n c t i o n V a l u e */ /* ------------------------------------------------------------------------ */ void Get_InitFunctionValue(int Type_Operator, struct QuantityStorage * QuantityStorage_P, int * Type_Form) { switch (Type_Operator) { case NOOP : *Type_Form = QuantityStorage_P->TypeQuantity ; break ; case EXTDER : *Type_Form = QuantityStorage_P->TypeQuantity + 1 ; break ; case EXTDERINV : *Type_Form = QuantityStorage_P->TypeQuantity - 1 ; break ; case GRAD : if (QuantityStorage_P->TypeQuantity == FORM0) *Type_Form = QuantityStorage_P->TypeQuantity + 1 ; else if (QuantityStorage_P->TypeQuantity == SCALAR) *Type_Form = VECTOR ; break ; case CURL : if ((QuantityStorage_P->TypeQuantity == FORM1) || (QuantityStorage_P->TypeQuantity == FORM1P)) *Type_Form = QuantityStorage_P->TypeQuantity + 1 ; else if (QuantityStorage_P->TypeQuantity == VECTOR) *Type_Form = VECTOR ; break ; case DIV : if (QuantityStorage_P->TypeQuantity == FORM2) *Type_Form = QuantityStorage_P->TypeQuantity + 1 ; else if (QuantityStorage_P->TypeQuantity == VECTOR) *Type_Form = SCALAR ; break ; case GRADINV : if (QuantityStorage_P->TypeQuantity == FORM1) *Type_Form = QuantityStorage_P->TypeQuantity - 1 ; else if (QuantityStorage_P->TypeQuantity == VECTOR) *Type_Form = SCALAR ; break ; case CURLINV : if (QuantityStorage_P->TypeQuantity == FORM2) *Type_Form = QuantityStorage_P->TypeQuantity - 1 ; else if (QuantityStorage_P->TypeQuantity == VECTOR) *Type_Form = VECTOR ; break ; case DIVINV : if ((QuantityStorage_P->TypeQuantity == FORM3) || (QuantityStorage_P->TypeQuantity == FORM3P)) *Type_Form = QuantityStorage_P->TypeQuantity - 1 ; else if (QuantityStorage_P->TypeQuantity == SCALAR) *Type_Form = VECTOR ; break ; case _D1 : case _D2 : case _D3 : if (QuantityStorage_P->TypeQuantity == VECTOR) *Type_Form = VECTOR ; else *Type_Form = VECTOR ; break ; default : Message::Error("Unknown operator in 'Get_InitFunctionValue'"); break; } } /* ------------------------------------------------------------------------ */ /* C a l _ I n t e r p o l a t i o n O r d e r */ /* ------------------------------------------------------------------------ */ double Cal_InterpolationOrder(struct Element * Element, struct QuantityStorage * QuantityStorage) { int i ; double Order = 0.0 ; for(i = 0 ; i < QuantityStorage->NbrElementaryBasisFunction ; i++) if(QuantityStorage->BasisFunction[i].Dof->Type == DOF_UNKNOWN) Order = std::max(QuantityStorage->BasisFunction[i].BasisFunction->Order, Order) ; return(Order) ; } /* ------------------------------------------------------------------------ */ /* C a l _ M a x E d g e L e n g t h */ /* ------------------------------------------------------------------------ */ double Cal_MaxEdgeLength(struct Element * Element) { int i, *IM, *N, NbrEdges ; double l, lmax = 0.0 ; IM = Geo_GetIM_Den(Element->Type, &NbrEdges) ; for(i = 0 ; i < NbrEdges ; i++){ N = IM + i * NBR_MAX_SUBENTITIES_IN_ELEMENT ; l = sqrt(SQU(Element->x[abs(N[1])-1]-Element->x[abs(N[0])-1]) + SQU(Element->y[abs(N[1])-1]-Element->y[abs(N[0])-1]) + SQU(Element->z[abs(N[1])-1]-Element->z[abs(N[0])-1])) ; lmax = std::max(lmax, l) ; } return(lmax) ; } getdp-2.7.0-source/Legacy/BF_Edge_2.cpp000644 001750 001750 00000007426 12473553042 021163 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "ProData.h" #include "Message.h" /* ------------------------------------------------------------------------ */ /* B F _ E d g e _ 2 */ /* ------------------------------------------------------------------------ */ /* ------- */ /* Edges */ /* ------- */ #define WrongNumEntity Message::Error("Wrong Edge number in 'BF_Edge_2E'") void BF_Edge_2E(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { switch (Element->Type) { case LINE : switch(NumEntity) { case 1 : s[0] = u ; s[1] = 0. ; s[2] = 0. ; break ; default : WrongNumEntity ; } break ; case TRIANGLE : switch(NumEntity) { case 1 : s[0] = -2.0*u+1.0-v ; s[1] = -u ; s[2] = 0. ; break ; case 2 : s[0] = -v ; s[1] = -2.0*v+1.0-u ; s[2] = 0. ; break ; case 3 : s[0] = v ; s[1] = u ; s[2] = 0. ; break ; default : WrongNumEntity ; } break ; case QUADRANGLE : switch(NumEntity) { default : Message::Error("BF_Edge_2E not ready for QUADRANGLE"); } break ; case TETRAHEDRON : switch(NumEntity) { case 1 : s[0] = -2.0*u+1.0-v-w ; s[1] = -u ; s[2] = -u ; break ; case 2 : s[0] = -v ; s[1] = -2.0*v+1.0-u-w ; s[2] = -v ; break ; case 3 : s[0] = -w ; s[1] = -w ; s[2] = -2.0*w+1.0-u-v ; break ; case 4 : s[0] = v ; s[1] = u ; s[2] = 0. ; break ; case 5 : s[0] = w ; s[1] = 0. ; s[2] = u ; break ; case 6 : s[0] = 0. ; s[1] = w ; s[2] = v ; break ; default : WrongNumEntity ; } break ; case HEXAHEDRON : switch(NumEntity) { default : Message::Error("BF_Edge_2E not ready for HEXAHEDRON"); } break ; case PRISM : switch(NumEntity) { default : Message::Error("BF_Edge_2E not ready for PRISM"); } break ; case PYRAMID : switch(NumEntity) { default : Message::Error("BF_Edge_2E not ready for PYRAMID"); } break ; default : Message::Error("Unknown type of Element in BF_Edge_2E"); break ; } } #undef WrongNumEntity /* ------- */ /* Faces */ /* ------- */ #define WrongNumEntity Message::Error("Wrong Face number in 'BF_Edge_2F'") void BF_Edge_2F(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { Message::Error("You should never end up here!") ; } #undef WrongNumEntity /* -------- */ /* Volume */ /* -------- */ void BF_Edge_2V(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { Message::Error("You should never end up here!") ; } /* ------------------------------------------------------------------------ */ /* B F _ C u r l E d g e _ 2 */ /* ------------------------------------------------------------------------ */ /* ------- */ /* Edges */ /* ------- */ void BF_CurlEdge_2E(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { s[0] = 0. ; s[1] = 0. ; s[2] = 0. ; } /* ------- */ /* Faces */ /* ------- */ void BF_CurlEdge_2F(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { s[0] = 0. ; s[1] = 0. ; s[2] = 0. ; } /* -------- */ /* Volume */ /* -------- */ void BF_CurlEdge_2V(struct Element * Element, int NumEntity, double u, double v, double w, double s[]) { s[0] = 0. ; s[1] = 0. ; s[2] = 0. ; } getdp-2.7.0-source/Legacy/Pos_Element.cpp000644 001750 001750 00000126560 12473553042 021742 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Christophe Trophime // #include #include "Pos_Element.h" #include "GeoData.h" #include "Get_Geometry.h" #include "Get_DofOfElement.h" #include "Cal_Value.h" #include "MallocUtils.h" #include "Message.h" extern struct CurrentData Current ; /* ------------------------------------------------------------------------ */ /* Create/Destroy/Compare */ /* ------------------------------------------------------------------------ */ void Alloc_PostElement(struct PostElement * PostElement) { PostElement->NumNodes = (int *) Malloc(PostElement->NbrNodes * sizeof(int)) ; /* allocate as much as possible in one step */ PostElement->u = (double *) Malloc(6 * PostElement->NbrNodes * sizeof(double)) ; PostElement->v = &PostElement->u[PostElement->NbrNodes] ; PostElement->w = &PostElement->u[2*PostElement->NbrNodes] ; PostElement->x = &PostElement->u[3*PostElement->NbrNodes] ; PostElement->y = &PostElement->u[4*PostElement->NbrNodes] ; PostElement->z = &PostElement->u[5*PostElement->NbrNodes] ; PostElement->Value = (struct Value *) Malloc(PostElement->NbrNodes * sizeof(struct Value)) ; } struct PostElement * Create_PostElement(int Index, int Type, int NbrNodes, int Depth) { struct PostElement * PostElement ; PostElement = (struct PostElement *) Malloc(sizeof(struct PostElement)) ; PostElement->Index = Index ; PostElement->Type = Type ; PostElement->Depth = Depth ; PostElement->NbrNodes = NbrNodes ; if(NbrNodes > 0) Alloc_PostElement(PostElement); return PostElement ; } void Destroy_PostElement(struct PostElement * PostElement) { if(PostElement->NbrNodes > 0){ Free(PostElement->NumNodes) ; if(PostElement->u) Free(PostElement->u); /* normal case */ else if(PostElement->x) Free(PostElement->x); /* partial copy */ Free(PostElement->Value) ; } Free(PostElement) ; } struct PostElement * NodeCopy_PostElement(struct PostElement *PostElement) { struct PostElement * Copy ; int i ; Copy = (struct PostElement *) Malloc(sizeof(struct PostElement)) ; Copy->Index = PostElement->Index ; Copy->Type = PostElement->Type ; Copy->Depth = PostElement->Depth ; Copy->NbrNodes = PostElement->NbrNodes ; if(Copy->NbrNodes > 0){ Alloc_PostElement(Copy); for(i = 0 ; i < Copy->NbrNodes ; i++){ Copy->NumNodes[i] = PostElement->NumNodes[i]; Copy->u[i] = PostElement->u[i] ; Copy->v[i] = PostElement->v[i] ; Copy->w[i] = PostElement->w[i] ; Copy->x[i] = PostElement->x[i] ; Copy->y[i] = PostElement->y[i] ; Copy->z[i] = PostElement->z[i] ; } } return Copy ; } struct PostElement * PartialCopy_PostElement(struct PostElement *PostElement) { struct PostElement * Copy ; int i ; Copy = (struct PostElement *) Malloc(sizeof(struct PostElement)) ; Copy->Index = PostElement->Index ; Copy->Type = PostElement->Type ; Copy->Depth = PostElement->Depth ; Copy->NbrNodes = PostElement->NbrNodes ; if(Copy->NbrNodes > 0){ Copy->NumNodes = NULL ; Copy->u = Copy->v = Copy->w = NULL ; /* allocate as much as possible in one step */ Copy->x = (double *) Malloc(3* Copy->NbrNodes * sizeof(double)) ; Copy->y = &Copy->x[Copy->NbrNodes]; Copy->z = &Copy->x[2 * Copy->NbrNodes]; Copy->Value = (struct Value *) Malloc(Copy->NbrNodes * sizeof(struct Value)) ; for(i = 0 ; i < Copy->NbrNodes ; i++){ Copy->x[i] = PostElement->x[i] ; Copy->y[i] = PostElement->y[i] ; Copy->z[i] = PostElement->z[i] ; Cal_CopyValue(&PostElement->Value[i], &Copy->Value[i]); } } return Copy ; } /* 2 PostElements never have the same barycenter unless they are identical */ int fcmp_PostElement(const void *a, const void *b) { struct PostElement *PE1, *PE2 ; double s1, s2, TOL=Current.GeoData->CharacteristicLength * 1.e-12 ; int i; PE1 = *(struct PostElement**)a; PE2 = *(struct PostElement**)b; if(PE1->NbrNodes != PE2->NbrNodes) return PE1->NbrNodes - PE2->NbrNodes; s1 = s2 = 0.0 ; for(i=0;iNbrNodes;i++){ s1 += PE1->x[i]; s2 += PE2->x[i]; } if(s1-s2 > TOL) return 1; else if(s1-s2 < -TOL) return -1; s1 = s2 = 0.0 ; for(i=0;iNbrNodes;i++){ s1 += PE1->y[i]; s2 += PE2->y[i]; } if(s1-s2 > TOL) return 1; else if(s1-s2 < -TOL) return -1; s1 = s2 = 0.0 ; for(i=0;iNbrNodes;i++){ s1 += PE1->z[i]; s2 += PE2->z[i]; } if(s1-s2 > TOL) return 1; else if(s1-s2 < -TOL) return -1; return 0; } int fcmp_PostElement_v0(const void *a, const void *b) { return (int)( (*(struct PostElement**)a)->v[0] - (*(struct PostElement**)b)->v[0] ) ; } int fcmp_PostElement_absu0(const void *a, const void *b) { return (int)( fabs((*(struct PostElement**)b)->u[0]) - fabs((*(struct PostElement**)a)->u[0]) ) ; } /* ------------------------------------------------------------------------ */ /* C u t _ P o s t E l e m e n t */ /* ------------------------------------------------------------------------ */ void Cut_PostElement(struct PostElement * PE, struct Geo_Element * GE, List_T * PE_L, int Index, int Depth, int Skin, int DecomposeInSimplex) { struct Element E ; struct PostElement * C[8] ; double u01, u02, u03, u12, u13, u23 ; double v01, v02, v03, v12, v13, v23 ; double w01, w02, w03, w12, w13, w23 ; int i, j, NbCut = 0 ; /* Recursive division */ if(PE->Depth < Depth){ switch(PE->Type){ case POINT : Message::Error("Impossible to divide a Point recursively"); break; case LINE : case LINE_2 : u01 = .5 * (PE->u[0] + PE->u[1]); v01 = .5 * (PE->v[0] + PE->v[1]); w01 = .5 * (PE->w[0] + PE->w[1]); C[0] = Create_PostElement(Index, LINE, 2, PE->Depth) ; C[0]->u[0] = PE->u[0] ; C[0]->v[0] = PE->v[0] ; C[0]->w[0] = PE->w[0] ; C[0]->u[1] = u01 ; C[0]->v[1] = v01 ; C[0]->w[1] = w01 ; C[1] = PE ; C[1]->u[0] = u01 ; C[1]->v[0] = v01 ; C[1]->w[0] = w01 ; NbCut = 2 ; break; case TRIANGLE : case TRIANGLE_2 : u01 = .5 * (PE->u[0] + PE->u[1]); u02 = .5 * (PE->u[0] + PE->u[2]); v01 = .5 * (PE->v[0] + PE->v[1]); v02 = .5 * (PE->v[0] + PE->v[2]); w01 = .5 * (PE->w[0] + PE->w[1]); w02 = .5 * (PE->w[0] + PE->w[2]); u12 = .5 * (PE->u[1] + PE->u[2]); v12 = .5 * (PE->v[1] + PE->v[2]); w12 = .5 * (PE->w[1] + PE->w[2]); C[0] = Create_PostElement(Index, TRIANGLE, 3, PE->Depth) ; C[0]->u[0] = PE->u[0] ; C[0]->v[0] = PE->v[0] ; C[0]->w[0] = PE->w[0] ; C[0]->u[1] = u01 ; C[0]->v[1] = v01 ; C[0]->w[1] = w01 ; C[0]->u[2] = u02 ; C[0]->v[2] = v02 ; C[0]->w[2] = w02 ; C[1] = Create_PostElement(Index, TRIANGLE, 3, PE->Depth) ; C[1]->u[0] = u01 ; C[1]->v[0] = v01 ; C[1]->w[0] = w01 ; C[1]->u[1] = PE->u[1] ; C[1]->v[1] = PE->v[1] ; C[1]->w[1] = PE->w[1] ; C[1]->u[2] = u12 ; C[1]->v[2] = v12 ; C[1]->w[2] = w12 ; C[2] = Create_PostElement(Index, TRIANGLE, 3, PE->Depth) ; C[2]->u[0] = u02 ; C[2]->v[0] = v02 ; C[2]->w[0] = w02 ; C[2]->u[1] = u12 ; C[2]->v[1] = v12 ; C[2]->w[1] = w12 ; C[2]->u[2] = PE->u[2] ; C[2]->v[2] = PE->v[2] ; C[2]->w[2] = PE->w[2] ; C[3] = PE ; C[3]->u[0] = u01 ; C[3]->v[0] = v01 ; C[3]->w[0] = w01 ; C[3]->u[1] = u12 ; C[3]->v[1] = v12 ; C[3]->w[1] = w12 ; C[3]->u[2] = u02 ; C[3]->v[2] = v02 ; C[3]->w[2] = w02 ; NbCut = 4 ; break; case TETRAHEDRON : u01 = .5 * (PE->u[0] + PE->u[1]); u02 = .5 * (PE->u[0] + PE->u[2]); v01 = .5 * (PE->v[0] + PE->v[1]); v02 = .5 * (PE->v[0] + PE->v[2]); w01 = .5 * (PE->w[0] + PE->w[1]); w02 = .5 * (PE->w[0] + PE->w[2]); u03 = .5 * (PE->u[0] + PE->u[3]); u12 = .5 * (PE->u[1] + PE->u[2]); v03 = .5 * (PE->v[0] + PE->v[3]); v12 = .5 * (PE->v[1] + PE->v[2]); w03 = .5 * (PE->w[0] + PE->w[3]); w12 = .5 * (PE->w[1] + PE->w[2]); u13 = .5 * (PE->u[1] + PE->u[3]); u23 = .5 * (PE->u[2] + PE->u[3]); v13 = .5 * (PE->v[1] + PE->v[3]); v23 = .5 * (PE->v[2] + PE->v[3]); w13 = .5 * (PE->w[1] + PE->w[3]); w23 = .5 * (PE->w[2] + PE->w[3]); C[0] = Create_PostElement(Index, TETRAHEDRON, 4, PE->Depth) ; C[0]->u[0] = PE->u[0] ; C[0]->v[0] = PE->v[0] ; C[0]->w[0] = PE->w[0] ; C[0]->u[1] = u01 ; C[0]->v[1] = v01 ; C[0]->w[1] = w01 ; C[0]->u[2] = u02 ; C[0]->v[2] = v02 ; C[0]->w[2] = w02 ; C[0]->u[3] = u03 ; C[0]->v[3] = v03 ; C[0]->w[3] = w03 ; C[1] = Create_PostElement(Index, TETRAHEDRON, 4, PE->Depth) ; C[1]->u[0] = PE->u[1] ; C[1]->v[0] = PE->v[1] ; C[1]->w[0] = PE->w[1] ; C[1]->u[1] = u01 ; C[1]->v[1] = v01 ; C[1]->w[1] = w01 ; C[1]->u[2] = u12 ; C[1]->v[2] = v12 ; C[1]->w[2] = w12 ; C[1]->u[3] = u13 ; C[1]->v[3] = v13 ; C[1]->w[3] = w13 ; C[2] = Create_PostElement(Index, TETRAHEDRON, 4, PE->Depth) ; C[2]->u[0] = PE->u[2] ; C[2]->v[0] = PE->v[2] ; C[2]->w[0] = PE->w[2] ; C[2]->u[1] = u02 ; C[2]->v[1] = v02 ; C[2]->w[1] = w02 ; C[2]->u[2] = u12 ; C[2]->v[2] = v12 ; C[2]->w[2] = w12 ; C[2]->u[3] = u23 ; C[2]->v[3] = v23 ; C[2]->w[3] = w23 ; C[3] = Create_PostElement(Index, TETRAHEDRON, 4, PE->Depth) ; C[3]->u[0] = PE->u[3] ; C[3]->v[0] = PE->v[3] ; C[3]->w[0] = PE->w[3] ; C[3]->u[1] = u03 ; C[3]->v[1] = v03 ; C[3]->w[1] = w03 ; C[3]->u[2] = u13 ; C[3]->v[2] = v13 ; C[3]->w[2] = w13 ; C[3]->u[3] = u23 ; C[3]->v[3] = v23 ; C[3]->w[3] = w23 ; C[4] = Create_PostElement(Index, TETRAHEDRON, 4, PE->Depth) ; C[4]->u[0] = u01 ; C[4]->v[0] = v01 ; C[4]->w[0] = w01 ; C[4]->u[1] = u02 ; C[4]->v[1] = v02 ; C[4]->w[1] = w02 ; C[4]->u[2] = u03 ; C[4]->v[2] = v03 ; C[4]->w[2] = w03 ; C[4]->u[3] = u23 ; C[4]->v[3] = v23 ; C[4]->w[3] = w23 ; C[5] = Create_PostElement(Index, TETRAHEDRON, 4, PE->Depth) ; C[5]->u[0] = u01 ; C[5]->v[0] = v01 ; C[5]->w[0] = w01 ; C[5]->u[1] = u02 ; C[5]->v[1] = v02 ; C[5]->w[1] = w02 ; C[5]->u[2] = u12 ; C[5]->v[2] = v12 ; C[5]->w[2] = w12 ; C[5]->u[3] = u23 ; C[5]->v[3] = v23 ; C[5]->w[3] = w23 ; C[6] = Create_PostElement(Index, TETRAHEDRON, 4, PE->Depth) ; C[6]->u[0] = u01 ; C[6]->v[0] = v01 ; C[6]->w[0] = w01 ; C[6]->u[1] = u12 ; C[6]->v[1] = v12 ; C[6]->w[1] = w12 ; C[6]->u[2] = u13 ; C[6]->v[2] = v13 ; C[6]->w[2] = w13 ; C[6]->u[3] = u23 ; C[6]->v[3] = v23 ; C[6]->w[3] = w23 ; C[7] = PE ; C[7]->u[0] = u01 ; C[7]->v[0] = v01 ; C[7]->w[0] = w01 ; C[7]->u[1] = u03 ; C[7]->v[1] = v03 ; C[7]->w[1] = w03 ; C[7]->u[2] = u13 ; C[7]->v[2] = v13 ; C[7]->w[2] = w13 ; C[7]->u[3] = u23 ; C[7]->v[3] = v23 ; C[7]->w[3] = w23 ; NbCut = 8 ; break ; default : Message::Error("Recursive division not implemented for Quadrangles, Hexahedra, " "Prisms and Pyramids") ; break; } for(i = 0 ; i < NbCut ; i++){ C[i]->Depth ++ ; for(j = 0 ; j < C[i]->NbrNodes ; j++) C[i]->NumNodes[j] = -1 ; Cut_PostElement(C[i], GE, PE_L, Index, Depth, Skin, DecomposeInSimplex); } } else{ Get_InitDofOfElement(&E) ; E.GeoElement = GE ; E.Num = E.GeoElement->Num ; E.Type = E.GeoElement->Type ; E.Region = E.GeoElement->Region ; Get_NodesCoordinatesOfElement(&E) ; for(i = 0 ; i < PE->NbrNodes ; i++){ if( Skin == 0 && PE->Depth == 1 && ( DecomposeInSimplex == 0 || E.GeoElement->Type == LINE || E.GeoElement->Type == TRIANGLE || E.GeoElement->Type == TETRAHEDRON ) ){ PE->x[i] = E.x[i] ; PE->y[i] = E.y[i] ; PE->z[i] = E.z[i] ; } else{ Get_BFGeoElement(&E, PE->u[i], PE->v[i], PE->w[i]) ; PE->x[i] = PE->y[i] = PE->z[i] = 0. ; for (j = 0 ; j < E.GeoElement->NbrNodes ; j++) { PE->x[i] += E.x[j] * E.n[j] ; PE->y[i] += E.y[j] * E.n[j] ; PE->z[i] += E.z[j] * E.n[j] ; } } } List_Add(PE_L, &PE); } } /* ------------------------------------------------------------------------ */ /* F i l l _ P o s t E l e m e n t */ /* ------------------------------------------------------------------------ */ #define POS_CUT_FILL Cut_PostElement(PE, GE, PE_L, Index, Depth, 0, DecomposeInSimplex) #define POS_CUT_SKIN Cut_PostElement(PE, GE, PE_L, Index, Depth, 1, DecomposeInSimplex) void Fill_PostElement(struct Geo_Element * GE, List_T * PE_L, int Index, int Depth, int Skin, List_T * EvaluationPoints_L, int DecomposeInSimplex) { struct PostElement * PE ; int Nbr_EP, i_EP; if(!Depth){ PE = Create_PostElement(Index, POINT, 1, 0) ; switch(GE->Type){ case POINT : PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] = 0. ; break ; case LINE : case LINE_2 : PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] = 0. ; break ; case TRIANGLE : case TRIANGLE_2 : PE->u[0] = 1./3.; PE->v[0] = 1./3.; PE->w[0] = 0. ; break ; case QUADRANGLE : case QUADRANGLE_2: case QUADRANGLE_2_8N: PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] = 0. ; break ; case TETRAHEDRON : PE->u[0] = 0.25 ; PE->v[0] = 0.25 ; PE->w[0] = 0.25 ; break ; case HEXAHEDRON : PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] = 0. ; break ; case PRISM : PE->u[0] = 1./3.; PE->v[0] = 1./3.; PE->w[0] = 0. ; break ; case PYRAMID : PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] = 1./3.; break ; } POS_CUT_FILL ; } else{ if(!Skin){ switch(GE->Type){ case POINT : PE = Create_PostElement(Index, POINT, 1, 1) ; /* node 1 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] = 0. ; POS_CUT_FILL ; break ; case LINE : case LINE_2 : PE = Create_PostElement(Index, LINE, 2, 1) ; /* nodes 1 2 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[1] ; PE->u[0] =-1. ; PE->v[0] = 0. ; PE->w[0] = 0. ; PE->u[1] = 1. ; PE->v[1] = 0. ; PE->w[1] = 0. ; POS_CUT_FILL ; break ; case TRIANGLE : case TRIANGLE_2 : PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 1 2 3 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[1] ; PE->NumNodes[2] = GE->NumNodes[2] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] = 0. ; PE->u[1] = 1. ; PE->v[1] = 0. ; PE->w[1] = 0. ; PE->u[2] = 0. ; PE->v[2] = 1. ; PE->w[2] = 0. ; POS_CUT_FILL ; break ; case QUADRANGLE : case QUADRANGLE_2 : case QUADRANGLE_2_8N: if(DecomposeInSimplex){ PE = Create_PostElement(Index, TRIANGLE, 3, 1); /* nodes 1 2 4 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[1] ; PE->NumNodes[2] = GE->NumNodes[3] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] = 0. ; PE->u[1] = 1. ; PE->v[1] =-1. ; PE->w[1] = 0. ; PE->u[2] =-1. ; PE->v[2] = 1. ; PE->w[2] = 0. ; POS_CUT_FILL; PE = Create_PostElement(Index, TRIANGLE, 3, 1); /* nodes 2 3 4 */ PE->NumNodes[0] = GE->NumNodes[1] ; PE->NumNodes[1] = GE->NumNodes[2] ; PE->NumNodes[2] = GE->NumNodes[3] ; PE->u[0] = 1. ; PE->v[0] =-1. ; PE->w[0] = 0. ; PE->u[1] = 1. ; PE->v[1] = 1. ; PE->w[1] = 0. ; PE->u[2] =-1. ; PE->v[2] = 1. ; PE->w[2] = 0. ; POS_CUT_FILL; } else{ if (!EvaluationPoints_L) { PE = Create_PostElement(Index, QUADRANGLE, 4, 1) ; /* nodes 1 2 3 4 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[1] ; PE->NumNodes[2] = GE->NumNodes[2] ; PE->NumNodes[3] = GE->NumNodes[3] ; PE->u[0] = -1. ; PE->v[0] = -1. ; PE->w[0] = 0. ; PE->u[1] = 1. ; PE->v[1] = -1. ; PE->w[1] = 0. ; PE->u[2] = 1. ; PE->v[2] = 1. ; PE->w[2] = 0. ; PE->u[3] = -1. ; PE->v[3] = 1. ; PE->w[3] = 0. ; } else { /* Only for Quadrangles now, to be extended... */ Nbr_EP = List_Nbr(EvaluationPoints_L)/3; PE = Create_PostElement(Index, QUADRANGLE, Nbr_EP, 1) ; for (i_EP=0 ; i_EPu[i_EP]); List_Read(EvaluationPoints_L, i_EP*3+1, &PE->v[i_EP]); List_Read(EvaluationPoints_L, i_EP*3+2, &PE->w[i_EP]); } } POS_CUT_FILL ; } break ; case TETRAHEDRON : PE = Create_PostElement(Index, TETRAHEDRON, 4, 1) ; /* nodes 1 2 3 4 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[1] ; PE->NumNodes[2] = GE->NumNodes[2] ; PE->NumNodes[3] = GE->NumNodes[3] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] = 0. ; PE->u[1] = 1. ; PE->v[1] = 0. ; PE->w[1] = 0. ; PE->u[2] = 0. ; PE->v[2] = 1. ; PE->w[2] = 0. ; PE->u[3] = 0. ; PE->v[3] = 0. ; PE->w[3] = 1. ; POS_CUT_FILL; break ; case HEXAHEDRON : if(DecomposeInSimplex){ PE = Create_PostElement(Index, TETRAHEDRON, 4, 1); /* nodes 1 2 3 6 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[1] ; PE->NumNodes[2] = GE->NumNodes[2] ; PE->NumNodes[3] = GE->NumNodes[5] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] =-1. ; PE->u[1] = 1. ; PE->v[1] =-1. ; PE->w[1] =-1. ; PE->u[2] = 1. ; PE->v[2] = 1. ; PE->w[2] =-1. ; PE->u[3] = 1. ; PE->v[3] =-1. ; PE->w[3] = 1. ; POS_CUT_FILL; PE = Create_PostElement(Index, TETRAHEDRON, 4, 1); /* nodes 1 3 6 7 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[2] ; PE->NumNodes[2] = GE->NumNodes[5] ; PE->NumNodes[3] = GE->NumNodes[6] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] =-1. ; PE->u[1] = 1. ; PE->v[1] = 1. ; PE->w[1] =-1. ; PE->u[2] = 1. ; PE->v[2] =-1. ; PE->w[2] = 1. ; PE->u[3] = 1. ; PE->v[3] = 1. ; PE->w[3] = 1. ; POS_CUT_FILL; PE = Create_PostElement(Index, TETRAHEDRON, 4, 1); /* nodes 1 5 6 7 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[4] ; PE->NumNodes[2] = GE->NumNodes[5] ; PE->NumNodes[3] = GE->NumNodes[6] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] =-1. ; PE->u[1] =-1. ; PE->v[1] =-1. ; PE->w[1] = 1. ; PE->u[2] = 1. ; PE->v[2] =-1. ; PE->w[2] = 1. ; PE->u[3] = 1. ; PE->v[3] = 1. ; PE->w[3] = 1. ; POS_CUT_FILL; PE = Create_PostElement(Index, TETRAHEDRON, 4, 1); /* nodes 1 3 4 7 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[2] ; PE->NumNodes[2] = GE->NumNodes[3] ; PE->NumNodes[3] = GE->NumNodes[6] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] =-1. ; PE->u[1] = 1. ; PE->v[1] = 1. ; PE->w[1] =-1. ; PE->u[2] =-1. ; PE->v[2] = 1. ; PE->w[2] =-1. ; PE->u[3] = 1. ; PE->v[3] = 1. ; PE->w[3] = 1. ; POS_CUT_FILL; PE = Create_PostElement(Index, TETRAHEDRON, 4, 1); /* nodes 1 5 7 8 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[4] ; PE->NumNodes[2] = GE->NumNodes[6] ; PE->NumNodes[3] = GE->NumNodes[7] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] =-1. ; PE->u[1] =-1. ; PE->v[1] =-1. ; PE->w[1] = 1. ; PE->u[2] = 1. ; PE->v[2] = 1. ; PE->w[2] = 1. ; PE->u[3] =-1. ; PE->v[3] = 1. ; PE->w[3] = 1. ; POS_CUT_FILL; PE = Create_PostElement(Index, TETRAHEDRON, 4, 1); /* nodes 1 4 7 8 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[3] ; PE->NumNodes[2] = GE->NumNodes[6] ; PE->NumNodes[3] = GE->NumNodes[7] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] =-1. ; PE->u[1] =-1. ; PE->v[1] = 1. ; PE->w[1] =-1. ; PE->u[2] = 1. ; PE->v[2] = 1. ; PE->w[2] = 1. ; PE->u[3] =-1. ; PE->v[3] = 1. ; PE->w[3] = 1. ; POS_CUT_FILL; } else{ PE = Create_PostElement(Index, HEXAHEDRON, 8, 1) ; /* nodes 1 2 3 4 5 6 7 8 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[1] ; PE->NumNodes[2] = GE->NumNodes[2] ; PE->NumNodes[3] = GE->NumNodes[3] ; PE->NumNodes[4] = GE->NumNodes[4] ; PE->NumNodes[5] = GE->NumNodes[5] ; PE->NumNodes[6] = GE->NumNodes[6] ; PE->NumNodes[7] = GE->NumNodes[7] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] =-1. ; PE->u[1] = 1. ; PE->v[1] =-1. ; PE->w[1] =-1. ; PE->u[2] = 1. ; PE->v[2] = 1. ; PE->w[2] =-1. ; PE->u[3] =-1. ; PE->v[3] = 1. ; PE->w[3] =-1. ; PE->u[4] =-1. ; PE->v[4] =-1. ; PE->w[4] = 1. ; PE->u[5] = 1. ; PE->v[5] =-1. ; PE->w[5] = 1. ; PE->u[6] = 1. ; PE->v[6] = 1. ; PE->w[6] = 1. ; PE->u[7] =-1. ; PE->v[7] = 1. ; PE->w[7] = 1. ; POS_CUT_FILL; } break ; case PRISM : if(DecomposeInSimplex){ PE = Create_PostElement(Index, TETRAHEDRON, 4, 1); /* nodes 1 2 3 5 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[1] ; PE->NumNodes[2] = GE->NumNodes[2] ; PE->NumNodes[3] = GE->NumNodes[4] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] =-1. ; PE->u[1] = 1. ; PE->v[1] = 0. ; PE->w[1] =-1. ; PE->u[2] = 0. ; PE->v[2] = 1. ; PE->w[2] =-1. ; PE->u[3] = 1. ; PE->v[3] = 0. ; PE->w[3] = 1. ; POS_CUT_FILL; PE = Create_PostElement(Index, TETRAHEDRON, 4, 1); /* nodes 1 3 5 6 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[2] ; PE->NumNodes[2] = GE->NumNodes[4] ; PE->NumNodes[3] = GE->NumNodes[5] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] =-1. ; PE->u[1] = 0. ; PE->v[1] = 1. ; PE->w[1] =-1. ; PE->u[2] = 1. ; PE->v[2] = 0. ; PE->w[2] = 1. ; PE->u[3] = 0. ; PE->v[3] = 1. ; PE->w[3] = 1. ; POS_CUT_FILL; PE = Create_PostElement(Index, TETRAHEDRON, 4, 1); /* nodes 1 4 5 6 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[3] ; PE->NumNodes[2] = GE->NumNodes[4] ; PE->NumNodes[3] = GE->NumNodes[5] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] =-1. ; PE->u[1] = 0. ; PE->v[1] = 0. ; PE->w[1] = 1. ; PE->u[2] = 1. ; PE->v[2] = 0. ; PE->w[2] = 1. ; PE->u[3] = 0. ; PE->v[3] = 1. ; PE->w[3] = 1. ; POS_CUT_FILL; } else{ PE = Create_PostElement(Index, PRISM, 6, 1) ; /* nodes 1 2 3 4 5 6 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[1] ; PE->NumNodes[2] = GE->NumNodes[2] ; PE->NumNodes[3] = GE->NumNodes[3] ; PE->NumNodes[4] = GE->NumNodes[4] ; PE->NumNodes[5] = GE->NumNodes[5] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] =-1. ; PE->u[1] = 1. ; PE->v[1] = 0. ; PE->w[1] =-1. ; PE->u[2] = 0. ; PE->v[2] = 1. ; PE->w[2] =-1. ; PE->u[3] = 0. ; PE->v[3] = 0. ; PE->w[3] = 1. ; PE->u[4] = 1. ; PE->v[4] = 0. ; PE->w[4] = 1. ; PE->u[5] = 0. ; PE->v[5] = 1. ; PE->w[5] = 1. ; POS_CUT_FILL; } break ; case PYRAMID : if(DecomposeInSimplex){ PE = Create_PostElement(Index, TETRAHEDRON, 4, 1); /* nodes 1 2 4 5 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[1] ; PE->NumNodes[2] = GE->NumNodes[3] ; PE->NumNodes[3] = GE->NumNodes[4] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] = 0. ; PE->u[1] = 1. ; PE->v[1] =-1. ; PE->w[1] = 0. ; PE->u[2] =-1. ; PE->v[2] = 1. ; PE->w[2] = 0. ; PE->u[3] = 0. ; PE->v[3] = 0. ; PE->w[3] = 1. ; POS_CUT_FILL; PE = Create_PostElement(Index, TETRAHEDRON, 4, 1); /* nodes 2 3 4 5 */ PE->NumNodes[0] = GE->NumNodes[1] ; PE->NumNodes[1] = GE->NumNodes[2] ; PE->NumNodes[2] = GE->NumNodes[3] ; PE->NumNodes[3] = GE->NumNodes[4] ; PE->u[0] = 1. ; PE->v[0] =-1. ; PE->w[0] = 0. ; PE->u[1] = 1. ; PE->v[1] = 1. ; PE->w[1] = 0. ; PE->u[2] =-1. ; PE->v[2] = 1. ; PE->w[2] = 0. ; PE->u[3] = 0. ; PE->v[3] = 0. ; PE->w[3] = 1. ; POS_CUT_FILL; } else{ PE = Create_PostElement(Index, PYRAMID, 5, 1) ; /* nodes 1 2 3 4 5 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[1] ; PE->NumNodes[2] = GE->NumNodes[2] ; PE->NumNodes[3] = GE->NumNodes[3] ; PE->NumNodes[4] = GE->NumNodes[4] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] = 0. ; PE->u[1] = 1. ; PE->v[1] =-1. ; PE->w[1] = 0. ; PE->u[2] = 1. ; PE->v[2] = 1. ; PE->w[2] = 0. ; PE->u[3] =-1. ; PE->v[3] = 1. ; PE->w[3] = 0. ; PE->u[4] = 0. ; PE->v[4] = 0. ; PE->w[4] = 1. ; POS_CUT_FILL; } break ; } } else { /* Skin: facets oriented with normals pointing outwards */ switch(GE->Type){ case TRIANGLE : PE = Create_PostElement(Index, LINE, 2, 1) ; /* nodes 1 2 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[1] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] = 0. ; PE->u[1] = 1. ; PE->v[1] = 0. ; PE->w[1] = 0. ; POS_CUT_SKIN ; PE = Create_PostElement(Index, LINE, 2, 1) ; /* nodes 2 3 */ PE->NumNodes[0] = GE->NumNodes[1] ; PE->NumNodes[1] = GE->NumNodes[2] ; PE->u[0] = 1. ; PE->v[0] = 0. ; PE->w[0] = 0. ; PE->u[1] = 0. ; PE->v[1] = 1. ; PE->w[1] = 0. ; POS_CUT_SKIN ; PE = Create_PostElement(Index, LINE, 2, 1) ; /* nodes 3 1 */ PE->NumNodes[0] = GE->NumNodes[2] ; PE->NumNodes[1] = GE->NumNodes[0] ; PE->u[0] = 0. ; PE->v[0] = 1. ; PE->w[0] = 0. ; PE->u[1] = 0. ; PE->v[1] = 0. ; PE->w[1] = 0. ; POS_CUT_SKIN ; break ; case QUADRANGLE : PE = Create_PostElement(Index, LINE, 2, 1) ; /* nodes 1 2 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[1] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] = 0. ; PE->u[1] = 1. ; PE->v[1] =-1. ; PE->w[1] = 0. ; POS_CUT_SKIN ; PE = Create_PostElement(Index, LINE, 2, 1) ; /* nodes 2 3 */ PE->NumNodes[0] = GE->NumNodes[1] ; PE->NumNodes[1] = GE->NumNodes[2] ; PE->u[0] = 1. ; PE->v[0] =-1. ; PE->w[0] = 0. ; PE->u[1] = 1. ; PE->v[1] = 1. ; PE->w[1] = 0. ; POS_CUT_SKIN ; PE = Create_PostElement(Index, LINE, 2, 1) ; /* nodes 3 4 */ PE->NumNodes[0] = GE->NumNodes[2] ; PE->NumNodes[1] = GE->NumNodes[3] ; PE->u[0] = 1. ; PE->v[0] = 1. ; PE->w[0] = 0. ; PE->u[1] =-1. ; PE->v[1] = 1. ; PE->w[1] = 0. ; POS_CUT_SKIN ; PE = Create_PostElement(Index, LINE, 2, 1) ; /* nodes 4 1 */ PE->NumNodes[0] = GE->NumNodes[3] ; PE->NumNodes[1] = GE->NumNodes[0] ; PE->u[0] =-1. ; PE->v[0] = 1. ; PE->w[0] = 0. ; PE->u[1] =-1. ; PE->v[1] =-1. ; PE->w[1] = 0. ; POS_CUT_SKIN ; break ; case TETRAHEDRON : PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 1 2 4 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[1] ; PE->NumNodes[2] = GE->NumNodes[3] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] = 0. ; PE->u[1] = 1. ; PE->v[1] = 0. ; PE->w[1] = 0. ; PE->u[2] = 0. ; PE->v[2] = 0. ; PE->w[2] = 1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 1 3 2 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[2] ; PE->NumNodes[2] = GE->NumNodes[1] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] = 0. ; PE->u[1] = 0. ; PE->v[1] = 1. ; PE->w[1] = 0. ; PE->u[2] = 1. ; PE->v[2] = 0. ; PE->w[2] = 0. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 1 4 3 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[3] ; PE->NumNodes[2] = GE->NumNodes[2] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] = 0. ; PE->u[1] = 0. ; PE->v[1] = 0. ; PE->w[1] = 1. ; PE->u[2] = 0. ; PE->v[2] = 1. ; PE->w[2] = 0. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 2 3 4 */ PE->NumNodes[0] = GE->NumNodes[1] ; PE->NumNodes[1] = GE->NumNodes[2] ; PE->NumNodes[2] = GE->NumNodes[3] ; PE->u[0] = 1. ; PE->v[0] = 0. ; PE->w[0] = 0. ; PE->u[1] = 0. ; PE->v[1] = 1. ; PE->w[1] = 0. ; PE->u[2] = 0. ; PE->v[2] = 0. ; PE->w[2] = 1. ; POS_CUT_SKIN; break ; case HEXAHEDRON : if(DecomposeInSimplex){ PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 1 4 2 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[3] ; PE->NumNodes[2] = GE->NumNodes[1] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] =-1. ; PE->u[1] =-1. ; PE->v[1] = 1. ; PE->w[1] =-1. ; PE->u[2] = 1. ; PE->v[2] =-1. ; PE->w[2] =-1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 2 4 3 */ PE->NumNodes[0] = GE->NumNodes[1] ; PE->NumNodes[1] = GE->NumNodes[3] ; PE->NumNodes[2] = GE->NumNodes[2] ; PE->u[0] = 1. ; PE->v[0] =-1. ; PE->w[0] =-1. ; PE->u[1] =-1. ; PE->v[1] = 1. ; PE->w[1] =-1. ; PE->u[2] = 1. ; PE->v[2] = 1. ; PE->w[2] =-1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 5 6 8 */ PE->NumNodes[0] = GE->NumNodes[4] ; PE->NumNodes[1] = GE->NumNodes[5] ; PE->NumNodes[2] = GE->NumNodes[7] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] = 1. ; PE->u[1] = 1. ; PE->v[1] =-1. ; PE->w[1] = 1. ; PE->u[2] =-1. ; PE->v[2] = 1. ; PE->w[2] = 1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 6 7 8 */ PE->NumNodes[0] = GE->NumNodes[5] ; PE->NumNodes[1] = GE->NumNodes[6] ; PE->NumNodes[2] = GE->NumNodes[7] ; PE->u[0] = 1. ; PE->v[0] =-1. ; PE->w[0] = 1. ; PE->u[1] = 1. ; PE->v[1] = 1. ; PE->w[1] = 1. ; PE->u[2] =-1. ; PE->v[2] = 1. ; PE->w[2] = 1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 1 5 4 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[4] ; PE->NumNodes[2] = GE->NumNodes[3] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] =-1. ; PE->u[1] =-1. ; PE->v[1] =-1. ; PE->w[1] = 1. ; PE->u[2] =-1. ; PE->v[2] = 1. ; PE->w[2] =-1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 5 8 4 */ PE->NumNodes[0] = GE->NumNodes[4] ; PE->NumNodes[1] = GE->NumNodes[7] ; PE->NumNodes[2] = GE->NumNodes[3] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] = 1. ; PE->u[1] =-1. ; PE->v[1] = 1. ; PE->w[1] = 1. ; PE->u[2] =-1. ; PE->v[2] = 1. ; PE->w[2] =-1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 2 3 6 */ PE->NumNodes[0] = GE->NumNodes[1] ; PE->NumNodes[1] = GE->NumNodes[2] ; PE->NumNodes[2] = GE->NumNodes[5] ; PE->u[0] = 1. ; PE->v[0] =-1. ; PE->w[0] =-1. ; PE->u[1] = 1. ; PE->v[1] = 1. ; PE->w[1] =-1. ; PE->u[2] = 1. ; PE->v[2] =-1. ; PE->w[2] = 1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 6 3 7 */ PE->NumNodes[0] = GE->NumNodes[5] ; PE->NumNodes[1] = GE->NumNodes[2] ; PE->NumNodes[2] = GE->NumNodes[6] ; PE->u[0] = 1. ; PE->v[0] =-1. ; PE->w[0] = 1. ; PE->u[1] = 1. ; PE->v[1] = 1. ; PE->w[1] =-1. ; PE->u[2] = 1. ; PE->v[2] = 1. ; PE->w[2] = 1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 5 1 6 */ PE->NumNodes[0] = GE->NumNodes[4] ; PE->NumNodes[1] = GE->NumNodes[0] ; PE->NumNodes[2] = GE->NumNodes[5] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] = 1. ; PE->u[1] =-1. ; PE->v[1] =-1. ; PE->w[1] =-1. ; PE->u[2] = 1. ; PE->v[2] =-1. ; PE->w[2] = 1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 6 1 2 */ PE->NumNodes[0] = GE->NumNodes[5] ; PE->NumNodes[1] = GE->NumNodes[0] ; PE->NumNodes[2] = GE->NumNodes[1] ; PE->u[0] = 1. ; PE->v[0] =-1. ; PE->w[0] = 1. ; PE->u[1] =-1. ; PE->v[1] =-1. ; PE->w[1] =-1. ; PE->u[2] = 1. ; PE->v[2] =-1. ; PE->w[2] =-1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 8 7 4 */ PE->NumNodes[0] = GE->NumNodes[7] ; PE->NumNodes[1] = GE->NumNodes[6] ; PE->NumNodes[2] = GE->NumNodes[3] ; PE->u[0] =-1. ; PE->v[0] = 1. ; PE->w[0] = 1. ; PE->u[1] = 1. ; PE->v[1] = 1. ; PE->w[1] = 1. ; PE->u[2] =-1. ; PE->v[2] = 1. ; PE->w[2] =-1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 7 3 4 */ PE->NumNodes[0] = GE->NumNodes[6] ; PE->NumNodes[1] = GE->NumNodes[2] ; PE->NumNodes[2] = GE->NumNodes[3] ; PE->u[0] = 1. ; PE->v[0] = 1. ; PE->w[0] = 1. ; PE->u[1] = 1. ; PE->v[1] = 1. ; PE->w[1] =-1. ; PE->u[2] =-1. ; PE->v[2] = 1. ; PE->w[2] =-1. ; POS_CUT_SKIN; } else{ PE = Create_PostElement(Index, QUADRANGLE, 4, 1) ; /* nodes 1 2 6 5 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[1] ; PE->NumNodes[2] = GE->NumNodes[5] ; PE->NumNodes[3] = GE->NumNodes[4] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] =-1. ; PE->u[1] = 1. ; PE->v[1] =-1. ; PE->w[1] =-1. ; PE->u[2] = 1. ; PE->v[2] =-1. ; PE->w[2] = 1. ; PE->u[3] =-1. ; PE->v[3] =-1. ; PE->w[3] = 1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, QUADRANGLE, 4, 1) ; /* nodes 1 4 3 2 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[3] ; PE->NumNodes[2] = GE->NumNodes[2] ; PE->NumNodes[3] = GE->NumNodes[1] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] =-1. ; PE->u[1] =-1. ; PE->v[1] = 1. ; PE->w[1] =-1. ; PE->u[2] = 1. ; PE->v[2] = 1. ; PE->w[2] =-1. ; PE->u[3] = 1. ; PE->v[3] =-1. ; PE->w[3] =-1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, QUADRANGLE, 4, 1) ; /* nodes 1 5 8 4 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[4] ; PE->NumNodes[2] = GE->NumNodes[7] ; PE->NumNodes[3] = GE->NumNodes[3] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] =-1. ; PE->u[1] =-1. ; PE->v[1] =-1. ; PE->w[1] = 1. ; PE->u[2] =-1. ; PE->v[2] = 1. ; PE->w[2] = 1. ; PE->u[3] =-1. ; PE->v[3] = 1. ; PE->w[3] =-1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, QUADRANGLE, 4, 1) ; /* nodes 2 3 7 6 */ PE->NumNodes[0] = GE->NumNodes[1] ; PE->NumNodes[1] = GE->NumNodes[2] ; PE->NumNodes[2] = GE->NumNodes[6] ; PE->NumNodes[3] = GE->NumNodes[5] ; PE->u[0] = 1. ; PE->v[0] =-1. ; PE->w[0] =-1. ; PE->u[1] = 1. ; PE->v[1] = 1. ; PE->w[1] =-1. ; PE->u[2] = 1. ; PE->v[2] = 1. ; PE->w[2] = 1. ; PE->u[3] = 1. ; PE->v[3] =-1. ; PE->w[3] = 1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, QUADRANGLE, 4, 1) ; /* nodes 3 4 8 7 */ PE->NumNodes[0] = GE->NumNodes[2] ; PE->NumNodes[1] = GE->NumNodes[3] ; PE->NumNodes[2] = GE->NumNodes[7] ; PE->NumNodes[3] = GE->NumNodes[6] ; PE->u[0] = 1. ; PE->v[0] = 1. ; PE->w[0] =-1. ; PE->u[1] =-1. ; PE->v[1] = 1. ; PE->w[1] =-1. ; PE->u[2] =-1. ; PE->v[2] = 1. ; PE->w[2] = 1. ; PE->u[3] = 1. ; PE->v[3] = 1. ; PE->w[3] = 1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, QUADRANGLE, 4, 1) ; /* nodes 5 6 7 8 */ PE->NumNodes[0] = GE->NumNodes[4] ; PE->NumNodes[1] = GE->NumNodes[5] ; PE->NumNodes[2] = GE->NumNodes[6] ; PE->NumNodes[3] = GE->NumNodes[7] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] = 1. ; PE->u[1] = 1. ; PE->v[1] =-1. ; PE->w[1] = 1. ; PE->u[2] = 1. ; PE->v[2] = 1. ; PE->w[2] = 1. ; PE->u[3] =-1. ; PE->v[3] = 1. ; PE->w[3] = 1. ; POS_CUT_SKIN; } break ; case PRISM : PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 1 3 2 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[2] ; PE->NumNodes[2] = GE->NumNodes[1] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] =-1. ; PE->u[1] = 0. ; PE->v[1] = 1. ; PE->w[1] =-1. ; PE->u[2] = 1. ; PE->v[2] = 0. ; PE->w[2] =-1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 4 5 6 */ PE->NumNodes[0] = GE->NumNodes[3] ; PE->NumNodes[1] = GE->NumNodes[4] ; PE->NumNodes[2] = GE->NumNodes[5] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] = 1. ; PE->u[1] = 1. ; PE->v[1] = 0. ; PE->w[1] = 1. ; PE->u[2] = 0. ; PE->v[2] = 1. ; PE->w[2] = 1. ; POS_CUT_SKIN; if(DecomposeInSimplex){ PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 1 2 5 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[1] ; PE->NumNodes[2] = GE->NumNodes[4] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] =-1. ; PE->u[1] = 1. ; PE->v[1] = 0. ; PE->w[1] =-1. ; PE->u[2] = 1. ; PE->v[2] = 0. ; PE->w[2] = 1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 1 5 4 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[4] ; PE->NumNodes[2] = GE->NumNodes[3] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] =-1. ; PE->u[1] = 1. ; PE->v[1] = 0. ; PE->w[1] = 1. ; PE->u[2] = 0. ; PE->v[2] = 0. ; PE->w[2] = 1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 1 6 3 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[5] ; PE->NumNodes[2] = GE->NumNodes[2] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] =-1. ; PE->u[1] = 0. ; PE->v[1] = 1. ; PE->w[1] = 1. ; PE->u[2] = 0. ; PE->v[2] = 1. ; PE->w[2] =-1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 1 4 6 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[3] ; PE->NumNodes[2] = GE->NumNodes[5] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] =-1. ; PE->u[1] = 0. ; PE->v[1] = 0. ; PE->w[1] = 1. ; PE->u[2] = 0. ; PE->v[2] = 1. ; PE->w[2] = 1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 2 3 5 */ PE->NumNodes[0] = GE->NumNodes[1] ; PE->NumNodes[1] = GE->NumNodes[2] ; PE->NumNodes[2] = GE->NumNodes[4] ; PE->u[0] = 1. ; PE->v[0] = 0. ; PE->w[0] =-1. ; PE->u[1] = 0. ; PE->v[1] = 1. ; PE->w[1] =-1. ; PE->u[2] = 1. ; PE->v[2] = 0. ; PE->w[2] = 1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 3 6 5 */ PE->NumNodes[0] = GE->NumNodes[2] ; PE->NumNodes[1] = GE->NumNodes[5] ; PE->NumNodes[2] = GE->NumNodes[4] ; PE->u[0] = 0. ; PE->v[0] = 1. ; PE->w[0] =-1. ; PE->u[1] = 0. ; PE->v[1] = 1. ; PE->w[1] = 1. ; PE->u[2] = 1. ; PE->v[2] = 0. ; PE->w[2] = 1. ; POS_CUT_SKIN; } else{ PE = Create_PostElement(Index, QUADRANGLE, 4, 1) ; /* nodes 1 2 5 4 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[1] ; PE->NumNodes[2] = GE->NumNodes[4] ; PE->NumNodes[3] = GE->NumNodes[3] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] =-1. ; PE->u[1] = 1. ; PE->v[1] = 0. ; PE->w[1] =-1. ; PE->u[2] = 1. ; PE->v[2] = 0. ; PE->w[2] = 1. ; PE->u[3] = 0. ; PE->v[3] = 0. ; PE->w[3] = 1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, QUADRANGLE, 4, 1) ; /* nodes 1 4 6 3 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[3] ; PE->NumNodes[2] = GE->NumNodes[5] ; PE->NumNodes[3] = GE->NumNodes[2] ; PE->u[0] = 0. ; PE->v[0] = 0. ; PE->w[0] =-1. ; PE->u[1] = 0. ; PE->v[1] = 0. ; PE->w[1] = 1. ; PE->u[2] = 0. ; PE->v[2] = 1. ; PE->w[2] = 1. ; PE->u[3] = 0. ; PE->v[3] = 1. ; PE->w[3] =-1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, QUADRANGLE, 4, 1) ; /* nodes 2 3 6 5 */ PE->NumNodes[0] = GE->NumNodes[1] ; PE->NumNodes[1] = GE->NumNodes[2] ; PE->NumNodes[2] = GE->NumNodes[5] ; PE->NumNodes[3] = GE->NumNodes[4] ; PE->u[0] = 1. ; PE->v[0] = 0. ; PE->w[0] =-1. ; PE->u[1] = 0. ; PE->v[1] = 1. ; PE->w[1] =-1. ; PE->u[2] = 0. ; PE->v[2] = 1. ; PE->w[2] = 1. ; PE->u[3] = 1. ; PE->v[3] = 0. ; PE->w[3] = 1. ; POS_CUT_SKIN; } break ; case PYRAMID : PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 1 2 5 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[1] ; PE->NumNodes[2] = GE->NumNodes[4] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] = 0. ; PE->u[1] = 1. ; PE->v[1] =-1. ; PE->w[1] = 0. ; PE->u[2] = 0. ; PE->v[2] = 0. ; PE->w[2] = 1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 2 3 5 */ PE->NumNodes[0] = GE->NumNodes[1] ; PE->NumNodes[1] = GE->NumNodes[2] ; PE->NumNodes[2] = GE->NumNodes[4] ; PE->u[0] = 1. ; PE->v[0] =-1. ; PE->w[0] = 0. ; PE->u[1] = 1. ; PE->v[1] = 1. ; PE->w[1] = 0. ; PE->u[2] = 0. ; PE->v[2] = 0. ; PE->w[2] = 1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 3 4 5 */ PE->NumNodes[0] = GE->NumNodes[2] ; PE->NumNodes[1] = GE->NumNodes[3] ; PE->NumNodes[2] = GE->NumNodes[4] ; PE->u[0] = 1. ; PE->v[0] = 1. ; PE->w[0] = 0. ; PE->u[1] =-1. ; PE->v[1] = 1. ; PE->w[1] = 0. ; PE->u[2] = 0. ; PE->v[2] = 0. ; PE->w[2] = 1. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 4 1 5 */ PE->NumNodes[0] = GE->NumNodes[3] ; PE->NumNodes[1] = GE->NumNodes[0] ; PE->NumNodes[2] = GE->NumNodes[4] ; PE->u[0] =-1. ; PE->v[0] = 1. ; PE->w[0] = 0. ; PE->u[1] =-1. ; PE->v[1] =-1. ; PE->w[1] = 0. ; PE->u[2] = 0. ; PE->v[2] = 0. ; PE->w[2] = 1. ; POS_CUT_SKIN; if(DecomposeInSimplex){ PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 1 3 2 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[2] ; PE->NumNodes[2] = GE->NumNodes[1] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] = 0. ; PE->u[1] = 1. ; PE->v[1] = 1. ; PE->w[1] = 0. ; PE->u[2] = 1. ; PE->v[2] =-1. ; PE->w[2] = 0. ; POS_CUT_SKIN; PE = Create_PostElement(Index, TRIANGLE, 3, 1) ; /* nodes 1 4 3 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[3] ; PE->NumNodes[2] = GE->NumNodes[2] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] = 0. ; PE->u[1] =-1. ; PE->v[1] = 1. ; PE->w[1] = 0. ; PE->u[2] = 1. ; PE->v[2] = 1. ; PE->w[2] = 0. ; POS_CUT_SKIN; } else{ PE = Create_PostElement(Index, QUADRANGLE, 4, 1) ; /* nodes 1 4 3 2 */ PE->NumNodes[0] = GE->NumNodes[0] ; PE->NumNodes[1] = GE->NumNodes[3] ; PE->NumNodes[2] = GE->NumNodes[2] ; PE->NumNodes[3] = GE->NumNodes[1] ; PE->u[0] =-1. ; PE->v[0] =-1. ; PE->w[0] = 0. ; PE->u[1] =-1. ; PE->v[1] = 1. ; PE->w[1] = 0. ; PE->u[2] = 1. ; PE->v[2] = 1. ; PE->w[2] = 0. ; PE->u[3] = 1. ; PE->v[3] =-1. ; PE->w[3] = 0. ; POS_CUT_SKIN; } break ; } } } } #undef POS_CUT_FILL #undef POS_CUT_SKIN /* ------------------------------------------------------------------------ */ /* S o r t B y C o n n e c t i v i t y */ /* ------------------------------------------------------------------------ */ int Compare_PostElement_Node(struct PostElement * PE1, int n1, struct PostElement * PE2, int n2) { double TOL=Current.GeoData->CharacteristicLength * 1.e-8; if ( (fabs(PE1->x[n1] - PE2->x[n2]) < TOL) && (fabs(PE1->y[n1] - PE2->y[n2]) < TOL) && (fabs(PE1->z[n1] - PE2->z[n2]) < TOL) ) return 1 ; return 0 ; } void Sort_PostElement_Connectivity(List_T *PostElement_L) { int ii, jj, start, end, iPost, NbrPost ; struct PostElement *PE, *PE2 ; NbrPost = List_Nbr(PostElement_L) ; /* u[0] = 1 if the element is in the ordered list, with natural orientation -1 if the element is in the ordered list, but with opposite orientation 0 if the element is not in the list v[0] = relative index (to the first element) in the ordered list */ for(ii = 0 ; ii < NbrPost ; ii++){ PE = *(struct PostElement**)List_Pointer(PostElement_L, ii); if(PE->NbrNodes != 2){ Message::Error("Connectivity sorting impossible for %d-noded elements", PE->NbrNodes) ; return; } PE->u[0] = 0. ; } PE = *(struct PostElement**)List_Pointer(PostElement_L, 0); PE->u[0] = 1. ; PE->v[0] = 0. ; iPost = 1 ; while(iPost < NbrPost){ for(ii = 0 ; ii < NbrPost ; ii++){ PE = *(struct PostElement**)List_Pointer(PostElement_L, ii); if(PE->u[0]){ if(PE->u[0] > 0){ start = 0 ; end = 1 ; } else{ start = 1 ; end = 0 ; } for(jj = 0 ; jj < NbrPost ; jj++){ if(jj != ii){ PE2 = *(struct PostElement**)List_Pointer(PostElement_L, jj); if(!PE2->u[0]){ if(Compare_PostElement_Node(PE, end, PE2, 0)){ PE2->u[0] = 1. ; PE2->v[0] = PE->v[0] + 1. ; iPost++ ; } else if (Compare_PostElement_Node(PE, start, PE2, 0)){ PE2->u[0] = -1. ; PE2->v[0] = PE->v[0] - 1. ; iPost++ ; } else if (Compare_PostElement_Node(PE, start, PE2, 1)){ PE2->u[0] = 1. ; PE2->v[0] = PE->v[0] - 1. ; iPost++ ; } else if (Compare_PostElement_Node(PE, end, PE2, 1)){ PE2->u[0] = -1. ; PE2->v[0] = PE->v[0] + 1. ; iPost++ ; } } } } } } List_Sort(PostElement_L, fcmp_PostElement_absu0) ; } List_Sort(PostElement_L, fcmp_PostElement_v0) ; } getdp-2.7.0-source/Legacy/MainLegacy.cpp000644 001750 001750 00000042546 12606421314 021534 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include #include #include #include "GetDPConfig.h" #include "GetDPVersion.h" #include "onelab.h" #include "ProData.h" #include "ProParser.h" #include "SolvingAnalyse.h" #include "LinAlg.h" #include "OS.h" #include "MallocUtils.h" #include "Message.h" #if defined(HAVE_GMSH) #include #include #include #endif int Flag_PRE = 0, Flag_CAL = 0, Flag_POS = 0, Flag_RESTART = 0; int Flag_XDATA = 0, Flag_BIN = 0, Flag_SPLIT = 0, Flag_GMSH_VERSION = 1; int Flag_NETWORK_CACHE = 0, Flag_CALLED_WITH_ONELAB_SERVER = 0; double Flag_ORDER = -1.; char *Name_Generic = 0, *Name_Path = 0; char *Name_Resolution = 0; char *Name_MshFile = 0, *Name_AdaptFile = 0; char *Name_PostOperation[NBR_MAX_POS] = {0}; char *Name_ResFile[NBR_MAX_RES] = {0}; char *Name_GmshReadFile[NBR_MAX_RES] = {0}; static void Info(int level, char *arg0) { switch(level){ case 0 : fprintf(stderr, "GetDP, a General environment for the treatment of Discrete Problems\n" "Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege\n" "Usage: %s [file] [options]\n" "Processing options:\n" " -pre 'Resolution' pre-processing\n" " -cal processing\n" " -pos 'PostOperation(s)' post-processing\n" " -msh file read mesh (in msh format) from file\n" " -gmshread file(s) read gmsh data (same as GmshRead in resolution)\n" " -restart resume processing from where it stopped\n" " -solve 'Resolution' same as -pre 'Resolution' -cal\n" " -split save processing results in separate files\n" " -res file(s) load processing results from file(s)\n" " -name string use string as generic file name\n" " -adapt file read adaptation constraints from file\n" " -order num restrict maximum interpolation order\n" " -cache cache network computations to disk\n" "Linear solver options:\n" #if defined(HAVE_PETSC) " -solver file specify parameter file (default: .petscrc)\n" " [PETsc options] PETSc options (must be listed after [file])\n" #endif #if defined(HAVE_SLEPC) " -slepc use SLEPc instead of Arpack as eigensolver\n" #endif #if defined(HAVE_SPARSKIT) " -solver file specify parameter file (default: solver.par)\n" " -'Parameter' num override value of solver parameter 'Parameter'\n" #endif "Output options:\n" " -bin create binary output files\n" " -v2 create mesh-based Gmsh output files when possible\n" "Other options:\n" " -check interactive check of problem structure\n" " -v num set verbosity level (default: 5)\n" " -p num set progress indicator update (default: 10)\n" " -onelab name [address] communicate with ONELAB (file or server address)\n" " -setnumber name value set constant number name=value\n" " -setstring name value set constant string name=value\n" " -version show version number\n" " -info show detailed version information\n" " -help show this message\n", arg0); break; case 1: fprintf(stderr, "%s\n", GETDP_VERSION); break; case 2: fprintf(stderr, "Version : %s\n", GETDP_VERSION); fprintf(stderr, "License : %s\n", GETDP_SHORT_LICENSE); fprintf(stderr, "Build OS : %s\n", GETDP_OS); fprintf(stderr, "Build date : %s\n", GETDP_DATE); fprintf(stderr, "Build host : %s\n", GETDP_HOST); fprintf(stderr, "Build options :%s\n", GETDP_CONFIG_OPTIONS); #if defined(HAVE_PETSC) fprintf(stderr, "PETSc version : %d.%d.%d (%s arithmetic)\n", PETSC_VERSION_MAJOR, PETSC_VERSION_MINOR, PETSC_VERSION_SUBMINOR, #if defined(PETSC_USE_COMPLEX) "complex" #else "real" #endif ); #endif #if defined(HAVE_GMSH) fprintf(stderr, "Gmsh lib version : %s%s (%s)\n", GMSH_VERSION, GMSH_EXTRA_VERSION, GMSH_DATE); fprintf(stderr, "Gmsh lib options :%s\n", GMSH_CONFIG_OPTIONS); #endif fprintf(stderr, "Packaged by : %s\n", GETDP_PACKAGER); fprintf(stderr, "Web site : http://www.geuz.org/getdp/\n"); fprintf(stderr, "Mailing list : getdp@geuz.org\n"); break; } Message::Exit(0); } /* ------------------------------------------------------------------------ */ /* G e t _ O p t i o n s */ /* ------------------------------------------------------------------------ */ static void Get_Options(int argc, char *argv[], int *sargc, char **sargv, char *pro, int *lres, int *lpos, int *check) { strcpy(pro, ""); int i = *sargc = 1, j = 0; while (i < argc) { if (argv[i][0] == '-') { if (!strcmp(argv[i]+1, "cal")) { Flag_CAL = 1; i++; } else if (!strcmp(argv[i]+1, "check")) { *check = 1; i++; } else if (!strcmp(argv[i]+1, "xdata")) { Flag_XDATA = 1; i++; } else if (!strcmp(argv[i]+1, "cache")) { Flag_NETWORK_CACHE = 1; i++; } else if (!strcmp(argv[i]+1, "bin")) { Flag_BIN = 1; i++; } else if (!strcmp(argv[i]+1, "v2")) { Flag_GMSH_VERSION = 2; i++; } else if (!strcmp(argv[i]+1, "ascii")) { Flag_BIN = 0; i++; } else if (!strcmp(argv[i]+1, "split")) { Flag_SPLIT = 1; i++; } else if (!strcmp(argv[i]+1, "socket")) { i++; if (i < argc && argv[i][0] != '-') { Message::InitializeSocket(argv[i]); i++; } else { Message::Error("Missing socket name"); } } else if (!strcmp(argv[i]+1, "onelab")) { i++; if (i + 1 < argc && argv[i][0] != '-' && argv[i + 1][0] != '-') { Message::InitializeOnelab(argv[i], argv[i + 1]); i += 2; } else if (i < argc && argv[i][0] != '-') { Message::InitializeOnelab(argv[i], ""); i += 1; } else { Message::Error("Missing client name and/or address of ONELAB server"); } } else if (!strcmp(argv[i]+1, "setnumber")) { i++; if (i + 1 < argc && argv[i][0] != '-') { CommandLineNumbers[argv[i]] = std::vector(1, atof(argv[i + 1])); i += 2; } else{ Message::Error("Missing name and/or value for number definition"); } } else if (!strcmp(argv[i]+1, "setstring")) { i++; if (i + 1 < argc && argv[i][0] != '-' && argv[i + 1][0] != '-') { CommandLineStrings[argv[i]] = argv[i + 1]; i += 2; } else{ Message::Error("Missing name and/or value for string definition"); } } else if (!strcmp(argv[i]+1, "setlist") || !strcmp(argv[i]+1, "setlistofnumbers")) { i++; if (i + 1 < argc && argv[i][0] != '-') { std::string n(argv[i]); std::vector v; int s = atoi(argv[i + 1]), j = 0; i += 2; while(j < s && i < argc){ v.push_back(atof(argv[i])); i++; j++; } if(j < s) Message::Error("Missing values in list (got %d instead of %d)", j, s); CommandLineNumbers[n] = v; } else{ Message::Error("Missing name and/or value for definition of list of numbers"); } } else if (!strcmp(argv[i]+1, "restart")){ Flag_CAL = Flag_RESTART = 1; i++; } else if (!strcmp(argv[i]+1, "verbose") || !strcmp(argv[i]+1, "v")) { i++; if (i < argc && argv[i][0] != '-') { Message::SetVerbosity(atoi(argv[i])); i++; } else { Message::Error("Missing number"); } } else if (!strcmp(argv[i]+1, "help") || !strcmp(argv[i]+1, "h") || !strcmp(argv[i]+1, "-help") || !strcmp(argv[i]+1, "-h")) { Info(0, argv[0]); } else if (!strcmp(argv[i]+1, "version") || !strcmp(argv[i]+1, "-version")) { Info(1, argv[0]); } else if (!strcmp(argv[i]+1, "info") || !strcmp(argv[i]+1, "-info")) { Info(2, argv[0]); } else if (!strcmp(argv[i]+1, "progress") || !strcmp(argv[i]+1, "p")) { i++; if (i < argc && argv[i][0] != '-') { Message::SetProgressMeterStep(atoi(argv[i])); i++; } else { Message::Error("Missing number"); } } else if (!strcmp(argv[i]+1, "pre")) { i++; if (i < argc && argv[i][0] == '#') { Flag_PRE = 1; *lres = -atoi(argv[i]+1); i++; } else if (i < argc && argv[i][0] != '-') { Flag_PRE = 1; Name_Resolution = strSave(argv[i]); i++; } else { Flag_PRE = *lres = 1; } } else if (!strcmp(argv[i]+1, "order") || !strcmp(argv[i]+1, "ord")) { i++; if (i < argc && argv[i][0] != '-') { Flag_ORDER = atof(argv[i]); i++; } else { Message::Error("Missing interpolation order"); } } else if (!strcmp(argv[i]+1, "solver")) { // fix when calling getdp from gmsh (since the GUI forces us // to put the -solver option before the .pro file!) sargv[(*sargc)++] = argv[i++]; if (i < argc && argv[i][0] != '-') { sargv[(*sargc)++] = argv[i++]; } else { Message::Error("Missing solver option file name"); } } else if (!strcmp(argv[i]+1, "solve") || !strcmp(argv[i]+1, "sol")) { i++; if (i < argc && argv[i][0] == '#') { Flag_PRE = Flag_CAL = 1; *lres = -atoi(argv[i]+1); i++; } else if (i < argc && argv[i][0] != '-') { Flag_PRE = Flag_CAL = 1; Name_Resolution = strSave(argv[i]); i++; } else { Flag_PRE = Flag_CAL = *lres = 1; } } else if (!strcmp(argv[i]+1, "post") || !strcmp(argv[i]+1, "pos")) { i++; j = 0; if (i < argc && argv[i][0] == '#') { Flag_POS = 1; *lpos = -atoi(argv[i]+1); i++; } /* Only one numbered (#) PostOperation allowed */ else { while (i < argc && argv[i][0] != '-') { Name_PostOperation[j] = strSave(argv[i]); i++; j++; if(j == NBR_MAX_POS){ Message::Error("Too many PostOperations"); break; } } if(!j){ Flag_POS = *lpos = 1; } else{ Flag_POS = 1; Name_PostOperation[j] = NULL; } } } else if (!strcmp(argv[i]+1, "mesh") || !strcmp(argv[i]+1, "msh") || !strcmp(argv[i]+1, "m")) { i++; if (i < argc && argv[i][0] != '-') { Name_MshFile = strSave(argv[i]); i++; } else { Message::Error("Missing file name"); } } else if (!strcmp(argv[i]+1, "adapt") || !strcmp(argv[i]+1, "adap") || !strcmp(argv[i]+1, "ada")) { i++; if (i < argc && argv[i][0] != '-') { Name_AdaptFile = strSave(argv[i]); i++; } else { Message::Error("Missing file name"); } } else if (!strcmp(argv[i]+1, "res")) { i++; j = 0; while (i < argc && argv[i][0] != '-') { Name_ResFile[j] = strSave(argv[i]); i++; j++; if(j == NBR_MAX_RES){ Message::Error("Too many '.res' files"); break; } } if(!j) Message::Error("Missing file name"); else{ Name_ResFile[j] = NULL; } } else if (!strcmp(argv[i]+1, "gmshread")) { i++; j = 0; while (i < argc && argv[i][0] != '-') { Name_GmshReadFile[j] = strSave(argv[i]); i++; j++; if(j == NBR_MAX_RES){ Message::Error("Too many GmshRead files"); break; } } if(!j) Message::Error("Missing file name"); else{ Name_GmshReadFile[j] = NULL; } } else if (!strcmp(argv[i]+1, "name")) { i++; if (i < argc && argv[i][0] != '-') { Name_Generic = strSave(argv[i]); i++; } else { Message::Error("Missing string"); } } else if (!strcmp(argv[i]+1, "petscinfo") || !strcmp(argv[i]+1, "-petscinfo")) { sargv[(*sargc)++] = (char*)"-info"; i++; } else { sargv[(*sargc)++] = argv[i++]; } } else{ if (!strlen(pro)) { sargv[0] = argv[i]; strcpy(pro, argv[i++]); } else{ sargv[(*sargc)++] = argv[i++]; } } } if(!strlen(pro)){ Message::Error("Missing input file name"); Name_Generic = strSave(""); *sargc = 0; } else{ if(!Name_Generic){ Name_Generic = strSave(pro); if(strcmp(pro+(strlen(pro)-4), ".pro") && strcmp(pro+(strlen(pro)-4), ".PRO")) strcat(pro,".pro"); else Name_Generic[strlen(pro)-4] = '\0'; } else{ std::string fix = Fix_RelativePath(Name_Generic, pro); Free(Name_Generic); Name_Generic = strSave(fix.c_str()); if(strcmp(pro+(strlen(pro)-4), ".pro") && strcmp(pro+(strlen(pro)-4), ".PRO")) strcat(pro,".pro"); } Name_Path = strSave(Name_Generic); i = strlen(Name_Path)-1; while(i >= 0 && Name_Path[i] != '/' && Name_Path[i] != '\\') i--; Name_Path[i+1] = '\0'; } } #if defined(HAVE_GMSH) class GmshMsg : public GmshMessage{ public: void operator()(std::string level, std::string msg) { if(level == "Fatal") Message::Fatal("%s", msg.c_str()); else if(level == "Error") Message::Error("%s", msg.c_str()); else if(level == "Warning") Message::Warning("%s", msg.c_str()); else Message::Info("%s", msg.c_str()); } }; #endif static void Free_GlobalVariables() { Flag_PRE = 0; Flag_CAL = 0; Flag_POS = 0; Flag_RESTART = 0; Flag_XDATA = 0; Flag_BIN = 0; Flag_SPLIT = 0; Flag_GMSH_VERSION = 1; Flag_NETWORK_CACHE = 0; Flag_ORDER = -1.; Free(Name_Generic); Name_Generic = 0; Free(Name_Path); Name_Path = 0; Free(Name_Resolution); Name_Resolution = 0; Free(Name_MshFile); Name_MshFile = 0; Free(Name_AdaptFile); Name_AdaptFile = 0; int i = 0; while(Name_PostOperation[i]){ Free(Name_PostOperation[i]); Name_PostOperation[i] = 0; i++; } i = 0; while(Name_ResFile[i]){ Free(Name_ResFile[i]); Name_ResFile[i] = 0; i++; } i = 0; while(Name_GmshReadFile[i]){ Free(Name_GmshReadFile[i]); Name_GmshReadFile[i] = 0; i++; } Free_ProblemStructure(); Free_ParserVariables(); } int MainLegacy(int argc, char *argv[]) { if(argc < 2) Info(0, argv[0]); std::string cmdline(""); for(int i = 0; i < argc; i++){ if(i) cmdline += " "; cmdline += argv[i]; } Message::Initialize(argc, argv); char pro[256]; char **sargv = (char**)Malloc(256 * sizeof(char*)); int sargc, lres = 0, lpos = 0, check = 0; Get_Options(argc, argv, &sargc, sargv, pro, &lres, &lpos, &check); if(Message::GetErrorCount()){ Message::Finalize(); return Message::GetErrorCount(); } Message::Info("Running '%s' [GetDP %s, %d node%s]", cmdline.c_str(), GETDP_VERSION, Message::GetCommSize(), Message::GetCommSize() > 1 ? "s" : ""); Message::Cpu(3, true, true, true, true, "Started"); if(sargc > 1){ std::string solveropt(""); for(int i = 1; i < sargc; i++){ if(i > 1) solveropt += " "; solveropt += sargv[i]; } Message::Debug("Passing unused options to solver: '%s'", solveropt.c_str()); } if(!Name_ResFile[0]){ Name_ResFile[0] = (char*)Malloc((strlen(Name_Generic)+5)*sizeof(char)); strcpy(Name_ResFile[0], Name_Generic); strcat(Name_ResFile[0], ".res"); Name_ResFile[1] = 0; } if(!Name_MshFile){ Message::GetOnelabString("Gmsh/MshFileName", &Name_MshFile); if(Name_MshFile) Message::Info("Got mesh name from Onelab: '%s'", Name_MshFile); } if(!Name_MshFile){ Name_MshFile = (char*)Malloc((strlen(Name_Generic)+5)*sizeof(char)); strcpy(Name_MshFile, Name_Generic); strcat(Name_MshFile, ".msh"); } #if defined(HAVE_GMSH) Message::Info("Initializing Gmsh"); GmshInitialize(); if(!GmshGetMessageHandler() && !Flag_CALLED_WITH_ONELAB_SERVER){ // do not set msg handler if one is provided (e.g. on Android/iOS) GmshMsg c; GmshSetMessageHandler(&c); } int j = 0; while(Name_GmshReadFile[j]){ GmshMergePostProcessingFile(Name_GmshReadFile[j]); j++; } #endif IncreaseStackSize(); LinAlg_InitializeSolver(&sargc, &sargv); Init_ProblemStructure(); Read_ProblemStructure(pro); Finalize_ProblemStructure(); int choose = 1; if (!Flag_PRE && !Flag_CAL && !Flag_POS && !check){ lres = lpos = 1; choose = 0; } if(check) Print_ProblemStructure(); if(lres) Print_ListResolution(choose, lres, &Name_Resolution); if(lpos) Print_ListPostOperation(choose, lpos, Name_PostOperation); if(Flag_PRE || Flag_CAL || Flag_POS) SolvingAnalyse(); LinAlg_FinalizeSolver(); Message::PrintErrorCounter("Run"); Message::Cpu(3, true, true, true, true, "Stopped"); #if defined(HAVE_GMSH) if(!Flag_CALLED_WITH_ONELAB_SERVER) GmshFinalize(); #endif Free_GlobalVariables(); Free(sargv); Message::Finalize(); return Message::GetErrorCount(); } int GetDP(std::vector &args, void *ptr) { onelab::server *onelabServer = (onelab::server*) ptr; if(onelabServer != NULL){ onelab::server::setInstance(onelabServer); Flag_CALLED_WITH_ONELAB_SERVER = 1; } int argc = args.size(); std::vector argv(argc + 1, (char*)0); for(int i = 0; i < argc; i++) argv[i] = (char*)args[i].c_str(); return MainLegacy(argc, &argv[0]); } getdp-2.7.0-source/Legacy/Get_ConstraintOfElement.h000644 001750 001750 00000002622 12473553042 023707 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _GET_CONSTRAINT_OF_ELEMENT_H_ #define _GET_CONSTRAINT_OF_ELEMENT_H_ #include "ProData.h" void Treatment_ConstraintForElement(struct FunctionSpace * FunctionSpace_P, struct QuantityStorage * QuantityStorage_P, int Num_Entity[], int i_Entity, int i_BFunction, int TypeConstraint) ; void Treatment_ConstraintForRegion(struct GlobalQuantity * GlobalQuantity_P, struct FunctionSpace * FunctionSpace_P, struct QuantityStorage * QuantityStorage_P) ; void Treatment_ConstraintByLocalProjection(struct Element *Element, struct FunctionSpace *FunctionSpace_P, struct QuantityStorage *QuantityStorage_P) ; void Get_ValueForConstraint(struct ConstraintInFS * Constraint_P, double Value[], double Value2[], int * Index_TimeFunction) ; void Get_PreResolutionForConstraint(struct ConstraintInFS * Constraint_P, int * Index_TimeFunction) ; void Get_LinkForConstraint(struct ConstraintInFS * Constraint_P, int Num_Entity, int * CodeEntity_Link, int Orient, double Value[]) ; #endif getdp-2.7.0-source/Legacy/F_Misc.cpp000644 001750 001750 00000121072 12606421314 020653 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include #include "GetDPConfig.h" #include "ProData.h" #include "ProDefine.h" #include "F.h" #include "Message.h" #include "Cal_Value.h" #include "OS.h" extern struct CurrentData Current ; void F_Printf(F_ARG) { Print_Value(A) ; printf("\n") ; } void F_Rand(F_ARG) { int k; if(A->Type != SCALAR) Message::Error("Non scalar argument for function 'Rand"); V->Val[0] = A->Val[0] * (double)rand() / (double)RAND_MAX; if (Current.NbrHar != 1){ V->Val[MAX_DIM] = 0. ; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) V->Val[MAX_DIM*k] = V->Val[MAX_DIM*(k+1)] = 0. ; } V->Type = SCALAR ; } void F_CompElementNum (F_ARG) { if(!Current.Element || !Current.ElementSource) Message::Error("Uninitialized Element in 'F_CompElementNum'"); V->Type = SCALAR ; V->Val[0] = (Current.Element->Num == Current.ElementSource->Num) ; } void F_ElementNum (F_ARG) { if(!Current.Element) Message::Error("Uninitialized Element in 'F_ElementNum'"); V->Type = SCALAR ; V->Val[0] = Current.Element->Num ; } void F_QuadraturePointIndex (F_ARG) { V->Type = SCALAR ; V->Val[0] = Current.QuadraturePointIndex ; } void F_GetCpuTime (F_ARG) { double s = 0.; long mem = 0; GetResources(&s, &mem); V->Type = SCALAR ; V->Val[0] = s ; } void F_GetWallClockTime (F_ARG) { V->Type = SCALAR ; V->Val[0] = Message::GetWallClockTime() ; } void F_GetMemory (F_ARG) { double s = 0.; long mem = 0; GetResources(&s, &mem); double val = mem / 1024. / 1024.; V->Type = SCALAR ; V->Val[0] = val ; } void F_SetNumber (F_ARG) { double val = A->Val[0]; int type = A->Type; for (int k = 0; k < Current.NbrHar; k++) V->Val[MAX_DIM * k] = 0. ; V->Type = SCALAR; if(type != SCALAR){ Message::Error("Non scalar argument for function 'SetNumber'"); return; } if(!Fct->String){ Message::Error("Missing ONELAB variable name: use SetNumber[value]{\"name\"}"); return; } Message::SetOnelabNumber(Fct->String, val); V->Val[0] = val ; } void F_GetNumber (F_ARG) { if(Fct->NbrArguments){ Cal_CopyValue(A, V); } else{ for (int k = 0; k < Current.NbrHar; k++) V->Val[MAX_DIM * k] = 0. ; V->Type = SCALAR; } if(!Fct->String){ Message::Error("Missing ONELAB variable name: use GetNumber[]{\"name\"}"); return; } if(Message::UseOnelab()) V->Val[0] = Message::GetOnelabNumber(Fct->String); } void F_VirtualWork (F_ARG) { MATRIX3x3 Jac ; double DetJac ; double DetJac_dx[3], squF[6] ; double s[3] = {0.,0.,0.}; if(!Current.Element) Message::Error("Uninitialized Element in 'F_VirtualWork'"); Current.flagAssDiag = 1; /*+++prov*/ int numNode = Current.NumEntity; int i = 0 ; while (i < Current.Element->GeoElement->NbrNodes && Current.Element->GeoElement->NumNodes[i] != numNode) i++; if (i < Current.Element->GeoElement->NbrNodes ) { for(int j = 0; j < 3; j++) { squF[j] = A->Val[j] * A->Val[j] ; squF[j+3] = A->Val[j] * A->Val[(j<2)?j+1:0] ; } //Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w); DetJac = Current.Element->DetJac ; Jac = Current.Element->Jac ; DetJac_dx[0] = Current.Element->dndu[i][0] * ( Jac.c22 * Jac.c33 - Jac.c23 * Jac.c32 ) - Current.Element->dndu[i][1] * ( Jac.c12 * Jac.c33 - Jac.c13 * Jac.c32 ) + Current.Element->dndu[i][2] * ( Jac.c12 * Jac.c23 - Jac.c22 * Jac.c13 ); DetJac_dx[1] = - Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c33 - Jac.c23 * Jac.c31 ) + Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c33 - Jac.c13 * Jac.c31 ) - Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c23 - Jac.c13 * Jac.c21 ); DetJac_dx[2] = Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c32 - Jac.c22 * Jac.c31 ) - Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c32 - Jac.c12 * Jac.c31 ) + Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c22 - Jac.c12 * Jac.c21 ); if(DetJac != 0){ s[0] = ( DetJac_dx[0] * ( - squF[0] + squF[1] + squF[2] ) - 2 * DetJac_dx[1] * squF[3] - 2 * DetJac_dx[2] * squF[5])/DetJac ; s[1] = ( DetJac_dx[1] * ( squF[0] - squF[1] + squF[2] ) - 2 * DetJac_dx[0] * squF[3] - 2 * DetJac_dx[2] * squF[4])/DetJac ; s[2] = ( DetJac_dx[2] * ( squF[0] + squF[1] - squF[2] ) - 2 * DetJac_dx[0] * squF[5] - 2 * DetJac_dx[1] * squF[4])/DetJac ; } else { Message::Warning("Zero determinant in 'F_VirtualWork'") ; } } V->Type = VECTOR ; V->Val[0] = s[0] ; V->Val[1] = s[1] ; V->Val[2] = s[2] ; } void F_NodeForceDensity (F_ARG) { MATRIX3x3 Jac ; double DetJac ; double Grad_n[3] ; double s11 = 0., s12 = 0., s13 = 0. ; double s21 = 0., s22 = 0., s23 = 0. ; double s31 = 0., s32 = 0., s33 = 0. ; double s[3] = {0.,0.,0.}; if(!Current.Element) Message::Error("Uninitialized Element in 'F_NodeForceDensity'"); Current.flagAssDiag = 1; /*+++prov*/ int numNode = Current.NumEntity; int i = 0 ; while (i < Current.Element->GeoElement->NbrNodes && Current.Element->GeoElement->NumNodes[i] != numNode) i++; if (i < Current.Element->GeoElement->NbrNodes ) { if(A->Type == TENSOR_SYM){ s11 = A->Val[0] ; s12 = A->Val[1] ; s13 = A->Val[2] ; s21 = s12; s22 = A->Val[3] ; s23 = A->Val[4] ; s31 = s13; s32 = s23; s33 = A->Val[5] ; } else if(A->Type == TENSOR){ s11 = A->Val[0] ; s12 = A->Val[1] ; s13 = A->Val[2] ; s21 = A->Val[3] ; s22 = A->Val[4] ; s23 = A->Val[5] ; s31 = A->Val[6] ; s32 = A->Val[7] ; s33 = A->Val[8] ; } else{ Message::Error("Unknown tensor type in 'F_NodeForceDensity'") ; } DetJac = Current.Element->DetJac ; Jac = Current.Element->Jac ; Grad_n[0] = Current.Element->dndu[i][0] * ( Jac.c22 * Jac.c33 - Jac.c23 * Jac.c32 ) - Current.Element->dndu[i][1] * ( Jac.c12 * Jac.c33 - Jac.c13 * Jac.c32 ) + Current.Element->dndu[i][2] * ( Jac.c12 * Jac.c23 - Jac.c22 * Jac.c13 ); Grad_n[1] = - Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c33 - Jac.c23 * Jac.c31 ) + Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c33 - Jac.c13 * Jac.c31 ) - Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c23 - Jac.c13 * Jac.c21 ); Grad_n[2] = Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c32 - Jac.c22 * Jac.c31 ) - Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c32 - Jac.c12 * Jac.c31 ) + Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c22 - Jac.c12 * Jac.c21 ); if(DetJac != 0){ s[0] = ( Grad_n[0] * s11 + Grad_n[1] * s12 + Grad_n[2] * s13 ) / DetJac ; s[1] = ( Grad_n[0] * s21 + Grad_n[1] * s22 + Grad_n[2] * s23 ) / DetJac ; s[2] = ( Grad_n[0] * s31 + Grad_n[1] * s32 + Grad_n[2] * s33 ) / DetJac ; } else { Message::Warning("Zero determinant in 'F_NodeForceDensity'") ; } } V->Type = VECTOR ; V->Val[0] = s[0] ; V->Val[1] = s[1] ; V->Val[2] = s[2] ; } // Blex added 25/04/14 update 06/06/14 void F_Felec (F_ARG) { MATRIX3x3 Jac ; double DetJac ; double DetJac_dx[3], squF[6] ; double dsdx[3] ; //Derivative of the base functions with respect to x, y and z double s[3] = {0.,0.,0.}; if(!Current.Element) Message::Error("Uninitialized Element in 'F_Felec'"); Current.flagAssDiag = 1; /*+++prov*/ int numNode = Current.NumEntity; int i = 0 ; while (i < Current.Element->GeoElement->NbrNodes && Current.Element->GeoElement->NumNodes[i] != numNode) i++; if (i < Current.Element->GeoElement->NbrNodes ) { for(int j = 0; j < 3; j++) { squF[j] = A->Val[j] * A->Val[j] ; squF[j+3] = A->Val[j] * A->Val[(j<2)?j+1:0] ; } //Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w); DetJac = Current.Element->DetJac ; Jac = Current.Element->Jac ; DetJac_dx[0] = Current.Element->dndu[i][0] * ( Jac.c22 * Jac.c33 - Jac.c23 * Jac.c32 ) - Current.Element->dndu[i][1] * ( Jac.c12 * Jac.c33 - Jac.c13 * Jac.c32 ) + Current.Element->dndu[i][2] * ( Jac.c12 * Jac.c23 - Jac.c22 * Jac.c13 ); DetJac_dx[1] = - Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c33 - Jac.c23 * Jac.c31 ) + Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c33 - Jac.c13 * Jac.c31 ) - Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c23 - Jac.c13 * Jac.c21 ); DetJac_dx[2] = Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c32 - Jac.c22 * Jac.c31 ) - Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c32 - Jac.c12 * Jac.c31 ) + Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c22 - Jac.c12 * Jac.c21 ); if(DetJac != 0){ dsdx[0] = DetJac_dx[0]/DetJac ; dsdx[1] = DetJac_dx[1]/DetJac ; dsdx[2] = DetJac_dx[2]/DetJac ; s[0] = - 0.5 * ( dsdx[0] * ( squF[0] - squF[1] - squF[2] ) + 2 * dsdx[1] * squF[3] + 2 * dsdx[2] * squF[5]) ; s[1] = - 0.5 * ( dsdx[1] * ( - squF[0] + squF[1] - squF[2] ) + 2 * dsdx[0] * squF[3] + 2 * dsdx[2] * squF[4]) ; s[2] = - 0.5 * ( dsdx[2] * ( - squF[0] - squF[1] + squF[2] ) + 2 * dsdx[0] * squF[5] + 2 * dsdx[1] * squF[4]) ; } else { Message::Warning("Zero determinant in 'F_Felec'") ; } } V->Type = VECTOR ; V->Val[0] = s[0] ; V->Val[1] = s[1] ; V->Val[2] = s[2] ; } void F_dFxdux (F_ARG) { MATRIX3x3 Jac ; double DetJac ; double DetJac_dx[3], squF[6] ; double dsdx[3] ; //Derivative of the base functions with respect to x, y and z double s[3] = {0.,0.,0.}; if(!Current.Element) Message::Error("Uninitialized Element in 'F_dFxdux'"); int numNode = Current.NumEntity; int i = 0 ; while (i < Current.Element->GeoElement->NbrNodes && Current.Element->GeoElement->NumNodes[i] != numNode) i++; if (i < Current.Element->GeoElement->NbrNodes ) { for(int j = 0; j < 3; j++) { squF[j] = A->Val[j] * A->Val[j] ; squF[j+3] = A->Val[j] * A->Val[(j<2)?j+1:0] ; } //Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w); DetJac = Current.Element->DetJac ; Jac = Current.Element->Jac ; DetJac_dx[0] = Current.Element->dndu[i][0] * ( Jac.c22 * Jac.c33 - Jac.c23 * Jac.c32 ) - Current.Element->dndu[i][1] * ( Jac.c12 * Jac.c33 - Jac.c13 * Jac.c32 ) + Current.Element->dndu[i][2] * ( Jac.c12 * Jac.c23 - Jac.c22 * Jac.c13 ); DetJac_dx[1] = - Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c33 - Jac.c23 * Jac.c31 ) + Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c33 - Jac.c13 * Jac.c31 ) - Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c23 - Jac.c13 * Jac.c21 ); DetJac_dx[2] = Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c32 - Jac.c22 * Jac.c31 ) - Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c32 - Jac.c12 * Jac.c31 ) + Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c22 - Jac.c12 * Jac.c21 ); if(DetJac != 0){ dsdx[0] = DetJac_dx[0]/DetJac ; dsdx[1] = DetJac_dx[1]/DetJac ; dsdx[2] = DetJac_dx[2]/DetJac ; s[0] = - squF[0] * dsdx[0] ; s[1] = - squF[0] * dsdx[1] ; s[2] = - squF[0] * dsdx[2] ; } else { Message::Warning("Zero determinant in 'F_dFxdux'") ; } } V->Type = VECTOR ; V->Val[0] = s[0] ; V->Val[1] = s[1] ; V->Val[2] = s[2] ; } void F_dFydux (F_ARG) { MATRIX3x3 Jac ; double DetJac ; double DetJac_dx[3], squF[6] ; double dsdx[3] ; //Derivative of the base functions with respect to x, y and z double s[3] = {0.,0.,0.}; if(!Current.Element) Message::Error("Uninitialized Element in 'F_dFydux'"); int numNode = Current.NumEntity; int i = 0 ; while (i < Current.Element->GeoElement->NbrNodes && Current.Element->GeoElement->NumNodes[i] != numNode) i++; if (i < Current.Element->GeoElement->NbrNodes ) { for(int j = 0; j < 3; j++) { squF[j] = A->Val[j] * A->Val[j] ; squF[j+3] = A->Val[j] * A->Val[(j<2)?j+1:0] ; } //Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w); DetJac = Current.Element->DetJac ; Jac = Current.Element->Jac ; DetJac_dx[0] = Current.Element->dndu[i][0] * ( Jac.c22 * Jac.c33 - Jac.c23 * Jac.c32 ) - Current.Element->dndu[i][1] * ( Jac.c12 * Jac.c33 - Jac.c13 * Jac.c32 ) + Current.Element->dndu[i][2] * ( Jac.c12 * Jac.c23 - Jac.c22 * Jac.c13 ); DetJac_dx[1] = - Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c33 - Jac.c23 * Jac.c31 ) + Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c33 - Jac.c13 * Jac.c31 ) - Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c23 - Jac.c13 * Jac.c21 ); DetJac_dx[2] = Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c32 - Jac.c22 * Jac.c31 ) - Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c32 - Jac.c12 * Jac.c31 ) + Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c22 - Jac.c12 * Jac.c21 ); if(DetJac != 0){ dsdx[0] = DetJac_dx[0]/DetJac ; dsdx[1] = DetJac_dx[1]/DetJac ; dsdx[2] = DetJac_dx[2]/DetJac ; s[0] = - 0.5 * (2 * squF[3] * dsdx[0] + (- squF[0] - squF[1] + squF[2]) * dsdx[1] - 2 * squF[4] * dsdx[2]) ; s[1] = - 0.5 * ((squF[0] + squF[1] - squF[2]) * dsdx[0] + 2 * squF[3] * dsdx[1] + 2 * squF[5] * dsdx[2]) ; s[2] = - 0.5 * (2 * squF[4] * dsdx[0] - 2 * squF[5] * dsdx[1] + 2 * squF[3] * dsdx[2]) ; } else { Message::Warning("Zero determinant in 'F_dFydux'") ; } } V->Type = VECTOR ; V->Val[0] = s[0] ; V->Val[1] = s[1] ; V->Val[2] = s[2] ; } void F_dFzdux (F_ARG) { MATRIX3x3 Jac ; double DetJac ; double DetJac_dx[3], squF[6] ; double dsdx[3] ; //Derivative of the base functions with respect to x, y and z double s[3] = {0.,0.,0.}; if(!Current.Element) Message::Error("Uninitialized Element in 'F_dFzdux'"); int numNode = Current.NumEntity; int i = 0 ; while (i < Current.Element->GeoElement->NbrNodes && Current.Element->GeoElement->NumNodes[i] != numNode) i++; if (i < Current.Element->GeoElement->NbrNodes ) { for(int j = 0; j < 3; j++) { squF[j] = A->Val[j] * A->Val[j] ; squF[j+3] = A->Val[j] * A->Val[(j<2)?j+1:0] ; } //Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w); DetJac = Current.Element->DetJac ; Jac = Current.Element->Jac ; DetJac_dx[0] = Current.Element->dndu[i][0] * ( Jac.c22 * Jac.c33 - Jac.c23 * Jac.c32 ) - Current.Element->dndu[i][1] * ( Jac.c12 * Jac.c33 - Jac.c13 * Jac.c32 ) + Current.Element->dndu[i][2] * ( Jac.c12 * Jac.c23 - Jac.c22 * Jac.c13 ); DetJac_dx[1] = - Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c33 - Jac.c23 * Jac.c31 ) + Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c33 - Jac.c13 * Jac.c31 ) - Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c23 - Jac.c13 * Jac.c21 ); DetJac_dx[2] = Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c32 - Jac.c22 * Jac.c31 ) - Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c32 - Jac.c12 * Jac.c31 ) + Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c22 - Jac.c12 * Jac.c21 ); if(DetJac != 0){ dsdx[0] = DetJac_dx[0]/DetJac ; dsdx[1] = DetJac_dx[1]/DetJac ; dsdx[2] = DetJac_dx[2]/DetJac ; s[0] = - 0.5 * (2 * squF[5] * dsdx[0] - 2 * squF[4] * dsdx[1] + (-squF[0] + squF[1] - squF[2]) * dsdx[2]) ; s[1] = - 0.5 * (2 * squF[4] * dsdx[0] + 2 * squF[5] * dsdx[1] - 2 * squF[3] * dsdx[2]) ; s[2] = - 0.5 * ((squF[0] - squF[1] + squF[2]) * dsdx[0] + 2 * squF[3] * dsdx[1] + 2 * squF[5] * dsdx[2]) ; } else { Message::Warning("Zero determinant in 'F_dFzdux'") ; } } V->Type = VECTOR ; V->Val[0] = s[0] ; V->Val[1] = s[1] ; V->Val[2] = s[2] ; } void F_dFxduy (F_ARG) { MATRIX3x3 Jac ; double DetJac ; double DetJac_dx[3], squF[6] ; double dsdx[3] ; //Derivative of the base functions with respect to x, y and z double s[3] = {0.,0.,0.}; if(!Current.Element) Message::Error("Uninitialized Element in 'F_dFxduy'"); int numNode = Current.NumEntity; int i = 0 ; while (i < Current.Element->GeoElement->NbrNodes && Current.Element->GeoElement->NumNodes[i] != numNode) i++; if (i < Current.Element->GeoElement->NbrNodes ) { for(int j = 0; j < 3; j++) { squF[j] = A->Val[j] * A->Val[j] ; squF[j+3] = A->Val[j] * A->Val[(j<2)?j+1:0] ; } //Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w); DetJac = Current.Element->DetJac ; Jac = Current.Element->Jac ; DetJac_dx[0] = Current.Element->dndu[i][0] * ( Jac.c22 * Jac.c33 - Jac.c23 * Jac.c32 ) - Current.Element->dndu[i][1] * ( Jac.c12 * Jac.c33 - Jac.c13 * Jac.c32 ) + Current.Element->dndu[i][2] * ( Jac.c12 * Jac.c23 - Jac.c22 * Jac.c13 ); DetJac_dx[1] = - Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c33 - Jac.c23 * Jac.c31 ) + Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c33 - Jac.c13 * Jac.c31 ) - Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c23 - Jac.c13 * Jac.c21 ); DetJac_dx[2] = Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c32 - Jac.c22 * Jac.c31 ) - Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c32 - Jac.c12 * Jac.c31 ) + Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c22 - Jac.c12 * Jac.c21 ); if(DetJac != 0){ dsdx[0] = DetJac_dx[0]/DetJac ; dsdx[1] = DetJac_dx[1]/DetJac ; dsdx[2] = DetJac_dx[2]/DetJac ; s[0] = - 0.5 * (2 * squF[3] * dsdx[0] + (squF[0] + squF[1] - squF[2]) * dsdx[1] + 2 * squF[4] * dsdx[2]) ; s[1] = - 0.5 * ((-squF[0] - squF[1] + squF[2]) * dsdx[0] + 2 * squF[3] * dsdx[1] - 2 * squF[5] * dsdx[2]) ; s[2] = - 0.5 * (- 2 * squF[4] * dsdx[0] + 2 * squF[5] * dsdx[1] + 2 * squF[3] * dsdx[2]) ; } else { Message::Warning("Zero determinant in 'F_dFxduy'") ; } } V->Type = VECTOR ; V->Val[0] = s[0] ; V->Val[1] = s[1] ; V->Val[2] = s[2] ; } void F_dFyduy (F_ARG) { MATRIX3x3 Jac ; double DetJac ; double DetJac_dx[3], squF[6] ; double dsdx[3] ; //Derivative of the base functions with respect to x, y and z double s[3] = {0.,0.,0.}; if(!Current.Element) Message::Error("Uninitialized Element in 'F_dFyduy'"); int numNode = Current.NumEntity; int i = 0 ; while (i < Current.Element->GeoElement->NbrNodes && Current.Element->GeoElement->NumNodes[i] != numNode) i++; if (i < Current.Element->GeoElement->NbrNodes ) { for(int j = 0; j < 3; j++) { squF[j] = A->Val[j] * A->Val[j] ; squF[j+3] = A->Val[j] * A->Val[(j<2)?j+1:0] ; } //Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w); DetJac = Current.Element->DetJac ; Jac = Current.Element->Jac ; DetJac_dx[0] = Current.Element->dndu[i][0] * ( Jac.c22 * Jac.c33 - Jac.c23 * Jac.c32 ) - Current.Element->dndu[i][1] * ( Jac.c12 * Jac.c33 - Jac.c13 * Jac.c32 ) + Current.Element->dndu[i][2] * ( Jac.c12 * Jac.c23 - Jac.c22 * Jac.c13 ); DetJac_dx[1] = - Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c33 - Jac.c23 * Jac.c31 ) + Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c33 - Jac.c13 * Jac.c31 ) - Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c23 - Jac.c13 * Jac.c21 ); DetJac_dx[2] = Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c32 - Jac.c22 * Jac.c31 ) - Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c32 - Jac.c12 * Jac.c31 ) + Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c22 - Jac.c12 * Jac.c21 ); if(DetJac != 0){ dsdx[0] = DetJac_dx[0]/DetJac ; dsdx[1] = DetJac_dx[1]/DetJac ; dsdx[2] = DetJac_dx[2]/DetJac ; s[0] = - squF[1] * dsdx[0] ; s[1] = - squF[1] * dsdx[1] ; s[2] = - squF[1] * dsdx[2] ; } else { Message::Warning("Zero determinant in 'F_dFyduy'") ; } } V->Type = VECTOR ; V->Val[0] = s[0] ; V->Val[1] = s[1] ; V->Val[2] = s[2] ; } void F_dFzduy (F_ARG) { MATRIX3x3 Jac ; double DetJac ; double DetJac_dx[3], squF[6] ; double dsdx[3] ; //Derivative of the base functions with respect to x, y and z double s[3] = {0.,0.,0.}; if(!Current.Element) Message::Error("Uninitialized Element in 'F_dFzduy'"); int numNode = Current.NumEntity; int i = 0 ; while (i < Current.Element->GeoElement->NbrNodes && Current.Element->GeoElement->NumNodes[i] != numNode) i++; if (i < Current.Element->GeoElement->NbrNodes ) { for(int j = 0; j < 3; j++) { squF[j] = A->Val[j] * A->Val[j] ; squF[j+3] = A->Val[j] * A->Val[(j<2)?j+1:0] ; } //Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w); DetJac = Current.Element->DetJac ; Jac = Current.Element->Jac ; DetJac_dx[0] = Current.Element->dndu[i][0] * ( Jac.c22 * Jac.c33 - Jac.c23 * Jac.c32 ) - Current.Element->dndu[i][1] * ( Jac.c12 * Jac.c33 - Jac.c13 * Jac.c32 ) + Current.Element->dndu[i][2] * ( Jac.c12 * Jac.c23 - Jac.c22 * Jac.c13 ); DetJac_dx[1] = - Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c33 - Jac.c23 * Jac.c31 ) + Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c33 - Jac.c13 * Jac.c31 ) - Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c23 - Jac.c13 * Jac.c21 ); DetJac_dx[2] = Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c32 - Jac.c22 * Jac.c31 ) - Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c32 - Jac.c12 * Jac.c31 ) + Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c22 - Jac.c12 * Jac.c21 ); if(DetJac != 0){ dsdx[0] = DetJac_dx[0]/DetJac ; dsdx[1] = DetJac_dx[1]/DetJac ; dsdx[2] = DetJac_dx[2]/DetJac ; s[0] = - 0.5 * (2 * squF[4] * dsdx[0] + 2 * squF[5] * dsdx[1] - 2 * squF[3] * dsdx[2]) ; s[1] = - 0.5 * (-2 * squF[5] * dsdx[0] + 2 * squF[4] * dsdx[1] + (squF[0] - squF[1] - squF[2]) * dsdx[2]) ; s[2] = - 0.5 * (2 * squF[3] * dsdx[0] + (-squF[0] + squF[1] + squF[2]) * dsdx[1] + 2 * squF[4] * dsdx[2]) ; } else { Message::Warning("Zero determinant in 'F_dFzduy'") ; } } V->Type = VECTOR ; V->Val[0] = s[0] ; V->Val[1] = s[1] ; V->Val[2] = s[2] ; } void F_dFxduz (F_ARG) { MATRIX3x3 Jac ; double DetJac ; double DetJac_dx[3], squF[6] ; double dsdx[3] ; //Derivative of the base functions with respect to x, y and z double s[3] = {0.,0.,0.}; if(!Current.Element) Message::Error("Uninitialized Element in 'F_dFxduz'"); int numNode = Current.NumEntity; int i = 0 ; while (i < Current.Element->GeoElement->NbrNodes && Current.Element->GeoElement->NumNodes[i] != numNode) i++; if (i < Current.Element->GeoElement->NbrNodes ) { for(int j = 0; j < 3; j++) { squF[j] = A->Val[j] * A->Val[j] ; squF[j+3] = A->Val[j] * A->Val[(j<2)?j+1:0] ; } //Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w); DetJac = Current.Element->DetJac ; Jac = Current.Element->Jac ; DetJac_dx[0] = Current.Element->dndu[i][0] * ( Jac.c22 * Jac.c33 - Jac.c23 * Jac.c32 ) - Current.Element->dndu[i][1] * ( Jac.c12 * Jac.c33 - Jac.c13 * Jac.c32 ) + Current.Element->dndu[i][2] * ( Jac.c12 * Jac.c23 - Jac.c22 * Jac.c13 ); DetJac_dx[1] = - Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c33 - Jac.c23 * Jac.c31 ) + Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c33 - Jac.c13 * Jac.c31 ) - Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c23 - Jac.c13 * Jac.c21 ); DetJac_dx[2] = Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c32 - Jac.c22 * Jac.c31 ) - Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c32 - Jac.c12 * Jac.c31 ) + Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c22 - Jac.c12 * Jac.c21 ); if(DetJac != 0){ dsdx[0] = DetJac_dx[0]/DetJac ; dsdx[1] = DetJac_dx[1]/DetJac ; dsdx[2] = DetJac_dx[2]/DetJac ; s[0] = - 0.5 * (2 * squF[5] * dsdx[0] + 2 * squF[4] * dsdx[1] + (squF[0] - squF[1] + squF[2]) * dsdx[2]) ; s[1] = - 0.5 * (-2 * squF[4] * dsdx[0] + 2 * squF[5] * dsdx[1] + 2 * squF[3] * dsdx[2]) ; s[2] = - 0.5 * ((-squF[0] + squF[1] - squF[2]) * dsdx[0] - 2 * squF[3] * dsdx[1] + 2 * squF[5] * dsdx[2]) ; } else { Message::Warning("Zero determinant in 'F_dFxduz'") ; } } V->Type = VECTOR ; V->Val[0] = s[0] ; V->Val[1] = s[1] ; V->Val[2] = s[2] ; } void F_dFyduz (F_ARG) { MATRIX3x3 Jac ; double DetJac ; double DetJac_dx[3], squF[6] ; double dsdx[3] ; //Derivative of the base functions with respect to x, y and z double s[3] = {0.,0.,0.}; if(!Current.Element) Message::Error("Uninitialized Element in 'F_dFyduz'"); int numNode = Current.NumEntity; int i = 0 ; while (i < Current.Element->GeoElement->NbrNodes && Current.Element->GeoElement->NumNodes[i] != numNode) i++; if (i < Current.Element->GeoElement->NbrNodes ) { for(int j = 0; j < 3; j++) { squF[j] = A->Val[j] * A->Val[j] ; squF[j+3] = A->Val[j] * A->Val[(j<2)?j+1:0] ; } //Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w); DetJac = Current.Element->DetJac ; Jac = Current.Element->Jac ; DetJac_dx[0] = Current.Element->dndu[i][0] * ( Jac.c22 * Jac.c33 - Jac.c23 * Jac.c32 ) - Current.Element->dndu[i][1] * ( Jac.c12 * Jac.c33 - Jac.c13 * Jac.c32 ) + Current.Element->dndu[i][2] * ( Jac.c12 * Jac.c23 - Jac.c22 * Jac.c13 ); DetJac_dx[1] = - Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c33 - Jac.c23 * Jac.c31 ) + Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c33 - Jac.c13 * Jac.c31 ) - Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c23 - Jac.c13 * Jac.c21 ); DetJac_dx[2] = Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c32 - Jac.c22 * Jac.c31 ) - Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c32 - Jac.c12 * Jac.c31 ) + Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c22 - Jac.c12 * Jac.c21 ); if(DetJac != 0){ dsdx[0] = DetJac_dx[0]/DetJac ; dsdx[1] = DetJac_dx[1]/DetJac ; dsdx[2] = DetJac_dx[2]/DetJac ; s[0] = - 0.5 * (2 * squF[4] * dsdx[0] - 2 * squF[5] * dsdx[1] + 2 * squF[3] * dsdx[2]) ; s[1] = - 0.5 * (2 * squF[5] * dsdx[0] + 2 * squF[4] * dsdx[1] + (-squF[0] + squF[1] + squF[2]) * dsdx[2]) ; s[2] = - 0.5 * (-2 * squF[3] * dsdx[0] + (squF[0] - squF[1] - squF[2]) * dsdx[1] + 2 * squF[4] * dsdx[2]) ; } else { Message::Warning("Zero determinant in 'F_dFyduz'") ; } } V->Type = VECTOR ; V->Val[0] = s[0] ; V->Val[1] = s[1] ; V->Val[2] = s[2] ; } void F_dFzduz (F_ARG) { MATRIX3x3 Jac ; double DetJac ; double DetJac_dx[3], squF[6] ; double dsdx[3] ; //Derivative of the base functions with respect to x, y and z double s[3] = {0.,0.,0.}; if(!Current.Element) Message::Error("Uninitialized Element in 'F_dFzduz'"); int numNode = Current.NumEntity; int i = 0 ; while (i < Current.Element->GeoElement->NbrNodes && Current.Element->GeoElement->NumNodes[i] != numNode) i++; if (i < Current.Element->GeoElement->NbrNodes ) { for(int j = 0; j < 3; j++) { squF[j] = A->Val[j] * A->Val[j] ; squF[j+3] = A->Val[j] * A->Val[(j<2)?j+1:0] ; } //Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w); DetJac = Current.Element->DetJac ; Jac = Current.Element->Jac ; DetJac_dx[0] = Current.Element->dndu[i][0] * ( Jac.c22 * Jac.c33 - Jac.c23 * Jac.c32 ) - Current.Element->dndu[i][1] * ( Jac.c12 * Jac.c33 - Jac.c13 * Jac.c32 ) + Current.Element->dndu[i][2] * ( Jac.c12 * Jac.c23 - Jac.c22 * Jac.c13 ); DetJac_dx[1] = - Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c33 - Jac.c23 * Jac.c31 ) + Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c33 - Jac.c13 * Jac.c31 ) - Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c23 - Jac.c13 * Jac.c21 ); DetJac_dx[2] = Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c32 - Jac.c22 * Jac.c31 ) - Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c32 - Jac.c12 * Jac.c31 ) + Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c22 - Jac.c12 * Jac.c21 ); if(DetJac != 0){ dsdx[0] = DetJac_dx[0]/DetJac ; dsdx[1] = DetJac_dx[1]/DetJac ; dsdx[2] = DetJac_dx[2]/DetJac ; s[0] = - squF[2] * dsdx[0] ; s[1] = - squF[2] * dsdx[1] ; s[2] = - squF[2] * dsdx[2] ; } else { Message::Warning("Zero determinant in 'F_dFzduz'") ; } } V->Type = VECTOR ; V->Val[0] = s[0] ; V->Val[1] = s[1] ; V->Val[2] = s[2] ; } void F_dFxdv (F_ARG) { MATRIX3x3 Jac ; double DetJac ; double DetJac_dx[3], squF[3] ; double dsdx[3] ; //Derivative of the base functions with respect to x, y and z double s[3] = {0.,0.,0.}; if(!Current.Element) Message::Error("Uninitialized Element in 'F_dFxdv'"); int numNode = Current.NumEntity; int i = 0 ; while (i < Current.Element->GeoElement->NbrNodes && Current.Element->GeoElement->NumNodes[i] != numNode) i++; if (i < Current.Element->GeoElement->NbrNodes ) { for(int j = 0; j < 3; j++) { squF[j] = A->Val[j] ; } //Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w); DetJac = Current.Element->DetJac ; Jac = Current.Element->Jac ; DetJac_dx[0] = Current.Element->dndu[i][0] * ( Jac.c22 * Jac.c33 - Jac.c23 * Jac.c32 ) - Current.Element->dndu[i][1] * ( Jac.c12 * Jac.c33 - Jac.c13 * Jac.c32 ) + Current.Element->dndu[i][2] * ( Jac.c12 * Jac.c23 - Jac.c22 * Jac.c13 ); DetJac_dx[1] = - Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c33 - Jac.c23 * Jac.c31 ) + Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c33 - Jac.c13 * Jac.c31 ) - Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c23 - Jac.c13 * Jac.c21 ); DetJac_dx[2] = Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c32 - Jac.c22 * Jac.c31 ) - Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c32 - Jac.c12 * Jac.c31 ) + Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c22 - Jac.c12 * Jac.c21 ); if(DetJac != 0){ dsdx[0] = DetJac_dx[0]/DetJac ; dsdx[1] = DetJac_dx[1]/DetJac ; dsdx[2] = DetJac_dx[2]/DetJac ; s[0] = - squF[0] * dsdx[0] - squF[1] * dsdx[1] - squF[2] * dsdx[2] ; s[1] = squF[1] * dsdx[0] - squF[0] * dsdx[1] ; s[2] = squF[2] * dsdx[0] - squF[0] * dsdx[2] ; } else { Message::Warning("Zero determinant in 'F_dFxdv'") ; } } V->Type = VECTOR ; V->Val[0] = s[0] ; V->Val[1] = s[1] ; V->Val[2] = s[2] ; } void F_dFydv (F_ARG) { MATRIX3x3 Jac ; double DetJac ; double DetJac_dx[3], squF[3] ; double dsdx[3] ; //Derivative of the base functions with respect to x, y and z double s[3] = {0.,0.,0.}; if(!Current.Element) Message::Error("Uninitialized Element in 'F_dFydv'"); int numNode = Current.NumEntity; int i = 0 ; while (i < Current.Element->GeoElement->NbrNodes && Current.Element->GeoElement->NumNodes[i] != numNode) i++; if (i < Current.Element->GeoElement->NbrNodes ) { for(int j = 0; j < 3; j++) { squF[j] = A->Val[j] ; } //Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w); DetJac = Current.Element->DetJac ; Jac = Current.Element->Jac ; DetJac_dx[0] = Current.Element->dndu[i][0] * ( Jac.c22 * Jac.c33 - Jac.c23 * Jac.c32 ) - Current.Element->dndu[i][1] * ( Jac.c12 * Jac.c33 - Jac.c13 * Jac.c32 ) + Current.Element->dndu[i][2] * ( Jac.c12 * Jac.c23 - Jac.c22 * Jac.c13 ); DetJac_dx[1] = - Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c33 - Jac.c23 * Jac.c31 ) + Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c33 - Jac.c13 * Jac.c31 ) - Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c23 - Jac.c13 * Jac.c21 ); DetJac_dx[2] = Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c32 - Jac.c22 * Jac.c31 ) - Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c32 - Jac.c12 * Jac.c31 ) + Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c22 - Jac.c12 * Jac.c21 ); if(DetJac != 0){ dsdx[0] = DetJac_dx[0]/DetJac ; dsdx[1] = DetJac_dx[1]/DetJac ; dsdx[2] = DetJac_dx[2]/DetJac ; s[0] = - squF[1] * dsdx[0] + squF[0] * dsdx[1] ; s[1] = - squF[0] * dsdx[0] - squF[1] * dsdx[1] - squF[2] * dsdx[2] ; s[2] = squF[2] * dsdx[1] - squF[1] * dsdx[2] ; } else { Message::Warning("Zero determinant in 'F_dFydv'") ; } } V->Type = VECTOR ; V->Val[0] = s[0] ; V->Val[1] = s[1] ; V->Val[2] = s[2] ; } void F_dFzdv (F_ARG) { MATRIX3x3 Jac ; double DetJac ; double DetJac_dx[3], squF[3] ; double dsdx[3] ; //Derivative of the base functions with respect to x, y and z double s[3] = {0.,0.,0.}; if(!Current.Element) Message::Error("Uninitialized Element in 'F_dFzdv'"); int numNode = Current.NumEntity; int i = 0 ; while (i < Current.Element->GeoElement->NbrNodes && Current.Element->GeoElement->NumNodes[i] != numNode) i++; if (i < Current.Element->GeoElement->NbrNodes ) { for(int j = 0; j < 3; j++) { squF[j] = A->Val[j] ; } //Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w); DetJac = Current.Element->DetJac ; Jac = Current.Element->Jac ; DetJac_dx[0] = Current.Element->dndu[i][0] * ( Jac.c22 * Jac.c33 - Jac.c23 * Jac.c32 ) - Current.Element->dndu[i][1] * ( Jac.c12 * Jac.c33 - Jac.c13 * Jac.c32 ) + Current.Element->dndu[i][2] * ( Jac.c12 * Jac.c23 - Jac.c22 * Jac.c13 ); DetJac_dx[1] = - Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c33 - Jac.c23 * Jac.c31 ) + Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c33 - Jac.c13 * Jac.c31 ) - Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c23 - Jac.c13 * Jac.c21 ); DetJac_dx[2] = Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c32 - Jac.c22 * Jac.c31 ) - Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c32 - Jac.c12 * Jac.c31 ) + Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c22 - Jac.c12 * Jac.c21 ); if(DetJac != 0){ dsdx[0] = DetJac_dx[0]/DetJac ; dsdx[1] = DetJac_dx[1]/DetJac ; dsdx[2] = DetJac_dx[2]/DetJac ; s[0] = - squF[2] * dsdx[0] + squF[0] * dsdx[2] ; s[1] = - squF[2] * dsdx[1] + squF[1] * dsdx[2] ; s[2] = - squF[0] * dsdx[0] - squF[1] * dsdx[1] - squF[2] * dsdx[2] ; } else { Message::Warning("Zero determinant in 'F_dFzdv'") ; } } V->Type = VECTOR ; V->Val[0] = s[0] ; V->Val[1] = s[1] ; V->Val[2] = s[2] ; } void F_dWedxdv (F_ARG) { MATRIX3x3 Jac ; double DetJac ; double DetJac_dx[3], squF[3] ; double dsdx[3] ; //Derivative of the base functions with respect to x, y and z double s[3] = {0.,0.,0.}; if(!Current.Element) Message::Error("Uninitialized Element in 'F_dWedxdv'"); int numNode = Current.NumEntity; int i = 0 ; while (i < Current.Element->GeoElement->NbrNodes && Current.Element->GeoElement->NumNodes[i] != numNode) i++; if (i < Current.Element->GeoElement->NbrNodes ) { for(int j = 0; j < 3; j++) { squF[j] = A->Val[j] ; } //Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w); DetJac = Current.Element->DetJac ; Jac = Current.Element->Jac ; DetJac_dx[0] = Current.Element->dndu[i][0] * ( Jac.c22 * Jac.c33 - Jac.c23 * Jac.c32 ) - Current.Element->dndu[i][1] * ( Jac.c12 * Jac.c33 - Jac.c13 * Jac.c32 ) + Current.Element->dndu[i][2] * ( Jac.c12 * Jac.c23 - Jac.c22 * Jac.c13 ); DetJac_dx[1] = - Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c33 - Jac.c23 * Jac.c31 ) + Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c33 - Jac.c13 * Jac.c31 ) - Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c23 - Jac.c13 * Jac.c21 ); DetJac_dx[2] = Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c32 - Jac.c22 * Jac.c31 ) - Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c32 - Jac.c12 * Jac.c31 ) + Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c22 - Jac.c12 * Jac.c21 ); if(DetJac != 0){ dsdx[0] = DetJac_dx[0]/DetJac ; dsdx[1] = DetJac_dx[1]/DetJac ; dsdx[2] = DetJac_dx[2]/DetJac ; s[0] = -squF[0] * dsdx[0] + squF[1] * dsdx[1] + squF[2] * dsdx[2] ; s[1] = -squF[1] * dsdx[0] - squF[0] * dsdx[1] ; s[2] = -squF[2] * dsdx[0] - squF[0] * dsdx[2] ; } else { Message::Warning("Zero determinant in 'F_dWedxdv'") ; } } V->Type = VECTOR ; V->Val[0] = s[0] ; V->Val[1] = s[1] ; V->Val[2] = s[2] ; } void F_dWedydv (F_ARG) { MATRIX3x3 Jac ; double DetJac ; double DetJac_dx[3], squF[3] ; double dsdx[3] ; //Derivative of the base functions with respect to x, y and z double s[3] = {0.,0.,0.}; if(!Current.Element) Message::Error("Uninitialized Element in 'F_dWedydv'"); int numNode = Current.NumEntity; int i = 0 ; while (i < Current.Element->GeoElement->NbrNodes && Current.Element->GeoElement->NumNodes[i] != numNode) i++; if (i < Current.Element->GeoElement->NbrNodes ) { for(int j = 0; j < 3; j++) { squF[j] = A->Val[j] ; } //Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w); DetJac = Current.Element->DetJac ; Jac = Current.Element->Jac ; DetJac_dx[0] = Current.Element->dndu[i][0] * ( Jac.c22 * Jac.c33 - Jac.c23 * Jac.c32 ) - Current.Element->dndu[i][1] * ( Jac.c12 * Jac.c33 - Jac.c13 * Jac.c32 ) + Current.Element->dndu[i][2] * ( Jac.c12 * Jac.c23 - Jac.c22 * Jac.c13 ); DetJac_dx[1] = - Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c33 - Jac.c23 * Jac.c31 ) + Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c33 - Jac.c13 * Jac.c31 ) - Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c23 - Jac.c13 * Jac.c21 ); DetJac_dx[2] = Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c32 - Jac.c22 * Jac.c31 ) - Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c32 - Jac.c12 * Jac.c31 ) + Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c22 - Jac.c12 * Jac.c21 ); if(DetJac != 0){ dsdx[0] = DetJac_dx[0]/DetJac ; dsdx[1] = DetJac_dx[1]/DetJac ; dsdx[2] = DetJac_dx[2]/DetJac ; s[0] = -squF[1] * dsdx[0] - squF[0] * dsdx[1] ; s[1] = squF[0] * dsdx[0] - squF[1] * dsdx[1] + squF[2] * dsdx[2] ; s[2] = -squF[2] * dsdx[1] - squF[1] * dsdx[2] ; } else { Message::Warning("Zero determinant in 'F_dWedydv'") ; } } V->Type = VECTOR ; V->Val[0] = s[0] ; V->Val[1] = s[1] ; V->Val[2] = s[2] ; } void F_dWedzdv (F_ARG) { MATRIX3x3 Jac ; double DetJac ; double DetJac_dx[3], squF[3] ; double dsdx[3] ; //Derivative of the base functions with respect to x, y and z double s[3] = {0.,0.,0.}; if(!Current.Element) Message::Error("Uninitialized Element in 'F_dWedzdv'"); int numNode = Current.NumEntity; int i = 0 ; while (i < Current.Element->GeoElement->NbrNodes && Current.Element->GeoElement->NumNodes[i] != numNode) i++; if (i < Current.Element->GeoElement->NbrNodes ) { for(int j = 0; j < 3; j++) { squF[j] = A->Val[j] ; } //Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w); DetJac = Current.Element->DetJac ; Jac = Current.Element->Jac ; DetJac_dx[0] = Current.Element->dndu[i][0] * ( Jac.c22 * Jac.c33 - Jac.c23 * Jac.c32 ) - Current.Element->dndu[i][1] * ( Jac.c12 * Jac.c33 - Jac.c13 * Jac.c32 ) + Current.Element->dndu[i][2] * ( Jac.c12 * Jac.c23 - Jac.c22 * Jac.c13 ); DetJac_dx[1] = - Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c33 - Jac.c23 * Jac.c31 ) + Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c33 - Jac.c13 * Jac.c31 ) - Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c23 - Jac.c13 * Jac.c21 ); DetJac_dx[2] = Current.Element->dndu[i][0] * ( Jac.c21 * Jac.c32 - Jac.c22 * Jac.c31 ) - Current.Element->dndu[i][1] * ( Jac.c11 * Jac.c32 - Jac.c12 * Jac.c31 ) + Current.Element->dndu[i][2] * ( Jac.c11 * Jac.c22 - Jac.c12 * Jac.c21 ); if(DetJac != 0){ dsdx[0] = DetJac_dx[0]/DetJac ; dsdx[1] = DetJac_dx[1]/DetJac ; dsdx[2] = DetJac_dx[2]/DetJac ; s[0] = -squF[2] * dsdx[0] - squF[0] * dsdx[2] ; s[1] = -squF[2] * dsdx[1] - squF[1] * dsdx[2] ; s[2] = squF[0] * dsdx[0] + squF[1] * dsdx[1] - squF[2] * dsdx[2] ; } else { Message::Warning("Zero determinant in 'F_dWedzdv'") ; } } V->Type = VECTOR ; V->Val[0] = s[0] ; V->Val[1] = s[1] ; V->Val[2] = s[2] ; } // End Blex added void F_AssDiag(F_ARG) { int k ; if (Fct->NbrParameters == 1) Current.flagAssDiag = Fct->Para[0]; else Current.flagAssDiag = 2; /*+++prov*/ V->Val[0] = 1.; if (Current.NbrHar != 1){ V->Val[MAX_DIM] = 0. ; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) V->Val[MAX_DIM*k] = V->Val[MAX_DIM*(k+1)] = 0. ; } V->Type = SCALAR ; } getdp-2.7.0-source/Legacy/Pos_Print.cpp000644 001750 001750 00000172072 12553357400 021443 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include #include #include "ProData.h" #include "GeoData.h" #include "DofData.h" #include "Cal_PostQuantity.h" #include "Get_Geometry.h" #include "Get_DofOfElement.h" #include "Get_FunctionValue.h" #include "ExtendedGroup.h" #include "Cal_Quantity.h" #include "Cal_Value.h" #include "Pos_Formulation.h" #include "Pos_Element.h" #include "Pos_Search.h" #include "Pos_Print.h" #include "Pos_Format.h" #include "Adapt.h" #include "MallocUtils.h" #include "Message.h" #define SQU(a) ((a)*(a)) extern struct Problem Problem_S ; extern struct CurrentData Current ; extern int Flag_BIN ; extern FILE *PostStream ; /* Print OnElementsOf ------------------ expl: plot on elements, belonging to the current mesh, where the solution was computed during the processing stage args: list of groups of region type Print OnSection --------------- expl: plot an a 'real' cut of the mesh, i.e. computation on the intersections of the mesh with a cutting entity (plane, line) args: 2 (not done) or 3 points, specifying the cutting line or the cutting plane Print OnGrid ------------ expl: reinterpolate the solution on a grid args: - a list of groups of region type (belonging to a mesh, where the solution will be reinterpolated) - 3 expressions (using $S and $T) and 2 intervals for the parametric grid definition Print OnPoint, OnLine, OnPlane, OnBox ------------------------------------- expl: reinterpolate the solution on a grid (particular cases) args: 1, 2, 3 or 4 points (0d, 1d, 2d or 3d grid) and the associated number of divisions Print OnRegion -------------- expl: print Global Quantities associated with Regions args: list of groups of region type */ /* ------------------------------------------------------------------------ */ /* P o s _ P r i n t O n E l e m e n t s O f */ /* ------------------------------------------------------------------------ */ struct CutEdge { int nbc ; double x[2],y[2],z[2] ; double xc,yc,zc ; double uc,vc,wc ; struct Value *Value ; } ; struct xyzv { double x,y,z; struct Value v; /*int nbvals; for time domain -> malloc Value *v... */ int nboccurences; }; struct ValMinMax { struct Value Val, ValX, ValY, ValZ; }; int CompareValue(const Value * valA_P, const Value * valB_P) { double cmp=0, VecLengthSquA, VecLengthSquB; //if (Current.NbrHar != 1) // Message::Error("Cannot compare multi-harmonic values"); // -> we compare the real part in this case switch (valA_P->Type) { case SCALAR: cmp = valA_P->Val[0] - valB_P->Val[0]; break; case VECTOR: VecLengthSquA = valA_P->Val[0] * valA_P->Val[0] + valA_P->Val[1] * valA_P->Val[1] + valA_P->Val[2] * valA_P->Val[2]; VecLengthSquB = valB_P->Val[0] * valB_P->Val[0] + valB_P->Val[1] * valB_P->Val[1] + valB_P->Val[2] * valB_P->Val[2]; cmp = VecLengthSquA - VecLengthSquB; break; default: Message::Error("Cannot compare values other than SCALAR and VECTOR"); } if(cmp > 1.e-16) return 1; else if(cmp < -1.e-16) return -1; else return 0; } void SetValMinMax(struct PostElement *PE_P, int iNode, struct ValMinMax *ValueMinMax_P) { Cal_CopyValue(&PE_P->Value[iNode], &ValueMinMax_P->Val); ValueMinMax_P->ValX.Val[0] = PE_P->x[iNode]; ValueMinMax_P->ValY.Val[0] = PE_P->y[iNode]; ValueMinMax_P->ValZ.Val[0] = PE_P->z[iNode]; } void InitValMinMax(struct ValMinMax *ValueMinMax_P, struct PostElement *PE_P) { // Init ValueMin and ValueMax ValueMinMax_P->ValX.Type = SCALAR; ValueMinMax_P->ValY.Type = SCALAR; ValueMinMax_P->ValZ.Type = SCALAR; Cal_ZeroValue(&ValueMinMax_P->ValX); Cal_ZeroValue(&ValueMinMax_P->ValY); Cal_ZeroValue(&ValueMinMax_P->ValZ); SetValMinMax(PE_P, 0, ValueMinMax_P); } void EvalMinMax(struct PostElement *PE_P, struct ValMinMax *ValueMin_P, struct ValMinMax *ValueMax_P) { for(int iNode = 0 ; iNode < PE_P->NbrNodes ; iNode++) { if (CompareValue(&PE_P->Value[iNode], &ValueMin_P->Val) < 0) SetValMinMax(PE_P, iNode, ValueMin_P); if (CompareValue(&PE_P->Value[iNode], &ValueMax_P->Val) > 0) SetValMinMax(PE_P, iNode, ValueMax_P); } } static int fcmp_xyzv(const void * a, const void * b) { struct xyzv *p1, *p2; double TOL = Current.GeoData->CharacteristicLength * 1.e-8; p1 = (struct xyzv*)a; p2 = (struct xyzv*)b; if(p1->x - p2->x > TOL) return 1; if(p1->x - p2->x <-TOL) return -1; if(p1->y - p2->y > TOL) return 1; if(p1->y - p2->y <-TOL) return -1; if(p1->z - p2->z > TOL) return 1; if(p1->z - p2->z <-TOL) return -1; return 0; } static List_T * SkinPostElement_L ; static int SkinDepth ; static void Cut_SkinPostElement(void *a, void *b) { struct PostElement * PE ; PE = *(struct PostElement**)a ; Cut_PostElement(PE, Geo_GetGeoElement(PE->Index), SkinPostElement_L, PE->Index, SkinDepth, 0, 1) ; } static void Decompose_SkinPostElement(void *a, void *b) { struct PostElement * PE, * PE2 ; PE = *(struct PostElement**)a ; if(PE->Type != QUADRANGLE) return; /* change the quad to a tri */ PE->Type = TRIANGLE; PE->NbrNodes = 3; /* create a second tri */ PE2 = NodeCopy_PostElement(PE) ; PE2->NumNodes[1] = PE->NumNodes[2]; PE2->u[1] = PE->u[2]; PE2->x[1] = PE->x[2]; PE2->v[1] = PE->v[2]; PE2->y[1] = PE->y[2]; PE2->w[1] = PE->w[2]; PE2->z[1] = PE->z[2]; PE2->NumNodes[2] = PE->NumNodes[3]; PE2->u[2] = PE->u[3]; PE2->x[2] = PE->x[3]; PE2->v[2] = PE->v[3]; PE2->y[2] = PE->y[3]; PE2->w[2] = PE->w[3]; PE2->z[2] = PE->z[3]; List_Add(SkinPostElement_L, &PE2); } void Pos_PrintOnElementsOf(struct PostQuantity *NCPQ_P, struct PostQuantity *CPQ_P, int Order, struct DefineQuantity *DefineQuantity_P0, struct QuantityStorage *QuantityStorage_P0, struct PostSubOperation *PSO_P) { Tree_T * PostElement_T ; List_T * PostElement_L, * Region_L ; struct Element Element ; struct PostElement * PE ; struct Value * CumulativeValues ; struct xyzv xyzv, *xyzv_P ; struct ValMinMax ValueMin, ValueMax ; Tree_T * xyzv_T ; double * Error=NULL, Dummy[5], d, x1, x2 ; int jj, NbrGeo, iGeo, incGeo, NbrPost=0, iPost ; int NbrTimeStep, iTime, iNode ; int Store = 0, DecomposeInSimplex = 0, Depth ; bool StoreMinMax, ValueMinMaxInitialized; /* Do we have to store min. and max. values? */ if (PSO_P->StoreMinInRegister >= 0 || PSO_P->StoreMaxInRegister >= 0 || PSO_P->StoreMinXinRegister >= 0 || PSO_P->StoreMaxXinRegister >= 0 || PSO_P->StoreMinYinRegister >= 0 || PSO_P->StoreMaxYinRegister >= 0 || PSO_P->StoreMinZinRegister >= 0 || PSO_P->StoreMaxZinRegister >= 0) { StoreMinMax = true; } else StoreMinMax = false; /* Select the TimeSteps */ NbrTimeStep = Pos_InitTimeSteps(PSO_P); /* Print the header */ NbrGeo = Geo_GetNbrGeoElements() ; Format_PostHeader(PSO_P, NbrTimeStep, Order, PSO_P->Label ? PSO_P->Label : (NCPQ_P ? NCPQ_P->Name : NULL), PSO_P->Label ? NULL : (CPQ_P ? CPQ_P->Name : NULL)); /* Get the region */ Region_L = ((struct Group *) List_Pointer(Problem_S.Group, PSO_P->Case.OnRegion.RegionIndex))->InitialList ; Get_InitDofOfElement(&Element) ; /* Compute the Cumulative quantity, if any */ if(CPQ_P){ Cal_PostCumulativeQuantity(Region_L, PSO_P->PostQuantitySupport[Order], PSO_P->TimeStep_L, CPQ_P, DefineQuantity_P0, QuantityStorage_P0, &CumulativeValues); } /* If we compute a skin, apply smoothing, sort the results, or perform adaption, we'll need to store all the PostElements */ if(PSO_P->Smoothing || PSO_P->Skin || PSO_P->Adapt || PSO_P->Sort) Store = 1 ; /* Check if everything is OK for Adaption */ if(PSO_P->Adapt){ if(PSO_P->Dimension == _ALL){ Message::Error("You have to specify a Dimension for the adaptation (2 or 3)"); return; } if(PSO_P->Target < 0.){ Message::Error("You have to specify a Target for the adaptation (e.g. 0.01)"); return; } if(NbrTimeStep > 1){ Message::Error("Adaption not ready with more than one time step"); return; } } /* Check if we should decompose all PostElements to simplices */ if(!PSO_P->Skin && PSO_P->DecomposeInSimplex) DecomposeInSimplex = 1 ; /* Check for de-refinement */ if(PSO_P->Depth < 0) incGeo = - PSO_P->Depth ; else incGeo = 1 ; /* Create the list of PostElements */ PostElement_L = List_Create(Store ? NbrGeo/10 : 10, Store ? NbrGeo/10 : 10, sizeof(struct PostElement *)) ; if(Store){ /* If we have a Skin, we will divide after the skin extraction */ if(PSO_P->Skin && PSO_P->Depth > 1) Depth = 1; else Depth = PSO_P->Depth; /* Generate all PostElements */ Message::ResetProgressMeter(); for(iGeo = 0 ; iGeo < NbrGeo ; iGeo += incGeo) { Element.GeoElement = Geo_GetGeoElement(iGeo) ; if(List_Search(Region_L, &Element.GeoElement->Region, fcmp_int)){ Fill_PostElement(Element.GeoElement, PostElement_L, iGeo, Depth, PSO_P->Skin, PSO_P->EvaluationPoints, DecomposeInSimplex) ; } Message::ProgressMeter(iGeo + 1, NbrGeo, "Post-processing (Generate)"); if(Message::GetErrorCount()) break; } /* Compute the skin */ if(PSO_P->Skin){ PostElement_T = Tree_Create(sizeof(struct PostElement *), fcmp_PostElement); Message::ResetProgressMeter(); for(iPost = 0 ; iPost < List_Nbr(PostElement_L) ; iPost++){ PE = *(struct PostElement**)List_Pointer(PostElement_L, iPost) ; if(Tree_PQuery(PostElement_T, &PE)){ Tree_Suppress(PostElement_T, &PE); Destroy_PostElement(PE) ; } else Tree_Add(PostElement_T, &PE); Message::ProgressMeter(iPost + 1, List_Nbr(PostElement_L), "Post-processing (Skin)"); if(Message::GetErrorCount()) break; } /* only decompose in simplices (triangles!) now */ if(PSO_P->DecomposeInSimplex){ List_Reset(PostElement_L); SkinPostElement_L = PostElement_L ; Tree_Action(PostElement_T, Decompose_SkinPostElement); for(iPost = 0 ; iPost < List_Nbr(SkinPostElement_L) ; iPost++) Tree_Add(PostElement_T, (struct PostElement**)List_Pointer(SkinPostElement_L, iPost)) ; } if(PSO_P->Depth > 1){ List_Reset(PostElement_L); SkinPostElement_L = PostElement_L ; SkinDepth = PSO_P->Depth ; Tree_Action(PostElement_T, Cut_SkinPostElement) ; } else{ List_Delete(PostElement_L); PostElement_L = Tree2List(PostElement_T); } Tree_Delete(PostElement_T); } } /* if Store */ /* Loop on GeoElements */ Message::ResetProgressMeter(); ValueMinMaxInitialized = false; for(iGeo = 0 ; iGeo < NbrGeo ; iGeo += incGeo) { if(Store){ if(iGeo) break ; } else{ List_Reset(PostElement_L) ; Element.GeoElement = Geo_GetGeoElement(iGeo) ; if(List_Search(Region_L, &Element.GeoElement->Region, fcmp_int)){ Fill_PostElement(Element.GeoElement, PostElement_L, iGeo, PSO_P->Depth, PSO_P->Skin, PSO_P->EvaluationPoints, DecomposeInSimplex) ; } } NbrPost = List_Nbr(PostElement_L) ; /* Loop on PostElements */ for(iPost = 0 ; iPost < NbrPost ; iPost++) { PE = *(struct PostElement **)List_Pointer(PostElement_L, iPost) ; if(!NCPQ_P){ /* Only one Cumulative */ for (iTime = 0 ; iTime < NbrTimeStep ; iTime++){ for(iNode = 0 ; iNode < PE->NbrNodes ; iNode++) Cal_CopyValue(&CumulativeValues[iTime], &PE->Value[iNode]); if(!Store) Format_PostElement(PSO_P, PSO_P->Iso, 0, Current.Time, iTime, NbrTimeStep, Current.NbrHar, PSO_P->HarmonicToTime, NULL, PE); } } else{ /* There is one non-cumulative */ if(PSO_P->SubType == PRINT_ONGRID){ /* We re-interpolate */ for (iTime = 0 ; iTime < NbrTimeStep ; iTime++) { Pos_InitAllSolutions(PSO_P->TimeStep_L, iTime) ; for(iNode = 0 ; iNode < PE->NbrNodes ; iNode++){ InWhichElement(&Current.GeoData->Grid, Region_L, &Element, PSO_P->Dimension, PE->x[iNode], PE->y[iNode], PE->z[iNode], &PE->u[iNode], &PE->v[iNode], &PE->w[iNode]) ; Current.Region = Element.Region ; Current.x = PE->x[iNode] ; Current.y = PE->y[iNode] ; Current.z = PE->z[iNode] ; Cal_PostQuantity(NCPQ_P, DefineQuantity_P0, QuantityStorage_P0, NULL, &Element, PE->u[iNode], PE->v[iNode], PE->w[iNode], &PE->Value[iNode]); if(CPQ_P) Combine_PostQuantity(PSO_P->CombinationType, Order, &PE->Value[iNode], &CumulativeValues[iNode]) ; } if (StoreMinMax) { if (!ValueMinMaxInitialized){ // Init ValueMin and ValueMax InitValMinMax(&ValueMin, PE); InitValMinMax(&ValueMax, PE); ValueMinMaxInitialized = true; } EvalMinMax(PE, &ValueMin, &ValueMax); } if(!Store) Format_PostElement(PSO_P, PSO_P->Iso, 0, Current.Time, iTime, NbrTimeStep, Current.NbrHar, PSO_P->HarmonicToTime, NULL, PE); } } else{ /* PRINT_ONREGION: We work on the real mesh */ Element.GeoElement = Geo_GetGeoElement(PE->Index) ; Element.Num = Element.GeoElement->Num ; Element.Type = Element.GeoElement->Type ; Current.Region = Element.Region = Element.GeoElement->Region ; Get_NodesCoordinatesOfElement(&Element) ; for (iTime = 0 ; iTime < NbrTimeStep ; iTime++) { Pos_InitAllSolutions(PSO_P->TimeStep_L, iTime) ; for(iNode = 0 ; iNode < PE->NbrNodes ; iNode++){ Current.x = PE->x[iNode] ; Current.y = PE->y[iNode] ; Current.z = PE->z[iNode] ; Cal_PostQuantity(NCPQ_P, DefineQuantity_P0, QuantityStorage_P0, NULL, &Element, PE->u[iNode], PE->v[iNode], PE->w[iNode], &PE->Value[iNode]); if(CPQ_P) Combine_PostQuantity(PSO_P->CombinationType, Order, &PE->Value[iNode], &CumulativeValues[iTime]) ; } if (StoreMinMax) { if (!ValueMinMaxInitialized){ // Init ValueMin and ValueMax InitValMinMax(&ValueMin, PE); InitValMinMax(&ValueMax, PE); ValueMinMaxInitialized = true; } EvalMinMax(PE, &ValueMin, &ValueMax); } if(!Store) Format_PostElement(PSO_P, PSO_P->Iso, 0, Current.Time, iTime, NbrTimeStep, Current.NbrHar, PSO_P->HarmonicToTime, NULL, PE); } } } if(!Store) Destroy_PostElement(PE) ; } Message::ProgressMeter(iGeo + 1, NbrGeo, "Post-processing (Compute)"); if(Message::GetErrorCount()) break; } /* for iGeo */ /* Store minimum or maximum value in register */ if (StoreMinMax) { if (PSO_P->StoreMinInRegister >= 0) Cal_StoreInRegister(&ValueMin.Val, PSO_P->StoreMinInRegister) ; if (PSO_P->StoreMinXinRegister >= 0) Cal_StoreInRegister(&ValueMin.ValX, PSO_P->StoreMinXinRegister) ; if (PSO_P->StoreMinYinRegister >= 0) Cal_StoreInRegister(&ValueMin.ValY, PSO_P->StoreMinYinRegister) ; if (PSO_P->StoreMinZinRegister >= 0) Cal_StoreInRegister(&ValueMin.ValZ, PSO_P->StoreMinZinRegister) ; if (PSO_P->StoreMaxInRegister >= 0) Cal_StoreInRegister(&ValueMax.Val, PSO_P->StoreMaxInRegister) ; if (PSO_P->StoreMaxXinRegister >= 0) Cal_StoreInRegister(&ValueMax.Val, PSO_P->StoreMaxXinRegister) ; if (PSO_P->StoreMaxYinRegister >= 0) Cal_StoreInRegister(&ValueMax.Val, PSO_P->StoreMaxYinRegister) ; if (PSO_P->StoreMaxZinRegister >= 0) Cal_StoreInRegister(&ValueMax.Val, PSO_P->StoreMaxZinRegister) ; } /* Perform Smoothing */ if(PSO_P->Smoothing){ Message::Info("Smoothing (phase 1)"); xyzv_T = Tree_Create(sizeof(struct xyzv), fcmp_xyzv); for (iPost = 0 ; iPost < NbrPost ; iPost++){ PE = *(struct PostElement**)List_Pointer(PostElement_L, iPost) ; for(iNode = 0 ; iNode < PE->NbrNodes ; iNode++) { xyzv.x = PE->x[iNode]; xyzv.y = PE->y[iNode]; xyzv.z = PE->z[iNode]; if((xyzv_P = (struct xyzv*)Tree_PQuery(xyzv_T, &xyzv))){ x1 = (double)(xyzv_P->nboccurences)/ (double)(xyzv_P->nboccurences + 1.); x2 = 1./(double)(xyzv_P->nboccurences + 1); Cal_AddMultValue2(&xyzv_P->v, x1, &PE->Value[iNode], x2); xyzv_P->nboccurences++; } else{ Cal_CopyValue(&PE->Value[iNode],&xyzv.v); xyzv.nboccurences = 1; Tree_Add(xyzv_T, &xyzv); } } } Message::Info("Smoothing (phase 2)"); for(iPost = 0 ; iPost < NbrPost ; iPost++){ PE = *(struct PostElement**)List_Pointer(PostElement_L, iPost) ; for(iNode = 0 ; iNode < PE->NbrNodes ; iNode++) { xyzv.x = PE->x[iNode]; xyzv.y = PE->y[iNode]; xyzv.z = PE->z[iNode]; if((xyzv_P = (struct xyzv*)Tree_PQuery(xyzv_T, &xyzv))){ Cal_CopyValue(&xyzv_P->v, &PE->Value[iNode]); } else Message::Warning("Node (%g,%g,%g) not found", xyzv.x, xyzv.y, xyzv.z); } } Tree_Delete(xyzv_T); } /* if Smoothing */ /* Perform Adaption */ if(PSO_P->Adapt){ if(!Current.GeoData->H) Current.GeoData->H = (double*)Malloc((NbrGeo+2)*sizeof(double)) ; if(!Current.GeoData->P) Current.GeoData->P = (double*)Malloc((NbrGeo+2)*sizeof(double)) ; Error = (double*)Malloc((NbrGeo+1)*sizeof(double)) ; /* All elements are perfect... */ for(iGeo = 0 ; iGeo < NbrGeo ; iGeo++){ Element.GeoElement = Geo_GetGeoElement(iGeo) ; Element.Num = Element.GeoElement->Num ; Element.Type = Element.GeoElement->Type ; Element.Region = Element.GeoElement->Region ; Get_NodesCoordinatesOfElement(&Element) ; Current.GeoData->H[iGeo+1] = Cal_MaxEdgeLength(&Element) ; Current.GeoData->P[iGeo+1] = 1. ; Error[iGeo+1] = PSO_P->Target ; } /* ...except those we want to optimize */ for(iPost = 0 ; iPost < NbrPost ; iPost++){ PE = *(struct PostElement**)List_Pointer(PostElement_L, iPost); Error[PE->Index+1] = 0. ; for(iNode = 0 ; iNode < PE->NbrNodes ; iNode++) Error[PE->Index+1] += PE->Value[iNode].Val[0] ; Error[PE->Index+1] /= (double)PE->NbrNodes ; } Adapt (NbrGeo, PSO_P->Adapt, PSO_P->Dimension, Error, Current.GeoData->H, Current.GeoData->P, PSO_P->Target); /* Clean up the interpolation orders to fit to what's available */ if(List_Nbr(PSO_P->Value_L)){ for(iGeo = 0 ; iGeo < NbrGeo ; iGeo++){ for(jj = List_Nbr(PSO_P->Value_L)-1 ; jj >= 0 ; jj--){ d = *(double*)List_Pointer(PSO_P->Value_L, jj); if(Current.GeoData->P[iGeo+1] > d || jj == 0){ Current.GeoData->P[iGeo+1] = d ; break ; } } } } } /* if Adapt */ /* Print everything if we are in Store mode */ if(Store){ /* Sort the elements */ switch(PSO_P->Sort){ case SORT_BY_POSITION : List_Sort(PostElement_L, fcmp_PostElement) ; break ; case SORT_BY_CONNECTIVITY : Sort_PostElement_Connectivity(PostElement_L) ; break ; } Dummy[0] = Dummy[1] = Dummy[2] = Dummy[3] = Dummy[4] = 0. ; for(iPost = 0 ; iPost < NbrPost ; iPost++){ PE = *(struct PostElement**)List_Pointer(PostElement_L, iPost); /* Get the values from adaption */ if(PSO_P->Adapt){ Element.GeoElement = Geo_GetGeoElement(PE->Index) ; Dummy[0] = Element.GeoElement->Num ; Dummy[1] = Error[PE->Index+1] ; Dummy[2] = Current.GeoData->H[PE->Index+1] ; Dummy[3] = Current.GeoData->P[PE->Index+1] ; Dummy[4] = iPost ? 0 : NbrPost ; for(iNode = 0 ; iNode < PE->NbrNodes ; iNode++){ PE->Value[iNode].Type = SCALAR ; if(PSO_P->Adapt == H1 || PSO_P->Adapt == H2) PE->Value[iNode].Val[0] = Dummy[2] ; else PE->Value[iNode].Val[0] = Dummy[3] ; } } /* Compute curvilinear coord if connection sort */ if(PSO_P->Sort == SORT_BY_CONNECTIVITY){ Dummy[0] = Dummy[1] ; Dummy[1] = Dummy[0] + sqrt(SQU(PE->x[1]-PE->x[0])+ SQU(PE->y[1]-PE->y[0])+ SQU(PE->z[1]-PE->z[0])) ; Dummy[2] = PE->v[0] ; Dummy[3] = -1. ; } Format_PostElement(PSO_P, PSO_P->Iso, 1, Current.Time, 0, 1, Current.NbrHar, PSO_P->HarmonicToTime, Dummy, PE); } } Format_PostFooter(PSO_P, Store); if(Store) for(iPost = 0 ; iPost < NbrPost ; iPost++){ PE = *(struct PostElement**)List_Pointer(PostElement_L, iPost); Destroy_PostElement(PE) ; } List_Delete(PostElement_L); if(CPQ_P) Free(CumulativeValues); if(PSO_P->Adapt) Free(Error) ; } /* ------------------------------------------------------------------------ */ /* P o s _ P r i n t O n S e c t i o n */ /* ------------------------------------------------------------------------ */ double Plane(double a, double b, double c, double d, double x, double y, double z) { return (a*x+b*y+c*z+d); } static double DIRX[3], DIRY[3], DIRZ[3], XCP, YCP ; int fcmp_Angle (const void *a, const void *b) { struct CutEdge *q , *w; double x1,y1,x2,y2,ang1,ang2; q = (struct CutEdge*)a; w = (struct CutEdge*)b; x1 = q->xc*DIRX[0] + q->yc*DIRX[1] + q->zc*DIRX[2]; y1 = q->xc*DIRY[0] + q->yc*DIRY[1] + q->zc*DIRY[2]; x2 = w->xc*DIRX[0] + w->yc*DIRX[1] + w->zc*DIRX[2]; y2 = w->xc*DIRY[0] + w->yc*DIRY[1] + w->zc*DIRY[2]; ang1 = atan2(y1-YCP,x1-XCP); ang2 = atan2(y2-YCP,x2-XCP); if(ang1>ang2)return 1; return -1; } void prodvec (double *a , double *b , double *c) { c[0] = a[1]*b[2]-a[2]*b[1]; c[1] = a[2]*b[0]-a[0]*b[2]; c[2] = a[0]*b[1]-a[1]*b[0]; } void normvec(double *a) { double mod; mod = sqrt(SQU(a[0])+SQU(a[1])+SQU(a[2])); a[0]/=mod; a[1]/=mod; a[2]/=mod; } #define NBR_MAX_CUT 10 #define LETS_PRINT_THE_RESULT \ List_Reset(PE_L); \ if(PSO_P->Depth < 2) \ List_Add(PE_L, &PE) ; \ else \ Cut_PostElement(PE, Element.GeoElement, PE_L, PE->Index, \ PSO_P->Depth, 0, 1) ; \ for(iPost = 0 ; iPost < List_Nbr(PE_L) ; iPost++){ \ PE = *(struct PostElement **)List_Pointer(PE_L, iPost) ; \ for(iTime = 0 ; iTime < NbTimeStep ; iTime++){ \ Pos_InitAllSolutions(PSO_P->TimeStep_L, iTime) ; \ for(iNode = 0 ; iNode < PE->NbrNodes ; iNode++){ \ if(NCPQ_P){ \ Current.x = PE->x[iNode] ; \ Current.y = PE->y[iNode] ; \ Current.z = PE->z[iNode] ; \ Cal_PostQuantity(NCPQ_P, DefineQuantity_P0, QuantityStorage_P0, \ NULL, &Element, PE->u[iNode], PE->v[iNode], PE->w[iNode], \ &PE->Value[iNode]); \ if(CPQ_P) \ Combine_PostQuantity(PSO_P->CombinationType, Order, \ &PE->Value[iNode], &CumulativeValues[iTime]) ; \ } \ else \ Cal_CopyValue(&CumulativeValues[iTime],&PE->Value[iNode]); \ } \ Format_PostElement(PSO_P, PSO_P->Iso,0, \ Current.Time, iTime, NbTimeStep, \ Current.NbrHar, PSO_P->HarmonicToTime, \ NULL, PE); \ } \ } \ for(iPost = 0 ; iPost < List_Nbr(PE_L) ; iPost++) \ Destroy_PostElement(*(struct PostElement **)List_Pointer(PE_L, iPost)); void Pos_PrintOnSection(struct PostQuantity *NCPQ_P, struct PostQuantity *CPQ_P, int Order, struct DefineQuantity *DefineQuantity_P0, struct QuantityStorage *QuantityStorage_P0, struct PostSubOperation *PSO_P) { struct CutEdge e[NBR_MAX_CUT]; struct Element Element ; struct PostElement * PE ; struct Value * CumulativeValues ; List_T * PE_L ; int NbGeoElement, NbTimeStep, NbCut, * NumNodes ; int iPost, iNode, iGeo, iCut, iEdge, iTime ; double A, B, C, D, d1, d2, u, xcg, ycg, zcg ; double x[3], y[3], z[3] ; NbTimeStep = Pos_InitTimeSteps(PSO_P); PE_L = List_Create(10, 10, sizeof(struct PostElement *)) ; for(iCut = 0 ; iCut < NBR_MAX_CUT ; iCut++) e[iCut].Value = (struct Value*) Malloc(NbTimeStep*sizeof(struct Value)) ; Format_PostHeader(PSO_P, NbTimeStep, Order, PSO_P->Label ? PSO_P->Label : (NCPQ_P ? NCPQ_P->Name : NULL), PSO_P->Label ? NULL : (CPQ_P ? CPQ_P->Name : NULL)); if(CPQ_P){ Cal_PostCumulativeQuantity(NULL, PSO_P->PostQuantitySupport[Order], PSO_P->TimeStep_L, CPQ_P, DefineQuantity_P0, QuantityStorage_P0, &CumulativeValues); } switch(PSO_P->SubType) { case PRINT_ONSECTION_1D : Message::Error("Print on 1D cuts not done (use Print OnLine instead)"); break; case PRINT_ONSECTION_2D : /* Ax+By+Cz+D=0 from (x0,y0,z0),(x1,y1,z1),(x2,y2,z2) */ x[0] = PSO_P->Case.OnSection.x[0] ; y[0] = PSO_P->Case.OnSection.y[0] ; z[0] = PSO_P->Case.OnSection.z[0] ; x[1] = PSO_P->Case.OnSection.x[1] ; y[1] = PSO_P->Case.OnSection.y[1] ; z[1] = PSO_P->Case.OnSection.z[1] ; x[2] = PSO_P->Case.OnSection.x[2] ; y[2] = PSO_P->Case.OnSection.y[2] ; z[2] = PSO_P->Case.OnSection.z[2] ; A = (y[1]-y[0])*(z[2]-z[0]) - (z[1]-z[0])*(y[2]-y[0]) ; B = -(x[1]-x[0])*(z[2]-z[0]) + (z[1]-z[0])*(x[2]-x[0]) ; C = (x[1]-x[0])*(y[2]-y[0]) - (y[1]-y[0])*(x[2]-x[0]) ; D = -A*x[0]-B*y[0]-C*z[0] ; /* Cut each element */ NbGeoElement = Geo_GetNbrGeoElements() ; Message::ResetProgressMeter(); for(iGeo = 0 ; iGeo < NbGeoElement ; iGeo++) { Element.GeoElement = Geo_GetGeoElement(iGeo) ; Element.Num = Element.GeoElement->Num ; Element.Type = Element.GeoElement->Type ; Current.Region = Element.Region = Element.GeoElement->Region ; if((PSO_P->Dimension == _ALL && (Element.GeoElement->Type != POINT)) || (PSO_P->Dimension == _3D && (Element.GeoElement->Type & (TETRAHEDRON|HEXAHEDRON|PRISM|PYRAMID))) || (PSO_P->Dimension == _2D && (Element.GeoElement->Type & (TRIANGLE|QUADRANGLE))) || (PSO_P->Dimension == _1D && (Element.GeoElement->Type & LINE))){ Get_NodesCoordinatesOfElement(&Element) ; if(Element.GeoElement->NbrEdges == 0) Geo_CreateEdgesOfElement(Element.GeoElement) ; NbCut = 0; for(iEdge = 0 ; iEdge < Element.GeoElement->NbrEdges ; iEdge++){ NumNodes = Geo_GetNodesOfEdgeInElement(Element.GeoElement, iEdge) ; e[NbCut].x[0] = Element.x[abs(NumNodes[0])-1] ; e[NbCut].y[0] = Element.y[abs(NumNodes[0])-1] ; e[NbCut].z[0] = Element.z[abs(NumNodes[0])-1] ; e[NbCut].x[1] = Element.x[abs(NumNodes[1])-1] ; e[NbCut].y[1] = Element.y[abs(NumNodes[1])-1] ; e[NbCut].z[1] = Element.z[abs(NumNodes[1])-1] ; d1 = Plane(A,B,C,D,e[NbCut].x[0],e[NbCut].y[0],e[NbCut].z[0]); d2 = Plane(A,B,C,D,e[NbCut].x[1],e[NbCut].y[1],e[NbCut].z[1]); if(d1*d2 <= 0) { if(d1*d2 < 0.) u = -d2/(d1-d2) ; else if(d1 == 0.) u = 1. ; else u = 0. ; e[NbCut].xc = u*e[NbCut].x[0] + (1.-u)*e[NbCut].x[1]; e[NbCut].yc = u*e[NbCut].y[0] + (1.-u)*e[NbCut].y[1]; e[NbCut].zc = u*e[NbCut].z[0] + (1.-u)*e[NbCut].z[1]; if(NCPQ_P) xyz2uvwInAnElement(&Element, e[NbCut].xc, e[NbCut].yc, e[NbCut].zc, &e[NbCut].uc, &e[NbCut].vc, &e[NbCut].wc); NbCut++; } } if(NbCut > 3){ xcg = ycg = zcg = 0.; for(iCut = 0 ; iCut < NbCut ; iCut++){ xcg += e[iCut].xc; ycg += e[iCut].yc; zcg += e[iCut].zc; } xcg /= (double)NbCut; ycg /= (double)NbCut; zcg /= (double)NbCut; DIRZ[0] = A; DIRY[0] = xcg-e[0].xc; DIRZ[1] = B; DIRY[1] = ycg-e[0].yc; DIRZ[2] = C; DIRY[2] = zcg-e[0].zc; normvec(DIRZ); normvec(DIRY); prodvec(DIRY,DIRZ,DIRX); normvec(DIRX); XCP = xcg*DIRX[0] + ycg*DIRX[1] + zcg*DIRX[2]; YCP = xcg*DIRY[0] + ycg*DIRY[1] + zcg*DIRY[2]; qsort(e,NbCut,sizeof(struct CutEdge), fcmp_Angle); } if(NbCut > 2){ iCut = 2; while(iCut < NbCut){ if(PSO_P->Depth > 0){ PE = Create_PostElement(iGeo, TRIANGLE, 3, 1) ; PE->x[0] = e[0].xc; PE->x[1] = e[iCut-1].xc; PE->x[2] = e[iCut].xc; PE->y[0] = e[0].yc; PE->y[1] = e[iCut-1].yc; PE->y[2] = e[iCut].yc; PE->z[0] = e[0].zc; PE->z[1] = e[iCut-1].zc; PE->z[2] = e[iCut].zc; PE->u[0] = e[0].uc; PE->u[1] = e[iCut-1].uc; PE->u[2] = e[iCut].uc; PE->v[0] = e[0].vc; PE->v[1] = e[iCut-1].vc; PE->v[2] = e[iCut].vc; PE->w[0] = e[0].wc; PE->w[1] = e[iCut-1].wc; PE->w[2] = e[iCut].wc; LETS_PRINT_THE_RESULT ; } else{ PE = Create_PostElement(iGeo, POINT, 1, 0) ; PE->x[0] = (e[0].xc + e[iCut-1].xc + e[iCut].xc) / 3. ; PE->y[0] = (e[0].yc + e[iCut-1].yc + e[iCut].yc) / 3. ; PE->z[0] = (e[0].zc + e[iCut-1].zc + e[iCut].zc) / 3. ; PE->u[0] = (e[0].uc + e[iCut-1].uc + e[iCut].uc) / 3. ; PE->v[0] = (e[0].vc + e[iCut-1].vc + e[iCut].vc) / 3. ; PE->w[0] = (e[0].wc + e[iCut-1].wc + e[iCut].wc) / 3. ; LETS_PRINT_THE_RESULT ; } iCut++; } } if(NbCut == 2){ if(PSO_P->Depth > 0){ PE = Create_PostElement(iGeo, LINE, 2, 1) ; PE->x[0] = e[0].xc; PE->x[1] = e[1].xc; PE->y[0] = e[0].yc; PE->y[1] = e[1].yc; PE->z[0] = e[0].zc; PE->z[1] = e[1].zc; PE->u[0] = e[0].uc; PE->u[1] = e[1].uc; PE->v[0] = e[0].vc; PE->v[1] = e[1].vc; PE->w[0] = e[0].wc; PE->w[1] = e[1].wc; LETS_PRINT_THE_RESULT ; } else{ PE = Create_PostElement(iGeo, POINT, 1, 0) ; PE->x[0] = (e[0].xc + e[1].xc) / 2. ; PE->y[0] = (e[0].yc + e[1].yc) / 2. ; PE->z[0] = (e[0].zc + e[1].zc) / 2. ; PE->u[0] = (e[0].uc + e[1].uc) / 2. ; PE->v[0] = (e[0].vc + e[1].vc) / 2. ; PE->w[0] = (e[0].wc + e[1].wc) / 2. ; LETS_PRINT_THE_RESULT ; } } } Message::ProgressMeter(iGeo + 1, NbGeoElement, "Post-processing (Cut)") ; if(Message::GetErrorCount()) break; } Format_PostFooter(PSO_P, 0); break; default : Message::Error("Unknown operation in Print OnSection"); break; } List_Delete(PE_L) ; if(CPQ_P) Free(CumulativeValues); for(iCut = 0 ; iCut < NBR_MAX_CUT ; iCut++) Free(e[iCut].Value) ; } #undef NBR_MAX_CUT #undef LETS_PRINT_THE_RESULT /* ------------------------------------------------------------------------ */ /* P o s _ P r i n t O n G r i d */ /* ------------------------------------------------------------------------ */ #define LETS_PRINT_THE_RESULT \ PE->x[0] = Current.xp = Current.x ; \ PE->y[0] = Current.yp = Current.y ; \ PE->z[0] = Current.zp = Current.z ; \ if(!NCPQ_P){ \ for (ts = 0 ; ts < NbTimeStep ; ts++){ \ PE->Value[0] = CumulativeValues[ts] ; \ Format_PostElement(PSO_P, PSO_P->Iso, 0, \ Current.Time, ts, NbTimeStep, \ Current.NbrHar, PSO_P->HarmonicToTime, \ Normal, PE); \ } \ } \ else{ \ InWhichElement(&Current.GeoData->Grid, NULL, &Element, PSO_P->Dimension, \ Current.x, Current.y, Current.z, &u, &v, &w) ; \ Current.Region = Element.Region ; \ if(Element.Num != NO_ELEMENT) \ PE->Index = Geo_GetGeoElementIndex(Element.GeoElement) ; \ else \ PE->Index = NO_ELEMENT ; \ for (ts = 0 ; ts < NbTimeStep ; ts++) { \ Pos_InitAllSolutions(PSO_P->TimeStep_L, ts) ; \ Cal_PostQuantity(NCPQ_P, DefineQuantity_P0, QuantityStorage_P0, \ NULL, &Element, u, v, w, &PE->Value[0]); \ if(CPQ_P) \ Combine_PostQuantity(PSO_P->CombinationType, Order, \ &PE->Value[0], &CumulativeValues[ts]) ; \ Format_PostElement(PSO_P, PSO_P->Iso, 0, \ Current.Time, ts, NbTimeStep, \ Current.NbrHar, PSO_P->HarmonicToTime, \ Normal, PE); \ } \ } #define ARRAY(i,j,k,t) \ Array[ (t) * Current.NbrHar * ((int)N[0]+1) * ((int)N[1]+1) + \ (k) * ((int)N[0]+1) * ((int)N[1]+1) + \ (j) * ((int)N[0]+1) + \ (i) ] #define LETS_STORE_THE_RESULT \ if(!NCPQ_P){ \ if(CumulativeValues[0].Type != SCALAR) \ Message::Error("Print OnPlane not designed for non scalars with Depth > 1"); \ else \ for (ts = 0 ; ts < NbTimeStep ; ts++) \ for(k = 0 ; k < Current.NbrHar ; k++) \ ARRAY(i1,i2,k,ts) = (float)CumulativeValues[ts].Val[MAX_DIM*k] ; \ } \ else{ \ InWhichElement(&Current.GeoData->Grid, NULL, &Element, PSO_P->Dimension, \ Current.x, Current.y, Current.z, &u, &v, &w) ; \ Current.Region = Element.Region ; \ for (ts = 0 ; ts < NbTimeStep ; ts++) { \ Pos_InitAllSolutions(PSO_P->TimeStep_L, ts) ; \ Cal_PostQuantity(NCPQ_P, DefineQuantity_P0, QuantityStorage_P0, \ NULL, &Element, u, v, w, &PE->Value[0]); \ if(PE->Value[0].Type != SCALAR) \ Message::Error("Print OnPlane not designed for non scalars with Depth > 1"); \ if(CPQ_P) \ Combine_PostQuantity(PSO_P->CombinationType, Order, \ &PE->Value[0], &CumulativeValues[ts]) ; \ for(k = 0 ; k < Current.NbrHar ; k++) \ ARRAY(i1,i2,k,ts) = (float)PE->Value[0].Val[MAX_DIM*k] ; \ } \ } void Pos_PrintOnGrid(struct PostQuantity *NCPQ_P, struct PostQuantity *CPQ_P, int Order, struct DefineQuantity *DefineQuantity_P0, struct QuantityStorage *QuantityStorage_P0, struct PostSubOperation *PSO_P) { struct Element Element ; struct Value * CumulativeValues, Value ; struct PostElement * PE , * PE2 ; int i1, i2, i3, k, NbTimeStep, ts ; float *Array = NULL ; double u, v, w, Length, Normal[4] = {0., 0., 0., 0.} ; double X[4], Y[4], Z[4], S[4], N[4], tmp[3]; Get_InitDofOfElement(&Element) ; NbTimeStep = Pos_InitTimeSteps(PSO_P); if(CPQ_P){ Cal_PostCumulativeQuantity(NULL, PSO_P->PostQuantitySupport[Order], PSO_P->TimeStep_L, CPQ_P, DefineQuantity_P0, QuantityStorage_P0, &CumulativeValues); } Format_PostHeader(PSO_P, NbTimeStep, Order, PSO_P->Label ? PSO_P->Label : (NCPQ_P ? NCPQ_P->Name : NULL), PSO_P->Label ? NULL : (CPQ_P ? CPQ_P->Name : NULL)); PE = Create_PostElement(0, POINT, 1, 0) ; switch(PSO_P->SubType) { case PRINT_ONGRID_0D : Current.x = PSO_P->Case.OnGrid.x[0] ; Current.y = PSO_P->Case.OnGrid.y[0] ; Current.z = PSO_P->Case.OnGrid.z[0] ; Normal[0] = Normal[1] = Normal[2] = 0.0 ; LETS_PRINT_THE_RESULT ; if (PSO_P->StoreInRegister >= 0) Cal_StoreInRegister(&PE->Value[0], PSO_P->StoreInRegister) ; if (PSO_P->StoreInVariable) Cal_StoreInVariable(&PE->Value[0], PSO_P->StoreInVariable) ; break; case PRINT_ONGRID_1D : X[0] = PSO_P->Case.OnGrid.x[0] ; X[1] = PSO_P->Case.OnGrid.x[1] ; Y[0] = PSO_P->Case.OnGrid.y[0] ; Y[1] = PSO_P->Case.OnGrid.y[1] ; Z[0] = PSO_P->Case.OnGrid.z[0] ; Z[1] = PSO_P->Case.OnGrid.z[1] ; N[0] = PSO_P->Case.OnGrid.n[0] ; Normal[1] = Normal[2] = 0.0 ; Length = sqrt(SQU(X[1]-X[0]) + SQU(Y[1]-Y[0]) + SQU(Z[1]-Z[0])) ; for (i1 = 0 ; i1 <= N[0] ; i1++) { S[0] = (double)i1 / (double)(N[0] ? N[0] : 1) ; Normal[0] = Length * S[0] ; Current.x = X[0] + (X[1] - X[0]) * S[0] ; Current.y = Y[0] + (Y[1] - Y[0]) * S[0] ; Current.z = Z[0] + (Z[1] - Z[0]) * S[0] ; LETS_PRINT_THE_RESULT ; } break; case PRINT_ONGRID_2D : X[0] = PSO_P->Case.OnGrid.x[0] ; X[1] = PSO_P->Case.OnGrid.x[1] ; Y[0] = PSO_P->Case.OnGrid.y[0] ; Y[1] = PSO_P->Case.OnGrid.y[1] ; Z[0] = PSO_P->Case.OnGrid.z[0] ; Z[1] = PSO_P->Case.OnGrid.z[1] ; X[2] = PSO_P->Case.OnGrid.x[2] ; Y[2] = PSO_P->Case.OnGrid.y[2] ; Z[2] = PSO_P->Case.OnGrid.z[2] ; S[0] = X[1]-X[0]; S[1] = Y[1]-Y[0]; S[2] = Z[1]-Z[0]; N[0] = X[2]-X[0]; N[1] = Y[2]-Y[0]; N[2] = Z[2]-Z[0]; prodvec(S,N,Normal); Length = sqrt(SQU(Normal[0])+SQU(Normal[1])+SQU(Normal[2])); if(!Length){ Message::Warning("Bad plane (null normal)"); return ; } Normal[0]/=Length ; Normal[1]/=Length ; Normal[2]/=Length ; N[0] = PSO_P->Case.OnGrid.n[0] ; N[1] = PSO_P->Case.OnGrid.n[1] ; if(PSO_P->Depth > 1) Array = (float*) Malloc(NbTimeStep*Current.NbrHar*(int)((N[0]+1)*(N[1]+1))*sizeof(float)) ; for (i1 = 0 ; i1 <= N[0] ; i1++) { S[0] = (double)i1 / (double)(N[0] ? N[0] : 1) ; for (i2 = 0 ; i2 <= N[1] ; i2++) { S[1] = (double)i2 / (double)(N[1] ? N[1] : 1) ; Current.x = X[0] + (X[1] - X[0]) * S[0] + (X[2] - X[0]) * S[1] ; Current.y = Y[0] + (Y[1] - Y[0]) * S[0] + (Y[2] - Y[0]) * S[1] ; Current.z = Z[0] + (Z[1] - Z[0]) * S[0] + (Z[2] - Z[0]) * S[1] ; if(PSO_P->Depth > 1){ LETS_STORE_THE_RESULT ; } else{ LETS_PRINT_THE_RESULT ; } } if(PostStream && PSO_P->Depth < 2 && !Flag_BIN) fprintf(PostStream, "\n"); } if(PSO_P->Depth > 1){ PE2 = Create_PostElement(0, TRIANGLE, 3, 0); PE2->Value[0].Type = PE2->Value[1].Type = PE2->Value[2].Type = SCALAR ; for (i1 = 0 ; i1 < N[0] ; i1++) { S[0] = (double)i1 / (double)(N[0] ? N[0] : 1) ; S[2] = (double)(i1+1) / (double)(N[0] ? N[0] : 1) ; for (i2 = 0 ; i2 < N[1] ; i2++) { S[1] = (double)i2 / (double)(N[1] ? N[1] : 1) ; S[3] = (double)(i2+1) / (double)(N[1] ? N[1] : 1) ; PE2->x[0] = X[0] + (X[1] - X[0]) * S[0] + (X[2] - X[0]) * S[1] ; PE2->y[0] = Y[0] + (Y[1] - Y[0]) * S[0] + (Y[2] - Y[0]) * S[1] ; PE2->z[0] = Z[0] + (Z[1] - Z[0]) * S[0] + (Z[2] - Z[0]) * S[1] ; PE2->x[1] = X[0] + (X[1] - X[0]) * S[2] + (X[2] - X[0]) * S[1] ; PE2->y[1] = Y[0] + (Y[1] - Y[0]) * S[2] + (Y[2] - Y[0]) * S[1] ; PE2->z[1] = Z[0] + (Z[1] - Z[0]) * S[2] + (Z[2] - Z[0]) * S[1] ; PE2->x[2] = X[0] + (X[1] - X[0]) * S[0] + (X[2] - X[0]) * S[3] ; PE2->y[2] = Y[0] + (Y[1] - Y[0]) * S[0] + (Y[2] - Y[0]) * S[3] ; PE2->z[2] = Z[0] + (Z[1] - Z[0]) * S[0] + (Z[2] - Z[0]) * S[3] ; for (ts = 0 ; ts < NbTimeStep ; ts++){ for(k = 0 ; k < Current.NbrHar ; k++){ PE2->Value[0].Val[MAX_DIM*k] = ARRAY(i1,i2,k,ts) ; PE2->Value[1].Val[MAX_DIM*k] = ARRAY(i1+1,i2,k,ts) ; PE2->Value[2].Val[MAX_DIM*k] = ARRAY(i1,i2+1,k,ts) ; } Format_PostElement(PSO_P, PSO_P->Iso, 0, Current.Time, ts, NbTimeStep, Current.NbrHar, PSO_P->HarmonicToTime, Normal, PE2); } PE2->x[0] = X[0] + (X[1] - X[0]) * S[2] + (X[2] - X[0]) * S[3] ; PE2->y[0] = Y[0] + (Y[1] - Y[0]) * S[2] + (Y[2] - Y[0]) * S[3] ; PE2->z[0] = Z[0] + (Z[1] - Z[0]) * S[2] + (Z[2] - Z[0]) * S[3] ; tmp[0] = PE2->x[1]; PE2->x[1] = PE2->x[2]; PE2->x[2] = tmp[0]; tmp[1] = PE2->y[1]; PE2->y[1] = PE2->y[2]; PE2->y[2] = tmp[1]; tmp[2] = PE2->z[1]; PE2->z[1] = PE2->z[2]; PE2->z[2] = tmp[2]; for (ts = 0 ; ts < NbTimeStep ; ts++){ for(k = 0 ; k < Current.NbrHar ; k++){ PE2->Value[0].Val[MAX_DIM*k] = ARRAY(i1+1,i2+1,k,ts) ; PE2->Value[1].Val[MAX_DIM*k] = ARRAY(i1,i2+1,k,ts) ; PE2->Value[2].Val[MAX_DIM*k] = ARRAY(i1+1,i2,k,ts) ; } Format_PostElement(PSO_P, PSO_P->Iso, 0, Current.Time, ts, NbTimeStep, Current.NbrHar, PSO_P->HarmonicToTime, Normal, PE2); } } } Destroy_PostElement(PE2) ; Free(Array) ; } break; case PRINT_ONGRID_3D : X[0] = PSO_P->Case.OnGrid.x[0] ; X[1] = PSO_P->Case.OnGrid.x[1] ; Y[0] = PSO_P->Case.OnGrid.y[0] ; Y[1] = PSO_P->Case.OnGrid.y[1] ; Z[0] = PSO_P->Case.OnGrid.z[0] ; Z[1] = PSO_P->Case.OnGrid.z[1] ; X[2] = PSO_P->Case.OnGrid.x[2] ; X[3] = PSO_P->Case.OnGrid.x[3] ; Y[2] = PSO_P->Case.OnGrid.y[2] ; Y[3] = PSO_P->Case.OnGrid.y[3] ; Z[2] = PSO_P->Case.OnGrid.z[2] ; Z[3] = PSO_P->Case.OnGrid.z[3] ; N[0] = PSO_P->Case.OnGrid.n[0] ; N[1] = PSO_P->Case.OnGrid.n[1] ; N[2] = PSO_P->Case.OnGrid.n[2] ; Normal[0] = Normal[1] = Normal[2] = 0.0 ; for (i1 = 0 ; i1 <= N[0] ; i1++) { S[0] = (double)i1 / (double)(N[0] ? N[0] : 1) ; for (i2 = 0 ; i2 <= N[1] ; i2++) { S[1] = (double)i2 / (double)(N[1] ? N[1] : 1) ; for (i3 = 0 ; i3 <= N[2] ; i3++) { S[2] = (double)i3 / (double)(N[2] ? N[2] : 1) ; Current.x = X[0] + (X[1]-X[0])*S[0] + (X[2]-X[0])*S[1] + (X[3]-X[0])*S[2] ; Current.y = Y[0] + (Y[1]-Y[0])*S[0] + (Y[2]-Y[0])*S[1] + (Y[3]-Y[0])*S[2] ; Current.z = Z[0] + (Z[1]-Z[0])*S[0] + (Z[2]-Z[0])*S[1] + (Z[3]-Z[0])*S[2] ; LETS_PRINT_THE_RESULT ; } if(PostStream && !Flag_BIN) fprintf(PostStream, "\n"); } if(PostStream && !Flag_BIN) fprintf(PostStream, "\n\n"); /* two blanks lines for -index in gnuplot */ } break; case PRINT_ONGRID_PARAM : for (i1 = 0 ; i1 < List_Nbr(PSO_P->Case.OnParamGrid.ParameterValue[0]) ; i1++) { List_Read(PSO_P->Case.OnParamGrid.ParameterValue[0], i1, &Current.a) ; for (i2 = 0 ; i2 < List_Nbr(PSO_P->Case.OnParamGrid.ParameterValue[1]) ; i2++) { List_Read(PSO_P->Case.OnParamGrid.ParameterValue[1], i2, &Current.b) ; for (i3 = 0 ; i3 < List_Nbr(PSO_P->Case.OnParamGrid.ParameterValue[2]) ; i3++) { List_Read(PSO_P->Case.OnParamGrid.ParameterValue[2], i3, &Current.c) ; Get_ValueOfExpressionByIndex(PSO_P->Case.OnParamGrid.ExpressionIndex[0], NULL, 0., 0., 0., &Value) ; Current.x = Value.Val[0]; Get_ValueOfExpressionByIndex(PSO_P->Case.OnParamGrid.ExpressionIndex[1], NULL, 0., 0., 0., &Value) ; Current.y = Value.Val[0]; Get_ValueOfExpressionByIndex(PSO_P->Case.OnParamGrid.ExpressionIndex[2], NULL, 0., 0., 0., &Value) ; Current.z = Value.Val[0]; Normal[0] = Current.a ; Normal[1] = Current.b ; Normal[2] = Current.c ; LETS_PRINT_THE_RESULT ; } if(PostStream && List_Nbr(PSO_P->Case.OnParamGrid.ParameterValue[2])>1 && !Flag_BIN) fprintf(PostStream, "\n"); } if(PostStream && List_Nbr(PSO_P->Case.OnParamGrid.ParameterValue[1])>1 && !Flag_BIN) fprintf(PostStream, "\n\n"); /* two blanks lines for -index in gnuplot */ } break; } Destroy_PostElement(PE) ; Format_PostFooter(PSO_P, 0); if(CPQ_P) Free(CumulativeValues); } #undef LETS_PRINT_THE_RESULT #undef LETS_STORE_THE_RESULT #undef ARRAY /* ------------------------------------------------------------------------ */ /* P o s _ P r i n t O n R e g i o n */ /* ------------------------------------------------------------------------ */ void Pos_PrintOnRegion(struct PostQuantity *NCPQ_P, struct PostQuantity *CPQ_P, int Order, struct DefineQuantity *DefineQuantity_P0, struct QuantityStorage *QuantityStorage_P0, struct PostSubOperation *PSO_P) { struct Element Element ; struct Value Value, ValueSummed ; struct PostQuantity *PQ_P ; struct Group * Group_P ; List_T *Region_L, *Support_L ; int i, iTime, NbrTimeStep ; int Nbr_Region=0, Num_Region, Group_FunctionType ; int Type_Evaluation=0; double u, v, w; NbrTimeStep = Pos_InitTimeSteps(PSO_P); if (CPQ_P && NCPQ_P){ Message::Error("Only one PostProcessing Quantity allowed in PostOperation") ; return; } if (CPQ_P) { PQ_P = CPQ_P ; Support_L = /* for e.g. PQ[ Support ] ... */ ((struct Group *) List_Pointer(Problem_S.Group, PSO_P->PostQuantitySupport[Order]))->InitialList ; } else { PQ_P = NCPQ_P ; Support_L = NULL ; } Format_PostHeader(PSO_P, NbrTimeStep, Order, PSO_P->Label ? PSO_P->Label : (NCPQ_P ? NCPQ_P->Name : NULL), PSO_P->Label ? NULL : (CPQ_P ? CPQ_P->Name : NULL)); Group_P = (PSO_P->Case.OnRegion.RegionIndex < 0)? NULL : (struct Group *) List_Pointer(Problem_S.Group, PSO_P->Case.OnRegion.RegionIndex); Region_L = Group_P? Group_P->InitialList : NULL ; Group_FunctionType = Group_P? Group_P->FunctionType : REGION; if (!Support_L && List_Nbr(NCPQ_P->PostQuantityTerm) && ( ((struct PostQuantityTerm *)List_Pointer(NCPQ_P->PostQuantityTerm, 0)) ->Type == LOCALQUANTITY && ((struct PostQuantityTerm *)List_Pointer(NCPQ_P->PostQuantityTerm, 0)) ->EvaluationType == LOCAL) ) { if (Group_FunctionType == REGION){ Message::Error("Print OnRegion not valid for PostProcessing Quantity '%s'", NCPQ_P->Name); return; } else Type_Evaluation = LOCAL; } else Type_Evaluation = GLOBAL; if (Region_L) { if (Group_P->FunctionType == REGION) { List_Sort(Region_L, fcmp_int) ; Nbr_Region = List_Nbr(Region_L) ; if (!PSO_P->NoTitle && PSO_P->Format != FORMAT_SPACE_TABLE && PSO_P->Format != FORMAT_VALUE_ONLY) { std::ostringstream sstream; if (PSO_P->Format == FORMAT_GMSH) sstream << "// "; else sstream << "# "; sstream << PQ_P->Name << " on"; for(i = 0 ; i < Nbr_Region ; i++) { List_Read(Region_L, i, &Num_Region) ; sstream << " " << Num_Region; } if(PostStream == stdout || PostStream == stderr) Message::Direct(sstream.str().c_str()); else if(PostStream) fprintf(PostStream, "%s\n", sstream.str().c_str()) ; } } else if (Group_P->FunctionType == NODESOF) { if (!Group_P->ExtendedList) Generate_ExtendedGroup(Group_P) ; Region_L = Group_P->ExtendedList ; /* Attention: new Region_L */ Nbr_Region = List_Nbr(Region_L) ; } else { Message::Error("Function type (%d) not allowed for PrintOnRegion", Group_P->FunctionType) ; return; } } else Nbr_Region = 1 ; for (iTime = 0 ; iTime < NbrTimeStep ; iTime++) { Pos_InitAllSolutions(PSO_P->TimeStep_L, iTime) ; if (PSO_P->Format == FORMAT_REGION_VALUE) { Cal_ZeroValue(&ValueSummed) ; } if(Nbr_Region > 1) Message::ResetProgressMeter(); for(i = 0 ; i < Nbr_Region ; i++) { if (Region_L) List_Read(Region_L, i, &Num_Region) ; else Num_Region = NO_REGION ; Current.SubRegion = Num_Region ; /* Region being a GlobalQuantity Entity no */ Current.NumEntity = Num_Region ; /* for OnRegion NodesOf */ Element.GeoElement = NULL ; Element.Num = NO_ELEMENT ; Element.Type = -1 ; Current.Region = Element.Region = Num_Region ; Current.x = Current.y = Current.z = 0. ; if (Type_Evaluation == GLOBAL) { Cal_PostQuantity(PQ_P, DefineQuantity_P0, QuantityStorage_P0, Support_L, &Element, 0., 0., 0., &Value) ; } else { if (Group_FunctionType == NODESOF) Geo_GetNodesCoordinates(1, &Num_Region, &Current.x, &Current.y, &Current.z) ; InWhichElement(&Current.GeoData->Grid, NULL, &Element, PSO_P->Dimension, Current.x, Current.y, Current.z, &u, &v, &w) ; Cal_PostQuantity(PQ_P, DefineQuantity_P0, QuantityStorage_P0, Support_L, &Element, u, v, w, &Value) ; } if (PSO_P->Format != FORMAT_REGION_VALUE) { if (PSO_P->StoreInRegister >= 0) Cal_StoreInRegister(&Value, PSO_P->StoreInRegister) ; if (PSO_P->StoreInVariable) Cal_StoreInVariable(&Value, PSO_P->StoreInVariable) ; if (PSO_P->SendToServer && strcmp(PSO_P->SendToServer, "No")){ if(Value.Type == SCALAR) Message::AddOnelabNumberChoice(PSO_P->SendToServer, Value.Val[0], PSO_P->Color); else if(Message::UseOnelab()) Message::Warning("Cannot send non-scalar values to server (yet)"); } } Format_PostValue(PSO_P->Format, PSO_P->Comma, Group_FunctionType, iTime, Current.Time, NbrTimeStep, i, Current.NumEntity, Nbr_Region, Current.NbrHar, PSO_P->HarmonicToTime, PSO_P->FourierTransform, PSO_P->NoNewLine, &Value) ; if (PSO_P->Format == FORMAT_REGION_VALUE) { ValueSummed.Type = Value.Type ; Cal_AddValue(&ValueSummed, &Value, &ValueSummed); } if(Nbr_Region > 1) Message::ProgressMeter(i + 1, Nbr_Region, "Post-processing (OnRegion)"); } if (PostStream && PSO_P->Format == FORMAT_REGION_VALUE) { fprintf(PostStream, "%s", Print_Value_ToString(&ValueSummed).c_str()); if (PSO_P->StoreInRegister >= 0) Cal_StoreInRegister(&ValueSummed, PSO_P->StoreInRegister) ; if (PSO_P->StoreInVariable) Cal_StoreInVariable(&ValueSummed, PSO_P->StoreInVariable) ; if (PSO_P->SendToServer && strcmp(PSO_P->SendToServer, "No")){ if(Value.Type == SCALAR) Message::AddOnelabNumberChoice(PSO_P->SendToServer, ValueSummed.Val[0], PSO_P->Color); else if(Message::UseOnelab()) Message::Warning("Cannot send non-scalar values to server (yet)"); } } } Format_PostFooter(PSO_P, 0); } /* ------------------------------------------------------------------------ */ /* P o s _ P r i n t W i t h A r g u m e n t */ /* ------------------------------------------------------------------------ */ void Pos_PrintWithArgument(struct PostQuantity *NCPQ_P, struct PostQuantity *CPQ_P, int Order, struct DefineQuantity *DefineQuantity_P0, struct QuantityStorage *QuantityStorage_P0, struct PostSubOperation *PSO_P) { struct Element Element ; struct Value Value ; struct Expression * Expression_P ; List_T *Region_L ; int i, N, Num_Region ; double X[2], S, x ; if(CPQ_P){ Message::Error("Cumulative PostProcessing Quantity in PrintWithArgument not done") ; return; } X[0] = PSO_P->Case.WithArgument.x[0] ; X[1] = PSO_P->Case.WithArgument.x[1] ; N = PSO_P->Case.WithArgument.n ; Expression_P = (struct Expression *) List_Pointer(Problem_S.Expression, PSO_P->Case.WithArgument.ArgumentIndex) ; Region_L = ((struct Group *) List_Pointer(Problem_S.Group, PSO_P->Case.WithArgument.RegionIndex)) ->InitialList ; if (List_Nbr(Region_L)) List_Read(Region_L, 0, &Num_Region) ; else Num_Region = NO_REGION ; for (i = 0 ; i <= N ; i++) { S = (double)i / (double)(N ? N : 1) ; x = X[0] + (X[1] - X[0]) * S ; Expression_P->Case.Constant = x ; Element.GeoElement = NULL ; Element.Num = NO_ELEMENT ; Element.Type = -1 ; Current.Region = Element.Region = Num_Region ; Current.x = Current.y = Current.z = 0. ; Cal_PostQuantity(NCPQ_P, DefineQuantity_P0, QuantityStorage_P0, NULL, &Element, 0., 0., 0., &Value) ; Format_PostValue(PSO_P->Format, PSO_P->Comma, REGION, 0, x, 1, 0, 0, 1, Current.NbrHar, PSO_P->HarmonicToTime, PSO_P->FourierTransform, PSO_P->NoNewLine, &Value) ; } } /* ------------------------------------------------------------------------ */ /* P o s _ P r i n t E x p r e s s i o n */ /* ------------------------------------------------------------------------ */ void Pos_PrintExpression(struct PostSubOperation *PSO_P) { int NbrTimeStep, iTime; struct Value Value; char *str = PSO_P->Case.Expression.String; char *str2 = PSO_P->Case.Expression.String2; int expr = PSO_P->Case.Expression.ExpressionIndex; if((!str || !strlen(str)) && (!str2 || !strlen(str2)) && expr < 0) return; // nothing to print; useful to request merging an existing file if(!PostStream) return; NbrTimeStep = Pos_InitTimeSteps(PSO_P); for(iTime = 0; iTime < NbrTimeStep; iTime++){ Pos_InitAllSolutions(PSO_P->TimeStep_L, iTime) ; if(expr >= 0){ Get_ValueOfExpressionByIndex(expr, NULL, 0., 0., 0., &Value) ; if(str) fprintf(PostStream, "%s", str); fprintf(PostStream, "%s", Print_Value_ToString(&Value).c_str()); } else if(str2){ if(str) fprintf(PostStream, "%s", str); fprintf(PostStream, "%s", str2); } else if(str){ fprintf(PostStream, "%s", str); } if(PSO_P->NoNewLine) fprintf(PostStream, " ") ; else fprintf(PostStream, "\n") ; } } /* ------------------------------------------------------------------------ */ /* P o s _ P r i n t G r o u p */ /* ------------------------------------------------------------------------ */ void Pos_PrintGroup(struct PostSubOperation *PSO_P) { struct Group *Group_P; struct Geo_Element *GeoElement; struct PostElement *SL, *ST, *SQ; List_T *Region_L; int i, NbrGeo, iGeo, *NumNodes; double x [NBR_MAX_NODES_IN_ELEMENT] ; double y [NBR_MAX_NODES_IN_ELEMENT] ; double z [NBR_MAX_NODES_IN_ELEMENT] ; int numDofData, Code_BasisFunction, CodeExist = 0, k; struct Dof * Dof_P = NULL; double sizeEdge, Val_Dof, Val_Dof_i ; NbrGeo = Geo_GetNbrGeoElements() ; Format_PostHeader(PSO_P, 1, 0, PSO_P->Label, NULL); Region_L = ((struct Group *) List_Pointer(Problem_S.Group, PSO_P->Case.Group.GroupIndex))->InitialList ; Group_P = (struct Group *) List_Pointer(Problem_S.Group, PSO_P->Case.Group.ExtendedGroupIndex); SL = Create_PostElement(0, LINE, 2, 1) ; ST = Create_PostElement(0, TRIANGLE, 3, 1) ; SQ = Create_PostElement(0, QUADRANGLE, 4, 1) ; if(!Group_P->ExtendedList) Generate_ExtendedGroup(Group_P) ; Message::ResetProgressMeter(); for(iGeo = 0 ; iGeo < NbrGeo ; iGeo++) { GeoElement = Geo_GetGeoElement(iGeo) ; if(List_Search(Region_L, &GeoElement->Region, fcmp_int)){ Geo_GetNodesCoordinates (GeoElement->NbrNodes, GeoElement->NumNodes, x, y, z) ; switch (Group_P->FunctionType) { case EDGESOFTREEIN : if(!GeoElement->NbrEdges) Geo_CreateEdgesOfElement(GeoElement) ; for(i=0 ; iNbrEdges ; i++){ if(List_Search(Group_P->ExtendedList, &GeoElement->NumEdges[i], fcmp_absint)){ NumNodes = Geo_GetNodesOfEdgeInElement(GeoElement, i) ; SL->Index = iGeo; SL->x[0] = x[abs(NumNodes[0])-1]; SL->x[1] = x[abs(NumNodes[1])-1]; SL->y[0] = y[abs(NumNodes[0])-1]; SL->y[1] = y[abs(NumNodes[1])-1]; SL->z[0] = z[abs(NumNodes[0])-1]; SL->z[1] = z[abs(NumNodes[1])-1]; SL->Value[0].Type = SL->Value[1].Type = SCALAR ; SL->Value[0].Val[0] = SL->Value[1].Val[0] = GeoElement->NumEdges[i]; Format_PostElement(PSO_P, PSO_P->Iso, 0, 0, 0, 1, 1, 1, NULL, SL); } } break ; case EDGESOF : if(!GeoElement->NbrEdges) Geo_CreateEdgesOfElement(GeoElement) ; for(i=0 ; iNbrEdges ; i++){ NumNodes = Geo_GetNodesOfEdgeInElement(GeoElement, i) ; SL->Index = iGeo; SL->x[0] = x[abs(NumNodes[0])-1]; SL->x[1] = x[abs(NumNodes[1])-1]; SL->y[0] = y[abs(NumNodes[0])-1]; SL->y[1] = y[abs(NumNodes[1])-1]; SL->z[0] = z[abs(NumNodes[0])-1]; SL->z[1] = z[abs(NumNodes[1])-1]; SL->Value[0].Type = SL->Value[1].Type = SCALAR ; // SL->Value[0].Val[0] = SL->Value[1].Val[0] = fabs(GeoElement->NumEdges[i]); // Dof : type, num, 0 if (List_Nbr(PSO_P->Value_L)<2) Message::Error("Number of Values needed: 2"); numDofData = int(*(double*)List_Pointer(PSO_P->Value_L, 0)); Code_BasisFunction = int(*(double*)List_Pointer(PSO_P->Value_L, 1)); CodeExist = ((Dof_P = Dof_GetDofStruct(Current.DofData_P0+ numDofData, Code_BasisFunction, abs(GeoElement->NumEdges[i]), 0)) != NULL) ; if (CodeExist) { sizeEdge = sqrt( SQU(SL->x[1]-SL->x[0]) + SQU(SL->y[1]-SL->y[0]) + SQU(SL->z[1]-SL->z[0]) ); if(Current.NbrHar==1){ Dof_GetRealDofValue(Current.DofData_P0+ numDofData, Dof_P, &Val_Dof) ; Val_Dof = Val_Dof / sizeEdge ; SL->Value[0].Val[0] = SL->Value[1].Val[0] = Val_Dof; } else{ for (k = 0 ; k < Current.NbrHar ; k+=2) { Dof_GetComplexDofValue (Current.DofData_P0+ numDofData, Dof_P + k/2*gCOMPLEX_INCREMENT, &Val_Dof, &Val_Dof_i) ; Val_Dof = Val_Dof / sizeEdge ; Val_Dof_i = Val_Dof_i / sizeEdge ; SL->Value[0].Val[MAX_DIM*k ] = SL->Value[1].Val[MAX_DIM*k ] = Val_Dof; SL->Value[0].Val[MAX_DIM*(k+1)] = SL->Value[1].Val[MAX_DIM*(k+1)] = Val_Dof_i; } } Format_PostElement(PSO_P, PSO_P->Iso, 0, 0, 0, 1, Current.NbrHar, PSO_P->HarmonicToTime, NULL, SL); } } break ; case FACETSOFTREEIN : if(!GeoElement->NbrFacets) Geo_CreateFacetsOfElement(GeoElement) ; for(i=0 ; iNbrFacets ; i++){ if(List_Search(Group_P->ExtendedList, &GeoElement->NumFacets[i], fcmp_absint)){ NumNodes = Geo_GetNodesOfFacetInElement(GeoElement, i) ; if(!NumNodes[3]){ // we have triangle ST->Index = iGeo; ST->x[0] = x[abs(NumNodes[0])-1]; ST->x[1] = x[abs(NumNodes[1])-1]; ST->y[0] = y[abs(NumNodes[0])-1]; ST->y[1] = y[abs(NumNodes[1])-1]; ST->z[0] = z[abs(NumNodes[0])-1]; ST->z[1] = z[abs(NumNodes[1])-1]; ST->x[2] = x[abs(NumNodes[2])-1]; ST->y[2] = y[abs(NumNodes[2])-1]; ST->z[2] = z[abs(NumNodes[2])-1]; ST->Value[0].Type = ST->Value[1].Type = ST->Value[2].Type = SCALAR ; ST->Value[0].Val[0] = ST->Value[1].Val[0] = ST->Value[2].Val[0] = GeoElement->NumFacets[i]; Format_PostElement(PSO_P, PSO_P->Iso, 0, 0, 0, 1, 1, 1, NULL, ST); } else{ // we have a quad SQ->Index = iGeo; SQ->x[0] = x[abs(NumNodes[0])-1]; SQ->x[1] = x[abs(NumNodes[1])-1]; SQ->y[0] = y[abs(NumNodes[0])-1]; SQ->y[1] = y[abs(NumNodes[1])-1]; SQ->z[0] = z[abs(NumNodes[0])-1]; SQ->z[1] = z[abs(NumNodes[1])-1]; SQ->x[2] = x[abs(NumNodes[2])-1]; SQ->x[3] = x[abs(NumNodes[3])-1]; SQ->y[2] = y[abs(NumNodes[2])-1]; SQ->y[3] = y[abs(NumNodes[3])-1]; SQ->z[2] = z[abs(NumNodes[2])-1]; SQ->z[3] = z[abs(NumNodes[3])-1]; SQ->Value[0].Type = SQ->Value[1].Type = SQ->Value[2].Type = SQ->Value[3].Type = SCALAR ; SQ->Value[0].Val[0] = SQ->Value[1].Val[0] = SQ->Value[2].Val[0] = SQ->Value[3].Val[0] = GeoElement->NumFacets[i]; Format_PostElement(PSO_P, PSO_P->Iso, 0, 0, 0, 1, 1, 1, NULL, SQ); } } } break ; default : Message::Error("Print function not implemented for this kind of Group"); break ; } } Message::ProgressMeter(iGeo + 1, NbrGeo, "Post-processing (Compute)") ; if(Message::GetErrorCount()) break; } Destroy_PostElement(SL) ; Format_PostFooter(PSO_P, 0); } getdp-2.7.0-source/Legacy/F_Geometry.cpp000644 001750 001750 00000043434 12500032606 021553 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "ProData.h" #include "ProDefine.h" #include "GeoData.h" #include "DofData.h" #include "Get_Geometry.h" #include "F.h" #include "NumericUtils.h" #include "MallocUtils.h" #include "Message.h" #define SQU(a) ((a)*(a)) extern struct CurrentData Current ; void F_Normal(F_ARG) { int k ; if(!Current.Element || Current.Element->Num == NO_ELEMENT) Message::Error("No element on which to compute 'F_Normal'"); Geo_CreateNormal(Current.Element->Type, Current.Element->x, Current.Element->y, Current.Element->z, V->Val); if (Current.NbrHar != 1) { V->Val[MAX_DIM] = 0. ; V->Val[MAX_DIM+1] = 0. ; V->Val[MAX_DIM+2] = 0. ; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) { V->Val[MAX_DIM* k ] = V->Val[0] ; V->Val[MAX_DIM* k +1] = V->Val[1] ; V->Val[MAX_DIM* k +2] = V->Val[2] ; V->Val[MAX_DIM*(k+1) ] = 0. ; V->Val[MAX_DIM*(k+1)+1] = 0. ; V->Val[MAX_DIM*(k+1)+2] = 0. ; } } V->Type = VECTOR ; } void F_NormalSource(F_ARG) { int k ; if(!Current.ElementSource || Current.ElementSource->Num == NO_ELEMENT) Message::Error("No element on which to compute 'F_NormalSource'"); Geo_CreateNormal(Current.ElementSource->Type, Current.ElementSource->x, Current.ElementSource->y, Current.ElementSource->z, V->Val); if (Current.NbrHar != 1) { V->Val[MAX_DIM] = 0. ; V->Val[MAX_DIM+1] = 0. ; V->Val[MAX_DIM+2] = 0. ; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) { V->Val[MAX_DIM* k ] = V->Val[0] ; V->Val[MAX_DIM* k +1] = V->Val[1] ; V->Val[MAX_DIM* k +2] = V->Val[2] ; V->Val[MAX_DIM*(k+1) ] = 0. ; V->Val[MAX_DIM*(k+1)+1] = 0. ; V->Val[MAX_DIM*(k+1)+2] = 0. ; } } V->Type = VECTOR ; } void F_Tangent(F_ARG) { int k ; double tx, ty, tz, norm ; if(!Current.Element || Current.Element->Num == NO_ELEMENT) Message::Error("No element on which to compute 'F_Tangent'"); switch (Current.Element->Type) { case LINE : tx = Current.Element->x[1] - Current.Element->x[0] ; ty = Current.Element->y[1] - Current.Element->y[0] ; tz = Current.Element->z[1] - Current.Element->z[0] ; norm = sqrt(SQU(tx)+SQU(ty)+SQU(tz)) ; V->Val[0] = tx/norm ; V->Val[1] = ty/norm ; V->Val[2] = tz/norm ; break ; default : Message::Error("Function 'Tangent' only valid for Line Elements"); } if (Current.NbrHar != 1) { V->Val[MAX_DIM] = 0. ; V->Val[MAX_DIM+1] = 0. ; V->Val[MAX_DIM+2] = 0. ; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) { V->Val[MAX_DIM* k ] = V->Val[0] ; V->Val[MAX_DIM* k +1] = V->Val[1] ; V->Val[MAX_DIM* k +2] = V->Val[2] ; V->Val[MAX_DIM*(k+1) ] = 0. ; V->Val[MAX_DIM*(k+1)+1] = 0. ; V->Val[MAX_DIM*(k+1)+2] = 0. ; } } V->Type = VECTOR ; } void F_TangentSource(F_ARG) { int k ; double tx, ty, tz, norm ; if(!Current.ElementSource || Current.ElementSource->Num == NO_ELEMENT) Message::Error("No element on which to compute 'F_TangentSource'"); switch (Current.ElementSource->Type) { case LINE : tx = Current.ElementSource->x[1] - Current.ElementSource->x[0] ; ty = Current.ElementSource->y[1] - Current.ElementSource->y[0] ; tz = Current.ElementSource->z[1] - Current.ElementSource->z[0] ; norm = sqrt(SQU(tx)+SQU(ty)+SQU(tz)) ; V->Val[0] = tx/norm ; V->Val[1] = ty/norm ; V->Val[2] = tz/norm ; break ; default : Message::Error("Function 'TangentSource' only valid for Line Elements"); } if (Current.NbrHar != 1) { V->Val[MAX_DIM] = 0. ; V->Val[MAX_DIM+1] = 0. ; V->Val[MAX_DIM+2] = 0. ; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) { V->Val[MAX_DIM* k ] = V->Val[0] ; V->Val[MAX_DIM* k +1] = V->Val[1] ; V->Val[MAX_DIM* k +2] = V->Val[2] ; V->Val[MAX_DIM*(k+1) ] = 0. ; V->Val[MAX_DIM*(k+1)+1] = 0. ; V->Val[MAX_DIM*(k+1)+2] = 0. ; } } V->Type = VECTOR ; } void F_ElementVol(F_ARG) { int k; double Vol = 0.; MATRIX3x3 Jac; if(!Current.Element || Current.Element->Num == NO_ELEMENT) Message::Error("No element on which to compute 'F_ElementVol'"); /* It would be more efficient to compute the volumes directly from the node coordinates, but I'm lazy... */ Get_NodesCoordinatesOfElement(Current.Element) ; Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w) ; /* we use the most general case (3D embedding) */ switch(Current.Element->Type){ case LINE: Vol = 2. * JacobianLin3D(Current.Element,&Jac); break; case TRIANGLE: Vol = 0.5 * JacobianSur3D(Current.Element,&Jac) ; break; case QUADRANGLE: Vol = 4. * JacobianSur3D(Current.Element,&Jac) ; break; case TETRAHEDRON: Vol = 1./6. * JacobianVol3D(Current.Element,&Jac) ; break; case HEXAHEDRON: Vol = 8. * JacobianVol3D(Current.Element,&Jac) ; break; case PRISM: Vol = JacobianVol3D(Current.Element,&Jac) ; break; case PYRAMID: Vol = 4./3. * JacobianVol3D(Current.Element,&Jac) ; break; default : Message::Error("F_ElementVol not implemented for %s", Get_StringForDefine(Element_Type, Current.Element->Type)); } V->Type = SCALAR ; V->Val[0] = fabs(Vol); for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) V->Val[MAX_DIM* k] = V->Val[0] ; } void F_SurfaceArea(F_ARG) { struct Element Element ; List_T * InitialList_L; int Nbr_Element, i_Element ; double Val_Surface ; double c11, c21, c12, c22, DetJac ; int i, k ; if (!Fct->Active) { Fct->Active = (struct FunctionActive *)Malloc(sizeof(struct FunctionActive)) ; if (Fct->NbrParameters == 1) { int Index_Region = (int)(Fct->Para[0]) ; InitialList_L = List_Create(1,1,sizeof(int)); List_Add(InitialList_L, &Index_Region); } else if (Fct->NbrParameters > 1) { InitialList_L = List_Create(Fct->NbrParameters,1,sizeof(int)); List_Reset(InitialList_L); for (i=0; iNbrParameters; i++) { int Index_Region = (int)(Fct->Para[i]) ; List_Add(InitialList_L, &Index_Region); } } else { InitialList_L = NULL ; } Val_Surface = 0. ; Nbr_Element = Geo_GetNbrGeoElements() ; for (i_Element = 0 ; i_Element < Nbr_Element; i_Element++) { Element.GeoElement = Geo_GetGeoElement(i_Element) ; if ((InitialList_L && List_Search(InitialList_L, &(Element.GeoElement->Region), fcmp_int)) || (!InitialList_L && Element.GeoElement->Region == Current.Region)) { Element.Num = Element.GeoElement->Num ; Element.Type = Element.GeoElement->Type ; if (Element.Type == TRIANGLE || Element.Type == QUADRANGLE) { Get_NodesCoordinatesOfElement(&Element) ; Get_BFGeoElement(&Element, 0., 0., 0.) ; c11 = c21 = c12 = c22 = 0. ; for ( i = 0 ; i < Element.GeoElement->NbrNodes ; i++ ) { c11 += Element.x[i] * Element.dndu[i][0] ; c21 += Element.x[i] * Element.dndu[i][1] ; c12 += Element.y[i] * Element.dndu[i][0] ; c22 += Element.y[i] * Element.dndu[i][1] ; } DetJac = c11 * c22 - c12 * c21 ; if (Element.Type == TRIANGLE) Val_Surface += fabs(DetJac) * 0.5 ; else if (Element.Type == QUADRANGLE) Val_Surface += fabs(DetJac) * 4. ; } else if (Element.Type == LINE) { Get_NodesCoordinatesOfElement(&Element) ; Get_BFGeoElement(&Element, 0., 0., 0.) ; c11 = 0. ; for ( i = 0 ; i < Element.GeoElement->NbrNodes ; i++ ) { c11 += Element.x[i] * Element.dndu[i][0] ; } DetJac = c11 ; Val_Surface += fabs(DetJac) * 2 ; // SurfaceArea of LINE x 1m } else { Message::Error("Function 'SurfaceArea' only valid for line, triangle or " "quandrangle elements"); } } } Fct->Active->Case.SurfaceArea.Value = Val_Surface ; } V->Type = SCALAR ; V->Val[0] = Fct->Active->Case.SurfaceArea.Value ; V->Val[MAX_DIM] = 0; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) { V->Val[MAX_DIM* k] = V->Val[0] ; V->Val[MAX_DIM* (k+1)] = 0 ; } } void F_GetVolume(F_ARG) { struct Element Element ; List_T * InitialList_L; int Nbr_Element, i_Element ; double Val_Volume ; double c11, c21, c31, c12, c22, c32, c13, c23, c33 ; double DetJac ; int i, k ; if (!Fct->Active) { Fct->Active = (struct FunctionActive *)Malloc(sizeof(struct FunctionActive)) ; if (Fct->NbrParameters == 1) { int Index_Region = (int)(Fct->Para[0]) ; InitialList_L = List_Create(1, 1, sizeof(int)); List_Add(InitialList_L,&Index_Region); } else { InitialList_L = NULL ; } Val_Volume = 0. ; Nbr_Element = Geo_GetNbrGeoElements() ; for (i_Element = 0 ; i_Element < Nbr_Element; i_Element++) { Element.GeoElement = Geo_GetGeoElement(i_Element) ; if ((InitialList_L && List_Search(InitialList_L, &(Element.GeoElement->Region), fcmp_int)) || (!InitialList_L && Element.GeoElement->Region == Current.Region)) { Element.Num = Element.GeoElement->Num ; Element.Type = Element.GeoElement->Type ; if (Element.Type == TETRAHEDRON || Element.Type == HEXAHEDRON || Element.Type == PRISM) { Get_NodesCoordinatesOfElement(&Element) ; Get_BFGeoElement(&Element, 0., 0., 0.) ; c11 = c21 = c31 = c12 = c22 = c32 = c13 = c23 = c33 = 0; for ( i = 0 ; i < Element.GeoElement->NbrNodes ; i++ ) { c11 += Element.x[i] * Element.dndu[i][0] ; c21 += Element.x[i] * Element.dndu[i][1] ; c31 += Element.x[i] * Element.dndu[i][2] ; c12 += Element.y[i] * Element.dndu[i][0] ; c22 += Element.y[i] * Element.dndu[i][1] ; c32 += Element.y[i] * Element.dndu[i][2] ; c13 += Element.z[i] * Element.dndu[i][0] ; c23 += Element.z[i] * Element.dndu[i][1] ; c33 += Element.z[i] * Element.dndu[i][2] ; } DetJac = c11 * c22 * c33 + c13 * c21 * c32 + c12 * c23 * c31 - c13 * c22 * c31 - c11 * c23 * c32 - c12 * c21 * c33 ; switch(Element.Type){ case TETRAHEDRON: Val_Volume += 1./6. * fabs(DetJac); break; case HEXAHEDRON: Val_Volume += 8. * fabs(DetJac); break; case PRISM: Val_Volume += fabs(DetJac); break; } } else { Message::Error("Function 'GetVolume' not valid for %s", Get_StringForDefine(Element_Type, Element.Type)); } } } Fct->Active->Case.GetVolume.Value = Val_Volume ; } V->Type = SCALAR ; V->Val[0] = Fct->Active->Case.GetVolume.Value ; V->Val[MAX_DIM] = 0; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) { V->Val[MAX_DIM* k] = V->Val[0] ; V->Val[MAX_DIM* (k+1)] = 0 ; } } void F_GetNumElements(F_ARG) { struct Element Element ; if (!Fct->Active) { Fct->Active = (struct FunctionActive *)Malloc(sizeof(struct FunctionActive)) ; List_T * InitialList_L = 0; if (Fct->NbrParameters == 1) { int Index_Region = (int)(Fct->Para[0]) ; InitialList_L = List_Create(1, 1, sizeof(int)); List_Add(InitialList_L, &Index_Region); } int Count = 0. ; int Nbr_Element = Geo_GetNbrGeoElements() ; for (int i_Element = 0 ; i_Element < Nbr_Element; i_Element++) { Element.GeoElement = Geo_GetGeoElement(i_Element) ; if ((InitialList_L && List_Search(InitialList_L, &(Element.GeoElement->Region), fcmp_int)) || (!InitialList_L && Element.GeoElement->Region == Current.Region)) { Count++; } } Fct->Active->Case.GetNumElements.Value = Count ; } V->Type = SCALAR ; V->Val[0] = Fct->Active->Case.GetNumElements.Value ; V->Val[MAX_DIM] = 0; for (int k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) { V->Val[MAX_DIM* k] = V->Val[0] ; V->Val[MAX_DIM* (k+1)] = 0 ; } } void F_CellSize(F_ARG) { double cellSize, Vol; MATRIX3x3 Jac; double c11, c21, c12, c22, DetJac; int i, k ; if(!Current.Element || Current.Element->Num == NO_ELEMENT) Message::Error("No element on which to compute 'CellSize'"); Get_NodesCoordinatesOfElement(Current.Element) ; Get_BFGeoElement(Current.Element, 0., 0., 0.) ; switch(Current.Element->Type){ case LINE: cellSize = 2. * JacobianLin3D(Current.Element,&Jac); break; case TRIANGLE: c11 = c21 = c12 = c22 = 0. ; for ( i = 0 ; i < Current.Element->GeoElement->NbrNodes ; i++ ) { c11 += Current.Element->x[i] * Current.Element->dndu[i][0] ; c21 += Current.Element->x[i] * Current.Element->dndu[i][1] ; c12 += Current.Element->y[i] * Current.Element->dndu[i][0] ; c22 += Current.Element->y[i] * Current.Element->dndu[i][1] ; } DetJac = c11 * c22 - c12 * c21 ; cellSize = sqrt(SQU(Current.Element->x[1]-Current.Element->x[0]) +SQU(Current.Element->y[1]-Current.Element->y[0]) +SQU(Current.Element->z[1]-Current.Element->z[0])) * sqrt(SQU(Current.Element->x[2]-Current.Element->x[1]) +SQU(Current.Element->y[2]-Current.Element->y[1]) +SQU(Current.Element->z[2]-Current.Element->z[1])) * sqrt(SQU(Current.Element->x[0]-Current.Element->x[2]) +SQU(Current.Element->y[0]-Current.Element->y[2]) +SQU(Current.Element->z[0]-Current.Element->z[2])) / fabs(DetJac) ; break; case QUADRANGLE: // Message::Warning("Function CellSize not ready for QUADRANGLE") ; Vol = 4. * JacobianSur3D(Current.Element,&Jac) ; cellSize = sqrt(Vol); break; case TETRAHEDRON: cellSize = 0.; Message::Warning("Function CellSize not ready for TETRAHEDRON") ; break; case HEXAHEDRON: cellSize = 0.; Message::Warning("Function CellSize not ready for HEXAHEDRON") ; break; case PRISM: cellSize = 0.; Message::Warning("Function CellSize not ready for PRISM") ; break; default : cellSize = 0.; Message::Error("Function 'CellSize' not valid for %s", Get_StringForDefine(Element_Type, Current.Element->Type)); } V->Type = SCALAR ; V->Val[0] = cellSize ; V->Val[MAX_DIM] = 0. ; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) { V->Val[MAX_DIM* k] = V->Val[0] ; V->Val[MAX_DIM* (k+1)] = 0 ; } } void F_SquNormEdgeValues(F_ARG) { struct Geo_Element *GeoElement; int i, *NumNodes; double x [NBR_MAX_NODES_IN_ELEMENT] ; double y [NBR_MAX_NODES_IN_ELEMENT] ; double z [NBR_MAX_NODES_IN_ELEMENT] ; double xe[2], ye[2], ze[2]; int numDofData, Code_BasisFunction, CodeExist = 0; struct Dof * Dof_P = NULL; double Val_Dof, Val_Dof_i, valSum, sizeEdge ; int k; if(!Current.Element || Current.Element->Num == NO_ELEMENT) Message::Error("No element on which to compute 'SquNormEdgeValues'"); numDofData = (int)Fct->Para[0]; Code_BasisFunction = (int)Fct->Para[1]; GeoElement = Current.Element->GeoElement; Geo_GetNodesCoordinates (GeoElement->NbrNodes, GeoElement->NumNodes, x, y, z) ; valSum = 0.; if(!GeoElement->NbrEdges) Geo_CreateEdgesOfElement(GeoElement) ; for(i=0 ; iNbrEdges ; i++){ NumNodes = Geo_GetNodesOfEdgeInElement(GeoElement, i) ; xe[0] = x[abs(NumNodes[0])-1]; xe[1] = x[abs(NumNodes[1])-1]; ye[0] = y[abs(NumNodes[0])-1]; ye[1] = y[abs(NumNodes[1])-1]; ze[0] = z[abs(NumNodes[0])-1]; ze[1] = z[abs(NumNodes[1])-1]; CodeExist = ((Dof_P = Dof_GetDofStruct(Current.DofData_P0+ numDofData, Code_BasisFunction, abs(GeoElement->NumEdges[i]), 0)) != NULL) ; if (CodeExist) { sizeEdge = sqrt( SQU(xe[1]-xe[0]) + SQU(ye[1]-ye[0]) + SQU(ze[1]-ze[0]) ); if(Current.NbrHar==1){ Dof_GetRealDofValue(Current.DofData_P0+ numDofData, Dof_P, &Val_Dof) ; Val_Dof = Val_Dof/sizeEdge; valSum += SQU(Val_Dof) * sizeEdge; } else{ for (k = 0 ; k < Current.NbrHar ; k+=2) { Dof_GetComplexDofValue (Current.DofData_P0+ numDofData, Dof_P + k/2*gCOMPLEX_INCREMENT, &Val_Dof, &Val_Dof_i) ; Val_Dof = Val_Dof /sizeEdge; Val_Dof_i = Val_Dof_i/sizeEdge; valSum += (SQU(Val_Dof)+SQU(Val_Dof_i)) * sizeEdge; } } } } V->Type = SCALAR ; V->Val[0] = valSum ; V->Val[MAX_DIM] = 0. ; for (k = 2 ; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar) ; k += 2) { V->Val[MAX_DIM* k] = V->Val[0] ; V->Val[MAX_DIM* (k+1)] = 0 ; } } static double POINT_TO_PROJECT[3], ELLIPSE_PARAMETERS[2]; static double dist_ellipse(double t) { double x, y; x = ELLIPSE_PARAMETERS[0] * cos(t); y = ELLIPSE_PARAMETERS[1] * sin(t); return sqrt(SQU(x - POINT_TO_PROJECT[0]) + SQU(y - POINT_TO_PROJECT[1])); } void F_ProjectPointOnEllipse(F_ARG) { int k; double t1 = 0., t2 = 1.e-6, t3, f1, f2, f3, tol = 1.e-4; double t, x, y; POINT_TO_PROJECT[0] = A->Val[0]; POINT_TO_PROJECT[1] = A->Val[1]; POINT_TO_PROJECT[2] = A->Val[2]; ELLIPSE_PARAMETERS[0] = Fct->Para[0] ; ELLIPSE_PARAMETERS[1] = Fct->Para[1] ; mnbrak(&t1, &t2, &t3, &f1, &f2, &f3, dist_ellipse); if(t1 > t2){ t = t1; t1 = t3; t3 = t; } brent(t1, t2, t3, dist_ellipse, tol, &t); x = ELLIPSE_PARAMETERS[0] * cos(t); y = ELLIPSE_PARAMETERS[1] * sin(t); /* printf("SL(%g,%g,0,%g,%g,0){1,1};\n", A->Val[0], A->Val[1], x, y); */ for (k = 0 ; k < Current.NbrHar ; k++) { V->Val[MAX_DIM*k ] = 0. ; V->Val[MAX_DIM*k+1] = 0. ; V->Val[MAX_DIM*k+2] = 0. ; } V->Val[0] = x; V->Val[1] = y; V->Type = VECTOR ; } getdp-2.7.0-source/Legacy/CMakeLists.txt000644 001750 001750 00000004467 12473553042 021565 0ustar00geuzainegeuzaine000000 000000 # GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege # # See the LICENSE.txt file for license information. Please report all # bugs and problems to the public mailing list . set(SRC MainLegacy.cpp F_Analytic.cpp F_BiotSavart.cpp F_Coord.cpp F_ExtMath.cpp F_Geometry.cpp F_Interpolation.cpp F_Hysteresis.cpp F_Math.cpp F_Misc.cpp F_MultiHar.cpp F_Raytracing.cpp F_Gmsh.cpp F_DiffGeom.cpp F_Octave.cpp F_Python.cpp BF_Node.cpp BF_NodeXYZ.cpp BF_Node_2.cpp BF_Node_3.cpp BF_Edge.cpp BF_Edge_2.cpp BF_Edge_3.cpp BF_Edge_4.cpp BF_Facet.cpp BF_Volume.cpp BF_Region.cpp BF_Perpendicular.cpp BF_GroupOfEntities.cpp GF_Helmholtz.cpp GF_HelmholtzxForm.cpp GF_Laplace.cpp GF_LaplacexForm.cpp Gauss_Point.cpp Gauss_Line.cpp Gauss_Triangle.cpp Gauss_Quadrangle.cpp Gauss_Tetrahedron.cpp Gauss_Hexahedron.cpp Gauss_Prism.cpp Gauss_Pyramid.cpp GeoData.cpp GeoEntity.cpp GeoNormal.cpp GeoTree.cpp DofData.cpp LinAlg.cpp LinAlg_PETSC.cpp LinAlg_SPARSKIT.cpp SolvingAnalyse.cpp SolvingOperations.cpp Cal_SolutionErrorRatio.cpp Operation_TimeLoopAdaptive.cpp Operation_IterativeLoopN.cpp Operation_IterativeLinearSolver.cpp Operation_IterativeTimeReduction.cpp Operation_Update.cpp Operation_ChangeOfCoordinates.cpp Operation_PostOperation.cpp Treatment_Formulation.cpp Get_DofOfElement.cpp Get_ConstraintOfElement.cpp Treatment_ConstraintByLocalProjection.cpp Get_FunctionValue.cpp Get_Geometry.cpp Get_ElementSource.cpp ExtendedGroup.cpp Pre_TermOfFemEquation.cpp Generate_Network.cpp Cal_GalerkinTermOfFemEquation.cpp Cal_GlobalTermOfFemEquation.cpp Cal_IntegralQuantity.cpp Cal_AnalyticIntegration.cpp Cal_Quantity.cpp Cal_Value.cpp Cal_AssembleTerm.cpp Cal_PostQuantity.cpp MovingBand2D.cpp EigenSolve.cpp EigenSolve_ARPACK.cpp EigenSolve_SLEPC.cpp Pos_FemInterpolation.cpp Pos_Formulation.cpp Pos_Print.cpp Pos_Element.cpp Pos_Format.cpp Pos_Iso.cpp Pos_Search.cpp ) file(GLOB HDR RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} *.h) append_getdp_src(Legacy "${SRC};${HDR}") getdp-2.7.0-source/Legacy/F_Octave.cpp000644 001750 001750 00000010701 12473553042 021203 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "GetDPConfig.h" #include "ProData.h" #include "F.h" #include "Message.h" extern struct CurrentData Current ; // This file defines a simple interface to Octave. // // * To configure GetDP with Octave support, point cmake to Octave's library and // include directories, e.g.: // // cmake -DCMAKE_PREFIX_PATH="/opt/local/include/octave-3.6.4; // /opt/local/lib/octave/3.6.4" .. // // * The Octave interpreter will be initialized when GetDP is started; you can // then use the Octave[argument_list]{string} function in the same way as // other GetDP functions: // // - `argument_list' contains standard GetDP arguments, e.g. X[], Norm[{d a}], // etc. These arguments will be stored in Octave as input{0}, input{1}, // etc., which you can then access as normal Octave variables // // - `string' contains either the Octave expression that you want to // evaluate. Due to conflicts in the GetDP syntax, to use a string variable, // you need to use Str[string_variable] // // * Since the Octave interpreter lives for the whole duration of the GetDP run, // you can make quite efficient Octave calculations by precomputing things // outside the finite element assembly loop. The easiest way to to this is to // evaluate the Octave code you need to precompute using // // Evaluate[ my_octave_precomputation[] ] // // in the Operation field of a Resolution before Generate[] is called. // TODO: also add a way to evaluate a single Octave function, without // parsing the expression. Example: // // octave_idx_type n = 2; // octave_value_list in; // for (octave_idx_type i = 0; i < n; i++) // in(i) = octave_value (5 * (i + 2)); // octave_value_list out = feval("gcd", in, 1); // if (!error_state && out.length () > 0) // Message::Info("res = %d", out(0).int_value()); // else // Message::Error("Octave error"); #if defined(HAVE_OCTAVE) #undef _D1 #undef _D2 #undef HAVE_ARPACK #include #include void F_Octave(F_ARG) { if(!Fct->String){ Message::Error("Missing Octave expression: use Octave[arguments]{\"expression\"}"); for (int k = 0; k < Current.NbrHar; k++) V->Val[MAX_DIM * k] = 0. ; V->Type = SCALAR; return; } // we could do this more efficiently by directly storing the values in octave // (instead of parsing) std::string expr; for(int i = 0; i < Fct->NbrArguments; i++){ char tmp[256]; if((A + i)->Type == SCALAR){ if(Current.NbrHar == 2) sprintf(tmp, "input{%d} = %.16g+%.16gi;", i + 1, (A + i)->Val[0], (A + i)->Val[MAX_DIM]); else sprintf(tmp, "input{%d} = %.16g;", i + 1, (A + i)->Val[0]); } else{ Message::Error("Non-scalar Octave arguments not coded yet"); } expr += tmp; } expr += Fct->String; int status; octave_value out; // FIXME: it seems like we cannot evaluate several octave statements at // once !?!? //out = eval_string(expr.c_str(), false, status); //if(status) Message::Error("Octave evaluation error"); // FIXME: this will break when semi-colons are present in expressions for // something else than statement boundaries std::string::size_type first = 0; while(1){ std::string::size_type last = expr.find_first_of(";", first); std::string str = expr.substr(first, last - first + 1); if(str.size()){ //Message::Info("Evaluating %s", str.c_str()); out = eval_string(str.c_str(), false, status); if(status) Message::Error("Octave evaluation error"); } if(last == std::string::npos) break; first = last + 1; } for (int k = 0; k < Current.NbrHar; k++) for (int j = 0; j < 9; j++) V->Val[MAX_DIM * k + j] = 0. ; if(out.is_real_scalar()){ V->Val[0] = out.double_value(); V->Type = SCALAR; } else if(out.is_complex_scalar()){ V->Val[0] = out.complex_value().real(); V->Val[MAX_DIM] = out.complex_value().imag(); V->Type = SCALAR; } else if(out.is_real_matrix() || out.is_complex_matrix()){ Message::Error("Octave matrix output not coded yet"); V->Type = VECTOR ; } } #else void F_Octave(F_ARG) { Message::Error("You need to compile GetDP with Octave support to use Octave functions"); V->Val[0] = 0. ; V->Type = SCALAR ; } #endif getdp-2.7.0-source/Legacy/Gauss_Line.h000644 001750 001750 00000027300 12473553042 021216 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . /* Please change the MAX_LINE_POINTS in Quadrature.h if you extend this list, in order for the Gauss-Legendre rules to be automatically updated. */ /* 1 integration point */ static double lx1[1]={ 0.000000000000000e+00}; static double lp1[1]={ 2.000000000000000e+00}; /* 2 integration points */ static double lx2[2]={ -5.773502691896257e-01, 5.773502691896257e-01}; static double lp2[2]={ 1.000000000000000e+00, 1.000000000000000e+00}; /* 3 integration points */ static double lx3[3]={ -7.745966692414834e-01, 0.000000000000000e+00, 7.745966692414834e-01}; static double lp3[3]={ 5.555555555555552e-01, 8.888888888888888e-01, 5.555555555555552e-01}; /* 4 integration points */ static double lx4[4]={ -8.611363115940526e-01,-3.399810435848563e-01, 3.399810435848563e-01, 8.611363115940526e-01}; static double lp4[4]={ 3.478548451374537e-01, 6.521451548625464e-01, 6.521451548625464e-01, 3.478548451374537e-01}; /* 5 integration points */ static double lx5[5]={ -9.061798459386640e-01,-5.384693101056831e-01, 0.000000000000000e+00, 5.384693101056831e-01, 9.061798459386640e-01}; static double lp5[5]={ 2.369268850561890e-01, 4.786286704993665e-01, 5.688888888888889e-01, 4.786286704993665e-01, 2.369268850561890e-01}; /* 6 integration points */ static double lx6[6]={ -9.324695142031521e-01,-6.612093864662646e-01,-2.386191860831969e-01, 2.386191860831969e-01, 6.612093864662646e-01, 9.324695142031521e-01}; static double lp6[6]={ 1.713244923791705e-01, 3.607615730481386e-01, 4.679139345726913e-01, 4.679139345726913e-01, 3.607615730481386e-01, 1.713244923791705e-01}; /* 7 integration points */ static double lx7[7]={ -9.491079123427585e-01,-7.415311855993945e-01,-4.058451513773972e-01, 0.000000000000000e+00, 4.058451513773972e-01, 7.415311855993945e-01, 9.491079123427585e-01}; static double lp7[7]={ 1.294849661688697e-01, 2.797053914892767e-01, 3.818300505051190e-01, 4.179591836734694e-01, 3.818300505051190e-01, 2.797053914892767e-01, 1.294849661688697e-01}; /* 8 integration points */ static double lx8[8]={ -9.602898564975363e-01,-7.966664774136268e-01,-5.255324099163290e-01,-1.834346424956498e-01, 1.834346424956498e-01, 5.255324099163290e-01, 7.966664774136268e-01, 9.602898564975363e-01}; static double lp8[8]={ 1.012285362903768e-01, 2.223810344533745e-01, 3.137066458778874e-01, 3.626837833783620e-01, 3.626837833783620e-01, 3.137066458778874e-01, 2.223810344533745e-01, 1.012285362903768e-01}; /* 9 integration points */ static double lx9[9]={ -9.681602395076261e-01,-8.360311073266359e-01,-6.133714327005905e-01,-3.242534234038089e-01, 0.000000000000000e+00, 3.242534234038089e-01, 6.133714327005905e-01, 8.360311073266359e-01, 9.681602395076261e-01}; static double lp9[9]={ 8.127438836157463e-02, 1.806481606948576e-01, 2.606106964029355e-01, 3.123470770400029e-01, 3.302393550012598e-01, 3.123470770400029e-01, 2.606106964029355e-01, 1.806481606948576e-01, 8.127438836157463e-02}; /* 10 integration points */ static double lx10[10]={ -9.739065285171716e-01,-8.650633666889845e-01,-6.794095682990244e-01,-4.333953941292472e-01, -1.488743389816312e-01, 1.488743389816312e-01, 4.333953941292472e-01, 6.794095682990244e-01, 8.650633666889845e-01, 9.739065285171716e-01}; static double lp10[10]={ 6.667134430868774e-02, 1.494513491505805e-01, 2.190863625159822e-01, 2.692667193099962e-01, 2.955242247147529e-01, 2.955242247147529e-01, 2.692667193099962e-01, 2.190863625159822e-01, 1.494513491505805e-01, 6.667134430868774e-02}; /* 11 integration points */ static double lx11[11]={ -9.782286581460570e-01,-8.870625997680953e-01,-7.301520055740494e-01,-5.190961292068118e-01, -2.695431559523450e-01, 0.000000000000000e+00, 2.695431559523450e-01, 5.190961292068118e-01, 7.301520055740494e-01, 8.870625997680953e-01, 9.782286581460570e-01}; static double lp11[11]={ 5.566856711617354e-02, 1.255803694649047e-01, 1.862902109277343e-01, 2.331937645919903e-01, 2.628045445102466e-01, 2.729250867779006e-01, 2.628045445102466e-01, 2.331937645919903e-01, 1.862902109277343e-01, 1.255803694649047e-01, 5.566856711617354e-02}; /* 12 integration points */ static double lx12[12]={ -9.815606342467192e-01,-9.041172563704748e-01,-7.699026741943047e-01,-5.873179542866175e-01, -3.678314989981802e-01,-1.252334085114689e-01, 1.252334085114689e-01, 3.678314989981802e-01, 5.873179542866175e-01, 7.699026741943047e-01, 9.041172563704748e-01, 9.815606342467192e-01}; static double lp12[12]={ 4.717533638651183e-02, 1.069393259953182e-01, 1.600783285433463e-01, 2.031674267230658e-01, 2.334925365383548e-01, 2.491470458134029e-01, 2.491470458134029e-01, 2.334925365383548e-01, 2.031674267230658e-01, 1.600783285433463e-01, 1.069393259953182e-01, 4.717533638651183e-02}; /* 13 integration points */ static double lx13[13]={ -9.841830547185881e-01,-9.175983992229780e-01,-8.015780907333099e-01,-6.423493394403402e-01, -4.484927510364468e-01,-2.304583159551348e-01, 1.232595164407831e-32, 2.304583159551348e-01, 4.484927510364468e-01, 6.423493394403402e-01, 8.015780907333099e-01, 9.175983992229780e-01, 9.841830547185881e-01}; static double lp13[13]={ 4.048400476531581e-02, 9.212149983772838e-02, 1.388735102197872e-01, 1.781459807619457e-01, 2.078160475368884e-01, 2.262831802628971e-01, 2.325515532308739e-01, 2.262831802628971e-01, 2.078160475368884e-01, 1.781459807619457e-01, 1.388735102197872e-01, 9.212149983772838e-02, 4.048400476531581e-02}; /* 14 integration points */ static double lx14[14]={ -9.862838086968123e-01,-9.284348836635736e-01,-8.272013150697650e-01,-6.872929048116855e-01, -5.152486363581541e-01,-3.191123689278897e-01,-1.080549487073437e-01, 1.080549487073437e-01, 3.191123689278897e-01, 5.152486363581541e-01, 6.872929048116855e-01, 8.272013150697650e-01, 9.284348836635736e-01, 9.862838086968123e-01}; static double lp14[14]={ 3.511946033175199e-02, 8.015808715976037e-02, 1.215185706879031e-01, 1.572031671581936e-01, 1.855383974779378e-01, 2.051984637212955e-01, 2.152638534631578e-01, 2.152638534631578e-01, 2.051984637212955e-01, 1.855383974779378e-01, 1.572031671581936e-01, 1.215185706879031e-01, 8.015808715976037e-02, 3.511946033175199e-02}; /* 15 integration points */ static double lx15[15]={ -9.879925180204854e-01,-9.372733924007060e-01,-8.482065834104272e-01,-7.244177313601701e-01, -5.709721726085388e-01,-3.941513470775634e-01,-2.011940939974345e-01, 1.232595164407831e-32, 2.011940939974345e-01, 3.941513470775634e-01, 5.709721726085388e-01, 7.244177313601701e-01, 8.482065834104272e-01, 9.372733924007060e-01, 9.879925180204854e-01}; static double lp15[15]={ 3.075324199611663e-02, 7.036604748810814e-02, 1.071592204671720e-01, 1.395706779261543e-01, 1.662692058169940e-01, 1.861610000155622e-01, 1.984314853271116e-01, 2.025782419255613e-01, 1.984314853271116e-01, 1.861610000155622e-01, 1.662692058169940e-01, 1.395706779261543e-01, 1.071592204671720e-01, 7.036604748810814e-02, 3.075324199611663e-02}; /* 16 integration points */ static double lx16[16]={ -9.894009349916499e-01,-9.445750230732326e-01,-8.656312023878318e-01,-7.554044083550030e-01, -6.178762444026438e-01,-4.580167776572274e-01,-2.816035507792589e-01,-9.501250983763744e-02, 9.501250983763744e-02, 2.816035507792589e-01, 4.580167776572274e-01, 6.178762444026438e-01, 7.554044083550030e-01, 8.656312023878318e-01, 9.445750230732326e-01, 9.894009349916499e-01}; static double lp16[16]={ 2.715245941175406e-02, 6.225352393864778e-02, 9.515851168249290e-02, 1.246289712555339e-01, 1.495959888165768e-01, 1.691565193950026e-01, 1.826034150449236e-01, 1.894506104550685e-01, 1.894506104550685e-01, 1.826034150449236e-01, 1.691565193950026e-01, 1.495959888165768e-01, 1.246289712555339e-01, 9.515851168249290e-02, 6.225352393864778e-02, 2.715245941175406e-02}; /* 17 integration points */ static double lx17[17]={ -9.905754753144174e-01,-9.506755217687678e-01,-8.802391537269859e-01,-7.815140038968014e-01, -6.576711592166907e-01,-5.126905370864769e-01,-3.512317634538763e-01,-1.784841814958479e-01, 1.232595164407831e-32, 1.784841814958479e-01, 3.512317634538763e-01, 5.126905370864769e-01, 6.576711592166907e-01, 7.815140038968014e-01, 8.802391537269859e-01, 9.506755217687678e-01, 9.905754753144174e-01}; static double lp17[17]={ 2.414830286854792e-02, 5.545952937398713e-02, 8.503614831717915e-02, 1.118838471934039e-01, 1.351363684685256e-01, 1.540457610768104e-01, 1.680041021564499e-01, 1.765627053669926e-01, 1.794464703562065e-01, 1.765627053669926e-01, 1.680041021564499e-01, 1.540457610768104e-01, 1.351363684685256e-01, 1.118838471934039e-01, 8.503614831717915e-02, 5.545952937398713e-02, 2.414830286854792e-02}; /* 18 integration points */ static double lx18[18]={ -9.915651684209310e-01,-9.558239495713977e-01,-8.926024664975557e-01,-8.037049589725231e-01, -6.916870430603532e-01,-5.597708310739475e-01,-4.117511614628426e-01,-2.518862256915055e-01, -8.477501304173531e-02, 8.477501304173531e-02, 2.518862256915055e-01, 4.117511614628426e-01, 5.597708310739475e-01, 6.916870430603532e-01, 8.037049589725231e-01, 8.926024664975557e-01, 9.558239495713977e-01, 9.915651684209310e-01}; static double lp18[18]={ 2.161601352648315e-02, 4.971454889496984e-02, 7.642573025488918e-02, 1.009420441062872e-01, 1.225552067114784e-01, 1.406429146706506e-01, 1.546846751262652e-01, 1.642764837458327e-01, 1.691423829631435e-01, 1.691423829631435e-01, 1.642764837458327e-01, 1.546846751262652e-01, 1.406429146706506e-01, 1.225552067114784e-01, 1.009420441062872e-01, 7.642573025488918e-02, 4.971454889496984e-02, 2.161601352648315e-02}; /* 19 integration points */ static double lx19[19]={ -9.924068438435844e-01,-9.602081521348300e-01,-9.031559036148179e-01,-8.227146565371428e-01, -7.209661773352294e-01,-6.005453046616810e-01,-4.645707413759609e-01,-3.165640999636298e-01, -1.603586456402254e-01, 1.232595164407831e-32, 1.603586456402254e-01, 3.165640999636298e-01, 4.645707413759609e-01, 6.005453046616810e-01, 7.209661773352294e-01, 8.227146565371428e-01, 9.031559036148179e-01, 9.602081521348300e-01, 9.924068438435844e-01}; static double lp19[19]={ 1.946178822972643e-02, 4.481422676569959e-02, 6.904454273764125e-02, 9.149002162245014e-02, 1.115666455473341e-01, 1.287539625393363e-01, 1.426067021736066e-01, 1.527660420658597e-01, 1.589688433939544e-01, 1.610544498487837e-01, 1.589688433939544e-01, 1.527660420658597e-01, 1.426067021736066e-01, 1.287539625393363e-01, 1.115666455473341e-01, 9.149002162245014e-02, 6.904454273764125e-02, 4.481422676569959e-02, 1.946178822972643e-02}; /* 20 integration points */ static double lx20[20]={ -9.931285991850949e-01,-9.639719272779138e-01,-9.122344282513259e-01,-8.391169718222189e-01, -7.463319064601508e-01,-6.360536807265150e-01,-5.108670019508271e-01,-3.737060887154195e-01, -2.277858511416451e-01,-7.652652113349734e-02, 7.652652113349734e-02, 2.277858511416451e-01, 3.737060887154195e-01, 5.108670019508271e-01, 6.360536807265150e-01, 7.463319064601508e-01, 8.391169718222189e-01, 9.122344282513259e-01, 9.639719272779138e-01, 9.931285991850949e-01}; static double lp20[20]={ 1.761400713915226e-02, 4.060142980038705e-02, 6.267204833410904e-02, 8.327674157670474e-02, 1.019301198172405e-01, 1.181945319615183e-01, 1.316886384491766e-01, 1.420961093183819e-01, 1.491729864726038e-01, 1.527533871307260e-01, 1.527533871307260e-01, 1.491729864726038e-01, 1.420961093183819e-01, 1.316886384491766e-01, 1.181945319615183e-01, 1.019301198172405e-01, 8.327674157670474e-02, 6.267204833410904e-02, 4.060142980038705e-02, 1.761400713915226e-02}; getdp-2.7.0-source/Legacy/SolvingAnalyse.h000644 001750 001750 00000002147 12473553042 022125 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _SOLVING_ANALYSE_H_ #define _SOLVING_ANALYSE_H_ #include "ProData.h" void Init_DofDataInFunctionSpace(int Nbr_DefineSystem, struct DofData *DofData_P0); void Init_DofDataInDefineQuantity(struct DefineSystem *DefineSystem_P, struct DofData *DofData_P0, struct Formulation *Formulation_P); double * Get_TimeFunctionValues(struct DofData * DofData_P); void Init_HarInDofData(struct DefineSystem * DefineSystem_P, struct DofData * DofData_P); void Treatment_PostOperation(struct Resolution * Resolution_P, struct DofData * DofData_P0, struct DefineSystem * DefineSystem_P0, struct GeoData * GeoData_P0, struct PostProcessing * PostProcessing_P, struct PostOperation * PostOperation_P); void SolvingAnalyse(); #endif getdp-2.7.0-source/Legacy/GeoData.h000644 001750 001750 00000011211 12473553042 020463 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _GEODATA_H_ #define _GEODATA_H_ #include "ListUtils.h" #include "TreeUtils.h" struct Grid{ int Init; List_T * Bricks; double Xmin, Xmax, Ymin, Ymax, Zmin, Zmax; int Nx, Ny, Nz; }; struct GeoData { int Num ; char * Name ; List_T * Nodes, * Elements ; int NbrElementsWithEdges, NbrElementsWithFacets ; int NumCurrentEdge, NumCurrentFacet ; Tree_T * EdgesXNodes , * FacetsXEdges ; Tree_T * NodesXElements ; Tree_T * Normals ; List_T * GroupForPRE ; double Xmin, Xmax, Ymin, Ymax, Zmin, Zmax ; double Dimension, CharacteristicLength ; struct Grid Grid; double * H, * P ; } ; int Geo_AddGeoData(List_T * GeoData_L, char * Name_MshFile, char * Name_DefaultMshFile, char * Name_AdaptFile, char * Name_DefaultAdaptFile) ; void Geo_InitGeoData(struct GeoData * GeoData_P, int Num, char * Name) ; void Geo_FreeGeoData(struct GeoData * GeoData_P) ; void Geo_SetCurrentGeoData(struct GeoData * GeoData_P) ; void Geo_OpenFile(char * Name, const char * Mode) ; void Geo_CloseFile(void) ; void Geo_ReadFile(struct GeoData * GeoData_P) ; void Geo_ReadFileAdapt(struct GeoData * GeoData_P) ; void Geo_SaveMesh(struct GeoData * GeoData_P, List_T * InitialList, char * FileName) ; int Geo_GetElementType(int Format, int Type); int Geo_GetElementTypeInv(int Format, int Type); int Geo_GetNbrGeoElements(void) ; struct Geo_Element * Geo_GetGeoElement(int Index_Element) ; int Geo_GetGeoElementIndex(struct Geo_Element * GeoElement) ; struct Geo_Element * Geo_GetGeoElementOfNum(int Num_Element) ; int Geo_GetNbrGeoNodes(void) ; struct Geo_Node * Geo_GetGeoNode(int Index_Node) ; struct Geo_Node * Geo_GetGeoNodeOfNum(int Num_Node) ; void Geo_GetNodesCoordinates(int Nbr_Node, int * Num_Node, double * x, double * y, double * z) ; void Geo_SetNodesCoordinates(int Nbr_Node, int * Num_Node, double * x, double * y, double * z) ; void Geo_SetNodesCoordinatesX(int Nbr_Node, int * Num_Node, double * x) ; void Geo_SetNodesCoordinatesY(int Nbr_Node, int * Num_Node, double * y) ; void Geo_SetNodesCoordinatesZ(int Nbr_Node, int * Num_Node, double * z) ; double * Geo_GetNodes_uvw(int Type, int *nbn) ; double * Geo_GetBarycenter_uvw(int Type) ; void Geo_CreateEdgesOfElement(struct Geo_Element * Geo_Element) ; int * Geo_GetNodesOfEdgeInElement(struct Geo_Element * Geo_Element, int Num_Edge) ; void Geo_CreateFacetsOfElement(struct Geo_Element * Geo_Element) ; int * Geo_GetNodesOfFacetInElement(struct Geo_Element * Geo_Element, int Num_Facet) ; int * Geo_GetIM_Den(int Type_Element, int * Nbe) ; int * Geo_GetIM_Dfe(int Type_Element, int * Nbf) ; int * Geo_GetIM_Dfn(int Type_Element, int * Nbf) ; int * Geo_GetIM_Den_Xp(int Type_Element, int *Nbe, int *Nbn) ; int * Geo_GetIM_Dfe_Xp(int Type_Element, int *Nbf, int *Nbe) ; void Geo_CreateEntitiesOfElement (int Nbr_Entities2, int * D_Element, int Geo_Element_NbrEntities1, int * Geo_Element_NumEntities1, int * Geo_Element_NbrEntities2, int ** Geo_Element_NumEntities2, int * Geo_NbrElementsWithEntities2, int * Geo_NumCurrentEntity2, Tree_T * Geo_Entities2XEntities1) ; void Geo_GenerateEdgesOfTree(List_T * InitialList, List_T * InitialSuppList, List_T ** ExtendedList) ; void Geo_GenerateFacetsOfTree(List_T * InitialList, List_T * InitialSuppList, List_T ** ExtendedList) ; void Geo_GenerateEdgesOfSubTree(List_T * InitialList, List_T * ExtendedList, Tree_T * EntitiesInTree_T) ; void Geo_GenerateFacetsOfSubTree(List_T * InitialList, List_T * ExtendedList, Tree_T * EntitiesInTree_T) ; void Geo_ChangeTreeIndex(void * a, void * b) ; int fcmp_GeoData_Name(const void * a, const void * b) ; int fcmp_Elm(const void * a, const void * b) ; int fcmp_Nod(const void * a, const void * b) ; int fcmp_E2XE1(const void * a, const void * b) ; void free_E2XE1(void * a, void * b) ; int fcmp_EXVector(const void * a, const void * b) ; void Geo_WriteFilePRE(struct GeoData * GeoData_P, List_T * Group_L) ; void Geo_ReadFilePRE(struct GeoData * GeoData_P, int NbrGeoData, List_T * Group_L) ; void Geo_WriteEntities2XEntities1(void * a, void * b) ; void Geo_AddGroupForPRE(int Num) ; void Geo_CreateNodesXElements(int NumNode, int InIndex, int *NbrElements, int **NumElements) ; void Geo_CreateNormal(int Type, double *x, double *y, double *z, double *N) ; void Geo_CreateNormalOfElement(struct Geo_Element *GeoElement, double *Normal) ; #endif getdp-2.7.0-source/Legacy/Cal_PostQuantity.h000644 001750 001750 00000002014 12473553042 022423 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _CAL_POST_QUANTITY_H_ #define _CAL_POST_QUANTITY_H_ #include "ProData.h" void Cal_PostQuantity(struct PostQuantity *PostQuantity_P, struct DefineQuantity *DefineQuantity_P0, struct QuantityStorage *QuantityStorage_P0, List_T *Support_L, struct Element *Element, double u, double v, double w, struct Value *Value) ; void Cal_PostCumulativeQuantity(List_T *Region_L, int SupportIndex, List_T *TimeStep_L, struct PostQuantity *PostQuantity_P, struct DefineQuantity *DefineQuantity_P0, struct QuantityStorage *QuantityStorage_P0, struct Value **Value) ; void Combine_PostQuantity(int Type, int Order, struct Value *V1, struct Value *V2) ; #endif getdp-2.7.0-source/Legacy/GeoEntity.cpp000644 001750 001750 00000054301 12473553042 021430 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "GeoData.h" #include "ProData.h" #include "GeoEntity.h" #include "MallocUtils.h" #include "Message.h" extern FILE * File_PRE ; extern struct GeoData * CurrentGeoData ; extern int Flag_XDATA ; /* ------------------------------------------------------------------------ */ /* G e o _ G e t N o d e s _ u v w */ /* ------------------------------------------------------------------------ */ double * Geo_GetNodes_uvw(int Type, int *nbn) { switch(Type){ case POINT : *nbn = NbrNodes_Point ; return(*Nodes_Point) ; case LINE : *nbn = NbrNodes_Line ; return(*Nodes_Line) ; case TRIANGLE : *nbn = NbrNodes_Triangle ; return(*Nodes_Triangle) ; case QUADRANGLE : *nbn = NbrNodes_Quadrangle ; return(*Nodes_Quadrangle) ; case TETRAHEDRON : *nbn = NbrNodes_Tetrahedron ; return(*Nodes_Tetrahedron) ; case HEXAHEDRON : *nbn = NbrNodes_Hexahedron ; return(*Nodes_Hexahedron) ; case PRISM : *nbn = NbrNodes_Prism ; return(*Nodes_Prism) ; case PYRAMID : *nbn = NbrNodes_Pyramid ; return(*Nodes_Pyramid) ; case LINE_2 : *nbn = NbrNodes_Line_2 ; return(*Nodes_Line_2) ; case TRIANGLE_2 : *nbn = NbrNodes_Triangle_2 ; return(*Nodes_Triangle_2) ; case QUADRANGLE_2: *nbn = NbrNodes_Quadrangle_2 ;return(*Nodes_Quadrangle_2) ; case QUADRANGLE_2_8N: *nbn = NbrNodes_Quadrangle_2_8N ;return(*Nodes_Quadrangle_2_8N); default : Message::Error("Unknown type of Element in Geo_GetNodes_uvw") ; return(NULL) ; } } /* ------------------------------------------------------------------------ */ /* G e o _ C r e a t e E d g e s O f E l e m e n t */ /* ------------------------------------------------------------------------ */ void Geo_CreateEdgesOfElement(struct Geo_Element * Geo_Element) { int Nbr_Entities2, * D_Element ; D_Element = Geo_GetIM_Den(Geo_Element->Type, &Nbr_Entities2) ; Geo_CreateEntitiesOfElement(Nbr_Entities2, D_Element, Geo_Element->NbrNodes, Geo_Element->NumNodes, &Geo_Element->NbrEdges, &Geo_Element->NumEdges, &CurrentGeoData->NbrElementsWithEdges, &CurrentGeoData->NumCurrentEdge, CurrentGeoData->EdgesXNodes) ; } /* ------------------------------------------------------------------------ */ /* G e o _ G e t N o d e s O f E d g e I n E l e m e n t */ /* ------------------------------------------------------------------------ */ int *Geo_GetNodesOfEdgeInElement(struct Geo_Element * Geo_Element, int Num_Edge) { int Nbr_Entities2 ; return( Geo_GetIM_Den(Geo_Element->Type, &Nbr_Entities2) + Num_Edge * NBR_MAX_SUBENTITIES_IN_ELEMENT ) ; } /* ------------------------------------------------------------------------ */ /* G e o _ G e t N o d e s O f F a c e t I n E l e m e n t */ /* ------------------------------------------------------------------------ */ int *Geo_GetNodesOfFacetInElement(struct Geo_Element * Geo_Element, int Num_Facet) { int Nbr_Entities2 ; return( Geo_GetIM_Dfn(Geo_Element->Type, &Nbr_Entities2) + Num_Facet * NBR_MAX_SUBENTITIES_IN_ELEMENT ) ; } /* ------------------------------------------------------------------------ */ /* G e o _ C r e a t e F a c e t s O f E l e m e n t */ /* ------------------------------------------------------------------------ */ void Geo_CreateFacetsOfElement(struct Geo_Element * Geo_Element) { int Nbr_Entities2, * D_Element ; D_Element = Geo_GetIM_Dfe(Geo_Element->Type, &Nbr_Entities2) ; Geo_CreateEntitiesOfElement(Nbr_Entities2, D_Element, Geo_Element->NbrEdges, Geo_Element->NumEdges, &Geo_Element->NbrFacets, &Geo_Element->NumFacets, &CurrentGeoData->NbrElementsWithFacets, &CurrentGeoData->NumCurrentFacet, CurrentGeoData->FacetsXEdges) ; } /* ------------------------------------------------------------------------ */ /* G e o _ G e t I M _ D e n */ /* ------------------------------------------------------------------------ */ int *Geo_GetIM_Den(int Type_Element, int * Nbe) { switch (Type_Element) { case POINT : *Nbe = NbrEdges_Point ; return(NULL) ; case LINE : *Nbe = NbrEdges_Line ; return(*Den_Line) ; case TRIANGLE : *Nbe = NbrEdges_Triangle ; return(*Den_Triangle) ; case QUADRANGLE : *Nbe = NbrEdges_Quadrangle ; return(*Den_Quadrangle) ; case TETRAHEDRON : *Nbe = NbrEdges_Tetrahedron ; return(*Den_Tetrahedron) ; case HEXAHEDRON : *Nbe = NbrEdges_Hexahedron ; return(*Den_Hexahedron) ; case PRISM : *Nbe = NbrEdges_Prism ; return(*Den_Prism) ; case PYRAMID : *Nbe = NbrEdges_Pyramid ; return(*Den_Pyramid) ; case LINE_2 : *Nbe = NbrEdges_Line_2 ; return(*Den_Line_2) ; case TRIANGLE_2 : *Nbe = NbrEdges_Triangle_2 ; return(*Den_Triangle_2) ; case QUADRANGLE_2 :*Nbe = NbrEdges_Quadrangle_2; return(*Den_Quadrangle_2) ; case QUADRANGLE_2_8N :*Nbe = NbrEdges_Quadrangle_2_8N; return(*Den_Quadrangle_2_8N) ; default : Message::Error("Unknown incidence matrix for element type %d", Type_Element); return(NULL) ; } } /* ------------------------------------------------------------------------ */ /* G e o _ G e t I M _ D f e */ /* ------------------------------------------------------------------------ */ int *Geo_GetIM_Dfe(int Type_Element, int * Nbf) { switch (Type_Element) { case POINT : *Nbf = NbrFacets_Point ; return(NULL) ; case LINE : *Nbf = NbrFacets_Line ; return(NULL) ; case TRIANGLE : *Nbf = NbrFacets_Triangle ; return(*Dfe_Triangle) ; case QUADRANGLE : *Nbf = NbrFacets_Quadrangle ; return(*Dfe_Quadrangle) ; case TETRAHEDRON : *Nbf = NbrFacets_Tetrahedron ; return(*Dfe_Tetrahedron) ; case HEXAHEDRON : *Nbf = NbrFacets_Hexahedron ; return(*Dfe_Hexahedron) ; case PRISM : *Nbf = NbrFacets_Prism ; return(*Dfe_Prism) ; case PYRAMID : *Nbf = NbrFacets_Pyramid ; return(*Dfe_Pyramid) ; case LINE_2 : *Nbf = NbrFacets_Line_2 ; return(NULL) ; case TRIANGLE_2 : *Nbf = NbrFacets_Triangle_2 ; return(*Dfe_Triangle_2) ; case QUADRANGLE_2 :*Nbf = NbrFacets_Quadrangle_2; return(*Dfe_Quadrangle_2) ; case QUADRANGLE_2_8N :*Nbf = NbrFacets_Quadrangle_2_8N; return(*Dfe_Quadrangle_2_8N) ; default : Message::Error("Unknown incidence matrix for element type %d", Type_Element); return(NULL) ; } } /* ------------------------------------------------------------------------ */ /* G e o _ G e t I M _ D f n */ /* ------------------------------------------------------------------------ */ int *Geo_GetIM_Dfn(int Type_Element, int * Nbf) { switch (Type_Element) { case POINT : *Nbf = NbrFacets_Point ; return(NULL) ; case LINE : *Nbf = NbrFacets_Line ; return(NULL) ; case TRIANGLE : *Nbf = NbrFacets_Triangle ; return(*Dfn_Triangle) ; case QUADRANGLE : *Nbf = NbrFacets_Quadrangle ; return(*Dfn_Quadrangle) ; case TETRAHEDRON :*Nbf = NbrFacets_Tetrahedron ; return(*Dfn_Tetrahedron) ; case HEXAHEDRON : *Nbf = NbrFacets_Hexahedron ; return(*Dfn_Hexahedron) ; case PRISM : *Nbf = NbrFacets_Prism ; return(*Dfn_Prism) ; case PYRAMID : *Nbf = NbrFacets_Pyramid ; return(*Dfn_Pyramid) ; case LINE_2 : *Nbf = NbrFacets_Line_2 ; return(NULL) ; case TRIANGLE_2 : *Nbf = NbrFacets_Triangle_2 ; return(*Dfn_Triangle_2) ; case QUADRANGLE_2:*Nbf = NbrFacets_Quadrangle_2; return(*Dfn_Quadrangle_2) ; case QUADRANGLE_2_8N:*Nbf = NbrFacets_Quadrangle_2_8N; return(*Dfn_Quadrangle_2_8N) ; default : Message::Error("Unknown incidence matrix for element type %d", Type_Element); return(NULL) ; } } /* ------------------------------------------------------------------------ */ /* G e o _ G e t I M _ D e n _ X p */ /* ------------------------------------------------------------------------ */ int * Geo_GetIM_Den_Xp(int Type_Element, int * Nbe, int * Nbn) { switch (Type_Element) { case POINT : *Nbe = NbrEdges_Point ; *Nbn = NbrNodes_Point ; return(NULL) ; case LINE : *Nbe = NbrEdges_Line ; *Nbn = NbrNodes_Line ; return(Den_Line_Xp) ; case TRIANGLE : *Nbe = NbrEdges_Triangle ; *Nbn = NbrNodes_Triangle ; return(Den_Triangle_Xp) ; case QUADRANGLE : *Nbe = NbrEdges_Quadrangle ; *Nbn = NbrNodes_Quadrangle ; return(Den_Quadrangle_Xp) ; case TETRAHEDRON : *Nbe = NbrEdges_Tetrahedron ; *Nbn = NbrNodes_Tetrahedron ; return(Den_Tetrahedron_Xp) ; case HEXAHEDRON : *Nbe = NbrEdges_Hexahedron ; *Nbn = NbrNodes_Hexahedron ; return(Den_Hexahedron_Xp) ; case PRISM : *Nbe = NbrEdges_Prism ; *Nbn = NbrNodes_Prism ; return(Den_Prism_Xp) ; case PYRAMID : *Nbe = NbrEdges_Pyramid ; *Nbn = NbrNodes_Pyramid ; return(Den_Pyramid_Xp) ; case LINE_2 : *Nbe = NbrEdges_Line_2 ; *Nbn = NbrNodes_Line_2 ; return(Den_Line_2_Xp) ; case TRIANGLE_2 : *Nbe = NbrEdges_Triangle_2 ; *Nbn = NbrNodes_Triangle_2 ; return(Den_Triangle_2_Xp) ; case QUADRANGLE_2 : *Nbe = NbrEdges_Quadrangle_2 ; *Nbn = NbrNodes_Quadrangle_2 ; return(Den_Quadrangle_2_Xp) ; case QUADRANGLE_2_8N : *Nbe = NbrEdges_Quadrangle_2_8N ; *Nbn = NbrNodes_Quadrangle_2_8N ; return(Den_Quadrangle_2_8N_Xp) ; default : Message::Error("Unknown incidence matrix for element type %d", Type_Element); return(NULL) ; } } /* ------------------------------------------------------------------------ */ /* G e o _ G e t I M _ D f e _ X p */ /* ------------------------------------------------------------------------ */ int * Geo_GetIM_Dfe_Xp(int Type_Element, int * nbf, int * nbe) { switch (Type_Element) { case POINT : *nbf = NbrFacets_Point ; *nbe = NbrEdges_Point ; return(NULL) ; case LINE : *nbf = NbrFacets_Line ; *nbe = NbrEdges_Line ; return(NULL) ; case TRIANGLE : *nbf = NbrFacets_Triangle ; *nbe = NbrEdges_Triangle ; return(Dfe_Triangle_Xp) ; case QUADRANGLE : *nbf = NbrFacets_Quadrangle ; *nbe = NbrEdges_Quadrangle ; return(Dfe_Quadrangle_Xp) ; case TETRAHEDRON : *nbf = NbrFacets_Tetrahedron ; *nbe = NbrEdges_Tetrahedron ; return(Dfe_Tetrahedron_Xp) ; case HEXAHEDRON : *nbf = NbrFacets_Hexahedron ; *nbe = NbrEdges_Hexahedron ; return(Dfe_Hexahedron_Xp) ; case PRISM : *nbf = NbrFacets_Prism ; *nbe = NbrEdges_Prism ; return(Dfe_Prism_Xp) ; case PYRAMID : *nbf = NbrFacets_Pyramid ; *nbe = NbrEdges_Pyramid ; return(Dfe_Pyramid_Xp) ; case LINE_2 : *nbf = NbrFacets_Line_2 ; *nbe = NbrEdges_Line_2 ; return(NULL) ; case TRIANGLE_2 : *nbf = NbrFacets_Triangle_2 ; *nbe = NbrEdges_Triangle_2 ; return(Dfe_Triangle_2_Xp) ; case QUADRANGLE_2 : *nbf = NbrFacets_Quadrangle_2 ; *nbe = NbrEdges_Quadrangle_2 ; return(Dfe_Quadrangle_2_Xp) ; case QUADRANGLE_2_8N : *nbf = NbrFacets_Quadrangle_2_8N ; *nbe = NbrEdges_Quadrangle_2_8N ; return(Dfe_Quadrangle_2_8N_Xp) ; default : Message::Error("Unknown incidence matrix for element type %d", Type_Element); return(NULL) ; } } /* ------------------------------------------------------------------------ */ /* G e o _ C r e a t e E n t i t i e s O f E l e m e n t */ /* ------------------------------------------------------------------------ */ void Geo_CreateEntitiesOfElement (int Nbr_Entities2, int * D_Element, int Geo_Element_NbrEntities1, int * Geo_Element_NumEntities1, int * Geo_Element_NbrEntities2, int ** Geo_Element_NumEntities2, int * Geo_NbrElementsWithEntities2, int * Geo_NumCurrentEntity2, Tree_T * Geo_Entities2XEntities1) { int i, j, Nbr_Entities1, Num_Entities1[NBR_MAX_SUBENTITIES_IN_ELEMENT], Sign_Entity2 ; int * Entity_P, Entity ; struct Entity2XEntity1 Entity2XEntities1, * Entity2XEntities1_P ; *Geo_Element_NbrEntities2 = Nbr_Entities2 ; *Geo_Element_NumEntities2 = (int *)Malloc(Nbr_Entities2 * sizeof(int)) ; (*Geo_NbrElementsWithEntities2)++ ; for (i = 0 ; i < Nbr_Entities2 ; i++) { Entity_P = D_Element + i * NBR_MAX_SUBENTITIES_IN_ELEMENT ; Nbr_Entities1 = 0 ; while ((Entity = *(Entity_P++))) Num_Entities1[Nbr_Entities1++] = (Entity > 0)? Geo_Element_NumEntities1[Entity-1] : - Geo_Element_NumEntities1[-Entity-1] ; qsort(Num_Entities1, Nbr_Entities1, sizeof(int), fcmp_absint) ; if (Num_Entities1[0] < 0) { Sign_Entity2 = -1 ; for (j = 0 ; j < Nbr_Entities1 ; j++) Num_Entities1[j] *= -1 ; } else Sign_Entity2 = 1 ; Entity2XEntities1.NbrEntities = Nbr_Entities1 ; Entity2XEntities1.NumEntities = Num_Entities1 ; if ((Entity2XEntities1_P = (struct Entity2XEntity1*) Tree_PQuery(Geo_Entities2XEntities1, &Entity2XEntities1)) == NULL) { Entity2XEntities1.Num = ++(*Geo_NumCurrentEntity2) ; Entity2XEntities1.NumEntities = (int *)Malloc(Nbr_Entities1*sizeof(int)) ; for (j = 0 ; j < Nbr_Entities1 ; j++) Entity2XEntities1.NumEntities[j] = Num_Entities1[j] ; Tree_Add(Geo_Entities2XEntities1, &Entity2XEntities1) ; (*Geo_Element_NumEntities2)[i] = Entity2XEntities1.Num * Sign_Entity2 ; } else (*Geo_Element_NumEntities2)[i] = Entity2XEntities1_P->Num * Sign_Entity2 ; } } /* ------------------------------------------------------------------------ */ /* f c m p _ E 2 X E 1 */ /* ------------------------------------------------------------------------ */ int fcmp_E2XE1(const void * a, const void * b) { int i ; if (((struct Entity2XEntity1 *)a)->NbrEntities != ((struct Entity2XEntity1 *)b)->NbrEntities) return ((struct Entity2XEntity1 *)a)->NbrEntities - ((struct Entity2XEntity1 *)b)->NbrEntities ; for (i = 0 ; i < ((struct Entity2XEntity1 *)a)->NbrEntities ; i++) { if (((struct Entity2XEntity1 *)a)->NumEntities[i] > ((struct Entity2XEntity1 *)b)->NumEntities[i]) return 1 ; if (((struct Entity2XEntity1 *)a)->NumEntities[i] < ((struct Entity2XEntity1 *)b)->NumEntities[i]) return -1 ; } return 0 ; } /* ------------------------------------------------------------------------ */ /* f r e e _ E 2 X E 1 */ /* ------------------------------------------------------------------------ */ void free_E2XE1(void * a, void *b) { Free(((struct Entity2XEntity1 *)a)->NumEntities); } /* ------------------------------------------------------------------------ */ /* G e o _ W r i t e F i l e P R E */ /* ------------------------------------------------------------------------ */ void Geo_WriteFilePRE(struct GeoData * GeoData_P, List_T * Group_L) { if(Message::GetIsCommWorld() && Message::GetCommRank()) return; int i, Nbr_Elements, j, Index_Group, Nbr_Entities, * Num_Entities ; struct Geo_Element * Geo_Element_P0, * Geo_Element_P ; struct Group * Group_P ; Nbr_Elements = List_Nbr(GeoData_P->Elements) ; /* E l e m e n t s X E d g e s */ if (Nbr_Elements && GeoData_P->NumCurrentEdge) { fprintf(File_PRE, "$ElementsXEdges\n") ; fprintf(File_PRE, "%d %d\n", GeoData_P->Num, GeoData_P->NbrElementsWithEdges) ; Geo_Element_P0 = (struct Geo_Element*)List_Pointer(GeoData_P->Elements, 0) ; for (i = 0 ; i < Nbr_Elements ; i++) { if ((Geo_Element_P0 + i)->NbrEdges) { Geo_Element_P = Geo_Element_P0 + i ; fprintf(File_PRE, "%d %d", i, Geo_Element_P->NbrEdges) ; for (j = 0 ; j < Geo_Element_P->NbrEdges ; j++) fprintf(File_PRE, " %d", Geo_Element_P->NumEdges[j]) ; fprintf(File_PRE, "\n") ; } } fprintf(File_PRE, "$EndElementsXEdges\n") ; if (Flag_XDATA) { fprintf(File_PRE, "$EdgesXNodes /* Never used, only for test */\n") ; fprintf(File_PRE, "%d %d\n", GeoData_P->Num, Tree_Nbr(GeoData_P->EdgesXNodes)) ; Tree_Action(GeoData_P->EdgesXNodes, Geo_WriteEntities2XEntities1) ; fprintf(File_PRE, "$EndEdgesXNodes\n") ; } } /* E l e m e n t s X F a c e t s */ if (Nbr_Elements && GeoData_P->NumCurrentFacet) { fprintf(File_PRE, "$ElementsXFacets\n") ; fprintf(File_PRE, "%d %d\n", GeoData_P->Num, GeoData_P->NbrElementsWithFacets) ; Geo_Element_P0 = (struct Geo_Element*)List_Pointer(GeoData_P->Elements, 0) ; for (i = 0 ; i < Nbr_Elements ; i++) { if ((Geo_Element_P0 + i)->NbrFacets) { Geo_Element_P = Geo_Element_P0 + i ; fprintf(File_PRE, "%d %d", i, Geo_Element_P->NbrFacets) ; for (j = 0 ; j < Geo_Element_P->NbrFacets ; j++) fprintf(File_PRE, " %d", Geo_Element_P->NumFacets[j]) ; fprintf(File_PRE, "\n") ; } } fprintf(File_PRE, "$EndElementsXFacets\n") ; if (Flag_XDATA) { fprintf(File_PRE, "$FacetsXEdges /* Never used, only for test */\n") ; fprintf(File_PRE, "%d %d\n", GeoData_P->Num, Tree_Nbr(GeoData_P->FacetsXEdges)) ; Tree_Action(GeoData_P->FacetsXEdges, Geo_WriteEntities2XEntities1) ; fprintf(File_PRE, "$EndFacetsXEdges\n") ; } } /* E x t e n d e d G r o u p */ if (GeoData_P->GroupForPRE != NULL) { for (i = 0 ; i < List_Nbr(GeoData_P->GroupForPRE) ; i++) { List_Read(GeoData_P->GroupForPRE, i, &Index_Group) ; Group_P = (struct Group*)List_Pointer(Group_L, Index_Group) ; fprintf(File_PRE, "$ExtendedGroup /* %s */\n", Group_P->Name) ; fprintf(File_PRE, "%d %d\n", Index_Group, Nbr_Entities = List_Nbr(Group_P->ExtendedList)) ; if (Nbr_Entities) { Num_Entities = (int*)List_Pointer(Group_P->ExtendedList, 0) ; for (j = 0 ; j < Nbr_Entities ; j++) { fprintf(File_PRE, (j%10)? " %d" : "%d", Num_Entities[j]) ; if (j%10 == 9) fprintf(File_PRE, "\n") ; } if (j%10) fprintf(File_PRE, "\n") ; fprintf(File_PRE, "$EndExtendedGroup\n") ; } } } } /* --------------------------------------------------------- */ /* G e o _ W r i t e E n t i t i e s 2 X E n t i t i e s 1 */ /* --------------------------------------------------------- */ void Geo_WriteEntities2XEntities1(void * a, void * b) { int i ; fprintf(File_PRE, "%d %d", ((struct Entity2XEntity1 *)a)->Num, ((struct Entity2XEntity1 *)a)->NbrEntities) ; for (i = 0 ; i < ((struct Entity2XEntity1 *)a)->NbrEntities ; i++) fprintf(File_PRE, " %d", ((struct Entity2XEntity1 *)a)->NumEntities[i]) ; fprintf(File_PRE, "\n") ; } /* ------------------------------------------------------------------------ */ /* G e o _ R e a d F i l e P R E */ /* ------------------------------------------------------------------------ */ void Geo_ReadFilePRE(struct GeoData * GeoData_P0, int NbrGeoData, List_T * Group_L) { Message::Barrier(); struct GeoData * GeoData_P ; struct Geo_Element * Geo_Element_P0, * Geo_Element_P ; struct Group * Group_P ; int i, Index_Element, Nbr_Entities, j, Index_Group, Num_Entity ; int GeoDataIndex ; char String[256] ; for(GeoDataIndex = 0 ; GeoDataIndex < NbrGeoData ; GeoDataIndex++){ if(!(GeoData_P0 + GeoDataIndex)->Elements){ Message::Warning("No Element in GeoData %d", GeoDataIndex); return; } } while (1) { do { fgets(String, sizeof(String), File_PRE) ; if (feof(File_PRE)) break ; } while (String[0] != '$') ; if (feof(File_PRE)) break ; /* E l e m e n t s X E d g e s */ if (!strncmp(&String[1], "ElementsXEdges", 14)) { fscanf(File_PRE, "%d", &GeoDataIndex) ; if(GeoDataIndex > NbrGeoData-1){ Message::Error("Unknown GeoData: %d", GeoDataIndex); return; } GeoData_P = GeoData_P0 + GeoDataIndex ; Geo_Element_P0 = (struct Geo_Element*)List_Pointer(GeoData_P->Elements, 0) ; fscanf(File_PRE, "%d", &GeoData_P->NbrElementsWithEdges) ; for (i = 0 ; i < GeoData_P->NbrElementsWithEdges ; i++) { fscanf(File_PRE, "%d %d", &Index_Element, &Nbr_Entities) ; Geo_Element_P = Geo_Element_P0 + Index_Element ; Geo_Element_P->NbrEdges = Nbr_Entities ; Geo_Element_P->NumEdges = (int *)Malloc(Nbr_Entities * sizeof(int)) ; for (j = 0 ; j < Geo_Element_P->NbrEdges ; j++) fscanf(File_PRE, "%d", &Geo_Element_P->NumEdges[j]) ; } } /* E l e m e n t s X F a c e t s */ else if (!strncmp(&String[1], "ElementsXFacets", 15)) { fscanf(File_PRE, "%d", &GeoDataIndex) ; if(GeoDataIndex > NbrGeoData-1){ Message::Error("Unknown GeoData: %d", GeoDataIndex); return; } GeoData_P = GeoData_P0 + GeoDataIndex ; Geo_Element_P0 = (struct Geo_Element*)List_Pointer(GeoData_P->Elements, 0) ; fscanf(File_PRE, "%d", &GeoData_P->NbrElementsWithFacets) ; for (i = 0 ; i < GeoData_P->NbrElementsWithFacets ; i++) { fscanf(File_PRE, "%d %d", &Index_Element, &Nbr_Entities) ; Geo_Element_P = Geo_Element_P0 + Index_Element ; Geo_Element_P->NbrFacets = Nbr_Entities ; Geo_Element_P->NumFacets = (int *)Malloc(Nbr_Entities * sizeof(int)) ; for (j = 0 ; j < Geo_Element_P->NbrFacets ; j++) fscanf(File_PRE, "%d", &Geo_Element_P->NumFacets[j]) ; } } /* E x t e n d e d G r o u p */ else if (!strncmp(&String[1], "ExtendedGroup", 13)) { fscanf(File_PRE, "%d %d", &Index_Group, &Nbr_Entities) ; Group_P = (struct Group*)List_Pointer(Group_L, Index_Group) ; Group_P->ExtendedList = List_Create(Nbr_Entities, 1, sizeof(int)) ; for (i = 0 ; i < Nbr_Entities ; i++) { fscanf(File_PRE, "%d", &Num_Entity) ; List_Add(Group_P->ExtendedList, &Num_Entity) ; } } do { fgets(String, sizeof(String), File_PRE) ; if (feof(File_PRE)){ Message::Error("Prematured end of file"); return; } } while (String[0] != '$') ; } /* while 1 ... */ } /* ------------------------------------------------------------------------ */ /* G e o _ A d d G r o u p F o r P R E */ /* ------------------------------------------------------------------------ */ void Geo_AddGroupForPRE(int Num) { if (CurrentGeoData->GroupForPRE == NULL) CurrentGeoData->GroupForPRE = List_Create( 2, 2, sizeof(int)) ; List_Add(CurrentGeoData->GroupForPRE, &Num) ; } getdp-2.7.0-source/Legacy/F_Coord.cpp000644 001750 001750 00000013750 12473553042 021037 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "ProData.h" #include "GeoData.h" #include "F.h" #include "Get_Geometry.h" #include "Message.h" extern struct CurrentData Current ; /* ------------------------------------------------------------------------ */ /* Get a Vector containing the current coordinates */ /* ------------------------------------------------------------------------ */ void F_CoordXYZ(F_ARG) { int i, k ; double X, Y, Z ; if(!Current.Element || Current.Element->Num == NO_ELEMENT){ X = Current.x ; Y = Current.y ; Z = Current.z ; } else{ Get_NodesCoordinatesOfElement(Current.Element) ; Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w) ; X = Y = Z = 0. ; for (i = 0 ; i < Current.Element->GeoElement->NbrNodes ; i++) { X += Current.Element->x[i] * Current.Element->n[i] ; Y += Current.Element->y[i] * Current.Element->n[i] ; Z += Current.Element->z[i] * Current.Element->n[i] ; } } if (Current.NbrHar == 1){ V->Val[0] = X ; V->Val[1] = Y ; V->Val[2] = Z ; } else { for (k = 0 ; k < Current.NbrHar ; k+=2) { V->Val[MAX_DIM* k ] = X ; V->Val[MAX_DIM* k +1] = Y ; V->Val[MAX_DIM* k +2] = Z ; V->Val[MAX_DIM*(k+1) ] = 0. ; V->Val[MAX_DIM*(k+1)+1] = 0. ; V->Val[MAX_DIM*(k+1)+2] = 0. ; } } V->Type = VECTOR ; } void F_CoordXYZS(F_ARG) { int k ; double X, Y, Z ; X = Current.xs ; Y = Current.ys ; Z = Current.zs ; if (Current.NbrHar == 1){ V->Val[0] = X ; V->Val[1] = Y ; V->Val[2] = Z ; } else { for (k = 0 ; k < Current.NbrHar ; k+=2) { V->Val[MAX_DIM* k ] = X ; V->Val[MAX_DIM* k +1] = Y ; V->Val[MAX_DIM* k +2] = Z ; V->Val[MAX_DIM*(k+1) ] = 0. ; V->Val[MAX_DIM*(k+1)+1] = 0. ; V->Val[MAX_DIM*(k+1)+2] = 0. ; } } V->Type = VECTOR ; } /* ------------------------------------------------------------------------ */ /* Get the X, Y or Z coordinate */ /* ------------------------------------------------------------------------ */ #define get_1_coord(name, coord) \ int i, k; \ double tmp; \ \ if(!Current.Element || Current.Element->Num == NO_ELEMENT){ \ tmp = Current.coord ; \ } \ else{ \ Get_NodesCoordinatesOfElement(Current.Element) ; \ Get_BFGeoElement(Current.Element, Current.u, Current.v, Current.w) ; \ tmp = 0. ; \ for (i = 0 ; i < Current.Element->GeoElement->NbrNodes ; i++) { \ tmp += Current.Element->coord[i] * Current.Element->n[i] ; \ } \ } \ if (Current.NbrHar == 1){ \ V->Val[0] = tmp ; \ } \ else { \ for (k = 0 ; k < Current.NbrHar ; k+=2) { \ V->Val[MAX_DIM* k ] = tmp ; \ V->Val[MAX_DIM*(k+1) ] = 0. ; \ } \ } \ V->Type = SCALAR ; void F_CoordX(F_ARG){ get_1_coord("F_CoordX",x) } void F_CoordY(F_ARG){ get_1_coord("F_CoordY",y) } void F_CoordZ(F_ARG){ get_1_coord("F_CoordZ",z) } #undef get_1_coord #define get_1_coord_source(name, coord) \ int k; \ double tmp; \ \ tmp = Current.coord ; \ if (Current.NbrHar == 1){ \ V->Val[0] = tmp ; \ } \ else { \ for (k = 0 ; k < Current.NbrHar ; k+=2) { \ V->Val[MAX_DIM* k ] = tmp ; \ V->Val[MAX_DIM*(k+1) ] = 0. ; \ } \ } \ V->Type = SCALAR ; void F_CoordXS(F_ARG){ get_1_coord_source("F_CoordXS",xs) } void F_CoordYS(F_ARG){ get_1_coord_source("F_CoordYS",ys) } void F_CoordZS(F_ARG){ get_1_coord_source("F_CoordZS",zs) } #undef get_1_coord_source /* ------------------------------------------------------------------------ */ /* a*X + b*Y + c*Z */ /* ------------------------------------------------------------------------ */ void F_aX_bY_cZ(F_ARG) { int k ; double X, Y, Z, tmp ; Geo_GetNodesCoordinates(1, &Current.NumEntity, &X, &Y, &Z) ; if (Current.NbrHar == 1){ V->Val[0] = Fct->Para[0] * X + Fct->Para[1] * Y + Fct->Para[2] * Z ; } else { tmp = Fct->Para[0] * X + Fct->Para[1] * Y + Fct->Para[2] * Z ; for (k = 0 ; k < Current.NbrHar ; k+=2) { V->Val[MAX_DIM* k ] = tmp ; V->Val[MAX_DIM*(k+1) ] = 0. ; } } V->Type = SCALAR ; } /* ------------------------------------------------------------------------ */ /* a*(X2-X1) + b*(Y2-Y1) + c*(Z2-Z1) */ /* ------------------------------------------------------------------------ */ void F_aX21_bY21_cZ21 (F_ARG) { int k, * NumNodes ; double X1, Y1, Z1, X2, Y2, Z2, tmp ; if(!Current.Element || Current.Element->Num == NO_ELEMENT) Message::Error("No element on which to perform F_aX21_bY21_cZ21"); NumNodes = Geo_GetNodesOfEdgeInElement (Current.Element->GeoElement, Current.NumEntityInElement) ; Get_NodesCoordinatesOfElement(Current.Element) ; X1 = Current.Element->x[abs(NumNodes[0])-1] ; Y1 = Current.Element->y[abs(NumNodes[0])-1] ; Z1 = Current.Element->z[abs(NumNodes[0])-1] ; X2 = Current.Element->x[abs(NumNodes[1])-1] ; Y2 = Current.Element->y[abs(NumNodes[1])-1] ; Z2 = Current.Element->z[abs(NumNodes[1])-1] ; tmp = Fct->Para[0] * (X2-X1) + Fct->Para[1] * (Y2-Y1) + Fct->Para[2] * (Z2-Z1) ; if (Current.Element->GeoElement->NumEdges[Current.NumEntityInElement] < 0) tmp *= -1. ; if (Current.NbrHar == 1){ V->Val[0] = tmp ; } else { for (k = 0 ; k < Current.NbrHar ; k+=2) { V->Val[MAX_DIM* k ] = tmp ; V->Val[MAX_DIM*(k+1) ] = 0. ; } } V->Type = SCALAR ; } getdp-2.7.0-source/Legacy/Get_ElementSource.h000644 001750 001750 00000000764 12473553042 022543 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _GET_ELEMENT_SOURCE_H_ #define _GET_ELEMENT_SOURCE_H_ #include "ProData.h" void Get_InitElementSource(struct Element *Element, int InIndex); int Get_NextElementSource(struct Element *ElementSource); void Get_ElementTrace(struct Element *Element, int InIndex); #endif getdp-2.7.0-source/Legacy/Gauss_Triangle.cpp000644 001750 001750 00000006561 12473553042 022435 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "Gauss.h" #include "Gauss_Triangle.h" #include "Message.h" #include "MallocUtils.h" /* Gauss Integration over a triangle */ void Gauss_Triangle(int Nbr_Points, int Num, double *u, double *v, double *w, double *wght) { switch (Nbr_Points) { case 1 : *u= xt1 [Num] ; *v= yt1 [Num] ; *w= 0. ; *wght= pt1 [Num] ; break ; case 3 : *u= xt3 [Num] ; *v= yt3 [Num] ; *w= 0. ; *wght= pt3 [Num] ; break ; case 4 : *u= xt4 [Num] ; *v= yt4 [Num] ; *w= 0. ; *wght= pt4 [Num] ; break ; case 6 : *u= xt6 [Num] ; *v= yt6 [Num] ; *w= 0. ; *wght= pt6 [Num] ; break ; case 7 : *u= xt7 [Num] ; *v= yt7 [Num] ; *w= 0. ; *wght= pt7 [Num] ; break ; case 12 : *u= xt12[Num] ; *v= yt12[Num] ; *w= 0. ; *wght= pt12[Num] ; break ; case 13 : *u= xt13[Num] ; *v= yt13[Num] ; *w= 0. ; *wght= pt13[Num] ; break ; case 16 : *u= xt16[Num] ; *v= yt16[Num] ; *w= 0. ; *wght= pt16[Num] ; break ; default : Message::Error("Wrong number of Gauss points for Triangle: " "valid choices: 1, 3, 4, 6, 7, 12, 13, 16"); break; } } /* Degenerate n1Xn2 Gauss-Legendre scheme to integrate over a tri */ static int glt[MAX_LINE_POINTS] = {-1}; static double *glxt[MAX_LINE_POINTS], *glyt[MAX_LINE_POINTS], *glpt[MAX_LINE_POINTS]; static void quadToTri(double xi,double eta,double *r, double *s, double *J) { double r1; *r = 0.5e0 * (1.0e0 + xi); r1 = 1.0e0 - (*r); *s = 0.5e0 * (1.0e0 + eta) * r1; *J = 0.25e0 * r1; } void GaussLegendre_Triangle(int Nbr_Points, int Num, double *u, double *v, double *w, double *wght) { int i,j,index=0,nb; double pt1,pt2,wt1,wt2,dJ,dum; nb = (int)sqrt((double)Nbr_Points); if(nb*nb != Nbr_Points || nb > MAX_LINE_POINTS){ Message::Error("Number of points should be n^2 with n in [1,%d]", MAX_LINE_POINTS) ; return; } if(glt[0] < 0) for(i=0 ; i < MAX_LINE_POINTS ; i++) glt[i] = 0 ; if(!glt[nb - 1]){ Message::Info("Computing degenerate GaussLegendre %dX%d for Triangle", nb, nb); glxt[nb - 1] = (double*)Malloc(Nbr_Points * sizeof(double)); glyt[nb - 1] = (double*)Malloc(Nbr_Points * sizeof(double)); glpt[nb - 1] = (double*)Malloc(Nbr_Points * sizeof(double)); for(i = 0; i < nb; i++) { Gauss_Line(nb, i, &pt1, &dum, &dum, &wt1); for(j = 0; j < nb; j++) { Gauss_Line(nb, j, &pt2, &dum, &dum, &wt2); quadToTri(pt1, pt2, &glxt[nb - 1][index], &glyt[nb - 1][index], &dJ); glpt[nb - 1][index++] = dJ * wt1 * wt2; } } glt[nb - 1] = 1; } *u = glxt[nb - 1][Num] ; *v = glyt[nb - 1][Num] ; *w = 0. ; *wght = glpt[nb - 1][Num] ; } /* Gauss Integration over a triangle with a 1/R singularity over node (0,0,0) */ void GaussSingularR_Triangle(int Nbr_Points, int Num, double *u, double *v, double *w, double *wght) { switch (Nbr_Points) { case 1 : *u= xts1 [Num] ; *v= yts1 [Num] ; *w= 0. ; *wght= pts1 [Num] ; break ; case 3 : *u= xts3 [Num] ; *v= yts3 [Num] ; *w= 0. ; *wght= pts3 [Num] ; break ; case 4 : *u= xts4 [Num] ; *v= yts4 [Num] ; *w= 0. ; *wght= pts4 [Num] ; break ; default : Message::Error("Wrong number of (modified) Gauss points for Triangle: " "valid choices: 1, 3, 4"); break; } } getdp-2.7.0-source/Numeric/Adapt.h000644 001750 001750 00000001223 12473553040 020406 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _ADAPT_H_ #define _ADAPT_H_ #define P1 1 #define P2 2 #define H1 3 #define H2 4 double Adapt (int N, /* Number of elements */ int method, /* H1, H2, P1 or P2 */ int dim, /* 2 or 3 */ double *err, /* elementary errors */ double *h, /* elementary mesh sizes */ double *p, /* elementary exponents */ double e0); /* prescribed error or number of elements */ #endif getdp-2.7.0-source/Numeric/Legendre.h000644 001750 001750 00000001350 12473553040 021103 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _LEGENDRE_H_ #define _LEGENDRE_H_ double Factorial(double n) ; double BinomialCoef( double n, double m ) ; double Legendre(int l, int m, double x) ; void LegendreRecursive(int l, int m, double x, double P[]) ; void LegendreRecursiveM(int l, double x, double P[]) ; double dLegendre (int l, int m, double x) ; double dLegendreFinDif (int l, int m, double x) ; void PrintLegendre(int l, int m, double x, char * FileName); void SphericalHarmonics(int l, int m, double Theta, double Phi, double Yl_m[]); #endif getdp-2.7.0-source/Numeric/Legendre.cpp000644 001750 001750 00000011534 12473553040 021443 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Ruth Sabariego // #include #include #include "Message.h" #define THESIGN(a) ((a)>=0 ? 1 : -1) #define THEABS(a) ((a)>=0 ? a : -a) #define ONE_OVER_FOUR_PI 7.9577471545947668E-02 double Factorial(double n) { /* FACTORIAL(n) is the product of all the integers from 1 to n */ double F ; if ( n < 0 ){ Message::Error("Factorial(n): n must be a positive integer") ; return 0; } if ( n == 0 ) return 1. ; if ( n <= 2 ) return n ; F = n ; while ( n > 2 ){ n-- ; F *= n ; } return F; } double BinomialCoef(double n, double m) { /* Binomial Coefficients: (n m) Computes de number of ways of choosing m objects from a collection of n distinct objects */ int i ; double B = 1. ; if (m==0 || n==m) return 1. ; for(i = (int)n ; i > m ; i--) B *= (double)i/(double)(i-m); return B; } double Legendre(int l, int m, double x) { /* Computes the associated Legendre polynomial P_l^m(x). Here the degree l and the order m are the integers satisfying -l<=m<=l, while x lies in the range -1<=x<=1 */ double fact, pll=0., pmm, pmmp1, somx2, Cte ; int i, ll; if ( THEABS(m) > l || fabs(x) > 1.){ Message::Error("Bad arguments for Legendre: P_l^m(x) with -l<=m<=l (int)," " -1<=x<=1 l = %d m = %d x = %.8g", l, m, x); return 0.; } Cte = (m > 0) ? 1. : Factorial((double)(l-THEABS(m))) / Factorial((double)(l+THEABS(m))) * pow(-1.,(double)THEABS(m)) ; m = THEABS(m) ; pmm = 1. ; if (m > 0) { somx2 = sqrt((1.-x)*(1.+x)) ; fact = 1. ; for (i=1;i<=m;i++){ pmm *= -fact*somx2 ; fact += 2. ; } } if (l==m){ return Cte*pmm ; } else { pmmp1 = x * (2*m+1)*pmm ; if (l==(m+1)){ return Cte*pmmp1 ; } else { for (ll=(m+2);ll<=l;ll++) { pll = (x*(2*ll-1)*pmmp1-(ll+m-1)*pmm)/(ll-m) ; pmm = pmmp1 ; pmmp1 = pll ; } return Cte*pll ; } } } void LegendreRecursive(int l, int m, double x, double P[]) { /* Computes recursively a (l+1)-terms sequence of the associated Legendre polynomial P_l^m(x). l and m are the integers satisfying 0<=m<=l x lies in the range -1<=x<=1 l = maximum order considered, m = invariable */ int il ; double Pl_m, Plm1_m ; P[0] = Plm1_m = Legendre(0, m, x) ; P[1] = Pl_m = Legendre(1, m, x) ; if (l >=2) for(il = 1 ; il < l ; il ++){ P[il+1] = (2*il+1)*x*Pl_m/(il-m+1) + (il+m)*Plm1_m/(m-il-1) ; Plm1_m = Pl_m ; Pl_m = P[il+1]; } } void LegendreRecursiveM(int l, double x, double P[]) { /* Computes recursively a (l+1)-terms sequence of the associated Legendre polynomial P_l^m(x). x lies in the range -1<=x<=1, l = invariable, -l<=m<=l */ int m ; double Pl_m, Plm1_m ; if (fabs(x) == 1.) for(m = -l ; m <= l ; m ++) P[l+m] = (m==0) ? pow(THESIGN(x),(double)l) : 0. ; else{ if (l==0){ P[0] = Legendre(0, 0, x) ; return; } P[0] = Plm1_m = Legendre(l, -l, x) ; P[1] = Pl_m = Legendre(l, -l+1, x) ; if (l >= 1) for(m = -l+1 ; m < l ; m ++){ P[l+m+1] = -2*m*x*Pl_m/sqrt(1-x*x) + (m*(m-1)-l*(l+1))*Plm1_m ; Plm1_m = Pl_m ; Pl_m = P[l+m+1]; } else return ; } } double dLegendre (int l, int m, double x) { /* Computes the derivative of the associated Legendre polynomial P_l^m(x) */ double dpl; if ( THEABS(m) > l || fabs(x) > 1.){ Message::Error("Bad arguments for dLegendre: -l<=m<=l (integers), -1<=x<=1." " Current values: l %d m %d x %.8g", l, m, x) ; return 0.; } if (fabs(x)==1.) dpl = 0.; else dpl = ((l+m)*(l-m+1)*sqrt(1-x*x)*((THEABS((m-1))>l) ? 0. : Legendre(l, m-1, x)) + m*x* Legendre (l,m,x))/(1-x*x); return dpl; } double dLegendreFinDif (int l, int m, double x) { /* Computes the derivative of the associated Legendre polynomial P_l^m(x) using Finite Differences: f'(x) = (f(x+\delta x)-f(x-\delta x))/(2 \delta) */ double dpl, delta = 1e-6; if ( THEABS(m) > l || fabs(x) > 1.){ Message::Error("Bad arguments for dLegendreFinDif: -l<=m<=l (integers), " "-1<=x<=1. Current values: l %d m %d x %.8g", l, m, x ); return 0.; } dpl = (Legendre (l, m, x+delta) - Legendre (l, m, x-delta))/(2*delta); return dpl; } void SphericalHarmonics(int l, int m, double Theta, double Phi, double Yl_m[]) { int am ; double cn, Pl_m, F, cRe ; cn = sqrt((2*l+1)*ONE_OVER_FOUR_PI) ; /* Normalization Factor */ am = THESIGN(m)*m ; F= sqrt(Factorial((double)(l-am))/ Factorial((double)(l+am))) ; Pl_m = Legendre(l, am, cos(Theta)); cRe = cn * F * Pl_m ; Yl_m[0] = cRe*cos(m*Phi) ; Yl_m[1] = cRe*sin(m*Phi) ; } getdp-2.7.0-source/Numeric/NumericUtils.h000644 001750 001750 00000001113 12473553040 021776 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _NUMERIC_UTILS_H_ #define _NUMERIC_UTILS_H_ // Numerical routines implemented using either the GSL or Numerical Recipes double brent(double ax, double bx, double cx, double (*f)(double), double tol, double *xmin); void mnbrak(double *ax, double *bx, double *cx, double *fa, double *fb, double *fc, double (*func)(double)); #endif getdp-2.7.0-source/Numeric/BesselLib.f000644 001750 001750 00001067512 11266605602 021236 0ustar00geuzainegeuzaine000000 000000 REAL FUNCTION R1MACH(I) INTEGER I C C SINGLE-PRECISION MACHINE CONSTANTS C R1MACH(1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE. C R1MACH(2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE. C R1MACH(3) = B**(-T), THE SMALLEST RELATIVE SPACING. C R1MACH(4) = B**(1-T), THE LARGEST RELATIVE SPACING. C R1MACH(5) = LOG10(B) C C THIS VERSION ADAPTS AUTOMATICALLY TO MOST CURRENT MACHINES, C INCLUDING AUTO-DOUBLE COMPILERS. C TO ALTER FOR A PARTICULAR ENVIRONMENT, THE DESIRED SET OF DATA C STATEMENTS MAY BE ACTIVATED BY REMOVING THE C FROM COLUMN 1. C CONSTANTS FOR OLDER MACHINES CAN BE OBTAINED BY C mail netlib@research.bell-labs.com C send old1mach from blas C PLEASE SEND CORRECTIONS TO dmg OR ehg@bell-labs.com. C INTEGER SMALL(2) INTEGER LARGE(2) INTEGER RIGHT(2) INTEGER DIVER(2) INTEGER LOG10(2) INTEGER SC SAVE SMALL, LARGE, RIGHT, DIVER, LOG10, SC REAL RMACH(5) EQUIVALENCE (RMACH(1),SMALL(1)) EQUIVALENCE (RMACH(2),LARGE(1)) EQUIVALENCE (RMACH(3),RIGHT(1)) EQUIVALENCE (RMACH(4),DIVER(1)) EQUIVALENCE (RMACH(5),LOG10(1)) INTEGER J, K, L, T3E(3) DATA T3E(1) / 9777664 / DATA T3E(2) / 5323660 / DATA T3E(3) / 46980 / C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES. C DATA RMACH(1) / O402400000000 / C DATA RMACH(2) / O376777777777 / C DATA RMACH(3) / O714400000000 / C DATA RMACH(4) / O716400000000 / C DATA RMACH(5) / O776464202324 /, SC/987/ C C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING C 32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). C DATA SMALL(1) / 8388608 / C DATA LARGE(1) / 2147483647 / C DATA RIGHT(1) / 880803840 / C DATA DIVER(1) / 889192448 / C DATA LOG10(1) / 1067065499 /, SC/987/ C DATA RMACH(1) / O00040000000 / C DATA RMACH(2) / O17777777777 / C DATA RMACH(3) / O06440000000 / C DATA RMACH(4) / O06500000000 / C DATA RMACH(5) / O07746420233 /, SC/987/ C C MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000. C DATA SMALL(1) / $00800000 / C DATA LARGE(1) / $7F7FFFFF / C DATA RIGHT(1) / $33800000 / C DATA DIVER(1) / $34000000 / C DATA LOG10(1) / $3E9A209B /, SC/987/ C C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. C DATA RMACH(1) / O000400000000 / C DATA RMACH(2) / O377777777777 / C DATA RMACH(3) / O146400000000 / C DATA RMACH(4) / O147400000000 / C DATA RMACH(5) / O177464202324 /, SC/987/ C IF (SC .NE. 987) THEN * *** CHECK FOR AUTODOUBLE *** SMALL(2) = 0 RMACH(1) = 1E13 IF (SMALL(2) .NE. 0) THEN * *** AUTODOUBLED *** IF ( SMALL(1) .EQ. 1117925532 * .AND. SMALL(2) .EQ. -448790528) THEN * *** IEEE BIG ENDIAN *** SMALL(1) = 1048576 SMALL(2) = 0 LARGE(1) = 2146435071 LARGE(2) = -1 RIGHT(1) = 1017118720 RIGHT(2) = 0 DIVER(1) = 1018167296 DIVER(2) = 0 LOG10(1) = 1070810131 LOG10(2) = 1352628735 ELSE IF ( SMALL(2) .EQ. 1117925532 * .AND. SMALL(1) .EQ. -448790528) THEN * *** IEEE LITTLE ENDIAN *** SMALL(2) = 1048576 SMALL(1) = 0 LARGE(2) = 2146435071 LARGE(1) = -1 RIGHT(2) = 1017118720 RIGHT(1) = 0 DIVER(2) = 1018167296 DIVER(1) = 0 LOG10(2) = 1070810131 LOG10(1) = 1352628735 ELSE IF ( SMALL(1) .EQ. -2065213935 * .AND. SMALL(2) .EQ. 10752) THEN * *** VAX WITH D_FLOATING *** SMALL(1) = 128 SMALL(2) = 0 LARGE(1) = -32769 LARGE(2) = -1 RIGHT(1) = 9344 RIGHT(2) = 0 DIVER(1) = 9472 DIVER(2) = 0 LOG10(1) = 546979738 LOG10(2) = -805796613 ELSE IF ( SMALL(1) .EQ. 1267827943 * .AND. SMALL(2) .EQ. 704643072) THEN * *** IBM MAINFRAME *** SMALL(1) = 1048576 SMALL(2) = 0 LARGE(1) = 2147483647 LARGE(2) = -1 RIGHT(1) = 856686592 RIGHT(2) = 0 DIVER(1) = 873463808 DIVER(2) = 0 LOG10(1) = 1091781651 LOG10(2) = 1352628735 ELSE WRITE(*,9010) STOP 777 END IF ELSE RMACH(1) = 1234567. IF (SMALL(1) .EQ. 1234613304) THEN * *** IEEE *** SMALL(1) = 8388608 LARGE(1) = 2139095039 RIGHT(1) = 864026624 DIVER(1) = 872415232 LOG10(1) = 1050288283 ELSE IF (SMALL(1) .EQ. -1271379306) THEN * *** VAX *** SMALL(1) = 128 LARGE(1) = -32769 RIGHT(1) = 13440 DIVER(1) = 13568 LOG10(1) = 547045274 ELSE IF (SMALL(1) .EQ. 1175639687) THEN * *** IBM MAINFRAME *** SMALL(1) = 1048576 LARGE(1) = 2147483647 RIGHT(1) = 990904320 DIVER(1) = 1007681536 LOG10(1) = 1091781651 ELSE IF (SMALL(1) .EQ. 1251390520) THEN * *** CONVEX C-1 *** SMALL(1) = 8388608 LARGE(1) = 2147483647 RIGHT(1) = 880803840 DIVER(1) = 889192448 LOG10(1) = 1067065499 ELSE DO 10 L = 1, 3 J = SMALL(1) / 10000000 K = SMALL(1) - 10000000*J IF (K .NE. T3E(L)) GO TO 20 SMALL(1) = J 10 CONTINUE * *** CRAY T3E *** CALL I1MT3E(SMALL, 16, 0, 0) CALL I1MT3E(LARGE, 32751, 16777215, 16777215) CALL I1MT3E(RIGHT, 15520, 0, 0) CALL I1MT3E(DIVER, 15536, 0, 0) CALL I1MT3E(LOG10, 16339, 4461392, 10451455) GO TO 30 20 CALL I1MCRA(J, K, 16405, 9876536, 0) IF (SMALL(1) .NE. J) THEN WRITE(*,9020) STOP 777 END IF * *** CRAY 1, XMP, 2, AND 3 *** CALL I1MCRA(SMALL(1), K, 8195, 8388608, 0) CALL I1MCRA(LARGE(1), K, 24574, 16777215, 16777214) CALL I1MCRA(RIGHT(1), K, 16338, 8388608, 0) CALL I1MCRA(DIVER(1), K, 16339, 8388608, 0) CALL I1MCRA(LOG10(1), K, 16383, 10100890, 8715216) END IF END IF 30 SC = 987 END IF * SANITY CHECK IF (RMACH(4) .GE. 1.0) STOP 776 IF (I .LT. 1 .OR. I .GT. 5) THEN WRITE(*,*) 'R1MACH(I): I =',I,' is out of bounds.' STOP END IF R1MACH = RMACH(I) RETURN 9010 FORMAT(/' Adjust autodoubled R1MACH by getting data'/ *' appropriate for your machine from D1MACH.') 9020 FORMAT(/' Adjust R1MACH by uncommenting data statements'/ *' appropriate for your machine.') * /* C source for R1MACH -- remove the * in column 1 */ *#include *#include *#include *float r1mach_(long *i) *{ * switch(*i){ * case 1: return FLT_MIN; * case 2: return FLT_MAX; * case 3: return FLT_EPSILON/FLT_RADIX; * case 4: return FLT_EPSILON; * case 5: return log10(FLT_RADIX); * } * fprintf(stderr, "invalid argument: r1mach(%ld)\n", *i); * exit(1); return 0; /* else complaint of missing return value */ *} END SUBROUTINE I1MT3E(A, B, C, D) **** SPECIAL COMPUTATION FOR CRAY T3E **** **** 64-BIT INTEGERS, "REAL" = IEEE DOUBLE **** INTEGER A(2), B, C, D A(2) = 16777216*B + C A(1) = 16777216*A(1) + D END SUBROUTINE I1MCRA(A, A1, B, C, D) **** SPECIAL COMPUTATION FOR OLD CRAY MACHINES **** INTEGER A, A1, B, C, D A1 = 16777216*B + C A = 16777216*A1 + D END c----------------------------------------------------------------------- c----------------------------------------------------------------------- DOUBLE PRECISION FUNCTION D1MACH(I) INTEGER I C C DOUBLE-PRECISION MACHINE CONSTANTS C D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE. C D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE. C D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING. C D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING. C D1MACH( 5) = LOG10(B) C C THIS VERSION ADAPTS AUTOMATICALLY TO MOST CURRENT MACHINES. C R1MACH CAN HANDLE AUTO-DOUBLE COMPILING, BUT THIS VERSION OF C D1MACH DOES NOT, BECAUSE WE DO NOT HAVE QUAD CONSTANTS FOR C MANY MACHINES YET. C TO ALTER FOR A PARTICULAR ENVIRONMENT, THE DESIRED SET OF DATA C STATEMENTS MAY BE ACTIVATED BY REMOVING THE C FROM COLUMN 1. C CONSTANTS FOR OLDER MACHINES CAN BE OBTAINED BY C mail netlib@research.bell-labs.com C send old1mach from blas C PLEASE SEND CORRECTIONS TO dmg OR ehg@bell-labs.com. C INTEGER SMALL(2) INTEGER LARGE(2) INTEGER RIGHT(2) INTEGER DIVER(2) INTEGER LOG10(2) INTEGER SC, CRAY1(38), J COMMON /D9MACH/ CRAY1 SAVE SMALL, LARGE, RIGHT, DIVER, LOG10, SC DOUBLE PRECISION DMACH(5) EQUIVALENCE (DMACH(1),SMALL(1)) EQUIVALENCE (DMACH(2),LARGE(1)) EQUIVALENCE (DMACH(3),RIGHT(1)) EQUIVALENCE (DMACH(4),DIVER(1)) EQUIVALENCE (DMACH(5),LOG10(1)) C C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES. C DATA SMALL(1),SMALL(2) / O402400000000, O000000000000 / C DATA LARGE(1),LARGE(2) / O376777777777, O777777777777 / C DATA RIGHT(1),RIGHT(2) / O604400000000, O000000000000 / C DATA DIVER(1),DIVER(2) / O606400000000, O000000000000 / C DATA LOG10(1),LOG10(2) / O776464202324, O117571775714 /, SC/987/ C C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING C 32-BIT INTEGERS. C DATA SMALL(1),SMALL(2) / 8388608, 0 / C DATA LARGE(1),LARGE(2) / 2147483647, -1 / C DATA RIGHT(1),RIGHT(2) / 612368384, 0 / C DATA DIVER(1),DIVER(2) / 620756992, 0 / C DATA LOG10(1),LOG10(2) / 1067065498, -2063872008 /, SC/987/ C C MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000 C DATA SMALL(1),SMALL(2) / $00000000, $00100000 / C DATA LARGE(1),LARGE(2) / $FFFFFFFF, $7FEFFFFF / C DATA RIGHT(1),RIGHT(2) / $00000000, $3CA00000 / C DATA DIVER(1),DIVER(2) / $00000000, $3CB00000 / C DATA LOG10(1),LOG10(2) / $509F79FF, $3FD34413 /, SC/987/ C C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. C DATA SMALL(1),SMALL(2) / O000040000000, O000000000000 / C DATA LARGE(1),LARGE(2) / O377777777777, O777777777777 / C DATA RIGHT(1),RIGHT(2) / O170540000000, O000000000000 / C DATA DIVER(1),DIVER(2) / O170640000000, O000000000000 / C DATA LOG10(1),LOG10(2) / O177746420232, O411757177572 /, SC/987/ C C ON FIRST CALL, IF NO DATA UNCOMMENTED, TEST MACHINE TYPES. IF (SC .NE. 987) THEN DMACH(1) = 1.D13 IF ( SMALL(1) .EQ. 1117925532 * .AND. SMALL(2) .EQ. -448790528) THEN * *** IEEE BIG ENDIAN *** SMALL(1) = 1048576 SMALL(2) = 0 LARGE(1) = 2146435071 LARGE(2) = -1 RIGHT(1) = 1017118720 RIGHT(2) = 0 DIVER(1) = 1018167296 DIVER(2) = 0 LOG10(1) = 1070810131 LOG10(2) = 1352628735 ELSE IF ( SMALL(2) .EQ. 1117925532 * .AND. SMALL(1) .EQ. -448790528) THEN * *** IEEE LITTLE ENDIAN *** SMALL(2) = 1048576 SMALL(1) = 0 LARGE(2) = 2146435071 LARGE(1) = -1 RIGHT(2) = 1017118720 RIGHT(1) = 0 DIVER(2) = 1018167296 DIVER(1) = 0 LOG10(2) = 1070810131 LOG10(1) = 1352628735 ELSE IF ( SMALL(1) .EQ. -2065213935 * .AND. SMALL(2) .EQ. 10752) THEN * *** VAX WITH D_FLOATING *** SMALL(1) = 128 SMALL(2) = 0 LARGE(1) = -32769 LARGE(2) = -1 RIGHT(1) = 9344 RIGHT(2) = 0 DIVER(1) = 9472 DIVER(2) = 0 LOG10(1) = 546979738 LOG10(2) = -805796613 ELSE IF ( SMALL(1) .EQ. 1267827943 * .AND. SMALL(2) .EQ. 704643072) THEN * *** IBM MAINFRAME *** SMALL(1) = 1048576 SMALL(2) = 0 LARGE(1) = 2147483647 LARGE(2) = -1 RIGHT(1) = 856686592 RIGHT(2) = 0 DIVER(1) = 873463808 DIVER(2) = 0 LOG10(1) = 1091781651 LOG10(2) = 1352628735 ELSE IF ( SMALL(1) .EQ. 1120022684 * .AND. SMALL(2) .EQ. -448790528) THEN * *** CONVEX C-1 *** SMALL(1) = 1048576 SMALL(2) = 0 LARGE(1) = 2147483647 LARGE(2) = -1 RIGHT(1) = 1019215872 RIGHT(2) = 0 DIVER(1) = 1020264448 DIVER(2) = 0 LOG10(1) = 1072907283 LOG10(2) = 1352628735 ELSE IF ( SMALL(1) .EQ. 815547074 * .AND. SMALL(2) .EQ. 58688) THEN * *** VAX G-FLOATING *** SMALL(1) = 16 SMALL(2) = 0 LARGE(1) = -32769 LARGE(2) = -1 RIGHT(1) = 15552 RIGHT(2) = 0 DIVER(1) = 15568 DIVER(2) = 0 LOG10(1) = 1142112243 LOG10(2) = 2046775455 ELSE DMACH(2) = 1.D27 + 1 DMACH(3) = 1.D27 LARGE(2) = LARGE(2) - RIGHT(2) IF (LARGE(2) .EQ. 64 .AND. SMALL(2) .EQ. 0) THEN CRAY1(1) = 67291416 DO 10 J = 1, 20 10 CRAY1(J+1) = CRAY1(J) + CRAY1(J) CRAY1(22) = CRAY1(21) + 321322 DO 20 J = 22, 37 20 CRAY1(J+1) = CRAY1(J) + CRAY1(J) IF (CRAY1(38) .EQ. SMALL(1)) THEN * *** CRAY *** CALL I1MCRY(SMALL(1), J, 8285, 8388608, 0) SMALL(2) = 0 CALL I1MCRY(LARGE(1), J, 24574, 16777215, 16777215) CALL I1MCRY(LARGE(2), J, 0, 16777215, 16777214) CALL I1MCRY(RIGHT(1), J, 16291, 8388608, 0) RIGHT(2) = 0 CALL I1MCRY(DIVER(1), J, 16292, 8388608, 0) DIVER(2) = 0 CALL I1MCRY(LOG10(1), J, 16383, 10100890, 8715215) CALL I1MCRY(LOG10(2), J, 0, 16226447, 9001388) ELSE WRITE(*,9000) STOP 779 END IF ELSE WRITE(*,9000) STOP 779 END IF END IF SC = 987 END IF * SANITY CHECK IF (DMACH(4) .GE. 1.0D0) STOP 778 IF (I .LT. 1 .OR. I .GT. 5) THEN WRITE(*,*) 'D1MACH(I): I =',I,' is out of bounds.' STOP END IF D1MACH = DMACH(I) RETURN 9000 FORMAT(/' Adjust D1MACH by uncommenting data statements'/ *' appropriate for your machine.') * /* Standard C source for D1MACH -- remove the * in column 1 */ *#include *#include *#include *double d1mach_(long *i) *{ * switch(*i){ * case 1: return DBL_MIN; * case 2: return DBL_MAX; * case 3: return DBL_EPSILON/FLT_RADIX; * case 4: return DBL_EPSILON; * case 5: return log10(FLT_RADIX); * } * fprintf(stderr, "invalid argument: d1mach(%ld)\n", *i); * exit(1); return 0; /* some compilers demand return values */ *} END SUBROUTINE I1MCRY(A, A1, B, C, D) **** SPECIAL COMPUTATION FOR OLD CRAY MACHINES **** INTEGER A, A1, B, C, D A1 = 16777216*B + C A = 16777216*A1 + D END c----------------------------------------------------------------------- c----------------------------------------------------------------------- INTEGER FUNCTION I1MACH(I) INTEGER I C C I1MACH( 1) = THE STANDARD INPUT UNIT. C I1MACH( 2) = THE STANDARD OUTPUT UNIT. C I1MACH( 3) = THE STANDARD PUNCH UNIT. C I1MACH( 4) = THE STANDARD ERROR MESSAGE UNIT. C I1MACH( 5) = THE NUMBER OF BITS PER INTEGER STORAGE UNIT. C I1MACH( 6) = THE NUMBER OF CHARACTERS PER CHARACTER STORAGE UNIT. C INTEGERS HAVE FORM SIGN ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) ) C I1MACH( 7) = A, THE BASE. C I1MACH( 8) = S, THE NUMBER OF BASE-A DIGITS. C I1MACH( 9) = A**S - 1, THE LARGEST MAGNITUDE. C FLOATS HAVE FORM SIGN (B**E)*( (X(1)/B) + ... + (X(T)/B**T) ) C WHERE EMIN .LE. E .LE. EMAX. C I1MACH(10) = B, THE BASE. C SINGLE-PRECISION C I1MACH(11) = T, THE NUMBER OF BASE-B DIGITS. C I1MACH(12) = EMIN, THE SMALLEST EXPONENT E. C I1MACH(13) = EMAX, THE LARGEST EXPONENT E. C DOUBLE-PRECISION C I1MACH(14) = T, THE NUMBER OF BASE-B DIGITS. C I1MACH(15) = EMIN, THE SMALLEST EXPONENT E. C I1MACH(16) = EMAX, THE LARGEST EXPONENT E. C INTEGER IMACH(16), OUTPUT, SANITY, SMALL(2) SAVE IMACH, SANITY REAL RMACH EQUIVALENCE (IMACH(4),OUTPUT), (RMACH,SMALL(1)) INTEGER J, K, T3E(3) DATA T3E(1) / 9777664 / DATA T3E(2) / 5323660 / DATA T3E(3) / 46980 / C C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 43 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 35 / C DATA IMACH( 9) / O377777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 27 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 63 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING C 32-BIT INTEGER ARITHMETIC. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 56 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000. C C DATA IMACH( 1) / 0 / C DATA IMACH( 2) / 0 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 0 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 1 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -125 / C DATA IMACH(13) / 128 / C DATA IMACH(14) / 53 / C DATA IMACH(15) / -1021 / C DATA IMACH(16) / 1024 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. C C NOTE THAT THE PUNCH UNIT, I1MACH(3), HAS BEEN SET TO 7 C WHICH IS APPROPRIATE FOR THE UNIVAC-FOR SYSTEM. C IF YOU HAVE THE UNIVAC-FTN SYSTEM, SET IT TO 1. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 6 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 35 / C DATA IMACH( 9) / O377777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 27 / C DATA IMACH(12) / -128 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 60 / C DATA IMACH(15) /-1024 / C DATA IMACH(16) / 1023 /, SANITY/987/ C IF (SANITY .NE. 987) THEN * *** CHECK FOR AUTODOUBLE *** SMALL(2) = 0 RMACH = 1E13 IF (SMALL(2) .NE. 0) THEN * *** AUTODOUBLED *** IF ( (SMALL(1) .EQ. 1117925532 * .AND. SMALL(2) .EQ. -448790528) * .OR. (SMALL(2) .EQ. 1117925532 * .AND. SMALL(1) .EQ. -448790528)) THEN * *** IEEE *** IMACH(10) = 2 IMACH(14) = 53 IMACH(15) = -1021 IMACH(16) = 1024 ELSE IF ( SMALL(1) .EQ. -2065213935 * .AND. SMALL(2) .EQ. 10752) THEN * *** VAX WITH D_FLOATING *** IMACH(10) = 2 IMACH(14) = 56 IMACH(15) = -127 IMACH(16) = 127 ELSE IF ( SMALL(1) .EQ. 1267827943 * .AND. SMALL(2) .EQ. 704643072) THEN * *** IBM MAINFRAME *** IMACH(10) = 16 IMACH(14) = 14 IMACH(15) = -64 IMACH(16) = 63 ELSE WRITE(*,9010) STOP 777 END IF IMACH(11) = IMACH(14) IMACH(12) = IMACH(15) IMACH(13) = IMACH(16) ELSE RMACH = 1234567. IF (SMALL(1) .EQ. 1234613304) THEN * *** IEEE *** IMACH(10) = 2 IMACH(11) = 24 IMACH(12) = -125 IMACH(13) = 128 IMACH(14) = 53 IMACH(15) = -1021 IMACH(16) = 1024 SANITY = 987 ELSE IF (SMALL(1) .EQ. -1271379306) THEN * *** VAX *** IMACH(10) = 2 IMACH(11) = 24 IMACH(12) = -127 IMACH(13) = 127 IMACH(14) = 56 IMACH(15) = -127 IMACH(16) = 127 SANITY = 987 ELSE IF (SMALL(1) .EQ. 1175639687) THEN * *** IBM MAINFRAME *** IMACH(10) = 16 IMACH(11) = 6 IMACH(12) = -64 IMACH(13) = 63 IMACH(14) = 14 IMACH(15) = -64 IMACH(16) = 63 SANITY = 987 ELSE IF (SMALL(1) .EQ. 1251390520) THEN * *** CONVEX C-1 *** IMACH(10) = 2 IMACH(11) = 24 IMACH(12) = -128 IMACH(13) = 127 IMACH(14) = 53 IMACH(15) = -1024 IMACH(16) = 1023 ELSE DO 10 I = 1, 3 J = SMALL(1) / 10000000 K = SMALL(1) - 10000000*J IF (K .NE. T3E(I)) GO TO 20 SMALL(1) = J 10 CONTINUE * *** CRAY T3E *** IMACH(10) = 2 IMACH(11) = 53 IMACH(12) = -1024 IMACH(13) = 1023 IMACH(14) = 0 IMACH(15) = 0 IMACH(16) = 0 GO TO 30 20 CALL I1MCR1(J, K, 16405, 9876536, 0) IF (SMALL(1) .NE. J) THEN WRITE(*,9020) STOP 777 END IF * *** CRAY 1, XMP, 2, AND 3 *** IMACH(1) = 5 IMACH(2) = 6 IMACH(3) = 102 IMACH(4) = 6 IMACH(5) = 64 IMACH(6) = 8 IMACH(7) = 2 IMACH(8) = 63 CALL I1MCR1(IMACH(9), K, 32767, 16777215, 16777215) IMACH(10) = 2 IMACH(11) = 47 IMACH(12) = -8189 IMACH(13) = 8190 IMACH(14) = 94 IMACH(15) = -8099 IMACH(16) = 8190 GO TO 35 END IF END IF 30 IMACH( 1) = 5 IMACH( 2) = 6 IMACH( 3) = 7 IMACH( 4) = 6 IMACH( 5) = 32 IMACH( 6) = 4 IMACH( 7) = 2 IMACH( 8) = 31 IMACH( 9) = 2147483647 35 SANITY = 987 END IF 9010 FORMAT(/' Adjust autodoubled I1MACH by uncommenting data'/ * ' statements appropriate for your machine and setting'/ * ' IMACH(I) = IMACH(I+3) for I = 11, 12, and 13.') 9020 FORMAT(/' Adjust I1MACH by uncommenting data statements'/ * ' appropriate for your machine.') IF (I .LT. 1 .OR. I .GT. 16) GO TO 40 I1MACH = IMACH(I) C REMOVE THE FOLLOWING LINE IF FORTRAN66 IS PREFERRED TO FORTRAN77. IF (I .EQ. 6) I1MACH = 1 RETURN 40 WRITE(*,*) 'I1MACH(I): I =',I,' is out of bounds.' STOP * /* C source for I1MACH -- remove the * in column 1 */ * /* Note that some values may need changing. */ *#include *#include *#include *#include * *long i1mach_(long *i) *{ * switch(*i){ * case 1: return 5; /* standard input */ * case 2: return 6; /* standard output */ * case 3: return 7; /* standard punch */ * case 4: return 0; /* standard error */ * case 5: return 32; /* bits per integer */ * case 6: return 1; /* Fortran 77 value */ * case 7: return 2; /* base for integers */ * case 8: return 31; /* digits of integer base */ * case 9: return LONG_MAX; * case 10: return FLT_RADIX; * case 11: return FLT_MANT_DIG; * case 12: return FLT_MIN_EXP; * case 13: return FLT_MAX_EXP; * case 14: return DBL_MANT_DIG; * case 15: return DBL_MIN_EXP; * case 16: return DBL_MAX_EXP; * } * fprintf(stderr, "invalid argument: i1mach(%ld)\n", *i); * exit(1);return 0; /* some compilers demand return values */ *} END SUBROUTINE I1MCR1(A, A1, B, C, D) **** SPECIAL COMPUTATION FOR OLD CRAY MACHINES **** INTEGER A, A1, B, C, D A1 = 16777216*B + C A = 16777216*A1 + D END c----------------------------------------------------------------------- double precision function dgamln(z,ierr) c Logarithm of Gamma function c author Amos, Donald E., Sandia National Laboratories c c dgamln computes the natural log of the gamma function for c z.gt.0. the asymptotic expansion is used to generate values c greater than zmin which are adjusted by the recursion c g(z+1)=z*g(z) for z.le.zmin. the function was made as c portable as possible by computimg zmin from the number of base c 10 digits in a word, rln=amax1(-alog10(r1mach(4)),0.5e-18) c limited to 18 digits of (relative) accuracy. c c since integer arguments are common, a table look up on 100 c values is used for speed of execution. c c description of arguments c c input z is d0uble precision c z - argument, z.gt.0.0d0 c c output dgamln is double precision c dgamln - natural log of the gamma function at z.ne.0.0d0 c ierr - error flag c ierr=0, normal return, computation completed c ierr=1, z.le.0.0d0, no computation c c c***routines called i1mach,d1mach double precision cf, con, fln, fz, gln, rln, s, tlg, trm, tst, * t1, wdtol, z, zdmy, zinc, zm, zmin, zp, zsq, d1mach integer i, ierr, i1m, k, mz, nz, i1mach dimension cf(22), gln(100) c lngamma(n), n=1,100 data gln(1), gln(2), gln(3), gln(4), gln(5), gln(6), gln(7), 1 gln(8), gln(9), gln(10), gln(11), gln(12), gln(13), gln(14), 2 gln(15), gln(16), gln(17), gln(18), gln(19), gln(20), 3 gln(21), gln(22)/ 4 0.00000000000000000d+00, 0.00000000000000000d+00, 5 6.93147180559945309d-01, 1.79175946922805500d+00, 6 3.17805383034794562d+00, 4.78749174278204599d+00, 7 6.57925121201010100d+00, 8.52516136106541430d+00, 8 1.06046029027452502d+01, 1.28018274800814696d+01, 9 1.51044125730755153d+01, 1.75023078458738858d+01, a 1.99872144956618861d+01, 2.25521638531234229d+01, b 2.51912211827386815d+01, 2.78992713838408916d+01, c 3.06718601060806728d+01, 3.35050734501368889d+01, d 3.63954452080330536d+01, 3.93398841871994940d+01, e 4.23356164607534850d+01, 4.53801388984769080d+01/ data gln(23), gln(24), gln(25), gln(26), gln(27), gln(28), 1 gln(29), gln(30), gln(31), gln(32), gln(33), gln(34), 2 gln(35), gln(36), gln(37), gln(38), gln(39), gln(40), 3 gln(41), gln(42), gln(43), gln(44)/ 4 4.84711813518352239d+01, 5.16066755677643736d+01, 5 5.47847293981123192d+01, 5.80036052229805199d+01, 6 6.12617017610020020d+01, 6.45575386270063311d+01, 7 6.78897431371815350d+01, 7.12570389671680090d+01, 8 7.46582363488301644d+01, 7.80922235533153106d+01, 9 8.15579594561150372d+01, 8.50544670175815174d+01, a 8.85808275421976788d+01, 9.21361756036870925d+01, b 9.57196945421432025d+01, 9.93306124547874269d+01, c 1.02968198614513813d+02, 1.06631760260643459d+02, d 1.10320639714757395d+02, 1.14034211781461703d+02, e 1.17771881399745072d+02, 1.21533081515438634d+02/ data gln(45), gln(46), gln(47), gln(48), gln(49), gln(50), 1 gln(51), gln(52), gln(53), gln(54), gln(55), gln(56), 2 gln(57), gln(58), gln(59), gln(60), gln(61), gln(62), 3 gln(63), gln(64), gln(65), gln(66)/ 4 1.25317271149356895d+02, 1.29123933639127215d+02, 5 1.32952575035616310d+02, 1.36802722637326368d+02, 6 1.40673923648234259d+02, 1.44565743946344886d+02, 7 1.48477766951773032d+02, 1.52409592584497358d+02, 8 1.56360836303078785d+02, 1.60331128216630907d+02, 9 1.64320112263195181d+02, 1.68327445448427652d+02, a 1.72352797139162802d+02, 1.76395848406997352d+02, b 1.80456291417543771d+02, 1.84533828861449491d+02, c 1.88628173423671591d+02, 1.92739047287844902d+02, d 1.96866181672889994d+02, 2.01009316399281527d+02, e 2.05168199482641199d+02, 2.09342586752536836d+02/ data gln(67), gln(68), gln(69), gln(70), gln(71), gln(72), 1 gln(73), gln(74), gln(75), gln(76), gln(77), gln(78), 2 gln(79), gln(80), gln(81), gln(82), gln(83), gln(84), 3 gln(85), gln(86), gln(87), gln(88)/ 4 2.13532241494563261d+02, 2.17736934113954227d+02, 5 2.21956441819130334d+02, 2.26190548323727593d+02, 6 2.30439043565776952d+02, 2.34701723442818268d+02, 7 2.38978389561834323d+02, 2.43268849002982714d+02, 8 2.47572914096186884d+02, 2.51890402209723194d+02, 9 2.56221135550009525d+02, 2.60564940971863209d+02, a 2.64921649798552801d+02, 2.69291097651019823d+02, b 2.73673124285693704d+02, 2.78067573440366143d+02, c 2.82474292687630396d+02, 2.86893133295426994d+02, d 2.91323950094270308d+02, 2.95766601350760624d+02, e 3.00220948647014132d+02, 3.04686856765668715d+02/ data gln(89), gln(90), gln(91), gln(92), gln(93), gln(94), 1 gln(95), gln(96), gln(97), gln(98), gln(99), gln(100)/ 2 3.09164193580146922d+02, 3.13652829949879062d+02, 3 3.18152639620209327d+02, 3.22663499126726177d+02, 4 3.27185287703775217d+02, 3.31717887196928473d+02, 5 3.36261181979198477d+02, 3.40815058870799018d+02, 6 3.45379407062266854d+02, 3.49954118040770237d+02, 7 3.54539085519440809d+02, 3.59134205369575399d+02/ c coefficients of asymptotic expansion data cf(1), cf(2), cf(3), cf(4), cf(5), cf(6), cf(7), cf(8), 1 cf(9), cf(10), cf(11), cf(12), cf(13), cf(14), cf(15), 2 cf(16), cf(17), cf(18), cf(19), cf(20), cf(21), cf(22)/ 3 8.33333333333333333d-02, -2.77777777777777778d-03, 4 7.93650793650793651d-04, -5.95238095238095238d-04, 5 8.41750841750841751d-04, -1.91752691752691753d-03, 6 6.41025641025641026d-03, -2.95506535947712418d-02, 7 1.79644372368830573d-01, -1.39243221690590112d+00, 8 1.34028640441683920d+01, -1.56848284626002017d+02, 9 2.19310333333333333d+03, -3.61087712537249894d+04, a 6.91472268851313067d+05, -1.52382215394074162d+07, b 3.82900751391414141d+08, -1.08822660357843911d+10, c 3.47320283765002252d+11, -1.23696021422692745d+13, d 4.88788064793079335d+14, -2.13203339609193739d+16/ c c ln(2*pi) data con / 1.83787706640934548d+00/ c c***first executable statement dgamln ierr=0 if (z.le.0.0d0) go to 70 if (z.gt.101.0d0) go to 10 nz = int(sngl(z)) fz = z - float(nz) if (fz.gt.0.0d0) go to 10 if (nz.gt.100) go to 10 dgamln = gln(nz) return 10 continue wdtol = d1mach(4) wdtol = dmax1(wdtol,0.5d-18) i1m = i1mach(14) rln = d1mach(5)*float(i1m) fln = dmin1(rln,20.0d0) fln = dmax1(fln,3.0d0) fln = fln - 3.0d0 zm = 1.8000d0 + 0.3875d0*fln mz = int(sngl(zm)) + 1 zmin = float(mz) zdmy = z zinc = 0.0d0 if (z.ge.zmin) go to 20 zinc = zmin - float(nz) zdmy = z + zinc 20 continue zp = 1.0d0/zdmy t1 = cf(1)*zp s = t1 if (zp.lt.wdtol) go to 40 zsq = zp*zp tst = t1*wdtol do 30 k=2,22 zp = zp*zsq trm = cf(k)*zp if (dabs(trm).lt.tst) go to 40 s = s + trm 30 continue 40 continue if (zinc.ne.0.0d0) go to 50 tlg = dlog(z) dgamln = z*(tlg-1.0d0) + 0.5d0*(con-tlg) + s return 50 continue zp = 1.0d0 nz = int(sngl(zinc)) do 60 i=1,nz zp = zp*(z+float(i-1)) 60 continue tlg = dlog(zdmy) dgamln = zdmy*(tlg-1.0d0) - dlog(zp) + 0.5d0*(con-tlg) + s return c c 70 continue dgamln = d1mach(7) ierr=1 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine xerror(mess,nmess,l1,l2) c c this is a dummy xerror routine to print error messages with nmess c characters. l1 and l2 are dummy parameters to make this call c compatible with the slatec xerror routine. this is a fortran 77 c routine. c character*(*) mess nn=nmess/70 nr=nmess-70*nn if(nr.ne.0) nn=nn+1 k=1 print 900 900 format(/) do 10 i=1,nn kmin=min0(k+69,nmess) print *, mess(k:kmin) k=k+70 10 continue print 900 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- double precision function zabs2(zr, zi) c refer to zbesh,zbesi,zbesj,zbesk,zbesy,zairy,zbiry c zabs2 computes the absolute value or magnitude of a double c precision complex variable cmplx(zr,zi) c double precision zr, zi, u, v, q, s u = dabs(zr) v = dabs(zi) s = u + v c----------------------------------------------------------------------- c s*1.0d0 makes an unnormalized underflow on cdc machines into a c true floating zero c----------------------------------------------------------------------- s = s*1.0d+0 if (s.eq.0.0d+0) go to 20 if (u.gt.v) go to 10 q = u/v zabs2 = v*dsqrt(1.d+0+q*q) return 10 q = v/u zabs2 = u*dsqrt(1.d+0+q*q) return 20 zabs2 = 0.0d+0 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zacai(zr, zi, fnu, kode, mr, n, yr, yi, nz, rl, tol, * elim, alim) c Refer to zairy c c zacai applies the analytic continuation formula c c k(fnu,zn*exp(mp))=k(fnu,zn)*exp(-mp*fnu) - mp*i(fnu,zn) c mp=pi*mr*cmplx(0.0,1.0) c c to continue the k function from the right half to the left c half z plane for use with zairy where fnu=1/3 or 2/3 and n=1. c zacai is the same as zacon with the parts for larger orders and c recurrence removed. a recursive call to zacon can result if zacon c is called from zairy. c c***routines called zasyi,zbknu,zmlri,zseri,zs1s2,d1mach,zabs2 c complex csgn,cspn,c1,c2,y,z,zn,cy double precision alim, arg, ascle, az, csgnr, csgni, cspnr, * cspni, c1r, c1i, c2r, c2i, cyr, cyi, dfnu, elim, fmr, fnu, pi, * rl, sgn, tol, yy, yr, yi, zr, zi, znr, zni, d1mach, zabs2 integer inu, iuf, kode, mr, n, nn, nw, nz dimension yr(n), yi(n), cyr(2), cyi(2) data pi / 3.14159265358979324d0 / nz = 0 znr = -zr zni = -zi az = zabs2(zr,zi) nn = n dfnu = fnu + dble(float(n-1)) if (az.le.2.0d0) go to 10 if (az*az*0.25d0.gt.dfnu+1.0d0) go to 20 10 continue c----------------------------------------------------------------------- c power series for the i function c----------------------------------------------------------------------- call zseri(znr, zni, fnu, kode, nn, yr, yi, nw, tol, elim, alim) go to 40 20 continue if (az.lt.rl) go to 30 c----------------------------------------------------------------------- c asymptotic expansion for large z for the i function c----------------------------------------------------------------------- call zasyi(znr, zni, fnu, kode, nn, yr, yi, nw, rl, tol, elim, * alim) if (nw.lt.0) go to 80 go to 40 30 continue c----------------------------------------------------------------------- c miller algorithm normalized by the series for the i function c----------------------------------------------------------------------- call zmlri(znr, zni, fnu, kode, nn, yr, yi, nw, tol) if(nw.lt.0) go to 80 40 continue c----------------------------------------------------------------------- c analytic continuation to the left half plane for the k function c----------------------------------------------------------------------- call zbknu(znr, zni, fnu, kode, 1, cyr, cyi, nw, tol, elim, alim) if (nw.ne.0) go to 80 fmr = dble(float(mr)) sgn = -dsign(pi,fmr) csgnr = 0.0d0 csgni = sgn if (kode.eq.1) go to 50 yy = -zni csgnr = -csgni*dsin(yy) csgni = csgni*dcos(yy) 50 continue c----------------------------------------------------------------------- c calculate cspn=exp(fnu*pi*i) to minimize losses of significance c when fnu is large c----------------------------------------------------------------------- inu = int(sngl(fnu)) arg = (fnu-dble(float(inu)))*sgn cspnr = dcos(arg) cspni = dsin(arg) if (mod(inu,2).eq.0) go to 60 cspnr = -cspnr cspni = -cspni 60 continue c1r = cyr(1) c1i = cyi(1) c2r = yr(1) c2i = yi(1) if (kode.eq.1) go to 70 iuf = 0 ascle = 1.0d+3*d1mach(1)/tol call zs1s2(znr, zni, c1r, c1i, c2r, c2i, nw, ascle, alim, iuf) nz = nz + nw 70 continue yr(1) = cspnr*c1r - cspni*c1i + csgnr*c2r - csgni*c2i yi(1) = cspnr*c1i + cspni*c1r + csgnr*c2i + csgni*c2r return 80 continue nz = -1 if(nw.eq.(-2)) nz=-2 return end c----------------------------------------------------------------------- subroutine zacon(zr, zi, fnu, kode, mr, n, yr, yi, nz, rl, fnul, * tol, elim, alim) c Refer to zbesk,zbesh c c zacon applies the analytic continuation formula c c k(fnu,zn*exp(mp))=k(fnu,zn)*exp(-mp*fnu) - mp*i(fnu,zn) c mp=pi*mr*cmplx(0.0,1.0) c c to continue the k function from the right half to the left c half z plane c c***routines called zbinu,zbknu,zs1s2,d1mach,zabs2,zmlt c c complex ck,cone,cscl,cscr,csgn,cspn,cy,czero,c1,c2,rz,sc1,sc2,st, c *s1,s2,y,z,zn double precision alim, arg, ascle, as2, azn, bry, bscle, cki, * ckr, coner, cpn, cscl, cscr, csgni, csgnr, cspni, cspnr, * csr, csrr, cssr, cyi, cyr, c1i, c1m, c1r, c2i, c2r, elim, fmr, * fn, fnu, fnul, pi, pti, ptr, razn, rl, rzi, rzr, sc1i, sc1r, * sc2i, sc2r, sgn, spn, sti, str, s1i, s1r, s2i, s2r, tol, yi, yr, * yy, zeror, zi, zni, znr, zr, d1mach, zabs2 integer i, inu, iuf, kflag, kode, mr, n, nn, nw, nz dimension yr(n), yi(n), cyr(2), cyi(2), cssr(3), csrr(3), bry(3) data pi / 3.14159265358979324d0 / data zeror,coner / 0.0d0,1.0d0 / nz = 0 znr = -zr zni = -zi nn = n call zbinu(znr, zni, fnu, kode, nn, yr, yi, nw, rl, fnul, tol, * elim, alim) if (nw.lt.0) go to 90 c----------------------------------------------------------------------- c analytic continuation to the left half plane for the k function c----------------------------------------------------------------------- nn = min0(2,n) call zbknu(znr, zni, fnu, kode, nn, cyr, cyi, nw, tol, elim, alim) if (nw.ne.0) go to 90 s1r = cyr(1) s1i = cyi(1) fmr = dble(float(mr)) sgn = -dsign(pi,fmr) csgnr = zeror csgni = sgn if (kode.eq.1) go to 10 yy = -zni cpn = dcos(yy) spn = dsin(yy) call zmlt(csgnr, csgni, cpn, spn, csgnr, csgni) 10 continue c----------------------------------------------------------------------- c calculate cspn=exp(fnu*pi*i) to minimize losses of significance c when fnu is large c----------------------------------------------------------------------- inu = int(sngl(fnu)) arg = (fnu-dble(float(inu)))*sgn cpn = dcos(arg) spn = dsin(arg) cspnr = cpn cspni = spn if (mod(inu,2).eq.0) go to 20 cspnr = -cspnr cspni = -cspni 20 continue iuf = 0 c1r = s1r c1i = s1i c2r = yr(1) c2i = yi(1) ascle = 1.0d+3*d1mach(1)/tol if (kode.eq.1) go to 30 call zs1s2(znr, zni, c1r, c1i, c2r, c2i, nw, ascle, alim, iuf) nz = nz + nw sc1r = c1r sc1i = c1i 30 continue call zmlt(cspnr, cspni, c1r, c1i, str, sti) call zmlt(csgnr, csgni, c2r, c2i, ptr, pti) yr(1) = str + ptr yi(1) = sti + pti if (n.eq.1) return cspnr = -cspnr cspni = -cspni s2r = cyr(2) s2i = cyi(2) c1r = s2r c1i = s2i c2r = yr(2) c2i = yi(2) if (kode.eq.1) go to 40 call zs1s2(znr, zni, c1r, c1i, c2r, c2i, nw, ascle, alim, iuf) nz = nz + nw sc2r = c1r sc2i = c1i 40 continue call zmlt(cspnr, cspni, c1r, c1i, str, sti) call zmlt(csgnr, csgni, c2r, c2i, ptr, pti) yr(2) = str + ptr yi(2) = sti + pti if (n.eq.2) return cspnr = -cspnr cspni = -cspni azn = zabs2(znr,zni) razn = 1.0d0/azn str = znr*razn sti = -zni*razn rzr = (str+str)*razn rzi = (sti+sti)*razn fn = fnu + 1.0d0 ckr = fn*rzr cki = fn*rzi c----------------------------------------------------------------------- c scale near exponent extremes during recurrence on k functions c----------------------------------------------------------------------- cscl = 1.0d0/tol cscr = tol cssr(1) = cscl cssr(2) = coner cssr(3) = cscr csrr(1) = cscr csrr(2) = coner csrr(3) = cscl bry(1) = ascle bry(2) = 1.0d0/ascle bry(3) = d1mach(2) as2 = zabs2(s2r,s2i) kflag = 2 if (as2.gt.bry(1)) go to 50 kflag = 1 go to 60 50 continue if (as2.lt.bry(2)) go to 60 kflag = 3 60 continue bscle = bry(kflag) s1r = s1r*cssr(kflag) s1i = s1i*cssr(kflag) s2r = s2r*cssr(kflag) s2i = s2i*cssr(kflag) csr = csrr(kflag) do 80 i=3,n str = s2r sti = s2i s2r = ckr*str - cki*sti + s1r s2i = ckr*sti + cki*str + s1i s1r = str s1i = sti c1r = s2r*csr c1i = s2i*csr str = c1r sti = c1i c2r = yr(i) c2i = yi(i) if (kode.eq.1) go to 70 if (iuf.lt.0) go to 70 call zs1s2(znr, zni, c1r, c1i, c2r, c2i, nw, ascle, alim, iuf) nz = nz + nw sc1r = sc2r sc1i = sc2i sc2r = c1r sc2i = c1i if (iuf.ne.3) go to 70 iuf = -4 s1r = sc1r*cssr(kflag) s1i = sc1i*cssr(kflag) s2r = sc2r*cssr(kflag) s2i = sc2i*cssr(kflag) str = sc2r sti = sc2i 70 continue ptr = cspnr*c1r - cspni*c1i pti = cspnr*c1i + cspni*c1r yr(i) = ptr + csgnr*c2r - csgni*c2i yi(i) = pti + csgnr*c2i + csgni*c2r ckr = ckr + rzr cki = cki + rzi cspnr = -cspnr cspni = -cspni if (kflag.ge.3) go to 80 ptr = dabs(c1r) pti = dabs(c1i) c1m = dmax1(ptr,pti) if (c1m.le.bscle) go to 80 kflag = kflag + 1 bscle = bry(kflag) s1r = s1r*csr s1i = s1i*csr s2r = str s2i = sti s1r = s1r*cssr(kflag) s1i = s1i*cssr(kflag) s2r = s2r*cssr(kflag) s2i = s2i*cssr(kflag) csr = csrr(kflag) 80 continue return 90 continue nz = -1 if(nw.eq.(-2)) nz=-2 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zdiv(ar, ai, br, bi, cr, ci) c Refer to zbesh,zbesi,zbesj,zbesk,zbesy,zairy,zbiry c c double precision complex divide c=a/b. c c***routines called zabs2 c double precision ar, ai, br, bi, cr, ci, bm, ca, cb, cc, cd double precision zabs2 bm = 1.0d0/zabs2(br,bi) cc = br*bm cd = bi*bm ca = (ar*cc+ai*cd)*bm cb = (ai*cc-ar*cd)*bm cr = ca ci = cb return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zexp(ar, ai, br, bi) c Refer to zbesh,zbesi,zbesj,zbesk,zbesy,zairy,zbiry c c double precision complex exponential function b=exp(a) c double precision ar, ai, br, bi, zm, ca, cb zm = dexp(ar) ca = zm*dcos(ai) cb = zm*dsin(ai) br = ca bi = cb return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zkscl(zrr,zri,fnu,n,yr,yi,nz,rzr,rzi,ascle,tol,elim) c geuz for g77 EXTERNAL zlog c refer to zbesk c c set k functions to zero on underflow, continue recurrence c on scaled functions until two members come on scale, then c return with min(nz+2,n) values scaled by 1/tol. c c routines called zuchk,zabs2,zlog c c complex ck,cs,cy,czero,rz,s1,s2,y,zr,zd,celm double precision acs, as, ascle, cki, ckr, csi, csr, cyi, * cyr, elim, fn, fnu, rzi, rzr, str, s1i, s1r, s2i, * s2r, tol, yi, yr, zeroi, zeror, zri, zrr, zabs2, * zdr, zdi, celmr, elm, helim, alas integer i, ic, idum, kk, n, nn, nw, nz dimension yr(n), yi(n), cyr(2), cyi(2) data zeror,zeroi / 0.0d0 , 0.0d0 / c nz = 0 ic = 0 nn = min0(2,n) do 10 i=1,nn s1r = yr(i) s1i = yi(i) cyr(i) = s1r cyi(i) = s1i as = zabs2(s1r,s1i) acs = -zrr + dlog(as) nz = nz + 1 yr(i) = zeror yi(i) = zeroi if (acs.lt.(-elim)) go to 10 call zlog(s1r, s1i, csr, csi, idum) csr = csr - zrr csi = csi - zri str = dexp(csr)/tol csr = str*dcos(csi) csi = str*dsin(csi) call zuchk(csr, csi, nw, ascle, tol) if (nw.ne.0) go to 10 yr(i) = csr yi(i) = csi ic = i nz = nz - 1 10 continue if (n.eq.1) return if (ic.gt.1) go to 20 yr(1) = zeror yi(1) = zeroi nz = 2 20 continue if (n.eq.2) return if (nz.eq.0) return fn = fnu + 1.0d0 ckr = fn*rzr cki = fn*rzi s1r = cyr(1) s1i = cyi(1) s2r = cyr(2) s2i = cyi(2) helim = 0.5d0*elim elm = dexp(-elim) celmr = elm zdr = zrr zdi = zri c c find two consecutive y values on scale. scale recurrence if c s2 gets larger than exp(elim/2) c do 30 i=3,n kk = i csr = s2r csi = s2i s2r = ckr*csr - cki*csi + s1r s2i = cki*csr + ckr*csi + s1i s1r = csr s1i = csi ckr = ckr + rzr cki = cki + rzi as = zabs2(s2r,s2i) alas = dlog(as) acs = -zdr + alas nz = nz + 1 yr(i) = zeror yi(i) = zeroi if (acs.lt.(-elim)) go to 25 call zlog(s2r, s2i, csr, csi, idum) csr = csr - zdr csi = csi - zdi str = dexp(csr)/tol csr = str*dcos(csi) csi = str*dsin(csi) call zuchk(csr, csi, nw, ascle, tol) if (nw.ne.0) go to 25 yr(i) = csr yi(i) = csi nz = nz - 1 if (ic.eq.kk-1) go to 40 ic = kk go to 30 25 continue if(alas.lt.helim) go to 30 zdr = zdr - elim s1r = s1r*celmr s1i = s1i*celmr s2r = s2r*celmr s2i = s2i*celmr 30 continue nz = n if(ic.eq.n) nz=n-1 go to 45 40 continue nz = kk - 2 45 continue do 50 i=1,nz yr(i) = zeror yi(i) = zeroi 50 continue return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zlog(ar, ai, br, bi, ierr) c Refer to zbesh,zbesi,zbesj,zbesk,zbesy,zairy,zbiry c c double precision complex logarithm b=clog(a) c ierr=0,normal return ierr=1, z=cmplx(0.0,0.0) c***routines called zabs2 double precision ar, ai, br, bi, zm, dtheta, dpi, dhpi double precision zabs2 data dpi , dhpi / 3.141592653589793238462643383d+0, 1 1.570796326794896619231321696d+0/ c ierr=0 if (ar.eq.0.0d+0) go to 10 if (ai.eq.0.0d+0) go to 20 dtheta = datan(ai/ar) if (dtheta.le.0.0d+0) go to 40 if (ar.lt.0.0d+0) dtheta = dtheta - dpi go to 50 10 if (ai.eq.0.0d+0) go to 60 bi = dhpi br = dlog(dabs(ai)) if (ai.lt.0.0d+0) bi = -bi return 20 if (ar.gt.0.0d+0) go to 30 br = dlog(dabs(ar)) bi = dpi return 30 br = dlog(ar) bi = 0.0d+0 return 40 if (ar.lt.0.0d+0) dtheta = dtheta + dpi 50 zm = zabs2(ar,ai) br = dlog(zm) bi = dtheta return 60 continue ierr=1 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zmlt(ar, ai, br, bi, cr, ci) c Refer to zbesh,zbesi,zbesj,zbesk,zbesy,zairy,zbiry c c double precision complex multiply, c=a*b. c double precision ar, ai, br, bi, cr, ci, ca, cb ca = ar*br - ai*bi cb = ar*bi + ai*br cr = ca ci = cb return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zrati(zr, zi, fnu, n, cyr, cyi, tol) c Refer to zbesi,zbesk,zbesh c c zrati computes ratios of i bessel functions by backward c recurrence. the starting index is determined by forward c recurrence as described in j. res. of nat. bur. of standards-b, c mathematical sciences, vol 77b, p111-114, september, 1973, c bessel functions i and j of complex argument and integer order, c by d. j. sookne. c c***routines called zabs2,zdiv c complex z,cy(1),cone,czero,p1,p2,t1,rz,pt,cdfnu double precision ak, amagz, ap1, ap2, arg, az, cdfnui, cdfnur, * conei, coner, cyi, cyr, czeroi, czeror, dfnu, fdnu, flam, fnu, * fnup, pti, ptr, p1i, p1r, p2i, p2r, rak, rap1, rho, rt2, rzi, * rzr, test, test1, tol, tti, ttr, t1i, t1r, zi, zr, zabs2 integer i, id, idnu, inu, itime, k, kk, magz, n dimension cyr(n), cyi(n) data czeror,czeroi,coner,conei,rt2/ 1 0.0d0, 0.0d0, 1.0d0, 0.0d0, 1.41421356237309505d0 / az = zabs2(zr,zi) inu = int(sngl(fnu)) idnu = inu + n - 1 magz = int(sngl(az)) amagz = dble(float(magz+1)) fdnu = dble(float(idnu)) fnup = dmax1(amagz,fdnu) id = idnu - magz - 1 itime = 1 k = 1 ptr = 1.0d0/az rzr = ptr*(zr+zr)*ptr rzi = -ptr*(zi+zi)*ptr t1r = rzr*fnup t1i = rzi*fnup p2r = -t1r p2i = -t1i p1r = coner p1i = conei t1r = t1r + rzr t1i = t1i + rzi if (id.gt.0) id = 0 ap2 = zabs2(p2r,p2i) ap1 = zabs2(p1r,p1i) c----------------------------------------------------------------------- c the overflow test on k(fnu+i-1,z) before the call to cbknu c guarantees that p2 is on scale. scale test1 and all subsequent c p2 values by ap1 to ensure that an overflow does not occur c prematurely. c----------------------------------------------------------------------- arg = (ap2+ap2)/(ap1*tol) test1 = dsqrt(arg) test = test1 rap1 = 1.0d0/ap1 p1r = p1r*rap1 p1i = p1i*rap1 p2r = p2r*rap1 p2i = p2i*rap1 ap2 = ap2*rap1 10 continue k = k + 1 ap1 = ap2 ptr = p2r pti = p2i p2r = p1r - (t1r*ptr-t1i*pti) p2i = p1i - (t1r*pti+t1i*ptr) p1r = ptr p1i = pti t1r = t1r + rzr t1i = t1i + rzi ap2 = zabs2(p2r,p2i) if (ap1.le.test) go to 10 if (itime.eq.2) go to 20 ak = zabs2(t1r,t1i)*0.5d0 flam = ak + dsqrt(ak*ak-1.0d0) rho = dmin1(ap2/ap1,flam) test = test1*dsqrt(rho/(rho*rho-1.0d0)) itime = 2 go to 10 20 continue kk = k + 1 - id ak = dble(float(kk)) t1r = ak t1i = czeroi dfnu = fnu + dble(float(n-1)) p1r = 1.0d0/ap2 p1i = czeroi p2r = czeror p2i = czeroi do 30 i=1,kk ptr = p1r pti = p1i rap1 = dfnu + t1r ttr = rzr*rap1 tti = rzi*rap1 p1r = (ptr*ttr-pti*tti) + p2r p1i = (ptr*tti+pti*ttr) + p2i p2r = ptr p2i = pti t1r = t1r - coner 30 continue if (p1r.ne.czeror .or. p1i.ne.czeroi) go to 40 p1r = tol p1i = tol 40 continue call zdiv(p2r, p2i, p1r, p1i, cyr(n), cyi(n)) if (n.eq.1) return k = n - 1 ak = dble(float(k)) t1r = ak t1i = czeroi cdfnur = fnu*rzr cdfnui = fnu*rzi do 60 i=2,n ptr = cdfnur + (t1r*rzr-t1i*rzi) + cyr(k+1) pti = cdfnui + (t1r*rzi+t1i*rzr) + cyi(k+1) ak = zabs2(ptr,pti) if (ak.ne.czeror) go to 50 ptr = tol pti = tol ak = tol*rt2 50 continue rak = coner/ak cyr(k) = rak*ptr*rak cyi(k) = -rak*pti*rak t1r = t1r - coner k = k - 1 60 continue return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zs1s2(zrr, zri, s1r, s1i, s2r, s2i, nz, ascle, alim, * iuf) c geuz for g77 EXTERNAL zexp EXTERNAL zlog c Refer to zbesk,zairy c c zs1s2 tests for a possible underflow resulting from the c addition of the i and k functions in the analytic con- c tinuation formula where s1=k function and s2=i function. c on kode=1 the i and k functions are different orders of c magnitude, but for kode=2 they can be of the same order c of magnitude and the maximum must be at least one c precision above the underflow limit. c c***routines called zabs2,zexp,zlog c complex czero,c1,s1,s1d,s2,zr double precision aa, alim, aln, ascle, as1, as2, c1i, c1r, s1di, * s1dr, s1i, s1r, s2i, s2r, zeroi, zeror, zri, zrr, zabs2 integer iuf, idum, nz data zeror,zeroi / 0.0d0 , 0.0d0 / nz = 0 as1 = zabs2(s1r,s1i) as2 = zabs2(s2r,s2i) if (s1r.eq.0.0d0 .and. s1i.eq.0.0d0) go to 10 if (as1.eq.0.0d0) go to 10 aln = -zrr - zrr + dlog(as1) s1dr = s1r s1di = s1i s1r = zeror s1i = zeroi as1 = zeror if (aln.lt.(-alim)) go to 10 call zlog(s1dr, s1di, c1r, c1i, idum) c1r = c1r - zrr - zrr c1i = c1i - zri - zri call zexp(c1r, c1i, s1r, s1i) as1 = zabs2(s1r,s1i) iuf = iuf + 1 10 continue aa = dmax1(as1,as2) if (aa.gt.ascle) return s1r = zeror s1i = zeroi s2r = zeror s2i = zeroi nz = 1 iuf = 0 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zshch(zr, zi, cshr, cshi, cchr, cchi) c Refer to zbesk,zbesh c c zshch computes the complex hyperbolic functions csh=sinh(x+i*y) c and cch=cosh(x+i*y), where i**2=-1. c double precision cchi, cchr, ch, cn, cshi, cshr, sh, sn, zi, zr, * dcosh, dsinh sh = dsinh(zr) ch = dcosh(zr) sn = dsin(zi) cn = dcos(zi) cshr = sh*cn cshi = ch*sn cchr = ch*cn cchi = sh*sn return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zsqrt(ar, ai, br, bi) c Refer to zbesh,zbesi,zbesj,zbesk,zbesy,zairy,zbiry c c double precision complex square root, b=csqrt(a) c c***routines called zabs2 c double precision ar, ai, br, bi, zm, dtheta, dpi, drt double precision zabs2 data drt , dpi / 7.071067811865475244008443621d-1, 1 3.141592653589793238462643383d+0/ zm = zabs2(ar,ai) zm = dsqrt(zm) if (ar.eq.0.0d+0) go to 10 if (ai.eq.0.0d+0) go to 20 dtheta = datan(ai/ar) if (dtheta.le.0.0d+0) go to 40 if (ar.lt.0.0d+0) dtheta = dtheta - dpi go to 50 10 if (ai.gt.0.0d+0) go to 60 if (ai.lt.0.0d+0) go to 70 br = 0.0d+0 bi = 0.0d+0 return 20 if (ar.gt.0.0d+0) go to 30 br = 0.0d+0 bi = dsqrt(dabs(ar)) return 30 br = dsqrt(ar) bi = 0.0d+0 return 40 if (ar.lt.0.0d+0) dtheta = dtheta + dpi 50 dtheta = dtheta*0.5d+0 br = zm*dcos(dtheta) bi = zm*dsin(dtheta) return 60 br = zm*drt bi = zm*drt return 70 br = zm*drt bi = -zm*drt return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zuchk(yr, yi, nz, ascle, tol) c refer to zseri,zuoik,zunk1,zunk2,zuni1,zuni2,zkscl c c y enters as a scaled quantity whose magnitude is greater than c exp(-alim)=ascle=1.0e+3*d1mach(1)/tol. the test is made to see c if the magnitude of the real or imaginary part would underflow c when y is scaled (by tol) to its proper value. y is accepted c if the underflow is at least one precision below the magnitude c of the largest component; otherwise the phase angle does not have c absolute accuracy and an underflow is assumed. c c complex y double precision ascle, ss, st, tol, wr, wi, yr, yi integer nz nz = 0 wr = dabs(yr) wi = dabs(yi) st = dmin1(wr,wi) if (st.gt.ascle) return ss = dmax1(wr,wi) st = st/tol if (ss.lt.st) nz = 1 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zunhj(zr, zi, fnu, ipmtr, tol, phir, phii, argr, argi, * zeta1r, zeta1i, zeta2r, zeta2i, asumr, asumi, bsumr, bsumi) c geuz for g77 EXTERNAL zsqrt EXTERNAL zlog c refer to zbesi,zbesk c c zunhj computes parameters for bessel functions c(fnu,z) = c j(fnu,z), y(fnu,z) or h(i,fnu,z) i=1,2 for large orders fnu c by means of the uniform asymptotic expansion c c c(fnu,z)=c1*phi*( asum*airy(arg) + c2*bsum*dairy(arg) ) c c for proper choices of c1, c2, airy and dairy where airy is c an airy function and dairy is its derivative. c c (2/3)*fnu*zeta**1.5 = zeta1-zeta2, c c zeta1=0.5*fnu*clog((1+w)/(1-w)), zeta2=fnu*w for scaling c purposes in airy functions from cairy or cbiry. c c mconj=sign of aimag(z), but is ambiguous when z is real and c must be specified. ipmtr=0 returns all parameters. ipmtr= c 1 computes all except asum and bsum. c c***routines called zabs2,zdiv,zlog,zsqrt,d1mach c complex arg,asum,bsum,cfnu,cone,cr,czero,dr,p,phi,przth,ptfn, c *rfn13,rtzta,rzth,suma,sumb,tfn,t2,up,w,w2,z,za,zb,zc,zeta,zeta1, c *zeta2,zth double precision alfa, ang, ap, ar, argi, argr, asumi, asumr, * atol, aw2, azth, beta, br, bsumi, bsumr, btol, c, conei, coner, * cri, crr, dri, drr, ex1, ex2, fnu, fn13, fn23, gama, gpi, hpi, * phii, phir, pi, pp, pr, przthi, przthr, ptfni, ptfnr, raw, raw2, * razth, rfnu, rfnu2, rfn13, rtzti, rtztr, rzthi, rzthr, sti, str, * sumai, sumar, sumbi, sumbr, test, tfni, tfnr, thpi, tol, tzai, * tzar, t2i, t2r, upi, upr, wi, wr, w2i, w2r, zai, zar, zbi, zbr, * zci, zcr, zeroi, zeror, zetai, zetar, zeta1i, zeta1r, zeta2i, * zeta2r, zi, zr, zthi, zthr, zabs2, ac, d1mach integer ias, ibs, ipmtr, is, j, jr, ju, k, kmax, kp1, ks, l, lr, * lrp1, l1, l2, m, idum dimension ar(14), br(14), c(105), alfa(180), beta(210), gama(30), * ap(30), pr(30), pi(30), upr(14), upi(14), crr(14), cri(14), * drr(14), dri(14) data ar(1), ar(2), ar(3), ar(4), ar(5), ar(6), ar(7), ar(8), 1 ar(9), ar(10), ar(11), ar(12), ar(13), ar(14)/ 2 1.00000000000000000d+00, 1.04166666666666667d-01, 3 8.35503472222222222d-02, 1.28226574556327160d-01, 4 2.91849026464140464d-01, 8.81627267443757652d-01, 5 3.32140828186276754d+00, 1.49957629868625547d+01, 6 7.89230130115865181d+01, 4.74451538868264323d+02, 7 3.20749009089066193d+03, 2.40865496408740049d+04, 8 1.98923119169509794d+05, 1.79190200777534383d+06/ data br(1), br(2), br(3), br(4), br(5), br(6), br(7), br(8), 1 br(9), br(10), br(11), br(12), br(13), br(14)/ 2 1.00000000000000000d+00, -1.45833333333333333d-01, 3 -9.87413194444444444d-02, -1.43312053915895062d-01, 4 -3.17227202678413548d-01, -9.42429147957120249d-01, 5 -3.51120304082635426d+00, -1.57272636203680451d+01, 6 -8.22814390971859444d+01, -4.92355370523670524d+02, 7 -3.31621856854797251d+03, -2.48276742452085896d+04, 8 -2.04526587315129788d+05, -1.83844491706820990d+06/ data c(1), c(2), c(3), c(4), c(5), c(6), c(7), c(8), c(9), c(10), 1 c(11), c(12), c(13), c(14), c(15), c(16), c(17), c(18), 2 c(19), c(20), c(21), c(22), c(23), c(24)/ 3 1.00000000000000000d+00, -2.08333333333333333d-01, 4 1.25000000000000000d-01, 3.34201388888888889d-01, 5 -4.01041666666666667d-01, 7.03125000000000000d-02, 6 -1.02581259645061728d+00, 1.84646267361111111d+00, 7 -8.91210937500000000d-01, 7.32421875000000000d-02, 8 4.66958442342624743d+00, -1.12070026162229938d+01, 9 8.78912353515625000d+00, -2.36408691406250000d+00, a 1.12152099609375000d-01, -2.82120725582002449d+01, b 8.46362176746007346d+01, -9.18182415432400174d+01, c 4.25349987453884549d+01, -7.36879435947963170d+00, d 2.27108001708984375d-01, 2.12570130039217123d+02, e -7.65252468141181642d+02, 1.05999045252799988d+03/ data c(25), c(26), c(27), c(28), c(29), c(30), c(31), c(32), 1 c(33), c(34), c(35), c(36), c(37), c(38), c(39), c(40), 2 c(41), c(42), c(43), c(44), c(45), c(46), c(47), c(48)/ 3 -6.99579627376132541d+02, 2.18190511744211590d+02, 4 -2.64914304869515555d+01, 5.72501420974731445d-01, 5 -1.91945766231840700d+03, 8.06172218173730938d+03, 6 -1.35865500064341374d+04, 1.16553933368645332d+04, 7 -5.30564697861340311d+03, 1.20090291321635246d+03, 8 -1.08090919788394656d+02, 1.72772750258445740d+00, 9 2.02042913309661486d+04, -9.69805983886375135d+04, a 1.92547001232531532d+05, -2.03400177280415534d+05, b 1.22200464983017460d+05, -4.11926549688975513d+04, c 7.10951430248936372d+03, -4.93915304773088012d+02, d 6.07404200127348304d+00, -2.42919187900551333d+05, e 1.31176361466297720d+06, -2.99801591853810675d+06/ data c(49), c(50), c(51), c(52), c(53), c(54), c(55), c(56), 1 c(57), c(58), c(59), c(60), c(61), c(62), c(63), c(64), 2 c(65), c(66), c(67), c(68), c(69), c(70), c(71), c(72)/ 3 3.76327129765640400d+06, -2.81356322658653411d+06, 4 1.26836527332162478d+06, -3.31645172484563578d+05, 5 4.52187689813627263d+04, -2.49983048181120962d+03, 6 2.43805296995560639d+01, 3.28446985307203782d+06, 7 -1.97068191184322269d+07, 5.09526024926646422d+07, 8 -7.41051482115326577d+07, 6.63445122747290267d+07, 9 -3.75671766607633513d+07, 1.32887671664218183d+07, a -2.78561812808645469d+06, 3.08186404612662398d+05, b -1.38860897537170405d+04, 1.10017140269246738d+02, c -4.93292536645099620d+07, 3.25573074185765749d+08, d -9.39462359681578403d+08, 1.55359689957058006d+09, e -1.62108055210833708d+09, 1.10684281682301447d+09/ data c(73), c(74), c(75), c(76), c(77), c(78), c(79), c(80), 1 c(81), c(82), c(83), c(84), c(85), c(86), c(87), c(88), 2 c(89), c(90), c(91), c(92), c(93), c(94), c(95), c(96)/ 3 -4.95889784275030309d+08, 1.42062907797533095d+08, 4 -2.44740627257387285d+07, 2.24376817792244943d+06, 5 -8.40054336030240853d+04, 5.51335896122020586d+02, 6 8.14789096118312115d+08, -5.86648149205184723d+09, 7 1.86882075092958249d+10, -3.46320433881587779d+10, 8 4.12801855797539740d+10, -3.30265997498007231d+10, 9 1.79542137311556001d+10, -6.56329379261928433d+09, a 1.55927986487925751d+09, -2.25105661889415278d+08, b 1.73951075539781645d+07, -5.49842327572288687d+05, c 3.03809051092238427d+03, -1.46792612476956167d+10, d 1.14498237732025810d+11, -3.99096175224466498d+11, e 8.19218669548577329d+11, -1.09837515608122331d+12/ data c(97), c(98), c(99), c(100), c(101), c(102), c(103), c(104), 1 c(105)/ 2 1.00815810686538209d+12, -6.45364869245376503d+11, 3 2.87900649906150589d+11, -8.78670721780232657d+10, 4 1.76347306068349694d+10, -2.16716498322379509d+09, 5 1.43157876718888981d+08, -3.87183344257261262d+06, 6 1.82577554742931747d+04/ data alfa(1), alfa(2), alfa(3), alfa(4), alfa(5), alfa(6), 1 alfa(7), alfa(8), alfa(9), alfa(10), alfa(11), alfa(12), 2 alfa(13), alfa(14), alfa(15), alfa(16), alfa(17), alfa(18), 3 alfa(19), alfa(20), alfa(21), alfa(22)/ 4 -4.44444444444444444d-03, -9.22077922077922078d-04, 5 -8.84892884892884893d-05, 1.65927687832449737d-04, 6 2.46691372741792910d-04, 2.65995589346254780d-04, 7 2.61824297061500945d-04, 2.48730437344655609d-04, 8 2.32721040083232098d-04, 2.16362485712365082d-04, 9 2.00738858762752355d-04, 1.86267636637545172d-04, a 1.73060775917876493d-04, 1.61091705929015752d-04, b 1.50274774160908134d-04, 1.40503497391269794d-04, c 1.31668816545922806d-04, 1.23667445598253261d-04, d 1.16405271474737902d-04, 1.09798298372713369d-04, e 1.03772410422992823d-04, 9.82626078369363448d-05/ data alfa(23), alfa(24), alfa(25), alfa(26), alfa(27), alfa(28), 1 alfa(29), alfa(30), alfa(31), alfa(32), alfa(33), alfa(34), 2 alfa(35), alfa(36), alfa(37), alfa(38), alfa(39), alfa(40), 3 alfa(41), alfa(42), alfa(43), alfa(44)/ 4 9.32120517249503256d-05, 8.85710852478711718d-05, 5 8.42963105715700223d-05, 8.03497548407791151d-05, 6 7.66981345359207388d-05, 7.33122157481777809d-05, 7 7.01662625163141333d-05, 6.72375633790160292d-05, 8 6.93735541354588974d-04, 2.32241745182921654d-04, 9 -1.41986273556691197d-05, -1.16444931672048640d-04, a -1.50803558053048762d-04, -1.55121924918096223d-04, b -1.46809756646465549d-04, -1.33815503867491367d-04, c -1.19744975684254051d-04, -1.06184319207974020d-04, d -9.37699549891194492d-05, -8.26923045588193274d-05, e -7.29374348155221211d-05, -6.44042357721016283d-05/ data alfa(45), alfa(46), alfa(47), alfa(48), alfa(49), alfa(50), 1 alfa(51), alfa(52), alfa(53), alfa(54), alfa(55), alfa(56), 2 alfa(57), alfa(58), alfa(59), alfa(60), alfa(61), alfa(62), 3 alfa(63), alfa(64), alfa(65), alfa(66)/ 4 -5.69611566009369048d-05, -5.04731044303561628d-05, 5 -4.48134868008882786d-05, -3.98688727717598864d-05, 6 -3.55400532972042498d-05, -3.17414256609022480d-05, 7 -2.83996793904174811d-05, -2.54522720634870566d-05, 8 -2.28459297164724555d-05, -2.05352753106480604d-05, 9 -1.84816217627666085d-05, -1.66519330021393806d-05, a -1.50179412980119482d-05, -1.35554031379040526d-05, b -1.22434746473858131d-05, -1.10641884811308169d-05, c -3.54211971457743841d-04, -1.56161263945159416d-04, d 3.04465503594936410d-05, 1.30198655773242693d-04, e 1.67471106699712269d-04, 1.70222587683592569d-04/ data alfa(67), alfa(68), alfa(69), alfa(70), alfa(71), alfa(72), 1 alfa(73), alfa(74), alfa(75), alfa(76), alfa(77), alfa(78), 2 alfa(79), alfa(80), alfa(81), alfa(82), alfa(83), alfa(84), 3 alfa(85), alfa(86), alfa(87), alfa(88)/ 4 1.56501427608594704d-04, 1.36339170977445120d-04, 5 1.14886692029825128d-04, 9.45869093034688111d-05, 6 7.64498419250898258d-05, 6.07570334965197354d-05, 7 4.74394299290508799d-05, 3.62757512005344297d-05, 8 2.69939714979224901d-05, 1.93210938247939253d-05, 9 1.30056674793963203d-05, 7.82620866744496661d-06, a 3.59257485819351583d-06, 1.44040049814251817d-07, b -2.65396769697939116d-06, -4.91346867098485910d-06, c -6.72739296091248287d-06, -8.17269379678657923d-06, d -9.31304715093561232d-06, -1.02011418798016441d-05, e -1.08805962510592880d-05, -1.13875481509603555d-05/ data alfa(89), alfa(90), alfa(91), alfa(92), alfa(93), alfa(94), 1 alfa(95), alfa(96), alfa(97), alfa(98), alfa(99), alfa(100), 2 alfa(101), alfa(102), alfa(103), alfa(104), alfa(105), 3 alfa(106), alfa(107), alfa(108), alfa(109), alfa(110)/ 4 -1.17519675674556414d-05, -1.19987364870944141d-05, 5 3.78194199201772914d-04, 2.02471952761816167d-04, 6 -6.37938506318862408d-05, -2.38598230603005903d-04, 7 -3.10916256027361568d-04, -3.13680115247576316d-04, 8 -2.78950273791323387d-04, -2.28564082619141374d-04, 9 -1.75245280340846749d-04, -1.25544063060690348d-04, a -8.22982872820208365d-05, -4.62860730588116458d-05, b -1.72334302366962267d-05, 5.60690482304602267d-06, c 2.31395443148286800d-05, 3.62642745856793957d-05, d 4.58006124490188752d-05, 5.24595294959114050d-05, e 5.68396208545815266d-05, 5.94349820393104052d-05/ data alfa(111), alfa(112), alfa(113), alfa(114), alfa(115), 1 alfa(116), alfa(117), alfa(118), alfa(119), alfa(120), 2 alfa(121), alfa(122), alfa(123), alfa(124), alfa(125), 3 alfa(126), alfa(127), alfa(128), alfa(129), alfa(130)/ 4 6.06478527578421742d-05, 6.08023907788436497d-05, 5 6.01577894539460388d-05, 5.89199657344698500d-05, 6 5.72515823777593053d-05, 5.52804375585852577d-05, 7 5.31063773802880170d-05, 5.08069302012325706d-05, 8 4.84418647620094842d-05, 4.60568581607475370d-05, 9 -6.91141397288294174d-04, -4.29976633058871912d-04, a 1.83067735980039018d-04, 6.60088147542014144d-04, b 8.75964969951185931d-04, 8.77335235958235514d-04, c 7.49369585378990637d-04, 5.63832329756980918d-04, d 3.68059319971443156d-04, 1.88464535514455599d-04/ data alfa(131), alfa(132), alfa(133), alfa(134), alfa(135), 1 alfa(136), alfa(137), alfa(138), alfa(139), alfa(140), 2 alfa(141), alfa(142), alfa(143), alfa(144), alfa(145), 3 alfa(146), alfa(147), alfa(148), alfa(149), alfa(150)/ 4 3.70663057664904149d-05, -8.28520220232137023d-05, 5 -1.72751952869172998d-04, -2.36314873605872983d-04, 6 -2.77966150694906658d-04, -3.02079514155456919d-04, 7 -3.12594712643820127d-04, -3.12872558758067163d-04, 8 -3.05678038466324377d-04, -2.93226470614557331d-04, 9 -2.77255655582934777d-04, -2.59103928467031709d-04, a -2.39784014396480342d-04, -2.20048260045422848d-04, b -2.00443911094971498d-04, -1.81358692210970687d-04, c -1.63057674478657464d-04, -1.45712672175205844d-04, d -1.29425421983924587d-04, -1.14245691942445952d-04/ data alfa(151), alfa(152), alfa(153), alfa(154), alfa(155), 1 alfa(156), alfa(157), alfa(158), alfa(159), alfa(160), 2 alfa(161), alfa(162), alfa(163), alfa(164), alfa(165), 3 alfa(166), alfa(167), alfa(168), alfa(169), alfa(170)/ 4 1.92821964248775885d-03, 1.35592576302022234d-03, 5 -7.17858090421302995d-04, -2.58084802575270346d-03, 6 -3.49271130826168475d-03, -3.46986299340960628d-03, 7 -2.82285233351310182d-03, -1.88103076404891354d-03, 8 -8.89531718383947600d-04, 3.87912102631035228d-06, 9 7.28688540119691412d-04, 1.26566373053457758d-03, a 1.62518158372674427d-03, 1.83203153216373172d-03, b 1.91588388990527909d-03, 1.90588846755546138d-03, c 1.82798982421825727d-03, 1.70389506421121530d-03, d 1.55097127171097686d-03, 1.38261421852276159d-03/ data alfa(171), alfa(172), alfa(173), alfa(174), alfa(175), 1 alfa(176), alfa(177), alfa(178), alfa(179), alfa(180)/ 2 1.20881424230064774d-03, 1.03676532638344962d-03, 3 8.71437918068619115d-04, 7.16080155297701002d-04, 4 5.72637002558129372d-04, 4.42089819465802277d-04, 5 3.24724948503090564d-04, 2.20342042730246599d-04, 6 1.28412898401353882d-04, 4.82005924552095464d-05/ data beta(1), beta(2), beta(3), beta(4), beta(5), beta(6), 1 beta(7), beta(8), beta(9), beta(10), beta(11), beta(12), 2 beta(13), beta(14), beta(15), beta(16), beta(17), beta(18), 3 beta(19), beta(20), beta(21), beta(22)/ 4 1.79988721413553309d-02, 5.59964911064388073d-03, 5 2.88501402231132779d-03, 1.80096606761053941d-03, 6 1.24753110589199202d-03, 9.22878876572938311d-04, 7 7.14430421727287357d-04, 5.71787281789704872d-04, 8 4.69431007606481533d-04, 3.93232835462916638d-04, 9 3.34818889318297664d-04, 2.88952148495751517d-04, a 2.52211615549573284d-04, 2.22280580798883327d-04, b 1.97541838033062524d-04, 1.76836855019718004d-04, c 1.59316899661821081d-04, 1.44347930197333986d-04, d 1.31448068119965379d-04, 1.20245444949302884d-04, e 1.10449144504599392d-04, 1.01828770740567258d-04/ data beta(23), beta(24), beta(25), beta(26), beta(27), beta(28), 1 beta(29), beta(30), beta(31), beta(32), beta(33), beta(34), 2 beta(35), beta(36), beta(37), beta(38), beta(39), beta(40), 3 beta(41), beta(42), beta(43), beta(44)/ 4 9.41998224204237509d-05, 8.74130545753834437d-05, 5 8.13466262162801467d-05, 7.59002269646219339d-05, 6 7.09906300634153481d-05, 6.65482874842468183d-05, 7 6.25146958969275078d-05, 5.88403394426251749d-05, 8 -1.49282953213429172d-03, -8.78204709546389328d-04, 9 -5.02916549572034614d-04, -2.94822138512746025d-04, a -1.75463996970782828d-04, -1.04008550460816434d-04, b -5.96141953046457895d-05, -3.12038929076098340d-05, c -1.26089735980230047d-05, -2.42892608575730389d-07, d 8.05996165414273571d-06, 1.36507009262147391d-05, e 1.73964125472926261d-05, 1.98672978842133780d-05/ data beta(45), beta(46), beta(47), beta(48), beta(49), beta(50), 1 beta(51), beta(52), beta(53), beta(54), beta(55), beta(56), 2 beta(57), beta(58), beta(59), beta(60), beta(61), beta(62), 3 beta(63), beta(64), beta(65), beta(66)/ 4 2.14463263790822639d-05, 2.23954659232456514d-05, 5 2.28967783814712629d-05, 2.30785389811177817d-05, 6 2.30321976080909144d-05, 2.28236073720348722d-05, 7 2.25005881105292418d-05, 2.20981015361991429d-05, 8 2.16418427448103905d-05, 2.11507649256220843d-05, 9 2.06388749782170737d-05, 2.01165241997081666d-05, a 1.95913450141179244d-05, 1.90689367910436740d-05, b 1.85533719641636667d-05, 1.80475722259674218d-05, c 5.52213076721292790d-04, 4.47932581552384646d-04, d 2.79520653992020589d-04, 1.52468156198446602d-04, e 6.93271105657043598d-05, 1.76258683069991397d-05/ data beta(67), beta(68), beta(69), beta(70), beta(71), beta(72), 1 beta(73), beta(74), beta(75), beta(76), beta(77), beta(78), 2 beta(79), beta(80), beta(81), beta(82), beta(83), beta(84), 3 beta(85), beta(86), beta(87), beta(88)/ 4 -1.35744996343269136d-05, -3.17972413350427135d-05, 5 -4.18861861696693365d-05, -4.69004889379141029d-05, 6 -4.87665447413787352d-05, -4.87010031186735069d-05, 7 -4.74755620890086638d-05, -4.55813058138628452d-05, 8 -4.33309644511266036d-05, -4.09230193157750364d-05, 9 -3.84822638603221274d-05, -3.60857167535410501d-05, a -3.37793306123367417d-05, -3.15888560772109621d-05, b -2.95269561750807315d-05, -2.75978914828335759d-05, c -2.58006174666883713d-05, -2.41308356761280200d-05, d -2.25823509518346033d-05, -2.11479656768912971d-05, e -1.98200638885294927d-05, -1.85909870801065077d-05/ data beta(89), beta(90), beta(91), beta(92), beta(93), beta(94), 1 beta(95), beta(96), beta(97), beta(98), beta(99), beta(100), 2 beta(101), beta(102), beta(103), beta(104), beta(105), 3 beta(106), beta(107), beta(108), beta(109), beta(110)/ 4 -1.74532699844210224d-05, -1.63997823854497997d-05, 5 -4.74617796559959808d-04, -4.77864567147321487d-04, 6 -3.20390228067037603d-04, -1.61105016119962282d-04, 7 -4.25778101285435204d-05, 3.44571294294967503d-05, 8 7.97092684075674924d-05, 1.03138236708272200d-04, 9 1.12466775262204158d-04, 1.13103642108481389d-04, a 1.08651634848774268d-04, 1.01437951597661973d-04, b 9.29298396593363896d-05, 8.40293133016089978d-05, c 7.52727991349134062d-05, 6.69632521975730872d-05, d 5.92564547323194704d-05, 5.22169308826975567d-05, e 4.58539485165360646d-05, 4.01445513891486808d-05/ data beta(111), beta(112), beta(113), beta(114), beta(115), 1 beta(116), beta(117), beta(118), beta(119), beta(120), 2 beta(121), beta(122), beta(123), beta(124), beta(125), 3 beta(126), beta(127), beta(128), beta(129), beta(130)/ 4 3.50481730031328081d-05, 3.05157995034346659d-05, 5 2.64956119950516039d-05, 2.29363633690998152d-05, 6 1.97893056664021636d-05, 1.70091984636412623d-05, 7 1.45547428261524004d-05, 1.23886640995878413d-05, 8 1.04775876076583236d-05, 8.79179954978479373d-06, 9 7.36465810572578444d-04, 8.72790805146193976d-04, a 6.22614862573135066d-04, 2.85998154194304147d-04, b 3.84737672879366102d-06, -1.87906003636971558d-04, c -2.97603646594554535d-04, -3.45998126832656348d-04, d -3.53382470916037712d-04, -3.35715635775048757d-04/ data beta(131), beta(132), beta(133), beta(134), beta(135), 1 beta(136), beta(137), beta(138), beta(139), beta(140), 2 beta(141), beta(142), beta(143), beta(144), beta(145), 3 beta(146), beta(147), beta(148), beta(149), beta(150)/ 4 -3.04321124789039809d-04, -2.66722723047612821d-04, 5 -2.27654214122819527d-04, -1.89922611854562356d-04, 6 -1.55058918599093870d-04, -1.23778240761873630d-04, 7 -9.62926147717644187d-05, -7.25178327714425337d-05, 8 -5.22070028895633801d-05, -3.50347750511900522d-05, 9 -2.06489761035551757d-05, -8.70106096849767054d-06, a 1.13698686675100290d-06, 9.16426474122778849d-06, b 1.56477785428872620d-05, 2.08223629482466847d-05, c 2.48923381004595156d-05, 2.80340509574146325d-05, d 3.03987774629861915d-05, 3.21156731406700616d-05/ data beta(151), beta(152), beta(153), beta(154), beta(155), 1 beta(156), beta(157), beta(158), beta(159), beta(160), 2 beta(161), beta(162), beta(163), beta(164), beta(165), 3 beta(166), beta(167), beta(168), beta(169), beta(170)/ 4 -1.80182191963885708d-03, -2.43402962938042533d-03, 5 -1.83422663549856802d-03, -7.62204596354009765d-04, 6 2.39079475256927218d-04, 9.49266117176881141d-04, 7 1.34467449701540359d-03, 1.48457495259449178d-03, 8 1.44732339830617591d-03, 1.30268261285657186d-03, 9 1.10351597375642682d-03, 8.86047440419791759d-04, a 6.73073208165665473d-04, 4.77603872856582378d-04, b 3.05991926358789362d-04, 1.60315694594721630d-04, c 4.00749555270613286d-05, -5.66607461635251611d-05, d -1.32506186772982638d-04, -1.90296187989614057d-04/ data beta(171), beta(172), beta(173), beta(174), beta(175), 1 beta(176), beta(177), beta(178), beta(179), beta(180), 2 beta(181), beta(182), beta(183), beta(184), beta(185), 3 beta(186), beta(187), beta(188), beta(189), beta(190)/ 4 -2.32811450376937408d-04, -2.62628811464668841d-04, 5 -2.82050469867598672d-04, -2.93081563192861167d-04, 6 -2.97435962176316616d-04, -2.96557334239348078d-04, 7 -2.91647363312090861d-04, -2.83696203837734166d-04, 8 -2.73512317095673346d-04, -2.61750155806768580d-04, 9 6.38585891212050914d-03, 9.62374215806377941d-03, a 7.61878061207001043d-03, 2.83219055545628054d-03, b -2.09841352012720090d-03, -5.73826764216626498d-03, c -7.70804244495414620d-03, -8.21011692264844401d-03, d -7.65824520346905413d-03, -6.47209729391045177d-03/ data beta(191), beta(192), beta(193), beta(194), beta(195), 1 beta(196), beta(197), beta(198), beta(199), beta(200), 2 beta(201), beta(202), beta(203), beta(204), beta(205), 3 beta(206), beta(207), beta(208), beta(209), beta(210)/ 4 -4.99132412004966473d-03, -3.45612289713133280d-03, 5 -2.01785580014170775d-03, -7.59430686781961401d-04, 6 2.84173631523859138d-04, 1.10891667586337403d-03, 7 1.72901493872728771d-03, 2.16812590802684701d-03, 8 2.45357710494539735d-03, 2.61281821058334862d-03, 9 2.67141039656276912d-03, 2.65203073395980430d-03, a 2.57411652877287315d-03, 2.45389126236094427d-03, b 2.30460058071795494d-03, 2.13684837686712662d-03, c 1.95896528478870911d-03, 1.77737008679454412d-03, d 1.59690280765839059d-03, 1.42111975664438546d-03/ data gama(1), gama(2), gama(3), gama(4), gama(5), gama(6), 1 gama(7), gama(8), gama(9), gama(10), gama(11), gama(12), 2 gama(13), gama(14), gama(15), gama(16), gama(17), gama(18), 3 gama(19), gama(20), gama(21), gama(22)/ 4 6.29960524947436582d-01, 2.51984209978974633d-01, 5 1.54790300415655846d-01, 1.10713062416159013d-01, 6 8.57309395527394825d-02, 6.97161316958684292d-02, 7 5.86085671893713576d-02, 5.04698873536310685d-02, 8 4.42600580689154809d-02, 3.93720661543509966d-02, 9 3.54283195924455368d-02, 3.21818857502098231d-02, a 2.94646240791157679d-02, 2.71581677112934479d-02, b 2.51768272973861779d-02, 2.34570755306078891d-02, c 2.19508390134907203d-02, 2.06210828235646240d-02, d 1.94388240897880846d-02, 1.83810633800683158d-02, e 1.74293213231963172d-02, 1.65685837786612353d-02/ data gama(23), gama(24), gama(25), gama(26), gama(27), gama(28), 1 gama(29), gama(30)/ 2 1.57865285987918445d-02, 1.50729501494095594d-02, 3 1.44193250839954639d-02, 1.38184805735341786d-02, 4 1.32643378994276568d-02, 1.27517121970498651d-02, 5 1.22761545318762767d-02, 1.18338262398482403d-02/ data ex1, ex2, hpi, gpi, thpi / 1 3.33333333333333333d-01, 6.66666666666666667d-01, 2 1.57079632679489662d+00, 3.14159265358979324d+00, 3 4.71238898038468986d+00/ data zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 / c rfnu = 1.0d0/fnu c----------------------------------------------------------------------- c overflow test (z/fnu too small) c----------------------------------------------------------------------- test = d1mach(1)*1.0d+3 ac = fnu*test if (dabs(zr).gt.ac .or. dabs(zi).gt.ac) go to 15 zeta1r = 2.0d0*dabs(dlog(test))+fnu zeta1i = 0.0d0 zeta2r = fnu zeta2i = 0.0d0 phir = 1.0d0 phii = 0.0d0 argr = 1.0d0 argi = 0.0d0 return 15 continue zbr = zr*rfnu zbi = zi*rfnu rfnu2 = rfnu*rfnu c----------------------------------------------------------------------- c compute in the fourth quadrant c----------------------------------------------------------------------- fn13 = fnu**ex1 fn23 = fn13*fn13 rfn13 = 1.0d0/fn13 w2r = coner - zbr*zbr + zbi*zbi w2i = conei - zbr*zbi - zbr*zbi aw2 = zabs2(w2r,w2i) if (aw2.gt.0.25d0) go to 130 c----------------------------------------------------------------------- c power series for cabs(w2).le.0.25d0 c----------------------------------------------------------------------- k = 1 pr(1) = coner pi(1) = conei sumar = gama(1) sumai = zeroi ap(1) = 1.0d0 if (aw2.lt.tol) go to 20 do 10 k=2,30 pr(k) = pr(k-1)*w2r - pi(k-1)*w2i pi(k) = pr(k-1)*w2i + pi(k-1)*w2r sumar = sumar + pr(k)*gama(k) sumai = sumai + pi(k)*gama(k) ap(k) = ap(k-1)*aw2 if (ap(k).lt.tol) go to 20 10 continue k = 30 20 continue kmax = k zetar = w2r*sumar - w2i*sumai zetai = w2r*sumai + w2i*sumar argr = zetar*fn23 argi = zetai*fn23 call zsqrt(sumar, sumai, zar, zai) call zsqrt(w2r, w2i, str, sti) zeta2r = str*fnu zeta2i = sti*fnu str = coner + ex2*(zetar*zar-zetai*zai) sti = conei + ex2*(zetar*zai+zetai*zar) zeta1r = str*zeta2r - sti*zeta2i zeta1i = str*zeta2i + sti*zeta2r zar = zar + zar zai = zai + zai call zsqrt(zar, zai, str, sti) phir = str*rfn13 phii = sti*rfn13 if (ipmtr.eq.1) go to 120 c----------------------------------------------------------------------- c sum series for asum and bsum c----------------------------------------------------------------------- sumbr = zeror sumbi = zeroi do 30 k=1,kmax sumbr = sumbr + pr(k)*beta(k) sumbi = sumbi + pi(k)*beta(k) 30 continue asumr = zeror asumi = zeroi bsumr = sumbr bsumi = sumbi l1 = 0 l2 = 30 btol = tol*(dabs(bsumr)+dabs(bsumi)) atol = tol pp = 1.0d0 ias = 0 ibs = 0 if (rfnu2.lt.tol) go to 110 do 100 is=2,7 atol = atol/rfnu2 pp = pp*rfnu2 if (ias.eq.1) go to 60 sumar = zeror sumai = zeroi do 40 k=1,kmax m = l1 + k sumar = sumar + pr(k)*alfa(m) sumai = sumai + pi(k)*alfa(m) if (ap(k).lt.atol) go to 50 40 continue 50 continue asumr = asumr + sumar*pp asumi = asumi + sumai*pp if (pp.lt.tol) ias = 1 60 continue if (ibs.eq.1) go to 90 sumbr = zeror sumbi = zeroi do 70 k=1,kmax m = l2 + k sumbr = sumbr + pr(k)*beta(m) sumbi = sumbi + pi(k)*beta(m) if (ap(k).lt.atol) go to 80 70 continue 80 continue bsumr = bsumr + sumbr*pp bsumi = bsumi + sumbi*pp if (pp.lt.btol) ibs = 1 90 continue if (ias.eq.1 .and. ibs.eq.1) go to 110 l1 = l1 + 30 l2 = l2 + 30 100 continue 110 continue asumr = asumr + coner pp = rfnu*rfn13 bsumr = bsumr*pp bsumi = bsumi*pp 120 continue return c----------------------------------------------------------------------- c cabs(w2).gt.0.25d0 c----------------------------------------------------------------------- 130 continue call zsqrt(w2r, w2i, wr, wi) if (wr.lt.0.0d0) wr = 0.0d0 if (wi.lt.0.0d0) wi = 0.0d0 str = coner + wr sti = wi call zdiv(str, sti, zbr, zbi, zar, zai) call zlog(zar, zai, zcr, zci, idum) if (zci.lt.0.0d0) zci = 0.0d0 if (zci.gt.hpi) zci = hpi if (zcr.lt.0.0d0) zcr = 0.0d0 zthr = (zcr-wr)*1.5d0 zthi = (zci-wi)*1.5d0 zeta1r = zcr*fnu zeta1i = zci*fnu zeta2r = wr*fnu zeta2i = wi*fnu azth = zabs2(zthr,zthi) ang = thpi if (zthr.ge.0.0d0 .and. zthi.lt.0.0d0) go to 140 ang = hpi if (zthr.eq.0.0d0) go to 140 ang = datan(zthi/zthr) if (zthr.lt.0.0d0) ang = ang + gpi 140 continue pp = azth**ex2 ang = ang*ex2 zetar = pp*dcos(ang) zetai = pp*dsin(ang) if (zetai.lt.0.0d0) zetai = 0.0d0 argr = zetar*fn23 argi = zetai*fn23 call zdiv(zthr, zthi, zetar, zetai, rtztr, rtzti) call zdiv(rtztr, rtzti, wr, wi, zar, zai) tzar = zar + zar tzai = zai + zai call zsqrt(tzar, tzai, str, sti) phir = str*rfn13 phii = sti*rfn13 if (ipmtr.eq.1) go to 120 raw = 1.0d0/dsqrt(aw2) str = wr*raw sti = -wi*raw tfnr = str*rfnu*raw tfni = sti*rfnu*raw razth = 1.0d0/azth str = zthr*razth sti = -zthi*razth rzthr = str*razth*rfnu rzthi = sti*razth*rfnu zcr = rzthr*ar(2) zci = rzthi*ar(2) raw2 = 1.0d0/aw2 str = w2r*raw2 sti = -w2i*raw2 t2r = str*raw2 t2i = sti*raw2 str = t2r*c(2) + c(3) sti = t2i*c(2) upr(2) = str*tfnr - sti*tfni upi(2) = str*tfni + sti*tfnr bsumr = upr(2) + zcr bsumi = upi(2) + zci asumr = zeror asumi = zeroi if (rfnu.lt.tol) go to 220 przthr = rzthr przthi = rzthi ptfnr = tfnr ptfni = tfni upr(1) = coner upi(1) = conei pp = 1.0d0 btol = tol*(dabs(bsumr)+dabs(bsumi)) ks = 0 kp1 = 2 l = 3 ias = 0 ibs = 0 do 210 lr=2,12,2 lrp1 = lr + 1 c----------------------------------------------------------------------- c compute two additional cr, dr, and up for two more terms in c next suma and sumb c----------------------------------------------------------------------- do 160 k=lr,lrp1 ks = ks + 1 kp1 = kp1 + 1 l = l + 1 zar = c(l) zai = zeroi do 150 j=2,kp1 l = l + 1 str = zar*t2r - t2i*zai + c(l) zai = zar*t2i + zai*t2r zar = str 150 continue str = ptfnr*tfnr - ptfni*tfni ptfni = ptfnr*tfni + ptfni*tfnr ptfnr = str upr(kp1) = ptfnr*zar - ptfni*zai upi(kp1) = ptfni*zar + ptfnr*zai crr(ks) = przthr*br(ks+1) cri(ks) = przthi*br(ks+1) str = przthr*rzthr - przthi*rzthi przthi = przthr*rzthi + przthi*rzthr przthr = str drr(ks) = przthr*ar(ks+2) dri(ks) = przthi*ar(ks+2) 160 continue pp = pp*rfnu2 if (ias.eq.1) go to 180 sumar = upr(lrp1) sumai = upi(lrp1) ju = lrp1 do 170 jr=1,lr ju = ju - 1 sumar = sumar + crr(jr)*upr(ju) - cri(jr)*upi(ju) sumai = sumai + crr(jr)*upi(ju) + cri(jr)*upr(ju) 170 continue asumr = asumr + sumar asumi = asumi + sumai test = dabs(sumar) + dabs(sumai) if (pp.lt.tol .and. test.lt.tol) ias = 1 180 continue if (ibs.eq.1) go to 200 sumbr = upr(lr+2) + upr(lrp1)*zcr - upi(lrp1)*zci sumbi = upi(lr+2) + upr(lrp1)*zci + upi(lrp1)*zcr ju = lrp1 do 190 jr=1,lr ju = ju - 1 sumbr = sumbr + drr(jr)*upr(ju) - dri(jr)*upi(ju) sumbi = sumbi + drr(jr)*upi(ju) + dri(jr)*upr(ju) 190 continue bsumr = bsumr + sumbr bsumi = bsumi + sumbi test = dabs(sumbr) + dabs(sumbi) if (pp.lt.btol .and. test.lt.btol) ibs = 1 200 continue if (ias.eq.1 .and. ibs.eq.1) go to 220 210 continue 220 continue asumr = asumr + coner str = -bsumr*rfn13 sti = -bsumi*rfn13 call zdiv(str, sti, rtztr, rtzti, bsumr, bsumi) go to 120 end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zuni1(zr, zi, fnu, kode, n, yr, yi, nz, nlast, fnul, * tol, elim, alim) c refer to zbesi,zbesk c c zuni1 computes i(fnu,z) by means of the uniform asymptotic c expansion for i(fnu,z) in -pi/3.le.arg z.le.pi/3. c c fnul is the smallest order permitted for the asymptotic c expansion. nlast=0 means all of the y values were set. c nlast.ne.0 is the number left to be computed by another c formula for orders fnu to fnu+nlast-1 because fnu+nlast-1.lt.fnul. c y(i)=czero for i=nlast+1,n c c***routines called zuchk,zunik,zuoik,d1mach,zabs2 c complex cfn,cone,crsc,cscl,csr,css,cwrk,czero,c1,c2,phi,rz,sum,s1, c *s2,y,z,zeta1,zeta2 double precision alim, aphi, ascle, bry, coner, crsc, * cscl, csrr, cssr, cwrki, cwrkr, c1r, c2i, c2m, c2r, elim, fn, * fnu, fnul, phii, phir, rast, rs1, rzi, rzr, sti, str, sumi, * sumr, s1i, s1r, s2i, s2r, tol, yi, yr, zeroi, zeror, zeta1i, * zeta1r, zeta2i, zeta2r, zi, zr, cyr, cyi, d1mach, zabs2 integer i, iflag, init, k, kode, m, n, nd, nlast, nn, nuf, nw, nz dimension bry(3), yr(n), yi(n), cwrkr(16), cwrki(16), cssr(3), * csrr(3), cyr(2), cyi(2) data zeror,zeroi,coner / 0.0d0, 0.0d0, 1.0d0 / c nz = 0 nd = n nlast = 0 c----------------------------------------------------------------------- c computed values with exponents between alim and elim in mag- c nitude are scaled to keep intermediate arithmetic on scale, c exp(alim)=exp(elim)*tol c----------------------------------------------------------------------- cscl = 1.0d0/tol crsc = tol cssr(1) = cscl cssr(2) = coner cssr(3) = crsc csrr(1) = crsc csrr(2) = coner csrr(3) = cscl bry(1) = 1.0d+3*d1mach(1)/tol c----------------------------------------------------------------------- c check for underflow and overflow on first member c----------------------------------------------------------------------- fn = dmax1(fnu,1.0d0) init = 0 call zunik(zr, zi, fn, 1, 1, tol, init, phir, phii, zeta1r, * zeta1i, zeta2r, zeta2i, sumr, sumi, cwrkr, cwrki) if (kode.eq.1) go to 10 str = zr + zeta2r sti = zi + zeta2i rast = fn/zabs2(str,sti) str = str*rast*rast sti = -sti*rast*rast s1r = -zeta1r + str s1i = -zeta1i + sti go to 20 10 continue s1r = -zeta1r + zeta2r s1i = -zeta1i + zeta2i 20 continue rs1 = s1r if (dabs(rs1).gt.elim) go to 130 30 continue nn = min0(2,nd) do 80 i=1,nn fn = fnu + dble(float(nd-i)) init = 0 call zunik(zr, zi, fn, 1, 0, tol, init, phir, phii, zeta1r, * zeta1i, zeta2r, zeta2i, sumr, sumi, cwrkr, cwrki) if (kode.eq.1) go to 40 str = zr + zeta2r sti = zi + zeta2i rast = fn/zabs2(str,sti) str = str*rast*rast sti = -sti*rast*rast s1r = -zeta1r + str s1i = -zeta1i + sti + zi go to 50 40 continue s1r = -zeta1r + zeta2r s1i = -zeta1i + zeta2i 50 continue c----------------------------------------------------------------------- c test for underflow and overflow c----------------------------------------------------------------------- rs1 = s1r if (dabs(rs1).gt.elim) go to 110 if (i.eq.1) iflag = 2 if (dabs(rs1).lt.alim) go to 60 c----------------------------------------------------------------------- c refine test and scale c----------------------------------------------------------------------- aphi = zabs2(phir,phii) rs1 = rs1 + dlog(aphi) if (dabs(rs1).gt.elim) go to 110 if (i.eq.1) iflag = 1 if (rs1.lt.0.0d0) go to 60 if (i.eq.1) iflag = 3 60 continue c----------------------------------------------------------------------- c scale s1 if cabs(s1).lt.ascle c----------------------------------------------------------------------- s2r = phir*sumr - phii*sumi s2i = phir*sumi + phii*sumr str = dexp(s1r)*cssr(iflag) s1r = str*dcos(s1i) s1i = str*dsin(s1i) str = s2r*s1r - s2i*s1i s2i = s2r*s1i + s2i*s1r s2r = str if (iflag.ne.1) go to 70 call zuchk(s2r, s2i, nw, bry(1), tol) if (nw.ne.0) go to 110 70 continue cyr(i) = s2r cyi(i) = s2i m = nd - i + 1 yr(m) = s2r*csrr(iflag) yi(m) = s2i*csrr(iflag) 80 continue if (nd.le.2) go to 100 rast = 1.0d0/zabs2(zr,zi) str = zr*rast sti = -zi*rast rzr = (str+str)*rast rzi = (sti+sti)*rast bry(2) = 1.0d0/bry(1) bry(3) = d1mach(2) s1r = cyr(1) s1i = cyi(1) s2r = cyr(2) s2i = cyi(2) c1r = csrr(iflag) ascle = bry(iflag) k = nd - 2 fn = dble(float(k)) do 90 i=3,nd c2r = s2r c2i = s2i s2r = s1r + (fnu+fn)*(rzr*c2r-rzi*c2i) s2i = s1i + (fnu+fn)*(rzr*c2i+rzi*c2r) s1r = c2r s1i = c2i c2r = s2r*c1r c2i = s2i*c1r yr(k) = c2r yi(k) = c2i k = k - 1 fn = fn - 1.0d0 if (iflag.ge.3) go to 90 str = dabs(c2r) sti = dabs(c2i) c2m = dmax1(str,sti) if (c2m.le.ascle) go to 90 iflag = iflag + 1 ascle = bry(iflag) s1r = s1r*c1r s1i = s1i*c1r s2r = c2r s2i = c2i s1r = s1r*cssr(iflag) s1i = s1i*cssr(iflag) s2r = s2r*cssr(iflag) s2i = s2i*cssr(iflag) c1r = csrr(iflag) 90 continue 100 continue return c----------------------------------------------------------------------- c set underflow and update parameters c----------------------------------------------------------------------- 110 continue if (rs1.gt.0.0d0) go to 120 yr(nd) = zeror yi(nd) = zeroi nz = nz + 1 nd = nd - 1 if (nd.eq.0) go to 100 call zuoik(zr, zi, fnu, kode, 1, nd, yr, yi, nuf, tol, elim, alim) if (nuf.lt.0) go to 120 nd = nd - nuf nz = nz + nuf if (nd.eq.0) go to 100 fn = fnu + dble(float(nd-1)) if (fn.ge.fnul) go to 30 nlast = nd return 120 continue nz = -1 return 130 continue if (rs1.gt.0.0d0) go to 120 nz = n do 140 i=1,n yr(i) = zeror yi(i) = zeroi 140 continue return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zuni2(zr, zi, fnu, kode, n, yr, yi, nz, nlast, fnul, * tol, elim, alim) c refer to zbesi,zbesk c c zuni2 computes i(fnu,z) in the right half plane by means of c uniform asymptotic expansion for j(fnu,zn) where zn is z*i c or -z*i and zn is in the right half plane also. c c fnul is the smallest order permitted for the asymptotic c expansion. nlast=0 means all of the y values were set. c nlast.ne.0 is the number left to be computed by another c formula for orders fnu to fnu+nlast-1 because fnu+nlast-1.lt.fnul. c y(i)=czero for i=nlast+1,n c c***routines called zairy,zuchk,zunhj,zuoik,d1mach,zabs2 c complex ai,arg,asum,bsum,cfn,ci,cid,cip,cone,crsc,cscl,csr,css, c *czero,c1,c2,dai,phi,rz,s1,s2,y,z,zb,zeta1,zeta2,zn double precision aarg, aic, aii, air, alim, ang, aphi, argi, * argr, ascle, asumi, asumr, bry, bsumi, bsumr, cidi, cipi, cipr, * coner, crsc, cscl, csrr, cssr, c1r, c2i, c2m, c2r, daii, * dair, elim, fn, fnu, fnul, hpi, phii, phir, rast, raz, rs1, rzi, * rzr, sti, str, s1i, s1r, s2i, s2r, tol, yi, yr, zbi, zbr, zeroi, * zeror, zeta1i, zeta1r, zeta2i, zeta2r, zi, zni, znr, zr, cyr, * cyi, d1mach, zabs2, car, sar integer i, iflag, in, inu, j, k, kode, n, nai, nd, ndai, nlast, * nn, nuf, nw, nz, idum dimension bry(3), yr(n), yi(n), cipr(4), cipi(4), cssr(3), * csrr(3), cyr(2), cyi(2) data zeror,zeroi,coner / 0.0d0, 0.0d0, 1.0d0 / data cipr(1),cipi(1),cipr(2),cipi(2),cipr(3),cipi(3),cipr(4), * cipi(4)/ 1.0d0,0.0d0, 0.0d0,1.0d0, -1.0d0,0.0d0, 0.0d0,-1.0d0/ data hpi, aic / 1 1.57079632679489662d+00, 1.265512123484645396d+00/ c nz = 0 nd = n nlast = 0 c----------------------------------------------------------------------- c computed values with exponents between alim and elim in mag- c nitude are scaled to keep intermediate arithmetic on scale, c exp(alim)=exp(elim)*tol c----------------------------------------------------------------------- cscl = 1.0d0/tol crsc = tol cssr(1) = cscl cssr(2) = coner cssr(3) = crsc csrr(1) = crsc csrr(2) = coner csrr(3) = cscl bry(1) = 1.0d+3*d1mach(1)/tol c----------------------------------------------------------------------- c zn is in the right half plane after rotation by ci or -ci c----------------------------------------------------------------------- znr = zi zni = -zr zbr = zr zbi = zi cidi = -coner inu = int(sngl(fnu)) ang = hpi*(fnu-dble(float(inu))) c2r = dcos(ang) c2i = dsin(ang) car = c2r sar = c2i in = inu + n - 1 in = mod(in,4) + 1 str = c2r*cipr(in) - c2i*cipi(in) c2i = c2r*cipi(in) + c2i*cipr(in) c2r = str if (zi.gt.0.0d0) go to 10 znr = -znr zbi = -zbi cidi = -cidi c2i = -c2i 10 continue c----------------------------------------------------------------------- c check for underflow and overflow on first member c----------------------------------------------------------------------- fn = dmax1(fnu,1.0d0) call zunhj(znr, zni, fn, 1, tol, phir, phii, argr, argi, zeta1r, * zeta1i, zeta2r, zeta2i, asumr, asumi, bsumr, bsumi) if (kode.eq.1) go to 20 str = zbr + zeta2r sti = zbi + zeta2i rast = fn/zabs2(str,sti) str = str*rast*rast sti = -sti*rast*rast s1r = -zeta1r + str s1i = -zeta1i + sti go to 30 20 continue s1r = -zeta1r + zeta2r s1i = -zeta1i + zeta2i 30 continue rs1 = s1r if (dabs(rs1).gt.elim) go to 150 40 continue nn = min0(2,nd) do 90 i=1,nn fn = fnu + dble(float(nd-i)) call zunhj(znr, zni, fn, 0, tol, phir, phii, argr, argi, * zeta1r, zeta1i, zeta2r, zeta2i, asumr, asumi, bsumr, bsumi) if (kode.eq.1) go to 50 str = zbr + zeta2r sti = zbi + zeta2i rast = fn/zabs2(str,sti) str = str*rast*rast sti = -sti*rast*rast s1r = -zeta1r + str s1i = -zeta1i + sti + dabs(zi) go to 60 50 continue s1r = -zeta1r + zeta2r s1i = -zeta1i + zeta2i 60 continue c----------------------------------------------------------------------- c test for underflow and overflow c----------------------------------------------------------------------- rs1 = s1r if (dabs(rs1).gt.elim) go to 120 if (i.eq.1) iflag = 2 if (dabs(rs1).lt.alim) go to 70 c----------------------------------------------------------------------- c refine test and scale c----------------------------------------------------------------------- c----------------------------------------------------------------------- aphi = zabs2(phir,phii) aarg = zabs2(argr,argi) rs1 = rs1 + dlog(aphi) - 0.25d0*dlog(aarg) - aic if (dabs(rs1).gt.elim) go to 120 if (i.eq.1) iflag = 1 if (rs1.lt.0.0d0) go to 70 if (i.eq.1) iflag = 3 70 continue c----------------------------------------------------------------------- c scale s1 to keep intermediate arithmetic on scale near c exponent extremes c----------------------------------------------------------------------- call zairy(argr, argi, 0, 2, air, aii, nai, idum) call zairy(argr, argi, 1, 2, dair, daii, ndai, idum) str = dair*bsumr - daii*bsumi sti = dair*bsumi + daii*bsumr str = str + (air*asumr-aii*asumi) sti = sti + (air*asumi+aii*asumr) s2r = phir*str - phii*sti s2i = phir*sti + phii*str str = dexp(s1r)*cssr(iflag) s1r = str*dcos(s1i) s1i = str*dsin(s1i) str = s2r*s1r - s2i*s1i s2i = s2r*s1i + s2i*s1r s2r = str if (iflag.ne.1) go to 80 call zuchk(s2r, s2i, nw, bry(1), tol) if (nw.ne.0) go to 120 80 continue if (zi.le.0.0d0) s2i = -s2i str = s2r*c2r - s2i*c2i s2i = s2r*c2i + s2i*c2r s2r = str cyr(i) = s2r cyi(i) = s2i j = nd - i + 1 yr(j) = s2r*csrr(iflag) yi(j) = s2i*csrr(iflag) str = -c2i*cidi c2i = c2r*cidi c2r = str 90 continue if (nd.le.2) go to 110 raz = 1.0d0/zabs2(zr,zi) str = zr*raz sti = -zi*raz rzr = (str+str)*raz rzi = (sti+sti)*raz bry(2) = 1.0d0/bry(1) bry(3) = d1mach(2) s1r = cyr(1) s1i = cyi(1) s2r = cyr(2) s2i = cyi(2) c1r = csrr(iflag) ascle = bry(iflag) k = nd - 2 fn = dble(float(k)) do 100 i=3,nd c2r = s2r c2i = s2i s2r = s1r + (fnu+fn)*(rzr*c2r-rzi*c2i) s2i = s1i + (fnu+fn)*(rzr*c2i+rzi*c2r) s1r = c2r s1i = c2i c2r = s2r*c1r c2i = s2i*c1r yr(k) = c2r yi(k) = c2i k = k - 1 fn = fn - 1.0d0 if (iflag.ge.3) go to 100 str = dabs(c2r) sti = dabs(c2i) c2m = dmax1(str,sti) if (c2m.le.ascle) go to 100 iflag = iflag + 1 ascle = bry(iflag) s1r = s1r*c1r s1i = s1i*c1r s2r = c2r s2i = c2i s1r = s1r*cssr(iflag) s1i = s1i*cssr(iflag) s2r = s2r*cssr(iflag) s2i = s2i*cssr(iflag) c1r = csrr(iflag) 100 continue 110 continue return 120 continue if (rs1.gt.0.0d0) go to 140 c----------------------------------------------------------------------- c set underflow and update parameters c----------------------------------------------------------------------- yr(nd) = zeror yi(nd) = zeroi nz = nz + 1 nd = nd - 1 if (nd.eq.0) go to 110 call zuoik(zr, zi, fnu, kode, 1, nd, yr, yi, nuf, tol, elim, alim) if (nuf.lt.0) go to 140 nd = nd - nuf nz = nz + nuf if (nd.eq.0) go to 110 fn = fnu + dble(float(nd-1)) if (fn.lt.fnul) go to 130 c fn = cidi c j = nuf + 1 c k = mod(j,4) + 1 c s1r = cipr(k) c s1i = cipi(k) c if (fn.lt.0.0d0) s1i = -s1i c str = c2r*s1r - c2i*s1i c c2i = c2r*s1i + c2i*s1r c c2r = str in = inu + nd - 1 in = mod(in,4) + 1 c2r = car*cipr(in) - sar*cipi(in) c2i = car*cipi(in) + sar*cipr(in) if (zi.le.0.0d0) c2i = -c2i go to 40 130 continue nlast = nd return 140 continue nz = -1 return 150 continue if (rs1.gt.0.0d0) go to 140 nz = n do 160 i=1,n yr(i) = zeror yi(i) = zeroi 160 continue return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zunik(zrr, zri, fnu, ikflg, ipmtr, tol, init, phir, * phii, zeta1r, zeta1i, zeta2r, zeta2i, sumr, sumi, cwrkr, cwrki) c geuz for g77 EXTERNAL zsqrt EXTERNAL zlog c Refer to zbesi,zbesk c c zunik computes parameters for the uniform asymptotic c expansions of the i and k functions on ikflg= 1 or 2 c respectively by c c w(fnu,zr) = phi*exp(zeta)*sum c c where zeta=-zeta1 + zeta2 or c zeta1 - zeta2 c c the first call must have init=0. subsequent calls with the c same zr and fnu will return the i or k function on ikflg= c 1 or 2 with no change in init. cwrk is a complex work c array. ipmtr=0 computes all parameters. ipmtr=1 computes phi, c zeta1,zeta2. c c***routines called zdiv,zlog,zsqrt,d1mach c complex cfn,con,cone,crfn,cwrk,czero,phi,s,sr,sum,t,t2,zeta1, c *zeta2,zn,zr double precision ac, c, con, conei, coner, crfni, crfnr, cwrki, * cwrkr, fnu, phii, phir, rfn, si, sr, sri, srr, sti, str, sumi, * sumr, test, ti, tol, tr, t2i, t2r, zeroi, zeror, zeta1i, zeta1r, * zeta2i, zeta2r, zni, znr, zri, zrr, d1mach integer i, idum, ikflg, init, ipmtr, j, k, l dimension c(120), cwrkr(16), cwrki(16), con(2) data zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 / data con(1), con(2) / 1 3.98942280401432678d-01, 1.25331413731550025d+00 / data c(1), c(2), c(3), c(4), c(5), c(6), c(7), c(8), c(9), c(10), 1 c(11), c(12), c(13), c(14), c(15), c(16), c(17), c(18), 2 c(19), c(20), c(21), c(22), c(23), c(24)/ 3 1.00000000000000000d+00, -2.08333333333333333d-01, 4 1.25000000000000000d-01, 3.34201388888888889d-01, 5 -4.01041666666666667d-01, 7.03125000000000000d-02, 6 -1.02581259645061728d+00, 1.84646267361111111d+00, 7 -8.91210937500000000d-01, 7.32421875000000000d-02, 8 4.66958442342624743d+00, -1.12070026162229938d+01, 9 8.78912353515625000d+00, -2.36408691406250000d+00, a 1.12152099609375000d-01, -2.82120725582002449d+01, b 8.46362176746007346d+01, -9.18182415432400174d+01, c 4.25349987453884549d+01, -7.36879435947963170d+00, d 2.27108001708984375d-01, 2.12570130039217123d+02, e -7.65252468141181642d+02, 1.05999045252799988d+03/ data c(25), c(26), c(27), c(28), c(29), c(30), c(31), c(32), 1 c(33), c(34), c(35), c(36), c(37), c(38), c(39), c(40), 2 c(41), c(42), c(43), c(44), c(45), c(46), c(47), c(48)/ 3 -6.99579627376132541d+02, 2.18190511744211590d+02, 4 -2.64914304869515555d+01, 5.72501420974731445d-01, 5 -1.91945766231840700d+03, 8.06172218173730938d+03, 6 -1.35865500064341374d+04, 1.16553933368645332d+04, 7 -5.30564697861340311d+03, 1.20090291321635246d+03, 8 -1.08090919788394656d+02, 1.72772750258445740d+00, 9 2.02042913309661486d+04, -9.69805983886375135d+04, a 1.92547001232531532d+05, -2.03400177280415534d+05, b 1.22200464983017460d+05, -4.11926549688975513d+04, c 7.10951430248936372d+03, -4.93915304773088012d+02, d 6.07404200127348304d+00, -2.42919187900551333d+05, e 1.31176361466297720d+06, -2.99801591853810675d+06/ data c(49), c(50), c(51), c(52), c(53), c(54), c(55), c(56), 1 c(57), c(58), c(59), c(60), c(61), c(62), c(63), c(64), 2 c(65), c(66), c(67), c(68), c(69), c(70), c(71), c(72)/ 3 3.76327129765640400d+06, -2.81356322658653411d+06, 4 1.26836527332162478d+06, -3.31645172484563578d+05, 5 4.52187689813627263d+04, -2.49983048181120962d+03, 6 2.43805296995560639d+01, 3.28446985307203782d+06, 7 -1.97068191184322269d+07, 5.09526024926646422d+07, 8 -7.41051482115326577d+07, 6.63445122747290267d+07, 9 -3.75671766607633513d+07, 1.32887671664218183d+07, a -2.78561812808645469d+06, 3.08186404612662398d+05, b -1.38860897537170405d+04, 1.10017140269246738d+02, c -4.93292536645099620d+07, 3.25573074185765749d+08, d -9.39462359681578403d+08, 1.55359689957058006d+09, e -1.62108055210833708d+09, 1.10684281682301447d+09/ data c(73), c(74), c(75), c(76), c(77), c(78), c(79), c(80), 1 c(81), c(82), c(83), c(84), c(85), c(86), c(87), c(88), 2 c(89), c(90), c(91), c(92), c(93), c(94), c(95), c(96)/ 3 -4.95889784275030309d+08, 1.42062907797533095d+08, 4 -2.44740627257387285d+07, 2.24376817792244943d+06, 5 -8.40054336030240853d+04, 5.51335896122020586d+02, 6 8.14789096118312115d+08, -5.86648149205184723d+09, 7 1.86882075092958249d+10, -3.46320433881587779d+10, 8 4.12801855797539740d+10, -3.30265997498007231d+10, 9 1.79542137311556001d+10, -6.56329379261928433d+09, a 1.55927986487925751d+09, -2.25105661889415278d+08, b 1.73951075539781645d+07, -5.49842327572288687d+05, c 3.03809051092238427d+03, -1.46792612476956167d+10, d 1.14498237732025810d+11, -3.99096175224466498d+11, e 8.19218669548577329d+11, -1.09837515608122331d+12/ data c(97), c(98), c(99), c(100), c(101), c(102), c(103), c(104), 1 c(105), c(106), c(107), c(108), c(109), c(110), c(111), 2 c(112), c(113), c(114), c(115), c(116), c(117), c(118)/ 3 1.00815810686538209d+12, -6.45364869245376503d+11, 4 2.87900649906150589d+11, -8.78670721780232657d+10, 5 1.76347306068349694d+10, -2.16716498322379509d+09, 6 1.43157876718888981d+08, -3.87183344257261262d+06, 7 1.82577554742931747d+04, 2.86464035717679043d+11, 8 -2.40629790002850396d+12, 9.10934118523989896d+12, 9 -2.05168994109344374d+13, 3.05651255199353206d+13, a -3.16670885847851584d+13, 2.33483640445818409d+13, b -1.23204913055982872d+13, 4.61272578084913197d+12, c -1.19655288019618160d+12, 2.05914503232410016d+11, d -2.18229277575292237d+10, 1.24700929351271032d+09/ data c(119), c(120)/ 1 -2.91883881222208134d+07, 1.18838426256783253d+05/ c if (init.ne.0) go to 40 c----------------------------------------------------------------------- c initialize all variables c----------------------------------------------------------------------- rfn = 1.0d0/fnu c----------------------------------------------------------------------- c overflow test (zr/fnu too small) c----------------------------------------------------------------------- test = d1mach(1)*1.0d+3 ac = fnu*test if (dabs(zrr).gt.ac .or. dabs(zri).gt.ac) go to 15 zeta1r = 2.0d0*dabs(dlog(test))+fnu zeta1i = 0.0d0 zeta2r = fnu zeta2i = 0.0d0 phir = 1.0d0 phii = 0.0d0 return 15 continue tr = zrr*rfn ti = zri*rfn sr = coner + (tr*tr-ti*ti) si = conei + (tr*ti+ti*tr) call zsqrt(sr, si, srr, sri) str = coner + srr sti = conei + sri call zdiv(str, sti, tr, ti, znr, zni) call zlog(znr, zni, str, sti, idum) zeta1r = fnu*str zeta1i = fnu*sti zeta2r = fnu*srr zeta2i = fnu*sri call zdiv(coner, conei, srr, sri, tr, ti) srr = tr*rfn sri = ti*rfn call zsqrt(srr, sri, cwrkr(16), cwrki(16)) phir = cwrkr(16)*con(ikflg) phii = cwrki(16)*con(ikflg) if (ipmtr.ne.0) return call zdiv(coner, conei, sr, si, t2r, t2i) cwrkr(1) = coner cwrki(1) = conei crfnr = coner crfni = conei ac = 1.0d0 l = 1 do 20 k=2,15 sr = zeror si = zeroi do 10 j=1,k l = l + 1 str = sr*t2r - si*t2i + c(l) si = sr*t2i + si*t2r sr = str 10 continue str = crfnr*srr - crfni*sri crfni = crfnr*sri + crfni*srr crfnr = str cwrkr(k) = crfnr*sr - crfni*si cwrki(k) = crfnr*si + crfni*sr ac = ac*rfn test = dabs(cwrkr(k)) + dabs(cwrki(k)) if (ac.lt.tol .and. test.lt.tol) go to 30 20 continue k = 15 30 continue init = k 40 continue if (ikflg.eq.2) go to 60 c----------------------------------------------------------------------- c compute sum for the i function c----------------------------------------------------------------------- sr = zeror si = zeroi do 50 i=1,init sr = sr + cwrkr(i) si = si + cwrki(i) 50 continue sumr = sr sumi = si phir = cwrkr(16)*con(1) phii = cwrki(16)*con(1) return 60 continue c----------------------------------------------------------------------- c compute sum for the k function c----------------------------------------------------------------------- sr = zeror si = zeroi tr = coner do 70 i=1,init sr = sr + tr*cwrkr(i) si = si + tr*cwrki(i) tr = -tr 70 continue sumr = sr sumi = si phir = cwrkr(16)*con(2) phii = cwrki(16)*con(2) return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zunk1(zr, zi, fnu, kode, mr, n, yr, yi, nz, tol, elim, * alim) c refer to zbesk c c zunk1 computes k(fnu,z) and its analytic continuation from the c right half plane to the left half plane by means of the c uniform asymptotic expansion. c mr indicates the direction of rotation for analytic continuation. c nz=-1 means an overflow will occur c c***routines called zkscl,zs1s2,zuchk,zunik,d1mach,zabs2 c complex cfn,ck,cone,crsc,cs,cscl,csgn,cspn,csr,css,cwrk,cy,czero, c *c1,c2,phi,phid,rz,sum,sumd,s1,s2,y,z,zeta1,zeta1d,zeta2,zeta2d,zr double precision alim, ang, aphi, asc, ascle, bry, cki, ckr, * coner, crsc, cscl, csgni, cspni, cspnr, csr, csrr, cssr, * cwrki, cwrkr, cyi, cyr, c1i, c1r, c2i, c2m, c2r, elim, fmr, fn, * fnf, fnu, phidi, phidr, phii, phir, pi, rast, razr, rs1, rzi, * rzr, sgn, sti, str, sumdi, sumdr, sumi, sumr, s1i, s1r, s2i, * s2r, tol, yi, yr, zeroi, zeror, zeta1i, zeta1r, zeta2i, zeta2r, * zet1di, zet1dr, zet2di, zet2dr, zi, zr, zri, zrr, d1mach, zabs2 integer i, ib, iflag, ifn, il, init, inu, iuf, k, kdflg, kflag, * kk, kode, mr, n, nw, nz, initd, ic, ipard, j dimension bry(3), init(2), yr(n), yi(n), sumr(2), sumi(2), * zeta1r(2), zeta1i(2), zeta2r(2), zeta2i(2), cyr(2), cyi(2), * cwrkr(16,3), cwrki(16,3), cssr(3), csrr(3), phir(2), phii(2) data zeror,zeroi,coner / 0.0d0, 0.0d0, 1.0d0 / data pi / 3.14159265358979324d0 / c kdflg = 1 nz = 0 c----------------------------------------------------------------------- c exp(-alim)=exp(-elim)/tol=approx. one precision greater than c the underflow limit c----------------------------------------------------------------------- cscl = 1.0d0/tol crsc = tol cssr(1) = cscl cssr(2) = coner cssr(3) = crsc csrr(1) = crsc csrr(2) = coner csrr(3) = cscl bry(1) = 1.0d+3*d1mach(1)/tol bry(2) = 1.0d0/bry(1) bry(3) = d1mach(2) zrr = zr zri = zi if (zr.ge.0.0d0) go to 10 zrr = -zr zri = -zi 10 continue j = 2 do 70 i=1,n c----------------------------------------------------------------------- c j flip flops between 1 and 2 in j = 3 - j c----------------------------------------------------------------------- j = 3 - j fn = fnu + dble(float(i-1)) init(j) = 0 call zunik(zrr, zri, fn, 2, 0, tol, init(j), phir(j), phii(j), * zeta1r(j), zeta1i(j), zeta2r(j), zeta2i(j), sumr(j), sumi(j), * cwrkr(1,j), cwrki(1,j)) if (kode.eq.1) go to 20 str = zrr + zeta2r(j) sti = zri + zeta2i(j) rast = fn/zabs2(str,sti) str = str*rast*rast sti = -sti*rast*rast s1r = zeta1r(j) - str s1i = zeta1i(j) - sti go to 30 20 continue s1r = zeta1r(j) - zeta2r(j) s1i = zeta1i(j) - zeta2i(j) 30 continue rs1 = s1r c----------------------------------------------------------------------- c test for underflow and overflow c----------------------------------------------------------------------- if (dabs(rs1).gt.elim) go to 60 if (kdflg.eq.1) kflag = 2 if (dabs(rs1).lt.alim) go to 40 c----------------------------------------------------------------------- c refine test and scale c----------------------------------------------------------------------- aphi = zabs2(phir(j),phii(j)) rs1 = rs1 + dlog(aphi) if (dabs(rs1).gt.elim) go to 60 if (kdflg.eq.1) kflag = 1 if (rs1.lt.0.0d0) go to 40 if (kdflg.eq.1) kflag = 3 40 continue c----------------------------------------------------------------------- c scale s1 to keep intermediate arithmetic on scale near c exponent extremes c----------------------------------------------------------------------- s2r = phir(j)*sumr(j) - phii(j)*sumi(j) s2i = phir(j)*sumi(j) + phii(j)*sumr(j) str = dexp(s1r)*cssr(kflag) s1r = str*dcos(s1i) s1i = str*dsin(s1i) str = s2r*s1r - s2i*s1i s2i = s1r*s2i + s2r*s1i s2r = str if (kflag.ne.1) go to 50 call zuchk(s2r, s2i, nw, bry(1), tol) if (nw.ne.0) go to 60 50 continue cyr(kdflg) = s2r cyi(kdflg) = s2i yr(i) = s2r*csrr(kflag) yi(i) = s2i*csrr(kflag) if (kdflg.eq.2) go to 75 kdflg = 2 go to 70 60 continue if (rs1.gt.0.0d0) go to 300 c----------------------------------------------------------------------- c for zr.lt.0.0, the i function to be added will overflow c----------------------------------------------------------------------- if (zr.lt.0.0d0) go to 300 kdflg = 1 yr(i)=zeror yi(i)=zeroi nz=nz+1 if (i.eq.1) go to 70 if ((yr(i-1).eq.zeror).and.(yi(i-1).eq.zeroi)) go to 70 yr(i-1)=zeror yi(i-1)=zeroi nz=nz+1 70 continue i = n 75 continue razr = 1.0d0/zabs2(zrr,zri) str = zrr*razr sti = -zri*razr rzr = (str+str)*razr rzi = (sti+sti)*razr ckr = fn*rzr cki = fn*rzi ib = i + 1 if (n.lt.ib) go to 160 c----------------------------------------------------------------------- c test last member for underflow and overflow. set sequence to zero c on underflow. c----------------------------------------------------------------------- fn = fnu + dble(float(n-1)) ipard = 1 if (mr.ne.0) ipard = 0 initd = 0 call zunik(zrr, zri, fn, 2, ipard, tol, initd, phidr, phidi, * zet1dr, zet1di, zet2dr, zet2di, sumdr, sumdi, cwrkr(1,3), * cwrki(1,3)) if (kode.eq.1) go to 80 str = zrr + zet2dr sti = zri + zet2di rast = fn/zabs2(str,sti) str = str*rast*rast sti = -sti*rast*rast s1r = zet1dr - str s1i = zet1di - sti go to 90 80 continue s1r = zet1dr - zet2dr s1i = zet1di - zet2di 90 continue rs1 = s1r if (dabs(rs1).gt.elim) go to 95 if (dabs(rs1).lt.alim) go to 100 c---------------------------------------------------------------------------- c refine estimate and test c------------------------------------------------------------------------- aphi = zabs2(phidr,phidi) rs1 = rs1+dlog(aphi) if (dabs(rs1).lt.elim) go to 100 95 continue if (dabs(rs1).gt.0.0d0) go to 300 c----------------------------------------------------------------------- c for zr.lt.0.0, the i function to be added will overflow c----------------------------------------------------------------------- if (zr.lt.0.0d0) go to 300 nz = n do 96 i=1,n yr(i) = zeror yi(i) = zeroi 96 continue return c--------------------------------------------------------------------------- c forward recur for remainder of the sequence c---------------------------------------------------------------------------- 100 continue s1r = cyr(1) s1i = cyi(1) s2r = cyr(2) s2i = cyi(2) c1r = csrr(kflag) ascle = bry(kflag) do 120 i=ib,n c2r = s2r c2i = s2i s2r = ckr*c2r - cki*c2i + s1r s2i = ckr*c2i + cki*c2r + s1i s1r = c2r s1i = c2i ckr = ckr + rzr cki = cki + rzi c2r = s2r*c1r c2i = s2i*c1r yr(i) = c2r yi(i) = c2i if (kflag.ge.3) go to 120 str = dabs(c2r) sti = dabs(c2i) c2m = dmax1(str,sti) if (c2m.le.ascle) go to 120 kflag = kflag + 1 ascle = bry(kflag) s1r = s1r*c1r s1i = s1i*c1r s2r = c2r s2i = c2i s1r = s1r*cssr(kflag) s1i = s1i*cssr(kflag) s2r = s2r*cssr(kflag) s2i = s2i*cssr(kflag) c1r = csrr(kflag) 120 continue 160 continue if (mr.eq.0) return c----------------------------------------------------------------------- c analytic continuation for re(z).lt.0.0d0 c----------------------------------------------------------------------- nz = 0 fmr = dble(float(mr)) sgn = -dsign(pi,fmr) c----------------------------------------------------------------------- c cspn and csgn are coeff of k and i functions resp. c----------------------------------------------------------------------- csgni = sgn inu = int(sngl(fnu)) fnf = fnu - dble(float(inu)) ifn = inu + n - 1 ang = fnf*sgn cspnr = dcos(ang) cspni = dsin(ang) if (mod(ifn,2).eq.0) go to 170 cspnr = -cspnr cspni = -cspni 170 continue asc = bry(1) iuf = 0 kk = n kdflg = 1 ib = ib - 1 ic = ib - 1 do 270 k=1,n fn = fnu + dble(float(kk-1)) c----------------------------------------------------------------------- c logic to sort out cases whose parameters were set for the k c function above c----------------------------------------------------------------------- m=3 if (n.gt.2) go to 175 172 continue initd = init(j) phidr = phir(j) phidi = phii(j) zet1dr = zeta1r(j) zet1di = zeta1i(j) zet2dr = zeta2r(j) zet2di = zeta2i(j) sumdr = sumr(j) sumdi = sumi(j) m = j j = 3 - j go to 180 175 continue if ((kk.eq.n).and.(ib.lt.n)) go to 180 if ((kk.eq.ib).or.(kk.eq.ic)) go to 172 initd = 0 180 continue call zunik(zrr, zri, fn, 1, 0, tol, initd, phidr, phidi, * zet1dr, zet1di, zet2dr, zet2di, sumdr, sumdi, * cwrkr(1,m), cwrki(1,m)) if (kode.eq.1) go to 200 str = zrr + zet2dr sti = zri + zet2di rast = fn/zabs2(str,sti) str = str*rast*rast sti = -sti*rast*rast s1r = -zet1dr + str s1i = -zet1di + sti go to 210 200 continue s1r = -zet1dr + zet2dr s1i = -zet1di + zet2di 210 continue c----------------------------------------------------------------------- c test for underflow and overflow c----------------------------------------------------------------------- rs1 = s1r if (dabs(rs1).gt.elim) go to 260 if (kdflg.eq.1) iflag = 2 if (dabs(rs1).lt.alim) go to 220 c----------------------------------------------------------------------- c refine test and scale c----------------------------------------------------------------------- aphi = zabs2(phidr,phidi) rs1 = rs1 + dlog(aphi) if (dabs(rs1).gt.elim) go to 260 if (kdflg.eq.1) iflag = 1 if (rs1.lt.0.0d0) go to 220 if (kdflg.eq.1) iflag = 3 220 continue str = phidr*sumdr - phidi*sumdi sti = phidr*sumdi + phidi*sumdr s2r = -csgni*sti s2i = csgni*str str = dexp(s1r)*cssr(iflag) s1r = str*dcos(s1i) s1i = str*dsin(s1i) str = s2r*s1r - s2i*s1i s2i = s2r*s1i + s2i*s1r s2r = str if (iflag.ne.1) go to 230 call zuchk(s2r, s2i, nw, bry(1), tol) if (nw.eq.0) go to 230 s2r = zeror s2i = zeroi 230 continue cyr(kdflg) = s2r cyi(kdflg) = s2i c2r = s2r c2i = s2i s2r = s2r*csrr(iflag) s2i = s2i*csrr(iflag) c----------------------------------------------------------------------- c add i and k functions, k sequence in y(i), i=1,n c----------------------------------------------------------------------- s1r = yr(kk) s1i = yi(kk) if (kode.eq.1) go to 250 call zs1s2(zrr, zri, s1r, s1i, s2r, s2i, nw, asc, alim, iuf) nz = nz + nw 250 continue yr(kk) = s1r*cspnr - s1i*cspni + s2r yi(kk) = cspnr*s1i + cspni*s1r + s2i kk = kk - 1 cspnr = -cspnr cspni = -cspni if (c2r.ne.0.0d0 .or. c2i.ne.0.0d0) go to 255 kdflg = 1 go to 270 255 continue if (kdflg.eq.2) go to 275 kdflg = 2 go to 270 260 continue if (rs1.gt.0.0d0) go to 300 s2r = zeror s2i = zeroi go to 230 270 continue k = n 275 continue il = n - k if (il.eq.0) return c----------------------------------------------------------------------- c recur backward for remainder of i sequence and add in the c k functions, scaling the i sequence during recurrence to keep c intermediate arithmetic on scale near exponent extremes. c----------------------------------------------------------------------- s1r = cyr(1) s1i = cyi(1) s2r = cyr(2) s2i = cyi(2) csr = csrr(iflag) ascle = bry(iflag) fn = dble(float(inu+il)) do 290 i=1,il c2r = s2r c2i = s2i s2r = s1r + (fn+fnf)*(rzr*c2r-rzi*c2i) s2i = s1i + (fn+fnf)*(rzr*c2i+rzi*c2r) s1r = c2r s1i = c2i fn = fn - 1.0d0 c2r = s2r*csr c2i = s2i*csr ckr = c2r cki = c2i c1r = yr(kk) c1i = yi(kk) if (kode.eq.1) go to 280 call zs1s2(zrr, zri, c1r, c1i, c2r, c2i, nw, asc, alim, iuf) nz = nz + nw 280 continue yr(kk) = c1r*cspnr - c1i*cspni + c2r yi(kk) = c1r*cspni + c1i*cspnr + c2i kk = kk - 1 cspnr = -cspnr cspni = -cspni if (iflag.ge.3) go to 290 c2r = dabs(ckr) c2i = dabs(cki) c2m = dmax1(c2r,c2i) if (c2m.le.ascle) go to 290 iflag = iflag + 1 ascle = bry(iflag) s1r = s1r*csr s1i = s1i*csr s2r = ckr s2i = cki s1r = s1r*cssr(iflag) s1i = s1i*cssr(iflag) s2r = s2r*cssr(iflag) s2i = s2i*cssr(iflag) csr = csrr(iflag) 290 continue return 300 continue nz = -1 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zunk2(zr, zi, fnu, kode, mr, n, yr, yi, nz, tol, elim, * alim) c refer to zbesk c c zunk2 computes k(fnu,z) and its analytic continuation from the c right half plane to the left half plane by means of the c uniform asymptotic expansions for h(kind,fnu,zn) and j(fnu,zn) c where zn is in the right half plane, kind=(3-mr)/2, mr=+1 or c -1. here zn=zr*i or -zr*i where zr=z if z is in the right c half plane or zr=-z if z is in the left half plane. mr indic- c ates the direction of rotation for analytic continuation. c nz=-1 means an overflow will occur c c***routines called zairy,zkscl,zs1s2,zuchk,zunhj,d1mach,zabs2 c complex ai,arg,argd,asum,asumd,bsum,bsumd,cfn,ci,cip,ck,cone,crsc, c *cr1,cr2,cs,cscl,csgn,cspn,csr,css,cy,czero,c1,c2,dai,phi,phid,rz, c *s1,s2,y,z,zb,zeta1,zeta1d,zeta2,zeta2d,zn,zr double precision aarg, aic, aii, air, alim, ang, aphi, argdi, * argdr, argi, argr, asc, ascle, asumdi, asumdr, asumi, asumr, * bry, bsumdi, bsumdr, bsumi, bsumr, car, cipi, cipr, cki, ckr, * coner, crsc, cr1i, cr1r, cr2i, cr2r, cscl, csgni, csi, * cspni, cspnr, csr, csrr, cssr, cyi, cyr, c1i, c1r, c2i, c2m, * c2r, daii, dair, elim, fmr, fn, fnf, fnu, hpi, phidi, phidr, * phii, phir, pi, pti, ptr, rast, razr, rs1, rzi, rzr, sar, sgn, * sti, str, s1i, s1r, s2i, s2r, tol, yi, yr, yy, zbi, zbr, zeroi, * zeror, zeta1i, zeta1r, zeta2i, zeta2r, zet1di, zet1dr, zet2di, * zet2dr, zi, zni, znr, zr, zri, zrr, d1mach, zabs2 integer i, ib, iflag, ifn, il, in, inu, iuf, k, kdflg, kflag, kk, * kode, mr, n, nai, ndai, nw, nz, idum, j, ipard, ic dimension bry(3), yr(n), yi(n), asumr(2), asumi(2), bsumr(2), * bsumi(2), phir(2), phii(2), argr(2), argi(2), zeta1r(2), * zeta1i(2), zeta2r(2), zeta2i(2), cyr(2), cyi(2), cipr(4), * cipi(4), cssr(3), csrr(3) data zeror,zeroi,coner,cr1r,cr1i,cr2r,cr2i / 1 0.0d0, 0.0d0, 1.0d0, 1 1.0d0,1.73205080756887729d0 , -0.5d0,-8.66025403784438647d-01 / data hpi, pi, aic / 1 1.57079632679489662d+00, 3.14159265358979324d+00, 1 1.26551212348464539d+00/ data cipr(1),cipi(1),cipr(2),cipi(2),cipr(3),cipi(3),cipr(4), * cipi(4) / 1 1.0d0,0.0d0 , 0.0d0,-1.0d0 , -1.0d0,0.0d0 , 0.0d0,1.0d0 / c kdflg = 1 nz = 0 c----------------------------------------------------------------------- c exp(-alim)=exp(-elim)/tol=approx. one precision greater than c the underflow limit c----------------------------------------------------------------------- cscl = 1.0d0/tol crsc = tol cssr(1) = cscl cssr(2) = coner cssr(3) = crsc csrr(1) = crsc csrr(2) = coner csrr(3) = cscl bry(1) = 1.0d+3*d1mach(1)/tol bry(2) = 1.0d0/bry(1) bry(3) = d1mach(2) zrr = zr zri = zi if (zr.ge.0.0d0) go to 10 zrr = -zr zri = -zi 10 continue yy = zri znr = zri zni = -zrr zbr = zrr zbi = zri inu = int(sngl(fnu)) fnf = fnu - dble(float(inu)) ang = -hpi*fnf car = dcos(ang) sar = dsin(ang) c2r = hpi*sar c2i = -hpi*car kk = mod(inu,4) + 1 str = c2r*cipr(kk) - c2i*cipi(kk) sti = c2r*cipi(kk) + c2i*cipr(kk) csr = cr1r*str - cr1i*sti csi = cr1r*sti + cr1i*str if (yy.gt.0.0d0) go to 20 znr = -znr zbi = -zbi 20 continue c----------------------------------------------------------------------- c k(fnu,z) is computed from h(2,fnu,-i*z) where z is in the first c quadrant. fourth quadrant values (yy.le.0.0e0) are computed by c conjugation since the k function is real on the positive real axis c----------------------------------------------------------------------- j = 2 do 80 i=1,n c----------------------------------------------------------------------- c j flip flops between 1 and 2 in j = 3 - j c----------------------------------------------------------------------- j = 3 - j fn = fnu + dble(float(i-1)) call zunhj(znr, zni, fn, 0, tol, phir(j), phii(j), argr(j), * argi(j), zeta1r(j), zeta1i(j), zeta2r(j), zeta2i(j), asumr(j), * asumi(j), bsumr(j), bsumi(j)) if (kode.eq.1) go to 30 str = zbr + zeta2r(j) sti = zbi + zeta2i(j) rast = fn/zabs2(str,sti) str = str*rast*rast sti = -sti*rast*rast s1r = zeta1r(j) - str s1i = zeta1i(j) - sti go to 40 30 continue s1r = zeta1r(j) - zeta2r(j) s1i = zeta1i(j) - zeta2i(j) 40 continue c----------------------------------------------------------------------- c test for underflow and overflow c----------------------------------------------------------------------- rs1 = s1r if (dabs(rs1).gt.elim) go to 70 if (kdflg.eq.1) kflag = 2 if (dabs(rs1).lt.alim) go to 50 c----------------------------------------------------------------------- c refine test and scale c----------------------------------------------------------------------- aphi = zabs2(phir(j),phii(j)) aarg = zabs2(argr(j),argi(j)) rs1 = rs1 + dlog(aphi) - 0.25d0*dlog(aarg) - aic if (dabs(rs1).gt.elim) go to 70 if (kdflg.eq.1) kflag = 1 if (rs1.lt.0.0d0) go to 50 if (kdflg.eq.1) kflag = 3 50 continue c----------------------------------------------------------------------- c scale s1 to keep intermediate arithmetic on scale near c exponent extremes c----------------------------------------------------------------------- c2r = argr(j)*cr2r - argi(j)*cr2i c2i = argr(j)*cr2i + argi(j)*cr2r call zairy(c2r, c2i, 0, 2, air, aii, nai, idum) call zairy(c2r, c2i, 1, 2, dair, daii, ndai, idum) str = dair*bsumr(j) - daii*bsumi(j) sti = dair*bsumi(j) + daii*bsumr(j) ptr = str*cr2r - sti*cr2i pti = str*cr2i + sti*cr2r str = ptr + (air*asumr(j)-aii*asumi(j)) sti = pti + (air*asumi(j)+aii*asumr(j)) ptr = str*phir(j) - sti*phii(j) pti = str*phii(j) + sti*phir(j) s2r = ptr*csr - pti*csi s2i = ptr*csi + pti*csr str = dexp(s1r)*cssr(kflag) s1r = str*dcos(s1i) s1i = str*dsin(s1i) str = s2r*s1r - s2i*s1i s2i = s1r*s2i + s2r*s1i s2r = str if (kflag.ne.1) go to 60 call zuchk(s2r, s2i, nw, bry(1), tol) if (nw.ne.0) go to 70 60 continue if (yy.le.0.0d0) s2i = -s2i cyr(kdflg) = s2r cyi(kdflg) = s2i yr(i) = s2r*csrr(kflag) yi(i) = s2i*csrr(kflag) str = csi csi = -csr csr = str if (kdflg.eq.2) go to 85 kdflg = 2 go to 80 70 continue if (rs1.gt.0.0d0) go to 320 c----------------------------------------------------------------------- c for zr.lt.0.0, the i function to be added will overflow c----------------------------------------------------------------------- if (zr.lt.0.0d0) go to 320 kdflg = 1 yr(i)=zeror yi(i)=zeroi nz=nz+1 str = csi csi =-csr csr = str if (i.eq.1) go to 80 if ((yr(i-1).eq.zeror).and.(yi(i-1).eq.zeroi)) go to 80 yr(i-1)=zeror yi(i-1)=zeroi nz=nz+1 80 continue i = n 85 continue razr = 1.0d0/zabs2(zrr,zri) str = zrr*razr sti = -zri*razr rzr = (str+str)*razr rzi = (sti+sti)*razr ckr = fn*rzr cki = fn*rzi ib = i + 1 if (n.lt.ib) go to 180 c----------------------------------------------------------------------- c test last member for underflow and overflow. set sequence to zero c on underflow. c----------------------------------------------------------------------- fn = fnu + dble(float(n-1)) ipard = 1 if (mr.ne.0) ipard = 0 call zunhj(znr, zni, fn, ipard, tol, phidr, phidi, argdr, argdi, * zet1dr, zet1di, zet2dr, zet2di, asumdr, asumdi, bsumdr, bsumdi) if (kode.eq.1) go to 90 str = zbr + zet2dr sti = zbi + zet2di rast = fn/zabs2(str,sti) str = str*rast*rast sti = -sti*rast*rast s1r = zet1dr - str s1i = zet1di - sti go to 100 90 continue s1r = zet1dr - zet2dr s1i = zet1di - zet2di 100 continue rs1 = s1r if (dabs(rs1).gt.elim) go to 105 if (dabs(rs1).lt.alim) go to 120 c---------------------------------------------------------------------------- c refine estimate and test c------------------------------------------------------------------------- aphi = zabs2(phidr,phidi) rs1 = rs1+dlog(aphi) if (dabs(rs1).lt.elim) go to 120 105 continue if (rs1.gt.0.0d0) go to 320 c----------------------------------------------------------------------- c for zr.lt.0.0, the i function to be added will overflow c----------------------------------------------------------------------- if (zr.lt.0.0d0) go to 320 nz = n do 106 i=1,n yr(i) = zeror yi(i) = zeroi 106 continue return 120 continue s1r = cyr(1) s1i = cyi(1) s2r = cyr(2) s2i = cyi(2) c1r = csrr(kflag) ascle = bry(kflag) do 130 i=ib,n c2r = s2r c2i = s2i s2r = ckr*c2r - cki*c2i + s1r s2i = ckr*c2i + cki*c2r + s1i s1r = c2r s1i = c2i ckr = ckr + rzr cki = cki + rzi c2r = s2r*c1r c2i = s2i*c1r yr(i) = c2r yi(i) = c2i if (kflag.ge.3) go to 130 str = dabs(c2r) sti = dabs(c2i) c2m = dmax1(str,sti) if (c2m.le.ascle) go to 130 kflag = kflag + 1 ascle = bry(kflag) s1r = s1r*c1r s1i = s1i*c1r s2r = c2r s2i = c2i s1r = s1r*cssr(kflag) s1i = s1i*cssr(kflag) s2r = s2r*cssr(kflag) s2i = s2i*cssr(kflag) c1r = csrr(kflag) 130 continue 180 continue if (mr.eq.0) return c----------------------------------------------------------------------- c analytic continuation for re(z).lt.0.0d0 c----------------------------------------------------------------------- nz = 0 fmr = dble(float(mr)) sgn = -dsign(pi,fmr) c----------------------------------------------------------------------- c cspn and csgn are coeff of k and i funcions resp. c----------------------------------------------------------------------- csgni = sgn if (yy.le.0.0d0) csgni = -csgni ifn = inu + n - 1 ang = fnf*sgn cspnr = dcos(ang) cspni = dsin(ang) if (mod(ifn,2).eq.0) go to 190 cspnr = -cspnr cspni = -cspni 190 continue c----------------------------------------------------------------------- c cs=coeff of the j function to get the i function. i(fnu,z) is c computed from exp(i*fnu*hpi)*j(fnu,-i*z) where z is in the first c quadrant. fourth quadrant values (yy.le.0.0e0) are computed by c conjugation since the i function is real on the positive real axis c----------------------------------------------------------------------- csr = sar*csgni csi = car*csgni in = mod(ifn,4) + 1 c2r = cipr(in) c2i = cipi(in) str = csr*c2r + csi*c2i csi = -csr*c2i + csi*c2r csr = str asc = bry(1) iuf = 0 kk = n kdflg = 1 ib = ib - 1 ic = ib - 1 do 290 k=1,n fn = fnu + dble(float(kk-1)) c----------------------------------------------------------------------- c logic to sort out cases whose parameters were set for the k c function above c----------------------------------------------------------------------- if (n.gt.2) go to 175 172 continue phidr = phir(j) phidi = phii(j) argdr = argr(j) argdi = argi(j) zet1dr = zeta1r(j) zet1di = zeta1i(j) zet2dr = zeta2r(j) zet2di = zeta2i(j) asumdr = asumr(j) asumdi = asumi(j) bsumdr = bsumr(j) bsumdi = bsumi(j) j = 3 - j go to 210 175 continue if ((kk.eq.n).and.(ib.lt.n)) go to 210 if ((kk.eq.ib).or.(kk.eq.ic)) go to 172 call zunhj(znr, zni, fn, 0, tol, phidr, phidi, argdr, * argdi, zet1dr, zet1di, zet2dr, zet2di, asumdr, * asumdi, bsumdr, bsumdi) 210 continue if (kode.eq.1) go to 220 str = zbr + zet2dr sti = zbi + zet2di rast = fn/zabs2(str,sti) str = str*rast*rast sti = -sti*rast*rast s1r = -zet1dr + str s1i = -zet1di + sti go to 230 220 continue s1r = -zet1dr + zet2dr s1i = -zet1di + zet2di 230 continue c----------------------------------------------------------------------- c test for underflow and overflow c----------------------------------------------------------------------- rs1 = s1r if (dabs(rs1).gt.elim) go to 280 if (kdflg.eq.1) iflag = 2 if (dabs(rs1).lt.alim) go to 240 c----------------------------------------------------------------------- c refine test and scale c----------------------------------------------------------------------- aphi = zabs2(phidr,phidi) aarg = zabs2(argdr,argdi) rs1 = rs1 + dlog(aphi) - 0.25d0*dlog(aarg) - aic if (dabs(rs1).gt.elim) go to 280 if (kdflg.eq.1) iflag = 1 if (rs1.lt.0.0d0) go to 240 if (kdflg.eq.1) iflag = 3 240 continue call zairy(argdr, argdi, 0, 2, air, aii, nai, idum) call zairy(argdr, argdi, 1, 2, dair, daii, ndai, idum) str = dair*bsumdr - daii*bsumdi sti = dair*bsumdi + daii*bsumdr str = str + (air*asumdr-aii*asumdi) sti = sti + (air*asumdi+aii*asumdr) ptr = str*phidr - sti*phidi pti = str*phidi + sti*phidr s2r = ptr*csr - pti*csi s2i = ptr*csi + pti*csr str = dexp(s1r)*cssr(iflag) s1r = str*dcos(s1i) s1i = str*dsin(s1i) str = s2r*s1r - s2i*s1i s2i = s2r*s1i + s2i*s1r s2r = str if (iflag.ne.1) go to 250 call zuchk(s2r, s2i, nw, bry(1), tol) if (nw.eq.0) go to 250 s2r = zeror s2i = zeroi 250 continue if (yy.le.0.0d0) s2i = -s2i cyr(kdflg) = s2r cyi(kdflg) = s2i c2r = s2r c2i = s2i s2r = s2r*csrr(iflag) s2i = s2i*csrr(iflag) c----------------------------------------------------------------------- c add i and k functions, k sequence in y(i), i=1,n c----------------------------------------------------------------------- s1r = yr(kk) s1i = yi(kk) if (kode.eq.1) go to 270 call zs1s2(zrr, zri, s1r, s1i, s2r, s2i, nw, asc, alim, iuf) nz = nz + nw 270 continue yr(kk) = s1r*cspnr - s1i*cspni + s2r yi(kk) = s1r*cspni + s1i*cspnr + s2i kk = kk - 1 cspnr = -cspnr cspni = -cspni str = csi csi = -csr csr = str if (c2r.ne.0.0d0 .or. c2i.ne.0.0d0) go to 255 kdflg = 1 go to 290 255 continue if (kdflg.eq.2) go to 295 kdflg = 2 go to 290 280 continue if (rs1.gt.0.0d0) go to 320 s2r = zeror s2i = zeroi go to 250 290 continue k = n 295 continue il = n - k if (il.eq.0) return c----------------------------------------------------------------------- c recur backward for remainder of i sequence and add in the c k functions, scaling the i sequence during recurrence to keep c intermediate arithmetic on scale near exponent extremes. c----------------------------------------------------------------------- s1r = cyr(1) s1i = cyi(1) s2r = cyr(2) s2i = cyi(2) csr = csrr(iflag) ascle = bry(iflag) fn = dble(float(inu+il)) do 310 i=1,il c2r = s2r c2i = s2i s2r = s1r + (fn+fnf)*(rzr*c2r-rzi*c2i) s2i = s1i + (fn+fnf)*(rzr*c2i+rzi*c2r) s1r = c2r s1i = c2i fn = fn - 1.0d0 c2r = s2r*csr c2i = s2i*csr ckr = c2r cki = c2i c1r = yr(kk) c1i = yi(kk) if (kode.eq.1) go to 300 call zs1s2(zrr, zri, c1r, c1i, c2r, c2i, nw, asc, alim, iuf) nz = nz + nw 300 continue yr(kk) = c1r*cspnr - c1i*cspni + c2r yi(kk) = c1r*cspni + c1i*cspnr + c2i kk = kk - 1 cspnr = -cspnr cspni = -cspni if (iflag.ge.3) go to 310 c2r = dabs(ckr) c2i = dabs(cki) c2m = dmax1(c2r,c2i) if (c2m.le.ascle) go to 310 iflag = iflag + 1 ascle = bry(iflag) s1r = s1r*csr s1i = s1i*csr s2r = ckr s2i = cki s1r = s1r*cssr(iflag) s1i = s1i*cssr(iflag) s2r = s2r*cssr(iflag) s2i = s2i*cssr(iflag) csr = csrr(iflag) 310 continue return 320 continue nz = -1 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zuoik(zr, zi, fnu, kode, ikflg, n, yr, yi, nuf, tol, * elim, alim) c geuz for g77 EXTERNAL zlog c refer to zbesi,zbesk,zbesh c c zuoik computes the leading terms of the uniform asymptotic c expansions for the i and k functions and compares them c (in logarithmic form) to alim and elim for over and underflow c where alim.lt.elim. if the magnitude, based on the leading c exponential, is less than alim or greater than -alim, then c the result is on scale. if not, then a refined test using other c multipliers (in logarithmic form) is made based on elim. here c exp(-elim)=smallest machine number*1.0e+3 and exp(-alim)= c exp(-elim)/tol c c ikflg=1 means the i sequence is tested c =2 means the k sequence is tested c nuf = 0 means the last member of the sequence is on scale c =-1 means an overflow would occur c ikflg=1 and nuf.gt.0 means the last nuf y values were set to zero c the first n-nuf values must be set by another routine c ikflg=2 and nuf.eq.n means all y values were set to zero c ikflg=2 and 0.lt.nuf.lt.n not considered. y must be set by c another routine c c***routines called zuchk,zunhj,zunik,d1mach,zabs2,zlog c complex arg,asum,bsum,cwrk,cz,czero,phi,sum,y,z,zb,zeta1,zeta2,zn, c *zr double precision aarg, aic, alim, aphi, argi, argr, asumi, asumr, * ascle, ax, ay, bsumi, bsumr, cwrki, cwrkr, czi, czr, elim, fnn, * fnu, gnn, gnu, phii, phir, rcz, str, sti, sumi, sumr, tol, yi, * yr, zbi, zbr, zeroi, zeror, zeta1i, zeta1r, zeta2i, zeta2r, zi, * zni, znr, zr, zri, zrr, d1mach, zabs2 integer i, idum, iform, ikflg, init, kode, n, nn, nuf, nw dimension yr(n), yi(n), cwrkr(16), cwrki(16) data zeror,zeroi / 0.0d0, 0.0d0 / data aic / 1.265512123484645396d+00 / nuf = 0 nn = n zrr = zr zri = zi if (zr.ge.0.0d0) go to 10 zrr = -zr zri = -zi 10 continue zbr = zrr zbi = zri ax = dabs(zr)*1.7321d0 ay = dabs(zi) iform = 1 if (ay.gt.ax) iform = 2 gnu = dmax1(fnu,1.0d0) if (ikflg.eq.1) go to 20 fnn = dble(float(nn)) gnn = fnu + fnn - 1.0d0 gnu = dmax1(gnn,fnn) 20 continue c----------------------------------------------------------------------- c only the magnitude of arg and phi are needed along with the c real parts of zeta1, zeta2 and zb. no attempt is made to get c the sign of the imaginary part correct. c----------------------------------------------------------------------- if (iform.eq.2) go to 30 init = 0 call zunik(zrr, zri, gnu, ikflg, 1, tol, init, phir, phii, * zeta1r, zeta1i, zeta2r, zeta2i, sumr, sumi, cwrkr, cwrki) czr = -zeta1r + zeta2r czi = -zeta1i + zeta2i go to 50 30 continue znr = zri zni = -zrr if (zi.gt.0.0d0) go to 40 znr = -znr 40 continue call zunhj(znr, zni, gnu, 1, tol, phir, phii, argr, argi, zeta1r, * zeta1i, zeta2r, zeta2i, asumr, asumi, bsumr, bsumi) czr = -zeta1r + zeta2r czi = -zeta1i + zeta2i aarg = zabs2(argr,argi) 50 continue if (kode.eq.1) go to 60 czr = czr - zbr czi = czi - zbi 60 continue if (ikflg.eq.1) go to 70 czr = -czr czi = -czi 70 continue aphi = zabs2(phir,phii) rcz = czr c----------------------------------------------------------------------- c overflow test c----------------------------------------------------------------------- if (rcz.gt.elim) go to 210 if (rcz.lt.alim) go to 80 rcz = rcz + dlog(aphi) if (iform.eq.2) rcz = rcz - 0.25d0*dlog(aarg) - aic if (rcz.gt.elim) go to 210 go to 130 80 continue c----------------------------------------------------------------------- c underflow test c----------------------------------------------------------------------- if (rcz.lt.(-elim)) go to 90 if (rcz.gt.(-alim)) go to 130 rcz = rcz + dlog(aphi) if (iform.eq.2) rcz = rcz - 0.25d0*dlog(aarg) - aic if (rcz.gt.(-elim)) go to 110 90 continue do 100 i=1,nn yr(i) = zeror yi(i) = zeroi 100 continue nuf = nn return 110 continue ascle = 1.0d+3*d1mach(1)/tol call zlog(phir, phii, str, sti, idum) czr = czr + str czi = czi + sti if (iform.eq.1) go to 120 call zlog(argr, argi, str, sti, idum) czr = czr - 0.25d0*str - aic czi = czi - 0.25d0*sti 120 continue ax = dexp(rcz)/tol ay = czi czr = ax*dcos(ay) czi = ax*dsin(ay) call zuchk(czr, czi, nw, ascle, tol) if (nw.ne.0) go to 90 130 continue if (ikflg.eq.2) return if (n.eq.1) return c----------------------------------------------------------------------- c set underflows on i sequence c----------------------------------------------------------------------- 140 continue gnu = fnu + dble(float(nn-1)) if (iform.eq.2) go to 150 init = 0 call zunik(zrr, zri, gnu, ikflg, 1, tol, init, phir, phii, * zeta1r, zeta1i, zeta2r, zeta2i, sumr, sumi, cwrkr, cwrki) czr = -zeta1r + zeta2r czi = -zeta1i + zeta2i go to 160 150 continue call zunhj(znr, zni, gnu, 1, tol, phir, phii, argr, argi, zeta1r, * zeta1i, zeta2r, zeta2i, asumr, asumi, bsumr, bsumi) czr = -zeta1r + zeta2r czi = -zeta1i + zeta2i aarg = zabs2(argr,argi) 160 continue if (kode.eq.1) go to 170 czr = czr - zbr czi = czi - zbi 170 continue aphi = zabs2(phir,phii) rcz = czr if (rcz.lt.(-elim)) go to 180 if (rcz.gt.(-alim)) return rcz = rcz + dlog(aphi) if (iform.eq.2) rcz = rcz - 0.25d0*dlog(aarg) - aic if (rcz.gt.(-elim)) go to 190 180 continue yr(nn) = zeror yi(nn) = zeroi nn = nn - 1 nuf = nuf + 1 if (nn.eq.0) return go to 140 190 continue ascle = 1.0d+3*d1mach(1)/tol call zlog(phir, phii, str, sti, idum) czr = czr + str czi = czi + sti if (iform.eq.1) go to 200 call zlog(argr, argi, str, sti, idum) czr = czr - 0.25d0*str - aic czi = czi - 0.25d0*sti 200 continue ax = dexp(rcz)/tol ay = czi czr = ax*dcos(ay) czi = ax*dsin(ay) call zuchk(czr, czi, nw, ascle, tol) if (nw.ne.0) go to 180 return 210 continue nuf = -1 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zbesj(zr, zi, fnu, kode, n, cyr, cyi, nz, ierr) c j-Bessel function of complex argument and first kind c Author Amos, Donald E., Sandia National Laboratories c c on kode=1, cbesj computes an n member sequence of complex c bessel functions cy(i)=j(fnu+i-1,z) for real, nonnegative c orders fnu+i-1, i=1,...,n and complex z in the cut plane c -pi.lt.arg(z).le.pi. on kode=2, cbesj returns the scaled c functions c c cy(i)=exp(-abs(y))*j(fnu+i-1,z) i = 1,...,n , y=aimag(z) c c which remove the exponential growth in both the upper and c lower half planes for z to infinity. c c Input zr,zi,fnu are double precision c zr,zi - z=cmplx(zr,zi), -pi.lt.arg(z).le.pi c fnu - order of initial j function, fnu.ge.0.0d0 c kode - a parameter to indicate the scaling option c kode= 1 returns c cy(i)=j(fnu+i-1,z), i=1,...,n c = 2 returns c cy(i)=j(fnu+i-1,z)exp(-abs(y)), i=1,...,n c n - number of members of the sequence, n.ge.1 c c Output cyr,cyi are double precision c cyr,cyi- double precision vectors whose first n components c contain real and imaginary parts for the sequence c cy(i)=j(fnu+i-1,z) or c cy(i)=j(fnu+i-1,z)exp(-abs(y)) i=1,...,n c depending on kode, y=aimag(z). c nz - number of components set to zero due to underflow, c nz= 0 , normal return c nz.gt.0 , last nz components of cy set zero due c to underflow, cy(i)=cmplx(0.0d0,0.0d0), c i = n-nz+1,...,n c ierr - error flag c ierr=0, normal return - computation completed c ierr=1, input error - no computation c ierr=2, overflow - no computation, aimag(z) c too large on kode=1 c ierr=3, cabs(z) or fnu+n-1 large - computation done c but losses of signifcance by argument c reduction produce less than half of machine c accuracy c ierr=4, cabs(z) or fnu+n-1 too large - no computa- c tion because of complete losses of signifi- c cance by argument reduction c ierr=5, error - no computation, c algorithm termination condition not met c c c the computation is carried out by the formula c c j(fnu,z)=exp( fnu*pi*i/2)*i(fnu,-i*z) aimag(z).ge.0.0 c c j(fnu,z)=exp(-fnu*pi*i/2)*i(fnu, i*z) aimag(z).lt.0.0 c c where i**2 = -1 and i(fnu,z) is the i bessel function. c c for negative orders,the formula c c j(-fnu,z) = j(fnu,z)*cos(pi*fnu) - y(fnu,z)*sin(pi*fnu) c c can be used. however,for large orders close to integers, the c the function changes radically. when fnu is a large positive c integer,the magnitude of j(-fnu,z)=j(fnu,z)*cos(pi*fnu) is a c large negative power of ten. but when fnu is not an integer, c y(fnu,z) dominates in magnitude with a large positive power of c ten and the most that the second term can be reduced is by c unit roundoff from the coefficient. thus, wide changes can c occur within unit roundoff of a large integer for fnu. here, c large means fnu.gt.cabs(z). c c in most complex variable computation, one must evaluate ele- c mentary functions. when the magnitude of z or fnu+n-1 is c large, losses of significance by argument reduction occur. c consequently, if either one exceeds u1=sqrt(0.5/ur), then c losses exceeding half precision are likely and an error flag c ierr=3 is triggered where ur=dmax1(d1mach(4),1.0d-18) is c double precision unit roundoff limited to 18 digits precision. c if either is larger than u2=0.5/ur, then all significance is c lost and ierr=4. in order to use the int function, arguments c must be further restricted not to exceed the largest machine c integer, u3=i1mach(9). thus, the magnitude of z and fnu+n-1 is c restricted by min(u2,u3). on 32 bit machines, u1,u2, and u3 c are approximately 2.0e+3, 4.2e+6, 2.1e+9 in single precision c arithmetic and 1.3e+8, 1.8e+16, 2.1e+9 in double precision c arithmetic respectively. this makes u2 and u3 limiting in c their respective arithmetics. this means that one can expect c to retain, in the worst cases on 32 bit machines, no digits c in single and only 7 digits in double precision arithmetic. c similar considerations hold for other machines. c c the approximate relative error in the magnitude of a complex c bessel function can be expressed by p*10**s where p=max(unit c roundoff,1.0e-18) is the nominal precision and 10**s repre- c sents the increase in error due to argument reduction in the c elementary functions. here, s=max(1,abs(log10(cabs(z))), c abs(log10(fnu))) approximately (i.e. s=max(1,abs(exponent of c cabs(z),abs(exponent of fnu)) ). however, the phase angle may c have only absolute accuracy. this is most likely to occur when c one component (in absolute value) is larger than the other by c several orders of magnitude. if one component is 10**k larger c than the other, then one can expect only max(abs(log10(p))-k, c 0) significant digits; or, stated another way, when k exceeds c the exponent of p, no significant digits remain in the smaller c component. however, the phase angle retains absolute accuracy c because, in complex arithmetic with precision p, the smaller c component will not (as a rule) decrease below p times the c magnitude of the larger component. in these extreme cases, c the principal phase angle is on the order of +p, -p, pi/2-p, c or -pi/2+p. c c***routines called zbinu,i1mach,d1mach c c complex ci,csgn,cy,z,zn double precision aa, alim, arg, cii, csgni, csgnr, cyi, cyr, dig, * elim, fnu, fnul, hpi, rl, r1m5, str, tol, zi, zni, znr, zr, * d1mach, bb, fn, az, zabs2, ascle, rtol, atol, sti integer i, ierr, inu, inuh, ir, k, kode, k1, k2, n, nl, nz, i1mach dimension cyr(n), cyi(n) data hpi /1.57079632679489662d0/ c write(*,*)'zr, zi, fnu, kode, n, nz',zr, zi, fnu, kode, n,nz c write(*,*)'cyr',(cyr(i),i=1,n) c write(*,*)'cyi',(cyi(i),i=1,n) c ierr = 0 nz=0 if (fnu.lt.0.0d0) ierr=1 if (kode.lt.1 .or. kode.gt.2) ierr=1 if (n.lt.1) ierr=1 if (ierr.ne.0) return c----------------------------------------------------------------------- c set parameters related to machine constants. c tol is the approximate unit roundoff limited to 1.0e-18. c elim is the approximate exponential over- and underflow limit. c exp(-elim).lt.exp(-alim)=exp(-elim)/tol and c exp(elim).gt.exp(alim)=exp(elim)*tol are intervals near c underflow and overflow limits where scaled arithmetic is done. c rl is the lower boundary of the asymptotic expansion for large z. c dig = number of base 10 digits in tol = 10**(-dig). c fnul is the lower boundary of the asymptotic series for large fnu. c----------------------------------------------------------------------- tol = dmax1(d1mach(4),1.0d-18) k1 = i1mach(15) k2 = i1mach(16) r1m5 = d1mach(5) k = min0(iabs(k1),iabs(k2)) elim = 2.303d0*(dble(float(k))*r1m5-3.0d0) k1 = i1mach(14) - 1 aa = r1m5*dble(float(k1)) dig = dmin1(aa,18.0d0) aa = aa*2.303d0 alim = elim + dmax1(-aa,-41.45d0) rl = 1.2d0*dig + 3.0d0 fnul = 10.0d0 + 6.0d0*(dig-3.0d0) c----------------------------------------------------------------------- c test for proper range c----------------------------------------------------------------------- az = zabs2(zr,zi) fn = fnu+dble(float(n-1)) aa = 0.5d0/tol bb=dble(float(i1mach(9)))*0.5d0 aa = dmin1(aa,bb) if (az.gt.aa) go to 260 if (fn.gt.aa) go to 260 aa = dsqrt(aa) if (az.gt.aa) ierr=3 if (fn.gt.aa) ierr=3 c----------------------------------------------------------------------- c calculate csgn=exp(fnu*hpi*i) to minimize losses of significance c when fnu is large c----------------------------------------------------------------------- cii = 1.0d0 inu = int(sngl(fnu)) inuh = inu/2 ir = inu - 2*inuh arg = (fnu-dble(float(inu-ir)))*hpi csgnr = dcos(arg) csgni = dsin(arg) if (mod(inuh,2).eq.0) go to 40 csgnr = -csgnr csgni = -csgni 40 continue c----------------------------------------------------------------------- c zn is in the right half plane c----------------------------------------------------------------------- znr = zi zni = -zr if (zi.ge.0.0d0) go to 50 znr = -znr zni = -zni csgni = -csgni cii = -cii 50 continue call zbinu(znr, zni, fnu, kode, n, cyr, cyi, nz, rl, fnul, tol, * elim, alim) if (nz.lt.0) go to 130 nl = n - nz if (nl.eq.0) return rtol = 1.0d0/tol ascle = d1mach(1)*rtol*1.0d+3 do 60 i=1,nl c str = cyr(i)*csgnr - cyi(i)*csgni c cyi(i) = cyr(i)*csgni + cyi(i)*csgnr c cyr(i) = str aa = cyr(i) bb = cyi(i) atol = 1.0d0 if (dmax1(dabs(aa),dabs(bb)).gt.ascle) go to 55 aa = aa*rtol bb = bb*rtol atol = tol 55 continue str = aa*csgnr - bb*csgni sti = aa*csgni + bb*csgnr cyr(i) = str*atol cyi(i) = sti*atol str = -csgni*cii csgni = csgnr*cii csgnr = str 60 continue return 130 continue if(nz.eq.(-2)) go to 140 nz = 0 ierr = 2 return 140 continue nz=0 ierr=5 return 260 continue nz=0 ierr=4 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zbesy(zr, zi, fnu, kode, n, cyr, cyi, nz, cwrkr, cwrki, * ierr) c y-Bessel function of complex argument and of second kind c Author Amos, Donald E., Sandia National Laboratories c c on kode=1, cbesy computes an n member sequence of complex c bessel functions cy(i)=y(fnu+i-1,z) for real, nonnegative c orders fnu+i-1, i=1,...,n and complex z in the cut plane c -pi.lt.arg(z).le.pi. on kode=2, cbesy returns the scaled c functions c c cy(i)=exp(-abs(y))*y(fnu+i-1,z) i = 1,...,n , y=aimag(z) c c which remove the exponential growth in both the upper and c lower half planes for z to infinity. c c input zr,zi,fnu are double precision c zr,zi - z=cmplx(zr,zi), z.ne.cmplx(0.0d0,0.0d0), c -pi.lt.arg(z).le.pi c fnu - order of initial y function, fnu.ge.0.0d0 c kode - a parameter to indicate the scaling option c kode= 1 returns c cy(i)=y(fnu+i-1,z), i=1,...,n c = 2 returns c cy(i)=y(fnu+i-1,z)*exp(-abs(y)), i=1,...,n c where y=aimag(z) c n - number of members of the sequence, n.ge.1 c cwrkr, - double precision work vectors of dimension at c cwrki at least n c c output cyr,cyi are double precision c cyr,cyi- double precision vectors whose first n components c contain real and imaginary parts for the sequence c cy(i)=y(fnu+i-1,z) or c cy(i)=y(fnu+i-1,z)*exp(-abs(y)) i=1,...,n c depending on kode. c nz - nz=0 , a normal return c nz.gt.0 , nz components of cy set to zero due to c underflow (generally on kode=2) c ierr - error flag c ierr=0, normal return - computation completed c ierr=1, input error - no computation c ierr=2, overflow - no computation, fnu is c too large or cabs(z) is too small or both c ierr=3, cabs(z) or fnu+n-1 large - computation done c but losses of signifcance by argument c reduction produce less than half of machine c accuracy c ierr=4, cabs(z) or fnu+n-1 too large - no computa- c tion because of complete losses of signifi- c cance by argument reduction c ierr=5, error - no computation, c algorithm termination condition not met c c c the computation is carried out by the formula c c y(fnu,z)=0.5*(h(1,fnu,z)-h(2,fnu,z))/i c c where i**2 = -1 and the hankel bessel functions h(1,fnu,z) c and h(2,fnu,z) are calculated in cbesh. c c for negative orders,the formula c c y(-fnu,z) = y(fnu,z)*cos(pi*fnu) + j(fnu,z)*sin(pi*fnu) c c can be used. however,for large orders close to half odd c integers the function changes radically. when fnu is a large c positive half odd integer,the magnitude of y(-fnu,z)=j(fnu,z)* c sin(pi*fnu) is a large negative power of ten. but when fnu is c not a half odd integer, y(fnu,z) dominates in magnitude with a c large positive power of ten and the most that the second term c can be reduced is by unit roundoff from the coefficient. thus, c wide changes can occur within unit roundoff of a large half c odd integer. here, large means fnu.gt.cabs(z). c c in most complex variable computation, one must evaluate ele- c mentary functions. when the magnitude of z or fnu+n-1 is c large, losses of significance by argument reduction occur. c consequently, if either one exceeds u1=sqrt(0.5/ur), then c losses exceeding half precision are likely and an error flag c ierr=3 is triggered where ur=dmax1(d1mach(4),1.0d-18) is c double precision unit roundoff limited to 18 digits precision. c if either is larger than u2=0.5/ur, then all significance is c lost and ierr=4. in order to use the int function, arguments c must be further restricted not to exceed the largest machine c integer, u3=i1mach(9). thus, the magnitude of z and fnu+n-1 is c restricted by min(u2,u3). on 32 bit machines, u1,u2, and u3 c are approximately 2.0e+3, 4.2e+6, 2.1e+9 in single precision c arithmetic and 1.3e+8, 1.8e+16, 2.1e+9 in double precision c arithmetic respectively. this makes u2 and u3 limiting in c their respective arithmetics. this means that one can expect c to retain, in the worst cases on 32 bit machines, no digits c in single and only 7 digits in double precision arithmetic. c similar considerations hold for other machines. c c the approximate relative error in the magnitude of a complex c bessel function can be expressed by p*10**s where p=max(unit c roundoff,1.0e-18) is the nominal precision and 10**s repre- c sents the increase in error due to argument reduction in the c elementary functions. here, s=max(1,abs(log10(cabs(z))), c abs(log10(fnu))) approximately (i.e. s=max(1,abs(exponent of c cabs(z),abs(exponent of fnu)) ). however, the phase angle may c have only absolute accuracy. this is most likely to occur when c one component (in absolute value) is larger than the other by c several orders of magnitude. if one component is 10**k larger c than the other, then one can expect only max(abs(log10(p))-k, c 0) significant digits; or, stated another way, when k exceeds c the exponent of p, no significant digits remain in the smaller c component. however, the phase angle retains absolute accuracy c because, in complex arithmetic with precision p, the smaller c component will not (as a rule) decrease below p times the c magnitude of the larger component. in these extreme cases, c the principal phase angle is on the order of +p, -p, pi/2-p, c or -pi/2+p. c c***routines called zbesh,i1mach,d1mach c c complex cwrk,cy,c1,c2,ex,hci,z,zu,zv double precision cwrki, cwrkr, cyi, cyr, c1i, c1r, c2i, c2r, * elim, exi, exr, ey, fnu, hcii, sti, str, tay, zi, zr, dexp, * d1mach, ascle, rtol, atol, aa, bb, tol integer i, ierr, k, kode, k1, k2, n, nz, nz1, nz2, i1mach dimension cyr(n), cyi(n), cwrkr(n), cwrki(n) c ierr = 0 nz=0 if (zr.eq.0.0d0 .and. zi.eq.0.0d0) ierr=1 if (fnu.lt.0.0d0) ierr=1 if (kode.lt.1 .or. kode.gt.2) ierr=1 if (n.lt.1) ierr=1 if (ierr.ne.0) return hcii = 0.5d0 call zbesh(zr, zi, fnu, kode, 1, n, cyr, cyi, nz1, ierr) if (ierr.ne.0.and.ierr.ne.3) go to 170 call zbesh(zr, zi, fnu, kode, 2, n, cwrkr, cwrki, nz2, ierr) if (ierr.ne.0.and.ierr.ne.3) go to 170 nz = min0(nz1,nz2) if (kode.eq.2) go to 60 do 50 i=1,n str = cwrkr(i) - cyr(i) sti = cwrki(i) - cyi(i) cyr(i) = -sti*hcii cyi(i) = str*hcii 50 continue return 60 continue tol = dmax1(d1mach(4),1.0d-18) k1 = i1mach(15) k2 = i1mach(16) k = min0(iabs(k1),iabs(k2)) r1m5 = d1mach(5) c----------------------------------------------------------------------- c elim is the approximate exponential under- and overflow limit c----------------------------------------------------------------------- elim = 2.303d0*(dble(float(k))*r1m5-3.0d0) exr = dcos(zr) exi = dsin(zr) ey = 0.0d0 tay = dabs(zi+zi) if (tay.lt.elim) ey = dexp(-tay) if (zi.lt.0.0d0) go to 90 c1r = exr*ey c1i = exi*ey c2r = exr c2i = -exi 70 continue nz = 0 rtol = 1.0d0/tol ascle = d1mach(1)*rtol*1.0d+3 do 80 i=1,n c str = c1r*cyr(i) - c1i*cyi(i) c sti = c1r*cyi(i) + c1i*cyr(i) c str = -str + c2r*cwrkr(i) - c2i*cwrki(i) c sti = -sti + c2r*cwrki(i) + c2i*cwrkr(i) c cyr(i) = -sti*hcii c cyi(i) = str*hcii aa = cwrkr(i) bb = cwrki(i) atol = 1.0d0 if (dmax1(dabs(aa),dabs(bb)).gt.ascle) go to 75 aa = aa*rtol bb = bb*rtol atol = tol 75 continue str = (aa*c2r - bb*c2i)*atol sti = (aa*c2i + bb*c2r)*atol aa = cyr(i) bb = cyi(i) atol = 1.0d0 if (dmax1(dabs(aa),dabs(bb)).gt.ascle) go to 85 aa = aa*rtol bb = bb*rtol atol = tol 85 continue str = str - (aa*c1r - bb*c1i)*atol sti = sti - (aa*c1i + bb*c1r)*atol cyr(i) = -sti*hcii cyi(i) = str*hcii if (str.eq.0.0d0 .and. sti.eq.0.0d0 .and. ey.eq.0.0d0) nz = nz * + 1 80 continue return 90 continue c1r = exr c1i = exi c2r = exr*ey c2i = -exi*ey go to 70 170 continue nz = 0 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zbesh(zr, zi, fnu, kode, m, n, cyr, cyi, nz, ierr) c h-Bessel functions of complex argument and third kind,hankel functions c Author Amos, Donald E., Sandia National Laboratories c c on kode=1, zbesh computes an n member sequence of complex c hankel (bessel) functions cy(j)=h(m,fnu+j-1,z) for kinds m=1 c or 2, real, nonnegative orders fnu+j-1, j=1,...,n, and complex c z.ne.cmplx(0.0,0.0) in the cut plane -pi.lt.arg(z).le.pi. c on kode=2, zbesh returns the scaled hankel functions c c cy(i)=exp(-mm*z*i)*h(m,fnu+j-1,z) mm=3-2*m, i**2=-1. c c which removes the exponential behavior in both the upper and c lower half planes. c c input zr,zi,fnu are double precision c zr,zi - z=cmplx(zr,zi), z.ne.cmplx(0.0d0,0.0d0), c -pt.lt.arg(z).le.pi c fnu - order of initial h function, fnu.ge.0.0d0 c kode - a parameter to indicate the scaling option c kode= 1 returns c cy(j)=h(m,fnu+j-1,z), j=1,...,n c = 2 returns c cy(j)=h(m,fnu+j-1,z)*exp(-i*z*(3-2m)) c j=1,...,n , i**2=-1 c m - kind of hankel function, m=1 or 2 c n - number of members in the sequence, n.ge.1 c c output cyr,cyi are double precision c cyr,cyi- double precision vectors whose first n components c contain real and imaginary parts for the sequence c cy(j)=h(m,fnu+j-1,z) or c cy(j)=h(m,fnu+j-1,z)*exp(-i*z*(3-2m)) j=1,...,n c depending on kode, i**2=-1. c nz - number of components set to zero due to underflow, c nz= 0 , normal return c nz.gt.0 , first nz components of cy set to zero due c to underflow, cy(j)=cmplx(0.0d0,0.0d0) c j=1,...,nz when y.gt.0.0 and m=1 or c y.lt.0.0 and m=2. for the complmentary c half planes, nz states only the number c of underflows. c ierr - error flag c ierr=0, normal return - computation completed c ierr=1, input error - no computation c ierr=2, overflow - no computation, fnu too c large or cabs(z) too small or both c ierr=3, cabs(z) or fnu+n-1 large - computation done c but losses of signifcance by argument c reduction produce less than half of machine c accuracy c ierr=4, cabs(z) or fnu+n-1 too large - no computa- c tion because of complete losses of signifi- c cance by argument reduction c ierr=5, error - no computation, c algorithm termination condition not met c c c the computation is carried out by the relation c c h(m,fnu,z)=(1/mp)*exp(-mp*fnu)*k(fnu,z*exp(-mp)) c mp=mm*hpi*i, mm=3-2*m, hpi=pi/2, i**2=-1 c c for m=1 or 2 where the k bessel function is computed for the c right half plane re(z).ge.0.0. the k function is continued c to the left half plane by the relation c c k(fnu,z*exp(mp)) = exp(-mp*fnu)*k(fnu,z)-mp*i(fnu,z) c mp=mr*pi*i, mr=+1 or -1, re(z).gt.0, i**2=-1 c c where i(fnu,z) is the i bessel function. c c exponential decay of h(m,fnu,z) occurs in the upper half z c plane for m=1 and the lower half z plane for m=2. exponential c growth occurs in the complementary half planes. scaling c by exp(-mm*z*i) removes the exponential behavior in the c whole z plane for z to infinity. c c for negative orders,the formulae c c h(1,-fnu,z) = h(1,fnu,z)*cexp( pi*fnu*i) c h(2,-fnu,z) = h(2,fnu,z)*cexp(-pi*fnu*i) c i**2=-1 c c can be used. c c in most complex variable computation, one must evaluate ele- c mentary functions. when the magnitude of z or fnu+n-1 is c large, losses of significance by argument reduction occur. c consequently, if either one exceeds u1=sqrt(0.5/ur), then c losses exceeding half precision are likely and an error flag c ierr=3 is triggered where ur=dmax1(d1mach(4),1.0d-18) is c double precision unit roundoff limited to 18 digits precision. c if either is larger than u2=0.5/ur, then all significance is c lost and ierr=4. in order to use the int function, arguments c must be further restricted not to exceed the largest machine c integer, u3=i1mach(9). thus, the magnitude of z and fnu+n-1 is c restricted by min(u2,u3). on 32 bit machines, u1,u2, and u3 c are approximately 2.0e+3, 4.2e+6, 2.1e+9 in single precision c arithmetic and 1.3e+8, 1.8e+16, 2.1e+9 in double precision c arithmetic respectively. this makes u2 and u3 limiting in c their respective arithmetics. this means that one can expect c to retain, in the worst cases on 32 bit machines, no digits c in single and only 7 digits in double precision arithmetic. c similar considerations hold for other machines. c c the approximate relative error in the magnitude of a complex c bessel function can be expressed by p*10**s where p=max(unit c roundoff,1.0d-18) is the nominal precision and 10**s repre- c sents the increase in error due to argument reduction in the c elementary functions. here, s=max(1,abs(log10(cabs(z))), c abs(log10(fnu))) approximately (i.e. s=max(1,abs(exponent of c cabs(z),abs(exponent of fnu)) ). however, the phase angle may c have only absolute accuracy. this is most likely to occur when c one component (in absolute value) is larger than the other by c several orders of magnitude. if one component is 10**k larger c than the other, then one can expect only max(abs(log10(p))-k, c 0) significant digits; or, stated another way, when k exceeds c the exponent of p, no significant digits remain in the smaller c component. however, the phase angle retains absolute accuracy c because, in complex arithmetic with precision p, the smaller c component will not (as a rule) decrease below p times the c magnitude of the larger component. in these extreme cases, c the principal phase angle is on the order of +p, -p, pi/2-p, c or -pi/2+p. c c***routines called zacon,zbknu,zbunk,zuoik,zabs2,i1mach,d1mach c c complex cy,z,zn,zt,csgn double precision aa, alim, aln, arg, az, cyi, cyr, dig, elim, * fmm, fn, fnu, fnul, hpi, rhpi, rl, r1m5, sgn, str, tol, ufl, zi, * zni, znr, zr, zti, d1mach, zabs2, bb, ascle, rtol, atol, sti, * csgnr, csgni integer i, ierr, inu, inuh, ir, k, kode, k1, k2, m, * mm, mr, n, nn, nuf, nw, nz, i1mach dimension cyr(n), cyi(n) data hpi /1.57079632679489662d0/ c ierr = 0 nz=0 if (zr.eq.0.0d0 .and. zi.eq.0.0d0) ierr=1 if (fnu.lt.0.0d0) ierr=1 if (m.lt.1 .or. m.gt.2) ierr=1 if (kode.lt.1 .or. kode.gt.2) ierr=1 if (n.lt.1) ierr=1 if (ierr.ne.0) return nn = n c----------------------------------------------------------------------- c set parameters related to machine constants. c tol is the approximate unit roundoff limited to 1.0e-18. c elim is the approximate exponential over- and underflow limit. c exp(-elim).lt.exp(-alim)=exp(-elim)/tol and c exp(elim).gt.exp(alim)=exp(elim)*tol are intervals near c underflow and overflow limits where scaled arithmetic is done. c rl is the lower boundary of the asymptotic expansion for large z. c dig = number of base 10 digits in tol = 10**(-dig). c fnul is the lower boundary of the asymptotic series for large fnu c----------------------------------------------------------------------- tol = dmax1(d1mach(4),1.0d-18) k1 = i1mach(15) k2 = i1mach(16) r1m5 = d1mach(5) k = min0(iabs(k1),iabs(k2)) elim = 2.303d0*(dble(float(k))*r1m5-3.0d0) k1 = i1mach(14) - 1 aa = r1m5*dble(float(k1)) dig = dmin1(aa,18.0d0) aa = aa*2.303d0 alim = elim + dmax1(-aa,-41.45d0) fnul = 10.0d0 + 6.0d0*(dig-3.0d0) rl = 1.2d0*dig + 3.0d0 fn = fnu + dble(float(nn-1)) mm = 3 - m - m fmm = dble(float(mm)) znr = fmm*zi zni = -fmm*zr c----------------------------------------------------------------------- c test for proper range c----------------------------------------------------------------------- az = zabs2(zr,zi) aa = 0.5d0/tol bb=dble(float(i1mach(9)))*0.5d0 aa = dmin1(aa,bb) if (az.gt.aa) go to 260 if (fn.gt.aa) go to 260 aa = dsqrt(aa) if (az.gt.aa) ierr=3 if (fn.gt.aa) ierr=3 c----------------------------------------------------------------------- c overflow test on the last member of the sequence c----------------------------------------------------------------------- ufl = d1mach(1)*1.0d+3 if (az.lt.ufl) go to 230 if (fnu.gt.fnul) go to 90 if (fn.le.1.0d0) go to 70 if (fn.gt.2.0d0) go to 60 if (az.gt.tol) go to 70 arg = 0.5d0*az aln = -fn*dlog(arg) if (aln.gt.elim) go to 230 go to 70 60 continue call zuoik(znr, zni, fnu, kode, 2, nn, cyr, cyi, nuf, tol, elim, * alim) if (nuf.lt.0) go to 230 nz = nz + nuf nn = nn - nuf c----------------------------------------------------------------------- c here nn=n or nn=0 since nuf=0,nn, or -1 on return from cuoik c if nuf=nn, then cy(i)=czero for all i c----------------------------------------------------------------------- if (nn.eq.0) go to 140 70 continue if ((znr.lt.0.0d0) .or. (znr.eq.0.0d0 .and. zni.lt.0.0d0 .and. * m.eq.2)) go to 80 c----------------------------------------------------------------------- c right half plane computation, xn.ge.0. .and. (xn.ne.0. .or. c yn.ge.0. .or. m=1) c----------------------------------------------------------------------- call zbknu(znr, zni, fnu, kode, nn, cyr, cyi, nz, tol, elim, alim) go to 110 c----------------------------------------------------------------------- c left half plane computation c----------------------------------------------------------------------- 80 continue mr = -mm call zacon(znr, zni, fnu, kode, mr, nn, cyr, cyi, nw, rl, fnul, * tol, elim, alim) if (nw.lt.0) go to 240 nz=nw go to 110 90 continue c----------------------------------------------------------------------- c uniform asymptotic expansions for fnu.gt.fnul c----------------------------------------------------------------------- mr = 0 if ((znr.ge.0.0d0) .and. (znr.ne.0.0d0 .or. zni.ge.0.0d0 .or. * m.ne.2)) go to 100 mr = -mm if (znr.ne.0.0d0 .or. zni.ge.0.0d0) go to 100 znr = -znr zni = -zni 100 continue call zbunk(znr, zni, fnu, kode, mr, nn, cyr, cyi, nw, tol, elim, * alim) if (nw.lt.0) go to 240 nz = nz + nw 110 continue c----------------------------------------------------------------------- c h(m,fnu,z) = -fmm*(i/hpi)*(zt**fnu)*k(fnu,-z*zt) c c zt=exp(-fmm*hpi*i) = cmplx(0.0,-fmm), fmm=3-2*m, m=1,2 c----------------------------------------------------------------------- sgn = dsign(hpi,-fmm) c----------------------------------------------------------------------- c calculate exp(fnu*hpi*i) to minimize losses of significance c when fnu is large c----------------------------------------------------------------------- inu = int(sngl(fnu)) inuh = inu/2 ir = inu - 2*inuh arg = (fnu-dble(float(inu-ir)))*sgn rhpi = 1.0d0/sgn c zni = rhpi*dcos(arg) c znr = -rhpi*dsin(arg) csgni = rhpi*dcos(arg) csgnr = -rhpi*dsin(arg) if (mod(inuh,2).eq.0) go to 120 c znr = -znr c zni = -zni csgnr = -csgnr csgni = -csgni 120 continue zti = -fmm rtol = 1.0d0/tol ascle = ufl*rtol do 130 i=1,nn c str = cyr(i)*znr - cyi(i)*zni c cyi(i) = cyr(i)*zni + cyi(i)*znr c cyr(i) = str c str = -zni*zti c zni = znr*zti c znr = str aa = cyr(i) bb = cyi(i) atol = 1.0d0 if (dmax1(dabs(aa),dabs(bb)).gt.ascle) go to 135 aa = aa*rtol bb = bb*rtol atol = tol 135 continue str = aa*csgnr - bb*csgni sti = aa*csgni + bb*csgnr cyr(i) = str*atol cyi(i) = sti*atol str = -csgni*zti csgni = csgnr*zti csgnr = str 130 continue return 140 continue if (znr.lt.0.0d0) go to 230 return 230 continue nz=0 ierr=2 return 240 continue if(nw.eq.(-1)) go to 230 nz=0 ierr=5 return 260 continue nz=0 ierr=4 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zbesi(zr, zi, fnu, kode, n, cyr, cyi, nz, ierr) c i-Bessel function,complex bessel function, c modified bessel function of the first kind c Author Amos, Donald E., Sandia National Laboratories c c on kode=1, zbesi computes an n member sequence of complex c bessel functions cy(j)=i(fnu+j-1,z) for real, nonnegative c orders fnu+j-1, j=1,...,n and complex z in the cut plane c -pi.lt.arg(z).le.pi. on kode=2, zbesi returns the scaled c functions c c cy(j)=exp(-abs(x))*i(fnu+j-1,z) j = 1,...,n , x=real(z) c c with the exponential growth removed in both the left and c right half planes for z to infinity. definitions and notation c are found in the nbs handbook of mathematical functions c (ref. 1). c c input zr,zi,fnu are double precision c zr,zi - z=cmplx(zr,zi), -pi.lt.arg(z).le.pi c fnu - order of initial i function, fnu.ge.0.0d0 c kode - a parameter to indicate the scaling option c kode= 1 returns c cy(j)=i(fnu+j-1,z), j=1,...,n c = 2 returns c cy(j)=i(fnu+j-1,z)*exp(-abs(x)), j=1,...,n c n - number of members of the sequence, n.ge.1 c c output cyr,cyi are double precision c cyr,cyi- double precision vectors whose first n components c contain real and imaginary parts for the sequence c cy(j)=i(fnu+j-1,z) or c cy(j)=i(fnu+j-1,z)*exp(-abs(x)) j=1,...,n c depending on kode, x=real(z) c nz - number of components set to zero due to underflow, c nz= 0 , normal return c nz.gt.0 , last nz components of cy set to zero c to underflow, cy(j)=cmplx(0.0d0,0.0d0) c j = n-nz+1,...,n c ierr - error flag c ierr=0, normal return - computation completed c ierr=1, input error - no computation c ierr=2, overflow - no computation, real(z) too c large on kode=1 c ierr=3, cabs(z) or fnu+n-1 large - computation done c but losses of signifcance by argument c reduction produce less than half of machine c accuracy c ierr=4, cabs(z) or fnu+n-1 too large - no computa- c tion because of complete losses of signifi- c cance by argument reduction c ierr=5, error - no computation, c algorithm termination condition not met c c c the computation is carried out by the power series for c small cabs(z), the asymptotic expansion for large cabs(z), c the miller algorithm normalized by the wronskian and a c neumann series for imtermediate magnitudes, and the c uniform asymptotic expansions for i(fnu,z) and j(fnu,z) c for large orders. backward recurrence is used to generate c sequences or reduce orders when necessary. c c the calculations above are done in the right half plane and c continued into the left half plane by the formula c c i(fnu,z*exp(m*pi)) = exp(m*pi*fnu)*i(fnu,z) real(z).gt.0.0 c m = +i or -i, i**2=-1 c c for negative orders,the formula c c i(-fnu,z) = i(fnu,z) + (2/pi)*sin(pi*fnu)*k(fnu,z) c c can be used. however,for large orders close to integers, the c the function changes radically. when fnu is a large positive c integer,the magnitude of i(-fnu,z)=i(fnu,z) is a large c negative power of ten. but when fnu is not an integer, c k(fnu,z) dominates in magnitude with a large positive power of c ten and the most that the second term can be reduced is by c unit roundoff from the coefficient. thus, wide changes can c occur within unit roundoff of a large integer for fnu. here, c large means fnu.gt.cabs(z). c c in most complex variable computation, one must evaluate ele- c mentary functions. when the magnitude of z or fnu+n-1 is c large, losses of significance by argument reduction occur. c consequently, if either one exceeds u1=sqrt(0.5/ur), then c losses exceeding half precision are likely and an error flag c ierr=3 is triggered where ur=dmax1(d1mach(4),1.0d-18) is c double precision unit roundoff limited to 18 digits precision. c if either is larger than u2=0.5/ur, then all significance is c lost and ierr=4. in order to use the int function, arguments c must be further restricted not to exceed the largest machine c integer, u3=i1mach(9). thus, the magnitude of z and fnu+n-1 is c restricted by min(u2,u3). on 32 bit machines, u1,u2, and u3 c are approximately 2.0e+3, 4.2e+6, 2.1e+9 in single precision c arithmetic and 1.3e+8, 1.8e+16, 2.1e+9 in double precision c arithmetic respectively. this makes u2 and u3 limiting in c their respective arithmetics. this means that one can expect c to retain, in the worst cases on 32 bit machines, no digits c in single and only 7 digits in double precision arithmetic. c similar considerations hold for other machines. c c the approximate relative error in the magnitude of a complex c bessel function can be expressed by p*10**s where p=max(unit c roundoff,1.0e-18) is the nominal precision and 10**s repre- c sents the increase in error due to argument reduction in the c elementary functions. here, s=max(1,abs(log10(cabs(z))), c abs(log10(fnu))) approximately (i.e. s=max(1,abs(exponent of c cabs(z),abs(exponent of fnu)) ). however, the phase angle may c have only absolute accuracy. this is most likely to occur when c one component (in absolute value) is larger than the other by c several orders of magnitude. if one component is 10**k larger c than the other, then one can expect only max(abs(log10(p))-k, c 0) significant digits; or, stated another way, when k exceeds c the exponent of p, no significant digits remain in the smaller c component. however, the phase angle retains absolute accuracy c because, in complex arithmetic with precision p, the smaller c component will not (as a rule) decrease below p times the c magnitude of the larger component. in these extreme cases, c the principal phase angle is on the order of +p, -p, pi/2-p, c or -pi/2+p. c c***routines called zbinu,i1mach,d1mach c complex cone,csgn,cw,cy,czero,z,zn double precision aa, alim, arg, conei, coner, csgni, csgnr, cyi, * cyr, dig, elim, fnu, fnul, pi, rl, r1m5, str, tol, zi, zni, znr, * zr, d1mach, az, bb, fn, zabs2, ascle, rtol, atol, sti integer i, ierr, inu, k, kode, k1,k2,n,nz,nn, i1mach dimension cyr(n), cyi(n) data pi /3.14159265358979324d0/ data coner, conei /1.0d0,0.0d0/ c ierr = 0 nz=0 if (fnu.lt.0.0d0) ierr=1 if (kode.lt.1 .or. kode.gt.2) ierr=1 if (n.lt.1) ierr=1 if (ierr.ne.0) return c----------------------------------------------------------------------- c set parameters related to machine constants. c tol is the approximate unit roundoff limited to 1.0e-18. c elim is the approximate exponential over- and underflow limit. c exp(-elim).lt.exp(-alim)=exp(-elim)/tol and c exp(elim).gt.exp(alim)=exp(elim)*tol are intervals near c underflow and overflow limits where scaled arithmetic is done. c rl is the lower boundary of the asymptotic expansion for large z. c dig = number of base 10 digits in tol = 10**(-dig). c fnul is the lower boundary of the asymptotic series for large fnu. c----------------------------------------------------------------------- tol = dmax1(d1mach(4),1.0d-18) k1 = i1mach(15) k2 = i1mach(16) r1m5 = d1mach(5) k = min0(iabs(k1),iabs(k2)) elim = 2.303d0*(dble(float(k))*r1m5-3.0d0) k1 = i1mach(14) - 1 aa = r1m5*dble(float(k1)) dig = dmin1(aa,18.0d0) aa = aa*2.303d0 alim = elim + dmax1(-aa,-41.45d0) rl = 1.2d0*dig + 3.0d0 fnul = 10.0d0 + 6.0d0*(dig-3.0d0) c----------------------------------------------------------------------------- c test for proper range c----------------------------------------------------------------------- az = zabs2(zr,zi) fn = fnu+dble(float(n-1)) aa = 0.5d0/tol bb=dble(float(i1mach(9)))*0.5d0 aa = dmin1(aa,bb) if (az.gt.aa) go to 260 if (fn.gt.aa) go to 260 aa = dsqrt(aa) if (az.gt.aa) ierr=3 if (fn.gt.aa) ierr=3 znr = zr zni = zi csgnr = coner csgni = conei if (zr.ge.0.0d0) go to 40 znr = -zr zni = -zi c----------------------------------------------------------------------- c calculate csgn=exp(fnu*pi*i) to minimize losses of significance c when fnu is large c----------------------------------------------------------------------- inu = int(sngl(fnu)) arg = (fnu-dble(float(inu)))*pi if (zi.lt.0.0d0) arg = -arg csgnr = dcos(arg) csgni = dsin(arg) if (mod(inu,2).eq.0) go to 40 csgnr = -csgnr csgni = -csgni 40 continue call zbinu(znr, zni, fnu, kode, n, cyr, cyi, nz, rl, fnul, tol, * elim, alim) if (nz.lt.0) go to 120 if (zr.ge.0.0d0) return c----------------------------------------------------------------------- c analytic continuation to the left half plane c----------------------------------------------------------------------- nn = n - nz if (nn.eq.0) return rtol = 1.0d0/tol ascle = d1mach(1)*rtol*1.0d+3 do 50 i=1,nn c str = cyr(i)*csgnr - cyi(i)*csgni c cyi(i) = cyr(i)*csgni + cyi(i)*csgnr c cyr(i) = str aa = cyr(i) bb = cyi(i) atol = 1.0d0 if (dmax1(dabs(aa),dabs(bb)).gt.ascle) go to 55 aa = aa*rtol bb = bb*rtol atol = tol 55 continue str = aa*csgnr - bb*csgni sti = aa*csgni + bb*csgnr cyr(i) = str*atol cyi(i) = sti*atol csgnr = -csgnr csgni = -csgni 50 continue return 120 continue if(nz.eq.(-2)) go to 130 nz = 0 ierr=2 return 130 continue nz=0 ierr=5 return 260 continue nz=0 ierr=4 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zbesk(zr, zi, fnu, kode, n, cyr, cyi, nz, ierr) c k-Bessel function,complex bessel function, c modified bessel function of the second kind, c bessel function of the third kind c Author Amos, Donald E., Sandia National Laboratories c c on kode=1, cbesk computes an n member sequence of complex c bessel functions cy(j)=k(fnu+j-1,z) for real, nonnegative c orders fnu+j-1, j=1,...,n and complex z.ne.cmplx(0.0,0.0) c in the cut plane -pi.lt.arg(z).le.pi. on kode=2, cbesk c returns the scaled k functions, c c cy(j)=exp(z)*k(fnu+j-1,z) , j=1,...,n, c c which remove the exponential behavior in both the left and c right half planes for z to infinity. c c input zr,zi,fnu are double precision c zr,zi - z=cmplx(zr,zi), z.ne.cmplx(0.0d0,0.0d0), c -pi.lt.arg(z).le.pi c fnu - order of initial k function, fnu.ge.0.0d0 c n - number of members of the sequence, n.ge.1 c kode - a parameter to indicate the scaling option c kode= 1 returns c cy(i)=k(fnu+i-1,z), i=1,...,n c = 2 returns c cy(i)=k(fnu+i-1,z)*exp(z), i=1,...,n c c output cyr,cyi are double precision c cyr,cyi- double precision vectors whose first n components c contain real and imaginary parts for the sequence c cy(i)=k(fnu+i-1,z), i=1,...,n or c cy(i)=k(fnu+i-1,z)*exp(z), i=1,...,n c depending on kode c nz - number of components set to zero due to underflow. c nz= 0 , normal return c nz.gt.0 , first nz components of cy set to zero due c to underflow, cy(i)=cmplx(0.0d0,0.0d0), c i=1,...,n when x.ge.0.0. when x.lt.0.0 c nz states only the number of underflows c in the sequence. c c ierr - error flag c ierr=0, normal return - computation completed c ierr=1, input error - no computation c ierr=2, overflow - no computation, fnu is c too large or cabs(z) is too small or both c ierr=3, cabs(z) or fnu+n-1 large - computation done c but losses of signifcance by argument c reduction produce less than half of machine c accuracy c ierr=4, cabs(z) or fnu+n-1 too large - no computa- c tion because of complete losses of signifi- c cance by argument reduction c ierr=5, error - no computation, c algorithm termination condition not met c c c equations of the reference are implemented for small orders c dnu and dnu+1.0 in the right half plane x.ge.0.0. forward c recurrence generates higher orders. k is continued to the left c half plane by the relation c c k(fnu,z*exp(mp)) = exp(-mp*fnu)*k(fnu,z)-mp*i(fnu,z) c mp=mr*pi*i, mr=+1 or -1, re(z).gt.0, i**2=-1 c c where i(fnu,z) is the i bessel function. c c for large orders, fnu.gt.fnul, the k function is computed c by means of its uniform asymptotic expansions. c c for negative orders, the formula c c k(-fnu,z) = k(fnu,z) c c can be used. c c cbesk assumes that a significant digit sinh(x) function is c available. c c in most complex variable computation, one must evaluate ele- c mentary functions. when the magnitude of z or fnu+n-1 is c large, losses of significance by argument reduction occur. c consequently, if either one exceeds u1=sqrt(0.5/ur), then c losses exceeding half precision are likely and an error flag c ierr=3 is triggered where ur=dmax1(d1mach(4),1.0d-18) is c double precision unit roundoff limited to 18 digits precision. c if either is larger than u2=0.5/ur, then all significance is c lost and ierr=4. in order to use the int function, arguments c must be further restricted not to exceed the largest machine c integer, u3=i1mach(9). thus, the magnitude of z and fnu+n-1 is c restricted by min(u2,u3). on 32 bit machines, u1,u2, and u3 c are approximately 2.0e+3, 4.2e+6, 2.1e+9 in single precision c arithmetic and 1.3e+8, 1.8e+16, 2.1e+9 in double precision c arithmetic respectively. this makes u2 and u3 limiting in c their respective arithmetics. this means that one can expect c to retain, in the worst cases on 32 bit machines, no digits c in single and only 7 digits in double precision arithmetic. c similar considerations hold for other machines. c c the approximate relative error in the magnitude of a complex c bessel function can be expressed by p*10**s where p=max(unit c roundoff,1.0e-18) is the nominal precision and 10**s repre- c sents the increase in error due to argument reduction in the c elementary functions. here, s=max(1,abs(log10(cabs(z))), c abs(log10(fnu))) approximately (i.e. s=max(1,abs(exponent of c cabs(z),abs(exponent of fnu)) ). however, the phase angle may c have only absolute accuracy. this is most likely to occur when c one component (in absolute value) is larger than the other by c several orders of magnitude. if one component is 10**k larger c than the other, then one can expect only max(abs(log10(p))-k, c 0) significant digits; or, stated another way, when k exceeds c the exponent of p, no significant digits remain in the smaller c component. however, the phase angle retains absolute accuracy c because, in complex arithmetic with precision p, the smaller c component will not (as a rule) decrease below p times the c magnitude of the larger component. in these extreme cases, c the principal phase angle is on the order of +p, -p, pi/2-p, c or -pi/2+p. c c***routines called zacon,zbknu,zbunk,zuoik,zabs2,i1mach,d1mach c c complex cy,z double precision aa, alim, aln, arg, az, cyi, cyr, dig, elim, fn, * fnu, fnul, rl, r1m5, tol, ufl, zi, zr, d1mach, zabs2, bb integer ierr, k, kode, k1, k2, mr, n, nn, nuf, nw, nz, i1mach dimension cyr(n), cyi(n) c ierr = 0 nz=0 if (zi.eq.0.0e0 .and. zr.eq.0.0e0) ierr=1 if (fnu.lt.0.0d0) ierr=1 if (kode.lt.1 .or. kode.gt.2) ierr=1 if (n.lt.1) ierr=1 if (ierr.ne.0) return nn = n c----------------------------------------------------------------------- c set parameters related to machine constants. c tol is the approximate unit roundoff limited to 1.0e-18. c elim is the approximate exponential over- and underflow limit. c exp(-elim).lt.exp(-alim)=exp(-elim)/tol and c exp(elim).gt.exp(alim)=exp(elim)*tol are intervals near c underflow and overflow limits where scaled arithmetic is done. c rl is the lower boundary of the asymptotic expansion for large z. c dig = number of base 10 digits in tol = 10**(-dig). c fnul is the lower boundary of the asymptotic series for large fnu c----------------------------------------------------------------------- tol = dmax1(d1mach(4),1.0d-18) k1 = i1mach(15) k2 = i1mach(16) r1m5 = d1mach(5) k = min0(iabs(k1),iabs(k2)) elim = 2.303d0*(dble(float(k))*r1m5-3.0d0) k1 = i1mach(14) - 1 aa = r1m5*dble(float(k1)) dig = dmin1(aa,18.0d0) aa = aa*2.303d0 alim = elim + dmax1(-aa,-41.45d0) fnul = 10.0d0 + 6.0d0*(dig-3.0d0) rl = 1.2d0*dig + 3.0d0 c----------------------------------------------------------------------------- c test for proper range c----------------------------------------------------------------------- az = zabs2(zr,zi) fn = fnu + dble(float(nn-1)) aa = 0.5d0/tol bb=dble(float(i1mach(9)))*0.5d0 aa = dmin1(aa,bb) if (az.gt.aa) go to 260 if (fn.gt.aa) go to 260 aa = dsqrt(aa) if (az.gt.aa) ierr=3 if (fn.gt.aa) ierr=3 c----------------------------------------------------------------------- c overflow test on the last member of the sequence c----------------------------------------------------------------------- c ufl = dexp(-elim) ufl = d1mach(1)*1.0d+3 if (az.lt.ufl) go to 180 if (fnu.gt.fnul) go to 80 if (fn.le.1.0d0) go to 60 if (fn.gt.2.0d0) go to 50 if (az.gt.tol) go to 60 arg = 0.5d0*az aln = -fn*dlog(arg) if (aln.gt.elim) go to 180 go to 60 50 continue call zuoik(zr, zi, fnu, kode, 2, nn, cyr, cyi, nuf, tol, elim, * alim) if (nuf.lt.0) go to 180 nz = nz + nuf nn = nn - nuf c----------------------------------------------------------------------- c here nn=n or nn=0 since nuf=0,nn, or -1 on return from cuoik c if nuf=nn, then cy(i)=czero for all i c----------------------------------------------------------------------- if (nn.eq.0) go to 100 60 continue if (zr.lt.0.0d0) go to 70 c----------------------------------------------------------------------- c right half plane computation, real(z).ge.0. c----------------------------------------------------------------------- call zbknu(zr, zi, fnu, kode, nn, cyr, cyi, nw, tol, elim, alim) if (nw.lt.0) go to 200 nz=nw return c----------------------------------------------------------------------- c left half plane computation c pi/2.lt.arg(z).le.pi and -pi.lt.arg(z).lt.-pi/2. c----------------------------------------------------------------------- 70 continue if (nz.ne.0) go to 180 mr = 1 if (zi.lt.0.0d0) mr = -1 call zacon(zr, zi, fnu, kode, mr, nn, cyr, cyi, nw, rl, fnul, * tol, elim, alim) if (nw.lt.0) go to 200 nz=nw return c----------------------------------------------------------------------- c uniform asymptotic expansions for fnu.gt.fnul c----------------------------------------------------------------------- 80 continue mr = 0 if (zr.ge.0.0d0) go to 90 mr = 1 if (zi.lt.0.0d0) mr = -1 90 continue call zbunk(zr, zi, fnu, kode, mr, nn, cyr, cyi, nw, tol, elim, * alim) if (nw.lt.0) go to 200 nz = nz + nw return 100 continue if (zr.lt.0.0d0) go to 180 return 180 continue nz = 0 ierr=2 return 200 continue if(nw.eq.(-1)) go to 180 nz=0 ierr=5 return 260 continue nz=0 ierr=4 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zasyi(zr, zi, fnu, kode, n, yr, yi, nz, rl, tol, elim, * alim) c geuz for g77 EXTERNAL zsqrt EXTERNAL zexp c Refer to zbesi,zbesk c c zasyi computes the i bessel function for real(z).ge.0.0 by c means of the asymptotic expansion for large cabs(z) in the c region cabs(z).gt.max(rl,fnu*fnu/2). nz=0 is a normal return. c nz.lt.0 indicates an overflow on kode=1. c c***routines called d1mach,zabs2,zdiv,zexp,zmlt,zsqrt c c complex ak1,ck,cone,cs1,cs2,cz,czero,dk,ez,p1,rz,s2,y,z double precision aa, aez, ak, ak1i, ak1r, alim, arg, arm, atol, * az, bb, bk, cki, ckr, conei, coner, cs1i, cs1r, cs2i, cs2r, czi, * czr, dfnu, dki, dkr, dnu2, elim, ezi, ezr, fdn, fnu, pi, p1i, * p1r, raz, rl, rtpi, rtr1, rzi, rzr, s, sgn, sqk, sti, str, s2i, * s2r, tol, tzi, tzr, yi, yr, zeroi, zeror, zi, zr, d1mach, zabs2 integer i, ib, il, inu, j, jl, k, kode, koded, m, n, nn, nz dimension yr(n), yi(n) data pi, rtpi /3.14159265358979324d0 , 0.159154943091895336d0 / data zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 / c nz = 0 az = zabs2(zr,zi) arm = 1.0d+3*d1mach(1) rtr1 = dsqrt(arm) il = min0(2,n) dfnu = fnu + dble(float(n-il)) c----------------------------------------------------------------------- c overflow test c----------------------------------------------------------------------- raz = 1.0d0/az str = zr*raz sti = -zi*raz ak1r = rtpi*str*raz ak1i = rtpi*sti*raz call zsqrt(ak1r, ak1i, ak1r, ak1i) czr = zr czi = zi if (kode.ne.2) go to 10 czr = zeror czi = zi 10 continue if (dabs(czr).gt.elim) go to 100 dnu2 = dfnu + dfnu koded = 1 if ((dabs(czr).gt.alim) .and. (n.gt.2)) go to 20 koded = 0 call zexp(czr, czi, str, sti) call zmlt(ak1r, ak1i, str, sti, ak1r, ak1i) 20 continue fdn = 0.0d0 if (dnu2.gt.rtr1) fdn = dnu2*dnu2 ezr = zr*8.0d0 ezi = zi*8.0d0 c----------------------------------------------------------------------- c when z is imaginary, the error test must be made relative to the c first reciprocal power since this is the leading term of the c expansion for the imaginary part. c----------------------------------------------------------------------- aez = 8.0d0*az s = tol/aez jl = int(sngl(rl+rl)) + 2 p1r = zeror p1i = zeroi if (zi.eq.0.0d0) go to 30 c----------------------------------------------------------------------- c calculate exp(pi*(0.5+fnu+n-il)*i) to minimize losses of c significance when fnu or n is large c----------------------------------------------------------------------- inu = int(sngl(fnu)) arg = (fnu-dble(float(inu)))*pi inu = inu + n - il ak = -dsin(arg) bk = dcos(arg) if (zi.lt.0.0d0) bk = -bk p1r = ak p1i = bk if (mod(inu,2).eq.0) go to 30 p1r = -p1r p1i = -p1i 30 continue do 70 k=1,il sqk = fdn - 1.0d0 atol = s*dabs(sqk) sgn = 1.0d0 cs1r = coner cs1i = conei cs2r = coner cs2i = conei ckr = coner cki = conei ak = 0.0d0 aa = 1.0d0 bb = aez dkr = ezr dki = ezi do 40 j=1,jl call zdiv(ckr, cki, dkr, dki, str, sti) ckr = str*sqk cki = sti*sqk cs2r = cs2r + ckr cs2i = cs2i + cki sgn = -sgn cs1r = cs1r + ckr*sgn cs1i = cs1i + cki*sgn dkr = dkr + ezr dki = dki + ezi aa = aa*dabs(sqk)/bb bb = bb + aez ak = ak + 8.0d0 sqk = sqk - ak if (aa.le.atol) go to 50 40 continue go to 110 50 continue s2r = cs1r s2i = cs1i if (zr+zr.ge.elim) go to 60 tzr = zr + zr tzi = zi + zi call zexp(-tzr, -tzi, str, sti) call zmlt(str, sti, p1r, p1i, str, sti) call zmlt(str, sti, cs2r, cs2i, str, sti) s2r = s2r + str s2i = s2i + sti 60 continue fdn = fdn + 8.0d0*dfnu + 4.0d0 p1r = -p1r p1i = -p1i m = n - il + k yr(m) = s2r*ak1r - s2i*ak1i yi(m) = s2r*ak1i + s2i*ak1r 70 continue if (n.le.2) return nn = n k = nn - 2 ak = dble(float(k)) str = zr*raz sti = -zi*raz rzr = (str+str)*raz rzi = (sti+sti)*raz ib = 3 do 80 i=ib,nn yr(k) = (ak+fnu)*(rzr*yr(k+1)-rzi*yi(k+1)) + yr(k+2) yi(k) = (ak+fnu)*(rzr*yi(k+1)+rzi*yr(k+1)) + yi(k+2) ak = ak - 1.0d0 k = k - 1 80 continue if (koded.eq.0) return call zexp(czr, czi, ckr, cki) do 90 i=1,nn str = yr(i)*ckr - yi(i)*cki yi(i) = yr(i)*cki + yi(i)*ckr yr(i) = str 90 continue return 100 continue nz = -1 return 110 continue nz=-2 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zbinu(zr, zi, fnu, kode, n, cyr, cyi, nz, rl, fnul, * tol, elim, alim) c***refer to zbesh,zbesi,zbesj,zbesk,zairy,zbiry c c zbinu computes the i function in the right half z plane c c***routines called zabs2,zasyi,zbuni,zmlri,zseri,zuoik,zwrsk c double precision alim, az, cwi, cwr, cyi, cyr, dfnu, elim, fnu, * fnul, rl, tol, zeroi, zeror, zi, zr, zabs2 integer i, inw, kode, n, nlast, nn, nui, nw, nz dimension cyr(n), cyi(n), cwr(2), cwi(2) data zeror,zeroi / 0.0d0, 0.0d0 / c nz = 0 az = zabs2(zr,zi) nn = n dfnu = fnu + dble(float(n-1)) if (az.le.2.0d0) go to 10 if (az*az*0.25d0.gt.dfnu+1.0d0) go to 20 10 continue c----------------------------------------------------------------------- c power series c----------------------------------------------------------------------- call zseri(zr, zi, fnu, kode, nn, cyr, cyi, nw, tol, elim, alim) inw = iabs(nw) nz = nz + inw nn = nn - inw if (nn.eq.0) return if (nw.ge.0) go to 120 dfnu = fnu + dble(float(nn-1)) 20 continue if (az.lt.rl) go to 40 if (dfnu.le.1.0d0) go to 30 if (az+az.lt.dfnu*dfnu) go to 50 c----------------------------------------------------------------------- c asymptotic expansion for large z c----------------------------------------------------------------------- 30 continue call zasyi(zr, zi, fnu, kode, nn, cyr, cyi, nw, rl, tol, elim, * alim) if (nw.lt.0) go to 130 go to 120 40 continue if (dfnu.le.1.0d0) go to 70 50 continue c----------------------------------------------------------------------- c overflow and underflow test on i sequence for miller algorithm c----------------------------------------------------------------------- call zuoik(zr, zi, fnu, kode, 1, nn, cyr, cyi, nw, tol, elim, * alim) if (nw.lt.0) go to 130 nz = nz + nw nn = nn - nw if (nn.eq.0) return dfnu = fnu+dble(float(nn-1)) if (dfnu.gt.fnul) go to 110 if (az.gt.fnul) go to 110 60 continue if (az.gt.rl) go to 80 70 continue c----------------------------------------------------------------------- c miller algorithm normalized by the series c----------------------------------------------------------------------- call zmlri(zr, zi, fnu, kode, nn, cyr, cyi, nw, tol) if(nw.lt.0) go to 130 go to 120 80 continue c----------------------------------------------------------------------- c miller algorithm normalized by the wronskian c----------------------------------------------------------------------- c----------------------------------------------------------------------- c overflow test on k functions used in wronskian c----------------------------------------------------------------------- call zuoik(zr, zi, fnu, kode, 2, 2, cwr, cwi, nw, tol, elim, * alim) if (nw.ge.0) go to 100 nz = nn do 90 i=1,nn cyr(i) = zeror cyi(i) = zeroi 90 continue return 100 continue if (nw.gt.0) go to 130 call zwrsk(zr, zi, fnu, kode, nn, cyr, cyi, nw, cwr, cwi, tol, * elim, alim) if (nw.lt.0) go to 130 go to 120 110 continue c----------------------------------------------------------------------- c increment fnu+nn-1 up to fnul, compute and recur backward c----------------------------------------------------------------------- nui = int(sngl(fnul-dfnu)) + 1 nui = max0(nui,0) call zbuni(zr, zi, fnu, kode, nn, cyr, cyi, nw, nui, nlast, fnul, * tol, elim, alim) if (nw.lt.0) go to 130 nz = nz + nw if (nlast.eq.0) go to 120 nn = nlast go to 60 120 continue return 130 continue nz = -1 if(nw.eq.(-2)) nz=-2 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zbknu(zr, zi, fnu, kode, n, yr, yi, nz, tol, elim, * alim) c geuz for g77 EXTERNAL zsqrt EXTERNAL zexp EXTERNAL zlog c Refer to zbesi,zbesk,zairy,zbesh c c zbknu computes the k bessel function in the right half z plane. c c***routines called dgamln,i1mach,d1mach,zkscl,zshch,zuchk,zabs2,zdiv, c zexp,zlog,zmlt,zsqrt c double precision aa, ak, alim, ascle, a1, a2, bb, bk, bry, caz, * cbi, cbr, cc, cchi, cchr, cki, ckr, coefi, coefr, conei, coner, * crscr, csclr, cshi, cshr, csi, csr, csrr, cssr, ctwor, * czeroi, czeror, czi, czr, dnu, dnu2, dpi, elim, etest, fc, fhs, * fi, fk, fks, fmui, fmur, fnu, fpi, fr, g1, g2, hpi, pi, pr, pti, * ptr, p1i, p1r, p2i, p2m, p2r, qi, qr, rak, rcaz, rthpi, rzi, * rzr, r1, s, smui, smur, spi, sti, str, s1i, s1r, s2i, s2r, tm, * tol, tth, t1, t2, yi, yr, zi, zr, dgamln, d1mach, zabs2, elm, * celmr, zdr, zdi, as, alas, helim, cyr, cyi integer i, iflag, inu, k, kflag, kk, kmax, kode, koded, n, nz, * idum, i1mach, j, ic, inub, nw dimension yr(n), yi(n), cc(8), cssr(3), csrr(3), bry(3), cyr(2), * cyi(2) c complex z,y,a,b,rz,smu,fu,fmu,f,flrz,cz,s1,s2,csh,cch c complex ck,p,q,coef,p1,p2,cbk,pt,czero,cone,ctwo,st,ez,cs,dk c data kmax / 30 / data czeror,czeroi,coner,conei,ctwor,r1/ 1 0.0d0 , 0.0d0 , 1.0d0 , 0.0d0 , 2.0d0 , 2.0d0 / data dpi, rthpi, spi ,hpi, fpi, tth / 1 3.14159265358979324d0, 1.25331413731550025d0, 2 1.90985931710274403d0, 1.57079632679489662d0, 3 1.89769999331517738d0, 6.66666666666666666d-01/ data cc(1), cc(2), cc(3), cc(4), cc(5), cc(6), cc(7), cc(8)/ 1 5.77215664901532861d-01, -4.20026350340952355d-02, 2 -4.21977345555443367d-02, 7.21894324666309954d-03, 3 -2.15241674114950973d-04, -2.01348547807882387d-05, 4 1.13302723198169588d-06, 6.11609510448141582d-09/ c caz = zabs2(zr,zi) csclr = 1.0d0/tol crscr = tol cssr(1) = csclr cssr(2) = 1.0d0 cssr(3) = crscr csrr(1) = crscr csrr(2) = 1.0d0 csrr(3) = csclr bry(1) = 1.0d+3*d1mach(1)/tol bry(2) = 1.0d0/bry(1) bry(3) = d1mach(2) nz = 0 iflag = 0 koded = kode rcaz = 1.0d0/caz str = zr*rcaz sti = -zi*rcaz rzr = (str+str)*rcaz rzi = (sti+sti)*rcaz inu = int(sngl(fnu+0.5d0)) dnu = fnu - dble(float(inu)) if (dabs(dnu).eq.0.5d0) go to 110 dnu2 = 0.0d0 if (dabs(dnu).gt.tol) dnu2 = dnu*dnu if (caz.gt.r1) go to 110 c----------------------------------------------------------------------- c series for cabs(z).le.r1 c----------------------------------------------------------------------- fc = 1.0d0 call zlog(rzr, rzi, smur, smui, idum) fmur = smur*dnu fmui = smui*dnu call zshch(fmur, fmui, cshr, cshi, cchr, cchi) if (dnu.eq.0.0d0) go to 10 fc = dnu*dpi fc = fc/dsin(fc) smur = cshr/dnu smui = cshi/dnu 10 continue a2 = 1.0d0 + dnu c----------------------------------------------------------------------- c gam(1-z)*gam(1+z)=pi*z/sin(pi*z), t1=1/gam(1-dnu), t2=1/gam(1+dnu) c----------------------------------------------------------------------- t2 = dexp(-dgamln(a2,idum)) t1 = 1.0d0/(t2*fc) if (dabs(dnu).gt.0.1d0) go to 40 c----------------------------------------------------------------------- c series for f0 to resolve indeterminacy for small abs(dnu) c----------------------------------------------------------------------- ak = 1.0d0 s = cc(1) do 20 k=2,8 ak = ak*dnu2 tm = cc(k)*ak s = s + tm if (dabs(tm).lt.tol) go to 30 20 continue 30 g1 = -s go to 50 40 continue g1 = (t1-t2)/(dnu+dnu) 50 continue g2 = (t1+t2)*0.5d0 fr = fc*(cchr*g1+smur*g2) fi = fc*(cchi*g1+smui*g2) call zexp(fmur, fmui, str, sti) pr = 0.5d0*str/t2 pi = 0.5d0*sti/t2 call zdiv(0.5d0, 0.0d0, str, sti, ptr, pti) qr = ptr/t1 qi = pti/t1 s1r = fr s1i = fi s2r = pr s2i = pi ak = 1.0d0 a1 = 1.0d0 ckr = coner cki = conei bk = 1.0d0 - dnu2 if (inu.gt.0 .or. n.gt.1) go to 80 c----------------------------------------------------------------------- c generate k(fnu,z), 0.0d0 .le. fnu .lt. 0.5d0 and n=1 c----------------------------------------------------------------------- if (caz.lt.tol) go to 70 call zmlt(zr, zi, zr, zi, czr, czi) czr = 0.25d0*czr czi = 0.25d0*czi t1 = 0.25d0*caz*caz 60 continue fr = (fr*ak+pr+qr)/bk fi = (fi*ak+pi+qi)/bk str = 1.0d0/(ak-dnu) pr = pr*str pi = pi*str str = 1.0d0/(ak+dnu) qr = qr*str qi = qi*str str = ckr*czr - cki*czi rak = 1.0d0/ak cki = (ckr*czi+cki*czr)*rak ckr = str*rak s1r = ckr*fr - cki*fi + s1r s1i = ckr*fi + cki*fr + s1i a1 = a1*t1*rak bk = bk + ak + ak + 1.0d0 ak = ak + 1.0d0 if (a1.gt.tol) go to 60 70 continue yr(1) = s1r yi(1) = s1i if (koded.eq.1) return call zexp(zr, zi, str, sti) call zmlt(s1r, s1i, str, sti, yr(1), yi(1)) return c----------------------------------------------------------------------- c generate k(dnu,z) and k(dnu+1,z) for forward recurrence c----------------------------------------------------------------------- 80 continue if (caz.lt.tol) go to 100 call zmlt(zr, zi, zr, zi, czr, czi) czr = 0.25d0*czr czi = 0.25d0*czi t1 = 0.25d0*caz*caz 90 continue fr = (fr*ak+pr+qr)/bk fi = (fi*ak+pi+qi)/bk str = 1.0d0/(ak-dnu) pr = pr*str pi = pi*str str = 1.0d0/(ak+dnu) qr = qr*str qi = qi*str str = ckr*czr - cki*czi rak = 1.0d0/ak cki = (ckr*czi+cki*czr)*rak ckr = str*rak s1r = ckr*fr - cki*fi + s1r s1i = ckr*fi + cki*fr + s1i str = pr - fr*ak sti = pi - fi*ak s2r = ckr*str - cki*sti + s2r s2i = ckr*sti + cki*str + s2i a1 = a1*t1*rak bk = bk + ak + ak + 1.0d0 ak = ak + 1.0d0 if (a1.gt.tol) go to 90 100 continue kflag = 2 a1 = fnu + 1.0d0 ak = a1*dabs(smur) if (ak.gt.alim) kflag = 3 str = cssr(kflag) p2r = s2r*str p2i = s2i*str call zmlt(p2r, p2i, rzr, rzi, s2r, s2i) s1r = s1r*str s1i = s1i*str if (koded.eq.1) go to 210 call zexp(zr, zi, fr, fi) call zmlt(s1r, s1i, fr, fi, s1r, s1i) call zmlt(s2r, s2i, fr, fi, s2r, s2i) go to 210 c----------------------------------------------------------------------- c iflag=0 means no underflow occurred c iflag=1 means an underflow occurred- computation proceeds with c koded=2 and a test for on scale values is made during forward c recursion c----------------------------------------------------------------------- 110 continue call zsqrt(zr, zi, str, sti) call zdiv(rthpi, czeroi, str, sti, coefr, coefi) kflag = 2 if (koded.eq.2) go to 120 if (zr.gt.alim) go to 290 c blank line str = dexp(-zr)*cssr(kflag) sti = -str*dsin(zi) str = str*dcos(zi) call zmlt(coefr, coefi, str, sti, coefr, coefi) 120 continue if (dabs(dnu).eq.0.5d0) go to 300 c----------------------------------------------------------------------- c miller algorithm for cabs(z).gt.r1 c----------------------------------------------------------------------- ak = dcos(dpi*dnu) ak = dabs(ak) if (ak.eq.czeror) go to 300 fhs = dabs(0.25d0-dnu2) if (fhs.eq.czeror) go to 300 c----------------------------------------------------------------------- c compute r2=f(e). if cabs(z).ge.r2, use forward recurrence to c determine the backward index k. r2=f(e) is a straight line on c 12.le.e.le.60. e is computed from 2**(-e)=b**(1-i1mach(14))= c tol where b is the base of the arithmetic. c----------------------------------------------------------------------- t1 = dble(float(i1mach(14)-1)) t1 = t1*d1mach(5)*3.321928094d0 t1 = dmax1(t1,12.0d0) t1 = dmin1(t1,60.0d0) t2 = tth*t1 - 6.0d0 if (zr.ne.0.0d0) go to 130 t1 = hpi go to 140 130 continue t1 = datan(zi/zr) t1 = dabs(t1) 140 continue if (t2.gt.caz) go to 170 c----------------------------------------------------------------------- c forward recurrence loop when cabs(z).ge.r2 c----------------------------------------------------------------------- etest = ak/(dpi*caz*tol) fk = coner if (etest.lt.coner) go to 180 fks = ctwor ckr = caz + caz + ctwor p1r = czeror p2r = coner do 150 i=1,kmax ak = fhs/fks cbr = ckr/(fk+coner) ptr = p2r p2r = cbr*p2r - p1r*ak p1r = ptr ckr = ckr + ctwor fks = fks + fk + fk + ctwor fhs = fhs + fk + fk fk = fk + coner str = dabs(p2r)*fk if (etest.lt.str) go to 160 150 continue go to 310 160 continue fk = fk + spi*t1*dsqrt(t2/caz) fhs = dabs(0.25d0-dnu2) go to 180 170 continue c----------------------------------------------------------------------- c compute backward index k for cabs(z).lt.r2 c----------------------------------------------------------------------- a2 = dsqrt(caz) ak = fpi*ak/(tol*dsqrt(a2)) aa = 3.0d0*t1/(1.0d0+caz) bb = 14.7d0*t1/(28.0d0+caz) ak = (dlog(ak)+caz*dcos(aa)/(1.0d0+0.008d0*caz))/dcos(bb) fk = 0.12125d0*ak*ak/caz + 1.5d0 180 continue c----------------------------------------------------------------------- c backward recurrence loop for miller algorithm c----------------------------------------------------------------------- k = int(sngl(fk)) fk = dble(float(k)) fks = fk*fk p1r = czeror p1i = czeroi p2r = tol p2i = czeroi csr = p2r csi = p2i do 190 i=1,k a1 = fks - fk ak = (fks+fk)/(a1+fhs) rak = 2.0d0/(fk+coner) cbr = (fk+zr)*rak cbi = zi*rak ptr = p2r pti = p2i p2r = (ptr*cbr-pti*cbi-p1r)*ak p2i = (pti*cbr+ptr*cbi-p1i)*ak p1r = ptr p1i = pti csr = csr + p2r csi = csi + p2i fks = a1 - fk + coner fk = fk - coner 190 continue c----------------------------------------------------------------------- c compute (p2/cs)=(p2/cabs(cs))*(conjg(cs)/cabs(cs)) for better c scaling c----------------------------------------------------------------------- tm = zabs2(csr,csi) ptr = 1.0d0/tm s1r = p2r*ptr s1i = p2i*ptr csr = csr*ptr csi = -csi*ptr call zmlt(coefr, coefi, s1r, s1i, str, sti) call zmlt(str, sti, csr, csi, s1r, s1i) if (inu.gt.0 .or. n.gt.1) go to 200 zdr = zr zdi = zi if(iflag.eq.1) go to 270 go to 240 200 continue c----------------------------------------------------------------------- c compute p1/p2=(p1/cabs(p2)*conjg(p2)/cabs(p2) for scaling c----------------------------------------------------------------------- tm = zabs2(p2r,p2i) ptr = 1.0d0/tm p1r = p1r*ptr p1i = p1i*ptr p2r = p2r*ptr p2i = -p2i*ptr call zmlt(p1r, p1i, p2r, p2i, ptr, pti) str = dnu + 0.5d0 - ptr sti = -pti call zdiv(str, sti, zr, zi, str, sti) str = str + 1.0d0 call zmlt(str, sti, s1r, s1i, s2r, s2i) c----------------------------------------------------------------------- c forward recursion on the three term recursion with relation with c scaling near exponent extremes on kflag=1 or kflag=3 c----------------------------------------------------------------------- 210 continue str = dnu + 1.0d0 ckr = str*rzr cki = str*rzi if (n.eq.1) inu = inu - 1 if (inu.gt.0) go to 220 if (n.gt.1) go to 215 s1r = s2r s1i = s2i 215 continue zdr = zr zdi = zi if(iflag.eq.1) go to 270 go to 240 220 continue inub = 1 if(iflag.eq.1) go to 261 225 continue p1r = csrr(kflag) ascle = bry(kflag) do 230 i=inub,inu str = s2r sti = s2i s2r = ckr*str - cki*sti + s1r s2i = ckr*sti + cki*str + s1i s1r = str s1i = sti ckr = ckr + rzr cki = cki + rzi if (kflag.ge.3) go to 230 p2r = s2r*p1r p2i = s2i*p1r str = dabs(p2r) sti = dabs(p2i) p2m = dmax1(str,sti) if (p2m.le.ascle) go to 230 kflag = kflag + 1 ascle = bry(kflag) s1r = s1r*p1r s1i = s1i*p1r s2r = p2r s2i = p2i str = cssr(kflag) s1r = s1r*str s1i = s1i*str s2r = s2r*str s2i = s2i*str p1r = csrr(kflag) 230 continue if (n.ne.1) go to 240 s1r = s2r s1i = s2i 240 continue str = csrr(kflag) yr(1) = s1r*str yi(1) = s1i*str if (n.eq.1) return yr(2) = s2r*str yi(2) = s2i*str if (n.eq.2) return kk = 2 250 continue kk = kk + 1 if (kk.gt.n) return p1r = csrr(kflag) ascle = bry(kflag) do 260 i=kk,n p2r = s2r p2i = s2i s2r = ckr*p2r - cki*p2i + s1r s2i = cki*p2r + ckr*p2i + s1i s1r = p2r s1i = p2i ckr = ckr + rzr cki = cki + rzi p2r = s2r*p1r p2i = s2i*p1r yr(i) = p2r yi(i) = p2i if (kflag.ge.3) go to 260 str = dabs(p2r) sti = dabs(p2i) p2m = dmax1(str,sti) if (p2m.le.ascle) go to 260 kflag = kflag + 1 ascle = bry(kflag) s1r = s1r*p1r s1i = s1i*p1r s2r = p2r s2i = p2i str = cssr(kflag) s1r = s1r*str s1i = s1i*str s2r = s2r*str s2i = s2i*str p1r = csrr(kflag) 260 continue return c----------------------------------------------------------------------- c iflag=1 cases, forward recurrence on scaled values on underflow c----------------------------------------------------------------------- 261 continue helim = 0.5d0*elim elm = dexp(-elim) celmr = elm ascle = bry(1) zdr = zr zdi = zi ic = -1 j = 2 do 262 i=1,inu str = s2r sti = s2i s2r = str*ckr-sti*cki+s1r s2i = sti*ckr+str*cki+s1i s1r = str s1i = sti ckr = ckr+rzr cki = cki+rzi as = zabs2(s2r,s2i) alas = dlog(as) p2r = -zdr+alas if(p2r.lt.(-elim)) go to 263 call zlog(s2r,s2i,str,sti,idum) p2r = -zdr+str p2i = -zdi+sti p2m = dexp(p2r)/tol p1r = p2m*dcos(p2i) p1i = p2m*dsin(p2i) call zuchk(p1r,p1i,nw,ascle,tol) if(nw.ne.0) go to 263 j = 3 - j cyr(j) = p1r cyi(j) = p1i if(ic.eq.(i-1)) go to 264 ic = i go to 262 263 continue if(alas.lt.helim) go to 262 zdr = zdr-elim s1r = s1r*celmr s1i = s1i*celmr s2r = s2r*celmr s2i = s2i*celmr 262 continue if(n.ne.1) go to 270 s1r = s2r s1i = s2i go to 270 264 continue kflag = 1 inub = i+1 s2r = cyr(j) s2i = cyi(j) j = 3 - j s1r = cyr(j) s1i = cyi(j) if(inub.le.inu) go to 225 if(n.ne.1) go to 240 s1r = s2r s1i = s2i go to 240 270 continue yr(1) = s1r yi(1) = s1i if(n.eq.1) go to 280 yr(2) = s2r yi(2) = s2i 280 continue ascle = bry(1) call zkscl(zdr,zdi,fnu,n,yr,yi,nz,rzr,rzi,ascle,tol,elim) inu = n - nz if (inu.le.0) return kk = nz + 1 s1r = yr(kk) s1i = yi(kk) yr(kk) = s1r*csrr(1) yi(kk) = s1i*csrr(1) if (inu.eq.1) return kk = nz + 2 s2r = yr(kk) s2i = yi(kk) yr(kk) = s2r*csrr(1) yi(kk) = s2i*csrr(1) if (inu.eq.2) return t2 = fnu + dble(float(kk-1)) ckr = t2*rzr cki = t2*rzi kflag = 1 go to 250 290 continue c----------------------------------------------------------------------- c scale by dexp(z), iflag = 1 cases c----------------------------------------------------------------------- koded = 2 iflag = 1 kflag = 2 go to 120 c----------------------------------------------------------------------- c fnu=half odd integer case, dnu=-0.5 c----------------------------------------------------------------------- 300 continue s1r = coefr s1i = coefi s2r = coefr s2i = coefi go to 210 c c 310 continue nz=-2 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zbuni(zr, zi, fnu, kode, n, yr, yi, nz, nui, nlast, * fnul, tol, elim, alim) c Refer to zbesi,zbesk c c zbuni computes the i bessel function for large cabs(z).gt. c fnul and fnu+n-1.lt.fnul. the order is increased from c fnu+n-1 greater than fnul by adding nui and computing c according to the uniform asymptotic expansion for i(fnu,z) c on iform=1 and the expansion for j(fnu,z) on iform=2 c c***routines called zuni1,zuni2,zabs2,d1mach c c complex cscl,cscr,cy,rz,st,s1,s2,y,z double precision alim, ax, ay, csclr, cscrr, cyi, cyr, dfnu, * elim, fnu, fnui, fnul, gnu, raz, rzi, rzr, sti, str, s1i, s1r, * s2i, s2r, tol, yi, yr, zi, zr, zabs2, ascle, bry, c1r, c1i, c1m, * d1mach integer i, iflag, iform, k, kode, n, nl, nlast, nui, nw, nz dimension yr(n), yi(n), cyr(2), cyi(2), bry(3) nz = 0 ax = dabs(zr)*1.7321d0 ay = dabs(zi) iform = 1 if (ay.gt.ax) iform = 2 if (nui.eq.0) go to 60 fnui = dble(float(nui)) dfnu = fnu + dble(float(n-1)) gnu = dfnu + fnui if (iform.eq.2) go to 10 c----------------------------------------------------------------------- c asymptotic expansion for i(fnu,z) for large fnu applied in c -pi/3.le.arg(z).le.pi/3 c----------------------------------------------------------------------- call zuni1(zr, zi, gnu, kode, 2, cyr, cyi, nw, nlast, fnul, tol, * elim, alim) go to 20 10 continue c----------------------------------------------------------------------- c asymptotic expansion for j(fnu,z*exp(m*hpi)) for large fnu c applied in pi/3.lt.abs(arg(z)).le.pi/2 where m=+i or -i c and hpi=pi/2 c----------------------------------------------------------------------- call zuni2(zr, zi, gnu, kode, 2, cyr, cyi, nw, nlast, fnul, tol, * elim, alim) 20 continue if (nw.lt.0) go to 50 if (nw.ne.0) go to 90 str = zabs2(cyr(1),cyi(1)) c---------------------------------------------------------------------- c scale backward recurrence, bry(3) is defined but never used c---------------------------------------------------------------------- bry(1)=1.0d+3*d1mach(1)/tol bry(2) = 1.0d0/bry(1) bry(3) = bry(2) iflag = 2 ascle = bry(2) csclr = 1.0d0 if (str.gt.bry(1)) go to 21 iflag = 1 ascle = bry(1) csclr = 1.0d0/tol go to 25 21 continue if (str.lt.bry(2)) go to 25 iflag = 3 ascle=bry(3) csclr = tol 25 continue cscrr = 1.0d0/csclr s1r = cyr(2)*csclr s1i = cyi(2)*csclr s2r = cyr(1)*csclr s2i = cyi(1)*csclr raz = 1.0d0/zabs2(zr,zi) str = zr*raz sti = -zi*raz rzr = (str+str)*raz rzi = (sti+sti)*raz do 30 i=1,nui str = s2r sti = s2i s2r = (dfnu+fnui)*(rzr*str-rzi*sti) + s1r s2i = (dfnu+fnui)*(rzr*sti+rzi*str) + s1i s1r = str s1i = sti fnui = fnui - 1.0d0 if (iflag.ge.3) go to 30 str = s2r*cscrr sti = s2i*cscrr c1r = dabs(str) c1i = dabs(sti) c1m = dmax1(c1r,c1i) if (c1m.le.ascle) go to 30 iflag = iflag+1 ascle = bry(iflag) s1r = s1r*cscrr s1i = s1i*cscrr s2r = str s2i = sti csclr = csclr*tol cscrr = 1.0d0/csclr s1r = s1r*csclr s1i = s1i*csclr s2r = s2r*csclr s2i = s2i*csclr 30 continue yr(n) = s2r*cscrr yi(n) = s2i*cscrr if (n.eq.1) return nl = n - 1 fnui = dble(float(nl)) k = nl do 40 i=1,nl str = s2r sti = s2i s2r = (fnu+fnui)*(rzr*str-rzi*sti) + s1r s2i = (fnu+fnui)*(rzr*sti+rzi*str) + s1i s1r = str s1i = sti str = s2r*cscrr sti = s2i*cscrr yr(k) = str yi(k) = sti fnui = fnui - 1.0d0 k = k - 1 if (iflag.ge.3) go to 40 c1r = dabs(str) c1i = dabs(sti) c1m = dmax1(c1r,c1i) if (c1m.le.ascle) go to 40 iflag = iflag+1 ascle = bry(iflag) s1r = s1r*cscrr s1i = s1i*cscrr s2r = str s2i = sti csclr = csclr*tol cscrr = 1.0d0/csclr s1r = s1r*csclr s1i = s1i*csclr s2r = s2r*csclr s2i = s2i*csclr 40 continue return 50 continue nz = -1 if(nw.eq.(-2)) nz=-2 return 60 continue if (iform.eq.2) go to 70 c----------------------------------------------------------------------- c asymptotic expansion for i(fnu,z) for large fnu applied in c -pi/3.le.arg(z).le.pi/3 c----------------------------------------------------------------------- call zuni1(zr, zi, fnu, kode, n, yr, yi, nw, nlast, fnul, tol, * elim, alim) go to 80 70 continue c----------------------------------------------------------------------- c asymptotic expansion for j(fnu,z*exp(m*hpi)) for large fnu c applied in pi/3.lt.abs(arg(z)).le.pi/2 where m=+i or -i c and hpi=pi/2 c----------------------------------------------------------------------- call zuni2(zr, zi, fnu, kode, n, yr, yi, nw, nlast, fnul, tol, * elim, alim) 80 continue if (nw.lt.0) go to 50 nz = nw return 90 continue nlast = n return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zbunk(zr, zi, fnu, kode, mr, n, yr, yi, nz, tol, elim, * alim) c Refer to zbesk,zbesh c c zbunk computes the k bessel function for fnu.gt.fnul. c according to the uniform asymptotic expansion for k(fnu,z) c in zunk1 and the expansion for h(2,fnu,z) in zunk2 c c***routines called zunk1,zunk2 c c complex y,z double precision alim, ax, ay, elim, fnu, tol, yi, yr, zi, zr integer kode, mr, n, nz dimension yr(n), yi(n) nz = 0 ax = dabs(zr)*1.7321d0 ay = dabs(zi) if (ay.gt.ax) go to 10 c----------------------------------------------------------------------- c asymptotic expansion for k(fnu,z) for large fnu applied in c -pi/3.le.arg(z).le.pi/3 c----------------------------------------------------------------------- call zunk1(zr, zi, fnu, kode, mr, n, yr, yi, nz, tol, elim, alim) go to 20 10 continue c----------------------------------------------------------------------- c asymptotic expansion for h(2,fnu,z*exp(m*hpi)) for large fnu c applied in pi/3.lt.abs(arg(z)).le.pi/2 where m=+i or -i c and hpi=pi/2 c----------------------------------------------------------------------- call zunk2(zr, zi, fnu, kode, mr, n, yr, yi, nz, tol, elim, alim) 20 continue return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zmlri(zr, zi, fnu, kode, n, yr, yi, nz, tol) c geuz for g77 EXTERNAL zexp EXTERNAL zlog c Refer to zbesi,zbesk c c zmlri computes the i bessel function for re(z).ge.0.0 by the c miller algorithm normalized by a neumann series. c c***routines called dgamln,d1mach,zabs2,zexp,zlog,zmlt c c complex ck,cnorm,cone,ctwo,czero,pt,p1,p2,rz,sum,y,z double precision ack, ak, ap, at, az, bk, cki, ckr, cnormi, * cnormr, conei, coner, fkap, fkk, flam, fnf, fnu, pti, ptr, p1i, * p1r, p2i, p2r, raz, rho, rho2, rzi, rzr, scle, sti, str, sumi, * sumr, tfnf, tol, tst, yi, yr, zeroi, zeror, zi, zr, dgamln, * d1mach, zabs2 integer i, iaz, idum, ifnu, inu, itime, k, kk, km, kode, m, n, nz dimension yr(n), yi(n) data zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 / scle = d1mach(1)/tol nz=0 az = zabs2(zr,zi) iaz = int(sngl(az)) ifnu = int(sngl(fnu)) inu = ifnu + n - 1 at = dble(float(iaz)) + 1.0d0 raz = 1.0d0/az str = zr*raz sti = -zi*raz ckr = str*at*raz cki = sti*at*raz rzr = (str+str)*raz rzi = (sti+sti)*raz p1r = zeror p1i = zeroi p2r = coner p2i = conei ack = (at+1.0d0)*raz rho = ack + dsqrt(ack*ack-1.0d0) rho2 = rho*rho tst = (rho2+rho2)/((rho2-1.0d0)*(rho-1.0d0)) tst = tst/tol c----------------------------------------------------------------------- c compute relative truncation error index for series c----------------------------------------------------------------------- ak = at do 10 i=1,80 ptr = p2r pti = p2i p2r = p1r - (ckr*ptr-cki*pti) p2i = p1i - (cki*ptr+ckr*pti) p1r = ptr p1i = pti ckr = ckr + rzr cki = cki + rzi ap = zabs2(p2r,p2i) if (ap.gt.tst*ak*ak) go to 20 ak = ak + 1.0d0 10 continue go to 110 20 continue i = i + 1 k = 0 if (inu.lt.iaz) go to 40 c----------------------------------------------------------------------- c compute relative truncation error for ratios c----------------------------------------------------------------------- p1r = zeror p1i = zeroi p2r = coner p2i = conei at = dble(float(inu)) + 1.0d0 str = zr*raz sti = -zi*raz ckr = str*at*raz cki = sti*at*raz ack = at*raz tst = dsqrt(ack/tol) itime = 1 do 30 k=1,80 ptr = p2r pti = p2i p2r = p1r - (ckr*ptr-cki*pti) p2i = p1i - (ckr*pti+cki*ptr) p1r = ptr p1i = pti ckr = ckr + rzr cki = cki + rzi ap = zabs2(p2r,p2i) if (ap.lt.tst) go to 30 if (itime.eq.2) go to 40 ack = zabs2(ckr,cki) flam = ack + dsqrt(ack*ack-1.0d0) fkap = ap/zabs2(p1r,p1i) rho = dmin1(flam,fkap) tst = tst*dsqrt(rho/(rho*rho-1.0d0)) itime = 2 30 continue go to 110 40 continue c----------------------------------------------------------------------- c backward recurrence and sum normalizing relation c----------------------------------------------------------------------- k = k + 1 kk = max0(i+iaz,k+inu) fkk = dble(float(kk)) p1r = zeror p1i = zeroi c----------------------------------------------------------------------- c scale p2 and sum by scle c----------------------------------------------------------------------- p2r = scle p2i = zeroi fnf = fnu - dble(float(ifnu)) tfnf = fnf + fnf bk = dgamln(fkk+tfnf+1.0d0,idum) - dgamln(fkk+1.0d0,idum) - * dgamln(tfnf+1.0d0,idum) bk = dexp(bk) sumr = zeror sumi = zeroi km = kk - inu do 50 i=1,km ptr = p2r pti = p2i p2r = p1r + (fkk+fnf)*(rzr*ptr-rzi*pti) p2i = p1i + (fkk+fnf)*(rzi*ptr+rzr*pti) p1r = ptr p1i = pti ak = 1.0d0 - tfnf/(fkk+tfnf) ack = bk*ak sumr = sumr + (ack+bk)*p1r sumi = sumi + (ack+bk)*p1i bk = ack fkk = fkk - 1.0d0 50 continue yr(n) = p2r yi(n) = p2i if (n.eq.1) go to 70 do 60 i=2,n ptr = p2r pti = p2i p2r = p1r + (fkk+fnf)*(rzr*ptr-rzi*pti) p2i = p1i + (fkk+fnf)*(rzi*ptr+rzr*pti) p1r = ptr p1i = pti ak = 1.0d0 - tfnf/(fkk+tfnf) ack = bk*ak sumr = sumr + (ack+bk)*p1r sumi = sumi + (ack+bk)*p1i bk = ack fkk = fkk - 1.0d0 m = n - i + 1 yr(m) = p2r yi(m) = p2i 60 continue 70 continue if (ifnu.le.0) go to 90 do 80 i=1,ifnu ptr = p2r pti = p2i p2r = p1r + (fkk+fnf)*(rzr*ptr-rzi*pti) p2i = p1i + (fkk+fnf)*(rzr*pti+rzi*ptr) p1r = ptr p1i = pti ak = 1.0d0 - tfnf/(fkk+tfnf) ack = bk*ak sumr = sumr + (ack+bk)*p1r sumi = sumi + (ack+bk)*p1i bk = ack fkk = fkk - 1.0d0 80 continue 90 continue ptr = zr pti = zi if (kode.eq.2) ptr = zeror call zlog(rzr, rzi, str, sti, idum) p1r = -fnf*str + ptr p1i = -fnf*sti + pti ap = dgamln(1.0d0+fnf,idum) ptr = p1r - ap pti = p1i c----------------------------------------------------------------------- c the division cexp(pt)/(sum+p2) is altered to avoid overflow c in the denominator by squaring large quantities c----------------------------------------------------------------------- p2r = p2r + sumr p2i = p2i + sumi ap = zabs2(p2r,p2i) p1r = 1.0d0/ap call zexp(ptr, pti, str, sti) ckr = str*p1r cki = sti*p1r ptr = p2r*p1r pti = -p2i*p1r call zmlt(ckr, cki, ptr, pti, cnormr, cnormi) do 100 i=1,n str = yr(i)*cnormr - yi(i)*cnormi yi(i) = yr(i)*cnormi + yi(i)*cnormr yr(i) = str 100 continue return 110 continue nz=-2 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zseri(zr, zi, fnu, kode, n, yr, yi, nz, tol, elim, * alim) c geuz for g77 EXTERNAL zlog c Refer to zbesi,zbesk c c zseri computes the i bessel function for real(z).ge.0.0 by c means of the power series for large cabs(z) in the c region cabs(z).le.2*sqrt(fnu+1). nz=0 is a normal return. c nz.gt.0 means that the last nz components were set to zero c due to underflow. nz.lt.0 means underflow occurred, but the c condition cabs(z).le.2*sqrt(fnu+1) was violated and the c computation must be completed in another routine with n=n-abs(nz). c c***routines called dgamln,d1mach,zuchk,zabs2,zdiv,zlog,zmlt c c complex ak1,ck,coef,cone,crsc,cscl,cz,czero,hz,rz,s1,s2,y,z double precision aa, acz, ak, ak1i, ak1r, alim, arm, ascle, atol, * az, cki, ckr, coefi, coefr, conei, coner, crscr, czi, czr, dfnu, * elim, fnu, fnup, hzi, hzr, raz, rs, rtr1, rzi, rzr, s, ss, sti, * str, s1i, s1r, s2i, s2r, tol, yi, yr, wi, wr, zeroi, zeror, zi, * zr, dgamln, d1mach, zabs2 integer i, ib, idum, iflag, il, k, kode, l, m, n, nn, nz, nw dimension yr(n), yi(n), wr(2), wi(2) data zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 / c nz = 0 az = zabs2(zr,zi) if (az.eq.0.0d0) go to 160 arm = 1.0d+3*d1mach(1) rtr1 = dsqrt(arm) crscr = 1.0d0 iflag = 0 if (az.lt.arm) go to 150 hzr = 0.5d0*zr hzi = 0.5d0*zi czr = zeror czi = zeroi if (az.le.rtr1) go to 10 call zmlt(hzr, hzi, hzr, hzi, czr, czi) 10 continue acz = zabs2(czr,czi) nn = n call zlog(hzr, hzi, ckr, cki, idum) 20 continue dfnu = fnu + dble(float(nn-1)) fnup = dfnu + 1.0d0 c----------------------------------------------------------------------- c underflow test c----------------------------------------------------------------------- ak1r = ckr*dfnu ak1i = cki*dfnu ak = dgamln(fnup,idum) ak1r = ak1r - ak if (kode.eq.2) ak1r = ak1r - zr if (ak1r.gt.(-elim)) go to 40 30 continue nz = nz + 1 yr(nn) = zeror yi(nn) = zeroi if (acz.gt.dfnu) go to 190 nn = nn - 1 if (nn.eq.0) return go to 20 40 continue if (ak1r.gt.(-alim)) go to 50 iflag = 1 ss = 1.0d0/tol crscr = tol ascle = arm*ss 50 continue aa = dexp(ak1r) if (iflag.eq.1) aa = aa*ss coefr = aa*dcos(ak1i) coefi = aa*dsin(ak1i) atol = tol*acz/fnup il = min0(2,nn) do 90 i=1,il dfnu = fnu + dble(float(nn-i)) fnup = dfnu + 1.0d0 s1r = coner s1i = conei if (acz.lt.tol*fnup) go to 70 ak1r = coner ak1i = conei ak = fnup + 2.0d0 s = fnup aa = 2.0d0 60 continue rs = 1.0d0/s str = ak1r*czr - ak1i*czi sti = ak1r*czi + ak1i*czr ak1r = str*rs ak1i = sti*rs s1r = s1r + ak1r s1i = s1i + ak1i s = s + ak ak = ak + 2.0d0 aa = aa*acz*rs if (aa.gt.atol) go to 60 70 continue s2r = s1r*coefr - s1i*coefi s2i = s1r*coefi + s1i*coefr wr(i) = s2r wi(i) = s2i if (iflag.eq.0) go to 80 call zuchk(s2r, s2i, nw, ascle, tol) if (nw.ne.0) go to 30 80 continue m = nn - i + 1 yr(m) = s2r*crscr yi(m) = s2i*crscr if (i.eq.il) go to 90 call zdiv(coefr, coefi, hzr, hzi, str, sti) coefr = str*dfnu coefi = sti*dfnu 90 continue if (nn.le.2) return k = nn - 2 ak = dble(float(k)) raz = 1.0d0/az str = zr*raz sti = -zi*raz rzr = (str+str)*raz rzi = (sti+sti)*raz if (iflag.eq.1) go to 120 ib = 3 100 continue do 110 i=ib,nn yr(k) = (ak+fnu)*(rzr*yr(k+1)-rzi*yi(k+1)) + yr(k+2) yi(k) = (ak+fnu)*(rzr*yi(k+1)+rzi*yr(k+1)) + yi(k+2) ak = ak - 1.0d0 k = k - 1 110 continue return c----------------------------------------------------------------------- c recur backward with scaled values c----------------------------------------------------------------------- 120 continue c----------------------------------------------------------------------- c exp(-alim)=exp(-elim)/tol=approx. one precision above the c underflow limit = ascle = d1mach(1)*ss*1.0d+3 c----------------------------------------------------------------------- s1r = wr(1) s1i = wi(1) s2r = wr(2) s2i = wi(2) do 130 l=3,nn ckr = s2r cki = s2i s2r = s1r + (ak+fnu)*(rzr*ckr-rzi*cki) s2i = s1i + (ak+fnu)*(rzr*cki+rzi*ckr) s1r = ckr s1i = cki ckr = s2r*crscr cki = s2i*crscr yr(k) = ckr yi(k) = cki ak = ak - 1.0d0 k = k - 1 if (zabs2(ckr,cki).gt.ascle) go to 140 130 continue return 140 continue ib = l + 1 if (ib.gt.nn) return go to 100 150 continue nz = n if (fnu.eq.0.0d0) nz = nz - 1 160 continue yr(1) = zeror yi(1) = zeroi if (fnu.ne.0.0d0) go to 170 yr(1) = coner yi(1) = conei 170 continue if (n.eq.1) return do 180 i=2,n yr(i) = zeror yi(i) = zeroi 180 continue return c----------------------------------------------------------------------- c return with nz.lt.0 if cabs(z*z/4).gt.fnu+n-nz-1 complete c the calculation in cbinu with n=n-iabs(nz) c----------------------------------------------------------------------- 190 continue nz = -nz return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zwrsk(zrr, zri, fnu, kode, n, yr, yi, nz, cwr, cwi, * tol, elim, alim) c refer to zbesi,zbesk c c zwrsk computes the i bessel function for re(z).ge.0.0 by c normalizing the i function ratios from zrati by the wronskian c c***routines called d1mach,zbknu,zrati,zabs2 c complex cinu,cscl,ct,cw,c1,c2,rct,st,y,zr double precision act, acw, alim, ascle, cinui, cinur, csclr, cti, * ctr, cwi, cwr, c1i, c1r, c2i, c2r, elim, fnu, pti, ptr, ract, * sti, str, tol, yi, yr, zri, zrr, zabs2, d1mach integer i, kode, n, nw, nz dimension yr(n), yi(n), cwr(2), cwi(2) c----------------------------------------------------------------------- c i(fnu+i-1,z) by backward recurrence for ratios c y(i)=i(fnu+i,z)/i(fnu+i-1,z) from crati normalized by the c wronskian with k(fnu,z) and k(fnu+1,z) from cbknu. c----------------------------------------------------------------------- nz = 0 call zbknu(zrr, zri, fnu, kode, 2, cwr, cwi, nw, tol, elim, alim) if (nw.ne.0) go to 50 call zrati(zrr, zri, fnu, n, yr, yi, tol) c----------------------------------------------------------------------- c recur forward on i(fnu+1,z) = r(fnu,z)*i(fnu,z), c r(fnu+j-1,z)=y(j), j=1,...,n c----------------------------------------------------------------------- cinur = 1.0d0 cinui = 0.0d0 if (kode.eq.1) go to 10 cinur = dcos(zri) cinui = dsin(zri) 10 continue c----------------------------------------------------------------------- c on low exponent machines the k functions can be close to both c the under and overflow limits and the normalization must be c scaled to prevent over or underflow. cuoik has determined that c the result is on scale. c----------------------------------------------------------------------- acw = zabs2(cwr(2),cwi(2)) ascle = 1.0d+3*d1mach(1)/tol csclr = 1.0d0 if (acw.gt.ascle) go to 20 csclr = 1.0d0/tol go to 30 20 continue ascle = 1.0d0/ascle if (acw.lt.ascle) go to 30 csclr = tol 30 continue c1r = cwr(1)*csclr c1i = cwi(1)*csclr c2r = cwr(2)*csclr c2i = cwi(2)*csclr str = yr(1) sti = yi(1) c----------------------------------------------------------------------- c cinu=cinu*(conjg(ct)/cabs(ct))*(1.0d0/cabs(ct) prevents c under- or overflow prematurely by squaring cabs(ct) c----------------------------------------------------------------------- ptr = str*c1r - sti*c1i pti = str*c1i + sti*c1r ptr = ptr + c2r pti = pti + c2i ctr = zrr*ptr - zri*pti cti = zrr*pti + zri*ptr act = zabs2(ctr,cti) ract = 1.0d0/act ctr = ctr*ract cti = -cti*ract ptr = cinur*ract pti = cinui*ract cinur = ptr*ctr - pti*cti cinui = ptr*cti + pti*ctr yr(1) = cinur*csclr yi(1) = cinui*csclr if (n.eq.1) return do 40 i=2,n ptr = str*cinur - sti*cinui cinui = str*cinui + sti*cinur cinur = ptr str = yr(i) sti = yi(i) yr(i) = cinur*csclr yi(i) = cinui*csclr 40 continue return 50 continue nz = -1 if(nw.eq.(-2)) nz=-2 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zairy(zr, zi, id, kode, air, aii, nz, ierr) c geuz for g77 EXTERNAL zsqrt EXTERNAL zexp c Airy function,bessel functions of order one third c Author Amos, Donald E., Sandia National Laboratories c c on kode=1, zairy computes the complex airy function ai(z) or c its derivative dai(z)/dz on id=0 or id=1 respectively. on c kode=2, a scaling option cexp(zta)*ai(z) or cexp(zta)* c dai(z)/dz is provided to remove the exponential decay in c -pi/3.lt.arg(z).lt.pi/3 and the exponential growth in c pi/3.lt.abs(arg(z)).lt.pi where zta=(2/3)*z*csqrt(z). c c while the airy functions ai(z) and dai(z)/dz are analytic in c the whole z plane, the corresponding scaled functions defined c for kode=2 have a cut along the negative real axis. c c input zr,zi are double precision c zr,zi - z=cmplx(zr,zi) c id - order of derivative, id=0 or id=1 c kode - a parameter to indicate the scaling option c kode= 1 returns c ai=ai(z) on id=0 or c ai=dai(z)/dz on id=1 c = 2 returns c ai=cexp(zta)*ai(z) on id=0 or c ai=cexp(zta)*dai(z)/dz on id=1 where c zta=(2/3)*z*csqrt(z) c c output air,aii are double precision c air,aii- complex answer depending on the choices for id and c kode c nz - underflow indicator c nz= 0 , normal return c nz= 1 , ai=cmplx(0.0d0,0.0d0) due to underflow in c -pi/3.lt.arg(z).lt.pi/3 on kode=1 c ierr - error flag c ierr=0, normal return - computation completed c ierr=1, input error - no computation c ierr=2, overflow - no computation, real(zta) c too large on kode=1 c ierr=3, cabs(z) large - computation completed c losses of signifcance by argument reduction c produce less than half of machine accuracy c ierr=4, cabs(z) too large - no computation c complete loss of accuracy by argument c reduction c ierr=5, error - no computation, c algorithm termination condition not met c c c ai and dai are computed for cabs(z).gt.1.0 from the k bessel c functions by c c ai(z)=c*sqrt(z)*k(1/3,zta) , dai(z)=-c*z*k(2/3,zta) c c=1.0/(pi*sqrt(3.0)) c zta=(2/3)*z**(3/2) c c with the power series for cabs(z).le.1.0. c c in most complex variable computation, one must evaluate ele- c mentary functions. when the magnitude of z is large, losses c of significance by argument reduction occur. consequently, if c the magnitude of zeta=(2/3)*z**1.5 exceeds u1=sqrt(0.5/ur), c then losses exceeding half precision are likely and an error c flag ierr=3 is triggered where ur=dmax1(d1mach(4),1.0d-18) is c double precision unit roundoff limited to 18 digits precision. c also, if the magnitude of zeta is larger than u2=0.5/ur, then c all significance is lost and ierr=4. in order to use the int c function, zeta must be further restricted not to exceed the c largest integer, u3=i1mach(9). thus, the magnitude of zeta c must be restricted by min(u2,u3). on 32 bit machines, u1,u2, c and u3 are approximately 2.0e+3, 4.2e+6, 2.1e+9 in single c precision arithmetic and 1.3e+8, 1.8e+16, 2.1e+9 in double c precision arithmetic respectively. this makes u2 and u3 limit- c ing in their respective arithmetics. this means that the mag- c nitude of z cannot exceed 3.1e+4 in single and 2.1e+6 in c double precision arithmetic. this also means that one can c expect to retain, in the worst cases on 32 bit machines, c no digits in single precision and only 7 digits in double c precision arithmetic. similar considerations hold for other c machines. c c the approximate relative error in the magnitude of a complex c bessel function can be expressed by p*10**s where p=max(unit c roundoff,1.0e-18) is the nominal precision and 10**s repre- c sents the increase in error due to argument reduction in the c elementary functions. here, s=max(1,abs(log10(cabs(z))), c abs(log10(fnu))) approximately (i.e. s=max(1,abs(exponent of c cabs(z),abs(exponent of fnu)) ). however, the phase angle may c have only absolute accuracy. this is most likely to occur when c one component (in absolute value) is larger than the other by c several orders of magnitude. if one component is 10**k larger c than the other, then one can expect only max(abs(log10(p))-k, c 0) significant digits; or, stated another way, when k exceeds c the exponent of p, no significant digits remain in the smaller c component. however, the phase angle retains absolute accuracy c because, in complex arithmetic with precision p, the smaller c component will not (as a rule) decrease below p times the c magnitude of the larger component. in these extreme cases, c the principal phase angle is on the order of +p, -p, pi/2-p, c or -pi/2+p. c c***routines called zacai,zbknu,zexp,zsqrt,i1mach,d1mach c c complex ai,cone,csq,cy,s1,s2,trm1,trm2,z,zta,z3 double precision aa, ad, aii, air, ak, alim, atrm, az, az3, bk, * cc, ck, coef, conei, coner, csqi, csqr, cyi, cyr, c1, c2, dig, * dk, d1, d2, elim, fid, fnu, ptr, rl, r1m5, sfac, sti, str, * s1i, s1r, s2i, s2r, tol, trm1i, trm1r, trm2i, trm2r, tth, zeroi, * zeror, zi, zr, ztai, ztar, z3i, z3r, d1mach, zabs2, alaz, bb integer id, ierr, iflag, k, kode, k1, k2, mr, nn, nz, i1mach dimension cyr(1), cyi(1) data tth, c1, c2, coef /6.66666666666666667d-01, * 3.55028053887817240d-01,2.58819403792806799d-01, * 1.83776298473930683d-01/ data zeror, zeroi, coner, conei /0.0d0,0.0d0,1.0d0,0.0d0/ c***first executable statement zairy ierr = 0 nz=0 if (id.lt.0 .or. id.gt.1) ierr=1 if (kode.lt.1 .or. kode.gt.2) ierr=1 if (ierr.ne.0) return az = zabs2(zr,zi) tol = dmax1(d1mach(4),1.0d-18) fid = dble(float(id)) if (az.gt.1.0d0) go to 70 c----------------------------------------------------------------------- c power series for cabs(z).le.1. c----------------------------------------------------------------------- s1r = coner s1i = conei s2r = coner s2i = conei if (az.lt.tol) go to 170 aa = az*az if (aa.lt.tol/az) go to 40 trm1r = coner trm1i = conei trm2r = coner trm2i = conei atrm = 1.0d0 str = zr*zr - zi*zi sti = zr*zi + zi*zr z3r = str*zr - sti*zi z3i = str*zi + sti*zr az3 = az*aa ak = 2.0d0 + fid bk = 3.0d0 - fid - fid ck = 4.0d0 - fid dk = 3.0d0 + fid + fid d1 = ak*dk d2 = bk*ck ad = dmin1(d1,d2) ak = 24.0d0 + 9.0d0*fid bk = 30.0d0 - 9.0d0*fid do 30 k=1,25 str = (trm1r*z3r-trm1i*z3i)/d1 trm1i = (trm1r*z3i+trm1i*z3r)/d1 trm1r = str s1r = s1r + trm1r s1i = s1i + trm1i str = (trm2r*z3r-trm2i*z3i)/d2 trm2i = (trm2r*z3i+trm2i*z3r)/d2 trm2r = str s2r = s2r + trm2r s2i = s2i + trm2i atrm = atrm*az3/ad d1 = d1 + ak d2 = d2 + bk ad = dmin1(d1,d2) if (atrm.lt.tol*ad) go to 40 ak = ak + 18.0d0 bk = bk + 18.0d0 30 continue 40 continue if (id.eq.1) go to 50 air = s1r*c1 - c2*(zr*s2r-zi*s2i) aii = s1i*c1 - c2*(zr*s2i+zi*s2r) if (kode.eq.1) return call zsqrt(zr, zi, str, sti) ztar = tth*(zr*str-zi*sti) ztai = tth*(zr*sti+zi*str) call zexp(ztar, ztai, str, sti) ptr = air*str - aii*sti aii = air*sti + aii*str air = ptr return 50 continue air = -s2r*c2 aii = -s2i*c2 if (az.le.tol) go to 60 str = zr*s1r - zi*s1i sti = zr*s1i + zi*s1r cc = c1/(1.0d0+fid) air = air + cc*(str*zr-sti*zi) aii = aii + cc*(str*zi+sti*zr) 60 continue if (kode.eq.1) return call zsqrt(zr, zi, str, sti) ztar = tth*(zr*str-zi*sti) ztai = tth*(zr*sti+zi*str) call zexp(ztar, ztai, str, sti) ptr = str*air - sti*aii aii = str*aii + sti*air air = ptr return c----------------------------------------------------------------------- c case for cabs(z).gt.1.0 c----------------------------------------------------------------------- 70 continue fnu = (1.0d0+fid)/3.0d0 c----------------------------------------------------------------------- c set parameters related to machine constants. c tol is the approximate unit roundoff limited to 1.0d-18. c elim is the approximate exponential over- and underflow limit. c exp(-elim).lt.exp(-alim)=exp(-elim)/tol and c exp(elim).gt.exp(alim)=exp(elim)*tol are intervals near c underflow and overflow limits where scaled arithmetic is done. c rl is the lower boundary of the asymptotic expansion for large z. c dig = number of base 10 digits in tol = 10**(-dig). c----------------------------------------------------------------------- k1 = i1mach(15) k2 = i1mach(16) r1m5 = d1mach(5) k = min0(iabs(k1),iabs(k2)) elim = 2.303d0*(dble(float(k))*r1m5-3.0d0) k1 = i1mach(14) - 1 aa = r1m5*dble(float(k1)) dig = dmin1(aa,18.0d0) aa = aa*2.303d0 alim = elim + dmax1(-aa,-41.45d0) rl = 1.2d0*dig + 3.0d0 alaz = dlog(az) c-------------------------------------------------------------------------- c test for proper range c----------------------------------------------------------------------- aa=0.5d0/tol bb=dble(float(i1mach(9)))*0.5d0 aa=dmin1(aa,bb) aa=aa**tth if (az.gt.aa) go to 260 aa=dsqrt(aa) if (az.gt.aa) ierr=3 call zsqrt(zr, zi, csqr, csqi) ztar = tth*(zr*csqr-zi*csqi) ztai = tth*(zr*csqi+zi*csqr) c----------------------------------------------------------------------- c re(zta).le.0 when re(z).lt.0, especially when im(z) is small c----------------------------------------------------------------------- iflag = 0 sfac = 1.0d0 ak = ztai if (zr.ge.0.0d0) go to 80 bk = ztar ck = -dabs(bk) ztar = ck ztai = ak 80 continue if (zi.ne.0.0d0) go to 90 if (zr.gt.0.0d0) go to 90 ztar = 0.0d0 ztai = ak 90 continue aa = ztar if (aa.ge.0.0d0 .and. zr.gt.0.0d0) go to 110 if (kode.eq.2) go to 100 c----------------------------------------------------------------------- c overflow test c----------------------------------------------------------------------- if (aa.gt.(-alim)) go to 100 aa = -aa + 0.25d0*alaz iflag = 1 sfac = tol if (aa.gt.elim) go to 270 100 continue c----------------------------------------------------------------------- c cbknu and cacon return exp(zta)*k(fnu,zta) on kode=2 c----------------------------------------------------------------------- mr = 1 if (zi.lt.0.0d0) mr = -1 call zacai(ztar, ztai, fnu, kode, mr, 1, cyr, cyi, nn, rl, tol, * elim, alim) if (nn.lt.0) go to 280 nz = nz + nn go to 130 110 continue if (kode.eq.2) go to 120 c----------------------------------------------------------------------- c underflow test c----------------------------------------------------------------------- if (aa.lt.alim) go to 120 aa = -aa - 0.25d0*alaz iflag = 2 sfac = 1.0d0/tol if (aa.lt.(-elim)) go to 210 120 continue call zbknu(ztar, ztai, fnu, kode, 1, cyr, cyi, nz, tol, elim, * alim) 130 continue s1r = cyr(1)*coef s1i = cyi(1)*coef if (iflag.ne.0) go to 150 if (id.eq.1) go to 140 air = csqr*s1r - csqi*s1i aii = csqr*s1i + csqi*s1r return 140 continue air = -(zr*s1r-zi*s1i) aii = -(zr*s1i+zi*s1r) return 150 continue s1r = s1r*sfac s1i = s1i*sfac if (id.eq.1) go to 160 str = s1r*csqr - s1i*csqi s1i = s1r*csqi + s1i*csqr s1r = str air = s1r/sfac aii = s1i/sfac return 160 continue str = -(s1r*zr-s1i*zi) s1i = -(s1r*zi+s1i*zr) s1r = str air = s1r/sfac aii = s1i/sfac return 170 continue aa = 1.0d+3*d1mach(1) s1r = zeror s1i = zeroi if (id.eq.1) go to 190 if (az.le.aa) go to 180 s1r = c2*zr s1i = c2*zi 180 continue air = c1 - s1r aii = -s1i return 190 continue air = -c2 aii = 0.0d0 aa = dsqrt(aa) if (az.le.aa) go to 200 s1r = 0.5d0*(zr*zr-zi*zi) s1i = zr*zi 200 continue air = air + c1*s1r aii = aii + c1*s1i return 210 continue nz = 1 air = zeror aii = zeroi return 270 continue nz = 0 ierr=2 return 280 continue if(nn.eq.(-1)) go to 270 nz=0 ierr=5 return 260 continue ierr=4 nz=0 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- subroutine zbiry(zr, zi, id, kode, bir, bii, ierr) c geuz for g77 EXTERNAL zsqrt c Airy function,bessel functions of order one third c Author Amos, Donald E., Sandia National Laboratories c c on kode=1, cbiry computes the complex airy function bi(z) or c its derivative dbi(z)/dz on id=0 or id=1 respectively. on c kode=2, a scaling option cexp(-axzta)*bi(z) or cexp(-axzta)* c dbi(z)/dz is provided to remove the exponential behavior in c both the left and right half planes where c zta=(2/3)*z*csqrt(z)=cmplx(xzta,yzta) and axzta=abs(xzta). c c input zr,zi are double precision c zr,zi - z=cmplx(zr,zi) c id - order of derivative, id=0 or id=1 c kode - a parameter to indicate the scaling option c kode= 1 returns c bi=bi(z) on id=0 or c bi=dbi(z)/dz on id=1 c = 2 returns c bi=cexp(-axzta)*bi(z) on id=0 or c bi=cexp(-axzta)*dbi(z)/dz on id=1 where c zta=(2/3)*z*csqrt(z)=cmplx(xzta,yzta) c and axzta=abs(xzta) c c output bir,bii are double precision c bir,bii- complex answer depending on the choices for id and c kode c ierr - error flag c ierr=0, normal return - computation completed c ierr=1, input error - no computation c ierr=2, overflow - no computation, real(z) c too large on kode=1 c ierr=3, cabs(z) large - computation completed c losses of signifcance by argument reduction c produce less than half of machine accuracy c ierr=4, cabs(z) too large - no computation c complete loss of accuracy by argument c reduction c ierr=5, error - no computation, c algorithm termination condition not met c c bi and dbi are computed for cabs(z).gt.1.0 from the i bessel c functions by c c bi(z)=c*sqrt(z)*( i(-1/3,zta) + i(1/3,zta) ) c dbi(z)=c * z * ( i(-2/3,zta) + i(2/3,zta) ) c c=1.0/sqrt(3.0) c zta=(2/3)*z**(3/2) c c with the power series for cabs(z).le.1.0. c c in most complex variable computation, one must evaluate ele- c mentary functions. when the magnitude of z is large, losses c of significance by argument reduction occur. consequently, if c the magnitude of zeta=(2/3)*z**1.5 exceeds u1=sqrt(0.5/ur), c then losses exceeding half precision are likely and an error c flag ierr=3 is triggered where ur=dmax1(d1mach(4),1.0d-18) is c double precision unit roundoff limited to 18 digits precision. c also, if the magnitude of zeta is larger than u2=0.5/ur, then c all significance is lost and ierr=4. in order to use the int c function, zeta must be further restricted not to exceed the c largest integer, u3=i1mach(9). thus, the magnitude of zeta c must be restricted by min(u2,u3). on 32 bit machines, u1,u2, c and u3 are approximately 2.0e+3, 4.2e+6, 2.1e+9 in single c precision arithmetic and 1.3e+8, 1.8e+16, 2.1e+9 in double c precision arithmetic respectively. this makes u2 and u3 limit- c ing in their respective arithmetics. this means that the mag- c nitude of z cannot exceed 3.1e+4 in single and 2.1e+6 in c double precision arithmetic. this also means that one can c expect to retain, in the worst cases on 32 bit machines, c no digits in single precision and only 7 digits in double c precision arithmetic. similar considerations hold for other c machines. c c the approximate relative error in the magnitude of a complex c bessel function can be expressed by p*10**s where p=max(unit c roundoff,1.0e-18) is the nominal precision and 10**s repre- c sents the increase in error due to argument reduction in the c elementary functions. here, s=max(1,abs(log10(cabs(z))), c abs(log10(fnu))) approximately (i.e. s=max(1,abs(exponent of c cabs(z),abs(exponent of fnu)) ). however, the phase angle may c have only absolute accuracy. this is most likely to occur when c one component (in absolute value) is larger than the other by c several orders of magnitude. if one component is 10**k larger c than the other, then one can expect only max(abs(log10(p))-k, c 0) significant digits; or, stated another way, when k exceeds c the exponent of p, no significant digits remain in the smaller c component. however, the phase angle retains absolute accuracy c because, in complex arithmetic with precision p, the smaller c component will not (as a rule) decrease below p times the c magnitude of the larger component. in these extreme cases, c the principal phase angle is on the order of +p, -p, pi/2-p, c or -pi/2+p. c c***routines called zbinu,zabs2,zdiv,zsqrt,d1mach,i1mach c c complex bi,cone,csq,cy,s1,s2,trm1,trm2,z,zta,z3 double precision aa, ad, ak, alim, atrm, az, az3, bb, bii, bir, * bk, cc, ck, coef, conei, coner, csqi, csqr, cyi, cyr, c1, c2, * dig, dk, d1, d2, eaa, elim, fid, fmr, fnu, fnul, pi, rl, r1m5, * sfac, sti, str, s1i, s1r, s2i, s2r, tol, trm1i, trm1r, trm2i, * trm2r, tth, zi, zr, ztai, ztar, z3i, z3r, d1mach, zabs2 integer id, ierr, k, kode, k1, k2, nz, i1mach dimension cyr(2), cyi(2) data tth, c1, c2, coef, pi /6.66666666666666667d-01, * 6.14926627446000736d-01,4.48288357353826359d-01, * 5.77350269189625765d-01,3.14159265358979324d+00/ data coner, conei /1.0d0,0.0d0/ c ierr = 0 nz=0 if (id.lt.0 .or. id.gt.1) ierr=1 if (kode.lt.1 .or. kode.gt.2) ierr=1 if (ierr.ne.0) return az = zabs2(zr,zi) tol = dmax1(d1mach(4),1.0d-18) fid = dble(float(id)) if (az.gt.1.0e0) go to 70 c----------------------------------------------------------------------- c power series for cabs(z).le.1. c----------------------------------------------------------------------- s1r = coner s1i = conei s2r = coner s2i = conei if (az.lt.tol) go to 130 aa = az*az if (aa.lt.tol/az) go to 40 trm1r = coner trm1i = conei trm2r = coner trm2i = conei atrm = 1.0d0 str = zr*zr - zi*zi sti = zr*zi + zi*zr z3r = str*zr - sti*zi z3i = str*zi + sti*zr az3 = az*aa ak = 2.0d0 + fid bk = 3.0d0 - fid - fid ck = 4.0d0 - fid dk = 3.0d0 + fid + fid d1 = ak*dk d2 = bk*ck ad = dmin1(d1,d2) ak = 24.0d0 + 9.0d0*fid bk = 30.0d0 - 9.0d0*fid do 30 k=1,25 str = (trm1r*z3r-trm1i*z3i)/d1 trm1i = (trm1r*z3i+trm1i*z3r)/d1 trm1r = str s1r = s1r + trm1r s1i = s1i + trm1i str = (trm2r*z3r-trm2i*z3i)/d2 trm2i = (trm2r*z3i+trm2i*z3r)/d2 trm2r = str s2r = s2r + trm2r s2i = s2i + trm2i atrm = atrm*az3/ad d1 = d1 + ak d2 = d2 + bk ad = dmin1(d1,d2) if (atrm.lt.tol*ad) go to 40 ak = ak + 18.0d0 bk = bk + 18.0d0 30 continue 40 continue if (id.eq.1) go to 50 bir = c1*s1r + c2*(zr*s2r-zi*s2i) bii = c1*s1i + c2*(zr*s2i+zi*s2r) if (kode.eq.1) return call zsqrt(zr, zi, str, sti) ztar = tth*(zr*str-zi*sti) ztai = tth*(zr*sti+zi*str) aa = ztar aa = -dabs(aa) eaa = dexp(aa) bir = bir*eaa bii = bii*eaa return 50 continue bir = s2r*c2 bii = s2i*c2 if (az.le.tol) go to 60 cc = c1/(1.0d0+fid) str = s1r*zr - s1i*zi sti = s1r*zi + s1i*zr bir = bir + cc*(str*zr-sti*zi) bii = bii + cc*(str*zi+sti*zr) 60 continue if (kode.eq.1) return call zsqrt(zr, zi, str, sti) ztar = tth*(zr*str-zi*sti) ztai = tth*(zr*sti+zi*str) aa = ztar aa = -dabs(aa) eaa = dexp(aa) bir = bir*eaa bii = bii*eaa return c----------------------------------------------------------------------- c case for cabs(z).gt.1.0 c----------------------------------------------------------------------- 70 continue fnu = (1.0d0+fid)/3.0d0 c----------------------------------------------------------------------- c set parameters related to machine constants. c tol is the approximate unit roundoff limited to 1.0e-18. c elim is the approximate exponential over- and underflow limit. c exp(-elim).lt.exp(-alim)=exp(-elim)/tol and c exp(elim).gt.exp(alim)=exp(elim)*tol are intervals near c underflow and overflow limits where scaled arithmetic is done. c rl is the lower boundary of the asymptotic expansion for large z. c dig = number of base 10 digits in tol = 10**(-dig). c fnul is the lower boundary of the asymptotic series for large fnu. c----------------------------------------------------------------------- k1 = i1mach(15) k2 = i1mach(16) r1m5 = d1mach(5) k = min0(iabs(k1),iabs(k2)) elim = 2.303d0*(dble(float(k))*r1m5-3.0d0) k1 = i1mach(14) - 1 aa = r1m5*dble(float(k1)) dig = dmin1(aa,18.0d0) aa = aa*2.303d0 alim = elim + dmax1(-aa,-41.45d0) rl = 1.2d0*dig + 3.0d0 fnul = 10.0d0 + 6.0d0*(dig-3.0d0) c----------------------------------------------------------------------- c test for range c----------------------------------------------------------------------- aa=0.5d0/tol bb=dble(float(i1mach(9)))*0.5d0 aa=dmin1(aa,bb) aa=aa**tth if (az.gt.aa) go to 260 aa=dsqrt(aa) if (az.gt.aa) ierr=3 call zsqrt(zr, zi, csqr, csqi) ztar = tth*(zr*csqr-zi*csqi) ztai = tth*(zr*csqi+zi*csqr) c----------------------------------------------------------------------- c re(zta).le.0 when re(z).lt.0, especially when im(z) is small c----------------------------------------------------------------------- sfac = 1.0d0 ak = ztai if (zr.ge.0.0d0) go to 80 bk = ztar ck = -dabs(bk) ztar = ck ztai = ak 80 continue if (zi.ne.0.0d0 .or. zr.gt.0.0d0) go to 90 ztar = 0.0d0 ztai = ak 90 continue aa = ztar if (kode.eq.2) go to 100 c----------------------------------------------------------------------- c overflow test c----------------------------------------------------------------------- bb = dabs(aa) if (bb.lt.alim) go to 100 bb = bb + 0.25d0*dlog(az) sfac = tol if (bb.gt.elim) go to 190 100 continue fmr = 0.0d0 if (aa.ge.0.0d0 .and. zr.gt.0.0d0) go to 110 fmr = pi if (zi.lt.0.0d0) fmr = -pi ztar = -ztar ztai = -ztai 110 continue c----------------------------------------------------------------------- c aa=factor for analytic continuation of i(fnu,zta) c kode=2 returns exp(-abs(xzta))*i(fnu,zta) from cbesi c----------------------------------------------------------------------- call zbinu(ztar, ztai, fnu, kode, 1, cyr, cyi, nz, rl, fnul, tol, * elim, alim) if (nz.lt.0) go to 200 aa = fmr*fnu z3r = sfac str = dcos(aa) sti = dsin(aa) s1r = (str*cyr(1)-sti*cyi(1))*z3r s1i = (str*cyi(1)+sti*cyr(1))*z3r fnu = (2.0d0-fid)/3.0d0 call zbinu(ztar, ztai, fnu, kode, 2, cyr, cyi, nz, rl, fnul, tol, * elim, alim) cyr(1) = cyr(1)*z3r cyi(1) = cyi(1)*z3r cyr(2) = cyr(2)*z3r cyi(2) = cyi(2)*z3r c----------------------------------------------------------------------- c backward recur one step for orders -1/3 or -2/3 c----------------------------------------------------------------------- call zdiv(cyr(1), cyi(1), ztar, ztai, str, sti) s2r = (fnu+fnu)*str + cyr(2) s2i = (fnu+fnu)*sti + cyi(2) aa = fmr*(fnu-1.0d0) str = dcos(aa) sti = dsin(aa) s1r = coef*(s1r+s2r*str-s2i*sti) s1i = coef*(s1i+s2r*sti+s2i*str) if (id.eq.1) go to 120 str = csqr*s1r - csqi*s1i s1i = csqr*s1i + csqi*s1r s1r = str bir = s1r/sfac bii = s1i/sfac return 120 continue str = zr*s1r - zi*s1i s1i = zr*s1i + zi*s1r s1r = str bir = s1r/sfac bii = s1i/sfac return 130 continue aa = c1*(1.0d0-fid) + fid*c2 bir = aa bii = 0.0d0 return 190 continue ierr=2 nz=0 return 200 continue if(nz.eq.(-1)) go to 190 nz=0 ierr=5 return 260 continue ierr=4 nz=0 return end c----------------------------------------------------------------------- c----------------------------------------------------------------------- getdp-2.7.0-source/Numeric/Bessel.cpp000644 001750 001750 00000012304 12473553040 021127 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "GetDPConfig.h" #include "Message.h" #include "Bessel.h" #if defined(HAVE_NO_FORTRAN) static void zbesj_(double*, double*, double*, int*, int*, double*, double*, int*, int*) { Message::Fatal("Bessel functions require Fortran compiler"); } static void zbesy_(double*, double*, double*, int*, int*, double*, double*, int*, double*, double*, int*) { Message::Fatal("Bessel functions require Fortran compiler"); } static void zbesh_(double*, double*, double*, int*, int*, int*, double*, double*, int*, int*) { Message::Fatal("Bessel functions require Fortran compiler"); } #else #if defined(HAVE_UNDERSCORE) #define zbesj_ zbesj #define zbesy_ zbesy #define zbesh_ zbesh #endif extern "C" { void zbesj_(double*, double*, double*, int*, int*, double*, double*, int*, int*); void zbesy_(double*, double*, double*, int*, int*, double*, double*, int*, double*, double*, int*); void zbesh_(double*, double*, double*, int*, int*, int*, double*, double*, int*, int*); } #endif static int BesselError(int ierr, const char *str) { static int warn=0; switch(ierr){ case 0 : return 0; case 1 : Message::Error("Input error in %s", str); return BESSEL_ERROR_INPUT; case 2 : return BESSEL_OVERFLOW; case 3 : if(!warn){ Message::Info("Half machine accuracy lost in %s (large argument or order)", str); warn = 1; } return BESSEL_HALF_ACCURACY; case 4 : Message::Error("Complete loss of significance in %s (argument or order too large)", str); return BESSEL_NO_ACCURACY; case 5 : Message::Error("Failed to converge in %s", str); return BESSEL_NO_CONVERGENCE; default: Message::Info("Unknown Bessel status in %s (%d)", str, ierr); return ierr; } } // First kind Bessel functions int BesselJn(double n, int num, double x, double *val) { int nz = 0, ierr = 0, kode = 1; double xi = 0.0; double* ji = new double[num]; zbesj_(&x, &xi, &n, &kode, &num, val, ji, &nz, &ierr) ; delete[] ji; return BesselError(ierr, "BesselJn"); } int BesselSphericalJn(double n, int num, double x, double *val) { int ierr = BesselJn(n+0.5, num, x, val); double coef = sqrt(0.5*M_PI/x); for(int i = 0; i < num; i++){ val[i] *= coef; } return BesselError(ierr, "BesselSphericalJn"); } int BesselAltSphericalJn(double n, int num, double x, double *val) { int ierr = BesselJn(n+0.5, num, x, val); double coef = sqrt(0.5*M_PI*x); for(int i = 0; i < num; i++){ val[i] *= coef; } return BesselError(ierr, "BesselAltSphericalJn"); } // Second kind Bessel functions int BesselYn(double n, int num, double x, double *val) { int nz = 0, ierr = 0, kode = 1; double xi = 0.0; double* yi = new double[num]; double* auxyr = new double[num]; double* auxyi = new double[num]; zbesy_(&x, &xi, &n, &kode, &num, val, yi, &nz, auxyr, auxyi, &ierr); delete[] yi; delete[] auxyr; delete[] auxyi; return BesselError(ierr, "BesselYn"); } int BesselSphericalYn(double n, int num, double x, double *val) { int ierr = BesselYn(n+0.5, num, x, val); double coef = sqrt(0.5*M_PI/x); for(int i = 0; i < num; i++){ val[i] *= coef; } return BesselError(ierr, "BesselSphericalYn"); } int BesselAltSphericalYn(double n, int num, double x, double *val) { int ierr = BesselYn(n+0.5, num, x, val); double coef = sqrt(0.5*M_PI*x); for(int i = 0; i < num; i++){ val[i] *= coef; } return BesselError(ierr, "BesselAltSphericalYn"); } // Hankel functions (type = 1 or 2) int BesselHn(int type, double n, int num, double x, std::complex *val) { int nz = 0, ierr = 0, kode = 1; double* hr = new double[num]; double* hi = new double[num]; double xi = 0.0; zbesh_(&x, &xi, &n, &kode, &type, &num, hr, hi, &nz, &ierr); for(int i=0; i < num; i++){ val[i] = std::complex(hr[i], hi[i]); } delete[] hr; delete[] hi; return BesselError(ierr, "BesselHn"); } int BesselSphericalHn(int type, double n, int num, double x, std::complex *val) { int ierr = BesselHn(type, n+0.5, num, x, val); double coef = sqrt(0.5*M_PI/x); for(int i = 0; i < num; i++){ val[i] *= coef; } return BesselError(ierr, "BesselSphericalHn"); } int BesselAltSphericalHn(int type, double n, int num, double x, std::complex *val) { int ierr = BesselHn(type, n+0.5, num, x, val); double coef = sqrt(0.5*M_PI*x); for(int i = 0; i < num; i++){ val[i] *= coef; } return BesselError(ierr, "BesselAltSphericalHn"); } // Utilities for backward compatibility double Spherical_j_n(int n, double x) { double res; BesselSphericalJn(n, 1, x, &res); return res; } double AltSpherical_j_n(int n, double x) { double res; BesselAltSphericalJn(n, 1, x, &res); return res; } double Spherical_y_n(int n, double x) { double res; BesselSphericalYn(n, 1, x, &res); return res; } double AltSpherical_y_n(int n, double x) { double res; BesselAltSphericalYn(n, 1, x, &res); return res; } getdp-2.7.0-source/Numeric/Adapt.cpp000644 001750 001750 00000012261 12473553040 020745 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Jean-Francois Remacle // #include #include "Adapt.h" #include "NumericUtils.h" #include "Message.h" #define SQU(a) ((a)*(a)) static int NN ; static double MINH , *ERR , *HH , *PP , E0, DIM ; /* ------------------------------------------------------------------------ */ /* f XXX */ /* ------------------------------------------------------------------------ */ /* h-type version 1 : minimize the number of elements while keeping a given global error */ double fH1 (double l){ int i; double val1 = 0.0, val2 = 0.0; for(i = 1 ; i <= NN ; i++){ val1 += pow(2.*l*SQU(ERR[i])*PP[i]/DIM, DIM/(2.*PP[i]+DIM)); val2 += SQU(ERR[i]) * pow(2.*l*SQU(ERR[i])*PP[i]/DIM, -2.*PP[i]/(2.*PP[i]+DIM)); } return ( -(val1 + l * (val2 - SQU(E0))) ); } /* h-type version 2 : minimize the error while keeping a given number of elements */ double fH2 (double l){ int i; double val1 = 0.0, val2 = 0.0, qi; for(i = 1 ; i <= NN ; i++){ qi = pow(DIM*l/(2.*PP[i]*SQU(ERR[i])), -DIM/(DIM+2.*PP[i])); val1 += SQU(ERR[i]) * pow(qi, -2.*PP[i]/DIM); val2 += qi; } return ( -(val1 + l * (val2 - E0)) ); } /* p-type : minimize error by modifying the interpolation order vector */ double fP1 (double l){ int i; double val1 = 0.0, val2 = 0.0, qi, e; for(i = 1 ; i <= NN ; i++){ e = ERR[i]; if(e == 0.0) e=1.e-12; qi = - log(2.*l*log(HH[i]/MINH)*SQU(e)) / log(HH[i]/MINH); val1 -= 0.5 * qi; val2 += pow(HH[i]/MINH, qi) * SQU(e); } return ( -(val1 + l * (val2 - SQU(E0))) ); } /* ------------------------------------------------------------------------ */ /* A d a p t */ /* ------------------------------------------------------------------------ */ double min1d (int method, double (*funct)(double), double *xmin){ double xx, fx, fb, fa, bx, ax, tol = 1.e-4; switch(method){ case H1: case P1: ax=1.e-12; xx=1.e2; break; default: ax=1.e-15; xx=1.e-12; break; } mnbrak(&ax,&xx,&bx,&fa,&fx,&fb,funct); return ( brent(ax,xx,bx,funct,tol,xmin) ); } /* Adapt return the constraint (N0 ou e0) for the optimzed problem */ double Adapt (int N, /* Number of elements */ int method, /* H1, H2, P1 or P2 */ int dim, /* 2 or 3 */ double *err, /* elementary errors */ double *h, /* elementary mesh sizes */ double *p, /* elementary exponents */ double e0){ /* prescribed error or number of elements */ int i, maxdeg = 999; double contr=0., pivrai, lambda, minf, qi, ri, pi, obj, obj2, minri=0., maxri=0.; double errmin=0., errmax=0.; h[N+1] = 1.0; p[N+1] = 1.0; NN = N; ERR = err; HH = h; PP = p; E0 = e0; DIM = (double)dim; for(i = 1 ; i <= N ; i++){ if(i == 1) errmin = errmax = err[i]; else{ errmin = std::min(errmin, err[i]); errmax = std::max(errmax, err[i]); } } switch (method) { case H1 : minf = min1d (method, fH1, &lambda); obj = 0.0; for(i = 1 ; i <= N ; i++){ qi = pow(2.*lambda*SQU(err[i])*p[i]/DIM, DIM/(2.*p[i]+DIM)); ri = pow(qi,1./DIM); if(i==1) minri = maxri = ri; if(err[i] == 0.0) ri = .5; minri = std::min(minri, ri); maxri = std::max(maxri, ri); obj += SQU(err[i]) * pow(ri, -2.*p[i]) ; h[i] = sqrt(2.) * h[i]/ri; p[i] = ri; } contr = fabs(minf); Message::Info("H-Refinement 1, Error %g=>%g, Objective %g, Reduction Factor %g->%g", e0, sqrt(obj), -minf, minri, maxri); break; case H2 : minf = min1d (method, fH2, &lambda); obj = 0.0; for(i = 1 ; i <= N ; i++){ qi = pow((DIM*lambda)/(2.*SQU(err[i])*p[i]), -DIM/(DIM+2.*p[i])); ri = pow(qi, 1./DIM); if(i == 1) minri = maxri = ri; minri = std::min(minri, ri); maxri = std::max(maxri, ri); obj += pow(ri,DIM) ; h[i] = h[i]/ri; p[i] = p[i]; } contr = sqrt(fabs(minf)); Message::Info("H-Refinement 2, Elements %g=>%g, Objective %g, Reduction Factor %g->%g", e0, obj, 100. * sqrt(fabs(minf)), minri, maxri); break; case P1 : MINH = h[1]; for(i = 1 ; i <= N ; i++) MINH = std::min(h[i], MINH); MINH /= 2.; minf = min1d (method, fP1, &lambda); obj = obj2 = 0.0; for(i = 1 ; i <= N ; i++){ qi = -log(2.*lambda*SQU(err[i])*log(h[i]/MINH)) / log(h[i]/MINH); pi = p[i] - .5 * qi; pivrai = std::min(std::max(1., (double)(int)(pi+.99)), (double)maxdeg); obj2 += pow(h[i]/MINH, 2.*(p[i]-pivrai)) * SQU(err[i]); obj += SQU(err[i]) * pow(h[i]/MINH, qi); h[i] = h[i]; p[i] = pi; } contr = fabs(minf); Message::Info("P-Refinement, Error %g=%g=>%g, Objective %g", e0, sqrt(obj), sqrt(obj2), minf); break; case P2 : minf = min1d (method, fH1, &lambda); break; default : Message::Error("Unknown adaptation method"); } return (contr) ; } getdp-2.7.0-source/Numeric/Bessel.h000644 001750 001750 00000002647 12473553040 020605 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _BESSEL_H_ #define _BESSEL_H_ #include #include #define BESSEL_ERROR_INPUT 1 #define BESSEL_OVERFLOW 2 #define BESSEL_HALF_ACCURACY 3 #define BESSEL_NO_ACCURACY 4 #define BESSEL_NO_CONVERGENCE 5 // These routines provide a C++ interface to the Fortran Bessel // functions from Donald E. Amos (Sandia National Laboratories) int BesselJn(double n, int num, double x, double *val); int BesselSphericalJn(double n, int num, double x, double *val); int BesselAltSphericalJn(double n, int num, double x, double *val); int BesselYn(double n, int num, double x, double *val); int BesselSphericalYn(double n, int num, double x, double *val); int BesselAltSphericalYn(double n, int num, double x, double *val); int BesselHn(int type, double n, int num, double x, std::complex *val); int BesselSphericalHn(int type, double n, int num, double x, std::complex *val); int BesselAltSphericalHn(int type, double n, int num, double x, std::complex *val); // Utilities for backward compatibility double Spherical_j_n(int n, double x); double AltSpherical_j_n(int n, double x); double Spherical_y_n(int n, double x); double AltSpherical_y_n(int n, double x); #endif getdp-2.7.0-source/Numeric/kissfft.hh000644 001750 001750 00000027653 12611677027 021223 0ustar00geuzainegeuzaine000000 000000 // KISS FFT 1.3.0 // // Copyright (c) 2003-2010 Mark Borgerding // // All rights reserved. // // Redistribution and use in source and binary forms, with or without // modification, are permitted provided that the following conditions are met: // // * Redistributions of source code must retain the above copyright notice, this // list of conditions and the following disclaimer. // // * Redistributions in binary form must reproduce the above copyright notice, // this list of conditions and the following disclaimer in the documentation // and/or other materials provided with the distribution. // // * Neither the author nor the names of any contributors may be used to endorse // or promote products derived from this software without specific prior // written permission. // // THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" // AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE // IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE // ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE // LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR // CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF // SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS // INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN // CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) // ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE // POSSIBILITY OF SUCH DAMAGE. #ifndef KISSFFT_CLASS_HH #include #include namespace kissfft_utils { template struct traits { typedef T_scalar scalar_type; typedef std::complex cpx_type; void fill_twiddles( std::complex * dst ,int nfft,bool inverse) { T_scalar phinc = (inverse?2:-2)* acos( (T_scalar) -1) / nfft; for (int i=0;i(0,i*phinc) ); } void prepare( std::vector< std::complex > & dst, int nfft,bool inverse, std::vector & stageRadix, std::vector & stageRemainder ) { _twiddles.resize(nfft); fill_twiddles( &_twiddles[0],nfft,inverse); dst = _twiddles; //factorize //start factoring out 4's, then 2's, then 3,5,7,9,... int n= nfft; int p=4; do { while (n % p) { switch (p) { case 4: p = 2; break; case 2: p = 3; break; default: p += 2; break; } if (p*p>n) p=n;// no more factors } n /= p; stageRadix.push_back(p); stageRemainder.push_back(n); }while(n>1); } std::vector _twiddles; const cpx_type twiddle(int i) { return _twiddles[i]; } }; } template > class kissfft { public: typedef T_traits traits_type; typedef typename traits_type::scalar_type scalar_type; typedef typename traits_type::cpx_type cpx_type; kissfft(int nfft,bool inverse,const traits_type & traits=traits_type() ) :_nfft(nfft),_inverse(inverse),_traits(traits) { _traits.prepare(_twiddles, _nfft,_inverse ,_stageRadix, _stageRemainder); } void transform(const cpx_type * src , cpx_type * dst) { kf_work(0, dst, src, 1,1); } private: void kf_work( int stage,cpx_type * Fout, const cpx_type * f, size_t fstride,size_t in_stride) { int p = _stageRadix[stage]; int m = _stageRemainder[stage]; cpx_type * Fout_beg = Fout; cpx_type * Fout_end = Fout + p*m; if (m==1) { do{ *Fout = *f; f += fstride*in_stride; }while(++Fout != Fout_end ); }else{ do{ // recursive call: // DFT of size m*p performed by doing // p instances of smaller DFTs of size m, // each one takes a decimated version of the input kf_work(stage+1, Fout , f, fstride*p,in_stride); f += fstride*in_stride; }while( (Fout += m) != Fout_end ); } Fout=Fout_beg; // recombine the p smaller DFTs switch (p) { case 2: kf_bfly2(Fout,fstride,m); break; case 3: kf_bfly3(Fout,fstride,m); break; case 4: kf_bfly4(Fout,fstride,m); break; case 5: kf_bfly5(Fout,fstride,m); break; default: kf_bfly_generic(Fout,fstride,m,p); break; } } // these were #define macros in the original kiss_fft void C_ADD( cpx_type & c,const cpx_type & a,const cpx_type & b) { c=a+b;} void C_MUL( cpx_type & c,const cpx_type & a,const cpx_type & b) { c=a*b;} void C_SUB( cpx_type & c,const cpx_type & a,const cpx_type & b) { c=a-b;} void C_ADDTO( cpx_type & c,const cpx_type & a) { c+=a;} void C_FIXDIV( cpx_type & ,int ) {} // NO-OP for float types scalar_type S_MUL( const scalar_type & a,const scalar_type & b) { return a*b;} scalar_type HALF_OF( const scalar_type & a) { return a*.5;} void C_MULBYSCALAR(cpx_type & c,const scalar_type & a) {c*=a;} void kf_bfly2( cpx_type * Fout, const size_t fstride, int m) { for (int k=0;kreal() - HALF_OF(scratch[3].real() ) , Fout->imag() - HALF_OF(scratch[3].imag() ) ); C_MULBYSCALAR( scratch[0] , epi3.imag() ); C_ADDTO(*Fout,scratch[3]); Fout[m2] = cpx_type( Fout[m].real() + scratch[0].imag() , Fout[m].imag() - scratch[0].real() ); C_ADDTO( Fout[m] , cpx_type( -scratch[0].imag(),scratch[0].real() ) ); ++Fout; }while(--k); } void kf_bfly5( cpx_type * Fout, const size_t fstride, const size_t m) { cpx_type *Fout0,*Fout1,*Fout2,*Fout3,*Fout4; size_t u; cpx_type scratch[13]; cpx_type * twiddles = &_twiddles[0]; cpx_type *tw; cpx_type ya,yb; ya = twiddles[fstride*m]; yb = twiddles[fstride*2*m]; Fout0=Fout; Fout1=Fout0+m; Fout2=Fout0+2*m; Fout3=Fout0+3*m; Fout4=Fout0+4*m; tw=twiddles; for ( u=0; u scratchbuf(p); for ( u=0; u=Norig) twidx-=Norig; C_MUL(t,scratchbuf[q] , twiddles[twidx] ); C_ADDTO( Fout[ k ] ,t); } k += m; } } } int _nfft; bool _inverse; std::vector _twiddles; std::vector _stageRadix; std::vector _stageRemainder; traits_type _traits; }; #endif getdp-2.7.0-source/Numeric/NumericUtils.cpp000644 001750 001750 00000010262 12473553040 022336 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include "GetDPConfig.h" #include "Message.h" #if !defined(HAVE_GSL) && !defined(HAVE_NR) double brent(double ax, double bx, double cx, double (*f) (double), double tol, double *xmin) { Message::Error("Minimization routines require GSL or NR"); return 0; } void mnbrak(double *ax, double *bx, double *cx, double *fa_dummy, double *fb_dummy, double *fc_dummy, double (*func) (double)) { Message::Error("Minimization routines require GSL or NR"); } #endif #if defined(HAVE_GSL) #include #include #include static double (*nrfunc) (double); double fn1(double x, void *params) { double val = nrfunc(x); return val; } #define MAXITER 100 // Returns the minimum betwen ax and cx to a given tolerance tol using // brent's method. double brent(double ax, double bx, double cx, double (*f) (double), double tol, double *xmin) { int status; int iter = 0; double a, b, c; // a < b < c const gsl_min_fminimizer_type *T; gsl_min_fminimizer *s; gsl_function F; // gsl wants a= 0.0 ? fabs(a) : -fabs(a)) void mnbrak(double *ax, double *bx, double *cx, double *fa_dummy, double *fb_dummy, double *fc_dummy, double (*func) (double)) { double ulim, u, r, q; volatile double f_a, f_b, f_c, f_u; f_a = (*func) (*ax); f_b = (*func) (*bx); if(f_b > f_a) { double tmp; tmp = *ax; *ax = *bx; *bx = tmp; tmp = f_b; f_b = f_a; f_a = tmp; } *cx = *bx + MYGOLD_ * (*bx - *ax); f_c = (*func) (*cx); while(f_b > f_c) { r = (*bx - *ax) * (f_b - f_c); q = (*bx - *cx) * (f_b - f_a); u = (*bx) - ((*bx - *cx) * q - (*bx - *ax) * r) / (2.0 * SIGN(std::max(fabs(q - r), MYTINY_), q - r)); ulim = *bx + MYLIMIT_ * (*cx - *bx); if((*bx - u) * (u - *cx) > 0.0) { f_u = (*func) (u); if(f_u < f_c) { *ax = *bx; *bx = u; return; } else if(f_u > f_b) { *cx = u; return; } u = *cx + MYGOLD_ * (*cx - *bx); f_u = (*func) (u); } else if((*cx - u) * (u - ulim) > 0.0) { f_u = (*func) (u); if(f_u < f_c) { *bx = *cx; *cx = u; u = *cx + MYGOLD_ * (*cx - *bx); f_b = f_c; f_c = f_u; f_u = (*func) (u); } } else if((u - ulim) * (ulim - *cx) >= 0.0) { u = ulim; f_u = (*func) (u); } else { u = *cx + MYGOLD_ * (*cx - *bx); f_u = (*func) (u); } *ax = *bx; *bx = *cx; *cx = u; f_a = f_b; f_b = f_c; f_c = f_u; } } #endif getdp-2.7.0-source/Numeric/CMakeLists.txt000644 001750 001750 00000000713 12473553040 021747 0ustar00geuzainegeuzaine000000 000000 # GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege # # See the LICENSE.txt file for license information. Please report all # bugs and problems to the public mailing list . set(SRC NumericUtils.cpp Adapt.cpp Legendre.cpp Bessel.cpp ) if(ENABLE_FORTRAN) list(APPEND SRC BesselLib.f) endif(ENABLE_FORTRAN) file(GLOB HDR RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} *.h) append_getdp_src(Numeric "${SRC};${HDR}") getdp-2.7.0-source/contrib/Arpack/dstqrb.f000644 001750 001750 00000040624 11266605602 022122 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: dstqrb c c\Description: c Computes all eigenvalues and the last component of the eigenvectors c of a symmetric tridiagonal matrix using the implicit QL or QR method. c c This is mostly a modification of the LAPACK routine dsteqr. c See Remarks. c c\Usage: c call dstqrb c ( N, D, E, Z, WORK, INFO ) c c\Arguments c N Integer. (INPUT) c The number of rows and columns in the matrix. N >= 0. c c D Double precision array, dimension (N). (INPUT/OUTPUT) c On entry, D contains the diagonal elements of the c tridiagonal matrix. c On exit, D contains the eigenvalues, in ascending order. c If an error exit is made, the eigenvalues are correct c for indices 1,2,...,INFO-1, but they are unordered and c may not be the smallest eigenvalues of the matrix. c c E Double precision array, dimension (N-1). (INPUT/OUTPUT) c On entry, E contains the subdiagonal elements of the c tridiagonal matrix in positions 1 through N-1. c On exit, E has been destroyed. c c Z Double precision array, dimension (N). (OUTPUT) c On exit, Z contains the last row of the orthonormal c eigenvector matrix of the symmetric tridiagonal matrix. c If an error exit is made, Z contains the last row of the c eigenvector matrix associated with the stored eigenvalues. c c WORK Double precision array, dimension (max(1,2*N-2)). (WORKSPACE) c Workspace used in accumulating the transformation for c computing the last components of the eigenvectors. c c INFO Integer. (OUTPUT) c = 0: normal return. c < 0: if INFO = -i, the i-th argument had an illegal value. c > 0: if INFO = +i, the i-th eigenvalue has not converged c after a total of 30*N iterations. c c\Remarks c 1. None. c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c daxpy Level 1 BLAS that computes a vector triad. c dcopy Level 1 BLAS that copies one vector to another. c dswap Level 1 BLAS that swaps the contents of two vectors. c lsame LAPACK character comparison routine. c dlae2 LAPACK routine that computes the eigenvalues of a 2-by-2 c symmetric matrix. c dlaev2 LAPACK routine that eigendecomposition of a 2-by-2 symmetric c matrix. c dlamch LAPACK routine that determines machine constants. c dlanst LAPACK routine that computes the norm of a matrix. c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c dlartg LAPACK Givens rotation construction routine. c dlascl LAPACK routine for careful scaling of a matrix. c dlaset LAPACK matrix initialization routine. c dlasr LAPACK routine that applies an orthogonal transformation to c a matrix. c dlasrt LAPACK sorting routine. c dsteqr LAPACK routine that computes eigenvalues and eigenvectors c of a symmetric tridiagonal matrix. c xerbla LAPACK error handler routine. c c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: stqrb.F SID: 2.5 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks c 1. Starting with version 2.5, this routine is a modified version c of LAPACK version 2.0 subroutine SSTEQR. No lines are deleted, c only commeted out and new lines inserted. c All lines commented out have "c$$$" at the beginning. c Note that the LAPACK version 1.0 subroutine SSTEQR contained c bugs. c c\EndLib c c----------------------------------------------------------------------- c subroutine dstqrb ( n, d, e, z, work, info ) c c %------------------% c | Scalar Arguments | c %------------------% c integer info, n c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & d( n ), e( n-1 ), z( n ), work( 2*n-2 ) c c .. parameters .. Double precision & zero, one, two, three parameter ( zero = 0.0D+0, one = 1.0D+0, & two = 2.0D+0, three = 3.0D+0 ) integer maxit parameter ( maxit = 30 ) c .. c .. local scalars .. integer i, icompz, ii, iscale, j, jtot, k, l, l1, lend, & lendm1, lendp1, lendsv, lm1, lsv, m, mm, mm1, & nm1, nmaxit Double precision & anorm, b, c, eps, eps2, f, g, p, r, rt1, rt2, & s, safmax, safmin, ssfmax, ssfmin, tst c .. c .. external functions .. logical lsame Double precision & dlamch, dlanst, dlapy2 external lsame, dlamch, dlanst, dlapy2 c .. c .. external subroutines .. external dlae2, dlaev2, dlartg, dlascl, dlaset, dlasr, & dlasrt, dswap, xerbla c .. c .. intrinsic functions .. intrinsic abs, max, sign, sqrt c .. c .. executable statements .. c c test the input parameters. c info = 0 c c$$$ IF( LSAME( COMPZ, 'N' ) ) THEN c$$$ ICOMPZ = 0 c$$$ ELSE IF( LSAME( COMPZ, 'V' ) ) THEN c$$$ ICOMPZ = 1 c$$$ ELSE IF( LSAME( COMPZ, 'I' ) ) THEN c$$$ ICOMPZ = 2 c$$$ ELSE c$$$ ICOMPZ = -1 c$$$ END IF c$$$ IF( ICOMPZ.LT.0 ) THEN c$$$ INFO = -1 c$$$ ELSE IF( N.LT.0 ) THEN c$$$ INFO = -2 c$$$ ELSE IF( ( LDZ.LT.1 ) .OR. ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1, c$$$ $ N ) ) ) THEN c$$$ INFO = -6 c$$$ END IF c$$$ IF( INFO.NE.0 ) THEN c$$$ CALL XERBLA( 'SSTEQR', -INFO ) c$$$ RETURN c$$$ END IF c c *** New starting with version 2.5 *** c icompz = 2 c ************************************* c c quick return if possible c if( n.eq.0 ) $ return c if( n.eq.1 ) then if( icompz.eq.2 ) z( 1 ) = one return end if c c determine the unit roundoff and over/underflow thresholds. c eps = dlamch( 'e' ) eps2 = eps**2 safmin = dlamch( 's' ) safmax = one / safmin ssfmax = sqrt( safmax ) / three ssfmin = sqrt( safmin ) / eps2 c c compute the eigenvalues and eigenvectors of the tridiagonal c matrix. c c$$ if( icompz.eq.2 ) c$$$ $ call dlaset( 'full', n, n, zero, one, z, ldz ) c c *** New starting with version 2.5 *** c if ( icompz .eq. 2 ) then do 5 j = 1, n-1 z(j) = zero 5 continue z( n ) = one end if c ************************************* c nmaxit = n*maxit jtot = 0 c c determine where the matrix splits and choose ql or qr iteration c for each block, according to whether top or bottom diagonal c element is smaller. c l1 = 1 nm1 = n - 1 c 10 continue if( l1.gt.n ) $ go to 160 if( l1.gt.1 ) $ e( l1-1 ) = zero if( l1.le.nm1 ) then do 20 m = l1, nm1 tst = abs( e( m ) ) if( tst.eq.zero ) $ go to 30 if( tst.le.( sqrt( abs( d( m ) ) )*sqrt( abs( d( m+ $ 1 ) ) ) )*eps ) then e( m ) = zero go to 30 end if 20 continue end if m = n c 30 continue l = l1 lsv = l lend = m lendsv = lend l1 = m + 1 if( lend.eq.l ) $ go to 10 c c scale submatrix in rows and columns l to lend c anorm = dlanst( 'i', lend-l+1, d( l ), e( l ) ) iscale = 0 if( anorm.eq.zero ) $ go to 10 if( anorm.gt.ssfmax ) then iscale = 1 call dlascl( 'g', 0, 0, anorm, ssfmax, lend-l+1, 1, d( l ), n, $ info ) call dlascl( 'g', 0, 0, anorm, ssfmax, lend-l, 1, e( l ), n, $ info ) else if( anorm.lt.ssfmin ) then iscale = 2 call dlascl( 'g', 0, 0, anorm, ssfmin, lend-l+1, 1, d( l ), n, $ info ) call dlascl( 'g', 0, 0, anorm, ssfmin, lend-l, 1, e( l ), n, $ info ) end if c c choose between ql and qr iteration c if( abs( d( lend ) ).lt.abs( d( l ) ) ) then lend = lsv l = lendsv end if c if( lend.gt.l ) then c c ql iteration c c look for small subdiagonal element. c 40 continue if( l.ne.lend ) then lendm1 = lend - 1 do 50 m = l, lendm1 tst = abs( e( m ) )**2 if( tst.le.( eps2*abs( d( m ) ) )*abs( d( m+1 ) )+ $ safmin )go to 60 50 continue end if c m = lend c 60 continue if( m.lt.lend ) $ e( m ) = zero p = d( l ) if( m.eq.l ) $ go to 80 c c if remaining matrix is 2-by-2, use dlae2 or dlaev2 c to compute its eigensystem. c if( m.eq.l+1 ) then if( icompz.gt.0 ) then call dlaev2( d( l ), e( l ), d( l+1 ), rt1, rt2, c, s ) work( l ) = c work( n-1+l ) = s c$$$ call dlasr( 'r', 'v', 'b', n, 2, work( l ), c$$$ $ work( n-1+l ), z( 1, l ), ldz ) c c *** New starting with version 2.5 *** c tst = z(l+1) z(l+1) = c*tst - s*z(l) z(l) = s*tst + c*z(l) c ************************************* else call dlae2( d( l ), e( l ), d( l+1 ), rt1, rt2 ) end if d( l ) = rt1 d( l+1 ) = rt2 e( l ) = zero l = l + 2 if( l.le.lend ) $ go to 40 go to 140 end if c if( jtot.eq.nmaxit ) $ go to 140 jtot = jtot + 1 c c form shift. c g = ( d( l+1 )-p ) / ( two*e( l ) ) r = dlapy2( g, one ) g = d( m ) - p + ( e( l ) / ( g+sign( r, g ) ) ) c s = one c = one p = zero c c inner loop c mm1 = m - 1 do 70 i = mm1, l, -1 f = s*e( i ) b = c*e( i ) call dlartg( g, f, c, s, r ) if( i.ne.m-1 ) $ e( i+1 ) = r g = d( i+1 ) - p r = ( d( i )-g )*s + two*c*b p = s*r d( i+1 ) = g + p g = c*r - b c c if eigenvectors are desired, then save rotations. c if( icompz.gt.0 ) then work( i ) = c work( n-1+i ) = -s end if c 70 continue c c if eigenvectors are desired, then apply saved rotations. c if( icompz.gt.0 ) then mm = m - l + 1 c$$$ call dlasr( 'r', 'v', 'b', n, mm, work( l ), work( n-1+l ), c$$$ $ z( 1, l ), ldz ) c c *** New starting with version 2.5 *** c call dlasr( 'r', 'v', 'b', 1, mm, work( l ), & work( n-1+l ), z( l ), 1 ) c ************************************* end if c d( l ) = d( l ) - p e( l ) = g go to 40 c c eigenvalue found. c 80 continue d( l ) = p c l = l + 1 if( l.le.lend ) $ go to 40 go to 140 c else c c qr iteration c c look for small superdiagonal element. c 90 continue if( l.ne.lend ) then lendp1 = lend + 1 do 100 m = l, lendp1, -1 tst = abs( e( m-1 ) )**2 if( tst.le.( eps2*abs( d( m ) ) )*abs( d( m-1 ) )+ $ safmin )go to 110 100 continue end if c m = lend c 110 continue if( m.gt.lend ) $ e( m-1 ) = zero p = d( l ) if( m.eq.l ) $ go to 130 c c if remaining matrix is 2-by-2, use dlae2 or dlaev2 c to compute its eigensystem. c if( m.eq.l-1 ) then if( icompz.gt.0 ) then call dlaev2( d( l-1 ), e( l-1 ), d( l ), rt1, rt2, c, s ) c$$$ work( m ) = c c$$$ work( n-1+m ) = s c$$$ call dlasr( 'r', 'v', 'f', n, 2, work( m ), c$$$ $ work( n-1+m ), z( 1, l-1 ), ldz ) c c *** New starting with version 2.5 *** c tst = z(l) z(l) = c*tst - s*z(l-1) z(l-1) = s*tst + c*z(l-1) c ************************************* else call dlae2( d( l-1 ), e( l-1 ), d( l ), rt1, rt2 ) end if d( l-1 ) = rt1 d( l ) = rt2 e( l-1 ) = zero l = l - 2 if( l.ge.lend ) $ go to 90 go to 140 end if c if( jtot.eq.nmaxit ) $ go to 140 jtot = jtot + 1 c c form shift. c g = ( d( l-1 )-p ) / ( two*e( l-1 ) ) r = dlapy2( g, one ) g = d( m ) - p + ( e( l-1 ) / ( g+sign( r, g ) ) ) c s = one c = one p = zero c c inner loop c lm1 = l - 1 do 120 i = m, lm1 f = s*e( i ) b = c*e( i ) call dlartg( g, f, c, s, r ) if( i.ne.m ) $ e( i-1 ) = r g = d( i ) - p r = ( d( i+1 )-g )*s + two*c*b p = s*r d( i ) = g + p g = c*r - b c c if eigenvectors are desired, then save rotations. c if( icompz.gt.0 ) then work( i ) = c work( n-1+i ) = s end if c 120 continue c c if eigenvectors are desired, then apply saved rotations. c if( icompz.gt.0 ) then mm = l - m + 1 c$$$ call dlasr( 'r', 'v', 'f', n, mm, work( m ), work( n-1+m ), c$$$ $ z( 1, m ), ldz ) c c *** New starting with version 2.5 *** c call dlasr( 'r', 'v', 'f', 1, mm, work( m ), work( n-1+m ), & z( m ), 1 ) c ************************************* end if c d( l ) = d( l ) - p e( lm1 ) = g go to 90 c c eigenvalue found. c 130 continue d( l ) = p c l = l - 1 if( l.ge.lend ) $ go to 90 go to 140 c end if c c undo scaling if necessary c 140 continue if( iscale.eq.1 ) then call dlascl( 'g', 0, 0, ssfmax, anorm, lendsv-lsv+1, 1, $ d( lsv ), n, info ) call dlascl( 'g', 0, 0, ssfmax, anorm, lendsv-lsv, 1, e( lsv ), $ n, info ) else if( iscale.eq.2 ) then call dlascl( 'g', 0, 0, ssfmin, anorm, lendsv-lsv+1, 1, $ d( lsv ), n, info ) call dlascl( 'g', 0, 0, ssfmin, anorm, lendsv-lsv, 1, e( lsv ), $ n, info ) end if c c check for no convergence to an eigenvalue after a total c of n*maxit iterations. c if( jtot.lt.nmaxit ) $ go to 10 do 150 i = 1, n - 1 if( e( i ).ne.zero ) $ info = info + 1 150 continue go to 190 c c order eigenvalues and eigenvectors. c 160 continue if( icompz.eq.0 ) then c c use quick sort c call dlasrt( 'i', n, d, info ) c else c c use selection sort to minimize swaps of eigenvectors c do 180 ii = 2, n i = ii - 1 k = i p = d( i ) do 170 j = ii, n if( d( j ).lt.p ) then k = j p = d( j ) end if 170 continue if( k.ne.i ) then d( k ) = d( i ) d( i ) = p c$$$ call dswap( n, z( 1, i ), 1, z( 1, k ), 1 ) c *** New starting with version 2.5 *** c p = z(k) z(k) = z(i) z(i) = p c ************************************* end if 180 continue end if c 190 continue return c c %---------------% c | End of dstqrb | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/ssaitr.f000644 001750 001750 00000073727 11266605602 022142 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: ssaitr c c\Description: c Reverse communication interface for applying NP additional steps to c a K step symmetric Arnoldi factorization. c c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T c c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0. c c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T c c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0. c c where OP and B are as in ssaupd. The B-norm of r_{k+p} is also c computed and returned. c c\Usage: c call ssaitr c ( IDO, BMAT, N, K, NP, MODE, RESID, RNORM, V, LDV, H, LDH, c IPNTR, WORKD, INFO ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y. c This is for the restart phase to force the new c starting vector into the range of OP. c IDO = 1: compute Y = OP * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y, c IPNTR(3) is the pointer into WORK for B * X. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y. c IDO = 99: done c ------------------------------------------------------------- c When the routine is used in the "shift-and-invert" mode, the c vector B * Q is already available and does not need to be c recomputed in forming OP * Q. c c BMAT Character*1. (INPUT) c BMAT specifies the type of matrix B that defines the c semi-inner product for the operator OP. See ssaupd. c B = 'I' -> standard eigenvalue problem A*x = lambda*x c B = 'G' -> generalized eigenvalue problem A*x = lambda*M*x c c N Integer. (INPUT) c Dimension of the eigenproblem. c c K Integer. (INPUT) c Current order of H and the number of columns of V. c c NP Integer. (INPUT) c Number of additional Arnoldi steps to take. c c MODE Integer. (INPUT) c Signifies which form for "OP". If MODE=2 then c a reduction in the number of B matrix vector multiplies c is possible since the B-norm of OP*x is equivalent to c the inv(B)-norm of A*x. c c RESID Real array of length N. (INPUT/OUTPUT) c On INPUT: RESID contains the residual vector r_{k}. c On OUTPUT: RESID contains the residual vector r_{k+p}. c c RNORM Real scalar. (INPUT/OUTPUT) c On INPUT the B-norm of r_{k}. c On OUTPUT the B-norm of the updated residual r_{k+p}. c c V Real N by K+NP array. (INPUT/OUTPUT) c On INPUT: V contains the Arnoldi vectors in the first K c columns. c On OUTPUT: V contains the new NP Arnoldi vectors in the next c NP columns. The first K columns are unchanged. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Real (K+NP) by 2 array. (INPUT/OUTPUT) c H is used to store the generated symmetric tridiagonal matrix c with the subdiagonal in the first column starting at H(2,1) c and the main diagonal in the second column. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c IPNTR Integer array of length 3. (OUTPUT) c Pointer to mark the starting locations in the WORK for c vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. c IPNTR(3): pointer to the vector B * X when used in the c shift-and-invert mode. X is the current operand. c ------------------------------------------------------------- c c WORKD Real work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The calling program should not c use WORKD as temporary workspace during the iteration !!!!!! c On INPUT, WORKD(1:N) = B*RESID where RESID is associated c with the K step Arnoldi factorization. Used to save some c computation at the first step. c On OUTPUT, WORKD(1:N) = B*RESID where RESID is associated c with the K+NP step Arnoldi factorization. c c INFO Integer. (OUTPUT) c = 0: Normal exit. c > 0: Size of an invariant subspace of OP is found that is c less than K + NP. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c sgetv0 ARPACK routine to generate the initial vector. c ivout ARPACK utility routine that prints integers. c smout ARPACK utility routine that prints matrices. c svout ARPACK utility routine that prints vectors. c slamch LAPACK routine that determines machine constants. c slascl LAPACK routine for careful scaling of a matrix. c sgemv Level 2 BLAS routine for matrix vector multiplication. c saxpy Level 1 BLAS that computes a vector triad. c sscal Level 1 BLAS that scales a vector. c scopy Level 1 BLAS that copies one vector to another . c sdot Level 1 BLAS that computes the scalar product of two vectors. c snrm2 Level 1 BLAS that computes the norm of a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/93: Version ' 2.4' c c\SCCS Information: @(#) c FILE: saitr.F SID: 2.6 DATE OF SID: 8/28/96 RELEASE: 2 c c\Remarks c The algorithm implemented is: c c restart = .false. c Given V_{k} = [v_{1}, ..., v_{k}], r_{k}; c r_{k} contains the initial residual vector even for k = 0; c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already c computed by the calling program. c c betaj = rnorm ; p_{k+1} = B*r_{k} ; c For j = k+1, ..., k+np Do c 1) if ( betaj < tol ) stop or restart depending on j. c if ( restart ) generate a new starting vector. c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}]; c p_{j} = p_{j}/betaj c 3) r_{j} = OP*v_{j} where OP is defined as in ssaupd c For shift-invert mode p_{j} = B*v_{j} is already available. c wnorm = || OP*v_{j} || c 4) Compute the j-th step residual vector. c w_{j} = V_{j}^T * B * OP * v_{j} c r_{j} = OP*v_{j} - V_{j} * w_{j} c alphaj <- j-th component of w_{j} c rnorm = || r_{j} || c betaj+1 = rnorm c If (rnorm > 0.717*wnorm) accept step and go back to 1) c 5) Re-orthogonalization step: c s = V_{j}'*B*r_{j} c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} || c alphaj = alphaj + s_{j}; c 6) Iterative refinement step: c If (rnorm1 > 0.717*rnorm) then c rnorm = rnorm1 c accept step and go back to 1) c Else c rnorm = rnorm1 c If this is the first time in step 6), go to 5) c Else r_{j} lies in the span of V_{j} numerically. c Set r_{j} = 0 and rnorm = 0; go to 1) c EndIf c End Do c c\EndLib c c----------------------------------------------------------------------- c subroutine ssaitr & (ido, bmat, n, k, np, mode, resid, rnorm, v, ldv, h, ldh, & ipntr, workd, info) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1 integer ido, info, k, ldh, ldv, n, mode, np Real & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(3) Real & h(ldh,2), resid(n), v(ldv,k+np), workd(3*n) c c %------------% c | Parameters | c %------------% c Real & one, zero parameter (one = 1.0E+0, zero = 0.0E+0) c c %---------------% c | Local Scalars | c %---------------% c logical first, orth1, orth2, rstart, step3, step4 integer i, ierr, ipj, irj, ivj, iter, itry, j, msglvl, & infol, jj Real & rnorm1, wnorm, safmin, temp1 save orth1, orth2, rstart, step3, step4, & ierr, ipj, irj, ivj, iter, itry, j, msglvl, & rnorm1, safmin, wnorm c c %-----------------------% c | Local Array Arguments | c %-----------------------% c Real & xtemp(2) c c %----------------------% c | External Subroutines | c %----------------------% c external saxpy, scopy, sscal, sgemv, sgetv0, svout, smout, & slascl, ivout, second c c %--------------------% c | External Functions | c %--------------------% c Real & sdot, snrm2, slamch external sdot, snrm2, slamch c c %-----------------% c | Data statements | c %-----------------% c data first / .true. / c c %-----------------------% c | Executable Statements | c %-----------------------% c if (first) then first = .false. c c %--------------------------------% c | safmin = safe minimum is such | c | that 1/sfmin does not overflow | c %--------------------------------% c safmin = slamch('safmin') end if c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = msaitr c c %------------------------------% c | Initial call to this routine | c %------------------------------% c info = 0 step3 = .false. step4 = .false. rstart = .false. orth1 = .false. orth2 = .false. c c %--------------------------------% c | Pointer to the current step of | c | the factorization to build | c %--------------------------------% c j = k + 1 c c %------------------------------------------% c | Pointers used for reverse communication | c | when using WORKD. | c %------------------------------------------% c ipj = 1 irj = ipj + n ivj = irj + n end if c c %-------------------------------------------------% c | When in reverse communication mode one of: | c | STEP3, STEP4, ORTH1, ORTH2, RSTART | c | will be .true. | c | STEP3: return from computing OP*v_{j}. | c | STEP4: return from computing B-norm of OP*v_{j} | c | ORTH1: return from computing B-norm of r_{j+1} | c | ORTH2: return from computing B-norm of | c | correction to the residual vector. | c | RSTART: return from OP computations needed by | c | sgetv0. | c %-------------------------------------------------% c if (step3) go to 50 if (step4) go to 60 if (orth1) go to 70 if (orth2) go to 90 if (rstart) go to 30 c c %------------------------------% c | Else this is the first step. | c %------------------------------% c c %--------------------------------------------------------------% c | | c | A R N O L D I I T E R A T I O N L O O P | c | | c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) | c %--------------------------------------------------------------% c 1000 continue c if (msglvl .gt. 2) then call ivout (logfil, 1, j, ndigit, & '_saitr: generating Arnoldi vector no.') call svout (logfil, 1, rnorm, ndigit, & '_saitr: B-norm of the current residual =') end if c c %---------------------------------------------------------% c | Check for exact zero. Equivalent to determing whether a | c | j-step Arnoldi factorization is present. | c %---------------------------------------------------------% c if (rnorm .gt. zero) go to 40 c c %---------------------------------------------------% c | Invariant subspace found, generate a new starting | c | vector which is orthogonal to the current Arnoldi | c | basis and continue the iteration. | c %---------------------------------------------------% c if (msglvl .gt. 0) then call ivout (logfil, 1, j, ndigit, & '_saitr: ****** restart at step ******') end if c c %---------------------------------------------% c | ITRY is the loop variable that controls the | c | maximum amount of times that a restart is | c | attempted. NRSTRT is used by stat.h | c %---------------------------------------------% c nrstrt = nrstrt + 1 itry = 1 20 continue rstart = .true. ido = 0 30 continue c c %--------------------------------------% c | If in reverse communication mode and | c | RSTART = .true. flow returns here. | c %--------------------------------------% c call sgetv0 (ido, bmat, itry, .false., n, j, v, ldv, & resid, rnorm, ipntr, workd, ierr) if (ido .ne. 99) go to 9000 if (ierr .lt. 0) then itry = itry + 1 if (itry .le. 3) go to 20 c c %------------------------------------------------% c | Give up after several restart attempts. | c | Set INFO to the size of the invariant subspace | c | which spans OP and exit. | c %------------------------------------------------% c info = j - 1 call second (t1) tsaitr = tsaitr + (t1 - t0) ido = 99 go to 9000 end if c 40 continue c c %---------------------------------------------------------% c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm | c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow | c | when reciprocating a small RNORM, test against lower | c | machine bound. | c %---------------------------------------------------------% c call scopy (n, resid, 1, v(1,j), 1) if (rnorm .ge. safmin) then temp1 = one / rnorm call sscal (n, temp1, v(1,j), 1) call sscal (n, temp1, workd(ipj), 1) else c c %-----------------------------------------% c | To scale both v_{j} and p_{j} carefully | c | use LAPACK routine SLASCL | c %-----------------------------------------% c call slascl ('General', i, i, rnorm, one, n, 1, & v(1,j), n, infol) call slascl ('General', i, i, rnorm, one, n, 1, & workd(ipj), n, infol) end if c c %------------------------------------------------------% c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} | c | Note that this is not quite yet r_{j}. See STEP 4 | c %------------------------------------------------------% c step3 = .true. nopx = nopx + 1 call second (t2) call scopy (n, v(1,j), 1, workd(ivj), 1) ipntr(1) = ivj ipntr(2) = irj ipntr(3) = ipj ido = 1 c c %-----------------------------------% c | Exit in order to compute OP*v_{j} | c %-----------------------------------% c go to 9000 50 continue c c %-----------------------------------% c | Back from reverse communication; | c | WORKD(IRJ:IRJ+N-1) := OP*v_{j}. | c %-----------------------------------% c call second (t3) tmvopx = tmvopx + (t3 - t2) c step3 = .false. c c %------------------------------------------% c | Put another copy of OP*v_{j} into RESID. | c %------------------------------------------% c call scopy (n, workd(irj), 1, resid, 1) c c %-------------------------------------------% c | STEP 4: Finish extending the symmetric | c | Arnoldi to length j. If MODE = 2 | c | then B*OP = B*inv(B)*A = A and | c | we don't need to compute B*OP. | c | NOTE: If MODE = 2 WORKD(IVJ:IVJ+N-1) is | c | assumed to have A*v_{j}. | c %-------------------------------------------% c if (mode .eq. 2) go to 65 call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 step4 = .true. ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %-------------------------------------% c | Exit in order to compute B*OP*v_{j} | c %-------------------------------------% c go to 9000 else if (bmat .eq. 'I') then call scopy(n, resid, 1 , workd(ipj), 1) end if 60 continue c c %-----------------------------------% c | Back from reverse communication; | c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j}. | c %-----------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c step4 = .false. c c %-------------------------------------% c | The following is needed for STEP 5. | c | Compute the B-norm of OP*v_{j}. | c %-------------------------------------% c 65 continue if (mode .eq. 2) then c c %----------------------------------% c | Note that the B-norm of OP*v_{j} | c | is the inv(B)-norm of A*v_{j}. | c %----------------------------------% c wnorm = sdot (n, resid, 1, workd(ivj), 1) wnorm = sqrt(abs(wnorm)) else if (bmat .eq. 'G') then wnorm = sdot (n, resid, 1, workd(ipj), 1) wnorm = sqrt(abs(wnorm)) else if (bmat .eq. 'I') then wnorm = snrm2(n, resid, 1) end if c c %-----------------------------------------% c | Compute the j-th residual corresponding | c | to the j step factorization. | c | Use Classical Gram Schmidt and compute: | c | w_{j} <- V_{j}^T * B * OP * v_{j} | c | r_{j} <- OP*v_{j} - V_{j} * w_{j} | c %-----------------------------------------% c c c %------------------------------------------% c | Compute the j Fourier coefficients w_{j} | c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. | c %------------------------------------------% c if (mode .ne. 2 ) then call sgemv('T', n, j, one, v, ldv, workd(ipj), 1, zero, & workd(irj), 1) else if (mode .eq. 2) then call sgemv('T', n, j, one, v, ldv, workd(ivj), 1, zero, & workd(irj), 1) end if c c %--------------------------------------% c | Orthgonalize r_{j} against V_{j}. | c | RESID contains OP*v_{j}. See STEP 3. | c %--------------------------------------% c call sgemv('N', n, j, -one, v, ldv, workd(irj), 1, one, & resid, 1) c c %--------------------------------------% c | Extend H to have j rows and columns. | c %--------------------------------------% c h(j,2) = workd(irj + j - 1) if (j .eq. 1 .or. rstart) then h(j,1) = zero else h(j,1) = rnorm end if call second (t4) c orth1 = .true. iter = 0 c call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call scopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %----------------------------------% c | Exit in order to compute B*r_{j} | c %----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call scopy (n, resid, 1, workd(ipj), 1) end if 70 continue c c %---------------------------------------------------% c | Back from reverse communication if ORTH1 = .true. | c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. | c %---------------------------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c orth1 = .false. c c %------------------------------% c | Compute the B-norm of r_{j}. | c %------------------------------% c if (bmat .eq. 'G') then rnorm = sdot (n, resid, 1, workd(ipj), 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then rnorm = snrm2(n, resid, 1) end if c c %-----------------------------------------------------------% c | STEP 5: Re-orthogonalization / Iterative refinement phase | c | Maximum NITER_ITREF tries. | c | | c | s = V_{j}^T * B * r_{j} | c | r_{j} = r_{j} - V_{j}*s | c | alphaj = alphaj + s_{j} | c | | c | The stopping criteria used for iterative refinement is | c | discussed in Parlett's book SEP, page 107 and in Gragg & | c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. | c | Determine if we need to correct the residual. The goal is | c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || | c %-----------------------------------------------------------% c if (rnorm .gt. 0.717*wnorm) go to 100 nrorth = nrorth + 1 c c %---------------------------------------------------% c | Enter the Iterative refinement phase. If further | c | refinement is necessary, loop back here. The loop | c | variable is ITER. Perform a step of Classical | c | Gram-Schmidt using all the Arnoldi vectors V_{j} | c %---------------------------------------------------% c 80 continue c if (msglvl .gt. 2) then xtemp(1) = wnorm xtemp(2) = rnorm call svout (logfil, 2, xtemp, ndigit, & '_saitr: re-orthonalization ; wnorm and rnorm are') end if c c %----------------------------------------------------% c | Compute V_{j}^T * B * r_{j}. | c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). | c %----------------------------------------------------% c call sgemv ('T', n, j, one, v, ldv, workd(ipj), 1, & zero, workd(irj), 1) c c %----------------------------------------------% c | Compute the correction to the residual: | c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). | c | The correction to H is v(:,1:J)*H(1:J,1:J) + | c | v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j, but only | c | H(j,j) is updated. | c %----------------------------------------------% c call sgemv ('N', n, j, -one, v, ldv, workd(irj), 1, & one, resid, 1) c if (j .eq. 1 .or. rstart) h(j,1) = zero h(j,2) = h(j,2) + workd(irj + j - 1) c orth2 = .true. call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call scopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %-----------------------------------% c | Exit in order to compute B*r_{j}. | c | r_{j} is the corrected residual. | c %-----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call scopy (n, resid, 1, workd(ipj), 1) end if 90 continue c c %---------------------------------------------------% c | Back from reverse communication if ORTH2 = .true. | c %---------------------------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c c %-----------------------------------------------------% c | Compute the B-norm of the corrected residual r_{j}. | c %-----------------------------------------------------% c if (bmat .eq. 'G') then rnorm1 = sdot (n, resid, 1, workd(ipj), 1) rnorm1 = sqrt(abs(rnorm1)) else if (bmat .eq. 'I') then rnorm1 = snrm2(n, resid, 1) end if c if (msglvl .gt. 0 .and. iter .gt. 0) then call ivout (logfil, 1, j, ndigit, & '_saitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then xtemp(1) = rnorm xtemp(2) = rnorm1 call svout (logfil, 2, xtemp, ndigit, & '_saitr: iterative refinement ; rnorm and rnorm1 are') end if end if c c %-----------------------------------------% c | Determine if we need to perform another | c | step of re-orthogonalization. | c %-----------------------------------------% c if (rnorm1 .gt. 0.717*rnorm) then c c %--------------------------------% c | No need for further refinement | c %--------------------------------% c rnorm = rnorm1 c else c c %-------------------------------------------% c | Another step of iterative refinement step | c | is required. NITREF is used by stat.h | c %-------------------------------------------% c nitref = nitref + 1 rnorm = rnorm1 iter = iter + 1 if (iter .le. 1) go to 80 c c %-------------------------------------------------% c | Otherwise RESID is numerically in the span of V | c %-------------------------------------------------% c do 95 jj = 1, n resid(jj) = zero 95 continue rnorm = zero end if c c %----------------------------------------------% c | Branch here directly if iterative refinement | c | wasn't necessary or after at most NITER_REF | c | steps of iterative refinement. | c %----------------------------------------------% c 100 continue c rstart = .false. orth2 = .false. c call second (t5) titref = titref + (t5 - t4) c c %----------------------------------------------------------% c | Make sure the last off-diagonal element is non negative | c | If not perform a similarity transformation on H(1:j,1:j) | c | and scale v(:,j) by -1. | c %----------------------------------------------------------% c if (h(j,1) .lt. zero) then h(j,1) = -h(j,1) if ( j .lt. k+np) then call sscal(n, -one, v(1,j+1), 1) else call sscal(n, -one, resid, 1) end if end if c c %------------------------------------% c | STEP 6: Update j = j+1; Continue | c %------------------------------------% c j = j + 1 if (j .gt. k+np) then call second (t1) tsaitr = tsaitr + (t1 - t0) ido = 99 c if (msglvl .gt. 1) then call svout (logfil, k+np, h(1,2), ndigit, & '_saitr: main diagonal of matrix H of step K+NP.') if (k+np .gt. 1) then call svout (logfil, k+np-1, h(2,1), ndigit, & '_saitr: sub diagonal of matrix H of step K+NP.') end if end if c go to 9000 end if c c %--------------------------------------------------------% c | Loop back to extend the factorization by another step. | c %--------------------------------------------------------% c go to 1000 c c %---------------------------------------------------------------% c | | c | E N D O F M A I N I T E R A T I O N L O O P | c | | c %---------------------------------------------------------------% c 9000 continue return c c %---------------% c | End of ssaitr | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/cneigh.f000644 001750 001750 00000017711 11266605602 022061 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: cneigh c c\Description: c Compute the eigenvalues of the current upper Hessenberg matrix c and the corresponding Ritz estimates given the current residual norm. c c\Usage: c call cneigh c ( RNORM, N, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL, RWORK, IERR ) c c\Arguments c RNORM Real scalar. (INPUT) c Residual norm corresponding to the current upper Hessenberg c matrix H. c c N Integer. (INPUT) c Size of the matrix H. c c H Complex N by N array. (INPUT) c H contains the current upper Hessenberg matrix. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RITZ Complex array of length N. (OUTPUT) c On output, RITZ(1:N) contains the eigenvalues of H. c c BOUNDS Complex array of length N. (OUTPUT) c On output, BOUNDS contains the Ritz estimates associated with c the eigenvalues held in RITZ. This is equal to RNORM c times the last components of the eigenvectors corresponding c to the eigenvalues in RITZ. c c Q Complex N by N array. (WORKSPACE) c Workspace needed to store the eigenvectors of H. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKL Complex work array of length N**2 + 3*N. (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. This is needed to keep the full Schur form c of H and also in the calculation of the eigenvectors of H. c c RWORK Real work array of length N (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. c c IERR Integer. (OUTPUT) c Error exit flag from clahqr or ctrevc. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx Complex c c\Routines called: c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c cmout ARPACK utility routine that prints matrices c cvout ARPACK utility routine that prints vectors. c svout ARPACK utility routine that prints vectors. c clacpy LAPACK matrix copy routine. c clahqr LAPACK routine to compute the Schur form of an c upper Hessenberg matrix. c claset LAPACK matrix initialization routine. c ctrevc LAPACK routine to compute the eigenvectors of a matrix c in upper triangular form c ccopy Level 1 BLAS that copies one vector to another. c csscal Level 1 BLAS that scales a complex vector by a real number. c scnrm2 Level 1 BLAS that computes the norm of a vector. c c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: neigh.F SID: 2.2 DATE OF SID: 4/20/96 RELEASE: 2 c c\Remarks c None c c\EndLib c c----------------------------------------------------------------------- c subroutine cneigh (rnorm, n, h, ldh, ritz, bounds, & q, ldq, workl, rwork, ierr) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer ierr, n, ldh, ldq Real & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c Complex & bounds(n), h(ldh,n), q(ldq,n), ritz(n), & workl(n*(n+3)) Real & rwork(n) c c %------------% c | Parameters | c %------------% c Complex & one, zero Real & rone parameter (one = (1.0E+0, 0.0E+0), zero = (0.0E+0, 0.0E+0), & rone = 1.0E+0) c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c logical select(1) integer j, msglvl Complex & vl(1) Real & temp c c %----------------------% c | External Subroutines | c %----------------------% c external clacpy, clahqr, ctrevc, ccopy, & csscal, cmout, cvout, second c c %--------------------% c | External Functions | c %--------------------% c Real & scnrm2 external scnrm2 c c %-----------------------% c | Executable Statements | c %-----------------------% c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mceigh c if (msglvl .gt. 2) then call cmout (logfil, n, n, h, ldh, ndigit, & '_neigh: Entering upper Hessenberg matrix H ') end if c c %----------------------------------------------------------% c | 1. Compute the eigenvalues, the last components of the | c | corresponding Schur vectors and the full Schur form T | c | of the current upper Hessenberg matrix H. | c | clahqr returns the full Schur form of H | c | in WORKL(1:N**2), and the Schur vectors in q. | c %----------------------------------------------------------% c call clacpy ('All', n, n, h, ldh, workl, n) call claset ('All', n, n, zero, one, q, ldq) call clahqr (.true., .true., n, 1, n, workl, ldh, ritz, & 1, n, q, ldq, ierr) if (ierr .ne. 0) go to 9000 c call ccopy (n, q(n-1,1), ldq, bounds, 1) if (msglvl .gt. 1) then call cvout (logfil, n, bounds, ndigit, & '_neigh: last row of the Schur matrix for H') end if c c %----------------------------------------------------------% c | 2. Compute the eigenvectors of the full Schur form T and | c | apply the Schur vectors to get the corresponding | c | eigenvectors. | c %----------------------------------------------------------% c call ctrevc ('Right', 'Back', select, n, workl, n, vl, n, q, & ldq, n, n, workl(n*n+1), rwork, ierr) c if (ierr .ne. 0) go to 9000 c c %------------------------------------------------% c | Scale the returning eigenvectors so that their | c | Euclidean norms are all one. LAPACK subroutine | c | ctrevc returns each eigenvector normalized so | c | that the element of largest magnitude has | c | magnitude 1; here the magnitude of a complex | c | number (x,y) is taken to be |x| + |y|. | c %------------------------------------------------% c do 10 j=1, n temp = scnrm2( n, q(1,j), 1 ) call csscal ( n, rone / temp, q(1,j), 1 ) 10 continue c if (msglvl .gt. 1) then call ccopy(n, q(n,1), ldq, workl, 1) call cvout (logfil, n, workl, ndigit, & '_neigh: Last row of the eigenvector matrix for H') end if c c %----------------------------% c | Compute the Ritz estimates | c %----------------------------% c call ccopy(n, q(n,1), n, bounds, 1) call csscal(n, rnorm, bounds, 1) c if (msglvl .gt. 2) then call cvout (logfil, n, ritz, ndigit, & '_neigh: The eigenvalues of H') call cvout (logfil, n, bounds, ndigit, & '_neigh: Ritz estimates for the eigenvalues of H') end if c call second(t1) tceigh = tceigh + (t1 - t0) c 9000 continue return c c %---------------% c | End of cneigh | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/sstqrb.f000644 001750 001750 00000040464 11266605602 022143 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: sstqrb c c\Description: c Computes all eigenvalues and the last component of the eigenvectors c of a symmetric tridiagonal matrix using the implicit QL or QR method. c c This is mostly a modification of the LAPACK routine ssteqr. c See Remarks. c c\Usage: c call sstqrb c ( N, D, E, Z, WORK, INFO ) c c\Arguments c N Integer. (INPUT) c The number of rows and columns in the matrix. N >= 0. c c D Real array, dimension (N). (INPUT/OUTPUT) c On entry, D contains the diagonal elements of the c tridiagonal matrix. c On exit, D contains the eigenvalues, in ascending order. c If an error exit is made, the eigenvalues are correct c for indices 1,2,...,INFO-1, but they are unordered and c may not be the smallest eigenvalues of the matrix. c c E Real array, dimension (N-1). (INPUT/OUTPUT) c On entry, E contains the subdiagonal elements of the c tridiagonal matrix in positions 1 through N-1. c On exit, E has been destroyed. c c Z Real array, dimension (N). (OUTPUT) c On exit, Z contains the last row of the orthonormal c eigenvector matrix of the symmetric tridiagonal matrix. c If an error exit is made, Z contains the last row of the c eigenvector matrix associated with the stored eigenvalues. c c WORK Real array, dimension (max(1,2*N-2)). (WORKSPACE) c Workspace used in accumulating the transformation for c computing the last components of the eigenvectors. c c INFO Integer. (OUTPUT) c = 0: normal return. c < 0: if INFO = -i, the i-th argument had an illegal value. c > 0: if INFO = +i, the i-th eigenvalue has not converged c after a total of 30*N iterations. c c\Remarks c 1. None. c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c saxpy Level 1 BLAS that computes a vector triad. c scopy Level 1 BLAS that copies one vector to another. c sswap Level 1 BLAS that swaps the contents of two vectors. c lsame LAPACK character comparison routine. c slae2 LAPACK routine that computes the eigenvalues of a 2-by-2 c symmetric matrix. c slaev2 LAPACK routine that eigendecomposition of a 2-by-2 symmetric c matrix. c slamch LAPACK routine that determines machine constants. c slanst LAPACK routine that computes the norm of a matrix. c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c slartg LAPACK Givens rotation construction routine. c slascl LAPACK routine for careful scaling of a matrix. c slaset LAPACK matrix initialization routine. c slasr LAPACK routine that applies an orthogonal transformation to c a matrix. c slasrt LAPACK sorting routine. c ssteqr LAPACK routine that computes eigenvalues and eigenvectors c of a symmetric tridiagonal matrix. c xerbla LAPACK error handler routine. c c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: stqrb.F SID: 2.5 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks c 1. Starting with version 2.5, this routine is a modified version c of LAPACK version 2.0 subroutine SSTEQR. No lines are deleted, c only commeted out and new lines inserted. c All lines commented out have "c$$$" at the beginning. c Note that the LAPACK version 1.0 subroutine SSTEQR contained c bugs. c c\EndLib c c----------------------------------------------------------------------- c subroutine sstqrb ( n, d, e, z, work, info ) c c %------------------% c | Scalar Arguments | c %------------------% c integer info, n c c %-----------------% c | Array Arguments | c %-----------------% c Real & d( n ), e( n-1 ), z( n ), work( 2*n-2 ) c c .. parameters .. Real & zero, one, two, three parameter ( zero = 0.0E+0, one = 1.0E+0, & two = 2.0E+0, three = 3.0E+0 ) integer maxit parameter ( maxit = 30 ) c .. c .. local scalars .. integer i, icompz, ii, iscale, j, jtot, k, l, l1, lend, & lendm1, lendp1, lendsv, lm1, lsv, m, mm, mm1, & nm1, nmaxit Real & anorm, b, c, eps, eps2, f, g, p, r, rt1, rt2, & s, safmax, safmin, ssfmax, ssfmin, tst c .. c .. external functions .. logical lsame Real & slamch, slanst, slapy2 external lsame, slamch, slanst, slapy2 c .. c .. external subroutines .. external slae2, slaev2, slartg, slascl, slaset, slasr, & slasrt, sswap, xerbla c .. c .. intrinsic functions .. intrinsic abs, max, sign, sqrt c .. c .. executable statements .. c c test the input parameters. c info = 0 c c$$$ IF( LSAME( COMPZ, 'N' ) ) THEN c$$$ ICOMPZ = 0 c$$$ ELSE IF( LSAME( COMPZ, 'V' ) ) THEN c$$$ ICOMPZ = 1 c$$$ ELSE IF( LSAME( COMPZ, 'I' ) ) THEN c$$$ ICOMPZ = 2 c$$$ ELSE c$$$ ICOMPZ = -1 c$$$ END IF c$$$ IF( ICOMPZ.LT.0 ) THEN c$$$ INFO = -1 c$$$ ELSE IF( N.LT.0 ) THEN c$$$ INFO = -2 c$$$ ELSE IF( ( LDZ.LT.1 ) .OR. ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1, c$$$ $ N ) ) ) THEN c$$$ INFO = -6 c$$$ END IF c$$$ IF( INFO.NE.0 ) THEN c$$$ CALL XERBLA( 'SSTEQR', -INFO ) c$$$ RETURN c$$$ END IF c c *** New starting with version 2.5 *** c icompz = 2 c ************************************* c c quick return if possible c if( n.eq.0 ) $ return c if( n.eq.1 ) then if( icompz.eq.2 ) z( 1 ) = one return end if c c determine the unit roundoff and over/underflow thresholds. c eps = slamch( 'e' ) eps2 = eps**2 safmin = slamch( 's' ) safmax = one / safmin ssfmax = sqrt( safmax ) / three ssfmin = sqrt( safmin ) / eps2 c c compute the eigenvalues and eigenvectors of the tridiagonal c matrix. c c$$ if( icompz.eq.2 ) c$$$ $ call slaset( 'full', n, n, zero, one, z, ldz ) c c *** New starting with version 2.5 *** c if ( icompz .eq. 2 ) then do 5 j = 1, n-1 z(j) = zero 5 continue z( n ) = one end if c ************************************* c nmaxit = n*maxit jtot = 0 c c determine where the matrix splits and choose ql or qr iteration c for each block, according to whether top or bottom diagonal c element is smaller. c l1 = 1 nm1 = n - 1 c 10 continue if( l1.gt.n ) $ go to 160 if( l1.gt.1 ) $ e( l1-1 ) = zero if( l1.le.nm1 ) then do 20 m = l1, nm1 tst = abs( e( m ) ) if( tst.eq.zero ) $ go to 30 if( tst.le.( sqrt( abs( d( m ) ) )*sqrt( abs( d( m+ $ 1 ) ) ) )*eps ) then e( m ) = zero go to 30 end if 20 continue end if m = n c 30 continue l = l1 lsv = l lend = m lendsv = lend l1 = m + 1 if( lend.eq.l ) $ go to 10 c c scale submatrix in rows and columns l to lend c anorm = slanst( 'i', lend-l+1, d( l ), e( l ) ) iscale = 0 if( anorm.eq.zero ) $ go to 10 if( anorm.gt.ssfmax ) then iscale = 1 call slascl( 'g', 0, 0, anorm, ssfmax, lend-l+1, 1, d( l ), n, $ info ) call slascl( 'g', 0, 0, anorm, ssfmax, lend-l, 1, e( l ), n, $ info ) else if( anorm.lt.ssfmin ) then iscale = 2 call slascl( 'g', 0, 0, anorm, ssfmin, lend-l+1, 1, d( l ), n, $ info ) call slascl( 'g', 0, 0, anorm, ssfmin, lend-l, 1, e( l ), n, $ info ) end if c c choose between ql and qr iteration c if( abs( d( lend ) ).lt.abs( d( l ) ) ) then lend = lsv l = lendsv end if c if( lend.gt.l ) then c c ql iteration c c look for small subdiagonal element. c 40 continue if( l.ne.lend ) then lendm1 = lend - 1 do 50 m = l, lendm1 tst = abs( e( m ) )**2 if( tst.le.( eps2*abs( d( m ) ) )*abs( d( m+1 ) )+ $ safmin )go to 60 50 continue end if c m = lend c 60 continue if( m.lt.lend ) $ e( m ) = zero p = d( l ) if( m.eq.l ) $ go to 80 c c if remaining matrix is 2-by-2, use slae2 or slaev2 c to compute its eigensystem. c if( m.eq.l+1 ) then if( icompz.gt.0 ) then call slaev2( d( l ), e( l ), d( l+1 ), rt1, rt2, c, s ) work( l ) = c work( n-1+l ) = s c$$$ call slasr( 'r', 'v', 'b', n, 2, work( l ), c$$$ $ work( n-1+l ), z( 1, l ), ldz ) c c *** New starting with version 2.5 *** c tst = z(l+1) z(l+1) = c*tst - s*z(l) z(l) = s*tst + c*z(l) c ************************************* else call slae2( d( l ), e( l ), d( l+1 ), rt1, rt2 ) end if d( l ) = rt1 d( l+1 ) = rt2 e( l ) = zero l = l + 2 if( l.le.lend ) $ go to 40 go to 140 end if c if( jtot.eq.nmaxit ) $ go to 140 jtot = jtot + 1 c c form shift. c g = ( d( l+1 )-p ) / ( two*e( l ) ) r = slapy2( g, one ) g = d( m ) - p + ( e( l ) / ( g+sign( r, g ) ) ) c s = one c = one p = zero c c inner loop c mm1 = m - 1 do 70 i = mm1, l, -1 f = s*e( i ) b = c*e( i ) call slartg( g, f, c, s, r ) if( i.ne.m-1 ) $ e( i+1 ) = r g = d( i+1 ) - p r = ( d( i )-g )*s + two*c*b p = s*r d( i+1 ) = g + p g = c*r - b c c if eigenvectors are desired, then save rotations. c if( icompz.gt.0 ) then work( i ) = c work( n-1+i ) = -s end if c 70 continue c c if eigenvectors are desired, then apply saved rotations. c if( icompz.gt.0 ) then mm = m - l + 1 c$$$ call slasr( 'r', 'v', 'b', n, mm, work( l ), work( n-1+l ), c$$$ $ z( 1, l ), ldz ) c c *** New starting with version 2.5 *** c call slasr( 'r', 'v', 'b', 1, mm, work( l ), & work( n-1+l ), z( l ), 1 ) c ************************************* end if c d( l ) = d( l ) - p e( l ) = g go to 40 c c eigenvalue found. c 80 continue d( l ) = p c l = l + 1 if( l.le.lend ) $ go to 40 go to 140 c else c c qr iteration c c look for small superdiagonal element. c 90 continue if( l.ne.lend ) then lendp1 = lend + 1 do 100 m = l, lendp1, -1 tst = abs( e( m-1 ) )**2 if( tst.le.( eps2*abs( d( m ) ) )*abs( d( m-1 ) )+ $ safmin )go to 110 100 continue end if c m = lend c 110 continue if( m.gt.lend ) $ e( m-1 ) = zero p = d( l ) if( m.eq.l ) $ go to 130 c c if remaining matrix is 2-by-2, use slae2 or slaev2 c to compute its eigensystem. c if( m.eq.l-1 ) then if( icompz.gt.0 ) then call slaev2( d( l-1 ), e( l-1 ), d( l ), rt1, rt2, c, s ) c$$$ work( m ) = c c$$$ work( n-1+m ) = s c$$$ call slasr( 'r', 'v', 'f', n, 2, work( m ), c$$$ $ work( n-1+m ), z( 1, l-1 ), ldz ) c c *** New starting with version 2.5 *** c tst = z(l) z(l) = c*tst - s*z(l-1) z(l-1) = s*tst + c*z(l-1) c ************************************* else call slae2( d( l-1 ), e( l-1 ), d( l ), rt1, rt2 ) end if d( l-1 ) = rt1 d( l ) = rt2 e( l-1 ) = zero l = l - 2 if( l.ge.lend ) $ go to 90 go to 140 end if c if( jtot.eq.nmaxit ) $ go to 140 jtot = jtot + 1 c c form shift. c g = ( d( l-1 )-p ) / ( two*e( l-1 ) ) r = slapy2( g, one ) g = d( m ) - p + ( e( l-1 ) / ( g+sign( r, g ) ) ) c s = one c = one p = zero c c inner loop c lm1 = l - 1 do 120 i = m, lm1 f = s*e( i ) b = c*e( i ) call slartg( g, f, c, s, r ) if( i.ne.m ) $ e( i-1 ) = r g = d( i ) - p r = ( d( i+1 )-g )*s + two*c*b p = s*r d( i ) = g + p g = c*r - b c c if eigenvectors are desired, then save rotations. c if( icompz.gt.0 ) then work( i ) = c work( n-1+i ) = s end if c 120 continue c c if eigenvectors are desired, then apply saved rotations. c if( icompz.gt.0 ) then mm = l - m + 1 c$$$ call slasr( 'r', 'v', 'f', n, mm, work( m ), work( n-1+m ), c$$$ $ z( 1, m ), ldz ) c c *** New starting with version 2.5 *** c call slasr( 'r', 'v', 'f', 1, mm, work( m ), work( n-1+m ), & z( m ), 1 ) c ************************************* end if c d( l ) = d( l ) - p e( lm1 ) = g go to 90 c c eigenvalue found. c 130 continue d( l ) = p c l = l - 1 if( l.ge.lend ) $ go to 90 go to 140 c end if c c undo scaling if necessary c 140 continue if( iscale.eq.1 ) then call slascl( 'g', 0, 0, ssfmax, anorm, lendsv-lsv+1, 1, $ d( lsv ), n, info ) call slascl( 'g', 0, 0, ssfmax, anorm, lendsv-lsv, 1, e( lsv ), $ n, info ) else if( iscale.eq.2 ) then call slascl( 'g', 0, 0, ssfmin, anorm, lendsv-lsv+1, 1, $ d( lsv ), n, info ) call slascl( 'g', 0, 0, ssfmin, anorm, lendsv-lsv, 1, e( lsv ), $ n, info ) end if c c check for no convergence to an eigenvalue after a total c of n*maxit iterations. c if( jtot.lt.nmaxit ) $ go to 10 do 150 i = 1, n - 1 if( e( i ).ne.zero ) $ info = info + 1 150 continue go to 190 c c order eigenvalues and eigenvectors. c 160 continue if( icompz.eq.0 ) then c c use quick sort c call slasrt( 'i', n, d, info ) c else c c use selection sort to minimize swaps of eigenvectors c do 180 ii = 2, n i = ii - 1 k = i p = d( i ) do 170 j = ii, n if( d( j ).lt.p ) then k = j p = d( j ) end if 170 continue if( k.ne.i ) then d( k ) = d( i ) d( i ) = p c$$$ call sswap( n, z( 1, i ), 1, z( 1, k ), 1 ) c *** New starting with version 2.5 *** c p = z(k) z(k) = z(i) z(i) = p c ************************************* end if 180 continue end if c 190 continue return c c %---------------% c | End of sstqrb | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dnaupd.f000644 001750 001750 00000072023 11266605602 022074 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: dnaupd c c\Description: c Reverse communication interface for the Implicitly Restarted Arnoldi c iteration. This subroutine computes approximations to a few eigenpairs c of a linear operator "OP" with respect to a semi-inner product defined by c a symmetric positive semi-definite real matrix B. B may be the identity c matrix. NOTE: If the linear operator "OP" is real and symmetric c with respect to the real positive semi-definite symmetric matrix B, c i.e. B*OP = (OP`)*B, then subroutine dsaupd should be used instead. c c The computed approximate eigenvalues are called Ritz values and c the corresponding approximate eigenvectors are called Ritz vectors. c c dnaupd is usually called iteratively to solve one of the c following problems: c c Mode 1: A*x = lambda*x. c ===> OP = A and B = I. c c Mode 2: A*x = lambda*M*x, M symmetric positive definite c ===> OP = inv[M]*A and B = M. c ===> (If M can be factored see remark 3 below) c c Mode 3: A*x = lambda*M*x, M symmetric semi-definite c ===> OP = Real_Part{ inv[A - sigma*M]*M } and B = M. c ===> shift-and-invert mode (in real arithmetic) c If OP*x = amu*x, then c amu = 1/2 * [ 1/(lambda-sigma) + 1/(lambda-conjg(sigma)) ]. c Note: If sigma is real, i.e. imaginary part of sigma is zero; c Real_Part{ inv[A - sigma*M]*M } == inv[A - sigma*M]*M c amu == 1/(lambda-sigma). c c Mode 4: A*x = lambda*M*x, M symmetric semi-definite c ===> OP = Imaginary_Part{ inv[A - sigma*M]*M } and B = M. c ===> shift-and-invert mode (in real arithmetic) c If OP*x = amu*x, then c amu = 1/2i * [ 1/(lambda-sigma) - 1/(lambda-conjg(sigma)) ]. c c Both mode 3 and 4 give the same enhancement to eigenvalues close to c the (complex) shift sigma. However, as lambda goes to infinity, c the operator OP in mode 4 dampens the eigenvalues more strongly than c does OP defined in mode 3. c c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v c should be accomplished either by a direct method c using a sparse matrix factorization and solving c c [A - sigma*M]*w = v or M*w = v, c c or through an iterative method for solving these c systems. If an iterative method is used, the c convergence test must be more stringent than c the accuracy requirements for the eigenvalue c approximations. c c\Usage: c call dnaupd c ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, c IPNTR, WORKD, WORKL, LWORKL, INFO ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. IDO must be zero on the first c call to dnaupd. IDO will be set internally to c indicate the type of operation to be performed. Control is c then given back to the calling routine which has the c responsibility to carry out the requested operation and call c dnaupd with the result. The operand is given in c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)). c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c This is for the initialization phase to force the c starting vector into the range of OP. c IDO = 1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c In mode 3 and 4, the vector B * X is already c available in WORKD(ipntr(3)). It does not c need to be recomputed in forming OP * X. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c IDO = 3: compute the IPARAM(8) real and imaginary parts c of the shifts where INPTR(14) is the pointer c into WORKL for placing the shifts. See Remark c 5 below. c IDO = 99: done c ------------------------------------------------------------- c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B that defines the c semi-inner product for the operator OP. c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*B*x c c N Integer. (INPUT) c Dimension of the eigenproblem. c c WHICH Character*2. (INPUT) c 'LM' -> want the NEV eigenvalues of largest magnitude. c 'SM' -> want the NEV eigenvalues of smallest magnitude. c 'LR' -> want the NEV eigenvalues of largest real part. c 'SR' -> want the NEV eigenvalues of smallest real part. c 'LI' -> want the NEV eigenvalues of largest imaginary part. c 'SI' -> want the NEV eigenvalues of smallest imaginary part. c c NEV Integer. (INPUT/OUTPUT) c Number of eigenvalues of OP to be computed. 0 < NEV < N-1. c c TOL Double precision scalar. (INPUT) c Stopping criterion: the relative accuracy of the Ritz value c is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)) c where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex. c DEFAULT = DLAMCH('EPS') (machine precision as computed c by the LAPACK auxiliary subroutine DLAMCH). c c RESID Double precision array of length N. (INPUT/OUTPUT) c On INPUT: c If INFO .EQ. 0, a random initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c On OUTPUT: c RESID contains the final residual vector. c c NCV Integer. (INPUT) c Number of columns of the matrix V. NCV must satisfy the two c inequalities 2 <= NCV-NEV and NCV <= N. c This will indicate how many Arnoldi vectors are generated c at each iteration. After the startup phase in which NEV c Arnoldi vectors are generated, the algorithm generates c approximately NCV-NEV Arnoldi vectors at each subsequent update c iteration. Most of the cost in generating each Arnoldi vector is c in the matrix-vector operation OP*x. c NOTE: 2 <= NCV-NEV in order that complex conjugate pairs of Ritz c values are kept together. (See remark 4 below) c c V Double precision array N by NCV. (OUTPUT) c Contains the final set of Arnoldi basis vectors. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling program. c c IPARAM Integer array of length 11. (INPUT/OUTPUT) c IPARAM(1) = ISHIFT: method for selecting the implicit shifts. c The shifts selected at each iteration are used to restart c the Arnoldi iteration in an implicit fashion. c ------------------------------------------------------------- c ISHIFT = 0: the shifts are provided by the user via c reverse communication. The real and imaginary c parts of the NCV eigenvalues of the Hessenberg c matrix H are returned in the part of the WORKL c array corresponding to RITZR and RITZI. See remark c 5 below. c ISHIFT = 1: exact shifts with respect to the current c Hessenberg matrix H. This is equivalent to c restarting the iteration with a starting vector c that is a linear combination of approximate Schur c vectors associated with the "wanted" Ritz values. c ------------------------------------------------------------- c c IPARAM(2) = No longer referenced. c c IPARAM(3) = MXITER c On INPUT: maximum number of Arnoldi update iterations allowed. c On OUTPUT: actual number of Arnoldi update iterations taken. c c IPARAM(4) = NB: blocksize to be used in the recurrence. c The code currently works only for NB = 1. c c IPARAM(5) = NCONV: number of "converged" Ritz values. c This represents the number of Ritz values that satisfy c the convergence criterion. c c IPARAM(6) = IUPD c No longer referenced. Implicit restarting is ALWAYS used. c c IPARAM(7) = MODE c On INPUT determines what type of eigenproblem is being solved. c Must be 1,2,3,4; See under \Description of dnaupd for the c four modes available. c c IPARAM(8) = NP c When ido = 3 and the user provides shifts through reverse c communication (IPARAM(1)=0), dnaupd returns NP, the number c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark c 5 below. c c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO, c OUTPUT: NUMOP = total number of OP*x operations, c NUMOPB = total number of B*x operations if BMAT='G', c NUMREO = total number of steps of re-orthogonalization. c c IPNTR Integer array of length 14. (OUTPUT) c Pointer to mark the starting locations in the WORKD and WORKL c arrays for matrices/vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X in WORKD. c IPNTR(2): pointer to the current result vector Y in WORKD. c IPNTR(3): pointer to the vector B * X in WORKD when used in c the shift-and-invert mode. c IPNTR(4): pointer to the next available location in WORKL c that is untouched by the program. c IPNTR(5): pointer to the NCV by NCV upper Hessenberg matrix c H in WORKL. c IPNTR(6): pointer to the real part of the ritz value array c RITZR in WORKL. c IPNTR(7): pointer to the imaginary part of the ritz value array c RITZI in WORKL. c IPNTR(8): pointer to the Ritz estimates in array WORKL associated c with the Ritz values located in RITZR and RITZI in WORKL. c c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below. c c Note: IPNTR(9:13) is only referenced by dneupd. See Remark 2 below. c c IPNTR(9): pointer to the real part of the NCV RITZ values of the c original system. c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of c the original system. c IPNTR(11): pointer to the NCV corresponding error bounds. c IPNTR(12): pointer to the NCV by NCV upper quasi-triangular c Schur matrix for H. c IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors c of the upper Hessenberg matrix H. Only referenced by c dneupd if RVEC = .TRUE. See Remark 2 below. c ------------------------------------------------------------- c c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration. Upon termination c WORKD(1:N) contains B*RESID(1:N). If an invariant subspace c associated with the converged Ritz values is desired, see remark c 2 below, subroutine dneupd uses this output. c See Data Distribution Note below. c c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. See Data Distribution Note below. c c LWORKL Integer. (INPUT) c LWORKL must be at least 3*NCV**2 + 6*NCV. c c INFO Integer. (INPUT/OUTPUT) c If INFO .EQ. 0, a randomly initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c Error flag on output. c = 0: Normal exit. c = 1: Maximum number of iterations taken. c All possible eigenvalues of OP has been found. IPARAM(5) c returns the number of wanted converged Ritz values. c = 2: No longer an informational error. Deprecated starting c with release 2 of ARPACK. c = 3: No shifts could be applied during a cycle of the c Implicitly restarted Arnoldi iteration. One possibility c is to increase the size of NCV relative to NEV. c See remark 4 below. c = -1: N must be positive. c = -2: NEV must be positive. c = -3: NCV-NEV >= 2 and less than or equal to N. c = -4: The maximum number of Arnoldi update iteration c must be greater than zero. c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI' c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work array is not sufficient. c = -8: Error return from LAPACK eigenvalue calculation; c = -9: Starting vector is zero. c = -10: IPARAM(7) must be 1,2,3,4. c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable. c = -12: IPARAM(1) must be equal to 0 or 1. c = -9999: Could not build an Arnoldi factorization. c IPARAM(5) returns the size of the current Arnoldi c factorization. c c\Remarks c 1. The computed Ritz values are approximate eigenvalues of OP. The c selection of WHICH should be made with this in mind when c Mode = 3 and 4. After convergence, approximate eigenvalues of the c original problem may be obtained with the ARPACK subroutine dneupd. c c 2. If a basis for the invariant subspace corresponding to the converged Ritz c values is needed, the user must call dneupd immediately following c completion of dnaupd. This is new starting with release 2 of ARPACK. c c 3. If M can be factored into a Cholesky factorization M = LL` c then Mode = 2 should not be selected. Instead one should use c Mode = 1 with OP = inv(L)*A*inv(L`). Appropriate triangular c linear systems should be solved with L and L` rather c than computing inverses. After convergence, an approximate c eigenvector z of the original problem is recovered by solving c L`z = x where x is a Ritz vector of OP. c c 4. At present there is no a-priori analysis to guide the selection c of NCV relative to NEV. The only formal requrement is that NCV > NEV + 2. c However, it is recommended that NCV .ge. 2*NEV+1. If many problems of c the same type are to be solved, one should experiment with increasing c NCV while keeping NEV fixed for a given test problem. This will c usually decrease the required number of OP*x operations but it c also increases the work and storage required to maintain the orthogonal c basis vectors. The optimal "cross-over" with respect to CPU time c is problem dependent and must be determined empirically. c See Chapter 8 of Reference 2 for further information. c c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the c NP = IPARAM(8) real and imaginary parts of the shifts in locations c real part imaginary part c ----------------------- -------------- c 1 WORKL(IPNTR(14)) WORKL(IPNTR(14)+NP) c 2 WORKL(IPNTR(14)+1) WORKL(IPNTR(14)+NP+1) c . . c . . c . . c NP WORKL(IPNTR(14)+NP-1) WORKL(IPNTR(14)+2*NP-1). c c Only complex conjugate pairs of shifts may be applied and the pairs c must be placed in consecutive locations. The real part of the c eigenvalues of the current upper Hessenberg matrix are located in c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1) and the imaginary part c in WORKL(IPNTR(7)) through WORKL(IPNTR(7)+NCV-1). They are ordered c according to the order defined by WHICH. The complex conjugate c pairs are kept together and the associated Ritz estimates are located in c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1). c c----------------------------------------------------------------------- c c\Data Distribution Note: c c Fortran-D syntax: c ================ c Double precision resid(n), v(ldv,ncv), workd(3*n), workl(lworkl) c decompose d1(n), d2(n,ncv) c align resid(i) with d1(i) c align v(i,j) with d2(i,j) c align workd(i) with d1(i) range (1:n) c align workd(i) with d1(i-n) range (n+1:2*n) c align workd(i) with d1(i-2*n) range (2*n+1:3*n) c distribute d1(block), d2(block,:) c replicated workl(lworkl) c c Cray MPP syntax: c =============== c Double precision resid(n), v(ldv,ncv), workd(n,3), workl(lworkl) c shared resid(block), v(block,:), workd(block,:) c replicated workl(lworkl) c c CM2/CM5 syntax: c ============== c c----------------------------------------------------------------------- c c include 'ex-nonsym.doc' c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for c Real Matrices", Linear Algebra and its Applications, vol 88/89, c pp 575-595, (1987). c c\Routines called: c dnaup2 ARPACK routine that implements the Implicitly Restarted c Arnoldi Iteration. c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c dvout ARPACK utility routine that prints vectors. c dlamch LAPACK routine that determines machine constants. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/16/93: Version '1.1' c c\SCCS Information: @(#) c FILE: naupd.F SID: 2.10 DATE OF SID: 08/23/02 RELEASE: 2 c c\Remarks c c\EndLib c c----------------------------------------------------------------------- c subroutine dnaupd & ( ido, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam, & ipntr, workd, workl, lworkl, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1, which*2 integer ido, info, ldv, lworkl, n, ncv, nev Double precision & tol c c %-----------------% c | Array Arguments | c %-----------------% c integer iparam(11), ipntr(14) Double precision & resid(n), v(ldv,ncv), workd(3*n), workl(lworkl) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c integer bounds, ierr, ih, iq, ishift, iupd, iw, & ldh, ldq, levec, mode, msglvl, mxiter, nb, & nev0, next, np, ritzi, ritzr, j save bounds, ih, iq, ishift, iupd, iw, ldh, ldq, & levec, mode, msglvl, mxiter, nb, nev0, next, & np, ritzi, ritzr c c %----------------------% c | External Subroutines | c %----------------------% c external dnaup2, dvout, ivout, second, dstatn c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlamch external dlamch c c %-----------------------% c | Executable Statements | c %-----------------------% c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call dstatn call second (t0) msglvl = mnaupd c c %----------------% c | Error checking | c %----------------% c ierr = 0 ishift = iparam(1) c levec = iparam(2) mxiter = iparam(3) c nb = iparam(4) nb = 1 c c %--------------------------------------------% c | Revision 2 performs only implicit restart. | c %--------------------------------------------% c iupd = 1 mode = iparam(7) c if (n .le. 0) then ierr = -1 else if (nev .le. 0) then ierr = -2 else if (ncv .le. nev+1 .or. ncv .gt. n) then ierr = -3 else if (mxiter .le. 0) then ierr = 4 else if (which .ne. 'LM' .and. & which .ne. 'SM' .and. & which .ne. 'LR' .and. & which .ne. 'SR' .and. & which .ne. 'LI' .and. & which .ne. 'SI') then ierr = -5 else if (bmat .ne. 'I' .and. bmat .ne. 'G') then ierr = -6 else if (lworkl .lt. 3*ncv**2 + 6*ncv) then ierr = -7 else if (mode .lt. 1 .or. mode .gt. 4) then ierr = -10 else if (mode .eq. 1 .and. bmat .eq. 'G') then ierr = -11 else if (ishift .lt. 0 .or. ishift .gt. 1) then ierr = -12 end if c c %------------% c | Error Exit | c %------------% c if (ierr .ne. 0) then info = ierr ido = 99 go to 9000 end if c c %------------------------% c | Set default parameters | c %------------------------% c if (nb .le. 0) nb = 1 if (tol .le. zero) tol = dlamch('EpsMach') c c %----------------------------------------------% c | NP is the number of additional steps to | c | extend the length NEV Lanczos factorization. | c | NEV0 is the local variable designating the | c | size of the invariant subspace desired. | c %----------------------------------------------% c np = ncv - nev nev0 = nev c c %-----------------------------% c | Zero out internal workspace | c %-----------------------------% c do 10 j = 1, 3*ncv**2 + 6*ncv workl(j) = zero 10 continue c c %-------------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | c | etc... and the remaining workspace. | c | Also update pointer to be used on output. | c | Memory is laid out as follows: | c | workl(1:ncv*ncv) := generated Hessenberg matrix | c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary | c | parts of ritz values | c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds | c | workl(ncv*ncv+3*ncv+1:2*ncv*ncv+3*ncv) := rotation matrix Q | c | workl(2*ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) := workspace | c | The final workspace is needed by subroutine dneigh called | c | by dnaup2. Subroutine dneigh calls LAPACK routines for | c | calculating eigenvalues and the last row of the eigenvector | c | matrix. | c %-------------------------------------------------------------% c ldh = ncv ldq = ncv ih = 1 ritzr = ih + ldh*ncv ritzi = ritzr + ncv bounds = ritzi + ncv iq = bounds + ncv iw = iq + ldq*ncv next = iw + ncv**2 + 3*ncv c ipntr(4) = next ipntr(5) = ih ipntr(6) = ritzr ipntr(7) = ritzi ipntr(8) = bounds ipntr(14) = iw c end if c c %-------------------------------------------------------% c | Carry out the Implicitly restarted Arnoldi Iteration. | c %-------------------------------------------------------% c call dnaup2 & ( ido, bmat, n, which, nev0, np, tol, resid, mode, iupd, & ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritzr), & workl(ritzi), workl(bounds), workl(iq), ldq, workl(iw), & ipntr, workd, info ) c c %--------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP or shifts. | c %--------------------------------------------------% c if (ido .eq. 3) iparam(8) = np if (ido .ne. 99) go to 9000 c iparam(3) = mxiter iparam(5) = np iparam(9) = nopx iparam(10) = nbx iparam(11) = nrorth c c %------------------------------------% c | Exit if there was an informational | c | error within dnaup2. | c %------------------------------------% c if (info .lt. 0) go to 9000 if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then call ivout (logfil, 1, mxiter, ndigit, & '_naupd: Number of update iterations taken') call ivout (logfil, 1, np, ndigit, & '_naupd: Number of wanted "converged" Ritz values') call dvout (logfil, np, workl(ritzr), ndigit, & '_naupd: Real part of the final Ritz values') call dvout (logfil, np, workl(ritzi), ndigit, & '_naupd: Imaginary part of the final Ritz values') call dvout (logfil, np, workl(bounds), ndigit, & '_naupd: Associated Ritz estimates') end if c call second (t1) tnaupd = t1 - t0 c if (msglvl .gt. 0) then c c %--------------------------------------------------------% c | Version Number & Version Date are defined in version.h | c %--------------------------------------------------------% c write (6,1000) write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt, & tmvopx, tmvbx, tnaupd, tnaup2, tnaitr, titref, & tgetv0, tneigh, tngets, tnapps, tnconv, trvec 1000 format (//, & 5x, '=============================================',/ & 5x, '= Nonsymmetric implicit Arnoldi update code =',/ & 5x, '= Version Number: ', ' 2.4', 21x, ' =',/ & 5x, '= Version Date: ', ' 07/31/96', 16x, ' =',/ & 5x, '=============================================',/ & 5x, '= Summary of timing statistics =',/ & 5x, '=============================================',//) 1100 format ( & 5x, 'Total number update iterations = ', i5,/ & 5x, 'Total number of OP*x operations = ', i5,/ & 5x, 'Total number of B*x operations = ', i5,/ & 5x, 'Total number of reorthogonalization steps = ', i5,/ & 5x, 'Total number of iterative refinement steps = ', i5,/ & 5x, 'Total number of restart steps = ', i5,/ & 5x, 'Total time in user OP*x operation = ', f12.6,/ & 5x, 'Total time in user B*x operation = ', f12.6,/ & 5x, 'Total time in Arnoldi update routine = ', f12.6,/ & 5x, 'Total time in naup2 routine = ', f12.6,/ & 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/ & 5x, 'Total time in reorthogonalization phase = ', f12.6,/ & 5x, 'Total time in (re)start vector generation = ', f12.6,/ & 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/ & 5x, 'Total time in getting the shifts = ', f12.6,/ & 5x, 'Total time in applying the shifts = ', f12.6,/ & 5x, 'Total time in convergence testing = ', f12.6,/ & 5x, 'Total time in computing final Ritz vectors = ', f12.6/) end if c 9000 continue c return c c %---------------% c | End of dnaupd | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/sseupd.f000644 001750 001750 00000102654 11266605602 022130 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: sseupd c c\Description: c c This subroutine returns the converged approximations to eigenvalues c of A*z = lambda*B*z and (optionally): c c (1) the corresponding approximate eigenvectors, c c (2) an orthonormal (Lanczos) basis for the associated approximate c invariant subspace, c c (3) Both. c c There is negligible additional cost to obtain eigenvectors. An orthonormal c (Lanczos) basis is always computed. There is an additional storage cost c of n*nev if both are requested (in this case a separate array Z must be c supplied). c c These quantities are obtained from the Lanczos factorization computed c by SSAUPD for the linear operator OP prescribed by the MODE selection c (see IPARAM(7) in SSAUPD documentation.) SSAUPD must be called before c this routine is called. These approximate eigenvalues and vectors are c commonly called Ritz values and Ritz vectors respectively. They are c referred to as such in the comments that follow. The computed orthonormal c basis for the invariant subspace corresponding to these Ritz values is c referred to as a Lanczos basis. c c See documentation in the header of the subroutine SSAUPD for a definition c of OP as well as other terms and the relation of computed Ritz values c and vectors of OP with respect to the given problem A*z = lambda*B*z. c c The approximate eigenvalues of the original problem are returned in c ascending algebraic order. The user may elect to call this routine c once for each desired Ritz vector and store it peripherally if desired. c There is also the option of computing a selected set of these vectors c with a single call. c c\Usage: c call sseupd c ( RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, BMAT, N, WHICH, NEV, TOL, c RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, LWORKL, INFO ) c c RVEC LOGICAL (INPUT) c Specifies whether Ritz vectors corresponding to the Ritz value c approximations to the eigenproblem A*z = lambda*B*z are computed. c c RVEC = .FALSE. Compute Ritz values only. c c RVEC = .TRUE. Compute Ritz vectors. c c HOWMNY Character*1 (INPUT) c Specifies how many Ritz vectors are wanted and the form of Z c the matrix of Ritz vectors. See remark 1 below. c = 'A': compute NEV Ritz vectors; c = 'S': compute some of the Ritz vectors, specified c by the logical array SELECT. c c SELECT Logical array of dimension NCV. (INPUT/WORKSPACE) c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be c computed. To select the Ritz vector corresponding to a c Ritz value D(j), SELECT(j) must be set to .TRUE.. c If HOWMNY = 'A' , SELECT is used as a workspace for c reordering the Ritz values. c c D Real array of dimension NEV. (OUTPUT) c On exit, D contains the Ritz value approximations to the c eigenvalues of A*z = lambda*B*z. The values are returned c in ascending order. If IPARAM(7) = 3,4,5 then D represents c the Ritz values of OP computed by ssaupd transformed to c those of the original eigensystem A*z = lambda*B*z. If c IPARAM(7) = 1,2 then the Ritz values of OP are the same c as the those of A*z = lambda*B*z. c c Z Real N by NEV array if HOWMNY = 'A'. (OUTPUT) c On exit, Z contains the B-orthonormal Ritz vectors of the c eigensystem A*z = lambda*B*z corresponding to the Ritz c value approximations. c If RVEC = .FALSE. then Z is not referenced. c NOTE: The array Z may be set equal to first NEV columns of the c Arnoldi/Lanczos basis array V computed by SSAUPD. c c LDZ Integer. (INPUT) c The leading dimension of the array Z. If Ritz vectors are c desired, then LDZ .ge. max( 1, N ). In any case, LDZ .ge. 1. c c SIGMA Real (INPUT) c If IPARAM(7) = 3,4,5 represents the shift. Not referenced if c IPARAM(7) = 1 or 2. c c c **** The remaining arguments MUST be the same as for the **** c **** call to SSAUPD that was just completed. **** c c NOTE: The remaining arguments c c BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, c WORKD, WORKL, LWORKL, INFO c c must be passed directly to SSEUPD following the last call c to SSAUPD. These arguments MUST NOT BE MODIFIED between c the the last call to SSAUPD and the call to SSEUPD. c c Two of these parameters (WORKL, INFO) are also output parameters: c c WORKL Real work array of length LWORKL. (OUTPUT/WORKSPACE) c WORKL(1:4*ncv) contains information obtained in c ssaupd. They are not changed by sseupd. c WORKL(4*ncv+1:ncv*ncv+8*ncv) holds the c untransformed Ritz values, the computed error estimates, c and the associated eigenvector matrix of H. c c Note: IPNTR(8:10) contains the pointer into WORKL for addresses c of the above information computed by sseupd. c ------------------------------------------------------------- c IPNTR(8): pointer to the NCV RITZ values of the original system. c IPNTR(9): pointer to the NCV corresponding error bounds. c IPNTR(10): pointer to the NCV by NCV matrix of eigenvectors c of the tridiagonal matrix T. Only referenced by c sseupd if RVEC = .TRUE. See Remarks. c ------------------------------------------------------------- c c INFO Integer. (OUTPUT) c Error flag on output. c = 0: Normal exit. c = -1: N must be positive. c = -2: NEV must be positive. c = -3: NCV must be greater than NEV and less than or equal to N. c = -5: WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'. c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work WORKL array is not sufficient. c = -8: Error return from trid. eigenvalue calculation; c Information error from LAPACK routine ssteqr. c = -9: Starting vector is zero. c = -10: IPARAM(7) must be 1,2,3,4,5. c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible. c = -12: NEV and WHICH = 'BE' are incompatible. c = -14: SSAUPD did not find any eigenvalues to sufficient c accuracy. c = -15: HOWMNY must be one of 'A' or 'S' if RVEC = .true. c = -16: HOWMNY = 'S' not yet implemented c = -17: SSEUPD got a different count of the number of converged c Ritz values than SSAUPD got. This indicates the user c probably made an error in passing data from SSAUPD to c SSEUPD or that the data was modified before entering c SSEUPD. c c\BeginLib c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall, c 1980. c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program", c Computer Physics Communications, 53 (1989), pp 169-179. c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to c Implement the Spectral Transformation", Math. Comp., 48 (1987), c pp 663-673. c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems", c SIAM J. Matr. Anal. Apps., January (1993). c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines c for Updating the QR decomposition", ACM TOMS, December 1990, c Volume 16 Number 4, pp 369-377. c c\Remarks c 1. The converged Ritz values are always returned in increasing c (algebraic) order. c c 2. Currently only HOWMNY = 'A' is implemented. It is included at this c stage for the user who wants to incorporate it. c c\Routines called: c ssesrt ARPACK routine that sorts an array X, and applies the c corresponding permutation to a matrix A. c ssortr ssortr ARPACK sorting routine. c ivout ARPACK utility routine that prints integers. c svout ARPACK utility routine that prints vectors. c sgeqr2 LAPACK routine that computes the QR factorization of c a matrix. c slacpy LAPACK matrix copy routine. c slamch LAPACK routine that determines machine constants. c sorm2r LAPACK routine that applies an orthogonal matrix in c factored form. c ssteqr LAPACK routine that computes eigenvalues and eigenvectors c of a tridiagonal matrix. c sger Level 2 BLAS rank one update to a matrix. c scopy Level 1 BLAS that copies one vector to another . c snrm2 Level 1 BLAS that computes the norm of a vector. c sscal Level 1 BLAS that scales a vector. c sswap Level 1 BLAS that swaps the contents of two vectors. c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Chao Yang Houston, Texas c Dept. of Computational & c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/15/93: Version ' 2.1' c c\SCCS Information: @(#) c FILE: seupd.F SID: 2.11 DATE OF SID: 04/10/01 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- subroutine sseupd(rvec , howmny, select, d , & z , ldz , sigma , bmat , & n , which , nev , tol , & resid , ncv , v , ldv , & iparam, ipntr , workd , workl, & lworkl, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat, howmny, which*2 logical rvec integer info, ldz, ldv, lworkl, n, ncv, nev Real & sigma, tol c c %-----------------% c | Array Arguments | c %-----------------% c integer iparam(7), ipntr(11) logical select(ncv) Real & d(nev) , resid(n) , v(ldv,ncv), & z(ldz, nev), workd(2*n), workl(lworkl) c c %------------% c | Parameters | c %------------% c Real & one, zero parameter (one = 1.0E+0 , zero = 0.0E+0 ) c c %---------------% c | Local Scalars | c %---------------% c character type*6 integer bounds , ierr , ih , ihb , ihd , & iq , iw , j , k , ldh , & ldq , mode , msglvl, nconv , next , & ritz , irz , ibd , np , ishift, & leftptr, rghtptr, numcnv, jj Real & bnorm2 , rnorm, temp, temp1, eps23 logical reord c c %----------------------% c | External Subroutines | c %----------------------% c external scopy , sger , sgeqr2, slacpy, sorm2r, sscal, & ssesrt, ssteqr, sswap , svout , ivout , ssortr c c %--------------------% c | External Functions | c %--------------------% c Real & snrm2, slamch external snrm2, slamch c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic min c c %-----------------------% c | Executable Statements | c %-----------------------% c c %------------------------% c | Set default parameters | c %------------------------% c msglvl = mseupd mode = iparam(7) nconv = iparam(5) info = 0 c c %--------------% c | Quick return | c %--------------% c if (nconv .eq. 0) go to 9000 ierr = 0 c if (nconv .le. 0) ierr = -14 if (n .le. 0) ierr = -1 if (nev .le. 0) ierr = -2 if (ncv .le. nev .or. ncv .gt. n) ierr = -3 if (which .ne. 'LM' .and. & which .ne. 'SM' .and. & which .ne. 'LA' .and. & which .ne. 'SA' .and. & which .ne. 'BE') ierr = -5 if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6 if ( (howmny .ne. 'A' .and. & howmny .ne. 'P' .and. & howmny .ne. 'S') .and. rvec ) & ierr = -15 if (rvec .and. howmny .eq. 'S') ierr = -16 c if (rvec .and. lworkl .lt. ncv**2+8*ncv) ierr = -7 c if (mode .eq. 1 .or. mode .eq. 2) then type = 'REGULR' else if (mode .eq. 3 ) then type = 'SHIFTI' else if (mode .eq. 4 ) then type = 'BUCKLE' else if (mode .eq. 5 ) then type = 'CAYLEY' else ierr = -10 end if if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11 if (nev .eq. 1 .and. which .eq. 'BE') ierr = -12 c c %------------% c | Error Exit | c %------------% c if (ierr .ne. 0) then info = ierr go to 9000 end if c c %-------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | c | etc... and the remaining workspace. | c | Also update pointer to be used on output. | c | Memory is laid out as follows: | c | workl(1:2*ncv) := generated tridiagonal matrix H | c | The subdiagonal is stored in workl(2:ncv). | c | The dead spot is workl(1) but upon exiting | c | ssaupd stores the B-norm of the last residual | c | vector in workl(1). We use this !!! | c | workl(2*ncv+1:2*ncv+ncv) := ritz values | c | The wanted values are in the first NCONV spots. | c | workl(3*ncv+1:3*ncv+ncv) := computed Ritz estimates | c | The wanted values are in the first NCONV spots. | c | NOTE: workl(1:4*ncv) is set by ssaupd and is not | c | modified by sseupd. | c %-------------------------------------------------------% c c %-------------------------------------------------------% c | The following is used and set by sseupd. | c | workl(4*ncv+1:4*ncv+ncv) := used as workspace during | c | computation of the eigenvectors of H. Stores | c | the diagonal of H. Upon EXIT contains the NCV | c | Ritz values of the original system. The first | c | NCONV spots have the wanted values. If MODE = | c | 1 or 2 then will equal workl(2*ncv+1:3*ncv). | c | workl(5*ncv+1:5*ncv+ncv) := used as workspace during | c | computation of the eigenvectors of H. Stores | c | the subdiagonal of H. Upon EXIT contains the | c | NCV corresponding Ritz estimates of the | c | original system. The first NCONV spots have the | c | wanted values. If MODE = 1,2 then will equal | c | workl(3*ncv+1:4*ncv). | c | workl(6*ncv+1:6*ncv+ncv*ncv) := orthogonal Q that is | c | the eigenvector matrix for H as returned by | c | ssteqr. Not referenced if RVEC = .False. | c | Ordering follows that of workl(4*ncv+1:5*ncv) | c | workl(6*ncv+ncv*ncv+1:6*ncv+ncv*ncv+2*ncv) := | c | Workspace. Needed by ssteqr and by sseupd. | c | GRAND total of NCV*(NCV+8) locations. | c %-------------------------------------------------------% c c ih = ipntr(5) ritz = ipntr(6) bounds = ipntr(7) ldh = ncv ldq = ncv ihd = bounds + ldh ihb = ihd + ldh iq = ihb + ldh iw = iq + ldh*ncv next = iw + 2*ncv ipntr(4) = next ipntr(8) = ihd ipntr(9) = ihb ipntr(10) = iq c c %----------------------------------------% c | irz points to the Ritz values computed | c | by _seigt before exiting _saup2. | c | ibd points to the Ritz estimates | c | computed by _seigt before exiting | c | _saup2. | c %----------------------------------------% c irz = ipntr(11)+ncv ibd = irz+ncv c c c %---------------------------------% c | Set machine dependent constant. | c %---------------------------------% c eps23 = slamch('Epsilon-Machine') eps23 = eps23**(2.0E+0 / 3.0E+0 ) c c %---------------------------------------% c | RNORM is B-norm of the RESID(1:N). | c | BNORM2 is the 2 norm of B*RESID(1:N). | c | Upon exit of ssaupd WORKD(1:N) has | c | B*RESID(1:N). | c %---------------------------------------% c rnorm = workl(ih) if (bmat .eq. 'I') then bnorm2 = rnorm else if (bmat .eq. 'G') then bnorm2 = snrm2(n, workd, 1) end if c if (msglvl .gt. 2) then call svout(logfil, ncv, workl(irz), ndigit, & '_seupd: Ritz values passed in from _SAUPD.') call svout(logfil, ncv, workl(ibd), ndigit, & '_seupd: Ritz estimates passed in from _SAUPD.') end if c if (rvec) then c reord = .false. c c %---------------------------------------------------% c | Use the temporary bounds array to store indices | c | These will be used to mark the select array later | c %---------------------------------------------------% c do 10 j = 1,ncv workl(bounds+j-1) = j select(j) = .false. 10 continue c c %-------------------------------------% c | Select the wanted Ritz values. | c | Sort the Ritz values so that the | c | wanted ones appear at the tailing | c | NEV positions of workl(irr) and | c | workl(iri). Move the corresponding | c | error estimates in workl(bound) | c | accordingly. | c %-------------------------------------% c np = ncv - nev ishift = 0 call ssgets(ishift, which , nev , & np , workl(irz) , workl(bounds), & workl) c if (msglvl .gt. 2) then call svout(logfil, ncv, workl(irz), ndigit, & '_seupd: Ritz values after calling _SGETS.') call svout(logfil, ncv, workl(bounds), ndigit, & '_seupd: Ritz value indices after calling _SGETS.') end if c c %-----------------------------------------------------% c | Record indices of the converged wanted Ritz values | c | Mark the select array for possible reordering | c %-----------------------------------------------------% c numcnv = 0 do 11 j = 1,ncv temp1 = max(eps23, abs(workl(irz+ncv-j)) ) jj = workl(bounds + ncv - j) if (numcnv .lt. nconv .and. & workl(ibd+jj-1) .le. tol*temp1) then select(jj) = .true. numcnv = numcnv + 1 if (jj .gt. nev) reord = .true. endif 11 continue c c %-----------------------------------------------------------% c | Check the count (numcnv) of converged Ritz values with | c | the number (nconv) reported by _saupd. If these two | c | are different then there has probably been an error | c | caused by incorrect passing of the _saupd data. | c %-----------------------------------------------------------% c if (msglvl .gt. 2) then call ivout(logfil, 1, numcnv, ndigit, & '_seupd: Number of specified eigenvalues') call ivout(logfil, 1, nconv, ndigit, & '_seupd: Number of "converged" eigenvalues') end if c if (numcnv .ne. nconv) then info = -17 go to 9000 end if c c %-----------------------------------------------------------% c | Call LAPACK routine _steqr to compute the eigenvalues and | c | eigenvectors of the final symmetric tridiagonal matrix H. | c | Initialize the eigenvector matrix Q to the identity. | c %-----------------------------------------------------------% c call scopy(ncv-1, workl(ih+1), 1, workl(ihb), 1) call scopy(ncv, workl(ih+ldh), 1, workl(ihd), 1) c call ssteqr('Identity', ncv, workl(ihd), workl(ihb), & workl(iq) , ldq, workl(iw), ierr) c if (ierr .ne. 0) then info = -8 go to 9000 end if c if (msglvl .gt. 1) then call scopy(ncv, workl(iq+ncv-1), ldq, workl(iw), 1) call svout(logfil, ncv, workl(ihd), ndigit, & '_seupd: NCV Ritz values of the final H matrix') call svout(logfil, ncv, workl(iw), ndigit, & '_seupd: last row of the eigenvector matrix for H') end if c if (reord) then c c %---------------------------------------------% c | Reordered the eigenvalues and eigenvectors | c | computed by _steqr so that the "converged" | c | eigenvalues appear in the first NCONV | c | positions of workl(ihd), and the associated | c | eigenvectors appear in the first NCONV | c | columns. | c %---------------------------------------------% c leftptr = 1 rghtptr = ncv c if (ncv .eq. 1) go to 30 c 20 if (select(leftptr)) then c c %-------------------------------------------% c | Search, from the left, for the first Ritz | c | value that has not converged. | c %-------------------------------------------% c leftptr = leftptr + 1 c else if ( .not. select(rghtptr)) then c c %----------------------------------------------% c | Search, from the right, the first Ritz value | c | that has converged. | c %----------------------------------------------% c rghtptr = rghtptr - 1 c else c c %----------------------------------------------% c | Swap the Ritz value on the left that has not | c | converged with the Ritz value on the right | c | that has converged. Swap the associated | c | eigenvector of the tridiagonal matrix H as | c | well. | c %----------------------------------------------% c temp = workl(ihd+leftptr-1) workl(ihd+leftptr-1) = workl(ihd+rghtptr-1) workl(ihd+rghtptr-1) = temp call scopy(ncv, workl(iq+ncv*(leftptr-1)), 1, & workl(iw), 1) call scopy(ncv, workl(iq+ncv*(rghtptr-1)), 1, & workl(iq+ncv*(leftptr-1)), 1) call scopy(ncv, workl(iw), 1, & workl(iq+ncv*(rghtptr-1)), 1) leftptr = leftptr + 1 rghtptr = rghtptr - 1 c end if c if (leftptr .lt. rghtptr) go to 20 c 30 end if c if (msglvl .gt. 2) then call svout (logfil, ncv, workl(ihd), ndigit, & '_seupd: The eigenvalues of H--reordered') end if c c %----------------------------------------% c | Load the converged Ritz values into D. | c %----------------------------------------% c call scopy(nconv, workl(ihd), 1, d, 1) c else c c %-----------------------------------------------------% c | Ritz vectors not required. Load Ritz values into D. | c %-----------------------------------------------------% c call scopy(nconv, workl(ritz), 1, d, 1) call scopy(ncv, workl(ritz), 1, workl(ihd), 1) c end if c c %------------------------------------------------------------------% c | Transform the Ritz values and possibly vectors and corresponding | c | Ritz estimates of OP to those of A*x=lambda*B*x. The Ritz values | c | (and corresponding data) are returned in ascending order. | c %------------------------------------------------------------------% c if (type .eq. 'REGULR') then c c %---------------------------------------------------------% c | Ascending sort of wanted Ritz values, vectors and error | c | bounds. Not necessary if only Ritz values are desired. | c %---------------------------------------------------------% c if (rvec) then call ssesrt('LA', rvec , nconv, d, ncv, workl(iq), ldq) else call scopy(ncv, workl(bounds), 1, workl(ihb), 1) end if c else c c %-------------------------------------------------------------% c | * Make a copy of all the Ritz values. | c | * Transform the Ritz values back to the original system. | c | For TYPE = 'SHIFTI' the transformation is | c | lambda = 1/theta + sigma | c | For TYPE = 'BUCKLE' the transformation is | c | lambda = sigma * theta / ( theta - 1 ) | c | For TYPE = 'CAYLEY' the transformation is | c | lambda = sigma * (theta + 1) / (theta - 1 ) | c | where the theta are the Ritz values returned by ssaupd. | c | NOTES: | c | *The Ritz vectors are not affected by the transformation. | c | They are only reordered. | c %-------------------------------------------------------------% c call scopy (ncv, workl(ihd), 1, workl(iw), 1) if (type .eq. 'SHIFTI') then do 40 k=1, ncv workl(ihd+k-1) = one / workl(ihd+k-1) + sigma 40 continue else if (type .eq. 'BUCKLE') then do 50 k=1, ncv workl(ihd+k-1) = sigma * workl(ihd+k-1) / & (workl(ihd+k-1) - one) 50 continue else if (type .eq. 'CAYLEY') then do 60 k=1, ncv workl(ihd+k-1) = sigma * (workl(ihd+k-1) + one) / & (workl(ihd+k-1) - one) 60 continue end if c c %-------------------------------------------------------------% c | * Store the wanted NCONV lambda values into D. | c | * Sort the NCONV wanted lambda in WORKL(IHD:IHD+NCONV-1) | c | into ascending order and apply sort to the NCONV theta | c | values in the transformed system. We will need this to | c | compute Ritz estimates in the original system. | c | * Finally sort the lambda`s into ascending order and apply | c | to Ritz vectors if wanted. Else just sort lambda`s into | c | ascending order. | c | NOTES: | c | *workl(iw:iw+ncv-1) contain the theta ordered so that they | c | match the ordering of the lambda. We`ll use them again for | c | Ritz vector purification. | c %-------------------------------------------------------------% c call scopy(nconv, workl(ihd), 1, d, 1) call ssortr('LA', .true., nconv, workl(ihd), workl(iw)) if (rvec) then call ssesrt('LA', rvec , nconv, d, ncv, workl(iq), ldq) else call scopy(ncv, workl(bounds), 1, workl(ihb), 1) call sscal(ncv, bnorm2/rnorm, workl(ihb), 1) call ssortr('LA', .true., nconv, d, workl(ihb)) end if c end if c c %------------------------------------------------% c | Compute the Ritz vectors. Transform the wanted | c | eigenvectors of the symmetric tridiagonal H by | c | the Lanczos basis matrix V. | c %------------------------------------------------% c if (rvec .and. howmny .eq. 'A') then c c %----------------------------------------------------------% c | Compute the QR factorization of the matrix representing | c | the wanted invariant subspace located in the first NCONV | c | columns of workl(iq,ldq). | c %----------------------------------------------------------% c call sgeqr2(ncv, nconv , workl(iq) , & ldq, workl(iw+ncv), workl(ihb), & ierr) c c %--------------------------------------------------------% c | * Postmultiply V by Q. | c | * Copy the first NCONV columns of VQ into Z. | c | The N by NCONV matrix Z is now a matrix representation | c | of the approximate invariant subspace associated with | c | the Ritz values in workl(ihd). | c %--------------------------------------------------------% c call sorm2r('Right', 'Notranspose', n , & ncv , nconv , workl(iq), & ldq , workl(iw+ncv), v , & ldv , workd(n+1) , ierr) call slacpy('All', n, nconv, v, ldv, z, ldz) c c %-----------------------------------------------------% c | In order to compute the Ritz estimates for the Ritz | c | values in both systems, need the last row of the | c | eigenvector matrix. Remember, it`s in factored form | c %-----------------------------------------------------% c do 65 j = 1, ncv-1 workl(ihb+j-1) = zero 65 continue workl(ihb+ncv-1) = one call sorm2r('Left', 'Transpose' , ncv , & 1 , nconv , workl(iq) , & ldq , workl(iw+ncv), workl(ihb), & ncv , temp , ierr) c else if (rvec .and. howmny .eq. 'S') then c c Not yet implemented. See remark 2 above. c end if c if (type .eq. 'REGULR' .and. rvec) then c do 70 j=1, ncv workl(ihb+j-1) = rnorm * abs( workl(ihb+j-1) ) 70 continue c else if (type .ne. 'REGULR' .and. rvec) then c c %-------------------------------------------------% c | * Determine Ritz estimates of the theta. | c | If RVEC = .true. then compute Ritz estimates | c | of the theta. | c | If RVEC = .false. then copy Ritz estimates | c | as computed by ssaupd. | c | * Determine Ritz estimates of the lambda. | c %-------------------------------------------------% c call sscal (ncv, bnorm2, workl(ihb), 1) if (type .eq. 'SHIFTI') then c do 80 k=1, ncv workl(ihb+k-1) = abs( workl(ihb+k-1) ) & / workl(iw+k-1)**2 80 continue c else if (type .eq. 'BUCKLE') then c do 90 k=1, ncv workl(ihb+k-1) = sigma * abs( workl(ihb+k-1) ) & / (workl(iw+k-1)-one )**2 90 continue c else if (type .eq. 'CAYLEY') then c do 100 k=1, ncv workl(ihb+k-1) = abs( workl(ihb+k-1) & / workl(iw+k-1)*(workl(iw+k-1)-one) ) 100 continue c end if c end if c if (type .ne. 'REGULR' .and. msglvl .gt. 1) then call svout(logfil, nconv, d, ndigit, & '_seupd: Untransformed converged Ritz values') call svout(logfil, nconv, workl(ihb), ndigit, & '_seupd: Ritz estimates of the untransformed Ritz values') else if (msglvl .gt. 1) then call svout(logfil, nconv, d, ndigit, & '_seupd: Converged Ritz values') call svout(logfil, nconv, workl(ihb), ndigit, & '_seupd: Associated Ritz estimates') end if c c %-------------------------------------------------% c | Ritz vector purification step. Formally perform | c | one of inverse subspace iteration. Only used | c | for MODE = 3,4,5. See reference 7 | c %-------------------------------------------------% c if (rvec .and. (type .eq. 'SHIFTI' .or. type .eq. 'CAYLEY')) then c do 110 k=0, nconv-1 workl(iw+k) = workl(iq+k*ldq+ncv-1) & / workl(iw+k) 110 continue c else if (rvec .and. type .eq. 'BUCKLE') then c do 120 k=0, nconv-1 workl(iw+k) = workl(iq+k*ldq+ncv-1) & / (workl(iw+k)-one) 120 continue c end if c if (type .ne. 'REGULR') & call sger (n, nconv, one, resid, 1, workl(iw), 1, z, ldz) c 9000 continue c return c c %---------------% c | End of sseupd| c %---------------% c end getdp-2.7.0-source/contrib/Arpack/icnteq.f000644 001750 001750 00000000604 11266605602 022100 0ustar00geuzainegeuzaine000000 000000 c c----------------------------------------------------------------------- c c Count the number of elements equal to a specified integer value. c integer function icnteq (n, array, value) c integer n, value integer array(*) c k = 0 do 10 i = 1, n if (array(i) .eq. value) k = k + 1 10 continue icnteq = k c return end getdp-2.7.0-source/contrib/Arpack/dsaup2.f000644 001750 001750 00000077127 11266605602 022031 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: dsaup2 c c\Description: c Intermediate level interface called by dsaupd. c c\Usage: c call dsaup2 c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD, c ISHIFT, MXITER, V, LDV, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL, c IPNTR, WORKD, INFO ) c c\Arguments c c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in dsaupd. c MODE, ISHIFT, MXITER: see the definition of IPARAM in dsaupd. c c NP Integer. (INPUT/OUTPUT) c Contains the number of implicit shifts to apply during c each Arnoldi/Lanczos iteration. c If ISHIFT=1, NP is adjusted dynamically at each iteration c to accelerate convergence and prevent stagnation. c This is also roughly equal to the number of matrix-vector c products (involving the operator OP) per Arnoldi iteration. c The logic for adjusting is contained within the current c subroutine. c If ISHIFT=0, NP is the number of shifts the user needs c to provide via reverse comunication. 0 < NP < NCV-NEV. c NP may be less than NCV-NEV since a leading block of the current c upper Tridiagonal matrix has split off and contains "unwanted" c Ritz values. c Upon termination of the IRA iteration, NP contains the number c of "converged" wanted Ritz values. c c IUPD Integer. (INPUT) c IUPD .EQ. 0: use explicit restart instead implicit update. c IUPD .NE. 0: use implicit update. c c V Double precision N by (NEV+NP) array. (INPUT/OUTPUT) c The Lanczos basis vectors. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Double precision (NEV+NP) by 2 array. (OUTPUT) c H is used to store the generated symmetric tridiagonal matrix c The subdiagonal is stored in the first column of H starting c at H(2,1). The main diagonal is stored in the second column c of H starting at H(1,2). If dsaup2 converges store the c B-norm of the final residual vector in H(1,1). c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RITZ Double precision array of length NEV+NP. (OUTPUT) c RITZ(1:NEV) contains the computed Ritz values of OP. c c BOUNDS Double precision array of length NEV+NP. (OUTPUT) c BOUNDS(1:NEV) contain the error bounds corresponding to RITZ. c c Q Double precision (NEV+NP) by (NEV+NP) array. (WORKSPACE) c Private (replicated) work array used to accumulate the c rotation in the shift application step. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKL Double precision array of length at least 3*(NEV+NP). (INPUT/WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. It is used in the computation of the c tridiagonal eigenvalue problem, the calculation and c application of the shifts and convergence checking. c If ISHIFT .EQ. O and IDO .EQ. 3, the first NP locations c of WORKL are used in reverse communication to hold the user c supplied shifts. c c IPNTR Integer array of length 3. (OUTPUT) c Pointer to mark the starting locations in the WORKD for c vectors used by the Lanczos iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. c IPNTR(3): pointer to the vector B * X when used in one of c the spectral transformation modes. X is the current c operand. c ------------------------------------------------------------- c c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Lanczos iteration c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration !!!!!!!!!! c See Data Distribution Note in dsaupd. c c INFO Integer. (INPUT/OUTPUT) c If INFO .EQ. 0, a randomly initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c Error flag on output. c = 0: Normal return. c = 1: All possible eigenvalues of OP has been found. c NP returns the size of the invariant subspace c spanning the operator OP. c = 2: No shifts could be applied. c = -8: Error return from trid. eigenvalue calculation; c This should never happen. c = -9: Starting vector is zero. c = -9999: Could not build an Lanczos factorization. c Size that was built in returned in NP. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall, c 1980. c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program", c Computer Physics Communications, 53 (1989), pp 169-179. c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to c Implement the Spectral Transformation", Math. Comp., 48 (1987), c pp 663-673. c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems", c SIAM J. Matr. Anal. Apps., January (1993). c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines c for Updating the QR decomposition", ACM TOMS, December 1990, c Volume 16 Number 4, pp 369-377. c c\Routines called: c dgetv0 ARPACK initial vector generation routine. c dsaitr ARPACK Lanczos factorization routine. c dsapps ARPACK application of implicit shifts routine. c dsconv ARPACK convergence of Ritz values routine. c dseigt ARPACK compute Ritz values and error bounds routine. c dsgets ARPACK reorder Ritz values and error bounds routine. c dsortr ARPACK sorting routine. c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c dvout ARPACK utility routine that prints vectors. c dlamch LAPACK routine that determines machine constants. c dcopy Level 1 BLAS that copies one vector to another. c ddot Level 1 BLAS that computes the scalar product of two vectors. c dnrm2 Level 1 BLAS that computes the norm of a vector. c dscal Level 1 BLAS that scales a vector. c dswap Level 1 BLAS that swaps two vectors. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/15/93: Version ' 2.4' c xx/xx/95: Version ' 2.4'. (R.B. Lehoucq) c c\SCCS Information: @(#) c FILE: saup2.F SID: 2.7 DATE OF SID: 5/19/98 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine dsaup2 & ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd, & ishift, mxiter, v, ldv, h, ldh, ritz, bounds, & q, ldq, workl, ipntr, workd, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1, which*2 integer ido, info, ishift, iupd, ldh, ldq, ldv, mxiter, & n, mode, nev, np Double precision & tol c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(3) Double precision & bounds(nev+np), h(ldh,2), q(ldq,nev+np), resid(n), & ritz(nev+np), v(ldv,nev+np), workd(3*n), & workl(3*(nev+np)) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c character wprime*2 logical cnorm, getv0, initv, update, ushift integer ierr, iter, j, kplusp, msglvl, nconv, nevbef, nev0, & np0, nptemp, nevd2, nevm2, kp(3) Double precision & rnorm, temp, eps23 save cnorm, getv0, initv, update, ushift, & iter, kplusp, msglvl, nconv, nev0, np0, & rnorm, eps23 c c %----------------------% c | External Subroutines | c %----------------------% c external dcopy, dgetv0, dsaitr, dscal, dsconv, dseigt, dsgets, & dsapps, dsortr, dvout, ivout, second, dswap c c %--------------------% c | External Functions | c %--------------------% c Double precision & ddot, dnrm2, dlamch external ddot, dnrm2, dlamch c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic min c c %-----------------------% c | Executable Statements | c %-----------------------% c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = msaup2 c c %---------------------------------% c | Set machine dependent constant. | c %---------------------------------% c eps23 = dlamch('Epsilon-Machine') eps23 = eps23**(2.0D+0/3.0D+0) c c %-------------------------------------% c | nev0 and np0 are integer variables | c | hold the initial values of NEV & NP | c %-------------------------------------% c nev0 = nev np0 = np c c %-------------------------------------% c | kplusp is the bound on the largest | c | Lanczos factorization built. | c | nconv is the current number of | c | "converged" eigenvlues. | c | iter is the counter on the current | c | iteration step. | c %-------------------------------------% c kplusp = nev0 + np0 nconv = 0 iter = 0 c c %--------------------------------------------% c | Set flags for computing the first NEV steps | c | of the Lanczos factorization. | c %--------------------------------------------% c getv0 = .true. update = .false. ushift = .false. cnorm = .false. c if (info .ne. 0) then c c %--------------------------------------------% c | User provides the initial residual vector. | c %--------------------------------------------% c initv = .true. info = 0 else initv = .false. end if end if c c %---------------------------------------------% c | Get a possibly random starting vector and | c | force it into the range of the operator OP. | c %---------------------------------------------% c 10 continue c if (getv0) then call dgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, rnorm, & ipntr, workd, info) c if (ido .ne. 99) go to 9000 c if (rnorm .eq. zero) then c c %-----------------------------------------% c | The initial vector is zero. Error exit. | c %-----------------------------------------% c info = -9 go to 1200 end if getv0 = .false. ido = 0 end if c c %------------------------------------------------------------% c | Back from reverse communication: continue with update step | c %------------------------------------------------------------% c if (update) go to 20 c c %-------------------------------------------% c | Back from computing user specified shifts | c %-------------------------------------------% c if (ushift) go to 50 c c %-------------------------------------% c | Back from computing residual norm | c | at the end of the current iteration | c %-------------------------------------% c if (cnorm) go to 100 c c %----------------------------------------------------------% c | Compute the first NEV steps of the Lanczos factorization | c %----------------------------------------------------------% c call dsaitr (ido, bmat, n, 0, nev0, mode, resid, rnorm, v, ldv, & h, ldh, ipntr, workd, info) c c %---------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP and possibly B | c %---------------------------------------------------% c if (ido .ne. 99) go to 9000 c if (info .gt. 0) then c c %-----------------------------------------------------% c | dsaitr was unable to build an Lanczos factorization | c | of length NEV0. INFO is returned with the size of | c | the factorization built. Exit main loop. | c %-----------------------------------------------------% c np = info mxiter = iter info = -9999 go to 1200 end if c c %--------------------------------------------------------------% c | | c | M A I N LANCZOS I T E R A T I O N L O O P | c | Each iteration implicitly restarts the Lanczos | c | factorization in place. | c | | c %--------------------------------------------------------------% c 1000 continue c iter = iter + 1 c if (msglvl .gt. 0) then call ivout (logfil, 1, iter, ndigit, & '_saup2: **** Start of major iteration number ****') end if if (msglvl .gt. 1) then call ivout (logfil, 1, nev, ndigit, & '_saup2: The length of the current Lanczos factorization') call ivout (logfil, 1, np, ndigit, & '_saup2: Extend the Lanczos factorization by') end if c c %------------------------------------------------------------% c | Compute NP additional steps of the Lanczos factorization. | c %------------------------------------------------------------% c ido = 0 20 continue update = .true. c call dsaitr (ido, bmat, n, nev, np, mode, resid, rnorm, v, & ldv, h, ldh, ipntr, workd, info) c c %---------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP and possibly B | c %---------------------------------------------------% c if (ido .ne. 99) go to 9000 c if (info .gt. 0) then c c %-----------------------------------------------------% c | dsaitr was unable to build an Lanczos factorization | c | of length NEV0+NP0. INFO is returned with the size | c | of the factorization built. Exit main loop. | c %-----------------------------------------------------% c np = info mxiter = iter info = -9999 go to 1200 end if update = .false. c if (msglvl .gt. 1) then call dvout (logfil, 1, rnorm, ndigit, & '_saup2: Current B-norm of residual for factorization') end if c c %--------------------------------------------------------% c | Compute the eigenvalues and corresponding error bounds | c | of the current symmetric tridiagonal matrix. | c %--------------------------------------------------------% c call dseigt (rnorm, kplusp, h, ldh, ritz, bounds, workl, ierr) c if (ierr .ne. 0) then info = -8 go to 1200 end if c c %----------------------------------------------------% c | Make a copy of eigenvalues and corresponding error | c | bounds obtained from _seigt. | c %----------------------------------------------------% c call dcopy(kplusp, ritz, 1, workl(kplusp+1), 1) call dcopy(kplusp, bounds, 1, workl(2*kplusp+1), 1) c c %---------------------------------------------------% c | Select the wanted Ritz values and their bounds | c | to be used in the convergence test. | c | The selection is based on the requested number of | c | eigenvalues instead of the current NEV and NP to | c | prevent possible misconvergence. | c | * Wanted Ritz values := RITZ(NP+1:NEV+NP) | c | * Shifts := RITZ(1:NP) := WORKL(1:NP) | c %---------------------------------------------------% c nev = nev0 np = np0 call dsgets (ishift, which, nev, np, ritz, bounds, workl) c c %-------------------% c | Convergence test. | c %-------------------% c call dcopy (nev, bounds(np+1), 1, workl(np+1), 1) call dsconv (nev, ritz(np+1), workl(np+1), tol, nconv) c if (msglvl .gt. 2) then kp(1) = nev kp(2) = np kp(3) = nconv call ivout (logfil, 3, kp, ndigit, & '_saup2: NEV, NP, NCONV are') call dvout (logfil, kplusp, ritz, ndigit, & '_saup2: The eigenvalues of H') call dvout (logfil, kplusp, bounds, ndigit, & '_saup2: Ritz estimates of the current NCV Ritz values') end if c c %---------------------------------------------------------% c | Count the number of unwanted Ritz values that have zero | c | Ritz estimates. If any Ritz estimates are equal to zero | c | then a leading block of H of order equal to at least | c | the number of Ritz values with zero Ritz estimates has | c | split off. None of these Ritz values may be removed by | c | shifting. Decrease NP the number of shifts to apply. If | c | no shifts may be applied, then prepare to exit | c %---------------------------------------------------------% c nptemp = np do 30 j=1, nptemp if (bounds(j) .eq. zero) then np = np - 1 nev = nev + 1 end if 30 continue c if ( (nconv .ge. nev0) .or. & (iter .gt. mxiter) .or. & (np .eq. 0) ) then c c %------------------------------------------------% c | Prepare to exit. Put the converged Ritz values | c | and corresponding bounds in RITZ(1:NCONV) and | c | BOUNDS(1:NCONV) respectively. Then sort. Be | c | careful when NCONV > NP since we don't want to | c | swap overlapping locations. | c %------------------------------------------------% c if (which .eq. 'BE') then c c %-----------------------------------------------------% c | Both ends of the spectrum are requested. | c | Sort the eigenvalues into algebraically decreasing | c | order first then swap low end of the spectrum next | c | to high end in appropriate locations. | c | NOTE: when np < floor(nev/2) be careful not to swap | c | overlapping locations. | c %-----------------------------------------------------% c wprime = 'SA' call dsortr (wprime, .true., kplusp, ritz, bounds) nevd2 = nev0 / 2 nevm2 = nev0 - nevd2 if ( nev .gt. 1 ) then call dswap ( min(nevd2,np), ritz(nevm2+1), 1, & ritz( max(kplusp-nevd2+1,kplusp-np+1) ), 1) call dswap ( min(nevd2,np), bounds(nevm2+1), 1, & bounds( max(kplusp-nevd2+1,kplusp-np+1)), 1) end if c else c c %--------------------------------------------------% c | LM, SM, LA, SA case. | c | Sort the eigenvalues of H into the an order that | c | is opposite to WHICH, and apply the resulting | c | order to BOUNDS. The eigenvalues are sorted so | c | that the wanted part are always within the first | c | NEV locations. | c %--------------------------------------------------% c if (which .eq. 'LM') wprime = 'SM' if (which .eq. 'SM') wprime = 'LM' if (which .eq. 'LA') wprime = 'SA' if (which .eq. 'SA') wprime = 'LA' c call dsortr (wprime, .true., kplusp, ritz, bounds) c end if c c %--------------------------------------------------% c | Scale the Ritz estimate of each Ritz value | c | by 1 / max(eps23,magnitude of the Ritz value). | c %--------------------------------------------------% c do 35 j = 1, nev0 temp = max( eps23, abs(ritz(j)) ) bounds(j) = bounds(j)/temp 35 continue c c %----------------------------------------------------% c | Sort the Ritz values according to the scaled Ritz | c | esitmates. This will push all the converged ones | c | towards the front of ritzr, ritzi, bounds | c | (in the case when NCONV < NEV.) | c %----------------------------------------------------% c wprime = 'LA' call dsortr(wprime, .true., nev0, bounds, ritz) c c %----------------------------------------------% c | Scale the Ritz estimate back to its original | c | value. | c %----------------------------------------------% c do 40 j = 1, nev0 temp = max( eps23, abs(ritz(j)) ) bounds(j) = bounds(j)*temp 40 continue c c %--------------------------------------------------% c | Sort the "converged" Ritz values again so that | c | the "threshold" values and their associated Ritz | c | estimates appear at the appropriate position in | c | ritz and bound. | c %--------------------------------------------------% c if (which .eq. 'BE') then c c %------------------------------------------------% c | Sort the "converged" Ritz values in increasing | c | order. The "threshold" values are in the | c | middle. | c %------------------------------------------------% c wprime = 'LA' call dsortr(wprime, .true., nconv, ritz, bounds) c else c c %----------------------------------------------% c | In LM, SM, LA, SA case, sort the "converged" | c | Ritz values according to WHICH so that the | c | "threshold" value appears at the front of | c | ritz. | c %----------------------------------------------% call dsortr(which, .true., nconv, ritz, bounds) c end if c c %------------------------------------------% c | Use h( 1,1 ) as storage to communicate | c | rnorm to _seupd if needed | c %------------------------------------------% c h(1,1) = rnorm c if (msglvl .gt. 1) then call dvout (logfil, kplusp, ritz, ndigit, & '_saup2: Sorted Ritz values.') call dvout (logfil, kplusp, bounds, ndigit, & '_saup2: Sorted ritz estimates.') end if c c %------------------------------------% c | Max iterations have been exceeded. | c %------------------------------------% c if (iter .gt. mxiter .and. nconv .lt. nev) info = 1 c c %---------------------% c | No shifts to apply. | c %---------------------% c if (np .eq. 0 .and. nconv .lt. nev0) info = 2 c np = nconv go to 1100 c else if (nconv .lt. nev .and. ishift .eq. 1) then c c %---------------------------------------------------% c | Do not have all the requested eigenvalues yet. | c | To prevent possible stagnation, adjust the number | c | of Ritz values and the shifts. | c %---------------------------------------------------% c nevbef = nev nev = nev + min (nconv, np/2) if (nev .eq. 1 .and. kplusp .ge. 6) then nev = kplusp / 2 else if (nev .eq. 1 .and. kplusp .gt. 2) then nev = 2 end if np = kplusp - nev c c %---------------------------------------% c | If the size of NEV was just increased | c | resort the eigenvalues. | c %---------------------------------------% c if (nevbef .lt. nev) & call dsgets (ishift, which, nev, np, ritz, bounds, & workl) c end if c if (msglvl .gt. 0) then call ivout (logfil, 1, nconv, ndigit, & '_saup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev kp(2) = np call ivout (logfil, 2, kp, ndigit, & '_saup2: NEV and NP are') call dvout (logfil, nev, ritz(np+1), ndigit, & '_saup2: "wanted" Ritz values.') call dvout (logfil, nev, bounds(np+1), ndigit, & '_saup2: Ritz estimates of the "wanted" values ') end if end if c if (ishift .eq. 0) then c c %-----------------------------------------------------% c | User specified shifts: reverse communication to | c | compute the shifts. They are returned in the first | c | NP locations of WORKL. | c %-----------------------------------------------------% c ushift = .true. ido = 3 go to 9000 end if c 50 continue c c %------------------------------------% c | Back from reverse communication; | c | User specified shifts are returned | c | in WORKL(1:*NP) | c %------------------------------------% c ushift = .false. c c c %---------------------------------------------------------% c | Move the NP shifts to the first NP locations of RITZ to | c | free up WORKL. This is for the non-exact shift case; | c | in the exact shift case, dsgets already handles this. | c %---------------------------------------------------------% c if (ishift .eq. 0) call dcopy (np, workl, 1, ritz, 1) c if (msglvl .gt. 2) then call ivout (logfil, 1, np, ndigit, & '_saup2: The number of shifts to apply ') call dvout (logfil, np, workl, ndigit, & '_saup2: shifts selected') if (ishift .eq. 1) then call dvout (logfil, np, bounds, ndigit, & '_saup2: corresponding Ritz estimates') end if end if c c %---------------------------------------------------------% c | Apply the NP0 implicit shifts by QR bulge chasing. | c | Each shift is applied to the entire tridiagonal matrix. | c | The first 2*N locations of WORKD are used as workspace. | c | After dsapps is done, we have a Lanczos | c | factorization of length NEV. | c %---------------------------------------------------------% c call dsapps (n, nev, np, ritz, v, ldv, h, ldh, resid, q, ldq, & workd) c c %---------------------------------------------% c | Compute the B-norm of the updated residual. | c | Keep B*RESID in WORKD(1:N) to be used in | c | the first step of the next call to dsaitr. | c %---------------------------------------------% c cnorm = .true. call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(n+1), 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 c c %----------------------------------% c | Exit in order to compute B*RESID | c %----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd, 1) end if c 100 continue c c %----------------------------------% c | Back from reverse communication; | c | WORKD(1:N) := B*RESID | c %----------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c if (bmat .eq. 'G') then rnorm = ddot (n, resid, 1, workd, 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then rnorm = dnrm2(n, resid, 1) end if cnorm = .false. 130 continue c if (msglvl .gt. 2) then call dvout (logfil, 1, rnorm, ndigit, & '_saup2: B-norm of residual for NEV factorization') call dvout (logfil, nev, h(1,2), ndigit, & '_saup2: main diagonal of compressed H matrix') call dvout (logfil, nev-1, h(2,1), ndigit, & '_saup2: subdiagonal of compressed H matrix') end if c go to 1000 c c %---------------------------------------------------------------% c | | c | E N D O F M A I N I T E R A T I O N L O O P | c | | c %---------------------------------------------------------------% c 1100 continue c mxiter = iter nev = nconv c 1200 continue ido = 99 c c %------------% c | Error exit | c %------------% c call second (t1) tsaup2 = t1 - t0 c 9000 continue return c c %---------------% c | End of dsaup2 | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/cneupd.f000644 001750 001750 00000103756 11266605602 022107 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: cneupd c c\Description: c This subroutine returns the converged approximations to eigenvalues c of A*z = lambda*B*z and (optionally): c c (1) The corresponding approximate eigenvectors; c c (2) An orthonormal basis for the associated approximate c invariant subspace; c c (3) Both. c c There is negligible additional cost to obtain eigenvectors. An orthonormal c basis is always computed. There is an additional storage cost of n*nev c if both are requested (in this case a separate array Z must be supplied). c c The approximate eigenvalues and eigenvectors of A*z = lambda*B*z c are derived from approximate eigenvalues and eigenvectors of c of the linear operator OP prescribed by the MODE selection in the c call to CNAUPD. CNAUPD must be called before this routine is called. c These approximate eigenvalues and vectors are commonly called Ritz c values and Ritz vectors respectively. They are referred to as such c in the comments that follow. The computed orthonormal basis for the c invariant subspace corresponding to these Ritz values is referred to as a c Schur basis. c c The definition of OP as well as other terms and the relation of computed c Ritz values and vectors of OP with respect to the given problem c A*z = lambda*B*z may be found in the header of CNAUPD. For a brief c description, see definitions of IPARAM(7), MODE and WHICH in the c documentation of CNAUPD. c c\Usage: c call cneupd c ( RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, WORKEV, BMAT, c N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, c WORKL, LWORKL, RWORK, INFO ) c c\Arguments: c RVEC LOGICAL (INPUT) c Specifies whether a basis for the invariant subspace corresponding c to the converged Ritz value approximations for the eigenproblem c A*z = lambda*B*z is computed. c c RVEC = .FALSE. Compute Ritz values only. c c RVEC = .TRUE. Compute Ritz vectors or Schur vectors. c See Remarks below. c c HOWMNY Character*1 (INPUT) c Specifies the form of the basis for the invariant subspace c corresponding to the converged Ritz values that is to be computed. c c = 'A': Compute NEV Ritz vectors; c = 'P': Compute NEV Schur vectors; c = 'S': compute some of the Ritz vectors, specified c by the logical array SELECT. c c SELECT Logical array of dimension NCV. (INPUT) c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be c computed. To select the Ritz vector corresponding to a c Ritz value D(j), SELECT(j) must be set to .TRUE.. c If HOWMNY = 'A' or 'P', SELECT need not be initialized c but it is used as internal workspace. c c D Complex array of dimension NEV+1. (OUTPUT) c On exit, D contains the Ritz approximations c to the eigenvalues lambda for A*z = lambda*B*z. c c Z Complex N by NEV array (OUTPUT) c On exit, if RVEC = .TRUE. and HOWMNY = 'A', then the columns of c Z represents approximate eigenvectors (Ritz vectors) corresponding c to the NCONV=IPARAM(5) Ritz values for eigensystem c A*z = lambda*B*z. c c If RVEC = .FALSE. or HOWMNY = 'P', then Z is NOT REFERENCED. c c NOTE: If if RVEC = .TRUE. and a Schur basis is not required, c the array Z may be set equal to first NEV+1 columns of the Arnoldi c basis array V computed by CNAUPD. In this case the Arnoldi basis c will be destroyed and overwritten with the eigenvector basis. c c LDZ Integer. (INPUT) c The leading dimension of the array Z. If Ritz vectors are c desired, then LDZ .ge. max( 1, N ) is required. c In any case, LDZ .ge. 1 is required. c c SIGMA Complex (INPUT) c If IPARAM(7) = 3 then SIGMA represents the shift. c Not referenced if IPARAM(7) = 1 or 2. c c WORKEV Complex work array of dimension 2*NCV. (WORKSPACE) c c **** The remaining arguments MUST be the same as for the **** c **** call to CNAUPD that was just completed. **** c c NOTE: The remaining arguments c c BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, c WORKD, WORKL, LWORKL, RWORK, INFO c c must be passed directly to CNEUPD following the last call c to CNAUPD. These arguments MUST NOT BE MODIFIED between c the the last call to CNAUPD and the call to CNEUPD. c c Three of these parameters (V, WORKL and INFO) are also output parameters: c c V Complex N by NCV array. (INPUT/OUTPUT) c c Upon INPUT: the NCV columns of V contain the Arnoldi basis c vectors for OP as constructed by CNAUPD . c c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns c contain approximate Schur vectors that span the c desired invariant subspace. c c NOTE: If the array Z has been set equal to first NEV+1 columns c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the c Arnoldi basis held by V has been overwritten by the desired c Ritz vectors. If a separate array Z has been passed then c the first NCONV=IPARAM(5) columns of V will contain approximate c Schur vectors that span the desired invariant subspace. c c WORKL Real work array of length LWORKL. (OUTPUT/WORKSPACE) c WORKL(1:ncv*ncv+2*ncv) contains information obtained in c cnaupd. They are not changed by cneupd. c WORKL(ncv*ncv+2*ncv+1:3*ncv*ncv+4*ncv) holds the c untransformed Ritz values, the untransformed error estimates of c the Ritz values, the upper triangular matrix for H, and the c associated matrix representation of the invariant subspace for H. c c Note: IPNTR(9:13) contains the pointer into WORKL for addresses c of the above information computed by cneupd. c ------------------------------------------------------------- c IPNTR(9): pointer to the NCV RITZ values of the c original system. c IPNTR(10): Not used c IPNTR(11): pointer to the NCV corresponding error estimates. c IPNTR(12): pointer to the NCV by NCV upper triangular c Schur matrix for H. c IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors c of the upper Hessenberg matrix H. Only referenced by c cneupd if RVEC = .TRUE. See Remark 2 below. c ------------------------------------------------------------- c c INFO Integer. (OUTPUT) c Error flag on output. c = 0: Normal exit. c c = 1: The Schur form computed by LAPACK routine csheqr c could not be reordered by LAPACK routine ctrsen. c Re-enter subroutine cneupd with IPARAM(5)=NCV and c increase the size of the array D to have c dimension at least dimension NCV and allocate at least NCV c columns for Z. NOTE: Not necessary if Z and V share c the same space. Please notify the authors if this error c occurs. c c = -1: N must be positive. c = -2: NEV must be positive. c = -3: NCV-NEV >= 1 and less than or equal to N. c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI' c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work WORKL array is not sufficient. c = -8: Error return from LAPACK eigenvalue calculation. c This should never happened. c = -9: Error return from calculation of eigenvectors. c Informational error from LAPACK routine ctrevc. c = -10: IPARAM(7) must be 1,2,3 c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible. c = -12: HOWMNY = 'S' not yet implemented c = -13: HOWMNY must be one of 'A' or 'P' if RVEC = .true. c = -14: CNAUPD did not find any eigenvalues to sufficient c accuracy. c = -15: CNEUPD got a different count of the number of converged c Ritz values than CNAUPD got. This indicates the user c probably made an error in passing data from CNAUPD to c CNEUPD or that the data was modified before entering c CNEUPD c c\BeginLib c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B. Nour-Omid, B. N. Parlett, T. Ericsson and P. S. Jensen, c "How to Implement the Spectral Transformation", Math Comp., c Vol. 48, No. 178, April, 1987 pp. 664-673. c c\Routines called: c ivout ARPACK utility routine that prints integers. c cmout ARPACK utility routine that prints matrices c cvout ARPACK utility routine that prints vectors. c cgeqr2 LAPACK routine that computes the QR factorization of c a matrix. c clacpy LAPACK matrix copy routine. c clahqr LAPACK routine that computes the Schur form of a c upper Hessenberg matrix. c claset LAPACK matrix initialization routine. c ctrevc LAPACK routine to compute the eigenvectors of a matrix c in upper triangular form. c ctrsen LAPACK routine that re-orders the Schur form. c cunm2r LAPACK routine that applies an orthogonal matrix in c factored form. c slamch LAPACK routine that determines machine constants. c ctrmm Level 3 BLAS matrix times an upper triangular matrix. c cgeru Level 2 BLAS rank one update to a matrix. c ccopy Level 1 BLAS that copies one vector to another . c cscal Level 1 BLAS that scales a vector. c csscal Level 1 BLAS that scales a complex vector by a real number. c scnrm2 Level 1 BLAS that computes the norm of a complex vector. c c\Remarks c c 1. Currently only HOWMNY = 'A' and 'P' are implemented. c c 2. Schur vectors are an orthogonal representation for the basis of c Ritz vectors. Thus, their numerical properties are often superior. c If RVEC = .true. then the relationship c A * V(:,1:IPARAM(5)) = V(:,1:IPARAM(5)) * T, and c transpose( V(:,1:IPARAM(5)) ) * V(:,1:IPARAM(5)) = I c are approximately satisfied. c Here T is the leading submatrix of order IPARAM(5) of the c upper triangular matrix stored workl(ipntr(12)). c c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Chao Yang Houston, Texas c Dept. of Computational & c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: neupd.F SID: 2.8 DATE OF SID: 07/21/02 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- subroutine cneupd(rvec , howmny, select, d , & z , ldz , sigma , workev, & bmat , n , which , nev , & tol , resid , ncv , v , & ldv , iparam, ipntr , workd , & workl, lworkl, rwork , info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat, howmny, which*2 logical rvec integer info, ldz, ldv, lworkl, n, ncv, nev Complex & sigma Real & tol c c %-----------------% c | Array Arguments | c %-----------------% c integer iparam(11), ipntr(14) logical select(ncv) Real & rwork(ncv) Complex & d(nev) , resid(n) , v(ldv,ncv), & z(ldz, nev), & workd(3*n) , workl(lworkl), workev(2*ncv) c c %------------% c | Parameters | c %------------% c Complex & one, zero parameter (one = (1.0E+0, 0.0E+0), zero = (0.0E+0, 0.0E+0)) c c %---------------% c | Local Scalars | c %---------------% c character type*6 integer bounds, ierr , ih , ihbds, iheig , nconv , & invsub, iuptri, iwev , j , ldh , ldq , & mode , msglvl, ritz , wr , k , irz , & ibd , outncv, iq , np , numcnv, jj , & ishift Complex & rnorm, temp, vl(1) Real & conds, sep, rtemp, eps23 logical reord c c %----------------------% c | External Subroutines | c %----------------------% c external ccopy , cgeru, cgeqr2, clacpy, cmout, & cunm2r, ctrmm, cvout, ivout, & clahqr c c %--------------------% c | External Functions | c %--------------------% c Real & scnrm2, slamch, slapy2 external scnrm2, slamch, slapy2 c Complex & cdotc external cdotc c c %-----------------------% c | Executable Statements | c %-----------------------% c c %------------------------% c | Set default parameters | c %------------------------% c msglvl = mceupd mode = iparam(7) nconv = iparam(5) info = 0 c c c %---------------------------------% c | Get machine dependent constant. | c %---------------------------------% c eps23 = slamch('Epsilon-Machine') eps23 = eps23**(2.0E+0 / 3.0E+0) c c %-------------------------------% c | Quick return | c | Check for incompatible input | c %-------------------------------% c ierr = 0 c if (nconv .le. 0) then ierr = -14 else if (n .le. 0) then ierr = -1 else if (nev .le. 0) then ierr = -2 else if (ncv .le. nev .or. ncv .gt. n) then ierr = -3 else if (which .ne. 'LM' .and. & which .ne. 'SM' .and. & which .ne. 'LR' .and. & which .ne. 'SR' .and. & which .ne. 'LI' .and. & which .ne. 'SI') then ierr = -5 else if (bmat .ne. 'I' .and. bmat .ne. 'G') then ierr = -6 else if (lworkl .lt. 3*ncv**2 + 4*ncv) then ierr = -7 else if ( (howmny .ne. 'A' .and. & howmny .ne. 'P' .and. & howmny .ne. 'S') .and. rvec ) then ierr = -13 else if (howmny .eq. 'S' ) then ierr = -12 end if c if (mode .eq. 1 .or. mode .eq. 2) then type = 'REGULR' else if (mode .eq. 3 ) then type = 'SHIFTI' else ierr = -10 end if if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11 c c %------------% c | Error Exit | c %------------% c if (ierr .ne. 0) then info = ierr go to 9000 end if c c %--------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, WORKEV, Q | c | etc... and the remaining workspace. | c | Also update pointer to be used on output. | c | Memory is laid out as follows: | c | workl(1:ncv*ncv) := generated Hessenberg matrix | c | workl(ncv*ncv+1:ncv*ncv+ncv) := ritz values | c | workl(ncv*ncv+ncv+1:ncv*ncv+2*ncv) := error bounds | c %--------------------------------------------------------% c c %-----------------------------------------------------------% c | The following is used and set by CNEUPD. | c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := The untransformed | c | Ritz values. | c | workl(ncv*ncv+3*ncv+1:ncv*ncv+4*ncv) := The untransformed | c | error bounds of | c | the Ritz values | c | workl(ncv*ncv+4*ncv+1:2*ncv*ncv+4*ncv) := Holds the upper | c | triangular matrix | c | for H. | c | workl(2*ncv*ncv+4*ncv+1: 3*ncv*ncv+4*ncv) := Holds the | c | associated matrix | c | representation of | c | the invariant | c | subspace for H. | c | GRAND total of NCV * ( 3 * NCV + 4 ) locations. | c %-----------------------------------------------------------% c ih = ipntr(5) ritz = ipntr(6) iq = ipntr(7) bounds = ipntr(8) ldh = ncv ldq = ncv iheig = bounds + ldh ihbds = iheig + ldh iuptri = ihbds + ldh invsub = iuptri + ldh*ncv ipntr(9) = iheig ipntr(11) = ihbds ipntr(12) = iuptri ipntr(13) = invsub wr = 1 iwev = wr + ncv c c %-----------------------------------------% c | irz points to the Ritz values computed | c | by _neigh before exiting _naup2. | c | ibd points to the Ritz estimates | c | computed by _neigh before exiting | c | _naup2. | c %-----------------------------------------% c irz = ipntr(14) + ncv*ncv ibd = irz + ncv c c %------------------------------------% c | RNORM is B-norm of the RESID(1:N). | c %------------------------------------% c rnorm = workl(ih+2) workl(ih+2) = zero c if (msglvl .gt. 2) then call cvout(logfil, ncv, workl(irz), ndigit, & '_neupd: Ritz values passed in from _NAUPD.') call cvout(logfil, ncv, workl(ibd), ndigit, & '_neupd: Ritz estimates passed in from _NAUPD.') end if c if (rvec) then c reord = .false. c c %---------------------------------------------------% c | Use the temporary bounds array to store indices | c | These will be used to mark the select array later | c %---------------------------------------------------% c do 10 j = 1,ncv workl(bounds+j-1) = j select(j) = .false. 10 continue c c %-------------------------------------% c | Select the wanted Ritz values. | c | Sort the Ritz values so that the | c | wanted ones appear at the tailing | c | NEV positions of workl(irr) and | c | workl(iri). Move the corresponding | c | error estimates in workl(ibd) | c | accordingly. | c %-------------------------------------% c np = ncv - nev ishift = 0 call cngets(ishift, which , nev , & np , workl(irz), workl(bounds)) c if (msglvl .gt. 2) then call cvout (logfil, ncv, workl(irz), ndigit, & '_neupd: Ritz values after calling _NGETS.') call cvout (logfil, ncv, workl(bounds), ndigit, & '_neupd: Ritz value indices after calling _NGETS.') end if c c %-----------------------------------------------------% c | Record indices of the converged wanted Ritz values | c | Mark the select array for possible reordering | c %-----------------------------------------------------% c numcnv = 0 do 11 j = 1,ncv rtemp = max(eps23, & slapy2 ( real(workl(irz+ncv-j)), & aimag(workl(irz+ncv-j)) )) jj = workl(bounds + ncv - j) if (numcnv .lt. nconv .and. & slapy2( real(workl(ibd+jj-1)), & aimag(workl(ibd+jj-1)) ) & .le. tol*rtemp) then select(jj) = .true. numcnv = numcnv + 1 if (jj .gt. nev) reord = .true. endif 11 continue c c %-----------------------------------------------------------% c | Check the count (numcnv) of converged Ritz values with | c | the number (nconv) reported by dnaupd. If these two | c | are different then there has probably been an error | c | caused by incorrect passing of the dnaupd data. | c %-----------------------------------------------------------% c if (msglvl .gt. 2) then call ivout(logfil, 1, numcnv, ndigit, & '_neupd: Number of specified eigenvalues') call ivout(logfil, 1, nconv, ndigit, & '_neupd: Number of "converged" eigenvalues') end if c if (numcnv .ne. nconv) then info = -15 go to 9000 end if c c %-------------------------------------------------------% c | Call LAPACK routine clahqr to compute the Schur form | c | of the upper Hessenberg matrix returned by CNAUPD. | c | Make a copy of the upper Hessenberg matrix. | c | Initialize the Schur vector matrix Q to the identity. | c %-------------------------------------------------------% c call ccopy(ldh*ncv, workl(ih), 1, workl(iuptri), 1) call claset('All', ncv, ncv , & zero , one, workl(invsub), & ldq) call clahqr(.true., .true. , ncv , & 1 , ncv , workl(iuptri), & ldh , workl(iheig) , 1 , & ncv , workl(invsub), ldq , & ierr) call ccopy(ncv , workl(invsub+ncv-1), ldq, & workl(ihbds), 1) c if (ierr .ne. 0) then info = -8 go to 9000 end if c if (msglvl .gt. 1) then call cvout (logfil, ncv, workl(iheig), ndigit, & '_neupd: Eigenvalues of H') call cvout (logfil, ncv, workl(ihbds), ndigit, & '_neupd: Last row of the Schur vector matrix') if (msglvl .gt. 3) then call cmout (logfil , ncv, ncv , & workl(iuptri), ldh, ndigit, & '_neupd: The upper triangular matrix ') end if end if c if (reord) then c c %-----------------------------------------------% c | Reorder the computed upper triangular matrix. | c %-----------------------------------------------% c call ctrsen('None' , 'V' , select , & ncv , workl(iuptri), ldh , & workl(invsub), ldq , workl(iheig), & nconv , conds , sep , & workev , ncv , ierr) c if (ierr .eq. 1) then info = 1 go to 9000 end if c if (msglvl .gt. 2) then call cvout (logfil, ncv, workl(iheig), ndigit, & '_neupd: Eigenvalues of H--reordered') if (msglvl .gt. 3) then call cmout(logfil , ncv, ncv , & workl(iuptri), ldq, ndigit, & '_neupd: Triangular matrix after re-ordering') end if end if c end if c c %---------------------------------------------% c | Copy the last row of the Schur basis matrix | c | to workl(ihbds). This vector will be used | c | to compute the Ritz estimates of converged | c | Ritz values. | c %---------------------------------------------% c call ccopy(ncv , workl(invsub+ncv-1), ldq, & workl(ihbds), 1) c c %--------------------------------------------% c | Place the computed eigenvalues of H into D | c | if a spectral transformation was not used. | c %--------------------------------------------% c if (type .eq. 'REGULR') then call ccopy(nconv, workl(iheig), 1, d, 1) end if c c %----------------------------------------------------------% c | Compute the QR factorization of the matrix representing | c | the wanted invariant subspace located in the first NCONV | c | columns of workl(invsub,ldq). | c %----------------------------------------------------------% c call cgeqr2(ncv , nconv , workl(invsub), & ldq , workev, workev(ncv+1), & ierr) c c %--------------------------------------------------------% c | * Postmultiply V by Q using cunm2r. | c | * Copy the first NCONV columns of VQ into Z. | c | * Postmultiply Z by R. | c | The N by NCONV matrix Z is now a matrix representation | c | of the approximate invariant subspace associated with | c | the Ritz values in workl(iheig). The first NCONV | c | columns of V are now approximate Schur vectors | c | associated with the upper triangular matrix of order | c | NCONV in workl(iuptri). | c %--------------------------------------------------------% c call cunm2r('Right', 'Notranspose', n , & ncv , nconv , workl(invsub), & ldq , workev , v , & ldv , workd(n+1) , ierr) call clacpy('All', n, nconv, v, ldv, z, ldz) c do 20 j=1, nconv c c %---------------------------------------------------% c | Perform both a column and row scaling if the | c | diagonal element of workl(invsub,ldq) is negative | c | I'm lazy and don't take advantage of the upper | c | triangular form of workl(iuptri,ldq). | c | Note that since Q is orthogonal, R is a diagonal | c | matrix consisting of plus or minus ones. | c %---------------------------------------------------% c if ( real( workl(invsub+(j-1)*ldq+j-1) ) .lt. & real(zero) ) then call cscal(nconv, -one, workl(iuptri+j-1), ldq) call cscal(nconv, -one, workl(iuptri+(j-1)*ldq), 1) end if c 20 continue c if (howmny .eq. 'A') then c c %--------------------------------------------% c | Compute the NCONV wanted eigenvectors of T | c | located in workl(iuptri,ldq). | c %--------------------------------------------% c do 30 j=1, ncv if (j .le. nconv) then select(j) = .true. else select(j) = .false. end if 30 continue c call ctrevc('Right', 'Select' , select , & ncv , workl(iuptri), ldq , & vl , 1 , workl(invsub), & ldq , ncv , outncv , & workev , rwork , ierr) c if (ierr .ne. 0) then info = -9 go to 9000 end if c c %------------------------------------------------% c | Scale the returning eigenvectors so that their | c | Euclidean norms are all one. LAPACK subroutine | c | ctrevc returns each eigenvector normalized so | c | that the element of largest magnitude has | c | magnitude 1. | c %------------------------------------------------% c do 40 j=1, nconv rtemp = scnrm2(ncv, workl(invsub+(j-1)*ldq), 1) rtemp = real(one) / rtemp call csscal ( ncv, rtemp, & workl(invsub+(j-1)*ldq), 1 ) c c %------------------------------------------% c | Ritz estimates can be obtained by taking | c | the inner product of the last row of the | c | Schur basis of H with eigenvectors of T. | c | Note that the eigenvector matrix of T is | c | upper triangular, thus the length of the | c | inner product can be set to j. | c %------------------------------------------% c workev(j) = cdotc(j, workl(ihbds), 1, & workl(invsub+(j-1)*ldq), 1) 40 continue c if (msglvl .gt. 2) then call ccopy(nconv, workl(invsub+ncv-1), ldq, & workl(ihbds), 1) call cvout (logfil, nconv, workl(ihbds), ndigit, & '_neupd: Last row of the eigenvector matrix for T') if (msglvl .gt. 3) then call cmout(logfil , ncv, ncv , & workl(invsub), ldq, ndigit, & '_neupd: The eigenvector matrix for T') end if end if c c %---------------------------------------% c | Copy Ritz estimates into workl(ihbds) | c %---------------------------------------% c call ccopy(nconv, workev, 1, workl(ihbds), 1) c c %----------------------------------------------% c | The eigenvector matrix Q of T is triangular. | c | Form Z*Q. | c %----------------------------------------------% c call ctrmm('Right' , 'Upper' , 'No transpose', & 'Non-unit', n , nconv , & one , workl(invsub), ldq , & z , ldz) end if c else c c %--------------------------------------------------% c | An approximate invariant subspace is not needed. | c | Place the Ritz values computed CNAUPD into D. | c %--------------------------------------------------% c call ccopy(nconv, workl(ritz), 1, d, 1) call ccopy(nconv, workl(ritz), 1, workl(iheig), 1) call ccopy(nconv, workl(bounds), 1, workl(ihbds), 1) c end if c c %------------------------------------------------% c | Transform the Ritz values and possibly vectors | c | and corresponding error bounds of OP to those | c | of A*x = lambda*B*x. | c %------------------------------------------------% c if (type .eq. 'REGULR') then c if (rvec) & call cscal(ncv, rnorm, workl(ihbds), 1) c else c c %---------------------------------------% c | A spectral transformation was used. | c | * Determine the Ritz estimates of the | c | Ritz values in the original system. | c %---------------------------------------% c if (rvec) & call cscal(ncv, rnorm, workl(ihbds), 1) c do 50 k=1, ncv temp = workl(iheig+k-1) workl(ihbds+k-1) = workl(ihbds+k-1) / temp / temp 50 continue c end if c c %-----------------------------------------------------------% c | * Transform the Ritz values back to the original system. | c | For TYPE = 'SHIFTI' the transformation is | c | lambda = 1/theta + sigma | c | NOTES: | c | *The Ritz vectors are not affected by the transformation. | c %-----------------------------------------------------------% c if (type .eq. 'SHIFTI') then do 60 k=1, nconv d(k) = one / workl(iheig+k-1) + sigma 60 continue end if c if (type .ne. 'REGULR' .and. msglvl .gt. 1) then call cvout (logfil, nconv, d, ndigit, & '_neupd: Untransformed Ritz values.') call cvout (logfil, nconv, workl(ihbds), ndigit, & '_neupd: Ritz estimates of the untransformed Ritz values.') else if ( msglvl .gt. 1) then call cvout (logfil, nconv, d, ndigit, & '_neupd: Converged Ritz values.') call cvout (logfil, nconv, workl(ihbds), ndigit, & '_neupd: Associated Ritz estimates.') end if c c %-------------------------------------------------% c | Eigenvector Purification step. Formally perform | c | one of inverse subspace iteration. Only used | c | for MODE = 3. See reference 3. | c %-------------------------------------------------% c if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then c c %------------------------------------------------% c | Purify the computed Ritz vectors by adding a | c | little bit of the residual vector: | c | T | c | resid(:)*( e s ) / theta | c | NCV | c | where H s = s theta. | c %------------------------------------------------% c do 100 j=1, nconv if (workl(iheig+j-1) .ne. zero) then workev(j) = workl(invsub+(j-1)*ldq+ncv-1) / & workl(iheig+j-1) endif 100 continue c %---------------------------------------% c | Perform a rank one update to Z and | c | purify all the Ritz vectors together. | c %---------------------------------------% c call cgeru (n, nconv, one, resid, 1, workev, 1, z, ldz) c end if c 9000 continue c return c c %---------------% c | End of cneupd| c %---------------% c end getdp-2.7.0-source/contrib/Arpack/zvout.f000644 001750 001750 00000020026 11266605602 022004 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c c\SCCS Information: @(#) c FILE: zvout.f SID: 2.1 DATE OF SID: 11/16/95 RELEASE: 2 c *----------------------------------------------------------------------- * Routine: ZVOUT * * Purpose: Complex*16 vector output routine. * * Usage: CALL ZVOUT (LOUT, N, CX, IDIGIT, IFMT) * * Arguments * N - Length of array CX. (Input) * CX - Complex*16 array to be printed. (Input) * IFMT - Format to be used in printing array CX. (Input) * IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In) * If IDIGIT .LT. 0, printing is done with 72 columns. * If IDIGIT .GT. 0, printing is done with 132 columns. * *----------------------------------------------------------------------- * SUBROUTINE ZVOUT( LOUT, N, CX, IDIGIT, IFMT ) * ... * ... SPECIFICATIONS FOR ARGUMENTS INTEGER N, IDIGIT, LOUT Complex*16 & CX( * ) CHARACTER IFMT*( * ) * ... * ... SPECIFICATIONS FOR LOCAL VARIABLES INTEGER I, NDIGIT, K1, K2, LLL CHARACTER*80 LINE * ... * ... FIRST EXECUTABLE STATEMENT * * LLL = MIN( LEN( IFMT ), 80 ) DO 10 I = 1, LLL LINE( I: I ) = '-' 10 CONTINUE * DO 20 I = LLL + 1, 80 LINE( I: I ) = ' ' 20 CONTINUE * WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL ) 9999 FORMAT( / 1X, A / 1X, A ) * IF( N.LE.0 ) $ RETURN NDIGIT = IDIGIT IF( IDIGIT.EQ.0 ) $ NDIGIT = 4 * *======================================================================= * CODE FOR OUTPUT USING 72 COLUMNS FORMAT *======================================================================= * IF( IDIGIT.LT.0 ) THEN NDIGIT = -IDIGIT IF( NDIGIT.LE.4 ) THEN DO 30 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) IF (K1.NE.N) THEN WRITE( LOUT, 9998 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE WRITE( LOUT, 9997 )K1, K2, ( CX( I ), $ I = K1, K2 ) END IF 30 CONTINUE ELSE IF( NDIGIT.LE.6 ) THEN DO 40 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) IF (K1.NE.N) THEN WRITE( LOUT, 9988 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE WRITE( LOUT, 9987 )K1, K2, ( CX( I ), $ I = K1, K2 ) END IF 40 CONTINUE ELSE IF( NDIGIT.LE.8 ) THEN DO 50 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) IF (K1.NE.N) THEN WRITE( LOUT, 9978 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE WRITE( LOUT, 9977 )K1, K2, ( CX( I ), $ I = K1, K2 ) END IF 50 CONTINUE ELSE DO 60 K1 = 1, N WRITE( LOUT, 9968 )K1, K1, CX( I ) 60 CONTINUE END IF * *======================================================================= * CODE FOR OUTPUT USING 132 COLUMNS FORMAT *======================================================================= * ELSE IF( NDIGIT.LE.4 ) THEN DO 70 K1 = 1, N, 4 K2 = MIN0( N, K1+3 ) IF ((K1+3).LE.N) THEN WRITE( LOUT, 9958 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE IF ((K1+3-N) .EQ. 1) THEN WRITE( LOUT, 9957 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE IF ((K1+3-N) .EQ. 2) THEN WRITE( LOUT, 9956 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE IF ((K1+3-N) .EQ. 1) THEN WRITE( LOUT, 9955 )K1, K2, ( CX( I ), $ I = K1, K2 ) END IF 70 CONTINUE ELSE IF( NDIGIT.LE.6 ) THEN DO 80 K1 = 1, N, 3 K2 = MIN0( N, K1+2 ) IF ((K1+2).LE.N) THEN WRITE( LOUT, 9948 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE IF ((K1+2-N) .EQ. 1) THEN WRITE( LOUT, 9947 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE IF ((K1+2-N) .EQ. 2) THEN WRITE( LOUT, 9946 )K1, K2, ( CX( I ), $ I = K1, K2 ) END IF 80 CONTINUE ELSE IF( NDIGIT.LE.8 ) THEN DO 90 K1 = 1, N, 3 K2 = MIN0( N, K1+2 ) IF ((K1+2).LE.N) THEN WRITE( LOUT, 9938 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE IF ((K1+2-N) .EQ. 1) THEN WRITE( LOUT, 9937 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE IF ((K1+2-N) .EQ. 2) THEN WRITE( LOUT, 9936 )K1, K2, ( CX( I ), $ I = K1, K2 ) END IF 90 CONTINUE ELSE DO 100 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) IF ((K1+2).LE.N) THEN WRITE( LOUT, 9928 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE IF ((K1+2-N) .EQ. 1) THEN WRITE( LOUT, 9927 )K1, K2, ( CX( I ), $ I = K1, K2 ) END IF 100 CONTINUE END IF END IF WRITE( LOUT, 9994 ) RETURN * *======================================================================= * FORMAT FOR 72 COLUMNS *======================================================================= * * DISPLAY 4 SIGNIFICANT DIGITS * 9998 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,2('(',D10.3,',',D10.3,') ') ) 9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,1('(',D10.3,',',D10.3,') ') ) * * DISPLAY 6 SIGNIFICANT DIGITS * 9988 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,2('(',D12.5,',',D12.5,') ') ) 9987 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,1('(',D12.5,',',D12.5,') ') ) * * DISPLAY 8 SIGNIFICANT DIGITS * 9978 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,2('(',D14.7,',',D14.7,') ') ) 9977 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,1('(',D14.7,',',D14.7,') ') ) * * DISPLAY 13 SIGNIFICANT DIGITS * 9968 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,1('(',D20.13,',',D20.13,') ') ) * *========================================================================= * FORMAT FOR 132 COLUMNS *========================================================================= * * DISPLAY 4 SIGNIFICANT DIGITS * 9958 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,4('(',D10.3,',',D10.3,') ') ) 9957 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,3('(',D10.3,',',D10.3,') ') ) 9956 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,2('(',D10.3,',',D10.3,') ') ) 9955 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,1('(',D10.3,',',D10.3,') ') ) * * DISPLAY 6 SIGNIFICANT DIGITS * 9948 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,3('(',D12.5,',',D12.5,') ') ) 9947 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,2('(',D12.5,',',D12.5,') ') ) 9946 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,1('(',D12.5,',',D12.5,') ') ) * * DISPLAY 8 SIGNIFICANT DIGITS * 9938 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,3('(',D14.7,',',D14.7,') ') ) 9937 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,2('(',D14.7,',',D14.7,') ') ) 9936 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,1('(',D14.7,',',D14.7,') ') ) * * DISPLAY 13 SIGNIFICANT DIGITS * 9928 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,2('(',D20.13,',',D20.13,') ') ) 9927 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,1('(',D20.13,',',D20.13,') ') ) * * * 9994 FORMAT( 1X, ' ' ) END getdp-2.7.0-source/contrib/Arpack/zgetv0.f000644 001750 001750 00000031274 11266605602 022043 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: zgetv0 c c\Description: c Generate a random initial residual vector for the Arnoldi process. c Force the residual vector to be in the range of the operator OP. c c\Usage: c call zgetv0 c ( IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM, c IPNTR, WORKD, IERR ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. IDO must be zero on the first c call to zgetv0. c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c This is for the initialization phase to force the c starting vector into the range of OP. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c IDO = 99: done c ------------------------------------------------------------- c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B in the (generalized) c eigenvalue problem A*x = lambda*B*x. c B = 'I' -> standard eigenvalue problem A*x = lambda*x c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x c c ITRY Integer. (INPUT) c ITRY counts the number of times that zgetv0 is called. c It should be set to 1 on the initial call to zgetv0. c c INITV Logical variable. (INPUT) c .TRUE. => the initial residual vector is given in RESID. c .FALSE. => generate a random initial residual vector. c c N Integer. (INPUT) c Dimension of the problem. c c J Integer. (INPUT) c Index of the residual vector to be generated, with respect to c the Arnoldi process. J > 1 in case of a "restart". c c V Complex*16 N by J array. (INPUT) c The first J-1 columns of V contain the current Arnoldi basis c if this is a "restart". c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c RESID Complex*16 array of length N. (INPUT/OUTPUT) c Initial residual vector to be generated. If RESID is c provided, force RESID into the range of the operator OP. c c RNORM Double precision scalar. (OUTPUT) c B-norm of the generated residual. c c IPNTR Integer array of length 3. (OUTPUT) c c WORKD Complex*16 work array of length 2*N. (REVERSE COMMUNICATION). c On exit, WORK(1:N) = B*RESID to be used in SSAITR. c c IERR Integer. (OUTPUT) c = 0: Normal exit. c = -1: Cannot generate a nontrivial restarted residual vector c in the range of the operator OP. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx Complex*16 c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c c\Routines called: c second ARPACK utility routine for timing. c zvout ARPACK utility routine that prints vectors. c zlarnv LAPACK routine for generating a random vector. c zgemv Level 2 BLAS routine for matrix vector multiplication. c zcopy Level 1 BLAS that copies one vector to another. c zdotc Level 1 BLAS that computes the scalar product of two vectors. c dznrm2 Level 1 BLAS that computes the norm of a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: getv0.F SID: 2.3 DATE OF SID: 08/27/96 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine zgetv0 & ( ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm, & ipntr, workd, ierr ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1 logical initv integer ido, ierr, itry, j, ldv, n Double precision & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(3) Complex*16 & resid(n), v(ldv,j), workd(2*n) c c %------------% c | Parameters | c %------------% c Complex*16 & one, zero Double precision & rzero parameter (one = (1.0D+0, 0.0D+0), zero = (0.0D+0, 0.0D+0), & rzero = 0.0D+0) c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c logical first, inits, orth integer idist, iseed(4), iter, msglvl, jj Double precision & rnorm0 Complex*16 & cnorm save first, iseed, inits, iter, msglvl, orth, rnorm0 c c %----------------------% c | External Subroutines | c %----------------------% c external zcopy, zgemv, zlarnv, zvout, second c c %--------------------% c | External Functions | c %--------------------% c Double precision & dznrm2, dlapy2 Complex*16 & zdotc external zdotc, dznrm2, dlapy2 c c %-----------------% c | Data Statements | c %-----------------% c data inits /.true./ c c %-----------------------% c | Executable Statements | c %-----------------------% c c c %-----------------------------------% c | Initialize the seed of the LAPACK | c | random number generator | c %-----------------------------------% c if (inits) then iseed(1) = 1 iseed(2) = 3 iseed(3) = 5 iseed(4) = 7 inits = .false. end if c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mgetv0 c ierr = 0 iter = 0 first = .FALSE. orth = .FALSE. c c %-----------------------------------------------------% c | Possibly generate a random starting vector in RESID | c | Use a LAPACK random number generator used by the | c | matrix generation routines. | c | idist = 1: uniform (0,1) distribution; | c | idist = 2: uniform (-1,1) distribution; | c | idist = 3: normal (0,1) distribution; | c %-----------------------------------------------------% c if (.not.initv) then idist = 2 call zlarnv (idist, iseed, n, resid) end if c c %----------------------------------------------------------% c | Force the starting vector into the range of OP to handle | c | the generalized problem when B is possibly (singular). | c %----------------------------------------------------------% c call second (t2) if (bmat .eq. 'G') then nopx = nopx + 1 ipntr(1) = 1 ipntr(2) = n + 1 call zcopy (n, resid, 1, workd, 1) ido = -1 go to 9000 end if end if c c %----------------------------------------% c | Back from computing B*(initial-vector) | c %----------------------------------------% c if (first) go to 20 c c %-----------------------------------------------% c | Back from computing B*(orthogonalized-vector) | c %-----------------------------------------------% c if (orth) go to 40 c call second (t3) tmvopx = tmvopx + (t3 - t2) c c %------------------------------------------------------% c | Starting vector is now in the range of OP; r = OP*r; | c | Compute B-norm of starting vector. | c %------------------------------------------------------% c call second (t2) first = .TRUE. if (bmat .eq. 'G') then nbx = nbx + 1 call zcopy (n, workd(n+1), 1, resid, 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 go to 9000 else if (bmat .eq. 'I') then call zcopy (n, resid, 1, workd, 1) end if c 20 continue c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c first = .FALSE. if (bmat .eq. 'G') then cnorm = zdotc (n, resid, 1, workd, 1) rnorm0 = sqrt(dlapy2(dble(cnorm),dimag(cnorm))) else if (bmat .eq. 'I') then rnorm0 = dznrm2(n, resid, 1) end if rnorm = rnorm0 c c %---------------------------------------------% c | Exit if this is the very first Arnoldi step | c %---------------------------------------------% c if (j .eq. 1) go to 50 c c %---------------------------------------------------------------- c | Otherwise need to B-orthogonalize the starting vector against | c | the current Arnoldi basis using Gram-Schmidt with iter. ref. | c | This is the case where an invariant subspace is encountered | c | in the middle of the Arnoldi factorization. | c | | c | s = V^{T}*B*r; r = r - V*s; | c | | c | Stopping criteria used for iter. ref. is discussed in | c | Parlett's book, page 107 and in Gragg & Reichel TOMS paper. | c %---------------------------------------------------------------% c orth = .TRUE. 30 continue c call zgemv ('C', n, j-1, one, v, ldv, workd, 1, & zero, workd(n+1), 1) call zgemv ('N', n, j-1, -one, v, ldv, workd(n+1), 1, & one, resid, 1) c c %----------------------------------------------------------% c | Compute the B-norm of the orthogonalized starting vector | c %----------------------------------------------------------% c call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call zcopy (n, resid, 1, workd(n+1), 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 go to 9000 else if (bmat .eq. 'I') then call zcopy (n, resid, 1, workd, 1) end if c 40 continue c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c if (bmat .eq. 'G') then cnorm = zdotc (n, resid, 1, workd, 1) rnorm = sqrt(dlapy2(dble(cnorm),dimag(cnorm))) else if (bmat .eq. 'I') then rnorm = dznrm2(n, resid, 1) end if c c %--------------------------------------% c | Check for further orthogonalization. | c %--------------------------------------% c if (msglvl .gt. 2) then call dvout (logfil, 1, rnorm0, ndigit, & '_getv0: re-orthonalization ; rnorm0 is') call dvout (logfil, 1, rnorm, ndigit, & '_getv0: re-orthonalization ; rnorm is') end if c if (rnorm .gt. 0.717*rnorm0) go to 50 c iter = iter + 1 if (iter .le. 1) then c c %-----------------------------------% c | Perform iterative refinement step | c %-----------------------------------% c rnorm0 = rnorm go to 30 else c c %------------------------------------% c | Iterative refinement step "failed" | c %------------------------------------% c do 45 jj = 1, n resid(jj) = zero 45 continue rnorm = rzero ierr = -1 end if c 50 continue c if (msglvl .gt. 0) then call dvout (logfil, 1, rnorm, ndigit, & '_getv0: B-norm of initial / restarted starting vector') end if if (msglvl .gt. 2) then call zvout (logfil, n, resid, ndigit, & '_getv0: initial / restarted starting vector') end if ido = 99 c call second (t1) tgetv0 = tgetv0 + (t1 - t0) c 9000 continue return c c %---------------% c | End of zgetv0 | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/zngets.f000644 001750 001750 00000012712 11266605602 022132 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: zngets c c\Description: c Given the eigenvalues of the upper Hessenberg matrix H, c computes the NP shifts AMU that are zeros of the polynomial of c degree NP which filters out components of the unwanted eigenvectors c corresponding to the AMU's based on some given criteria. c c NOTE: call this even in the case of user specified shifts in order c to sort the eigenvalues, and error bounds of H for later use. c c\Usage: c call zngets c ( ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS ) c c\Arguments c ISHIFT Integer. (INPUT) c Method for selecting the implicit shifts at each iteration. c ISHIFT = 0: user specified shifts c ISHIFT = 1: exact shift with respect to the matrix H. c c WHICH Character*2. (INPUT) c Shift selection criteria. c 'LM' -> want the KEV eigenvalues of largest magnitude. c 'SM' -> want the KEV eigenvalues of smallest magnitude. c 'LR' -> want the KEV eigenvalues of largest REAL part. c 'SR' -> want the KEV eigenvalues of smallest REAL part. c 'LI' -> want the KEV eigenvalues of largest imaginary part. c 'SI' -> want the KEV eigenvalues of smallest imaginary part. c c KEV Integer. (INPUT) c The number of desired eigenvalues. c c NP Integer. (INPUT) c The number of shifts to compute. c c RITZ Complex*16 array of length KEV+NP. (INPUT/OUTPUT) c On INPUT, RITZ contains the the eigenvalues of H. c On OUTPUT, RITZ are sorted so that the unwanted c eigenvalues are in the first NP locations and the wanted c portion is in the last KEV locations. When exact shifts are c selected, the unwanted part corresponds to the shifts to c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues c are further sorted so that the ones with largest Ritz values c are first. c c BOUNDS Complex*16 array of length KEV+NP. (INPUT/OUTPUT) c Error bounds corresponding to the ordering in RITZ. c c c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx Complex*16 c c\Routines called: c zsortc ARPACK sorting routine. c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c zvout ARPACK utility routine that prints vectors. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: ngets.F SID: 2.2 DATE OF SID: 4/20/96 RELEASE: 2 c c\Remarks c 1. This routine does not keep complex conjugate pairs of c eigenvalues together. c c\EndLib c c----------------------------------------------------------------------- c subroutine zngets ( ishift, which, kev, np, ritz, bounds) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which integer ishift, kev, np c c %-----------------% c | Array Arguments | c %-----------------% c Complex*16 & bounds(kev+np), ritz(kev+np) c c %------------% c | Parameters | c %------------% c Complex*16 & one, zero parameter (one = (1.0D+0, 0.0D+0), zero = (0.0D+0, 0.0D+0)) c c %---------------% c | Local Scalars | c %---------------% c integer msglvl c c %----------------------% c | External Subroutines | c %----------------------% c external zvout, zsortc, second c c %-----------------------% c | Executable Statements | c %-----------------------% c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mcgets c call zsortc (which, .true., kev+np, ritz, bounds) c if ( ishift .eq. 1 ) then c c %-------------------------------------------------------% c | Sort the unwanted Ritz values used as shifts so that | c | the ones with largest Ritz estimates are first | c | This will tend to minimize the effects of the | c | forward instability of the iteration when the shifts | c | are applied in subroutine znapps. | c | Be careful and use 'SM' since we want to sort BOUNDS! | c %-------------------------------------------------------% c call zsortc ( 'SM', .true., np, bounds, ritz ) c end if c call second (t1) tcgets = tcgets + (t1 - t0) c if (msglvl .gt. 0) then call ivout (logfil, 1, kev, ndigit, '_ngets: KEV is') call ivout (logfil, 1, np, ndigit, '_ngets: NP is') call zvout (logfil, kev+np, ritz, ndigit, & '_ngets: Eigenvalues of current H matrix ') call zvout (logfil, kev+np, bounds, ndigit, & '_ngets: Ritz estimates of the current KEV+NP Ritz values') end if c return c c %---------------% c | End of zngets | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/ivout.f000644 001750 001750 00000006457 11266605602 021777 0ustar00geuzainegeuzaine000000 000000 C----------------------------------------------------------------------- C Routine: IVOUT C C Purpose: Integer vector output routine. C C Usage: CALL IVOUT (LOUT, N, IX, IDIGIT, IFMT) C C Arguments C N - Length of array IX. (Input) C IX - Integer array to be printed. (Input) C IFMT - Format to be used in printing array IX. (Input) C IDIGIT - Print up to ABS(IDIGIT) decimal digits / number. (Input) C If IDIGIT .LT. 0, printing is done with 72 columns. C If IDIGIT .GT. 0, printing is done with 132 columns. C C----------------------------------------------------------------------- C SUBROUTINE IVOUT (LOUT, N, IX, IDIGIT, IFMT) C ... C ... SPECIFICATIONS FOR ARGUMENTS INTEGER IX(*), N, IDIGIT, LOUT CHARACTER IFMT*(*) C ... C ... SPECIFICATIONS FOR LOCAL VARIABLES INTEGER I, NDIGIT, K1, K2, LLL CHARACTER*80 LINE * ... * ... SPECIFICATIONS INTRINSICS INTRINSIC MIN * C LLL = MIN ( LEN ( IFMT ), 80 ) DO 1 I = 1, LLL LINE(I:I) = '-' 1 CONTINUE C DO 2 I = LLL+1, 80 LINE(I:I) = ' ' 2 CONTINUE C WRITE ( LOUT, 2000 ) IFMT, LINE(1:LLL) 2000 FORMAT ( /1X, A /1X, A ) C IF (N .LE. 0) RETURN NDIGIT = IDIGIT IF (IDIGIT .EQ. 0) NDIGIT = 4 C C======================================================================= C CODE FOR OUTPUT USING 72 COLUMNS FORMAT C======================================================================= C IF (IDIGIT .LT. 0) THEN C NDIGIT = -IDIGIT IF (NDIGIT .LE. 4) THEN DO 10 K1 = 1, N, 10 K2 = MIN0(N,K1+9) WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2) 10 CONTINUE C ELSE IF (NDIGIT .LE. 6) THEN DO 30 K1 = 1, N, 7 K2 = MIN0(N,K1+6) WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2) 30 CONTINUE C ELSE IF (NDIGIT .LE. 10) THEN DO 50 K1 = 1, N, 5 K2 = MIN0(N,K1+4) WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2) 50 CONTINUE C ELSE DO 70 K1 = 1, N, 3 K2 = MIN0(N,K1+2) WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2) 70 CONTINUE END IF C C======================================================================= C CODE FOR OUTPUT USING 132 COLUMNS FORMAT C======================================================================= C ELSE C IF (NDIGIT .LE. 4) THEN DO 90 K1 = 1, N, 20 K2 = MIN0(N,K1+19) WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2) 90 CONTINUE C ELSE IF (NDIGIT .LE. 6) THEN DO 110 K1 = 1, N, 15 K2 = MIN0(N,K1+14) WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2) 110 CONTINUE C ELSE IF (NDIGIT .LE. 10) THEN DO 130 K1 = 1, N, 10 K2 = MIN0(N,K1+9) WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2) 130 CONTINUE C ELSE DO 150 K1 = 1, N, 7 K2 = MIN0(N,K1+6) WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2) 150 CONTINUE END IF END IF WRITE (LOUT,1004) C 1000 FORMAT(1X,I4,' - ',I4,':',20(1X,I5)) 1001 FORMAT(1X,I4,' - ',I4,':',15(1X,I7)) 1002 FORMAT(1X,I4,' - ',I4,':',10(1X,I11)) 1003 FORMAT(1X,I4,' - ',I4,':',7(1X,I15)) 1004 FORMAT(1X,' ') C RETURN END getdp-2.7.0-source/contrib/Arpack/dnaitr.f000644 001750 001750 00000073673 11266605602 022116 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: dnaitr c c\Description: c Reverse communication interface for applying NP additional steps to c a K step nonsymmetric Arnoldi factorization. c c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T c c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0. c c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T c c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0. c c where OP and B are as in dnaupd. The B-norm of r_{k+p} is also c computed and returned. c c\Usage: c call dnaitr c ( IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH, c IPNTR, WORKD, INFO ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y. c This is for the restart phase to force the new c starting vector into the range of OP. c IDO = 1: compute Y = OP * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y, c IPNTR(3) is the pointer into WORK for B * X. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y. c IDO = 99: done c ------------------------------------------------------------- c When the routine is used in the "shift-and-invert" mode, the c vector B * Q is already available and do not need to be c recompute in forming OP * Q. c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B that defines the c semi-inner product for the operator OP. See dnaupd. c B = 'I' -> standard eigenvalue problem A*x = lambda*x c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x c c N Integer. (INPUT) c Dimension of the eigenproblem. c c K Integer. (INPUT) c Current size of V and H. c c NP Integer. (INPUT) c Number of additional Arnoldi steps to take. c c NB Integer. (INPUT) c Blocksize to be used in the recurrence. c Only work for NB = 1 right now. The goal is to have a c program that implement both the block and non-block method. c c RESID Double precision array of length N. (INPUT/OUTPUT) c On INPUT: RESID contains the residual vector r_{k}. c On OUTPUT: RESID contains the residual vector r_{k+p}. c c RNORM Double precision scalar. (INPUT/OUTPUT) c B-norm of the starting residual on input. c B-norm of the updated residual r_{k+p} on output. c c V Double precision N by K+NP array. (INPUT/OUTPUT) c On INPUT: V contains the Arnoldi vectors in the first K c columns. c On OUTPUT: V contains the new NP Arnoldi vectors in the next c NP columns. The first K columns are unchanged. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Double precision (K+NP) by (K+NP) array. (INPUT/OUTPUT) c H is used to store the generated upper Hessenberg matrix. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c IPNTR Integer array of length 3. (OUTPUT) c Pointer to mark the starting locations in the WORK for c vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. c IPNTR(3): pointer to the vector B * X when used in the c shift-and-invert mode. X is the current operand. c ------------------------------------------------------------- c c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The calling program should not c use WORKD as temporary workspace during the iteration !!!!!! c On input, WORKD(1:N) = B*RESID and is used to save some c computation at the first step. c c INFO Integer. (OUTPUT) c = 0: Normal exit. c > 0: Size of the spanning invariant subspace of OP found. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: c dgetv0 ARPACK routine to generate the initial vector. c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c dmout ARPACK utility routine that prints matrices c dvout ARPACK utility routine that prints vectors. c dlabad LAPACK routine that computes machine constants. c dlamch LAPACK routine that determines machine constants. c dlascl LAPACK routine for careful scaling of a matrix. c dlanhs LAPACK routine that computes various norms of a matrix. c dgemv Level 2 BLAS routine for matrix vector multiplication. c daxpy Level 1 BLAS that computes a vector triad. c dscal Level 1 BLAS that scales a vector. c dcopy Level 1 BLAS that copies one vector to another . c ddot Level 1 BLAS that computes the scalar product of two vectors. c dnrm2 Level 1 BLAS that computes the norm of a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.4' c c\SCCS Information: @(#) c FILE: naitr.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks c The algorithm implemented is: c c restart = .false. c Given V_{k} = [v_{1}, ..., v_{k}], r_{k}; c r_{k} contains the initial residual vector even for k = 0; c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already c computed by the calling program. c c betaj = rnorm ; p_{k+1} = B*r_{k} ; c For j = k+1, ..., k+np Do c 1) if ( betaj < tol ) stop or restart depending on j. c ( At present tol is zero ) c if ( restart ) generate a new starting vector. c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}]; c p_{j} = p_{j}/betaj c 3) r_{j} = OP*v_{j} where OP is defined as in dnaupd c For shift-invert mode p_{j} = B*v_{j} is already available. c wnorm = || OP*v_{j} || c 4) Compute the j-th step residual vector. c w_{j} = V_{j}^T * B * OP * v_{j} c r_{j} = OP*v_{j} - V_{j} * w_{j} c H(:,j) = w_{j}; c H(j,j-1) = rnorm c rnorm = || r_(j) || c If (rnorm > 0.717*wnorm) accept step and go back to 1) c 5) Re-orthogonalization step: c s = V_{j}'*B*r_{j} c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} || c alphaj = alphaj + s_{j}; c 6) Iterative refinement step: c If (rnorm1 > 0.717*rnorm) then c rnorm = rnorm1 c accept step and go back to 1) c Else c rnorm = rnorm1 c If this is the first time in step 6), go to 5) c Else r_{j} lies in the span of V_{j} numerically. c Set r_{j} = 0 and rnorm = 0; go to 1) c EndIf c End Do c c\EndLib c c----------------------------------------------------------------------- c subroutine dnaitr & (ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh, & ipntr, workd, info) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1 integer ido, info, k, ldh, ldv, n, nb, np Double precision & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(3) Double precision & h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c logical first, orth1, orth2, rstart, step3, step4 integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl, & jj Double precision & betaj, ovfl, temp1, rnorm1, smlnum, tst1, ulp, unfl, & wnorm save first, orth1, orth2, rstart, step3, step4, & ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl, & betaj, rnorm1, smlnum, ulp, unfl, wnorm c c %-----------------------% c | Local Array Arguments | c %-----------------------% c Double precision & xtemp(2) c c %----------------------% c | External Subroutines | c %----------------------% c external daxpy, dcopy, dscal, dgemv, dgetv0, dlabad, & dvout, dmout, ivout, second c c %--------------------% c | External Functions | c %--------------------% c Double precision & ddot, dnrm2, dlanhs, dlamch external ddot, dnrm2, dlanhs, dlamch c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic abs, sqrt c c %-----------------% c | Data statements | c %-----------------% c data first / .true. / c c %-----------------------% c | Executable Statements | c %-----------------------% c if (first) then c c %-----------------------------------------% c | Set machine-dependent constants for the | c | the splitting and deflation criterion. | c | If norm(H) <= sqrt(OVFL), | c | overflow should not occur. | c | REFERENCE: LAPACK subroutine dlahqr | c %-----------------------------------------% c unfl = dlamch( 'safe minimum' ) ovfl = one / unfl call dlabad( unfl, ovfl ) ulp = dlamch( 'precision' ) smlnum = unfl*( n / ulp ) first = .false. end if c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mnaitr c c %------------------------------% c | Initial call to this routine | c %------------------------------% c info = 0 step3 = .false. step4 = .false. rstart = .false. orth1 = .false. orth2 = .false. j = k + 1 ipj = 1 irj = ipj + n ivj = irj + n end if c c %-------------------------------------------------% c | When in reverse communication mode one of: | c | STEP3, STEP4, ORTH1, ORTH2, RSTART | c | will be .true. when .... | c | STEP3: return from computing OP*v_{j}. | c | STEP4: return from computing B-norm of OP*v_{j} | c | ORTH1: return from computing B-norm of r_{j+1} | c | ORTH2: return from computing B-norm of | c | correction to the residual vector. | c | RSTART: return from OP computations needed by | c | dgetv0. | c %-------------------------------------------------% c if (step3) go to 50 if (step4) go to 60 if (orth1) go to 70 if (orth2) go to 90 if (rstart) go to 30 c c %-----------------------------% c | Else this is the first step | c %-----------------------------% c c %--------------------------------------------------------------% c | | c | A R N O L D I I T E R A T I O N L O O P | c | | c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) | c %--------------------------------------------------------------% 1000 continue c if (msglvl .gt. 1) then call ivout (logfil, 1, j, ndigit, & '_naitr: generating Arnoldi vector number') call dvout (logfil, 1, rnorm, ndigit, & '_naitr: B-norm of the current residual is') end if c c %---------------------------------------------------% c | STEP 1: Check if the B norm of j-th residual | c | vector is zero. Equivalent to determing whether | c | an exact j-step Arnoldi factorization is present. | c %---------------------------------------------------% c betaj = rnorm if (rnorm .gt. zero) go to 40 c c %---------------------------------------------------% c | Invariant subspace found, generate a new starting | c | vector which is orthogonal to the current Arnoldi | c | basis and continue the iteration. | c %---------------------------------------------------% c if (msglvl .gt. 0) then call ivout (logfil, 1, j, ndigit, & '_naitr: ****** RESTART AT STEP ******') end if c c %---------------------------------------------% c | ITRY is the loop variable that controls the | c | maximum amount of times that a restart is | c | attempted. NRSTRT is used by stat.h | c %---------------------------------------------% c betaj = zero nrstrt = nrstrt + 1 itry = 1 20 continue rstart = .true. ido = 0 30 continue c c %--------------------------------------% c | If in reverse communication mode and | c | RSTART = .true. flow returns here. | c %--------------------------------------% c call dgetv0 (ido, bmat, itry, .false., n, j, v, ldv, & resid, rnorm, ipntr, workd, ierr) if (ido .ne. 99) go to 9000 if (ierr .lt. 0) then itry = itry + 1 if (itry .le. 3) go to 20 c c %------------------------------------------------% c | Give up after several restart attempts. | c | Set INFO to the size of the invariant subspace | c | which spans OP and exit. | c %------------------------------------------------% c info = j - 1 call second (t1) tnaitr = tnaitr + (t1 - t0) ido = 99 go to 9000 end if c 40 continue c c %---------------------------------------------------------% c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm | c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow | c | when reciprocating a small RNORM, test against lower | c | machine bound. | c %---------------------------------------------------------% c call dcopy (n, resid, 1, v(1,j), 1) if (rnorm .ge. unfl) then temp1 = one / rnorm call dscal (n, temp1, v(1,j), 1) call dscal (n, temp1, workd(ipj), 1) else c c %-----------------------------------------% c | To scale both v_{j} and p_{j} carefully | c | use LAPACK routine SLASCL | c %-----------------------------------------% c call dlascl ('General', i, i, rnorm, one, n, 1, & v(1,j), n, infol) call dlascl ('General', i, i, rnorm, one, n, 1, & workd(ipj), n, infol) end if c c %------------------------------------------------------% c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} | c | Note that this is not quite yet r_{j}. See STEP 4 | c %------------------------------------------------------% c step3 = .true. nopx = nopx + 1 call second (t2) call dcopy (n, v(1,j), 1, workd(ivj), 1) ipntr(1) = ivj ipntr(2) = irj ipntr(3) = ipj ido = 1 c c %-----------------------------------% c | Exit in order to compute OP*v_{j} | c %-----------------------------------% c go to 9000 50 continue c c %----------------------------------% c | Back from reverse communication; | c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} | c | if step3 = .true. | c %----------------------------------% c call second (t3) tmvopx = tmvopx + (t3 - t2) step3 = .false. c c %------------------------------------------% c | Put another copy of OP*v_{j} into RESID. | c %------------------------------------------% c call dcopy (n, workd(irj), 1, resid, 1) c c %---------------------------------------% c | STEP 4: Finish extending the Arnoldi | c | factorization to length j. | c %---------------------------------------% c call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 step4 = .true. ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %-------------------------------------% c | Exit in order to compute B*OP*v_{j} | c %-------------------------------------% c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd(ipj), 1) end if 60 continue c c %----------------------------------% c | Back from reverse communication; | c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} | c | if step4 = .true. | c %----------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c step4 = .false. c c %-------------------------------------% c | The following is needed for STEP 5. | c | Compute the B-norm of OP*v_{j}. | c %-------------------------------------% c if (bmat .eq. 'G') then wnorm = ddot (n, resid, 1, workd(ipj), 1) wnorm = sqrt(abs(wnorm)) else if (bmat .eq. 'I') then wnorm = dnrm2(n, resid, 1) end if c c %-----------------------------------------% c | Compute the j-th residual corresponding | c | to the j step factorization. | c | Use Classical Gram Schmidt and compute: | c | w_{j} <- V_{j}^T * B * OP * v_{j} | c | r_{j} <- OP*v_{j} - V_{j} * w_{j} | c %-----------------------------------------% c c c %------------------------------------------% c | Compute the j Fourier coefficients w_{j} | c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. | c %------------------------------------------% c call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1, & zero, h(1,j), 1) c c %--------------------------------------% c | Orthogonalize r_{j} against V_{j}. | c | RESID contains OP*v_{j}. See STEP 3. | c %--------------------------------------% c call dgemv ('N', n, j, -one, v, ldv, h(1,j), 1, & one, resid, 1) c if (j .gt. 1) h(j,j-1) = betaj c call second (t4) c orth1 = .true. c call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %----------------------------------% c | Exit in order to compute B*r_{j} | c %----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd(ipj), 1) end if 70 continue c c %---------------------------------------------------% c | Back from reverse communication if ORTH1 = .true. | c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. | c %---------------------------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c orth1 = .false. c c %------------------------------% c | Compute the B-norm of r_{j}. | c %------------------------------% c if (bmat .eq. 'G') then rnorm = ddot (n, resid, 1, workd(ipj), 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then rnorm = dnrm2(n, resid, 1) end if c c %-----------------------------------------------------------% c | STEP 5: Re-orthogonalization / Iterative refinement phase | c | Maximum NITER_ITREF tries. | c | | c | s = V_{j}^T * B * r_{j} | c | r_{j} = r_{j} - V_{j}*s | c | alphaj = alphaj + s_{j} | c | | c | The stopping criteria used for iterative refinement is | c | discussed in Parlett's book SEP, page 107 and in Gragg & | c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. | c | Determine if we need to correct the residual. The goal is | c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || | c | The following test determines whether the sine of the | c | angle between OP*x and the computed residual is less | c | than or equal to 0.717. | c %-----------------------------------------------------------% c if (rnorm .gt. 0.717*wnorm) go to 100 iter = 0 nrorth = nrorth + 1 c c %---------------------------------------------------% c | Enter the Iterative refinement phase. If further | c | refinement is necessary, loop back here. The loop | c | variable is ITER. Perform a step of Classical | c | Gram-Schmidt using all the Arnoldi vectors V_{j} | c %---------------------------------------------------% c 80 continue c if (msglvl .gt. 2) then xtemp(1) = wnorm xtemp(2) = rnorm call dvout (logfil, 2, xtemp, ndigit, & '_naitr: re-orthonalization; wnorm and rnorm are') call dvout (logfil, j, h(1,j), ndigit, & '_naitr: j-th column of H') end if c c %----------------------------------------------------% c | Compute V_{j}^T * B * r_{j}. | c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). | c %----------------------------------------------------% c call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1, & zero, workd(irj), 1) c c %---------------------------------------------% c | Compute the correction to the residual: | c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). | c | The correction to H is v(:,1:J)*H(1:J,1:J) | c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. | c %---------------------------------------------% c call dgemv ('N', n, j, -one, v, ldv, workd(irj), 1, & one, resid, 1) call daxpy (j, one, workd(irj), 1, h(1,j), 1) c orth2 = .true. call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %-----------------------------------% c | Exit in order to compute B*r_{j}. | c | r_{j} is the corrected residual. | c %-----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd(ipj), 1) end if 90 continue c c %---------------------------------------------------% c | Back from reverse communication if ORTH2 = .true. | c %---------------------------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c c %-----------------------------------------------------% c | Compute the B-norm of the corrected residual r_{j}. | c %-----------------------------------------------------% c if (bmat .eq. 'G') then rnorm1 = ddot (n, resid, 1, workd(ipj), 1) rnorm1 = sqrt(abs(rnorm1)) else if (bmat .eq. 'I') then rnorm1 = dnrm2(n, resid, 1) end if c if (msglvl .gt. 0 .and. iter .gt. 0) then call ivout (logfil, 1, j, ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then xtemp(1) = rnorm xtemp(2) = rnorm1 call dvout (logfil, 2, xtemp, ndigit, & '_naitr: iterative refinement ; rnorm and rnorm1 are') end if end if c c %-----------------------------------------% c | Determine if we need to perform another | c | step of re-orthogonalization. | c %-----------------------------------------% c if (rnorm1 .gt. 0.717*rnorm) then c c %---------------------------------------% c | No need for further refinement. | c | The cosine of the angle between the | c | corrected residual vector and the old | c | residual vector is greater than 0.717 | c | In other words the corrected residual | c | and the old residual vector share an | c | angle of less than arcCOS(0.717) | c %---------------------------------------% c rnorm = rnorm1 c else c c %-------------------------------------------% c | Another step of iterative refinement step | c | is required. NITREF is used by stat.h | c %-------------------------------------------% c nitref = nitref + 1 rnorm = rnorm1 iter = iter + 1 if (iter .le. 1) go to 80 c c %-------------------------------------------------% c | Otherwise RESID is numerically in the span of V | c %-------------------------------------------------% c do 95 jj = 1, n resid(jj) = zero 95 continue rnorm = zero end if c c %----------------------------------------------% c | Branch here directly if iterative refinement | c | wasn't necessary or after at most NITER_REF | c | steps of iterative refinement. | c %----------------------------------------------% c 100 continue c rstart = .false. orth2 = .false. c call second (t5) titref = titref + (t5 - t4) c c %------------------------------------% c | STEP 6: Update j = j+1; Continue | c %------------------------------------% c j = j + 1 if (j .gt. k+np) then call second (t1) tnaitr = tnaitr + (t1 - t0) ido = 99 do 110 i = max(1,k), k+np-1 c c %--------------------------------------------% c | Check for splitting and deflation. | c | Use a standard test as in the QR algorithm | c | REFERENCE: LAPACK subroutine dlahqr | c %--------------------------------------------% c tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) ) if( tst1.eq.zero ) & tst1 = dlanhs( '1', k+np, h, ldh, workd(n+1) ) if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) & h(i+1,i) = zero 110 continue c if (msglvl .gt. 2) then call dmout (logfil, k+np, k+np, h, ldh, ndigit, & '_naitr: Final upper Hessenberg matrix H of order K+NP') end if c go to 9000 end if c c %--------------------------------------------------------% c | Loop back to extend the factorization by another step. | c %--------------------------------------------------------% c go to 1000 c c %---------------------------------------------------------------% c | | c | E N D O F M A I N I T E R A T I O N L O O P | c | | c %---------------------------------------------------------------% c 9000 continue return c c %---------------% c | End of dnaitr | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/snaitr.f000644 001750 001750 00000073467 11266605602 022136 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: snaitr c c\Description: c Reverse communication interface for applying NP additional steps to c a K step nonsymmetric Arnoldi factorization. c c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T c c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0. c c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T c c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0. c c where OP and B are as in snaupd. The B-norm of r_{k+p} is also c computed and returned. c c\Usage: c call snaitr c ( IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH, c IPNTR, WORKD, INFO ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y. c This is for the restart phase to force the new c starting vector into the range of OP. c IDO = 1: compute Y = OP * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y, c IPNTR(3) is the pointer into WORK for B * X. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y. c IDO = 99: done c ------------------------------------------------------------- c When the routine is used in the "shift-and-invert" mode, the c vector B * Q is already available and do not need to be c recompute in forming OP * Q. c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B that defines the c semi-inner product for the operator OP. See snaupd. c B = 'I' -> standard eigenvalue problem A*x = lambda*x c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x c c N Integer. (INPUT) c Dimension of the eigenproblem. c c K Integer. (INPUT) c Current size of V and H. c c NP Integer. (INPUT) c Number of additional Arnoldi steps to take. c c NB Integer. (INPUT) c Blocksize to be used in the recurrence. c Only work for NB = 1 right now. The goal is to have a c program that implement both the block and non-block method. c c RESID Real array of length N. (INPUT/OUTPUT) c On INPUT: RESID contains the residual vector r_{k}. c On OUTPUT: RESID contains the residual vector r_{k+p}. c c RNORM Real scalar. (INPUT/OUTPUT) c B-norm of the starting residual on input. c B-norm of the updated residual r_{k+p} on output. c c V Real N by K+NP array. (INPUT/OUTPUT) c On INPUT: V contains the Arnoldi vectors in the first K c columns. c On OUTPUT: V contains the new NP Arnoldi vectors in the next c NP columns. The first K columns are unchanged. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Real (K+NP) by (K+NP) array. (INPUT/OUTPUT) c H is used to store the generated upper Hessenberg matrix. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c IPNTR Integer array of length 3. (OUTPUT) c Pointer to mark the starting locations in the WORK for c vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. c IPNTR(3): pointer to the vector B * X when used in the c shift-and-invert mode. X is the current operand. c ------------------------------------------------------------- c c WORKD Real work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The calling program should not c use WORKD as temporary workspace during the iteration !!!!!! c On input, WORKD(1:N) = B*RESID and is used to save some c computation at the first step. c c INFO Integer. (OUTPUT) c = 0: Normal exit. c > 0: Size of the spanning invariant subspace of OP found. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: c sgetv0 ARPACK routine to generate the initial vector. c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c smout ARPACK utility routine that prints matrices c svout ARPACK utility routine that prints vectors. c slabad LAPACK routine that computes machine constants. c slamch LAPACK routine that determines machine constants. c slascl LAPACK routine for careful scaling of a matrix. c slanhs LAPACK routine that computes various norms of a matrix. c sgemv Level 2 BLAS routine for matrix vector multiplication. c saxpy Level 1 BLAS that computes a vector triad. c sscal Level 1 BLAS that scales a vector. c scopy Level 1 BLAS that copies one vector to another . c sdot Level 1 BLAS that computes the scalar product of two vectors. c snrm2 Level 1 BLAS that computes the norm of a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.4' c c\SCCS Information: @(#) c FILE: naitr.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks c The algorithm implemented is: c c restart = .false. c Given V_{k} = [v_{1}, ..., v_{k}], r_{k}; c r_{k} contains the initial residual vector even for k = 0; c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already c computed by the calling program. c c betaj = rnorm ; p_{k+1} = B*r_{k} ; c For j = k+1, ..., k+np Do c 1) if ( betaj < tol ) stop or restart depending on j. c ( At present tol is zero ) c if ( restart ) generate a new starting vector. c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}]; c p_{j} = p_{j}/betaj c 3) r_{j} = OP*v_{j} where OP is defined as in snaupd c For shift-invert mode p_{j} = B*v_{j} is already available. c wnorm = || OP*v_{j} || c 4) Compute the j-th step residual vector. c w_{j} = V_{j}^T * B * OP * v_{j} c r_{j} = OP*v_{j} - V_{j} * w_{j} c H(:,j) = w_{j}; c H(j,j-1) = rnorm c rnorm = || r_(j) || c If (rnorm > 0.717*wnorm) accept step and go back to 1) c 5) Re-orthogonalization step: c s = V_{j}'*B*r_{j} c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} || c alphaj = alphaj + s_{j}; c 6) Iterative refinement step: c If (rnorm1 > 0.717*rnorm) then c rnorm = rnorm1 c accept step and go back to 1) c Else c rnorm = rnorm1 c If this is the first time in step 6), go to 5) c Else r_{j} lies in the span of V_{j} numerically. c Set r_{j} = 0 and rnorm = 0; go to 1) c EndIf c End Do c c\EndLib c c----------------------------------------------------------------------- c subroutine snaitr & (ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh, & ipntr, workd, info) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1 integer ido, info, k, ldh, ldv, n, nb, np Real & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(3) Real & h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n) c c %------------% c | Parameters | c %------------% c Real & one, zero parameter (one = 1.0E+0, zero = 0.0E+0) c c %---------------% c | Local Scalars | c %---------------% c logical first, orth1, orth2, rstart, step3, step4 integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl, & jj Real & betaj, ovfl, temp1, rnorm1, smlnum, tst1, ulp, unfl, & wnorm save first, orth1, orth2, rstart, step3, step4, & ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl, & betaj, rnorm1, smlnum, ulp, unfl, wnorm c c %-----------------------% c | Local Array Arguments | c %-----------------------% c Real & xtemp(2) c c %----------------------% c | External Subroutines | c %----------------------% c external saxpy, scopy, sscal, sgemv, sgetv0, slabad, & svout, smout, ivout, second c c %--------------------% c | External Functions | c %--------------------% c Real & sdot, snrm2, slanhs, slamch external sdot, snrm2, slanhs, slamch c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic abs, sqrt c c %-----------------% c | Data statements | c %-----------------% c data first / .true. / c c %-----------------------% c | Executable Statements | c %-----------------------% c if (first) then c c %-----------------------------------------% c | Set machine-dependent constants for the | c | the splitting and deflation criterion. | c | If norm(H) <= sqrt(OVFL), | c | overflow should not occur. | c | REFERENCE: LAPACK subroutine slahqr | c %-----------------------------------------% c unfl = slamch( 'safe minimum' ) ovfl = one / unfl call slabad( unfl, ovfl ) ulp = slamch( 'precision' ) smlnum = unfl*( n / ulp ) first = .false. end if c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mnaitr c c %------------------------------% c | Initial call to this routine | c %------------------------------% c info = 0 step3 = .false. step4 = .false. rstart = .false. orth1 = .false. orth2 = .false. j = k + 1 ipj = 1 irj = ipj + n ivj = irj + n end if c c %-------------------------------------------------% c | When in reverse communication mode one of: | c | STEP3, STEP4, ORTH1, ORTH2, RSTART | c | will be .true. when .... | c | STEP3: return from computing OP*v_{j}. | c | STEP4: return from computing B-norm of OP*v_{j} | c | ORTH1: return from computing B-norm of r_{j+1} | c | ORTH2: return from computing B-norm of | c | correction to the residual vector. | c | RSTART: return from OP computations needed by | c | sgetv0. | c %-------------------------------------------------% c if (step3) go to 50 if (step4) go to 60 if (orth1) go to 70 if (orth2) go to 90 if (rstart) go to 30 c c %-----------------------------% c | Else this is the first step | c %-----------------------------% c c %--------------------------------------------------------------% c | | c | A R N O L D I I T E R A T I O N L O O P | c | | c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) | c %--------------------------------------------------------------% 1000 continue c if (msglvl .gt. 1) then call ivout (logfil, 1, j, ndigit, & '_naitr: generating Arnoldi vector number') call svout (logfil, 1, rnorm, ndigit, & '_naitr: B-norm of the current residual is') end if c c %---------------------------------------------------% c | STEP 1: Check if the B norm of j-th residual | c | vector is zero. Equivalent to determing whether | c | an exact j-step Arnoldi factorization is present. | c %---------------------------------------------------% c betaj = rnorm if (rnorm .gt. zero) go to 40 c c %---------------------------------------------------% c | Invariant subspace found, generate a new starting | c | vector which is orthogonal to the current Arnoldi | c | basis and continue the iteration. | c %---------------------------------------------------% c if (msglvl .gt. 0) then call ivout (logfil, 1, j, ndigit, & '_naitr: ****** RESTART AT STEP ******') end if c c %---------------------------------------------% c | ITRY is the loop variable that controls the | c | maximum amount of times that a restart is | c | attempted. NRSTRT is used by stat.h | c %---------------------------------------------% c betaj = zero nrstrt = nrstrt + 1 itry = 1 20 continue rstart = .true. ido = 0 30 continue c c %--------------------------------------% c | If in reverse communication mode and | c | RSTART = .true. flow returns here. | c %--------------------------------------% c call sgetv0 (ido, bmat, itry, .false., n, j, v, ldv, & resid, rnorm, ipntr, workd, ierr) if (ido .ne. 99) go to 9000 if (ierr .lt. 0) then itry = itry + 1 if (itry .le. 3) go to 20 c c %------------------------------------------------% c | Give up after several restart attempts. | c | Set INFO to the size of the invariant subspace | c | which spans OP and exit. | c %------------------------------------------------% c info = j - 1 call second (t1) tnaitr = tnaitr + (t1 - t0) ido = 99 go to 9000 end if c 40 continue c c %---------------------------------------------------------% c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm | c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow | c | when reciprocating a small RNORM, test against lower | c | machine bound. | c %---------------------------------------------------------% c call scopy (n, resid, 1, v(1,j), 1) if (rnorm .ge. unfl) then temp1 = one / rnorm call sscal (n, temp1, v(1,j), 1) call sscal (n, temp1, workd(ipj), 1) else c c %-----------------------------------------% c | To scale both v_{j} and p_{j} carefully | c | use LAPACK routine SLASCL | c %-----------------------------------------% c call slascl ('General', i, i, rnorm, one, n, 1, & v(1,j), n, infol) call slascl ('General', i, i, rnorm, one, n, 1, & workd(ipj), n, infol) end if c c %------------------------------------------------------% c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} | c | Note that this is not quite yet r_{j}. See STEP 4 | c %------------------------------------------------------% c step3 = .true. nopx = nopx + 1 call second (t2) call scopy (n, v(1,j), 1, workd(ivj), 1) ipntr(1) = ivj ipntr(2) = irj ipntr(3) = ipj ido = 1 c c %-----------------------------------% c | Exit in order to compute OP*v_{j} | c %-----------------------------------% c go to 9000 50 continue c c %----------------------------------% c | Back from reverse communication; | c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} | c | if step3 = .true. | c %----------------------------------% c call second (t3) tmvopx = tmvopx + (t3 - t2) step3 = .false. c c %------------------------------------------% c | Put another copy of OP*v_{j} into RESID. | c %------------------------------------------% c call scopy (n, workd(irj), 1, resid, 1) c c %---------------------------------------% c | STEP 4: Finish extending the Arnoldi | c | factorization to length j. | c %---------------------------------------% c call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 step4 = .true. ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %-------------------------------------% c | Exit in order to compute B*OP*v_{j} | c %-------------------------------------% c go to 9000 else if (bmat .eq. 'I') then call scopy (n, resid, 1, workd(ipj), 1) end if 60 continue c c %----------------------------------% c | Back from reverse communication; | c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} | c | if step4 = .true. | c %----------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c step4 = .false. c c %-------------------------------------% c | The following is needed for STEP 5. | c | Compute the B-norm of OP*v_{j}. | c %-------------------------------------% c if (bmat .eq. 'G') then wnorm = sdot (n, resid, 1, workd(ipj), 1) wnorm = sqrt(abs(wnorm)) else if (bmat .eq. 'I') then wnorm = snrm2(n, resid, 1) end if c c %-----------------------------------------% c | Compute the j-th residual corresponding | c | to the j step factorization. | c | Use Classical Gram Schmidt and compute: | c | w_{j} <- V_{j}^T * B * OP * v_{j} | c | r_{j} <- OP*v_{j} - V_{j} * w_{j} | c %-----------------------------------------% c c c %------------------------------------------% c | Compute the j Fourier coefficients w_{j} | c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. | c %------------------------------------------% c call sgemv ('T', n, j, one, v, ldv, workd(ipj), 1, & zero, h(1,j), 1) c c %--------------------------------------% c | Orthogonalize r_{j} against V_{j}. | c | RESID contains OP*v_{j}. See STEP 3. | c %--------------------------------------% c call sgemv ('N', n, j, -one, v, ldv, h(1,j), 1, & one, resid, 1) c if (j .gt. 1) h(j,j-1) = betaj c call second (t4) c orth1 = .true. c call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call scopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %----------------------------------% c | Exit in order to compute B*r_{j} | c %----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call scopy (n, resid, 1, workd(ipj), 1) end if 70 continue c c %---------------------------------------------------% c | Back from reverse communication if ORTH1 = .true. | c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. | c %---------------------------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c orth1 = .false. c c %------------------------------% c | Compute the B-norm of r_{j}. | c %------------------------------% c if (bmat .eq. 'G') then rnorm = sdot (n, resid, 1, workd(ipj), 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then rnorm = snrm2(n, resid, 1) end if c c %-----------------------------------------------------------% c | STEP 5: Re-orthogonalization / Iterative refinement phase | c | Maximum NITER_ITREF tries. | c | | c | s = V_{j}^T * B * r_{j} | c | r_{j} = r_{j} - V_{j}*s | c | alphaj = alphaj + s_{j} | c | | c | The stopping criteria used for iterative refinement is | c | discussed in Parlett's book SEP, page 107 and in Gragg & | c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. | c | Determine if we need to correct the residual. The goal is | c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || | c | The following test determines whether the sine of the | c | angle between OP*x and the computed residual is less | c | than or equal to 0.717. | c %-----------------------------------------------------------% c if (rnorm .gt. 0.717*wnorm) go to 100 iter = 0 nrorth = nrorth + 1 c c %---------------------------------------------------% c | Enter the Iterative refinement phase. If further | c | refinement is necessary, loop back here. The loop | c | variable is ITER. Perform a step of Classical | c | Gram-Schmidt using all the Arnoldi vectors V_{j} | c %---------------------------------------------------% c 80 continue c if (msglvl .gt. 2) then xtemp(1) = wnorm xtemp(2) = rnorm call svout (logfil, 2, xtemp, ndigit, & '_naitr: re-orthonalization; wnorm and rnorm are') call svout (logfil, j, h(1,j), ndigit, & '_naitr: j-th column of H') end if c c %----------------------------------------------------% c | Compute V_{j}^T * B * r_{j}. | c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). | c %----------------------------------------------------% c call sgemv ('T', n, j, one, v, ldv, workd(ipj), 1, & zero, workd(irj), 1) c c %---------------------------------------------% c | Compute the correction to the residual: | c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). | c | The correction to H is v(:,1:J)*H(1:J,1:J) | c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. | c %---------------------------------------------% c call sgemv ('N', n, j, -one, v, ldv, workd(irj), 1, & one, resid, 1) call saxpy (j, one, workd(irj), 1, h(1,j), 1) c orth2 = .true. call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call scopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %-----------------------------------% c | Exit in order to compute B*r_{j}. | c | r_{j} is the corrected residual. | c %-----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call scopy (n, resid, 1, workd(ipj), 1) end if 90 continue c c %---------------------------------------------------% c | Back from reverse communication if ORTH2 = .true. | c %---------------------------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c c %-----------------------------------------------------% c | Compute the B-norm of the corrected residual r_{j}. | c %-----------------------------------------------------% c if (bmat .eq. 'G') then rnorm1 = sdot (n, resid, 1, workd(ipj), 1) rnorm1 = sqrt(abs(rnorm1)) else if (bmat .eq. 'I') then rnorm1 = snrm2(n, resid, 1) end if c if (msglvl .gt. 0 .and. iter .gt. 0) then call ivout (logfil, 1, j, ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then xtemp(1) = rnorm xtemp(2) = rnorm1 call svout (logfil, 2, xtemp, ndigit, & '_naitr: iterative refinement ; rnorm and rnorm1 are') end if end if c c %-----------------------------------------% c | Determine if we need to perform another | c | step of re-orthogonalization. | c %-----------------------------------------% c if (rnorm1 .gt. 0.717*rnorm) then c c %---------------------------------------% c | No need for further refinement. | c | The cosine of the angle between the | c | corrected residual vector and the old | c | residual vector is greater than 0.717 | c | In other words the corrected residual | c | and the old residual vector share an | c | angle of less than arcCOS(0.717) | c %---------------------------------------% c rnorm = rnorm1 c else c c %-------------------------------------------% c | Another step of iterative refinement step | c | is required. NITREF is used by stat.h | c %-------------------------------------------% c nitref = nitref + 1 rnorm = rnorm1 iter = iter + 1 if (iter .le. 1) go to 80 c c %-------------------------------------------------% c | Otherwise RESID is numerically in the span of V | c %-------------------------------------------------% c do 95 jj = 1, n resid(jj) = zero 95 continue rnorm = zero end if c c %----------------------------------------------% c | Branch here directly if iterative refinement | c | wasn't necessary or after at most NITER_REF | c | steps of iterative refinement. | c %----------------------------------------------% c 100 continue c rstart = .false. orth2 = .false. c call second (t5) titref = titref + (t5 - t4) c c %------------------------------------% c | STEP 6: Update j = j+1; Continue | c %------------------------------------% c j = j + 1 if (j .gt. k+np) then call second (t1) tnaitr = tnaitr + (t1 - t0) ido = 99 do 110 i = max(1,k), k+np-1 c c %--------------------------------------------% c | Check for splitting and deflation. | c | Use a standard test as in the QR algorithm | c | REFERENCE: LAPACK subroutine slahqr | c %--------------------------------------------% c tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) ) if( tst1.eq.zero ) & tst1 = slanhs( '1', k+np, h, ldh, workd(n+1) ) if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) & h(i+1,i) = zero 110 continue c if (msglvl .gt. 2) then call smout (logfil, k+np, k+np, h, ldh, ndigit, & '_naitr: Final upper Hessenberg matrix H of order K+NP') end if c go to 9000 end if c c %--------------------------------------------------------% c | Loop back to extend the factorization by another step. | c %--------------------------------------------------------% c go to 1000 c c %---------------------------------------------------------------% c | | c | E N D O F M A I N I T E R A T I O N L O O P | c | | c %---------------------------------------------------------------% c 9000 continue return c c %---------------% c | End of snaitr | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/smout.f000644 001750 001750 00000012145 11266605602 021767 0ustar00geuzainegeuzaine000000 000000 *----------------------------------------------------------------------- * Routine: SMOUT * * Purpose: Real matrix output routine. * * Usage: CALL SMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT) * * Arguments * M - Number of rows of A. (Input) * N - Number of columns of A. (Input) * A - Real M by N matrix to be printed. (Input) * LDA - Leading dimension of A exactly as specified in the * dimension statement of the calling program. (Input) * IFMT - Format to be used in printing matrix A. (Input) * IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In) * If IDIGIT .LT. 0, printing is done with 72 columns. * If IDIGIT .GT. 0, printing is done with 132 columns. * *----------------------------------------------------------------------- * SUBROUTINE SMOUT( LOUT, M, N, A, LDA, IDIGIT, IFMT ) * ... * ... SPECIFICATIONS FOR ARGUMENTS INTEGER M, N, IDIGIT, LDA, LOUT REAL A( LDA, * ) CHARACTER IFMT*( * ) * ... * ... SPECIFICATIONS FOR LOCAL VARIABLES INTEGER I, J, NDIGIT, K1, K2, LLL CHARACTER*1 ICOL( 3 ) CHARACTER*80 LINE * ... * ... SPECIFICATIONS INTRINSICS INTRINSIC MIN * DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o', $ 'l' / * ... * ... FIRST EXECUTABLE STATEMENT * LLL = MIN( LEN( IFMT ), 80 ) DO 10 I = 1, LLL LINE( I: I ) = '-' 10 CONTINUE * DO 20 I = LLL + 1, 80 LINE( I: I ) = ' ' 20 CONTINUE * WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL ) 9999 FORMAT( / 1X, A / 1X, A ) * IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 ) $ RETURN NDIGIT = IDIGIT IF( IDIGIT.EQ.0 ) $ NDIGIT = 4 * *======================================================================= * CODE FOR OUTPUT USING 72 COLUMNS FORMAT *======================================================================= * IF( IDIGIT.LT.0 ) THEN NDIGIT = -IDIGIT IF( NDIGIT.LE.4 ) THEN DO 40 K1 = 1, N, 5 K2 = MIN0( N, K1+4 ) WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 ) DO 30 I = 1, M WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 ) 30 CONTINUE 40 CONTINUE * ELSE IF( NDIGIT.LE.6 ) THEN DO 60 K1 = 1, N, 4 K2 = MIN0( N, K1+3 ) WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 ) DO 50 I = 1, M WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 ) 50 CONTINUE 60 CONTINUE * ELSE IF( NDIGIT.LE.10 ) THEN DO 80 K1 = 1, N, 3 K2 = MIN0( N, K1+2 ) WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 ) DO 70 I = 1, M WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 ) 70 CONTINUE 80 CONTINUE * ELSE DO 100 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 ) DO 90 I = 1, M WRITE( LOUT, 9991 )I, ( A( I, J ), J = K1, K2 ) 90 CONTINUE 100 CONTINUE END IF * *======================================================================= * CODE FOR OUTPUT USING 132 COLUMNS FORMAT *======================================================================= * ELSE IF( NDIGIT.LE.4 ) THEN DO 120 K1 = 1, N, 10 K2 = MIN0( N, K1+9 ) WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 ) DO 110 I = 1, M WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 ) 110 CONTINUE 120 CONTINUE * ELSE IF( NDIGIT.LE.6 ) THEN DO 140 K1 = 1, N, 8 K2 = MIN0( N, K1+7 ) WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 ) DO 130 I = 1, M WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 ) 130 CONTINUE 140 CONTINUE * ELSE IF( NDIGIT.LE.10 ) THEN DO 160 K1 = 1, N, 6 K2 = MIN0( N, K1+5 ) WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 ) DO 150 I = 1, M WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 ) 150 CONTINUE 160 CONTINUE * ELSE DO 180 K1 = 1, N, 5 K2 = MIN0( N, K1+4 ) WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 ) DO 170 I = 1, M WRITE( LOUT, 9991 )I, ( A( I, J ), J = K1, K2 ) 170 CONTINUE 180 CONTINUE END IF END IF WRITE( LOUT, 9990 ) * 9998 FORMAT( 10X, 10( 4X, 3A1, I4, 1X ) ) 9997 FORMAT( 10X, 8( 5X, 3A1, I4, 2X ) ) 9996 FORMAT( 10X, 6( 7X, 3A1, I4, 4X ) ) 9995 FORMAT( 10X, 5( 9X, 3A1, I4, 6X ) ) 9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P10E12.3 ) 9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P8E14.5 ) 9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P6E18.9 ) 9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P5E22.13 ) 9990 FORMAT( 1X, ' ' ) * RETURN END getdp-2.7.0-source/contrib/Arpack/csortc.f000644 001750 001750 00000017575 11266605602 022131 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: csortc c c\Description: c Sorts the Complex array in X into the order c specified by WHICH and optionally applies the permutation to the c Real array Y. c c\Usage: c call csortc c ( WHICH, APPLY, N, X, Y ) c c\Arguments c WHICH Character*2. (Input) c 'LM' -> sort X into increasing order of magnitude. c 'SM' -> sort X into decreasing order of magnitude. c 'LR' -> sort X with real(X) in increasing algebraic order c 'SR' -> sort X with real(X) in decreasing algebraic order c 'LI' -> sort X with imag(X) in increasing algebraic order c 'SI' -> sort X with imag(X) in decreasing algebraic order c c APPLY Logical. (Input) c APPLY = .TRUE. -> apply the sorted order to array Y. c APPLY = .FALSE. -> do not apply the sorted order to array Y. c c N Integer. (INPUT) c Size of the arrays. c c X Complex array of length N. (INPUT/OUTPUT) c This is the array to be sorted. c c Y Complex array of length N. (INPUT/OUTPUT) c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Routines called: c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c Adapted from the sort routine in LANSO. c c\SCCS Information: @(#) c FILE: sortc.F SID: 2.2 DATE OF SID: 4/20/96 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine csortc (which, apply, n, x, y) c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which logical apply integer n c c %-----------------% c | Array Arguments | c %-----------------% c Complex & x(0:n-1), y(0:n-1) c c %---------------% c | Local Scalars | c %---------------% c integer i, igap, j Complex & temp Real & temp1, temp2 c c %--------------------% c | External functions | c %--------------------% c Real & slapy2 c c %--------------------% c | Intrinsic Functions | c %--------------------% Intrinsic & real, aimag c c %-----------------------% c | Executable Statements | c %-----------------------% c igap = n / 2 c if (which .eq. 'LM') then c c %--------------------------------------------% c | Sort X into increasing order of magnitude. | c %--------------------------------------------% c 10 continue if (igap .eq. 0) go to 9000 c do 30 i = igap, n-1 j = i-igap 20 continue c if (j.lt.0) go to 30 c temp1 = slapy2(real(x(j)),aimag(x(j))) temp2 = slapy2(real(x(j+igap)),aimag(x(j+igap))) c if (temp1.gt.temp2) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 30 end if j = j-igap go to 20 30 continue igap = igap / 2 go to 10 c else if (which .eq. 'SM') then c c %--------------------------------------------% c | Sort X into decreasing order of magnitude. | c %--------------------------------------------% c 40 continue if (igap .eq. 0) go to 9000 c do 60 i = igap, n-1 j = i-igap 50 continue c if (j .lt. 0) go to 60 c temp1 = slapy2(real(x(j)),aimag(x(j))) temp2 = slapy2(real(x(j+igap)),aimag(x(j+igap))) c if (temp1.lt.temp2) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 60 endif j = j-igap go to 50 60 continue igap = igap / 2 go to 40 c else if (which .eq. 'LR') then c c %------------------------------------------------% c | Sort XREAL into increasing order of algebraic. | c %------------------------------------------------% c 70 continue if (igap .eq. 0) go to 9000 c do 90 i = igap, n-1 j = i-igap 80 continue c if (j.lt.0) go to 90 c if (real(x(j)).gt.real(x(j+igap))) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 90 endif j = j-igap go to 80 90 continue igap = igap / 2 go to 70 c else if (which .eq. 'SR') then c c %------------------------------------------------% c | Sort XREAL into decreasing order of algebraic. | c %------------------------------------------------% c 100 continue if (igap .eq. 0) go to 9000 do 120 i = igap, n-1 j = i-igap 110 continue c if (j.lt.0) go to 120 c if (real(x(j)).lt.real(x(j+igap))) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 120 endif j = j-igap go to 110 120 continue igap = igap / 2 go to 100 c else if (which .eq. 'LI') then c c %--------------------------------------------% c | Sort XIMAG into increasing algebraic order | c %--------------------------------------------% c 130 continue if (igap .eq. 0) go to 9000 do 150 i = igap, n-1 j = i-igap 140 continue c if (j.lt.0) go to 150 c if (aimag(x(j)).gt.aimag(x(j+igap))) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 150 endif j = j-igap go to 140 150 continue igap = igap / 2 go to 130 c else if (which .eq. 'SI') then c c %---------------------------------------------% c | Sort XIMAG into decreasing algebraic order | c %---------------------------------------------% c 160 continue if (igap .eq. 0) go to 9000 do 180 i = igap, n-1 j = i-igap 170 continue c if (j.lt.0) go to 180 c if (aimag(x(j)).lt.aimag(x(j+igap))) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 180 endif j = j-igap go to 170 180 continue igap = igap / 2 go to 160 end if c 9000 continue return c c %---------------% c | End of csortc | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/snapps.f000644 001750 001750 00000055515 11266605602 022134 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: snapps c c\Description: c Given the Arnoldi factorization c c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T, c c apply NP implicit shifts resulting in c c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q c c where Q is an orthogonal matrix which is the product of rotations c and reflections resulting from the NP bulge chage sweeps. c The updated Arnoldi factorization becomes: c c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T. c c\Usage: c call snapps c ( N, KEV, NP, SHIFTR, SHIFTI, V, LDV, H, LDH, RESID, Q, LDQ, c WORKL, WORKD ) c c\Arguments c N Integer. (INPUT) c Problem size, i.e. size of matrix A. c c KEV Integer. (INPUT/OUTPUT) c KEV+NP is the size of the input matrix H. c KEV is the size of the updated matrix HNEW. KEV is only c updated on ouput when fewer than NP shifts are applied in c order to keep the conjugate pair together. c c NP Integer. (INPUT) c Number of implicit shifts to be applied. c c SHIFTR, Real array of length NP. (INPUT) c SHIFTI Real and imaginary part of the shifts to be applied. c Upon, entry to snapps, the shifts must be sorted so that the c conjugate pairs are in consecutive locations. c c V Real N by (KEV+NP) array. (INPUT/OUTPUT) c On INPUT, V contains the current KEV+NP Arnoldi vectors. c On OUTPUT, V contains the updated KEV Arnoldi vectors c in the first KEV columns of V. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Real (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT) c On INPUT, H contains the current KEV+NP by KEV+NP upper c Hessenber matrix of the Arnoldi factorization. c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg c matrix in the KEV leading submatrix. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RESID Real array of length N. (INPUT/OUTPUT) c On INPUT, RESID contains the the residual vector r_{k+p}. c On OUTPUT, RESID is the update residual vector rnew_{k} c in the first KEV locations. c c Q Real KEV+NP by KEV+NP work array. (WORKSPACE) c Work array used to accumulate the rotations and reflections c during the bulge chase sweep. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKL Real work array of length (KEV+NP). (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. c c WORKD Real work array of length 2*N. (WORKSPACE) c Distributed array used in the application of the accumulated c orthogonal matrix Q. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c c\Routines called: c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c smout ARPACK utility routine that prints matrices. c svout ARPACK utility routine that prints vectors. c slabad LAPACK routine that computes machine constants. c slacpy LAPACK matrix copy routine. c slamch LAPACK routine that determines machine constants. c slanhs LAPACK routine that computes various norms of a matrix. c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c slarf LAPACK routine that applies Householder reflection to c a matrix. c slarfg LAPACK Householder reflection construction routine. c slartg LAPACK Givens rotation construction routine. c slaset LAPACK matrix initialization routine. c sgemv Level 2 BLAS routine for matrix vector multiplication. c saxpy Level 1 BLAS that computes a vector triad. c scopy Level 1 BLAS that copies one vector to another . c sscal Level 1 BLAS that scales a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.4' c c\SCCS Information: @(#) c FILE: napps.F SID: 2.4 DATE OF SID: 3/28/97 RELEASE: 2 c c\Remarks c 1. In this version, each shift is applied to all the sublocks of c the Hessenberg matrix H and not just to the submatrix that it c comes from. Deflation as in LAPACK routine slahqr (QR algorithm c for upper Hessenberg matrices ) is used. c The subdiagonals of H are enforced to be non-negative. c c\EndLib c c----------------------------------------------------------------------- c subroutine snapps & ( n, kev, np, shiftr, shifti, v, ldv, h, ldh, resid, q, ldq, & workl, workd ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer kev, ldh, ldq, ldv, n, np c c %-----------------% c | Array Arguments | c %-----------------% c Real & h(ldh,kev+np), resid(n), shifti(np), shiftr(np), & v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np) c c %------------% c | Parameters | c %------------% c Real & one, zero parameter (one = 1.0E+0, zero = 0.0E+0) c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c integer i, iend, ir, istart, j, jj, kplusp, msglvl, nr logical cconj, first Real & c, f, g, h11, h12, h21, h22, h32, ovfl, r, s, sigmai, & sigmar, smlnum, ulp, unfl, u(3), t, tau, tst1 save first, ovfl, smlnum, ulp, unfl c c %----------------------% c | External Subroutines | c %----------------------% c external saxpy, scopy, sscal, slacpy, slarfg, slarf, & slaset, slabad, second, slartg c c %--------------------% c | External Functions | c %--------------------% c Real & slamch, slanhs, slapy2 external slamch, slanhs, slapy2 c c %----------------------% c | Intrinsics Functions | c %----------------------% c intrinsic abs, max, min c c %----------------% c | Data statments | c %----------------% c data first / .true. / c c %-----------------------% c | Executable Statements | c %-----------------------% c if (first) then c c %-----------------------------------------------% c | Set machine-dependent constants for the | c | stopping criterion. If norm(H) <= sqrt(OVFL), | c | overflow should not occur. | c | REFERENCE: LAPACK subroutine slahqr | c %-----------------------------------------------% c unfl = slamch( 'safe minimum' ) ovfl = one / unfl call slabad( unfl, ovfl ) ulp = slamch( 'precision' ) smlnum = unfl*( n / ulp ) first = .false. end if c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mnapps kplusp = kev + np c c %--------------------------------------------% c | Initialize Q to the identity to accumulate | c | the rotations and reflections | c %--------------------------------------------% c call slaset ('All', kplusp, kplusp, zero, one, q, ldq) c c %----------------------------------------------% c | Quick return if there are no shifts to apply | c %----------------------------------------------% c if (np .eq. 0) go to 9000 c c %----------------------------------------------% c | Chase the bulge with the application of each | c | implicit shift. Each shift is applied to the | c | whole matrix including each block. | c %----------------------------------------------% c cconj = .false. do 110 jj = 1, np sigmar = shiftr(jj) sigmai = shifti(jj) c if (msglvl .gt. 2 ) then call ivout (logfil, 1, jj, ndigit, & '_napps: shift number.') call svout (logfil, 1, sigmar, ndigit, & '_napps: The real part of the shift ') call svout (logfil, 1, sigmai, ndigit, & '_napps: The imaginary part of the shift ') end if c c %-------------------------------------------------% c | The following set of conditionals is necessary | c | in order that complex conjugate pairs of shifts | c | are applied together or not at all. | c %-------------------------------------------------% c if ( cconj ) then c c %-----------------------------------------% c | cconj = .true. means the previous shift | c | had non-zero imaginary part. | c %-----------------------------------------% c cconj = .false. go to 110 else if ( jj .lt. np .and. abs( sigmai ) .gt. zero ) then c c %------------------------------------% c | Start of a complex conjugate pair. | c %------------------------------------% c cconj = .true. else if ( jj .eq. np .and. abs( sigmai ) .gt. zero ) then c c %----------------------------------------------% c | The last shift has a nonzero imaginary part. | c | Don't apply it; thus the order of the | c | compressed H is order KEV+1 since only np-1 | c | were applied. | c %----------------------------------------------% c kev = kev + 1 go to 110 end if istart = 1 20 continue c c %--------------------------------------------------% c | if sigmai = 0 then | c | Apply the jj-th shift ... | c | else | c | Apply the jj-th and (jj+1)-th together ... | c | (Note that jj < np at this point in the code) | c | end | c | to the current block of H. The next do loop | c | determines the current block ; | c %--------------------------------------------------% c do 30 i = istart, kplusp-1 c c %----------------------------------------% c | Check for splitting and deflation. Use | c | a standard test as in the QR algorithm | c | REFERENCE: LAPACK subroutine slahqr | c %----------------------------------------% c tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) ) if( tst1.eq.zero ) & tst1 = slanhs( '1', kplusp-jj+1, h, ldh, workl ) if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) then if (msglvl .gt. 0) then call ivout (logfil, 1, i, ndigit, & '_napps: matrix splitting at row/column no.') call ivout (logfil, 1, jj, ndigit, & '_napps: matrix splitting with shift number.') call svout (logfil, 1, h(i+1,i), ndigit, & '_napps: off diagonal element.') end if iend = i h(i+1,i) = zero go to 40 end if 30 continue iend = kplusp 40 continue c if (msglvl .gt. 2) then call ivout (logfil, 1, istart, ndigit, & '_napps: Start of current block ') call ivout (logfil, 1, iend, ndigit, & '_napps: End of current block ') end if c c %------------------------------------------------% c | No reason to apply a shift to block of order 1 | c %------------------------------------------------% c if ( istart .eq. iend ) go to 100 c c %------------------------------------------------------% c | If istart + 1 = iend then no reason to apply a | c | complex conjugate pair of shifts on a 2 by 2 matrix. | c %------------------------------------------------------% c if ( istart + 1 .eq. iend .and. abs( sigmai ) .gt. zero ) & go to 100 c h11 = h(istart,istart) h21 = h(istart+1,istart) if ( abs( sigmai ) .le. zero ) then c c %---------------------------------------------% c | Real-valued shift ==> apply single shift QR | c %---------------------------------------------% c f = h11 - sigmar g = h21 c do 80 i = istart, iend-1 c c %-----------------------------------------------------% c | Contruct the plane rotation G to zero out the bulge | c %-----------------------------------------------------% c call slartg (f, g, c, s, r) if (i .gt. istart) then c c %-------------------------------------------% c | The following ensures that h(1:iend-1,1), | c | the first iend-2 off diagonal of elements | c | H, remain non negative. | c %-------------------------------------------% c if (r .lt. zero) then r = -r c = -c s = -s end if h(i,i-1) = r h(i+1,i-1) = zero end if c c %---------------------------------------------% c | Apply rotation to the left of H; H <- G'*H | c %---------------------------------------------% c do 50 j = i, kplusp t = c*h(i,j) + s*h(i+1,j) h(i+1,j) = -s*h(i,j) + c*h(i+1,j) h(i,j) = t 50 continue c c %---------------------------------------------% c | Apply rotation to the right of H; H <- H*G | c %---------------------------------------------% c do 60 j = 1, min(i+2,iend) t = c*h(j,i) + s*h(j,i+1) h(j,i+1) = -s*h(j,i) + c*h(j,i+1) h(j,i) = t 60 continue c c %----------------------------------------------------% c | Accumulate the rotation in the matrix Q; Q <- Q*G | c %----------------------------------------------------% c do 70 j = 1, min( i+jj, kplusp ) t = c*q(j,i) + s*q(j,i+1) q(j,i+1) = - s*q(j,i) + c*q(j,i+1) q(j,i) = t 70 continue c c %---------------------------% c | Prepare for next rotation | c %---------------------------% c if (i .lt. iend-1) then f = h(i+1,i) g = h(i+2,i) end if 80 continue c c %-----------------------------------% c | Finished applying the real shift. | c %-----------------------------------% c else c c %----------------------------------------------------% c | Complex conjugate shifts ==> apply double shift QR | c %----------------------------------------------------% c h12 = h(istart,istart+1) h22 = h(istart+1,istart+1) h32 = h(istart+2,istart+1) c c %---------------------------------------------------------% c | Compute 1st column of (H - shift*I)*(H - conj(shift)*I) | c %---------------------------------------------------------% c s = 2.0*sigmar t = slapy2 ( sigmar, sigmai ) u(1) = ( h11 * (h11 - s) + t * t ) / h21 + h12 u(2) = h11 + h22 - s u(3) = h32 c do 90 i = istart, iend-1 c nr = min ( 3, iend-i+1 ) c c %-----------------------------------------------------% c | Construct Householder reflector G to zero out u(1). | c | G is of the form I - tau*( 1 u )' * ( 1 u' ). | c %-----------------------------------------------------% c call slarfg ( nr, u(1), u(2), 1, tau ) c if (i .gt. istart) then h(i,i-1) = u(1) h(i+1,i-1) = zero if (i .lt. iend-1) h(i+2,i-1) = zero end if u(1) = one c c %--------------------------------------% c | Apply the reflector to the left of H | c %--------------------------------------% c call slarf ('Left', nr, kplusp-i+1, u, 1, tau, & h(i,i), ldh, workl) c c %---------------------------------------% c | Apply the reflector to the right of H | c %---------------------------------------% c ir = min ( i+3, iend ) call slarf ('Right', ir, nr, u, 1, tau, & h(1,i), ldh, workl) c c %-----------------------------------------------------% c | Accumulate the reflector in the matrix Q; Q <- Q*G | c %-----------------------------------------------------% c call slarf ('Right', kplusp, nr, u, 1, tau, & q(1,i), ldq, workl) c c %----------------------------% c | Prepare for next reflector | c %----------------------------% c if (i .lt. iend-1) then u(1) = h(i+1,i) u(2) = h(i+2,i) if (i .lt. iend-2) u(3) = h(i+3,i) end if c 90 continue c c %--------------------------------------------% c | Finished applying a complex pair of shifts | c | to the current block | c %--------------------------------------------% c end if c 100 continue c c %---------------------------------------------------------% c | Apply the same shift to the next block if there is any. | c %---------------------------------------------------------% c istart = iend + 1 if (iend .lt. kplusp) go to 20 c c %---------------------------------------------% c | Loop back to the top to get the next shift. | c %---------------------------------------------% c 110 continue c c %--------------------------------------------------% c | Perform a similarity transformation that makes | c | sure that H will have non negative sub diagonals | c %--------------------------------------------------% c do 120 j=1,kev if ( h(j+1,j) .lt. zero ) then call sscal( kplusp-j+1, -one, h(j+1,j), ldh ) call sscal( min(j+2, kplusp), -one, h(1,j+1), 1 ) call sscal( min(j+np+1,kplusp), -one, q(1,j+1), 1 ) end if 120 continue c do 130 i = 1, kev c c %--------------------------------------------% c | Final check for splitting and deflation. | c | Use a standard test as in the QR algorithm | c | REFERENCE: LAPACK subroutine slahqr | c %--------------------------------------------% c tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) ) if( tst1.eq.zero ) & tst1 = slanhs( '1', kev, h, ldh, workl ) if( h( i+1,i ) .le. max( ulp*tst1, smlnum ) ) & h(i+1,i) = zero 130 continue c c %-------------------------------------------------% c | Compute the (kev+1)-st column of (V*Q) and | c | temporarily store the result in WORKD(N+1:2*N). | c | This is needed in the residual update since we | c | cannot GUARANTEE that the corresponding entry | c | of H would be zero as in exact arithmetic. | c %-------------------------------------------------% c if (h(kev+1,kev) .gt. zero) & call sgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero, & workd(n+1), 1) c c %----------------------------------------------------------% c | Compute column 1 to kev of (V*Q) in backward order | c | taking advantage of the upper Hessenberg structure of Q. | c %----------------------------------------------------------% c do 140 i = 1, kev call sgemv ('N', n, kplusp-i+1, one, v, ldv, & q(1,kev-i+1), 1, zero, workd, 1) call scopy (n, workd, 1, v(1,kplusp-i+1), 1) 140 continue c c %-------------------------------------------------% c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). | c %-------------------------------------------------% c call slacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv) c c %--------------------------------------------------------------% c | Copy the (kev+1)-st column of (V*Q) in the appropriate place | c %--------------------------------------------------------------% c if (h(kev+1,kev) .gt. zero) & call scopy (n, workd(n+1), 1, v(1,kev+1), 1) c c %-------------------------------------% c | Update the residual vector: | c | r <- sigmak*r + betak*v(:,kev+1) | c | where | c | sigmak = (e_{kplusp}'*Q)*e_{kev} | c | betak = e_{kev+1}'*H*e_{kev} | c %-------------------------------------% c call sscal (n, q(kplusp,kev), resid, 1) if (h(kev+1,kev) .gt. zero) & call saxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1) c if (msglvl .gt. 1) then call svout (logfil, 1, q(kplusp,kev), ndigit, & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}') call svout (logfil, 1, h(kev+1,kev), ndigit, & '_napps: betak = e_{kev+1}^T*H*e_{kev}') call ivout (logfil, 1, kev, ndigit, & '_napps: Order of the final Hessenberg matrix ') if (msglvl .gt. 2) then call smout (logfil, kev, kev, h, ldh, ndigit, & '_napps: updated Hessenberg matrix H for next iteration') end if c end if c 9000 continue call second (t1) tnapps = tnapps + (t1 - t0) c return c c %---------------% c | End of snapps | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/snconv.f000644 001750 001750 00000007641 11266605602 022133 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: snconv c c\Description: c Convergence testing for the nonsymmetric Arnoldi eigenvalue routine. c c\Usage: c call snconv c ( N, RITZR, RITZI, BOUNDS, TOL, NCONV ) c c\Arguments c N Integer. (INPUT) c Number of Ritz values to check for convergence. c c RITZR, Real arrays of length N. (INPUT) c RITZI Real and imaginary parts of the Ritz values to be checked c for convergence. c BOUNDS Real array of length N. (INPUT) c Ritz estimates for the Ritz values in RITZR and RITZI. c c TOL Real scalar. (INPUT) c Desired backward error for a Ritz value to be considered c "converged". c c NCONV Integer scalar. (OUTPUT) c Number of "converged" Ritz values. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c second ARPACK utility routine for timing. c slamch LAPACK routine that determines machine constants. c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.1' c c\SCCS Information: @(#) c FILE: nconv.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 c c\Remarks c 1. xxxx c c\EndLib c c----------------------------------------------------------------------- c subroutine snconv (n, ritzr, ritzi, bounds, tol, nconv) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer n, nconv Real & tol c c %-----------------% c | Array Arguments | c %-----------------% Real & ritzr(n), ritzi(n), bounds(n) c c %---------------% c | Local Scalars | c %---------------% c integer i Real & temp, eps23 c c %--------------------% c | External Functions | c %--------------------% c Real & slapy2, slamch external slapy2, slamch c %-----------------------% c | Executable Statements | c %-----------------------% c c %-------------------------------------------------------------% c | Convergence test: unlike in the symmetric code, I am not | c | using things like refined error bounds and gap condition | c | because I don't know the exact equivalent concept. | c | | c | Instead the i-th Ritz value is considered "converged" when: | c | | c | bounds(i) .le. ( TOL * | ritz | ) | c | | c | for some appropriate choice of norm. | c %-------------------------------------------------------------% c call second (t0) c c %---------------------------------% c | Get machine dependent constant. | c %---------------------------------% c eps23 = slamch('Epsilon-Machine') eps23 = eps23**(2.0E+0 / 3.0E+0) c nconv = 0 do 20 i = 1, n temp = max( eps23, slapy2( ritzr(i), ritzi(i) ) ) if (bounds(i) .le. tol*temp) nconv = nconv + 1 20 continue c call second (t1) tnconv = tnconv + (t1 - t0) c return c c %---------------% c | End of snconv | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dgetv0.f000644 001750 001750 00000031642 11266605602 022014 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: dgetv0 c c\Description: c Generate a random initial residual vector for the Arnoldi process. c Force the residual vector to be in the range of the operator OP. c c\Usage: c call dgetv0 c ( IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM, c IPNTR, WORKD, IERR ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. IDO must be zero on the first c call to dgetv0. c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c This is for the initialization phase to force the c starting vector into the range of OP. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c IDO = 99: done c ------------------------------------------------------------- c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B in the (generalized) c eigenvalue problem A*x = lambda*B*x. c B = 'I' -> standard eigenvalue problem A*x = lambda*x c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x c c ITRY Integer. (INPUT) c ITRY counts the number of times that dgetv0 is called. c It should be set to 1 on the initial call to dgetv0. c c INITV Logical variable. (INPUT) c .TRUE. => the initial residual vector is given in RESID. c .FALSE. => generate a random initial residual vector. c c N Integer. (INPUT) c Dimension of the problem. c c J Integer. (INPUT) c Index of the residual vector to be generated, with respect to c the Arnoldi process. J > 1 in case of a "restart". c c V Double precision N by J array. (INPUT) c The first J-1 columns of V contain the current Arnoldi basis c if this is a "restart". c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c RESID Double precision array of length N. (INPUT/OUTPUT) c Initial residual vector to be generated. If RESID is c provided, force RESID into the range of the operator OP. c c RNORM Double precision scalar. (OUTPUT) c B-norm of the generated residual. c c IPNTR Integer array of length 3. (OUTPUT) c c WORKD Double precision work array of length 2*N. (REVERSE COMMUNICATION). c On exit, WORK(1:N) = B*RESID to be used in SSAITR. c c IERR Integer. (OUTPUT) c = 0: Normal exit. c = -1: Cannot generate a nontrivial restarted residual vector c in the range of the operator OP. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: c second ARPACK utility routine for timing. c dvout ARPACK utility routine for vector output. c dlarnv LAPACK routine for generating a random vector. c dgemv Level 2 BLAS routine for matrix vector multiplication. c dcopy Level 1 BLAS that copies one vector to another. c ddot Level 1 BLAS that computes the scalar product of two vectors. c dnrm2 Level 1 BLAS that computes the norm of a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: getv0.F SID: 2.7 DATE OF SID: 04/07/99 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine dgetv0 & ( ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm, & ipntr, workd, ierr ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1 logical initv integer ido, ierr, itry, j, ldv, n Double precision & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(3) Double precision & resid(n), v(ldv,j), workd(2*n) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c logical first, inits, orth integer idist, iseed(4), iter, msglvl, jj Double precision & rnorm0 save first, iseed, inits, iter, msglvl, orth, rnorm0 c c %----------------------% c | External Subroutines | c %----------------------% c external dlarnv, dvout, dcopy, dgemv, second c c %--------------------% c | External Functions | c %--------------------% c Double precision & ddot, dnrm2 external ddot, dnrm2 c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic abs, sqrt c c %-----------------% c | Data Statements | c %-----------------% c data inits /.true./ c c %-----------------------% c | Executable Statements | c %-----------------------% c c c %-----------------------------------% c | Initialize the seed of the LAPACK | c | random number generator | c %-----------------------------------% c if (inits) then iseed(1) = 1 iseed(2) = 3 iseed(3) = 5 iseed(4) = 7 inits = .false. end if c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mgetv0 c ierr = 0 iter = 0 first = .FALSE. orth = .FALSE. c c %-----------------------------------------------------% c | Possibly generate a random starting vector in RESID | c | Use a LAPACK random number generator used by the | c | matrix generation routines. | c | idist = 1: uniform (0,1) distribution; | c | idist = 2: uniform (-1,1) distribution; | c | idist = 3: normal (0,1) distribution; | c %-----------------------------------------------------% c if (.not.initv) then idist = 2 call dlarnv (idist, iseed, n, resid) end if c c %----------------------------------------------------------% c | Force the starting vector into the range of OP to handle | c | the generalized problem when B is possibly (singular). | c %----------------------------------------------------------% c call second (t2) if (bmat .eq. 'G') then nopx = nopx + 1 ipntr(1) = 1 ipntr(2) = n + 1 call dcopy (n, resid, 1, workd, 1) ido = -1 go to 9000 end if end if c c %-----------------------------------------% c | Back from computing OP*(initial-vector) | c %-----------------------------------------% c if (first) go to 20 c c %-----------------------------------------------% c | Back from computing B*(orthogonalized-vector) | c %-----------------------------------------------% c if (orth) go to 40 c if (bmat .eq. 'G') then call second (t3) tmvopx = tmvopx + (t3 - t2) end if c c %------------------------------------------------------% c | Starting vector is now in the range of OP; r = OP*r; | c | Compute B-norm of starting vector. | c %------------------------------------------------------% c call second (t2) first = .TRUE. if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, workd(n+1), 1, resid, 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd, 1) end if c 20 continue c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c first = .FALSE. if (bmat .eq. 'G') then rnorm0 = ddot (n, resid, 1, workd, 1) rnorm0 = sqrt(abs(rnorm0)) else if (bmat .eq. 'I') then rnorm0 = dnrm2(n, resid, 1) end if rnorm = rnorm0 c c %---------------------------------------------% c | Exit if this is the very first Arnoldi step | c %---------------------------------------------% c if (j .eq. 1) go to 50 c c %---------------------------------------------------------------- c | Otherwise need to B-orthogonalize the starting vector against | c | the current Arnoldi basis using Gram-Schmidt with iter. ref. | c | This is the case where an invariant subspace is encountered | c | in the middle of the Arnoldi factorization. | c | | c | s = V^{T}*B*r; r = r - V*s; | c | | c | Stopping criteria used for iter. ref. is discussed in | c | Parlett's book, page 107 and in Gragg & Reichel TOMS paper. | c %---------------------------------------------------------------% c orth = .TRUE. 30 continue c call dgemv ('T', n, j-1, one, v, ldv, workd, 1, & zero, workd(n+1), 1) call dgemv ('N', n, j-1, -one, v, ldv, workd(n+1), 1, & one, resid, 1) c c %----------------------------------------------------------% c | Compute the B-norm of the orthogonalized starting vector | c %----------------------------------------------------------% c call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(n+1), 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd, 1) end if c 40 continue c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c if (bmat .eq. 'G') then rnorm = ddot (n, resid, 1, workd, 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then rnorm = dnrm2(n, resid, 1) end if c c %--------------------------------------% c | Check for further orthogonalization. | c %--------------------------------------% c if (msglvl .gt. 2) then call dvout (logfil, 1, rnorm0, ndigit, & '_getv0: re-orthonalization ; rnorm0 is') call dvout (logfil, 1, rnorm, ndigit, & '_getv0: re-orthonalization ; rnorm is') end if c if (rnorm .gt. 0.717*rnorm0) go to 50 c iter = iter + 1 if (iter .le. 5) then c c %-----------------------------------% c | Perform iterative refinement step | c %-----------------------------------% c rnorm0 = rnorm go to 30 else c c %------------------------------------% c | Iterative refinement step "failed" | c %------------------------------------% c do 45 jj = 1, n resid(jj) = zero 45 continue rnorm = zero ierr = -1 end if c 50 continue c if (msglvl .gt. 0) then call dvout (logfil, 1, rnorm, ndigit, & '_getv0: B-norm of initial / restarted starting vector') end if if (msglvl .gt. 3) then call dvout (logfil, n, resid, ndigit, & '_getv0: initial / restarted starting vector') end if ido = 99 c call second (t1) tgetv0 = tgetv0 + (t1 - t0) c 9000 continue return c c %---------------% c | End of dgetv0 | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/sngets.f000644 001750 001750 00000017454 11266605602 022133 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: sngets c c\Description: c Given the eigenvalues of the upper Hessenberg matrix H, c computes the NP shifts AMU that are zeros of the polynomial of c degree NP which filters out components of the unwanted eigenvectors c corresponding to the AMU's based on some given criteria. c c NOTE: call this even in the case of user specified shifts in order c to sort the eigenvalues, and error bounds of H for later use. c c\Usage: c call sngets c ( ISHIFT, WHICH, KEV, NP, RITZR, RITZI, BOUNDS, SHIFTR, SHIFTI ) c c\Arguments c ISHIFT Integer. (INPUT) c Method for selecting the implicit shifts at each iteration. c ISHIFT = 0: user specified shifts c ISHIFT = 1: exact shift with respect to the matrix H. c c WHICH Character*2. (INPUT) c Shift selection criteria. c 'LM' -> want the KEV eigenvalues of largest magnitude. c 'SM' -> want the KEV eigenvalues of smallest magnitude. c 'LR' -> want the KEV eigenvalues of largest real part. c 'SR' -> want the KEV eigenvalues of smallest real part. c 'LI' -> want the KEV eigenvalues of largest imaginary part. c 'SI' -> want the KEV eigenvalues of smallest imaginary part. c c KEV Integer. (INPUT/OUTPUT) c INPUT: KEV+NP is the size of the matrix H. c OUTPUT: Possibly increases KEV by one to keep complex conjugate c pairs together. c c NP Integer. (INPUT/OUTPUT) c Number of implicit shifts to be computed. c OUTPUT: Possibly decreases NP by one to keep complex conjugate c pairs together. c c RITZR, Real array of length KEV+NP. (INPUT/OUTPUT) c RITZI On INPUT, RITZR and RITZI contain the real and imaginary c parts of the eigenvalues of H. c On OUTPUT, RITZR and RITZI are sorted so that the unwanted c eigenvalues are in the first NP locations and the wanted c portion is in the last KEV locations. When exact shifts are c selected, the unwanted part corresponds to the shifts to c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues c are further sorted so that the ones with largest Ritz values c are first. c c BOUNDS Real array of length KEV+NP. (INPUT/OUTPUT) c Error bounds corresponding to the ordering in RITZ. c c SHIFTR, SHIFTI *** USE deprecated as of version 2.1. *** c c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c ssortc ARPACK sorting routine. c scopy Level 1 BLAS that copies one vector to another . c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.1' c c\SCCS Information: @(#) c FILE: ngets.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 c c\Remarks c 1. xxxx c c\EndLib c c----------------------------------------------------------------------- c subroutine sngets ( ishift, which, kev, np, ritzr, ritzi, bounds, & shiftr, shifti ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which integer ishift, kev, np c c %-----------------% c | Array Arguments | c %-----------------% c Real & bounds(kev+np), ritzr(kev+np), ritzi(kev+np), & shiftr(1), shifti(1) c c %------------% c | Parameters | c %------------% c Real & one, zero parameter (one = 1.0, zero = 0.0) c c %---------------% c | Local Scalars | c %---------------% c integer msglvl c c %----------------------% c | External Subroutines | c %----------------------% c external scopy, ssortc, second c c %----------------------% c | Intrinsics Functions | c %----------------------% c intrinsic abs c c %-----------------------% c | Executable Statements | c %-----------------------% c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mngets c c %----------------------------------------------------% c | LM, SM, LR, SR, LI, SI case. | c | Sort the eigenvalues of H into the desired order | c | and apply the resulting order to BOUNDS. | c | The eigenvalues are sorted so that the wanted part | c | are always in the last KEV locations. | c | We first do a pre-processing sort in order to keep | c | complex conjugate pairs together | c %----------------------------------------------------% c if (which .eq. 'LM') then call ssortc ('LR', .true., kev+np, ritzr, ritzi, bounds) else if (which .eq. 'SM') then call ssortc ('SR', .true., kev+np, ritzr, ritzi, bounds) else if (which .eq. 'LR') then call ssortc ('LM', .true., kev+np, ritzr, ritzi, bounds) else if (which .eq. 'SR') then call ssortc ('SM', .true., kev+np, ritzr, ritzi, bounds) else if (which .eq. 'LI') then call ssortc ('LM', .true., kev+np, ritzr, ritzi, bounds) else if (which .eq. 'SI') then call ssortc ('SM', .true., kev+np, ritzr, ritzi, bounds) end if c call ssortc (which, .true., kev+np, ritzr, ritzi, bounds) c c %-------------------------------------------------------% c | Increase KEV by one if the ( ritzr(np),ritzi(np) ) | c | = ( ritzr(np+1),-ritzi(np+1) ) and ritz(np) .ne. zero | c | Accordingly decrease NP by one. In other words keep | c | complex conjugate pairs together. | c %-------------------------------------------------------% c if ( ( ritzr(np+1) - ritzr(np) ) .eq. zero & .and. ( ritzi(np+1) + ritzi(np) ) .eq. zero ) then np = np - 1 kev = kev + 1 end if c if ( ishift .eq. 1 ) then c c %-------------------------------------------------------% c | Sort the unwanted Ritz values used as shifts so that | c | the ones with largest Ritz estimates are first | c | This will tend to minimize the effects of the | c | forward instability of the iteration when they shifts | c | are applied in subroutine snapps. | c | Be careful and use 'SR' since we want to sort BOUNDS! | c %-------------------------------------------------------% c call ssortc ( 'SR', .true., np, bounds, ritzr, ritzi ) end if c call second (t1) tngets = tngets + (t1 - t0) c if (msglvl .gt. 0) then call ivout (logfil, 1, kev, ndigit, '_ngets: KEV is') call ivout (logfil, 1, np, ndigit, '_ngets: NP is') call svout (logfil, kev+np, ritzr, ndigit, & '_ngets: Eigenvalues of current H matrix -- real part') call svout (logfil, kev+np, ritzi, ndigit, & '_ngets: Eigenvalues of current H matrix -- imag part') call svout (logfil, kev+np, bounds, ndigit, & '_ngets: Ritz estimates of the current KEV+NP Ritz values') end if c return c c %---------------% c | End of sngets | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dsaitr.f000644 001750 001750 00000074133 11266605602 022113 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: dsaitr c c\Description: c Reverse communication interface for applying NP additional steps to c a K step symmetric Arnoldi factorization. c c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T c c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0. c c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T c c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0. c c where OP and B are as in dsaupd. The B-norm of r_{k+p} is also c computed and returned. c c\Usage: c call dsaitr c ( IDO, BMAT, N, K, NP, MODE, RESID, RNORM, V, LDV, H, LDH, c IPNTR, WORKD, INFO ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y. c This is for the restart phase to force the new c starting vector into the range of OP. c IDO = 1: compute Y = OP * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y, c IPNTR(3) is the pointer into WORK for B * X. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y. c IDO = 99: done c ------------------------------------------------------------- c When the routine is used in the "shift-and-invert" mode, the c vector B * Q is already available and does not need to be c recomputed in forming OP * Q. c c BMAT Character*1. (INPUT) c BMAT specifies the type of matrix B that defines the c semi-inner product for the operator OP. See dsaupd. c B = 'I' -> standard eigenvalue problem A*x = lambda*x c B = 'G' -> generalized eigenvalue problem A*x = lambda*M*x c c N Integer. (INPUT) c Dimension of the eigenproblem. c c K Integer. (INPUT) c Current order of H and the number of columns of V. c c NP Integer. (INPUT) c Number of additional Arnoldi steps to take. c c MODE Integer. (INPUT) c Signifies which form for "OP". If MODE=2 then c a reduction in the number of B matrix vector multiplies c is possible since the B-norm of OP*x is equivalent to c the inv(B)-norm of A*x. c c RESID Double precision array of length N. (INPUT/OUTPUT) c On INPUT: RESID contains the residual vector r_{k}. c On OUTPUT: RESID contains the residual vector r_{k+p}. c c RNORM Double precision scalar. (INPUT/OUTPUT) c On INPUT the B-norm of r_{k}. c On OUTPUT the B-norm of the updated residual r_{k+p}. c c V Double precision N by K+NP array. (INPUT/OUTPUT) c On INPUT: V contains the Arnoldi vectors in the first K c columns. c On OUTPUT: V contains the new NP Arnoldi vectors in the next c NP columns. The first K columns are unchanged. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Double precision (K+NP) by 2 array. (INPUT/OUTPUT) c H is used to store the generated symmetric tridiagonal matrix c with the subdiagonal in the first column starting at H(2,1) c and the main diagonal in the second column. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c IPNTR Integer array of length 3. (OUTPUT) c Pointer to mark the starting locations in the WORK for c vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. c IPNTR(3): pointer to the vector B * X when used in the c shift-and-invert mode. X is the current operand. c ------------------------------------------------------------- c c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The calling program should not c use WORKD as temporary workspace during the iteration !!!!!! c On INPUT, WORKD(1:N) = B*RESID where RESID is associated c with the K step Arnoldi factorization. Used to save some c computation at the first step. c On OUTPUT, WORKD(1:N) = B*RESID where RESID is associated c with the K+NP step Arnoldi factorization. c c INFO Integer. (OUTPUT) c = 0: Normal exit. c > 0: Size of an invariant subspace of OP is found that is c less than K + NP. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c dgetv0 ARPACK routine to generate the initial vector. c ivout ARPACK utility routine that prints integers. c dmout ARPACK utility routine that prints matrices. c dvout ARPACK utility routine that prints vectors. c dlamch LAPACK routine that determines machine constants. c dlascl LAPACK routine for careful scaling of a matrix. c dgemv Level 2 BLAS routine for matrix vector multiplication. c daxpy Level 1 BLAS that computes a vector triad. c dscal Level 1 BLAS that scales a vector. c dcopy Level 1 BLAS that copies one vector to another . c ddot Level 1 BLAS that computes the scalar product of two vectors. c dnrm2 Level 1 BLAS that computes the norm of a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/93: Version ' 2.4' c c\SCCS Information: @(#) c FILE: saitr.F SID: 2.6 DATE OF SID: 8/28/96 RELEASE: 2 c c\Remarks c The algorithm implemented is: c c restart = .false. c Given V_{k} = [v_{1}, ..., v_{k}], r_{k}; c r_{k} contains the initial residual vector even for k = 0; c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already c computed by the calling program. c c betaj = rnorm ; p_{k+1} = B*r_{k} ; c For j = k+1, ..., k+np Do c 1) if ( betaj < tol ) stop or restart depending on j. c if ( restart ) generate a new starting vector. c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}]; c p_{j} = p_{j}/betaj c 3) r_{j} = OP*v_{j} where OP is defined as in dsaupd c For shift-invert mode p_{j} = B*v_{j} is already available. c wnorm = || OP*v_{j} || c 4) Compute the j-th step residual vector. c w_{j} = V_{j}^T * B * OP * v_{j} c r_{j} = OP*v_{j} - V_{j} * w_{j} c alphaj <- j-th component of w_{j} c rnorm = || r_{j} || c betaj+1 = rnorm c If (rnorm > 0.717*wnorm) accept step and go back to 1) c 5) Re-orthogonalization step: c s = V_{j}'*B*r_{j} c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} || c alphaj = alphaj + s_{j}; c 6) Iterative refinement step: c If (rnorm1 > 0.717*rnorm) then c rnorm = rnorm1 c accept step and go back to 1) c Else c rnorm = rnorm1 c If this is the first time in step 6), go to 5) c Else r_{j} lies in the span of V_{j} numerically. c Set r_{j} = 0 and rnorm = 0; go to 1) c EndIf c End Do c c\EndLib c c----------------------------------------------------------------------- c subroutine dsaitr & (ido, bmat, n, k, np, mode, resid, rnorm, v, ldv, h, ldh, & ipntr, workd, info) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1 integer ido, info, k, ldh, ldv, n, mode, np Double precision & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(3) Double precision & h(ldh,2), resid(n), v(ldv,k+np), workd(3*n) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c logical first, orth1, orth2, rstart, step3, step4 integer i, ierr, ipj, irj, ivj, iter, itry, j, msglvl, & infol, jj Double precision & rnorm1, wnorm, safmin, temp1 save orth1, orth2, rstart, step3, step4, & ierr, ipj, irj, ivj, iter, itry, j, msglvl, & rnorm1, safmin, wnorm c c %-----------------------% c | Local Array Arguments | c %-----------------------% c Double precision & xtemp(2) c c %----------------------% c | External Subroutines | c %----------------------% c external daxpy, dcopy, dscal, dgemv, dgetv0, dvout, dmout, & dlascl, ivout, second c c %--------------------% c | External Functions | c %--------------------% c Double precision & ddot, dnrm2, dlamch external ddot, dnrm2, dlamch c c %-----------------% c | Data statements | c %-----------------% c data first / .true. / c c %-----------------------% c | Executable Statements | c %-----------------------% c if (first) then first = .false. c c %--------------------------------% c | safmin = safe minimum is such | c | that 1/sfmin does not overflow | c %--------------------------------% c safmin = dlamch('safmin') end if c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = msaitr c c %------------------------------% c | Initial call to this routine | c %------------------------------% c info = 0 step3 = .false. step4 = .false. rstart = .false. orth1 = .false. orth2 = .false. c c %--------------------------------% c | Pointer to the current step of | c | the factorization to build | c %--------------------------------% c j = k + 1 c c %------------------------------------------% c | Pointers used for reverse communication | c | when using WORKD. | c %------------------------------------------% c ipj = 1 irj = ipj + n ivj = irj + n end if c c %-------------------------------------------------% c | When in reverse communication mode one of: | c | STEP3, STEP4, ORTH1, ORTH2, RSTART | c | will be .true. | c | STEP3: return from computing OP*v_{j}. | c | STEP4: return from computing B-norm of OP*v_{j} | c | ORTH1: return from computing B-norm of r_{j+1} | c | ORTH2: return from computing B-norm of | c | correction to the residual vector. | c | RSTART: return from OP computations needed by | c | dgetv0. | c %-------------------------------------------------% c if (step3) go to 50 if (step4) go to 60 if (orth1) go to 70 if (orth2) go to 90 if (rstart) go to 30 c c %------------------------------% c | Else this is the first step. | c %------------------------------% c c %--------------------------------------------------------------% c | | c | A R N O L D I I T E R A T I O N L O O P | c | | c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) | c %--------------------------------------------------------------% c 1000 continue c if (msglvl .gt. 2) then call ivout (logfil, 1, j, ndigit, & '_saitr: generating Arnoldi vector no.') call dvout (logfil, 1, rnorm, ndigit, & '_saitr: B-norm of the current residual =') end if c c %---------------------------------------------------------% c | Check for exact zero. Equivalent to determing whether a | c | j-step Arnoldi factorization is present. | c %---------------------------------------------------------% c if (rnorm .gt. zero) go to 40 c c %---------------------------------------------------% c | Invariant subspace found, generate a new starting | c | vector which is orthogonal to the current Arnoldi | c | basis and continue the iteration. | c %---------------------------------------------------% c if (msglvl .gt. 0) then call ivout (logfil, 1, j, ndigit, & '_saitr: ****** restart at step ******') end if c c %---------------------------------------------% c | ITRY is the loop variable that controls the | c | maximum amount of times that a restart is | c | attempted. NRSTRT is used by stat.h | c %---------------------------------------------% c nrstrt = nrstrt + 1 itry = 1 20 continue rstart = .true. ido = 0 30 continue c c %--------------------------------------% c | If in reverse communication mode and | c | RSTART = .true. flow returns here. | c %--------------------------------------% c call dgetv0 (ido, bmat, itry, .false., n, j, v, ldv, & resid, rnorm, ipntr, workd, ierr) if (ido .ne. 99) go to 9000 if (ierr .lt. 0) then itry = itry + 1 if (itry .le. 3) go to 20 c c %------------------------------------------------% c | Give up after several restart attempts. | c | Set INFO to the size of the invariant subspace | c | which spans OP and exit. | c %------------------------------------------------% c info = j - 1 call second (t1) tsaitr = tsaitr + (t1 - t0) ido = 99 go to 9000 end if c 40 continue c c %---------------------------------------------------------% c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm | c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow | c | when reciprocating a small RNORM, test against lower | c | machine bound. | c %---------------------------------------------------------% c call dcopy (n, resid, 1, v(1,j), 1) if (rnorm .ge. safmin) then temp1 = one / rnorm call dscal (n, temp1, v(1,j), 1) call dscal (n, temp1, workd(ipj), 1) else c c %-----------------------------------------% c | To scale both v_{j} and p_{j} carefully | c | use LAPACK routine SLASCL | c %-----------------------------------------% c call dlascl ('General', i, i, rnorm, one, n, 1, & v(1,j), n, infol) call dlascl ('General', i, i, rnorm, one, n, 1, & workd(ipj), n, infol) end if c c %------------------------------------------------------% c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} | c | Note that this is not quite yet r_{j}. See STEP 4 | c %------------------------------------------------------% c step3 = .true. nopx = nopx + 1 call second (t2) call dcopy (n, v(1,j), 1, workd(ivj), 1) ipntr(1) = ivj ipntr(2) = irj ipntr(3) = ipj ido = 1 c c %-----------------------------------% c | Exit in order to compute OP*v_{j} | c %-----------------------------------% c go to 9000 50 continue c c %-----------------------------------% c | Back from reverse communication; | c | WORKD(IRJ:IRJ+N-1) := OP*v_{j}. | c %-----------------------------------% c call second (t3) tmvopx = tmvopx + (t3 - t2) c step3 = .false. c c %------------------------------------------% c | Put another copy of OP*v_{j} into RESID. | c %------------------------------------------% c call dcopy (n, workd(irj), 1, resid, 1) c c %-------------------------------------------% c | STEP 4: Finish extending the symmetric | c | Arnoldi to length j. If MODE = 2 | c | then B*OP = B*inv(B)*A = A and | c | we don't need to compute B*OP. | c | NOTE: If MODE = 2 WORKD(IVJ:IVJ+N-1) is | c | assumed to have A*v_{j}. | c %-------------------------------------------% c if (mode .eq. 2) go to 65 call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 step4 = .true. ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %-------------------------------------% c | Exit in order to compute B*OP*v_{j} | c %-------------------------------------% c go to 9000 else if (bmat .eq. 'I') then call dcopy(n, resid, 1 , workd(ipj), 1) end if 60 continue c c %-----------------------------------% c | Back from reverse communication; | c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j}. | c %-----------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c step4 = .false. c c %-------------------------------------% c | The following is needed for STEP 5. | c | Compute the B-norm of OP*v_{j}. | c %-------------------------------------% c 65 continue if (mode .eq. 2) then c c %----------------------------------% c | Note that the B-norm of OP*v_{j} | c | is the inv(B)-norm of A*v_{j}. | c %----------------------------------% c wnorm = ddot (n, resid, 1, workd(ivj), 1) wnorm = sqrt(abs(wnorm)) else if (bmat .eq. 'G') then wnorm = ddot (n, resid, 1, workd(ipj), 1) wnorm = sqrt(abs(wnorm)) else if (bmat .eq. 'I') then wnorm = dnrm2(n, resid, 1) end if c c %-----------------------------------------% c | Compute the j-th residual corresponding | c | to the j step factorization. | c | Use Classical Gram Schmidt and compute: | c | w_{j} <- V_{j}^T * B * OP * v_{j} | c | r_{j} <- OP*v_{j} - V_{j} * w_{j} | c %-----------------------------------------% c c c %------------------------------------------% c | Compute the j Fourier coefficients w_{j} | c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. | c %------------------------------------------% c if (mode .ne. 2 ) then call dgemv('T', n, j, one, v, ldv, workd(ipj), 1, zero, & workd(irj), 1) else if (mode .eq. 2) then call dgemv('T', n, j, one, v, ldv, workd(ivj), 1, zero, & workd(irj), 1) end if c c %--------------------------------------% c | Orthgonalize r_{j} against V_{j}. | c | RESID contains OP*v_{j}. See STEP 3. | c %--------------------------------------% c call dgemv('N', n, j, -one, v, ldv, workd(irj), 1, one, & resid, 1) c c %--------------------------------------% c | Extend H to have j rows and columns. | c %--------------------------------------% c h(j,2) = workd(irj + j - 1) if (j .eq. 1 .or. rstart) then h(j,1) = zero else h(j,1) = rnorm end if call second (t4) c orth1 = .true. iter = 0 c call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %----------------------------------% c | Exit in order to compute B*r_{j} | c %----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd(ipj), 1) end if 70 continue c c %---------------------------------------------------% c | Back from reverse communication if ORTH1 = .true. | c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. | c %---------------------------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c orth1 = .false. c c %------------------------------% c | Compute the B-norm of r_{j}. | c %------------------------------% c if (bmat .eq. 'G') then rnorm = ddot (n, resid, 1, workd(ipj), 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then rnorm = dnrm2(n, resid, 1) end if c c %-----------------------------------------------------------% c | STEP 5: Re-orthogonalization / Iterative refinement phase | c | Maximum NITER_ITREF tries. | c | | c | s = V_{j}^T * B * r_{j} | c | r_{j} = r_{j} - V_{j}*s | c | alphaj = alphaj + s_{j} | c | | c | The stopping criteria used for iterative refinement is | c | discussed in Parlett's book SEP, page 107 and in Gragg & | c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. | c | Determine if we need to correct the residual. The goal is | c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || | c %-----------------------------------------------------------% c if (rnorm .gt. 0.717*wnorm) go to 100 nrorth = nrorth + 1 c c %---------------------------------------------------% c | Enter the Iterative refinement phase. If further | c | refinement is necessary, loop back here. The loop | c | variable is ITER. Perform a step of Classical | c | Gram-Schmidt using all the Arnoldi vectors V_{j} | c %---------------------------------------------------% c 80 continue c if (msglvl .gt. 2) then xtemp(1) = wnorm xtemp(2) = rnorm call dvout (logfil, 2, xtemp, ndigit, & '_saitr: re-orthonalization ; wnorm and rnorm are') end if c c %----------------------------------------------------% c | Compute V_{j}^T * B * r_{j}. | c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). | c %----------------------------------------------------% c call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1, & zero, workd(irj), 1) c c %----------------------------------------------% c | Compute the correction to the residual: | c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). | c | The correction to H is v(:,1:J)*H(1:J,1:J) + | c | v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j, but only | c | H(j,j) is updated. | c %----------------------------------------------% c call dgemv ('N', n, j, -one, v, ldv, workd(irj), 1, & one, resid, 1) c if (j .eq. 1 .or. rstart) h(j,1) = zero h(j,2) = h(j,2) + workd(irj + j - 1) c orth2 = .true. call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %-----------------------------------% c | Exit in order to compute B*r_{j}. | c | r_{j} is the corrected residual. | c %-----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd(ipj), 1) end if 90 continue c c %---------------------------------------------------% c | Back from reverse communication if ORTH2 = .true. | c %---------------------------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c c %-----------------------------------------------------% c | Compute the B-norm of the corrected residual r_{j}. | c %-----------------------------------------------------% c if (bmat .eq. 'G') then rnorm1 = ddot (n, resid, 1, workd(ipj), 1) rnorm1 = sqrt(abs(rnorm1)) else if (bmat .eq. 'I') then rnorm1 = dnrm2(n, resid, 1) end if c if (msglvl .gt. 0 .and. iter .gt. 0) then call ivout (logfil, 1, j, ndigit, & '_saitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then xtemp(1) = rnorm xtemp(2) = rnorm1 call dvout (logfil, 2, xtemp, ndigit, & '_saitr: iterative refinement ; rnorm and rnorm1 are') end if end if c c %-----------------------------------------% c | Determine if we need to perform another | c | step of re-orthogonalization. | c %-----------------------------------------% c if (rnorm1 .gt. 0.717*rnorm) then c c %--------------------------------% c | No need for further refinement | c %--------------------------------% c rnorm = rnorm1 c else c c %-------------------------------------------% c | Another step of iterative refinement step | c | is required. NITREF is used by stat.h | c %-------------------------------------------% c nitref = nitref + 1 rnorm = rnorm1 iter = iter + 1 if (iter .le. 1) go to 80 c c %-------------------------------------------------% c | Otherwise RESID is numerically in the span of V | c %-------------------------------------------------% c do 95 jj = 1, n resid(jj) = zero 95 continue rnorm = zero end if c c %----------------------------------------------% c | Branch here directly if iterative refinement | c | wasn't necessary or after at most NITER_REF | c | steps of iterative refinement. | c %----------------------------------------------% c 100 continue c rstart = .false. orth2 = .false. c call second (t5) titref = titref + (t5 - t4) c c %----------------------------------------------------------% c | Make sure the last off-diagonal element is non negative | c | If not perform a similarity transformation on H(1:j,1:j) | c | and scale v(:,j) by -1. | c %----------------------------------------------------------% c if (h(j,1) .lt. zero) then h(j,1) = -h(j,1) if ( j .lt. k+np) then call dscal(n, -one, v(1,j+1), 1) else call dscal(n, -one, resid, 1) end if end if c c %------------------------------------% c | STEP 6: Update j = j+1; Continue | c %------------------------------------% c j = j + 1 if (j .gt. k+np) then call second (t1) tsaitr = tsaitr + (t1 - t0) ido = 99 c if (msglvl .gt. 1) then call dvout (logfil, k+np, h(1,2), ndigit, & '_saitr: main diagonal of matrix H of step K+NP.') if (k+np .gt. 1) then call dvout (logfil, k+np-1, h(2,1), ndigit, & '_saitr: sub diagonal of matrix H of step K+NP.') end if end if c go to 9000 end if c c %--------------------------------------------------------% c | Loop back to extend the factorization by another step. | c %--------------------------------------------------------% c go to 1000 c c %---------------------------------------------------------------% c | | c | E N D O F M A I N I T E R A T I O N L O O P | c | | c %---------------------------------------------------------------% c 9000 continue return c c %---------------% c | End of dsaitr | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/znaitr.f000644 001750 001750 00000074633 11266605602 022141 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: znaitr c c\Description: c Reverse communication interface for applying NP additional steps to c a K step nonsymmetric Arnoldi factorization. c c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T c c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0. c c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T c c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0. c c where OP and B are as in znaupd. The B-norm of r_{k+p} is also c computed and returned. c c\Usage: c call znaitr c ( IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH, c IPNTR, WORKD, INFO ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y. c This is for the restart phase to force the new c starting vector into the range of OP. c IDO = 1: compute Y = OP * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y, c IPNTR(3) is the pointer into WORK for B * X. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y. c IDO = 99: done c ------------------------------------------------------------- c When the routine is used in the "shift-and-invert" mode, the c vector B * Q is already available and do not need to be c recomputed in forming OP * Q. c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B that defines the c semi-inner product for the operator OP. See znaupd. c B = 'I' -> standard eigenvalue problem A*x = lambda*x c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x c c N Integer. (INPUT) c Dimension of the eigenproblem. c c K Integer. (INPUT) c Current size of V and H. c c NP Integer. (INPUT) c Number of additional Arnoldi steps to take. c c NB Integer. (INPUT) c Blocksize to be used in the recurrence. c Only work for NB = 1 right now. The goal is to have a c program that implement both the block and non-block method. c c RESID Complex*16 array of length N. (INPUT/OUTPUT) c On INPUT: RESID contains the residual vector r_{k}. c On OUTPUT: RESID contains the residual vector r_{k+p}. c c RNORM Double precision scalar. (INPUT/OUTPUT) c B-norm of the starting residual on input. c B-norm of the updated residual r_{k+p} on output. c c V Complex*16 N by K+NP array. (INPUT/OUTPUT) c On INPUT: V contains the Arnoldi vectors in the first K c columns. c On OUTPUT: V contains the new NP Arnoldi vectors in the next c NP columns. The first K columns are unchanged. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Complex*16 (K+NP) by (K+NP) array. (INPUT/OUTPUT) c H is used to store the generated upper Hessenberg matrix. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c IPNTR Integer array of length 3. (OUTPUT) c Pointer to mark the starting locations in the WORK for c vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. c IPNTR(3): pointer to the vector B * X when used in the c shift-and-invert mode. X is the current operand. c ------------------------------------------------------------- c c WORKD Complex*16 work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The calling program should not c use WORKD as temporary workspace during the iteration !!!!!! c On input, WORKD(1:N) = B*RESID and is used to save some c computation at the first step. c c INFO Integer. (OUTPUT) c = 0: Normal exit. c > 0: Size of the spanning invariant subspace of OP found. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx Complex*16 c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: c zgetv0 ARPACK routine to generate the initial vector. c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c zmout ARPACK utility routine that prints matrices c zvout ARPACK utility routine that prints vectors. c zlanhs LAPACK routine that computes various norms of a matrix. c zlascl LAPACK routine for careful scaling of a matrix. c dlabad LAPACK routine for defining the underflow and overflow c limits. c dlamch LAPACK routine that determines machine constants. c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c zgemv Level 2 BLAS routine for matrix vector multiplication. c zaxpy Level 1 BLAS that computes a vector triad. c zcopy Level 1 BLAS that copies one vector to another . c zdotc Level 1 BLAS that computes the scalar product of two vectors. c zscal Level 1 BLAS that scales a vector. c zdscal Level 1 BLAS that scales a complex vector by a real number. c dznrm2 Level 1 BLAS that computes the norm of a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: naitr.F SID: 2.3 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks c The algorithm implemented is: c c restart = .false. c Given V_{k} = [v_{1}, ..., v_{k}], r_{k}; c r_{k} contains the initial residual vector even for k = 0; c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already c computed by the calling program. c c betaj = rnorm ; p_{k+1} = B*r_{k} ; c For j = k+1, ..., k+np Do c 1) if ( betaj < tol ) stop or restart depending on j. c ( At present tol is zero ) c if ( restart ) generate a new starting vector. c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}]; c p_{j} = p_{j}/betaj c 3) r_{j} = OP*v_{j} where OP is defined as in znaupd c For shift-invert mode p_{j} = B*v_{j} is already available. c wnorm = || OP*v_{j} || c 4) Compute the j-th step residual vector. c w_{j} = V_{j}^T * B * OP * v_{j} c r_{j} = OP*v_{j} - V_{j} * w_{j} c H(:,j) = w_{j}; c H(j,j-1) = rnorm c rnorm = || r_(j) || c If (rnorm > 0.717*wnorm) accept step and go back to 1) c 5) Re-orthogonalization step: c s = V_{j}'*B*r_{j} c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} || c alphaj = alphaj + s_{j}; c 6) Iterative refinement step: c If (rnorm1 > 0.717*rnorm) then c rnorm = rnorm1 c accept step and go back to 1) c Else c rnorm = rnorm1 c If this is the first time in step 6), go to 5) c Else r_{j} lies in the span of V_{j} numerically. c Set r_{j} = 0 and rnorm = 0; go to 1) c EndIf c End Do c c\EndLib c c----------------------------------------------------------------------- c subroutine znaitr & (ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh, & ipntr, workd, info) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1 integer ido, info, k, ldh, ldv, n, nb, np Double precision & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(3) Complex*16 & h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n) c c %------------% c | Parameters | c %------------% c Complex*16 & one, zero Double precision & rone, rzero parameter (one = (1.0D+0, 0.0D+0), zero = (0.0D+0, 0.0D+0), & rone = 1.0D+0, rzero = 0.0D+0) c c %--------------% c | Local Arrays | c %--------------% c Double precision & rtemp(2) c c %---------------% c | Local Scalars | c %---------------% c logical first, orth1, orth2, rstart, step3, step4 integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl, & jj Double precision & ovfl, smlnum, tst1, ulp, unfl, betaj, & temp1, rnorm1, wnorm Complex*16 & cnorm c save first, orth1, orth2, rstart, step3, step4, & ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl, & betaj, rnorm1, smlnum, ulp, unfl, wnorm c c %----------------------% c | External Subroutines | c %----------------------% c external zaxpy, zcopy, zscal, zdscal, zgemv, zgetv0, & dlabad, zvout, zmout, ivout, second c c %--------------------% c | External Functions | c %--------------------% c Complex*16 & zdotc Double precision & dlamch, dznrm2, zlanhs, dlapy2 external zdotc, dznrm2, zlanhs, dlamch, dlapy2 c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic dimag, dble, max, sqrt c c %-----------------% c | Data statements | c %-----------------% c data first / .true. / c c %-----------------------% c | Executable Statements | c %-----------------------% c if (first) then c c %-----------------------------------------% c | Set machine-dependent constants for the | c | the splitting and deflation criterion. | c | If norm(H) <= sqrt(OVFL), | c | overflow should not occur. | c | REFERENCE: LAPACK subroutine zlahqr | c %-----------------------------------------% c unfl = dlamch( 'safe minimum' ) ovfl = dble(one / unfl) call dlabad( unfl, ovfl ) ulp = dlamch( 'precision' ) smlnum = unfl*( n / ulp ) first = .false. end if c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mcaitr c c %------------------------------% c | Initial call to this routine | c %------------------------------% c info = 0 step3 = .false. step4 = .false. rstart = .false. orth1 = .false. orth2 = .false. j = k + 1 ipj = 1 irj = ipj + n ivj = irj + n end if c c %-------------------------------------------------% c | When in reverse communication mode one of: | c | STEP3, STEP4, ORTH1, ORTH2, RSTART | c | will be .true. when .... | c | STEP3: return from computing OP*v_{j}. | c | STEP4: return from computing B-norm of OP*v_{j} | c | ORTH1: return from computing B-norm of r_{j+1} | c | ORTH2: return from computing B-norm of | c | correction to the residual vector. | c | RSTART: return from OP computations needed by | c | zgetv0. | c %-------------------------------------------------% c if (step3) go to 50 if (step4) go to 60 if (orth1) go to 70 if (orth2) go to 90 if (rstart) go to 30 c c %-----------------------------% c | Else this is the first step | c %-----------------------------% c c %--------------------------------------------------------------% c | | c | A R N O L D I I T E R A T I O N L O O P | c | | c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) | c %--------------------------------------------------------------% 1000 continue c if (msglvl .gt. 1) then call ivout (logfil, 1, j, ndigit, & '_naitr: generating Arnoldi vector number') call dvout (logfil, 1, rnorm, ndigit, & '_naitr: B-norm of the current residual is') end if c c %---------------------------------------------------% c | STEP 1: Check if the B norm of j-th residual | c | vector is zero. Equivalent to determine whether | c | an exact j-step Arnoldi factorization is present. | c %---------------------------------------------------% c betaj = rnorm if (rnorm .gt. rzero) go to 40 c c %---------------------------------------------------% c | Invariant subspace found, generate a new starting | c | vector which is orthogonal to the current Arnoldi | c | basis and continue the iteration. | c %---------------------------------------------------% c if (msglvl .gt. 0) then call ivout (logfil, 1, j, ndigit, & '_naitr: ****** RESTART AT STEP ******') end if c c %---------------------------------------------% c | ITRY is the loop variable that controls the | c | maximum amount of times that a restart is | c | attempted. NRSTRT is used by stat.h | c %---------------------------------------------% c betaj = rzero nrstrt = nrstrt + 1 itry = 1 20 continue rstart = .true. ido = 0 30 continue c c %--------------------------------------% c | If in reverse communication mode and | c | RSTART = .true. flow returns here. | c %--------------------------------------% c call zgetv0 (ido, bmat, itry, .false., n, j, v, ldv, & resid, rnorm, ipntr, workd, ierr) if (ido .ne. 99) go to 9000 if (ierr .lt. 0) then itry = itry + 1 if (itry .le. 3) go to 20 c c %------------------------------------------------% c | Give up after several restart attempts. | c | Set INFO to the size of the invariant subspace | c | which spans OP and exit. | c %------------------------------------------------% c info = j - 1 call second (t1) tcaitr = tcaitr + (t1 - t0) ido = 99 go to 9000 end if c 40 continue c c %---------------------------------------------------------% c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm | c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow | c | when reciprocating a small RNORM, test against lower | c | machine bound. | c %---------------------------------------------------------% c call zcopy (n, resid, 1, v(1,j), 1) if ( rnorm .ge. unfl) then temp1 = rone / rnorm call zdscal (n, temp1, v(1,j), 1) call zdscal (n, temp1, workd(ipj), 1) else c c %-----------------------------------------% c | To scale both v_{j} and p_{j} carefully | c | use LAPACK routine zlascl | c %-----------------------------------------% c call zlascl ('General', i, i, rnorm, rone, & n, 1, v(1,j), n, infol) call zlascl ('General', i, i, rnorm, rone, & n, 1, workd(ipj), n, infol) end if c c %------------------------------------------------------% c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} | c | Note that this is not quite yet r_{j}. See STEP 4 | c %------------------------------------------------------% c step3 = .true. nopx = nopx + 1 call second (t2) call zcopy (n, v(1,j), 1, workd(ivj), 1) ipntr(1) = ivj ipntr(2) = irj ipntr(3) = ipj ido = 1 c c %-----------------------------------% c | Exit in order to compute OP*v_{j} | c %-----------------------------------% c go to 9000 50 continue c c %----------------------------------% c | Back from reverse communication; | c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} | c | if step3 = .true. | c %----------------------------------% c call second (t3) tmvopx = tmvopx + (t3 - t2) step3 = .false. c c %------------------------------------------% c | Put another copy of OP*v_{j} into RESID. | c %------------------------------------------% c call zcopy (n, workd(irj), 1, resid, 1) c c %---------------------------------------% c | STEP 4: Finish extending the Arnoldi | c | factorization to length j. | c %---------------------------------------% c call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 step4 = .true. ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %-------------------------------------% c | Exit in order to compute B*OP*v_{j} | c %-------------------------------------% c go to 9000 else if (bmat .eq. 'I') then call zcopy (n, resid, 1, workd(ipj), 1) end if 60 continue c c %----------------------------------% c | Back from reverse communication; | c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} | c | if step4 = .true. | c %----------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c step4 = .false. c c %-------------------------------------% c | The following is needed for STEP 5. | c | Compute the B-norm of OP*v_{j}. | c %-------------------------------------% c if (bmat .eq. 'G') then cnorm = zdotc (n, resid, 1, workd(ipj), 1) wnorm = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) ) else if (bmat .eq. 'I') then wnorm = dznrm2(n, resid, 1) end if c c %-----------------------------------------% c | Compute the j-th residual corresponding | c | to the j step factorization. | c | Use Classical Gram Schmidt and compute: | c | w_{j} <- V_{j}^T * B * OP * v_{j} | c | r_{j} <- OP*v_{j} - V_{j} * w_{j} | c %-----------------------------------------% c c c %------------------------------------------% c | Compute the j Fourier coefficients w_{j} | c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. | c %------------------------------------------% c call zgemv ('C', n, j, one, v, ldv, workd(ipj), 1, & zero, h(1,j), 1) c c %--------------------------------------% c | Orthogonalize r_{j} against V_{j}. | c | RESID contains OP*v_{j}. See STEP 3. | c %--------------------------------------% c call zgemv ('N', n, j, -one, v, ldv, h(1,j), 1, & one, resid, 1) c if (j .gt. 1) h(j,j-1) = dcmplx(betaj, rzero) c call second (t4) c orth1 = .true. c call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call zcopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %----------------------------------% c | Exit in order to compute B*r_{j} | c %----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call zcopy (n, resid, 1, workd(ipj), 1) end if 70 continue c c %---------------------------------------------------% c | Back from reverse communication if ORTH1 = .true. | c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. | c %---------------------------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c orth1 = .false. c c %------------------------------% c | Compute the B-norm of r_{j}. | c %------------------------------% c if (bmat .eq. 'G') then cnorm = zdotc (n, resid, 1, workd(ipj), 1) rnorm = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) ) else if (bmat .eq. 'I') then rnorm = dznrm2(n, resid, 1) end if c c %-----------------------------------------------------------% c | STEP 5: Re-orthogonalization / Iterative refinement phase | c | Maximum NITER_ITREF tries. | c | | c | s = V_{j}^T * B * r_{j} | c | r_{j} = r_{j} - V_{j}*s | c | alphaj = alphaj + s_{j} | c | | c | The stopping criteria used for iterative refinement is | c | discussed in Parlett's book SEP, page 107 and in Gragg & | c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. | c | Determine if we need to correct the residual. The goal is | c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || | c | The following test determines whether the sine of the | c | angle between OP*x and the computed residual is less | c | than or equal to 0.717. | c %-----------------------------------------------------------% c if ( rnorm .gt. 0.717*wnorm ) go to 100 c iter = 0 nrorth = nrorth + 1 c c %---------------------------------------------------% c | Enter the Iterative refinement phase. If further | c | refinement is necessary, loop back here. The loop | c | variable is ITER. Perform a step of Classical | c | Gram-Schmidt using all the Arnoldi vectors V_{j} | c %---------------------------------------------------% c 80 continue c if (msglvl .gt. 2) then rtemp(1) = wnorm rtemp(2) = rnorm call dvout (logfil, 2, rtemp, ndigit, & '_naitr: re-orthogonalization; wnorm and rnorm are') call zvout (logfil, j, h(1,j), ndigit, & '_naitr: j-th column of H') end if c c %----------------------------------------------------% c | Compute V_{j}^T * B * r_{j}. | c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). | c %----------------------------------------------------% c call zgemv ('C', n, j, one, v, ldv, workd(ipj), 1, & zero, workd(irj), 1) c c %---------------------------------------------% c | Compute the correction to the residual: | c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). | c | The correction to H is v(:,1:J)*H(1:J,1:J) | c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. | c %---------------------------------------------% c call zgemv ('N', n, j, -one, v, ldv, workd(irj), 1, & one, resid, 1) call zaxpy (j, one, workd(irj), 1, h(1,j), 1) c orth2 = .true. call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call zcopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %-----------------------------------% c | Exit in order to compute B*r_{j}. | c | r_{j} is the corrected residual. | c %-----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call zcopy (n, resid, 1, workd(ipj), 1) end if 90 continue c c %---------------------------------------------------% c | Back from reverse communication if ORTH2 = .true. | c %---------------------------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c c %-----------------------------------------------------% c | Compute the B-norm of the corrected residual r_{j}. | c %-----------------------------------------------------% c if (bmat .eq. 'G') then cnorm = zdotc (n, resid, 1, workd(ipj), 1) rnorm1 = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) ) else if (bmat .eq. 'I') then rnorm1 = dznrm2(n, resid, 1) end if c if (msglvl .gt. 0 .and. iter .gt. 0 ) then call ivout (logfil, 1, j, ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then rtemp(1) = rnorm rtemp(2) = rnorm1 call dvout (logfil, 2, rtemp, ndigit, & '_naitr: iterative refinement ; rnorm and rnorm1 are') end if end if c c %-----------------------------------------% c | Determine if we need to perform another | c | step of re-orthogonalization. | c %-----------------------------------------% c if ( rnorm1 .gt. 0.717*rnorm ) then c c %---------------------------------------% c | No need for further refinement. | c | The cosine of the angle between the | c | corrected residual vector and the old | c | residual vector is greater than 0.717 | c | In other words the corrected residual | c | and the old residual vector share an | c | angle of less than arcCOS(0.717) | c %---------------------------------------% c rnorm = rnorm1 c else c c %-------------------------------------------% c | Another step of iterative refinement step | c | is required. NITREF is used by stat.h | c %-------------------------------------------% c nitref = nitref + 1 rnorm = rnorm1 iter = iter + 1 if (iter .le. 1) go to 80 c c %-------------------------------------------------% c | Otherwise RESID is numerically in the span of V | c %-------------------------------------------------% c do 95 jj = 1, n resid(jj) = zero 95 continue rnorm = rzero end if c c %----------------------------------------------% c | Branch here directly if iterative refinement | c | wasn't necessary or after at most NITER_REF | c | steps of iterative refinement. | c %----------------------------------------------% c 100 continue c rstart = .false. orth2 = .false. c call second (t5) titref = titref + (t5 - t4) c c %------------------------------------% c | STEP 6: Update j = j+1; Continue | c %------------------------------------% c j = j + 1 if (j .gt. k+np) then call second (t1) tcaitr = tcaitr + (t1 - t0) ido = 99 do 110 i = max(1,k), k+np-1 c c %--------------------------------------------% c | Check for splitting and deflation. | c | Use a standard test as in the QR algorithm | c | REFERENCE: LAPACK subroutine zlahqr | c %--------------------------------------------% c tst1 = dlapy2(dble(h(i,i)),dimag(h(i,i))) & + dlapy2(dble(h(i+1,i+1)), dimag(h(i+1,i+1))) if( tst1.eq.dble(zero) ) & tst1 = zlanhs( '1', k+np, h, ldh, workd(n+1) ) if( dlapy2(dble(h(i+1,i)),dimag(h(i+1,i))) .le. & max( ulp*tst1, smlnum ) ) & h(i+1,i) = zero 110 continue c if (msglvl .gt. 2) then call zmout (logfil, k+np, k+np, h, ldh, ndigit, & '_naitr: Final upper Hessenberg matrix H of order K+NP') end if c go to 9000 end if c c %--------------------------------------------------------% c | Loop back to extend the factorization by another step. | c %--------------------------------------------------------% c go to 1000 c c %---------------------------------------------------------------% c | | c | E N D O F M A I N I T E R A T I O N L O O P | c | | c %---------------------------------------------------------------% c 9000 continue return c c %---------------% c | End of znaitr | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dstats.f000644 001750 001750 00000002216 11266605602 022120 0ustar00geuzainegeuzaine000000 000000 c c\SCCS Information: @(#) c FILE: stats.F SID: 2.1 DATE OF SID: 4/19/96 RELEASE: 2 c %---------------------------------------------% c | Initialize statistic and timing information | c | for symmetric Arnoldi code. | c %---------------------------------------------% subroutine dstats c %--------------------------------% c | See stat.doc for documentation | c %--------------------------------% include 'stat.h' c %-----------------------% c | Executable Statements | c %-----------------------% nopx = 0 nbx = 0 nrorth = 0 nitref = 0 nrstrt = 0 tsaupd = 0.0D+0 tsaup2 = 0.0D+0 tsaitr = 0.0D+0 tseigt = 0.0D+0 tsgets = 0.0D+0 tsapps = 0.0D+0 tsconv = 0.0D+0 titref = 0.0D+0 tgetv0 = 0.0D+0 trvec = 0.0D+0 c %----------------------------------------------------% c | User time including reverse communication overhead | c %----------------------------------------------------% tmvopx = 0.0D+0 tmvbx = 0.0D+0 return c c End of dstats c end getdp-2.7.0-source/contrib/Arpack/sstatn.f000644 001750 001750 00000002710 11266605602 022131 0ustar00geuzainegeuzaine000000 000000 c c %---------------------------------------------% c | Initialize statistic and timing information | c | for nonsymmetric Arnoldi code. | c %---------------------------------------------% c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: statn.F SID: 2.4 DATE OF SID: 4/20/96 RELEASE: 2 c subroutine sstatn c c %--------------------------------% c | See stat.doc for documentation | c %--------------------------------% c include 'stat.h' c c %-----------------------% c | Executable Statements | c %-----------------------% c nopx = 0 nbx = 0 nrorth = 0 nitref = 0 nrstrt = 0 c tnaupd = 0.0E+0 tnaup2 = 0.0E+0 tnaitr = 0.0E+0 tneigh = 0.0E+0 tngets = 0.0E+0 tnapps = 0.0E+0 tnconv = 0.0E+0 titref = 0.0E+0 tgetv0 = 0.0E+0 trvec = 0.0E+0 c c %----------------------------------------------------% c | User time including reverse communication overhead | c %----------------------------------------------------% c tmvopx = 0.0E+0 tmvbx = 0.0E+0 c return c c c %---------------% c | End of sstatn | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dseupd.f000644 001750 001750 00000103200 11266605602 022075 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: dseupd c c\Description: c c This subroutine returns the converged approximations to eigenvalues c of A*z = lambda*B*z and (optionally): c c (1) the corresponding approximate eigenvectors, c c (2) an orthonormal (Lanczos) basis for the associated approximate c invariant subspace, c c (3) Both. c c There is negligible additional cost to obtain eigenvectors. An orthonormal c (Lanczos) basis is always computed. There is an additional storage cost c of n*nev if both are requested (in this case a separate array Z must be c supplied). c c These quantities are obtained from the Lanczos factorization computed c by DSAUPD for the linear operator OP prescribed by the MODE selection c (see IPARAM(7) in DSAUPD documentation.) DSAUPD must be called before c this routine is called. These approximate eigenvalues and vectors are c commonly called Ritz values and Ritz vectors respectively. They are c referred to as such in the comments that follow. The computed orthonormal c basis for the invariant subspace corresponding to these Ritz values is c referred to as a Lanczos basis. c c See documentation in the header of the subroutine DSAUPD for a definition c of OP as well as other terms and the relation of computed Ritz values c and vectors of OP with respect to the given problem A*z = lambda*B*z. c c The approximate eigenvalues of the original problem are returned in c ascending algebraic order. The user may elect to call this routine c once for each desired Ritz vector and store it peripherally if desired. c There is also the option of computing a selected set of these vectors c with a single call. c c\Usage: c call dseupd c ( RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, BMAT, N, WHICH, NEV, TOL, c RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, LWORKL, INFO ) c c RVEC LOGICAL (INPUT) c Specifies whether Ritz vectors corresponding to the Ritz value c approximations to the eigenproblem A*z = lambda*B*z are computed. c c RVEC = .FALSE. Compute Ritz values only. c c RVEC = .TRUE. Compute Ritz vectors. c c HOWMNY Character*1 (INPUT) c Specifies how many Ritz vectors are wanted and the form of Z c the matrix of Ritz vectors. See remark 1 below. c = 'A': compute NEV Ritz vectors; c = 'S': compute some of the Ritz vectors, specified c by the logical array SELECT. c c SELECT Logical array of dimension NCV. (INPUT/WORKSPACE) c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be c computed. To select the Ritz vector corresponding to a c Ritz value D(j), SELECT(j) must be set to .TRUE.. c If HOWMNY = 'A' , SELECT is used as a workspace for c reordering the Ritz values. c c D Double precision array of dimension NEV. (OUTPUT) c On exit, D contains the Ritz value approximations to the c eigenvalues of A*z = lambda*B*z. The values are returned c in ascending order. If IPARAM(7) = 3,4,5 then D represents c the Ritz values of OP computed by dsaupd transformed to c those of the original eigensystem A*z = lambda*B*z. If c IPARAM(7) = 1,2 then the Ritz values of OP are the same c as the those of A*z = lambda*B*z. c c Z Double precision N by NEV array if HOWMNY = 'A'. (OUTPUT) c On exit, Z contains the B-orthonormal Ritz vectors of the c eigensystem A*z = lambda*B*z corresponding to the Ritz c value approximations. c If RVEC = .FALSE. then Z is not referenced. c NOTE: The array Z may be set equal to first NEV columns of the c Arnoldi/Lanczos basis array V computed by DSAUPD . c c LDZ Integer. (INPUT) c The leading dimension of the array Z. If Ritz vectors are c desired, then LDZ .ge. max( 1, N ). In any case, LDZ .ge. 1. c c SIGMA Double precision (INPUT) c If IPARAM(7) = 3,4,5 represents the shift. Not referenced if c IPARAM(7) = 1 or 2. c c c **** The remaining arguments MUST be the same as for the **** c **** call to DSAUPD that was just completed. **** c c NOTE: The remaining arguments c c BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, c WORKD, WORKL, LWORKL, INFO c c must be passed directly to DSEUPD following the last call c to DSAUPD . These arguments MUST NOT BE MODIFIED between c the the last call to DSAUPD and the call to DSEUPD . c c Two of these parameters (WORKL, INFO) are also output parameters: c c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) c WORKL(1:4*ncv) contains information obtained in c dsaupd . They are not changed by dseupd . c WORKL(4*ncv+1:ncv*ncv+8*ncv) holds the c untransformed Ritz values, the computed error estimates, c and the associated eigenvector matrix of H. c c Note: IPNTR(8:10) contains the pointer into WORKL for addresses c of the above information computed by dseupd . c ------------------------------------------------------------- c IPNTR(8): pointer to the NCV RITZ values of the original system. c IPNTR(9): pointer to the NCV corresponding error bounds. c IPNTR(10): pointer to the NCV by NCV matrix of eigenvectors c of the tridiagonal matrix T. Only referenced by c dseupd if RVEC = .TRUE. See Remarks. c ------------------------------------------------------------- c c INFO Integer. (OUTPUT) c Error flag on output. c = 0: Normal exit. c = -1: N must be positive. c = -2: NEV must be positive. c = -3: NCV must be greater than NEV and less than or equal to N. c = -5: WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'. c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work WORKL array is not sufficient. c = -8: Error return from trid. eigenvalue calculation; c Information error from LAPACK routine dsteqr . c = -9: Starting vector is zero. c = -10: IPARAM(7) must be 1,2,3,4,5. c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible. c = -12: NEV and WHICH = 'BE' are incompatible. c = -14: DSAUPD did not find any eigenvalues to sufficient c accuracy. c = -15: HOWMNY must be one of 'A' or 'S' if RVEC = .true. c = -16: HOWMNY = 'S' not yet implemented c = -17: DSEUPD got a different count of the number of converged c Ritz values than DSAUPD got. This indicates the user c probably made an error in passing data from DSAUPD to c DSEUPD or that the data was modified before entering c DSEUPD . c c\BeginLib c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall, c 1980. c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program", c Computer Physics Communications, 53 (1989), pp 169-179. c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to c Implement the Spectral Transformation", Math. Comp., 48 (1987), c pp 663-673. c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems", c SIAM J. Matr. Anal. Apps., January (1993). c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines c for Updating the QR decomposition", ACM TOMS, December 1990, c Volume 16 Number 4, pp 369-377. c c\Remarks c 1. The converged Ritz values are always returned in increasing c (algebraic) order. c c 2. Currently only HOWMNY = 'A' is implemented. It is included at this c stage for the user who wants to incorporate it. c c\Routines called: c dsesrt ARPACK routine that sorts an array X, and applies the c corresponding permutation to a matrix A. c dsortr dsortr ARPACK sorting routine. c ivout ARPACK utility routine that prints integers. c dvout ARPACK utility routine that prints vectors. c dgeqr2 LAPACK routine that computes the QR factorization of c a matrix. c dlacpy LAPACK matrix copy routine. c dlamch LAPACK routine that determines machine constants. c dorm2r LAPACK routine that applies an orthogonal matrix in c factored form. c dsteqr LAPACK routine that computes eigenvalues and eigenvectors c of a tridiagonal matrix. c dger Level 2 BLAS rank one update to a matrix. c dcopy Level 1 BLAS that copies one vector to another . c dnrm2 Level 1 BLAS that computes the norm of a vector. c dscal Level 1 BLAS that scales a vector. c dswap Level 1 BLAS that swaps the contents of two vectors. c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Chao Yang Houston, Texas c Dept. of Computational & c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/15/93: Version ' 2.1' c c\SCCS Information: @(#) c FILE: seupd.F SID: 2.11 DATE OF SID: 04/10/01 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- subroutine dseupd (rvec , howmny, select, d , & z , ldz , sigma , bmat , & n , which , nev , tol , & resid , ncv , v , ldv , & iparam, ipntr , workd , workl, & lworkl, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat, howmny, which*2 logical rvec integer info, ldz, ldv, lworkl, n, ncv, nev Double precision & sigma, tol c c %-----------------% c | Array Arguments | c %-----------------% c integer iparam(7), ipntr(11) logical select(ncv) Double precision & d(nev) , resid(n) , v(ldv,ncv), & z(ldz, nev), workd(2*n), workl(lworkl) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0 , zero = 0.0D+0 ) c c %---------------% c | Local Scalars | c %---------------% c character type*6 integer bounds , ierr , ih , ihb , ihd , & iq , iw , j , k , ldh , & ldq , mode , msglvl, nconv , next , & ritz , irz , ibd , np , ishift, & leftptr, rghtptr, numcnv, jj Double precision & bnorm2 , rnorm, temp, temp1, eps23 logical reord c c %----------------------% c | External Subroutines | c %----------------------% c external dcopy , dger , dgeqr2 , dlacpy , dorm2r , dscal , & dsesrt , dsteqr , dswap , dvout , ivout , dsortr c c %--------------------% c | External Functions | c %--------------------% c Double precision & dnrm2 , dlamch external dnrm2 , dlamch c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic min c c %-----------------------% c | Executable Statements | c %-----------------------% c c %------------------------% c | Set default parameters | c %------------------------% c msglvl = mseupd mode = iparam(7) nconv = iparam(5) info = 0 c c %--------------% c | Quick return | c %--------------% c if (nconv .eq. 0) go to 9000 ierr = 0 c if (nconv .le. 0) ierr = -14 if (n .le. 0) ierr = -1 if (nev .le. 0) ierr = -2 if (ncv .le. nev .or. ncv .gt. n) ierr = -3 if (which .ne. 'LM' .and. & which .ne. 'SM' .and. & which .ne. 'LA' .and. & which .ne. 'SA' .and. & which .ne. 'BE') ierr = -5 if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6 if ( (howmny .ne. 'A' .and. & howmny .ne. 'P' .and. & howmny .ne. 'S') .and. rvec ) & ierr = -15 if (rvec .and. howmny .eq. 'S') ierr = -16 c if (rvec .and. lworkl .lt. ncv**2+8*ncv) ierr = -7 c if (mode .eq. 1 .or. mode .eq. 2) then type = 'REGULR' else if (mode .eq. 3 ) then type = 'SHIFTI' else if (mode .eq. 4 ) then type = 'BUCKLE' else if (mode .eq. 5 ) then type = 'CAYLEY' else ierr = -10 end if if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11 if (nev .eq. 1 .and. which .eq. 'BE') ierr = -12 c c %------------% c | Error Exit | c %------------% c if (ierr .ne. 0) then info = ierr go to 9000 end if c c %-------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | c | etc... and the remaining workspace. | c | Also update pointer to be used on output. | c | Memory is laid out as follows: | c | workl(1:2*ncv) := generated tridiagonal matrix H | c | The subdiagonal is stored in workl(2:ncv). | c | The dead spot is workl(1) but upon exiting | c | dsaupd stores the B-norm of the last residual | c | vector in workl(1). We use this !!! | c | workl(2*ncv+1:2*ncv+ncv) := ritz values | c | The wanted values are in the first NCONV spots. | c | workl(3*ncv+1:3*ncv+ncv) := computed Ritz estimates | c | The wanted values are in the first NCONV spots. | c | NOTE: workl(1:4*ncv) is set by dsaupd and is not | c | modified by dseupd . | c %-------------------------------------------------------% c c %-------------------------------------------------------% c | The following is used and set by dseupd . | c | workl(4*ncv+1:4*ncv+ncv) := used as workspace during | c | computation of the eigenvectors of H. Stores | c | the diagonal of H. Upon EXIT contains the NCV | c | Ritz values of the original system. The first | c | NCONV spots have the wanted values. If MODE = | c | 1 or 2 then will equal workl(2*ncv+1:3*ncv). | c | workl(5*ncv+1:5*ncv+ncv) := used as workspace during | c | computation of the eigenvectors of H. Stores | c | the subdiagonal of H. Upon EXIT contains the | c | NCV corresponding Ritz estimates of the | c | original system. The first NCONV spots have the | c | wanted values. If MODE = 1,2 then will equal | c | workl(3*ncv+1:4*ncv). | c | workl(6*ncv+1:6*ncv+ncv*ncv) := orthogonal Q that is | c | the eigenvector matrix for H as returned by | c | dsteqr . Not referenced if RVEC = .False. | c | Ordering follows that of workl(4*ncv+1:5*ncv) | c | workl(6*ncv+ncv*ncv+1:6*ncv+ncv*ncv+2*ncv) := | c | Workspace. Needed by dsteqr and by dseupd . | c | GRAND total of NCV*(NCV+8) locations. | c %-------------------------------------------------------% c c ih = ipntr(5) ritz = ipntr(6) bounds = ipntr(7) ldh = ncv ldq = ncv ihd = bounds + ldh ihb = ihd + ldh iq = ihb + ldh iw = iq + ldh*ncv next = iw + 2*ncv ipntr(4) = next ipntr(8) = ihd ipntr(9) = ihb ipntr(10) = iq c c %----------------------------------------% c | irz points to the Ritz values computed | c | by _seigt before exiting _saup2. | c | ibd points to the Ritz estimates | c | computed by _seigt before exiting | c | _saup2. | c %----------------------------------------% c irz = ipntr(11)+ncv ibd = irz+ncv c c c %---------------------------------% c | Set machine dependent constant. | c %---------------------------------% c eps23 = dlamch ('Epsilon-Machine') eps23 = eps23**(2.0D+0 / 3.0D+0 ) c c %---------------------------------------% c | RNORM is B-norm of the RESID(1:N). | c | BNORM2 is the 2 norm of B*RESID(1:N). | c | Upon exit of dsaupd WORKD(1:N) has | c | B*RESID(1:N). | c %---------------------------------------% c rnorm = workl(ih) if (bmat .eq. 'I') then bnorm2 = rnorm else if (bmat .eq. 'G') then bnorm2 = dnrm2 (n, workd, 1) end if c if (msglvl .gt. 2) then call dvout (logfil, ncv, workl(irz), ndigit, & '_seupd: Ritz values passed in from _SAUPD.') call dvout (logfil, ncv, workl(ibd), ndigit, & '_seupd: Ritz estimates passed in from _SAUPD.') end if c if (rvec) then c reord = .false. c c %---------------------------------------------------% c | Use the temporary bounds array to store indices | c | These will be used to mark the select array later | c %---------------------------------------------------% c do 10 j = 1,ncv workl(bounds+j-1) = j select(j) = .false. 10 continue c c %-------------------------------------% c | Select the wanted Ritz values. | c | Sort the Ritz values so that the | c | wanted ones appear at the tailing | c | NEV positions of workl(irr) and | c | workl(iri). Move the corresponding | c | error estimates in workl(bound) | c | accordingly. | c %-------------------------------------% c np = ncv - nev ishift = 0 call dsgets (ishift, which , nev , & np , workl(irz) , workl(bounds), & workl) c if (msglvl .gt. 2) then call dvout (logfil, ncv, workl(irz), ndigit, & '_seupd: Ritz values after calling _SGETS.') call dvout (logfil, ncv, workl(bounds), ndigit, & '_seupd: Ritz value indices after calling _SGETS.') end if c c %-----------------------------------------------------% c | Record indices of the converged wanted Ritz values | c | Mark the select array for possible reordering | c %-----------------------------------------------------% c numcnv = 0 do 11 j = 1,ncv temp1 = max(eps23, abs(workl(irz+ncv-j)) ) jj = workl(bounds + ncv - j) if (numcnv .lt. nconv .and. & workl(ibd+jj-1) .le. tol*temp1) then select(jj) = .true. numcnv = numcnv + 1 if (jj .gt. nev) reord = .true. endif 11 continue c c %-----------------------------------------------------------% c | Check the count (numcnv) of converged Ritz values with | c | the number (nconv) reported by _saupd. If these two | c | are different then there has probably been an error | c | caused by incorrect passing of the _saupd data. | c %-----------------------------------------------------------% c if (msglvl .gt. 2) then call ivout(logfil, 1, numcnv, ndigit, & '_seupd: Number of specified eigenvalues') call ivout(logfil, 1, nconv, ndigit, & '_seupd: Number of "converged" eigenvalues') end if c if (numcnv .ne. nconv) then info = -17 go to 9000 end if c c %-----------------------------------------------------------% c | Call LAPACK routine _steqr to compute the eigenvalues and | c | eigenvectors of the final symmetric tridiagonal matrix H. | c | Initialize the eigenvector matrix Q to the identity. | c %-----------------------------------------------------------% c call dcopy (ncv-1, workl(ih+1), 1, workl(ihb), 1) call dcopy (ncv, workl(ih+ldh), 1, workl(ihd), 1) c call dsteqr ('Identity', ncv, workl(ihd), workl(ihb), & workl(iq) , ldq, workl(iw), ierr) c if (ierr .ne. 0) then info = -8 go to 9000 end if c if (msglvl .gt. 1) then call dcopy (ncv, workl(iq+ncv-1), ldq, workl(iw), 1) call dvout (logfil, ncv, workl(ihd), ndigit, & '_seupd: NCV Ritz values of the final H matrix') call dvout (logfil, ncv, workl(iw), ndigit, & '_seupd: last row of the eigenvector matrix for H') end if c if (reord) then c c %---------------------------------------------% c | Reordered the eigenvalues and eigenvectors | c | computed by _steqr so that the "converged" | c | eigenvalues appear in the first NCONV | c | positions of workl(ihd), and the associated | c | eigenvectors appear in the first NCONV | c | columns. | c %---------------------------------------------% c leftptr = 1 rghtptr = ncv c if (ncv .eq. 1) go to 30 c 20 if (select(leftptr)) then c c %-------------------------------------------% c | Search, from the left, for the first Ritz | c | value that has not converged. | c %-------------------------------------------% c leftptr = leftptr + 1 c else if ( .not. select(rghtptr)) then c c %----------------------------------------------% c | Search, from the right, the first Ritz value | c | that has converged. | c %----------------------------------------------% c rghtptr = rghtptr - 1 c else c c %----------------------------------------------% c | Swap the Ritz value on the left that has not | c | converged with the Ritz value on the right | c | that has converged. Swap the associated | c | eigenvector of the tridiagonal matrix H as | c | well. | c %----------------------------------------------% c temp = workl(ihd+leftptr-1) workl(ihd+leftptr-1) = workl(ihd+rghtptr-1) workl(ihd+rghtptr-1) = temp call dcopy (ncv, workl(iq+ncv*(leftptr-1)), 1, & workl(iw), 1) call dcopy (ncv, workl(iq+ncv*(rghtptr-1)), 1, & workl(iq+ncv*(leftptr-1)), 1) call dcopy (ncv, workl(iw), 1, & workl(iq+ncv*(rghtptr-1)), 1) leftptr = leftptr + 1 rghtptr = rghtptr - 1 c end if c if (leftptr .lt. rghtptr) go to 20 c 30 end if c if (msglvl .gt. 2) then call dvout (logfil, ncv, workl(ihd), ndigit, & '_seupd: The eigenvalues of H--reordered') end if c c %----------------------------------------% c | Load the converged Ritz values into D. | c %----------------------------------------% c call dcopy (nconv, workl(ihd), 1, d, 1) c else c c %-----------------------------------------------------% c | Ritz vectors not required. Load Ritz values into D. | c %-----------------------------------------------------% c call dcopy (nconv, workl(ritz), 1, d, 1) call dcopy (ncv, workl(ritz), 1, workl(ihd), 1) c end if c c %------------------------------------------------------------------% c | Transform the Ritz values and possibly vectors and corresponding | c | Ritz estimates of OP to those of A*x=lambda*B*x. The Ritz values | c | (and corresponding data) are returned in ascending order. | c %------------------------------------------------------------------% c if (type .eq. 'REGULR') then c c %---------------------------------------------------------% c | Ascending sort of wanted Ritz values, vectors and error | c | bounds. Not necessary if only Ritz values are desired. | c %---------------------------------------------------------% c if (rvec) then call dsesrt ('LA', rvec , nconv, d, ncv, workl(iq), ldq) else call dcopy (ncv, workl(bounds), 1, workl(ihb), 1) end if c else c c %-------------------------------------------------------------% c | * Make a copy of all the Ritz values. | c | * Transform the Ritz values back to the original system. | c | For TYPE = 'SHIFTI' the transformation is | c | lambda = 1/theta + sigma | c | For TYPE = 'BUCKLE' the transformation is | c | lambda = sigma * theta / ( theta - 1 ) | c | For TYPE = 'CAYLEY' the transformation is | c | lambda = sigma * (theta + 1) / (theta - 1 ) | c | where the theta are the Ritz values returned by dsaupd . | c | NOTES: | c | *The Ritz vectors are not affected by the transformation. | c | They are only reordered. | c %-------------------------------------------------------------% c call dcopy (ncv, workl(ihd), 1, workl(iw), 1) if (type .eq. 'SHIFTI') then do 40 k=1, ncv workl(ihd+k-1) = one / workl(ihd+k-1) + sigma 40 continue else if (type .eq. 'BUCKLE') then do 50 k=1, ncv workl(ihd+k-1) = sigma * workl(ihd+k-1) / & (workl(ihd+k-1) - one) 50 continue else if (type .eq. 'CAYLEY') then do 60 k=1, ncv workl(ihd+k-1) = sigma * (workl(ihd+k-1) + one) / & (workl(ihd+k-1) - one) 60 continue end if c c %-------------------------------------------------------------% c | * Store the wanted NCONV lambda values into D. | c | * Sort the NCONV wanted lambda in WORKL(IHD:IHD+NCONV-1) | c | into ascending order and apply sort to the NCONV theta | c | values in the transformed system. We will need this to | c | compute Ritz estimates in the original system. | c | * Finally sort the lambda`s into ascending order and apply | c | to Ritz vectors if wanted. Else just sort lambda`s into | c | ascending order. | c | NOTES: | c | *workl(iw:iw+ncv-1) contain the theta ordered so that they | c | match the ordering of the lambda. We`ll use them again for | c | Ritz vector purification. | c %-------------------------------------------------------------% c call dcopy (nconv, workl(ihd), 1, d, 1) call dsortr ('LA', .true., nconv, workl(ihd), workl(iw)) if (rvec) then call dsesrt ('LA', rvec , nconv, d, ncv, workl(iq), ldq) else call dcopy (ncv, workl(bounds), 1, workl(ihb), 1) call dscal (ncv, bnorm2/rnorm, workl(ihb), 1) call dsortr ('LA', .true., nconv, d, workl(ihb)) end if c end if c c %------------------------------------------------% c | Compute the Ritz vectors. Transform the wanted | c | eigenvectors of the symmetric tridiagonal H by | c | the Lanczos basis matrix V. | c %------------------------------------------------% c if (rvec .and. howmny .eq. 'A') then c c %----------------------------------------------------------% c | Compute the QR factorization of the matrix representing | c | the wanted invariant subspace located in the first NCONV | c | columns of workl(iq,ldq). | c %----------------------------------------------------------% c call dgeqr2 (ncv, nconv , workl(iq) , & ldq, workl(iw+ncv), workl(ihb), & ierr) c c %--------------------------------------------------------% c | * Postmultiply V by Q. | c | * Copy the first NCONV columns of VQ into Z. | c | The N by NCONV matrix Z is now a matrix representation | c | of the approximate invariant subspace associated with | c | the Ritz values in workl(ihd). | c %--------------------------------------------------------% c call dorm2r ('Right', 'Notranspose', n , & ncv , nconv , workl(iq), & ldq , workl(iw+ncv), v , & ldv , workd(n+1) , ierr) call dlacpy ('All', n, nconv, v, ldv, z, ldz) c c %-----------------------------------------------------% c | In order to compute the Ritz estimates for the Ritz | c | values in both systems, need the last row of the | c | eigenvector matrix. Remember, it`s in factored form | c %-----------------------------------------------------% c do 65 j = 1, ncv-1 workl(ihb+j-1) = zero 65 continue workl(ihb+ncv-1) = one call dorm2r ('Left', 'Transpose' , ncv , & 1 , nconv , workl(iq) , & ldq , workl(iw+ncv), workl(ihb), & ncv , temp , ierr) c else if (rvec .and. howmny .eq. 'S') then c c Not yet implemented. See remark 2 above. c end if c if (type .eq. 'REGULR' .and. rvec) then c do 70 j=1, ncv workl(ihb+j-1) = rnorm * abs( workl(ihb+j-1) ) 70 continue c else if (type .ne. 'REGULR' .and. rvec) then c c %-------------------------------------------------% c | * Determine Ritz estimates of the theta. | c | If RVEC = .true. then compute Ritz estimates | c | of the theta. | c | If RVEC = .false. then copy Ritz estimates | c | as computed by dsaupd . | c | * Determine Ritz estimates of the lambda. | c %-------------------------------------------------% c call dscal (ncv, bnorm2, workl(ihb), 1) if (type .eq. 'SHIFTI') then c do 80 k=1, ncv workl(ihb+k-1) = abs( workl(ihb+k-1) ) & / workl(iw+k-1)**2 80 continue c else if (type .eq. 'BUCKLE') then c do 90 k=1, ncv workl(ihb+k-1) = sigma * abs( workl(ihb+k-1) ) & / (workl(iw+k-1)-one )**2 90 continue c else if (type .eq. 'CAYLEY') then c do 100 k=1, ncv workl(ihb+k-1) = abs( workl(ihb+k-1) & / workl(iw+k-1)*(workl(iw+k-1)-one) ) 100 continue c end if c end if c if (type .ne. 'REGULR' .and. msglvl .gt. 1) then call dvout (logfil, nconv, d, ndigit, & '_seupd: Untransformed converged Ritz values') call dvout (logfil, nconv, workl(ihb), ndigit, & '_seupd: Ritz estimates of the untransformed Ritz values') else if (msglvl .gt. 1) then call dvout (logfil, nconv, d, ndigit, & '_seupd: Converged Ritz values') call dvout (logfil, nconv, workl(ihb), ndigit, & '_seupd: Associated Ritz estimates') end if c c %-------------------------------------------------% c | Ritz vector purification step. Formally perform | c | one of inverse subspace iteration. Only used | c | for MODE = 3,4,5. See reference 7 | c %-------------------------------------------------% c if (rvec .and. (type .eq. 'SHIFTI' .or. type .eq. 'CAYLEY')) then c do 110 k=0, nconv-1 workl(iw+k) = workl(iq+k*ldq+ncv-1) & / workl(iw+k) 110 continue c else if (rvec .and. type .eq. 'BUCKLE') then c do 120 k=0, nconv-1 workl(iw+k) = workl(iq+k*ldq+ncv-1) & / (workl(iw+k)-one) 120 continue c end if c if (type .ne. 'REGULR') & call dger (n, nconv, one, resid, 1, workl(iw), 1, z, ldz) c 9000 continue c return c c %---------------% c | End of dseupd | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/snaupd.f000644 001750 001750 00000071617 11266605602 022123 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: snaupd c c\Description: c Reverse communication interface for the Implicitly Restarted Arnoldi c iteration. This subroutine computes approximations to a few eigenpairs c of a linear operator "OP" with respect to a semi-inner product defined by c a symmetric positive semi-definite real matrix B. B may be the identity c matrix. NOTE: If the linear operator "OP" is real and symmetric c with respect to the real positive semi-definite symmetric matrix B, c i.e. B*OP = (OP`)*B, then subroutine ssaupd should be used instead. c c The computed approximate eigenvalues are called Ritz values and c the corresponding approximate eigenvectors are called Ritz vectors. c c snaupd is usually called iteratively to solve one of the c following problems: c c Mode 1: A*x = lambda*x. c ===> OP = A and B = I. c c Mode 2: A*x = lambda*M*x, M symmetric positive definite c ===> OP = inv[M]*A and B = M. c ===> (If M can be factored see remark 3 below) c c Mode 3: A*x = lambda*M*x, M symmetric semi-definite c ===> OP = Real_Part{ inv[A - sigma*M]*M } and B = M. c ===> shift-and-invert mode (in real arithmetic) c If OP*x = amu*x, then c amu = 1/2 * [ 1/(lambda-sigma) + 1/(lambda-conjg(sigma)) ]. c Note: If sigma is real, i.e. imaginary part of sigma is zero; c Real_Part{ inv[A - sigma*M]*M } == inv[A - sigma*M]*M c amu == 1/(lambda-sigma). c c Mode 4: A*x = lambda*M*x, M symmetric semi-definite c ===> OP = Imaginary_Part{ inv[A - sigma*M]*M } and B = M. c ===> shift-and-invert mode (in real arithmetic) c If OP*x = amu*x, then c amu = 1/2i * [ 1/(lambda-sigma) - 1/(lambda-conjg(sigma)) ]. c c Both mode 3 and 4 give the same enhancement to eigenvalues close to c the (complex) shift sigma. However, as lambda goes to infinity, c the operator OP in mode 4 dampens the eigenvalues more strongly than c does OP defined in mode 3. c c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v c should be accomplished either by a direct method c using a sparse matrix factorization and solving c c [A - sigma*M]*w = v or M*w = v, c c or through an iterative method for solving these c systems. If an iterative method is used, the c convergence test must be more stringent than c the accuracy requirements for the eigenvalue c approximations. c c\Usage: c call snaupd c ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, c IPNTR, WORKD, WORKL, LWORKL, INFO ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. IDO must be zero on the first c call to snaupd. IDO will be set internally to c indicate the type of operation to be performed. Control is c then given back to the calling routine which has the c responsibility to carry out the requested operation and call c snaupd with the result. The operand is given in c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)). c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c This is for the initialization phase to force the c starting vector into the range of OP. c IDO = 1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c In mode 3 and 4, the vector B * X is already c available in WORKD(ipntr(3)). It does not c need to be recomputed in forming OP * X. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c IDO = 3: compute the IPARAM(8) real and imaginary parts c of the shifts where INPTR(14) is the pointer c into WORKL for placing the shifts. See Remark c 5 below. c IDO = 99: done c ------------------------------------------------------------- c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B that defines the c semi-inner product for the operator OP. c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*B*x c c N Integer. (INPUT) c Dimension of the eigenproblem. c c WHICH Character*2. (INPUT) c 'LM' -> want the NEV eigenvalues of largest magnitude. c 'SM' -> want the NEV eigenvalues of smallest magnitude. c 'LR' -> want the NEV eigenvalues of largest real part. c 'SR' -> want the NEV eigenvalues of smallest real part. c 'LI' -> want the NEV eigenvalues of largest imaginary part. c 'SI' -> want the NEV eigenvalues of smallest imaginary part. c c NEV Integer. (INPUT/OUTPUT) c Number of eigenvalues of OP to be computed. 0 < NEV < N-1. c c TOL Real scalar. (INPUT) c Stopping criterion: the relative accuracy of the Ritz value c is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)) c where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex. c DEFAULT = SLAMCH('EPS') (machine precision as computed c by the LAPACK auxiliary subroutine SLAMCH). c c RESID Real array of length N. (INPUT/OUTPUT) c On INPUT: c If INFO .EQ. 0, a random initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c On OUTPUT: c RESID contains the final residual vector. c c NCV Integer. (INPUT) c Number of columns of the matrix V. NCV must satisfy the two c inequalities 2 <= NCV-NEV and NCV <= N. c This will indicate how many Arnoldi vectors are generated c at each iteration. After the startup phase in which NEV c Arnoldi vectors are generated, the algorithm generates c approximately NCV-NEV Arnoldi vectors at each subsequent update c iteration. Most of the cost in generating each Arnoldi vector is c in the matrix-vector operation OP*x. c NOTE: 2 <= NCV-NEV in order that complex conjugate pairs of Ritz c values are kept together. (See remark 4 below) c c V Real array N by NCV. (OUTPUT) c Contains the final set of Arnoldi basis vectors. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling program. c c IPARAM Integer array of length 11. (INPUT/OUTPUT) c IPARAM(1) = ISHIFT: method for selecting the implicit shifts. c The shifts selected at each iteration are used to restart c the Arnoldi iteration in an implicit fashion. c ------------------------------------------------------------- c ISHIFT = 0: the shifts are provided by the user via c reverse communication. The real and imaginary c parts of the NCV eigenvalues of the Hessenberg c matrix H are returned in the part of the WORKL c array corresponding to RITZR and RITZI. See remark c 5 below. c ISHIFT = 1: exact shifts with respect to the current c Hessenberg matrix H. This is equivalent to c restarting the iteration with a starting vector c that is a linear combination of approximate Schur c vectors associated with the "wanted" Ritz values. c ------------------------------------------------------------- c c IPARAM(2) = No longer referenced. c c IPARAM(3) = MXITER c On INPUT: maximum number of Arnoldi update iterations allowed. c On OUTPUT: actual number of Arnoldi update iterations taken. c c IPARAM(4) = NB: blocksize to be used in the recurrence. c The code currently works only for NB = 1. c c IPARAM(5) = NCONV: number of "converged" Ritz values. c This represents the number of Ritz values that satisfy c the convergence criterion. c c IPARAM(6) = IUPD c No longer referenced. Implicit restarting is ALWAYS used. c c IPARAM(7) = MODE c On INPUT determines what type of eigenproblem is being solved. c Must be 1,2,3,4; See under \Description of snaupd for the c four modes available. c c IPARAM(8) = NP c When ido = 3 and the user provides shifts through reverse c communication (IPARAM(1)=0), snaupd returns NP, the number c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark c 5 below. c c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO, c OUTPUT: NUMOP = total number of OP*x operations, c NUMOPB = total number of B*x operations if BMAT='G', c NUMREO = total number of steps of re-orthogonalization. c c IPNTR Integer array of length 14. (OUTPUT) c Pointer to mark the starting locations in the WORKD and WORKL c arrays for matrices/vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X in WORKD. c IPNTR(2): pointer to the current result vector Y in WORKD. c IPNTR(3): pointer to the vector B * X in WORKD when used in c the shift-and-invert mode. c IPNTR(4): pointer to the next available location in WORKL c that is untouched by the program. c IPNTR(5): pointer to the NCV by NCV upper Hessenberg matrix c H in WORKL. c IPNTR(6): pointer to the real part of the ritz value array c RITZR in WORKL. c IPNTR(7): pointer to the imaginary part of the ritz value array c RITZI in WORKL. c IPNTR(8): pointer to the Ritz estimates in array WORKL associated c with the Ritz values located in RITZR and RITZI in WORKL. c c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below. c c Note: IPNTR(9:13) is only referenced by sneupd. See Remark 2 below. c c IPNTR(9): pointer to the real part of the NCV RITZ values of the c original system. c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of c the original system. c IPNTR(11): pointer to the NCV corresponding error bounds. c IPNTR(12): pointer to the NCV by NCV upper quasi-triangular c Schur matrix for H. c IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors c of the upper Hessenberg matrix H. Only referenced by c sneupd if RVEC = .TRUE. See Remark 2 below. c ------------------------------------------------------------- c c WORKD Real work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration. Upon termination c WORKD(1:N) contains B*RESID(1:N). If an invariant subspace c associated with the converged Ritz values is desired, see remark c 2 below, subroutine sneupd uses this output. c See Data Distribution Note below. c c WORKL Real work array of length LWORKL. (OUTPUT/WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. See Data Distribution Note below. c c LWORKL Integer. (INPUT) c LWORKL must be at least 3*NCV**2 + 6*NCV. c c INFO Integer. (INPUT/OUTPUT) c If INFO .EQ. 0, a randomly initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c Error flag on output. c = 0: Normal exit. c = 1: Maximum number of iterations taken. c All possible eigenvalues of OP has been found. IPARAM(5) c returns the number of wanted converged Ritz values. c = 2: No longer an informational error. Deprecated starting c with release 2 of ARPACK. c = 3: No shifts could be applied during a cycle of the c Implicitly restarted Arnoldi iteration. One possibility c is to increase the size of NCV relative to NEV. c See remark 4 below. c = -1: N must be positive. c = -2: NEV must be positive. c = -3: NCV-NEV >= 2 and less than or equal to N. c = -4: The maximum number of Arnoldi update iteration c must be greater than zero. c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI' c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work array is not sufficient. c = -8: Error return from LAPACK eigenvalue calculation; c = -9: Starting vector is zero. c = -10: IPARAM(7) must be 1,2,3,4. c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable. c = -12: IPARAM(1) must be equal to 0 or 1. c = -9999: Could not build an Arnoldi factorization. c IPARAM(5) returns the size of the current Arnoldi c factorization. c c\Remarks c 1. The computed Ritz values are approximate eigenvalues of OP. The c selection of WHICH should be made with this in mind when c Mode = 3 and 4. After convergence, approximate eigenvalues of the c original problem may be obtained with the ARPACK subroutine sneupd. c c 2. If a basis for the invariant subspace corresponding to the converged Ritz c values is needed, the user must call sneupd immediately following c completion of snaupd. This is new starting with release 2 of ARPACK. c c 3. If M can be factored into a Cholesky factorization M = LL` c then Mode = 2 should not be selected. Instead one should use c Mode = 1 with OP = inv(L)*A*inv(L`). Appropriate triangular c linear systems should be solved with L and L` rather c than computing inverses. After convergence, an approximate c eigenvector z of the original problem is recovered by solving c L`z = x where x is a Ritz vector of OP. c c 4. At present there is no a-priori analysis to guide the selection c of NCV relative to NEV. The only formal requrement is that NCV > NEV + 2. c However, it is recommended that NCV .ge. 2*NEV+1. If many problems of c the same type are to be solved, one should experiment with increasing c NCV while keeping NEV fixed for a given test problem. This will c usually decrease the required number of OP*x operations but it c also increases the work and storage required to maintain the orthogonal c basis vectors. The optimal "cross-over" with respect to CPU time c is problem dependent and must be determined empirically. c See Chapter 8 of Reference 2 for further information. c c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the c NP = IPARAM(8) real and imaginary parts of the shifts in locations c real part imaginary part c ----------------------- -------------- c 1 WORKL(IPNTR(14)) WORKL(IPNTR(14)+NP) c 2 WORKL(IPNTR(14)+1) WORKL(IPNTR(14)+NP+1) c . . c . . c . . c NP WORKL(IPNTR(14)+NP-1) WORKL(IPNTR(14)+2*NP-1). c c Only complex conjugate pairs of shifts may be applied and the pairs c must be placed in consecutive locations. The real part of the c eigenvalues of the current upper Hessenberg matrix are located in c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1) and the imaginary part c in WORKL(IPNTR(7)) through WORKL(IPNTR(7)+NCV-1). They are ordered c according to the order defined by WHICH. The complex conjugate c pairs are kept together and the associated Ritz estimates are located in c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1). c c----------------------------------------------------------------------- c c\Data Distribution Note: c c Fortran-D syntax: c ================ c Real resid(n), v(ldv,ncv), workd(3*n), workl(lworkl) c decompose d1(n), d2(n,ncv) c align resid(i) with d1(i) c align v(i,j) with d2(i,j) c align workd(i) with d1(i) range (1:n) c align workd(i) with d1(i-n) range (n+1:2*n) c align workd(i) with d1(i-2*n) range (2*n+1:3*n) c distribute d1(block), d2(block,:) c replicated workl(lworkl) c c Cray MPP syntax: c =============== c Real resid(n), v(ldv,ncv), workd(n,3), workl(lworkl) c shared resid(block), v(block,:), workd(block,:) c replicated workl(lworkl) c c CM2/CM5 syntax: c ============== c c----------------------------------------------------------------------- c c include 'ex-nonsym.doc' c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for c Real Matrices", Linear Algebra and its Applications, vol 88/89, c pp 575-595, (1987). c c\Routines called: c snaup2 ARPACK routine that implements the Implicitly Restarted c Arnoldi Iteration. c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c svout ARPACK utility routine that prints vectors. c slamch LAPACK routine that determines machine constants. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/16/93: Version '1.1' c c\SCCS Information: @(#) c FILE: naupd.F SID: 2.10 DATE OF SID: 08/23/02 RELEASE: 2 c c\Remarks c c\EndLib c c----------------------------------------------------------------------- c subroutine snaupd & ( ido, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam, & ipntr, workd, workl, lworkl, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1, which*2 integer ido, info, ldv, lworkl, n, ncv, nev Real & tol c c %-----------------% c | Array Arguments | c %-----------------% c integer iparam(11), ipntr(14) Real & resid(n), v(ldv,ncv), workd(3*n), workl(lworkl) c c %------------% c | Parameters | c %------------% c Real & one, zero parameter (one = 1.0E+0, zero = 0.0E+0) c c %---------------% c | Local Scalars | c %---------------% c integer bounds, ierr, ih, iq, ishift, iupd, iw, & ldh, ldq, levec, mode, msglvl, mxiter, nb, & nev0, next, np, ritzi, ritzr, j save bounds, ih, iq, ishift, iupd, iw, ldh, ldq, & levec, mode, msglvl, mxiter, nb, nev0, next, & np, ritzi, ritzr c c %----------------------% c | External Subroutines | c %----------------------% c external snaup2, svout, ivout, second, sstatn c c %--------------------% c | External Functions | c %--------------------% c Real & slamch external slamch c c %-----------------------% c | Executable Statements | c %-----------------------% c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call sstatn call second (t0) msglvl = mnaupd c c %----------------% c | Error checking | c %----------------% c ierr = 0 ishift = iparam(1) c levec = iparam(2) mxiter = iparam(3) c nb = iparam(4) nb = 1 c c %--------------------------------------------% c | Revision 2 performs only implicit restart. | c %--------------------------------------------% c iupd = 1 mode = iparam(7) c if (n .le. 0) then ierr = -1 else if (nev .le. 0) then ierr = -2 else if (ncv .le. nev+1 .or. ncv .gt. n) then ierr = -3 else if (mxiter .le. 0) then ierr = 4 else if (which .ne. 'LM' .and. & which .ne. 'SM' .and. & which .ne. 'LR' .and. & which .ne. 'SR' .and. & which .ne. 'LI' .and. & which .ne. 'SI') then ierr = -5 else if (bmat .ne. 'I' .and. bmat .ne. 'G') then ierr = -6 else if (lworkl .lt. 3*ncv**2 + 6*ncv) then ierr = -7 else if (mode .lt. 1 .or. mode .gt. 4) then ierr = -10 else if (mode .eq. 1 .and. bmat .eq. 'G') then ierr = -11 else if (ishift .lt. 0 .or. ishift .gt. 1) then ierr = -12 end if c c %------------% c | Error Exit | c %------------% c if (ierr .ne. 0) then info = ierr ido = 99 go to 9000 end if c c %------------------------% c | Set default parameters | c %------------------------% c if (nb .le. 0) nb = 1 if (tol .le. zero) tol = slamch('EpsMach') c c %----------------------------------------------% c | NP is the number of additional steps to | c | extend the length NEV Lanczos factorization. | c | NEV0 is the local variable designating the | c | size of the invariant subspace desired. | c %----------------------------------------------% c np = ncv - nev nev0 = nev c c %-----------------------------% c | Zero out internal workspace | c %-----------------------------% c do 10 j = 1, 3*ncv**2 + 6*ncv workl(j) = zero 10 continue c c %-------------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | c | etc... and the remaining workspace. | c | Also update pointer to be used on output. | c | Memory is laid out as follows: | c | workl(1:ncv*ncv) := generated Hessenberg matrix | c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary | c | parts of ritz values | c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds | c | workl(ncv*ncv+3*ncv+1:2*ncv*ncv+3*ncv) := rotation matrix Q | c | workl(2*ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) := workspace | c | The final workspace is needed by subroutine sneigh called | c | by snaup2. Subroutine sneigh calls LAPACK routines for | c | calculating eigenvalues and the last row of the eigenvector | c | matrix. | c %-------------------------------------------------------------% c ldh = ncv ldq = ncv ih = 1 ritzr = ih + ldh*ncv ritzi = ritzr + ncv bounds = ritzi + ncv iq = bounds + ncv iw = iq + ldq*ncv next = iw + ncv**2 + 3*ncv c ipntr(4) = next ipntr(5) = ih ipntr(6) = ritzr ipntr(7) = ritzi ipntr(8) = bounds ipntr(14) = iw c end if c c %-------------------------------------------------------% c | Carry out the Implicitly restarted Arnoldi Iteration. | c %-------------------------------------------------------% c call snaup2 & ( ido, bmat, n, which, nev0, np, tol, resid, mode, iupd, & ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritzr), & workl(ritzi), workl(bounds), workl(iq), ldq, workl(iw), & ipntr, workd, info ) c c %--------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP or shifts. | c %--------------------------------------------------% c if (ido .eq. 3) iparam(8) = np if (ido .ne. 99) go to 9000 c iparam(3) = mxiter iparam(5) = np iparam(9) = nopx iparam(10) = nbx iparam(11) = nrorth c c %------------------------------------% c | Exit if there was an informational | c | error within snaup2. | c %------------------------------------% c if (info .lt. 0) go to 9000 if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then call ivout (logfil, 1, mxiter, ndigit, & '_naupd: Number of update iterations taken') call ivout (logfil, 1, np, ndigit, & '_naupd: Number of wanted "converged" Ritz values') call svout (logfil, np, workl(ritzr), ndigit, & '_naupd: Real part of the final Ritz values') call svout (logfil, np, workl(ritzi), ndigit, & '_naupd: Imaginary part of the final Ritz values') call svout (logfil, np, workl(bounds), ndigit, & '_naupd: Associated Ritz estimates') end if c call second (t1) tnaupd = t1 - t0 c if (msglvl .gt. 0) then c c %--------------------------------------------------------% c | Version Number & Version Date are defined in version.h | c %--------------------------------------------------------% c write (6,1000) write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt, & tmvopx, tmvbx, tnaupd, tnaup2, tnaitr, titref, & tgetv0, tneigh, tngets, tnapps, tnconv, trvec 1000 format (//, & 5x, '=============================================',/ & 5x, '= Nonsymmetric implicit Arnoldi update code =',/ & 5x, '= Version Number: ', ' 2.4', 21x, ' =',/ & 5x, '= Version Date: ', ' 07/31/96', 16x, ' =',/ & 5x, '=============================================',/ & 5x, '= Summary of timing statistics =',/ & 5x, '=============================================',//) 1100 format ( & 5x, 'Total number update iterations = ', i5,/ & 5x, 'Total number of OP*x operations = ', i5,/ & 5x, 'Total number of B*x operations = ', i5,/ & 5x, 'Total number of reorthogonalization steps = ', i5,/ & 5x, 'Total number of iterative refinement steps = ', i5,/ & 5x, 'Total number of restart steps = ', i5,/ & 5x, 'Total time in user OP*x operation = ', f12.6,/ & 5x, 'Total time in user B*x operation = ', f12.6,/ & 5x, 'Total time in Arnoldi update routine = ', f12.6,/ & 5x, 'Total time in naup2 routine = ', f12.6,/ & 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/ & 5x, 'Total time in reorthogonalization phase = ', f12.6,/ & 5x, 'Total time in (re)start vector generation = ', f12.6,/ & 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/ & 5x, 'Total time in getting the shifts = ', f12.6,/ & 5x, 'Total time in applying the shifts = ', f12.6,/ & 5x, 'Total time in convergence testing = ', f12.6,/ & 5x, 'Total time in computing final Ritz vectors = ', f12.6/) end if c 9000 continue c return c c %---------------% c | End of snaupd | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dmout.f000644 001750 001750 00000012657 11266605602 021760 0ustar00geuzainegeuzaine000000 000000 *----------------------------------------------------------------------- * Routine: DMOUT * * Purpose: Real matrix output routine. * * Usage: CALL DMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT) * * Arguments * M - Number of rows of A. (Input) * N - Number of columns of A. (Input) * A - Real M by N matrix to be printed. (Input) * LDA - Leading dimension of A exactly as specified in the * dimension statement of the calling program. (Input) * IFMT - Format to be used in printing matrix A. (Input) * IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In) * If IDIGIT .LT. 0, printing is done with 72 columns. * If IDIGIT .GT. 0, printing is done with 132 columns. * *----------------------------------------------------------------------- * SUBROUTINE DMOUT( LOUT, M, N, A, LDA, IDIGIT, IFMT ) * ... * ... SPECIFICATIONS FOR ARGUMENTS * ... * ... SPECIFICATIONS FOR LOCAL VARIABLES * .. Scalar Arguments .. CHARACTER*( * ) IFMT INTEGER IDIGIT, LDA, LOUT, M, N * .. * .. Array Arguments .. DOUBLE PRECISION A( LDA, * ) * .. * .. Local Scalars .. CHARACTER*80 LINE INTEGER I, J, K1, K2, LLL, NDIGIT * .. * .. Local Arrays .. CHARACTER ICOL( 3 ) * .. * .. Intrinsic Functions .. INTRINSIC LEN, MIN, MIN0 * .. * .. Data statements .. DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o', $ 'l' / * .. * .. Executable Statements .. * ... * ... FIRST EXECUTABLE STATEMENT * LLL = MIN( LEN( IFMT ), 80 ) DO 10 I = 1, LLL LINE( I: I ) = '-' 10 CONTINUE * DO 20 I = LLL + 1, 80 LINE( I: I ) = ' ' 20 CONTINUE * WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL ) 9999 FORMAT( / 1X, A, / 1X, A ) * IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 ) $ RETURN NDIGIT = IDIGIT IF( IDIGIT.EQ.0 ) $ NDIGIT = 4 * *======================================================================= * CODE FOR OUTPUT USING 72 COLUMNS FORMAT *======================================================================= * IF( IDIGIT.LT.0 ) THEN NDIGIT = -IDIGIT IF( NDIGIT.LE.4 ) THEN DO 40 K1 = 1, N, 5 K2 = MIN0( N, K1+4 ) WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 ) DO 30 I = 1, M WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 ) 30 CONTINUE 40 CONTINUE * ELSE IF( NDIGIT.LE.6 ) THEN DO 60 K1 = 1, N, 4 K2 = MIN0( N, K1+3 ) WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 ) DO 50 I = 1, M WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 ) 50 CONTINUE 60 CONTINUE * ELSE IF( NDIGIT.LE.10 ) THEN DO 80 K1 = 1, N, 3 K2 = MIN0( N, K1+2 ) WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 ) DO 70 I = 1, M WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 ) 70 CONTINUE 80 CONTINUE * ELSE DO 100 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 ) DO 90 I = 1, M WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 ) 90 CONTINUE 100 CONTINUE END IF * *======================================================================= * CODE FOR OUTPUT USING 132 COLUMNS FORMAT *======================================================================= * ELSE IF( NDIGIT.LE.4 ) THEN DO 120 K1 = 1, N, 10 K2 = MIN0( N, K1+9 ) WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 ) DO 110 I = 1, M WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 ) 110 CONTINUE 120 CONTINUE * ELSE IF( NDIGIT.LE.6 ) THEN DO 140 K1 = 1, N, 8 K2 = MIN0( N, K1+7 ) WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 ) DO 130 I = 1, M WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 ) 130 CONTINUE 140 CONTINUE * ELSE IF( NDIGIT.LE.10 ) THEN DO 160 K1 = 1, N, 6 K2 = MIN0( N, K1+5 ) WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 ) DO 150 I = 1, M WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 ) 150 CONTINUE 160 CONTINUE * ELSE DO 180 K1 = 1, N, 5 K2 = MIN0( N, K1+4 ) WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 ) DO 170 I = 1, M WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 ) 170 CONTINUE 180 CONTINUE END IF END IF WRITE( LOUT, FMT = 9990 ) * 9998 FORMAT( 10X, 10( 4X, 3A1, I4, 1X ) ) 9997 FORMAT( 10X, 8( 5X, 3A1, I4, 2X ) ) 9996 FORMAT( 10X, 6( 7X, 3A1, I4, 4X ) ) 9995 FORMAT( 10X, 5( 9X, 3A1, I4, 6X ) ) 9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 10D12.3 ) 9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 8D14.5 ) 9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 6D18.9 ) 9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 5D22.13 ) 9990 FORMAT( 1X, ' ' ) * RETURN END getdp-2.7.0-source/contrib/Arpack/sstats.f000644 001750 001750 00000002216 11266605602 022137 0ustar00geuzainegeuzaine000000 000000 c c\SCCS Information: @(#) c FILE: stats.F SID: 2.1 DATE OF SID: 4/19/96 RELEASE: 2 c %---------------------------------------------% c | Initialize statistic and timing information | c | for symmetric Arnoldi code. | c %---------------------------------------------% subroutine sstats c %--------------------------------% c | See stat.doc for documentation | c %--------------------------------% include 'stat.h' c %-----------------------% c | Executable Statements | c %-----------------------% nopx = 0 nbx = 0 nrorth = 0 nitref = 0 nrstrt = 0 tsaupd = 0.0E+0 tsaup2 = 0.0E+0 tsaitr = 0.0E+0 tseigt = 0.0E+0 tsgets = 0.0E+0 tsapps = 0.0E+0 tsconv = 0.0E+0 titref = 0.0E+0 tgetv0 = 0.0E+0 trvec = 0.0E+0 c %----------------------------------------------------% c | User time including reverse communication overhead | c %----------------------------------------------------% tmvopx = 0.0E+0 tmvbx = 0.0E+0 return c c End of sstats c end getdp-2.7.0-source/contrib/Arpack/cnaup2.f000644 001750 001750 00000071035 11266605602 022013 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: cnaup2 c c\Description: c Intermediate level interface called by cnaupd. c c\Usage: c call cnaup2 c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD, c ISHIFT, MXITER, V, LDV, H, LDH, RITZ, BOUNDS, c Q, LDQ, WORKL, IPNTR, WORKD, RWORK, INFO ) c c\Arguments c c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in cnaupd. c MODE, ISHIFT, MXITER: see the definition of IPARAM in cnaupd. c c NP Integer. (INPUT/OUTPUT) c Contains the number of implicit shifts to apply during c each Arnoldi iteration. c If ISHIFT=1, NP is adjusted dynamically at each iteration c to accelerate convergence and prevent stagnation. c This is also roughly equal to the number of matrix-vector c products (involving the operator OP) per Arnoldi iteration. c The logic for adjusting is contained within the current c subroutine. c If ISHIFT=0, NP is the number of shifts the user needs c to provide via reverse comunication. 0 < NP < NCV-NEV. c NP may be less than NCV-NEV since a leading block of the current c upper Hessenberg matrix has split off and contains "unwanted" c Ritz values. c Upon termination of the IRA iteration, NP contains the number c of "converged" wanted Ritz values. c c IUPD Integer. (INPUT) c IUPD .EQ. 0: use explicit restart instead implicit update. c IUPD .NE. 0: use implicit update. c c V Complex N by (NEV+NP) array. (INPUT/OUTPUT) c The Arnoldi basis vectors are returned in the first NEV c columns of V. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Complex (NEV+NP) by (NEV+NP) array. (OUTPUT) c H is used to store the generated upper Hessenberg matrix c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RITZ Complex array of length NEV+NP. (OUTPUT) c RITZ(1:NEV) contains the computed Ritz values of OP. c c BOUNDS Complex array of length NEV+NP. (OUTPUT) c BOUNDS(1:NEV) contain the error bounds corresponding to c the computed Ritz values. c c Q Complex (NEV+NP) by (NEV+NP) array. (WORKSPACE) c Private (replicated) work array used to accumulate the c rotation in the shift application step. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKL Complex work array of length at least c (NEV+NP)**2 + 3*(NEV+NP). (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. It is used in shifts calculation, shifts c application and convergence checking. c c c IPNTR Integer array of length 3. (OUTPUT) c Pointer to mark the starting locations in the WORKD for c vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. c IPNTR(3): pointer to the vector B * X when used in the c shift-and-invert mode. X is the current operand. c ------------------------------------------------------------- c c WORKD Complex work array of length 3*N. (WORKSPACE) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration !!!!!!!!!! c See Data Distribution Note in CNAUPD. c c RWORK Real work array of length NEV+NP ( WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. c c INFO Integer. (INPUT/OUTPUT) c If INFO .EQ. 0, a randomly initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c Error flag on output. c = 0: Normal return. c = 1: Maximum number of iterations taken. c All possible eigenvalues of OP has been found. c NP returns the number of converged Ritz values. c = 2: No shifts could be applied. c = -8: Error return from LAPACK eigenvalue calculation; c This should never happen. c = -9: Starting vector is zero. c = -9999: Could not build an Arnoldi factorization. c Size that was built in returned in NP. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx Complex c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: c cgetv0 ARPACK initial vector generation routine. c cnaitr ARPACK Arnoldi factorization routine. c cnapps ARPACK application of implicit shifts routine. c cneigh ARPACK compute Ritz values and error bounds routine. c cngets ARPACK reorder Ritz values and error bounds routine. c csortc ARPACK sorting routine. c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c cmout ARPACK utility routine that prints matrices c cvout ARPACK utility routine that prints vectors. c svout ARPACK utility routine that prints vectors. c slamch LAPACK routine that determines machine constants. c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c ccopy Level 1 BLAS that copies one vector to another . c cdotc Level 1 BLAS that computes the scalar product of two vectors. c cswap Level 1 BLAS that swaps two vectors. c scnrm2 Level 1 BLAS that computes the norm of a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice Universitya c Chao Yang Houston, Texas c Dept. of Computational & c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: naup2.F SID: 2.6 DATE OF SID: 06/01/00 RELEASE: 2 c c\Remarks c 1. None c c\EndLib c c----------------------------------------------------------------------- c subroutine cnaup2 & ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd, & ishift, mxiter, v, ldv, h, ldh, ritz, bounds, & q, ldq, workl, ipntr, workd, rwork, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1, which*2 integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter, & n, nev, np Real & tol c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(13) Complex & bounds(nev+np), h(ldh,nev+np), q(ldq,nev+np), & resid(n), ritz(nev+np), v(ldv,nev+np), & workd(3*n), workl( (nev+np)*(nev+np+3) ) Real & rwork(nev+np) c c %------------% c | Parameters | c %------------% c Complex & one, zero Real & rzero parameter (one = (1.0E+0, 0.0E+0) , zero = (0.0E+0, 0.0E+0) , & rzero = 0.0E+0 ) c c %---------------% c | Local Scalars | c %---------------% c logical cnorm , getv0, initv , update, ushift integer ierr , iter , kplusp, msglvl, nconv, & nevbef, nev0 , np0 , nptemp, i , & j Complex & cmpnorm Real & rnorm , eps23, rtemp character wprime*2 c save cnorm, getv0, initv , update, ushift, & rnorm, iter , kplusp, msglvl, nconv , & nevbef, nev0 , np0 , eps23 c c c %-----------------------% c | Local array arguments | c %-----------------------% c integer kp(3) c c %----------------------% c | External Subroutines | c %----------------------% c external ccopy, cgetv0, cnaitr, cneigh, cngets, cnapps, & csortc, cswap, cmout, cvout, ivout, second c c %--------------------% c | External functions | c %--------------------% c Complex & cdotc Real & scnrm2, slamch, slapy2 external cdotc, scnrm2, slamch, slapy2 c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic aimag, real , min, max c c %-----------------------% c | Executable Statements | c %-----------------------% c if (ido .eq. 0) then c call second (t0) c msglvl = mcaup2 c nev0 = nev np0 = np c c %-------------------------------------% c | kplusp is the bound on the largest | c | Lanczos factorization built. | c | nconv is the current number of | c | "converged" eigenvalues. | c | iter is the counter on the current | c | iteration step. | c %-------------------------------------% c kplusp = nev + np nconv = 0 iter = 0 c c %---------------------------------% c | Get machine dependent constant. | c %---------------------------------% c eps23 = slamch('Epsilon-Machine') eps23 = eps23**(2.0E+0 / 3.0E+0 ) c c %---------------------------------------% c | Set flags for computing the first NEV | c | steps of the Arnoldi factorization. | c %---------------------------------------% c getv0 = .true. update = .false. ushift = .false. cnorm = .false. c if (info .ne. 0) then c c %--------------------------------------------% c | User provides the initial residual vector. | c %--------------------------------------------% c initv = .true. info = 0 else initv = .false. end if end if c c %---------------------------------------------% c | Get a possibly random starting vector and | c | force it into the range of the operator OP. | c %---------------------------------------------% c 10 continue c if (getv0) then call cgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, rnorm, & ipntr, workd, info) c if (ido .ne. 99) go to 9000 c if (rnorm .eq. rzero) then c c %-----------------------------------------% c | The initial vector is zero. Error exit. | c %-----------------------------------------% c info = -9 go to 1100 end if getv0 = .false. ido = 0 end if c c %-----------------------------------% c | Back from reverse communication : | c | continue with update step | c %-----------------------------------% c if (update) go to 20 c c %-------------------------------------------% c | Back from computing user specified shifts | c %-------------------------------------------% c if (ushift) go to 50 c c %-------------------------------------% c | Back from computing residual norm | c | at the end of the current iteration | c %-------------------------------------% c if (cnorm) go to 100 c c %----------------------------------------------------------% c | Compute the first NEV steps of the Arnoldi factorization | c %----------------------------------------------------------% c call cnaitr (ido, bmat, n, 0, nev, mode, resid, rnorm, v, ldv, & h, ldh, ipntr, workd, info) c if (ido .ne. 99) go to 9000 c if (info .gt. 0) then np = info mxiter = iter info = -9999 go to 1200 end if c c %--------------------------------------------------------------% c | | c | M A I N ARNOLDI I T E R A T I O N L O O P | c | Each iteration implicitly restarts the Arnoldi | c | factorization in place. | c | | c %--------------------------------------------------------------% c 1000 continue c iter = iter + 1 c if (msglvl .gt. 0) then call ivout (logfil, 1, iter, ndigit, & '_naup2: **** Start of major iteration number ****') end if c c %-----------------------------------------------------------% c | Compute NP additional steps of the Arnoldi factorization. | c | Adjust NP since NEV might have been updated by last call | c | to the shift application routine cnapps. | c %-----------------------------------------------------------% c np = kplusp - nev c if (msglvl .gt. 1) then call ivout (logfil, 1, nev, ndigit, & '_naup2: The length of the current Arnoldi factorization') call ivout (logfil, 1, np, ndigit, & '_naup2: Extend the Arnoldi factorization by') end if c c %-----------------------------------------------------------% c | Compute NP additional steps of the Arnoldi factorization. | c %-----------------------------------------------------------% c ido = 0 20 continue update = .true. c call cnaitr(ido, bmat, n, nev, np, mode, resid, rnorm, & v , ldv , h, ldh, ipntr, workd, info) c if (ido .ne. 99) go to 9000 c if (info .gt. 0) then np = info mxiter = iter info = -9999 go to 1200 end if update = .false. c if (msglvl .gt. 1) then call svout (logfil, 1, rnorm, ndigit, & '_naup2: Corresponding B-norm of the residual') end if c c %--------------------------------------------------------% c | Compute the eigenvalues and corresponding error bounds | c | of the current upper Hessenberg matrix. | c %--------------------------------------------------------% c call cneigh (rnorm, kplusp, h, ldh, ritz, bounds, & q, ldq, workl, rwork, ierr) c if (ierr .ne. 0) then info = -8 go to 1200 end if c c %---------------------------------------------------% c | Select the wanted Ritz values and their bounds | c | to be used in the convergence test. | c | The wanted part of the spectrum and corresponding | c | error bounds are in the last NEV loc. of RITZ, | c | and BOUNDS respectively. | c %---------------------------------------------------% c nev = nev0 np = np0 c c %--------------------------------------------------% c | Make a copy of Ritz values and the corresponding | c | Ritz estimates obtained from cneigh. | c %--------------------------------------------------% c call ccopy(kplusp,ritz,1,workl(kplusp**2+1),1) call ccopy(kplusp,bounds,1,workl(kplusp**2+kplusp+1),1) c c %---------------------------------------------------% c | Select the wanted Ritz values and their bounds | c | to be used in the convergence test. | c | The wanted part of the spectrum and corresponding | c | bounds are in the last NEV loc. of RITZ | c | BOUNDS respectively. | c %---------------------------------------------------% c call cngets (ishift, which, nev, np, ritz, bounds) c c %------------------------------------------------------------% c | Convergence test: currently we use the following criteria. | c | The relative accuracy of a Ritz value is considered | c | acceptable if: | c | | c | error_bounds(i) .le. tol*max(eps23, magnitude_of_ritz(i)). | c | | c %------------------------------------------------------------% c nconv = 0 c do 25 i = 1, nev rtemp = max( eps23, slapy2( real (ritz(np+i)), & aimag(ritz(np+i)) ) ) if ( slapy2(real (bounds(np+i)),aimag(bounds(np+i))) & .le. tol*rtemp ) then nconv = nconv + 1 end if 25 continue c if (msglvl .gt. 2) then kp(1) = nev kp(2) = np kp(3) = nconv call ivout (logfil, 3, kp, ndigit, & '_naup2: NEV, NP, NCONV are') call cvout (logfil, kplusp, ritz, ndigit, & '_naup2: The eigenvalues of H') call cvout (logfil, kplusp, bounds, ndigit, & '_naup2: Ritz estimates of the current NCV Ritz values') end if c c %---------------------------------------------------------% c | Count the number of unwanted Ritz values that have zero | c | Ritz estimates. If any Ritz estimates are equal to zero | c | then a leading block of H of order equal to at least | c | the number of Ritz values with zero Ritz estimates has | c | split off. None of these Ritz values may be removed by | c | shifting. Decrease NP the number of shifts to apply. If | c | no shifts may be applied, then prepare to exit | c %---------------------------------------------------------% c nptemp = np do 30 j=1, nptemp if (bounds(j) .eq. zero) then np = np - 1 nev = nev + 1 end if 30 continue c if ( (nconv .ge. nev0) .or. & (iter .gt. mxiter) .or. & (np .eq. 0) ) then c if (msglvl .gt. 4) then call cvout(logfil, kplusp, workl(kplusp**2+1), ndigit, & '_naup2: Eigenvalues computed by _neigh:') call cvout(logfil, kplusp, workl(kplusp**2+kplusp+1), & ndigit, & '_naup2: Ritz estimates computed by _neigh:') end if c c %------------------------------------------------% c | Prepare to exit. Put the converged Ritz values | c | and corresponding bounds in RITZ(1:NCONV) and | c | BOUNDS(1:NCONV) respectively. Then sort. Be | c | careful when NCONV > NP | c %------------------------------------------------% c c %------------------------------------------% c | Use h( 3,1 ) as storage to communicate | c | rnorm to cneupd if needed | c %------------------------------------------% h(3,1) = cmplx(rnorm,rzero) c c %----------------------------------------------% c | Sort Ritz values so that converged Ritz | c | values appear within the first NEV locations | c | of ritz and bounds, and the most desired one | c | appears at the front. | c %----------------------------------------------% c if (which .eq. 'LM') wprime = 'SM' if (which .eq. 'SM') wprime = 'LM' if (which .eq. 'LR') wprime = 'SR' if (which .eq. 'SR') wprime = 'LR' if (which .eq. 'LI') wprime = 'SI' if (which .eq. 'SI') wprime = 'LI' c call csortc(wprime, .true., kplusp, ritz, bounds) c c %--------------------------------------------------% c | Scale the Ritz estimate of each Ritz value | c | by 1 / max(eps23, magnitude of the Ritz value). | c %--------------------------------------------------% c do 35 j = 1, nev0 rtemp = max( eps23, slapy2( real (ritz(j)), & aimag(ritz(j)) ) ) bounds(j) = bounds(j)/rtemp 35 continue c c %---------------------------------------------------% c | Sort the Ritz values according to the scaled Ritz | c | estimates. This will push all the converged ones | c | towards the front of ritz, bounds (in the case | c | when NCONV < NEV.) | c %---------------------------------------------------% c wprime = 'LM' call csortc(wprime, .true., nev0, bounds, ritz) c c %----------------------------------------------% c | Scale the Ritz estimate back to its original | c | value. | c %----------------------------------------------% c do 40 j = 1, nev0 rtemp = max( eps23, slapy2( real (ritz(j)), & aimag(ritz(j)) ) ) bounds(j) = bounds(j)*rtemp 40 continue c c %-----------------------------------------------% c | Sort the converged Ritz values again so that | c | the "threshold" value appears at the front of | c | ritz and bound. | c %-----------------------------------------------% c call csortc(which, .true., nconv, ritz, bounds) c if (msglvl .gt. 1) then call cvout (logfil, kplusp, ritz, ndigit, & '_naup2: Sorted eigenvalues') call cvout (logfil, kplusp, bounds, ndigit, & '_naup2: Sorted ritz estimates.') end if c c %------------------------------------% c | Max iterations have been exceeded. | c %------------------------------------% c if (iter .gt. mxiter .and. nconv .lt. nev0) info = 1 c c %---------------------% c | No shifts to apply. | c %---------------------% c if (np .eq. 0 .and. nconv .lt. nev0) info = 2 c np = nconv go to 1100 c else if ( (nconv .lt. nev0) .and. (ishift .eq. 1) ) then c c %-------------------------------------------------% c | Do not have all the requested eigenvalues yet. | c | To prevent possible stagnation, adjust the size | c | of NEV. | c %-------------------------------------------------% c nevbef = nev nev = nev + min(nconv, np/2) if (nev .eq. 1 .and. kplusp .ge. 6) then nev = kplusp / 2 else if (nev .eq. 1 .and. kplusp .gt. 3) then nev = 2 end if np = kplusp - nev c c %---------------------------------------% c | If the size of NEV was just increased | c | resort the eigenvalues. | c %---------------------------------------% c if (nevbef .lt. nev) & call cngets (ishift, which, nev, np, ritz, bounds) c end if c if (msglvl .gt. 0) then call ivout (logfil, 1, nconv, ndigit, & '_naup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev kp(2) = np call ivout (logfil, 2, kp, ndigit, & '_naup2: NEV and NP are') call cvout (logfil, nev, ritz(np+1), ndigit, & '_naup2: "wanted" Ritz values ') call cvout (logfil, nev, bounds(np+1), ndigit, & '_naup2: Ritz estimates of the "wanted" values ') end if end if c if (ishift .eq. 0) then c c %-------------------------------------------------------% c | User specified shifts: pop back out to get the shifts | c | and return them in the first 2*NP locations of WORKL. | c %-------------------------------------------------------% c ushift = .true. ido = 3 go to 9000 end if 50 continue ushift = .false. c if ( ishift .ne. 1 ) then c c %----------------------------------% c | Move the NP shifts from WORKL to | c | RITZ, to free up WORKL | c | for non-exact shift case. | c %----------------------------------% c call ccopy (np, workl, 1, ritz, 1) end if c if (msglvl .gt. 2) then call ivout (logfil, 1, np, ndigit, & '_naup2: The number of shifts to apply ') call cvout (logfil, np, ritz, ndigit, & '_naup2: values of the shifts') if ( ishift .eq. 1 ) & call cvout (logfil, np, bounds, ndigit, & '_naup2: Ritz estimates of the shifts') end if c c %---------------------------------------------------------% c | Apply the NP implicit shifts by QR bulge chasing. | c | Each shift is applied to the whole upper Hessenberg | c | matrix H. | c | The first 2*N locations of WORKD are used as workspace. | c %---------------------------------------------------------% c call cnapps (n, nev, np, ritz, v, ldv, & h, ldh, resid, q, ldq, workl, workd) c c %---------------------------------------------% c | Compute the B-norm of the updated residual. | c | Keep B*RESID in WORKD(1:N) to be used in | c | the first step of the next call to cnaitr. | c %---------------------------------------------% c cnorm = .true. call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call ccopy (n, resid, 1, workd(n+1), 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 c c %----------------------------------% c | Exit in order to compute B*RESID | c %----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call ccopy (n, resid, 1, workd, 1) end if c 100 continue c c %----------------------------------% c | Back from reverse communication; | c | WORKD(1:N) := B*RESID | c %----------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c if (bmat .eq. 'G') then cmpnorm = cdotc (n, resid, 1, workd, 1) rnorm = sqrt(slapy2(real (cmpnorm),aimag(cmpnorm))) else if (bmat .eq. 'I') then rnorm = scnrm2(n, resid, 1) end if cnorm = .false. c if (msglvl .gt. 2) then call svout (logfil, 1, rnorm, ndigit, & '_naup2: B-norm of residual for compressed factorization') call cmout (logfil, nev, nev, h, ldh, ndigit, & '_naup2: Compressed upper Hessenberg matrix H') end if c go to 1000 c c %---------------------------------------------------------------% c | | c | E N D O F M A I N I T E R A T I O N L O O P | c | | c %---------------------------------------------------------------% c 1100 continue c mxiter = iter nev = nconv c 1200 continue ido = 99 c c %------------% c | Error Exit | c %------------% c call second (t1) tcaup2 = t1 - t0 c 9000 continue c c %---------------% c | End of cnaup2 | c %---------------% c return end getdp-2.7.0-source/contrib/Arpack/version.h000644 001750 001750 00000002346 11266605602 022311 0ustar00geuzainegeuzaine000000 000000 /* In the current version, the parameter KAPPA in the Kahan's test for orthogonality is set to 0.717, the same as used by Gragg & Reichel. However computational experience indicates that this is a little too strict and will frequently force reorthogonalization when it is not necessary to do so. Also the "moving boundary" idea is not currently activated in the nonsymmetric code since it is not conclusive that it's the right thing to do all the time. Requires further investigation. As of 02/01/93 Richard Lehoucq assumes software control of the codes from Phuong Vu. On 03/01/93 all the *.F files were migrated SCCS. The 1.1 version of codes are those received from Phuong Vu. The frozen version of 07/08/92 is now considered version 1.1. Version 2.1 contains two new symmetric routines, sesrt and seupd. Changes as well as bug fixes for version 1.1 codes that were only corrected for programming bugs are version 1.2. These 1.2 versions will also be in version 2.1. Subroutine [d,s]saupd now requires slightly more workspace. See [d,s]saupd for the details. \SCCS Information: @(#) FILE: version.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2 */ #define VERSION_NUMBER ' 2.1' #define VERSION_DATE ' 11/15/95' getdp-2.7.0-source/contrib/Arpack/sseigt.f000644 001750 001750 00000011755 11266605602 022124 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: sseigt c c\Description: c Compute the eigenvalues of the current symmetric tridiagonal matrix c and the corresponding error bounds given the current residual norm. c c\Usage: c call sseigt c ( RNORM, N, H, LDH, EIG, BOUNDS, WORKL, IERR ) c c\Arguments c RNORM Real scalar. (INPUT) c RNORM contains the residual norm corresponding to the current c symmetric tridiagonal matrix H. c c N Integer. (INPUT) c Size of the symmetric tridiagonal matrix H. c c H Real N by 2 array. (INPUT) c H contains the symmetric tridiagonal matrix with the c subdiagonal in the first column starting at H(2,1) and the c main diagonal in second column. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c EIG Real array of length N. (OUTPUT) c On output, EIG contains the N eigenvalues of H possibly c unsorted. The BOUNDS arrays are returned in the c same sorted order as EIG. c c BOUNDS Real array of length N. (OUTPUT) c On output, BOUNDS contains the error estimates corresponding c to the eigenvalues EIG. This is equal to RNORM times the c last components of the eigenvectors corresponding to the c eigenvalues in EIG. c c WORKL Real work array of length 3*N. (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. c c IERR Integer. (OUTPUT) c Error exit flag from sstqrb. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c sstqrb ARPACK routine that computes the eigenvalues and the c last components of the eigenvectors of a symmetric c and tridiagonal matrix. c second ARPACK utility routine for timing. c svout ARPACK utility routine that prints vectors. c scopy Level 1 BLAS that copies one vector to another. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.4' c c\SCCS Information: @(#) c FILE: seigt.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks c None c c\EndLib c c----------------------------------------------------------------------- c subroutine sseigt & ( rnorm, n, h, ldh, eig, bounds, workl, ierr ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer ierr, ldh, n Real & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c Real & eig(n), bounds(n), h(ldh,2), workl(3*n) c c %------------% c | Parameters | c %------------% c Real & zero parameter (zero = 0.0E+0) c c %---------------% c | Local Scalars | c %---------------% c integer i, k, msglvl c c %----------------------% c | External Subroutines | c %----------------------% c external scopy, sstqrb, svout, second c c %-----------------------% c | Executable Statements | c %-----------------------% c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mseigt c if (msglvl .gt. 0) then call svout (logfil, n, h(1,2), ndigit, & '_seigt: main diagonal of matrix H') if (n .gt. 1) then call svout (logfil, n-1, h(2,1), ndigit, & '_seigt: sub diagonal of matrix H') end if end if c call scopy (n, h(1,2), 1, eig, 1) call scopy (n-1, h(2,1), 1, workl, 1) call sstqrb (n, eig, workl, bounds, workl(n+1), ierr) if (ierr .ne. 0) go to 9000 if (msglvl .gt. 1) then call svout (logfil, n, bounds, ndigit, & '_seigt: last row of the eigenvector matrix for H') end if c c %-----------------------------------------------% c | Finally determine the error bounds associated | c | with the n Ritz values of H. | c %-----------------------------------------------% c do 30 k = 1, n bounds(k) = rnorm*abs(bounds(k)) 30 continue c call second (t1) tseigt = tseigt + (t1 - t0) c 9000 continue return c c %---------------% c | End of sseigt | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/sneupd.f000644 001750 001750 00000125775 11266605602 022134 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: sneupd c c\Description: c c This subroutine returns the converged approximations to eigenvalues c of A*z = lambda*B*z and (optionally): c c (1) The corresponding approximate eigenvectors; c c (2) An orthonormal basis for the associated approximate c invariant subspace; c c (3) Both. c c There is negligible additional cost to obtain eigenvectors. An orthonormal c basis is always computed. There is an additional storage cost of n*nev c if both are requested (in this case a separate array Z must be supplied). c c The approximate eigenvalues and eigenvectors of A*z = lambda*B*z c are derived from approximate eigenvalues and eigenvectors of c of the linear operator OP prescribed by the MODE selection in the c call to SNAUPD. SNAUPD must be called before this routine is called. c These approximate eigenvalues and vectors are commonly called Ritz c values and Ritz vectors respectively. They are referred to as such c in the comments that follow. The computed orthonormal basis for the c invariant subspace corresponding to these Ritz values is referred to as a c Schur basis. c c See documentation in the header of the subroutine SNAUPD for c definition of OP as well as other terms and the relation of computed c Ritz values and Ritz vectors of OP with respect to the given problem c A*z = lambda*B*z. For a brief description, see definitions of c IPARAM(7), MODE and WHICH in the documentation of SNAUPD. c c\Usage: c call sneupd c ( RVEC, HOWMNY, SELECT, DR, DI, Z, LDZ, SIGMAR, SIGMAI, WORKEV, BMAT, c N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, c LWORKL, INFO ) c c\Arguments: c RVEC LOGICAL (INPUT) c Specifies whether a basis for the invariant subspace corresponding c to the converged Ritz value approximations for the eigenproblem c A*z = lambda*B*z is computed. c c RVEC = .FALSE. Compute Ritz values only. c c RVEC = .TRUE. Compute the Ritz vectors or Schur vectors. c See Remarks below. c c HOWMNY Character*1 (INPUT) c Specifies the form of the basis for the invariant subspace c corresponding to the converged Ritz values that is to be computed. c c = 'A': Compute NEV Ritz vectors; c = 'P': Compute NEV Schur vectors; c = 'S': compute some of the Ritz vectors, specified c by the logical array SELECT. c c SELECT Logical array of dimension NCV. (INPUT) c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be c computed. To select the Ritz vector corresponding to a c Ritz value (DR(j), DI(j)), SELECT(j) must be set to .TRUE.. c If HOWMNY = 'A' or 'P', SELECT is used as internal workspace. c c DR Real array of dimension NEV+1. (OUTPUT) c If IPARAM(7) = 1,2 or 3 and SIGMAI=0.0 then on exit: DR contains c the real part of the Ritz approximations to the eigenvalues of c A*z = lambda*B*z. c If IPARAM(7) = 3, 4 and SIGMAI is not equal to zero, then on exit: c DR contains the real part of the Ritz values of OP computed by c SNAUPD. A further computation must be performed by the user c to transform the Ritz values computed for OP by SNAUPD to those c of the original system A*z = lambda*B*z. See remark 3 below. c c DI Real array of dimension NEV+1. (OUTPUT) c On exit, DI contains the imaginary part of the Ritz value c approximations to the eigenvalues of A*z = lambda*B*z associated c with DR. c c NOTE: When Ritz values are complex, they will come in complex c conjugate pairs. If eigenvectors are requested, the c corresponding Ritz vectors will also come in conjugate c pairs and the real and imaginary parts of these are c represented in two consecutive columns of the array Z c (see below). c c Z Real N by NEV+1 array if RVEC = .TRUE. and HOWMNY = 'A'. (OUTPUT) c On exit, if RVEC = .TRUE. and HOWMNY = 'A', then the columns of c Z represent approximate eigenvectors (Ritz vectors) corresponding c to the NCONV=IPARAM(5) Ritz values for eigensystem c A*z = lambda*B*z. c c The complex Ritz vector associated with the Ritz value c with positive imaginary part is stored in two consecutive c columns. The first column holds the real part of the Ritz c vector and the second column holds the imaginary part. The c Ritz vector associated with the Ritz value with negative c imaginary part is simply the complex conjugate of the Ritz vector c associated with the positive imaginary part. c c If RVEC = .FALSE. or HOWMNY = 'P', then Z is not referenced. c c NOTE: If if RVEC = .TRUE. and a Schur basis is not required, c the array Z may be set equal to first NEV+1 columns of the Arnoldi c basis array V computed by SNAUPD. In this case the Arnoldi basis c will be destroyed and overwritten with the eigenvector basis. c c LDZ Integer. (INPUT) c The leading dimension of the array Z. If Ritz vectors are c desired, then LDZ >= max( 1, N ). In any case, LDZ >= 1. c c SIGMAR Real (INPUT) c If IPARAM(7) = 3 or 4, represents the real part of the shift. c Not referenced if IPARAM(7) = 1 or 2. c c SIGMAI Real (INPUT) c If IPARAM(7) = 3 or 4, represents the imaginary part of the shift. c Not referenced if IPARAM(7) = 1 or 2. See remark 3 below. c c WORKEV Real work array of dimension 3*NCV. (WORKSPACE) c c **** The remaining arguments MUST be the same as for the **** c **** call to SNAUPD that was just completed. **** c c NOTE: The remaining arguments c c BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, c WORKD, WORKL, LWORKL, INFO c c must be passed directly to SNEUPD following the last call c to SNAUPD. These arguments MUST NOT BE MODIFIED between c the the last call to SNAUPD and the call to SNEUPD. c c Three of these parameters (V, WORKL, INFO) are also output parameters: c c V Real N by NCV array. (INPUT/OUTPUT) c c Upon INPUT: the NCV columns of V contain the Arnoldi basis c vectors for OP as constructed by SNAUPD . c c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns c contain approximate Schur vectors that span the c desired invariant subspace. See Remark 2 below. c c NOTE: If the array Z has been set equal to first NEV+1 columns c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the c Arnoldi basis held by V has been overwritten by the desired c Ritz vectors. If a separate array Z has been passed then c the first NCONV=IPARAM(5) columns of V will contain approximate c Schur vectors that span the desired invariant subspace. c c WORKL Real work array of length LWORKL. (OUTPUT/WORKSPACE) c WORKL(1:ncv*ncv+3*ncv) contains information obtained in c snaupd. They are not changed by sneupd. c WORKL(ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) holds the c real and imaginary part of the untransformed Ritz values, c the upper quasi-triangular matrix for H, and the c associated matrix representation of the invariant subspace for H. c c Note: IPNTR(9:13) contains the pointer into WORKL for addresses c of the above information computed by sneupd. c ------------------------------------------------------------- c IPNTR(9): pointer to the real part of the NCV RITZ values of the c original system. c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of c the original system. c IPNTR(11): pointer to the NCV corresponding error bounds. c IPNTR(12): pointer to the NCV by NCV upper quasi-triangular c Schur matrix for H. c IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors c of the upper Hessenberg matrix H. Only referenced by c sneupd if RVEC = .TRUE. See Remark 2 below. c ------------------------------------------------------------- c c INFO Integer. (OUTPUT) c Error flag on output. c c = 0: Normal exit. c c = 1: The Schur form computed by LAPACK routine slahqr c could not be reordered by LAPACK routine strsen. c Re-enter subroutine sneupd with IPARAM(5)=NCV and c increase the size of the arrays DR and DI to have c dimension at least dimension NCV and allocate at least NCV c columns for Z. NOTE: Not necessary if Z and V share c the same space. Please notify the authors if this error c occurs. c c = -1: N must be positive. c = -2: NEV must be positive. c = -3: NCV-NEV >= 2 and less than or equal to N. c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI' c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work WORKL array is not sufficient. c = -8: Error return from calculation of a real Schur form. c Informational error from LAPACK routine slahqr. c = -9: Error return from calculation of eigenvectors. c Informational error from LAPACK routine strevc. c = -10: IPARAM(7) must be 1,2,3,4. c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible. c = -12: HOWMNY = 'S' not yet implemented c = -13: HOWMNY must be one of 'A' or 'P' if RVEC = .true. c = -14: SNAUPD did not find any eigenvalues to sufficient c accuracy. c = -15: DNEUPD got a different count of the number of converged c Ritz values than DNAUPD got. This indicates the user c probably made an error in passing data from DNAUPD to c DNEUPD or that the data was modified before entering c DNEUPD c c\BeginLib c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for c Real Matrices", Linear Algebra and its Applications, vol 88/89, c pp 575-595, (1987). c c\Routines called: c ivout ARPACK utility routine that prints integers. c smout ARPACK utility routine that prints matrices c svout ARPACK utility routine that prints vectors. c sgeqr2 LAPACK routine that computes the QR factorization of c a matrix. c slacpy LAPACK matrix copy routine. c slahqr LAPACK routine to compute the real Schur form of an c upper Hessenberg matrix. c slamch LAPACK routine that determines machine constants. c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c slaset LAPACK matrix initialization routine. c sorm2r LAPACK routine that applies an orthogonal matrix in c factored form. c strevc LAPACK routine to compute the eigenvectors of a matrix c in upper quasi-triangular form. c strsen LAPACK routine that re-orders the Schur form. c strmm Level 3 BLAS matrix times an upper triangular matrix. c sger Level 2 BLAS rank one update to a matrix. c scopy Level 1 BLAS that copies one vector to another . c sdot Level 1 BLAS that computes the scalar product of two vectors. c snrm2 Level 1 BLAS that computes the norm of a vector. c sscal Level 1 BLAS that scales a vector. c c\Remarks c c 1. Currently only HOWMNY = 'A' and 'P' are implemented. c c Let trans(X) denote the transpose of X. c c 2. Schur vectors are an orthogonal representation for the basis of c Ritz vectors. Thus, their numerical properties are often superior. c If RVEC = .TRUE. then the relationship c A * V(:,1:IPARAM(5)) = V(:,1:IPARAM(5)) * T, and c trans(V(:,1:IPARAM(5))) * V(:,1:IPARAM(5)) = I are approximately c satisfied. Here T is the leading submatrix of order IPARAM(5) of the c real upper quasi-triangular matrix stored workl(ipntr(12)). That is, c T is block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; c each 2-by-2 diagonal block has its diagonal elements equal and its c off-diagonal elements of opposite sign. Corresponding to each 2-by-2 c diagonal block is a complex conjugate pair of Ritz values. The real c Ritz values are stored on the diagonal of T. c c 3. If IPARAM(7) = 3 or 4 and SIGMAI is not equal zero, then the user must c form the IPARAM(5) Rayleigh quotients in order to transform the Ritz c values computed by SNAUPD for OP to those of A*z = lambda*B*z. c Set RVEC = .true. and HOWMNY = 'A', and c compute c trans(Z(:,I)) * A * Z(:,I) if DI(I) = 0. c If DI(I) is not equal to zero and DI(I+1) = - D(I), c then the desired real and imaginary parts of the Ritz value are c trans(Z(:,I)) * A * Z(:,I) + trans(Z(:,I+1)) * A * Z(:,I+1), c trans(Z(:,I)) * A * Z(:,I+1) - trans(Z(:,I+1)) * A * Z(:,I), c respectively. c Another possibility is to set RVEC = .true. and HOWMNY = 'P' and c compute trans(V(:,1:IPARAM(5))) * A * V(:,1:IPARAM(5)) and then an upper c quasi-triangular matrix of order IPARAM(5) is computed. See remark c 2 above. c c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Chao Yang Houston, Texas c Dept. of Computational & c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: neupd.F SID: 2.7 DATE OF SID: 09/20/00 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- subroutine sneupd(rvec , howmny, select, dr , di, & z , ldz , sigmar, sigmai, workev, & bmat , n , which , nev , tol, & resid, ncv , v , ldv , iparam, & ipntr, workd , workl , lworkl, info) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat, howmny, which*2 logical rvec integer info, ldz, ldv, lworkl, n, ncv, nev Real & sigmar, sigmai, tol c c %-----------------% c | Array Arguments | c %-----------------% c integer iparam(11), ipntr(14) logical select(ncv) Real & dr(nev+1) , di(nev+1), resid(n) , & v(ldv,ncv) , z(ldz,*) , workd(3*n), & workl(lworkl), workev(3*ncv) c c %------------% c | Parameters | c %------------% c Real & one, zero parameter (one = 1.0E+0 , zero = 0.0E+0 ) c c %---------------% c | Local Scalars | c %---------------% c character type*6 integer bounds, ierr , ih , ihbds , & iheigr, iheigi, iconj , nconv , & invsub, iuptri, iwev , iwork(1), & j , k , ldh , ldq , & mode , msglvl, outncv, ritzr , & ritzi , wri , wrr , irr , & iri , ibd , ishift, numcnv , & np , jj logical reord Real & conds , rnorm, sep , temp, & vl(1,1), temp1, eps23 c c %----------------------% c | External Subroutines | c %----------------------% c external scopy , sger , sgeqr2, slacpy, & slahqr, slaset, smout , sorm2r, & strevc, strmm , strsen, sscal , & svout , ivout c c %--------------------% c | External Functions | c %--------------------% c Real & slapy2, snrm2, slamch, sdot external slapy2, snrm2, slamch, sdot c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic abs, min, sqrt c c %-----------------------% c | Executable Statements | c %-----------------------% c c %------------------------% c | Set default parameters | c %------------------------% c msglvl = mneupd mode = iparam(7) nconv = iparam(5) info = 0 c c %---------------------------------% c | Get machine dependent constant. | c %---------------------------------% c eps23 = slamch('Epsilon-Machine') eps23 = eps23**(2.0E+0 / 3.0E+0 ) c c %--------------% c | Quick return | c %--------------% c ierr = 0 c if (nconv .le. 0) then ierr = -14 else if (n .le. 0) then ierr = -1 else if (nev .le. 0) then ierr = -2 else if (ncv .le. nev+1 .or. ncv .gt. n) then ierr = -3 else if (which .ne. 'LM' .and. & which .ne. 'SM' .and. & which .ne. 'LR' .and. & which .ne. 'SR' .and. & which .ne. 'LI' .and. & which .ne. 'SI') then ierr = -5 else if (bmat .ne. 'I' .and. bmat .ne. 'G') then ierr = -6 else if (lworkl .lt. 3*ncv**2 + 6*ncv) then ierr = -7 else if ( (howmny .ne. 'A' .and. & howmny .ne. 'P' .and. & howmny .ne. 'S') .and. rvec ) then ierr = -13 else if (howmny .eq. 'S' ) then ierr = -12 end if c if (mode .eq. 1 .or. mode .eq. 2) then type = 'REGULR' else if (mode .eq. 3 .and. sigmai .eq. zero) then type = 'SHIFTI' else if (mode .eq. 3 ) then type = 'REALPT' else if (mode .eq. 4 ) then type = 'IMAGPT' else ierr = -10 end if if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11 c c %------------% c | Error Exit | c %------------% c if (ierr .ne. 0) then info = ierr go to 9000 end if c c %--------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | c | etc... and the remaining workspace. | c | Also update pointer to be used on output. | c | Memory is laid out as follows: | c | workl(1:ncv*ncv) := generated Hessenberg matrix | c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary | c | parts of ritz values | c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds | c %--------------------------------------------------------% c c %-----------------------------------------------------------% c | The following is used and set by SNEUPD. | c | workl(ncv*ncv+3*ncv+1:ncv*ncv+4*ncv) := The untransformed | c | real part of the Ritz values. | c | workl(ncv*ncv+4*ncv+1:ncv*ncv+5*ncv) := The untransformed | c | imaginary part of the Ritz values. | c | workl(ncv*ncv+5*ncv+1:ncv*ncv+6*ncv) := The untransformed | c | error bounds of the Ritz values | c | workl(ncv*ncv+6*ncv+1:2*ncv*ncv+6*ncv) := Holds the upper | c | quasi-triangular matrix for H | c | workl(2*ncv*ncv+6*ncv+1: 3*ncv*ncv+6*ncv) := Holds the | c | associated matrix representation of the invariant | c | subspace for H. | c | GRAND total of NCV * ( 3 * NCV + 6 ) locations. | c %-----------------------------------------------------------% c ih = ipntr(5) ritzr = ipntr(6) ritzi = ipntr(7) bounds = ipntr(8) ldh = ncv ldq = ncv iheigr = bounds + ldh iheigi = iheigr + ldh ihbds = iheigi + ldh iuptri = ihbds + ldh invsub = iuptri + ldh*ncv ipntr(9) = iheigr ipntr(10) = iheigi ipntr(11) = ihbds ipntr(12) = iuptri ipntr(13) = invsub wrr = 1 wri = ncv + 1 iwev = wri + ncv c c %-----------------------------------------% c | irr points to the REAL part of the Ritz | c | values computed by _neigh before | c | exiting _naup2. | c | iri points to the IMAGINARY part of the | c | Ritz values computed by _neigh | c | before exiting _naup2. | c | ibd points to the Ritz estimates | c | computed by _neigh before exiting | c | _naup2. | c %-----------------------------------------% c irr = ipntr(14)+ncv*ncv iri = irr+ncv ibd = iri+ncv c c %------------------------------------% c | RNORM is B-norm of the RESID(1:N). | c %------------------------------------% c rnorm = workl(ih+2) workl(ih+2) = zero c if (msglvl .gt. 2) then call svout(logfil, ncv, workl(irr), ndigit, & '_neupd: Real part of Ritz values passed in from _NAUPD.') call svout(logfil, ncv, workl(iri), ndigit, & '_neupd: Imag part of Ritz values passed in from _NAUPD.') call svout(logfil, ncv, workl(ibd), ndigit, & '_neupd: Ritz estimates passed in from _NAUPD.') end if c if (rvec) then c reord = .false. c c %---------------------------------------------------% c | Use the temporary bounds array to store indices | c | These will be used to mark the select array later | c %---------------------------------------------------% c do 10 j = 1,ncv workl(bounds+j-1) = j select(j) = .false. 10 continue c c %-------------------------------------% c | Select the wanted Ritz values. | c | Sort the Ritz values so that the | c | wanted ones appear at the tailing | c | NEV positions of workl(irr) and | c | workl(iri). Move the corresponding | c | error estimates in workl(bound) | c | accordingly. | c %-------------------------------------% c np = ncv - nev ishift = 0 call sngets(ishift , which , nev , & np , workl(irr), workl(iri), & workl(bounds), workl , workl(np+1)) c if (msglvl .gt. 2) then call svout(logfil, ncv, workl(irr), ndigit, & '_neupd: Real part of Ritz values after calling _NGETS.') call svout(logfil, ncv, workl(iri), ndigit, & '_neupd: Imag part of Ritz values after calling _NGETS.') call svout(logfil, ncv, workl(bounds), ndigit, & '_neupd: Ritz value indices after calling _NGETS.') end if c c %-----------------------------------------------------% c | Record indices of the converged wanted Ritz values | c | Mark the select array for possible reordering | c %-----------------------------------------------------% c numcnv = 0 do 11 j = 1,ncv temp1 = max(eps23, & slapy2( workl(irr+ncv-j), workl(iri+ncv-j) )) jj = workl(bounds + ncv - j) if (numcnv .lt. nconv .and. & workl(ibd+jj-1) .le. tol*temp1) then select(jj) = .true. numcnv = numcnv + 1 if (jj .gt. nev) reord = .true. endif 11 continue c c %-----------------------------------------------------------% c | Check the count (numcnv) of converged Ritz values with | c | the number (nconv) reported by dnaupd. If these two | c | are different then there has probably been an error | c | caused by incorrect passing of the dnaupd data. | c %-----------------------------------------------------------% c if (msglvl .gt. 2) then call ivout(logfil, 1, numcnv, ndigit, & '_neupd: Number of specified eigenvalues') call ivout(logfil, 1, nconv, ndigit, & '_neupd: Number of "converged" eigenvalues') end if c if (numcnv .ne. nconv) then info = -15 go to 9000 end if c c %-----------------------------------------------------------% c | Call LAPACK routine slahqr to compute the real Schur form | c | of the upper Hessenberg matrix returned by SNAUPD. | c | Make a copy of the upper Hessenberg matrix. | c | Initialize the Schur vector matrix Q to the identity. | c %-----------------------------------------------------------% c call scopy(ldh*ncv, workl(ih), 1, workl(iuptri), 1) call slaset('All', ncv, ncv, & zero , one, workl(invsub), & ldq) call slahqr(.true., .true. , ncv, & 1 , ncv , workl(iuptri), & ldh , workl(iheigr), workl(iheigi), & 1 , ncv , workl(invsub), & ldq , ierr) call scopy(ncv , workl(invsub+ncv-1), ldq, & workl(ihbds), 1) c if (ierr .ne. 0) then info = -8 go to 9000 end if c if (msglvl .gt. 1) then call svout(logfil, ncv, workl(iheigr), ndigit, & '_neupd: Real part of the eigenvalues of H') call svout(logfil, ncv, workl(iheigi), ndigit, & '_neupd: Imaginary part of the Eigenvalues of H') call svout(logfil, ncv, workl(ihbds), ndigit, & '_neupd: Last row of the Schur vector matrix') if (msglvl .gt. 3) then call smout(logfil , ncv, ncv , & workl(iuptri), ldh, ndigit, & '_neupd: The upper quasi-triangular matrix ') end if end if c if (reord) then c c %-----------------------------------------------------% c | Reorder the computed upper quasi-triangular matrix. | c %-----------------------------------------------------% c call strsen('None' , 'V' , & select , ncv , & workl(iuptri), ldh , & workl(invsub), ldq , & workl(iheigr), workl(iheigi), & nconv , conds , & sep , workl(ihbds) , & ncv , iwork , & 1 , ierr) c if (ierr .eq. 1) then info = 1 go to 9000 end if c if (msglvl .gt. 2) then call svout(logfil, ncv, workl(iheigr), ndigit, & '_neupd: Real part of the eigenvalues of H--reordered') call svout(logfil, ncv, workl(iheigi), ndigit, & '_neupd: Imag part of the eigenvalues of H--reordered') if (msglvl .gt. 3) then call smout(logfil , ncv, ncv , & workl(iuptri), ldq, ndigit, & '_neupd: Quasi-triangular matrix after re-ordering') end if end if c end if c c %---------------------------------------% c | Copy the last row of the Schur vector | c | into workl(ihbds). This will be used | c | to compute the Ritz estimates of | c | converged Ritz values. | c %---------------------------------------% c call scopy(ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1) c c %----------------------------------------------------% c | Place the computed eigenvalues of H into DR and DI | c | if a spectral transformation was not used. | c %----------------------------------------------------% c if (type .eq. 'REGULR') then call scopy(nconv, workl(iheigr), 1, dr, 1) call scopy(nconv, workl(iheigi), 1, di, 1) end if c c %----------------------------------------------------------% c | Compute the QR factorization of the matrix representing | c | the wanted invariant subspace located in the first NCONV | c | columns of workl(invsub,ldq). | c %----------------------------------------------------------% c call sgeqr2(ncv, nconv , workl(invsub), & ldq, workev, workev(ncv+1), & ierr) c c %---------------------------------------------------------% c | * Postmultiply V by Q using sorm2r. | c | * Copy the first NCONV columns of VQ into Z. | c | * Postmultiply Z by R. | c | The N by NCONV matrix Z is now a matrix representation | c | of the approximate invariant subspace associated with | c | the Ritz values in workl(iheigr) and workl(iheigi) | c | The first NCONV columns of V are now approximate Schur | c | vectors associated with the real upper quasi-triangular | c | matrix of order NCONV in workl(iuptri) | c %---------------------------------------------------------% c call sorm2r('Right', 'Notranspose', n , & ncv , nconv , workl(invsub), & ldq , workev , v , & ldv , workd(n+1) , ierr) call slacpy('All', n, nconv, v, ldv, z, ldz) c do 20 j=1, nconv c c %---------------------------------------------------% c | Perform both a column and row scaling if the | c | diagonal element of workl(invsub,ldq) is negative | c | I'm lazy and don't take advantage of the upper | c | quasi-triangular form of workl(iuptri,ldq) | c | Note that since Q is orthogonal, R is a diagonal | c | matrix consisting of plus or minus ones | c %---------------------------------------------------% c if (workl(invsub+(j-1)*ldq+j-1) .lt. zero) then call sscal(nconv, -one, workl(iuptri+j-1), ldq) call sscal(nconv, -one, workl(iuptri+(j-1)*ldq), 1) end if c 20 continue c if (howmny .eq. 'A') then c c %--------------------------------------------% c | Compute the NCONV wanted eigenvectors of T | c | located in workl(iuptri,ldq). | c %--------------------------------------------% c do 30 j=1, ncv if (j .le. nconv) then select(j) = .true. else select(j) = .false. end if 30 continue c call strevc('Right', 'Select' , select , & ncv , workl(iuptri), ldq , & vl , 1 , workl(invsub), & ldq , ncv , outncv , & workev , ierr) c if (ierr .ne. 0) then info = -9 go to 9000 end if c c %------------------------------------------------% c | Scale the returning eigenvectors so that their | c | Euclidean norms are all one. LAPACK subroutine | c | strevc returns each eigenvector normalized so | c | that the element of largest magnitude has | c | magnitude 1; | c %------------------------------------------------% c iconj = 0 do 40 j=1, nconv c if ( workl(iheigi+j-1) .eq. zero ) then c c %----------------------% c | real eigenvalue case | c %----------------------% c temp = snrm2( ncv, workl(invsub+(j-1)*ldq), 1 ) call sscal( ncv, one / temp, & workl(invsub+(j-1)*ldq), 1 ) c else c c %-------------------------------------------% c | Complex conjugate pair case. Note that | c | since the real and imaginary part of | c | the eigenvector are stored in consecutive | c | columns, we further normalize by the | c | square root of two. | c %-------------------------------------------% c if (iconj .eq. 0) then temp = slapy2(snrm2(ncv, & workl(invsub+(j-1)*ldq), & 1), & snrm2(ncv, & workl(invsub+j*ldq), & 1)) call sscal(ncv, one/temp, & workl(invsub+(j-1)*ldq), 1 ) call sscal(ncv, one/temp, & workl(invsub+j*ldq), 1 ) iconj = 1 else iconj = 0 end if c end if c 40 continue c call sgemv('T', ncv, nconv, one, workl(invsub), & ldq, workl(ihbds), 1, zero, workev, 1) c iconj = 0 do 45 j=1, nconv if (workl(iheigi+j-1) .ne. zero) then c c %-------------------------------------------% c | Complex conjugate pair case. Note that | c | since the real and imaginary part of | c | the eigenvector are stored in consecutive | c %-------------------------------------------% c if (iconj .eq. 0) then workev(j) = slapy2(workev(j), workev(j+1)) workev(j+1) = workev(j) iconj = 1 else iconj = 0 end if end if 45 continue c if (msglvl .gt. 2) then call scopy(ncv, workl(invsub+ncv-1), ldq, & workl(ihbds), 1) call svout(logfil, ncv, workl(ihbds), ndigit, & '_neupd: Last row of the eigenvector matrix for T') if (msglvl .gt. 3) then call smout(logfil, ncv, ncv, workl(invsub), ldq, & ndigit, '_neupd: The eigenvector matrix for T') end if end if c c %---------------------------------------% c | Copy Ritz estimates into workl(ihbds) | c %---------------------------------------% c call scopy(nconv, workev, 1, workl(ihbds), 1) c c %---------------------------------------------------------% c | Compute the QR factorization of the eigenvector matrix | c | associated with leading portion of T in the first NCONV | c | columns of workl(invsub,ldq). | c %---------------------------------------------------------% c call sgeqr2(ncv, nconv , workl(invsub), & ldq, workev, workev(ncv+1), & ierr) c c %----------------------------------------------% c | * Postmultiply Z by Q. | c | * Postmultiply Z by R. | c | The N by NCONV matrix Z is now contains the | c | Ritz vectors associated with the Ritz values | c | in workl(iheigr) and workl(iheigi). | c %----------------------------------------------% c call sorm2r('Right', 'Notranspose', n , & ncv , nconv , workl(invsub), & ldq , workev , z , & ldz , workd(n+1) , ierr) c call strmm('Right' , 'Upper' , 'No transpose', & 'Non-unit', n , nconv , & one , workl(invsub), ldq , & z , ldz) c end if c else c c %------------------------------------------------------% c | An approximate invariant subspace is not needed. | c | Place the Ritz values computed SNAUPD into DR and DI | c %------------------------------------------------------% c call scopy(nconv, workl(ritzr), 1, dr, 1) call scopy(nconv, workl(ritzi), 1, di, 1) call scopy(nconv, workl(ritzr), 1, workl(iheigr), 1) call scopy(nconv, workl(ritzi), 1, workl(iheigi), 1) call scopy(nconv, workl(bounds), 1, workl(ihbds), 1) end if c c %------------------------------------------------% c | Transform the Ritz values and possibly vectors | c | and corresponding error bounds of OP to those | c | of A*x = lambda*B*x. | c %------------------------------------------------% c if (type .eq. 'REGULR') then c if (rvec) & call sscal(ncv, rnorm, workl(ihbds), 1) c else c c %---------------------------------------% c | A spectral transformation was used. | c | * Determine the Ritz estimates of the | c | Ritz values in the original system. | c %---------------------------------------% c if (type .eq. 'SHIFTI') then c if (rvec) & call sscal(ncv, rnorm, workl(ihbds), 1) c do 50 k=1, ncv temp = slapy2( workl(iheigr+k-1), & workl(iheigi+k-1) ) workl(ihbds+k-1) = abs( workl(ihbds+k-1) ) & / temp / temp 50 continue c else if (type .eq. 'REALPT') then c do 60 k=1, ncv 60 continue c else if (type .eq. 'IMAGPT') then c do 70 k=1, ncv 70 continue c end if c c %-----------------------------------------------------------% c | * Transform the Ritz values back to the original system. | c | For TYPE = 'SHIFTI' the transformation is | c | lambda = 1/theta + sigma | c | For TYPE = 'REALPT' or 'IMAGPT' the user must from | c | Rayleigh quotients or a projection. See remark 3 above.| c | NOTES: | c | *The Ritz vectors are not affected by the transformation. | c %-----------------------------------------------------------% c if (type .eq. 'SHIFTI') then c do 80 k=1, ncv temp = slapy2( workl(iheigr+k-1), & workl(iheigi+k-1) ) workl(iheigr+k-1) = workl(iheigr+k-1)/temp/temp & + sigmar workl(iheigi+k-1) = -workl(iheigi+k-1)/temp/temp & + sigmai 80 continue c call scopy(nconv, workl(iheigr), 1, dr, 1) call scopy(nconv, workl(iheigi), 1, di, 1) c else if (type .eq. 'REALPT' .or. type .eq. 'IMAGPT') then c call scopy(nconv, workl(iheigr), 1, dr, 1) call scopy(nconv, workl(iheigi), 1, di, 1) c end if c end if c if (type .eq. 'SHIFTI' .and. msglvl .gt. 1) then call svout(logfil, nconv, dr, ndigit, & '_neupd: Untransformed real part of the Ritz valuess.') call svout (logfil, nconv, di, ndigit, & '_neupd: Untransformed imag part of the Ritz valuess.') call svout(logfil, nconv, workl(ihbds), ndigit, & '_neupd: Ritz estimates of untransformed Ritz values.') else if (type .eq. 'REGULR' .and. msglvl .gt. 1) then call svout(logfil, nconv, dr, ndigit, & '_neupd: Real parts of converged Ritz values.') call svout (logfil, nconv, di, ndigit, & '_neupd: Imag parts of converged Ritz values.') call svout(logfil, nconv, workl(ihbds), ndigit, & '_neupd: Associated Ritz estimates.') end if c c %-------------------------------------------------% c | Eigenvector Purification step. Formally perform | c | one of inverse subspace iteration. Only used | c | for MODE = 2. | c %-------------------------------------------------% c if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then c c %------------------------------------------------% c | Purify the computed Ritz vectors by adding a | c | little bit of the residual vector: | c | T | c | resid(:)*( e s ) / theta | c | NCV | c | where H s = s theta. Remember that when theta | c | has nonzero imaginary part, the corresponding | c | Ritz vector is stored across two columns of Z. | c %------------------------------------------------% c iconj = 0 do 110 j=1, nconv if (workl(iheigi+j-1) .eq. zero) then workev(j) = workl(invsub+(j-1)*ldq+ncv-1) / & workl(iheigr+j-1) else if (iconj .eq. 0) then temp = slapy2( workl(iheigr+j-1), workl(iheigi+j-1) ) workev(j) = ( workl(invsub+(j-1)*ldq+ncv-1) * & workl(iheigr+j-1) + & workl(invsub+j*ldq+ncv-1) * & workl(iheigi+j-1) ) / temp / temp workev(j+1) = ( workl(invsub+j*ldq+ncv-1) * & workl(iheigr+j-1) - & workl(invsub+(j-1)*ldq+ncv-1) * & workl(iheigi+j-1) ) / temp / temp iconj = 1 else iconj = 0 end if 110 continue c c %---------------------------------------% c | Perform a rank one update to Z and | c | purify all the Ritz vectors together. | c %---------------------------------------% c call sger(n, nconv, one, resid, 1, workev, 1, z, ldz) c end if c 9000 continue c return c c %---------------% c | End of SNEUPD | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/zneigh.f000644 001750 001750 00000020070 11266605602 022100 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: zneigh c c\Description: c Compute the eigenvalues of the current upper Hessenberg matrix c and the corresponding Ritz estimates given the current residual norm. c c\Usage: c call zneigh c ( RNORM, N, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL, RWORK, IERR ) c c\Arguments c RNORM Double precision scalar. (INPUT) c Residual norm corresponding to the current upper Hessenberg c matrix H. c c N Integer. (INPUT) c Size of the matrix H. c c H Complex*16 N by N array. (INPUT) c H contains the current upper Hessenberg matrix. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RITZ Complex*16 array of length N. (OUTPUT) c On output, RITZ(1:N) contains the eigenvalues of H. c c BOUNDS Complex*16 array of length N. (OUTPUT) c On output, BOUNDS contains the Ritz estimates associated with c the eigenvalues held in RITZ. This is equal to RNORM c times the last components of the eigenvectors corresponding c to the eigenvalues in RITZ. c c Q Complex*16 N by N array. (WORKSPACE) c Workspace needed to store the eigenvectors of H. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKL Complex*16 work array of length N**2 + 3*N. (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. This is needed to keep the full Schur form c of H and also in the calculation of the eigenvectors of H. c c RWORK Double precision work array of length N (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. c c IERR Integer. (OUTPUT) c Error exit flag from zlahqr or ztrevc. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx Complex*16 c c\Routines called: c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c zmout ARPACK utility routine that prints matrices c zvout ARPACK utility routine that prints vectors. c dvout ARPACK utility routine that prints vectors. c zlacpy LAPACK matrix copy routine. c zlahqr LAPACK routine to compute the Schur form of an c upper Hessenberg matrix. c zlaset LAPACK matrix initialization routine. c ztrevc LAPACK routine to compute the eigenvectors of a matrix c in upper triangular form c zcopy Level 1 BLAS that copies one vector to another. c zdscal Level 1 BLAS that scales a complex vector by a real number. c dznrm2 Level 1 BLAS that computes the norm of a vector. c c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: neigh.F SID: 2.2 DATE OF SID: 4/20/96 RELEASE: 2 c c\Remarks c None c c\EndLib c c----------------------------------------------------------------------- c subroutine zneigh (rnorm, n, h, ldh, ritz, bounds, & q, ldq, workl, rwork, ierr) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer ierr, n, ldh, ldq Double precision & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c Complex*16 & bounds(n), h(ldh,n), q(ldq,n), ritz(n), & workl(n*(n+3)) Double precision & rwork(n) c c %------------% c | Parameters | c %------------% c Complex*16 & one, zero Double precision & rone parameter (one = (1.0D+0, 0.0D+0), zero = (0.0D+0, 0.0D+0), & rone = 1.0D+0) c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c logical select(1) integer j, msglvl Complex*16 & vl(1) Double precision & temp c c %----------------------% c | External Subroutines | c %----------------------% c external zlacpy, zlahqr, ztrevc, zcopy, & zdscal, zmout, zvout, second c c %--------------------% c | External Functions | c %--------------------% c Double precision & dznrm2 external dznrm2 c c %-----------------------% c | Executable Statements | c %-----------------------% c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mceigh c if (msglvl .gt. 2) then call zmout (logfil, n, n, h, ldh, ndigit, & '_neigh: Entering upper Hessenberg matrix H ') end if c c %----------------------------------------------------------% c | 1. Compute the eigenvalues, the last components of the | c | corresponding Schur vectors and the full Schur form T | c | of the current upper Hessenberg matrix H. | c | zlahqr returns the full Schur form of H | c | in WORKL(1:N**2), and the Schur vectors in q. | c %----------------------------------------------------------% c call zlacpy ('All', n, n, h, ldh, workl, n) call zlaset ('All', n, n, zero, one, q, ldq) call zlahqr (.true., .true., n, 1, n, workl, ldh, ritz, & 1, n, q, ldq, ierr) if (ierr .ne. 0) go to 9000 c call zcopy (n, q(n-1,1), ldq, bounds, 1) if (msglvl .gt. 1) then call zvout (logfil, n, bounds, ndigit, & '_neigh: last row of the Schur matrix for H') end if c c %----------------------------------------------------------% c | 2. Compute the eigenvectors of the full Schur form T and | c | apply the Schur vectors to get the corresponding | c | eigenvectors. | c %----------------------------------------------------------% c call ztrevc ('Right', 'Back', select, n, workl, n, vl, n, q, & ldq, n, n, workl(n*n+1), rwork, ierr) c if (ierr .ne. 0) go to 9000 c c %------------------------------------------------% c | Scale the returning eigenvectors so that their | c | Euclidean norms are all one. LAPACK subroutine | c | ztrevc returns each eigenvector normalized so | c | that the element of largest magnitude has | c | magnitude 1; here the magnitude of a complex | c | number (x,y) is taken to be |x| + |y|. | c %------------------------------------------------% c do 10 j=1, n temp = dznrm2( n, q(1,j), 1 ) call zdscal ( n, rone / temp, q(1,j), 1 ) 10 continue c if (msglvl .gt. 1) then call zcopy(n, q(n,1), ldq, workl, 1) call zvout (logfil, n, workl, ndigit, & '_neigh: Last row of the eigenvector matrix for H') end if c c %----------------------------% c | Compute the Ritz estimates | c %----------------------------% c call zcopy(n, q(n,1), n, bounds, 1) call zdscal(n, rnorm, bounds, 1) c if (msglvl .gt. 2) then call zvout (logfil, n, ritz, ndigit, & '_neigh: The eigenvalues of H') call zvout (logfil, n, bounds, ndigit, & '_neigh: Ritz estimates for the eigenvalues of H') end if c call second(t1) tceigh = tceigh + (t1 - t0) c 9000 continue return c c %---------------% c | End of zneigh | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/cnapps.f000644 001750 001750 00000042206 11266605602 022105 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: cnapps c c\Description: c Given the Arnoldi factorization c c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T, c c apply NP implicit shifts resulting in c c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q c c where Q is an orthogonal matrix which is the product of rotations c and reflections resulting from the NP bulge change sweeps. c The updated Arnoldi factorization becomes: c c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T. c c\Usage: c call cnapps c ( N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ, c WORKL, WORKD ) c c\Arguments c N Integer. (INPUT) c Problem size, i.e. size of matrix A. c c KEV Integer. (INPUT/OUTPUT) c KEV+NP is the size of the input matrix H. c KEV is the size of the updated matrix HNEW. c c NP Integer. (INPUT) c Number of implicit shifts to be applied. c c SHIFT Complex array of length NP. (INPUT) c The shifts to be applied. c c V Complex N by (KEV+NP) array. (INPUT/OUTPUT) c On INPUT, V contains the current KEV+NP Arnoldi vectors. c On OUTPUT, V contains the updated KEV Arnoldi vectors c in the first KEV columns of V. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Complex (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT) c On INPUT, H contains the current KEV+NP by KEV+NP upper c Hessenberg matrix of the Arnoldi factorization. c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg c matrix in the KEV leading submatrix. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RESID Complex array of length N. (INPUT/OUTPUT) c On INPUT, RESID contains the the residual vector r_{k+p}. c On OUTPUT, RESID is the update residual vector rnew_{k} c in the first KEV locations. c c Q Complex KEV+NP by KEV+NP work array. (WORKSPACE) c Work array used to accumulate the rotations and reflections c during the bulge chase sweep. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKL Complex work array of length (KEV+NP). (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. c c WORKD Complex work array of length 2*N. (WORKSPACE) c Distributed array used in the application of the accumulated c orthogonal matrix Q. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx Complex c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c c\Routines called: c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c cmout ARPACK utility routine that prints matrices c cvout ARPACK utility routine that prints vectors. c clacpy LAPACK matrix copy routine. c clanhs LAPACK routine that computes various norms of a matrix. c clartg LAPACK Givens rotation construction routine. c claset LAPACK matrix initialization routine. c slabad LAPACK routine for defining the underflow and overflow c limits. c slamch LAPACK routine that determines machine constants. c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c cgemv Level 2 BLAS routine for matrix vector multiplication. c caxpy Level 1 BLAS that computes a vector triad. c ccopy Level 1 BLAS that copies one vector to another. c cscal Level 1 BLAS that scales a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: napps.F SID: 2.3 DATE OF SID: 3/28/97 RELEASE: 2 c c\Remarks c 1. In this version, each shift is applied to all the sublocks of c the Hessenberg matrix H and not just to the submatrix that it c comes from. Deflation as in LAPACK routine clahqr (QR algorithm c for upper Hessenberg matrices ) is used. c Upon output, the subdiagonals of H are enforced to be non-negative c real numbers. c c\EndLib c c----------------------------------------------------------------------- c subroutine cnapps & ( n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq, & workl, workd ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer kev, ldh, ldq, ldv, n, np c c %-----------------% c | Array Arguments | c %-----------------% c Complex & h(ldh,kev+np), resid(n), shift(np), & v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np) c c %------------% c | Parameters | c %------------% c Complex & one, zero Real & rzero parameter (one = (1.0E+0, 0.0E+0), zero = (0.0E+0, 0.0E+0), & rzero = 0.0E+0) c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c integer i, iend, istart, j, jj, kplusp, msglvl logical first Complex & cdum, f, g, h11, h21, r, s, sigma, t Real & c, ovfl, smlnum, ulp, unfl, tst1 save first, ovfl, smlnum, ulp, unfl c c %----------------------% c | External Subroutines | c %----------------------% c external caxpy, ccopy, cgemv, cscal, clacpy, clartg, & cvout, claset, slabad, cmout, second, ivout c c %--------------------% c | External Functions | c %--------------------% c Real & clanhs, slamch, slapy2 external clanhs, slamch, slapy2 c c %----------------------% c | Intrinsics Functions | c %----------------------% c intrinsic abs, aimag, conjg, cmplx, max, min, real c c %---------------------% c | Statement Functions | c %---------------------% c Real & cabs1 cabs1( cdum ) = abs( real( cdum ) ) + abs( aimag( cdum ) ) c c %----------------% c | Data statments | c %----------------% c data first / .true. / c c %-----------------------% c | Executable Statements | c %-----------------------% c if (first) then c c %-----------------------------------------------% c | Set machine-dependent constants for the | c | stopping criterion. If norm(H) <= sqrt(OVFL), | c | overflow should not occur. | c | REFERENCE: LAPACK subroutine clahqr | c %-----------------------------------------------% c unfl = slamch( 'safe minimum' ) ovfl = real(one / unfl) call slabad( unfl, ovfl ) ulp = slamch( 'precision' ) smlnum = unfl*( n / ulp ) first = .false. end if c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mcapps c kplusp = kev + np c c %--------------------------------------------% c | Initialize Q to the identity to accumulate | c | the rotations and reflections | c %--------------------------------------------% c call claset ('All', kplusp, kplusp, zero, one, q, ldq) c c %----------------------------------------------% c | Quick return if there are no shifts to apply | c %----------------------------------------------% c if (np .eq. 0) go to 9000 c c %----------------------------------------------% c | Chase the bulge with the application of each | c | implicit shift. Each shift is applied to the | c | whole matrix including each block. | c %----------------------------------------------% c do 110 jj = 1, np sigma = shift(jj) c if (msglvl .gt. 2 ) then call ivout (logfil, 1, jj, ndigit, & '_napps: shift number.') call cvout (logfil, 1, sigma, ndigit, & '_napps: Value of the shift ') end if c istart = 1 20 continue c do 30 i = istart, kplusp-1 c c %----------------------------------------% c | Check for splitting and deflation. Use | c | a standard test as in the QR algorithm | c | REFERENCE: LAPACK subroutine clahqr | c %----------------------------------------% c tst1 = cabs1( h( i, i ) ) + cabs1( h( i+1, i+1 ) ) if( tst1.eq.rzero ) & tst1 = clanhs( '1', kplusp-jj+1, h, ldh, workl ) if ( abs(real(h(i+1,i))) & .le. max(ulp*tst1, smlnum) ) then if (msglvl .gt. 0) then call ivout (logfil, 1, i, ndigit, & '_napps: matrix splitting at row/column no.') call ivout (logfil, 1, jj, ndigit, & '_napps: matrix splitting with shift number.') call cvout (logfil, 1, h(i+1,i), ndigit, & '_napps: off diagonal element.') end if iend = i h(i+1,i) = zero go to 40 end if 30 continue iend = kplusp 40 continue c if (msglvl .gt. 2) then call ivout (logfil, 1, istart, ndigit, & '_napps: Start of current block ') call ivout (logfil, 1, iend, ndigit, & '_napps: End of current block ') end if c c %------------------------------------------------% c | No reason to apply a shift to block of order 1 | c | or if the current block starts after the point | c | of compression since we'll discard this stuff | c %------------------------------------------------% c if ( istart .eq. iend .or. istart .gt. kev) go to 100 c h11 = h(istart,istart) h21 = h(istart+1,istart) f = h11 - sigma g = h21 c do 80 i = istart, iend-1 c c %------------------------------------------------------% c | Construct the plane rotation G to zero out the bulge | c %------------------------------------------------------% c call clartg (f, g, c, s, r) if (i .gt. istart) then h(i,i-1) = r h(i+1,i-1) = zero end if c c %---------------------------------------------% c | Apply rotation to the left of H; H <- G'*H | c %---------------------------------------------% c do 50 j = i, kplusp t = c*h(i,j) + s*h(i+1,j) h(i+1,j) = -conjg(s)*h(i,j) + c*h(i+1,j) h(i,j) = t 50 continue c c %---------------------------------------------% c | Apply rotation to the right of H; H <- H*G | c %---------------------------------------------% c do 60 j = 1, min(i+2,iend) t = c*h(j,i) + conjg(s)*h(j,i+1) h(j,i+1) = -s*h(j,i) + c*h(j,i+1) h(j,i) = t 60 continue c c %-----------------------------------------------------% c | Accumulate the rotation in the matrix Q; Q <- Q*G' | c %-----------------------------------------------------% c do 70 j = 1, min(i+jj, kplusp) t = c*q(j,i) + conjg(s)*q(j,i+1) q(j,i+1) = - s*q(j,i) + c*q(j,i+1) q(j,i) = t 70 continue c c %---------------------------% c | Prepare for next rotation | c %---------------------------% c if (i .lt. iend-1) then f = h(i+1,i) g = h(i+2,i) end if 80 continue c c %-------------------------------% c | Finished applying the shift. | c %-------------------------------% c 100 continue c c %---------------------------------------------------------% c | Apply the same shift to the next block if there is any. | c %---------------------------------------------------------% c istart = iend + 1 if (iend .lt. kplusp) go to 20 c c %---------------------------------------------% c | Loop back to the top to get the next shift. | c %---------------------------------------------% c 110 continue c c %---------------------------------------------------% c | Perform a similarity transformation that makes | c | sure that the compressed H will have non-negative | c | real subdiagonal elements. | c %---------------------------------------------------% c do 120 j=1,kev if ( real( h(j+1,j) ) .lt. rzero .or. & aimag( h(j+1,j) ) .ne. rzero ) then t = h(j+1,j) / slapy2(real(h(j+1,j)),aimag(h(j+1,j))) call cscal( kplusp-j+1, conjg(t), h(j+1,j), ldh ) call cscal( min(j+2, kplusp), t, h(1,j+1), 1 ) call cscal( min(j+np+1,kplusp), t, q(1,j+1), 1 ) h(j+1,j) = cmplx( real( h(j+1,j) ), rzero ) end if 120 continue c do 130 i = 1, kev c c %--------------------------------------------% c | Final check for splitting and deflation. | c | Use a standard test as in the QR algorithm | c | REFERENCE: LAPACK subroutine clahqr. | c | Note: Since the subdiagonals of the | c | compressed H are nonnegative real numbers, | c | we take advantage of this. | c %--------------------------------------------% c tst1 = cabs1( h( i, i ) ) + cabs1( h( i+1, i+1 ) ) if( tst1 .eq. rzero ) & tst1 = clanhs( '1', kev, h, ldh, workl ) if( real( h( i+1,i ) ) .le. max( ulp*tst1, smlnum ) ) & h(i+1,i) = zero 130 continue c c %-------------------------------------------------% c | Compute the (kev+1)-st column of (V*Q) and | c | temporarily store the result in WORKD(N+1:2*N). | c | This is needed in the residual update since we | c | cannot GUARANTEE that the corresponding entry | c | of H would be zero as in exact arithmetic. | c %-------------------------------------------------% c if ( real( h(kev+1,kev) ) .gt. rzero ) & call cgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero, & workd(n+1), 1) c c %----------------------------------------------------------% c | Compute column 1 to kev of (V*Q) in backward order | c | taking advantage of the upper Hessenberg structure of Q. | c %----------------------------------------------------------% c do 140 i = 1, kev call cgemv ('N', n, kplusp-i+1, one, v, ldv, & q(1,kev-i+1), 1, zero, workd, 1) call ccopy (n, workd, 1, v(1,kplusp-i+1), 1) 140 continue c c %-------------------------------------------------% c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). | c %-------------------------------------------------% c call clacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv) c c %--------------------------------------------------------------% c | Copy the (kev+1)-st column of (V*Q) in the appropriate place | c %--------------------------------------------------------------% c if ( real( h(kev+1,kev) ) .gt. rzero ) & call ccopy (n, workd(n+1), 1, v(1,kev+1), 1) c c %-------------------------------------% c | Update the residual vector: | c | r <- sigmak*r + betak*v(:,kev+1) | c | where | c | sigmak = (e_{kev+p}'*Q)*e_{kev} | c | betak = e_{kev+1}'*H*e_{kev} | c %-------------------------------------% c call cscal (n, q(kplusp,kev), resid, 1) if ( real( h(kev+1,kev) ) .gt. rzero ) & call caxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1) c if (msglvl .gt. 1) then call cvout (logfil, 1, q(kplusp,kev), ndigit, & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}') call cvout (logfil, 1, h(kev+1,kev), ndigit, & '_napps: betak = e_{kev+1}^T*H*e_{kev}') call ivout (logfil, 1, kev, ndigit, & '_napps: Order of the final Hessenberg matrix ') if (msglvl .gt. 2) then call cmout (logfil, kev, kev, h, ldh, ndigit, & '_napps: updated Hessenberg matrix H for next iteration') end if c end if c 9000 continue call second (t1) tcapps = tcapps + (t1 - t0) c return c c %---------------% c | End of cnapps | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/zsortc.f000644 001750 001750 00000017660 11266605602 022153 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: zsortc c c\Description: c Sorts the Complex*16 array in X into the order c specified by WHICH and optionally applies the permutation to the c Double precision array Y. c c\Usage: c call zsortc c ( WHICH, APPLY, N, X, Y ) c c\Arguments c WHICH Character*2. (Input) c 'LM' -> sort X into increasing order of magnitude. c 'SM' -> sort X into decreasing order of magnitude. c 'LR' -> sort X with real(X) in increasing algebraic order c 'SR' -> sort X with real(X) in decreasing algebraic order c 'LI' -> sort X with imag(X) in increasing algebraic order c 'SI' -> sort X with imag(X) in decreasing algebraic order c c APPLY Logical. (Input) c APPLY = .TRUE. -> apply the sorted order to array Y. c APPLY = .FALSE. -> do not apply the sorted order to array Y. c c N Integer. (INPUT) c Size of the arrays. c c X Complex*16 array of length N. (INPUT/OUTPUT) c This is the array to be sorted. c c Y Complex*16 array of length N. (INPUT/OUTPUT) c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Routines called: c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c Adapted from the sort routine in LANSO. c c\SCCS Information: @(#) c FILE: sortc.F SID: 2.2 DATE OF SID: 4/20/96 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine zsortc (which, apply, n, x, y) c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which logical apply integer n c c %-----------------% c | Array Arguments | c %-----------------% c Complex*16 & x(0:n-1), y(0:n-1) c c %---------------% c | Local Scalars | c %---------------% c integer i, igap, j Complex*16 & temp Double precision & temp1, temp2 c c %--------------------% c | External functions | c %--------------------% c Double precision & dlapy2 c c %--------------------% c | Intrinsic Functions | c %--------------------% Intrinsic & dble, dimag c c %-----------------------% c | Executable Statements | c %-----------------------% c igap = n / 2 c if (which .eq. 'LM') then c c %--------------------------------------------% c | Sort X into increasing order of magnitude. | c %--------------------------------------------% c 10 continue if (igap .eq. 0) go to 9000 c do 30 i = igap, n-1 j = i-igap 20 continue c if (j.lt.0) go to 30 c temp1 = dlapy2(dble(x(j)),dimag(x(j))) temp2 = dlapy2(dble(x(j+igap)),dimag(x(j+igap))) c if (temp1.gt.temp2) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 30 end if j = j-igap go to 20 30 continue igap = igap / 2 go to 10 c else if (which .eq. 'SM') then c c %--------------------------------------------% c | Sort X into decreasing order of magnitude. | c %--------------------------------------------% c 40 continue if (igap .eq. 0) go to 9000 c do 60 i = igap, n-1 j = i-igap 50 continue c if (j .lt. 0) go to 60 c temp1 = dlapy2(dble(x(j)),dimag(x(j))) temp2 = dlapy2(dble(x(j+igap)),dimag(x(j+igap))) c if (temp1.lt.temp2) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 60 endif j = j-igap go to 50 60 continue igap = igap / 2 go to 40 c else if (which .eq. 'LR') then c c %------------------------------------------------% c | Sort XREAL into increasing order of algebraic. | c %------------------------------------------------% c 70 continue if (igap .eq. 0) go to 9000 c do 90 i = igap, n-1 j = i-igap 80 continue c if (j.lt.0) go to 90 c if (dble(x(j)).gt.dble(x(j+igap))) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 90 endif j = j-igap go to 80 90 continue igap = igap / 2 go to 70 c else if (which .eq. 'SR') then c c %------------------------------------------------% c | Sort XREAL into decreasing order of algebraic. | c %------------------------------------------------% c 100 continue if (igap .eq. 0) go to 9000 do 120 i = igap, n-1 j = i-igap 110 continue c if (j.lt.0) go to 120 c if (dble(x(j)).lt.dble(x(j+igap))) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 120 endif j = j-igap go to 110 120 continue igap = igap / 2 go to 100 c else if (which .eq. 'LI') then c c %--------------------------------------------% c | Sort XIMAG into increasing algebraic order | c %--------------------------------------------% c 130 continue if (igap .eq. 0) go to 9000 do 150 i = igap, n-1 j = i-igap 140 continue c if (j.lt.0) go to 150 c if (dimag(x(j)).gt.dimag(x(j+igap))) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 150 endif j = j-igap go to 140 150 continue igap = igap / 2 go to 130 c else if (which .eq. 'SI') then c c %---------------------------------------------% c | Sort XIMAG into decreasing algebraic order | c %---------------------------------------------% c 160 continue if (igap .eq. 0) go to 9000 do 180 i = igap, n-1 j = i-igap 170 continue c if (j.lt.0) go to 180 c if (dimag(x(j)).lt.dimag(x(j+igap))) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 180 endif j = j-igap go to 170 180 continue igap = igap / 2 go to 160 end if c 9000 continue return c c %---------------% c | End of zsortc | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/svout.f000644 001750 001750 00000007144 11266605602 022003 0ustar00geuzainegeuzaine000000 000000 *----------------------------------------------------------------------- * Routine: SVOUT * * Purpose: Real vector output routine. * * Usage: CALL SVOUT (LOUT, N, SX, IDIGIT, IFMT) * * Arguments * N - Length of array SX. (Input) * SX - Real array to be printed. (Input) * IFMT - Format to be used in printing array SX. (Input) * IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In) * If IDIGIT .LT. 0, printing is done with 72 columns. * If IDIGIT .GT. 0, printing is done with 132 columns. * *----------------------------------------------------------------------- * SUBROUTINE SVOUT( LOUT, N, SX, IDIGIT, IFMT ) * ... * ... SPECIFICATIONS FOR ARGUMENTS INTEGER N, IDIGIT, LOUT REAL SX( * ) CHARACTER IFMT*( * ) * ... * ... SPECIFICATIONS FOR LOCAL VARIABLES INTEGER I, NDIGIT, K1, K2, LLL CHARACTER*80 LINE * ... * ... FIRST EXECUTABLE STATEMENT * * LLL = MIN( LEN( IFMT ), 80 ) DO 10 I = 1, LLL LINE( I: I ) = '-' 10 CONTINUE * DO 20 I = LLL + 1, 80 LINE( I: I ) = ' ' 20 CONTINUE * WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL ) 9999 FORMAT( / 1X, A / 1X, A ) * IF( N.LE.0 ) $ RETURN NDIGIT = IDIGIT IF( IDIGIT.EQ.0 ) $ NDIGIT = 4 * *======================================================================= * CODE FOR OUTPUT USING 72 COLUMNS FORMAT *======================================================================= * IF( IDIGIT.LT.0 ) THEN NDIGIT = -IDIGIT IF( NDIGIT.LE.4 ) THEN DO 30 K1 = 1, N, 5 K2 = MIN0( N, K1+4 ) WRITE( LOUT, 9998 )K1, K2, ( SX( I ), I = K1, K2 ) 30 CONTINUE ELSE IF( NDIGIT.LE.6 ) THEN DO 40 K1 = 1, N, 4 K2 = MIN0( N, K1+3 ) WRITE( LOUT, 9997 )K1, K2, ( SX( I ), I = K1, K2 ) 40 CONTINUE ELSE IF( NDIGIT.LE.10 ) THEN DO 50 K1 = 1, N, 3 K2 = MIN0( N, K1+2 ) WRITE( LOUT, 9996 )K1, K2, ( SX( I ), I = K1, K2 ) 50 CONTINUE ELSE DO 60 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) WRITE( LOUT, 9995 )K1, K2, ( SX( I ), I = K1, K2 ) 60 CONTINUE END IF * *======================================================================= * CODE FOR OUTPUT USING 132 COLUMNS FORMAT *======================================================================= * ELSE IF( NDIGIT.LE.4 ) THEN DO 70 K1 = 1, N, 10 K2 = MIN0( N, K1+9 ) WRITE( LOUT, 9998 )K1, K2, ( SX( I ), I = K1, K2 ) 70 CONTINUE ELSE IF( NDIGIT.LE.6 ) THEN DO 80 K1 = 1, N, 8 K2 = MIN0( N, K1+7 ) WRITE( LOUT, 9997 )K1, K2, ( SX( I ), I = K1, K2 ) 80 CONTINUE ELSE IF( NDIGIT.LE.10 ) THEN DO 90 K1 = 1, N, 6 K2 = MIN0( N, K1+5 ) WRITE( LOUT, 9996 )K1, K2, ( SX( I ), I = K1, K2 ) 90 CONTINUE ELSE DO 100 K1 = 1, N, 5 K2 = MIN0( N, K1+4 ) WRITE( LOUT, 9995 )K1, K2, ( SX( I ), I = K1, K2 ) 100 CONTINUE END IF END IF WRITE( LOUT, 9994 ) RETURN 9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P10E12.3 ) 9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P8E14.5 ) 9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P6E18.9 ) 9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P5E24.13 ) 9994 FORMAT( 1X, ' ' ) END getdp-2.7.0-source/contrib/Arpack/dsapps.f000644 001750 001750 00000044122 11266605602 022112 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: dsapps c c\Description: c Given the Arnoldi factorization c c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T, c c apply NP shifts implicitly resulting in c c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q c c where Q is an orthogonal matrix of order KEV+NP. Q is the product of c rotations resulting from the NP bulge chasing sweeps. The updated Arnoldi c factorization becomes: c c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T. c c\Usage: c call dsapps c ( N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ, WORKD ) c c\Arguments c N Integer. (INPUT) c Problem size, i.e. dimension of matrix A. c c KEV Integer. (INPUT) c INPUT: KEV+NP is the size of the input matrix H. c OUTPUT: KEV is the size of the updated matrix HNEW. c c NP Integer. (INPUT) c Number of implicit shifts to be applied. c c SHIFT Double precision array of length NP. (INPUT) c The shifts to be applied. c c V Double precision N by (KEV+NP) array. (INPUT/OUTPUT) c INPUT: V contains the current KEV+NP Arnoldi vectors. c OUTPUT: VNEW = V(1:n,1:KEV); the updated Arnoldi vectors c are in the first KEV columns of V. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Double precision (KEV+NP) by 2 array. (INPUT/OUTPUT) c INPUT: H contains the symmetric tridiagonal matrix of the c Arnoldi factorization with the subdiagonal in the 1st column c starting at H(2,1) and the main diagonal in the 2nd column. c OUTPUT: H contains the updated tridiagonal matrix in the c KEV leading submatrix. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RESID Double precision array of length (N). (INPUT/OUTPUT) c INPUT: RESID contains the the residual vector r_{k+p}. c OUTPUT: RESID is the updated residual vector rnew_{k}. c c Q Double precision KEV+NP by KEV+NP work array. (WORKSPACE) c Work array used to accumulate the rotations during the bulge c chase sweep. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKD Double precision work array of length 2*N. (WORKSPACE) c Distributed array used in the application of the accumulated c orthogonal matrix Q. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c dvout ARPACK utility routine that prints vectors. c dlamch LAPACK routine that determines machine constants. c dlartg LAPACK Givens rotation construction routine. c dlacpy LAPACK matrix copy routine. c dlaset LAPACK matrix initialization routine. c dgemv Level 2 BLAS routine for matrix vector multiplication. c daxpy Level 1 BLAS that computes a vector triad. c dcopy Level 1 BLAS that copies one vector to another. c dscal Level 1 BLAS that scales a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/16/93: Version ' 2.4' c c\SCCS Information: @(#) c FILE: sapps.F SID: 2.6 DATE OF SID: 3/28/97 RELEASE: 2 c c\Remarks c 1. In this version, each shift is applied to all the subblocks of c the tridiagonal matrix H and not just to the submatrix that it c comes from. This routine assumes that the subdiagonal elements c of H that are stored in h(1:kev+np,1) are nonegative upon input c and enforce this condition upon output. This version incorporates c deflation. See code for documentation. c c\EndLib c c----------------------------------------------------------------------- c subroutine dsapps & ( n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq, workd ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer kev, ldh, ldq, ldv, n, np c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & h(ldh,2), q(ldq,kev+np), resid(n), shift(np), & v(ldv,kev+np), workd(2*n) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c integer i, iend, istart, itop, j, jj, kplusp, msglvl logical first Double precision & a1, a2, a3, a4, big, c, epsmch, f, g, r, s save epsmch, first c c c %----------------------% c | External Subroutines | c %----------------------% c external daxpy, dcopy, dscal, dlacpy, dlartg, dlaset, dvout, & ivout, second, dgemv c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlamch external dlamch c c %----------------------% c | Intrinsics Functions | c %----------------------% c intrinsic abs c c %----------------% c | Data statments | c %----------------% c data first / .true. / c c %-----------------------% c | Executable Statements | c %-----------------------% c if (first) then epsmch = dlamch('Epsilon-Machine') first = .false. end if itop = 1 c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = msapps c kplusp = kev + np c c %----------------------------------------------% c | Initialize Q to the identity matrix of order | c | kplusp used to accumulate the rotations. | c %----------------------------------------------% c call dlaset ('All', kplusp, kplusp, zero, one, q, ldq) c c %----------------------------------------------% c | Quick return if there are no shifts to apply | c %----------------------------------------------% c if (np .eq. 0) go to 9000 c c %----------------------------------------------------------% c | Apply the np shifts implicitly. Apply each shift to the | c | whole matrix and not just to the submatrix from which it | c | comes. | c %----------------------------------------------------------% c do 90 jj = 1, np c istart = itop c c %----------------------------------------------------------% c | Check for splitting and deflation. Currently we consider | c | an off-diagonal element h(i+1,1) negligible if | c | h(i+1,1) .le. epsmch*( |h(i,2)| + |h(i+1,2)| ) | c | for i=1:KEV+NP-1. | c | If above condition tests true then we set h(i+1,1) = 0. | c | Note that h(1:KEV+NP,1) are assumed to be non negative. | c %----------------------------------------------------------% c 20 continue c c %------------------------------------------------% c | The following loop exits early if we encounter | c | a negligible off diagonal element. | c %------------------------------------------------% c do 30 i = istart, kplusp-1 big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then call ivout (logfil, 1, i, ndigit, & '_sapps: deflation at row/column no.') call ivout (logfil, 1, jj, ndigit, & '_sapps: occured before shift number.') call dvout (logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') end if h(i+1,1) = zero iend = i go to 40 end if 30 continue iend = kplusp 40 continue c if (istart .lt. iend) then c c %--------------------------------------------------------% c | Construct the plane rotation G'(istart,istart+1,theta) | c | that attempts to drive h(istart+1,1) to zero. | c %--------------------------------------------------------% c f = h(istart,2) - shift(jj) g = h(istart+1,1) call dlartg (f, g, c, s, r) c c %-------------------------------------------------------% c | Apply rotation to the left and right of H; | c | H <- G' * H * G, where G = G(istart,istart+1,theta). | c | This will create a "bulge". | c %-------------------------------------------------------% c a1 = c*h(istart,2) + s*h(istart+1,1) a2 = c*h(istart+1,1) + s*h(istart+1,2) a4 = c*h(istart+1,2) - s*h(istart+1,1) a3 = c*h(istart+1,1) - s*h(istart,2) h(istart,2) = c*a1 + s*a2 h(istart+1,2) = c*a4 - s*a3 h(istart+1,1) = c*a3 + s*a4 c c %----------------------------------------------------% c | Accumulate the rotation in the matrix Q; Q <- Q*G | c %----------------------------------------------------% c do 60 j = 1, min(istart+jj,kplusp) a1 = c*q(j,istart) + s*q(j,istart+1) q(j,istart+1) = - s*q(j,istart) + c*q(j,istart+1) q(j,istart) = a1 60 continue c c c %----------------------------------------------% c | The following loop chases the bulge created. | c | Note that the previous rotation may also be | c | done within the following loop. But it is | c | kept separate to make the distinction among | c | the bulge chasing sweeps and the first plane | c | rotation designed to drive h(istart+1,1) to | c | zero. | c %----------------------------------------------% c do 70 i = istart+1, iend-1 c c %----------------------------------------------% c | Construct the plane rotation G'(i,i+1,theta) | c | that zeros the i-th bulge that was created | c | by G(i-1,i,theta). g represents the bulge. | c %----------------------------------------------% c f = h(i,1) g = s*h(i+1,1) c c %----------------------------------% c | Final update with G(i-1,i,theta) | c %----------------------------------% c h(i+1,1) = c*h(i+1,1) call dlartg (f, g, c, s, r) c c %-------------------------------------------% c | The following ensures that h(1:iend-1,1), | c | the first iend-2 off diagonal of elements | c | H, remain non negative. | c %-------------------------------------------% c if (r .lt. zero) then r = -r c = -c s = -s end if c c %--------------------------------------------% c | Apply rotation to the left and right of H; | c | H <- G * H * G', where G = G(i,i+1,theta) | c %--------------------------------------------% c h(i,1) = r c a1 = c*h(i,2) + s*h(i+1,1) a2 = c*h(i+1,1) + s*h(i+1,2) a3 = c*h(i+1,1) - s*h(i,2) a4 = c*h(i+1,2) - s*h(i+1,1) c h(i,2) = c*a1 + s*a2 h(i+1,2) = c*a4 - s*a3 h(i+1,1) = c*a3 + s*a4 c c %----------------------------------------------------% c | Accumulate the rotation in the matrix Q; Q <- Q*G | c %----------------------------------------------------% c do 50 j = 1, min( i+jj, kplusp ) a1 = c*q(j,i) + s*q(j,i+1) q(j,i+1) = - s*q(j,i) + c*q(j,i+1) q(j,i) = a1 50 continue c 70 continue c end if c c %--------------------------% c | Update the block pointer | c %--------------------------% c istart = iend + 1 c c %------------------------------------------% c | Make sure that h(iend,1) is non-negative | c | If not then set h(iend,1) <-- -h(iend,1) | c | and negate the last column of Q. | c | We have effectively carried out a | c | similarity on transformation H | c %------------------------------------------% c if (h(iend,1) .lt. zero) then h(iend,1) = -h(iend,1) call dscal(kplusp, -one, q(1,iend), 1) end if c c %--------------------------------------------------------% c | Apply the same shift to the next block if there is any | c %--------------------------------------------------------% c if (iend .lt. kplusp) go to 20 c c %-----------------------------------------------------% c | Check if we can increase the the start of the block | c %-----------------------------------------------------% c do 80 i = itop, kplusp-1 if (h(i+1,1) .gt. zero) go to 90 itop = itop + 1 80 continue c c %-----------------------------------% c | Finished applying the jj-th shift | c %-----------------------------------% c 90 continue c c %------------------------------------------% c | All shifts have been applied. Check for | c | more possible deflation that might occur | c | after the last shift is applied. | c %------------------------------------------% c do 100 i = itop, kplusp-1 big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then call ivout (logfil, 1, i, ndigit, & '_sapps: deflation at row/column no.') call dvout (logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') end if h(i+1,1) = zero end if 100 continue c c %-------------------------------------------------% c | Compute the (kev+1)-st column of (V*Q) and | c | temporarily store the result in WORKD(N+1:2*N). | c | This is not necessary if h(kev+1,1) = 0. | c %-------------------------------------------------% c if ( h(kev+1,1) .gt. zero ) & call dgemv ('N', n, kplusp, one, v, ldv, & q(1,kev+1), 1, zero, workd(n+1), 1) c c %-------------------------------------------------------% c | Compute column 1 to kev of (V*Q) in backward order | c | taking advantage that Q is an upper triangular matrix | c | with lower bandwidth np. | c | Place results in v(:,kplusp-kev:kplusp) temporarily. | c %-------------------------------------------------------% c do 130 i = 1, kev call dgemv ('N', n, kplusp-i+1, one, v, ldv, & q(1,kev-i+1), 1, zero, workd, 1) call dcopy (n, workd, 1, v(1,kplusp-i+1), 1) 130 continue c c %-------------------------------------------------% c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). | c %-------------------------------------------------% c call dlacpy ('All', n, kev, v(1,np+1), ldv, v, ldv) c c %--------------------------------------------% c | Copy the (kev+1)-st column of (V*Q) in the | c | appropriate place if h(kev+1,1) .ne. zero. | c %--------------------------------------------% c if ( h(kev+1,1) .gt. zero ) & call dcopy (n, workd(n+1), 1, v(1,kev+1), 1) c c %-------------------------------------% c | Update the residual vector: | c | r <- sigmak*r + betak*v(:,kev+1) | c | where | c | sigmak = (e_{kev+p}'*Q)*e_{kev} | c | betak = e_{kev+1}'*H*e_{kev} | c %-------------------------------------% c call dscal (n, q(kplusp,kev), resid, 1) if (h(kev+1,1) .gt. zero) & call daxpy (n, h(kev+1,1), v(1,kev+1), 1, resid, 1) c if (msglvl .gt. 1) then call dvout (logfil, 1, q(kplusp,kev), ndigit, & '_sapps: sigmak of the updated residual vector') call dvout (logfil, 1, h(kev+1,1), ndigit, & '_sapps: betak of the updated residual vector') call dvout (logfil, kev, h(1,2), ndigit, & '_sapps: updated main diagonal of H for next iteration') if (kev .gt. 1) then call dvout (logfil, kev-1, h(2,1), ndigit, & '_sapps: updated sub diagonal of H for next iteration') end if end if c call second (t1) tsapps = tsapps + (t1 - t0) c 9000 continue return c c %---------------% c | End of dsapps | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/ssapps.f000644 001750 001750 00000043732 11266605602 022137 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: ssapps c c\Description: c Given the Arnoldi factorization c c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T, c c apply NP shifts implicitly resulting in c c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q c c where Q is an orthogonal matrix of order KEV+NP. Q is the product of c rotations resulting from the NP bulge chasing sweeps. The updated Arnoldi c factorization becomes: c c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T. c c\Usage: c call ssapps c ( N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ, WORKD ) c c\Arguments c N Integer. (INPUT) c Problem size, i.e. dimension of matrix A. c c KEV Integer. (INPUT) c INPUT: KEV+NP is the size of the input matrix H. c OUTPUT: KEV is the size of the updated matrix HNEW. c c NP Integer. (INPUT) c Number of implicit shifts to be applied. c c SHIFT Real array of length NP. (INPUT) c The shifts to be applied. c c V Real N by (KEV+NP) array. (INPUT/OUTPUT) c INPUT: V contains the current KEV+NP Arnoldi vectors. c OUTPUT: VNEW = V(1:n,1:KEV); the updated Arnoldi vectors c are in the first KEV columns of V. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Real (KEV+NP) by 2 array. (INPUT/OUTPUT) c INPUT: H contains the symmetric tridiagonal matrix of the c Arnoldi factorization with the subdiagonal in the 1st column c starting at H(2,1) and the main diagonal in the 2nd column. c OUTPUT: H contains the updated tridiagonal matrix in the c KEV leading submatrix. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RESID Real array of length (N). (INPUT/OUTPUT) c INPUT: RESID contains the the residual vector r_{k+p}. c OUTPUT: RESID is the updated residual vector rnew_{k}. c c Q Real KEV+NP by KEV+NP work array. (WORKSPACE) c Work array used to accumulate the rotations during the bulge c chase sweep. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKD Real work array of length 2*N. (WORKSPACE) c Distributed array used in the application of the accumulated c orthogonal matrix Q. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c svout ARPACK utility routine that prints vectors. c slamch LAPACK routine that determines machine constants. c slartg LAPACK Givens rotation construction routine. c slacpy LAPACK matrix copy routine. c slaset LAPACK matrix initialization routine. c sgemv Level 2 BLAS routine for matrix vector multiplication. c saxpy Level 1 BLAS that computes a vector triad. c scopy Level 1 BLAS that copies one vector to another. c sscal Level 1 BLAS that scales a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/16/93: Version ' 2.4' c c\SCCS Information: @(#) c FILE: sapps.F SID: 2.6 DATE OF SID: 3/28/97 RELEASE: 2 c c\Remarks c 1. In this version, each shift is applied to all the subblocks of c the tridiagonal matrix H and not just to the submatrix that it c comes from. This routine assumes that the subdiagonal elements c of H that are stored in h(1:kev+np,1) are nonegative upon input c and enforce this condition upon output. This version incorporates c deflation. See code for documentation. c c\EndLib c c----------------------------------------------------------------------- c subroutine ssapps & ( n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq, workd ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer kev, ldh, ldq, ldv, n, np c c %-----------------% c | Array Arguments | c %-----------------% c Real & h(ldh,2), q(ldq,kev+np), resid(n), shift(np), & v(ldv,kev+np), workd(2*n) c c %------------% c | Parameters | c %------------% c Real & one, zero parameter (one = 1.0E+0, zero = 0.0E+0) c c %---------------% c | Local Scalars | c %---------------% c integer i, iend, istart, itop, j, jj, kplusp, msglvl logical first Real & a1, a2, a3, a4, big, c, epsmch, f, g, r, s save epsmch, first c c c %----------------------% c | External Subroutines | c %----------------------% c external saxpy, scopy, sscal, slacpy, slartg, slaset, svout, & ivout, second, sgemv c c %--------------------% c | External Functions | c %--------------------% c Real & slamch external slamch c c %----------------------% c | Intrinsics Functions | c %----------------------% c intrinsic abs c c %----------------% c | Data statments | c %----------------% c data first / .true. / c c %-----------------------% c | Executable Statements | c %-----------------------% c if (first) then epsmch = slamch('Epsilon-Machine') first = .false. end if itop = 1 c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = msapps c kplusp = kev + np c c %----------------------------------------------% c | Initialize Q to the identity matrix of order | c | kplusp used to accumulate the rotations. | c %----------------------------------------------% c call slaset ('All', kplusp, kplusp, zero, one, q, ldq) c c %----------------------------------------------% c | Quick return if there are no shifts to apply | c %----------------------------------------------% c if (np .eq. 0) go to 9000 c c %----------------------------------------------------------% c | Apply the np shifts implicitly. Apply each shift to the | c | whole matrix and not just to the submatrix from which it | c | comes. | c %----------------------------------------------------------% c do 90 jj = 1, np c istart = itop c c %----------------------------------------------------------% c | Check for splitting and deflation. Currently we consider | c | an off-diagonal element h(i+1,1) negligible if | c | h(i+1,1) .le. epsmch*( |h(i,2)| + |h(i+1,2)| ) | c | for i=1:KEV+NP-1. | c | If above condition tests true then we set h(i+1,1) = 0. | c | Note that h(1:KEV+NP,1) are assumed to be non negative. | c %----------------------------------------------------------% c 20 continue c c %------------------------------------------------% c | The following loop exits early if we encounter | c | a negligible off diagonal element. | c %------------------------------------------------% c do 30 i = istart, kplusp-1 big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then call ivout (logfil, 1, i, ndigit, & '_sapps: deflation at row/column no.') call ivout (logfil, 1, jj, ndigit, & '_sapps: occured before shift number.') call svout (logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') end if h(i+1,1) = zero iend = i go to 40 end if 30 continue iend = kplusp 40 continue c if (istart .lt. iend) then c c %--------------------------------------------------------% c | Construct the plane rotation G'(istart,istart+1,theta) | c | that attempts to drive h(istart+1,1) to zero. | c %--------------------------------------------------------% c f = h(istart,2) - shift(jj) g = h(istart+1,1) call slartg (f, g, c, s, r) c c %-------------------------------------------------------% c | Apply rotation to the left and right of H; | c | H <- G' * H * G, where G = G(istart,istart+1,theta). | c | This will create a "bulge". | c %-------------------------------------------------------% c a1 = c*h(istart,2) + s*h(istart+1,1) a2 = c*h(istart+1,1) + s*h(istart+1,2) a4 = c*h(istart+1,2) - s*h(istart+1,1) a3 = c*h(istart+1,1) - s*h(istart,2) h(istart,2) = c*a1 + s*a2 h(istart+1,2) = c*a4 - s*a3 h(istart+1,1) = c*a3 + s*a4 c c %----------------------------------------------------% c | Accumulate the rotation in the matrix Q; Q <- Q*G | c %----------------------------------------------------% c do 60 j = 1, min(istart+jj,kplusp) a1 = c*q(j,istart) + s*q(j,istart+1) q(j,istart+1) = - s*q(j,istart) + c*q(j,istart+1) q(j,istart) = a1 60 continue c c c %----------------------------------------------% c | The following loop chases the bulge created. | c | Note that the previous rotation may also be | c | done within the following loop. But it is | c | kept separate to make the distinction among | c | the bulge chasing sweeps and the first plane | c | rotation designed to drive h(istart+1,1) to | c | zero. | c %----------------------------------------------% c do 70 i = istart+1, iend-1 c c %----------------------------------------------% c | Construct the plane rotation G'(i,i+1,theta) | c | that zeros the i-th bulge that was created | c | by G(i-1,i,theta). g represents the bulge. | c %----------------------------------------------% c f = h(i,1) g = s*h(i+1,1) c c %----------------------------------% c | Final update with G(i-1,i,theta) | c %----------------------------------% c h(i+1,1) = c*h(i+1,1) call slartg (f, g, c, s, r) c c %-------------------------------------------% c | The following ensures that h(1:iend-1,1), | c | the first iend-2 off diagonal of elements | c | H, remain non negative. | c %-------------------------------------------% c if (r .lt. zero) then r = -r c = -c s = -s end if c c %--------------------------------------------% c | Apply rotation to the left and right of H; | c | H <- G * H * G', where G = G(i,i+1,theta) | c %--------------------------------------------% c h(i,1) = r c a1 = c*h(i,2) + s*h(i+1,1) a2 = c*h(i+1,1) + s*h(i+1,2) a3 = c*h(i+1,1) - s*h(i,2) a4 = c*h(i+1,2) - s*h(i+1,1) c h(i,2) = c*a1 + s*a2 h(i+1,2) = c*a4 - s*a3 h(i+1,1) = c*a3 + s*a4 c c %----------------------------------------------------% c | Accumulate the rotation in the matrix Q; Q <- Q*G | c %----------------------------------------------------% c do 50 j = 1, min( i+jj, kplusp ) a1 = c*q(j,i) + s*q(j,i+1) q(j,i+1) = - s*q(j,i) + c*q(j,i+1) q(j,i) = a1 50 continue c 70 continue c end if c c %--------------------------% c | Update the block pointer | c %--------------------------% c istart = iend + 1 c c %------------------------------------------% c | Make sure that h(iend,1) is non-negative | c | If not then set h(iend,1) <-- -h(iend,1) | c | and negate the last column of Q. | c | We have effectively carried out a | c | similarity on transformation H | c %------------------------------------------% c if (h(iend,1) .lt. zero) then h(iend,1) = -h(iend,1) call sscal(kplusp, -one, q(1,iend), 1) end if c c %--------------------------------------------------------% c | Apply the same shift to the next block if there is any | c %--------------------------------------------------------% c if (iend .lt. kplusp) go to 20 c c %-----------------------------------------------------% c | Check if we can increase the the start of the block | c %-----------------------------------------------------% c do 80 i = itop, kplusp-1 if (h(i+1,1) .gt. zero) go to 90 itop = itop + 1 80 continue c c %-----------------------------------% c | Finished applying the jj-th shift | c %-----------------------------------% c 90 continue c c %------------------------------------------% c | All shifts have been applied. Check for | c | more possible deflation that might occur | c | after the last shift is applied. | c %------------------------------------------% c do 100 i = itop, kplusp-1 big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then call ivout (logfil, 1, i, ndigit, & '_sapps: deflation at row/column no.') call svout (logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') end if h(i+1,1) = zero end if 100 continue c c %-------------------------------------------------% c | Compute the (kev+1)-st column of (V*Q) and | c | temporarily store the result in WORKD(N+1:2*N). | c | This is not necessary if h(kev+1,1) = 0. | c %-------------------------------------------------% c if ( h(kev+1,1) .gt. zero ) & call sgemv ('N', n, kplusp, one, v, ldv, & q(1,kev+1), 1, zero, workd(n+1), 1) c c %-------------------------------------------------------% c | Compute column 1 to kev of (V*Q) in backward order | c | taking advantage that Q is an upper triangular matrix | c | with lower bandwidth np. | c | Place results in v(:,kplusp-kev:kplusp) temporarily. | c %-------------------------------------------------------% c do 130 i = 1, kev call sgemv ('N', n, kplusp-i+1, one, v, ldv, & q(1,kev-i+1), 1, zero, workd, 1) call scopy (n, workd, 1, v(1,kplusp-i+1), 1) 130 continue c c %-------------------------------------------------% c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). | c %-------------------------------------------------% c call slacpy ('All', n, kev, v(1,np+1), ldv, v, ldv) c c %--------------------------------------------% c | Copy the (kev+1)-st column of (V*Q) in the | c | appropriate place if h(kev+1,1) .ne. zero. | c %--------------------------------------------% c if ( h(kev+1,1) .gt. zero ) & call scopy (n, workd(n+1), 1, v(1,kev+1), 1) c c %-------------------------------------% c | Update the residual vector: | c | r <- sigmak*r + betak*v(:,kev+1) | c | where | c | sigmak = (e_{kev+p}'*Q)*e_{kev} | c | betak = e_{kev+1}'*H*e_{kev} | c %-------------------------------------% c call sscal (n, q(kplusp,kev), resid, 1) if (h(kev+1,1) .gt. zero) & call saxpy (n, h(kev+1,1), v(1,kev+1), 1, resid, 1) c if (msglvl .gt. 1) then call svout (logfil, 1, q(kplusp,kev), ndigit, & '_sapps: sigmak of the updated residual vector') call svout (logfil, 1, h(kev+1,1), ndigit, & '_sapps: betak of the updated residual vector') call svout (logfil, kev, h(1,2), ndigit, & '_sapps: updated main diagonal of H for next iteration') if (kev .gt. 1) then call svout (logfil, kev-1, h(2,1), ndigit, & '_sapps: updated sub diagonal of H for next iteration') end if end if c call second (t1) tsapps = tsapps + (t1 - t0) c 9000 continue return c c %---------------% c | End of ssapps | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dnconv.f000644 001750 001750 00000007765 11266605602 022123 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: dnconv c c\Description: c Convergence testing for the nonsymmetric Arnoldi eigenvalue routine. c c\Usage: c call dnconv c ( N, RITZR, RITZI, BOUNDS, TOL, NCONV ) c c\Arguments c N Integer. (INPUT) c Number of Ritz values to check for convergence. c c RITZR, Double precision arrays of length N. (INPUT) c RITZI Real and imaginary parts of the Ritz values to be checked c for convergence. c BOUNDS Double precision array of length N. (INPUT) c Ritz estimates for the Ritz values in RITZR and RITZI. c c TOL Double precision scalar. (INPUT) c Desired backward error for a Ritz value to be considered c "converged". c c NCONV Integer scalar. (OUTPUT) c Number of "converged" Ritz values. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c second ARPACK utility routine for timing. c dlamch LAPACK routine that determines machine constants. c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.1' c c\SCCS Information: @(#) c FILE: nconv.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 c c\Remarks c 1. xxxx c c\EndLib c c----------------------------------------------------------------------- c subroutine dnconv (n, ritzr, ritzi, bounds, tol, nconv) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer n, nconv Double precision & tol c c %-----------------% c | Array Arguments | c %-----------------% Double precision & ritzr(n), ritzi(n), bounds(n) c c %---------------% c | Local Scalars | c %---------------% c integer i Double precision & temp, eps23 c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlapy2, dlamch external dlapy2, dlamch c %-----------------------% c | Executable Statements | c %-----------------------% c c %-------------------------------------------------------------% c | Convergence test: unlike in the symmetric code, I am not | c | using things like refined error bounds and gap condition | c | because I don't know the exact equivalent concept. | c | | c | Instead the i-th Ritz value is considered "converged" when: | c | | c | bounds(i) .le. ( TOL * | ritz | ) | c | | c | for some appropriate choice of norm. | c %-------------------------------------------------------------% c call second (t0) c c %---------------------------------% c | Get machine dependent constant. | c %---------------------------------% c eps23 = dlamch('Epsilon-Machine') eps23 = eps23**(2.0D+0 / 3.0D+0) c nconv = 0 do 20 i = 1, n temp = max( eps23, dlapy2( ritzr(i), ritzi(i) ) ) if (bounds(i) .le. tol*temp) nconv = nconv + 1 20 continue c call second (t1) tnconv = tnconv + (t1 - t0) c return c c %---------------% c | End of dnconv | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/sgetv0.f000644 001750 001750 00000031466 11266605602 022037 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: sgetv0 c c\Description: c Generate a random initial residual vector for the Arnoldi process. c Force the residual vector to be in the range of the operator OP. c c\Usage: c call sgetv0 c ( IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM, c IPNTR, WORKD, IERR ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. IDO must be zero on the first c call to sgetv0. c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c This is for the initialization phase to force the c starting vector into the range of OP. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c IDO = 99: done c ------------------------------------------------------------- c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B in the (generalized) c eigenvalue problem A*x = lambda*B*x. c B = 'I' -> standard eigenvalue problem A*x = lambda*x c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x c c ITRY Integer. (INPUT) c ITRY counts the number of times that sgetv0 is called. c It should be set to 1 on the initial call to sgetv0. c c INITV Logical variable. (INPUT) c .TRUE. => the initial residual vector is given in RESID. c .FALSE. => generate a random initial residual vector. c c N Integer. (INPUT) c Dimension of the problem. c c J Integer. (INPUT) c Index of the residual vector to be generated, with respect to c the Arnoldi process. J > 1 in case of a "restart". c c V Real N by J array. (INPUT) c The first J-1 columns of V contain the current Arnoldi basis c if this is a "restart". c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c RESID Real array of length N. (INPUT/OUTPUT) c Initial residual vector to be generated. If RESID is c provided, force RESID into the range of the operator OP. c c RNORM Real scalar. (OUTPUT) c B-norm of the generated residual. c c IPNTR Integer array of length 3. (OUTPUT) c c WORKD Real work array of length 2*N. (REVERSE COMMUNICATION). c On exit, WORK(1:N) = B*RESID to be used in SSAITR. c c IERR Integer. (OUTPUT) c = 0: Normal exit. c = -1: Cannot generate a nontrivial restarted residual vector c in the range of the operator OP. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: c second ARPACK utility routine for timing. c svout ARPACK utility routine for vector output. c slarnv LAPACK routine for generating a random vector. c sgemv Level 2 BLAS routine for matrix vector multiplication. c scopy Level 1 BLAS that copies one vector to another. c sdot Level 1 BLAS that computes the scalar product of two vectors. c snrm2 Level 1 BLAS that computes the norm of a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: getv0.F SID: 2.7 DATE OF SID: 04/07/99 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine sgetv0 & ( ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm, & ipntr, workd, ierr ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1 logical initv integer ido, ierr, itry, j, ldv, n Real & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(3) Real & resid(n), v(ldv,j), workd(2*n) c c %------------% c | Parameters | c %------------% c Real & one, zero parameter (one = 1.0E+0, zero = 0.0E+0) c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c logical first, inits, orth integer idist, iseed(4), iter, msglvl, jj Real & rnorm0 save first, iseed, inits, iter, msglvl, orth, rnorm0 c c %----------------------% c | External Subroutines | c %----------------------% c external slarnv, svout, scopy, sgemv, second c c %--------------------% c | External Functions | c %--------------------% c Real & sdot, snrm2 external sdot, snrm2 c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic abs, sqrt c c %-----------------% c | Data Statements | c %-----------------% c data inits /.true./ c c %-----------------------% c | Executable Statements | c %-----------------------% c c c %-----------------------------------% c | Initialize the seed of the LAPACK | c | random number generator | c %-----------------------------------% c if (inits) then iseed(1) = 1 iseed(2) = 3 iseed(3) = 5 iseed(4) = 7 inits = .false. end if c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mgetv0 c ierr = 0 iter = 0 first = .FALSE. orth = .FALSE. c c %-----------------------------------------------------% c | Possibly generate a random starting vector in RESID | c | Use a LAPACK random number generator used by the | c | matrix generation routines. | c | idist = 1: uniform (0,1) distribution; | c | idist = 2: uniform (-1,1) distribution; | c | idist = 3: normal (0,1) distribution; | c %-----------------------------------------------------% c if (.not.initv) then idist = 2 call slarnv (idist, iseed, n, resid) end if c c %----------------------------------------------------------% c | Force the starting vector into the range of OP to handle | c | the generalized problem when B is possibly (singular). | c %----------------------------------------------------------% c call second (t2) if (bmat .eq. 'G') then nopx = nopx + 1 ipntr(1) = 1 ipntr(2) = n + 1 call scopy (n, resid, 1, workd, 1) ido = -1 go to 9000 end if end if c c %-----------------------------------------% c | Back from computing OP*(initial-vector) | c %-----------------------------------------% c if (first) go to 20 c c %-----------------------------------------------% c | Back from computing B*(orthogonalized-vector) | c %-----------------------------------------------% c if (orth) go to 40 c if (bmat .eq. 'G') then call second (t3) tmvopx = tmvopx + (t3 - t2) end if c c %------------------------------------------------------% c | Starting vector is now in the range of OP; r = OP*r; | c | Compute B-norm of starting vector. | c %------------------------------------------------------% c call second (t2) first = .TRUE. if (bmat .eq. 'G') then nbx = nbx + 1 call scopy (n, workd(n+1), 1, resid, 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 go to 9000 else if (bmat .eq. 'I') then call scopy (n, resid, 1, workd, 1) end if c 20 continue c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c first = .FALSE. if (bmat .eq. 'G') then rnorm0 = sdot (n, resid, 1, workd, 1) rnorm0 = sqrt(abs(rnorm0)) else if (bmat .eq. 'I') then rnorm0 = snrm2(n, resid, 1) end if rnorm = rnorm0 c c %---------------------------------------------% c | Exit if this is the very first Arnoldi step | c %---------------------------------------------% c if (j .eq. 1) go to 50 c c %---------------------------------------------------------------- c | Otherwise need to B-orthogonalize the starting vector against | c | the current Arnoldi basis using Gram-Schmidt with iter. ref. | c | This is the case where an invariant subspace is encountered | c | in the middle of the Arnoldi factorization. | c | | c | s = V^{T}*B*r; r = r - V*s; | c | | c | Stopping criteria used for iter. ref. is discussed in | c | Parlett's book, page 107 and in Gragg & Reichel TOMS paper. | c %---------------------------------------------------------------% c orth = .TRUE. 30 continue c call sgemv ('T', n, j-1, one, v, ldv, workd, 1, & zero, workd(n+1), 1) call sgemv ('N', n, j-1, -one, v, ldv, workd(n+1), 1, & one, resid, 1) c c %----------------------------------------------------------% c | Compute the B-norm of the orthogonalized starting vector | c %----------------------------------------------------------% c call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call scopy (n, resid, 1, workd(n+1), 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 go to 9000 else if (bmat .eq. 'I') then call scopy (n, resid, 1, workd, 1) end if c 40 continue c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c if (bmat .eq. 'G') then rnorm = sdot (n, resid, 1, workd, 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then rnorm = snrm2(n, resid, 1) end if c c %--------------------------------------% c | Check for further orthogonalization. | c %--------------------------------------% c if (msglvl .gt. 2) then call svout (logfil, 1, rnorm0, ndigit, & '_getv0: re-orthonalization ; rnorm0 is') call svout (logfil, 1, rnorm, ndigit, & '_getv0: re-orthonalization ; rnorm is') end if c if (rnorm .gt. 0.717*rnorm0) go to 50 c iter = iter + 1 if (iter .le. 5) then c c %-----------------------------------% c | Perform iterative refinement step | c %-----------------------------------% c rnorm0 = rnorm go to 30 else c c %------------------------------------% c | Iterative refinement step "failed" | c %------------------------------------% c do 45 jj = 1, n resid(jj) = zero 45 continue rnorm = zero ierr = -1 end if c 50 continue c if (msglvl .gt. 0) then call svout (logfil, 1, rnorm, ndigit, & '_getv0: B-norm of initial / restarted starting vector') end if if (msglvl .gt. 3) then call svout (logfil, n, resid, ndigit, & '_getv0: initial / restarted starting vector') end if ido = 99 c call second (t1) tgetv0 = tgetv0 + (t1 - t0) c 9000 continue return c c %---------------% c | End of sgetv0 | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/ssesrt.f000644 001750 001750 00000012310 11266605602 022135 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: ssesrt c c\Description: c Sort the array X in the order specified by WHICH and optionally c apply the permutation to the columns of the matrix A. c c\Usage: c call ssesrt c ( WHICH, APPLY, N, X, NA, A, LDA) c c\Arguments c WHICH Character*2. (Input) c 'LM' -> X is sorted into increasing order of magnitude. c 'SM' -> X is sorted into decreasing order of magnitude. c 'LA' -> X is sorted into increasing order of algebraic. c 'SA' -> X is sorted into decreasing order of algebraic. c c APPLY Logical. (Input) c APPLY = .TRUE. -> apply the sorted order to A. c APPLY = .FALSE. -> do not apply the sorted order to A. c c N Integer. (INPUT) c Dimension of the array X. c c X Real array of length N. (INPUT/OUTPUT) c The array to be sorted. c c NA Integer. (INPUT) c Number of rows of the matrix A. c c A Real array of length NA by N. (INPUT/OUTPUT) c c LDA Integer. (INPUT) c Leading dimension of A. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Routines c sswap Level 1 BLAS that swaps the contents of two vectors. c c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/15/93: Version ' 2.1'. c Adapted from the sort routine in LANSO and c the ARPACK code ssortr c c\SCCS Information: @(#) c FILE: sesrt.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine ssesrt (which, apply, n, x, na, a, lda) c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which logical apply integer lda, n, na c c %-----------------% c | Array Arguments | c %-----------------% c Real & x(0:n-1), a(lda, 0:n-1) c c %---------------% c | Local Scalars | c %---------------% c integer i, igap, j Real & temp c c %----------------------% c | External Subroutines | c %----------------------% c external sswap c c %-----------------------% c | Executable Statements | c %-----------------------% c igap = n / 2 c if (which .eq. 'SA') then c c X is sorted into decreasing order of algebraic. c 10 continue if (igap .eq. 0) go to 9000 do 30 i = igap, n-1 j = i-igap 20 continue c if (j.lt.0) go to 30 c if (x(j).lt.x(j+igap)) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp if (apply) call sswap( na, a(1, j), 1, a(1,j+igap), 1) else go to 30 endif j = j-igap go to 20 30 continue igap = igap / 2 go to 10 c else if (which .eq. 'SM') then c c X is sorted into decreasing order of magnitude. c 40 continue if (igap .eq. 0) go to 9000 do 60 i = igap, n-1 j = i-igap 50 continue c if (j.lt.0) go to 60 c if (abs(x(j)).lt.abs(x(j+igap))) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp if (apply) call sswap( na, a(1, j), 1, a(1,j+igap), 1) else go to 60 endif j = j-igap go to 50 60 continue igap = igap / 2 go to 40 c else if (which .eq. 'LA') then c c X is sorted into increasing order of algebraic. c 70 continue if (igap .eq. 0) go to 9000 do 90 i = igap, n-1 j = i-igap 80 continue c if (j.lt.0) go to 90 c if (x(j).gt.x(j+igap)) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp if (apply) call sswap( na, a(1, j), 1, a(1,j+igap), 1) else go to 90 endif j = j-igap go to 80 90 continue igap = igap / 2 go to 70 c else if (which .eq. 'LM') then c c X is sorted into increasing order of magnitude. c 100 continue if (igap .eq. 0) go to 9000 do 120 i = igap, n-1 j = i-igap 110 continue c if (j.lt.0) go to 120 c if (abs(x(j)).gt.abs(x(j+igap))) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp if (apply) call sswap( na, a(1, j), 1, a(1,j+igap), 1) else go to 120 endif j = j-igap go to 110 120 continue igap = igap / 2 go to 100 end if c 9000 continue return c c %---------------% c | End of ssesrt | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dneupd.f000644 001750 001750 00000126444 11266605602 022107 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: dneupd c c\Description: c c This subroutine returns the converged approximations to eigenvalues c of A*z = lambda*B*z and (optionally): c c (1) The corresponding approximate eigenvectors; c c (2) An orthonormal basis for the associated approximate c invariant subspace; c c (3) Both. c c There is negligible additional cost to obtain eigenvectors. An orthonormal c basis is always computed. There is an additional storage cost of n*nev c if both are requested (in this case a separate array Z must be supplied). c c The approximate eigenvalues and eigenvectors of A*z = lambda*B*z c are derived from approximate eigenvalues and eigenvectors of c of the linear operator OP prescribed by the MODE selection in the c call to DNAUPD . DNAUPD must be called before this routine is called. c These approximate eigenvalues and vectors are commonly called Ritz c values and Ritz vectors respectively. They are referred to as such c in the comments that follow. The computed orthonormal basis for the c invariant subspace corresponding to these Ritz values is referred to as a c Schur basis. c c See documentation in the header of the subroutine DNAUPD for c definition of OP as well as other terms and the relation of computed c Ritz values and Ritz vectors of OP with respect to the given problem c A*z = lambda*B*z. For a brief description, see definitions of c IPARAM(7), MODE and WHICH in the documentation of DNAUPD . c c\Usage: c call dneupd c ( RVEC, HOWMNY, SELECT, DR, DI, Z, LDZ, SIGMAR, SIGMAI, WORKEV, BMAT, c N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, c LWORKL, INFO ) c c\Arguments: c RVEC LOGICAL (INPUT) c Specifies whether a basis for the invariant subspace corresponding c to the converged Ritz value approximations for the eigenproblem c A*z = lambda*B*z is computed. c c RVEC = .FALSE. Compute Ritz values only. c c RVEC = .TRUE. Compute the Ritz vectors or Schur vectors. c See Remarks below. c c HOWMNY Character*1 (INPUT) c Specifies the form of the basis for the invariant subspace c corresponding to the converged Ritz values that is to be computed. c c = 'A': Compute NEV Ritz vectors; c = 'P': Compute NEV Schur vectors; c = 'S': compute some of the Ritz vectors, specified c by the logical array SELECT. c c SELECT Logical array of dimension NCV. (INPUT) c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be c computed. To select the Ritz vector corresponding to a c Ritz value (DR(j), DI(j)), SELECT(j) must be set to .TRUE.. c If HOWMNY = 'A' or 'P', SELECT is used as internal workspace. c c DR Double precision array of dimension NEV+1. (OUTPUT) c If IPARAM(7) = 1,2 or 3 and SIGMAI=0.0 then on exit: DR contains c the real part of the Ritz approximations to the eigenvalues of c A*z = lambda*B*z. c If IPARAM(7) = 3, 4 and SIGMAI is not equal to zero, then on exit: c DR contains the real part of the Ritz values of OP computed by c DNAUPD . A further computation must be performed by the user c to transform the Ritz values computed for OP by DNAUPD to those c of the original system A*z = lambda*B*z. See remark 3 below. c c DI Double precision array of dimension NEV+1. (OUTPUT) c On exit, DI contains the imaginary part of the Ritz value c approximations to the eigenvalues of A*z = lambda*B*z associated c with DR. c c NOTE: When Ritz values are complex, they will come in complex c conjugate pairs. If eigenvectors are requested, the c corresponding Ritz vectors will also come in conjugate c pairs and the real and imaginary parts of these are c represented in two consecutive columns of the array Z c (see below). c c Z Double precision N by NEV+1 array if RVEC = .TRUE. and HOWMNY = 'A'. (OUTPUT) c On exit, if RVEC = .TRUE. and HOWMNY = 'A', then the columns of c Z represent approximate eigenvectors (Ritz vectors) corresponding c to the NCONV=IPARAM(5) Ritz values for eigensystem c A*z = lambda*B*z. c c The complex Ritz vector associated with the Ritz value c with positive imaginary part is stored in two consecutive c columns. The first column holds the real part of the Ritz c vector and the second column holds the imaginary part. The c Ritz vector associated with the Ritz value with negative c imaginary part is simply the complex conjugate of the Ritz vector c associated with the positive imaginary part. c c If RVEC = .FALSE. or HOWMNY = 'P', then Z is not referenced. c c NOTE: If if RVEC = .TRUE. and a Schur basis is not required, c the array Z may be set equal to first NEV+1 columns of the Arnoldi c basis array V computed by DNAUPD . In this case the Arnoldi basis c will be destroyed and overwritten with the eigenvector basis. c c LDZ Integer. (INPUT) c The leading dimension of the array Z. If Ritz vectors are c desired, then LDZ >= max( 1, N ). In any case, LDZ >= 1. c c SIGMAR Double precision (INPUT) c If IPARAM(7) = 3 or 4, represents the real part of the shift. c Not referenced if IPARAM(7) = 1 or 2. c c SIGMAI Double precision (INPUT) c If IPARAM(7) = 3 or 4, represents the imaginary part of the shift. c Not referenced if IPARAM(7) = 1 or 2. See remark 3 below. c c WORKEV Double precision work array of dimension 3*NCV. (WORKSPACE) c c **** The remaining arguments MUST be the same as for the **** c **** call to DNAUPD that was just completed. **** c c NOTE: The remaining arguments c c BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, c WORKD, WORKL, LWORKL, INFO c c must be passed directly to DNEUPD following the last call c to DNAUPD . These arguments MUST NOT BE MODIFIED between c the the last call to DNAUPD and the call to DNEUPD . c c Three of these parameters (V, WORKL, INFO) are also output parameters: c c V Double precision N by NCV array. (INPUT/OUTPUT) c c Upon INPUT: the NCV columns of V contain the Arnoldi basis c vectors for OP as constructed by DNAUPD . c c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns c contain approximate Schur vectors that span the c desired invariant subspace. See Remark 2 below. c c NOTE: If the array Z has been set equal to first NEV+1 columns c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the c Arnoldi basis held by V has been overwritten by the desired c Ritz vectors. If a separate array Z has been passed then c the first NCONV=IPARAM(5) columns of V will contain approximate c Schur vectors that span the desired invariant subspace. c c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) c WORKL(1:ncv*ncv+3*ncv) contains information obtained in c dnaupd . They are not changed by dneupd . c WORKL(ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) holds the c real and imaginary part of the untransformed Ritz values, c the upper quasi-triangular matrix for H, and the c associated matrix representation of the invariant subspace for H. c c Note: IPNTR(9:13) contains the pointer into WORKL for addresses c of the above information computed by dneupd . c ------------------------------------------------------------- c IPNTR(9): pointer to the real part of the NCV RITZ values of the c original system. c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of c the original system. c IPNTR(11): pointer to the NCV corresponding error bounds. c IPNTR(12): pointer to the NCV by NCV upper quasi-triangular c Schur matrix for H. c IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors c of the upper Hessenberg matrix H. Only referenced by c dneupd if RVEC = .TRUE. See Remark 2 below. c ------------------------------------------------------------- c c INFO Integer. (OUTPUT) c Error flag on output. c c = 0: Normal exit. c c = 1: The Schur form computed by LAPACK routine dlahqr c could not be reordered by LAPACK routine dtrsen . c Re-enter subroutine dneupd with IPARAM(5)=NCV and c increase the size of the arrays DR and DI to have c dimension at least dimension NCV and allocate at least NCV c columns for Z. NOTE: Not necessary if Z and V share c the same space. Please notify the authors if this error c occurs. c c = -1: N must be positive. c = -2: NEV must be positive. c = -3: NCV-NEV >= 2 and less than or equal to N. c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI' c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work WORKL array is not sufficient. c = -8: Error return from calculation of a real Schur form. c Informational error from LAPACK routine dlahqr . c = -9: Error return from calculation of eigenvectors. c Informational error from LAPACK routine dtrevc . c = -10: IPARAM(7) must be 1,2,3,4. c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible. c = -12: HOWMNY = 'S' not yet implemented c = -13: HOWMNY must be one of 'A' or 'P' if RVEC = .true. c = -14: DNAUPD did not find any eigenvalues to sufficient c accuracy. c = -15: DNEUPD got a different count of the number of converged c Ritz values than DNAUPD got. This indicates the user c probably made an error in passing data from DNAUPD to c DNEUPD or that the data was modified before entering c DNEUPD c c\BeginLib c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for c Real Matrices", Linear Algebra and its Applications, vol 88/89, c pp 575-595, (1987). c c\Routines called: c ivout ARPACK utility routine that prints integers. c dmout ARPACK utility routine that prints matrices c dvout ARPACK utility routine that prints vectors. c dgeqr2 LAPACK routine that computes the QR factorization of c a matrix. c dlacpy LAPACK matrix copy routine. c dlahqr LAPACK routine to compute the real Schur form of an c upper Hessenberg matrix. c dlamch LAPACK routine that determines machine constants. c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c dlaset LAPACK matrix initialization routine. c dorm2r LAPACK routine that applies an orthogonal matrix in c factored form. c dtrevc LAPACK routine to compute the eigenvectors of a matrix c in upper quasi-triangular form. c dtrsen LAPACK routine that re-orders the Schur form. c dtrmm Level 3 BLAS matrix times an upper triangular matrix. c dger Level 2 BLAS rank one update to a matrix. c dcopy Level 1 BLAS that copies one vector to another . c ddot Level 1 BLAS that computes the scalar product of two vectors. c dnrm2 Level 1 BLAS that computes the norm of a vector. c dscal Level 1 BLAS that scales a vector. c c\Remarks c c 1. Currently only HOWMNY = 'A' and 'P' are implemented. c c Let trans(X) denote the transpose of X. c c 2. Schur vectors are an orthogonal representation for the basis of c Ritz vectors. Thus, their numerical properties are often superior. c If RVEC = .TRUE. then the relationship c A * V(:,1:IPARAM(5)) = V(:,1:IPARAM(5)) * T, and c trans(V(:,1:IPARAM(5))) * V(:,1:IPARAM(5)) = I are approximately c satisfied. Here T is the leading submatrix of order IPARAM(5) of the c real upper quasi-triangular matrix stored workl(ipntr(12)). That is, c T is block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; c each 2-by-2 diagonal block has its diagonal elements equal and its c off-diagonal elements of opposite sign. Corresponding to each 2-by-2 c diagonal block is a complex conjugate pair of Ritz values. The real c Ritz values are stored on the diagonal of T. c c 3. If IPARAM(7) = 3 or 4 and SIGMAI is not equal zero, then the user must c form the IPARAM(5) Rayleigh quotients in order to transform the Ritz c values computed by DNAUPD for OP to those of A*z = lambda*B*z. c Set RVEC = .true. and HOWMNY = 'A', and c compute c trans(Z(:,I)) * A * Z(:,I) if DI(I) = 0. c If DI(I) is not equal to zero and DI(I+1) = - D(I), c then the desired real and imaginary parts of the Ritz value are c trans(Z(:,I)) * A * Z(:,I) + trans(Z(:,I+1)) * A * Z(:,I+1), c trans(Z(:,I)) * A * Z(:,I+1) - trans(Z(:,I+1)) * A * Z(:,I), c respectively. c Another possibility is to set RVEC = .true. and HOWMNY = 'P' and c compute trans(V(:,1:IPARAM(5))) * A * V(:,1:IPARAM(5)) and then an upper c quasi-triangular matrix of order IPARAM(5) is computed. See remark c 2 above. c c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Chao Yang Houston, Texas c Dept. of Computational & c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: neupd.F SID: 2.7 DATE OF SID: 09/20/00 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- subroutine dneupd (rvec , howmny, select, dr , di, & z , ldz , sigmar, sigmai, workev, & bmat , n , which , nev , tol, & resid, ncv , v , ldv , iparam, & ipntr, workd , workl , lworkl, info) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat, howmny, which*2 logical rvec integer info, ldz, ldv, lworkl, n, ncv, nev Double precision & sigmar, sigmai, tol c c %-----------------% c | Array Arguments | c %-----------------% c integer iparam(11), ipntr(14) logical select(ncv) Double precision & dr(nev+1) , di(nev+1), resid(n) , & v(ldv,ncv) , z(ldz,*) , workd(3*n), & workl(lworkl), workev(3*ncv) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0 , zero = 0.0D+0 ) c c %---------------% c | Local Scalars | c %---------------% c character type*6 integer bounds, ierr , ih , ihbds , & iheigr, iheigi, iconj , nconv , & invsub, iuptri, iwev , iwork(1), & j , k , ldh , ldq , & mode , msglvl, outncv, ritzr , & ritzi , wri , wrr , irr , & iri , ibd , ishift, numcnv , & np , jj logical reord Double precision & conds , rnorm, sep , temp, & vl(1,1), temp1, eps23 c c %----------------------% c | External Subroutines | c %----------------------% c external dcopy , dger , dgeqr2 , dlacpy , & dlahqr , dlaset , dmout , dorm2r , & dtrevc , dtrmm , dtrsen , dscal , & dvout , ivout c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlapy2 , dnrm2 , dlamch , ddot external dlapy2 , dnrm2 , dlamch , ddot c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic abs, min, sqrt c c %-----------------------% c | Executable Statements | c %-----------------------% c c %------------------------% c | Set default parameters | c %------------------------% c msglvl = mneupd mode = iparam(7) nconv = iparam(5) info = 0 c c %---------------------------------% c | Get machine dependent constant. | c %---------------------------------% c eps23 = dlamch ('Epsilon-Machine') eps23 = eps23**(2.0D+0 / 3.0D+0 ) c c %--------------% c | Quick return | c %--------------% c ierr = 0 c if (nconv .le. 0) then ierr = -14 else if (n .le. 0) then ierr = -1 else if (nev .le. 0) then ierr = -2 else if (ncv .le. nev+1 .or. ncv .gt. n) then ierr = -3 else if (which .ne. 'LM' .and. & which .ne. 'SM' .and. & which .ne. 'LR' .and. & which .ne. 'SR' .and. & which .ne. 'LI' .and. & which .ne. 'SI') then ierr = -5 else if (bmat .ne. 'I' .and. bmat .ne. 'G') then ierr = -6 else if (lworkl .lt. 3*ncv**2 + 6*ncv) then ierr = -7 else if ( (howmny .ne. 'A' .and. & howmny .ne. 'P' .and. & howmny .ne. 'S') .and. rvec ) then ierr = -13 else if (howmny .eq. 'S' ) then ierr = -12 end if c if (mode .eq. 1 .or. mode .eq. 2) then type = 'REGULR' else if (mode .eq. 3 .and. sigmai .eq. zero) then type = 'SHIFTI' else if (mode .eq. 3 ) then type = 'REALPT' else if (mode .eq. 4 ) then type = 'IMAGPT' else ierr = -10 end if if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11 c c %------------% c | Error Exit | c %------------% c if (ierr .ne. 0) then info = ierr go to 9000 end if c c %--------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | c | etc... and the remaining workspace. | c | Also update pointer to be used on output. | c | Memory is laid out as follows: | c | workl(1:ncv*ncv) := generated Hessenberg matrix | c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary | c | parts of ritz values | c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds | c %--------------------------------------------------------% c c %-----------------------------------------------------------% c | The following is used and set by DNEUPD . | c | workl(ncv*ncv+3*ncv+1:ncv*ncv+4*ncv) := The untransformed | c | real part of the Ritz values. | c | workl(ncv*ncv+4*ncv+1:ncv*ncv+5*ncv) := The untransformed | c | imaginary part of the Ritz values. | c | workl(ncv*ncv+5*ncv+1:ncv*ncv+6*ncv) := The untransformed | c | error bounds of the Ritz values | c | workl(ncv*ncv+6*ncv+1:2*ncv*ncv+6*ncv) := Holds the upper | c | quasi-triangular matrix for H | c | workl(2*ncv*ncv+6*ncv+1: 3*ncv*ncv+6*ncv) := Holds the | c | associated matrix representation of the invariant | c | subspace for H. | c | GRAND total of NCV * ( 3 * NCV + 6 ) locations. | c %-----------------------------------------------------------% c ih = ipntr(5) ritzr = ipntr(6) ritzi = ipntr(7) bounds = ipntr(8) ldh = ncv ldq = ncv iheigr = bounds + ldh iheigi = iheigr + ldh ihbds = iheigi + ldh iuptri = ihbds + ldh invsub = iuptri + ldh*ncv ipntr(9) = iheigr ipntr(10) = iheigi ipntr(11) = ihbds ipntr(12) = iuptri ipntr(13) = invsub wrr = 1 wri = ncv + 1 iwev = wri + ncv c c %-----------------------------------------% c | irr points to the REAL part of the Ritz | c | values computed by _neigh before | c | exiting _naup2. | c | iri points to the IMAGINARY part of the | c | Ritz values computed by _neigh | c | before exiting _naup2. | c | ibd points to the Ritz estimates | c | computed by _neigh before exiting | c | _naup2. | c %-----------------------------------------% c irr = ipntr(14)+ncv*ncv iri = irr+ncv ibd = iri+ncv c c %------------------------------------% c | RNORM is B-norm of the RESID(1:N). | c %------------------------------------% c rnorm = workl(ih+2) workl(ih+2) = zero c if (msglvl .gt. 2) then call dvout (logfil, ncv, workl(irr), ndigit, & '_neupd: Real part of Ritz values passed in from _NAUPD.') call dvout (logfil, ncv, workl(iri), ndigit, & '_neupd: Imag part of Ritz values passed in from _NAUPD.') call dvout (logfil, ncv, workl(ibd), ndigit, & '_neupd: Ritz estimates passed in from _NAUPD.') end if c if (rvec) then c reord = .false. c c %---------------------------------------------------% c | Use the temporary bounds array to store indices | c | These will be used to mark the select array later | c %---------------------------------------------------% c do 10 j = 1,ncv workl(bounds+j-1) = j select(j) = .false. 10 continue c c %-------------------------------------% c | Select the wanted Ritz values. | c | Sort the Ritz values so that the | c | wanted ones appear at the tailing | c | NEV positions of workl(irr) and | c | workl(iri). Move the corresponding | c | error estimates in workl(bound) | c | accordingly. | c %-------------------------------------% c np = ncv - nev ishift = 0 call dngets (ishift , which , nev , & np , workl(irr), workl(iri), & workl(bounds), workl , workl(np+1)) c if (msglvl .gt. 2) then call dvout (logfil, ncv, workl(irr), ndigit, & '_neupd: Real part of Ritz values after calling _NGETS.') call dvout (logfil, ncv, workl(iri), ndigit, & '_neupd: Imag part of Ritz values after calling _NGETS.') call dvout (logfil, ncv, workl(bounds), ndigit, & '_neupd: Ritz value indices after calling _NGETS.') end if c c %-----------------------------------------------------% c | Record indices of the converged wanted Ritz values | c | Mark the select array for possible reordering | c %-----------------------------------------------------% c numcnv = 0 do 11 j = 1,ncv temp1 = max(eps23, & dlapy2 ( workl(irr+ncv-j), workl(iri+ncv-j) )) jj = workl(bounds + ncv - j) if (numcnv .lt. nconv .and. & workl(ibd+jj-1) .le. tol*temp1) then select(jj) = .true. numcnv = numcnv + 1 if (jj .gt. nev) reord = .true. endif 11 continue c c %-----------------------------------------------------------% c | Check the count (numcnv) of converged Ritz values with | c | the number (nconv) reported by dnaupd. If these two | c | are different then there has probably been an error | c | caused by incorrect passing of the dnaupd data. | c %-----------------------------------------------------------% c if (msglvl .gt. 2) then call ivout(logfil, 1, numcnv, ndigit, & '_neupd: Number of specified eigenvalues') call ivout(logfil, 1, nconv, ndigit, & '_neupd: Number of "converged" eigenvalues') end if c if (numcnv .ne. nconv) then info = -15 go to 9000 end if c c %-----------------------------------------------------------% c | Call LAPACK routine dlahqr to compute the real Schur form | c | of the upper Hessenberg matrix returned by DNAUPD . | c | Make a copy of the upper Hessenberg matrix. | c | Initialize the Schur vector matrix Q to the identity. | c %-----------------------------------------------------------% c call dcopy (ldh*ncv, workl(ih), 1, workl(iuptri), 1) call dlaset ('All', ncv, ncv, & zero , one, workl(invsub), & ldq) call dlahqr (.true., .true. , ncv, & 1 , ncv , workl(iuptri), & ldh , workl(iheigr), workl(iheigi), & 1 , ncv , workl(invsub), & ldq , ierr) call dcopy (ncv , workl(invsub+ncv-1), ldq, & workl(ihbds), 1) c if (ierr .ne. 0) then info = -8 go to 9000 end if c if (msglvl .gt. 1) then call dvout (logfil, ncv, workl(iheigr), ndigit, & '_neupd: Real part of the eigenvalues of H') call dvout (logfil, ncv, workl(iheigi), ndigit, & '_neupd: Imaginary part of the Eigenvalues of H') call dvout (logfil, ncv, workl(ihbds), ndigit, & '_neupd: Last row of the Schur vector matrix') if (msglvl .gt. 3) then call dmout (logfil , ncv, ncv , & workl(iuptri), ldh, ndigit, & '_neupd: The upper quasi-triangular matrix ') end if end if c if (reord) then c c %-----------------------------------------------------% c | Reorder the computed upper quasi-triangular matrix. | c %-----------------------------------------------------% c call dtrsen ('None' , 'V' , & select , ncv , & workl(iuptri), ldh , & workl(invsub), ldq , & workl(iheigr), workl(iheigi), & nconv , conds , & sep , workl(ihbds) , & ncv , iwork , & 1 , ierr) c if (ierr .eq. 1) then info = 1 go to 9000 end if c if (msglvl .gt. 2) then call dvout (logfil, ncv, workl(iheigr), ndigit, & '_neupd: Real part of the eigenvalues of H--reordered') call dvout (logfil, ncv, workl(iheigi), ndigit, & '_neupd: Imag part of the eigenvalues of H--reordered') if (msglvl .gt. 3) then call dmout (logfil , ncv, ncv , & workl(iuptri), ldq, ndigit, & '_neupd: Quasi-triangular matrix after re-ordering') end if end if c end if c c %---------------------------------------% c | Copy the last row of the Schur vector | c | into workl(ihbds). This will be used | c | to compute the Ritz estimates of | c | converged Ritz values. | c %---------------------------------------% c call dcopy (ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1) c c %----------------------------------------------------% c | Place the computed eigenvalues of H into DR and DI | c | if a spectral transformation was not used. | c %----------------------------------------------------% c if (type .eq. 'REGULR') then call dcopy (nconv, workl(iheigr), 1, dr, 1) call dcopy (nconv, workl(iheigi), 1, di, 1) end if c c %----------------------------------------------------------% c | Compute the QR factorization of the matrix representing | c | the wanted invariant subspace located in the first NCONV | c | columns of workl(invsub,ldq). | c %----------------------------------------------------------% c call dgeqr2 (ncv, nconv , workl(invsub), & ldq, workev, workev(ncv+1), & ierr) c c %---------------------------------------------------------% c | * Postmultiply V by Q using dorm2r . | c | * Copy the first NCONV columns of VQ into Z. | c | * Postmultiply Z by R. | c | The N by NCONV matrix Z is now a matrix representation | c | of the approximate invariant subspace associated with | c | the Ritz values in workl(iheigr) and workl(iheigi) | c | The first NCONV columns of V are now approximate Schur | c | vectors associated with the real upper quasi-triangular | c | matrix of order NCONV in workl(iuptri) | c %---------------------------------------------------------% c call dorm2r ('Right', 'Notranspose', n , & ncv , nconv , workl(invsub), & ldq , workev , v , & ldv , workd(n+1) , ierr) call dlacpy ('All', n, nconv, v, ldv, z, ldz) c do 20 j=1, nconv c c %---------------------------------------------------% c | Perform both a column and row scaling if the | c | diagonal element of workl(invsub,ldq) is negative | c | I'm lazy and don't take advantage of the upper | c | quasi-triangular form of workl(iuptri,ldq) | c | Note that since Q is orthogonal, R is a diagonal | c | matrix consisting of plus or minus ones | c %---------------------------------------------------% c if (workl(invsub+(j-1)*ldq+j-1) .lt. zero) then call dscal (nconv, -one, workl(iuptri+j-1), ldq) call dscal (nconv, -one, workl(iuptri+(j-1)*ldq), 1) end if c 20 continue c if (howmny .eq. 'A') then c c %--------------------------------------------% c | Compute the NCONV wanted eigenvectors of T | c | located in workl(iuptri,ldq). | c %--------------------------------------------% c do 30 j=1, ncv if (j .le. nconv) then select(j) = .true. else select(j) = .false. end if 30 continue c call dtrevc ('Right', 'Select' , select , & ncv , workl(iuptri), ldq , & vl , 1 , workl(invsub), & ldq , ncv , outncv , & workev , ierr) c if (ierr .ne. 0) then info = -9 go to 9000 end if c c %------------------------------------------------% c | Scale the returning eigenvectors so that their | c | Euclidean norms are all one. LAPACK subroutine | c | dtrevc returns each eigenvector normalized so | c | that the element of largest magnitude has | c | magnitude 1; | c %------------------------------------------------% c iconj = 0 do 40 j=1, nconv c if ( workl(iheigi+j-1) .eq. zero ) then c c %----------------------% c | real eigenvalue case | c %----------------------% c temp = dnrm2 ( ncv, workl(invsub+(j-1)*ldq), 1 ) call dscal ( ncv, one / temp, & workl(invsub+(j-1)*ldq), 1 ) c else c c %-------------------------------------------% c | Complex conjugate pair case. Note that | c | since the real and imaginary part of | c | the eigenvector are stored in consecutive | c | columns, we further normalize by the | c | square root of two. | c %-------------------------------------------% c if (iconj .eq. 0) then temp = dlapy2 (dnrm2 (ncv, & workl(invsub+(j-1)*ldq), & 1), & dnrm2 (ncv, & workl(invsub+j*ldq), & 1)) call dscal (ncv, one/temp, & workl(invsub+(j-1)*ldq), 1 ) call dscal (ncv, one/temp, & workl(invsub+j*ldq), 1 ) iconj = 1 else iconj = 0 end if c end if c 40 continue c call dgemv ('T', ncv, nconv, one, workl(invsub), & ldq, workl(ihbds), 1, zero, workev, 1) c iconj = 0 do 45 j=1, nconv if (workl(iheigi+j-1) .ne. zero) then c c %-------------------------------------------% c | Complex conjugate pair case. Note that | c | since the real and imaginary part of | c | the eigenvector are stored in consecutive | c %-------------------------------------------% c if (iconj .eq. 0) then workev(j) = dlapy2 (workev(j), workev(j+1)) workev(j+1) = workev(j) iconj = 1 else iconj = 0 end if end if 45 continue c if (msglvl .gt. 2) then call dcopy (ncv, workl(invsub+ncv-1), ldq, & workl(ihbds), 1) call dvout (logfil, ncv, workl(ihbds), ndigit, & '_neupd: Last row of the eigenvector matrix for T') if (msglvl .gt. 3) then call dmout (logfil, ncv, ncv, workl(invsub), ldq, & ndigit, '_neupd: The eigenvector matrix for T') end if end if c c %---------------------------------------% c | Copy Ritz estimates into workl(ihbds) | c %---------------------------------------% c call dcopy (nconv, workev, 1, workl(ihbds), 1) c c %---------------------------------------------------------% c | Compute the QR factorization of the eigenvector matrix | c | associated with leading portion of T in the first NCONV | c | columns of workl(invsub,ldq). | c %---------------------------------------------------------% c call dgeqr2 (ncv, nconv , workl(invsub), & ldq, workev, workev(ncv+1), & ierr) c c %----------------------------------------------% c | * Postmultiply Z by Q. | c | * Postmultiply Z by R. | c | The N by NCONV matrix Z is now contains the | c | Ritz vectors associated with the Ritz values | c | in workl(iheigr) and workl(iheigi). | c %----------------------------------------------% c call dorm2r ('Right', 'Notranspose', n , & ncv , nconv , workl(invsub), & ldq , workev , z , & ldz , workd(n+1) , ierr) c call dtrmm ('Right' , 'Upper' , 'No transpose', & 'Non-unit', n , nconv , & one , workl(invsub), ldq , & z , ldz) c end if c else c c %------------------------------------------------------% c | An approximate invariant subspace is not needed. | c | Place the Ritz values computed DNAUPD into DR and DI | c %------------------------------------------------------% c call dcopy (nconv, workl(ritzr), 1, dr, 1) call dcopy (nconv, workl(ritzi), 1, di, 1) call dcopy (nconv, workl(ritzr), 1, workl(iheigr), 1) call dcopy (nconv, workl(ritzi), 1, workl(iheigi), 1) call dcopy (nconv, workl(bounds), 1, workl(ihbds), 1) end if c c %------------------------------------------------% c | Transform the Ritz values and possibly vectors | c | and corresponding error bounds of OP to those | c | of A*x = lambda*B*x. | c %------------------------------------------------% c if (type .eq. 'REGULR') then c if (rvec) & call dscal (ncv, rnorm, workl(ihbds), 1) c else c c %---------------------------------------% c | A spectral transformation was used. | c | * Determine the Ritz estimates of the | c | Ritz values in the original system. | c %---------------------------------------% c if (type .eq. 'SHIFTI') then c if (rvec) & call dscal (ncv, rnorm, workl(ihbds), 1) c do 50 k=1, ncv temp = dlapy2 ( workl(iheigr+k-1), & workl(iheigi+k-1) ) workl(ihbds+k-1) = abs( workl(ihbds+k-1) ) & / temp / temp 50 continue c else if (type .eq. 'REALPT') then c do 60 k=1, ncv 60 continue c else if (type .eq. 'IMAGPT') then c do 70 k=1, ncv 70 continue c end if c c %-----------------------------------------------------------% c | * Transform the Ritz values back to the original system. | c | For TYPE = 'SHIFTI' the transformation is | c | lambda = 1/theta + sigma | c | For TYPE = 'REALPT' or 'IMAGPT' the user must from | c | Rayleigh quotients or a projection. See remark 3 above.| c | NOTES: | c | *The Ritz vectors are not affected by the transformation. | c %-----------------------------------------------------------% c if (type .eq. 'SHIFTI') then c do 80 k=1, ncv temp = dlapy2 ( workl(iheigr+k-1), & workl(iheigi+k-1) ) workl(iheigr+k-1) = workl(iheigr+k-1)/temp/temp & + sigmar workl(iheigi+k-1) = -workl(iheigi+k-1)/temp/temp & + sigmai 80 continue c call dcopy (nconv, workl(iheigr), 1, dr, 1) call dcopy (nconv, workl(iheigi), 1, di, 1) c else if (type .eq. 'REALPT' .or. type .eq. 'IMAGPT') then c call dcopy (nconv, workl(iheigr), 1, dr, 1) call dcopy (nconv, workl(iheigi), 1, di, 1) c end if c end if c if (type .eq. 'SHIFTI' .and. msglvl .gt. 1) then call dvout (logfil, nconv, dr, ndigit, & '_neupd: Untransformed real part of the Ritz valuess.') call dvout (logfil, nconv, di, ndigit, & '_neupd: Untransformed imag part of the Ritz valuess.') call dvout (logfil, nconv, workl(ihbds), ndigit, & '_neupd: Ritz estimates of untransformed Ritz values.') else if (type .eq. 'REGULR' .and. msglvl .gt. 1) then call dvout (logfil, nconv, dr, ndigit, & '_neupd: Real parts of converged Ritz values.') call dvout (logfil, nconv, di, ndigit, & '_neupd: Imag parts of converged Ritz values.') call dvout (logfil, nconv, workl(ihbds), ndigit, & '_neupd: Associated Ritz estimates.') end if c c %-------------------------------------------------% c | Eigenvector Purification step. Formally perform | c | one of inverse subspace iteration. Only used | c | for MODE = 2. | c %-------------------------------------------------% c if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then c c %------------------------------------------------% c | Purify the computed Ritz vectors by adding a | c | little bit of the residual vector: | c | T | c | resid(:)*( e s ) / theta | c | NCV | c | where H s = s theta. Remember that when theta | c | has nonzero imaginary part, the corresponding | c | Ritz vector is stored across two columns of Z. | c %------------------------------------------------% c iconj = 0 do 110 j=1, nconv if (workl(iheigi+j-1) .eq. zero) then workev(j) = workl(invsub+(j-1)*ldq+ncv-1) / & workl(iheigr+j-1) else if (iconj .eq. 0) then temp = dlapy2 ( workl(iheigr+j-1), workl(iheigi+j-1) ) workev(j) = ( workl(invsub+(j-1)*ldq+ncv-1) * & workl(iheigr+j-1) + & workl(invsub+j*ldq+ncv-1) * & workl(iheigi+j-1) ) / temp / temp workev(j+1) = ( workl(invsub+j*ldq+ncv-1) * & workl(iheigr+j-1) - & workl(invsub+(j-1)*ldq+ncv-1) * & workl(iheigi+j-1) ) / temp / temp iconj = 1 else iconj = 0 end if 110 continue c c %---------------------------------------% c | Perform a rank one update to Z and | c | purify all the Ritz vectors together. | c %---------------------------------------% c call dger (n, nconv, one, resid, 1, workev, 1, z, ldz) c end if c 9000 continue c return c c %---------------% c | End of DNEUPD | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/zneupd.f000644 001750 001750 00000104544 11266605602 022132 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: zneupd c c\Description: c This subroutine returns the converged approximations to eigenvalues c of A*z = lambda*B*z and (optionally): c c (1) The corresponding approximate eigenvectors; c c (2) An orthonormal basis for the associated approximate c invariant subspace; c c (3) Both. c c There is negligible additional cost to obtain eigenvectors. An orthonormal c basis is always computed. There is an additional storage cost of n*nev c if both are requested (in this case a separate array Z must be supplied). c c The approximate eigenvalues and eigenvectors of A*z = lambda*B*z c are derived from approximate eigenvalues and eigenvectors of c of the linear operator OP prescribed by the MODE selection in the c call to ZNAUPD. ZNAUPD must be called before this routine is called. c These approximate eigenvalues and vectors are commonly called Ritz c values and Ritz vectors respectively. They are referred to as such c in the comments that follow. The computed orthonormal basis for the c invariant subspace corresponding to these Ritz values is referred to as a c Schur basis. c c The definition of OP as well as other terms and the relation of computed c Ritz values and vectors of OP with respect to the given problem c A*z = lambda*B*z may be found in the header of ZNAUPD. For a brief c description, see definitions of IPARAM(7), MODE and WHICH in the c documentation of ZNAUPD. c c\Usage: c call zneupd c ( RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, WORKEV, BMAT, c N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, c WORKL, LWORKL, RWORK, INFO ) c c\Arguments: c RVEC LOGICAL (INPUT) c Specifies whether a basis for the invariant subspace corresponding c to the converged Ritz value approximations for the eigenproblem c A*z = lambda*B*z is computed. c c RVEC = .FALSE. Compute Ritz values only. c c RVEC = .TRUE. Compute Ritz vectors or Schur vectors. c See Remarks below. c c HOWMNY Character*1 (INPUT) c Specifies the form of the basis for the invariant subspace c corresponding to the converged Ritz values that is to be computed. c c = 'A': Compute NEV Ritz vectors; c = 'P': Compute NEV Schur vectors; c = 'S': compute some of the Ritz vectors, specified c by the logical array SELECT. c c SELECT Logical array of dimension NCV. (INPUT) c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be c computed. To select the Ritz vector corresponding to a c Ritz value D(j), SELECT(j) must be set to .TRUE.. c If HOWMNY = 'A' or 'P', SELECT need not be initialized c but it is used as internal workspace. c c D Complex*16 array of dimension NEV+1. (OUTPUT) c On exit, D contains the Ritz approximations c to the eigenvalues lambda for A*z = lambda*B*z. c c Z Complex*16 N by NEV array (OUTPUT) c On exit, if RVEC = .TRUE. and HOWMNY = 'A', then the columns of c Z represents approximate eigenvectors (Ritz vectors) corresponding c to the NCONV=IPARAM(5) Ritz values for eigensystem c A*z = lambda*B*z. c c If RVEC = .FALSE. or HOWMNY = 'P', then Z is NOT REFERENCED. c c NOTE: If if RVEC = .TRUE. and a Schur basis is not required, c the array Z may be set equal to first NEV+1 columns of the Arnoldi c basis array V computed by ZNAUPD. In this case the Arnoldi basis c will be destroyed and overwritten with the eigenvector basis. c c LDZ Integer. (INPUT) c The leading dimension of the array Z. If Ritz vectors are c desired, then LDZ .ge. max( 1, N ) is required. c In any case, LDZ .ge. 1 is required. c c SIGMA Complex*16 (INPUT) c If IPARAM(7) = 3 then SIGMA represents the shift. c Not referenced if IPARAM(7) = 1 or 2. c c WORKEV Complex*16 work array of dimension 2*NCV. (WORKSPACE) c c **** The remaining arguments MUST be the same as for the **** c **** call to ZNAUPD that was just completed. **** c c NOTE: The remaining arguments c c BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, c WORKD, WORKL, LWORKL, RWORK, INFO c c must be passed directly to ZNEUPD following the last call c to ZNAUPD. These arguments MUST NOT BE MODIFIED between c the the last call to ZNAUPD and the call to ZNEUPD. c c Three of these parameters (V, WORKL and INFO) are also output parameters: c c V Complex*16 N by NCV array. (INPUT/OUTPUT) c c Upon INPUT: the NCV columns of V contain the Arnoldi basis c vectors for OP as constructed by ZNAUPD . c c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns c contain approximate Schur vectors that span the c desired invariant subspace. c c NOTE: If the array Z has been set equal to first NEV+1 columns c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the c Arnoldi basis held by V has been overwritten by the desired c Ritz vectors. If a separate array Z has been passed then c the first NCONV=IPARAM(5) columns of V will contain approximate c Schur vectors that span the desired invariant subspace. c c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) c WORKL(1:ncv*ncv+2*ncv) contains information obtained in c znaupd. They are not changed by zneupd. c WORKL(ncv*ncv+2*ncv+1:3*ncv*ncv+4*ncv) holds the c untransformed Ritz values, the untransformed error estimates of c the Ritz values, the upper triangular matrix for H, and the c associated matrix representation of the invariant subspace for H. c c Note: IPNTR(9:13) contains the pointer into WORKL for addresses c of the above information computed by zneupd. c ------------------------------------------------------------- c IPNTR(9): pointer to the NCV RITZ values of the c original system. c IPNTR(10): Not used c IPNTR(11): pointer to the NCV corresponding error estimates. c IPNTR(12): pointer to the NCV by NCV upper triangular c Schur matrix for H. c IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors c of the upper Hessenberg matrix H. Only referenced by c zneupd if RVEC = .TRUE. See Remark 2 below. c ------------------------------------------------------------- c c INFO Integer. (OUTPUT) c Error flag on output. c = 0: Normal exit. c c = 1: The Schur form computed by LAPACK routine csheqr c could not be reordered by LAPACK routine ztrsen. c Re-enter subroutine zneupd with IPARAM(5)=NCV and c increase the size of the array D to have c dimension at least dimension NCV and allocate at least NCV c columns for Z. NOTE: Not necessary if Z and V share c the same space. Please notify the authors if this error c occurs. c c = -1: N must be positive. c = -2: NEV must be positive. c = -3: NCV-NEV >= 1 and less than or equal to N. c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI' c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work WORKL array is not sufficient. c = -8: Error return from LAPACK eigenvalue calculation. c This should never happened. c = -9: Error return from calculation of eigenvectors. c Informational error from LAPACK routine ztrevc. c = -10: IPARAM(7) must be 1,2,3 c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible. c = -12: HOWMNY = 'S' not yet implemented c = -13: HOWMNY must be one of 'A' or 'P' if RVEC = .true. c = -14: ZNAUPD did not find any eigenvalues to sufficient c accuracy. c = -15: ZNEUPD got a different count of the number of converged c Ritz values than ZNAUPD got. This indicates the user c probably made an error in passing data from ZNAUPD to c ZNEUPD or that the data was modified before entering c ZNEUPD c c\BeginLib c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B. Nour-Omid, B. N. Parlett, T. Ericsson and P. S. Jensen, c "How to Implement the Spectral Transformation", Math Comp., c Vol. 48, No. 178, April, 1987 pp. 664-673. c c\Routines called: c ivout ARPACK utility routine that prints integers. c zmout ARPACK utility routine that prints matrices c zvout ARPACK utility routine that prints vectors. c zgeqr2 LAPACK routine that computes the QR factorization of c a matrix. c zlacpy LAPACK matrix copy routine. c zlahqr LAPACK routine that computes the Schur form of a c upper Hessenberg matrix. c zlaset LAPACK matrix initialization routine. c ztrevc LAPACK routine to compute the eigenvectors of a matrix c in upper triangular form. c ztrsen LAPACK routine that re-orders the Schur form. c zunm2r LAPACK routine that applies an orthogonal matrix in c factored form. c dlamch LAPACK routine that determines machine constants. c ztrmm Level 3 BLAS matrix times an upper triangular matrix. c zgeru Level 2 BLAS rank one update to a matrix. c zcopy Level 1 BLAS that copies one vector to another . c zscal Level 1 BLAS that scales a vector. c zdscal Level 1 BLAS that scales a complex vector by a real number. c dznrm2 Level 1 BLAS that computes the norm of a complex vector. c c\Remarks c c 1. Currently only HOWMNY = 'A' and 'P' are implemented. c c 2. Schur vectors are an orthogonal representation for the basis of c Ritz vectors. Thus, their numerical properties are often superior. c If RVEC = .true. then the relationship c A * V(:,1:IPARAM(5)) = V(:,1:IPARAM(5)) * T, and c transpose( V(:,1:IPARAM(5)) ) * V(:,1:IPARAM(5)) = I c are approximately satisfied. c Here T is the leading submatrix of order IPARAM(5) of the c upper triangular matrix stored workl(ipntr(12)). c c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Chao Yang Houston, Texas c Dept. of Computational & c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: neupd.F SID: 2.8 DATE OF SID: 07/21/02 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- subroutine zneupd(rvec , howmny, select, d , & z , ldz , sigma , workev, & bmat , n , which , nev , & tol , resid , ncv , v , & ldv , iparam, ipntr , workd , & workl, lworkl, rwork , info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat, howmny, which*2 logical rvec integer info, ldz, ldv, lworkl, n, ncv, nev Complex*16 & sigma Double precision & tol c c %-----------------% c | Array Arguments | c %-----------------% c integer iparam(11), ipntr(14) logical select(ncv) Double precision & rwork(ncv) Complex*16 & d(nev) , resid(n) , v(ldv,ncv), & z(ldz, nev), & workd(3*n) , workl(lworkl), workev(2*ncv) c c %------------% c | Parameters | c %------------% c Complex*16 & one, zero parameter (one = (1.0D+0, 0.0D+0), zero = (0.0D+0, 0.0D+0)) c c %---------------% c | Local Scalars | c %---------------% c character type*6 integer bounds, ierr , ih , ihbds, iheig , nconv , & invsub, iuptri, iwev , j , ldh , ldq , & mode , msglvl, ritz , wr , k , irz , & ibd , outncv, iq , np , numcnv, jj , & ishift Complex*16 & rnorm, temp, vl(1) Double precision & conds, sep, rtemp, eps23 logical reord c c %----------------------% c | External Subroutines | c %----------------------% c external zcopy , zgeru, zgeqr2, zlacpy, zmout, & zunm2r, ztrmm, zvout, ivout, & zlahqr c c %--------------------% c | External Functions | c %--------------------% c Double precision & dznrm2, dlamch, dlapy2 external dznrm2, dlamch, dlapy2 c Complex*16 & zdotc external zdotc c c %-----------------------% c | Executable Statements | c %-----------------------% c c %------------------------% c | Set default parameters | c %------------------------% c msglvl = mceupd mode = iparam(7) nconv = iparam(5) info = 0 c c c %---------------------------------% c | Get machine dependent constant. | c %---------------------------------% c eps23 = dlamch('Epsilon-Machine') eps23 = eps23**(2.0D+0 / 3.0D+0) c c %-------------------------------% c | Quick return | c | Check for incompatible input | c %-------------------------------% c ierr = 0 c if (nconv .le. 0) then ierr = -14 else if (n .le. 0) then ierr = -1 else if (nev .le. 0) then ierr = -2 else if (ncv .le. nev .or. ncv .gt. n) then ierr = -3 else if (which .ne. 'LM' .and. & which .ne. 'SM' .and. & which .ne. 'LR' .and. & which .ne. 'SR' .and. & which .ne. 'LI' .and. & which .ne. 'SI') then ierr = -5 else if (bmat .ne. 'I' .and. bmat .ne. 'G') then ierr = -6 else if (lworkl .lt. 3*ncv**2 + 4*ncv) then ierr = -7 else if ( (howmny .ne. 'A' .and. & howmny .ne. 'P' .and. & howmny .ne. 'S') .and. rvec ) then ierr = -13 else if (howmny .eq. 'S' ) then ierr = -12 end if c if (mode .eq. 1 .or. mode .eq. 2) then type = 'REGULR' else if (mode .eq. 3 ) then type = 'SHIFTI' else ierr = -10 end if if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11 c c %------------% c | Error Exit | c %------------% c if (ierr .ne. 0) then info = ierr go to 9000 end if c c %--------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, WORKEV, Q | c | etc... and the remaining workspace. | c | Also update pointer to be used on output. | c | Memory is laid out as follows: | c | workl(1:ncv*ncv) := generated Hessenberg matrix | c | workl(ncv*ncv+1:ncv*ncv+ncv) := ritz values | c | workl(ncv*ncv+ncv+1:ncv*ncv+2*ncv) := error bounds | c %--------------------------------------------------------% c c %-----------------------------------------------------------% c | The following is used and set by ZNEUPD. | c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := The untransformed | c | Ritz values. | c | workl(ncv*ncv+3*ncv+1:ncv*ncv+4*ncv) := The untransformed | c | error bounds of | c | the Ritz values | c | workl(ncv*ncv+4*ncv+1:2*ncv*ncv+4*ncv) := Holds the upper | c | triangular matrix | c | for H. | c | workl(2*ncv*ncv+4*ncv+1: 3*ncv*ncv+4*ncv) := Holds the | c | associated matrix | c | representation of | c | the invariant | c | subspace for H. | c | GRAND total of NCV * ( 3 * NCV + 4 ) locations. | c %-----------------------------------------------------------% c ih = ipntr(5) ritz = ipntr(6) iq = ipntr(7) bounds = ipntr(8) ldh = ncv ldq = ncv iheig = bounds + ldh ihbds = iheig + ldh iuptri = ihbds + ldh invsub = iuptri + ldh*ncv ipntr(9) = iheig ipntr(11) = ihbds ipntr(12) = iuptri ipntr(13) = invsub wr = 1 iwev = wr + ncv c c %-----------------------------------------% c | irz points to the Ritz values computed | c | by _neigh before exiting _naup2. | c | ibd points to the Ritz estimates | c | computed by _neigh before exiting | c | _naup2. | c %-----------------------------------------% c irz = ipntr(14) + ncv*ncv ibd = irz + ncv c c %------------------------------------% c | RNORM is B-norm of the RESID(1:N). | c %------------------------------------% c rnorm = workl(ih+2) workl(ih+2) = zero c if (msglvl .gt. 2) then call zvout(logfil, ncv, workl(irz), ndigit, & '_neupd: Ritz values passed in from _NAUPD.') call zvout(logfil, ncv, workl(ibd), ndigit, & '_neupd: Ritz estimates passed in from _NAUPD.') end if c if (rvec) then c reord = .false. c c %---------------------------------------------------% c | Use the temporary bounds array to store indices | c | These will be used to mark the select array later | c %---------------------------------------------------% c do 10 j = 1,ncv workl(bounds+j-1) = j select(j) = .false. 10 continue c c %-------------------------------------% c | Select the wanted Ritz values. | c | Sort the Ritz values so that the | c | wanted ones appear at the tailing | c | NEV positions of workl(irr) and | c | workl(iri). Move the corresponding | c | error estimates in workl(ibd) | c | accordingly. | c %-------------------------------------% c np = ncv - nev ishift = 0 call zngets(ishift, which , nev , & np , workl(irz), workl(bounds)) c if (msglvl .gt. 2) then call zvout (logfil, ncv, workl(irz), ndigit, & '_neupd: Ritz values after calling _NGETS.') call zvout (logfil, ncv, workl(bounds), ndigit, & '_neupd: Ritz value indices after calling _NGETS.') end if c c %-----------------------------------------------------% c | Record indices of the converged wanted Ritz values | c | Mark the select array for possible reordering | c %-----------------------------------------------------% c numcnv = 0 do 11 j = 1,ncv rtemp = max(eps23, & dlapy2 ( dble(workl(irz+ncv-j)), & dimag(workl(irz+ncv-j)) )) jj = workl(bounds + ncv - j) if (numcnv .lt. nconv .and. & dlapy2( dble(workl(ibd+jj-1)), & dimag(workl(ibd+jj-1)) ) & .le. tol*rtemp) then select(jj) = .true. numcnv = numcnv + 1 if (jj .gt. nev) reord = .true. endif 11 continue c c %-----------------------------------------------------------% c | Check the count (numcnv) of converged Ritz values with | c | the number (nconv) reported by dnaupd. If these two | c | are different then there has probably been an error | c | caused by incorrect passing of the dnaupd data. | c %-----------------------------------------------------------% c if (msglvl .gt. 2) then call ivout(logfil, 1, numcnv, ndigit, & '_neupd: Number of specified eigenvalues') call ivout(logfil, 1, nconv, ndigit, & '_neupd: Number of "converged" eigenvalues') end if c if (numcnv .ne. nconv) then info = -15 go to 9000 end if c c %-------------------------------------------------------% c | Call LAPACK routine zlahqr to compute the Schur form | c | of the upper Hessenberg matrix returned by ZNAUPD. | c | Make a copy of the upper Hessenberg matrix. | c | Initialize the Schur vector matrix Q to the identity. | c %-------------------------------------------------------% c call zcopy(ldh*ncv, workl(ih), 1, workl(iuptri), 1) call zlaset('All', ncv, ncv , & zero , one, workl(invsub), & ldq) call zlahqr(.true., .true. , ncv , & 1 , ncv , workl(iuptri), & ldh , workl(iheig) , 1 , & ncv , workl(invsub), ldq , & ierr) call zcopy(ncv , workl(invsub+ncv-1), ldq, & workl(ihbds), 1) c if (ierr .ne. 0) then info = -8 go to 9000 end if c if (msglvl .gt. 1) then call zvout (logfil, ncv, workl(iheig), ndigit, & '_neupd: Eigenvalues of H') call zvout (logfil, ncv, workl(ihbds), ndigit, & '_neupd: Last row of the Schur vector matrix') if (msglvl .gt. 3) then call zmout (logfil , ncv, ncv , & workl(iuptri), ldh, ndigit, & '_neupd: The upper triangular matrix ') end if end if c if (reord) then c c %-----------------------------------------------% c | Reorder the computed upper triangular matrix. | c %-----------------------------------------------% c call ztrsen('None' , 'V' , select , & ncv , workl(iuptri), ldh , & workl(invsub), ldq , workl(iheig), & nconv , conds , sep , & workev , ncv , ierr) c if (ierr .eq. 1) then info = 1 go to 9000 end if c if (msglvl .gt. 2) then call zvout (logfil, ncv, workl(iheig), ndigit, & '_neupd: Eigenvalues of H--reordered') if (msglvl .gt. 3) then call zmout(logfil , ncv, ncv , & workl(iuptri), ldq, ndigit, & '_neupd: Triangular matrix after re-ordering') end if end if c end if c c %---------------------------------------------% c | Copy the last row of the Schur basis matrix | c | to workl(ihbds). This vector will be used | c | to compute the Ritz estimates of converged | c | Ritz values. | c %---------------------------------------------% c call zcopy(ncv , workl(invsub+ncv-1), ldq, & workl(ihbds), 1) c c %--------------------------------------------% c | Place the computed eigenvalues of H into D | c | if a spectral transformation was not used. | c %--------------------------------------------% c if (type .eq. 'REGULR') then call zcopy(nconv, workl(iheig), 1, d, 1) end if c c %----------------------------------------------------------% c | Compute the QR factorization of the matrix representing | c | the wanted invariant subspace located in the first NCONV | c | columns of workl(invsub,ldq). | c %----------------------------------------------------------% c call zgeqr2(ncv , nconv , workl(invsub), & ldq , workev, workev(ncv+1), & ierr) c c %--------------------------------------------------------% c | * Postmultiply V by Q using zunm2r. | c | * Copy the first NCONV columns of VQ into Z. | c | * Postmultiply Z by R. | c | The N by NCONV matrix Z is now a matrix representation | c | of the approximate invariant subspace associated with | c | the Ritz values in workl(iheig). The first NCONV | c | columns of V are now approximate Schur vectors | c | associated with the upper triangular matrix of order | c | NCONV in workl(iuptri). | c %--------------------------------------------------------% c call zunm2r('Right', 'Notranspose', n , & ncv , nconv , workl(invsub), & ldq , workev , v , & ldv , workd(n+1) , ierr) call zlacpy('All', n, nconv, v, ldv, z, ldz) c do 20 j=1, nconv c c %---------------------------------------------------% c | Perform both a column and row scaling if the | c | diagonal element of workl(invsub,ldq) is negative | c | I'm lazy and don't take advantage of the upper | c | triangular form of workl(iuptri,ldq). | c | Note that since Q is orthogonal, R is a diagonal | c | matrix consisting of plus or minus ones. | c %---------------------------------------------------% c if ( dble( workl(invsub+(j-1)*ldq+j-1) ) .lt. & dble(zero) ) then call zscal(nconv, -one, workl(iuptri+j-1), ldq) call zscal(nconv, -one, workl(iuptri+(j-1)*ldq), 1) end if c 20 continue c if (howmny .eq. 'A') then c c %--------------------------------------------% c | Compute the NCONV wanted eigenvectors of T | c | located in workl(iuptri,ldq). | c %--------------------------------------------% c do 30 j=1, ncv if (j .le. nconv) then select(j) = .true. else select(j) = .false. end if 30 continue c call ztrevc('Right', 'Select' , select , & ncv , workl(iuptri), ldq , & vl , 1 , workl(invsub), & ldq , ncv , outncv , & workev , rwork , ierr) c if (ierr .ne. 0) then info = -9 go to 9000 end if c c %------------------------------------------------% c | Scale the returning eigenvectors so that their | c | Euclidean norms are all one. LAPACK subroutine | c | ztrevc returns each eigenvector normalized so | c | that the element of largest magnitude has | c | magnitude 1. | c %------------------------------------------------% c do 40 j=1, nconv rtemp = dznrm2(ncv, workl(invsub+(j-1)*ldq), 1) rtemp = dble(one) / rtemp call zdscal ( ncv, rtemp, & workl(invsub+(j-1)*ldq), 1 ) c c %------------------------------------------% c | Ritz estimates can be obtained by taking | c | the inner product of the last row of the | c | Schur basis of H with eigenvectors of T. | c | Note that the eigenvector matrix of T is | c | upper triangular, thus the length of the | c | inner product can be set to j. | c %------------------------------------------% c c FIXME GetDP: don't use zdotc on Apple with gfortran c workev(j) = zdotc(j, workl(ihbds), 1, c & workl(invsub+(j-1)*ldq), 1) workev(j) = 0 do 41 k=1, j workev(j) = workev(j) + conjg(workl(ihbds)+k-1) * & workl(invsub+(j-1)*ldq+k-1) 41 continue c END OF FIXME 40 continue c if (msglvl .gt. 2) then call zcopy(nconv, workl(invsub+ncv-1), ldq, & workl(ihbds), 1) call zvout (logfil, nconv, workl(ihbds), ndigit, & '_neupd: Last row of the eigenvector matrix for T') if (msglvl .gt. 3) then call zmout(logfil , ncv, ncv , & workl(invsub), ldq, ndigit, & '_neupd: The eigenvector matrix for T') end if end if c c %---------------------------------------% c | Copy Ritz estimates into workl(ihbds) | c %---------------------------------------% c call zcopy(nconv, workev, 1, workl(ihbds), 1) c c %----------------------------------------------% c | The eigenvector matrix Q of T is triangular. | c | Form Z*Q. | c %----------------------------------------------% c call ztrmm('Right' , 'Upper' , 'No transpose', & 'Non-unit', n , nconv , & one , workl(invsub), ldq , & z , ldz) end if c else c c %--------------------------------------------------% c | An approximate invariant subspace is not needed. | c | Place the Ritz values computed ZNAUPD into D. | c %--------------------------------------------------% c call zcopy(nconv, workl(ritz), 1, d, 1) call zcopy(nconv, workl(ritz), 1, workl(iheig), 1) call zcopy(nconv, workl(bounds), 1, workl(ihbds), 1) c end if c c %------------------------------------------------% c | Transform the Ritz values and possibly vectors | c | and corresponding error bounds of OP to those | c | of A*x = lambda*B*x. | c %------------------------------------------------% c if (type .eq. 'REGULR') then c if (rvec) & call zscal(ncv, rnorm, workl(ihbds), 1) c else c c %---------------------------------------% c | A spectral transformation was used. | c | * Determine the Ritz estimates of the | c | Ritz values in the original system. | c %---------------------------------------% c if (rvec) & call zscal(ncv, rnorm, workl(ihbds), 1) c do 50 k=1, ncv temp = workl(iheig+k-1) workl(ihbds+k-1) = workl(ihbds+k-1) / temp / temp 50 continue c end if c c %-----------------------------------------------------------% c | * Transform the Ritz values back to the original system. | c | For TYPE = 'SHIFTI' the transformation is | c | lambda = 1/theta + sigma | c | NOTES: | c | *The Ritz vectors are not affected by the transformation. | c %-----------------------------------------------------------% c if (type .eq. 'SHIFTI') then do 60 k=1, nconv d(k) = one / workl(iheig+k-1) + sigma 60 continue end if c if (type .ne. 'REGULR' .and. msglvl .gt. 1) then call zvout (logfil, nconv, d, ndigit, & '_neupd: Untransformed Ritz values.') call zvout (logfil, nconv, workl(ihbds), ndigit, & '_neupd: Ritz estimates of the untransformed Ritz values.') else if ( msglvl .gt. 1) then call zvout (logfil, nconv, d, ndigit, & '_neupd: Converged Ritz values.') call zvout (logfil, nconv, workl(ihbds), ndigit, & '_neupd: Associated Ritz estimates.') end if c c %-------------------------------------------------% c | Eigenvector Purification step. Formally perform | c | one of inverse subspace iteration. Only used | c | for MODE = 3. See reference 3. | c %-------------------------------------------------% c if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then c c %------------------------------------------------% c | Purify the computed Ritz vectors by adding a | c | little bit of the residual vector: | c | T | c | resid(:)*( e s ) / theta | c | NCV | c | where H s = s theta. | c %------------------------------------------------% c do 100 j=1, nconv if (workl(iheig+j-1) .ne. zero) then workev(j) = workl(invsub+(j-1)*ldq+ncv-1) / & workl(iheig+j-1) endif 100 continue c %---------------------------------------% c | Perform a rank one update to Z and | c | purify all the Ritz vectors together. | c %---------------------------------------% c call zgeru (n, nconv, one, resid, 1, workev, 1, z, ldz) c end if c 9000 continue c return c c %---------------% c | End of zneupd| c %---------------% c end getdp-2.7.0-source/contrib/Arpack/debug.h000644 001750 001750 00000001351 11266605602 021705 0ustar00geuzainegeuzaine000000 000000 c c\SCCS Information: @(#) c FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2 c c %---------------------------------% c | See debug.doc for documentation | c %---------------------------------% integer logfil, ndigit, mgetv0, & msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd, & mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd, & mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd common /debug/ & logfil, ndigit, mgetv0, & msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd, & mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd, & mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd getdp-2.7.0-source/contrib/Arpack/znaup2.f000644 001750 001750 00000071342 11266605602 022043 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: znaup2 c c\Description: c Intermediate level interface called by znaupd . c c\Usage: c call znaup2 c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD, c ISHIFT, MXITER, V, LDV, H, LDH, RITZ, BOUNDS, c Q, LDQ, WORKL, IPNTR, WORKD, RWORK, INFO ) c c\Arguments c c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in znaupd . c MODE, ISHIFT, MXITER: see the definition of IPARAM in znaupd . c c NP Integer. (INPUT/OUTPUT) c Contains the number of implicit shifts to apply during c each Arnoldi iteration. c If ISHIFT=1, NP is adjusted dynamically at each iteration c to accelerate convergence and prevent stagnation. c This is also roughly equal to the number of matrix-vector c products (involving the operator OP) per Arnoldi iteration. c The logic for adjusting is contained within the current c subroutine. c If ISHIFT=0, NP is the number of shifts the user needs c to provide via reverse comunication. 0 < NP < NCV-NEV. c NP may be less than NCV-NEV since a leading block of the current c upper Hessenberg matrix has split off and contains "unwanted" c Ritz values. c Upon termination of the IRA iteration, NP contains the number c of "converged" wanted Ritz values. c c IUPD Integer. (INPUT) c IUPD .EQ. 0: use explicit restart instead implicit update. c IUPD .NE. 0: use implicit update. c c V Complex*16 N by (NEV+NP) array. (INPUT/OUTPUT) c The Arnoldi basis vectors are returned in the first NEV c columns of V. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Complex*16 (NEV+NP) by (NEV+NP) array. (OUTPUT) c H is used to store the generated upper Hessenberg matrix c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RITZ Complex*16 array of length NEV+NP. (OUTPUT) c RITZ(1:NEV) contains the computed Ritz values of OP. c c BOUNDS Complex*16 array of length NEV+NP. (OUTPUT) c BOUNDS(1:NEV) contain the error bounds corresponding to c the computed Ritz values. c c Q Complex*16 (NEV+NP) by (NEV+NP) array. (WORKSPACE) c Private (replicated) work array used to accumulate the c rotation in the shift application step. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKL Complex*16 work array of length at least c (NEV+NP)**2 + 3*(NEV+NP). (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. It is used in shifts calculation, shifts c application and convergence checking. c c c IPNTR Integer array of length 3. (OUTPUT) c Pointer to mark the starting locations in the WORKD for c vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. c IPNTR(3): pointer to the vector B * X when used in the c shift-and-invert mode. X is the current operand. c ------------------------------------------------------------- c c WORKD Complex*16 work array of length 3*N. (WORKSPACE) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration !!!!!!!!!! c See Data Distribution Note in ZNAUPD . c c RWORK Double precision work array of length NEV+NP ( WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. c c INFO Integer. (INPUT/OUTPUT) c If INFO .EQ. 0, a randomly initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c Error flag on output. c = 0: Normal return. c = 1: Maximum number of iterations taken. c All possible eigenvalues of OP has been found. c NP returns the number of converged Ritz values. c = 2: No shifts could be applied. c = -8: Error return from LAPACK eigenvalue calculation; c This should never happen. c = -9: Starting vector is zero. c = -9999: Could not build an Arnoldi factorization. c Size that was built in returned in NP. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx Complex*16 c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: c zgetv0 ARPACK initial vector generation routine. c znaitr ARPACK Arnoldi factorization routine. c znapps ARPACK application of implicit shifts routine. c zneigh ARPACK compute Ritz values and error bounds routine. c zngets ARPACK reorder Ritz values and error bounds routine. c zsortc ARPACK sorting routine. c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c zmout ARPACK utility routine that prints matrices c zvout ARPACK utility routine that prints vectors. c dvout ARPACK utility routine that prints vectors. c dlamch LAPACK routine that determines machine constants. c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c zcopy Level 1 BLAS that copies one vector to another . c zdotc Level 1 BLAS that computes the scalar product of two vectors. c zswap Level 1 BLAS that swaps two vectors. c dznrm2 Level 1 BLAS that computes the norm of a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice Universitya c Chao Yang Houston, Texas c Dept. of Computational & c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: naup2.F SID: 2.6 DATE OF SID: 06/01/00 RELEASE: 2 c c\Remarks c 1. None c c\EndLib c c----------------------------------------------------------------------- c subroutine znaup2 & ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd, & ishift, mxiter, v, ldv, h, ldh, ritz, bounds, & q, ldq, workl, ipntr, workd, rwork, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1, which*2 integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter, & n, nev, np Double precision & tol c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(13) Complex*16 & bounds(nev+np), h(ldh,nev+np), q(ldq,nev+np), & resid(n), ritz(nev+np), v(ldv,nev+np), & workd(3*n), workl( (nev+np)*(nev+np+3) ) Double precision & rwork(nev+np) c c %------------% c | Parameters | c %------------% c Complex*16 & one, zero Double precision & rzero parameter (one = (1.0D+0, 0.0D+0) , zero = (0.0D+0, 0.0D+0) , & rzero = 0.0D+0 ) c c %---------------% c | Local Scalars | c %---------------% c logical cnorm , getv0, initv , update, ushift integer ierr , iter , kplusp, msglvl, nconv, & nevbef, nev0 , np0 , nptemp, i , & j Complex*16 & cmpnorm Double precision & rnorm , eps23, rtemp character wprime*2 c save cnorm, getv0, initv , update, ushift, & rnorm, iter , kplusp, msglvl, nconv , & nevbef, nev0 , np0 , eps23 c c c %-----------------------% c | Local array arguments | c %-----------------------% c integer kp(3) c c %----------------------% c | External Subroutines | c %----------------------% c external zcopy , zgetv0 , znaitr , zneigh , zngets , znapps , & zsortc , zswap , zmout , zvout , ivout, second c c %--------------------% c | External functions | c %--------------------% c Complex*16 & zdotc Double precision & dznrm2 , dlamch , dlapy2 external zdotc , dznrm2 , dlamch , dlapy2 c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic dimag , dble , min, max c c %-----------------------% c | Executable Statements | c %-----------------------% c if (ido .eq. 0) then c call second (t0) c msglvl = mcaup2 c nev0 = nev np0 = np c c %-------------------------------------% c | kplusp is the bound on the largest | c | Lanczos factorization built. | c | nconv is the current number of | c | "converged" eigenvalues. | c | iter is the counter on the current | c | iteration step. | c %-------------------------------------% c kplusp = nev + np nconv = 0 iter = 0 c c %---------------------------------% c | Get machine dependent constant. | c %---------------------------------% c eps23 = dlamch ('Epsilon-Machine') eps23 = eps23**(2.0D+0 / 3.0D+0 ) c c %---------------------------------------% c | Set flags for computing the first NEV | c | steps of the Arnoldi factorization. | c %---------------------------------------% c getv0 = .true. update = .false. ushift = .false. cnorm = .false. c if (info .ne. 0) then c c %--------------------------------------------% c | User provides the initial residual vector. | c %--------------------------------------------% c initv = .true. info = 0 else initv = .false. end if end if c c %---------------------------------------------% c | Get a possibly random starting vector and | c | force it into the range of the operator OP. | c %---------------------------------------------% c 10 continue c if (getv0) then call zgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, rnorm, & ipntr, workd, info) c if (ido .ne. 99) go to 9000 c if (rnorm .eq. rzero) then c c %-----------------------------------------% c | The initial vector is zero. Error exit. | c %-----------------------------------------% c info = -9 go to 1100 end if getv0 = .false. ido = 0 end if c c %-----------------------------------% c | Back from reverse communication : | c | continue with update step | c %-----------------------------------% c if (update) go to 20 c c %-------------------------------------------% c | Back from computing user specified shifts | c %-------------------------------------------% c if (ushift) go to 50 c c %-------------------------------------% c | Back from computing residual norm | c | at the end of the current iteration | c %-------------------------------------% c if (cnorm) go to 100 c c %----------------------------------------------------------% c | Compute the first NEV steps of the Arnoldi factorization | c %----------------------------------------------------------% c call znaitr (ido, bmat, n, 0, nev, mode, resid, rnorm, v, ldv, & h, ldh, ipntr, workd, info) c if (ido .ne. 99) go to 9000 c if (info .gt. 0) then np = info mxiter = iter info = -9999 go to 1200 end if c c %--------------------------------------------------------------% c | | c | M A I N ARNOLDI I T E R A T I O N L O O P | c | Each iteration implicitly restarts the Arnoldi | c | factorization in place. | c | | c %--------------------------------------------------------------% c 1000 continue c iter = iter + 1 c if (msglvl .gt. 0) then call ivout (logfil, 1, iter, ndigit, & '_naup2: **** Start of major iteration number ****') end if c c %-----------------------------------------------------------% c | Compute NP additional steps of the Arnoldi factorization. | c | Adjust NP since NEV might have been updated by last call | c | to the shift application routine znapps . | c %-----------------------------------------------------------% c np = kplusp - nev c if (msglvl .gt. 1) then call ivout (logfil, 1, nev, ndigit, & '_naup2: The length of the current Arnoldi factorization') call ivout (logfil, 1, np, ndigit, & '_naup2: Extend the Arnoldi factorization by') end if c c %-----------------------------------------------------------% c | Compute NP additional steps of the Arnoldi factorization. | c %-----------------------------------------------------------% c ido = 0 20 continue update = .true. c call znaitr (ido, bmat, n, nev, np, mode, resid, rnorm, & v , ldv , h, ldh, ipntr, workd, info) c if (ido .ne. 99) go to 9000 c if (info .gt. 0) then np = info mxiter = iter info = -9999 go to 1200 end if update = .false. c if (msglvl .gt. 1) then call dvout (logfil, 1, rnorm, ndigit, & '_naup2: Corresponding B-norm of the residual') end if c c %--------------------------------------------------------% c | Compute the eigenvalues and corresponding error bounds | c | of the current upper Hessenberg matrix. | c %--------------------------------------------------------% c call zneigh (rnorm, kplusp, h, ldh, ritz, bounds, & q, ldq, workl, rwork, ierr) c if (ierr .ne. 0) then info = -8 go to 1200 end if c c %---------------------------------------------------% c | Select the wanted Ritz values and their bounds | c | to be used in the convergence test. | c | The wanted part of the spectrum and corresponding | c | error bounds are in the last NEV loc. of RITZ, | c | and BOUNDS respectively. | c %---------------------------------------------------% c nev = nev0 np = np0 c c %--------------------------------------------------% c | Make a copy of Ritz values and the corresponding | c | Ritz estimates obtained from zneigh . | c %--------------------------------------------------% c call zcopy (kplusp,ritz,1,workl(kplusp**2+1),1) call zcopy (kplusp,bounds,1,workl(kplusp**2+kplusp+1),1) c c %---------------------------------------------------% c | Select the wanted Ritz values and their bounds | c | to be used in the convergence test. | c | The wanted part of the spectrum and corresponding | c | bounds are in the last NEV loc. of RITZ | c | BOUNDS respectively. | c %---------------------------------------------------% c call zngets (ishift, which, nev, np, ritz, bounds) c c %------------------------------------------------------------% c | Convergence test: currently we use the following criteria. | c | The relative accuracy of a Ritz value is considered | c | acceptable if: | c | | c | error_bounds(i) .le. tol*max(eps23, magnitude_of_ritz(i)). | c | | c %------------------------------------------------------------% c nconv = 0 c do 25 i = 1, nev rtemp = max( eps23, dlapy2 ( dble (ritz(np+i)), & dimag (ritz(np+i)) ) ) if ( dlapy2 (dble (bounds(np+i)),dimag (bounds(np+i))) & .le. tol*rtemp ) then nconv = nconv + 1 end if 25 continue c if (msglvl .gt. 2) then kp(1) = nev kp(2) = np kp(3) = nconv call ivout (logfil, 3, kp, ndigit, & '_naup2: NEV, NP, NCONV are') call zvout (logfil, kplusp, ritz, ndigit, & '_naup2: The eigenvalues of H') call zvout (logfil, kplusp, bounds, ndigit, & '_naup2: Ritz estimates of the current NCV Ritz values') end if c c %---------------------------------------------------------% c | Count the number of unwanted Ritz values that have zero | c | Ritz estimates. If any Ritz estimates are equal to zero | c | then a leading block of H of order equal to at least | c | the number of Ritz values with zero Ritz estimates has | c | split off. None of these Ritz values may be removed by | c | shifting. Decrease NP the number of shifts to apply. If | c | no shifts may be applied, then prepare to exit | c %---------------------------------------------------------% c nptemp = np do 30 j=1, nptemp if (bounds(j) .eq. zero) then np = np - 1 nev = nev + 1 end if 30 continue c if ( (nconv .ge. nev0) .or. & (iter .gt. mxiter) .or. & (np .eq. 0) ) then c if (msglvl .gt. 4) then call zvout (logfil, kplusp, workl(kplusp**2+1), ndigit, & '_naup2: Eigenvalues computed by _neigh:') call zvout (logfil, kplusp, workl(kplusp**2+kplusp+1), & ndigit, & '_naup2: Ritz estimates computed by _neigh:') end if c c %------------------------------------------------% c | Prepare to exit. Put the converged Ritz values | c | and corresponding bounds in RITZ(1:NCONV) and | c | BOUNDS(1:NCONV) respectively. Then sort. Be | c | careful when NCONV > NP | c %------------------------------------------------% c c %------------------------------------------% c | Use h( 3,1 ) as storage to communicate | c | rnorm to zneupd if needed | c %------------------------------------------% h(3,1) = dcmplx (rnorm,rzero) c c %----------------------------------------------% c | Sort Ritz values so that converged Ritz | c | values appear within the first NEV locations | c | of ritz and bounds, and the most desired one | c | appears at the front. | c %----------------------------------------------% c if (which .eq. 'LM') wprime = 'SM' if (which .eq. 'SM') wprime = 'LM' if (which .eq. 'LR') wprime = 'SR' if (which .eq. 'SR') wprime = 'LR' if (which .eq. 'LI') wprime = 'SI' if (which .eq. 'SI') wprime = 'LI' c call zsortc (wprime, .true., kplusp, ritz, bounds) c c %--------------------------------------------------% c | Scale the Ritz estimate of each Ritz value | c | by 1 / max(eps23, magnitude of the Ritz value). | c %--------------------------------------------------% c do 35 j = 1, nev0 rtemp = max( eps23, dlapy2 ( dble (ritz(j)), & dimag (ritz(j)) ) ) bounds(j) = bounds(j)/rtemp 35 continue c c %---------------------------------------------------% c | Sort the Ritz values according to the scaled Ritz | c | estimates. This will push all the converged ones | c | towards the front of ritz, bounds (in the case | c | when NCONV < NEV.) | c %---------------------------------------------------% c wprime = 'LM' call zsortc (wprime, .true., nev0, bounds, ritz) c c %----------------------------------------------% c | Scale the Ritz estimate back to its original | c | value. | c %----------------------------------------------% c do 40 j = 1, nev0 rtemp = max( eps23, dlapy2 ( dble (ritz(j)), & dimag (ritz(j)) ) ) bounds(j) = bounds(j)*rtemp 40 continue c c %-----------------------------------------------% c | Sort the converged Ritz values again so that | c | the "threshold" value appears at the front of | c | ritz and bound. | c %-----------------------------------------------% c call zsortc (which, .true., nconv, ritz, bounds) c if (msglvl .gt. 1) then call zvout (logfil, kplusp, ritz, ndigit, & '_naup2: Sorted eigenvalues') call zvout (logfil, kplusp, bounds, ndigit, & '_naup2: Sorted ritz estimates.') end if c c %------------------------------------% c | Max iterations have been exceeded. | c %------------------------------------% c if (iter .gt. mxiter .and. nconv .lt. nev0) info = 1 c c %---------------------% c | No shifts to apply. | c %---------------------% c if (np .eq. 0 .and. nconv .lt. nev0) info = 2 c np = nconv go to 1100 c else if ( (nconv .lt. nev0) .and. (ishift .eq. 1) ) then c c %-------------------------------------------------% c | Do not have all the requested eigenvalues yet. | c | To prevent possible stagnation, adjust the size | c | of NEV. | c %-------------------------------------------------% c nevbef = nev nev = nev + min(nconv, np/2) if (nev .eq. 1 .and. kplusp .ge. 6) then nev = kplusp / 2 else if (nev .eq. 1 .and. kplusp .gt. 3) then nev = 2 end if np = kplusp - nev c c %---------------------------------------% c | If the size of NEV was just increased | c | resort the eigenvalues. | c %---------------------------------------% c if (nevbef .lt. nev) & call zngets (ishift, which, nev, np, ritz, bounds) c end if c if (msglvl .gt. 0) then call ivout (logfil, 1, nconv, ndigit, & '_naup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev kp(2) = np call ivout (logfil, 2, kp, ndigit, & '_naup2: NEV and NP are') call zvout (logfil, nev, ritz(np+1), ndigit, & '_naup2: "wanted" Ritz values ') call zvout (logfil, nev, bounds(np+1), ndigit, & '_naup2: Ritz estimates of the "wanted" values ') end if end if c if (ishift .eq. 0) then c c %-------------------------------------------------------% c | User specified shifts: pop back out to get the shifts | c | and return them in the first 2*NP locations of WORKL. | c %-------------------------------------------------------% c ushift = .true. ido = 3 go to 9000 end if 50 continue ushift = .false. c if ( ishift .ne. 1 ) then c c %----------------------------------% c | Move the NP shifts from WORKL to | c | RITZ, to free up WORKL | c | for non-exact shift case. | c %----------------------------------% c call zcopy (np, workl, 1, ritz, 1) end if c if (msglvl .gt. 2) then call ivout (logfil, 1, np, ndigit, & '_naup2: The number of shifts to apply ') call zvout (logfil, np, ritz, ndigit, & '_naup2: values of the shifts') if ( ishift .eq. 1 ) & call zvout (logfil, np, bounds, ndigit, & '_naup2: Ritz estimates of the shifts') end if c c %---------------------------------------------------------% c | Apply the NP implicit shifts by QR bulge chasing. | c | Each shift is applied to the whole upper Hessenberg | c | matrix H. | c | The first 2*N locations of WORKD are used as workspace. | c %---------------------------------------------------------% c call znapps (n, nev, np, ritz, v, ldv, & h, ldh, resid, q, ldq, workl, workd) c c %---------------------------------------------% c | Compute the B-norm of the updated residual. | c | Keep B*RESID in WORKD(1:N) to be used in | c | the first step of the next call to znaitr . | c %---------------------------------------------% c cnorm = .true. call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call zcopy (n, resid, 1, workd(n+1), 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 c c %----------------------------------% c | Exit in order to compute B*RESID | c %----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call zcopy (n, resid, 1, workd, 1) end if c 100 continue c c %----------------------------------% c | Back from reverse communication; | c | WORKD(1:N) := B*RESID | c %----------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c if (bmat .eq. 'G') then cmpnorm = zdotc (n, resid, 1, workd, 1) rnorm = sqrt(dlapy2 (dble (cmpnorm),dimag (cmpnorm))) else if (bmat .eq. 'I') then rnorm = dznrm2 (n, resid, 1) end if cnorm = .false. c if (msglvl .gt. 2) then call dvout (logfil, 1, rnorm, ndigit, & '_naup2: B-norm of residual for compressed factorization') call zmout (logfil, nev, nev, h, ldh, ndigit, & '_naup2: Compressed upper Hessenberg matrix H') end if c go to 1000 c c %---------------------------------------------------------------% c | | c | E N D O F M A I N I T E R A T I O N L O O P | c | | c %---------------------------------------------------------------% c 1100 continue c mxiter = iter nev = nconv c 1200 continue ido = 99 c c %------------% c | Error Exit | c %------------% c call second (t1) tcaup2 = t1 - t0 c 9000 continue c c %---------------% c | End of znaup2 | c %---------------% c return end getdp-2.7.0-source/contrib/Arpack/dsgets.f000644 001750 001750 00000016435 11266605602 022117 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: dsgets c c\Description: c Given the eigenvalues of the symmetric tridiagonal matrix H, c computes the NP shifts AMU that are zeros of the polynomial of c degree NP which filters out components of the unwanted eigenvectors c corresponding to the AMU's based on some given criteria. c c NOTE: This is called even in the case of user specified shifts in c order to sort the eigenvalues, and error bounds of H for later use. c c\Usage: c call dsgets c ( ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS, SHIFTS ) c c\Arguments c ISHIFT Integer. (INPUT) c Method for selecting the implicit shifts at each iteration. c ISHIFT = 0: user specified shifts c ISHIFT = 1: exact shift with respect to the matrix H. c c WHICH Character*2. (INPUT) c Shift selection criteria. c 'LM' -> KEV eigenvalues of largest magnitude are retained. c 'SM' -> KEV eigenvalues of smallest magnitude are retained. c 'LA' -> KEV eigenvalues of largest value are retained. c 'SA' -> KEV eigenvalues of smallest value are retained. c 'BE' -> KEV eigenvalues, half from each end of the spectrum. c If KEV is odd, compute one more from the high end. c c KEV Integer. (INPUT) c KEV+NP is the size of the matrix H. c c NP Integer. (INPUT) c Number of implicit shifts to be computed. c c RITZ Double precision array of length KEV+NP. (INPUT/OUTPUT) c On INPUT, RITZ contains the eigenvalues of H. c On OUTPUT, RITZ are sorted so that the unwanted eigenvalues c are in the first NP locations and the wanted part is in c the last KEV locations. When exact shifts are selected, the c unwanted part corresponds to the shifts to be applied. c c BOUNDS Double precision array of length KEV+NP. (INPUT/OUTPUT) c Error bounds corresponding to the ordering in RITZ. c c SHIFTS Double precision array of length NP. (INPUT/OUTPUT) c On INPUT: contains the user specified shifts if ISHIFT = 0. c On OUTPUT: contains the shifts sorted into decreasing order c of magnitude with respect to the Ritz estimates contained in c BOUNDS. If ISHIFT = 0, SHIFTS is not modified on exit. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c dsortr ARPACK utility sorting routine. c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c dvout ARPACK utility routine that prints vectors. c dcopy Level 1 BLAS that copies one vector to another. c dswap Level 1 BLAS that swaps the contents of two vectors. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/93: Version ' 2.1' c c\SCCS Information: @(#) c FILE: sgets.F SID: 2.4 DATE OF SID: 4/19/96 RELEASE: 2 c c\Remarks c c\EndLib c c----------------------------------------------------------------------- c subroutine dsgets ( ishift, which, kev, np, ritz, bounds, shifts ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which integer ishift, kev, np c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & bounds(kev+np), ritz(kev+np), shifts(np) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c integer kevd2, msglvl c c %----------------------% c | External Subroutines | c %----------------------% c external dswap, dcopy, dsortr, second c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic max, min c c %-----------------------% c | Executable Statements | c %-----------------------% c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = msgets c if (which .eq. 'BE') then c c %-----------------------------------------------------% c | Both ends of the spectrum are requested. | c | Sort the eigenvalues into algebraically increasing | c | order first then swap high end of the spectrum next | c | to low end in appropriate locations. | c | NOTE: when np < floor(kev/2) be careful not to swap | c | overlapping locations. | c %-----------------------------------------------------% c call dsortr ('LA', .true., kev+np, ritz, bounds) kevd2 = kev / 2 if ( kev .gt. 1 ) then call dswap ( min(kevd2,np), ritz, 1, & ritz( max(kevd2,np)+1 ), 1) call dswap ( min(kevd2,np), bounds, 1, & bounds( max(kevd2,np)+1 ), 1) end if c else c c %----------------------------------------------------% c | LM, SM, LA, SA case. | c | Sort the eigenvalues of H into the desired order | c | and apply the resulting order to BOUNDS. | c | The eigenvalues are sorted so that the wanted part | c | are always in the last KEV locations. | c %----------------------------------------------------% c call dsortr (which, .true., kev+np, ritz, bounds) end if c if (ishift .eq. 1 .and. np .gt. 0) then c c %-------------------------------------------------------% c | Sort the unwanted Ritz values used as shifts so that | c | the ones with largest Ritz estimates are first. | c | This will tend to minimize the effects of the | c | forward instability of the iteration when the shifts | c | are applied in subroutine dsapps. | c %-------------------------------------------------------% c call dsortr ('SM', .true., np, bounds, ritz) call dcopy (np, ritz, 1, shifts, 1) end if c call second (t1) tsgets = tsgets + (t1 - t0) c if (msglvl .gt. 0) then call ivout (logfil, 1, kev, ndigit, '_sgets: KEV is') call ivout (logfil, 1, np, ndigit, '_sgets: NP is') call dvout (logfil, kev+np, ritz, ndigit, & '_sgets: Eigenvalues of current H matrix') call dvout (logfil, kev+np, bounds, ndigit, & '_sgets: Associated Ritz estimates') end if c return c c %---------------% c | End of dsgets | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dstatn.f000644 001750 001750 00000002710 11266605602 022112 0ustar00geuzainegeuzaine000000 000000 c c %---------------------------------------------% c | Initialize statistic and timing information | c | for nonsymmetric Arnoldi code. | c %---------------------------------------------% c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: statn.F SID: 2.4 DATE OF SID: 4/20/96 RELEASE: 2 c subroutine dstatn c c %--------------------------------% c | See stat.doc for documentation | c %--------------------------------% c include 'stat.h' c c %-----------------------% c | Executable Statements | c %-----------------------% c nopx = 0 nbx = 0 nrorth = 0 nitref = 0 nrstrt = 0 c tnaupd = 0.0D+0 tnaup2 = 0.0D+0 tnaitr = 0.0D+0 tneigh = 0.0D+0 tngets = 0.0D+0 tnapps = 0.0D+0 tnconv = 0.0D+0 titref = 0.0D+0 tgetv0 = 0.0D+0 trvec = 0.0D+0 c c %----------------------------------------------------% c | User time including reverse communication overhead | c %----------------------------------------------------% c tmvopx = 0.0D+0 tmvbx = 0.0D+0 c return c c c %---------------% c | End of dstatn | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/ssaup2.f000644 001750 001750 00000076707 11266605602 022053 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: ssaup2 c c\Description: c Intermediate level interface called by ssaupd. c c\Usage: c call ssaup2 c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD, c ISHIFT, MXITER, V, LDV, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL, c IPNTR, WORKD, INFO ) c c\Arguments c c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in ssaupd. c MODE, ISHIFT, MXITER: see the definition of IPARAM in ssaupd. c c NP Integer. (INPUT/OUTPUT) c Contains the number of implicit shifts to apply during c each Arnoldi/Lanczos iteration. c If ISHIFT=1, NP is adjusted dynamically at each iteration c to accelerate convergence and prevent stagnation. c This is also roughly equal to the number of matrix-vector c products (involving the operator OP) per Arnoldi iteration. c The logic for adjusting is contained within the current c subroutine. c If ISHIFT=0, NP is the number of shifts the user needs c to provide via reverse comunication. 0 < NP < NCV-NEV. c NP may be less than NCV-NEV since a leading block of the current c upper Tridiagonal matrix has split off and contains "unwanted" c Ritz values. c Upon termination of the IRA iteration, NP contains the number c of "converged" wanted Ritz values. c c IUPD Integer. (INPUT) c IUPD .EQ. 0: use explicit restart instead implicit update. c IUPD .NE. 0: use implicit update. c c V Real N by (NEV+NP) array. (INPUT/OUTPUT) c The Lanczos basis vectors. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Real (NEV+NP) by 2 array. (OUTPUT) c H is used to store the generated symmetric tridiagonal matrix c The subdiagonal is stored in the first column of H starting c at H(2,1). The main diagonal is stored in the second column c of H starting at H(1,2). If ssaup2 converges store the c B-norm of the final residual vector in H(1,1). c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RITZ Real array of length NEV+NP. (OUTPUT) c RITZ(1:NEV) contains the computed Ritz values of OP. c c BOUNDS Real array of length NEV+NP. (OUTPUT) c BOUNDS(1:NEV) contain the error bounds corresponding to RITZ. c c Q Real (NEV+NP) by (NEV+NP) array. (WORKSPACE) c Private (replicated) work array used to accumulate the c rotation in the shift application step. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKL Real array of length at least 3*(NEV+NP). (INPUT/WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. It is used in the computation of the c tridiagonal eigenvalue problem, the calculation and c application of the shifts and convergence checking. c If ISHIFT .EQ. O and IDO .EQ. 3, the first NP locations c of WORKL are used in reverse communication to hold the user c supplied shifts. c c IPNTR Integer array of length 3. (OUTPUT) c Pointer to mark the starting locations in the WORKD for c vectors used by the Lanczos iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. c IPNTR(3): pointer to the vector B * X when used in one of c the spectral transformation modes. X is the current c operand. c ------------------------------------------------------------- c c WORKD Real work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Lanczos iteration c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration !!!!!!!!!! c See Data Distribution Note in ssaupd. c c INFO Integer. (INPUT/OUTPUT) c If INFO .EQ. 0, a randomly initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c Error flag on output. c = 0: Normal return. c = 1: All possible eigenvalues of OP has been found. c NP returns the size of the invariant subspace c spanning the operator OP. c = 2: No shifts could be applied. c = -8: Error return from trid. eigenvalue calculation; c This should never happen. c = -9: Starting vector is zero. c = -9999: Could not build an Lanczos factorization. c Size that was built in returned in NP. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall, c 1980. c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program", c Computer Physics Communications, 53 (1989), pp 169-179. c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to c Implement the Spectral Transformation", Math. Comp., 48 (1987), c pp 663-673. c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems", c SIAM J. Matr. Anal. Apps., January (1993). c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines c for Updating the QR decomposition", ACM TOMS, December 1990, c Volume 16 Number 4, pp 369-377. c c\Routines called: c sgetv0 ARPACK initial vector generation routine. c ssaitr ARPACK Lanczos factorization routine. c ssapps ARPACK application of implicit shifts routine. c ssconv ARPACK convergence of Ritz values routine. c sseigt ARPACK compute Ritz values and error bounds routine. c ssgets ARPACK reorder Ritz values and error bounds routine. c ssortr ARPACK sorting routine. c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c svout ARPACK utility routine that prints vectors. c slamch LAPACK routine that determines machine constants. c scopy Level 1 BLAS that copies one vector to another. c sdot Level 1 BLAS that computes the scalar product of two vectors. c snrm2 Level 1 BLAS that computes the norm of a vector. c sscal Level 1 BLAS that scales a vector. c sswap Level 1 BLAS that swaps two vectors. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/15/93: Version ' 2.4' c xx/xx/95: Version ' 2.4'. (R.B. Lehoucq) c c\SCCS Information: @(#) c FILE: saup2.F SID: 2.7 DATE OF SID: 5/19/98 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine ssaup2 & ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd, & ishift, mxiter, v, ldv, h, ldh, ritz, bounds, & q, ldq, workl, ipntr, workd, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1, which*2 integer ido, info, ishift, iupd, ldh, ldq, ldv, mxiter, & n, mode, nev, np Real & tol c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(3) Real & bounds(nev+np), h(ldh,2), q(ldq,nev+np), resid(n), & ritz(nev+np), v(ldv,nev+np), workd(3*n), & workl(3*(nev+np)) c c %------------% c | Parameters | c %------------% c Real & one, zero parameter (one = 1.0E+0, zero = 0.0E+0) c c %---------------% c | Local Scalars | c %---------------% c character wprime*2 logical cnorm, getv0, initv, update, ushift integer ierr, iter, j, kplusp, msglvl, nconv, nevbef, nev0, & np0, nptemp, nevd2, nevm2, kp(3) Real & rnorm, temp, eps23 save cnorm, getv0, initv, update, ushift, & iter, kplusp, msglvl, nconv, nev0, np0, & rnorm, eps23 c c %----------------------% c | External Subroutines | c %----------------------% c external scopy, sgetv0, ssaitr, sscal, ssconv, sseigt, ssgets, & ssapps, ssortr, svout, ivout, second, sswap c c %--------------------% c | External Functions | c %--------------------% c Real & sdot, snrm2, slamch external sdot, snrm2, slamch c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic min c c %-----------------------% c | Executable Statements | c %-----------------------% c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = msaup2 c c %---------------------------------% c | Set machine dependent constant. | c %---------------------------------% c eps23 = slamch('Epsilon-Machine') eps23 = eps23**(2.0E+0/3.0E+0) c c %-------------------------------------% c | nev0 and np0 are integer variables | c | hold the initial values of NEV & NP | c %-------------------------------------% c nev0 = nev np0 = np c c %-------------------------------------% c | kplusp is the bound on the largest | c | Lanczos factorization built. | c | nconv is the current number of | c | "converged" eigenvlues. | c | iter is the counter on the current | c | iteration step. | c %-------------------------------------% c kplusp = nev0 + np0 nconv = 0 iter = 0 c c %--------------------------------------------% c | Set flags for computing the first NEV steps | c | of the Lanczos factorization. | c %--------------------------------------------% c getv0 = .true. update = .false. ushift = .false. cnorm = .false. c if (info .ne. 0) then c c %--------------------------------------------% c | User provides the initial residual vector. | c %--------------------------------------------% c initv = .true. info = 0 else initv = .false. end if end if c c %---------------------------------------------% c | Get a possibly random starting vector and | c | force it into the range of the operator OP. | c %---------------------------------------------% c 10 continue c if (getv0) then call sgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, rnorm, & ipntr, workd, info) c if (ido .ne. 99) go to 9000 c if (rnorm .eq. zero) then c c %-----------------------------------------% c | The initial vector is zero. Error exit. | c %-----------------------------------------% c info = -9 go to 1200 end if getv0 = .false. ido = 0 end if c c %------------------------------------------------------------% c | Back from reverse communication: continue with update step | c %------------------------------------------------------------% c if (update) go to 20 c c %-------------------------------------------% c | Back from computing user specified shifts | c %-------------------------------------------% c if (ushift) go to 50 c c %-------------------------------------% c | Back from computing residual norm | c | at the end of the current iteration | c %-------------------------------------% c if (cnorm) go to 100 c c %----------------------------------------------------------% c | Compute the first NEV steps of the Lanczos factorization | c %----------------------------------------------------------% c call ssaitr (ido, bmat, n, 0, nev0, mode, resid, rnorm, v, ldv, & h, ldh, ipntr, workd, info) c c %---------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP and possibly B | c %---------------------------------------------------% c if (ido .ne. 99) go to 9000 c if (info .gt. 0) then c c %-----------------------------------------------------% c | ssaitr was unable to build an Lanczos factorization | c | of length NEV0. INFO is returned with the size of | c | the factorization built. Exit main loop. | c %-----------------------------------------------------% c np = info mxiter = iter info = -9999 go to 1200 end if c c %--------------------------------------------------------------% c | | c | M A I N LANCZOS I T E R A T I O N L O O P | c | Each iteration implicitly restarts the Lanczos | c | factorization in place. | c | | c %--------------------------------------------------------------% c 1000 continue c iter = iter + 1 c if (msglvl .gt. 0) then call ivout (logfil, 1, iter, ndigit, & '_saup2: **** Start of major iteration number ****') end if if (msglvl .gt. 1) then call ivout (logfil, 1, nev, ndigit, & '_saup2: The length of the current Lanczos factorization') call ivout (logfil, 1, np, ndigit, & '_saup2: Extend the Lanczos factorization by') end if c c %------------------------------------------------------------% c | Compute NP additional steps of the Lanczos factorization. | c %------------------------------------------------------------% c ido = 0 20 continue update = .true. c call ssaitr (ido, bmat, n, nev, np, mode, resid, rnorm, v, & ldv, h, ldh, ipntr, workd, info) c c %---------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP and possibly B | c %---------------------------------------------------% c if (ido .ne. 99) go to 9000 c if (info .gt. 0) then c c %-----------------------------------------------------% c | ssaitr was unable to build an Lanczos factorization | c | of length NEV0+NP0. INFO is returned with the size | c | of the factorization built. Exit main loop. | c %-----------------------------------------------------% c np = info mxiter = iter info = -9999 go to 1200 end if update = .false. c if (msglvl .gt. 1) then call svout (logfil, 1, rnorm, ndigit, & '_saup2: Current B-norm of residual for factorization') end if c c %--------------------------------------------------------% c | Compute the eigenvalues and corresponding error bounds | c | of the current symmetric tridiagonal matrix. | c %--------------------------------------------------------% c call sseigt (rnorm, kplusp, h, ldh, ritz, bounds, workl, ierr) c if (ierr .ne. 0) then info = -8 go to 1200 end if c c %----------------------------------------------------% c | Make a copy of eigenvalues and corresponding error | c | bounds obtained from _seigt. | c %----------------------------------------------------% c call scopy(kplusp, ritz, 1, workl(kplusp+1), 1) call scopy(kplusp, bounds, 1, workl(2*kplusp+1), 1) c c %---------------------------------------------------% c | Select the wanted Ritz values and their bounds | c | to be used in the convergence test. | c | The selection is based on the requested number of | c | eigenvalues instead of the current NEV and NP to | c | prevent possible misconvergence. | c | * Wanted Ritz values := RITZ(NP+1:NEV+NP) | c | * Shifts := RITZ(1:NP) := WORKL(1:NP) | c %---------------------------------------------------% c nev = nev0 np = np0 call ssgets (ishift, which, nev, np, ritz, bounds, workl) c c %-------------------% c | Convergence test. | c %-------------------% c call scopy (nev, bounds(np+1), 1, workl(np+1), 1) call ssconv (nev, ritz(np+1), workl(np+1), tol, nconv) c if (msglvl .gt. 2) then kp(1) = nev kp(2) = np kp(3) = nconv call ivout (logfil, 3, kp, ndigit, & '_saup2: NEV, NP, NCONV are') call svout (logfil, kplusp, ritz, ndigit, & '_saup2: The eigenvalues of H') call svout (logfil, kplusp, bounds, ndigit, & '_saup2: Ritz estimates of the current NCV Ritz values') end if c c %---------------------------------------------------------% c | Count the number of unwanted Ritz values that have zero | c | Ritz estimates. If any Ritz estimates are equal to zero | c | then a leading block of H of order equal to at least | c | the number of Ritz values with zero Ritz estimates has | c | split off. None of these Ritz values may be removed by | c | shifting. Decrease NP the number of shifts to apply. If | c | no shifts may be applied, then prepare to exit | c %---------------------------------------------------------% c nptemp = np do 30 j=1, nptemp if (bounds(j) .eq. zero) then np = np - 1 nev = nev + 1 end if 30 continue c if ( (nconv .ge. nev0) .or. & (iter .gt. mxiter) .or. & (np .eq. 0) ) then c c %------------------------------------------------% c | Prepare to exit. Put the converged Ritz values | c | and corresponding bounds in RITZ(1:NCONV) and | c | BOUNDS(1:NCONV) respectively. Then sort. Be | c | careful when NCONV > NP since we don't want to | c | swap overlapping locations. | c %------------------------------------------------% c if (which .eq. 'BE') then c c %-----------------------------------------------------% c | Both ends of the spectrum are requested. | c | Sort the eigenvalues into algebraically decreasing | c | order first then swap low end of the spectrum next | c | to high end in appropriate locations. | c | NOTE: when np < floor(nev/2) be careful not to swap | c | overlapping locations. | c %-----------------------------------------------------% c wprime = 'SA' call ssortr (wprime, .true., kplusp, ritz, bounds) nevd2 = nev0 / 2 nevm2 = nev0 - nevd2 if ( nev .gt. 1 ) then call sswap ( min(nevd2,np), ritz(nevm2+1), 1, & ritz( max(kplusp-nevd2+1,kplusp-np+1) ), 1) call sswap ( min(nevd2,np), bounds(nevm2+1), 1, & bounds( max(kplusp-nevd2+1,kplusp-np+1)), 1) end if c else c c %--------------------------------------------------% c | LM, SM, LA, SA case. | c | Sort the eigenvalues of H into the an order that | c | is opposite to WHICH, and apply the resulting | c | order to BOUNDS. The eigenvalues are sorted so | c | that the wanted part are always within the first | c | NEV locations. | c %--------------------------------------------------% c if (which .eq. 'LM') wprime = 'SM' if (which .eq. 'SM') wprime = 'LM' if (which .eq. 'LA') wprime = 'SA' if (which .eq. 'SA') wprime = 'LA' c call ssortr (wprime, .true., kplusp, ritz, bounds) c end if c c %--------------------------------------------------% c | Scale the Ritz estimate of each Ritz value | c | by 1 / max(eps23,magnitude of the Ritz value). | c %--------------------------------------------------% c do 35 j = 1, nev0 temp = max( eps23, abs(ritz(j)) ) bounds(j) = bounds(j)/temp 35 continue c c %----------------------------------------------------% c | Sort the Ritz values according to the scaled Ritz | c | esitmates. This will push all the converged ones | c | towards the front of ritzr, ritzi, bounds | c | (in the case when NCONV < NEV.) | c %----------------------------------------------------% c wprime = 'LA' call ssortr(wprime, .true., nev0, bounds, ritz) c c %----------------------------------------------% c | Scale the Ritz estimate back to its original | c | value. | c %----------------------------------------------% c do 40 j = 1, nev0 temp = max( eps23, abs(ritz(j)) ) bounds(j) = bounds(j)*temp 40 continue c c %--------------------------------------------------% c | Sort the "converged" Ritz values again so that | c | the "threshold" values and their associated Ritz | c | estimates appear at the appropriate position in | c | ritz and bound. | c %--------------------------------------------------% c if (which .eq. 'BE') then c c %------------------------------------------------% c | Sort the "converged" Ritz values in increasing | c | order. The "threshold" values are in the | c | middle. | c %------------------------------------------------% c wprime = 'LA' call ssortr(wprime, .true., nconv, ritz, bounds) c else c c %----------------------------------------------% c | In LM, SM, LA, SA case, sort the "converged" | c | Ritz values according to WHICH so that the | c | "threshold" value appears at the front of | c | ritz. | c %----------------------------------------------% call ssortr(which, .true., nconv, ritz, bounds) c end if c c %------------------------------------------% c | Use h( 1,1 ) as storage to communicate | c | rnorm to _seupd if needed | c %------------------------------------------% c h(1,1) = rnorm c if (msglvl .gt. 1) then call svout (logfil, kplusp, ritz, ndigit, & '_saup2: Sorted Ritz values.') call svout (logfil, kplusp, bounds, ndigit, & '_saup2: Sorted ritz estimates.') end if c c %------------------------------------% c | Max iterations have been exceeded. | c %------------------------------------% c if (iter .gt. mxiter .and. nconv .lt. nev) info = 1 c c %---------------------% c | No shifts to apply. | c %---------------------% c if (np .eq. 0 .and. nconv .lt. nev0) info = 2 c np = nconv go to 1100 c else if (nconv .lt. nev .and. ishift .eq. 1) then c c %---------------------------------------------------% c | Do not have all the requested eigenvalues yet. | c | To prevent possible stagnation, adjust the number | c | of Ritz values and the shifts. | c %---------------------------------------------------% c nevbef = nev nev = nev + min (nconv, np/2) if (nev .eq. 1 .and. kplusp .ge. 6) then nev = kplusp / 2 else if (nev .eq. 1 .and. kplusp .gt. 2) then nev = 2 end if np = kplusp - nev c c %---------------------------------------% c | If the size of NEV was just increased | c | resort the eigenvalues. | c %---------------------------------------% c if (nevbef .lt. nev) & call ssgets (ishift, which, nev, np, ritz, bounds, & workl) c end if c if (msglvl .gt. 0) then call ivout (logfil, 1, nconv, ndigit, & '_saup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev kp(2) = np call ivout (logfil, 2, kp, ndigit, & '_saup2: NEV and NP are') call svout (logfil, nev, ritz(np+1), ndigit, & '_saup2: "wanted" Ritz values.') call svout (logfil, nev, bounds(np+1), ndigit, & '_saup2: Ritz estimates of the "wanted" values ') end if end if c if (ishift .eq. 0) then c c %-----------------------------------------------------% c | User specified shifts: reverse communication to | c | compute the shifts. They are returned in the first | c | NP locations of WORKL. | c %-----------------------------------------------------% c ushift = .true. ido = 3 go to 9000 end if c 50 continue c c %------------------------------------% c | Back from reverse communication; | c | User specified shifts are returned | c | in WORKL(1:*NP) | c %------------------------------------% c ushift = .false. c c c %---------------------------------------------------------% c | Move the NP shifts to the first NP locations of RITZ to | c | free up WORKL. This is for the non-exact shift case; | c | in the exact shift case, ssgets already handles this. | c %---------------------------------------------------------% c if (ishift .eq. 0) call scopy (np, workl, 1, ritz, 1) c if (msglvl .gt. 2) then call ivout (logfil, 1, np, ndigit, & '_saup2: The number of shifts to apply ') call svout (logfil, np, workl, ndigit, & '_saup2: shifts selected') if (ishift .eq. 1) then call svout (logfil, np, bounds, ndigit, & '_saup2: corresponding Ritz estimates') end if end if c c %---------------------------------------------------------% c | Apply the NP0 implicit shifts by QR bulge chasing. | c | Each shift is applied to the entire tridiagonal matrix. | c | The first 2*N locations of WORKD are used as workspace. | c | After ssapps is done, we have a Lanczos | c | factorization of length NEV. | c %---------------------------------------------------------% c call ssapps (n, nev, np, ritz, v, ldv, h, ldh, resid, q, ldq, & workd) c c %---------------------------------------------% c | Compute the B-norm of the updated residual. | c | Keep B*RESID in WORKD(1:N) to be used in | c | the first step of the next call to ssaitr. | c %---------------------------------------------% c cnorm = .true. call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call scopy (n, resid, 1, workd(n+1), 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 c c %----------------------------------% c | Exit in order to compute B*RESID | c %----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call scopy (n, resid, 1, workd, 1) end if c 100 continue c c %----------------------------------% c | Back from reverse communication; | c | WORKD(1:N) := B*RESID | c %----------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c if (bmat .eq. 'G') then rnorm = sdot (n, resid, 1, workd, 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then rnorm = snrm2(n, resid, 1) end if cnorm = .false. 130 continue c if (msglvl .gt. 2) then call svout (logfil, 1, rnorm, ndigit, & '_saup2: B-norm of residual for NEV factorization') call svout (logfil, nev, h(1,2), ndigit, & '_saup2: main diagonal of compressed H matrix') call svout (logfil, nev-1, h(2,1), ndigit, & '_saup2: subdiagonal of compressed H matrix') end if c go to 1000 c c %---------------------------------------------------------------% c | | c | E N D O F M A I N I T E R A T I O N L O O P | c | | c %---------------------------------------------------------------% c 1100 continue c mxiter = iter nev = nconv c 1200 continue ido = 99 c c %------------% c | Error exit | c %------------% c call second (t1) tsaup2 = t1 - t0 c 9000 continue return c c %---------------% c | End of ssaup2 | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dlaqrb.f000644 001750 001750 00000044020 11266605602 022062 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: dlaqrb c c\Description: c Compute the eigenvalues and the Schur decomposition of an upper c Hessenberg submatrix in rows and columns ILO to IHI. Only the c last component of the Schur vectors are computed. c c This is mostly a modification of the LAPACK routine dlahqr. c c\Usage: c call dlaqrb c ( WANTT, N, ILO, IHI, H, LDH, WR, WI, Z, INFO ) c c\Arguments c WANTT Logical variable. (INPUT) c = .TRUE. : the full Schur form T is required; c = .FALSE.: only eigenvalues are required. c c N Integer. (INPUT) c The order of the matrix H. N >= 0. c c ILO Integer. (INPUT) c IHI Integer. (INPUT) c It is assumed that H is already upper quasi-triangular in c rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless c ILO = 1). SLAQRB works primarily with the Hessenberg c submatrix in rows and columns ILO to IHI, but applies c transformations to all of H if WANTT is .TRUE.. c 1 <= ILO <= max(1,IHI); IHI <= N. c c H Double precision array, dimension (LDH,N). (INPUT/OUTPUT) c On entry, the upper Hessenberg matrix H. c On exit, if WANTT is .TRUE., H is upper quasi-triangular in c rows and columns ILO:IHI, with any 2-by-2 diagonal blocks in c standard form. If WANTT is .FALSE., the contents of H are c unspecified on exit. c c LDH Integer. (INPUT) c The leading dimension of the array H. LDH >= max(1,N). c c WR Double precision array, dimension (N). (OUTPUT) c WI Double precision array, dimension (N). (OUTPUT) c The real and imaginary parts, respectively, of the computed c eigenvalues ILO to IHI are stored in the corresponding c elements of WR and WI. If two eigenvalues are computed as a c complex conjugate pair, they are stored in consecutive c elements of WR and WI, say the i-th and (i+1)th, with c WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the c eigenvalues are stored in the same order as on the diagonal c of the Schur form returned in H, with WR(i) = H(i,i), and, if c H(i:i+1,i:i+1) is a 2-by-2 diagonal block, c WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i). c c Z Double precision array, dimension (N). (OUTPUT) c On exit Z contains the last components of the Schur vectors. c c INFO Integer. (OUPUT) c = 0: successful exit c > 0: SLAQRB failed to compute all the eigenvalues ILO to IHI c in a total of 30*(IHI-ILO+1) iterations; if INFO = i, c elements i+1:ihi of WR and WI contain those eigenvalues c which have been successfully computed. c c\Remarks c 1. None. c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c dlabad LAPACK routine that computes machine constants. c dlamch LAPACK routine that determines machine constants. c dlanhs LAPACK routine that computes various norms of a matrix. c dlanv2 LAPACK routine that computes the Schur factorization of c 2 by 2 nonsymmetric matrix in standard form. c dlarfg LAPACK Householder reflection construction routine. c dcopy Level 1 BLAS that copies one vector to another. c drot Level 1 BLAS that applies a rotation to a 2 by 2 matrix. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.4' c Modified from the LAPACK routine dlahqr so that only the c last component of the Schur vectors are computed. c c\SCCS Information: @(#) c FILE: laqrb.F SID: 2.2 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks c 1. None c c\EndLib c c----------------------------------------------------------------------- c subroutine dlaqrb ( wantt, n, ilo, ihi, h, ldh, wr, wi, & z, info ) c c %------------------% c | Scalar Arguments | c %------------------% c logical wantt integer ihi, ilo, info, ldh, n c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & h( ldh, * ), wi( * ), wr( * ), z( * ) c c %------------% c | Parameters | c %------------% c Double precision & zero, one, dat1, dat2 parameter (zero = 0.0D+0, one = 1.0D+0, dat1 = 7.5D-1, & dat2 = -4.375D-1) c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c integer i, i1, i2, itn, its, j, k, l, m, nh, nr Double precision & cs, h00, h10, h11, h12, h21, h22, h33, h33s, & h43h34, h44, h44s, ovfl, s, smlnum, sn, sum, & t1, t2, t3, tst1, ulp, unfl, v1, v2, v3 Double precision & v( 3 ), work( 1 ) c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlamch, dlanhs external dlamch, dlanhs c c %----------------------% c | External Subroutines | c %----------------------% c external dcopy, dlabad, dlanv2, dlarfg, drot c c %-----------------------% c | Executable Statements | c %-----------------------% c info = 0 c c %--------------------------% c | Quick return if possible | c %--------------------------% c if( n.eq.0 ) & return if( ilo.eq.ihi ) then wr( ilo ) = h( ilo, ilo ) wi( ilo ) = zero return end if c c %---------------------------------------------% c | Initialize the vector of last components of | c | the Schur vectors for accumulation. | c %---------------------------------------------% c do 5 j = 1, n-1 z(j) = zero 5 continue z(n) = one c nh = ihi - ilo + 1 c c %-------------------------------------------------------------% c | Set machine-dependent constants for the stopping criterion. | c | If norm(H) <= sqrt(OVFL), overflow should not occur. | c %-------------------------------------------------------------% c unfl = dlamch( 'safe minimum' ) ovfl = one / unfl call dlabad( unfl, ovfl ) ulp = dlamch( 'precision' ) smlnum = unfl*( nh / ulp ) c c %---------------------------------------------------------------% c | I1 and I2 are the indices of the first row and last column | c | of H to which transformations must be applied. If eigenvalues | c | only are computed, I1 and I2 are set inside the main loop. | c | Zero out H(J+2,J) = ZERO for J=1:N if WANTT = .TRUE. | c | else H(J+2,J) for J=ILO:IHI-ILO-1 if WANTT = .FALSE. | c %---------------------------------------------------------------% c if( wantt ) then i1 = 1 i2 = n do 8 i=1,i2-2 h(i1+i+1,i) = zero 8 continue else do 9 i=1, ihi-ilo-1 h(ilo+i+1,ilo+i-1) = zero 9 continue end if c c %---------------------------------------------------% c | ITN is the total number of QR iterations allowed. | c %---------------------------------------------------% c itn = 30*nh c c ------------------------------------------------------------------ c The main loop begins here. I is the loop index and decreases from c IHI to ILO in steps of 1 or 2. Each iteration of the loop works c with the active submatrix in rows and columns L to I. c Eigenvalues I+1 to IHI have already converged. Either L = ILO or c H(L,L-1) is negligible so that the matrix splits. c ------------------------------------------------------------------ c i = ihi 10 continue l = ilo if( i.lt.ilo ) & go to 150 c %--------------------------------------------------------------% c | Perform QR iterations on rows and columns ILO to I until a | c | submatrix of order 1 or 2 splits off at the bottom because a | c | subdiagonal element has become negligible. | c %--------------------------------------------------------------% do 130 its = 0, itn c c %----------------------------------------------% c | Look for a single small subdiagonal element. | c %----------------------------------------------% c do 20 k = i, l + 1, -1 tst1 = abs( h( k-1, k-1 ) ) + abs( h( k, k ) ) if( tst1.eq.zero ) & tst1 = dlanhs( '1', i-l+1, h( l, l ), ldh, work ) if( abs( h( k, k-1 ) ).le.max( ulp*tst1, smlnum ) ) & go to 30 20 continue 30 continue l = k if( l.gt.ilo ) then c c %------------------------% c | H(L,L-1) is negligible | c %------------------------% c h( l, l-1 ) = zero end if c c %-------------------------------------------------------------% c | Exit from loop if a submatrix of order 1 or 2 has split off | c %-------------------------------------------------------------% c if( l.ge.i-1 ) & go to 140 c c %---------------------------------------------------------% c | Now the active submatrix is in rows and columns L to I. | c | If eigenvalues only are being computed, only the active | c | submatrix need be transformed. | c %---------------------------------------------------------% c if( .not.wantt ) then i1 = l i2 = i end if c if( its.eq.10 .or. its.eq.20 ) then c c %-------------------% c | Exceptional shift | c %-------------------% c s = abs( h( i, i-1 ) ) + abs( h( i-1, i-2 ) ) h44 = dat1*s h33 = h44 h43h34 = dat2*s*s c else c c %-----------------------------------------% c | Prepare to use Wilkinson's double shift | c %-----------------------------------------% c h44 = h( i, i ) h33 = h( i-1, i-1 ) h43h34 = h( i, i-1 )*h( i-1, i ) end if c c %-----------------------------------------------------% c | Look for two consecutive small subdiagonal elements | c %-----------------------------------------------------% c do 40 m = i - 2, l, -1 c c %---------------------------------------------------------% c | Determine the effect of starting the double-shift QR | c | iteration at row M, and see if this would make H(M,M-1) | c | negligible. | c %---------------------------------------------------------% c h11 = h( m, m ) h22 = h( m+1, m+1 ) h21 = h( m+1, m ) h12 = h( m, m+1 ) h44s = h44 - h11 h33s = h33 - h11 v1 = ( h33s*h44s-h43h34 ) / h21 + h12 v2 = h22 - h11 - h33s - h44s v3 = h( m+2, m+1 ) s = abs( v1 ) + abs( v2 ) + abs( v3 ) v1 = v1 / s v2 = v2 / s v3 = v3 / s v( 1 ) = v1 v( 2 ) = v2 v( 3 ) = v3 if( m.eq.l ) & go to 50 h00 = h( m-1, m-1 ) h10 = h( m, m-1 ) tst1 = abs( v1 )*( abs( h00 )+abs( h11 )+abs( h22 ) ) if( abs( h10 )*( abs( v2 )+abs( v3 ) ).le.ulp*tst1 ) & go to 50 40 continue 50 continue c c %----------------------% c | Double-shift QR step | c %----------------------% c do 120 k = m, i - 1 c c ------------------------------------------------------------ c The first iteration of this loop determines a reflection G c from the vector V and applies it from left and right to H, c thus creating a nonzero bulge below the subdiagonal. c c Each subsequent iteration determines a reflection G to c restore the Hessenberg form in the (K-1)th column, and thus c chases the bulge one step toward the bottom of the active c submatrix. NR is the order of G. c ------------------------------------------------------------ c nr = min( 3, i-k+1 ) if( k.gt.m ) & call dcopy( nr, h( k, k-1 ), 1, v, 1 ) call dlarfg( nr, v( 1 ), v( 2 ), 1, t1 ) if( k.gt.m ) then h( k, k-1 ) = v( 1 ) h( k+1, k-1 ) = zero if( k.lt.i-1 ) & h( k+2, k-1 ) = zero else if( m.gt.l ) then h( k, k-1 ) = -h( k, k-1 ) end if v2 = v( 2 ) t2 = t1*v2 if( nr.eq.3 ) then v3 = v( 3 ) t3 = t1*v3 c c %------------------------------------------------% c | Apply G from the left to transform the rows of | c | the matrix in columns K to I2. | c %------------------------------------------------% c do 60 j = k, i2 sum = h( k, j ) + v2*h( k+1, j ) + v3*h( k+2, j ) h( k, j ) = h( k, j ) - sum*t1 h( k+1, j ) = h( k+1, j ) - sum*t2 h( k+2, j ) = h( k+2, j ) - sum*t3 60 continue c c %----------------------------------------------------% c | Apply G from the right to transform the columns of | c | the matrix in rows I1 to min(K+3,I). | c %----------------------------------------------------% c do 70 j = i1, min( k+3, i ) sum = h( j, k ) + v2*h( j, k+1 ) + v3*h( j, k+2 ) h( j, k ) = h( j, k ) - sum*t1 h( j, k+1 ) = h( j, k+1 ) - sum*t2 h( j, k+2 ) = h( j, k+2 ) - sum*t3 70 continue c c %----------------------------------% c | Accumulate transformations for Z | c %----------------------------------% c sum = z( k ) + v2*z( k+1 ) + v3*z( k+2 ) z( k ) = z( k ) - sum*t1 z( k+1 ) = z( k+1 ) - sum*t2 z( k+2 ) = z( k+2 ) - sum*t3 else if( nr.eq.2 ) then c c %------------------------------------------------% c | Apply G from the left to transform the rows of | c | the matrix in columns K to I2. | c %------------------------------------------------% c do 90 j = k, i2 sum = h( k, j ) + v2*h( k+1, j ) h( k, j ) = h( k, j ) - sum*t1 h( k+1, j ) = h( k+1, j ) - sum*t2 90 continue c c %----------------------------------------------------% c | Apply G from the right to transform the columns of | c | the matrix in rows I1 to min(K+3,I). | c %----------------------------------------------------% c do 100 j = i1, i sum = h( j, k ) + v2*h( j, k+1 ) h( j, k ) = h( j, k ) - sum*t1 h( j, k+1 ) = h( j, k+1 ) - sum*t2 100 continue c c %----------------------------------% c | Accumulate transformations for Z | c %----------------------------------% c sum = z( k ) + v2*z( k+1 ) z( k ) = z( k ) - sum*t1 z( k+1 ) = z( k+1 ) - sum*t2 end if 120 continue 130 continue c c %-------------------------------------------------------% c | Failure to converge in remaining number of iterations | c %-------------------------------------------------------% c info = i return 140 continue if( l.eq.i ) then c c %------------------------------------------------------% c | H(I,I-1) is negligible: one eigenvalue has converged | c %------------------------------------------------------% c wr( i ) = h( i, i ) wi( i ) = zero else if( l.eq.i-1 ) then c c %--------------------------------------------------------% c | H(I-1,I-2) is negligible; | c | a pair of eigenvalues have converged. | c | | c | Transform the 2-by-2 submatrix to standard Schur form, | c | and compute and store the eigenvalues. | c %--------------------------------------------------------% c call dlanv2( h( i-1, i-1 ), h( i-1, i ), h( i, i-1 ), & h( i, i ), wr( i-1 ), wi( i-1 ), wr( i ), wi( i ), & cs, sn ) if( wantt ) then c c %-----------------------------------------------------% c | Apply the transformation to the rest of H and to Z, | c | as required. | c %-----------------------------------------------------% c if( i2.gt.i ) & call drot( i2-i, h( i-1, i+1 ), ldh, h( i, i+1 ), ldh, & cs, sn ) call drot( i-i1-1, h( i1, i-1 ), 1, h( i1, i ), 1, cs, sn ) sum = cs*z( i-1 ) + sn*z( i ) z( i ) = cs*z( i ) - sn*z( i-1 ) z( i-1 ) = sum end if end if c c %---------------------------------------------------------% c | Decrement number of remaining iterations, and return to | c | start of the main loop with new value of I. | c %---------------------------------------------------------% c itn = itn - its i = l - 1 go to 10 150 continue return c c %---------------% c | End of dlaqrb | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dneigh.f000644 001750 001750 00000024241 11266605602 022056 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: dneigh c c\Description: c Compute the eigenvalues of the current upper Hessenberg matrix c and the corresponding Ritz estimates given the current residual norm. c c\Usage: c call dneigh c ( RNORM, N, H, LDH, RITZR, RITZI, BOUNDS, Q, LDQ, WORKL, IERR ) c c\Arguments c RNORM Double precision scalar. (INPUT) c Residual norm corresponding to the current upper Hessenberg c matrix H. c c N Integer. (INPUT) c Size of the matrix H. c c H Double precision N by N array. (INPUT) c H contains the current upper Hessenberg matrix. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RITZR, Double precision arrays of length N. (OUTPUT) c RITZI On output, RITZR(1:N) (resp. RITZI(1:N)) contains the real c (respectively imaginary) parts of the eigenvalues of H. c c BOUNDS Double precision array of length N. (OUTPUT) c On output, BOUNDS contains the Ritz estimates associated with c the eigenvalues RITZR and RITZI. This is equal to RNORM c times the last components of the eigenvectors corresponding c to the eigenvalues in RITZR and RITZI. c c Q Double precision N by N array. (WORKSPACE) c Workspace needed to store the eigenvectors of H. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKL Double precision work array of length N**2 + 3*N. (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. This is needed to keep the full Schur form c of H and also in the calculation of the eigenvectors of H. c c IERR Integer. (OUTPUT) c Error exit flag from dlaqrb or dtrevc. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c dlaqrb ARPACK routine to compute the real Schur form of an c upper Hessenberg matrix and last row of the Schur vectors. c second ARPACK utility routine for timing. c dmout ARPACK utility routine that prints matrices c dvout ARPACK utility routine that prints vectors. c dlacpy LAPACK matrix copy routine. c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c dtrevc LAPACK routine to compute the eigenvectors of a matrix c in upper quasi-triangular form c dgemv Level 2 BLAS routine for matrix vector multiplication. c dcopy Level 1 BLAS that copies one vector to another . c dnrm2 Level 1 BLAS that computes the norm of a vector. c dscal Level 1 BLAS that scales a vector. c c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.1' c c\SCCS Information: @(#) c FILE: neigh.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 c c\Remarks c None c c\EndLib c c----------------------------------------------------------------------- c subroutine dneigh (rnorm, n, h, ldh, ritzr, ritzi, bounds, & q, ldq, workl, ierr) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer ierr, n, ldh, ldq Double precision & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & bounds(n), h(ldh,n), q(ldq,n), ritzi(n), ritzr(n), & workl(n*(n+3)) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c logical select(1) integer i, iconj, msglvl Double precision & temp, vl(1) c c %----------------------% c | External Subroutines | c %----------------------% c external dcopy, dlacpy, dlaqrb, dtrevc, dvout, second c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlapy2, dnrm2 external dlapy2, dnrm2 c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic abs c c %-----------------------% c | Executable Statements | c %-----------------------% c c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mneigh c if (msglvl .gt. 2) then call dmout (logfil, n, n, h, ldh, ndigit, & '_neigh: Entering upper Hessenberg matrix H ') end if c c %-----------------------------------------------------------% c | 1. Compute the eigenvalues, the last components of the | c | corresponding Schur vectors and the full Schur form T | c | of the current upper Hessenberg matrix H. | c | dlaqrb returns the full Schur form of H in WORKL(1:N**2) | c | and the last components of the Schur vectors in BOUNDS. | c %-----------------------------------------------------------% c call dlacpy ('All', n, n, h, ldh, workl, n) call dlaqrb (.true., n, 1, n, workl, n, ritzr, ritzi, bounds, & ierr) if (ierr .ne. 0) go to 9000 c if (msglvl .gt. 1) then call dvout (logfil, n, bounds, ndigit, & '_neigh: last row of the Schur matrix for H') end if c c %-----------------------------------------------------------% c | 2. Compute the eigenvectors of the full Schur form T and | c | apply the last components of the Schur vectors to get | c | the last components of the corresponding eigenvectors. | c | Remember that if the i-th and (i+1)-st eigenvalues are | c | complex conjugate pairs, then the real & imaginary part | c | of the eigenvector components are split across adjacent | c | columns of Q. | c %-----------------------------------------------------------% c call dtrevc ('R', 'A', select, n, workl, n, vl, n, q, ldq, & n, n, workl(n*n+1), ierr) c if (ierr .ne. 0) go to 9000 c c %------------------------------------------------% c | Scale the returning eigenvectors so that their | c | euclidean norms are all one. LAPACK subroutine | c | dtrevc returns each eigenvector normalized so | c | that the element of largest magnitude has | c | magnitude 1; here the magnitude of a complex | c | number (x,y) is taken to be |x| + |y|. | c %------------------------------------------------% c iconj = 0 do 10 i=1, n if ( abs( ritzi(i) ) .le. zero ) then c c %----------------------% c | Real eigenvalue case | c %----------------------% c temp = dnrm2( n, q(1,i), 1 ) call dscal ( n, one / temp, q(1,i), 1 ) else c c %-------------------------------------------% c | Complex conjugate pair case. Note that | c | since the real and imaginary part of | c | the eigenvector are stored in consecutive | c | columns, we further normalize by the | c | square root of two. | c %-------------------------------------------% c if (iconj .eq. 0) then temp = dlapy2( dnrm2( n, q(1,i), 1 ), & dnrm2( n, q(1,i+1), 1 ) ) call dscal ( n, one / temp, q(1,i), 1 ) call dscal ( n, one / temp, q(1,i+1), 1 ) iconj = 1 else iconj = 0 end if end if 10 continue c call dgemv ('T', n, n, one, q, ldq, bounds, 1, zero, workl, 1) c if (msglvl .gt. 1) then call dvout (logfil, n, workl, ndigit, & '_neigh: Last row of the eigenvector matrix for H') end if c c %----------------------------% c | Compute the Ritz estimates | c %----------------------------% c iconj = 0 do 20 i = 1, n if ( abs( ritzi(i) ) .le. zero ) then c c %----------------------% c | Real eigenvalue case | c %----------------------% c bounds(i) = rnorm * abs( workl(i) ) else c c %-------------------------------------------% c | Complex conjugate pair case. Note that | c | since the real and imaginary part of | c | the eigenvector are stored in consecutive | c | columns, we need to take the magnitude | c | of the last components of the two vectors | c %-------------------------------------------% c if (iconj .eq. 0) then bounds(i) = rnorm * dlapy2( workl(i), workl(i+1) ) bounds(i+1) = bounds(i) iconj = 1 else iconj = 0 end if end if 20 continue c if (msglvl .gt. 2) then call dvout (logfil, n, ritzr, ndigit, & '_neigh: Real part of the eigenvalues of H') call dvout (logfil, n, ritzi, ndigit, & '_neigh: Imaginary part of the eigenvalues of H') call dvout (logfil, n, bounds, ndigit, & '_neigh: Ritz estimates for the eigenvalues of H') end if c call second (t1) tneigh = tneigh + (t1 - t0) c 9000 continue return c c %---------------% c | End of dneigh | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dnapps.f000644 001750 001750 00000055721 11266605602 022114 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: dnapps c c\Description: c Given the Arnoldi factorization c c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T, c c apply NP implicit shifts resulting in c c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q c c where Q is an orthogonal matrix which is the product of rotations c and reflections resulting from the NP bulge chage sweeps. c The updated Arnoldi factorization becomes: c c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T. c c\Usage: c call dnapps c ( N, KEV, NP, SHIFTR, SHIFTI, V, LDV, H, LDH, RESID, Q, LDQ, c WORKL, WORKD ) c c\Arguments c N Integer. (INPUT) c Problem size, i.e. size of matrix A. c c KEV Integer. (INPUT/OUTPUT) c KEV+NP is the size of the input matrix H. c KEV is the size of the updated matrix HNEW. KEV is only c updated on ouput when fewer than NP shifts are applied in c order to keep the conjugate pair together. c c NP Integer. (INPUT) c Number of implicit shifts to be applied. c c SHIFTR, Double precision array of length NP. (INPUT) c SHIFTI Real and imaginary part of the shifts to be applied. c Upon, entry to dnapps, the shifts must be sorted so that the c conjugate pairs are in consecutive locations. c c V Double precision N by (KEV+NP) array. (INPUT/OUTPUT) c On INPUT, V contains the current KEV+NP Arnoldi vectors. c On OUTPUT, V contains the updated KEV Arnoldi vectors c in the first KEV columns of V. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Double precision (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT) c On INPUT, H contains the current KEV+NP by KEV+NP upper c Hessenber matrix of the Arnoldi factorization. c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg c matrix in the KEV leading submatrix. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RESID Double precision array of length N. (INPUT/OUTPUT) c On INPUT, RESID contains the the residual vector r_{k+p}. c On OUTPUT, RESID is the update residual vector rnew_{k} c in the first KEV locations. c c Q Double precision KEV+NP by KEV+NP work array. (WORKSPACE) c Work array used to accumulate the rotations and reflections c during the bulge chase sweep. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKL Double precision work array of length (KEV+NP). (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. c c WORKD Double precision work array of length 2*N. (WORKSPACE) c Distributed array used in the application of the accumulated c orthogonal matrix Q. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c c\Routines called: c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c dmout ARPACK utility routine that prints matrices. c dvout ARPACK utility routine that prints vectors. c dlabad LAPACK routine that computes machine constants. c dlacpy LAPACK matrix copy routine. c dlamch LAPACK routine that determines machine constants. c dlanhs LAPACK routine that computes various norms of a matrix. c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c dlarf LAPACK routine that applies Householder reflection to c a matrix. c dlarfg LAPACK Householder reflection construction routine. c dlartg LAPACK Givens rotation construction routine. c dlaset LAPACK matrix initialization routine. c dgemv Level 2 BLAS routine for matrix vector multiplication. c daxpy Level 1 BLAS that computes a vector triad. c dcopy Level 1 BLAS that copies one vector to another . c dscal Level 1 BLAS that scales a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.4' c c\SCCS Information: @(#) c FILE: napps.F SID: 2.4 DATE OF SID: 3/28/97 RELEASE: 2 c c\Remarks c 1. In this version, each shift is applied to all the sublocks of c the Hessenberg matrix H and not just to the submatrix that it c comes from. Deflation as in LAPACK routine dlahqr (QR algorithm c for upper Hessenberg matrices ) is used. c The subdiagonals of H are enforced to be non-negative. c c\EndLib c c----------------------------------------------------------------------- c subroutine dnapps & ( n, kev, np, shiftr, shifti, v, ldv, h, ldh, resid, q, ldq, & workl, workd ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer kev, ldh, ldq, ldv, n, np c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & h(ldh,kev+np), resid(n), shifti(np), shiftr(np), & v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c integer i, iend, ir, istart, j, jj, kplusp, msglvl, nr logical cconj, first Double precision & c, f, g, h11, h12, h21, h22, h32, ovfl, r, s, sigmai, & sigmar, smlnum, ulp, unfl, u(3), t, tau, tst1 save first, ovfl, smlnum, ulp, unfl c c %----------------------% c | External Subroutines | c %----------------------% c external daxpy, dcopy, dscal, dlacpy, dlarfg, dlarf, & dlaset, dlabad, second, dlartg c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlamch, dlanhs, dlapy2 external dlamch, dlanhs, dlapy2 c c %----------------------% c | Intrinsics Functions | c %----------------------% c intrinsic abs, max, min c c %----------------% c | Data statments | c %----------------% c data first / .true. / c c %-----------------------% c | Executable Statements | c %-----------------------% c if (first) then c c %-----------------------------------------------% c | Set machine-dependent constants for the | c | stopping criterion. If norm(H) <= sqrt(OVFL), | c | overflow should not occur. | c | REFERENCE: LAPACK subroutine dlahqr | c %-----------------------------------------------% c unfl = dlamch( 'safe minimum' ) ovfl = one / unfl call dlabad( unfl, ovfl ) ulp = dlamch( 'precision' ) smlnum = unfl*( n / ulp ) first = .false. end if c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mnapps kplusp = kev + np c c %--------------------------------------------% c | Initialize Q to the identity to accumulate | c | the rotations and reflections | c %--------------------------------------------% c call dlaset ('All', kplusp, kplusp, zero, one, q, ldq) c c %----------------------------------------------% c | Quick return if there are no shifts to apply | c %----------------------------------------------% c if (np .eq. 0) go to 9000 c c %----------------------------------------------% c | Chase the bulge with the application of each | c | implicit shift. Each shift is applied to the | c | whole matrix including each block. | c %----------------------------------------------% c cconj = .false. do 110 jj = 1, np sigmar = shiftr(jj) sigmai = shifti(jj) c if (msglvl .gt. 2 ) then call ivout (logfil, 1, jj, ndigit, & '_napps: shift number.') call dvout (logfil, 1, sigmar, ndigit, & '_napps: The real part of the shift ') call dvout (logfil, 1, sigmai, ndigit, & '_napps: The imaginary part of the shift ') end if c c %-------------------------------------------------% c | The following set of conditionals is necessary | c | in order that complex conjugate pairs of shifts | c | are applied together or not at all. | c %-------------------------------------------------% c if ( cconj ) then c c %-----------------------------------------% c | cconj = .true. means the previous shift | c | had non-zero imaginary part. | c %-----------------------------------------% c cconj = .false. go to 110 else if ( jj .lt. np .and. abs( sigmai ) .gt. zero ) then c c %------------------------------------% c | Start of a complex conjugate pair. | c %------------------------------------% c cconj = .true. else if ( jj .eq. np .and. abs( sigmai ) .gt. zero ) then c c %----------------------------------------------% c | The last shift has a nonzero imaginary part. | c | Don't apply it; thus the order of the | c | compressed H is order KEV+1 since only np-1 | c | were applied. | c %----------------------------------------------% c kev = kev + 1 go to 110 end if istart = 1 20 continue c c %--------------------------------------------------% c | if sigmai = 0 then | c | Apply the jj-th shift ... | c | else | c | Apply the jj-th and (jj+1)-th together ... | c | (Note that jj < np at this point in the code) | c | end | c | to the current block of H. The next do loop | c | determines the current block ; | c %--------------------------------------------------% c do 30 i = istart, kplusp-1 c c %----------------------------------------% c | Check for splitting and deflation. Use | c | a standard test as in the QR algorithm | c | REFERENCE: LAPACK subroutine dlahqr | c %----------------------------------------% c tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) ) if( tst1.eq.zero ) & tst1 = dlanhs( '1', kplusp-jj+1, h, ldh, workl ) if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) then if (msglvl .gt. 0) then call ivout (logfil, 1, i, ndigit, & '_napps: matrix splitting at row/column no.') call ivout (logfil, 1, jj, ndigit, & '_napps: matrix splitting with shift number.') call dvout (logfil, 1, h(i+1,i), ndigit, & '_napps: off diagonal element.') end if iend = i h(i+1,i) = zero go to 40 end if 30 continue iend = kplusp 40 continue c if (msglvl .gt. 2) then call ivout (logfil, 1, istart, ndigit, & '_napps: Start of current block ') call ivout (logfil, 1, iend, ndigit, & '_napps: End of current block ') end if c c %------------------------------------------------% c | No reason to apply a shift to block of order 1 | c %------------------------------------------------% c if ( istart .eq. iend ) go to 100 c c %------------------------------------------------------% c | If istart + 1 = iend then no reason to apply a | c | complex conjugate pair of shifts on a 2 by 2 matrix. | c %------------------------------------------------------% c if ( istart + 1 .eq. iend .and. abs( sigmai ) .gt. zero ) & go to 100 c h11 = h(istart,istart) h21 = h(istart+1,istart) if ( abs( sigmai ) .le. zero ) then c c %---------------------------------------------% c | Real-valued shift ==> apply single shift QR | c %---------------------------------------------% c f = h11 - sigmar g = h21 c do 80 i = istart, iend-1 c c %-----------------------------------------------------% c | Contruct the plane rotation G to zero out the bulge | c %-----------------------------------------------------% c call dlartg (f, g, c, s, r) if (i .gt. istart) then c c %-------------------------------------------% c | The following ensures that h(1:iend-1,1), | c | the first iend-2 off diagonal of elements | c | H, remain non negative. | c %-------------------------------------------% c if (r .lt. zero) then r = -r c = -c s = -s end if h(i,i-1) = r h(i+1,i-1) = zero end if c c %---------------------------------------------% c | Apply rotation to the left of H; H <- G'*H | c %---------------------------------------------% c do 50 j = i, kplusp t = c*h(i,j) + s*h(i+1,j) h(i+1,j) = -s*h(i,j) + c*h(i+1,j) h(i,j) = t 50 continue c c %---------------------------------------------% c | Apply rotation to the right of H; H <- H*G | c %---------------------------------------------% c do 60 j = 1, min(i+2,iend) t = c*h(j,i) + s*h(j,i+1) h(j,i+1) = -s*h(j,i) + c*h(j,i+1) h(j,i) = t 60 continue c c %----------------------------------------------------% c | Accumulate the rotation in the matrix Q; Q <- Q*G | c %----------------------------------------------------% c do 70 j = 1, min( i+jj, kplusp ) t = c*q(j,i) + s*q(j,i+1) q(j,i+1) = - s*q(j,i) + c*q(j,i+1) q(j,i) = t 70 continue c c %---------------------------% c | Prepare for next rotation | c %---------------------------% c if (i .lt. iend-1) then f = h(i+1,i) g = h(i+2,i) end if 80 continue c c %-----------------------------------% c | Finished applying the real shift. | c %-----------------------------------% c else c c %----------------------------------------------------% c | Complex conjugate shifts ==> apply double shift QR | c %----------------------------------------------------% c h12 = h(istart,istart+1) h22 = h(istart+1,istart+1) h32 = h(istart+2,istart+1) c c %---------------------------------------------------------% c | Compute 1st column of (H - shift*I)*(H - conj(shift)*I) | c %---------------------------------------------------------% c s = 2.0*sigmar t = dlapy2 ( sigmar, sigmai ) u(1) = ( h11 * (h11 - s) + t * t ) / h21 + h12 u(2) = h11 + h22 - s u(3) = h32 c do 90 i = istart, iend-1 c nr = min ( 3, iend-i+1 ) c c %-----------------------------------------------------% c | Construct Householder reflector G to zero out u(1). | c | G is of the form I - tau*( 1 u )' * ( 1 u' ). | c %-----------------------------------------------------% c call dlarfg ( nr, u(1), u(2), 1, tau ) c if (i .gt. istart) then h(i,i-1) = u(1) h(i+1,i-1) = zero if (i .lt. iend-1) h(i+2,i-1) = zero end if u(1) = one c c %--------------------------------------% c | Apply the reflector to the left of H | c %--------------------------------------% c call dlarf ('Left', nr, kplusp-i+1, u, 1, tau, & h(i,i), ldh, workl) c c %---------------------------------------% c | Apply the reflector to the right of H | c %---------------------------------------% c ir = min ( i+3, iend ) call dlarf ('Right', ir, nr, u, 1, tau, & h(1,i), ldh, workl) c c %-----------------------------------------------------% c | Accumulate the reflector in the matrix Q; Q <- Q*G | c %-----------------------------------------------------% c call dlarf ('Right', kplusp, nr, u, 1, tau, & q(1,i), ldq, workl) c c %----------------------------% c | Prepare for next reflector | c %----------------------------% c if (i .lt. iend-1) then u(1) = h(i+1,i) u(2) = h(i+2,i) if (i .lt. iend-2) u(3) = h(i+3,i) end if c 90 continue c c %--------------------------------------------% c | Finished applying a complex pair of shifts | c | to the current block | c %--------------------------------------------% c end if c 100 continue c c %---------------------------------------------------------% c | Apply the same shift to the next block if there is any. | c %---------------------------------------------------------% c istart = iend + 1 if (iend .lt. kplusp) go to 20 c c %---------------------------------------------% c | Loop back to the top to get the next shift. | c %---------------------------------------------% c 110 continue c c %--------------------------------------------------% c | Perform a similarity transformation that makes | c | sure that H will have non negative sub diagonals | c %--------------------------------------------------% c do 120 j=1,kev if ( h(j+1,j) .lt. zero ) then call dscal( kplusp-j+1, -one, h(j+1,j), ldh ) call dscal( min(j+2, kplusp), -one, h(1,j+1), 1 ) call dscal( min(j+np+1,kplusp), -one, q(1,j+1), 1 ) end if 120 continue c do 130 i = 1, kev c c %--------------------------------------------% c | Final check for splitting and deflation. | c | Use a standard test as in the QR algorithm | c | REFERENCE: LAPACK subroutine dlahqr | c %--------------------------------------------% c tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) ) if( tst1.eq.zero ) & tst1 = dlanhs( '1', kev, h, ldh, workl ) if( h( i+1,i ) .le. max( ulp*tst1, smlnum ) ) & h(i+1,i) = zero 130 continue c c %-------------------------------------------------% c | Compute the (kev+1)-st column of (V*Q) and | c | temporarily store the result in WORKD(N+1:2*N). | c | This is needed in the residual update since we | c | cannot GUARANTEE that the corresponding entry | c | of H would be zero as in exact arithmetic. | c %-------------------------------------------------% c if (h(kev+1,kev) .gt. zero) & call dgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero, & workd(n+1), 1) c c %----------------------------------------------------------% c | Compute column 1 to kev of (V*Q) in backward order | c | taking advantage of the upper Hessenberg structure of Q. | c %----------------------------------------------------------% c do 140 i = 1, kev call dgemv ('N', n, kplusp-i+1, one, v, ldv, & q(1,kev-i+1), 1, zero, workd, 1) call dcopy (n, workd, 1, v(1,kplusp-i+1), 1) 140 continue c c %-------------------------------------------------% c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). | c %-------------------------------------------------% c call dlacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv) c c %--------------------------------------------------------------% c | Copy the (kev+1)-st column of (V*Q) in the appropriate place | c %--------------------------------------------------------------% c if (h(kev+1,kev) .gt. zero) & call dcopy (n, workd(n+1), 1, v(1,kev+1), 1) c c %-------------------------------------% c | Update the residual vector: | c | r <- sigmak*r + betak*v(:,kev+1) | c | where | c | sigmak = (e_{kplusp}'*Q)*e_{kev} | c | betak = e_{kev+1}'*H*e_{kev} | c %-------------------------------------% c call dscal (n, q(kplusp,kev), resid, 1) if (h(kev+1,kev) .gt. zero) & call daxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1) c if (msglvl .gt. 1) then call dvout (logfil, 1, q(kplusp,kev), ndigit, & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}') call dvout (logfil, 1, h(kev+1,kev), ndigit, & '_napps: betak = e_{kev+1}^T*H*e_{kev}') call ivout (logfil, 1, kev, ndigit, & '_napps: Order of the final Hessenberg matrix ') if (msglvl .gt. 2) then call dmout (logfil, kev, kev, h, ldh, ndigit, & '_napps: updated Hessenberg matrix H for next iteration') end if c end if c 9000 continue call second (t1) tnapps = tnapps + (t1 - t0) c return c c %---------------% c | End of dnapps | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dsortr.f000644 001750 001750 00000012354 11266605602 022137 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: dsortr c c\Description: c Sort the array X1 in the order specified by WHICH and optionally c applies the permutation to the array X2. c c\Usage: c call dsortr c ( WHICH, APPLY, N, X1, X2 ) c c\Arguments c WHICH Character*2. (Input) c 'LM' -> X1 is sorted into increasing order of magnitude. c 'SM' -> X1 is sorted into decreasing order of magnitude. c 'LA' -> X1 is sorted into increasing order of algebraic. c 'SA' -> X1 is sorted into decreasing order of algebraic. c c APPLY Logical. (Input) c APPLY = .TRUE. -> apply the sorted order to X2. c APPLY = .FALSE. -> do not apply the sorted order to X2. c c N Integer. (INPUT) c Size of the arrays. c c X1 Double precision array of length N. (INPUT/OUTPUT) c The array to be sorted. c c X2 Double precision array of length N. (INPUT/OUTPUT) c Only referenced if APPLY = .TRUE. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/16/93: Version ' 2.1'. c Adapted from the sort routine in LANSO. c c\SCCS Information: @(#) c FILE: sortr.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine dsortr (which, apply, n, x1, x2) c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which logical apply integer n c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & x1(0:n-1), x2(0:n-1) c c %---------------% c | Local Scalars | c %---------------% c integer i, igap, j Double precision & temp c c %-----------------------% c | Executable Statements | c %-----------------------% c igap = n / 2 c if (which .eq. 'SA') then c c X1 is sorted into decreasing order of algebraic. c 10 continue if (igap .eq. 0) go to 9000 do 30 i = igap, n-1 j = i-igap 20 continue c if (j.lt.0) go to 30 c if (x1(j).lt.x1(j+igap)) then temp = x1(j) x1(j) = x1(j+igap) x1(j+igap) = temp if (apply) then temp = x2(j) x2(j) = x2(j+igap) x2(j+igap) = temp end if else go to 30 endif j = j-igap go to 20 30 continue igap = igap / 2 go to 10 c else if (which .eq. 'SM') then c c X1 is sorted into decreasing order of magnitude. c 40 continue if (igap .eq. 0) go to 9000 do 60 i = igap, n-1 j = i-igap 50 continue c if (j.lt.0) go to 60 c if (abs(x1(j)).lt.abs(x1(j+igap))) then temp = x1(j) x1(j) = x1(j+igap) x1(j+igap) = temp if (apply) then temp = x2(j) x2(j) = x2(j+igap) x2(j+igap) = temp end if else go to 60 endif j = j-igap go to 50 60 continue igap = igap / 2 go to 40 c else if (which .eq. 'LA') then c c X1 is sorted into increasing order of algebraic. c 70 continue if (igap .eq. 0) go to 9000 do 90 i = igap, n-1 j = i-igap 80 continue c if (j.lt.0) go to 90 c if (x1(j).gt.x1(j+igap)) then temp = x1(j) x1(j) = x1(j+igap) x1(j+igap) = temp if (apply) then temp = x2(j) x2(j) = x2(j+igap) x2(j+igap) = temp end if else go to 90 endif j = j-igap go to 80 90 continue igap = igap / 2 go to 70 c else if (which .eq. 'LM') then c c X1 is sorted into increasing order of magnitude. c 100 continue if (igap .eq. 0) go to 9000 do 120 i = igap, n-1 j = i-igap 110 continue c if (j.lt.0) go to 120 c if (abs(x1(j)).gt.abs(x1(j+igap))) then temp = x1(j) x1(j) = x1(j+igap) x1(j+igap) = temp if (apply) then temp = x2(j) x2(j) = x2(j+igap) x2(j+igap) = temp end if else go to 120 endif j = j-igap go to 110 120 continue igap = igap / 2 go to 100 end if c 9000 continue return c c %---------------% c | End of dsortr | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/cgetv0.f000644 001750 001750 00000031150 11266605602 022005 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: cgetv0 c c\Description: c Generate a random initial residual vector for the Arnoldi process. c Force the residual vector to be in the range of the operator OP. c c\Usage: c call cgetv0 c ( IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM, c IPNTR, WORKD, IERR ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. IDO must be zero on the first c call to cgetv0. c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c This is for the initialization phase to force the c starting vector into the range of OP. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c IDO = 99: done c ------------------------------------------------------------- c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B in the (generalized) c eigenvalue problem A*x = lambda*B*x. c B = 'I' -> standard eigenvalue problem A*x = lambda*x c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x c c ITRY Integer. (INPUT) c ITRY counts the number of times that cgetv0 is called. c It should be set to 1 on the initial call to cgetv0. c c INITV Logical variable. (INPUT) c .TRUE. => the initial residual vector is given in RESID. c .FALSE. => generate a random initial residual vector. c c N Integer. (INPUT) c Dimension of the problem. c c J Integer. (INPUT) c Index of the residual vector to be generated, with respect to c the Arnoldi process. J > 1 in case of a "restart". c c V Complex N by J array. (INPUT) c The first J-1 columns of V contain the current Arnoldi basis c if this is a "restart". c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c RESID Complex array of length N. (INPUT/OUTPUT) c Initial residual vector to be generated. If RESID is c provided, force RESID into the range of the operator OP. c c RNORM Real scalar. (OUTPUT) c B-norm of the generated residual. c c IPNTR Integer array of length 3. (OUTPUT) c c WORKD Complex work array of length 2*N. (REVERSE COMMUNICATION). c On exit, WORK(1:N) = B*RESID to be used in SSAITR. c c IERR Integer. (OUTPUT) c = 0: Normal exit. c = -1: Cannot generate a nontrivial restarted residual vector c in the range of the operator OP. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx Complex c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c c\Routines called: c second ARPACK utility routine for timing. c cvout ARPACK utility routine that prints vectors. c clarnv LAPACK routine for generating a random vector. c cgemv Level 2 BLAS routine for matrix vector multiplication. c ccopy Level 1 BLAS that copies one vector to another. c cdotc Level 1 BLAS that computes the scalar product of two vectors. c scnrm2 Level 1 BLAS that computes the norm of a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: getv0.F SID: 2.3 DATE OF SID: 08/27/96 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine cgetv0 & ( ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm, & ipntr, workd, ierr ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1 logical initv integer ido, ierr, itry, j, ldv, n Real & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(3) Complex & resid(n), v(ldv,j), workd(2*n) c c %------------% c | Parameters | c %------------% c Complex & one, zero Real & rzero parameter (one = (1.0E+0, 0.0E+0), zero = (0.0E+0, 0.0E+0), & rzero = 0.0E+0) c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c logical first, inits, orth integer idist, iseed(4), iter, msglvl, jj Real & rnorm0 Complex & cnorm save first, iseed, inits, iter, msglvl, orth, rnorm0 c c %----------------------% c | External Subroutines | c %----------------------% c external ccopy, cgemv, clarnv, cvout, second c c %--------------------% c | External Functions | c %--------------------% c Real & scnrm2, slapy2 Complex & cdotc external cdotc, scnrm2, slapy2 c c %-----------------% c | Data Statements | c %-----------------% c data inits /.true./ c c %-----------------------% c | Executable Statements | c %-----------------------% c c c %-----------------------------------% c | Initialize the seed of the LAPACK | c | random number generator | c %-----------------------------------% c if (inits) then iseed(1) = 1 iseed(2) = 3 iseed(3) = 5 iseed(4) = 7 inits = .false. end if c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mgetv0 c ierr = 0 iter = 0 first = .FALSE. orth = .FALSE. c c %-----------------------------------------------------% c | Possibly generate a random starting vector in RESID | c | Use a LAPACK random number generator used by the | c | matrix generation routines. | c | idist = 1: uniform (0,1) distribution; | c | idist = 2: uniform (-1,1) distribution; | c | idist = 3: normal (0,1) distribution; | c %-----------------------------------------------------% c if (.not.initv) then idist = 2 call clarnv (idist, iseed, n, resid) end if c c %----------------------------------------------------------% c | Force the starting vector into the range of OP to handle | c | the generalized problem when B is possibly (singular). | c %----------------------------------------------------------% c call second (t2) if (bmat .eq. 'G') then nopx = nopx + 1 ipntr(1) = 1 ipntr(2) = n + 1 call ccopy (n, resid, 1, workd, 1) ido = -1 go to 9000 end if end if c c %----------------------------------------% c | Back from computing B*(initial-vector) | c %----------------------------------------% c if (first) go to 20 c c %-----------------------------------------------% c | Back from computing B*(orthogonalized-vector) | c %-----------------------------------------------% c if (orth) go to 40 c call second (t3) tmvopx = tmvopx + (t3 - t2) c c %------------------------------------------------------% c | Starting vector is now in the range of OP; r = OP*r; | c | Compute B-norm of starting vector. | c %------------------------------------------------------% c call second (t2) first = .TRUE. if (bmat .eq. 'G') then nbx = nbx + 1 call ccopy (n, workd(n+1), 1, resid, 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 go to 9000 else if (bmat .eq. 'I') then call ccopy (n, resid, 1, workd, 1) end if c 20 continue c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c first = .FALSE. if (bmat .eq. 'G') then cnorm = cdotc (n, resid, 1, workd, 1) rnorm0 = sqrt(slapy2(real(cnorm),aimag(cnorm))) else if (bmat .eq. 'I') then rnorm0 = scnrm2(n, resid, 1) end if rnorm = rnorm0 c c %---------------------------------------------% c | Exit if this is the very first Arnoldi step | c %---------------------------------------------% c if (j .eq. 1) go to 50 c c %---------------------------------------------------------------- c | Otherwise need to B-orthogonalize the starting vector against | c | the current Arnoldi basis using Gram-Schmidt with iter. ref. | c | This is the case where an invariant subspace is encountered | c | in the middle of the Arnoldi factorization. | c | | c | s = V^{T}*B*r; r = r - V*s; | c | | c | Stopping criteria used for iter. ref. is discussed in | c | Parlett's book, page 107 and in Gragg & Reichel TOMS paper. | c %---------------------------------------------------------------% c orth = .TRUE. 30 continue c call cgemv ('C', n, j-1, one, v, ldv, workd, 1, & zero, workd(n+1), 1) call cgemv ('N', n, j-1, -one, v, ldv, workd(n+1), 1, & one, resid, 1) c c %----------------------------------------------------------% c | Compute the B-norm of the orthogonalized starting vector | c %----------------------------------------------------------% c call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call ccopy (n, resid, 1, workd(n+1), 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 go to 9000 else if (bmat .eq. 'I') then call ccopy (n, resid, 1, workd, 1) end if c 40 continue c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c if (bmat .eq. 'G') then cnorm = cdotc (n, resid, 1, workd, 1) rnorm = sqrt(slapy2(real(cnorm),aimag(cnorm))) else if (bmat .eq. 'I') then rnorm = scnrm2(n, resid, 1) end if c c %--------------------------------------% c | Check for further orthogonalization. | c %--------------------------------------% c if (msglvl .gt. 2) then call svout (logfil, 1, rnorm0, ndigit, & '_getv0: re-orthonalization ; rnorm0 is') call svout (logfil, 1, rnorm, ndigit, & '_getv0: re-orthonalization ; rnorm is') end if c if (rnorm .gt. 0.717*rnorm0) go to 50 c iter = iter + 1 if (iter .le. 1) then c c %-----------------------------------% c | Perform iterative refinement step | c %-----------------------------------% c rnorm0 = rnorm go to 30 else c c %------------------------------------% c | Iterative refinement step "failed" | c %------------------------------------% c do 45 jj = 1, n resid(jj) = zero 45 continue rnorm = rzero ierr = -1 end if c 50 continue c if (msglvl .gt. 0) then call svout (logfil, 1, rnorm, ndigit, & '_getv0: B-norm of initial / restarted starting vector') end if if (msglvl .gt. 2) then call cvout (logfil, n, resid, ndigit, & '_getv0: initial / restarted starting vector') end if ido = 99 c call second (t1) tgetv0 = tgetv0 + (t1 - t0) c 9000 continue return c c %---------------% c | End of cgetv0 | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dsconv.f000644 001750 001750 00000006602 11266605602 022115 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: dsconv c c\Description: c Convergence testing for the symmetric Arnoldi eigenvalue routine. c c\Usage: c call dsconv c ( N, RITZ, BOUNDS, TOL, NCONV ) c c\Arguments c N Integer. (INPUT) c Number of Ritz values to check for convergence. c c RITZ Double precision array of length N. (INPUT) c The Ritz values to be checked for convergence. c c BOUNDS Double precision array of length N. (INPUT) c Ritz estimates associated with the Ritz values in RITZ. c c TOL Double precision scalar. (INPUT) c Desired relative accuracy for a Ritz value to be considered c "converged". c c NCONV Integer scalar. (OUTPUT) c Number of "converged" Ritz values. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Routines called: c second ARPACK utility routine for timing. c dlamch LAPACK routine that determines machine constants. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: sconv.F SID: 2.4 DATE OF SID: 4/19/96 RELEASE: 2 c c\Remarks c 1. Starting with version 2.4, this routine no longer uses the c Parlett strategy using the gap conditions. c c\EndLib c c----------------------------------------------------------------------- c subroutine dsconv (n, ritz, bounds, tol, nconv) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer n, nconv Double precision & tol c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & ritz(n), bounds(n) c c %---------------% c | Local Scalars | c %---------------% c integer i Double precision & temp, eps23 c c %-------------------% c | External routines | c %-------------------% c Double precision & dlamch external dlamch c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic abs c c %-----------------------% c | Executable Statements | c %-----------------------% c call second (t0) c eps23 = dlamch('Epsilon-Machine') eps23 = eps23**(2.0D+0 / 3.0D+0) c nconv = 0 do 10 i = 1, n c c %-----------------------------------------------------% c | The i-th Ritz value is considered "converged" | c | when: bounds(i) .le. TOL*max(eps23, abs(ritz(i))) | c %-----------------------------------------------------% c temp = max( eps23, abs(ritz(i)) ) if ( bounds(i) .le. tol*temp ) then nconv = nconv + 1 end if c 10 continue c call second (t1) tsconv = tsconv + (t1 - t0) c return c c %---------------% c | End of dsconv | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/znaupd.f000644 001750 001750 00000066315 11266605602 022131 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: znaupd c c\Description: c Reverse communication interface for the Implicitly Restarted Arnoldi c iteration. This is intended to be used to find a few eigenpairs of a c complex linear operator OP with respect to a semi-inner product defined c by a hermitian positive semi-definite real matrix B. B may be the identity c matrix. NOTE: if both OP and B are real, then dsaupd or dnaupd should c be used. c c c The computed approximate eigenvalues are called Ritz values and c the corresponding approximate eigenvectors are called Ritz vectors. c c znaupd is usually called iteratively to solve one of the c following problems: c c Mode 1: A*x = lambda*x. c ===> OP = A and B = I. c c Mode 2: A*x = lambda*M*x, M hermitian positive definite c ===> OP = inv[M]*A and B = M. c ===> (If M can be factored see remark 3 below) c c Mode 3: A*x = lambda*M*x, M hermitian semi-definite c ===> OP = inv[A - sigma*M]*M and B = M. c ===> shift-and-invert mode c If OP*x = amu*x, then lambda = sigma + 1/amu. c c c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v c should be accomplished either by a direct method c using a sparse matrix factorization and solving c c [A - sigma*M]*w = v or M*w = v, c c or through an iterative method for solving these c systems. If an iterative method is used, the c convergence test must be more stringent than c the accuracy requirements for the eigenvalue c approximations. c c\Usage: c call znaupd c ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, c IPNTR, WORKD, WORKL, LWORKL, RWORK, INFO ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. IDO must be zero on the first c call to znaupd. IDO will be set internally to c indicate the type of operation to be performed. Control is c then given back to the calling routine which has the c responsibility to carry out the requested operation and call c znaupd with the result. The operand is given in c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)). c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c This is for the initialization phase to force the c starting vector into the range of OP. c IDO = 1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c In mode 3, the vector B * X is already c available in WORKD(ipntr(3)). It does not c need to be recomputed in forming OP * X. c IDO = 2: compute Y = M * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c IDO = 3: compute and return the shifts in the first c NP locations of WORKL. c IDO = 99: done c ------------------------------------------------------------- c After the initialization phase, when the routine is used in c the "shift-and-invert" mode, the vector M * X is already c available and does not need to be recomputed in forming OP*X. c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B that defines the c semi-inner product for the operator OP. c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*M*x c c N Integer. (INPUT) c Dimension of the eigenproblem. c c WHICH Character*2. (INPUT) c 'LM' -> want the NEV eigenvalues of largest magnitude. c 'SM' -> want the NEV eigenvalues of smallest magnitude. c 'LR' -> want the NEV eigenvalues of largest real part. c 'SR' -> want the NEV eigenvalues of smallest real part. c 'LI' -> want the NEV eigenvalues of largest imaginary part. c 'SI' -> want the NEV eigenvalues of smallest imaginary part. c c NEV Integer. (INPUT) c Number of eigenvalues of OP to be computed. 0 < NEV < N-1. c c TOL Double precision scalar. (INPUT) c Stopping criteria: the relative accuracy of the Ritz value c is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)) c where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex. c DEFAULT = dlamch('EPS') (machine precision as computed c by the LAPACK auxiliary subroutine dlamch). c c RESID Complex*16 array of length N. (INPUT/OUTPUT) c On INPUT: c If INFO .EQ. 0, a random initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c On OUTPUT: c RESID contains the final residual vector. c c NCV Integer. (INPUT) c Number of columns of the matrix V. NCV must satisfy the two c inequalities 1 <= NCV-NEV and NCV <= N. c This will indicate how many Arnoldi vectors are generated c at each iteration. After the startup phase in which NEV c Arnoldi vectors are generated, the algorithm generates c approximately NCV-NEV Arnoldi vectors at each subsequent update c iteration. Most of the cost in generating each Arnoldi vector is c in the matrix-vector operation OP*x. (See remark 4 below.) c c V Complex*16 array N by NCV. (OUTPUT) c Contains the final set of Arnoldi basis vectors. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling program. c c IPARAM Integer array of length 11. (INPUT/OUTPUT) c IPARAM(1) = ISHIFT: method for selecting the implicit shifts. c The shifts selected at each iteration are used to filter out c the components of the unwanted eigenvector. c ------------------------------------------------------------- c ISHIFT = 0: the shifts are to be provided by the user via c reverse communication. The NCV eigenvalues of c the Hessenberg matrix H are returned in the part c of WORKL array corresponding to RITZ. c ISHIFT = 1: exact shifts with respect to the current c Hessenberg matrix H. This is equivalent to c restarting the iteration from the beginning c after updating the starting vector with a linear c combination of Ritz vectors associated with the c "wanted" eigenvalues. c ISHIFT = 2: other choice of internal shift to be defined. c ------------------------------------------------------------- c c IPARAM(2) = No longer referenced c c IPARAM(3) = MXITER c On INPUT: maximum number of Arnoldi update iterations allowed. c On OUTPUT: actual number of Arnoldi update iterations taken. c c IPARAM(4) = NB: blocksize to be used in the recurrence. c The code currently works only for NB = 1. c c IPARAM(5) = NCONV: number of "converged" Ritz values. c This represents the number of Ritz values that satisfy c the convergence criterion. c c IPARAM(6) = IUPD c No longer referenced. Implicit restarting is ALWAYS used. c c IPARAM(7) = MODE c On INPUT determines what type of eigenproblem is being solved. c Must be 1,2,3; See under \Description of znaupd for the c four modes available. c c IPARAM(8) = NP c When ido = 3 and the user provides shifts through reverse c communication (IPARAM(1)=0), _naupd returns NP, the number c of shifts the user is to provide. 0 < NP < NCV-NEV. c c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO, c OUTPUT: NUMOP = total number of OP*x operations, c NUMOPB = total number of B*x operations if BMAT='G', c NUMREO = total number of steps of re-orthogonalization. c c IPNTR Integer array of length 14. (OUTPUT) c Pointer to mark the starting locations in the WORKD and WORKL c arrays for matrices/vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X in WORKD. c IPNTR(2): pointer to the current result vector Y in WORKD. c IPNTR(3): pointer to the vector B * X in WORKD when used in c the shift-and-invert mode. c IPNTR(4): pointer to the next available location in WORKL c that is untouched by the program. c IPNTR(5): pointer to the NCV by NCV upper Hessenberg c matrix H in WORKL. c IPNTR(6): pointer to the ritz value array RITZ c IPNTR(7): pointer to the (projected) ritz vector array Q c IPNTR(8): pointer to the error BOUNDS array in WORKL. c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below. c c Note: IPNTR(9:13) is only referenced by zneupd. See Remark 2 below. c c IPNTR(9): pointer to the NCV RITZ values of the c original system. c IPNTR(10): Not Used c IPNTR(11): pointer to the NCV corresponding error bounds. c IPNTR(12): pointer to the NCV by NCV upper triangular c Schur matrix for H. c IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors c of the upper Hessenberg matrix H. Only referenced by c zneupd if RVEC = .TRUE. See Remark 2 below. c c ------------------------------------------------------------- c c WORKD Complex*16 work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration !!!!!!!!!! c See Data Distribution Note below. c c WORKL Complex*16 work array of length LWORKL. (OUTPUT/WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. See Data Distribution Note below. c c LWORKL Integer. (INPUT) c LWORKL must be at least 3*NCV**2 + 5*NCV. c c RWORK Double precision work array of length NCV (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. c c c INFO Integer. (INPUT/OUTPUT) c If INFO .EQ. 0, a randomly initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c Error flag on output. c = 0: Normal exit. c = 1: Maximum number of iterations taken. c All possible eigenvalues of OP has been found. IPARAM(5) c returns the number of wanted converged Ritz values. c = 2: No longer an informational error. Deprecated starting c with release 2 of ARPACK. c = 3: No shifts could be applied during a cycle of the c Implicitly restarted Arnoldi iteration. One possibility c is to increase the size of NCV relative to NEV. c See remark 4 below. c = -1: N must be positive. c = -2: NEV must be positive. c = -3: NCV-NEV >= 1 and less than or equal to N. c = -4: The maximum number of Arnoldi update iteration c must be greater than zero. c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI' c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work array is not sufficient. c = -8: Error return from LAPACK eigenvalue calculation; c = -9: Starting vector is zero. c = -10: IPARAM(7) must be 1,2,3. c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible. c = -12: IPARAM(1) must be equal to 0 or 1. c = -9999: Could not build an Arnoldi factorization. c User input error highly likely. Please c check actual array dimensions and layout. c IPARAM(5) returns the size of the current Arnoldi c factorization. c c\Remarks c 1. The computed Ritz values are approximate eigenvalues of OP. The c selection of WHICH should be made with this in mind when using c Mode = 3. When operating in Mode = 3 setting WHICH = 'LM' will c compute the NEV eigenvalues of the original problem that are c closest to the shift SIGMA . After convergence, approximate eigenvalues c of the original problem may be obtained with the ARPACK subroutine zneupd. c c 2. If a basis for the invariant subspace corresponding to the converged Ritz c values is needed, the user must call zneupd immediately following c completion of znaupd. This is new starting with release 2 of ARPACK. c c 3. If M can be factored into a Cholesky factorization M = LL` c then Mode = 2 should not be selected. Instead one should use c Mode = 1 with OP = inv(L)*A*inv(L`). Appropriate triangular c linear systems should be solved with L and L` rather c than computing inverses. After convergence, an approximate c eigenvector z of the original problem is recovered by solving c L`z = x where x is a Ritz vector of OP. c c 4. At present there is no a-priori analysis to guide the selection c of NCV relative to NEV. The only formal requirement is that NCV > NEV + 1. c However, it is recommended that NCV .ge. 2*NEV. If many problems of c the same type are to be solved, one should experiment with increasing c NCV while keeping NEV fixed for a given test problem. This will c usually decrease the required number of OP*x operations but it c also increases the work and storage required to maintain the orthogonal c basis vectors. The optimal "cross-over" with respect to CPU time c is problem dependent and must be determined empirically. c See Chapter 8 of Reference 2 for further information. c c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the c NP = IPARAM(8) complex shifts in locations c WORKL(IPNTR(14)), WORKL(IPNTR(14)+1), ... , WORKL(IPNTR(14)+NP). c Eigenvalues of the current upper Hessenberg matrix are located in c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are ordered c according to the order defined by WHICH. The associated Ritz estimates c are located in WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , c WORKL(IPNTR(8)+NCV-1). c c----------------------------------------------------------------------- c c\Data Distribution Note: c c Fortran-D syntax: c ================ c Complex*16 resid(n), v(ldv,ncv), workd(3*n), workl(lworkl) c decompose d1(n), d2(n,ncv) c align resid(i) with d1(i) c align v(i,j) with d2(i,j) c align workd(i) with d1(i) range (1:n) c align workd(i) with d1(i-n) range (n+1:2*n) c align workd(i) with d1(i-2*n) range (2*n+1:3*n) c distribute d1(block), d2(block,:) c replicated workl(lworkl) c c Cray MPP syntax: c =============== c Complex*16 resid(n), v(ldv,ncv), workd(n,3), workl(lworkl) c shared resid(block), v(block,:), workd(block,:) c replicated workl(lworkl) c c CM2/CM5 syntax: c ============== c c----------------------------------------------------------------------- c c include 'ex-nonsym.doc' c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx Complex*16 c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett & Y. Saad, "_Complex_ Shift and Invert Strategies for c Double precision Matrices", Linear Algebra and its Applications, vol 88/89, c pp 575-595, (1987). c c\Routines called: c znaup2 ARPACK routine that implements the Implicitly Restarted c Arnoldi Iteration. c zstatn ARPACK routine that initializes the timing variables. c ivout ARPACK utility routine that prints integers. c zvout ARPACK utility routine that prints vectors. c second ARPACK utility routine for timing. c dlamch LAPACK routine that determines machine constants. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: naupd.F SID: 2.9 DATE OF SID: 07/21/02 RELEASE: 2 c c\Remarks c c\EndLib c c----------------------------------------------------------------------- c subroutine znaupd & ( ido, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam, & ipntr, workd, workl, lworkl, rwork, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1, which*2 integer ido, info, ldv, lworkl, n, ncv, nev Double precision & tol c c %-----------------% c | Array Arguments | c %-----------------% c integer iparam(11), ipntr(14) Complex*16 & resid(n), v(ldv,ncv), workd(3*n), workl(lworkl) Double precision & rwork(ncv) c c %------------% c | Parameters | c %------------% c Complex*16 & one, zero parameter (one = (1.0D+0, 0.0D+0), zero = (0.0D+0, 0.0D+0)) c c %---------------% c | Local Scalars | c %---------------% c integer bounds, ierr, ih, iq, ishift, iupd, iw, & ldh, ldq, levec, mode, msglvl, mxiter, nb, & nev0, next, np, ritz, j save bounds, ih, iq, ishift, iupd, iw, & ldh, ldq, levec, mode, msglvl, mxiter, nb, & nev0, next, np, ritz c c %----------------------% c | External Subroutines | c %----------------------% c external znaup2, zvout, ivout, second, zstatn c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlamch external dlamch c c %-----------------------% c | Executable Statements | c %-----------------------% c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call zstatn call second (t0) msglvl = mcaupd c c %----------------% c | Error checking | c %----------------% c ierr = 0 ishift = iparam(1) c levec = iparam(2) mxiter = iparam(3) c nb = iparam(4) nb = 1 c c %--------------------------------------------% c | Revision 2 performs only implicit restart. | c %--------------------------------------------% c iupd = 1 mode = iparam(7) c if (n .le. 0) then ierr = -1 else if (nev .le. 0) then ierr = -2 else if (ncv .le. nev .or. ncv .gt. n) then ierr = -3 else if (mxiter .le. 0) then ierr = -4 else if (which .ne. 'LM' .and. & which .ne. 'SM' .and. & which .ne. 'LR' .and. & which .ne. 'SR' .and. & which .ne. 'LI' .and. & which .ne. 'SI') then ierr = -5 else if (bmat .ne. 'I' .and. bmat .ne. 'G') then ierr = -6 else if (lworkl .lt. 3*ncv**2 + 5*ncv) then ierr = -7 else if (mode .lt. 1 .or. mode .gt. 3) then ierr = -10 else if (mode .eq. 1 .and. bmat .eq. 'G') then ierr = -11 end if c c %------------% c | Error Exit | c %------------% c if (ierr .ne. 0) then info = ierr ido = 99 go to 9000 end if c c %------------------------% c | Set default parameters | c %------------------------% c if (nb .le. 0) nb = 1 if (tol .le. 0.0D+0 ) tol = dlamch('EpsMach') if (ishift .ne. 0 .and. & ishift .ne. 1 .and. & ishift .ne. 2) ishift = 1 c c %----------------------------------------------% c | NP is the number of additional steps to | c | extend the length NEV Lanczos factorization. | c | NEV0 is the local variable designating the | c | size of the invariant subspace desired. | c %----------------------------------------------% c np = ncv - nev nev0 = nev c c %-----------------------------% c | Zero out internal workspace | c %-----------------------------% c do 10 j = 1, 3*ncv**2 + 5*ncv workl(j) = zero 10 continue c c %-------------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | c | etc... and the remaining workspace. | c | Also update pointer to be used on output. | c | Memory is laid out as follows: | c | workl(1:ncv*ncv) := generated Hessenberg matrix | c | workl(ncv*ncv+1:ncv*ncv+ncv) := the ritz values | c | workl(ncv*ncv+ncv+1:ncv*ncv+2*ncv) := error bounds | c | workl(ncv*ncv+2*ncv+1:2*ncv*ncv+2*ncv) := rotation matrix Q | c | workl(2*ncv*ncv+2*ncv+1:3*ncv*ncv+5*ncv) := workspace | c | The final workspace is needed by subroutine zneigh called | c | by znaup2. Subroutine zneigh calls LAPACK routines for | c | calculating eigenvalues and the last row of the eigenvector | c | matrix. | c %-------------------------------------------------------------% c ldh = ncv ldq = ncv ih = 1 ritz = ih + ldh*ncv bounds = ritz + ncv iq = bounds + ncv iw = iq + ldq*ncv next = iw + ncv**2 + 3*ncv c ipntr(4) = next ipntr(5) = ih ipntr(6) = ritz ipntr(7) = iq ipntr(8) = bounds ipntr(14) = iw end if c c %-------------------------------------------------------% c | Carry out the Implicitly restarted Arnoldi Iteration. | c %-------------------------------------------------------% c call znaup2 & ( ido, bmat, n, which, nev0, np, tol, resid, mode, iupd, & ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritz), & workl(bounds), workl(iq), ldq, workl(iw), & ipntr, workd, rwork, info ) c c %--------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP. | c %--------------------------------------------------% c if (ido .eq. 3) iparam(8) = np if (ido .ne. 99) go to 9000 c iparam(3) = mxiter iparam(5) = np iparam(9) = nopx iparam(10) = nbx iparam(11) = nrorth c c %------------------------------------% c | Exit if there was an informational | c | error within znaup2. | c %------------------------------------% c if (info .lt. 0) go to 9000 if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then call ivout (logfil, 1, mxiter, ndigit, & '_naupd: Number of update iterations taken') call ivout (logfil, 1, np, ndigit, & '_naupd: Number of wanted "converged" Ritz values') call zvout (logfil, np, workl(ritz), ndigit, & '_naupd: The final Ritz values') call zvout (logfil, np, workl(bounds), ndigit, & '_naupd: Associated Ritz estimates') end if c call second (t1) tcaupd = t1 - t0 c if (msglvl .gt. 0) then c c %--------------------------------------------------------% c | Version Number & Version Date are defined in version.h | c %--------------------------------------------------------% c write (6,1000) write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt, & tmvopx, tmvbx, tcaupd, tcaup2, tcaitr, titref, & tgetv0, tceigh, tcgets, tcapps, tcconv, trvec 1000 format (//, & 5x, '=============================================',/ & 5x, '= Complex implicit Arnoldi update code =',/ & 5x, '= Version Number: ', ' 2.3', 21x, ' =',/ & 5x, '= Version Date: ', ' 07/31/96', 16x, ' =',/ & 5x, '=============================================',/ & 5x, '= Summary of timing statistics =',/ & 5x, '=============================================',//) 1100 format ( & 5x, 'Total number update iterations = ', i5,/ & 5x, 'Total number of OP*x operations = ', i5,/ & 5x, 'Total number of B*x operations = ', i5,/ & 5x, 'Total number of reorthogonalization steps = ', i5,/ & 5x, 'Total number of iterative refinement steps = ', i5,/ & 5x, 'Total number of restart steps = ', i5,/ & 5x, 'Total time in user OP*x operation = ', f12.6,/ & 5x, 'Total time in user B*x operation = ', f12.6,/ & 5x, 'Total time in Arnoldi update routine = ', f12.6,/ & 5x, 'Total time in naup2 routine = ', f12.6,/ & 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/ & 5x, 'Total time in reorthogonalization phase = ', f12.6,/ & 5x, 'Total time in (re)start vector generation = ', f12.6,/ & 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/ & 5x, 'Total time in getting the shifts = ', f12.6,/ & 5x, 'Total time in applying the shifts = ', f12.6,/ & 5x, 'Total time in convergence testing = ', f12.6,/ & 5x, 'Total time in computing final Ritz vectors = ', f12.6/) end if c 9000 continue c return c c %---------------% c | End of znaupd | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dvout.f000644 001750 001750 00000007604 11266605602 021765 0ustar00geuzainegeuzaine000000 000000 *----------------------------------------------------------------------- * Routine: DVOUT * * Purpose: Real vector output routine. * * Usage: CALL DVOUT (LOUT, N, SX, IDIGIT, IFMT) * * Arguments * N - Length of array SX. (Input) * SX - Real array to be printed. (Input) * IFMT - Format to be used in printing array SX. (Input) * IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In) * If IDIGIT .LT. 0, printing is done with 72 columns. * If IDIGIT .GT. 0, printing is done with 132 columns. * *----------------------------------------------------------------------- * SUBROUTINE DVOUT( LOUT, N, SX, IDIGIT, IFMT ) * ... * ... SPECIFICATIONS FOR ARGUMENTS * ... * ... SPECIFICATIONS FOR LOCAL VARIABLES * .. Scalar Arguments .. CHARACTER*( * ) IFMT INTEGER IDIGIT, LOUT, N * .. * .. Array Arguments .. DOUBLE PRECISION SX( * ) * .. * .. Local Scalars .. CHARACTER*80 LINE INTEGER I, K1, K2, LLL, NDIGIT * .. * .. Intrinsic Functions .. INTRINSIC LEN, MIN, MIN0 * .. * .. Executable Statements .. * ... * ... FIRST EXECUTABLE STATEMENT * * LLL = MIN( LEN( IFMT ), 80 ) DO 10 I = 1, LLL LINE( I: I ) = '-' 10 CONTINUE * DO 20 I = LLL + 1, 80 LINE( I: I ) = ' ' 20 CONTINUE * WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL ) 9999 FORMAT( / 1X, A, / 1X, A ) * IF( N.LE.0 ) $ RETURN NDIGIT = IDIGIT IF( IDIGIT.EQ.0 ) $ NDIGIT = 4 * *======================================================================= * CODE FOR OUTPUT USING 72 COLUMNS FORMAT *======================================================================= * IF( IDIGIT.LT.0 ) THEN NDIGIT = -IDIGIT IF( NDIGIT.LE.4 ) THEN DO 30 K1 = 1, N, 5 K2 = MIN0( N, K1+4 ) WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 ) 30 CONTINUE ELSE IF( NDIGIT.LE.6 ) THEN DO 40 K1 = 1, N, 4 K2 = MIN0( N, K1+3 ) WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 ) 40 CONTINUE ELSE IF( NDIGIT.LE.10 ) THEN DO 50 K1 = 1, N, 3 K2 = MIN0( N, K1+2 ) WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 ) 50 CONTINUE ELSE DO 60 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 ) 60 CONTINUE END IF * *======================================================================= * CODE FOR OUTPUT USING 132 COLUMNS FORMAT *======================================================================= * ELSE IF( NDIGIT.LE.4 ) THEN DO 70 K1 = 1, N, 10 K2 = MIN0( N, K1+9 ) WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 ) 70 CONTINUE ELSE IF( NDIGIT.LE.6 ) THEN DO 80 K1 = 1, N, 8 K2 = MIN0( N, K1+7 ) WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 ) 80 CONTINUE ELSE IF( NDIGIT.LE.10 ) THEN DO 90 K1 = 1, N, 6 K2 = MIN0( N, K1+5 ) WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 ) 90 CONTINUE ELSE DO 100 K1 = 1, N, 5 K2 = MIN0( N, K1+4 ) WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 ) 100 CONTINUE END IF END IF WRITE( LOUT, FMT = 9994 ) RETURN 9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P, 10D12.3 ) 9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 8D14.5 ) 9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 6D18.9 ) 9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 5D24.13 ) 9994 FORMAT( 1X, ' ' ) END getdp-2.7.0-source/contrib/Arpack/zstatn.f000644 001750 001750 00000002305 11266605602 022140 0ustar00geuzainegeuzaine000000 000000 c c\SCCS Information: @(#) c FILE: statn.F SID: 2.2 DATE OF SID: 4/20/96 RELEASE: 2 c c %---------------------------------------------% c | Initialize statistic and timing information | c | for complex nonsymmetric Arnoldi code. | c %---------------------------------------------% subroutine zstatn c c %--------------------------------% c | See stat.doc for documentation | c %--------------------------------% c include 'stat.h' c %-----------------------% c | Executable Statements | c %-----------------------% nopx = 0 nbx = 0 nrorth = 0 nitref = 0 nrstrt = 0 tcaupd = 0.0D+0 tcaup2 = 0.0D+0 tcaitr = 0.0D+0 tceigh = 0.0D+0 tcgets = 0.0D+0 tcapps = 0.0D+0 tcconv = 0.0D+0 titref = 0.0D+0 tgetv0 = 0.0D+0 trvec = 0.0D+0 c %----------------------------------------------------% c | User time including reverse communication overhead | c %----------------------------------------------------% tmvopx = 0.0D+0 tmvbx = 0.0D+0 return c c %---------------% c | End of zstatn | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/stat.h000644 001750 001750 00000001713 11266605602 021574 0ustar00geuzainegeuzaine000000 000000 c %--------------------------------% c | See stat.doc for documentation | c %--------------------------------% c c\SCCS Information: @(#) c FILE: stat.h SID: 2.2 DATE OF SID: 11/16/95 RELEASE: 2 c real t0, t1, t2, t3, t4, t5 save t0, t1, t2, t3, t4, t5 c integer nopx, nbx, nrorth, nitref, nrstrt real tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv, & tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv, & tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv, & tmvopx, tmvbx, tgetv0, titref, trvec common /timing/ & nopx, nbx, nrorth, nitref, nrstrt, & tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv, & tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv, & tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv, & tmvopx, tmvbx, tgetv0, titref, trvec getdp-2.7.0-source/contrib/Arpack/dseigt.f000644 001750 001750 00000012115 11266605602 022074 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: dseigt c c\Description: c Compute the eigenvalues of the current symmetric tridiagonal matrix c and the corresponding error bounds given the current residual norm. c c\Usage: c call dseigt c ( RNORM, N, H, LDH, EIG, BOUNDS, WORKL, IERR ) c c\Arguments c RNORM Double precision scalar. (INPUT) c RNORM contains the residual norm corresponding to the current c symmetric tridiagonal matrix H. c c N Integer. (INPUT) c Size of the symmetric tridiagonal matrix H. c c H Double precision N by 2 array. (INPUT) c H contains the symmetric tridiagonal matrix with the c subdiagonal in the first column starting at H(2,1) and the c main diagonal in second column. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c EIG Double precision array of length N. (OUTPUT) c On output, EIG contains the N eigenvalues of H possibly c unsorted. The BOUNDS arrays are returned in the c same sorted order as EIG. c c BOUNDS Double precision array of length N. (OUTPUT) c On output, BOUNDS contains the error estimates corresponding c to the eigenvalues EIG. This is equal to RNORM times the c last components of the eigenvectors corresponding to the c eigenvalues in EIG. c c WORKL Double precision work array of length 3*N. (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. c c IERR Integer. (OUTPUT) c Error exit flag from dstqrb. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c dstqrb ARPACK routine that computes the eigenvalues and the c last components of the eigenvectors of a symmetric c and tridiagonal matrix. c second ARPACK utility routine for timing. c dvout ARPACK utility routine that prints vectors. c dcopy Level 1 BLAS that copies one vector to another. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.4' c c\SCCS Information: @(#) c FILE: seigt.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks c None c c\EndLib c c----------------------------------------------------------------------- c subroutine dseigt & ( rnorm, n, h, ldh, eig, bounds, workl, ierr ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer ierr, ldh, n Double precision & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & eig(n), bounds(n), h(ldh,2), workl(3*n) c c %------------% c | Parameters | c %------------% c Double precision & zero parameter (zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c integer i, k, msglvl c c %----------------------% c | External Subroutines | c %----------------------% c external dcopy, dstqrb, dvout, second c c %-----------------------% c | Executable Statements | c %-----------------------% c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mseigt c if (msglvl .gt. 0) then call dvout (logfil, n, h(1,2), ndigit, & '_seigt: main diagonal of matrix H') if (n .gt. 1) then call dvout (logfil, n-1, h(2,1), ndigit, & '_seigt: sub diagonal of matrix H') end if end if c call dcopy (n, h(1,2), 1, eig, 1) call dcopy (n-1, h(2,1), 1, workl, 1) call dstqrb (n, eig, workl, bounds, workl(n+1), ierr) if (ierr .ne. 0) go to 9000 if (msglvl .gt. 1) then call dvout (logfil, n, bounds, ndigit, & '_seigt: last row of the eigenvector matrix for H') end if c c %-----------------------------------------------% c | Finally determine the error bounds associated | c | with the n Ritz values of H. | c %-----------------------------------------------% c do 30 k = 1, n bounds(k) = rnorm*abs(bounds(k)) 30 continue c call second (t1) tseigt = tseigt + (t1 - t0) c 9000 continue return c c %---------------% c | End of dseigt | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/ssortr.f000644 001750 001750 00000012274 11266605602 022157 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: ssortr c c\Description: c Sort the array X1 in the order specified by WHICH and optionally c applies the permutation to the array X2. c c\Usage: c call ssortr c ( WHICH, APPLY, N, X1, X2 ) c c\Arguments c WHICH Character*2. (Input) c 'LM' -> X1 is sorted into increasing order of magnitude. c 'SM' -> X1 is sorted into decreasing order of magnitude. c 'LA' -> X1 is sorted into increasing order of algebraic. c 'SA' -> X1 is sorted into decreasing order of algebraic. c c APPLY Logical. (Input) c APPLY = .TRUE. -> apply the sorted order to X2. c APPLY = .FALSE. -> do not apply the sorted order to X2. c c N Integer. (INPUT) c Size of the arrays. c c X1 Real array of length N. (INPUT/OUTPUT) c The array to be sorted. c c X2 Real array of length N. (INPUT/OUTPUT) c Only referenced if APPLY = .TRUE. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/16/93: Version ' 2.1'. c Adapted from the sort routine in LANSO. c c\SCCS Information: @(#) c FILE: sortr.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine ssortr (which, apply, n, x1, x2) c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which logical apply integer n c c %-----------------% c | Array Arguments | c %-----------------% c Real & x1(0:n-1), x2(0:n-1) c c %---------------% c | Local Scalars | c %---------------% c integer i, igap, j Real & temp c c %-----------------------% c | Executable Statements | c %-----------------------% c igap = n / 2 c if (which .eq. 'SA') then c c X1 is sorted into decreasing order of algebraic. c 10 continue if (igap .eq. 0) go to 9000 do 30 i = igap, n-1 j = i-igap 20 continue c if (j.lt.0) go to 30 c if (x1(j).lt.x1(j+igap)) then temp = x1(j) x1(j) = x1(j+igap) x1(j+igap) = temp if (apply) then temp = x2(j) x2(j) = x2(j+igap) x2(j+igap) = temp end if else go to 30 endif j = j-igap go to 20 30 continue igap = igap / 2 go to 10 c else if (which .eq. 'SM') then c c X1 is sorted into decreasing order of magnitude. c 40 continue if (igap .eq. 0) go to 9000 do 60 i = igap, n-1 j = i-igap 50 continue c if (j.lt.0) go to 60 c if (abs(x1(j)).lt.abs(x1(j+igap))) then temp = x1(j) x1(j) = x1(j+igap) x1(j+igap) = temp if (apply) then temp = x2(j) x2(j) = x2(j+igap) x2(j+igap) = temp end if else go to 60 endif j = j-igap go to 50 60 continue igap = igap / 2 go to 40 c else if (which .eq. 'LA') then c c X1 is sorted into increasing order of algebraic. c 70 continue if (igap .eq. 0) go to 9000 do 90 i = igap, n-1 j = i-igap 80 continue c if (j.lt.0) go to 90 c if (x1(j).gt.x1(j+igap)) then temp = x1(j) x1(j) = x1(j+igap) x1(j+igap) = temp if (apply) then temp = x2(j) x2(j) = x2(j+igap) x2(j+igap) = temp end if else go to 90 endif j = j-igap go to 80 90 continue igap = igap / 2 go to 70 c else if (which .eq. 'LM') then c c X1 is sorted into increasing order of magnitude. c 100 continue if (igap .eq. 0) go to 9000 do 120 i = igap, n-1 j = i-igap 110 continue c if (j.lt.0) go to 120 c if (abs(x1(j)).gt.abs(x1(j+igap))) then temp = x1(j) x1(j) = x1(j+igap) x1(j+igap) = temp if (apply) then temp = x2(j) x2(j) = x2(j+igap) x2(j+igap) = temp end if else go to 120 endif j = j-igap go to 110 120 continue igap = igap / 2 go to 100 end if c 9000 continue return c c %---------------% c | End of ssortr | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dsesrt.f000644 001750 001750 00000012370 11266605602 022124 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: dsesrt c c\Description: c Sort the array X in the order specified by WHICH and optionally c apply the permutation to the columns of the matrix A. c c\Usage: c call dsesrt c ( WHICH, APPLY, N, X, NA, A, LDA) c c\Arguments c WHICH Character*2. (Input) c 'LM' -> X is sorted into increasing order of magnitude. c 'SM' -> X is sorted into decreasing order of magnitude. c 'LA' -> X is sorted into increasing order of algebraic. c 'SA' -> X is sorted into decreasing order of algebraic. c c APPLY Logical. (Input) c APPLY = .TRUE. -> apply the sorted order to A. c APPLY = .FALSE. -> do not apply the sorted order to A. c c N Integer. (INPUT) c Dimension of the array X. c c X Double precision array of length N. (INPUT/OUTPUT) c The array to be sorted. c c NA Integer. (INPUT) c Number of rows of the matrix A. c c A Double precision array of length NA by N. (INPUT/OUTPUT) c c LDA Integer. (INPUT) c Leading dimension of A. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Routines c dswap Level 1 BLAS that swaps the contents of two vectors. c c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/15/93: Version ' 2.1'. c Adapted from the sort routine in LANSO and c the ARPACK code dsortr c c\SCCS Information: @(#) c FILE: sesrt.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine dsesrt (which, apply, n, x, na, a, lda) c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which logical apply integer lda, n, na c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & x(0:n-1), a(lda, 0:n-1) c c %---------------% c | Local Scalars | c %---------------% c integer i, igap, j Double precision & temp c c %----------------------% c | External Subroutines | c %----------------------% c external dswap c c %-----------------------% c | Executable Statements | c %-----------------------% c igap = n / 2 c if (which .eq. 'SA') then c c X is sorted into decreasing order of algebraic. c 10 continue if (igap .eq. 0) go to 9000 do 30 i = igap, n-1 j = i-igap 20 continue c if (j.lt.0) go to 30 c if (x(j).lt.x(j+igap)) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp if (apply) call dswap( na, a(1, j), 1, a(1,j+igap), 1) else go to 30 endif j = j-igap go to 20 30 continue igap = igap / 2 go to 10 c else if (which .eq. 'SM') then c c X is sorted into decreasing order of magnitude. c 40 continue if (igap .eq. 0) go to 9000 do 60 i = igap, n-1 j = i-igap 50 continue c if (j.lt.0) go to 60 c if (abs(x(j)).lt.abs(x(j+igap))) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp if (apply) call dswap( na, a(1, j), 1, a(1,j+igap), 1) else go to 60 endif j = j-igap go to 50 60 continue igap = igap / 2 go to 40 c else if (which .eq. 'LA') then c c X is sorted into increasing order of algebraic. c 70 continue if (igap .eq. 0) go to 9000 do 90 i = igap, n-1 j = i-igap 80 continue c if (j.lt.0) go to 90 c if (x(j).gt.x(j+igap)) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp if (apply) call dswap( na, a(1, j), 1, a(1,j+igap), 1) else go to 90 endif j = j-igap go to 80 90 continue igap = igap / 2 go to 70 c else if (which .eq. 'LM') then c c X is sorted into increasing order of magnitude. c 100 continue if (igap .eq. 0) go to 9000 do 120 i = igap, n-1 j = i-igap 110 continue c if (j.lt.0) go to 120 c if (abs(x(j)).gt.abs(x(j+igap))) then temp = x(j) x(j) = x(j+igap) x(j+igap) = temp if (apply) call dswap( na, a(1, j), 1, a(1,j+igap), 1) else go to 120 endif j = j-igap go to 110 120 continue igap = igap / 2 go to 100 end if c 9000 continue return c c %---------------% c | End of dsesrt | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/cnaupd.f000644 001750 001750 00000066152 11266605602 022101 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: cnaupd c c\Description: c Reverse communication interface for the Implicitly Restarted Arnoldi c iteration. This is intended to be used to find a few eigenpairs of a c complex linear operator OP with respect to a semi-inner product defined c by a hermitian positive semi-definite real matrix B. B may be the identity c matrix. NOTE: if both OP and B are real, then ssaupd or snaupd should c be used. c c c The computed approximate eigenvalues are called Ritz values and c the corresponding approximate eigenvectors are called Ritz vectors. c c cnaupd is usually called iteratively to solve one of the c following problems: c c Mode 1: A*x = lambda*x. c ===> OP = A and B = I. c c Mode 2: A*x = lambda*M*x, M hermitian positive definite c ===> OP = inv[M]*A and B = M. c ===> (If M can be factored see remark 3 below) c c Mode 3: A*x = lambda*M*x, M hermitian semi-definite c ===> OP = inv[A - sigma*M]*M and B = M. c ===> shift-and-invert mode c If OP*x = amu*x, then lambda = sigma + 1/amu. c c c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v c should be accomplished either by a direct method c using a sparse matrix factorization and solving c c [A - sigma*M]*w = v or M*w = v, c c or through an iterative method for solving these c systems. If an iterative method is used, the c convergence test must be more stringent than c the accuracy requirements for the eigenvalue c approximations. c c\Usage: c call cnaupd c ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, c IPNTR, WORKD, WORKL, LWORKL, RWORK, INFO ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. IDO must be zero on the first c call to cnaupd. IDO will be set internally to c indicate the type of operation to be performed. Control is c then given back to the calling routine which has the c responsibility to carry out the requested operation and call c cnaupd with the result. The operand is given in c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)). c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c This is for the initialization phase to force the c starting vector into the range of OP. c IDO = 1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c In mode 3, the vector B * X is already c available in WORKD(ipntr(3)). It does not c need to be recomputed in forming OP * X. c IDO = 2: compute Y = M * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c IDO = 3: compute and return the shifts in the first c NP locations of WORKL. c IDO = 99: done c ------------------------------------------------------------- c After the initialization phase, when the routine is used in c the "shift-and-invert" mode, the vector M * X is already c available and does not need to be recomputed in forming OP*X. c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B that defines the c semi-inner product for the operator OP. c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*M*x c c N Integer. (INPUT) c Dimension of the eigenproblem. c c WHICH Character*2. (INPUT) c 'LM' -> want the NEV eigenvalues of largest magnitude. c 'SM' -> want the NEV eigenvalues of smallest magnitude. c 'LR' -> want the NEV eigenvalues of largest real part. c 'SR' -> want the NEV eigenvalues of smallest real part. c 'LI' -> want the NEV eigenvalues of largest imaginary part. c 'SI' -> want the NEV eigenvalues of smallest imaginary part. c c NEV Integer. (INPUT) c Number of eigenvalues of OP to be computed. 0 < NEV < N-1. c c TOL Real scalar. (INPUT) c Stopping criteria: the relative accuracy of the Ritz value c is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)) c where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex. c DEFAULT = slamch('EPS') (machine precision as computed c by the LAPACK auxiliary subroutine slamch). c c RESID Complex array of length N. (INPUT/OUTPUT) c On INPUT: c If INFO .EQ. 0, a random initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c On OUTPUT: c RESID contains the final residual vector. c c NCV Integer. (INPUT) c Number of columns of the matrix V. NCV must satisfy the two c inequalities 1 <= NCV-NEV and NCV <= N. c This will indicate how many Arnoldi vectors are generated c at each iteration. After the startup phase in which NEV c Arnoldi vectors are generated, the algorithm generates c approximately NCV-NEV Arnoldi vectors at each subsequent update c iteration. Most of the cost in generating each Arnoldi vector is c in the matrix-vector operation OP*x. (See remark 4 below.) c c V Complex array N by NCV. (OUTPUT) c Contains the final set of Arnoldi basis vectors. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling program. c c IPARAM Integer array of length 11. (INPUT/OUTPUT) c IPARAM(1) = ISHIFT: method for selecting the implicit shifts. c The shifts selected at each iteration are used to filter out c the components of the unwanted eigenvector. c ------------------------------------------------------------- c ISHIFT = 0: the shifts are to be provided by the user via c reverse communication. The NCV eigenvalues of c the Hessenberg matrix H are returned in the part c of WORKL array corresponding to RITZ. c ISHIFT = 1: exact shifts with respect to the current c Hessenberg matrix H. This is equivalent to c restarting the iteration from the beginning c after updating the starting vector with a linear c combination of Ritz vectors associated with the c "wanted" eigenvalues. c ISHIFT = 2: other choice of internal shift to be defined. c ------------------------------------------------------------- c c IPARAM(2) = No longer referenced c c IPARAM(3) = MXITER c On INPUT: maximum number of Arnoldi update iterations allowed. c On OUTPUT: actual number of Arnoldi update iterations taken. c c IPARAM(4) = NB: blocksize to be used in the recurrence. c The code currently works only for NB = 1. c c IPARAM(5) = NCONV: number of "converged" Ritz values. c This represents the number of Ritz values that satisfy c the convergence criterion. c c IPARAM(6) = IUPD c No longer referenced. Implicit restarting is ALWAYS used. c c IPARAM(7) = MODE c On INPUT determines what type of eigenproblem is being solved. c Must be 1,2,3; See under \Description of cnaupd for the c four modes available. c c IPARAM(8) = NP c When ido = 3 and the user provides shifts through reverse c communication (IPARAM(1)=0), _naupd returns NP, the number c of shifts the user is to provide. 0 < NP < NCV-NEV. c c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO, c OUTPUT: NUMOP = total number of OP*x operations, c NUMOPB = total number of B*x operations if BMAT='G', c NUMREO = total number of steps of re-orthogonalization. c c IPNTR Integer array of length 14. (OUTPUT) c Pointer to mark the starting locations in the WORKD and WORKL c arrays for matrices/vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X in WORKD. c IPNTR(2): pointer to the current result vector Y in WORKD. c IPNTR(3): pointer to the vector B * X in WORKD when used in c the shift-and-invert mode. c IPNTR(4): pointer to the next available location in WORKL c that is untouched by the program. c IPNTR(5): pointer to the NCV by NCV upper Hessenberg c matrix H in WORKL. c IPNTR(6): pointer to the ritz value array RITZ c IPNTR(7): pointer to the (projected) ritz vector array Q c IPNTR(8): pointer to the error BOUNDS array in WORKL. c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below. c c Note: IPNTR(9:13) is only referenced by cneupd. See Remark 2 below. c c IPNTR(9): pointer to the NCV RITZ values of the c original system. c IPNTR(10): Not Used c IPNTR(11): pointer to the NCV corresponding error bounds. c IPNTR(12): pointer to the NCV by NCV upper triangular c Schur matrix for H. c IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors c of the upper Hessenberg matrix H. Only referenced by c cneupd if RVEC = .TRUE. See Remark 2 below. c c ------------------------------------------------------------- c c WORKD Complex work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration !!!!!!!!!! c See Data Distribution Note below. c c WORKL Complex work array of length LWORKL. (OUTPUT/WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. See Data Distribution Note below. c c LWORKL Integer. (INPUT) c LWORKL must be at least 3*NCV**2 + 5*NCV. c c RWORK Real work array of length NCV (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. c c c INFO Integer. (INPUT/OUTPUT) c If INFO .EQ. 0, a randomly initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c Error flag on output. c = 0: Normal exit. c = 1: Maximum number of iterations taken. c All possible eigenvalues of OP has been found. IPARAM(5) c returns the number of wanted converged Ritz values. c = 2: No longer an informational error. Deprecated starting c with release 2 of ARPACK. c = 3: No shifts could be applied during a cycle of the c Implicitly restarted Arnoldi iteration. One possibility c is to increase the size of NCV relative to NEV. c See remark 4 below. c = -1: N must be positive. c = -2: NEV must be positive. c = -3: NCV-NEV >= 1 and less than or equal to N. c = -4: The maximum number of Arnoldi update iteration c must be greater than zero. c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI' c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work array is not sufficient. c = -8: Error return from LAPACK eigenvalue calculation; c = -9: Starting vector is zero. c = -10: IPARAM(7) must be 1,2,3. c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible. c = -12: IPARAM(1) must be equal to 0 or 1. c = -9999: Could not build an Arnoldi factorization. c User input error highly likely. Please c check actual array dimensions and layout. c IPARAM(5) returns the size of the current Arnoldi c factorization. c c\Remarks c 1. The computed Ritz values are approximate eigenvalues of OP. The c selection of WHICH should be made with this in mind when using c Mode = 3. When operating in Mode = 3 setting WHICH = 'LM' will c compute the NEV eigenvalues of the original problem that are c closest to the shift SIGMA . After convergence, approximate eigenvalues c of the original problem may be obtained with the ARPACK subroutine cneupd. c c 2. If a basis for the invariant subspace corresponding to the converged Ritz c values is needed, the user must call cneupd immediately following c completion of cnaupd. This is new starting with release 2 of ARPACK. c c 3. If M can be factored into a Cholesky factorization M = LL` c then Mode = 2 should not be selected. Instead one should use c Mode = 1 with OP = inv(L)*A*inv(L`). Appropriate triangular c linear systems should be solved with L and L` rather c than computing inverses. After convergence, an approximate c eigenvector z of the original problem is recovered by solving c L`z = x where x is a Ritz vector of OP. c c 4. At present there is no a-priori analysis to guide the selection c of NCV relative to NEV. The only formal requirement is that NCV > NEV + 1. c However, it is recommended that NCV .ge. 2*NEV. If many problems of c the same type are to be solved, one should experiment with increasing c NCV while keeping NEV fixed for a given test problem. This will c usually decrease the required number of OP*x operations but it c also increases the work and storage required to maintain the orthogonal c basis vectors. The optimal "cross-over" with respect to CPU time c is problem dependent and must be determined empirically. c See Chapter 8 of Reference 2 for further information. c c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the c NP = IPARAM(8) complex shifts in locations c WORKL(IPNTR(14)), WORKL(IPNTR(14)+1), ... , WORKL(IPNTR(14)+NP). c Eigenvalues of the current upper Hessenberg matrix are located in c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are ordered c according to the order defined by WHICH. The associated Ritz estimates c are located in WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , c WORKL(IPNTR(8)+NCV-1). c c----------------------------------------------------------------------- c c\Data Distribution Note: c c Fortran-D syntax: c ================ c Complex resid(n), v(ldv,ncv), workd(3*n), workl(lworkl) c decompose d1(n), d2(n,ncv) c align resid(i) with d1(i) c align v(i,j) with d2(i,j) c align workd(i) with d1(i) range (1:n) c align workd(i) with d1(i-n) range (n+1:2*n) c align workd(i) with d1(i-2*n) range (2*n+1:3*n) c distribute d1(block), d2(block,:) c replicated workl(lworkl) c c Cray MPP syntax: c =============== c Complex resid(n), v(ldv,ncv), workd(n,3), workl(lworkl) c shared resid(block), v(block,:), workd(block,:) c replicated workl(lworkl) c c CM2/CM5 syntax: c ============== c c----------------------------------------------------------------------- c c include 'ex-nonsym.doc' c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx Complex c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett & Y. Saad, "_Complex_ Shift and Invert Strategies for c Real Matrices", Linear Algebra and its Applications, vol 88/89, c pp 575-595, (1987). c c\Routines called: c cnaup2 ARPACK routine that implements the Implicitly Restarted c Arnoldi Iteration. c cstatn ARPACK routine that initializes the timing variables. c ivout ARPACK utility routine that prints integers. c cvout ARPACK utility routine that prints vectors. c second ARPACK utility routine for timing. c slamch LAPACK routine that determines machine constants. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: naupd.F SID: 2.9 DATE OF SID: 07/21/02 RELEASE: 2 c c\Remarks c c\EndLib c c----------------------------------------------------------------------- c subroutine cnaupd & ( ido, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam, & ipntr, workd, workl, lworkl, rwork, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1, which*2 integer ido, info, ldv, lworkl, n, ncv, nev Real & tol c c %-----------------% c | Array Arguments | c %-----------------% c integer iparam(11), ipntr(14) Complex & resid(n), v(ldv,ncv), workd(3*n), workl(lworkl) Real & rwork(ncv) c c %------------% c | Parameters | c %------------% c Complex & one, zero parameter (one = (1.0E+0, 0.0E+0), zero = (0.0E+0, 0.0E+0)) c c %---------------% c | Local Scalars | c %---------------% c integer bounds, ierr, ih, iq, ishift, iupd, iw, & ldh, ldq, levec, mode, msglvl, mxiter, nb, & nev0, next, np, ritz, j save bounds, ih, iq, ishift, iupd, iw, & ldh, ldq, levec, mode, msglvl, mxiter, nb, & nev0, next, np, ritz c c %----------------------% c | External Subroutines | c %----------------------% c external cnaup2, cvout, ivout, second, cstatn c c %--------------------% c | External Functions | c %--------------------% c Real & slamch external slamch c c %-----------------------% c | Executable Statements | c %-----------------------% c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call cstatn call second (t0) msglvl = mcaupd c c %----------------% c | Error checking | c %----------------% c ierr = 0 ishift = iparam(1) c levec = iparam(2) mxiter = iparam(3) c nb = iparam(4) nb = 1 c c %--------------------------------------------% c | Revision 2 performs only implicit restart. | c %--------------------------------------------% c iupd = 1 mode = iparam(7) c if (n .le. 0) then ierr = -1 else if (nev .le. 0) then ierr = -2 else if (ncv .le. nev .or. ncv .gt. n) then ierr = -3 else if (mxiter .le. 0) then ierr = -4 else if (which .ne. 'LM' .and. & which .ne. 'SM' .and. & which .ne. 'LR' .and. & which .ne. 'SR' .and. & which .ne. 'LI' .and. & which .ne. 'SI') then ierr = -5 else if (bmat .ne. 'I' .and. bmat .ne. 'G') then ierr = -6 else if (lworkl .lt. 3*ncv**2 + 5*ncv) then ierr = -7 else if (mode .lt. 1 .or. mode .gt. 3) then ierr = -10 else if (mode .eq. 1 .and. bmat .eq. 'G') then ierr = -11 end if c c %------------% c | Error Exit | c %------------% c if (ierr .ne. 0) then info = ierr ido = 99 go to 9000 end if c c %------------------------% c | Set default parameters | c %------------------------% c if (nb .le. 0) nb = 1 if (tol .le. 0.0E+0 ) tol = slamch('EpsMach') if (ishift .ne. 0 .and. & ishift .ne. 1 .and. & ishift .ne. 2) ishift = 1 c c %----------------------------------------------% c | NP is the number of additional steps to | c | extend the length NEV Lanczos factorization. | c | NEV0 is the local variable designating the | c | size of the invariant subspace desired. | c %----------------------------------------------% c np = ncv - nev nev0 = nev c c %-----------------------------% c | Zero out internal workspace | c %-----------------------------% c do 10 j = 1, 3*ncv**2 + 5*ncv workl(j) = zero 10 continue c c %-------------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | c | etc... and the remaining workspace. | c | Also update pointer to be used on output. | c | Memory is laid out as follows: | c | workl(1:ncv*ncv) := generated Hessenberg matrix | c | workl(ncv*ncv+1:ncv*ncv+ncv) := the ritz values | c | workl(ncv*ncv+ncv+1:ncv*ncv+2*ncv) := error bounds | c | workl(ncv*ncv+2*ncv+1:2*ncv*ncv+2*ncv) := rotation matrix Q | c | workl(2*ncv*ncv+2*ncv+1:3*ncv*ncv+5*ncv) := workspace | c | The final workspace is needed by subroutine cneigh called | c | by cnaup2. Subroutine cneigh calls LAPACK routines for | c | calculating eigenvalues and the last row of the eigenvector | c | matrix. | c %-------------------------------------------------------------% c ldh = ncv ldq = ncv ih = 1 ritz = ih + ldh*ncv bounds = ritz + ncv iq = bounds + ncv iw = iq + ldq*ncv next = iw + ncv**2 + 3*ncv c ipntr(4) = next ipntr(5) = ih ipntr(6) = ritz ipntr(7) = iq ipntr(8) = bounds ipntr(14) = iw end if c c %-------------------------------------------------------% c | Carry out the Implicitly restarted Arnoldi Iteration. | c %-------------------------------------------------------% c call cnaup2 & ( ido, bmat, n, which, nev0, np, tol, resid, mode, iupd, & ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritz), & workl(bounds), workl(iq), ldq, workl(iw), & ipntr, workd, rwork, info ) c c %--------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP. | c %--------------------------------------------------% c if (ido .eq. 3) iparam(8) = np if (ido .ne. 99) go to 9000 c iparam(3) = mxiter iparam(5) = np iparam(9) = nopx iparam(10) = nbx iparam(11) = nrorth c c %------------------------------------% c | Exit if there was an informational | c | error within cnaup2. | c %------------------------------------% c if (info .lt. 0) go to 9000 if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then call ivout (logfil, 1, mxiter, ndigit, & '_naupd: Number of update iterations taken') call ivout (logfil, 1, np, ndigit, & '_naupd: Number of wanted "converged" Ritz values') call cvout (logfil, np, workl(ritz), ndigit, & '_naupd: The final Ritz values') call cvout (logfil, np, workl(bounds), ndigit, & '_naupd: Associated Ritz estimates') end if c call second (t1) tcaupd = t1 - t0 c if (msglvl .gt. 0) then c c %--------------------------------------------------------% c | Version Number & Version Date are defined in version.h | c %--------------------------------------------------------% c write (6,1000) write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt, & tmvopx, tmvbx, tcaupd, tcaup2, tcaitr, titref, & tgetv0, tceigh, tcgets, tcapps, tcconv, trvec 1000 format (//, & 5x, '=============================================',/ & 5x, '= Complex implicit Arnoldi update code =',/ & 5x, '= Version Number: ', ' 2.3', 21x, ' =',/ & 5x, '= Version Date: ', ' 07/31/96', 16x, ' =',/ & 5x, '=============================================',/ & 5x, '= Summary of timing statistics =',/ & 5x, '=============================================',//) 1100 format ( & 5x, 'Total number update iterations = ', i5,/ & 5x, 'Total number of OP*x operations = ', i5,/ & 5x, 'Total number of B*x operations = ', i5,/ & 5x, 'Total number of reorthogonalization steps = ', i5,/ & 5x, 'Total number of iterative refinement steps = ', i5,/ & 5x, 'Total number of restart steps = ', i5,/ & 5x, 'Total time in user OP*x operation = ', f12.6,/ & 5x, 'Total time in user B*x operation = ', f12.6,/ & 5x, 'Total time in Arnoldi update routine = ', f12.6,/ & 5x, 'Total time in naup2 routine = ', f12.6,/ & 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/ & 5x, 'Total time in reorthogonalization phase = ', f12.6,/ & 5x, 'Total time in (re)start vector generation = ', f12.6,/ & 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/ & 5x, 'Total time in getting the shifts = ', f12.6,/ & 5x, 'Total time in applying the shifts = ', f12.6,/ & 5x, 'Total time in convergence testing = ', f12.6,/ & 5x, 'Total time in computing final Ritz vectors = ', f12.6/) end if c 9000 continue c return c c %---------------% c | End of cnaupd | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dsaupd.f000644 001750 001750 00000070607 11266605602 022107 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: dsaupd c c\Description: c c Reverse communication interface for the Implicitly Restarted Arnoldi c Iteration. For symmetric problems this reduces to a variant of the Lanczos c method. This method has been designed to compute approximations to a c few eigenpairs of a linear operator OP that is real and symmetric c with respect to a real positive semi-definite symmetric matrix B, c i.e. c c B*OP = (OP`)*B. c c Another way to express this condition is c c < x,OPy > = < OPx,y > where < z,w > = z`Bw . c c In the standard eigenproblem B is the identity matrix. c ( A` denotes transpose of A) c c The computed approximate eigenvalues are called Ritz values and c the corresponding approximate eigenvectors are called Ritz vectors. c c dsaupd is usually called iteratively to solve one of the c following problems: c c Mode 1: A*x = lambda*x, A symmetric c ===> OP = A and B = I. c c Mode 2: A*x = lambda*M*x, A symmetric, M symmetric positive definite c ===> OP = inv[M]*A and B = M. c ===> (If M can be factored see remark 3 below) c c Mode 3: K*x = lambda*M*x, K symmetric, M symmetric positive semi-definite c ===> OP = (inv[K - sigma*M])*M and B = M. c ===> Shift-and-Invert mode c c Mode 4: K*x = lambda*KG*x, K symmetric positive semi-definite, c KG symmetric indefinite c ===> OP = (inv[K - sigma*KG])*K and B = K. c ===> Buckling mode c c Mode 5: A*x = lambda*M*x, A symmetric, M symmetric positive semi-definite c ===> OP = inv[A - sigma*M]*[A + sigma*M] and B = M. c ===> Cayley transformed mode c c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v c should be accomplished either by a direct method c using a sparse matrix factorization and solving c c [A - sigma*M]*w = v or M*w = v, c c or through an iterative method for solving these c systems. If an iterative method is used, the c convergence test must be more stringent than c the accuracy requirements for the eigenvalue c approximations. c c\Usage: c call dsaupd c ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, c IPNTR, WORKD, WORKL, LWORKL, INFO ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. IDO must be zero on the first c call to dsaupd . IDO will be set internally to c indicate the type of operation to be performed. Control is c then given back to the calling routine which has the c responsibility to carry out the requested operation and call c dsaupd with the result. The operand is given in c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)). c (If Mode = 2 see remark 5 below) c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c This is for the initialization phase to force the c starting vector into the range of OP. c IDO = 1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c In mode 3,4 and 5, the vector B * X is already c available in WORKD(ipntr(3)). It does not c need to be recomputed in forming OP * X. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c IDO = 3: compute the IPARAM(8) shifts where c IPNTR(11) is the pointer into WORKL for c placing the shifts. See remark 6 below. c IDO = 99: done c ------------------------------------------------------------- c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B that defines the c semi-inner product for the operator OP. c B = 'I' -> standard eigenvalue problem A*x = lambda*x c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x c c N Integer. (INPUT) c Dimension of the eigenproblem. c c WHICH Character*2. (INPUT) c Specify which of the Ritz values of OP to compute. c c 'LA' - compute the NEV largest (algebraic) eigenvalues. c 'SA' - compute the NEV smallest (algebraic) eigenvalues. c 'LM' - compute the NEV largest (in magnitude) eigenvalues. c 'SM' - compute the NEV smallest (in magnitude) eigenvalues. c 'BE' - compute NEV eigenvalues, half from each end of the c spectrum. When NEV is odd, compute one more from the c high end than from the low end. c (see remark 1 below) c c NEV Integer. (INPUT) c Number of eigenvalues of OP to be computed. 0 < NEV < N. c c TOL Double precision scalar. (INPUT) c Stopping criterion: the relative accuracy of the Ritz value c is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)). c If TOL .LE. 0. is passed a default is set: c DEFAULT = DLAMCH ('EPS') (machine precision as computed c by the LAPACK auxiliary subroutine DLAMCH ). c c RESID Double precision array of length N. (INPUT/OUTPUT) c On INPUT: c If INFO .EQ. 0, a random initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c On OUTPUT: c RESID contains the final residual vector. c c NCV Integer. (INPUT) c Number of columns of the matrix V (less than or equal to N). c This will indicate how many Lanczos vectors are generated c at each iteration. After the startup phase in which NEV c Lanczos vectors are generated, the algorithm generates c NCV-NEV Lanczos vectors at each subsequent update iteration. c Most of the cost in generating each Lanczos vector is in the c matrix-vector product OP*x. (See remark 4 below). c c V Double precision N by NCV array. (OUTPUT) c The NCV columns of V contain the Lanczos basis vectors. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c IPARAM Integer array of length 11. (INPUT/OUTPUT) c IPARAM(1) = ISHIFT: method for selecting the implicit shifts. c The shifts selected at each iteration are used to restart c the Arnoldi iteration in an implicit fashion. c ------------------------------------------------------------- c ISHIFT = 0: the shifts are provided by the user via c reverse communication. The NCV eigenvalues of c the current tridiagonal matrix T are returned in c the part of WORKL array corresponding to RITZ. c See remark 6 below. c ISHIFT = 1: exact shifts with respect to the reduced c tridiagonal matrix T. This is equivalent to c restarting the iteration with a starting vector c that is a linear combination of Ritz vectors c associated with the "wanted" Ritz values. c ------------------------------------------------------------- c c IPARAM(2) = LEVEC c No longer referenced. See remark 2 below. c c IPARAM(3) = MXITER c On INPUT: maximum number of Arnoldi update iterations allowed. c On OUTPUT: actual number of Arnoldi update iterations taken. c c IPARAM(4) = NB: blocksize to be used in the recurrence. c The code currently works only for NB = 1. c c IPARAM(5) = NCONV: number of "converged" Ritz values. c This represents the number of Ritz values that satisfy c the convergence criterion. c c IPARAM(6) = IUPD c No longer referenced. Implicit restarting is ALWAYS used. c c IPARAM(7) = MODE c On INPUT determines what type of eigenproblem is being solved. c Must be 1,2,3,4,5; See under \Description of dsaupd for the c five modes available. c c IPARAM(8) = NP c When ido = 3 and the user provides shifts through reverse c communication (IPARAM(1)=0), dsaupd returns NP, the number c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark c 6 below. c c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO, c OUTPUT: NUMOP = total number of OP*x operations, c NUMOPB = total number of B*x operations if BMAT='G', c NUMREO = total number of steps of re-orthogonalization. c c IPNTR Integer array of length 11. (OUTPUT) c Pointer to mark the starting locations in the WORKD and WORKL c arrays for matrices/vectors used by the Lanczos iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X in WORKD. c IPNTR(2): pointer to the current result vector Y in WORKD. c IPNTR(3): pointer to the vector B * X in WORKD when used in c the shift-and-invert mode. c IPNTR(4): pointer to the next available location in WORKL c that is untouched by the program. c IPNTR(5): pointer to the NCV by 2 tridiagonal matrix T in WORKL. c IPNTR(6): pointer to the NCV RITZ values array in WORKL. c IPNTR(7): pointer to the Ritz estimates in array WORKL associated c with the Ritz values located in RITZ in WORKL. c IPNTR(11): pointer to the NP shifts in WORKL. See Remark 6 below. c c Note: IPNTR(8:10) is only referenced by dseupd . See Remark 2. c IPNTR(8): pointer to the NCV RITZ values of the original system. c IPNTR(9): pointer to the NCV corresponding error bounds. c IPNTR(10): pointer to the NCV by NCV matrix of eigenvectors c of the tridiagonal matrix T. Only referenced by c dseupd if RVEC = .TRUE. See Remarks. c ------------------------------------------------------------- c c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration. Upon termination c WORKD(1:N) contains B*RESID(1:N). If the Ritz vectors are desired c subroutine dseupd uses this output. c See Data Distribution Note below. c c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. See Data Distribution Note below. c c LWORKL Integer. (INPUT) c LWORKL must be at least NCV**2 + 8*NCV . c c INFO Integer. (INPUT/OUTPUT) c If INFO .EQ. 0, a randomly initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c Error flag on output. c = 0: Normal exit. c = 1: Maximum number of iterations taken. c All possible eigenvalues of OP has been found. IPARAM(5) c returns the number of wanted converged Ritz values. c = 2: No longer an informational error. Deprecated starting c with release 2 of ARPACK. c = 3: No shifts could be applied during a cycle of the c Implicitly restarted Arnoldi iteration. One possibility c is to increase the size of NCV relative to NEV. c See remark 4 below. c = -1: N must be positive. c = -2: NEV must be positive. c = -3: NCV must be greater than NEV and less than or equal to N. c = -4: The maximum number of Arnoldi update iterations allowed c must be greater than zero. c = -5: WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'. c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work array WORKL is not sufficient. c = -8: Error return from trid. eigenvalue calculation; c Informatinal error from LAPACK routine dsteqr . c = -9: Starting vector is zero. c = -10: IPARAM(7) must be 1,2,3,4,5. c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable. c = -12: IPARAM(1) must be equal to 0 or 1. c = -13: NEV and WHICH = 'BE' are incompatable. c = -9999: Could not build an Arnoldi factorization. c IPARAM(5) returns the size of the current Arnoldi c factorization. The user is advised to check that c enough workspace and array storage has been allocated. c c c\Remarks c 1. The converged Ritz values are always returned in ascending c algebraic order. The computed Ritz values are approximate c eigenvalues of OP. The selection of WHICH should be made c with this in mind when Mode = 3,4,5. After convergence, c approximate eigenvalues of the original problem may be obtained c with the ARPACK subroutine dseupd . c c 2. If the Ritz vectors corresponding to the converged Ritz values c are needed, the user must call dseupd immediately following completion c of dsaupd . This is new starting with version 2.1 of ARPACK. c c 3. If M can be factored into a Cholesky factorization M = LL` c then Mode = 2 should not be selected. Instead one should use c Mode = 1 with OP = inv(L)*A*inv(L`). Appropriate triangular c linear systems should be solved with L and L` rather c than computing inverses. After convergence, an approximate c eigenvector z of the original problem is recovered by solving c L`z = x where x is a Ritz vector of OP. c c 4. At present there is no a-priori analysis to guide the selection c of NCV relative to NEV. The only formal requrement is that NCV > NEV. c However, it is recommended that NCV .ge. 2*NEV. If many problems of c the same type are to be solved, one should experiment with increasing c NCV while keeping NEV fixed for a given test problem. This will c usually decrease the required number of OP*x operations but it c also increases the work and storage required to maintain the orthogonal c basis vectors. The optimal "cross-over" with respect to CPU time c is problem dependent and must be determined empirically. c c 5. If IPARAM(7) = 2 then in the Reverse commuication interface the user c must do the following. When IDO = 1, Y = OP * X is to be computed. c When IPARAM(7) = 2 OP = inv(B)*A. After computing A*X the user c must overwrite X with A*X. Y is then the solution to the linear set c of equations B*Y = A*X. c c 6. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the c NP = IPARAM(8) shifts in locations: c 1 WORKL(IPNTR(11)) c 2 WORKL(IPNTR(11)+1) c . c . c . c NP WORKL(IPNTR(11)+NP-1). c c The eigenvalues of the current tridiagonal matrix are located in c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are in the c order defined by WHICH. The associated Ritz estimates are located in c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1). c c----------------------------------------------------------------------- c c\Data Distribution Note: c c Fortran-D syntax: c ================ c REAL RESID(N), V(LDV,NCV), WORKD(3*N), WORKL(LWORKL) c DECOMPOSE D1(N), D2(N,NCV) c ALIGN RESID(I) with D1(I) c ALIGN V(I,J) with D2(I,J) c ALIGN WORKD(I) with D1(I) range (1:N) c ALIGN WORKD(I) with D1(I-N) range (N+1:2*N) c ALIGN WORKD(I) with D1(I-2*N) range (2*N+1:3*N) c DISTRIBUTE D1(BLOCK), D2(BLOCK,:) c REPLICATED WORKL(LWORKL) c c Cray MPP syntax: c =============== c REAL RESID(N), V(LDV,NCV), WORKD(N,3), WORKL(LWORKL) c SHARED RESID(BLOCK), V(BLOCK,:), WORKD(BLOCK,:) c REPLICATED WORKL(LWORKL) c c c\BeginLib c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall, c 1980. c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program", c Computer Physics Communications, 53 (1989), pp 169-179. c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to c Implement the Spectral Transformation", Math. Comp., 48 (1987), c pp 663-673. c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems", c SIAM J. Matr. Anal. Apps., January (1993). c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines c for Updating the QR decomposition", ACM TOMS, December 1990, c Volume 16 Number 4, pp 369-377. c 8. R.B. Lehoucq, D.C. Sorensen, "Implementation of Some Spectral c Transformations in a k-Step Arnoldi Method". In Preparation. c c\Routines called: c dsaup2 ARPACK routine that implements the Implicitly Restarted c Arnoldi Iteration. c dstats ARPACK routine that initialize timing and other statistics c variables. c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c dvout ARPACK utility routine that prints vectors. c dlamch LAPACK routine that determines machine constants. c c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/15/93: Version ' 2.4' c c\SCCS Information: @(#) c FILE: saupd.F SID: 2.8 DATE OF SID: 04/10/01 RELEASE: 2 c c\Remarks c 1. None c c\EndLib c c----------------------------------------------------------------------- c subroutine dsaupd & ( ido, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam, & ipntr, workd, workl, lworkl, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1, which*2 integer ido, info, ldv, lworkl, n, ncv, nev Double precision & tol c c %-----------------% c | Array Arguments | c %-----------------% c integer iparam(11), ipntr(11) Double precision & resid(n), v(ldv,ncv), workd(3*n), workl(lworkl) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0 , zero = 0.0D+0 ) c c %---------------% c | Local Scalars | c %---------------% c integer bounds, ierr, ih, iq, ishift, iupd, iw, & ldh, ldq, msglvl, mxiter, mode, nb, & nev0, next, np, ritz, j save bounds, ierr, ih, iq, ishift, iupd, iw, & ldh, ldq, msglvl, mxiter, mode, nb, & nev0, next, np, ritz c c %----------------------% c | External Subroutines | c %----------------------% c external dsaup2 , dvout , ivout, second, dstats c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlamch external dlamch c c %-----------------------% c | Executable Statements | c %-----------------------% c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call dstats call second (t0) msglvl = msaupd c ierr = 0 ishift = iparam(1) mxiter = iparam(3) c nb = iparam(4) nb = 1 c c %--------------------------------------------% c | Revision 2 performs only implicit restart. | c %--------------------------------------------% c iupd = 1 mode = iparam(7) c c %----------------% c | Error checking | c %----------------% c if (n .le. 0) then ierr = -1 else if (nev .le. 0) then ierr = -2 else if (ncv .le. nev .or. ncv .gt. n) then ierr = -3 end if c c %----------------------------------------------% c | NP is the number of additional steps to | c | extend the length NEV Lanczos factorization. | c %----------------------------------------------% c np = ncv - nev c if (mxiter .le. 0) ierr = -4 if (which .ne. 'LM' .and. & which .ne. 'SM' .and. & which .ne. 'LA' .and. & which .ne. 'SA' .and. & which .ne. 'BE') ierr = -5 if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6 c if (lworkl .lt. ncv**2 + 8*ncv) ierr = -7 if (mode .lt. 1 .or. mode .gt. 5) then ierr = -10 else if (mode .eq. 1 .and. bmat .eq. 'G') then ierr = -11 else if (ishift .lt. 0 .or. ishift .gt. 1) then ierr = -12 else if (nev .eq. 1 .and. which .eq. 'BE') then ierr = -13 end if c c %------------% c | Error Exit | c %------------% c if (ierr .ne. 0) then info = ierr ido = 99 go to 9000 end if c c %------------------------% c | Set default parameters | c %------------------------% c if (nb .le. 0) nb = 1 if (tol .le. zero) tol = dlamch ('EpsMach') c c %----------------------------------------------% c | NP is the number of additional steps to | c | extend the length NEV Lanczos factorization. | c | NEV0 is the local variable designating the | c | size of the invariant subspace desired. | c %----------------------------------------------% c np = ncv - nev nev0 = nev c c %-----------------------------% c | Zero out internal workspace | c %-----------------------------% c do 10 j = 1, ncv**2 + 8*ncv workl(j) = zero 10 continue c c %-------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | c | etc... and the remaining workspace. | c | Also update pointer to be used on output. | c | Memory is laid out as follows: | c | workl(1:2*ncv) := generated tridiagonal matrix | c | workl(2*ncv+1:2*ncv+ncv) := ritz values | c | workl(3*ncv+1:3*ncv+ncv) := computed error bounds | c | workl(4*ncv+1:4*ncv+ncv*ncv) := rotation matrix Q | c | workl(4*ncv+ncv*ncv+1:7*ncv+ncv*ncv) := workspace | c %-------------------------------------------------------% c ldh = ncv ldq = ncv ih = 1 ritz = ih + 2*ldh bounds = ritz + ncv iq = bounds + ncv iw = iq + ncv**2 next = iw + 3*ncv c ipntr(4) = next ipntr(5) = ih ipntr(6) = ritz ipntr(7) = bounds ipntr(11) = iw end if c c %-------------------------------------------------------% c | Carry out the Implicitly restarted Lanczos Iteration. | c %-------------------------------------------------------% c call dsaup2 & ( ido, bmat, n, which, nev0, np, tol, resid, mode, iupd, & ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritz), & workl(bounds), workl(iq), ldq, workl(iw), ipntr, workd, & info ) c c %--------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP or shifts. | c %--------------------------------------------------% c if (ido .eq. 3) iparam(8) = np if (ido .ne. 99) go to 9000 c iparam(3) = mxiter iparam(5) = np iparam(9) = nopx iparam(10) = nbx iparam(11) = nrorth c c %------------------------------------% c | Exit if there was an informational | c | error within dsaup2 . | c %------------------------------------% c if (info .lt. 0) go to 9000 if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then call ivout (logfil, 1, mxiter, ndigit, & '_saupd: number of update iterations taken') call ivout (logfil, 1, np, ndigit, & '_saupd: number of "converged" Ritz values') call dvout (logfil, np, workl(Ritz), ndigit, & '_saupd: final Ritz values') call dvout (logfil, np, workl(Bounds), ndigit, & '_saupd: corresponding error bounds') end if c call second (t1) tsaupd = t1 - t0 c if (msglvl .gt. 0) then c c %--------------------------------------------------------% c | Version Number & Version Date are defined in version.h | c %--------------------------------------------------------% c write (6,1000) write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt, & tmvopx, tmvbx, tsaupd, tsaup2, tsaitr, titref, & tgetv0, tseigt, tsgets, tsapps, tsconv 1000 format (//, & 5x, '==========================================',/ & 5x, '= Symmetric implicit Arnoldi update code =',/ & 5x, '= Version Number:', ' 2.4' , 19x, ' =',/ & 5x, '= Version Date: ', ' 07/31/96' , 14x, ' =',/ & 5x, '==========================================',/ & 5x, '= Summary of timing statistics =',/ & 5x, '==========================================',//) 1100 format ( & 5x, 'Total number update iterations = ', i5,/ & 5x, 'Total number of OP*x operations = ', i5,/ & 5x, 'Total number of B*x operations = ', i5,/ & 5x, 'Total number of reorthogonalization steps = ', i5,/ & 5x, 'Total number of iterative refinement steps = ', i5,/ & 5x, 'Total number of restart steps = ', i5,/ & 5x, 'Total time in user OP*x operation = ', f12.6,/ & 5x, 'Total time in user B*x operation = ', f12.6,/ & 5x, 'Total time in Arnoldi update routine = ', f12.6,/ & 5x, 'Total time in saup2 routine = ', f12.6,/ & 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/ & 5x, 'Total time in reorthogonalization phase = ', f12.6,/ & 5x, 'Total time in (re)start vector generation = ', f12.6,/ & 5x, 'Total time in trid eigenvalue subproblem = ', f12.6,/ & 5x, 'Total time in getting the shifts = ', f12.6,/ & 5x, 'Total time in applying the shifts = ', f12.6,/ & 5x, 'Total time in convergence testing = ', f12.6) end if c 9000 continue c return c c %---------------% c | End of dsaupd | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/iswap.f000644 001750 001750 00000002313 11266605602 021737 0ustar00geuzainegeuzaine000000 000000 subroutine iswap (n,sx,incx,sy,incy) c c interchanges two vectors. c uses unrolled loops for increments equal to 1. c jack dongarra, linpack, 3/11/78. c integer sx(1),sy(1),stemp integer i,incx,incy,ix,iy,m,mp1,n c if(n.le.0)return if(incx.eq.1.and.incy.eq.1)go to 20 c c code for unequal increments or equal increments not equal c to 1 c ix = 1 iy = 1 if(incx.lt.0)ix = (-n+1)*incx + 1 if(incy.lt.0)iy = (-n+1)*incy + 1 do 10 i = 1,n stemp = sx(ix) sx(ix) = sy(iy) sy(iy) = stemp ix = ix + incx iy = iy + incy 10 continue return c c code for both increments equal to 1 c c c clean-up loop c 20 m = mod(n,3) if( m .eq. 0 ) go to 40 do 30 i = 1,m stemp = sx(i) sx(i) = sy(i) sy(i) = stemp 30 continue if( n .lt. 3 ) return 40 mp1 = m + 1 do 50 i = mp1,n,3 stemp = sx(i) sx(i) = sy(i) sy(i) = stemp stemp = sx(i + 1) sx(i + 1) = sy(i + 1) sy(i + 1) = stemp stemp = sx(i + 2) sx(i + 2) = sy(i + 2) sy(i + 2) = stemp 50 continue return end getdp-2.7.0-source/contrib/Arpack/ssaupd.f000644 001750 001750 00000070372 11266605602 022125 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: ssaupd c c\Description: c c Reverse communication interface for the Implicitly Restarted Arnoldi c Iteration. For symmetric problems this reduces to a variant of the Lanczos c method. This method has been designed to compute approximations to a c few eigenpairs of a linear operator OP that is real and symmetric c with respect to a real positive semi-definite symmetric matrix B, c i.e. c c B*OP = (OP`)*B. c c Another way to express this condition is c c < x,OPy > = < OPx,y > where < z,w > = z`Bw . c c In the standard eigenproblem B is the identity matrix. c ( A` denotes transpose of A) c c The computed approximate eigenvalues are called Ritz values and c the corresponding approximate eigenvectors are called Ritz vectors. c c ssaupd is usually called iteratively to solve one of the c following problems: c c Mode 1: A*x = lambda*x, A symmetric c ===> OP = A and B = I. c c Mode 2: A*x = lambda*M*x, A symmetric, M symmetric positive definite c ===> OP = inv[M]*A and B = M. c ===> (If M can be factored see remark 3 below) c c Mode 3: K*x = lambda*M*x, K symmetric, M symmetric positive semi-definite c ===> OP = (inv[K - sigma*M])*M and B = M. c ===> Shift-and-Invert mode c c Mode 4: K*x = lambda*KG*x, K symmetric positive semi-definite, c KG symmetric indefinite c ===> OP = (inv[K - sigma*KG])*K and B = K. c ===> Buckling mode c c Mode 5: A*x = lambda*M*x, A symmetric, M symmetric positive semi-definite c ===> OP = inv[A - sigma*M]*[A + sigma*M] and B = M. c ===> Cayley transformed mode c c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v c should be accomplished either by a direct method c using a sparse matrix factorization and solving c c [A - sigma*M]*w = v or M*w = v, c c or through an iterative method for solving these c systems. If an iterative method is used, the c convergence test must be more stringent than c the accuracy requirements for the eigenvalue c approximations. c c\Usage: c call ssaupd c ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, c IPNTR, WORKD, WORKL, LWORKL, INFO ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. IDO must be zero on the first c call to ssaupd. IDO will be set internally to c indicate the type of operation to be performed. Control is c then given back to the calling routine which has the c responsibility to carry out the requested operation and call c ssaupd with the result. The operand is given in c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)). c (If Mode = 2 see remark 5 below) c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c This is for the initialization phase to force the c starting vector into the range of OP. c IDO = 1: compute Y = OP * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c In mode 3,4 and 5, the vector B * X is already c available in WORKD(ipntr(3)). It does not c need to be recomputed in forming OP * X. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. c IDO = 3: compute the IPARAM(8) shifts where c IPNTR(11) is the pointer into WORKL for c placing the shifts. See remark 6 below. c IDO = 99: done c ------------------------------------------------------------- c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B that defines the c semi-inner product for the operator OP. c B = 'I' -> standard eigenvalue problem A*x = lambda*x c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x c c N Integer. (INPUT) c Dimension of the eigenproblem. c c WHICH Character*2. (INPUT) c Specify which of the Ritz values of OP to compute. c c 'LA' - compute the NEV largest (algebraic) eigenvalues. c 'SA' - compute the NEV smallest (algebraic) eigenvalues. c 'LM' - compute the NEV largest (in magnitude) eigenvalues. c 'SM' - compute the NEV smallest (in magnitude) eigenvalues. c 'BE' - compute NEV eigenvalues, half from each end of the c spectrum. When NEV is odd, compute one more from the c high end than from the low end. c (see remark 1 below) c c NEV Integer. (INPUT) c Number of eigenvalues of OP to be computed. 0 < NEV < N. c c TOL Real scalar. (INPUT) c Stopping criterion: the relative accuracy of the Ritz value c is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)). c If TOL .LE. 0. is passed a default is set: c DEFAULT = SLAMCH('EPS') (machine precision as computed c by the LAPACK auxiliary subroutine SLAMCH). c c RESID Real array of length N. (INPUT/OUTPUT) c On INPUT: c If INFO .EQ. 0, a random initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c On OUTPUT: c RESID contains the final residual vector. c c NCV Integer. (INPUT) c Number of columns of the matrix V (less than or equal to N). c This will indicate how many Lanczos vectors are generated c at each iteration. After the startup phase in which NEV c Lanczos vectors are generated, the algorithm generates c NCV-NEV Lanczos vectors at each subsequent update iteration. c Most of the cost in generating each Lanczos vector is in the c matrix-vector product OP*x. (See remark 4 below). c c V Real N by NCV array. (OUTPUT) c The NCV columns of V contain the Lanczos basis vectors. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c IPARAM Integer array of length 11. (INPUT/OUTPUT) c IPARAM(1) = ISHIFT: method for selecting the implicit shifts. c The shifts selected at each iteration are used to restart c the Arnoldi iteration in an implicit fashion. c ------------------------------------------------------------- c ISHIFT = 0: the shifts are provided by the user via c reverse communication. The NCV eigenvalues of c the current tridiagonal matrix T are returned in c the part of WORKL array corresponding to RITZ. c See remark 6 below. c ISHIFT = 1: exact shifts with respect to the reduced c tridiagonal matrix T. This is equivalent to c restarting the iteration with a starting vector c that is a linear combination of Ritz vectors c associated with the "wanted" Ritz values. c ------------------------------------------------------------- c c IPARAM(2) = LEVEC c No longer referenced. See remark 2 below. c c IPARAM(3) = MXITER c On INPUT: maximum number of Arnoldi update iterations allowed. c On OUTPUT: actual number of Arnoldi update iterations taken. c c IPARAM(4) = NB: blocksize to be used in the recurrence. c The code currently works only for NB = 1. c c IPARAM(5) = NCONV: number of "converged" Ritz values. c This represents the number of Ritz values that satisfy c the convergence criterion. c c IPARAM(6) = IUPD c No longer referenced. Implicit restarting is ALWAYS used. c c IPARAM(7) = MODE c On INPUT determines what type of eigenproblem is being solved. c Must be 1,2,3,4,5; See under \Description of ssaupd for the c five modes available. c c IPARAM(8) = NP c When ido = 3 and the user provides shifts through reverse c communication (IPARAM(1)=0), ssaupd returns NP, the number c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark c 6 below. c c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO, c OUTPUT: NUMOP = total number of OP*x operations, c NUMOPB = total number of B*x operations if BMAT='G', c NUMREO = total number of steps of re-orthogonalization. c c IPNTR Integer array of length 11. (OUTPUT) c Pointer to mark the starting locations in the WORKD and WORKL c arrays for matrices/vectors used by the Lanczos iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X in WORKD. c IPNTR(2): pointer to the current result vector Y in WORKD. c IPNTR(3): pointer to the vector B * X in WORKD when used in c the shift-and-invert mode. c IPNTR(4): pointer to the next available location in WORKL c that is untouched by the program. c IPNTR(5): pointer to the NCV by 2 tridiagonal matrix T in WORKL. c IPNTR(6): pointer to the NCV RITZ values array in WORKL. c IPNTR(7): pointer to the Ritz estimates in array WORKL associated c with the Ritz values located in RITZ in WORKL. c IPNTR(11): pointer to the NP shifts in WORKL. See Remark 6 below. c c Note: IPNTR(8:10) is only referenced by sseupd. See Remark 2. c IPNTR(8): pointer to the NCV RITZ values of the original system. c IPNTR(9): pointer to the NCV corresponding error bounds. c IPNTR(10): pointer to the NCV by NCV matrix of eigenvectors c of the tridiagonal matrix T. Only referenced by c sseupd if RVEC = .TRUE. See Remarks. c ------------------------------------------------------------- c c WORKD Real work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration. Upon termination c WORKD(1:N) contains B*RESID(1:N). If the Ritz vectors are desired c subroutine sseupd uses this output. c See Data Distribution Note below. c c WORKL Real work array of length LWORKL. (OUTPUT/WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. See Data Distribution Note below. c c LWORKL Integer. (INPUT) c LWORKL must be at least NCV**2 + 8*NCV . c c INFO Integer. (INPUT/OUTPUT) c If INFO .EQ. 0, a randomly initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c Error flag on output. c = 0: Normal exit. c = 1: Maximum number of iterations taken. c All possible eigenvalues of OP has been found. IPARAM(5) c returns the number of wanted converged Ritz values. c = 2: No longer an informational error. Deprecated starting c with release 2 of ARPACK. c = 3: No shifts could be applied during a cycle of the c Implicitly restarted Arnoldi iteration. One possibility c is to increase the size of NCV relative to NEV. c See remark 4 below. c = -1: N must be positive. c = -2: NEV must be positive. c = -3: NCV must be greater than NEV and less than or equal to N. c = -4: The maximum number of Arnoldi update iterations allowed c must be greater than zero. c = -5: WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'. c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work array WORKL is not sufficient. c = -8: Error return from trid. eigenvalue calculation; c Informatinal error from LAPACK routine ssteqr. c = -9: Starting vector is zero. c = -10: IPARAM(7) must be 1,2,3,4,5. c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable. c = -12: IPARAM(1) must be equal to 0 or 1. c = -13: NEV and WHICH = 'BE' are incompatable. c = -9999: Could not build an Arnoldi factorization. c IPARAM(5) returns the size of the current Arnoldi c factorization. The user is advised to check that c enough workspace and array storage has been allocated. c c c\Remarks c 1. The converged Ritz values are always returned in ascending c algebraic order. The computed Ritz values are approximate c eigenvalues of OP. The selection of WHICH should be made c with this in mind when Mode = 3,4,5. After convergence, c approximate eigenvalues of the original problem may be obtained c with the ARPACK subroutine sseupd. c c 2. If the Ritz vectors corresponding to the converged Ritz values c are needed, the user must call sseupd immediately following completion c of ssaupd. This is new starting with version 2.1 of ARPACK. c c 3. If M can be factored into a Cholesky factorization M = LL` c then Mode = 2 should not be selected. Instead one should use c Mode = 1 with OP = inv(L)*A*inv(L`). Appropriate triangular c linear systems should be solved with L and L` rather c than computing inverses. After convergence, an approximate c eigenvector z of the original problem is recovered by solving c L`z = x where x is a Ritz vector of OP. c c 4. At present there is no a-priori analysis to guide the selection c of NCV relative to NEV. The only formal requrement is that NCV > NEV. c However, it is recommended that NCV .ge. 2*NEV. If many problems of c the same type are to be solved, one should experiment with increasing c NCV while keeping NEV fixed for a given test problem. This will c usually decrease the required number of OP*x operations but it c also increases the work and storage required to maintain the orthogonal c basis vectors. The optimal "cross-over" with respect to CPU time c is problem dependent and must be determined empirically. c c 5. If IPARAM(7) = 2 then in the Reverse commuication interface the user c must do the following. When IDO = 1, Y = OP * X is to be computed. c When IPARAM(7) = 2 OP = inv(B)*A. After computing A*X the user c must overwrite X with A*X. Y is then the solution to the linear set c of equations B*Y = A*X. c c 6. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the c NP = IPARAM(8) shifts in locations: c 1 WORKL(IPNTR(11)) c 2 WORKL(IPNTR(11)+1) c . c . c . c NP WORKL(IPNTR(11)+NP-1). c c The eigenvalues of the current tridiagonal matrix are located in c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are in the c order defined by WHICH. The associated Ritz estimates are located in c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1). c c----------------------------------------------------------------------- c c\Data Distribution Note: c c Fortran-D syntax: c ================ c REAL RESID(N), V(LDV,NCV), WORKD(3*N), WORKL(LWORKL) c DECOMPOSE D1(N), D2(N,NCV) c ALIGN RESID(I) with D1(I) c ALIGN V(I,J) with D2(I,J) c ALIGN WORKD(I) with D1(I) range (1:N) c ALIGN WORKD(I) with D1(I-N) range (N+1:2*N) c ALIGN WORKD(I) with D1(I-2*N) range (2*N+1:3*N) c DISTRIBUTE D1(BLOCK), D2(BLOCK,:) c REPLICATED WORKL(LWORKL) c c Cray MPP syntax: c =============== c REAL RESID(N), V(LDV,NCV), WORKD(N,3), WORKL(LWORKL) c SHARED RESID(BLOCK), V(BLOCK,:), WORKD(BLOCK,:) c REPLICATED WORKL(LWORKL) c c c\BeginLib c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall, c 1980. c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program", c Computer Physics Communications, 53 (1989), pp 169-179. c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to c Implement the Spectral Transformation", Math. Comp., 48 (1987), c pp 663-673. c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems", c SIAM J. Matr. Anal. Apps., January (1993). c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines c for Updating the QR decomposition", ACM TOMS, December 1990, c Volume 16 Number 4, pp 369-377. c 8. R.B. Lehoucq, D.C. Sorensen, "Implementation of Some Spectral c Transformations in a k-Step Arnoldi Method". In Preparation. c c\Routines called: c ssaup2 ARPACK routine that implements the Implicitly Restarted c Arnoldi Iteration. c sstats ARPACK routine that initialize timing and other statistics c variables. c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c svout ARPACK utility routine that prints vectors. c slamch LAPACK routine that determines machine constants. c c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c 12/15/93: Version ' 2.4' c c\SCCS Information: @(#) c FILE: saupd.F SID: 2.8 DATE OF SID: 04/10/01 RELEASE: 2 c c\Remarks c 1. None c c\EndLib c c----------------------------------------------------------------------- c subroutine ssaupd & ( ido, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam, & ipntr, workd, workl, lworkl, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1, which*2 integer ido, info, ldv, lworkl, n, ncv, nev Real & tol c c %-----------------% c | Array Arguments | c %-----------------% c integer iparam(11), ipntr(11) Real & resid(n), v(ldv,ncv), workd(3*n), workl(lworkl) c c %------------% c | Parameters | c %------------% c Real & one, zero parameter (one = 1.0E+0 , zero = 0.0E+0 ) c c %---------------% c | Local Scalars | c %---------------% c integer bounds, ierr, ih, iq, ishift, iupd, iw, & ldh, ldq, msglvl, mxiter, mode, nb, & nev0, next, np, ritz, j save bounds, ierr, ih, iq, ishift, iupd, iw, & ldh, ldq, msglvl, mxiter, mode, nb, & nev0, next, np, ritz c c %----------------------% c | External Subroutines | c %----------------------% c external ssaup2, svout, ivout, second, sstats c c %--------------------% c | External Functions | c %--------------------% c Real & slamch external slamch c c %-----------------------% c | Executable Statements | c %-----------------------% c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call sstats call second (t0) msglvl = msaupd c ierr = 0 ishift = iparam(1) mxiter = iparam(3) c nb = iparam(4) nb = 1 c c %--------------------------------------------% c | Revision 2 performs only implicit restart. | c %--------------------------------------------% c iupd = 1 mode = iparam(7) c c %----------------% c | Error checking | c %----------------% c if (n .le. 0) then ierr = -1 else if (nev .le. 0) then ierr = -2 else if (ncv .le. nev .or. ncv .gt. n) then ierr = -3 end if c c %----------------------------------------------% c | NP is the number of additional steps to | c | extend the length NEV Lanczos factorization. | c %----------------------------------------------% c np = ncv - nev c if (mxiter .le. 0) ierr = -4 if (which .ne. 'LM' .and. & which .ne. 'SM' .and. & which .ne. 'LA' .and. & which .ne. 'SA' .and. & which .ne. 'BE') ierr = -5 if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6 c if (lworkl .lt. ncv**2 + 8*ncv) ierr = -7 if (mode .lt. 1 .or. mode .gt. 5) then ierr = -10 else if (mode .eq. 1 .and. bmat .eq. 'G') then ierr = -11 else if (ishift .lt. 0 .or. ishift .gt. 1) then ierr = -12 else if (nev .eq. 1 .and. which .eq. 'BE') then ierr = -13 end if c c %------------% c | Error Exit | c %------------% c if (ierr .ne. 0) then info = ierr ido = 99 go to 9000 end if c c %------------------------% c | Set default parameters | c %------------------------% c if (nb .le. 0) nb = 1 if (tol .le. zero) tol = slamch('EpsMach') c c %----------------------------------------------% c | NP is the number of additional steps to | c | extend the length NEV Lanczos factorization. | c | NEV0 is the local variable designating the | c | size of the invariant subspace desired. | c %----------------------------------------------% c np = ncv - nev nev0 = nev c c %-----------------------------% c | Zero out internal workspace | c %-----------------------------% c do 10 j = 1, ncv**2 + 8*ncv workl(j) = zero 10 continue c c %-------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | c | etc... and the remaining workspace. | c | Also update pointer to be used on output. | c | Memory is laid out as follows: | c | workl(1:2*ncv) := generated tridiagonal matrix | c | workl(2*ncv+1:2*ncv+ncv) := ritz values | c | workl(3*ncv+1:3*ncv+ncv) := computed error bounds | c | workl(4*ncv+1:4*ncv+ncv*ncv) := rotation matrix Q | c | workl(4*ncv+ncv*ncv+1:7*ncv+ncv*ncv) := workspace | c %-------------------------------------------------------% c ldh = ncv ldq = ncv ih = 1 ritz = ih + 2*ldh bounds = ritz + ncv iq = bounds + ncv iw = iq + ncv**2 next = iw + 3*ncv c ipntr(4) = next ipntr(5) = ih ipntr(6) = ritz ipntr(7) = bounds ipntr(11) = iw end if c c %-------------------------------------------------------% c | Carry out the Implicitly restarted Lanczos Iteration. | c %-------------------------------------------------------% c call ssaup2 & ( ido, bmat, n, which, nev0, np, tol, resid, mode, iupd, & ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritz), & workl(bounds), workl(iq), ldq, workl(iw), ipntr, workd, & info ) c c %--------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP or shifts. | c %--------------------------------------------------% c if (ido .eq. 3) iparam(8) = np if (ido .ne. 99) go to 9000 c iparam(3) = mxiter iparam(5) = np iparam(9) = nopx iparam(10) = nbx iparam(11) = nrorth c c %------------------------------------% c | Exit if there was an informational | c | error within ssaup2. | c %------------------------------------% c if (info .lt. 0) go to 9000 if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then call ivout (logfil, 1, mxiter, ndigit, & '_saupd: number of update iterations taken') call ivout (logfil, 1, np, ndigit, & '_saupd: number of "converged" Ritz values') call svout (logfil, np, workl(Ritz), ndigit, & '_saupd: final Ritz values') call svout (logfil, np, workl(Bounds), ndigit, & '_saupd: corresponding error bounds') end if c call second (t1) tsaupd = t1 - t0 c if (msglvl .gt. 0) then c c %--------------------------------------------------------% c | Version Number & Version Date are defined in version.h | c %--------------------------------------------------------% c write (6,1000) write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt, & tmvopx, tmvbx, tsaupd, tsaup2, tsaitr, titref, & tgetv0, tseigt, tsgets, tsapps, tsconv 1000 format (//, & 5x, '==========================================',/ & 5x, '= Symmetric implicit Arnoldi update code =',/ & 5x, '= Version Number:', ' 2.4' , 19x, ' =',/ & 5x, '= Version Date: ', ' 07/31/96' , 14x, ' =',/ & 5x, '==========================================',/ & 5x, '= Summary of timing statistics =',/ & 5x, '==========================================',//) 1100 format ( & 5x, 'Total number update iterations = ', i5,/ & 5x, 'Total number of OP*x operations = ', i5,/ & 5x, 'Total number of B*x operations = ', i5,/ & 5x, 'Total number of reorthogonalization steps = ', i5,/ & 5x, 'Total number of iterative refinement steps = ', i5,/ & 5x, 'Total number of restart steps = ', i5,/ & 5x, 'Total time in user OP*x operation = ', f12.6,/ & 5x, 'Total time in user B*x operation = ', f12.6,/ & 5x, 'Total time in Arnoldi update routine = ', f12.6,/ & 5x, 'Total time in saup2 routine = ', f12.6,/ & 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/ & 5x, 'Total time in reorthogonalization phase = ', f12.6,/ & 5x, 'Total time in (re)start vector generation = ', f12.6,/ & 5x, 'Total time in trid eigenvalue subproblem = ', f12.6,/ & 5x, 'Total time in getting the shifts = ', f12.6,/ & 5x, 'Total time in applying the shifts = ', f12.6,/ & 5x, 'Total time in convergence testing = ', f12.6) end if c 9000 continue c return c c %---------------% c | End of ssaupd | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/snaupe.f000644 001750 001750 00000000000 11266605602 022076 0ustar00geuzainegeuzaine000000 000000 getdp-2.7.0-source/contrib/Arpack/dngets.f000644 001750 001750 00000017534 11266605602 022113 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: dngets c c\Description: c Given the eigenvalues of the upper Hessenberg matrix H, c computes the NP shifts AMU that are zeros of the polynomial of c degree NP which filters out components of the unwanted eigenvectors c corresponding to the AMU's based on some given criteria. c c NOTE: call this even in the case of user specified shifts in order c to sort the eigenvalues, and error bounds of H for later use. c c\Usage: c call dngets c ( ISHIFT, WHICH, KEV, NP, RITZR, RITZI, BOUNDS, SHIFTR, SHIFTI ) c c\Arguments c ISHIFT Integer. (INPUT) c Method for selecting the implicit shifts at each iteration. c ISHIFT = 0: user specified shifts c ISHIFT = 1: exact shift with respect to the matrix H. c c WHICH Character*2. (INPUT) c Shift selection criteria. c 'LM' -> want the KEV eigenvalues of largest magnitude. c 'SM' -> want the KEV eigenvalues of smallest magnitude. c 'LR' -> want the KEV eigenvalues of largest real part. c 'SR' -> want the KEV eigenvalues of smallest real part. c 'LI' -> want the KEV eigenvalues of largest imaginary part. c 'SI' -> want the KEV eigenvalues of smallest imaginary part. c c KEV Integer. (INPUT/OUTPUT) c INPUT: KEV+NP is the size of the matrix H. c OUTPUT: Possibly increases KEV by one to keep complex conjugate c pairs together. c c NP Integer. (INPUT/OUTPUT) c Number of implicit shifts to be computed. c OUTPUT: Possibly decreases NP by one to keep complex conjugate c pairs together. c c RITZR, Double precision array of length KEV+NP. (INPUT/OUTPUT) c RITZI On INPUT, RITZR and RITZI contain the real and imaginary c parts of the eigenvalues of H. c On OUTPUT, RITZR and RITZI are sorted so that the unwanted c eigenvalues are in the first NP locations and the wanted c portion is in the last KEV locations. When exact shifts are c selected, the unwanted part corresponds to the shifts to c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues c are further sorted so that the ones with largest Ritz values c are first. c c BOUNDS Double precision array of length KEV+NP. (INPUT/OUTPUT) c Error bounds corresponding to the ordering in RITZ. c c SHIFTR, SHIFTI *** USE deprecated as of version 2.1. *** c c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c dsortc ARPACK sorting routine. c dcopy Level 1 BLAS that copies one vector to another . c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.1' c c\SCCS Information: @(#) c FILE: ngets.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 c c\Remarks c 1. xxxx c c\EndLib c c----------------------------------------------------------------------- c subroutine dngets ( ishift, which, kev, np, ritzr, ritzi, bounds, & shiftr, shifti ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which integer ishift, kev, np c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & bounds(kev+np), ritzr(kev+np), ritzi(kev+np), & shiftr(1), shifti(1) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0, zero = 0.0) c c %---------------% c | Local Scalars | c %---------------% c integer msglvl c c %----------------------% c | External Subroutines | c %----------------------% c external dcopy, dsortc, second c c %----------------------% c | Intrinsics Functions | c %----------------------% c intrinsic abs c c %-----------------------% c | Executable Statements | c %-----------------------% c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mngets c c %----------------------------------------------------% c | LM, SM, LR, SR, LI, SI case. | c | Sort the eigenvalues of H into the desired order | c | and apply the resulting order to BOUNDS. | c | The eigenvalues are sorted so that the wanted part | c | are always in the last KEV locations. | c | We first do a pre-processing sort in order to keep | c | complex conjugate pairs together | c %----------------------------------------------------% c if (which .eq. 'LM') then call dsortc ('LR', .true., kev+np, ritzr, ritzi, bounds) else if (which .eq. 'SM') then call dsortc ('SR', .true., kev+np, ritzr, ritzi, bounds) else if (which .eq. 'LR') then call dsortc ('LM', .true., kev+np, ritzr, ritzi, bounds) else if (which .eq. 'SR') then call dsortc ('SM', .true., kev+np, ritzr, ritzi, bounds) else if (which .eq. 'LI') then call dsortc ('LM', .true., kev+np, ritzr, ritzi, bounds) else if (which .eq. 'SI') then call dsortc ('SM', .true., kev+np, ritzr, ritzi, bounds) end if c call dsortc (which, .true., kev+np, ritzr, ritzi, bounds) c c %-------------------------------------------------------% c | Increase KEV by one if the ( ritzr(np),ritzi(np) ) | c | = ( ritzr(np+1),-ritzi(np+1) ) and ritz(np) .ne. zero | c | Accordingly decrease NP by one. In other words keep | c | complex conjugate pairs together. | c %-------------------------------------------------------% c if ( ( ritzr(np+1) - ritzr(np) ) .eq. zero & .and. ( ritzi(np+1) + ritzi(np) ) .eq. zero ) then np = np - 1 kev = kev + 1 end if c if ( ishift .eq. 1 ) then c c %-------------------------------------------------------% c | Sort the unwanted Ritz values used as shifts so that | c | the ones with largest Ritz estimates are first | c | This will tend to minimize the effects of the | c | forward instability of the iteration when they shifts | c | are applied in subroutine dnapps. | c | Be careful and use 'SR' since we want to sort BOUNDS! | c %-------------------------------------------------------% c call dsortc ( 'SR', .true., np, bounds, ritzr, ritzi ) end if c call second (t1) tngets = tngets + (t1 - t0) c if (msglvl .gt. 0) then call ivout (logfil, 1, kev, ndigit, '_ngets: KEV is') call ivout (logfil, 1, np, ndigit, '_ngets: NP is') call dvout (logfil, kev+np, ritzr, ndigit, & '_ngets: Eigenvalues of current H matrix -- real part') call dvout (logfil, kev+np, ritzi, ndigit, & '_ngets: Eigenvalues of current H matrix -- imag part') call dvout (logfil, kev+np, bounds, ndigit, & '_ngets: Ritz estimates of the current KEV+NP Ritz values') end if c return c c %---------------% c | End of dngets | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/sneigh.f000644 001750 001750 00000024035 11266605602 022076 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: sneigh c c\Description: c Compute the eigenvalues of the current upper Hessenberg matrix c and the corresponding Ritz estimates given the current residual norm. c c\Usage: c call sneigh c ( RNORM, N, H, LDH, RITZR, RITZI, BOUNDS, Q, LDQ, WORKL, IERR ) c c\Arguments c RNORM Real scalar. (INPUT) c Residual norm corresponding to the current upper Hessenberg c matrix H. c c N Integer. (INPUT) c Size of the matrix H. c c H Real N by N array. (INPUT) c H contains the current upper Hessenberg matrix. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RITZR, Real arrays of length N. (OUTPUT) c RITZI On output, RITZR(1:N) (resp. RITZI(1:N)) contains the real c (respectively imaginary) parts of the eigenvalues of H. c c BOUNDS Real array of length N. (OUTPUT) c On output, BOUNDS contains the Ritz estimates associated with c the eigenvalues RITZR and RITZI. This is equal to RNORM c times the last components of the eigenvectors corresponding c to the eigenvalues in RITZR and RITZI. c c Q Real N by N array. (WORKSPACE) c Workspace needed to store the eigenvectors of H. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKL Real work array of length N**2 + 3*N. (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. This is needed to keep the full Schur form c of H and also in the calculation of the eigenvectors of H. c c IERR Integer. (OUTPUT) c Error exit flag from slaqrb or strevc. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c slaqrb ARPACK routine to compute the real Schur form of an c upper Hessenberg matrix and last row of the Schur vectors. c second ARPACK utility routine for timing. c smout ARPACK utility routine that prints matrices c svout ARPACK utility routine that prints vectors. c slacpy LAPACK matrix copy routine. c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c strevc LAPACK routine to compute the eigenvectors of a matrix c in upper quasi-triangular form c sgemv Level 2 BLAS routine for matrix vector multiplication. c scopy Level 1 BLAS that copies one vector to another . c snrm2 Level 1 BLAS that computes the norm of a vector. c sscal Level 1 BLAS that scales a vector. c c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.1' c c\SCCS Information: @(#) c FILE: neigh.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 c c\Remarks c None c c\EndLib c c----------------------------------------------------------------------- c subroutine sneigh (rnorm, n, h, ldh, ritzr, ritzi, bounds, & q, ldq, workl, ierr) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer ierr, n, ldh, ldq Real & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c Real & bounds(n), h(ldh,n), q(ldq,n), ritzi(n), ritzr(n), & workl(n*(n+3)) c c %------------% c | Parameters | c %------------% c Real & one, zero parameter (one = 1.0E+0, zero = 0.0E+0) c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c logical select(1) integer i, iconj, msglvl Real & temp, vl(1) c c %----------------------% c | External Subroutines | c %----------------------% c external scopy, slacpy, slaqrb, strevc, svout, second c c %--------------------% c | External Functions | c %--------------------% c Real & slapy2, snrm2 external slapy2, snrm2 c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic abs c c %-----------------------% c | Executable Statements | c %-----------------------% c c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mneigh c if (msglvl .gt. 2) then call smout (logfil, n, n, h, ldh, ndigit, & '_neigh: Entering upper Hessenberg matrix H ') end if c c %-----------------------------------------------------------% c | 1. Compute the eigenvalues, the last components of the | c | corresponding Schur vectors and the full Schur form T | c | of the current upper Hessenberg matrix H. | c | slaqrb returns the full Schur form of H in WORKL(1:N**2) | c | and the last components of the Schur vectors in BOUNDS. | c %-----------------------------------------------------------% c call slacpy ('All', n, n, h, ldh, workl, n) call slaqrb (.true., n, 1, n, workl, n, ritzr, ritzi, bounds, & ierr) if (ierr .ne. 0) go to 9000 c if (msglvl .gt. 1) then call svout (logfil, n, bounds, ndigit, & '_neigh: last row of the Schur matrix for H') end if c c %-----------------------------------------------------------% c | 2. Compute the eigenvectors of the full Schur form T and | c | apply the last components of the Schur vectors to get | c | the last components of the corresponding eigenvectors. | c | Remember that if the i-th and (i+1)-st eigenvalues are | c | complex conjugate pairs, then the real & imaginary part | c | of the eigenvector components are split across adjacent | c | columns of Q. | c %-----------------------------------------------------------% c call strevc ('R', 'A', select, n, workl, n, vl, n, q, ldq, & n, n, workl(n*n+1), ierr) c if (ierr .ne. 0) go to 9000 c c %------------------------------------------------% c | Scale the returning eigenvectors so that their | c | euclidean norms are all one. LAPACK subroutine | c | strevc returns each eigenvector normalized so | c | that the element of largest magnitude has | c | magnitude 1; here the magnitude of a complex | c | number (x,y) is taken to be |x| + |y|. | c %------------------------------------------------% c iconj = 0 do 10 i=1, n if ( abs( ritzi(i) ) .le. zero ) then c c %----------------------% c | Real eigenvalue case | c %----------------------% c temp = snrm2( n, q(1,i), 1 ) call sscal ( n, one / temp, q(1,i), 1 ) else c c %-------------------------------------------% c | Complex conjugate pair case. Note that | c | since the real and imaginary part of | c | the eigenvector are stored in consecutive | c | columns, we further normalize by the | c | square root of two. | c %-------------------------------------------% c if (iconj .eq. 0) then temp = slapy2( snrm2( n, q(1,i), 1 ), & snrm2( n, q(1,i+1), 1 ) ) call sscal ( n, one / temp, q(1,i), 1 ) call sscal ( n, one / temp, q(1,i+1), 1 ) iconj = 1 else iconj = 0 end if end if 10 continue c call sgemv ('T', n, n, one, q, ldq, bounds, 1, zero, workl, 1) c if (msglvl .gt. 1) then call svout (logfil, n, workl, ndigit, & '_neigh: Last row of the eigenvector matrix for H') end if c c %----------------------------% c | Compute the Ritz estimates | c %----------------------------% c iconj = 0 do 20 i = 1, n if ( abs( ritzi(i) ) .le. zero ) then c c %----------------------% c | Real eigenvalue case | c %----------------------% c bounds(i) = rnorm * abs( workl(i) ) else c c %-------------------------------------------% c | Complex conjugate pair case. Note that | c | since the real and imaginary part of | c | the eigenvector are stored in consecutive | c | columns, we need to take the magnitude | c | of the last components of the two vectors | c %-------------------------------------------% c if (iconj .eq. 0) then bounds(i) = rnorm * slapy2( workl(i), workl(i+1) ) bounds(i+1) = bounds(i) iconj = 1 else iconj = 0 end if end if 20 continue c if (msglvl .gt. 2) then call svout (logfil, n, ritzr, ndigit, & '_neigh: Real part of the eigenvalues of H') call svout (logfil, n, ritzi, ndigit, & '_neigh: Imaginary part of the eigenvalues of H') call svout (logfil, n, bounds, ndigit, & '_neigh: Ritz estimates for the eigenvalues of H') end if c call second (t1) tneigh = tneigh + (t1 - t0) c 9000 continue return c c %---------------% c | End of sneigh | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/icopy.f000644 001750 001750 00000003635 11266605602 021747 0ustar00geuzainegeuzaine000000 000000 *-------------------------------------------------------------------- *\Documentation * *\Name: ICOPY * *\Description: * ICOPY copies an integer vector lx to an integer vector ly. * *\Usage: * call icopy ( n, lx, inc, ly, incy ) * *\Arguments: * n integer (input) * On entry, n is the number of elements of lx to be c copied to ly. * * lx integer array (input) * On entry, lx is the integer vector to be copied. * * incx integer (input) * On entry, incx is the increment between elements of lx. * * ly integer array (input) * On exit, ly is the integer vector that contains the * copy of lx. * * incy integer (input) * On entry, incy is the increment between elements of ly. * *\Enddoc * *-------------------------------------------------------------------- * subroutine icopy( n, lx, incx, ly, incy ) * * ---------------------------- * Specifications for arguments * ---------------------------- integer incx, incy, n integer lx( 1 ), ly( 1 ) * * ---------------------------------- * Specifications for local variables * ---------------------------------- integer i, ix, iy * * -------------------------- * First executable statement * -------------------------- if( n.le.0 ) $ return if( incx.eq.1 .and. incy.eq.1 ) $ go to 20 c c.....code for unequal increments or equal increments c not equal to 1 ix = 1 iy = 1 if( incx.lt.0 ) $ ix = ( -n+1 )*incx + 1 if( incy.lt.0 ) $ iy = ( -n+1 )*incy + 1 do 10 i = 1, n ly( iy ) = lx( ix ) ix = ix + incx iy = iy + incy 10 continue return c c.....code for both increments equal to 1 c 20 continue do 30 i = 1, n ly( i ) = lx( i ) 30 continue return end getdp-2.7.0-source/contrib/Arpack/second.f000644 001750 001750 00000001526 11266605602 022074 0ustar00geuzainegeuzaine000000 000000 SUBROUTINE SECOND( T ) * REAL T * * -- LAPACK auxiliary routine (preliminary version) -- * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., * Courant Institute, Argonne National Lab, and Rice University * July 26, 1991 * * Purpose * ======= * * SECOND returns the user time for a process in seconds. * This version gets the time from the system function ETIME. * * .. Local Scalars .. REAL T1 * .. * .. Local Arrays .. REAL TARRAY( 2 ) * .. * .. External Functions .. * REMOVED BY CHRISTOPHE * REAL ETIME * EXTERNAL ETIME * .. * .. Executable Statements .. * * REMOVED BY CHRISTOPHE * T1 = ETIME( TARRAY ) T1 = 0 T = TARRAY( 1 ) RETURN * * End of SECOND * END getdp-2.7.0-source/contrib/Arpack/cmout.f000644 001750 001750 00000021063 11266605602 021746 0ustar00geuzainegeuzaine000000 000000 * * Routine: CMOUT * * Purpose: Complex matrix output routine. * * Usage: CALL CMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT) * * Arguments * M - Number of rows of A. (Input) * N - Number of columns of A. (Input) * A - Complex M by N matrix to be printed. (Input) * LDA - Leading dimension of A exactly as specified in the * dimension statement of the calling program. (Input) * IFMT - Format to be used in printing matrix A. (Input) * IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In) * If IDIGIT .LT. 0, printing is done with 72 columns. * If IDIGIT .GT. 0, printing is done with 132 columns. * *\SCCS Information: @(#) * FILE: cmout.f SID: 2.1 DATE OF SID: 11/16/95 RELEASE: 2 * *----------------------------------------------------------------------- * SUBROUTINE CMOUT( LOUT, M, N, A, LDA, IDIGIT, IFMT ) * ... * ... SPECIFICATIONS FOR ARGUMENTS INTEGER M, N, IDIGIT, LDA, LOUT Complex & A( LDA, * ) CHARACTER IFMT*( * ) * ... * ... SPECIFICATIONS FOR LOCAL VARIABLES INTEGER I, J, NDIGIT, K1, K2, LLL CHARACTER*1 ICOL( 3 ) CHARACTER*80 LINE * ... * ... SPECIFICATIONS INTRINSICS INTRINSIC MIN * DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o', $ 'l' / * ... * ... FIRST EXECUTABLE STATEMENT * LLL = MIN( LEN( IFMT ), 80 ) DO 10 I = 1, LLL LINE( I: I ) = '-' 10 CONTINUE * DO 20 I = LLL + 1, 80 LINE( I: I ) = ' ' 20 CONTINUE * WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL ) 9999 FORMAT( / 1X, A / 1X, A ) * IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 ) $ RETURN NDIGIT = IDIGIT IF( IDIGIT.EQ.0 ) $ NDIGIT = 4 * *======================================================================= * CODE FOR OUTPUT USING 72 COLUMNS FORMAT *======================================================================= * IF( IDIGIT.LT.0 ) THEN NDIGIT = -IDIGIT IF( NDIGIT.LE.4 ) THEN DO 40 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 ) DO 30 I = 1, M IF (K1.NE.N) THEN WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 ) ELSE WRITE( LOUT, 9984 )I, ( A( I, J ), J = K1, K2 ) END IF 30 CONTINUE 40 CONTINUE * ELSE IF( NDIGIT.LE.6 ) THEN DO 60 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 ) DO 50 I = 1, M IF (K1.NE.N) THEN WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 ) ELSE WRITE( LOUT, 9983 )I, ( A( I, J ), J = K1, K2 ) END IF 50 CONTINUE 60 CONTINUE * ELSE IF( NDIGIT.LE.8 ) THEN DO 80 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 ) DO 70 I = 1, M IF (K1.NE.N) THEN WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 ) ELSE WRITE( LOUT, 9982 )I, ( A( I, J ), J = K1, K2 ) END IF 70 CONTINUE 80 CONTINUE * ELSE DO 100 K1 = 1, N WRITE( LOUT, 9995 ) ICOL, K1 DO 90 I = 1, M WRITE( LOUT, 9991 )I, A( I, K1 ) 90 CONTINUE 100 CONTINUE END IF * *======================================================================= * CODE FOR OUTPUT USING 132 COLUMNS FORMAT *======================================================================= * ELSE IF( NDIGIT.LE.4 ) THEN DO 120 K1 = 1, N, 4 K2 = MIN0( N, K1+3 ) WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 ) DO 110 I = 1, M IF ((K1+3).LE.N) THEN WRITE( LOUT, 9974 )I, ( A( I, J ), J = K1, K2 ) ELSE IF ((K1+3-N).EQ.1) THEN WRITE( LOUT, 9964 )I, ( A( I, J ), J = k1, K2 ) ELSE IF ((K1+3-N).EQ.2) THEN WRITE( LOUT, 9954 )I, ( A( I, J ), J = K1, K2 ) ELSE IF ((K1+3-N).EQ.3) THEN WRITE( LOUT, 9944 )I, ( A( I, J ), J = K1, K2 ) END IF 110 CONTINUE 120 CONTINUE * ELSE IF( NDIGIT.LE.6 ) THEN DO 140 K1 = 1, N, 3 K2 = MIN0( N, K1+ 2) WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 ) DO 130 I = 1, M IF ((K1+2).LE.N) THEN WRITE( LOUT, 9973 )I, ( A( I, J ), J = K1, K2 ) ELSE IF ((K1+2-N).EQ.1) THEN WRITE( LOUT, 9963 )I, ( A( I, J ), J = K1, K2 ) ELSE IF ((K1+2-N).EQ.2) THEN WRITE( LOUT, 9953 )I, ( A( I, J ), J = K1, K2 ) END IF 130 CONTINUE 140 CONTINUE * ELSE IF( NDIGIT.LE.8 ) THEN DO 160 K1 = 1, N, 3 K2 = MIN0( N, K1+2 ) WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 ) DO 150 I = 1, M IF ((K1+2).LE.N) THEN WRITE( LOUT, 9972 )I, ( A( I, J ), J = K1, K2 ) ELSE IF ((K1+2-N).EQ.1) THEN WRITE( LOUT, 9962 )I, ( A( I, J ), J = K1, K2 ) ELSE IF ((K1+2-N).EQ.2) THEN WRITE( LOUT, 9952 )I, ( A( I, J ), J = K1, K2 ) END IF 150 CONTINUE 160 CONTINUE * ELSE DO 180 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 ) DO 170 I = 1, M IF ((K1+1).LE.N) THEN WRITE( LOUT, 9971 )I, ( A( I, J ), J = K1, K2 ) ELSE WRITE( LOUT, 9961 )I, ( A( I, J ), J = K1, K2 ) END IF 170 CONTINUE 180 CONTINUE END IF END IF WRITE( LOUT, 9990 ) * 9998 FORMAT( 11X, 4( 9X, 3A1, I4, 9X ) ) 9997 FORMAT( 10X, 4( 11X, 3A1, I4, 11X ) ) 9996 FORMAT( 10X, 3( 13X, 3A1, I4, 13X ) ) 9995 FORMAT( 12X, 2( 18x, 3A1, I4, 18X ) ) * *======================================================== * FORMAT FOR 72 COLUMN *======================================================== * * DISPLAY 4 SIGNIFICANT DIGITS * 9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E10.3,',',E10.3,') ') ) 9984 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E10.3,',',E10.3,') ') ) * * DISPLAY 6 SIGNIFICANT DIGITS * 9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E12.5,',',E12.5,') ') ) 9983 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E12.5,',',E12.5,') ') ) * * DISPLAY 8 SIGNIFICANT DIGITS * 9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E14.7,',',E14.7,') ') ) 9982 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E14.7,',',E14.7,') ') ) * * DISPLAY 13 SIGNIFICANT DIGITS * 9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E20.13,',',E20.13,')') ) 9990 FORMAT( 1X, ' ' ) * * *======================================================== * FORMAT FOR 132 COLUMN *======================================================== * * DISPLAY 4 SIGNIFICANT DIGIT * 9974 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,4('(',E10.3,',',E10.3,') ') ) 9964 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',E10.3,',',E10.3,') ') ) 9954 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E10.3,',',E10.3,') ') ) 9944 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E10.3,',',E10.3,') ') ) * * DISPLAY 6 SIGNIFICANT DIGIT * 9973 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',E12.5,',',E12.5,') ') ) 9963 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E12.5,',',E12.5,') ') ) 9953 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E12.5,',',E12.5,') ') ) * * DISPLAY 8 SIGNIFICANT DIGIT * 9972 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',E14.7,',',E14.7,') ') ) 9962 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E14.7,',',E14.7,') ') ) 9952 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E14.7,',',E14.7,') ') ) * * DISPLAY 13 SIGNIFICANT DIGIT * 9971 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E20.13,',',E20.13, & ') ')) 9961 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E20.13,',',E20.13, & ') ')) * * * * RETURN END getdp-2.7.0-source/contrib/Arpack/dnaup2.f000644 001750 001750 00000075365 11266605602 022026 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: dnaup2 c c\Description: c Intermediate level interface called by dnaupd. c c\Usage: c call dnaup2 c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD, c ISHIFT, MXITER, V, LDV, H, LDH, RITZR, RITZI, BOUNDS, c Q, LDQ, WORKL, IPNTR, WORKD, INFO ) c c\Arguments c c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in dnaupd. c MODE, ISHIFT, MXITER: see the definition of IPARAM in dnaupd. c c NP Integer. (INPUT/OUTPUT) c Contains the number of implicit shifts to apply during c each Arnoldi iteration. c If ISHIFT=1, NP is adjusted dynamically at each iteration c to accelerate convergence and prevent stagnation. c This is also roughly equal to the number of matrix-vector c products (involving the operator OP) per Arnoldi iteration. c The logic for adjusting is contained within the current c subroutine. c If ISHIFT=0, NP is the number of shifts the user needs c to provide via reverse comunication. 0 < NP < NCV-NEV. c NP may be less than NCV-NEV for two reasons. The first, is c to keep complex conjugate pairs of "wanted" Ritz values c together. The second, is that a leading block of the current c upper Hessenberg matrix has split off and contains "unwanted" c Ritz values. c Upon termination of the IRA iteration, NP contains the number c of "converged" wanted Ritz values. c c IUPD Integer. (INPUT) c IUPD .EQ. 0: use explicit restart instead implicit update. c IUPD .NE. 0: use implicit update. c c V Double precision N by (NEV+NP) array. (INPUT/OUTPUT) c The Arnoldi basis vectors are returned in the first NEV c columns of V. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Double precision (NEV+NP) by (NEV+NP) array. (OUTPUT) c H is used to store the generated upper Hessenberg matrix c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RITZR, Double precision arrays of length NEV+NP. (OUTPUT) c RITZI RITZR(1:NEV) (resp. RITZI(1:NEV)) contains the real (resp. c imaginary) part of the computed Ritz values of OP. c c BOUNDS Double precision array of length NEV+NP. (OUTPUT) c BOUNDS(1:NEV) contain the error bounds corresponding to c the computed Ritz values. c c Q Double precision (NEV+NP) by (NEV+NP) array. (WORKSPACE) c Private (replicated) work array used to accumulate the c rotation in the shift application step. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKL Double precision work array of length at least c (NEV+NP)**2 + 3*(NEV+NP). (INPUT/WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. It is used in shifts calculation, shifts c application and convergence checking. c c On exit, the last 3*(NEV+NP) locations of WORKL contain c the Ritz values (real,imaginary) and associated Ritz c estimates of the current Hessenberg matrix. They are c listed in the same order as returned from dneigh. c c If ISHIFT .EQ. O and IDO .EQ. 3, the first 2*NP locations c of WORKL are used in reverse communication to hold the user c supplied shifts. c c IPNTR Integer array of length 3. (OUTPUT) c Pointer to mark the starting locations in the WORKD for c vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. c IPNTR(3): pointer to the vector B * X when used in the c shift-and-invert mode. X is the current operand. c ------------------------------------------------------------- c c WORKD Double precision work array of length 3*N. (WORKSPACE) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration !!!!!!!!!! c See Data Distribution Note in DNAUPD. c c INFO Integer. (INPUT/OUTPUT) c If INFO .EQ. 0, a randomly initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c Error flag on output. c = 0: Normal return. c = 1: Maximum number of iterations taken. c All possible eigenvalues of OP has been found. c NP returns the number of converged Ritz values. c = 2: No shifts could be applied. c = -8: Error return from LAPACK eigenvalue calculation; c This should never happen. c = -9: Starting vector is zero. c = -9999: Could not build an Arnoldi factorization. c Size that was built in returned in NP. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: c dgetv0 ARPACK initial vector generation routine. c dnaitr ARPACK Arnoldi factorization routine. c dnapps ARPACK application of implicit shifts routine. c dnconv ARPACK convergence of Ritz values routine. c dneigh ARPACK compute Ritz values and error bounds routine. c dngets ARPACK reorder Ritz values and error bounds routine. c dsortc ARPACK sorting routine. c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c dmout ARPACK utility routine that prints matrices c dvout ARPACK utility routine that prints vectors. c dlamch LAPACK routine that determines machine constants. c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c dcopy Level 1 BLAS that copies one vector to another . c ddot Level 1 BLAS that computes the scalar product of two vectors. c dnrm2 Level 1 BLAS that computes the norm of a vector. c dswap Level 1 BLAS that swaps two vectors. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: naup2.F SID: 2.8 DATE OF SID: 10/17/00 RELEASE: 2 c c\Remarks c 1. None c c\EndLib c c----------------------------------------------------------------------- c subroutine dnaup2 & ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd, & ishift, mxiter, v, ldv, h, ldh, ritzr, ritzi, bounds, & q, ldq, workl, ipntr, workd, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1, which*2 integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter, & n, nev, np Double precision & tol c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(13) Double precision & bounds(nev+np), h(ldh,nev+np), q(ldq,nev+np), resid(n), & ritzi(nev+np), ritzr(nev+np), v(ldv,nev+np), & workd(3*n), workl( (nev+np)*(nev+np+3) ) c c %------------% c | Parameters | c %------------% c Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) c c %---------------% c | Local Scalars | c %---------------% c character wprime*2 logical cnorm , getv0, initv, update, ushift integer ierr , iter , j , kplusp, msglvl, nconv, & nevbef, nev0 , np0 , nptemp, numcnv Double precision & rnorm , temp , eps23 save cnorm , getv0, initv, update, ushift, & rnorm , iter , eps23, kplusp, msglvl, nconv , & nevbef, nev0 , np0 , numcnv c c %-----------------------% c | Local array arguments | c %-----------------------% c integer kp(4) c c %----------------------% c | External Subroutines | c %----------------------% c external dcopy , dgetv0, dnaitr, dnconv, dneigh, & dngets, dnapps, dvout , ivout , second c c %--------------------% c | External Functions | c %--------------------% c Double precision & ddot, dnrm2, dlapy2, dlamch external ddot, dnrm2, dlapy2, dlamch c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic min, max, abs, sqrt c c %-----------------------% c | Executable Statements | c %-----------------------% c if (ido .eq. 0) then c call second (t0) c msglvl = mnaup2 c c %-------------------------------------% c | Get the machine dependent constant. | c %-------------------------------------% c eps23 = dlamch('Epsilon-Machine') eps23 = eps23**(2.0D+0 / 3.0D+0) c nev0 = nev np0 = np c c %-------------------------------------% c | kplusp is the bound on the largest | c | Lanczos factorization built. | c | nconv is the current number of | c | "converged" eigenvlues. | c | iter is the counter on the current | c | iteration step. | c %-------------------------------------% c kplusp = nev + np nconv = 0 iter = 0 c c %---------------------------------------% c | Set flags for computing the first NEV | c | steps of the Arnoldi factorization. | c %---------------------------------------% c getv0 = .true. update = .false. ushift = .false. cnorm = .false. c if (info .ne. 0) then c c %--------------------------------------------% c | User provides the initial residual vector. | c %--------------------------------------------% c initv = .true. info = 0 else initv = .false. end if end if c c %---------------------------------------------% c | Get a possibly random starting vector and | c | force it into the range of the operator OP. | c %---------------------------------------------% c 10 continue c if (getv0) then call dgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, rnorm, & ipntr, workd, info) c if (ido .ne. 99) go to 9000 c if (rnorm .eq. zero) then c c %-----------------------------------------% c | The initial vector is zero. Error exit. | c %-----------------------------------------% c info = -9 go to 1100 end if getv0 = .false. ido = 0 end if c c %-----------------------------------% c | Back from reverse communication : | c | continue with update step | c %-----------------------------------% c if (update) go to 20 c c %-------------------------------------------% c | Back from computing user specified shifts | c %-------------------------------------------% c if (ushift) go to 50 c c %-------------------------------------% c | Back from computing residual norm | c | at the end of the current iteration | c %-------------------------------------% c if (cnorm) go to 100 c c %----------------------------------------------------------% c | Compute the first NEV steps of the Arnoldi factorization | c %----------------------------------------------------------% c call dnaitr (ido, bmat, n, 0, nev, mode, resid, rnorm, v, ldv, & h, ldh, ipntr, workd, info) c c %---------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP and possibly B | c %---------------------------------------------------% c if (ido .ne. 99) go to 9000 c if (info .gt. 0) then np = info mxiter = iter info = -9999 go to 1200 end if c c %--------------------------------------------------------------% c | | c | M A I N ARNOLDI I T E R A T I O N L O O P | c | Each iteration implicitly restarts the Arnoldi | c | factorization in place. | c | | c %--------------------------------------------------------------% c 1000 continue c iter = iter + 1 c if (msglvl .gt. 0) then call ivout (logfil, 1, iter, ndigit, & '_naup2: **** Start of major iteration number ****') end if c c %-----------------------------------------------------------% c | Compute NP additional steps of the Arnoldi factorization. | c | Adjust NP since NEV might have been updated by last call | c | to the shift application routine dnapps. | c %-----------------------------------------------------------% c np = kplusp - nev c if (msglvl .gt. 1) then call ivout (logfil, 1, nev, ndigit, & '_naup2: The length of the current Arnoldi factorization') call ivout (logfil, 1, np, ndigit, & '_naup2: Extend the Arnoldi factorization by') end if c c %-----------------------------------------------------------% c | Compute NP additional steps of the Arnoldi factorization. | c %-----------------------------------------------------------% c ido = 0 20 continue update = .true. c call dnaitr (ido , bmat, n , nev, np , mode , resid, & rnorm, v , ldv, h , ldh, ipntr, workd, & info) c c %---------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP and possibly B | c %---------------------------------------------------% c if (ido .ne. 99) go to 9000 c if (info .gt. 0) then np = info mxiter = iter info = -9999 go to 1200 end if update = .false. c if (msglvl .gt. 1) then call dvout (logfil, 1, rnorm, ndigit, & '_naup2: Corresponding B-norm of the residual') end if c c %--------------------------------------------------------% c | Compute the eigenvalues and corresponding error bounds | c | of the current upper Hessenberg matrix. | c %--------------------------------------------------------% c call dneigh (rnorm, kplusp, h, ldh, ritzr, ritzi, bounds, & q, ldq, workl, ierr) c if (ierr .ne. 0) then info = -8 go to 1200 end if c c %----------------------------------------------------% c | Make a copy of eigenvalues and corresponding error | c | bounds obtained from dneigh. | c %----------------------------------------------------% c call dcopy(kplusp, ritzr, 1, workl(kplusp**2+1), 1) call dcopy(kplusp, ritzi, 1, workl(kplusp**2+kplusp+1), 1) call dcopy(kplusp, bounds, 1, workl(kplusp**2+2*kplusp+1), 1) c c %---------------------------------------------------% c | Select the wanted Ritz values and their bounds | c | to be used in the convergence test. | c | The wanted part of the spectrum and corresponding | c | error bounds are in the last NEV loc. of RITZR, | c | RITZI and BOUNDS respectively. The variables NEV | c | and NP may be updated if the NEV-th wanted Ritz | c | value has a non zero imaginary part. In this case | c | NEV is increased by one and NP decreased by one. | c | NOTE: The last two arguments of dngets are no | c | longer used as of version 2.1. | c %---------------------------------------------------% c nev = nev0 np = np0 numcnv = nev call dngets (ishift, which, nev, np, ritzr, ritzi, & bounds, workl, workl(np+1)) if (nev .eq. nev0+1) numcnv = nev0+1 c c %-------------------% c | Convergence test. | c %-------------------% c call dcopy (nev, bounds(np+1), 1, workl(2*np+1), 1) call dnconv (nev, ritzr(np+1), ritzi(np+1), workl(2*np+1), & tol, nconv) c if (msglvl .gt. 2) then kp(1) = nev kp(2) = np kp(3) = numcnv kp(4) = nconv call ivout (logfil, 4, kp, ndigit, & '_naup2: NEV, NP, NUMCNV, NCONV are') call dvout (logfil, kplusp, ritzr, ndigit, & '_naup2: Real part of the eigenvalues of H') call dvout (logfil, kplusp, ritzi, ndigit, & '_naup2: Imaginary part of the eigenvalues of H') call dvout (logfil, kplusp, bounds, ndigit, & '_naup2: Ritz estimates of the current NCV Ritz values') end if c c %---------------------------------------------------------% c | Count the number of unwanted Ritz values that have zero | c | Ritz estimates. If any Ritz estimates are equal to zero | c | then a leading block of H of order equal to at least | c | the number of Ritz values with zero Ritz estimates has | c | split off. None of these Ritz values may be removed by | c | shifting. Decrease NP the number of shifts to apply. If | c | no shifts may be applied, then prepare to exit | c %---------------------------------------------------------% c nptemp = np do 30 j=1, nptemp if (bounds(j) .eq. zero) then np = np - 1 nev = nev + 1 end if 30 continue c if ( (nconv .ge. numcnv) .or. & (iter .gt. mxiter) .or. & (np .eq. 0) ) then c if (msglvl .gt. 4) then call dvout(logfil, kplusp, workl(kplusp**2+1), ndigit, & '_naup2: Real part of the eig computed by _neigh:') call dvout(logfil, kplusp, workl(kplusp**2+kplusp+1), & ndigit, & '_naup2: Imag part of the eig computed by _neigh:') call dvout(logfil, kplusp, workl(kplusp**2+kplusp*2+1), & ndigit, & '_naup2: Ritz eistmates computed by _neigh:') end if c c %------------------------------------------------% c | Prepare to exit. Put the converged Ritz values | c | and corresponding bounds in RITZ(1:NCONV) and | c | BOUNDS(1:NCONV) respectively. Then sort. Be | c | careful when NCONV > NP | c %------------------------------------------------% c c %------------------------------------------% c | Use h( 3,1 ) as storage to communicate | c | rnorm to _neupd if needed | c %------------------------------------------% h(3,1) = rnorm c c %----------------------------------------------% c | To be consistent with dngets, we first do a | c | pre-processing sort in order to keep complex | c | conjugate pairs together. This is similar | c | to the pre-processing sort used in dngets | c | except that the sort is done in the opposite | c | order. | c %----------------------------------------------% c if (which .eq. 'LM') wprime = 'SR' if (which .eq. 'SM') wprime = 'LR' if (which .eq. 'LR') wprime = 'SM' if (which .eq. 'SR') wprime = 'LM' if (which .eq. 'LI') wprime = 'SM' if (which .eq. 'SI') wprime = 'LM' c call dsortc (wprime, .true., kplusp, ritzr, ritzi, bounds) c c %----------------------------------------------% c | Now sort Ritz values so that converged Ritz | c | values appear within the first NEV locations | c | of ritzr, ritzi and bounds, and the most | c | desired one appears at the front. | c %----------------------------------------------% c if (which .eq. 'LM') wprime = 'SM' if (which .eq. 'SM') wprime = 'LM' if (which .eq. 'LR') wprime = 'SR' if (which .eq. 'SR') wprime = 'LR' if (which .eq. 'LI') wprime = 'SI' if (which .eq. 'SI') wprime = 'LI' c call dsortc(wprime, .true., kplusp, ritzr, ritzi, bounds) c c %--------------------------------------------------% c | Scale the Ritz estimate of each Ritz value | c | by 1 / max(eps23,magnitude of the Ritz value). | c %--------------------------------------------------% c do 35 j = 1, numcnv temp = max(eps23,dlapy2(ritzr(j), & ritzi(j))) bounds(j) = bounds(j)/temp 35 continue c c %----------------------------------------------------% c | Sort the Ritz values according to the scaled Ritz | c | esitmates. This will push all the converged ones | c | towards the front of ritzr, ritzi, bounds | c | (in the case when NCONV < NEV.) | c %----------------------------------------------------% c wprime = 'LR' call dsortc(wprime, .true., numcnv, bounds, ritzr, ritzi) c c %----------------------------------------------% c | Scale the Ritz estimate back to its original | c | value. | c %----------------------------------------------% c do 40 j = 1, numcnv temp = max(eps23, dlapy2(ritzr(j), & ritzi(j))) bounds(j) = bounds(j)*temp 40 continue c c %------------------------------------------------% c | Sort the converged Ritz values again so that | c | the "threshold" value appears at the front of | c | ritzr, ritzi and bound. | c %------------------------------------------------% c call dsortc(which, .true., nconv, ritzr, ritzi, bounds) c if (msglvl .gt. 1) then call dvout (logfil, kplusp, ritzr, ndigit, & '_naup2: Sorted real part of the eigenvalues') call dvout (logfil, kplusp, ritzi, ndigit, & '_naup2: Sorted imaginary part of the eigenvalues') call dvout (logfil, kplusp, bounds, ndigit, & '_naup2: Sorted ritz estimates.') end if c c %------------------------------------% c | Max iterations have been exceeded. | c %------------------------------------% c if (iter .gt. mxiter .and. nconv .lt. numcnv) info = 1 c c %---------------------% c | No shifts to apply. | c %---------------------% c if (np .eq. 0 .and. nconv .lt. numcnv) info = 2 c np = nconv go to 1100 c else if ( (nconv .lt. numcnv) .and. (ishift .eq. 1) ) then c c %-------------------------------------------------% c | Do not have all the requested eigenvalues yet. | c | To prevent possible stagnation, adjust the size | c | of NEV. | c %-------------------------------------------------% c nevbef = nev nev = nev + min(nconv, np/2) if (nev .eq. 1 .and. kplusp .ge. 6) then nev = kplusp / 2 else if (nev .eq. 1 .and. kplusp .gt. 3) then nev = 2 end if np = kplusp - nev c c %---------------------------------------% c | If the size of NEV was just increased | c | resort the eigenvalues. | c %---------------------------------------% c if (nevbef .lt. nev) & call dngets (ishift, which, nev, np, ritzr, ritzi, & bounds, workl, workl(np+1)) c end if c if (msglvl .gt. 0) then call ivout (logfil, 1, nconv, ndigit, & '_naup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev kp(2) = np call ivout (logfil, 2, kp, ndigit, & '_naup2: NEV and NP are') call dvout (logfil, nev, ritzr(np+1), ndigit, & '_naup2: "wanted" Ritz values -- real part') call dvout (logfil, nev, ritzi(np+1), ndigit, & '_naup2: "wanted" Ritz values -- imag part') call dvout (logfil, nev, bounds(np+1), ndigit, & '_naup2: Ritz estimates of the "wanted" values ') end if end if c if (ishift .eq. 0) then c c %-------------------------------------------------------% c | User specified shifts: reverse comminucation to | c | compute the shifts. They are returned in the first | c | 2*NP locations of WORKL. | c %-------------------------------------------------------% c ushift = .true. ido = 3 go to 9000 end if c 50 continue c c %------------------------------------% c | Back from reverse communication; | c | User specified shifts are returned | c | in WORKL(1:2*NP) | c %------------------------------------% c ushift = .false. c if ( ishift .eq. 0 ) then c c %----------------------------------% c | Move the NP shifts from WORKL to | c | RITZR, RITZI to free up WORKL | c | for non-exact shift case. | c %----------------------------------% c call dcopy (np, workl, 1, ritzr, 1) call dcopy (np, workl(np+1), 1, ritzi, 1) end if c if (msglvl .gt. 2) then call ivout (logfil, 1, np, ndigit, & '_naup2: The number of shifts to apply ') call dvout (logfil, np, ritzr, ndigit, & '_naup2: Real part of the shifts') call dvout (logfil, np, ritzi, ndigit, & '_naup2: Imaginary part of the shifts') if ( ishift .eq. 1 ) & call dvout (logfil, np, bounds, ndigit, & '_naup2: Ritz estimates of the shifts') end if c c %---------------------------------------------------------% c | Apply the NP implicit shifts by QR bulge chasing. | c | Each shift is applied to the whole upper Hessenberg | c | matrix H. | c | The first 2*N locations of WORKD are used as workspace. | c %---------------------------------------------------------% c call dnapps (n, nev, np, ritzr, ritzi, v, ldv, & h, ldh, resid, q, ldq, workl, workd) c c %---------------------------------------------% c | Compute the B-norm of the updated residual. | c | Keep B*RESID in WORKD(1:N) to be used in | c | the first step of the next call to dnaitr. | c %---------------------------------------------% c cnorm = .true. call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(n+1), 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 c c %----------------------------------% c | Exit in order to compute B*RESID | c %----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd, 1) end if c 100 continue c c %----------------------------------% c | Back from reverse communication; | c | WORKD(1:N) := B*RESID | c %----------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c if (bmat .eq. 'G') then rnorm = ddot (n, resid, 1, workd, 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then rnorm = dnrm2(n, resid, 1) end if cnorm = .false. c if (msglvl .gt. 2) then call dvout (logfil, 1, rnorm, ndigit, & '_naup2: B-norm of residual for compressed factorization') call dmout (logfil, nev, nev, h, ldh, ndigit, & '_naup2: Compressed upper Hessenberg matrix H') end if c go to 1000 c c %---------------------------------------------------------------% c | | c | E N D O F M A I N I T E R A T I O N L O O P | c | | c %---------------------------------------------------------------% c 1100 continue c mxiter = iter nev = numcnv c 1200 continue ido = 99 c c %------------% c | Error Exit | c %------------% c call second (t1) tnaup2 = t1 - t0 c 9000 continue c c %---------------% c | End of dnaup2 | c %---------------% c return end getdp-2.7.0-source/contrib/Arpack/zmout.f000644 001750 001750 00000021074 11266605602 021777 0ustar00geuzainegeuzaine000000 000000 * * Routine: ZMOUT * * Purpose: Complex*16 matrix output routine. * * Usage: CALL ZMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT) * * Arguments * M - Number of rows of A. (Input) * N - Number of columns of A. (Input) * A - Complex*16 M by N matrix to be printed. (Input) * LDA - Leading dimension of A exactly as specified in the * dimension statement of the calling program. (Input) * IFMT - Format to be used in printing matrix A. (Input) * IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In) * If IDIGIT .LT. 0, printing is done with 72 columns. * If IDIGIT .GT. 0, printing is done with 132 columns. * *\SCCS Information: @(#) * FILE: zmout.f SID: 2.1 DATE OF SID: 11/16/95 RELEASE: 2 * *----------------------------------------------------------------------- * SUBROUTINE ZMOUT( LOUT, M, N, A, LDA, IDIGIT, IFMT ) * ... * ... SPECIFICATIONS FOR ARGUMENTS INTEGER M, N, IDIGIT, LDA, LOUT Complex*16 & A( LDA, * ) CHARACTER IFMT*( * ) * ... * ... SPECIFICATIONS FOR LOCAL VARIABLES INTEGER I, J, NDIGIT, K1, K2, LLL CHARACTER*1 ICOL( 3 ) CHARACTER*80 LINE * ... * ... SPECIFICATIONS INTRINSICS INTRINSIC MIN * DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o', $ 'l' / * ... * ... FIRST EXECUTABLE STATEMENT * LLL = MIN( LEN( IFMT ), 80 ) DO 10 I = 1, LLL LINE( I: I ) = '-' 10 CONTINUE * DO 20 I = LLL + 1, 80 LINE( I: I ) = ' ' 20 CONTINUE * WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL ) 9999 FORMAT( / 1X, A / 1X, A ) * IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 ) $ RETURN NDIGIT = IDIGIT IF( IDIGIT.EQ.0 ) $ NDIGIT = 4 * *======================================================================= * CODE FOR OUTPUT USING 72 COLUMNS FORMAT *======================================================================= * IF( IDIGIT.LT.0 ) THEN NDIGIT = -IDIGIT IF( NDIGIT.LE.4 ) THEN DO 40 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 ) DO 30 I = 1, M IF (K1.NE.N) THEN WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 ) ELSE WRITE( LOUT, 9984 )I, ( A( I, J ), J = K1, K2 ) END IF 30 CONTINUE 40 CONTINUE * ELSE IF( NDIGIT.LE.6 ) THEN DO 60 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 ) DO 50 I = 1, M IF (K1.NE.N) THEN WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 ) ELSE WRITE( LOUT, 9983 )I, ( A( I, J ), J = K1, K2 ) END IF 50 CONTINUE 60 CONTINUE * ELSE IF( NDIGIT.LE.8 ) THEN DO 80 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 ) DO 70 I = 1, M IF (K1.NE.N) THEN WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 ) ELSE WRITE( LOUT, 9982 )I, ( A( I, J ), J = K1, K2 ) END IF 70 CONTINUE 80 CONTINUE * ELSE DO 100 K1 = 1, N WRITE( LOUT, 9995 ) ICOL, K1 DO 90 I = 1, M WRITE( LOUT, 9991 )I, A( I, K1 ) 90 CONTINUE 100 CONTINUE END IF * *======================================================================= * CODE FOR OUTPUT USING 132 COLUMNS FORMAT *======================================================================= * ELSE IF( NDIGIT.LE.4 ) THEN DO 120 K1 = 1, N, 4 K2 = MIN0( N, K1+3 ) WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 ) DO 110 I = 1, M IF ((K1+3).LE.N) THEN WRITE( LOUT, 9974 )I, ( A( I, J ), J = K1, K2 ) ELSE IF ((K1+3-N).EQ.1) THEN WRITE( LOUT, 9964 )I, ( A( I, J ), J = k1, K2 ) ELSE IF ((K1+3-N).EQ.2) THEN WRITE( LOUT, 9954 )I, ( A( I, J ), J = K1, K2 ) ELSE IF ((K1+3-N).EQ.3) THEN WRITE( LOUT, 9944 )I, ( A( I, J ), J = K1, K2 ) END IF 110 CONTINUE 120 CONTINUE * ELSE IF( NDIGIT.LE.6 ) THEN DO 140 K1 = 1, N, 3 K2 = MIN0( N, K1+ 2) WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 ) DO 130 I = 1, M IF ((K1+2).LE.N) THEN WRITE( LOUT, 9973 )I, ( A( I, J ), J = K1, K2 ) ELSE IF ((K1+2-N).EQ.1) THEN WRITE( LOUT, 9963 )I, ( A( I, J ), J = K1, K2 ) ELSE IF ((K1+2-N).EQ.2) THEN WRITE( LOUT, 9953 )I, ( A( I, J ), J = K1, K2 ) END IF 130 CONTINUE 140 CONTINUE * ELSE IF( NDIGIT.LE.8 ) THEN DO 160 K1 = 1, N, 3 K2 = MIN0( N, K1+2 ) WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 ) DO 150 I = 1, M IF ((K1+2).LE.N) THEN WRITE( LOUT, 9972 )I, ( A( I, J ), J = K1, K2 ) ELSE IF ((K1+2-N).EQ.1) THEN WRITE( LOUT, 9962 )I, ( A( I, J ), J = K1, K2 ) ELSE IF ((K1+2-N).EQ.2) THEN WRITE( LOUT, 9952 )I, ( A( I, J ), J = K1, K2 ) END IF 150 CONTINUE 160 CONTINUE * ELSE DO 180 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 ) DO 170 I = 1, M IF ((K1+1).LE.N) THEN WRITE( LOUT, 9971 )I, ( A( I, J ), J = K1, K2 ) ELSE WRITE( LOUT, 9961 )I, ( A( I, J ), J = K1, K2 ) END IF 170 CONTINUE 180 CONTINUE END IF END IF WRITE( LOUT, 9990 ) * 9998 FORMAT( 11X, 4( 9X, 3A1, I4, 9X ) ) 9997 FORMAT( 10X, 4( 11X, 3A1, I4, 11X ) ) 9996 FORMAT( 10X, 3( 13X, 3A1, I4, 13X ) ) 9995 FORMAT( 12X, 2( 18x, 3A1, I4, 18X ) ) * *======================================================== * FORMAT FOR 72 COLUMN *======================================================== * * DISPLAY 4 SIGNIFICANT DIGITS * 9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D10.3,',',D10.3,') ') ) 9984 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D10.3,',',D10.3,') ') ) * * DISPLAY 6 SIGNIFICANT DIGITS * 9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D12.5,',',D12.5,') ') ) 9983 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D12.5,',',D12.5,') ') ) * * DISPLAY 8 SIGNIFICANT DIGITS * 9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D14.7,',',D14.7,') ') ) 9982 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D14.7,',',D14.7,') ') ) * * DISPLAY 13 SIGNIFICANT DIGITS * 9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D20.13,',',D20.13,')') ) 9990 FORMAT( 1X, ' ' ) * * *======================================================== * FORMAT FOR 132 COLUMN *======================================================== * * DISPLAY 4 SIGNIFICANT DIGIT * 9974 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,4('(',D10.3,',',D10.3,') ') ) 9964 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',D10.3,',',D10.3,') ') ) 9954 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D10.3,',',D10.3,') ') ) 9944 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D10.3,',',D10.3,') ') ) * * DISPLAY 6 SIGNIFICANT DIGIT * 9973 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',D12.5,',',D12.5,') ') ) 9963 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D12.5,',',D12.5,') ') ) 9953 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D12.5,',',D12.5,') ') ) * * DISPLAY 8 SIGNIFICANT DIGIT * 9972 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',D14.7,',',D14.7,') ') ) 9962 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D14.7,',',D14.7,') ') ) 9952 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D14.7,',',D14.7,') ') ) * * DISPLAY 13 SIGNIFICANT DIGIT * 9971 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D20.13,',',D20.13, & ') ')) 9961 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D20.13,',',D20.13, & ') ')) * * * * RETURN END getdp-2.7.0-source/contrib/Arpack/iset.f000644 001750 001750 00000000505 11266605602 021561 0ustar00geuzainegeuzaine000000 000000 c c----------------------------------------------------------------------- c c Only work with increment equal to 1 right now. c subroutine iset (n, value, array, inc) c integer n, value, inc integer array(*) c do 10 i = 1, n array(i) = value 10 continue c return end getdp-2.7.0-source/contrib/Arpack/ssgets.f000644 001750 001750 00000016341 11266605602 022132 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: ssgets c c\Description: c Given the eigenvalues of the symmetric tridiagonal matrix H, c computes the NP shifts AMU that are zeros of the polynomial of c degree NP which filters out components of the unwanted eigenvectors c corresponding to the AMU's based on some given criteria. c c NOTE: This is called even in the case of user specified shifts in c order to sort the eigenvalues, and error bounds of H for later use. c c\Usage: c call ssgets c ( ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS, SHIFTS ) c c\Arguments c ISHIFT Integer. (INPUT) c Method for selecting the implicit shifts at each iteration. c ISHIFT = 0: user specified shifts c ISHIFT = 1: exact shift with respect to the matrix H. c c WHICH Character*2. (INPUT) c Shift selection criteria. c 'LM' -> KEV eigenvalues of largest magnitude are retained. c 'SM' -> KEV eigenvalues of smallest magnitude are retained. c 'LA' -> KEV eigenvalues of largest value are retained. c 'SA' -> KEV eigenvalues of smallest value are retained. c 'BE' -> KEV eigenvalues, half from each end of the spectrum. c If KEV is odd, compute one more from the high end. c c KEV Integer. (INPUT) c KEV+NP is the size of the matrix H. c c NP Integer. (INPUT) c Number of implicit shifts to be computed. c c RITZ Real array of length KEV+NP. (INPUT/OUTPUT) c On INPUT, RITZ contains the eigenvalues of H. c On OUTPUT, RITZ are sorted so that the unwanted eigenvalues c are in the first NP locations and the wanted part is in c the last KEV locations. When exact shifts are selected, the c unwanted part corresponds to the shifts to be applied. c c BOUNDS Real array of length KEV+NP. (INPUT/OUTPUT) c Error bounds corresponding to the ordering in RITZ. c c SHIFTS Real array of length NP. (INPUT/OUTPUT) c On INPUT: contains the user specified shifts if ISHIFT = 0. c On OUTPUT: contains the shifts sorted into decreasing order c of magnitude with respect to the Ritz estimates contained in c BOUNDS. If ISHIFT = 0, SHIFTS is not modified on exit. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c ssortr ARPACK utility sorting routine. c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c svout ARPACK utility routine that prints vectors. c scopy Level 1 BLAS that copies one vector to another. c sswap Level 1 BLAS that swaps the contents of two vectors. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/93: Version ' 2.1' c c\SCCS Information: @(#) c FILE: sgets.F SID: 2.4 DATE OF SID: 4/19/96 RELEASE: 2 c c\Remarks c c\EndLib c c----------------------------------------------------------------------- c subroutine ssgets ( ishift, which, kev, np, ritz, bounds, shifts ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which integer ishift, kev, np c c %-----------------% c | Array Arguments | c %-----------------% c Real & bounds(kev+np), ritz(kev+np), shifts(np) c c %------------% c | Parameters | c %------------% c Real & one, zero parameter (one = 1.0E+0, zero = 0.0E+0) c c %---------------% c | Local Scalars | c %---------------% c integer kevd2, msglvl c c %----------------------% c | External Subroutines | c %----------------------% c external sswap, scopy, ssortr, second c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic max, min c c %-----------------------% c | Executable Statements | c %-----------------------% c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = msgets c if (which .eq. 'BE') then c c %-----------------------------------------------------% c | Both ends of the spectrum are requested. | c | Sort the eigenvalues into algebraically increasing | c | order first then swap high end of the spectrum next | c | to low end in appropriate locations. | c | NOTE: when np < floor(kev/2) be careful not to swap | c | overlapping locations. | c %-----------------------------------------------------% c call ssortr ('LA', .true., kev+np, ritz, bounds) kevd2 = kev / 2 if ( kev .gt. 1 ) then call sswap ( min(kevd2,np), ritz, 1, & ritz( max(kevd2,np)+1 ), 1) call sswap ( min(kevd2,np), bounds, 1, & bounds( max(kevd2,np)+1 ), 1) end if c else c c %----------------------------------------------------% c | LM, SM, LA, SA case. | c | Sort the eigenvalues of H into the desired order | c | and apply the resulting order to BOUNDS. | c | The eigenvalues are sorted so that the wanted part | c | are always in the last KEV locations. | c %----------------------------------------------------% c call ssortr (which, .true., kev+np, ritz, bounds) end if c if (ishift .eq. 1 .and. np .gt. 0) then c c %-------------------------------------------------------% c | Sort the unwanted Ritz values used as shifts so that | c | the ones with largest Ritz estimates are first. | c | This will tend to minimize the effects of the | c | forward instability of the iteration when the shifts | c | are applied in subroutine ssapps. | c %-------------------------------------------------------% c call ssortr ('SM', .true., np, bounds, ritz) call scopy (np, ritz, 1, shifts, 1) end if c call second (t1) tsgets = tsgets + (t1 - t0) c if (msglvl .gt. 0) then call ivout (logfil, 1, kev, ndigit, '_sgets: KEV is') call ivout (logfil, 1, np, ndigit, '_sgets: NP is') call svout (logfil, kev+np, ritz, ndigit, & '_sgets: Eigenvalues of current H matrix') call svout (logfil, kev+np, bounds, ndigit, & '_sgets: Associated Ritz estimates') end if c return c c %---------------% c | End of ssgets | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/cstatn.f000644 001750 001750 00000002305 11266605602 022111 0ustar00geuzainegeuzaine000000 000000 c c\SCCS Information: @(#) c FILE: statn.F SID: 2.2 DATE OF SID: 4/20/96 RELEASE: 2 c c %---------------------------------------------% c | Initialize statistic and timing information | c | for complex nonsymmetric Arnoldi code. | c %---------------------------------------------% subroutine cstatn c c %--------------------------------% c | See stat.doc for documentation | c %--------------------------------% c include 'stat.h' c %-----------------------% c | Executable Statements | c %-----------------------% nopx = 0 nbx = 0 nrorth = 0 nitref = 0 nrstrt = 0 tcaupd = 0.0E+0 tcaup2 = 0.0E+0 tcaitr = 0.0E+0 tceigh = 0.0E+0 tcgets = 0.0E+0 tcapps = 0.0E+0 tcconv = 0.0E+0 titref = 0.0E+0 tgetv0 = 0.0E+0 trvec = 0.0E+0 c %----------------------------------------------------% c | User time including reverse communication overhead | c %----------------------------------------------------% tmvopx = 0.0E+0 tmvbx = 0.0E+0 return c c %---------------% c | End of cstatn | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dsortc.f000644 001750 001750 00000022046 11266605602 022117 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: dsortc c c\Description: c Sorts the complex array in XREAL and XIMAG into the order c specified by WHICH and optionally applies the permutation to the c real array Y. It is assumed that if an element of XIMAG is c nonzero, then its negative is also an element. In other words, c both members of a complex conjugate pair are to be sorted and the c pairs are kept adjacent to each other. c c\Usage: c call dsortc c ( WHICH, APPLY, N, XREAL, XIMAG, Y ) c c\Arguments c WHICH Character*2. (Input) c 'LM' -> sort XREAL,XIMAG into increasing order of magnitude. c 'SM' -> sort XREAL,XIMAG into decreasing order of magnitude. c 'LR' -> sort XREAL into increasing order of algebraic. c 'SR' -> sort XREAL into decreasing order of algebraic. c 'LI' -> sort XIMAG into increasing order of magnitude. c 'SI' -> sort XIMAG into decreasing order of magnitude. c NOTE: If an element of XIMAG is non-zero, then its negative c is also an element. c c APPLY Logical. (Input) c APPLY = .TRUE. -> apply the sorted order to array Y. c APPLY = .FALSE. -> do not apply the sorted order to array Y. c c N Integer. (INPUT) c Size of the arrays. c c XREAL, Double precision array of length N. (INPUT/OUTPUT) c XIMAG Real and imaginary part of the array to be sorted. c c Y Double precision array of length N. (INPUT/OUTPUT) c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.1' c Adapted from the sort routine in LANSO. c c\SCCS Information: @(#) c FILE: sortc.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine dsortc (which, apply, n, xreal, ximag, y) c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which logical apply integer n c c %-----------------% c | Array Arguments | c %-----------------% c Double precision & xreal(0:n-1), ximag(0:n-1), y(0:n-1) c c %---------------% c | Local Scalars | c %---------------% c integer i, igap, j Double precision & temp, temp1, temp2 c c %--------------------% c | External Functions | c %--------------------% c Double precision & dlapy2 external dlapy2 c c %-----------------------% c | Executable Statements | c %-----------------------% c igap = n / 2 c if (which .eq. 'LM') then c c %------------------------------------------------------% c | Sort XREAL,XIMAG into increasing order of magnitude. | c %------------------------------------------------------% c 10 continue if (igap .eq. 0) go to 9000 c do 30 i = igap, n-1 j = i-igap 20 continue c if (j.lt.0) go to 30 c temp1 = dlapy2(xreal(j),ximag(j)) temp2 = dlapy2(xreal(j+igap),ximag(j+igap)) c if (temp1.gt.temp2) then temp = xreal(j) xreal(j) = xreal(j+igap) xreal(j+igap) = temp c temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 30 end if j = j-igap go to 20 30 continue igap = igap / 2 go to 10 c else if (which .eq. 'SM') then c c %------------------------------------------------------% c | Sort XREAL,XIMAG into decreasing order of magnitude. | c %------------------------------------------------------% c 40 continue if (igap .eq. 0) go to 9000 c do 60 i = igap, n-1 j = i-igap 50 continue c if (j .lt. 0) go to 60 c temp1 = dlapy2(xreal(j),ximag(j)) temp2 = dlapy2(xreal(j+igap),ximag(j+igap)) c if (temp1.lt.temp2) then temp = xreal(j) xreal(j) = xreal(j+igap) xreal(j+igap) = temp c temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 60 endif j = j-igap go to 50 60 continue igap = igap / 2 go to 40 c else if (which .eq. 'LR') then c c %------------------------------------------------% c | Sort XREAL into increasing order of algebraic. | c %------------------------------------------------% c 70 continue if (igap .eq. 0) go to 9000 c do 90 i = igap, n-1 j = i-igap 80 continue c if (j.lt.0) go to 90 c if (xreal(j).gt.xreal(j+igap)) then temp = xreal(j) xreal(j) = xreal(j+igap) xreal(j+igap) = temp c temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 90 endif j = j-igap go to 80 90 continue igap = igap / 2 go to 70 c else if (which .eq. 'SR') then c c %------------------------------------------------% c | Sort XREAL into decreasing order of algebraic. | c %------------------------------------------------% c 100 continue if (igap .eq. 0) go to 9000 do 120 i = igap, n-1 j = i-igap 110 continue c if (j.lt.0) go to 120 c if (xreal(j).lt.xreal(j+igap)) then temp = xreal(j) xreal(j) = xreal(j+igap) xreal(j+igap) = temp c temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 120 endif j = j-igap go to 110 120 continue igap = igap / 2 go to 100 c else if (which .eq. 'LI') then c c %------------------------------------------------% c | Sort XIMAG into increasing order of magnitude. | c %------------------------------------------------% c 130 continue if (igap .eq. 0) go to 9000 do 150 i = igap, n-1 j = i-igap 140 continue c if (j.lt.0) go to 150 c if (abs(ximag(j)).gt.abs(ximag(j+igap))) then temp = xreal(j) xreal(j) = xreal(j+igap) xreal(j+igap) = temp c temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 150 endif j = j-igap go to 140 150 continue igap = igap / 2 go to 130 c else if (which .eq. 'SI') then c c %------------------------------------------------% c | Sort XIMAG into decreasing order of magnitude. | c %------------------------------------------------% c 160 continue if (igap .eq. 0) go to 9000 do 180 i = igap, n-1 j = i-igap 170 continue c if (j.lt.0) go to 180 c if (abs(ximag(j)).lt.abs(ximag(j+igap))) then temp = xreal(j) xreal(j) = xreal(j+igap) xreal(j+igap) = temp c temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 180 endif j = j-igap go to 170 180 continue igap = igap / 2 go to 160 end if c 9000 continue return c c %---------------% c | End of dsortc | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/cvout.f000644 001750 001750 00000020015 11266605602 021753 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c c\SCCS Information: @(#) c FILE: cvout.f SID: 2.1 DATE OF SID: 11/16/95 RELEASE: 2 c *----------------------------------------------------------------------- * Routine: CVOUT * * Purpose: Complex vector output routine. * * Usage: CALL CVOUT (LOUT, N, CX, IDIGIT, IFMT) * * Arguments * N - Length of array CX. (Input) * CX - Complex array to be printed. (Input) * IFMT - Format to be used in printing array CX. (Input) * IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In) * If IDIGIT .LT. 0, printing is done with 72 columns. * If IDIGIT .GT. 0, printing is done with 132 columns. * *----------------------------------------------------------------------- * SUBROUTINE CVOUT( LOUT, N, CX, IDIGIT, IFMT ) * ... * ... SPECIFICATIONS FOR ARGUMENTS INTEGER N, IDIGIT, LOUT Complex & CX( * ) CHARACTER IFMT*( * ) * ... * ... SPECIFICATIONS FOR LOCAL VARIABLES INTEGER I, NDIGIT, K1, K2, LLL CHARACTER*80 LINE * ... * ... FIRST EXECUTABLE STATEMENT * * LLL = MIN( LEN( IFMT ), 80 ) DO 10 I = 1, LLL LINE( I: I ) = '-' 10 CONTINUE * DO 20 I = LLL + 1, 80 LINE( I: I ) = ' ' 20 CONTINUE * WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL ) 9999 FORMAT( / 1X, A / 1X, A ) * IF( N.LE.0 ) $ RETURN NDIGIT = IDIGIT IF( IDIGIT.EQ.0 ) $ NDIGIT = 4 * *======================================================================= * CODE FOR OUTPUT USING 72 COLUMNS FORMAT *======================================================================= * IF( IDIGIT.LT.0 ) THEN NDIGIT = -IDIGIT IF( NDIGIT.LE.4 ) THEN DO 30 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) IF (K1.NE.N) THEN WRITE( LOUT, 9998 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE WRITE( LOUT, 9997 )K1, K2, ( CX( I ), $ I = K1, K2 ) END IF 30 CONTINUE ELSE IF( NDIGIT.LE.6 ) THEN DO 40 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) IF (K1.NE.N) THEN WRITE( LOUT, 9988 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE WRITE( LOUT, 9987 )K1, K2, ( CX( I ), $ I = K1, K2 ) END IF 40 CONTINUE ELSE IF( NDIGIT.LE.8 ) THEN DO 50 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) IF (K1.NE.N) THEN WRITE( LOUT, 9978 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE WRITE( LOUT, 9977 )K1, K2, ( CX( I ), $ I = K1, K2 ) END IF 50 CONTINUE ELSE DO 60 K1 = 1, N WRITE( LOUT, 9968 )K1, K1, CX( I ) 60 CONTINUE END IF * *======================================================================= * CODE FOR OUTPUT USING 132 COLUMNS FORMAT *======================================================================= * ELSE IF( NDIGIT.LE.4 ) THEN DO 70 K1 = 1, N, 4 K2 = MIN0( N, K1+3 ) IF ((K1+3).LE.N) THEN WRITE( LOUT, 9958 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE IF ((K1+3-N) .EQ. 1) THEN WRITE( LOUT, 9957 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE IF ((K1+3-N) .EQ. 2) THEN WRITE( LOUT, 9956 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE IF ((K1+3-N) .EQ. 1) THEN WRITE( LOUT, 9955 )K1, K2, ( CX( I ), $ I = K1, K2 ) END IF 70 CONTINUE ELSE IF( NDIGIT.LE.6 ) THEN DO 80 K1 = 1, N, 3 K2 = MIN0( N, K1+2 ) IF ((K1+2).LE.N) THEN WRITE( LOUT, 9948 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE IF ((K1+2-N) .EQ. 1) THEN WRITE( LOUT, 9947 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE IF ((K1+2-N) .EQ. 2) THEN WRITE( LOUT, 9946 )K1, K2, ( CX( I ), $ I = K1, K2 ) END IF 80 CONTINUE ELSE IF( NDIGIT.LE.8 ) THEN DO 90 K1 = 1, N, 3 K2 = MIN0( N, K1+2 ) IF ((K1+2).LE.N) THEN WRITE( LOUT, 9938 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE IF ((K1+2-N) .EQ. 1) THEN WRITE( LOUT, 9937 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE IF ((K1+2-N) .EQ. 2) THEN WRITE( LOUT, 9936 )K1, K2, ( CX( I ), $ I = K1, K2 ) END IF 90 CONTINUE ELSE DO 100 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) IF ((K1+2).LE.N) THEN WRITE( LOUT, 9928 )K1, K2, ( CX( I ), $ I = K1, K2 ) ELSE IF ((K1+2-N) .EQ. 1) THEN WRITE( LOUT, 9927 )K1, K2, ( CX( I ), $ I = K1, K2 ) END IF 100 CONTINUE END IF END IF WRITE( LOUT, 9994 ) RETURN * *======================================================================= * FORMAT FOR 72 COLUMNS *======================================================================= * * DISPLAY 4 SIGNIFICANT DIGITS * 9998 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,2('(',E10.3,',',E10.3,') ') ) 9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,1('(',E10.3,',',E10.3,') ') ) * * DISPLAY 6 SIGNIFICANT DIGITS * 9988 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,2('(',E12.5,',',E12.5,') ') ) 9987 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,1('(',E12.5,',',E12.5,') ') ) * * DISPLAY 8 SIGNIFICANT DIGITS * 9978 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,2('(',E14.7,',',E14.7,') ') ) 9977 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,1('(',E14.7,',',E14.7,') ') ) * * DISPLAY 13 SIGNIFICANT DIGITS * 9968 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,1('(',E20.13,',',E20.13,') ') ) * *========================================================================= * FORMAT FOR 132 COLUMNS *========================================================================= * * DISPLAY 4 SIGNIFICANT DIGITS * 9958 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,4('(',E10.3,',',E10.3,') ') ) 9957 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,3('(',E10.3,',',E10.3,') ') ) 9956 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,2('(',E10.3,',',E10.3,') ') ) 9955 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,1('(',E10.3,',',E10.3,') ') ) * * DISPLAY 6 SIGNIFICANT DIGITS * 9948 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,3('(',E12.5,',',E12.5,') ') ) 9947 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,2('(',E12.5,',',E12.5,') ') ) 9946 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,1('(',E12.5,',',E12.5,') ') ) * * DISPLAY 8 SIGNIFICANT DIGITS * 9938 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,3('(',E14.7,',',E14.7,') ') ) 9937 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,2('(',E14.7,',',E14.7,') ') ) 9936 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,1('(',E14.7,',',E14.7,') ') ) * * DISPLAY 13 SIGNIFICANT DIGITS * 9928 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,2('(',E20.13,',',E20.13,') ') ) 9927 FORMAT( 1X, I4, ' - ', I4, ':', 1X, $ 1P,1('(',E20.13,',',E20.13,') ') ) * * * 9994 FORMAT( 1X, ' ' ) END getdp-2.7.0-source/contrib/Arpack/CMakeLists.txt000644 001750 001750 00000002121 12473553037 023207 0ustar00geuzainegeuzaine000000 000000 # GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege # # See the LICENSE.txt file for license information. Please report all # bugs and problems to the public mailing list . set(SRC sgetv0.f slaqrb.f sstqrb.f ssortc.f ssortr.f sstatn.f sstats.f snaitr.f snapps.f snaup2.f snaupd.f snconv.f sneigh.f sngets.f ssaitr.f ssapps.f ssaup2.f ssaupd.f ssconv.f sseigt.f ssgets.f sneupd.f sseupd.f ssesrt.f dgetv0.f dlaqrb.f dstqrb.f dsortc.f dsortr.f dstatn.f dstats.f dnaitr.f dnapps.f dnaup2.f dnaupd.f dnconv.f dneigh.f dngets.f dsaitr.f dsapps.f dsaup2.f dsaupd.f dsconv.f dseigt.f dsgets.f dneupd.f dseupd.f dsesrt.f cnaitr.f cnapps.f cnaup2.f cnaupd.f cneigh.f cneupd.f cngets.f cgetv0.f csortc.f cstatn.f znaitr.f znapps.f znaup2.f znaupd.f zneigh.f zneupd.f zngets.f zgetv0.f zsortc.f zstatn.f cvout.f dmout.f dvout.f icnteq.f icopy.f iset.f iswap.f ivout.f second.f smout.f svout.f zmout.f zvout.f cmout.f ) file(GLOB HDR RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} *.h) append_getdp_src(contrib/Arpack "${SRC};${HDR}") getdp-2.7.0-source/contrib/Arpack/znapps.f000644 001750 001750 00000042331 11266605602 022133 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: znapps c c\Description: c Given the Arnoldi factorization c c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T, c c apply NP implicit shifts resulting in c c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q c c where Q is an orthogonal matrix which is the product of rotations c and reflections resulting from the NP bulge change sweeps. c The updated Arnoldi factorization becomes: c c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T. c c\Usage: c call znapps c ( N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ, c WORKL, WORKD ) c c\Arguments c N Integer. (INPUT) c Problem size, i.e. size of matrix A. c c KEV Integer. (INPUT/OUTPUT) c KEV+NP is the size of the input matrix H. c KEV is the size of the updated matrix HNEW. c c NP Integer. (INPUT) c Number of implicit shifts to be applied. c c SHIFT Complex*16 array of length NP. (INPUT) c The shifts to be applied. c c V Complex*16 N by (KEV+NP) array. (INPUT/OUTPUT) c On INPUT, V contains the current KEV+NP Arnoldi vectors. c On OUTPUT, V contains the updated KEV Arnoldi vectors c in the first KEV columns of V. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Complex*16 (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT) c On INPUT, H contains the current KEV+NP by KEV+NP upper c Hessenberg matrix of the Arnoldi factorization. c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg c matrix in the KEV leading submatrix. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RESID Complex*16 array of length N. (INPUT/OUTPUT) c On INPUT, RESID contains the the residual vector r_{k+p}. c On OUTPUT, RESID is the update residual vector rnew_{k} c in the first KEV locations. c c Q Complex*16 KEV+NP by KEV+NP work array. (WORKSPACE) c Work array used to accumulate the rotations and reflections c during the bulge chase sweep. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKL Complex*16 work array of length (KEV+NP). (WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. c c WORKD Complex*16 work array of length 2*N. (WORKSPACE) c Distributed array used in the application of the accumulated c orthogonal matrix Q. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx Complex*16 c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c c\Routines called: c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c zmout ARPACK utility routine that prints matrices c zvout ARPACK utility routine that prints vectors. c zlacpy LAPACK matrix copy routine. c zlanhs LAPACK routine that computes various norms of a matrix. c zlartg LAPACK Givens rotation construction routine. c zlaset LAPACK matrix initialization routine. c dlabad LAPACK routine for defining the underflow and overflow c limits. c dlamch LAPACK routine that determines machine constants. c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c zgemv Level 2 BLAS routine for matrix vector multiplication. c zaxpy Level 1 BLAS that computes a vector triad. c zcopy Level 1 BLAS that copies one vector to another. c zscal Level 1 BLAS that scales a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: napps.F SID: 2.3 DATE OF SID: 3/28/97 RELEASE: 2 c c\Remarks c 1. In this version, each shift is applied to all the sublocks of c the Hessenberg matrix H and not just to the submatrix that it c comes from. Deflation as in LAPACK routine zlahqr (QR algorithm c for upper Hessenberg matrices ) is used. c Upon output, the subdiagonals of H are enforced to be non-negative c real numbers. c c\EndLib c c----------------------------------------------------------------------- c subroutine znapps & ( n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq, & workl, workd ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer kev, ldh, ldq, ldv, n, np c c %-----------------% c | Array Arguments | c %-----------------% c Complex*16 & h(ldh,kev+np), resid(n), shift(np), & v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np) c c %------------% c | Parameters | c %------------% c Complex*16 & one, zero Double precision & rzero parameter (one = (1.0D+0, 0.0D+0), zero = (0.0D+0, 0.0D+0), & rzero = 0.0D+0) c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c integer i, iend, istart, j, jj, kplusp, msglvl logical first Complex*16 & cdum, f, g, h11, h21, r, s, sigma, t Double precision & c, ovfl, smlnum, ulp, unfl, tst1 save first, ovfl, smlnum, ulp, unfl c c %----------------------% c | External Subroutines | c %----------------------% c external zaxpy, zcopy, zgemv, zscal, zlacpy, zlartg, & zvout, zlaset, dlabad, zmout, second, ivout c c %--------------------% c | External Functions | c %--------------------% c Double precision & zlanhs, dlamch, dlapy2 external zlanhs, dlamch, dlapy2 c c %----------------------% c | Intrinsics Functions | c %----------------------% c intrinsic abs, dimag, conjg, dcmplx, max, min, dble c c %---------------------% c | Statement Functions | c %---------------------% c Double precision & zabs1 zabs1( cdum ) = abs( dble( cdum ) ) + abs( dimag( cdum ) ) c c %----------------% c | Data statments | c %----------------% c data first / .true. / c c %-----------------------% c | Executable Statements | c %-----------------------% c if (first) then c c %-----------------------------------------------% c | Set machine-dependent constants for the | c | stopping criterion. If norm(H) <= sqrt(OVFL), | c | overflow should not occur. | c | REFERENCE: LAPACK subroutine zlahqr | c %-----------------------------------------------% c unfl = dlamch( 'safe minimum' ) ovfl = dble(one / unfl) call dlabad( unfl, ovfl ) ulp = dlamch( 'precision' ) smlnum = unfl*( n / ulp ) first = .false. end if c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mcapps c kplusp = kev + np c c %--------------------------------------------% c | Initialize Q to the identity to accumulate | c | the rotations and reflections | c %--------------------------------------------% c call zlaset ('All', kplusp, kplusp, zero, one, q, ldq) c c %----------------------------------------------% c | Quick return if there are no shifts to apply | c %----------------------------------------------% c if (np .eq. 0) go to 9000 c c %----------------------------------------------% c | Chase the bulge with the application of each | c | implicit shift. Each shift is applied to the | c | whole matrix including each block. | c %----------------------------------------------% c do 110 jj = 1, np sigma = shift(jj) c if (msglvl .gt. 2 ) then call ivout (logfil, 1, jj, ndigit, & '_napps: shift number.') call zvout (logfil, 1, sigma, ndigit, & '_napps: Value of the shift ') end if c istart = 1 20 continue c do 30 i = istart, kplusp-1 c c %----------------------------------------% c | Check for splitting and deflation. Use | c | a standard test as in the QR algorithm | c | REFERENCE: LAPACK subroutine zlahqr | c %----------------------------------------% c tst1 = zabs1( h( i, i ) ) + zabs1( h( i+1, i+1 ) ) if( tst1.eq.rzero ) & tst1 = zlanhs( '1', kplusp-jj+1, h, ldh, workl ) if ( abs(dble(h(i+1,i))) & .le. max(ulp*tst1, smlnum) ) then if (msglvl .gt. 0) then call ivout (logfil, 1, i, ndigit, & '_napps: matrix splitting at row/column no.') call ivout (logfil, 1, jj, ndigit, & '_napps: matrix splitting with shift number.') call zvout (logfil, 1, h(i+1,i), ndigit, & '_napps: off diagonal element.') end if iend = i h(i+1,i) = zero go to 40 end if 30 continue iend = kplusp 40 continue c if (msglvl .gt. 2) then call ivout (logfil, 1, istart, ndigit, & '_napps: Start of current block ') call ivout (logfil, 1, iend, ndigit, & '_napps: End of current block ') end if c c %------------------------------------------------% c | No reason to apply a shift to block of order 1 | c | or if the current block starts after the point | c | of compression since we'll discard this stuff | c %------------------------------------------------% c if ( istart .eq. iend .or. istart .gt. kev) go to 100 c h11 = h(istart,istart) h21 = h(istart+1,istart) f = h11 - sigma g = h21 c do 80 i = istart, iend-1 c c %------------------------------------------------------% c | Construct the plane rotation G to zero out the bulge | c %------------------------------------------------------% c call zlartg (f, g, c, s, r) if (i .gt. istart) then h(i,i-1) = r h(i+1,i-1) = zero end if c c %---------------------------------------------% c | Apply rotation to the left of H; H <- G'*H | c %---------------------------------------------% c do 50 j = i, kplusp t = c*h(i,j) + s*h(i+1,j) h(i+1,j) = -conjg(s)*h(i,j) + c*h(i+1,j) h(i,j) = t 50 continue c c %---------------------------------------------% c | Apply rotation to the right of H; H <- H*G | c %---------------------------------------------% c do 60 j = 1, min(i+2,iend) t = c*h(j,i) + conjg(s)*h(j,i+1) h(j,i+1) = -s*h(j,i) + c*h(j,i+1) h(j,i) = t 60 continue c c %-----------------------------------------------------% c | Accumulate the rotation in the matrix Q; Q <- Q*G' | c %-----------------------------------------------------% c do 70 j = 1, min(i+jj, kplusp) t = c*q(j,i) + conjg(s)*q(j,i+1) q(j,i+1) = - s*q(j,i) + c*q(j,i+1) q(j,i) = t 70 continue c c %---------------------------% c | Prepare for next rotation | c %---------------------------% c if (i .lt. iend-1) then f = h(i+1,i) g = h(i+2,i) end if 80 continue c c %-------------------------------% c | Finished applying the shift. | c %-------------------------------% c 100 continue c c %---------------------------------------------------------% c | Apply the same shift to the next block if there is any. | c %---------------------------------------------------------% c istart = iend + 1 if (iend .lt. kplusp) go to 20 c c %---------------------------------------------% c | Loop back to the top to get the next shift. | c %---------------------------------------------% c 110 continue c c %---------------------------------------------------% c | Perform a similarity transformation that makes | c | sure that the compressed H will have non-negative | c | real subdiagonal elements. | c %---------------------------------------------------% c do 120 j=1,kev if ( dble( h(j+1,j) ) .lt. rzero .or. & dimag( h(j+1,j) ) .ne. rzero ) then t = h(j+1,j) / dlapy2(dble(h(j+1,j)),dimag(h(j+1,j))) call zscal( kplusp-j+1, conjg(t), h(j+1,j), ldh ) call zscal( min(j+2, kplusp), t, h(1,j+1), 1 ) call zscal( min(j+np+1,kplusp), t, q(1,j+1), 1 ) h(j+1,j) = dcmplx( dble( h(j+1,j) ), rzero ) end if 120 continue c do 130 i = 1, kev c c %--------------------------------------------% c | Final check for splitting and deflation. | c | Use a standard test as in the QR algorithm | c | REFERENCE: LAPACK subroutine zlahqr. | c | Note: Since the subdiagonals of the | c | compressed H are nonnegative real numbers, | c | we take advantage of this. | c %--------------------------------------------% c tst1 = zabs1( h( i, i ) ) + zabs1( h( i+1, i+1 ) ) if( tst1 .eq. rzero ) & tst1 = zlanhs( '1', kev, h, ldh, workl ) if( dble( h( i+1,i ) ) .le. max( ulp*tst1, smlnum ) ) & h(i+1,i) = zero 130 continue c c %-------------------------------------------------% c | Compute the (kev+1)-st column of (V*Q) and | c | temporarily store the result in WORKD(N+1:2*N). | c | This is needed in the residual update since we | c | cannot GUARANTEE that the corresponding entry | c | of H would be zero as in exact arithmetic. | c %-------------------------------------------------% c if ( dble( h(kev+1,kev) ) .gt. rzero ) & call zgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero, & workd(n+1), 1) c c %----------------------------------------------------------% c | Compute column 1 to kev of (V*Q) in backward order | c | taking advantage of the upper Hessenberg structure of Q. | c %----------------------------------------------------------% c do 140 i = 1, kev call zgemv ('N', n, kplusp-i+1, one, v, ldv, & q(1,kev-i+1), 1, zero, workd, 1) call zcopy (n, workd, 1, v(1,kplusp-i+1), 1) 140 continue c c %-------------------------------------------------% c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). | c %-------------------------------------------------% c call zlacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv) c c %--------------------------------------------------------------% c | Copy the (kev+1)-st column of (V*Q) in the appropriate place | c %--------------------------------------------------------------% c if ( dble( h(kev+1,kev) ) .gt. rzero ) & call zcopy (n, workd(n+1), 1, v(1,kev+1), 1) c c %-------------------------------------% c | Update the residual vector: | c | r <- sigmak*r + betak*v(:,kev+1) | c | where | c | sigmak = (e_{kev+p}'*Q)*e_{kev} | c | betak = e_{kev+1}'*H*e_{kev} | c %-------------------------------------% c call zscal (n, q(kplusp,kev), resid, 1) if ( dble( h(kev+1,kev) ) .gt. rzero ) & call zaxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1) c if (msglvl .gt. 1) then call zvout (logfil, 1, q(kplusp,kev), ndigit, & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}') call zvout (logfil, 1, h(kev+1,kev), ndigit, & '_napps: betak = e_{kev+1}^T*H*e_{kev}') call ivout (logfil, 1, kev, ndigit, & '_napps: Order of the final Hessenberg matrix ') if (msglvl .gt. 2) then call zmout (logfil, kev, kev, h, ldh, ndigit, & '_napps: updated Hessenberg matrix H for next iteration') end if c end if c 9000 continue call second (t1) tcapps = tcapps + (t1 - t0) c return c c %---------------% c | End of znapps | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/slaqrb.f000644 001750 001750 00000043644 11266605602 022114 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: slaqrb c c\Description: c Compute the eigenvalues and the Schur decomposition of an upper c Hessenberg submatrix in rows and columns ILO to IHI. Only the c last component of the Schur vectors are computed. c c This is mostly a modification of the LAPACK routine slahqr. c c\Usage: c call slaqrb c ( WANTT, N, ILO, IHI, H, LDH, WR, WI, Z, INFO ) c c\Arguments c WANTT Logical variable. (INPUT) c = .TRUE. : the full Schur form T is required; c = .FALSE.: only eigenvalues are required. c c N Integer. (INPUT) c The order of the matrix H. N >= 0. c c ILO Integer. (INPUT) c IHI Integer. (INPUT) c It is assumed that H is already upper quasi-triangular in c rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless c ILO = 1). SLAQRB works primarily with the Hessenberg c submatrix in rows and columns ILO to IHI, but applies c transformations to all of H if WANTT is .TRUE.. c 1 <= ILO <= max(1,IHI); IHI <= N. c c H Real array, dimension (LDH,N). (INPUT/OUTPUT) c On entry, the upper Hessenberg matrix H. c On exit, if WANTT is .TRUE., H is upper quasi-triangular in c rows and columns ILO:IHI, with any 2-by-2 diagonal blocks in c standard form. If WANTT is .FALSE., the contents of H are c unspecified on exit. c c LDH Integer. (INPUT) c The leading dimension of the array H. LDH >= max(1,N). c c WR Real array, dimension (N). (OUTPUT) c WI Real array, dimension (N). (OUTPUT) c The real and imaginary parts, respectively, of the computed c eigenvalues ILO to IHI are stored in the corresponding c elements of WR and WI. If two eigenvalues are computed as a c complex conjugate pair, they are stored in consecutive c elements of WR and WI, say the i-th and (i+1)th, with c WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the c eigenvalues are stored in the same order as on the diagonal c of the Schur form returned in H, with WR(i) = H(i,i), and, if c H(i:i+1,i:i+1) is a 2-by-2 diagonal block, c WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i). c c Z Real array, dimension (N). (OUTPUT) c On exit Z contains the last components of the Schur vectors. c c INFO Integer. (OUPUT) c = 0: successful exit c > 0: SLAQRB failed to compute all the eigenvalues ILO to IHI c in a total of 30*(IHI-ILO+1) iterations; if INFO = i, c elements i+1:ihi of WR and WI contain those eigenvalues c which have been successfully computed. c c\Remarks c 1. None. c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\Routines called: c slabad LAPACK routine that computes machine constants. c slamch LAPACK routine that determines machine constants. c slanhs LAPACK routine that computes various norms of a matrix. c slanv2 LAPACK routine that computes the Schur factorization of c 2 by 2 nonsymmetric matrix in standard form. c slarfg LAPACK Householder reflection construction routine. c scopy Level 1 BLAS that copies one vector to another. c srot Level 1 BLAS that applies a rotation to a 2 by 2 matrix. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.4' c Modified from the LAPACK routine slahqr so that only the c last component of the Schur vectors are computed. c c\SCCS Information: @(#) c FILE: laqrb.F SID: 2.2 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks c 1. None c c\EndLib c c----------------------------------------------------------------------- c subroutine slaqrb ( wantt, n, ilo, ihi, h, ldh, wr, wi, & z, info ) c c %------------------% c | Scalar Arguments | c %------------------% c logical wantt integer ihi, ilo, info, ldh, n c c %-----------------% c | Array Arguments | c %-----------------% c Real & h( ldh, * ), wi( * ), wr( * ), z( * ) c c %------------% c | Parameters | c %------------% c Real & zero, one, dat1, dat2 parameter (zero = 0.0E+0, one = 1.0E+0, dat1 = 7.5E-1, & dat2 = -4.375E-1) c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c integer i, i1, i2, itn, its, j, k, l, m, nh, nr Real & cs, h00, h10, h11, h12, h21, h22, h33, h33s, & h43h34, h44, h44s, ovfl, s, smlnum, sn, sum, & t1, t2, t3, tst1, ulp, unfl, v1, v2, v3 Real & v( 3 ), work( 1 ) c c %--------------------% c | External Functions | c %--------------------% c Real & slamch, slanhs external slamch, slanhs c c %----------------------% c | External Subroutines | c %----------------------% c external scopy, slabad, slanv2, slarfg, srot c c %-----------------------% c | Executable Statements | c %-----------------------% c info = 0 c c %--------------------------% c | Quick return if possible | c %--------------------------% c if( n.eq.0 ) & return if( ilo.eq.ihi ) then wr( ilo ) = h( ilo, ilo ) wi( ilo ) = zero return end if c c %---------------------------------------------% c | Initialize the vector of last components of | c | the Schur vectors for accumulation. | c %---------------------------------------------% c do 5 j = 1, n-1 z(j) = zero 5 continue z(n) = one c nh = ihi - ilo + 1 c c %-------------------------------------------------------------% c | Set machine-dependent constants for the stopping criterion. | c | If norm(H) <= sqrt(OVFL), overflow should not occur. | c %-------------------------------------------------------------% c unfl = slamch( 'safe minimum' ) ovfl = one / unfl call slabad( unfl, ovfl ) ulp = slamch( 'precision' ) smlnum = unfl*( nh / ulp ) c c %---------------------------------------------------------------% c | I1 and I2 are the indices of the first row and last column | c | of H to which transformations must be applied. If eigenvalues | c | only are computed, I1 and I2 are set inside the main loop. | c | Zero out H(J+2,J) = ZERO for J=1:N if WANTT = .TRUE. | c | else H(J+2,J) for J=ILO:IHI-ILO-1 if WANTT = .FALSE. | c %---------------------------------------------------------------% c if( wantt ) then i1 = 1 i2 = n do 8 i=1,i2-2 h(i1+i+1,i) = zero 8 continue else do 9 i=1, ihi-ilo-1 h(ilo+i+1,ilo+i-1) = zero 9 continue end if c c %---------------------------------------------------% c | ITN is the total number of QR iterations allowed. | c %---------------------------------------------------% c itn = 30*nh c c ------------------------------------------------------------------ c The main loop begins here. I is the loop index and decreases from c IHI to ILO in steps of 1 or 2. Each iteration of the loop works c with the active submatrix in rows and columns L to I. c Eigenvalues I+1 to IHI have already converged. Either L = ILO or c H(L,L-1) is negligible so that the matrix splits. c ------------------------------------------------------------------ c i = ihi 10 continue l = ilo if( i.lt.ilo ) & go to 150 c %--------------------------------------------------------------% c | Perform QR iterations on rows and columns ILO to I until a | c | submatrix of order 1 or 2 splits off at the bottom because a | c | subdiagonal element has become negligible. | c %--------------------------------------------------------------% do 130 its = 0, itn c c %----------------------------------------------% c | Look for a single small subdiagonal element. | c %----------------------------------------------% c do 20 k = i, l + 1, -1 tst1 = abs( h( k-1, k-1 ) ) + abs( h( k, k ) ) if( tst1.eq.zero ) & tst1 = slanhs( '1', i-l+1, h( l, l ), ldh, work ) if( abs( h( k, k-1 ) ).le.max( ulp*tst1, smlnum ) ) & go to 30 20 continue 30 continue l = k if( l.gt.ilo ) then c c %------------------------% c | H(L,L-1) is negligible | c %------------------------% c h( l, l-1 ) = zero end if c c %-------------------------------------------------------------% c | Exit from loop if a submatrix of order 1 or 2 has split off | c %-------------------------------------------------------------% c if( l.ge.i-1 ) & go to 140 c c %---------------------------------------------------------% c | Now the active submatrix is in rows and columns L to I. | c | If eigenvalues only are being computed, only the active | c | submatrix need be transformed. | c %---------------------------------------------------------% c if( .not.wantt ) then i1 = l i2 = i end if c if( its.eq.10 .or. its.eq.20 ) then c c %-------------------% c | Exceptional shift | c %-------------------% c s = abs( h( i, i-1 ) ) + abs( h( i-1, i-2 ) ) h44 = dat1*s h33 = h44 h43h34 = dat2*s*s c else c c %-----------------------------------------% c | Prepare to use Wilkinson's double shift | c %-----------------------------------------% c h44 = h( i, i ) h33 = h( i-1, i-1 ) h43h34 = h( i, i-1 )*h( i-1, i ) end if c c %-----------------------------------------------------% c | Look for two consecutive small subdiagonal elements | c %-----------------------------------------------------% c do 40 m = i - 2, l, -1 c c %---------------------------------------------------------% c | Determine the effect of starting the double-shift QR | c | iteration at row M, and see if this would make H(M,M-1) | c | negligible. | c %---------------------------------------------------------% c h11 = h( m, m ) h22 = h( m+1, m+1 ) h21 = h( m+1, m ) h12 = h( m, m+1 ) h44s = h44 - h11 h33s = h33 - h11 v1 = ( h33s*h44s-h43h34 ) / h21 + h12 v2 = h22 - h11 - h33s - h44s v3 = h( m+2, m+1 ) s = abs( v1 ) + abs( v2 ) + abs( v3 ) v1 = v1 / s v2 = v2 / s v3 = v3 / s v( 1 ) = v1 v( 2 ) = v2 v( 3 ) = v3 if( m.eq.l ) & go to 50 h00 = h( m-1, m-1 ) h10 = h( m, m-1 ) tst1 = abs( v1 )*( abs( h00 )+abs( h11 )+abs( h22 ) ) if( abs( h10 )*( abs( v2 )+abs( v3 ) ).le.ulp*tst1 ) & go to 50 40 continue 50 continue c c %----------------------% c | Double-shift QR step | c %----------------------% c do 120 k = m, i - 1 c c ------------------------------------------------------------ c The first iteration of this loop determines a reflection G c from the vector V and applies it from left and right to H, c thus creating a nonzero bulge below the subdiagonal. c c Each subsequent iteration determines a reflection G to c restore the Hessenberg form in the (K-1)th column, and thus c chases the bulge one step toward the bottom of the active c submatrix. NR is the order of G. c ------------------------------------------------------------ c nr = min( 3, i-k+1 ) if( k.gt.m ) & call scopy( nr, h( k, k-1 ), 1, v, 1 ) call slarfg( nr, v( 1 ), v( 2 ), 1, t1 ) if( k.gt.m ) then h( k, k-1 ) = v( 1 ) h( k+1, k-1 ) = zero if( k.lt.i-1 ) & h( k+2, k-1 ) = zero else if( m.gt.l ) then h( k, k-1 ) = -h( k, k-1 ) end if v2 = v( 2 ) t2 = t1*v2 if( nr.eq.3 ) then v3 = v( 3 ) t3 = t1*v3 c c %------------------------------------------------% c | Apply G from the left to transform the rows of | c | the matrix in columns K to I2. | c %------------------------------------------------% c do 60 j = k, i2 sum = h( k, j ) + v2*h( k+1, j ) + v3*h( k+2, j ) h( k, j ) = h( k, j ) - sum*t1 h( k+1, j ) = h( k+1, j ) - sum*t2 h( k+2, j ) = h( k+2, j ) - sum*t3 60 continue c c %----------------------------------------------------% c | Apply G from the right to transform the columns of | c | the matrix in rows I1 to min(K+3,I). | c %----------------------------------------------------% c do 70 j = i1, min( k+3, i ) sum = h( j, k ) + v2*h( j, k+1 ) + v3*h( j, k+2 ) h( j, k ) = h( j, k ) - sum*t1 h( j, k+1 ) = h( j, k+1 ) - sum*t2 h( j, k+2 ) = h( j, k+2 ) - sum*t3 70 continue c c %----------------------------------% c | Accumulate transformations for Z | c %----------------------------------% c sum = z( k ) + v2*z( k+1 ) + v3*z( k+2 ) z( k ) = z( k ) - sum*t1 z( k+1 ) = z( k+1 ) - sum*t2 z( k+2 ) = z( k+2 ) - sum*t3 else if( nr.eq.2 ) then c c %------------------------------------------------% c | Apply G from the left to transform the rows of | c | the matrix in columns K to I2. | c %------------------------------------------------% c do 90 j = k, i2 sum = h( k, j ) + v2*h( k+1, j ) h( k, j ) = h( k, j ) - sum*t1 h( k+1, j ) = h( k+1, j ) - sum*t2 90 continue c c %----------------------------------------------------% c | Apply G from the right to transform the columns of | c | the matrix in rows I1 to min(K+3,I). | c %----------------------------------------------------% c do 100 j = i1, i sum = h( j, k ) + v2*h( j, k+1 ) h( j, k ) = h( j, k ) - sum*t1 h( j, k+1 ) = h( j, k+1 ) - sum*t2 100 continue c c %----------------------------------% c | Accumulate transformations for Z | c %----------------------------------% c sum = z( k ) + v2*z( k+1 ) z( k ) = z( k ) - sum*t1 z( k+1 ) = z( k+1 ) - sum*t2 end if 120 continue 130 continue c c %-------------------------------------------------------% c | Failure to converge in remaining number of iterations | c %-------------------------------------------------------% c info = i return 140 continue if( l.eq.i ) then c c %------------------------------------------------------% c | H(I,I-1) is negligible: one eigenvalue has converged | c %------------------------------------------------------% c wr( i ) = h( i, i ) wi( i ) = zero else if( l.eq.i-1 ) then c c %--------------------------------------------------------% c | H(I-1,I-2) is negligible; | c | a pair of eigenvalues have converged. | c | | c | Transform the 2-by-2 submatrix to standard Schur form, | c | and compute and store the eigenvalues. | c %--------------------------------------------------------% c call slanv2( h( i-1, i-1 ), h( i-1, i ), h( i, i-1 ), & h( i, i ), wr( i-1 ), wi( i-1 ), wr( i ), wi( i ), & cs, sn ) if( wantt ) then c c %-----------------------------------------------------% c | Apply the transformation to the rest of H and to Z, | c | as required. | c %-----------------------------------------------------% c if( i2.gt.i ) & call srot( i2-i, h( i-1, i+1 ), ldh, h( i, i+1 ), ldh, & cs, sn ) call srot( i-i1-1, h( i1, i-1 ), 1, h( i1, i ), 1, cs, sn ) sum = cs*z( i-1 ) + sn*z( i ) z( i ) = cs*z( i ) - sn*z( i-1 ) z( i-1 ) = sum end if end if c c %---------------------------------------------------------% c | Decrement number of remaining iterations, and return to | c | start of the main loop with new value of I. | c %---------------------------------------------------------% c itn = itn - its i = l - 1 go to 10 150 continue return c c %---------------% c | End of slaqrb | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/cnaitr.f000644 001750 001750 00000074467 11266605602 022117 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: cnaitr c c\Description: c Reverse communication interface for applying NP additional steps to c a K step nonsymmetric Arnoldi factorization. c c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T c c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0. c c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T c c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0. c c where OP and B are as in cnaupd. The B-norm of r_{k+p} is also c computed and returned. c c\Usage: c call cnaitr c ( IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH, c IPNTR, WORKD, INFO ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) c Reverse communication flag. c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface c IDO = -1: compute Y = OP * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y. c This is for the restart phase to force the new c starting vector into the range of OP. c IDO = 1: compute Y = OP * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y, c IPNTR(3) is the pointer into WORK for B * X. c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORK for X, c IPNTR(2) is the pointer into WORK for Y. c IDO = 99: done c ------------------------------------------------------------- c When the routine is used in the "shift-and-invert" mode, the c vector B * Q is already available and do not need to be c recomputed in forming OP * Q. c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B that defines the c semi-inner product for the operator OP. See cnaupd. c B = 'I' -> standard eigenvalue problem A*x = lambda*x c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x c c N Integer. (INPUT) c Dimension of the eigenproblem. c c K Integer. (INPUT) c Current size of V and H. c c NP Integer. (INPUT) c Number of additional Arnoldi steps to take. c c NB Integer. (INPUT) c Blocksize to be used in the recurrence. c Only work for NB = 1 right now. The goal is to have a c program that implement both the block and non-block method. c c RESID Complex array of length N. (INPUT/OUTPUT) c On INPUT: RESID contains the residual vector r_{k}. c On OUTPUT: RESID contains the residual vector r_{k+p}. c c RNORM Real scalar. (INPUT/OUTPUT) c B-norm of the starting residual on input. c B-norm of the updated residual r_{k+p} on output. c c V Complex N by K+NP array. (INPUT/OUTPUT) c On INPUT: V contains the Arnoldi vectors in the first K c columns. c On OUTPUT: V contains the new NP Arnoldi vectors in the next c NP columns. The first K columns are unchanged. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Complex (K+NP) by (K+NP) array. (INPUT/OUTPUT) c H is used to store the generated upper Hessenberg matrix. c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c IPNTR Integer array of length 3. (OUTPUT) c Pointer to mark the starting locations in the WORK for c vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. c IPNTR(3): pointer to the vector B * X when used in the c shift-and-invert mode. X is the current operand. c ------------------------------------------------------------- c c WORKD Complex work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The calling program should not c use WORKD as temporary workspace during the iteration !!!!!! c On input, WORKD(1:N) = B*RESID and is used to save some c computation at the first step. c c INFO Integer. (OUTPUT) c = 0: Normal exit. c > 0: Size of the spanning invariant subspace of OP found. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx Complex c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: c cgetv0 ARPACK routine to generate the initial vector. c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c cmout ARPACK utility routine that prints matrices c cvout ARPACK utility routine that prints vectors. c clanhs LAPACK routine that computes various norms of a matrix. c clascl LAPACK routine for careful scaling of a matrix. c slabad LAPACK routine for defining the underflow and overflow c limits. c slamch LAPACK routine that determines machine constants. c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c cgemv Level 2 BLAS routine for matrix vector multiplication. c caxpy Level 1 BLAS that computes a vector triad. c ccopy Level 1 BLAS that copies one vector to another . c cdotc Level 1 BLAS that computes the scalar product of two vectors. c cscal Level 1 BLAS that scales a vector. c csscal Level 1 BLAS that scales a complex vector by a real number. c scnrm2 Level 1 BLAS that computes the norm of a vector. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: naitr.F SID: 2.3 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks c The algorithm implemented is: c c restart = .false. c Given V_{k} = [v_{1}, ..., v_{k}], r_{k}; c r_{k} contains the initial residual vector even for k = 0; c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already c computed by the calling program. c c betaj = rnorm ; p_{k+1} = B*r_{k} ; c For j = k+1, ..., k+np Do c 1) if ( betaj < tol ) stop or restart depending on j. c ( At present tol is zero ) c if ( restart ) generate a new starting vector. c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}]; c p_{j} = p_{j}/betaj c 3) r_{j} = OP*v_{j} where OP is defined as in cnaupd c For shift-invert mode p_{j} = B*v_{j} is already available. c wnorm = || OP*v_{j} || c 4) Compute the j-th step residual vector. c w_{j} = V_{j}^T * B * OP * v_{j} c r_{j} = OP*v_{j} - V_{j} * w_{j} c H(:,j) = w_{j}; c H(j,j-1) = rnorm c rnorm = || r_(j) || c If (rnorm > 0.717*wnorm) accept step and go back to 1) c 5) Re-orthogonalization step: c s = V_{j}'*B*r_{j} c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} || c alphaj = alphaj + s_{j}; c 6) Iterative refinement step: c If (rnorm1 > 0.717*rnorm) then c rnorm = rnorm1 c accept step and go back to 1) c Else c rnorm = rnorm1 c If this is the first time in step 6), go to 5) c Else r_{j} lies in the span of V_{j} numerically. c Set r_{j} = 0 and rnorm = 0; go to 1) c EndIf c End Do c c\EndLib c c----------------------------------------------------------------------- c subroutine cnaitr & (ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh, & ipntr, workd, info) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1 integer ido, info, k, ldh, ldv, n, nb, np Real & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(3) Complex & h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n) c c %------------% c | Parameters | c %------------% c Complex & one, zero Real & rone, rzero parameter (one = (1.0E+0, 0.0E+0), zero = (0.0E+0, 0.0E+0), & rone = 1.0E+0, rzero = 0.0E+0) c c %--------------% c | Local Arrays | c %--------------% c Real & rtemp(2) c c %---------------% c | Local Scalars | c %---------------% c logical first, orth1, orth2, rstart, step3, step4 integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl, & jj Real & ovfl, smlnum, tst1, ulp, unfl, betaj, & temp1, rnorm1, wnorm Complex & cnorm c save first, orth1, orth2, rstart, step3, step4, & ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl, & betaj, rnorm1, smlnum, ulp, unfl, wnorm c c %----------------------% c | External Subroutines | c %----------------------% c external caxpy, ccopy, cscal, csscal, cgemv, cgetv0, & slabad, cvout, cmout, ivout, second c c %--------------------% c | External Functions | c %--------------------% c Complex & cdotc Real & slamch, scnrm2, clanhs, slapy2 external cdotc, scnrm2, clanhs, slamch, slapy2 c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic aimag, real, max, sqrt c c %-----------------% c | Data statements | c %-----------------% c data first / .true. / c c %-----------------------% c | Executable Statements | c %-----------------------% c if (first) then c c %-----------------------------------------% c | Set machine-dependent constants for the | c | the splitting and deflation criterion. | c | If norm(H) <= sqrt(OVFL), | c | overflow should not occur. | c | REFERENCE: LAPACK subroutine clahqr | c %-----------------------------------------% c unfl = slamch( 'safe minimum' ) ovfl = real(one / unfl) call slabad( unfl, ovfl ) ulp = slamch( 'precision' ) smlnum = unfl*( n / ulp ) first = .false. end if c if (ido .eq. 0) then c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mcaitr c c %------------------------------% c | Initial call to this routine | c %------------------------------% c info = 0 step3 = .false. step4 = .false. rstart = .false. orth1 = .false. orth2 = .false. j = k + 1 ipj = 1 irj = ipj + n ivj = irj + n end if c c %-------------------------------------------------% c | When in reverse communication mode one of: | c | STEP3, STEP4, ORTH1, ORTH2, RSTART | c | will be .true. when .... | c | STEP3: return from computing OP*v_{j}. | c | STEP4: return from computing B-norm of OP*v_{j} | c | ORTH1: return from computing B-norm of r_{j+1} | c | ORTH2: return from computing B-norm of | c | correction to the residual vector. | c | RSTART: return from OP computations needed by | c | cgetv0. | c %-------------------------------------------------% c if (step3) go to 50 if (step4) go to 60 if (orth1) go to 70 if (orth2) go to 90 if (rstart) go to 30 c c %-----------------------------% c | Else this is the first step | c %-----------------------------% c c %--------------------------------------------------------------% c | | c | A R N O L D I I T E R A T I O N L O O P | c | | c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) | c %--------------------------------------------------------------% 1000 continue c if (msglvl .gt. 1) then call ivout (logfil, 1, j, ndigit, & '_naitr: generating Arnoldi vector number') call svout (logfil, 1, rnorm, ndigit, & '_naitr: B-norm of the current residual is') end if c c %---------------------------------------------------% c | STEP 1: Check if the B norm of j-th residual | c | vector is zero. Equivalent to determine whether | c | an exact j-step Arnoldi factorization is present. | c %---------------------------------------------------% c betaj = rnorm if (rnorm .gt. rzero) go to 40 c c %---------------------------------------------------% c | Invariant subspace found, generate a new starting | c | vector which is orthogonal to the current Arnoldi | c | basis and continue the iteration. | c %---------------------------------------------------% c if (msglvl .gt. 0) then call ivout (logfil, 1, j, ndigit, & '_naitr: ****** RESTART AT STEP ******') end if c c %---------------------------------------------% c | ITRY is the loop variable that controls the | c | maximum amount of times that a restart is | c | attempted. NRSTRT is used by stat.h | c %---------------------------------------------% c betaj = rzero nrstrt = nrstrt + 1 itry = 1 20 continue rstart = .true. ido = 0 30 continue c c %--------------------------------------% c | If in reverse communication mode and | c | RSTART = .true. flow returns here. | c %--------------------------------------% c call cgetv0 (ido, bmat, itry, .false., n, j, v, ldv, & resid, rnorm, ipntr, workd, ierr) if (ido .ne. 99) go to 9000 if (ierr .lt. 0) then itry = itry + 1 if (itry .le. 3) go to 20 c c %------------------------------------------------% c | Give up after several restart attempts. | c | Set INFO to the size of the invariant subspace | c | which spans OP and exit. | c %------------------------------------------------% c info = j - 1 call second (t1) tcaitr = tcaitr + (t1 - t0) ido = 99 go to 9000 end if c 40 continue c c %---------------------------------------------------------% c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm | c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow | c | when reciprocating a small RNORM, test against lower | c | machine bound. | c %---------------------------------------------------------% c call ccopy (n, resid, 1, v(1,j), 1) if ( rnorm .ge. unfl) then temp1 = rone / rnorm call csscal (n, temp1, v(1,j), 1) call csscal (n, temp1, workd(ipj), 1) else c c %-----------------------------------------% c | To scale both v_{j} and p_{j} carefully | c | use LAPACK routine clascl | c %-----------------------------------------% c call clascl ('General', i, i, rnorm, rone, & n, 1, v(1,j), n, infol) call clascl ('General', i, i, rnorm, rone, & n, 1, workd(ipj), n, infol) end if c c %------------------------------------------------------% c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} | c | Note that this is not quite yet r_{j}. See STEP 4 | c %------------------------------------------------------% c step3 = .true. nopx = nopx + 1 call second (t2) call ccopy (n, v(1,j), 1, workd(ivj), 1) ipntr(1) = ivj ipntr(2) = irj ipntr(3) = ipj ido = 1 c c %-----------------------------------% c | Exit in order to compute OP*v_{j} | c %-----------------------------------% c go to 9000 50 continue c c %----------------------------------% c | Back from reverse communication; | c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} | c | if step3 = .true. | c %----------------------------------% c call second (t3) tmvopx = tmvopx + (t3 - t2) step3 = .false. c c %------------------------------------------% c | Put another copy of OP*v_{j} into RESID. | c %------------------------------------------% c call ccopy (n, workd(irj), 1, resid, 1) c c %---------------------------------------% c | STEP 4: Finish extending the Arnoldi | c | factorization to length j. | c %---------------------------------------% c call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 step4 = .true. ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %-------------------------------------% c | Exit in order to compute B*OP*v_{j} | c %-------------------------------------% c go to 9000 else if (bmat .eq. 'I') then call ccopy (n, resid, 1, workd(ipj), 1) end if 60 continue c c %----------------------------------% c | Back from reverse communication; | c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} | c | if step4 = .true. | c %----------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c step4 = .false. c c %-------------------------------------% c | The following is needed for STEP 5. | c | Compute the B-norm of OP*v_{j}. | c %-------------------------------------% c if (bmat .eq. 'G') then cnorm = cdotc (n, resid, 1, workd(ipj), 1) wnorm = sqrt( slapy2(real(cnorm),aimag(cnorm)) ) else if (bmat .eq. 'I') then wnorm = scnrm2(n, resid, 1) end if c c %-----------------------------------------% c | Compute the j-th residual corresponding | c | to the j step factorization. | c | Use Classical Gram Schmidt and compute: | c | w_{j} <- V_{j}^T * B * OP * v_{j} | c | r_{j} <- OP*v_{j} - V_{j} * w_{j} | c %-----------------------------------------% c c c %------------------------------------------% c | Compute the j Fourier coefficients w_{j} | c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. | c %------------------------------------------% c call cgemv ('C', n, j, one, v, ldv, workd(ipj), 1, & zero, h(1,j), 1) c c %--------------------------------------% c | Orthogonalize r_{j} against V_{j}. | c | RESID contains OP*v_{j}. See STEP 3. | c %--------------------------------------% c call cgemv ('N', n, j, -one, v, ldv, h(1,j), 1, & one, resid, 1) c if (j .gt. 1) h(j,j-1) = cmplx(betaj, rzero) c call second (t4) c orth1 = .true. c call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call ccopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %----------------------------------% c | Exit in order to compute B*r_{j} | c %----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call ccopy (n, resid, 1, workd(ipj), 1) end if 70 continue c c %---------------------------------------------------% c | Back from reverse communication if ORTH1 = .true. | c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. | c %---------------------------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c orth1 = .false. c c %------------------------------% c | Compute the B-norm of r_{j}. | c %------------------------------% c if (bmat .eq. 'G') then cnorm = cdotc (n, resid, 1, workd(ipj), 1) rnorm = sqrt( slapy2(real(cnorm),aimag(cnorm)) ) else if (bmat .eq. 'I') then rnorm = scnrm2(n, resid, 1) end if c c %-----------------------------------------------------------% c | STEP 5: Re-orthogonalization / Iterative refinement phase | c | Maximum NITER_ITREF tries. | c | | c | s = V_{j}^T * B * r_{j} | c | r_{j} = r_{j} - V_{j}*s | c | alphaj = alphaj + s_{j} | c | | c | The stopping criteria used for iterative refinement is | c | discussed in Parlett's book SEP, page 107 and in Gragg & | c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. | c | Determine if we need to correct the residual. The goal is | c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || | c | The following test determines whether the sine of the | c | angle between OP*x and the computed residual is less | c | than or equal to 0.717. | c %-----------------------------------------------------------% c if ( rnorm .gt. 0.717*wnorm ) go to 100 c iter = 0 nrorth = nrorth + 1 c c %---------------------------------------------------% c | Enter the Iterative refinement phase. If further | c | refinement is necessary, loop back here. The loop | c | variable is ITER. Perform a step of Classical | c | Gram-Schmidt using all the Arnoldi vectors V_{j} | c %---------------------------------------------------% c 80 continue c if (msglvl .gt. 2) then rtemp(1) = wnorm rtemp(2) = rnorm call svout (logfil, 2, rtemp, ndigit, & '_naitr: re-orthogonalization; wnorm and rnorm are') call cvout (logfil, j, h(1,j), ndigit, & '_naitr: j-th column of H') end if c c %----------------------------------------------------% c | Compute V_{j}^T * B * r_{j}. | c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). | c %----------------------------------------------------% c call cgemv ('C', n, j, one, v, ldv, workd(ipj), 1, & zero, workd(irj), 1) c c %---------------------------------------------% c | Compute the correction to the residual: | c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). | c | The correction to H is v(:,1:J)*H(1:J,1:J) | c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. | c %---------------------------------------------% c call cgemv ('N', n, j, -one, v, ldv, workd(irj), 1, & one, resid, 1) call caxpy (j, one, workd(irj), 1, h(1,j), 1) c orth2 = .true. call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call ccopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 c c %-----------------------------------% c | Exit in order to compute B*r_{j}. | c | r_{j} is the corrected residual. | c %-----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call ccopy (n, resid, 1, workd(ipj), 1) end if 90 continue c c %---------------------------------------------------% c | Back from reverse communication if ORTH2 = .true. | c %---------------------------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c c %-----------------------------------------------------% c | Compute the B-norm of the corrected residual r_{j}. | c %-----------------------------------------------------% c if (bmat .eq. 'G') then cnorm = cdotc (n, resid, 1, workd(ipj), 1) rnorm1 = sqrt( slapy2(real(cnorm),aimag(cnorm)) ) else if (bmat .eq. 'I') then rnorm1 = scnrm2(n, resid, 1) end if c if (msglvl .gt. 0 .and. iter .gt. 0 ) then call ivout (logfil, 1, j, ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then rtemp(1) = rnorm rtemp(2) = rnorm1 call svout (logfil, 2, rtemp, ndigit, & '_naitr: iterative refinement ; rnorm and rnorm1 are') end if end if c c %-----------------------------------------% c | Determine if we need to perform another | c | step of re-orthogonalization. | c %-----------------------------------------% c if ( rnorm1 .gt. 0.717*rnorm ) then c c %---------------------------------------% c | No need for further refinement. | c | The cosine of the angle between the | c | corrected residual vector and the old | c | residual vector is greater than 0.717 | c | In other words the corrected residual | c | and the old residual vector share an | c | angle of less than arcCOS(0.717) | c %---------------------------------------% c rnorm = rnorm1 c else c c %-------------------------------------------% c | Another step of iterative refinement step | c | is required. NITREF is used by stat.h | c %-------------------------------------------% c nitref = nitref + 1 rnorm = rnorm1 iter = iter + 1 if (iter .le. 1) go to 80 c c %-------------------------------------------------% c | Otherwise RESID is numerically in the span of V | c %-------------------------------------------------% c do 95 jj = 1, n resid(jj) = zero 95 continue rnorm = rzero end if c c %----------------------------------------------% c | Branch here directly if iterative refinement | c | wasn't necessary or after at most NITER_REF | c | steps of iterative refinement. | c %----------------------------------------------% c 100 continue c rstart = .false. orth2 = .false. c call second (t5) titref = titref + (t5 - t4) c c %------------------------------------% c | STEP 6: Update j = j+1; Continue | c %------------------------------------% c j = j + 1 if (j .gt. k+np) then call second (t1) tcaitr = tcaitr + (t1 - t0) ido = 99 do 110 i = max(1,k), k+np-1 c c %--------------------------------------------% c | Check for splitting and deflation. | c | Use a standard test as in the QR algorithm | c | REFERENCE: LAPACK subroutine clahqr | c %--------------------------------------------% c tst1 = slapy2(real(h(i,i)),aimag(h(i,i))) & + slapy2(real(h(i+1,i+1)), aimag(h(i+1,i+1))) if( tst1.eq.real(zero) ) & tst1 = clanhs( '1', k+np, h, ldh, workd(n+1) ) if( slapy2(real(h(i+1,i)),aimag(h(i+1,i))) .le. & max( ulp*tst1, smlnum ) ) & h(i+1,i) = zero 110 continue c if (msglvl .gt. 2) then call cmout (logfil, k+np, k+np, h, ldh, ndigit, & '_naitr: Final upper Hessenberg matrix H of order K+NP') end if c go to 9000 end if c c %--------------------------------------------------------% c | Loop back to extend the factorization by another step. | c %--------------------------------------------------------% c go to 1000 c c %---------------------------------------------------------------% c | | c | E N D O F M A I N I T E R A T I O N L O O P | c | | c %---------------------------------------------------------------% c 9000 continue return c c %---------------% c | End of cnaitr | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/ssortc.f000644 001750 001750 00000021752 11266605602 022141 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: ssortc c c\Description: c Sorts the complex array in XREAL and XIMAG into the order c specified by WHICH and optionally applies the permutation to the c real array Y. It is assumed that if an element of XIMAG is c nonzero, then its negative is also an element. In other words, c both members of a complex conjugate pair are to be sorted and the c pairs are kept adjacent to each other. c c\Usage: c call ssortc c ( WHICH, APPLY, N, XREAL, XIMAG, Y ) c c\Arguments c WHICH Character*2. (Input) c 'LM' -> sort XREAL,XIMAG into increasing order of magnitude. c 'SM' -> sort XREAL,XIMAG into decreasing order of magnitude. c 'LR' -> sort XREAL into increasing order of algebraic. c 'SR' -> sort XREAL into decreasing order of algebraic. c 'LI' -> sort XIMAG into increasing order of magnitude. c 'SI' -> sort XIMAG into decreasing order of magnitude. c NOTE: If an element of XIMAG is non-zero, then its negative c is also an element. c c APPLY Logical. (Input) c APPLY = .TRUE. -> apply the sorted order to array Y. c APPLY = .FALSE. -> do not apply the sorted order to array Y. c c N Integer. (INPUT) c Size of the arrays. c c XREAL, Real array of length N. (INPUT/OUTPUT) c XIMAG Real and imaginary part of the array to be sorted. c c Y Real array of length N. (INPUT/OUTPUT) c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.1' c Adapted from the sort routine in LANSO. c c\SCCS Information: @(#) c FILE: sortc.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine ssortc (which, apply, n, xreal, ximag, y) c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which logical apply integer n c c %-----------------% c | Array Arguments | c %-----------------% c Real & xreal(0:n-1), ximag(0:n-1), y(0:n-1) c c %---------------% c | Local Scalars | c %---------------% c integer i, igap, j Real & temp, temp1, temp2 c c %--------------------% c | External Functions | c %--------------------% c Real & slapy2 external slapy2 c c %-----------------------% c | Executable Statements | c %-----------------------% c igap = n / 2 c if (which .eq. 'LM') then c c %------------------------------------------------------% c | Sort XREAL,XIMAG into increasing order of magnitude. | c %------------------------------------------------------% c 10 continue if (igap .eq. 0) go to 9000 c do 30 i = igap, n-1 j = i-igap 20 continue c if (j.lt.0) go to 30 c temp1 = slapy2(xreal(j),ximag(j)) temp2 = slapy2(xreal(j+igap),ximag(j+igap)) c if (temp1.gt.temp2) then temp = xreal(j) xreal(j) = xreal(j+igap) xreal(j+igap) = temp c temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 30 end if j = j-igap go to 20 30 continue igap = igap / 2 go to 10 c else if (which .eq. 'SM') then c c %------------------------------------------------------% c | Sort XREAL,XIMAG into decreasing order of magnitude. | c %------------------------------------------------------% c 40 continue if (igap .eq. 0) go to 9000 c do 60 i = igap, n-1 j = i-igap 50 continue c if (j .lt. 0) go to 60 c temp1 = slapy2(xreal(j),ximag(j)) temp2 = slapy2(xreal(j+igap),ximag(j+igap)) c if (temp1.lt.temp2) then temp = xreal(j) xreal(j) = xreal(j+igap) xreal(j+igap) = temp c temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 60 endif j = j-igap go to 50 60 continue igap = igap / 2 go to 40 c else if (which .eq. 'LR') then c c %------------------------------------------------% c | Sort XREAL into increasing order of algebraic. | c %------------------------------------------------% c 70 continue if (igap .eq. 0) go to 9000 c do 90 i = igap, n-1 j = i-igap 80 continue c if (j.lt.0) go to 90 c if (xreal(j).gt.xreal(j+igap)) then temp = xreal(j) xreal(j) = xreal(j+igap) xreal(j+igap) = temp c temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 90 endif j = j-igap go to 80 90 continue igap = igap / 2 go to 70 c else if (which .eq. 'SR') then c c %------------------------------------------------% c | Sort XREAL into decreasing order of algebraic. | c %------------------------------------------------% c 100 continue if (igap .eq. 0) go to 9000 do 120 i = igap, n-1 j = i-igap 110 continue c if (j.lt.0) go to 120 c if (xreal(j).lt.xreal(j+igap)) then temp = xreal(j) xreal(j) = xreal(j+igap) xreal(j+igap) = temp c temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 120 endif j = j-igap go to 110 120 continue igap = igap / 2 go to 100 c else if (which .eq. 'LI') then c c %------------------------------------------------% c | Sort XIMAG into increasing order of magnitude. | c %------------------------------------------------% c 130 continue if (igap .eq. 0) go to 9000 do 150 i = igap, n-1 j = i-igap 140 continue c if (j.lt.0) go to 150 c if (abs(ximag(j)).gt.abs(ximag(j+igap))) then temp = xreal(j) xreal(j) = xreal(j+igap) xreal(j+igap) = temp c temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 150 endif j = j-igap go to 140 150 continue igap = igap / 2 go to 130 c else if (which .eq. 'SI') then c c %------------------------------------------------% c | Sort XIMAG into decreasing order of magnitude. | c %------------------------------------------------% c 160 continue if (igap .eq. 0) go to 9000 do 180 i = igap, n-1 j = i-igap 170 continue c if (j.lt.0) go to 180 c if (abs(ximag(j)).lt.abs(ximag(j+igap))) then temp = xreal(j) xreal(j) = xreal(j+igap) xreal(j+igap) = temp c temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp c if (apply) then temp = y(j) y(j) = y(j+igap) y(j+igap) = temp end if else go to 180 endif j = j-igap go to 170 180 continue igap = igap / 2 go to 160 end if c 9000 continue return c c %---------------% c | End of ssortc | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/cngets.f000644 001750 001750 00000012673 11266605602 022111 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: cngets c c\Description: c Given the eigenvalues of the upper Hessenberg matrix H, c computes the NP shifts AMU that are zeros of the polynomial of c degree NP which filters out components of the unwanted eigenvectors c corresponding to the AMU's based on some given criteria. c c NOTE: call this even in the case of user specified shifts in order c to sort the eigenvalues, and error bounds of H for later use. c c\Usage: c call cngets c ( ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS ) c c\Arguments c ISHIFT Integer. (INPUT) c Method for selecting the implicit shifts at each iteration. c ISHIFT = 0: user specified shifts c ISHIFT = 1: exact shift with respect to the matrix H. c c WHICH Character*2. (INPUT) c Shift selection criteria. c 'LM' -> want the KEV eigenvalues of largest magnitude. c 'SM' -> want the KEV eigenvalues of smallest magnitude. c 'LR' -> want the KEV eigenvalues of largest REAL part. c 'SR' -> want the KEV eigenvalues of smallest REAL part. c 'LI' -> want the KEV eigenvalues of largest imaginary part. c 'SI' -> want the KEV eigenvalues of smallest imaginary part. c c KEV Integer. (INPUT) c The number of desired eigenvalues. c c NP Integer. (INPUT) c The number of shifts to compute. c c RITZ Complex array of length KEV+NP. (INPUT/OUTPUT) c On INPUT, RITZ contains the the eigenvalues of H. c On OUTPUT, RITZ are sorted so that the unwanted c eigenvalues are in the first NP locations and the wanted c portion is in the last KEV locations. When exact shifts are c selected, the unwanted part corresponds to the shifts to c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues c are further sorted so that the ones with largest Ritz values c are first. c c BOUNDS Complex array of length KEV+NP. (INPUT/OUTPUT) c Error bounds corresponding to the ordering in RITZ. c c c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx Complex c c\Routines called: c csortc ARPACK sorting routine. c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c cvout ARPACK utility routine that prints vectors. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: ngets.F SID: 2.2 DATE OF SID: 4/20/96 RELEASE: 2 c c\Remarks c 1. This routine does not keep complex conjugate pairs of c eigenvalues together. c c\EndLib c c----------------------------------------------------------------------- c subroutine cngets ( ishift, which, kev, np, ritz, bounds) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character*2 which integer ishift, kev, np c c %-----------------% c | Array Arguments | c %-----------------% c Complex & bounds(kev+np), ritz(kev+np) c c %------------% c | Parameters | c %------------% c Complex & one, zero parameter (one = (1.0E+0, 0.0E+0), zero = (0.0E+0, 0.0E+0)) c c %---------------% c | Local Scalars | c %---------------% c integer msglvl c c %----------------------% c | External Subroutines | c %----------------------% c external cvout, csortc, second c c %-----------------------% c | Executable Statements | c %-----------------------% c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call second (t0) msglvl = mcgets c call csortc (which, .true., kev+np, ritz, bounds) c if ( ishift .eq. 1 ) then c c %-------------------------------------------------------% c | Sort the unwanted Ritz values used as shifts so that | c | the ones with largest Ritz estimates are first | c | This will tend to minimize the effects of the | c | forward instability of the iteration when the shifts | c | are applied in subroutine cnapps. | c | Be careful and use 'SM' since we want to sort BOUNDS! | c %-------------------------------------------------------% c call csortc ( 'SM', .true., np, bounds, ritz ) c end if c call second (t1) tcgets = tcgets + (t1 - t0) c if (msglvl .gt. 0) then call ivout (logfil, 1, kev, ndigit, '_ngets: KEV is') call ivout (logfil, 1, np, ndigit, '_ngets: NP is') call cvout (logfil, kev+np, ritz, ndigit, & '_ngets: Eigenvalues of current H matrix ') call cvout (logfil, kev+np, bounds, ndigit, & '_ngets: Ritz estimates of the current KEV+NP Ritz values') end if c return c c %---------------% c | End of cngets | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/snaup2.f000644 001750 001750 00000075145 11266605602 022041 0ustar00geuzainegeuzaine000000 000000 c\BeginDoc c c\Name: snaup2 c c\Description: c Intermediate level interface called by snaupd. c c\Usage: c call snaup2 c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD, c ISHIFT, MXITER, V, LDV, H, LDH, RITZR, RITZI, BOUNDS, c Q, LDQ, WORKL, IPNTR, WORKD, INFO ) c c\Arguments c c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in snaupd. c MODE, ISHIFT, MXITER: see the definition of IPARAM in snaupd. c c NP Integer. (INPUT/OUTPUT) c Contains the number of implicit shifts to apply during c each Arnoldi iteration. c If ISHIFT=1, NP is adjusted dynamically at each iteration c to accelerate convergence and prevent stagnation. c This is also roughly equal to the number of matrix-vector c products (involving the operator OP) per Arnoldi iteration. c The logic for adjusting is contained within the current c subroutine. c If ISHIFT=0, NP is the number of shifts the user needs c to provide via reverse comunication. 0 < NP < NCV-NEV. c NP may be less than NCV-NEV for two reasons. The first, is c to keep complex conjugate pairs of "wanted" Ritz values c together. The second, is that a leading block of the current c upper Hessenberg matrix has split off and contains "unwanted" c Ritz values. c Upon termination of the IRA iteration, NP contains the number c of "converged" wanted Ritz values. c c IUPD Integer. (INPUT) c IUPD .EQ. 0: use explicit restart instead implicit update. c IUPD .NE. 0: use implicit update. c c V Real N by (NEV+NP) array. (INPUT/OUTPUT) c The Arnoldi basis vectors are returned in the first NEV c columns of V. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling c program. c c H Real (NEV+NP) by (NEV+NP) array. (OUTPUT) c H is used to store the generated upper Hessenberg matrix c c LDH Integer. (INPUT) c Leading dimension of H exactly as declared in the calling c program. c c RITZR, Real arrays of length NEV+NP. (OUTPUT) c RITZI RITZR(1:NEV) (resp. RITZI(1:NEV)) contains the real (resp. c imaginary) part of the computed Ritz values of OP. c c BOUNDS Real array of length NEV+NP. (OUTPUT) c BOUNDS(1:NEV) contain the error bounds corresponding to c the computed Ritz values. c c Q Real (NEV+NP) by (NEV+NP) array. (WORKSPACE) c Private (replicated) work array used to accumulate the c rotation in the shift application step. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. c c WORKL Real work array of length at least c (NEV+NP)**2 + 3*(NEV+NP). (INPUT/WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. It is used in shifts calculation, shifts c application and convergence checking. c c On exit, the last 3*(NEV+NP) locations of WORKL contain c the Ritz values (real,imaginary) and associated Ritz c estimates of the current Hessenberg matrix. They are c listed in the same order as returned from sneigh. c c If ISHIFT .EQ. O and IDO .EQ. 3, the first 2*NP locations c of WORKL are used in reverse communication to hold the user c supplied shifts. c c IPNTR Integer array of length 3. (OUTPUT) c Pointer to mark the starting locations in the WORKD for c vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. c IPNTR(3): pointer to the vector B * X when used in the c shift-and-invert mode. X is the current operand. c ------------------------------------------------------------- c c WORKD Real work array of length 3*N. (WORKSPACE) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration !!!!!!!!!! c See Data Distribution Note in DNAUPD. c c INFO Integer. (INPUT/OUTPUT) c If INFO .EQ. 0, a randomly initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c Error flag on output. c = 0: Normal return. c = 1: Maximum number of iterations taken. c All possible eigenvalues of OP has been found. c NP returns the number of converged Ritz values. c = 2: No shifts could be applied. c = -8: Error return from LAPACK eigenvalue calculation; c This should never happen. c = -9: Starting vector is zero. c = -9999: Could not build an Arnoldi factorization. c Size that was built in returned in NP. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Local variables: c xxxxxx real c c\References: c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: c sgetv0 ARPACK initial vector generation routine. c snaitr ARPACK Arnoldi factorization routine. c snapps ARPACK application of implicit shifts routine. c snconv ARPACK convergence of Ritz values routine. c sneigh ARPACK compute Ritz values and error bounds routine. c sngets ARPACK reorder Ritz values and error bounds routine. c ssortc ARPACK sorting routine. c ivout ARPACK utility routine that prints integers. c second ARPACK utility routine for timing. c smout ARPACK utility routine that prints matrices c svout ARPACK utility routine that prints vectors. c slamch LAPACK routine that determines machine constants. c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c scopy Level 1 BLAS that copies one vector to another . c sdot Level 1 BLAS that computes the scalar product of two vectors. c snrm2 Level 1 BLAS that computes the norm of a vector. c sswap Level 1 BLAS that swaps two vectors. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: naup2.F SID: 2.8 DATE OF SID: 10/17/00 RELEASE: 2 c c\Remarks c 1. None c c\EndLib c c----------------------------------------------------------------------- c subroutine snaup2 & ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd, & ishift, mxiter, v, ldv, h, ldh, ritzr, ritzi, bounds, & q, ldq, workl, ipntr, workd, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c character bmat*1, which*2 integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter, & n, nev, np Real & tol c c %-----------------% c | Array Arguments | c %-----------------% c integer ipntr(13) Real & bounds(nev+np), h(ldh,nev+np), q(ldq,nev+np), resid(n), & ritzi(nev+np), ritzr(nev+np), v(ldv,nev+np), & workd(3*n), workl( (nev+np)*(nev+np+3) ) c c %------------% c | Parameters | c %------------% c Real & one, zero parameter (one = 1.0E+0, zero = 0.0E+0) c c %---------------% c | Local Scalars | c %---------------% c character wprime*2 logical cnorm , getv0, initv, update, ushift integer ierr , iter , j , kplusp, msglvl, nconv, & nevbef, nev0 , np0 , nptemp, numcnv Real & rnorm , temp , eps23 save cnorm , getv0, initv, update, ushift, & rnorm , iter , eps23, kplusp, msglvl, nconv , & nevbef, nev0 , np0 , numcnv c c %-----------------------% c | Local array arguments | c %-----------------------% c integer kp(4) c c %----------------------% c | External Subroutines | c %----------------------% c external scopy , sgetv0, snaitr, snconv, sneigh, & sngets, snapps, svout , ivout , second c c %--------------------% c | External Functions | c %--------------------% c Real & sdot, snrm2, slapy2, slamch external sdot, snrm2, slapy2, slamch c c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic min, max, abs, sqrt c c %-----------------------% c | Executable Statements | c %-----------------------% c if (ido .eq. 0) then c call second (t0) c msglvl = mnaup2 c c %-------------------------------------% c | Get the machine dependent constant. | c %-------------------------------------% c eps23 = slamch('Epsilon-Machine') eps23 = eps23**(2.0E+0 / 3.0E+0) c nev0 = nev np0 = np c c %-------------------------------------% c | kplusp is the bound on the largest | c | Lanczos factorization built. | c | nconv is the current number of | c | "converged" eigenvlues. | c | iter is the counter on the current | c | iteration step. | c %-------------------------------------% c kplusp = nev + np nconv = 0 iter = 0 c c %---------------------------------------% c | Set flags for computing the first NEV | c | steps of the Arnoldi factorization. | c %---------------------------------------% c getv0 = .true. update = .false. ushift = .false. cnorm = .false. c if (info .ne. 0) then c c %--------------------------------------------% c | User provides the initial residual vector. | c %--------------------------------------------% c initv = .true. info = 0 else initv = .false. end if end if c c %---------------------------------------------% c | Get a possibly random starting vector and | c | force it into the range of the operator OP. | c %---------------------------------------------% c 10 continue c if (getv0) then call sgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, rnorm, & ipntr, workd, info) c if (ido .ne. 99) go to 9000 c if (rnorm .eq. zero) then c c %-----------------------------------------% c | The initial vector is zero. Error exit. | c %-----------------------------------------% c info = -9 go to 1100 end if getv0 = .false. ido = 0 end if c c %-----------------------------------% c | Back from reverse communication : | c | continue with update step | c %-----------------------------------% c if (update) go to 20 c c %-------------------------------------------% c | Back from computing user specified shifts | c %-------------------------------------------% c if (ushift) go to 50 c c %-------------------------------------% c | Back from computing residual norm | c | at the end of the current iteration | c %-------------------------------------% c if (cnorm) go to 100 c c %----------------------------------------------------------% c | Compute the first NEV steps of the Arnoldi factorization | c %----------------------------------------------------------% c call snaitr (ido, bmat, n, 0, nev, mode, resid, rnorm, v, ldv, & h, ldh, ipntr, workd, info) c c %---------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP and possibly B | c %---------------------------------------------------% c if (ido .ne. 99) go to 9000 c if (info .gt. 0) then np = info mxiter = iter info = -9999 go to 1200 end if c c %--------------------------------------------------------------% c | | c | M A I N ARNOLDI I T E R A T I O N L O O P | c | Each iteration implicitly restarts the Arnoldi | c | factorization in place. | c | | c %--------------------------------------------------------------% c 1000 continue c iter = iter + 1 c if (msglvl .gt. 0) then call ivout (logfil, 1, iter, ndigit, & '_naup2: **** Start of major iteration number ****') end if c c %-----------------------------------------------------------% c | Compute NP additional steps of the Arnoldi factorization. | c | Adjust NP since NEV might have been updated by last call | c | to the shift application routine snapps. | c %-----------------------------------------------------------% c np = kplusp - nev c if (msglvl .gt. 1) then call ivout (logfil, 1, nev, ndigit, & '_naup2: The length of the current Arnoldi factorization') call ivout (logfil, 1, np, ndigit, & '_naup2: Extend the Arnoldi factorization by') end if c c %-----------------------------------------------------------% c | Compute NP additional steps of the Arnoldi factorization. | c %-----------------------------------------------------------% c ido = 0 20 continue update = .true. c call snaitr (ido , bmat, n , nev, np , mode , resid, & rnorm, v , ldv, h , ldh, ipntr, workd, & info) c c %---------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP and possibly B | c %---------------------------------------------------% c if (ido .ne. 99) go to 9000 c if (info .gt. 0) then np = info mxiter = iter info = -9999 go to 1200 end if update = .false. c if (msglvl .gt. 1) then call svout (logfil, 1, rnorm, ndigit, & '_naup2: Corresponding B-norm of the residual') end if c c %--------------------------------------------------------% c | Compute the eigenvalues and corresponding error bounds | c | of the current upper Hessenberg matrix. | c %--------------------------------------------------------% c call sneigh (rnorm, kplusp, h, ldh, ritzr, ritzi, bounds, & q, ldq, workl, ierr) c if (ierr .ne. 0) then info = -8 go to 1200 end if c c %----------------------------------------------------% c | Make a copy of eigenvalues and corresponding error | c | bounds obtained from sneigh. | c %----------------------------------------------------% c call scopy(kplusp, ritzr, 1, workl(kplusp**2+1), 1) call scopy(kplusp, ritzi, 1, workl(kplusp**2+kplusp+1), 1) call scopy(kplusp, bounds, 1, workl(kplusp**2+2*kplusp+1), 1) c c %---------------------------------------------------% c | Select the wanted Ritz values and their bounds | c | to be used in the convergence test. | c | The wanted part of the spectrum and corresponding | c | error bounds are in the last NEV loc. of RITZR, | c | RITZI and BOUNDS respectively. The variables NEV | c | and NP may be updated if the NEV-th wanted Ritz | c | value has a non zero imaginary part. In this case | c | NEV is increased by one and NP decreased by one. | c | NOTE: The last two arguments of sngets are no | c | longer used as of version 2.1. | c %---------------------------------------------------% c nev = nev0 np = np0 numcnv = nev call sngets (ishift, which, nev, np, ritzr, ritzi, & bounds, workl, workl(np+1)) if (nev .eq. nev0+1) numcnv = nev0+1 c c %-------------------% c | Convergence test. | c %-------------------% c call scopy (nev, bounds(np+1), 1, workl(2*np+1), 1) call snconv (nev, ritzr(np+1), ritzi(np+1), workl(2*np+1), & tol, nconv) c if (msglvl .gt. 2) then kp(1) = nev kp(2) = np kp(3) = numcnv kp(4) = nconv call ivout (logfil, 4, kp, ndigit, & '_naup2: NEV, NP, NUMCNV, NCONV are') call svout (logfil, kplusp, ritzr, ndigit, & '_naup2: Real part of the eigenvalues of H') call svout (logfil, kplusp, ritzi, ndigit, & '_naup2: Imaginary part of the eigenvalues of H') call svout (logfil, kplusp, bounds, ndigit, & '_naup2: Ritz estimates of the current NCV Ritz values') end if c c %---------------------------------------------------------% c | Count the number of unwanted Ritz values that have zero | c | Ritz estimates. If any Ritz estimates are equal to zero | c | then a leading block of H of order equal to at least | c | the number of Ritz values with zero Ritz estimates has | c | split off. None of these Ritz values may be removed by | c | shifting. Decrease NP the number of shifts to apply. If | c | no shifts may be applied, then prepare to exit | c %---------------------------------------------------------% c nptemp = np do 30 j=1, nptemp if (bounds(j) .eq. zero) then np = np - 1 nev = nev + 1 end if 30 continue c if ( (nconv .ge. numcnv) .or. & (iter .gt. mxiter) .or. & (np .eq. 0) ) then c if (msglvl .gt. 4) then call svout(logfil, kplusp, workl(kplusp**2+1), ndigit, & '_naup2: Real part of the eig computed by _neigh:') call svout(logfil, kplusp, workl(kplusp**2+kplusp+1), & ndigit, & '_naup2: Imag part of the eig computed by _neigh:') call svout(logfil, kplusp, workl(kplusp**2+kplusp*2+1), & ndigit, & '_naup2: Ritz eistmates computed by _neigh:') end if c c %------------------------------------------------% c | Prepare to exit. Put the converged Ritz values | c | and corresponding bounds in RITZ(1:NCONV) and | c | BOUNDS(1:NCONV) respectively. Then sort. Be | c | careful when NCONV > NP | c %------------------------------------------------% c c %------------------------------------------% c | Use h( 3,1 ) as storage to communicate | c | rnorm to _neupd if needed | c %------------------------------------------% h(3,1) = rnorm c c %----------------------------------------------% c | To be consistent with sngets, we first do a | c | pre-processing sort in order to keep complex | c | conjugate pairs together. This is similar | c | to the pre-processing sort used in sngets | c | except that the sort is done in the opposite | c | order. | c %----------------------------------------------% c if (which .eq. 'LM') wprime = 'SR' if (which .eq. 'SM') wprime = 'LR' if (which .eq. 'LR') wprime = 'SM' if (which .eq. 'SR') wprime = 'LM' if (which .eq. 'LI') wprime = 'SM' if (which .eq. 'SI') wprime = 'LM' c call ssortc (wprime, .true., kplusp, ritzr, ritzi, bounds) c c %----------------------------------------------% c | Now sort Ritz values so that converged Ritz | c | values appear within the first NEV locations | c | of ritzr, ritzi and bounds, and the most | c | desired one appears at the front. | c %----------------------------------------------% c if (which .eq. 'LM') wprime = 'SM' if (which .eq. 'SM') wprime = 'LM' if (which .eq. 'LR') wprime = 'SR' if (which .eq. 'SR') wprime = 'LR' if (which .eq. 'LI') wprime = 'SI' if (which .eq. 'SI') wprime = 'LI' c call ssortc(wprime, .true., kplusp, ritzr, ritzi, bounds) c c %--------------------------------------------------% c | Scale the Ritz estimate of each Ritz value | c | by 1 / max(eps23,magnitude of the Ritz value). | c %--------------------------------------------------% c do 35 j = 1, numcnv temp = max(eps23,slapy2(ritzr(j), & ritzi(j))) bounds(j) = bounds(j)/temp 35 continue c c %----------------------------------------------------% c | Sort the Ritz values according to the scaled Ritz | c | esitmates. This will push all the converged ones | c | towards the front of ritzr, ritzi, bounds | c | (in the case when NCONV < NEV.) | c %----------------------------------------------------% c wprime = 'LR' call ssortc(wprime, .true., numcnv, bounds, ritzr, ritzi) c c %----------------------------------------------% c | Scale the Ritz estimate back to its original | c | value. | c %----------------------------------------------% c do 40 j = 1, numcnv temp = max(eps23, slapy2(ritzr(j), & ritzi(j))) bounds(j) = bounds(j)*temp 40 continue c c %------------------------------------------------% c | Sort the converged Ritz values again so that | c | the "threshold" value appears at the front of | c | ritzr, ritzi and bound. | c %------------------------------------------------% c call ssortc(which, .true., nconv, ritzr, ritzi, bounds) c if (msglvl .gt. 1) then call svout (logfil, kplusp, ritzr, ndigit, & '_naup2: Sorted real part of the eigenvalues') call svout (logfil, kplusp, ritzi, ndigit, & '_naup2: Sorted imaginary part of the eigenvalues') call svout (logfil, kplusp, bounds, ndigit, & '_naup2: Sorted ritz estimates.') end if c c %------------------------------------% c | Max iterations have been exceeded. | c %------------------------------------% c if (iter .gt. mxiter .and. nconv .lt. numcnv) info = 1 c c %---------------------% c | No shifts to apply. | c %---------------------% c if (np .eq. 0 .and. nconv .lt. numcnv) info = 2 c np = nconv go to 1100 c else if ( (nconv .lt. numcnv) .and. (ishift .eq. 1) ) then c c %-------------------------------------------------% c | Do not have all the requested eigenvalues yet. | c | To prevent possible stagnation, adjust the size | c | of NEV. | c %-------------------------------------------------% c nevbef = nev nev = nev + min(nconv, np/2) if (nev .eq. 1 .and. kplusp .ge. 6) then nev = kplusp / 2 else if (nev .eq. 1 .and. kplusp .gt. 3) then nev = 2 end if np = kplusp - nev c c %---------------------------------------% c | If the size of NEV was just increased | c | resort the eigenvalues. | c %---------------------------------------% c if (nevbef .lt. nev) & call sngets (ishift, which, nev, np, ritzr, ritzi, & bounds, workl, workl(np+1)) c end if c if (msglvl .gt. 0) then call ivout (logfil, 1, nconv, ndigit, & '_naup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev kp(2) = np call ivout (logfil, 2, kp, ndigit, & '_naup2: NEV and NP are') call svout (logfil, nev, ritzr(np+1), ndigit, & '_naup2: "wanted" Ritz values -- real part') call svout (logfil, nev, ritzi(np+1), ndigit, & '_naup2: "wanted" Ritz values -- imag part') call svout (logfil, nev, bounds(np+1), ndigit, & '_naup2: Ritz estimates of the "wanted" values ') end if end if c if (ishift .eq. 0) then c c %-------------------------------------------------------% c | User specified shifts: reverse comminucation to | c | compute the shifts. They are returned in the first | c | 2*NP locations of WORKL. | c %-------------------------------------------------------% c ushift = .true. ido = 3 go to 9000 end if c 50 continue c c %------------------------------------% c | Back from reverse communication; | c | User specified shifts are returned | c | in WORKL(1:2*NP) | c %------------------------------------% c ushift = .false. c if ( ishift .eq. 0 ) then c c %----------------------------------% c | Move the NP shifts from WORKL to | c | RITZR, RITZI to free up WORKL | c | for non-exact shift case. | c %----------------------------------% c call scopy (np, workl, 1, ritzr, 1) call scopy (np, workl(np+1), 1, ritzi, 1) end if c if (msglvl .gt. 2) then call ivout (logfil, 1, np, ndigit, & '_naup2: The number of shifts to apply ') call svout (logfil, np, ritzr, ndigit, & '_naup2: Real part of the shifts') call svout (logfil, np, ritzi, ndigit, & '_naup2: Imaginary part of the shifts') if ( ishift .eq. 1 ) & call svout (logfil, np, bounds, ndigit, & '_naup2: Ritz estimates of the shifts') end if c c %---------------------------------------------------------% c | Apply the NP implicit shifts by QR bulge chasing. | c | Each shift is applied to the whole upper Hessenberg | c | matrix H. | c | The first 2*N locations of WORKD are used as workspace. | c %---------------------------------------------------------% c call snapps (n, nev, np, ritzr, ritzi, v, ldv, & h, ldh, resid, q, ldq, workl, workd) c c %---------------------------------------------% c | Compute the B-norm of the updated residual. | c | Keep B*RESID in WORKD(1:N) to be used in | c | the first step of the next call to snaitr. | c %---------------------------------------------% c cnorm = .true. call second (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call scopy (n, resid, 1, workd(n+1), 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 c c %----------------------------------% c | Exit in order to compute B*RESID | c %----------------------------------% c go to 9000 else if (bmat .eq. 'I') then call scopy (n, resid, 1, workd, 1) end if c 100 continue c c %----------------------------------% c | Back from reverse communication; | c | WORKD(1:N) := B*RESID | c %----------------------------------% c if (bmat .eq. 'G') then call second (t3) tmvbx = tmvbx + (t3 - t2) end if c if (bmat .eq. 'G') then rnorm = sdot (n, resid, 1, workd, 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then rnorm = snrm2(n, resid, 1) end if cnorm = .false. c if (msglvl .gt. 2) then call svout (logfil, 1, rnorm, ndigit, & '_naup2: B-norm of residual for compressed factorization') call smout (logfil, nev, nev, h, ldh, ndigit, & '_naup2: Compressed upper Hessenberg matrix H') end if c go to 1000 c c %---------------------------------------------------------------% c | | c | E N D O F M A I N I T E R A T I O N L O O P | c | | c %---------------------------------------------------------------% c 1100 continue c mxiter = iter nev = numcnv c 1200 continue ido = 99 c c %------------% c | Error Exit | c %------------% c call second (t1) tnaup2 = t1 - t0 c 9000 continue c c %---------------% c | End of snaup2 | c %---------------% c return end getdp-2.7.0-source/contrib/Arpack/ssconv.f000644 001750 001750 00000006456 11266605602 022143 0ustar00geuzainegeuzaine000000 000000 c----------------------------------------------------------------------- c\BeginDoc c c\Name: ssconv c c\Description: c Convergence testing for the symmetric Arnoldi eigenvalue routine. c c\Usage: c call ssconv c ( N, RITZ, BOUNDS, TOL, NCONV ) c c\Arguments c N Integer. (INPUT) c Number of Ritz values to check for convergence. c c RITZ Real array of length N. (INPUT) c The Ritz values to be checked for convergence. c c BOUNDS Real array of length N. (INPUT) c Ritz estimates associated with the Ritz values in RITZ. c c TOL Real scalar. (INPUT) c Desired relative accuracy for a Ritz value to be considered c "converged". c c NCONV Integer scalar. (OUTPUT) c Number of "converged" Ritz values. c c\EndDoc c c----------------------------------------------------------------------- c c\BeginLib c c\Routines called: c second ARPACK utility routine for timing. c slamch LAPACK routine that determines machine constants. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics c Rice University c Houston, Texas c c\SCCS Information: @(#) c FILE: sconv.F SID: 2.4 DATE OF SID: 4/19/96 RELEASE: 2 c c\Remarks c 1. Starting with version 2.4, this routine no longer uses the c Parlett strategy using the gap conditions. c c\EndLib c c----------------------------------------------------------------------- c subroutine ssconv (n, ritz, bounds, tol, nconv) c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% c include 'debug.h' include 'stat.h' c c %------------------% c | Scalar Arguments | c %------------------% c integer n, nconv Real & tol c c %-----------------% c | Array Arguments | c %-----------------% c Real & ritz(n), bounds(n) c c %---------------% c | Local Scalars | c %---------------% c integer i Real & temp, eps23 c c %-------------------% c | External routines | c %-------------------% c Real & slamch external slamch c %---------------------% c | Intrinsic Functions | c %---------------------% c intrinsic abs c c %-----------------------% c | Executable Statements | c %-----------------------% c call second (t0) c eps23 = slamch('Epsilon-Machine') eps23 = eps23**(2.0E+0 / 3.0E+0) c nconv = 0 do 10 i = 1, n c c %-----------------------------------------------------% c | The i-th Ritz value is considered "converged" | c | when: bounds(i) .le. TOL*max(eps23, abs(ritz(i))) | c %-----------------------------------------------------% c temp = max( eps23, abs(ritz(i)) ) if ( bounds(i) .le. tol*temp ) then nconv = nconv + 1 end if c 10 continue c call second (t1) tsconv = tsconv + (t1 - t0) c return c c %---------------% c | End of ssconv | c %---------------% c end getdp-2.7.0-source/contrib/Arpack/dnaupe.f000644 001750 001750 00000000000 11266605602 022057 0ustar00geuzainegeuzaine000000 000000 getdp-2.7.0-source/contrib/Sparskit/inout.f000644 001750 001750 00000155116 11266605601 022362 0ustar00geuzainegeuzaine000000 000000 c $Id: inout.f,v 1.1 2008-04-11 06:01:06 geuzaine Exp $ c----------------------------------------------------------------------c subroutine psplot (ncol,ja,ia,iunt,mode) integer ja(*),ia(*),iunt,ncol,id,mode call pspltm (ncol, ncol, mode, ja, ia, ' ', & 0, 5.0, "in", 0, id, iunt) return end c----------------------------------------------------------------------c c S P A R S K I T c c----------------------------------------------------------------------c C INPUT-OUTPUT MODULE c c----------------------------------------------------------------------c c contents: c c---------- c c readmt : reads matrices in the Boeing/Harwell format. c c prtmt : prints matrices in the Boeing/Harwell format. c c dump : outputs matrix rows in a simple format (debugging purposes)c c pspltm : generates a post-script plot of the non-zero pattern of A c c pltmt : produces a 'pic' file for plotting a sparse matrix c c smms : write the matrx in a format used in SMMS package c c readsm : reads matrics in coordinate format (as in SMMS package) c c readsk : reads matrices in CSR format (simplified H/B formate). c c skit : writes matrics to a file, format same as above. c c prtunf : writes matrics (in CSR format) unformatted c c readunf: reads unformatted data of matrics (in CSR format) c c----------------------------------------------------------------------c subroutine readmt (nmax,nzmax,job,iounit,a,ja,ia,rhs,nrhs, * guesol,nrow,ncol,nnz,title,key,type,ierr) c----------------------------------------------------------------------- c this subroutine reads a boeing/harwell matrix. handles right hand c sides in full format only (no sparse right hand sides). c Also the matrix must be in assembled forms. c Author: Youcef Saad - Date: Sept., 1989 c updated Oct 31, 1989. c----------------------------------------------------------------------- c on entry: c--------- c nmax = max column dimension allowed for matrix. The array ia should c be of length at least ncol+1 (see below) if job.gt.0 c nzmax = max number of nonzeros elements allowed. the arrays a, c and ja should be of length equal to nnz (see below) if these c arrays are to be read (see job). c c job = integer to indicate what is to be read. (note: job is an c input and output parameter, it can be modified on return) c job = 0 read the values of ncol, nrow, nnz, title, key, c type and return. matrix is not read and arrays c a, ja, ia, rhs are not touched. c job = 1 read srtucture only, i.e., the arrays ja and ia. c job = 2 read matrix including values, i.e., a, ja, ia c job = 3 read matrix and right hand sides: a,ja,ia,rhs. c rhs may contain initial guesses and exact c solutions appended to the actual right hand sides. c this will be indicated by the output parameter c guesol [see below]. c c nrhs = integer. nrhs is an input as well as ouput parameter. c at input nrhs contains the total length of the array rhs. c See also ierr and nrhs in output parameters. c c iounit = logical unit number where to read the matrix from. c c on return: c---------- c job = on return job may be modified to the highest job it could c do: if job=2 on entry but no matrix values are available it c is reset to job=1 on return. Similarly of job=3 but no rhs c is provided then it is rest to job=2 or job=1 depending on c whether or not matrix values are provided. c Note that no error message is triggered (i.e. ierr = 0 c on return in these cases. It is therefore important to c compare the values of job on entry and return ). c c a = the a matrix in the a, ia, ja (column) storage format c ja = column number of element a(i,j) in array a. c ia = pointer array. ia(i) points to the beginning of column i. c c rhs = real array of size nrow + 1 if available (see job) c c nrhs = integer containing the number of right-hand sides found c each right hand side may be accompanied with an intial guess c and also the exact solution. c c guesol = a 2-character string indicating whether an initial guess c (1-st character) and / or the exact solution (2-nd c character) is provided with the right hand side. c if the first character of guesol is 'G' it means that an c an intial guess is provided for each right-hand side. c These are appended to the right hand-sides in the array rhs. c if the second character of guesol is 'X' it means that an c exact solution is provided for each right-hand side. c These are appended to the right hand-sides c and the initial guesses (if any) in the array rhs. c c nrow = number of rows in matrix c ncol = number of columns in matrix c nnz = number of nonzero elements in A. This info is returned c even if there is not enough space in a, ja, ia, in order c to determine the minimum storage needed. c c title = character*72 = title of matrix test ( character a*72). c key = character*8 = key of matrix c type = charatcer*3 = type of matrix. c for meaning of title, key and type refer to documentation c Harwell/Boeing matrices. c c ierr = integer used for error messages c * ierr = 0 means that the matrix has been read normally. c * ierr = 1 means that the array matrix could not be read c because ncol+1 .gt. nmax c * ierr = 2 means that the array matrix could not be read c because nnz .gt. nzmax c * ierr = 3 means that the array matrix could not be read c because both (ncol+1 .gt. nmax) and (nnz .gt. nzmax ) c * ierr = 4 means that the right hand side (s) initial c guesse (s) and exact solution (s) could not be c read because they are stored in sparse format (not handled c by this routine ...) c * ierr = 5 means that the right-hand-sides, initial guesses c and exact solutions could not be read because the length of c rhs as specified by the input value of nrhs is not c sufficient to store them. The rest of the matrix may have c been read normally. c c Notes: c------- c 1) The file inout must be open (and possibly rewound if necessary) c prior to calling readmt. c 2) Refer to the documentation on the Harwell-Boeing formats c for details on the format assumed by readmt. c We summarize the format here for convenience. c c a) all lines in inout are assumed to be 80 character long. c b) the file consists of a header followed by the block of the c column start pointers followed by the block of the c row indices, followed by the block of the real values and c finally the numerical values of the right-hand-side if a c right hand side is supplied. c c) the file starts by a header which contains four lines if no c right hand side is supplied and five lines otherwise. c * first line contains the title (72 characters long) followed by c the 8-character identifier (name of the matrix, called key) c [ A72,A8 ] c * second line contains the number of lines for each c of the following data blocks (4 of them) and the total number c of lines excluding the header. c [5i4] c * the third line contains a three character string identifying c the type of matrices as they are referenced in the Harwell c Boeing documentation [e.g., rua, rsa,..] and the number of c rows, columns, nonzero entries. c [A3,11X,4I14] c * The fourth line contains the variable fortran format c for the following data blocks. c [2A16,2A20] c * The fifth line is only present if right-hand-sides are c supplied. It consists of three one character-strings containing c the storage format for the right-hand-sides c ('F'= full,'M'=sparse=same as matrix), an initial guess c indicator ('G' for yes), an exact solution indicator c ('X' for yes), followed by the number of right-hand-sides c and then the number of row indices. c [A3,11X,2I14] c d) The three following blocks follow the header as described c above. c e) In case the right hand-side are in sparse formats then c the fourth block uses the same storage format as for the matrix c to describe the NRHS right hand sides provided, with a column c being replaced by a right hand side. c----------------------------------------------------------------------- character title*72, key*8, type*3, ptrfmt*16, indfmt*16, 1 valfmt*20, rhsfmt*20, rhstyp*3, guesol*2 integer totcrd, ptrcrd, indcrd, valcrd, rhscrd, nrow, ncol, 1 nnz, neltvl, nrhs, nmax, nzmax, nrwindx integer ia (nmax+1), ja (nzmax) real*8 a(nzmax), rhs(*) c----------------------------------------------------------------------- ierr = 0 lenrhs = nrhs c read (iounit,10) title, key, totcrd, ptrcrd, indcrd, valcrd, 1 rhscrd, type, nrow, ncol, nnz, neltvl, ptrfmt, indfmt, 2 valfmt, rhsfmt 10 format (a72, a8 / 5i14 / a3, 11x, 4i14 / 2a16, 2a20) c if (rhscrd .gt. 0) read (iounit,11) rhstyp, nrhs, nrwindx 11 format (a3,11x,i14,i14) c c anything else to read ? c if (job .le. 0) return c ---- check whether matrix is readable ------ n = ncol if (ncol .gt. nmax) ierr = 1 if (nnz .gt. nzmax) ierr = ierr + 2 if (ierr .ne. 0) return c ---- read pointer and row numbers ---------- read (iounit,ptrfmt) (ia (i), i = 1, n+1) read (iounit,indfmt) (ja (i), i = 1, nnz) c --- reading values of matrix if required.... if (job .le. 1) return c --- and if available ----------------------- if (valcrd .le. 0) then job = 1 return endif read (iounit,valfmt) (a(i), i = 1, nnz) c --- reading rhs if required ---------------- if (job .le. 2) return c --- and if available ----------------------- if ( rhscrd .le. 0) then job = 2 return endif c c --- read right-hand-side.-------------------- c if (rhstyp(1:1) .eq. 'M') then ierr = 4 return endif c guesol = rhstyp(2:3) c nvec = 1 if (guesol(1:1) .eq. 'G' .or. guesol(1:1) .eq. 'g') nvec=nvec+1 if (guesol(2:2) .eq. 'X' .or. guesol(2:2) .eq. 'x') nvec=nvec+1 c len = nrhs*nrow c if (len*nvec .gt. lenrhs) then ierr = 5 return endif c c read right-hand-sides c next = 1 iend = len read(iounit,rhsfmt) (rhs(i), i = next, iend) c c read initial guesses if available c if (guesol(1:1) .eq. 'G' .or. guesol(1:1) .eq. 'g') then next = next+len iend = iend+ len read(iounit,valfmt) (rhs(i), i = next, iend) endif c c read exact solutions if available c if (guesol(2:2) .eq. 'X' .or. guesol(2:2) .eq. 'x') then next = next+len iend = iend+ len read(iounit,valfmt) (rhs(i), i = next, iend) endif c return c--------- end of readmt ----------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine prtmt (nrow,ncol,a,ja,ia,rhs,guesol,title,key,type, 1 ifmt,job,iounit) c----------------------------------------------------------------------- c writes a matrix in Harwell-Boeing format into a file. c assumes that the matrix is stored in COMPRESSED SPARSE COLUMN FORMAT. c some limited functionality for right hand sides. c Author: Youcef Saad - Date: Sept., 1989 - updated Oct. 31, 1989 to c cope with new format. c----------------------------------------------------------------------- c on entry: c--------- c nrow = number of rows in matrix c ncol = number of columns in matrix c a = real*8 array containing the values of the matrix stored c columnwise c ja = integer array of the same length as a containing the column c indices of the corresponding matrix elements of array a. c ia = integer array of containing the pointers to the beginning of c the row in arrays a and ja. c rhs = real array containing the right-hand-side (s) and optionally c the associated initial guesses and/or exact solutions c in this order. See also guesol for details. the vector rhs will c be used only if job .gt. 2 (see below). Only full storage for c the right hand sides is supported. c c guesol = a 2-character string indicating whether an initial guess c (1-st character) and / or the exact solution (2-nd) c character) is provided with the right hand side. c if the first character of guesol is 'G' it means that an c an intial guess is provided for each right-hand sides. c These are assumed to be appended to the right hand-sides in c the array rhs. c if the second character of guesol is 'X' it means that an c exact solution is provided for each right-hand side. c These are assumed to be appended to the right hand-sides c and the initial guesses (if any) in the array rhs. c c title = character*72 = title of matrix test ( character a*72 ). c key = character*8 = key of matrix c type = charatcer*3 = type of matrix. c c ifmt = integer specifying the format chosen for the real values c to be output (i.e., for a, and for rhs-guess-sol if c applicable). The meaning of ifmt is as follows. c * if (ifmt .lt. 100) then the D descriptor is used, c format Dd.m, in which the length (m) of the mantissa is c precisely the integer ifmt (and d = ifmt+6) c * if (ifmt .gt. 100) then prtmt will use the c F- descriptor (format Fd.m) in which the length of the c mantissa (m) is the integer mod(ifmt,100) and the length c of the integer part is k=ifmt/100 (and d = k+m+2) c Thus ifmt= 4 means D10.4 +.xxxxD+ee while c ifmt=104 means F7.4 +x.xxxx c ifmt=205 means F9.5 +xx.xxxxx c Note: formats for ja, and ia are internally computed. c c job = integer to indicate whether matrix values and c a right-hand-side is available to be written c job = 1 write srtucture only, i.e., the arrays ja and ia. c job = 2 write matrix including values, i.e., a, ja, ia c job = 3 write matrix and one right hand side: a,ja,ia,rhs. c job = nrhs+2 write matrix and nrhs successive right hand sides c Note that there cannot be any right-hand-side if the matrix c has no values. Also the initial guess and exact solutions when c provided are for each right hand side. For example if nrhs=2 c and guesol='GX' there are 6 vectors to write. c c c iounit = logical unit number where to write the matrix into. c c on return: c---------- c the matrix a, ja, ia will be written in output unit iounit c in the Harwell-Boeing format. None of the inputs is modofied. c c Notes: 1) This code attempts to pack as many elements as possible per c 80-character line. c 2) this code attempts to avoid as much as possible to put c blanks in the formats that are written in the 4-line header c (This is done for purely esthetical reasons since blanks c are ignored in format descriptors.) c 3) sparse formats for right hand sides and guesses are not c supported. c----------------------------------------------------------------------- character title*72,key*8,type*3,ptrfmt*16,indfmt*16,valfmt*20, * guesol*2, rhstyp*3 integer totcrd, ptrcrd, indcrd, valcrd, rhscrd, nrow, ncol, 1 nnz, nrhs, len, nperli, nrwindx integer ja(*), ia(*) real*8 a(*),rhs(*) c-------------- c compute pointer format c-------------- nnz = ia(ncol+1) -1 len = int ( alog10(0.1+real(nnz+1))) + 1 nperli = 80/len ptrcrd = ncol/nperli + 1 if (len .gt. 9) then assign 101 to ix else assign 100 to ix endif write (ptrfmt,ix) nperli,len 100 format(1h(,i2,1HI,i1,1h) ) 101 format(1h(,i2,1HI,i2,1h) ) c---------------------------- c compute ROW index format c---------------------------- len = int ( alog10(0.1+real(nrow) )) + 1 nperli = min0(80/len,nnz) indcrd = (nnz-1)/nperli+1 write (indfmt,100) nperli,len c--------------- c compute values and rhs format (using the same for both) c--------------- valcrd = 0 rhscrd = 0 c quit this part if no values provided. if (job .le. 1) goto 20 c if (ifmt .ge. 100) then ihead = ifmt/100 ifmt = ifmt-100*ihead len = ihead+ifmt+2 nperli = 80/len c if (len .le. 9 ) then assign 102 to ix elseif (ifmt .le. 9) then assign 103 to ix else assign 104 to ix endif c write(valfmt,ix) nperli,len,ifmt 102 format(1h(,i2,1hF,i1,1h.,i1,1h) ) 103 format(1h(,i2,1hF,i2,1h.,i1,1h) ) 104 format(1h(,i2,1hF,i2,1h.,i2,1h) ) C else len = ifmt + 6 nperli = 80/len c try to minimize the blanks in the format strings. if (nperli .le. 9) then if (len .le. 9 ) then assign 105 to ix elseif (ifmt .le. 9) then assign 106 to ix else assign 107 to ix endif else if (len .le. 9 ) then assign 108 to ix elseif (ifmt .le. 9) then assign 109 to ix else assign 110 to ix endif endif c----------- write(valfmt,ix) nperli,len,ifmt 105 format(1h(,i1,1hD,i1,1h.,i1,1h) ) 106 format(1h(,i1,1hD,i2,1h.,i1,1h) ) 107 format(1h(,i1,1hD,i2,1h.,i2,1h) ) 108 format(1h(,i2,1hD,i1,1h.,i1,1h) ) 109 format(1h(,i2,1hD,i2,1h.,i1,1h) ) 110 format(1h(,i2,1hD,i2,1h.,i2,1h) ) c endif valcrd = (nnz-1)/nperli+1 nrhs = job -2 if (nrhs .ge. 1) then i = (nrhs*nrow-1)/nperli+1 rhscrd = i if (guesol(1:1) .eq. 'G' .or. guesol(1:1) .eq. 'g') + rhscrd = rhscrd+i if (guesol(2:2) .eq. 'X' .or. guesol(2:2) .eq. 'x') + rhscrd = rhscrd+i rhstyp = 'F'//guesol endif 20 continue c totcrd = ptrcrd+indcrd+valcrd+rhscrd c write 4-line or five line header write(iounit,10) title,key,totcrd,ptrcrd,indcrd,valcrd, 1 rhscrd,type,nrow,ncol,nnz,nrhs,ptrfmt,indfmt,valfmt,valfmt c----------------------------------------------------------------------- nrwindx = 0 if (nrhs .ge. 1) write (iounit,11) rhstyp, nrhs, nrwindx 10 format (a72, a8 / 5i14 / a3, 11x, 4i14 / 2a16, 2a20) 11 format(A3,11x,i14,i14) c write(iounit,ptrfmt) (ia (i), i = 1, ncol+1) write(iounit,indfmt) (ja (i), i = 1, nnz) if (job .le. 1) return write(iounit,valfmt) (a(i), i = 1, nnz) if (job .le. 2) return len = nrow*nrhs next = 1 iend = len write(iounit,valfmt) (rhs(i), i = next, iend) c c write initial guesses if available c if (guesol(1:1) .eq. 'G' .or. guesol(1:1) .eq. 'g') then next = next+len iend = iend+ len write(iounit,valfmt) (rhs(i), i = next, iend) endif c c write exact solutions if available c if (guesol(2:2) .eq. 'X' .or. guesol(2:2) .eq. 'x') then next = next+len iend = iend+ len write(iounit,valfmt) (rhs(i), i = next, iend) endif c return c----------end of prtmt ------------------------------------------------ c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine dump (i1,i2,values,a,ja,ia,iout) integer i1, i2, ia(*), ja(*), iout real*8 a(*) logical values c----------------------------------------------------------------------- c outputs rows i1 through i2 of a sparse matrix stored in CSR format c (or columns i1 through i2 of a matrix stored in CSC format) in a file, c one (column) row at a time in a nice readable format. c This is a simple routine which is useful for debugging. c----------------------------------------------------------------------- c on entry: c--------- c i1 = first row (column) to print out c i2 = last row (column) to print out c values= logical. indicates whether or not to print real values. c if value = .false. only the pattern will be output. c a, c ja, c ia = matrix in CSR format (or CSC format) c iout = logical unit number for output. c---------- c the output file iout will have written in it the rows or columns c of the matrix in one of two possible formats (depending on the max c number of elements per row. The values are output with only c two digits of accuracy (D9.2). ) c----------------------------------------------------------------------- c local variables integer maxr, i, k1, k2 c c select mode horizontal or vertical c maxr = 0 do 1 i=i1, i2 maxr = max0(maxr,ia(i+1)-ia(i)) 1 continue if (maxr .le. 8) then c c able to do one row acros line c do 2 i=i1, i2 write(iout,100) i k1=ia(i) k2 = ia(i+1)-1 write (iout,101) (ja(k),k=k1,k2) if (values) write (iout,102) (a(k),k=k1,k2) 2 continue else c c unable to one row acros line. do three items at a time c across a line do 3 i=i1, i2 if (values) then write(iout,200) i else write(iout,203) i endif k1=ia(i) k2 = ia(i+1)-1 if (values) then write (iout,201) (ja(k),a(k),k=k1,k2) else write (iout,202) (ja(k),k=k1,k2) endif 3 continue endif c c formats : c 100 format (1h ,34(1h-),' row',i6,1x,34(1h-) ) 101 format(' col:',8(i5,6h : )) 102 format(' val:',8(D9.2,2h :) ) 200 format (1h ,30(1h-),' row',i3,1x,30(1h-),/ * 3(' columns : values * ') ) c-------------xiiiiiihhhhhhddddddddd-*- 201 format(3(1h ,i6,6h : ,D9.2,3h * ) ) 202 format(6(1h ,i5,6h * ) ) 203 format (1h ,30(1h-),' row',i3,1x,30(1h-),/ * 3(' column : column *') ) return c----end-of-dump-------------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine pspltm(nrow,ncol,mode,ja,ia,title,ptitle,size,munt, * nlines,lines,iunt) c----------------------------------------------------------------------- integer nrow,ncol,ptitle,mode,iunt, ja(*), ia(*), lines(nlines) real size character title*(*), munt*2 c----------------------------------------------------------------------- c PSPLTM - PostScript PLoTer of a (sparse) Matrix c This version by loris renggli (renggli@masg1.epfl.ch), Dec 1991 c and Youcef Saad c------ c Loris RENGGLI, Swiss Federal Institute of Technology, Math. Dept c CH-1015 Lausanne (Switzerland) -- e-mail: renggli@masg1.epfl.ch c Modified by Youcef Saad -- June 24, 1992 to add a few features: c separation lines + acceptance of MSR format. c----------------------------------------------------------------------- c input arguments description : c c nrow = number of rows in matrix c c ncol = number of columns in matrix c c mode = integer indicating whether the matrix is stored in c CSR mode (mode=0) or CSC mode (mode=1) or MSR mode (mode=2) c c ja = column indices of nonzero elements when matrix is c stored rowise. Row indices if stores column-wise. c ia = integer array of containing the pointers to the c beginning of the columns in arrays a, ja. c c title = character*(*). a title of arbitrary length to be printed c as a caption to the figure. Can be a blank character if no c caption is desired. c c ptitle = position of title; 0 under the drawing, else above c c size = size of the drawing c c munt = units used for size : 'cm' or 'in' c c nlines = number of separation lines to draw for showing a partionning c of the matrix. enter zero if no partition lines are wanted. c c lines = integer array of length nlines containing the coordinates of c the desired partition lines . The partitioning is symmetric: c a horizontal line across the matrix will be drawn in c between rows lines(i) and lines(i)+1 for i=1, 2, ..., nlines c an a vertical line will be similarly drawn between columns c lines(i) and lines(i)+1 for i=1,2,...,nlines c c iunt = logical unit number where to write the matrix into. c----------------------------------------------------------------------- c additional note: use of 'cm' assumes european format for paper size c (21cm wide) and use of 'in' assumes american format (8.5in wide). c The correct centering of the figure depends on the proper choice. Y.S. c----------------------------------------------------------------------- c external integer LENSTR external LENSTR c local variables --------------------------------------------------- integer n,nr,nc,maxdim,istart,ilast,ii,k,ltit real lrmrgn,botmrgn,xtit,ytit,ytitof,fnstit,siz real xl,xr, yb,yt, scfct,u2dot,frlw,delt,paperx,conv,xx,yy logical square c change square to .true. if you prefer a square frame around c a rectangular matrix data haf /0.5/, zero/0.0/, conv/2.54/,square/.false./ c----------------------------------------------------------------------- siz = size nr = nrow nc = ncol n = nc if (mode .eq. 0) n = nr c nnz = ia(n+1) - ia(1) maxdim = max(nrow, ncol) m = 1 + maxdim nc = nc+1 nr = nr+1 c c units (cm or in) to dot conversion factor and paper size c if (munt.eq.'cm' .or. munt.eq.'CM') then u2dot = 72.0/conv paperx = 21.0 else u2dot = 72.0 paperx = 8.5*conv siz = siz*conv end if c c left and right margins (drawing is centered) c lrmrgn = (paperx-siz)/2.0 c c bottom margin : 2 cm c botmrgn = 2.0 c scaling factor scfct = siz*u2dot/m c matrix frame line witdh frlw = 0.25 c font size for title (cm) fnstit = 0.5 ltit = LENSTR(title) c position of title : centered horizontally c at 1.0 cm vertically over the drawing ytitof = 1.0 xtit = paperx/2.0 ytit = botmrgn+siz*nr/m + ytitof c almost exact bounding box xl = lrmrgn*u2dot - scfct*frlw/2 xr = (lrmrgn+siz)*u2dot + scfct*frlw/2 yb = botmrgn*u2dot - scfct*frlw/2 yt = (botmrgn+siz*nr/m)*u2dot + scfct*frlw/2 if (ltit.gt.0) then yt = yt + (ytitof+fnstit*0.70)*u2dot end if c add some room to bounding box delt = 10.0 xl = xl-delt xr = xr+delt yb = yb-delt yt = yt+delt c c correction for title under the drawing if (ptitle.eq.0 .and. ltit.gt.0) then ytit = botmrgn + fnstit*0.3 botmrgn = botmrgn + ytitof + fnstit*0.7 end if c begin of output c write(iunt,10) '%!' write(iunt,10) '%%Creator: PSPLTM routine' write(iunt,12) '%%BoundingBox:',xl,yb,xr,yt write(iunt,10) '%%EndComments' write(iunt,10) '/cm {72 mul 2.54 div} def' write(iunt,10) '/mc {72 div 2.54 mul} def' write(iunt,10) '/pnum { 72 div 2.54 mul 20 string' write(iunt,10) 'cvs print ( ) print} def' write(iunt,10) 1 '/Cshow {dup stringwidth pop -2 div 0 rmoveto show} def' c c we leave margins etc. in cm so it is easy to modify them if c needed by editing the output file write(iunt,10) 'gsave' if (ltit.gt.0) then write(iunt,*) '/Helvetica findfont ',fnstit, & ' cm scalefont setfont ' write(iunt,*) xtit,' cm ',ytit,' cm moveto ' write(iunt,'(3A)') '(',title(1:ltit),') Cshow' end if write(iunt,*) lrmrgn,' cm ',botmrgn,' cm translate' write(iunt,*) siz,' cm ',m,' div dup scale ' c------- c draw a frame around the matrix write(iunt,*) frlw,' setlinewidth' write(iunt,10) 'newpath' write(iunt,11) 0, 0, ' moveto' if (square) then write(iunt,11) m,0,' lineto' write(iunt,11) m, m, ' lineto' write(iunt,11) 0,m,' lineto' else write(iunt,11) nc,0,' lineto' write(iunt,11) nc,nr,' lineto' write(iunt,11) 0,nr,' lineto' end if write(iunt,10) 'closepath stroke' c c drawing the separation lines c write(iunt,*) ' 0.2 setlinewidth' do 22 kol=1, nlines isep = lines(kol) c c horizontal lines c yy = real(nrow-isep) + haf xx = real(ncol+1) write(iunt,13) zero, yy, ' moveto ' write(iunt,13) xx, yy, ' lineto stroke ' c c vertical lines c xx = real(isep) + haf yy = real(nrow+1) write(iunt,13) xx, zero,' moveto ' write(iunt,13) xx, yy, ' lineto stroke ' 22 continue c c----------- plotting loop --------------------------------------------- c write(iunt,10) '1 1 translate' write(iunt,10) '0.8 setlinewidth' write(iunt,10) '/p {moveto 0 -.40 rmoveto ' write(iunt,10) ' 0 .80 rlineto stroke} def' c do 1 ii=1, n istart = ia(ii) ilast = ia(ii+1)-1 if (mode .eq. 1) then do 2 k=istart, ilast write(iunt,11) ii-1, nrow-ja(k), ' p' 2 continue else do 3 k=istart, ilast write(iunt,11) ja(k)-1, nrow-ii, ' p' 3 continue c add diagonal element if MSR mode. if (mode .eq. 2) * write(iunt,11) ii-1, nrow-ii, ' p' c endif 1 continue c----------------------------------------------------------------------- write(iunt,10) 'showpage' return c 10 format (A) 11 format (2(I6,1x),A) 12 format (A,4(1x,F9.2)) 13 format (2(F9.2,1x),A) c----------------------------------------------------------------------- end c integer function lenstr(s) c----------------------------------------------------------------------- c return length of the string S c----------------------------------------------------------------------- character*(*) s integer len intrinsic len integer n c----------------------------------------------------------------------- n = len(s) 10 continue if (s(n:n).eq.' ') then n = n-1 if (n.gt.0) go to 10 end if lenstr = n c return c--------end-of-pspltm-------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine pltmt (nrow,ncol,mode,ja,ia,title,key,type, 1 job, iounit) c----------------------------------------------------------------------- c this subroutine creates a 'pic' file for plotting the pattern of c a sparse matrix stored in general sparse format. it is not intended c to be a means of plotting large matrices (it is very inefficient). c It is however useful for small matrices and can be used for example c for inserting matrix plots in a text. The size of the plot can be c 7in x 7in or 5 in x 5in .. There is also an option for writing a c 3-line header in troff (see description of parameter job). c Author: Youcef Saad - Date: Sept., 1989 c See SPARSKIT/UNSUPP/ for a version of this to produce a post-script c file. c----------------------------------------------------------------------- c nrow = number of rows in matrix c c ncol = number of columns in matrix c c mode = integer indicating whether the matrix is stored c row-wise (mode = 0) or column-wise (mode=1) c c ja = column indices of nonzero elements when matrix is c stored rowise. Row indices if stores column-wise. c ia = integer array of containing the pointers to the c beginning of the columns in arrays a, ja. c c title = character*71 = title of matrix test ( character a*71 ). c key = character*8 = key of matrix c type = character*3 = type of matrix. c c job = this integer parameter allows to set a few minor c options. First it tells pltmt whether or not to c reduce the plot. The standard size of 7in is then c replaced by a 5in plot. It also tells pltmt whether or c not to append to the pic file a few 'troff' lines that c produce a centered caption includingg the title, key and c types as well as the size and number of nonzero elements. c job = 0 : do not reduce and do not make caption. c job = 1 : reduce and do not make caption. c job = 10 : do not reduce and make caption c job = 11 : reduce and make caption. c (i.e. trailing digit for reduction, leading digit for caption) c c iounit = logical unit number where to write the matrix into. c c----------------------------------------------------------------------- c example of usage . c----------------- c In the fortran code: c a) read a Harwell/Boeing matrix c call readmt (.....) c iout = 13 c b) generate pic file: c call pltmt (nrow,ncol,mode,ja,ia,title,key,type,iout) c stop c --------- c Then in a unix environment plot the matrix by the command c c pic FOR013.DAT | troff -me | lpr -Ppsx c c----------------------------------------------------------------------- c notes: 1) Plots square as well as rectangular matrices. c (however not as much tested with rectangular matrices.) c 2) the dot-size is adapted according to the size of the c matrix. c 3) This is not meant at all as a way of plotting large c matrices. The pic file generaled will have one line for c each nonzero element. It is only meant for use in c such things as document poreparations etc.. c 4) The caption written will print the 71 character long c title. This may not be centered correctly if the c title has trailing blanks (a problem with Troff). c if you want the title centered then you can center c the string in title before calling pltmt. c c----------------------------------------------------------------------- integer ja(*), ia(*) character key*8,title*72,type*3 real x, y c------- n = ncol if (mode .eq. 0) n = nrow nnz = ia(n+1) - ia(1) maxdim = max0 (nrow, ncol) xnrow = real(nrow) ptsize = 0.08 hscale = (7.0 -2.0*ptsize)/real(maxdim-1) vscale = hscale xwid = ptsize + real(ncol-1)*hscale + ptsize xht = ptsize + real(nrow-1)*vscale + ptsize xshift = (7.0-xwid)/2.0 yshift = (7.0-xht)/2.0 c------ if (mod(job,10) .eq. 1) then write (iounit,88) else write (iounit,89) endif 88 format('.PS 5in',/,'.po 1.8i') 89 format('.PS',/,'.po 0.7i') write(iounit,90) 90 format('box invisible wid 7.0 ht 7.0 with .sw at (0.0,0.0) ') write(iounit,91) xwid, xht, xshift, yshift 91 format('box wid ',f5.2,' ht ',f5.2, * ' with .sw at (',f5.2,',',f5.2,')' ) c c shift points slightly to account for size of dot , etc.. c tiny = 0.03 if (mod(job,10) .eq. 1) tiny = 0.05 xshift = xshift + ptsize - tiny yshift = yshift + ptsize + tiny c c----------------------------------------------------------------------- c ips = 8 if (maxdim .le. 500) ips = 10 if (maxdim .le. 300) ips = 12 if (maxdim .le. 100) ips = 16 if (maxdim .lt. 50) ips = 24 write(iounit,92) ips 92 format ('.ps ',i2) c c-----------plottingloop --------------------------------------------- c do 1 ii=1, n istart = ia(ii) ilast = ia(ii+1)-1 if (mode .ne. 0) then x = real(ii-1) do 2 k=istart, ilast y = xnrow-real(ja(k)) write(iounit,128) xshift+x*hscale, yshift+y*vscale 2 continue else y = xnrow - real(ii) do 3 k=istart, ilast x = real(ja(k)-1) write(iounit,128) xshift+x*hscale, yshift+y*vscale 3 continue endif 1 continue c----------------------------------------------------------------------- 128 format(7h"." at ,f6.3,1h,,f6.3,8h ljust ) write (iounit, 129) 129 format('.PE') c quit if caption not desired. if ( (job/10) .ne. 1) return c write(iounit,127) key, type, title write(iounit,130) nrow,ncol,nnz 127 format('.sp 4'/'.ll 7i'/'.ps 12'/'.po 0.7i'/'.ce 3'/, * 'Matrix: ',a8,', Type: ',a3,/,a72) 130 format('Dimension: ',i4,' x ',i4,', Nonzero elements: ',i5) return c----------------end-of-pltmt ------------------------------------------ c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine smms (n,first,last,mode,a,ja,ia,iout) integer ia(*), ja(*), n, first, last, mode, iout real*8 a(*) c----------------------------------------------------------------------- c writes a matrix in Coordinate (SMMS) format -- c----------------------------------------------------------------------- c on entry: c--------- c n = integer = size of matrix -- number of rows (columns if matrix c is stored columnwise) c first = first row (column) to be output. This routine will output c rows (colums) first to last. c last = last row (column) to be output. c mode = integer giving some information about the storage of the c matrix. A 3-digit decimal number. 'htu' c * u = 0 means that matrix is stored row-wise c * u = 1 means that matrix is stored column-wise c * t = 0 indicates that the matrix is stored in CSR format c * t = 1 indicates that the matrix is stored in MSR format. c * h = ... to be added. c a, c ja, c ia = matrix in CSR or MSR format (see mode) c iout = output unit number. c c on return: c---------- c the output file iout will have written in it the matrix in smms c (coordinate format) c c----------------------------------------------------------------------- logical msr, csc c c determine mode ( msr or csr ) c msr = .false. csc = .false. if (mod(mode,10) .eq. 1) csc = .true. if ( (mode/10) .eq. 1) msr = .true. write (iout,*) n do 2 i=first, last k1=ia(i) k2 = ia(i+1)-1 c write (iout,*) ' row ', i if (msr) write(iout,'(2i6,e22.14)') i, i, a(i) do 10 k=k1, k2 if (csc) then write(iout,'(2i6,e22.14)') ja(k), i, a(k) else write(iout,'(2i6,e22.14)') i, ja(k), a(k) endif 10 continue 2 continue c----end-of-smms-------------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine readsm (nmax,nzmax,n,nnz,ia,ja,a,iout,ierr) integer nmax, nzmax, row, n, iout, i, j, k, ierr integer ia(nmax+1), ja(nzmax) real*8 a(nzmax), x c----------------------------------------------------------------------- c read a matrix in coordinate format as is used in the SMMS c package (F. Alvarado), i.e. the row is in ascending order. c Outputs the matrix in CSR format. c----------------------------------------------------------------------- c coded by Kesheng Wu on Oct 21, 1991 with the supervision of Y. Saad c----------------------------------------------------------------------- c on entry: c--------- c nmax = the maximum size of array c nzmax = the maximum number of nonzeros c iout = the I/O unit that has the data file c c on return: c---------- c n = integer = size of matrix c nnz = number of non-zero entries in the matrix c a, c ja, c ia = matrix in CSR format c ierr = error code, c 0 -- subroutine end with intended job done c 1 -- error in I/O unit iout c 2 -- end-of-file reached while reading n, i.e. a empty data file c 3 -- n non-positive or too large c 4 -- nnz is zero or larger than nzmax c 5 -- data file is not orgnized in the order of ascending c row indices c c in case of errors: c n will be set to zero (0). In case the data file has more than nzmax c number of entries, the first nzmax entries will be read, and are not c cleared on return. The total number of entry is determined. c Ierr is set. c----------------------------------------------------------------------- c rewind(iout) nnz = 0 ia(1) = 1 row = 1 c read (iout,*, err=1000, end=1010) n if ((n.le.0) .or. (n.gt.nmax)) goto 1020 c 10 nnz = nnz + 1 read (iout, *, err=1000, end=100) i, j, x c set the pointers when needed if (i.gt.row) then do 20 k = row+1, i ia(k) = nnz 20 continue row = i else if (i.lt.row) then goto 1040 endif ja(nnz) = j a (nnz) = x if (nnz.lt.nzmax) then goto 10 else goto 1030 endif c normal return -- end of file reached 100 ia(row+1) = nnz nnz = nnz - 1 if (nnz.eq.0) goto 1030 c c everything seems to be OK. c ierr = 0 return c c error handling code c c error in reading data entries c 1000 ierr = 1 goto 2000 c c empty file c 1010 ierr = 2 goto 2000 c c problem with n c 1020 ierr = 3 goto 2000 c c problem with nnz c 1030 ierr = 4 c c try to determine the real number of entries, in case needed c if (nnz.ge.nzmax) then 200 read(iout, *, err=210, end=210) i, j, x nnz = nnz + 1 goto 200 210 continue endif goto 2000 c c data entries not ordered c 1040 ierr = 5 2000 n = 0 return c----end-of-readsm------------------------------------------------------ c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine readsk (nmax,nzmax,n,nnz,a,ja,ia,iounit,ierr) integer nmax, nzmax, iounit, n, nnz, i, ierr integer ia(nmax+1), ja(nzmax) real*8 a(nzmax) c----------------------------------------------------------------------- c Reads matrix in Compressed Saprse Row format. The data is supposed to c appear in the following order -- n, ia, ja, a c Only square matrices accepted. Format has following features c (1) each number is separated by at least one space (or end-of-line), c (2) each array starts with a new line. c----------------------------------------------------------------------- c coded by Kesheng Wu on Oct 21, 1991 with supervision of Y. Saad c----------------------------------------------------------------------- c on entry: c--------- c nmax = max column dimension allowed for matrix. c nzmax = max number of nonzeros elements allowed. the arrays a, c and ja should be of length equal to nnz (see below). c iounit = logical unit number where to read the matrix from. c c on return: c---------- c ia, c ja, c a = matrx in CSR format c n = number of rows(columns) in matrix c nnz = number of nonzero elements in A. This info is returned c even if there is not enough space in a, ja, ia, in order c to determine the minimum storage needed. c ierr = error code, c 0 : OK; c 1 : error when try to read the specified I/O unit. c 2 : end-of-file reached during reading of data file. c 3 : array size in data file is negtive or larger than nmax; c 4 : nunmer of nonzeros in data file is negtive or larger than nzmax c in case of errors: c--------- c n is set to 0 (zero), at the same time ierr is set. c----------------------------------------------------------------------- c c read the size of the matrix c rewind(iounit) read (iounit, *, err=1000, end=1010) n if ((n.le.0).or.(n.gt.nmax)) goto 1020 c c read the pointer array ia(*) c read (iounit, *, err=1000, end=1010) (ia(i), i=1, n+1) c c Number of None-Zeros c nnz = ia(n+1) - 1 if ((nnz.le.0).or.(nnz.gt.nzmax)) goto 1030 c c read the column indices array c read (iounit, *, err=1000, end=1010) (ja(i), i=1, nnz) c c read the matrix elements c read (iounit, *, err=1000, end=1010) (a(i), i=1, nnz) c c normal return c ierr = 0 return c c error handling code c c error in reading I/O unit 1000 ierr = 1 goto 2000 c c EOF reached in reading 1010 ierr =2 goto 2000 c c n non-positive or too large 1020 ierr = 3 n = 0 goto 2000 c c NNZ non-positive or too large 1030 ierr = 4 c c the real return statement c 2000 n = 0 return c---------end of readsk ------------------------------------------------ c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine skit (n, a, ja, ia, ifmt, iounit, ierr) c----------------------------------------------------------------------- c Writes a matrix in Compressed Sparse Row format to an I/O unit. c It tryes to pack as many number as possible into lines of less than c 80 characters. Space is inserted in between numbers for separation c to avoid carrying a header in the data file. This can be viewed c as a simplified Harwell-Boeing format. c----------------------------------------------------------------------- c Modified from subroutine prtmt written by Y. Saad c----------------------------------------------------------------------- c on entry: c--------- c n = number of rows(columns) in matrix c a = real*8 array containing the values of the matrix stored c columnwise c ja = integer array of the same length as a containing the column c indices of the corresponding matrix elements of array a. c ia = integer array of containing the pointers to the beginning of c the row in arrays a and ja. c ifmt = integer specifying the format chosen for the real values c to be output (i.e., for a, and for rhs-guess-sol if c applicable). The meaning of ifmt is as follows. c * if (ifmt .lt. 100) then the D descriptor is used, c format Dd.m, in which the length (m) of the mantissa is c precisely the integer ifmt (and d = ifmt+6) c * if (ifmt .gt. 100) then prtmt will use the c F- descriptor (format Fd.m) in which the length of the c mantissa (m) is the integer mod(ifmt,100) and the length c of the integer part is k=ifmt/100 (and d = k+m+2) c Thus ifmt= 4 means D10.4 +.xxxxD+ee while c ifmt=104 means F7.4 +x.xxxx c ifmt=205 means F9.5 +xx.xxxxx c Note: formats for ja, and ia are internally computed. c c iounit = logical unit number where to write the matrix into. c c on return: c---------- c ierr = error code, 0 for normal 1 for error in writing to iounit. c c on error: c-------- c If error is encontacted when writing the matrix, the whole matrix c is written to the standard output. c ierr is set to 1. c----------------------------------------------------------------------- character ptrfmt*16,indfmt*16,valfmt*20 integer iounit, n, ifmt, len, nperli, nnz, i, ihead integer ja(*), ia(*), ierr real*8 a(*) c-------------- c compute pointer format c-------------- nnz = ia(n+1) len = int ( alog10(0.1+real(nnz))) + 2 nnz = nnz - 1 nperli = 80/len c print *, ' skit entries:', n, nnz, len, nperli if (len .gt. 9) then assign 101 to ix else assign 100 to ix endif write (ptrfmt,ix) nperli,len 100 format(1h(,i2,1HI,i1,1h) ) 101 format(1h(,i2,1HI,i2,1h) ) c---------------------------- c compute ROW index format c---------------------------- len = int ( alog10(0.1+real(n) )) + 2 nperli = min0(80/len,nnz) write (indfmt,100) nperli,len c--------------------------- c compute value format c--------------------------- if (ifmt .ge. 100) then ihead = ifmt/100 ifmt = ifmt-100*ihead len = ihead+ifmt+3 nperli = 80/len c if (len .le. 9 ) then assign 102 to ix elseif (ifmt .le. 9) then assign 103 to ix else assign 104 to ix endif c write(valfmt,ix) nperli,len,ifmt 102 format(1h(,i2,1hF,i1,1h.,i1,1h) ) 103 format(1h(,i2,1hF,i2,1h.,i1,1h) ) 104 format(1h(,i2,1hF,i2,1h.,i2,1h) ) C else len = ifmt + 7 nperli = 80/len c try to minimize the blanks in the format strings. if (nperli .le. 9) then if (len .le. 9 ) then assign 105 to ix elseif (ifmt .le. 9) then assign 106 to ix else assign 107 to ix endif else if (len .le. 9 ) then assign 108 to ix elseif (ifmt .le. 9) then assign 109 to ix else assign 110 to ix endif endif c----------- write(valfmt,ix) nperli,len,ifmt 105 format(1h(,i1,1hD,i1,1h.,i1,1h) ) 106 format(1h(,i1,1hD,i2,1h.,i1,1h) ) 107 format(1h(,i1,1hD,i2,1h.,i2,1h) ) 108 format(1h(,i2,1hD,i1,1h.,i1,1h) ) 109 format(1h(,i2,1hD,i2,1h.,i1,1h) ) 110 format(1h(,i2,1hD,i2,1h.,i2,1h) ) c endif c c output the data c write(iounit, *) n write(iounit,ptrfmt,err=1000) (ia(i), i = 1, n+1) write(iounit,indfmt,err=1000) (ja(i), i = 1, nnz) write(iounit,valfmt,err=1000) ( a(i), i = 1, nnz) c c done, if no trouble is encounted in writing data c ierr = 0 return c c if can't write the data to the I/O unit specified, should be able to c write everything to standard output (unit 6) c 1000 write(0, *) 'Error, Can''t write data to sepcified unit',iounit write(0, *) 'Write the matrix into standard output instead!' ierr = 1 write(6,*) n write(6,ptrfmt) (ia(i), i=1, n+1) write(6,indfmt) (ja(i), i=1, nnz) write(6,valfmt) ( a(i), i=1, nnz) return c----------end of skit ------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine prtunf(n, a, ja, ia, iout, ierr) c----------------------------------------------------------------------- c This subroutine dumps the arrays used for storing sparse compressed row c format in machine code, i.e. unformatted using standard FORTRAN term. c----------------------------------------------------------------------- c First coded by Kesheng Wu on Oct 21, 1991 under the instruction of c Prof. Y. Saad c----------------------------------------------------------------------- c On entry: c n: the size of the matrix (matrix is n X n) c ia: integer array stores the stariting position of each row. c ja: integer array stores the column indices of each entry. c a: the non-zero entries of the matrix. c iout: the unit number opened for storing the matrix. c On return: c ierr: a error, 0 if everything's OK, else 1 if error in writing data. c On error: c set ierr to 1. c No redirection is made, since direct the machine code to the standard c output may cause unpridictable consequences. c----------------------------------------------------------------------- integer iout, n, nnz, ierr, ia(*), ja(*) real*8 a(*) nnz = ia(n+1)-ia(1) c write(unit=iout, err=1000) n write(unit=iout, err=1000) (ia(k),k=1,n+1) if (nnz .gt. 0) then write(unit=iout, err=1000) (ja(k),k=1,nnz) write(unit=iout, err=1000) ( a(k),k=1,nnz) endif c ierr = 0 return c 1000 ierr = 1 return end c---------end of prtunf ------------------------------------------------ c c----------------------------------------------------------------------- subroutine readunf(nmax,nzmax,n,nnz,a,ja,ia,iounit,ierr) c----------------------------------------------------------------------- c This subroutine reads a matix store in machine code (FORTRAN c unformatted form). The matrix is in CSR format. c----------------------------------------------------------------------- c First coded by Kesheng Wu on Oct 21, 1991 under the instruction of c Prof. Y. Saad c----------------------------------------------------------------------- c On entry: c nmax: the maximum value of matrix size. c nzmax: the maximum number of non-zero entries. c iounit: the I/O unit that opened for reading. c On return: c n: the actual size of array. c nnz: the actual number of non-zero entries. c ia,ja,a: the matrix in CSR format. c ierr: a error code, it's same as that used in reaadsk c 0 -- OK c 1 -- error in reading iounit c 2 -- end-of-file reached while reading data file c 3 -- n is non-positive or too large c 4 -- nnz is non-positive or too large c On error: c return with n set to 0 (zero). nnz is kept if it's set already, c in case one want to use it to determine the size of array needed c to hold the data. c----------------------------------------------------------------------- c integer nmax, nzmax, n, iounit, nnz, k integer ia(nmax+1), ja(nzmax) real*8 a(nzmax) c rewind iounit c read (unit=iounit, err=1000, end=1010) n if ((n.le.0) .or. (n.gt.nmax)) goto 1020 c read(unit=iounit, err=1000, end=1010) (ia(k),k=1,n+1) c nnz = ia(n+1) - 1 if ((nnz.le.0) .or. (nnz.gt.nzmax)) goto 1030 c read(unit=iounit, err=1000, end=1010) (ja(k),k=1,nnz) read(unit=iounit, err=1000, end=1010) (a(k),k=1,nnz) c c everything seems to be OK. c ierr = 0 return c c error handling c 1000 ierr = 1 goto 2000 1010 ierr = 2 goto 2000 1020 ierr = 3 goto 2000 1030 ierr = 4 2000 n = 0 return end c---------end of readunf ---------------------------------------------- getdp-2.7.0-source/contrib/Sparskit/Sparskit.cpp000644 001750 001750 00000172002 12321573223 023347 0ustar00geuzainegeuzaine000000 000000 #include #include #include #include "GetDPConfig.h" #include "Sparskit.h" #include "MallocUtils.h" #include "Message.h" #if defined(HAVE_UNDERSCORE) #define etime_ etime #define ilut_ ilut #define ilutp_ ilutp #define ilud_ ilud #define iludp_ iludp #define iluk_ iluk #define ilu0_ ilu0 #define milu0_ milu0 #define cmkreord_ cmkreord #define sortcol_ sortcol #define skit_ skit #define psplot_ psplot #define cg_ cg #define cgnr_ cgnr #define bcg_ bcg #define dbcg_ dbcg #define bcgstab_ bcgstab #define tfqmr_ tfqmr #define fom_ fom #define gmres_ gmres #define fgmres_ fgmres #define dqgmres_ dqgmres #define amux_ amux #define atmux_ atmux #define lusol_ lusol #define lutsol_ lutsol #define csrcoo_ csrcoo #define ma28ad_ ma28ad #define ma28cd_ ma28cd #define dnrm2_ dnrm2 #define flu_ flu #define pgmres_ pgmres #define getdia_ getdia #define amudia_ amudia #define diamua_ diamua #define rnrms_ rnrms #define cnrms_ cnrms #endif /* Fortran prototypes */ extern "C" { void ilut_ (int*,double*,int*,int*,int*,double*, sscalar*,int*,int*,int*,double*,int*,int*); void ilutp_ (int*,double*,int*,int*,int*,double*, double*,int*,sscalar*,int*, int*,int*,double*,int*,int*,int*); void ilud_ (int*,double*,int*,int*,double*, double*,sscalar*,int*, int*,int*,double*,int*,int*); void iludp_ (int*,double*,int*,int*,double*, double*,double*, int*,sscalar*,int*,int*,int*, double*,int*,int*,int*); void iluk_ (int*,double*,int*,int*,int*, sscalar*,int*,int*, int*,int*,double*,int*,int*); void ilu0_ (int*,double*,int*,int*,sscalar*,int*,int*,int*,int*); void milu0_ (int*,double*,int*,int*,sscalar*,int*,int*,int*,int*); void cmkreord_ (int*,double*,int*,int*,double*,int*,int*,int*, int*,int*,int*,int*,int*,int*); void sortcol_ (int*,double*,int*,int*,int*,double*); void skit_ (int*,double*,int*,int*,int*,int*,int*); void psplot_ (int*,int*,int*,int*,int*); void cg_ (int*,double*,double*,int*,double*,double*); void cgnr_ (int*,double*,double*,int*,double*,double*); void bcg_ (int*,double*,double*,int*,double*,double*); void dbcg_ (int*,double*,double*,int*,double*,double*); void bcgstab_ (int*,double*,double*,int*,double*,double*); void tfqmr_ (int*,double*,double*,int*,double*,double*); void fom_ (int*,double*,double*,int*,double*,double*); void gmres_ (int*,double*,double*,int*,double*,double*); void fgmres_ (int*,double*,double*,int*,double*,double*); void dqgmres_ (int*,double*,double*,int*,double*,double*); void amux_ (int*,double*,double*,double*,int*,int*); void atmux_ (int*,double*,double*,double*,int*,int*); void lusol_ (int*,double*,double*,sscalar*,int*,int*); void lutsol_ (int*,double*,double*,sscalar*,int*,int*); void csrcoo_ (int*,int*,int*,double*,int*,int*,int*,double*,int*,int*,int*); void ma28ad_ (int*,int*,double*,int*,int*,int*,int*,double*,int*,int*,double*,int*); void ma28cd_ (int*,double*,int*,int*,int*,double*,double*,int*); double dnrm2_ (int*,double*,int*); void flu_ (int*,double*,double*,double*,int*,int*,double*,double*, double*,double*,double*); void pgmres_ (int*,int*,double*,double*,double*,double*, int*,int*,double*,int*,int*, sscalar*,int*,int*,int*); void getdia_ (int*,int*,int*,double*,int*,int*,int*,double*,int*,int*); void diamua_ (int*,int*,double*,int*,int*,double*,double*,int*,int*); void amudia_ (int*,int*,double*,int*,int*,double*,double*,int*,int*); void rnrms_ (int*,int*,double*,int*,int*,double*); void cnrms_ (int*,int*,double*,int*,int*,double*); } /* ------------------------------------------------------------------------ */ /* s o l v e */ /* ------------------------------------------------------------------------ */ void solve_matrix (Matrix *M, Solver_Params *p, double *b, double *x){ FILE *pf; double fpar[17]; double *a, *w, *rhs, *sol, *dx ; double res; int i, j, k, nnz, nnz_ilu, ierr, ipar[17]; int *ja, *ia, *jw, *mask, *levels; int its, end, do_permute=0; int zero=0, un=1, deux=2, six=6, douze=12, trente=30, trente_et_un=31; int ROW=0, COLUMN=1; double res1=1.; int TrueNnz=0; if (!M->N) { Message::Warning("No equations in linear system"); return; } for(i=0 ; iN ; i++){ if(b[i] != 0.) break; if(i == M->N-1) { Message::Warning("Null right hand side in linear system"); /* for(i=0 ; iN ; i++) x[i] = 0. ; return ; */ } } if(M->T == DENSE){ if(p->Algorithm == LU){ Message::Info("Dense LU decomposition"); print_matrix_info_DENSE(M->N); sol = (double*)Malloc(M->N * sizeof(double)); w = (double*)Malloc(M->N * sizeof(double)); dx = (double*)Malloc(M->N * sizeof(double)); ipar[1] = p->Re_Use_LU; ipar[2] = p->Iterative_Improvement; ipar[3] = p->Matrix_Printing; ipar[4] = p->Nb_Iter_Max; fpar[1] = p->Stopping_Test; flu_(&ipar[1], &fpar[1], M->F.a, M->F.lu, &M->N, &M->N, b, x, dx, sol, w); Free(sol); Free(w); Free(dx); return ; } Message::Info("Dense to sparse matrix conversion") ; nnz = M->N * M->N ; M->S.a = List_Create(1, 1, sizeof(double)); M->S.a->n = nnz ; M->S.a->array = (char*) M->F.a ; M->S.jptr = List_Create(M->N+1, M->N, sizeof(int)); M->S.ai = List_Create(nnz, M->N, sizeof(int)); for(i=1 ; i<=nnz ; i+=M->N){ List_Add(M->S.jptr, &i) ; for(j=1 ; j<=M->N ; j++){ List_Add(M->S.ai, &j) ; } } i = nnz + 1 ; List_Add(M->S.jptr, &i) ; if(M->changed){ do_permute = 1 ; M->changed = 0 ; } for (i=0 ; iF.a[i]) TrueNnz++ ; Message::Info("Number of nonzeros %d/%d (%.4f)",TrueNnz, nnz, (double)TrueNnz/(double)nnz); Message::Cpu(""); } /* if DENSE */ else{ nnz = List_Nbr(M->S.a); if(M->changed){ do_permute = 1 ; csr_format (&M->S, M->N); restore_format (&M->S); M->changed = 0 ; } } /* if SPARSE */ a = (double*) M->S.a->array; ia = (int*) M->S.jptr->array; ja = (int*) M->S.ai->array; if(p->Scaling != NONE){ Message::Info("Scaling system of equations") ; scale_matrix (p->Scaling, M) ; scale_vector (ROW, M, b) ; } else{ Message::Info("No scaling of system of equations") ; } for (i=1; iN; i++) { if(ia[i]-ia[i-1] <= 0) Message::Error("Zero row in matrix"); } rhs = (double*) Malloc(M->N * sizeof(double)); sol = (double*) Calloc(M->N, sizeof(double)); /* Renumbering */ if (!M->ILU_Exists){ M->S.permr = (int*) Malloc(M->N * sizeof(int)); M->S.rpermr = (int*) Malloc(M->N * sizeof(int)); M->S.permp = (int*) Malloc(2 * M->N * sizeof(int)); } if(do_permute || !M->ILU_Exists){ for(i=0 ; iN ; i++) { M->S.permr[i] = M->S.rpermr[i] = M->S.permp[i+M->N] = i+1; } switch (p->Renumbering_Technique){ case NONE: Message::Info("No renumbering"); break; case RCMK: Message::Info("RCMK algebraic renumbering"); if(!M->ILU_Exists){ M->S.a_rcmk = (double*) Malloc(nnz * sizeof(double)); M->S.ia_rcmk = (int*) Malloc((M->N + 1) * sizeof(int)); M->S.ja_rcmk = (int*) Malloc(nnz * sizeof(int)); } mask = (int*) Malloc(nnz * sizeof(int)); levels = (int*) Malloc((M->N + 1) * sizeof(int)); i = j = k = 1; cmkreord_(&M->N, a, ja, ia, M->S.a_rcmk, M->S.ja_rcmk, M->S.ia_rcmk, &i, M->S.permr, mask, &j, &k, M->S.rpermr, levels); w = (double*) Malloc(nnz * sizeof(double)); sortcol_(&M->N, M->S.a_rcmk, M->S.ja_rcmk, M->S.ia_rcmk, mask, w); Free(w); Free(mask); Free(levels); break; default : Message::Error("Unknown renumbering technique"); break; } print_matrix_info_CSR(M->N, ia, ja); Message::Cpu(""); } if(p->Renumbering_Technique == RCMK){ if (p->Re_Use_ILU && !M->ILU_Exists && !do_permute){ /* This is incorrect if M is to be changed during the process, and we still want to keep the same precond. Free(M->S.a->array) ; Free(M->S.jptr->array) ; Free(M->S.ai->array) ; M->S.a->array = (char*)M->S.a_rcmk; M->S.jptr->array = (char*)M->S.ia_rcmk; M->S.ai->array = (char*)M->S.ja_rcmk; */ } a = M->S.a_rcmk; ia = M->S.ia_rcmk; ja = M->S.ja_rcmk; } if (p->Matrix_Printing == 1 || p->Matrix_Printing == 3) { Message::Info("Matrix printing"); skit_(&M->N, a, ja, ia, &douze, &douze, &ierr); pf = fopen("fort.13","w"); for (i=0 ; iN ; i++) fprintf(pf, "%d %22.15E\n", i+1, b[i]); fclose(pf); psplot_(&M->N, ja, ia, &trente, &zero); } /* Incomplete factorizations */ if (!M->ILU_Exists) { if (p->Re_Use_ILU) M->ILU_Exists = 1; #if defined(HAVE_ILU_FLOAT) #define ILUSTORAGE "Float" #else #define ILUSTORAGE "Double" #endif end = 0 ; switch (p->Preconditioner){ case ILUT : Message::Info("ILUT (%s, fill-in = %d)", ILUSTORAGE, p->Nb_Fill); nnz_ilu = 2 * (M->N+1) * (p->Nb_Fill+1); break; case ILUTP : Message::Info("ILUTP (%s, fill-in = %d)", ILUSTORAGE, p->Nb_Fill); nnz_ilu = 2 * (M->N+1) * (p->Nb_Fill+1); break; case ILUD : Message::Info("ILUD (%s)", ILUSTORAGE); /* first guess */ nnz_ilu = List_Nbr(M->S.a); break; case ILUDP : Message::Info("ILUDP (%s)", ILUSTORAGE); /* first guess */ nnz_ilu = List_Nbr(M->S.a); break ; case ILUK : Message::Info("ILU%d (%s)", p->Nb_Fill, ILUSTORAGE); /* exact for nbfill=0, first guess otherwise */ nnz_ilu = (p->Nb_Fill+1) * List_Nbr(M->S.a) + (M->N+1); break; case ILU0 : Message::Info("ILU0 (%s)", ILUSTORAGE); nnz_ilu = List_Nbr(M->S.a) + (M->N+1); break; case MILU0 : Message::Info("MILU0 (%s)", ILUSTORAGE); nnz_ilu = List_Nbr(M->S.a) + (M->N+1); break; case DIAGONAL : Message::Info("Diagonal scaling (%s)", ILUSTORAGE); M->S.alu = (sscalar*) Malloc((M->N+1) * sizeof(sscalar)); M->S.jlu = (int*) Malloc((M->N+1) * sizeof(int)); M->S.ju = (int*) Malloc((M->N+1) * sizeof(int)); for (i=0 ; iN ; i++) { M->S.alu[i] = 1.0 ; M->S.jlu[i] = M->N+2 ; M->S.ju[i] = M->N+2 ; } M->S.alu[M->N] = 0.0 ; M->S.jlu[M->N] = M->N+2 ; M->S.ju[M->N] = 0 ; end = 1; ierr = 0; break; case NONE : Message::Info("No ILU"); end = 1; ierr = 0; break ; default : Message::Error("Unknown ILU method"); break; } if(!end){ M->S.alu = (sscalar*) Malloc(nnz_ilu * sizeof(sscalar)); M->S.jlu = (int*) Malloc(nnz_ilu * sizeof(int)); M->S.ju = (int*) Malloc((M->N+1) * sizeof(int)); } reallocate : switch(p->Preconditioner){ case ILUT : w = (double*) Malloc((M->N+1) * sizeof(double)); jw = (int*) Malloc(2 * (M->N+1) * sizeof(int)); ilut_(&M->N, a, ja, ia, &p->Nb_Fill, &p->Dropping_Tolerance, M->S.alu, M->S.jlu, M->S.ju, &nnz_ilu, w, jw, &ierr); Free(w); Free(jw); break; case ILUTP : w = (double*) Malloc((M->N+1) * sizeof(double)); jw = (int*) Malloc(2 * (M->N+1) * sizeof(int)); ilutp_(&M->N, a, ja, ia, &p->Nb_Fill, &p->Dropping_Tolerance, &p->Permutation_Tolerance, &M->N, M->S.alu, M->S.jlu, M->S.ju, &nnz_ilu, w, jw, M->S.permp, &ierr); Free(jw); Free(w); break; case ILUD : w = (double*) Malloc((M->N+1) * sizeof(double)); jw = (int*) Malloc(2 * (M->N+1) * sizeof(int)); ilud_(&M->N, a, ja, ia, &p->Diagonal_Compensation, &p->Dropping_Tolerance, M->S.alu, M->S.jlu, M->S.ju, &nnz_ilu, w, jw, &ierr); Free(w); Free(jw); break; case ILUDP : w = (double*) Malloc((M->N+1) * sizeof(double)); jw = (int*) Malloc(2 * (M->N+1) * sizeof(int)); iludp_(&M->N, a, ja, ia, &p->Diagonal_Compensation, &p->Dropping_Tolerance, &p->Permutation_Tolerance, &M->N, M->S.alu, M->S.jlu, M->S.ju, &nnz_ilu, w, jw, M->S.permp, &ierr); Free(jw); Free(w); break; case ILUK : levels = (int*) Malloc(nnz_ilu * sizeof(int)); w = (double*) Malloc((M->N+1) * sizeof(double)); jw = (int*) Malloc(3 * (M->N+1) * sizeof(int)); iluk_(&M->N, a, ja, ia, &p->Nb_Fill, M->S.alu, M->S.jlu, M->S.ju, levels, &nnz_ilu, w, jw, &ierr); Free(levels); Free(w); Free(jw); break; case ILU0 : jw = (int*) Malloc((M->N+1) * sizeof(int)); ilu0_(&M->N, a, ja, ia, M->S.alu, M->S.jlu, M->S.ju, jw, &ierr); Free(jw); break; case MILU0 : jw = (int*) Malloc((M->N+1) * sizeof(int)); milu0_(&M->N, a, ja, ia, M->S.alu, M->S.jlu, M->S.ju, jw, &ierr); Free(jw); break; } switch (ierr){ case 0 : break; case -1 : Message::Error("Input matrix may be wrong"); break; case -2 : /* Matrix L in ILU overflows work array 'al' */ case -3 : /* Matrix U in ILU overflows work array 'alu' */ nnz_ilu += nnz_ilu/2 ; Message::Info("Reallocating ILU (NZ: %d)", nnz_ilu); Free(M->S.alu) ; M->S.alu = (sscalar*) Malloc(nnz_ilu * sizeof(sscalar)); Free(M->S.jlu) ; M->S.jlu = (int*) Malloc(nnz_ilu * sizeof(int)); goto reallocate ; case -4 : Message::Error("Illegal value of nb_fill in ILU"); break; case -5 : Message::Error("Zero row encountered in ILU"); break; default : Message::Error("Zero pivot on line %d in ILU",ierr); break; } if(p->Preconditioner != NONE) print_matrix_info_MSR(M->N, M->S.alu, M->S.jlu); if(p->Matrix_Printing == 2 || p->Matrix_Printing == 3){ Message::Info("ILU printing"); psplot_(&M->N, M->S.jlu, M->S.jlu, &trente_et_un, &deux); } Message::Cpu(""); } /* RHS reordering */ for(i=0;iN;i++){ rhs[i] = b[M->S.rpermr[i] - 1]; } /* Iterations */ ipar[1] = 0; ipar[2] = (p->Preconditioner == NONE) ? 0 : p->Preconditioner_Position; ipar[3] = 1; ipar[4] = 0; ipar[5] = p->Krylov_Size; ipar[6] = p->Nb_Iter_Max; fpar[1] = p->Stopping_Test; fpar[2] = 0.0; fpar[11] = 0.0; switch (p->Algorithm){ case CG : Message::Info("Conjugate Gradient (CG)"); ipar[4] = 5 * M->N; break; case CGNR : Message::Info("CG Normal Residual equation (CGNR)"); ipar[4] = 5 * M->N; break; case BCG : Message::Info("Bi-Conjugate Gradient (BCG)"); ipar[4] = 7 * M->N; break; case DBCG : Message::Info("BCG with partial pivoting (DBCG)"); ipar[4] = 11 * M->N; break; case BCGSTAB : Message::Info("BCG stabilized (BCGSTAB)"); ipar[4] = 8 * M->N; break; case TFQMR : Message::Info("Transpose-Free Quasi-Minimum Residual (TFQMR)"); ipar[4] = 11 * M->N; break; case FOM : Message::Info("Full Orthogonalization Method (FOM)"); ipar[4] = (M->N+3) * (ipar[5]+2) + (ipar[5]+1) * ipar[5]/2; break; case GMRES : Message::Info("Generalized Minimum RESidual (GMRES)"); ipar[4] = (M->N+3) * (ipar[5]+2) + (ipar[5]+1) * ipar[5]/2; break; case FGMRES : Message::Info("Flexible version of Generalized Minimum RESidual (FGMRES)"); ipar[4] = 2*M->N * (ipar[5]+1) + (ipar[5]+1)*ipar[5]/2 + 3*ipar[5] + 2; break; case DQGMRES : Message::Info("Direct version of Quasi Generalize Minimum RESidual (DQGMRES)"); ipar[4] = M->N + (ipar[5]+1) * (2*M->N+4); break; case PGMRES : Message::Info("Alternative Generalized Minimum RESidual (GMRES)"); ipar[4] = (M->N+4) * (ipar[5]+2) + (ipar[5]+1) * ipar[5]/2; break; default : Message::Error("Unknown algorithm for sparse matrix solver"); break; } w = (double*) Malloc(ipar[4] * sizeof(double)); its = 0; end = 0; res = 0.0; while(1){ switch(p->Algorithm){ case CG : cg_(&M->N, rhs, sol, &ipar[1], &fpar[1], w); break; case CGNR : cgnr_(&M->N, rhs, sol, &ipar[1], &fpar[1], w); break; case BCG : bcg_(&M->N, rhs, sol, &ipar[1], &fpar[1], w); break; case DBCG : dbcg_(&M->N, rhs, sol, &ipar[1], &fpar[1], w); break; case BCGSTAB : bcgstab_(&M->N, rhs, sol, &ipar[1], &fpar[1], w); break; case TFQMR : tfqmr_(&M->N, rhs, sol, &ipar[1], &fpar[1], w); break; case FOM : fom_(&M->N, rhs, sol, &ipar[1], &fpar[1], w); break; case GMRES : gmres_(&M->N, rhs, sol, &ipar[1], &fpar[1], w); break; case FGMRES : fgmres_(&M->N, rhs, sol, &ipar[1], &fpar[1], w); break; case DQGMRES : dqgmres_(&M->N, rhs, sol, &ipar[1], &fpar[1], w); break; case PGMRES : pgmres_ (&M->N, &p->Krylov_Size, rhs, sol, w, &p->Stopping_Test, &p->Nb_Iter_Max, &six, a, ja, ia, M->S.alu, M->S.jlu, M->S.ju, &ierr); end = 1; break; } if(!end){ if(ipar[7] != its){ if(its) Message::Info(" %4d %.7e %.7e", its, res, res/res1); its = ipar[7] ; } res = fpar[5]; if(its==1) res1 = fpar[5] ; switch(ipar[1]){ case 1 : amux_(&M->N, &w[ipar[8]-1], &w[ipar[9]-1], a, ja, ia); break; case 2 : atmux_(&M->N, &w[ipar[8]-1], &w[ipar[9]-1], a, ja, ia); break; case 3 : case 5 : lusol_(&M->N, &w[ipar[8]-1], &w[ipar[9]-1], M->S.alu, M->S.jlu, M->S.ju); break; case 4 : case 6 : lutsol_(&M->N, &w[ipar[8]-1], &w[ipar[9]-1], M->S.alu, M->S.jlu, M->S.ju); break; case 0 : end = 1; break; case -1 : Message::Warning("Iterative solver has iterated too many times"); end = 1; break; case -2 : Message::Warning("Iterative solver was not given enough work space"); Message::Warning("The work space should at least have %d elements", ipar[4]); end = 1; break; case -3 : Message::Warning("Iterative solver is facing a break-down"); end = 1; break; default : Message::Warning("Iterative solver terminated (code = %d)", ipar[1]); end = 1; break; } } if(end) break; } /* Convergence results monitoring */ Message::Info(" %4d %.7e %.7e", ipar[7], fpar[6], fpar[6]/res1); amux_(&M->N, sol, w, a, ja, ia); for(i=0 ; iN ; i++){ w[M->N+i] = sol[i] - 1.0 ; w[i] -= rhs[i] ; } Message::Info("%d Iterations / Residual: %g", ipar[7], dnrm2_(&M->N,w,&un)); /* Message::Info("Conv. Rate: %g, |Res|: %g, |Err|: %g", fpar[7], dnrm2_(&M->N,w,&un), dnrm2_(&M->N,&w[M->N],&un)); */ Free(w); /* Inverse renumbering */ for (i=0;iN;i++) { j = M->S.permr[i] - 1; k = M->S.permp[j+M->N] - 1; x[i] = sol[k]; } /* Free memory */ Free(rhs); Free(sol); if (!M->ILU_Exists){ if(p->Preconditioner != NONE) { Free(M->S.alu); Free(M->S.jlu); Free(M->S.ju); } if (p->Renumbering_Technique == RCMK) { Free(M->S.rpermr); Free(M->S.permr); Free(M->S.permp); Free(M->S.a_rcmk); Free(M->S.ia_rcmk); Free(M->S.ja_rcmk); } } if(M->T == DENSE){ List_Delete(M->S.a); List_Delete(M->S.jptr); List_Delete(M->S.ai); } if(p->Scaling) scale_vector (COLUMN, M, x) ; } /* ------------------------------------------------------------------------ */ /* p r i n t */ /* ------------------------------------------------------------------------ */ void print_parametres (Solver_Params *p){ printf(" Matrix_Format : %d\n", p->Matrix_Format); printf(" Matrix_Printing : %d\n", p->Matrix_Printing); printf(" Renumbering_Technique : %d\n", p->Renumbering_Technique); printf(" Preconditioner : %d\n", p->Preconditioner); printf(" Preconditioner_Position : %d\n", p->Preconditioner_Position); printf(" Nb_Fill : %d\n", p->Nb_Fill); printf(" Dropping_Tolerance : %g\n", p->Dropping_Tolerance); printf(" Permutation_Tolerance : %g\n", p->Permutation_Tolerance); printf(" Diagonal_Compensation : %g\n", p->Diagonal_Compensation); printf(" Algorithm : %d\n", p->Algorithm); printf(" Krylov_Size : %d\n", p->Krylov_Size); printf(" IC_Acceleration : %g\n", p->IC_Acceleration); printf(" Iterative_Improvement : %d\n", p->Iterative_Improvement); printf(" Nb_Iter_Max : %d\n", p->Nb_Iter_Max); printf(" Stopping_Test : %g\n", p->Stopping_Test); } /* ------------------------------------------------------------------------ */ /* i n i t */ /* ------------------------------------------------------------------------ */ void init_matrix (int NbLines, Matrix *M, Solver_Params *p){ int i, j=0; M->T = p->Matrix_Format; M->N = NbLines; M->changed = 1 ; M->ILU_Exists = 0; M->notranspose = 0 ; M->scaled = 0 ; switch (M->T) { case SPARSE : M->S.a = List_Create (NbLines, NbLines, sizeof(double)); M->S.ai = List_Create (NbLines, NbLines, sizeof(int)); M->S.ptr = List_Create (NbLines, NbLines, sizeof(int)); M->S.jptr = List_Create (NbLines+1, NbLines, sizeof(int)); /* '+1' indispensable: csr_format ecrit 'nnz+1' dans jptr[NbLine] */ for(i=0; iS.jptr, &j); break; case DENSE : M->F.LU_Exist = 0; /* Tous les algos iteratifs sont programmes pour resoudre A^T x = b... C'est tres con, mais bon. L'algo LU est le seul qui demande la vraie matrice en entree... */ if(p->Algorithm == LU){ M->F.lu = (double*) Malloc (NbLines * NbLines * sizeof(double)); M->notranspose = 1 ; } else M->F.lu = NULL; M->F.a = (double*) Malloc (NbLines * NbLines * sizeof(double)); break; default : Message::Error("Unknown type of matrix storage format: %d", M->T); break; } } void init_vector (int Nb, double **V){ *V = (double*) Malloc (Nb * sizeof(double)); } /* ------------------------------------------------------------------------ */ /* f r e e */ /* ------------------------------------------------------------------------ */ void free_matrix (Matrix *M){ if(M->scaled){ Free(M->rowscal) ; Free(M->colscal) ; } switch (M->T) { case SPARSE : List_Delete(M->S.a); List_Delete(M->S.ai); List_Delete(M->S.ptr); List_Delete(M->S.jptr); break; case DENSE : Free(M->F.a); Free(M->F.lu); break; } } /* ------------------------------------------------------------------------ */ /* z e r o */ /* ------------------------------------------------------------------------ */ void zero_matrix (Matrix *M){ int i,j=0; M->changed = 1 ; switch (M->T) { case SPARSE : List_Reset (M->S.a); List_Reset (M->S.ai); List_Reset (M->S.ptr); List_Reset (M->S.jptr); for (i=0; iN; i++) List_Add (M->S.jptr, &j); break; case DENSE : for(i=0; i<(M->N)*(M->N); i++) M->F.a[i] = 0.0; break; } } void zero_matrix2 (Matrix *M){ int i, iptr; int *jptr, *ptr; double *a; M->changed = 1 ; switch (M->T) { case SPARSE : jptr = (int*) M->S.jptr->array; ptr = (int*) M->S.ptr->array; a = (double*) M->S.a->array; for (i=0; iN; i++) { iptr = jptr[i]; while (iptr>0) { a[iptr-1]= 0. ; iptr = ptr[iptr-1]; } } break; case DENSE : for(i=0; i<(M->N)*(M->N); i++) M->F.a[i] = 0.0; break; } } void zero_vector (int Nb, double *V){ int i; for(i=0; i u */ int i; for(i=0; i u */ int i; for(i=0; ichanged = 1 ; switch (M->T) { case SPARSE : il--; pp = (int*) M->S.jptr->array; ptr = (int*) M->S.ptr->array; ai = (int*) M->S.ai->array; a = (double*) M->S.a->array; iptr = pp[il]; iptr2 = iptr-1; while(iptr>0){ iptr2 = iptr-1; jptr = ai[iptr2]; if(jptr == ic){ a[iptr2] += val; return; } iptr = ptr[iptr2]; } List_Add (M->S.a, &val); List_Add (M->S.ai, &ic); List_Add (M->S.ptr, &zero); /* Les pointeurs ont pu etre modifies s'il y a eu une reallocation dans List_Add */ ptr = (int*) M->S.ptr->array; ai = (int*) M->S.ai->array; a = (double*) M->S.a->array; n = List_Nbr(M->S.a); if(!pp[il]) pp[il] = n; else ptr[iptr2] = n; break; case DENSE : if(M->notranspose) M->F.a[((M->N))*(il-1)+(ic-1)] += val; else M->F.a[((M->N))*(ic-1)+(il-1)] += val; break; } } void add_matrix_matrix (Matrix *M, Matrix *N){ /* M+N -> M */ int i, *ai, iptr, *jptr, *ptr; double *a; switch (M->T) { case SPARSE : jptr = (int*) N->S.jptr->array; ptr = (int*) N->S.ptr->array; a = (double*) N->S.a->array; ai = (int*) N->S.ai->array; for (i=0; iN; i++) { iptr = jptr[i]; while (iptr>0) { add_matrix_double (M, ai[iptr-1], i+1, a[iptr-1]); /* add_matrix_double transpose, donc pour additionner, il faut transposer une seconde fois */ iptr = ptr[iptr-1]; } } break; case DENSE : for(i=0; i<(M->N)*(M->N); i++) M->F.a[i] += N->F.a[i]; break; } } void add_matrix_prod_matrix_double (Matrix *M, Matrix *N, double d){ /* M+N*d -> M */ int i, *ai, iptr, *jptr, *ptr; double *a; switch (M->T) { case SPARSE : jptr = (int*) N->S.jptr->array; ptr = (int*) N->S.ptr->array; a = (double*) N->S.a->array; ai = (int*) N->S.ai->array; for (i=0; iN; i++) { iptr = jptr[i]; while (iptr>0) { add_matrix_double (M, ai[iptr-1], i+1, d*a[iptr-1]); /* add_matrix_double transpose, donc pour additionner, il faut transposer une seconde fois */ iptr = ptr[iptr-1]; } } break; case DENSE : for(i=0; i<(M->N)*(M->N); i++) M->F.a[i] += d*N->F.a[i]; break; } } /* ------------------------------------------------------------------------ */ /* s u b */ /* ------------------------------------------------------------------------ */ void sub_vector_vector_1 (int Nb, double *U, double *V){ /* u-v -> u */ int i; for(i=0; i v */ int i; for(i=0; i u */ int i; for(i=0; i prosca */ int i; *prosca = 0.0 ; for (i=0; iT) { case SPARSE : jptr = (int*) M->S.jptr->array; a = (double*) M->S.a->array; ai = (int*) M->S.ai->array; switch (scaling) { case DIAG_SCALING : rowscal = colscal = (double*)Malloc(M->N * sizeof(double)); /* extract diagonal */ idiag = (int*)Malloc(M->N * sizeof(int)); getdia_ (&M->N, &M->N, &job0, a, ai, jptr, &len, rowscal, idiag, &ioff) ; Free (idiag); for (i = 0 ; i < M->N ; i++){ if (rowscal[i]){ rowscal[i] = 1./sqrt(fabs(rowscal[i])) ; /* printf(" %d %e \n", i, rowscal[i] ); */ } else { Message::Warning("Diagonal scaling aborted because of zero diagonal element (%d)",i+1) ; Free (rowscal) ; return ; } } diamua_ (&M->N, &job1, a, ai, jptr, rowscal, a, ai, jptr) ; amudia_ (&M->N, &job1, a, ai, jptr, colscal, a, ai, jptr) ; break ; case MAX_SCALING : case NORM1_SCALING : case NORM2_SCALING : switch (scaling) { case MAX_SCALING : norm = 0 ; break ; case NORM1_SCALING : norm = 1 ; break ; case NORM2_SCALING : norm = 2 ; break ; } rowscal = (double*)Malloc(M->N * sizeof(double)); rnrms_ (&M->N, &norm, a, ai, jptr, rowscal); for (i = 0 ; i < M->N ; i++){ /* printf(" %d %e \n", i, rowscal[i] ); */ if (rowscal[i]) rowscal[i] = 1./rowscal[i] ; else { Message::Warning("Scaling aborted because of zero row (%d)", i+1) ; Free (rowscal) ; return ; } } diamua_ (&M->N, &job1, a, ai, jptr, rowscal, a, ai, jptr) ; colscal = (double*)Malloc(M->N * sizeof(double)); cnrms_ (&M->N, &norm, a, ai, jptr, colscal); for (i = 0 ; i < M->N ; i++){ if (colscal[i]){ colscal[i] = 1./colscal[i] ; /* printf(" %d %e %e \n", i, 1./rowscal[i], 1./colscal[i] ); */ } else { Message::Warning("Scaling aborted because of zero column (%d)", i+1) ; Free (colscal) ; return ; } } amudia_ (&M->N, &job1, a, ai, jptr, colscal, a, ai, jptr) ; break; default : Message::Error("Unknown type of matrix scaling: %d", scaling); break; } M->scaled = 1 ; M->rowscal = rowscal ; M->colscal = colscal ; break; case DENSE : Message::Warning("Scaling is not implemented for dense matrices") ; break; } } void scale_vector (int ROW_or_COLUMN, Matrix *M, double *V){ double *scal = NULL; int i; if (!M->scaled) return ; switch (ROW_or_COLUMN) { case 0 : scal = M->rowscal ; break ; case 1 : scal = M->colscal ; break ; } if (scal == NULL) Message::Error("scale_vector : no scaling factors available !") ; for (i = 0 ; i < M->N ; i++) V[i] *= scal[i] ; } void prod_matrix_vector (Matrix *M, double *V , double *res ){ /* M*V -> res ou M est la transposee!! */ int k, i, j, *ai, *jptr ; double *a; switch (M->T) { case SPARSE : /* csr_format transpose! donc la matrice arrivant dans cette routine doit bel et bien etre la transposee !!! */ if(M->changed){ csr_format (&M->S, M->N); restore_format (&M->S); M->changed = 0 ; } jptr = (int*) M->S.jptr->array; a = (double*) M->S.a->array; ai = (int*) M->S.ai->array; for(i=0; iN; i++){ res[i] = 0.0 ; for(k=jptr[i]; k<=jptr[i+1]-1; k++){ res[i] += V[ai[k-1]-1] * a[k-1]; } } break; case DENSE : if(M->notranspose){ for(i=0; iN; i++){ res[i] = 0.0 ; for(j=0; jN; j++) res[i] += M->F.a[(M->N)*i+j] * V[j]; } } else{ for(i=0; iN; i++){ res[i] = 0.0 ; for(j=0; jN; j++) res[i] += M->F.a[(M->N)*j+i] * V[j]; } } break; } } void prod_matrix_double (Matrix *M, double v){ /* M*v -> M */ int i; double *a; switch (M->T) { case SPARSE : a = (double*) M->S.a->array; for(i=0; iS.a); i++){ a[i] *= v; } break; case DENSE : for(i=0; i<(M->N)*(M->N); i++) M->F.a[i] *= v; break; } } void multi_prod_matrix_double(int n, Matrix **Mat, double *coef, Matrix *MatRes){ int k; zero_matrix(MatRes); for(k=0;k proscar + i prodscai */ int i; *proscar = *proscai = 0.0 ; for (i=0; i *norm) *norm = fabs(U[i]); } /* ------------------------------------------------------------------------ */ /* i d e n t i t y */ /* ------------------------------------------------------------------------ */ void identity_matrix (Matrix *M){ int i; zero_matrix(M); for (i=1;i<=M->N;i++) add_matrix_double(M,i,i,1.0); } /* ------------------------------------------------------------------------ */ /* w r i t e */ /* ------------------------------------------------------------------------ */ void binary_write_matrix (Matrix *M, const char *name, const char *ext){ int Nb; FILE *pfile; char filename[256]; if(!M->N){ Message::Warning("No elements in matrix"); return; } strcpy(filename, name); strcat(filename, ext); pfile = fopen(filename, "wb") ; fprintf(pfile,"%d\n",M->T); switch (M->T) { case SPARSE : Nb = List_Nbr(M->S.a) ; fprintf(pfile,"%d %d\n", M->N, Nb); fprintf(pfile,"%d %d %d %d %d\n", M->S.ptr->nmax, M->S.ptr->size, M->S.ptr->incr, M->S.ptr->n, M->S.ptr->isorder); fprintf(pfile,"%d %d %d %d %d\n", M->S.ai->nmax, M->S.ai->size, M->S.ai->incr, M->S.ai->n, M->S.ai->isorder); fprintf(pfile,"%d %d %d %d %d\n", M->S.jptr->nmax, M->S.jptr->size, M->S.jptr->incr, M->S.jptr->n, M->S.jptr->isorder); fprintf(pfile,"%d %d %d %d %d\n", M->S.a->nmax, M->S.a->size, M->S.a->incr, M->S.a->n, M->S.a->isorder); fwrite(M->S.ptr->array, sizeof(int), Nb, pfile); fwrite(M->S.ai->array, sizeof(int), Nb, pfile); fwrite(M->S.jptr->array, sizeof(int), M->N, pfile); fwrite(M->S.a->array, sizeof(double), Nb, pfile); break; case DENSE : fprintf(pfile,"%d\n", M->N); fwrite(M->F.a, sizeof(double), M->N*M->N, pfile); break; } fclose(pfile) ; } void binary_write_vector (int Nb, double *V, const char *name, const char *ext){ char filename[256]; FILE *pfile; strcpy(filename, name); strcat(filename, ext); pfile = fopen(filename, "wb") ; fwrite(V, sizeof(double), Nb, pfile); fclose(pfile) ; } void formatted_write_matrix (FILE *pfile, Matrix *M, int style){ int *ptr,*ai,i,j,*jptr, *ia, *ja, *ir, nnz, ierr; int un=1; double *a; if(!M->N){ Message::Warning("No element in matrix"); return; } switch (M->T) { case DENSE : if(M->notranspose) for(i=0 ; iN ; i++) for(j=0 ; jN ; j++) fprintf(pfile,"%d %d %.16g\n", j+1, i+1, M->F.a[i*(M->N)+j]); else for(i=0 ; iN ; i++) for(j=0 ; jN ; j++) fprintf(pfile,"%d %d %.16g\n", i+1, j+1, M->F.a[i*(M->N)+j]); break; case SPARSE : switch(style){ case ELAP : fprintf(pfile,"%d\n",M->T); a = (double*)M->S.a->array; ai = (int*)M->S.ai->array; ptr = (int*)M->S.ptr->array; jptr = (int*)M->S.jptr->array; fprintf(pfile,"%d\n",M->N); fprintf(pfile,"%d\n",List_Nbr(M->S.a)); for(i=0;iN;i++) fprintf(pfile," %d",jptr[i]); fprintf(pfile,"\n"); for(i=0;iS.a);i++) fprintf(pfile,"%d %d %.16g \n",ai[i],ptr[i],a[i]); break; case KUL : csr_format(&M->S, M->N); a = (double*) M->S.a->array; ia = (int*) M->S.jptr->array; ja = (int*) M->S.ptr->array; nnz = List_Nbr(M->S.a); ir = (int*) Malloc(nnz * sizeof(int)); csrcoo_(&M->N, &un, &nnz, a, ja, ia, &nnz, a, ir, ja, &ierr); for(i=0 ; iS); break; default : Message::Error("Unknown print style for formatted matrix output"); } break ; default : Message::Error("Unknown matrix format for formatted matrix output"); } } void formatted_write_vector (FILE *pfile, int Nb, double *V, int style){ int i; /* for(i=0 ; iT); M->ILU_Exists = 0; switch (M->T) { case SPARSE : fscanf(pfile,"%d %d\n", &M->N, &Nb); M->S.ptr = List_Create (Nb, 1, sizeof(int)); M->S.ai = List_Create (Nb, 1, sizeof(int)); M->S.jptr = List_Create (M->N, 1, sizeof(int)); M->S.a = List_Create (Nb, 1, sizeof(double)); fscanf(pfile,"%d %d %d %d %d\n", &M->S.ptr->nmax, &M->S.ptr->size, &M->S.ptr->incr, &M->S.ptr->n, &M->S.ptr->isorder); fscanf(pfile,"%d %d %d %d %d\n", &M->S.ai->nmax, &M->S.ai->size, &M->S.ai->incr, &M->S.ai->n, &M->S.ai->isorder); fscanf(pfile,"%d %d %d %d %d\n", &M->S.jptr->nmax, &M->S.jptr->size, &M->S.jptr->incr, &M->S.jptr->n, &M->S.jptr->isorder); fscanf(pfile,"%d %d %d %d %d\n", &M->S.a->nmax, &M->S.a->size, &M->S.a->incr, &M->S.a->n, &M->S.a->isorder); fread(M->S.ptr->array, sizeof(int), Nb, pfile); fread(M->S.ai->array, sizeof(int), Nb, pfile); fread(M->S.jptr->array, sizeof(int), M->N, pfile); fread(M->S.a->array, sizeof(double), Nb, pfile); break; case DENSE : fscanf(pfile,"%d\n", &M->N); M->F.LU_Exist = 0; M->F.a = (double*) Malloc(M->N * M->N * sizeof(double)); M->F.lu = (double*) Malloc(M->N * M->N * sizeof(double)); fread(M->F.a, sizeof(double), M->N * M->N, pfile); break ; } fclose(pfile) ; } void binary_read_vector (int Nb, double **V, const char *name, const char *ext){ char filename[256]; FILE *pfile; strcpy(filename, name); strcat(filename, ext); pfile = fopen(filename, "rb") ; if (pfile == NULL) { Message::Error("Error opening file %s", filename); } init_vector(Nb, V); fread(*V, sizeof(double), Nb, pfile); fclose(pfile) ; } void formatted_read_matrix (Matrix *M, const char *name , const char *ext, int style){ int i,nnz,inb,inb2; double nb; FILE *pfile; char filename[256]; strcpy(filename, name); strcat(filename, ext); pfile = fopen(filename, "r") ; if (pfile == NULL) { Message::Error("Error opening file %s", filename); } fscanf(pfile,"%d",&M->T); switch (M->T) { case SPARSE : List_Reset(M->S.jptr); fscanf(pfile,"%d",&M->N); fscanf(pfile,"%d",&nnz); for(i=0;iN;i++){ fscanf(pfile," %d",&inb); List_Add(M->S.jptr,&inb); } for(i=0;iS.ai,&inb); List_Add(M->S.ptr,&inb2); List_Add(M->S.a,&nb); } break; case DENSE : fscanf(pfile,"%d",&M->N); for(i=0;i<(M->N)*(M->N);i++){ fscanf(pfile,"%d %lf ", &inb, &M->F.a[i]); } break; } fclose(pfile) ; } void formatted_read_vector (int Nb, double *V, const char *name, const char *ext, int style){ int i; FILE *pfile; char filename[256]; strcpy(filename, name); strcat(filename, ext); pfile = fopen(filename, "r") ; if (pfile == NULL) { Message::Error("Error opening file %s", filename); } for(i=0 ; ib) return(a); else return(b); } void print_matrix_info_CSR (int N, int *jptr, int *ai){ int i, j, k, l, m, n; l = n = 0; j = jptr[N]-1 ; for (i=0; iT) { case SPARSE : /* csr_format transpose! donc la matrice arrivant dans cette routine doit bel et bien etre la transposee !!! */ if(M->changed){ csr_format (&M->S, M->N); restore_format (&M->S); M->changed = 0 ; } jptr = (int*) M->S.jptr->array; a = (double*) M->S.a->array; ai = (int*) M->S.ai->array; for(i=0; iN; i++){ /* lignes */ found=0; for(k=jptr[i]-1;k col) { break; } } if (!found) V[i]=0; /* printf(" V[%d] = %g \n",i, V[i]); */ } break; case DENSE : if(M->notranspose){ for(j=0; jN; j++) V[j] = M->F.a[(M->N)*col+j]; } else{ for(i=0; iN; i++){ for(j=0; jN; j++) V[j] = M->F.a[(M->N)*j+col]; } } break; } } void get_element_in_matrix (Matrix *M, int row, int col, double *V){ int k, i, *ai, *jptr ; double *a; int found; switch (M->T) { case SPARSE : /* csr_format transpose! donc la matrice arrivant dans cette routine doit bel et bien etre la transposee !!! */ if(M->changed){ csr_format (&M->S, M->N); restore_format (&M->S); M->changed = 0 ; } jptr = (int*) M->S.jptr->array; a = (double*) M->S.a->array; ai = (int*) M->S.ai->array; for(i=0; iN; i++){ /* lignes */ found=0; for(k=jptr[i]-1;k col) { break; } } if (!found) V[i]=0; /* printf(" V[%d] = %g \n",i, V[i]); */ } break; case DENSE : if(M->notranspose){ *V = M->F.a[(M->N)*col+row]; } else{ for(i=0; iN; i++){ *V = M->F.a[(M->N)*row+col]; } } break; } } /* ------------------------------------------------------------------------ */ /* S o l v e r p a r a m e t e r s */ /* ------------------------------------------------------------------------ */ static char comALGORITHM[] = "\n%s (Integer): \n\ - 1 CG Conjugate Gradient \n\ - 2 CGNR CG (Normal Residual equation) \n\ - 3 BCG Bi-Conjugate Gradient \n\ - 4 DBCG BCG with partial pivoting \n\ - 5 BCGSTAB BCG stabilized \n\ - 6 TFQMR Transpose-Free Quasi-Minimum Residual \n\ - 7 FOM Full Orthogonalization Method \n\ - 8 GMRES Generalized Minimum RESidual \n\ - 9 FGMRES Flexible version of GMRES \n\ - 10 DQGMRES Direct versions of GMRES \n\ - 11 LU LU Factorization \n\ - 12 PGMRES Alternative version of GMRES \n\ - default : %d\n"; static char comPRECONDITIONER[] = "\n%s (Integer): \n\ - 0 NONE No Factorization\n\ - 1 ILUT Incomplete LU factorization with dual truncation strategy \n\ - 2 ILUTP ILUT with column pivoting \n\ - 3 ILUD ILU with single dropping + diagonal compensation (~MILUT) \n\ - 4 ILUDP ILUD with column pivoting \n\ - 5 ILUK level-k ILU \n\ - 6 ILU0 simple ILU(0) preconditioning \n\ - 7 MILU0 MILU(0) preconditioning \n\ - 8 DIAGONAL \n\ - default : %d \n"; static char comPRECONDITIONER_POSITION[] = "\n%s (Integer): \n\ - 0 No Preconditioner \n\ - 1 Left Preconditioner \n\ - 2 Right Preconditioner \n\ - 3 Both Left and Right Preconditioner \n\ - default : %d \n"; static char comRENUMBERING_TECHNIQUE[] = "\n%s (Integer): \n\ - 0 No renumbering \n\ - 1 Reverse Cuthill-Mc Kee \n\ - default : %d \n"; static char comNB_ITER_MAX[] = "\n%s (Integer): Maximum number of iterations \n\ - default : %d \n"; static char comMATRIX_FORMAT[] = "\n%s (Integer): \n\ - 1 Sparse \n\ - 2 Full \n\ - default : %d\n"; static char comMATRIX_PRINTING[] = "\n%s (Integer): Disk write ('fort.*') \n\ - 1 matrix (csr) \n\ - 2 preconditioner (msr) \n\ - 3 both \n\ - default : %d\n"; static char comMATRIX_STORAGE[] = "\n%s (Integer): Disk Write or Read in internal format \n\ - 0 none \n\ - 1 write matrix (sparse) \n\ - 2 read matrix (sparse) \n\ - default : %d\n"; static char comNB_FILL[] = "\n%s (Integer): \n\ - ILUT/ILUTP : maximum number of elements per line \n\ of L and U (except diagonal element) \n\ - ILUK : each element whose fill-in level is greater than NB_FILL \n\ is dropped. \n\ - default : %d\n"; static char comKRYLOV_SIZE[] = "\n%s (Integer): Krylov subspace size \n\ - default : %d\n"; static char comSTOPPING_TEST[] = "\n%s (Real): Target relative residual \n\ - default : %g \n"; static char comIC_ACCELERATION[] = "\n%s (Real): IC accelerator\n\ - default : %g \n"; static char comITERATIVE_IMPROVEMENT[] = "\n%s (Integer): Iterative improvement of the solution obtained by a LU \n\ - default : %d\n"; static char comDROPPING_TOLERANCE[] = "\n%s (Real): \n\ - ILUT/ILUTP/ILUK: a(i,j) is dropped if \n\ abs(a(i,j)) < DROPPING_TOLERANCE * abs(diagonal element in U). \n\ - ILUD/ILUDP : a(i,j) is dropped if \n\ abs(a(i,j)) < DROPPING_TOLERANCE * [weighted norm of line i]. \n\ Weighted norm = 1-norm / number of nonzero elements on the line. \n\ - default : %g\n"; static char comPERMUTATION_TOLERANCE[] = "\n%s (Real): Tolerance for column permutation in ILUTP/ILUDP. \n\ At stage i, columns i and j are permuted if \n\ abs(a(i,j))*PERMUTATION_TOLERANCE > abs(a(i,i)). \n\ - 0 no permutations \n\ - 0.001 -> 0.1 classical \n\ - default : %g\n"; static char comRE_USE_LU[] = "\n%s (Integer): Reuse LU decomposition\n\ - 0 no \n\ - 1 yes \n\ - default : %d\n"; static char comRE_USE_ILU[] = "\n%s (Integer): Reuse ILU decomposition (and renumbering if any)\n\ - 0 no \n\ - 1 yes \n\ - default : %d\n"; static char comDIAGONAL_COMPENSATION[] = "\n%s (Real): ILUD/ILUDP: the term 'DIAGONAL_COMPENSATION * (sum \n\ of all dropped elements of the line)' is added to the diagonal element in U \n\ - 0 ~ ILU with threshold \n\ 1 ~ MILU with threshold. \n\ - default : %g\n"; static char comSCALING[] = "\n%s (Integer): Scale system \n\ - 0 no \n\ - 1 on basis of diagonal elements (no loss of possible symmetry) \n\ - 2 on basis of inf. norm of first rows and then columns (asymmetric) \n\ - 3 on basis of norm 1 of first rows and then columns (asymmetric) \n\ - 4 on basis of norm 2 of first rows and then columns (asymmetric) \n\ - default : %d\n"; /* ------------------------------------------------------------------------ */ /* A c t i o n s */ /* ------------------------------------------------------------------------ */ #define act_ARGS Solver_Params *p, int i, double d void actALGORITHM (act_ARGS){ p->Algorithm = i; } void actPRECONDITIONER (act_ARGS){ p->Preconditioner = i; } void actPRECONDITIONER_POSITION (act_ARGS){ p->Preconditioner_Position = i; } void actRENUMBERING_TECHNIQUE (act_ARGS){ p->Renumbering_Technique = i; } void actNB_ITER_MAX (act_ARGS){ p->Nb_Iter_Max = i; } void actMATRIX_FORMAT (act_ARGS){ p->Matrix_Format = i; } void actMATRIX_PRINTING (act_ARGS){ p->Matrix_Printing = i; } void actMATRIX_STORAGE (act_ARGS){ p->Matrix_Storage = i; } void actNB_FILL (act_ARGS){ p->Nb_Fill = i; } void actKRYLOV_SIZE (act_ARGS){ p->Krylov_Size = i; } void actSTOPPING_TEST (act_ARGS){ p->Stopping_Test = d; } void actIC_ACCELERATION (act_ARGS){ p->IC_Acceleration = d; } void actITERATIVE_IMPROVEMENT (act_ARGS){ p->Iterative_Improvement = i; } void actRE_USE_LU (act_ARGS){ p->Re_Use_LU = i; } void actDROPPING_TOLERANCE (act_ARGS){ p->Dropping_Tolerance = d; } void actPERMUTATION_TOLERANCE (act_ARGS){ p->Permutation_Tolerance = d; } void actRE_USE_ILU (act_ARGS){ p->Re_Use_ILU = i; } void actDIAGONAL_COMPENSATION (act_ARGS){ p->Diagonal_Compensation = d; } void actSCALING (act_ARGS){ p->Scaling = i; } /* ------------------------------------------------------------------------ */ /* P a r a m e t e r s w i t h d e f a u l t v a l u e s */ /* ------------------------------------------------------------------------ */ #define REEL 1 #define ENTIER 2 typedef struct { const char *str; int typeinfo; int defaultint; double defaultfloat; const char *com; void (*action) (Solver_Params *p , int i , double d); }InfoSolver; int compInfoSolver(const void *a, const void *b){ return(strcmp(((InfoSolver*)a)->str, ((InfoSolver*)b)->str)); } static InfoSolver Tab_Params[] = { {"Matrix_Format", ENTIER, 1, 0., comMATRIX_FORMAT, actMATRIX_FORMAT}, {"Matrix_Printing", ENTIER, 0, 0., comMATRIX_PRINTING, actMATRIX_PRINTING}, {"Matrix_Storage", ENTIER, 0, 0., comMATRIX_STORAGE, actMATRIX_STORAGE}, {"Scaling", ENTIER, 0, 0., comSCALING, actSCALING}, {"Renumbering_Technique", ENTIER, 1, 0., comRENUMBERING_TECHNIQUE, actRENUMBERING_TECHNIQUE}, {"Preconditioner", ENTIER, 2, 0., comPRECONDITIONER, actPRECONDITIONER}, {"Preconditioner_Position", ENTIER, 2, 0., comPRECONDITIONER_POSITION, actPRECONDITIONER_POSITION}, {"Nb_Fill", ENTIER, 20, 0., comNB_FILL, actNB_FILL}, {"Permutation_Tolerance", REEL, 0, 5.e-2, comPERMUTATION_TOLERANCE, actPERMUTATION_TOLERANCE}, {"Dropping_Tolerance", REEL, 0, 0., comDROPPING_TOLERANCE, actDROPPING_TOLERANCE}, {"Diagonal_Compensation", REEL, 0, 0., comDIAGONAL_COMPENSATION, actDIAGONAL_COMPENSATION}, {"Re_Use_ILU", ENTIER, 0, 0., comRE_USE_ILU, actRE_USE_ILU}, {"Algorithm", ENTIER, 8, 0., comALGORITHM, actALGORITHM}, {"Krylov_Size", ENTIER, 40, 0., comKRYLOV_SIZE, actKRYLOV_SIZE}, {"IC_Acceleration", REEL, 0, 1., comIC_ACCELERATION, actIC_ACCELERATION}, {"Re_Use_LU", ENTIER, 0, 0., comRE_USE_LU, actRE_USE_LU}, {"Iterative_Improvement", ENTIER, 0, 0., comITERATIVE_IMPROVEMENT, actITERATIVE_IMPROVEMENT}, {"Nb_Iter_Max", ENTIER, 1000, 0., comNB_ITER_MAX, actNB_ITER_MAX}, {"Stopping_Test", REEL, 0, 1.e-10,comSTOPPING_TEST, actSTOPPING_TEST} }; /* ------------------------------------------------------------------------ */ /* i n i t _ s o l v e r */ /* ------------------------------------------------------------------------ */ #define NbInfosSolver (int)(sizeof(Tab_Params)/sizeof(Tab_Params[0])) void Commentaires (FILE *out){ int i; InfoSolver *pI; for(i=0;itypeinfo){ case REEL : fprintf(out,pI->com,pI->str,pI->defaultfloat); break; case ENTIER : fprintf(out,pI->com,pI->str,pI->defaultint); break; } } fprintf(out,"\n"); } void init_solver (Solver_Params *p , const char *name){ char buff[128]; FILE *file; InfoSolver *pI,I; int i; double ff; int ii; for(i=0;iaction)(p,pI->defaultint,pI->defaultfloat); } if(!(file = fopen(name,"r"))){ file = fopen(name,"w"); if(!file){ Message::Warning("Could not open solver parameter file"); return; } fprintf(file,"/*\n"); Commentaires(file); fprintf(file,"*/\n\n"); Message::Info("Parameter file not found"); Message::Info("Enter parameter values:"); for(i=0;itypeinfo){ case REEL : getfloat : if(Message::UseSocket() || Message::UseOnelab()) strcpy(buff, "\n"); else{ printf("%25s (Real) [=help, =%g]: ",pI->str,pI->defaultfloat); fgets(buff, 128, stdin); } if(!strcmp(buff,"h\n")){ printf(pI->com,pI->str,pI->defaultfloat); printf("\n"); goto getfloat; } if(!strcmp(buff,"\n")){ fprintf(file,"%25s %12g\n",pI->str,pI->defaultfloat); (pI->action)(p,pI->defaultint,pI->defaultfloat); } else{ fprintf(file,"%25s %12g\n",pI->str,atof(buff)); (pI->action)(p,pI->defaultint,atof(buff)); } break; case ENTIER : getint : if(Message::UseSocket() || Message::UseOnelab()){ strcpy(buff, "\n"); } else{ printf("%25s (Integer) [=help, =%d]: ",pI->str,pI->defaultint); fgets(buff, 128, stdin); } if(!strcmp(buff,"h\n")){ printf(pI->com,pI->str,pI->defaultint); printf("\n"); goto getint; } if(!strcmp(buff,"\n")){ fprintf(file,"%25s %12d\n",pI->str,pI->defaultint); (pI->action)(p,pI->defaultint,pI->defaultfloat); } else{ fprintf(file,"%25s %12d\n",pI->str,atoi(buff)); (pI->action)(p,atoi(buff),pI->defaultfloat); } break; } } } else { qsort(Tab_Params, NbInfosSolver, sizeof(InfoSolver), compInfoSolver); rewind(file); while (!feof(file)){ fscanf(file,"%s",buff); I.str = buff; if(!(pI = (InfoSolver*)bsearch(&I,Tab_Params, NbInfosSolver, sizeof(InfoSolver),compInfoSolver))){ if(buff[0] == '/' && buff[1] == '*'){ while(1){ if(feof(file)){ Message::Warning("End of comment not detected"); fclose(file); return; } if((getc(file)=='*')&&(getc(file)=='/')){ break; } } } else{ Message::Warning("Unknown solver parameter '%s'", buff); fscanf(file,"%s",buff); } } else{ switch(pI->typeinfo){ case REEL : fscanf(file,"%lf",&ff); (pI->action)(p,ii,ff); break; case ENTIER : fscanf(file,"%d",&ii); (pI->action)(p,ii,ff); break; } } } } fclose(file); } void init_solver_option (Solver_Params *p , const char *name, const char *value){ InfoSolver *pI; int i, vali; float valf; for(i=0;istr, name)){ switch(pI->typeinfo){ case REEL : valf = atof(value); (pI->action)(p,pI->defaultint,valf); Message::Info("Overriding parameter '%s': %g", pI->str, valf); break; case ENTIER : vali = atoi(value); (pI->action)(p,vali,pI->defaultfloat); Message::Info("Overriding parameter '%s': %d", pI->str, vali); break; } return; } } Message::Error("Unknown solver parameter '%s'", name); } /* ------------------------------------------------------------------------ */ /* dynamic CSR format */ /* ------------------------------------------------------------------------ */ static int cmpij(int ai,int aj,int bi,int bj){ if(aibi)return 1; if(ajbj)return 1; return 0; } static int *alloc_ivec(long nl, long nh){ int *v; v=(int *)Malloc((size_t) ((nh-nl+1+1)*sizeof(int))); return v-nl+1; } static void free_ivec(int *v, long nl, long nh){ Free(v+nl-1); } #define SWAP(a,b) temp=(a);(a)=(b);(b)=temp; #define SWAPI(a,b) tempi=(a);(a)=(b);(b)=tempi; #define M 7 #define NSTACK 50 #define M1 -1 static void sort2(unsigned long n, double arr[], int ai[] , int aj []){ unsigned long i,ir=n,j,k,l=1; int *istack,jstack=0,tempi; double a,temp; int b,c; istack=alloc_ivec(1,NSTACK); for (;;) { if (ir-l < M) { for (j=l+1;j<=ir;j++) { a=arr[j M1]; b=ai[j M1]; c=aj[j M1]; for (i=j-1;i>=1;i--) { if (cmpij(ai[i M1],aj[i M1],b,c) <= 0) break; arr[i+1 M1]=arr[i M1]; ai[i+1 M1]=ai[i M1]; aj[i+1 M1]=aj[i M1]; } arr[i+1 M1]=a; ai[i+1 M1]=b; aj[i+1 M1]=c; } if (!jstack) { free_ivec(istack,1,NSTACK); return; } ir=istack[jstack]; l=istack[jstack-1]; jstack -= 2; } else { k=(l+ir) >> 1; SWAP(arr[k M1],arr[l+1 M1]) SWAPI(ai[k M1],ai[l+1 M1]) SWAPI(aj[k M1],aj[l+1 M1]) if (cmpij(ai[l+1 M1],aj[l+1 M1],ai[ir M1],aj[ir M1])>0){ SWAP(arr[l+1 M1],arr[ir M1]) SWAPI(ai[l+1 M1],ai[ir M1]) SWAPI(aj[l+1 M1],aj[ir M1]) } if (cmpij(ai[l M1],aj[l M1],ai[ir M1],aj[ir M1])>0){ SWAP(arr[l M1],arr[ir M1]) SWAPI(ai[l M1],ai[ir M1]) SWAPI(aj[l M1],aj[ir M1]) } if (cmpij(ai[l+1 M1],aj[l+1 M1],ai[l M1],aj[l M1])>0){ SWAP(arr[l+1 M1],arr[l M1]) SWAPI(ai[l+1 M1],ai[l M1]) SWAPI(aj[l+1 M1],aj[l M1]) } i=l+1; j=ir; a=arr[l M1]; b=ai[l M1]; c=aj[l M1]; for (;;) { do i++; while (cmpij(ai[i M1],aj[i M1],b,c) < 0); do j--; while (cmpij(ai[j M1],aj[j M1],b,c) > 0); if (j < i) break; SWAP(arr[i M1],arr[j M1]) SWAPI(ai[i M1],ai[j M1]) SWAPI(aj[i M1],aj[j M1]) } arr[l M1]=arr[j M1]; arr[j M1]=a; ai[l M1]=ai[j M1]; ai[j M1]=b; aj[l M1]=aj[j M1]; aj[j M1]=c; jstack += 2; if (jstack > NSTACK) { Message::Error("NSTACK too small in sort2"); } if (ir-i+1 >= j-l) { istack[jstack]=ir; istack[jstack-1]=i; ir=j-1; } else { istack[jstack]=j-1; istack[jstack-1]=l; l=i; } } } } #undef M #undef NSTACK #undef SWAP #undef SWAPI #undef M1 static void deblign ( int nz , int *ptr , int *jptr , int *ai){ int i,ilign; ilign = 1; jptr[0] = 1; for(i=1; iptr->array; jptr = (int*)MM->jptr->array; ai = (int*)MM->ai->array; a = (double*)MM->a->array; n = N; for(i=0;ia),a,ai,ptr); deblign(List_Nbr(MM->a),ptr,jptr,ai); jptr[N]=List_Nbr(MM->a)+1; } void restore_format (Sparse_Matrix *MM){ char *temp; temp = MM->ptr->array; MM->ptr->array = MM->ai->array; MM->ai->array = temp; } getdp-2.7.0-source/contrib/Sparskit/unary.f000644 001750 001750 00000323625 11266605601 022364 0ustar00geuzainegeuzaine000000 000000 c $Id: unary.f,v 1.1 2008-04-11 06:01:06 geuzaine Exp $ c----------------------------------------------------------------------c c S P A R S K I T c c----------------------------------------------------------------------c c UNARY SUBROUTINES MODULE c c----------------------------------------------------------------------c c contents: c c---------- c c submat : extracts a submatrix from a sparse matrix. c c filter : filters elements from a matrix according to their magnitude.c c filterm: same as above, but for the MSR format c c csort : sorts the elements in increasing order of columns c c clncsr : clean up the CSR format matrix, remove duplicate entry, etc c c transp : in-place transposition routine (see also csrcsc in formats) c c copmat : copy of a matrix into another matrix (both stored csr) c c msrcop : copies a matrix in MSR format into a matrix in MSR format c c getelm : returns a(i,j) for any (i,j) from a CSR-stored matrix. c c getdia : extracts a specified diagonal from a matrix. c c getl : extracts lower triangular part c c getu : extracts upper triangular part c c levels : gets the level scheduling structure for lower triangular c c matrices. c c amask : extracts C = A mask M c c rperm : permutes the rows of a matrix (B = P A) c c cperm : permutes the columns of a matrix (B = A Q) c c dperm : permutes both the rows and columns of a matrix (B = P A Q ) c c dperm1 : general extractiob routine (extracts arbitrary rows) c c dperm2 : general submatrix permutation/extraction routine c c dmperm : symmetric permutation of row and column (B=PAP') in MSR fmt c c dvperm : permutes a real vector (in-place) c c ivperm : permutes an integer vector (in-place) c c retmx : returns the max absolute value in each row of the matrix c c diapos : returns the positions of the diagonal elements in A. c c extbdg : extracts the main diagonal blocks of a matrix. c c getbwd : returns the bandwidth information on a matrix. c c blkfnd : finds the block-size of a matrix. c c blkchk : checks whether a given integer is the block size of A. c c infdia : obtains information on the diagonals of A. c c amubdg : gets number of nonzeros in each row of A*B (as well as NNZ) c c aplbdg : gets number of nonzeros in each row of A+B (as well as NNZ) c c rnrms : computes the norms of the rows of A c c cnrms : computes the norms of the columns of A c c roscal : scales the rows of a matrix by their norms. c c coscal : scales the columns of a matrix by their norms. c c addblk : Adds a matrix B into a block of A. c c get1up : Collects the first elements of each row of the upper c c triangular portion of the matrix. c c xtrows : extracts given rows from a matrix in CSR format. c c csrkvstr: Finds block row partitioning of matrix in CSR format c c csrkvstc: Finds block column partitioning of matrix in CSR format c c kvstmerge: Merges block partitionings, for conformal row/col pattern c c----------------------------------------------------------------------c subroutine submat (n,job,i1,i2,j1,j2,a,ja,ia,nr,nc,ao,jao,iao) integer n,job,i1,i2,j1,j2,nr,nc,ia(*),ja(*),jao(*),iao(*) real*8 a(*),ao(*) c----------------------------------------------------------------------- c extracts the submatrix A(i1:i2,j1:j2) and puts the result in c matrix ao,iao,jao c---- In place: ao,jao,iao may be the same as a,ja,ia. c-------------- c on input c--------- c n = row dimension of the matrix c i1,i2 = two integers with i2 .ge. i1 indicating the range of rows to be c extracted. c j1,j2 = two integers with j2 .ge. j1 indicating the range of columns c to be extracted. c * There is no checking whether the input values for i1, i2, j1, c j2 are between 1 and n. c a, c ja, c ia = matrix in compressed sparse row format. c c job = job indicator: if job .ne. 1 then the real values in a are NOT c extracted, only the column indices (i.e. data structure) are. c otherwise values as well as column indices are extracted... c c on output c-------------- c nr = number of rows of submatrix c nc = number of columns of submatrix c * if either of nr or nc is nonpositive the code will quit. c c ao, c jao,iao = extracted matrix in general sparse format with jao containing c the column indices,and iao being the pointer to the beginning c of the row,in arrays a,ja. c----------------------------------------------------------------------c c Y. Saad, Sep. 21 1989 c c----------------------------------------------------------------------c nr = i2-i1+1 nc = j2-j1+1 c if ( nr .le. 0 .or. nc .le. 0) return c klen = 0 c c simple procedure. proceeds row-wise... c do 100 i = 1,nr ii = i1+i-1 k1 = ia(ii) k2 = ia(ii+1)-1 iao(i) = klen+1 c----------------------------------------------------------------------- do 60 k=k1,k2 j = ja(k) if (j .ge. j1 .and. j .le. j2) then klen = klen+1 if (job .eq. 1) ao(klen) = a(k) jao(klen) = j - j1+1 endif 60 continue 100 continue iao(nr+1) = klen+1 return c------------end-of submat---------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine filter(n,job,drptol,a,ja,ia,b,jb,ib,len,ierr) real*8 a(*),b(*),drptol integer ja(*),jb(*),ia(*),ib(*),n,job,len,ierr c----------------------------------------------------------------------- c This module removes any elements whose absolute value c is small from an input matrix A and puts the resulting c matrix in B. The input parameter job selects a definition c of small. c----------------------------------------------------------------------- c on entry: c--------- c n = integer. row dimension of matrix c job = integer. used to determine strategy chosen by caller to c drop elements from matrix A. c job = 1 c Elements whose absolute value is less than the c drop tolerance are removed. c job = 2 c Elements whose absolute value is less than the c product of the drop tolerance and the Euclidean c norm of the row are removed. c job = 3 c Elements whose absolute value is less that the c product of the drop tolerance and the largest c element in the row are removed. c c drptol = real. drop tolerance used for dropping strategy. c a c ja c ia = input matrix in compressed sparse format c len = integer. the amount of space available in arrays b and jb. c c on return: c---------- c b c jb c ib = resulting matrix in compressed sparse format. c c ierr = integer. containing error message. c ierr .eq. 0 indicates normal return c ierr .gt. 0 indicates that there is'nt enough c space is a and ja to store the resulting matrix. c ierr then contains the row number where filter stopped. c note: c------ This module is in place. (b,jb,ib can ne the same as c a, ja, ia in which case the result will be overwritten). c----------------------------------------------------------------------c c contributed by David Day, Sep 19, 1989. c c----------------------------------------------------------------------c c local variables real*8 norm,loctol integer index,row,k,k1,k2 c index = 1 do 10 row= 1,n k1 = ia(row) k2 = ia(row+1) - 1 ib(row) = index goto (100,200,300) job 100 norm = 1.0d0 goto 400 200 norm = 0.0d0 do 22 k = k1,k2 norm = norm + a(k) * a(k) 22 continue norm = sqrt(norm) goto 400 300 norm = 0.0d0 do 23 k = k1,k2 if( abs(a(k)) .gt. norm) then norm = abs(a(k)) endif 23 continue 400 loctol = drptol * norm do 30 k = k1,k2 if( abs(a(k)) .gt. loctol)then if (index .gt. len) then ierr = row return endif b(index) = a(k) jb(index) = ja(k) index = index + 1 endif 30 continue 10 continue ib(n+1) = index return c--------------------end-of-filter ------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine filterm (n,job,drop,a,ja,b,jb,len,ierr) real*8 a(*),b(*),drop integer ja(*),jb(*),n,job,len,ierr c----------------------------------------------------------------------- c This subroutine removes any elements whose absolute value c is small from an input matrix A. Same as filter but c uses the MSR format. c----------------------------------------------------------------------- c on entry: c--------- c n = integer. row dimension of matrix c job = integer. used to determine strategy chosen by caller to c drop elements from matrix A. c job = 1 c Elements whose absolute value is less than the c drop tolerance are removed. c job = 2 c Elements whose absolute value is less than the c product of the drop tolerance and the Euclidean c norm of the row are removed. c job = 3 c Elements whose absolute value is less that the c product of the drop tolerance and the largest c element in the row are removed. c c drop = real. drop tolerance used for dropping strategy. c a c ja = input matrix in Modifief Sparse Row format c len = integer. the amount of space in arrays b and jb. c c on return: c---------- c c b, jb = resulting matrix in Modifief Sparse Row format c c ierr = integer. containing error message. c ierr .eq. 0 indicates normal return c ierr .gt. 0 indicates that there is'nt enough c space is a and ja to store the resulting matrix. c ierr then contains the row number where filter stopped. c note: c------ This module is in place. (b,jb can ne the same as c a, ja in which case the result will be overwritten). c----------------------------------------------------------------------c c contributed by David Day, Sep 19, 1989. c c----------------------------------------------------------------------c c local variables c real*8 norm,loctol integer index,row,k,k1,k2 c index = n+2 do 10 row= 1,n k1 = ja(row) k2 = ja(row+1) - 1 jb(row) = index goto (100,200,300) job 100 norm = 1.0d0 goto 400 200 norm = a(row)**2 do 22 k = k1,k2 norm = norm + a(k) * a(k) 22 continue norm = sqrt(norm) goto 400 300 norm = abs(a(row)) do 23 k = k1,k2 norm = max(abs(a(k)),norm) 23 continue 400 loctol = drop * norm do 30 k = k1,k2 if( abs(a(k)) .gt. loctol)then if (index .gt. len) then ierr = row return endif b(index) = a(k) jb(index) = ja(k) index = index + 1 endif 30 continue 10 continue jb(n+1) = index return c--------------------end-of-filterm------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine csort (n,a,ja,ia,iwork,values) logical values integer n, ja(*), ia(n+1), iwork(*) real*8 a(*) c----------------------------------------------------------------------- c This routine sorts the elements of a matrix (stored in Compressed c Sparse Row Format) in increasing order of their column indices within c each row. It uses a form of bucket sort with a cost of O(nnz) where c nnz = number of nonzero elements. c requires an integer work array of length 2*nnz. c----------------------------------------------------------------------- c on entry: c--------- c n = the row dimension of the matrix c a = the matrix A in compressed sparse row format. c ja = the array of column indices of the elements in array a. c ia = the array of pointers to the rows. c iwork = integer work array of length max ( n+1, 2*nnz ) c where nnz = 2* (ia(n+1)-ia(1)) ) . c values= logical indicating whether or not the real values a(*) must c also be permuted. if (.not. values) then the array a is not c touched by csort and can be a dummy array. c c on return: c---------- c the matrix stored in the structure a, ja, ia is permuted in such a c way that the column indices are in increasing order within each row. c iwork(1:nnz) contains the permutation used to rearrange the elements. c----------------------------------------------------------------------- c Y. Saad - Feb. 1, 1991. c----------------------------------------------------------------------- c local variables integer i, k, j, ifirst, nnz, next c c count the number of elements in each column c do 1 i=1,n+1 iwork(i) = 0 1 continue do 3 i=1, n do 2 k=ia(i), ia(i+1)-1 j = ja(k)+1 iwork(j) = iwork(j)+1 2 continue 3 continue c c compute pointers from lengths. c iwork(1) = 1 do 4 i=1,n iwork(i+1) = iwork(i) + iwork(i+1) 4 continue c c get the positions of the nonzero elements in order of columns. c ifirst = ia(1) nnz = ia(n+1)-ifirst do 5 i=1,n do 51 k=ia(i),ia(i+1)-1 j = ja(k) next = iwork(j) iwork(nnz+next) = k iwork(j) = next+1 51 continue 5 continue c c convert to coordinate format c do 6 i=1, n do 61 k=ia(i), ia(i+1)-1 iwork(k) = i 61 continue 6 continue c c loop to find permutation: for each element find the correct c position in (sorted) arrays a, ja. Record this in iwork. c do 7 k=1, nnz ko = iwork(nnz+k) irow = iwork(ko) next = ia(irow) c c the current element should go in next position in row. iwork c records this position. c iwork(ko) = next ia(irow) = next+1 7 continue c c perform an in-place permutation of the arrays. c call ivperm (nnz, ja(ifirst), iwork) if (values) call dvperm (nnz, a(ifirst), iwork) c c reshift the pointers of the original matrix back. c do 8 i=n,1,-1 ia(i+1) = ia(i) 8 continue ia(1) = ifirst c return c---------------end-of-csort-------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine clncsr(job,value2,nrow,a,ja,ia,indu,iwk) c .. Scalar Arguments .. integer job, nrow, value2 c .. c .. Array Arguments .. integer ia(nrow+1),indu(nrow),iwk(nrow+1),ja(*) real*8 a(*) c .. c c This routine performs two tasks to clean up a CSR matrix c -- remove duplicate/zero entries, c -- perform a partial ordering, new order lower triangular part, c main diagonal, upper triangular part. c c On entry: c c job = options c 0 -- nothing is done c 1 -- eliminate duplicate entries, zero entries. c 2 -- eliminate duplicate entries and perform partial ordering. c 3 -- eliminate duplicate entries, sort the entries in the c increasing order of clumn indices. c c value2 -- 0 the matrix is pattern only (a is not touched) c 1 matrix has values too. c nrow -- row dimension of the matrix c a,ja,ia -- input matrix in CSR format c c On return: c a,ja,ia -- cleaned matrix c indu -- pointers to the beginning of the upper triangular c portion if job > 1 c c Work space: c iwk -- integer work space of size nrow+1 c c .. Local Scalars .. integer i,j,k,ko,ipos,kfirst,klast real*8 tmp c .. c if (job.le.0) return c c .. eliminate duplicate entries -- c array INDU is used as marker for existing indices, it is also the c location of the entry. c IWK is used to stored the old IA array. c matrix is copied to squeeze out the space taken by the duplicated c entries. c do 90 i = 1, nrow indu(i) = 0 iwk(i) = ia(i) 90 continue iwk(nrow+1) = ia(nrow+1) k = 1 do 120 i = 1, nrow ia(i) = k ipos = iwk(i) klast = iwk(i+1) 100 if (ipos.lt.klast) then j = ja(ipos) if (indu(j).eq.0) then c .. new entry .. if (value2.ne.0) then if (a(ipos) .ne. 0.0D0) then indu(j) = k ja(k) = ja(ipos) a(k) = a(ipos) k = k + 1 endif else indu(j) = k ja(k) = ja(ipos) k = k + 1 endif else if (value2.ne.0) then c .. duplicate entry .. a(indu(j)) = a(indu(j)) + a(ipos) endif ipos = ipos + 1 go to 100 endif c .. remove marks before working on the next row .. do 110 ipos = ia(i), k - 1 indu(ja(ipos)) = 0 110 continue 120 continue ia(nrow+1) = k if (job.le.1) return c c .. partial ordering .. c split the matrix into strict upper/lower triangular c parts, INDU points to the the beginning of the upper part. c do 140 i = 1, nrow klast = ia(i+1) - 1 kfirst = ia(i) 130 if (klast.gt.kfirst) then if (ja(klast).lt.i .and. ja(kfirst).ge.i) then c .. swap klast with kfirst .. j = ja(klast) ja(klast) = ja(kfirst) ja(kfirst) = j if (value2.ne.0) then tmp = a(klast) a(klast) = a(kfirst) a(kfirst) = tmp endif endif if (ja(klast).ge.i) & klast = klast - 1 if (ja(kfirst).lt.i) & kfirst = kfirst + 1 go to 130 endif c if (ja(klast).lt.i) then indu(i) = klast + 1 else indu(i) = klast endif 140 continue if (job.le.2) return c c .. order the entries according to column indices c burble-sort is used c do 190 i = 1, nrow do 160 ipos = ia(i), indu(i)-1 do 150 j = indu(i)-1, ipos+1, -1 k = j - 1 if (ja(k).gt.ja(j)) then ko = ja(k) ja(k) = ja(j) ja(j) = ko if (value2.ne.0) then tmp = a(k) a(k) = a(j) a(j) = tmp endif endif 150 continue 160 continue do 180 ipos = indu(i), ia(i+1)-1 do 170 j = ia(i+1)-1, ipos+1, -1 k = j - 1 if (ja(k).gt.ja(j)) then ko = ja(k) ja(k) = ja(j) ja(j) = ko if (value2.ne.0) then tmp = a(k) a(k) = a(j) a(j) = tmp endif endif 170 continue 180 continue 190 continue return c---- end of clncsr ---------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine copmat (nrow,a,ja,ia,ao,jao,iao,ipos,job) real*8 a(*),ao(*) integer nrow, ia(*),ja(*),jao(*),iao(*), ipos, job c---------------------------------------------------------------------- c copies the matrix a, ja, ia, into the matrix ao, jao, iao. c---------------------------------------------------------------------- c on entry: c--------- c nrow = row dimension of the matrix c a, c ja, c ia = input matrix in compressed sparse row format. c ipos = integer. indicates the position in the array ao, jao c where the first element should be copied. Thus c iao(1) = ipos on return. c job = job indicator. if (job .ne. 1) the values are not copies c (i.e., pattern only is copied in the form of arrays ja, ia). c c on return: c---------- c ao, c jao, c iao = output matrix containing the same data as a, ja, ia. c----------------------------------------------------------------------- c Y. Saad, March 1990. c----------------------------------------------------------------------- c local variables integer kst, i, k c kst = ipos -ia(1) do 100 i = 1, nrow+1 iao(i) = ia(i) + kst 100 continue c do 200 k=ia(1), ia(nrow+1)-1 jao(kst+k)= ja(k) 200 continue c if (job .ne. 1) return do 201 k=ia(1), ia(nrow+1)-1 ao(kst+k) = a(k) 201 continue c return c--------end-of-copmat ------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine msrcop (nrow,a,ja,ao,jao,job) real*8 a(*),ao(*) integer nrow, ja(*),jao(*), job c---------------------------------------------------------------------- c copies the MSR matrix a, ja, into the MSR matrix ao, jao c---------------------------------------------------------------------- c on entry: c--------- c nrow = row dimension of the matrix c a,ja = input matrix in Modified compressed sparse row format. c job = job indicator. Values are not copied if job .ne. 1 c c on return: c---------- c ao, jao = output matrix containing the same data as a, ja. c----------------------------------------------------------------------- c Y. Saad, c----------------------------------------------------------------------- c local variables integer i, k c do 100 i = 1, nrow+1 jao(i) = ja(i) 100 continue c do 200 k=ja(1), ja(nrow+1)-1 jao(k)= ja(k) 200 continue c if (job .ne. 1) return do 201 k=ja(1), ja(nrow+1)-1 ao(k) = a(k) 201 continue do 202 k=1,nrow ao(k) = a(k) 202 continue c return c--------end-of-msrcop ------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- double precision function getelm (i,j,a,ja,ia,iadd,sorted) c----------------------------------------------------------------------- c purpose: c -------- c this function returns the element a(i,j) of a matrix a, c for any pair (i,j). the matrix is assumed to be stored c in compressed sparse row (csr) format. getelm performs a c binary search in the case where it is known that the elements c are sorted so that the column indices are in increasing order. c also returns (in iadd) the address of the element a(i,j) in c arrays a and ja when the search is successsful (zero if not). c----- c first contributed by noel nachtigal (mit). c recoded jan. 20, 1991, by y. saad [in particular c added handling of the non-sorted case + the iadd output] c----------------------------------------------------------------------- c parameters: c ----------- c on entry: c---------- c i = the row index of the element sought (input). c j = the column index of the element sought (input). c a = the matrix a in compressed sparse row format (input). c ja = the array of column indices (input). c ia = the array of pointers to the rows' data (input). c sorted = logical indicating whether the matrix is knonw to c have its column indices sorted in increasing order c (sorted=.true.) or not (sorted=.false.). c (input). c on return: c----------- c getelm = value of a(i,j). c iadd = address of element a(i,j) in arrays a, ja if found, c zero if not found. (output) c c note: the inputs i and j are not checked for validity. c----------------------------------------------------------------------- c noel m. nachtigal october 28, 1990 -- youcef saad jan 20, 1991. c----------------------------------------------------------------------- integer i, ia(*), iadd, j, ja(*) double precision a(*) logical sorted c c local variables. c integer ibeg, iend, imid, k c c initialization c iadd = 0 getelm = 0.0 ibeg = ia(i) iend = ia(i+1)-1 c c case where matrix is not necessarily sorted c if (.not. sorted) then c c scan the row - exit as soon as a(i,j) is found c do 5 k=ibeg, iend if (ja(k) .eq. j) then iadd = k goto 20 endif 5 continue c c end unsorted case. begin sorted case c else c c begin binary search. compute the middle index. c 10 imid = ( ibeg + iend ) / 2 c c test if found c if (ja(imid).eq.j) then iadd = imid goto 20 endif if (ibeg .ge. iend) goto 20 c c else update the interval bounds. c if (ja(imid).gt.j) then iend = imid -1 else ibeg = imid +1 endif goto 10 c c end both cases c endif c 20 if (iadd .ne. 0) getelm = a(iadd) c return c--------end-of-getelm-------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine getdia (nrow,ncol,job,a,ja,ia,len,diag,idiag,ioff) real*8 diag(*),a(*) integer nrow, ncol, job, len, ioff, ia(*), ja(*), idiag(*) c----------------------------------------------------------------------- c this subroutine extracts a given diagonal from a matrix stored in csr c format. the output matrix may be transformed with the diagonal removed c from it if desired (as indicated by job.) c----------------------------------------------------------------------- c our definition of a diagonal of matrix is a vector of length nrow c (always) which contains the elements in rows 1 to nrow of c the matrix that are contained in the diagonal offset by ioff c with respect to the main diagonal. if the diagonal element c falls outside the matrix then it is defined as a zero entry. c thus the proper definition of diag(*) with offset ioff is c c diag(i) = a(i,ioff+i) i=1,2,...,nrow c with elements falling outside the matrix being defined as zero. c c----------------------------------------------------------------------- c c on entry: c---------- c c nrow = integer. the row dimension of the matrix a. c ncol = integer. the column dimension of the matrix a. c job = integer. job indicator. if job = 0 then c the matrix a, ja, ia, is not altered on return. c if job.ne.0 then getdia will remove the entries c collected in diag from the original matrix. c this is done in place. c c a,ja, c ia = matrix stored in compressed sparse row a,ja,ia,format c ioff = integer,containing the offset of the wanted diagonal c the diagonal extracted is the one corresponding to the c entries a(i,j) with j-i = ioff. c thus ioff = 0 means the main diagonal c c on return: c----------- c len = number of nonzero elements found in diag. c (len .le. min(nrow,ncol-ioff)-max(1,1-ioff) + 1 ) c c diag = real*8 array of length nrow containing the wanted diagonal. c diag contains the diagonal (a(i,j),j-i = ioff ) as defined c above. c c idiag = integer array of length len, containing the poisitions c in the original arrays a and ja of the diagonal elements c collected in diag. a zero entry in idiag(i) means that c there was no entry found in row i belonging to the diagonal. c c a, ja, c ia = if job .ne. 0 the matrix is unchanged. otherwise the nonzero c diagonal entries collected in diag are removed from the c matrix and therefore the arrays a, ja, ia will change. c (the matrix a, ja, ia will contain len fewer elements) c c----------------------------------------------------------------------c c Y. Saad, sep. 21 1989 - modified and retested Feb 17, 1996. c c----------------------------------------------------------------------c c local variables integer istart, max, iend, i, kold, k, kdiag, ko c istart = max(0,-ioff) iend = min(nrow,ncol-ioff) len = 0 do 1 i=1,nrow idiag(i) = 0 diag(i) = 0.0d0 1 continue c c extract diagonal elements c do 6 i=istart+1, iend do 51 k= ia(i),ia(i+1) -1 if (ja(k)-i .eq. ioff) then diag(i)= a(k) idiag(i) = k len = len+1 goto 6 endif 51 continue 6 continue if (job .eq. 0 .or. len .eq.0) return c c remove diagonal elements and rewind structure c ko = 0 do 7 i=1, nrow kold = ko kdiag = idiag(i) do 71 k= ia(i), ia(i+1)-1 if (k .ne. kdiag) then ko = ko+1 a(ko) = a(k) ja(ko) = ja(k) endif 71 continue ia(i) = kold+1 7 continue c c redefine ia(nrow+1) c ia(nrow+1) = ko+1 return c------------end-of-getdia---------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine transp (nrow,ncol,a,ja,ia,iwk,ierr) integer nrow, ncol, ia(*), ja(*), iwk(*), ierr real*8 a(*) c------------------------------------------------------------------------ c In-place transposition routine. c------------------------------------------------------------------------ c this subroutine transposes a matrix stored in compressed sparse row c format. the transposition is done in place in that the arrays a,ja,ia c of the transpose are overwritten onto the original arrays. c------------------------------------------------------------------------ c on entry: c--------- c nrow = integer. The row dimension of A. c ncol = integer. The column dimension of A. c a = real array of size nnz (number of nonzero elements in A). c containing the nonzero elements c ja = integer array of length nnz containing the column positions c of the corresponding elements in a. c ia = integer of size n+1, where n = max(nrow,ncol). On entry c ia(k) contains the position in a,ja of the beginning of c the k-th row. c c iwk = integer work array of same length as ja. c c on return: c---------- c c ncol = actual row dimension of the transpose of the input matrix. c Note that this may be .le. the input value for ncol, in c case some of the last columns of the input matrix are zero c columns. In the case where the actual number of rows found c in transp(A) exceeds the input value of ncol, transp will c return without completing the transposition. see ierr. c a, c ja, c ia = contains the transposed matrix in compressed sparse c row format. The row dimension of a, ja, ia is now ncol. c c ierr = integer. error message. If the number of rows for the c transposed matrix exceeds the input value of ncol, c then ierr is set to that number and transp quits. c Otherwise ierr is set to 0 (normal return). c c Note: c----- 1) If you do not need the transposition to be done in place c it is preferrable to use the conversion routine csrcsc c (see conversion routines in formats). c 2) the entries of the output matrix are not sorted (the column c indices in each are not in increasing order) use csrcsc c if you want them sorted. c----------------------------------------------------------------------c c Y. Saad, Sep. 21 1989 c c modified Oct. 11, 1989. c c----------------------------------------------------------------------c c local variables real*8 t, t1 ierr = 0 nnz = ia(nrow+1)-1 c c determine column dimension c jcol = 0 do 1 k=1, nnz jcol = max(jcol,ja(k)) 1 continue if (jcol .gt. ncol) then ierr = jcol return endif c c convert to coordinate format. use iwk for row indices. c ncol = jcol c do 3 i=1,nrow do 2 k=ia(i),ia(i+1)-1 iwk(k) = i 2 continue 3 continue c find pointer array for transpose. do 35 i=1,ncol+1 ia(i) = 0 35 continue do 4 k=1,nnz i = ja(k) ia(i+1) = ia(i+1)+1 4 continue ia(1) = 1 c------------------------------------------------------------------------ do 44 i=1,ncol ia(i+1) = ia(i) + ia(i+1) 44 continue c c loop for a cycle in chasing process. c init = 1 k = 0 5 t = a(init) i = ja(init) j = iwk(init) iwk(init) = -1 c------------------------------------------------------------------------ 6 k = k+1 c current row number is i. determine where to go. l = ia(i) c save the chased element. t1 = a(l) inext = ja(l) c then occupy its location. a(l) = t ja(l) = j c update pointer information for next element to be put in row i. ia(i) = l+1 c determine next element to be chased if (iwk(l) .lt. 0) goto 65 t = t1 i = inext j = iwk(l) iwk(l) = -1 if (k .lt. nnz) goto 6 goto 70 65 init = init+1 if (init .gt. nnz) goto 70 if (iwk(init) .lt. 0) goto 65 c restart chasing -- goto 5 70 continue do 80 i=ncol,1,-1 ia(i+1) = ia(i) 80 continue ia(1) = 1 c return c------------------end-of-transp ---------------------------------------- c------------------------------------------------------------------------ end c------------------------------------------------------------------------ subroutine getl (n,a,ja,ia,ao,jao,iao) integer n, ia(*), ja(*), iao(*), jao(*) real*8 a(*), ao(*) c------------------------------------------------------------------------ c this subroutine extracts the lower triangular part of a matrix c and writes the result ao, jao, iao. The routine is in place in c that ao, jao, iao can be the same as a, ja, ia if desired. c----------- c on input: c c n = dimension of the matrix a. c a, ja, c ia = matrix stored in compressed sparse row format. c On return: c ao, jao, c iao = lower triangular matrix (lower part of a) c stored in a, ja, ia, format c note: the diagonal element is the last element in each row. c i.e. in a(ia(i+1)-1 ) c ao, jao, iao may be the same as a, ja, ia on entry -- in which case c getl will overwrite the result on a, ja, ia. c c------------------------------------------------------------------------ c local variables real*8 t integer ko, kold, kdiag, k, i c c inititialize ko (pointer for output matrix) c ko = 0 do 7 i=1, n kold = ko kdiag = 0 do 71 k = ia(i), ia(i+1) -1 if (ja(k) .gt. i) goto 71 ko = ko+1 ao(ko) = a(k) jao(ko) = ja(k) if (ja(k) .eq. i) kdiag = ko 71 continue if (kdiag .eq. 0 .or. kdiag .eq. ko) goto 72 c c exchange c t = ao(kdiag) ao(kdiag) = ao(ko) ao(ko) = t c k = jao(kdiag) jao(kdiag) = jao(ko) jao(ko) = k 72 iao(i) = kold+1 7 continue c redefine iao(n+1) iao(n+1) = ko+1 return c----------end-of-getl ------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine getu (n,a,ja,ia,ao,jao,iao) integer n, ia(*), ja(*), iao(*), jao(*) real*8 a(*), ao(*) c------------------------------------------------------------------------ c this subroutine extracts the upper triangular part of a matrix c and writes the result ao, jao, iao. The routine is in place in c that ao, jao, iao can be the same as a, ja, ia if desired. c----------- c on input: c c n = dimension of the matrix a. c a, ja, c ia = matrix stored in a, ja, ia, format c On return: c ao, jao, c iao = upper triangular matrix (upper part of a) c stored in compressed sparse row format c note: the diagonal element is the last element in each row. c i.e. in a(ia(i+1)-1 ) c ao, jao, iao may be the same as a, ja, ia on entry -- in which case c getu will overwrite the result on a, ja, ia. c c------------------------------------------------------------------------ c local variables real*8 t integer ko, k, i, kdiag, kfirst ko = 0 do 7 i=1, n kfirst = ko+1 kdiag = 0 do 71 k = ia(i), ia(i+1) -1 if (ja(k) .lt. i) goto 71 ko = ko+1 ao(ko) = a(k) jao(ko) = ja(k) if (ja(k) .eq. i) kdiag = ko 71 continue if (kdiag .eq. 0 .or. kdiag .eq. kfirst) goto 72 c exchange t = ao(kdiag) ao(kdiag) = ao(kfirst) ao(kfirst) = t c k = jao(kdiag) jao(kdiag) = jao(kfirst) jao(kfirst) = k 72 iao(i) = kfirst 7 continue c redefine iao(n+1) iao(n+1) = ko+1 return c----------end-of-getu ------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine levels (n, jal, ial, nlev, lev, ilev, levnum) integer jal(*),ial(*), levnum(*), ilev(*), lev(*) c----------------------------------------------------------------------- c levels gets the level structure of a lower triangular matrix c for level scheduling in the parallel solution of triangular systems c strict lower matrices (e.g. unit) as well matrices with their main c diagonal are accepted. c----------------------------------------------------------------------- c on entry: c---------- c n = integer. The row dimension of the matrix c jal, ial = c c on return: c----------- c nlev = integer. number of levels found c lev = integer array of length n containing the level c scheduling permutation. c ilev = integer array. pointer to beginning of levels in lev. c the numbers lev(i) to lev(i+1)-1 contain the row numbers c that belong to level number i, in the level scheduling c ordering. The equations of the same level can be solved c in parallel, once those of all the previous levels have c been solved. c work arrays: c------------- c levnum = integer array of length n (containing the level numbers c of each unknown on return) c----------------------------------------------------------------------- do 10 i = 1, n levnum(i) = 0 10 continue c c compute level of each node -- c nlev = 0 do 20 i = 1, n levi = 0 do 15 j = ial(i), ial(i+1) - 1 levi = max (levi, levnum(jal(j))) 15 continue levi = levi+1 levnum(i) = levi nlev = max(nlev,levi) 20 continue c-------------set data structure -------------------------------------- do 21 j=1, nlev+1 ilev(j) = 0 21 continue c------count number of elements in each level ----------------------- do 22 j=1, n i = levnum(j)+1 ilev(i) = ilev(i)+1 22 continue c---- set up pointer for each level ---------------------------------- ilev(1) = 1 do 23 j=1, nlev ilev(j+1) = ilev(j)+ilev(j+1) 23 continue c-----determine elements of each level -------------------------------- do 30 j=1,n i = levnum(j) lev(ilev(i)) = j ilev(i) = ilev(i)+1 30 continue c reset pointers backwards do 35 j=nlev, 1, -1 ilev(j+1) = ilev(j) 35 continue ilev(1) = 1 return c----------end-of-levels------------------------------------------------ C----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine amask (nrow,ncol,a,ja,ia,jmask,imask, * c,jc,ic,iw,nzmax,ierr) c--------------------------------------------------------------------- real*8 a(*),c(*) integer ia(nrow+1),ja(*),jc(*),ic(nrow+1),jmask(*),imask(nrow+1) logical iw(ncol) c----------------------------------------------------------------------- c This subroutine builds a sparse matrix from an input matrix by c extracting only elements in positions defined by the mask jmask, imask c----------------------------------------------------------------------- c On entry: c--------- c nrow = integer. row dimension of input matrix c ncol = integer. Column dimension of input matrix. c c a, c ja, c ia = matrix in Compressed Sparse Row format c c jmask, c imask = matrix defining mask (pattern only) stored in compressed c sparse row format. c c nzmax = length of arrays c and jc. see ierr. c c On return: c----------- c c a, ja, ia and jmask, imask are unchanged. c c c c jc, c ic = the output matrix in Compressed Sparse Row format. c c ierr = integer. serving as error message.c c ierr = 1 means normal return c ierr .gt. 1 means that amask stopped when processing c row number ierr, because there was not enough space in c c, jc according to the value of nzmax. c c work arrays: c------------- c iw = logical work array of length ncol. c c note: c------ the algorithm is in place: c, jc, ic can be the same as c a, ja, ia in which cas the code will overwrite the matrix c c on a, ja, ia c c----------------------------------------------------------------------- ierr = 0 len = 0 do 1 j=1, ncol iw(j) = .false. 1 continue c unpack the mask for row ii in iw do 100 ii=1, nrow c save pointer in order to be able to do things in place do 2 k=imask(ii), imask(ii+1)-1 iw(jmask(k)) = .true. 2 continue c add umasked elemnts of row ii k1 = ia(ii) k2 = ia(ii+1)-1 ic(ii) = len+1 do 200 k=k1,k2 j = ja(k) if (iw(j)) then len = len+1 if (len .gt. nzmax) then ierr = ii return endif jc(len) = j c(len) = a(k) endif 200 continue c do 3 k=imask(ii), imask(ii+1)-1 iw(jmask(k)) = .false. 3 continue 100 continue ic(nrow+1)=len+1 c return c-----end-of-amask ----------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine rperm (nrow,a,ja,ia,ao,jao,iao,perm,job) integer nrow,ja(*),ia(nrow+1),jao(*),iao(nrow+1),perm(nrow),job real*8 a(*),ao(*) c----------------------------------------------------------------------- c this subroutine permutes the rows of a matrix in CSR format. c rperm computes B = P A where P is a permutation matrix. c the permutation P is defined through the array perm: for each j, c perm(j) represents the destination row number of row number j. c Youcef Saad -- recoded Jan 28, 1991. c----------------------------------------------------------------------- c on entry: c---------- c n = dimension of the matrix c a, ja, ia = input matrix in csr format c perm = integer array of length nrow containing the permutation arrays c for the rows: perm(i) is the destination of row i in the c permuted matrix. c ---> a(i,j) in the original matrix becomes a(perm(i),j) c in the output matrix. c c job = integer indicating the work to be done: c job = 1 permute a, ja, ia into ao, jao, iao c (including the copying of real values ao and c the array iao). c job .ne. 1 : ignore real values. c (in which case arrays a and ao are not needed nor c used). c c------------ c on return: c------------ c ao, jao, iao = input matrix in a, ja, ia format c note : c if (job.ne.1) then the arrays a and ao are not used. c----------------------------------------------------------------------c c Y. Saad, May 2, 1990 c c----------------------------------------------------------------------c logical values values = (job .eq. 1) c c determine pointers for output matix. c do 50 j=1,nrow i = perm(j) iao(i+1) = ia(j+1) - ia(j) 50 continue c c get pointers from lengths c iao(1) = 1 do 51 j=1,nrow iao(j+1)=iao(j+1)+iao(j) 51 continue c c copying c do 100 ii=1,nrow c c old row = ii -- new row = iperm(ii) -- ko = new pointer c ko = iao(perm(ii)) do 60 k=ia(ii), ia(ii+1)-1 jao(ko) = ja(k) if (values) ao(ko) = a(k) ko = ko+1 60 continue 100 continue c return c---------end-of-rperm ------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine cperm (nrow,a,ja,ia,ao,jao,iao,perm,job) integer nrow,ja(*),ia(nrow+1),jao(*),iao(nrow+1),perm(*), job real*8 a(*), ao(*) c----------------------------------------------------------------------- c this subroutine permutes the columns of a matrix a, ja, ia. c the result is written in the output matrix ao, jao, iao. c cperm computes B = A P, where P is a permutation matrix c that maps column j into column perm(j), i.e., on return c a(i,j) becomes a(i,perm(j)) in new matrix c Y. Saad, May 2, 1990 / modified Jan. 28, 1991. c----------------------------------------------------------------------- c on entry: c---------- c nrow = row dimension of the matrix c c a, ja, ia = input matrix in csr format. c c perm = integer array of length ncol (number of columns of A c containing the permutation array the columns: c a(i,j) in the original matrix becomes a(i,perm(j)) c in the output matrix. c c job = integer indicating the work to be done: c job = 1 permute a, ja, ia into ao, jao, iao c (including the copying of real values ao and c the array iao). c job .ne. 1 : ignore real values ao and ignore iao. c c------------ c on return: c------------ c ao, jao, iao = input matrix in a, ja, ia format (array ao not needed) c c Notes: c------- c 1. if job=1 then ao, iao are not used. c 2. This routine is in place: ja, jao can be the same. c 3. If the matrix is initially sorted (by increasing column number) c then ao,jao,iao may not be on return. c c----------------------------------------------------------------------c c local parameters: integer k, i, nnz c nnz = ia(nrow+1)-1 do 100 k=1,nnz jao(k) = perm(ja(k)) 100 continue c c done with ja array. return if no need to touch values. c if (job .ne. 1) return c c else get new pointers -- and copy values too. c do 1 i=1, nrow+1 iao(i) = ia(i) 1 continue c do 2 k=1, nnz ao(k) = a(k) 2 continue c return c---------end-of-cperm-------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine dperm (nrow,a,ja,ia,ao,jao,iao,perm,qperm,job) integer nrow,ja(*),ia(nrow+1),jao(*),iao(nrow+1),perm(nrow), + qperm(*),job real*8 a(*),ao(*) c----------------------------------------------------------------------- c This routine permutes the rows and columns of a matrix stored in CSR c format. i.e., it computes P A Q, where P, Q are permutation matrices. c P maps row i into row perm(i) and Q maps column j into column qperm(j): c a(i,j) becomes a(perm(i),qperm(j)) in new matrix c In the particular case where Q is the transpose of P (symmetric c permutation of A) then qperm is not needed. c note that qperm should be of length ncol (number of columns) but this c is not checked. c----------------------------------------------------------------------- c Y. Saad, Sep. 21 1989 / recoded Jan. 28 1991. c----------------------------------------------------------------------- c on entry: c---------- c n = dimension of the matrix c a, ja, c ia = input matrix in a, ja, ia format c perm = integer array of length n containing the permutation arrays c for the rows: perm(i) is the destination of row i in the c permuted matrix -- also the destination of column i in case c permutation is symmetric (job .le. 2) c c qperm = same thing for the columns. This should be provided only c if job=3 or job=4, i.e., only in the case of a nonsymmetric c permutation of rows and columns. Otherwise qperm is a dummy c c job = integer indicating the work to be done: c * job = 1,2 permutation is symmetric Ao :== P * A * transp(P) c job = 1 permute a, ja, ia into ao, jao, iao c job = 2 permute matrix ignoring real values. c * job = 3,4 permutation is non-symmetric Ao :== P * A * Q c job = 3 permute a, ja, ia into ao, jao, iao c job = 4 permute matrix ignoring real values. c c on return: c----------- c ao, jao, iao = input matrix in a, ja, ia format c c in case job .eq. 2 or job .eq. 4, a and ao are never referred to c and can be dummy arguments. c Notes: c------- c 1) algorithm is in place c 2) column indices may not be sorted on return even though they may be c on entry. c----------------------------------------------------------------------c c local variables integer locjob, mod c c locjob indicates whether or not real values must be copied. c locjob = mod(job,2) c c permute rows first c call rperm (nrow,a,ja,ia,ao,jao,iao,perm,locjob) c c then permute columns c locjob = 0 c if (job .le. 2) then call cperm (nrow,ao,jao,iao,ao,jao,iao,perm,locjob) else call cperm (nrow,ao,jao,iao,ao,jao,iao,qperm,locjob) endif c return c-------end-of-dperm---------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine dperm1 (i1,i2,a,ja,ia,b,jb,ib,perm,ipos,job) integer i1,i2,job,ja(*),ia(*),jb(*),ib(*),perm(*) real*8 a(*),b(*) c----------------------------------------------------------------------- c general submatrix extraction routine. c----------------------------------------------------------------------- c extracts rows perm(i1), perm(i1+1), ..., perm(i2) (in this order) c from a matrix (doing nothing in the column indices.) The resulting c submatrix is constructed in b, jb, ib. A pointer ipos to the c beginning of arrays b,jb,is also allowed (i.e., nonzero elements c are accumulated starting in position ipos of b, jb). c----------------------------------------------------------------------- c Y. Saad,Sep. 21 1989 / recoded Jan. 28 1991 / modified for PSPARSLIB c Sept. 1997.. c----------------------------------------------------------------------- c on entry: c---------- c n = dimension of the matrix c a,ja, c ia = input matrix in CSR format c perm = integer array of length n containing the indices of the rows c to be extracted. c c job = job indicator. if (job .ne.1) values are not copied (i.e., c only pattern is copied). c c on return: c----------- c b,ja, c ib = matrix in csr format. b(ipos:ipos+nnz-1),jb(ipos:ipos+nnz-1) c contain the value and column indices respectively of the nnz c nonzero elements of the permuted matrix. thus ib(1)=ipos. c c Notes: c------- c algorithm is NOT in place c----------------------------------------------------------------------- c local variables c integer ko,irow,k logical values c----------------------------------------------------------------------- values = (job .eq. 1) ko = ipos ib(1) = ko do 900 i=i1,i2 irow = perm(i) do 800 k=ia(irow),ia(irow+1)-1 if (values) b(ko) = a(k) jb(ko) = ja(k) ko=ko+1 800 continue ib(i-i1+2) = ko 900 continue return c--------end-of-dperm1-------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine dperm2 (i1,i2,a,ja,ia,b,jb,ib,cperm,rperm,istart, * ipos,job) integer i1,i2,job,istart,ja(*),ia(*),jb(*),ib(*),cperm(*),rperm(*) real*8 a(*),b(*) c----------------------------------------------------------------------- c general submatrix permutation/ extraction routine. c----------------------------------------------------------------------- c extracts rows rperm(i1), rperm(i1+1), ..., rperm(i2) and does an c associated column permutation (using array cperm). The resulting c submatrix is constructed in b, jb, ib. For added flexibility, the c extracted elements are put in sequence starting from row 'istart' c of B. In addition a pointer ipos to the beginning of arrays b,jb, c is also allowed (i.e., nonzero elements are accumulated starting in c position ipos of b, jb). In most applications istart and ipos are c equal to one. However, the generality adds substantial flexiblity. c EXPLE: (1) to permute msr to msr (excluding diagonals) c call dperm2 (1,n,a,ja,ja,b,jb,jb,rperm,rperm,1,n+2) c (2) To extract rows 1 to 10: define rperm and cperm to be c identity permutations (rperm(i)=i, i=1,n) and then c call dperm2 (1,10,a,ja,ia,b,jb,ib,rperm,rperm,1,1) c (3) to achieve a symmetric permutation as defined by perm: c call dperm2 (1,10,a,ja,ia,b,jb,ib,perm,perm,1,1) c (4) to get a symmetric permutation of A and append the c resulting data structure to A's data structure (useful!) c call dperm2 (1,10,a,ja,ia,a,ja,ia(n+1),perm,perm,1,ia(n+1)) c----------------------------------------------------------------------- c Y. Saad,Sep. 21 1989 / recoded Jan. 28 1991. c----------------------------------------------------------------------- c on entry: c---------- c n = dimension of the matrix c i1,i2 = extract rows rperm(i1) to rperm(i2) of A, with i1 0 : Row number i is a zero row. c Notes: c------- c 1) The column dimension of A is not needed. c 2) algorithm in place (B can take the place of A). c----------------------------------------------------------------- call rnrms (nrow,nrm,a,ja,ia,diag) ierr = 0 do 1 j=1, nrow if (diag(j) .eq. 0.0d0) then ierr = j return else diag(j) = 1.0d0/diag(j) endif 1 continue call diamua(nrow,job,a,ja,ia,diag,b,jb,ib) return c-------end-of-roscal--------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine coscal(nrow,job,nrm,a,ja,ia,diag,b,jb,ib,ierr) c----------------------------------------------------------------------- real*8 a(*),b(*),diag(nrow) integer nrow,job,ja(*),jb(*),ia(nrow+1),ib(nrow+1),ierr c----------------------------------------------------------------------- c scales the columns of A such that their norms are one on return c result matrix written on b, or overwritten on A. c 3 choices of norms: 1-norm, 2-norm, max-norm. in place. c----------------------------------------------------------------------- c on entry: c --------- c nrow = integer. The row dimension of A c c job = integer. job indicator. Job=0 means get array b only c job = 1 means get b, and the integer arrays ib, jb. c c nrm = integer. norm indicator. nrm = 1, means 1-norm, nrm =2 c means the 2-nrm, nrm = 0 means max norm c c a, c ja, c ia = Matrix A in compressed sparse row format. c c on return: c---------- c c diag = diagonal matrix stored as a vector containing the matrix c by which the columns have been scaled, i.e., on return c we have B = A * Diag c c b, c jb, c ib = resulting matrix B in compressed sparse row sparse format. c c ierr = error message. ierr=0 : Normal return c ierr=i > 0 : Column number i is a zero row. c Notes: c------- c 1) The column dimension of A is not needed. c 2) algorithm in place (B can take the place of A). c----------------------------------------------------------------- call cnrms (nrow,nrm,a,ja,ia,diag) ierr = 0 do 1 j=1, nrow if (diag(j) .eq. 0.0) then ierr = j return else diag(j) = 1.0d0/diag(j) endif 1 continue call amudia (nrow,job,a,ja,ia,diag,b,jb,ib) return c--------end-of-coscal-------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine addblk(nrowa, ncola, a, ja, ia, ipos, jpos, job, & nrowb, ncolb, b, jb, ib, nrowc, ncolc, c, jc, ic, nzmx, ierr) c implicit none integer nrowa, nrowb, nrowc, ncola, ncolb, ncolc, ipos, jpos integer nzmx, ierr, job integer ja(1:*), ia(1:*), jb(1:*), ib(1:*), jc(1:*), ic(1:*) real*8 a(1:*), b(1:*), c(1:*) c----------------------------------------------------------------------- c This subroutine adds a matrix B into a submatrix of A whose c (1,1) element is located in the starting position (ipos, jpos). c The resulting matrix is allowed to be larger than A (and B), c and the resulting dimensions nrowc, ncolc will be redefined c accordingly upon return. c The input matrices are assumed to be sorted, i.e. in each row c the column indices appear in ascending order in the CSR format. c----------------------------------------------------------------------- c on entry: c --------- c nrowa = number of rows in A. c bcola = number of columns in A. c a,ja,ia = Matrix A in compressed sparse row format with entries sorted c nrowb = number of rows in B. c ncolb = number of columns in B. c b,jb,ib = Matrix B in compressed sparse row format with entries sorted c c nzmax = integer. The length of the arrays c and jc. addblk will c stop if the number of nonzero elements in the matrix C c exceeds nzmax. See ierr. c c on return: c---------- c nrowc = number of rows in C. c ncolc = number of columns in C. c c,jc,ic = resulting matrix C in compressed sparse row sparse format c with entries sorted ascendly in each row. c c ierr = integer. serving as error message. c ierr = 0 means normal return, c ierr .gt. 0 means that addblk stopped while computing the c i-th row of C with i=ierr, because the number c of elements in C exceeds nzmax. c c Notes: c------- c this will not work if any of the two input matrices is not sorted c----------------------------------------------------------------------- logical values integer i,j1,j2,ka,kb,kc,kamax,kbmax values = (job .ne. 0) ierr = 0 nrowc = max(nrowa, nrowb+ipos-1) ncolc = max(ncola, ncolb+jpos-1) kc = 1 kbmax = 0 ic(1) = kc c do 10 i=1, nrowc if (i.le.nrowa) then ka = ia(i) kamax = ia(i+1)-1 else ka = ia(nrowa+1) end if if ((i.ge.ipos).and.((i-ipos).le.nrowb)) then kb = ib(i-ipos+1) kbmax = ib(i-ipos+2)-1 else kb = ib(nrowb+1) end if c c a do-while type loop -- goes through all the elements in a row. c 20 continue if (ka .le. kamax) then j1 = ja(ka) else j1 = ncolc+1 endif if (kb .le. kbmax) then j2 = jb(kb) + jpos - 1 else j2 = ncolc+1 endif c c if there are more elements to be added. c if ((ka .le. kamax .or. kb .le. kbmax) .and. & (j1 .le. ncolc .or. j2 .le. ncolc)) then c c three cases c if (j1 .eq. j2) then if (values) c(kc) = a(ka)+b(kb) jc(kc) = j1 ka = ka+1 kb = kb+1 kc = kc+1 else if (j1 .lt. j2) then jc(kc) = j1 if (values) c(kc) = a(ka) ka = ka+1 kc = kc+1 else if (j1 .gt. j2) then jc(kc) = j2 if (values) c(kc) = b(kb) kb = kb+1 kc = kc+1 endif if (kc .gt. nzmx) goto 999 goto 20 end if ic(i+1) = kc 10 continue return 999 ierr = i return c---------end-of-addblk------------------------------------------------- end c----------------------------------------------------------------------- subroutine get1up (n,ja,ia,ju) integer n, ja(*),ia(*),ju(*) c---------------------------------------------------------------------- c obtains the first element of each row of the upper triangular part c of a matrix. Assumes that the matrix is already sorted. c----------------------------------------------------------------------- c parameters c input c ----- c ja = integer array containing the column indices of aij c ia = pointer array. ia(j) contains the position of the c beginning of row j in ja c c output c ------ c ju = integer array of length n. ju(i) is the address in ja c of the first element of the uper triangular part of c of A (including rthe diagonal. Thus if row i does have c a nonzero diagonal element then ju(i) will point to it. c This is a more general version of diapos. c----------------------------------------------------------------------- c local vAriables integer i, k c do 5 i=1, n ju(i) = 0 k = ia(i) c 1 continue if (ja(k) .ge. i) then ju(i) = k goto 5 elseif (k .lt. ia(i+1) -1) then k=k+1 c c go try next element in row c goto 1 endif 5 continue return c-----end-of-get1up----------------------------------------------------- end c---------------------------------------------------------------------- subroutine xtrows (i1,i2,a,ja,ia,ao,jao,iao,iperm,job) integer i1,i2,ja(*),ia(*),jao(*),iao(*),iperm(*),job real*8 a(*),ao(*) c----------------------------------------------------------------------- c this subroutine extracts given rows from a matrix in CSR format. c Specifically, rows number iperm(i1), iperm(i1+1), ...., iperm(i2) c are extracted and put in the output matrix ao, jao, iao, in CSR c format. NOT in place. c Youcef Saad -- coded Feb 15, 1992. c----------------------------------------------------------------------- c on entry: c---------- c i1,i2 = two integers indicating the rows to be extracted. c xtrows will extract rows iperm(i1), iperm(i1+1),..,iperm(i2), c from original matrix and stack them in output matrix c ao, jao, iao in csr format c c a, ja, ia = input matrix in csr format c c iperm = integer array of length nrow containing the reverse permutation c array for the rows. row number iperm(j) in permuted matrix PA c used to be row number j in unpermuted matrix. c ---> a(i,j) in the permuted matrix was a(iperm(i),j) c in the inout matrix. c c job = integer indicating the work to be done: c job .ne. 1 : get structure only of output matrix,, c i.e., ignore real values. (in which case arrays a c and ao are not used nor accessed). c job = 1 get complete data structure of output matrix. c (i.e., including arrays ao and iao). c------------ c on return: c------------ c ao, jao, iao = input matrix in a, ja, ia format c note : c if (job.ne.1) then the arrays a and ao are not used. c----------------------------------------------------------------------c c Y. Saad, revised May 2, 1990 c c----------------------------------------------------------------------c logical values values = (job .eq. 1) c c copying c ko = 1 iao(1) = ko do 100 j=i1,i2 c c ii=iperm(j) is the index of old row to be copied. c ii = iperm(j) do 60 k=ia(ii), ia(ii+1)-1 jao(ko) = ja(k) if (values) ao(ko) = a(k) ko = ko+1 60 continue iao(j-i1+2) = ko 100 continue c return c---------end-of-xtrows------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine csrkvstr(n, ia, ja, nr, kvstr) c----------------------------------------------------------------------- integer n, ia(n+1), ja(*), nr, kvstr(*) c----------------------------------------------------------------------- c Finds block row partitioning of matrix in CSR format. c----------------------------------------------------------------------- c On entry: c-------------- c n = number of matrix scalar rows c ia,ja = input matrix sparsity structure in CSR format c c On return: c--------------- c nr = number of block rows c kvstr = first row number for each block row c c Notes: c----------- c Assumes that the matrix is sorted by columns. c This routine does not need any workspace. c c----------------------------------------------------------------------- c local variables integer i, j, jdiff c----------------------------------------------------------------------- nr = 1 kvstr(1) = 1 c--------------------------------- do i = 2, n jdiff = ia(i+1)-ia(i) if (jdiff .eq. ia(i)-ia(i-1)) then do j = ia(i), ia(i+1)-1 if (ja(j) .ne. ja(j-jdiff)) then nr = nr + 1 kvstr(nr) = i goto 299 endif enddo 299 continue else 300 nr = nr + 1 kvstr(nr) = i endif enddo kvstr(nr+1) = n+1 c--------------------------------- return end c----------------------------------------------------------------------- c------------------------end-of-csrkvstr-------------------------------- subroutine csrkvstc(n, ia, ja, nc, kvstc, iwk) c----------------------------------------------------------------------- integer n, ia(n+1), ja(*), nc, kvstc(*), iwk(*) c----------------------------------------------------------------------- c Finds block column partitioning of matrix in CSR format. c----------------------------------------------------------------------- c On entry: c-------------- c n = number of matrix scalar rows c ia,ja = input matrix sparsity structure in CSR format c c On return: c--------------- c nc = number of block columns c kvstc = first column number for each block column c c Work space: c---------------- c iwk(*) of size equal to the number of scalar columns plus one. c Assumed initialized to 0, and left initialized on return. c c Notes: c----------- c Assumes that the matrix is sorted by columns. c c----------------------------------------------------------------------- c local variables integer i, j, k, ncol c c----------------------------------------------------------------------- c-----use ncol to find maximum scalar column number ncol = 0 c-----mark the beginning position of the blocks in iwk do i = 1, n if (ia(i) .lt. ia(i+1)) then j = ja(ia(i)) iwk(j) = 1 do k = ia(i)+1, ia(i+1)-1 j = ja(k) if (ja(k-1).ne.j-1) then iwk(j) = 1 iwk(ja(k-1)+1) = 1 endif enddo iwk(j+1) = 1 ncol = max0(ncol, j) endif enddo c--------------------------------- nc = 1 kvstc(1) = 1 do i = 2, ncol+1 if (iwk(i).ne.0) then nc = nc + 1 kvstc(nc) = i iwk(i) = 0 endif enddo nc = nc - 1 c--------------------------------- return end c----------------------------------------------------------------------- c------------------------end-of-csrkvstc-------------------------------- c----------------------------------------------------------------------- subroutine kvstmerge(nr, kvstr, nc, kvstc, n, kvst) c----------------------------------------------------------------------- integer nr, kvstr(nr+1), nc, kvstc(nc+1), n, kvst(*) c----------------------------------------------------------------------- c Merges block partitionings, for conformal row/col pattern. c----------------------------------------------------------------------- c On entry: c-------------- c nr,nc = matrix block row and block column dimension c kvstr = first row number for each block row c kvstc = first column number for each block column c c On return: c--------------- c n = conformal row/col matrix block dimension c kvst = conformal row/col block partitioning c c Notes: c----------- c If matrix is not square, this routine returns without warning. c c----------------------------------------------------------------------- c-----local variables integer i,j c--------------------------------- if (kvstr(nr+1) .ne. kvstc(nc+1)) return i = 1 j = 1 n = 1 200 if (i .gt. nr+1) then kvst(n) = kvstc(j) j = j + 1 elseif (j .gt. nc+1) then kvst(n) = kvstr(i) i = i + 1 elseif (kvstc(j) .eq. kvstr(i)) then kvst(n) = kvstc(j) j = j + 1 i = i + 1 elseif (kvstc(j) .lt. kvstr(i)) then kvst(n) = kvstc(j) j = j + 1 else kvst(n) = kvstr(i) i = i + 1 endif n = n + 1 if (i.le.nr+1 .or. j.le.nc+1) goto 200 n = n - 2 c--------------------------------- return c------------------------end-of-kvstmerge------------------------------- end getdp-2.7.0-source/contrib/Sparskit/reordering.f000644 001750 001750 00000036151 11266605601 023361 0ustar00geuzainegeuzaine000000 000000 c $Id: reordering.f,v 1.1 2008-04-11 06:01:06 geuzaine Exp $ c----------------------------------------------------------------------c c S P A R S K I T c c----------------------------------------------------------------------c c ROERDERING ROUTINES -- LEVEL SET BASED ROUTINES c c----------------------------------------------------------------------c c BSF : Breadth-First Seearch traversal (Cuthill mc kee ordering) c c dblstr : two-way dissection partitioning -- with equal size domains c c stripes : routine used by dblstr to assign points c c perphn : finds a peripheral node and does a BFS search from it. c c add_lvst: routine for adding a new level set in BFS algorithm c c reversp : routine to reverse a given permuation (e.g., for RCMK) c c maskdeg : integer function to compute the `masked' of a node c c----------------------------------------------------------------------c subroutine BFS(n,ja,ia,nfirst,iperm,mask,maskval,riord,levels, * nlev) implicit none integer n,ja(*),ia(*),nfirst,iperm(n),mask(n),riord(*),levels(*), * nlev,maskval c----------------------------------------------------------------------- c finds the level-structure (breadth-first-search or CMK) ordering for a c given sparse matrix. Uses add_lvst. Allows a set of nodes to be c the initial level (instead of just one node). Allows masked nodes. c-------------------------parameters------------------------------------ c on entry: c---------- c n = number of nodes in the graph c ja, ia = pattern of matrix in CSR format (the ja,ia arrays of csr data c structure) c nfirst = number of nodes in the first level that is input in riord c iperm = integer array indicating in which order to traverse the graph c in order to generate all connected components. c The nodes will be traversed in order iperm(1),....,iperm(n) c Convention: c if iperm(1) .eq. 0 on entry then BFS will traverse the c nodes in the order 1,2,...,n. c c riord = (also an ouput argument). on entry riord contains the labels c of the nfirst nodes that constitute the first level. c c mask = array used to indicate whether or not a node should be c condidered in the graph. see maskval. c mask is also used as a marker of visited nodes. c c maskval= consider node i only when: mask(i) .eq. maskval c maskval must be .gt. 0. c thus, to consider all nodes, take mask(1:n) = 1. c maskval=1 (for example) c c on return c --------- c mask = on return mask is restored to its initial state. c riord = `reverse permutation array'. Contains the labels of the nodes c constituting all the levels found, from the first level to c the last. c levels = pointer array for the level structure. If lev is a level c number, and k1=levels(lev),k2=levels(lev+1)-1, then c all the nodes of level number lev are: c riord(k1),riord(k1+1),...,riord(k2) c nlev = number of levels found c----------------------------------------------------------------------- c Notes on possible usage c------------------------- c 1. if you want a CMK ordering from a known node, say node init then c call BFS with nfirst=1,iperm(1) =0, mask(1:n) =1, maskval =1, c riord(1) = init. c 2. if you want the RCMK ordering and you have a preferred initial node c then use above call followed by reversp(n,riord) c 3. Similarly to 1, and 2, but you know a good LEVEL SET to start from c (nfirst = number if nodes in the level, riord(1:nfirst) contains c the nodes. c 4. If you do not know how to select a good initial node in 1 and 2, c then you should use perphn instead. c c----------------------------------------------------------------------- c local variables -- integer j, ii, nod, istart, iend logical permut permut = (iperm(1) .ne. 0) c c start pointer structure to levels c nlev = 0 c c previous end c istart = 0 ii = 0 c c current end c iend = nfirst c c intialize masks to zero -- except nodes of first level -- c do 12 j=1, nfirst mask(riord(j)) = 0 12 continue c----------------------------------------------------------------------- 13 continue c 1 nlev = nlev+1 levels(nlev) = istart + 1 call add_lvst (istart,iend,nlev,riord,ja,ia,mask,maskval) if (istart .lt. iend) goto 1 2 ii = ii+1 if (ii .le. n) then nod = ii if (permut) nod = iperm(nod) if (mask(nod) .eq. maskval) then c c start a new level c istart = iend iend = iend+1 riord(iend) = nod mask(nod) = 0 goto 1 else goto 2 endif endif c----------------------------------------------------------------------- 3 levels(nlev+1) = iend+1 do j=1, iend mask(riord(j)) = maskval enddo return c----------------------------------------------------------------------- c-----end-of-BFS-------------------------------------------------------- end c----------------------------------------------------------------------- subroutine dblstr(n,ja,ia,ip1,ip2,nfirst,riord,ndom,map,mapptr, * mask,levels,iwk) implicit none integer ndom,ja(*),ia(*),ip1,ip2,nfirst,riord(*),map(*),mapptr(*), * mask(*),levels(*),iwk(*),nextdom c----------------------------------------------------------------------- c this routine performs a two-way partitioning of a graph using c level sets recursively. First a coarse set is found by a c simple cuthill-mc Kee type algorithm. Them each of the large c domains is further partitioned into subsets using the same c technique. The ip1 and ip2 parameters indicate the desired number c number of partitions 'in each direction'. So the total number of c partitions on return ought to be equal (or close) to ip1*ip2 c----------------------parameters---------------------------------------- c on entry: c--------- c n = row dimension of matrix == number of vertices in graph c ja, ia = pattern of matrix in CSR format (the ja,ia arrays of csr data c structure) c ip1 = integer indicating the number of large partitions ('number of c paritions in first direction') c ip2 = integer indicating the number of smaller partitions, per c large partition, ('number of partitions in second direction') c nfirst = number of nodes in the first level that is input in riord c riord = (also an ouput argument). on entry riord contains the labels c of the nfirst nodes that constitute the first level. c on return: c----------- c ndom = total number of partitions found c map = list of nodes listed partition by pertition from partition 1 c to paritition ndom. c mapptr = pointer array for map. All nodes from position c k1=mapptr(idom),to position k2=mapptr(idom+1)-1 in map belong c to partition idom. c work arrays: c------------- c mask = array of length n, used to hold the partition number of each c node for the first (large) partitioning. c mask is also used as a marker of visited nodes. c levels = integer array of length .le. n used to hold the pointer c arrays for the various level structures obtained from BFS. c----------------------------------------------------------------------- integer n, j,idom,kdom,jdom,maskval,k,nlev,init,ndp1,numnod maskval = 1 do j=1, n mask(j) = maskval enddo iwk(1) = 0 call BFS(n,ja,ia,nfirst,iwk,mask,maskval,riord,levels,nlev) c init = riord(1) c call perphn (ja,ia,mask,maskval,init,nlev,riord,levels) call stripes (nlev,riord,levels,ip1,map,mapptr,ndom) c----------------------------------------------------------------------- if (ip2 .eq. 1) return ndp1 = ndom+1 c c pack info into array iwk c do j = 1, ndom+1 iwk(j) = ndp1+mapptr(j) enddo do j=1, mapptr(ndom+1)-1 iwk(ndp1+j) = map(j) enddo c----------------------------------------------------------------------- do idom=1, ndom do k=mapptr(idom),mapptr(idom+1)-1 mask(map(k)) = idom enddo enddo nextdom = 1 c c jdom = counter for total number of (small) subdomains c jdom = 1 mapptr(jdom) = 1 c----------------------------------------------------------------------- do idom =1, ndom maskval = idom nfirst = 1 numnod = iwk(idom+1) - iwk(idom) j = iwk(idom) init = iwk(j) nextdom = mapptr(jdom) call perphn(numnod,ja,ia,init,iwk(j),mask,maskval, * nlev,riord,levels) call stripes (nlev,riord,levels,ip2,map(nextdom), * mapptr(jdom),kdom) mapptr(jdom) = nextdom do j = jdom,jdom+kdom-1 mapptr(j+1) = nextdom + mapptr(j+1)-1 enddo jdom = jdom + kdom enddo c ndom = jdom - 1 return end c----------------------------------------------------------------------- subroutine perphn(n,ja,ia,init,iperm,mask,maskval,nlev,riord, * levels) implicit none integer n,ja(*),ia(*),init,iperm(*),mask(*),maskval, * nlev,riord(*),levels(*) c----------------------------------------------------------------------- c finds a pseudo-peripheral node and does a BFS search from it. c----------------------------------------------------------------------- c see routine dblstr for description of parameters c input: c------- c ja, ia = list pointer array for the adjacency graph c mask = array used for masking nodes -- see maskval c maskval = value to be checked against for determing whether or c not a node is masked. If mask(k) .ne. maskval then c node k is not considered. c init = init node in the pseudo-peripheral node algorithm. c c output: c------- c init = actual pseudo-peripherial node found. c nlev = number of levels in the final BFS traversal. c riord = c levels = c----------------------------------------------------------------------- integer j,nlevp,deg,nfirst,mindeg,nod,maskdeg nlevp = 0 1 continue riord(1) = init nfirst = 1 call BFS(n,ja,ia,nfirst,iperm,mask,maskval,riord,levels,nlev) if (nlev .gt. nlevp) then mindeg = levels(nlev+1)-1 do j=levels(nlev),levels(nlev+1)-1 nod = riord(j) deg = maskdeg(ja,ia,nod,mask,maskval) if (deg .lt. mindeg) then init = nod mindeg = deg endif enddo nlevp = nlev goto 1 endif return end c----------------------------------------------------------------------- subroutine add_lvst(istart,iend,nlev,riord,ja,ia,mask,maskval) integer nlev, nod, riord(*), ja(*), ia(*), mask(*) c---------------------------------------------------------------------- c adds one level set to the previous sets. span all nodes of previous c set. Uses Mask to mark those already visited. c----------------------------------------------------------------------- nod = iend do 25 ir = istart+1,iend i = riord(ir) do 24 k=ia(i),ia(i+1)-1 j = ja(k) if (mask(j) .eq. maskval) then nod = nod+1 mask(j) = 0 riord(nod) = j endif 24 continue 25 continue istart = iend iend = nod return c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine stripes (nlev,riord,levels,ip,map,mapptr,ndom) implicit none integer nlev,riord(*),levels(nlev+1),ip,map(*), * mapptr(*), ndom c----------------------------------------------------------------------- c this is a post processor to BFS. stripes uses the output of BFS to c find a decomposition of the adjacency graph by stripes. It fills c the stripes level by level until a number of nodes .gt. ip is c is reached. c---------------------------parameters----------------------------------- c on entry: c -------- c nlev = number of levels as found by BFS c riord = reverse permutation array produced by BFS -- c levels = pointer array for the level structure as computed by BFS. If c lev is a level number, and k1=levels(lev),k2=levels(lev+1)-1, c then all the nodes of level number lev are: c riord(k1),riord(k1+1),...,riord(k2) c ip = number of desired partitions (subdomains) of about equal size. c c on return c --------- c ndom = number of subgraphs (subdomains) found c map = node per processor list. The nodes are listed contiguously c from proc 1 to nproc = mpx*mpy. c mapptr = pointer array for array map. list for proc. i starts at c mapptr(i) and ends at mapptr(i+1)-1 in array map. c----------------------------------------------------------------------- c local variables. c integer ib,ktr,ilev,k,nsiz,psiz ndom = 1 ib = 1 c to add: if (ip .le. 1) then ... nsiz = levels(nlev+1) - levels(1) psiz = (nsiz-ib)/max(1,(ip - ndom + 1)) + 1 mapptr(ndom) = ib ktr = 0 do 10 ilev = 1, nlev c c add all nodes of this level to domain c do 3 k=levels(ilev), levels(ilev+1)-1 map(ib) = riord(k) ib = ib+1 ktr = ktr + 1 if (ktr .ge. psiz .or. k .ge. nsiz) then ndom = ndom + 1 mapptr(ndom) = ib psiz = (nsiz-ib)/max(1,(ip - ndom + 1)) + 1 ktr = 0 endif c 3 continue 10 continue ndom = ndom-1 return c----------------------------------------------------------------------- c-----end-of-stripes---------------------------------------------------- end c----------------------------------------------------------------------- subroutine rversp (n, riord) integer n, riord(n) c----------------------------------------------------------------------- c this routine does an in-place reversing of the permutation array c riord -- c----------------------------------------------------------------------- integer j, k do 26 j=1,n/2 k = riord(j) riord(j) = riord(n-j+1) riord(n-j+1) = k 26 continue return end c----------------------------------------------------------------------- integer function maskdeg (ja,ia,nod,mask,maskval) implicit none integer ja(*),ia(*),nod,mask(*),maskval c----------------------------------------------------------------------- integer deg, k deg = 0 do k =ia(nod),ia(nod+1)-1 if (mask(ja(k)) .eq. maskval) deg = deg+1 enddo maskdeg = deg return end c----------------------------------------------------------------------- getdp-2.7.0-source/contrib/Sparskit/iters.f000644 001750 001750 00000313557 11266605601 022357 0ustar00geuzainegeuzaine000000 000000 c $Id: iters.f,v 1.1 2008-04-11 06:01:06 geuzaine Exp $ c----------------------------------------------------------------------c function distdot(n,x,ix,y,iy) c----------------------------------------------------------------------c integer n, ix, iy real*8 distdot, x(*), y(*), ddot external ddot distdot = ddot(n,x,ix,y,iy) return end c----------------------------------------------------------------------c c----------------------------------------------------------------------c c S P A R S K I T c c----------------------------------------------------------------------c c Basic Iterative Solvers with Reverse Communication c c----------------------------------------------------------------------c c This file currently has several basic iterative linear system c c solvers. They are: c c CG -- Conjugate Gradient Method c c CGNR -- Conjugate Gradient Method (Normal Residual equation) c c BCG -- Bi-Conjugate Gradient Method c c DBCG -- BCG with partial pivoting c c BCGSTAB -- BCG stabilized c c TFQMR -- Transpose-Free Quasi-Minimum Residual method c c FOM -- Full Orthogonalization Method c c GMRES -- Generalized Minimum RESidual method c c FGMRES -- Flexible version of Generalized Minimum c c RESidual method c c DQGMRES -- Direct versions of Quasi Generalize Minimum c c Residual method c c----------------------------------------------------------------------c c They all have the following calling sequence: c subroutine solver(n, rhs, sol, ipar, fpar, w) c integer n, ipar(16) c real*8 rhs(n), sol(n), fpar(16), w(*) c Where c (1) 'n' is the size of the linear system, c (2) 'rhs' is the right-hand side of the linear system, c (3) 'sol' is the solution to the linear system, c (4) 'ipar' is an integer parameter array for the reverse c communication protocol, c (5) 'fpar' is an floating-point parameter array storing c information to and from the iterative solvers. c (6) 'w' is the work space (size is specified in ipar) c c They are preconditioned iterative solvers with reverse c communication. The preconditioners can be applied from either c from left or right or both (specified by ipar(2), see below). c c Author: Kesheng John Wu (kewu@mail.cs.umn.edu) 1993 c c NOTES: c c (1) Work space required by each of the iterative solver c routines is as follows: c CG == 5 * n c CGNR == 5 * n c BCG == 7 * n c DBCG == 11 * n c BCGSTAB == 8 * n c TFQMR == 11 * n c FOM == (n+3)*(m+2) + (m+1)*m/2 (m = ipar(5), default m=15) c GMRES == (n+3)*(m+2) + (m+1)*m/2 (m = ipar(5), default m=15) c FGMRES == 2*n*(m+1) + (m+1)*m/2 + 3*m + 2 (m = ipar(5), c default m=15) c DQGMRES == n + lb * (2*n+4) (lb=ipar(5)+1, default lb = 16) c c (2) ALL iterative solvers require a user-supplied DOT-product c routine named DISTDOT. The prototype of DISTDOT is c c real*8 function distdot(n,x,ix,y,iy) c integer n, ix, iy c real*8 x(1+(n-1)*ix), y(1+(n-1)*iy) c c This interface of DISTDOT is exactly the same as that of c DDOT (or SDOT if real == real*8) from BLAS-1. It should have c same functionality as DDOT on a single processor machine. On a c parallel/distributed environment, each processor can perform c DDOT on the data it has, then perform a summation on all the c partial results. c c (3) To use this set of routines under SPMD/MIMD program paradigm, c several things are to be noted: (a) 'n' should be the number of c vector elements of 'rhs' that is present on the local processor. c (b) if RHS(i) is on processor j, it is expected that SOL(i) c will be on the same processor, i.e. the vectors are distributed c to each processor in the same way. (c) the preconditioning and c stopping criteria specifications have to be the same on all c processor involved, ipar and fpar have to be the same on each c processor. (d) DISTDOT should be replaced by a distributed c dot-product function. c c .................................................................. c Reverse Communication Protocols c c When a reverse-communication routine returns, it could be either c that the routine has terminated or it simply requires the caller c to perform one matrix-vector multiplication. The possible matrices c that involve in the matrix-vector multiplications are: c A (the matrix of the linear system), c A^T (A transposed), c Ml^{-1} (inverse of the left preconditioner), c Ml^{-T} (inverse of the left preconditioner transposed), c Mr^{-1} (inverse of the right preconditioner), c Mr^{-T} (inverse of the right preconditioner transposed). c For all the matrix vector multiplication, v = A u. The input and c output vectors are supposed to be part of the work space 'w', and c the starting positions of them are stored in ipar(8:9), see below. c c The array 'ipar' is used to store the information about the solver. c Here is the list of what each element represents: c c ipar(1) -- status of the call/return. c A call to the solver with ipar(1) == 0 will initialize the c iterative solver. On return from the iterative solver, ipar(1) c carries the status flag which indicates the condition of the c return. The status information is divided into two categories, c (1) a positive value indicates the solver requires a matrix-vector c multiplication, c (2) a non-positive value indicates termination of the solver. c Here is the current definition: c 1 == request a matvec with A, c 2 == request a matvec with A^T, c 3 == request a left preconditioner solve (Ml^{-1}), c 4 == request a left preconditioner transposed solve (Ml^{-T}), c 5 == request a right preconditioner solve (Mr^{-1}), c 6 == request a right preconditioner transposed solve (Mr^{-T}), c 10 == request the caller to perform stopping test, c 0 == normal termination of the solver, satisfied the stopping c criteria, c -1 == termination because iteration number is greater than the c preset limit, c -2 == return due to insufficient work space, c -3 == return due to anticipated break-down / divide by zero, c in the case where Arnoldi procedure is used, additional c error code can be found in ipar(12), where ipar(12) is c the error code of orthogonalization procedure MGSRO: c -1: zero input vector c -2: input vector contains abnormal numbers c -3: input vector is a linear combination of others c -4: trianguler system in GMRES/FOM/etc. has rank 0 (zero) c -4 == the values of fpar(1) and fpar(2) are both <= 0, the valid c ranges are 0 <= fpar(1) < 1, 0 <= fpar(2), and they can c not be zero at the same time c -9 == while trying to detect a break-down, an abnormal number is c detected. c -10 == return due to some non-numerical reasons, e.g. invalid c floating-point numbers etc. c c ipar(2) -- status of the preconditioning: c 0 == no preconditioning c 1 == left preconditioning only c 2 == right preconditioning only c 3 == both left and right preconditioning c c ipar(3) -- stopping criteria (details of this will be c discussed later). c c ipar(4) -- number of elements in the array 'w'. if this is less c than the desired size, it will be over-written with the minimum c requirement. In which case the status flag ipar(1) = -2. c c ipar(5) -- size of the Krylov subspace (used by GMRES and its c variants), e.g. GMRES(ipar(5)), FGMRES(ipar(5)), c DQGMRES(ipar(5)). c c ipar(6) -- maximum number of matrix-vector multiplies, if not a c positive number the iterative solver will run till convergence c test is satisfied. c c ipar(7) -- current number of matrix-vector multiplies. It is c incremented after each matrix-vector multiplication. If there c is preconditioning, the counter is incremented after the c preconditioning associated with each matrix-vector multiplication. c c ipar(8) -- pointer to the input vector to the requested matrix- c vector multiplication. c c ipar(9) -- pointer to the output vector of the requested matrix- c vector multiplication. c c To perform v = A * u, it is assumed that u is w(ipar(8):ipar(8)+n-1) c and v is stored as w(ipar(9):ipar(9)+n-1). c c ipar(10) -- the return address (used to determine where to go to c inside the iterative solvers after the caller has performed the c requested services). c c ipar(11) -- the result of the external convergence test c On final return from the iterative solvers, this value c will be reflected by ipar(1) = 0 (details discussed later) c c ipar(12) -- error code of MGSRO, it is c 1 if the input vector to MGSRO is linear combination c of others, c 0 if MGSRO was successful, c -1 if the input vector to MGSRO is zero, c -2 if the input vector contains invalid number. c c ipar(13) -- number of initializations. During each initilization c residual norm is computed directly from M_l(b - A x). c c ipar(14) to ipar(16) are NOT defined, they are NOT USED by c any iterative solver at this time. c c Information about the error and tolerance are stored in the array c FPAR. So are some internal variables that need to be saved from c one iteration to the next one. Since the internal variables are c not the same for each routine, we only define the common ones. c c The first two are input parameters: c fpar(1) -- the relative tolerance, c fpar(2) -- the absolute tolerance (details discussed later), c c When the iterative solver terminates, c fpar(3) -- initial residual/error norm, c fpar(4) -- target residual/error norm, c fpar(5) -- current residual norm (if available), c fpar(6) -- current residual/error norm, c fpar(7) -- convergence rate, c c fpar(8:10) are used by some of the iterative solvers to save some c internal information. c c fpar(11) -- number of floating-point operations. The iterative c solvers will add the number of FLOPS they used to this variable, c but they do NOT initialize it, nor add the number of FLOPS due to c matrix-vector multiplications (since matvec is outside of the c iterative solvers). To insure the correct FLOPS count, the c caller should set fpar(11) = 0 before invoking the iterative c solvers and account for the number of FLOPS from matrix-vector c multiplications and preconditioners. c c fpar(12:16) are not used in current implementation. c c Whether the content of fpar(3), fpar(4) and fpar(6) are residual c norms or error norms depends on ipar(3). If the requested c convergence test is based on the residual norm, they will be c residual norms. If the caller want to test convergence based the c error norms (estimated by the norm of the modifications applied c to the approximate solution), they will be error norms. c Convergence rate is defined by (Fortran 77 statement) c fpar(7) = log10(fpar(3) / fpar(6)) / (ipar(7)-ipar(13)) c If fpar(7) = 0.5, it means that approximately every 2 (= 1/0.5) c steps the residual/error norm decrease by a factor of 10. c c .................................................................. c Stopping criteria, c c An iterative solver may be terminated due to (1) satisfying c convergence test; (2) exceeding iteration limit; (3) insufficient c work space; (4) break-down. Checking of the work space is c only done in the initialization stage, i.e. when it is called with c ipar(1) == 0. A complete convergence test is done after each c update of the solutions. Other conditions are monitored c continuously. c c With regard to the number of iteration, when ipar(6) is positive, c the current iteration number will be checked against it. If c current iteration number is greater the ipar(6) than the solver c will return with status -1. If ipar(6) is not positive, the c iteration will continue until convergence test is satisfied. c c Two things may be used in the convergence tests, one is the c residual 2-norm, the other one is 2-norm of the change in the c approximate solution. The residual and the change in approximate c solution are from the preconditioned system (if preconditioning c is applied). The DQGMRES and TFQMR use two estimates for the c residual norms. The estimates are not accurate, but they are c acceptable in most of the cases. Generally speaking, the error c of the TFQMR's estimate is less accurate. c c The convergence test type is indicated by ipar(3). There are four c type convergence tests: (1) tests based on the residual norm; c (2) tests based on change in approximate solution; (3) caller c does not care, the solver choose one from above two on its own; c (4) caller will perform the test, the solver should simply continue. c Here is the complete definition: c -2 == || dx(i) || <= rtol * || rhs || + atol c -1 == || dx(i) || <= rtol * || dx(1) || + atol c 0 == solver will choose test 1 (next) c 1 == || residual || <= rtol * || initial residual || + atol c 2 == || residual || <= rtol * || rhs || + atol c 999 == caller will perform the test c where dx(i) denote the change in the solution at the ith update. c ||.|| denotes 2-norm. rtol = fpar(1) and atol = fpar(2). c c If the caller is to perform the convergence test, the outcome c should be stored in ipar(11). c ipar(11) = 0 -- failed the convergence test, iterative solver c should continue c ipar(11) = 1 -- satisfied convergence test, iterative solver c should perform the clean up job and stop. c c Upon return with ipar(1) = 10, c ipar(8) points to the starting position of the change in c solution Sx, where the actual solution of the step is c x_j = x_0 + M_r^{-1} Sx. c Exception: ipar(8) < 0, Sx = 0. It is mostly used by c GMRES and variants to indicate (1) Sx was not necessary, c (2) intermediate result of Sx is not computed. c ipar(9) points to the starting position of a work vector that c can be used by the caller. c c NOTE: the caller should allow the iterative solver to perform c clean up job after the external convergence test is satisfied, c since some of the iterative solvers do not directly c update the 'sol' array. A typical clean-up stage includes c performing the final update of the approximate solution and c computing the convergence information (e.g. values of fpar(3:7)). c c NOTE: fpar(4) and fpar(6) are not set by the accelerators (the c routines implemented here) if ipar(3) = 999. c c .................................................................. c Usage: c c To start solving a linear system, the user needs to specify c first 6 elements of the ipar, and first 2 elements of fpar. c The user may optionally set fpar(11) = 0 if one wants to count c the number of floating-point operations. (Note: the iterative c solvers will only add the floating-point operations inside c themselves, the caller will have to add the FLOPS from the c matrix-vector multiplication routines and the preconditioning c routines in order to account for all the arithmetic operations.) c c Here is an example: c ipar(1) = 0 ! always 0 to start an iterative solver c ipar(2) = 2 ! right preconditioning c ipar(3) = 1 ! use convergence test scheme 1 c ipar(4) = 10000 ! the 'w' has 10,000 elements c ipar(5) = 10 ! use *GMRES(10) (e.g. FGMRES(10)) c ipar(6) = 100 ! use at most 100 matvec's c fpar(1) = 1.0E-6 ! relative tolerance 1.0E-6 c fpar(2) = 1.0E-10 ! absolute tolerance 1.0E-10 c fpar(11) = 0.0 ! clearing the FLOPS counter c c After the above specifications, one can start to call an iterative c solver, say BCG. Here is a piece of pseudo-code showing how it can c be done, c c 10 call bcg(n,rhs,sol,ipar,fpar,w) c if (ipar(1).eq.1) then c call amux(n,w(ipar(8)),w(ipar(9)),a,ja,ia) c goto 10 c else if (ipar(1).eq.2) then c call atmux(n,w(ipar(8)),w(ipar(9)),a,ja,ia) c goto 10 c else if (ipar(1).eq.3) then c left preconditioner solver c goto 10 c else if (ipar(1).eq.4) then c left preconditioner transposed solve c goto 10 c else if (ipar(1).eq.5) then c right preconditioner solve c goto 10 c else if (ipar(1).eq.6) then c right preconditioner transposed solve c goto 10 c else if (ipar(1).eq.10) then c call my own stopping test routine c goto 10 c else if (ipar(1).gt.0) then c ipar(1) is an unspecified code c else c the iterative solver terminated with code = ipar(1) c endif c c This segment of pseudo-code assumes the matrix is in CSR format, c AMUX and ATMUX are two routines from the SPARSKIT MATVEC module. c They perform matrix-vector multiplications for CSR matrices, c where w(ipar(8)) is the first element of the input vectors to the c two routines, and w(ipar(9)) is the first element of the output c vectors from them. For simplicity, we did not show the name of c the routine that performs the preconditioning operations or the c convergence tests. c----------------------------------------------------------------------- subroutine cg(n, rhs, sol, ipar, fpar, w) implicit none integer n, ipar(16) real*8 rhs(n), sol(n), fpar(16), w(n,*) c----------------------------------------------------------------------- c This is a implementation of the Conjugate Gradient (CG) method c for solving linear system. c c NOTE: This is not the PCG algorithm. It is a regular CG algorithm. c To be consistent with the other solvers, the preconditioners are c applied by performing Ml^{-1} A Mr^{-1} P in place of A P in the c CG algorithm. The PCG uses its preconditioners very differently. c c fpar(7) is used here internally to store . c w(:,1) -- residual vector c w(:,2) -- P, the conjugate direction c w(:,3) -- A P, matrix multiply the conjugate direction c w(:,4) -- temporary storage for results of preconditioning c w(:,5) -- change in the solution (sol) is stored here until c termination of this solver c----------------------------------------------------------------------- c external functions used c real*8 distdot logical stopbis, brkdn external distdot, stopbis, brkdn, bisinit c c local variables c integer i real*8 alpha logical lp,rp save c c check the status of the call c if (ipar(1).le.0) ipar(10) = 0 goto (10, 20, 40, 50, 60, 70, 80), ipar(10) c c initialization c call bisinit(ipar,fpar,5*n,1,lp,rp,w) if (ipar(1).lt.0) return c c request for matrix vector multiplication A*x in the initialization c ipar(1) = 1 ipar(8) = n+1 ipar(9) = ipar(8) + n ipar(10) = 1 do i = 1, n w(i,2) = sol(i) enddo return 10 ipar(7) = ipar(7) + 1 ipar(13) = 1 do i = 1, n w(i,2) = rhs(i) - w(i,3) enddo fpar(11) = fpar(11) + n c c if left preconditioned c if (lp) then ipar(1) = 3 ipar(9) = 1 ipar(10) = 2 return endif c 20 if (lp) then do i = 1, n w(i,2) = w(i,1) enddo else do i = 1, n w(i,1) = w(i,2) enddo endif c fpar(7) = distdot(n,w,1,w,1) fpar(11) = fpar(11) + 2 * n fpar(3) = sqrt(fpar(7)) fpar(5) = fpar(3) if (abs(ipar(3)).eq.2) then fpar(4) = fpar(1) * sqrt(distdot(n,rhs,1,rhs,1)) + fpar(2) fpar(11) = fpar(11) + 2 * n else if (ipar(3).ne.999) then fpar(4) = fpar(1) * fpar(3) + fpar(2) endif c c before iteration can continue, we need to compute A * p, which c includes the preconditioning operations c 30 if (rp) then ipar(1) = 5 ipar(8) = n + 1 if (lp) then ipar(9) = ipar(8) + n else ipar(9) = 3*n + 1 endif ipar(10) = 3 return endif c 40 ipar(1) = 1 if (rp) then ipar(8) = ipar(9) else ipar(8) = n + 1 endif if (lp) then ipar(9) = 3*n+1 else ipar(9) = n+n+1 endif ipar(10) = 4 return c 50 if (lp) then ipar(1) = 3 ipar(8) = ipar(9) ipar(9) = n+n+1 ipar(10) = 5 return endif c c continuing with the iterations c 60 ipar(7) = ipar(7) + 1 alpha = distdot(n,w(1,2),1,w(1,3),1) fpar(11) = fpar(11) + 2*n if (brkdn(alpha,ipar)) goto 900 alpha = fpar(7) / alpha do i = 1, n w(i,5) = w(i,5) + alpha * w(i,2) w(i,1) = w(i,1) - alpha * w(i,3) enddo fpar(11) = fpar(11) + 4*n c c are we ready to terminate ? c if (ipar(3).eq.999) then ipar(1) = 10 ipar(8) = 4*n + 1 ipar(9) = 3*n + 1 ipar(10) = 6 return endif 70 if (ipar(3).eq.999) then if (ipar(11).eq.1) goto 900 else if (stopbis(n,ipar,1,fpar,w,w(1,2),alpha)) then goto 900 endif c c continue the iterations c alpha = fpar(5)*fpar(5) / fpar(7) fpar(7) = fpar(5)*fpar(5) do i = 1, n w(i,2) = w(i,1) + alpha * w(i,2) enddo fpar(11) = fpar(11) + 2*n goto 30 c c clean up -- necessary to accommodate the right-preconditioning c 900 if (rp) then if (ipar(1).lt.0) ipar(12) = ipar(1) ipar(1) = 5 ipar(8) = 4*n + 1 ipar(9) = ipar(8) - n ipar(10) = 7 return endif 80 if (rp) then call tidycg(n,ipar,fpar,sol,w(1,4)) else call tidycg(n,ipar,fpar,sol,w(1,5)) endif c return end c-----end-of-cg c----------------------------------------------------------------------- subroutine cgnr(n,rhs,sol,ipar,fpar,wk) implicit none integer n, ipar(16) real*8 rhs(n),sol(n),fpar(16),wk(n,*) c----------------------------------------------------------------------- c CGNR -- Using CG algorithm solving A x = b by solving c Normal Residual equation: A^T A x = A^T b c As long as the matrix is not singular, A^T A is symmetric c positive definite, therefore CG (CGNR) will converge. c c Usage of the work space: c wk(:,1) == residual vector R c wk(:,2) == the conjugate direction vector P c wk(:,3) == a scratch vector holds A P, or A^T R c wk(:,4) == a scratch vector holds intermediate results of the c preconditioning c wk(:,5) == a place to hold the modification to SOL c c size of the work space WK is required = 5*n c----------------------------------------------------------------------- c external functions used c real*8 distdot logical stopbis, brkdn external distdot, stopbis, brkdn, bisinit c c local variables c integer i real*8 alpha, zz, zzm1 logical lp, rp save c c check the status of the call c if (ipar(1).le.0) ipar(10) = 0 goto (10, 20, 40, 50, 60, 70, 80, 90, 100, 110), ipar(10) c c initialization c call bisinit(ipar,fpar,5*n,1,lp,rp,wk) if (ipar(1).lt.0) return c c request for matrix vector multiplication A*x in the initialization c ipar(1) = 1 ipar(8) = 1 ipar(9) = 1 + n ipar(10) = 1 do i = 1, n wk(i,1) = sol(i) enddo return 10 ipar(7) = ipar(7) + 1 ipar(13) = ipar(13) + 1 do i = 1, n wk(i,1) = rhs(i) - wk(i,2) enddo fpar(11) = fpar(11) + n c c if left preconditioned, precondition the initial residual c if (lp) then ipar(1) = 3 ipar(10) = 2 return endif c 20 if (lp) then do i = 1, n wk(i,1) = wk(i,2) enddo endif c zz = distdot(n,wk,1,wk,1) fpar(11) = fpar(11) + 2 * n fpar(3) = sqrt(zz) fpar(5) = fpar(3) if (abs(ipar(3)).eq.2) then fpar(4) = fpar(1) * sqrt(distdot(n,rhs,1,rhs,1)) + fpar(2) fpar(11) = fpar(11) + 2 * n else if (ipar(3).ne.999) then fpar(4) = fpar(1) * fpar(3) + fpar(2) endif c c normal iteration begins here, first half of the iteration c computes the conjugate direction c 30 continue c c request the caller to perform a A^T r --> wk(:,3) c if (lp) then ipar(1) = 4 ipar(8) = 1 if (rp) then ipar(9) = n + n + 1 else ipar(9) = 3*n + 1 endif ipar(10) = 3 return endif c 40 ipar(1) = 2 if (lp) then ipar(8) = ipar(9) else ipar(8) = 1 endif if (rp) then ipar(9) = 3*n + 1 else ipar(9) = n + n + 1 endif ipar(10) = 4 return c 50 if (rp) then ipar(1) = 6 ipar(8) = ipar(9) ipar(9) = n + n + 1 ipar(10) = 5 return endif c 60 ipar(7) = ipar(7) + 1 zzm1 = zz zz = distdot(n,wk(1,3),1,wk(1,3),1) fpar(11) = fpar(11) + 2 * n if (brkdn(zz,ipar)) goto 900 if (ipar(7).gt.3) then alpha = zz / zzm1 do i = 1, n wk(i,2) = wk(i,3) + alpha * wk(i,2) enddo fpar(11) = fpar(11) + 2 * n else do i = 1, n wk(i,2) = wk(i,3) enddo endif c c before iteration can continue, we need to compute A * p c if (rp) then ipar(1) = 5 ipar(8) = n + 1 if (lp) then ipar(9) = ipar(8) + n else ipar(9) = 3*n + 1 endif ipar(10) = 6 return endif c 70 ipar(1) = 1 if (rp) then ipar(8) = ipar(9) else ipar(8) = n + 1 endif if (lp) then ipar(9) = 3*n+1 else ipar(9) = n+n+1 endif ipar(10) = 7 return c 80 if (lp) then ipar(1) = 3 ipar(8) = ipar(9) ipar(9) = n+n+1 ipar(10) = 8 return endif c c update the solution -- accumulate the changes in w(:,5) c 90 ipar(7) = ipar(7) + 1 alpha = distdot(n,wk(1,3),1,wk(1,3),1) fpar(11) = fpar(11) + 2 * n if (brkdn(alpha,ipar)) goto 900 alpha = zz / alpha do i = 1, n wk(i,5) = wk(i,5) + alpha * wk(i,2) wk(i,1) = wk(i,1) - alpha * wk(i,3) enddo fpar(11) = fpar(11) + 4 * n c c are we ready to terminate ? c if (ipar(3).eq.999) then ipar(1) = 10 ipar(8) = 4*n + 1 ipar(9) = 3*n + 1 ipar(10) = 9 return endif 100 if (ipar(3).eq.999) then if (ipar(11).eq.1) goto 900 else if (stopbis(n,ipar,1,fpar,wk,wk(1,2),alpha)) then goto 900 endif c c continue the iterations c goto 30 c c clean up -- necessary to accommodate the right-preconditioning c 900 if (rp) then if (ipar(1).lt.0) ipar(12) = ipar(1) ipar(1) = 5 ipar(8) = 4*n + 1 ipar(9) = ipar(8) - n ipar(10) = 10 return endif 110 if (rp) then call tidycg(n,ipar,fpar,sol,wk(1,4)) else call tidycg(n,ipar,fpar,sol,wk(1,5)) endif return end c-----end-of-cgnr c----------------------------------------------------------------------- subroutine bcg(n,rhs,sol,ipar,fpar,w) implicit none integer n, ipar(16) real*8 fpar(16), rhs(n), sol(n), w(n,*) c----------------------------------------------------------------------- c BCG: Bi Conjugate Gradient method. Programmed with reverse c communication, see the header for detailed specifications c of the protocol. c c in this routine, before successful return, the fpar's are c fpar(3) == initial residual norm c fpar(4) == target residual norm c fpar(5) == current residual norm c fpar(7) == current rho (rhok = ) c fpar(8) == previous rho (rhokm1) c c w(:,1) -- r, the residual c w(:,2) -- s, the dual of the 'r' c w(:,3) -- p, the projection direction c w(:,4) -- q, the dual of the 'p' c w(:,5) -- v, a scratch vector to store A*p, or A*q. c w(:,6) -- a scratch vector to store intermediate results c w(:,7) -- changes in the solution c----------------------------------------------------------------------- c external routines used c real*8 distdot logical stopbis,brkdn external distdot, stopbis, brkdn c real*8 one parameter(one=1.0D0) c c local variables c integer i real*8 alpha logical rp, lp save c c status of the program c if (ipar(1).le.0) ipar(10) = 0 goto (10, 20, 40, 50, 60, 70, 80, 90, 100, 110), ipar(10) c c initialization, initial residual c call bisinit(ipar,fpar,7*n,1,lp,rp,w) if (ipar(1).lt.0) return c c compute initial residual, request a matvecc c ipar(1) = 1 ipar(8) = 3*n+1 ipar(9) = ipar(8) + n do i = 1, n w(i,4) = sol(i) enddo ipar(10) = 1 return 10 ipar(7) = ipar(7) + 1 ipar(13) = ipar(13) + 1 do i = 1, n w(i,1) = rhs(i) - w(i,5) enddo fpar(11) = fpar(11) + n if (lp) then ipar(1) = 3 ipar(8) = 1 ipar(9) = n+1 ipar(10) = 2 return endif c 20 if (lp) then do i = 1, n w(i,1) = w(i,2) w(i,3) = w(i,2) w(i,4) = w(i,2) enddo else do i = 1, n w(i,2) = w(i,1) w(i,3) = w(i,1) w(i,4) = w(i,1) enddo endif c fpar(7) = distdot(n,w,1,w,1) fpar(11) = fpar(11) + 2 * n fpar(3) = sqrt(fpar(7)) fpar(5) = fpar(3) fpar(8) = one if (abs(ipar(3)).eq.2) then fpar(4) = fpar(1) * sqrt(distdot(n,rhs,1,rhs,1)) + fpar(2) fpar(11) = fpar(11) + 2 * n else if (ipar(3).ne.999) then fpar(4) = fpar(1) * fpar(3) + fpar(2) endif if (ipar(3).ge.0.and.fpar(5).le.fpar(4)) then fpar(6) = fpar(5) goto 900 endif c c end of initialization, begin iteration, v = A p c 30 if (rp) then ipar(1) = 5 ipar(8) = n + n + 1 if (lp) then ipar(9) = 4*n + 1 else ipar(9) = 5*n + 1 endif ipar(10) = 3 return endif c 40 ipar(1) = 1 if (rp) then ipar(8) = ipar(9) else ipar(8) = n + n + 1 endif if (lp) then ipar(9) = 5*n + 1 else ipar(9) = 4*n + 1 endif ipar(10) = 4 return c 50 if (lp) then ipar(1) = 3 ipar(8) = ipar(9) ipar(9) = 4*n + 1 ipar(10) = 5 return endif c 60 ipar(7) = ipar(7) + 1 alpha = distdot(n,w(1,4),1,w(1,5),1) fpar(11) = fpar(11) + 2 * n if (brkdn(alpha,ipar)) goto 900 alpha = fpar(7) / alpha do i = 1, n w(i,7) = w(i,7) + alpha * w(i,3) w(i,1) = w(i,1) - alpha * w(i,5) enddo fpar(11) = fpar(11) + 4 * n if (ipar(3).eq.999) then ipar(1) = 10 ipar(8) = 6*n + 1 ipar(9) = 5*n + 1 ipar(10) = 6 return endif 70 if (ipar(3).eq.999) then if (ipar(11).eq.1) goto 900 else if (stopbis(n,ipar,1,fpar,w,w(1,3),alpha)) then goto 900 endif c c A^t * x c if (lp) then ipar(1) = 4 ipar(8) = 3*n + 1 if (rp) then ipar(9) = 4*n + 1 else ipar(9) = 5*n + 1 endif ipar(10) = 7 return endif c 80 ipar(1) = 2 if (lp) then ipar(8) = ipar(9) else ipar(8) = 3*n + 1 endif if (rp) then ipar(9) = 5*n + 1 else ipar(9) = 4*n + 1 endif ipar(10) = 8 return c 90 if (rp) then ipar(1) = 6 ipar(8) = ipar(9) ipar(9) = 4*n + 1 ipar(10) = 9 return endif c 100 ipar(7) = ipar(7) + 1 do i = 1, n w(i,2) = w(i,2) - alpha * w(i,5) enddo fpar(8) = fpar(7) fpar(7) = distdot(n,w,1,w(1,2),1) fpar(11) = fpar(11) + 4 * n if (brkdn(fpar(7), ipar)) return alpha = fpar(7) / fpar(8) do i = 1, n w(i,3) = w(i,1) + alpha * w(i,3) w(i,4) = w(i,2) + alpha * w(i,4) enddo fpar(11) = fpar(11) + 4 * n c c end of the iterations c goto 30 c c some clean up job to do c 900 if (rp) then if (ipar(1).lt.0) ipar(12) = ipar(1) ipar(1) = 5 ipar(8) = 6*n + 1 ipar(9) = ipar(8) - n ipar(10) = 10 return endif 110 if (rp) then call tidycg(n,ipar,fpar,sol,w(1,6)) else call tidycg(n,ipar,fpar,sol,w(1,7)) endif return c-----end-of-bcg end c----------------------------------------------------------------------- subroutine bcgstab(n, rhs, sol, ipar, fpar, w) implicit none integer n, ipar(16) real*8 rhs(n), sol(n), fpar(16), w(n,8) c----------------------------------------------------------------------- c BCGSTAB --- Bi Conjugate Gradient stabilized (BCGSTAB) c This is an improved BCG routine. (1) no matrix transpose is c involved. (2) the convergence is smoother. c c c Algorithm: c Initialization - r = b - A x, r0 = r, p = r, rho = (r0, r), c Iterate - c (1) v = A p c (2) alpha = rho / (r0, v) c (3) s = r - alpha v c (4) t = A s c (5) omega = (t, s) / (t, t) c (6) x = x + alpha * p + omega * s c (7) r = s - omega * t c convergence test goes here c (8) beta = rho, rho = (r0, r), beta = rho * alpha / (beta * omega) c p = r + beta * (p - omega * v) c c in this routine, before successful return, the fpar's are c fpar(3) == initial (preconditionied-)residual norm c fpar(4) == target (preconditionied-)residual norm c fpar(5) == current (preconditionied-)residual norm c fpar(6) == current residual norm or error c fpar(7) == current rho (rhok = ) c fpar(8) == alpha c fpar(9) == omega c c Usage of the work space W c w(:, 1) = r0, the initial residual vector c w(:, 2) = r, current residual vector c w(:, 3) = s c w(:, 4) = t c w(:, 5) = v c w(:, 6) = p c w(:, 7) = tmp, used in preconditioning, etc. c w(:, 8) = delta x, the correction to the answer is accumulated c here, so that the right-preconditioning may be applied c at the end c----------------------------------------------------------------------- c external routines used c real*8 distdot logical stopbis, brkdn external distdot, stopbis, brkdn c real*8 one parameter(one=1.0D0) c c local variables c integer i real*8 alpha,beta,rho,omega logical lp, rp save lp, rp c c where to go c if (ipar(1).gt.0) then goto (10, 20, 40, 50, 60, 70, 80, 90, 100, 110) ipar(10) else if (ipar(1).lt.0) then goto 900 endif c c call the initialization routine c call bisinit(ipar,fpar,8*n,1,lp,rp,w) if (ipar(1).lt.0) return c c perform a matvec to compute the initial residual c ipar(1) = 1 ipar(8) = 1 ipar(9) = 1 + n do i = 1, n w(i,1) = sol(i) enddo ipar(10) = 1 return 10 ipar(7) = ipar(7) + 1 ipar(13) = ipar(13) + 1 do i = 1, n w(i,1) = rhs(i) - w(i,2) enddo fpar(11) = fpar(11) + n if (lp) then ipar(1) = 3 ipar(10) = 2 return endif c 20 if (lp) then do i = 1, n w(i,1) = w(i,2) w(i,6) = w(i,2) enddo else do i = 1, n w(i,2) = w(i,1) w(i,6) = w(i,1) enddo endif c fpar(7) = distdot(n,w,1,w,1) fpar(11) = fpar(11) + 2 * n fpar(5) = sqrt(fpar(7)) fpar(3) = fpar(5) if (abs(ipar(3)).eq.2) then fpar(4) = fpar(1) * sqrt(distdot(n,rhs,1,rhs,1)) + fpar(2) fpar(11) = fpar(11) + 2 * n else if (ipar(3).ne.999) then fpar(4) = fpar(1) * fpar(3) + fpar(2) endif if (ipar(3).ge.0) fpar(6) = fpar(5) if (ipar(3).ge.0 .and. fpar(5).le.fpar(4) .and. + ipar(3).ne.999) then goto 900 endif c c beginning of the iterations c c Step (1), v = A p 30 if (rp) then ipar(1) = 5 ipar(8) = 5*n+1 if (lp) then ipar(9) = 4*n + 1 else ipar(9) = 6*n + 1 endif ipar(10) = 3 return endif c 40 ipar(1) = 1 if (rp) then ipar(8) = ipar(9) else ipar(8) = 5*n+1 endif if (lp) then ipar(9) = 6*n + 1 else ipar(9) = 4*n + 1 endif ipar(10) = 4 return 50 if (lp) then ipar(1) = 3 ipar(8) = ipar(9) ipar(9) = 4*n + 1 ipar(10) = 5 return endif c 60 ipar(7) = ipar(7) + 1 c c step (2) alpha = distdot(n,w(1,1),1,w(1,5),1) fpar(11) = fpar(11) + 2 * n if (brkdn(alpha, ipar)) goto 900 alpha = fpar(7) / alpha fpar(8) = alpha c c step (3) do i = 1, n w(i,3) = w(i,2) - alpha * w(i,5) enddo fpar(11) = fpar(11) + 2 * n c c Step (4): the second matvec -- t = A s c if (rp) then ipar(1) = 5 ipar(8) = n+n+1 if (lp) then ipar(9) = ipar(8)+n else ipar(9) = 6*n + 1 endif ipar(10) = 6 return endif c 70 ipar(1) = 1 if (rp) then ipar(8) = ipar(9) else ipar(8) = n+n+1 endif if (lp) then ipar(9) = 6*n + 1 else ipar(9) = 3*n + 1 endif ipar(10) = 7 return 80 if (lp) then ipar(1) = 3 ipar(8) = ipar(9) ipar(9) = 3*n + 1 ipar(10) = 8 return endif 90 ipar(7) = ipar(7) + 1 c c step (5) omega = distdot(n,w(1,4),1,w(1,4),1) fpar(11) = fpar(11) + n + n if (brkdn(omega,ipar)) goto 900 omega = distdot(n,w(1,4),1,w(1,3),1) / omega fpar(11) = fpar(11) + n + n if (brkdn(omega,ipar)) goto 900 fpar(9) = omega alpha = fpar(8) c c step (6) and (7) do i = 1, n w(i,7) = alpha * w(i,6) + omega * w(i,3) w(i,8) = w(i,8) + w(i,7) w(i,2) = w(i,3) - omega * w(i,4) enddo fpar(11) = fpar(11) + 6 * n + 1 c c convergence test if (ipar(3).eq.999) then ipar(1) = 10 ipar(8) = 7*n + 1 ipar(9) = 6*n + 1 ipar(10) = 9 return endif if (stopbis(n,ipar,2,fpar,w(1,2),w(1,7),one)) goto 900 100 if (ipar(3).eq.999.and.ipar(11).eq.1) goto 900 c c step (8): computing new p and rho rho = fpar(7) fpar(7) = distdot(n,w(1,2),1,w(1,1),1) omega = fpar(9) beta = fpar(7) * fpar(8) / (fpar(9) * rho) do i = 1, n w(i,6) = w(i,2) + beta * (w(i,6) - omega * w(i,5)) enddo fpar(11) = fpar(11) + 6 * n + 3 if (brkdn(fpar(7),ipar)) goto 900 c c end of an iteration c goto 30 c c some clean up job to do c 900 if (rp) then if (ipar(1).lt.0) ipar(12) = ipar(1) ipar(1) = 5 ipar(8) = 7*n + 1 ipar(9) = ipar(8) - n ipar(10) = 10 return endif 110 if (rp) then call tidycg(n,ipar,fpar,sol,w(1,7)) else call tidycg(n,ipar,fpar,sol,w(1,8)) endif c return c-----end-of-bcgstab end c----------------------------------------------------------------------- subroutine tfqmr(n, rhs, sol, ipar, fpar, w) implicit none integer n, ipar(16) real*8 rhs(n), sol(n), fpar(16), w(n,*) c----------------------------------------------------------------------- c TFQMR --- transpose-free Quasi-Minimum Residual method c This is developed from BCG based on the principle of Quasi-Minimum c Residual, and it is transpose-free. c c It uses approximate residual norm. c c Internally, the fpar's are used as following: c fpar(3) --- initial residual norm squared c fpar(4) --- target residual norm squared c fpar(5) --- current residual norm squared c c w(:,1) -- R, residual c w(:,2) -- R0, the initial residual c w(:,3) -- W c w(:,4) -- Y c w(:,5) -- Z c w(:,6) -- A * Y c w(:,7) -- A * Z c w(:,8) -- V c w(:,9) -- D c w(:,10) -- intermediate results of preconditioning c w(:,11) -- changes in the solution c----------------------------------------------------------------------- c external functions c real*8 distdot logical stopbis, brkdn external stopbis, brkdn, distdot c real*8 one,zero parameter(one=1.0D0,zero=0.0D0) c c local variables c integer i logical lp, rp real*8 eta,sigma,theta,te,alpha,rho,tao save c c status of the call (where to go) c if (ipar(1).le.0) ipar(10) = 0 goto (10,20,40,50,60,70,80,90,100,110), ipar(10) c c initializations c call bisinit(ipar,fpar,11*n,2,lp,rp,w) if (ipar(1).lt.0) return ipar(1) = 1 ipar(8) = 1 ipar(9) = 1 + 6*n do i = 1, n w(i,1) = sol(i) enddo ipar(10) = 1 return 10 ipar(7) = ipar(7) + 1 ipar(13) = ipar(13) + 1 do i = 1, n w(i,1) = rhs(i) - w(i,7) w(i,9) = zero enddo fpar(11) = fpar(11) + n c if (lp) then ipar(1) = 3 ipar(9) = n+1 ipar(10) = 2 return endif 20 continue if (lp) then do i = 1, n w(i,1) = w(i,2) w(i,3) = w(i,2) enddo else do i = 1, n w(i,2) = w(i,1) w(i,3) = w(i,1) enddo endif c fpar(5) = sqrt(distdot(n,w,1,w,1)) fpar(3) = fpar(5) tao = fpar(5) fpar(11) = fpar(11) + n + n if (abs(ipar(3)).eq.2) then fpar(4) = fpar(1) * sqrt(distdot(n,rhs,1,rhs,1)) + fpar(2) fpar(11) = fpar(11) + n + n else if (ipar(3).ne.999) then fpar(4) = fpar(1) * tao + fpar(2) endif te = zero rho = zero c c begin iteration c 30 sigma = rho rho = distdot(n,w(1,2),1,w(1,3),1) fpar(11) = fpar(11) + n + n if (brkdn(rho,ipar)) goto 900 if (ipar(7).eq.1) then alpha = zero else alpha = rho / sigma endif do i = 1, n w(i,4) = w(i,3) + alpha * w(i,5) enddo fpar(11) = fpar(11) + n + n c c A * x -- with preconditioning c if (rp) then ipar(1) = 5 ipar(8) = 3*n + 1 if (lp) then ipar(9) = 5*n + 1 else ipar(9) = 9*n + 1 endif ipar(10) = 3 return endif c 40 ipar(1) = 1 if (rp) then ipar(8) = ipar(9) else ipar(8) = 3*n + 1 endif if (lp) then ipar(9) = 9*n + 1 else ipar(9) = 5*n + 1 endif ipar(10) = 4 return c 50 if (lp) then ipar(1) = 3 ipar(8) = ipar(9) ipar(9) = 5*n + 1 ipar(10) = 5 return endif 60 ipar(7) = ipar(7) + 1 do i = 1, n w(i,8) = w(i,6) + alpha * (w(i,7) + alpha * w(i,8)) enddo sigma = distdot(n,w(1,2),1,w(1,8),1) fpar(11) = fpar(11) + 6 * n if (brkdn(sigma,ipar)) goto 900 alpha = rho / sigma do i = 1, n w(i,5) = w(i,4) - alpha * w(i,8) enddo fpar(11) = fpar(11) + 2*n c c the second A * x c if (rp) then ipar(1) = 5 ipar(8) = 4*n + 1 if (lp) then ipar(9) = 6*n + 1 else ipar(9) = 9*n + 1 endif ipar(10) = 6 return endif c 70 ipar(1) = 1 if (rp) then ipar(8) = ipar(9) else ipar(8) = 4*n + 1 endif if (lp) then ipar(9) = 9*n + 1 else ipar(9) = 6*n + 1 endif ipar(10) = 7 return c 80 if (lp) then ipar(1) = 3 ipar(8) = ipar(9) ipar(9) = 6*n + 1 ipar(10) = 8 return endif 90 ipar(7) = ipar(7) + 1 do i = 1, n w(i,3) = w(i,3) - alpha * w(i,6) enddo c c update I c theta = distdot(n,w(1,3),1,w(1,3),1) / (tao*tao) sigma = one / (one + theta) tao = tao * sqrt(sigma * theta) fpar(11) = fpar(11) + 4*n + 6 if (brkdn(tao,ipar)) goto 900 eta = sigma * alpha sigma = te / alpha te = theta * eta do i = 1, n w(i,9) = w(i,4) + sigma * w(i,9) w(i,11) = w(i,11) + eta * w(i,9) w(i,3) = w(i,3) - alpha * w(i,7) enddo fpar(11) = fpar(11) + 6 * n + 6 if (ipar(7).eq.1) then if (ipar(3).eq.-1) then fpar(3) = eta * sqrt(distdot(n,w(1,9),1,w(1,9),1)) fpar(4) = fpar(1)*fpar(3) + fpar(2) fpar(11) = fpar(11) + n + n + 4 endif endif c c update II c theta = distdot(n,w(1,3),1,w(1,3),1) / (tao*tao) sigma = one / (one + theta) tao = tao * sqrt(sigma * theta) fpar(11) = fpar(11) + 8 + 2*n if (brkdn(tao,ipar)) goto 900 eta = sigma * alpha sigma = te / alpha te = theta * eta do i = 1, n w(i,9) = w(i,5) + sigma * w(i,9) w(i,11) = w(i,11) + eta * w(i,9) enddo fpar(11) = fpar(11) + 4*n + 3 c c this is the correct over-estimate c fpar(5) = sqrt(real(ipar(7)+1)) * tao c this is an approximation fpar(5) = tao if (ipar(3).eq.999) then ipar(1) = 10 ipar(8) = 10*n + 1 ipar(9) = 9*n + 1 ipar(10) = 9 return else if (ipar(3).lt.0) then fpar(6) = eta * sqrt(distdot(n,w(1,9),1,w(1,9),1)) fpar(11) = fpar(11) + n + n + 2 else fpar(6) = fpar(5) endif if (fpar(6).gt.fpar(4) .and. (ipar(7).lt.ipar(6) + .or. ipar(6).le.0)) goto 30 100 if (ipar(3).eq.999.and.ipar(11).eq.0) goto 30 c c clean up c 900 if (rp) then if (ipar(1).lt.0) ipar(12) = ipar(1) ipar(1) = 5 ipar(8) = 10*n + 1 ipar(9) = ipar(8) - n ipar(10) = 10 return endif 110 if (rp) then call tidycg(n,ipar,fpar,sol,w(1,10)) else call tidycg(n,ipar,fpar,sol,w(1,11)) endif c return end c-----end-of-tfqmr c----------------------------------------------------------------------- subroutine fom(n, rhs, sol, ipar, fpar, w) implicit none integer n, ipar(16) real*8 rhs(n), sol(n), fpar(16), w(*) c----------------------------------------------------------------------- c This a version of The Full Orthogonalization Method (FOM) c implemented with reverse communication. It is a simple restart c version of the FOM algorithm and is implemented with plane c rotations similarly to GMRES. c c parameters: c ----------- c ipar(5) == the dimension of the Krylov subspace c after every ipar(5) iterations, the FOM will restart with c the updated solution and recomputed residual vector. c c the work space in `w' is used as follows: c (1) the basis for the Krylov subspace, size n*(m+1); c (2) the Hessenberg matrix, only the upper triangular c portion of the matrix is stored, size (m+1)*m/2 + 1 c (3) three vectors, all are of size m, they are c the cosine and sine of the Givens rotations, the third one holds c the residuals, it is of size m+1. c c TOTAL SIZE REQUIRED == (n+3)*(m+2) + (m+1)*m/2 c Note: m == ipar(5). The default value for this is 15 if c ipar(5) <= 1. c----------------------------------------------------------------------- c external functions used c real*8 distdot external distdot c real*8 one, zero parameter(one=1.0D0, zero=0.0D0) c c local variables, ptr and p2 are temporary pointers, c hes points to the Hessenberg matrix, c vc, vs point to the cosines and sines of the Givens rotations c vrn points to the vectors of residual norms, more precisely c the right hand side of the least square problem solved. c integer i,ii,idx,k,m,ptr,p2,prs,hes,vc,vs,vrn real*8 alpha, c, s logical lp, rp save c c check the status of the call c if (ipar(1).le.0) ipar(10) = 0 goto (10, 20, 30, 40, 50, 60, 70) ipar(10) c c initialization c if (ipar(5).le.1) then m = 15 else m = ipar(5) endif idx = n * (m+1) hes = idx + n vc = hes + (m+1) * m / 2 + 1 vs = vc + m vrn = vs + m i = vrn + m + 1 call bisinit(ipar,fpar,i,1,lp,rp,w) if (ipar(1).lt.0) return c c request for matrix vector multiplication A*x in the initialization c 100 ipar(1) = 1 ipar(8) = n+1 ipar(9) = 1 ipar(10) = 1 k = 0 do i = 1, n w(n+i) = sol(i) enddo return 10 ipar(7) = ipar(7) + 1 ipar(13) = ipar(13) + 1 if (lp) then do i = 1, n w(n+i) = rhs(i) - w(i) enddo ipar(1) = 3 ipar(10) = 2 return else do i = 1, n w(i) = rhs(i) - w(i) enddo endif fpar(11) = fpar(11) + n c 20 alpha = sqrt(distdot(n,w,1,w,1)) fpar(11) = fpar(11) + 2*n + 1 if (ipar(7).eq.1 .and. ipar(3).ne.999) then if (abs(ipar(3)).eq.2) then fpar(4) = fpar(1) * sqrt(distdot(n,rhs,1,rhs,1)) + fpar(2) fpar(11) = fpar(11) + 2*n else fpar(4) = fpar(1) * alpha + fpar(2) endif fpar(3) = alpha endif fpar(5) = alpha w(vrn+1) = alpha if (alpha.le.fpar(4) .and. ipar(3).ge.0 .and. ipar(3).ne.999) then ipar(1) = 0 fpar(6) = alpha goto 300 endif alpha = one / alpha do ii = 1, n w(ii) = alpha * w(ii) enddo fpar(11) = fpar(11) + n c c request for (1) right preconditioning c (2) matrix vector multiplication c (3) left preconditioning c 110 k = k + 1 if (rp) then ipar(1) = 5 ipar(8) = k*n - n + 1 if (lp) then ipar(9) = k*n + 1 else ipar(9) = idx + 1 endif ipar(10) = 3 return endif c 30 ipar(1) = 1 if (rp) then ipar(8) = ipar(9) else ipar(8) = (k-1)*n + 1 endif if (lp) then ipar(9) = idx + 1 else ipar(9) = 1 + k*n endif ipar(10) = 4 return c 40 if (lp) then ipar(1) = 3 ipar(8) = ipar(9) ipar(9) = k*n + 1 ipar(10) = 5 return endif c c Modified Gram-Schmidt orthogonalization procedure c temporary pointer 'ptr' is pointing to the current column of the c Hessenberg matrix. 'p2' points to the new basis vector c 50 ipar(7) = ipar(7) + 1 ptr = k * (k - 1) / 2 + hes p2 = ipar(9) call mgsro(.false.,n,n,k+1,k+1,fpar(11),w,w(ptr+1), $ ipar(12)) if (ipar(12).lt.0) goto 200 c c apply previous Givens rotations to column. c p2 = ptr + 1 do i = 1, k-1 ptr = p2 p2 = p2 + 1 alpha = w(ptr) c = w(vc+i) s = w(vs+i) w(ptr) = c * alpha + s * w(p2) w(p2) = c * w(p2) - s * alpha enddo c c end of one Arnoldi iteration, alpha will store the estimated c residual norm at current stage c fpar(11) = fpar(11) + 6*k prs = vrn+k alpha = fpar(5) if (w(p2) .ne. zero) alpha = abs(w(p2+1)*w(prs)/w(p2)) fpar(5) = alpha c if (k.ge.m .or. (ipar(3).ge.0 .and. alpha.le.fpar(4)) + .or. (ipar(6).gt.0 .and. ipar(7).ge.ipar(6))) + goto 200 c call givens(w(p2), w(p2+1), c, s) w(vc+k) = c w(vs+k) = s alpha = - s * w(prs) w(prs) = c * w(prs) w(prs+1) = alpha c if (w(p2).ne.zero) goto 110 c c update the approximate solution, first solve the upper triangular c system, temporary pointer ptr points to the Hessenberg matrix, c prs points to the right-hand-side (also the solution) of the system. c 200 ptr = hes + k * (k + 1) / 2 prs = vrn + k if (w(ptr).eq.zero) then c c if the diagonal elements of the last column is zero, reduce k by 1 c so that a smaller trianguler system is solved c k = k - 1 if (k.gt.0) then goto 200 else ipar(1) = -3 ipar(12) = -4 goto 300 endif endif w(prs) = w(prs) / w(ptr) do i = k-1, 1, -1 ptr = ptr - i - 1 do ii = 1, i w(vrn+ii) = w(vrn+ii) - w(prs) * w(ptr+ii) enddo prs = prs - 1 w(prs) = w(prs) / w(ptr) enddo c do ii = 1, n w(ii) = w(ii) * w(prs) enddo do i = 1, k-1 prs = prs + 1 ptr = i*n do ii = 1, n w(ii) = w(ii) + w(prs) * w(ptr+ii) enddo enddo fpar(11) = fpar(11) + 2*(k-1)*n + n + k*(k+1) c if (rp) then ipar(1) = 5 ipar(8) = 1 ipar(9) = idx + 1 ipar(10) = 6 return endif c 60 if (rp) then do i = 1, n sol(i) = sol(i) + w(idx+i) enddo else do i = 1, n sol(i) = sol(i) + w(i) enddo endif fpar(11) = fpar(11) + n c c process the complete stopping criteria c if (ipar(3).eq.999) then ipar(1) = 10 ipar(8) = -1 ipar(9) = idx + 1 ipar(10) = 7 return else if (ipar(3).lt.0) then if (ipar(7).le.m+1) then fpar(3) = abs(w(vrn+1)) if (ipar(3).eq.-1) fpar(4) = fpar(1)*fpar(3)+fpar(2) endif alpha = abs(w(vrn+k)) endif fpar(6) = alpha c c do we need to restart ? c 70 if (ipar(12).ne.0) then ipar(1) = -3 goto 300 endif if (ipar(7).lt.ipar(6) .or. ipar(6).le.0) then if (ipar(3).ne.999) then if (fpar(6).gt.fpar(4)) goto 100 else if (ipar(11).eq.0) goto 100 endif endif c c termination, set error code, compute convergence rate c if (ipar(1).gt.0) then if (ipar(3).eq.999 .and. ipar(11).eq.1) then ipar(1) = 0 else if (ipar(3).ne.999 .and. fpar(6).le.fpar(4)) then ipar(1) = 0 else if (ipar(7).ge.ipar(6) .and. ipar(6).gt.0) then ipar(1) = -1 else ipar(1) = -10 endif endif 300 if (fpar(3).ne.zero .and. fpar(6).ne.zero .and. + ipar(7).gt.ipar(13)) then fpar(7) = log10(fpar(3) / fpar(6)) / dble(ipar(7)-ipar(13)) else fpar(7) = zero endif return end c-----end-of-fom-------------------------------------------------------- c----------------------------------------------------------------------- subroutine gmres(n, rhs, sol, ipar, fpar, w) implicit none integer n, ipar(16) real*8 rhs(n), sol(n), fpar(16), w(*) c----------------------------------------------------------------------- c This a version of GMRES implemented with reverse communication. c It is a simple restart version of the GMRES algorithm. c c ipar(5) == the dimension of the Krylov subspace c after every ipar(5) iterations, the GMRES will restart with c the updated solution and recomputed residual vector. c c the space of the `w' is used as follows: c (1) the basis for the Krylov subspace, size n*(m+1); c (2) the Hessenberg matrix, only the upper triangular c portion of the matrix is stored, size (m+1)*m/2 + 1 c (3) three vectors, all are of size m, they are c the cosine and sine of the Givens rotations, the third one holds c the residuals, it is of size m+1. c c TOTAL SIZE REQUIRED == (n+3)*(m+2) + (m+1)*m/2 c Note: m == ipar(5). The default value for this is 15 if c ipar(5) <= 1. c----------------------------------------------------------------------- c external functions used c real*8 distdot external distdot c real*8 one, zero parameter(one=1.0D0, zero=0.0D0) c c local variables, ptr and p2 are temporary pointers, c hess points to the Hessenberg matrix, c vc, vs point to the cosines and sines of the Givens rotations c vrn points to the vectors of residual norms, more precisely c the right hand side of the least square problem solved. c integer i,ii,idx,k,m,ptr,p2,hess,vc,vs,vrn real*8 alpha, c, s logical lp, rp save c c check the status of the call c if (ipar(1).le.0) ipar(10) = 0 goto (10, 20, 30, 40, 50, 60, 70) ipar(10) c c initialization c if (ipar(5).le.1) then m = 15 else m = ipar(5) endif idx = n * (m+1) hess = idx + n vc = hess + (m+1) * m / 2 + 1 vs = vc + m vrn = vs + m i = vrn + m + 1 call bisinit(ipar,fpar,i,1,lp,rp,w) if (ipar(1).lt.0) return c c request for matrix vector multiplication A*x in the initialization c 100 ipar(1) = 1 ipar(8) = n+1 ipar(9) = 1 ipar(10) = 1 k = 0 do i = 1, n w(n+i) = sol(i) enddo return 10 ipar(7) = ipar(7) + 1 ipar(13) = ipar(13) + 1 if (lp) then do i = 1, n w(n+i) = rhs(i) - w(i) enddo ipar(1) = 3 ipar(10) = 2 return else do i = 1, n w(i) = rhs(i) - w(i) enddo endif fpar(11) = fpar(11) + n c 20 alpha = sqrt(distdot(n,w,1,w,1)) fpar(11) = fpar(11) + 2*n if (ipar(7).eq.1 .and. ipar(3).ne.999) then if (abs(ipar(3)).eq.2) then fpar(4) = fpar(1) * sqrt(distdot(n,rhs,1,rhs,1)) + fpar(2) fpar(11) = fpar(11) + 2*n else fpar(4) = fpar(1) * alpha + fpar(2) endif fpar(3) = alpha endif fpar(5) = alpha w(vrn+1) = alpha if (alpha.le.fpar(4) .and. ipar(3).ge.0 .and. ipar(3).ne.999) then ipar(1) = 0 fpar(6) = alpha goto 300 endif alpha = one / alpha do ii = 1, n w(ii) = alpha * w(ii) enddo fpar(11) = fpar(11) + n c c request for (1) right preconditioning c (2) matrix vector multiplication c (3) left preconditioning c 110 k = k + 1 if (rp) then ipar(1) = 5 ipar(8) = k*n - n + 1 if (lp) then ipar(9) = k*n + 1 else ipar(9) = idx + 1 endif ipar(10) = 3 return endif c 30 ipar(1) = 1 if (rp) then ipar(8) = ipar(9) else ipar(8) = (k-1)*n + 1 endif if (lp) then ipar(9) = idx + 1 else ipar(9) = 1 + k*n endif ipar(10) = 4 return c 40 if (lp) then ipar(1) = 3 ipar(8) = ipar(9) ipar(9) = k*n + 1 ipar(10) = 5 return endif c c Modified Gram-Schmidt orthogonalization procedure c temporary pointer 'ptr' is pointing to the current column of the c Hessenberg matrix. 'p2' points to the new basis vector c 50 ipar(7) = ipar(7) + 1 ptr = k * (k - 1) / 2 + hess p2 = ipar(9) call mgsro(.false.,n,n,k+1,k+1,fpar(11),w,w(ptr+1), $ ipar(12)) if (ipar(12).lt.0) goto 200 c c apply previous Givens rotations and generate a new one to eliminate c the subdiagonal element. c p2 = ptr + 1 do i = 1, k-1 ptr = p2 p2 = p2 + 1 alpha = w(ptr) c = w(vc+i) s = w(vs+i) w(ptr) = c * alpha + s * w(p2) w(p2) = c * w(p2) - s * alpha enddo call givens(w(p2), w(p2+1), c, s) w(vc+k) = c w(vs+k) = s p2 = vrn + k alpha = - s * w(p2) w(p2) = c * w(p2) w(p2+1) = alpha c c end of one Arnoldi iteration, alpha will store the estimated c residual norm at current stage c fpar(11) = fpar(11) + 6*k + 2 alpha = abs(alpha) fpar(5) = alpha if (k.lt.m .and. .not.(ipar(3).ge.0 .and. alpha.le.fpar(4)) + .and. (ipar(6).le.0 .or. ipar(7).lt.ipar(6))) goto 110 c c update the approximate solution, first solve the upper triangular c system, temporary pointer ptr points to the Hessenberg matrix, c p2 points to the right-hand-side (also the solution) of the system. c 200 ptr = hess + k * (k + 1) / 2 p2 = vrn + k if (w(ptr).eq.zero) then c c if the diagonal elements of the last column is zero, reduce k by 1 c so that a smaller trianguler system is solved [It should only c happen when the matrix is singular, and at most once!] c k = k - 1 if (k.gt.0) then goto 200 else ipar(1) = -3 ipar(12) = -4 goto 300 endif endif w(p2) = w(p2) / w(ptr) do i = k-1, 1, -1 ptr = ptr - i - 1 do ii = 1, i w(vrn+ii) = w(vrn+ii) - w(p2) * w(ptr+ii) enddo p2 = p2 - 1 w(p2) = w(p2) / w(ptr) enddo c do ii = 1, n w(ii) = w(ii) * w(p2) enddo do i = 1, k-1 ptr = i*n p2 = p2 + 1 do ii = 1, n w(ii) = w(ii) + w(p2) * w(ptr+ii) enddo enddo fpar(11) = fpar(11) + 2*k*n - n + k*(k+1) c if (rp) then ipar(1) = 5 ipar(8) = 1 ipar(9) = idx + 1 ipar(10) = 6 return endif c 60 if (rp) then do i = 1, n sol(i) = sol(i) + w(idx+i) enddo else do i = 1, n sol(i) = sol(i) + w(i) enddo endif fpar(11) = fpar(11) + n c c process the complete stopping criteria c if (ipar(3).eq.999) then ipar(1) = 10 ipar(8) = -1 ipar(9) = idx + 1 ipar(10) = 7 return else if (ipar(3).lt.0) then if (ipar(7).le.m+1) then fpar(3) = abs(w(vrn+1)) if (ipar(3).eq.-1) fpar(4) = fpar(1)*fpar(3)+fpar(2) endif fpar(6) = abs(w(vrn+k)) else fpar(6) = fpar(5) endif c c do we need to restart ? c 70 if (ipar(12).ne.0) then ipar(1) = -3 goto 300 endif if ((ipar(7).lt.ipar(6) .or. ipar(6).le.0) .and. + ((ipar(3).eq.999.and.ipar(11).eq.0) .or. + (ipar(3).ne.999.and.fpar(6).gt.fpar(4)))) goto 100 c c termination, set error code, compute convergence rate c if (ipar(1).gt.0) then if (ipar(3).eq.999 .and. ipar(11).eq.1) then ipar(1) = 0 else if (ipar(3).ne.999 .and. fpar(6).le.fpar(4)) then ipar(1) = 0 else if (ipar(7).ge.ipar(6) .and. ipar(6).gt.0) then ipar(1) = -1 else ipar(1) = -10 endif endif 300 if (fpar(3).ne.zero .and. fpar(6).ne.zero .and. + ipar(7).gt.ipar(13)) then fpar(7) = log10(fpar(3) / fpar(6)) / dble(ipar(7)-ipar(13)) else fpar(7) = zero endif return end c-----end-of-gmres c----------------------------------------------------------------------- subroutine dqgmres(n, rhs, sol, ipar, fpar, w) implicit none integer n, ipar(16) real*8 rhs(n), sol(n), fpar(16), w(*) c----------------------------------------------------------------------- c DQGMRES -- Flexible Direct version of Quasi-General Minimum c Residual method. The right preconditioning can be varied from c step to step. c c Work space used = n + lb * (2*n+4) c where lb = ipar(5) + 1 (default 16 if ipar(5) <= 1) c----------------------------------------------------------------------- c local variables c real*8 one,zero,deps parameter(one=1.0D0,zero=0.0D0) parameter(deps=1.0D-33) c integer i,ii,j,jp1,j0,k,ptrw,ptrv,iv,iw,ic,is,ihm,ihd,lb,ptr real*8 alpha,beta,psi,c,s,distdot logical lp,rp,full external distdot,bisinit save c c where to go c if (ipar(1).le.0) ipar(10) = 0 goto (10, 20, 40, 50, 60, 70) ipar(10) c c locations of the work arrays. The arrangement is as follows: c w(1:n) -- temporary storage for the results of the preconditioning c w(iv+1:iw) -- the V's c w(iw+1:ic) -- the W's c w(ic+1:is) -- the COSINEs of the Givens rotations c w(is+1:ihm) -- the SINEs of the Givens rotations c w(ihm+1:ihd) -- the last column of the Hessenberg matrix c w(ihd+1:i) -- the inverse of the diagonals of the Hessenberg matrix c if (ipar(5).le.1) then lb = 16 else lb = ipar(5) + 1 endif iv = n iw = iv + lb * n ic = iw + lb * n is = ic + lb ihm = is + lb ihd = ihm + lb i = ihd + lb c c parameter check, initializations c full = .false. call bisinit(ipar,fpar,i,1,lp,rp,w) if (ipar(1).lt.0) return ipar(1) = 1 if (lp) then do ii = 1, n w(iv+ii) = sol(ii) enddo ipar(8) = iv+1 ipar(9) = 1 else do ii = 1, n w(ii) = sol(ii) enddo ipar(8) = 1 ipar(9) = iv+1 endif ipar(10) = 1 return c 10 ipar(7) = ipar(7) + 1 ipar(13) = ipar(13) + 1 if (lp) then do i = 1, n w(i) = rhs(i) - w(i) enddo ipar(1) = 3 ipar(8) = 1 ipar(9) = iv+1 ipar(10) = 2 return else do i = 1, n w(iv+i) = rhs(i) - w(iv+i) enddo endif fpar(11) = fpar(11) + n c 20 alpha = sqrt(distdot(n, w(iv+1), 1, w(iv+1), 1)) fpar(11) = fpar(11) + (n + n) if (abs(ipar(3)).eq.2) then fpar(4) = fpar(1) * sqrt(distdot(n,rhs,1,rhs,1)) + fpar(2) fpar(11) = fpar(11) + 2*n else if (ipar(3).ne.999) then fpar(4) = fpar(1) * alpha + fpar(2) endif fpar(3) = alpha fpar(5) = alpha psi = alpha if (alpha.le.fpar(4)) then ipar(1) = 0 fpar(6) = alpha goto 80 endif alpha = one / alpha do i = 1, n w(iv+i) = w(iv+i) * alpha enddo fpar(11) = fpar(11) + n j = 0 c c iterations start here c 30 j = j + 1 if (j.gt.lb) j = j - lb jp1 = j + 1 if (jp1.gt.lb) jp1 = jp1 - lb ptrv = iv + (j-1)*n + 1 ptrw = iv + (jp1-1)*n + 1 if (.not.full) then if (j.gt.jp1) full = .true. endif if (full) then j0 = jp1+1 if (j0.gt.lb) j0 = j0 - lb else j0 = 1 endif c c request the caller to perform matrix-vector multiplication and c preconditioning c if (rp) then ipar(1) = 5 ipar(8) = ptrv ipar(9) = ptrv + iw - iv ipar(10) = 3 return else do i = 0, n-1 w(ptrv+iw-iv+i) = w(ptrv+i) enddo endif c 40 ipar(1) = 1 if (rp) then ipar(8) = ipar(9) else ipar(8) = ptrv endif if (lp) then ipar(9) = 1 else ipar(9) = ptrw endif ipar(10) = 4 return c 50 if (lp) then ipar(1) = 3 ipar(8) = ipar(9) ipar(9) = ptrw ipar(10) = 5 return endif c c compute the last column of the Hessenberg matrix c modified Gram-schmidt procedure, orthogonalize against (lb-1) c previous vectors c 60 continue call mgsro(full,n,n,lb,jp1,fpar(11),w(iv+1),w(ihm+1), $ ipar(12)) if (ipar(12).lt.0) then ipar(1) = -3 goto 80 endif beta = w(ihm+jp1) c c incomplete factorization (QR factorization through Givens rotations) c (1) apply previous rotations [(lb-1) of them] c (2) generate a new rotation c if (full) then w(ihm+jp1) = w(ihm+j0) * w(is+jp1) w(ihm+j0) = w(ihm+j0) * w(ic+jp1) endif i = j0 do while (i.ne.j) k = i+1 if (k.gt.lb) k = k - lb c = w(ic+i) s = w(is+i) alpha = w(ihm+i) w(ihm+i) = c * alpha + s * w(ihm+k) w(ihm+k) = c * w(ihm+k) - s * alpha i = k enddo call givens(w(ihm+j), beta, c, s) if (full) then fpar(11) = fpar(11) + 6 * lb else fpar(11) = fpar(11) + 6 * j endif c c detect whether diagonal element of this column is zero c if (abs(w(ihm+j)).lt.deps) then ipar(1) = -3 goto 80 endif w(ihd+j) = one / w(ihm+j) w(ic+j) = c w(is+j) = s c c update the W's (the conjugate directions) -- essentially this is one c step of triangular solve. c ptrw = iw+(j-1)*n + 1 if (full) then do i = j+1, lb alpha = -w(ihm+i)*w(ihd+i) ptr = iw+(i-1)*n+1 do ii = 0, n-1 w(ptrw+ii) = w(ptrw+ii) + alpha * w(ptr+ii) enddo enddo endif do i = 1, j-1 alpha = -w(ihm+i)*w(ihd+i) ptr = iw+(i-1)*n+1 do ii = 0, n-1 w(ptrw+ii) = w(ptrw+ii) + alpha * w(ptr+ii) enddo enddo c c update the solution to the linear system c alpha = psi * c * w(ihd+j) psi = - s * psi do i = 1, n sol(i) = sol(i) + alpha * w(ptrw-1+i) enddo if (full) then fpar(11) = fpar(11) + lb * (n+n) else fpar(11) = fpar(11) + j * (n+n) endif c c determine whether to continue, c compute the desired error/residual norm c ipar(7) = ipar(7) + 1 fpar(5) = abs(psi) if (ipar(3).eq.999) then ipar(1) = 10 ipar(8) = -1 ipar(9) = 1 ipar(10) = 6 return endif if (ipar(3).lt.0) then alpha = abs(alpha) if (ipar(7).eq.2 .and. ipar(3).eq.-1) then fpar(3) = alpha*sqrt(distdot(n, w(ptrw), 1, w(ptrw), 1)) fpar(4) = fpar(1) * fpar(3) + fpar(2) fpar(6) = fpar(3) else fpar(6) = alpha*sqrt(distdot(n, w(ptrw), 1, w(ptrw), 1)) endif fpar(11) = fpar(11) + 2 * n else fpar(6) = fpar(5) endif if (ipar(1).ge.0 .and. fpar(6).gt.fpar(4) .and. (ipar(6).le.0 + .or. ipar(7).lt.ipar(6))) goto 30 70 if (ipar(3).eq.999 .and. ipar(11).eq.0) goto 30 c c clean up the iterative solver c 80 fpar(7) = zero if (fpar(3).ne.zero .and. fpar(6).ne.zero .and. + ipar(7).gt.ipar(13)) + fpar(7) = log10(fpar(3) / fpar(6)) / dble(ipar(7)-ipar(13)) if (ipar(1).gt.0) then if (ipar(3).eq.999 .and. ipar(11).ne.0) then ipar(1) = 0 else if (fpar(6).le.fpar(4)) then ipar(1) = 0 else if (ipar(6).gt.0 .and. ipar(7).ge.ipar(6)) then ipar(1) = -1 else ipar(1) = -10 endif endif return end c-----end-of-dqgmres c----------------------------------------------------------------------- subroutine fgmres(n, rhs, sol, ipar, fpar, w) implicit none integer n, ipar(16) real*8 rhs(n), sol(n), fpar(16), w(*) c----------------------------------------------------------------------- c This a version of FGMRES implemented with reverse communication. c c ipar(5) == the dimension of the Krylov subspace c c the space of the `w' is used as follows: c >> V: the bases for the Krylov subspace, size n*(m+1); c >> W: the above bases after (left-)multiplying with the c right-preconditioner inverse, size m*n; c >> a temporary vector of size n; c >> the Hessenberg matrix, only the upper triangular portion c of the matrix is stored, size (m+1)*m/2 + 1 c >> three vectors, first two are of size m, they are the cosine c and sine of the Givens rotations, the third one holds the c residuals, it is of size m+1. c c TOTAL SIZE REQUIRED == n*(2m+1) + (m+1)*m/2 + 3*m + 2 c Note: m == ipar(5). The default value for this is 15 if c ipar(5) <= 1. c----------------------------------------------------------------------- c external functions used c real*8 distdot external distdot c real*8 one, zero parameter(one=1.0D0, zero=0.0D0) c c local variables, ptr and p2 are temporary pointers, c hess points to the Hessenberg matrix, c vc, vs point to the cosines and sines of the Givens rotations c vrn points to the vectors of residual norms, more precisely c the right hand side of the least square problem solved. c integer i,ii,idx,iz,k,m,ptr,p2,hess,vc,vs,vrn real*8 alpha, c, s logical lp, rp save c c check the status of the call c if (ipar(1).le.0) ipar(10) = 0 goto (10, 20, 30, 40, 50, 60) ipar(10) c c initialization c if (ipar(5).le.1) then m = 15 else m = ipar(5) endif idx = n * (m+1) iz = idx + n hess = iz + n*m vc = hess + (m+1) * m / 2 + 1 vs = vc + m vrn = vs + m i = vrn + m + 1 call bisinit(ipar,fpar,i,1,lp,rp,w) if (ipar(1).lt.0) return c c request for matrix vector multiplication A*x in the initialization c 100 ipar(1) = 1 ipar(8) = n+1 ipar(9) = 1 ipar(10) = 1 k = 0 do ii = 1, n w(ii+n) = sol(ii) enddo return 10 ipar(7) = ipar(7) + 1 ipar(13) = ipar(13) + 1 fpar(11) = fpar(11) + n if (lp) then do i = 1, n w(n+i) = rhs(i) - w(i) enddo ipar(1) = 3 ipar(10) = 2 return else do i = 1, n w(i) = rhs(i) - w(i) enddo endif c 20 alpha = sqrt(distdot(n,w,1,w,1)) fpar(11) = fpar(11) + n + n if (ipar(7).eq.1 .and. ipar(3).ne.999) then if (abs(ipar(3)).eq.2) then fpar(4) = fpar(1) * sqrt(distdot(n,rhs,1,rhs,1)) + fpar(2) fpar(11) = fpar(11) + 2*n else fpar(4) = fpar(1) * alpha + fpar(2) endif fpar(3) = alpha endif fpar(5) = alpha w(vrn+1) = alpha if (alpha.le.fpar(4) .and. ipar(3).ge.0 .and. ipar(3).ne.999) then ipar(1) = 0 fpar(6) = alpha goto 300 endif alpha = one / alpha do ii = 1, n w(ii) = w(ii) * alpha enddo fpar(11) = fpar(11) + n c c request for (1) right preconditioning c (2) matrix vector multiplication c (3) left preconditioning c 110 k = k + 1 if (rp) then ipar(1) = 5 ipar(8) = k*n - n + 1 ipar(9) = iz + ipar(8) ipar(10) = 3 return else do ii = 0, n-1 w(iz+k*n-ii) = w(k*n-ii) enddo endif c 30 ipar(1) = 1 if (rp) then ipar(8) = ipar(9) else ipar(8) = (k-1)*n + 1 endif if (lp) then ipar(9) = idx + 1 else ipar(9) = 1 + k*n endif ipar(10) = 4 return c 40 if (lp) then ipar(1) = 3 ipar(8) = ipar(9) ipar(9) = k*n + 1 ipar(10) = 5 return endif c c Modified Gram-Schmidt orthogonalization procedure c temporary pointer 'ptr' is pointing to the current column of the c Hessenberg matrix. 'p2' points to the new basis vector c 50 ptr = k * (k - 1) / 2 + hess p2 = ipar(9) ipar(7) = ipar(7) + 1 call mgsro(.false.,n,n,k+1,k+1,fpar(11),w,w(ptr+1), $ ipar(12)) if (ipar(12).lt.0) goto 200 c c apply previous Givens rotations and generate a new one to eliminate c the subdiagonal element. c p2 = ptr + 1 do i = 1, k-1 ptr = p2 p2 = p2 + 1 alpha = w(ptr) c = w(vc+i) s = w(vs+i) w(ptr) = c * alpha + s * w(p2) w(p2) = c * w(p2) - s * alpha enddo call givens(w(p2), w(p2+1), c, s) w(vc+k) = c w(vs+k) = s p2 = vrn + k alpha = - s * w(p2) w(p2) = c * w(p2) w(p2+1) = alpha fpar(11) = fpar(11) + 6 * k c c end of one Arnoldi iteration, alpha will store the estimated c residual norm at current stage c alpha = abs(alpha) fpar(5) = alpha if (k.lt.m .and. .not.(ipar(3).ge.0 .and. alpha.le.fpar(4)) + .and. (ipar(6).le.0 .or. ipar(7).lt.ipar(6))) goto 110 c c update the approximate solution, first solve the upper triangular c system, temporary pointer ptr points to the Hessenberg matrix, c p2 points to the right-hand-side (also the solution) of the system. c 200 ptr = hess + k * (k + 1 ) / 2 p2 = vrn + k if (w(ptr).eq.zero) then c c if the diagonal elements of the last column is zero, reduce k by 1 c so that a smaller trianguler system is solved [It should only c happen when the matrix is singular!] c k = k - 1 if (k.gt.0) then goto 200 else ipar(1) = -3 ipar(12) = -4 goto 300 endif endif w(p2) = w(p2) / w(ptr) do i = k-1, 1, -1 ptr = ptr - i - 1 do ii = 1, i w(vrn+ii) = w(vrn+ii) - w(p2) * w(ptr+ii) enddo p2 = p2 - 1 w(p2) = w(p2) / w(ptr) enddo c do i = 0, k-1 ptr = iz+i*n do ii = 1, n sol(ii) = sol(ii) + w(p2)*w(ptr+ii) enddo p2 = p2 + 1 enddo fpar(11) = fpar(11) + 2*k*n + k*(k+1) c c process the complete stopping criteria c if (ipar(3).eq.999) then ipar(1) = 10 ipar(8) = -1 ipar(9) = idx + 1 ipar(10) = 6 return else if (ipar(3).lt.0) then if (ipar(7).le.m+1) then fpar(3) = abs(w(vrn+1)) if (ipar(3).eq.-1) fpar(4) = fpar(1)*fpar(3)+fpar(2) endif fpar(6) = abs(w(vrn+k)) else if (ipar(3).ne.999) then fpar(6) = fpar(5) endif c c do we need to restart ? c 60 if (ipar(12).ne.0) then ipar(1) = -3 goto 300 endif if ((ipar(7).lt.ipar(6) .or. ipar(6).le.0).and. + ((ipar(3).eq.999.and.ipar(11).eq.0) .or. + (ipar(3).ne.999.and.fpar(6).gt.fpar(4)))) goto 100 c c termination, set error code, compute convergence rate c if (ipar(1).gt.0) then if (ipar(3).eq.999 .and. ipar(11).eq.1) then ipar(1) = 0 else if (ipar(3).ne.999 .and. fpar(6).le.fpar(4)) then ipar(1) = 0 else if (ipar(7).ge.ipar(6) .and. ipar(6).gt.0) then ipar(1) = -1 else ipar(1) = -10 endif endif 300 if (fpar(3).ne.zero .and. fpar(6).ne.zero .and. $ ipar(7).gt.ipar(13)) then fpar(7) = log10(fpar(3) / fpar(6)) / dble(ipar(7)-ipar(13)) else fpar(7) = zero endif return end c-----end-of-fgmres c----------------------------------------------------------------------- subroutine dbcg (n,rhs,sol,ipar,fpar,w) implicit none integer n,ipar(16) real*8 rhs(n), sol(n), fpar(16), w(n,*) c----------------------------------------------------------------------- c Quasi GMRES method for solving a linear c system of equations a * sol = y. double precision version. c this version is without restarting and without preconditioning. c parameters : c ----------- c n = dimension of the problem c c y = w(:,1) a temporary storage used for various operations c z = w(:,2) a work vector of length n. c v = w(:,3:4) size n x 2 c w = w(:,5:6) size n x 2 c p = w(:,7:9) work array of dimension n x 3 c del x = w(:,10) accumulation of the changes in solution c tmp = w(:,11) a temporary vector used to hold intermediate result of c preconditioning, etc. c c sol = the solution of the problem . at input sol must contain an c initial guess to the solution. c *** note: y is destroyed on return. c c----------------------------------------------------------------------- c subroutines and functions called: c 1) matrix vector multiplication and preconditioning through reverse c communication c c 2) implu, uppdir, distdot (blas) c----------------------------------------------------------------------- c aug. 1983 version. author youcef saad. yale university computer c science dept. some changes made july 3, 1986. c references: siam j. sci. stat. comp., vol. 5, pp. 203-228 (1984) c----------------------------------------------------------------------- c local variables c real*8 one,zero parameter(one=1.0D0,zero=0.0D0) c real*8 t,sqrt,distdot,ss,res,beta,ss1,delta,x,zeta,umm integer k,j,i,i2,ip2,ju,lb,lbm1,np,indp logical lp,rp,full, perm(3) real*8 ypiv(3),u(3),usav(3) external tidycg save c c where to go c if (ipar(1).le.0) ipar(10) = 0 goto (110, 120, 130, 140, 150, 160, 170, 180, 190, 200) ipar(10) c c initialization, parameter checking, clear the work arrays c call bisinit(ipar,fpar,11*n,1,lp,rp,w) if (ipar(1).lt.0) return perm(1) = .false. perm(2) = .false. perm(3) = .false. usav(1) = zero usav(2) = zero usav(3) = zero ypiv(1) = zero ypiv(2) = zero ypiv(3) = zero c----------------------------------------------------------------------- c initialize constants for outer loop : c----------------------------------------------------------------------- lb = 3 lbm1 = 2 c c get initial residual vector and norm c ipar(1) = 1 ipar(8) = 1 ipar(9) = 1 + n do i = 1, n w(i,1) = sol(i) enddo ipar(10) = 1 return 110 ipar(7) = ipar(7) + 1 ipar(13) = ipar(13) + 1 if (lp) then do i = 1, n w(i,1) = rhs(i) - w(i,2) enddo ipar(1) = 3 ipar(8) = 1 ipar(9) = n+n+1 ipar(10) = 2 return else do i = 1, n w(i,3) = rhs(i) - w(i,2) enddo endif fpar(11) = fpar(11) + n c 120 fpar(3) = sqrt(distdot(n,w(1,3),1,w(1,3),1)) fpar(11) = fpar(11) + n + n fpar(5) = fpar(3) fpar(7) = fpar(3) zeta = fpar(3) if (abs(ipar(3)).eq.2) then fpar(4) = fpar(1) * sqrt(distdot(n,rhs,1,rhs,1)) + fpar(2) fpar(11) = fpar(11) + 2*n else if (ipar(3).ne.999) then fpar(4) = fpar(1) * zeta + fpar(2) endif if (ipar(3).ge.0.and.fpar(5).le.fpar(4)) then fpar(6) = fpar(5) goto 900 endif c c normalize first arnoldi vector c t = one/zeta do 22 k=1,n w(k,3) = w(k,3)*t w(k,5) = w(k,3) 22 continue fpar(11) = fpar(11) + n c c initialize constants for main loop c beta = zero delta = zero i2 = 1 indp = 0 i = 0 c c main loop: i = index of the loop. c c----------------------------------------------------------------------- 30 i = i + 1 c if (rp) then ipar(1) = 5 ipar(8) = (1+i2)*n+1 if (lp) then ipar(9) = 1 else ipar(9) = 10*n + 1 endif ipar(10) = 3 return endif c 130 ipar(1) = 1 if (rp) then ipar(8) = ipar(9) else ipar(8) = (1+i2)*n + 1 endif if (lp) then ipar(9) = 10*n + 1 else ipar(9) = 1 endif ipar(10) = 4 return c 140 if (lp) then ipar(1) = 3 ipar(8) = ipar(9) ipar(9) = 1 ipar(10) = 5 return endif c c A^t * x c 150 ipar(7) = ipar(7) + 1 if (lp) then ipar(1) = 4 ipar(8) = (3+i2)*n + 1 if (rp) then ipar(9) = n + 1 else ipar(9) = 10*n + 1 endif ipar(10) = 6 return endif c 160 ipar(1) = 2 if (lp) then ipar(8) = ipar(9) else ipar(8) = (3+i2)*n + 1 endif if (rp) then ipar(9) = 10*n + 1 else ipar(9) = n + 1 endif ipar(10) = 7 return c 170 if (rp) then ipar(1) = 6 ipar(8) = ipar(9) ipar(9) = n + 1 ipar(10) = 8 return endif c----------------------------------------------------------------------- c orthogonalize current v against previous v's and c determine relevant part of i-th column of u(.,.) the c upper triangular matrix -- c----------------------------------------------------------------------- 180 ipar(7) = ipar(7) + 1 u(1) = zero ju = 1 k = i2 if (i .le. lbm1) ju = 0 if (i .lt. lb) k = 0 31 if (k .eq. lbm1) k=0 k=k+1 c if (k .ne. i2) then ss = delta ss1 = beta ju = ju + 1 u(ju) = ss else ss = distdot(n,w(1,1),1,w(1,4+k),1) fpar(11) = fpar(11) + 2*n ss1= ss ju = ju + 1 u(ju) = ss endif c do 32 j=1,n w(j,1) = w(j,1) - ss*w(j,k+2) w(j,2) = w(j,2) - ss1*w(j,k+4) 32 continue fpar(11) = fpar(11) + 4*n c if (k .ne. i2) goto 31 c c end of Mod. Gram. Schmidt loop c t = distdot(n,w(1,2),1,w(1,1),1) c beta = sqrt(abs(t)) delta = t/beta c ss = one/beta ss1 = one/ delta c c normalize and insert new vectors c ip2 = i2 if (i2 .eq. lbm1) i2=0 i2=i2+1 c do 315 j=1,n w(j,i2+2)=w(j,1)*ss w(j,i2+4)=w(j,2)*ss1 315 continue fpar(11) = fpar(11) + 4*n c----------------------------------------------------------------------- c end of orthogonalization. c now compute the coefficients u(k) of the last c column of the l . u factorization of h . c----------------------------------------------------------------------- np = min0(i,lb) full = (i .ge. lb) call implu(np, umm, beta, ypiv, u, perm, full) c----------------------------------------------------------------------- c update conjugate directions and solution c----------------------------------------------------------------------- do 33 k=1,n w(k,1) = w(k,ip2+2) 33 continue call uppdir(n, w(1,7), np, lb, indp, w, u, usav, fpar(11)) c----------------------------------------------------------------------- if (i .eq. 1) goto 34 j = np - 1 if (full) j = j-1 if (.not.perm(j)) zeta = -zeta*ypiv(j) 34 x = zeta/u(np) if (perm(np))goto 36 do 35 k=1,n w(k,10) = w(k,10) + x*w(k,1) 35 continue fpar(11) = fpar(11) + 2 * n c----------------------------------------------------------------------- 36 if (ipar(3).eq.999) then ipar(1) = 10 ipar(8) = 9*n + 1 ipar(9) = 10*n + 1 ipar(10) = 9 return endif res = abs(beta*zeta/umm) fpar(5) = res * sqrt(distdot(n, w(1,i2+2), 1, w(1,i2+2), 1)) fpar(11) = fpar(11) + 2 * n if (ipar(3).lt.0) then fpar(6) = x * sqrt(distdot(n,w,1,w,1)) fpar(11) = fpar(11) + 2 * n if (ipar(7).le.3) then fpar(3) = fpar(6) if (ipar(3).eq.-1) then fpar(4) = fpar(1) * sqrt(fpar(3)) + fpar(2) endif endif else fpar(6) = fpar(5) endif c---- convergence test ----------------------------------------------- 190 if (ipar(3).eq.999.and.ipar(11).eq.0) then goto 30 else if (fpar(6).gt.fpar(4) .and. (ipar(6).gt.ipar(7) .or. + ipar(6).le.0)) then goto 30 endif c----------------------------------------------------------------------- c here the fact that the last step is different is accounted for. c----------------------------------------------------------------------- if (.not. perm(np)) goto 900 x = zeta/umm do 40 k = 1,n w(k,10) = w(k,10) + x*w(k,1) 40 continue fpar(11) = fpar(11) + 2 * n c c right preconditioning and clean-up jobs c 900 if (rp) then if (ipar(1).lt.0) ipar(12) = ipar(1) ipar(1) = 5 ipar(8) = 9*n + 1 ipar(9) = ipar(8) + n ipar(10) = 10 return endif 200 if (rp) then call tidycg(n,ipar,fpar,sol,w(1,11)) else call tidycg(n,ipar,fpar,sol,w(1,10)) endif return end c-----end-of-dbcg------------------------------------------------------- c----------------------------------------------------------------------- subroutine implu(np,umm,beta,ypiv,u,permut,full) real*8 umm,beta,ypiv(*),u(*),x, xpiv logical full, perm, permut(*) integer np,k,npm1 c----------------------------------------------------------------------- c performs implicitly one step of the lu factorization of a c banded hessenberg matrix. c----------------------------------------------------------------------- if (np .le. 1) goto 12 npm1 = np - 1 c c -- perform previous step of the factorization- c do 6 k=1,npm1 if (.not. permut(k)) goto 5 x=u(k) u(k) = u(k+1) u(k+1) = x 5 u(k+1) = u(k+1) - ypiv(k)*u(k) 6 continue c----------------------------------------------------------------------- c now determine pivotal information to be used in the next call c----------------------------------------------------------------------- 12 umm = u(np) perm = (beta .gt. abs(umm)) if (.not. perm) goto 4 xpiv = umm / beta u(np) = beta goto 8 4 xpiv = beta/umm 8 permut(np) = perm ypiv(np) = xpiv if (.not. full) return c shift everything up if full... do 7 k=1,npm1 ypiv(k) = ypiv(k+1) permut(k) = permut(k+1) 7 continue return c-----end-of-implu end c----------------------------------------------------------------------- subroutine uppdir(n,p,np,lbp,indp,y,u,usav,flops) real*8 p(n,lbp), y(*), u(*), usav(*), x, flops integer k,np,n,npm1,j,ju,indp,lbp c----------------------------------------------------------------------- c updates the conjugate directions p given the upper part of the c banded upper triangular matrix u. u contains the non zero c elements of the column of the triangular matrix.. c----------------------------------------------------------------------- real*8 zero parameter(zero=0.0D0) c npm1=np-1 if (np .le. 1) goto 12 j=indp ju = npm1 10 if (j .le. 0) j=lbp x = u(ju) /usav(j) if (x .eq. zero) goto 115 do 11 k=1,n y(k) = y(k) - x*p(k,j) 11 continue flops = flops + 2*n 115 j = j-1 ju = ju -1 if (ju .ge. 1) goto 10 12 indp = indp + 1 if (indp .gt. lbp) indp = 1 usav(indp) = u(np) do 13 k=1,n p(k,indp) = y(k) 13 continue 208 return c----------------------------------------------------------------------- c-------end-of-uppdir--------------------------------------------------- end subroutine givens(x,y,c,s) real*8 x,y,c,s c----------------------------------------------------------------------- c Given x and y, this subroutine generates a Givens' rotation c, s. c And apply the rotation on (x,y) ==> (sqrt(x**2 + y**2), 0). c (See P 202 of "matrix computation" by Golub and van Loan.) c----------------------------------------------------------------------- real*8 t,one,zero parameter (zero=0.0D0,one=1.0D0) c if (x.eq.zero .and. y.eq.zero) then c = one s = zero else if (abs(y).gt.abs(x)) then t = x / y x = sqrt(one+t*t) s = sign(one / x, y) c = t*s else if (abs(y).le.abs(x)) then t = y / x y = sqrt(one+t*t) c = sign(one / y, x) s = t*c else c c X or Y must be an invalid floating-point number, set both to zero c x = zero y = zero c = one s = zero endif x = abs(x*y) c c end of givens c return end c-----end-of-givens c----------------------------------------------------------------------- logical function stopbis(n,ipar,mvpi,fpar,r,delx,sx) implicit none integer n,mvpi,ipar(16) real*8 fpar(16), r(n), delx(n), sx, distdot external distdot c----------------------------------------------------------------------- c function for determining the stopping criteria. return value of c true if the stopbis criteria is satisfied. c----------------------------------------------------------------------- if (ipar(11) .eq. 1) then stopbis = .true. else stopbis = .false. endif if (ipar(6).gt.0 .and. ipar(7).ge.ipar(6)) then ipar(1) = -1 stopbis = .true. endif if (stopbis) return c c computes errors c fpar(5) = sqrt(distdot(n,r,1,r,1)) fpar(11) = fpar(11) + 2 * n if (ipar(3).lt.0) then c c compute the change in the solution vector c fpar(6) = sx * sqrt(distdot(n,delx,1,delx,1)) fpar(11) = fpar(11) + 2 * n if (ipar(7).lt.mvpi+mvpi+1) then c c if this is the end of the first iteration, set fpar(3:4) c fpar(3) = fpar(6) if (ipar(3).eq.-1) then fpar(4) = fpar(1) * fpar(3) + fpar(2) endif endif else fpar(6) = fpar(5) endif c c .. the test is struct this way so that when the value in fpar(6) c is not a valid number, STOPBIS is set to .true. c if (fpar(6).gt.fpar(4)) then stopbis = .false. ipar(11) = 0 else stopbis = .true. ipar(11) = 1 endif c return end c-----end-of-stopbis c----------------------------------------------------------------------- subroutine tidycg(n,ipar,fpar,sol,delx) implicit none integer i,n,ipar(16) real*8 fpar(16),sol(n),delx(n) c----------------------------------------------------------------------- c Some common operations required before terminating the CG routines c----------------------------------------------------------------------- real*8 zero parameter(zero=0.0D0) c if (ipar(12).ne.0) then ipar(1) = ipar(12) else if (ipar(1).gt.0) then if ((ipar(3).eq.999 .and. ipar(11).eq.1) .or. + fpar(6).le.fpar(4)) then ipar(1) = 0 else if (ipar(7).ge.ipar(6) .and. ipar(6).gt.0) then ipar(1) = -1 else ipar(1) = -10 endif endif if (fpar(3).gt.zero .and. fpar(6).gt.zero .and. + ipar(7).gt.ipar(13)) then fpar(7) = log10(fpar(3) / fpar(6)) / dble(ipar(7)-ipar(13)) else fpar(7) = zero endif do i = 1, n sol(i) = sol(i) + delx(i) enddo return end c-----end-of-tidycg c----------------------------------------------------------------------- logical function brkdn(alpha, ipar) implicit none integer ipar(16) real*8 alpha, beta, zero, one parameter (zero=0.0D0, one=1.0D0) c----------------------------------------------------------------------- c test whether alpha is zero or an abnormal number, if yes, c this routine will return .true. c c If alpha == 0, ipar(1) = -3, c if alpha is an abnormal number, ipar(1) = -9. c----------------------------------------------------------------------- brkdn = .false. if (alpha.gt.zero) then beta = one / alpha if (.not. beta.gt.zero) then brkdn = .true. ipar(1) = -9 endif else if (alpha.lt.zero) then beta = one / alpha if (.not. beta.lt.zero) then brkdn = .true. ipar(1) = -9 endif else if (alpha.eq.zero) then brkdn = .true. ipar(1) = -3 else brkdn = .true. ipar(1) = -9 endif return end c-----end-of-brkdn c----------------------------------------------------------------------- subroutine bisinit(ipar,fpar,wksize,dsc,lp,rp,wk) implicit none integer i,ipar(16),wksize,dsc logical lp,rp real*8 fpar(16),wk(*) c----------------------------------------------------------------------- c some common initializations for the iterative solvers c----------------------------------------------------------------------- real*8 zero, one parameter(zero=0.0D0, one=1.0D0) c c ipar(1) = -2 inidcate that there are not enough space in the work c array c if (ipar(4).lt.wksize) then ipar(1) = -2 ipar(4) = wksize return endif c if (ipar(2).gt.2) then lp = .true. rp = .true. else if (ipar(2).eq.2) then lp = .false. rp = .true. else if (ipar(2).eq.1) then lp = .true. rp = .false. else lp = .false. rp = .false. endif if (ipar(3).eq.0) ipar(3) = dsc c .. clear the ipar elements used ipar(7) = 0 ipar(8) = 0 ipar(9) = 0 ipar(10) = 0 ipar(11) = 0 ipar(12) = 0 ipar(13) = 0 c c fpar(1) must be between (0, 1), fpar(2) must be positive, c fpar(1) and fpar(2) can NOT both be zero c Normally return ipar(1) = -4 to indicate any of above error c if (fpar(1).lt.zero .or. fpar(1).ge.one .or. fpar(2).lt.zero .or. & (fpar(1).eq.zero .and. fpar(2).eq.zero)) then if (ipar(1).eq.0) then ipar(1) = -4 return else fpar(1) = 1.0D-6 fpar(2) = 1.0D-16 endif endif c .. clear the fpar elements do i = 3, 10 fpar(i) = zero enddo if (fpar(11).lt.zero) fpar(11) = zero c .. clear the used portion of the work array to zero do i = 1, wksize wk(i) = zero enddo c return c-----end-of-bisinit end c----------------------------------------------------------------------- subroutine mgsro(full,lda,n,m,ind,ops,vec,hh,ierr) implicit none logical full integer lda,m,n,ind,ierr real*8 ops,hh(m),vec(lda,m) c----------------------------------------------------------------------- c MGSRO -- Modified Gram-Schmidt procedure with Selective Re- c Orthogonalization c The ind'th vector of VEC is orthogonalized against the rest of c the vectors. c c The test for performing re-orthogonalization is performed for c each indivadual vectors. If the cosine between the two vectors c is greater than 0.99 (REORTH = 0.99**2), re-orthogonalization is c performed. The norm of the 'new' vector is kept in variable NRM0, c and updated after operating with each vector. c c full -- .ture. if it is necessary to orthogonalize the ind'th c against all the vectors vec(:,1:ind-1), vec(:,ind+2:m) c .false. only orthogonalize againt vec(:,1:ind-1) c lda -- the leading dimension of VEC c n -- length of the vector in VEC c m -- number of vectors can be stored in VEC c ind -- index to the vector to be changed c ops -- operation counts c vec -- vector of LDA X M storing the vectors c hh -- coefficient of the orthogonalization c ierr -- error code c 0 : successful return c -1: zero input vector c -2: input vector contains abnormal numbers c -3: input vector is a linear combination of others c c External routines used: real*8 distdot c----------------------------------------------------------------------- integer i,k real*8 nrm0, nrm1, fct, thr, distdot, zero, one, reorth parameter (zero=0.0D0, one=1.0D0, reorth=0.98D0) external distdot c c compute the norm of the input vector c nrm0 = distdot(n,vec(1,ind),1,vec(1,ind),1) ops = ops + n + n thr = nrm0 * reorth if (nrm0.le.zero) then ierr = - 1 return else if (nrm0.gt.zero .and. one/nrm0.gt.zero) then ierr = 0 else ierr = -2 return endif c c Modified Gram-Schmidt loop c if (full) then do 40 i = ind+1, m fct = distdot(n,vec(1,ind),1,vec(1,i),1) hh(i) = fct do 20 k = 1, n vec(k,ind) = vec(k,ind) - fct * vec(k,i) 20 continue ops = ops + 4 * n + 2 if (fct*fct.gt.thr) then fct = distdot(n,vec(1,ind),1,vec(1,i),1) hh(i) = hh(i) + fct do 30 k = 1, n vec(k,ind) = vec(k,ind) - fct * vec(k,i) 30 continue ops = ops + 4*n + 1 endif nrm0 = nrm0 - hh(i) * hh(i) if (nrm0.lt.zero) nrm0 = zero thr = nrm0 * reorth 40 continue endif c do 70 i = 1, ind-1 fct = distdot(n,vec(1,ind),1,vec(1,i),1) hh(i) = fct do 50 k = 1, n vec(k,ind) = vec(k,ind) - fct * vec(k,i) 50 continue ops = ops + 4 * n + 2 if (fct*fct.gt.thr) then fct = distdot(n,vec(1,ind),1,vec(1,i),1) hh(i) = hh(i) + fct do 60 k = 1, n vec(k,ind) = vec(k,ind) - fct * vec(k,i) 60 continue ops = ops + 4*n + 1 endif nrm0 = nrm0 - hh(i) * hh(i) if (nrm0.lt.zero) nrm0 = zero thr = nrm0 * reorth 70 continue c c test the resulting vector c nrm1 = sqrt(distdot(n,vec(1,ind),1,vec(1,ind),1)) ops = ops + n + n 75 hh(ind) = nrm1 if (nrm1.le.zero) then ierr = -3 return endif c c scale the resulting vector c fct = one / nrm1 do 80 k = 1, n vec(k,ind) = vec(k,ind) * fct 80 continue ops = ops + n + 1 c c normal return c ierr = 0 return c end surbotine mgsro end getdp-2.7.0-source/contrib/Sparskit/formats.f000644 001750 001750 00000412513 11266605601 022674 0ustar00geuzainegeuzaine000000 000000 c $Id: formats.f,v 1.1 2008-04-11 06:01:06 geuzaine Exp $ c----------------------------------------------------------------------c c S P A R S K I T c c----------------------------------------------------------------------c c FORMAT CONVERSION MODULE c c----------------------------------------------------------------------c c contents: c c---------- c c csrdns : converts a row-stored sparse matrix into the dense format. c c dnscsr : converts a dense matrix to a sparse storage format. c c coocsr : converts coordinate to to csr format c c coicsr : in-place conversion of coordinate to csr format c c csrcoo : converts compressed sparse row to coordinate. c c csrssr : converts compressed sparse row to symmetric sparse row c c ssrcsr : converts symmetric sparse row to compressed sparse row c c csrell : converts compressed sparse row to ellpack format c c ellcsr : converts ellpack format to compressed sparse row format c c csrmsr : converts compressed sparse row format to modified sparse c c row format c c msrcsr : converts modified sparse row format to compressed sparse c c row format. c c csrcsc : converts compressed sparse row format to compressed sparse c c column format (transposition) c c csrcsc2 : rectangular version of csrcsc c c csrlnk : converts compressed sparse row to linked list format c c lnkcsr : converts linked list format to compressed sparse row fmt c c csrdia : converts a compressed sparse row format into a diagonal c c format. c c diacsr : converts a diagonal format into a compressed sparse row c c format. c c bsrcsr : converts a block-row sparse format into a compressed c c sparse row format. c c csrbsr : converts a compressed sparse row format into a block-row c c sparse format. c c csrbnd : converts a compressed sparse row format into a banded c c format (linpack style). c c bndcsr : converts a banded format (linpack style) into a compressed c c sparse row storage. c c csrssk : converts the compressed sparse row format to the symmetric c c skyline format c c sskssr : converts symmetric skyline format to symmetric sparse row c c format. c c csrjad : converts the csr format into the jagged diagonal format c c jadcsr : converts the jagged-diagonal format into the csr format c c csruss : Compressed Sparse Row to Unsymmetric Sparse Skyline c c format c c usscsr : Unsymmetric Sparse Skyline format to Compressed Sparse Row c c csrsss : Compressed Sparse Row to Symmetric Sparse Skyline format c c ssscsr : Symmetric Sparse Skyline format to Compressed Sparse Row c c csrvbr : Converts compressed sparse row to var block row format c c vbrcsr : Converts var block row to compressed sparse row format c c csorted : Checks if matrix in CSR format is sorted by columns c c--------- miscalleneous additions not involving the csr format--------c c cooell : converts coordinate to Ellpack/Itpack format c c dcsort : sorting routine used by crsjad c c----------------------------------------------------------------------c subroutine csrdns(nrow,ncol,a,ja,ia,dns,ndns,ierr) real*8 dns(ndns,*),a(*) integer ja(*),ia(*) c----------------------------------------------------------------------- c Compressed Sparse Row to Dense c----------------------------------------------------------------------- c c converts a row-stored sparse matrix into a densely stored one c c On entry: c---------- c c nrow = row-dimension of a c ncol = column dimension of a c a, c ja, c ia = input matrix in compressed sparse row format. c (a=value array, ja=column array, ia=pointer array) c dns = array where to store dense matrix c ndns = first dimension of array dns c c on return: c----------- c dns = the sparse matrix a, ja, ia has been stored in dns(ndns,*) c c ierr = integer error indicator. c ierr .eq. 0 means normal return c ierr .eq. i means that the code has stopped when processing c row number i, because it found a column number .gt. ncol. c c----------------------------------------------------------------------- ierr = 0 do 1 i=1, nrow do 2 j=1,ncol dns(i,j) = 0.0d0 2 continue 1 continue c do 4 i=1,nrow do 3 k=ia(i),ia(i+1)-1 j = ja(k) if (j .gt. ncol) then ierr = i return endif dns(i,j) = a(k) 3 continue 4 continue return c---- end of csrdns ---------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine dnscsr(nrow,ncol,nzmax,dns,ndns,a,ja,ia,ierr) real*8 dns(ndns,*),a(*) integer ia(*),ja(*) c----------------------------------------------------------------------- c Dense to Compressed Row Sparse c----------------------------------------------------------------------- c c converts a densely stored matrix into a row orientied c compactly sparse matrix. ( reverse of csrdns ) c Note: this routine does not check whether an element c is small. It considers that a(i,j) is zero if it is exactly c equal to zero: see test below. c----------------------------------------------------------------------- c on entry: c--------- c c nrow = row-dimension of a c ncol = column dimension of a c nzmax = maximum number of nonzero elements allowed. This c should be set to be the lengths of the arrays a and ja. c dns = input nrow x ncol (dense) matrix. c ndns = first dimension of dns. c c on return: c---------- c c a, ja, ia = value, column, pointer arrays for output matrix c c ierr = integer error indicator: c ierr .eq. 0 means normal retur c ierr .eq. i means that the the code stopped while c processing row number i, because there was no space left in c a, and ja (as defined by parameter nzmax). c----------------------------------------------------------------------- ierr = 0 next = 1 ia(1) = 1 do 4 i=1,nrow do 3 j=1, ncol if (dns(i,j) .eq. 0.0d0) goto 3 if (next .gt. nzmax) then ierr = i return endif ja(next) = j a(next) = dns(i,j) next = next+1 3 continue ia(i+1) = next 4 continue return c---- end of dnscsr ---------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine coocsr(nrow,nnz,a,ir,jc,ao,jao,iao) c----------------------------------------------------------------------- real*8 a(*),ao(*),x integer ir(*),jc(*),jao(*),iao(*) c----------------------------------------------------------------------- c Coordinate to Compressed Sparse Row c----------------------------------------------------------------------- c converts a matrix that is stored in coordinate format c a, ir, jc into a row general sparse ao, jao, iao format. c c on entry: c--------- c nrow = dimension of the matrix c nnz = number of nonzero elements in matrix c a, c ir, c jc = matrix in coordinate format. a(k), ir(k), jc(k) store the nnz c nonzero elements of the matrix with a(k) = actual real value of c the elements, ir(k) = its row number and jc(k) = its column c number. The order of the elements is arbitrary. c c on return: c----------- c ir is destroyed c c ao, jao, iao = matrix in general sparse matrix format with ao c continung the real values, jao containing the column indices, c and iao being the pointer to the beginning of the row, c in arrays ao, jao. c c Notes: c------ This routine is NOT in place. See coicsr c c------------------------------------------------------------------------ do 1 k=1,nrow+1 iao(k) = 0 1 continue c determine row-lengths. do 2 k=1, nnz iao(ir(k)) = iao(ir(k))+1 2 continue c starting position of each row.. k = 1 do 3 j=1,nrow+1 k0 = iao(j) iao(j) = k k = k+k0 3 continue c go through the structure once more. Fill in output matrix. do 4 k=1, nnz i = ir(k) j = jc(k) x = a(k) iad = iao(i) ao(iad) = x jao(iad) = j iao(i) = iad+1 4 continue c shift back iao do 5 j=nrow,1,-1 iao(j+1) = iao(j) 5 continue iao(1) = 1 return c------------- end of coocsr ------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine coicsr (n,nnz,job,a,ja,ia,iwk) integer ia(nnz),ja(nnz),iwk(n) real*8 a(*) c------------------------------------------------------------------------ c IN-PLACE coo-csr conversion routine. c------------------------------------------------------------------------ c this subroutine converts a matrix stored in coordinate format into c the csr format. The conversion is done in place in that the arrays c a,ja,ia of the result are overwritten onto the original arrays. c------------------------------------------------------------------------ c on entry: c--------- c n = integer. row dimension of A. c nnz = integer. number of nonzero elements in A. c job = integer. Job indicator. when job=1, the real values in a are c filled. Otherwise a is not touched and the structure of the c array only (i.e. ja, ia) is obtained. c a = real array of size nnz (number of nonzero elements in A) c containing the nonzero elements c ja = integer array of length nnz containing the column positions c of the corresponding elements in a. c ia = integer array of length nnz containing the row positions c of the corresponding elements in a. c iwk = integer work array of length n+1 c on return: c---------- c a c ja c ia = contains the compressed sparse row data structure for the c resulting matrix. c Note: c------- c the entries of the output matrix are not sorted (the column c indices in each are not in increasing order) use coocsr c if you want them sorted. c----------------------------------------------------------------------c c Coded by Y. Saad, Sep. 26 1989 c c----------------------------------------------------------------------c real*8 t,tnext logical values c----------------------------------------------------------------------- values = (job .eq. 1) c find pointer array for resulting matrix. do 35 i=1,n+1 iwk(i) = 0 35 continue do 4 k=1,nnz i = ia(k) iwk(i+1) = iwk(i+1)+1 4 continue c------------------------------------------------------------------------ iwk(1) = 1 do 44 i=2,n iwk(i) = iwk(i-1) + iwk(i) 44 continue c c loop for a cycle in chasing process. c init = 1 k = 0 5 if (values) t = a(init) i = ia(init) j = ja(init) ia(init) = -1 c------------------------------------------------------------------------ 6 k = k+1 c current row number is i. determine where to go. ipos = iwk(i) c save the chased element. if (values) tnext = a(ipos) inext = ia(ipos) jnext = ja(ipos) c then occupy its location. if (values) a(ipos) = t ja(ipos) = j c update pointer information for next element to come in row i. iwk(i) = ipos+1 c determine next element to be chased, if (ia(ipos) .lt. 0) goto 65 t = tnext i = inext j = jnext ia(ipos) = -1 if (k .lt. nnz) goto 6 goto 70 65 init = init+1 if (init .gt. nnz) goto 70 if (ia(init) .lt. 0) goto 65 c restart chasing -- goto 5 70 do 80 i=1,n ia(i+1) = iwk(i) 80 continue ia(1) = 1 return c----------------- end of coicsr ---------------------------------------- c------------------------------------------------------------------------ end c----------------------------------------------------------------------- subroutine csrcoo (nrow,job,nzmax,a,ja,ia,nnz,ao,ir,jc,ierr) c----------------------------------------------------------------------- real*8 a(*),ao(*) integer ir(*),jc(*),ja(*),ia(nrow+1) c----------------------------------------------------------------------- c Compressed Sparse Row to Coordinate c----------------------------------------------------------------------- c converts a matrix that is stored in coordinate format c a, ir, jc into a row general sparse ao, jao, iao format. c c on entry: c--------- c nrow = dimension of the matrix. c job = integer serving as a job indicator. c if job = 1 fill in only the array ir, ignore jc, and ao. c if job = 2 fill in ir, and jc but not ao c if job = 3 fill in everything. c The reason why these options are provided is that on return c ao and jc are the same as a, ja. So when job = 3, a and ja are c simply copied into ao, jc. When job=2, only jc and ir are c returned. With job=1 only the array ir is returned. Moreover, c the algorithm is in place: c call csrcoo (nrow,1,nzmax,a,ja,ia,nnz,a,ia,ja,ierr) c will write the output matrix in coordinate format on a, ja,ia. c c a, c ja, c ia = matrix in compressed sparse row format. c nzmax = length of space available in ao, ir, jc. c the code will stop immediatly if the number of c nonzero elements found in input matrix exceeds nzmax. c c on return: c----------- c ao, ir, jc = matrix in coordinate format. c c nnz = number of nonzero elements in matrix. c ierr = integer error indicator. c ierr .eq. 0 means normal retur c ierr .eq. 1 means that the the code stopped c because there was no space in ao, ir, jc c (according to the value of nzmax). c c NOTES: 1)This routine is PARTIALLY in place: csrcoo can be called with c ao being the same array as as a, and jc the same array as ja. c but ir CANNOT be the same as ia. c 2) note the order in the output arrays, c------------------------------------------------------------------------ ierr = 0 nnz = ia(nrow+1)-1 if (nnz .gt. nzmax) then ierr = 1 return endif c------------------------------------------------------------------------ goto (3,2,1) job 1 do 10 k=1,nnz ao(k) = a(k) 10 continue 2 do 11 k=1,nnz jc(k) = ja(k) 11 continue c c copy backward to allow for in-place processing. c 3 do 13 i=nrow,1,-1 k1 = ia(i+1)-1 k2 = ia(i) do 12 k=k1,k2,-1 ir(k) = i 12 continue 13 continue return c------------- end-of-csrcoo ------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine csrssr (nrow,a,ja,ia,nzmax,ao,jao,iao,ierr) real*8 a(*), ao(*), t integer ia(*), ja(*), iao(*), jao(*) c----------------------------------------------------------------------- c Compressed Sparse Row to Symmetric Sparse Row c----------------------------------------------------------------------- c this subroutine extracts the lower triangular part of a matrix. c It can used as a means for converting a symmetric matrix for c which all the entries are stored in sparse format into one c in which only the lower part is stored. The routine is in place in c that the output matrix ao, jao, iao can be overwritten on c the input matrix a, ja, ia if desired. Csrssr has been coded to c put the diagonal elements of the matrix in the last position in c each row (i.e. in position ao(ia(i+1)-1 of ao and jao) c----------------------------------------------------------------------- c On entry c----------- c nrow = dimension of the matrix a. c a, ja, c ia = matrix stored in compressed row sparse format c c nzmax = length of arrays ao, and jao. c c On return: c----------- c ao, jao, c iao = lower part of input matrix (a,ja,ia) stored in compressed sparse c row format format. c c ierr = integer error indicator. c ierr .eq. 0 means normal return c ierr .eq. i means that the code has stopped when processing c row number i, because there is not enough space in ao, jao c (according to the value of nzmax) c c----------------------------------------------------------------------- ierr = 0 ko = 0 c----------------------------------------------------------------------- do 7 i=1, nrow kold = ko kdiag = 0 do 71 k = ia(i), ia(i+1) -1 if (ja(k) .gt. i) goto 71 ko = ko+1 if (ko .gt. nzmax) then ierr = i return endif ao(ko) = a(k) jao(ko) = ja(k) if (ja(k) .eq. i) kdiag = ko 71 continue if (kdiag .eq. 0 .or. kdiag .eq. ko) goto 72 c c exchange c t = ao(kdiag) ao(kdiag) = ao(ko) ao(ko) = t c k = jao(kdiag) jao(kdiag) = jao(ko) jao(ko) = k 72 iao(i) = kold+1 7 continue c redefine iao(n+1) iao(nrow+1) = ko+1 return c--------- end of csrssr ----------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine ssrcsr(job, value2, nrow, a, ja, ia, nzmax, & ao, jao, iao, indu, iwk, ierr) c .. Scalar Arguments .. integer ierr, job, nrow, nzmax, value2 c .. c .. Array Arguments .. integer ia(nrow+1), iao(nrow+1), indu(nrow), & iwk(nrow+1), ja(*), jao(nzmax) real*8 a(*), ao(nzmax) c .. c----------------------------------------------------------------------- c Symmetric Sparse Row to Compressed Sparse Row format c----------------------------------------------------------------------- c This subroutine converts a given matrix in SSR format to regular c CSR format by computing Ao = A + A' - diag(A), where A' is A c transpose. c c Typically this routine is used to expand the SSR matrix of c Harwell Boeing matrices, or to obtain a symmetrized graph of c unsymmetric matrices. c c This routine is inplace, i.e., (Ao,jao,iao) may be same as c (a,ja,ia). c c It is possible to input an arbitrary CSR matrix to this routine, c since there is no syntactical difference between CSR and SSR c format. It also removes duplicate entries and perform a partial c ordering. The output matrix has an order of lower half, main c diagonal and upper half after the partial ordering. c----------------------------------------------------------------------- c on entry: c--------- c c job = options c 0 -- duplicate entries are not removed. If the input matrix is c SSR (not an arbitary CSR) matrix, no duplicate entry should c arise from this routine. c 1 -- eliminate duplicate entries, zero entries. c 2 -- eliminate duplicate entries and perform partial ordering. c 3 -- eliminate duplicate entries, sort the entries in the c increasing order of clumn indices. c c value2= will the values of A be copied? c 0 -- only expand the graph (a, ao are not touched) c 1 -- expand the matrix with the values. c c nrow = column dimension of inout matrix c a, c ia, c ja = matrix in compressed sparse row format. c c nzmax = size of arrays ao and jao. SSRCSR will abort if the storage c provided in ao, jao is not sufficient to store A. See ierr. c c on return: c---------- c ao, jao, iao c = output matrix in compressed sparse row format. The resulting c matrix is symmetric and is equal to A+A'-D. ao, jao, iao, c can be the same as a, ja, ia in the calling sequence. c c indu = integer array of length nrow. INDU will contain pointers c to the beginning of upper traigular part if job > 1. c Otherwise it is also used as a work array (size nrow). c c iwk = integer work space (size nrow+1). c c ierr = integer. Serving as error message. If the length of the arrays c ao, jao exceeds nzmax, ierr returns the minimum value c needed for nzmax. otherwise ierr=0 (normal return). c c----------------------------------------------------------------------- c .. Local Scalars .. integer i, ipos, j, k, kfirst, klast, ko, kosav, nnz real*8 tmp c .. c .. Executable Statements .. ierr = 0 do 10 i = 1, nrow indu(i) = 0 iwk(i) = 0 10 continue iwk(nrow+1) = 0 c c .. compute number of elements in each row of (A'-D) c put result in iwk(i+1) for row i. c do 30 i = 1, nrow do 20 k = ia(i), ia(i+1) - 1 j = ja(k) if (j.ne.i) & iwk(j+1) = iwk(j+1) + 1 20 continue 30 continue c c .. find addresses of first elements of ouput matrix. result in iwk c iwk(1) = 1 do 40 i = 1, nrow indu(i) = iwk(i) + ia(i+1) - ia(i) iwk(i+1) = iwk(i+1) + indu(i) indu(i) = indu(i) - 1 40 continue c.....Have we been given enough storage in ao, jao ? nnz = iwk(nrow+1) - 1 if (nnz.gt.nzmax) then ierr = nnz return endif c c .. copy the existing matrix (backwards). c kosav = iwk(nrow+1) do 60 i = nrow, 1, -1 klast = ia(i+1) - 1 kfirst = ia(i) iao(i+1) = kosav kosav = iwk(i) ko = iwk(i) - kfirst iwk(i) = ko + klast + 1 do 50 k = klast, kfirst, -1 if (value2.ne.0) & ao(k+ko) = a(k) jao(k+ko) = ja(k) 50 continue 60 continue iao(1) = 1 c c now copy (A'-D). Go through the structure of ao, jao, iao c that has already been copied. iwk(i) is the address c of the next free location in row i for ao, jao. c do 80 i = 1, nrow do 70 k = iao(i), indu(i) j = jao(k) if (j.ne.i) then ipos = iwk(j) if (value2.ne.0) & ao(ipos) = ao(k) jao(ipos) = i iwk(j) = ipos + 1 endif 70 continue 80 continue if (job.le.0) return c c .. eliminate duplicate entries -- c array INDU is used as marker for existing indices, it is also the c location of the entry. c IWK is used to stored the old IAO array. c matrix is copied to squeeze out the space taken by the duplicated c entries. c do 90 i = 1, nrow indu(i) = 0 iwk(i) = iao(i) 90 continue iwk(nrow+1) = iao(nrow+1) k = 1 do 120 i = 1, nrow iao(i) = k ipos = iwk(i) klast = iwk(i+1) 100 if (ipos.lt.klast) then j = jao(ipos) if (indu(j).eq.0) then c .. new entry .. if (value2.ne.0) then if (ao(ipos) .ne. 0.0D0) then indu(j) = k jao(k) = jao(ipos) ao(k) = ao(ipos) k = k + 1 endif else indu(j) = k jao(k) = jao(ipos) k = k + 1 endif else if (value2.ne.0) then c .. duplicate entry .. ao(indu(j)) = ao(indu(j)) + ao(ipos) endif ipos = ipos + 1 go to 100 endif c .. remove marks before working on the next row .. do 110 ipos = iao(i), k - 1 indu(jao(ipos)) = 0 110 continue 120 continue iao(nrow+1) = k if (job.le.1) return c c .. partial ordering .. c split the matrix into strict upper/lower triangular c parts, INDU points to the the beginning of the strict upper part. c do 140 i = 1, nrow klast = iao(i+1) - 1 kfirst = iao(i) 130 if (klast.gt.kfirst) then if (jao(klast).lt.i .and. jao(kfirst).ge.i) then c .. swap klast with kfirst .. j = jao(klast) jao(klast) = jao(kfirst) jao(kfirst) = j if (value2.ne.0) then tmp = ao(klast) ao(klast) = ao(kfirst) ao(kfirst) = tmp endif endif if (jao(klast).ge.i) & klast = klast - 1 if (jao(kfirst).lt.i) & kfirst = kfirst + 1 go to 130 endif c if (jao(klast).lt.i) then indu(i) = klast + 1 else indu(i) = klast endif 140 continue if (job.le.2) return c c .. order the entries according to column indices c bubble-sort is used c do 190 i = 1, nrow do 160 ipos = iao(i), indu(i)-1 do 150 j = indu(i)-1, ipos+1, -1 k = j - 1 if (jao(k).gt.jao(j)) then ko = jao(k) jao(k) = jao(j) jao(j) = ko if (value2.ne.0) then tmp = ao(k) ao(k) = ao(j) ao(j) = tmp endif endif 150 continue 160 continue do 180 ipos = indu(i), iao(i+1)-1 do 170 j = iao(i+1)-1, ipos+1, -1 k = j - 1 if (jao(k).gt.jao(j)) then ko = jao(k) jao(k) = jao(j) jao(j) = ko if (value2.ne.0) then tmp = ao(k) ao(k) = ao(j) ao(j) = tmp endif endif 170 continue 180 continue 190 continue c return c---- end of ssrcsr ---------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine xssrcsr (nrow,a,ja,ia,nzmax,ao,jao,iao,indu,ierr) integer ia(nrow+1),iao(nrow+1),ja(*),jao(nzmax),indu(nrow+1) real*8 a(*),ao(nzmax) c----------------------------------------------------------------------- c Symmetric Sparse Row to (regular) Compressed Sparse Row c----------------------------------------------------------------------- c this subroutine converts a symmetric matrix in which only the lower c part is stored in compressed sparse row format, i.e., c a matrix stored in symmetric sparse format, into a fully stored matrix c i.e., a matrix where both the lower and upper parts are stored in c compressed sparse row format. the algorithm is in place (i.e. result c may be overwritten onto the input matrix a, ja, ia ----- ). c the output matrix delivered by ssrcsr is such that each row starts with c the elements of the lower part followed by those of the upper part. c----------------------------------------------------------------------- c on entry: c--------- c c nrow = row dimension of inout matrix c a, c ia, c ja = matrix in compressed sparse row format. This is assumed to be c a lower triangular matrix. c c nzmax = size of arrays ao and jao. ssrcsr will abort if the storage c provided in a, ja is not sufficient to store A. See ierr. c c on return: c---------- c ao, iao, c jao = output matrix in compressed sparse row format. The resulting c matrix is symmetric and is equal to A+A**T - D, if c A is the original lower triangular matrix. ao, jao, iao, c can be the same as a, ja, ia in the calling sequence. c c indu = integer array of length nrow+1. If the input matrix is such c that the last element in each row is its diagonal element then c on return, indu will contain the pointers to the diagonal c element in each row of the output matrix. Otherwise used as c work array. c ierr = integer. Serving as error message. If the length of the arrays c ao, jao exceeds nzmax, ierr returns the minimum value c needed for nzmax. otherwise ierr=0 (normal return). c c----------------------------------------------------------------------- ierr = 0 do 1 i=1,nrow+1 indu(i) = 0 1 continue c c compute number of elements in each row of strict upper part. c put result in indu(i+1) for row i. c do 3 i=1, nrow do 2 k=ia(i),ia(i+1)-1 j = ja(k) if (j .lt. i) indu(j+1) = indu(j+1)+1 2 continue 3 continue c----------- c find addresses of first elements of ouput matrix. result in indu c----------- indu(1) = 1 do 4 i=1,nrow lenrow = ia(i+1)-ia(i) indu(i+1) = indu(i) + indu(i+1) + lenrow 4 continue c--------------------- enough storage in a, ja ? -------- nnz = indu(nrow+1)-1 if (nnz .gt. nzmax) then ierr = nnz return endif c c now copy lower part (backwards). c kosav = indu(nrow+1) do 6 i=nrow,1,-1 klast = ia(i+1)-1 kfirst = ia(i) iao(i+1) = kosav ko = indu(i) kosav = ko do 5 k = kfirst, klast ao(ko) = a(k) jao(ko) = ja(k) ko = ko+1 5 continue indu(i) = ko 6 continue iao(1) = 1 c c now copy upper part. Go through the structure of ao, jao, iao c that has already been copied (lower part). indu(i) is the address c of the next free location in row i for ao, jao. c do 8 i=1,nrow c i-th row is now in ao, jao, iao structure -- lower half part do 9 k=iao(i), iao(i+1)-1 j = jao(k) if (j .ge. i) goto 8 ipos = indu(j) ao(ipos) = ao(k) jao(ipos) = i indu(j) = indu(j) + 1 9 continue 8 continue return c----- end of xssrcsr -------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine csrell (nrow,a,ja,ia,maxcol,coef,jcoef,ncoef, * ndiag,ierr) integer ia(nrow+1), ja(*), jcoef(ncoef,1) real*8 a(*), coef(ncoef,1) c----------------------------------------------------------------------- c Compressed Sparse Row to Ellpack - Itpack format c----------------------------------------------------------------------- c this subroutine converts matrix stored in the general a, ja, ia c format into the coef, jcoef itpack format. c c----------------------------------------------------------------------- c on entry: c---------- c nrow = row dimension of the matrix A. c c a, c ia, c ja = input matrix in compressed sparse row format. c c ncoef = first dimension of arrays coef, and jcoef. c c maxcol = integer equal to the number of columns available in coef. c c on return: c---------- c coef = real array containing the values of the matrix A in c itpack-ellpack format. c jcoef = integer array containing the column indices of coef(i,j) c in A. c ndiag = number of active 'diagonals' found. c c ierr = error message. 0 = correct return. If ierr .ne. 0 on c return this means that the number of diagonals found c (ndiag) exceeds maxcol. c c----------------------------------------------------------------------- c first determine the length of each row of lower-part-of(A) ierr = 0 ndiag = 0 do 3 i=1, nrow k = ia(i+1)-ia(i) ndiag = max0(ndiag,k) 3 continue c----- check whether sufficient columns are available. ----------------- if (ndiag .gt. maxcol) then ierr = 1 return endif c c fill coef with zero elements and jcoef with row numbers.------------ c do 4 j=1,ndiag do 41 i=1,nrow coef(i,j) = 0.0d0 jcoef(i,j) = i 41 continue 4 continue c c------- copy elements row by row.-------------------------------------- c do 6 i=1, nrow k1 = ia(i) k2 = ia(i+1)-1 do 5 k=k1,k2 coef(i,k-k1+1) = a(k) jcoef(i,k-k1+1) = ja(k) 5 continue 6 continue return c--- end of csrell------------------------------------------------------ c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine ellcsr(nrow,coef,jcoef,ncoef,ndiag,a,ja,ia,nzmax,ierr) integer ia(nrow+1), ja(*), jcoef(ncoef,1) real*8 a(*), coef(ncoef,1) c----------------------------------------------------------------------- c Ellpack - Itpack format to Compressed Sparse Row c----------------------------------------------------------------------- c this subroutine converts a matrix stored in ellpack-itpack format c coef-jcoef into the compressed sparse row format. It actually checks c whether an entry in the input matrix is a nonzero element before c putting it in the output matrix. The test does not account for small c values but only for exact zeros. c----------------------------------------------------------------------- c on entry: c---------- c c nrow = row dimension of the matrix A. c coef = array containing the values of the matrix A in ellpack format. c jcoef = integer arraycontains the column indices of coef(i,j) in A. c ncoef = first dimension of arrays coef, and jcoef. c ndiag = number of active columns in coef, jcoef. c c ndiag = on entry the number of columns made available in coef. c c on return: c---------- c a, ia, c ja = matrix in a, ia, ja format where. c c nzmax = size of arrays a and ja. ellcsr will abort if the storage c provided in a, ja is not sufficient to store A. See ierr. c c ierr = integer. serves are output error message. c ierr = 0 means normal return. c ierr = 1 means that there is not enough space in c a and ja to store output matrix. c----------------------------------------------------------------------- c first determine the length of each row of lower-part-of(A) ierr = 0 c-----check whether sufficient columns are available. ----------------- c c------- copy elements row by row.-------------------------------------- kpos = 1 ia(1) = kpos do 6 i=1, nrow do 5 k=1,ndiag if (coef(i,k) .ne. 0.0d0) then if (kpos .gt. nzmax) then ierr = kpos return endif a(kpos) = coef(i,k) ja(kpos) = jcoef(i,k) kpos = kpos+1 endif 5 continue ia(i+1) = kpos 6 continue return c--- end of ellcsr ----------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine csrmsr (n,a,ja,ia,ao,jao,wk,iwk) real*8 a(*),ao(*),wk(n) integer ia(n+1),ja(*),jao(*),iwk(n+1) c----------------------------------------------------------------------- c Compressed Sparse Row to Modified - Sparse Row c Sparse row with separate main diagonal c----------------------------------------------------------------------- c converts a general sparse matrix a, ja, ia into c a compressed matrix using a separated diagonal (referred to as c the bell-labs format as it is used by bell labs semi conductor c group. We refer to it here as the modified sparse row format. c Note: this has been coded in such a way that one can overwrite c the output matrix onto the input matrix if desired by a call of c the form c c call csrmsr (n, a, ja, ia, a, ja, wk,iwk) c c In case ao, jao, are different from a, ja, then one can c use ao, jao as the work arrays in the calling sequence: c c call csrmsr (n, a, ja, ia, ao, jao, ao,jao) c c----------------------------------------------------------------------- c c on entry : c--------- c a, ja, ia = matrix in csr format. note that the c algorithm is in place: ao, jao can be the same c as a, ja, in which case it will be overwritten on it c upon return. c c on return : c----------- c c ao, jao = sparse matrix in modified sparse row storage format: c + ao(1:n) contains the diagonal of the matrix. c + ao(n+2:nnz) contains the nondiagonal elements of the c matrix, stored rowwise. c + jao(n+2:nnz) : their column indices c + jao(1:n+1) contains the pointer array for the nondiagonal c elements in ao(n+1:nnz) and jao(n+2:nnz). c i.e., for i .le. n+1 jao(i) points to beginning of row i c in arrays ao, jao. c here nnz = number of nonzero elements+1 c work arrays: c------------ c wk = real work array of length n c iwk = integer work array of length n+1 c c notes: c------- c Algorithm is in place. i.e. both: c c call csrmsr (n, a, ja, ia, ao, jao, ao,jao) c (in which ao, jao, are different from a, ja) c and c call csrmsr (n, a, ja, ia, a, ja, wk,iwk) c (in which wk, jwk, are different from a, ja) c are OK. c-------- c coded by Y. Saad Sep. 1989. Rechecked Feb 27, 1990. c----------------------------------------------------------------------- icount = 0 c c store away diagonal elements and count nonzero diagonal elements. c do 1 i=1,n wk(i) = 0.0d0 iwk(i+1) = ia(i+1)-ia(i) do 2 k=ia(i),ia(i+1)-1 if (ja(k) .eq. i) then wk(i) = a(k) icount = icount + 1 iwk(i+1) = iwk(i+1)-1 endif 2 continue 1 continue c c compute total length c iptr = n + ia(n+1) - icount c c copy backwards (to avoid collisions) c do 500 ii=n,1,-1 do 100 k=ia(ii+1)-1,ia(ii),-1 j = ja(k) if (j .ne. ii) then ao(iptr) = a(k) jao(iptr) = j iptr = iptr-1 endif 100 continue 500 continue c c compute pointer values and copy wk(*) c jao(1) = n+2 do 600 i=1,n ao(i) = wk(i) jao(i+1) = jao(i)+iwk(i+1) 600 continue return c------------ end of subroutine csrmsr --------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine msrcsr (n,a,ja,ao,jao,iao,wk,iwk) real*8 a(*),ao(*),wk(n) integer ja(*),jao(*),iao(n+1),iwk(n+1) c----------------------------------------------------------------------- c Modified - Sparse Row to Compressed Sparse Row c c----------------------------------------------------------------------- c converts a compressed matrix using a separated diagonal c (modified sparse row format) in the Compressed Sparse Row c format. c does not check for zero elements in the diagonal. c c c on entry : c--------- c n = row dimension of matrix c a, ja = sparse matrix in msr sparse storage format c see routine csrmsr for details on data structure c c on return : c----------- c c ao,jao,iao = output matrix in csr format. c c work arrays: c------------ c wk = real work array of length n c iwk = integer work array of length n+1 c c notes: c The original version of this was NOT in place, but has c been modified by adding the vector iwk to be in place. c The original version had ja instead of iwk everywhere in c loop 500. Modified Sun 29 May 1994 by R. Bramley (Indiana). c c----------------------------------------------------------------------- logical added do 1 i=1,n wk(i) = a(i) iwk(i) = ja(i) 1 continue iwk(n+1) = ja(n+1) iao(1) = 1 iptr = 1 c--------- do 500 ii=1,n added = .false. idiag = iptr + (iwk(ii+1)-iwk(ii)) do 100 k=iwk(ii),iwk(ii+1)-1 j = ja(k) if (j .lt. ii) then ao(iptr) = a(k) jao(iptr) = j iptr = iptr+1 elseif (added) then ao(iptr) = a(k) jao(iptr) = j iptr = iptr+1 else c add diag element - only reserve a position for it. idiag = iptr iptr = iptr+1 added = .true. c then other element ao(iptr) = a(k) jao(iptr) = j iptr = iptr+1 endif 100 continue ao(idiag) = wk(ii) jao(idiag) = ii if (.not. added) iptr = iptr+1 iao(ii+1) = iptr 500 continue return c------------ end of subroutine msrcsr --------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine csrcsc (n,job,ipos,a,ja,ia,ao,jao,iao) integer ia(n+1),iao(n+1),ja(*),jao(*) real*8 a(*),ao(*) c----------------------------------------------------------------------- c Compressed Sparse Row to Compressed Sparse Column c c (transposition operation) Not in place. c----------------------------------------------------------------------- c -- not in place -- c this subroutine transposes a matrix stored in a, ja, ia format. c --------------- c on entry: c---------- c n = dimension of A. c job = integer to indicate whether to fill the values (job.eq.1) of the c matrix ao or only the pattern., i.e.,ia, and ja (job .ne.1) c c ipos = starting position in ao, jao of the transposed matrix. c the iao array takes this into account (thus iao(1) is set to ipos.) c Note: this may be useful if one needs to append the data structure c of the transpose to that of A. In this case use for example c call csrcsc (n,1,ia(n+1),a,ja,ia,a,ja,ia(n+2)) c for any other normal usage, enter ipos=1. c a = real array of length nnz (nnz=number of nonzero elements in input c matrix) containing the nonzero elements. c ja = integer array of length nnz containing the column positions c of the corresponding elements in a. c ia = integer of size n+1. ia(k) contains the position in a, ja of c the beginning of the k-th row. c c on return: c ---------- c output arguments: c ao = real array of size nzz containing the "a" part of the transpose c jao = integer array of size nnz containing the column indices. c iao = integer array of size n+1 containing the "ia" index array of c the transpose. c c----------------------------------------------------------------------- call csrcsc2 (n,n,job,ipos,a,ja,ia,ao,jao,iao) end c----------------------------------------------------------------------- subroutine csrcsc2 (n,n2,job,ipos,a,ja,ia,ao,jao,iao) integer ia(n+1),iao(n2+1),ja(*),jao(*) real*8 a(*),ao(*) c----------------------------------------------------------------------- c Compressed Sparse Row to Compressed Sparse Column c c (transposition operation) Not in place. c----------------------------------------------------------------------- c Rectangular version. n is number of rows of CSR matrix, c n2 (input) is number of columns of CSC matrix. c----------------------------------------------------------------------- c -- not in place -- c this subroutine transposes a matrix stored in a, ja, ia format. c --------------- c on entry: c---------- c n = number of rows of CSR matrix. c n2 = number of columns of CSC matrix. c job = integer to indicate whether to fill the values (job.eq.1) of the c matrix ao or only the pattern., i.e.,ia, and ja (job .ne.1) c c ipos = starting position in ao, jao of the transposed matrix. c the iao array takes this into account (thus iao(1) is set to ipos.) c Note: this may be useful if one needs to append the data structure c of the transpose to that of A. In this case use for example c call csrcsc2 (n,n,1,ia(n+1),a,ja,ia,a,ja,ia(n+2)) c for any other normal usage, enter ipos=1. c a = real array of length nnz (nnz=number of nonzero elements in input c matrix) containing the nonzero elements. c ja = integer array of length nnz containing the column positions c of the corresponding elements in a. c ia = integer of size n+1. ia(k) contains the position in a, ja of c the beginning of the k-th row. c c on return: c ---------- c output arguments: c ao = real array of size nzz containing the "a" part of the transpose c jao = integer array of size nnz containing the column indices. c iao = integer array of size n+1 containing the "ia" index array of c the transpose. c c----------------------------------------------------------------------- c----------------- compute lengths of rows of transp(A) ---------------- do 1 i=1,n2+1 iao(i) = 0 1 continue do 3 i=1, n do 2 k=ia(i), ia(i+1)-1 j = ja(k)+1 iao(j) = iao(j)+1 2 continue 3 continue c---------- compute pointers from lengths ------------------------------ iao(1) = ipos do 4 i=1,n2 iao(i+1) = iao(i) + iao(i+1) 4 continue c--------------- now do the actual copying ----------------------------- do 6 i=1,n do 62 k=ia(i),ia(i+1)-1 j = ja(k) next = iao(j) if (job .eq. 1) ao(next) = a(k) jao(next) = i iao(j) = next+1 62 continue 6 continue c-------------------------- reshift iao and leave ---------------------- do 7 i=n2,1,-1 iao(i+1) = iao(i) 7 continue iao(1) = ipos c--------------- end of csrcsc2 ---------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine csrlnk (n,a,ja,ia,link) real*8 a(*) integer n, ja(*), ia(n+1), link(*) c----------------------------------------------------------------------- c Compressed Sparse Row to Linked storage format. c----------------------------------------------------------------------- c this subroutine translates a matrix stored in compressed sparse c row into one with a linked list storage format. Only the link c array needs to be obtained since the arrays a, ja, and ia may c be unchanged and carry the same meaning for the output matrix. c in other words a, ja, ia, link is the output linked list data c structure with a, ja, unchanged from input, and ia possibly c altered (in case therea re null rows in matrix). Details on c the output array link are given below. c----------------------------------------------------------------------- c Coded by Y. Saad, Feb 21, 1991. c----------------------------------------------------------------------- c c on entry: c---------- c n = integer equal to the dimension of A. c c a = real array of size nna containing the nonzero elements c ja = integer array of size nnz containing the column positions c of the corresponding elements in a. c ia = integer of size n+1 containing the pointers to the beginning c of each row. ia(k) contains the position in a, ja of the c beginning of the k-th row. c c on return: c---------- c a, ja, are not changed. c ia may be changed if there are null rows. c c a = nonzero elements. c ja = column positions. c ia = ia(i) points to the first element of row i in linked structure. c link = integer array of size containing the linked list information. c link(k) points to the next element of the row after element c a(k), ja(k). if link(k) = 0, then there is no next element, c i.e., a(k), jcol(k) is the last element of the current row. c c Thus row number i can be accessed as follows: c next = ia(i) c while(next .ne. 0) do c value = a(next) ! value a(i,j) c jcol = ja(next) ! column index j c next = link(next) ! address of next element in row c endwhile c notes: c ------ ia may be altered on return. c----------------------------------------------------------------------- c local variables integer i, k c c loop through all rows c do 100 i =1, n istart = ia(i) iend = ia(i+1)-1 if (iend .gt. istart) then do 99 k=istart, iend-1 link(k) = k+1 99 continue link(iend) = 0 else ia(i) = 0 endif 100 continue c return c-------------end-of-csrlnk -------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine lnkcsr (n, a, jcol, istart, link, ao, jao, iao) real*8 a(*), ao(*) integer n, jcol(*), istart(n), link(*), jao(*), iao(*) c----------------------------------------------------------------------- c Linked list storage format to Compressed Sparse Row format c----------------------------------------------------------------------- c this subroutine translates a matrix stored in linked list storage c format into the compressed sparse row format. c----------------------------------------------------------------------- c Coded by Y. Saad, Feb 21, 1991. c----------------------------------------------------------------------- c c on entry: c---------- c n = integer equal to the dimension of A. c c a = real array of size nna containing the nonzero elements c jcol = integer array of size nnz containing the column positions c of the corresponding elements in a. c istart= integer array of size n poiting to the beginning of the rows. c istart(i) contains the position of the first element of c row i in data structure. (a, jcol, link). c if a row is empty istart(i) must be zero. c link = integer array of size nnz containing the links in the linked c list data structure. link(k) points to the next element c of the row after element ao(k), jcol(k). if link(k) = 0, c then there is no next element, i.e., ao(k), jcol(k) is c the last element of the current row. c c on return: c----------- c ao, jao, iao = matrix stored in csr format: c c ao = real array containing the values of the nonzero elements of c the matrix stored row-wise. c jao = integer array of size nnz containing the column indices. c iao = integer array of size n+1 containing the pointers array to the c beginning of each row. iao(i) is the address in ao,jao of c first element of row i. c c----------------------------------------------------------------------- c first determine individial bandwidths and pointers. c----------------------------------------------------------------------- c local variables integer irow, ipos, next c----------------------------------------------------------------------- ipos = 1 iao(1) = ipos c c loop through all rows c do 100 irow =1, n c c unroll i-th row. c next = istart(irow) 10 if (next .eq. 0) goto 99 jao(ipos) = jcol(next) ao(ipos) = a(next) ipos = ipos+1 next = link(next) goto 10 99 iao(irow+1) = ipos 100 continue c return c-------------end-of-lnkcsr ------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine csrdia (n,idiag,job,a,ja,ia,ndiag, * diag,ioff,ao,jao,iao,ind) real*8 diag(ndiag,idiag), a(*), ao(*) integer ia(*), ind(*), ja(*), jao(*), iao(*), ioff(*) c----------------------------------------------------------------------- c Compressed sparse row to diagonal format c----------------------------------------------------------------------- c this subroutine extracts idiag diagonals from the input matrix a, c a, ia, and puts the rest of the matrix in the output matrix ao, c jao, iao. The diagonals to be extracted depend on the value of job c (see below for details.) In the first case, the diagonals to be c extracted are simply identified by their offsets provided in ioff c by the caller. In the second case, the code internally determines c the idiag most significant diagonals, i.e., those diagonals of the c matrix which have the largest number of nonzero elements, and c extracts them. c----------------------------------------------------------------------- c on entry: c---------- c n = dimension of the matrix a. c idiag = integer equal to the number of diagonals to be extracted. c Note: on return idiag may be modified. c a, ja, c ia = matrix stored in a, ja, ia, format c job = integer. serves as a job indicator. Job is better thought c of as a two-digit number job=xy. If the first (x) digit c is one on entry then the diagonals to be extracted are c internally determined. In this case csrdia exctracts the c idiag most important diagonals, i.e. those having the largest c number on nonzero elements. If the first digit is zero c then csrdia assumes that ioff(*) contains the offsets c of the diagonals to be extracted. there is no verification c that ioff(*) contains valid entries. c The second (y) digit of job determines whether or not c the remainder of the matrix is to be written on ao,jao,iao. c If it is zero then ao, jao, iao is not filled, i.e., c the diagonals are found and put in array diag and the rest is c is discarded. if it is one, ao, jao, iao contains matrix c of the remaining elements. c Thus: c job= 0 means do not select diagonals internally (pick those c defined by ioff) and do not fill ao,jao,iao c job= 1 means do not select diagonals internally c and fill ao,jao,iao c job=10 means select diagonals internally c and do not fill ao,jao,iao c job=11 means select diagonals internally c and fill ao,jao,iao c c ndiag = integer equal to the first dimension of array diag. c c on return: c----------- c c idiag = number of diagonals found. This may be smaller than its value c on entry. c diag = real array of size (ndiag x idiag) containing the diagonals c of A on return c c ioff = integer array of length idiag, containing the offsets of the c diagonals to be extracted. c ao, jao c iao = remainder of the matrix in a, ja, ia format. c work arrays: c------------ c ind = integer array of length 2*n-1 used as integer work space. c needed only when job.ge.10 i.e., in case the diagonals are to c be selected internally. c c Notes: c------- c 1) The algorithm is in place: ao, jao, iao can be overwritten on c a, ja, ia if desired c 2) When the code is required to select the diagonals (job .ge. 10) c the selection of the diagonals is done from left to right c as a result if several diagonals have the same weight (number c of nonzero elemnts) the leftmost one is selected first. c----------------------------------------------------------------------- job1 = job/10 job2 = job-job1*10 if (job1 .eq. 0) goto 50 n2 = n+n-1 call infdia(n,ja,ia,ind,idum) c----------- determine diagonals to accept.---------------------------- c----------------------------------------------------------------------- ii = 0 4 ii=ii+1 jmax = 0 do 41 k=1, n2 j = ind(k) if (j .le. jmax) goto 41 i = k jmax = j 41 continue if (jmax .le. 0) then ii = ii-1 goto 42 endif ioff(ii) = i-n ind(i) = - jmax if (ii .lt. idiag) goto 4 42 idiag = ii c---------------- initialize diago to zero ----------------------------- 50 continue do 55 j=1,idiag do 54 i=1,n diag(i,j) = 0.0d0 54 continue 55 continue c----------------------------------------------------------------------- ko = 1 c----------------------------------------------------------------------- c extract diagonals and accumulate remaining matrix. c----------------------------------------------------------------------- do 6 i=1, n do 51 k=ia(i),ia(i+1)-1 j = ja(k) do 52 l=1,idiag if (j-i .ne. ioff(l)) goto 52 diag(i,l) = a(k) goto 51 52 continue c--------------- append element not in any diagonal to ao,jao,iao ----- if (job2 .eq. 0) goto 51 ao(ko) = a(k) jao(ko) = j ko = ko+1 51 continue if (job2 .ne. 0 ) ind(i+1) = ko 6 continue if (job2 .eq. 0) return c finish with iao iao(1) = 1 do 7 i=2,n+1 iao(i) = ind(i) 7 continue return c----------- end of csrdia --------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine diacsr (n,job,idiag,diag,ndiag,ioff,a,ja,ia) real*8 diag(ndiag,idiag), a(*), t integer ia(*), ja(*), ioff(*) c----------------------------------------------------------------------- c diagonal format to compressed sparse row c----------------------------------------------------------------------- c this subroutine extract the idiag most important diagonals from the c input matrix a, ja, ia, i.e, those diagonals of the matrix which have c the largest number of nonzero elements. If requested (see job), c the rest of the matrix is put in a the output matrix ao, jao, iao c----------------------------------------------------------------------- c on entry: c---------- c n = integer. dimension of the matrix a. c job = integer. job indicator with the following meaning. c if (job .eq. 0) then check for each entry in diag c whether this entry is zero. If it is then do not include c in the output matrix. Note that the test is a test for c an exact arithmetic zero. Be sure that the zeros are c actual zeros in double precision otherwise this would not c work. c c idiag = integer equal to the number of diagonals to be extracted. c Note: on return idiag may be modified. c c diag = real array of size (ndiag x idiag) containing the diagonals c of A on return. c c ndiag = integer equal to the first dimension of array diag. c c ioff = integer array of length idiag, containing the offsets of the c diagonals to be extracted. c c on return: c----------- c a, c ja, c ia = matrix stored in a, ja, ia, format c c Note: c ----- the arrays a and ja should be of length n*idiag. c c----------------------------------------------------------------------- ia(1) = 1 ko = 1 do 80 i=1, n do 70 jj = 1, idiag j = i+ioff(jj) if (j .lt. 1 .or. j .gt. n) goto 70 t = diag(i,jj) if (job .eq. 0 .and. t .eq. 0.0d0) goto 70 a(ko) = t ja(ko) = j ko = ko+1 70 continue ia(i+1) = ko 80 continue return c----------- end of diacsr --------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine bsrcsr (job, n, m, na, a, ja, ia, ao, jao, iao) implicit none integer job, n, m, na, ia(*), ja(*), jao(*), iao(n+1) real*8 a(na,*), ao(*) c----------------------------------------------------------------------- c Block Sparse Row to Compressed Sparse Row. c----------------------------------------------------------------------- c NOTE: ** meanings of parameters may have changed wrt earlier versions c FORMAT DEFINITION HAS CHANGED WRT TO EARLIER VERSIONS... c----------------------------------------------------------------------- c c converts a matrix stored in block-reduced a, ja, ia format to the c general sparse row a, ja, ia format. A matrix that has a block c structure is a matrix whose entries are blocks of the same size m c (e.g. 3 x 3). Then it is often preferred to work with the reduced c graph of the matrix. Instead of storing one element at a time one can c store a whole block at a time. In this storage scheme an entry is a c square array holding the m**2 elements of a block. c c----------------------------------------------------------------------- c on entry: c---------- c job = if job.eq.0 on entry, values are not copied (pattern only) c c n = the block row dimension of the matrix. c c m = the dimension of each block. Thus, the actual row dimension c of A is n x m. c c na = first dimension of array a as declared in calling program. c This should be .ge. m**2. c c a = real array containing the real entries of the matrix. Recall c that each entry is in fact an m x m block. These entries c are stored column-wise in locations a(1:m*m,k) for each k-th c entry. See details below. c c ja = integer array of length n. ja(k) contains the column index c of the leading element, i.e., the element (1,1) of the block c that is held in the column a(*,k) of the value array. c c ia = integer array of length n+1. ia(i) points to the beginning c of block row number i in the arrays a and ja. c c on return: c----------- c ao, jao, c iao = matrix stored in compressed sparse row format. The number of c rows in the new matrix is n x m. c c Notes: THIS CODE IS NOT IN PLACE. c c----------------------------------------------------------------------- c BSR FORMAT. c---------- c Each row of A contains the m x m block matrix unpacked column- c wise (this allows the user to declare the array a as a(m,m,*) on entry c if desired). The block rows are stored in sequence just as for the c compressed sparse row format. c c----------------------------------------------------------------------- c example with m = 2: c 1 2 3 c +-------|--------|--------+ +-------+ c | 1 2 | 0 0 | 3 4 | Block | x 0 x | 1 c | 5 6 | 0 0 | 7 8 | Representation: | 0 x x | 2 c +-------+--------+--------+ | x 0 0 | 3 c | 0 0 | 9 10 | 11 12 | +-------+ c | 0 0 | 13 14 | 15 16 | c +-------+--------+--------+ c | 17 18 | 0 0 | 0 0 | c | 22 23 | 0 0 | 0 0 | c +-------+--------+--------+ c c For this matrix: n = 3 c m = 2 c nnz = 5 c----------------------------------------------------------------------- c Data structure in Block Sparse Row format: c------------------------------------------- c Array A: c------------------------- c 1 3 9 11 17 <<--each m x m block is stored column-wise c 5 7 13 15 22 in a column of the array A. c 2 4 10 12 18 c 6 8 14 16 23 c------------------------- c JA 1 3 2 3 1 <<-- column indices for each block. Note that c------------------------- these indices are wrt block matrix. c IA 1 3 5 6 <<-- pointers to beginning of each block row c------------------------- in arrays A and JA. c----------------------------------------------------------------------- c locals c integer i, i1, i2, ij, ii, irow, j, jstart, k, krow, no logical val c val = (job.ne.0) no = n * m irow = 1 krow = 1 iao(irow) = 1 c----------------------------------------------------------------------- do 2 ii=1, n c c recall: n is the block-row dimension c i1 = ia(ii) i2 = ia(ii+1)-1 c c create m rows for each block row -- i.e., each k. c do 23 i=1,m do 21 k=i1, i2 jstart = m*(ja(k)-1) do 22 j=1,m ij = (j-1)*m + i if (val) ao(krow) = a(ij,k) jao(krow) = jstart+j krow = krow+1 22 continue 21 continue irow = irow+1 iao(irow) = krow 23 continue 2 continue return c-------------end-of-bsrcsr -------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine csrbsr (job,nrow,m,na,a,ja,ia,ao,jao,iao,iw,ierr) implicit none integer job,ierr,nrow,m,na,ia(nrow+1),ja(*),jao(na),iao(*),iw(*) real*8 a(*),ao(na,*) c----------------------------------------------------------------------- c Compressed Sparse Row to Block Sparse Row c----------------------------------------------------------------------- c c This subroutine converts a matrix stored in a general compressed a, c ja, ia format into a a block sparse row format a(m,m,*),ja(*),ia(*). c See routine bsrcsr for more details on data structure for block c matrices. c c NOTES: 1) the initial matrix does not have to have a block structure. c zero padding is done for general sparse matrices. c 2) For most practical purposes, na should be the same as m*m. c c----------------------------------------------------------------------- c c In what follows nr=1+(nrow-1)/m = block-row dimension of output matrix c c on entry: c---------- c c job = job indicator. c job = 0 -> only the pattern of output matrix is generated c job > 0 -> both pattern and values are generated. c job = -1 -> iao(1) will return the number of nonzero blocks, c in the output matrix. In this case jao(1:nr) is used as c workspace, ao is untouched, iao is untouched except iao(1) c c nrow = integer, the actual row dimension of the matrix. c c m = integer equal to the dimension of each block. m should be > 0. c c na = first dimension of array ao as declared in calling program. c na should be .ge. m*m. c c a, ja, c ia = input matrix stored in compressed sparse row format. c c on return: c----------- c c ao = real array containing the values of the matrix. For details c on the format see below. Each row of a contains the m x m c block matrix unpacked column-wise (this allows the user to c declare the array a as ao(m,m,*) on entry if desired). The c block rows are stored in sequence just as for the compressed c sparse row format. The block dimension of the output matrix c is nr = 1 + (nrow-1) / m. c c jao = integer array. containing the block-column indices of the c block-matrix. Each jao(k) is an integer between 1 and nr c containing the block column index of the block ao(*,k). c c iao = integer array of length nr+1. iao(i) points to the beginning c of block row number i in the arrays ao and jao. When job=-1 c iao(1) contains the number of nonzero blocks of the output c matrix and the rest of iao is unused. This is useful for c determining the lengths of ao and jao. c c ierr = integer, error code. c 0 -- normal termination c 1 -- m is equal to zero c 2 -- NA too small to hold the blocks (should be .ge. m**2) c c Work arrays: c------------- c iw = integer work array of dimension nr = 1 + (nrow-1) / m c c NOTES: c------- c 1) this code is not in place. c 2) see routine bsrcsr for details on data sctructure for block c sparse row format. c c----------------------------------------------------------------------- c nr is the block-dimension of the output matrix. c integer nr, m2, io, ko, ii, len, k, jpos, j, i, ij, jr, irow logical vals c----- ierr = 0 if (m*m .gt. na) ierr = 2 if (m .eq. 0) ierr = 1 if (ierr .ne. 0) return c----------------------------------------------------------------------- vals = (job .gt. 0) nr = 1 + (nrow-1) / m m2 = m*m ko = 1 io = 1 iao(io) = 1 len = 0 c c iw determines structure of block-row (nonzero indicator) c do j=1, nr iw(j) = 0 enddo c c big loop -- leap by m rows each time. c do ii=1, nrow, m irow = 0 c c go through next m rows -- make sure not to go beyond nrow. c do while (ii+irow .le. nrow .and. irow .le. m-1) do k=ia(ii+irow),ia(ii+irow+1)-1 c c block column index = (scalar column index -1) / m + 1 c j = ja(k)-1 jr = j/m + 1 j = j - (jr-1)*m jpos = iw(jr) if (jpos .eq. 0) then c c create a new block c iw(jr) = ko jao(ko) = jr if (vals) then c c initialize new block to zero -- then copy nonzero element c do i=1, m2 ao(i,ko) = 0.0d0 enddo ij = j*m + irow + 1 ao(ij,ko) = a(k) endif ko = ko+1 else c c copy column index and nonzero element c jao(jpos) = jr ij = j*m + irow + 1 if (vals) ao(ij,jpos) = a(k) endif enddo irow = irow+1 enddo c c refresh iw c do j = iao(io),ko-1 iw(jao(j)) = 0 enddo if (job .eq. -1) then len = len + ko-1 ko = 1 else io = io+1 iao(io) = ko endif enddo if (job .eq. -1) iao(1) = len c return c--------------end-of-csrbsr-------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine csrbnd (n,a,ja,ia,job,abd,nabd,lowd,ml,mu,ierr) real*8 a(*),abd(nabd,n) integer ia(n+1),ja(*) c----------------------------------------------------------------------- c Compressed Sparse Row to Banded (Linpack ) format. c----------------------------------------------------------------------- c this subroutine converts a general sparse matrix stored in c compressed sparse row format into the banded format. for the c banded format,the Linpack conventions are assumed (see below). c----------------------------------------------------------------------- c on entry: c---------- c n = integer,the actual row dimension of the matrix. c c a, c ja, c ia = input matrix stored in compressed sparse row format. c c job = integer. if job=1 then the values of the lower bandwith ml c and the upper bandwidth mu are determined internally. c otherwise it is assumed that the values of ml and mu c are the correct bandwidths on input. See ml and mu below. c c nabd = integer. first dimension of array abd. c c lowd = integer. this should be set to the row number in abd where c the lowest diagonal (leftmost) of A is located. c lowd should be ( 1 .le. lowd .le. nabd). c if it is not known in advance what lowd should be c enter lowd = 0 and the default value lowd = ml+mu+1 c will be chosen. Alternative: call routine getbwd from unary c first to detrermione ml and mu then define lowd accordingly. c (Note: the banded solvers in linpack use lowd=2*ml+mu+1. ) c c ml = integer. equal to the bandwidth of the strict lower part of A c mu = integer. equal to the bandwidth of the strict upper part of A c thus the total bandwidth of A is ml+mu+1. c if ml+mu+1 is found to be larger than lowd then an error c flag is raised (unless lowd = 0). see ierr. c c note: ml and mu are assumed to have the correct bandwidth values c as defined above if job is set to zero on entry. c c on return: c----------- c c abd = real array of dimension abd(nabd,n). c on return contains the values of the matrix stored in c banded form. The j-th column of abd contains the elements c of the j-th column of the original matrix comprised in the c band ( i in (j-ml,j+mu) ) with the lowest diagonal at c the bottom row (row lowd). See details below for this format. c c ml = integer. equal to the bandwidth of the strict lower part of A c mu = integer. equal to the bandwidth of the strict upper part of A c if job=1 on entry then these two values are internally computed. c c lowd = integer. row number in abd where the lowest diagonal c (leftmost) of A is located on return. In case lowd = 0 c on return, then it is defined to ml+mu+1 on return and the c lowd will contain this value on return. ` c c ierr = integer. used for error messages. On return: c ierr .eq. 0 :means normal return c ierr .eq. -1 : means invalid value for lowd. (either .lt. 0 c or larger than nabd). c ierr .eq. -2 : means that lowd is not large enough and as c result the matrix cannot be stored in array abd. c lowd should be at least ml+mu+1, where ml and mu are as c provided on output. c c----------------------------------------------------------------------* c Additional details on banded format. (this closely follows the * c format used in linpack. may be useful for converting a matrix into * c this storage format in order to use the linpack banded solvers). * c----------------------------------------------------------------------* c --- band storage format for matrix abd --- * c uses ml+mu+1 rows of abd(nabd,*) to store the diagonals of * c a in rows of abd starting from the lowest (sub)-diagonal which is * c stored in row number lowd of abd. the minimum number of rows needed * c in abd is ml+mu+1, i.e., the minimum value for lowd is ml+mu+1. the * c j-th column of abd contains the elements of the j-th column of a, * c from bottom to top: the element a(j+ml,j) is stored in position * c abd(lowd,j), then a(j+ml-1,j) in position abd(lowd-1,j) and so on. * c Generally, the element a(j+k,j) of original matrix a is stored in * c position abd(lowd+k-ml,j), for k=ml,ml-1,..,0,-1, -mu. * c The first dimension nabd of abd must be .ge. lowd * c * c example [from linpack ]: if the original matrix is * c * c 11 12 13 0 0 0 * c 21 22 23 24 0 0 * c 0 32 33 34 35 0 original banded matrix * c 0 0 43 44 45 46 * c 0 0 0 54 55 56 * c 0 0 0 0 65 66 * c * c then n = 6, ml = 1, mu = 2. lowd should be .ge. 4 (=ml+mu+1) and * c if lowd = 5 for example, abd should be: * c * c untouched --> x x x x x x * c * * 13 24 35 46 * c * 12 23 34 45 56 resulting abd matrix in banded * c 11 22 33 44 55 66 format * c row lowd--> 21 32 43 54 65 * * c * c * = not used * c * c----------------------------------------------------------------------* c first determine ml and mu. c----------------------------------------------------------------------- ierr = 0 c----------- if (job .eq. 1) call getbwd(n,a,ja,ia,ml,mu) m = ml+mu+1 if (lowd .eq. 0) lowd = m if (m .gt. lowd) ierr = -2 if (lowd .gt. nabd .or. lowd .lt. 0) ierr = -1 if (ierr .lt. 0) return c------------ do 15 i=1,m ii = lowd -i+1 do 10 j=1,n abd(ii,j) = 0.0d0 10 continue 15 continue c--------------------------------------------------------------------- mdiag = lowd-ml do 30 i=1,n do 20 k=ia(i),ia(i+1)-1 j = ja(k) abd(i-j+mdiag,j) = a(k) 20 continue 30 continue return c------------- end of csrbnd ------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine bndcsr (n,abd,nabd,lowd,ml,mu,a,ja,ia,len,ierr) real*8 a(*),abd(nabd,*), t integer ia(n+1),ja(*) c----------------------------------------------------------------------- c Banded (Linpack ) format to Compressed Sparse Row format. c----------------------------------------------------------------------- c on entry: c---------- c n = integer,the actual row dimension of the matrix. c c nabd = first dimension of array abd. c c abd = real array containing the values of the matrix stored in c banded form. The j-th column of abd contains the elements c of the j-th column of the original matrix,comprised in the c band ( i in (j-ml,j+mu) ) with the lowest diagonal located c in row lowd (see below). c c lowd = integer. this should be set to the row number in abd where c the lowest diagonal (leftmost) of A is located. c lowd should be s.t. ( 1 .le. lowd .le. nabd). c The subroutines dgbco, ... of linpack use lowd=2*ml+mu+1. c c ml = integer. equal to the bandwidth of the strict lower part of A c mu = integer. equal to the bandwidth of the strict upper part of A c thus the total bandwidth of A is ml+mu+1. c if ml+mu+1 is found to be larger than nabd then an error c message is set. see ierr. c c len = integer. length of arrays a and ja. bndcsr will stop if the c length of the arrays a and ja is insufficient to store the c matrix. see ierr. c c on return: c----------- c a, c ja, c ia = input matrix stored in compressed sparse row format. c c lowd = if on entry lowd was zero then lowd is reset to the default c value ml+mu+l. c c ierr = integer. used for error message output. c ierr .eq. 0 :means normal return c ierr .eq. -1 : means invalid value for lowd. c ierr .gt. 0 : means that there was not enough storage in a and ja c for storing the ourput matrix. The process ran out of space c (as indicated by len) while trying to fill row number ierr. c This should give an idea of much more storage might be required. c Moreover, the first irow-1 rows are correctly filled. c c notes: the values in abd found to be equal to zero c ----- (actual test: if (abd(...) .eq. 0.0d0) are removed. c The resulting may not be identical to a csr matrix c originally transformed to a bnd format. c c----------------------------------------------------------------------- ierr = 0 c----------- if (lowd .gt. nabd .or. lowd .le. 0) then ierr = -1 return endif c----------- ko = 1 ia(1) = 1 do 30 irow=1,n c----------------------------------------------------------------------- i = lowd do 20 j=irow-ml,irow+mu if (j .le. 0 ) goto 19 if (j .gt. n) goto 21 t = abd(i,j) if (t .eq. 0.0d0) goto 19 if (ko .gt. len) then ierr = irow return endif a(ko) = t ja(ko) = j ko = ko+1 19 i = i-1 20 continue c end for row irow 21 ia(irow+1) = ko 30 continue return c------------- end of bndcsr ------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine csrssk (n,imod,a,ja,ia,asky,isky,nzmax,ierr) real*8 a(*),asky(nzmax) integer n, imod, nzmax, ierr, ia(n+1), isky(n+1), ja(*) c----------------------------------------------------------------------- c Compressed Sparse Row to Symmetric Skyline Format c or Symmetric Sparse Row c----------------------------------------------------------------------- c this subroutine translates a compressed sparse row or a symmetric c sparse row format into a symmetric skyline format. c the input matrix can be in either compressed sparse row or the c symmetric sparse row format. The output matrix is in a symmetric c skyline format: a real array containing the (active portions) of the c rows in sequence and a pointer to the beginning of each row. c c This module is NOT in place. c----------------------------------------------------------------------- c Coded by Y. Saad, Oct 5, 1989. Revised Feb. 18, 1991. c----------------------------------------------------------------------- c c on entry: c---------- c n = integer equal to the dimension of A. c imod = integer indicating the variant of skyline format wanted: c imod = 0 means the pointer isky points to the `zeroth' c element of the row, i.e., to the position of the diagonal c element of previous row (for i=1, isky(1)= 0) c imod = 1 means that itpr points to the beginning of the row. c imod = 2 means that isky points to the end of the row (diagonal c element) c c a = real array of size nna containing the nonzero elements c ja = integer array of size nnz containing the column positions c of the corresponding elements in a. c ia = integer of size n+1. ia(k) contains the position in a, ja of c the beginning of the k-th row. c nzmax = integer. must be set to the number of available locations c in the output array asky. c c on return: c---------- c c asky = real array containing the values of the matrix stored in skyline c format. asky contains the sequence of active rows from c i=1, to n, an active row being the row of elemnts of c the matrix contained between the leftmost nonzero element c and the diagonal element. c isky = integer array of size n+1 containing the pointer array to c each row. The meaning of isky depends on the input value of c imod (see above). c ierr = integer. Error message. If the length of the c output array asky exceeds nzmax. ierr returns the minimum value c needed for nzmax. otherwise ierr=0 (normal return). c c Notes: c 1) This module is NOT in place. c 2) even when imod = 2, length of isky is n+1, not n. c c----------------------------------------------------------------------- c first determine individial bandwidths and pointers. c----------------------------------------------------------------------- ierr = 0 isky(1) = 0 do 3 i=1,n ml = 0 do 31 k=ia(i),ia(i+1)-1 ml = max(ml,i-ja(k)+1) 31 continue isky(i+1) = isky(i)+ml 3 continue c c test if there is enough space asky to do the copying. c nnz = isky(n+1) if (nnz .gt. nzmax) then ierr = nnz return endif c c fill asky with zeros. c do 1 k=1, nnz asky(k) = 0.0d0 1 continue c c copy nonzero elements. c do 4 i=1,n kend = isky(i+1) do 41 k=ia(i),ia(i+1)-1 j = ja(k) if (j .le. i) asky(kend+j-i) = a(k) 41 continue 4 continue c c modify pointer according to imod if necessary. c if (imod .eq. 0) return if (imod .eq. 1) then do 50 k=1, n+1 isky(k) = isky(k)+1 50 continue endif if (imod .eq. 2) then do 60 k=1, n isky(k) = isky(k+1) 60 continue endif c return c------------- end of csrssk ------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine sskssr (n,imod,asky,isky,ao,jao,iao,nzmax,ierr) real*8 asky(*),ao(nzmax) integer n, imod,nzmax,ierr, isky(n+1),iao(n+1),jao(nzmax) c----------------------------------------------------------------------- c Symmetric Skyline Format to Symmetric Sparse Row format. c----------------------------------------------------------------------- c tests for exact zeros in skyline matrix (and ignores them in c output matrix). In place routine (a, isky :: ao, iao) c----------------------------------------------------------------------- c this subroutine translates a symmetric skyline format into a c symmetric sparse row format. Each element is tested to see if it is c a zero element. Only the actual nonzero elements are retained. Note c that the test used is simple and does take into account the smallness c of a value. the subroutine filter (see unary module) can be used c for this purpose. c----------------------------------------------------------------------- c Coded by Y. Saad, Oct 5, 1989. Revised Feb 18, 1991./ c----------------------------------------------------------------------- c c on entry: c---------- c n = integer equal to the dimension of A. c imod = integer indicating the variant of skyline format used: c imod = 0 means the pointer iao points to the `zeroth' c element of the row, i.e., to the position of the diagonal c element of previous row (for i=1, iao(1)= 0) c imod = 1 means that itpr points to the beginning of the row. c imod = 2 means that iao points to the end of the row c (diagonal element) c asky = real array containing the values of the matrix. asky contains c the sequence of active rows from i=1, to n, an active row c being the row of elemnts of the matrix contained between the c leftmost nonzero element and the diagonal element. c isky = integer array of size n+1 containing the pointer array to c each row. isky (k) contains the address of the beginning of the c k-th active row in the array asky. c nzmax = integer. equal to the number of available locations in the c output array ao. c c on return: c ---------- c ao = real array of size nna containing the nonzero elements c jao = integer array of size nnz containing the column positions c of the corresponding elements in a. c iao = integer of size n+1. iao(k) contains the position in a, ja of c the beginning of the k-th row. c ierr = integer. Serving as error message. If the length of the c output arrays ao, jao exceeds nzmax then ierr returns c the row number where the algorithm stopped: rows c i, to ierr-1 have been processed succesfully. c ierr = 0 means normal return. c ierr = -1 : illegal value for imod c Notes: c------- c This module is in place: ao and iao can be the same as asky, and isky. c----------------------------------------------------------------------- c local variables integer next, kend, kstart, i, j ierr = 0 c c check for validity of imod c if (imod.ne.0 .and. imod.ne.1 .and. imod .ne. 2) then ierr =-1 return endif c c next = pointer to next available position in output matrix c kend = pointer to end of current row in skyline matrix. c next = 1 c c set kend = start position -1 in skyline matrix. c kend = 0 if (imod .eq. 1) kend = isky(1)-1 if (imod .eq. 0) kend = isky(1) c c loop through all rows c do 50 i=1,n c c save value of pointer to ith row in output matrix c iao(i) = next c c get beginnning and end of skyline row c kstart = kend+1 if (imod .eq. 0) kend = isky(i+1) if (imod .eq. 1) kend = isky(i+1)-1 if (imod .eq. 2) kend = isky(i) c c copy element into output matrix unless it is a zero element. c do 40 k=kstart,kend if (asky(k) .eq. 0.0d0) goto 40 j = i-(kend-k) jao(next) = j ao(next) = asky(k) next=next+1 if (next .gt. nzmax+1) then ierr = i return endif 40 continue 50 continue iao(n+1) = next return c-------------end-of-sskssr -------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine csrjad (nrow, a, ja, ia, idiag, iperm, ao, jao, iao) integer ja(*), jao(*), ia(nrow+1), iperm(nrow), iao(nrow) real*8 a(*), ao(*) c----------------------------------------------------------------------- c Compressed Sparse Row to JAgged Diagonal storage. c----------------------------------------------------------------------- c this subroutine converts matrix stored in the compressed sparse c row format to the jagged diagonal format. The data structure c for the JAD (Jagged Diagonal storage) is as follows. The rows of c the matrix are (implicitly) permuted so that their lengths are in c decreasing order. The real entries ao(*) and their column indices c jao(*) are stored in succession. The number of such diagonals is idiag. c the lengths of each of these diagonals is stored in iao(*). c For more details see [E. Anderson and Y. Saad, c ``Solving sparse triangular systems on parallel computers'' in c Inter. J. of High Speed Computing, Vol 1, pp. 73-96 (1989).] c or [Y. Saad, ``Krylov Subspace Methods on Supercomputers'' c SIAM J. on Stat. Scient. Comput., volume 10, pp. 1200-1232 (1989).] c----------------------------------------------------------------------- c on entry: c---------- c nrow = row dimension of the matrix A. c c a, c ia, c ja = input matrix in compressed sparse row format. c c on return: c---------- c c idiag = integer. The number of jagged diagonals in the matrix. c c iperm = integer array of length nrow containing the permutation c of the rows that leads to a decreasing order of the c number of nonzero elements. c c ao = real array containing the values of the matrix A in c jagged diagonal storage. The j-diagonals are stored c in ao in sequence. c c jao = integer array containing the column indices of the c entries in ao. c c iao = integer array containing pointers to the beginning c of each j-diagonal in ao, jao. iao is also used as c a work array and it should be of length n at least. c c----------------------------------------------------------------------- c ---- define initial iperm and get lengths of each row c ---- jao is used a work vector to store tehse lengths c idiag = 0 ilo = nrow do 10 j=1, nrow iperm(j) = j len = ia(j+1) - ia(j) ilo = min(ilo,len) idiag = max(idiag,len) jao(j) = len 10 continue c c call sorter to get permutation. use iao as work array. c call dcsort (jao, nrow, iao, iperm, ilo, idiag) c c define output data structure. first lengths of j-diagonals c do 20 j=1, nrow iao(j) = 0 20 continue do 40 k=1, nrow len = jao(iperm(k)) do 30 i=1,len iao(i) = iao(i)+1 30 continue 40 continue c c get the output matrix itself c k1 = 1 k0 = k1 do 60 jj=1, idiag len = iao(jj) do 50 k=1,len i = ia(iperm(k))+jj-1 ao(k1) = a(i) jao(k1) = ja(i) k1 = k1+1 50 continue iao(jj) = k0 k0 = k1 60 continue iao(idiag+1) = k1 return c----------end-of-csrjad------------------------------------------------ c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine jadcsr (nrow, idiag, a, ja, ia, iperm, ao, jao, iao) integer ja(*), jao(*), ia(idiag+1), iperm(nrow), iao(nrow+1) real*8 a(*), ao(*) c----------------------------------------------------------------------- c Jagged Diagonal Storage to Compressed Sparse Row c----------------------------------------------------------------------- c this subroutine converts a matrix stored in the jagged diagonal format c to the compressed sparse row format. c----------------------------------------------------------------------- c on entry: c---------- c nrow = integer. the row dimension of the matrix A. c c idiag = integer. The number of jagged diagonals in the data c structure a, ja, ia. c c a, c ja, c ia = input matrix in jagged diagonal format. c c iperm = permutation of the rows used to obtain the JAD ordering. c c on return: c---------- c c ao, jao, c iao = matrix in CSR format. c----------------------------------------------------------------------- c determine first the pointers for output matrix. Go through the c structure once: c do 137 j=1,nrow jao(j) = 0 137 continue c c compute the lengths of each row of output matrix - c do 140 i=1, idiag len = ia(i+1)-ia(i) do 138 k=1,len jao(iperm(k)) = jao(iperm(k))+1 138 continue 140 continue c c remember to permute c kpos = 1 iao(1) = 1 do 141 i=1, nrow kpos = kpos+jao(i) iao(i+1) = kpos 141 continue c c copy elemnts one at a time. c do 200 jj = 1, idiag k1 = ia(jj)-1 len = ia(jj+1)-k1-1 do 160 k=1,len kpos = iao(iperm(k)) ao(kpos) = a(k1+k) jao(kpos) = ja(k1+k) iao(iperm(k)) = kpos+1 160 continue 200 continue c c rewind pointers c do 5 j=nrow,1,-1 iao(j+1) = iao(j) 5 continue iao(1) = 1 return c----------end-of-jadcsr------------------------------------------------ c----------------------------------------------------------------------- end subroutine dcsort(ival, n, icnt, index, ilo, ihi) c----------------------------------------------------------------------- c Specifications for arguments: c ---------------------------- integer n, ilo, ihi, ival(n), icnt(ilo:ihi), index(n) c----------------------------------------------------------------------- c This routine computes a permutation which, when applied to the c input vector ival, sorts the integers in ival in descending c order. The permutation is represented by the vector index. The c permuted ival can be interpreted as follows: c ival(index(i-1)) .ge. ival(index(i)) .ge. ival(index(i+1)) c c A specialized sort, the distribution counting sort, is used c which takes advantage of the knowledge that c 1) The values are in the (small) range [ ilo, ihi ] c 2) Values are likely to be repeated often c c contributed to SPARSKIT by Mike Heroux. (Cray Research) c --------------------------------------- c----------------------------------------------------------------------- c Usage: c------ c call dcsort( ival, n, icnt, index, ilo, ihi ) c c Arguments: c----------- c ival integer array (input) c On entry, ia is an n dimensional array that contains c the values to be sorted. ival is unchanged on exit. c c n integer (input) c On entry, n is the number of elements in ival and index. c c icnt integer (work) c On entry, is an integer work vector of length c (ihi - ilo + 1). c c index integer array (output) c On exit, index is an n-length integer vector containing c the permutation which sorts the vector ival. c c ilo integer (input) c On entry, ilo is .le. to the minimum value in ival. c c ihi integer (input) c On entry, ihi is .ge. to the maximum value in ival. c c Remarks: c--------- c The permutation is NOT applied to the vector ival. c c---------------------------------------------------------------- c c Local variables: c Other integer values are temporary indices. c c Author: c-------- c Michael Heroux c Sandra Carney c Mathematical Software Research Group c Cray Research, Inc. c c References: c Knuth, Donald E., "The Art of Computer Programming, Volume 3: c Sorting and Searching," Addison-Wesley, Reading, Massachusetts, c 1973, pp. 78-79. c c Revision history: c 05/09/90: Original implementation. A variation of the c Distribution Counting Sort recommended by c Sandra Carney. (Mike Heroux) c c----------------------------------------------------------------- c ---------------------------------- c Specifications for local variables c ---------------------------------- integer i, j, ivalj c c -------------------------- c First executable statement c -------------------------- do 10 i = ilo, ihi icnt(i) = 0 10 continue c do 20 i = 1, n icnt(ival(i)) = icnt(ival(i)) + 1 20 continue c do 30 i = ihi-1,ilo,-1 icnt(i) = icnt(i) + icnt(i+1) 30 continue c do 40 j = n, 1, -1 ivalj = ival(j) index(icnt(ivalj)) = j icnt(ivalj) = icnt(ivalj) - 1 40 continue return end c-------end-of-dcsort--------------------------------------------------- c----------------------------------------------------------------------- subroutine cooell(job,n,nnz,a,ja,ia,ao,jao,lda,ncmax,nc,ierr) implicit none integer job,n,nnz,lda,ncmax,nc,ierr integer ja(nnz),ia(nnz),jao(lda,ncmax) real*8 a(nnz),ao(lda,ncmax) c----------------------------------------------------------------------- c COOrdinate format to ELLpack format c----------------------------------------------------------------------- c On entry: c job -- 0 if only pattern is to be processed(AO is not touched) c n -- number of rows in the matrix c a,ja,ia -- input matix in COO format c lda -- leading dimension of array AO and JAO c ncmax -- size of the second dimension of array AO and JAO c c On exit: c ao,jao -- the matrix in ELL format c nc -- maximum number of nonzeros per row c ierr -- 0 if convertion succeeded c -1 if LDA < N c nc if NC > ncmax c c NOTE: the last column of JAO is used as work space!! c----------------------------------------------------------------------- integer i,j,k,ip real*8 zero logical copyval parameter (zero=0.0D0) c .. first executable statement .. copyval = (job.ne.0) if (lda .lt. n) then ierr = -1 return endif c .. use the last column of JAO as workspace c .. initialize the work space do i = 1, n jao(i,ncmax) = 0 enddo nc = 0 c .. go through ia and ja to find out number nonzero per row do k = 1, nnz i = ia(k) jao(i,ncmax) = jao(i,ncmax) + 1 enddo c .. maximum number of nonzero per row nc = 0 do i = 1, n if (nc.lt.jao(i,ncmax)) nc = jao(i,ncmax) jao(i,ncmax) = 0 enddo c .. if nc > ncmax retrun now if (nc.gt.ncmax) then ierr = nc return endif c .. go through ia and ja to copy the matrix to AO and JAO do k = 1, nnz i = ia(k) j = ja(k) jao(i,ncmax) = jao(i,ncmax) + 1 ip = jao(i,ncmax) if (ip.gt.nc) nc = ip if (copyval) ao(i,ip) = a(k) jao(i,ip) = j enddo c .. fill the unspecified elements of AO and JAO with zero diagonals do i = 1, n do j = ia(i+1)-ia(i)+1, nc jao(i,j)=i if(copyval) ao(i,j) = zero enddo enddo ierr = 0 c return end c-----end-of-cooell----------------------------------------------------- c----------------------------------------------------------------------- subroutine xcooell(n,nnz,a,ja,ia,ac,jac,nac,ner,ncmax,ierr) C----------------------------------------------------------------------- C coordinate format to ellpack format. C----------------------------------------------------------------------- C C DATE WRITTEN: June 4, 1989. C C PURPOSE C ------- C This subroutine takes a sparse matrix in coordinate format and C converts it into the Ellpack-Itpack storage. C C Example: C ------- C ( 11 0 13 0 0 0 ) C | 21 22 0 24 0 0 | C | 0 32 33 0 35 0 | C A = | 0 0 43 44 0 46 | C | 51 0 0 54 55 0 | C ( 61 62 0 0 65 66 ) C C Coordinate storage scheme: C C A = (11,22,33,44,55,66,13,21,24,32,35,43,46,51,54,61,62,65) C IA = (1, 2, 3, 4, 5, 6, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 6 ) C JA = ( 1, 2, 3, 4, 5, 6, 3, 1, 4, 2, 5, 3, 6, 1, 4, 1, 2, 5) C C Ellpack-Itpack storage scheme: C C ( 11 13 0 0 ) ( 1 3 * * ) C | 22 21 24 0 | | 2 1 4 * | C AC = | 33 32 35 0 | JAC = | 3 2 5 * | C | 44 43 46 0 | | 4 3 6 * | C | 55 51 54 0 | | 5 1 4 * | C ( 66 61 62 65 ) ( 6 1 2 5 ) C C Note: * means that you can store values from 1 to 6 (1 to n, where C n is the order of the matrix) in that position in the array. C C Contributed by: C --------------- C Ernest E. Rothman C Cornell Thoery Center/Cornell National Supercomputer Facility C e-mail address: BITNET: EER@CORNELLF.BITNET C INTERNET: eer@cornellf.tn.cornell.edu C C checked and modified 04/13/90 Y.Saad. C C REFERENCES C ---------- C Kincaid, D. R.; Oppe, T. C.; Respess, J. R.; Young, D. M. 1984. C ITPACKV 2C User's Guide, CNA-191. Center for Numerical Analysis, C University of Texas at Austin. C C "Engineering and Scientific Subroutine Library; Guide and C Reference; Release 3 (SC23-0184-3). Pp. 79-86. C C----------------------------------------------------------------------- C C INPUT PARAMETERS C ---------------- C N - Integer. The size of the square matrix. C C NNZ - Integer. Must be greater than or equal to the number of C nonzero elements in the sparse matrix. Dimension of A, IA C and JA. C C NCA - Integer. First dimension of output arrays ca and jac. C C A(NNZ) - Real array. (Double precision) C Stored entries of the sparse matrix A. C NNZ is the number of nonzeros. C C IA(NNZ) - Integer array. C Pointers to specify rows for the stored nonzero entries C in A. C C JA(NNZ) - Integer array. C Pointers to specify columns for the stored nonzero C entries in A. C C NER - Integer. Must be set greater than or equal to the maximum C number of nonzeros in any row of the sparse matrix. C C OUTPUT PARAMETERS C ----------------- C AC(NAC,*) - Real array. (Double precision) C Stored entries of the sparse matrix A in compressed C storage mode. C C JAC(NAC,*) - Integer array. C Contains the column numbers of the sparse matrix C elements stored in the corresponding positions in C array AC. C C NCMAX - Integer. Equals the maximum number of nonzeros in any C row of the sparse matrix. C C IERR - Error parameter is returned as zero on successful C execution of the subroutin (N,K) C MODIFIE LE VECTEUR DE PIVOTAGE EN CONSEQUENCE C C C DESCRIPTION DES PARAMETRES C ++++++++++++++++++++++++++ C C NMAX = DIMENSION DES TABLEAUX C N = NOMBRE D'EQUATIONS C K = NUMERO DE L'ETAPE C LU(NMAX,NMAX) = MATRICE LU C PIV(N) = VECTEUR DE PIVOTAGE DES LIGNES DE A C C INTEGER NMAX,N,K,PIV(N) REAL*8 LU(NMAX,NMAX) INTEGER I,JMAX REAL*8 VA,VMAX VMAX = ABS(LU(PIV(K),K)) JMAX = K DO I=K+1,N VA=ABS(LU(PIV(I),K)) IF (VA.GT.VMAX) THEN VMAX = VA JMAX = I ENDIF ENDDO I = PIV(K) PIV(K) = PIV(JMAX) PIV(JMAX) = I END C C\* C------------------------------------------------------------------------------ SUBROUTINE GSFITE(IPARAM,RPARAM, & NMAX,N,A,B,X,LU,RES,DX,PIV,CONV) C------------------------------------------------------------------------------ C C +-----------------+------------------------------------------+----------+ C | PROGRAMMEUR | COMMENTAIRES | DATE | C +-----------------+------------------------------------------+----------+ C | UME MARC | | 02/09/91 | C +-----------------+------------------------------------------+----------+ C C BUT DE LA ROUTINE C +++++++++++++++++ C C AMELIORATION ITERATIVE DE LA SOLUTION X C C C DESCRIPTION DES PARAMETRES C ++++++++++++++++++++++++++ C C NMAX = DIMENSION DES TABLEAUX C N = NOMBRE D'EQUATIONS C A(NMAX,NMAX) = MATRICE A C B(N) = VECTEUR INDEPENDANT C X(N) = VECTEUR SOLUTION C LU(NMAX,NMAX) = MATRICE LU C RESN) = VECTEUR RESIDU C DX(N) = VECTEUR CORRECTION DE LA SOLUTION C PIV(N) = VECTEUR DE PIVOTAGE DES LIGNES DE A C CONV : 0 = PAS DE CONVERGENCE EN N/10 ITERATIONS C 1 = CONVERGENCE (PRECISION = 1.E-5) C C INTEGER IPARAM(*) REAL*8 RPARAM(*) INTEGER CONV INTEGER NMAX,N,PIV(N) REAL*8 A(NMAX,NMAX),B(N),X(N) REAL*8 LU(NMAX,NMAX),RES(N),DX(N) INTEGER I,J,ITE REAL*8 PREC,DXMAX,DERR,DAV REAL*8 VAL PREC = RPARAM(1) DO ITE=1,IPARAM(4) DO I = 1,N VAL = 0.0D0 DO J = 1,N VAL = VAL + DBLE(A(I,J)) * DBLE(X(J)) ENDDO RES(I) = DBLE(B(I)) - VAL ENDDO CALL GAUFBA(NMAX,N,LU,PIV,RES,DX) DO I=1,N X(I) = X(I) + DX(I) ENDDO DXMAX = 0.0D0 DO I=1,N IF (X(I).EQ.0.0D0) THEN DERR = ABS(DX(I)) ELSE DERR = ABS(DX(I)/X(I)) ENDIF IF (DERR.GT.DXMAX) DXMAX = DERR ENDDO WRITE(*,'(A,E12.5,$)')'= ERREUR REL. MAX. ',DXMAX WRITE(*,'(A,$)')' =' WRITE(*,'(A,$)')13 IF (DXMAX.LT.PREC) THEN CONV = 1 WRITE(*,*) RETURN ENDIF IF (IPARAM(3).EQ.1) THEN IF ((ITE.GT.2).AND.(DXMAX.GT.DAV)) THEN CONV = 0 WRITE(*,*) RETURN ENDIF ENDIF DAV = DXMAX ENDDO WRITE(*,*) CONV = 0 END getdp-2.7.0-source/contrib/Sparskit/blassm.f000644 001750 001750 00000104227 11266605601 022502 0ustar00geuzainegeuzaine000000 000000 c $Id: blassm.f,v 1.1 2008-04-11 06:01:06 geuzaine Exp $ c----------------------------------------------------------------------c c S P A R S K I T c c----------------------------------------------------------------------c c BASIC LINEAR ALGEBRA FOR SPARSE MATRICES. BLASSM MODULE c c----------------------------------------------------------------------c c amub : computes C = A*B c c aplb : computes C = A+B c c aplb1 : computes C = A+B [Sorted version: A, B, C sorted] c c aplsb : computes C = A + s B c c aplsb1 : computes C = A+sB [Sorted version: A, B, C sorted] c c apmbt : Computes C = A +/- transp(B) c c aplsbt : Computes C = A + s * transp(B) c c diamua : Computes C = Diag * A c c amudia : Computes C = A* Diag c c aplsca : Computes A:= A + s I (s = scalar) c c apldia : Computes C = A + Diag. c c----------------------------------------------------------------------c c Note: this module still incomplete. c c----------------------------------------------------------------------c subroutine amub (nrow,ncol,job,a,ja,ia,b,jb,ib, * c,jc,ic,nzmax,iw,ierr) real*8 a(*), b(*), c(*) integer ja(*),jb(*),jc(*),ia(nrow+1),ib(*),ic(*),iw(ncol) c----------------------------------------------------------------------- c performs the matrix by matrix product C = A B c----------------------------------------------------------------------- c on entry: c --------- c nrow = integer. The row dimension of A = row dimension of C c ncol = integer. The column dimension of B = column dimension of C c job = integer. Job indicator. When job = 0, only the structure c (i.e. the arrays jc, ic) is computed and the c real values are ignored. c c a, c ja, c ia = Matrix A in compressed sparse row format. c c b, c jb, c ib = Matrix B in compressed sparse row format. c c nzmax = integer. The length of the arrays c and jc. c amub will stop if the result matrix C has a number c of elements that exceeds exceeds nzmax. See ierr. c c on return: c---------- c c, c jc, c ic = resulting matrix C in compressed sparse row sparse format. c c ierr = integer. serving as error message. c ierr = 0 means normal return, c ierr .gt. 0 means that amub stopped while computing the c i-th row of C with i=ierr, because the number c of elements in C exceeds nzmax. c c work arrays: c------------ c iw = integer work array of length equal to the number of c columns in A. c Note: c------- c The row dimension of B is not needed. However there is no checking c on the condition that ncol(A) = nrow(B). c c----------------------------------------------------------------------- real*8 scal logical values values = (job .ne. 0) len = 0 ic(1) = 1 ierr = 0 c initialize array iw. do 1 j=1, ncol iw(j) = 0 1 continue c do 500 ii=1, nrow c row i do 200 ka=ia(ii), ia(ii+1)-1 if (values) scal = a(ka) jj = ja(ka) do 100 kb=ib(jj),ib(jj+1)-1 jcol = jb(kb) jpos = iw(jcol) if (jpos .eq. 0) then len = len+1 if (len .gt. nzmax) then ierr = ii return endif jc(len) = jcol iw(jcol)= len if (values) c(len) = scal*b(kb) else if (values) c(jpos) = c(jpos) + scal*b(kb) endif 100 continue 200 continue do 201 k=ic(ii), len iw(jc(k)) = 0 201 continue ic(ii+1) = len+1 500 continue return c-------------end-of-amub----------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine aplb (nrow,ncol,job,a,ja,ia,b,jb,ib, * c,jc,ic,nzmax,iw,ierr) real*8 a(*), b(*), c(*) integer ja(*),jb(*),jc(*),ia(nrow+1),ib(nrow+1),ic(nrow+1), * iw(ncol) c----------------------------------------------------------------------- c performs the matrix sum C = A+B. c----------------------------------------------------------------------- c on entry: c --------- c nrow = integer. The row dimension of A and B c ncol = integer. The column dimension of A and B. c job = integer. Job indicator. When job = 0, only the structure c (i.e. the arrays jc, ic) is computed and the c real values are ignored. c c a, c ja, c ia = Matrix A in compressed sparse row format. c c b, c jb, c ib = Matrix B in compressed sparse row format. c c nzmax = integer. The length of the arrays c and jc. c amub will stop if the result matrix C has a number c of elements that exceeds exceeds nzmax. See ierr. c c on return: c---------- c c, c jc, c ic = resulting matrix C in compressed sparse row sparse format. c c ierr = integer. serving as error message. c ierr = 0 means normal return, c ierr .gt. 0 means that amub stopped while computing the c i-th row of C with i=ierr, because the number c of elements in C exceeds nzmax. c c work arrays: c------------ c iw = integer work array of length equal to the number of c columns in A. c c----------------------------------------------------------------------- logical values values = (job .ne. 0) ierr = 0 len = 0 ic(1) = 1 do 1 j=1, ncol iw(j) = 0 1 continue c do 500 ii=1, nrow c row i do 200 ka=ia(ii), ia(ii+1)-1 len = len+1 jcol = ja(ka) if (len .gt. nzmax) goto 999 jc(len) = jcol if (values) c(len) = a(ka) iw(jcol)= len 200 continue c do 300 kb=ib(ii),ib(ii+1)-1 jcol = jb(kb) jpos = iw(jcol) if (jpos .eq. 0) then len = len+1 if (len .gt. nzmax) goto 999 jc(len) = jcol if (values) c(len) = b(kb) iw(jcol)= len else if (values) c(jpos) = c(jpos) + b(kb) endif 300 continue do 301 k=ic(ii), len iw(jc(k)) = 0 301 continue ic(ii+1) = len+1 500 continue return 999 ierr = ii return c------------end of aplb ----------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine aplb1(nrow,ncol,job,a,ja,ia,b,jb,ib,c,jc,ic,nzmax,ierr) real*8 a(*), b(*), c(*) integer ja(*),jb(*),jc(*),ia(nrow+1),ib(nrow+1),ic(nrow+1) c----------------------------------------------------------------------- c performs the matrix sum C = A+B for matrices in sorted CSR format. c the difference with aplb is that the resulting matrix is such that c the elements of each row are sorted with increasing column indices in c each row, provided the original matrices are sorted in the same way. c----------------------------------------------------------------------- c on entry: c --------- c nrow = integer. The row dimension of A and B c ncol = integer. The column dimension of A and B. c job = integer. Job indicator. When job = 0, only the structure c (i.e. the arrays jc, ic) is computed and the c real values are ignored. c c a, c ja, c ia = Matrix A in compressed sparse row format with entries sorted c c b, c jb, c ib = Matrix B in compressed sparse row format with entries sorted c ascendly in each row c c nzmax = integer. The length of the arrays c and jc. c amub will stop if the result matrix C has a number c of elements that exceeds exceeds nzmax. See ierr. c c on return: c---------- c c, c jc, c ic = resulting matrix C in compressed sparse row sparse format c with entries sorted ascendly in each row. c c ierr = integer. serving as error message. c ierr = 0 means normal return, c ierr .gt. 0 means that amub stopped while computing the c i-th row of C with i=ierr, because the number c of elements in C exceeds nzmax. c c Notes: c------- c this will not work if any of the two input matrices is not sorted c----------------------------------------------------------------------- logical values values = (job .ne. 0) ierr = 0 kc = 1 ic(1) = kc c do 6 i=1, nrow ka = ia(i) kb = ib(i) kamax = ia(i+1)-1 kbmax = ib(i+1)-1 5 continue if (ka .le. kamax) then j1 = ja(ka) else j1 = ncol+1 endif if (kb .le. kbmax) then j2 = jb(kb) else j2 = ncol+1 endif c c three cases c if (j1 .eq. j2) then if (values) c(kc) = a(ka)+b(kb) jc(kc) = j1 ka = ka+1 kb = kb+1 kc = kc+1 else if (j1 .lt. j2) then jc(kc) = j1 if (values) c(kc) = a(ka) ka = ka+1 kc = kc+1 else if (j1 .gt. j2) then jc(kc) = j2 if (values) c(kc) = b(kb) kb = kb+1 kc = kc+1 endif if (kc .gt. nzmax) goto 999 if (ka .le. kamax .or. kb .le. kbmax) goto 5 ic(i+1) = kc 6 continue return 999 ierr = i return c------------end-of-aplb1----------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine aplsb (nrow,ncol,a,ja,ia,s,b,jb,ib,c,jc,ic, * nzmax,ierr) real*8 a(*), b(*), c(*), s integer ja(*),jb(*),jc(*),ia(nrow+1),ib(nrow+1),ic(nrow+1) c----------------------------------------------------------------------- c performs the operation C = A+s B for matrices in sorted CSR format. c the difference with aplsb is that the resulting matrix is such that c the elements of each row are sorted with increasing column indices in c each row, provided the original matrices are sorted in the same way. c----------------------------------------------------------------------- c on entry: c --------- c nrow = integer. The row dimension of A and B c ncol = integer. The column dimension of A and B. c c a, c ja, c ia = Matrix A in compressed sparse row format with entries sorted c c s = real. scalar factor for B. c c b, c jb, c ib = Matrix B in compressed sparse row format with entries sorted c ascendly in each row c c nzmax = integer. The length of the arrays c and jc. c amub will stop if the result matrix C has a number c of elements that exceeds exceeds nzmax. See ierr. c c on return: c---------- c c, c jc, c ic = resulting matrix C in compressed sparse row sparse format c with entries sorted ascendly in each row. c c ierr = integer. serving as error message. c ierr = 0 means normal return, c ierr .gt. 0 means that amub stopped while computing the c i-th row of C with i=ierr, because the number c of elements in C exceeds nzmax. c c Notes: c------- c this will not work if any of the two input matrices is not sorted c----------------------------------------------------------------------- ierr = 0 kc = 1 ic(1) = kc c c the following loop does a merge of two sparse rows + adds them. c do 6 i=1, nrow ka = ia(i) kb = ib(i) kamax = ia(i+1)-1 kbmax = ib(i+1)-1 5 continue c c this is a while -- do loop -- c if (ka .le. kamax .or. kb .le. kbmax) then c if (ka .le. kamax) then j1 = ja(ka) else c take j1 large enough that always j2 .lt. j1 j1 = ncol+1 endif if (kb .le. kbmax) then j2 = jb(kb) else c similarly take j2 large enough that always j1 .lt. j2 j2 = ncol+1 endif c c three cases c if (j1 .eq. j2) then c(kc) = a(ka)+s*b(kb) jc(kc) = j1 ka = ka+1 kb = kb+1 kc = kc+1 else if (j1 .lt. j2) then jc(kc) = j1 c(kc) = a(ka) ka = ka+1 kc = kc+1 else if (j1 .gt. j2) then jc(kc) = j2 c(kc) = s*b(kb) kb = kb+1 kc = kc+1 endif if (kc .gt. nzmax) goto 999 goto 5 c c end while loop c endif ic(i+1) = kc 6 continue return 999 ierr = i return c------------end-of-aplsb --------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine aplsb1 (nrow,ncol,a,ja,ia,s,b,jb,ib,c,jc,ic, * nzmax,ierr) real*8 a(*), b(*), c(*), s integer ja(*),jb(*),jc(*),ia(nrow+1),ib(nrow+1),ic(nrow+1) c----------------------------------------------------------------------- c performs the operation C = A+s B for matrices in sorted CSR format. c the difference with aplsb is that the resulting matrix is such that c the elements of each row are sorted with increasing column indices in c each row, provided the original matrices are sorted in the same way. c----------------------------------------------------------------------- c on entry: c --------- c nrow = integer. The row dimension of A and B c ncol = integer. The column dimension of A and B. c c a, c ja, c ia = Matrix A in compressed sparse row format with entries sorted c c s = real. scalar factor for B. c c b, c jb, c ib = Matrix B in compressed sparse row format with entries sorted c ascendly in each row c c nzmax = integer. The length of the arrays c and jc. c amub will stop if the result matrix C has a number c of elements that exceeds exceeds nzmax. See ierr. c c on return: c---------- c c, c jc, c ic = resulting matrix C in compressed sparse row sparse format c with entries sorted ascendly in each row. c c ierr = integer. serving as error message. c ierr = 0 means normal return, c ierr .gt. 0 means that amub stopped while computing the c i-th row of C with i=ierr, because the number c of elements in C exceeds nzmax. c c Notes: c------- c this will not work if any of the two input matrices is not sorted c----------------------------------------------------------------------- ierr = 0 kc = 1 ic(1) = kc c c the following loop does a merge of two sparse rows + adds them. c do 6 i=1, nrow ka = ia(i) kb = ib(i) kamax = ia(i+1)-1 kbmax = ib(i+1)-1 5 continue c c this is a while -- do loop -- c if (ka .le. kamax .or. kb .le. kbmax) then c if (ka .le. kamax) then j1 = ja(ka) else c take j1 large enough that always j2 .lt. j1 j1 = ncol+1 endif if (kb .le. kbmax) then j2 = jb(kb) else c similarly take j2 large enough that always j1 .lt. j2 j2 = ncol+1 endif c c three cases c if (j1 .eq. j2) then c(kc) = a(ka)+s*b(kb) jc(kc) = j1 ka = ka+1 kb = kb+1 kc = kc+1 else if (j1 .lt. j2) then jc(kc) = j1 c(kc) = a(ka) ka = ka+1 kc = kc+1 else if (j1 .gt. j2) then jc(kc) = j2 c(kc) = s*b(kb) kb = kb+1 kc = kc+1 endif if (kc .gt. nzmax) goto 999 goto 5 c c end while loop c endif ic(i+1) = kc 6 continue return 999 ierr = i return c------------end-of-aplsb1 --------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine apmbt (nrow,ncol,job,a,ja,ia,b,jb,ib, * c,jc,ic,nzmax,iw,ierr) real*8 a(*), b(*), c(*) integer ja(*),jb(*),jc(*),ia(nrow+1),ib(ncol+1),ic(*),iw(*) c----------------------------------------------------------------------- c performs the matrix sum C = A + transp(B) or C = A - transp(B) c----------------------------------------------------------------------- c on entry: c --------- c nrow = integer. The row dimension of A and transp(B) c ncol = integer. The column dimension of A. Also the row c dimension of B. c c job = integer. if job = -1, apmbt will compute C= A - transp(B) c (structure + values) c if (job .eq. 1) it will compute C=A+transp(A) c (structure+ values) c if (job .eq. 0) it will compute the structure of c C= A+/-transp(B) only (ignoring all real values). c any other value of job will be treated as job=1 c a, c ja, c ia = Matrix A in compressed sparse row format. c c b, c jb, c ib = Matrix B in compressed sparse row format. c c nzmax = integer. The length of the arrays c, jc, and ic. c amub will stop if the result matrix C has a number c of elements that exceeds exceeds nzmax. See ierr. c c on return: c---------- c c, c jc, c ic = resulting matrix C in compressed sparse row format. c c ierr = integer. serving as error message. c ierr = 0 means normal return. c ierr = -1 means that nzmax was .lt. either the number of c nonzero elements of A or the number of nonzero elements in B. c ierr .gt. 0 means that amub stopped while computing the c i-th row of C with i=ierr, because the number c of elements in C exceeds nzmax. c c work arrays: c------------ c iw = integer work array of length at least max(ncol,nrow) c c Notes: c------- It is important to note that here all of three arrays c, ic, c and jc are assumed to be of length nnz(c). This is because c the matrix is internally converted in coordinate format. c c----------------------------------------------------------------------- logical values values = (job .ne. 0) c ierr = 0 do 1 j=1, ncol iw(j) = 0 1 continue c nnza = ia(nrow+1)-1 nnzb = ib(ncol+1)-1 len = nnzb if (nzmax .lt. nnzb .or. nzmax .lt. nnza) then ierr = -1 return endif c c trasnpose matrix b into c c ljob = 0 if (values) ljob = 1 ipos = 1 call csrcsc (ncol,ljob,ipos,b,jb,ib,c,jc,ic) c----------------------------------------------------------------------- if (job .eq. -1) then do 2 k=1,len c(k) = -c(k) 2 continue endif c c--------------- main loop -------------------------------------------- c do 500 ii=1, nrow do 200 k = ic(ii),ic(ii+1)-1 iw(jc(k)) = k 200 continue c----------------------------------------------------------------------- do 300 ka = ia(ii), ia(ii+1)-1 jcol = ja(ka) jpos = iw(jcol) if (jpos .eq. 0) then c c if fill-in append in coordinate format to matrix. c len = len+1 if (len .gt. nzmax) goto 999 jc(len) = jcol ic(len) = ii if (values) c(len) = a(ka) else c else do addition. if (values) c(jpos) = c(jpos) + a(ka) endif 300 continue do 301 k=ic(ii), ic(ii+1)-1 iw(jc(k)) = 0 301 continue 500 continue c c convert first part of matrix (without fill-ins) into coo format c ljob = 2 if (values) ljob = 3 do 501 i=1, nrow+1 iw(i) = ic(i) 501 continue call csrcoo (nrow,ljob,nnzb,c,jc,iw,nnzb,c,ic,jc,ierr) c c convert the whole thing back to csr format. c ljob = 0 if (values) ljob = 1 call coicsr (nrow,len,ljob,c,jc,ic,iw) return 999 ierr = ii return c--------end-of-apmbt--------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine aplsbt(nrow,ncol,a,ja,ia,s,b,jb,ib, * c,jc,ic,nzmax,iw,ierr) real*8 a(*), b(*), c(*), s integer ja(*),jb(*),jc(*),ia(nrow+1),ib(ncol+1),ic(*),iw(*) c----------------------------------------------------------------------- c performs the matrix sum C = A + transp(B). c----------------------------------------------------------------------- c on entry: c --------- c nrow = integer. The row dimension of A and transp(B) c ncol = integer. The column dimension of A. Also the row c dimension of B. c c a, c ja, c ia = Matrix A in compressed sparse row format. c c s = real. scalar factor for B. c c c b, c jb, c ib = Matrix B in compressed sparse row format. c c nzmax = integer. The length of the arrays c, jc, and ic. c amub will stop if the result matrix C has a number c of elements that exceeds exceeds nzmax. See ierr. c c on return: c---------- c c, c jc, c ic = resulting matrix C in compressed sparse row format. c c ierr = integer. serving as error message. c ierr = 0 means normal return. c ierr = -1 means that nzmax was .lt. either the number of c nonzero elements of A or the number of nonzero elements in B. c ierr .gt. 0 means that amub stopped while computing the c i-th row of C with i=ierr, because the number c of elements in C exceeds nzmax. c c work arrays: c------------ c iw = integer work array of length at least max(nrow,ncol) c c Notes: c------- It is important to note that here all of three arrays c, ic, c and jc are assumed to be of length nnz(c). This is because c the matrix is internally converted in coordinate format. c c----------------------------------------------------------------------- ierr = 0 do 1 j=1, ncol iw(j) = 0 1 continue c nnza = ia(nrow+1)-1 nnzb = ib(ncol+1)-1 len = nnzb if (nzmax .lt. nnzb .or. nzmax .lt. nnza) then ierr = -1 return endif c c transpose matrix b into c c ljob = 1 ipos = 1 call csrcsc (ncol,ljob,ipos,b,jb,ib,c,jc,ic) do 2 k=1,len 2 c(k) = c(k)*s c c main loop. add rows from ii = 1 to nrow. c do 500 ii=1, nrow c iw is used as a system to recognize whether there c was a nonzero element in c. do 200 k = ic(ii),ic(ii+1)-1 iw(jc(k)) = k 200 continue c do 300 ka = ia(ii), ia(ii+1)-1 jcol = ja(ka) jpos = iw(jcol) if (jpos .eq. 0) then c c if fill-in append in coordinate format to matrix. c len = len+1 if (len .gt. nzmax) goto 999 jc(len) = jcol ic(len) = ii c(len) = a(ka) else c else do addition. c(jpos) = c(jpos) + a(ka) endif 300 continue do 301 k=ic(ii), ic(ii+1)-1 iw(jc(k)) = 0 301 continue 500 continue c c convert first part of matrix (without fill-ins) into coo format c ljob = 3 do 501 i=1, nrow+1 iw(i) = ic(i) 501 continue call csrcoo (nrow,ljob,nnzb,c,jc,iw,nnzb,c,ic,jc,ierr) c c convert the whole thing back to csr format. c ljob = 1 call coicsr (nrow,len,ljob,c,jc,ic,iw) return 999 ierr = ii return c--------end-of-aplsbt-------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine diamua (nrow,job, a, ja, ia, diag, b, jb, ib) real*8 a(*), b(*), diag(nrow), scal integer ja(*),jb(*), ia(nrow+1),ib(nrow+1) c----------------------------------------------------------------------- c performs the matrix by matrix product B = Diag * A (in place) c----------------------------------------------------------------------- c on entry: c --------- c nrow = integer. The row dimension of A c c job = integer. job indicator. Job=0 means get array b only c job = 1 means get b, and the integer arrays ib, jb. c c a, c ja, c ia = Matrix A in compressed sparse row format. c c diag = diagonal matrix stored as a vector dig(1:n) c c on return: c---------- c c b, c jb, c ib = resulting matrix B in compressed sparse row sparse format. c c Notes: c------- c 1) The column dimension of A is not needed. c 2) algorithm in place (B can take the place of A). c in this case use job=0. c----------------------------------------------------------------- do 1 ii=1,nrow c c normalize each row c k1 = ia(ii) k2 = ia(ii+1)-1 scal = diag(ii) do 2 k=k1, k2 b(k) = a(k)*scal 2 continue 1 continue c if (job .eq. 0) return c do 3 ii=1, nrow+1 ib(ii) = ia(ii) 3 continue do 31 k=ia(1), ia(nrow+1) -1 jb(k) = ja(k) 31 continue return c----------end-of-diamua------------------------------------------------ c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine amudia (nrow,job, a, ja, ia, diag, b, jb, ib) real*8 a(*), b(*), diag(nrow) integer ja(*),jb(*), ia(nrow+1),ib(nrow+1) c----------------------------------------------------------------------- c performs the matrix by matrix product B = A * Diag (in place) c----------------------------------------------------------------------- c on entry: c --------- c nrow = integer. The row dimension of A c c job = integer. job indicator. Job=0 means get array b only c job = 1 means get b, and the integer arrays ib, jb. c c a, c ja, c ia = Matrix A in compressed sparse row format. c c diag = diagonal matrix stored as a vector dig(1:n) c c on return: c---------- c c b, c jb, c ib = resulting matrix B in compressed sparse row sparse format. c c Notes: c------- c 1) The column dimension of A is not needed. c 2) algorithm in place (B can take the place of A). c----------------------------------------------------------------- do 1 ii=1,nrow c c scale each element c k1 = ia(ii) k2 = ia(ii+1)-1 do 2 k=k1, k2 b(k) = a(k)*diag(ja(k)) 2 continue 1 continue c if (job .eq. 0) return c do 3 ii=1, nrow+1 ib(ii) = ia(ii) 3 continue do 31 k=ia(1), ia(nrow+1) -1 jb(k) = ja(k) 31 continue return c----------------------------------------------------------------------- c-----------end-of-amudiag---------------------------------------------- end c----------------------------------------------------------------------- subroutine aplsca (nrow, a, ja, ia, scal,iw) real*8 a(*), scal integer ja(*), ia(nrow+1),iw(*) c----------------------------------------------------------------------- c Adds a scalar to the diagonal entries of a sparse matrix A :=A + s I c----------------------------------------------------------------------- c on entry: c --------- c nrow = integer. The row dimension of A c c a, c ja, c ia = Matrix A in compressed sparse row format. c c scal = real. scalar to add to the diagonal entries. c c on return: c---------- c c a, c ja, c ia = matrix A with diagonal elements shifted (or created). c c iw = integer work array of length n. On return iw will c contain the positions of the diagonal entries in the c output matrix. (i.e., a(iw(k)), ja(iw(k)), k=1,...n, c are the values/column indices of the diagonal elements c of the output matrix. ). c c Notes: c------- c The column dimension of A is not needed. c important: the matrix a may be expanded slightly to allow for c additions of nonzero elements to previously nonexisting diagonals. c The is no checking as to whether there is enough space appended c to the arrays a and ja. if not sure allow for n additional c elemnts. c coded by Y. Saad. Latest version July, 19, 1990 c----------------------------------------------------------------------- logical test c call diapos (nrow,ja,ia,iw) icount = 0 do 1 j=1, nrow if (iw(j) .eq. 0) then icount = icount+1 else a(iw(j)) = a(iw(j)) + scal endif 1 continue c c if no diagonal elements to insert in data structure return. c if (icount .eq. 0) return c c shift the nonzero elements if needed, to allow for created c diagonal elements. c ko = ia(nrow+1)+icount c c copy rows backward c do 5 ii=nrow, 1, -1 c c go through row ii c k1 = ia(ii) k2 = ia(ii+1)-1 ia(ii+1) = ko test = (iw(ii) .eq. 0) do 4 k = k2,k1,-1 j = ja(k) if (test .and. (j .lt. ii)) then test = .false. ko = ko - 1 a(ko) = scal ja(ko) = ii iw(ii) = ko endif ko = ko-1 a(ko) = a(k) ja(ko) = j 4 continue c diagonal element has not been added yet. if (test) then ko = ko-1 a(ko) = scal ja(ko) = ii iw(ii) = ko endif 5 continue ia(1) = ko return c----------------------------------------------------------------------- c----------end-of-aplsca------------------------------------------------ end c----------------------------------------------------------------------- subroutine apldia (nrow, job, a, ja, ia, diag, b, jb, ib, iw) real*8 a(*), b(*), diag(nrow) integer ja(*),jb(*), ia(nrow+1),ib(nrow+1), iw(*) c----------------------------------------------------------------------- c Adds a diagonal matrix to a general sparse matrix: B = A + Diag c----------------------------------------------------------------------- c on entry: c --------- c nrow = integer. The row dimension of A c c job = integer. job indicator. Job=0 means get array b only c (i.e. assume that a has already been copied into array b, c or that algorithm is used in place. ) For all practical c purposes enter job=0 for an in-place call and job=1 otherwise c c Note: in case there are missing diagonal elements in A, c then the option job =0 will be ignored, since the algorithm c must modify the data structure (i.e. jb, ib) in this c situation. c c a, c ja, c ia = Matrix A in compressed sparse row format. c c diag = diagonal matrix stored as a vector dig(1:n) c c on return: c---------- c c b, c jb, c ib = resulting matrix B in compressed sparse row sparse format. c c c iw = integer work array of length n. On return iw will c contain the positions of the diagonal entries in the c output matrix. (i.e., a(iw(k)), ja(iw(k)), k=1,...n, c are the values/column indices of the diagonal elements c of the output matrix. ). c c Notes: c------- c 1) The column dimension of A is not needed. c 2) algorithm in place (b, jb, ib, can be the same as c a, ja, ia, on entry). See comments for parameter job. c c coded by Y. Saad. Latest version July, 19, 1990 c----------------------------------------------------------------- logical test c c copy integer arrays into b's data structure if required c if (job .ne. 0) then nnz = ia(nrow+1)-1 do 2 k=1, nnz jb(k) = ja(k) b(k) = a(k) 2 continue do 3 k=1, nrow+1 ib(k) = ia(k) 3 continue endif c c get positions of diagonal elements in data structure. c call diapos (nrow,ja,ia,iw) c c count number of holes in diagonal and add diag(*) elements to c valid diagonal entries. c icount = 0 do 1 j=1, nrow if (iw(j) .eq. 0) then icount = icount+1 else b(iw(j)) = a(iw(j)) + diag(j) endif 1 continue c c if no diagonal elements to insert return c if (icount .eq. 0) return c c shift the nonzero elements if needed, to allow for created c diagonal elements. c ko = ib(nrow+1)+icount c c copy rows backward c do 5 ii=nrow, 1, -1 c c go through row ii c k1 = ib(ii) k2 = ib(ii+1)-1 ib(ii+1) = ko test = (iw(ii) .eq. 0) do 4 k = k2,k1,-1 j = jb(k) if (test .and. (j .lt. ii)) then test = .false. ko = ko - 1 b(ko) = diag(ii) jb(ko) = ii iw(ii) = ko endif ko = ko-1 b(ko) = a(k) jb(ko) = j 4 continue c diagonal element has not been added yet. if (test) then ko = ko-1 b(ko) = diag(ii) jb(ko) = ii iw(ii) = ko endif 5 continue ib(1) = ko return c----------------------------------------------------------------------- c------------end-of-apldiag--------------------------------------------- end getdp-2.7.0-source/contrib/Sparskit/Sparskit.h000644 001750 001750 00000011436 12010200204 022774 0ustar00geuzainegeuzaine000000 000000 #ifndef _SPARSKIT_H_ #define _SPARSKIT_H_ #include "ListUtils.h" #define ELAP 1 #define KUL 2 #define NONE 0 #define SPARSE 1 #define DENSE 2 #define CSR 1 /* Compressed Sparse Row */ #define CSC 2 /* Compressed Sparse Column */ #define MSR 3 /* Modified Sparse Row */ #define COO 4 /* Coordinate */ #define CG 1 #define CGNR 2 #define BCG 3 #define DBCG 4 #define BCGSTAB 5 #define TFQMR 6 #define FOM 7 #define GMRES 8 #define FGMRES 9 #define DQGMRES 10 #define LU 11 #define PGMRES 12 #define ILUT 1 #define ILUTP 2 #define ILUD 3 #define ILUDP 4 #define ILUK 5 #define ILU0 6 #define MILU0 7 #define DIAGONAL 8 #define RCMK 1 #define DIAG_SCALING 1 #define MAX_SCALING 2 #define NORM1_SCALING 3 #define NORM2_SCALING 4 #if defined(HAVE_ILU_FLOAT) #define sscalar float #else #define sscalar double #endif typedef struct { /* sparse matrix */ List_T *a; List_T *jptr, *ai, *ptr; /* permuted matrix */ double *a_rcmk ; int *ia_rcmk, *ja_rcmk; /* permutation vectors */ int *permr, *permp, *rpermr; /* ILU decomposition */ sscalar *alu; int *jlu, *ju; }Sparse_Matrix; typedef struct { int LU_Exist; double *a, *lu; }Dense_Matrix; typedef struct{ int T, N, changed, ILU_Exists, notranspose, scaled; double *rowscal, *colscal; Sparse_Matrix S; Dense_Matrix F; }Matrix; typedef struct { int Matrix_Format; int Matrix_Printing; int Matrix_Storage; int Scaling ; int Renumbering_Technique; int Preconditioner; int Preconditioner_Position; int Nb_Fill; double Dropping_Tolerance; double Permutation_Tolerance; double Diagonal_Compensation; int Re_Use_ILU; int Algorithm; int Krylov_Size; double IC_Acceleration; int Iterative_Improvement; int Re_Use_LU; int Nb_Iter_Max; double Stopping_Test; }Solver_Params; void init_solver(Solver_Params *p, const char *name); void init_solver_option(Solver_Params *p, const char *name, const char *value); void init_matrix(int Nb, Matrix *M, Solver_Params *p); void init_vector(int Nb, double **V); void free_matrix(Matrix *M); void zero_matrix(Matrix *M); void zero_matrix2(Matrix *M); void zero_vector(int Nb, double *V); void copy_vector(int Nb, double *U, double *V); void add_vector_vector(int Nb, double *U, double *V); void add_vector_prod_vector_double(int Nb, double *U, double *V, double d); void add_matrix_double(Matrix *M, int il, int ic, double val); void add_matrix_matrix(Matrix *M, Matrix *N); void add_matrix_prod_matrix_double(Matrix *M, Matrix *N, double d); void sub_vector_vector_1(int Nb, double *U, double *V); void sub_vector_vector_2(int Nb, double *U, double *V); void prod_vector_double(int Nb, double *U, double a); void prodsc_vector_vector(int Nb, double *U, double *V, double *prosca); void prodsc_vectorconj_vector(int Nb, double *U, double *V, double *proscar, double *proscai); void prod_matrix_vector(Matrix *M, double *v, double *res); void prod_matrix_double(Matrix *M, double v); void multi_prod_matrix_double(int n, Matrix **Mat, double *coef, Matrix *MatRes); void multi_prod_vector_double(int n, int Sizevec, double **Vec, double *coef, double *VecRes); void multi_prod_matrix_vector(int n, int Sizevec, Matrix **Mat, double **Vec, double *VecRes); void norm2_vector(int Nb, double *U, double *norm); void norminf_vector(int Nb, double *U, double *norm); void identity_matrix(Matrix *M); void scale_matrix(int scaling, Matrix *M); void scale_vector(int ROW_or_COLUMN, Matrix *M, double *V); void get_column_in_matrix(Matrix *M, int col, double *V); void get_element_in_matrix(Matrix *M, int row, int col, double *V); void formatted_write_matrix(FILE *pfile, Matrix *M, int style); void formatted_write_vector(FILE *pfile, int Nb, double *V, int style); void formatted_read_matrix(Matrix *M, const char *name, const char *ext, int style); void formatted_read_vector(int Nb, double *V, const char *name, const char *ext, int style); void binary_write_matrix(Matrix *M, const char *name, const char *ext); void binary_write_vector(int Nb, double *V, const char *name, const char *ext); void binary_read_matrix(Matrix *M, const char *name, const char *ext); void binary_read_vector(int Nb, double **V, const char *name, const char *ext); void print_matrix(Matrix *M); void print_vector(double *v, int N); void print_vector_int(int *v, int N); void print_matrix_info_CSR(int N, int *jptr, int *ai); void print_matrix_info_MSR(int N, sscalar *a, int *jptr); void print_matrix_info_DENSE(int N); void csr_format(Sparse_Matrix *M, int N); void restore_format(Sparse_Matrix *M); void solve_matrix(Matrix *M, Solver_Params *p, double *b, double *x); void print_parametres(Solver_Params *p); #endif getdp-2.7.0-source/contrib/Sparskit/ilut.F000644 001750 001750 00000234426 11741264640 022145 0ustar00geuzainegeuzaine000000 000000 c $Id: ilut.F,v 1.2 2009-03-17 08:48:47 geuzaine Exp $ c----------------------------------------------------------------------c c The file has been renamed from ilut.f to ilut.F to permit c c preprocessing by 'cpp' c c The '-cpp' flag is not standard c c c c WARNING: the preprocessing is NOT done under AIX with the native C c c compiler -> you CANNOT use the -DHAVE_ILU_FLOAT option. c c----------------------------------------------------------------------c #ifndef HAVE_ILU_FLOAT #define scalar real*8 #else #define scalar real*4 #endif c----------------------------------------------------------------------c c S P A R S K I T c c----------------------------------------------------------------------c c ITERATIVE SOLVERS MODULE c c----------------------------------------------------------------------c c This Version Dated: August 13, 1996. Warning: meaning of some c c ============ arguments have changed w.r.t. earlier versions. Some c c Calling sequences may also have changed c c----------------------------------------------------------------------c c Contents: c c-------------------------preconditioners------------------------------c c c c ILUT : Incomplete LU factorization with dual truncation strategy c c ILUTP : ILUT with column pivoting c c ILUD : ILU with single dropping + diagonal compensation (~MILUT) c c ILUDP : ILUD with column pivoting c c ILUK : level-k ILU c c ILU0 : simple ILU(0) preconditioning c c MILU0 : MILU(0) preconditioning c c c c----------sample-accelerator-and-LU-solvers---------------------------c c c c PGMRES : preconditioned GMRES solver c c LUSOL : forward followed by backward triangular solve (Precond.) c c LUTSOL : solving v = (LU)^{-T} u (used for preconditioning) c c c c-------------------------utility-routine------------------------------c c c c QSPLIT : quick split routine used by ilut to sort out the k largest c c elements in absolute value c c c c----------------------------------------------------------------------c c c c Note: all preconditioners are preprocessors to pgmres. c c usage: call preconditioner then call pgmres c c c c----------------------------------------------------------------------c subroutine ilut(n,a,ja,ia,lfil,droptol,alu,jlu,ju,iwk,w,jw,ierr) c----------------------------------------------------------------------- implicit none integer n real*8 a(*),w(n),droptol scalar alu(*) integer ja(*),ia(n+1),jlu(*),ju(n),jw(2*n),lfil,iwk,ierr c----------------------------------------------------------------------* c *** ILUT preconditioner *** * c incomplete LU factorization with dual truncation mechanism * c----------------------------------------------------------------------* c Author: Yousef Saad *May, 5, 1990, Latest revision, August 1996 * c----------------------------------------------------------------------* c PARAMETERS c----------- c c on entry: c========== c n = integer. The row dimension of the matrix A. The matrix c c a,ja,ia = matrix stored in Compressed Sparse Row format. c c lfil = integer. The fill-in parameter. Each row of L and each row c of U will have a maximum of lfil elements (excluding the c diagonal element). lfil must be .ge. 0. c ** WARNING: THE MEANING OF LFIL HAS CHANGED WITH RESPECT TO c EARLIER VERSIONS. c c droptol = real*8. Sets the threshold for dropping small terms in the c factorization. See below for details on dropping strategy. c c c iwk = integer. The lengths of arrays alu and jlu. If the arrays c are not big enough to store the ILU factorizations, ilut c will stop with an error message. c c On return: c=========== c c alu,jlu = matrix stored in Modified Sparse Row (MSR) format containing c the L and U factors together. The diagonal (stored in c alu(1:n) ) is inverted. Each i-th row of the alu,jlu matrix c contains the i-th row of L (excluding the diagonal entry=1) c followed by the i-th row of U. c c ju = integer array of length n containing the pointers to c the beginning of each row of U in the matrix alu,jlu. c c ierr = integer. Error message with the following meaning. c ierr = 0 --> successful return. c ierr .gt. 0 --> zero pivot encountered at step number ierr. c ierr = -1 --> Error. input matrix may be wrong. c (The elimination process has generated a c row in L or U whose length is .gt. n.) c ierr = -2 --> The matrix L overflows the array al. c ierr = -3 --> The matrix U overflows the array alu. c ierr = -4 --> Illegal value for lfil. c ierr = -5 --> zero row encountered. c c work arrays: c============= c jw = integer work array of length 2*n. c w = real work array of length n c c---------------------------------------------------------------------- c w, ju (1:n) store the working array [1:ii-1 = L-part, ii:n = u] c jw(n+1:2n) stores nonzero indicators c c Notes: c ------ c The diagonal elements of the input matrix must be nonzero (at least c 'structurally'). c c----------------------------------------------------------------------* c---- Dual drop strategy works as follows. * c * c 1) Theresholding in L and U as set by droptol. Any element whose * c magnitude is less than some tolerance (relative to the abs * c value of diagonal element in u) is dropped. * c * c 2) Keeping only the largest lfil elements in the i-th row of L * c and the largest lfil elements in the i-th row of U (excluding * c diagonal elements). * c * c Flexibility: one can use droptol=0 to get a strategy based on * c keeping the largest elements in each row of L and U. Taking * c droptol .ne. 0 but lfil=n will give the usual threshold strategy * c (however, fill-in is then mpredictible). * c----------------------------------------------------------------------* c locals integer ju0,k,j1,j2,j,ii,i,lenl,lenu,jj,jrow,jpos,len real*8 tnorm, t, abs, s, fact if (lfil .lt. 0) goto 998 c----------------------------------------------------------------------- c initialize ju0 (points to next element to be added to alu,jlu) c and pointer array. c----------------------------------------------------------------------- ju0 = n+2 jlu(1) = ju0 c c initialize nonzero indicator array. c do 1 j=1,n jw(n+j) = 0 1 continue c----------------------------------------------------------------------- c beginning of main loop. c----------------------------------------------------------------------- do 500 ii = 1, n j1 = ia(ii) j2 = ia(ii+1) - 1 tnorm = 0.0d0 do 501 k=j1,j2 tnorm = tnorm+abs(a(k)) 501 continue if (tnorm .eq. 0.0) goto 999 tnorm = tnorm/real(j2-j1+1) c c unpack L-part and U-part of row of A in arrays w c lenu = 1 lenl = 0 jw(ii) = ii w(ii) = 0.0 jw(n+ii) = ii c do 170 j = j1, j2 k = ja(j) t = a(j) if (k .lt. ii) then lenl = lenl+1 jw(lenl) = k w(lenl) = t jw(n+k) = lenl else if (k .eq. ii) then w(ii) = t else lenu = lenu+1 jpos = ii+lenu-1 jw(jpos) = k w(jpos) = t jw(n+k) = jpos endif 170 continue jj = 0 len = 0 c c eliminate previous rows c 150 jj = jj+1 if (jj .gt. lenl) goto 160 c----------------------------------------------------------------------- c in order to do the elimination in the correct order we must select c the smallest column index among jw(k), k=jj+1, ..., lenl. c----------------------------------------------------------------------- jrow = jw(jj) k = jj c c determine smallest column index c do 151 j=jj+1,lenl if (jw(j) .lt. jrow) then jrow = jw(j) k = j endif 151 continue c if (k .ne. jj) then c exchange in jw j = jw(jj) jw(jj) = jw(k) jw(k) = j c exchange in jr jw(n+jrow) = jj jw(n+j) = k c exchange in w s = w(jj) w(jj) = w(k) w(k) = s endif c c zero out element in row by setting jw(n+jrow) to zero. c jw(n+jrow) = 0 c c get the multiplier for row to be eliminated (jrow). c fact = w(jj)*alu(jrow) if (abs(fact) .le. droptol) goto 150 c c combine current row and row jrow c do 203 k = ju(jrow), jlu(jrow+1)-1 s = fact*alu(k) j = jlu(k) jpos = jw(n+j) if (j .ge. ii) then c c dealing with upper part. c if (jpos .eq. 0) then c c this is a fill-in element c lenu = lenu+1 if (lenu .gt. n) goto 995 i = ii+lenu-1 jw(i) = j jw(n+j) = i w(i) = - s else c c this is not a fill-in element c w(jpos) = w(jpos) - s endif else c c dealing with lower part. c if (jpos .eq. 0) then c c this is a fill-in element c lenl = lenl+1 if (lenl .gt. n) goto 995 jw(lenl) = j jw(n+j) = lenl w(lenl) = - s else c c this is not a fill-in element c w(jpos) = w(jpos) - s endif endif 203 continue c c store this pivot element -- (from left to right -- no danger of c overlap with the working elements in L (pivots). c len = len+1 w(len) = fact jw(len) = jrow goto 150 160 continue c c reset double-pointer to zero (U-part) c do 308 k=1, lenu jw(n+jw(ii+k-1)) = 0 308 continue c c update L-matrix c lenl = len len = min0(lenl,lfil) c c sort by quick-split c call qsplit (w,jw,lenl,len) c c store L-part c do 204 k=1, len if (ju0 .gt. iwk) goto 996 alu(ju0) = w(k) jlu(ju0) = jw(k) ju0 = ju0+1 204 continue c c save pointer to beginning of row ii of U c ju(ii) = ju0 c c update U-matrix -- first apply dropping strategy c len = 0 do k=1, lenu-1 if (abs(w(ii+k)) .gt. droptol*tnorm) then len = len+1 w(ii+len) = w(ii+k) jw(ii+len) = jw(ii+k) endif enddo lenu = len+1 len = min0(lenu,lfil) c call qsplit (w(ii+1), jw(ii+1), lenu-1,len) c c copy c t = abs(w(ii)) if (len + ju0 .gt. iwk) goto 997 do 302 k=ii+1,ii+len-1 jlu(ju0) = jw(k) alu(ju0) = w(k) t = t + abs(w(k) ) ju0 = ju0+1 302 continue c c store inverse of diagonal element of u c if (w(ii) .eq. 0.0) w(ii) = (0.0001 + droptol)*tnorm c alu(ii) = 1.0d0/ w(ii) c c update pointer to beginning of next row of U. c jlu(ii+1) = ju0 c----------------------------------------------------------------------- c end main loop c----------------------------------------------------------------------- 500 continue ierr = 0 return c c incomprehensible error. Matrix must be wrong. c 995 ierr = -1 return c c insufficient storage in L. c 996 ierr = -2 return c c insufficient storage in U. c 997 ierr = -3 return c c illegal lfil entered. c 998 ierr = -4 return c c zero row encountered c 999 ierr = -5 return c----------------end-of-ilut-------------------------------------------- c----------------------------------------------------------------------- end c---------------------------------------------------------------------- subroutine ilutp(n,a,ja,ia,lfil,droptol,permtol,mbloc,alu, * jlu,ju,iwk,w,jw,iperm,ierr) c----------------------------------------------------------------------- c implicit none integer n,ja(*),ia(n+1),lfil,jlu(*),ju(n),jw(2*n),iwk, * iperm(2*n),ierr scalar alu(*) real*8 a(*), w(n), droptol c----------------------------------------------------------------------* c *** ILUTP preconditioner -- ILUT with pivoting *** * c incomplete LU factorization with dual truncation mechanism * c----------------------------------------------------------------------* c author Yousef Saad *Sep 8, 1993 -- Latest revision, August 1996. * c----------------------------------------------------------------------* c on entry: c========== c n = integer. The dimension of the matrix A. c c a,ja,ia = matrix stored in Compressed Sparse Row format. c ON RETURN THE COLUMNS OF A ARE PERMUTED. SEE BELOW FOR c DETAILS. c c lfil = integer. The fill-in parameter. Each row of L and each row c of U will have a maximum of lfil elements (excluding the c diagonal element). lfil must be .ge. 0. c ** WARNING: THE MEANING OF LFIL HAS CHANGED WITH RESPECT TO c EARLIER VERSIONS. c c droptol = real*8. Sets the threshold for dropping small terms in the c factorization. See below for details on dropping strategy. c c lfil = integer. The fill-in parameter. Each row of L and c each row of U will have a maximum of lfil elements. c WARNING: THE MEANING OF LFIL HAS CHANGED WITH RESPECT TO c EARLIER VERSIONS. c lfil must be .ge. 0. c c permtol = tolerance ratio used to determne whether or not to permute c two columns. At step i columns i and j are permuted when c c abs(a(i,j))*permtol .gt. abs(a(i,i)) c c [0 --> never permute; good values 0.1 to 0.01] c c mbloc = if desired, permuting can be done only within the diagonal c blocks of size mbloc. Useful for PDE problems with several c degrees of freedom.. If feature not wanted take mbloc=n. c c c iwk = integer. The lengths of arrays alu and jlu. If the arrays c are not big enough to store the ILU factorizations, ilut c will stop with an error message. c c On return: c=========== c c alu,jlu = matrix stored in Modified Sparse Row (MSR) format containing c the L and U factors together. The diagonal (stored in c alu(1:n) ) is inverted. Each i-th row of the alu,jlu matrix c contains the i-th row of L (excluding the diagonal entry=1) c followed by the i-th row of U. c c ju = integer array of length n containing the pointers to c the beginning of each row of U in the matrix alu,jlu. c c iperm = contains the permutation arrays. c iperm(1:n) = old numbers of unknowns c iperm(n+1:2*n) = reverse permutation = new unknowns. c c ierr = integer. Error message with the following meaning. c ierr = 0 --> successful return. c ierr .gt. 0 --> zero pivot encountered at step number ierr. c ierr = -1 --> Error. input matrix may be wrong. c (The elimination process has generated a c row in L or U whose length is .gt. n.) c ierr = -2 --> The matrix L overflows the array al. c ierr = -3 --> The matrix U overflows the array alu. c ierr = -4 --> Illegal value for lfil. c ierr = -5 --> zero row encountered. c c work arrays: c============= c jw = integer work array of length 2*n. c w = real work array of length n c c IMPORTANR NOTE: c -------------- c TO AVOID PERMUTING THE SOLUTION VECTORS ARRAYS FOR EACH LU-SOLVE, C THE MATRIX A IS PERMUTED ON RETURN. [all column indices are c changed]. SIMILARLY FOR THE U MATRIX. c To permute the matrix back to its original state use the loop: c c do k=ia(1), ia(n+1)-1 c ja(k) = iperm(ja(k)) c enddo c c----------------------------------------------------------------------- c local variables c integer k,i,j,jrow,ju0,ii,j1,j2,jpos,len,imax,lenu,lenl,jj,mbloc, * icut real*8 s, tmp, tnorm,xmax,xmax0, fact, abs, t, permtol c if (lfil .lt. 0) goto 998 c----------------------------------------------------------------------- c initialize ju0 (points to next element to be added to alu,jlu) c and pointer array. c----------------------------------------------------------------------- ju0 = n+2 jlu(1) = ju0 c c integer double pointer array. c do 1 j=1, n jw(n+j) = 0 iperm(j) = j iperm(n+j) = j 1 continue c----------------------------------------------------------------------- c beginning of main loop. c----------------------------------------------------------------------- do 500 ii = 1, n c c avancement de l'ilutp c if (mod(ii/1000) .eq. 0) c write(*, '(A1,$)') '*' c c j1 = ia(ii) j2 = ia(ii+1) - 1 tnorm = 0.0d0 do 501 k=j1,j2 tnorm = tnorm+abs(a(k)) 501 continue if (tnorm .eq. 0.0) goto 999 tnorm = tnorm/(j2-j1+1) c c unpack L-part and U-part of row of A in arrays w -- c lenu = 1 lenl = 0 jw(ii) = ii w(ii) = 0.0 jw(n+ii) = ii c do 170 j = j1, j2 k = iperm(n+ja(j)) t = a(j) if (k .lt. ii) then lenl = lenl+1 jw(lenl) = k w(lenl) = t jw(n+k) = lenl else if (k .eq. ii) then w(ii) = t else lenu = lenu+1 jpos = ii+lenu-1 jw(jpos) = k w(jpos) = t jw(n+k) = jpos endif 170 continue jj = 0 len = 0 c c eliminate previous rows c 150 jj = jj+1 if (jj .gt. lenl) goto 160 c----------------------------------------------------------------------- c in order to do the elimination in the correct order we must select c the smallest column index among jw(k), k=jj+1, ..., lenl. c----------------------------------------------------------------------- jrow = jw(jj) k = jj c c determine smallest column index c do 151 j=jj+1,lenl if (jw(j) .lt. jrow) then jrow = jw(j) k = j endif 151 continue c if (k .ne. jj) then c exchange in jw j = jw(jj) jw(jj) = jw(k) jw(k) = j c exchange in jr jw(n+jrow) = jj jw(n+j) = k c exchange in w s = w(jj) w(jj) = w(k) w(k) = s endif c c zero out element in row by resetting jw(n+jrow) to zero. c jw(n+jrow) = 0 c c get the multiplier for row to be eliminated: jrow c fact = w(jj)*alu(jrow) c c drop term if small c if (abs(fact) .le. droptol) goto 150 c c combine current row and row jrow c do 203 k = ju(jrow), jlu(jrow+1)-1 s = fact*alu(k) c new column number j = iperm(n+jlu(k)) jpos = jw(n+j) if (j .ge. ii) then c c dealing with upper part. c if (jpos .eq. 0) then c c this is a fill-in element c lenu = lenu+1 i = ii+lenu-1 if (lenu .gt. n) goto 995 jw(i) = j jw(n+j) = i w(i) = - s else c no fill-in element -- w(jpos) = w(jpos) - s endif else c c dealing with lower part. c if (jpos .eq. 0) then c c this is a fill-in element c lenl = lenl+1 if (lenl .gt. n) goto 995 jw(lenl) = j jw(n+j) = lenl w(lenl) = - s else c c this is not a fill-in element c w(jpos) = w(jpos) - s endif endif 203 continue c c store this pivot element -- (from left to right -- no danger of c overlap with the working elements in L (pivots). c len = len+1 w(len) = fact jw(len) = jrow goto 150 160 continue c c reset double-pointer to zero (U-part) c do 308 k=1, lenu jw(n+jw(ii+k-1)) = 0 308 continue c c update L-matrix c lenl = len len = min0(lenl,lfil) c c sort by quick-split c call qsplit (w,jw,lenl,len) c c store L-part -- in original coordinates .. c do 204 k=1, len if (ju0 .gt. iwk) goto 996 alu(ju0) = w(k) jlu(ju0) = iperm(jw(k)) ju0 = ju0+1 204 continue c c save pointer to beginning of row ii of U c ju(ii) = ju0 c c update U-matrix -- first apply dropping strategy c len = 0 do k=1, lenu-1 if (abs(w(ii+k)) .gt. droptol*tnorm) then len = len+1 w(ii+len) = w(ii+k) jw(ii+len) = jw(ii+k) endif enddo lenu = len+1 len = min0(lenu,lfil) call qsplit (w(ii+1), jw(ii+1), lenu-1,len) c c determine next pivot -- c imax = ii xmax = abs(w(imax)) xmax0 = xmax icut = ii - 1 + mbloc - mod(ii-1,mbloc) do k=ii+1,ii+len-1 t = abs(w(k)) if (t .gt. xmax .and. t*permtol .gt. xmax0 .and. * jw(k) .le. icut) then imax = k xmax = t endif enddo c c exchange w's c tmp = w(ii) w(ii) = w(imax) w(imax) = tmp c c update iperm and reverse iperm c j = jw(imax) i = iperm(ii) iperm(ii) = iperm(j) iperm(j) = i c c reverse iperm c iperm(n+iperm(ii)) = ii iperm(n+iperm(j)) = j c----------------------------------------------------------------------- c if (len + ju0 .gt. iwk) goto 997 c c copy U-part in original coordinates c do 302 k=ii+1,ii+len-1 jlu(ju0) = iperm(jw(k)) alu(ju0) = w(k) ju0 = ju0+1 302 continue c c store inverse of diagonal element of u c if (w(ii) .eq. 0.0) w(ii) = (1.0D-4 + droptol)*tnorm alu(ii) = 1.0d0/ w(ii) c c update pointer to beginning of next row of U. c jlu(ii+1) = ju0 c----------------------------------------------------------------------- c end main loop c----------------------------------------------------------------------- 500 continue c c permute all column indices of LU ... c do k = jlu(1),jlu(n+1)-1 jlu(k) = iperm(n+jlu(k)) enddo c c ...and of A c do k=ia(1), ia(n+1)-1 ja(k) = iperm(n+ja(k)) enddo c ierr = 0 return c c incomprehensible error. Matrix must be wrong. c 995 ierr = -1 return c c insufficient storage in L. c 996 ierr = -2 return c c insufficient storage in U. c 997 ierr = -3 return c c illegal lfil entered. c 998 ierr = -4 return c c zero row encountered c 999 ierr = -5 return c----------------end-of-ilutp------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine ilud(n,a,ja,ia,alph,tol,alu,jlu,ju,iwk,w,jw,ierr) c----------------------------------------------------------------------- implicit none integer n scalar alu(*) real*8 a(*),w(2*n),tol, alph integer ja(*),ia(n+1),jlu(*),ju(n),jw(2*n),iwk,ierr c----------------------------------------------------------------------* c *** ILUD preconditioner *** * c incomplete LU factorization with standard droppoing strategy * c----------------------------------------------------------------------* c Author: Yousef Saad * Aug. 1995 -- * c----------------------------------------------------------------------* c This routine computes the ILU factorization with standard threshold * c dropping: at i-th step of elimination, an element a(i,j) in row i is * c dropped if it satisfies the criterion: * c * c abs(a(i,j)) < tol * [average magnitude of elements in row i of A] * c * c There is no control on memory size required for the factors as is * c done in ILUT. This routines computes also various diagonal compensa- * c tion ILU's such MILU. These are defined through the parameter alph * c----------------------------------------------------------------------* c on entry: c========== c n = integer. The row dimension of the matrix A. The matrix c c a,ja,ia = matrix stored in Compressed Sparse Row format c c alph = diagonal compensation parameter -- the term: c c alph*(sum of all dropped out elements in a given row) c c is added to the diagonal element of U of the factorization c Thus: alph = 0 ---> ~ ILU with threshold, c alph = 1 ---> ~ MILU with threshold. c c tol = Threshold parameter for dropping small terms in the c factorization. During the elimination, a term a(i,j) is c dropped whenever abs(a(i,j)) .lt. tol * [weighted norm of c row i]. Here weighted norm = 1-norm / number of nnz c elements in the row. c c iwk = The length of arrays alu and jlu -- this routine will stop c if storage for the factors L and U is not sufficient c c On return: c=========== c c alu,jlu = matrix stored in Modified Sparse Row (MSR) format containing c the L and U factors together. The diagonal (stored in c alu(1:n) ) is inverted. Each i-th row of the alu,jlu matrix c contains the i-th row of L (excluding the diagonal entry=1) c followed by the i-th row of U. c c ju = integer array of length n containing the pointers to c the beginning of each row of U in the matrix alu,jlu. c c ierr = integer. Error message with the following meaning. c ierr = 0 --> successful return. c ierr .gt. 0 --> zero pivot encountered at step number ierr. c ierr = -1 --> Error. input matrix may be wrong. c (The elimination process has generated a c row in L or U whose length is .gt. n.) c ierr = -2 --> Insufficient storage for the LU factors -- c arrays alu/ jalu are overflowed. c ierr = -3 --> Zero row encountered. c c Work Arrays: c============= c jw = integer work array of length 2*n. c w = real work array of length n c c---------------------------------------------------------------------- c c w, ju (1:n) store the working array [1:ii-1 = L-part, ii:n = u] c jw(n+1:2n) stores the nonzero indicator. c c Notes: c ------ c All diagonal elements of the input matrix must be nonzero. c c----------------------------------------------------------------------- c locals integer ju0,k,j1,j2,j,ii,i,lenl,lenu,jj,jrow,jpos,len real*8 tnorm, t, abs, s, fact, dropsum c----------------------------------------------------------------------- c initialize ju0 (points to next element to be added to alu,jlu) c and pointer array. c----------------------------------------------------------------------- ju0 = n+2 jlu(1) = ju0 c c initialize nonzero indicator array. c do 1 j=1,n jw(n+j) = 0 1 continue c----------------------------------------------------------------------- c beginning of main loop. c----------------------------------------------------------------------- do 500 ii = 1, n j1 = ia(ii) j2 = ia(ii+1) - 1 dropsum = 0.0d0 tnorm = 0.0d0 do 501 k=j1,j2 tnorm = tnorm + abs(a(k)) 501 continue if (tnorm .eq. 0.0) goto 997 tnorm = tnorm / real(j2-j1+1) c c unpack L-part and U-part of row of A in arrays w c lenu = 1 lenl = 0 jw(ii) = ii w(ii) = 0.0 jw(n+ii) = ii c do 170 j = j1, j2 k = ja(j) t = a(j) if (k .lt. ii) then lenl = lenl+1 jw(lenl) = k w(lenl) = t jw(n+k) = lenl else if (k .eq. ii) then w(ii) = t else lenu = lenu+1 jpos = ii+lenu-1 jw(jpos) = k w(jpos) = t jw(n+k) = jpos endif 170 continue jj = 0 len = 0 c c eliminate previous rows c 150 jj = jj+1 if (jj .gt. lenl) goto 160 c----------------------------------------------------------------------- c in order to do the elimination in the correct order we must select c the smallest column index among jw(k), k=jj+1, ..., lenl. c----------------------------------------------------------------------- jrow = jw(jj) k = jj c c determine smallest column index c do 151 j=jj+1,lenl if (jw(j) .lt. jrow) then jrow = jw(j) k = j endif 151 continue c if (k .ne. jj) then c exchange in jw j = jw(jj) jw(jj) = jw(k) jw(k) = j c exchange in jr jw(n+jrow) = jj jw(n+j) = k c exchange in w s = w(jj) w(jj) = w(k) w(k) = s endif c c zero out element in row by setting resetting jw(n+jrow) to zero. c jw(n+jrow) = 0 c c drop term if small c c if (abs(w(jj)) .le. tol*tnorm) then c dropsum = dropsum + w(jj) c goto 150 c endif c c get the multiplier for row to be eliminated (jrow). c fact = w(jj)*alu(jrow) c c drop term if small c if (abs(fact) .le. tol) then dropsum = dropsum + w(jj) goto 150 endif c c combine current row and row jrow c do 203 k = ju(jrow), jlu(jrow+1)-1 s = fact*alu(k) j = jlu(k) jpos = jw(n+j) if (j .ge. ii) then c c dealing with upper part. c if (jpos .eq. 0) then c c this is a fill-in element c lenu = lenu+1 if (lenu .gt. n) goto 995 i = ii+lenu-1 jw(i) = j jw(n+j) = i w(i) = - s else c c this is not a fill-in element c w(jpos) = w(jpos) - s endif else c c dealing with lower part. c if (jpos .eq. 0) then c c this is a fill-in element c lenl = lenl+1 if (lenl .gt. n) goto 995 jw(lenl) = j jw(n+j) = lenl w(lenl) = - s else c c this is not a fill-in element c w(jpos) = w(jpos) - s endif endif 203 continue len = len+1 w(len) = fact jw(len) = jrow goto 150 160 continue c c reset double-pointer to zero (For U-part only) c do 308 k=1, lenu jw(n+jw(ii+k-1)) = 0 308 continue c c update l-matrix c do 204 k=1, len if (ju0 .gt. iwk) goto 996 alu(ju0) = w(k) jlu(ju0) = jw(k) ju0 = ju0+1 204 continue c c save pointer to beginning of row ii of U c ju(ii) = ju0 c c go through elements in U-part of w to determine elements to keep c len = 0 do k=1, lenu-1 c if (abs(w(ii+k)) .gt. tnorm*tol) then if (abs(w(ii+k)) .gt. abs(w(ii))*tol) then len = len+1 w(ii+len) = w(ii+k) jw(ii+len) = jw(ii+k) else dropsum = dropsum + w(ii+k) endif enddo c c now update u-matrix c if (ju0 + len-1 .gt. iwk) goto 996 do 302 k=ii+1,ii+len jlu(ju0) = jw(k) alu(ju0) = w(k) ju0 = ju0+1 302 continue c c define diagonal element c w(ii) = w(ii) + alph*dropsum c c store inverse of diagonal element of u c if (w(ii) .eq. 0.0) w(ii) = (0.0001 + tol)*tnorm c alu(ii) = 1.0d0/ w(ii) c c update pointer to beginning of next row of U. c jlu(ii+1) = ju0 c----------------------------------------------------------------------- c end main loop c----------------------------------------------------------------------- 500 continue ierr = 0 return c c incomprehensible error. Matrix must be wrong. c 995 ierr = -1 return c c insufficient storage in alu/ jlu arrays for L / U factors c 996 ierr = -2 return c c zero row encountered c 997 ierr = -3 return c----------------end-of-ilud ------------------------------------------ c----------------------------------------------------------------------- end c---------------------------------------------------------------------- subroutine iludp(n,a,ja,ia,alph,droptol,permtol,mbloc,alu, * jlu,ju,iwk,w,jw,iperm,ierr) c----------------------------------------------------------------------- implicit none integer n,ja(*),ia(n+1),mbloc,jlu(*),ju(n),jw(2*n),iwk, * iperm(2*n),ierr scalar alu(*) real*8 a(*), w(2*n), alph, droptol, permtol c----------------------------------------------------------------------* c *** ILUDP preconditioner *** * c incomplete LU factorization with standard droppoing strategy * c and column pivoting * c----------------------------------------------------------------------* c author Yousef Saad -- Aug 1995. * c----------------------------------------------------------------------* c on entry: c========== c n = integer. The dimension of the matrix A. c c a,ja,ia = matrix stored in Compressed Sparse Row format. c ON RETURN THE COLUMNS OF A ARE PERMUTED. c c alph = diagonal compensation parameter -- the term: c c alph*(sum of all dropped out elements in a given row) c c is added to the diagonal element of U of the factorization c Thus: alph = 0 ---> ~ ILU with threshold, c alph = 1 ---> ~ MILU with threshold. c c droptol = tolerance used for dropping elements in L and U. c elements are dropped if they are .lt. norm(row) x droptol c row = row being eliminated c c permtol = tolerance ratio used for determning whether to permute c two columns. Two columns are permuted only when c abs(a(i,j))*permtol .gt. abs(a(i,i)) c [0 --> never permute; good values 0.1 to 0.01] c c mbloc = if desired, permuting can be done only within the diagonal c blocks of size mbloc. Useful for PDE problems with several c degrees of freedom.. If feature not wanted take mbloc=n. c c iwk = integer. The declared lengths of arrays alu and jlu c if iwk is not large enough the code will stop prematurely c with ierr = -2 or ierr = -3 (see below). c c On return: c=========== c c alu,jlu = matrix stored in Modified Sparse Row (MSR) format containing c the L and U factors together. The diagonal (stored in c alu(1:n) ) is inverted. Each i-th row of the alu,jlu matrix c contains the i-th row of L (excluding the diagonal entry=1) c followed by the i-th row of U. c c ju = integer array of length n containing the pointers to c the beginning of each row of U in the matrix alu,jlu. c iperm = contains the permutation arrays .. c iperm(1:n) = old numbers of unknowns c iperm(n+1:2*n) = reverse permutation = new unknowns. c c ierr = integer. Error message with the following meaning. c ierr = 0 --> successful return. c ierr .gt. 0 --> zero pivot encountered at step number ierr. c ierr = -1 --> Error. input matrix may be wrong. c (The elimination process has generated a c row in L or U whose length is .gt. n.) c ierr = -2 --> The L/U matrix overflows the arrays alu,jlu c ierr = -3 --> zero row encountered. c c work arrays: c============= c jw = integer work array of length 2*n. c w = real work array of length 2*n c c Notes: c ------ c IMPORTANT: TO AVOID PERMUTING THE SOLUTION VECTORS ARRAYS FOR EACH c LU-SOLVE, THE MATRIX A IS PERMUTED ON RETURN. [all column indices are c changed]. SIMILARLY FOR THE U MATRIX. c To permute the matrix back to its original state use the loop: c c do k=ia(1), ia(n+1)-1 c ja(k) = perm(ja(k)) c enddo c c----------------------------------------------------------------------- c local variables c integer k,i,j,jrow,ju0,ii,j1,j2,jpos,len,imax,lenu,lenl,jj,icut real*8 s,tmp,tnorm,xmax,xmax0,fact,abs,t,dropsum c----------------------------------------------------------------------- c initialize ju0 (points to next element to be added to alu,jlu) c and pointer array. c----------------------------------------------------------------------- ju0 = n+2 jlu(1) = ju0 c c integer double pointer array. c do 1 j=1,n jw(n+j) = 0 iperm(j) = j iperm(n+j) = j 1 continue c----------------------------------------------------------------------- c beginning of main loop. c----------------------------------------------------------------------- do 500 ii = 1, n j1 = ia(ii) j2 = ia(ii+1) - 1 dropsum = 0.0d0 tnorm = 0.0d0 do 501 k=j1,j2 tnorm = tnorm+abs(a(k)) 501 continue if (tnorm .eq. 0.0) goto 997 tnorm = tnorm/(j2-j1+1) c c unpack L-part and U-part of row of A in arrays w -- c lenu = 1 lenl = 0 jw(ii) = ii w(ii) = 0.0 jw(n+ii) = ii c do 170 j = j1, j2 k = iperm(n+ja(j)) t = a(j) if (k .lt. ii) then lenl = lenl+1 jw(lenl) = k w(lenl) = t jw(n+k) = lenl else if (k .eq. ii) then w(ii) = t else lenu = lenu+1 jpos = ii+lenu-1 jw(jpos) = k w(jpos) = t jw(n+k) = jpos endif 170 continue jj = 0 len = 0 c c eliminate previous rows c 150 jj = jj+1 if (jj .gt. lenl) goto 160 c----------------------------------------------------------------------- c in order to do the elimination in the correct order we must select c the smallest column index among jw(k), k=jj+1, ..., lenl. c----------------------------------------------------------------------- jrow = jw(jj) k = jj c c determine smallest column index c do 151 j=jj+1,lenl if (jw(j) .lt. jrow) then jrow = jw(j) k = j endif 151 continue c if (k .ne. jj) then c exchange in jw j = jw(jj) jw(jj) = jw(k) jw(k) = j c exchange in jr jw(n+jrow) = jj jw(n+j) = k c exchange in w s = w(jj) w(jj) = w(k) w(k) = s endif c c zero out element in row by resetting jw(n+jrow) to zero. c jw(n+jrow) = 0 c c drop term if small c if (abs(w(jj)) .le. droptol*tnorm) then dropsum = dropsum + w(jj) goto 150 endif c c get the multiplier for row to be eliminated: jrow c fact = w(jj)*alu(jrow) c c combine current row and row jrow c do 203 k = ju(jrow), jlu(jrow+1)-1 s = fact*alu(k) c new column number j = iperm(n+jlu(k)) jpos = jw(n+j) c c if fill-in element is small then disregard: c if (j .ge. ii) then c c dealing with upper part. c if (jpos .eq. 0) then c this is a fill-in element lenu = lenu+1 i = ii+lenu-1 if (lenu .gt. n) goto 995 jw(i) = j jw(n+j) = i w(i) = - s else c no fill-in element -- w(jpos) = w(jpos) - s endif else c c dealing with lower part. c if (jpos .eq. 0) then c this is a fill-in element lenl = lenl+1 if (lenl .gt. n) goto 995 jw(lenl) = j jw(n+j) = lenl w(lenl) = - s else c no fill-in element -- w(jpos) = w(jpos) - s endif endif 203 continue len = len+1 w(len) = fact jw(len) = jrow goto 150 160 continue c c reset double-pointer to zero (U-part) c do 308 k=1, lenu jw(n+jw(ii+k-1)) = 0 308 continue c c update L-matrix c do 204 k=1, len if (ju0 .gt. iwk) goto 996 alu(ju0) = w(k) jlu(ju0) = iperm(jw(k)) ju0 = ju0+1 204 continue c c save pointer to beginning of row ii of U c ju(ii) = ju0 c c update u-matrix -- first apply dropping strategy c len = 0 do k=1, lenu-1 if (abs(w(ii+k)) .gt. tnorm*droptol) then len = len+1 w(ii+len) = w(ii+k) jw(ii+len) = jw(ii+k) else dropsum = dropsum + w(ii+k) endif enddo c imax = ii xmax = abs(w(imax)) xmax0 = xmax icut = ii - 1 + mbloc - mod(ii-1,mbloc) c c determine next pivot -- c do k=ii+1,ii+len t = abs(w(k)) if (t .gt. xmax .and. t*permtol .gt. xmax0 .and. * jw(k) .le. icut) then imax = k xmax = t endif enddo c c exchange w's c tmp = w(ii) w(ii) = w(imax) w(imax) = tmp c c update iperm and reverse iperm c j = jw(imax) i = iperm(ii) iperm(ii) = iperm(j) iperm(j) = i c reverse iperm iperm(n+iperm(ii)) = ii iperm(n+iperm(j)) = j c----------------------------------------------------------------------- if (len + ju0-1 .gt. iwk) goto 996 c c copy U-part in original coordinates c do 302 k=ii+1,ii+len jlu(ju0) = iperm(jw(k)) alu(ju0) = w(k) ju0 = ju0+1 302 continue c c define diagonal element c w(ii) = w(ii) + alph*dropsum c c store inverse of diagonal element of u c if (w(ii) .eq. 0.0) w(ii) = (1.0D-4 + droptol)*tnorm c alu(ii) = 1.0d0/ w(ii) c c update pointer to beginning of next row of U. c jlu(ii+1) = ju0 c----------------------------------------------------------------------- c end main loop c----------------------------------------------------------------------- 500 continue c c permute all column indices of LU ... c do k = jlu(1),jlu(n+1)-1 jlu(k) = iperm(n+jlu(k)) enddo c c ...and of A c do k=ia(1), ia(n+1)-1 ja(k) = iperm(n+ja(k)) enddo c ierr = 0 return c c incomprehensible error. Matrix must be wrong. c 995 ierr = -1 return c c insufficient storage in arrays alu, jlu to store factors c 996 ierr = -2 return c c zero row encountered c 997 ierr = -3 return c----------------end-of-iludp------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine iluk(n,a,ja,ia,lfil,alu,jlu,ju,levs,iwk,w,jw,ierr) implicit none integer n scalar alu(*) real*8 a(*),w(n) integer ja(*),ia(n+1),jlu(*),ju(n),levs(*),jw(3*n),lfil,iwk,ierr c----------------------------------------------------------------------* c SPARSKIT ROUTINE ILUK -- ILU WITH LEVEL OF FILL-IN OF K (ILU(k)) * c----------------------------------------------------------------------* c c on entry: c========== c n = integer. The row dimension of the matrix A. The matrix c c a,ja,ia = matrix stored in Compressed Sparse Row format. c c lfil = integer. The fill-in parameter. Each element whose c leve-of-fill exceeds lfil during the ILU process is dropped. c lfil must be .ge. 0 c c tol = real*8. Sets the threshold for dropping small terms in the c factorization. See below for details on dropping strategy. c c iwk = integer. The minimum length of arrays alu, jlu, and levs. c c On return: c=========== c c alu,jlu = matrix stored in Modified Sparse Row (MSR) format containing c the L and U factors together. The diagonal (stored in c alu(1:n) ) is inverted. Each i-th row of the alu,jlu matrix c contains the i-th row of L (excluding the diagonal entry=1) c followed by the i-th row of U. c c ju = integer array of length n containing the pointers to c the beginning of each row of U in the matrix alu,jlu. c c levs = integer (work) array of size iwk -- which contains the c levels of each element in alu, jlu. c c ierr = integer. Error message with the following meaning. c ierr = 0 --> successful return. c ierr .gt. 0 --> zero pivot encountered at step number ierr. c ierr = -1 --> Error. input matrix may be wrong. c (The elimination process has generated a c row in L or U whose length is .gt. n.) c ierr = -2 --> The matrix L overflows the array al. c ierr = -3 --> The matrix U overflows the array alu. c ierr = -4 --> Illegal value for lfil. c ierr = -5 --> zero row encountered in A or U. c c work arrays: c============= c jw = integer work array of length 3*n. c w = real work array of length n c c Notes/known bugs: This is not implemented efficiently storage-wise. c For example: Only the part of the array levs(*) associated with c the U-matrix is needed in the routine.. So some storage can c be saved if needed. The levels of fills in the LU matrix are c output for information only -- they are not needed by LU-solve. c c---------------------------------------------------------------------- c w, ju (1:n) store the working array [1:ii-1 = L-part, ii:n = u] c jw(n+1:2n) stores the nonzero indicator. c c Notes: c ------ c All the diagonal elements of the input matrix must be nonzero. c c----------------------------------------------------------------------* c locals integer ju0,k,j1,j2,j,ii,i,lenl,lenu,jj,jrow,jpos,n2, * jlev, min real*8 t, s, fact if (lfil .lt. 0) goto 998 c----------------------------------------------------------------------- c initialize ju0 (points to next element to be added to alu,jlu) c and pointer array. c----------------------------------------------------------------------- n2 = n+n ju0 = n+2 jlu(1) = ju0 c c initialize nonzero indicator array + levs array -- c do 1 j=1,2*n jw(j) = 0 1 continue c----------------------------------------------------------------------- c beginning of main loop. c----------------------------------------------------------------------- do 500 ii = 1, n j1 = ia(ii) j2 = ia(ii+1) - 1 c c unpack L-part and U-part of row of A in arrays w c lenu = 1 lenl = 0 jw(ii) = ii w(ii) = 0.0 jw(n+ii) = ii c do 170 j = j1, j2 k = ja(j) t = a(j) if (t .eq. 0.0) goto 170 if (k .lt. ii) then lenl = lenl+1 jw(lenl) = k w(lenl) = t jw(n2+lenl) = 0 jw(n+k) = lenl else if (k .eq. ii) then w(ii) = t jw(n2+ii) = 0 else lenu = lenu+1 jpos = ii+lenu-1 jw(jpos) = k w(jpos) = t jw(n2+jpos) = 0 jw(n+k) = jpos endif 170 continue c jj = 0 c c eliminate previous rows c 150 jj = jj+1 if (jj .gt. lenl) goto 160 c----------------------------------------------------------------------- c in order to do the elimination in the correct order we must select c the smallest column index among jw(k), k=jj+1, ..., lenl. c----------------------------------------------------------------------- jrow = jw(jj) k = jj c c determine smallest column index c do 151 j=jj+1,lenl if (jw(j) .lt. jrow) then jrow = jw(j) k = j endif 151 continue c if (k .ne. jj) then c exchange in jw j = jw(jj) jw(jj) = jw(k) jw(k) = j c exchange in jw(n+ (pointers/ nonzero indicator). jw(n+jrow) = jj jw(n+j) = k c exchange in jw(n2+ (levels) j = jw(n2+jj) jw(n2+jj) = jw(n2+k) jw(n2+k) = j c exchange in w s = w(jj) w(jj) = w(k) w(k) = s endif c c zero out element in row by resetting jw(n+jrow) to zero. c jw(n+jrow) = 0 c c get the multiplier for row to be eliminated (jrow) + its level c fact = w(jj)*alu(jrow) jlev = jw(n2+jj) if (jlev .gt. lfil) goto 150 c c combine current row and row jrow c do 203 k = ju(jrow), jlu(jrow+1)-1 s = fact*alu(k) j = jlu(k) jpos = jw(n+j) if (j .ge. ii) then c c dealing with upper part. c if (jpos .eq. 0) then c c this is a fill-in element c lenu = lenu+1 if (lenu .gt. n) goto 995 i = ii+lenu-1 jw(i) = j jw(n+j) = i w(i) = - s jw(n2+i) = jlev+levs(k)+1 else c c this is not a fill-in element c w(jpos) = w(jpos) - s jw(n2+jpos) = min(jw(n2+jpos),jlev+levs(k)+1) endif else c c dealing with lower part. c if (jpos .eq. 0) then c c this is a fill-in element c lenl = lenl+1 if (lenl .gt. n) goto 995 jw(lenl) = j jw(n+j) = lenl w(lenl) = - s jw(n2+lenl) = jlev+levs(k)+1 else c c this is not a fill-in element c w(jpos) = w(jpos) - s jw(n2+jpos) = min(jw(n2+jpos),jlev+levs(k)+1) endif endif 203 continue w(jj) = fact jw(jj) = jrow goto 150 160 continue c c reset double-pointer to zero (U-part) c do 308 k=1, lenu jw(n+jw(ii+k-1)) = 0 308 continue c c update l-matrix c do 204 k=1, lenl if (ju0 .gt. iwk) goto 996 if (jw(n2+k) .le. lfil) then alu(ju0) = w(k) jlu(ju0) = jw(k) ju0 = ju0+1 endif 204 continue c c save pointer to beginning of row ii of U c ju(ii) = ju0 c c update u-matrix c do 302 k=ii+1,ii+lenu-1 c oups: who suppressed the following test in getdp < 0.81? if (ju0 .gt. iwk) goto 997 if (jw(n2+k) .le. lfil) then jlu(ju0) = jw(k) alu(ju0) = w(k) levs(ju0) = jw(n2+k) ju0 = ju0+1 endif 302 continue if (w(ii) .eq. 0.0) goto 999 c alu(ii) = 1.0d0/ w(ii) c c update pointer to beginning of next row of U. c jlu(ii+1) = ju0 c----------------------------------------------------------------------- c end main loop c----------------------------------------------------------------------- 500 continue ierr = 0 return c c incomprehensible error. Matrix must be wrong. c 995 ierr = -1 return c c insufficient storage in L. c 996 ierr = -2 return c c insufficient storage in U. c 997 ierr = -3 return c c illegal lfil entered. c 998 ierr = -4 return c c zero row encountered in A or U. c 999 ierr = -5 return c----------------end-of-iluk-------------------------------------------- c----------------------------------------------------------------------- end c---------------------------------------------------------------------- subroutine ilu0(n, a, ja, ia, alu, jlu, ju, iw, ierr) implicit real*8 (a-h,o-z) scalar alu(*) real*8 a(*) integer ja(*), ia(*), ju(*), jlu(*), iw(*) c------------------ right preconditioner ------------------------------* c *** ilu(0) preconditioner. *** * c----------------------------------------------------------------------* c Note that this has been coded in such a way that it can be used c with pgmres. Normally, since the data structure of the L+U matrix is c the same as that the A matrix, savings can be made. In fact with c some definitions (not correct for general sparse matrices) all we c need in addition to a, ja, ia is an additional diagonal. c ILU0 is not recommended for serious problems. It is only provided c here for comparison purposes. c----------------------------------------------------------------------- c c on entry: c--------- c n = dimension of matrix c a, ja, c ia = original matrix in compressed sparse row storage. c c on return: c----------- c alu,jlu = matrix stored in Modified Sparse Row (MSR) format containing c the L and U factors together. The diagonal (stored in c alu(1:n) ) is inverted. Each i-th row of the alu,jlu matrix c contains the i-th row of L (excluding the diagonal entry=1) c followed by the i-th row of U. c c ju = pointer to the diagonal elements in alu, jlu. c c ierr = integer indicating error code on return c ierr = 0 --> normal return c ierr = k --> code encountered a zero pivot at step k. c work arrays: c------------- c iw = integer work array of length n. c------------ c IMPORTANT c----------- c it is assumed that the the elements in the input matrix are stored c in such a way that in each row the lower part comes first and c then the upper part. To get the correct ILU factorization, it is c also necessary to have the elements of L sorted by increasing c column number. It may therefore be necessary to sort the c elements of a, ja, ia prior to calling ilu0. This can be c achieved by transposing the matrix twice using csrcsc. c c----------------------------------------------------------------------- ju0 = n+2 jlu(1) = ju0 c c initialize work vector to zero's c do 31 i=1, n iw(i) = 0 31 continue c c main loop c do 500 ii = 1, n js = ju0 c c generating row number ii of L and U. c do 100 j=ia(ii),ia(ii+1)-1 c c copy row ii of a, ja, ia into row ii of alu, jlu (L/U) matrix. c jcol = ja(j) if (jcol .eq. ii) then alu(ii) = a(j) iw(jcol) = ii ju(ii) = ju0 else alu(ju0) = a(j) jlu(ju0) = ja(j) iw(jcol) = ju0 ju0 = ju0+1 endif 100 continue jlu(ii+1) = ju0 jf = ju0-1 jm = ju(ii)-1 c c exit if diagonal element is reached. c do 150 j=js, jm jrow = jlu(j) tl = alu(j)*alu(jrow) alu(j) = tl c c perform linear combination c do 140 jj = ju(jrow), jlu(jrow+1)-1 jw = iw(jlu(jj)) if (jw .ne. 0) alu(jw) = alu(jw) - tl*alu(jj) 140 continue 150 continue c c invert and store diagonal element. c if (alu(ii) .eq. 0.0d0) goto 600 alu(ii) = 1.0d0/alu(ii) c c reset pointer iw to zero c iw(ii) = 0 do 201 i = js, jf 201 iw(jlu(i)) = 0 500 continue ierr = 0 return c c zero pivot : c 600 ierr = ii c return c------- end-of-ilu0 --------------------------------------------------- c----------------------------------------------------------------------- end c---------------------------------------------------------------------- subroutine milu0(n, a, ja, ia, alu, jlu, ju, iw, ierr) implicit real*8 (a-h,o-z) scalar alu(*) real*8 a(*) integer ja(*), ia(*), ju(*), jlu(*), iw(*) c----------------------------------------------------------------------* c *** simple milu(0) preconditioner. *** * c----------------------------------------------------------------------* c Note that this has been coded in such a way that it can be used c with pgmres. Normally, since the data structure of a, ja, ia is c the same as that of a, ja, ia, savings can be made. In fact with c some definitions (not correct for general sparse matrices) all we c need in addition to a, ja, ia is an additional diagonal. c Ilu0 is not recommended for serious problems. It is only provided c here for comparison purposes. c----------------------------------------------------------------------- c c on entry: c---------- c n = dimension of matrix c a, ja, c ia = original matrix in compressed sparse row storage. c c on return: c---------- c alu,jlu = matrix stored in Modified Sparse Row (MSR) format containing c the L and U factors together. The diagonal (stored in c alu(1:n) ) is inverted. Each i-th row of the alu,jlu matrix c contains the i-th row of L (excluding the diagonal entry=1) c followed by the i-th row of U. c c ju = pointer to the diagonal elements in alu, jlu. c c ierr = integer indicating error code on return c ierr = 0 --> normal return c ierr = k --> code encountered a zero pivot at step k. c work arrays: c------------- c iw = integer work array of length n. c------------ c Note (IMPORTANT): c----------- C it is assumed that the the elements in the input matrix are ordered c in such a way that in each row the lower part comes first and c then the upper part. To get the correct ILU factorization, it is c also necessary to have the elements of L ordered by increasing c column number. It may therefore be necessary to sort the c elements of a, ja, ia prior to calling milu0. This can be c achieved by transposing the matrix twice using csrcsc. c----------------------------------------------------------- ju0 = n+2 jlu(1) = ju0 c initialize work vector to zero's do 31 i=1, n 31 iw(i) = 0 c c-------------- MAIN LOOP ---------------------------------- c do 500 ii = 1, n js = ju0 c c generating row number ii or L and U. c do 100 j=ia(ii),ia(ii+1)-1 c c copy row ii of a, ja, ia into row ii of alu, jlu (L/U) matrix. c jcol = ja(j) if (jcol .eq. ii) then alu(ii) = a(j) iw(jcol) = ii ju(ii) = ju0 else alu(ju0) = a(j) jlu(ju0) = ja(j) iw(jcol) = ju0 ju0 = ju0+1 endif 100 continue jlu(ii+1) = ju0 jf = ju0-1 jm = ju(ii)-1 c s accumulates fill-in values s = 0.0d0 do 150 j=js, jm jrow = jlu(j) tl = alu(j)*alu(jrow) alu(j) = tl c-----------------------perform linear combination -------- do 140 jj = ju(jrow), jlu(jrow+1)-1 jw = iw(jlu(jj)) if (jw .ne. 0) then alu(jw) = alu(jw) - tl*alu(jj) else s = s + tl*alu(jj) endif 140 continue 150 continue c----------------------- invert and store diagonal element. alu(ii) = alu(ii)-s if (alu(ii) .eq. 0.0d0) goto 600 alu(ii) = 1.0d0/alu(ii) c----------------------- reset pointer iw to zero iw(ii) = 0 do 201 i = js, jf 201 iw(jlu(i)) = 0 500 continue ierr = 0 return c zero pivot : 600 ierr = ii return c------- end-of-milu0 -------------------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine pgmres(n, im, rhs, sol, vv, eps, maxits, iout, * aa, ja, ia, alu, jlu, ju, ierr) c----------------------------------------------------------------------- implicit real*8 (a-h,o-z) integer n, im, maxits, iout, ierr, ja(*), ia(n+1), jlu(*), ju(n) scalar alu(*) real*8 vv(n,*), rhs(n), sol(n), aa(*), eps c----------------------------------------------------------------------* c * c *** ILUT - Preconditioned GMRES *** * c * c----------------------------------------------------------------------* c This is a simple version of the ILUT preconditioned GMRES algorithm. * c The ILUT preconditioner uses a dual strategy for dropping elements * c instead of the usual level of-fill-in approach. See details in ILUT * c subroutine documentation. PGMRES uses the L and U matrices generated * c from the subroutine ILUT to precondition the GMRES algorithm. * c The preconditioning is applied to the right. The stopping criterion * c utilized is based simply on reducing the residual norm by epsilon. * c This preconditioning is more reliable than ilu0 but requires more * c storage. It seems to be much less prone to difficulties related to * c strong nonsymmetries in the matrix. We recommend using a nonzero tol * c (tol=.005 or .001 usually give good results) in ILUT. Use a large * c lfil whenever possible (e.g. lfil = 5 to 10). The higher lfil the * c more reliable the code is. Efficiency may also be much improved. * c Note that lfil=n and tol=0.0 in ILUT will yield the same factors as * c Gaussian elimination without pivoting. * c * c ILU(0) and MILU(0) are also provided for comparison purposes * c USAGE: first call ILUT or ILU0 or MILU0 to set up preconditioner and * c then call pgmres. * c----------------------------------------------------------------------* c Coded by Y. Saad - This version dated May, 7, 1990. * c----------------------------------------------------------------------* c parameters * c----------- * c on entry: * c========== * c * c n == integer. The dimension of the matrix. * c im == size of krylov subspace: should not exceed 50 in this * c version (can be reset by changing parameter command for * c kmax below) * c rhs == real vector of length n containing the right hand side. * c Destroyed on return. * c sol == real vector of length n containing an initial guess to the * c solution on input. approximate solution on output * c eps == tolerance for stopping criterion. process is stopped * c as soon as ( ||.|| is the euclidean norm): * c || current residual||/||initial residual|| <= eps * c maxits== maximum number of iterations allowed * c iout == output unit number number for printing intermediate results * c if (iout .le. 0) nothing is printed out. * c * c aa, ja, * c ia == the input matrix in compressed sparse row format: * c aa(1:nnz) = nonzero elements of A stored row-wise in order * c ja(1:nnz) = corresponding column indices. * c ia(1:n+1) = pointer to beginning of each row in aa and ja. * c here nnz = number of nonzero elements in A = ia(n+1)-ia(1) * c * c alu,jlu== A matrix stored in Modified Sparse Row format containing * c the L and U factors, as computed by subroutine ilut. * c * c ju == integer array of length n containing the pointers to * c the beginning of each row of U in alu, jlu as computed * c by subroutine ILUT. * c * c on return: * c========== * c sol == contains an approximate solution (upon successful return). * c ierr == integer. Error message with the following meaning. * c ierr = 0 --> successful return. * c ierr = 1 --> convergence not achieved in itmax iterations. * c ierr =-1 --> the initial guess seems to be the exact * c solution (initial residual computed was zero) * c * c----------------------------------------------------------------------* c * c work arrays: * c============= * c vv == work array of length n x (im+1) (used to store the Arnoli * c basis) * c----------------------------------------------------------------------* c subroutines called : * c amux : SPARSKIT routine to do the matrix by vector multiplication * c delivers y=Ax, given x -- see SPARSKIT/BLASSM/amux * c lusol : combined forward and backward solves (Preconditioning ope.) * c BLAS1 routines. * c----------------------------------------------------------------------* parameter (kmax=50) real*8 hh(kmax+1,kmax), c(kmax), s(kmax), rs(kmax+1),t c------------------------------------------------------------- c arnoldi size should not exceed kmax=50 in this version.. c to reset modify paramter kmax accordingly. c------------------------------------------------------------- data epsmac/1.d-16/ n1 = n + 1 its = 0 c------------------------------------------------------------- c outer loop starts here.. c-------------- compute initial residual vector -------------- call amux (n, sol, vv, aa, ja, ia) do 21 j=1,n vv(j,1) = rhs(j) - vv(j,1) 21 continue c------------------------------------------------------------- 20 ro = dnrm2(n, vv, 1) if (iout .gt. 0 .and. its .eq. 0) * write(iout, 199) its, ro if (ro .eq. 0.0d0) goto 999 t = 1.0d0/ ro do 210 j=1, n vv(j,1) = vv(j,1)*t 210 continue if (its .eq. 0) eps1=eps*ro c ** initialize 1-st term of rhs of hessenberg system.. rs(1) = ro i = 0 4 i=i+1 its = its + 1 i1 = i + 1 call lusol (n, vv(1,i), rhs, alu, jlu, ju) call amux (n, rhs, vv(1,i1), aa, ja, ia) c----------------------------------------- c modified gram - schmidt... c----------------------------------------- do 55 j=1, i t = ddot(n, vv(1,j),1,vv(1,i1),1) hh(j,i) = t call daxpy(n, -t, vv(1,j), 1, vv(1,i1), 1) 55 continue t = dnrm2(n, vv(1,i1), 1) hh(i1,i) = t if ( t .eq. 0.0d0) goto 58 t = 1.0d0/t do 57 k=1,n vv(k,i1) = vv(k,i1)*t 57 continue c c done with modified gram schimd and arnoldi step.. c now update factorization of hh c 58 if (i .eq. 1) goto 121 c--------perfrom previous transformations on i-th column of h do 66 k=2,i k1 = k-1 t = hh(k1,i) hh(k1,i) = c(k1)*t + s(k1)*hh(k,i) hh(k,i) = -s(k1)*t + c(k1)*hh(k,i) 66 continue 121 gam = sqrt(hh(i,i)**2 + hh(i1,i)**2) c c if gamma is zero then any small value will do... c will affect only residual estimate c if (gam .eq. 0.0d0) gam = epsmac c c get next plane rotation c c(i) = hh(i,i)/gam s(i) = hh(i1,i)/gam rs(i1) = -s(i)*rs(i) rs(i) = c(i)*rs(i) c c detrermine residual norm and test for convergence- c hh(i,i) = c(i)*hh(i,i) + s(i)*hh(i1,i) ro = abs(rs(i1)) 131 format(1h ,2e14.4) if (iout .gt. 0) * write(iout, 199) its, ro if (i .lt. im .and. (ro .gt. eps1)) goto 4 c c now compute solution. first solve upper triangular system. c rs(i) = rs(i)/hh(i,i) do 30 ii=2,i k=i-ii+1 k1 = k+1 t=rs(k) do 40 j=k1,i t = t-hh(k,j)*rs(j) 40 continue rs(k) = t/hh(k,k) 30 continue c c form linear combination of v(*,i)'s to get solution c t = rs(1) do 15 k=1, n rhs(k) = vv(k,1)*t 15 continue do 16 j=2, i t = rs(j) do 161 k=1, n rhs(k) = rhs(k)+t*vv(k,j) 161 continue 16 continue c c call preconditioner. c call lusol (n, rhs, rhs, alu, jlu, ju) do 17 k=1, n sol(k) = sol(k) + rhs(k) 17 continue c c restart outer loop when necessary c if (ro .le. eps1) goto 990 if (its .ge. maxits) goto 991 c c else compute residual vector and continue.. c do 24 j=1,i jj = i1-j+1 rs(jj-1) = -s(jj-1)*rs(jj) rs(jj) = c(jj-1)*rs(jj) 24 continue do 25 j=1,i1 t = rs(j) if (j .eq. 1) t = t-1.0d0 call daxpy (n, t, vv(1,j), 1, vv, 1) 25 continue 199 format(' its =', i4, ' res. norm =', d20.6) c restart outer loop. goto 20 990 ierr = 0 return 991 ierr = 1 return 999 continue ierr = -1 return c-----------------end of pgmres --------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine lusol(n, y, x, alu, jlu, ju) scalar alu(*) real*8 x(n), y(n) integer n, jlu(*), ju(*) c----------------------------------------------------------------------- c c This routine solves the system (LU) x = y, c given an LU decomposition of a matrix stored in (alu, jlu, ju) c modified sparse row format c c----------------------------------------------------------------------- c on entry: c n = dimension of system c y = the right-hand-side vector c alu, jlu, ju c = the LU matrix as provided from the ILU routines. c c on return c x = solution of LU x = y. c----------------------------------------------------------------------- c c Note: routine is in place: call lusol (n, x, x, alu, jlu, ju) c will solve the system with rhs x and overwrite the result on x . c c----------------------------------------------------------------------- c local variables c integer i,k c c forward solve c do 40 i = 1, n x(i) = y(i) do 41 k=jlu(i),ju(i)-1 x(i) = x(i) - alu(k)* x(jlu(k)) 41 continue 40 continue c c backward solve. c do 90 i = n, 1, -1 do 91 k=ju(i),jlu(i+1)-1 x(i) = x(i) - alu(k)*x(jlu(k)) 91 continue x(i) = alu(i)*x(i) 90 continue c return c----------------end of lusol ------------------------------------------ c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine lutsol(n, y, x, alu, jlu, ju) scalar alu(*) real*8 x(n), y(n) integer n, jlu(*), ju(*) c----------------------------------------------------------------------- c c This routine solves the system Transp(LU) x = y, c given an LU decomposition of a matrix stored in (alu, jlu, ju) c modified sparse row format. Transp(M) is the transpose of M. c----------------------------------------------------------------------- c on entry: c n = dimension of system c y = the right-hand-side vector c alu, jlu, ju c = the LU matrix as provided from the ILU routines. c c on return c x = solution of transp(LU) x = y. c----------------------------------------------------------------------- c c Note: routine is in place: call lutsol (n, x, x, alu, jlu, ju) c will solve the system with rhs x and overwrite the result on x . c c----------------------------------------------------------------------- c local variables c integer i,k c do 10 i = 1, n x(i) = y(i) 10 continue c c forward solve (with U^T) c do 20 i = 1, n x(i) = x(i) * alu(i) do 30 k=ju(i),jlu(i+1)-1 x(jlu(k)) = x(jlu(k)) - alu(k)* x(i) 30 continue 20 continue c c backward solve (with L^T) c do 40 i = n, 1, -1 do 50 k=jlu(i),ju(i)-1 x(jlu(k)) = x(jlu(k)) - alu(k)*x(i) 50 continue 40 continue c return c----------------end of lutsol ----------------------------------------- c----------------------------------------------------------------------- end c----------------------------------------------------------------------- subroutine qsplit(a,ind,n,ncut) real*8 a(n) integer ind(n), n, ncut c----------------------------------------------------------------------- c does a quick-sort split of a real array. c on input a(1:n). is a real array c on output a(1:n) is permuted such that its elements satisfy: c c abs(a(i)) .ge. abs(a(ncut)) for i .lt. ncut and c abs(a(i)) .le. abs(a(ncut)) for i .gt. ncut c c ind(1:n) is an integer array which permuted in the same way as a(*). c----------------------------------------------------------------------- real*8 tmp, abskey integer itmp, first, last c----- first = 1 last = n if (ncut .lt. first .or. ncut .gt. last) return c c outer loop -- while mid .ne. ncut do c 1 mid = first abskey = abs(a(mid)) do 2 j=first+1, last if (abs(a(j)) .gt. abskey) then mid = mid+1 c interchange tmp = a(mid) itmp = ind(mid) a(mid) = a(j) ind(mid) = ind(j) a(j) = tmp ind(j) = itmp endif 2 continue c c interchange c tmp = a(mid) a(mid) = a(first) a(first) = tmp c itmp = ind(mid) ind(mid) = ind(first) ind(first) = itmp c c test for while loop c if (mid .eq. ncut) return if (mid .gt. ncut) then last = mid-1 else first = mid+1 endif goto 1 c----------------end-of-qsplit------------------------------------------ c----------------------------------------------------------------------- end getdp-2.7.0-source/contrib/Sparskit/blas1.f000644 001750 001750 00000037460 11266605601 022227 0ustar00geuzainegeuzaine000000 000000 c $Id: blas1.f,v 1.1 2008-04-11 06:01:05 geuzaine Exp $ subroutine dcopy(n,dx,incx,dy,incy) c c copies a vector, x, to a vector, y. c uses unrolled loops for increments equal to one. c jack dongarra, linpack, 3/11/78. c double precision dx(1),dy(1) integer i,incx,incy,ix,iy,m,mp1,n c if(n.le.0)return if(incx.eq.1.and.incy.eq.1)go to 20 c c code for unequal increments or equal increments c not equal to 1 c ix = 1 iy = 1 if(incx.lt.0)ix = (-n+1)*incx + 1 if(incy.lt.0)iy = (-n+1)*incy + 1 do 10 i = 1,n dy(iy) = dx(ix) ix = ix + incx iy = iy + incy 10 continue return c c code for both increments equal to 1 c c c clean-up loop c 20 m = mod(n,7) if( m .eq. 0 ) go to 40 do 30 i = 1,m dy(i) = dx(i) 30 continue if( n .lt. 7 ) return 40 mp1 = m + 1 do 50 i = mp1,n,7 dy(i) = dx(i) dy(i + 1) = dx(i + 1) dy(i + 2) = dx(i + 2) dy(i + 3) = dx(i + 3) dy(i + 4) = dx(i + 4) dy(i + 5) = dx(i + 5) dy(i + 6) = dx(i + 6) 50 continue return end double precision function ddot(n,dx,incx,dy,incy) c c forms the dot product of two vectors. c uses unrolled loops for increments equal to one. c jack dongarra, linpack, 3/11/78. c double precision dx(1),dy(1),dtemp integer i,incx,incy,ix,iy,m,mp1,n c ddot = 0.0d0 dtemp = 0.0d0 if(n.le.0)return if(incx.eq.1.and.incy.eq.1)go to 20 c c code for unequal increments or equal increments c not equal to 1 c ix = 1 iy = 1 if(incx.lt.0)ix = (-n+1)*incx + 1 if(incy.lt.0)iy = (-n+1)*incy + 1 do 10 i = 1,n dtemp = dtemp + dx(ix)*dy(iy) ix = ix + incx iy = iy + incy 10 continue ddot = dtemp return c c code for both increments equal to 1 c c c clean-up loop c 20 m = mod(n,5) if( m .eq. 0 ) go to 40 do 30 i = 1,m dtemp = dtemp + dx(i)*dy(i) 30 continue if( n .lt. 5 ) go to 60 40 mp1 = m + 1 do 50 i = mp1,n,5 dtemp = dtemp + dx(i)*dy(i) + dx(i + 1)*dy(i + 1) + * dx(i + 2)*dy(i + 2) + dx(i + 3)*dy(i + 3) + dx(i + 4)*dy(i + 4) 50 continue 60 ddot = dtemp return end c double precision function dasum(n,dx,incx) c c takes the sum of the absolute values. c jack dongarra, linpack, 3/11/78. c double precision dx(1),dtemp integer i,incx,m,mp1,n,nincx c dasum = 0.0d0 dtemp = 0.0d0 if(n.le.0)return if(incx.eq.1)go to 20 c c code for increment not equal to 1 c nincx = n*incx do 10 i = 1,nincx,incx dtemp = dtemp + dabs(dx(i)) 10 continue dasum = dtemp return c c code for increment equal to 1 c c c clean-up loop c 20 m = mod(n,6) if( m .eq. 0 ) go to 40 do 30 i = 1,m dtemp = dtemp + dabs(dx(i)) 30 continue if( n .lt. 6 ) go to 60 40 mp1 = m + 1 do 50 i = mp1,n,6 dtemp = dtemp + dabs(dx(i)) + dabs(dx(i + 1)) + dabs(dx(i + 2)) * + dabs(dx(i + 3)) + dabs(dx(i + 4)) + dabs(dx(i + 5)) 50 continue 60 dasum = dtemp return end subroutine daxpy(n,da,dx,incx,dy,incy) c c constant times a vector plus a vector. c uses unrolled loops for increments equal to one. c jack dongarra, linpack, 3/11/78. c double precision dx(1),dy(1),da integer i,incx,incy,ix,iy,m,mp1,n c if(n.le.0)return if (da .eq. 0.0d0) return if(incx.eq.1.and.incy.eq.1)go to 20 c c code for unequal increments or equal increments c not equal to 1 c ix = 1 iy = 1 if(incx.lt.0)ix = (-n+1)*incx + 1 if(incy.lt.0)iy = (-n+1)*incy + 1 do 10 i = 1,n dy(iy) = dy(iy) + da*dx(ix) ix = ix + incx iy = iy + incy 10 continue return c c code for both increments equal to 1 c c c clean-up loop c 20 m = mod(n,4) if( m .eq. 0 ) go to 40 do 30 i = 1,m dy(i) = dy(i) + da*dx(i) 30 continue if( n .lt. 4 ) return 40 mp1 = m + 1 do 50 i = mp1,n,4 dy(i) = dy(i) + da*dx(i) dy(i + 1) = dy(i + 1) + da*dx(i + 1) dy(i + 2) = dy(i + 2) + da*dx(i + 2) dy(i + 3) = dy(i + 3) + da*dx(i + 3) 50 continue return end double precision function dnrm2 ( n, dx, incx) integer next double precision dx(1), cutlo, cuthi, hitest, sum, xmax,zero,one data zero, one /0.0d0, 1.0d0/ c c euclidean norm of the n-vector stored in dx() with storage c increment incx . c if n .le. 0 return with result = 0. c if n .ge. 1 then incx must be .ge. 1 c c c.l.lawson, 1978 jan 08 c c four phase method using two built-in constants that are c hopefully applicable to all machines. c cutlo = maximum of dsqrt(u/eps) over all known machines. c cuthi = minimum of dsqrt(v) over all known machines. c where c eps = smallest no. such that eps + 1. .gt. 1. c u = smallest positive no. (underflow limit) c v = largest no. (overflow limit) c c brief outline of algorithm.. c c phase 1 scans zero components. c move to phase 2 when a component is nonzero and .le. cutlo c move to phase 3 when a component is .gt. cutlo c move to phase 4 when a component is .ge. cuthi/m c where m = n for x() real and m = 2*n for complex. c c values for cutlo and cuthi.. c from the environmental parameters listed in the imsl converter c document the limiting values are as follows.. c cutlo, s.p. u/eps = 2**(-102) for honeywell. close seconds are c univac and dec at 2**(-103) c thus cutlo = 2**(-51) = 4.44089e-16 c cuthi, s.p. v = 2**127 for univac, honeywell, and dec. c thus cuthi = 2**(63.5) = 1.30438e19 c cutlo, d.p. u/eps = 2**(-67) for honeywell and dec. c thus cutlo = 2**(-33.5) = 8.23181d-11 c cuthi, d.p. same as s.p. cuthi = 1.30438d19 c data cutlo, cuthi / 8.232d-11, 1.304d19 / c data cutlo, cuthi / 4.441e-16, 1.304e19 / data cutlo, cuthi / 8.232d-11, 1.304d19 / c if(n .gt. 0) go to 10 dnrm2 = zero go to 300 c 10 assign 30 to next sum = zero nn = n * incx c begin main loop i = 1 20 go to next,(30, 50, 70, 110) 30 if( dabs(dx(i)) .gt. cutlo) go to 85 assign 50 to next xmax = zero c c phase 1. sum is zero c 50 if( dx(i) .eq. zero) go to 200 if( dabs(dx(i)) .gt. cutlo) go to 85 c c prepare for phase 2. assign 70 to next go to 105 c c prepare for phase 4. c 100 i = j assign 110 to next sum = (sum / dx(i)) / dx(i) 105 xmax = dabs(dx(i)) go to 115 c c phase 2. sum is small. c scale to avoid destructive underflow. c 70 if( dabs(dx(i)) .gt. cutlo ) go to 75 c c common code for phases 2 and 4. c in phase 4 sum is large. scale to avoid overflow. c 110 if( dabs(dx(i)) .le. xmax ) go to 115 sum = one + sum * (xmax / dx(i))**2 xmax = dabs(dx(i)) go to 200 c 115 sum = sum + (dx(i)/xmax)**2 go to 200 c c c prepare for phase 3. c 75 sum = (sum * xmax) * xmax c c c for real or d.p. set hitest = cuthi/n c for complex set hitest = cuthi/(2*n) c 85 hitest = cuthi/float( n ) c c phase 3. sum is mid-range. no scaling. c do 95 j =i,nn,incx if(dabs(dx(j)) .ge. hitest) go to 100 95 sum = sum + dx(j)**2 dnrm2 = dsqrt( sum ) go to 300 c 200 continue i = i + incx if ( i .le. nn ) go to 20 c c end of main loop. c c compute square root and adjust for scaling. c dnrm2 = xmax * dsqrt(sum) 300 continue return end subroutine dscal(n,da,dx,incx) c scales a vector by a constant. c uses unrolled loops for increment equal to one. c jack dongarra, linpack, 3/11/78. c double precision da,dx(1) integer i,incx,m,mp1,n,nincx c if(n.le.0)return if(incx.eq.1)go to 20 c c code for increment not equal to 1 c nincx = n*incx do 10 i = 1,nincx,incx dx(i) = da*dx(i) 10 continue return c c code for increment equal to 1 c c c clean-up loop c 20 m = mod(n,5) if( m .eq. 0 ) go to 40 do 30 i = 1,m dx(i) = da*dx(i) 30 continue if( n .lt. 5 ) return 40 mp1 = m + 1 do 50 i = mp1,n,5 dx(i) = da*dx(i) dx(i + 1) = da*dx(i + 1) dx(i + 2) = da*dx(i + 2) dx(i + 3) = da*dx(i + 3) dx(i + 4) = da*dx(i + 4) 50 continue return end subroutine dswap (n,dx,incx,dy,incy) c c interchanges two vectors. c uses unrolled loops for increments equal one. c jack dongarra, linpack, 3/11/78. c double precision dx(1),dy(1),dtemp integer i,incx,incy,ix,iy,m,mp1,n c if(n.le.0)return if(incx.eq.1.and.incy.eq.1)go to 20 c c code for unequal increments or equal increments not equal c to 1 c ix = 1 iy = 1 if(incx.lt.0)ix = (-n+1)*incx + 1 if(incy.lt.0)iy = (-n+1)*incy + 1 do 10 i = 1,n dtemp = dx(ix) dx(ix) = dy(iy) dy(iy) = dtemp ix = ix + incx iy = iy + incy 10 continue return c c code for both increments equal to 1 c c c clean-up loop c 20 m = mod(n,3) if( m .eq. 0 ) go to 40 do 30 i = 1,m dtemp = dx(i) dx(i) = dy(i) dy(i) = dtemp 30 continue if( n .lt. 3 ) return 40 mp1 = m + 1 do 50 i = mp1,n,3 dtemp = dx(i) dx(i) = dy(i) dy(i) = dtemp dtemp = dx(i + 1) dx(i + 1) = dy(i + 1) dy(i + 1) = dtemp dtemp = dx(i + 2) dx(i + 2) = dy(i + 2) dy(i + 2) = dtemp 50 continue return end integer function idamax(n,dx,incx) c c finds the index of element having max. absolute value. c jack dongarra, linpack, 3/11/78. c double precision dx(1),dmax integer i,incx,ix,n c idamax = 0 if( n .lt. 1 ) return idamax = 1 if(n.eq.1)return if(incx.eq.1)go to 20 c c code for increment not equal to 1 c ix = 1 dmax = dabs(dx(1)) ix = ix + incx do 10 i = 2,n if(dabs(dx(ix)).le.dmax) go to 5 idamax = i dmax = dabs(dx(ix)) 5 ix = ix + incx 10 continue return c c code for increment equal to 1 c 20 dmax = dabs(dx(1)) do 30 i = 2,n if(dabs(dx(i)).le.dmax) go to 30 idamax = i dmax = dabs(dx(i)) 30 continue return end c subroutine drot (n,dx,incx,dy,incy,c,s) c c applies a plane rotation. c jack dongarra, linpack, 3/11/78. c double precision dx(1),dy(1),dtemp,c,s integer i,incx,incy,ix,iy,n c if(n.le.0)return if(incx.eq.1.and.incy.eq.1)go to 20 c c code for unequal increments or equal increments not equal c to 1 c ix = 1 iy = 1 if(incx.lt.0)ix = (-n+1)*incx + 1 if(incy.lt.0)iy = (-n+1)*incy + 1 do 10 i = 1,n dtemp = c*dx(ix) + s*dy(iy) dy(iy) = c*dy(iy) - s*dx(ix) dx(ix) = dtemp ix = ix + incx iy = iy + incy 10 continue return c c code for both increments equal to 1 c 20 do 30 i = 1,n dtemp = c*dx(i) + s*dy(i) dy(i) = c*dy(i) - s*dx(i) dx(i) = dtemp 30 continue return end c subroutine drotg(da,db,c,s) c c construct givens plane rotation. c jack dongarra, linpack, 3/11/78. c double precision da,db,c,s,roe,scale,r,z c roe = db if( dabs(da) .gt. dabs(db) ) roe = da scale = dabs(da) + dabs(db) if( scale .ne. 0.0d0 ) go to 10 c = 1.0d0 s = 0.0d0 r = 0.0d0 go to 20 10 r = scale*dsqrt((da/scale)**2 + (db/scale)**2) r = dsign(1.0d0,roe)*r c = da/r s = db/r 20 z = 1.0d0 if( dabs(da) .gt. dabs(db) ) z = s if( dabs(db) .ge. dabs(da) .and. c .ne. 0.0d0 ) z = 1.0d0/c da = r db = z return end c subroutine ccopy(n,cx,incx,cy,incy) c c copies a vector, x, to a vector, y. c jack dongarra, linpack, 3/11/78. c complex cx(1),cy(1) integer i,incx,incy,ix,iy,n c if(n.le.0)return if(incx.eq.1.and.incy.eq.1)go to 20 c c code for unequal increments or equal increments c not equal to 1 c ix = 1 iy = 1 if(incx.lt.0)ix = (-n+1)*incx + 1 if(incy.lt.0)iy = (-n+1)*incy + 1 do 10 i = 1,n cy(iy) = cx(ix) ix = ix + incx iy = iy + incy 10 continue return c c code for both increments equal to 1 c 20 do 30 i = 1,n cy(i) = cx(i) 30 continue return end subroutine cscal(n,ca,cx,incx) c c scales a vector by a constant. c jack dongarra, linpack, 3/11/78. c complex ca,cx(1) integer i,incx,n,nincx c if(n.le.0)return if(incx.eq.1)go to 20 c c code for increment not equal to 1 c nincx = n*incx do 10 i = 1,nincx,incx cx(i) = ca*cx(i) 10 continue return c c code for increment equal to 1 c 20 do 30 i = 1,n cx(i) = ca*cx(i) 30 continue return end c subroutine csrot (n,cx,incx,cy,incy,c,s) c c applies a plane rotation, where the cos and sin (c and s) are real c and the vectors cx and cy are complex. c jack dongarra, linpack, 3/11/78. c complex cx(1),cy(1),ctemp real c,s integer i,incx,incy,ix,iy,n c if(n.le.0)return if(incx.eq.1.and.incy.eq.1)go to 20 c c code for unequal increments or equal increments not equal c to 1 c ix = 1 iy = 1 if(incx.lt.0)ix = (-n+1)*incx + 1 if(incy.lt.0)iy = (-n+1)*incy + 1 do 10 i = 1,n ctemp = c*cx(ix) + s*cy(iy) cy(iy) = c*cy(iy) - s*cx(ix) cx(ix) = ctemp ix = ix + incx iy = iy + incy 10 continue return c c code for both increments equal to 1 c 20 do 30 i = 1,n ctemp = c*cx(i) + s*cy(i) cy(i) = c*cy(i) - s*cx(i) cx(i) = ctemp 30 continue return end subroutine cswap (n,cx,incx,cy,incy) c c interchanges two vectors. c jack dongarra, linpack, 3/11/78. c complex cx(1),cy(1),ctemp integer i,incx,incy,ix,iy,n c if(n.le.0)return if(incx.eq.1.and.incy.eq.1)go to 20 c c code for unequal increments or equal increments not equal c to 1 c ix = 1 iy = 1 if(incx.lt.0)ix = (-n+1)*incx + 1 if(incy.lt.0)iy = (-n+1)*incy + 1 do 10 i = 1,n ctemp = cx(ix) cx(ix) = cy(iy) cy(iy) = ctemp ix = ix + incx iy = iy + incy 10 continue return c c code for both increments equal to 1 20 do 30 i = 1,n ctemp = cx(i) cx(i) = cy(i) cy(i) = ctemp 30 continue return end subroutine csscal(n,sa,cx,incx) c c scales a complex vector by a real constant. c jack dongarra, linpack, 3/11/78. c complex cx(1) real sa integer i,incx,n,nincx c if(n.le.0)return if(incx.eq.1)go to 20 c c code for increment not equal to 1 c nincx = n*incx do 10 i = 1,nincx,incx cx(i) = cmplx(sa*real(cx(i)),sa*aimag(cx(i))) 10 continue return c c code for increment equal to 1 c 20 do 30 i = 1,n cx(i) = cmplx(sa*real(cx(i)),sa*aimag(cx(i))) 30 continue return end getdp-2.7.0-source/contrib/Sparskit/CMakeLists.txt000644 001750 001750 00000000726 12473553037 023617 0ustar00geuzainegeuzaine000000 000000 # GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege # # See the LICENSE.txt file for license information. Please report all # bugs and problems to the public mailing list . set(SRC Sparskit.cpp blas1.f blassm.f cmkreord.f flu.f formats.f inout.f iters.f matvec.f reordering.f unary.f ilut.F ) file(GLOB HDR RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} *.h) append_getdp_src(contrib/Sparskit "${SRC};${HDR}") getdp-2.7.0-source/demos/Magnetostatics.pro000644 001750 001750 00000016473 12542221512 022426 0ustar00geuzainegeuzaine000000 000000 Group { // Input groups: DefineGroup[ Domain_M = {{}, Name "Regions/0Sources/Permanent magnets"}, Domain_S = {{}, Name "Regions/0Sources/Inductor (imposed j_s)"}, Domain_Inf = {{}, Name "Regions/0Special regions/Infinite domain (spherical shell)", Closed "1"}, Domain_Mag = {{}, Name "Regions/Other regions/Passive magnetic regions"}, Dirichlet_phi_0 = {{}, Name "Regions/0Boundary conditions/h_t = 0", Closed "1"}, Dirichlet_a_0 = {{}, Name "Regions/0Boundary conditions/b_n = 0"} ]; DefineGroup[ Domain = {{Domain_Mag, Domain_M, Domain_S, Domain_Inf}, Name "Regions/Computational domain", Visible 0} ]; } Function{ // Input constants: DefineConstant[ Val_Rint, Val_Rext // interior/exterior radius of Domain_Inf Nb_max_iter = 30, relaxation_factor = 1, stop_criterion = 1e-5, Flag_NL = 1, Flag_NL_Newton_Raphson = {1, Choices{0,1}, Visible Flag_NL, Name "Parameters/Materials/2Newton-Raphson iteration"} //R_ = {"MagSta_phi", Name "GetDP/1ResolutionChoices", Visible 0}, //C_ = {"-solve -v2", Name "GetDP/9ComputeCommand", Visible 0} //P_ = {"", Name "GetDP/2PostOperationChoices", Visible 0} ]; // Input functions: DefineFunction[ mu, // magnetic permeability nu, // magnetic reluctivity hc, // coercive magnetic field js // source current density dhdb_NL, dbdh_NL // part of the Jacobian matrix need for Newton-Raphson ]; // remove this: only for demo //DefineConstant[ hcx = {0, Label "Coercive field h_x", Path "Sources"}]; //DefineConstant[ hcy = {1000, Label "Coercive field h_y", Path "Sources"}]; //hc[] = Vector[hcx,hcy,0]; //mu[] = 4*Pi*10^-7; //nu[] = 1/mu[]; } Jacobian { { Name JVol ; Case { { Region Domain_Inf ; Jacobian VolSphShell{Val_Rint, Val_Rext} ; } { Region All ; Jacobian Vol ; } } } } Integration { { Name I1 ; Case { { Type Gauss ; Case { { GeoElement Triangle ; NumberOfPoints 4 ; } { GeoElement Quadrangle ; NumberOfPoints 4 ; } } } } } } /* -------------------------------------------------------------------------- MagSta_phi : Magnetic scalar potential phi formulation -------------------------------------------------------------------------- */ Constraint { { Name phi ; Case { { Region Dirichlet_phi_0 ; Value 0. ; } } } } FunctionSpace { { Name Hgrad_phi ; Type Form0 ; BasisFunction { { Name sn ; NameOfCoef phin ; Function BF_Node ; Support Domain ; Entity NodesOf[ All ] ; } } Constraint { { NameOfCoef phin ; EntityType NodesOf ; NameOfConstraint phi ; } } } } Formulation { { Name MagSta_phi ; Type FemEquation ; Quantity { { Name phi ; Type Local ; NameOfSpace Hgrad_phi ; } } Equation { Galerkin { [ - mu[-{d phi}] * Dof{d phi} , {d phi} ] ; In Domain ; Jacobian JVol ; Integration I1 ; } Galerkin { JacNL [ - dbdh_NL[-{d phi}] * Dof{d phi} , {d phi} ] ; In Domain_NL ; Jacobian JVol ; Integration I1 ; } Galerkin { [ - mu[] * hc[] , {d phi} ] ; In Domain_M ; Jacobian JVol ; Integration I1 ; } } } } Resolution { { Name MagSta_phi ; System { { Name A ; NameOfFormulation MagSta_phi ; } } Operation { If(!Flag_NL) Generate[A] ; Solve[A] ; EndIf If(Flag_NL) //IterativeLoopN[ Nb_max_iter, relaxation_factor, // System { {A, reltol, abstol, Solution MeanL2Norm} } ]{ IterativeLoop[Nb_max_iter, stop_criterion, relaxation_factor]{ GenerateJac[A] ; SolveJac[A] ; } EndIf SaveSolution[A] ; //PostOperation[MagSta_phi] ; } } } PostProcessing { { Name MagSta_phi ; NameOfFormulation MagSta_phi ; Quantity { { Name b ; Value { Local { [ - mu[-{d phi}] * {d phi} ] ; In Domain ; Jacobian JVol ; } Local { [ - mu[] * hc[] ] ; In Domain_M ; Jacobian JVol ; } } } { Name h ; Value { Local { [ - {d phi} ] ; In Domain ; Jacobian JVol ; } } } { Name hc ; Value { Local { [ hc[] ] ; In Domain_M ; Jacobian JVol ; } } } { Name phi ; Value { Local { [ {phi} ] ; In Domain ; Jacobian JVol ; } } } } } } PostOperation { { Name MagSta_phi ; NameOfPostProcessing MagSta_phi; Operation { Print[ b, OnElementsOf Domain, File "MagSta_phi_b.pos" ] ; Print[ h, OnElementsOf Domain, File "MagSta_phi_h.pos" ] ; Print[ hc, OnElementsOf Domain, File "MagSta_a_hc.pos" ] ; Print[ phi, OnElementsOf Domain, File "MagSta_phi_phi.pos" ] ; } } } /* -------------------------------------------------------------------------- MagSta_a : Magnetic vector potential a formulation (2D) -------------------------------------------------------------------------- */ Constraint { { Name a ; Case { { Region Dirichlet_a_0 ; Value 0. ; } } } } FunctionSpace { { Name Hcurl_a ; Type Form1P ; BasisFunction { { Name se ; NameOfCoef ae ; Function BF_PerpendicularEdge ; Support Domain ; Entity NodesOf[ All ] ; } } Constraint { { NameOfCoef ae ; EntityType NodesOf ; NameOfConstraint a ; } } } } Formulation { { Name MagSta_a ; Type FemEquation ; Quantity { { Name a ; Type Local ; NameOfSpace Hcurl_a ; } } Equation { Galerkin { [ nu[{d a}] * Dof{d a} , {d a} ] ; In Domain ; Jacobian JVol ; Integration I1 ; } Galerkin { JacNL [ dhdb_NL[{d a}] * Dof{d a} , {d a} ] ; In Domain_NL ; Jacobian JVol ; Integration I1 ; } Galerkin { [ hc[] , {d a} ] ; In Domain_M ; Jacobian JVol ; Integration I1 ; } Galerkin { [ -js[] , {a} ] ; In Domain_S ; Jacobian JVol ; Integration I1 ; } } } } Resolution { { Name MagSta_a ; System { { Name A ; NameOfFormulation MagSta_a ; } } Operation { If(!Flag_NL) Generate[A] ; Solve[A] ; EndIf If(Flag_NL) //IterativeLoopN[ Nb_max_iter, relaxation_factor, // System { {A, reltol, abstol, Solution MeanL2Norm} } ]{ IterativeLoop[Nb_max_iter, stop_criterion, relaxation_factor]{ GenerateJac[A] ; SolveJac[A] ; } EndIf SaveSolution[A] ; //PostOperation[MagSta_a]; } } } PostProcessing { { Name MagSta_a ; NameOfFormulation MagSta_a ; Quantity { { Name az ; Value { Local { [ CompZ[{a}] ] ; In Domain ; Jacobian JVol ; } } } { Name b ; Value { Local { [ {d a} ] ; In Domain ; Jacobian JVol ; } } } { Name a ; Value { Local { [ {a} ] ; In Domain ; Jacobian JVol ; } } } { Name h ; Value { Local { [ nu[{d a}] * {d a} ] ; In Domain ; Jacobian JVol ; } Local { [ hc[] ] ; In Domain_M ; Jacobian JVol ; } } } { Name hc ; Value { Local { [ hc[] ] ; In Domain_M ; Jacobian JVol ; } } } } } } PostOperation { { Name MagSta_a ; NameOfPostProcessing MagSta_a; Operation { Print[ b, OnElementsOf Domain, File "MagSta_a_b.pos" ] ; Print[ h, OnElementsOf Domain, File "MagSta_a_h.pos" ] ; Print[ hc, OnElementsOf Domain, File "MagSta_a_hc.pos" ] ; Print[ az, OnElementsOf Domain, File "MagSta_az_a.pos" ] ; } } } getdp-2.7.0-source/demos/magnet_data.pro000644 001750 001750 00000000536 12247432724 021711 0ustar00geuzainegeuzaine000000 000000 DefineConstant[ Val_Rint = {0.15, Min 0.2, Max 1, Step 0.1, Name "Parameters/Geometry/1Internal shell radius (m)"} ]; DefineConstant[ Val_Rext = {0.25, Min Val_Rint, Max 0.5, Step 0.1, Name "Parameters/Geometry/2External shell radius (m)"}]; AIR = 100; AIR_INF = 101; AIR_GAP = 102; MAGNET = 103; CORE = 104; LINE_INF = 105; LINE_X = 106; getdp-2.7.0-source/demos/BH.pro000644 001750 001750 00000005105 12326765734 017743 0ustar00geuzainegeuzaine000000 000000 Function{ // analytical: nu = 100. + 10. * exp ( 1.8 * b * b ) nu_1a[] = 100. + 10. * Exp[1.8*SquNorm[$1]] ; dnudb2_1a[] = 18. * Exp[1.8*SquNorm[$1]] ; h_1a[] = nu_1a[$1]*$1 ; dhdb_1a[] = TensorDiag[1,1,1] * nu_1a[$1#1] + 2*dnudb2_1a[#1] * SquDyadicProduct[#1] ; dhdb_1a_NL[] = 2*dnudb2_1a[$1#1] * SquDyadicProduct[#1] ; // interpolated Mat1_h = { 0.0000e+00, 5.5023e+00, 1.1018e+01, 1.6562e+01, 2.2149e+01, 2.7798e+01, 3.3528e+01, 3.9363e+01, 4.5335e+01, 5.1479e+01, 5.7842e+01, 6.4481e+01, 7.1470e+01, 7.8906e+01, 8.6910e+01, 9.5644e+01, 1.0532e+02, 1.1620e+02, 1.2868e+02, 1.4322e+02, 1.6050e+02, 1.8139e+02, 2.0711e+02, 2.3932e+02, 2.8028e+02, 3.3314e+02, 4.0231e+02, 4.9395e+02, 6.1678e+02, 7.8320e+02, 1.0110e+03, 1.3257e+03, 1.7645e+03, 2.3819e+03, 3.2578e+03, 4.5110e+03, 6.3187e+03, 8.9478e+03, 1.2802e+04, 1.8500e+04, 2.6989e+04, 3.9739e+04, 5.9047e+04, 8.8520e+04, 1.3388e+05, 2.0425e+05, 3.1434e+05, 4.8796e+05, 7.6403e+05 } ; Mat1_b = { 0.0000e+00, 5.0000e-02, 1.0000e-01, 1.5000e-01, 2.0000e-01, 2.5000e-01, 3.0000e-01, 3.5000e-01, 4.0000e-01, 4.5000e-01, 5.0000e-01, 5.5000e-01, 6.0000e-01, 6.5000e-01, 7.0000e-01, 7.5000e-01, 8.0000e-01, 8.5000e-01, 9.0000e-01, 9.5000e-01, 1.0000e+00, 1.0500e+00, 1.1000e+00, 1.1500e+00, 1.2000e+00, 1.2500e+00, 1.3000e+00, 1.3500e+00, 1.4000e+00, 1.4500e+00, 1.5000e+00, 1.5500e+00, 1.6000e+00, 1.6500e+00, 1.7000e+00, 1.7500e+00, 1.8000e+00, 1.8500e+00, 1.9000e+00, 1.9500e+00, 2.0000e+00, 2.0500e+00, 2.1000e+00, 2.1500e+00, 2.2000e+00, 2.2500e+00, 2.3000e+00, 2.3500e+00, 2.4000e+00 } ; // for a-formulation Mat1_b2 = List[Mat1_b]^2; Mat1_nu = List[Mat1_h]/List[Mat1_b]; Mat1_nu(0) = Mat1_nu(1); Mat1_nu_b2 = ListAlt[Mat1_b2, Mat1_nu] ; nu_1[] = InterpolationLinear[ SquNorm[$1] ]{List[Mat1_nu_b2]} ; dnudb2_1[] = dInterpolationLinear[SquNorm[$1]]{List[Mat1_nu_b2]} ; h_1[] = nu_1[$1] * $1 ; dhdb_1[] = TensorDiag[1,1,1] * nu_1[$1#1] + 2*dnudb2_1[#1] * SquDyadicProduct[#1] ; dhdb_1_NL[] = 2*dnudb2_1[$1#1] * SquDyadicProduct[#1] ; // for phi-formulation Mat1_h2 = List[Mat1_h]^2; Mat1_mu = List[Mat1_b]/List[Mat1_h]; Mat1_mu(0) = Mat1_mu(1); Mat1_mu_h2 = ListAlt[Mat1_h2, Mat1_mu] ; mu_1[] = InterpolationLinear[SquNorm[$1]]{List[Mat1_mu_h2]} ; dmudh2_1[] = dInterpolationLinear[SquNorm[$1]]{List[Mat1_mu_h2]} ; b_1[] = mu_1[$1] * $1 ; // $1 = -{d phi} dbdh_1[] = TensorDiag[1,1,1] * mu_1[$1] + 2*dmudh2_1[$1] * SquDyadicProduct[$1] ; dbdh_1_NL[] = 2*dmudh2_1[$1] * SquDyadicProduct[$1] ; } getdp-2.7.0-source/demos/magnet.msh000644 001750 001750 00000521036 12321573224 020704 0ustar00geuzainegeuzaine000000 000000 $MeshFormat 2.2 0 8 $EndMeshFormat $Nodes 1691 1 0 0 0 2 -0.07000000000000001 0 0 3 -0.07000000000000001 0.07000000000000001 0 4 0.07000000000000001 0 0 5 0.07000000000000001 0.07000000000000001 0 6 -0.07000000000000001 0.015 0 7 -0.04000000000000001 0.015 0 8 -0.04000000000000001 0 0 9 0.04000000000000001 0 0 10 0.04000000000000001 0.04000000000000001 0 11 -0.04000000000000001 0.04000000000000001 0 12 0.07000000000000001 0.0025 0 13 0.04000000000000001 0.0025 0 14 0.15 0 0 15 0.25 0 0 16 0 0.15 0 17 0 0.25 0 18 -0.25 0 0 19 -0.15 0 0 20 -0.2375000000000244 0 0 21 -0.2250000000000705 0 0 22 -0.2125000000001057 0 0 23 -0.2000000000001356 0 0 24 -0.1875000000001003 0 0 25 -0.1750000000000651 0 0 26 -0.1625000000000298 0 0 27 -0.1391126053982107 0 0 28 -0.1289956898327272 0 0 29 -0.119594729068269 0 0 30 -0.1108590545471922 0 0 31 -0.1027415892067458 0 0 32 -0.09519857981791344 0 0 33 -0.08818937643297675 0 0 34 -0.08167619799310902 0 0 35 -0.07562394585072173 0 0 36 -0.06400000000001735 0 0 37 -0.05800000000003524 0 0 38 -0.05200000000003444 0 0 39 -0.04600000000001601 0 0 40 -0.03428571428572901 0 0 41 -0.02857142857145386 0 0 42 -0.02285714285718789 0 0 43 -0.01714285714290295 0 0 44 -0.01142857142860318 0 0 45 -0.005714285714295782 0 0 46 0.005747935883124945 0 0 47 0.01101405731206453 0 0 48 0.01583875067331511 0 0 49 0.02025901794496604 0 0 50 0.02430876065055775 0 0 51 0.02801903861478274 0 0 52 0.03141830507821233 0 0 53 0.0345326313046057 0 0 54 0.03738590179557275 0 0 55 0.04249999999999617 0 0 56 0.04499999999998962 0 0 57 0.04749999999998036 0 0 58 0.04999999999997065 0 0 59 0.05249999999996185 0 0 60 0.05499999999995666 0 0 61 0.05749999999996142 0 0 62 0.05999999999996752 0 0 63 0.06249999999997632 0 0 64 0.06499999999999326 0 0 65 0.06749999999999393 0 0 66 0.07263585596098944 0 0 67 0.07561909883971586 0 0 68 0.07899551108592605 0 0 69 0.08281691058708179 0 0 70 0.08714194275864236 0 0 71 0.09203698366222585 0 0 72 0.09757715414810018 0 0 73 0.1038474798988963 0 0 74 0.1109441902736833 0 0 75 0.1189761951641425 0 0 76 0.1280667598457811 0 0 77 0.138355396621783 0 0 78 0.1624999999999661 0 0 79 0.1749999999999322 0 0 80 0.1874999999998983 0 0 81 0.1999999999998644 0 0 82 0.2124999999998956 0 0 83 0.2249999999999268 0 0 84 0.2374999999999634 0 0 85 -0.07000000000000001 0.004999999999986723 0 86 -0.07000000000000001 0.009999999999986364 0 87 -0.07000000000000001 0.02049999999998936 0 88 -0.07000000000000001 0.02599999999997641 0 89 -0.07000000000000001 0.03149999999996063 0 90 -0.07000000000000001 0.03699999999994483 0 91 -0.07000000000000001 0.04249999999992986 0 92 -0.07000000000000001 0.04799999999994715 0 93 -0.07000000000000001 0.05349999999996228 0 94 -0.07000000000000001 0.05899999999996626 0 95 -0.07000000000000001 0.06449999999998084 0 96 -0.06416666666667548 0.07000000000000001 0 97 -0.05833333333335186 0.07000000000000001 0 98 -0.05250000000002372 0.07000000000000001 0 99 -0.04666666666670733 0.07000000000000001 0 100 -0.04083333333339365 0.07000000000000001 0 101 -0.03500000000007997 0.07000000000000001 0 102 -0.02916666666676494 0.07000000000000001 0 103 -0.02333333333344854 0.07000000000000001 0 104 -0.01750000000013352 0.07000000000000001 0 105 -0.01166666666681849 0.07000000000000001 0 106 -0.005833333333500765 0.07000000000000001 0 107 -1.870864574371467e-13 0.07000000000000001 0 108 0.005833333333160939 0.07000000000000001 0 109 0.01166666666650895 0.07000000000000001 0 110 0.01749999999985698 0.07000000000000001 0 111 0.02333333333320499 0.07000000000000001 0 112 0.02916666666655303 0.07000000000000001 0 113 0.03499999999990105 0.07000000000000001 0 114 0.04083333333324905 0.07000000000000001 0 115 0.04666666666659709 0.07000000000000001 0 116 0.05249999999994512 0.07000000000000001 0 117 0.05833333333330576 0.07000000000000001 0 118 0.06416666666665377 0.07000000000000001 0 119 0.07000000000000001 0.06419176819454588 0 120 0.07000000000000001 0.05867507784454372 0 121 0.07000000000000001 0.05343529531642914 0 122 0.07000000000000001 0.04845852158999587 0 123 0.07000000000000001 0.04373155361155478 0 124 0.07000000000000001 0.03924185554125212 0 125 0.07000000000000001 0.034977515608915 0 126 0.07000000000000001 0.03092722236240403 0 127 0.07000000000000001 0.02708023269198453 0 128 0.07000000000000001 0.02342634052455959 0 129 0.07000000000000001 0.01995585433821694 0 130 0.07000000000000001 0.01665956771039138 0 131 0.07000000000000001 0.01352873693324987 0 132 0.07000000000000001 0.01055505690923456 0 133 0.07000000000000001 0.007730639813927846 0 134 0.07000000000000001 0.005047993036067872 0 135 0.04000000000000001 0.004950717068225791 0 136 0.04000000000000001 0.007625658155371627 0 137 0.04000000000000001 0.01054533899480435 0 138 0.04000000000000001 0.01373215130682997 0 139 0.04000000000000001 0.01721053687878183 0 140 0.04000000000000001 0.02100717066667693 0 141 0.04000000000000001 0.02515117123564521 0 142 0.04000000000000001 0.02967432126403131 0 143 0.04000000000000001 0.03461131010634918 0 144 0.03428571428572359 0.04000000000000001 0 145 0.02857142857145453 0.04000000000000001 0 146 0.02285714285718015 0.04000000000000001 0 147 0.01714285714291069 0.04000000000000001 0 148 0.01142857142864124 0.04000000000000001 0 149 0.005714285714372658 0.04000000000000001 0 150 1.00301711380979e-13 0.04000000000000001 0 151 -0.005714285714196451 0.04000000000000001 0 152 -0.01142857142850075 0.04000000000000001 0 153 -0.0171428571427952 0.04000000000000001 0 154 -0.02285714285710318 0.04000000000000001 0 155 -0.02857142857140922 0.04000000000000001 0 156 -0.03428571428569203 0.04000000000000001 0 157 -0.04000000000000001 0.03500000000001085 0 158 -0.04000000000000001 0.03000000000002711 0 159 -0.04000000000000001 0.02500000000002724 0 160 -0.04000000000000001 0.02000000000001368 0 161 -0.04000000000000001 0.01000000000001354 0 162 -0.04000000000000001 0.005000000000013884 0 163 -0.04599999999998429 0.015 0 164 -0.05199999999996587 0.015 0 165 -0.05799999999996451 0.015 0 166 -0.06399999999998537 0.015 0 167 0.04249999999999617 0.0025 0 168 0.04499999999998962 0.0025 0 169 0.04749999999998036 0.0025 0 170 0.04999999999997065 0.0025 0 171 0.05249999999996185 0.0025 0 172 0.05499999999995666 0.0025 0 173 0.05749999999996142 0.0025 0 174 0.05999999999996752 0.0025 0 175 0.06249999999997632 0.0025 0 176 0.06499999999999326 0.0025 0 177 0.06749999999999393 0.0025 0 178 -0.1494876739510048 0.01238690182079761 0 179 -0.1479541955104195 0.02468918854204349 0 180 -0.1454100398909227 0.03682282307102839 0 181 -0.1418725862551389 0.04870492038057509 0 182 -0.1373659989983254 0.06025431369779312 0 183 -0.131921062681069 0.07139210895538424 0 184 -0.1255749717395045 0.08204222371817231 0 185 -0.1183710764096192 0.09213190690324431 0 186 -0.1103585866011626 0.1015922357436517 0 187 -0.1015922357440542 0.1103585866007921 0 188 -0.09213190690363771 0.1183710764093131 0 189 -0.08204222371854253 0.1255749717392627 0 190 -0.07139210895571872 0.131921062680888 0 191 -0.06025431369807269 0.1373659989982028 0 192 -0.04870492038080815 0.1418725862550589 0 193 -0.03682282307118924 0.145410039890882 0 194 -0.02468918854214896 0.1479541955104019 0 195 -0.01238690182084777 0.1494876739510006 0 196 0.01238690182079761 0.1494876739510048 0 197 0.02468918854204349 0.1479541955104195 0 198 0.03682282307102839 0.1454100398909227 0 199 0.04870492038057509 0.1418725862551389 0 200 0.06025431369779312 0.1373659989983254 0 201 0.07139210895538424 0.131921062681069 0 202 0.08204222371817231 0.1255749717395045 0 203 0.09213190690324431 0.1183710764096192 0 204 0.1015922357436517 0.1103585866011626 0 205 0.1103585866007921 0.1015922357440542 0 206 0.1183710764093131 0.09213190690363771 0 207 0.1255749717392627 0.08204222371854253 0 208 0.131921062680888 0.07139210895571872 0 209 0.1373659989982028 0.06025431369807269 0 210 0.1418725862550589 0.04870492038080815 0 211 0.145410039890882 0.03682282307118924 0 212 0.1479541955104019 0.02468918854214896 0 213 0.1494876739510006 0.01238690182084777 0 214 -0.2496988640512965 0.01226691858178542 0 215 -0.2487961816680586 0.02450428508229523 0 216 -0.2472941274912118 0.03668261861372881 0 217 -0.2451963201008335 0.04877258050390176 0 218 -0.2425078132986752 0.06074504497565948 0 219 -0.239235083933108 0.07257116931343172 0 220 -0.2353860162958329 0.08422246334783778 0 221 -0.2309698831279201 0.09567085809103487 0 222 -0.2259973232809801 0.1068887733573183 0 223 -0.2204803160872402 0.1178491842062162 0 224 -0.2144321525002497 0.1285256860480022 0 225 -0.2078674030758467 0.1388925582545857 0 226 -0.200801882870402 0.1489248261227837 0 227 -0.1932526133409637 0.1585983210405709 0 228 -0.1852377813390517 0.1678897387114104 0 229 -0.1767766952969747 0.176776695296299 0 230 -0.1678897387120847 0.1852377813384407 0 231 -0.1585983210412388 0.1932526133404155 0 232 -0.1489248261234254 0.2008018828699261 0 233 -0.1388925582551997 0.2078674030754364 0 234 -0.1285256860485907 0.2144321524998971 0 235 -0.1178491842067528 0.2204803160869533 0 236 -0.1068887733577939 0.2259973232807552 0 237 -0.09567085809147087 0.2309698831277395 0 238 -0.08422246334822603 0.235386016295694 0 239 -0.07257116931375247 0.2392350839330107 0 240 -0.06074504497592132 0.2425078132986096 0 241 -0.04877258050411222 0.2451963201007917 0 242 -0.03668261861389353 0.2472941274911874 0 243 -0.02450428508240754 0.2487961816680475 0 244 -0.01226691858183452 0.2496988640512941 0 245 0.01226691858178542 0.2496988640512965 0 246 0.02450428508229523 0.2487961816680586 0 247 0.03668261861372881 0.2472941274912118 0 248 0.04877258050390176 0.2451963201008335 0 249 0.06074504497565948 0.2425078132986752 0 250 0.07257116931343172 0.239235083933108 0 251 0.08422246334783778 0.2353860162958329 0 252 0.09567085809103487 0.2309698831279201 0 253 0.1068887733573183 0.2259973232809801 0 254 0.1178491842062162 0.2204803160872402 0 255 0.1285256860480022 0.2144321525002497 0 256 0.1388925582545857 0.2078674030758467 0 257 0.1489248261227837 0.200801882870402 0 258 0.1585983210405709 0.1932526133409637 0 259 0.1678897387114104 0.1852377813390517 0 260 0.176776695296299 0.1767766952969747 0 261 0.1852377813384407 0.1678897387120847 0 262 0.1932526133404155 0.1585983210412388 0 263 0.2008018828699261 0.1489248261234254 0 264 0.2078674030754364 0.1388925582551997 0 265 0.2144321524998971 0.1285256860485907 0 266 0.2204803160869533 0.1178491842067528 0 267 0.2259973232807552 0.1068887733577939 0 268 0.2309698831277395 0.09567085809147087 0 269 0.235386016295694 0.08422246334822603 0 270 0.2392350839330107 0.07257116931375247 0 271 0.2425078132986096 0.06074504497592132 0 272 0.2451963201007917 0.04877258050411222 0 273 0.2472941274911874 0.03668261861389353 0 274 0.2487961816680475 0.02450428508240754 0 275 0.2496988640512941 0.01226691858183452 0 276 0.02447113316396854 0.1984067060673943 0 277 -0.1897096202783635 0.07255179839925222 0 278 -0.07195746018815052 0.1865427009613585 0 279 0.1898900620691591 0.07140017388385492 0 280 0.1151432954856066 0.1634909178588887 0 281 -0.1534573150373951 0.128502207247146 0 282 0.1621281704534496 0.1184499284987124 0 283 -0.1163219024662524 0.1645626207289621 0 284 0.07284987581771421 0.1878936451294863 0 285 -0.02871115085680499 0.20222331098752 0 286 -0.208475557476639 0.03896874044567408 0 287 0.2084755574764958 0.03896874044583663 0 288 -0.1822548064377207 0.1092306791462188 0 289 0.1486017475818076 0.151834033281804 0 290 0.1938690752267129 0.1022109953935466 0 291 0.132593563000709 0.1259489859918924 0 292 -0.1599453762100093 0.08903927966741099 0 293 0.001036717739095584 0.2172974190108047 0 294 0.05179335035145918 0.2110373581920343 0 295 -0.100155403385719 0.1919034007302523 0 296 -0.0546651505190109 0.2094503138715028 0 297 0.1035595969641496 0.191830121642622 0 298 -0.1470708260872052 0.1611441265030903 0 299 -0.1762318127074342 0.04238393732225251 0 300 0.1762318127073253 0.04238393732261013 0 301 -0.1213034539800283 0.1351756036818962 0 302 0.1614401015074255 0.08404328112444222 0 303 0.0845849246718041 0.1604915420303199 0 304 -0.04548927305698786 0.1744806761055648 0 305 -0.08780395912559023 0.1576653480015401 0 306 -0.0005552145512370043 0.1806695006775061 0 307 0.0444382370600899 0.175122638444832 0 308 -0.2118035551856959 0.06398689532015575 0 309 0.2106060304650645 0.06566341281815544 0 310 -0.2027938150209226 0.09351655970443369 0 311 -0.1786330575565496 0.1366885758988748 0 312 0.1402136867283279 0.1790408095586838 0 313 0.1752543871465119 0.1394841178213039 0 314 -0.1405386527775976 0.1065419697013298 0 315 0.1093624215412041 0.1380113045703504 0 316 0.02757835689079736 0.2235994104887093 0 317 -0.08108757392583746 0.2102116308021168 0 318 -0.1301004272182481 0.1847284131472937 0 319 -0.02765812079174987 0.2242461191114671 0 320 0.08131660393671179 0.2108053687800534 0 321 -0.166666744463026 0.06485306429284414 0 322 0.142887535048411 0.1020331131855279 0 323 0.1633652558076813 0.06336713729334748 0 324 0.0210138823245849 0.1706261092526991 0 325 -0.06344375594400196 0.1614353252144076 0 326 -0.2270302502673476 0.02175098632982355 0 327 0.2270302502672498 0.02175098632990653 0 328 0.1897975919031685 0.02330068540552602 0 329 -0.1897975919034444 0.0233006854054144 0 330 0.2098847972739828 0.08803810315110144 0 331 -0.02089384716244558 0.169596186536968 0 332 0.06190936734484031 0.1604657742801974 0 333 -0.09909330249705499 0.1406906179057911 0 334 0.1920651742470033 0.1273405815697322 0 335 -0.1696463896519044 0.1546029690804187 0 336 0.1262229637046537 0.1916003774881531 0 337 0.1289377850136374 0.1469655962706839 0 338 -0.1611160176216341 0.1114082134877119 0 339 -0.1686424557883318 0.02128970850647561 0 340 0.168661720253772 0.02118565871936985 0 341 -0.2259446709351557 0.04802886947956703 0 342 0.2259446709350681 0.04802886947972648 0 343 -0.1932225434674564 0.05304429425185259 0 344 0.1932225434674152 0.05304429425217298 0 345 -0.1941503412101823 0.1248480496364392 0 346 -0.1787910785271682 0.09026179342960459 0 347 -0.1304378199858901 0.1513736219195005 0 348 0.08974599302948046 0.17853774443394 0 349 -0.04476143616449433 0.1947254200279986 0 350 -0.005018314874597825 0.1997649669348663 0 351 -0.09859609508989597 0.1738133361616919 0 352 0.05340811570251884 0.1925599307552296 0 353 0.1686613655623818 0.1584574753583473 0 354 0.150396422059976 0.131526080237962 0 355 0.1754855955255797 0.09766831881998826 0 356 -0.123350281135287 0.1153081075317135 0 357 0.09087835767916153 0.1418673501380388 0 358 0.2082719965177303 0.01803734538580197 0 359 -0.2082719965179275 0.01803734538571054 0 360 -0.01137527605830275 0.2317124830614599 0 361 0.06733591411014209 0.2220043837019176 0 362 -0.1192665466267458 0.1989891322039636 0 363 -0.04526262882151474 0.2275359292121813 0 364 0.09813859519242056 0.20924544379139 0 365 -0.1456373529986062 0.1789117418498118 0 366 -0.2181125961114795 0.08188351504688288 0 367 -0.2044133728319515 0.1104313583297191 0 368 0.01248976584036876 0.2325176448954209 0 369 0.04438171597692792 0.2285841480186429 0 370 -0.09859431395034791 0.2109526822600392 0 371 -0.0686138374495007 0.2225176135232634 0 372 0.1563456374932458 0.1718286416841466 0 373 -0.1412707582447122 0.08829202860709436 0 374 0.1149195319615304 0.1215317642887338 0 375 0.2089073648511573 0.1052698303682557 0 376 -0.1488825250176886 0.07444312142725432 0 377 -0.1637517946707818 0.04372798201366723 0 378 0.1402359595763737 0.08771763500277908 0 379 0.1636925560797913 0.04331002189913688 0 380 0.1254016275426078 0.1092236636133687 0 381 -0.01483966590354054 0.2137130624370803 0 382 0.0663228626401559 0.2037034636943369 0 383 -0.1136763673401922 0.1818195155197246 0 384 -0.03703600354695396 0.2106197832191278 0 385 0.08731187487734697 0.1956934407710273 0 386 -0.1322239587128886 0.1686191454775705 0 387 -0.06896230845071652 0.1501484850726062 0 388 0.1850195835440836 0.08843665002781138 0 389 -0.1613233601273693 0.1700993119755373 0 390 0.09918134093953353 0.158591618602558 0 391 0.03292726040309749 0.1630105915273589 0 392 0.01377188536346997 0.2135163777832061 0 393 0.03852113844417948 0.2104638552607408 0 394 -0.08879107675037724 0.1945514344629265 0 395 -0.06486410252900138 0.2037807675904871 0 396 0.00767042337809765 0.1660961894129096 0 397 0.1147747950117204 0.2043979153682691 0 398 -0.1351979787018527 0.1289187096506302 0 399 -0.04587069960361168 0.1591371944422244 0 400 -0.1055330927332352 0.1279497415075871 0 401 0.1133356401635039 0.1804368268910979 0 402 0.07092597796211179 0.1497888772082888 0 403 -0.1536811175907274 0.1477150641564815 0 404 -0.02979487366315906 0.1842887067963155 0 405 0.07374951659844958 0.1715493145960652 0 406 -0.1134597986254923 0.149133515505903 0 407 0.1785928740088341 0.1146113714647966 0 408 -0.1773178222861316 0.05887292805884972 0 409 0.1777983963261749 0.05842196462002782 0 410 -0.2000549953044421 0.07607600000533693 0 411 0.01190075885514844 0.1860649321271375 0 412 0.03349316404094847 0.183396458271373 0 413 -0.05384050027328455 0.1852701558410989 0 414 -0.07971261620547554 0.1765689854665558 0 415 0.1696520896664091 0.07583522647675683 0 416 0.1566954919363337 0.1014226213558258 0 417 0.1499501083370781 0.06939217793904932 0 418 -0.1709964437863746 0.07550669186661355 0 419 -0.09941969043193372 0.1602656663200732 0 420 0.05595715579007364 0.1804338976376658 0 421 0.1456596093727369 0.1150373077308425 0 422 -0.01055488188693217 0.1888772272814394 0 423 0.1373771915827468 0.1599089813994481 0 424 0.2211090716814921 0.07848854930762698 0 425 0.2009200276348937 0.07385989806693569 0 426 -0.1735226048547427 0.1181016635597981 0 427 0.1887137382797634 0.0386963462358695 0 428 -0.1887105898218778 0.03870136432301228 0 429 0.1870547518486222 0.1399757997771885 0 430 -0.228685616502965 0.06279521610658742 0 431 0.2300315454220712 0.06181839925285987 0 432 0.1023789320454206 0.1682597469952428 0 433 -0.2324295546698223 0.0352117376226303 0 434 0.2324295546697486 0.03521173762276383 0 435 -0.1815303215435288 0.1497314973117438 0 436 -0.1389590871029585 0.1397867818783153 0 437 0.2028093724422359 0.119650615387711 0 438 0.1389119002430829 0.1883899219971601 0 439 -0.08719389397345068 0.1393404480869085 0 440 0.04577562773115795 0.1557183256528991 0 441 -0.006558983362836293 0.1622340760055865 0 442 0.03717752166958289 0.1933320818635756 0 443 0.01088836898113799 0.1965748837079236 0 444 -0.03314887453042145 0.1587019424423936 0 445 -0.1673406171810415 0.09801480837183396 0 446 -0.2387834418437684 0.01677089263375363 0 447 0.2387834418437198 0.01677089263381907 0 448 -0.1905974458227473 0.1383841868280994 0 449 0.1594466276610137 0.1415539498577393 0 450 0.1802913725454413 0.1516726306225861 0 451 -0.1576993820909505 0.0325306493162195 0 452 -0.189737895682458 0.09835192153932659 0 453 -0.2169580362036458 0.09467610084634609 0 454 -0.1602947852927571 0.1372959364745963 0 455 -0.1536521980102312 0.09939546883605646 0 456 -0.2063670033868977 0.05229557774186751 0 457 0.2062399640610207 0.05238561698746159 0 458 0.180448109271358 0.01316640940633942 0 459 -0.1804473928860481 0.01317027869392316 0 460 0.1226416738046315 0.1725175718860761 0 461 0.172082971026265 0.1247486870805215 0 462 -0.06903603969490131 0.1731119492549246 0 463 0.1576380634052615 0.03241087148376278 0 464 0.1216393881096182 0.133334361907925 0 465 -0.1300836786170246 0.1037317593345496 0 466 -0.1492468242722266 0.1172482632700781 0 467 0.1158877104980058 0.1491123904257448 0 468 0.1380453216819204 0.1369918020449893 0 469 0.0993440334212832 0.1322215937225929 0 470 -0.1928166448451819 0.08500737779677839 0 471 0.02917944067515117 0.236580654866035 0 472 -0.08579229004395081 0.222408148711928 0 473 -0.2186871369137031 0.01153036649361961 0 474 0.2186871369135471 0.01153036649367367 0 475 -0.200040629065763 0.06468742340969456 0 476 0.150146111697984 0.1828348362818498 0 477 0.0002106855239255544 0.23714178210393 0 478 0.05741638133516201 0.2300861324856405 0 479 -0.1116070811733638 0.2092374274500754 0 480 -0.05782027398542711 0.2299853720092481 0 481 0.1787880347887245 0.02910244981159679 0 482 -0.1788013126223462 0.02911872579468272 0 483 -0.2196585739910273 0.03399693015041417 0 484 0.2196585739908999 0.03399693015055235 0 485 -0.137407106740497 0.1951047194319554 0 486 -0.1471535940098611 0.05734526790206829 0 487 -0.02921087999367888 0.236839793372503 0 488 0.08588249179343209 0.2226447717501323 0 489 0.1311204907866696 0.09361823100988456 0 490 -0.05831312275380181 0.1731698984556383 0 491 0.2174668402741414 0.09833207426904535 0 492 0.1961586274932068 0.01258196548337043 0 493 -0.1961585752787548 0.01258224750135512 0 494 0.1971285417595237 0.09199417104925287 0 495 0.1499409974123202 0.05836720392726245 0 496 0.1726004470251331 0.08668999769514113 0 497 -0.05507290789726171 0.1519457676375463 0 498 0.1987437133832513 0.06299547449568051 0 499 0.01967653790108591 0.1584155865204587 0 500 0.2002888495934286 0.02912635758173169 0 501 -0.2002883923546492 0.02912711473949414 0 502 -0.05497571419517995 0.1981178311650428 0 503 -0.0918683476320078 0.1819423258422109 0 504 -0.161244819767945 0.1237226524178099 0 505 -0.1720281360977763 0.1660639024055035 0 506 -0.2280878447451277 0.07634188386680084 0 507 -0.07732567613033962 0.1624891671236214 0 508 -0.09449632636224049 0.1285263156789079 0 509 0.05936768673652185 0.1476014278478461 0 510 -0.01953555908374001 0.1575948148892701 0 511 0.149489302434501 0.1626284142239459 0 512 0.1255963819801903 0.1595239429980775 0 513 0.1264130451844437 0.2030606867909102 0 514 -0.1613342963346758 0.01180355418224843 0 515 0.1613342963346535 0.01180355418223747 0 516 -0.2388667111880417 0.0269841040564463 0 517 0.2388667111879906 0.0269841040565581 0 518 -0.1943464256889474 0.1119954755051278 0 519 -0.1116910877173082 0.1154676511627613 0 520 0.1353430469723554 0.1140442254392661 0 521 -0.2031352513933811 0.1207693278807177 0 522 0.1663547169301055 0.170387489446865 0 523 -0.01076180188344822 0.1759636102734154 0 524 -0.09320957986825568 0.1495851665297697 0 525 0.05253655819346105 0.1676162145296278 0 526 -0.03259651189416857 0.1728454021044346 0 527 0.1021665789047804 0.17966986737118 0 528 0.2020697993936658 0.1302845076582893 0 529 0.07420487225964309 0.1613632919917848 0 530 -0.1110047039249265 0.1382679868529845 0 531 -0.1599621421322744 0.07711809200104941 0 532 0.07984337159947588 0.1392239137968303 0 533 -0.1425148035270152 0.1497696798753597 0 534 0.1593692873922535 0.07456872191204689 0 535 0.1910374253984701 0.1143181356594395 0 536 0.03275030876922702 0.1730540226881611 0 537 -0.1825540752427808 0.1267177852369948 0 538 0.1690496819360372 0.05230284187882273 0 539 0.009871568342819451 0.1758017700181571 0 540 0.1605957379985228 0.1271330272425423 0 541 0.1816322723914364 0.1311089205807642 0 542 -0.02566619369700504 0.2138020681437267 0 543 0.07672229468426726 0.1997362546412374 0 544 -0.122931435274289 0.1751547759907717 0 545 -0.2149028408758557 0.1073983580832867 0 546 -0.1588236694648154 0.1596513999654431 0 547 -0.1320530347922045 0.09108405778090085 0 548 -0.1700713808269451 0.05274274207334331 0 549 0.005161101044821489 0.2066086508990496 0 550 0.04519162494318611 0.2016716848632403 0 551 -0.1708438894927757 0.1431986252718415 0 552 -0.1580471684280852 0.1805137074087126 0 553 0.1046710815750733 0.1207319544805595 0 554 0.1510149400504575 0.09223959244431493 0 555 -0.1356154977427687 0.1177211764582923 0 556 0.001332143304703886 0.1903903021457746 0 557 0.04489483885264275 0.1849690013945352 0 558 0.1305134723692351 0.1804719005530425 0 559 -0.2357102381457901 0.05284950670514355 0 560 0.2353867609030867 0.05276175707287731 0 561 0.1092957647108251 0.2137803710782421 0 562 0.1148390572881707 0.1936507948421602 0 563 0.1397601103806208 0.147702810939364 0 564 -0.01822249427318974 0.2398089170439336 0 565 0.07594516105506893 0.2281944911828666 0 566 -0.1291200400389473 0.1381260488505693 0 567 -0.04059050358996055 0.2370511517282851 0 568 -0.129118152063207 0.202902205972832 0 569 0.09634687578877391 0.2202748498530121 0 570 -0.1469802235733497 0.190266349508381 0 571 0.09175650668949767 0.1651732230626597 0 572 -0.1721544205318275 0.1078466446575013 0 573 0.2107126784196495 0.02811903228606653 0 574 -0.2107125869720181 0.02811918371751987 0 575 -0.07667424232404235 0.1987687545865599 0 576 0.02611818770065211 0.2117602602998508 0 577 0.1923578831376139 0.08157309410970173 0 578 0.01767795609887217 0.2227010964926306 0 579 0.03696379530959129 0.2203224156715516 0 580 -0.09705939527250657 0.2201242973441081 0 581 -0.07591025807892436 0.2282824689960661 0 582 -0.07122537876753346 0.2117147500487853 0 583 -0.08940463415199475 0.2047021785076232 0 584 0.01816691719560755 0.2398821757954838 0 585 0.04066413677623246 0.2371074084144412 0 586 0.1022740151039321 0.1471173956059273 0 587 -0.1386461230307235 0.07995145206896496 0 588 0.1148008641865038 0.1114484163527156 0 589 -0.1570236007350765 0.02054000047355693 0 590 0.0824503481961551 0.1505210453889216 0 591 -0.1165699692375576 0.1265575086313576 0 592 -0.217468550794316 0.05629761682179834 0 593 0.2178391150691905 0.05681529739007907 0 594 -0.03402452822654752 0.1931507190087416 0 595 -0.04008452054644031 0.184126846647359 0 596 0.07821371263984153 0.179614930055265 0 597 -0.2152554973664184 0.04578860741999041 0 598 0.2152732469981465 0.04583290186721595 0 599 -0.1195694458206402 0.1553400337522619 0 600 -0.04577989084299346 0.2051130622627811 0 601 -0.1039557614831618 0.182298220448897 0 602 -0.01641018151450797 0.2025676394059984 0 603 0.06411930485184447 0.19267995511301 0 604 -0.109050379881474 0.1713591699520875 0 605 -0.1209486603850906 0.1873500055017723 0 606 -0.01836768648796375 0.2224365892789464 0 607 0.07184416312786747 0.211070593272644 0 608 -0.03634308506607178 0.2204152052326949 0 609 -0.1351858810953138 0.1770478934700734 0 610 0.08818259864735339 0.2046351020921947 0 611 0.1680126292894044 0.1482839968336258 0 612 0.1820902841308603 0.1053402915263032 0 613 0.159061639491768 0.1578538974684085 0 614 -0.1875483358845711 0.06167644279672829 0 615 0.1871817103439296 0.06114576126297673 0 616 -0.1821837474990694 0.05123695147100644 0 617 0.1830689353993995 0.0500944112051682 0 618 0.1570151898910179 0.02049523494967337 0 619 0.2229633217306099 0.08895040963349414 0 620 0.1423400921193069 0.1248945303434303 0 621 -0.1692674534505878 0.08570525939773471 0 622 -0.1989673978768439 0.04393216349745685 0 623 0.1989609717194833 0.04393655041984301 0 624 -0.177881667975032 0.1003206300264458 0 625 0.1696014850438827 0.03463336789690137 0 626 0.1475860143139187 0.1412633072053519 0 627 0.2107846788455604 0.0766106758997474 0 628 0.1805852130762862 0.07915517039151274 0 629 0.1682336240659473 0.1084371511496008 0 630 -0.08912106410254048 0.1687908048192822 0 631 0.1642450333518128 0.09508349376488551 0 632 -0.1798346019905119 0.07955075680537714 0 633 -0.1695511219726788 0.03443668137555871 0 634 -0.19972342949745 0.1331257765842055 0 635 -0.1999558307773317 0.1029863244754705 0 636 -0.1494936588136033 0.08660418574682106 0 637 0.2066956898901702 0.008176715690427303 0 638 -0.2066956845623678 0.008176744467735454 0 639 -0.1514371809170466 0.1706206423264898 0 640 0.1774262376346609 0.1618257010954319 0 641 -0.1704888831042878 0.009212823093687345 0 642 0.1704903394344434 0.009204957271887658 0 643 0.1243878733232805 0.1185050209485557 0 644 0.2294073814052924 0.07318745500930116 0 645 0.105214911794199 0.2022402525937506 0 646 -0.1187740698110176 0.1059525460814014 0 647 -0.1786789281148298 0.06883528036994417 0 648 -0.2081349126204407 0.08426895341561261 0 649 -0.001499351484019081 0.1714272205316117 0 650 -0.08180074862001069 0.1876748402639223 0 651 -0.06433546843466222 0.1926708231409952 0 652 -0.2114105606855175 0.07507153454408379 0 653 0.09327703978684455 0.1884621326500684 0 654 -0.002317815518364305 0.2265091747007077 0 655 0.05728559822390424 0.2191578194563231 0 656 -0.1089497894971204 0.1989346601903313 0 657 -0.05287042405383376 0.2205673041389869 0 658 -0.1911219704348854 0.1482738434724267 0 659 0.1507831788275774 0.08054761322377675 0 660 -0.2260420376590611 0.08689740783182297 0 661 -0.1361942400489357 0.16022078588461 0 662 0.1776650587898244 0.06810038350699177 0 663 -0.02100743247241466 0.180271898443105 0 664 0.1406217835705783 0.07563883606431868 0 665 0.08870673272841417 0.1325924734041895 0 666 0.1909179833267934 0.1486110853461603 0 667 0.06445443220743431 0.1700301125443162 0 668 -0.180339048394645 0.1593772857099295 0 669 -0.1039620611000581 0.1491499552668644 0 670 -0.00846455745935234 0.2411961675626327 0 671 0.0668167704263227 0.2319111047672503 0 672 -0.05039245805033422 0.2360259207323521 0 673 -0.1211671816381058 0.2087249630727382 0 674 0.1547317245601761 0.111215839997503 0 675 0.1978138320798426 0.1389921089111477 0 676 0.1595647580745743 0.1807310618884132 0 677 -0.1059163093743362 0.216820757787051 0 678 -0.06712933375070045 0.2317826281919332 0 679 0.008802811709815225 0.2411461528286496 0 680 0.05005473312255922 0.2360582136043735 0 681 0.2114918265413025 0.1143019762171338 0 682 0.1666159370605362 0.1344882646692473 0 683 -0.1706096995102583 0.1305378154022292 0 684 -0.04081008267911942 0.1662641330871503 0 685 -0.006752982103746478 0.2093370434735073 0 686 0.05723002252039666 0.2018267605544646 0 687 0.2049811514388595 0.09751625474629556 0 688 0.04310898104318364 0.1658254957860015 0 689 0.2008042994802644 0.1083995549026913 0 690 -0.08167962645560638 0.1498529394680916 0 691 0.02332454498566017 0.1891125067315244 0 692 0.1373700963363662 0.198013910199599 0 693 0.1527150290554494 0.04560008858799856 0 694 -0.2078047791419415 0.1018017402878512 0 695 0.0210184873401594 0.231056196507656 0 696 0.03575348912574004 0.229238807491876 0 697 -0.1523663994967792 0.04568737864165556 0 698 -0.07652586765314935 0.2190269224164319 0 699 -0.0903876414689275 0.213679787525163 0 700 -0.008758950878095029 0.2199529282286843 0 701 0.06194065816798514 0.2112329631534547 0 702 -0.0449396429173503 0.2154865433780836 0 703 -0.1113468812725961 0.1899393361248773 0 704 0.09594383133349034 0.1981084334266026 0 705 -0.141195401663149 0.168858420056799 0 706 0.121329465176449 0.1016357351062326 0 707 -0.1416492276547971 0.06866331310521889 0 708 -0.1208158770626541 0.1445694684271858 0 709 -0.1420147089255208 0.09652680098744673 0 710 -0.162657970298596 0.1484927989897562 0 711 -0.06349651826896008 0.1821531055308031 0 712 0.1099872913217418 0.1291661957940323 0 713 0.08204258764811939 0.1694550076950057 0 714 0.09167227113534947 0.1535453004544959 0 715 -0.2315033543918267 0.00962617886016838 0 716 0.2315033543917369 0.009626178860206468 0 717 -0.09958371648482051 0.201713630600208 0 718 -0.0616765278840512 0.2163360201970456 0 719 0.007144865841227956 0.22494724916445 0 720 0.04772699660687069 0.2199419548474888 0 721 -0.02341717477006106 0.1918965836538533 0 722 -0.110329504045848 0.1571682392398563 0 723 0.06822399965089294 0.1803669758459681 0 724 0.1339409593736116 0.1705297586139949 0 725 0.2372502868199765 0.04429151265867468 0 726 -0.2373550399096788 0.04422702272185199 0 727 -0.04448305858544882 0.1504247165530881 0 728 0.1445854815517361 0.1711285736270115 0 729 -0.1390267107047019 0.1860148642981934 0 730 -0.1273681786067577 0.1938148952515634 0 731 0.08966239185988349 0.2142216711428576 0 732 -0.03581304365259517 0.2292176397314263 0 733 -0.020966891520977 0.231008780373662 0 734 0.07646486680464448 0.2189439217375228 0 735 0.006511518796726824 0.1566082537827185 0 736 -0.2116065009714189 0.1163555200220247 0 737 0.1199511725894528 0.2117434319783255 0 738 -0.1678252826302703 0.1762724067754091 0 739 0.03207310815297348 0.1533776352990414 0 740 0.2199629704814452 0.06876396494629498 0 741 0.1480591677257824 0.1918991600075188 0 742 -0.1265371959345604 0.1271759610512032 0 743 -0.07558234118528555 0.139889021994104 0 744 -0.1438131181421365 0.1275773628476208 0 745 0.1077213192997818 0.1570737845919688 0 746 0.02166055841373584 0.1801692494658557 0 747 0.121510561466039 0.183735494332106 0 748 0.2015964632519706 0.08347952571975126 0 749 0.1109154230718865 0.171860116489545 0 750 -0.1511384231704224 0.1086484788237941 0 751 0.1830821434144018 0.1224255392710508 0 752 0.1591764832671493 0.05298809644546169 0 753 0.03354747486242968 0.2023849756632802 0 754 0.01663078899855257 0.2044715947447618 0 755 -0.2420192973260464 0.007704827703813495 0 756 0.2420192973260146 0.007704827703839543 0 757 0.2168703087554695 0.02159902473518052 0 758 -0.2168702994242133 0.02159904018728148 0 759 -0.05304933213255025 0.1637978697725054 0 760 -0.1588202414081728 0.05509830400025137 0 761 -0.2197355406242166 0.06937693195909339 0 762 0.06863591330265292 0.140397004692227 0 763 0.1314162852044252 0.1036451730732665 0 764 -0.1487867044488316 0.1384411720799199 0 765 -0.100983538347522 0.1192310384245851 0 766 -0.03806260192755886 0.2011664591012338 0 767 0.152680373483753 0.1218444605582794 0 768 0.08210228832760288 0.1885657271352723 0 769 -0.153935165332124 0.06632023613795789 0 770 -0.1254486876764808 0.1630013727288396 0 771 -0.1853825470221381 0.1179523070187068 0 772 0.1867186160373521 0.09713008536338047 0 773 0.216868734206862 0.1085283676837963 0 774 0.1029036209650013 0.03295236898565956 0 775 -0.1041880811436964 0.03490822760122611 0 776 0.08826811922443978 0.01830771102430407 0 777 -0.002888507289532251 0.1107610700862632 0 778 0.03208333333322704 0.1052061631945068 0 779 -0.03786051910017436 0.1056897581922689 0 780 0.09842354840110451 0.0612236069767796 0 781 -0.06641479266880197 0.09794061310250782 0 782 -0.09843880505443126 0.06147947832401138 0 783 0.06124999999997971 0.09956387799747546 0 784 0.08489176201647106 0.03295236898565951 0 785 0.01433627407082085 0.09137680708388615 0 786 -0.02017446977838111 0.09136584237146628 0 787 -0.0875474243818237 0.01774999999999472 0 788 0.0791172848485617 0.009267865770850293 0 789 -0.09025422591296949 0.08653396673601926 0 790 -0.08945910831159301 0.04373025869332479 0 791 0.09065488906118424 0.08605399598243213 0 792 0.04203783583284788 0.09017406109837896 0 793 -0.04904739463580963 0.08917370011468284 0 794 0.1235770025486942 0.02277951657175281 0 795 -0.002916666666843925 0.08773489324780862 0 796 0.08603184212994576 0.04995717355580566 0 797 0.0790154670329684 0.01830771102430416 0 798 -0.1242952094504982 0.02271564785026085 0 799 0.105408088773341 0.01695345660990993 0 800 0.01577556091139345 0.1269129892033047 0 801 -0.02179566508090079 0.1263468901834029 0 802 0.117534401037271 0.04991687780707417 0 803 0.08477575325537284 0.06705066890265521 0 804 -0.1056732173977357 0.01597995365383003 0 805 0.06730741980184014 0.08658428526557566 0 806 -0.08408837126842666 0.0673969969273821 0 807 -0.1204804438873155 0.052218026039252 0 808 -0.06708333333333771 0.0846380650379264 0 809 0.02881453220216419 0.08565577032075083 0 810 -0.03464786553568998 0.08565577032066521 0 811 -0.08429177890054092 0.03166702605970965 0 812 0.05194706642242207 0.1195099078293988 0 813 0.07995214994919413 0.04169213466193769 0 814 -0.05582576260851516 0.1172784950675144 0 815 0.08788500955769618 0.008787632690731935 0 816 0.07697370339968825 0.09773611509142324 0 817 0.07840268701999592 0.02708312410942625 0 818 0.09988635436639808 0.04603874407832623 0 819 0.05532366590616784 0.08177170551938834 0 820 -0.002502591334430182 0.1308486811454682 0 821 -0.08106777111016193 0.05603292064371761 0 822 -0.1060338406810846 0.07802493205969893 0 823 0.009154793518311418 0.08032265793921584 0 824 -0.01498812685195157 0.08032265793917313 0 825 0.1068821238828965 0.07783216881571002 0 826 0.01357020018228491 0.1083680759420278 0 827 -0.01885024040752438 0.1080159039561217 0 828 -0.07907786514805018 0.0792637784971842 0 829 0.07953224001077924 0.07815814290687044 0 830 -0.07961829778426492 0.00987874472763782 0 831 0.09374379443073484 0.02783087930729123 0 832 -0.08393064798695593 0.1018186161493033 0 833 -0.1025688506916336 0.04832631573431351 0 834 0.07505249229572677 0.005688925980962629 0 835 0.08923414914674734 0.04088145204546234 0 836 -0.03987708355241475 0.1243346341661835 0 837 0.03791666666657505 0.08019171404472829 0 838 -0.04284771746672487 0.0794235851396651 0 839 0.03405703077250392 0.122720145019976 0 840 -0.05615248581969201 0.08028089108199277 0 841 0.09682199930460225 0.009101078610972117 0 842 -0.07935988352793422 0.02324999999998288 0 843 0.04670227035197599 0.1038017667064929 0 844 -0.07916705029107576 0.03974999999993734 0 845 0.07860987196772964 0.05692428343721004 0 846 0.0201912465325748 0.07988105588880805 0 847 -0.02602457986615064 0.07988105588875283 0 848 0.003204536838060261 0.09856321440495429 0 849 -0.009068825722634311 0.09863255720500251 0 850 0.0713842230860553 0.1127831110889093 0 851 0.1178002266806491 0.03535838957869367 0 852 -0.09526727902327298 0.02651525702053992 0 853 0.07746194109232525 0.03434744898293535 0 854 0.07487917483323145 0.01149316149056238 0 855 0.1150196155710164 0.06364885307041789 0 856 0.1159494092723355 0.01096648308676386 0 857 -0.05340544779426952 0.1029871652668974 0 858 -0.1196847216956117 0.0376124776768587 0 859 -0.0783829274041111 0.09275295853832646 0 860 0.0836363042741943 0.01373420504585515 0 861 -0.09571698053010584 0.01057952212624004 0 862 -0.07078436439446789 0.1147423778161158 0 863 0.08604328739255979 0.02493658798383352 0 864 -0.1123744802703426 0.06547725797171303 0 865 -0.1152268918077306 0.01121015462029049 0 866 0.0746722666576983 0.02173302600678863 0 867 -0.002916666666841949 0.07975203113371984 0 868 0.133211078233782 0.01279727364672147 0 869 0.02427962801664691 0.09762430135683371 0 870 -0.03011813005211689 0.09760979636068538 0 871 0.1114497352922445 0.02557211759248948 0 872 0.09591516684424811 0.07393977335215039 0 873 -0.09625521861116559 0.07395325144026901 0 874 -0.131816201633207 0.0144942149000335 0 875 0.07749667005439695 0.04864792952199116 0 876 0.0836220801418929 0.005532828978843577 0 877 0.131051396719939 0.03610829039728069 0 878 0.04684936568806335 0.07900882654476309 0 879 -0.07862050831338094 0.04856401718661285 0 880 0.09640468456153962 0.01952208536512714 0 881 0.09248128075255918 0.09958940179331631 0 882 -0.09302191125983771 0.03742741794265646 0 883 -0.1143757115376112 0.02585577445548836 0 884 0.05482357428942239 0.09196550653463451 0 885 0.1062586321440923 0.008012668112456142 0 886 -0.05979565012775347 0.09233540214717724 0 887 -0.09055943803356019 0.05496523638929248 0 888 0.0359384531927281 0.09444001120780027 0 889 -0.04049424680871479 0.09354088797203003 0 890 0.006702699430846032 0.117463123803902 0 891 0.07465278585027406 0.01669019226702677 0 892 -0.0951242908462946 0.09744465598798338 0 893 -0.02997862456762419 0.1131791755568444 0 894 -0.01257228341109391 0.1171502281959306 0 895 0.02400265257928639 0.1132935452778615 0 896 0.1033179098590039 0.09226652703538527 0 897 -0.1289431092265002 0.03288187077685129 0 898 0.1087028213954516 0.04148764249401577 0 899 0.02574399225083376 0.1326467017845028 0 900 -0.01555016337640757 0.1365067072621123 0 901 0.009069166595490123 0.1360274527654827 0 902 -0.07757829030139735 0.01693836300577639 0 903 0.07785044492598392 0.06630289822148666 0 904 0.1092267644922552 0.05419782203803195 0 905 0.005363298714321151 0.09076547990348509 0 906 -0.07785402466326322 0.06647695033118811 0 907 -0.01119931171926512 0.09076984158747477 0 908 0.0670833333333269 0.0773271961764401 0 909 0.08926656859362261 0.06092568363771753 0 910 -0.08820062184498624 0.008129483658057074 0 911 -0.06708333333333771 0.07702845639355398 0 912 0.09274349040296212 0.03533010068481264 0 913 0.08001273141637294 0.004602255190097636 0 914 0.09387413503238562 0.01401100257243133 0 915 0.07567479212164159 0.08970018895854201 0 916 0.1030891393312034 0.02459902296424746 0 917 -0.03630820680732316 0.07809344078846217 0 918 0.02984205088743284 0.07713909049268651 0 919 -0.03256397859744659 0.1322531268668928 0 920 0.07383527797324679 0.008507467095376014 0 921 0.07435554398219664 0.02900372752719428 0 922 -0.07722933953037459 0.02971961833437533 0 923 -0.1254518181958581 0.04385930074271205 0 924 0.06047998891500187 0.1089905239430805 0 925 0.04423230169996389 0.128874309415152 0 926 0.06201902489961293 0.1264091836317712 0 927 -0.05116154321537214 0.1283330559049263 0 928 0.04088935948548651 0.1125509256588867 0 929 0.07956102008093878 0.01347594249643318 0 930 0.09256748803467826 0.005970446979807019 0 931 0.1247404862305631 0.05960667784105653 0 932 0.08303296780096156 0.1098115564757524 0 933 -0.04958333333336551 0.07634789535569735 0 934 0.06904673031522361 0.09494493128870875 0 935 0.07292635927085381 0.003553786419681709 0 936 -0.1034054903442078 0.009145341121023186 0 937 0.1298174461044146 0.04723006514693001 0 938 -0.1232426204894366 0.06234246874963716 0 939 0.01458333333318296 0.07617020637723952 0 940 -0.02041666666679103 0.0761702063772052 0 941 -0.1104569918908286 0.04209402153704551 0 942 -0.04590027258696508 0.1087393696242935 0 943 0.09375426149264102 0.05286785036655143 0 944 -0.09477645773179635 0.01865551704306795 0 945 0.1346526432593632 0.02391074421175616 0 946 0.08197736208417537 0.02302806264800571 0 947 -0.06215293865960586 0.1082543409171254 0 948 -0.07546079185425314 0.006019258491319093 0 949 -0.1008406709019707 0.087447704907694 0 950 0.02188588848159498 0.08670486567895336 0 951 -0.02771991644001222 0.08670329929139058 0 952 0.002904200828476498 0.07600866085151348 0 953 -0.008737534162147099 0.07600866085150403 0 954 0.123787078804682 0.008020645308881301 0 955 0.07456789049154422 0.04157023334867632 0 956 -0.08562011673091238 0.02478925415678473 0 957 -0.08754269110902187 0.07449618915119612 0 958 0.08694785550113855 0.0746293426572275 0 959 0.09842484640162841 0.03939808049310427 0 960 -0.1039976311174987 0.02459277244512714 0 961 0.06015622907250381 0.07671127304388267 0 962 0.01717950413941616 0.1002899555652906 0 963 -0.07633488179971944 0.06071578031281205 0 964 -0.1239632420166703 0.00741223665009294 0 965 -0.02304592692550151 0.1002117383613344 0 966 0.0753156693024019 0.06112117259994872 0 967 0.08807700912220034 0.004514304261201832 0 968 -0.1061658175557123 0.05735168736388127 0 969 -0.06074004501157446 0.07544537563384365 0 970 -0.07353767563176164 0.07558747045637139 0 971 -0.08566075902022695 0.03750821715813651 0 972 0.07340931449616601 0.02525328660827207 0 973 -0.1348875086402696 0.02347781957449595 0 974 -0.1171561939229377 0.07473907718003031 0 975 0.07378145157648658 0.03698537629864693 0 976 -0.08139595958340706 0.1136837596663109 0 977 0.1179346860818699 0.07597703926760431 0 978 0.1029345662062525 0.06905921754450552 0 979 0.07371841831499953 0.03288413489717607 0 980 -0.09668597330130391 0.04300764669523314 0 981 0.07352751061748579 0.07564826514317839 0 982 -0.1030574303269932 0.06822463188861932 0 983 0.0036457177697591 0.08356352234825082 0 984 -0.009479497715303148 0.08356424929555928 0 985 0.06034669522270661 0.08737059378381901 0 986 0.01511309087492486 0.08399687301337316 0 987 -0.02094666529726189 0.08399632935527929 0 988 -0.07424075623592744 0.1057086243989008 0 989 0.08364179312870408 0.01836083286168031 0 990 -0.0638668196276739 0.1238770158289965 0 991 -0.04517331638867106 0.1006921945586949 0 992 0.04221733163099872 0.0973994671131284 0 993 0.06933834881438355 0.1032563967563218 0 994 -0.08520897328595822 0.05018471679763868 0 995 0.08473369027918892 0.03868950907451608 0 996 0.08509000817344342 0.04441342735356428 0 997 0.08156804250811871 0.06165092502515089 0 998 -0.08678714458349765 0.06074413946345981 0 999 0.1121539811993568 0.01800951691445897 0 1000 0.0830574998556849 0.009711374099591186 0 1001 -0.0922752666429142 0.06638563683546811 0 1002 0.04862856266938621 0.08643782579824655 0 1003 0.09883230382603342 0.08243785274830186 0 1004 0.004872925081655394 0.106293991239983 0 1005 -0.07455210988633984 0.08584357517645815 0 1006 0.09253989517616359 0.06696669880198734 0 1007 -0.003059516176760978 0.121855691117396 0 1008 0.1009398045791595 0.004824062525330393 0 1009 0.05203145516807106 0.07598577022257927 0 1010 0.07221980211495595 0.006611943451266211 0 1011 -0.07428290694475148 0.01259772770411906 0 1012 -0.07555378087192774 0.0529532242571855 0 1013 -0.07087400103402225 0.09145985621014852 0 1014 -0.01041433053041155 0.1058108447390796 0 1015 -0.002894895461295705 0.09505658998704732 0 1016 0.08552822588248177 0.09320528179775704 0 1017 0.09089000691127384 0.02301921881913538 0 1018 -0.08614078022471443 0.09374887204953873 0 1019 -0.07942548712253081 0.07238601745929074 0 1020 0.03555233528500602 0.08668668577289107 0 1021 -0.04138566861849316 0.08668668577279569 0 1022 -0.04954823382161192 0.08264283659815115 0 1023 -0.006590911499855561 0.139683759612122 0 1024 0.024150199323398 0.1042069098752149 0 1025 -0.07477654714839901 0.03447820515470791 0 1026 -0.02997628671402109 0.1042126020987988 0 1027 0.02466405633630834 0.07545061435023123 0 1028 -0.03164768961032351 0.07531272735435893 0 1029 -0.0604190864655892 0.08535764970068586 0 1030 0.07691695460343834 0.002813916237152175 0 1031 0.08864445838906977 0.02969394933573958 0 1032 0.07953492027585005 0.0721428826597032 0 1033 0.08056773887546506 0.03123419532057062 0 1034 0.08847098727044073 0.01363173979426231 0 1035 0.0426555810591878 0.07608604058561218 0 1036 0.08480106203526212 0.0561274024354156 0 1037 0.07396153203521293 0.04645095929575477 0 1038 -0.08218987567943452 0.08648675698023604 0 1039 -0.08324336569334267 0.005425121828712224 0 1040 -0.0754409136378639 0.0443500262703323 0 1041 0.008828465535928155 0.07450030503359377 0 1042 -0.01466179886956834 0.07450030503357645 0 1043 -0.04362110249528987 0.07409422248589807 0 1044 -0.08244365680918635 0.01546894535309923 0 1045 -0.05541666666668781 0.07453442899451379 0 1046 0.07502182545509906 0.05213641334087003 0 1047 0.0732798178917058 0.08243477521594973 0 1048 0.05372954195885127 0.1015352555627068 0 1049 0.0730736391839559 0.01395583721751924 0 1050 -0.05278684745012006 0.09522799936967992 0 1051 -0.1125818851717298 0.01829676413887416 0 1052 -0.01139293955888461 0.1280631775437684 0 1053 -0.07434367159365486 0.02327256876286622 0 1054 -0.09780172239457915 0.05483308588938295 0 1055 -0.08257995448596636 0.04415911815881808 0 1056 0.110105585872642 0.03340529586681485 0 1057 -0.002627002067474421 0.1026357437619003 0 1058 0.1204351110546099 0.01618277756733321 0 1059 0.01824759622436196 0.1395403927545388 0 1060 0.00519706388530769 0.1266215876071107 0 1061 0.01000885287042754 0.09881678173426674 0 1062 -0.01595857661231019 0.09841695781811349 0 1063 0.09098264865446878 0.04747045281567282 0 1064 -0.1121624638603282 0.08488510563608057 0 1065 -0.03863547852613726 0.1156050187520906 0 1066 0.1223794683861556 0.0415686932396877 0 1067 0.01629515958185432 0.1166824870925706 0 1068 -0.0980316052367529 0.004998222819224163 0 1069 0.0763511809615816 0.008716769201269327 0 1070 0.03529777822021934 0.07542798490567451 0 1071 -0.04201644803749124 0.1345148869852655 0 1072 0.03212172173560052 0.1132852060312423 0 1073 0.0729196270199647 0.01930471239415545 0 1074 -0.05922987201679207 0.09931709871278277 0 1075 0.09789399189120783 0.03107501021062362 0 1076 0.04257983234267182 0.083293231811608 0 1077 -0.09083500821286988 0.1083353389627405 0 1078 0.1413201860484808 0.01671864469701458 0 1079 -0.111930666612093 0.03328055574606843 0 1080 -0.02246419469544975 0.1158940935826317 0 1081 0.1110710249249464 0.08623184605596845 0 1082 -0.1024162697578763 0.04129043239490249 0 1083 0.1240630145562951 0.03100808895769357 0 1084 0.05343152542007343 0.1308063972259573 0 1085 0.0996072765803736 0.01477138812378413 0 1086 0.08326007409287155 0.08383478604608932 0 1087 0.1015956779030507 0.05400987124502282 0 1088 -0.09039419549827835 0.03047259918829859 0 1089 0.03904495355601516 0.103651169122369 0 1090 0.1409957207892808 0.00849397953024853 0 1091 -0.07405192738648907 0.09787428197452151 0 1092 -0.03088583750332888 0.1212688231846743 0 1093 -0.09372973398265153 0.04918214107648457 0 1094 0.08474136749755706 0.00249446941494351 0 1095 -0.09542546012725969 0.08093869086195991 0 1096 -0.1307551738722696 0.05153314380843605 0 1097 -0.04737372470842639 0.1186608192341993 0 1098 0.02466601963857872 0.1209235124015763 0 1099 0.07133113270982468 0.1220451859262392 0 1100 0.09242543552045311 0.1083475245387011 0 1101 0.0427814395950941 0.1209138219808534 0 1102 -0.1215766860159672 0.01482580363191039 0 1103 0.07254376307539272 0.01092574411628442 0 1104 0.01981091486852319 0.0746004252463742 0 1105 -0.02581682073365855 0.07448102753414565 0 1106 0.03639194428217609 0.1358572339972565 0 1107 0.0804490461263976 0.05166742680366827 0 1108 0.1075663469311413 0.06144460397767271 0 1109 -0.1419328168557372 0.01759697376014563 0 1110 0.1113940111144049 0.006584040610502407 0 1111 0.07752906677109392 0.02269789187524948 0 1112 -0.09786573434450604 0.03239031078206776 0 1113 -0.09048656388317132 0.01322797715347975 0 1114 0.04802318612224707 0.09521898046893135 0 1115 0.05118745337975815 0.1100565764335261 0 1116 0.108736326037366 0.04794144723207147 0 1117 -0.09307541949033118 0.004891390043033779 0 1118 -0.05462494972009603 0.08750307983539496 0 1119 0.08075409929085012 0.03656835629387449 0 1120 0.06204346866730907 0.08195301075782115 0 1121 -0.1118268297467956 0.05032027336465131 0 1122 0.08342121596295615 0.0281547147305392 0 1123 0.1003392893712464 0.1001358933064145 0 1124 -0.1198458837044629 0.03046926530110552 0 1125 -0.1095786228613254 0.006345898734616799 0 1126 -0.1413445308000121 0.008373391863504876 0 1127 0.02564012572956118 0.08108311447351869 0 1128 -0.03202581531720145 0.08119227542430686 0 1129 -0.08139039309417884 0.06239427428399059 0 1130 -0.06257912178041926 0.08062962750200078 0 1131 -0.07226686346656541 0.08047226911229882 0 1132 0.07401050093511971 0.0569192814102895 0 1133 -0.02488556343979402 0.1387148979437411 0 1134 0.0944122767809655 0.0423111658458014 0 1135 -0.00291666666684008 0.07435387056734748 0 1136 -0.0804194693088876 0.03416084110132128 0 1137 0.1089321677828249 0.01191574737671201 0 1138 -0.1353989950142098 0.04068337478820749 0 1139 0.02842733295874626 0.09179268648148245 0 1140 -0.03430756420256713 0.09166331723435464 0 1141 0.1149524060434968 0.05679292120067617 0 1142 0.09512635700877606 0.09221811744988523 0 1143 -0.09091274525835259 0.02257844213276301 0 1144 0.09685063619146488 0.02493341852685384 0 1145 0.08616411374823058 0.0215304826673918 0 1146 -0.07365414831196773 0.03968145218617872 0 1147 0.1367282507080454 0.04154520702992575 0 1148 0.07864268929715135 0.1174484659172561 0 1149 0.01008680672518391 0.08659115764117781 0 1150 0.03085906695661618 0.0990784230931904 0 1151 -0.01592056851289484 0.08659082341895309 0 1152 -0.03632167721104421 0.09890142606947208 0 1153 0.09194795043906887 0.07963283017699656 0 1154 0.1210186932985373 0.06749032741875477 0 1155 -0.08139288553349866 0.0277121944114025 0 1156 0.09204977191475999 0.01002137933436772 0 1157 -0.1049980295068523 0.09492478904764365 0 1158 -0.07294582454934929 0.1232660028238846 0 1159 -0.1175801610832819 0.04522081987210391 0 1160 0.08146364612920139 0.0159696728570682 0 1161 0.08070025362587127 0.007004623208299541 0 1162 0.07645221182220793 0.01422620789393256 0 1163 -0.08274573944824481 0.01983492757342308 0 1164 0.1080252361490364 0.02128352852027646 0 1165 0.1170174385836887 0.02227791108690771 0 1166 0.09221389735263655 0.01789230418399734 0 1167 -0.1092932215165459 0.01219562245372693 0 1168 0.07207848215090441 0.02181535587169963 0 1169 0.08090621083650389 0.001944151439149458 0 1170 -0.04650715094460038 0.09471307127647539 0 1171 -0.0379166666667368 0.07353105508349203 0 1172 -0.07304006172859344 0.01774999999999468 0 1173 0.133211078233782 0.005364666135240599 0 1174 0.1171369628614397 0.0288344857862672 0 1175 0.1176403512164836 0.005722287345036673 0 1176 0.1390909650411175 0.03154641251769207 0 1177 -0.07416343748351113 0.06979008764936621 0 1178 -0.03842510402071078 0.08216317609210794 0 1179 0.03290038874136653 0.08184838146886886 0 1180 0.06275718457864742 0.09274207209711649 0 1181 0.07726308579413781 0.03840131717642249 0 1182 0.08512667426331087 0.1022691605228811 0 1183 -0.1335400181872528 0.005760616290756282 0 1184 0.02055702730023085 0.0933348523142791 0 1185 0.07729075940069496 0.04473852537292172 0 1186 -0.02628618778817459 0.0932861252056157 0 1187 0.04812621497350755 0.07447666619788845 0 1188 -0.08508312084834987 0.01156013118550481 0 1189 0.07418257516386394 0.06965716284378283 0 1190 -0.1389309047959229 0.03130735095027297 0 1191 -0.07400422929832673 0.04945757340653865 0 1192 -0.09296663136830918 0.05988651714703894 0 1193 -0.08689802359534715 0.08154387644531912 0 1194 -0.0731981260672845 0.02874999999996852 0 1195 0.002436361924141638 0.1416518330305815 0 1196 0.1025761606756086 0.01095827483873803 0 1197 0.0771186850923793 0.03090368149062245 0 1198 0.0768954471703527 0.1055198211283336 0 1199 0.07589590483502857 0.01956151525568085 0 1200 -0.0536726393736142 0.1100662763311141 0 1201 0.07727217450930429 0.01143598937060955 0 1202 0.1154719370297698 0.04199772572995791 0 1203 -0.09997266983784156 0.01529030931277991 0 1204 0.08804951004688784 0.03550947602523803 0 1205 0.1073958350862898 0.003387749629848048 0 1206 0.0718499994867695 0.001597586815529223 0 1207 0.1276496563378093 0.01708911235195314 0 1208 -0.1148180383899205 0.05754194269782695 0 1209 -0.07898896328850316 0.003864693083224588 0 1210 0.1115838656825792 0.06979572094506253 0 1211 -0.07278283828313432 0.002682010444874142 0 1212 0.05625196365907684 0.07431609311772089 0 1213 0.07412747740035262 0.00137342306148388 0 1214 0.1039651583751516 0.03846885788264826 0 1215 0.07150468314990839 0.009142848361581201 0 1216 0.08105174597234546 0.04685276954498145 0 1217 0.07769167186684385 0.005908792002115011 0 1218 -0.07413503566681233 0.05695578365979842 0 1219 0.06343228720658338 0.1179475824838798 0 1220 0.0858600718087805 0.01136119502111756 0 1221 0.09637315703153217 0.003959259785519547 0 1222 -0.1096554863003395 0.0716164747750154 0 1223 -0.09818145176191911 0.03811595040669417 0 1224 -0.1158445080602375 0.004993658001000045 0 1225 -0.02550476631240656 0.1089372421623385 0 1226 -0.06491737272590091 0.09034631723968917 0 1227 -0.06315747132256572 0.116038057407438 0 1228 0.05600454500006559 0.01644200005056 0 1229 0.05509774809246017 0.03126625531388749 0 1230 0.05310595440830023 0.05094690845321247 0 1231 0.04883648103117275 0.01086216675060252 0 1232 -0.05248968061533541 0.0525701878318189 0 1233 -0.05490667515708103 0.03223294043190733 0 1234 0.06124999999997192 0.01020571081700541 0 1235 -0.03738119183643607 0.05478043901250164 0 1236 0.03846822398174235 0.0548768907047127 0 1237 -0.02178510099174928 0.05519306743931152 0 1238 0.00285714285723648 0.05500000000002737 0 1239 0.02018098428893293 0.05511728863049317 0 1240 0.04953025482921175 0.02301984908466817 0 1241 0.05898323291258774 0.04218850657509009 0 1242 0.06055466678159531 0.02397472328021416 0 1243 0.05478883174582902 0.008772322548408838 0 1244 -0.009710401804665938 0.05311545953152703 0 1245 0.0629673726005377 0.01656193716499502 0 1246 -0.05809055721985934 0.04335262453526343 0 1247 0.04928532878875854 0.03864907152384892 0 1248 0.05970372608324732 0.05968315074765053 0 1249 0.06248905792911651 0.03149489275931202 0 1250 0.04648651551048669 0.01768829892697597 0 1251 0.04487363423469724 0.007288221874348778 0 1252 -0.06052827551833755 0.05981987502911047 0 1253 0.04830499817018465 0.06048146282856494 0 1254 -0.04915977803963024 0.04348375460983901 0 1255 0.03034606383608338 0.05012442227381428 0 1256 0.06553189192559467 0.007361696956446621 0 1257 -0.04524992522705491 0.06030715280065592 0 1258 0.04749059033856513 0.03033987334220203 0 1259 -0.04921904620211197 0.02497696446315514 0 1260 -0.06038538869958409 0.02444321232771541 0 1261 0.06166391403467111 0.0499412606251728 0 1262 0.010522017108086 0.04985048413863646 0 1263 0.03012812770918962 0.06018291212243387 0 1264 0.01143798981126954 0.060047378621862 0 1265 0.0450331914528423 0.04761469386331724 0 1266 -0.03009396924350356 0.04867798610260275 0 1267 0.06541991542506734 0.01207743382555192 0 1268 0.05053652154297769 0.006777203488982244 0 1269 -0.03058947724861445 0.06055711793536986 0 1270 0.05533044250544651 0.02154542379891145 0 1271 0.05908963659132969 0.006286232073238615 0 1272 -0.01465131162270624 0.06099360823864521 0 1273 -0.005035564343891213 0.06099400145599035 0 1274 -0.04260424944800682 0.04812469613775901 0 1275 -0.06149958060708954 0.05123505672744265 0 1276 0.0442013103388974 0.01210758567957435 0 1277 0.05131861092367986 0.01583030812830436 0 1278 -0.04744630457228335 0.03509185411009466 0 1279 -0.00246693359194235 0.04824200095631741 0 1280 0.06528944888413357 0.02126978516015628 0 1281 -0.06213131576014422 0.03526118411529136 0 1282 -0.01709048981191227 0.04846085427667773 0 1283 0.0640859894612172 0.03854308154096143 0 1284 0.03593061950443865 0.04733381845065804 0 1285 0.05744112008281806 0.01218093389112085 0 1286 0.05947856858551945 0.01997175962268483 0 1287 -0.0390379824566073 0.06250097080115666 0 1288 0.05816711065466621 0.03588327665517498 0 1289 0.0201545376523642 0.04832315724395939 0 1290 0.06547215390210051 0.0266730631540573 0 1291 0.03849071927649441 0.06287712856380086 0 1292 0.02041666666653099 0.06276124463893971 0 1293 0.002916666666486926 0.06278344671203485 0 1294 0.04518542995297216 0.02106357655325965 0 1295 -0.02268820143094756 0.06251708799756303 0 1296 -0.05293346408905995 0.06265319495769213 0 1297 0.05375362400544585 0.005672348745461865 0 1298 0.06182057318234185 0.006110687643177828 0 1299 0.05413266263200771 0.04532893104197579 0 1300 0.05312246974040798 0.02657231995119635 0 1301 0.005170811627576584 0.04703488924876871 0 1302 0.05360160631416618 0.01261402445592167 0 1303 0.06430216621165383 0.04280231481221076 0 1304 -0.05521541757168695 0.03945320982212391 0 1305 0.05412010514294718 0.06236309969907226 0 1306 -0.04605649420104001 0.05364009904061307 0 1307 0.06099960204825486 0.01407981320801721 0 1308 0.04755176102702144 0.00573942440405215 0 1309 0.06436390998389407 0.0552425264836877 0 1310 -0.04601382253681437 0.02981502172596724 0 1311 -0.02366236044264908 0.04674442317443257 0 1312 -0.03515938685846218 0.04630011997976945 0 1313 0.05888618297794214 0.02843161651280026 0 1314 0.0664738504156686 0.01536784898566132 0 1315 0.04566146711093558 0.03516327546156273 0 1316 0.0433675185000244 0.005481605334110607 0 1317 0.05198301619485394 0.02031209580807206 0 1318 -0.00901589374198645 0.04507326368746746 0 1319 0.0445550513891787 0.0265765301223311 0 1320 -0.06449125400335787 0.02955785248740409 0 1321 0.0476792740512063 0.05359285904599244 0 1322 -0.05503938204018404 0.02077074748414869 0 1323 0.05061377264234464 0.03340172762010539 0 1324 -0.0638051690575536 0.04547151980738022 0 1325 0.0535432617085024 0.05686120558086134 0 1326 0.05196091572293611 0.01016526574961884 0 1327 -0.05386130189191629 0.04688930357631674 0 1328 0.04321619884879913 0.01511017771560135 0 1329 0.06382039912009918 0.06381884840929238 0 1330 0.06716870392477463 0.005325507896638855 0 1331 -0.003655741571426442 0.05438255802380141 0 1332 -0.01576681909980307 0.05433101355458813 0 1333 0.05505503181549939 0.03985083581105384 0 1334 -0.06463108792518028 0.05641930391998716 0 1335 0.04333879132599163 0.06498830544030837 0 1336 -0.05500627582114879 0.02667647002333349 0 1337 -0.06394517060172102 0.06397277283738642 0 1338 0.02697987710585577 0.05521004693452906 0 1339 0.04503550964167748 0.04245311758981026 0 1340 0.02534514179576525 0.04530839646110799 0 1341 0.06745550251471717 0.009142848361581205 0 1342 0.04258482768492212 0.009209421697152602 0 1343 -0.01014273014179128 0.06370899538894746 0 1344 -0.0314338290401445 0.05519284861697214 0 1345 0.05677761194656708 0.00478527739901425 0 1346 0.04688599384952021 0.0134894197483833 0 1347 0.06602164217994372 0.03244021605975504 0 1348 0.02582778875548456 0.06499743265641811 0 1349 -0.04468619541051167 0.02250000000002046 0 1350 0.05834551239512873 0.05409975271067538 0 1351 0.03275312452446315 0.05501140268611609 0 1352 -0.04851448213497182 0.04871691215854369 0 1353 0.04790377999405471 0.008293231166741527 0 1354 0.01517137648280787 0.06487583566828908 0 1355 0.05815358843772648 0.009474775971153926 0 1356 -0.04541135998041181 0.04059912850541576 0 1357 -0.0579210699836359 0.05488433291976613 0 1358 0.01499557049916953 0.04522312393944064 0 1359 0.03189186860538435 0.04434293825668301 0 1360 0.01391692942460955 0.05498617186705666 0 1361 0.05821243352523734 0.04638052127222267 0 1362 -0.06555851582937894 0.03904071468680532 0 1363 0.06734720575047183 0.01886838367231872 0 1364 -0.04307844150037613 0.06584445070555468 0 1365 0.008527787562446633 0.05498281084867727 0 1366 0.008066575081961675 0.06486662147161003 0 1367 0.04208352748792424 0.05829349487454847 0 1368 -0.05039885513124603 0.05759099096504255 0 1369 -0.06441763264380612 0.02053702394893651 0 1370 -0.009817426741075341 0.05837231407807465 0 1371 0.05662780669845156 0.02494702381223688 0 1372 0.04283258374890006 0.01919315528207613 0 1373 -0.03354629780023727 0.06478905669949814 0 1374 0.04535567032438163 0.004668984009584139 0 1375 0.06376075667403888 0.005097682548396762 0 1376 0.06426659938890725 0.009747858646546002 0 1377 0.0512281686462969 0.00449299148145486 0 1378 0.04975469880798036 0.0479945830481249 0 1379 0.05943421358858653 0.01678416852455399 0 1380 0.06604446357887646 0.05094690845321249 0 1381 0.03316531435155259 0.06482238700530145 0 1382 0.04926377905971374 0.02675987460758352 0 1383 -0.05781870580327601 0.06464324144031786 0 1384 0.05908393404164668 0.06522648317321462 0 1385 0.02460132093580031 0.05081666230878077 0 1386 -0.0486552058842078 0.01937158816293538 0 1387 -0.04171744557953224 0.05597110690676008 0 1388 0.06248928222271881 0.01988831144250534 0 1389 0.04850235064465193 0.02009676168997658 0 1390 0.04357105375197479 0.03170038742458946 0 1391 -0.05083971223140264 0.03034751979576453 0 1392 -0.05904039700195275 0.03042726847087128 0 1393 0.009566251275569202 0.04442169946536917 0 1394 0.05081640077322858 0.01323259797546282 0 1395 0.06374977985440027 0.01399311777770186 0 1396 -0.03493223862654811 0.05936733286441516 0 1397 0.04077521514051752 0.04480346656227459 0 1398 -0.0272379911639108 0.06512390567794211 0 1399 0.06710545273578357 0.02925929117875008 0 1400 -0.03107906092169654 0.04407468863811601 0 1401 0.05190719984147583 0.02935745953166797 0 1402 -0.001819318056263086 0.06506701664756404 0 1403 0.05004270770947522 0.06580494454867536 0 1404 -0.01445103280315601 0.04447129979489434 0 1405 0.05473488223493033 0.01887745512533863 0 1406 -0.01809029434959459 0.06486922510107307 0 1407 -0.03452865159918134 0.05109206566923876 0 1408 0.05892344970755952 0.00402729772007197 0 1409 0.06198235663425609 0.02728980015619583 0 1410 0.04272060164445256 0.05264221757506326 0 1411 0.01622478933483018 0.05955758388532813 0 1412 0.05468546808959499 0.03508270229343153 0 1413 -0.04808569949664441 0.06576095969278055 0 1414 0.04581124226692382 0.01012406998041262 0 1415 0.05877235719084269 0.03235219506242137 0 1416 -0.04252698301234677 0.04365250980700614 0 1417 -0.0573672966481875 0.03540004163078353 0 1418 -0.05855454334448837 0.04775117028371611 0 1419 -0.02561804695787379 0.05251235100585927 0 1420 0.06606802699195703 0.04686861883359736 0 1421 0.06067358517939791 0.007979662543796564 0 1422 0.01595400779463244 0.05070004516391727 0 1423 0.006287886435656313 0.05939259177012214 0 1424 0.06703270566347365 0.02393304349644657 0 1425 -0.06545609985986957 0.02496634361750992 0 1426 -0.04352739527906617 0.03337559864511033 0 1427 -0.06610765520926115 0.05083937555658185 0 1428 -0.01975930573445754 0.05942852449775061 0 1429 -0.01949952802597435 0.04424517549926236 0 1430 0.06556601410528537 0.05963209140695119 0 1431 -0.05970590914508544 0.01970500757076649 0 1432 0.06786985367109062 0.01213438500305578 0 1433 3.510657914722737e-05 0.05916551682865213 0 1434 0.052645675754488 0.007882565797091816 0 1435 -0.02557410691194452 0.05866714465532277 0 1436 0.02470668890519877 0.05965378499656279 0 1437 0.0565297306989124 0.007102283114052442 0 1438 -0.06637313379835513 0.03424999999995272 0 1439 -0.04123204418621323 0.05240314519937066 0 1440 0.0006764560219611591 0.04469266417761883 0 1441 0.03562723138667047 0.05871027297686802 0 1442 0.06690673426918911 0.04011304316057887 0 1443 -0.05526471152373991 0.05878432019443276 0 1444 0.05351480462705691 0.01500566690427515 0 1445 0.05256046040147538 0.02358139020214757 0 1446 0.04960230983663119 0.04353564611116165 0 1447 0.00154105772310198 0.0505606337772833 0 1448 0.06228355525156534 0.03499136853151198 0 1449 0.05819037277951993 0.02234152084856399 0 1450 -0.0211589151172518 0.05059863604651385 0 1451 -0.0123698619560838 0.04911060451123055 0 1452 0.04188703237523579 0.01213931520703732 0 1453 0.06280784387827025 0.01191108101079901 0 1454 0.06680501044604745 0.03637462383067467 0 1455 -0.05035580191300552 0.03944996493745406 0 1456 0.06296727736559704 0.007785010114826 0 1457 -0.0521673452115945 0.03528782090039457 0 1458 0.06380343568137967 0.02383812111492924 0 1459 0.04658014070279878 0.02397295298098942 0 1460 0.06124999999997192 0.004064979128106989 0 1461 -0.04376723995098303 0.02641952354235369 0 1462 0.05710234210253047 0.04990282553002792 0 1463 0.0486960623938336 0.01593651815789492 0 1464 0.06181668161932572 0.04587119437406748 0 1465 -0.004386369539102073 0.04446440869151434 0 1466 0.04936329024324941 0.004401923874897851 0 1467 0.05559005867054712 0.02791776345026799 0 1468 0.03565220706400101 0.0516262562675433 0 1469 0.0679338720596158 0.02149068143833962 0 1470 0.05006463232194411 0.008961332104964314 0 1471 0.05551041203885798 0.0111946826060473 0 1472 0.06056184718036098 0.03873078121113276 0 1473 -0.01422917161520418 0.06595456960180146 0 1474 0.05569735148602862 0.01366198577545786 0 1475 0.05817105424171368 0.01435249417991653 0 1476 -0.04381921251606976 0.01848305501929471 0 1477 0.005723763375689535 0.05148576360267863 0 1478 0.06803037109416479 0.007180214324865604 0 1479 -0.04577310693725789 0.04531270360432556 0 1480 -0.00652081381192602 0.04986154230619604 0 1481 -0.05318810534293969 0.0426638980275679 0 1482 0.04288224588435612 0.02289935322901965 0 1483 -0.02725279240727231 0.04389941958303026 0 1484 -0.06604898307652705 0.06034462090786364 0 1485 -0.0382544672341297 0.04939245517142716 0 1486 0.05980386811479253 0.01203413484633549 0 1487 -0.0379166666667368 0.0668139734028412 0 1488 -0.03866913818030709 0.04389479809411638 0 1489 -0.0608644413542113 0.03973597808836361 0 1490 0.04018646839438721 0.04933717780809029 0 1491 0.03687224363884073 0.04329099235451775 0 1492 0.04377693086798873 0.03863606839738095 0 1493 -0.05643356427953516 0.0508646824115657 0 1494 0.04201544856762977 0.00681303787588416 0 1495 0.04186278019558278 0.004291732078063073 0 1496 0.06674424428666312 0.06675532960407607 0 1497 0.02007074999249724 0.04356200651664718 0 1498 0.04996017752439479 0.01788461152378974 0 1499 -0.04313013920136159 0.03695761237291528 0 1500 0.05721903599656157 0.01907066533779563 0 1501 0.05287795943503 0.0174067839257113 0 1502 0.06469947864659406 0.01860468482026097 0 1503 -0.06123231080554535 0.06705181608511226 0 1504 0.03791666666657505 0.06698896271758933 0 1505 0.05532568495118564 0.06699679932410665 0 1506 0.02041666666653098 0.06696821949744941 0 1507 0.002916666666486926 0.06698112830496124 0 1508 0.04374999999999289 0.003829543215495597 0 1509 0.06847255981554957 0.004046210943780759 0 1510 -0.006414276649731779 0.06589765981874626 0 1511 -0.06708333333333771 0.0672499999999904 0 1512 0.06461413267624008 0.02943145266161405 0 1513 -0.06710440816094787 0.01775925598723146 0 1514 -0.03921253494268871 0.05863146255527495 0 1515 -0.06283333333334672 0.007499999999986543 0 1516 -0.04716666666665267 0.007500000000013712 0 1517 -0.05542857142856644 0.008679407845694046 0 1518 -0.0506777758738822 0.005056868006628925 0 1519 -0.05882226994497471 0.004777500109540942 0 1520 -0.05991732690905087 0.01032500307485696 0 1521 -0.05099358974359772 0.01034116809115642 0 1522 -0.06566188354467209 0.0108875005124694 0 1523 -0.04443730025248361 0.004176144667778371 0 1524 -0.04433333333332537 0.01090000000000677 0 1525 -0.06547937405066473 0.004129583351583458 0 1526 -0.04298757380911689 0.007507769864070622 0 1527 -0.0670034354950818 0.007501743251423255 0 1528 0.06374999999998479 0.00125 0 1529 0.05624999999995907 0.00125 0 1530 0.04374999999999245 0.00125 0 1531 0.05124999999996634 0.00125 0 1532 0.05374999999995952 0.00125 0 1533 0.04624999999998494 0.00125 0 1534 0.04874999999997552 0.00125 0 1535 0.06124999999997192 0.00125 0 1536 0.04124999999999807 0.00125 0 1537 0.05874999999996447 0.00125 0 1538 0.06874999999999697 0.00125 0 1539 0.06624999999999359 0.00125 0 1540 0.02036805118374901 0.01812065107544686 0 1541 0.0009974326658506926 0.02072775866257577 0 1542 -0.01982142857142763 0.02000000000000722 0 1543 0.02971867184649751 0.01014766476916685 0 1544 0.02818133110156949 0.02690817129818473 0 1545 0.01055512854329999 0.01258341304700112 0 1546 0.01143518676432974 0.0272437093207577 0 1547 0.02016429856173663 0.009571274859246847 0 1548 -0.009938974133093779 0.0127408313557689 0 1549 -0.007987998581626559 0.02699920845210563 0 1550 -0.02919410113560711 0.0128173902119099 0 1551 -0.0288660851220607 0.02745846756968257 0 1552 0.03180298647006193 0.01811277538970511 0 1553 0.03480156189046221 0.006414903571350245 0 1554 0.00075419269651792 0.00924979422749066 0 1555 0.002070875450293012 0.03021584366706013 0 1556 -0.01894810815044841 0.009205631622931275 0 1557 -0.01840039304580488 0.03032975936351359 0 1558 0.02041137138436748 0.03059722041226205 0 1559 0.03500293616291426 0.01204753888715955 0 1560 0.02616389963267024 0.005526885626802423 0 1561 0.01318159982018973 0.01973342133714509 0 1562 -0.03182939206985845 0.01959097284366571 0 1563 0.02631510218333976 0.01555288895578708 0 1564 0.01430885284993679 0.006285368216952283 0 1565 0.03358847359701442 0.03182065424556338 0 1566 -0.01216009320731712 0.01990021379514791 0 1567 0.0340033539567504 0.02429788446658897 0 1568 -0.0336403081718802 0.03275812047988404 0 1569 -0.03364030817188148 0.007241879520142651 0 1570 0.00638605116147205 0.006534370011346055 0 1571 0.03637555504007452 0.003885595874455514 0 1572 0.01876697104762311 0.02563032327105848 0 1573 0.02949987370916567 0.004634194022435136 0 1574 0.02614008669373894 0.02220368461136145 0 1575 0.01712627664474054 0.01525715650381933 0 1576 0.02539630816221701 0.0347767557092262 0 1577 -0.005229119217766308 0.0337637794960175 0 1578 0.03504439618912997 0.01767383604515568 0 1579 0.006949955648869045 0.03355471800432867 0 1580 -0.02499797008947772 0.005745519902567513 0 1581 -0.02517782074967947 0.03331286016991793 0 1582 0.008194461251618268 0.01707782963701099 0 1583 -0.005174555814830908 0.006759283839353892 0 1584 -0.01292472894084425 0.03330260529611202 0 1585 -0.01292472894086804 0.006697394703898376 0 1586 0.02524071074889454 0.009492841958404427 0 1587 0.0208680330664881 0.005004000523824107 0 1588 0.03685915032101564 0.0092035217836382 0 1589 -0.005511062497791703 0.01810209042733039 0 1590 0.01588219885508731 0.0338495266011908 0 1591 0.03013260525120269 0.01498203416132485 0 1592 -0.003987950636164397 0.02522794055339172 0 1593 0.005259159142700445 0.02501823838215685 0 1594 -0.02568129743813066 0.02220119379824699 0 1595 0.03327235673012621 0.003129607809008921 0 1596 -0.0339468180956185 0.01493504923331482 0 1597 -0.03414789168720821 0.02539813375351755 0 1598 -0.02287007241202583 0.01471714258826218 0 1599 -0.01598367438710069 0.02564302153924484 0 1600 -0.0153525426725208 0.01566254982445322 0 1601 0.02359068263292942 0.02633752876552409 0 1602 0.02296934292441149 0.01407479420329495 0 1603 0.03777983166402706 0.00596762583119238 0 1604 0.03603922680614371 0.02092685081012164 0 1605 -0.02362435525400007 0.02748880135315489 0 1606 0.006265108947793663 0.01148333490006098 0 1607 -0.005364487793172948 0.01243767619324043 0 1608 0.03308312524162817 0.009394624195988431 0 1609 0.00225267090585702 0.004375277755012959 0 1610 0.002753327820898925 0.03534379260350635 0 1611 -0.0201642094083056 0.004606643341151428 0 1612 -0.02016420940830246 0.03539335665883413 0 1613 0.0363462091109214 0.02775101514605291 0 1614 0.01713121404048211 0.003585513777608511 0 1615 0.01509201421761 0.01065660823367463 0 1616 0.03019745692249079 0.02282195182176758 0 1617 -0.02772172055322264 0.01732774086109441 0 1618 0.0008993756032925121 0.0164024230322865 0 1619 0.01523855777080436 0.0287368294526208 0 1620 0.03786943399162163 0.01208825563499961 0 1621 -0.00769316788106825 0.02175925464724318 0 1622 0.02033797568035253 0.03584470054453581 0 1623 0.03078004879132018 0.03567300064872701 0 1624 0.009083419863846929 0.02322923037022039 0 1625 0.03147331501772715 0.006859318898975182 0 1626 -0.03072534305391712 0.004393847797722763 0 1627 -0.03121043441068778 0.03557407176981713 0 1628 -0.008783948541006262 0.03589339359897987 0 1629 0.02697863076473503 0.002531367719099623 0 1630 0.02780481686656788 0.01864206658177044 0 1631 0.01036922274578948 0.004028953008234127 0 1632 -0.0358269505583812 0.02156645701245412 0 1633 0.03588270641421892 0.03587011205119263 0 1634 0.02171505525547501 0.02186491819026997 0 1635 -0.009048076328828883 0.004047601849016637 0 1636 0.02841929419099102 0.007332181055156803 0 1637 0.01746437105865346 0.02072337671694504 0 1638 0.03701894909211115 0.0151215733380588 0 1639 0.02390147121809431 0.003247522103352434 0 1640 0.007113700037776882 0.02889629292971535 0 1641 0.0233107742501428 0.006770011777891261 0 1642 0.02762261836011315 0.01259496740081151 0 1643 0.01281592814162225 0.01572795444400479 0 1644 0.03800713876096377 0.001994012218209532 0 1645 -0.01336474708980333 0.02876855455867306 0 1646 -0.01362504416251806 0.0110135516636246 0 1647 0.02965463242782034 0.03141235174014607 0 1648 -0.03515137506299651 0.01087510984718959 0 1649 -0.03513842175463484 0.02918703717002238 0 1650 -0.03600011301272139 0.004022621219648834 0 1651 -0.0360207294032848 0.03599301614016449 0 1652 -0.00157639558535035 0.004076871164371503 0 1653 -0.03632063214477163 0.01821849581788967 0 1654 0.03588175191854034 0.00178693330695036 0 1655 -0.001636606071823312 0.03589007702966606 0 1656 -0.02495233102848675 0.01050920562497988 0 1657 0.0106244734628923 0.008531467730011625 0 1658 0.01403309048640374 0.0240783317007358 0 1659 0.01751288254725072 0.007020553122261275 0 1660 0.02423529943548169 0.01827259702703473 0 1661 -0.0303955314912161 0.02380644514303021 0 1662 0.03199524285276113 0.02750200478638393 0 1663 0.02544686514178075 0.03000640558506863 0 1664 0.0005238408753406167 0.02468516423147946 0 1665 0.0371454534471021 0.02371410952099687 0 1666 0.03153940559572596 0.01229800506319702 0 1667 0.03732032062015273 0.03214281568519025 0 1668 -0.008470422070311057 0.03136550159107951 0 1669 0.01373241952431761 0.002779967000558984 0 1670 -0.01990287861924724 0.02441333280476322 0 1671 -0.003041716719647666 0.02960316770790364 0 1672 0.03753940058911222 0.01847749364875406 0 1673 0.01130734617327518 0.03136640718652525 0 1674 0.03342354646019099 0.01503929381410017 0 1675 -0.009336721364160765 0.01676710270719733 0 1676 -0.02977690475706111 0.008597158817418713 0 1677 -0.0304953488025378 0.03156378633206905 0 1678 -0.01606724847614087 0.003999584406618586 0 1679 -0.01606724847614086 0.03600041559335716 0 1680 0.02984065942863736 0.001961999236727678 0 1681 0.03843250509301307 0.003859590198416644 0 1682 -0.009251439997214884 0.008649175292321039 0 1683 0.03313941518180979 0.02118356131156007 0 1684 -0.01209231062539206 0.02401538406822648 0 1685 -0.02379726722349848 0.01857296400795861 0 1686 -0.03695835924951988 0.0074279221174017 0 1687 -0.03695989186595997 0.03258763475802177 0 1688 0.01075823786010777 0.03603382139461263 0 1689 -0.002682466352083399 0.02119426444361433 0 1690 -0.01588548801383425 0.02160575033864048 0 1691 0.004771559630170079 0.02090133106082629 0 $EndNodes $Elements 3380 1 1 2 106 1 18 20 2 1 2 106 1 20 21 3 1 2 106 1 21 22 4 1 2 106 1 22 23 5 1 2 106 1 23 24 6 1 2 106 1 24 25 7 1 2 106 1 25 26 8 1 2 106 1 26 19 9 1 2 106 2 19 27 10 1 2 106 2 27 28 11 1 2 106 2 28 29 12 1 2 106 2 29 30 13 1 2 106 2 30 31 14 1 2 106 2 31 32 15 1 2 106 2 32 33 16 1 2 106 2 33 34 17 1 2 106 2 34 35 18 1 2 106 2 35 2 19 1 2 106 3 2 36 20 1 2 106 3 36 37 21 1 2 106 3 37 38 22 1 2 106 3 38 39 23 1 2 106 3 39 8 24 1 2 106 4 8 40 25 1 2 106 4 40 41 26 1 2 106 4 41 42 27 1 2 106 4 42 43 28 1 2 106 4 43 44 29 1 2 106 4 44 45 30 1 2 106 4 45 1 31 1 2 106 5 1 46 32 1 2 106 5 46 47 33 1 2 106 5 47 48 34 1 2 106 5 48 49 35 1 2 106 5 49 50 36 1 2 106 5 50 51 37 1 2 106 5 51 52 38 1 2 106 5 52 53 39 1 2 106 5 53 54 40 1 2 106 5 54 9 41 1 2 106 6 9 55 42 1 2 106 6 55 56 43 1 2 106 6 56 57 44 1 2 106 6 57 58 45 1 2 106 6 58 59 46 1 2 106 6 59 60 47 1 2 106 6 60 61 48 1 2 106 6 61 62 49 1 2 106 6 62 63 50 1 2 106 6 63 64 51 1 2 106 6 64 65 52 1 2 106 6 65 4 53 1 2 106 7 4 66 54 1 2 106 7 66 67 55 1 2 106 7 67 68 56 1 2 106 7 68 69 57 1 2 106 7 69 70 58 1 2 106 7 70 71 59 1 2 106 7 71 72 60 1 2 106 7 72 73 61 1 2 106 7 73 74 62 1 2 106 7 74 75 63 1 2 106 7 75 76 64 1 2 106 7 76 77 65 1 2 106 7 77 14 66 1 2 106 8 14 78 67 1 2 106 8 78 79 68 1 2 106 8 79 80 69 1 2 106 8 80 81 70 1 2 106 8 81 82 71 1 2 106 8 82 83 72 1 2 106 8 83 84 73 1 2 106 8 84 15 74 1 2 105 23 18 214 75 1 2 105 23 214 215 76 1 2 105 23 215 216 77 1 2 105 23 216 217 78 1 2 105 23 217 218 79 1 2 105 23 218 219 80 1 2 105 23 219 220 81 1 2 105 23 220 221 82 1 2 105 23 221 222 83 1 2 105 23 222 223 84 1 2 105 23 223 224 85 1 2 105 23 224 225 86 1 2 105 23 225 226 87 1 2 105 23 226 227 88 1 2 105 23 227 228 89 1 2 105 23 228 229 90 1 2 105 23 229 230 91 1 2 105 23 230 231 92 1 2 105 23 231 232 93 1 2 105 23 232 233 94 1 2 105 23 233 234 95 1 2 105 23 234 235 96 1 2 105 23 235 236 97 1 2 105 23 236 237 98 1 2 105 23 237 238 99 1 2 105 23 238 239 100 1 2 105 23 239 240 101 1 2 105 23 240 241 102 1 2 105 23 241 242 103 1 2 105 23 242 243 104 1 2 105 23 243 244 105 1 2 105 23 244 17 106 1 2 105 24 17 245 107 1 2 105 24 245 246 108 1 2 105 24 246 247 109 1 2 105 24 247 248 110 1 2 105 24 248 249 111 1 2 105 24 249 250 112 1 2 105 24 250 251 113 1 2 105 24 251 252 114 1 2 105 24 252 253 115 1 2 105 24 253 254 116 1 2 105 24 254 255 117 1 2 105 24 255 256 118 1 2 105 24 256 257 119 1 2 105 24 257 258 120 1 2 105 24 258 259 121 1 2 105 24 259 260 122 1 2 105 24 260 261 123 1 2 105 24 261 262 124 1 2 105 24 262 263 125 1 2 105 24 263 264 126 1 2 105 24 264 265 127 1 2 105 24 265 266 128 1 2 105 24 266 267 129 1 2 105 24 267 268 130 1 2 105 24 268 269 131 1 2 105 24 269 270 132 1 2 105 24 270 271 133 1 2 105 24 271 272 134 1 2 105 24 272 273 135 1 2 105 24 273 274 136 1 2 105 24 274 275 137 1 2 105 24 275 15 138 2 2 101 26 630 305 507 139 2 2 101 26 80 492 458 140 2 2 101 26 24 459 493 141 2 2 101 26 352 557 420 142 2 2 101 26 277 410 475 143 2 2 101 26 307 420 557 144 2 2 101 26 350 422 556 145 2 2 101 26 276 691 442 146 2 2 101 26 276 443 691 147 2 2 101 26 306 556 422 148 2 2 101 26 207 664 378 149 2 2 101 26 407 461 629 150 2 2 101 26 410 470 648 151 2 2 101 26 629 461 282 152 2 2 101 26 412 442 691 153 2 2 101 26 411 691 443 154 2 2 101 26 648 470 310 155 2 2 101 26 414 630 507 156 2 2 101 26 324 396 499 157 2 2 101 26 279 498 425 158 2 2 101 26 323 409 662 159 2 2 101 26 322 489 378 160 2 2 101 26 207 378 489 161 2 2 101 26 191 497 387 162 2 2 101 26 323 662 415 163 2 2 101 26 465 709 547 164 2 2 101 26 193 444 727 165 2 2 101 26 455 636 709 166 2 2 101 26 214 446 215 167 2 2 101 26 274 447 275 168 2 2 101 26 324 499 391 169 2 2 101 26 296 395 502 170 2 2 101 26 295 503 394 171 2 2 101 26 337 467 464 172 2 2 101 26 299 633 377 173 2 2 101 26 315 464 467 174 2 2 101 26 325 387 497 175 2 2 101 26 340 458 481 176 2 2 101 26 339 482 459 177 2 2 101 26 314 709 465 178 2 2 101 26 328 481 458 179 2 2 101 26 329 459 482 180 2 2 101 26 292 636 455 181 2 2 101 26 562 336 513 182 2 2 101 26 299 377 548 183 2 2 101 26 276 442 753 184 2 2 101 26 276 754 443 185 2 2 101 26 397 562 513 186 2 2 101 26 322 416 674 187 2 2 101 26 191 387 743 188 2 2 101 26 332 509 402 189 2 2 101 26 322 378 554 190 2 2 101 26 313 429 450 191 2 2 101 26 16 735 441 192 2 2 101 26 349 413 595 193 2 2 101 26 321 647 408 194 2 2 101 26 278 414 462 195 2 2 101 26 304 595 413 196 2 2 101 26 311 435 448 197 2 2 101 26 325 507 387 198 2 2 101 26 399 727 444 199 2 2 101 26 215 446 516 200 2 2 101 26 274 517 447 201 2 2 101 26 333 400 508 202 2 2 101 26 374 643 464 203 2 2 101 26 322 674 421 204 2 2 101 26 546 505 335 205 2 2 101 26 389 505 546 206 2 2 101 26 193 194 444 207 2 2 101 26 358 500 492 208 2 2 101 26 359 493 501 209 2 2 101 26 328 492 500 210 2 2 101 26 329 501 493 211 2 2 101 26 300 379 625 212 2 2 101 26 321 418 647 213 2 2 101 26 285 542 384 214 2 2 101 26 449 611 613 215 2 2 101 26 289 449 613 216 2 2 101 26 293 549 392 217 2 2 101 26 294 393 550 218 2 2 101 26 285 384 766 219 2 2 101 26 300 538 379 220 2 2 101 26 277 470 410 221 2 2 101 26 355 496 388 222 2 2 101 26 16 441 195 223 2 2 101 26 355 388 772 224 2 2 101 26 198 440 739 225 2 2 101 26 416 631 629 226 2 2 101 26 211 463 693 227 2 2 101 26 337 464 468 228 2 2 101 26 297 401 562 229 2 2 101 26 291 468 464 230 2 2 101 26 396 441 735 231 2 2 101 26 279 615 498 232 2 2 101 26 209 417 664 233 2 2 101 26 351 604 419 234 2 2 101 26 300 481 427 235 2 2 101 26 299 428 482 236 2 2 101 26 198 199 440 237 2 2 101 26 324 391 536 238 2 2 101 26 338 445 455 239 2 2 101 26 329 493 459 240 2 2 101 26 328 458 492 241 2 2 101 26 293 392 719 242 2 2 101 26 294 720 393 243 2 2 101 26 352 420 603 244 2 2 101 26 295 394 717 245 2 2 101 26 296 718 395 246 2 2 101 26 292 455 445 247 2 2 101 26 328 427 481 248 2 2 101 26 329 482 428 249 2 2 101 26 350 602 422 250 2 2 101 26 218 430 219 251 2 2 101 26 270 431 271 252 2 2 101 26 298 546 403 253 2 2 101 26 302 415 496 254 2 2 101 26 297 527 401 255 2 2 101 26 324 539 396 256 2 2 101 26 291 464 643 257 2 2 101 26 355 629 631 258 2 2 101 26 427 500 623 259 2 2 101 26 428 622 501 260 2 2 101 26 341 433 483 261 2 2 101 26 342 484 434 262 2 2 101 26 298 403 533 263 2 2 101 26 333 530 400 264 2 2 101 26 288 518 452 265 2 2 101 26 332 402 529 266 2 2 101 26 373 709 636 267 2 2 101 26 262 640 450 268 2 2 101 26 207 208 664 269 2 2 101 26 19 178 514 270 2 2 101 26 14 515 213 271 2 2 101 26 304 413 490 272 2 2 101 26 180 697 451 273 2 2 101 26 310 470 452 274 2 2 101 26 19 514 26 275 2 2 101 26 14 78 515 276 2 2 101 26 391 739 440 277 2 2 101 26 287 623 500 278 2 2 101 26 286 501 622 279 2 2 101 26 390 432 571 280 2 2 101 26 261 640 262 281 2 2 101 26 379 693 463 282 2 2 101 26 216 516 433 283 2 2 101 26 273 434 517 284 2 2 101 26 372 613 522 285 2 2 101 26 307 557 412 286 2 2 101 26 306 411 556 287 2 2 101 26 179 180 451 288 2 2 101 26 184 547 587 289 2 2 101 26 416 629 674 290 2 2 101 26 209 495 417 291 2 2 101 26 436 764 744 292 2 2 101 26 334 675 429 293 2 2 101 26 323 417 495 294 2 2 101 26 322 554 416 295 2 2 101 26 321 408 548 296 2 2 101 26 211 212 463 297 2 2 101 26 226 634 448 298 2 2 101 26 398 436 744 299 2 2 101 26 278 650 414 300 2 2 101 26 299 548 616 301 2 2 101 26 330 424 619 302 2 2 101 26 349 502 413 303 2 2 101 26 321 531 418 304 2 2 101 26 351 419 630 305 2 2 101 26 305 630 419 306 2 2 101 26 323 538 409 307 2 2 101 26 329 428 501 308 2 2 101 26 328 500 427 309 2 2 101 26 281 744 764 310 2 2 101 26 312 476 438 311 2 2 101 26 398 566 436 312 2 2 101 26 323 415 534 313 2 2 101 26 408 616 548 314 2 2 101 26 305 419 524 315 2 2 101 26 399 759 497 316 2 2 101 26 280 432 745 317 2 2 101 26 419 604 722 318 2 2 101 26 390 745 432 319 2 2 101 26 420 723 603 320 2 2 101 26 307 525 420 321 2 2 101 26 422 602 721 322 2 2 101 26 377 451 697 323 2 2 101 26 280 749 432 324 2 2 101 26 323 534 417 325 2 2 101 26 306 539 411 326 2 2 101 26 307 412 536 327 2 2 101 26 414 507 462 328 2 2 101 26 345 537 448 329 2 2 101 26 407 612 535 330 2 2 101 26 311 448 537 331 2 2 101 26 225 634 226 332 2 2 101 26 452 518 635 333 2 2 101 26 302 534 415 334 2 2 101 26 334 528 675 335 2 2 101 26 189 743 439 336 2 2 101 26 322 421 520 337 2 2 101 26 374 464 712 338 2 2 101 26 410 652 475 339 2 2 101 26 79 80 458 340 2 2 101 26 24 25 459 341 2 2 101 26 308 475 652 342 2 2 101 26 390 571 714 343 2 2 101 26 423 728 724 344 2 2 101 26 277 475 614 345 2 2 101 26 399 497 727 346 2 2 101 26 283 604 544 347 2 2 101 26 285 602 542 348 2 2 101 26 284 543 603 349 2 2 101 26 309 425 498 350 2 2 101 26 304 759 684 351 2 2 101 26 278 575 650 352 2 2 101 26 278 651 575 353 2 2 101 26 224 521 634 354 2 2 101 26 221 453 222 355 2 2 101 26 443 754 549 356 2 2 101 26 442 550 753 357 2 2 101 26 346 452 470 358 2 2 101 26 326 483 433 359 2 2 101 26 327 434 484 360 2 2 101 26 400 530 591 361 2 2 101 26 377 633 451 362 2 2 101 26 315 467 586 363 2 2 101 26 282 674 629 364 2 2 101 26 314 465 555 365 2 2 101 26 356 555 465 366 2 2 101 26 189 190 743 367 2 2 101 26 208 209 664 368 2 2 101 26 353 522 613 369 2 2 101 26 289 511 423 370 2 2 101 26 373 587 547 371 2 2 101 26 330 627 424 372 2 2 101 26 467 745 586 373 2 2 101 26 337 423 512 374 2 2 101 26 204 588 553 375 2 2 101 26 289 423 563 376 2 2 101 26 306 422 523 377 2 2 101 26 753 550 393 378 2 2 101 26 754 392 549 379 2 2 101 26 304 490 759 380 2 2 101 26 301 591 530 381 2 2 101 26 337 563 423 382 2 2 101 26 218 559 430 383 2 2 101 26 271 431 560 384 2 2 101 26 280 512 460 385 2 2 101 26 259 522 260 386 2 2 101 26 717 479 656 387 2 2 101 26 718 657 480 388 2 2 101 26 719 477 654 389 2 2 101 26 720 655 478 390 2 2 101 26 370 479 717 391 2 2 101 26 371 718 480 392 2 2 101 26 368 477 719 393 2 2 101 26 369 720 478 394 2 2 101 26 423 511 728 395 2 2 101 26 224 634 225 396 2 2 101 26 308 456 475 397 2 2 101 26 269 424 644 398 2 2 101 26 259 676 522 399 2 2 101 26 231 552 570 400 2 2 101 26 300 617 538 401 2 2 101 26 80 81 492 402 2 2 101 26 23 24 493 403 2 2 101 26 260 522 640 404 2 2 101 26 269 619 424 405 2 2 101 26 396 735 499 406 2 2 101 26 343 475 456 407 2 2 101 26 190 191 743 408 2 2 101 26 265 528 437 409 2 2 101 26 338 504 426 410 2 2 101 26 265 437 681 411 2 2 101 26 383 544 604 412 2 2 101 26 366 648 453 413 2 2 101 26 381 542 602 414 2 2 101 26 382 603 543 415 2 2 101 26 310 453 648 416 2 2 101 26 354 540 449 417 2 2 101 26 215 516 216 418 2 2 101 26 273 517 274 419 2 2 101 26 351 630 503 420 2 2 101 26 414 503 630 421 2 2 101 26 398 742 566 422 2 2 101 26 343 428 616 423 2 2 101 26 299 616 428 424 2 2 101 26 344 617 427 425 2 2 101 26 281 454 504 426 2 2 101 26 309 627 425 427 2 2 101 26 300 427 617 428 2 2 101 26 409 538 617 429 2 2 101 26 429 666 450 430 2 2 101 26 326 446 715 431 2 2 101 26 327 716 447 432 2 2 101 26 404 595 526 433 2 2 101 26 325 490 462 434 2 2 101 26 281 504 466 435 2 2 101 26 338 466 504 436 2 2 101 26 219 430 506 437 2 2 101 26 335 668 435 438 2 2 101 26 301 530 708 439 2 2 101 26 288 572 426 440 2 2 101 26 341 430 559 441 2 2 101 26 342 560 431 442 2 2 101 26 338 426 572 443 2 2 101 26 331 441 523 444 2 2 101 26 412 557 442 445 2 2 101 26 411 443 556 446 2 2 101 26 303 713 529 447 2 2 101 26 315 586 469 448 2 2 101 26 357 469 586 449 2 2 101 26 253 569 561 450 2 2 101 26 333 508 439 451 2 2 101 26 304 526 595 452 2 2 101 26 189 439 508 453 2 2 101 26 403 454 764 454 2 2 101 26 281 764 454 455 2 2 101 26 288 426 771 456 2 2 101 26 391 499 739 457 2 2 101 26 296 502 600 458 2 2 101 26 295 601 503 459 2 2 101 26 279 425 577 460 2 2 101 26 290 535 612 461 2 2 101 26 336 438 692 462 2 2 101 26 435 658 448 463 2 2 101 26 314 555 466 464 2 2 101 26 283 722 604 465 2 2 101 26 326 433 516 466 2 2 101 26 327 517 434 467 2 2 101 26 341 592 430 468 2 2 101 26 342 431 593 469 2 2 101 26 284 603 723 470 2 2 101 26 260 640 261 471 2 2 101 26 285 721 602 472 2 2 101 26 332 440 509 473 2 2 101 26 315 712 464 474 2 2 101 26 407 535 751 475 2 2 101 26 199 509 440 476 2 2 101 26 374 553 588 477 2 2 101 26 379 463 625 478 2 2 101 26 401 749 460 479 2 2 101 26 330 619 491 480 2 2 101 26 280 460 749 481 2 2 101 26 309 498 457 482 2 2 101 26 290 494 687 483 2 2 101 26 290 687 689 484 2 2 101 26 185 646 465 485 2 2 101 26 341 726 433 486 2 2 101 26 342 434 725 487 2 2 101 26 402 590 529 488 2 2 101 26 758 574 483 489 2 2 101 26 757 484 573 490 2 2 101 26 367 518 521 491 2 2 101 26 345 521 518 492 2 2 101 26 326 715 473 493 2 2 101 26 327 474 716 494 2 2 101 26 406 708 530 495 2 2 101 26 394 650 575 496 2 2 101 26 395 575 651 497 2 2 101 26 312 724 728 498 2 2 101 26 203 469 665 499 2 2 101 26 348 432 527 500 2 2 101 26 405 529 713 501 2 2 101 26 331 510 441 502 2 2 101 26 326 758 483 503 2 2 101 26 327 484 757 504 2 2 101 26 195 441 510 505 2 2 101 26 344 427 623 506 2 2 101 26 343 622 428 507 2 2 101 26 303 529 590 508 2 2 101 26 21 22 473 509 2 2 101 26 82 83 474 510 2 2 101 26 402 509 762 511 2 2 101 26 334 429 541 512 2 2 101 26 313 541 429 513 2 2 101 26 270 644 431 514 2 2 101 26 331 444 510 515 2 2 101 26 194 510 444 516 2 2 101 26 347 533 436 517 2 2 101 26 276 753 576 518 2 2 101 26 276 576 754 519 2 2 101 26 387 507 690 520 2 2 101 26 246 471 247 521 2 2 101 26 344 457 498 522 2 2 101 26 237 472 238 523 2 2 101 26 334 437 528 524 2 2 101 26 365 570 552 525 2 2 101 26 227 435 668 526 2 2 101 26 186 187 519 527 2 2 101 26 216 433 726 528 2 2 101 26 273 725 434 529 2 2 101 26 346 621 445 530 2 2 101 26 339 451 633 531 2 2 101 26 335 435 551 532 2 2 101 26 341 483 597 533 2 2 101 26 342 598 484 534 2 2 101 26 292 445 621 535 2 2 101 26 311 551 435 536 2 2 101 26 353 611 450 537 2 2 101 26 325 497 759 538 2 2 101 26 313 450 611 539 2 2 101 26 280 467 512 540 2 2 101 26 337 512 467 541 2 2 101 26 348 571 432 542 2 2 101 26 336 558 438 543 2 2 101 26 312 438 558 544 2 2 101 26 227 658 435 545 2 2 101 26 333 439 524 546 2 2 101 26 334 535 437 547 2 2 101 26 221 660 453 548 2 2 101 26 466 555 744 549 2 2 101 26 683 551 311 550 2 2 101 26 454 551 683 551 2 2 101 26 332 525 440 552 2 2 101 26 347 436 566 553 2 2 101 26 326 516 446 554 2 2 101 26 327 447 517 555 2 2 101 26 403 764 533 556 2 2 101 26 265 681 266 557 2 2 101 26 331 526 444 558 2 2 101 26 183 184 587 559 2 2 101 26 202 203 665 560 2 2 101 26 185 186 646 561 2 2 101 26 400 765 508 562 2 2 101 26 340 625 463 563 2 2 101 26 232 485 233 564 2 2 101 26 242 487 243 565 2 2 101 26 251 488 252 566 2 2 101 26 201 202 532 567 2 2 101 26 181 182 486 568 2 2 101 26 364 561 569 569 2 2 101 26 366 453 660 570 2 2 101 26 325 462 507 571 2 2 101 26 206 207 489 572 2 2 101 26 436 533 764 573 2 2 101 26 373 547 709 574 2 2 101 26 401 527 749 575 2 2 101 26 460 512 724 576 2 2 101 26 214 755 446 577 2 2 101 26 275 447 756 578 2 2 101 26 289 626 449 579 2 2 101 26 354 449 626 580 2 2 101 26 352 550 442 581 2 2 101 26 350 443 549 582 2 2 101 26 288 452 624 583 2 2 101 26 449 540 682 584 2 2 101 26 346 624 452 585 2 2 101 26 267 491 268 586 2 2 101 26 431 740 593 587 2 2 101 26 350 556 443 588 2 2 101 26 352 442 557 589 2 2 101 26 356 742 555 590 2 2 101 26 82 474 637 591 2 2 101 26 22 638 473 592 2 2 101 26 264 528 265 593 2 2 101 26 724 312 558 594 2 2 101 26 460 724 558 595 2 2 101 26 396 649 441 596 2 2 101 26 391 440 688 597 2 2 101 26 209 210 495 598 2 2 101 26 185 465 547 599 2 2 101 26 403 546 710 600 2 2 101 26 399 444 684 601 2 2 101 26 486 707 769 602 2 2 101 26 303 714 571 603 2 2 101 26 430 592 761 604 2 2 101 26 372 511 613 605 2 2 101 26 404 526 663 606 2 2 101 26 338 455 750 607 2 2 101 26 338 572 445 608 2 2 101 26 305 690 507 609 2 2 101 26 432 749 527 610 2 2 101 26 340 481 625 611 2 2 101 26 339 633 482 612 2 2 101 26 390 586 745 613 2 2 101 26 358 637 474 614 2 2 101 26 359 473 638 615 2 2 101 26 222 453 545 616 2 2 101 26 20 715 755 617 2 2 101 26 84 756 716 618 2 2 101 26 346 445 624 619 2 2 101 26 182 707 486 620 2 2 101 26 181 486 697 621 2 2 101 26 335 505 668 622 2 2 101 26 309 593 740 623 2 2 101 26 401 747 562 624 2 2 101 26 447 716 756 625 2 2 101 26 446 755 715 626 2 2 101 26 204 205 588 627 2 2 101 26 206 489 706 628 2 2 101 26 186 519 646 629 2 2 101 26 324 536 746 630 2 2 101 26 343 456 622 631 2 2 101 26 344 623 457 632 2 2 101 26 203 553 469 633 2 2 101 26 340 642 458 634 2 2 101 26 339 459 641 635 2 2 101 26 286 622 456 636 2 2 101 26 287 457 623 637 2 2 101 26 486 760 697 638 2 2 101 26 191 192 497 639 2 2 101 26 313 461 541 640 2 2 101 26 282 461 540 641 2 2 101 26 412 746 536 642 2 2 101 26 314 750 455 643 2 2 101 26 312 728 476 644 2 2 101 26 196 197 499 645 2 2 101 26 336 692 513 646 2 2 101 26 354 468 620 647 2 2 101 26 339 589 451 648 2 2 101 26 291 620 468 649 2 2 101 26 331 663 526 650 2 2 101 26 314 455 709 651 2 2 101 26 179 451 589 652 2 2 101 26 219 506 220 653 2 2 101 26 310 694 453 654 2 2 101 26 226 448 658 655 2 2 101 26 262 450 666 656 2 2 101 26 353 613 611 657 2 2 101 26 345 448 634 658 2 2 101 26 397 513 737 659 2 2 101 26 353 450 640 660 2 2 101 26 403 710 454 661 2 2 101 26 310 452 635 662 2 2 101 26 419 669 524 663 2 2 101 26 210 693 495 664 2 2 101 26 308 592 456 665 2 2 101 26 309 457 593 666 2 2 101 26 308 761 592 667 2 2 101 26 343 614 475 668 2 2 101 26 286 456 597 669 2 2 101 26 287 598 457 670 2 2 101 26 489 763 706 671 2 2 101 26 230 552 231 672 2 2 101 26 334 751 535 673 2 2 101 26 399 684 759 674 2 2 101 26 202 665 532 675 2 2 101 26 284 768 543 676 2 2 101 26 228 505 229 677 2 2 101 26 398 555 742 678 2 2 101 26 309 740 627 679 2 2 101 26 283 544 770 680 2 2 101 26 302 496 631 681 2 2 101 26 188 189 508 682 2 2 101 26 263 666 675 683 2 2 101 26 375 687 491 684 2 2 101 26 192 727 497 685 2 2 101 26 420 525 667 686 2 2 101 26 416 554 631 687 2 2 101 26 302 631 554 688 2 2 101 26 197 739 499 689 2 2 101 26 196 499 735 690 2 2 101 26 348 653 768 691 2 2 101 26 199 200 509 692 2 2 101 26 313 611 682 693 2 2 101 26 330 491 687 694 2 2 101 26 449 682 611 695 2 2 101 26 314 466 750 696 2 2 101 26 79 458 642 697 2 2 101 26 25 641 459 698 2 2 101 26 340 463 618 699 2 2 101 26 347 770 661 700 2 2 101 26 194 195 510 701 2 2 101 26 337 468 563 702 2 2 101 26 311 537 683 703 2 2 101 26 401 460 747 704 2 2 101 26 426 683 537 705 2 2 101 26 392 578 719 706 2 2 101 26 393 720 579 707 2 2 101 26 184 185 547 708 2 2 101 26 462 490 711 709 2 2 101 26 313 682 461 710 2 2 101 26 253 561 254 711 2 2 101 26 395 718 582 712 2 2 101 26 394 583 717 713 2 2 101 26 255 513 256 714 2 2 101 26 278 462 711 715 2 2 101 26 407 751 461 716 2 2 101 26 17 477 679 717 2 2 101 26 249 680 478 718 2 2 101 26 319 608 542 719 2 2 101 26 320 543 610 720 2 2 101 26 240 678 480 721 2 2 101 26 235 479 677 722 2 2 101 26 319 542 606 723 2 2 101 26 318 609 544 724 2 2 101 26 320 607 543 725 2 2 101 26 384 542 608 726 2 2 101 26 385 610 543 727 2 2 101 26 381 606 542 728 2 2 101 26 318 544 605 729 2 2 101 26 386 544 609 730 2 2 101 26 382 543 607 731 2 2 101 26 383 605 544 732 2 2 101 26 366 506 761 733 2 2 101 26 346 470 632 734 2 2 101 26 301 566 742 735 2 2 101 26 188 508 765 736 2 2 101 26 344 498 615 737 2 2 101 26 258 476 676 738 2 2 101 26 389 738 505 739 2 2 101 26 366 761 652 740 2 2 101 26 454 683 504 741 2 2 101 26 200 762 509 742 2 2 101 26 212 618 463 743 2 2 101 26 235 673 479 744 2 2 101 26 17 670 477 745 2 2 101 26 249 478 671 746 2 2 101 26 240 480 672 747 2 2 101 26 178 179 589 748 2 2 101 26 388 577 494 749 2 2 101 26 418 531 621 750 2 2 101 26 429 675 666 751 2 2 101 26 292 621 531 752 2 2 101 26 338 750 466 753 2 2 101 26 286 483 574 754 2 2 101 26 287 573 484 755 2 2 101 26 257 692 741 756 2 2 101 26 316 578 576 757 2 2 101 26 316 576 579 758 2 2 101 26 317 575 582 759 2 2 101 26 317 583 575 760 2 2 101 26 495 693 752 761 2 2 101 26 392 576 578 762 2 2 101 26 393 579 576 763 2 2 101 26 395 582 575 764 2 2 101 26 394 575 583 765 2 2 101 26 372 522 676 766 2 2 101 26 281 466 744 767 2 2 101 26 223 736 224 768 2 2 101 26 349 600 502 769 2 2 101 26 280 745 467 770 2 2 101 26 351 503 601 771 2 2 101 26 277 632 470 772 2 2 101 26 222 545 223 773 2 2 101 26 203 204 553 774 2 2 101 26 354 626 468 775 2 2 101 26 357 586 714 776 2 2 101 26 421 620 520 777 2 2 101 26 291 520 620 778 2 2 101 26 356 465 646 779 2 2 101 26 321 769 531 780 2 2 101 26 398 744 555 781 2 2 101 26 335 710 546 782 2 2 101 26 341 559 726 783 2 2 101 26 342 725 560 784 2 2 101 26 243 564 244 785 2 2 101 26 250 565 251 786 2 2 101 26 233 568 234 787 2 2 101 26 241 567 242 788 2 2 101 26 252 569 253 789 2 2 101 26 231 570 232 790 2 2 101 26 269 644 270 791 2 2 101 26 315 469 712 792 2 2 101 26 245 584 246 793 2 2 101 26 247 585 248 794 2 2 101 26 236 580 237 795 2 2 101 26 238 581 239 796 2 2 101 26 17 679 245 797 2 2 101 26 248 680 249 798 2 2 101 26 239 678 240 799 2 2 101 26 235 677 236 800 2 2 101 26 413 711 490 801 2 2 101 26 437 689 681 802 2 2 101 26 367 635 518 803 2 2 101 26 405 667 529 804 2 2 101 26 332 529 667 805 2 2 101 26 286 597 483 806 2 2 101 26 287 484 598 807 2 2 101 26 178 589 514 808 2 2 101 26 20 21 715 809 2 2 101 26 83 84 716 810 2 2 101 26 406 530 669 811 2 2 101 26 376 769 707 812 2 2 101 26 258 676 259 813 2 2 101 26 333 669 530 814 2 2 101 26 246 584 471 815 2 2 101 26 247 471 585 816 2 2 101 26 212 213 618 817 2 2 101 26 237 580 472 818 2 2 101 26 238 472 581 819 2 2 101 26 268 619 269 820 2 2 101 26 25 26 641 821 2 2 101 26 78 79 642 822 2 2 101 26 234 673 235 823 2 2 101 26 240 672 241 824 2 2 101 26 17 244 670 825 2 2 101 26 249 671 250 826 2 2 101 26 357 665 469 827 2 2 101 26 324 746 539 828 2 2 101 26 347 599 770 829 2 2 101 26 441 649 523 830 2 2 101 26 322 520 763 831 2 2 101 26 372 476 728 832 2 2 101 26 224 736 521 833 2 2 101 26 348 768 596 834 2 2 101 26 286 574 501 835 2 2 101 26 287 500 573 836 2 2 101 26 243 487 564 837 2 2 101 26 251 565 488 838 2 2 101 26 233 485 568 839 2 2 101 26 242 567 487 840 2 2 101 26 252 488 569 841 2 2 101 26 232 570 485 842 2 2 101 26 353 640 522 843 2 2 101 26 227 668 228 844 2 2 101 26 355 772 612 845 2 2 101 26 290 772 494 846 2 2 101 26 388 494 772 847 2 2 101 26 256 692 257 848 2 2 101 26 375 681 689 849 2 2 101 26 345 634 521 850 2 2 101 26 424 627 740 851 2 2 101 26 216 726 217 852 2 2 101 26 272 725 273 853 2 2 101 26 306 649 539 854 2 2 101 26 438 741 692 855 2 2 101 26 213 515 618 856 2 2 101 26 26 514 641 857 2 2 101 26 78 642 515 858 2 2 101 26 396 539 649 859 2 2 101 26 282 767 674 860 2 2 101 26 217 559 218 861 2 2 101 26 271 560 272 862 2 2 101 26 393 576 753 863 2 2 101 26 392 754 576 864 2 2 101 26 426 537 771 865 2 2 101 26 389 546 639 866 2 2 101 26 298 639 546 867 2 2 101 26 285 766 594 868 2 2 101 26 229 505 738 869 2 2 101 26 300 625 481 870 2 2 101 26 358 492 637 871 2 2 101 26 359 638 493 872 2 2 101 26 316 471 695 873 2 2 101 26 316 696 471 874 2 2 101 26 317 472 699 875 2 2 101 26 317 698 472 876 2 2 101 26 326 473 758 877 2 2 101 26 327 757 474 878 2 2 101 26 355 631 496 879 2 2 101 26 81 637 492 880 2 2 101 26 23 493 638 881 2 2 101 26 423 724 512 882 2 2 101 26 299 482 633 883 2 2 101 26 220 506 660 884 2 2 101 26 390 714 586 885 2 2 101 26 366 660 506 886 2 2 101 26 346 632 621 887 2 2 101 26 258 741 476 888 2 2 101 26 418 621 632 889 2 2 101 26 340 515 642 890 2 2 101 26 339 641 514 891 2 2 101 26 292 531 636 892 2 2 101 26 359 758 473 893 2 2 101 26 358 474 757 894 2 2 101 26 336 562 747 895 2 2 101 26 376 636 531 896 2 2 101 26 255 737 513 897 2 2 101 26 291 643 520 898 2 2 101 26 268 491 619 899 2 2 101 26 397 645 562 900 2 2 101 26 380 520 643 901 2 2 101 26 297 562 645 902 2 2 101 26 358 573 500 903 2 2 101 26 359 501 574 904 2 2 101 26 333 524 669 905 2 2 101 26 21 473 715 906 2 2 101 26 83 716 474 907 2 2 101 26 411 539 746 908 2 2 101 26 360 654 477 909 2 2 101 26 361 478 655 910 2 2 101 26 362 656 479 911 2 2 101 26 363 480 657 912 2 2 101 26 409 617 615 913 2 2 101 26 344 615 617 914 2 2 101 26 388 628 577 915 2 2 101 26 279 577 628 916 2 2 101 26 408 614 616 917 2 2 101 26 343 616 614 918 2 2 101 26 372 676 476 919 2 2 101 26 360 477 670 920 2 2 101 26 361 671 478 921 2 2 101 26 400 591 519 922 2 2 101 26 362 479 673 923 2 2 101 26 363 672 480 924 2 2 101 26 407 629 612 925 2 2 101 26 355 612 629 926 2 2 101 26 368 679 477 927 2 2 101 26 369 478 680 928 2 2 101 26 370 677 479 929 2 2 101 26 371 480 678 930 2 2 101 26 332 667 525 931 2 2 101 26 438 476 741 932 2 2 101 26 413 502 651 933 2 2 101 26 375 491 773 934 2 2 101 26 414 650 503 935 2 2 101 26 262 666 263 936 2 2 101 26 377 697 760 937 2 2 101 26 397 561 645 938 2 2 101 26 364 645 561 939 2 2 101 26 267 773 491 940 2 2 101 26 388 496 628 941 2 2 101 26 415 628 496 942 2 2 101 26 318 730 485 943 2 2 101 26 318 485 729 944 2 2 101 26 319 733 487 945 2 2 101 26 320 488 734 946 2 2 101 26 319 487 732 947 2 2 101 26 320 731 488 948 2 2 101 26 18 20 755 949 2 2 101 26 15 756 84 950 2 2 101 26 322 763 489 951 2 2 101 26 226 658 227 952 2 2 101 26 365 639 705 953 2 2 101 26 340 618 515 954 2 2 101 26 293 700 685 955 2 2 101 26 294 686 701 956 2 2 101 26 380 763 520 957 2 2 101 26 325 759 490 958 2 2 101 26 389 639 552 959 2 2 101 26 18 755 214 960 2 2 101 26 15 275 756 961 2 2 101 26 365 552 639 962 2 2 101 26 339 514 589 963 2 2 101 26 293 685 549 964 2 2 101 26 294 550 686 965 2 2 101 26 385 543 768 966 2 2 101 26 330 687 494 967 2 2 101 26 81 82 637 968 2 2 101 26 22 23 638 969 2 2 101 26 386 770 544 970 2 2 101 26 375 689 687 971 2 2 101 26 307 536 688 972 2 2 101 26 391 688 536 973 2 2 101 26 364 704 645 974 2 2 101 26 439 743 690 975 2 2 101 26 356 646 519 976 2 2 101 26 263 675 264 977 2 2 101 26 266 773 267 978 2 2 101 26 257 741 258 979 2 2 101 26 330 494 748 980 2 2 101 26 302 554 659 981 2 2 101 26 378 659 554 982 2 2 101 26 301 708 566 983 2 2 101 26 298 533 661 984 2 2 101 26 297 653 527 985 2 2 101 26 362 703 656 986 2 2 101 26 426 504 683 987 2 2 101 26 363 657 702 988 2 2 101 26 360 700 654 989 2 2 101 26 361 655 701 990 2 2 101 26 383 604 601 991 2 2 101 26 365 705 609 992 2 2 101 26 303 571 713 993 2 2 101 26 364 610 704 994 2 2 101 26 351 601 604 995 2 2 101 26 362 605 703 996 2 2 101 26 363 702 608 997 2 2 101 26 360 606 700 998 2 2 101 26 361 701 607 999 2 2 101 26 277 614 647 1000 2 2 101 26 220 660 221 1001 2 2 101 26 289 613 511 1002 2 2 101 26 408 647 614 1003 2 2 101 26 245 679 584 1004 2 2 101 26 248 585 680 1005 2 2 101 26 239 581 678 1006 2 2 101 26 236 677 580 1007 2 2 101 26 277 647 632 1008 2 2 101 26 418 632 647 1009 2 2 101 26 356 519 591 1010 2 2 101 26 374 588 643 1011 2 2 101 26 234 568 673 1012 2 2 101 26 241 672 567 1013 2 2 101 26 380 643 588 1014 2 2 101 26 244 564 670 1015 2 2 101 26 250 671 565 1016 2 2 101 26 323 495 752 1017 2 2 101 26 345 518 771 1018 2 2 101 26 402 532 590 1019 2 2 101 26 282 540 767 1020 2 2 101 26 394 503 650 1021 2 2 101 26 400 519 765 1022 2 2 101 26 395 651 502 1023 2 2 101 26 187 765 519 1024 2 2 101 26 356 591 742 1025 2 2 101 26 413 651 711 1026 2 2 101 26 421 674 767 1027 2 2 101 26 210 211 693 1028 2 2 101 26 180 181 697 1029 2 2 101 26 205 206 706 1030 2 2 101 26 357 590 532 1031 2 2 101 26 182 183 707 1032 2 2 101 26 357 532 665 1033 2 2 101 26 279 662 615 1034 2 2 101 26 409 615 662 1035 2 2 101 26 192 193 727 1036 2 2 101 26 437 535 689 1037 2 2 101 26 387 690 743 1038 2 2 101 26 16 196 735 1039 2 2 101 26 254 737 255 1040 2 2 101 26 197 198 739 1041 2 2 101 26 229 738 230 1042 2 2 101 26 373 636 587 1043 2 2 101 26 376 587 636 1044 2 2 101 26 200 201 762 1045 2 2 101 26 187 188 765 1046 2 2 101 26 298 661 705 1047 2 2 101 26 402 762 532 1048 2 2 101 26 376 531 769 1049 2 2 101 26 201 532 762 1050 2 2 101 26 279 628 662 1051 2 2 101 26 415 662 628 1052 2 2 101 26 380 706 763 1053 2 2 101 26 345 771 537 1054 2 2 101 26 349 595 594 1055 2 2 101 26 288 624 572 1056 2 2 101 26 404 594 595 1057 2 2 101 26 228 668 505 1058 2 2 101 26 439 690 524 1059 2 2 101 26 445 572 624 1060 2 2 101 26 306 523 649 1061 2 2 101 26 494 577 748 1062 2 2 101 26 385 768 653 1063 2 2 101 26 302 659 534 1064 2 2 101 26 417 534 659 1065 2 2 101 26 422 663 523 1066 2 2 101 26 297 704 653 1067 2 2 101 26 331 523 663 1068 2 2 101 26 440 525 688 1069 2 2 101 26 321 760 769 1070 2 2 101 26 486 769 760 1071 2 2 101 26 357 714 590 1072 2 2 101 26 386 661 770 1073 2 2 101 26 469 553 712 1074 2 2 101 26 468 626 563 1075 2 2 101 26 444 526 684 1076 2 2 101 26 461 751 541 1077 2 2 101 26 456 592 597 1078 2 2 101 26 457 598 593 1079 2 2 101 26 223 545 736 1080 2 2 101 26 460 558 747 1081 2 2 101 26 348 527 653 1082 2 2 101 26 256 513 692 1083 2 2 101 26 367 545 694 1084 2 2 101 26 289 563 626 1085 2 2 101 26 430 761 506 1086 2 2 101 26 341 597 592 1087 2 2 101 26 342 593 598 1088 2 2 101 26 254 561 737 1089 2 2 101 26 397 737 561 1090 2 2 101 26 278 711 651 1091 2 2 101 26 347 661 533 1092 2 2 101 26 372 728 511 1093 2 2 101 26 323 752 538 1094 2 2 101 26 379 538 752 1095 2 2 101 26 230 738 552 1096 2 2 101 26 330 748 627 1097 2 2 101 26 389 552 738 1098 2 2 101 26 425 627 748 1099 2 2 101 26 379 752 693 1100 2 2 101 26 378 664 659 1101 2 2 101 26 417 659 664 1102 2 2 101 26 360 670 564 1103 2 2 101 26 361 565 671 1104 2 2 101 26 363 567 672 1105 2 2 101 26 362 673 568 1106 2 2 101 26 264 675 528 1107 2 2 101 26 295 717 656 1108 2 2 101 26 296 657 718 1109 2 2 101 26 293 719 654 1110 2 2 101 26 294 655 720 1111 2 2 101 26 304 684 526 1112 2 2 101 26 307 688 525 1113 2 2 101 26 305 524 690 1114 2 2 101 26 370 580 677 1115 2 2 101 26 371 678 581 1116 2 2 101 26 368 584 679 1117 2 2 101 26 369 680 585 1118 2 2 101 26 380 588 706 1119 2 2 101 26 205 706 588 1120 2 2 101 26 360 564 733 1121 2 2 101 26 361 734 565 1122 2 2 101 26 363 732 567 1123 2 2 101 26 362 568 730 1124 2 2 101 26 364 569 731 1125 2 2 101 26 288 771 518 1126 2 2 101 26 285 594 721 1127 2 2 101 26 454 710 551 1128 2 2 101 26 365 729 570 1129 2 2 101 26 284 723 596 1130 2 2 101 26 404 721 594 1131 2 2 101 26 283 599 722 1132 2 2 101 26 405 596 723 1133 2 2 101 26 406 722 599 1134 2 2 101 26 461 682 540 1135 2 2 101 26 367 521 736 1136 2 2 101 26 290 689 535 1137 2 2 101 26 381 685 700 1138 2 2 101 26 382 701 686 1139 2 2 101 26 308 652 761 1140 2 2 101 26 296 600 702 1141 2 2 101 26 354 620 767 1142 2 2 101 26 384 702 600 1143 2 2 101 26 295 703 601 1144 2 2 101 26 383 601 703 1145 2 2 101 26 421 767 620 1146 2 2 101 26 453 694 545 1147 2 2 101 26 367 694 635 1148 2 2 101 26 386 705 661 1149 2 2 101 26 385 653 704 1150 2 2 101 26 350 549 685 1151 2 2 101 26 352 686 550 1152 2 2 101 26 360 733 606 1153 2 2 101 26 361 607 734 1154 2 2 101 26 362 730 605 1155 2 2 101 26 363 608 732 1156 2 2 101 26 364 731 610 1157 2 2 101 26 365 609 729 1158 2 2 101 26 321 548 760 1159 2 2 101 26 377 760 548 1160 2 2 101 26 368 578 695 1161 2 2 101 26 369 696 579 1162 2 2 101 26 370 583 699 1163 2 2 101 26 371 698 582 1164 2 2 101 26 348 713 571 1165 2 2 101 26 370 699 580 1166 2 2 101 26 371 581 698 1167 2 2 101 26 368 695 584 1168 2 2 101 26 369 585 696 1169 2 2 101 26 347 566 708 1170 2 2 101 26 335 551 710 1171 2 2 101 26 374 712 553 1172 2 2 101 26 376 707 587 1173 2 2 101 26 183 587 707 1174 2 2 101 26 382 686 603 1175 2 2 101 26 381 602 685 1176 2 2 101 26 352 603 686 1177 2 2 101 26 350 685 602 1178 2 2 101 26 298 705 639 1179 2 2 101 26 367 736 545 1180 2 2 101 26 334 541 751 1181 2 2 101 26 217 726 559 1182 2 2 101 26 272 560 725 1183 2 2 101 26 422 721 663 1184 2 2 101 26 404 663 721 1185 2 2 101 26 471 584 695 1186 2 2 101 26 471 696 585 1187 2 2 101 26 472 580 699 1188 2 2 101 26 472 698 581 1189 2 2 101 26 354 767 540 1190 2 2 101 26 266 681 773 1191 2 2 101 26 358 757 573 1192 2 2 101 26 359 574 758 1193 2 2 101 26 487 733 564 1194 2 2 101 26 488 565 734 1195 2 2 101 26 485 730 568 1196 2 2 101 26 487 567 732 1197 2 2 101 26 488 731 569 1198 2 2 101 26 485 570 729 1199 2 2 101 26 420 667 723 1200 2 2 101 26 405 723 667 1201 2 2 101 26 316 695 578 1202 2 2 101 26 316 579 696 1203 2 2 101 26 317 582 698 1204 2 2 101 26 317 699 583 1205 2 2 101 26 410 648 652 1206 2 2 101 26 348 596 713 1207 2 2 101 26 366 652 648 1208 2 2 101 26 297 645 704 1209 2 2 101 26 336 747 558 1210 2 2 101 26 419 722 669 1211 2 2 101 26 406 669 722 1212 2 2 101 26 347 708 599 1213 2 2 101 26 425 748 577 1214 2 2 101 26 368 719 578 1215 2 2 101 26 369 579 720 1216 2 2 101 26 370 717 583 1217 2 2 101 26 371 582 718 1218 2 2 101 26 295 656 703 1219 2 2 101 26 296 702 657 1220 2 2 101 26 293 654 700 1221 2 2 101 26 294 701 655 1222 2 2 101 26 381 700 606 1223 2 2 101 26 382 607 701 1224 2 2 101 26 384 608 702 1225 2 2 101 26 383 703 605 1226 2 2 101 26 385 704 610 1227 2 2 101 26 386 609 705 1228 2 2 101 26 303 590 714 1229 2 2 101 26 406 599 708 1230 2 2 101 26 405 713 596 1231 2 2 101 26 310 635 694 1232 2 2 101 26 318 605 730 1233 2 2 101 26 318 729 609 1234 2 2 101 26 319 606 733 1235 2 2 101 26 320 734 607 1236 2 2 101 26 319 732 608 1237 2 2 101 26 320 610 731 1238 2 2 101 26 412 691 746 1239 2 2 101 26 301 742 591 1240 2 2 101 26 349 594 766 1241 2 2 101 26 349 766 600 1242 2 2 101 26 384 600 766 1243 2 2 101 26 284 596 768 1244 2 2 101 26 283 770 599 1245 2 2 101 26 424 740 644 1246 2 2 101 26 431 644 740 1247 2 2 101 26 290 612 772 1248 2 2 101 26 411 746 691 1249 2 2 101 26 375 773 681 1250 2 2 100 28 880 1085 916 1251 2 2 100 28 1085 799 916 1252 2 2 100 28 1036 796 943 1253 2 2 100 28 944 960 1203 1254 2 2 100 28 1203 960 804 1255 2 2 100 28 909 1036 943 1256 2 2 100 28 5 119 1189 1257 2 2 100 28 899 1106 197 1258 2 2 100 28 95 3 1177 1259 2 2 100 28 798 1051 883 1260 2 2 100 28 12 935 134 1261 2 2 100 28 1043 1171 838 1262 2 2 100 28 826 1024 895 1263 2 2 100 28 800 1059 901 1264 2 2 100 28 1219 812 924 1265 2 2 100 28 788 1000 929 1266 2 2 100 28 800 899 1059 1267 2 2 100 28 774 916 1056 1268 2 2 100 28 209 931 937 1269 2 2 100 28 122 1037 1046 1270 2 2 100 28 798 874 1102 1271 2 2 100 28 1106 198 197 1272 2 2 100 28 191 990 927 1273 2 2 100 28 1133 900 195 1274 2 2 100 28 183 938 974 1275 2 2 100 28 85 86 948 1276 2 2 100 28 789 1018 892 1277 2 2 100 28 184 974 1064 1278 2 2 100 28 819 884 1002 1279 2 2 100 28 814 927 990 1280 2 2 100 28 1089 888 992 1281 2 2 100 28 783 924 1048 1282 2 2 100 28 5 908 118 1283 2 2 100 28 3 96 911 1284 2 2 100 28 782 982 968 1285 2 2 100 28 802 937 931 1286 2 2 100 28 789 892 949 1287 2 2 100 28 852 960 944 1288 2 2 100 28 821 887 994 1289 2 2 100 28 835 912 1134 1290 2 2 100 28 781 947 988 1291 2 2 100 28 130 1049 891 1292 2 2 100 28 1150 888 1089 1293 2 2 100 28 858 923 897 1294 2 2 100 28 783 993 924 1295 2 2 100 28 795 905 1015 1296 2 2 100 28 795 1015 907 1297 2 2 100 28 118 908 961 1298 2 2 100 28 95 906 963 1299 2 2 100 28 806 957 1001 1300 2 2 100 28 801 900 1133 1301 2 2 100 28 1157 892 187 1302 2 2 100 28 826 1004 1061 1303 2 2 100 28 194 1133 195 1304 2 2 100 28 112 1070 918 1305 2 2 100 28 819 985 884 1306 2 2 100 28 871 1056 916 1307 2 2 100 28 826 890 1004 1308 2 2 100 28 832 859 1091 1309 2 2 100 28 957 1193 1095 1310 2 2 100 28 838 1171 917 1311 2 2 100 28 112 113 1070 1312 2 2 100 28 777 1004 890 1313 2 2 100 28 858 897 1124 1314 2 2 100 28 1189 119 903 1315 2 2 100 28 798 1102 1051 1316 2 2 100 28 798 1124 897 1317 2 2 100 28 130 891 1073 1318 2 2 100 28 801 1133 919 1319 2 2 100 28 864 974 938 1320 2 2 100 28 821 998 887 1321 2 2 100 28 804 960 1051 1322 2 2 100 28 780 909 943 1323 2 2 100 28 71 930 967 1324 2 2 100 28 780 978 1006 1325 2 2 100 28 958 1153 1086 1326 2 2 100 28 926 812 1219 1327 2 2 100 28 827 1062 1014 1328 2 2 100 28 916 1075 1144 1329 2 2 100 28 205 896 1081 1330 2 2 100 28 906 95 1177 1331 2 2 100 28 805 915 934 1332 2 2 100 28 832 1018 859 1333 2 2 100 28 782 1001 982 1334 2 2 100 28 776 989 860 1335 2 2 100 28 827 1014 894 1336 2 2 100 28 839 1106 899 1337 2 2 100 28 790 882 971 1338 2 2 100 28 873 982 1001 1339 2 2 100 28 777 894 1014 1340 2 2 100 28 798 973 874 1341 2 2 100 28 207 1081 977 1342 2 2 100 28 815 1000 876 1343 2 2 100 28 86 1011 948 1344 2 2 100 28 819 878 1009 1345 2 2 100 28 117 118 961 1346 2 2 100 28 848 1015 905 1347 2 2 100 28 832 892 1018 1348 2 2 100 28 803 997 909 1349 2 2 100 28 849 907 1015 1350 2 2 100 28 1023 1052 820 1351 2 2 100 28 94 95 963 1352 2 2 100 28 872 1006 978 1353 2 2 100 28 126 127 921 1354 2 2 100 28 829 958 1086 1355 2 2 100 28 912 959 1134 1356 2 2 100 28 924 1115 1048 1357 2 2 100 28 96 969 911 1358 2 2 100 28 70 71 967 1359 2 2 100 28 775 1079 960 1360 2 2 100 28 107 108 952 1361 2 2 100 28 105 106 953 1362 2 2 100 28 134 935 1010 1363 2 2 100 28 209 937 210 1364 2 2 100 28 803 1006 958 1365 2 2 100 28 779 1026 893 1366 2 2 100 28 860 929 1000 1367 2 2 100 28 792 888 1020 1368 2 2 100 28 821 879 1012 1369 2 2 100 28 778 895 1024 1370 2 2 100 28 184 1064 185 1371 2 2 100 28 112 918 1027 1372 2 2 100 28 817 921 972 1373 2 2 100 28 864 968 982 1374 2 2 100 28 186 1157 187 1375 2 2 100 28 839 925 1106 1376 2 2 100 28 883 1051 960 1377 2 2 100 28 817 972 1111 1378 2 2 100 28 776 860 1034 1379 2 2 100 28 3 911 970 1380 2 2 100 28 795 867 983 1381 2 2 100 28 795 984 867 1382 2 2 100 28 790 980 882 1383 2 2 100 28 880 916 1144 1384 2 2 100 28 854 920 1069 1385 2 2 100 28 822 873 1095 1386 2 2 100 28 900 1052 1023 1387 2 2 100 28 121 122 1046 1388 2 2 100 28 1209 948 830 1389 2 2 100 28 774 1075 916 1390 2 2 100 28 793 1022 1021 1391 2 2 100 28 849 1014 1062 1392 2 2 100 28 848 1061 1004 1393 2 2 100 28 823 939 986 1394 2 2 100 28 824 987 940 1395 2 2 100 28 883 960 1079 1396 2 2 100 28 850 924 993 1397 2 2 100 28 874 964 1102 1398 2 2 100 28 119 966 903 1399 2 2 100 28 800 901 1060 1400 2 2 100 28 873 1001 957 1401 2 2 100 28 862 988 947 1402 2 2 100 28 826 962 1024 1403 2 2 100 28 800 1098 899 1404 2 2 100 28 1153 791 1086 1405 2 2 100 28 825 872 978 1406 2 2 100 28 826 1067 890 1407 2 2 100 28 31 936 1125 1408 2 2 100 28 839 899 1098 1409 2 2 100 28 826 1061 962 1410 2 2 100 28 842 1053 922 1411 2 2 100 28 819 1002 878 1412 2 2 100 28 784 1122 1031 1413 2 2 100 28 822 982 873 1414 2 2 100 28 815 876 967 1415 2 2 100 28 33 1039 910 1416 2 2 100 28 113 114 1070 1417 2 2 100 28 838 1021 1022 1418 2 2 100 28 798 897 973 1419 2 2 100 28 821 994 879 1420 2 2 100 28 789 1095 1193 1421 2 2 100 28 6 1172 1011 1422 2 2 100 28 781 1226 886 1423 2 2 100 28 935 1213 1030 1424 2 2 100 28 777 890 1007 1425 2 2 100 28 794 945 1083 1426 2 2 100 28 114 1035 1070 1427 2 2 100 28 801 1052 900 1428 2 2 100 28 5 981 908 1429 2 2 100 28 825 1003 872 1430 2 2 100 28 208 977 1154 1431 2 2 100 28 922 1053 1194 1432 2 2 100 28 107 952 1135 1433 2 2 100 28 106 1135 953 1434 2 2 100 28 863 1031 1122 1435 2 2 100 28 792 992 888 1436 2 2 100 28 842 902 1053 1437 2 2 100 28 820 1060 901 1438 2 2 100 28 875 1046 1037 1439 2 2 100 28 778 1072 895 1440 2 2 100 28 183 974 184 1441 2 2 100 28 779 893 1065 1442 2 2 100 28 823 1149 983 1443 2 2 100 28 824 984 1151 1444 2 2 100 28 818 1214 898 1445 2 2 100 28 205 1081 206 1446 2 2 100 28 873 957 1095 1447 2 2 100 28 827 894 1080 1448 2 2 100 28 30 31 1125 1449 2 2 100 28 834 935 1030 1450 2 2 100 28 101 1028 1171 1451 2 2 100 28 802 904 1116 1452 2 2 100 28 800 1060 890 1453 2 2 100 28 98 99 933 1454 2 2 100 28 788 929 1201 1455 2 2 100 28 89 1025 1194 1456 2 2 100 28 805 1047 915 1457 2 2 100 28 777 1007 894 1458 2 2 100 28 114 115 1035 1459 2 2 100 28 798 883 1124 1460 2 2 100 28 795 983 905 1461 2 2 100 28 795 907 984 1462 2 2 100 28 822 1064 974 1463 2 2 100 28 815 967 930 1464 2 2 100 28 826 895 1067 1465 2 2 100 28 96 97 969 1466 2 2 100 28 797 891 1162 1467 2 2 100 28 836 919 1071 1468 2 2 100 28 1039 1209 830 1469 2 2 100 28 207 977 208 1470 2 2 100 28 923 1096 1138 1471 2 2 100 28 811 971 1088 1472 2 2 100 28 133 1010 1215 1473 2 2 100 28 902 1172 1053 1474 2 2 100 28 820 901 1195 1475 2 2 100 28 6 1011 86 1476 2 2 100 28 793 1021 1170 1477 2 2 100 28 846 986 939 1478 2 2 100 28 847 940 987 1479 2 2 100 28 779 942 991 1480 2 2 100 28 206 1081 207 1481 2 2 100 28 825 1081 1003 1482 2 2 100 28 843 1115 928 1483 2 2 100 28 785 1061 905 1484 2 2 100 28 829 1086 1047 1485 2 2 100 28 836 1071 927 1486 2 2 100 28 786 907 1062 1487 2 2 100 28 109 110 939 1488 2 2 100 28 103 104 940 1489 2 2 100 28 857 991 942 1490 2 2 100 28 827 965 1062 1491 2 2 100 28 816 934 915 1492 2 2 100 28 123 124 955 1493 2 2 100 28 12 1206 935 1494 2 2 100 28 832 1077 892 1495 2 2 100 28 133 134 1010 1496 2 2 100 28 818 1063 1134 1497 2 2 100 28 803 909 1006 1498 2 2 100 28 956 1088 1143 1499 2 2 100 28 866 1111 972 1500 2 2 100 28 797 1111 1199 1501 2 2 100 28 842 1163 902 1502 2 2 100 28 812 1084 925 1503 2 2 100 28 802 1116 1202 1504 2 2 100 28 127 972 921 1505 2 2 100 28 872 958 1006 1506 2 2 100 28 905 983 1149 1507 2 2 100 28 784 1119 1033 1508 2 2 100 28 894 1007 1052 1509 2 2 100 28 907 1151 984 1510 2 2 100 28 863 1017 1031 1511 2 2 100 28 33 910 1117 1512 2 2 100 28 797 946 1111 1513 2 2 100 28 800 890 1067 1514 2 2 100 28 91 92 1040 1515 2 2 100 28 807 1096 923 1516 2 2 100 28 830 1011 902 1517 2 2 100 28 820 1052 1007 1518 2 2 100 28 896 1003 1081 1519 2 2 100 28 886 1118 1050 1520 2 2 100 28 111 112 1027 1521 2 2 100 28 101 102 1028 1522 2 2 100 28 200 926 201 1523 2 2 100 28 812 926 1084 1524 2 2 100 28 89 90 1025 1525 2 2 100 28 208 931 209 1526 2 2 100 28 877 1083 945 1527 2 2 100 28 797 1199 891 1528 2 2 100 28 783 884 1180 1529 2 2 100 28 818 943 1063 1530 2 2 100 28 801 919 1092 1531 2 2 100 28 797 989 946 1532 2 2 100 28 880 1144 1017 1533 2 2 100 28 848 905 1061 1534 2 2 100 28 131 132 1103 1535 2 2 100 28 849 1062 907 1536 2 2 100 28 818 898 1116 1537 2 2 100 28 780 943 1087 1538 2 2 100 28 131 1103 1049 1539 2 2 100 28 823 1041 939 1540 2 2 100 28 793 1050 1118 1541 2 2 100 28 824 940 1042 1542 2 2 100 28 876 913 1169 1543 2 2 100 28 181 1138 1096 1544 2 2 100 28 854 1069 1201 1545 2 2 100 28 807 938 1096 1546 2 2 100 28 836 1092 919 1547 2 2 100 28 191 927 192 1548 2 2 100 28 190 990 191 1549 2 2 100 28 825 977 1081 1550 2 2 100 28 832 976 1077 1551 2 2 100 28 790 994 1093 1552 2 2 100 28 801 894 1052 1553 2 2 100 28 129 130 1073 1554 2 2 100 28 130 131 1049 1555 2 2 100 28 877 1066 1083 1556 2 2 100 28 182 938 183 1557 2 2 100 28 115 1187 1035 1558 2 2 100 28 880 914 1085 1559 2 2 100 28 818 959 1214 1560 2 2 100 28 797 1162 929 1561 2 2 100 28 853 1033 1119 1562 2 2 100 28 71 1221 930 1563 2 2 100 28 877 937 1066 1564 2 2 100 28 841 1085 914 1565 2 2 100 28 909 997 1036 1566 2 2 100 28 887 1093 994 1567 2 2 100 28 801 1080 894 1568 2 2 100 28 33 34 1039 1569 2 2 100 28 889 1170 1021 1570 2 2 100 28 781 886 1074 1571 2 2 100 28 950 1139 1184 1572 2 2 100 28 898 1056 1202 1573 2 2 100 28 951 1186 1140 1574 2 2 100 28 812 925 1101 1575 2 2 100 28 816 993 934 1576 2 2 100 28 199 1106 925 1577 2 2 100 28 839 1101 925 1578 2 2 100 28 188 1077 976 1579 2 2 100 28 882 1088 971 1580 2 2 100 28 193 919 1133 1581 2 2 100 28 834 920 1010 1582 2 2 100 28 781 1013 1226 1583 2 2 100 28 898 1202 1116 1584 2 2 100 28 814 1097 927 1585 2 2 100 28 792 1020 1076 1586 2 2 100 28 783 1048 884 1587 2 2 100 28 780 1006 909 1588 2 2 100 28 75 76 954 1589 2 2 100 28 805 908 1047 1590 2 2 100 28 831 912 1031 1591 2 2 100 28 813 995 996 1592 2 2 100 28 126 921 979 1593 2 2 100 28 836 927 1097 1594 2 2 100 28 915 1047 1086 1595 2 2 100 28 809 1139 950 1596 2 2 100 28 810 951 1140 1597 2 2 100 28 119 120 966 1598 2 2 100 28 880 1166 914 1599 2 2 100 28 912 1075 959 1600 2 2 100 28 852 1143 1088 1601 2 2 100 28 802 931 1141 1602 2 2 100 28 803 903 997 1603 2 2 100 28 902 1011 1172 1604 2 2 100 28 785 905 1149 1605 2 2 100 28 846 1127 950 1606 2 2 100 28 847 951 1128 1607 2 2 100 28 786 1151 907 1608 2 2 100 28 922 1194 1025 1609 2 2 100 28 805 934 1180 1610 2 2 100 28 812 928 1115 1611 2 2 100 28 808 1013 1005 1612 2 2 100 28 196 1195 901 1613 2 2 100 28 830 902 1044 1614 2 2 100 28 844 1040 1055 1615 2 2 100 28 879 1055 1040 1616 2 2 100 28 908 981 1047 1617 2 2 100 28 851 1083 1066 1618 2 2 100 28 792 1002 1114 1619 2 2 100 28 802 1066 937 1620 2 2 100 28 917 1171 1028 1621 2 2 100 28 68 1169 1030 1622 2 2 100 28 195 900 1023 1623 2 2 100 28 884 1114 1002 1624 2 2 100 28 802 1141 904 1625 2 2 100 28 820 1007 1060 1626 2 2 100 28 1056 851 1202 1627 2 2 100 28 196 901 1059 1628 2 2 100 28 28 29 964 1629 2 2 100 28 846 950 986 1630 2 2 100 28 781 1074 947 1631 2 2 100 28 847 987 951 1632 2 2 100 28 203 1148 932 1633 2 2 100 28 778 1089 928 1634 2 2 100 28 902 1163 1044 1635 2 2 100 28 92 1191 1040 1636 2 2 100 28 876 1169 1094 1637 2 2 100 28 858 1159 923 1638 2 2 100 28 127 128 972 1639 2 2 100 28 840 1130 969 1640 2 2 100 28 931 855 1141 1641 2 2 100 28 67 68 1030 1642 2 2 100 28 838 917 1178 1643 2 2 100 28 124 975 955 1644 2 2 100 28 843 928 1089 1645 2 2 100 28 880 1017 1166 1646 2 2 100 28 867 952 983 1647 2 2 100 28 867 1135 952 1648 2 2 100 28 867 984 953 1649 2 2 100 28 867 953 1135 1650 2 2 100 28 862 1158 976 1651 2 2 100 28 852 1112 960 1652 2 2 100 28 890 1060 1007 1653 2 2 100 28 199 925 1084 1654 2 2 100 28 819 1212 961 1655 2 2 100 28 835 1204 912 1656 2 2 100 28 857 947 1074 1657 2 2 100 28 856 1058 999 1658 2 2 100 28 903 966 997 1659 2 2 100 28 807 1208 938 1660 2 2 100 28 783 934 993 1661 2 2 100 28 920 1215 1010 1662 2 2 100 28 197 1059 899 1663 2 2 100 28 208 1154 931 1664 2 2 100 28 14 1090 77 1665 2 2 100 28 821 1218 963 1666 2 2 100 28 981 1189 1032 1667 2 2 100 28 823 983 952 1668 2 2 100 28 824 953 984 1669 2 2 100 28 831 1031 1017 1670 2 2 100 28 807 923 1159 1671 2 2 100 28 864 938 1208 1672 2 2 100 28 831 1017 1144 1673 2 2 100 28 99 1043 933 1674 2 2 100 28 187 892 1077 1675 2 2 100 28 124 125 975 1676 2 2 100 28 785 986 950 1677 2 2 100 28 832 1091 988 1678 2 2 100 28 786 951 987 1679 2 2 100 28 71 72 1221 1680 2 2 100 28 819 1009 1212 1681 2 2 100 28 108 1041 952 1682 2 2 100 28 105 953 1042 1683 2 2 100 28 821 1012 1218 1684 2 2 100 28 98 933 1045 1685 2 2 100 28 845 997 966 1686 2 2 100 28 831 1144 1075 1687 2 2 100 28 74 1175 1110 1688 2 2 100 28 815 1220 1000 1689 2 2 100 28 787 944 1113 1690 2 2 100 28 895 1072 1098 1691 2 2 100 28 193 1071 919 1692 2 2 100 28 812 1115 924 1693 2 2 100 28 809 950 1127 1694 2 2 100 28 810 1128 951 1695 2 2 100 28 796 1107 1216 1696 2 2 100 28 815 930 1156 1697 2 2 100 28 805 1180 985 1698 2 2 100 28 861 1117 910 1699 2 2 100 28 185 1064 1157 1700 2 2 100 28 828 970 1131 1701 2 2 100 28 970 1019 1177 1702 2 2 100 28 74 75 1175 1703 2 2 100 28 1198 932 850 1704 2 2 100 28 861 910 1113 1705 2 2 100 28 868 1207 954 1706 2 2 100 28 881 1123 1100 1707 2 2 100 28 828 1019 970 1708 2 2 100 28 796 1216 996 1709 2 2 100 28 205 1123 896 1710 2 2 100 28 842 922 1155 1711 2 2 100 28 837 1076 1020 1712 2 2 100 28 878 1076 1035 1713 2 2 100 28 198 1106 199 1714 2 2 100 28 778 928 1072 1715 2 2 100 28 841 914 1156 1716 2 2 100 28 832 988 976 1717 2 2 100 28 806 906 1019 1718 2 2 100 28 822 1095 949 1719 2 2 100 28 861 1203 936 1720 2 2 100 28 829 981 1032 1721 2 2 100 28 837 1035 1076 1722 2 2 100 28 19 27 1126 1723 2 2 100 28 831 1075 912 1724 2 2 100 28 868 954 1173 1725 2 2 100 28 803 1032 903 1726 2 2 100 28 193 1133 194 1727 2 2 100 28 189 976 1158 1728 2 2 100 28 212 1176 945 1729 2 2 100 28 849 1057 1014 1730 2 2 100 28 796 1063 943 1731 2 2 100 28 913 1030 1169 1732 2 2 100 28 185 1157 186 1733 2 2 100 28 779 1065 942 1734 2 2 100 28 881 1016 1142 1735 2 2 100 28 212 945 1078 1736 2 2 100 28 843 1048 1115 1737 2 2 100 28 182 1096 938 1738 2 2 100 28 834 1069 920 1739 2 2 100 28 123 955 1037 1740 2 2 100 28 806 1019 957 1741 2 2 100 28 775 941 1079 1742 2 2 100 28 866 1199 1111 1743 2 2 100 28 181 1096 182 1744 2 2 100 28 803 958 1032 1745 2 2 100 28 857 1050 991 1746 2 2 100 28 789 1038 1018 1747 2 2 100 28 805 1120 908 1748 2 2 100 28 861 1113 944 1749 2 2 100 28 109 939 1041 1750 2 2 100 28 104 1042 940 1751 2 2 100 28 991 1050 1170 1752 2 2 100 28 816 915 1016 1753 2 2 100 28 861 936 1068 1754 2 2 100 28 820 1195 1023 1755 2 2 100 28 776 1034 1166 1756 2 2 100 28 817 946 1122 1757 2 2 100 28 202 1148 203 1758 2 2 100 28 862 976 988 1759 2 2 100 28 125 126 979 1760 2 2 100 28 828 957 1019 1761 2 2 100 28 1154 855 931 1762 2 2 100 28 840 1029 1130 1763 2 2 100 28 85 948 1211 1764 2 2 100 28 839 1098 1072 1765 2 2 100 28 799 1164 916 1766 2 2 100 28 884 985 1180 1767 2 2 100 28 839 1072 928 1768 2 2 100 28 14 213 1090 1769 2 2 100 28 774 959 1075 1770 2 2 100 28 823 952 1041 1771 2 2 100 28 893 1080 1092 1772 2 2 100 28 824 1042 953 1773 2 2 100 28 922 1136 1155 1774 2 2 100 28 791 1003 1142 1775 2 2 100 28 789 949 1095 1776 2 2 100 28 775 1082 941 1777 2 2 100 28 72 73 1008 1778 2 2 100 28 811 1088 956 1779 2 2 100 28 850 1219 924 1780 2 2 100 28 875 1107 1046 1781 2 2 100 28 780 1087 1108 1782 2 2 100 28 840 1045 933 1783 2 2 100 28 775 960 1112 1784 2 2 100 28 200 1084 926 1785 2 2 100 28 188 976 189 1786 2 2 100 28 806 1129 906 1787 2 2 100 28 835 996 995 1788 2 2 100 28 999 1058 1165 1789 2 2 100 28 94 963 1218 1790 2 2 100 28 31 1068 936 1791 2 2 100 28 854 1103 920 1792 2 2 100 28 19 1126 178 1793 2 2 100 28 117 961 1212 1794 2 2 100 28 784 995 1119 1795 2 2 100 28 942 1097 1200 1796 2 2 100 28 908 1120 961 1797 2 2 100 28 829 1032 958 1798 2 2 100 28 893 1092 1065 1799 2 2 100 28 844 1055 971 1800 2 2 100 28 32 33 1117 1801 2 2 100 28 778 1150 1089 1802 2 2 100 28 817 1111 946 1803 2 2 100 28 869 1024 962 1804 2 2 100 28 828 1131 1005 1805 2 2 100 28 833 941 1082 1806 2 2 100 28 869 1184 1139 1807 2 2 100 28 806 1001 998 1808 2 2 100 28 870 1140 1186 1809 2 2 100 28 881 1182 1016 1810 2 2 100 28 830 948 1011 1811 2 2 100 28 859 1005 1013 1812 2 2 100 28 125 979 975 1813 2 2 100 28 870 965 1026 1814 2 2 100 28 809 1020 1139 1815 2 2 100 28 848 1004 1057 1816 2 2 100 28 810 1140 1021 1817 2 2 100 28 954 1207 1058 1818 2 2 100 28 782 968 1054 1819 2 2 100 28 844 971 1136 1820 2 2 100 28 840 933 1022 1821 2 2 100 28 859 1018 1038 1822 2 2 100 28 110 1104 939 1823 2 2 100 28 103 940 1105 1824 2 2 100 28 841 1156 930 1825 2 2 100 28 874 1183 964 1826 2 2 100 28 906 1129 963 1827 2 2 100 28 179 1109 973 1828 2 2 100 28 784 1033 1122 1829 2 2 100 28 120 121 1132 1830 2 2 100 28 932 1148 850 1831 2 2 100 28 1190 179 973 1832 2 2 100 28 204 1100 1123 1833 2 2 100 28 834 1010 935 1834 2 2 100 28 833 1054 968 1835 2 2 100 28 942 1065 1097 1836 2 2 100 28 787 1143 944 1837 2 2 100 28 199 1084 200 1838 2 2 100 28 914 1166 1034 1839 2 2 100 28 838 1022 933 1840 2 2 100 28 918 1179 1127 1841 2 2 100 28 917 1128 1178 1842 2 2 100 28 791 1142 1016 1843 2 2 100 28 108 109 1041 1844 2 2 100 28 104 105 1042 1845 2 2 100 28 804 936 1203 1846 2 2 100 28 794 1207 945 1847 2 2 100 28 785 1184 962 1848 2 2 100 28 76 1173 954 1849 2 2 100 28 838 933 1043 1850 2 2 100 28 815 1156 1034 1851 2 2 100 28 841 930 1221 1852 2 2 100 28 128 1168 972 1853 2 2 100 28 785 962 1061 1854 2 2 100 28 192 927 1071 1855 2 2 100 28 835 1063 996 1856 2 2 100 28 801 1092 1080 1857 2 2 100 28 839 928 1101 1858 2 2 100 28 843 1114 1048 1859 2 2 100 28 857 942 1200 1860 2 2 100 28 876 1161 913 1861 2 2 100 28 895 1098 1067 1862 2 2 100 28 122 123 1037 1863 2 2 100 28 786 965 1186 1864 2 2 100 28 786 1062 965 1865 2 2 100 28 1097 814 1200 1866 2 2 100 28 796 996 1063 1867 2 2 100 28 833 980 1093 1868 2 2 100 28 871 916 1164 1869 2 2 100 28 843 992 1114 1870 2 2 100 28 845 1046 1107 1871 2 2 100 28 877 1147 937 1872 2 2 100 28 28 964 1183 1873 2 2 100 28 808 911 1130 1874 2 2 100 28 904 1141 1108 1875 2 2 100 28 856 954 1058 1876 2 2 100 28 857 1200 947 1877 2 2 100 28 97 1045 969 1878 2 2 100 28 811 1155 1136 1879 2 2 100 28 811 1136 971 1880 2 2 100 28 889 1152 991 1881 2 2 100 28 898 1214 1056 1882 2 2 100 28 833 1121 941 1883 2 2 100 28 192 1071 193 1884 2 2 100 28 836 1065 1092 1885 2 2 100 28 842 1155 956 1886 2 2 100 28 187 1077 188 1887 2 2 100 28 879 994 1055 1888 2 2 100 28 808 1131 911 1889 2 2 100 28 777 1014 1057 1890 2 2 100 28 1211 948 35 1891 2 2 100 28 865 1051 1102 1892 2 2 100 28 115 116 1187 1893 2 2 100 28 869 962 1184 1894 2 2 100 28 797 929 1160 1895 2 2 100 28 866 972 1168 1896 2 2 100 28 904 1108 1087 1897 2 2 100 28 856 1175 954 1898 2 2 100 28 201 926 1099 1899 2 2 100 28 16 195 1023 1900 2 2 100 28 75 954 1175 1901 2 2 100 28 16 1195 196 1902 2 2 100 28 92 93 1191 1903 2 2 100 28 790 971 1055 1904 2 2 100 28 858 1079 941 1905 2 2 100 28 842 956 1163 1906 2 2 100 28 897 923 1138 1907 2 2 100 28 888 1139 1020 1908 2 2 100 28 868 945 1207 1909 2 2 100 28 889 1021 1140 1910 2 2 100 28 777 1057 1004 1911 2 2 100 28 817 1197 921 1912 2 2 100 28 870 1186 965 1913 2 2 100 28 822 949 1064 1914 2 2 100 28 833 1093 1054 1915 2 2 100 28 116 1009 1187 1916 2 2 100 28 896 1142 1003 1917 2 2 100 28 863 1122 946 1918 2 2 100 28 201 1099 202 1919 2 2 100 28 121 1046 1132 1920 2 2 100 28 783 1180 934 1921 2 2 100 28 99 100 1043 1922 2 2 100 28 878 1002 1076 1923 2 2 100 28 110 111 1104 1924 2 2 100 28 102 103 1105 1925 2 2 100 28 819 961 1120 1926 2 2 100 28 885 1008 1205 1927 2 2 100 28 31 32 1068 1928 2 2 100 28 809 1127 1179 1929 2 2 100 28 93 1012 1191 1930 2 2 100 28 810 1178 1128 1931 2 2 100 28 853 975 979 1932 2 2 100 28 829 1047 981 1933 2 2 100 28 800 1067 1098 1934 2 2 100 28 196 1059 197 1935 2 2 100 28 3 970 1177 1936 2 2 100 28 852 944 1143 1937 2 2 100 28 845 966 1132 1938 2 2 100 28 821 963 1129 1939 2 2 100 28 812 1101 928 1940 2 2 100 28 73 1205 1008 1941 2 2 100 28 29 1224 964 1942 2 2 100 28 828 1005 1038 1943 2 2 100 28 784 1031 1204 1944 2 2 100 28 868 1078 945 1945 2 2 100 28 836 1097 1065 1946 2 2 100 28 774 1056 1214 1947 2 2 100 28 865 964 1224 1948 2 2 100 28 833 968 1121 1949 2 2 100 28 827 1225 965 1950 2 2 100 28 846 939 1104 1951 2 2 100 28 847 1105 940 1952 2 2 100 28 87 88 1053 1953 2 2 100 28 876 1094 967 1954 2 2 100 28 811 956 1155 1955 2 2 100 28 886 1029 1118 1956 2 2 100 28 845 1036 997 1957 2 2 100 28 203 932 1100 1958 2 2 100 28 828 1193 957 1959 2 2 100 28 918 1070 1179 1960 2 2 100 28 837 1070 1035 1961 2 2 100 28 869 1150 1024 1962 2 2 100 28 97 98 1045 1963 2 2 100 28 870 1026 1152 1964 2 2 100 28 861 944 1203 1965 2 2 100 28 818 1087 943 1966 2 2 100 28 893 1026 1225 1967 2 2 100 28 67 1030 1213 1968 2 2 100 28 35 948 1209 1969 2 2 100 28 841 1008 1196 1970 2 2 100 28 785 1149 986 1971 2 2 100 28 69 70 1094 1972 2 2 100 28 786 987 1151 1973 2 2 100 28 819 1120 985 1974 2 2 100 28 816 1016 1182 1975 2 2 100 28 840 969 1045 1976 2 2 100 28 885 1196 1008 1977 2 2 100 28 855 1108 1141 1978 2 2 100 28 914 1034 1156 1979 2 2 100 28 787 1113 1188 1980 2 2 100 28 2 1211 35 1981 2 2 100 28 814 947 1200 1982 2 2 100 28 120 1132 966 1983 2 2 100 28 781 988 1091 1984 2 2 100 28 1154 1210 855 1985 2 2 100 28 4 66 1206 1986 2 2 100 28 849 1015 1057 1987 2 2 100 28 69 1094 1169 1988 2 2 100 28 111 1027 1104 1989 2 2 100 28 102 1105 1028 1990 2 2 100 28 787 1163 956 1991 2 2 100 28 70 967 1094 1992 2 2 100 28 865 1102 964 1993 2 2 100 28 804 1167 936 1994 2 2 100 28 779 991 1152 1995 2 2 100 28 887 1192 1054 1996 2 2 100 28 837 1179 1070 1997 2 2 100 28 821 1129 998 1998 2 2 100 28 897 1138 1190 1999 2 2 100 28 854 1049 1103 2000 2 2 100 28 906 1177 1019 2001 2 2 100 28 210 937 1147 2002 2 2 100 28 965 1225 1026 2003 2 2 100 28 66 67 1213 2004 2 2 100 28 4 1206 12 2005 2 2 100 28 818 1134 959 2006 2 2 100 28 946 989 1145 2007 2 2 100 28 882 1112 1088 2008 2 2 100 28 73 74 1205 2009 2 2 100 28 885 1110 1137 2010 2 2 100 28 799 1196 1137 2011 2 2 100 28 76 77 1173 2012 2 2 100 28 816 1198 993 2013 2 2 100 28 204 1123 205 2014 2 2 100 28 68 69 1169 2015 2 2 100 28 863 946 1145 2016 2 2 100 28 860 1160 929 2017 2 2 100 28 852 1088 1112 2018 2 2 100 28 813 996 1216 2019 2 2 100 28 787 1188 1044 2020 2 2 100 28 790 1055 994 2021 2 2 100 28 864 1222 974 2022 2 2 100 28 116 1212 1009 2023 2 2 100 28 116 117 1212 2024 2 2 100 28 29 30 1224 2025 2 2 100 28 978 1108 1210 2026 2 2 100 28 93 94 1218 2027 2 2 100 28 822 974 1222 2028 2 2 100 28 93 1218 1012 2029 2 2 100 28 211 1176 212 2030 2 2 100 28 5 1189 981 2031 2 2 100 28 830 1188 1039 2032 2 2 100 28 912 1204 1031 2033 2 2 100 28 776 1166 1017 2034 2 2 100 28 813 1119 995 2035 2 2 100 28 788 1161 1000 2036 2 2 100 28 790 1093 980 2037 2 2 100 28 825 1210 977 2038 2 2 100 28 841 1221 1008 2039 2 2 100 28 180 1138 181 2040 2 2 100 28 180 1190 1138 2041 2 2 100 28 787 956 1143 2042 2 2 100 28 818 1116 1087 2043 2 2 100 28 921 1197 979 2044 2 2 100 28 903 1032 1189 2045 2 2 100 28 792 1076 1002 2046 2 2 100 28 848 1057 1015 2047 2 2 100 28 797 1160 989 2048 2 2 100 28 212 1078 213 2049 2 2 100 28 778 1024 1150 2050 2 2 100 28 776 1017 1145 2051 2 2 100 28 34 35 1209 2052 2 2 100 28 779 1152 1026 2053 2 2 100 28 780 1108 978 2054 2 2 100 28 87 1053 1172 2055 2 2 100 28 858 941 1159 2056 2 2 100 28 911 969 1130 2057 2 2 100 28 834 1030 1217 2058 2 2 100 28 977 1210 1154 2059 2 2 100 28 854 1162 1049 2060 2 2 100 28 889 991 1170 2061 2 2 100 28 863 1145 1017 2062 2 2 100 28 6 87 1172 2063 2 2 100 28 878 1035 1187 2064 2 2 100 28 774 1214 959 2065 2 2 100 28 814 1227 947 2066 2 2 100 28 885 1137 1196 2067 2 2 100 28 100 1171 1043 2068 2 2 100 28 785 950 1184 2069 2 2 100 28 210 1147 211 2070 2 2 100 28 203 1100 204 2071 2 2 100 28 786 1186 951 2072 2 2 100 28 844 1025 1146 2073 2 2 100 28 27 28 1183 2074 2 2 100 28 814 990 1227 2075 2 2 100 28 883 1079 1124 2076 2 2 100 28 911 1131 970 2077 2 2 100 28 792 1114 992 2078 2 2 100 28 892 1157 949 2079 2 2 100 28 855 1210 1108 2080 2 2 100 28 835 995 1204 2081 2 2 100 28 178 1109 179 2082 2 2 100 28 853 1181 975 2083 2 2 100 28 808 1005 1131 2084 2 2 100 28 782 1054 1192 2085 2 2 100 28 877 945 1176 2086 2 2 100 28 88 1194 1053 2087 2 2 100 28 179 1190 180 2088 2 2 100 28 922 1025 1136 2089 2 2 100 28 189 1158 190 2090 2 2 100 28 799 1137 999 2091 2 2 100 28 884 1048 1114 2092 2 2 100 28 788 1217 1161 2093 2 2 100 28 874 973 1109 2094 2 2 100 28 859 1038 1005 2095 2 2 100 28 805 985 1120 2096 2 2 100 28 202 1099 1148 2097 2 2 100 28 845 1107 1036 2098 2 2 100 28 106 107 1135 2099 2 2 100 28 860 989 1160 2100 2 2 100 28 808 1226 1013 2101 2 2 100 28 915 1086 1016 2102 2 2 100 28 891 1049 1162 2103 2 2 100 28 910 1039 1188 2104 2 2 100 28 862 1227 990 2105 2 2 100 28 876 1000 1161 2106 2 2 100 28 862 947 1227 2107 2 2 100 28 856 1137 1110 2108 2 2 100 28 799 999 1164 2109 2 2 100 28 128 129 1168 2110 2 2 100 28 879 1040 1191 2111 2 2 100 28 817 1033 1197 2112 2 2 100 28 806 998 1129 2113 2 2 100 28 853 979 1197 2114 2 2 100 28 788 1201 1069 2115 2 2 100 28 941 1121 1159 2116 2 2 100 28 833 1082 980 2117 2 2 100 28 840 1118 1029 2118 2 2 100 28 132 133 1215 2119 2 2 100 28 844 1146 1040 2120 2 2 100 28 872 1153 958 2121 2 2 100 28 850 993 1198 2122 2 2 100 28 918 1127 1027 2123 2 2 100 28 917 1028 1128 2124 2 2 100 28 872 1003 1153 2125 2 2 100 28 90 91 1146 2126 2 2 100 28 791 1016 1086 2127 2 2 100 28 789 1193 1038 2128 2 2 100 28 862 990 1158 2129 2 2 100 28 823 986 1149 2130 2 2 100 28 813 955 1181 2131 2 2 100 28 824 1151 987 2132 2 2 100 28 794 1083 1174 2133 2 2 100 28 90 1146 1025 2134 2 2 100 28 100 101 1171 2135 2 2 100 28 817 1122 1033 2136 2 2 100 28 843 1089 992 2137 2 2 100 28 875 1216 1107 2138 2 2 100 28 858 1124 1079 2139 2 2 100 28 871 1174 1056 2140 2 2 100 28 882 980 1223 2141 2 2 100 28 886 1050 1074 2142 2 2 100 28 88 89 1194 2143 2 2 100 28 887 1054 1093 2144 2 2 100 28 791 1153 1003 2145 2 2 100 28 784 1204 995 2146 2 2 100 28 904 1087 1116 2147 2 2 100 28 913 1217 1030 2148 2 2 100 28 840 1022 1118 2149 2 2 100 28 788 1069 1217 2150 2 2 100 28 796 1036 1107 2151 2 2 100 28 838 1178 1021 2152 2 2 100 28 837 1020 1179 2153 2 2 100 28 813 1185 955 2154 2 2 100 28 72 1008 1221 2155 2 2 100 28 859 1013 1091 2156 2 2 100 28 856 999 1137 2157 2 2 100 28 2 85 1211 2158 2 2 100 28 794 1174 1165 2159 2 2 100 28 864 982 1222 2160 2 2 100 28 793 1118 1022 2161 2 2 100 28 34 1209 1039 2162 2 2 100 28 793 1170 1050 2163 2 2 100 28 846 1104 1027 2164 2 2 100 28 847 1028 1105 2165 2 2 100 28 968 1208 1121 2166 2 2 100 28 781 1091 1013 2167 2 2 100 28 809 1179 1020 2168 2 2 100 28 810 1021 1178 2169 2 2 100 28 888 1150 1139 2170 2 2 100 28 949 1157 1064 2171 2 2 100 28 846 1027 1127 2172 2 2 100 28 847 1128 1028 2173 2 2 100 28 889 1140 1152 2174 2 2 100 28 807 1159 1121 2175 2 2 100 28 808 1130 1029 2176 2 2 100 28 808 1029 1226 2177 2 2 100 28 881 1142 1123 2178 2 2 100 28 998 1001 1192 2179 2 2 100 28 861 1068 1117 2180 2 2 100 28 91 1040 1146 2181 2 2 100 28 877 1176 1147 2182 2 2 100 28 878 1187 1009 2183 2 2 100 28 896 1123 1142 2184 2 2 100 28 844 1136 1025 2185 2 2 100 28 869 1139 1150 2186 2 2 100 28 897 1190 973 2187 2 2 100 28 879 1191 1012 2188 2 2 100 28 870 1152 1140 2189 2 2 100 28 864 1208 968 2190 2 2 100 28 853 1119 1181 2191 2 2 100 28 794 1165 1058 2192 2 2 100 28 776 1145 989 2193 2 2 100 28 871 999 1165 2194 2 2 100 28 871 1164 999 2195 2 2 100 28 860 1220 1034 2196 2 2 100 28 881 1100 1182 2197 2 2 100 28 868 1090 1078 2198 2 2 100 28 910 1188 1113 2199 2 2 100 28 32 1117 1068 2200 2 2 100 28 857 1074 1050 2201 2 2 100 28 853 1197 1033 2202 2 2 100 28 851 1056 1174 2203 2 2 100 28 190 1158 990 2204 2 2 100 28 955 975 1181 2205 2 2 100 28 16 1023 1195 2206 2 2 100 28 211 1147 1176 2207 2 2 100 28 804 1051 1167 2208 2 2 100 28 30 1125 1224 2209 2 2 100 28 955 1185 1037 2210 2 2 100 28 850 1148 1099 2211 2 2 100 28 825 978 1210 2212 2 2 100 28 891 1199 1073 2213 2 2 100 28 835 1134 1063 2214 2 2 100 28 932 1182 1100 2215 2 2 100 28 845 1132 1046 2216 2 2 100 28 874 1109 1126 2217 2 2 100 28 865 1167 1051 2218 2 2 100 28 887 998 1192 2219 2 2 100 28 913 1161 1217 2220 2 2 100 28 799 1085 1196 2221 2 2 100 28 815 1034 1220 2222 2 2 100 28 827 1080 1225 2223 2 2 100 28 886 1226 1029 2224 2 2 100 28 802 1202 1066 2225 2 2 100 28 854 1201 1162 2226 2 2 100 28 830 1044 1188 2227 2 2 100 28 828 1038 1193 2228 2 2 100 28 807 1121 1208 2229 2 2 100 28 775 1223 1082 2230 2 2 100 28 866 1073 1199 2231 2 2 100 28 875 1037 1185 2232 2 2 100 28 822 1222 982 2233 2 2 100 28 851 1066 1202 2234 2 2 100 28 860 1000 1220 2235 2 2 100 28 129 1073 1168 2236 2 2 100 28 782 1192 1001 2237 2 2 100 28 893 1225 1080 2238 2 2 100 28 868 1173 1090 2239 2 2 100 28 77 1090 1173 2240 2 2 100 28 816 1182 1198 2241 2 2 100 28 851 1174 1083 2242 2 2 100 28 213 1078 1090 2243 2 2 100 28 66 1213 1206 2244 2 2 100 28 841 1196 1085 2245 2 2 100 28 775 1112 1223 2246 2 2 100 28 787 1044 1163 2247 2 2 100 28 866 1168 1073 2248 2 2 100 28 27 1183 1126 2249 2 2 100 28 813 1216 1185 2250 2 2 100 28 850 1099 1219 2251 2 2 100 28 874 1126 1183 2252 2 2 100 28 834 1217 1069 2253 2 2 100 28 178 1126 1109 2254 2 2 100 28 936 1167 1125 2255 2 2 100 28 935 1206 1213 2256 2 2 100 28 929 1162 1201 2257 2 2 100 28 132 1215 1103 2258 2 2 100 28 980 1082 1223 2259 2 2 100 28 794 1058 1207 2260 2 2 100 28 885 1205 1110 2261 2 2 100 28 932 1198 1182 2262 2 2 100 28 926 1219 1099 2263 2 2 100 28 865 1125 1167 2264 2 2 100 28 871 1165 1174 2265 2 2 100 28 74 1110 1205 2266 2 2 100 28 813 1181 1119 2267 2 2 100 28 856 1110 1175 2268 2 2 100 28 920 1103 1215 2269 2 2 100 28 875 1185 1216 2270 2 2 100 28 882 1223 1112 2271 2 2 100 28 865 1224 1125 2272 2 2 104 30 1387 1514 1257 2273 2 2 104 30 171 172 1297 2274 2 2 104 30 176 177 1330 2275 2 2 104 30 1253 1321 1325 2276 2 2 104 30 1230 1325 1321 2277 2 2 104 30 1514 1287 1257 2278 2 2 104 30 1321 1367 1410 2279 2 2 104 30 1412 1247 1323 2280 2 2 104 30 1231 1346 1414 2281 2 2 104 30 1245 1388 1379 2282 2 2 104 30 1242 1286 1388 2283 2 2 104 30 1253 1367 1321 2284 2 2 104 30 1446 1247 1333 2285 2 2 104 30 1241 1299 1333 2286 2 2 104 30 1333 1247 1412 2287 2 2 104 30 1489 1417 1304 2288 2 2 104 30 176 1330 1375 2289 2 2 104 30 98 1383 1296 2290 2 2 104 30 120 1309 121 2291 2 2 104 30 1255 1284 1468 2292 2 2 104 30 1255 1359 1284 2293 2 2 104 30 1271 1460 1298 2294 2 2 104 30 1299 1446 1333 2295 2 2 104 30 1271 1408 1460 2296 2 2 104 30 1231 1394 1346 2297 2 2 104 30 131 1314 1432 2298 2 2 104 30 130 1314 131 2299 2 2 104 30 1275 1357 1334 2300 2 2 104 30 1278 1391 1310 2301 2 2 104 30 1246 1489 1304 2302 2 2 104 30 1283 1303 1472 2303 2 2 104 30 1257 1287 1364 2304 2 2 104 30 1250 1389 1294 2305 2 2 104 30 1346 1394 1463 2306 2 2 104 30 1252 1334 1357 2307 2 2 104 30 1276 1414 1346 2308 2 2 104 30 1286 1379 1388 2309 2 2 104 30 1258 1323 1315 2310 2 2 104 30 1239 1436 1292 2311 2 2 104 30 103 1295 1406 2312 2 2 104 30 172 1345 1297 2313 2 2 104 30 1253 1325 1305 2314 2 2 104 30 118 1384 1329 2315 2 2 104 30 1281 1392 1417 2316 2 2 104 30 88 1320 89 2317 2 2 104 30 127 1290 1424 2318 2 2 104 30 1276 1346 1328 2319 2 2 104 30 1250 1294 1372 2320 2 2 104 30 1270 1371 1445 2321 2 2 104 30 1299 1361 1462 2322 2 2 104 30 169 1308 1374 2323 2 2 104 30 141 1319 142 2324 2 2 104 30 1289 1385 1239 2325 2 2 104 30 1239 1292 1411 2326 2 2 104 30 1422 1289 1239 2327 2 2 104 30 1230 1299 1462 2328 2 2 104 30 1248 1305 1325 2329 2 2 104 30 1241 1472 1303 2330 2 2 104 30 1274 1306 1352 2331 2 2 104 30 1278 1457 1391 2332 2 2 104 30 117 1384 118 2333 2 2 104 30 1243 1297 1437 2334 2 2 104 30 142 1319 1390 2335 2 2 104 30 1281 1320 1392 2336 2 2 104 30 1242 1449 1286 2337 2 2 104 30 1266 1311 1419 2338 2 2 104 30 1267 1376 1341 2339 2 2 104 30 1243 1471 1326 2340 2 2 104 30 1241 1361 1299 2341 2 2 104 30 1250 1328 1346 2342 2 2 104 30 1268 1353 1308 2343 2 2 104 30 1257 1296 1368 2344 2 2 104 30 1300 1445 1371 2345 2 2 104 30 1267 1432 1314 2346 2 2 104 30 1232 1306 1368 2347 2 2 104 30 127 1399 1290 2348 2 2 104 30 1234 1355 1421 2349 2 2 104 30 1288 1472 1333 2350 2 2 104 30 175 1375 1460 2351 2 2 104 30 1257 1413 1296 2352 2 2 104 30 1243 1434 1297 2353 2 2 104 30 88 1425 1320 2354 2 2 104 30 1261 1309 1350 2355 2 2 104 30 149 1301 1440 2356 2 2 104 30 103 1398 1295 2357 2 2 104 30 1247 1315 1323 2358 2 2 104 30 171 1297 1377 2359 2 2 104 30 1446 1265 1339 2360 2 2 104 30 1256 1341 1376 2361 2 2 104 30 151 1318 152 2362 2 2 104 30 1242 1388 1458 2363 2 2 104 30 1378 1265 1446 2364 2 2 104 30 1257 1368 1306 2365 2 2 104 30 1244 1331 1370 2366 2 2 104 30 1273 1370 1331 2367 2 2 104 30 97 1383 98 2368 2 2 104 30 120 1430 1309 2369 2 2 104 30 1302 1326 1471 2370 2 2 104 30 1245 1379 1307 2371 2 2 104 30 1311 1450 1419 2372 2 2 104 30 130 1363 1314 2373 2 2 104 30 1347 1454 1448 2374 2 2 104 30 168 169 1374 2375 2 2 104 30 98 1296 1413 2376 2 2 104 30 91 1324 92 2377 2 2 104 30 1241 1333 1472 2378 2 2 104 30 1294 1389 1459 2379 2 2 104 30 149 1393 1301 2380 2 2 104 30 1244 1370 1332 2381 2 2 104 30 1272 1332 1370 2382 2 2 104 30 1258 1390 1319 2383 2 2 104 30 1246 1324 1489 2384 2 2 104 30 1230 1350 1325 2385 2 2 104 30 1240 1459 1389 2386 2 2 104 30 1230 1321 1378 2387 2 2 104 30 1283 1442 1303 2388 2 2 104 30 1248 1350 1309 2389 2 2 104 30 1259 1336 1322 2390 2 2 104 30 1232 1443 1357 2391 2 2 104 30 112 1348 1381 2392 2 2 104 30 1232 1368 1443 2393 2 2 104 30 1232 1352 1306 2394 2 2 104 30 1265 1378 1321 2395 2 2 104 30 102 1373 1398 2396 2 2 104 30 1268 1377 1297 2397 2 2 104 30 1262 1301 1393 2398 2 2 104 30 103 1406 104 2399 2 2 104 30 1234 1486 1355 2400 2 2 104 30 1233 1417 1392 2401 2 2 104 30 1260 1322 1336 2402 2 2 104 30 123 1303 1442 2403 2 2 104 30 1448 1454 1283 2404 2 2 104 30 1255 1351 1338 2405 2 2 104 30 1262 1477 1301 2406 2 2 104 30 109 1366 1354 2407 2 2 104 30 1324 1362 1489 2408 2 2 104 30 175 176 1375 2409 2 2 104 30 1263 1338 1351 2410 2 2 104 30 1271 1298 1421 2411 2 2 104 30 1254 1352 1327 2412 2 2 104 30 1242 1313 1371 2413 2 2 104 30 1259 1322 1386 2414 2 2 104 30 1251 1308 1353 2415 2 2 104 30 172 173 1345 2416 2 2 104 30 1269 1344 1435 2417 2 2 104 30 1298 1460 1375 2418 2 2 104 30 1230 1378 1299 2419 2 2 104 30 169 1466 1308 2420 2 2 104 30 1259 1461 1310 2421 2 2 104 30 1297 1345 1437 2422 2 2 104 30 1277 1463 1394 2423 2 2 104 30 1268 1308 1466 2424 2 2 104 30 91 1362 1324 2425 2 2 104 30 1344 1419 1435 2426 2 2 104 30 1250 1372 1328 2427 2 2 104 30 1247 1492 1315 2428 2 2 104 30 1276 1342 1414 2429 2 2 104 30 1267 1314 1395 2430 2 2 104 30 1253 1305 1403 2431 2 2 104 30 123 1420 1303 2432 2 2 104 30 121 1309 1380 2433 2 2 104 30 127 1424 128 2434 2 2 104 30 164 1322 165 2435 2 2 104 30 1232 1327 1352 2436 2 2 104 30 101 1373 102 2437 2 2 104 30 1248 1309 1430 2438 2 2 104 30 1251 1374 1308 2439 2 2 104 30 158 1426 1310 2440 2 2 104 30 1248 1384 1305 2441 2 2 104 30 135 1495 1494 2442 2 2 104 30 1261 1380 1309 2443 2 2 104 30 1271 1421 1355 2444 2 2 104 30 1242 1409 1313 2445 2 2 104 30 1246 1304 1481 2446 2 2 104 30 1237 1450 1332 2447 2 2 104 30 93 1334 94 2448 2 2 104 30 164 1386 1322 2449 2 2 104 30 1274 1439 1306 2450 2 2 104 30 138 1328 139 2451 2 2 104 30 1263 1381 1348 2452 2 2 104 30 1268 1297 1434 2453 2 2 104 30 1270 1500 1449 2454 2 2 104 30 1258 1319 1382 2455 2 2 104 30 1249 1313 1409 2456 2 2 104 30 1263 1441 1381 2457 2 2 104 30 1251 1494 1316 2458 2 2 104 30 119 1329 1430 2459 2 2 104 30 158 1310 1461 2460 2 2 104 30 105 1343 1510 2461 2 2 104 30 129 1363 130 2462 2 2 104 30 1241 1303 1464 2463 2 2 104 30 1258 1315 1390 2464 2 2 104 30 1274 1352 1479 2465 2 2 104 30 1248 1325 1350 2466 2 2 104 30 1266 1483 1311 2467 2 2 104 30 87 1425 88 2468 2 2 104 30 1246 1418 1324 2469 2 2 104 30 1302 1444 1394 2470 2 2 104 30 151 1465 1318 2471 2 2 104 30 1239 1338 1436 2472 2 2 104 30 1240 1445 1382 2473 2 2 104 30 90 1438 1362 2474 2 2 104 30 105 1510 106 2475 2 2 104 30 1294 1459 1482 2476 2 2 104 30 1245 1314 1502 2477 2 2 104 30 1264 1354 1366 2478 2 2 104 30 1251 1414 1342 2479 2 2 104 30 1236 1410 1367 2480 2 2 104 30 1267 1341 1432 2481 2 2 104 30 1238 1331 1447 2482 2 2 104 30 149 1440 150 2483 2 2 104 30 1229 1415 1412 2484 2 2 104 30 1275 1324 1418 2485 2 2 104 30 1259 1310 1391 2486 2 2 104 30 1257 1306 1387 2487 2 2 104 30 1247 1339 1492 2488 2 2 104 30 114 1335 115 2489 2 2 104 30 87 1369 1425 2490 2 2 104 30 1316 1494 1495 2491 2 2 104 30 1278 1310 1426 2492 2 2 104 30 1276 1328 1452 2493 2 2 104 30 119 1430 120 2494 2 2 104 30 1245 1395 1314 2495 2 2 104 30 1248 1430 1329 2496 2 2 104 30 1258 1401 1323 2497 2 2 104 30 1252 1383 1337 2498 2 2 104 30 1282 1332 1450 2499 2 2 104 30 145 1340 146 2500 2 2 104 30 1229 1323 1401 2501 2 2 104 30 136 1342 137 2502 2 2 104 30 132 1341 133 2503 2 2 104 30 1249 1347 1448 2504 2 2 104 30 143 1315 1492 2505 2 2 104 30 1280 1458 1388 2506 2 2 104 30 1300 1382 1445 2507 2 2 104 30 156 1312 1488 2508 2 2 104 30 1251 1316 1374 2509 2 2 104 30 1276 1452 1342 2510 2 2 104 30 154 1429 1311 2511 2 2 104 30 1268 1470 1353 2512 2 2 104 30 1277 1394 1444 2513 2 2 104 30 1245 1307 1395 2514 2 2 104 30 156 1400 1312 2515 2 2 104 30 154 1311 1483 2516 2 2 104 30 1279 1447 1331 2517 2 2 104 30 90 1362 91 2518 2 2 104 30 1291 1381 1441 2519 2 2 104 30 125 1347 126 2520 2 2 104 30 1259 1349 1461 2521 2 2 104 30 138 1452 1328 2522 2 2 104 30 1260 1392 1320 2523 2 2 104 30 1300 1467 1401 2524 2 2 104 30 1266 1312 1400 2525 2 2 104 30 1319 1482 1459 2526 2 2 104 30 1288 1412 1415 2527 2 2 104 30 1270 1445 1317 2528 2 2 104 30 1298 1375 1456 2529 2 2 104 30 1281 1362 1438 2530 2 2 104 30 111 1348 112 2531 2 2 104 30 1266 1407 1312 2532 2 2 104 30 1252 1484 1334 2533 2 2 104 30 1256 1375 1330 2534 2 2 104 30 143 1390 1315 2535 2 2 104 30 1270 1405 1500 2536 2 2 104 30 1255 1340 1359 2537 2 2 104 30 159 1349 160 2538 2 2 104 30 1282 1451 1332 2539 2 2 104 30 1236 1367 1441 2540 2 2 104 30 93 1427 1334 2541 2 2 104 30 141 1482 1319 2542 2 2 104 30 1244 1332 1451 2543 2 2 104 30 1252 1337 1484 2544 2 2 104 30 145 1359 1340 2545 2 2 104 30 1251 1342 1494 2546 2 2 104 30 1256 1456 1375 2547 2 2 104 30 147 1358 148 2548 2 2 104 30 1281 1438 1320 2549 2 2 104 30 109 1354 110 2550 2 2 104 30 1470 1268 1434 2551 2 2 104 30 1291 1441 1367 2552 2 2 104 30 152 1318 1404 2553 2 2 104 30 1253 1335 1367 2554 2 2 104 30 123 1442 124 2555 2 2 104 30 1270 1317 1405 2556 2 2 104 30 1229 1313 1415 2557 2 2 104 30 1238 1433 1331 2558 2 2 104 30 1238 1423 1433 2559 2 2 104 30 134 1478 1330 2560 2 2 104 30 1237 1332 1428 2561 2 2 104 30 108 1366 109 2562 2 2 104 30 1275 1334 1427 2563 2 2 104 30 1269 1398 1373 2564 2 2 104 30 1249 1415 1313 2565 2 2 104 30 1255 1468 1351 2566 2 2 104 30 1230 1462 1350 2567 2 2 104 30 1291 1367 1335 2568 2 2 104 30 1229 1412 1323 2569 2 2 104 30 89 1320 1438 2570 2 2 104 30 1240 1317 1445 2571 2 2 104 30 1269 1435 1398 2572 2 2 104 30 1314 1363 1502 2573 2 2 104 30 1229 1401 1467 2574 2 2 104 30 1273 1343 1370 2575 2 2 104 30 1272 1370 1343 2576 2 2 104 30 112 1381 113 2577 2 2 104 30 1252 1443 1383 2578 2 2 104 30 135 1494 136 2579 2 2 104 30 1246 1481 1327 2580 2 2 104 30 1253 1403 1335 2581 2 2 104 30 1240 1389 1317 2582 2 2 104 30 106 1402 107 2583 2 2 104 30 1295 1398 1435 2584 2 2 104 30 1286 1449 1500 2585 2 2 104 30 1229 1467 1313 2586 2 2 104 30 1239 1385 1338 2587 2 2 104 30 1275 1427 1324 2588 2 2 104 30 1291 1335 1504 2589 2 2 104 30 1248 1329 1384 2590 2 2 104 30 139 1328 1372 2591 2 2 104 30 114 1504 1335 2592 2 2 104 30 1296 1383 1443 2593 2 2 104 30 1264 1365 1360 2594 2 2 104 30 92 1324 1427 2595 2 2 104 30 139 1372 140 2596 2 2 104 30 126 1399 127 2597 2 2 104 30 144 1359 145 2598 2 2 104 30 116 1403 1505 2599 2 2 104 30 1260 1320 1425 2600 2 2 104 30 1305 1505 1403 2601 2 2 104 30 1274 1488 1485 2602 2 2 104 30 1265 1321 1410 2603 2 2 104 30 1231 1414 1353 2604 2 2 104 30 1326 1470 1434 2605 2 2 104 30 102 1398 103 2606 2 2 104 30 1319 1459 1382 2607 2 2 104 30 1259 1391 1336 2608 2 2 104 30 148 1393 149 2609 2 2 104 30 1268 1466 1377 2610 2 2 104 30 140 1372 1482 2611 2 2 104 30 146 1340 1497 2612 2 2 104 30 150 1465 151 2613 2 2 104 30 1293 1433 1423 2614 2 2 104 30 1311 1429 1450 2615 2 2 104 30 1235 1344 1396 2616 2 2 104 30 1255 1385 1340 2617 2 2 104 30 1260 1431 1322 2618 2 2 104 30 1273 1331 1433 2619 2 2 104 30 165 1431 166 2620 2 2 104 30 1282 1450 1429 2621 2 2 104 30 1289 1340 1385 2622 2 2 104 30 1256 1330 1478 2623 2 2 104 30 1262 1360 1365 2624 2 2 104 30 1243 1326 1434 2625 2 2 104 30 1289 1497 1340 2626 2 2 104 30 150 1440 1465 2627 2 2 104 30 1260 1336 1392 2628 2 2 104 30 122 1420 123 2629 2 2 104 30 1257 1364 1413 2630 2 2 104 30 10 143 1492 2631 2 2 104 30 1261 1420 1380 2632 2 2 104 30 133 1478 134 2633 2 2 104 30 1236 1468 1490 2634 2 2 104 30 177 1509 1330 2635 2 2 104 30 1300 1371 1467 2636 2 2 104 30 1231 1326 1394 2637 2 2 104 30 1294 1482 1372 2638 2 2 104 30 1233 1336 1391 2639 2 2 104 30 1233 1392 1336 2640 2 2 104 30 1249 1512 1347 2641 2 2 104 30 11 156 1488 2642 2 2 104 30 132 1432 1341 2643 2 2 104 30 1285 1355 1486 2644 2 2 104 30 99 1364 100 2645 2 2 104 30 1250 1463 1498 2646 2 2 104 30 1254 1356 1479 2647 2 2 104 30 1255 1338 1385 2648 2 2 104 30 166 1431 1369 2649 2 2 104 30 1254 1327 1481 2650 2 2 104 30 134 1330 1509 2651 2 2 104 30 95 1484 1337 2652 2 2 104 30 1272 1428 1332 2653 2 2 104 30 1261 1464 1420 2654 2 2 104 30 137 1342 1452 2655 2 2 104 30 1256 1478 1341 2656 2 2 104 30 1269 1396 1344 2657 2 2 104 30 1347 1512 1399 2658 2 2 104 30 1288 1333 1412 2659 2 2 104 30 142 1390 143 2660 2 2 104 30 121 1380 122 2661 2 2 104 30 157 1426 158 2662 2 2 104 30 1236 1490 1410 2663 2 2 104 30 1228 1501 1444 2664 2 2 104 30 170 171 1377 2665 2 2 104 30 1246 1327 1418 2666 2 2 104 30 1273 1433 1402 2667 2 2 104 30 1241 1464 1361 2668 2 2 104 30 1293 1402 1433 2669 2 2 104 30 165 1322 1431 2670 2 2 104 30 1263 1436 1338 2671 2 2 104 30 115 1403 116 2672 2 2 104 30 173 1408 1345 2673 2 2 104 30 148 1358 1393 2674 2 2 104 30 1302 1394 1326 2675 2 2 104 30 1237 1419 1450 2676 2 2 104 30 152 1404 153 2677 2 2 104 30 1233 1391 1457 2678 2 2 104 30 1231 1470 1326 2679 2 2 104 30 98 1413 99 2680 2 2 104 30 115 1335 1403 2681 2 2 104 30 1292 1348 1506 2682 2 2 104 30 1250 1498 1389 2683 2 2 104 30 1228 1405 1501 2684 2 2 104 30 111 1506 1348 2685 2 2 104 30 119 1496 1329 2686 2 2 104 30 124 1454 125 2687 2 2 104 30 1247 1446 1339 2688 2 2 104 30 126 1347 1399 2689 2 2 104 30 153 1404 1429 2690 2 2 104 30 1263 1348 1436 2691 2 2 104 30 1232 1493 1327 2692 2 2 104 30 1356 1416 1479 2693 2 2 104 30 1239 1411 1360 2694 2 2 104 30 1279 1331 1480 2695 2 2 104 30 1244 1480 1331 2696 2 2 104 30 7 1476 163 2697 2 2 104 30 1235 1407 1344 2698 2 2 104 30 10 1339 1397 2699 2 2 104 30 1287 1487 1364 2700 2 2 104 30 106 1510 1402 2701 2 2 104 30 1262 1393 1358 2702 2 2 104 30 1337 1383 1503 2703 2 2 104 30 1239 1360 1422 2704 2 2 104 30 1265 1397 1339 2705 2 2 104 30 1233 1457 1417 2706 2 2 104 30 1304 1417 1457 2707 2 2 104 30 1266 1400 1483 2708 2 2 104 30 1263 1351 1441 2709 2 2 104 30 158 1461 159 2710 2 2 104 30 155 1400 156 2711 2 2 104 30 1289 1422 1358 2712 2 2 104 30 94 1484 95 2713 2 2 104 30 1262 1358 1422 2714 2 2 104 30 1259 1386 1349 2715 2 2 104 30 1266 1344 1407 2716 2 2 104 30 1272 1406 1428 2717 2 2 104 30 1295 1428 1406 2718 2 2 104 30 100 1364 1487 2719 2 2 104 30 1234 1456 1376 2720 2 2 104 30 1238 1365 1423 2721 2 2 104 30 1264 1366 1423 2722 2 2 104 30 118 1329 1496 2723 2 2 104 30 1293 1423 1366 2724 2 2 104 30 1271 1345 1408 2725 2 2 104 30 1287 1396 1373 2726 2 2 104 30 1237 1428 1435 2727 2 2 104 30 1264 1411 1354 2728 2 2 104 30 1292 1354 1411 2729 2 2 104 30 1295 1435 1428 2730 2 2 104 30 169 170 1466 2731 2 2 104 30 1269 1373 1396 2732 2 2 104 30 1274 1416 1488 2733 2 2 104 30 1249 1409 1512 2734 2 2 104 30 1272 1343 1473 2735 2 2 104 30 1266 1419 1344 2736 2 2 104 30 163 1386 164 2737 2 2 104 30 1312 1485 1488 2738 2 2 104 30 1243 1355 1471 2739 2 2 104 30 1292 1506 1354 2740 2 2 104 30 153 1429 154 2741 2 2 104 30 110 1354 1506 2742 2 2 104 30 136 1494 1342 2743 2 2 104 30 147 1497 1358 2744 2 2 104 30 94 1334 1484 2745 2 2 104 30 1234 1421 1456 2746 2 2 104 30 124 1442 1454 2747 2 2 104 30 1284 1359 1491 2748 2 2 104 30 1289 1358 1497 2749 2 2 104 30 1261 1350 1462 2750 2 2 104 30 7 160 1476 2751 2 2 104 30 95 1337 1511 2752 2 2 104 30 1262 1365 1477 2753 2 2 104 30 1275 1493 1357 2754 2 2 104 30 1273 1510 1343 2755 2 2 104 30 144 1491 1359 2756 2 2 104 30 154 1483 155 2757 2 2 104 30 1251 1353 1414 2758 2 2 104 30 173 174 1408 2759 2 2 104 30 1264 1423 1365 2760 2 2 104 30 1282 1429 1404 2761 2 2 104 30 133 1341 1478 2762 2 2 104 30 1307 1486 1453 2763 2 2 104 30 10 1492 1339 2764 2 2 104 30 11 1416 1356 2765 2 2 104 30 1264 1360 1411 2766 2 2 104 30 128 1469 129 2767 2 2 104 30 1292 1436 1348 2768 2 2 104 30 1271 1437 1345 2769 2 2 104 30 131 1432 132 2770 2 2 104 30 1285 1471 1355 2771 2 2 104 30 1293 1366 1507 2772 2 2 104 30 1318 1480 1451 2773 2 2 104 30 108 1507 1366 2774 2 2 104 30 1260 1425 1369 2775 2 2 104 30 13 167 1495 2776 2 2 104 30 1271 1355 1437 2777 2 2 104 30 105 1473 1343 2778 2 2 104 30 1244 1451 1480 2779 2 2 104 30 6 166 1513 2780 2 2 104 30 1262 1422 1360 2781 2 2 104 30 1300 1401 1382 2782 2 2 104 30 13 1495 135 2783 2 2 104 30 104 1473 105 2784 2 2 104 30 137 1452 138 2785 2 2 104 30 1235 1485 1407 2786 2 2 104 30 1301 1447 1440 2787 2 2 104 30 99 1413 1364 2788 2 2 104 30 1242 1458 1409 2789 2 2 104 30 1279 1440 1447 2790 2 2 104 30 1234 1453 1486 2791 2 2 104 30 1278 1499 1356 2792 2 2 104 30 1236 1441 1351 2793 2 2 104 30 1278 1356 1455 2794 2 2 104 30 92 1427 93 2795 2 2 104 30 1290 1409 1458 2796 2 2 104 30 1307 1475 1486 2797 2 2 104 30 1258 1382 1401 2798 2 2 104 30 1243 1437 1355 2799 2 2 104 30 1254 1455 1356 2800 2 2 104 30 159 1461 1349 2801 2 2 104 30 140 1482 141 2802 2 2 104 30 1240 1382 1459 2803 2 2 104 30 89 1438 90 2804 2 2 104 30 1235 1439 1485 2805 2 2 104 30 1260 1369 1431 2806 2 2 104 30 1237 1435 1419 2807 2 2 104 30 122 1380 1420 2808 2 2 104 30 1337 1503 1511 2809 2 2 104 30 174 1460 1408 2810 2 2 104 30 10 1491 144 2811 2 2 104 30 11 1356 1499 2812 2 2 104 30 1236 1351 1468 2813 2 2 104 30 1249 1448 1415 2814 2 2 104 30 125 1454 1347 2815 2 2 104 30 5 1496 119 2816 2 2 104 30 1261 1462 1361 2817 2 2 104 30 1242 1371 1449 2818 2 2 104 30 1254 1479 1352 2819 2 2 104 30 3 1511 96 2820 2 2 104 30 1252 1357 1443 2821 2 2 104 30 1307 1379 1475 2822 2 2 104 30 1306 1439 1387 2823 2 2 104 30 160 1349 1476 2824 2 2 104 30 12 134 1509 2825 2 2 104 30 1267 1453 1376 2826 2 2 104 30 1291 1504 1381 2827 2 2 104 30 1275 1418 1493 2828 2 2 104 30 11 1499 157 2829 2 2 104 30 1285 1486 1475 2830 2 2 104 30 1307 1453 1395 2831 2 2 104 30 12 1509 177 2832 2 2 104 30 113 1381 1504 2833 2 2 104 30 96 1511 1503 2834 2 2 104 30 1318 1465 1480 2835 2 2 104 30 1279 1480 1465 2836 2 2 104 30 1303 1420 1464 2837 2 2 104 30 1250 1346 1463 2838 2 2 104 30 5 118 1496 2839 2 2 104 30 1296 1443 1368 2840 2 2 104 30 174 175 1460 2841 2 2 104 30 1267 1395 1453 2842 2 2 104 30 1270 1449 1371 2843 2 2 104 30 1232 1357 1493 2844 2 2 104 30 1231 1353 1470 2845 2 2 104 30 1299 1378 1446 2846 2 2 104 30 1349 1386 1476 2847 2 2 104 30 100 1487 101 2848 2 2 104 30 1288 1415 1448 2849 2 2 104 30 1238 1477 1365 2850 2 2 104 30 1261 1361 1464 2851 2 2 104 30 96 1503 97 2852 2 2 104 30 116 1505 117 2853 2 2 104 30 1281 1489 1362 2854 2 2 104 30 1256 1376 1456 2855 2 2 104 30 104 1406 1473 2856 2 2 104 30 1280 1424 1458 2857 2 2 104 30 113 1504 114 2858 2 2 104 30 129 1469 1363 2859 2 2 104 30 110 1506 111 2860 2 2 104 30 107 1507 108 2861 2 2 104 30 146 1497 147 2862 2 2 104 30 1235 1387 1439 2863 2 2 104 30 1272 1473 1406 2864 2 2 104 30 87 1513 1369 2865 2 2 104 30 1287 1373 1487 2866 2 2 104 30 1280 1502 1363 2867 2 2 104 30 128 1424 1469 2868 2 2 104 30 167 168 1508 2869 2 2 104 30 6 1513 87 2870 2 2 104 30 170 1377 1466 2871 2 2 104 30 1234 1376 1453 2872 2 2 104 30 3 95 1511 2873 2 2 104 30 1273 1402 1510 2874 2 2 104 30 1279 1465 1440 2875 2 2 104 30 1278 1426 1499 2876 2 2 104 30 101 1487 1373 2877 2 2 104 30 1284 1490 1468 2878 2 2 104 30 1280 1363 1469 2879 2 2 104 30 1228 1379 1500 2880 2 2 104 30 168 1374 1508 2881 2 2 104 30 1281 1417 1489 2882 2 2 104 30 1228 1475 1379 2883 2 2 104 30 1283 1454 1442 2884 2 2 104 30 1290 1458 1424 2885 2 2 104 30 1293 1507 1402 2886 2 2 104 30 107 1402 1507 2887 2 2 104 30 1316 1508 1374 2888 2 2 104 30 1318 1451 1404 2889 2 2 104 30 1327 1493 1418 2890 2 2 104 30 166 1369 1513 2891 2 2 104 30 1313 1467 1371 2892 2 2 104 30 1286 1500 1379 2893 2 2 104 30 1254 1481 1455 2894 2 2 104 30 1282 1404 1451 2895 2 2 104 30 163 1476 1386 2896 2 2 104 30 1304 1455 1481 2897 2 2 104 30 1298 1456 1421 2898 2 2 104 30 1280 1388 1502 2899 2 2 104 30 1290 1399 1512 2900 2 2 104 30 10 1397 1491 2901 2 2 104 30 117 1505 1384 2902 2 2 104 30 1317 1389 1498 2903 2 2 104 30 1278 1455 1457 2904 2 2 104 30 1245 1502 1388 2905 2 2 104 30 1274 1479 1416 2906 2 2 104 30 1304 1457 1455 2907 2 2 104 30 1228 1500 1405 2908 2 2 104 30 1265 1490 1397 2909 2 2 104 30 1283 1472 1448 2910 2 2 104 30 1285 1474 1471 2911 2 2 104 30 1280 1469 1424 2912 2 2 104 30 155 1483 1400 2913 2 2 104 30 97 1503 1383 2914 2 2 104 30 1305 1384 1505 2915 2 2 104 30 1288 1448 1472 2916 2 2 104 30 1235 1514 1387 2917 2 2 104 30 1302 1471 1474 2918 2 2 104 30 1284 1397 1490 2919 2 2 104 30 1235 1396 1514 2920 2 2 104 30 1290 1512 1409 2921 2 2 104 30 1312 1407 1485 2922 2 2 104 30 1284 1491 1397 2923 2 2 104 30 1265 1410 1490 2924 2 2 104 30 1317 1501 1405 2925 2 2 104 30 11 1488 1416 2926 2 2 104 30 1287 1514 1396 2927 2 2 104 30 1302 1474 1444 2928 2 2 104 30 1238 1447 1477 2929 2 2 104 30 1274 1485 1439 2930 2 2 104 30 157 1499 1426 2931 2 2 104 30 1228 1444 1474 2932 2 2 104 30 1301 1477 1447 2933 2 2 104 30 167 1508 1495 2934 2 2 104 30 1285 1475 1474 2935 2 2 104 30 1228 1474 1475 2936 2 2 104 30 1316 1495 1508 2937 2 2 104 30 1277 1444 1501 2938 2 2 104 30 1277 1498 1463 2939 2 2 104 30 1277 1501 1498 2940 2 2 104 30 1317 1498 1501 2941 2 2 103 32 164 165 1521 2942 2 2 103 32 1521 165 1517 2943 2 2 103 32 38 1518 1519 2944 2 2 103 32 37 38 1519 2945 2 2 103 32 165 1520 1517 2946 2 2 103 32 1517 1519 1518 2947 2 2 103 32 36 1519 1525 2948 2 2 103 32 39 1523 1518 2949 2 2 103 32 163 1521 1524 2950 2 2 103 32 166 1522 1520 2951 2 2 103 32 36 37 1519 2952 2 2 103 32 38 39 1518 2953 2 2 103 32 1515 1525 1519 2954 2 2 103 32 1516 1518 1523 2955 2 2 103 32 2 1525 85 2956 2 2 103 32 7 1524 161 2957 2 2 103 32 6 86 1522 2958 2 2 103 32 8 162 1523 2959 2 2 103 32 163 164 1521 2960 2 2 103 32 165 166 1520 2961 2 2 103 32 7 163 1524 2962 2 2 103 32 2 36 1525 2963 2 2 103 32 6 1522 166 2964 2 2 103 32 8 1523 39 2965 2 2 103 32 1516 1524 1521 2966 2 2 103 32 1515 1520 1522 2967 2 2 103 32 1515 1519 1520 2968 2 2 103 32 1517 1520 1519 2969 2 2 103 32 1517 1518 1521 2970 2 2 103 32 1516 1521 1518 2971 2 2 103 32 161 1526 162 2972 2 2 103 32 85 1527 86 2973 2 2 103 32 162 1526 1523 2974 2 2 103 32 86 1527 1522 2975 2 2 103 32 161 1524 1526 2976 2 2 103 32 85 1525 1527 2977 2 2 103 32 1515 1522 1527 2978 2 2 103 32 1516 1523 1526 2979 2 2 103 32 1515 1527 1525 2980 2 2 103 32 1516 1526 1524 2981 2 2 102 34 63 64 1528 2982 2 2 102 34 175 1528 176 2983 2 2 102 34 62 63 1535 2984 2 2 102 34 174 1535 175 2985 2 2 102 34 60 61 1529 2986 2 2 102 34 172 1529 173 2987 2 2 102 34 61 62 1537 2988 2 2 102 34 173 1537 174 2989 2 2 102 34 4 1538 65 2990 2 2 102 34 12 177 1538 2991 2 2 102 34 60 1529 1532 2992 2 2 102 34 172 1532 1529 2993 2 2 102 34 9 1536 13 2994 2 2 102 34 59 60 1532 2995 2 2 102 34 171 1532 172 2996 2 2 102 34 167 1536 1530 2997 2 2 102 34 55 1530 1536 2998 2 2 102 34 13 1536 167 2999 2 2 102 34 55 56 1530 3000 2 2 102 34 167 1530 168 3001 2 2 102 34 9 55 1536 3002 2 2 102 34 59 1532 1531 3003 2 2 102 34 171 1531 1532 3004 2 2 102 34 56 1533 1530 3005 2 2 102 34 168 1530 1533 3006 2 2 102 34 61 173 1529 3007 2 2 102 34 64 65 1539 3008 2 2 102 34 176 1539 177 3009 2 2 102 34 58 59 1531 3010 2 2 102 34 170 1531 171 3011 2 2 102 34 170 1534 1531 3012 2 2 102 34 58 1531 1534 3013 2 2 102 34 56 57 1533 3014 2 2 102 34 168 1533 169 3015 2 2 102 34 57 1534 1533 3016 2 2 102 34 169 1533 1534 3017 2 2 102 34 61 1537 173 3018 2 2 102 34 62 1535 174 3019 2 2 102 34 62 174 1537 3020 2 2 102 34 63 175 1535 3021 2 2 102 34 64 1539 176 3022 2 2 102 34 65 1538 177 3023 2 2 102 34 65 177 1539 3024 2 2 102 34 4 12 1538 3025 2 2 102 34 57 58 1534 3026 2 2 102 34 63 1528 175 3027 2 2 102 34 64 176 1528 3028 2 2 102 34 169 1534 170 3029 2 2 100 36 1642 1563 1602 3030 2 2 100 36 1586 1642 1602 3031 2 2 100 36 1597 1551 1649 3032 2 2 100 36 1596 1648 1550 3033 2 2 100 36 1554 1570 1606 3034 2 2 100 36 1551 1677 1649 3035 2 2 100 36 1550 1648 1676 3036 2 2 100 36 41 42 1580 3037 2 2 100 36 154 155 1581 3038 2 2 100 36 1558 1572 1601 3039 2 2 100 36 1551 1605 1581 3040 2 2 100 36 1547 1602 1575 3041 2 2 100 36 145 146 1576 3042 2 2 100 36 136 137 1588 3043 2 2 100 36 1557 1581 1605 3044 2 2 100 36 1553 1625 1595 3045 2 2 100 36 1689 1618 1541 3046 2 2 100 36 46 1631 1570 3047 2 2 100 36 1554 1609 1570 3048 2 2 100 36 1540 1575 1602 3049 2 2 100 36 1570 1657 1606 3050 2 2 100 36 1540 1637 1575 3051 2 2 100 36 1556 1600 1598 3052 2 2 100 36 146 1622 1576 3053 2 2 100 36 1688 147 148 3054 2 2 100 36 1590 147 1688 3055 2 2 100 36 1544 1601 1574 3056 2 2 100 36 1563 1591 1630 3057 2 2 100 36 1542 1598 1600 3058 2 2 100 36 41 1580 1626 3059 2 2 100 36 155 1627 1581 3060 2 2 100 36 1589 1618 1689 3061 2 2 100 36 1558 1576 1622 3062 2 2 100 36 1547 1575 1615 3063 2 2 100 36 1562 1596 1617 3064 2 2 100 36 1547 1586 1602 3065 2 2 100 36 1545 1606 1657 3066 2 2 100 36 1573 1595 1625 3067 2 2 100 36 1550 1617 1596 3068 2 2 100 36 1578 1604 1683 3069 2 2 100 36 1553 1588 1608 3070 2 2 100 36 1552 1630 1591 3071 2 2 100 36 1553 1603 1588 3072 2 2 100 36 46 1570 1609 3073 2 2 100 36 1561 1575 1637 3074 2 2 100 36 1553 1595 1571 3075 2 2 100 36 1569 1676 1648 3076 2 2 100 36 1568 1649 1677 3077 2 2 100 36 1552 1578 1683 3078 2 2 100 36 52 53 1595 3079 2 2 100 36 46 47 1631 3080 2 2 100 36 1582 1691 1618 3081 2 2 100 36 1549 1671 1668 3082 2 2 100 36 1553 1571 1603 3083 2 2 100 36 49 1639 1587 3084 2 2 100 36 1545 1643 1582 3085 2 2 100 36 1549 1592 1671 3086 2 2 100 36 1691 1541 1618 3087 2 2 100 36 1543 1586 1636 3088 2 2 100 36 1561 1582 1643 3089 2 2 100 36 1552 1674 1578 3090 2 2 100 36 49 1587 1614 3091 2 2 100 36 1558 1663 1576 3092 2 2 100 36 136 1588 1603 3093 2 2 100 36 1642 1543 1666 3094 2 2 100 36 1544 1574 1616 3095 2 2 100 36 1551 1581 1677 3096 2 2 100 36 1560 1636 1586 3097 2 2 100 36 1575 1643 1615 3098 2 2 100 36 1545 1615 1643 3099 2 2 100 36 1554 1607 1583 3100 2 2 100 36 49 50 1639 3101 2 2 100 36 1554 1583 1652 3102 2 2 100 36 1589 1607 1618 3103 2 2 100 36 1561 1624 1582 3104 2 2 100 36 1548 1675 1600 3105 2 2 100 36 50 51 1629 3106 2 2 100 36 1545 1582 1606 3107 2 2 100 36 1558 1619 1572 3108 2 2 100 36 1552 1591 1674 3109 2 2 100 36 1561 1643 1575 3110 2 2 100 36 1558 1622 1590 3111 2 2 100 36 1555 1579 1610 3112 2 2 100 36 1577 1668 1671 3113 2 2 100 36 149 1610 1579 3114 2 2 100 36 52 1595 1680 3115 2 2 100 36 149 1579 1688 3116 2 2 100 36 1548 1600 1646 3117 2 2 100 36 151 1577 1655 3118 2 2 100 36 1556 1580 1611 3119 2 2 100 36 1557 1612 1581 3120 2 2 100 36 1556 1678 1585 3121 2 2 100 36 1557 1584 1679 3122 2 2 100 36 151 1628 1577 3123 2 2 100 36 1555 1640 1579 3124 2 2 100 36 1556 1656 1580 3125 2 2 100 36 1559 1608 1588 3126 2 2 100 36 1563 1642 1591 3127 2 2 100 36 1591 1642 1666 3128 2 2 100 36 1572 1634 1601 3129 2 2 100 36 40 1626 1650 3130 2 2 100 36 156 1651 1627 3131 2 2 100 36 141 142 1613 3132 2 2 100 36 42 1611 1580 3133 2 2 100 36 154 1581 1612 3134 2 2 100 36 1582 1618 1606 3135 2 2 100 36 141 1613 1665 3136 2 2 100 36 145 1576 1623 3137 2 2 100 36 1560 1629 1573 3138 2 2 100 36 1543 1642 1586 3139 2 2 100 36 147 1590 1622 3140 2 2 100 36 1560 1573 1636 3141 2 2 100 36 137 1620 1588 3142 2 2 100 36 1555 1655 1671 3143 2 2 100 36 1558 1590 1619 3144 2 2 100 36 1551 1594 1605 3145 2 2 100 36 45 1652 1583 3146 2 2 100 36 45 1583 1635 3147 2 2 100 36 1557 1645 1584 3148 2 2 100 36 1556 1585 1646 3149 2 2 100 36 152 1679 1584 3150 2 2 100 36 44 1585 1678 3151 2 2 100 36 50 1629 1639 3152 2 2 100 36 1583 1607 1682 3153 2 2 100 36 7 1648 1596 3154 2 2 100 36 159 1597 1649 3155 2 2 100 36 48 49 1614 3156 2 2 100 36 1545 1657 1615 3157 2 2 100 36 1560 1586 1641 3158 2 2 100 36 1566 1600 1675 3159 2 2 100 36 44 1635 1585 3160 2 2 100 36 1548 1682 1607 3161 2 2 100 36 152 1584 1628 3162 2 2 100 36 1640 1624 1546 3163 2 2 100 36 40 41 1626 3164 2 2 100 36 155 156 1627 3165 2 2 100 36 1589 1675 1607 3166 2 2 100 36 1548 1607 1675 3167 2 2 100 36 1542 1670 1594 3168 2 2 100 36 159 1632 1597 3169 2 2 100 36 1549 1621 1592 3170 2 2 100 36 1593 1624 1640 3171 2 2 100 36 1554 1652 1609 3172 2 2 100 36 1 46 1609 3173 2 2 100 36 1573 1680 1595 3174 2 2 100 36 1550 1598 1617 3175 2 2 100 36 1562 1617 1594 3176 2 2 100 36 1555 1610 1655 3177 2 2 100 36 1555 1593 1640 3178 2 2 100 36 135 136 1603 3179 2 2 100 36 1563 1660 1602 3180 2 2 100 36 1562 1653 1596 3181 2 2 100 36 9 13 1644 3182 2 2 100 36 10 1633 143 3183 2 2 100 36 1547 1659 1587 3184 2 2 100 36 1562 1594 1661 3185 2 2 100 36 158 159 1649 3186 2 2 100 36 7 161 1648 3187 2 2 100 36 1542 1594 1685 3188 2 2 100 36 1547 1587 1641 3189 2 2 100 36 1557 1670 1599 3190 2 2 100 36 1558 1601 1663 3191 2 2 100 36 1568 1627 1651 3192 2 2 100 36 1569 1650 1626 3193 2 2 100 36 1555 1664 1593 3194 2 2 100 36 1572 1637 1634 3195 2 2 100 36 9 1644 54 3196 2 2 100 36 1551 1661 1594 3197 2 2 100 36 1556 1611 1678 3198 2 2 100 36 1557 1679 1612 3199 2 2 100 36 1559 1638 1674 3200 2 2 100 36 1564 1615 1657 3201 2 2 100 36 1559 1588 1620 3202 2 2 100 36 1556 1598 1656 3203 2 2 100 36 1552 1616 1630 3204 2 2 100 36 1547 1641 1586 3205 2 2 100 36 1540 1602 1660 3206 2 2 100 36 1594 1670 1605 3207 2 2 100 36 1577 1671 1655 3208 2 2 100 36 8 1650 162 3209 2 2 100 36 11 157 1651 3210 2 2 100 36 7 1596 1653 3211 2 2 100 36 11 1651 156 3212 2 2 100 36 8 40 1650 3213 2 2 100 36 1597 1632 1661 3214 2 2 100 36 148 149 1688 3215 2 2 100 36 1540 1634 1637 3216 2 2 100 36 1559 1620 1638 3217 2 2 100 36 1571 1595 1654 3218 2 2 100 36 10 144 1633 3219 2 2 100 36 1661 1632 1562 3220 2 2 100 36 1557 1599 1645 3221 2 2 100 36 1556 1646 1600 3222 2 2 100 36 53 1654 1595 3223 2 2 100 36 159 160 1632 3224 2 2 100 36 1567 1662 1616 3225 2 2 100 36 1544 1616 1662 3226 2 2 100 36 1542 1685 1598 3227 2 2 100 36 1574 1601 1634 3228 2 2 100 36 1557 1605 1670 3229 2 2 100 36 1542 1600 1690 3230 2 2 100 36 149 150 1610 3231 2 2 100 36 1566 1690 1600 3232 2 2 100 36 1541 1664 1689 3233 2 2 100 36 1574 1634 1660 3234 2 2 100 36 1550 1656 1598 3235 2 2 100 36 1541 1691 1664 3236 2 2 100 36 144 145 1623 3237 2 2 100 36 153 154 1612 3238 2 2 100 36 42 43 1611 3239 2 2 100 36 1567 1665 1613 3240 2 2 100 36 138 139 1638 3241 2 2 100 36 1574 1630 1616 3242 2 2 100 36 1572 1619 1658 3243 2 2 100 36 152 153 1679 3244 2 2 100 36 43 44 1678 3245 2 2 100 36 135 1603 1681 3246 2 2 100 36 1582 1624 1691 3247 2 2 100 36 144 1623 1633 3248 2 2 100 36 1546 1658 1619 3249 2 2 100 36 137 138 1620 3250 2 2 100 36 1551 1597 1661 3251 2 2 100 36 1543 1625 1608 3252 2 2 100 36 1587 1659 1614 3253 2 2 100 36 1566 1675 1621 3254 2 2 100 36 1589 1621 1675 3255 2 2 100 36 1593 1664 1691 3256 2 2 100 36 150 151 1655 3257 2 2 100 36 140 1665 1604 3258 2 2 100 36 140 141 1665 3259 2 2 100 36 1562 1632 1653 3260 2 2 100 36 1573 1625 1636 3261 2 2 100 36 1544 1663 1601 3262 2 2 100 36 1592 1689 1664 3263 2 2 100 36 1540 1660 1634 3264 2 2 100 36 139 140 1672 3265 2 2 100 36 1554 1618 1607 3266 2 2 100 36 1560 1641 1639 3267 2 2 100 36 1571 1681 1603 3268 2 2 100 36 146 147 1622 3269 2 2 100 36 1565 1647 1662 3270 2 2 100 36 1565 1633 1623 3271 2 2 100 36 140 1604 1672 3272 2 2 100 36 1553 1608 1625 3273 2 2 100 36 139 1672 1638 3274 2 2 100 36 151 152 1628 3275 2 2 100 36 1 1652 45 3276 2 2 100 36 44 45 1635 3277 2 2 100 36 47 48 1669 3278 2 2 100 36 1578 1672 1604 3279 2 2 100 36 53 54 1654 3280 2 2 100 36 1554 1606 1618 3281 2 2 100 36 1578 1674 1638 3282 2 2 100 36 1565 1662 1613 3283 2 2 100 36 1543 1636 1625 3284 2 2 100 36 1587 1639 1641 3285 2 2 100 36 51 52 1680 3286 2 2 100 36 1580 1656 1676 3287 2 2 100 36 142 143 1667 3288 2 2 100 36 1560 1639 1629 3289 2 2 100 36 7 1653 160 3290 2 2 100 36 1598 1685 1617 3291 2 2 100 36 142 1667 1613 3292 2 2 100 36 1590 1673 1619 3293 2 2 100 36 1593 1691 1624 3294 2 2 100 36 1544 1662 1647 3295 2 2 100 36 1584 1645 1668 3296 2 2 100 36 1550 1676 1656 3297 2 2 100 36 1549 1668 1645 3298 2 2 100 36 1578 1638 1672 3299 2 2 100 36 1592 1621 1689 3300 2 2 100 36 161 162 1686 3301 2 2 100 36 157 158 1687 3302 2 2 100 36 1574 1660 1630 3303 2 2 100 36 13 135 1681 3304 2 2 100 36 1 1609 1652 3305 2 2 100 36 1567 1613 1662 3306 2 2 100 36 1565 1623 1647 3307 2 2 100 36 1559 1666 1608 3308 2 2 100 36 1567 1604 1665 3309 2 2 100 36 150 1655 1610 3310 2 2 100 36 138 1638 1620 3311 2 2 100 36 1543 1608 1666 3312 2 2 100 36 1546 1619 1673 3313 2 2 100 36 1564 1657 1631 3314 2 2 100 36 1580 1676 1626 3315 2 2 100 36 1581 1627 1677 3316 2 2 100 36 153 1612 1679 3317 2 2 100 36 43 1678 1611 3318 2 2 100 36 1547 1615 1659 3319 2 2 100 36 1565 1613 1667 3320 2 2 100 36 1561 1637 1658 3321 2 2 100 36 1572 1658 1637 3322 2 2 100 36 1589 1689 1621 3323 2 2 100 36 1585 1682 1646 3324 2 2 100 36 1548 1646 1682 3325 2 2 100 36 1567 1683 1604 3326 2 2 100 36 1576 1647 1623 3327 2 2 100 36 48 1614 1669 3328 2 2 100 36 54 1644 1654 3329 2 2 100 36 1552 1683 1616 3330 2 2 100 36 1555 1671 1664 3331 2 2 100 36 1564 1659 1615 3332 2 2 100 36 1592 1664 1671 3333 2 2 100 36 1564 1614 1659 3334 2 2 100 36 1546 1673 1640 3335 2 2 100 36 1599 1670 1690 3336 2 2 100 36 1564 1669 1614 3337 2 2 100 36 1542 1690 1670 3338 2 2 100 36 1599 1684 1645 3339 2 2 100 36 1561 1658 1624 3340 2 2 100 36 47 1669 1631 3341 2 2 100 36 1546 1624 1658 3342 2 2 100 36 1549 1645 1684 3343 2 2 100 36 1570 1631 1657 3344 2 2 100 36 1594 1617 1685 3345 2 2 100 36 1579 1640 1673 3346 2 2 100 36 160 1653 1632 3347 2 2 100 36 1567 1616 1683 3348 2 2 100 36 1599 1690 1684 3349 2 2 100 36 1566 1684 1690 3350 2 2 100 36 1566 1621 1684 3351 2 2 100 36 1549 1684 1621 3352 2 2 100 36 143 1633 1667 3353 2 2 100 36 1544 1647 1663 3354 2 2 100 36 1563 1630 1660 3355 2 2 100 36 1565 1667 1633 3356 2 2 100 36 1559 1674 1666 3357 2 2 100 36 1569 1626 1676 3358 2 2 100 36 1568 1677 1627 3359 2 2 100 36 1577 1628 1668 3360 2 2 100 36 1564 1631 1669 3361 2 2 100 36 1584 1668 1628 3362 2 2 100 36 51 1680 1629 3363 2 2 100 36 1571 1654 1644 3364 2 2 100 36 1576 1663 1647 3365 2 2 100 36 1573 1629 1680 3366 2 2 100 36 1585 1635 1682 3367 2 2 100 36 1583 1682 1635 3368 2 2 100 36 1590 1688 1673 3369 2 2 100 36 1579 1673 1688 3370 2 2 100 36 1591 1666 1674 3371 2 2 100 36 162 1650 1686 3372 2 2 100 36 157 1687 1651 3373 2 2 100 36 13 1681 1644 3374 2 2 100 36 1569 1686 1650 3375 2 2 100 36 1568 1651 1687 3376 2 2 100 36 161 1686 1648 3377 2 2 100 36 158 1649 1687 3378 2 2 100 36 1568 1687 1649 3379 2 2 100 36 1569 1648 1686 3380 2 2 100 36 1571 1644 1681 $EndElements getdp-2.7.0-source/demos/magnet.geo000644 001750 001750 00000004713 12247432724 020673 0ustar00geuzainegeuzaine000000 000000 Include "magnet_data.pro"; DefineConstant[ h = {0.14, Min 0.1, Max 0.2, Step 0.01, Name "Parameters/Geometry/Core height (m)"} ] ; DefineConstant[ l = {0.14, Min 0.05, Max 0.2, Step 0.01, Name "Parameters/Geometry/Core width (m)"} ] ; DefineConstant[ d = {0.03, Min 0.01, Max 0.05, Step 0.002, Name "Parameters/Geometry/Core thickness (m)"} ] ; DefineConstant[ e = {5e-3, Min 5e-4, Max d, Step 1e-3, Name "Parameters/Geometry/Air gap (m)", Highlight "LightYellow"} ] ; DefineConstant[ ha = {0.03, Min 0.01, Max 0.1, Step 0.01, Name "Parameters/Geometry/Magnet height (m)"} ] ; lc0 = d / 5 ; lc1 = e / 2 ; lc2 = (Val_Rext - Val_Rint) / 8. ; Point(1) = {0, 0, 0, lc0}; Point(2) = {-l/2, 0, 0, lc0}; Point(3) = {-l/2, h/2, 0, lc0}; Point(4) = {l/2, 0, 0, lc1}; Point(5) = {l/2, h/2, 0, lc0}; Point(6) = {-l/2, ha/2, 0, lc0}; Point(7) = {-l/2+d, ha/2, 0, lc0}; Point(8) = {-l/2+d, 0, 0, lc0}; Point(9) = {l/2-d, 0, 0, lc1}; Point(10) = {l/2-d, h/2-d, 0, lc0}; Point(11) = {-l/2+d, h/2-d, 0, lc0}; Point(12) = {l/2, e/2, 0, lc1}; Point(13) = {l/2-d, e/2, 0, lc1}; Point(30) = {Val_Rint, 0, 0, lc2}; Point(31) = {Val_Rext, 0, 0, lc2}; Point(32) = {0, Val_Rint, 0, lc2}; Point(33) = {0, Val_Rext, 0, lc2}; Point(34) = {-Val_Rext, 0, 0, lc2}; Point(35) = {-Val_Rint, 0, 0, lc2}; Line(1) = {34, 35}; Line(2) = {35, 2}; Line(3) = {2, 8}; Line(4) = {8, 1}; Line(5) = {1, 9}; Line(6) = {9, 4}; Line(7) = {4, 30}; Line(8) = {30, 31}; Line(9) = {2, 6}; Line(10) = {6, 3}; Line(11) = {3, 5}; Line(12) = {5, 12}; Line(13) = {12, 4}; Line(14) = {9, 13}; Line(15) = {13, 10}; Line(16) = {10, 11}; Line(17) = {11, 7}; Line(18) = {7, 8}; Line(19) = {7, 6}; Line(20) = {13, 12}; Circle(21) = {35, 1, 32}; Circle(22) = {32, 1, 30}; Circle(23) = {34, 1, 33}; Circle(24) = {33, 1, 31}; Line Loop(25) = {21, 22, 8, -24, -23, 1}; Plane Surface(26) = {25}; Line Loop(27) = - {22, -7, -13, -12, -11, -10, -9, -2, 21}; Plane Surface(28) = {27}; Line Loop(29) = - {11, 12, -20, 15, 16, 17, 19, 10}; Plane Surface(30) = {29}; Line Loop(31) = {19, -9, 3, -18}; Plane Surface(32) = {31}; Line Loop(33) = - {20, 13, -6, 14}; Plane Surface(34) = {33}; Line Loop(35) = {15, 16, 17, 18, 4, 5, 14}; Plane Surface(36) = {35}; // physical entities (for which elements will be saved) Physical Surface(AIR) = {28, 36}; Physical Surface(AIR_INF) = {26}; Physical Surface(AIR_GAP) = {34}; Physical Surface(MAGNET) = {32}; Physical Surface(CORE) = {30}; Physical Line(LINE_INF) = {23, 24}; Physical Line(LINE_X) = {1:8}; getdp-2.7.0-source/demos/magnet.pro000644 001750 001750 00000005371 12361140412 020705 0ustar00geuzainegeuzaine000000 000000 /* To solve the problem with scalar potential, type 'getdp test -solve MagSta_phi -pos phi' with vector potential, type 'getdp test -solve MagSta_a -pos a' */ Include "magnet_data.pro"; Include "BH.pro"; Group { // AIR, AIR_INF, etc. are variables defined in core.txt, and correspond to the // tags of physical regions in the mesh Air = Region[ AIR ]; AirInf = Region[ AIR_INF ]; Core = Region[ CORE ]; AirGap = Region[ AIR_GAP ]; Magnet = Region[ MAGNET ]; // These are the generic group names that are used in "Magnetostatics.pro" Domain_S = Region[ {} ] ; Domain_Inf = Region[ AirInf ] ; Domain_M = Region[ Magnet ] ; // This defines a constant ('Flag_NL') with a default value (0), and a way to // change it from outside getdp with ONELAB, using the given parameter name // and possible binary values 0 or 1. DefineConstant[ Flag_NL = { 0, Choices{0,1}, Name "Parameters/Materials/1Nonlinear BH-curve"} ]; Domain_NL = Region[ {} ] ; If(Flag_NL) Domain_NL += Region[ {Core} ] ; EndIf Domain_Mag = Region[ {Air, AirInf, Core, AirGap} ] ; Dirichlet_a_0 = Region[ LINE_INF ] ; Dirichlet_phi_0 = Region[ {LINE_X, LINE_INF} ] ; } Function { mu0 = 4.e-7 * Pi ; // Another parameter that can be changed interactively; but is only visible // when it makes sense (if we don't perform a nonlinear analysis) DefineConstant[ murCore = {200., Min 1, Max 1000, Step 10, Visible !Flag_NL, Name "Parameters/Materials/Core relative permeability"} ]; nu [ Region[{Air, AirInf, AirGap, Magnet}] ] = 1. / mu0 ; If(!Flag_NL) nu [ Core ] = 1. / (murCore * mu0) ; mu [ Core ] = murCore * mu0; EndIf If(Flag_NL) nu [ Core ] = nu_1[$1] ; dhdb_NL [ Core ] = dhdb_1_NL[$1]; mu [ Core ] = mu_1[$1] ; dbdh_NL [ Core ] = dbdh_1_NL[$1]; EndIf mu [ Region[{Air, AirInf, AirGap, Magnet}] ] = mu0 ; DefineConstant[ Hc = {920000, Name "Parameters/Materials/hc", Label "Magnet coercive field (A/m)"} ]; hc [ Magnet ] = Rotate[ Vector[Hc, 0, 0.], 0, 0, Pi/2] ; } Include "Magnetostatics.pro" eps = 1.e-5; PostOperation { { Name phi ; NameOfPostProcessing MagSta_phi; Operation { Print[ phi, OnElementsOf Domain, File "phi.pos" ] ; Print[ hc, OnElementsOf Domain, File "hc.pos" ] ; Print[ b, OnElementsOf Domain, File "b_phi.pos" ] ; Print[ b, OnLine {{-0.07,eps,0}{0.09,eps,0}} {500}, File "b_phi.txt", Format Table ] ; } } { Name a ; NameOfPostProcessing MagSta_a; Operation { Print[ az, OnElementsOf Domain, File "az.pos"] ; Print[ b, OnElementsOf Domain, File "b_a.pos" ] ; Print[ h, OnElementsOf Domain, File "h_a.pos" ] ; Print[ b, OnLine {{-0.07,eps,0}{0.09,eps,0}} {500}, File "b_a.txt" , Format Table ] ; } } } getdp-2.7.0-source/doc/VERSIONS.txt000644 001750 001750 00000016707 12617441400 020371 0ustar00geuzainegeuzaine000000 000000 2.7.0 (November 7, 2015): new Else/ElseIf commands; new timing and memory reporting functions. 2.6.1 (July 30, 2015): enhanced Print[] command; minor fixes. 2.6.0 (July 21, 2015): new ability to define and use Macros in .pro files; new run-time variables (act as registers, but with user-defined names starting with '$') and run-time ONELAB Get/Set functions; new Append*ToFileName PostOperation options; new GetResdidual and associated operations; fixes and extended format support in MSH file reader; fixed UpdateConstraint for complex-simulated-real and multi-harmonic calculations. 2.5.1 (April 18, 2015): enhanced Python[] and DefineFunction[]. 2.5.0 (March 12, 2015): added option to embed Octave and Python interpreters; extended "Field" functions with gradient; extended string and list handling functions; new resolution and postprocessing functions (RenameFile, While, ...); extended EigenSolve with eigenvalue filter and high order polynomial EV problems; small bug fixes. 2.4.4 (July 9, 2014): better stability, updated onelab API version and inline parameter definitions, fixed UpdateConstraint in harmonic case, improved performance of multi-harmonic assembly, fixed memory leak in parallel MPI version, improved EigenSolve (quadratic EVP with SLEPC, EVP on real matrices), new CosineTransform, MPI_Printf, SendMergeFileRequest parser commands, small improvements and bug fixes. 2.4.3 (February 7, 2104): new mandatory 'Name' attribute to define onelab variables in DefineConstant[] & co; minor bug fixes. 2.4.2 (Septembre 27, 2013): fixed function arguments in nested expressions; minor improvements. 2.4.1 (July 16, 2013): minor improvements and bug fixes. 2.4.0 (July 9, 2013): new two-step Init constraints; faster network computation (with new -cache); improved Update operation; better cpu/memory reporting; new -setnumber, -setstring and -gmshread command line options; accept unicode file paths on Windows; small bug fixes. 2.3.1 (May 11, 2013): updated onelab; small bug fixes. 2.3.0 (March 9, 2013): moved build system from autoconf to cmake; new family of Field functions to use data imported from Gmsh; improved list handling; general code cleanup. 2.2.1 (July 15, 2012): cleaned up nonlinear convergence tests and integrated experimental adaptive time loop code; small bug fixes. 2.2.0 (June 19, 2012): new solver interface based on ONELAB; parallel SLEPC eigensolvers; cleaned up syntax for groups, moving band and global basis functions; new Field[] functions to interpolate post-processing datasets from Gmsh; fixed bug in Sur/Lin transformation of 2 forms; fixed bug for periodic constraints on high-order edge elements. 2.1.1 (April 12, 2011): default direct solver using MUMPS. 2.1.0 (October 24, 2010): parallel resolution using PETSc solvers; new Gmsh2 output format; new experimental SLEPc-based eigensolvers; various bug and performance fixes (missing face basis functions, slow PETSc assembly with global quantities, ...) 2.0.0 (March 16, 2010): general code cleanup (separated interface from legacy code; removed various undocumented, unstable and otherwise experimental features; moved to C++); updated input file formats; default solvers are now based on PETSc; small bug fixes (binary .res read, Newmark -restart). 1.2.1 (March 18, 2006): Small fixes. 1.2.0 (March 10, 2006): Windows versions do not depend on Cygwin anymore; major parser cleanup (loops & co). 1.1.2 (September 3, 2005): Small fixes. 1.1.0 (August 21, 2005): New eigensolver based on Arpack (EigenSolve); generalized old Lanczos solver to work with GSL+lapack; reworked PETSc interface, which now requires PETSc 2.3; documented many previously undocumented features (loops, conditionals, strings, link constraints, etc.); various improvements and bug fixes. 1.0.1 (February 6, 2005): Small fixes. 1.0.0 (April 24, 2004): New license (GNU GPL); added support for latest Gmsh mesh file format; more code cleanups. 0.91: Merged moving band and multi-harmonic code; new loops and conditionals in the parser; removed old readline code (just use GNU readline if available); upgraded to latest Gmsh post-processing format; various small enhancements and bug fixes. 0.89 (March 26, 2003): Code cleanup. 0.88: Integrated FMM code. 0.87: Fixed major performance problem on Windows (matrix assembly and post-processing can be up to 3-4 times faster with 0.87 compared to 0.86, bringing performance much closer to Unix versions); fixed stack overflow on Mac OS X; Re-introduced face basis functions mistakenly removed in 0.86; fixed post-processing bug with pyramidal basis functions; new build system based on autoconf. 0.86 (January 25, 2003): Updated Gmsh output format; many small bug fixes. 0.85 (January 21, 2002): Upgraded communication interface with Gmsh; new ChangeOfValues option in PostOperation; many internal changes. 0.84 (September 6, 2001): New ChangeOfCoordinate option in PostOperation; fixed crash in InterpolationAkima; improved interactive postprocessing (-ipos); changed syntax of parametric OnGrid ($S, $T -> $A, $B, $C); corrected Skin for non simplicial meshes; fixed floating point exception in diagonal matrix scaling; many other small fixes and cleanups. 0.83: Fixed bugs in SaveSolutions[] and InitSolution[]; fixed corrupted binary post-processing files in the harmonic case for the Gmsh format; output files are now created relatively to the input file directory; made solver options available on the command line; added optional matrix scaling and changed default parameter file name to 'solver.par' (Warning: please check the scaling definition in your old SOLVER.PAR files); generalized syntax for lists (start:[incr]end -> start:end:incr); updated reference guide; added a new short presentation on the web site; OnCut -> OnSection; new functional syntax for resolution operations (e.g. Generate X -> Generate[X]); many other small fixes and cleanups. 0.82: Added communication socket for interactive use with Gmsh; corrected (again) memory problem (leak + seg. fault) in time stepping schemes; corrected bug in Update[]. 0.81: Generalization of transformation jacobians (spherical and rectangular, with optional parameters); changed handling of missing command line arguments; enhanced Print OnCut; fixed memory leak for time domain analysis of coupled problems; -name option; fixed seg. fault in ILUK. 0.80: Fixed computation of time derivatives on first time step (in post-processing); added tolerance in transformation jacobians; fixed parsing of DOS files (carriage return problems); automatic memory reallocation in ILUD/ILUK. 0.79: Various bug fixes (mainly for the post-processing of intergal quantities); automatic treatment of degenerated cases in axisymmetrical problems. 0.78: Various bug fixes. 0.77: Changed syntax for PostOperations (Plot suppressed in favour of Print; Plot OnRegion becomes Print OnElementsOf); changed table oriented post-processing formats; new binary formats; new error diagnostics. 0.76: Reorganized high order shape functions; optimization of the post-processing (faster and less bloated); lots of internal cleanups. 0.74: High order shape functions; lots of small bug fixes. 0.73: Eigen value problems (Lanczos); minor corrections. 0.7: constraint syntax; fourier transform; unary minus correction; complex integral quantity correction; separate iteration matrix generation. 0.6: Second order time derivatives; Newton nonlinear scheme; Newmark time stepping scheme; global quantity syntax; interactive post-processing; tensors; integral quantities; post-processing facilities. 0.3: First distributed version. getdp-2.7.0-source/doc/getdp.bib000644 001750 001750 00000003766 12010200205 020121 0ustar00geuzainegeuzaine000000 000000 @misc{getdp, author = "P. Dular and C. Geuzaine", title = "{GetDP} reference manual: the documentation for {GetDP}, a general environment for the treatment of discrete problems", note = "\url{http://www.geuz.org/getdp/}", } @inproceedings{getdp-siam2008, author = "C. Geuzaine", title = "{GetDP}: a general finite-element solver for the de {R}ham complex", booktitle = "PAMM Volume 7 Issue 1. Special Issue: Sixth International Congress on Industrial Applied Mathematics (ICIAM07) and GAMM Annual Meeting, Z{\"u}rich 2007", pages = "1010603--1010604", volume = 7, year = 2008, publisher = "Wiley", } @article{getdp-ieee1998, author = "P. Dular and C. Geuzaine and F. Henrotte and W. Legros", title = "A general environment for the treatment of discrete problems and its application to the finite element method", journal = "IEEE Transactions on Magnetics", volume = 34, number = 5, pages = "3395--3398", month = sep, year = "1998", } @inproceedings{getdp-igte1998, author = "C. Geuzaine and P. Dular and W. Legros", title = "A General Environment for the Treatment of Discrete Problems and its Application to Coupled Finite Element and Boundary Integral Methods", booktitle = "Proceedings of the 8th International IGTE Symposium on Numerical Field Calculation in Electrical Engineering", address = "Graz (Austria)", month = sep, year = 1998, } @article{getdp-ieee1999, author = "P. Dular and C. Geuzaine and A. Genon and W. Legros", title = "An evolutive software environment for teaching finite element methods in electromagnetism", journal = "IEEE Transactions on Magnetics", month = may, year = 1999, volume = 35, number = 3, pages = "1682--1685", } getdp-2.7.0-source/doc/getdp.html000644 001750 001750 00000026372 12617441401 020351 0ustar00geuzainegeuzaine000000 000000 GetDP: a General Environment for the Treatment of Discrete Problems

GetDP

A General Environment for the Treatment of Discrete Problems

Patrick Dular and Christophe Geuzaine

GetDP is an open source finite element solver using mixed elements to discretize de Rham-type complexes in one, two and three dimensions. The main feature of GetDP is the closeness between the input data defining discrete problems (written by the user in ASCII data files) and the symbolic mathematical expressions of these problems.

For example, to solve the Poisson equation div(a grad(v)) = f on a domain D, an input file (".pro" file) would contain something like this: 

  FunctionSpace {
    { Name H1; Type Form0; 
      BasisFunction {
        { Name sn; NameOfCoef vn; Function BF_Node; Support D; Entity NodesOf[All]; }
      }
    }
  }
  Formulation{
    { Name Poisson; Type FemEquation;
      Quantity { 
        { Name v; Type Local; NameOfSpace H1; }
      }
      Equation {
        Galerkin { [ a[] * Dof{d v}, {d v} ] ; In D; Jacobian V; Integration I; }
        Galerkin { [ f[], {v} ] ; In D; Jacobian V; Integration I; }
      }
    }
  }

i.e., a direct transcription of the discrete function space and weak formulation of the problem.

See GetDP's reference manual for a more thorough overview of GetDP's capabilities.

Download

GetDP is distributed under the terms of the GNU General Public License (GPL):

If you use GetDP please cite one of the references in your work (books, articles, reports, etc.).

To help fund GetDP development, you can make a donation.

Documentation

Please use the public mailing list getdp@geuz.org to send questions or ask for help. If you think you have found a bug in the program, you can file a report directly here.

   

Licensing

GetDP is copyright (C) 1997-2015 by P. Dular and C. Geuzaine, University of Liège (see the CREDITS file for more information), and is distributed under the terms of the GNU General Public License (GPL) (version 2 or later).

In short, this means that everyone is free to use GetDP and to redistribute it on a free basis. GetDP is not in the public domain; it is copyrighted and there are restrictions on its distribution (see the license and the related FAQ). For example, you cannot integrate this version of GetDP (in full or in parts) in any closed-source software you plan to distribute (commercially or not). If you want to integrate parts of GetDP into a closed-source software, or want to sell a modified closed-source version of GetDP, you will need to obtain a different license. Please contact us directly for more information.

Links

  • GetDP uses either PETSc or SPARSKIT to solve linear systems, and ARPACK or SLEPc to solve eigenvalue problems.
  • Gmsh can be used as a graphical front-end for GetDP, through the ONELAB interface.
  • GetDP and Gmsh are bundled in the Onelab/Mobile app for iPhone, iPad and Android devices.
getdp-2.7.0-source/doc/CREDITS.txt000644 001750 001750 00000007521 12611677027 020222 0ustar00geuzainegeuzaine000000 000000 GetDP is copyright (C) 1997-2015 Patrick Dular and Christophe Geuzaine University of Liege Major code contributions to GetDP have been provided by Johan Gyselinck, Ruth Sabariego, Michael Asam and Bertrand Thierry. Other code contributors include: David Colignon, Tuan Ledinh, Patrick Lefevre, Andre Nicolet, Jean-Francois Remacle, Timo Tarhasaari, Christophe Trophime and Marc Ume. See the source code for more details. The AVL tree code (Common/avl.*) is copyright (C) 1988-1993, 1995 The Regents of the University of California. Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the University of California not be used in advertising or publicity pertaining to distribution of the software without specific, written prior permission. The University of California makes no representations about the suitability of this software for any purpose. It is provided "as is" without express or implied warranty. The KissFFT code (Numeric/kissfft.hh) is copyright (c) 2003-2010 Mark Borgerding. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the author nor the names of any contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. This version of GetDP may contain code (in the contrib/Arpack subdirectory) written by Danny Sorensen, Richard Lehoucq, Chao Yang and Kristi Maschhoff from the Dept. of Computational & Applied Mathematics at Rice University, Houston, Texas, USA. See http://www.caam.rice.edu/software/ARPACK/ for more info. This version of GetDP may contain code (in the contrib/Sparskit subdirectory) copyright (C) 1990 Yousef Saad: check the configuration options. Thanks to the following folks who have contributed by providing fresh ideas on theoretical or programming topics, who have sent patches, requests for changes or improvements, or who gave us access to exotic machines for testing GetDP: Olivier Adam, Alejandro Angulo, Geoffrey Deliege, Mark Evans, Philippe Geuzaine, Eric Godard, Sebastien Guenneau, Francois Henrotte, Daniel Kedzierski, Samuel Kvasnica, Benoit Meys, Uwe Pahner, Georgia Psoni, Robert Struijs, Ahmed Rassili, Thierry Scordilis, Herve Tortel, Jose Geraldo A. Brito Neto, Matthias Fenner, Daryl Van Vorst, Guillaume Dem\'esy. getdp-2.7.0-source/doc/LICENSE.txt000644 001750 001750 00000043235 12010200205 020156 0ustar00geuzainegeuzaine000000 000000 GetDP is provided under the terms of the GNU General Public License (GPL), Version 2 or later. GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. getdp-2.7.0-source/doc/texinfo/MagSta_a_2D.pro000644 001750 001750 00000005452 11266605602 022557 0ustar00geuzainegeuzaine000000 000000 /* ------------------------------------------------------------------- File "MagSta_a_2D.pro" Magnetostatics - Magnetic vector potential a formulation (2D) ------------------------------------------------------------------- I N P U T --------- GlobalGroup : (Extension '_Mag' is for Magnetic problem) ----------- Domain_Mag Whole magnetic domain DomainS_Mag Inductor regions (Source) Function : -------- nu[] Magnetic reluctivity Constraint : ---------- MagneticVectorPotential_2D Fixed magnetic vector potential (2D) (classical boundary condition) SourceCurrentDensityZ Fixed source current density (in Z direction) */ Group { DefineGroup[ Domain_Mag, DomainS_Mag ]; } Function { DefineFunction[ nu ]; } FunctionSpace { // Magnetic vector potential a (b = curl a) { Name Hcurl_a_Mag_2D; Type Form1P; BasisFunction { // a = a s // e e { Name se; NameOfCoef ae; Function BF_PerpendicularEdge; Support Domain_Mag; Entity NodesOf[ All ]; } } Constraint { { NameOfCoef ae; EntityType NodesOf; NameOfConstraint MagneticVectorPotential_2D; } } } // Source current density js (fully fixed space) { Name Hregion_j_Mag_2D; Type Vector; BasisFunction { { Name sr; NameOfCoef jsr; Function BF_RegionZ; Support DomainS_Mag; Entity DomainS_Mag; } } Constraint { { NameOfCoef jsr; EntityType Region; NameOfConstraint SourceCurrentDensityZ; } } } } Formulation { { Name Magnetostatics_a_2D; Type FemEquation; Quantity { { Name a ; Type Local; NameOfSpace Hcurl_a_Mag_2D; } { Name js; Type Local; NameOfSpace Hregion_j_Mag_2D; } } Equation { Galerkin { [ nu[] * Dof{d a} , {d a} ]; In Domain_Mag; Jacobian Vol; Integration CurlCurl; } Galerkin { [ - Dof{js} , {a} ]; In DomainS_Mag; Jacobian Vol; Integration CurlCurl; } } } } Resolution { { Name MagSta_a_2D; System { { Name Sys_Mag; NameOfFormulation Magnetostatics_a_2D; } } Operation { Generate[Sys_Mag]; Solve[Sys_Mag]; SaveSolution[Sys_Mag]; } } } PostProcessing { { Name MagSta_a_2D; NameOfFormulation Magnetostatics_a_2D; Quantity { { Name a; Value { Local { [ {a} ]; In Domain_Mag; Jacobian Vol; } } } { Name az; Value { Local { [ CompZ[{a}] ]; In Domain_Mag; Jacobian Vol; } } } { Name b; Value { Local { [ {d a} ]; In Domain_Mag; Jacobian Vol; } } } { Name h; Value { Local { [ nu[] * {d a} ]; In Domain_Mag; Jacobian Vol; } } } } } } getdp-2.7.0-source/doc/texinfo/Core.fig000644 001750 001750 00000002430 11266605602 021404 0ustar00geuzainegeuzaine000000 000000 #FIG 3.2 Landscape Center Metric Letter 100.00 Single -3 1200 2 6 360 1575 3870 4275 5 1 0 1 0 7 100 0 -1 0.000 0 1 0 0 1329.847 3917.153 3672 3915 2986 2261 1332 1575 5 1 0 1 0 7 100 0 -1 0.000 0 1 0 0 1332.709 3914.291 3132 3915 2605 2642 1332 2115 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2 3132 3915 3672 3915 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2 1332 3915 1332 2115 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2 1332 2115 1332 1575 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2 1332 3915 3132 3915 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 3 1332 3195 1692 3195 1692 3915 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 4 1872 3915 1872 3555 2052 3555 2052 3915 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 0 0 1.00 48.00 96.00 3204 1863 2988 2223 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 0 0 1.00 48.00 96.00 792 2907 1296 3303 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 0 0 1.00 48.00 96.00 2664 4239 2376 3951 4 0 0 100 0 12 10 0.0000 4 105 990 2844 1827 SurfaceGInf\001 4 0 0 100 0 12 10 1.5708 4 90 360 1548 3735 Core\001 4 0 0 100 0 12 10 1.5708 4 105 270 2016 3879 Ind\001 4 0 0 100 0 12 10 0.0000 4 105 900 360 2835 SurfaceGe0\001 4 0 0 100 0 12 10 0.0000 4 105 900 2700 4275 SurfaceGh0\001 4 0 0 100 0 12 10 0.0000 4 105 270 1980 3015 Air\001 4 0 0 100 0 12 10 0.0000 4 105 540 1728 2007 AirInf\001 -6 getdp-2.7.0-source/doc/texinfo/objects-wrap.jpg000644 001750 001750 00000611405 11266605602 023137 0ustar00geuzainegeuzaine000000 000000 ÿØÿàJFIFHHÿá€ExifMM*JR(‡iZHH c ^ÿÛCÿÛCÿÀ^cÿÄ ÿĵ}!1AQa"q2‘¡#B±ÁRÑð$3br‚ %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖ×ØÙÚáâãäåæçèéêñòóôõö÷øùúÿÄ ÿĵw!1AQaq"2B‘¡±Á #3RðbrÑ $4á%ñ&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚ƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖ×ØÙÚâãäåæçèéêòóôõö÷øùúÿÚ ?þþ( € ( € ( € ( € ( € ( € ( € (àø{üËþ’Yûâd~οüñèÿ‡™þË·?é>Ñÿkÿˆ¸ýþ…ãß„ÿðN?ø(—Æ…ž6Ñåýæ™âþþË>/øeñKáÿ‰,š gÁ¿~x³Åñ·‡otßxGÄZ߇õ=?R¹?ỼGâ¯ø˜| ý‚?oÿŽþ‡ýQñwü*o…Ÿ²wöwˆãýý߇?á]ÁEþ8~Åßu¯²i—F§ÿ ¯…¾ëÿ 5íì-Çú§‹|9ãøTÿ†¨ý®üUÿÿÁ1?hx¶ÿþA>$ý¨ÿhØ£á·À;ì¿é·ÿðœø×öhý¢mº/Û4Ë{Ë ÿÂû4|JþÑñׇôŸÂá+ý{Çþ?ácÁSèÍÿ`üY_íÿÒž þ6›ñþŒöJþÉÿ³Šÿ‚‡ÿÂÀûþ*ÿþü"¿bÿªáÿ þOù¦Ÿð„ÿÅÀ?á\ÿÁSèò?`üV§íÿÓa þÏü7þ#öÿÅj~Ñ_ý6?á\ÿÁSèò?`üV§íÿÓa þÏü7þ#öÿÅj~Ñ_ý6?á\ÿÁSèò?`üV§íÿÓa þ6›ðÿþŒöµþÖÿ³Šÿ‚x¿ûþ-þÿü%mÿªÿ ÿþ¿ù©ð›Å¿?ácÁSèÍÿ`üY_íÿÒž þ£ö»ð¯üH|ÿÄý #“÷öžÿ…uÿèøáûhümÑ~Ù¦[êúŸü&¾)ø[ ü,Ó¿²?°µ¿é~-ñ‚<;â þgû.Û¤ø‹Gý¯þø~ß÷úï~,ÿÁ8ÿà¢_þx'G‹÷šŸ‹¾%ü[ø¥û,øCá—Âï‡þ²YõŸ|Eø‹âÏ øÁ>²Ô¼MâïhžÓ5 JØ ðŸüÛþ ·ãßxkÀ¾ÿ‚ƒþÄ4ñ¿1ñf³§xs¾ð¯‡4ëcÄ>&ñ7ˆu‹›='Bðþ…¤ÙÞjšÎ³ª^ZéÚ^ks}}s´Ê ÃÑÿa=gþI?Ç?øj³Èþcá—Æ/ÛïþO;þA_ð´ኾ|{ÿ…Oÿ ?•©Âÿ /þOøNÿáñwü!¿Û¿ð†ø¯ûÿ†´ý¦ |?ñ¿üKìôoØ«öcý˜þü,¹ÑâÿI·Ôõÿ ~ؾÿ‚ˆüM¾ø5íÞ¡kªëºÆ¿ øçö^°Ó>è¾ Ó"ý€dˆ ¸ýþ»ãß‹?³çÃŒüm¬KûÍOÅßþ-üRð׋þ&üRøâKÖŸYñ—Ä_ˆ¾,ñGŽümâ;ÝKÄÞ.ñ·â OPÔ®@>ÿ € ( € ( € ( € (Ÿñg„ü+ãß ø›À¾:ðׇüiàŸxYðŸŒ|âÍNñ…|Yá_é×:?ˆ|5âokךN½áý{I¼¼ÒõT´ºÓµM:êæÊúÚ{i剀> ÿ‡RÁ2­¿Ò|;ûþÈüAoûý Ç¿ ÿgφþ)ø'X‹÷šg‹¾|[ø[á¯|Mø]ñÃw«³à߈¿¼Yáø'ÄvZo‰¼#â-ÄfŸ©[ðîχ^ÿ‰¿ÂÚ7öÿøIñÓþ@á¾?jÚ#þÿ´£j¿ñgmo‰µìËãí]mKDÿ‹—ð3ÇðÿiÂSàßøF¾ hžñ‡‡ÀøeÚï¿ñ>ðüïö€ñ‹l?äáÏÚàìQñ'àN£ö¯ô;ÿøN|û4~Îÿ±wÆÝkìšeÅåÿ†á ý¥þgxÆ×Ãú·‰?á1𕆽àñ´ß‡ÿô`µ¯ö·ýœWüÃþÿØ?ñhð·ÿá+ûoýPÿøWÿðÿÍKÿ„Ûþ-øÿ iûLxýãwüŸö€ÿ‰úoþ)~ËŸÿg¿ÚOàNáßù ÞøÀÚ‰>%|ý¶¾,Â1á©R_x+Â_°¿ü-=gÆ:gˆ|ðkÀ?¿âŠ×|vÃÐ?bÍ#ý'â—Ä_ˆ³'‡ß÷~=ýµ¿fßÚwöøY«ë ûËèÿl_ƒ¿¾x‹âý”z†³¥|:мY¨øïWðîâ¿iž»ðÿ„|O©i _ü-ø³ð³ã4/Š_>%ü?øÁðËÅÚð|Eø[ã/ü@ð'ˆ¿±5CúÏö‹¼'©jþÕÿ²|A¤êº§ö BãìÆ™¨i—^Uí•Ì€zP@P@P@P@P@P@P@P@P@P@PÄ,ÿ‚‡~Ì_Š¼Mð×ኼAûRüdðˆ5Ÿx£áì‰àï~Ñþ*ðÄÍ3Q¹Ð,>|wñ/Ã[McáOì—âx¦ÇTðÆ…®~Ø?¾|=]Gþ7¿×|m¢xoáÇÄmwÂ`ÿü-Oø('ÆOôO…¿³ÃÿØÿÃ÷ñ/¼ø‡ûk|@ðÇÆŠ~Ö4ÿø›\jzìŸû|DñÃ/Š?üIdÚƒ´­w]ÿ‚‡|ñ߆üG{â¿j u¿øÃGÆ0þûã·Ä¯ßþÒÿ·§íâ­3Zÿ‘×à×ì¹¥x;ö.øýòxsþoøÏÆ?ðP†ße¸°Ð|UâoìŸø(V£ÿ ŒmüC¦_ý“à—Š¯>Ú€tÿ‚kþÁžñW†¾#Kû*üø‡ñ“Â> ѼY¢~Ðÿü4Ÿ´í@¾*ðÆ£m©øCÄÚ§íCñþo‰´ˆ|Aài4ýÃÀψ~%jš€´ø[ùÑ<7á_iZXÛôP@P@P@P@P@P@P@òÅ/Øö6øÁã½wâ÷‹?g¿‡úOǯfh~Ó lï¾~Ö6ÿÙ:>Ÿá‹_ì/Ú»à¥ÿÃÿÚ7ÂþoƒtËo‡úŸü#_ôŸí¿†Òê õŸ·øWÕ|=zçÿðÄ^;øûßÙ«öäý¯þÙYÄöÏáÇÅŸhÿ¶ÏÂÏxîÛæ·Ô>%øƒöÅÐ>0~×Wõ¸¬´ Æ_ ~þןty|;¦êW¿ µ?…|Wâ‰Ú˜ÿ þ ;ð£åñÿìëðö±ð–ƒÿ!oþËŸ5O?¼}ý©Í‡ü ß²í/e¨üð·ü"Úž£g¤x›þ_ø)ÔßÛžðçˆ~'øsËñn± þϨÃÉÿgÿ þÕKñö ñ¿î58¿mo ÚüøYm¬]¦è^Ð?kÍ?Zñì1ñKâ‰<.ÃÆšWï‚ÿµÄŸÛxvËÅi¯øwEñÃoŠZ‚@>ÿ € ( € ( € ( € ( € ( € ( € ( € ( € ( ˜>5þÙ?³ÇÀ/X|<ñ׌|A®üVÔ¼?kã;‚_>|[ý¥>>ÇðöóQÕt8~*j?gO|TøÉ¥|Ohמºø½ªxÏá&Ò¼}â»ëÚ‘¨€xÿü&_ðQߌ¿¿ð€±7„¦ÿ‰–“¯~Ôz–©ûXüvŸìñ)¿ðoŽfÙ£â_Ÿ‚^þÜÔÞóÅ^ø—à¯ø(WÇ_#ÁÚG‡ôß|'Òü[ñ^°ø6ù> ü@ÿHý±|Mñþ %{mû ÇöÖ²øEão…žµ‡çÓ.ôÙáoÂoƒÿ²-¿Ä kßÃ¥|z¼ø}ûGEáßx¯áíÇÆ Ÿ†Wz‚ôÀ·ü'á? ø ¾ð/|5áÿø'Á~Ѽ'àïxOFÓ¼9á_ øWÚu¶áï xkÃÚ=µž“¡xBÒlí4½FÒí-tí/Nµ¶²²¶‚Ú¢P‚€ ( € ( € ( € ( € ( € ( € ( € ( € ( €?áÛ³‚Ó¿eVøûø‚ß÷úd¿±WŠ-~ü,¶Ö.¿Ðµßkÿ²¡¢ø¿öø¥ñÄžcà½Wâ/ÆÙâOŽí¼;eáWÐ"èßó%|?øÿHÐ>þÜ_~$xïBø;¯Kñà7ǯiÙè?i_†¾1øã¿øº>¡­üIðçÁ_ÆÚ]—Ã/Ú·þ-–•{uñ+Æ¿²Ä¿ ¿ € ( € ( € ( € ( € ( € ( € ( € (æµO…~øªÃáw†¾ü`ý¡~;kµñf—ð7à„tíÅVÞ½Ôu[/|Bøƒã¯|<ýŸ>ø^ÂÞ?Ÿáö³ûG|høA§|cÔ~üCðOÁ[Ÿˆ¿|1yà¦ñÿøP_µ?íþ•ûXüjÿ…)ðþoù¶Øcâ?Ä_ý¯Ëýßü]Û³ûá/í5ã#ZÑ<9ñÁ?ðÍ>ý„?áþÕñwÁߌŸðÔ5 §þ |ø7û:xWPðwÁ_‡¾ð“¯x‚ëÆ~1¼ÓažóÅ_~!jšv•¥ø‡â§Å¿kê>7ø½ñƒÆ6Ú•/~/|Nñ‹>&xÿQ³Xñ§Šõí]¥¾Ø( € ( € ( € ( € ( € ( € ( € ( € ( € ( € (Ïþ)|'øYñÇÀšïÂß >ü`øeâìÏøI¾|Rðo‡~ xÄ_ؚƟâ-ûwÂ>,ÓuêÿÙ> Òt­wLþÐÓî>Á¬iš~§kå^Ù[OÈðÉ¿ÿgßø™þÿáð•‡ïÿᎾ>ÜøâWì±yckþ‘ÿ¯Á_ýªóãoì]ö3EðÂ߇gÂíwâOìmû9ü:µÖuÿÁ=|câÛÿ¶0Aá?Û{º7Š¼5ð§ö­ð?ˆ?cÏŒž*ñàZüQÔtíSàÆ¿kš·†ü=¡~ε&Ž"øSñÄüSˆãø?ð#Ç·?m¯x/ÇÄOþÈŸ|7$N>ß € ( € ( € ( € ( € ( € ( € (Ïþ)|Rð'Ák¿~$ë¿ðøKÃÿÙ\ÜÁ¦k Ö5]cÄƟᯠøGÂ>ðÖŸ¬x·Ç4ðþ³á?ø;Åš6â? ø³Â¾#Ó®tøkÄÞÖ-¯4{Ãúö“yy¥ë:6©iu§jšuÕÍ•õ´öÓË|Aÿ ¿ñOöiÿ‰ïì1âϵxJ×ýþãïÅ?ØþËÆÿýí~(±øçñ·öCÿ„ L³ðŽŸðãáÂí3Æ?±·†þx;Yø]àŸÙ7á·‹~$ÿÂÿøxì?k‡¿¼U¨|&×ôŸ|ý¥´/ÝxÏŲ‡Æ½_áŸÇÝáìZŽ•¦Ø|T°Ñ¾üDø™àŸˆ¿õ‹BÓm~/| ñçÄ_†zw/5_„~%ñ^…ñ§Àÿ¾x<éú( € ( € ( € ( € ( € ( € ùƒã_íAá_‡*°ø!ðýXxÅ_´Š¼?kây¦ñ=®£ª|3ýž~Ꚏ«¡Ûü{ø÷o¡êº¯yáûÍ_Bñ‰ðcàƉâ? |Bý¨>!xcÄ~ð‡ˆþü.øyûF~ѳ¨ðS৅~xWPд-CÄ*ñ'Š¼Au㟊üsu§jŸ>3|LÕ4í+IÖ¾$üIÖ´+BÒoü4ø{áü øAàŸ‡¿>|?øáp` € (À?kŽŸðËÿ²Çí-ûKÿÂ/ÿ Çü3¿ÀŒŸ?á þÛÿ„kþøTŸ¼GãÿøEÿá#þÈñü#ÿðÂ?ý“ý·ýƒ­ÿe}¯íÿÙ—‘ö9€>ÿ…ÿMÿ£7ý€?ñe´WÿJz€øXßðTßú3ØÿWûEô§¨ÿ…ÿMÿ£7ý€?ñe´WÿJz€øXßðTßú3ØÿWûEô§¨ÿ…ÿMÿ£7ý€?ñe´WÿJz€øXßðTßú3ØÿWûEô§¨ÿ…ÿMÿ£7ý€?ñe´WÿJz€øXßðTßú3ØÿWûEô§¨ÿ…ÿMÿ£7ý€?ñe´WÿJz€øXßðTßú3ØÿWûEô§¨ÿ…ÿMÿ£7ý€?ñe´WÿJz€<ö…ý¬ट³_À/Ž?´gŽ¿b؃VðOÀ/ƒÿþ5øÇKðŸü‡ãÍ÷Šµ/ ü+ð^µã¯ØxjËXÿ‚YèZMçˆ/4 òßFµÕ5ÍN¸Ôd¶†ûUÓ­ž[È@?Wè € ( € ( € ( € ( € ( € ( € ( € ( Åžð¯|+âoøëÃ^ñ§‚|iáýgÂ~1ðw‹4m;Ä~ñg…|G§\èþ!ð׉¼=¬[^i:÷‡õí&òóKÖtmRÒëNÕ4ë«›+ëií§–&øƒþLþÌÿXÿÈÿXþÌþLïú( € ( € ( € ( € ( € ùƒö ø×⯇O‡ÿ, jþ%ð†µñïǶú¶¨Å§kžøYðÎ?þÑ?¾|)øŽßüø)á_ÞÔ4- PñŠ¼Iâ¯]xçâŸÅ?ÝiÚ§ÄÏŒß5M;JÒu¯‰?u­'Jд›Ï^i:á½CðÞᇿ >øcÁ?>x'áïÁχŸþø\Ø( € (àø+ü¢Ëþ Yÿfûdë:üF ¿è âÄÿ‡¿¼⯊¿5ñEôZ_‡|3¢Û¼is«kZ”äAa§[Q®¯.-í£-4òG;¨ðƒöøñúÚüø£á/ˆ—~ ]üYgáÍCí7žÄ¿ÚßðͪÚI76°ë?Ø:ÐÓf’!ÛiWë »ZÌÛ(9¦ŠÞ)n.%Ž æžybŠ¢RòK,ŽU#Ž4Vww`¨ ³4ÏßøǺg„/~ ^ø‡HÁ†îÿ„Hÿ†Gý¨´Ÿøšøwþ û_ë~ Ó?âa¡hß~Á;|Qð³WÖ,¿ÒtÍ3â_†¾þÄ¿¾&ø‹áýýìpZøËBøuñ¯àÿŽõË©XxGâ—Ãÿ\iþ,Ò@øW?ðTßú<Øÿ©ûEôØhÿ„×þ ›£ÿÄ£þ§öø‹ý•ÿïøX?ðÜ?´WÁøNþÃþÿ —ü)ßøw·Ç¯øTÿð“ù_Ûð­?áyühÿ„íßð‹ÿÂØø‹ý•ÿ †°ÃL~Ú~ ÿ‰WÅ/ø&¿Äˆ ¸ÿ‰…ž³û~ÓŸ³Æ…–Ú<¿èÖúf¿â_ÛÆÿðN?!½´Ô.µ] Bø)â[xv÷º†™ñK[ñ§â ø$ÿ‡ƒøw¿ñ/øéû'þßÿ|[7únáøcÏŠµ—ö‡dýŧˆÿábÿÁ:,¿m‚Z/Û5;}_Lÿ„+Å?´ŠzwöGöî·à/Â^#ðGˆ¼TÃÑÿa=þJÏÇ?øe´ÿÈþŸá—Æ/Øþ¿'þB¿ð«¿áµ¾|ÿ…±ÿÇ›§Âmÿ Óþ¿øA?á!ðü&_Ø_ð™xWûd蟵ì±ûPÂSÿ ÑûK|ý¢?áþÄÿ„×þgÆO‡_ÿáÿ„›û_þÏøJáñˆ?áÿ„ƒþý{ûû[ìŸÚ¿Øš¿Ø>Ñý›yä€{ýP@P@P@P@P@P@P@Aÿ¬xGößé±Äˆ¾øBƒ÷ºÇìoñOãŽü;ð·á/ÃOé‘î½ñ'ìñGâo‹ü'ðëá׃th/|GûøïÅð†´ÝOö ÖôÝ?ö ûþ€ ( € ( € ( € ( € (Ïþ)|Rð'Ák¿~$ë¿ðøKÃÿÙ\ÜÁ¦k Ö5]cÄƟᯠøGÂ>ðÖŸ¬x·Ç|úþ€ ( €?áéßðO½_ýáoíCðÿö›ñ~þóÀ±T'ýº>)é::þîãÅÚÿÂ_Øë@øãñ7ÿì/eÓômWâ.»á=?ÀšOˆõÿ økSñ§ˆ<]á7WçüYûxø«Ç>ñ5§ì‘û"~Ûÿ¼o‡õ›h¼CâÏÙ3Qýœü+ð×ÅZ–s€uŸx;þ -ñ{þ ¿«üpðýÞ¯ õö³á¯€>:×5?NðýΗãŸ|'¹ñÃícÄ €??à¨_ðQ_Ú¯öÿ‚‰|;Ò?aoüjýŸ?áˆ?j‹Ÿˆ?ðP›_|/ý˜?g xWYý›¾2ÿkhß<9ð³ö”ÿ‚£x'öÏñ„®|®hZ¯‰¾~ÔÇNÐ>-ø‚Ãà§Æï ü“Â׼pû €>/ÿ‚Žü;ø‰ñ‹þ ùûn|øGà½Gâ'Å/ŒŸ²Çÿ„<¥ëðýηã/Š ¼OàE.¹ãÏxGÂzVkªx†ÚÿX¿ÕüAd¶ÚM¥ì–qßê i§]€|cñCö\øëáÍ3ömøçXþÕµŒí?h/‰Þ2ý¢|uñ/àÂÚ#Zý>-þÇ_´ÏÃ/àVµ©ø â—ÀOÙÇÅ‹ðƒãoÄo†zï†_Iñ½•·€náñOŒ~ë ©‰µÐ>~ÌßðQÏ 'ìÿñ_øûmÿÂÝøKû0Á<¯ÂŸ¶‡ÁëßxâïìëûBjúGü¿UÕ|ÿ¶£ø ÆZŸÅÙ>ãNð惮ø¯D–ËÇyâ™î›Añæ¯>­|÷w…ÿe‹>?ñ÷íá¿Úáwí7âüEoګó~Ò6ÿ¶N«á¿Ù“Å |_ãxµÿÙÓÁÞ øðÿãõ—Œü «ø_Àrø+ÁW¶_ð¡ü ¾×¼ñOWÕ>&üG¸ñŒ/ø–CöRýþ$øþ ‹â¿ÙÏÆŸ±¿íà/h>ø[á;_‡ZwíáÏ|cø±ñIøIð{IñgÄ/øûOý§bðŸÁohÿô]JÛHð6™ûBx~ËSðo‚5}V/é3xÑ|¬€yß~~Þ>4ø'û Ùx³à¿í]­ëýõ†^#ð€ÿk/…?>!xöãÐ4/†Z_ÿi_‹_ü'ûJÙé?>Í&‹ãAfÖ^/ø§­hêZž¹âÙÿâ¥â¸-ü Sàßìóûr|9ý´ì¾-ø‡áÿí?â/Sýº4)¾"ø¹iÿjÿ5ïÙCÄ?ðLØ>üHñ…¾x—ö•4ßÁF´»’øn„ÚGÄm7À–>¸ð†à‹LºølýÐ@ÁX¿å_ðRÏû0Û#ÿY×â5ðìßÙvÛýúÇíðÿÃöÿ¸Ð¼ðŸþ ;ÿø?ð³Á:<_»Ó<#ðÓá/Âßڛ ¾|?ðÝ’Á£x7á×ï ø_Àž ðí–›á¯øwDðþ™§é¶Àü1WÆ;þ%þÿ‚Ÿ~ßþð•‡ú…ü#ýûüJÿ„Wö¿¸Ñ<9ÿ ã§ì%ñ_ão¿°ôĶÓ?á5øÅñKâWÅ?}—ûwâücâÛý_ÄZˆÿçü7Â_ñPÿÂäý€?hìÿù¤ðÍ?´Wìÿ oÚÿпäâ¿á¬n/øWŸØ?iÿ„›þMsâ‡ü%¿ØßðƒÅÿ 7ü,O ð½ÿà ž ÿ‰¯Å/ø'÷Ãÿˆ¸ÿ‰}žû~Ú¾øÁñNÛX—ý&ßS×ü5ûbüÿ‚w|2±ø •¦¡kªëºÆ¿xîÛÄw¾°Ó>ë~ÔüOâÏ€ððøWþ%ÿ?dÿÛÿàO‹fÿMÓ¼#ÿ yñOö²þÑð쟸´ñü,_ø'E—í£ðKEûf§o«éŸð…x§â–ƒñONþÈþÝÖü¥øKÄ~ñŠ€=áoüöøÑã½ á/ÃoÚÏàˆ>6øƒûN oÙöŠ>ðÿí¥kÑõ {ÅžñwìíâmOGøÛàOˆÓ4}rOˆ¿¼mà?øïáÕׇüE¦øçþÔü?¬ÚX€}@ñÓöNý–?jøEÿá¥ÿfŸ€´Gü ÿÛð…Âôø7ðëâßü!ÿð“dÂIÿ¿ü'þñü#ÿðÂ? ÿmÿdý“ûWûHûÚ?³lüŸÿá×°žÿ$Ÿàgü2¿Úä?ÿ 1ñ7ãì ÿ ß“ÿ ¯øZ?ðÅ_~ÿÂØÿ„cÍÔ¿á ÿ…—ÿ _ü Ÿðø»þßì/øL¼Wý²à x¿ñ/øû{þßÿ|%7ún£áø[? ?k/íÉû‹¿ÿÂÅÿ‚‹üý´~6è¿lÓ-ô3þ¯ |RÐ~ißÙÛº'€t¿øÇ"ñPÿ cþ ;á_øøöîøã XÈ'ÄŸµìª|Iøí¨ý«ý6ÿþŸþ͵÷ì]ðKZû&§qyaáŸøB¿f†ßÙÞµðþ“âOøL|[a¯xÿÅ@ü-ø)®“ÿ_~ÄŸ²·áý3þ&îðŸþ ñ?Åõ}Ëý'SÓ>xkâ—üÃàwÃ/|@¿²Ž{_è_~5üð&¯â9tÛ|RøáûCÅšHÿ Ýâ? ÿÄÃã§ìûü ð”ßèzw‹¿áS|,ý¬¿´|G'ïí<9ÿ ëþ ÑñÃöÑøÛ¢ý³L·Õõ?øM|Sð·AøY§dak~?Òü[â?xwÅ@ü=Sþ ǧ¡øÿöÐøð#Å°ÿÈ[áWíGãí/öNøíá_3÷¶ðœþÏÿ´»ü(øÛàíÍ2K?øgþ_è?ð•x;Xðÿ|9ý©á/è:Ö¢÷ýP@P@P@P@P@Ïø³Â~ñï…|Mà_xkÃþ4ðOñf§x¾,ð¯ˆôëÄ>ñ7‡µ‹kÍ'^ðþ½¤Þ^izΪZ]iÚ¦use}m=´òÄÀ |%ñgŠ¾üeöPø§âox›á߉ü?¦êÿ±¿Æ‰:Σ­øÓÇóØÁãÍSâ_ìŸãoêW:ÅÏÄoŒ³÷‚|¢üGð7Ä?ˆ:Îñ—öˆøâ]sRÕ´ŸŒÿ?d¿ÚÃö•ñ¨ÛôP@P@P@P@PÀòvßµ?ý Ÿ²_ì•ÿoÿ¾8þÝšOÄ_û„ÿÂIÿïÿ…iÿU/àíÿíOñÃþdŸÚÓþ ßÿHßôçÿ¾,ü,øàMwâ—Æ¿‰þü2ð¿ögü$ß~)xËÿü áßí½cOðîý»âïjZG‡ôŸíjúV…¦hjÿoÖ5=?Lµóoom ”äømOü]ý×ìWû.|@ý¡¼?¨þçÿ´wÄ¿hÿ³'ìmª][ÿÄÞ{½7âW‹´ïþÑ¿¾ø“Á­§kß þ=~ËŸ²í!û8üY¾ñwƒl¼3ñ|>¿|_ðÔÿ†[ý¬~$~÷ö‚ÿ‚‚ü@°²Ÿþ$ZïÃØ«àÇÃoÙ[ágŒü /Í©éúÿˆ>)\~׵׃þ xŠ+íkBÕ~)|ý¯>kðêxV÷áV™ðÏâo‡u‰Þ%?áÖ_ðO½_ý'â—ì½ðÿö›ñ~âÏÇ¿¶µÇ‰ÿnŠzNŽ¿¼·ðŽñoöÅ×þ8üMðïÃû Ùu gJøu¡x³Oð&“â=Å~&Ó<;iâxŸRÕÀ>ÿ €>ÿ‚±Ê,¿à¥Ÿö`¶Gþ³¯Äj?áì_ðK/úIgìÿ‰‘û:ÿóÇ þÅÿ²ÿ¤–~Àø™³¯ÿßÿ‡rü"ð·úwÀ_‹ÿµÿìÉâ 3÷—á?ígñ³Å >èíþ„Þøiû!þО)øãû xwáý‡…å»ð_ƒ~Mû/ê>øSáÙt×ø?á߇þ ð5ï ðªÿà Ÿ?ÒþþÓßÿlÛÿÄÂóáçí­ðÿÃþ)ø“XÔ?âSq¦hµ‡ìuðï ¾|?ðÝ’éþ1Ò´-wþ ãñßÇ~$ñ—Šü+©üRÑ|?㟠jÿøoøV_è¶ìÛû@~Ë?dÿF¾ø­ÿŸü4Gì±{ý…û¯ˆŸ¿á ?gFø…ÿ 3àƒ7Úx“þíëàØ£í¿µ/øMuoøkþ/à ·ü'âÏ ø÷¾ñ×|Máÿx'ÆžѼYàïøOYÓ¼Gá_xWÄzu¶±áïxkÄ:=Í擯x^Òo-5MYÒï.´íSNº¶¾²¹žÚx¥`‚€<ÿâ—Â…Ÿ| ®ü-ø×ðÓáÿƆ^(þÌÿ„›á×Å/øwâãìÆ™§êv¾Uí•´ñ€|ÿ¿ý‹4ôo…¿¾ ~ÌžßÞxö*ý¤¿ißØ_áf¯¬7îî<]¯ü%ýŽ¾1üøeâ/ˆöQéú6«ñ]ðž£ã½_ú…|5©øŠïÃþðÆ›¤€ðͶŸ‚âkð·þ Qñâˆ.?â_y£~Úß³ìÇñƒáe¶/úMƧ xkö:ðGü»âmÄom4û]+]×~5ø£À–Þ½ñ]†§ð·[ñ§áx$ÿ…‰ÿøQòøÿöuøûXøKAÿ·ŽeÏ‹š§ÀŸŽÞ>þÔæÃþoÙö—²Ô~ x[þmOQ³Ò%ü?øÁðËÅÚð|Eø[ã/ü@ð'ˆ¿±5CúÏö‹¼'©jþÕÿ²|A¤êº§ö BãìÆ™¨i—^Uí•Ì€zPÀðë/ø'Þ‘þ“ð·ö^øû2xÿqyãßتãÄÿ°¿Å=_GoÞ\xG_ø·ûkÿ¾&ø‹áýýìz~³ªü:×|Y¨øWñá_j~»ñ„|1©i ü1wÅßü¿à¡µÿÃÿè?ñ0ðÂ_‹3üý¬>[kÄɴω~=ý¡>x¿öçø£ðÿÄž(k½GÆZ߶÷…üwmáÝ_Rð?ÁÿŠ_|?¦x?€Ú_ðTßÄ£þßØö§ûOüL¿á`ÿÂËý¢¿`_ì;ýþßøS¿ð©ÿà¥ð’ÿgýûoþ_ü/? lÂCÿ¿ü*} þßøL2ý¸ÿá^`ý§Fÿ’Õÿ Ãþßí¯ø·ðšÿÂ3ãÏøD€>€øûXþ˵ü%?ðÍ´·ÀÚ#þìOøMáF|døuñoþÿøI¿µÿáÿ„§þøƒþÿøH?á׿±?µ¾Éý«ý‰«ýƒíÙ·žH¿Ð@P@P@P@P@?ñß৅h?†z§Ã/ê Ñ-§ñ€$øhkºWˆ|-¨xƒá¯Åox3ÇÚ6‡ã øÇá[h?üãOêZÿ…µpöOø×⯋ßumâÕ‡‡ô/Ú[à?ˆ4‚Ÿµ†<k¨Åð÷CøûgðÏáçÄ­gPøW©jºýαðâ/‚~&xâÿ­K]¼ñ¦ðÏâ/…<7ñsJð?Æ â?߀}?@P@P@P@P̵ïÆ¿|ø7{uð²ÃÃþ!ý þ'øƒBø)û1ø;ÄöºŽ­ x—ãïĹåÑü¨xÃÃÞÕt¯k?þÛ&µñÛö“ºø~Ú‡<û0|)øÓñ?IÒ¯ãð5Ü@¿øðS¿³§Á¿‡¿|¨xƒ]Ò|áøtÛÏøÎëNÕ>!|IñUä÷ÇŽ¾-üTñ—¥hvÞ1øÁñ{Æú—ˆ~'|^ñìºUž£ãÿ‰ž,ñ_5ˆßWׯ¥È>)~ÒÆ£ã½wöqý™´øNÿh{ìË?x»ÄñÞ«û8þÍ6ºÆ§øŠçÄÿ~"èÑøÂ^ øáÿ xƒÁþ/ð×ìuàï‰Z?íñZ×â7ÂM_Q·ø/û¡¦øÛÁ²7€ô="OøQ?üGý½â/WÖ5?üKý£¾"øOxö†ý¤>;è¿ þIု蠀 ( € ( €>ÿ‚±Ê,¿à¥Ÿö`¶Gþ³¯Äjûþ€ ( € ( €> ñgìCá]Å^&ø¯û)xãıçÆOxƒYñ¿Œn¾iÚv©ð ã_Ž5ÍFçÄž!×iÙoXh¾üGñÄÅáÙ>0|wð¿ÁÏÛkÆ ðÆŸðïÂßµßÃß É*ƒáoíE¬\xïBøûLü5ÿ†ý¡üGý§7„ô¿êž;ø§û8ü[µµÑõÛZ| ý©µŸ„ <%ãˆxKDñ†©â_€¾1ð·ÃÚ;DµøYñoÇúwÁÿþÏð×ÇŸ}@P@ |Rý€ÿcoŒ;×~/x³ö{ø¤üzñögö‡í7ð¶Îûàwícoý“£éþµþÂý«¾ _ü?ý£|/æø7L¶ø©ÿÂ5ñ?IþÛøm.¡ðßYûu}WÃ× ÿ ×ûdü3ÿ‰ìïûxÿjxJoô;oþÜÿ³Ýícÿ ÷úGî<áÏ…ß~üYý‹¾6ë_dÓ..4Ïx×ö­ø¥ûXüSø…ý‘ávÿÇú_‹aø…â/‰€ü5‡íð§æýª¿aïˆ/‡Óþ&ŸÅ¿Ø«ÆW_·GÂÏ h÷¿ñ-дÍÀzß߷?ˆ¾ _ø¢1§jºÁ؇ã<-áݾ8×þ)Zx~ß┟ @>€øûU~Î?´¿ü%6ß¾4|?ø‘â‡ÿØ|Rð‰¯ÚÅñOàαâíxôÿütøK©µ‡Äßß#½ðï‰tm_á×Å¿ ø3Ç~ñ…üSá¯xwLñ†µÝ7O÷ú( €<ã§ìû,~Ôð‹ÿÃKþÍ??høAÿ¶ÿá ÿ…éðoá×Å¿øCÿá&þÈÿ„“þøOü9âøGÿá ÿ„AþÛþÉû'ö¯ö&‘öÿ´fÙù ?ÿÃÿÂ%ÿ$ öÔý¿ÿgÿíù?ã#¿á°?á-û'ü€¿å%Þ ý¸ÿá^`ý§Yÿ’+ÿ Ãþßí¯ø¸ÿðšÿÂ3à?øD€øH¿à¦¿ ¾_|:ý?l/ÚÿÅE®ø£á?‹¾'þÅŸ×GƒOá×ÃOÙã┵·Ã/ˆß–Ÿ>£àß|Eý·¿gOx¿Ä~'Ó|âè>xº‡ÅÏðò>ÿEý¥üû@~ÅÚžÿ#®©ûQüñ…~ü6ûgï<9ÿ ÏíÅà>%Á>,?á1·ºÐmü3ý“ûYk_jñŠ¼?ðŠÿû;ãmÅçÃ[·ü'âÏ ø÷¾ñ×|Máÿx'ÆžѼYàïøOYÓ¼Gá_xWÄzu¶±áïxkÄ:=Í擯x^Òo-5MYÒï.´íSNº¶¾²¹žÚx¥`‚€ ( € ( € ( € (àÚ‡þ1§âŸ…?n} ýÂW_ð«>~ÜkÿO±²Å‡ˆþ'¯øÕoöÿ±éžÿ†BøÛñÓSø£ñ{â>¡âï|:ðßìmãÚËÆß´o‰^-ømðþàßôP@P@P@P@|àøÉŸÛ'Æ¿'ÿ‰Á/Ø»þ?€_÷ÿ¦xwÆ¿µ?Š¬lÿá©þ5hûÿ·ü%â?øQ“ÿ±ßÈþÔü+ñá‡Å=kþ uû>|EÑ®4ÍFÇ ÁûFükñW5…_~XxZý ÿhox“ÃGŠ-uwÁ ü+àß ßø«âWíñs¾Õt¯k?þÛ'†¼(lt-CÂúw¾>üXýž?gíâ¯Áþ:X|]ðpð৅gOƒ~ ø;Pñ»¤ø Ãðé·ž1ñÖª|Bø“â«Éî5|[ø©â/JÐí¼cñƒâ÷õ/üNø½ãÙt«=GÇÿèÞ)Óõ½ºÇ…¾)ø_ö ý¢ÿh [j~¹Ò#²¿øâ/†_¾5Á®øÂ×ÅÑxÂÞ;ÓþøvÃá÷‹¼?ñÅž4øR÷ÿìÅñÓþGá§Æ o ÿÂ/áÿ|@øÙ¢xx5¿øItˆ_ >ülø…ðëá/ÇOøŠ=#F²×~þÑ_ ¼'á?_µ}Oú>$xvïÃ^)ñŸ‡åÓ|]­€{ýP@P@yÿÅ/„ÿ >8ø]ø[ñ¯á§ÃÿŒ ¼Qý™ÿ 7ïŠ^ ðïÄx‹ûXÓüE£nøGÅšn¯áý_û'ÄN•®éŸÚ}ÇØ53OÔí|«Û+iãùþ/Žÿb_ø¦¾2Añâ—싦¦xwö´Õ|E£ø£Ä³!ÿEŸÃ¶¶£âï[|Mñ·ÃÿÞÜèÖÞý±|7£|MÖ,¾K¯ø³ö÷¸øÀ¿ˆ¿¶—í÷ýP@P€|tý•gÚ_þ{ŸŽ¿þüHñÃÿí¹þø÷[Ð-bø§ðgXñöDš‡‹¾|[Ó‡Äßß#½ð#â/ÂOx3Ç~ñ…ü/âoø‹Lñ†´-KOùÿþ÷öÉø7ûÿÙßö¿ÿ…µá+ÞÛ|ý¹ü cñ+Èðü*ø]ûSü? >6øûsL{øÛö€ý«|;ÿø§?Ù|#ñÿEñ‹tOˆV?øo}áWú7í½ðoâìGemÿùþ7üKÖ| ãoØÛZÖ4ÏôjzoíKðëĚ߇þü?½ñÆ£|'×nO þÆ>;øÛ}ãøkÀ n~&Ëâï‡> ûþ€ ( € øƒÅŸðOÙƒTñW‰¾%|1ð¯ˆ?e¯Œž.ñ³ãŸ|_ý‘)Gã»ï‹°þÉÞ6ý?noÚ³ölÖ5Óâ{è|[¥|@ð‡‹eýCöhÓ&þÓ´¡ð3ÃZ?Å/ŒÞ#øàOÿb~Î?´7í!¬ø§]ñ¿„þ~Ð~ “ËðÿìùªøwLÑ,>\}¿XñŸ=Ö¯¥ÙY\É(ŸÿÂÆÿ‚¦ÿÑ›þÀø²¿Ú+ÿ¥=@ü,oø*oý¿ìÿ‹+ý¢¿úSÔÂÆÿ‚¦ÿÑ›þÀø²¿Ú+ÿ¥=@ü,oø*oý¿ìÿ‹+ý¢¿úSÔÂÆÿ‚¦ÿÑ›þÀø²¿Ú+ÿ¥=@û.xKþ ›û8| ð7Â{ÏÙƒöñ÷‹tïøI¼añ[â_ü0x»à¦—ã‚Ÿ¶·Åo*🊼9û5~Ð?´•–¡¨xÇ_°gìû¤ê~ÔôŸÙ÷\ðÅÕÕ¿Äk]GKÔuý*þ+U¶‚òý €<ö±øéÿ ¿û,~Òß´¿ü"ÿðœÃ;üøÉñÓþ¯í¿øF¿á0ÿ…IðëÄ~?ÿ„_þ?ìÂ?ÿ ü#ÿÙ?ÛØ:ßöWÚþßý‘©yc˜çÿøXßðTßú3ØÿWûEô§¨ÿ…ÿMÿ£7ý€?ñe´WÿJz€øXßðTßú3ØÿWûEô§¨ÿ…ÿMÿ£7ý€?ñe´WÿJz€øXßðTßú3ØÿWûEô§¨âø)ìÏÿ$ÿ‚~Ä¿?bïþÍÿ±Ã]'ãW‡ü?miãß ÁFþ<ë:…ÃûO]Õu=bÿìÿjÔõ ÛÙg¹”Ð?ácÁSèÍÿ`üY_íÿÒž þ7ü7þŒßöÿÅ•þÑ_ý)ê?ácÁSèÍÿ`üY_íÿÒž þ7ü7þŒßöÿÅ•þÑ_ý)êñÿÚö±ÿ‚’~;8þÑž:ýŠ?b [Á?¾üKø×ã/ÂðR7Þ*Ô¼+ð¯Áz׎¼Caá«-cþ g¡i7ž ¼Òt+Ë}×T×4m:ãQ’ÚíWN¶yo!ý_ € ( €>Ó?㾇ý3ìÿ¿c¯#Nø%â¯øJµ=;Â:Ä‹ß ´Ï‚?¶N¹ðëÁÚ7ÂßþÖ_ ¼$Ÿg@þËâŸìûÿÏÛŸáü!Þ°ýÇü6/À+üJý–/,mÑÿá*øÕá²Þ|mý‹¾Ñ¦h¾.ø¥ñSø£¡|Iý¿g?‡Vº6Ÿãoø(WŒ|[ö6ûÂ~,ð¯|+á¯xÄÞñ§‚|iáýÅžñ„õ;Ä~ñg…|G§[kñ7†¼C£ÜÞi:÷‡õí&òÓTѵ.òëNÕ4ë«kë+™í§ŠVè( € ( €?áß~ø]ÿŸØ¯âÄØ·Ägï<;ðÿᦹ¬x£ö6[X¿âk?‚5/ØSÅÚÝÏìåàŸ‡þ7ñ¶âÏ‹:Çì¹á¯Ù‹öŽñ}ô¾2¹ðÏí!ðÿÄþ"ø“Ä€ü/ßÚŸöwÿFý¬~ ÿÂëøüÜ÷ì1ðãâ/Œ>Éæ~óþ.ì'ý³ñoöšð?Ú5­oß¼ÿ ÓãÛÃþoì¯|bøÉÿ ¿ðþÛû/MúÿáoÅŸ…Ÿ| ¡|Rø)ñ/áÿƆ^(þÓÿ„kâ/ÂßxwâÁ¬iš†™uå^Ù\ÁéýóÂÛGöTøûñÄŸ > üxøwñ/â„´­SÄï…¼'­¦©oá½\Óü3â‹I"ìš·…WÄz”¯Š4‹›ýQÖ Õ4½;Qº½Ñuˆ,@> €3¬5'U—S‡KÕ4íJmQmYŠÂöÚò]'VKK;÷Òõ8íå‘ì5±Ô,/ZÊèEr¶—Öw&! Ì.à4Èx»ÇÞ ðü#ð™x—Jðßü&ž/Ñ|áOí[•¶þÞñŸˆþÓý‡á½7v~ѪêŸcºû°ù¥ò$Áùh¯  ë cIÕeÔáÒõM;R›EÔ[GÖb°½¶¼—IÕ’ÒÎýô½N;yd{ E,u Ö²º\­¥õɈCs ¸|ÿbÿ”YÁK?ìÀ?lýg_ˆÔ÷ýP@Ïø³Â~ñï…|Mà_xkÃþ4ðOñf§x¾,ð¯ˆôëÄ>ñ7‡µ‹kÍ'^ðþ½¤Þ^izΪZ]iÚ¦use}m=´òÄÀ ~Ï,ñWÁ¿ˆCö,øÇâoxÛÅ+áÿ‹Ÿ¿f_Šz注ø³Qø§û0xCâg…ô™¼ãkY¹ÕüomñƒöI¶øÓðOà¼WñSÄ/ñíá]Sá·íÅOüVñ·íðÿàÛôP@P@PÄ,ýˆ|+£x«Äßÿe/xƒö<øÉâ¯k>7ñ×Âí;NÕ>|kñƹ¨Üø“Ä:ïí!û-ë Ÿˆþ ø☼;'ÆŽþ·ø9ûmxÃÁ~Óþø[ö»ø{á¹%@xOöÂÔ|⯠|0ýµ>øöIø‰ãŸhÞ øYâù¾1xWâ'ìÁû@üBñ&£mo¢ü+øñ¿VÒ¾øÛVøÀöÚχ­`øCñ»àOÀ‰Ÿ¼AÄ&ý<)ñãáßÂ?ˆ?4p·è € ( €>@ø¥û|,ñÏŽõß?uÿˆ²ïíâ_ìÏøI¿hÙ«UðïƒþÓßð‹xÒûÀÿ ¿á©¾|kÿ…+£øƒ^Õ~ÿ·ñÕ·ŠlÀ<ÿþïíOû;ÿ£~Ö?áuü?‡þn{öøqñÆdó?yÿGöþÙø·ûMxíÖ·áÏ‡Þ ÿ†iñ‡íáÿ 7öW‹¾1|dÿ†_ømý—¦€}¿á?xWǾð׎¼ âoøÓÁ>4ðþâÏxÇÂzÎâ? ø³Â¾#Ó­µx›Ã^!Ñîo4{Ãúö“yiªhÚΗyu§jšuÕµõ•ÌöÓÅ+tP@ÁK?äÝ~ÿÙÿÿÁ'õ鿱½}]ñãgÂo€>_ühøំž }{ÃþÄž,ÔcÒô¹|Iâ½R ÃWäKªøƒYºµÒt{Ã\j:•Õ½•¬rÜÏn§ðÓâŸÃŒ¾²ñïŸxoâƒu ½SOµñ…u[]_LmGDÔntkL–{YìÚžªÙÝ麮›r!¾Ó¯í§´¼‚âtõpž%ø£ðÛÁ¿¼UñcÅ^=ð†ðÇÀÚ7‰üEã/ˆ§ˆt»_øcCðXÔ?á/Õu¿Ét4½:ËÃ-¤ê‘ë³\ÜƺdÚ}ìžTÖÓ"pÿ¿io´ç‡µï| ø£|CÒ<+â&ð—Š©¦ê~ñ Ò4¯&â _Óô{F½¸ÐuÝZ²RÓm…ö•ªXêm=¥Ìs0¹Ð@Ú¾±¤èeöµ¯jšv‰£i–ò^jZ¶¯{m¦éš}¤#t·W×÷’ÃkioüÒOq,q å˜ Áñw¼à/øF?á2ñ.•á¿øM<_¢øŸڷ+mý½ã?ý§ûÃznìý£UÕ>Çuö;aóKäIƒòÐ_@|ûdÉÅÁ'ìÿþ#묿॔÷ýPÀ¶GüœWüwþÏÿâ7þºËþ Y@Ð@|gûnü7ñÏ|ð§Äð\5/‚?´Á/z¯Â¯·iš~¥ñÿ еOÚ›ö·×þ;i³?Çÿ†ß³•uû6üN›âůà ~3øSáOíæ·‰¾"xãƺς~7übÔ~Üø‡ÅòÅ}©øróXÕ/luêÀûoû0þÕPþÔZ†•s¤þÑZ¯„ã'‡ô½ö‰»ý­/àøŸ°]¿ÀÍšÏÀ=Ká?æø§©üy¸ñ­–µ<ÿ/¾\xŸSñÖ²¿—ö’Ò¤Ž‡ú`Áº—ÃïÛGàÏüûþ 5}ûD|>ý¦þßx#þSû>ø6ßã7‰¿iÿø–ÇĶ÷ìcð/ö‡â·Åo†—Ÿ ?iŸ|GðŒßu oà>©¦øŠóÂޟ┟µÉþ&èöºíäv>,ýÿ‚{xã'„m¾-j/ð?ÆO„Ÿ¼Nß õ/ƒÿ ¿h/Ú Ký§>)è>%ÿ„:kŒþ.“⮑ñ{ãµ­Ç‚¼sâ[ýOhÍñ.þiuÍÆ>5}ÃCÇ c èýPæükᧇ~0|Oÿ‚]|:ñf¥ñIðÿˆ¿oÿÿhj ~,üSøã»ìŸø&Wüs]µþÂø¥ðSÆ_þ&ø_ͽÓ- Ôÿáñv“ý·£Ë¨xwYû‡õ}WL½ôøvŸìëÿEöÿÿűÁSú2(ŸñgüsàýŸ…|Myà_þÛþ#ñ½¯‡õ›Ÿx{ÅŸðXø*ÿ‚ü+®øª :æ_hÞ&ñŽûNx÷WðŸ‡õM]m,µŸé~ñ¦£¡iÓÜê–^ñͬZ=àáí—ÿøuðö{ÿ‚‹Á@>"þÓ¿´ˆ?i«/ØöºÒ+ðïÃ/… ñÀËÝÃþ4ÿ…Œý~ПüYðv£ñágÄ¿iäžÕ¼sðÿÆ^Ó þÂsþÏ?~0ÝøÃá$ˆø…¦¯„ô“ð£önñ?…5ïêšGÁýkHð·‰<'ñ3â&ŸáUðŽ¯ª|-Ô5‡·þ*ðçÄ? ø8æýwöLý¦|_âÏ€P¯À/Û£Â_³‘ûZËâmsàÇíé£ÝükðGÀËÏØßãƒ>"[xûâ™ûiÝKâ|Dý©üIð_Ä^ø}áߎu½Ã^ ø‰¯¡ð,>2ÿ„ Qòëo€?ðUø›ö ñWÄ/…ÿ´øñÏÁ¯€_ðO›Š×Þ"ý¥~]|7Õ>>ü#ø•¡ûUj>4o…¿¶¿€õ Óâ%–ƒ§j~:ñ¹ø9ûl'ƇZÜ~‡áÏ‚üIáû¯ x€íŸÙgöIñGìëûSþÛ)ì¹ñ£Pøoñ£Åøƒãæ©âè~+ø›ÇzÄûkω¾6ðïÂ9üeá :Ç@ø©øcÄzLV 4xWö,ý©tßØSÇz^™ð·öÈÓÿiÏü^ŸÂ:Æñ[öâñŽõøf™?kø—áY¾hÞ ý½|=ðÂæ÷À“EðŠøg^øéð+Z×­døƒaâ_xÞ Vm#âQᯆ_·}¿ìËûÙxëöpý²¼cûCþÏŸ¶—‰¼Uý³mûIþÏÚ&¦ÿ²}·íbð¯üL>~Ö?·ÿÀŸÍþ‡¨ø»þâŸíeý£áÙ?wáÏøW_ðQ{ßÛGà–‹öÍNßHÔÿá5ð·ÂÝâžý‘ý…¢xÿKð—ˆüqáßðͶŸ‚âkð·þ Qñâˆ.?â_y£~Úß³ìÇñƒáe¶/úMƧ xkö:ðGü»âmÄom4û]+]×~5ø£À–Þ½ñ]†§ð·[ñ§áx$ÿ…©ÿø9þ‰ñKöbøû`x~ßþ%öÿb¯ˆø?ñOĚơÿk}O_ý“ÿl_ˆžøeð»áÿ†ì—Pðv«®è_ðPïŽþ;ñ'ˆì¼+â­3án‹áÿøŸHø8è o_Ù;âߎô/„º7ÅoøA>6ø¯ûN~Ï¿´'¾$þÊÿ´wŽ4}GÔ5íGÅÞý¿iŸü$øÛã‡ðiš'‰¤_ˆ¾ð±àK‹¯øïM¶ñÚŸ)ü;Ö#Ôô««½>×Wð¿ˆ5?‡ÿ[|Aðu—ÄMC]³?eÏŽŸðÑÿ| ñb÷Âÿð€ø·Qÿ„›Áÿ¾mÿÂUÿ ›ã·Âø‡á?íðwþ(´Lñçü*¾ñÿÃOøX>Ó“ÁÞ?ÿ„Wþ/]j>×4]Jìßè € ( € ( Åžð¯|+âoøëÃ^ñ§‚|iáýgÂ~1ðw‹4m;Ä~ñg…|G§\èþ!ð׉¼=¬[^i:÷‡õí&òóKÖtmRÒëNÕ4ë«›+ëií§–&øƒþOÚ;öDÿIø&¿?kïÙÊÛ‡ýœ¼eã˯þÙ>Ö5Ï–û_øOûZ~Ôÿ´&‰áÿŒì¼Aoi¬ê_?ißi~;ðí¾%ø—áïíUsà߆ÿÿc[à¯þüRð'Æh_~k¿ðxKÄÚp[\ϦkÖ4­cÃúÆ¡á¯xGÅÞñ6Ÿ£ø·ÀŸ< âÝ\ðOÄ_‡^6Ðü?㿇^;ðÿˆ¼ ãŸøžÖtk@ € ( € øƒÅŸ±Žá?x›âÿìkâ_þÊ|_â gÄþ8øKÅ^6ý˜>2øƒÆzÍÿÄ?|~ý’ü%ñOàׂ|ñƒÅ·7íÇí'á/ü2ý¨.?ô‚Ÿ´n£ã¿j>1|*ñìóûA辺ñAøsâOxWÆ^ø£à½ QÒ¼1⯋Ÿ³ŸÄ¯ _½·ÅOƒú7õk üø¯Ã þ>øNñG­öýž>Çñ»á‡Œ@>Ÿ €>ÿ‚–ɺü9ÿ³ÿÿ‚NÿëÓcz›þ QðÛâ×ÅÏÙ£HðGÁO xçÅ^:_Ú“öø‡¿áÆ­ðsGñ‡…<'ð7öÐø ñãǾ7Чøó®è¿ /5Ï x'á–¿}á­ÄxŽÏ[ñ_ö—á[H»ÔÄ ~П±GÇŸ‡ÆŸað‚?Ú»ö™ðw‹ôÚK⩪øö‘ømû7üEðÿíÉñ+ÄžÕ~~Ðõ ø£öjð‰>xWÃ:F¡à½Âþð—‹4ÿÚØÜjz¯ÀO‹Ú¿Š¤Õ´ =ðçìÉû}k_ðP|Dø¥á¿Ž> øk¦xÇHðß‹¼o/ÇÝ#Iøâo…º¯ìiwð³â&­à3Àµ‡„¼eà]!þ0øƒÅ~-ðŸÂ]cöñGŠOÄÛ üD_Ú ÁÖš´÷_€0¾~Ã~þÂ?ðPoÙGÁÿ²§Ä/ ø¿Æ øéÃßøïö«Ñ¾"hß´Wˆõߎÿ´wŠ>xsáw„üCñ‹âð§H_†zç€n5/üEºø5¬ø³Å¾:ÿ<8.<%©ø® !ý«<)ñSĵWþ*ýŸ?jÏ øSöœÿ‚‡|!øSá ý¤<5û9|gøÛð£ÁðL/Ú«Rø‹¨j—> ý¥þx.×CÓ~'ø[ÃqxoÇÿø‰ñ3Sø)ûfZüEÓ|ã}7MÐ4ËùàŸâ¸Ø¿±¯ì½ñ/Á¿?k‰ž3ø]û[ø7Z±øÅñ IJŽ‹ñ¿öÔÖ<[ðz÷á~x?Ãòø./|<ý¥¾:Xø~=S↗ãjÚ·Ž~Þø‡Ã£Vð®¯ákÉn4  hšÞý†oßþÊ?·ìÝñ×àïí+ªé_?e_„>"ø'¤xÓöð”:@ý¯|ÿgø½áÍÄ)ÿý¤þ"Ï£|GÒ¼SðKFðþ©ñÆÞøcãøÄzÿüðæäEâ€~ƒüNø_ñÕ~ ~Ç— ?bïÚ»Áþ0ø+ûW[øÂÇáî‹ûgxž+ð§Àö†ÐõϯÆÏøûö¹ð÷„~'ëß~Á©ê¾ø}7‹þ=è¾·¼¿ð+x¿ÃpùÚ§ÂÛ&ïöÖ¾ñýç…>7ÛCyûFxwÅšOÆëŸÚÃV_³^‡ûŸ„Z-¶·û7j³F‘ñgU¿¾ø½mñ×ZŽmsþŽ«e¨x¯TOŠV´-ž¯Ã<Íÿ`€ßµ¿Á_ÚgÃÚ÷~þÕÚÂïÞÿÁO,¾*^ü^ý©| ñ£Áš5‡Šÿl¿|Qÿ‚u\i¾ºý©~*êú6á/Ù‘>*xwð?…d×txÃPµñÌWÚUü^+°ûwöÈÿ“Šÿ‚NÿÙÿüFÿ×YÁK(ïú( Ìø(×ÅŸ…Ÿ¾'ÿÁ.¾)|kø—ðÿàÿÃ/ þßþ3ÿ„›â/Å/xwáÿ<;ý·ÿÊÿ‚ŽxwFþÝñw‹5-#ÃúOö¿ˆ5}+BÓ?´5 ·ëžŸ¦Zù··¶ÐJèðö/ø%—ý$³öÿÄÈýùãÐÿbÿ‚YÒK?`üLÙ×ÿž=ðö/ø%—ý$³öÿÄÈýùãÐÿbÿ‚YÒK?`üLÙ×ÿž=ðö/ø%—ý$³öÿÄÈýùãÐÿbÿ‚YÒK?`üLÙ×ÿž=rþ5ÿ‚•Á~$ø_WðGÄ_Û÷þ ±ãïø‚­µïx×ö©ý—üSá}nÞ ¨/`ƒWÐ5ÏßéZ”0ÞÚÛ]Åå¤ÉÕ¼¢X£uó/ˆÿðZø$/ìßá/…6ûjþÉ^#Ñ øÖ×Àö¾5×´ßiÞ%ñ.àï'†¾| øI᤽ñgüâËß ø+Á¾ ðÌú^—>©ã SÁ~ ñ0ºÿÃØ¿à–_ô’ÏØÿ#öuÿç@ü=‹þ eÿI,ý€?ñ2?g_þxôÃØ¿à–_ô’ÏØÿ#öuÿç@0|^ý·bÿÚSö´ÿ‚Vøötý¯?fÞ7Ò¿mÿŠ>,Õ<ðSãž*Ó|+cÿÃÿ‚‹è÷Þ&Ô<=à_kÚ½Ÿ‡ìõ}{CÒîµ›‹Hôë}GYÒ¬¦¹KFÒ)€?g¨ €?à¬_ò‹/ø)gý˜í‘ÿ¬ëñ€ø{üËþ’Yûâd~οüñèÿ‡±Á,¿é%Ÿ°þ&GìëÿÏ€ø{üËþ’Yûâd~οüñèÿ‡±Á,¿é%Ÿ°þ&GìëÿÏ€ø{üËþ’Yûâd~οüñèÿ‡±Á,¿é%Ÿ°þ&GìëÿÏ€ø{üËþ’Yûâd~οüñèÿ‡±Á,¿é%Ÿ°þ&GìëÿÏ€ø{üËþ’Yûâd~οüñèÿ‡±Á,¿é%Ÿ°þ&GìëÿÏ€ø{üËþ’Yûâd~οüñèâø)·üÛþ ·ãßø&çüÀ¾ÿ‚ƒþÄ4ñ¿?bÚ¿Â~ðw„ÿjÿ€Þ#ñW‹Ñü=ᯠx{Gñõ毯xƒ^Õï-4½FÒí.µSQº¶²²¶žæx¢`Ýê( €<ÿâ—Â…Ÿ| ®ü-ø×ðÓáÿƆ^(þÌÿ„›á×Å/øwâãìÆ™§êv¾Uí•´ñ€|ÿ KöŽý˜âû8|WøûC|Ñ¿âa®þÉ´Š®¾,|S»Ñíÿ{©éŸ³íñKÇ:GÄÝ'â¯{«x«Æòh_¶ßŽÿixóÄzÃÿÞ ø¥ûü]Câ…À>€øûKü,øýÿ N…á}[þÿ‹_ ¿±,þ:~Ï~0¿ðí—ÇoÙóÄ~ þ×G‡>1xD×¼Aÿÿü$ðëz‡Ãï韈>|iðu•·Å/ž?ø›ð—Äñæ¸ïôðÿã¿lŸ|`ƒþ%ß¿møG>|pÛþ‰áß~Ôþ±½ÿ†XøÕ¬lþÁð—‡?á{øJ?~Çþ#ø»SñWÄ_‰ÿô_ø&/ìùðëF·Ó4ëì}ÿ@P@P@PÈ¿fýcNñÞ»ûG~ÌÚÇü Ÿ´=÷öeç‹<#âøïJýœik]GÓü;sᎿ´i |LÒôí+VÖ¾|IÑtW^ÒlüAg¤ëÚ‰t=sÃzÿ‰þüKø{âü_øAãoˆ>!ü?øƒâ€` € ( € ñÿ~ þÑ~°ðwƯ‡¾ñî“¡x‚×Æ~¼Ô¡žÏÅ_ ¾!izv«¥ø{â§Â_hóéÞ7øCñƒÁöÚæ«/€þ/|1ñ„þ&xQ¼“Xð_Šô-]b¾@ ø[ñ/âŸÃè_³í§|@ø‰â _ûOþßí?áO„þ#Õü ñÁÚ¨k7¿ðÐú—Âÿ·Ã/Ù“ö€ð–ŸãOøK£øað'ö‚Ö5 xÛö^þÉñŒ|}û(~Ì _ÐçücÅžðì—áïxëÄÞð_‚|ûoÿÁ-¼Yãø³YÓ¼9á_ øWßðSÏÙXñ‰¼MâbæÏIм?¡i6wš¦³¬ê—–ºv—§ZÜß_\Ám²¨Aÿbÿ‚YÒK?`üLÙ×ÿž=ðö/ø%—ý$³öÿÄÈýùãÐÿbÿ‚YÒK?`üLÙ×ÿž=ðö/ø%—ý$³öÿÄÈýùãÐãø(gü‡â¯à¿xÿöäÿ‚axç_øo®'‰¾kž0ý¦?eOjþñ$sY\ÇâêZׯo|-®%Æ›§\&­¡Íc~³XYJ·KX;ïø{üËþ’Yûâd~οüñèÿ‡±Á,¿é%Ÿ°þ&GìëÿÏ€ø{üËþ’Yûâd~οüñèÿ‡±Á,¿é%Ÿ°þ&GìëÿÏ€ø{üËþ’Yûâd~οüñèÿ‡±Á,¿é%Ÿ°þ&GìëÿÏ€>`ø½ûnþÅÿ´§íiÿ­ð/ìéû^~̼o¥~Ûÿ|Yªx;à§Çß…?3~Í´¿Ž¼«oÔõÏø@~ |(ÿ‚zø+â_†|+y'ƒ¾ÿoü'ñ&§áÿx·ã½þ½ñðþ÷ÿ‚hÿÃLþÆÞý¹þøOûGãoì]ö¯øX¿Ø:ÛðßÄ?x;Jþ—¨ € ( € ( €>ÿ‚±Ê,¿à¥Ÿö`¶Gþ³¯Äjûþ€ ( € ( € ( øéð3þŸü"þ5ðWŠáV~Ð ?¶î¾ |e¶Ñ?á"ÿ„wþ?ì‡ñoÃïˆ^M_ÿð´þ|Sÿ„wÖ¾Þøÿð‘ÿÂ;àÿøÆ ?h…Ÿ~7|,>|tÿ…§ÿ O‚¼káøUŸ´ÂÏìKoŒ¿®µ¿øH¿áÿ„û]<%ñ á÷‹_Hðïü-?€ÿáñ%ïÁߌV~ðïü$ðŽøÃÀ>?ðÂÏÚágÆï‚? 7þ?|ð¯íðoâÁ_ê дŸø~m6ÓÆ> ºÓ´¿ˆ_ ¼Ug<Ç~-ü+ñ©¥k–ÞøÁð‡Æúw‡¾'|!ñìZUæ£à‰žð§4x×WЬ¥@ö/ø×â¯Úö`øAñ7â5‡‡ôOŒ“ø~÷Àß´?…|'k¨ÚøWÀµÂk¿j†Þ:ž«â5ü5ý ü ñ+ÀZ6¹aâè"Ó¼9m¯xcÆÞ4ðÞ¥¥x«Wú~€ ( € ( € ( ˜>5üñV¡â«ÿ5øWö‘ð¯‡í|14^'ºÔt¿†´7Ã=/QÕuË€Ÿî4=+^Õìü?g«ëÞ#Öþ |gÑ<9âˆ_²ÿÄ/øÅþðçÄ/…ßÿhÏÙÓöŠïþ |kð¯Ç/ êî…aâ ø“¾ ºð7Å?…ž9µÓ´¿‰Ÿ¾&izv•«k_ ¾$èºN«¯i6~ ³Òuíĺ¹á½Äÿ~%ü=ñ?‚~/ü ñ·Ä?ƒŸþüAñ@°P@P@sþ,ðŸ…|{á_xÇ^ðÿ<ãOë>ñƒ¼Y£iÞ#ð¯‹<+â=:çGñ†¼MáíbÚóI×¼?¯i7—š^³£j–—Zv©§]\Ù_[Om<±0È|Yâ¯ÙÿQø{û||ñ7ˆ¹ÕôkŸøêoìmgƾ?Öï.õ?øE?g߀Þ¾±ëß¼u{¢M/Œ|AâKm7ÁßMÄž·ÔuÝnïÆ_ €<þ;|q:eùñW¼૧ø•¦Ø|_Öü4ÚW‹ü;û8i×·úEƒ¿fɠÝ^|uý«>"¾«¡èÚ¸žÆÿÃ~ñˆå¿²ð”ÑIðûÁ_€$Ö~>ülgĉõŸøá}ô~(Ñ­üow¨^ø{\ð¿ìgð²[}.mOñ&¥Ž¢~+~Ù_´ÿ隦ƒðÚÖâûá·„n¼Aàˆ%Ó|M¦hußí>í{ãçÇhSâËë¿þj6:vŸwk£xÞïE“Cý˜~Eo}wsûGþÓºÌPXùß|agcªjÞ øáýSEÒ¥¶™¦jz€²Ó¾ xóÃõŽÿíµ.¨xJÏPÓ|¦?ß üS»Ñ´H|-àý¢Úÿí£ûcjzf— ^xÃz‹øgX_†¼¾Ôõëm#Ä°ø’çE½×uéÿf„ÿjoõÚ;þ l|+©ø3ÇËöñÅïÁ? x÷Yðÿ‚|{ñæYàš?·öâÚ“âgö^¦Øü*ø+á»^ÛûÃþðÕ߈üO Üø«]‹FŸW›Áˆîoüyø½wyà ø—Føµ¦Þü?Ôµ†–ÚbøcÂ~"ý²<w›³ñNtnÏà¿ìoð¯þm6çþø-üGãOɨøRëMÕ|QgaáÝ/öšøGþ ƒñ‡ãw„?cÏÙ»á$¾(ðï|û:kß´gì›ðã]ð—ü"3øÓöÇ›ö=øíñöjø/à߃¶Mj|;¤|.Ó¾ü ð§Œ~.ütÖ'‰®õ›››«k¿ øoKñ.º,|qøïñáßíCÿíøûâïÙxŽOâÏíûüXñßÛßIà }{öˆðí§Æ ö^ø§ø£ÂÖ’xÇÄS~ÑŸ°·À_Ù£RøÙñÅžӛğ<[à½6ÇJø…ã­.÷ödúßÅ?> ü@ð—ˆ|ñsYø;ªx Æ^3×¼ûJÙÁ£xâ¿Ãï éZõ²xbËöøAá]ÂW_ðÑŸ¼gtžø½©xÛ@Ô4;K[Æ–ºo€tùµŸ ü=ðxù³xãÃÿµ/ü]ÿZƒâ?ÃÝ7ÆmðîÒ÷Åz…#Ÿâ/†õñ?à‡<+áÝ_Åÿþ#øëÀÚF³ðÂïãßÁ½#Ç^ÕüE¥x£áψ|#á_ŒºÁÿoð[Å õφ0x¸ý ÿg/ø)L߶çìþÿµìõñ'Àžø_ñ/ʼµ»ñ½¤wì}ð{Ã~#ñ…#Ò<3ð@Ö®>Z½§…/4_øóÀú}×Å/‹ÀHx‹ãßÇ+9¾#=Žµàêw„4›Ï hŸ§Ñì´ïƒ?Cjͬ~صխ¯‡ï4Ýv/ë—? þh‡ƒ§Õ Ðï´ßꞺºñƯð$Ϋñ×㌶¥cá;ïÝj6ÿ à <ñFóCð÷ˆ»¯Ùø'à¸l~:üg’ÿÃ1xW[Ò>%Auðæþçàþ“©¿†üâ_Ú·ÄÞ^ˆ~7x Ùø{P·ø#û)ü9—^Ódµñ•¥j>*ñ”Ú¶•y¤nÚÏà]ãHm'ã÷ÅÇ‹áƒé>/ðÿÅ-:ÿÃzÝ÷„/´|/á¯þÚ¿çÓ[R»²øK£Ïe­éß ?d/†ñëIswñcTºñ'Œu]>ÛÂskš.–þ0ý @¢üyøÄ øtÚŽ¼+ã=:}{_OxáÍŽ€[ãÇÆKXuÛÔý–ÿe}^¶E¾øà¶Ñ5fø…ñÃÆšÅÍ–‡áV®i°øóÄß €iñïãi^oøóÁPE7ÄûûOŠž-ð$z?ˆ´è|qmª^Øh_±'졦êš5½ßÅŸYê—@ø¿ñ[ÆÖÛ4»›OˆxE𦭪IáïÙ¨7øíñÄé—çÅ^6ð‚®ŸâV›añ[ðÓi^/ðïìá§^ßé>ý›¾Ï&ƒuyñ×ö¬øŠú®‡£jâ{ÿ øSÄ~#–þËÂSE'Ãï|B“Yøûñ°iŸ'Ö|Wà…÷Ñø£F·ñ½Þ¡{áísÂÿ±ŸÂÉmô¹´]?Äš”:‰ø­ûe|ZÓüK¦jšÃk[‹ï†Þºñ‚ —Mñ6™ i×´øµïŸ¡OŠ7/®ü?ø}¨ØéÚ}Ý®ã{½Möaø!½õÝÏíûNë1Acç|Qñ…Ž©«x'à?‡õMH–Úf™©êËNøãÏ _Ô>;üo¶Ô¡á+=CMð˜ÿ|+ñNïFÑ!ð·€ö‹kÿ¶í©éš^yà ê/áa~üðjø;S×­´ÃâK÷]קý˜@?+ÿà­¶WÅþÈÿ~jëiã…ß´ìûp|&øS4:ÿ‚t?üc£þÆ?~0k´·Äo‡—¾ðï‡<û6Yü-ø_ñš÷Bÿ„7Ä:?Ä[ßèþÓm¾x·AøŸ4Ÿ À>îý›ÿkÿÚã„|ãô3Wµ¿›ãÖ‘ð[@±Ö¼-k®þÝmàŸ‹þ+øwà¿ÚSúŒ>}7àçì9¬ü:øÝáÿXéÞ-ñ^¯£üMð®‰ã‰šf‡á›ßÚ¸Óü=ñ÷ãÏü+©“Ç>ø‹¡\ÇâIáÖ¼gáËm_ö¬øÎ?µ.æø;û8èz”7Výþ¤w‹â?~.Öuj]#JÓf¾ñ”zv“âÿê@i¾1ðGö÷¼+¬X7»¯Ùø'à¸l~:üg’ÿÃ1xW[Ò>%Auðæþçàþ“©¿†üâ_Ú·ÄÞ^ˆ~7x Ùø{P·ø#û)ü9—^Ódµñ•¥j>*ñ”Ú¶•y¤nÚÏà]ãHm'ã÷ÅÇ‹áƒé>/ðÿÅ-:ÿÃzÝ÷„/´|/á¯þÚ¿çÓ[R»²øK£Ïe­éß ?d/†ñëIswñcTºñ'Œu]>ÛÂskš.–þ0ý @¢üyøÄ øtÚŽ¼+ã=:}{_OxáÍŽ€[ãÇÆKXuÛÔý–ÿe}^¶E¾øà¶Ñ5fø…ñÃÆšÅÍ–‡áV®i°øóÄß €iñïãi^oøóÁPE7ÄûûOŠž-ð$z?ˆ´è|qmª^Øh_±'졦êš5½ßÅŸYê—@ø¿ñ[ÆÖÛ4»›OˆxE𦭪IáïÙ¨7øíñÄé—çÅ^6ð‚®ŸâV›añ[ðÓi^/ðïìá§^ßé>ý›¾Ï&ƒuyñ×ö¬øŠú®‡£jâ{ÿ øSÄ~#–þËÂSE'Ãï|Bù_ö¸øñ:×G»ý¦µOŠ_g_‹²ï‹üG®7Š¾%üKðÃïß³OÁˆÿåð;~Ï´ÇÆKox÷_ñ·ÅÚwWñ·ÂŸ‰Q|/ðýŠ~ü:øéà/Ù/➣ðßãj|ðŸ„k° ?gø)_Ä¿Ú—Ný§µÏ éúwÀ«…ž"ð‡‡-ê²7ÃßÙŸâ_‹|>‘û~×"øÇð§á?ÆŸµ‚|ûcñÓã|Ú¬>Õtoøoø'áoÍáÿ x¿ã쬖Þ'ý¨~7Ýi~†Çàì÷á«‹›gðÕ—†´+oø±æ¼’+[½_\ðG€oüyø½wyà ø—Føµ¦Þü?Ôµ†–ÚbøcÂ~"ý²<w›³ñNtnÏà¿ìoð¯þm6çþø-üGãOɨøRëMÕ|QgaáÝ/öš¥áï¿.á]Lž9ð¯Ä] æ?Oµà?[jÿµgÆqý©w7ÁßÙÇCÔ¡º°ðïìïðÕ#¼_ükñv³¬ëRéV›5÷Œ£Ó´ŸøÿR“Høõñˆ/‚?·¼má]bÁ¼yâX¾ k_ m´ fˆ4iµÉ,?b¿ÙKK×ì4ÑãøF'ðΫgñ—ãwŽ¦¶m3NðÇa³ßßø“\ý›@!OÝ#‹Ä^>ø{áøW✺ÆOø/ì>4Ñþê±\YØxKö>ýžígðÚêÿþ>øŠélt+ñ™5¦­^x­ôéú—…¼àÐjþ7ÉmâxüAã|4ºˆžÓ>'ßÚMáÿ韲‚µ!¡ |(Ñ®-ô`|gý³>1EâM=;ÃE¯x Á:·Œ|=wká¯Xé^Ñ?hPx—ãÿÇ#'Ä–ü9ø[ ߇%×ôÿj:© ~Ç.-äÔ!ø…ñŸU·Žàx¿ö›ø—ct×>ø3¤k«ðÿAKŸÛÜÞx‹GÐõß|P›Ä_þ9YÍñìu¯x?PÓ¼!¤ÞxcDø¥>e§|øBVmcöÃý¬î­m|?y Þë±x\¹øoð @Ô<>©‡}¦ø§TðåÕ׎5 u_Ž¿`Õµ+ ßxvëQ·øoøIàÏŠ7š‡¼Aâ½ +˜tïþØÿµuÖá½$ü%øU§K§Oqà_‡¾ Ò|/¯x³"W¶ÑõÝ~ÏÁ?Àcñ×ã<—þ‹ÂºÞ‘ñ* ¯‡7÷?ôMü7àßþÕ¾&òôxšÚ•Ý—Â]{-oNøaû!|7ZK›¿‹¥×‰2Zîާì·û+èÚõ²-÷Ãÿ¶‰«7Ä/Ž4Ôn.l´? ê°sH½‡Çž&øLÛO“JðÛx—Çž ‚)¾'ßÚ|Tño#ÑüE§Cã‹mRöÃBý‰?e 7TÑ­îþ,øúÏPðôºÅÿŠÞ6¶Ù¥ÜÚ|@›Ãú/…5mRO~Í@~П~:þÍ^/°ý¤|#©Úh~"øÑûKüøKûo|?øSá량_ ü á]kTð‡ƒü3cáYôOø’ÁGü ð‡M¶Ò¬[i‹á ø‹öÈñýÜZlZÏÄ :5Ò5»?‚ÿ±¿Â¿øI´ÛŸøOà·ñü`¹ÿ…u2xç¿t+˜üI<:×€lü9m«þÕŸÇö¥ÜßgR†êÃÿ³¿ÃTŽñ|Gñ¯ÅÚγ­K¤iZl×Þ2NÒ|_ãýHM#ã×Æ ¾þÞñ·…u‹ñç‰bø­|5¶Ð5™þ |TѦ×$°ýŠÿe-/_°ÓGŒáŸÃ:­ŸÆ_Þ:šÙ´Í;Ã5†ÍüâMsöm…><|ktŽ/xûáï‡á_Šréÿ0øoâ÷Ä¿„ž'°ñÅì¿¿io†³ïí-©ÁðBÿö„Õ¿á‘~7ø Ã_±gÅË_ˆŸ¾~Ôþ#ðÈé_ˆ¾=ür³›â3Øë^ð~¡§xCI¼ðƉñJ}ËNø3ð„6¬ÚÇí‡ûYÝZÚø~óA½×bðþ¹sðßà¨x:}R ûMñN©áË«¯jÿ@,ê¿~8Á«jV>¾ðíÖ£oðÞð“ÁŸo4?xƒÅzW0éÞ)ý±ÿjë­ÃzIøKð«N—NžãÀ¿|¤ø_^ñf“âÿüRÓ¯ü7­ßxBû@‡Âþñí«ñ^}5µ+»/„º<öZÞðÃöBøo´—75K¯xÇUÓí¼'8ñV¹¢éoãÚçÚkö½ý­þþÌ-ø—ðvÛCý¡þ)ø_Â_õ? i_ ¼¦øÈ~Ñ´ÕŽâ9ü7û5þÎ äÖ¼'âψ_þjzUÿŠ¾;øûKñ&£ñ“Ä >øÇÂÿ`Ö~.^_Áàó-ÿ‚…þÆ^.ý›dÏØ{ãÇ»/‰í‰ûc|Qý·þ*~Ò>0ø™w«^øšÎïBñÀm#Ÿ ¼c©ê¿<[qâO‹ÞÔ5|[øÍ®jÞðo<9ã¯Ú÷à¯ÅQñ3àçŠt_ f_ðI?~׿ðLÿÛ öúý…4ïX|ÿ‚~øß⟆ÿjO†ô›éþ.|?ýž;üo¶Ô¡á+=CMð˜ÿ|+ñNïFÑ!ð·€ö‹kÿ¶í©éš^yà ê/áa~üðjø;S×­´ÃâK÷]קý˜@!±øéñ¾mFÖ êº7ƒü7€üð·Šfðÿ†<_ñöVK oþÔ?î´¿ Ccð?ö{ðÕÅͳøjËÃZ·ˆüXó^I­Þ¯®x#À7€‡~<ü^»¼ð Ð|K£|ZÓo~êZ‡ÃKm1|1á?~Ù?»‹M‹Yø§FºF·gð_ö7øWÿ 6›sÿ üþ#ñ§ŠäÔ|)u¦ê¾(³°ðî—ûMRð÷Çߌ?ð®¦OøWâ.…s‰'‡Z𠟇-µÚ³ã8þÔ»›àïìã¡êPÝXxwöwøj‘Þ/ˆþ5ø»YÖu©t+MšûÆQéÚO‹ü©~€ø6ïÄwþð­ÿŒ-ü?iâÛß èw~)µðž§w­xVÛÄw:e¬ÚÝ¿†µ›û.ûVðü:›ÝG£jwºnw§-µÕͤҽ¼`þÒ¶Ÿdø­à¿[èrhÓx{¯£êŸ|IqöÛo…¾ñž©©è—>ý›ü%)¹~Ô_/Ń,ïtÍ.çûÃÖº3k «Í¨øká÷À>sÓln|?eà8¢ø}ðïáMÇÂ/^˧YßkúO‰|û ø/ƦC{âOJ/5»ŒŸðPŽÚ‹f··Š)<[aá}GÇ×2kZöŸâ_kŸµ¸e–{¥évöÿ üàIþxûWø¡á|Rñ]¾½á¿Ù§ÃÚ‹jꟵïí©Íâ)ÿá4ý¦üo%׉¼_ðçÁ¿Û:†³§\kvíyâÍêÃâÄ__»Ò®aÒ5Í/Mø]á]öÞ7ƒã_ƒ|ñÄ–VÍ.­ot·7ÿðP/ÛóTŽïOž=;F»ðÔš¿Àÿ‚ðͦ‘xSBI4ï ë~Ñ?á Ô|=7ˆÄ Óá6‘ñÇǾ$Ðü}áo|Bñ5ŽŸâoÚźBï¿jÚ¦Xšâ×Àÿ²W‚'Ó¼=gðÛáäº5Û]Ùx_OÓt)¹øuðí@>+ý²´øõߊ?±/Šµ…~ ø×à?~ÙVw^4ñF»ãKk¿µ·‹|QûþØŸþjÛ~,:/¿Ø?KøËñ×áWìùáÅxÖ‹ øíaá Áž9Õ¾%h¶ßµHÛ76óø›Pñö±ám#â]‡Å‡ºW„<[⟇Úý®âÚïÅZO”ö¿³ÏìÃauâH¿á_~Çß í¯uïøX>0Õõ6Ã^¶Öõ [TÕu(eø‰ãï€|Mû iWþñWí©ð¦çÃÞ|0ý¬>/ü*‹Ç_üGe7õè¿iO|)ý¾|wû~È6ñk:ðÚøsö€ý¥~1è?ø«ðŠ]ႾÏ,º?<)}ñkö|ôÚ¿à~1þÏï|რ~/ø/áíîðÇš‰õfø[û$üuøEâ=/â—ì…û2þÌšg‚lηãý¢¾|ñ7Çé~¼Ò5{‡zŸ…µøƒIŸÂ?|,곧Ŀ üSøAû7|wøgá/ü/ð¥ðçÃ^<ø¬¡Óµ]ö+ø+ñ÷Â:/Šk5ÓiÍöxø›{iñöuøéè¶^)øqáŒ:N™¥jvž(øañ+J4Ïi6úŒ ~0xo[ð¿Á?ü_øy-¿…¼áõþäcoÛÓöeÿ‚|)ø“ãßÙ HÐþ$.‹ñ+Â>*ñÂߎú½Ÿ…¾%0øoBñ&·ûZÁB£Ó§‡ÃÖ?þtÛ„~ ø_}â߆ÚÞ¥ðÆëÃÿ .mçðg†|û?€}É­è+âüqgeð»Fø¯añrçLñ†‡âíNÑü]ûkø³ÃYÚÇñ3âõÜ’j°ü>ýƒ~Cw¥C£ør}7]ÅzDÖÖ‚u­]ðׄ>:€Iâ;sâé¼eysà;ãe¿Æ?XiºÞ§ øƒLðÏ‹n¿ø}£’Çá¸nµ»¨~~Á? a×oañ·ªê—6þ8±ñö©©ÜxòßÄÞ3ñ·í(Ùí®u;©uÝkÞñŒþ2ð ·ÂïøßáF±›­|rÖl,úØçö†ÿÄEσþ èW¶ZÍßÅ/‰—ºÇ†lþͧj——z¥¾¹§x¿Ç_ <‡öŒøµ?ìëðâ§í«xá©“özý™>3ÚøÃUøoãøB<ááÃíÅzwü×ö#Ö´½ëWÐ|I¬ÝxËOøëûBéþ†÷ÂÖþ½›LÑ,ï|àÿ‡ÿ³Õ§Á_ø)Î’t¯ ~ÉßðM jž´ºð/Áéü?ûv~ÑvÚWÀ߃zœâÏ]ðÿÂoÝÁ2ïtßüWñ†-^øÑzºÄú…Ü1ÌÞ O ð{X¶ø3ÿ1Ñ`Тðì‹ÿØðÊü0»‘?gÛ¿o?Ú?VÐþ Aâ3³â_#Òuø&Ußü'ß´7-µ¯E'ÆÏ]êI—Ä+uÿV§>½ñ¥¾5€SOŸðRÍ.ÞÒ×òübÖÏÀºåߎ> é^%ý¿?j?hþøµ­#^xãwÅ }Cþ ¹m¨ümøÁ{â+í{ZÒùïö¾ý„ÿशOìÅûB~Î?g?ø'Œ~Óßnìþ/|I‹öòý¦n†ÛSýžü_ºßþ ½¥ßéßÿgˆV–|!ðF×4ȵí_AÒt¿|GºÑø3á.•û"Á<âð^›ð›Á?¼ym§ÁG?k˜uŸüøWáÝ3Âß ~ø7ÅZ÷ü“Å(ø}ðGk^»Ö3°¼ñ%½ßÆßÚkP#j©§ð÷\Ñ5/ˆºÄÅðKþ [£e/ƒ¿d?ø&ÖmðïZŸ^ø¦j?·ïíCâ­+á߉|O‰>&|Tñ<:Ïüaï¾-|{ñֱ㋋/‹¾1Ô¾Ùáùüný¡u¿ØÇþ ñ¬|9ý—~üMý®,|.ÿ·íãÍ{Yø¿ðßÁÞ#ø‰ãŽ?`Ö?ྠOŸdMŸ‡Vú÷‹~iþ×a·»‹Ä6z¦ŸàÏøéŸh÷—þ/Ó´/…zˆfÖ¼_¡|[ð‡~0xšÇKÖ>*ø§NuŽûöëý¸%³m(xg௃gðöŸqðས•ew¯ô}3GðGƒo4Ÿøà0oA_Ïã‹;/…Ú7Å{‹—:gˆ¬4?kúvâïÛ_ÅžšÎÖ?‰Ÿ®ä“U‡á÷ìð’½*Óéºì~+Ò&¶°Ðü­hšï†¼!ñÔOÛŸMã+ËŸiß-þ1ø2ÃMÖõ=Äg†|[ûuø¯Ãí–? ~Ãu­ÝCð³ö øK»{ˆu½WT¹·ñňïµMNãÇ–þ&ñŸ¿i@˜> ê·¿íCáü[ð'ìÍûëZ¿ñö‚ý˜ü{ã«ŸÛ·ãïÃÏøÛáWìÇñãâìù{ðóàÝ¿ƒ¿`ˆúwÀ/‚þ.ñÇÂíGÅqiþñ¯Ž¼CâŸjð_j$Ñ|q{m¯xlÙÂ/ø)ûKc¨Cû*ÿÁ94nÓH¸ø[§j^ ý¾?hïEðÛölXÞ_‚_,4¯ø&?‘ðbmQt¯IãoˆúsëÞ(ñš=Ô:$~Ót_ƒwÁ@ VŸà§:IÐn¼5û'Á6<)ªxÒëÀ¿§ðÿíÙûEÛi_~ ês‹=wÃÿ ¼?uÿ˽Ó|;ñ_Ä~H´}{ãEêëêpÇ3x-<4ÁìbÛàÏüÇEƒB‹Â?²/ücÃ+ðÂîDýŸlbý¼ÿhý[Cø5ˆÎω~ÁK4»{K_ þÈðM‹[?ë—~8ø/¥x—öüý¨üa£ø_âÖ´yâ?ß-õø&嶣ñ·ãµíkHñ®µ«xvï﫼ÖÏâ{âmHâOÙ·þ 5ûh~É¿?j_Œ_ÿfOØj ~Ðú7ìϬx{à7ÄOø(—íâß„Ÿ ~5þËÚÄMáÿÄ4Ò´Ïø%Ï…5/|?ÐÏ‹´=gáÿìý§j øgð‹XÑ.‡Ã›}FÑ~èß@)~Ù?ðI_ÛoöÇøû3|^ñgìÃÿüÓ¾'þÌ´‚?i Æ:çíïûEøâïâçaø‰ðÃÄü-ñ×I¾ÿ‚fé>ñ§Â~ø7á÷…|¡h¾›à캑sá}oRø{¯ð›]ûÒO‚ßðRÝz=jÓâì›ÿíñÅm/i“þ ûHiÚ·ÇWCŠ+ø;ZÕßþ …©ËáïÙç¶÷ZäVŸ´è.í5ˆ.âÓ|Oã sBñÆM#ã7ÿà§ÚüšÏeÏø'~¹¨üGÐmü5ñëVÒ?à ß´÷†uOˆÑ•?áøMà{È?àšz„¿þiFïÄêÿô³â-SÅ–úÝÕƹãIµÝOÆ:ïŒ,Ûü!ÿ‚¡‰¾ßqû-Á9ôýoVћᧈ5¯þß_´Ÿ‚ï|?û<Ø´Òhÿþ=‡ü2éþxvõìü8¾:ñ'‡¤Ö.E·«x‚mÓNð÷‡4{Oh¿€ 3à¿üÛÃGE—ÁŸ²OüOÁÓ|:[¯üHý¹ÿhK/àWüF‘[|@Õ<¡kðLMWGÔ¾<øÎÂóÄ–÷|Si­@ª¤ŸÃÝsDÔ¾"è@8ÏÙçâEïÄŸhž!¶øYðOáF¹ð#ö—ý¤>ëZU·Åmgâ·Á_ÙûàÇlj_þ3ü~ñ×ÄOøkáÇŒ?hÚãç<ãýsྣâï‡ú‰†‰ñG×ü]m¥OªüE×þ&€{TZ=εÓ>xíῧÆÏ øoã/ˆá–Ïá°žK«ýköôý»5)uË;Ýgâ6¡q¥jº·Á†¨§ˆì5]'M¸Ôµÿjú±â_ÙȾ Ñï.-ü_§h_ ôÍ­x¿Bø·àÿü`ñ5Ž—¬|UñNœë÷í×ûpKfÚPðÏÁ_Ïáí>ãàÿÁ{M*Êî+_èúfàÞi>ð7À`Õ5¯ÿiŸß~~Ë¿¾2xMøQðöŠøåñö¨ý£üsð+Rý­õO‹¾6øùà_„—É¥|6ý™?j)uÏÙ³Áw_³_ŽbÐþx˜øGñ‡wá9´ë=Sá¾³«ÃãpHÔ> ÿÁM|Tú¼¿eOø'‹.¾(éXþÑúŒ_ðPŸÚ_EÕ~0éÚ!¼ðËL¿þ ‘{'ÿÙçÂãPñE´¿ôõ×.|]i¬"øìü_†Oƒ?ðT-Viu?~Ë¿ðN»¯øÃA‡ÀŸÜÛÁ5/®þ|3—Sò.|I¦è—~%×¼Eo&£3øŠÃÅ3éž.Ñ@-Ÿ„_ðSö–ÇP‡öUÿ‚rh:ݦ‘qð·NÔ¼û|~ÑÞ‹á·ìر¼6¿¾Xi_ðL#àÄÚ¢é^“Æßôç×¼Qâ)4{¨tHü¦è¿4ï‚€­> ÿÁNt“ ÝxköNÿ‚lxSTð¥×~OáÿÛ³ö‹¶Ò¾üÔçzï‡þx~ëþ —{¦øw⿈ü0‘hú÷Æ‹ÕÖ'Ô.áŽfðZxh7ƒØ#ijoü#Ä~¹ðçìAÿ¸¾ð6‰¥kÞø]àþÛ?¼sðçÀÞø§\èŸ5x#ÆðLcHø¹ñ›âÖâoˆš6»ñKâ@Ö´ä³ñ\é}ài6€|YûÁ.ÿৱjGÁý‹~*|1øÃûCOûZ~Ï¿ ¿h/Û÷öø«7ìëûHøÇÃÐè¿~-xËâE÷ügOñßí9âI¥øgþæ³ñ+RÒ¼EðÂÇÃí.¿ã_ˆ¾'ñ§ÄŸ}á'Á?ø)DVwZ]§ì‡ÿâ¿Ñí5¯øZš6™âÿø(í+âHüWûKù­ymñóãýͧü'@½øÓ¨øwQÓ|-yàÁqàxA´X[O2^x[à­ïÁ n¾ÿÁH51­éÚÿì‹ÿíñ_‡<[©Øøÿâ&™âŸø(Gí#ª_übøͦ8O‹~2ê0ÿÁ0ll¼ið÷Öú†að—Á[Ã~ðô~±°‚yü?e h>±'Áoø)n½µiñöMÿ‚vøÎÇâŒ6—¿´ƒIÿý¤4í[ãΫ¡Å¿„|­jïÿÂÔåð÷ìóá[{­r+OZtvšÄqi¾'ñ†¹¡x‹ã&‘ñ„‚ÿðSí~MNçÆ¿²çü¿\Ô~#è6þøõ«iðPoÚ{Ã:§ÄhÊŸð‹ü&ð=äðM=B_„4£wâu‡zYñ©âË}nêã\ñ¤Úî§ãwÆmþÿÁPÄßo¸ý–¿àœú~·«hÍðÓÄׂÿo¯ÚOÁw¾ýžlZi4€ÿžÃþ ™tÿ¼;zö~_x“ÃÒk*ñ(±½¿ðþ¡àé¿ µß„ÀiðëÆ|?ûMxÃà?ÇÙÿöqøwðKà­ož?ý™þ?øÓ⽟?g_ÚÅŸ´WÃ߆³ì¹ðçÅ_³Çìï®øoöŠñ¾»û2L¾%ñÖ‹¦xŽ/èÚK^XËá–°øoà } áí>ëÂrø Gà†¿åøK6¯áô»Òµ Å~ý‡¼ãXⵇÁ¾ Óâ"Óþ.Á@~7ZxŽÊÒòòÇEñ‹¢·‹®­îÇzN»máïÚ|¥®›y ÿÂ'ŸðËáÿÂöøeñRñN‘¥øßÆ6>#ðÇìuàŸfû^øåñ÷S›Ä:ÂüSý¸~7Zø‡[¿ðŽ”ú·Šäðþ¡ãñsªøÃUµºñçŽ~-~[~×_²Ö•ð£ö„øûzüø+¤i´w„ÿiÙûÃzoÀ?‰.Õ$ðÆýWöˆñ¿cÿÙ×öÃÿ‚–Íiwâ;ÏühøwñÛöº¸ñïÀoø3À~9ø÷á‡ú¾^Z¼7ßmý”À?D¯¾ÁIîcÔìÏì‘ÿëÖtÝCU´ø¡ªAã_ø(/í#⯉_´~žÄé?þ<Üé?ðL? Añ;FðÉÒ¼þ øG£Øü?ðGƒ†­-<<¶Z>ð³JøZ]| ÿ‚ëkVþ*ý‘?à~.Ñ~ ÜÚøŸã…¶¿ÿý£ï5Žž:ÐÚÙ<oñY?ðKñ÷Á_ZG-¦“ð"ÛHƒÃ2ZÇc¤ÞjÓøfOø{Å`jা*}^_ˆ?²§üÇÅ—_tÈ,hýF/ø(Oí/¢ê¿tíÆÞ øe¦_ÇÿȽ“áßìóáq¨x¢Ú_ƒúzë—>.´Ö ž5ñψ5Ÿ|aÖ~/€C'ÁŸø*«4ºŸ‰?eßø']׈üa ÃàO‹#ðïüöœð®©ªü"Óà•ôÏ‚Ÿîm¿àš—׾˩ù>$ÓtK¿ëÞ"·“Q™üEaâ™ôÏh ÏÂ/ø)ûKc¨Cû*ÿÁ94nÓH¸ø[§j^ ý¾?hïEðÛölXÞ_‚_,4¯ø&?‘ðbmQt¯IãoˆúsëÞ(ñš=Ô:$~Ót_ƒwÁ@ÅOø+§ü‡þ ‹ÿLÓÿfKÑÿàÿ³'…f ‹~ð|+ûQþѾ7ð-€¼}?ÃøF4-çöðBè~"ðí¯€d2ñ“ÞjÓüG¿Õl®Ið~›á½3F`Úkoƒ?ðS /þÈ¿ðM ¯Ã ¹ö}±‹öóý£õmàÔ#;>%øò='Xÿ‚e]ÿÂ}ûCxòÛZñÄR|lñ¥Þ t™|B·_ð…jsëß[ãX4øÿ,Òíí-|7û!ÿÁ6-lü ®]øãྕâ_Ûóö£ñ†á‹ZÒ5çˆþ7|P·Ô?à›–ÚÆߌ¾"¾×µ­#ƺ֭áÛ¿¾®óZC?ˆE R|ÿ‚”Egu¥Ú~ÈðN+ýÓZÿ…©£iž/ÿ‚€~Ò¾$Å´¿š×–ß>?ÜÚÁ2t ß:‡u7Âמð\ðç„E…´ó%ç…¾ Þü†ëàOüƒSÞ¯þÈ¿ðNßøsźþ"iž)ÿ‚„~Ò:¥ÿÆ/ŒÚc¤ø·ã.£üÆËÆŸ|9o§øf |±Ñ|7àïGáë'ŸÃöZƒáð |ÿ‚–ëÑëVŸ?dßø'oŒì~(Ãi{ûH4ŸðP_ÚCNÕ¾<êºQ[øGÁÚÖ®ÿðL-N_~Ï>·º×"´ø§Awi¬Aw›âkšˆ¾2i@<£â³ûjü/ø‡ð/Aý©dïÙ¿Å¿¶¯5ïÙ¯âf³û+~Ö?üñ_Æú—…?g_Ž¿´Ã_„žðÇÄŸÙ/ö~ð·ÂÙŠH> xÓž7Ñâ­Ýݵ—ÛÆ~.ñV¤ÑüF×|VôöÔwöúŽ¯áß ‡»ðDÿÕ.nnõOÚçöÇÔnüOsoãÿڋǑͬëß <¯êúÿŠ´ŸkWr·‰tûíâOÄOIeáËC¤iš^•ðŠõþ&ß|`ð?ƒþ0kúk›»k­:çTÿ‚€Á@uKÍ_OžòM&ïF—WøðYšrÒ/x9-tŸë~Ó¿á@*j°ñâ=2Ûàö¯ãˈ?¬¼oáO |Eñ%îâOÚ—Åž{eºý¨¿jÛvßð†þÈ^¹´ÓG€¾kº}Ε{ x{ÂzF‡ðõ£ðÃá­hë:•âˆ~(Dß |Añ‹Oø¿â M„ºí߇:ø$·ßj[ÿÙªûá¬ß|3saãïÛ“ödOŒ?´ïˆºìwàoxÆM'öÆÖþ-&¡®ø§ÅŸkø•ñá·Çkÿ øûÆ6z5÷†µïÛÿö²ø‹à¿ø'Çÿ ~è>»×<+ðŸá…{áz_¥¯Ã›øKKÕôO…¿À?ŠOÛþ ´ýµeÍw[øÑÿøñ¯?h¿‡_Ú¿-~iž±½øiû\jÿ ì|ãKÆŸ|5à ë:¥¿þ ŸÛÁðÂ×ÇF½àïüuñgŒôÍ+À³üþñ×…/<@èß²¿üëñÁ>$øð×þ ‹û?MñòßÆ ªè¿þ"x+߃¿´çŽõO‡Öþ6—Á~-xvïVÒ~Ù|°ñmÖà_ü#ø[á€Ú>“ Ïã¿ø¿Ãßx+öRð¾›ðÛJ¿ý›f|>ø‰À}bÿÁº­õ•ßí;ûIþËßõOéZí¾‹ðšO~ ño¾Ãð˜õö‹øßð/öšÿ‚SþÒÿ¿gi> øƒÁZ/ü[ö¤ðå—‹<â´×¾ þÈ^ñ÷ìÏâ}SCý•¼  µö&ýµ|¤x‹Â:'ÆyuxoÆßô-FkOZiV—þðŽ?¦/< û6üø¡ñûâ|ºå·Ãoƒ¾ ×¾"xþÿþÕ¼U«i 𭌺·‰µØ´ ÚóV¿´ÐtkkÍgTVÓËm¥ØÞÞÌvï@/ÂÚ¯á—ÅøËÂPi¿>ø§Àºw†õkÃÿ>ø—á6©>‘â»o^iZž‰Œ­4Õ×l–×À¾(¹ÔåÒä¹þÈ·ÓãS[X&‚I=Ôø³Â¡´Ä>&ðø}jÒÊÿGS¬éÁµkJîÎÃN½ÓÜæþÒþûQÓìì®-D°Ý]ßÙÛÀòMu8»Ý{CÓ¯-´ýGYÒ¬/ï-ïo-,ouK[Ë»M:/?Pº¶¶ždš{{}{x“Ãþ ø³®xâ^±¶­éñw‰ô_K%”^"{íŸ ÿoxcf¸àhMâo ÛX&«qâ .[÷Ò£Ô¦Õ¬"°“SŽöm6M9/ámÞý5yìÍd7 {Ö­ž7Œ[Õu'C³mC[Õ4íÁ$†¾Õom´û4šæU‚Þ&¹»–VIæt†.Y]c@ÎÀ ¥§.¢šC_Ù Z[)u(ô³uÔdÓ žiïÒÈÉö—²†æâÞÞ[¥ˆÁóÃÈ$•€> ÿ‚±Ê,¿à¥Ÿö`¶Gþ³¯Äjù¿XðÖ“â+oÇcð—UøµoñkÆú½¦é>,ñö‹®þÚ~5ðèòáf|dÔ&¼ÕSáçüãáR>œžðö©ø_Åú £ØøkáÿŠt_xCÂ? ?nï¿ðU?>"øÿá×ìðßþ 1û üdñ~¢øÂëàÖ·ñoÁ¶í!áÿü2ðÜwþд _üNñ —ì‰á¯ŽÞ6ñbxcÂ~|Dð?Š> øKÄ—¿¼O­¯Æ?|lø¬é_±'ü·öÿ‚Ýø±>j(¶øáã„š…¾%|Ôµ;…¿µ/Ĩµ|^<+û"~Åþ Óþ%^iø7g¡ø[øñ·Çÿ ¾ ÅmáŸëÞñgÅ_ÁzΫ¯ø£á€ìwüM¸Ñ¿bÙt‹¿ xCÀwZWí‘ÿ6Ón| ðúå/<àË‹ø)ísk7…<w‰á¨î¼!áÙ"m#ÃW1øs@Iôk;)WDÒ•…Œmü{øÙà_Ù·à·Åßå×-¾|ðV½ñÇ÷þðö­â­[Hðg…leÕ¼M®Å hvךµý¦ƒ£[^k: ²¶ž[m.ÆöðÆc·zä¾þÓ>øÇ«üBÐ4ß|Qð¹ðÃJð¦½âí/ãÃ?ü-º´Ðükÿ Wö±f|]a§Á©iÓønîlæ•tãb ÿÙÖæÙ¥ö‹xV×È7^&ðý°¹Ò.°ƒu~jæþüpøwñWះ>-xV›JðŠ.õ7O—ÆvW Õ ÕôjžÔ´]KIñ²¼Óõ{_èÚ––Ö š[‹cä QÑØæ§ñ«á.ñ7Hø3«üDð–›ñS_ðÝç‹ôo_k6–Þ!Ô¼;c­h~¸Ô­læ‘ Šu¯èzu½¾áyy>¡ØíçDâ»á‰¾ñ‡Œ¾"x#E\“Søcwáûê7Z£iừïi³jÙøwÄsºOˆ®ô¨¡{_[éW7x{QhôýU-®¤XÈM'‰¼7RÏ/ˆt8àƒW_Í4šµ‚E¾ò$+¢K#\Wi¥Š%Ó]…ëI" „³¨ –w–š…¥­ý…Õ½õõ¼–W¶sÅsiyisÍmuks <7÷ºKñ;Å,N²F̬ ±@ÏW왧Í?…|{Ÿ ü=×µ]þ {ÿAø™á˜µ «›„ÿ -tø(×íA§êÿµÏío³QðÝŸ‹ükàdÐï¼+û;ü<žòMBûPð†|C£ø›Ã_Ùš§Ä€@/íÃí§ |ѵ?ø'ŸìÕðÏãgÅ ßÚDøÁ/ÁßÚûZñ(ý£< ø[Ä’x›öÃý¢/ál| ð¿„ÿ²¼u£|7·ýŸþü^ñ…<áOxdI§ü>Ñ|Y |(øAðPóƒötÿ‚é~È_µ_ˆÿÿlŸ¾ ý?ißßü0ñÿŽþþØ>?Ö¼ áOÚoâW‰møoû!|1øEmð×â¿Â/ˆ^ ðž‡âýǺ‚þøãU¾ÿ |WýðýŒ®ìõOø)oíý­[k3ñmεû"Á:/õˆ~$Kí?Â?5„øÓÿ:°½ñÁ/ _xÄ?ðŠ|Ò¾Åü §ZýŽ×Z>Õñ¯ˆ< w{¬hZŽi«jžkd¾Õ<3q Pø“Â÷/t«¥øŸH{­Th®VÎêSo(P é¼eá {MNãÅ~ƒMÔýì5 µÍ2;äÒ¡¸¸ÕÒíî– •Ó ´»žý¡‘Åœ6×ÜÒ@:J(ñâ­œpÁ]þ:x¼øvßI>ÿ‚uþÄÉ}û@ßÌÚÅÏÀ½Ä?à§ú®Ÿ ~Ç&©qã_ÚG✗¾\Ûø7]“ÃÚLßw>½±'Á >$é?|/ðÚÖ?Ù¿àÂOüqøq¦xãÆ|5ûNüMñPýŸ¿cÈ|Oìãã÷í{ã/ 7Äýâ×í{ñaµ½GÄ6ÚV™¼]e/Š"þÌ~2øãg¼ñߎÿiߎ^°ñGÅ/Œ~/|2ð~·ðÛNð†|;âÏŒ¦üo¾¿Ñüg®~ÌzŸ…4 ká`ë_Æ?ˆÿ>,|øñ#à—ˆµ?|'ø™ÿ8ÿ‚oøÛá÷¼ãë?ˆ~%ý õm#þ Uû2ü?ñçíUûOx¯ÂzéÑtß\k¾Ô¾ üø9©A×4Ï iò|>ð=ß„|7ðßö{ýø¡ûyüø;ñÄ¿֧׮4Û>êî °`Ô´ë›Ëí>ÚþÊãPÓ>Íý¥cÔÞiÿmˆÏgöëhäi­>× ´ÖÞzGçÄ ‘o@My‹¾?|ð‡¡x›Åß| ¡ø{Äþ3ð÷ÃÍ[ºñ.™&™ªøÛÅZ­Ž‰ ørÖòÚâxQ¿Ôõ; }Œë¨ºŽâöK{mÓøéûoüýŸ<[á/øÎ×âˆu_|&ø‰ñ×G¹ø]ð›Çô‘ð“á6¥à=+â7Ž.µ?hÚÕºi^¹øŸà 5á7ïmâÍâÊÒé/#$èÏ üEðŒ4Í#Yð¿Œü3¯išüz\º5Þ›­i÷)¨oG>!Ò#·D¸2µÎ£¡+붥ԺtrÞ,>DR:€t–Ú®™z—²YêVqé·w6‹Û^[Ü%…õ˜V¼³½h¤qkwjMͼæ9  ¦TPà ¡ñ7†î4í?W·ñ‡>“«ÝÛØiZ¤:µ„ºv§}yrl­,ôûÔ¸kkÛ»«Àm-íí¥–iîA‚$iAJ—Qñƒ¤^izv­®if¡®M%¶‹c¨êVVWšÅÄMË—ksðßÄK}BïÂÚŠáÖntx> Ø\x\–ßB¸Ô¡Ôn'ÐüNºv£o vúUÞ­²À]ÉÖŽŸ×„¥ñ•—ˆüÞÒ5ëÏEñáØÒ‡Žü>‘e¥¦‹¨é×¾²ðøátÿ †ö7^(ý¢:ñõ¶™oyá‚ž¿ººÔ³gâcDÃjøÃÇþùÇFÑ´ó§ü3Òô¿†$2|@Ô~.x;Áß5B+½Zî-Aïu_ÛëöúÕo_KšÃìio®|ø®>‰®Ykš'‡­m|=á}gÂúf›û€cÙèzwˆ´;:Óá¯Å?ˆVž=øÉyñÃø¨ÜøsÄ_µ—Š|9/‡¢Ÿö¤ýªn¿²-Ÿá¯ìÁðêòËO>ëZUž™­xsôíáΠ·Ÿ > ú¦›£ø›Ãþ4ŒøâoÅû?‹Ÿ,wÃ5Íׇ<]ûyøÇAò-’ÛU7?mO‚ŸðN„iv¶qêQ/†~!xyä{k_h>2’ËöÆĶšo‰ãLÚ§‡>,üEÓþ#kÞð‰üIàé/<7â¿ÚïÄz5¾¹<_²ÿìñh÷6wŸ d‡\^[øÇâA×t? kÖú§Ä}SXñ®¥k'ÄŸˆ>$ù3þ 7a¡ÛþÆ¿¶ŸÄ­F½²Õþ ü"о&GñEºñ­‡‚íþ-~ÇÚÆ—ûNü ýŠÿdë x×OøEá?‹ñO‡ŸÅ²ׯk‘«ëÓÝxoÆ?¤ðOÁ½á‰|Uð–;­Kß³n…¬Máë=ö2ýŠ´½CIüuñÇÆ-gckñ+âwƒt3}¥jºGƒ­¡:Eí·Ãïü>ùâmÖŸðcöÂý€üM{¡xƒàý“ü0ý¥bí;š†4ˆý‰#øÇðŽÃö­Ðµ_xÅSÄ:‡Å/ÛÆÞý‰üuðûUð߃´O‰1]ëßü1­x–ûņ<)àÏÚàëN¶Ðo¾ÁeðóÅÿ eøsáøßJ°ñ¶¦)xcà·†4 |JøUâÏ…¿4?Ú×যñYÔe›áŠ¾xÞ/ê·/íã¬ßê^Ö¼E«ü\Ó´ï|6½ý›&ñ¿„¼ãoƒ_¾'|;Oü»¿ñWÿf oÙ—â}¿Ç¯†? õ¯¿¼?ñvçâÞ•â¿Š¿³OÅo&¹ãŸ þÑZW†< âÿˆŸ¿oïÛø{Âqé>ø?¥¡xƒö[ð-׆<¢|Xøyið â_Âéþ ñÁ}#àø¸Ç¡éý¥äVß~&ü_´ø±ñWOñ5†ŸâmNëÞ$ý·(\ÍàÿŠ?`ø¯âÿ xsT¾ÑÚãÃßíÇâý/~Ïð‹À0^Üjð§¿àÿ ?´fMĺŽªÞñž©xÏSÔ|Eñ Lñ‹|gûH€|ïûXþŲíƒqñSý©eøÿi«‹­GÀ^¾ø¡¦xZ8~)üBñ/ÃÿÞøÂ?±ì/â4>ñ—Â_‚¾×S[~1xgÅÞðî£iª|CƒÆ^5š;ŸŠ,ø\øûJÿÁª±Ö·u_‚?i_šÇ‡¼E­xÇsØxsKý©~ h¾(ñ^³®Ïá/Ø‹öUð%ÍŸÂ?> xoôŸ ëÿüQñž÷EÑÁÒCãm2_x¯ÆöŸ@?•_Û;öý›gÝwàßÁßÙ‹öÞ´ý¿ÿjOˆšŸ…´oü%ý¾¯ˆ>øÄ>5Ñô+ß øÁ¿¼ñƒâ_†?hˆÚÖ±âÂö¾ø- x£FƒÄVþ#ðö¥â­?Å5¯‡µ€½¿gÏø!·üßà‡Â?Ú;ö«ñåý§ì¡|<ý…ÿjÿüCÐü[¦é^,ñõ×Âïþ˺‘‹áÄ?^1ð‡Ãï~Ñžñ÷ˆ>i~ñ/ˆGíðSÄkøûÅ< ¨GðŸÄ^&ÿQÛÇàÏÄÚ?ö&ý­ÿgo…màè~!üýœ~3|ð¥ïÄ {[ðσ4Sâ×Ãýáúë¾!Ö<9á/ëXhø†mi­tß êw¤¶éa´ô½}NÈ㟉ðO¯XøGöañÂ/|3øƒñ3àçí#ñ_ö†ñÿßڇö‡ø¹ñ/¾+¶ý d?Úömøµð›Ný¤|qðwãÅ}OÀ—ßÅï ø‘ ñWÂÛ«_èþŠÃ]Ñ4[›»Ò@>øŸÿý¤>%~Ìÿ²Â}gá¯ìM®üUý›?à´/üÞ‰~"ø¥ñêã´7¼ðÀ¿>>ü8ÕöQ½×¥Ò¾ÿ‘ñ‹t»»£áx']øËâHü×¾oxÈïÛØ—Çú¯í]âßgßØÇãVñ;Ç>ñý×Å?Š>(ño>8~Î:Ÿìý§ü(ñÏìýðkJÕþ6…ã†xŸLñ·àýqüqð7MÔlþ5|EÖ4|HðÞµûGê£önÕto iß>xëÀ¶ |¢x'ãkhþ6ðÄ=A¿Ñï4°‹\ýˆ¿h~Ê¿°Ã/|7ý•~-ø“öA²ðφ~$þÍÿ¾*øïWý—> |!øǧþËŸüWýžî4~ÍÞ4ðþ|]øû |YÓ<+â/‹ZŸ4ã]?Hý”S×>ø[ mñvÛY¶ññ`ÑW_ðOÚC[ýžÿ`ï|cøwû#~×,ý—ÿdÿ~Ìÿ¾ ~Ѿ&küãy¼ ð·Â>ý©´Oj?³ŽuË¿Šoà sFÖ4¿ü¼Ö´ ümñÍ·„>*éWz^¸ÿ@!ð¿ü㧇¿n¸ÿiGÅ_üCàé~7øã•â{?xSÂ_¾øcBø!¤|.Õgÿ h‰û ø›â~µðŠÂïB¹³ðχ-¿lÿ‡Þ¹ð§µi|Ið®÷Å:6³ªüJûSþ Åÿ(²ÿ‚–Ù€~Ùúο¨ø8×ÿàÑ›¸`ñ}÷ÿnüA°:¾—à_ŸÙŸ±jéºíñsv|Euàû+ÏÚ™àðïÀo+é/®þÑ>*¿±ðuå²ø“XðÞ›®ønÇÁúçÀ?'?nOø%WìŸû|nñì± ~ߟ?j/Ú«O²ð·„|1ð3àì=©x‡\ñ‡ÇÿˆVZ±ð'Ã+VÚB;1á›zÏÃþñ7ˆôÈuߊ±^|Eø}{ðßàÅm;Pñ%Ç…>™ÿ‚ÿÁ´ÿ´ßÆû½gâíÅañ#öUýžü„¯o¼5á_ØüAý¥þ5ø‹^—ºÄ?¾øMì<%ñGVðþ©â x†÷Æ°k:ßÀo‰š5φþ-ü#Ž÷Añ~—¡ ×ü»á¬Ÿà›_~Kmâ»9~~ÑðPO†²YøïÅz?,ëÿ|Y‡æÒ¬õmáïˆ>Õ-¶•7‹þx‹Â·~!ð¦ò5ßü£Æº÷‹ÿdýWÇ_³?ìãÏ|(ý ¾8ü]ñ¯ÂÝgÅÞ-> øeðÓâ߆üáþοt­Oö\ñ ‡Ä_‡? µ?X|\µÓüWgðÁ:×Ĩ/âÐþøÊ TÒ€8?ÿÁü[àßÚ2‰Þýœÿ`ïx->>ø×Æ7²é¾)ñ4>.Õ~øãßüKk¡O£Ù\év·ÓüÓümð÷Yð4^*ŸÂsͯ_xnOꌼQ­Âô_ü«ö(ý­ÿc}_Äמ.ðì›zºGü¿ö ý¼%ª|>øãñ1u‹_?a-#ã—†´¿‰#Ôÿex'Nø¥áÏŒ:N‘-Æ™¨ü]×¾é ô=Þ/ØÞÛIáðâÇüûö»øÏû1|ø'㿇Ÿ±ö«'Â_Ú+â‡ÅÍoÂ7/é¾3ø‡ñf_‡ ¾!Ká]?Æ&ø]yð×Ç>,Ð…·Ä?hpk’ß}{ð›ö\ø×àŸÚ³ößøgà?Ù÷à·Â¿Ú«ÁÞÑ4Ÿ|ø‘â ŸŒV^9ðÏÆxãøÅâ¯^þÍÞ ð]ǼwÅ-;Ä:õäß"þÍÿõÏ„Ÿ4_†M;ö†ý«é_×â“áO…ß ?mŒß¾ |jø³ñB_Œþ Ó~øKFÔ<â˜ô}.óÃWúÿŒµëM/Ã~²Ô§Ôîo´ ‹ÿkŸø7gàìQðO\ý¡>=ÿÁM®üð¿\ñ÷‡>þÏÚ§‰ÿbßZë¿uTÈ5¯Yx+Ãÿ´Š|iáƒ~f× ñœzŠêºt¾ÿ„üóGàwüÓö´ý³üU§k°ïÂŽ?¿f¯xƒFð׿ÚöƒøQ¢þÍöŸ5›Ùø’çKðžñC㆛®xÁ~?ðWŒüã/|1ñçÅ ü:k? êß5Ÿ…²x®ÛH±ÿA/ø ì7¥Á:~;þÙ²®“û@|Jý¤G‚?fOØjûTñçŒt SÂôÏ럴Oü÷Ä ýœü/©ßëk£üðö¯öÁªÉ¦ø“Ä:ˆ>;]ükñoÚ´‹ï_xWÃÀÓÝ~~~ÝŸ²‡Œk=ö<ÑlÄ´gŠ~*|k»²øéñà/ÄÉ<âÙ[öý"Ó~ø£àLJgñ4¾"í‰õ+k|;Ó5M—žÔu;í3ÅúÓÀ?!ü ÿ‹ý¹5?fýkã_‹?gícÅ ~þÊ?oãð7Ž¼=á­;àž¡û'øãTKˆÿ³þ§â/Ø;â'Žtɾ1xVmâ‹<1ð§Ç²mÖ™ñH> ¾ñwŠ¼?†5‡€LþÊßðLÿÚ#áíkñãçˆæøðÎÛâf‡ûgøf_ü%ñ½ßÄ?ˆ÷Oí!ñ‹Ã<¨èÖ¾2ý–¾|Fð‡Š<97…¼5®xªçâ7íGûKø>×Ä>ŸDøoà_xWÄÖ1x¬ý™?aÚ[övðOŽ°~þÇžñ…çì½àÙÄøSá‡Å_Šºƒ¿hh—º•¿‰?jß^7¿ýž®¼C¢|QÔ´KÙ%³Ð¤ðOÆ¿j:†­â+Oü}ñ47ZV¥¤yíSÿ×ý¬¾>~ÎÞð~—ðßö/›âôðLŸÚ¯þ ¹ã„ñŸÆO‰Sx> OMû+_ü'øÝ¢xîßöFÕüOâ{߃þ'ýŸ|Eã=ᮯà/ E¢øŸÆVÚ¯†þ"Zj—××€Yx_ö+ø‘àÿø(-×íuᯰö•¦|[ð‡Á·øÃã«ØõíkãÇÃxGÁÿ´>™ñVÓà݇ÁO [øš÷âvµñ'áΕª|añG< ªêÞ Ðü[câO„ú…Üúpp_ÿa?Ú+Ný›?ࡳÌ~ý›?f=3ö§ñŽüðh~ο¾¶ñZjÞÑ4øIÓµëÿG®ø›X“RðÆ›ðÿP“WürñoüáφþÑü_ñ{þ /að7ÃZŸ‰,u=Ä¿ÿf¯ü&ðÁÏ€º‰4Ï è?hoøËö­Ó|3ðƒÄŸuëôÐ>|ÔµM[â)ýœÿd¿†>ðׇ?h_ÕuŸ~Í¿¿hÿŒ7s|cø%àÍ?Á >$xU¿øí£G¡éÞ>ñÄ{M>_j0Má!¦üB×ml@>"Ö¿à–Ÿ´}Î…ñ×DÑôŸÙFÛÅ>)øûpxZ/Ž×ž:øÍeñgöÅŸö¤×µOáÞ“û_]ø7áÇ„uïxwá%ž¸âo |FøÙ4·ÞÐ-¾i? <ö¯ o Á þ"i¿³oŠþx£àÿìgâÏ[~Ú¿¿j¿‡ß ¼g©økľ ¸ÓüoðÃß|5⟌>ý…þi:7ü,ßü"‹ÃZx{ö@Ô'¹µÒ,¿á>ñGá/¾o€}mâÿØ;âWlj¿±f¡ñ×Ã_´?…ÿboÚ7öuøãàÏÙãÇí!û9i¶~/øñ©þÊÚ•·…~øká~›á-OÄ¿<+¦~ÎZ‡‚Ç…üsñCÂvº–—âÍ^Áà­3J¸ç|ÿÊÐ-lÏÚ/ãf«û5~Èžð?¾ü"ð—ìûñ?À”šïÇo‚þ9ø<ÿ†—ñWÃÞ×gOø;ÁÞ7×O‹¼/¨]x‹Ãÿõ}nƆþÒõKÿéfÑtpðgü³ãö™ðgÄÞ ~É u;o„ß³OÃÍsáßÂïüQÔþþÛúÿÀ_ŒZÄŸøÇöÀ×u…^ñF‡ÿ á/ßü+ñ½²h´Š­toˆž3¼øãï¾Cðû[¡ûBÿÁ(~4ü_ÓþÝø3áŸìð‡Âþð¿í7àíSöIøsâï iŸ|/©ühñw†¼O¡|qðG¾%Á=þ6Æ>0_Gá‹+Æš—†?gß„^(ЭÔ|2>!j~4³ø¿áÿÚ;â߇¾&øCÀ¾2—Äß±ÎñGÀzF±ÿ¯‡lþ.j¾<øïû_xcM[ cJøaðHð׈ôýÁÀš7ü3ãv¯ðŸöøUñWöký‚|káoÙöÌý¡~<êþ Ô~,øãÄ>Õ¾üaðíSaᯇÞÓ5ؾÚÎÎO xÃö‚ð'ˆ/|'y£Zx;Qÿ…áÉ–ìO©iÐxLà¯ÚûöoøŸà¿ÿÁ7¿gÚ›Wý•×Nýž¿à·?þ8ê¿|u®ßxWã'ˆ<+¯| ðÍâþÆßþ"üÖæoړľø;q¬_ KῇücáM;âF•¢éw^=·Õnžñ€z&¥Xø^÷ÃÈ<®|—áO‹Üi“Ião~Ã^ñE¼VðxKÀVv¾"Óþ9þß?-/íl¯5 Ãâç„¥ÕàŠéüg¤øƒMðŸíRúqðž [_…Ÿ -ltoørÊÛáÿƒ`³ð÷ÄÝNçZø‘¡ZÃáÝ6;}â³y®ø¢óVñ¾—¥—Šõ;¯xŠæÿ^‚þê}wW–VÔ.>Uý¦'¶Ôþ-ü2ÐN¹¨ø«XдããÍá{ Ò¾|7¹Ñî5™ojÚƒÄqΫáAa·Á‡:…Þ‰eâoŠ6:έgaâ KðüKý€>SÑ,ô?iß m4댞<´ø…ñOQøá? |@¼—Þ(ý¬¼EáË#í_µWíI<^²¼øuû0|6{m+Zøkðàiþð浦Y|9Ðôï‡w‹¨|6øh@~ñ?‡åŽ9~,ü`³øÁñfâXa–ãþï~ß.ðïöM±Õµcm¤Ü'Áø'Átž+ $°ŠÃÃß|=anïŽôÙY~Ù ø…´h¿n¯µ?ŒŸì~$|FÒ~ø‹Äž sá¿~×Þ*І¦aý–ÿgXÞÞO‡?±÷€ÕtÏüHÑõXkeÄ={\ø‡ªZIñ'âG‰€5üCq£4Ÿµ]SÄnæ£áï„~1ñŸÁÕšxªúÍu6Ó¿`ØJ¶Ót´Ý+FšÒañÇãÞ”<7«X]Ku㯠ë> ÖüSû xßí3ðÇKø»ð7öºø;yâ]sál¾%ý™¾+ø–MOH·ø½¬hƒLñ>­=߇ü1iâ_jŸð€xOῳſ ü]ø%ð[ãæ‹'ˆ>éz¿ìkðkâ ”ÞÔ®þ%ü>ýƒ>ütð/‚±à6ºý¢?nÏ:g‰ôÛ8µkÀÞ)ñ‰ú4Óøbæ/èjý¶,&ð¯À+OxJÓã¯þź€mk}"Ó^ƒUÖ?d¿‚>%è>9øÓÇ^&×$Ô´¯‹¿ðPÚ÷à&ƒñ{á ÃøÛ\еÍ3âÄøçÆzGÃOüXøñLëÿ Øèú\ß ´ý:Ïâ…7‡tüað¶ƒñÃVº“Hø]§Þ·ˆo5ÛûöìÕuEÒou_Š>#—ûJûá7Ákš\Ö¾¡+é^¼ðŠ¼kû5€³Ò/n~iF‹ñ‹Å’x§Æú÷Å?øKâÌ÷ZWˆ>/jš5Õ»j¶ÿí¹sýáûŸü7ðÕͬß~ \ÙxSN>O€ô½á‡umÂ>øòWÄ?†šÖ›âýö“ýŸü=ñƒöšñÏÅÏøgMø‹ð3Æ(¶ð—‰?àª> ø1ªx»Ä¾ø}â-}´OþÊÿ¿e¯üNñO‰¾}¶ÓÂ_¿i ]3àgÅÍUðßÄ€4 oð_ÄÏ…Ÿ´Ãsñ7ÀÞ#øÉñÿÁ´ÄkOÿmÚhÚßÃ~Ú~>ðΣ¤ëß4x›EÓ|Sû5þų¦¹m¯x_â¦âx<'«Ã¬xkâ6ƒñ:çÅz•ïŽµßÚ4½ñQÑ5øŪjÚÏÆ/ÿÂaâÿ|)ñ~¿ðÎvÒ|AñÇ^Ò&ÕÒ×öýmßB ø+á9×Q³øËñ§MÔ¼-4[üu©x—â–™©xwǾ:øJ£ã­"Êóâ®±ªkß-dÑt­á‹¼_ð>ÞêkO$ú”6zGìûé6^Ò.u¯ê766ÚGÇ/š6•¢x›N×#µ·:瀵o i^ý”@#ÕcÒ¼=ªøºò÷Xñ¿Â»¯†´?ëZ·ÃÔ‹ÅýŒü+â(ü<šoìùû6h–Öm>,þ×ÿ`“G‡[ñž…ã}D2øV :ìu‡ÞñàÈ_³Ÿüëöý‰>!xçâoìïû:鲟Äùüâ?ü@ñ•šMñ=¿aŸ|FѼ)q¨ø~ø¼|M¿ø‡ûV|M‡HðåÏ„¾xoXñ_Â/„–f[¯x%ô¿ßx—öÁ­û{ø4øƒö ý¥¼ ំõØÁ?¿l_øà‰õmSS›áŽþ|X°oÚ'öšÔ¢µÖuÏþ×?nõSÃß ¾k:ÇŠ5½;Å> ñ%Ý–›©£ü@ñæ‚úQ7ü‡öC·»Ô,.4oÛf ý'Ã0x×U²›þ wÿ9ŠïLðmÔºŒ6¾-Ô-ŸöBY¬ü3s6‘«E½r‘éSK¦j1ÇvÏer#-¿à¬?²íÖeg£~Û7wž#ðìþ/ðõ¥·üïþ squ¯xNÔé¢ëÅ4~ÈO.©áÛs¬èâ}nÅ'Óa:®š$¹_·Zù iŸðV¯ØïZ>]Mý´µfñΑ}â3þ ÿ5¿>0Ðt´Ó¤ÔõÏ _ÙSâ #NXÒûRÒ~×ehš®œ×Æ/­Œ  ²ÿ‚¶þÇ”ºÓì?m ûoê:†‘àû›/ø&üÒêêÚL:¥Î«¥ønh?dI#×u2ßDÖ§Ô,´¶º¹²‡HÕ%¹Š4°»h€¿à­¿±ÅÄztÐX~ÚE¬x¯Qð&“,_ðL/ø)¤‘êž8ÒW][Áºs§ìˆË}â½1¼?¯.£áëc.¯dÚ&®.lâ:mç’IÿmýŽ"·½¼–ÃöÐŽÓNñ]·5 ©?à˜_ðSD·°ñÅí펛gàÛÙÛöDZø®ïQÕ4Ë oNÉ«Ü^ê66±Y¼÷vé yÿmýŽ4øõé¯ì?m ¼+­hÞñD·ŸðL/ø)¥´~ñˆÛG_h:óÍû""èúÖ¼Þ!ÐFÒõo}ª6¹£‹':—žíGþ Õûé âÇÕ´ßÛKKOØZê¾9}Gþ ÿ5²_i—ö“ßØê^,kŸÙ!áÛ Ëk›Û[Í`ÙÛÜZ[Ïq R:€?Pÿ‚³þÇÚTšüZ¦—ûjé²øWÃ1ø×ÅjðKÿø)µœžðl«©´^-×ÒãöC´ ʺ&²ÑëÚˆ·ÒtL­Ùf ÿ[ý’_QHMöÝ}ZoŸÅ¥¯üãþ vÚŒ¾¥±ñDvCö@7/áÑs,Vç[XΚ'‘"7>cª úgüŸö>Ö¤ðÔZ>—ûjêÒøÏA¸ñOƒâÓ?à—ÿðSkùñ‰gáŸÙXó öüý»~6þÏ^'øíð‹ölø ñIý¤þ~Íðç5ût¿ŠŸ?f[ŠZG‡"ø+ð/ö{ð‡ÂÍN_ê?hŸéž$øOâOþÕ¿ÿf‰~!ñ¥ð÷ìGàÛ+Æ«ðÛörø¨í¿ðI¿Û«á÷üëþ Íào€_ðPˆj/~Ò?~1|zðÏí-ªËûþÛŸ¼¦üSøéûcüTñW€g—ãÃÙÏÅ |G'ÆŸø[Ö¾ßøsÅú…§Ûâ…àðùº½Ö¬¬ÜõSSÿ‚³þÇÚ,ž%‹XÒÿm]&_h6þ)ñ„ZŸüÿþ ma'…<1vº›ZxÄ©uû!ÄÚƒtº.°Öú¾¨-tù×IÔÌw ,.Œ@Mÿaýíîõ öÙ‚ÿIðÌ5Õl¦ÿ‚]ÿÁNb»Ó<u.£ ¯‹u gý–k? ÜͤjÑA¯\¤zTÒ隌qݳÙ\ˆÀ oø+ì‡{u£YYè߶ÍÝçˆü;?‹ü=imÿ»ÿ‚œÜ]kÞµ:hºñF_²˪xvÜë:8Ÿ[±IôØN«¦‰.WíÖ¾hgü«ö;Ö…—FÓm-Y¼s¤_x‡Á#Lÿ‚`ÁMoÏŒ4-4é5=sÂÂ×öC”øƒHÓ£Ö4‡¾Ô´ŸµÙZ&«§5Äñ‹ëc(l¿à­¿±Æ¥†î´ûÛBþÛÆzŽ¡¤x>æËþ …ÿ4ºƒÅz¶“©sªé~šÙHõÝGL·Ñ5©õ --®®l¡Ò5Inb,.Ú Güö%ñ–£ ·íƒ­éú—Ž|Kð¿N¾Ò?à™ßðRÍJÏPø—à½WÄzŒ~Y\ÙþÉCu㟠ëžñnâ_ @òkú«áéú¦Ÿkw¢jpÛ_“þ ÛûEo{y-‡í¡¦â»ojRÁ0¿à¦‰oaã‹ÛÛ6ÏÁ·³·ìˆ"µñ]Þ£ªi–Þ“W¸½Ôlmb³yîíÒ@óþ ÛûiñëÓ_Ø~Ú1xWZѼ9â‰o?à˜_ðSKhü7ⶎ¾Ðuç›öDEÑõ­y¼C .¥êÞûTmsG0Nu;/<Úü«ö;ÒÅ«i¿¶––ž°µÕ|rúüþ kd¾ Ó/í'¿±Ô¼X×?²Cö–6×7¶·šÁ³·¸´·žâ¤u~¡ÿgý´©5øµM/öÕÓeð¯†cñ¯Š"Ô?à—ÿðSk9<7àÙWSh¼[¯¥Çì‡hþ•tMe£×µo¥:é™[²,.Ì@þ ·û$¾£šíºú´Þ>/‹K_ø%Çüíµ|&'Kcâˆì‡ì€n_âæX­Î¶±4O"Dn|ÇU ‰³¿ñGÀ¾ñ_ÄýKà¯Ç_Œ?²Ïíwûx~Þÿµ‚~ è~ñƒ>>x¶ÂÚâçÅO†¾%ü,›áå‡ÆÝcþ Áÿ mü'ñãá¤> ñíU©þÑzÎᯠ|ý¨¾þÒ¾ø=ðøî/Š_ fÚÇÁ:U×Å_7í¿à?ˆß<ã?jþ"ðoƒ|[í£ñcÃ.¨|%'À{mwFñ&‹ð[öø5 xŸ[6ß|+«iÚŒ¼%ã}JãǼ=ã¯øÏö õÿQ_ŒZ¦­¬übñ¿ü&/ð÷Ÿëÿ çm'Äuí"m]-a_ØöÑ-ô!àŸ‚¾u?Œ¿tÝKÂÓE¿ÇZ—‰~)iš—‡|{㯄 Eà¿Ú_ÀŸ²Ÿüö©ñoÆÃñß]ð¯Ä¯ÙßöøàMCàìcûSüxø ொ¿þ*þÞÓx¯öWøOãÙÛönñN‘­^ü)Ð>(ü1MdxŽê?ëÿ<]âèlt_eÞ|#øböÏü·ö8³XšîÃöе‹ÃÞ"Ò¼!¯ËsÿÂÿ‚šA‡âÝu´…Ñ#m|= ëÏ7숋£ëZóx‡@]KÔ ½ö¨ÚæŽ,`œêv^xµø+Wìw¤/‹VÓm--<akªøåõø&üÖÉ|¦_ÚOc©x±®d8‡‡l/,m®omo5ƒgoqio=Ä2<1Hêð¦“ñwÁ¿´ü ã?ůøGöˆÒt_ þÄß±ôŠ?hßÙóöˆý–þ|2ñÿ‰ßðQ¯x»ö€ø·á¿Ú;á‡Á­kâŸ<3ñ#©ð£@²¹oø—Åõ;ë{½Okÿþ{„Þ ðÄ-Áÿ µ¿üFø³áOŠÚç<[oðŸãý„W1þК|± 3ÅŸµÿíû¥ê¾Òmt/ƒv–±‹Oƒß³ö·¤xwÃú•‹ø+@³øU¡ßi¾ðÀ`;à§Á¿ þü:øMð#Ꮍ'Â|fÖ¼Uà…ð÷‡>hµÏŠàÖm¼A®üeøƒáÏø+KðçÀïØGá^»¨Íâ='þð¾áo‰+o¢/|F_xSÁÿ´šþÖš”³ü2ðç<9­|hø¢/ÿoßØ⊼sá„>3ø¯ñö³Ó?gÏÛGà'ÅÏŠ|ø)ð×Á?üy¡þÆ¿³7Âï x×Æþ»øq¥]_ø÷Ä^›\µñ?[Ä:¿Ä?Ú<ïKoø+oìqy5¥‡í¡uˆ|EªøC@–Ûþ …ÿ4ž=sźjë®x_Gx¿dF]OÄZ3x_]WD²3êZ{hš¸»¶„é·¾H¿ðVßØá Šél?m¶ŸÅóü>†áà˜_ðSCÞ=µÔn4‹ŸE(ý‘ rx¾ßV´»ÒçðÒ±ÖbÔmn,¤²[˜e‰@ Ÿø+oìqg±5݇í¡k‡¼E¥xC_–çþ …ÿ4‚=źëi ¢x_XydE]3ÄZËx‡A]+D½0êZ‹kš@´¶˜êV^xãø./ü—áß´/†ŸæËþ …ÿ4ºƒÅz¶“©sªé~šÙHõÝGL·Ñ5©õ --®®l¡Ò5Inb,.Ú /ø+oìqq4¶„Ñk+Ô| ¤Ëü þ i$z§Ž4†Õ×Vðnœéû"2ßx¯Loë˨øzØË«Ù6‰«‹›8Ž›yä€Á[cˆ­ïo%°ý´#´Ó¼WmàMBêOø&üÑ-ì[[g“ÆZŒ,¤ý±€3Ä:/‰´NúëâOÄo‰?þ2?ƒ$øÞðÞxßLøAãü Ó&ŽûÅÑ̶ÚwìûiÖˤÍmom6“6•ñËã–•6“«i¶“â{«¯øgYðη­þÈø‡Äu¤Ÿg¹ø¡â/OàïøE>ø³Æ ´Ôt_€ú.¤¯™û~Ŷ6v3Â_ûNø“ÍÒ¬¾%|@Ñ<;©xš×Yñ†-mtÍ#SÑ<à_‡7º¾“áé|q'Žõ_„ >èzUæ­k¦Ûx¿Àß°¯ƒ|Mio·‚<#c,Óþ5ÿÁ@þ1ÛëvpÝÄËãÛÏÇâ] m¬|C§ë~ð‡í\ñ'üßÆzMìéáÿi5»økiûxö‹ýŸ¼oã/hÖ^ýŒþ~Ì´ŸÅOÙoÂßiÛ[]gQð_Ä?Û÷âA«½…¡µðškÖþ:×|!à/xÅZõ>ÙðÍÖ“ayà½.Ã\ñŽ‡7†¾êßü+áŽM9±øY§H×Wz¿íßû~êúæ—yñY}3QÕ~ ü ñ.¯á»”Ôl5WžÇÀ×ú‹0Ú|]øÔÚ-Þ¥áÍûÄ?¶ÿ‹¼6öò¯ƒ>ÙÇ}{Ã?ø'çÁ8VæoköW×^ñï‡ô_k^,ñÖ‘âïx«öŽùkâ¿ÁË|Gñ;ö’øã;˜?iˆt/|Zñw€´­SÀþÿ‚†_xbÃÃ-‡üÃá¤^ +ªi_ ¼á?‡6^ Ônô¯üMý—†‹ãŸiÞ,ñ7Éiÿ†W`ÝŸí!á[_ø±ðÿâ?‹|yðsã~‹‡¾0ðgÃ<ߤð#ø|ß±ïüÛ_ÐítMãV£}©j?¦ø×ñóÀ¶ZGÅO…¶ÿþèÿ¼û-|]¼ð÷Á_ÙLÞüO¬iÚ.«ñBöÿâV½ðò‡þð÷5}{áÖ‰¹à¿Ù#Âzô¶¶šgìñû8è–Zvµoñ3öÝø·¡¦YkΟ øË[Ñ®5Ÿ [XèÚOðïá÷Ä õíkHð®¡âi?á7¿ø//Â_„–ú‡R³‡Æ^ ý„üâï³\¾½ã{«‰üE§üfý¿~8ZjM©iºV¥yãÉü&š„Ëj[[g“ÆZŒ,¤ý±€3Ä:/‰´NúëâOÄo‰?þ2?ƒ$øÞðÞxßLøAãü Ó&ŽûÅÑ̶ÚwìûiÖˤÍmom6“6•ñËã–•6“«i¶“â{«¯øgYðη­þÈø‡Äu¤Ÿg¹ø¡â/OàïøE>ø³Æ ´Ôt_€ú.¤¯™û~Ŷ6v3Â_ûNø“ÍÒ¬¾%|@Ñ<;©xš×Yñ†-mtÍ#SÑ<à_‡7º¾“áé|q'Žõ_„ >èzUæ­k¦Ûx¿Àß°¯ƒ|Mio·‚<#c,Óþ5ÿÁ@þ1ÛëvpÝÄËãÛÏÇâ] m¬|C§ë~ð‡í\R-cMÐ5‰¬l¼Y«ü)¼ø]ðNiº_àÄÞýŠ|âtµšïãí«êú¾«eñ7öÛø¯o.¥©øgCñ.±âK _´’jzV³ã_ü_³á›­&ÂóÁz]†¹ão |9Õ¾+øWÂÿšscð³N‘®®õÛ¿öýÕõÍ.òÿâ6²úf£ªüøAâ]_Ãw)¨Øj¯=¯ôx×öe¡á­SH»½øA¤é"ø≠ð§Å}6ëL×>)jšxÔ´?nÛb_+÷>ø+¦Ü¥¯ü)ƒ×:w„të{ËÿÚèþеoøGÂ_@ Ýè~"áå…¿‰þ&üdƒâ§ŒüGâ]#Fñ +áï~Û~-ÑÙRoŒ.¬ôÛßøU?ðOÏ…?m²Ò,to x«KoéºG†þ išÿ‚|ûAV_øÄ6ú,Ó|Eøñ†ÓâïƦÑnõ/hßØ~!ý·ü]á··•|ð¦Î;ëØ~ÿÁ?> ·3xÃ_²¾ºð÷|? xŠûZñgŽ´x“Å_´p·zî‘Šõ=kâ_ÄÂ_ñGKøqâßü)Ó³µŸŽî’Ò/دö$±]CO |ðcé×±|qø·§êzS$:WµO|OÑu-;âŽþ€4ñ‘§[üZ¾Õ>$ø¯N“IÖ¼)ðgÅÚçÁ"ê{o $®öZGüçö µ²´Ð®uŠ··0Ûhß¾4èÚV—âm?VºX‹|?Õ¼'¥xcö]ð_Ú#âßÄmSøŸà­Þ•ñG¶øAâÏŒF™¢kÿ³/ü¾0°µÔ4¿†ð^•â;Ç?´íÇñ+ÃwúeşÂº~#x‹Å~+ø/àÿk?³Â¯‰_þ ßgEû/üðŸ£üxÿ‚üWñ?Ão†Ú‡…>Ú[k_ ¾ü7ð§„~ü9øq/ìÉeáÏþÒÀz_ÁµOí±û4xËâí âm{áìñ‹Qø‡ñ/DñVñ?áWì½ð§Ä?~øÃÅžý¯|màø_?|%iñ›ö{ý§üMáx“Oø«ûC|tý¤ÿhïÚÆãöåø'ñNçáwìÛû뾌úÒ®ôˆn~iº^¹ã{gÿ„WÄŸüàßp]A«JÖÖWqꟷçü þäxjïFÓ£ŸOš/‚ÿµy<)jpiÒ&…á-o¿؟²?†u ÄV­´ÏüJøƒcãÍ_ÄŸ|-áOÙ?‡¼YûRø“N½»µoíEt¶Ö·>ý¼»O×~xižÐ/t«‡º“á=D§Ã_†oMÕ6ëìëû-ÄuCÿì}ðêK}GGø‘ã3T±Ó5‹|C×5ïˆrZj¿>$ø˜øóñ&óÀß?io‰Ú±ãŸŠ1ðŧˆ|-‡ÁØ?x'Á> ñ—‡õ{jp/Š<-ª?ìšùÿ_ðÅÙ§àGíð;âÇÇŸŽ~*‡áGÇ¿‹~ ñ'íc;üH×õ¯ x¶óö²ý§>üNýcx­¼e£ÏûB|Yñ'À¿ þÒ~1øðÏU×|A.£ûaxoNñƒ!ø…àï x÷Ç ¸wº¾“áé|q'Žõ_„ >èzUæ­k¦Ûx¿Àß°¯ƒ|Mio·‚<#c,Óþ5ÿÁ@þ1ÛëvpÝÄËãÛÏÇâ] m¬|C§ë~ð‡í\R-cMÐ5‰¬l¼Y«ü)¼ø]ðNiº_àÄÞýŠ|âtµšïãí«êú¾«eñ7öÛø¯o.¥©øgCñ.±âK _´’jzV³ã_ü_³á›­&ÂóÁz]†¹ão |9Õ¾+øWÂÿšscð³N‘®®õÛ¿öýÕõÍ.òÿâ6²úf£ªüøAâ]_Ãw)¨Øj¯=¯ôx×öe¡á­SH»½øA¤é"ø≠ð§Å}6ëL×>)jšxÔ´?nÛb_+÷>ø+¦Ü¥¯ü)ƒ×:w„të{ËÿÚèþеoøGÂ_@ Ýè~"áå…¿‰þ&üdƒâ§ŒüGâ]#Fñ +áï~Û~-ÑÙRoŒ.¬ôÛßøU?ðOÏ…?m²Ò,to x«KoéºG†þ išÿ‚|ûAV_øÄ6ú,Ó|Eøñ†ÓâïƦÑnõ/hßØ~!ý·ü]á··•|ð¦Î;ëØ~ÿÁ?> ·3xÃ_²¾ºð÷|? xŠûZñgŽ´x“Å_´pÇž3ø€ïþ*üaý“>'ê> ñïÅ?ŽzŒŸüð£Àþð'Àÿø(ßƽCZÓµ]_öXø;…üwñ#á5½¶›¡ø¯Ã?nÿ„:æ›ã NïZø‘ûJ]þÒšGÁ)¼)ðt³°ý­<%}ã?‹ß þ5k?fÏöž&_ƒ6>ð¾«ðÿW‹âƒ¼ÖÚuÿì¥ÿ»øâ™nþ.^¦§%ž“ñÛâ¼Þø_ûJü/]oÂÇÆß‚¿³5Ʊð£Âÿ>¡ñ>±§hº¯Å Ûÿ‰Z÷ÃÉþøwÃÞÕõï‡Z$ç‚ÿd ëÒÚÚiŸ³Çìã¢YiÚÕ¿ÄÏÛwâÜz†™e¬k:~ƒã-oF¸Ö|-mc Ci?ÿ‡ß@'×µ­#º‡‰¤ÿ„Þÿ༿ ~[êBJÎx'öðG‹¾Írú÷î®'ñŸñ›öýøái©6¥¦éZ•ç'ðšj-¨ñŽ“â[¯þÖ ­ïôýûÃÛøÄŸ_Àçø‡á¿ üW_·xsö[ðî­§Ý[ö°ý¶µm_Y2xÛö—ñ@Tø#Å~#žò V?ÞIsEñâW‡@-éWzD7? ´Ý/\ñ½³ÿÂ+âO‹þðoƸ. Õ¥kk+¸õOÛóþ r<5w£iÑϧÍÁÚ¼ž‰584éBð–·á_ìOÙÃ:†â+ƒÖÚgˆþ%|A±ñæ¯âOˆ¾ð§ìŸÃÞ,ý©|I§^Ý‹Ú·ö¢º[k[ŸþÈ^ Ý§ë¿ ¼4ÏèºUÇÃÝIðž¢Sá¯Ã ·¦êžñ6‘àc>"|\³ø¿ñ6æh_ì?Ø>1ý¼ü]á˯´VÙ- »O„ðN‚©{¥Ý‚¿‡¾ øemmžOh>0²“öÆÌoè¾&Ðu;믉?¾$XüCøÈþ ñ'ˆ~éBñWí}⟠›uƒöuý–â:¡ÿ„ ö>øu%¾££üHñΙªXéšÅ‡‡>!ëš÷Ä9-5_‰|L§¯kº4š7ÄSTø“ã{Ãyã}3áŒ|cðƒLš;ï_G2Ûiß°ì§[.“5µ½´ÚLÚWÇ/ŽZTÚN­¤jÚO‰î®¼OágÃ:Þ·û GâiÖ’|ižç⇈¼?ƒ¿áøSâÏ|&Ð_QÑ~躒¼ZgìeûØÙØÍÿ í;âO7J²ø•ñDðî¥âk]gÄ>µµÓ4ODð~hÞêúO‡¥ñýÄž;Õ~\|(ø¡éWšµ®›mâÿ~¾ ñ5¥¼VÞðŒPx³Oø×ÿøÇo­ÙÃw/o<;‰t5¶±ñŸ­økµpHµ7@Ö&±²ñf¯ð¦óáwÁ8|Y¦é~?‚?xGö)ðw‰ÒÖk¿Œ´^¯«êú­—ÄßÛoâ½¼º–§áĺlj.t(m|JÒI©éZÏ|_ñ|φn´› ÏévçŒt9¼5ðçVø¯á_ üriÍÂÍ:Fº»ÕÿnÿÛ÷WÔo4»ËÿˆÚË階«ðoá‰u ܦ£aª¼ö>¿Ð|Yã_Ù”‡†µM"î÷ᓤx‹âŠ$ñ—Œþ,ø7ŸôÛ­3\ø¥ªiãQþÐý¹ÿm‰|¯Üø;à®›r–¿ð¤>\éÞÓ­ï/ük£øCBÕ¼;á | <+w¡øŠ?‡–þ'ø›ñ’Šž3ñ‰tÄ0¯‡¼Mûmø·GeI¾0|Pº³ÓoáTÿÁ?>ý¶Èx_H±Ðm¼5â­-¼¦éø¦kþ ðOíY|CáÿÛè³MñâÆO‹¿›E»Ô¼9£aø‡ößñw†ÞÞUðg›8ï¯aøgÿüø' ÜÍã ~ÊúëÃÞ=ðþâ+íkÅž:Ò<]âO~ÑÀÝëºEü~+Ôõ¯‰Õ*ÞÜÃm£|bøÓ£iZ_‰´ýZéb-ðÿVðž•áÙtç‰õ;EÕ~(^ßüJ×¾Oðÿþð&¯¯|:Ñ ×<û$xO^–ÖÓLýž?gËNÖ­þ&~Û¿ãÔ4Ë-cYÓôkz5ƳákkIþü>ø‚ñÇí%ñ,üSðwÄ…?³Åý{á®»àŸ ËðëÇ¿ü㯠ëŸÿà“>O}“ã|rñæâcÇà¥_´½Æž»øUðOV׿hφ^.ñ-–ƒ§üZý›¥ñî›ûa|`ðÏØ{öð?ìÙñ»Çß´—Štm+áßí¨ü"×õ™|oñ?Áþ³ñ/ x†ëHÕ>+~Ûß·»oã/Ý|f¾ø{àhÿf_Ùcâ7ÆOŒ>ð§‡~\üvøññGƶÇïÛ›ã&”òÿü‹_¶ÃoÚGöDøñö“ð·Ã/ÙûöBø…ûQ|Cð'‚÷]|tý¥ü[¬ü ø¥âßMûjø²j:§€¼kãÝgÃñ}ÿì´‰à¯h<[û;øfÓÀ>.·ý³å·ÿ‚U€~–|Vñç…fïÙÂ>!ø4.[áÏÃÏj¼àoø'Vðχüuðçá„Öö^5ý·¿i/‡ ´­#ĺgì5û)ü$°½ø±ðcöPøs¦ü8OŠÞð‡Ã? l|=ªx‡á„4€‘?à‘2|SÔüûJÇûH|Yñ¿Ç?‹ß¿à¡'Ž|tù«ö½ø‰ñCÄßðQ?„^-Õþ'ëß| à_Žÿ,¾XxCÅZ߇4ï>.ø›ûA~Ï¿±gÄ=á֛Ὲ^Ð>üøËðƒöÌý³~|Ò~%Úx§í~0ÿ‚m|dø­ðƒãž¡¤üpýµto€~ýkÚî&ñ#TÕ>$øÞðÞxßLøAãü Ó&ŽûÅÑ̶ÚwìûiÖˤÍmom6“6•ñËã–•6“«i¶“â{«¯øgYðη­þÈø‡Äu¤Ÿg¹ø¡â/OàïøE>ø³Æ ´Ôt_€ú.¤¯™û~Ŷ6v3Â_ûNø“ÍÒ¬¾%|@Ñ<;©xš×Yñ†-mtÍ#SÑ<à_‡7º¾“áé|q'Žõ_„ >èzUæ­k¦Ûx¿Àß°¯ƒ|Mio·‚<#c,Óþ5ÿÁ@þ1ÛëvpÝÄËãÛÏÇâ] m¬|C§ë~ð‡í\R-cMÐ5‰¬l¼Y«ü)¼ø]ðNiº_àÄÞýŠ|âtµšïãí«êú¾«eñ7öÛø¯o.¥©øgCñ.±âK _´’jzV³ã_ü_³á›­&ÂóÁz]†¹ão |9Õ¾+øWÂÿšscð³N‘®®õÛ¿öýÕõÍ.òÿâ6²úf£ªüøAâ]_Ãw)¨Øj¯=¯ôx×öeý<øOmªü,øiªYx³Ä^=³Ô¾ø6þÓÇ>/ц¼[ã;kÏé·x³Åð˜Ð%~Òž"ð´šÞ t‰þ){lx'öSø5c®üJºˆjKâÝKÅÖÞ¾º±SµøWûC|¯iâTñ&›áÍRo:÷Äm?â/Å™|âOøÃvú/ˆÿk¿ønòåí?gÙ~)õˈ¾~È o,µßøY1‚óT·×¼5¡ø×XÕ>#Ék©|Aø“â@ !‘´ojš¯ÆmFðÝ|U_ƒ¾3ñÂ?-•÷Š¼AÚm¶•ûþÀ:sjv“hÚV›6‚4¯DÆêÃVð׎®¥ñ‚õŸ x§[ý+øƒÄ2Yéß.gøÓÿtþ ñ…ð›Æ,øSáEÔ´_€ú.¢öv±oìe¦DòÿÂIûNø»Ïðî‰ñâUž•âf×ÄÚ–›kkáSÒ< à‡ºæ¹./Å«›Ÿ‹Zw‰~iÞÓ5gLðݧŠü ûøÅv—Qé¾ð›ω-¾3ÿÁB>3Ûx’Þ+«¨­üg‡cñ§„#Â:ý–¿àß~Õ`ßësèW¾0³µø•að§TøWðÖËÅÖZ4»_x/ö(ð‰íç¼½øÓûDj7ž&¼²ø¯ûg|Q²›Ä·‡ôÝ_Ä·ðè6÷W“Ii¬hÚ·‹ücñ€äÙ%õo|Mý°~iþ*ñ¯|1ð·â}çÇÏý¦ü+‡†~|;ø×ðOà'íñ{þ û]x¶ÿUðψ¾*_øïö¢ñí#¯ü!ðoŠ¼I \xwâç†þ:|4Ñ®<á_‚ZÅïìŒõ¿‡õQ}¨|>Ñ´oxƒÄÓxÁÚÏůø;âƈö>!ø£aåÅ7íÁûlIž¹ðßÁýö _ƒ_ÿ³~Çi<:5…–¤ëžðß„þ€|;àýzëáïíÉð—ÁºoÄ/übøcÿ,øsñkâæiâëÁðÖŸ¶Ïì·¤xÁ׿¼{­3TÔ|9û|Fý˜|S¥ë>ø7¡Üé>¶øqû [x›áï>*Ý|Qñ-Æ0µôïÙx–?Ísñƒ^øÅañⵣϩxkÃöþñíÉâ¿ µÜ÷> øOlºÆ³ÂßØàü/ªTK[Mñæ‡kq¨ê¼i¢x»XñgíAâ)¯aRÖþ5ëÞ2>,øÔ>x»ÄŸ ü7®|qñV‘<LýŒÿb»Y¼AðOÁO¢ÞÃñçâ´ú̧ìžø™«xƒâ7„§Óüãß„`·âFÓ­ücw«|g“J›IñæƒðWÅþ"ø-áɇ„nä{K#öýƒ¬a–ÆúóâD—Vzf“ñ«ãU¶”ú宩o«A ¿ÃmcÂv¾ý–€<Ïã×Ã_†_<;ñ'BøÓâ Ùi?|Mðò -[Âþ¶×ìÿaIÄsZü=økûÝé/©øŽ_ø)—‰ˆôñ¡|pøz·¿þx—Å>Ô| éWßð®<ã`ñ§ˆ¿k¯Ù*×Æ[~#ê´÷ƒ>|0¶Ô|DúŒ?³Ï…¿i¿ØšÇÇ^0¼½²×u˜£“à¯ìIû_~Ûÿ¼7ñÏig}¯~Ï2|ðW‚íïìtïÛ/Å_àÔi@`øyûSüø…âÍWÁÞý ô¯†¿þüñoÄý3àíámoÀÿdøk\ðݯÄ_Û7öîøSñ{Pð?Æ{ãŠoÐÓHñoíGâm>Å¢—ö©ý¨/£tþý’¼kq£Kðóᵟ‡¼/ev×^ÑôÛ ’¿þ(¡ë0ø£JøbÑ|PñÅý?ãˆ5Ùl è¶ÞñŸíéã]ê·7úÜMÞ¡Â/ø''ÁèõGÔtÈmẲøƒá«ÝÞ {Æ:4&ý±*Úx•øQu-à>‹¨½…‡ì[ûi‘<¿ð’~Ó¾.óü;¢|@ø•g¥x‡Yµñ6¥¦ÚÚøcDÔôxáÀ®¹®K KñjæçâÖð¢_…w†ôÍgYÓ<7iâ¿~Ãþñ]¥Ôzo€ü¦ÇsâKoŒÿðPŒöÞ$·Šêê+ÇáØüiáãðŽ¿e¯ø7ÁßµX7úÜúïŒ,í~%X|)Õ>ü5²ñu–ŸãÍ.×Åž ýŠ<#â{yï/~4þÑ牯,¾+þÙßl¦ñ­áý7Wñ-ü: ½ÕäÒZk6­âÿü`±¦ßOa©Xišo&Ð.<3ð~/‹>ðÇÇ-<>™ðAó,îµÏÛŸöÿÕnõß\k¿õK÷Rø9ð—PÕ<um xžâî/ Ëáïøëöm¯áýT_j´mÇ^ ñ4Þ#ðv³ñkÀ¾ø±¢=ˆ~(ßØyqMûp~ÛA'†î|7ðG½ƒG—à×Áì߇qÚOae i:ç‡ü7á? xOP>&_…}ŸÄo|fâ¿ü&~#ðö‹®èö¾ñí­ã"=@_|eø­yd·pü0ÿ‚~|2‡UµoøfÃC6*°Õ>i:2xò=À~øöâ[/ÇàÙ®~0k߬>/ü@Ö´yõ/ x~ßÃþ"ý¹*Ò'€éŸ±ŸìWk7ˆ! ø#àiô[Ø~<üVŸY”ý“Ã5o|Fð”úü{ðŒŽø¥ñ“ ¼=âÿüKý¡að}½Ämà·­üðÍííÕ¯Š.`Ûá¿ø&ÇüÁÚ:øûãι&‹o£|JñÇ‚ü/­üEÖ5ë-[JðîàxZDzèÊ'Æ´ÿÇËÏ‹Úî³ñ*Ãöý•|3…< ößøGÇ¿µÃƒ¾0k[?üøàøm¼/ì·ûmük°k;]Bä韴·í=?€¾9ü:Kχ°wíà |ñØ:o‡< ð@ñO€¾kŸÿeoüðEœú7€üà? Ÿƒ?ðOŸ‡ž8½¼ÖûPÐü?y¨ø_â§íïñá|G©ë–6v‡Åšo†n¼SÌ4ߟ~Ö 7ûD|_×¼âo|øoñ–ƒß¼}૯ü6Ѿ%øN×ÇZWìQðK@ŽßÆ¿´ücöÛ—VÕµX|Cñçþ+=OÃßn¾%ÛÏð»Ãÿ´×Ä_ƒþ ø¦j¶ßücâdö…ž ðoÁüø'ð‹X¹ð?ÿ…¿<;®ü øGñ~Âñ®|+ð÷á÷„ôo 迶Çíý«jšÇ‡µˆtïé¾Ó´¯‚ßµ{ßjP]hõK-Ä^ÔôÏÙ¨ðþ¢|A7ÂkMâ‰<{cñHñ7Ä/xWÇÚi-ý¨üM§Ø´RþÕ?µôcNŸÁ²Wín4i~|6³ð÷…ì®ÚëÀZ>›arWáßÃ¥4=fi_ Z/Š ø¿§übñ»-]ÛÃþ3ý½·Ñ|Gû]ø¯Ãw—/iû<~ËñO®\Eðãö@økye®ÿÂÈñŒš¥¾½á­ƺƩñK]KâÄŸX¸ñ £xƒTÕ~3j7†ëâªüñŸŒ~øyl¯¼Uâ&Óm´¯ØöÓ›S´›FÒ´Ù´¥|{øâ&7V·†¼uu/ˆ¼¬ø[Å:ßì€_Ä!’ÏNø¡s?ÆŸøC§ðgˆ´/„Þ0ñgŸ .¥¢üÑu°³°ý‹c-2'—þOÚwÅÞ‡tOˆ¬ô¯ë6¾&Ô´Û[_ hšž‘ào|8øçöñ ¶ð7ö—¼ƒã§ðÁ>~Ù_ðP½]×5iÞ,ð×ì;áOÿÁDÿkkCðóáΛi}â›?Œÿ·ÅÛ}ì¼/røɼ9àÏü4ŠOk0ëþðGíNö­þ·>…{ã ;_‰V uO… l¼]e§øóKµñg‚ÿbøžÞ{Ëß?´F£yâkË/Šÿ¶wÅ)¼A«xMÕüKƒouy4–šÆ«x¿Æ?,i·ÓØjVf›ãÉ´ ü‹âÏ…<1ñËO¦|#Ð|Ë;­söçý¿õ[½w×ïÄýRãD½Ô¾|%Ô5OÝ[_è'¸»‹Ãrø{Æþ:ý›@+øUÚ‡ÃíFñ׈Ÿãÿü#5¿6oã½[ã<šTÚO4‚¾/ñÁoH,<#w#ÚXé°ìc ¶7ן$º³Ó4Ÿ_­´§×-uK}ZmþkµðÇì´çÿüðË⯀þ;|7øõ¬ü;Ö¾è²|>ð/Ä_üð¯ÅÏ„?³o‚eÕtÍ[ÁŸ³wÀχöŸã-â÷íÍñYo ÞOây<3ãKßxŸUøwy x&‡á·‚£ðöÀÕ|mðGþ.ñxø ûTj“ü{ø+ûø⾎|A¥èúßí%ª7ÄÏÚ+ÄðP?ߧ›ÄžñçŽ&Ð4«?Ž'ølô¿Â¯Œ_ >1xOá·Ž>|~ð¿Ä߇~ øs¯|\øWyâ-s@ñ¾«Áá[¹ü+âßÛÏöóñ׆üC¤i· áßø?TðçÃ_I¨øëBñ_…5]/XÒ|/â¿ë:ìz×xQ> ›á5¦‹ñÄž=±øƒ¤x›â„<+ãí 4þÔ~&ÓìZ)jŸÚ‚ú1§OàÙ+Àö·4¿>Yø{ÂöWmuà-M°¹+ðïáÒ€³Š4¯†-Å|_Óþ1xƒ]–À®‹máÿþÞž0ðåÞ«s­ÁäÝêü"ÿ‚r|T}GL†Þ«/ˆ>½Ð-à×¼c xÓBoÛ­§‰SÄšo‡5I¾4ëß´ÿˆ¿eðw‰jëšäº¿®n~-iß %øQ§xoLÖu3Ãvž+ð7ì?àoÚ]G¦øÀzlw>$¶øÏÿøÏmâKx®®¢·ñœ~ÆžŽ?ëöZÿƒ|ûU€C­Ï¡^øÂÎ×âU‡ÂSá_Ã[/Yiþ<Òí|Yà¿Ø£Â>'·žò÷ãOí¨ÞxšòËâ¿íñFÊojÞÓußàÛÝ^M%¦±£jÞ/ñÆ môö•†™¦øòmãÃ?âø³áO |rÓÃéŸô2Îë\ý¹ÿoýVï]ðåÆ»ñ?T¸Ñ/u/ƒŸ u SÀ÷V×ú‰î.âðܾñ¿Ž¿fÐ þÕEö¡ðûFѼuâMâ?k?¼ àï‹#Øø‡âý‡—ß·í±$xnçÃô{Ø4y~ |þÍøw¤ðèÖZ“®xÃ~ø„õâeøQ§ÙüFñÆhþ+ÿÂgâ?hºîkáÏþÚÞ1Ò#Ô÷Æ_Š×–KwÃø'çÃ(u[Vð†l43aâ« Sáö“£'#×üà?`éÞ%²ñ,~ šçã½ñŠÃâÿÄ kGŸRðׇíü?â/Û“Å~k¹î|ðžÙuf…¿°Áø_U:þ¨—:¶›ãÍÖãQÔþ!xÓDñv±âÏÚ<ƒÄS^Ã¥­ük×¼d|Yñ¨|6ñw‰>øn \øãâ­"x™ûþÅv³x‚àŸ‚>ŸE½‡ãÏÅiõ™OÙ<1ñ3VñÄo O§øÿÇ¿À8ŒŸ¾|ðw¾"üvý«ü ðSÁþñΕðcâÅ?Þè^ð?€®mìdº³ý€ÿa½OÄZ·‡mÛâ46^ÛñÏãbÛ kN}Ä“ˆ>_ø|;û+|¹â¿Û;⟌<;ñGXý˜~ü^û_„u|2¾ñ÷Å¿†þ,ýŠ~~Å^Ôã½y?fo†>øÑðïÄ_µïÿmŸŠ¸Ð4k_‰_ ¿aßÚ@Ôþ |Uø7á}+@Ó<4º…¦ŒÖ|FøâOŒÕ­lÿŽšGÃX~x:oü@ý›þêÞ&›ö<ýŽüñ7PþÐÓü;û@kk®'¿à¡¶Wįx‹Ä¿µÿüP¿“ö^øÓáÿßxŸâ_ìG®XxÇÁö¿€>¢ðî‹ ü&Ò´¿‡¿üAá€~ øð FÖ¾|)ñg„´›?…ÿ±§Ã ;[oøiÚªÚ{IÓüCñ³WÓô{õøAðÖmWÃz‡-tF¶¢+/øëBø¾Ûö“ñÿíO©øGÁÿ°Å ÿ‹—áÍçÄ Úó㱦x’ßE’ÞÂÜx«öáñî†Þ¾ðí!㟿†îüá xóÅÿgÿ€®´{+ï þÒ_ÿgÚöAýƒ@>¬ø!à|:ðoÀÏ…ÿ|Gâ-sÀÞ$Ò¼wñ3Á ø…g©Éñ ö·ø©^j~"ñ—í¯ûeøÛ]½—Æ?ð¢Äž!|O¯Šþ'xóÅZ¿â]GÅ-×|)á+ÀŸÿádxkö¤øãáÙÌkzíð—Ã׿>/üMñ•íž¬þܵdžþ$Û|bøà &—‰ôÿ…¿±쥥øNÃö ø‘áíKWðoˆ¢ðÄ?ØS^Ðn>8|+ýªRÚ|ë;O§‰4ßj“|i×¾#iÿ~,ËàïxŸÀ>·Ñ|Gû]ø¯Ãw—/iû<~ËñO®\Eðãö@økye®ÿÂÈñŒš¥¾½á­ƺƩñK]KâÄŸ|ð^ñŒ>$~ÛŸ|wãV´¶Öÿk~Äþ øÇðÁÇ„¼cñƒáìïà iöŸðOÿ؛šö·§êZ.‘à?Û'ÄŸ¶w…þ'þÒ2hÚ$ž$ðþ‡¬øßÃþ(´ð®›§üKý—@>±ñˆd³Ó¾(\Ïñ§þéüâ- á7Œ9iáôÏ„z™gu®~Üÿ·þ«w®ørã]øŸª\h—º—ÁÏ„º†©à{«kýÄ÷qxn_xßÇ_³hê¢ûPø}£hÞ:ñ‰¦ñƒµŸ‹^ðwÅì|CñFþÃËŠoÛƒöØ’ <7sῃú=ì<¿¾ ÿfü;ŽÒxtk -I×'Ô.-,|+gªhÞðà ú½ì¾Ò|w%Çþü(¸ø?ªé¶ºµæ•¡Úx—Á¿°¯¼_mV>ðE´Pk–ÿÿà ´ÿ+Ew Ÿ‰cðíçlm—CÖôÿøCÃ_µpu»ûÝ ‰V–~0økð¯TøSa¥øóO²ñu¿‰ü#ûø/Å–¾&½Ôh7·“ÍeñGöÎø¯eyâ]_Mðþ«â ›}ûIf¼ÕtmcÆ>.øÂ}ški¼E¥é~"ðf‰s¢x2Çã?ƒüñšÅ—Eøg¢«MªþÞ·ž«7‡o5?jwžºÔ¾|$Ôn¼-§ßøXÝÝŸ\øsÆþ7ý™@>&‡E×t?ø)…õ?]i^?ÑjÏø'^­ãËýãTðiÚ‡ü[û|xøeyðGöÍýª4{=#Úυ<ªÛ[ãmÞðê}>ÊÆh~|-Òt]+á׈¼5¥xkáàÚ™&ø@o|S´ø!âÿüÐåûÃ繼дýöý‡l Ó4ÛÛßê—f¢üwø»mc§kUîŸâe·±ð¯á{- öglڅLJÓÄRê>ü.o…Þ&ð÷õÍGÀ¾OxWö5ð/‰­ô­3@ý›ÿg6ÏGÔâwí‘ñz×XÒ4ÄV:6·¡Üx¿L·Ó|ukqðëáÿÄ x«Q›ÂPüHy¼qð÷àì¿ EñÄWz}‹ü?û øÆÖÚܾ3ñàøŸOøÇÿ øÝiâ-FúÞÍïüWa¡Íâ­XWÇZOˆÿ·j` zä÷º©ãK|9øÑ`þñ¥‚|MðDú˜Ðõ†¾'ðÕö™û&€|Íá¿?´÷‚¯<að öÞ“ö‰ðÄíÃ|ðþ ð·BøâoÚoÃÞÐì-.~,|Pøùð§HøñÃáÀÍ#C»ð®‰¤xçö£_ÛOÅWo¦xRŸÁÞ3ñLšOÃo€YÒ¿kŠ:6™àKŸÚgà?ÄØ|Søâ-[Vø—û5èÚíuàoø(/ÄýVÔ,´¿xBøIàDýµ<+û |.ð§ˆÿá5×5Söð÷Â}Jk«½ ËâgÄ­ÄþñíÐí ?iï€ß´.¤tÏ…Ÿµ÷ÀoÚcY‹Ä~øç?ìóâ¿x›âOÇŸêxçSðìÁð«Ãþ×u«ß‚²7‡#Ñ|g©ËãÝjsmãxWÄÞ&\ésüMø¡¯€{d:¬‹a¡júŸÅ ÎñüDo‚Þ4ñ§Â} låÔ5¨µE¶Ó?`Ø;Mcc=Ž•¥ÝøjßFøûñŸu•Ä6žñÌÚ¯…µ¿ øšëöEÌ“W¸Ò´½fòçâg€|/ÃïAð‹Æ¾,ø[á·ÖtÙÇÃÚ£xN×MýŠ?c­"ÛEI<_ñçÇ›¼/¢|Fø‰c¤_k6>'Ô.-,|+gªhÞðà ú½ì¾Ò|w%Çþü(¸ø?ªé¶ºµæ•¡Úx—Á¿°¯¼_mV>ðE´Pk–ÿÿà ´ÿ+Ew Ÿ‰cðíçlm—CÖôÿøCÃ_µpu»ûÝ ‰V–~0økð¯TøSa¥øóO²ñu¿‰ü#ûø/Å–¾&½Ôh7·“ÍeñGöÎø¯eyâ]_Mðþ«â ›}ûIf¼ÕtmcÆ>.øÂ}ški¼E¥é~"ðf‰s¢x2Çã?ƒüñšÅ—Eøg¢«MªþÞ·ž«7‡o5?jwžºÔ¾|$Ôn¼-§ßøXÝÝŸ\øsÆþ7ý™@*XÏ&¥ªiº6‡¯xÅóø«áͧÅïx7âÞ.›¯|bÕ4k Ã?íÁûjÏo¤h×>ø{á+Ûþç°ð°"Á-¬´\Ð<5á¿@ðÔÉâÖð…¯Œ´ï6ÿ<+©ë“®hÖþñWíÕâý(-õ/‹æ·Ón¡øaûü-‡Y¶] Ö:F¡¦xÇI×tm3C¶ñÅ¿ˆ|à?Ú É>%~п~ø7ÁÿhoÚƒàu¯Âß‹7þ ð6¯ñ/â‰üðgJý·~"iÑø¥¬þx Ä~1ÔÛÃß ¿a?††ã[0êO­ëP|A³K'ºñŒtoëzÿíáVŸ·‡ûâ÷„ôûŸ‡ÚÅOß@/éð~ÚÞ'×<[/ÅÚö[ý–>hþ>¿ý™þÝûøgÄ?>1ü<Ô®u/Ûøögý…þ.|`ø}ðÛáw†¼s­}—Kðoí ¢j?±¯Åy<+ªøWÄ~$µøË¢êFÏá§ìjÐ|ý˜¾~ÍúÏŽ¾"Ëñ#J‡ãŸ†µ|/ø±ûNx¶;¯fO†~*“C¸±ý’ÿgfïE¼ÓÇ?>%Õ¡ñÇÁoÙÿÁ>ý>øÛ↣uð_ö\ðfâ/|3øŒô·Šµ¼%ć›Ç~Ëð‘t_\Ew§Øø¿Ãÿ°Ï9xëövÐÿhÚ'Âþÿ‚xxÛJÓ< {ÿ ‰üOà¯Ù·Ã>!²Ñ|1¤ê:‹©ø™´ïèþðð²Zü#ÿ‚³ß'Ž¾ÿÁ? ýü#6¯â[›/:%…âêÿiÒ­¼EãÍRÚïâ„_À ·øKÿy½‹ÃÇÅ¿àŸZÎ¥¬ßÞÂü×tÛ£ãÿ†õŸŠ^µ“U¼ðoÀÿÞ§üS?~xbûWž+Ïéiâ¿ø£IŽhµ_'ˆ|Eãx°X¾ÿÁ^dƒL–óà—üÖÓ^—Ä’Øxƒ^ðŸíÍñÿ“è_ínÆ‘û=|‚ßþ |¿ü7}“á øÂÖ_xÇÆVºnµ>Ÿá-Uþê À —áüÞ;;‘¡üÿ‚uø?WOG ø;Uð—í±ñÓI‹à¿ìéæépêŸþi/ÿ»Óüâ¿éz›‹¾1ê)â½WSÕd»¿Ó<)¢išOÃÍáø·Ÿ ?à­éi¯ÅဟðN]Xj6šwÀßìŸÛkã½Þ‘û=ø"ö(m|o©x+AÕÿà˜—özïíã+=KÆB_Žž0}b×Lº×¬•~ßh£Ç:ÄPø'û&ÿÁ`¾xâ/„ôO‡ðOwP¸øÉûEü^ýŸu_~Ùß´N¹¦ü ÖÿhßÚã'Ç?x·YѵÏø'>¯{ñ“ãG‡´ÿŒÚ§Ã­⟊üC¥i°èžÑï¡ø}huψzwÀ=¾O„ŸðVGÕ¢Ñ?gø'LšV¡Úê¿´/~Ý_´O‹tßø_9’êÿö†øìÐÁ3|=¨üwñ¬zµŸ‡u écPøw£xJ].{»¸×£ðŽ½à „?ðUÈ.!Žãö{ÿ‚zø›F·ðܶ£¦øßöðøû­Ü|Rý¡,äÓßGøåñïRÒà—žoˆöžmÃ­à…žµøuáO Ii)ÓîŒz7Ã8¾G¦|ÿ‚±¹Ñm¼mðþ ýãí/SÐî¯>9Ç«þÝÿ¬õoÚ#â0H Ðnþ!jv_ðKeµµø'áK[bßEø é:,°\éºfµâ­[Öþ!Ð|VÛ/„_ðVÛõðúøÿà_üãÆM®G«ŸÚêÛ«ãîƒ}ñÂÂHõá?…vW_ðìXü6ýœü.»­y?täñ©âkUÓ­|]ñZm[â•ÇÅ ËáWüfÒï|Kðwþ ù¯êúö£Åøcöéý ¼ªjÿâ’îç¿>\ÛÁ2µ;Ÿß ôë˜ô%ñUÅ…ÏŒ|qã+{ RëþýĺµŸ‰t0;övøßâ¿Š eñçÄY<%ð'Äž ý«><~ÇÞ<³øUoªëšo€×à¯íâÿ€^ý¿`{‹ïü:ÖõÙ¾1Ùü*ðÏŒ¾$ügÁÞÕ´í^¾þ϶ð¥ÿ…ôÛoÙÐÜ&Ô.<>ž"—Sø‘ðÿás|.ñ7‡¼®j>ðªxƒÂ¿±¯|Mo¥išìßû ¿¿l‹ÖºÆ‘¤ëþ"±Ñµ»ýãÅúe¾›à+«[‡_þ!;ÅZŒÞ‡âCÍㇿeøHº/ˆ."»Óì|_áÿØgÀž6¶ÔîåñŸˆ§ÄúÆ?ø(WÆëOj7Ööoâ» ohò¾:Ò|Gý»ûS[×'½ÐõOXÁ⿇ ¤ð‡bø­á üCÓƳá/Ù‹Âúþ­ªøöÐý¬õ½JöͼsûDxÖê s[øyàMkÄ:CÙßi×÷—:¬ò[üHøáà 7í4z•Þ£k¾G¹ø~ŸüàßÖmmy™w¦Ç¨~Þß·­ûÁ Ýé¶ZTþµ_®SÁ—v‘xzKkËk~½Ñ?dД>#þÆŸ²çíãO x÷Ä_~üCø«ñ;áœÞ(øqñn] Qø#ûc~Ò:ŧ…ô/ê¿´÷Æïڟៀ¿hÙóöfð„¦Ó|+¡|?ø}âZø“ÂZşáeu¡j¾ øAtÅh³?Æ?Yør_ÙÏþ ñ+âΉñŸÂW'Âÿ†ÿµŸ…<;ûNøöÂñŸ†Ö×Pñ~½«x‹Y—·4?°_4ý[Æ:®‹/¿n¯èwzÿŽ´&Ñ!ñßÁû¯ø ö³mLj?à¡ú}ÞƒâMâ?ì+ûhx?ã/Ä ¿‡÷7žÓ¾6þÃ_¾5ÜxRûÇM7ìËð/Ŷ·öãOÙ›Àú‹^oƺo…þè¶þð‰üAâøžÏƾ=øÙ?jÚcÂíá›o~É|q«/Ç=gözøñ‡ö(øû"x›áU͜ގþýŽ?`[¿¿eŒ1øv 6ÚÏõ?Ĺ~è¾%ð·Œ~|cÒ4{›íÁÅ‚ -ÿn¯xnßMÒ>*øKöŠý›>#hÿ®~øÞÏáÏìSñ·ö†ðçì—áË­SÃÚW‡bïÙ“â—ìð÷öˆýš5¿Ž¿´¸¼?~!iõ½BÕ|M«øCŸü3 üøB~ßþ û'Yèúùñí'àØÇZðVµ­ÙhZ7íEð{âOìªß²—€4ÿ ØxƒÆÀ_‡Ÿµ‡€>x«ö£ýº¼càÿØë^/ñG¼/ñ BøgÄë¶7zOŠ¼áÏÚÄiࣰ—Ú/ìü/ÿÿ‚zøVá*øCc¬þÑ? xzâîÃâW‚ü3ãËP¿¶øcñX-ã×í‰ñoHø7âO~Î üM¤üpÖ¼eà¯øöŸý£üðKã?í¯xGþyï|ð_Jý“¾ÁC>h?ðO…Úeî«a©j´©¼} KŠµ›ïø–ÿÆ´¸´dÿ‚øÂ-[ž!ý«aê>;ñÎ¥ð“L±øMû/üoøû­x§Å~ñ-ÒAû~Ì¿®ÿjOÙOü‹A𾫫üUø‡£ü5ø¿ µ‹MJñ7ÅÇðßâ?ÆÏ WÙ?Ärx"_ŽðQ¯ÚoÇÚ'Â߈ÚÁoÂœñ‡€¿g +ÃÞ8_YþȲ^µû üý‘¾)øËÇ3éeðÓãÞ§qâ‹/‚óYéÚ®·¯üðÿÅ¿‡žÖ¿e@HøKû+~ͳˆ¼{ñáƒfÏÙÓâo†¯ü/ð³âÇdž? 4OüCø ðïÄ  [èÿ³ç…>,Ïáí{â¯íUût|u¸»Ð&ø‡ñ/ǺÇÄ_Þø³ÅÖ:î¥áTÔ<á‰Fx«Q›ÂPüHy¼qð÷àì¿ EñÄWz}‹ü?û øÆÖÚܾ3ñàøŸOøÇÿ øÝiâ-FúÞÍïüWa¡Íâ­XWÇZOˆÿ·j`–¾!þØ^ÑõŒÚìó¦¯Çï~ÏísâGá?ÂÄøMâ~ÆÆËÅÞ%Ó>+~Óÿ¶ŸÇ/Ž¿>þÏÞ!ý´¬|I¤kšœ_²÷Šÿh/ülð\«ˆ5K§\øÿ⦂“Àߊ4í~Çö¾ñÃ[=;Å^ Ñ~1ø3ö%¼gªü·Ð|©ÇmªþÝðSO‹÷ ÿfÏ‹´V‘ãñ¦ÜöWø«à¿„³Ö§ð÷MÑ> ø›öoO|)ñ×Ä/…à`ió?ˆæð…Žâ]#â.ñGÀÇâƒ<+ãíé>+ý®üU¥é7?µGíS{‰m'ÃßÙ£áý‘ÐÓÁÿ-´.ÃP[hšvœd ¾P‰|fø‰ñëLø)áoº·ƒ?hŸˆßµÍïˆ|á_øßK‡FÒ?jWÂ~ñ'‰|cñÏâw†ô=Tø¿Â¿ðKÏÙÇN»6š/¼)—ãïňŸ¾_üIðOÃ_ŽþÐ?@,þÏ_ |/ðáOÃoxsâçü-­âÄ‹|Lø¥¤i:]§ÅÛÏãߎ>)|Sø¹ñ?á?Á[]MÑ|)ð·öf‡ãŒ~)|@ø‰âOé:äÓ.|DÞÿ„7Àâ¯ßMû@|k½øû?xçãñ„¼wâOÝø‹á‰³øWoá›ß‹Ÿí¥};áOü·þ îš?†üQâkÿüDм/ð—â§Å¿ x3Äþ/¾Ömï­|=¡è:®“û*€s?³'»ÏÙ{öeøiðwWøïàiüMûËÅÖ6þ'ðìOà¿Zøš÷Qý¢>4ÞÞO5—ÅÛ;⽕ç‰u}7Ãú¯ˆ.môoí%šóUѵø»ãöi­¦ñ—¥ø‹Áš%ΉàËŒþðÆk]ដ­5þ«ûyþÞz­üÞ¼Ôüy©ÞxvëRøIð“QºðµþŸácwv|9sáÏøßöe©c<š–©¦èÚ½áÿÏ⯇6Ÿ¼àß‹ztºn½ñ‹TÑ®<3 ÿ·í«=¾‘£\øcált?øSŸVÃÂÀ‹¶²ÒtMs@ð׆þ;ÃS'‹[Â6¾2Ó¾4Ûüd𮧬hZN¹£[øoÅ_·W‹ô8 ·Ô¾-üWšßMº‡á‡ì#ð¶fÙt/X醙ã']Ñ´ÍÛÇþ!ð€ÿh0Óÿ†Z•Æ³ðßáö¯wâÏxòëUðG…5+Ÿü>¶K?xÎâûA°º›Åž´[ñ,v¾ñ’¶±á«hüGâƒF¼²‰u½UT_Îòí3iq§üGð~¿ýŸ£xWI×tk‡:×m.UøßñcûoQñ­¥~˳®‡Á¹ðŽ£ã+&çÅ¿þ&I6…ý‡ðÿCÒ﬚î?êß?gà˜í_WÒ ðÝÔú÷Á¿ÉðëÆ1ü%ñW‰~è“kìÛáÍJëCÑô¿Ø«ö1Ñìü=fÞ1øãã©ÓCðoÄï‰V¶:F«¥_ ·ƒ­¯tü>øzEo©ø_H»µ|øK7Á¯ɦßÝè<^)ðgì)àÿá‹?‡?mmô;Ëÿ·ÏÇ{/XKu-µÈðÅÿÄø ]+Åv"ð_†ÿjõˆµMñe•ŒßþÞ|)Õàñþ—¦ø²ñ?ƒ¿bŸøš=_WÕÿh¯ŒsZÍoñ_öÛø›eªë%Ñ<3©êV°èW>%’Fñ&³¥j~/ñ¯Åð í7R°ŸÇšn™aðÃ7ÚÇ/ øSâÌR`ü"ÓûvïUÿ‚€~ÜúåÕž‰qª|O×n<9ªê ~jWºýµ×⻸ñ?‡¥ðߎ¼oû6€G=Ž©©I¯hz6›ðçÅSø¿ÃúwÅ¿øâõ¥Æª|b×´Ùt{yÿm_Û‚x|3c{á/‡¾¹Ñ¬áÁÏì;G…´›+eÐ5ÍÃ^øñ7í—am§ìåûBjOð“ã…¾ü[ø}ñßZ±ø… ë¾Õ?m-'Ä_|]û!|Qý«¾?xÛÃ~ñM¯ì·ÿþýŽ~~Ö:ŸÆÍ[[ñ?ƒ>"|.Ö¾x{[ðlj¤ð‡„üoáox¤í{)î~ÀŸ “U½’ïÄ‘ßøÓOñÆ®K{ªx‹AñN±¯þÐÀé ©ÞÍá_]×¾ø®Ûø«àSð›D:_‰~8øHo\Ú~ñݭÒY¿ƒ¾|<}T¸ø«ñš}zÒ/²xYÖµûï ?â¾€|{ð:ÓTýš~7ø“ভyð“Àß µð»âWÁ?øÚóKð/Ž~*xû]ñ÷í;ÿ©ý5-CB–×Pø¦¿e¾øó㌚‹¾ø¯ÄÚþ(xàÏÀ‡þý†¼Y/ìÌõÝ„Z·‡“K¹Ôu‚ §øSãè< ©ê¼:Þ'ðïìsáéšìÉû6i6ž‘þ+þ׿á×4MÅž%Ó48ot[Ï%¦—à½y_Àñè—Ñj¾·ÕU®> ü¸ø=®Yk[ÜZÚxË𿃼se$¯ê·­cªéŸ?à ?ì|S5ÁÓÚöþÇÃð°í¥Žëâ&â(õ¿Ú˜=rÏVÑÇŽ­â_‚G€/ôïŒ~Ò~$BÚׇÿeÿ _?ˆ5=söâýªõ­V 1ã¿ÚÆ’Zkºÿ€þêÚ¾—&›¨i-s}ã‚Ñøÿ∫®iÚ¤þ'Òôí3ᆞ^ÒÛãƒüñžÚâÚâ94ÝO}ÿí÷ûwßÏ£èwz4Úu߆Úóà_Àëȼ1m'‚¢·»Ô¼®xORÒ¿e wn¥â{Ëý/NÓ~üM±ø£à«/ø_Â?¬¤ÑüMû[x³Ao ÁyûO~Õ·°øZAðçöhø^F³øwðÞ×BÔm5[+JÒ´û"¿þÆ0†ãÆ+£¼w^øݦ|tð`\_é‰á¿ÿÁB*ý®üQ£Úø’êÇöaýžm^;ëo†ÿ±÷Ãï+YÕüañû{[¶×l4ÝWTÕµ aÔ¼}ñÄ`;ñWötøûDøá¬?´¿ÂÙ?ãî‡áj_ ï5믂¾ øeoâëCYÓ¬ÿa_ø'§†|qá;ˆt 3Âoá‰ôŽ?´&ý…¨ZØx\’â êþñe×ì˜âÿ°WÀ´¼Ðµ­?^×?gëü[ºð׊­cŸÚ·öÊøð[öd>)»ðÆŸuûþÄ?¿g¿Šÿ ~ë¿>1köZd x‡à‡Å{/C®éß··íÓñÀ° ¶¼ºeLJ~|<ð/Äß>þÒ¶wÆáã‹Ýoᇊ| âß„]|HÓôOü+øŸá]sÁ>ýª@!¼ý”hÏ hú†›üÃãW€5‚~<_‹q[xãáïü“Äžý”>øª95SâÇÇË«Oø'Ͷñ?ö·ø‹e?ˆ¼KáíMºð§ŠtKêò]|Oñ—}«ø×âHÍOöAý¢- ø‡¡i?ðR~Ô4_Ø~ÑÞÑþ*|=ÿ‚r?àφ$‡Ä3j¿¶wíÁ¬j?ðO-*ÓVñ^¹wáýKXøIð›ZM#ÇÖÚ‡€m®n~)xy<;ñƳˆµ¯Ù+ö†ñø‡ xsþ +ûGj?FøåðçÀ¿þÿÁ×´›? ü ³ìaâOŠúιcñ?ö¿ý£¿kÿþÐ^±ñ/ƒþê¾9ðì“­þ×>:ðþ“§xrûãßį‰°çÀÙßãŸÃ؃á.•ã#iáøÓâ?Åïøž_xwQð焵¯CðOAø°¢Á>ÿfïj¿uêÿ¿km ÆÞŸIøÅû^þÙüÿñÏ/5Ÿøk‹ðkãÇÇ/Œ¿ ý‰>x“W0ðÄOøwâíØÕ¢ð§Ž|=â9ä²Ò|cñ¬ؾ~Ëÿ³ÏÀÍSOñWÂ?‚Ÿ²7ÃÝgâƒxëágÅ_þÉ_<ð‹Æ´§ŒEƯ¨Ý~ÄŸ²Áð¿‡<3w¢üð}ß‚þßñ—ã~¯â$7±|1¹×¼Q¨øjMÆþ?ø>ïv3jšMLJ¯õOü(ðìþñ%ïÀÿx³àÖpÖþ…ïmmtïØö³MB½Õ|H÷ ž‘ñ·ã%¤¯¦jžÕ"·ð·‚µÏ Zè_³H+µo&—s¨ê?þOð§ÇÐxSÔþxu¼OáßØçÂ1Ó4?Ù“ölÒm4Á@~9Øø¦kƒ§µíý†ÿáaÛK×ÄMÄQëµ0zåž­£[Ä¿þ_éßü3¤üH…µ¯þËþ¾jzçíÅûUëZ¬cÇ´ÿ$´×uÿü=Õµ}.M7PÒZæûÇ£ñÿÄåÛ{áÏŒ¾;xoUýü§|0Ó<7ñÖÿBøñŸ@øÀ·Öwþý“¬uSRøåûm~ÞßØ>Ôô _ö°ø}wû0~Íÿ4ÏüøµðúËÅ^+øñðßÅ>ñÏì©âO ~Ê[Üiº—‰ï/ô½;Møsñ6Ç€¼sáüJ²“Gñ7ímâͼ7çí=ûVÞÃáiß٣áx}ÏáßÃ{] Q´Õl®4m+JÓìŠü?ø{¡Á usâØŸûxøëAø u¿Ûþ g«Ÿ‰ž°¶Ò¼1ñê_ðRßÚâôøëÚ]–©®Y麋|ïíý"ÂÓZÖ-¬ôýBÞÞ SPŠ4»˜ô‡ÄzÜ^ðö½â9´ýkW‡@ѵMn]+ÚUÞ½âN-*Æ{ù4ýC°Ioõjõ`6Ú^•e—zô°Z[#Í2)ñOß´Ïþ›â/…mügáo /ŠõÙÞ|Rðv³ðÒmc_Òõ9´;ûmÛÅpØK«G¿k} yöBT“YÓï´øŒ“ÛºÐ[âÏŽ¿¼ ¬ü<ÐÒöPÜÜ[ÛËt±#žxby’¢°D¾2ð„nóüWḳ!¼¹Ô¼ÝsLû:ßNÔIÔ./·Ý²CcªÇ&™y-Ç––Ú„oe;%Ê´`I¼Yá[xe¸¸ñ7‡à·‚îÂÂyæÖt衆ûU¶¶½Òìå•îU#»Ô¬ï-.ì-݄ז×VÓÛ¤‘O¸!©üjøK£|MÒ> êÿ<%¦üT×ü7yâýÀ—ÚÍ¥·ˆu/ØëZ‡®5+[9¤C"kĺoo¸^^O¨Eö;yÑ'x€.ø_âo†üaã/ˆžÑc×$ÔþÝø~ÃÄzÖ…¨ÚxnêûÄZlÚ¤6~ñð®“â+½*(^×Ä–úUÍÄÞÔZ=?UKk©2ÓIâo ųËâ8 Õ×ÃóM&­`‘C¯¼‰ è’È×#ÕÚib‰t×azÒHˆ!,ê¥å¦¡ikauo}c}oå•íœñ\Ú^Z\ij[]ZÜÂÏ Å½Ä.’Á €};}«áK}UZãà¿ÁÛƒÚå–±½Å­§Œ¼1û ø;Ç6RHúþ«zÖ:®™ñ£þ ñÎÇÅ3\=¯oì|7ÿ ÚXî¾"hÞ"[ý©€#×,õmxêÞ%ø'ðäxÿNøÇá'âD-­xö_ðÕóøƒS×?n/Ú¯ZÕ`³;ý§üi%¦»¯øáî­«ériº†’×7Þ8-þ 耺æªAâ}/NÓ>iåí-¾7ø?Á_í®-®#“MÔ÷ßþß·}üú>‡w£M§]øm¯>ü¼‹ÃöÒx*+{½KÁZç„õ-+öP§q¦ê^'¼¿Òôí7áÏÄÛŠ> ²ñÏ…ü#ñ*ÊMÄßµ·‹4ðÜŸ´÷í[{…¤f…áôk?‡ ít-FÓU²¸Ñ´­+O²+ðÿáì`n-ð†•ý“â¯ÚïÅ=¯‰.¬fÙæÕ㾶øoû|>òµ_Æ·µ»mvÃMÕuM[P–KÇß9¬ÚT–¶¾×..-<1­xOÅ—²`kWÕôˆ<7u>½ðoÁ2|:ñŒ |Uâ_†:$ÚÆ…û6øsRºÐô}/ö*ýŒt{?Y·Œ~8øêtÐüñ;âU­Ž‘ªéWÄÃmàëkÝ#Àÿ¾€[ê~Ò.ßí_þÍðkŲi·÷zŠ|û x?ÆðèbÏáÏÛ[}òßãíóñÞËÅÖÝKmgr<1ñ>Jñ]‡ˆ¼á¿Ú¤=b-c@Ó|Yec7Á?…÷Ÿ ux<¥é¾,…&WÕõÚ+ãÜÖ³[üWý¶þ&ÙjºÇ‰tO êz•¬:ωd‘¼I¬éZŸ‹ükñ|FûMÔ¬'ñ曦X|ðÍÆ6ŸñËÃ>ø³ŸØ?´ÇþÝ»Õà ·>¹ug¢\jŸõÛjº‡Â_ƒš•îmuàx®î*ý»¼Uá•ðí½×Æ¿wVþÖÇÂ?؃áÖôÈ<9áÈ4ÏØxÂÃÅzv£iþ!!ð€~<6Ê{K¤]ÝkŸþ1YügðΧáíGTÑtÔð߉?nïøjÓT–?‡^‹ìž O†°'ÂäÕod»ñ$wþ4Óüq£ë’Þßêž"Ð|S¬kÿ´0zCjw³xGW×uï‡~+ŸÄöþ*ø;âïü&Ñ—â_Ž>#ÒÄ×6Ÿ°Çìwkt–oàï@Õ.>*üfŸ^´‹ìžÖu­~û§Oøãï„`9x‡öÍý™~üH“áŽ?jÿÙ¿¾\·Ãˆÿ þx§Cñ'Ç_‡º6­>„¿`OØö~ðÕ¥¿ÆxßÅwGÂ^ñïÄ øÏÆšï‰ílt?øAñ…·‡¼-û:€yE¿í¥­?…¼?âÿƒ²§ÇÉð¯â|_ ü]kðãöi¶ýdý…<ã8ô}7Âÿ³¿ìñáø(ßì[sñëö¬øýöí?Ã>)ñ?½źDž/üod—çÓµ¯„¾ ø Õý—öø¸ñKAâ;¯ø'÷ìAðçàz躯ˆm¼!}ãßÛ#Ʋ~“ñkÁŒÚæ·áÿxÃáÿÀ/…ÖðP^ñ%åLJuxö²Ñ¾"é?ô½SXðg†tÆ•?m b_Ø;Ãå~+CûEü\¿ý¢†‚Éñ LðWí·âŸ k?³çìãð[´ñ…γûR~Ú_³—Á߇ßdoÿ´W‰ïµxÛáö‹ñ“à߈~*Câ+}.ãÄÿõ]?áîŸã…€géÞÒ~è‡áÃ_|øwà¯xWÿþ|ñ߇m¼'áïøgÁMo¥i¿¶·í•¦éÞ𽟂4oÙø>Úßörýmôÿ¦…cà %n|©ø6÷Eý“€4î4ÝKÄ÷—ú^¦ü9ø›cñGÁV^9ð¿„~%YI£ø›ö¶ñf‚Þ‚óöžý«oað´ƒáÏìÑð¼>gðïá½®…¨Új¶W6•¥iöE~ü=ŒŽñŸ‹.®cð•–§øCö˜Öÿi ¦ŸáO‹+o x·þ â_ éZIÖ<{ã+ÇÑüOaû=ÿÁ0>Øx¢ÛXñ'Šd¶ñÕ§¬|W¡h> Ò¾'x‡âÏ¿ þÛ`¼ áµ½²ñŽ½ã_|uñÇ‹-_Á¾*x{J—Eñ_í‰â Xø¡ü5û ~ËÒkÀßØàŹñ¡uªéÞ$×ôýVÞ/øïƺïŠ|wãÿŽß>%€wÚkêQYøCVÔ,Å'öÂ-1ÿ·nõ_ø(íÏ®]Yè—§ÄývãÚ®¡ð—àæ¥{ _Û]x+»øz_ øëÆÿ³hsØêš”šö‡£i¿|U?‹ü?§|[ðo€>/Z\hÚ§Æ-{M—G·ŸöÕý¸'‡Ã67¾ø{á‹Á~|þðx[I²¶]\Ñ<5áŸ@Ÿ§Ýøºî+KH¼ñª?^ÓuýG×ôÕðÏŠ¿nïxe|;ouñ¯ã]Õ¿‡u±ðö øF5½2xr 3Åv0°ñ^£hÚˆGˆ|à ²žãÅéwZçÃÿŒVü3©ø{QÕ4]5<7âOÛ»Äþ´Õ%á×¢û'ˆá‡ì ð¹5[Ù.üIÿ4ÿhúä··ú§ˆ´ëÿí ú‹ðÕ5Hþx=m|šÊx+©«§ÃU¸_‡Iª.…`·ëà»í|·bQáUºàhBÀL<ÍÔòGí/i5—Å_x¶ . ÛXx_þŸ|oÕï®u/hZ‹µmFÒßàÏì©àô¹šOøh/Ží®—£ø—ÄúM¥…õ—…t_ C³Åzòx3OЀ>sÒ´ ß Øø'‡¾|)—àæ¹6™pt[‹xöðg¤µ³²ð„`·†þÓãGíóñÏOñ†¨^XÛjòøJóâÝEˆ4ŸxOMýª@(E¤jZ•emiáO…_ n~xßRñ¶›aã¯Yø“Á±w„|Kë:çÇŸÓj÷ö¿nŠ¶> ׸øƒw-׋/4«¿ø×âø»¯ ÞXi:冗࿇>›Cñ‹|rð¿…¾+êÍ&ð²ÄÏy¨êÿ·ïíß«ÝÝi¬üF¾¼Òõü!ø7ªê6ŠÜønÆy5]ÿÀÞ5ñgìÊjžÔ/‡Ž´má÷ƒ¼G?‰¼A¢|Xðw~-k?`¿ø£â’ ?mŸÛ‚h’ Ýàÿ†î|7¦ÿ—ø3. ö‘ü<Ð,¬4oëšO„ü7ð$i¼4Þ-OZØøC¿-þ4éÚ6¹¤èZƧ‡âÿÛ¯Å^·Ómæø¯ñoQ·ƒY‡áoì#ð­"ÇÚÛëºOŒtÍBÛBÓ4oÛøãÀ^ý À<ßã/ÂÈhŸ…ß>ëZ…ÏŒt_ÚÓö{ñ'ÁÿüDø;â]À?lkSð½Ç†_Møªkð™i_c?‚6Þ3Ôµ®ê¶>4ðÏŠ®|U>±¬XxãÃ:ïˆïhÀ ÙŸÇÞ"øåð“á÷ňðͯüoðßRø ñù~ZÉáøÛãçÃ]cÄ~ ø¥ÿóýŠ,ÛÄÚ§†~|ø§àø—ñÿÃßµOëÚoƒ®þ"è?/ü#§ø“ãoÃdÓ,u *󺕀|;?‡ü?â/‚ž)ñ?Á{ß%< k_ǧþÀß°¤xvõü}kqá› ?Œÿ´ËO j\|=–l<'®xNÒÿfàœÿhƒ_ümðnÊßácü ø ñÿöz¿Xø)ã]V×åøUûøçÃú®â?„²‡ÃÈþèz§¾%|dý§/íü3ðWö²†Þ‹Å~,ø ñKâÃ? èzÝ¿Ä_øâ@sð[â†þ"x+Ã~3ð…ðïávŸðkãWÅj$º·×ôŸØ#RðÄŸ|ø¹£øÖ{«ísGøáÿ ø›ñ ÃÇ>_Ñu/xNÒûÇW^!ð¯~-|?ñn™ãÚ´Ñ“@¿Ó“ìqxCáGÃ÷ðánøcCø¥âõöhðÞ¦5ÝsöÒý°µ½GWQã¿ÚÇÒk¿ü%«kBãOÕ¦kíKÇPͤüEø‰á° õÏßÛÃâÛ-;Áµ/âm'ã—„|9ñ§S{Y⸱žîæûþ ûw=Ûø~òÃNÒ¯<3öÿ‚?5 }TѦøw£Ù›k>¸Ó?ek~»ñç4[x;ǶŸ.ô¯ø[Á¿u…±ñgíKâß ÝéÑÝþÓŸµ]ôw àÏÙ?ác[øzÏáßÈtMF Ý+Lд#à yðãá­XÖ´9<]?ŠJxgÃtϾ²‰EÆ£oá¿~ß^%ðÏöt&åƒM«Áð£þ õð’ q ‘Gü$z'ÄÝ3Æ_ÙAã}ÇMÿíX^îÖçÄ÷jzŸ„¾(Ø|Qð ñW‹¼¨C£x³öÅñ5Ž™5Ý—ìãû0ÛK¬ÍÃ/ØûÁq˯ë9ñcë²Ùj–—Zö¹©ß^C7Ä_‰~"¿ׇu}FßÁn<+©üñ‡Œþ Ü>™ý«im¨=ŸìûØ4þŸKÒ´K¿Ìß~9A7‡Ëþ+ûB ë~ ñ~Ê Ú]–£¢§€¯n4ï…ÞYj_ 2ðž›ûT€P‹HÔ´*ÊÚÓŸ ¾Üü,ñ¾¥ãm6ÃÇ^ ³ñ'‚ÿbïø–%ÖuÏ?/¦Õïí~*þÜ?l|A®xŸÃvº†§t|=qñî[¯^iW~7ñ¯Åð w^¼°ÒuË /Á|56‡ãøåá |WÕšM;áe‰žóQÕÿoßÛ¿W»ºÓYø}y¥êþ%øCðoUÔl5¹ðÝŒòjº ÿ¼kâÏÙ”Õ'ˆ/ãñ%Ü—šæã?Æš¥õìÞ(Ð|E¯ë´0Ú~Ÿy¨ÞE­kQx+Å(ðUÇÂxËáÃi~"øÛâ--µ)mbŸØ¦Ö]JÆãÀÿüqc­IñsâäºÖ„¶+¡jºî»ªxb_ |Aøƒðd=2ÇPÒ¯ý‰3~ßÿ´‡‹îÆãÏñx^ŠÓÍ.­ã#]“Sý§ MÿNO±Åá…ßÀ^5ÿ…»áâ—ˆ#Ö4oÙ£Ãz˜ÔouÏÛKöÂÖõ]GŽÿiÿH|M®ü;ð–­­ ?V™¯µ/C6“ñâ'†À+øÂÒ? h¾>¾ºð×ßèÚV¯kûCéuè´[=Ó@ú¦»ÿý¿õ-^ãÃ-¡øíá9µŸƒŸ5•ðåç‡Wᶗ ñü<Õ|%u§~Ë%~Éÿ¾%xßÃ~7üUøO¥kÿnŸéß´?…¾|v»:Äÿ|>ð™Òü?û=k¿µýµÆŸ©ë?gÙ×áVàŸxÛöu·¿ø‰à}7ö³ñ÷í ~[ÚxÇŸ>@övµ¡ÉâéüRSÃ>øã¦|mð•”J.5 ø£öúñ/†³¡7,m^…ðO¯„k‰Š?á#Ñ>&éž0’þÊè~8ÒoÿjÀ@ÿ‚E^Þj?±…Æ¡¨ëžñ>¡ûeÁN/o¼Kðî·øâ˯ø)‡íu=Ö¹àhSÖšjÓÈ÷þ…µY£Ñn,êwä©@?G|C>¿m ë—ÓtkÅi”þÑüC®^øgAÕµø¬§“GÓuÏiÞñn£áý"ûQ[{]K\°ð¯‰¯t«)g¿µðþµ< §\€~3üIý…ÿhߌ¿°O‡?e߉ÿ?d/x¿ÃŸ¶ÁߎM¡øƒã_ÄO|0×¾ø'öÉÐjéøSý“­üA¢ø·Æ µñGÀÓ¦Úø QÒ®ô/êÚ¾£âdÓ®ï¼%xãúÿüÓã$ß ¾ ­·ìóÿïøƒñCö|ýª¿oO|:ðWÆ-OÅ>$ø(¿³×í=âoÚÇ?¼ {ìÃqâ?Nø âŽ^ÓÀý –^ºÑ¾ý·Â|#}6i¤€[ø—ÿæý¢ü?ûUü]ý®îüO¦|QÓ%ñõÏí¢ø‹Âz·†´ÚÃz~…û;¿Ôg¿†þµý•uß‹,ð•æ±¡OcàX~Ý_ ¼«iþ?¿O|?¸ñf•¬x‡âHÆ¿ðK_ÙÿÂ7ÿ¾-|)Ô> þÄ_´oí1ñ'ö&ðw…5ŠŸ ×I›özðφ|(<á©> þО/öi—Æ_¿høºîÛâÏôSÃ>>Õ>.êÿ¬¼E¯è~¾øk£:€}Y¬Á ¼Wìaû#|ðoìóûxwâÂkÿ\~ÒZ.‘«höú_ÇKá¯Áoü3ð׎WãçÄ_ØwãN±ÿ &¯®xÓVÖü^2¿Ò¼S¬hú_Ž.-.é|fØü7ÿ‚l~Ñ~×?àžß5Ï…?°oÅ_³—ì³ðÛöcøéñOâÆ­ã¯k“ëŸ |sû6¾•ûK|:ׯ>é¾3ø‡ñf_‡ ¾!Ká]?Æ&ø]yð×Ç>,Ð…·Ä?hpk’ß}{ð›ö\ø×àŸÚ³ößøgà?Ù÷à·Â¿Ú«ÁÞÑ4Ÿ|ø‘â ŸŒV^9ðÏÆxãøÅâ¯^þÍÞ ð]ǼwÅ-;Ä:õäß"þÍÿõÏ„Ÿ4_†M;ö†ý« xâ¿Æ«}cGÿ‚ŸÿÁGµgÆþý·¿m‚ÿ c]/Ûûö ð1¸ðÃ…?´…üqûW|iÓüA¨è> Ð|á iÒøÇžñoŽü)®jZôðþÐ Õ©þÄ^0Ц¹´ø7ûO|wý’ôÏ |YoÚ*xïâÿ¿Úsÿmµ¨/ŶísãÛÓáí[ãY~=üK´´Ôu?‡?¼ñÀþð¶¹i?Š4ÝKÃÞ)¼øïñv€+ø›ö1ý¡þËñOÒ?oÏÚ›F}Sâ&ûDøBø½á_ø' ~·Óîu{«ÿÛoöØmgþ ÿ¥Ïoá 6ïC†÷àŸÀßÙÇã½_…^³]sáî·ácNýš6|Ið/öéšox?áÇÇÙ›âχ¾ xóKø—àÝ+öÍý–u/|vý¬,ôvÑgÖþ8þØþ+ø ûG~̼1û7üñ Ûit¯üÓtØ>i?>êŸ ¼Yã;/ Ëãpø£áWüSÆIñ(i?¿`¿Œ°üv]&O«~ß4ÍößÓ|..!½ÑüIgü×±'¸2Ááß„^ ÔuÙ´ýf Eÿ‚xêgß´®±‡†ü+ãÏø7MñÕƱ®h©¢µ®…=Ãïxxuoø(?„â²Hý’?à? `ø!•kàë›OÛ§ã­àÿØöÉá[=[á*éºüÃÄšm‹ÚŠõ½ÓÆžŠz½ïŠ´+›¯ŤüXÑ4ï “]ÿ‚„èŸc²ý?à¿ £øS çÄAã¿Ûûâ׈¼+ûxÄúU†»â_‰?´+KûêjOŠx“źׅ<sâ sÄZ-¿×W½ð³Ùk^>ñÄÐ ÿ²³}6×ö5ÿ‚}xR *Wö‚ƒÃ¿ÿo7°|ñÜkâQmÛZîÿöЗÆ×úØkß <9â-Á¾/Ñ•þ£‚TøIâ_| £©i¿ðQïçÃzOÁØàìÞ"ñ‰ñËYÑ~,|Søáû[ßü\×´O]irþÑ¿µ?…£øoûÞx[áÐt-ÄŸîüG¯ßMð÷ZøO£|<°ý˜|Cysàýoödv¡ðƒþ +ã ;â Ž‰ñÛöø¹uñ»\Ñ|Qá]7Ä_°ßÆÍ?Ä?¶þá»-gñ§Æ£cÿ»o‡ÿ±÷ýðͯ†õ‹[¹ü#ã vðæ›ð£ÄQ|Eøy௎`k?³í+ñC\øâŸ~ÞŸüaÿ àü:t/Ù£áŸìYðËÂßµŽ©ámJËþŸüѾ<|ýª¾'ü6ýŠ>x_T6?õψ~,xâÖ»ñÇþ2м-¢xÆ–¾øžýö½ñ_‰¼3ãßµíEûKj¶¾³øA'Š¾|}²ÅÇÅŸèo©Ï«þȲW…?aMö<ÒÏàÒ7íã¿I¥ÿÁ:e3áo øãÁŸ|wð†‘&·à/Mñ³â—Å_Û‡OøS¬ÙÚêÚ^•û Á9íÿkß|OÕ¼!ñÖ= ßLø×ñwÀü<ÏàâG…õýMÓfЪ¾|<Ñ>ižÒ<3à/€³î‘ð{QñW…î­~ hZUÏÃÏؿßõa¨ŸÙßöoðg†t3cñ/öÙøçªxƒN?|K¢xSíókž+¼–Óþ&ŸÄžð/Ä° ë-PðªøbøEþ|%Ÿá'îoíàÔµ­?Æ>ý‰3~ßÿ´‡‹îÆãÏñx^ŠÓÍ.­ã#]“Sý§ MÿNO±Åá…ßÀ^5ÿ…»áâ—ˆ#Ö4oÙ£Ãz˜ÔouÏÛKöÂÖõ]GŽÿiÿH|M®ü;ð–­­ ?V™¯µ/C6“ñâ'†À'×&|ýŒ<ðÿöâñgÄ‹+߆ÿþ7G⟟>3ø þ 'ZÐþ?_i¿¬<[£þË?³õ„úä÷¿²ÏÁ¼}ã]ø§ÀZgÇß~Ïß?jo…´7í^ïŸ ~ XøE.õíWö”Ôþ2x!<)ñ_㿉> Ýk¿¿oˆI©â ~~Íò^ëøoà7ìEá-c\ñß‹õÏ ü2‹Àß<iâ_¯Ãx3ÁRxçÅ°³G§_ÇuáÝ_Q·ðEÛ ê#iºf~oô8mm´5¿³ðÿ‡ÀþÆO†~!iZwíÕᯠxáø§eðóMøq¬L4]_Â?±ì1¦É♿fxFÐ$¿µøÇûjþ×–?|}ûDé÷^-Ðávü.?¶¬¿>(i-3á÷Ã?ŽÀ_ŤjZ•emiáO…_ n~xßRñ¶›aã¯Yø“Á±w„|Kë:çÇŸÓj÷ö¿nŠ¶> ׸øƒw-׋/4«¿ø×âø»¯ ÞXi:冗࿇>›Cñ‹|rð¿…¾+êÍ&ð²ÄÏy¨êÿ·ïíß«ÝÝi¬üF¾¼Òõü!ø7ªê6ŠÜønÆy5]ÿÀÞ5ñgìÊjžÔ/‡Ž´má÷ƒ¼G?‰¼A¢|Xðw~-k?`¿ø£â’ ?mŸÛ‚h’ Ýàÿ†î|7¦ÿ—ø3. ö‘ü<Ð,¬4oëšO„ü7ð$i¼4Þ-OZØøC¿-þ4éÚ6¹¤èZƧ‡âÿÛ¯Å^·Ómæø¯ñoQ·ƒY‡áoì#ð­"ÇÚÛëºOŒtÍBÛBÓ4oÛøãÀ^ý À#žÊ_\k—WzG†~3Yübø¦èº¦£áíNÓÃ^'ý»¼Iá´´ò¼ ðê9u]U>~ÀŸ Äñø’îKÍsGñÆŸãMRúöoh>"×õÚm?O¼Ôo"Öµ¨¼â‹x*ãጼeð‚á´¿|mñ–Ú”¶¿±OìSk.¥cqà‚~¸±Ö¤ø¹ñr]kB[е]w]Õ<1/†> üAø2ú{ðËHºðÿÃ‡Ú +à ÍÁÒ.ü àK£}à]iº …•Ç„¼zt_ ›Ï ønX_GðõÑðî‚n4‹;9N‹¥ïû &~ÒÖmÅ_x¶ Q²oødɪ|kñ}Ì’xà^âÍCXð´ðKÁòG"|Aý¬þ1ÜÞÅðßÂ)§éºÜÞ Ð#©ÜØ·4/†>bÓ´ íÛáå” |!ðæ_†>/Ôüma¥xßÇ6¾#ðìuá_ ‹ý_ã¯í¨Íâ-b/Œ¿·7ÅË/ëWÞ·šïÅãÃú=BëÆÓÙ_ø×ÇŸ€#±ð¬Ú^‘g§iÿ ´Í¡|@Õ¾7èøÃãv½Óþi].©ªþÝŸ·ö±yâ7Äu[Ý#\ñ'Á„·ÚŽ¡«ØO¦iO-ÿƒï<ã_~Í`©á«Û½#ÄZF“ð‚ËÄrx£â›ñ_ž ø³ã1§êŸµÍ2ê/7öØý¹µí¹Ó> ø:çúuÏÁÿ‚dÔ/-ôßøCGµð_‡umÂ^øcPðšø˜üF³ÓþÂ×ã7ˆ´}wEð÷ˆüg‘ãÛ[Ä~¶[+ÏŠßo†¡ªÃðËþ ùð½ÃÃ>k]RÃÅz~ÍHø}¯ÇãÏøãجigÅ|C¼—Àð¹,>2xwIЯï|5âûo øÇöæ×´(PEðëá|÷>'¹‡áì ðÖnøk×3ëCNñ¶Ÿ®xŸRžÇÅZ'‹|C­~Ѷ‘5뺿„müO?ŠþèŸ ¼Sâ*m#Ä|K¥”ºµýŽ¿a‹KŸhðóàGƒžË_Ÿã7Å[SÀvžUö¿­k¾>øðŒâï†:T¿nÏŒ¾Ô|;ðïÂ1þÒÿ4ω¶š·Á-_Å1Ò~#| о~Ê´ŸìKû Ik/†¼#á¨ü!à Á=?Ãûëï‡þøW?¿x‡Àš¦©àOÿÂQáoÙÂÞ(ߦè_³oìÛ¡i¯r>&þÜEφ´OøÃEðÕÄÖÓ\\iºmƼº÷€¼ñÞ‹ ^øjãÀ¨>x3á-×ÂMGZÔV[Åö>6ðìKáo¡•õïH5¯é¿à¡ôß¼ñê1ZøhøûY’xÃEñMÆ£ûM€|;ñš×ìÁñ?Eý¦tƒ–ZÃ}Kâoà ŸŸ(]|xðûx»Lø„öÌž»ŽÝ´û„ztRŸZ|m𯅾6øºXÞãöóý¾¤—V°¼ö7ž–÷à?À«ÈÛ[Ðï|!á˜$Ó>ë¾ žÃöY¯­øNãÄÑøëJ²ø?oãø¾"øßþ:𿇾%xÝ4ï~ÓÞ(ðãA ÿµí_5¥äëàßØßáÃXhü9øFºn š–“áý'BÒ>Ú›ï|<>"ÐÅïãÁÃoø\ºgƯìå³[ïÛè,ý»uÏ \DæáεªÃð¿þ ÏðžvÞ7Óæ}cJø—¢k׳ØxSÇ:ô›Ú¤irø¦óÇú§Ûâ—ÄÏé^ñŠ<ãü3âÿÚÛÄZc}¢Óöpý—-¥ñe©øQû!|=Žï^‰~1½×ü?gâÔ5½sU¼×c›Çß|DvãJ¸[£ª_øSL¼-àþ x¯Æ¿¼Jú9Öõ‹[1þÂßðOK&Öü)wá½K»ðåàøÏñ­&ø|–SøRâ ­GG×| â7ý–€!µÒ¯tCÁ×~𯃀< ­ü+ñ‰~x„KáŸÙßB¿‡û3Jý?bØM¥Üø‡ö‘ñ]Λ i?¾(éÚ†®-“G·°³¸µžÏÀ¾ðZ‡fð­ŸÃ¤_‡ž øS'ÁÝ:ûI¾—Jñ4,ðìCá_Kqe¥øÂð_jöÿ¿à¡ŸôÿéZF»­i¶Zððýߌn®Ž»¯é~7ð–—ûPG§hÚ ·ÃË(>øCáÌ¿ |_©øÚÃJñ¿Žm|GàÿØë¾&ú¿Ç_ÚQ›ÄZÄ_no‹–^!Ö¯¼/o5ߋLJõßjz…ק²¿ñ¯>-GcáY´½"ÏNÓþh>›Bø«|oÐ<-ñ‡Æí{§ü.Ò$º]SUý»?oíbóÄ>oˆþ(ê·ºF¹âO‚? oµCW°ŸLÒž[ÿÞxƾ*ýšÀ SÃW·zGˆ´'á—ˆäñGÄ 7â¿…<ñgÆcOÕ>)kšeÔ^oí±ûsjÚ)s¦|ðuχt럃ÿ>ɨ^[é¾ð†kà¿êÚ„¼#ð$Æ¡á5ñ1øg§ü(ÿ…¯Æohúî‹áïøÎ=#Æ?¶·ˆü9l¶WŸ¾2ß CU‡á—üóá„7z‡†|Öº¥‡Šôýš6‘ðû_ÇžðÇ°XÒÏŠ ø‡y/€ÿárX|dðî“¡_ÞøkÅöÞñíͯhP ‹á×Âùî|OsÂ/Øá¬:Ýð×®gÖ†ãm?\ñ>¥=Š´Oø‡Zý¢%m"kÝO_×uÛøžü;Ñ>x§Åß|TÚGˆþ8ø—K)ukû~×>&ÐáçÀ=–¿?ÆoŠ·§€í<«;íZÖ,…|}ñáÖ:e敨XêW¾ðÿ‡çðï€o~ øŸÅ?;ÿ ÜZøùï|=i¦|føÑgaðòâ-CÂÖ0Á.®xOKÓ¿fà ïø~}‡÷×ßüð®…~ñ5MSÀž!ÿ„£Âß²/…¼Q¿MпfßÙ·BÓ^ä|Mý¸þ&‹Ÿ hž1ñ†‹á«‰­¦¸¸ÓtÛyuïx â½@½ðÕÇP|6ðgÂ[¯„šŽµ¨¬:·‹ì|máØ—ÂÞ9C+ëÞ,k^%Ó~4ÿÁB>7é¾+yãÔc2µðÑñö³$þ2ñ†‹â›Gö›ÎÒü3q§Çá(‡Â ü?o|HÖ~.hz7ůˆI®xönðÖªÓj:÷íûfë~+º‹âíMñOâ]sáo„õ oÄw~Õõ‹mGRñž†Ú/¾ xpÄž»ŽÝ´û„ztRŸZ|m𯅾6øºXÞãöóý¾¤—V°¼ö7ž–÷à?À«ÈÛ[Ðï|!á˜$Ó>ë¾ žÃöYø›ö£Ó¼kñ»â÷‚d/†ÿ £ñ§‡~2üDÑ?j¯íñÅšpÖh/ƒ5 ]âOímx’x£Løsû/|gøÑoðãÀ ~øßáî«áoŒ±ïÁÏÛGÂ_|;àŸŠø%àø>âñ€ž/~ÂåÓ>5g-šßx¾ß@ñgíÛ®xjâ ÷7u­V…ÿðN„ðë¶ñ¾Ÿ3ëWĽ^½žÃž9Ð<¤Ü~Õ xƒK—Å7ž8¿Õ<ßl¾&xJðˆüQàÇáŸþÖÞ"Óퟳ‡ì¹m/‹-OÂÙ áìwzóüKñî¿áû?&¡­ëš­æ»Þ>øƒâ  ÿ‚þÛeŸÙêãà—Æ'‚þ#Z~ÚðPýüÿ‚~þߟ~_jÞ)ý½?jïˆúðâOÃÙg]ðÄ/7‚®WðšxGR¹¹ƒÂútñêZ^‘¨hºÖ™¦}£ÿgý¼¯;û/öÕòá+ÿ„Íÿ‡_ÿÁM¼¯øN>×öøC|Ïød=¿ð•ý¿ý þìÿký¯ýì~wÉ@ÇüŸö>µ·Önî´¿ÛVÚ×Þ"Ó6øWÂß|],wÌÖNïqûyþßRK«X^ {Ï K{ðàUäm­èw¾ðÌiŸ ußOaû,€WÖü'qâhüu¥Y|·ñü_|oáßx_Ãß¼nšwˆ?iïxq †Úö¯šÒòuðoìoðá¬4þü#]7PMKIðþ“¡i mM÷€> h â÷ñà‡á·ü.]3ãWörÙ­÷‹íô~ݺ熮"spçZÕaø_ÿçøO»oéó>±¥|KÑ5ëÙì<)ãÇúMÇíRˆ4¹|Syã‹ýSÀíñFËâg€t¯øÅñŒ~ñímâ-1¾Ñiû8~Ë–Òø²Ôü(ý¾Çw¯?Ä¿Þëþ³ñjÞ¹ªÞk±Íãïˆ>"»q¥\-ÑÕ/ü)¦^ð ¼Wã_‚^%}ëzÅ­‚ÿaoø'¥“k~»ðÞ‡¥Ýørð|gøÖ“|>K)ü)qÖ££ë¾ñþË@ÚéWºF¡àë‹¿øWÁ‡ÀÖþø‡Ä¿ ¼B%ðÏìï¡_Ãý™¥~ÆŸ±G‡ì&Òî|CûHø®çMÐ4ŸˆßtíÃWÉ£ÛØYÜZÏgà_x-óxVÏáÒ/ÃÏ|)“àî}¤ßK¥xšxö!𯌥¸²Òüá x/µ{ŒßðPÏŒz‰t­#]Ö´Û-xx~ïÆ7WG]×ô¿øKKý¨#Ó´ íÛáå” |!ðæ_†>/Ôüma¥xßÇ6¾#ðìuá_ ‹ý_ã¯í¨Íâ-b/Œ¿·7ÅË/ëWÞ·šïÅãÃú=BëÆÓÙ_ø×ÇŸ€#±ð¬Ú^‘g§iÿ ´Í¡|@Õ¾7èøÃãv½Óþi].©ªþÝŸ·ö±yâ7Äu[Ý#\ñ'Á„·ÚŽ¡«ØO¦iO-ÿƒï<ã_~Í`©á«Û½#ÄZF“ð‚ËÄrx£â›ñ_ž ø³ã1§êŸµÍ2ê/7öØý¹µí¹Ó> ø:çúuÏÁÿ‚dÔ/-ôßøCGµð_‡umÂ^øcPðšø˜üF³ÓþÂ×ã7ˆ´}wEð÷ˆüg‘ãÛ[Ä~¶[+ÏŠßo†¡ªÃðËþ ùð½ÃÃ>k]RÃÅz~ÍHø}¯ÇãÏøãجigÅ|C¼—Àð¹,>2xwIЯï|5âûo øÇöæ×´(PEðëá|÷>'¹‡áì ðÖnøk×3ëCNñ¶Ÿ®xŸRžÇÅZ'‹|C­~Ѷ‘5뺿„müO?ŠþèŸ ¼Sâ*m#Ä|K¥”ºµýŽ¿a‹KŸhðóàGƒžË_Ÿã7Å[SÀvžUö¿­k¾>øðŒk2óJÔ,u+ßxÃóøwÀ7¿üO⟂ž"hí|ùZ~Â_°6Ÿÿ†n-||÷¾´Ó>3|h³°øyq¡ák`—@×<'¥éß³pw‡ü?>?Ãûëï‡þøW?¿x‡Àš¦©àOÿÂQáoÙÂÞ(ߦè_³oìÛ¡i¯r>&þÜEφ´OøÃEðÕÄÖÓ\\iºmƼº÷€¼ñÞ‹ ^øjãÀ¨>x3á-×ÂMGZÔV[Åö>6ðìKáo¡•õïH5¯é¿à¡ôß¼ñê1ZøhøûY’xÃEñMÆ£ûM€gi~¸Óãð”Cá?…~·€¾$k?4=â×Ä$×6øWÂß|],wÌÖNïqûyþßRK«X^ {Ï K{ðàUäm­èw¾ðÌiŸ ußOaû,€|óñëã'| þ?ð5¯Á~ÑŸ¾&xƒÁ_¾~Ì:>´<[ûD~ØšòëøOÿµ¿íaáÍ#UNøÿúð·ŒôMÁ¾Õ~/ÝxöyðÁÑ43ÇW´ð—…ì<ý>~ÐßµsüGñÇxƒÂ ~>hw:†fß…Ÿ´.Ÿ¤|pÿ‚„ï)4>4ý¡¿h?ÛÚx£öeý¾éž!ðî‘að›öGøµªü8}RãâF­ÇOÛƒá§Ç?†²ü^ú¶èz>±áÍá>âOëß ¼)ðnÝ> kzgû¿ÚA|eogáÙ?ö;ðÖŸâ]/Løû|$Ò©aã]n-WÂÚ%þ›>§¨\ˬYÿÂuãßuUÂÝRÿšeáoÇð[Å~5ø%âWÑη¬ZØ!öÿ‚zY6·áK¿ èz]߇/Æi7Ã䲟—]j:>»ào¿ì´ ®•{¤j¸»ð?…||àMoá_ˆ|Kð›Ä"_ þÎúü?ÙšWìiûx~Âm.çÄ?´ŠîtÝIøñGNÐ<5qlš=½…Ŭö~ð€€>Fý£5›ß i?³×ìÍáiŸ>)üL›Åß ×Uøkñ*ý¬ÿàš_³–±£^Ýünø…à}Áמ$ñ?‰?à¡ZßÃøá·„~5h>ñg†ü û]þѳG‚¼Wâø´?ÚÀw´°Òžøu¤ü+ðÁÏxàoÃ_~ø ©¦¡à_‡ú‡ˆôi~þŸ n4ÿ&/Š¿ìì5«íâ_í•ñÃÚ¶ žÐm‰´ÿ_x¦òUñqÒ®|cã‹>›KÒ,ôí?á6ƒáÙ´/ˆ·ÆýÂß|n׺Âí"K¥Õ5_Û³öþÖ/Cw¡ØxgÁíkªXx¯OÙ£iµøüyà?ü{5,ø¢ˆw’øþ%‡ÆOé:ý_máŸþÜÚö… ¾|/žçÄ÷0ü"ý>Ã­ß zæ}hiÞ6ÓõÏêSØø«Dñoˆu¯Ú VÒ&½ÔõýwWð¿‰çñ_ýá7Š|]ðwÅM¤xã‰t²—V¿±×ì1isâmþ|ðsÙkóüfø«qªxÓʳ¾×õ­bÀøWÇß>€Mc¦^iZ…Ž¥{áø~ø÷࿉üSðSÄM¯2 OØKöÓã¿ðÍůž÷ÃÖšgÆov."Ô<-c èç„ô½;öný6øI£¯‡¾ü2ÐÀ–Ÿ SCø{à½~Xjöž ±øtºg†ôÛ%ð%ž½`Ž·iáðý¾¯f¦¥ž—–àC2 ùOö• /Æ/‡š”Ö¡©xÃ:ŸŒäñŠæ†Ïàgì¿¢\[ø§E×~;Þé’Û%·ÄŸŽ~%Òž÷áÿ _7†¬àñ^µü!šµã'ñÀÍZ…J°øc¦iÿ õí MÅúÇÆøGâ÷Šî.âð—sªjŽ©ûv~ÞÚÝæ¡ΫñG[¹Ò|A¯üøE«j-©Xø²Ûý$xkVø{âÍ{öh¯gáû›Ý#EÒ4…Þ7ñLž,øÅ?ÅŸø7âž½u£jŸ¼A¥]hiý·?mýA­ìn|5ðßÁ7>²¹ø)ð&kH¿â[áO†:>—à=Vðïü#ð»ð¬~"ÐüOoaðóÆ øÉñ6èÚG‰|FÚ?‹m¿xytÛ;¯Š&E½ÿ…SÿüøSöÝÇHð°²m/Å^¶ðÞ‘¦ø?^Ó> x'Á´ž%Ó£ñ-—Æ ™¼ñâý‡Æ-{ÃþÔ§Ñõ¦ðÏŠÿnOx~ßXKo„þ ¸žíáø?û|-‡Y¹MS_:­®‡ãÍ7Vø…©ê.Ñ¡¢Oàoƒ¾ü¿þ.¥ç„">_¼C©ø›N¼ð~!ütÖ7N©â]SPð÷‰<9?‡~hÿ¼YâÏ÷·­€-ÚãDK?Ø[öÓ­mt‰/M[Áÿ>x§á猾øûö7ýšü)i¡ê6?´7íûñkà_ÆßOð¥m¢Ð´ ÏÚs@ýœ´¯xæÓáö¯£x#â@Ñ¿ õ/ë:Áø J°ðÇ„¼3ð³Vø…àè~3Òþ.|,ý”~|Xðþ£«è_ ñ&™uã ~Ñ¿·Gí áÙêú­ÿÄ;NÐüyâRÛÄ>0ðßï/ià Ÿ xjK >ÇÃÿŸßøÛâï‡ü?ñwÆÒêþýœü/«Ë®j:ïí“ûd뺎¹(ñ÷í7ãá/ˆõŸx#Yñ¹©øsS×#h­¥ý©€-xËNo\ü_¾Õ<-ñâŸÄ¹Es­Gñ#âÚ߇ô¿Yê>ñµâO}£â?į]ñ›,z—Ä-OSÐü_tO‚4ÿƒ~.ñÁ NóO»¾Ô­nà‚/Øgö±†OÞhÚu惨Ûü}øÛhþ »ÑõÍE»×ü+¬ü?ÕÇì¸ Æ™u¥_‰¯<-«øþü³øSâO|"¾žçÃ_³O‡õ;/éšGìkûève/Œ~:øºëOÑ4ï|TѼ?a¨iÒi>Òíîté´ï‡Ÿ~I§xz_ Ýx1à‰¾Ëðᮡ¥]§‡õxükàŸØ{ž+Ñ„Zƒ| ¬^#´øÝÿø¹§øE±½¼´²ñshº/ˆÚâÞç]Ò|wáëoÚ|¦…¢]h1ü$±µøs¨ü9—á†âÏiz?¼N|Eà¯ØãÂ>'o_k´Ç]Vò÷W‹ã?íÃñ~ËÄ½í¾‹¨ê>2ºðÞ·âÿjW!k-SÇÞ>øÀh>}*Ã᎙§ü3×´)4Oë<;á‹Þ+¸»‹ÀZ]Ω¨j:§íÙû{kwš„w:¯ÅnçIñ¿ðCá­¨¶¥câËoô‘á­[áï‹5ïÙ ½Ÿ‡îotHÒ>xßÅ2x³ãÿ|#àߊzõÖª|^ñ•u }§öÜý·õ·±¹ð×ÃÜø~Êçà§À™­"ÿ‰o…>èú_€ô}[þðÀ@ï±ø‹Cñ=½‡ÃÏüTƒã'ÄØ|C£i%ñhþ-ý¶üMáåÓlî¾(|`™÷þOüóáOÛt#ÂÂÉ´¿xjÛÃzF›àý{LøàŸ~Ð@x—NĶ_.fðoÄ‹öµïøkRŸGÖ›Ã>+ý¹=ø‡ðhÓXÜi:§‰uMCÃÞ$ðäþøQ£üñg‹>ÞÞ´>·k,ÿaoØNµµÐn$ñ&«{¡Aiñ“ãn‘gá=SLÕô [Ūxc\ðVƒkû4€G¤xz}ÿG½¼ðdß î¾üÀZ¦§àWþ¯~ÆþñDzf ~Îß³^‰ea{mñköÎø¡ö¿ éï‹4okSZ\·†´›1­Eâ‡ß>#€7@Ñn<5{ðÜ'u„—_ |âýZÔu¤ñÏ…¿b_øÚÇZx³^yOŠôßÿðP:o‰|½F9ßÇÇÃV¾2ñ”òk)Ñ|c¨Ü~Ó`xkÃRXIðÆ8þßøøÿÆß|?áÿ‹¾6—Wð¿ìçá}^]sQ×lŸÛ']ÔuÉG¿i¿ |G¬ø#ÁψõÍOÚž¹âMOSñ&‡&‡ñâ'…À #Ãw¯´Û†^1’sñ^ïãG…<5ñ›\½µ¿½¸Ó/,æ½ý¼?néÜi77úEîuªþÎÿ/Η{§ê~ð$xáî¹àH ý—@9?†´¿ø“Äþ+ðžµà=KâßÆ›Gãlüíßt­?Pñ_í‘ûføQ]?HøAûüÓ4m;Vð_íRÒÃCxGÁzn›ðâÒÎãáïúù«öZÒþ#|cø=ñ/ã×Æ…ß|}â¯ÛËân›ñ3ÿ Es­Gñ#âÚ߇ô¿Yê>ñµâO}£â?į]ñ›,z—Ä-OSÐü_tO‚4ÿƒ~.ñÁ NóO»¾Ô­nà‚/Øgö±†OÞhÚu惨Ûü}øÛhþ »ÑõÍE»×ü+¬ü?ÕÇì¸ Æ™u¥_‰¯<-«øþü³øSâO|"¾žçÃ_³O‡õ;/éšGìkûève/Œ~:øºëOÑ4ï|TѼ?a¨iÒi>Òíîté´ï‡Ÿ~I§xz_ Ýx1à‰¾Ëðᮡ¥]§‡õxükàŸØ{ž+Ñ„Zƒ| ¬^#´øÝÿø¹§øE±½¼´²ñshº/ˆÚâÞç]Ò|wáëoÚ|¦…¢]h1ü$±µøs¨ü9—á†âÏiz?¼N|Eà¯ØãÂ>'o_k´Ç]Vò÷W‹ã?íÃñ~ËÄ½í¾‹¨ê>2ºðÞ·âÿjW!k-SÇÞ>øÀh>}*Ã᎙§ü3×´)4Oë<;á‹Þ+¸»‹ÀZ]Ω¨j:§íÙû{kwš„w:¯ÅnçIñ¿ðCá­¨¶¥câËoô‘á­[áï‹5ïÙ ½Ÿ‡îotHÒ>xßÅ2x³ãÿ|#àߊzõÖª|^ñ•u }§öÜý·õ·±¹ð×ÃÜø~Êçà§À™­"ÿ‰o…>èú_€ô}[þðÀ@ï±ø‹Cñ=½‡ÃÏüTƒã'ÄØ|C£i%ñhþ-ý¶üMáåÓlî¾(|`™÷þOüóáOÛt#ÂÂÉ´¿xjÛÃzF›àý{LøàŸ~Ð@x—NĶ_.fðoÄ‹öµïøkRŸGÖ›Ã>+ý¹=ø‡ðhÓXÜi:§‰uMCÃÞ$ðäþøQ£üñg‹>ÞÞ´>·k,ÿaoØNµµÐn$ñ&«{¡Aiñ“ãn‘gá=SLÕô [Ūxc\ðVƒkû4€G¤xz}ÿG½¼ðdß î¾üÀZ¦§àWþ¯~ÆþñDzf ~Îß³^‰ea{mñköÎø¡ö¿ éï‹4okSZ\·†´›1­Eâ‡ß>#€7@Ñn<5{ðÜ'u„—_ |âýZÔu¤ñÏ…¿b_øÚÇZx³^yOŠôßÿðP:o‰|½F9ßÇÇÃV¾2ñ”òk)Ñ|c¨Ü~Ó`xkÃRXIðÆ8þßøøÿÆß|?áÿ‹¾6—Wð¿ìçá}^]sQ×lŸÛ']ÔuÉG¿i¿ |G¬ø#ÁψõÍOÚž¹âMOSñ&‡&‡ñâ'…À #Ãw¯´Û†^1’sñ^ïãG…<5ñ›\½µ¿½¸Ó/,æ½ý¼?néÜi77úEîuªþÎÿ/Η{§ê~ð$xáî¹àH ý—@+Çái=ð·‡þ!ø’]Ä¿µg‹<6š=½ßíEûS´‘‡¿²ŸÃI,´3ðËáöLVš¶áÏxÃÿ ãKÿ‡ ˜ñ…‹´ßˆK|cñ£LøÑã;as®Uýº|A Ç+,7òFÚ¼ ?à› Õ좌—ÚÄ¿ÞënºgÄmâ5´¿µ0¯iÍâËŸ‹÷Ú§…¾"|Q³ø—'‡þø›Å~×ä𷌿koiZ­Í—ìÃû¹¢È·zÿ…uŸ‡ú¸ý—!¸Ó.´«ñ5ç…µ¿Ãÿƒv |Iâ„WÓÜøköiðþ§eáý3HýaÝNÓ¬¥ñÇ_]iú&ãOŠš7‡ì5 :M'š]½Î6ðóáÏÃÀ 4ïKá;¯Æ<7ÂY~ü5Ô4«´ðþ¯|ûxSÅz0‹Oðoƒ!µ‹ÄvŸ¿à ?4ÿè¶7·––^.mEñ\[ÜëºOŽü=mûO€TдK­?„–6¿u‡2ü0Ó¼Yã­/Gñ·‰Ïˆ¼ûxGÄíâ‹ícöøëªÞ^êñ|gý¸~/ÙxƒW½·ÑuGÆW^Öü_ãmJãÄ-eªxûÇß Â¥X|1Ó4ÿ†zö…&‰âýcãG‡|#ñ{Åwqx K¹Õ5 GTý»?omnóPŽçUø£­Üé> ×þ|"ÕµÔ¬|Ymþ’<5«|=ñf½û4W³ðýÍî‘¢éGÂïø¦O|bŸâÏ„|ñO^ºÑµO‹Þ Ò®´´þÛŸ¶þ Öö7>øoà›ŸÙ\üø5¤_ñ-ð§ÃKð«xwÀþø]øV?h~'·°øyã?Š|dø›ˆtm#ľ#mÅ¿¶ß‰¼<ºm×ÅŒ"Þÿ©ÿ‚~|)ûnƒc¤xXY6—⯠[xoHÓ|¯iŸ<àÚOéÑø–ËãÌÞ øñ~Ãã½áÿ jSèúÓxgÅ·'ˆ¼?o¬%·Â\Ovðüý€>ìܦ©¯V×Cñ曫|BÔõ hž4ñf±ûG€]Öô‡½¸ø±¯küI7Šô¯|(ñoŒ¾kWW‹¾4xHKë¨?c؇NŸPÑ'ð7Áß ~_‹ÿRóÂ/ÆÞ!ÔüM§^xGÇ¿þ :k'Tñ.©¨x{ÄžŸÃ¿ 4ƒ^,ñgÀûÛÖ‡Àíq¢%Ÿì-ûéÖ¶º Äž$Õot(->2|mÒ,ü'ªiš¾ákxµO kž ÐmfôO ßè÷·ž ›á=׿ƒñø TÔüªÿÂUàïØßÂÞ(LÓ´ÙÛökÑ,¬/m¾-~Ùß>×á½#]ñfáÍjkK–ðÖ“f5¨¼AðûáçÄpè-dž¯~„ð.£ð’ëá/ƒ<_«BºŽ´ž9ð·ìKáXëBOkÏ)ñ^›ñ¿þ ñ§Mñ/—¨Ç;øøøj×Æ^2žMcÅ:/ŒuÚl xjK >ÇÃÿŸßøÛâï‡ü?ñwÆÒêþýœü/«Ë®j:ïí“ûd뺎¹(ñ÷í7ãá/ˆõŸx#Yñ¹©øsS×ñŠlÞçZÕÿkÛËöÕ|Gð÷öJðÄÿé~ ¿ñßÁoÙGâÏí ðÓÆ^†ßà4Sø7áÇŠµÿ„OÁ` ¶??loÚ_Â÷þøïsÿ„~5|f°ñæ™ð/öwñ§Ž!øÍûMê èšçÆïÚÏöØñî‡àxOö3·Ñô»­CÁ¾ ø3û#þÊ<kuð“Áuoø›á÷ÃmKâ8Ñgƒÿ þüFð7Á¯º×Œü!ñÛâF›â=bU×o,üuÿ#ø¯¬)â/ˆŸ¼w«Þx«Å‡ö/ðúÜéW¾;øµñ#Äž6ñWíïˆ|Iã=Wã!ø uoÚ°Ø|e§7‹.~/ßjžø‰ñFÏâ\žøâoøS_“ÂÞ2ý­¼M¤]j·6_³ìñi6«f>þÈŸ¢¹Ö£ø‘ñmoÃú_‰,õx‡Zñ'ˆ>ÑñâW‰.øM–=K⧩è~/º'ÁÁ¿xÇà†§y§ÝßjV·pAì3ûXÃ'‡ï4m:ÆóAÔmþ>üm´Ýèúæ‹"ÝëþÖ~êãö\†ãLºÒ¯ÄמÕüÿþ Ùü)ñ'Š>_Osá¯Ù§Ãú—‡ôÍ#ö5ý‡t ;N²—Æ?|]u§èšw>*hÞ°Ô4é4Ÿ iv÷:tÚwÃχ?$Ó¼=/„î¼ðDß eø?ð×PÒ®ÓÃú¼~5ðOì=áOèÂ-?Á¾ †Ö/Ú|nÿ‚€ü\ÓüG¢ØÞÞZYx¹´]Ämqos®é>;ðõ·í>ñ왦èŸ|ká¿Û OøOsà­3º7Ä~ɺ‡øûdÁ@¾']x«âžƒâ¯†þ&øᎳݧì»ñ[Ä2Õ ÒuøìíMÂ¥X|1Ó4ÿ†zö…&‰âýcãG‡|#ñ{Åwqx K¹Õ5 GTý»?omnóPŽçUø£­Üé> ×þ|"ÕµÔ¬|Ymþ’<5«|=ñf½û4W³ðýÍî‘¢éGÂïø¦O|bŸâÏ„|ñO^ºÑµO‹Þ Ò®´´þÛŸ¶þ Öö7>øoà›ŸÙ\üø5¤_ñ-ð§ÃKð«xwÀþø]øV?h~'·°øyã?Š|dø›ˆtm#ľ#mÅ¿¶ß‰¼<ºm×ÅŒ"Þÿ©ÿ‚~|)ûnƒc¤xXY6—⯠[xoHÓ|¯iŸ<àÚOéÑø–ËãÌÞ øñ~Ãã½áÿ jSèúÓxgÅ·'ˆ¼?o¬%·Â\Ovðüý€>ìܦ©¯V×Cñ曫|BÔõ hž4ñf±ûG€]Öô‡½¸ø±¯küI7Šô¯|(ñoŒ¾kWW‹¾4xHKë¨?c؇NŸPÑ'ð7Áß ~_‹ÿRóÂ/ÆÞ!ÔüM§^xGÇ¿þ :k'Tñ.©¨x{ÄžŸÃ¿ 4ƒ^,ñgÀûÛÖ‡Àíq¢%Ÿì-ûéÖ¶º Äž$Õot(->2|mÒ,ü'ªiš¾ákxµO kž ÐmfôO ßè÷·ž ›á=׿ƒñø TÔüªÿÂUàïØßÂÞ(LÓ´ÙÛökÑ,¬/m¾-~Ùß>×á½#]ñfáÍjkK–ðÖ“f5¨¼AðûáçÄpÓÏ„ö1iŸ >i¶þñ7‚ Óþø6Æø×\_øËÂQZxwM‚? ø·Ä‰¯x©+øoÂ_®ntmkâö¹¥]é“_~Û·¢ú^Žþøoà×Òtý[àŸÀؼ.Ò\xwÀÒ¾麗†üà@¬ô[/x}, ð·Æo‹6¿>/j>'ÓtoN|=â¿Ûo_ð÷ü#–w¾2Ⱥ4IðWöøJ¤i~ð´Ö‹ã¯ iÞ Ò4ß xÇOøƒàü{“Ä+oâ/üEšmãWÅÛOŒ?4jWz+?†ü]ûoø‡Cûtv |²Û¬?ÿàŸŸ á½¾²×üa5ÎáÿøzëÅšÕ÷ˆ¼_¤xëÅ^$ý£€.øŠofø×­êQüjñañ–½á¿„þ$ñwÃa>‘⯎:æˆ&¶ýŠÿc=0Á¢Ïào‚> ëüVøó ï†-3'Äojß4ùü%ãßü#›W+£Éñ3Tº·ø§áæÐ< ¡üñ‹þYÞ\¿Ãë7K‚Ãöý€´?BÓ.5OÞÞé¶Vß~;èº5…iÖ6ãÄÞÕü Ù~ÌàÅ`žÕµFçKñ÷™þ|ðïÃíOSð4Æ>ýŽ|;âw𽦓û6~Ìš™áÝrÿµïÅw“CÒüKâÍDñÕæ‹{‚ô»D‘ußøÇ è–Ká]CÂþO†8øÓûDºÍ¢Çñö•ýž> kº‡€<ðEÑî|5û<~Íÿe=Ä>!ºñíçÅÿˆ¾ûÃzBÇqðÊÃMð7Ås<ž1×>3xkŸ.ï4Ë‹Ûû[ÐóþÝß·…ìÖzî‘cs¤›ÿ³¾«uáíOO½Ó<=ð&¹ðöÿeÐ í#H‹ÅQx6ÆÇÁ¿~!Gñ ãÇÄOxwâ%ÄžñíMâ/ I ,¿µ7íM*èü)ý˜>Ëa¥Ïð‹áú_…ìüGgᆾÐ>j#Qøyðö@ Zæáñ>™ªx?âŸÇŸ üyñͶ©iúÔ0hw·íÆ“aö{‹_Z]iw¶_ ?à›Ÿ lµCÅw—…~-øv{˜ÖËâ—‡>(B¿µ8Ç_~)è_²æ•ñ‚ÓöšñwÆ/þÊÞ8ñ‚þè_µÏ‰üm?ƒ.~+ê^Ó4Ãÿ°'‹>.|bø…¨øÁ_²õ¦¿¨ø®KÛ·Åúß…<'ñ–ËTñÏ€¿hŒšŸít¿¿mPº¼\‘K©|XÕõø½©K-¾›ðoÅ7ø=Þ©kWvú¤±Ø_ö±ŠÃC¼ÒôkÍ&âÇãçí §Â+.‘ªiz¬—ß|)®ü:Õî?f5ÐtÝKÆSÝÚüOðøàþ‡ð³[ñWÁ»õoþί'‡¬ôØÿö"Ðì<4ò|Eøûãag¤XüFø©áïjwÚ¡¥xOK‚ïÃsižðÃà MÂ÷zT_Ø>5øKqðkàý®‹)ðè‹ÇÞ ý…|7âéVÖ~øy¶âÛÚ öðø«¦k:}œ—:}Ä» é:í‰O¶èÞ;ðîŸûJ€7MµþÁ½øe§Áá?ˆ ›áÃÿøßKÒ&èÒhðühð÷„~1jsÏmðêÊ÷Xñ.©{ûwþݺõêZK¨|YñE힯â?„¿µ­NcMñhÔ¤oxkVø{âß~Î`§‹»†z6àŒÞ&ÿ„«â­çÅ øKâuÍέ|^×4«½2kïÛcöâÔ_KÑßÀ üúNŸ«|ø{…ÚKøÃúWÃ7Rðß‚¼ð(•ž‹eâ/¥”øÍñf×ã'ÅíGÄúnâ©Ï‡¼Wûmëþÿ„rÎïâ÷ÆYF‰> þÂ? Q´/þšÃCÑ|uám;ÁZF›áOéÿ|à¿`x…müEáÿˆ³M¢üjø»iñ‡âáÍJïEgðß‹¿mÿènŽÏáOƒ[u‡àŸüóáœ7·ÖZÿŒ&¹Ð2×¼7ðŸÄž.øl'Ò&j—Vÿü<Ú´?ƒÞ#ñÁ ;Ë—ø}aæépX~ÿ°ƒ§èZeÆ©âÛÛÝ6ÊÛâïÇ}F°½Òu:ÆÜx›Ã¿€´/Ùœ8¬ÃÚ¶£¨Üé~>øS?Âï‚~ø}©ê~€xÇÁÿ±Ï‡|Nþ´ÒfÏÙ“CÓ<;®Cñ¿ö½ø®òhz_‰|Y èž:¼Ñoað^—h’.»àxô}É|+¨x_ÉðÇþOð—ávµ©Aos øãñ ?ˆ_n>"xsÿ.$ðLj¿joxbMeý©¿jiW@°—áOìÁð¦[ .„_§Òü/gâ;? ü5ðþðÛQÃχ²|ûFë"ø£ñOà?ìÓàï |dø§á?Ú×âW~2ürñv©§Ùè7·wÁOÙ^?‡–Zïà {ÝCBñF‡ðoö Ô¾-üsøáý ŶøñÓöFÿ†©}ÄzÏŒ|sð³Rý¬@>¿ñœqxºŒW:¦ñÇâl?¼cá‡~"×¼"dð¿ˆkèÇZ–/Ùgö|·¹Ki>þÆ>œ_¾.¾§áýÄz~¥ñÄ:ÏÄ­q'ø…ñÄ@.H¥Ô¾,jú‚|^Ô¥–ßMø7âüŠïNÔµ«»}RXÇì/û XÅa¡Þiz5æ“qcñóö…Ó¿á—HÕ4½VKïˆ>×~j÷³è:n¥ã)îí~'ø üðCøY­ø«àÝŒú·‡ÿg W“ÃÖz?ìûhvy>"ü}ñ°³Ò,~#|Tð÷‡5;í PÒ¼'¥Áwá¹´Ïxáð‹¦Çá{½*/ìü%¸ø5ð~×E”øtEãï~¾ñ?‡t«k?ü<ŽÛGñmíûx|UÓ5>ÎK>Çâ]džôvħÛtoøwOý¥@¦Úÿ`Þü2ÓàðŸÄ†Mð¿áÿŒ|o¥é)Ô¿á.ðOìuáØø†mOãïÇ-zøø†×ãwíÃñMuYô¯ßë~?Ô<ø´_Ã::m—ÂÏÁŸti4øH~4x{Â?µ9ç¶øue{¬x—T½ý»ÿnÝzõ-%Ô>,ø¢öÏWñÂ_ZÖ§±¦ø´jR7‡<5«|=ñoˆ?g0GÓÅÝÃ=NðGÆoÂUñVó⿆ü%ñ:æçFÖ¾/kšUÞ™5÷í±ûqj/¥èïà?†þ }'OÕ¾ ü½‹Âí%LJ|áý+áΛ©xoÁ^øJÏE²ñ‡ÒÊ |fø³kñ“âö£â}7FñTçÃÞ+ý¶õÿÂ9gwñ{ã,‹£DŸa„¨ÚF—áß Ma¡è¾:ð¶à­#Mð§Œtÿˆ>ð_Ç° °ót¸,?aßØ AÓô-2ãTñmíî›emñw㾋£X^é:ÆcnÔõ?@‰d¾ÔþKßjÒ‹_X~Ð_·ÿÆk n´XµÇÅiü.ž"Õ¥š}sHñƧ'í8á.=>ãá8‹Â<ßü+ñâÖ¡ü\Ö[Uð×ìÝáýqð௠é ÇÃ+ 7ÀßÌòxÇ\øÍᯠ|h»¼Ó./oíoCÏûw~Þ³YèºEýÎ’oþ~Îú­×‡µ=>÷LðôxÀšçÃØ#ý—@3´"/EàÛüqø…Ä/Ž7<9á߈—xcÄ_µ7ˆ¼1&€²þÔßµ4« XKð§ö`øS-†—?Â/„Sé~³ñŸ…þø@øm¨GáçÃÙ «?Åšf±"x{ãÆ]?ã'Äm0‡¸“þ]söëÖ|7nº›g\Gðcþ Óð¦;øÍœ®tï|SÑS¯Å âm¿ü50ã8âñt®uM;ãÄØ~%xÇÂÿüE¯xDÉáþÖþ!ÑŽµ,_²Ïìùor–Ò|)ýŒ|.58¾#|]}OÃú7ˆôýKâ/ˆuŸ‰ZâOñ ∀6<\‘K©|XÕõø½©K-¾›ðoÅ7ø=Þ©kWvú¤±Ø_ö±ŠÃC¼ÒôkÍ&âÇãçí §Â+.‘ªiz¬—ß|)®ü:Õî?f5ÐtÝKÆSÝÚüOðøàþ‡ð³[ñWÁ»õoþί'‡¬ôØÿö"Ðì<4ò|Eøûãag¤XüFø©áïjwÚ¡¥xOK‚ïÃsižðÃà MÂ÷zT_Ø>5øKqðkàý®‹)ðè‹ÇÞ ý…|7âéVÖ~øy¶âÛÚ öðø«¦k:}œ—:}Ä» é:í‰O¶èÞ;ðîŸûJ€7MµþÁ½øe§Áá?ˆ ›áÃÿøßKÒ&èÒhðühð÷„~1jsÏmðêÊ÷Xñ.©{ûwþݺõêZK¨|YñE힯â?„¿µ­NcMñhÔ¤oxkVø{âß~Î`§‹»†z6àŒÞ&ÿ„«â­çÅ øKâuÍέ|^×4«½2kïÛcöâÔ_KÑßÀ üúNŸ«|ø{…ÚKøÃúWÃ7Rðß‚¼ð(•ž‹eâ/¥”øÍñf×ã'ÅíGÄúnâ©Ï‡¼Wûmëþÿ„rÎïâ÷ÆYF‰> þÂ? Q´/þšÃCÑ|uám;ÁZF›áOéÿ|à¿`x…müEáÿˆ³M¢üjø»iñ‡âáÍJïEgðß‹¿mÿènŽÏáOƒ[u‡àŸüóáœ7·ÖZÿŒ&¹Ð2×¼7ðŸÄž.øl'Ò&j—Vÿü<Ú´?ƒÞ#ñÁ ;Ë—ø}aæépX~ÿ°ƒ§èZeÆ©âÛÛÝ6ÊÛâïÇ}F°½Òu:ÆÜx›Ã¿€´/Ùœ›ñ>½á?„:_þ%üCÔuïÙ×Áÿ³×ìçm¥|Dø‰e©i·ß ¿`߆rØh·~K.¨h¿ißivúyñ÷Ä[m?ÆxJ=?Â<Ég«øÀ¾;ùFËöæø!…ðïÅ?²÷ƒþ3~ÒøâØ|§þÇÿðˆþÓ??d BÂò÷Æ×þ.ý¤5ØãÆ?ðQOˆ^Öu=wQðÿÆïÚ2ëT³‹Y¼ðï…?áax›âîá_Ûµ—öåñW¾Yü9øGðÿö<øaðã¾5øá¤ë¶'ŠükûKü@øáýN?GâÿÚ7öÏø3ðï]øKðÎ/ڛⴚ–¿ã†··?·WÇÝ_ÂVW%¶ñ?ÀmXÖþ'|Lø §àï؃ÀÚƵbßo?kŸÚÆ?ˆúçüm¦üýºüe¥¯Á7ø¬G©¿íEûzþÎ| ðGörÖWÃzÆ™¨êß³ßÃÏŒŸ 5¿Ú,áÿ ëÞ"Ðì¾ø/Ãß±ØÕZF‘Š¢ðmƒ~8üBâLjžðïÄK‰<1â/Ú›Ä^“@YjoÚšUÐ,%øSû0|)–ÃKŸáÂ)ô¿ ÙøŽÏÂÿ |? |6ÔF£ðóáì€ÕŽŸâÍ3X‘<=ñƒã.Ÿñ“â6˜CÜIÿ®¹ûuë>·FŠ]M¿³®#ø1ÿéøSüfÎW:w‡>)è)‚×â†ñ6ßþ˜ñœqxºŒW:¦ñÇâl?¼cá‡~"×¼"dð¿ˆkèÇZ–/Ùgö|·¹Ki>þÆ>œ_¾.¾§áýÄz~¥ñÄ:ÏÄ­q'ø…ñÄ@.H¥Ô¾,jú‚|^Ô¥–ßMø7âüŠïNÔµ«»}RXÇì/û XÅa¡Þiz5æ“qcñóö…Ó¿á—HÕ4½VKïˆ>×~j÷³è:n¥ã)îí~'ø üðCøY­ø«àÝŒú·‡ÿg W“ÃÖz?ìûhvy>"ü}ñ°³Ò,~#|Tð÷‡5;í PÒ¼'¥Áwá¹´Ïxáð‹¦Çá{½*/ìü%¸ø5ð~×E”øtEãï~¾ñ?‡t«k?ü<ŽÛGñmíûx|UÓ5>ÎK>Çâ]džôvħÛtoøwOý¥@>@ý¥ü ¦|uÒ|#ûA¥øûáN•yðOÄ~=øí¤kº½¿Ž<ûþÇ:×µ-â׌¿h}ZCâ=KâoíáÿðmçÅÏß-ÏŠ®|aàx¯ö”øÑðóÇ ãÏ…^#ñ7ÆÀ­|3¡Ã¦Ù|!Ñìüñ7F“@ÿ„‡ãG‡¼#ñ‹Sž{o‡VWºÇ‰uKßÛ¿öíׯRÒ]CâÏŠ/lõü%ø­jpëo‹F¥#xsÃZ·Ãßøƒös4}<]Øü3Ñ´ï|fñ7ü%_o>+øoÂ_®ntmkâö¹¥]é“_~Û·¢ú^Žþøoà×Òtý[àŸÀؼ.Ò\xwÀÒ¾麗†üà@¬ô[/x}, ð·Æo‹6¿>/j>'ÓtoN|=â¿Ûo_ð÷ü#–w¾2Ⱥ4IðWöøJ¤i~ð´Ö‹ã¯ iÞ Ò4ß xÇOøƒàü{“Ä+oâ/üEšmãWÅÛOŒ?4jWz+?†ü]ûoø‡Cûtv |²Û¬?ÿàŸŸ á½¾²×üa5ÎáÿøzëÅšÕ÷ˆ¼_¤xëÅ^$ý£€.øŠofø×­êQüjñañ–½á¿„þ$ñwÃa>‘⯎:æˆ&¶ýŠÿc=0Á¢Ïào‚> ëüVøó ï†-3'Äojß4ùü%ãßü#›W+£Éñ3Tº·ø§áæÐ< ¡üñ‹þYÞ\¿Ãë7K‚Ãöý€´?BÓ.5OÞÞé¶Vß~;èº5…iÖ6ãÄÞÕü Ù~ÌàÅ`žÕµFçKñ÷™þ|ðïÃíOSð4Æ>ýŽ|;âw𽦓û6~Ìš™áÝrÿµïÅw“CÒüKâÍDñÕæ‹{‚ô»D‘ußøÇ è–Ká]CÂþO†Ô¾|µ¡Çi¯ém¢¼ø«ñfÓâÿÄÝOÄÚ}‡‰´ø¼?ãÛsÄžºÓ¤¹øÁñ0¥‚Ãð‡öøG ƨxcÂãNÓ´øe<áý+Fñ&‘ãøKãðgÕ´ïx~ökâoÅëO†‹«]øwJƒEñwí˯øsìñÚü<øv²KqÂOø'ÂHn5k/k\Úh¾9ðõŸŠµ­SÅ>(Ò>$xÓÄ´Ðvî;ý#â^µ©ø¯â‹ÿá2ø‘¦ü(ñ?‹~im¤ë¿5;ûAlbOØ®Èɧ?ƒ> øYôýOOø·ñÆ+Ý*m+âˆuOiÚ–‹ã¿ˆ@,x“[·Ó›ã>­wãi3iRxsà·ˆ¼_ðWAy.ü#`$–Ø;öÒ,m,î¤ø‘w}e¥[|jøÕ¤é–ú¥®¸öðÁªøOXømá‹_ÙhMBdðýÇÄN_x›ás|.øá_ê:çü=oâoþƾñhözoìñû7èf•¬Zü_ý²>'.¡£Øø‹_ÒtÜèwú߀´Û}2{[¯‡ÿ¾!:+ë j· º®¹ðzãàïÁ{[‹xµ‹+/x;öðÇŒ­,Z÷U×ÞIºñ‡>|"ý˜üw¢^ü4±ø¥ÝA¤é>8ð…~hÞÕ®4O‡¿œѬn´ÏiþI5ˆß4ÿŒ¿%¸ptË ë?·^¹á_ìíÚœ±2_Çð£þ Óðf;‚óY˜äÐþ)øsNµ€Ëñ7@ø¡öÚ˜Ôõ;[ø£PÔñ7‰¼ ¤&¯þ×:þ€—sÃû4þÍÏwæü5ý‹~Ký®~%|J:½ž—¯ivõí{â^²5Ÿ‰?|JgÅÚŒ[>/^ê~+øy=ߊ4‚ž)ñ/ÁÍ6M3S×ï-./ãƒöý…ã_ì+Ý!tÛ=´ßŽß´ ‘ÐnôýIJø‡£üLýšu_ˆZÿÁ[ߌ^:øAà}Oø-ã‚ÿm<}®~Éš7ÄÙ]ø[öaÿ‚Mø‹âgˆ¼¡ø‹âÌ×ZÛøo㯩®ø¶òÅ5?jW#Rµñ7Ä/ˆ@±á«½áÂ]BÚ]kEñeî·­Iák=kÀÞ$»ýž:3à‡ü+N‡Âe×À_Ø‹Äú…¯oþ"kz‹¿à£_´§{ñ§öˆ¾ž[›oŒ_´«§Á+4Y> i^¸ƒC»øwð“@¶ð'€¼s¡hPivÏ£xàæð¬¶ð'þ ™ö?iž,øûøãOºñ5ßÄoŽ2ë¿ðQ¿±ë´7Ä8e´›Âv¾:Ôlà”ð[i?|ð˜´OžÓ4¿ \éšg†|;«êz‡…ìüU¢xÔßð¤à«Z¾Ÿq§øßà¯ìIâ–øƒâÓâïÚ'S‡þ )ûAhº¿Æ{ +Ë_|³¾‹þ e{ÿ Ûöhð½´šŽŸ{ðƒÃ‘]ÞøÏO¼Ô#ñwŽ5K¿|o½ø¾Ûß‚_ðV=nÛÄíâƒÿ±]Æ·ñ/ÄÖÃâˆt/ø(Çí áF_ƒHºþÃý¾=‡üÖVø)ðÜ)´ƒÄÚž…&µãߥçŠõWñf›âÝ{LñG†€-ßüÿ‚³_?Œïm¾ ~Ä×,ÙÁ¯xãÄ7vÿlÑŸÂsøKà“|Šçà¿üvüKáß°Ÿ‚5#áý#á¯ÁÑáŸø(Ç84ÙÇá¿ØmüE¤|"ð½÷ü®÷G¶ø§ã .SXø¿â¨|KuÔ^†Ó‘øcÃëá]@xþ ÿÁUôkǾðWÀ?Ø7ÂàÿCà/€ÿý |O¢ü´Ö"‚ßâ/Äëm/ÄßðKmJ?‰?´G­ç× O‹ÿå×£Ñ`ÔÎOk6(øËgñ€ ?‚?ðTíïH›Ã_ax,>xKR¶ø= øŸþ /ûHø¿GÑ>.ø‰ofñWíñm¯¿à—öºßÇoŒš¾¥{s{k®xŸZÒ,´‡Ô¼C{ma'‰~ÃZæ›à}_ÆZ6•ãŸø(·íâ8<{ûHë w2þЮ4ßø%¿†ï>+ê>¼kCÀŸôÙüàÏê6Ðê^¶´Ô¼%ðvóá0ZÀ¯ø*=>«û@|g ñoÆ]cJÿ‚Pépêßü µ”~ø%ám'Â~УÑ|)¥ˆnBø¿ðÇþ ›û7x;öìý·¿hÿ‡²WÅ}3Sð¿ü.¯ß ¿oŸÚÁ¾4½ý‘?d¿ƒ:ßü?ûü(´¿ÿ‚vÉáo |5O‰Z—ÇÿˆWWš|¾ø…ñ&Çãøuñ7➪Ú>£ñÄ }ø»Q‹gÅëÝOů'»ñFðSÅ>%ø9¦É¦jzýå¥Åüp~À_°¼ký…{¤.›s§¶›ñÛö²: ÞŸ©'Š.æñ5χ·×?³Þ-Õ!´¾ø©q/‹€YÖ.bðž©â³&»¯|ŸáÂm'H’ëDÒ,ükàÏØs¾2·ÑRÏÁ~ -|MañËöîøÕaªÚÉö¶Ÿ…í5OÚG¦ëºGt[?ÚXwy i¶·~$øU/ƒwÞ/Ò4AmâßþÄÞñ&•-ΫñÇö…ÖõýrÛã?íÑñ3ûK]ºÑt}S]ñmåŠj~.Ô®F¥kâoˆ_þ2€I£Åsð»Lµ9ðÛxwÀÞ#øÍá¿ ülI' ¬å‡\—Rý»?oMjúçJ¸Ô>#k7¶z‹ü0ø/«jºN«aâ4×õ+7AÕüâmcör«á¹m¯-þèzjüMñOü$Ú׈~/xoÁ¿¬F—â‹Zý•íÌ·_·íÑ© ]ü#ð›B}?GÕ>|š×ÂIauiàIðVŸ©x+À^ýŸ€#Ðã´×ô‡6Ñ^|Uø³iñân§âm>ÃÄÚ|^ñí¹âO]iÒ\ü`ø˜RÁaøCûü#†ãNÔ<1áq§iÚ?Ž|2žðþ•£x“Hñ‡ƒ|%ñø³êÚw‰#|dÓþ2ü`–áÁÓ-ü7¬þÝzç…³·jrÄÉÂø'OÁ˜î Ífc“Cø§áÍ:Ö/ÄÝâ‡Ùÿj`SÔíü]oâCPñGʼnqüKø¯¤øÄÞ&ð6š¿û\ëú]ÏìÓû4C=ß›ð×ö-øm/ö¹ø•ñ(êöz^½¥ÙüK×µï‰zÈÖ~$üIñ(Ÿj1lø½{©ø¯â5ä÷~(Ð> x§Ä¿4Ù4ÍO_¼´¸¿ŽØ ö°¯t…ÓntöÓ~;~Ð6GA»Óõ$ñEÜÞ/ð&¹ðöúçö`›Åº¤6—ß.%ñgŒü'ü;ᯄºÇ‹~ xao<7û?xwT½°°Òc/Ø{AÓôv“Åÿ´Ž#‡BÒ~$üDÐ4 KSÑu‰|#agká‰<9ðçáÇÃp :ÅÌ^Õ9~Ý߬5[Y žÖÓâ𽦩áûHôÝwHñ®‹gûK@.áÐ/4 6ÖïÄŸ ¥øOðnûÅúF‘âè-¼[àŸØ›Ã¾$Ò¥¹Õ~8þкޣ®[|gýº>&ik·Z.ªk¾-¼±MOÅÚ•ÈÔ­|Mñ âÆP 4x¢Ñ®~i–£Ç>oøļ7á?‰$ãᵜ°ë’ê_·gíé­_\éW‡ÄmföÏQ†õmWIÕl Óõ/x Àß³ðzvšþ‘ðæÚ+ÏŠ¿m>/üMÔüM§Øx›O‹Ãþ1ý·ý§üw·ZÕ¼'ðï]ñ,Ú¶pxÅÿµ¯x‰<ñ[þ ûF|Kø‹aá_ ÜüLø‰|7Œ|š×ÂIauiàIðVŸ©x+À^ýŸ€#Ðã´×ô‡6Ñ^|Uø³iñân§âm>ÃÄÚ|^ñí¹âO]iÒ\ü`ø˜RÁaøCûü#†ãNÔ<1áq§iÚ?Ž|2žðþ•£x“Hñ‡ƒ|%ñø³êÚw‰3ñOŠ´ÏêjWÎð¿âØËVž1°ñ&—àùn~(x¿â¼~(¶}ªxsÃI£ø¿öãÖü1qq{€~[ý·Qÿ…Yÿïø=ý§ªê>%×ÒmKFñŸ…OˆõOÆ~"Ó>!xÏÅ¿´ˆGÅK¨èšÎ­ª|bñŒ?á7øÅ?Ã=Åÿ |=6‘¯|qñ’Öéiûþ¶‰«¬þø+à‘¡jZoÆŸŒ¶z‹ùSx[â—‰u/xwRÓëž.ø3áG•<)m=Õ¥•¯ìÿúÒ,ž›ïŠºÅÎ…¥hß~1hÖ×Z¶Ÿâm-ÌKá=[áÿ†4¯ÙtƹâUÐæøɨ]|Y“áèøs„~êšç|#ˆ<û&xs\¬tÙÃönÑlÓYƒâ·íÍñ ëzM§‰õ­;IñEþ—{âßévþ žðÃï€M¨øª M㉟âBü$—àïÃÝ>î+h¶Þ6ð'ì3áÿØ‘?ˆ¼g-Þ§â+OÿðP¯Œz‰õ³·¾Ô|U6‡aⵆ]#ÄzOŽµßøj`ìõÁ£êË¿Ž¯ü>ü‡âF“៌zsßxkö_ðþ´ðjº×íWûp뚟ˆ-$ñ§í?ã±g«êß|¯ëºN¡¦É¥øâúå£cñÇú þ×!·¿ðFeâß9µðF§ñ§Ãžøå¤Ïaqö®÷oûwÁA/®nü3y¥iÖž·Ô>ü¿ÿ…w6ªh6æÏHð®³à 2ãöYÎðž·‰®>Ùi^:ñ¿ÄX¼oã‰^𿎼:ÞñGí=â 9/-&ý«ÿj9á‚ž~Æþ Y´ÕøGðæ=ÃúN¤š‡ÃBÒo¯Ã¿Ž|Gã]àGÄ?ã…÷Ž|cñ_öcý°¼Q®xŸö›ñ Ó¼%áY~=|ZøWáoø?ô÷Š-¦Ðe×þÿÁ!üðŸMÓþ~о<½ñŸŒ¾h^ øuû8xâ?j>#~Õß~?€}ŒàñtZv©sñ‹Æ?áø›ñÄøG^ñÿ cx‡ö·ñ…äK«ÙóöYŽ]fàx ö1øS%¶¦ÿ~#E©êZˆôo|JÖ|Cñt×>!üAñGÅÉåx¯T½ø½â‹¹ï>#iŸïAñ|×~(ø}®xæûö`­âßÁiŶo‹Wþ > ¿ðoÁ}kZø/àß·è_´+ó›¥þÄ?±—¦Ä‹ÿjÏ£è~ èz>©¬hZÆ©á[  øjO xÀ6nøÍðà¾'·Å[½zçöuý ?gßš>©àÿšTšŸ‡ükû|6¿ñ%ßÄ8ü[ûZ|Xðߊ-o¿jŽ¼i¯k¬?e_Ž>"ø•ðľ&“\ñÄ…?#×|qã‹Àk¦üpýª¿g»h¿¼ñsJøuð9>;iÿþx.ÿJ? 48µC/Ž?mßø)§ì«ñ_ãF£ñ’Ãâ7‡¼6"×>|ø?ñÃö™ø§ñ›^øañ§YÒþü0ø« x#á÷Ãà–i¿Ûkà/í;ûÁBþ ü9ñÏÅ¿ëŸÿcŸÛ—ÄÚßYøMþ&|q×¼'û?xÇDñŸí“ûXø›ÁºÎ³að¿LøU©Ã¡øCÁÿ±§Ä½'áÇ¿~-¼ømñkö|øa¤x›ödðç‚À?¯ú( ›þ þÕ_ ~6§Ä×ðÿü%þ?¾$Gð“ÆñüRð~µðÖK/Ë h>'MÄx² 9u[“¡ø£Ã×Û´÷6ëQgÏ‘¢P¿Ö4.Kµ=SNÓ¥ÕocÓt¸¯ïm­$Ôµ•š+ ¸–6¼½•QÚ;[q$îªÅP€HòoŽÿ´Ã?ÙÏáÅßÿ5=Gþ_^ Ô¾!|Q>Ñu/ø‹Âþ Ñ´ùuc^ºð·‡ Ô5é,´½Þ÷ÄÍ‹4:Ÿ¨j{ZÖÒi¹ñ?<1áOø“Çú†¢·~𶙭jzÆŠ¿Û73`¨¯ôÝ2ÓO3M©ë†þÎm"×F³Yu ½kf“ ~ë“Fñ¿‡µÁÚñ¼m?éš^§áÍ/Äñ7†üCsý­¦ÁªÁ¦Í êÿeÔíµË{[…Ž-¸Ô4ùÒh. ŽXdUÖµñƒ}¨\i6Zæ‘yªÚ5Ú]é–º••Æ¡lö`ûrÜYE;ÜÂÖ_ÚÚ_ÚÖHÔÛiXyÁ>ÙoækÐ@ÁX¿å_ðRÏû0Û#ÿY×â5|ÑâßÁiŶo‹Wþ > ¿ðoÁ}kZø/àß·è_´+ó›¥þÄ?±—¦Ä‹ÿjÏ£è~ èz>©¬hZÆ©á[  øjO xÀ61“ûKVøéûKëÚíå·Å¯Ûãö–³®x_ÃÚçˆ5 ­8Þx£P¸ÄQx›Çž;øÀ%¾°š5×…tËo랟Â_ â'ñËO¸•>i†ÀIuûkÿÁCµkÍc@¸Ô~#jº>£uð«á¹«xJþ-F×õ9-tísÁþ"ñìöÝÄ6÷¿ ô-;Åþ/Ö¦ñƒâoŒ>ðŽ ôïüUÖ4»³—öàýºï£_Oàß‚¾V•iðcàýÆŸà{X®ì¼£éš>“yàßxà0? kÞ"Ò~ØÇãÿüY·øµªøÅšN›®èCþ4ý´õÝúòmCã'ÄÏ'z|*ÿ‚||[ŸŠ/ø¯ÆŸŠ-£ßjžðÒhþ/ý¸õ¿ \\^Áà„VÿmÔáVÁ;þi꺉uô›RѼgáSâ=GSñŸˆ´Ïˆ^3ñoí"ñRê:&³«jŸ¼_ãøMþ1OðÏ_ñŸM¤kß|A¤µºZ~Ç¿°­¢jë?„þ ø$hZ–›ñ§ã-ž¢þTÞø¥â]KÇ^Ô´Ïx÷á(¾!ñ¥¾¤|IÕ/¾-kZTšwŠô‚:狾 øQåO [OuiekûÿÁ>´‹'†æûâ®±s¡iZ7ÆŸŒZ5µÖ­§ø›KsøOVøá+ö]±®x•t9¾2j_døz>Çᇺ¦¹à_ÇâþÉž× köpý›´[4Ö`ø­ûs|H:Þ“iâ}kNÒ|Q¥Þø·À:]¿ƒ'¼ðûÇ j>*‡ÂSxâgø¿ %ø;ð÷O»ŠãÄ-·¼ û øÅö$Oâ/Ëw©øŠÓãü+ãŸâ}AìíïµM¡Øx­a—Hñ“ã­wþ˜;=phú²Åoã«ÿ‡?áø‘¤øgãœ÷Þý—ü?­<®µûUþÜ:æ§â I!üAñ”|iý¬¿gÿ€¶$ñíûgx#á:·Šï<®xÓLñg…>·Š4ïjžÒÿá,ñW…ÞËAð'ˆuxöŸý£4©Uü/­ßÜîx¿á¯‰4K¯Ù¨Æ|[ÿ3ý€mÅ8[þ sû(ø*ãž 𥖡©üøÅðfÿHøð2K)¯ìÝû èÚo‹Ãx×ãW‰´½>ÖÓâOÇ_躵Ÿ†î§Ð#´Ò<1„¼ àO‡ uø(‡ÁnµÍF göÈøM'‡îtÿ†wVÿðLoÛöÿ±Ÿ‰Ï‡Ò G¢ë³=ô>'ý·~4i¾?ÑãÓø'ðºÏÄ~ Ô¼sàٟῆ?g- Æ7—§Ç?þ:ø/öÆý­þücñí¡ãløšmHøóáÜkÐ\ë~>øgÆO‡µÏ@.·ÇÛzóÄúð»ö\ð¯Ãø àÍÇÅ-ÿðQoÚ²ÛáŸÄOêãÃYÛwöêðÿìñðŸö´ðŽ¯««ZÅ£|.ðÄ/ŽŸ ¾'Z|@ð¯Å}Yþ ZYü6Ó>$xÞºÿ‚…ø‚k?ÇÙoá>¿â«ÿümO€_~|uý¦uoxs@ÒltIÿkßÛOö›ãì+©ZxŸ|ðž«û3|ðï‚ßYøoð“MøSâ-Cৃµ€X°øñ£ÇÖ~“þyûkø¹¿hɯ øÃâß‹úN½ðÿÅž 𮓬x xƒáî›ñœ Ûö$ý”üiið’üBý©?k?øëâ5·‡„þ-þÓŸµïÇÿÁ@µÿxXñ—†ü-¤|øçûAüSøM7ì'û;x›Ä7Þ7´ø•ñ;Â?¯^é^1Ò¾$]Êañ×Çdø+ð+ögýžü?ñÿà?†¾ü0·øÙñ¾üRñGì}ðÀßõŸÚÆ>ó!пdÏØòÃÀVÞ’ËáØìüE¥ü[øßs¨_O§É¢ü^ñß|3¨[|Añç€wñ-ôí#âN©}ñkZÒ¤Ó¼W¤|×<]ðgÂ*xRÚ{«K+_Ø'þ õ¤Y<77ßu‹ JѾ4übÑ­®µm?ÄÚ[˜—Âz·Ãÿ i_²èsÄ«¡Íñ“Pºø³'ÃÑðæ?ü=Õ5ÏøF?x'öLðæ¹Xèÿ³‡ìÝ¢Ù¦³ÅoÛ›âAÖô›OëZv“â‹ý.÷žÒíü< à‡Þ9›QñT>›Ç?Ä…øI/Á߇º}ÜW Ñm¼màOØgÃþ/±"xÎ[½OÄVŸÿà¡_ôÿêgo}¨øªmÃÅk ºGˆôŸk¿ðÔÀÙëƒGÕ–+_ø|9ø'Ä'Ã?ôç¾ð×ì¿áýiàÕu¯Ú¯öá×5?ZIãOÚÇbÏWÕ¾ø_×tCM“KñÅõËFÇâô@ ü?®Coà:Ëž&skàOãO‡<#ñËIžÂâ)í]îßöîÿ‚‚_\ÝøfóJÓ¬/…¤ß_‡~мE¦øºÆ¿¼cñ£LøÑãvä[G Ç øƒöéÕtÑÉ ´º¼ ?à› Õä/VWÞø—¡^éjúßÄmâ4Ößµ0hüg‹¢ÓµKŸŒ^1ø—Äߎ'Â:÷ˆ¾øcûÄ?µ¿ˆ|/"][þÏŸ²Ìrë7À_±Â™-µ7ø»ñ-ORÓüG£x{âV³âˆ³¦¹ñ∀,ê>.O+Åz¥ïÅï]ÏyñLø9â_üÐ.-/5ýOL“l°¿ìwú}ÆšºEî„lhŽÚkG©i÷z‹æ»ñGÃísÀw7ß³oø¶ H>-³|Z¿ðQðUÿƒ~ ëZ×Áý¿Bø ¡_˜´Ý/ö!ýˆt½6 <_ûVx¼ CøƒñCÑõMcBÖ5O ØXxWÃRxkÀøx±â'‡µ?‰2ËñCþeׯèºíîá»øö0ðçŒÌ1ÙxÁÖQËâ7ã7ü#ã6›âXíŒv¾8—ÂÑø¯Ã–öþ×t_iZWí$â_é¾ “Å“Ý|P²ø#oðWà­ÏÄtûOü=ýˆ<'âU}kÄ?´íGâ=[ÄÅÛWâµ½ö»â=FñˆïeÑâ¸ñ^©z³ðÁo‰Úít~€}!£ø†Þâ÷á^…§x¿ÅúÔÞ!Ð|Mñ‡Ã¾ø·¡>⟊ºÆ—bÖrþÜ·]ôkáéüðWÃ#JÒ­> |¸ÓükÝ—ô}3GÒo<àoü§á­bÛÄZOÂ[üã‹6ÿµ_ø³IÓuÝxwÆŸ¶ž»¢ß^M¨|dø™äïO…_ðO‡‰ªé×¾ðêiöº‹ü/©|?ðÕ‹ø›EñO„<ñдñ‡‰4¿ËsñCÅÿàøÓñE´{íSÞMÅÿ··á‹‹‹Ø<ðŠßíºü*Ïø'Áïí=WQñ.¾“jZ7Œü*|G¨ê~3ñ™ñ Æ~-ý¤@">*]GDÖumSã‹üaÿ ¿Æ)þëþ/øSáé´{ãˆ4–·KOØ÷ö´M]gðŸÁ_ RÓ~4üe³Ô_Ê›Âß¼K©xëú–™ã¯ü%—Ä>4·Ó´‰:¥÷Å­kJ“Nñ^‘ðG\ñwÁŸ <©áKiî­,­`Ÿø'Ö‘dðÜß|UÖ.t-+FøÓñ‹F¶ºÕ´ÿinb_ êßü1¥~Ë 5Ï®‡7ÆMBëâÌŸGØü#ð÷T×< áüAàŸÙ3Úä c£þγv‹fšÌ¿no‰[Òm?Ñ'ðþ¹ ½ÿ‚4ë/ø™Í¯‚5?>ðÇ-&{ ˆ§µw»Û»þ }swá›Í+N°¼ðý¾¡ðà…ÿü+¹´}SA·6zG…uŸi—²ÈéçÂMbü)øe¯ÛøÖïâU¾¹ð÷Ázįô+o ßxþOÃzmì^5½ðÕž™¢ÙøvïÅI:ë·®¤Ûi3_½„e„VëkË?´ýëÛüHøyứô;m'âd6šø{á8 ügýª5ß ÿÂU¬i_ uÝv!/€ÿg†6ú¾¥ãß‹$¹›T±Õì¼U?…5+ økTñO†>0€|ÍeâÍGRÓ´-[Yøº¾.ÿ„ßâÏÃøÏáv‹}¥jŸ|S£êw+eû~ÅZp¾ŽãÃÿüq¡ê¶¾3&¤d]Áþ<×u/éz­¿Žüoð€·~1¼²Ò5íSXø«¥h²ZüH·øâÿ|#Ñ5)ÓÁ–“]xvËIý€ÿ`­"ÊKÆúÕΑ¥hß>9iÑkš‰´MtÛÚø[Vð„´¯ÙDÖ9~ßÿ¬&»Õ¼ªh  xSáÏüßà®±y}·guá«ZÁ@oµ=6ÿâφømñ_ÆÀjjž-¾´‹Å²Ü|TðïäðwŒü1ð[ÅÚÇÂ_ ^jžýŸ¼7xº>Ÿ þÃß±–“aa ~8ý¤|_#èÄO‰ZN….±¢êz•­‡„|9'†>|:øngÄÞ(Ôü<Ÿ%—âO‡~]|,ÿ„o@½½Ð´Sã?~Åþñ}¼±Ùx;ÀöQÁâ7ã7ü#ã6›âXÍ´v¾+ÂÒøãÂöþñ†‹®éZWí$7ŠüðÖµðò »; ?ǦéÖš„>üüQý¿¿àšß±L¿³OÅoÚÊ÷]ý¢>2ürðÇü¯öûø/ñ¿Ç_´çí…ãoÚöˆÿ„sösø£ý½ñWƒâÇÍsLøqûxHñeìÚo‡uoìŒQøÛBðv¹wâ øóIðçÇðí~€ óÿŠçâšü2ñû|O‡òüdñø[Åy|GÃ)øÃz'Ço~ÇŸ´6—¦øˆ·‡-uÿˆÚOìÔ“ÜØx«Qð·†>'ÚYø^}Sâ †ðNÚWAÓe¹þ;ü0ý‹ÿk/|&ý”d¯ÙËYÕ><üNø£ãð[ÇŸ³‹n¦ñ/íðóZýœµ{¿ø›ãæ‘{¡øïÆþÕ"ø;âË/ˆ? ¼ áÝsã7Ä/ Ï¥j¿À8ÏÿÁ'h_øö¦ø}ffo x—â—ÀOø(ï»?ÚNÃÄßo¾6~Õº¿í™¥øÖÏá4µ­ºü'Ò!ð§‡~ ÍâË9oåÒ>h? 4O þÇñg‰Ÿö?ðþ·à_ Yè>&ø¨øƒYý™í¯lü_â­Eìµó§éÿ³þ¦¨ß ¾ÚÞxŽï]ºÕ¼c¥€|gûUÁ*¿mOÚ/öYý•¾Ciû&èŸg¯Ø¿Ç?³N—âŠz½½×¾+ßøGáƒ<ñãÁß#ºoåý§áѵOCð¿¼E(Þx{ÅvVž(»ÔPÀðV/ùE—ü³þÌöÈÿÖuø@–Ú‡ì{ð»áýßÄ-kLý¢¿j„ZïÁø+ÄPê°~Þ·ŸÆ_þÅf²³Ë¡x#¾ ñÇíñ'á÷íûi|cµñŸö—ÁïøSâWÁø|£ëÿ¾%xG^Ó|9ûJ€7Tøû@ø5µý ÁX¿j/‡º§À˜ãøœ§Çß?àžÞ+ð·ìµðÃÆ’Ey¬øûöœÕí¿aË]âÏíMñv81ü?ÿ‚N~ xSuÙÖi¿Û~ÿUý…4ë[íGTÔ-.u„_ üZÚgÄ•½ð£v|}á­SGñÎ¥ð<ºýŸ~=ê÷M øgþ ‹ûf-ÇÄmþÐ_ ¼ñáÏìeâJïI¶dÔjßÚÚÿUýcŸÂß4!qá½á¯Áï‰f§â[Tð/‚tïkÖ¼-¢ø7àà­¿gïŽ^1—@ƒHÿ‚¥~ÙÞ?Ó>?x~ïÅ>Ño~~À~ñ/í%ã Gi}«|fÖÆ¥ûø’O†?°Ÿ†¬®-­4ýÇv9:Ïà‡ÇÍJÛúî³ÿoý±<[Œõ«ß^8ñGÂß…ÿ°V—yñÃâF”/ô럱}ü1*j^ð‡€u-#R¾øÍñZ×[‹áÀ‹À¾5Ö5}OŽˆž øPü)?UŒZÞ½ÿjý¬í†µíGömø‡â…ß `ÉlÖóY»–Ëñ÷ì[¥è¿°v‰ªÜ|b¶¹¸ð®‹ñOã7æðŽ‡mâ_…Ö‡Xðž¯àÙô¯ÙüÒü ý <+eªjZ¿ü‹ö¤ðÔ¿¼IiðÿÇz—…þ~ÀZǃþ ø#Å7Ká¿Ù£áv›á¯Ø6ñ7ö×ñ®Ÿ®øÃw×ÂË jUï‹|9m{áÝjâ/ø3â(—>?ø|E=÷ü‹öŸð Ïìí©ÚxŸUÔ|Mð×þ ëâÏ~Ë¿ ¼uio+YüIOý„›IøËûküYÓ®<@ºu¿ƒäÑ|ká7ã öúˆ|k¦øªÑ¿h°åý¿hm é_ðUÚÃÀ—ÿ t‹/ŒÞ³ø±àø'Þ¡¥~Í_µËiï5ŸŽ¿¶¶»©~öÖ3ø·ãI´ïx›À ÔåÑþ$Z]Øësê|{ãï €:/ØóMñ6½¯7ÄŸÚßöÌø³¬ë Óâßÿücý¨~2~Êðø–^&ð÷‹mk_Û+Dýˆu?ØÓÂ:Oü!"ðýÅçÀŸ x¿Ãwí¬éúfµá_üZm áß‚ô¿Øেbƒ&¿ðM¶ñ»ößøoñ#á%Ö·á/ ø×þ %ÿ!ð¿Šj=WA²Ð´¹¿kÚNKoÚZÖ?ƒÿ³Ï„c³ðÚx×GðÞ‹â?É«iYÉ«ÞÜø/À7  ðçìOð?Ågáh_Žÿ¶¯ÆÍ;âÏ…|{á¸,üWþ =áícöïÕl4ÏYÝjz’?íEâ ?†Ÿ°Â»?Þ\è>>¸´ñ6¹ã‹]OÀfÏÅÞ4Ó¼EceûNRÓÿa_Øãâ$ n¾/ZGûoÙkÿ5ß ÙøÃö‹Ö¾+þØÞ:ø÷ãÏ ë^'ñü(¯Ø’óöÅø“ñ×Qø û/xö]Yþ2|dð‡‰íï>$xgáö”~ |KÖ´o_øà€G7ü»þ Ë©i÷¿ð‘þÉ?°Ž£m⟎öÞø›­ü%ýŽ> ÿÅ[ã=*qi¦~ÆŸ±=©ð.—0þÇšÛRÒ?h/ÚB)l ð§ÆÈu)l¾é’\C6«ûlþÞZÍî‰qsãëËÝR¿ø;ðUÔ¼-ö xŠöæë@×4/k?³Ø6šõä×~ дOn\kŸî~2xÁß,u-3Åõû 7E´¼ý¸¿n½B MãÀÿ ¼-%†—cð³à£i¾²‚}3FÒô+C¾ðw€<û=€G ësø…>ÙYøâçâå‡Å}_ñv…aâ-2o x³ö×ñv§K%ßÅkgwÂOØ7áô:®›?‡4x´©´Ç®ø'D°¶×tMkÁþøê—âæñ&ðò[߉ñb×ãW‰5;RÕ¼?£Ýèž2ý¹üaá[ŸÞAðëá…¡ŸS¿àŸß]ø†+­cIñç…§—PÖ§r¶_±çìU§ èîøwñî½â»ÿ ¿Å;·ø‰á„³üÒ´‰âºÔ´çñ—ÿaŸxÂÃY7>+Öê]fÃã—íÿñªÃÄWÒE¦j^ ÿ„VËÆz-³XøŸHñŸˆSö³'×5M÷Åvö>4ðømðïOø‡á |VŠÿQð¿ìÅá-d^êZßígûhxUÕ ºñ¯íã–³ñ·àO‡šÞ¹§_Y¾‘ªÜÞ_Á$ÿ¾#ø|m;\¿ƒTÓ4í/ÄöŽtÿ†ßüàÿöÚž›$w×<÷ÿ·í÷~ÿðÝéÓh×z$WŸ¾Þ7‚¤¶¿ðÆ£wo…5Ïi:—ì OÃZÝ爮üc¢øÒïâE§|¬üMðo…¼s¥]øoÅ¿µ/‹,–Î ïÚ¯öœ»N·o…Ÿ²ƒZãD‡áÇëOišUì†4B¼[†¿(ºˆŸÅéðÞãÏø]zgÆ_øKï–Ñtë kŸ·o‹4 }h½ÅȵØ~ÿÁ9þê¼Ú{Ço¯hŸô­c–Þøÿ@ñÍÆ“ûT€E§xÊçÅámRûâüŸìþ(üD×ü)â¿|?ðýÖ‘âoÚÛÆ^“UšÓöxý˜lîu[˜¾~ÈŸ Ež·7Ä?‰ëZ…Ÿ‰4¿ø“Zñ®?á ø—ñÄ€§‹µ)bPÕþ,[Ë.¥ñz/ƒÞ7ñGÁ½7T·»Öµ-:îÂ+Ø[öˤÞXèÚ]æ‡ýûBü|±¸ÒõM_ üA¾“Uøw®øRãWý˜+jž-¾´‹Å²Ü|TðïäðwŒü1ð[ÅÚÇÂ_ ^jžýŸ¼7xº>Ÿ þÃß±–“aa ~8ý¤|_#èÄO‰ZN….±¢êz•­‡„|9'†>|:øngÄÞ(Ôü<Ÿ%—âO‡~]|,ÿ„o@½½Ð´Sã?~Åþñ}¼±Ùx;ÀöQÁâ7ã7ü#ã6›âXÍ´v¾+ÂÒøãÂöþñ†‹®éZWí$ünÞo‰sÏñ/ÀŸbø#àOøN•|uæx—á×ìAðëIJjúω¿hŸÚ#ÄÚαsañcöÈø±asâèZ‰üAzt#{}}}}âKO|Eø‰ñœÉ!:×ÄmrËYñ5Êü=ðŸÃ Zü{øð[öŒ·Ö-[ÁCGÔ­¯tïø)?üëO¼¼ÐnÇÄ¡®h7Þ6ý“¿eêÖ¼ ªxWþ‡Ä+~оû'ìíšõä×~ дOn\kŸî~2xÁß,u-3Åõû 7E´¼ý¸¿n½B MãÀÿ ¼-%†—cð³à£i¾²‚}3FÒô+C¾ðw€<û=€G ësø…>ÙYøâçâå‡Å}_ñv…aâ-2o x³ö×ñv§K%ßÅkgwÂOØ7áô:®›?‡4x´©´Ç®ø'D°¶×tMkÁþøê—âæñ&ðò[߉ñb×ãW‰5;RÕ¼?£Ýèž2ý¹üaá[ŸÞAðëá…¡ŸS¿àŸß]ø†+­cIñç…§—PÖ§r¶_±çìU§ èîøwñî½â»ÿ ¿Å;·ø‰á„³üÒ´‰âºÔ´çñ—ÿaŸxÂÃY7>+Öê]fÃã—íÿñªÃÄWÒE¦j^ ÿ„VËÆz-³XøŸHñŸˆSö³'×5M÷Åvö>4ðømðïOø‡á |VŠÿQð¿ìÅá-d^êZßígûhxUÕ ºñ¯íã–³ñ·àO‡šÞ¹§_Y¾‘ªÜÞ_Á$ÿ¾#ø|m;\¿ƒTÓ4í/ÄöŽtÿ†ßüàÿöÚž›$w×<÷ÿ·í÷~ÿðÝéÓh×z$WŸ¾Þ7‚¤¶¿ðÆ£wo…5Ïi:—ì OÃZÝ爮üc¢øÒïâE§|¬üMðo…¼s¥]øoÅ¿µ/‹,–Î ïÚ¯öœ»N·o…Ÿ²ƒZãD‡áÇëOišUì†4B¼[†¿(õán´Þ#øcðçÄ/ã_üJ}{ÀžÖŸâ7„,âÓ¼'ãöÕñQœëº%œ:Ö¯®›mz¦ ˆ.åùKö›ót߈þ ¹’=ÃOôÍ?áÞ©«èóGyñ×ãíÄ·^)״هẹð^‡¨ý“Sñ¿Æ‰-w§É¡x"ÓíVW:D^µñáˆÍñø›P²±Ðµ-[Ç t)´_[ü ñ_‹~i—RXü7µ—Q°Ó´ØöÒ Ó´§Õ¼s«^iZ_†>6üo²¶Ðõ›94Ñ—áÛÿøGß²Àõ]WÃÚV±{yâï„_ .¾øÝ>êú×€ô8üEá_ØÏÂ>(‹ÂÖ'ìÙû>i‰áé ø¹û_üY´Öt+?kpèò_ñ¼u¿…µ{ü ðûÇ€õ­{Pð®‘ãs'‰¾|%—à½ý¦¥Ô­ÿá.ðGì'àŸC=Å×õç¹µÔ­>8~ß¿´ÿ^jZV›©A<'?ªÏâ]'Æ%ºý¬@©]jºçÄk[}Gá€døoo¥üYðχ~#yº§†ÿf jÑxŸRÖ?lÿÚÛÄ7âÒo~Ñž?š×Ä:׃¾êZÝŒúyÑVòçÅpÉ7þ!h€ZÿRŽmwFÓ®þܺxVÏãwƒ|ñ.ôȯï-šÝïÿo_ÛÛPMðôúU–›w ¥×Á¯/káè­.ücym/…5¿h—¿²h 6âóÄú–›§iwþ ø£cñ7á͗įø_Ç6M x³ö¶ñ6'…a½ý«iëÈ<6ãáìÑðäI¡Zü7øwg£\Yj¶šŽŸ¥iZ:›/‡¿㱡ëSøºO ¡ñO„¾6éŸ<7¨ÜŠËþŸþß^)ðݼÌå¡Óµ¸>Á>¾A«ád‰¯\þÖ·ž3Ñþêz·ÇÿGá/ˆ ¾"Ùé~+øy§xKÅ¿þøcá‡xã/ÄO~3_Ùãöƒø‰ð»á÷‹¾êº†¾~ÐPx{ÃZç~|?Õ<'ý³«ü*·Ñ<+à»xÃþ 9ñÂWº‡ˆ> |/ðÿ†m~xÓÀ'¹øóû7øÄ>ƒã‡ìë£}Qâ­[Rðü-lµÿƒÿ ®¾.ã½:ÇÆFOè?±‚üY»}¬~Òÿ5mKûKþí¿ñjÚóÄ燼/®k7‡NºÔ#¸ÔQý¼.â„Þ ÖµO¿·/Å};àgÄÈü1ðÃöuð…ý³¬øGö<øQ¨ê7:½”^Ôuû¯ŠºÄ!µËñÆ4ý¤À>é°ÿ‚Â~ÄZ­·„ït¹kýJÏǾ"Öü!àk»ø&‡ü®òÛÆ~,ðÐññ…ü'qoû$Ɉ¼E  ø¨ëz&÷š–”<3â}mö6£ö`ø,?ì>Ö¶W«?ízÖZ—§øU§]ø&ü¨ÚßüQ¶Ô/t«Ÿ†öWöIò®¼}oªiºŽ›?ƒày“àéÛEÖVߥ¾‹+i:˜Kæ6^PaÿvýŒ5[í#LÓ-ÿl­GRñ‚ŸâVƒ§ØÁ1ÿà¦7—Úçä›M·é–ÿ²4——‚’ãYÑàYG>„³jÚlfü=õ¨”þ ýûø¼žÿ†ÄןâW‡o<_ðé4oø&gü·ToøON‹K¸Ô*ðíŒÞ=æ·¡ ý6Ö-_K’{”MBÑ¥ƒGÿ‚ÃþÃþ!‡ÁWÿµî¹oñ*ï]°øu>ÿÑÿ‚•jpøþûÂöÚï‰lü-—ì“:xªïöz.³w®ÛèM6“m¤êsê o…ÓÄëoø,'ìE{‹sg/íwoâOë?<;=·üCþ Wq¿ñó떾 ð‹,_²K¦«ã= çÃ>$·Ö|/bÓëšdþ×"½±‚M*ýmÀÿ‡ý‡ü›‹?ö½ò->![ü$ºŸþ£ÿ*òm¾+]ßZi–¿ ®%ÿ†IÙÄ+JþÇO·ð\Œ¾$šúöÒÒ=5®.aÀ>Bÿ‚‹ÿÁLÿeß‹ß°üàç€4ÚÿXøâ¿Ù›ãßìñ¦hßðN?ø(—†¢´øÛñŸà®¯áo…¿ |M®ø§öYÑ|9à¿xß]øà{-ÓÆ:¾…ëâ½òI¢±Ô­n¤÷ŸjÚ—‡ãø‰ke¯üøMuð‰téÖ>22xÇAý‹üâȵÛícö—øé«j_Ú_ð¸?mÿ‹Vמ ×<=á}sY¼:uÖ¡Æ¡âEâ/øó㮵wªhºŸŠôÝ2óᇄgð¾‘ÆÏ x7âÊÜI¦|/²—R½¹Ôÿo/ÛgUš öóÇ×7&§ªüø9©xjãíþº¹½ñ…®hLj¿g°ﯵ KPŸDÑ'ðŠn'ðö‰£‰¾/|Xû6«'ÂØ›áÊjºlº^‹g¤ë:Š­õÝE´³ÔôwÃ^øà%¿ˆæñqðEÍ猼ñŽßãfâSÖôÛðÿŠÿn¿øgLÖî¡øWðÆÆHõØ~þÁ? !ºÕ5]oÄ0ÞøŽÇÇ÷7ž«}â[xÛÆ´ M'\Ôµ ?ÁÚαãïx–OëšÏÂOxãá^“&›¬|iñ«ø™¡ý‰?c‹ "‚ãÿüq¢j¶¾4 F;¶Ñ|â-~ïQÑu«_xïá0˜üM¨YXèZ–­ã¿†ºÚ/­þø¯Å¿ ´Ë©,~Ú˨ØiÚ?ì û éPiÚSêÞ9Õ¯4­/Ã~7Ù[hzÍœš è‹Kðíÿ|#áÏÙ`„z®«áí+X½¼ñwÂ/†_ ünŸu}kÀz~"ð¯ìgáEák ölýŸ4Äðô|\ý¯þ,Úk:Ÿˆµ¸tyN‰¯øÞ :ßÂÚ½Œ~ø}ãÀ zÖ½¨xWHñ¹“Äß >Ëð^þÓR„jVÿð—x#öðOŒ¡žâëÆúóÜÚêVŸ?oߌÚˆ¯5-+MÔŽ žŸÇ‚Õgñ.“ãÝ~Ö Ô®µ]óâ5­¾£ð‹À2|7·Òþ,øgÿ¼ÝSó†5h¼O©k¶ímâñi7?hÏÍkâkÁßu-nÆ}<è«ysâ¸d›Çÿ´@ ­©G6»£i×î]<+gñ»Á¾øΗzdW÷–Ín÷ÿ·¯íí¨G¦øz}*ËM»ÐRëà×À—µðôV—~ ±¼¶—š߃4KßÙ4†›qyâ}KMÓ´»ÿ|Q±ø›ðæËâW„|/ã›&Ð&èž#‚ÊþOh~7¿ÒjÀ í/Äž)—Àú¥ÿŽ<ñ2Ëâ‹xÇÀ>(ñ€t¦Ó‰¢OàÜx§À1ücð_‚þ1Çu¤ëßµí&ëB†óöÙý¶/!Ьn<ð“À÷:E·ÁŸƒ6ÚF—kok¥éºN“¦øN_ øÀ¿À!±»¸ñ:øZÖËZð‡Æ?ŒÞ_iwˆìÂþ+ý¼|OáíG|^ø±ömVO„±7ÔÕtÙt½ÏIÖtÿ[뺋ig©è:#ñÀKÍâãà‹›Ïx3ã¿ÆÍ;Ä:§­é¶ áÿþÝ~-ðΙ­ÝCð¯áŒ‘ë°ü%ý‚~Cuªjºßˆa½ñŽ-în5=VûĶþ<ñ·Œÿi@ šN¹©jƒµcÇÞñ,ž1×5Ÿ„ž2ñǽ&M7XøÓâ=Wñ3Cû~ÇELJ~ øãDÕl>'|hŒwm¢ø3ÄZýÞ£¢ëV¾2ñßÂ` 1ø›P²±Ðµ-[Ç t)´_[ü ñ_‹~i—RXü7µ—Q°Ó´ØöÒ Ó´§Õ¼s«^iZ_†>6üo²¶Ðõ›94Ñ—áÛÿøGß²Àõ]WÃÚV±{yâï„_ .¾øÝ>êú×€ô8üEá_ØÏÂ>(‹ÂÖ'ìÙû>i‰áé ø¹û_üY´Öt+?kpèò_ñ¼u¿…µ{ü ðûÇ€õ­{Pð®‘ãs'‰¾|%—à½ý¦¥Ô­ÿá.ðGì'àŸC=Å×õç¹µÔ­>8~ß¿´ÿ^jZV›©A<'?ªÏâ]'Æ%ºý¬@©]jºçÄk[}Gá€døoo¥üYðχ~#yº§†ÿf jÑxŸRÖ?lÿÚÛÄ7âÒo~Ñž?š×Ä:׃¾êZÝŒúyÑVòçÅpÉ7þ!h€ZÿRŽmwFÓ®þܺxVÏãwƒ|ñ.ôȯï-šÝïÿo_ÛÛPMðôúU–›w ¥×Á¯/káè­.ücym/…5¿h—¿²h 6âóÄú–›§iwþ ø£cñ7á͗įø_Ç6M x³ö¶ñ6'…a½ý«iëÈ<6ãáìÑðäI¡Zü7øwg£\Yj¶šŽŸ¥iZ:›/‡¿㱡ëSøºO ¡ñO„¾6éŸ<7¨ÜŠËþŸþß^)ðݼÌå¡Óµ¸>Á>¾A«ádžçYÕ<'»!ñ_Âo„Sü×´êM#I·ñ—…aÏxÚÎÕ ðo‚ìÓEÕl>5~Ý߬‰¢OàÜx§À1ücð_‚þ1Çu¤ëßµí&ëB†óöÙý¶/!Ьn<ð“À÷:E·ÁŸƒ6ÚF—kok¥éºN“¦øN_ øÀ¿À!±»¸ñ:øZÖËZð‡Æ?ŒÞ_iwˆìÂþ+ý¼|OáíG|^ø±ömVO„±7ÔÕtÙt½ÏIÖtÿ[뺋ig©è:#ñÀKÍâãà‹›Ïx3ã¿ÆÍ;Ä:§­é¶ áÿþÝ~-ðΙ­ÝCð¯áŒ‘ë°ü%ý‚~Cuªjºßˆa½ñŽ-în5=VûĶþ<ñ·Œÿi@ šN¹©jƒµcÇÞñ,ž1×5Ÿ„ž2ñǽ&M7XøÓâ=Wñ3Cû~ÇELJ~ øãDÕl>'|hŒwm¢ø3ÄZýÞ£¢ëV¾2ñßÂ` 1ø›P²±Ðµ-[Ç t)´_[ü ñ_‹~i—RXü7µ—Q°Ó´ØöÒ Ó´§Õ¼s«^iZ_†>6üo²¶Ðõ›94Ñ—áÛÿøGß²Àõ]WÃÚV±{yâï„_ .¾øÝ>êú×€ô8üEá_ØÏÂ>(‹ÂÖ'ìÙû>i‰áé ø¹û_üY´Öt+?kpèò_ñ¼u¿…µ{ü ðûÇ€õ­{Pð®‘ãs'‰¾|%—à½ý¦¥Ô­ÿá.ðGì'àŸC=Å×õç¹µÔ­>8~ß¿´ÿ^jZV›©A<'?ªÏâ]'Æ%ºý¬@©]jºçÄk[}Gá€døoo¥üYðχ~#yº§†ÿf jÑxŸRÖ?lÿÚÛÄ7âÒo~Ñž?š×Ä:׃¾êZÝŒúyÑVòçÅpÉ7þ!h€ZÿRŽmwFÓ®þܺxVÏãwƒ|ñ.ôȯï-šÝïÿo_ÛÛPMðôúU–›w ¥×Á¯/káè­.ücym/…5¿h—¿²h 6âóÄú–›§iwþ ø£cñ7á͗įø_Ç6M x³ö¶ñ6'…a½ý«iëÈ<6ãáìÑðäI¡Zü7øwg£\Yj¶šŽŸ¥iZ:›/‡¿㱡ëSøºO ¡ñO„¾6éŸ<7¨ÜŠËþŸþß^)ðݼÌå¡Óµ¸>Á>¾A«ád#~×?,õøWÅzƤ-®‰¨ëì©¡ÞiðóÀ@7>Ò>]àÿÂ~ø¶òM8_I¡x‹Á°?‚$_ŠþðßÄ9ôí[ÿ²ß‡/¿¶u}[öÚý¬5kÓñGí/ãYˆüWྩ«äñIy∦âWÄ€hê×P?Ž4½7Áß A³ÔôÏÞ ðWÆ+‹ K(µxŽ£.¡ÿ ý¾5­t‹¸!´»ð›]| ø<‹¤ê—´«³'„5ßé‡ì„^m>o¿‰tkxâŽñHÑü}á_|A:F—â¯ÚïÅzIÑ!¼ýªj‹˜teðÿöhø{%¶ƒmðóÁé¡Ü®¡a¥éÚv‰áá!øgðÞ€&„/Œn.£}ÁŸ4ÏÞÓ/î Dð÷‰ÿà¡+ðÚiAªkM%–½Ãø'ÇÁè|IRÁ4~(·ñæŸã²6>4Ð ü?j÷ß¼QâO…6vZŸ‡ÿfŸ \ϧiÚì;ûég‡ôû¯|uñŒ¶^Ѿ*xÓNÑ4™4íBÂæßKð¦6ðçáçÃÀ´å»ð¼z•¤üø5qð—ƣæ]×þ'ðßì+à¯E£ÛÇðóÀ6vÚN³¦|Uý¼?h+Øé÷2Yéúî“ỉ{ 4kÝ;ÿ´¨ ñKá€þ"xÅ_ ¾&|ý™#ø}á]rÃÄZŸŽúƒ>.|'ý’þxŽI|G©|{ý¤4ŸÚø›AøËûoü^¹¿Ô<üE¾ÒôßøB¾êzoí»ñáÇŸÚ;ÆÀnëÖ—s^x«Dмðÿ\¸×>ÃñsÁÞøÉs¦ØkÿüQ¦jVj·_íÅyi¢ØIáo…Þ¸ÐtÆø)ð²ÇKÓ'‚ËÂzV•¦hÞ¾ÐüàÙè;»ñ=Ƶekáo|f³øÃá éÚGŠ—Dð÷‰ÿoø]4 oø[¦>ªŸbo„ ªé6z.—.›¯[ø«OÖlí4]\Ðu?øk〮nO‹ µåå·‚¾6Cñ³ÁKa­kV ¢è>-ÿ‚ø·AÑE՟߇6w#\ƒáüûáŒåý橪^_ë°x¢ vëRÔ®¼SaâŸøßöŸ-§ºÔî|;­k²øÆSøÇÃúÇÂøïáuµ†Ÿ¬ürÖ´Ø|Aì?ûÃ|öWºÁ?ÜéÅïÄÏŠWzÎoö? ê—wš¦Ÿ®[øëÅÿ >îêÊßÁš¦ªÿ 4 )¯¾x¯ÆŸ a°k‡ÚU¶©{§hÿðO_Ø#LƒNÒ.u›ß éþøåñn O]™<uöê>ð†ÿdÐ Úgö†‡má+Ûëƒ /¾ø‘¼¨êÞ²Ò5ïþÅ^ñDÚ.‰¤~Ìß³Õ´‰ñö¹ø¹g¨ø¾+Ö4m!mtMG_eMóLo‡žø‚!¹ðÖ‘òèÿþËðwÅ·’iÂúM Ä^ýüãhl./üAª»[êöŸÿà¡_´ÿ\jVQHu?ÃüN’Ö{ÿi> ñ%×ízý½ö§øŽÞ |ðü9ñ"üWðŸ†þ!ϧjÞý–ü9}ý³«ê߶×ía«^˜ÇŠ?iÈ|Gâ¿x õHõX/'ŠKÏE4¾#øtGP¶ºüq¥é¾øj ž§¦|nðg‚¾1\XZYE«Äuuø(_íñ¨Ek¤]Á ¥ß„ÚëàoÁä]'P´¸ø}¥]™>CâH¢– £ñE¿4ÿ5‘±ñ¦â;¯þÖ`ÚÝÜxžæÏSÔäðÅŠ>Ô|âïx 2ÇÄ߶/‹4hu™m¿fÙÆÊîicð_ì}ðÊ9µ×ñ_Žu~êÓT²–ûS×5顼ø—ñÄ@iWKqáKýPøæ™â_‚^5ñ_Áhì-ulèòkmeÿôý…ã)á˽3CðÝß…&OÅç…'²O‡ÚÔ×4wñì´™q¥]xZîaðoáûøW¾øEâ|)³²Ôü?û4øjæ};NÐ?aßØ×HÓE§-ß…ãÐ<­'àÿÁ«„¾52趾ñ?†ÿa_xú-Þ?‡ž³¶Òu3â¯íáûAXø¶ÇO¹’ÏO×tŸ Ü|KØl|y£^éÞý¥@#»š7vºnðoá<¿ ¼I‹´#Å÷ÚW‰<;ûx'Ŷ×ÚŽ·ûC|qÕneÔ¿áf~ÝíµÍwTÑô[­wSKÏ KÅÞ'µÔ¾!|BøÊ&±ou£'Œm´Ï ü(ð”þ×4ÿŽ^ðÿÅÖ°m3áRKq¬ÞjßðPïÛ^êA£ÞêµV×>|*ºÔt}~+ÿ ZI©ëþ×4ïx‡ö|·¯Z]Íyâ­Bð_Ãýrã\ûÅÏxã%Λa¯ü[ñF™©ZA¨~Ý·妋a'…¾xãAÓà§ÂË/Lž / éZV™£x:ûCð€?g îìWÄ÷Õ•¯…¼ñšÏã„,,6×—–Þ øÙÆÏ-†µ­X.‹ ø·þ âÝEV~ÙÜr†?ðOï†0k—÷š¦©y®Áâˆ5Û­KRºñM‡Š|oãÚ|¶žëS¹ðîµ®ËàOãë )]ë:u¿Øü3ª]Þjš~¹oã¯ü$4û»«+jš«ü0Ð.4¦¾ø!â¿|%†Á¬~iVÚ¥î£ÿÁ=`2 ;H¹Ôý“@+iŸÚ·„¯o¬~ ü0¾ø_âFð£«xËH×¼#ûx?Åhº&‘û3~ÏVÐhr'ÄoÚçâ垣áÿ ø¯XÑ´…µÑ5}•4;Í1¾xâ†çÃZGË£üøC/ÁßÞI§ é4/x#öðG¡°¸¿ñªío«Ú|[ÿ‚…|vÓüeq©YE!Ö4ÿ Oñ:KYïüM¤øƒÄ—_µèwö÷Ú>Ÿâ;x|1ðÀðçÄ‹ñ_Â~ø‡>«xwö[ðå÷öί«~Û_µ†­zc(ý¥ük!ñŠüà7Õ#Õ`¼ž)/(øKQðg‹¼Uà84Ë~ؾ,Ñ¡Öe¶ý˜g+¹¥Á±÷Ã(æ×_Å~9Ö5û«MRÊ[íO\צ†óâ_Ä_I¥\]-Ç…/õCà7šg‰~ x×Å£°µÖ5³£É­µ—üÓöŒ§‡.ôÍÃw~™>5ügžžÉ>j7P\x\ÑßIJÐzeÅþ•uák¹‡Á¿‡ïàm^ûáŠøÔxtË¢ÚøwÄþý…|ãè´{xþxÎÛIÖtÏŠ¿·‡ícâÛ>æK=?]Ò|7qñ/a±ñæ{§xwö•Žì^hÝÚéºÁ¿„òü*ñ$.Ò4ßi^$ðïìMàŸÛ_j:ßí ñÇU¹—Rÿ…™ût|g¶×5ÝSGÑnµÝM,o<\.u/xž×Rø…ñ ã(šÅ½ÖŒž1¶Ó<+ð£ÂSø_\Óþ9xOÃÿZÁ´Ï…I-Ƴy«ÁC¿m{©{¨|FÔn4 [\øEðªëQÑõø¯ü%i&§¯ø?\Ó¼AâÙðÞ½iw5犴M ÁõËsì?<àoŒ—:m†¿ñoÅf¥i¡ûuþÜW–š-„žø]à{Lo‚Ÿ ,t½2x,¼'¥iZfàëíÀ^ýž€#»±_ÜkVV¾ðGÆk?Œ>°ñ¤x©tOxŸöññ_…Ó@¶ÿ…±ñza£ê©ðçö&ø@š®“g¢éréºõ¿Š´ýfÎÓEÐuÍSð†¾8:æäø°Û^^[x+ãd?<¶Öµ`º.ƒâßø(‹t]Yü9øsgr5È>ÿÁ?¾Á®_Þjš¥åþ»Š ×nµ-JëÅ6)ñ¿ÿiðÚ{­Nçúֻ/€|e?Œ|?¬|(ñ¿Žþ[XiúÏÇ-kM‡ÄðþÃÿ±Ì7Ïe{¡|ð}Α¬^üLø¥w¬éÖÿcðΩwyªiúå¿Ž¼_ðÓîüªj¯ðÃ@¸Òšûà‡Šüið–±ø}¥[j—ºvÿõý‚4È4í"çPñi½ðΟ῎_à´ðåÙ“Á·_a°ðþ£áøoöM­¦hhvÞ½¾±ø7ðÂûá‰À:Ž­àK-#^ðìUàÿM¢èšGìÍû=[A¡ÈŸ¿kŸ‹–z‡ü+â½cFÒ×DÔuöTÐï4Æøyà?ˆ Ÿ i.ðá ¿|[y&œ/¤Ð¼EàØÁ6†ÂâÿÄ«µ¾¯iñoþ ñÛOñ•Æ¥e‡XÓü1?Äé-g¿ñ6“â]~× ßÛßhúˆíáðÇÁÿ?ß/Å øoâúv­áßÙo×ßÛ:¾­ûm~ÖµéŒx£ö—ñ¬‡Ä~+ðG€ßTU‚òx¤¼ñDSGñ+â?‡@4u k¨Ç^›àÙêzgÆïx+ãÅ…¥”Z¼GQ—Pÿ‚…þß„VºEÜÚ]øM®¾üEÒu K‡ÚUÙ“Âï‡tCöB¯6Ÿ7ˆßĺ5‡„< ñGNø¤hþ>ð¯ƒ> #KñWíwâ½$èÞ~Õ?µEÌ:²øû4|=’ÛA¶øyàôÐîWP°Òôí;Dððü3øo@BÆ7Q¾àÏŽšgÆïi—÷¢x{ÄÿðPøm4ˆ Õ5¦’Ë^‡áüãàô>$Š)`š?[øóOñƒYh#ºðÿíf ­Ýljîlõ=NOüQ°ø£á-GÁž.ñW€àÓ,|Mûbø³F‡Y–Ûöaýœl®æ–?þÇß £›]øçX×î­5K)oµ=s^šω|D&•qt·¿Õ€XÞiž%ø%ã_üŽÂ×XÖÎ&¶Ö_ðOOØ^2ž»Ó4? ÝøRdø×ñœ^xR{$ø}¨ÝAqà]sGþË@é—úU×…®æþ¿µ{ï„^(ñ'›;-OÃÿ³O†®gÓ´íöýt3Ãú}׋¾:øÆ[/èß*þÞ´‹ltû™,ôýwIðÝÇĽ†ÇÇš5îáßÚTæŸ?´ï†¿gÝNÃá—„þø#\ý¡¼-¨§Äÿ†²oõÏ„¾-ø•û'|×N¥qãïÛ+ãµÏÅOˆ¾øûJøößUñÑñ×Æ?‹ÞøomãŸx_ᕯÅ_ˆ>,Y'í4ðûàoÅ øƒâïí¨ü&»ø¹á-z_Úá'Àß\hOû4þÂRøªÛV°ñWíãñÒîoü7ø…ñ{ã}߆ü7aðÿÅÿ/¡øµ­kZ7Ä­_᎗ûøâ÷Ń?³`ÖZõ¥Üמ*Ñ4/ü?×.5Ï°ü\ðw¾2\é¶ÿÅ¿iš•¤‡í×ûq^Zh¶x[áwî41¾ |,±ÒôÉà²ðž•¥iš7ƒ¯´?xözŽîÅ|Oq­YZø[Á¬þ0øBÃÄzv‘â¥Ñ<=âÛÇÅ~MÛþÇÅ醪§ÃŸØ›ájºMž‹¥Ë¦ëÖþ*Óõ›;MA×4OÂ>øà뛓âÃmyymà¯ülðRØkZՂ躋à ~-ÐtQugðçáÍÈ× øcÿþøc¹yªj——úì(ƒ]ºÔµ+¯Øx§Æþ7ý§À iîµ;ŸëZì¾ñ”þ1ðþ±ð£Æþ;ø]ma§ë?µ­6_ÃûþÇ0ß=•î…ðOÁ÷:F±{ñ3â•Þ³§[ýÃ:¥Ý橧ë–þ:ñÂ@O»º²·ðf©ª¿Ã ãJkï‚+ñ§ÂXlÇáö•mª^éÚ?ü×öÓ Ó´‹CŦ÷Ã:†þ9|[‚Ó×fOÝ}†ÃÃú†<#á¿Ù4¶™ý¡¡ÛxJöúÇàßà ï…þ$oê:·,´{Â?±WƒüQ6‹¢i³7ìõm‡"|Fý®~.Yê>ð¯ŠõH[]Q×ÙSC¼Óáç€þ €n|5¤|º?Áÿ„2üñmäšp¾“Bñ‚?`xÚ ‹ÿj®Öú½§Å¿ø(WÇm?ÆW•”RcOðÄÿ¤µžÿÄÚOˆiWfOk¾Ò5Ù¼Ú|Þ#èÖð7Å;â6‘£øû¾ ø‚t/Å_µßŠô“¢CyûTþÕ0èËáÿìÑðöKmÛáçƒÓC¹]BÃKÓ´íÃÂCðÏá½M_Ü]Fú?ƒ>:iŸ¼ ¦_Ü@‰áïÿÁB%üEñê?Ã[;Í;á×€týGCðw†5 xVÎûÃ_æk‡þ¼µÐ¬ ºÐü ;éš+Oàí&t{ ÌÚ6’Òè¶öNtËÆÖ ’¿i[O²|Vð_Œ­ô94i¼=áWÑõOŽ¾$¸ûm·ÂßøÏTÔôKŸþÍþ”Ü¿ˆ?j/—âÇÁ–wºf—sý‡áë]µ†ÕæÔ|5ðûÇà9é¶7>²ðQ|>øwð¦ãሯeÓ¬ïµý'ľ ý†|ãS!½ñ'‹%šÝ¿ÆOø(GÇm?ų[ÛÅž-°ð¾£ãë‹™5­{Oñ/‰µÏÚÜ2ËG½Òô» {…þð$ÿ¼}«üPð‡‡>)x®ß^ðßìÓáíE¿µuOÚ÷öÆÔæñÿðš~Ó~7’ëÄÞ/øsàßíCYÓ®5»v¼ñfuañâ/‡€/ÝéW0éæ—¦ü.ð®ûoÁñ¯Á¾ø¿âK+f—V·º[›ÿø(íùªGw§Ï£]øjM_àÁxfƒSH¼)¡$šw…u¿ hŸðÈj>›Äâ‰ið›Høƒcãßh~>ð·„>!xšÇOñ7íGâÝ!wßµíS,MqkàÙ+ÁéÞ³ømðò]í®ì¼/§éºG€”Üü:øv olG‹añÜ|?Ò>5iÿ´&ææÒ wKðïŒ?o¿øvÚc\\ßë‘ü'ÿ‚xü(\†íÞª¾5²Õo-N•ã=Æwú/ív^æÞj"¾Ö<-¤|K°ø£ð÷Jð‡‹|Sðû_µÑüQû]ø«Iòž×öyý˜l.¼Iü+ïØûá½µî½ÿ ƾ³¦ØkÖÚÞ¡«jš®¥ ¿<}â0 útwQßÛê:¿‡|*ïÁüñŸŒ> jvÖ—ú¯öcÎÖ°Oìfú‡‡îôM+KŸÃÓAñËã+Mà±?‡'Ô,oü­ø].Íö½ñËãî§7ˆu…ø§ûpünµñ·á)õoÉáýCÇâçUñ†«kuãÏüZtZ=εÓ>xíῧÆÏ øoã/ˆá–Ïá°žK«ýköôý»5)uË;Ýgâ6¡q¥jº·Á†¨§ˆì5]'M¸Ôµÿjú±â_ÙȾ Ñï.-ü_§h_ ôÍ­x¿Bø·àÿü`ñ5Ž—¬|UñNœë÷í×ûpKfÚPðÏÁ_Ïáí>ãàÿÁ{M*Êî+_èúfàÞi>ð7À`3øSKÐüAwû1Kðûĺ•·Œ¿dÿÙ“ö|Ò<{gŇÿ¬¼;ñ WÆsŸˆžñ߉¼mâ¯ÚDÖg¶¹Ôî¥×u¯xÆ3øËÀ6ß ¼wã…Ä:nµñËY°°{ècŸØ~ÿi>ø'¡^Ùk7¾&^ë³û6ª^]ê–úæâÿ|$·wV÷^Ôu x3H¹Ò<ªüñg‹> ê¶Ðé_t¨-žßKýÿ`}.Ýü5ywãË»Ï YAñ‹ã6^’ÊO Oee?†.|1á/ ~ÊàzŸ¢AðûP»ðW߆Ã3Rð¥«ø3U²ñ'ƒcŸxŠéôm/ösýž¬mLðüBý´¾!XOáß øÇÄú.Žö:v¥rÿ&«¤Ýøá÷Ä zmχì¼_¾ü)¸øEâ+Ùtë;íIñ/‚¿aŸøÔÈo|IâÉEæ·oñ“þ ñÛOñlÖöñE'‹l Øø÷Äš¼-áˆ^&±ÓüMûQø·HA÷íAûTË\ZøöJðDúw‡¬þ|<—F»k»/ éún‘à%7?¾¨ÛÛâØ|wßôZÆ­#I¹¹´ƒ]Òü;ãÛïÅ~¶†Ä×7úä ÿàž? #×!„E{wª¯lµ[ËS¥xÏ@ñþ‹û]€W¹·ŸÄÚ‡ˆ¯µ iì>(ü=Ò¼!âßü>×ít~×~*Ò|§µýžf ¯Eÿ ûö>øom{¯ÂÁñ†¯¬é¶õ¶·¨jÚ¦«©C/ÄOxŒþÔwöúŽ¯áß ‡»ðDÿ!¹Òô ;âÄm'@Ñ’ÚãÃWvösÚü?ð/€@&ðöŸuá9|#ð?Ã_ƒòü%›Wðú]éZ†â¿ ~ÃÞ ñ¬qZÃàßéñiÿ?à ?­R×M¼ÐáƒOøeðÿá{|2ø©x§HÒüoãøcö:ðO‹³}¯|røû©Íâa~)þÜ?­|C­ßøGJ}[ÅrxPñø¹Õ|aªÚÝxóÇ?€s£D-tÏ…ÞðëxoÇ)ñ³Â~øËâ8e³øl'’êÿZý½?nÍJ]rÎ÷Yø¨\iZ®­ð_áƒê)â; WIÓn5-ÁZ¾ƒ¬x—öroˆ4{Ë‹éÚ½Ä3k^/о-ø?ÿ™£ø#Á·šOü ðη ¯ˆgñÅ—Âí⽇ÅË3ÄV‹µý;Gñwí¯âÏ MgkÄÏ‹×rIªÃðûö øI Þ•áÉôÝv?é[Xh~ Ö´MwÃ^øê'ˆíÏ‹¦ñ•åÏ‚4ï–ÿüa¦ëzžƒâ 3Ã>-ýºüWáöŽK†? áºÖî¡øYûü%‡]½‡Ä:Þ«ª\ÛøâÇÄwÚ¦§qãËxÏÆß´ g¶¹Ôî¥×u¯xÆ3øËÀ6ß ¼wã…Ä:nµñËY°°{ècŸØ~ÿi>ø'¡^Ùk7¾&^ë³û6ª^]ê–úæâÿ|$·wV÷^Ôu x3H¹Ò<ªüñg‹> ê¶Ðé_t¨-žßKýÿ`}.Ýü5ywãË»Ï YAñ‹ã6^’ÊO Oee?†.|1á/ ~ÊàzŸ¢AðûP»ðW߆Ã3Rð¥«ø3U²ñ'ƒcŸxŠéôm/ösýž¬mLðüBý´¾!XOáß øÇÄú.Žö:v¥rÿ&«¤Ýøá÷Ä zmχì¼_¾ü)¸øEâ+Ùtë;íIñ/‚¿aŸøÔÈo|IâÉEæ·oñ“þ ñÛOñlÖöñE'‹l Øø÷Äš¼-áˆ^&±ÓüMûQø·HA÷íAûTË\ZøöJðDúw‡¬þ|<—F»k»/ éún‘à%7?¾¨ÛÛâØ|wßôZÆ­#I¹¹´ƒ]Òü;ãÛïÅ~¶†Ä×7úä ÿàž? #×!„E{wª¯lµ[ËS¥xÏ@ñþ‹û]€W¹·ŸÄÚ‡ˆ¯µ iì>(ü=Ò¼!âßü>×ít~×~*Ò|§µýžf ¯Eÿ ûö>øom{¯ÂÁñ†¯¬é¶õ¶·¨jÚ¦«©C/ÄOxŒþÔwöúŽ¯áß ‡»ðDÿ!¹Òô ;âÄm'@Ñ’ÚãÃWvösÚü?ð/€@&ðöŸuá9|#ð?Ã_ƒòü%›Wðú]éZ†â¿ ~ÃÞ ñ¬qZÃàßéñiÿ?à ?­R×M¼ÐáƒOøeðÿá{|2ø©x§HÒüoãøcö:ðO‹³}¯|røû©Íâa~)þÜ?­|C­ßøGJ}[ÅrxPñø¹Õ|aªÚÝxóÇ?€s£D-tÏ…ÞðëxoÇ)ñ³Â~øËâ8e³øl'’êÿZý½?nÍJ]rÎ÷Yø¨\iZ®­ð_áƒê)â; WIÓn5-ÁZ¾ƒ¬x—öroˆ4{Ë‹éÚ½Ä3k^/о-ø?ÿ™£ø#Á·šOü ðη ¯ˆgñÅ—Âí⽇ÅË3ÄV‹µý;Gñwí¯âÏ MgkÄÏ‹×rIªÃðûö øI Þ•áÉôÝv?é[Xh~ Ö´MwÃ^øê'ˆíÏ‹¦ñ•åÏ‚4ï–ÿüa¦ëzžƒâ 3Ã>-ýºüWáöŽK†? áºÖî¡øYûü%‡]½‡Ä:Þ«ª\ÛøâÇÄwÚ¦§qãËxÏÆß´ g¶¹Ôî¥×u¯xÆ3øËÀ6ß ¼wã…Ä:nµñËY°°{ècŸØ~ÿi>ø'¡^Ùk7¾&^ë³û6ª^]ê–úæâÿ|$·wV÷^Ôu x3H¹Ò<ªüñg‹> ê¶Ðé_t¨-žßKýÿ`}.Ýü5ywãË»Ï YAñ‹ã6^’ÊO Oee?†.|1á/ ~ÊàzŸ¢AðûP»ðW߆Ã3Rð¥«ø3U²ñ'ƒcŸxŠéôm/ösýž¬mLðüBý´¾!XOáß øÇÄú.Žö:v¥rÿ&«¤Ýøá÷Ä zmχì¼_¾ü)¸øEâ+Ùtë;íIñ/‚¿aŸøÔÈo|IâÉEæ·oñ“þ ñÛOñlÖöñE'‹l Øø÷Äš¼-áˆ^&±ÓüMûQø·HA÷íAûTË\ZøöJðDúw‡¬þ|<—F»k»/ éún‘à%7?¾¨ÛÛâØ|wßôZÆ­#I¹¹´ƒ]Òü;ãÛïÅ~¶†Ä×7úä ÿàž? #×!„E{wª¯lµ[ËS¥xÏ@ñþ‹û]€W¹·ŸÄÚ‡ˆ¯µ iì>(ü=Ò¼!âßü>×ít~×~*Ò|§µýžf ¯Eÿ ûö>øom{¯ÂÁñ†¯¬é¶õ¶·¨jÚ¦«©C/ÄOxŒþÔwöúŽ¯áß ‡»ðDÿ!¹Òô ;âÄm'@Ñ’ÚãÃWvösÚü?ð/€@9­_Å^ø áÇ¿aøû/x+ö~‡X±ñüGã/…ðOχ4û6Ÿ‡4KY»Ôü/ñöôøÙŠtÍ>÷VkoÃÚ$Þ3šÎæoé~ ´ðçí@ñ÷†üûMütÖ¼&¿þøö)ýœ¾øóÄÚ½ŸÅ¯ÚšÓÆq|xýœ|;âk Û_üi×fO‹zˆm?lOŠú—µ=ká7Æ?Úk[ø‘©Áã‹/ÙÝ~˾|LÓ¿kÿW|=øK |ðûx[À ü;áØt?‰~Ð:.ûEüMñ'Ä Âz•þéu¿ø(/üKâO¼m«øÿâÅ[‹o¼_þx—Åú‡Šü;eá/ h‡Ä~‡ÀͪþÌ Ÿˆ4{Ë‹éÚ½Ä3k^/о-ø?ÿ™£ø#Á·šOü ðη ¯ˆgñÅ—Âí⽇ÅË3ÄV‹µý;Gñwí¯âÏ MgkÄÏ‹×rIªÃðûö øI Þ•áÉôÝv?é[Xh~ Ö´MwÃ^øê'ˆíÏ‹¦ñ•åÏ‚4ï–ÿüa¦ëzžƒâ 3Ã>-ýºüWáöŽK†? áºÖî¡øYûü%‡]½‡Ä:Þ«ª\ÛøâÇÄwÚ¦§qãËxÏÆß´ g¶¹Ôî¥×u¯xÆ3øËÀ6ß ¼wã…Ä:nµñËY°°{ècŸØ~ÿi>ø'¡^Ùk7¾&^ë³û6ª^]ê–úæâÿ|$·wV÷^Ôu x3H¹Ò<ªüñg‹> ê¶Ðé_t¨-žßKýÿ`}.Ýü5ywãË»Ï YAñ‹ã6^’ÊO Oee?†.|1á/ ~ÊàzŸ¢AðûP»ðW߆Ã3Rð¥«ø3U²ñ'ƒcŸxŠéôm/ösýž¬mLðüBý´¾!XOáß øÇÄú.Žö:v¥rÿ&«¤Ýøá÷Ä zmχì¼_¾ü)¸øEâ+Ùtë;íIñ/‚¿aŸøÔÈo|IâÉEæ·oñ“þ ñÛOñlÖöñE'‹l Øø÷Äš¼-áˆ^&±ÓüMûQø·HA÷íAûTË\ZøöJðDúw‡¬þ|<—F»k»/ éún‘à%7?¾¨ÛÛâØ|wßôZÆ­#I¹¹´ƒ]Òü;ãÛïÅ~¶†Ä×7úä ÿàž? #×!„E{wª¯lµ[ËS¥xÏ@ñþ‹û]€W¹·ŸÄÚ‡ˆ¯µ iì>(ü=Ò¼!âßü>×ít~×~*Ò|§µýžf ¯Eÿ ûö>øom{¯ÂÁñ†¯¬é¶õ¶·¨jÚ¦«©C/ÄOxŒþÔwöúŽ¯áß ‡»ðDÿÕ.nnõOÚçöÇÔnüOsoãÿڋǑͬëß <¯êúÿŠ´ŸkWr·‰tûíâOÄOIeáËC¤iš^•ðŠõþ&ß|`ð?ƒþ0kúk›»k­:çTÿ‚€Á@uKÍ_OžòM&ïF—WøðYšrÒ/x9-tŸë~Ó¿á@*j°ñâ=2Ûàö¯ãˈ?¬¼oáO |Eñ%îâOÚ—Åž{eºý¨¿jÛvßð†þÈ^¹´ÓG€¾kº}Ε{ x{ÂzF‡ðõ£ðÃá­hë:•âˆ~(Dß |Añ‹Oø¿â M„ºí߇øÑâbòËáÕ´ó¥î½ûvþÝ׺§‰lï|QñgP–ÓSÖ¾|%ñ®<[¦ëxm¤Ô¾êÞñ‹?g _ Û^[.›¡üÖ¼Mÿ OÄÛ‰Þ ðßÅïÞÙkÿ¼A¥‹_í/Û£ö⺖çO}á7„_Gµ›à§À­SGµº°O x+JÐ<àKOð7€¿gàõ i>"¶ñüv? u_‹Vÿ¼o¡kÚn“âÏßhºïí§ã_'þgÆMBkÍU>Á>>#éÉáßßiÚŸ…ü_ Ú=†¾ø§Eñ7„iŸ u…ÿu_jú—€u+¯x;ö9ðo‰,­ìõû9éz3Ïañ öÒø… ú>‹âøO÷:–›bñ÷zN«ðûÀß¡èvú¿Ã(¢øe§|(»øQ§kz…ž¡­¿Šü û xÅo¬|KâYN±¯Ø|rÿ‚ˆ|r°×ä·¾¾·“Æ—þ ¿ñ¦½ss¯kúf¿®kŸ¶-ÖöV¿ - ø?oà[ø¿Yø©á |PñM~Î>Õ.nnõOÚçöÇÔnüOsoãÿڋǑͬëß <¯êúÿŠ´ŸkWr·‰tûíâOÄOIeáËC¤iš^•ðŠõþ&ß|`ð?ƒþ0kúk›»k­:çTÿ‚€Á@uKÍ_OžòM&ïF—WøðYšrÒ/x9-tŸë~Ó¿á@*j°ñâ=2Ûàö¯ãˈ?¬¼oáO |Eñ%îâOÚ—Åž{eºý¨¿jÛvßð†þÈ^¹´ÓG€¾kº}Ε{ x{ÂzF‡ðõ£ðÃá­hë:•âˆ~(Dß |Añ‹Oø¿â M„ºí߇øÑâbòËáÕ´ó¥î½ûvþÝ׺§‰lï|QñgP–ÓSÖ¾|%ñ®<[¦ëxm¤Ô¾êÞñ‹?g _ Û^[.›¡üÖ¼Mÿ OÄÛ‰Þ ðßÅïÞÙkÿ¼A¥‹_í/Û£ö⺖çO}á7„_Gµ›à§À­SGµº°O x+JÐ<àKOð7€¿gàõ i>"¶ñüv? u_‹Vÿ¼o¡kÚn“âÏßhºïí§ã_'þgÆMBkÍU>Á>>#éÉáßßiÚŸ…ü_ Ú=†¾ø§Eñ7„«ªx1´«ü0‡á/ðß„dÐ Ú~…‰૽Cáö™ðÇQø_ðçUðf¯©xRºñƒ¿cŸø’ÈÚØþÏ_³ž—£<ö¿m/ˆPÏ£è¾'ñ„ü;s©i¶/ßw¤ê¿¼ ñú‡o [ü2Š/†Zw‹¿…v·¨YÙêÛø¯À¿°Ç|VúÁ—ľ%”ëý‡Ç/ø(‡Ç+ ~K{ëëyÐŽ³¡é^(‡â„MðÇÄ´ÿ‹þ ÑTØK®ÝøsÆ·§Œü?mw‘­ßÜ꺬_¿àœŸ£Ô!·‡LÔ^÷Ã_l®µè-ôh1m öÄ]Ó,|B~(]ëñÄ?⇠øÅž*ðµ¨øsÆ?µ×Š´Äymÿg/Ù‚Äø®߆²7ÃÈæÔ"ññájÛPñ–±­ë•’üMø‹â0 ¯¦ÙÅ©xƒPÕ¼!~¿ t_„^6ñ‡ÀíGU°Ôµ™íd°:Wì!ÿü²¶Ö|1uá/ ÛM¥Ì¿þ8hóøÖÖM&Òâã\ðžµá‹¿~É€Ùii¢ê:uÅ¼þø]?ÃOx›áF¥wáÏÙÓÚ’Ea¡þÅ¿±^¡½×Š?hµ®™¦üFø¡à¿hWæÿGÐí­a´¿_‡~ø|‡t ? Íðð'í;àìŸ |âm*[í&ú_xWö!ð‹ ¾‚ßÂÒ¬®,ñö‹®þÚ~5ðèòáf|dÔ&¼ÕSáçüãáR>œžðö©ø_Åú £ØøkáÿŠt_xCÂ/x»KÓ¼Jß/eøyâOV¿Gðþ­©iÚÍÏ…|aûsøËD»œÚ|0øwç‰oÁÏø'÷Â!©]Eâ½KS¸ð·4cÄúÆ¡/Ä 3Ä>/ñÇí<kšNŸ¨j^>ÖuŸkž1“ľÒ~øãÆ_ 5_FñÆcM’),?cØ’ñ6‰qà‚þ¸·ÔGƉÖ¯ƒ4V»Q»×üEk­h¾;ñ—Â` 7z}½•Ó꺧ƒJ¸ðÿÃ~øÓÅ/µ;m+áõ‹XiÐiŸ°Gü×GÓ¯|1z|[¨\hö|Zøåá½?ÁÒ}¯Ã–?jðÆ£áï øGöM­§èPh—þ »Ô>iŸ u…ÿu_jú—€u+¯x;ö9ðo‰,­ìõû9éz3Ïañ öÒø… ú>‹âøO÷:–›bñ÷zN«ðûÀß¡èvú¿Ã(¢øe§|(»øQ§kz…ž¡­¿Šü û xÅo¬|KâYN±¯Ø|rÿ‚ˆ|r°×ä·¾¾·“Æ—þ ¿ñ¦½ss¯kúf¿®kŸ¶-ÖöV¿ - ø?oà[ø¿Yø©á |PñM~Î>Õ.nnõOÚçöÇÔnüOsoãÿڋǑͬëß <¯êúÿŠ´ŸkWr·‰tûíâOÄOIeáËC¤iš^•ðŠõþ&ß|`ð?ƒþ0kúk›»k­:çTÿ‚€Á@uKÍ_OžòM&ïF—WøðYšrÒ/x9-tŸë~Ó¿á@*j°ñâ=2Ûàö¯ãˈ?¬¼oáO |Eñ%îâOÚ—Åž{eºý¨¿jÛvßð†þÈ^¹´ÓG€¾kº}Ε{ x{ÂzF‡ðõ£ðÃá­hë:•âˆ~(Dß |Añ‹Oø¿â M„ºí߇ºð¿€>7~Õþñ'ƒ> þÇÿ<}u}áïIðÃöi}rïö«øçÿ»:•Ôz§‚þ'üø ¿.N£eà‡Â_Š¾ ø‡ûL€t¿¿bÿüñŸÃ¯‰!ð÷ÄOü}ø{ÿ ®½¤ücý¯¾(iÏìAðËÆM$ž%ø½ãOx]¼;û:xköÌý¡´#¢Aâ]özøaàÛïÞÁ§øÓãÏ‹þ+ø×JñÿÆÿNè~²Ó!ðežð‡ûMân§ñ‹Â>øÑâbòËáÕ´ó¥î½ûvþÝ׺§‰lï|QñgP–ÓSÖ¾|%ñ®<[¦ëxm¤Ô¾êÞñ‹?g _ Û^[.›¡üÖ¼Mÿ OÄÛ‰Þ ðßÅïÞÙkÿ¼A¥‹_í/Û£ö⺖çO}á7„_Gµ›à§À­SGµº°O x+JÐ<àKOð7€¿gàõ i>"¶ñüv? u_‹Vÿ¼o¡kÚn“âÏßhºïí§ã_'þgÆMBkÍU>Á>>#éÉáßßiÚŸ…ü_ Ú=†¾ø§Eñ7„«ªx1´«ü0‡á/ðß„dÐ Ú~…‰૽Cáö™ðÇQø_ðçUðf¯©xRºñƒ¿cŸø’ÈÚØþÏ_³ž—£<ö¿m/ˆPÏ£è¾'ñ„ü;s©i¶/ßw¤ê¿¼ ñú‡o [ü2Š/†Zw‹¿…v·¨YÙêÛø¯À¿°Ç|VúÁ—ľ%”ëý‡Ç/ø(‡Ç+ ~K{ëëyÐŽ³¡é^(‡â„MðÇÄ´ÿ‹þ ÑTØK®ÝøsÆ·§Œü?mw‘­ßÜ꺬_¿àœŸ£Ô!·‡LÔ^÷Ã_l®µè-ôh1m öÄ]Ó,|B~(]ëñÄ?⇠øÅž*ðµ¨øsÆ?µ×Š´Äymÿg/Ù‚Äø®߆²7ÃÈæÔ"ññájÛPñ–±­ë•’üMø‹â0 ¯¦ÙÅ©xƒPÕ¼!~¿ t_„^6ñ‡ÀíGU°Ôµ™íd°:Wì!ÿü²¶Ö|1uá/ ÛM¥Ì¿þ8hóøÖÖM&Òâã\ðžµá‹¿~É€Ùii¢ê:uÅ¼þø]?ÃOx›áF¥wáÏÙÓÚ’Ea¡þÅ¿±^¡½×Š?hµ®™¦üFø¡à¿hWæÿGÐí­a´¿_‡~ø|úyð“IµÐ>ü2Ь|ðÞËEø{à½&ÏáÞ««Áâ SÀVºw†ôÛ;êZõ®©®ZëwþŠÐï5{mkXƒR¸±’öSPŽe»˜åÚ]-/¾1|8š5ÕüE­øÃ÷~<ÓÛÄ*Ö¿gR¾%Óõ_ÚgâVEµŽ¼}m¦[Þx_ীo¬Ùø£XÑ#ðÆš¾0ñÿ…€>qÑ´m<éÿ ô½/áŸÄ Ÿ5‹žðwÅÍGPŠïV»‹P{ÝWöúý¾µ[×Òæ°ûÚ[럾k¢k–Zæ‰áë[_x_Y𾙦þÇ`özâ-ÇN´økñOâ§~2^|@ðÇ„þ#j7>ñíeâŸKáè§ý©?j›¯ì‹gøkû0|:¼²ÓÇƺ֕g¦k^ðÇí;Cøs¨-çÃO†Äþ©¦èþ&ðÿ#>ø›ñ~ÏâçÄKðÍsuáÏ~Þ~1Ð|‹d¶ÕMÏÛSà§üŸá]­…Üz”Kៈ^yÚ×ÆŒ¤²ý±€#ñ-¦›âDøÓ6©áÏ‹?tÿˆÚ÷†üâx:KÏ ø¯ö»ño®Oì¿û3ü}Ñ­ü'iÅ–«5ψü)­øVëÄß²(GµƒHÕõéî¼7ã‡Rx'àÞ‰ðÇľ*øKÖ¥áÏÙ·BÖ&ðõžû~ÅZ^¡¤þ:øãã³±µø•ñ;Áº¾Òµ]#ÁÖÐ"öÛá÷þYÐ4« Þøyõσ’ü)øQq¢›2i*éþ&°ÓüM©ÝxsÄŸ¶çŒt¬üLøÁs&›qÂ?ØGá +§ øcPÓ“Ã>9ÑôÝJðÿ€<_¤x“Â^ øüxÆÓKñ%‡Å ™¼ñGãLü_á¯j—Ú;\xc[ý¸ü_£¥ïÙþx ÛOþ÷ü¿ágöŒÉ¯ø—QÕ[¾3ѵ/êzˆ¾!iž"ñoŒÿi Þ,²Óµ-Gâh_üoÿ rè¿ ¼gã_†÷:žâŸ:¦•}|4ïØ«ö=²[ãÀÿü?q¤Ÿ¾5Yj¾ÑÖCâK]ñÜ®—ãü ³âhìlµêÚ–…ãím á®™ð«Å¾+øo¨ËkðÞÆK­: +öý4}:ÃJ¼Õ¼s«>—meñ»ão†4½K=gCÒ⾿ðï‡<#û,Vþ̶Ðõ ëß x“á}÷Ãv^Õµ´Þ(ðìUá{HÑ ¶ýž¿fm#DÑu?‹ŸµÏÄd“HѵøWÃúþ£¢Z U›L»ðÃψ  ß„^"ð'‰d¯üFý…õo…ß uû¸þêqOûG~Áß±§ƒuÝx_Cñ'Š¿gísÄ—–ºÇíáãû_êÞ)‡DýŒ~)|Ôµ¯xïXñ§Ç­Sãö¬x‡Pý°€2¼+ûM…ÿ´¯ÚãöeñÏìS/€ËÆ^ñ¯Å¯‰º_Å¿ØŸàÆ¡ñ2ËÆÞ·ûY~ÒŸ´ZÿÂ7â5ý¢¼C«NÞðG…ÿmo†³oˆ|cû@üEOü_ø›Qñ_Ä(í}FÓΟðÏKÒþü@ÉñQø¹àï|\Ôu®õk¸µ½Õo¯ÛëU½}.k°M¥¾¹ð à¸ú&¹e®hžµµð÷…õŸ éšoìvg¡éÞ"ÐìtëO†¿þ!Zx÷ã%çÄ xOâ6£sáÏ~Ö^)ð侊ړö©ºþȶ†¿³ëË-<|8øk­iVzfµáÏ |:Ó´?‡:‚Þ|4øl@/êšnâoøÒ3ào‰¿ìþ.|D±ß ×7^ñwíçãȶKmTÜýµ> Á9þ¥ÚØ]Ç©D¾ø…áç‘í­|a øÊK/Û?Úi¾$O3jžø³ñOø¯xoÀ>'ñ'ƒ¤¼ðߊÿk¿èÖúäñ~Ëÿ³Å£ÜÙÞ|5ý>Eqyoã‰]Ðü5¯[êŸõMcƺ•¬Ÿ~ øWU†Ádø£©êúÄHÞ è_ üiãO‚ͪE­jÙ©m7öý€tËeðÕÞ—¥XÏbÃã?ÇÝßÂv‘\Yj³\øš߅n¼Mû"€T{X4_^žëÃ~1øu'‚~ èŸ |K⯄±Ýj^ý›t-boYèÿ±—ìU¥èúO㯎>1k;_‰_¼¡›í+UÒ<m Ò/m¾xáðJ±ð½ï‡x\ø9/Ÿ…)¸Ó&“ÆÞ ý†¼ â‹x­àð—€,¬í|E§üsý¾~4Z_ÚÙ^j5‡Ä;Ï K«ÁÓøÏIñ›á?Ú¤†§[h7ß `²øyâÿ†2ü9ð‡Ž|o¥XxÛS&ð¯ìuàÿÚø†mGöƒøë«ßÜx†ËâçíÍñ–-bòk ßk^2×|><_ãk­CS¿²ŸÇž5ø´'…4 )þéúgÃè²hZ÷Šþ/xGÿ5RçKðWw…æ·û{~Ýš¦£¨i7:ßÅRæ=GVøEðC_ñ·‹,u&?ñouo kÞ,ýš+éú=ØðF£|3ø«â¯øI¾3\üNð—†þ+Þ]iZïÅíkFºÒßQý¸¿m‹é´Í%üðßÀo£Å{ðàž¯§øvâFð¿Ã+ÃþðÞ¥¦ø#Á€#CÒ5ûKÈ­¾üMø¿iñc⮟âk ?ÄÚׇ)ÔµßÁªé~7ñß >&ŽÆËPñÞ­©h^>ÑfоéŸ ¼[â¿vúŒ¶¿ ìdºÓ Ò¿a?ØGÓ¬4«Í[Ç:³évÖ_¾6øcKÐd³Öt=.!{à[ÿøsÂ?²ÀoìËmP±¾½ð—‰>ß|0ø7eàM[Qð MâþÅ^×´ oÙëöfÒ4MQ³ø¹û\üFI4Xñ_…|?¯ê:%¨ÐÕY´Ë¿ü<ø‚nÇM²ðýÏÃè¢ðˆ¾\|)øw¯ßYéÒÞŸø/öðW‰4›Á/‹*×üJÒÝè×ÚÄO‰^»£hÚyÓþéz_Ã?ˆ> j?<àï‹šŽ¡Þ­w ÷º¯íõû}j·¯¥Íaö ´·×>|×D×,µÍÃÖ¶¾ð¾³á}3MýŽÀ1ìô=;ÄZŽið×âŸÄ+Oüd¼øá üFÔn|9â/ÚËÅ>—ÃÑOûR~Õ7_ÙÏð×ö`øuye§‡ u­*ÏLÖ¼9á‡Zv‡ðçP[φŸ ˆýSMÑüMáÿF| ñ7âýŸÅψ–;ášæëÞ.ý¼üc ùÉmª›Ÿ¶§ÁOø'?Â4»[ ¸õ(—Ã?¼<ò=µ¯Œ4IeûcGâ[M7ĉñ¦mSß~"éÿµï øÄþ$ðt—žñ_íwâ=ß\ž/Ùöx´{›;φ¿²È®/-ücñ 뺆µë}Sâ>©¬x×Rµ“âOÄjê°Ø,Ÿu=_Bø‰Ïá á?³ iV>½ðòëŸ%øSð¢ãE7dÒxÛÁŸ°×¼Qo¼ð•¯ˆ´ÿŽ·ÏÆ‹Kû[+ÍCF°ø‡yá)ux"ºé> Ó|'ûT€PÐ4ëmûál_<_ðÆ_‡>ñÏô«jcÄÞýŽ¼â;_ͨþÐu{ûÙ|\ý¹¾2Ŭ^Moá{íkÆZï‡Ç‹ümu¨jwöSøóÆ¿€$ð¦ƒa¥?Ã=?LøcâýM ^ñ_ÅïøwãF±ª\é~ŠîãP¼ÖÿooÛ³TÔu &ç[ø£ª\Ǩêß¾kþ ¶ñeŽ¤Âçþ-î­á­{ÅŸ³@}?G±»Ó´o†|Uÿ 7ÆkŸ‰ÞðßÅ{Ë­+]ø½­h×Z[ê?·í±}6™¤¿ƒ~ø ôx¯~üÕôÿÜHÞøs¥xÀÔ´ßx/àPqèzF¿iy·ÃŸ‰¿í>,|UÓüMa§ø›Sºðç‰?mÏèX!ø™ñ‚æM6â„°ÂWNðÆ¡§'†|s£éº6•áÿx¿Hñ'„¼ñøñ¦—âKŠ3x?âƘ>+ø¿Ã^Õ/´v¸ðÆ·ûqø¿GKß³ü"ð ·Ÿü)ïø'ÂÏí“_ñ.£ª·…|g£j^3Ôõ|BÓ3|j²Õ|£¬‡Å:–»ã¸5]/Æþ;ø@gÄÑØÙj;Õµ- ÇÚ,ÚÃ]3áW‹|Wð.ßQ–×Ὄ—ZtWì'ûhúu†•y«xçV}.ÚËãwÆß iz –z·¥Ä/| áßxGöX­ý™m¡ê7×¾ñ'Âûï†ì¼ «j>i¼QàÿØ«Â:ö‘¢Amû=~ÌÚF‰¢ê6?kŸˆÉ&‘£k+ð¯‡õýGDµ«6™wà?‡Ÿ@-Øé¶^¹ø}^ñÂ+…?õûë=:[Óã_þÃ> ñ&“x%ñgˆïLž-Óþ;ÿÁB>2[ërE½¼þ>Ô|1aâífK›éúö¹âoÚÜ+Ú-­•¿Áø-¾x¿Á7·ñOÅ x?⦳sªx{öqеëßÝê?¶?ísª]ÜÍ?j/ÛÜêúÿƒþëÚεâ'ÅZÿ‰Z[½ûOø‰ñ+Ã`tmO:Ã=/KøgñC'Ä Gâ烼ñsQÔ"»Õ®âÔ÷Uý¾¿o­Võô¹¬>Á6–úçÀ/€Zãèšå–¹¢xzÖ×ÃÞÖ|/¦i¿±Ø=ž‡§x‹C±Ó­>üSø…iãߌ—Ÿ<1á?ˆÚχ4ͪxsâÏÄ]?â6½á¿øŸÄž’óÃ~+ý®üG£[ë“Åû/þÏsgyð×ö@øqÅå¿Œ~$wCðÖ½oª|GÕ5êV²|Iøƒâ@~"~Ù?²Ÿƒ>+|cø;¯xÿÅ+ø÷£ø;Aøwñwá×ìu§øßãoíá׿ð™èß±ïìƒðàv‡¬|XøWðÁtØôX¾+þ×߃¾xóÅ%ð…bñ÷‡~$xƒÁW_³@¥k?¶'ÄxÜÝüþ ûà?ü3ðÇ«Ÿ‰~ñ^ûBürøðöþêËÃÏìWû|øSáöøá?Úgâî¥x‡Gý£¼ñ£ö´±Ò¬4Ÿ†âÀ øÂûAøð4µøûü%ýŸ)øQ¥~ݵT7–‹ã~Èß ü+ðŸÂo¨hžÒþj¿ÓÀ¿ ÿhࢴ :ÛA¾ø[—ÃÏü1—áÏ„ø¿E“B×¼Wñ{Â>øѬj—:_€¢»¸Ô/5¿ÛÛöìÕ5CI¹Öþ(ê—1ê:·Â/‚ÿˆ-¼Yc©0¹ÿ‹{«xk^ñgìÐ_OÑìnÇ‚4íáŸÅ_ÂMñšçâw„¼7ñ^òëJ×~/kZ5Ö–úíÅûl_M¦i/à߆þ}+߀?õ}?÷7…þé^ð†õ-7Á øz‘¯Ú^EmðçâoÅûO‹tÿXiþ&Ôî¼9âOÛsÆ:V~&|`¹“M¸‡áì#ð†Ó‡…ü1¨iÉáŸèún¥xÀ/Òa¥^jÞ9ÕŸK¶²øÝñ·Ã^ƒ%ž³¡éq ßßøwÞý–+f[hz…õIð¾ûá‡Á»/jÚ€Zox?ö*ðŽ½¤h[~Ï_³6‘¢hºŸÅÏÚçâ2I¤hÚÇŠü+áýQÑ-F†ªÍ¦]øáçÄ v:m—‡î~E€üEðŠãáOý~úÏN–ôø×Á°Ï‚¼I¤Þ |Yâ;Ó'‹tÿŽÿðPŒ–úÜ‘Eoo?µ Xx»Y’æãĺ~½®x›ö·Êðæ‹keoð~ o†ž/ðMÇmüSñGžø©¬Üêžýœt-z÷Ä÷zíû\ê—w3GãÏÚ‹Çö÷:¾¿àÿ†zö³­x£IñV¿âV–ïF¾Óþ"|JðØÝFÓΟðÏKÒþü@ÉñQø¹àï|\Ôu®õk¸µ½Õo¯ÛëU½}.k°M¥¾¹ð à¸ú&¹e®hžµµð÷…õŸ éšoìvg¡éÞ"ÐìtëO†¿þ!Zx÷ã%çÄ xOâ6£sáÏ~Ö^)ð侊ړö©ºþȶ†¿³ëË-<|8øk­iVzfµáÏ |:Ó´?‡:‚Þ|4øl@/êšnâoøÒ3ào‰¿ìþ.|D±ß ×7^ñwíçãȶKmTÜýµ> Á9þ¥ÚØ]Ç©D¾ø…áç‘í­|a øÊK/Û?Úi¾$O3jžø³ñOø¯xoÀ>'ñ'ƒ¤¼ðߊÿk¿èÖúäñ~Ëÿ³Å£ÜÙÞ|5ý>Eqyoã‰]Ðü5¯[êŸõMcƺ•¬Ÿ~ øWU†Ádø£©êúÄHÞ è_ üiãO‚ͪE­jÙ©m7öý€tËeðÕÞ—¥XÏbÃã?ÇÝßÂv‘\Yj³\øš߅n¼Mû"€T{X4_^žëÃ~1øu'‚~ èŸ |K⯄±Ýj^ý›t-boYèÿ±—ìU¥èúO㯎>1k;_‰_¼¡›í+UÒ<m Ò/m¾xáðJ±ð½ï‡x\ø9/Ÿ…)¸Ó&“ÆÞ ý†¼ â‹x­àð—€,¬í|E§üsý¾~4Z_ÚÙ^j5‡Ä;Ï K«ÁÓøÏIñ›á?Ú¤ôãá<¶¿ >ZØèÞ7ðå•·ÃÿÁgáεñ#Bµ‡Ãºlvú7Äfó]ñEæ­ã}.%K/êw^&ñÍþ½ýÔúî¯,­¨\|«ûLOm©ü[øe sQñV±¡iÇÇšÂ÷A¥| øos£Ük2ÞþÔµˆãœW‚Â+o‚u ½ËÄßluZÎÃÄ—‡aø—û;|§¢Yè~"Ó¾ÚiÖ?;²²ý³@!ñ h>&Ñ~$Ý_j>!ØüHø¤ü;ñ‰<çÃ~(ý¯¼U¡ LÃû-þΰ-½¼Ÿcïªéž9ø‘£ê>°Ö4ˈzö¹ñT´“âOÄkø†ãFi>3jº§ˆ>*ÝÍGÃßücã?ƒ«4 ñUõšêm§~À?°.•m¦è3iºV5¤Ããǽ(xoV°º>"–ëÇ^Ö|­ø§ö@‡W“KÒ®>&\Þk>>ø}/€üá¿…¾+ñ¯Â(©áïÙÇHÖdÑm´Øçö(Óm|&ÃÇŸ|_"i?>#hžÔ7øÃámㆭu&‘ð»O½oÞk·÷í٪ꋤÞê¿|G/ö•÷Âo‚>$×4¹¬5}BþWÒ¼yàÿx×ök øoá«›Y¾ü¹²ð¦œ|Ÿéz?ÃêÚ?„|ð–‹gáÿYxZ $ø½ñ’×âÏÆiüU£i¾'Ôá×ÿm¿øtèË'Æ_‹·v~døKûüH¬&ð·‡t½#Nð·Ž´]šn‘ை:Œ|à`¬þñ&¯ÜM{ñ{ãE§ÅW‡nõmÂ9¯þܾ.Ñ šEøwðòÖ;{ˆ~Á;þCss&±â›-ZÏÃÞ9ÑmÞêkO$ú”6zGìûé6^Ò.u¯ê766ÚGÇ/š6•¢x›N×#µ·:瀵o i^ý”@#ÕcÒ¼=ªøºò÷Xñ¿Â»¯†´?ëZ·ÃÔ‹ÅýŒü+â(ü<šoìùû6h–Öm>,þ×ÿ`“G‡[ñž…ã}D2øV :ìu‡ÞñàÅ4 \é ÿoÁÙ~ü’øiÒ^Cão~Àþñ…nϪø‚þâÃÆZÇoø(WÅ»M]¤ŠËR¸ø›?†4ýbþ{Y/ñ6·q¦ë:‡‹/ ­â/Ä/;ÖZA´øE¥izgÄ×v½×þ0x?Àÿ/®­®îXjZ½æ©ÿÿ‚€jw:vw¤Éy>Ÿ6³ðà¯/‡¢´×!ÒmSÁÞÖüýû€|+£~Àôßü4Òd][ö¦ý“ÓǾ/¾Ö< à߀ڗþxWöœ¸Ð|g£øÃÄ_µ¯í)û.üCø=ñ#öAøkðwÃ:µžyáIû2xâ^¿à}7á¯Ãm×Ãß ¾ hþ$þÑ>Ч“ãWÂï~Ø¿ ¾'|^ø‰©k?ÿfñ·†~7~Û÷Þ Ñ´¿øoÅþ+ýŽu­ Çþ0øWÿÑø£Å¯ü#Öìg¿Žþ"|}ñ‡þø“À<àÚgÄ> ø’Ûø#ö¸ý”i=SâÇ€<ñËÆÿ~)ø·Zðµ¯Äï„ÖWŸ¿kŸ©½µæ‹û;øöhøƒ¥ø7ãÇìÍûøFÏÅ:d/øâïü5·×t cÄ>(Ö¼{ªéž ñ§Äß}Câ¤øÍªêž ø«to5|#ñŒþ¬ÐxƒÅWÖk©¶ûþÀºU¶› Í¦éZ4Ö“Ž?ô¡á½ZÂèøŠ[¯xWYð^·âŸÙ^M/J¸ø™sy¬øûáô¾ð†þø¯Æ¿ :§‡¿g#Y“E¶Ò?cŸØ£Mµð›|yñ|‰¤XüDø¢xcPñ=†³}ákKT³ð€þX·‹Hð¾§u¾ïÅ¿¦øKð_GÐ.ïôÙ!ñ¿ƒÿaOø¦-Þ×áÏÛ1¡øºËã¿íóñºÞòÎÚ[©l>'ßød\éK"°ñ_†üûT€C¤E¥è:—…--¬¼oð²çá¯xêÃMñ¶¥‰|#ûx/Ä–z´×¿><ëšÊø‚Çâ¯íÃñRÖÿSÔ-|7â}sâ LJ׋.¥»»Ò¯õ¼Cy¬~ßß·f«ª.“{ªüQñ¿ÚWß ¾ø“\Òæ°Õõ ù_Jð çƒüUã_Ù¬ðýž‘{sð»HÒ4_Œ^,“Å>7×¾)ø7Â_gºÒ¼Añ{TÑ®­ÛPý·ÿmËŸìÜø'ῆ®lmføðRæËšqò|¥èÿ |;«hþðGÀ@ Z-Ÿ‡üEeáh,“â÷ÆK_‹?§ñV¦øŸQÿ„{_ý¶üWáÓ£,Ÿ~.ÝÙøq“á/ì#ðU"°›ÂÞÒô;ÂÞ:Ñt? iºG‚¾ éþ1ðg‚>=€³øÄšv¿q5ïÅ&é^»Õ´Qÿæ¿ûrø»D‚iáßÃËXíî!øIÿïøI Í̚NJlµk?xçE´ñN©­x§âF‘âŸxÓöš“ÅGDÔWã©«k?¼oÿ ‡‹ü=ð§ÅúÿÃ9ÛIñÇ{H›WK_ØWö=´K}x'௄ç]FÏã/Æ7Rð´ÑoñÖ¥â_ŠZf¥áßøëá(Œn´‹+ÏŠºÆ©¯|Hµ“EÒ´O„~.ñÀû{©­<“êPÙé°Wì¤ÙxwH¹Ö¼o¨ÜØÛi¾6hÚV‰âm;\ŽÖÜëžÕ¼-¥xKöQUJðö«âëËÝcÆÿ î¾|"Ðü­jßR/xGö3𯈣ðòi¿³çìÙ¢Xx[Y´ø³û_ü]‚MoÄVzõýËáX4è#±ÕþxÇ€Ò<5s¤/üU¿eøCð~Ká§Iy¼ûø#ÄZ»>«â û‹iÿ¿à¡_í5v’+-JãâlþÓõ‹ùídñ“âk¯~× ô{-/K½ø_ooaãï‡SøÀ>+ø¥áÏ|PÕΣáïÙ§Ãzõ¿ˆ¦ÔÿloÚ÷TÕMÔž8ý¦üj'Öƒ~ø¿ÄÚÝÆ›¬ê,¼h,.´ˆ¿¼<ïYiÓá•¥éŸ]Ú÷_øÁàÿü`¾º¶»¹a©j÷š§üþ ©ÜéÚ5Þ“%äú|ÚÏÀO€:¼¾ŠÓ\‡IµOxW[ðöwìjCD³ÐüE§|5´Ó¬~2xòÓâÅ=Gâ7„ü1ñò_x£ö²ñ‡.tµ~Õ_µ$ñxzÊóá×ìÁðÙí´­ká¯Ã§øcÚ֙eðçCÓ¾Þ.¡ðÛá¡tqøÄþ–8åø³ñ‚ÏãÅ›‰a†[øG¼]û|x»Ã¿Ù6ÇVÕ¶“pŸÿàœ_Òx¬$’Â+|Eðõ…»¼;Ð|weeûf€CâÐ|M¢üIº¾Ôþ2|C±ø‘ñIøwâ/x1φüQû_x«B™‡ö[ý`[{y>þÇÞUÓ<ø¾DÒ,~"|FÑ<1¨xžÃY¾ðµ¥Æ‹ªYøÀ€,[Ťx_Sºßwâ߃S|%ø/£èwúløßÁÿ°§‚üS‡okðçá͘Ðü]eñßöùøÝoygm-Ô¶ïü2.t¥‚Xx¯Ã~ ýª@!Ò"ÒôK––Ö^7øYsðÇáWˆ¹ñãÃÆëÅ—RÝÝéWž5ñ¿Åðü+c£és|&Óôë?ˆÞÐ|oñ‡ÂÚÇ ZêM#ávŸzÞ!¼Ö?oïÛ³UÕI½Õ~(øŽ_í+ï„ß|I®isXjú…ü¯¥xóÁþ*ñ¯ìÖx~ÏH½¹ø]¤i/Æ/IâŸëßüá/‹3Ýi^ ø½ªh×Ví¨~Ûÿ¶åÏö‡î|ðßÃW66³| ø)seáM8ù>Òô†>Õ´ø#à -ÏÃþ"²ð´Iñ{ã%¯ÅŸŒÓø«FÓ|O¨ÿÂ=¯þÛ~+ðéÑ–OŒ¿nìü8Éð—öø*‘XMáoézFáohº…4Ý#Á_tÿø3ÁÀ Yü?âM;_¸š÷â÷Æ‹O‹ßt¯ÝêÚ(ÿ„s_ý¹|]¢A4‹ðïáå¬v÷ü$ÿ‚wü$†ææMcÅ6ZµŸ‡¼s¢Úx§TÖ¼Sñ#HñO‰h~Öµo‡©Š<#ûøWÄQøy4ßÙóölÑ,<-¬Ú|Yý¯þ.Á&·â+= Æúþˆeð¬tØêÿ¼ ãÀ Ši¹Òþ*߃²ü!ø?%ðÓ¤¼‡ÆÞýüâ- ÝŸUñýŇŒ´ÿŽßðP¯‹vš»I–¥qñ6 iúÅüö²xƒIñ5׉?kÐ ú=–—¥Þü/··°ñ÷éü àüRðç„>(jçQð÷ìÓá½zßÄSj¶7í{ªj¦êO~Ó~5ëGÁ¿|_âmnãMÖu^4Z?Ä_ˆ^w‡,´ƒið‹JÒôω®í{¯ü`ðþ0_][]Ü°Ôµ{ÍSþ ÿÔîtíïI’ò}>mgà'À^_Ei®C¤Ú§ƒ¼+­ø?û;ö5䯵߇šGü1â¿êŸ¯<©x×ÅÚ>#´øvß´L_à±ÕüSûfþØþ%ÔtmÛà÷ì…ðkMÒí|[àÏjQx;Á“øsIðŸ€æ´ºøuðå@>\±ý¹ÿeŠ1xÇÂ_5ÿÚ#ööÖ|cñ7S7vŸ³#ürøuñGöƒøû}àÛ;éŸöløWû,þÌ×?Â]öS°ñ ‡Š|«ø¿á§ü—Â:%¯Ã C]ø÷ãߌÿŠ,¾5|5ñ_ãŸØóÂÿo>#x§ö³ý¡ÿkŸ²Ãiá¿‚¿ôo€¾5ñWÀ/€ÿ5ÛË¿ê2ÿ‚w~Ä¿³‡Á+¯‡‘üYø/¯ÆÚ‚¾:kÿµw‹ÿhK x—Þ¹ø‡£xÉhŠ¿>Ÿð÷~üÑ>!x_Àz£û>ø[á¿„!ð¿wû5øWHÑþ~ÌÉñ ÄPx‹Pý’ÿaÿø_Àö:_hŠ^,ÕÛVøÃñKÃþ½ñ}ÏŽw¦Éüû x/Å1hvö¿~ÙÅÖ_ÿoŸÖ÷–vÒÝKañ>ÿÃ"çJX ñ‡Šü7à¿Ú¤"-/AÔ¼)imeã…—? ~xƒÇVoµ(¼KáØ»Á~$³Õ¦½øññç\ÖWÄ?nŠ–·úž¡ká¿ëŸn<—7Âm?N³ø¡MáÝÆÿ|- üpÕ®¤Ò>i÷­âÍcöþý»5]Qt›ÝWâˆåþÒ¾øMðGÄšæ—5†¯¨_ÊúW€o<â¯þÍ`‡ìô‹ÛŸ…ÚF‘¢übñdž)ñ¾½ñOÁ¾ø³=Ö•â‹Ú¦unÚ‡í¿ûn\ÿ`x~çÁ? ü5sck7ÀŸ‚—6^Ó“à=/GøcáÝ[Gð‚>RÑlü?â+/ AdŸ¾2ZüYøÍ?Š´m7Äúü#Úÿí·â¿døËñvîÏÃŒŸ a‚©„Þðî—¤iÞñÖ‹¡øSMÒ<ñOñƒ<ñìÕŸÃþ$Óµû‰¯~/|h´ø½ñ7JðíÞ­¢øG5ÿÛ—ÅÚ$H¿þZÇoqÂOø'ÂHnndÖ/×þÎÚOˆ>8ëÚDÚºZþ¿±í¢[èCÁ?|':ê6~4麗…¦‹Žµ/üRÓ5/ø÷Ç_ @4|cu¤Y^|UÖ5M{âE¬š.•¢|#ñw‹þÛÝMiàÄŸR†ÏHý‚¿`=&ËúEεã}FæÆÛHøåñ³FÒ´OiÚäv¶ç\ð­ám+Â_²ˆz¬zW‡µ_^^ë7øWuðÃá‡à=kVøz‘x£Â?±Ÿ…|E‡“MýŸ?fÍÃÂÚͧşÚÿâìhðë~"³Ð¼o¯è†_ Á§AŽ¯ðûÀž<˜¦‘á«!â­ø;/ƒò_ :KÈ|màØÁ"ЭÙõ__ÜXxËOøíÿ ø·i«´‘YjWgðÆŸ¬_Ïk'ˆ4Ÿ]x“ö½¯£Ùiz]ïÂû{{|:ŸÀžñ_Å/xC↮u~Í>×­üE6§ûc~׺¦ªn¤ñÇí7ãQ>´|ðçÅþ&Öî4ÝgPñeãAau£üEø…áàxrËH6Ÿ´­/Løšî׺ÿÆøãõÕµÝË KW¼Õ?à ?ðP NçNÑ®ô™/'ÓæÖ~|ÕåðôVšä:Mªx;º߃ÿ³¿cP %ž‡â-;á­¦cñ“Ç–Ÿ¾)ê?¼'ሒøsŵ—ˆ¼9s¤}«öªý©'‹ÃÖWŸ¿f†Ïm¥k_ ~ ?ÃÖ´Ë/‡:ðîñu†ß £Ãþ'ðü±Ç/ÅŸŒ>,ÜK 2ÜÂ=âïÛãÅÞþɶ:¶¬m´›„ø/ÿâø.“Åa$–Xx{â/‡¬-ÝàñÞƒã»+/Û4¶ƒâmâMÕö§ñ“âĈÚOÿx“ÁŽ|7âÚûÅZÔÌ?²ßìëÛÛÉðçö>ð:®™ãŸ‰>£áË cL±ø‡¯kŸõKI>$üHñ0¿ˆn4f“ã6«ªxƒâ­Ñ¼Ô|=ðÆ>3ø:³Aâ_Y®¦ÚwìûéVÚnƒ6›¥hÓZL>8ü{Ò‡†õk £â)n¼uá]gÁzߊduy4½*ãâeÍæ³ãï‡ÒøÀ>ø[â¿ü"€êžýœtfMÛHýŽb6×ÂlÖõ¿Ù?øƒN´“ãL÷?!ðÅ­®™¤jz'€| ðàF÷WÒ|=/î$ñÞ«ð‚ãáGÃýJ¼Õ­tÛoøöðo‰­-â¶ðG„lbƒÅšÆ¿ø(Æ;}nθ™|{yáØüK¡­µˆtýoÃ^ý«€*E¬iº±5—‹5…7Ÿ ¾ ÃâÍ7Kñüø›Â?±Oƒ¼N–³]ü`ý¢õ}_WÕl¾&þÛíåÔµ? è~%Ö0Ú|]øÔÚ-Þ¥áÍûÄ?¶ÿ‹¼6öò¯ƒ>ÙÇ}{Ã?ø'çÁ8VæoköW×^ñï‡ô_k^,ñÖ‘âïx«öŽ–ï]Ò/ãñ^§­|Kø‘ã/øKþ(é<[â…:oöv³ñÃ]ÒZCeûþÄ–+¨iïáoƒ> }:ö/Ž?ôýOJd‡Jñö©â‰ú.¥§|@ñßÁÐÆž!Ò4ë‹WڧğéÒi:×…> ø»\ø#¤]OmáD•ÞËHÿ‚|þÁ6¶VšαñVöæmãÆJÒüM§ê×Ko‡ú·„ô¯ ~Ë [[g“ÆZŒ,¤ý±€3Ä:/‰´NúëâOÄo‰?þ2?ƒpÖfü#?uÙ¯þ ûQ|—À1Ù|9ñ6ãKß~Þ¿³ÿÃWÅúdš•û*~Î2üyÖµ¿ÛÆ?´EÅ£xhø¤~ÏŸµwÁÝGñÔþ ¾ ¶ÔU~i  Õ~6þÜß³íÇWâgÁ ü[оü9ð׆â¿ìOã_x_^ýŽ´ßé–Wðèwì‹û^øÒÇá¯û^üEµÖ.ü«j/üö·ø•o«kŸ õíáF¥á?‰òø∠X~Ýß³O…¼Eq øß⇿bÍoáo„¦ð–‡¦þÚ¿ þ üø_û&øƒX³MGRñ7Ä‹4íáíoûx|cÓ-¼Wâ?†V¿>'|iмEáï |KñO€ñ ¾‹4ß~ |a´ø»ñ©´[½KÚ7öˆmÿxmíå_|)³Žúö†ðOÏ‚p­ÌÞ0×쯮¼=ãßè"¾Ö¼Yã­#ÅÞ$ñWí-Þ»¤_Çâ½OZø—ñ#Æ_ð—üQÒþx·Äÿ tßìígㆻ¤´†Ëö+ý‰,WPÓßÂß|úuì_~-éúž”É•ãíSÄô]KNø㿃 +Ó¤Òu¯ |ñv¹ðGHºžÛ‰+½–‘ÿùý‚ml­4+câ­íÌ6Ú7Æ/:6•¥ø›OÕ®–"ßõo é^ý—@.xŸXÓ´]Wâ…íÿÄ­{áäÿü;áïjú÷í sÁ²G„õémm4ÏÙãöqÑ,´íjßâgí»ñn=CL²Ö5?Añ–·£\k>¶±Ð!´ŸáßÃïˆ ëÚÖ‘á]CÄÒÂoð^_„¿ -õ!¥gŒ¼û ø#Åßf¹}{Æ÷Wø‹OøÍû~üp´Ô›RÓt­JóÇ“øM5 –ÔxÇIñ-׉k Ö÷ú~}áˆmüGâO‡/àƒóüCðß„þ+¯Û¼9û-øwVÓî­ûX~ÛZ¶¯¬™.Yü_ø›s4/öìþÞ~.ðå×ÚN«l–Ð]§Â?ø'?ÁT½‹RŽîÁ_Ãß|2¶¶Ï'Œ´YIûcf7ˆt_h:õ×ÄŸˆß,~!üdx“Ä?ô¡x«ö¾ñO†ÍºÁû:þËqPÿÂû|:’ßQÑþ$xçLÕ,tÍbÃßõÍ{â–š¯Ä‰>&Ó×µÝMâF©ª|Iñ½á¼ñ¾™ðƒÆ>1øA¦M÷Š/£™m´ïØöÓ­—IšÚÞÚm&m+ã—Ç-*m'VÒ5m'Ä÷W^'ðγáo[ý#ñˆ4ëI>4ÏsñCÄ^ ŸÁßðŠ|)ñgŒ>h/¨è¿ô]I^-3ö2ý‹llìfÿ„¿öñ'›¥Y|Jø¢xwRñ5®³â ZÚéšF§¢xÀ¿4ou}'ÃÒøþâOê¿.>|?Ðô«ÍZ×M¶ñ¿a_øšÒÞ+oxFÆ(,Ót¿Á‰¼#ûø;Äék5ßÆÚ/WÕõ}VËâoí·ñ^Þ]KSð·â]cÄ—:6¾%i$Ôô­gƾ/ø¾gÃ7ZM…ç‚ô» sÆ:Þøs«|Wð¯…þ94æÇáf#]]êÿ·íû«ê7š]åÿÄmeôÍGUø7ðƒÄº¿†îSQ°Õ^{_è>,ñ¯ìÊCÃZ¦‘w{ðƒIÒ(]Yé·¿ðªàŸŸ ~Ûdx‹]ƒÃúßÅ¿ˆúìÕ¦|{Ôþ"~ÔŸ#iš§í„OþVùõ ÏøS?²Ÿíóâ3à_‰|S£éþü7øá¯Ùæúúébñí ûSÚ~ß?eOücý£¯4y¤ñu‹øµ‚Þ ŠëÅvÞø£âÏxãnµàhïü'Åz·À/A¤þË?³e¿…u¿W6ß~"~Ð?¶Gˆõ¦Ó5=kN×ÿjÿÛ_Â7ÿ àœ²xNÖü;icâÏâÿ‰‘EàïiKà¶ý–®n´«þÄà ð'ìõñâ~…á ?ã·í¿ûR|Ñ~=j~$ñÆ™ðCáÿ‡´ŸØ«Ã?5-û[³²ýª¾%xËá¢ÞþÛeX·„|m£xvÿö¾»ÓkŸ?e}< ð×ìUûkðϾ,ñ5¯ÚëƱüY‹WøEñƒöŽ‡]ý ¿j?Ú·ÇžÕìõÝ;^ðÇ/Ú Pø·ñwàü¯àª,¼]¦^xwÆ‘xwÆÐ*j‘?‹ ñàÔlЧÛÄ:/‰´NúëâOÄo‰?þ2?ƒ$øÞðÞxßLøAãü Ó&ŽûÅÑ̶ÚwìûiÖˤÍmom6“6•ñËã–•6“«i¶“â{«¯øgYðη­þÈø‡Äu¤Ÿg¹ø¡â/OàïøE>ø³Æ ´Ôt_€ú.¤¯™û~Ŷ6v3Â_ûNø“ÍÒ¬¾%|@Ñ<;©xš×Yñ†-mtÍ#SÑ<à_‡7º¾“áé|q'Žõ_„ >èzUæ­k¦Ûx¿Àß°¯ƒ|Mio·‚<#c,Óþ5ÿÁ@þ1ÛëvpÝÄËãÛÏÇâ] m¬|C§ë~ð‡í\R-cMÐ5‰¬l¼Y«ü)¼ø]ðNiº_àÄÞýŠ|âtµšïãí«êú¾«eñ7öÛø¯o.¥©øgCñ.±âK _´’jzV³ã_ü_³á›­&ÂóÁz]†¹ão |9Õ¾+øWÂÿšscð³N‘®®õÛ¿öýÕõÍ.òÿâ6²úf£ªüøAâ]_Ãw)¨Øj¯=¯ôx×öe¡á­SH»½øA¤é"ø≠ð§Å}6ëL×>)jšxÔ´?nÛb_+÷>ø+¦Ü¥¯ü)ƒ×:w„të{ËÿÚèþеoøGÂ_@ Ýè~"áå…¿‰þ&üdƒâ§ŒüGâ]#Fñ +áï~Û~-ÑÙRoŒ.¬ôÛßøU?ðOÏ…?m²Ò,to x«KoéºG†þ išÿ‚|ûAV_øÄ6ú,Ó|Eøñ†ÓâïƦÑnõ/hßØ~!ý·ü]á··•|ð¦Î;ëØ~ÿÁ?> ·3xÃ_²¾ºð÷|? xŠûZñgŽ´x“Å_´p·zî‘Šõ=kâ_ÄÂ_ñGKøqâßü)Ó³µŸŽî’Ò/دö$±]CO |ðcé×±|qø·§êzS$:WµO|OÑu-;âŽþ€4ñ‘§[üZ¾Õ>$ø¯N“IÖ¼)ðgÅÚçÁ"ê{o $®öZGüçö µ²´Ð®uŠ··0Ûhß¾4èÚV—âm?VºX‹|?Õ¼'¥xcö]¹â}cNÑu_Š·ÿµï‡“ü?ð «ëß´H5ÏþÉ×¥µ´Ó?gÙÇD²Óµ«‰Ÿ¶ïŸõ 2ËXÖtýÆZÞq¬øZÚÇ@†Ò‡¾ €O¯kZG…uIÿ ½ÿÁy~ü$·Ô„:•œ>2ðOì'à}šåõïÝ\Oâ-?ã7íûñÂÓRmKMÒµ+ÏOá4Ô&[Qã'Ä·^%ý¬@+[ßéú=÷†!·ñ‰>¿€>ÏñÃ~ø®¿nðçì·áÝ[N7º·íaûmjÚ¾²dñ·í/â¨þðGŠüG=ä¬~'¼’(æ‹â?į€[Ò®ôˆn~iº^¹ã{gÿ„WÄŸüàßp]A«JÖÖWqꟷçü þäxjïFÓ£ŸOš/‚ÿµy<)jpiÒ&…á-o¿؟²?†u ÄV­´ÏüJøƒcãÍ_ÄŸ|-áOÙ?‡¼YûRø“N½»µoíEt¶Ö·>ý¼»O×~xižÐ/t«‡º“á=D§Ã_†oMÕ6ëìëû-ÄuCÿì}ðêK}GGø‘ã3T±Ó5‹|C×5ïˆrZj¿>$ø˜O^×ti4o‰¦©ñ'Æ÷†óÆúgÂøÇá™4wÞ(¾Že¶Ó¿`ØN¶]&kk{i´™´¯Ž_´©´[HÕ´ŸÝ]xŸÃ:φu½oö@Ä> Ó­$øÓ=ÏÅx2Â)ð§Åž0øM ¾£¢üÑu%x´ÏØËö-±³±›þÿÚwÄžn•eñ+â‰áÝKÄֺψ|1kk¦iž‰àü8ѽÕôŸKãû‰µÙñ+ö”ñ…¤Öõ |OñKÛcÁ?²ŸÁ«txÏâUÔCR_ê^.¶ðuõÕŒz¯Â¿Úå{O§‰4ßj“|i×¾#iÿ~,ËàïxŸÀ>·Ñ|Gû]ø¯Ãw—/iû<~ËñO®\Eðãö@økye®ÿÂÈñŒš¥¾½á­ƺƩñK]KâÄŸX¸ñ £xƒTÕ~3j7†ëâªüñŸŒ~øyl¯¼Uâ&Óm´¯ØöÓ›S´›FÒ´Ù´¥|{øâ&7V·†¼uu/ˆ¼¬ø[Å:ßì€_Ä!’ÏNø¡s?ÆŸøC§ðgˆ´/„Þ0ñgŸ .¥¢üÑu°³°ý‹c-2'—þOÚwÅÞ‡tOˆ¬ô¯ë6¾&Ô´Û[_ hšž‘ào|8Õ×5Ét ~-\ÜüZÓ¾Kð£NðÞ™¬ë:g†íè>eÖ¹ûsþßú­Þ»áËwâ~©q¢^ê_>ê§î­¯ôÜ]Åá¹|=ã~Í ü?ª‹íCáö£xëÄ&›Ä~Ö~-xÁß4G±ñÅû.)¿nÛbH$ðÝφþè÷°hòüø/ý›ðî;IáѬ,´ '\ðÿ†ü'ð$ êÄËð£O³øâ/ŒÑüWÿ„ÏÄ~ÑuÝ×Þ#ýµ¼c¤G¨ ¯,–î†ðOφP궭àÿ ØhfÃÅV§Ãí'FOG¯øÀÀ#Ó¼KeâXü5ÏÆ {ã‡ÅÿˆÖ>¥á¯ÛøÄ_·'Šü2×sÜø/á=²ëÌ? `ƒð¾ªuýQ.um7Çš­Æ£©üBñ¦‰âícÅŸ´xˆ¦½†=K[øׯxÈø³ãPømâï|'ðÜ6¹ñÇÅZDð3ö3ýŠífñ#Á?| >‹{ÇŸŠÓë2Ÿ²xcâf­âˆÞŸOñÿ~€߉N·ñÞ­ñžM*m'ÇšÁ_ø‹à·‡$»‘í,tØö±†[ëω]YéšOƯVÚSë–º¥¾­6ÿ µ ÚøcöZ5~ßÿ¬5›­CLŠKïÙxWþ m¢øÏHñ:x‡ö³ŽëR¼Ðõ]FÞ×â5¿Ãy<ð‹þ7‡|5ñcK‹VðÇìÁá½RQâÚÛöÏÖ5/ÚÍãÿÚ3Æ“YëZ—ßk^!ÑNŸ=Šîoi!ø…ãýkmAàºðv›¥øãS³#á­ÇÆ/x3ãv˜cÕâ²´°µPý¾?à¡z„º‡„îí!·»Ò>| ºo‡×š†“!¼Ò¼;®xCPÒ?d ^ÔOˆ&øMi¢ü@ñ'l~ é&ø…á øûCM#Å¿µ‰´ûŠ_Ú§ö ¾ŒiÓø#öJð=­Æ/ÃφÖ~ð½•Û]x GÓl.Jü;øt ‡¬Ãâ+á‹EñCÄôÿŒ^ ×e°+¢ÛxÆ·§Œ<9wªÜßëpy7z„¿àœŸ£ÕQÓ!·†êË↯t x5ïè4ЛöÄ«iâTñ&›áÍRo:÷Äm?â/Å™|âOøÃvú/ˆÿk¿ønòåí?gÙ~)õˈ¾~È o,µßøY1‚óT·×¼5¡ø×XÕ>#Ék©|Aø“â@ !‘´ojš¯ÆmFðÝ|U_ƒ¾3ñÂ?-•÷Š¼AÚm¶•ûþÀ:sjv“hÚV›6‚4¯DÆêÃVð׎®¥ñ‚õŸ x§[ý+øƒÄ2Yéß.gøÓÿtþ ñ…ð›Æ,øSáEÔ´_€ú.¢öv±oìe¦DòÿÂIûNø»Ïðî‰ñâUž•âf×ÄÚ–›kkáSÒ< à‡ºæ¹./Å«›Ÿ‹Zw‰~iÞÓ5gLðݧŠü ûøÅv—Qé¾ð›ω-¾3ÿÁB>3Ûx’Þ+«¨­üg‡cñ§„#Â:ý–¿àß~Õ`ßësèW¾0³µø•að§TøWðÖËÅÖZ4»_x/ö(ð‰íç¼½øÓûDj7ž&¼²ø¯ûg|Q²›Ä·‡ôÝ_Ä·ðè6÷W“Ii¬hÚ·‹ücñ€Æ›}=†¥a¦i¾<›@¸ðÏÁø¾,øSôðúgÂ=̳º×?nÛÿU»×|9q®üOÕ.4KÝKàçÂ]CTð=Õµþâ{‹¸¼7/‡¼oã¯Ù´ãéÿb?ÙÆ>*Ò5o ø2? üNø·àÏ|U¶ñ¯ƒm|Qû'þÓŸd×<^%G£øóÁ?³ôÞ(ø{£øƒÆöÞÕõO Gão øS@ø Éx{àí;¤„ö_³ü‡âWÆ-'â’Ý·¾~Û<ûBøgö¢³ð6ƒ¨iZ—Å¿xÇá׈?fÏگß²7MLJ.|7âÿŽÿ´ŸÇÕñhÖ7ÞøÅâ?ˆ ´ß‹ 7?n›=KÂÅ4¿€_¶Ãω¿2>uá}ZçáÏÄ x§ãO€¾-ø£K}k¯ø)Oìke¦xÃPøûsxCö{ñ‘$Z'Ž4/x_Ä?²GŇÿ´M~ãÁ©û(þÅ?¿i3à·Æ­65ñ7†›Âÿ¿jÍCá­ž“6·£ø‚'Sð©àØ<9û,€}QÄx‡Âž4ø‰á_Ú'Ãzoìt?‡:WÄ_‚Vãÿ†_³ÇÁÿˆzU¥ç~ þÉW>ºñ>•ñ—öÆøé ø—î~ x~ÓÆñìñŸ€æðï‚®të߇^ñàcâ½yü+ñîþ)é_gøKá ;RºŠ}"ÃÆý†|ã'–é5ÜgÄ6¿oÿŽVÍÖ¡¦E%÷Œì¼+ÿ ‰¶Ñ|g¤x"ðŸ‹>|žø‹ÈÕbÖ¤Ó¼?ñÄÙäʼ?ÿ#ý’|Dt¡ðƒã×ÄßÚ³HÒ<;uãû+?ƒÿ³ŸÇïÚæxÜ^Üi·Ÿµ?íËâ¿Ù;á§t hÞ»Ó´ gÁß²„CÀ7øo¡k uÏü>ðU¦¯ð¯IøJï~Û2x÷[øoá‚¿¿oÛBOøÆ¿.-5/ÙëMý”§ý®|o…¯Aðûö[ø£âÛ¯þ<×á/×ÿiŸ³À#öÀ¿ðvµ«éš§Â߃:Ÿì£ñ þ âïþÊ¿ ­Ÿþ¸l#ø}ÿ wâ_üEªøÛö®—\Ö¤Ó¿k ö>'ÿ‚ŒüDÑ|SuâO‹Ÿ²WÁmo^øÙoð¾ËÇ¿l¾5þڴljôÿisZ~È¿²¿„n¦ÿ‚s]|ø'ðÏG𶿥|rñÞñâWöíëøÿž#øÍðƆ?üE¦ië?¿k-[^ñGˆ~*ÁMäø{¢øGUðßÀ=jßþ õû(ü:øo¥ØøË[𽧆õoØ£öYºý¢µŸÚëÄ^'ø¥xÏMÑ5†ø•ð·NøGªø R,ðÇÅ™ü}uáÝÃÿ±ð/þÉ:eΉãñ×öóý²øÄÏ¿àŸðO»]{ã»ãÙÓö<ðß‹|-àM_ˆž0ø¡û5| øóuû/xÄÓYêø—ãÇÄ¿Ù|Cñ?ígÿøöoâ#­øÿÅŸ/ôÝcTÒµ«Ûoˆ âTñoíhö…Ö¥y¡êº½¯Äk†òxáü,oøkâÆ—­áÙƒÃz¤¢ÿÄ?µ·íŸ¬j^'µ›Çÿ´g&³Öµ/‡>Ö¼C¢>{ÜÞ,ÒCñ Çú ÖÚƒÁuàí7KñƧfGÃ[Œ^ ðgÆí0Ç«Åeiak¡û|ÁBõ u ÝÚCow¤*|øtß®-5 &Cy¥xw\ð†¡¤~È@¼?¨ŸMðšÓEøâOØüAÒ/éÿ¼A®Ë`WE¶ðÿŒÿoOxrïU¹¿ÖàònõþÁ9>Gª>£¦Co Õ—Ä ^èðkÞ1ÐÞYk¿ð²ñN·û Wñˆd³Ó¾(\Ïñ§þéüâ- á7Œ9iáôÏ„z™gu®~Üÿ·þ«w®ørã]øŸª\h—º—ÁÏ„º†©à{«kýÄ÷qxn_xßÇ_³hê¢ûPø}£hÞ:ñ‰¦ñƒµŸ‹^ðwÅì|CñFþÃËŠoÛƒöØ’ <7sῃú=ì<¿¾ ÿfü;ŽÒxtk -I× øOlºÆ³ÂßØàü/ªTK[Mñæ‡kq¨ê¼i¢x»XñgíAâ)¯aRÖþ5ëÞ2>,øÔ>x»ÄŸ ü7®|qñV‘<LýŒÿb»Y¼AðOÁO¢ÞÃñçâ´ú̧ìžø™«xƒâ7„§Óüãß„`·âFÓ­ücw«|g“J›IñæƒðWÅþ"ø-áɇ„nä{K#öýƒ¬a–ÆúóâD—Vzf“ñ«ãU¶”ú宩o«A ¿ÃmcÂv¾ý–€ë“hkñfëPøÉÑðöOø\Õ>øF sß²g‚|AY迳wìá£Ø¶¶~$~ÜßàÖt;Zñ=¦“âËÝ.ÿÅ ·ÒüÐMðûÀ>9Ññ^¼þ¿øˆ÷ô¯ƒ³ü%ð†©]E>‘aã~Ã>ñ“ËtšÇŠîN³â_·ÿÇ+ fëPÓ"’ûÆv^ÿ„‚ÄÛh¾3ÒÐÓHñoíGâm>Å¢—ö©ý¨/£tþý’¼kq£Kðóᵟ‡¼/ev×^ÑôÛ ’¿þ(¡ë0ø£JøbÑ|PñÅý?ãˆ5Ùl è¶ÞñŸíéã]ê·7úÜMÞ¡Â/ø''ÁèõGÔtÈmẲøƒá«ÝÞ {Æ:4&ý±*Úx•øQu-à>‹¨½…‡ì[ûi‘<¿ð’~Ó¾.óü;¢|@ø•g¥x‡Yµñ6¥¦ÚÚøcDÔôxáÀ®¹®K KñjæçâÖð¢_…w†ôÍgYÓ<7iâ¿~Ãþñ]¥Ôzo€ü¦ÇsâKoŒÿðPŒöÞ$·Šêê+ÇáØüiáãðŽ¿e¯ø7ÁßµX7úÜúïŒ,í~%X|)Õ>ü5²ñu–ŸãÍ.×Åž ýŠ<#â{yï/~4þÑ牯,¾+þÙßl¦ñ­áý7Wñ-ü: ½ÕäÒZk6­âÿü`±¦ßOa©Xišo&Ð.<3ð~/‹>ðÇÇ-<>™ðAó,îµÏÛŸöÿÕnõß\k¿õK÷Rø9ð—PÕ<um xžâî/ Ëáïøëöm¯áýT_j´mÇ^ ñ4Þ#ðv³ñkÀ¾ø±¢=ˆ~(ßØyqMûp~ÛA'†î|7ðG½ƒG—à×Áì߇qÚOae i:ç‡ü7á? §Ÿ õa¯|,øi®Y|SÏÃÿêÃâv›¥ÙhšwÄa¨øwM¼<°ÑtÇ“NÒ,¼_çÂAk¥éò=•„ŠZZ»Al@>Sý§ã’ÛâOb¹“Cд/XXx#RÒ<3oouñÓö¡Õìdñv³á¿ÙÏÃÚƒF’xáF†.u¿ü\ñ”ó˜Ãw·6×:Ÿ„<3ŒµÙ>u‡U‘l4-_Sø£á™Þ?ˆð[Æž4øO¡-œº†µ¨¶Úgìûi¬lg±Ò´»¿ [èß~3†ÓÂ~#¹›Uð¶·á_]~È ’j÷V—¬Þ\üLð€åø}ãè>x×ÅŸ |6úΑû8ø{To Ú鿱Gìu¤[h©'‹þ<øów…ôOˆß,t‹ífÇÄú…Å¥…lõMÀ~øtW½—ÃÚOŽä¸ñÿÃÿ…õ]6×V¼Ò´;Oø7öð7‹í ŠÇÂ>¶Š rßãüãVŸâÅh®á³ñ,~¼ñí²èzÞŸâxkö®n·{¡Oñ*ÒÏÆ ~êŸ l4¿iö^.±·ñ?„bø²×Ä׺íñ¦öòy¬¾(þÙßì¯x¿Ä´9~Áðùîo4-?Aý€¿aÛ4Í6ö÷ź¥Æ™£h¿þ.ÛXéÚÆ•{§ø™mì|«ø^ËBý™À6¡qáôñºŸÄ‡ÿ ›áw‰¼=à}sQð/…SÄý| âk}+LÐ?fÿÙãM³Ñõøûd|^µÖ4'_ñŽ­ßèw/Ó-ôß]ZÜ|:øñÞ*Ôfð”?o|=ø;/ÂEÑ|AqÞŸcâÿþÃ>ñµ¶§w/ŒüE8>'Óþ1ÿÁB¾7Zx‹Q¾·³{ÿØhsx«G–ñÖ“â?íßÚ˜Þ¹=xÒÆü;øm'€¼;Åo x_âž5Ÿ ~Ì^ÔoõmWĶ‡íg­êW¶mãŸÚ#Æ·PkšßÃÏk^!ÒÎûN¿¼¹Õg’ßâGÄoY¿i£Ô®ôí]ðª=ÏÃôøÏàün³kkËø´Ë½6=Cööý½oÞ ïM²Ò§ðý«ü ø5rž »´‹ÃÒ[^Xø3[ð¥î‰û&€PÓæÍá ĺGÄ];âÄxWÇÚ9Ò|Wû]ø«KÒ4njÚ¦öÚO‡¿³GÃû#¡§ƒþ[h:]† ·Ñ4í8È>|2  7°ø´xhÖ.þ(h4ÿ‰> Ö¼â¯xAM3Å_µ×Œ|9¨ø¬Ù~̳•¼¯4ÿdo†°x†Oxö=CQ¶Ö¼3£kÞ±ã%²Ô¾"üMñøuYÃBÕõ?Š>ãøˆß¼iãO„úÙ˨kQj‹m¦~À?°všÆÆ{+K»ðÕ¾ñ÷ã>ë+ˆm<'â;™µ_ k~ñ5×슙&¯q¥izÍåÏÄÏø_‡Þ>ƒá|Yð·Ão¬é³‡µFð®›û~ÇZE¶Š’x¿ãÏ7x_DøñÇH¾Öl|O¨\ZXøVÏTѼà‡@õ{Ù|=¤øîKü?øQqðUÓmukÍ+C´ñ/ƒa_x¾Ú¬|#à‹h ×-þ1ÿÁ@þ5iþ,VŠî?ÇáÛÏØÛ.‡­éþ!ð‡†¿jàëw÷ºÿ­,üað×á^©ð¦ÃKñæŸeâëøGö'ð_‹-|M{¨þÑoo'šËâíñ^Êóĺ¾›áýWÄ6ú 7ö’ÍyªèÚÇŒ|]ñ„û4ÖÓx‹KÒüEàÍçDðeÆø?ã5‹.‹ðÏEVšÿUý¼ÿo=VþoÞj~<Ôï<;u©|$øI¨ÝxZÿO¿ð±»»>¹ðçüoû2€T±žMKTÓtm^ðÿ‹çñWÛO‹ÞðoŽ:]7^øŪh׆ۃöÕžßHÑ®|1ð÷ÂW¶:ü)Ï„+aá`E‚[Yi:&¹ xkÀᩓŭá _ißmþ2xWSÖ4-'\Ñ­ü7â¯Û«ÅúP[ê_þ+Ío¦ÝCðÃöø[³lº‡,tCLñŽ“®èÚf‡mã‹øÀ´-/XƒÅÀrÞ|DðïÆKŒŸð—øjöÿBÒaеïÛ›Æ>¶ñ=ÍÇÂÿ‡Q×!økû|#†çZžç^ºæŸãm8XÏ©xŸÅº'Šµ¯þÑtnâõôc^ø±¥x®oxßZøUã/ü(ðòi#øÑâí*ãQŸMýˆc.¯¬„¾ø}ñ>.ü_—_LÅáj^"ñ¿„o4߈~=ø4ÕåÑÖÞëTø›àm¼=ñNÓà‡‹üGð{C—ìžæóBÓôØ ö°ƒLÓoo|[ª\iš6‹ñßâíµŽ¬iWº‰–ÞÇÀZ¿…ì´/Ùœ³jOK©üHøð¹¾x›ÃÞ×5øUMø³û þÃ:§ˆ¿h|Dý˜ÿ`Ÿ xæÆßFÕþ(ø«Ç_³ÀÿŠ—²ßÃÏÈúìÞ+øµâ}gÁÞ4›öÿ‚üošñ5Ø4ïk^;ÓtMSXðÅüQøêÃV¶ñíBËkðNÿÙßÂ’|Gð¯„üyñ“öwðß„<7£|Mð7Áý?öìý¼þüý‰¾Ù_êúŒ¿µÅ_ xö¡ðG‚|ñ+VK}Y¾üøv~ø+ÃZ^ƒkfš&…ã_xP¢×¿d{k¾ø?ÿ ý©>xr÷Â^øçð“á§ÅùfŸ‹z熴Ÿ Ùæø«öÕý¸þ)þÕ¿²ïÆ_ç‡üGâ .ßÆ ~|aø©x×@Ô¼-oáßj¿¼?૆²`y?fþ3žâÇßðS¯ÚÃÅZwÇÏ ÙüQø]áO|0ÿ‚}éÞ*ø߯è6º\º‡íñÎ÷Tÿ‚|ßKàÏÙOÂ:]ׇ´Ÿ ø Çú‹/ol ðž‘áÛ‹Yü à+Ð ÷? ?l;û Aðöüø]ûAØü}ŽÎóC׿kÙAñ×ÄOÛgÅ^𖳧øëGÒWögø±û!øáüGÁM¢xÓÃk«xoÅšÅÏŠ|AãVü_ø_ñoá/†¾-€Pmöûñ=”šÎûs~Äž3Ó~,ø¶oxoÅžý€~2Íâ¿Ú3Ä>×ü]-çì­ð¶?à¡š €dÙ~Ïü9k¦jšŸü{öˆðßü)Ï_|ø›¯|?øIûjžø]¥x–çN‹Aý’?f]+@ÿ‚~éˆÿiz=_Á>ñ‡~Úxj+i:]µ÷ëÝ{MѼá k±à»ð‰4?·Gí'­j?³ÿ‹loãñ¶ñ‰ÿg[OØ7Áž6¶X`ð‡×þ ÕáŸÙ?Aý¥ÿnÏÚW‹lãµ´ñφþ(i¾¼ñ~˜ºg‡oãñn‘¡þØ üSû|²“ã=„i?„ú—‚¦Ñ~*‹?ÁIà£:Ÿ…b ø–ßÆW÷ß´ÄÝJÚÖ+þ×?lµ¯êÖ~ÓüGeá½*ÞóIkøµ½x·âÀØÿ‚pÿÁ=l/µk}ö,ÿ‚~xTð—Â(¼YðûÃ?ÿdß‚1iß ~]Úê‰âÛöçÖï|áÍFçQ×¢±×_áwÀ;»Ï [Û¾¨B×Ãí¤xÿƳHѾü3øGáŸ|ýžü)ð‹Â?›á¼ßþ | »ø}¡ü/Ðþ j+¯húƹûo~×ðg…ü!¤xáÞ‹â™­µ¯…Ÿ4ÝÁË}ªµåÄzN“â}3AÐ~z†¦O·„,m|e§|i·øÉá]OXдsF·ðߊ¿n¯èqAo©|[ø¯5¾›uÃØGál:Ͳè^±Ò5 3Æ:N»£iš·Ž-üCàþÐ`´½bËyñÿ,>2Â_á«Ûý I‡B׿noøfÛÄ÷7 þD\‡á¯ì ðŽj{x^ëš´ác>¥âèž*Ö¼CûDYÒ5»‹×Ðu{âÆ•â¹¼Iã}káWŒ¼[ð£ÃɤxãG‹´«F}7ö!ýŒ º¾°ø;àiôKÄø»ñ~]}3„{›Í OÐ`/Øv 3M½½ñn©q¦hÚ/Ç‹¶Ö:v±¥^éþ&[{jþ²Ð¿fpͨ\x}3ø#Á¿¬ÚÚòþ-2ïMPý½¿o[÷ƒA»Ól´©ü?jÿ¾ \§ƒ.í"ðô–×–> Öü){¢~É 4ùŸÄsxBÇFñ.‘ñNø£àcñÁžñöŽtŸþ×~*ÒôŸÚ£ö©½‡D¶“áïìÑðþÈèiàÿ‡–Ú—a¨-LJ´M;N2†ß ¨Åì>-šé´ÿZF»¥ÍÆ“máßþß~0ðî—qq0ŽuÈþÿÁ<~G®]ÞİêÙxÕu],ÚÞxÏ@ñžû]€gišéñ ‚5‹¿ŠÄM?âOˆ5¯x«ÅžÐSLñWíuãj>+6_³ìåo+ÍÿÙá…ì!“Å^=PÔmµ¯ èÚÆ·¬xÉlµ/ˆ¿|F~VE°Ðµ}Oâ†gxþ"7ÁoxÓá>„¶rêÔZ¢ÛiŸ°ì¦±±žÇJÒîü5o£|}øϺÊâO øŽæmWÂÚß…|Muû"€fI«ÜiZ^³ysñ3À>—á÷ øEã_|-ðÛë:GìãáíQ¼'k¦þű֑m¢¤ž/øóãÍÞÑ>#|D±Ò/µ›ê–>³Õ4oøáÐý^ö_i>;’ãÇÿþ\|ÕtÛ]ZóJÐíj7^¿Óïü,nîχ.|9ãþÌ ,g“RÕ4ÝC×¼?âùüUðæÓâ÷€<ñoN—M×¾1jš5džaŸöàýµg·Ò4kŸ |=ð•íŽ‡ÿ sá ØxX`–ÖZN‰®hðßÀ xjdñkxBÆ×ÆZwÆ›ŒžÔõ I×4k ø«öêñ~‡ú—Å¿Šó[é·Pü0ý„~ìÛ.…áË#PÓðíKKÖ ñAð·Ÿ<;ñ’Ãã'ü%þ½¿Ð´˜t-{öæñ†m¼Osqð¿áÔA5È~þÀŸá¹Ö§¹×…øÛN3ê^'ñn‰â­kÄ?´@#[¸½}X×¾,i^+›Äž7Ö¾xËÅ¿ <<šGˆþ4x»J¸ÔgÓbØ «ëá/ƒ¾ŸD¼O‹¿å×Ó1xCÄÚ—ˆ¼oáÍ7â~ @uytu·ºÕ>&ø@o|S´ø!âÿüÐåûÃ繼дýöý‡l Ó4ÛÛßê—f¢üwø»mc§kUîŸâe·±ð¯á{- öglڅLJÓÄRê>ü.o…Þ&ð÷õÍGÀ¾OxWö5ð/‰­ô­3@ý›ÿg6ÏGÔâwí‘ñz×XÒ4ÄV:6·¡Üx¿L·Ó|ukqðëáÿÄ x«Q›ÂPüHy¼qð÷àì¿ EñÄWz}‹ü?û øÆÖÚܾ3ñàøŸOøÇÿ øÝiâ-FúÞÍïüWa¡Íâ­XWÇZOˆÿ·j` zä÷º©ãK?|á_hçIñ_íwâ­/HÐ!¹ýª?j›ØtKi>þÍ쎆žøym év‚Üx{DÓ´ã ømðÊ€,XÞÃâÑà  ñÞ‘ñ«OøÕ¤k°Z\Üi6Þñ_í÷ãéw÷á‡\á?üÇáDzåÝìK :­—WUÒÍ­çŒôè×ÿµØv™®ŸØø#X»ø¡¡üDÓþ$øƒZðŠ¼Yà4Ï~×^1ðæ£â³eû0~ÎVò¼Ñü;ý‘¾^ÁâèKg.¡­Eª-¶™ûþÁÚkìt­.ïÃVú7Çߌû¬®!´ðŸˆîfÕ|-­øWÄ×_²(dš½Æ•¥ë7—?<à9~xú„^5ñgÂß ¾³¤~Î>ÕÂvºoìQûiÚ*Iâÿ><Ýá}â7ÄK"ûY±ñ>¡qicá[=SFð€>_Õïeðö“ã¹.<ðÿáEÇÁýWMµÕ¯4­Óľ ý…| âûh"±ð‚-¢ƒ\·øÇÿøÕ§ø±Z+¸lüK‡o<{clº·§ø‡Âý«€­ßÞèSüJ´³ñ‡Ã_…z§Â› /Çš}—‹¬müOáØŸÁ~,µñ5î£ûD|i½¼žk/Š?¶wÅ{+Ïêúo‡õ_\Ûè0ßÚK5æ«£k1ñwÆ ìÓ[Mâ-/Kñƒ4KÁ–?üàÿŒÖ,º/Ã=ZkýWöóý¼õ[ù¼;y©øóS¼ðíÖ¥ð“á&£uáký>ÿÂÆîìørçÞ7ñ¿ìÊRÆy5-SMÑ´={Ãþ/ŸÅ_m>/xÁ¿ôétÝ{ã©£\xfÿnÛV{}#F¹ðÇÃß ^Øèð§>­‡… me¤èšæᯠü w†¦O·„,m|e§|i·øÉá]OXдsF·ðߊ¿n¯èqAo©|[ø¯5¾›uÃØGál:Ͳè^±Ò5 3Æ:N»£iš·Ž-üCàþÐ`§ÿ µ+gá¿Ãí^ïÅžñåÖ«à jW>9ø}l–~ñÅöƒau7‹<i·âXí|!â)%mcÃVÑøÄ yeëzª¨¿œøðR/x—Dñ>‘¬Øx?Y’ÒxëÄöþ“UñÞµðŒM©êú¯Ãox®]vÉ>¯‹¼I>‘?ŒüU¢èú®·¬èLZm§öWˆ´ïxËÁ@bŸ²Þ±g™&…ã¿xWUð潇|}áo„fgðcösóìàÔþ ü ÑÓÅsYü;ñ_Š´/LÒ¼_ñ…ψ5VT–]?Â:6•¤xBð öT¼Ò¬î!ðw‹üà» ëŸgø4ƒÚTÚ7ìùà=itØ> ·ƒ4 ÿÜÙk?|so?ŒÞïã‰^þ++ߦÿ‡zŽŒ|i¡øü¿ý•om¬õ»_x¿Á^Mî=cö~±Ô>[ø¯Cø;ãUngñßÆiš—`ŸâïÇŸjš×Šu+O‰^$Ô´”Ð¥Õ÷7‡u{ÍWâ%÷Ä@ îeU·“ĉ x‹Áéq}›Æ¿tO|.ÅZu—í˨ϩþÑž/h:—ÇO¶¥ÿõï‡,åÔ<iáGЖæÆâã\‡ÂÚï„'쩾£iuâ ø‹ÃÚ–™‰õÝÆ_ l5·ø¥ûCÙ›oì¿_o´ïhâf™á‘¢ø[þß…zMŸ<9ác¢[ ?R0è aør§ì¢/'…%xêÞÃ[ñuÏü'ÿ´¶%·Å0µ/ÙFá?á"ÂÞ*ðFe¦Ieâ¿‚zf¿ð™%ÿXê?¾1kΠuMĺƣáOøFç€]˜u}zóSׯ€.ßþÊè×:²i¾$ð¬úÙáñž‹¢xÇ᥿Š×Ä_´œ7O{mûA|t¾µñW‡.~/ê>¹Ó¼'?‚<§‡Z?ƒfÐÌšeû¶—ðÐü1†ÙB-Fâkoø§Ã~2ð߈Oí+q{ð×N²Õh­wO²µ´ð®ƒ­ßÿÂC{…>x`ÜxŽH~iÖœÄz•ž·ã[ëK߉1|Oj~˺֩&‰uãOˆ~ñ«â MKCøÿ­Ø|0¶Ð5oŠ_RßQ>ø%à›ÑâýROƒŸ¼?¨ês]j~ ±>0Ö|[ÎÚ¿Œ^ñŒüGâ€Óö\ÖcƒD–ãâ†ìõä»»ð—ˆ5ï |+³ðŒúOìéÖ¡q þÏ­í<[v¿|6 ƒÂŒÎ OàßÀÝ&iž/…¿á øW¤ÙøÞ:%°Óõ#ðÖ‡ Ú~Ê"òxSÇ.ðÿŽôßxnÚOÑê¿ 4»m[öŠø•£ÿfEáM_â­»$Ið°ëú'Àm7L‹C0jVún¥â{ÿE­è^$u§ì·©j-§Éãÿè>0ŸÅÚUÆûHß[|3³Ð5/Žzm¤W á†v—§Å:»ü;ýžü(ú¿ˆTü"¶O^xžÏPž'ñÞ¦uωóüL‚ËöYÖ¦}ûÄŸ¼7{¯ê ¬ø[⟈<1ð²ÛÁÚž¿ðEŽ­?…?gÏ…0xÇU»ø!ðÃG»›Ao&™uâßø¾-æçþ Ä:•·ˆ´p í¿eýjÙôëÛ/øgÃÚ͆«uá]7Tð_‹ ?ÿ٨\+Züø ŸŠç_„Rj¶ºG„áñ×Ä»Gñ½â+2öóÃúW‚—Ã~€V‹öUÔtï³Íá¯ø#Á÷¾ñ4ZwÁ‰<3ðcF³Óþ|¾þ̳ñ~è×>(½Ó´Š>:Ñ­õ{ümÔ¢ÕwÏ­0·øw…c‡Y¿e{Û½ ñƒ<ÿ¶£m'ìùmÂ;{Løš½¸ƒâWŽ­ì5¿\ÿÂû@x÷ûcÆìßüWpÖúXñ {àOý³â[|S‹Rý”nþ(ü-â¯höZd–^+ø'¦kÿ “ÆZ€¾7Ïý¡wâŸÚ#âQ¿ñÅŽ£ñË㱬êTÑüK¬j>ÿ„nxÙ‡Wׯ5=zøíÿì®s«&›âO Ï¡ýžèº'Œ~[ø­|EûIÃt÷¶ß´ÇKë_xrçâþ£áû;Âsø#Ázpøu£ø6m ɦ_»i Ãgý”"Ôn&¶ñŠ|7ã/ øƒÃñê4¿|3Óu=Oã·Æ½>M5|3ñ ã&±k¯éÖþ&ðƒl´»kO |Ò4o økG‰-l Ö¿áÑ|9 è OÙZ}\iñxÿƺŽ¢ñnƒäþÒ·¿ të-WöŠ×tû+[O è:Ýÿü$7°xSà'† Ljä‡àfa©Á¬G©YÙë~5¾´½ø“Äð§ì»­j’h—^4ø‡áÿê¾ ´Ô´?ú݇à mVø¥ðõ-õá_‚^ ½/Õ$ø9ð;ÃúŽ§5Ö§à«ã gÅ°,í«øÁuïxÏÄ~(-?eÍf84In> xnÏ^K»¿ xƒ^ð—»?ϤþÎ]jìñð:ÞÓÅ·kðGÃb ·ƒ4 ÿÜÙk?|so?ŒÞïã‰^þ++ߦÿ‡zŽŒ|i¡øü¿ý•om¬õ»_x¿Á^Mî=cö~±Ô>[ø¯Cø;ãUngñßÆiš—`ŸâïÇŸjš×Šu+O‰^$Ô´”Ð¥Õ÷7‡u{ÍWâ%÷Ä@ îeU·“ĉ x‹Áéq}›Æ¿tO|.ÅZu—í˨ϩþÑž/h:—ÇO¶¥ÿõï‡,åÔ<iáGЖæÆâã\‡ÂÚï„'쩾£iuâ ø‹ÃÚ–™‰õÝÆ_ l5·ø¥ûCÙ›oì¿_o´ïhâf™á‘¢ø[þß…zMŸ<9ác¢[ ?R0è aør§ì¢/'…%xêÞÃ[ñuÏü'ÿ´¶%·Å0µ/ÙFá?á"ÂÞ*ðFe¦Ieâ¿‚zf¿ð™%ÿXê?¾1kΠuMĺƣáOøFç€]˜u}zóSׯ€.ßþÊè×:²i¾$ð¬úÙáñž‹¢xÇ᥿Š×Ä_´œ7O{mûA|t¾µñW‡.~/ê>¹Ó¼'?‚<§‡Z?ƒfÐÌšeû¶—ðÐü1†ÙB-Fâkoø§Ã~2ð߈Oí+q{ð×N²Õh­wO²µ´ð®ƒ­ßÿÂC{…>x`ÜxŽH~iÖœÄz•ž·ã[ëK߉1|Oj~˺֩&‰uãOˆ~ñ«â MKCøÿ­Ø|0¶Ð5oŠ_RßQ>ø%à›ÑâýROƒŸ¼?¨ês]j~ ±>0Ö|[ÎÚ¿Œ^ñŒüGâ€Óö\ÖcƒD–ãâ†ìõä»»ð—ˆ5ï |+³ðŒúOìéÖ¡q þÏ­í<[v¿|6 ƒÂŒÎ OàßÀÝ&iž/…¿á øW¤ÙøÞ:%°Óõ#ðÖ‡ Ú~Ê"òxSÇ.ðÿŽôßxnÚOÑê¿ 4»m[öŠø•£ÿfEáM_â­»$Ið°ëú'Àm7L‹C0jVún¥â{ÿE­è^$u§ì·©j-§Éãÿè>0ŸÅÚUÆûHß[|3³Ð5/Žzm¤W á†v—§Å:»ü;ýžü(ú¿ˆTü"¶O^xžÏPž'ñÞ¦uωóüL‚ËöYÖ¦}ûÄŸ¼7{¯ê ¬ø[⟈<1ð²ÛÁÚž¿ðEŽ­?…?gÏ…0xÇU»ø!ðÃG»›Ao&™uâßø¾-æçþ Ä:•·ˆ´p í¿eýjÙôëÛ/øgÃÚ͆«uá]7Tð_‹ ?ÿ٨\+Züø ŸŠç_„Rj¶ºG„áñ×Ä»Gñ½â+2öóÃúW‚—Ã~€V‹öUÔtï³Íá¯ø#Á÷¾ñ4ZwÁ‰<3ðcF³Óþ|¾þ̳ñ~è×>(½Ó´Š>:Ñ­õ{ümÔ¢ÕwÏ­0·øw…c‡Y¿e{Û½ ñƒ<ÿ¶£m'ìùmÂ;{Løš½¸ƒâWŽ­ì5¿\ÿÂû@x÷ûcÆìßüWpÖúXñ {àOý³â[|S‹Rý”nþ(ü-â¯höZd–^+ø'¦kÿ “ÆZ€¾7Ïý¡wâŸÚ#âQ¿ñÅŽ£ñË㱬êTÑüK¬j>ÿ„nxÙ‡Wׯ5=zøíÿì®s«&›âO Ï¡ýžèº'Œ~[ø­|EûIÃt÷¶ß´ÇKë_xrçâþ£áû;Âsø#Ázpøu£ø6m ɦ_»i Ãgý”"Ôn&¶ñŠ|7ã/ øƒÃñê4¿|3Óu=Oã·Æ½>M5|3ñ ã&±k¯éÖþ&ðƒl´»kO |Ò4o økG‰-l Ö¿áÑ|9 è OÙZ}\iñxÿƺŽ¢ñnƒäþÒ·¿ të-WöŠ×tû+[O è:Ýÿü$7°xSà'† Ljä‡àfa©Á¬G©YÙë~5¾´½ø“Äð§ì»­j’h—^4ø‡áÿê¾ ´Ô´?ú݇à mVø¥ðõ-õá_‚^ ½/Õ$ø9ð;ÃúŽ§5Ö§à«ã gÅ°,í«øÁuïxÏÄ~(-?eÍf84In> xnÏ^K»¿ xƒ^ð—»?ϤþÎ]jìñð:ÞÓÅ·kðGÃb ·ƒ4 ÿÜÙk?|so?ŒÞïã‰^þ++ߦÿ‡zŽŒ|i¡øü¿ý•om¬õ»_x¿Á^Mî=cö~±Ô>[ø¯Cø;ãUngñßÆiš—`ŸâïÇŸjš×Šu+O‰^$Ô´”Ð¥Õ÷7‡u{ÍWâ%÷Ä@ îeU·“ĉ x‹Áéq}›Æ¿tO|.ÅZu—í˨ϩþÑž/h:—ÇO¶¥ÿõï‡,åÔ<iáGЖæÆâã\‡ÂÚï„'쩾£iuâ ø‹ÃÚ–™‰õÝÆ_ l5·ø¥ûCÙ›oì¿_o´ïhâf™á‘¢ø[þß…zMŸ<9ác¢[ ?R0è aør§ì¢/'…Ï`ú® Öæî`ÿÙgetdp-2.7.0-source/doc/texinfo/mStrip.geo000644 001750 001750 00000003745 11266605602 022011 0ustar00geuzainegeuzaine000000 000000 /* ------------------------------------------------------------------- File "mStrip.geo" This file is the geometrical description used by GMSH to produce the file "mStrip.msh". ------------------------------------------------------------------- */ /* Definition of some parameters for geometrical dimensions, i.e. h (height of 'Diel1'), w (width of 'Line'), t (thickness of 'Line') xBox (width of the air box) and yBox (height of the air box) */ h = 1.e-3 ; w = 4.72e-3 ; t = 0.035e-3 ; xBox = w/2. * 6. ; yBox = h * 12. ; /* Definition of parameters for local mesh dimensions */ s = 1. ; p0 = h / 10. * s ; pLine0 = w/2. / 10. * s ; pLine1 = w/2. / 50. * s ; pxBox = xBox / 10. * s ; pyBox = yBox / 8. * s ; /* Definition of gemetrical points */ Point(1) = { 0 , 0, 0, p0} ; Point(2) = { xBox, 0, 0, pxBox} ; Point(3) = { xBox, h, 0, pxBox} ; Point(4) = { 0 , h, 0, pLine0} ; Point(5) = { w/2., h, 0, pLine1} ; Point(6) = { 0 , h+t, 0, pLine0} ; Point(7) = { w/2., h+t, 0, pLine1} ; Point(8) = { 0 , yBox, 0, pyBox} ; Point(9) = { xBox, yBox, 0, pyBox} ; /* Definition of gemetrical lines */ Line(1) = {1,2}; Line(2) = {2,3}; Line(3) = {3,9}; Line(4) = {9,8}; Line(5) = {8,6}; Line(7) = {4,1}; Line(8) = {5,3}; Line(9) = {4,5}; Line(10) = {6,7}; Line(11) = {5,7}; /* Definition of geometrical surfaces */ Line Loop(12) = {8,-2,-1,-7,9}; Plane Surface(13) = {12}; Line Loop(14) = {10,-11,8,3,4,5}; Plane Surface(15) = {14}; /* Definition of Physical entities (surfaces, lines). The Physical entities tell GMSH the elements and their associated region numbers to save in the file 'mStrip.msh'. For example, the Region 111 is made of elements of surface 13, while the Region 121 is made of elements of lines 9, 10 and 11 */ Physical Surface (101) = {15} ; /* Air */ Physical Surface (111) = {13} ; /* Diel1 */ Physical Line (120) = {1} ; /* Ground */ Physical Line (121) = {9,10,11} ; /* Line */ Physical Line (130) = {2,3,4} ; /* SurfInf */ getdp-2.7.0-source/doc/texinfo/objects-wrap.pdf000644 001750 001750 00000071260 11266605602 023127 0ustar00geuzainegeuzaine000000 000000 %PDF-1.2 %Çì¢ 4 0 obj <> stream xœí½Íóg»qÞÇ )S-š’ÐÊ$¦ÉUãýeiWùPñVeÃl%VqT%müïç Ÿègî,îå]xÁb±îó=¿sÐxiF#|ŠÃúÿû7Ÿ?üÇ¿~þÿÿ|Hùcl?Û{ê÷¡ÆZ<·‡þ¿ÿ!~ü?üÃÇhoÚÿù›ÏÿÓ7þÃü?~ó·ö~½ }zþ¶|ª¿ùü—ÿÓ?ùAþ÷Wßü݇çí±”ßü—?¼ô/ýÃKÿG}éþæã_?oþ>#/ñ?ÿ“ä^¾?¼ô/ýÃKÿ}©i ÌJbþ¸&%ÏÒ,˜ˆ´âøž“ÄÿíCŒê±}Ç£hRªÿñ¿~øÛÿaM@þûW~þÍú÷ù¤Rüâï¾ò ÿä[?õ•_öŸ”ø•¯|ù ÿ¤…¯üÅ?üæCŠ£|û7¾òËþ“¾”ä+¿üæCNñ+’|å—ß|(©~­j¾ý—ý'ßö•¯üò›ïØnR¬õc̳®™/¹<¿<Ü”+¸+7ðPîà©<[ð\BGåNÊ œ•3¸(C–V•!KkÊ¥ueÈÒ†òOeÈ؃p„,=*C–ž”!KÏÊ¥eÈÒ«2déM²ô® YúP¦,S8¡îFP†Œ#*C–‘”!ËÈÊź²cÈ2ª2dM²Œ® YÆΔe*C–”Qw3*CÆ™”!ËÌÊeeÈ2«2d™M²Ì.\ ËÊ”e*›,)å ŽÊœ”+8+wpQàª<¯g.®á¼Óq²*C–R•!K)Ê¥deÈR’2d)Q™²eÈ’§2dÉC˜c\îʨ»Ü”!K®Ê%eÈ’³2dÉI²ä¨LY‚2dIS˜s’4”!Kêʨ»Ô”!KªÊ%å|=“¿|¾+×+o7·#£ã~ÊÊñ8eîxžº»9ßmàæxÚ’ãtÚ¤ã|Ú¶ãrúˆãzú”ãvú¦ã~ú¸ãqt…ãytÎÍlóµ+Ç£§£K磓_k%ÇÔÉ]™:|(s, Êû’2×E˜ºËÆ\Ç\C eÈ8‚2ÿv —kã˜cnWÎ'Ž™‡*œ/Y³L²r9eâ˜s˜¨NÙÞÌ>esÇõÔ‘ã|êÔ1×æM˜kCkŽÙŠòÕÆ_kü›¹v†Màf¾3(—Óæ_s€‹·-6›Ù7›ò*+XÞþkéãß}¨í5å|>‰õ&*ðS[ ü{}~åøT,Ù–õ„Äd_öYù’¹~íƒïìqýmï÷l·Ä_›% ß<‚=œùë(öªÈ¿sýÚfGrZ[ŸVe¶,i+Žº=š§½¨=2=u1íïZÊë­uâ›m‰Õæ·­äõWÕ&I­šÐÕ4bkÃþÆʦ {A™/˜ó“M=Q=ŽO6[ öénYXçõ¢Ž–²>ÐGÿ´ªõr}|˜”Ï‘íïÆRÙ¹  Æê÷Ù œ¿û0c´CF²X!¥Ñí³¯Š}¸dÉÂJUˆCîöpéL¯r·¯Ä0­øSHǧÕ?©h¼†´g`Àß=Â%s²f#ªüYÕZŽbD½=«S¾gZ yV™H§hßyV‘x~™níwè“!Û^zV‡|¾$üø{µ ˆcò÷§±®÷ ”ñ#|CšR¦±šÈ“F“|ŠïÏçÈß)]Îü{”ð3˲§Y¢¹ói{W ÌKÀ³ÏÈw£ú×ÌÝÒ}⯠Zí›®kjñ>½ú’}9"'-T¼ âÑKrØ·Úh(–S_Ó—UÊökG7Mµ;–q!±«?o´¿M©áK_NöÏ+=ñ» 0ÏÖßÚbãYã[O¶{ªÖäK£àïæÌÖþf·\ÛžÏv¸çrú‚ãúö)Ïg{ÕóéËžOß÷<_]á˜sž”ã«£<§W×yίnô\^ë¹¾:ÙóµÖp|Æϳ²2ǔꙺc–cŽY]™k“©Ì1:(sŒNÊg-à™ctUæÜ xÞ²¤¬\ßoyæÜ# snlkÇå•Ñ3Ëj÷þ–•çü–­ãvÕ‹cäÙÖ€ŽÓ©Ó›ë8mÀ1ó•ãiK7ÛöKÓç3ø”#Áô¹ÏŠ~$Z‰f\¿‘&Ì'óxdZ¤æSŠ#Ó°2Ó²aŽBKÉLËÔ1* +3/Èh¿æõ¾± :k‘¾L+HÔe™‘†¥i¦¿™h«›}™2æ6Õͱ,#³ÑʲLsT~sš¡ KÂ*„ M0ÉL!¡T¦a¢ ­óéµÔ ƒæ°öl"&-¦Ý§®ù›Y¹b¤õöéÛ—9ê)y3„&úr%34nSÍM­ló̸ÍFËÂm¦ðšhÌà ËÜï^#LÎûwý©hÊ´l`fhè;myÉmûáXjžÆóé¨Þe³NÈw?¢m§Ífývü×yò÷4ÿ,ËÜúnY™ùlª&¬-S73if=}góOÛ]áóË&oƒiç0§ÆõÚ=1¦)¨®ÝÇ•ÏLek5†¼›+8*p†·CíY¹€‹rWå n˜ÂÔÞ•™·¡ Ù1…¹*³^S92dÇÔïfä SÅ›‘7L-/†j¯6u ÙGUFÞFóÌ!±š×“cÈ>†2dŸAϘwÖŲ*¦ü7#X"ÜŒ<Ï¢ mŠt3†²:›2óÖ•™·¡ ÙçF6›:9.à¨ÁIÚ¦Ù”Êqå ®ÊÜ„+óÖ•™·¡Ì¼MaìS'ÜüíÃæÓ*æÚˆ6n"õƒhÀGû@‹SâÍcÂÚg|ýî_z†´ú1=#Ìz˜¼Êøá¦\ö_ô•ªø‹¾y¶¦¼j1ÆP•mx^g„»qú‚±a–³26ÖJ¶ÉüÚ~SÆ&]Êxç£\ç€<<ÈsDžkNñQÞž39+c›°|Áù•Ñ36 Ó Yâ Ùƒ²ž:ú‚jû Æ&éªkÏ•Ùª2ZÓ£M„Ó•·›!KèÊ%Fáˆ6«2ê4Nå~ÊÐ1ê4ueÔ]ŽÊ¨»\•YwS9½mÕ3d)A˜Èy(³/4å~ÚŒãvò첤©\ŽìŽ!KªÊW›tŒºKQ9œº¸8MÖ]Woz†Œ1)S·eꢡ CS†Œ¡(³­&e¶Õ Ðæ‡ð˜—μy¼}ÓsûšgöÍ©üu—g]_—'±½UÖè²Ö<6¨ÀµåI"ÑNþ²–¶Ú^,Ïz(Z¢ 1èÃÒíÁŽõ`5?g©T™\¿mߘ§èŸe6–›¹G´,Kp=1Ç”ecJ)ûÐÜrKYk8Ûüx3XÂ|ÂF4aSÁªtØR0=ó_8¦´å’‘Rƒ§Ä€ì©a =þ¶Cú™ª½×f^³à‹ Âi›ð«-ØgæÀgÐô‚-”vƒ©á74›bøt²íÑ’‘NŸ¨æMÍÐ;Ê:pýýüø ƒá'ªÂ€¿åB?š-àUXýIñéb ï÷Ÿ=Ùˆ~5ÑÏëÍߥÿÌjZe ß{!¸£}õùe›·eÓñŒIè²yƤÒBP8Æd65e,.×RÙ3&­kÍ3&¡k¯Îóaì9µµwè“ܵé2®½LÏqí‰z†ŒË­Õ3d\þ@ž!cíÊãzæb¸[¶ejñÌoå~òp3ßm¹ç{¦,Q¹£l׳ãƲÊõ”¡cȸö¼s‘´öŒ=—SGŽ!ã2L9¬ë¤œOp ×^²g¶¥) Û7Ú˜cȸö˜=³­6϶fkÞ!ãÚ{ö̾=ï²µ>r3ÜxWæ;ƒr=}Ð1ûæPFÖ^µçyúøÍl{ËÆí²/S ç|tˆcꖤ̌ŽÛ)ÇW:Ž§ÌoÞÆ­¨\O:N§ ÜÌ>hmÆñÕÆçÓ&‡Ó†o¦î C¹œ>â8ž>us¾ú ãzú¬ãtúø͜ØNpÜŽq¼dü¶}¬0³îf8³ôØéß­4&âÖ'ŸTãÓ–êsrlfuÌ´ûÞJ˜]÷½ó51÷îô– ¶ÌlÜ )Ûw[cÚœhŸtÚ›Iø2ê6˜óÿ“Úþ¿æ¸¼\ϸá¹ðHLç`Ïg¾=V¬6ÒØž¹ÑÒq{îÚ&лÂY{¶Ú¾Èɼß×êˆÛ@Íþ>rÇr™c¥œ˜Ø¯^xwÆìY\i[Tî­¯l®æi->ìébî,Ž•ÎX?ò$C*&ÉS¸Ü+ØîšèKÅ2—g¿å¥`3kr±–j4Ÿó1¹eWmE4mͶµ¶6$¡méGæv`µ¶}ù×ÖÍÚvêô¾_[–î™oÇ9…^÷óÓ6Ózæ6U³¥ÖS}§q$°$6<úµÒl•õŽ/ÉÎ 4{Xó Kï6òÌ_>aÌ·e›ÏÿÞקÚlð¾nØ]‡@8s¢\á{™Ÿ34Ê3ù¼Ù wšãf3ôehÇ\”¸)gpW.à©\m&帓rånÊÑfŽ7gÈh3PÇÑf¬Ž!cNÊ-âfÈh+HÇÑfîŽ!£­CF[18†Œ¶òp ±â¼¸@F[ñ8†Œ¥)çë™›ëõΛ‘g[!9¾òvse¢r<2:ΧL³ ‡r;eëy°ÕÒÍ-œ:rO:f²r=mÃ1ó•Çic7÷«M:FÛKC9Ÿ¶í¸ž¾à˜}§*Ó§nÌCVN§o:Χ/;f‚r?:Á1ò`+¤›g8ºÅñ¥‹SUåztšcæ!+Ï£/î!¼ºÔ3ó”¡–Nö®g¿y‹Ê—®¾™ekyvŽŒ7³mX™8§ ofÛŽ]9œ:º™}3NåpÚÀÍå §ë™›óù–ãròæ¸Y·#»ã~ÊÊñ8eîø[o®W:Žo𠱪¸2žUÈf¶¥ª ±²¹2Ú É1d´•cÈ‚²ÉˆÛÍhXá9Žà¦œÀU9ƒ‹rgå ŽÊ ”MFÛü÷<ÀC2Ž.Œ>b®0ž!ã(ÊqdeÈ8’2dA2ö© ûP†Œ½+CÆÞ”!c/ÂÐ!æå2ö¤ {TþÚó_yÿÎ[Q¦ŒU¹^²Üœ/ÙoŽWYÝ®²½x· Œ<Œ¨\O:Χ 8¾ÚŒã«Ý\™‡¦ÜN[u\OÛvœO_pOßqN_»º–'ÇíôYÇõôqÇùèÇ—qÌi³¡…höšœÇ¶ö ¤ÛvnÛ½'…f›»pÒ¡a„®6t ¦#Í ŽcÒ¥íܣطk¯íSç¸ýË-GÜ“]ç±g g\쌦9hµ æLA[B6íåH@+Mç>+¥]g÷/ÛW*›Ðo+V6X,«yWëUµÈë€ç¶›¬_óeY¾Â´Z¬’Jp­mÜ$رNÝNyÓcy¥¹¡?Xê}vlðÓ 6Ìøa±HVêј+^~›Ïn[Ï\Î^1î_-4Àóa´…–Ëζaes|B5>©eø2? HûÔ%x†>';×ÿ4˜ÄôÚwœ,Ù§ÞÍF4êøivšÒ•/¯Æk-ë%Ë7NƳÈ‘Æ`N ¢3,z¤Í£>ŽŠòË+Æ`èÿ+ÝÎ$Ä"èV¸\i™b4…\~çœ##Ž fzµ2 ~C‡ž`×\ã#l\û̓–$j3جFå¯øb}Ÿ8‹´xÏØó‰Ze"t %l6±w61¶´5ëF:}ºV‰?€M,׆œhž/¿„¸*½ñ»~«¤LøùåÕ'ŠöõÁI9‹r7åÊÕØv¿7pTîà¬<ÀUy‚»p†Œu*CÆ•!cËʱUeÈغ2dlS2Ú<Ð1d´ùžcÈhó:ÇÑæo7ÈÒ›r>ëyëEùʃc~+ ×xdqÌoå«Lã[m(ÏS¶77Ö]S¾êÈ1¿U”û©kÇüVîW›qÌoåzÚžc¶í¡|µá›¾e^-Žóé Žù­¢|õ)ÇüVžñôMÇùôeÇø–yµ8îG'8Æ·Ì«åbxs@·x¦Î©ÊõÕQ7¿ï¬ÊçŽG9ù¹¹·“ç›Û82:§Ln®é”áÍå*CÇå¼Óq=ypÜNž÷#£ãqÊÄñ­A•'x0d¡5©2ý]ñôŽ¸”À²`ÑFc¡PyëY ðœßÔ'äع—ëMÙ'–ÅçèI4¼žÿzâHJÂC€í,ÁNj- 1ÀBU¶Õ¦À+i4Cϯ/«Ì:rõÔ-6ã²:åœíÜ- +H!šÅ~RuÐÓaG*´ØT”B0Ò ž"£Å.³1g~¦åfY‚Õ¥›ipž–`庎xØ—‡yÿ<Í—ò D…“Ú“žÖàãäù§EvØ™˜“ÙÎé‰ç#ì%à¨ÿ˜(ϧÿ”íGU,6êhh{%X˜Ö§5Cæ÷s$ô‚³#qDX¼J4#é·,ß5óªš|~­òz+L1.ƒÆ‹N³=¬ §¾Ö§5’Ú»h}Z#Ó§×}éyXŸŸÎ×ؙድWð€j(5“¾}¯ ÂÄ®ù÷þÝ,o~ik…©¸Ó?ê‘Ðìk‘1ßµåE<Ønçr¾³ j KÏûWX„Í–ûµ¥-ÜÁEy€»òOaØyÖ2C8‚‹rwewÖt_¸€“rWeÈh§ÝCÆ”!ã3†Œ½ È؇2d\'²c'¤I…nÃNµ<ë ‚`V€T3ÃØ1ŸgŽÖXY®‹±¹ZpãÙ—¹¦u-ñ‰°"aó㙦Xi¶&0Â@Óö•¥§ó°QL"0õÌ€©Û’ºó°R\!sRï|:›Bêƒ×%ti^QÍ# šŠï\"¯]rKÛ·«¤ÁkbGIŒÆ +ºÝ‘ñ¤yõN¥±—eHˆµ4W.¢€ðØÙÀajš£ÆœtCBÏ +Oz³°‚inƒK´KOÒÜÇ«–)øIm³L s;ál[šû:ˆlµ•æ6îd¸9M6´§‘eüýv22{UšŒI+Zšp}zÖßötÞF©’wO[Ä4ó>*6¸QU»šäMÙ‰¯7UÂýäšúnFiî꟩#Úû½†žú槡o¾ùmf¡ØÒt˜ú^Yû0Þ’èÕð½%Õ­ûŸ’a\å<2Ë•õ0:äÙõ„ê>µ8K@zÆXîlOµá}l%ùÑ|ëë»e‹È…–cÅoÖúr´ÐŽl—ym\¾-6g»GèmÑ9Û%o‹Ï%´»Gä‚C„ƒŽkb±ûR6E·{š¹é¼ý07ëž©ãàÀ*É•âµ=y,;F‡ùXoétéÊ3Y)u‹Ò”'¾´I“L0[ßS‰4ᘟu KSÄζ]f©uÊ•†(d¬Œº6Öó•#˜+‘J²(œO3å×Vˆ(6á•B{-ŽZ%›¿S*4#– çÃÂ+g BÊ=ª ŸŽCMμš1u/pæ˼:ªS+Šž®¡±£T»bhE}c:·sLµTpÓ6dÕ5œìØ8e91¯øÉüÍüÒb§,GW»^l þ00og¼²)¬+?qÊŒ¥qÿš0žÒ„Ï© Mêkâ£)ë 67ž µ´™Î·»ÞZZºî·WYkÞ¿›q{7Z [L2ÚNÏ=7ù=MwͧڄbØ° v-1;èÑwŽéWmâøtØÏ›E®šæb,ø£Õç .Ê œ•8y†Á"Ö•÷¨ªlãi5Í͈~UÛPFÞ` ¹2¶¦Œ¼Á@s1}#–cäÍ 4Ž™·$ܘ·¨ÜÀAy³våy«C¸"oµ+#ofpqŒ¼Áàr±bÎÂû™¤ÌwFeæ!3Ïe*£Í˜aÅ1ê®te”! +³ÌÍ°âeh†Ç(ó’•!»VnÌ[T†ì¶°q Ùá*|1¢¼U[89FÞrW†ì¹)Cvh¿ÃÑôj.ÊÈ[ÎÊÌ[òŒ6ð-´µ¾ñÏ>3õCè¿ç« ë–®÷Nê¥ýË÷Ô|æjõys[Û9†û™i;ᰵ㶵WV®[Û §­í<¹µpÛÚN8om'¶¶óÜÇÖvÂuk;á´µç6·¶n[Û ç­í„ãÖvžëØÚN¸nm'œ¶¶ó¼µWSn[Û —­í„ÛÖvÂsk;Ï;A¹nm'Ü·¶ó¼µcWÎ[Û ·­í„ÇÖvž·vÌÊek;á¾µðÜÚÎ3µcžÊuk;ᱵ筛rÞÚN¸mm'<·¶sÜ9[ÉÉ3ÚÀW4ß{,R?Ħ-5Ÿ0{ßËvˆ 9Úì»oØÆ®ÿü2æ’‹Û1çáIs`‹Å}3Ž‹Û1Œ|‹Û1Œ—ˆÅ}3Œ‘ˆÅ}3Œ‹ˆÅ}3ó0…¹©h±¸s=•iäNÊ4rgeäWpÜ ãå¹¾ƒÌÍ\÷q3óЕ™‡¡Œº°+Gss (¿›ž÷æFR¦q=+¿Æra¿«2óЄ÷¦DWÞ+9eѧ2ÖAùÝüææUòŒ«lÌX.LãwQ~W˜Â4Ò7eÝ»ò¼þöâηÇ“gÇé•Ýs~ËÐsyëÂs}ëÎs{Û€çþ¶%ÏïfŽð|Û°ãÞ¾à9¾}Êszû¦çüöqÏåÕ žnñ¼íÊýÕužÇ«3=CF»zîf8­Ø!]Çø[;Ôë–»bÎ1m&U9ƒ‹rgaÔ…böÜÁQ¹‚ƒ2ò€û n†ÉîÂp ÙíÑGx×ÆÍÛb¤Œ<ØEÂŽ!ûÈÊ}$ÏÔ ¸[Ä1dAyèS²÷¡ Ù{W†ì½ ×^&Œ<ô¢ Ù{V†ì=)Cö…1Fà®ÇÈC›Ê´ò eÈÞº2doM²·*Œ1ÔVž!{ËÊíz¦}ù|U'Žç‘åæ·©¯²º9]e{óUŽË©;ÇõÔµãvÚŒã~Ú˜ãqÚ¤ãyÚðÍ#œ6ï8ž>â8½}Ís~û¦çòöeÏõíûžÛ«+<÷W·x¯.ò<_æ˜}wîÜ|t¦çôêXÏùÕÉž_[·p}u¾gêü©Ì1((Ÿ1È3Ç ä¹Ð)ÌÆ2Çœ«eŒ¹vÅ«cÎá»2ÇÜ¡Ì1w*sN•¯1ýâWö©œÞo9¦ÓMèÊá•Å1çÞ¶f¹™sûP”ó[†Ž÷š%)ÇSG7—/W…vÐ4/èu5†+·ôØi LÐ]Êœ¼câ.Z°Ýß;=?2V¿íÚÚrí«`0áÝ°,¤Ãºdƒ»,‘¡&rhæv#þa7cÜ!V™á&¼¼¼ ì=ÜõÃ~¢]ºaÁÌÙ{¹¼Ãµ>XŠÎôÉ6ÛÖÅtÃG0È+ ršüÝv3Ü·ÃÞÅ|”KØFs6÷„u‰]ñSDš¡Š])aa}Öºsñ릟ñÛP-PèIO~™éf7ž¿oæ)ñ¤±?——±a©›7ÇÉW_z;0,Ç£k+ÊÇ$¶)a½}ôXÆo.ýµ½KzÚ)ÖQ }ºÛJ •m£3mž-O¥Á ß ºë꡽»¹R{O,Á^·>¼*bĈ´n‰X¿òØBÉ0ν{Ùpƒ!}4ÊR€Û¥¿[{™¸ 1sgôù‡õ×+XÒË‚˜ê`ªãéN·ž‚þ±Ü` íTAL“o[.V? uïfÚ€BåÝÏ\¿'ÎÌfÂ]Ø}kŸä½Šû@彊}?mGYÖ¨ûiÏïí÷}¸€ºyïRòžEÖûÒ^Ÿ g¹ûG ¹S凹GŒ£‹IøÙtì§rîQ¤üí{YÝ×VHœ1âF0c³à­Û²»æÇžÑggPfŸíÊß~ t¢‘bdw1õûÞ„hÝÓbž¿w½ï~ç™®ïl|0¸›Ë긌ïã2¾“áhzÜÁ8Ñ00¡¼¹ƒ‹0ýW1a½¹›0´Ã&ÄŽákhÇ<…±6Aw YÌà~3&è÷•ß YböÌɈE²Ä* Ó0âc:ûvåöæÁse÷<ÞºðleÒ熡³Ã0wsex(›ÁË1œœGP†'toÊ\”é…!KïI™ïŒÂ0d÷”ñ­6•!{ž¹Ðí­+£LÌ@s3ü½UeÈb ›aøèf0r YZƯ·¨LY‚2d©Sžü½å|=sóõNÇíäÁñ8yv<Œ7·xÊÄq:e踜2w|Õ‘ã~êÔñ|Û€cèœÃÙÍémcžóÛ&=×· {îo›÷̶]…GxûŽg”•Ô3C™}d*··ÏzFFTFY‹®Éì ç¢ëÍÔE¹¼:Ä3Êj4e”•Ú3ÃóîËc*§£Ó£¬fTFl£âb¶: m7S—VaÖÑlÂl3fh»™mÛ.º¾™}mNa£¿œ¨¬º~½Þ„-Å‘ ¥ šW"œ‡B8Ñg:áðÀNt¸ygXa:=Yw’KøŒõiTœ„·X½€>FÙn\±Žøw6 jy °sÿ18³]ë`xJD ¨u'mu]ãdÐ3”m°¶mS°iØ7#ìÆûÐþG^°]lO9n¯h3o$ÆZ(æ‚ŽeÛ*=âøÿïÖrö þåÒ&qǰϬ%*5;L tÔ®¸g;¬Ë«YK&Ï‹T;h„µËÚvû²Ò§w †Òhq`Ðæ¶6›û>¢óèö^ðÍ ¹ó+Ýb+´Ž‰h7ÃT£ûÓ >VŠ…Ã5•A<†y®ãtѺ2tÉZL ÌGۆȌÜPèxþÌrW;ȶ„µzþ,7ZysæoÉ.ÍŒNsÀñžŽÉðOf„›x% Yçḣ|îƒ4æZX×vBhø°C4+ó òçÓjñ—Ý"ëp‚Žv÷›a2ILÚÇD&©´CÂ,o*,æÒx‘§e£uݵ#f>žÉÖá✢’Ö)­€€ºÑn zZO¦»R´¶ O|b…GZÝe'ŸÅëSì﯉ãé]ûï“äÖY> .÷?Ø1û¬ž¤ÕÍõÊ5K[ý7˜Öµ»•ÆÊÃØÿPŸäó¸º$ÀuJ+äÿ¡>ÓÐe×Úɧ\ŸGößW»ú*†k©ìZï}E(l–nC˜ÛæQ1OA^m智`Š6OÏpnÖ½°ÍL˜ yjÆ:WÜw^ tôÌ 66]ª5‹3ÞÖ“ƒ]C ÍÒ¦äúÚ·íoiú˦Ô}î%(ÞmÄ®ý„6i;·!87œ.¤}û™¥›?îu^XÍšJÜææ‰St+aíç'÷upb‡%îv¬q÷×g8X½1çm6 a#7MmI —¸(¸ðÀMY^ñ%ïð-X¦´­¥/³fa€I;+R¹I`q7+ƒm—uùw݇kr~4†þg†÷ü[ãmaeíµÆó#Å´Q›ñ5ý>¯ï¬î‚q¤¿ÙgÍÖÇN˜ºûpN51Gym·KŒÎ÷Vµ&C:-“ÕµóN¦§Ó´°Ó$sçhþ F]©A‡¸£ÿ67»î5×—n{Ë&…wu;Íõ R4]÷åÀ9DLœÄ¦¥Ûȳ;¾k¹¥>ŒÃôVÚLJ,Ç6g÷¶=‘y¨tÍŠÍ4y|¨Ûq±gÌÝï³Yç>òƒ¹#o¹[3ÃOg“·˜Ïy;æuyö²íšÂ훂)Í1kcUüC˜µao±SsŸ¯ï–]Z6döîïlÚ~ƳËOõóFÏži¡C ¨e:œ4|0ÖèÆƧnâeÏÂñBDT}°xä˪G¾¬y„ÉðQ'7F¾lx„Yóiýñ²5¯¹/{œ7ÒÐù,7âeÞpˆB}*Àá8/»p¾™¼fá%æñ-¾Ó®‡yW¬Cd²T0—ìER‚Gš»GNƪG±“Cšøsðžòrž²uRòÈ­‰é=õëÅâ=íÆ!MÐÓ# ÖÍ!¶kVȇèiç1Ÿ}ú„Cž›Gš©«Ço–/ëãùÄ…Ü^š·@Ñ#…Oû+æÜV*¹©T=–S’¢bŸé•Ãt*àBn6áTáA6ĘÊÑ!Góˆ9†ÃÀßè‘Û¾Ùc•Âï™ÃúvôËÛyod‡ìO‡¼1¾ìÆð*݃<ê²:ŽÃ±;ƒÃ¾;ƒÃ¶¸Ãº›²Ã·Ñ:Ì»!:d£­ãn\Ãn07â˜ÜX~»en…Œy-so‚3és¡/‚ÉÄÓ•;zŒ-&Ç^$t˜ÏæžÊ®÷ã!›Í‚&mÜœRép2pÒ'ïè2ëC †8m·È3Œ#² S¶ðeHô‰x“ˆqhW@L²«]+óäêÚЫ\äU›Z?“ÈÁ¤y¤Ô€ 7œ ×h×oªE¹]»`4|™÷W;H œWl¯¡b!¹ì®8çQpüK\ð’lÛ€·¹$ôof&|Zã*·–á`fû­Â¿Œ‘8Z§ ªM,´–«Ý|yža•ÚqéML>ÓÌÙù¤Y&•#˜E'Ѷ–`;a ‹!4h¸v× "ª>©§Ñ †Ê¶ØK<¼k0ŠÍ´˜ {I:Í®Óì5ÍVÔyÑs f_è8jì¤mg ÖÌ›ªWZáV¸¨=×0sKç3Pz¼œeÏàF»žå¢'ZÙàØÓ¶úY”’w„‹¦Úi$[ Ý~åg¢(è´™ýž;òÅÞ\Îv|gÌÝå:°’Öú¿óV|ß>–Ÿ_Ær[î7siž•±ÝŠ0|8ûuÞ }‚3n7c;å:ãFæ;‡0·ãpÆíflÄ ŒwâŒÛÅÔE1)CvÛrwÌweh»X…¹Í›2ßÙ•Q¶q(Cö8…¹e[ŽQ¶vÆÍ1dOÉóÞžJY™ï,Ê=UeÈžšpä;»rºž¹9Ÿ<8>²x®oYyno™{îozo›ñ|Úžcº-àlÔÍñí#žÙVƒ2|¤qÖéfø5^ç›Èð·3JŽapƒ»ÄÍ𵶳EŽa‚³³EŽñÎQ•‘·Q”iÚËÂ<7’2ß•a>A8¼Áw…ñÎ>”QV½+3nó¼ÏØv·c0‹2d·ítǽ'ažýìQ²Ûö¾cÈnîŽñNs¸™Á[W†ì­)3Xonoð]aÈ~-"Cv¸‡ÜÌwFa½Ü1ø|¸Þys¼òpsºò|ó%£ãzÊÄq;e踟2wíLsl8I £ú&×b¶œWU»øà$m…Í,¬òo>—³Å8ö)X»»D‡½«ï+h‡í‘íUŠÅLÜ %Faì‘w®¬«7–y‹1 ƒÙæè¹úªÛ½ËpT€Ñ1G¬Šò¾>ÖüV`VÍØøÝK¾œmÝ÷®õ3²}2c7’Å>Ý÷®õÓ3l]‰f´ʱ¢8è“›¬êïñ¦G}«[^9Öñ¥•LÜàO!Þzœ‡Ù#Úåu˜aì0|Á¢Žµ/˜ÇΤi¢àd|Z~‡+@&ïB2ß©uG|…–—÷%Ù})s_Q’mõkÁdWªáLWÞ1— uo5óÄW£çRÁ¥¶"XIÞ“j¥Lœc£Ü¥ââÙ¸Ã×mÎاƒª910¶_åù)FÞe¤DÛÕÉ3Qn‡:&FdËLj {l‘%G+ú@Ì7Z!¶zSÂæ$iÇQ4a¹mŠ‘×Ò{ƒ½ œhâ Õ¶ÜñûFï˜Ü(fùRëR3s»–ëãjS†µk[Ø¢×Úi'næcÛûû:üqk]ï&£m؈븢ÍDeø5ØÈ긃³2Ú¢¬Ž'¸ cÆYl”uÁC}aNeœp¶MvÇh½!*ㄳ Žé«W”q¢;Teô†Ð”qZÏ,)7óÄ~Ê8у2ÜAbT†Œ—ń̾ž•!ãe=!ÓQ¥)wê eȇ2dŒS˜'öSP†ŒW$ 2dLY2¦¢ SU†Œ©)CÆÔ•!£Eöq sP†Œ9 óÄ~NÊ1geȘ«r¦ŽV¦îîÊ1eúMeÈX‚2d,I2–ì™3`‹áæ9^ÏÜœÞwz†,%*×7ož,žû+»çñ–•cF~ÉM9¾uá™uT”ó[§žËÛ<··Íxîoó<Þ6éu‘†p oÛöœÞ¾à9¿}ÇsyûšçúöMÏìSIy¼}Üó|u‚cF&²ÈMŽã«s<çWGy¦¬ÊùÕžÓ«3=ÇWÇz¯NvLYééæñê|ÏSº2Ç ¦Ì1«*sŒËÊ“2dDĨ›!cÊ£§pä˜Þ•9hÊœ3TeÎ1Š2ç$Y™sݤœÁAs†+2s D†º2^Q¢À°„D†º2"ÔÍ n¦ßhR†Œ#*sΔ!cÊØ›!ãe%CÆ^=SçX`oæÚ#)CÆ•!cʱMeȈCy7CFÊ»™n¹U2šÓ1dlYcziI2¶¨Ü¯¿½™Ï4åyd¹™yèQ9^e~ó©SÏlS¹¼mÌ3ÛXUno_ðÜß>åy¼}Óó|ûþͻͩŽrLU”óÑ™Ž©óƒr=ºÝ1çÀU™sà¡Ì9ðT®×37ﵸ2Çš¦®<Þs°X”û+‹gæ!)3Q9½eå™k–)Ì9pÊg,óÌ1«)s̪ʧ®=3Y˜kXHof¢2ó”óÛ&=sí9”Ù†»p;cŸç3öyæW”óéSŽ™‡¤Ì¿ ­Ð‚rÿø•øQ«¿Vx>­”Y<*µŒ&U蜴¢Iáwž. v1–úƪð ÚQ ]§”mÆä¬mð ïK<‘m§0Q…‡þöß7;ѵä€èÇ;JNvî‚kÒ,J´@eüY ZQí0Ïk¿Ê88öÆóÉ‘ö¬4÷¹¼EÀ¸šp´!ìs=æäóº2åu¾ÂÎ1þRÆ™¡ÔyR2³Ê±¬²Y%c¢¥2ÛÇu7R+Þ8n¶£?pš¢cT¶Y}¢gR¶˜å¸«x¥Ž¶ñv”lñ‡Ó>kŠ+¤ßƒ#¹5Ø ÷‰Ó†C¢ÉfU+.R”°Û ‘˜è•{F4%Qíf\R´Zwƒ:醚oÇÁ®ôôO©ùöÙøí•‚sÖɉtHôÍË5õæ}¶T£¶-3žî,¶“1¯£5Ïxzâ-A¸09ÅvŽI ”6ÍÖH§}-6¥&Zrá”v,·ðYÛ§T#óYöCkÖàGãï9ÔƒXÖž`ܶ–§µÑØYwƒõŒ¸kiÒ*ŒÓ<1s/¤ PÕÓÚyw =½zÎÆm§5<ï[~Š¹/.'ZËí’$‹…ÅY YÃ3OÄ­Ùñ§s96bô¡-—t¿‡†06íCCXù…7žWÑ¡¡*ýPÖáuïß{èé³Í `Fžéâ8¾Ÿm8™`…èþ¼ÙÖmÉì Žm—Ì>á9‚³rWå nÊØ ³¸ûŽqdÓâ÷;nà¤ÜÁEûpvÿ€cÈh÷Üœ!£Ý‡à2Ú½ Ž!£ÝÏà2"&ÿÍÑîp í ÇÑî£p íþ ÇÑîÁp í>› d´{9C»—Ãq¾þöfäÙîåpÜO3I¸†#‹ãtdwÌ2œÊ픡cäwtÜex3ûHžÊñÔÑÍ¥:uœ®gnÎçŽËÉ›ãKÇWÝ9S¶Žç©‹›ë5ö9†ìi*CF[CÆÔ•!cjÊÑM8†Œ©(CÆe÷ SRæX„d\ö Ï1eÈ»2dŒM2ƪ cQ†Œ1)CÆ•!c Ê1LaêØ0”!cèÊ14eÈŠ2d\ö ÏqÙ'½âÀ‘¤´ü ¡Hp Ùû)þ^û÷»…$AÅtÛ Ã0Í)÷â C$¦ÚŽ+8+sI_•3¸+cÑoSmÇfÁTÛqgaäSmÇÜ•ûÇmlð mªí2ÚTÛ1d´©¶cÈhSmÇѦڎ!£MµCF›jß C!¦ÚŽ!£MµCF›j;†¡Ä¦ÚŽ+8+pUÎà® ³ŒMµ›Œ˜j;à,ŒLµôcSmÇ<•!£MµCF›j;†Œ6Õv mªí2ÚTÛ1d´©¶cÈhSí›aµë¢•!ãˆÊ<€‘•!ã¨ÊqteÈ8¦2dœQ˜ufV†Œ³*CÆÙ•!ãœÊ&c Q¹€³råNÊ”)㎔±)SÆ¢L“2e ʬӡÌ:mʬӢÌ:MʬӠÌ6<„ÛpSf.ÊlÃI™m8(³ÏeöÙ¦Ì>[”Ùg“2ûlP¦Žž1·Í¶FñLU”©£’2uTP¦NÊÔÉM™:¹(S''eêä Ì1hŽAM™cPQæ””9eŽ¹C™cnSæ˜[”9æ&eŽ¹A™sŒ!Ü9ÇhÊœceÎ1’2çA™sª¡Ì9US未(sN•”9§ Êß:Ï]ç ?¾óÜœ¸ÛúûÎsŸ¹d½ç¹û ß~õþýûÎs ÚŽÍsÉB”ZõŒ¹mÁÜÊqgå®ÊÜ•qŒ,Oe;R†¹•ãÎÂÈ3æVŽ¸+wðT†Œ5*CÆš•!c­Ê±veÈX§2dlQ2¶,Œ Y˜[9†Œ­+CÆ6•!cʱgeÈØ«2dì]ùô GT†Œ# #„9æVŽ!ãèÊqLeÈ8£2dœY2Ϊ gW†Œs*ãˆdˆÊœ…+0TåîÊ<•MÆ£rgå®ÊÜ•x*CÆ•!cÊ‚Cz3dL]2¦© sT†Œ9+CÆ\•!K.Ê%'eÈ’ƒp¤,C™²4eÊR”!KJÊ%eÖÝPfÝ5eÖ]QæÑÞ¤ cl«C™mµ)³­eÈ’2d A™}s(³o6eöÍ¢ ]4“2tÑ ž1‡-q eꢦL]T”¡‹FR†.A™ºw(S÷6eêÞ¢ {R†Œ=Ž5C™cMSæXS”!cKʱeŽ­C™ckSæØZ”!cMʱáιÄPæ\¢)s.Q”!cIʱeΆ2çNM™s§¢ sRþÖùl ˆ—°g´%ÁŸü˜Ó–˜pžsÚ¥OÍýa"àïß{NÛìÐÌ\Îà›­›šqœÀ]¹€‡rOeËw³C3w†ýŽQߊIߊYßZzØ3¿U…#¿Õ”ù­®Ìo e~k*ã[k|qÌk%ÖøîßJIßZã¾g|kwžù­*œù­¦Ìoue~k(ó[Sß²£47cžÖì(c|Ëõ:Æ·ì°c|Ë ;æ·ª0oé]ýÝ3¿Õ•ù­¡ÌoMe|kéǼöa­¿<ã[KyÆ·ÖºÌ3¾UŠ2¿U…y]CiÊüVWæ·†2¿5•ñ­¥çó:…µîóŒo­ñÂ3¾µÖƒžñ­Z”ù­*LU›2¿Õ•ù­¡Œo­qÓ3žYëJÏxç=#k½é˜ynE™ßªÊüVSæ·º2¿5„YGm*ã[=(ã[k=ëßZóÏøÖZç:Þ׉e~«*ó[M™ßêÊüÖfìSßAßZëhÏøÖšOzÆ·ìF¿›©sFQæ·ª2¿Õ”ù­®Ìo aêØ1•ñ­”ñ­µ~÷Œo­y»g|k­ësL™E™ßªÊüVSæ·º2¿5„9†Î©lß²ë><pTNà¤ÀY˜×…¢ÌoUe~«)ó[]™ßž9Gê×Ü©_sªŽyÔÍø–>vŒoÙá㋯ÃZy¾Ï|9×muŸ™ñ÷9—ˆy®]W¶%âµ}î€ý–^šˆüÃÇGÖõ?þço>üOß|øÿñcüøÍß~Ÿ¢ýë¯àJËÙüæó_þÓÿå~ü£ŸüñOû÷õÍß}˜Ïòëò›ÿò—ÿëú‡§£ÿÚRÏÿø'ÿìŸÿìOþôç?úÉoÿqýöëeë^ñ%ŸŸÿÅO׿þÉ/þìg?ý£ÿù¿üÓõÛüñÏì¡Gw¬˜•_yáŸýìà ù¿ÿä·ÿ¯ÿü—ÿì'±{4˺ŽôyîÿpµøÑÏ?þŸúó?g.æóò_3ÿ×ú‡gÐdz+ ÿú/~õoVŽ~å2þŒÃ^ÊÂ?ùѯþèçÿö—ü/ÿݯü_Äð|%¬'þïÿÅ/ñ“ýøßýüz?1º³ñÛ¿´—î|üè—¿øç?ûåoÿêç¿ýû_þů¾ÈÌ) þ]9÷gV†Ëæ›®2xjn•×/ñÓ_üÔJü߬Ÿÿó7ÿúiÿ?ˆ‘endstream endobj 5 0 obj 18260 endobj 3 0 obj << /Type /Page /MediaBox [0 0 517 296] /Parent 2 0 R /Resources << /ProcSet [/PDF /ImageB /Text] /Font << /A 7 0 R >> >> /Contents 4 0 R >> endobj 7 0 obj <>/FontBBox[0 -20 146 146]/FontMatrix[1 0 0 1 0 0]/Widths[ 0 144 0 0 0 52 0 54 0 50 0 53 0 0 0 59 0 47 0 49 0 0 48 0 57 46 58 0 56 55 0 0 0 60 0 0 51 0 0 0 0 0]>> endobj 2 0 obj << /Type /Pages /Kids [ 3 0 R ] /Count 1 >> endobj 1 0 obj << /Type /Catalog /Pages 2 0 R >> endobj 50 0 obj << /CreationDate (D:20010718182310) /Producer (GNU Ghostscript 5.50) >> endobj 6 0 obj <> endobj 8 0 obj <> stream 0 0 0 0 146 146 d1 146 0 0 146 0 0 cm BI /IM true/W 146/H 146/BPC 1/F/CCF/DP<> ID ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÀ@ EI endstream endobj 9 0 obj <> stream 144 0 0 0 0 0 d1 endstream endobj 10 0 obj <> stream 0 0 0 0 144 144 d1 144 0 0 144 0 0 cm BI /IM true/W 144/H 144/BPC 1/F/CCF/DP<> ID 8 '¤à4œŸÿÿó@Ë4 ³@Ë4 ²jäpƒNiÏÿÿÿò&i 8A§?ÿÿÿæ–hf–hH&i 8A§?ÿÿÿÈ„pƒNiÏÿÿÿù ešY eš ß4ᜠӟÿÿÿä2ðƒNi 9ÿÿÿÿ4 ³@Ë4 ³@ÞA§4ᜠӟÿÿüà4œ“€ÒpÿÿÍ,Ð2Í,Ð2É«i 8A§?ÿÿÿȘA§4áœÿÿÿÿšY ešY  ˜A§4áœÿÿÿÿ Fi 8A§?ÿÿÿæ–hf–h$ƒ| Ó„pƒNÿÿÿË 8A§4çÿÿÿüÐ2Í,Ð2Íyœ Ó„pƒNÿÿó€ÒpNIÀiÿÿÿ4 ³@Ë4 ³@Ë&®A§4áœÿÿÿÿ"aœ Ó„sÿÿÿþhf–hf€D‚aœ Ó„sÿÿÿüA§4áœÿÿÿÿšY ešY ’ ðƒNi 9ÿÿÿþC/4ᜠӟÿÿÿó@Ë4 ³@Ë4 äpƒNi 9ÿÿÿÎIÀi8 '§ÿÿüÐ2Í,Ð2Í,š¹œ Ó„sÿÿÿü‰„pƒNiÏÿÿÿù ešY eš „pƒNiÏÿÿÿòaœ Ó„sÿÿÿþhf–hf‚H7 8A§4çÿÿÿù ¼ Ó„pƒNÿÿÿÍ,Ð2Í,Ð7i 8A§4çÿÿÿ EI endstream endobj 11 0 obj <> stream 0 0 0 0 47 65 d1 47 0 0 65 0 0 cm BI /IM true/W 47/H 65/BPC 1/F/CCF/DP<> ID & A hø dûA§„ý^N]@Ÿ é?ý×éõÿëÿA?ÿù õFŸÒÂý¬ÿï“_ä2»ÿOaÿ÷úï÷ïö¾oÃûa…ãßdºá¯iðf‚/à EI endstream endobj 12 0 obj <> stream 0 0 0 20 46 63 d1 46 0 0 43 0 20 cm BI /IM true/W 46/H 43/BPC 1/F/CCF/DP<> ID &±„ãäÕpÖCÏÿÿÿÿÿÿÿÿûÿïÿ‡ßdûOƒ æköš¶8\ojMTÃ@€€ EI endstream endobj 13 0 obj <> stream 52 0 0 0 0 0 d1 endstream endobj 14 0 obj <> stream 0 0 0 20 43 63 d1 43 0 0 43 0 20 cm BI /IM true/W 43/H 43/BPC 1/F/CCF/DP<> ID & ¹ 1<x@ôÿE¼ ƒzÃá>o§éõ¿ú}oøOÿÿÿÿðÖõÿûiv¿ì0K†»Âà %±_µ† P EI endstream endobj 15 0 obj <> stream 54 0 0 0 0 0 d1 endstream endobj 16 0 obj <> stream 0 0 0 20 50 63 d1 50 0 0 43 0 20 cm BI /IM true/W 50/H 43/BPC 1/F/CCF/DP<> ID & Á@Á`Š|<'t:\.h3¨‚ ˆÿ§÷ÿÃÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿçЇP±¯Éª¾Ðj  EI endstream endobj 17 0 obj <> stream 50 0 0 0 0 0 d1 endstream endobj 18 0 obj <> stream 0 0 0 20 47 85 d1 47 0 0 65 0 20 cm BI /IM true/W 47/H 65/BPC 1/F/CCF/DP<> ID &¹)Ä>MP[_‘gÿÿÿÿÿÿÿäàúÐ|_ó¨ß0þúé¿øOíÿ÷¯‡ÿÿÿÿÿáëþ×놽¥ÚýsY…œ_XRÚ“U`¶ˆ§€€ EI endstream endobj 19 0 obj <> stream 53 0 0 0 0 0 d1 endstream endobj 20 0 obj <> stream 0 0 0 0 46 61 d1 46 0 0 61 0 0 cm BI /IM true/W 46/H 61/BPC 1/F/CCF/DP<> ID &¨—âõ&¨,ŽÿÿÿÿÿÿþAóÐÿÿüÿÿüÌÿÿÿì/ÿÿ c=?ÿÿÿÿù@ƒäÕ(€ EI endstream endobj 21 0 obj <> stream 0 0 0 20 50 63 d1 50 0 0 43 0 20 cm BI /IM true/W 50/H 43/BPC 1/F/CCF/DP<> ID &¹(-4CO“T[L,‹2ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýÿÿÃÿì/úà×8¶±:¥µ&ª[@€€ EI endstream endobj 22 0 obj <> stream 0 0 0 20 40 63 d1 40 0 0 43 0 20 cm BI /IM true/W 40/H 43/BPC 1/F/CCF/DP<> ID & Á ,‚ÂzxAþ‰z4 =n“ÂÿÐkQþ£¯ÿû“Uï÷ì†Èô4öÓßÙ 'cü5µ†AŠ  EI endstream endobj 23 0 obj <> stream 59 0 0 0 0 0 d1 endstream endobj 24 0 obj <> stream 0 0 0 8 43 63 d1 43 0 0 55 0 8 cm BI /IM true/W 43/H 55/BPC 1/F/CCF/DP<> ID & Ü $ ôžŸá|>·ßOÿÿÿíxÿÿÿÿÿÿÿÿÿþP¼_ɪᬇŸÿÿÿÿ EI endstream endobj 25 0 obj <> stream 47 0 0 0 0 0 d1 endstream endobj 26 0 obj <> stream 0 0 0 0 38 63 d1 38 0 0 63 0 0 cm BI /IM true/W 38/H 63/BPC 1/F/CCF/DP<> ID &¨(»©5K ¼ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿóÂÇɪá…ÿùïOðžƒÿý…†¶¾  EI endstream endobj 27 0 obj <> stream 49 0 0 0 0 0 d1 endstream endobj 28 0 obj <> stream 0 0 0 0 45 65 d1 45 0 0 65 0 0 cm BI /IM true/W 45/H 65/BPC 1/F/CCF/DP<> ID &¡  ä§‚OAòô>‚ ÿ„zOÿWH?ëëýZáü}ÿÿß&¿È4gü4ïÿ}Âþßµýµ†þÃ[ Ž¼w²­`×`žCAÚþ  EI endstream endobj 29 0 obj <> stream 0 0 0 20 39 63 d1 39 0 0 43 0 20 cm BI /IM true/W 39/H 43/BPC 1/F/CCF/DP<> ID &¨Ø§@â"\QïB‚ôø ßO×Rj½ ±¬‚2Wª24˜K… XD@1^tâhÎ]'ÿ}…“Uù /cü>|…Ô»€€ EI endstream endobj 30 0 obj <> stream 48 0 0 0 0 0 d1 endstream endobj 31 0 obj <> stream 0 0 0 20 48 63 d1 48 0 0 43 0 20 cm BI /IM true/W 48/H 43/BPC 1/F/CCF/DP<> ID & „€‹"NkuÖŠ:„ ˆaè þ…ÿÿü?¿aû!ƒùN'cÃï‡È:ÈhOiÿüŽá?M-5úòŽ+öÖXf P  EI endstream endobj 32 0 obj <> stream 57 0 0 0 0 0 d1 endstream endobj 33 0 obj <> stream 46 0 0 0 0 0 d1 endstream endobj 34 0 obj <> stream 58 0 0 0 0 0 d1 endstream endobj 35 0 obj <> stream 0 0 0 0 43 65 d1 43 0 0 65 0 0 cm BI /IM true/W 43/H 65/BPC 1/F/CCF/DP<> ID &¹°‡@Oé‚ÎO‹ï¾S‰ä0`>ôßOÿ ¿ÿÿ¿kŠÿKô°\!°fAp}d*¼ µÐXD c)ÃEÅmx]u©ýÂOÿÿÿׇúíþa…Ø24üx}öAݯ ä5ü@ EI endstream endobj 36 0 obj <> stream 56 0 0 0 0 0 d1 endstream endobj 37 0 obj <> stream 55 0 0 0 0 0 d1 endstream endobj 38 0 obj <> stream 0 0 0 20 43 63 d1 43 0 0 43 0 20 cm BI /IM true/W 43/H 43/BPC 1/F/CCF/DP<> ID &¡œC0ƒÁ=ú$ô‚ôÂÝzO¯A­Gú×ø\•-ÿþ|2ø}×­þ×ý†–ÃÃÖÁ„Å~ÖÖ  @ EI endstream endobj 39 0 obj <> stream 0 0 0 0 42 63 d1 42 0 0 63 0 0 cm BI /IM true/W 42/H 63/BPC 1/F/CCF/DP<> ID &¡Ê?È£0žzz” áéûþýÿÚö¿öÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ]FŸ[P EI endstream endobj 40 0 obj <> stream 0 0 0 2 47 63 d1 47 0 0 61 0 2 cm BI /IM true/W 47/H 61/BPC 1/F/CCF/DP<> ID &¡MŒœ1L<*Ð|_ó¨ß0þúé¿øOíÿ÷¯‡ÿÿÿÿÿáëþ×놽¥ÚýsY…Å3KÚö ÈÏãÿÿÿÿÿùôÖ>MWj  EI endstream endobj 41 0 obj <> stream 60 0 0 0 0 0 d1 endstream endobj 42 0 obj <> stream 0 0 0 0 37 61 d1 37 0 0 61 0 0 cm BI /IM true/W 37/H 61/BPC 1/F/CCF/DP<> ID &©Eòj–Cÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ”)ɪP EI endstream endobj 43 0 obj <> stream 0 0 0 18 49 86 d1 49 0 0 68 0 18 cm BI /IM true/W 49/H 68/BPC 1/F/CCF/DP<> ID & ¹¨ê0ƒÁúD0ï[Ñ@hxAø x¦?ÿý¬š¬.×°\0`—û°¿ap¹0ÌÃN—õÿåŸÁÄ{²‚z =o§ÒoþŸÿÿÿÿû_öÒ'}ªzö 8bŽ÷†u– ab_ EI endstream endobj 44 0 obj <> stream 51 0 0 0 0 0 d1 endstream endobj 45 0 obj <> stream 0 0 0 20 55 63 d1 55 0 0 43 0 20 cm BI /IM true/W 55/H 43/BPC 1/F/CCF/DP<> ID &±Ð‰ši馟ûM5´ÓYx9âÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÝÿÿÿü8ÿa0¿ü8u˜]䄚݄ÂÚ   EI endstream endobj 46 0 obj <> stream 0 0 0 2 42 63 d1 42 0 0 61 0 2 cm BI /IM true/W 42/H 61/BPC 1/F/CCF/DP<> ID &°Zz~ÖÖ@ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÌ]}¨€ EI endstream endobj 47 0 obj <> stream 0 0 0 2 50 65 d1 50 0 0 63 0 2 cm BI /IM true/W 50/H 63/BPC 1/F/CCF/DP<> ID &¡ª|¾RtZ]>ɪSë%0“ÿÿÿÿÚü5øÿÿÿÿÿÿúÿõá/ãë…×ß|Ì/Áü7íÿáþ¿ÿÿÿÿú ÿ ëá/¯ÊŽ ¡Iª$Á@€ EI endstream endobj 48 0 obj <> stream 0 0 0 0 45 61 d1 45 0 0 61 0 0 cm BI /IM true/W 45/H 61/BPC 1/F/CCF/DP<> ID &±¬ Bq|š¥†²9ÿÿÿÿÿÿÿÿÿò¬ Bo‡ýó0pÿð߃~ÿûýÿ¿ÿÿÿ¯ýzÿëà—×…Ì-…Š…&©a @ EI endstream endobj 49 0 obj <> stream 0 0 0 0 41 65 d1 41 0 0 65 0 0 cm BI /IM true/W 41/H 65/BPC 1/F/CCF/DP<> ID &¡Êp¿"“ è?ä0žht›ÿþŸÿõ¿ÿOÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÚþõÿý¯ÿí¥Á‚ñþÂÃXad:€€ EI endstream endobj xref 0 51 0000000000 65535 f 0000019292 00000 n 0000019233 00000 n 0000018366 00000 n 0000000015 00000 n 0000018345 00000 n 0000019429 00000 n 0000018521 00000 n 0000020666 00000 n 0000020859 00000 n 0000020923 00000 n 0000021673 00000 n 0000021925 00000 n 0000022144 00000 n 0000022208 00000 n 0000022440 00000 n 0000022504 00000 n 0000022730 00000 n 0000022794 00000 n 0000023042 00000 n 0000023106 00000 n 0000023328 00000 n 0000023556 00000 n 0000023783 00000 n 0000023847 00000 n 0000024066 00000 n 0000024130 00000 n 0000024345 00000 n 0000024409 00000 n 0000024654 00000 n 0000024897 00000 n 0000024961 00000 n 0000025204 00000 n 0000025268 00000 n 0000025332 00000 n 0000025396 00000 n 0000025662 00000 n 0000025726 00000 n 0000025790 00000 n 0000026023 00000 n 0000026246 00000 n 0000026486 00000 n 0000026550 00000 n 0000026756 00000 n 0000027032 00000 n 0000027096 00000 n 0000027338 00000 n 0000027545 00000 n 0000027793 00000 n 0000028026 00000 n 0000019341 00000 n trailer << /Size 51 /Root 1 0 R /Info 50 0 R >> startxref 28260 %%EOF getdp-2.7.0-source/doc/texinfo/Jacobian_Lib.pro000644 001750 001750 00000001344 11266605602 023046 0ustar00geuzainegeuzaine000000 000000 /* ------------------------------------------------------------------- File "Jacobian_Lib.pro" Definition of a jacobian method ------------------------------------------------------------------- I N P U T --------- GlobalGroup : ----------- DomainInf Regions with Spherical Shell Transformation Parameters : ---------- Val_Rint, Val_Rext Inner and outer radius of the Spherical Shell of DomainInf */ Group { DefineGroup[ DomainInf ] ; DefineVariable[ Val_Rint, Val_Rext ] ; } Jacobian { { Name Vol ; Case { { Region DomainInf ; Jacobian VolSphShell {Val_Rint, Val_Rext} ; } { Region All ; Jacobian Vol ; } } } } getdp-2.7.0-source/doc/texinfo/Integration_Lib.pro000644 001750 001750 00000002044 11266605602 023621 0ustar00geuzainegeuzaine000000 000000 /* ------------------------------------------------------------------- File "Integration_Lib.pro" Definition of integration methods ------------------------------------------------------------------- */ Integration { { Name GradGrad ; Case { {Type Gauss ; Case { { GeoElement Triangle ; NumberOfPoints 4 ; } { GeoElement Quadrangle ; NumberOfPoints 4 ; } { GeoElement Tetrahedron ; NumberOfPoints 4 ; } { GeoElement Hexahedron ; NumberOfPoints 6 ; } { GeoElement Prism ; NumberOfPoints 9 ; } } } } } { Name CurlCurl ; Case { {Type Gauss ; Case { { GeoElement Triangle ; NumberOfPoints 4 ; } { GeoElement Quadrangle ; NumberOfPoints 4 ; } { GeoElement Tetrahedron ; NumberOfPoints 4 ; } { GeoElement Hexahedron ; NumberOfPoints 6 ; } { GeoElement Prism ; NumberOfPoints 9 ; } } } } } } getdp-2.7.0-source/doc/texinfo/MagDyn_av_2D.pro000644 001750 001750 00000014152 11266605602 022745 0ustar00geuzainegeuzaine000000 000000 /* ------------------------------------------------------------------- File "MagDyn_av_2D.pro" Magnetodynamics - Magnetic vector potential and electric scalar potential a-v formulation (2D) ------------------------------------------------------------------- I N P U T --------- GlobalGroup : (Extension '_Mag' is for Magnetic problem) ----------- Domain_Mag Whole magnetic domain DomainCC_Mag Nonconducting regions (not used) DomainC_Mag Conducting regions DomainS_Mag Inductor regions (Source) DomainV_Mag All regions in movement (for speed term) Function : -------- nu[] Magnetic reluctivity sigma[] Electric conductivity Velocity[] Velocity of regions Constraint : ---------- MagneticVectorPotential_2D Fixed magnetic vector potential (2D) (classical boundary condition) SourceCurrentDensityZ Fixed source current density (in Z direction) Voltage_2D Fixed voltage Current_2D Fixed Current Parameters : ---------- Freq Frequency (Hz) Parameters for time loop with theta scheme : Mag_Time0, Mag_TimeMax, Mag_DTime Initial time, Maximum time, Time step (s) Mag_Theta Theta (e.g. 1. : Implicit Euler, 0.5 : Cranck Nicholson) */ Group { DefineGroup[ Domain_Mag, DomainCC_Mag, DomainC_Mag, DomainS_Mag, DomainV_Mag ]; } Function { DefineFunction[ nu, sigma ]; DefineFunction[ Velocity ]; DefineVariable[ Freq ]; DefineVariable[ Mag_Time0, Mag_TimeMax, Mag_DTime, Mag_Theta ]; } FunctionSpace { // Magnetic vector potential a (b = curl a) { Name Hcurl_a_Mag_2D; Type Form1P; BasisFunction { // a = a s // e e { Name se; NameOfCoef ae; Function BF_PerpendicularEdge; Support Domain_Mag; Entity NodesOf[ All ]; } } Constraint { { NameOfCoef ae; EntityType NodesOf; NameOfConstraint MagneticVectorPotential_2D; } } } // Gradient of Electric scalar potential (2D) { Name Hregion_u_Mag_2D; Type Form1P; BasisFunction { { Name sr; NameOfCoef ur; Function BF_RegionZ; Support DomainC_Mag; Entity DomainC_Mag; } } GlobalQuantity { { Name U; Type AliasOf ; NameOfCoef ur; } { Name I; Type AssociatedWith; NameOfCoef ur; } } Constraint { { NameOfCoef U; EntityType Region; NameOfConstraint Voltage_2D; } { NameOfCoef I; EntityType Region; NameOfConstraint Current_2D; } } } // Source current density js (fully fixed space) { Name Hregion_j_Mag_2D; Type Vector; BasisFunction { { Name sr; NameOfCoef jsr; Function BF_RegionZ; Support DomainS_Mag; Entity DomainS_Mag; } } Constraint { { NameOfCoef jsr; EntityType Region; NameOfConstraint SourceCurrentDensityZ; } } } } Formulation { { Name Magnetodynamics_av_2D; Type FemEquation; Quantity { { Name a ; Type Local ; NameOfSpace Hcurl_a_Mag_2D; } { Name ur; Type Local ; NameOfSpace Hregion_u_Mag_2D; } { Name I ; Type Global; NameOfSpace Hregion_u_Mag_2D [I]; } { Name U ; Type Global; NameOfSpace Hregion_u_Mag_2D [U]; } { Name js; Type Local ; NameOfSpace Hregion_j_Mag_2D; } } Equation { Galerkin { [ nu[] * Dof{d a} , {d a} ]; In Domain_Mag; Jacobian Vol; Integration CurlCurl; } Galerkin { DtDof [ sigma[] * Dof{a} , {a} ]; In DomainC_Mag; Jacobian Vol; Integration CurlCurl; } Galerkin { [ sigma[] * Dof{ur} , {a} ]; In DomainC_Mag; Jacobian Vol; Integration CurlCurl; } Galerkin { [ - sigma[] * (Velocity[] *^ Dof{d a}) , {a} ]; In DomainV_Mag; Jacobian Vol; Integration CurlCurl; } Galerkin { [ - Dof{js} , {a} ]; In DomainS_Mag; Jacobian Vol; Integration CurlCurl; } Galerkin { DtDof [ sigma[] * Dof{a} , {ur} ]; In DomainC_Mag; Jacobian Vol; Integration CurlCurl; } Galerkin { [ sigma[] * Dof{ur} , {ur} ]; In DomainC_Mag; Jacobian Vol; Integration CurlCurl; } GlobalTerm { [ Dof{I} , {U} ]; In DomainC_Mag; } } } } Resolution { { Name MagDyn_av_2D; System { { Name Sys_Mag; NameOfFormulation Magnetodynamics_av_2D; Type ComplexValue; Frequency Freq; } } Operation { Generate[Sys_Mag]; Solve[Sys_Mag]; SaveSolution[Sys_Mag]; } } { Name MagDyn_t_av_2D; System { { Name Sys_Mag; NameOfFormulation Magnetodynamics_av_2D; } } Operation { InitSolution[Sys_Mag]; SaveSolution[Sys_Mag]; TimeLoopTheta[Mag_Time0, Mag_TimeMax, Mag_DTime, Mag_Theta] { Generate[Sys_Mag]; Solve[Sys_Mag]; SaveSolution[Sys_Mag]; } } } } PostProcessing { { Name MagDyn_av_2D; NameOfFormulation Magnetodynamics_av_2D; Quantity { { Name a; Value { Local { [ {a} ]; In Domain_Mag; Jacobian Vol; } } } { Name az; Value { Local { [ CompZ[{a}] ]; In Domain_Mag; Jacobian Vol; } } } { Name b; Value { Local { [ {d a} ]; In Domain_Mag; Jacobian Vol; } } } { Name h; Value { Local { [ nu[] * {d a} ]; In Domain_Mag; Jacobian Vol; } } } { Name j; Value { Local { [ - sigma[]*(Dt[{a}]+{ur}) ]; In DomainC_Mag; Jacobian Vol; } } } { Name jz; Value { Local { [ - sigma[]*CompZ[Dt[{a}]+{ur}] ]; In DomainC_Mag; Jacobian Vol; } } } { Name roj2; Value { Local { [ sigma[]*SquNorm[Dt[{a}]+{ur}] ]; In DomainC_Mag; Jacobian Vol; } } } { Name U; Value { Local { [ {U} ]; In DomainC_Mag; } } } { Name I; Value { Local { [ {I} ]; In DomainC_Mag; } } } } } } getdp-2.7.0-source/doc/texinfo/Core.txt000644 001750 001750 00000001541 11266605602 021460 0ustar00geuzainegeuzaine000000 000000 SurfaceGInf ______ / | -----____/ | \___ |____ AirInf \__ S | ------_ \ u | \ \ r | Air \ \ f | \ \ a | \ | c | | | e +------+ | | G | | | | e | Core | +---+ | | 0 | | |Ind| | | | | | | | | +------+---+---+---------+------+ \ SurfaceGh0 2D elements in: Air, AirInf, Core, Ind 1D elements in: SurfaceGh0, SurfaceGe0, SurfaceGInf (AirInf is a spherical shell corresponding to an infinite region) getdp-2.7.0-source/doc/texinfo/Strip.pdf000644 001750 001750 00000004671 11266605602 021632 0ustar00geuzainegeuzaine000000 000000 %PDF-1.1 %Çì¢ 4 0 obj << /Length 5 0 R >> stream q 1 i 0.472425 w 61.2255 23.0397 m 174.607 23.0397 l S 174.922 170.499 m 208.937 170.499 l S 61.5404 170.499 m 174.922 170.499 l S 208.685 22.9767 m 208.685 136.359 l S 208.685 136.359 m 208.685 170.373 l S 61.2255 23.0397 m 61.2255 136.422 l S 61.2255 136.422 m 61.2255 170.436 l S 27.2109 86.5336 m 58.9578 61.5896 l S 53.7927 67.5737 m 57.572 62.6604 l 51.903 65.18 l S Q q W 0 0 210 16.3 re 0 16.3 210 0.1 re 0 16.4 210 3.1 re 0 19.5 210 0.1 re 0 19.6 210 0.7 re 0 20.3 210 0.1 re 0 20.4 210 2.1 re 0 22.5 210 0.1 re 0 22.6 210 149.4 re n 1 i 0.472425 w 145.128 2.63096 m 126.987 20.7721 l S Q q 1 i 0.472425 w 131.396 14.2211 m 128.184 19.5753 l 133.538 16.3628 l S 208.559 39.921 m 95.1771 39.921 l S 174.607 23.0397 m 208.622 23.0397 l S 101.224 66.5658 m 87.6183 43.8894 l S 92.9094 49.7475 m 88.4371 45.4012 l 90.3269 51.3222 l S endstream endobj 5 0 obj 839 endobj 6 0 obj << /Type /Font /Name /R6 /Subtype /Type1 /BaseFont /Courier >> endobj 7 0 obj << /Length 8 0 R >> stream BT /R6 9.4485 Tf 1 0 0 1 128.184 103.793 Tm (Air) Tj ET 174.041 131.634 m 205.788 106.69 l S 200.622 112.675 m 204.402 107.761 l 198.733 110.281 l S Q q W 0 0 210 162.4 re 0 162.4 210 0.1 re 0 162.5 210 4.4 re 0 166.9 210 0.1 re 0 167 210 1.4 re 0 168.4 210 0.1 re 0 168.5 210 1.4 re 0 169.9 210 0.1 re 0 170 210 2 re n 1 i 0.472425 w 160.057 145.681 m 146.451 168.358 l S Q q 1 i 0.472425 w 149.159 160.925 m 147.27 166.909 l 151.742 162.5 l S 95.1141 39.921 m 61.3514 39.921 l S 95.0511 39.984 m 95.0511 42.6926 l S 95.0511 42.5666 m 61.2255 42.5666 l S BT /R6 9.4485 Tf 1 0 0 1 -0.000829688 91.0689 Tm (Surf_dn0) Tj 1 0 0 1 147.396 0.363345 Tm (Ground) Tj 1 0 0 1 144.624 28.5828 Tm (Diel1) Tj 1 0 0 1 103.807 69.7153 Tm (Line) Tj 1 0 0 1 125.475 134.595 Tm (Surf_Inf) Tj ET Q endstream endobj 8 0 obj 780 endobj 3 0 obj << /Type /Page /MediaBox [0 0 210 172] /Parent 2 0 R /Resources << /ProcSet [/PDF /Text] /Font << /R6 6 0 R >> >> /Contents [ 4 0 R 7 0 R ] >> endobj 2 0 obj << /Type /Pages /Kids [ 3 0 R ] /Count 1 >> endobj 1 0 obj << /Type /Catalog /Pages 2 0 R >> endobj 9 0 obj << /CreationDate (D:19990722085003) /Producer (Aladdin Ghostscript 5.03) >> endobj xref 0 10 0000000000 65535 f 0000002071 00000 n 0000002012 00000 n 0000001854 00000 n 0000000015 00000 n 0000000906 00000 n 0000000925 00000 n 0000001003 00000 n 0000001835 00000 n 0000002120 00000 n trailer << /Size 10 /Root 1 0 R /Info 9 0 R >> startxref 2211 %%EOF getdp-2.7.0-source/doc/texinfo/EleSta_v.pro000644 001750 001750 00000004422 11266605602 022254 0ustar00geuzainegeuzaine000000 000000 /* ------------------------------------------------------------------- File "EleSta_v.pro" Electrostatics - Electric scalar potential v formulation ------------------------------------------------------------------- I N P U T --------- Global Groups : (Extension '_Ele' is for Electric problem) ------------- Domain_Ele Whole electric domain (not used) DomainCC_Ele Nonconducting regions DomainC_Ele Conducting regions (not used) Function : -------- epsr[] Relative permittivity Constraint : ---------- ElectricScalarPotential Fixed electric scalar potential (classical boundary condition) Physical constants : ------------------ */ eps0 = 8.854187818e-12; Group { DefineGroup[ Domain_Ele, DomainCC_Ele, DomainC_Ele ]; } Function { DefineFunction[ epsr ]; } FunctionSpace { { Name Hgrad_v_Ele; Type Form0; BasisFunction { // v = v s , for all nodes // n n { Name sn; NameOfCoef vn; Function BF_Node; Support DomainCC_Ele; Entity NodesOf[ All ]; } } Constraint { { NameOfCoef vn; EntityType NodesOf; NameOfConstraint ElectricScalarPotential; } } } } Formulation { { Name Electrostatics_v; Type FemEquation; Quantity { { Name v; Type Local; NameOfSpace Hgrad_v_Ele; } } Equation { Galerkin { [ epsr[] * Dof{d v} , {d v} ]; In DomainCC_Ele; Jacobian Vol; Integration GradGrad; } } } } Resolution { { Name EleSta_v; System { { Name Sys_Ele; NameOfFormulation Electrostatics_v; } } Operation { Generate[Sys_Ele]; Solve[Sys_Ele]; SaveSolution[Sys_Ele]; } } } PostProcessing { { Name EleSta_v; NameOfFormulation Electrostatics_v; Quantity { { Name v; Value { Local { [ {v} ]; In DomainCC_Ele; Jacobian Vol; } } } { Name e; Value { Local { [ -{d v} ]; In DomainCC_Ele; Jacobian Vol; } } } { Name d; Value { Local { [ -eps0*epsr[] * {d v} ]; In DomainCC_Ele; Jacobian Vol; } } } } } } getdp-2.7.0-source/doc/texinfo/Strip.txt000644 001750 001750 00000001364 11266605602 021674 0ustar00geuzainegeuzaine000000 000000 SurfInf / / +------------------------------------+ / | | / | Air |/ | | | Line | | / / / | 2D elements in: +-------/---+ / | Air, Diel1 / |- | +-----------+------------------------+ 1D elements in: | Diel1 | Line, Ground, SurfInf | | +------------------------------------+ \ Ground getdp-2.7.0-source/doc/texinfo/texinfo.tex000644 001750 001750 00001052340 11266605602 022231 0ustar00geuzainegeuzaine000000 000000 % texinfo.tex -- TeX macros to handle Texinfo files. % % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % \def\texinfoversion{2007-09-03.05} % % Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, 2007, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, % 2007 Free Software Foundation, Inc. % % This texinfo.tex file is free software: you can redistribute it and/or % modify it under the terms of the GNU General Public License as % published by the Free Software Foundation, either version 3 of the % License, or (at your option) any later version. % % This texinfo.tex file is distributed in the hope that it will be % useful, but WITHOUT ANY WARRANTY; without even the implied warranty % of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU % General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program. If not, see . % % As a special exception, when this file is read by TeX when processing % a Texinfo source document, you may use the result without % restriction. (This has been our intent since Texinfo was invented.) % % Please try the latest version of texinfo.tex before submitting bug % reports; you can get the latest version from: % http://www.gnu.org/software/texinfo/ (the Texinfo home page), or % ftp://tug.org/tex/texinfo.tex % (and all CTAN mirrors, see http://www.ctan.org). % The texinfo.tex in any given distribution could well be out % of date, so if that's what you're using, please check. % % Send bug reports to bug-texinfo@gnu.org. Please include including a % complete document in each bug report with which we can reproduce the % problem. Patches are, of course, greatly appreciated. % % To process a Texinfo manual with TeX, it's most reliable to use the % texi2dvi shell script that comes with the distribution. For a simple % manual foo.texi, however, you can get away with this: % tex foo.texi % texindex foo.?? % tex foo.texi % tex foo.texi % dvips foo.dvi -o # or whatever; this makes foo.ps. % The extra TeX runs get the cross-reference information correct. % Sometimes one run after texindex suffices, and sometimes you need more % than two; texi2dvi does it as many times as necessary. % % It is possible to adapt texinfo.tex for other languages, to some % extent. You can get the existing language-specific files from the % full Texinfo distribution. % % The GNU Texinfo home page is http://www.gnu.org/software/texinfo. \message{Loading texinfo [version \texinfoversion]:} % If in a .fmt file, print the version number % and turn on active characters that we couldn't do earlier because % they might have appeared in the input file name. \everyjob{\message{[Texinfo version \texinfoversion]}% \catcode`+=\active \catcode`\_=\active} \chardef\other=12 % We never want plain's \outer definition of \+ in Texinfo. % For @tex, we can use \tabalign. \let\+ = \relax % Save some plain tex macros whose names we will redefine. \let\ptexb=\b \let\ptexbullet=\bullet \let\ptexc=\c \let\ptexcomma=\, \let\ptexdot=\. \let\ptexdots=\dots \let\ptexend=\end \let\ptexequiv=\equiv \let\ptexexclam=\! \let\ptexfootnote=\footnote \let\ptexgtr=> \let\ptexhat=^ \let\ptexi=\i \let\ptexindent=\indent \let\ptexinsert=\insert \let\ptexlbrace=\{ \let\ptexless=< \let\ptexnewwrite\newwrite \let\ptexnoindent=\noindent \let\ptexplus=+ \let\ptexrbrace=\} \let\ptexslash=\/ \let\ptexstar=\* \let\ptext=\t % If this character appears in an error message or help string, it % starts a new line in the output. \newlinechar = `^^J % Use TeX 3.0's \inputlineno to get the line number, for better error % messages, but if we're using an old version of TeX, don't do anything. % \ifx\inputlineno\thisisundefined \let\linenumber = \empty % Pre-3.0. \else \def\linenumber{l.\the\inputlineno:\space} \fi % Set up fixed words for English if not already set. \ifx\putwordAppendix\undefined \gdef\putwordAppendix{Appendix}\fi \ifx\putwordChapter\undefined \gdef\putwordChapter{Chapter}\fi \ifx\putwordfile\undefined \gdef\putwordfile{file}\fi \ifx\putwordin\undefined \gdef\putwordin{in}\fi \ifx\putwordIndexIsEmpty\undefined \gdef\putwordIndexIsEmpty{(Index is empty)}\fi \ifx\putwordIndexNonexistent\undefined \gdef\putwordIndexNonexistent{(Index is nonexistent)}\fi \ifx\putwordInfo\undefined \gdef\putwordInfo{Info}\fi \ifx\putwordInstanceVariableof\undefined \gdef\putwordInstanceVariableof{Instance Variable of}\fi \ifx\putwordMethodon\undefined \gdef\putwordMethodon{Method on}\fi \ifx\putwordNoTitle\undefined \gdef\putwordNoTitle{No Title}\fi \ifx\putwordof\undefined \gdef\putwordof{of}\fi \ifx\putwordon\undefined \gdef\putwordon{on}\fi \ifx\putwordpage\undefined \gdef\putwordpage{page}\fi \ifx\putwordsection\undefined \gdef\putwordsection{section}\fi \ifx\putwordSection\undefined \gdef\putwordSection{Section}\fi \ifx\putwordsee\undefined \gdef\putwordsee{see}\fi \ifx\putwordSee\undefined \gdef\putwordSee{See}\fi \ifx\putwordShortTOC\undefined \gdef\putwordShortTOC{Short Contents}\fi \ifx\putwordTOC\undefined \gdef\putwordTOC{Table of Contents}\fi % \ifx\putwordMJan\undefined \gdef\putwordMJan{January}\fi \ifx\putwordMFeb\undefined \gdef\putwordMFeb{February}\fi \ifx\putwordMMar\undefined \gdef\putwordMMar{March}\fi \ifx\putwordMApr\undefined \gdef\putwordMApr{April}\fi \ifx\putwordMMay\undefined \gdef\putwordMMay{May}\fi \ifx\putwordMJun\undefined \gdef\putwordMJun{June}\fi \ifx\putwordMJul\undefined \gdef\putwordMJul{July}\fi \ifx\putwordMAug\undefined \gdef\putwordMAug{August}\fi \ifx\putwordMSep\undefined \gdef\putwordMSep{September}\fi \ifx\putwordMOct\undefined \gdef\putwordMOct{October}\fi \ifx\putwordMNov\undefined \gdef\putwordMNov{November}\fi \ifx\putwordMDec\undefined \gdef\putwordMDec{December}\fi % \ifx\putwordDefmac\undefined \gdef\putwordDefmac{Macro}\fi \ifx\putwordDefspec\undefined \gdef\putwordDefspec{Special Form}\fi \ifx\putwordDefvar\undefined \gdef\putwordDefvar{Variable}\fi \ifx\putwordDefopt\undefined \gdef\putwordDefopt{User Option}\fi \ifx\putwordDeffunc\undefined \gdef\putwordDeffunc{Function}\fi % Since the category of space is not known, we have to be careful. \chardef\spacecat = 10 \def\spaceisspace{\catcode`\ =\spacecat} % sometimes characters are active, so we need control sequences. \chardef\colonChar = `\: \chardef\commaChar = `\, \chardef\dashChar = `\- \chardef\dotChar = `\. \chardef\exclamChar= `\! \chardef\lquoteChar= `\` \chardef\questChar = `\? \chardef\rquoteChar= `\' \chardef\semiChar = `\; \chardef\underChar = `\_ % Ignore a token. % \def\gobble#1{} % The following is used inside several \edef's. \def\makecsname#1{\expandafter\noexpand\csname#1\endcsname} % Hyphenation fixes. \hyphenation{ Flor-i-da Ghost-script Ghost-view Mac-OS Post-Script ap-pen-dix bit-map bit-maps data-base data-bases eshell fall-ing half-way long-est man-u-script man-u-scripts mini-buf-fer mini-buf-fers over-view par-a-digm par-a-digms rath-er rec-tan-gu-lar ro-bot-ics se-vere-ly set-up spa-ces spell-ing spell-ings stand-alone strong-est time-stamp time-stamps which-ever white-space wide-spread wrap-around } % Margin to add to right of even pages, to left of odd pages. \newdimen\bindingoffset \newdimen\normaloffset \newdimen\pagewidth \newdimen\pageheight % For a final copy, take out the rectangles % that mark overfull boxes (in case you have decided % that the text looks ok even though it passes the margin). % \def\finalout{\overfullrule=0pt} % @| inserts a changebar to the left of the current line. It should % surround any changed text. This approach does *not* work if the % change spans more than two lines of output. To handle that, we would % have adopt a much more difficult approach (putting marks into the main % vertical list for the beginning and end of each change). % \def\|{% % \vadjust can only be used in horizontal mode. \leavevmode % % Append this vertical mode material after the current line in the output. \vadjust{% % We want to insert a rule with the height and depth of the current % leading; that is exactly what \strutbox is supposed to record. \vskip-\baselineskip % % \vadjust-items are inserted at the left edge of the type. So % the \llap here moves out into the left-hand margin. \llap{% % % For a thicker or thinner bar, change the `1pt'. \vrule height\baselineskip width1pt % % This is the space between the bar and the text. \hskip 12pt }% }% } % Sometimes it is convenient to have everything in the transcript file % and nothing on the terminal. We don't just call \tracingall here, % since that produces some useless output on the terminal. We also make % some effort to order the tracing commands to reduce output in the log % file; cf. trace.sty in LaTeX. % \def\gloggingall{\begingroup \globaldefs = 1 \loggingall \endgroup}% \def\loggingall{% \tracingstats2 \tracingpages1 \tracinglostchars2 % 2 gives us more in etex \tracingparagraphs1 \tracingoutput1 \tracingmacros2 \tracingrestores1 \showboxbreadth\maxdimen \showboxdepth\maxdimen \ifx\eTeXversion\undefined\else % etex gives us more logging \tracingscantokens1 \tracingifs1 \tracinggroups1 \tracingnesting2 \tracingassigns1 \fi \tracingcommands3 % 3 gives us more in etex \errorcontextlines16 }% % add check for \lastpenalty to plain's definitions. If the last thing % we did was a \nobreak, we don't want to insert more space. % \def\smallbreak{\ifnum\lastpenalty<10000\par\ifdim\lastskip<\smallskipamount \removelastskip\penalty-50\smallskip\fi\fi} \def\medbreak{\ifnum\lastpenalty<10000\par\ifdim\lastskip<\medskipamount \removelastskip\penalty-100\medskip\fi\fi} \def\bigbreak{\ifnum\lastpenalty<10000\par\ifdim\lastskip<\bigskipamount \removelastskip\penalty-200\bigskip\fi\fi} % For @cropmarks command. % Do @cropmarks to get crop marks. % \newif\ifcropmarks \let\cropmarks = \cropmarkstrue % % Dimensions to add cropmarks at corners. % Added by P. A. MacKay, 12 Nov. 1986 % \newdimen\outerhsize \newdimen\outervsize % set by the paper size routines \newdimen\cornerlong \cornerlong=1pc \newdimen\cornerthick \cornerthick=.3pt \newdimen\topandbottommargin \topandbottommargin=.75in % Output a mark which sets \thischapter, \thissection and \thiscolor. % We dump everything together because we only have one kind of mark. % This works because we only use \botmark / \topmark, not \firstmark. % % A mark contains a subexpression of the \ifcase ... \fi construct. % \get*marks macros below extract the needed part using \ifcase. % % Another complication is to let the user choose whether \thischapter % (\thissection) refers to the chapter (section) in effect at the top % of a page, or that at the bottom of a page. The solution is % described on page 260 of The TeXbook. It involves outputting two % marks for the sectioning macros, one before the section break, and % one after. I won't pretend I can describe this better than DEK... \def\domark{% \toks0=\expandafter{\lastchapterdefs}% \toks2=\expandafter{\lastsectiondefs}% \toks4=\expandafter{\prevchapterdefs}% \toks6=\expandafter{\prevsectiondefs}% \toks8=\expandafter{\lastcolordefs}% \mark{% \the\toks0 \the\toks2 \noexpand\or \the\toks4 \the\toks6 \noexpand\else \the\toks8 }% } % \topmark doesn't work for the very first chapter (after the title % page or the contents), so we use \firstmark there -- this gets us % the mark with the chapter defs, unless the user sneaks in, e.g., % @setcolor (or @url, or @link, etc.) between @contents and the very % first @chapter. \def\gettopheadingmarks{% \ifcase0\topmark\fi \ifx\thischapter\empty \ifcase0\firstmark\fi \fi } \def\getbottomheadingmarks{\ifcase1\botmark\fi} \def\getcolormarks{\ifcase2\topmark\fi} % Avoid "undefined control sequence" errors. \def\lastchapterdefs{} \def\lastsectiondefs{} \def\prevchapterdefs{} \def\prevsectiondefs{} \def\lastcolordefs{} % Main output routine. \chardef\PAGE = 255 \output = {\onepageout{\pagecontents\PAGE}} \newbox\headlinebox \newbox\footlinebox % \onepageout takes a vbox as an argument. Note that \pagecontents % does insertions, but you have to call it yourself. \def\onepageout#1{% \ifcropmarks \hoffset=0pt \else \hoffset=\normaloffset \fi % \ifodd\pageno \advance\hoffset by \bindingoffset \else \advance\hoffset by -\bindingoffset\fi % % Do this outside of the \shipout so @code etc. will be expanded in % the headline as they should be, not taken literally (outputting ''code). \ifodd\pageno \getoddheadingmarks \else \getevenheadingmarks \fi \setbox\headlinebox = \vbox{\let\hsize=\pagewidth \makeheadline}% \ifodd\pageno \getoddfootingmarks \else \getevenfootingmarks \fi \setbox\footlinebox = \vbox{\let\hsize=\pagewidth \makefootline}% % {% % Have to do this stuff outside the \shipout because we want it to % take effect in \write's, yet the group defined by the \vbox ends % before the \shipout runs. % \indexdummies % don't expand commands in the output. \normalturnoffactive % \ in index entries must not stay \, e.g., if % the page break happens to be in the middle of an example. % We don't want .vr (or whatever) entries like this: % \entry{{\tt \indexbackslash }acronym}{32}{\code {\acronym}} % "\acronym" won't work when it's read back in; % it needs to be % {\code {{\tt \backslashcurfont }acronym} \shipout\vbox{% % Do this early so pdf references go to the beginning of the page. \ifpdfmakepagedest \pdfdest name{\the\pageno} xyz\fi % \ifcropmarks \vbox to \outervsize\bgroup \hsize = \outerhsize \vskip-\topandbottommargin \vtop to0pt{% \line{\ewtop\hfil\ewtop}% \nointerlineskip \line{% \vbox{\moveleft\cornerthick\nstop}% \hfill \vbox{\moveright\cornerthick\nstop}% }% \vss}% \vskip\topandbottommargin \line\bgroup \hfil % center the page within the outer (page) hsize. \ifodd\pageno\hskip\bindingoffset\fi \vbox\bgroup \fi % \unvbox\headlinebox \pagebody{#1}% \ifdim\ht\footlinebox > 0pt % Only leave this space if the footline is nonempty. % (We lessened \vsize for it in \oddfootingyyy.) % The \baselineskip=24pt in plain's \makefootline has no effect. \vskip 24pt \unvbox\footlinebox \fi % \ifcropmarks \egroup % end of \vbox\bgroup \hfil\egroup % end of (centering) \line\bgroup \vskip\topandbottommargin plus1fill minus1fill \boxmaxdepth = \cornerthick \vbox to0pt{\vss \line{% \vbox{\moveleft\cornerthick\nsbot}% \hfill \vbox{\moveright\cornerthick\nsbot}% }% \nointerlineskip \line{\ewbot\hfil\ewbot}% }% \egroup % \vbox from first cropmarks clause \fi }% end of \shipout\vbox }% end of group with \indexdummies \advancepageno \ifnum\outputpenalty>-20000 \else\dosupereject\fi } \newinsert\margin \dimen\margin=\maxdimen \def\pagebody#1{\vbox to\pageheight{\boxmaxdepth=\maxdepth #1}} {\catcode`\@ =11 \gdef\pagecontents#1{\ifvoid\topins\else\unvbox\topins\fi % marginal hacks, juha@viisa.uucp (Juha Takala) \ifvoid\margin\else % marginal info is present \rlap{\kern\hsize\vbox to\z@{\kern1pt\box\margin \vss}}\fi \dimen@=\dp#1\relax \unvbox#1\relax \ifvoid\footins\else\vskip\skip\footins\footnoterule \unvbox\footins\fi \ifr@ggedbottom \kern-\dimen@ \vfil \fi} } % Here are the rules for the cropmarks. Note that they are % offset so that the space between them is truly \outerhsize or \outervsize % (P. A. MacKay, 12 November, 1986) % \def\ewtop{\vrule height\cornerthick depth0pt width\cornerlong} \def\nstop{\vbox {\hrule height\cornerthick depth\cornerlong width\cornerthick}} \def\ewbot{\vrule height0pt depth\cornerthick width\cornerlong} \def\nsbot{\vbox {\hrule height\cornerlong depth\cornerthick width\cornerthick}} % Parse an argument, then pass it to #1. The argument is the rest of % the input line (except we remove a trailing comment). #1 should be a % macro which expects an ordinary undelimited TeX argument. % \def\parsearg{\parseargusing{}} \def\parseargusing#1#2{% \def\argtorun{#2}% \begingroup \obeylines \spaceisspace #1% \parseargline\empty% Insert the \empty token, see \finishparsearg below. } {\obeylines % \gdef\parseargline#1^^M{% \endgroup % End of the group started in \parsearg. \argremovecomment #1\comment\ArgTerm% }% } % First remove any @comment, then any @c comment. \def\argremovecomment#1\comment#2\ArgTerm{\argremovec #1\c\ArgTerm} \def\argremovec#1\c#2\ArgTerm{\argcheckspaces#1\^^M\ArgTerm} % Each occurence of `\^^M' or `\^^M' is replaced by a single space. % % \argremovec might leave us with trailing space, e.g., % @end itemize @c foo % This space token undergoes the same procedure and is eventually removed % by \finishparsearg. % \def\argcheckspaces#1\^^M{\argcheckspacesX#1\^^M \^^M} \def\argcheckspacesX#1 \^^M{\argcheckspacesY#1\^^M} \def\argcheckspacesY#1\^^M#2\^^M#3\ArgTerm{% \def\temp{#3}% \ifx\temp\empty % Do not use \next, perhaps the caller of \parsearg uses it; reuse \temp: \let\temp\finishparsearg \else \let\temp\argcheckspaces \fi % Put the space token in: \temp#1 #3\ArgTerm } % If a _delimited_ argument is enclosed in braces, they get stripped; so % to get _exactly_ the rest of the line, we had to prevent such situation. % We prepended an \empty token at the very beginning and we expand it now, % just before passing the control to \argtorun. % (Similarily, we have to think about #3 of \argcheckspacesY above: it is % either the null string, or it ends with \^^M---thus there is no danger % that a pair of braces would be stripped. % % But first, we have to remove the trailing space token. % \def\finishparsearg#1 \ArgTerm{\expandafter\argtorun\expandafter{#1}} % \parseargdef\foo{...} % is roughly equivalent to % \def\foo{\parsearg\Xfoo} % \def\Xfoo#1{...} % % Actually, I use \csname\string\foo\endcsname, ie. \\foo, as it is my % favourite TeX trick. --kasal, 16nov03 \def\parseargdef#1{% \expandafter \doparseargdef \csname\string#1\endcsname #1% } \def\doparseargdef#1#2{% \def#2{\parsearg#1}% \def#1##1% } % Several utility definitions with active space: { \obeyspaces \gdef\obeyedspace{ } % Make each space character in the input produce a normal interword % space in the output. Don't allow a line break at this space, as this % is used only in environments like @example, where each line of input % should produce a line of output anyway. % \gdef\sepspaces{\obeyspaces\let =\tie} % If an index command is used in an @example environment, any spaces % therein should become regular spaces in the raw index file, not the % expansion of \tie (\leavevmode \penalty \@M \ ). \gdef\unsepspaces{\let =\space} } \def\flushcr{\ifx\par\lisppar \def\next##1{}\else \let\next=\relax \fi \next} % Define the framework for environments in texinfo.tex. It's used like this: % % \envdef\foo{...} % \def\Efoo{...} % % It's the responsibility of \envdef to insert \begingroup before the % actual body; @end closes the group after calling \Efoo. \envdef also % defines \thisenv, so the current environment is known; @end checks % whether the environment name matches. The \checkenv macro can also be % used to check whether the current environment is the one expected. % % Non-false conditionals (@iftex, @ifset) don't fit into this, so they % are not treated as enviroments; they don't open a group. (The % implementation of @end takes care not to call \endgroup in this % special case.) % At runtime, environments start with this: \def\startenvironment#1{\begingroup\def\thisenv{#1}} % initialize \let\thisenv\empty % ... but they get defined via ``\envdef\foo{...}'': \long\def\envdef#1#2{\def#1{\startenvironment#1#2}} \def\envparseargdef#1#2{\parseargdef#1{\startenvironment#1#2}} % Check whether we're in the right environment: \def\checkenv#1{% \def\temp{#1}% \ifx\thisenv\temp \else \badenverr \fi } % Evironment mismatch, #1 expected: \def\badenverr{% \errhelp = \EMsimple \errmessage{This command can appear only \inenvironment\temp, not \inenvironment\thisenv}% } \def\inenvironment#1{% \ifx#1\empty out of any environment% \else in environment \expandafter\string#1% \fi } % @end foo executes the definition of \Efoo. % But first, it executes a specialized version of \checkenv % \parseargdef\end{% \if 1\csname iscond.#1\endcsname \else % The general wording of \badenverr may not be ideal, but... --kasal, 06nov03 \expandafter\checkenv\csname#1\endcsname \csname E#1\endcsname \endgroup \fi } \newhelp\EMsimple{Press RETURN to continue.} %% Simple single-character @ commands % @@ prints an @ % Kludge this until the fonts are right (grr). \def\@{{\tt\char64}} % This is turned off because it was never documented % and you can use @w{...} around a quote to suppress ligatures. %% Define @` and @' to be the same as ` and ' %% but suppressing ligatures. %\def\`{{`}} %\def\'{{'}} % Used to generate quoted braces. \def\mylbrace {{\tt\char123}} \def\myrbrace {{\tt\char125}} \let\{=\mylbrace \let\}=\myrbrace \begingroup % Definitions to produce \{ and \} commands for indices, % and @{ and @} for the aux/toc files. \catcode`\{ = \other \catcode`\} = \other \catcode`\[ = 1 \catcode`\] = 2 \catcode`\! = 0 \catcode`\\ = \other !gdef!lbracecmd[\{]% !gdef!rbracecmd[\}]% !gdef!lbraceatcmd[@{]% !gdef!rbraceatcmd[@}]% !endgroup % @comma{} to avoid , parsing problems. \let\comma = , % Accents: @, @dotaccent @ringaccent @ubaraccent @udotaccent % Others are defined by plain TeX: @` @' @" @^ @~ @= @u @v @H. \let\, = \c \let\dotaccent = \. \def\ringaccent#1{{\accent23 #1}} \let\tieaccent = \t \let\ubaraccent = \b \let\udotaccent = \d % Other special characters: @questiondown @exclamdown @ordf @ordm % Plain TeX defines: @AA @AE @O @OE @L (plus lowercase versions) @ss. \def\questiondown{?`} \def\exclamdown{!`} \def\ordf{\leavevmode\raise1ex\hbox{\selectfonts\lllsize \underbar{a}}} \def\ordm{\leavevmode\raise1ex\hbox{\selectfonts\lllsize \underbar{o}}} % Dotless i and dotless j, used for accents. \def\imacro{i} \def\jmacro{j} \def\dotless#1{% \def\temp{#1}% \ifx\temp\imacro \ptexi \else\ifx\temp\jmacro \j \else \errmessage{@dotless can be used only with i or j}% \fi\fi } % The \TeX{} logo, as in plain, but resetting the spacing so that a % period following counts as ending a sentence. (Idea found in latex.) % \edef\TeX{\TeX \spacefactor=1000 } % @LaTeX{} logo. Not quite the same results as the definition in % latex.ltx, since we use a different font for the raised A; it's most % convenient for us to use an explicitly smaller font, rather than using % the \scriptstyle font (since we don't reset \scriptstyle and % \scriptscriptstyle). % \def\LaTeX{% L\kern-.36em {\setbox0=\hbox{T}% \vbox to \ht0{\hbox{\selectfonts\lllsize A}\vss}}% \kern-.15em \TeX } % Be sure we're in horizontal mode when doing a tie, since we make space % equivalent to this in @example-like environments. Otherwise, a space % at the beginning of a line will start with \penalty -- and % since \penalty is valid in vertical mode, we'd end up putting the % penalty on the vertical list instead of in the new paragraph. {\catcode`@ = 11 % Avoid using \@M directly, because that causes trouble % if the definition is written into an index file. \global\let\tiepenalty = \@M \gdef\tie{\leavevmode\penalty\tiepenalty\ } } % @: forces normal size whitespace following. \def\:{\spacefactor=1000 } % @* forces a line break. \def\*{\hfil\break\hbox{}\ignorespaces} % @/ allows a line break. \let\/=\allowbreak % @. is an end-of-sentence period. \def\.{.\spacefactor=\endofsentencespacefactor\space} % @! is an end-of-sentence bang. \def\!{!\spacefactor=\endofsentencespacefactor\space} % @? is an end-of-sentence query. \def\?{?\spacefactor=\endofsentencespacefactor\space} % @frenchspacing on|off says whether to put extra space after punctuation. % \def\onword{on} \def\offword{off} % \parseargdef\frenchspacing{% \def\temp{#1}% \ifx\temp\onword \plainfrenchspacing \else\ifx\temp\offword \plainnonfrenchspacing \else \errhelp = \EMsimple \errmessage{Unknown @frenchspacing option `\temp', must be on/off}% \fi\fi } % @w prevents a word break. Without the \leavevmode, @w at the % beginning of a paragraph, when TeX is still in vertical mode, would % produce a whole line of output instead of starting the paragraph. \def\w#1{\leavevmode\hbox{#1}} % @group ... @end group forces ... to be all on one page, by enclosing % it in a TeX vbox. We use \vtop instead of \vbox to construct the box % to keep its height that of a normal line. According to the rules for % \topskip (p.114 of the TeXbook), the glue inserted is % max (\topskip - \ht (first item), 0). If that height is large, % therefore, no glue is inserted, and the space between the headline and % the text is small, which looks bad. % % Another complication is that the group might be very large. This can % cause the glue on the previous page to be unduly stretched, because it % does not have much material. In this case, it's better to add an % explicit \vfill so that the extra space is at the bottom. The % threshold for doing this is if the group is more than \vfilllimit % percent of a page (\vfilllimit can be changed inside of @tex). % \newbox\groupbox \def\vfilllimit{0.7} % \envdef\group{% \ifnum\catcode`\^^M=\active \else \errhelp = \groupinvalidhelp \errmessage{@group invalid in context where filling is enabled}% \fi \startsavinginserts % \setbox\groupbox = \vtop\bgroup % Do @comment since we are called inside an environment such as % @example, where each end-of-line in the input causes an % end-of-line in the output. We don't want the end-of-line after % the `@group' to put extra space in the output. Since @group % should appear on a line by itself (according to the Texinfo % manual), we don't worry about eating any user text. \comment } % % The \vtop produces a box with normal height and large depth; thus, TeX puts % \baselineskip glue before it, and (when the next line of text is done) % \lineskip glue after it. Thus, space below is not quite equal to space % above. But it's pretty close. \def\Egroup{% % To get correct interline space between the last line of the group % and the first line afterwards, we have to propagate \prevdepth. \endgraf % Not \par, as it may have been set to \lisppar. \global\dimen1 = \prevdepth \egroup % End the \vtop. % \dimen0 is the vertical size of the group's box. \dimen0 = \ht\groupbox \advance\dimen0 by \dp\groupbox % \dimen2 is how much space is left on the page (more or less). \dimen2 = \pageheight \advance\dimen2 by -\pagetotal % if the group doesn't fit on the current page, and it's a big big % group, force a page break. \ifdim \dimen0 > \dimen2 \ifdim \pagetotal < \vfilllimit\pageheight \page \fi \fi \box\groupbox \prevdepth = \dimen1 \checkinserts } % % TeX puts in an \escapechar (i.e., `@') at the beginning of the help % message, so this ends up printing `@group can only ...'. % \newhelp\groupinvalidhelp{% group can only be used in environments such as @example,^^J% where each line of input produces a line of output.} % @need space-in-mils % forces a page break if there is not space-in-mils remaining. \newdimen\mil \mil=0.001in % Old definition--didn't work. %\parseargdef\need{\par % %% This method tries to make TeX break the page naturally %% if the depth of the box does not fit. %{\baselineskip=0pt% %\vtop to #1\mil{\vfil}\kern -#1\mil\nobreak %\prevdepth=-1000pt %}} \parseargdef\need{% % Ensure vertical mode, so we don't make a big box in the middle of a % paragraph. \par % % If the @need value is less than one line space, it's useless. \dimen0 = #1\mil \dimen2 = \ht\strutbox \advance\dimen2 by \dp\strutbox \ifdim\dimen0 > \dimen2 % % Do a \strut just to make the height of this box be normal, so the % normal leading is inserted relative to the preceding line. % And a page break here is fine. \vtop to #1\mil{\strut\vfil}% % % TeX does not even consider page breaks if a penalty added to the % main vertical list is 10000 or more. But in order to see if the % empty box we just added fits on the page, we must make it consider % page breaks. On the other hand, we don't want to actually break the % page after the empty box. So we use a penalty of 9999. % % There is an extremely small chance that TeX will actually break the % page at this \penalty, if there are no other feasible breakpoints in % sight. (If the user is using lots of big @group commands, which % almost-but-not-quite fill up a page, TeX will have a hard time doing % good page breaking, for example.) However, I could not construct an % example where a page broke at this \penalty; if it happens in a real % document, then we can reconsider our strategy. \penalty9999 % % Back up by the size of the box, whether we did a page break or not. \kern -#1\mil % % Do not allow a page break right after this kern. \nobreak \fi } % @br forces paragraph break (and is undocumented). \let\br = \par % @page forces the start of a new page. % \def\page{\par\vfill\supereject} % @exdent text.... % outputs text on separate line in roman font, starting at standard page margin % This records the amount of indent in the innermost environment. % That's how much \exdent should take out. \newskip\exdentamount % This defn is used inside fill environments such as @defun. \parseargdef\exdent{\hfil\break\hbox{\kern -\exdentamount{\rm#1}}\hfil\break} % This defn is used inside nofill environments such as @example. \parseargdef\nofillexdent{{\advance \leftskip by -\exdentamount \leftline{\hskip\leftskip{\rm#1}}}} % @inmargin{WHICH}{TEXT} puts TEXT in the WHICH margin next to the current % paragraph. For more general purposes, use the \margin insertion % class. WHICH is `l' or `r'. % \newskip\inmarginspacing \inmarginspacing=1cm \def\strutdepth{\dp\strutbox} % \def\doinmargin#1#2{\strut\vadjust{% \nobreak \kern-\strutdepth \vtop to \strutdepth{% \baselineskip=\strutdepth \vss % if you have multiple lines of stuff to put here, you'll need to % make the vbox yourself of the appropriate size. \ifx#1l% \llap{\ignorespaces #2\hskip\inmarginspacing}% \else \rlap{\hskip\hsize \hskip\inmarginspacing \ignorespaces #2}% \fi \null }% }} \def\inleftmargin{\doinmargin l} \def\inrightmargin{\doinmargin r} % % @inmargin{TEXT [, RIGHT-TEXT]} % (if RIGHT-TEXT is given, use TEXT for left page, RIGHT-TEXT for right; % else use TEXT for both). % \def\inmargin#1{\parseinmargin #1,,\finish} \def\parseinmargin#1,#2,#3\finish{% not perfect, but better than nothing. \setbox0 = \hbox{\ignorespaces #2}% \ifdim\wd0 > 0pt \def\lefttext{#1}% have both texts \def\righttext{#2}% \else \def\lefttext{#1}% have only one text \def\righttext{#1}% \fi % \ifodd\pageno \def\temp{\inrightmargin\righttext}% odd page -> outside is right margin \else \def\temp{\inleftmargin\lefttext}% \fi \temp } % @include file insert text of that file as input. % \def\include{\parseargusing\filenamecatcodes\includezzz} \def\includezzz#1{% \pushthisfilestack \def\thisfile{#1}% {% \makevalueexpandable \def\temp{\input #1 }% \expandafter }\temp \popthisfilestack } \def\filenamecatcodes{% \catcode`\\=\other \catcode`~=\other \catcode`^=\other \catcode`_=\other \catcode`|=\other \catcode`<=\other \catcode`>=\other \catcode`+=\other \catcode`-=\other } \def\pushthisfilestack{% \expandafter\pushthisfilestackX\popthisfilestack\StackTerm } \def\pushthisfilestackX{% \expandafter\pushthisfilestackY\thisfile\StackTerm } \def\pushthisfilestackY #1\StackTerm #2\StackTerm {% \gdef\popthisfilestack{\gdef\thisfile{#1}\gdef\popthisfilestack{#2}}% } \def\popthisfilestack{\errthisfilestackempty} \def\errthisfilestackempty{\errmessage{Internal error: the stack of filenames is empty.}} \def\thisfile{} % @center line % outputs that line, centered. % \parseargdef\center{% \ifhmode \let\next\centerH \else \let\next\centerV \fi \next{\hfil \ignorespaces#1\unskip \hfil}% } \def\centerH#1{% {% \hfil\break \advance\hsize by -\leftskip \advance\hsize by -\rightskip \line{#1}% \break }% } \def\centerV#1{\line{\kern\leftskip #1\kern\rightskip}} % @sp n outputs n lines of vertical space \parseargdef\sp{\vskip #1\baselineskip} % @comment ...line which is ignored... % @c is the same as @comment % @ignore ... @end ignore is another way to write a comment \def\comment{\begingroup \catcode`\^^M=\other% \catcode`\@=\other \catcode`\{=\other \catcode`\}=\other% \commentxxx} {\catcode`\^^M=\other \gdef\commentxxx#1^^M{\endgroup}} \let\c=\comment % @paragraphindent NCHARS % We'll use ems for NCHARS, close enough. % NCHARS can also be the word `asis' or `none'. % We cannot feasibly implement @paragraphindent asis, though. % \def\asisword{asis} % no translation, these are keywords \def\noneword{none} % \parseargdef\paragraphindent{% \def\temp{#1}% \ifx\temp\asisword \else \ifx\temp\noneword \defaultparindent = 0pt \else \defaultparindent = #1em \fi \fi \parindent = \defaultparindent } % @exampleindent NCHARS % We'll use ems for NCHARS like @paragraphindent. % It seems @exampleindent asis isn't necessary, but % I preserve it to make it similar to @paragraphindent. \parseargdef\exampleindent{% \def\temp{#1}% \ifx\temp\asisword \else \ifx\temp\noneword \lispnarrowing = 0pt \else \lispnarrowing = #1em \fi \fi } % @firstparagraphindent WORD % If WORD is `none', then suppress indentation of the first paragraph % after a section heading. If WORD is `insert', then do indent at such % paragraphs. % % The paragraph indentation is suppressed or not by calling % \suppressfirstparagraphindent, which the sectioning commands do. % We switch the definition of this back and forth according to WORD. % By default, we suppress indentation. % \def\suppressfirstparagraphindent{\dosuppressfirstparagraphindent} \def\insertword{insert} % \parseargdef\firstparagraphindent{% \def\temp{#1}% \ifx\temp\noneword \let\suppressfirstparagraphindent = \dosuppressfirstparagraphindent \else\ifx\temp\insertword \let\suppressfirstparagraphindent = \relax \else \errhelp = \EMsimple \errmessage{Unknown @firstparagraphindent option `\temp'}% \fi\fi } % Here is how we actually suppress indentation. Redefine \everypar to % \kern backwards by \parindent, and then reset itself to empty. % % We also make \indent itself not actually do anything until the next % paragraph. % \gdef\dosuppressfirstparagraphindent{% \gdef\indent{% \restorefirstparagraphindent \indent }% \gdef\noindent{% \restorefirstparagraphindent \noindent }% \global\everypar = {% \kern -\parindent \restorefirstparagraphindent }% } \gdef\restorefirstparagraphindent{% \global \let \indent = \ptexindent \global \let \noindent = \ptexnoindent \global \everypar = {}% } % @asis just yields its argument. Used with @table, for example. % \def\asis#1{#1} % @math outputs its argument in math mode. % % One complication: _ usually means subscripts, but it could also mean % an actual _ character, as in @math{@var{some_variable} + 1}. So make % _ active, and distinguish by seeing if the current family is \slfam, % which is what @var uses. { \catcode`\_ = \active \gdef\mathunderscore{% \catcode`\_=\active \def_{\ifnum\fam=\slfam \_\else\sb\fi}% } } % Another complication: we want \\ (and @\) to output a \ character. % FYI, plain.tex uses \\ as a temporary control sequence (why?), but % this is not advertised and we don't care. Texinfo does not % otherwise define @\. % % The \mathchar is class=0=ordinary, family=7=ttfam, position=5C=\. \def\mathbackslash{\ifnum\fam=\ttfam \mathchar"075C \else\backslash \fi} % \def\math{% \tex \mathunderscore \let\\ = \mathbackslash \mathactive $\finishmath } \def\finishmath#1{#1$\endgroup} % Close the group opened by \tex. % Some active characters (such as <) are spaced differently in math. % We have to reset their definitions in case the @math was an argument % to a command which sets the catcodes (such as @item or @section). % { \catcode`^ = \active \catcode`< = \active \catcode`> = \active \catcode`+ = \active \gdef\mathactive{% \let^ = \ptexhat \let< = \ptexless \let> = \ptexgtr \let+ = \ptexplus } } % @bullet and @minus need the same treatment as @math, just above. \def\bullet{$\ptexbullet$} \def\minus{$-$} % @dots{} outputs an ellipsis using the current font. % We do .5em per period so that it has the same spacing in the cm % typewriter fonts as three actual period characters; on the other hand, % in other typewriter fonts three periods are wider than 1.5em. So do % whichever is larger. % \def\dots{% \leavevmode \setbox0=\hbox{...}% get width of three periods \ifdim\wd0 > 1.5em \dimen0 = \wd0 \else \dimen0 = 1.5em \fi \hbox to \dimen0{% \hskip 0pt plus.25fil .\hskip 0pt plus1fil .\hskip 0pt plus1fil .\hskip 0pt plus.5fil }% } % @enddots{} is an end-of-sentence ellipsis. % \def\enddots{% \dots \spacefactor=\endofsentencespacefactor } % @comma{} is so commas can be inserted into text without messing up % Texinfo's parsing. % \let\comma = , % @refill is a no-op. \let\refill=\relax % If working on a large document in chapters, it is convenient to % be able to disable indexing, cross-referencing, and contents, for test runs. % This is done with @novalidate (before @setfilename). % \newif\iflinks \linkstrue % by default we want the aux files. \let\novalidate = \linksfalse % @setfilename is done at the beginning of every texinfo file. % So open here the files we need to have open while reading the input. % This makes it possible to make a .fmt file for texinfo. \def\setfilename{% \fixbackslash % Turn off hack to swallow `\input texinfo'. \iflinks \tryauxfile % Open the new aux file. TeX will close it automatically at exit. \immediate\openout\auxfile=\jobname.aux \fi % \openindices needs to do some work in any case. \openindices \let\setfilename=\comment % Ignore extra @setfilename cmds. % % If texinfo.cnf is present on the system, read it. % Useful for site-wide @afourpaper, etc. \openin 1 texinfo.cnf \ifeof 1 \else \input texinfo.cnf \fi \closein 1 % \comment % Ignore the actual filename. } % Called from \setfilename. % \def\openindices{% \newindex{cp}% \newcodeindex{fn}% \newcodeindex{vr}% \newcodeindex{tp}% \newcodeindex{ky}% \newcodeindex{pg}% } % @bye. \outer\def\bye{\pagealignmacro\tracingstats=1\ptexend} \message{pdf,} % adobe `portable' document format \newcount\tempnum \newcount\lnkcount \newtoks\filename \newcount\filenamelength \newcount\pgn \newtoks\toksA \newtoks\toksB \newtoks\toksC \newtoks\toksD \newbox\boxA \newcount\countA \newif\ifpdf \newif\ifpdfmakepagedest % when pdftex is run in dvi mode, \pdfoutput is defined (so \pdfoutput=1 % can be set). So we test for \relax and 0 as well as \undefined, % borrowed from ifpdf.sty. \ifx\pdfoutput\undefined \else \ifx\pdfoutput\relax \else \ifcase\pdfoutput \else \pdftrue \fi \fi \fi % PDF uses PostScript string constants for the names of xref targets, % for display in the outlines, and in other places. Thus, we have to % double any backslashes. Otherwise, a name like "\node" will be % interpreted as a newline (\n), followed by o, d, e. Not good. % http://www.ntg.nl/pipermail/ntg-pdftex/2004-July/000654.html % (and related messages, the final outcome is that it is up to the TeX % user to double the backslashes and otherwise make the string valid, so % that's what we do). % double active backslashes. % {\catcode`\@=0 \catcode`\\=\active @gdef@activebackslashdouble{% @catcode`@\=@active @let\=@doublebackslash} } % To handle parens, we must adopt a different approach, since parens are % not active characters. hyperref.dtx (which has the same problem as % us) handles it with this amazing macro to replace tokens, with minor % changes for Texinfo. It is included here under the GPL by permission % from the author, Heiko Oberdiek. % % #1 is the tokens to replace. % #2 is the replacement. % #3 is the control sequence with the string. % \def\HyPsdSubst#1#2#3{% \def\HyPsdReplace##1#1##2\END{% ##1% \ifx\\##2\\% \else #2% \HyReturnAfterFi{% \HyPsdReplace##2\END }% \fi }% \xdef#3{\expandafter\HyPsdReplace#3#1\END}% } \long\def\HyReturnAfterFi#1\fi{\fi#1} % #1 is a control sequence in which to do the replacements. \def\backslashparens#1{% \xdef#1{#1}% redefine it as its expansion; the definition is simply % \lastnode when called from \setref -> \pdfmkdest. \HyPsdSubst{(}{\realbackslash(}{#1}% \HyPsdSubst{)}{\realbackslash)}{#1}% } \newhelp\nopdfimagehelp{Texinfo supports .png, .jpg, .jpeg, and .pdf images with PDF output, and none of those formats could be found. (.eps cannot be supported due to the design of the PDF format; use regular TeX (DVI output) for that.)} \ifpdf % % Color manipulation macros based on pdfcolor.tex. \def\cmykDarkRed{0.28 1 1 0.35} \def\cmykBlack{0 0 0 1} % \def\pdfsetcolor#1{\pdfliteral{#1 k}} % Set color, and create a mark which defines \thiscolor accordingly, % so that \makeheadline knows which color to restore. \def\setcolor#1{% \xdef\lastcolordefs{\gdef\noexpand\thiscolor{#1}}% \domark \pdfsetcolor{#1}% } % \def\maincolor{\cmykBlack} \pdfsetcolor{\maincolor} \edef\thiscolor{\maincolor} \def\lastcolordefs{} % \def\makefootline{% \baselineskip24pt \line{\pdfsetcolor{\maincolor}\the\footline}% } % \def\makeheadline{% \vbox to 0pt{% \vskip-22.5pt \line{% \vbox to8.5pt{}% % Extract \thiscolor definition from the marks. \getcolormarks % Typeset the headline with \maincolor, then restore the color. \pdfsetcolor{\maincolor}\the\headline\pdfsetcolor{\thiscolor}% }% \vss }% \nointerlineskip } % % \pdfcatalog{/PageMode /UseOutlines} % % #1 is image name, #2 width (might be empty/whitespace), #3 height (ditto). \def\dopdfimage#1#2#3{% \def\imagewidth{#2}\setbox0 = \hbox{\ignorespaces #2}% \def\imageheight{#3}\setbox2 = \hbox{\ignorespaces #3}% % % pdftex (and the PDF format) support .png, .jpg, .pdf (among % others). Let's try in that order. \let\pdfimgext=\empty \begingroup \openin 1 #1.png \ifeof 1 \openin 1 #1.jpg \ifeof 1 \openin 1 #1.jpeg \ifeof 1 \openin 1 #1.JPG \ifeof 1 \openin 1 #1.pdf \ifeof 1 \errhelp = \nopdfimagehelp \errmessage{Could not find image file #1 for pdf}% \else \gdef\pdfimgext{pdf}% \fi \else \gdef\pdfimgext{JPG}% \fi \else \gdef\pdfimgext{jpeg}% \fi \else \gdef\pdfimgext{jpg}% \fi \else \gdef\pdfimgext{png}% \fi \closein 1 \endgroup % % without \immediate, pdftex seg faults when the same image is % included twice. (Version 3.14159-pre-1.0-unofficial-20010704.) \ifnum\pdftexversion < 14 \immediate\pdfimage \else \immediate\pdfximage \fi \ifdim \wd0 >0pt width \imagewidth \fi \ifdim \wd2 >0pt height \imageheight \fi \ifnum\pdftexversion<13 #1.\pdfimgext \else {#1.\pdfimgext}% \fi \ifnum\pdftexversion < 14 \else \pdfrefximage \pdflastximage \fi} % \def\pdfmkdest#1{{% % We have to set dummies so commands such as @code, and characters % such as \, aren't expanded when present in a section title. \indexnofonts \turnoffactive \activebackslashdouble \makevalueexpandable \def\pdfdestname{#1}% \backslashparens\pdfdestname \safewhatsit{\pdfdest name{\pdfdestname} xyz}% }} % % used to mark target names; must be expandable. \def\pdfmkpgn#1{#1} % % by default, use a color that is dark enough to print on paper as % nearly black, but still distinguishable for online viewing. \def\urlcolor{\cmykDarkRed} \def\linkcolor{\cmykDarkRed} \def\endlink{\setcolor{\maincolor}\pdfendlink} % % Adding outlines to PDF; macros for calculating structure of outlines % come from Petr Olsak \def\expnumber#1{\expandafter\ifx\csname#1\endcsname\relax 0% \else \csname#1\endcsname \fi} \def\advancenumber#1{\tempnum=\expnumber{#1}\relax \advance\tempnum by 1 \expandafter\xdef\csname#1\endcsname{\the\tempnum}} % % #1 is the section text, which is what will be displayed in the % outline by the pdf viewer. #2 is the pdf expression for the number % of subentries (or empty, for subsubsections). #3 is the node text, % which might be empty if this toc entry had no corresponding node. % #4 is the page number % \def\dopdfoutline#1#2#3#4{% % Generate a link to the node text if that exists; else, use the % page number. We could generate a destination for the section % text in the case where a section has no node, but it doesn't % seem worth the trouble, since most documents are normally structured. \def\pdfoutlinedest{#3}% \ifx\pdfoutlinedest\empty \def\pdfoutlinedest{#4}% \else % Doubled backslashes in the name. {\activebackslashdouble \xdef\pdfoutlinedest{#3}% \backslashparens\pdfoutlinedest}% \fi % % Also double the backslashes in the display string. {\activebackslashdouble \xdef\pdfoutlinetext{#1}% \backslashparens\pdfoutlinetext}% % \pdfoutline goto name{\pdfmkpgn{\pdfoutlinedest}}#2{\pdfoutlinetext}% } % \def\pdfmakeoutlines{% \begingroup % Thanh's hack / proper braces in bookmarks \edef\mylbrace{\iftrue \string{\else}\fi}\let\{=\mylbrace \edef\myrbrace{\iffalse{\else\string}\fi}\let\}=\myrbrace % % Read toc silently, to get counts of subentries for \pdfoutline. \def\numchapentry##1##2##3##4{% \def\thischapnum{##2}% \def\thissecnum{0}% \def\thissubsecnum{0}% }% \def\numsecentry##1##2##3##4{% \advancenumber{chap\thischapnum}% \def\thissecnum{##2}% \def\thissubsecnum{0}% }% \def\numsubsecentry##1##2##3##4{% \advancenumber{sec\thissecnum}% \def\thissubsecnum{##2}% }% \def\numsubsubsecentry##1##2##3##4{% \advancenumber{subsec\thissubsecnum}% }% \def\thischapnum{0}% \def\thissecnum{0}% \def\thissubsecnum{0}% % % use \def rather than \let here because we redefine \chapentry et % al. a second time, below. \def\appentry{\numchapentry}% \def\appsecentry{\numsecentry}% \def\appsubsecentry{\numsubsecentry}% \def\appsubsubsecentry{\numsubsubsecentry}% \def\unnchapentry{\numchapentry}% \def\unnsecentry{\numsecentry}% \def\unnsubsecentry{\numsubsecentry}% \def\unnsubsubsecentry{\numsubsubsecentry}% \readdatafile{toc}% % % Read toc second time, this time actually producing the outlines. % The `-' means take the \expnumber as the absolute number of % subentries, which we calculated on our first read of the .toc above. % % We use the node names as the destinations. \def\numchapentry##1##2##3##4{% \dopdfoutline{##1}{count-\expnumber{chap##2}}{##3}{##4}}% \def\numsecentry##1##2##3##4{% \dopdfoutline{##1}{count-\expnumber{sec##2}}{##3}{##4}}% \def\numsubsecentry##1##2##3##4{% \dopdfoutline{##1}{count-\expnumber{subsec##2}}{##3}{##4}}% \def\numsubsubsecentry##1##2##3##4{% count is always zero \dopdfoutline{##1}{}{##3}{##4}}% % % PDF outlines are displayed using system fonts, instead of % document fonts. Therefore we cannot use special characters, % since the encoding is unknown. For example, the eogonek from % Latin 2 (0xea) gets translated to a | character. Info from % Staszek Wawrykiewicz, 19 Jan 2004 04:09:24 +0100. % % xx to do this right, we have to translate 8-bit characters to % their "best" equivalent, based on the @documentencoding. Right % now, I guess we'll just let the pdf reader have its way. \indexnofonts \setupdatafile \catcode`\\=\active \otherbackslash \input \tocreadfilename \endgroup } % \def\skipspaces#1{\def\PP{#1}\def\D{|}% \ifx\PP\D\let\nextsp\relax \else\let\nextsp\skipspaces \ifx\p\space\else\addtokens{\filename}{\PP}% \advance\filenamelength by 1 \fi \fi \nextsp} \def\getfilename#1{\filenamelength=0\expandafter\skipspaces#1|\relax} \ifnum\pdftexversion < 14 \let \startlink \pdfannotlink \else \let \startlink \pdfstartlink \fi % make a live url in pdf output. \def\pdfurl#1{% \begingroup % it seems we really need yet another set of dummies; have not % tried to figure out what each command should do in the context % of @url. for now, just make @/ a no-op, that's the only one % people have actually reported a problem with. % \normalturnoffactive \def\@{@}% \let\/=\empty \makevalueexpandable \leavevmode\setcolor{\urlcolor}% \startlink attr{/Border [0 0 0]}% user{/Subtype /Link /A << /S /URI /URI (#1) >>}% \endgroup} \def\pdfgettoks#1.{\setbox\boxA=\hbox{\toksA={#1.}\toksB={}\maketoks}} \def\addtokens#1#2{\edef\addtoks{\noexpand#1={\the#1#2}}\addtoks} \def\adn#1{\addtokens{\toksC}{#1}\global\countA=1\let\next=\maketoks} \def\poptoks#1#2|ENDTOKS|{\let\first=#1\toksD={#1}\toksA={#2}} \def\maketoks{% \expandafter\poptoks\the\toksA|ENDTOKS|\relax \ifx\first0\adn0 \else\ifx\first1\adn1 \else\ifx\first2\adn2 \else\ifx\first3\adn3 \else\ifx\first4\adn4 \else\ifx\first5\adn5 \else\ifx\first6\adn6 \else\ifx\first7\adn7 \else\ifx\first8\adn8 \else\ifx\first9\adn9 \else \ifnum0=\countA\else\makelink\fi \ifx\first.\let\next=\done\else \let\next=\maketoks \addtokens{\toksB}{\the\toksD} \ifx\first,\addtokens{\toksB}{\space}\fi \fi \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi \next} \def\makelink{\addtokens{\toksB}% {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0} \def\pdflink#1{% \startlink attr{/Border [0 0 0]} goto name{\pdfmkpgn{#1}} \setcolor{\linkcolor}#1\endlink} \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st} \else \let\pdfmkdest = \gobble \let\pdfurl = \gobble \let\endlink = \relax \let\setcolor = \gobble \let\pdfsetcolor = \gobble \let\pdfmakeoutlines = \relax \fi % \ifx\pdfoutput \message{fonts,} % Change the current font style to #1, remembering it in \curfontstyle. % For now, we do not accumulate font styles: @b{@i{foo}} prints foo in % italics, not bold italics. % \def\setfontstyle#1{% \def\curfontstyle{#1}% not as a control sequence, because we are \edef'd. \csname ten#1\endcsname % change the current font } % Select #1 fonts with the current style. % \def\selectfonts#1{\csname #1fonts\endcsname \csname\curfontstyle\endcsname} \def\rm{\fam=0 \setfontstyle{rm}} \def\it{\fam=\itfam \setfontstyle{it}} \def\sl{\fam=\slfam \setfontstyle{sl}} \def\bf{\fam=\bffam \setfontstyle{bf}}\def\bfstylename{bf} \def\tt{\fam=\ttfam \setfontstyle{tt}} % Texinfo sort of supports the sans serif font style, which plain TeX does not. % So we set up a \sf. \newfam\sffam \def\sf{\fam=\sffam \setfontstyle{sf}} \let\li = \sf % Sometimes we call it \li, not \sf. % We don't need math for this font style. \def\ttsl{\setfontstyle{ttsl}} % Default leading. \newdimen\textleading \textleading = 13.2pt % Set the baselineskip to #1, and the lineskip and strut size % correspondingly. There is no deep meaning behind these magic numbers % used as factors; they just match (closely enough) what Knuth defined. % \def\lineskipfactor{.08333} \def\strutheightpercent{.70833} \def\strutdepthpercent {.29167} % % can get a sort of poor man's double spacing by redefining this. \def\baselinefactor{1} % \def\setleading#1{% \dimen0 = #1\relax \normalbaselineskip = \baselinefactor\dimen0 \normallineskip = \lineskipfactor\normalbaselineskip \normalbaselines \setbox\strutbox =\hbox{% \vrule width0pt height\strutheightpercent\baselineskip depth \strutdepthpercent \baselineskip }% } % % PDF CMaps. See also LaTeX's t1.cmap. % % \cmapOT1 \ifpdf \begingroup \catcode`\^^M=\active \def^^M{^^J}% Output line endings as the ^^J char. \catcode`\%=12 \immediate\pdfobj stream {%!PS-Adobe-3.0 Resource-CMap %%DocumentNeededResources: ProcSet (CIDInit) %%IncludeResource: ProcSet (CIDInit) %%BeginResource: CMap (TeX-OT1-0) %%Title: (TeX-OT1-0 TeX OT1 0) %%Version: 1.000 %%EndComments /CIDInit /ProcSet findresource begin 12 dict begin begincmap /CIDSystemInfo << /Registry (TeX) /Ordering (OT1) /Supplement 0 >> def /CMapName /TeX-OT1-0 def /CMapType 2 def 1 begincodespacerange <00> <7F> endcodespacerange 8 beginbfrange <00> <01> <0393> <09> <0A> <03A8> <23> <26> <0023> <28> <3B> <0028> <3F> <5B> <003F> <5D> <5E> <005D> <61> <7A> <0061> <7B> <7C> <2013> endbfrange 40 beginbfchar <02> <0398> <03> <039B> <04> <039E> <05> <03A0> <06> <03A3> <07> <03D2> <08> <03A6> <0B> <00660066> <0C> <00660069> <0D> <0066006C> <0E> <006600660069> <0F> <00660066006C> <10> <0131> <11> <0237> <12> <0060> <13> <00B4> <14> <02C7> <15> <02D8> <16> <00AF> <17> <02DA> <18> <00B8> <19> <00DF> <1A> <00E6> <1B> <0153> <1C> <00F8> <1D> <00C6> <1E> <0152> <1F> <00D8> <21> <0021> <22> <201D> <27> <2019> <3C> <00A1> <3D> <003D> <3E> <00BF> <5C> <201C> <5F> <02D9> <60> <2018> <7D> <02DD> <7E> <007E> <7F> <00A8> endbfchar endcmap CMapName currentdict /CMap defineresource pop end end %%EndResource %%EOF }\endgroup \expandafter\edef\csname cmapOT1\endcsname#1{% \pdffontattr#1{/ToUnicode \the\pdflastobj\space 0 R}% }% % % \cmapOT1IT \begingroup \catcode`\^^M=\active \def^^M{^^J}% Output line endings as the ^^J char. \catcode`\%=12 \immediate\pdfobj stream {%!PS-Adobe-3.0 Resource-CMap %%DocumentNeededResources: ProcSet (CIDInit) %%IncludeResource: ProcSet (CIDInit) %%BeginResource: CMap (TeX-OT1IT-0) %%Title: (TeX-OT1IT-0 TeX OT1IT 0) %%Version: 1.000 %%EndComments /CIDInit /ProcSet findresource begin 12 dict begin begincmap /CIDSystemInfo << /Registry (TeX) /Ordering (OT1IT) /Supplement 0 >> def /CMapName /TeX-OT1IT-0 def /CMapType 2 def 1 begincodespacerange <00> <7F> endcodespacerange 8 beginbfrange <00> <01> <0393> <09> <0A> <03A8> <25> <26> <0025> <28> <3B> <0028> <3F> <5B> <003F> <5D> <5E> <005D> <61> <7A> <0061> <7B> <7C> <2013> endbfrange 42 beginbfchar <02> <0398> <03> <039B> <04> <039E> <05> <03A0> <06> <03A3> <07> <03D2> <08> <03A6> <0B> <00660066> <0C> <00660069> <0D> <0066006C> <0E> <006600660069> <0F> <00660066006C> <10> <0131> <11> <0237> <12> <0060> <13> <00B4> <14> <02C7> <15> <02D8> <16> <00AF> <17> <02DA> <18> <00B8> <19> <00DF> <1A> <00E6> <1B> <0153> <1C> <00F8> <1D> <00C6> <1E> <0152> <1F> <00D8> <21> <0021> <22> <201D> <23> <0023> <24> <00A3> <27> <2019> <3C> <00A1> <3D> <003D> <3E> <00BF> <5C> <201C> <5F> <02D9> <60> <2018> <7D> <02DD> <7E> <007E> <7F> <00A8> endbfchar endcmap CMapName currentdict /CMap defineresource pop end end %%EndResource %%EOF }\endgroup \expandafter\edef\csname cmapOT1IT\endcsname#1{% \pdffontattr#1{/ToUnicode \the\pdflastobj\space 0 R}% }% % % \cmapOT1TT \begingroup \catcode`\^^M=\active \def^^M{^^J}% Output line endings as the ^^J char. \catcode`\%=12 \immediate\pdfobj stream {%!PS-Adobe-3.0 Resource-CMap %%DocumentNeededResources: ProcSet (CIDInit) %%IncludeResource: ProcSet (CIDInit) %%BeginResource: CMap (TeX-OT1TT-0) %%Title: (TeX-OT1TT-0 TeX OT1TT 0) %%Version: 1.000 %%EndComments /CIDInit /ProcSet findresource begin 12 dict begin begincmap /CIDSystemInfo << /Registry (TeX) /Ordering (OT1TT) /Supplement 0 >> def /CMapName /TeX-OT1TT-0 def /CMapType 2 def 1 begincodespacerange <00> <7F> endcodespacerange 5 beginbfrange <00> <01> <0393> <09> <0A> <03A8> <21> <26> <0021> <28> <5F> <0028> <61> <7E> <0061> endbfrange 32 beginbfchar <02> <0398> <03> <039B> <04> <039E> <05> <03A0> <06> <03A3> <07> <03D2> <08> <03A6> <0B> <2191> <0C> <2193> <0D> <0027> <0E> <00A1> <0F> <00BF> <10> <0131> <11> <0237> <12> <0060> <13> <00B4> <14> <02C7> <15> <02D8> <16> <00AF> <17> <02DA> <18> <00B8> <19> <00DF> <1A> <00E6> <1B> <0153> <1C> <00F8> <1D> <00C6> <1E> <0152> <1F> <00D8> <20> <2423> <27> <2019> <60> <2018> <7F> <00A8> endbfchar endcmap CMapName currentdict /CMap defineresource pop end end %%EndResource %%EOF }\endgroup \expandafter\edef\csname cmapOT1TT\endcsname#1{% \pdffontattr#1{/ToUnicode \the\pdflastobj\space 0 R}% }% \else \expandafter\let\csname cmapOT1\endcsname\gobble \expandafter\let\csname cmapOT1IT\endcsname\gobble \expandafter\let\csname cmapOT1TT\endcsname\gobble \fi % Set the font macro #1 to the font named #2, adding on the % specified font prefix (normally `cm'). % #3 is the font's design size, #4 is a scale factor, #5 is the CMap % encoding (currently only OT1, OT1IT and OT1TT are allowed, pass % empty to omit). \def\setfont#1#2#3#4#5{% \font#1=\fontprefix#2#3 scaled #4 \csname cmap#5\endcsname#1% } % This is what gets called when #5 of \setfont is empty. \let\cmap\gobble % Use cm as the default font prefix. % To specify the font prefix, you must define \fontprefix % before you read in texinfo.tex. \ifx\fontprefix\undefined \def\fontprefix{cm} \fi % Support font families that don't use the same naming scheme as CM. \def\rmshape{r} \def\rmbshape{bx} %where the normal face is bold \def\bfshape{b} \def\bxshape{bx} \def\ttshape{tt} \def\ttbshape{tt} \def\ttslshape{sltt} \def\itshape{ti} \def\itbshape{bxti} \def\slshape{sl} \def\slbshape{bxsl} \def\sfshape{ss} \def\sfbshape{ss} \def\scshape{csc} \def\scbshape{csc} % Definitions for a main text size of 11pt. This is the default in % Texinfo. % \def\definetextfontsizexi{% % Text fonts (11.2pt, magstep1). \def\textnominalsize{11pt} \edef\mainmagstep{\magstephalf} \setfont\textrm\rmshape{10}{\mainmagstep}{OT1} \setfont\texttt\ttshape{10}{\mainmagstep}{OT1TT} \setfont\textbf\bfshape{10}{\mainmagstep}{OT1} \setfont\textit\itshape{10}{\mainmagstep}{OT1IT} \setfont\textsl\slshape{10}{\mainmagstep}{OT1} \setfont\textsf\sfshape{10}{\mainmagstep}{OT1} \setfont\textsc\scshape{10}{\mainmagstep}{OT1} \setfont\textttsl\ttslshape{10}{\mainmagstep}{OT1TT} \font\texti=cmmi10 scaled \mainmagstep \font\textsy=cmsy10 scaled \mainmagstep \def\textecsize{1095} % A few fonts for @defun names and args. \setfont\defbf\bfshape{10}{\magstep1}{OT1} \setfont\deftt\ttshape{10}{\magstep1}{OT1TT} \setfont\defttsl\ttslshape{10}{\magstep1}{OT1TT} \def\df{\let\tentt=\deftt \let\tenbf = \defbf \let\tenttsl=\defttsl \bf} % Fonts for indices, footnotes, small examples (9pt). \def\smallnominalsize{9pt} \setfont\smallrm\rmshape{9}{1000}{OT1} \setfont\smalltt\ttshape{9}{1000}{OT1TT} \setfont\smallbf\bfshape{10}{900}{OT1} \setfont\smallit\itshape{9}{1000}{OT1IT} \setfont\smallsl\slshape{9}{1000}{OT1} \setfont\smallsf\sfshape{9}{1000}{OT1} \setfont\smallsc\scshape{10}{900}{OT1} \setfont\smallttsl\ttslshape{10}{900}{OT1TT} \font\smalli=cmmi9 \font\smallsy=cmsy9 \def\smallecsize{0900} % Fonts for small examples (8pt). \def\smallernominalsize{8pt} \setfont\smallerrm\rmshape{8}{1000}{OT1} \setfont\smallertt\ttshape{8}{1000}{OT1TT} \setfont\smallerbf\bfshape{10}{800}{OT1} \setfont\smallerit\itshape{8}{1000}{OT1IT} \setfont\smallersl\slshape{8}{1000}{OT1} \setfont\smallersf\sfshape{8}{1000}{OT1} \setfont\smallersc\scshape{10}{800}{OT1} \setfont\smallerttsl\ttslshape{10}{800}{OT1TT} \font\smalleri=cmmi8 \font\smallersy=cmsy8 \def\smallerecsize{0800} % Fonts for title page (20.4pt): \def\titlenominalsize{20pt} \setfont\titlerm\rmbshape{12}{\magstep3}{OT1} \setfont\titleit\itbshape{10}{\magstep4}{OT1IT} \setfont\titlesl\slbshape{10}{\magstep4}{OT1} \setfont\titlett\ttbshape{12}{\magstep3}{OT1TT} \setfont\titlettsl\ttslshape{10}{\magstep4}{OT1TT} \setfont\titlesf\sfbshape{17}{\magstep1}{OT1} \let\titlebf=\titlerm \setfont\titlesc\scbshape{10}{\magstep4}{OT1} \font\titlei=cmmi12 scaled \magstep3 \font\titlesy=cmsy10 scaled \magstep4 \def\authorrm{\secrm} \def\authortt{\sectt} \def\titleecsize{2074} % Chapter (and unnumbered) fonts (17.28pt). \def\chapnominalsize{17pt} \setfont\chaprm\rmbshape{12}{\magstep2}{OT1} \setfont\chapit\itbshape{10}{\magstep3}{OT1IT} \setfont\chapsl\slbshape{10}{\magstep3}{OT1} \setfont\chaptt\ttbshape{12}{\magstep2}{OT1TT} \setfont\chapttsl\ttslshape{10}{\magstep3}{OT1TT} \setfont\chapsf\sfbshape{17}{1000}{OT1} \let\chapbf=\chaprm \setfont\chapsc\scbshape{10}{\magstep3}{OT1} \font\chapi=cmmi12 scaled \magstep2 \font\chapsy=cmsy10 scaled \magstep3 \def\chapecsize{1728} % Section fonts (14.4pt). \def\secnominalsize{14pt} \setfont\secrm\rmbshape{12}{\magstep1}{OT1} \setfont\secit\itbshape{10}{\magstep2}{OT1IT} \setfont\secsl\slbshape{10}{\magstep2}{OT1} \setfont\sectt\ttbshape{12}{\magstep1}{OT1TT} \setfont\secttsl\ttslshape{10}{\magstep2}{OT1TT} \setfont\secsf\sfbshape{12}{\magstep1}{OT1} \let\secbf\secrm \setfont\secsc\scbshape{10}{\magstep2}{OT1} \font\seci=cmmi12 scaled \magstep1 \font\secsy=cmsy10 scaled \magstep2 \def\sececsize{1440} % Subsection fonts (13.15pt). \def\ssecnominalsize{13pt} \setfont\ssecrm\rmbshape{12}{\magstephalf}{OT1} \setfont\ssecit\itbshape{10}{1315}{OT1IT} \setfont\ssecsl\slbshape{10}{1315}{OT1} \setfont\ssectt\ttbshape{12}{\magstephalf}{OT1TT} \setfont\ssecttsl\ttslshape{10}{1315}{OT1TT} \setfont\ssecsf\sfbshape{12}{\magstephalf}{OT1} \let\ssecbf\ssecrm \setfont\ssecsc\scbshape{10}{1315}{OT1} \font\sseci=cmmi12 scaled \magstephalf \font\ssecsy=cmsy10 scaled 1315 \def\ssececsize{1200} % Reduced fonts for @acro in text (10pt). \def\reducednominalsize{10pt} \setfont\reducedrm\rmshape{10}{1000}{OT1} \setfont\reducedtt\ttshape{10}{1000}{OT1TT} \setfont\reducedbf\bfshape{10}{1000}{OT1} \setfont\reducedit\itshape{10}{1000}{OT1IT} \setfont\reducedsl\slshape{10}{1000}{OT1} \setfont\reducedsf\sfshape{10}{1000}{OT1} \setfont\reducedsc\scshape{10}{1000}{OT1} \setfont\reducedttsl\ttslshape{10}{1000}{OT1TT} \font\reducedi=cmmi10 \font\reducedsy=cmsy10 \def\reducedecsize{1000} % reset the current fonts \textfonts \rm } % end of 11pt text font size definitions % Definitions to make the main text be 10pt Computer Modern, with % section, chapter, etc., sizes following suit. This is for the GNU % Press printing of the Emacs 22 manual. Maybe other manuals in the % future. Used with @smallbook, which sets the leading to 12pt. % \def\definetextfontsizex{% % Text fonts (10pt). \def\textnominalsize{10pt} \edef\mainmagstep{1000} \setfont\textrm\rmshape{10}{\mainmagstep}{OT1} \setfont\texttt\ttshape{10}{\mainmagstep}{OT1TT} \setfont\textbf\bfshape{10}{\mainmagstep}{OT1} \setfont\textit\itshape{10}{\mainmagstep}{OT1IT} \setfont\textsl\slshape{10}{\mainmagstep}{OT1} \setfont\textsf\sfshape{10}{\mainmagstep}{OT1} \setfont\textsc\scshape{10}{\mainmagstep}{OT1} \setfont\textttsl\ttslshape{10}{\mainmagstep}{OT1TT} \font\texti=cmmi10 scaled \mainmagstep \font\textsy=cmsy10 scaled \mainmagstep \def\textecsize{1000} % A few fonts for @defun names and args. \setfont\defbf\bfshape{10}{\magstephalf}{OT1} \setfont\deftt\ttshape{10}{\magstephalf}{OT1TT} \setfont\defttsl\ttslshape{10}{\magstephalf}{OT1TT} \def\df{\let\tentt=\deftt \let\tenbf = \defbf \let\tenttsl=\defttsl \bf} % Fonts for indices, footnotes, small examples (9pt). \def\smallnominalsize{9pt} \setfont\smallrm\rmshape{9}{1000}{OT1} \setfont\smalltt\ttshape{9}{1000}{OT1TT} \setfont\smallbf\bfshape{10}{900}{OT1} \setfont\smallit\itshape{9}{1000}{OT1IT} \setfont\smallsl\slshape{9}{1000}{OT1} \setfont\smallsf\sfshape{9}{1000}{OT1} \setfont\smallsc\scshape{10}{900}{OT1} \setfont\smallttsl\ttslshape{10}{900}{OT1TT} \font\smalli=cmmi9 \font\smallsy=cmsy9 \def\smallecsize{0900} % Fonts for small examples (8pt). \def\smallernominalsize{8pt} \setfont\smallerrm\rmshape{8}{1000}{OT1} \setfont\smallertt\ttshape{8}{1000}{OT1TT} \setfont\smallerbf\bfshape{10}{800}{OT1} \setfont\smallerit\itshape{8}{1000}{OT1IT} \setfont\smallersl\slshape{8}{1000}{OT1} \setfont\smallersf\sfshape{8}{1000}{OT1} \setfont\smallersc\scshape{10}{800}{OT1} \setfont\smallerttsl\ttslshape{10}{800}{OT1TT} \font\smalleri=cmmi8 \font\smallersy=cmsy8 \def\smallerecsize{0800} % Fonts for title page (20.4pt): \def\titlenominalsize{20pt} \setfont\titlerm\rmbshape{12}{\magstep3}{OT1} \setfont\titleit\itbshape{10}{\magstep4}{OT1IT} \setfont\titlesl\slbshape{10}{\magstep4}{OT1} \setfont\titlett\ttbshape{12}{\magstep3}{OT1TT} \setfont\titlettsl\ttslshape{10}{\magstep4}{OT1TT} \setfont\titlesf\sfbshape{17}{\magstep1}{OT1} \let\titlebf=\titlerm \setfont\titlesc\scbshape{10}{\magstep4}{OT1} \font\titlei=cmmi12 scaled \magstep3 \font\titlesy=cmsy10 scaled \magstep4 \def\authorrm{\secrm} \def\authortt{\sectt} \def\titleecsize{2074} % Chapter fonts (14.4pt). \def\chapnominalsize{14pt} \setfont\chaprm\rmbshape{12}{\magstep1}{OT1} \setfont\chapit\itbshape{10}{\magstep2}{OT1IT} \setfont\chapsl\slbshape{10}{\magstep2}{OT1} \setfont\chaptt\ttbshape{12}{\magstep1}{OT1TT} \setfont\chapttsl\ttslshape{10}{\magstep2}{OT1TT} \setfont\chapsf\sfbshape{12}{\magstep1}{OT1} \let\chapbf\chaprm \setfont\chapsc\scbshape{10}{\magstep2}{OT1} \font\chapi=cmmi12 scaled \magstep1 \font\chapsy=cmsy10 scaled \magstep2 \def\chapecsize{1440} % Section fonts (12pt). \def\secnominalsize{12pt} \setfont\secrm\rmbshape{12}{1000}{OT1} \setfont\secit\itbshape{10}{\magstep1}{OT1IT} \setfont\secsl\slbshape{10}{\magstep1}{OT1} \setfont\sectt\ttbshape{12}{1000}{OT1TT} \setfont\secttsl\ttslshape{10}{\magstep1}{OT1TT} \setfont\secsf\sfbshape{12}{1000}{OT1} \let\secbf\secrm \setfont\secsc\scbshape{10}{\magstep1}{OT1} \font\seci=cmmi12 \font\secsy=cmsy10 scaled \magstep1 \def\sececsize{1200} % Subsection fonts (10pt). \def\ssecnominalsize{10pt} \setfont\ssecrm\rmbshape{10}{1000}{OT1} \setfont\ssecit\itbshape{10}{1000}{OT1IT} \setfont\ssecsl\slbshape{10}{1000}{OT1} \setfont\ssectt\ttbshape{10}{1000}{OT1TT} \setfont\ssecttsl\ttslshape{10}{1000}{OT1TT} \setfont\ssecsf\sfbshape{10}{1000}{OT1} \let\ssecbf\ssecrm \setfont\ssecsc\scbshape{10}{1000}{OT1} \font\sseci=cmmi10 \font\ssecsy=cmsy10 \def\ssececsize{1000} % Reduced fonts for @acro in text (9pt). \def\reducednominalsize{9pt} \setfont\reducedrm\rmshape{9}{1000}{OT1} \setfont\reducedtt\ttshape{9}{1000}{OT1TT} \setfont\reducedbf\bfshape{10}{900}{OT1} \setfont\reducedit\itshape{9}{1000}{OT1IT} \setfont\reducedsl\slshape{9}{1000}{OT1} \setfont\reducedsf\sfshape{9}{1000}{OT1} \setfont\reducedsc\scshape{10}{900}{OT1} \setfont\reducedttsl\ttslshape{10}{900}{OT1TT} \font\reducedi=cmmi9 \font\reducedsy=cmsy9 \def\reducedecsize{0900} % reduce space between paragraphs \divide\parskip by 2 % reset the current fonts \textfonts \rm } % end of 10pt text font size definitions % We provide the user-level command % @fonttextsize 10 % (or 11) to redefine the text font size. pt is assumed. % \def\xword{10} \def\xiword{11} % \parseargdef\fonttextsize{% \def\textsizearg{#1}% \wlog{doing @fonttextsize \textsizearg}% % % Set \globaldefs so that documents can use this inside @tex, since % makeinfo 4.8 does not support it, but we need it nonetheless. % \begingroup \globaldefs=1 \ifx\textsizearg\xword \definetextfontsizex \else \ifx\textsizearg\xiword \definetextfontsizexi \else \errhelp=\EMsimple \errmessage{@fonttextsize only supports `10' or `11', not `\textsizearg'} \fi\fi \endgroup } % In order for the font changes to affect most math symbols and letters, % we have to define the \textfont of the standard families. Since % texinfo doesn't allow for producing subscripts and superscripts except % in the main text, we don't bother to reset \scriptfont and % \scriptscriptfont (which would also require loading a lot more fonts). % \def\resetmathfonts{% \textfont0=\tenrm \textfont1=\teni \textfont2=\tensy \textfont\itfam=\tenit \textfont\slfam=\tensl \textfont\bffam=\tenbf \textfont\ttfam=\tentt \textfont\sffam=\tensf } % The font-changing commands redefine the meanings of \tenSTYLE, instead % of just \STYLE. We do this because \STYLE needs to also set the % current \fam for math mode. Our \STYLE (e.g., \rm) commands hardwire % \tenSTYLE to set the current font. % % Each font-changing command also sets the names \lsize (one size lower) % and \lllsize (three sizes lower). These relative commands are used in % the LaTeX logo and acronyms. % % This all needs generalizing, badly. % \def\textfonts{% \let\tenrm=\textrm \let\tenit=\textit \let\tensl=\textsl \let\tenbf=\textbf \let\tentt=\texttt \let\smallcaps=\textsc \let\tensf=\textsf \let\teni=\texti \let\tensy=\textsy \let\tenttsl=\textttsl \def\curfontsize{text}% \def\lsize{reduced}\def\lllsize{smaller}% \resetmathfonts \setleading{\textleading}} \def\titlefonts{% \let\tenrm=\titlerm \let\tenit=\titleit \let\tensl=\titlesl \let\tenbf=\titlebf \let\tentt=\titlett \let\smallcaps=\titlesc \let\tensf=\titlesf \let\teni=\titlei \let\tensy=\titlesy \let\tenttsl=\titlettsl \def\curfontsize{title}% \def\lsize{chap}\def\lllsize{subsec}% \resetmathfonts \setleading{25pt}} \def\titlefont#1{{\titlefonts\rm #1}} \def\chapfonts{% \let\tenrm=\chaprm \let\tenit=\chapit \let\tensl=\chapsl \let\tenbf=\chapbf \let\tentt=\chaptt \let\smallcaps=\chapsc \let\tensf=\chapsf \let\teni=\chapi \let\tensy=\chapsy \let\tenttsl=\chapttsl \def\curfontsize{chap}% \def\lsize{sec}\def\lllsize{text}% \resetmathfonts \setleading{19pt}} \def\secfonts{% \let\tenrm=\secrm \let\tenit=\secit \let\tensl=\secsl \let\tenbf=\secbf \let\tentt=\sectt \let\smallcaps=\secsc \let\tensf=\secsf \let\teni=\seci \let\tensy=\secsy \let\tenttsl=\secttsl \def\curfontsize{sec}% \def\lsize{subsec}\def\lllsize{reduced}% \resetmathfonts \setleading{16pt}} \def\subsecfonts{% \let\tenrm=\ssecrm \let\tenit=\ssecit \let\tensl=\ssecsl \let\tenbf=\ssecbf \let\tentt=\ssectt \let\smallcaps=\ssecsc \let\tensf=\ssecsf \let\teni=\sseci \let\tensy=\ssecsy \let\tenttsl=\ssecttsl \def\curfontsize{ssec}% \def\lsize{text}\def\lllsize{small}% \resetmathfonts \setleading{15pt}} \let\subsubsecfonts = \subsecfonts \def\reducedfonts{% \let\tenrm=\reducedrm \let\tenit=\reducedit \let\tensl=\reducedsl \let\tenbf=\reducedbf \let\tentt=\reducedtt \let\reducedcaps=\reducedsc \let\tensf=\reducedsf \let\teni=\reducedi \let\tensy=\reducedsy \let\tenttsl=\reducedttsl \def\curfontsize{reduced}% \def\lsize{small}\def\lllsize{smaller}% \resetmathfonts \setleading{10.5pt}} \def\smallfonts{% \let\tenrm=\smallrm \let\tenit=\smallit \let\tensl=\smallsl \let\tenbf=\smallbf \let\tentt=\smalltt \let\smallcaps=\smallsc \let\tensf=\smallsf \let\teni=\smalli \let\tensy=\smallsy \let\tenttsl=\smallttsl \def\curfontsize{small}% \def\lsize{smaller}\def\lllsize{smaller}% \resetmathfonts \setleading{10.5pt}} \def\smallerfonts{% \let\tenrm=\smallerrm \let\tenit=\smallerit \let\tensl=\smallersl \let\tenbf=\smallerbf \let\tentt=\smallertt \let\smallcaps=\smallersc \let\tensf=\smallersf \let\teni=\smalleri \let\tensy=\smallersy \let\tenttsl=\smallerttsl \def\curfontsize{smaller}% \def\lsize{smaller}\def\lllsize{smaller}% \resetmathfonts \setleading{9.5pt}} % Set the fonts to use with the @small... environments. \let\smallexamplefonts = \smallfonts % About \smallexamplefonts. If we use \smallfonts (9pt), @smallexample % can fit this many characters: % 8.5x11=86 smallbook=72 a4=90 a5=69 % If we use \scriptfonts (8pt), then we can fit this many characters: % 8.5x11=90+ smallbook=80 a4=90+ a5=77 % For me, subjectively, the few extra characters that fit aren't worth % the additional smallness of 8pt. So I'm making the default 9pt. % % By the way, for comparison, here's what fits with @example (10pt): % 8.5x11=71 smallbook=60 a4=75 a5=58 % % I wish the USA used A4 paper. % --karl, 24jan03. % Set up the default fonts, so we can use them for creating boxes. % \definetextfontsizexi % Define these so they can be easily changed for other fonts. \def\angleleft{$\langle$} \def\angleright{$\rangle$} % Count depth in font-changes, for error checks \newcount\fontdepth \fontdepth=0 % Fonts for short table of contents. \setfont\shortcontrm\rmshape{12}{1000}{OT1} \setfont\shortcontbf\bfshape{10}{\magstep1}{OT1} % no cmb12 \setfont\shortcontsl\slshape{12}{1000}{OT1} \setfont\shortconttt\ttshape{12}{1000}{OT1TT} %% Add scribe-like font environments, plus @l for inline lisp (usually sans %% serif) and @ii for TeX italic % \smartitalic{ARG} outputs arg in italics, followed by an italic correction % unless the following character is such as not to need one. \def\smartitalicx{\ifx\next,\else\ifx\next-\else\ifx\next.\else \ptexslash\fi\fi\fi} \def\smartslanted#1{{\ifusingtt\ttsl\sl #1}\futurelet\next\smartitalicx} \def\smartitalic#1{{\ifusingtt\ttsl\it #1}\futurelet\next\smartitalicx} % like \smartslanted except unconditionally uses \ttsl. % @var is set to this for defun arguments. \def\ttslanted#1{{\ttsl #1}\futurelet\next\smartitalicx} % like \smartslanted except unconditionally use \sl. We never want % ttsl for book titles, do we? \def\cite#1{{\sl #1}\futurelet\next\smartitalicx} \let\i=\smartitalic \let\slanted=\smartslanted \let\var=\smartslanted \let\dfn=\smartslanted \let\emph=\smartitalic % @b, explicit bold. \def\b#1{{\bf #1}} \let\strong=\b % @sansserif, explicit sans. \def\sansserif#1{{\sf #1}} % We can't just use \exhyphenpenalty, because that only has effect at % the end of a paragraph. Restore normal hyphenation at the end of the % group within which \nohyphenation is presumably called. % \def\nohyphenation{\hyphenchar\font = -1 \aftergroup\restorehyphenation} \def\restorehyphenation{\hyphenchar\font = `- } % Set sfcode to normal for the chars that usually have another value. % Can't use plain's \frenchspacing because it uses the `\x notation, and % sometimes \x has an active definition that messes things up. % \catcode`@=11 \def\plainfrenchspacing{% \sfcode\dotChar =\@m \sfcode\questChar=\@m \sfcode\exclamChar=\@m \sfcode\colonChar=\@m \sfcode\semiChar =\@m \sfcode\commaChar =\@m \def\endofsentencespacefactor{1000}% for @. and friends } \def\plainnonfrenchspacing{% \sfcode`\.3000\sfcode`\?3000\sfcode`\!3000 \sfcode`\:2000\sfcode`\;1500\sfcode`\,1250 \def\endofsentencespacefactor{3000}% for @. and friends } \catcode`@=\other \def\endofsentencespacefactor{3000}% default \def\t#1{% {\tt \rawbackslash \plainfrenchspacing #1}% \null } \def\samp#1{`\tclose{#1}'\null} \setfont\keyrm\rmshape{8}{1000}{OT1} \font\keysy=cmsy9 \def\key#1{{\keyrm\textfont2=\keysy \leavevmode\hbox{% \raise0.4pt\hbox{\angleleft}\kern-.08em\vtop{% \vbox{\hrule\kern-0.4pt \hbox{\raise0.4pt\hbox{\vphantom{\angleleft}}#1}}% \kern-0.4pt\hrule}% \kern-.06em\raise0.4pt\hbox{\angleright}}}} \def\key #1{{\nohyphenation \uppercase{#1}}\null} % The old definition, with no lozenge: %\def\key #1{{\ttsl \nohyphenation \uppercase{#1}}\null} \def\ctrl #1{{\tt \rawbackslash \hat}#1} % @file, @option are the same as @samp. \let\file=\samp \let\option=\samp % @code is a modification of @t, % which makes spaces the same size as normal in the surrounding text. \def\tclose#1{% {% % Change normal interword space to be same as for the current font. \spaceskip = \fontdimen2\font % % Switch to typewriter. \tt % % But `\ ' produces the large typewriter interword space. \def\ {{\spaceskip = 0pt{} }}% % % Turn off hyphenation. \nohyphenation % \rawbackslash \plainfrenchspacing #1% }% \null } % We *must* turn on hyphenation at `-' and `_' in @code. % Otherwise, it is too hard to avoid overfull hboxes % in the Emacs manual, the Library manual, etc. % Unfortunately, TeX uses one parameter (\hyphenchar) to control % both hyphenation at - and hyphenation within words. % We must therefore turn them both off (\tclose does that) % and arrange explicitly to hyphenate at a dash. % -- rms. { \catcode`\-=\active \catcode`\_=\active \catcode`\'=\active \catcode`\`=\active % \global\def\code{\begingroup \catcode\rquoteChar=\active \catcode\lquoteChar=\active \let'\codequoteright \let`\codequoteleft % \catcode\dashChar=\active \catcode\underChar=\active \ifallowcodebreaks \let-\codedash \let_\codeunder \else \let-\realdash \let_\realunder \fi \codex } } \def\realdash{-} \def\codedash{-\discretionary{}{}{}} \def\codeunder{% % this is all so @math{@code{var_name}+1} can work. In math mode, _ % is "active" (mathcode"8000) and \normalunderscore (or \char95, etc.) % will therefore expand the active definition of _, which is us % (inside @code that is), therefore an endless loop. \ifusingtt{\ifmmode \mathchar"075F % class 0=ordinary, family 7=ttfam, pos 0x5F=_. \else\normalunderscore \fi \discretionary{}{}{}}% {\_}% } \def\codex #1{\tclose{#1}\endgroup} % An additional complication: the above will allow breaks after, e.g., % each of the four underscores in __typeof__. This is undesirable in % some manuals, especially if they don't have long identifiers in % general. @allowcodebreaks provides a way to control this. % \newif\ifallowcodebreaks \allowcodebreakstrue \def\keywordtrue{true} \def\keywordfalse{false} \parseargdef\allowcodebreaks{% \def\txiarg{#1}% \ifx\txiarg\keywordtrue \allowcodebreakstrue \else\ifx\txiarg\keywordfalse \allowcodebreaksfalse \else \errhelp = \EMsimple \errmessage{Unknown @allowcodebreaks option `\txiarg'}% \fi\fi } % @kbd is like @code, except that if the argument is just one @key command, % then @kbd has no effect. % @kbdinputstyle -- arg is `distinct' (@kbd uses slanted tty font always), % `example' (@kbd uses ttsl only inside of @example and friends), % or `code' (@kbd uses normal tty font always). \parseargdef\kbdinputstyle{% \def\txiarg{#1}% \ifx\txiarg\worddistinct \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\ttsl}% \else\ifx\txiarg\wordexample \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\tt}% \else\ifx\txiarg\wordcode \gdef\kbdexamplefont{\tt}\gdef\kbdfont{\tt}% \else \errhelp = \EMsimple \errmessage{Unknown @kbdinputstyle option `\txiarg'}% \fi\fi\fi } \def\worddistinct{distinct} \def\wordexample{example} \def\wordcode{code} % Default is `distinct.' \kbdinputstyle distinct \def\xkey{\key} \def\kbdfoo#1#2#3\par{\def\one{#1}\def\three{#3}\def\threex{??}% \ifx\one\xkey\ifx\threex\three \key{#2}% \else{\tclose{\kbdfont\look}}\fi \else{\tclose{\kbdfont\look}}\fi} % For @indicateurl, @env, @command quotes seem unnecessary, so use \code. \let\indicateurl=\code \let\env=\code \let\command=\code % @uref (abbreviation for `urlref') takes an optional (comma-separated) % second argument specifying the text to display and an optional third % arg as text to display instead of (rather than in addition to) the url % itself. First (mandatory) arg is the url. Perhaps eventually put in % a hypertex \special here. % \def\uref#1{\douref #1,,,\finish} \def\douref#1,#2,#3,#4\finish{\begingroup \unsepspaces \pdfurl{#1}% \setbox0 = \hbox{\ignorespaces #3}% \ifdim\wd0 > 0pt \unhbox0 % third arg given, show only that \else \setbox0 = \hbox{\ignorespaces #2}% \ifdim\wd0 > 0pt \ifpdf \unhbox0 % PDF: 2nd arg given, show only it \else \unhbox0\ (\code{#1})% DVI: 2nd arg given, show both it and url \fi \else \code{#1}% only url given, so show it \fi \fi \endlink \endgroup} % @url synonym for @uref, since that's how everyone uses it. % \let\url=\uref % rms does not like angle brackets --karl, 17may97. % So now @email is just like @uref, unless we are pdf. % %\def\email#1{\angleleft{\tt #1}\angleright} \ifpdf \def\email#1{\doemail#1,,\finish} \def\doemail#1,#2,#3\finish{\begingroup \unsepspaces \pdfurl{mailto:#1}% \setbox0 = \hbox{\ignorespaces #2}% \ifdim\wd0>0pt\unhbox0\else\code{#1}\fi \endlink \endgroup} \else \let\email=\uref \fi % Check if we are currently using a typewriter font. Since all the % Computer Modern typewriter fonts have zero interword stretch (and % shrink), and it is reasonable to expect all typewriter fonts to have % this property, we can check that font parameter. % \def\ifmonospace{\ifdim\fontdimen3\font=0pt } % Typeset a dimension, e.g., `in' or `pt'. The only reason for the % argument is to make the input look right: @dmn{pt} instead of @dmn{}pt. % \def\dmn#1{\thinspace #1} \def\kbd#1{\def\look{#1}\expandafter\kbdfoo\look??\par} % @l was never documented to mean ``switch to the Lisp font'', % and it is not used as such in any manual I can find. We need it for % Polish suppressed-l. --karl, 22sep96. %\def\l#1{{\li #1}\null} % Explicit font changes: @r, @sc, undocumented @ii. \def\r#1{{\rm #1}} % roman font \def\sc#1{{\smallcaps#1}} % smallcaps font \def\ii#1{{\it #1}} % italic font % @acronym for "FBI", "NATO", and the like. % We print this one point size smaller, since it's intended for % all-uppercase. % \def\acronym#1{\doacronym #1,,\finish} \def\doacronym#1,#2,#3\finish{% {\selectfonts\lsize #1}% \def\temp{#2}% \ifx\temp\empty \else \space ({\unsepspaces \ignorespaces \temp \unskip})% \fi } % @abbr for "Comput. J." and the like. % No font change, but don't do end-of-sentence spacing. % \def\abbr#1{\doabbr #1,,\finish} \def\doabbr#1,#2,#3\finish{% {\plainfrenchspacing #1}% \def\temp{#2}% \ifx\temp\empty \else \space ({\unsepspaces \ignorespaces \temp \unskip})% \fi } % @pounds{} is a sterling sign, which Knuth put in the CM italic font. % \def\pounds{{\it\$}} % @euro{} comes from a separate font, depending on the current style. % We use the free feym* fonts from the eurosym package by Henrik % Theiling, which support regular, slanted, bold and bold slanted (and % "outlined" (blackboard board, sort of) versions, which we don't need). % It is available from http://www.ctan.org/tex-archive/fonts/eurosym. % % Although only regular is the truly official Euro symbol, we ignore % that. The Euro is designed to be slightly taller than the regular % font height. % % feymr - regular % feymo - slanted % feybr - bold % feybo - bold slanted % % There is no good (free) typewriter version, to my knowledge. % A feymr10 euro is ~7.3pt wide, while a normal cmtt10 char is ~5.25pt wide. % Hmm. % % Also doesn't work in math. Do we need to do math with euro symbols? % Hope not. % % \def\euro{{\eurofont e}} \def\eurofont{% % We set the font at each command, rather than predefining it in % \textfonts and the other font-switching commands, so that % installations which never need the symbol don't have to have the % font installed. % % There is only one designed size (nominal 10pt), so we always scale % that to the current nominal size. % % By the way, simply using "at 1em" works for cmr10 and the like, but % does not work for cmbx10 and other extended/shrunken fonts. % \def\eurosize{\csname\curfontsize nominalsize\endcsname}% % \ifx\curfontstyle\bfstylename % bold: \font\thiseurofont = \ifusingit{feybo10}{feybr10} at \eurosize \else % regular: \font\thiseurofont = \ifusingit{feymo10}{feymr10} at \eurosize \fi \thiseurofont } % Hacks for glyphs from the EC fonts similar to \euro. We don't % use \let for the aliases, because sometimes we redefine the original % macro, and the alias should reflect the redefinition. \def\guillemetleft{{\ecfont \char"13}} \def\guillemotleft{\guillemetleft} \def\guillemetright{{\ecfont \char"14}} \def\guillemotright{\guillemetright} \def\guilsinglleft{{\ecfont \char"0E}} \def\guilsinglright{{\ecfont \char"0F}} \def\quotedblbase{{\ecfont \char"12}} \def\quotesinglbase{{\ecfont \char"0D}} % \def\ecfont{% % We can't distinguish serif/sanserif and italic/slanted, but this % is used for crude hacks anyway (like adding French and German % quotes to documents typeset with CM, where we lose kerning), so % hopefully nobody will notice/care. \edef\ecsize{\csname\curfontsize ecsize\endcsname}% \edef\nominalsize{\csname\curfontsize nominalsize\endcsname}% \ifx\curfontstyle\bfstylename % bold: \font\thisecfont = ecb\ifusingit{i}{x}\ecsize \space at \nominalsize \else % regular: \font\thisecfont = ec\ifusingit{ti}{rm}\ecsize \space at \nominalsize \fi \thisecfont } % @registeredsymbol - R in a circle. The font for the R should really % be smaller yet, but lllsize is the best we can do for now. % Adapted from the plain.tex definition of \copyright. % \def\registeredsymbol{% $^{{\ooalign{\hfil\raise.07ex\hbox{\selectfonts\lllsize R}% \hfil\crcr\Orb}}% }$% } % @textdegree - the normal degrees sign. % \def\textdegree{$^\circ$} % Laurent Siebenmann reports \Orb undefined with: % Textures 1.7.7 (preloaded format=plain 93.10.14) (68K) 16 APR 2004 02:38 % so we'll define it if necessary. % \ifx\Orb\undefined \def\Orb{\mathhexbox20D} \fi % Quotes. \chardef\quotedblleft="5C \chardef\quotedblright=`\" \chardef\quoteleft=`\` \chardef\quoteright=`\' \message{page headings,} \newskip\titlepagetopglue \titlepagetopglue = 1.5in \newskip\titlepagebottomglue \titlepagebottomglue = 2pc % First the title page. Must do @settitle before @titlepage. \newif\ifseenauthor \newif\iffinishedtitlepage % Do an implicit @contents or @shortcontents after @end titlepage if the % user says @setcontentsaftertitlepage or @setshortcontentsaftertitlepage. % \newif\ifsetcontentsaftertitlepage \let\setcontentsaftertitlepage = \setcontentsaftertitlepagetrue \newif\ifsetshortcontentsaftertitlepage \let\setshortcontentsaftertitlepage = \setshortcontentsaftertitlepagetrue \parseargdef\shorttitlepage{\begingroup\hbox{}\vskip 1.5in \chaprm \centerline{#1}% \endgroup\page\hbox{}\page} \envdef\titlepage{% % Open one extra group, as we want to close it in the middle of \Etitlepage. \begingroup \parindent=0pt \textfonts % Leave some space at the very top of the page. \vglue\titlepagetopglue % No rule at page bottom unless we print one at the top with @title. \finishedtitlepagetrue % % Most title ``pages'' are actually two pages long, with space % at the top of the second. We don't want the ragged left on the second. \let\oldpage = \page \def\page{% \iffinishedtitlepage\else \finishtitlepage \fi \let\page = \oldpage \page \null }% } \def\Etitlepage{% \iffinishedtitlepage\else \finishtitlepage \fi % It is important to do the page break before ending the group, % because the headline and footline are only empty inside the group. % If we use the new definition of \page, we always get a blank page % after the title page, which we certainly don't want. \oldpage \endgroup % % Need this before the \...aftertitlepage checks so that if they are % in effect the toc pages will come out with page numbers. \HEADINGSon % % If they want short, they certainly want long too. \ifsetshortcontentsaftertitlepage \shortcontents \contents \global\let\shortcontents = \relax \global\let\contents = \relax \fi % \ifsetcontentsaftertitlepage \contents \global\let\contents = \relax \global\let\shortcontents = \relax \fi } \def\finishtitlepage{% \vskip4pt \hrule height 2pt width \hsize \vskip\titlepagebottomglue \finishedtitlepagetrue } %%% Macros to be used within @titlepage: \let\subtitlerm=\tenrm \def\subtitlefont{\subtitlerm \normalbaselineskip = 13pt \normalbaselines} \def\authorfont{\authorrm \normalbaselineskip = 16pt \normalbaselines \let\tt=\authortt} \parseargdef\title{% \checkenv\titlepage \leftline{\titlefonts\rm #1} % print a rule at the page bottom also. \finishedtitlepagefalse \vskip4pt \hrule height 4pt width \hsize \vskip4pt } \parseargdef\subtitle{% \checkenv\titlepage {\subtitlefont \rightline{#1}}% } % @author should come last, but may come many times. % It can also be used inside @quotation. % \parseargdef\author{% \def\temp{\quotation}% \ifx\thisenv\temp \def\quotationauthor{#1}% printed in \Equotation. \else \checkenv\titlepage \ifseenauthor\else \vskip 0pt plus 1filll \seenauthortrue \fi {\authorfont \leftline{#1}}% \fi } %%% Set up page headings and footings. \let\thispage=\folio \newtoks\evenheadline % headline on even pages \newtoks\oddheadline % headline on odd pages \newtoks\evenfootline % footline on even pages \newtoks\oddfootline % footline on odd pages % Now make TeX use those variables \headline={{\textfonts\rm \ifodd\pageno \the\oddheadline \else \the\evenheadline \fi}} \footline={{\textfonts\rm \ifodd\pageno \the\oddfootline \else \the\evenfootline \fi}\HEADINGShook} \let\HEADINGShook=\relax % Commands to set those variables. % For example, this is what @headings on does % @evenheading @thistitle|@thispage|@thischapter % @oddheading @thischapter|@thispage|@thistitle % @evenfooting @thisfile|| % @oddfooting ||@thisfile \def\evenheading{\parsearg\evenheadingxxx} \def\evenheadingxxx #1{\evenheadingyyy #1\|\|\|\|\finish} \def\evenheadingyyy #1\|#2\|#3\|#4\finish{% \global\evenheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}} \def\oddheading{\parsearg\oddheadingxxx} \def\oddheadingxxx #1{\oddheadingyyy #1\|\|\|\|\finish} \def\oddheadingyyy #1\|#2\|#3\|#4\finish{% \global\oddheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}} \parseargdef\everyheading{\oddheadingxxx{#1}\evenheadingxxx{#1}}% \def\evenfooting{\parsearg\evenfootingxxx} \def\evenfootingxxx #1{\evenfootingyyy #1\|\|\|\|\finish} \def\evenfootingyyy #1\|#2\|#3\|#4\finish{% \global\evenfootline={\rlap{\centerline{#2}}\line{#1\hfil#3}}} \def\oddfooting{\parsearg\oddfootingxxx} \def\oddfootingxxx #1{\oddfootingyyy #1\|\|\|\|\finish} \def\oddfootingyyy #1\|#2\|#3\|#4\finish{% \global\oddfootline = {\rlap{\centerline{#2}}\line{#1\hfil#3}}% % % Leave some space for the footline. Hopefully ok to assume % @evenfooting will not be used by itself. \global\advance\pageheight by -12pt \global\advance\vsize by -12pt } \parseargdef\everyfooting{\oddfootingxxx{#1}\evenfootingxxx{#1}} % @evenheadingmarks top \thischapter <- chapter at the top of a page % @evenheadingmarks bottom \thischapter <- chapter at the bottom of a page % % The same set of arguments for: % % @oddheadingmarks % @evenfootingmarks % @oddfootingmarks % @everyheadingmarks % @everyfootingmarks \def\evenheadingmarks{\headingmarks{even}{heading}} \def\oddheadingmarks{\headingmarks{odd}{heading}} \def\evenfootingmarks{\headingmarks{even}{footing}} \def\oddfootingmarks{\headingmarks{odd}{footing}} \def\everyheadingmarks#1 {\headingmarks{even}{heading}{#1} \headingmarks{odd}{heading}{#1} } \def\everyfootingmarks#1 {\headingmarks{even}{footing}{#1} \headingmarks{odd}{footing}{#1} } % #1 = even/odd, #2 = heading/footing, #3 = top/bottom. \def\headingmarks#1#2#3 {% \expandafter\let\expandafter\temp \csname get#3headingmarks\endcsname \global\expandafter\let\csname get#1#2marks\endcsname \temp } \everyheadingmarks bottom \everyfootingmarks bottom % @headings double turns headings on for double-sided printing. % @headings single turns headings on for single-sided printing. % @headings off turns them off. % @headings on same as @headings double, retained for compatibility. % @headings after turns on double-sided headings after this page. % @headings doubleafter turns on double-sided headings after this page. % @headings singleafter turns on single-sided headings after this page. % By default, they are off at the start of a document, % and turned `on' after @end titlepage. \def\headings #1 {\csname HEADINGS#1\endcsname} \def\HEADINGSoff{% \global\evenheadline={\hfil} \global\evenfootline={\hfil} \global\oddheadline={\hfil} \global\oddfootline={\hfil}} \HEADINGSoff % When we turn headings on, set the page number to 1. % For double-sided printing, put current file name in lower left corner, % chapter name on inside top of right hand pages, document % title on inside top of left hand pages, and page numbers on outside top % edge of all pages. \def\HEADINGSdouble{% \global\pageno=1 \global\evenfootline={\hfil} \global\oddfootline={\hfil} \global\evenheadline={\line{\folio\hfil\thistitle}} \global\oddheadline={\line{\thischapter\hfil\folio}} \global\let\contentsalignmacro = \chapoddpage } \let\contentsalignmacro = \chappager % For single-sided printing, chapter title goes across top left of page, % page number on top right. \def\HEADINGSsingle{% \global\pageno=1 \global\evenfootline={\hfil} \global\oddfootline={\hfil} \global\evenheadline={\line{\thischapter\hfil\folio}} \global\oddheadline={\line{\thischapter\hfil\folio}} \global\let\contentsalignmacro = \chappager } \def\HEADINGSon{\HEADINGSdouble} \def\HEADINGSafter{\let\HEADINGShook=\HEADINGSdoublex} \let\HEADINGSdoubleafter=\HEADINGSafter \def\HEADINGSdoublex{% \global\evenfootline={\hfil} \global\oddfootline={\hfil} \global\evenheadline={\line{\folio\hfil\thistitle}} \global\oddheadline={\line{\thischapter\hfil\folio}} \global\let\contentsalignmacro = \chapoddpage } \def\HEADINGSsingleafter{\let\HEADINGShook=\HEADINGSsinglex} \def\HEADINGSsinglex{% \global\evenfootline={\hfil} \global\oddfootline={\hfil} \global\evenheadline={\line{\thischapter\hfil\folio}} \global\oddheadline={\line{\thischapter\hfil\folio}} \global\let\contentsalignmacro = \chappager } % Subroutines used in generating headings % This produces Day Month Year style of output. % Only define if not already defined, in case a txi-??.tex file has set % up a different format (e.g., txi-cs.tex does this). \ifx\today\undefined \def\today{% \number\day\space \ifcase\month \or\putwordMJan\or\putwordMFeb\or\putwordMMar\or\putwordMApr \or\putwordMMay\or\putwordMJun\or\putwordMJul\or\putwordMAug \or\putwordMSep\or\putwordMOct\or\putwordMNov\or\putwordMDec \fi \space\number\year} \fi % @settitle line... specifies the title of the document, for headings. % It generates no output of its own. \def\thistitle{\putwordNoTitle} \def\settitle{\parsearg{\gdef\thistitle}} \message{tables,} % Tables -- @table, @ftable, @vtable, @item(x). % default indentation of table text \newdimen\tableindent \tableindent=.8in % default indentation of @itemize and @enumerate text \newdimen\itemindent \itemindent=.3in % margin between end of table item and start of table text. \newdimen\itemmargin \itemmargin=.1in % used internally for \itemindent minus \itemmargin \newdimen\itemmax % Note @table, @ftable, and @vtable define @item, @itemx, etc., with % these defs. % They also define \itemindex % to index the item name in whatever manner is desired (perhaps none). \newif\ifitemxneedsnegativevskip \def\itemxpar{\par\ifitemxneedsnegativevskip\nobreak\vskip-\parskip\nobreak\fi} \def\internalBitem{\smallbreak \parsearg\itemzzz} \def\internalBitemx{\itemxpar \parsearg\itemzzz} \def\itemzzz #1{\begingroup % \advance\hsize by -\rightskip \advance\hsize by -\tableindent \setbox0=\hbox{\itemindicate{#1}}% \itemindex{#1}% \nobreak % This prevents a break before @itemx. % % If the item text does not fit in the space we have, put it on a line % by itself, and do not allow a page break either before or after that % line. We do not start a paragraph here because then if the next % command is, e.g., @kindex, the whatsit would get put into the % horizontal list on a line by itself, resulting in extra blank space. \ifdim \wd0>\itemmax % % Make this a paragraph so we get the \parskip glue and wrapping, % but leave it ragged-right. \begingroup \advance\leftskip by-\tableindent \advance\hsize by\tableindent \advance\rightskip by0pt plus1fil \leavevmode\unhbox0\par \endgroup % % We're going to be starting a paragraph, but we don't want the % \parskip glue -- logically it's part of the @item we just started. \nobreak \vskip-\parskip % % Stop a page break at the \parskip glue coming up. However, if % what follows is an environment such as @example, there will be no % \parskip glue; then the negative vskip we just inserted would % cause the example and the item to crash together. So we use this % bizarre value of 10001 as a signal to \aboveenvbreak to insert % \parskip glue after all. Section titles are handled this way also. % \penalty 10001 \endgroup \itemxneedsnegativevskipfalse \else % The item text fits into the space. Start a paragraph, so that the % following text (if any) will end up on the same line. \noindent % Do this with kerns and \unhbox so that if there is a footnote in % the item text, it can migrate to the main vertical list and % eventually be printed. \nobreak\kern-\tableindent \dimen0 = \itemmax \advance\dimen0 by \itemmargin \advance\dimen0 by -\wd0 \unhbox0 \nobreak\kern\dimen0 \endgroup \itemxneedsnegativevskiptrue \fi } \def\item{\errmessage{@item while not in a list environment}} \def\itemx{\errmessage{@itemx while not in a list environment}} % @table, @ftable, @vtable. \envdef\table{% \let\itemindex\gobble \tablecheck{table}% } \envdef\ftable{% \def\itemindex ##1{\doind {fn}{\code{##1}}}% \tablecheck{ftable}% } \envdef\vtable{% \def\itemindex ##1{\doind {vr}{\code{##1}}}% \tablecheck{vtable}% } \def\tablecheck#1{% \ifnum \the\catcode`\^^M=\active \endgroup \errmessage{This command won't work in this context; perhaps the problem is that we are \inenvironment\thisenv}% \def\next{\doignore{#1}}% \else \let\next\tablex \fi \next } \def\tablex#1{% \def\itemindicate{#1}% \parsearg\tabley } \def\tabley#1{% {% \makevalueexpandable \edef\temp{\noexpand\tablez #1\space\space\space}% \expandafter }\temp \endtablez } \def\tablez #1 #2 #3 #4\endtablez{% \aboveenvbreak \ifnum 0#1>0 \advance \leftskip by #1\mil \fi \ifnum 0#2>0 \tableindent=#2\mil \fi \ifnum 0#3>0 \advance \rightskip by #3\mil \fi \itemmax=\tableindent \advance \itemmax by -\itemmargin \advance \leftskip by \tableindent \exdentamount=\tableindent \parindent = 0pt \parskip = \smallskipamount \ifdim \parskip=0pt \parskip=2pt \fi \let\item = \internalBitem \let\itemx = \internalBitemx } \def\Etable{\endgraf\afterenvbreak} \let\Eftable\Etable \let\Evtable\Etable \let\Eitemize\Etable \let\Eenumerate\Etable % This is the counter used by @enumerate, which is really @itemize \newcount \itemno \envdef\itemize{\parsearg\doitemize} \def\doitemize#1{% \aboveenvbreak \itemmax=\itemindent \advance\itemmax by -\itemmargin \advance\leftskip by \itemindent \exdentamount=\itemindent \parindent=0pt \parskip=\smallskipamount \ifdim\parskip=0pt \parskip=2pt \fi \def\itemcontents{#1}% % @itemize with no arg is equivalent to @itemize @bullet. \ifx\itemcontents\empty\def\itemcontents{\bullet}\fi \let\item=\itemizeitem } % Definition of @item while inside @itemize and @enumerate. % \def\itemizeitem{% \advance\itemno by 1 % for enumerations {\let\par=\endgraf \smallbreak}% reasonable place to break {% % If the document has an @itemize directly after a section title, a % \nobreak will be last on the list, and \sectionheading will have % done a \vskip-\parskip. In that case, we don't want to zero % parskip, or the item text will crash with the heading. On the % other hand, when there is normal text preceding the item (as there % usually is), we do want to zero parskip, or there would be too much % space. In that case, we won't have a \nobreak before. At least % that's the theory. \ifnum\lastpenalty<10000 \parskip=0in \fi \noindent \hbox to 0pt{\hss \itemcontents \kern\itemmargin}% \vadjust{\penalty 1200}}% not good to break after first line of item. \flushcr } % \splitoff TOKENS\endmark defines \first to be the first token in % TOKENS, and \rest to be the remainder. % \def\splitoff#1#2\endmark{\def\first{#1}\def\rest{#2}}% % Allow an optional argument of an uppercase letter, lowercase letter, % or number, to specify the first label in the enumerated list. No % argument is the same as `1'. % \envparseargdef\enumerate{\enumeratey #1 \endenumeratey} \def\enumeratey #1 #2\endenumeratey{% % If we were given no argument, pretend we were given `1'. \def\thearg{#1}% \ifx\thearg\empty \def\thearg{1}\fi % % Detect if the argument is a single token. If so, it might be a % letter. Otherwise, the only valid thing it can be is a number. % (We will always have one token, because of the test we just made. % This is a good thing, since \splitoff doesn't work given nothing at % all -- the first parameter is undelimited.) \expandafter\splitoff\thearg\endmark \ifx\rest\empty % Only one token in the argument. It could still be anything. % A ``lowercase letter'' is one whose \lccode is nonzero. % An ``uppercase letter'' is one whose \lccode is both nonzero, and % not equal to itself. % Otherwise, we assume it's a number. % % We need the \relax at the end of the \ifnum lines to stop TeX from % continuing to look for a . % \ifnum\lccode\expandafter`\thearg=0\relax \numericenumerate % a number (we hope) \else % It's a letter. \ifnum\lccode\expandafter`\thearg=\expandafter`\thearg\relax \lowercaseenumerate % lowercase letter \else \uppercaseenumerate % uppercase letter \fi \fi \else % Multiple tokens in the argument. We hope it's a number. \numericenumerate \fi } % An @enumerate whose labels are integers. The starting integer is % given in \thearg. % \def\numericenumerate{% \itemno = \thearg \startenumeration{\the\itemno}% } % The starting (lowercase) letter is in \thearg. \def\lowercaseenumerate{% \itemno = \expandafter`\thearg \startenumeration{% % Be sure we're not beyond the end of the alphabet. \ifnum\itemno=0 \errmessage{No more lowercase letters in @enumerate; get a bigger alphabet}% \fi \char\lccode\itemno }% } % The starting (uppercase) letter is in \thearg. \def\uppercaseenumerate{% \itemno = \expandafter`\thearg \startenumeration{% % Be sure we're not beyond the end of the alphabet. \ifnum\itemno=0 \errmessage{No more uppercase letters in @enumerate; get a bigger alphabet} \fi \char\uccode\itemno }% } % Call \doitemize, adding a period to the first argument and supplying the % common last two arguments. Also subtract one from the initial value in % \itemno, since @item increments \itemno. % \def\startenumeration#1{% \advance\itemno by -1 \doitemize{#1.}\flushcr } % @alphaenumerate and @capsenumerate are abbreviations for giving an arg % to @enumerate. % \def\alphaenumerate{\enumerate{a}} \def\capsenumerate{\enumerate{A}} \def\Ealphaenumerate{\Eenumerate} \def\Ecapsenumerate{\Eenumerate} % @multitable macros % Amy Hendrickson, 8/18/94, 3/6/96 % % @multitable ... @end multitable will make as many columns as desired. % Contents of each column will wrap at width given in preamble. Width % can be specified either with sample text given in a template line, % or in percent of \hsize, the current width of text on page. % Table can continue over pages but will only break between lines. % To make preamble: % % Either define widths of columns in terms of percent of \hsize: % @multitable @columnfractions .25 .3 .45 % @item ... % % Numbers following @columnfractions are the percent of the total % current hsize to be used for each column. You may use as many % columns as desired. % Or use a template: % @multitable {Column 1 template} {Column 2 template} {Column 3 template} % @item ... % using the widest term desired in each column. % Each new table line starts with @item, each subsequent new column % starts with @tab. Empty columns may be produced by supplying @tab's % with nothing between them for as many times as empty columns are needed, % ie, @tab@tab@tab will produce two empty columns. % @item, @tab do not need to be on their own lines, but it will not hurt % if they are. % Sample multitable: % @multitable {Column 1 template} {Column 2 template} {Column 3 template} % @item first col stuff @tab second col stuff @tab third col % @item % first col stuff % @tab % second col stuff % @tab % third col % @item first col stuff @tab second col stuff % @tab Many paragraphs of text may be used in any column. % % They will wrap at the width determined by the template. % @item@tab@tab This will be in third column. % @end multitable % Default dimensions may be reset by user. % @multitableparskip is vertical space between paragraphs in table. % @multitableparindent is paragraph indent in table. % @multitablecolmargin is horizontal space to be left between columns. % @multitablelinespace is space to leave between table items, baseline % to baseline. % 0pt means it depends on current normal line spacing. % \newskip\multitableparskip \newskip\multitableparindent \newdimen\multitablecolspace \newskip\multitablelinespace \multitableparskip=0pt \multitableparindent=6pt \multitablecolspace=12pt \multitablelinespace=0pt % Macros used to set up halign preamble: % \let\endsetuptable\relax \def\xendsetuptable{\endsetuptable} \let\columnfractions\relax \def\xcolumnfractions{\columnfractions} \newif\ifsetpercent % #1 is the @columnfraction, usually a decimal number like .5, but might % be just 1. We just use it, whatever it is. % \def\pickupwholefraction#1 {% \global\advance\colcount by 1 \expandafter\xdef\csname col\the\colcount\endcsname{#1\hsize}% \setuptable } \newcount\colcount \def\setuptable#1{% \def\firstarg{#1}% \ifx\firstarg\xendsetuptable \let\go = \relax \else \ifx\firstarg\xcolumnfractions \global\setpercenttrue \else \ifsetpercent \let\go\pickupwholefraction \else \global\advance\colcount by 1 \setbox0=\hbox{#1\unskip\space}% Add a normal word space as a % separator; typically that is always in the input, anyway. \expandafter\xdef\csname col\the\colcount\endcsname{\the\wd0}% \fi \fi \ifx\go\pickupwholefraction % Put the argument back for the \pickupwholefraction call, so % we'll always have a period there to be parsed. \def\go{\pickupwholefraction#1}% \else \let\go = \setuptable \fi% \fi \go } % multitable-only commands. % % @headitem starts a heading row, which we typeset in bold. % Assignments have to be global since we are inside the implicit group % of an alignment entry. Note that \everycr resets \everytab. \def\headitem{\checkenv\multitable \crcr \global\everytab={\bf}\the\everytab}% % % A \tab used to include \hskip1sp. But then the space in a template % line is not enough. That is bad. So let's go back to just `&' until % we encounter the problem it was intended to solve again. % --karl, nathan@acm.org, 20apr99. \def\tab{\checkenv\multitable &\the\everytab}% % @multitable ... @end multitable definitions: % \newtoks\everytab % insert after every tab. % \envdef\multitable{% \vskip\parskip \startsavinginserts % % @item within a multitable starts a normal row. % We use \def instead of \let so that if one of the multitable entries % contains an @itemize, we don't choke on the \item (seen as \crcr aka % \endtemplate) expanding \doitemize. \def\item{\crcr}% % \tolerance=9500 \hbadness=9500 \setmultitablespacing \parskip=\multitableparskip \parindent=\multitableparindent \overfullrule=0pt \global\colcount=0 % \everycr = {% \noalign{% \global\everytab={}% \global\colcount=0 % Reset the column counter. % Check for saved footnotes, etc. \checkinserts % Keeps underfull box messages off when table breaks over pages. %\filbreak % Maybe so, but it also creates really weird page breaks when the % table breaks over pages. Wouldn't \vfil be better? Wait until the % problem manifests itself, so it can be fixed for real --karl. }% }% % \parsearg\domultitable } \def\domultitable#1{% % To parse everything between @multitable and @item: \setuptable#1 \endsetuptable % % This preamble sets up a generic column definition, which will % be used as many times as user calls for columns. % \vtop will set a single line and will also let text wrap and % continue for many paragraphs if desired. \halign\bgroup &% \global\advance\colcount by 1 \multistrut \vtop{% % Use the current \colcount to find the correct column width: \hsize=\expandafter\csname col\the\colcount\endcsname % % In order to keep entries from bumping into each other % we will add a \leftskip of \multitablecolspace to all columns after % the first one. % % If a template has been used, we will add \multitablecolspace % to the width of each template entry. % % If the user has set preamble in terms of percent of \hsize we will % use that dimension as the width of the column, and the \leftskip % will keep entries from bumping into each other. Table will start at % left margin and final column will justify at right margin. % % Make sure we don't inherit \rightskip from the outer environment. \rightskip=0pt \ifnum\colcount=1 % The first column will be indented with the surrounding text. \advance\hsize by\leftskip \else \ifsetpercent \else % If user has not set preamble in terms of percent of \hsize % we will advance \hsize by \multitablecolspace. \advance\hsize by \multitablecolspace \fi % In either case we will make \leftskip=\multitablecolspace: \leftskip=\multitablecolspace \fi % Ignoring space at the beginning and end avoids an occasional spurious % blank line, when TeX decides to break the line at the space before the % box from the multistrut, so the strut ends up on a line by itself. % For example: % @multitable @columnfractions .11 .89 % @item @code{#} % @tab Legal holiday which is valid in major parts of the whole country. % Is automatically provided with highlighting sequences respectively % marking characters. \noindent\ignorespaces##\unskip\multistrut }\cr } \def\Emultitable{% \crcr \egroup % end the \halign \global\setpercentfalse } \def\setmultitablespacing{% \def\multistrut{\strut}% just use the standard line spacing % % Compute \multitablelinespace (if not defined by user) for use in % \multitableparskip calculation. We used define \multistrut based on % this, but (ironically) that caused the spacing to be off. % See bug-texinfo report from Werner Lemberg, 31 Oct 2004 12:52:20 +0100. \ifdim\multitablelinespace=0pt \setbox0=\vbox{X}\global\multitablelinespace=\the\baselineskip \global\advance\multitablelinespace by-\ht0 \fi %% Test to see if parskip is larger than space between lines of %% table. If not, do nothing. %% If so, set to same dimension as multitablelinespace. \ifdim\multitableparskip>\multitablelinespace \global\multitableparskip=\multitablelinespace \global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller %% than skip between lines in the table. \fi% \ifdim\multitableparskip=0pt \global\multitableparskip=\multitablelinespace \global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller %% than skip between lines in the table. \fi} \message{conditionals,} % @iftex, @ifnotdocbook, @ifnothtml, @ifnotinfo, @ifnotplaintext, % @ifnotxml always succeed. They currently do nothing; we don't % attempt to check whether the conditionals are properly nested. But we % have to remember that they are conditionals, so that @end doesn't % attempt to close an environment group. % \def\makecond#1{% \expandafter\let\csname #1\endcsname = \relax \expandafter\let\csname iscond.#1\endcsname = 1 } \makecond{iftex} \makecond{ifnotdocbook} \makecond{ifnothtml} \makecond{ifnotinfo} \makecond{ifnotplaintext} \makecond{ifnotxml} % Ignore @ignore, @ifhtml, @ifinfo, and the like. % \def\direntry{\doignore{direntry}} \def\documentdescription{\doignore{documentdescription}} \def\docbook{\doignore{docbook}} \def\html{\doignore{html}} \def\ifdocbook{\doignore{ifdocbook}} \def\ifhtml{\doignore{ifhtml}} \def\ifinfo{\doignore{ifinfo}} \def\ifnottex{\doignore{ifnottex}} \def\ifplaintext{\doignore{ifplaintext}} \def\ifxml{\doignore{ifxml}} \def\ignore{\doignore{ignore}} \def\menu{\doignore{menu}} \def\xml{\doignore{xml}} % Ignore text until a line `@end #1', keeping track of nested conditionals. % % A count to remember the depth of nesting. \newcount\doignorecount \def\doignore#1{\begingroup % Scan in ``verbatim'' mode: \obeylines \catcode`\@ = \other \catcode`\{ = \other \catcode`\} = \other % % Make sure that spaces turn into tokens that match what \doignoretext wants. \spaceisspace % % Count number of #1's that we've seen. \doignorecount = 0 % % Swallow text until we reach the matching `@end #1'. \dodoignore{#1}% } { \catcode`_=11 % We want to use \_STOP_ which cannot appear in texinfo source. \obeylines % % \gdef\dodoignore#1{% % #1 contains the command name as a string, e.g., `ifinfo'. % % Define a command to find the next `@end #1'. \long\def\doignoretext##1^^M@end #1{% \doignoretextyyy##1^^M@#1\_STOP_}% % % And this command to find another #1 command, at the beginning of a % line. (Otherwise, we would consider a line `@c @ifset', for % example, to count as an @ifset for nesting.) \long\def\doignoretextyyy##1^^M@#1##2\_STOP_{\doignoreyyy{##2}\_STOP_}% % % And now expand that command. \doignoretext ^^M% }% } \def\doignoreyyy#1{% \def\temp{#1}% \ifx\temp\empty % Nothing found. \let\next\doignoretextzzz \else % Found a nested condition, ... \advance\doignorecount by 1 \let\next\doignoretextyyy % ..., look for another. % If we're here, #1 ends with ^^M\ifinfo (for example). \fi \next #1% the token \_STOP_ is present just after this macro. } % We have to swallow the remaining "\_STOP_". % \def\doignoretextzzz#1{% \ifnum\doignorecount = 0 % We have just found the outermost @end. \let\next\enddoignore \else % Still inside a nested condition. \advance\doignorecount by -1 \let\next\doignoretext % Look for the next @end. \fi \next } % Finish off ignored text. { \obeylines% % Ignore anything after the last `@end #1'; this matters in verbatim % environments, where otherwise the newline after an ignored conditional % would result in a blank line in the output. \gdef\enddoignore#1^^M{\endgroup\ignorespaces}% } % @set VAR sets the variable VAR to an empty value. % @set VAR REST-OF-LINE sets VAR to the value REST-OF-LINE. % % Since we want to separate VAR from REST-OF-LINE (which might be % empty), we can't just use \parsearg; we have to insert a space of our % own to delimit the rest of the line, and then take it out again if we % didn't need it. % We rely on the fact that \parsearg sets \catcode`\ =10. % \parseargdef\set{\setyyy#1 \endsetyyy} \def\setyyy#1 #2\endsetyyy{% {% \makevalueexpandable \def\temp{#2}% \edef\next{\gdef\makecsname{SET#1}}% \ifx\temp\empty \next{}% \else \setzzz#2\endsetzzz \fi }% } % Remove the trailing space \setxxx inserted. \def\setzzz#1 \endsetzzz{\next{#1}} % @clear VAR clears (i.e., unsets) the variable VAR. % \parseargdef\clear{% {% \makevalueexpandable \global\expandafter\let\csname SET#1\endcsname=\relax }% } % @value{foo} gets the text saved in variable foo. \def\value{\begingroup\makevalueexpandable\valuexxx} \def\valuexxx#1{\expandablevalue{#1}\endgroup} { \catcode`\- = \active \catcode`\_ = \active % \gdef\makevalueexpandable{% \let\value = \expandablevalue % We don't want these characters active, ... \catcode`\-=\other \catcode`\_=\other % ..., but we might end up with active ones in the argument if % we're called from @code, as @code{@value{foo-bar_}}, though. % So \let them to their normal equivalents. \let-\realdash \let_\normalunderscore } } % We have this subroutine so that we can handle at least some @value's % properly in indexes (we call \makevalueexpandable in \indexdummies). % The command has to be fully expandable (if the variable is set), since % the result winds up in the index file. This means that if the % variable's value contains other Texinfo commands, it's almost certain % it will fail (although perhaps we could fix that with sufficient work % to do a one-level expansion on the result, instead of complete). % \def\expandablevalue#1{% \expandafter\ifx\csname SET#1\endcsname\relax {[No value for ``#1'']}% \message{Variable `#1', used in @value, is not set.}% \else \csname SET#1\endcsname \fi } % @ifset VAR ... @end ifset reads the `...' iff VAR has been defined % with @set. % % To get special treatment of `@end ifset,' call \makeond and the redefine. % \makecond{ifset} \def\ifset{\parsearg{\doifset{\let\next=\ifsetfail}}} \def\doifset#1#2{% {% \makevalueexpandable \let\next=\empty \expandafter\ifx\csname SET#2\endcsname\relax #1% If not set, redefine \next. \fi \expandafter }\next } \def\ifsetfail{\doignore{ifset}} % @ifclear VAR ... @end ifclear reads the `...' iff VAR has never been % defined with @set, or has been undefined with @clear. % % The `\else' inside the `\doifset' parameter is a trick to reuse the % above code: if the variable is not set, do nothing, if it is set, % then redefine \next to \ifclearfail. % \makecond{ifclear} \def\ifclear{\parsearg{\doifset{\else \let\next=\ifclearfail}}} \def\ifclearfail{\doignore{ifclear}} % @dircategory CATEGORY -- specify a category of the dir file % which this file should belong to. Ignore this in TeX. \let\dircategory=\comment % @defininfoenclose. \let\definfoenclose=\comment \message{indexing,} % Index generation facilities % Define \newwrite to be identical to plain tex's \newwrite % except not \outer, so it can be used within macros and \if's. \edef\newwrite{\makecsname{ptexnewwrite}} % \newindex {foo} defines an index named foo. % It automatically defines \fooindex such that % \fooindex ...rest of line... puts an entry in the index foo. % It also defines \fooindfile to be the number of the output channel for % the file that accumulates this index. The file's extension is foo. % The name of an index should be no more than 2 characters long % for the sake of vms. % \def\newindex#1{% \iflinks \expandafter\newwrite \csname#1indfile\endcsname \openout \csname#1indfile\endcsname \jobname.#1 % Open the file \fi \expandafter\xdef\csname#1index\endcsname{% % Define @#1index \noexpand\doindex{#1}} } % @defindex foo == \newindex{foo} % \def\defindex{\parsearg\newindex} % Define @defcodeindex, like @defindex except put all entries in @code. % \def\defcodeindex{\parsearg\newcodeindex} % \def\newcodeindex#1{% \iflinks \expandafter\newwrite \csname#1indfile\endcsname \openout \csname#1indfile\endcsname \jobname.#1 \fi \expandafter\xdef\csname#1index\endcsname{% \noexpand\docodeindex{#1}}% } % @synindex foo bar makes index foo feed into index bar. % Do this instead of @defindex foo if you don't want it as a separate index. % % @syncodeindex foo bar similar, but put all entries made for index foo % inside @code. % \def\synindex#1 #2 {\dosynindex\doindex{#1}{#2}} \def\syncodeindex#1 #2 {\dosynindex\docodeindex{#1}{#2}} % #1 is \doindex or \docodeindex, #2 the index getting redefined (foo), % #3 the target index (bar). \def\dosynindex#1#2#3{% % Only do \closeout if we haven't already done it, else we'll end up % closing the target index. \expandafter \ifx\csname donesynindex#2\endcsname \undefined % The \closeout helps reduce unnecessary open files; the limit on the % Acorn RISC OS is a mere 16 files. \expandafter\closeout\csname#2indfile\endcsname \expandafter\let\csname\donesynindex#2\endcsname = 1 \fi % redefine \fooindfile: \expandafter\let\expandafter\temp\expandafter=\csname#3indfile\endcsname \expandafter\let\csname#2indfile\endcsname=\temp % redefine \fooindex: \expandafter\xdef\csname#2index\endcsname{\noexpand#1{#3}}% } % Define \doindex, the driver for all \fooindex macros. % Argument #1 is generated by the calling \fooindex macro, % and it is "foo", the name of the index. % \doindex just uses \parsearg; it calls \doind for the actual work. % This is because \doind is more useful to call from other macros. % There is also \dosubind {index}{topic}{subtopic} % which makes an entry in a two-level index such as the operation index. \def\doindex#1{\edef\indexname{#1}\parsearg\singleindexer} \def\singleindexer #1{\doind{\indexname}{#1}} % like the previous two, but they put @code around the argument. \def\docodeindex#1{\edef\indexname{#1}\parsearg\singlecodeindexer} \def\singlecodeindexer #1{\doind{\indexname}{\code{#1}}} % Take care of Texinfo commands that can appear in an index entry. % Since there are some commands we want to expand, and others we don't, % we have to laboriously prevent expansion for those that we don't. % \def\indexdummies{% \escapechar = `\\ % use backslash in output files. \def\@{@}% change to @@ when we switch to @ as escape char in index files. \def\ {\realbackslash\space }% % % Need these in case \tex is in effect and \{ is a \delimiter again. % But can't use \lbracecmd and \rbracecmd because texindex assumes % braces and backslashes are used only as delimiters. \let\{ = \mylbrace \let\} = \myrbrace % % I don't entirely understand this, but when an index entry is % generated from a macro call, the \endinput which \scanmacro inserts % causes processing to be prematurely terminated. This is, % apparently, because \indexsorttmp is fully expanded, and \endinput % is an expandable command. The redefinition below makes \endinput % disappear altogether for that purpose -- although logging shows that % processing continues to some further point. On the other hand, it % seems \endinput does not hurt in the printed index arg, since that % is still getting written without apparent harm. % % Sample source (mac-idx3.tex, reported by Graham Percival to % help-texinfo, 22may06): % @macro funindex {WORD} % @findex xyz % @end macro % ... % @funindex commtest % % The above is not enough to reproduce the bug, but it gives the flavor. % % Sample whatsit resulting: % .@write3{\entry{xyz}{@folio }{@code {xyz@endinput }}} % % So: \let\endinput = \empty % % Do the redefinitions. \commondummies } % For the aux and toc files, @ is the escape character. So we want to % redefine everything using @ as the escape character (instead of % \realbackslash, still used for index files). When everything uses @, % this will be simpler. % \def\atdummies{% \def\@{@@}% \def\ {@ }% \let\{ = \lbraceatcmd \let\} = \rbraceatcmd % % Do the redefinitions. \commondummies \otherbackslash } % Called from \indexdummies and \atdummies. % \def\commondummies{% % % \definedummyword defines \#1 as \string\#1\space, thus effectively % preventing its expansion. This is used only for control% words, % not control letters, because the \space would be incorrect for % control characters, but is needed to separate the control word % from whatever follows. % % For control letters, we have \definedummyletter, which omits the % space. % % These can be used both for control words that take an argument and % those that do not. If it is followed by {arg} in the input, then % that will dutifully get written to the index (or wherever). % \def\definedummyword ##1{\def##1{\string##1\space}}% \def\definedummyletter##1{\def##1{\string##1}}% \let\definedummyaccent\definedummyletter % \commondummiesnofonts % \definedummyletter\_% % % Non-English letters. \definedummyword\AA \definedummyword\AE \definedummyword\L \definedummyword\OE \definedummyword\O \definedummyword\aa \definedummyword\ae \definedummyword\l \definedummyword\oe \definedummyword\o \definedummyword\ss \definedummyword\exclamdown \definedummyword\questiondown \definedummyword\ordf \definedummyword\ordm % % Although these internal commands shouldn't show up, sometimes they do. \definedummyword\bf \definedummyword\gtr \definedummyword\hat \definedummyword\less \definedummyword\sf \definedummyword\sl \definedummyword\tclose \definedummyword\tt % \definedummyword\LaTeX \definedummyword\TeX % % Assorted special characters. \definedummyword\bullet \definedummyword\comma \definedummyword\copyright \definedummyword\registeredsymbol \definedummyword\dots \definedummyword\enddots \definedummyword\equiv \definedummyword\error \definedummyword\euro \definedummyword\guillemetleft \definedummyword\guillemetright \definedummyword\guilsinglleft \definedummyword\guilsinglright \definedummyword\expansion \definedummyword\minus \definedummyword\pounds \definedummyword\point \definedummyword\print \definedummyword\quotedblbase \definedummyword\quotedblleft \definedummyword\quotedblright \definedummyword\quoteleft \definedummyword\quoteright \definedummyword\quotesinglbase \definedummyword\result \definedummyword\textdegree % % We want to disable all macros so that they are not expanded by \write. \macrolist % \normalturnoffactive % % Handle some cases of @value -- where it does not contain any % (non-fully-expandable) commands. \makevalueexpandable } % \commondummiesnofonts: common to \commondummies and \indexnofonts. % \def\commondummiesnofonts{% % Control letters and accents. \definedummyletter\!% \definedummyaccent\"% \definedummyaccent\'% \definedummyletter\*% \definedummyaccent\,% \definedummyletter\.% \definedummyletter\/% \definedummyletter\:% \definedummyaccent\=% \definedummyletter\?% \definedummyaccent\^% \definedummyaccent\`% \definedummyaccent\~% \definedummyword\u \definedummyword\v \definedummyword\H \definedummyword\dotaccent \definedummyword\ringaccent \definedummyword\tieaccent \definedummyword\ubaraccent \definedummyword\udotaccent \definedummyword\dotless % % Texinfo font commands. \definedummyword\b \definedummyword\i \definedummyword\r \definedummyword\sc \definedummyword\t % % Commands that take arguments. \definedummyword\acronym \definedummyword\cite \definedummyword\code \definedummyword\command \definedummyword\dfn \definedummyword\emph \definedummyword\env \definedummyword\file \definedummyword\kbd \definedummyword\key \definedummyword\math \definedummyword\option \definedummyword\pxref \definedummyword\ref \definedummyword\samp \definedummyword\strong \definedummyword\tie \definedummyword\uref \definedummyword\url \definedummyword\var \definedummyword\verb \definedummyword\w \definedummyword\xref } % \indexnofonts is used when outputting the strings to sort the index % by, and when constructing control sequence names. It eliminates all % control sequences and just writes whatever the best ASCII sort string % would be for a given command (usually its argument). % \def\indexnofonts{% % Accent commands should become @asis. \def\definedummyaccent##1{\let##1\asis}% % We can just ignore other control letters. \def\definedummyletter##1{\let##1\empty}% % Hopefully, all control words can become @asis. \let\definedummyword\definedummyaccent % \commondummiesnofonts % % Don't no-op \tt, since it isn't a user-level command % and is used in the definitions of the active chars like <, >, |, etc. % Likewise with the other plain tex font commands. %\let\tt=\asis % \def\ { }% \def\@{@}% % how to handle braces? \def\_{\normalunderscore}% % % Non-English letters. \def\AA{AA}% \def\AE{AE}% \def\L{L}% \def\OE{OE}% \def\O{O}% \def\aa{aa}% \def\ae{ae}% \def\l{l}% \def\oe{oe}% \def\o{o}% \def\ss{ss}% \def\exclamdown{!}% \def\questiondown{?}% \def\ordf{a}% \def\ordm{o}% % \def\LaTeX{LaTeX}% \def\TeX{TeX}% % % Assorted special characters. % (The following {} will end up in the sort string, but that's ok.) \def\bullet{bullet}% \def\comma{,}% \def\copyright{copyright}% \def\registeredsymbol{R}% \def\dots{...}% \def\enddots{...}% \def\equiv{==}% \def\error{error}% \def\euro{euro}% \def\guillemetleft{<<}% \def\guillemetright{>>}% \def\guilsinglleft{<}% \def\guilsinglright{>}% \def\expansion{==>}% \def\minus{-}% \def\pounds{pounds}% \def\point{.}% \def\print{-|}% \def\quotedblbase{"}% \def\quotedblleft{"}% \def\quotedblright{"}% \def\quoteleft{`}% \def\quoteright{'}% \def\quotesinglbase{,}% \def\result{=>}% \def\textdegree{degrees}% % % We need to get rid of all macros, leaving only the arguments (if present). % Of course this is not nearly correct, but it is the best we can do for now. % makeinfo does not expand macros in the argument to @deffn, which ends up % writing an index entry, and texindex isn't prepared for an index sort entry % that starts with \. % % Since macro invocations are followed by braces, we can just redefine them % to take a single TeX argument. The case of a macro invocation that % goes to end-of-line is not handled. % \macrolist } \let\indexbackslash=0 %overridden during \printindex. \let\SETmarginindex=\relax % put index entries in margin (undocumented)? % Most index entries go through here, but \dosubind is the general case. % #1 is the index name, #2 is the entry text. \def\doind#1#2{\dosubind{#1}{#2}{}} % Workhorse for all \fooindexes. % #1 is name of index, #2 is stuff to put there, #3 is subentry -- % empty if called from \doind, as we usually are (the main exception % is with most defuns, which call us directly). % \def\dosubind#1#2#3{% \iflinks {% % Store the main index entry text (including the third arg). \toks0 = {#2}% % If third arg is present, precede it with a space. \def\thirdarg{#3}% \ifx\thirdarg\empty \else \toks0 = \expandafter{\the\toks0 \space #3}% \fi % \edef\writeto{\csname#1indfile\endcsname}% % \safewhatsit\dosubindwrite }% \fi } % Write the entry in \toks0 to the index file: % \def\dosubindwrite{% % Put the index entry in the margin if desired. \ifx\SETmarginindex\relax\else \insert\margin{\hbox{\vrule height8pt depth3pt width0pt \the\toks0}}% \fi % % Remember, we are within a group. \indexdummies % Must do this here, since \bf, etc expand at this stage \def\backslashcurfont{\indexbackslash}% \indexbackslash isn't defined now % so it will be output as is; and it will print as backslash. % % Process the index entry with all font commands turned off, to % get the string to sort by. {\indexnofonts \edef\temp{\the\toks0}% need full expansion \xdef\indexsorttmp{\temp}% }% % % Set up the complete index entry, with both the sort key and % the original text, including any font commands. We write % three arguments to \entry to the .?? file (four in the % subentry case), texindex reduces to two when writing the .??s % sorted result. \edef\temp{% \write\writeto{% \string\entry{\indexsorttmp}{\noexpand\folio}{\the\toks0}}% }% \temp } % Take care of unwanted page breaks/skips around a whatsit: % % If a skip is the last thing on the list now, preserve it % by backing up by \lastskip, doing the \write, then inserting % the skip again. Otherwise, the whatsit generated by the % \write or \pdfdest will make \lastskip zero. The result is that % sequences like this: % @end defun % @tindex whatever % @defun ... % will have extra space inserted, because the \medbreak in the % start of the @defun won't see the skip inserted by the @end of % the previous defun. % % But don't do any of this if we're not in vertical mode. We % don't want to do a \vskip and prematurely end a paragraph. % % Avoid page breaks due to these extra skips, too. % % But wait, there is a catch there: % We'll have to check whether \lastskip is zero skip. \ifdim is not % sufficient for this purpose, as it ignores stretch and shrink parts % of the skip. The only way seems to be to check the textual % representation of the skip. % % The following is almost like \def\zeroskipmacro{0.0pt} except that % the ``p'' and ``t'' characters have catcode \other, not 11 (letter). % \edef\zeroskipmacro{\expandafter\the\csname z@skip\endcsname} % \newskip\whatsitskip \newcount\whatsitpenalty % % ..., ready, GO: % \def\safewhatsit#1{% \ifhmode #1% \else % \lastskip and \lastpenalty cannot both be nonzero simultaneously. \whatsitskip = \lastskip \edef\lastskipmacro{\the\lastskip}% \whatsitpenalty = \lastpenalty % % If \lastskip is nonzero, that means the last item was a % skip. And since a skip is discardable, that means this % -\whatsitskip glue we're inserting is preceded by a % non-discardable item, therefore it is not a potential % breakpoint, therefore no \nobreak needed. \ifx\lastskipmacro\zeroskipmacro \else \vskip-\whatsitskip \fi % #1% % \ifx\lastskipmacro\zeroskipmacro % If \lastskip was zero, perhaps the last item was a penalty, and % perhaps it was >=10000, e.g., a \nobreak. In that case, we want % to re-insert the same penalty (values >10000 are used for various % signals); since we just inserted a non-discardable item, any % following glue (such as a \parskip) would be a breakpoint. For example: % % @deffn deffn-whatever % @vindex index-whatever % Description. % would allow a break between the index-whatever whatsit % and the "Description." paragraph. \ifnum\whatsitpenalty>9999 \penalty\whatsitpenalty \fi \else % On the other hand, if we had a nonzero \lastskip, % this make-up glue would be preceded by a non-discardable item % (the whatsit from the \write), so we must insert a \nobreak. \nobreak\vskip\whatsitskip \fi \fi } % The index entry written in the file actually looks like % \entry {sortstring}{page}{topic} % or % \entry {sortstring}{page}{topic}{subtopic} % The texindex program reads in these files and writes files % containing these kinds of lines: % \initial {c} % before the first topic whose initial is c % \entry {topic}{pagelist} % for a topic that is used without subtopics % \primary {topic} % for the beginning of a topic that is used with subtopics % \secondary {subtopic}{pagelist} % for each subtopic. % Define the user-accessible indexing commands % @findex, @vindex, @kindex, @cindex. \def\findex {\fnindex} \def\kindex {\kyindex} \def\cindex {\cpindex} \def\vindex {\vrindex} \def\tindex {\tpindex} \def\pindex {\pgindex} \def\cindexsub {\begingroup\obeylines\cindexsub} {\obeylines % \gdef\cindexsub "#1" #2^^M{\endgroup % \dosubind{cp}{#2}{#1}}} % Define the macros used in formatting output of the sorted index material. % @printindex causes a particular index (the ??s file) to get printed. % It does not print any chapter heading (usually an @unnumbered). % \parseargdef\printindex{\begingroup \dobreak \chapheadingskip{10000}% % \smallfonts \rm \tolerance = 9500 \plainfrenchspacing \everypar = {}% don't want the \kern\-parindent from indentation suppression. % % See if the index file exists and is nonempty. % Change catcode of @ here so that if the index file contains % \initial {@} % as its first line, TeX doesn't complain about mismatched braces % (because it thinks @} is a control sequence). \catcode`\@ = 11 \openin 1 \jobname.#1s \ifeof 1 % \enddoublecolumns gets confused if there is no text in the index, % and it loses the chapter title and the aux file entries for the % index. The easiest way to prevent this problem is to make sure % there is some text. \putwordIndexNonexistent \else % % If the index file exists but is empty, then \openin leaves \ifeof % false. We have to make TeX try to read something from the file, so % it can discover if there is anything in it. \read 1 to \temp \ifeof 1 \putwordIndexIsEmpty \else % Index files are almost Texinfo source, but we use \ as the escape % character. It would be better to use @, but that's too big a change % to make right now. \def\indexbackslash{\backslashcurfont}% \catcode`\\ = 0 \escapechar = `\\ \begindoublecolumns \input \jobname.#1s \enddoublecolumns \fi \fi \closein 1 \endgroup} % These macros are used by the sorted index file itself. % Change them to control the appearance of the index. \def\initial#1{{% % Some minor font changes for the special characters. \let\tentt=\sectt \let\tt=\sectt \let\sf=\sectt % % Remove any glue we may have, we'll be inserting our own. \removelastskip % % We like breaks before the index initials, so insert a bonus. \nobreak \vskip 0pt plus 3\baselineskip \penalty 0 \vskip 0pt plus -3\baselineskip % % Typeset the initial. Making this add up to a whole number of % baselineskips increases the chance of the dots lining up from column % to column. It still won't often be perfect, because of the stretch % we need before each entry, but it's better. % % No shrink because it confuses \balancecolumns. \vskip 1.67\baselineskip plus .5\baselineskip \leftline{\secbf #1}% % Do our best not to break after the initial. \nobreak \vskip .33\baselineskip plus .1\baselineskip }} % \entry typesets a paragraph consisting of the text (#1), dot leaders, and % then page number (#2) flushed to the right margin. It is used for index % and table of contents entries. The paragraph is indented by \leftskip. % % A straightforward implementation would start like this: % \def\entry#1#2{... % But this frozes the catcodes in the argument, and can cause problems to % @code, which sets - active. This problem was fixed by a kludge--- % ``-'' was active throughout whole index, but this isn't really right. % % The right solution is to prevent \entry from swallowing the whole text. % --kasal, 21nov03 \def\entry{% \begingroup % % Start a new paragraph if necessary, so our assignments below can't % affect previous text. \par % % Do not fill out the last line with white space. \parfillskip = 0in % % No extra space above this paragraph. \parskip = 0in % % Do not prefer a separate line ending with a hyphen to fewer lines. \finalhyphendemerits = 0 % % \hangindent is only relevant when the entry text and page number % don't both fit on one line. In that case, bob suggests starting the % dots pretty far over on the line. Unfortunately, a large % indentation looks wrong when the entry text itself is broken across % lines. So we use a small indentation and put up with long leaders. % % \hangafter is reset to 1 (which is the value we want) at the start % of each paragraph, so we need not do anything with that. \hangindent = 2em % % When the entry text needs to be broken, just fill out the first line % with blank space. \rightskip = 0pt plus1fil % % A bit of stretch before each entry for the benefit of balancing % columns. \vskip 0pt plus1pt % % Swallow the left brace of the text (first parameter): \afterassignment\doentry \let\temp = } \def\doentry{% \bgroup % Instead of the swallowed brace. \noindent \aftergroup\finishentry % And now comes the text of the entry. } \def\finishentry#1{% % #1 is the page number. % % The following is kludged to not output a line of dots in the index if % there are no page numbers. The next person who breaks this will be % cursed by a Unix daemon. \setbox\boxA = \hbox{#1}% \ifdim\wd\boxA = 0pt \ % \else % % If we must, put the page number on a line of its own, and fill out % this line with blank space. (The \hfil is overwhelmed with the % fill leaders glue in \indexdotfill if the page number does fit.) \hfil\penalty50 \null\nobreak\indexdotfill % Have leaders before the page number. % % The `\ ' here is removed by the implicit \unskip that TeX does as % part of (the primitive) \par. Without it, a spurious underfull % \hbox ensues. \ifpdf \pdfgettoks#1.% \ \the\toksA \else \ #1% \fi \fi \par \endgroup } % Like plain.tex's \dotfill, except uses up at least 1 em. \def\indexdotfill{\cleaders \hbox{$\mathsurround=0pt \mkern1.5mu.\mkern1.5mu$}\hskip 1em plus 1fill} \def\primary #1{\line{#1\hfil}} \newskip\secondaryindent \secondaryindent=0.5cm \def\secondary#1#2{{% \parfillskip=0in \parskip=0in \hangindent=1in \hangafter=1 \noindent\hskip\secondaryindent\hbox{#1}\indexdotfill \ifpdf \pdfgettoks#2.\ \the\toksA % The page number ends the paragraph. \else #2 \fi \par }} % Define two-column mode, which we use to typeset indexes. % Adapted from the TeXbook, page 416, which is to say, % the manmac.tex format used to print the TeXbook itself. \catcode`\@=11 \newbox\partialpage \newdimen\doublecolumnhsize \def\begindoublecolumns{\begingroup % ended by \enddoublecolumns % Grab any single-column material above us. \output = {% % % Here is a possibility not foreseen in manmac: if we accumulate a % whole lot of material, we might end up calling this \output % routine twice in a row (see the doublecol-lose test, which is % essentially a couple of indexes with @setchapternewpage off). In % that case we just ship out what is in \partialpage with the normal % output routine. Generally, \partialpage will be empty when this % runs and this will be a no-op. See the indexspread.tex test case. \ifvoid\partialpage \else \onepageout{\pagecontents\partialpage}% \fi % \global\setbox\partialpage = \vbox{% % Unvbox the main output page. \unvbox\PAGE \kern-\topskip \kern\baselineskip }% }% \eject % run that output routine to set \partialpage % % Use the double-column output routine for subsequent pages. \output = {\doublecolumnout}% % % Change the page size parameters. We could do this once outside this % routine, in each of @smallbook, @afourpaper, and the default 8.5x11 % format, but then we repeat the same computation. Repeating a couple % of assignments once per index is clearly meaningless for the % execution time, so we may as well do it in one place. % % First we halve the line length, less a little for the gutter between % the columns. We compute the gutter based on the line length, so it % changes automatically with the paper format. The magic constant % below is chosen so that the gutter has the same value (well, +-<1pt) % as it did when we hard-coded it. % % We put the result in a separate register, \doublecolumhsize, so we % can restore it in \pagesofar, after \hsize itself has (potentially) % been clobbered. % \doublecolumnhsize = \hsize \advance\doublecolumnhsize by -.04154\hsize \divide\doublecolumnhsize by 2 \hsize = \doublecolumnhsize % % Double the \vsize as well. (We don't need a separate register here, % since nobody clobbers \vsize.) \vsize = 2\vsize } % The double-column output routine for all double-column pages except % the last. % \def\doublecolumnout{% \splittopskip=\topskip \splitmaxdepth=\maxdepth % Get the available space for the double columns -- the normal % (undoubled) page height minus any material left over from the % previous page. \dimen@ = \vsize \divide\dimen@ by 2 \advance\dimen@ by -\ht\partialpage % % box0 will be the left-hand column, box2 the right. \setbox0=\vsplit255 to\dimen@ \setbox2=\vsplit255 to\dimen@ \onepageout\pagesofar \unvbox255 \penalty\outputpenalty } % % Re-output the contents of the output page -- any previous material, % followed by the two boxes we just split, in box0 and box2. \def\pagesofar{% \unvbox\partialpage % \hsize = \doublecolumnhsize \wd0=\hsize \wd2=\hsize \hbox to\pagewidth{\box0\hfil\box2}% } % % All done with double columns. \def\enddoublecolumns{% % The following penalty ensures that the page builder is exercised % _before_ we change the output routine. This is necessary in the % following situation: % % The last section of the index consists only of a single entry. % Before this section, \pagetotal is less than \pagegoal, so no % break occurs before the last section starts. However, the last % section, consisting of \initial and the single \entry, does not % fit on the page and has to be broken off. Without the following % penalty the page builder will not be exercised until \eject % below, and by that time we'll already have changed the output % routine to the \balancecolumns version, so the next-to-last % double-column page will be processed with \balancecolumns, which % is wrong: The two columns will go to the main vertical list, with % the broken-off section in the recent contributions. As soon as % the output routine finishes, TeX starts reconsidering the page % break. The two columns and the broken-off section both fit on the % page, because the two columns now take up only half of the page % goal. When TeX sees \eject from below which follows the final % section, it invokes the new output routine that we've set after % \balancecolumns below; \onepageout will try to fit the two columns % and the final section into the vbox of \pageheight (see % \pagebody), causing an overfull box. % % Note that glue won't work here, because glue does not exercise the % page builder, unlike penalties (see The TeXbook, pp. 280-281). \penalty0 % \output = {% % Split the last of the double-column material. Leave it on the % current page, no automatic page break. \balancecolumns % % If we end up splitting too much material for the current page, % though, there will be another page break right after this \output % invocation ends. Having called \balancecolumns once, we do not % want to call it again. Therefore, reset \output to its normal % definition right away. (We hope \balancecolumns will never be % called on to balance too much material, but if it is, this makes % the output somewhat more palatable.) \global\output = {\onepageout{\pagecontents\PAGE}}% }% \eject \endgroup % started in \begindoublecolumns % % \pagegoal was set to the doubled \vsize above, since we restarted % the current page. We're now back to normal single-column % typesetting, so reset \pagegoal to the normal \vsize (after the % \endgroup where \vsize got restored). \pagegoal = \vsize } % % Called at the end of the double column material. \def\balancecolumns{% \setbox0 = \vbox{\unvbox255}% like \box255 but more efficient, see p.120. \dimen@ = \ht0 \advance\dimen@ by \topskip \advance\dimen@ by-\baselineskip \divide\dimen@ by 2 % target to split to %debug\message{final 2-column material height=\the\ht0, target=\the\dimen@.}% \splittopskip = \topskip % Loop until we get a decent breakpoint. {% \vbadness = 10000 \loop \global\setbox3 = \copy0 \global\setbox1 = \vsplit3 to \dimen@ \ifdim\ht3>\dimen@ \global\advance\dimen@ by 1pt \repeat }% %debug\message{split to \the\dimen@, column heights: \the\ht1, \the\ht3.}% \setbox0=\vbox to\dimen@{\unvbox1}% \setbox2=\vbox to\dimen@{\unvbox3}% % \pagesofar } \catcode`\@ = \other \message{sectioning,} % Chapters, sections, etc. % \unnumberedno is an oxymoron, of course. But we count the unnumbered % sections so that we can refer to them unambiguously in the pdf % outlines by their "section number". We avoid collisions with chapter % numbers by starting them at 10000. (If a document ever has 10000 % chapters, we're in trouble anyway, I'm sure.) \newcount\unnumberedno \unnumberedno = 10000 \newcount\chapno \newcount\secno \secno=0 \newcount\subsecno \subsecno=0 \newcount\subsubsecno \subsubsecno=0 % This counter is funny since it counts through charcodes of letters A, B, ... \newcount\appendixno \appendixno = `\@ % % \def\appendixletter{\char\the\appendixno} % We do the following ugly conditional instead of the above simple % construct for the sake of pdftex, which needs the actual % letter in the expansion, not just typeset. % \def\appendixletter{% \ifnum\appendixno=`A A% \else\ifnum\appendixno=`B B% \else\ifnum\appendixno=`C C% \else\ifnum\appendixno=`D D% \else\ifnum\appendixno=`E E% \else\ifnum\appendixno=`F F% \else\ifnum\appendixno=`G G% \else\ifnum\appendixno=`H H% \else\ifnum\appendixno=`I I% \else\ifnum\appendixno=`J J% \else\ifnum\appendixno=`K K% \else\ifnum\appendixno=`L L% \else\ifnum\appendixno=`M M% \else\ifnum\appendixno=`N N% \else\ifnum\appendixno=`O O% \else\ifnum\appendixno=`P P% \else\ifnum\appendixno=`Q Q% \else\ifnum\appendixno=`R R% \else\ifnum\appendixno=`S S% \else\ifnum\appendixno=`T T% \else\ifnum\appendixno=`U U% \else\ifnum\appendixno=`V V% \else\ifnum\appendixno=`W W% \else\ifnum\appendixno=`X X% \else\ifnum\appendixno=`Y Y% \else\ifnum\appendixno=`Z Z% % The \the is necessary, despite appearances, because \appendixletter is % expanded while writing the .toc file. \char\appendixno is not % expandable, thus it is written literally, thus all appendixes come out % with the same letter (or @) in the toc without it. \else\char\the\appendixno \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi} % Each @chapter defines these (using marks) as the number+name, number % and name of the chapter. Page headings and footings can use % these. @section does likewise. \def\thischapter{} \def\thischapternum{} \def\thischaptername{} \def\thissection{} \def\thissectionnum{} \def\thissectionname{} \newcount\absseclevel % used to calculate proper heading level \newcount\secbase\secbase=0 % @raisesections/@lowersections modify this count % @raisesections: treat @section as chapter, @subsection as section, etc. \def\raisesections{\global\advance\secbase by -1} \let\up=\raisesections % original BFox name % @lowersections: treat @chapter as section, @section as subsection, etc. \def\lowersections{\global\advance\secbase by 1} \let\down=\lowersections % original BFox name % we only have subsub. \chardef\maxseclevel = 3 % % A numbered section within an unnumbered changes to unnumbered too. % To achive this, remember the "biggest" unnum. sec. we are currently in: \chardef\unmlevel = \maxseclevel % % Trace whether the current chapter is an appendix or not: % \chapheadtype is "N" or "A", unnumbered chapters are ignored. \def\chapheadtype{N} % Choose a heading macro % #1 is heading type % #2 is heading level % #3 is text for heading \def\genhead#1#2#3{% % Compute the abs. sec. level: \absseclevel=#2 \advance\absseclevel by \secbase % Make sure \absseclevel doesn't fall outside the range: \ifnum \absseclevel < 0 \absseclevel = 0 \else \ifnum \absseclevel > 3 \absseclevel = 3 \fi \fi % The heading type: \def\headtype{#1}% \if \headtype U% \ifnum \absseclevel < \unmlevel \chardef\unmlevel = \absseclevel \fi \else % Check for appendix sections: \ifnum \absseclevel = 0 \edef\chapheadtype{\headtype}% \else \if \headtype A\if \chapheadtype N% \errmessage{@appendix... within a non-appendix chapter}% \fi\fi \fi % Check for numbered within unnumbered: \ifnum \absseclevel > \unmlevel \def\headtype{U}% \else \chardef\unmlevel = 3 \fi \fi % Now print the heading: \if \headtype U% \ifcase\absseclevel \unnumberedzzz{#3}% \or \unnumberedseczzz{#3}% \or \unnumberedsubseczzz{#3}% \or \unnumberedsubsubseczzz{#3}% \fi \else \if \headtype A% \ifcase\absseclevel \appendixzzz{#3}% \or \appendixsectionzzz{#3}% \or \appendixsubseczzz{#3}% \or \appendixsubsubseczzz{#3}% \fi \else \ifcase\absseclevel \chapterzzz{#3}% \or \seczzz{#3}% \or \numberedsubseczzz{#3}% \or \numberedsubsubseczzz{#3}% \fi \fi \fi \suppressfirstparagraphindent } % an interface: \def\numhead{\genhead N} \def\apphead{\genhead A} \def\unnmhead{\genhead U} % @chapter, @appendix, @unnumbered. Increment top-level counter, reset % all lower-level sectioning counters to zero. % % Also set \chaplevelprefix, which we prepend to @float sequence numbers % (e.g., figures), q.v. By default (before any chapter), that is empty. \let\chaplevelprefix = \empty % \outer\parseargdef\chapter{\numhead0{#1}} % normally numhead0 calls chapterzzz \def\chapterzzz#1{% % section resetting is \global in case the chapter is in a group, such % as an @include file. \global\secno=0 \global\subsecno=0 \global\subsubsecno=0 \global\advance\chapno by 1 % % Used for \float. \gdef\chaplevelprefix{\the\chapno.}% \resetallfloatnos % \message{\putwordChapter\space \the\chapno}% % % Write the actual heading. \chapmacro{#1}{Ynumbered}{\the\chapno}% % % So @section and the like are numbered underneath this chapter. \global\let\section = \numberedsec \global\let\subsection = \numberedsubsec \global\let\subsubsection = \numberedsubsubsec } \outer\parseargdef\appendix{\apphead0{#1}} % normally apphead0 calls appendixzzz \def\appendixzzz#1{% \global\secno=0 \global\subsecno=0 \global\subsubsecno=0 \global\advance\appendixno by 1 \gdef\chaplevelprefix{\appendixletter.}% \resetallfloatnos % \def\appendixnum{\putwordAppendix\space \appendixletter}% \message{\appendixnum}% % \chapmacro{#1}{Yappendix}{\appendixletter}% % \global\let\section = \appendixsec \global\let\subsection = \appendixsubsec \global\let\subsubsection = \appendixsubsubsec } \outer\parseargdef\unnumbered{\unnmhead0{#1}} % normally unnmhead0 calls unnumberedzzz \def\unnumberedzzz#1{% \global\secno=0 \global\subsecno=0 \global\subsubsecno=0 \global\advance\unnumberedno by 1 % % Since an unnumbered has no number, no prefix for figures. \global\let\chaplevelprefix = \empty \resetallfloatnos % % This used to be simply \message{#1}, but TeX fully expands the % argument to \message. Therefore, if #1 contained @-commands, TeX % expanded them. For example, in `@unnumbered The @cite{Book}', TeX % expanded @cite (which turns out to cause errors because \cite is meant % to be executed, not expanded). % % Anyway, we don't want the fully-expanded definition of @cite to appear % as a result of the \message, we just want `@cite' itself. We use % \the to achieve this: TeX expands \the only once, % simply yielding the contents of . (We also do this for % the toc entries.) \toks0 = {#1}% \message{(\the\toks0)}% % \chapmacro{#1}{Ynothing}{\the\unnumberedno}% % \global\let\section = \unnumberedsec \global\let\subsection = \unnumberedsubsec \global\let\subsubsection = \unnumberedsubsubsec } % @centerchap is like @unnumbered, but the heading is centered. \outer\parseargdef\centerchap{% % Well, we could do the following in a group, but that would break % an assumption that \chapmacro is called at the outermost level. % Thus we are safer this way: --kasal, 24feb04 \let\centerparametersmaybe = \centerparameters \unnmhead0{#1}% \let\centerparametersmaybe = \relax } % @top is like @unnumbered. \let\top\unnumbered % Sections. \outer\parseargdef\numberedsec{\numhead1{#1}} % normally calls seczzz \def\seczzz#1{% \global\subsecno=0 \global\subsubsecno=0 \global\advance\secno by 1 \sectionheading{#1}{sec}{Ynumbered}{\the\chapno.\the\secno}% } \outer\parseargdef\appendixsection{\apphead1{#1}} % normally calls appendixsectionzzz \def\appendixsectionzzz#1{% \global\subsecno=0 \global\subsubsecno=0 \global\advance\secno by 1 \sectionheading{#1}{sec}{Yappendix}{\appendixletter.\the\secno}% } \let\appendixsec\appendixsection \outer\parseargdef\unnumberedsec{\unnmhead1{#1}} % normally calls unnumberedseczzz \def\unnumberedseczzz#1{% \global\subsecno=0 \global\subsubsecno=0 \global\advance\secno by 1 \sectionheading{#1}{sec}{Ynothing}{\the\unnumberedno.\the\secno}% } % Subsections. \outer\parseargdef\numberedsubsec{\numhead2{#1}} % normally calls numberedsubseczzz \def\numberedsubseczzz#1{% \global\subsubsecno=0 \global\advance\subsecno by 1 \sectionheading{#1}{subsec}{Ynumbered}{\the\chapno.\the\secno.\the\subsecno}% } \outer\parseargdef\appendixsubsec{\apphead2{#1}} % normally calls appendixsubseczzz \def\appendixsubseczzz#1{% \global\subsubsecno=0 \global\advance\subsecno by 1 \sectionheading{#1}{subsec}{Yappendix}% {\appendixletter.\the\secno.\the\subsecno}% } \outer\parseargdef\unnumberedsubsec{\unnmhead2{#1}} %normally calls unnumberedsubseczzz \def\unnumberedsubseczzz#1{% \global\subsubsecno=0 \global\advance\subsecno by 1 \sectionheading{#1}{subsec}{Ynothing}% {\the\unnumberedno.\the\secno.\the\subsecno}% } % Subsubsections. \outer\parseargdef\numberedsubsubsec{\numhead3{#1}} % normally numberedsubsubseczzz \def\numberedsubsubseczzz#1{% \global\advance\subsubsecno by 1 \sectionheading{#1}{subsubsec}{Ynumbered}% {\the\chapno.\the\secno.\the\subsecno.\the\subsubsecno}% } \outer\parseargdef\appendixsubsubsec{\apphead3{#1}} % normally appendixsubsubseczzz \def\appendixsubsubseczzz#1{% \global\advance\subsubsecno by 1 \sectionheading{#1}{subsubsec}{Yappendix}% {\appendixletter.\the\secno.\the\subsecno.\the\subsubsecno}% } \outer\parseargdef\unnumberedsubsubsec{\unnmhead3{#1}} %normally unnumberedsubsubseczzz \def\unnumberedsubsubseczzz#1{% \global\advance\subsubsecno by 1 \sectionheading{#1}{subsubsec}{Ynothing}% {\the\unnumberedno.\the\secno.\the\subsecno.\the\subsubsecno}% } % These macros control what the section commands do, according % to what kind of chapter we are in (ordinary, appendix, or unnumbered). % Define them by default for a numbered chapter. \let\section = \numberedsec \let\subsection = \numberedsubsec \let\subsubsection = \numberedsubsubsec % Define @majorheading, @heading and @subheading % NOTE on use of \vbox for chapter headings, section headings, and such: % 1) We use \vbox rather than the earlier \line to permit % overlong headings to fold. % 2) \hyphenpenalty is set to 10000 because hyphenation in a % heading is obnoxious; this forbids it. % 3) Likewise, headings look best if no \parindent is used, and % if justification is not attempted. Hence \raggedright. \def\majorheading{% {\advance\chapheadingskip by 10pt \chapbreak }% \parsearg\chapheadingzzz } \def\chapheading{\chapbreak \parsearg\chapheadingzzz} \def\chapheadingzzz#1{% {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000 \parindent=0pt\raggedright \rm #1\hfill}}% \bigskip \par\penalty 200\relax \suppressfirstparagraphindent } % @heading, @subheading, @subsubheading. \parseargdef\heading{\sectionheading{#1}{sec}{Yomitfromtoc}{} \suppressfirstparagraphindent} \parseargdef\subheading{\sectionheading{#1}{subsec}{Yomitfromtoc}{} \suppressfirstparagraphindent} \parseargdef\subsubheading{\sectionheading{#1}{subsubsec}{Yomitfromtoc}{} \suppressfirstparagraphindent} % These macros generate a chapter, section, etc. heading only % (including whitespace, linebreaking, etc. around it), % given all the information in convenient, parsed form. %%% Args are the skip and penalty (usually negative) \def\dobreak#1#2{\par\ifdim\lastskip<#1\removelastskip\penalty#2\vskip#1\fi} %%% Define plain chapter starts, and page on/off switching for it % Parameter controlling skip before chapter headings (if needed) \newskip\chapheadingskip \def\chapbreak{\dobreak \chapheadingskip {-4000}} \def\chappager{\par\vfill\supereject} % Because \domark is called before \chapoddpage, the filler page will % get the headings for the next chapter, which is wrong. But we don't % care -- we just disable all headings on the filler page. \def\chapoddpage{% \chappager \ifodd\pageno \else \begingroup \evenheadline={\hfil}\evenfootline={\hfil}% \oddheadline={\hfil}\oddfootline={\hfil}% \hbox to 0pt{}% \chappager \endgroup \fi } \def\setchapternewpage #1 {\csname CHAPPAG#1\endcsname} \def\CHAPPAGoff{% \global\let\contentsalignmacro = \chappager \global\let\pchapsepmacro=\chapbreak \global\let\pagealignmacro=\chappager} \def\CHAPPAGon{% \global\let\contentsalignmacro = \chappager \global\let\pchapsepmacro=\chappager \global\let\pagealignmacro=\chappager \global\def\HEADINGSon{\HEADINGSsingle}} \def\CHAPPAGodd{% \global\let\contentsalignmacro = \chapoddpage \global\let\pchapsepmacro=\chapoddpage \global\let\pagealignmacro=\chapoddpage \global\def\HEADINGSon{\HEADINGSdouble}} \CHAPPAGon % Chapter opening. % % #1 is the text, #2 is the section type (Ynumbered, Ynothing, % Yappendix, Yomitfromtoc), #3 the chapter number. % % To test against our argument. \def\Ynothingkeyword{Ynothing} \def\Yomitfromtockeyword{Yomitfromtoc} \def\Yappendixkeyword{Yappendix} % \def\chapmacro#1#2#3{% % Insert the first mark before the heading break (see notes for \domark). \let\prevchapterdefs=\lastchapterdefs \let\prevsectiondefs=\lastsectiondefs \gdef\lastsectiondefs{\gdef\thissectionname{}\gdef\thissectionnum{}% \gdef\thissection{}}% % \def\temptype{#2}% \ifx\temptype\Ynothingkeyword \gdef\lastchapterdefs{\gdef\thischaptername{#1}\gdef\thischapternum{}% \gdef\thischapter{\thischaptername}}% \else\ifx\temptype\Yomitfromtockeyword \gdef\lastchapterdefs{\gdef\thischaptername{#1}\gdef\thischapternum{}% \gdef\thischapter{}}% \else\ifx\temptype\Yappendixkeyword \toks0={#1}% \xdef\lastchapterdefs{% \gdef\noexpand\thischaptername{\the\toks0}% \gdef\noexpand\thischapternum{\appendixletter}% \gdef\noexpand\thischapter{\putwordAppendix{} \noexpand\thischapternum: \noexpand\thischaptername}% }% \else \toks0={#1}% \xdef\lastchapterdefs{% \gdef\noexpand\thischaptername{\the\toks0}% \gdef\noexpand\thischapternum{\the\chapno}% \gdef\noexpand\thischapter{\putwordChapter{} \noexpand\thischapternum: \noexpand\thischaptername}% }% \fi\fi\fi % % Output the mark. Pass it through \safewhatsit, to take care of % the preceding space. \safewhatsit\domark % % Insert the chapter heading break. \pchapsepmacro % % Now the second mark, after the heading break. No break points % between here and the heading. \let\prevchapterdefs=\lastchapterdefs \let\prevsectiondefs=\lastsectiondefs \domark % {% \chapfonts \rm % % Have to define \lastsection before calling \donoderef, because the % xref code eventually uses it. On the other hand, it has to be called % after \pchapsepmacro, or the headline will change too soon. \gdef\lastsection{#1}% % % Only insert the separating space if we have a chapter/appendix % number, and don't print the unnumbered ``number''. \ifx\temptype\Ynothingkeyword \setbox0 = \hbox{}% \def\toctype{unnchap}% \else\ifx\temptype\Yomitfromtockeyword \setbox0 = \hbox{}% contents like unnumbered, but no toc entry \def\toctype{omit}% \else\ifx\temptype\Yappendixkeyword \setbox0 = \hbox{\putwordAppendix{} #3\enspace}% \def\toctype{app}% \else \setbox0 = \hbox{#3\enspace}% \def\toctype{numchap}% \fi\fi\fi % % Write the toc entry for this chapter. Must come before the % \donoderef, because we include the current node name in the toc % entry, and \donoderef resets it to empty. \writetocentry{\toctype}{#1}{#3}% % % For pdftex, we have to write out the node definition (aka, make % the pdfdest) after any page break, but before the actual text has % been typeset. If the destination for the pdf outline is after the % text, then jumping from the outline may wind up with the text not % being visible, for instance under high magnification. \donoderef{#2}% % % Typeset the actual heading. \nobreak % Avoid page breaks at the interline glue. \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \raggedright \hangindent=\wd0 \centerparametersmaybe \unhbox0 #1\par}% }% \nobreak\bigskip % no page break after a chapter title \nobreak } % @centerchap -- centered and unnumbered. \let\centerparametersmaybe = \relax \def\centerparameters{% \advance\rightskip by 3\rightskip \leftskip = \rightskip \parfillskip = 0pt } % I don't think this chapter style is supported any more, so I'm not % updating it with the new noderef stuff. We'll see. --karl, 11aug03. % \def\setchapterstyle #1 {\csname CHAPF#1\endcsname} % \def\unnchfopen #1{% \chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000 \parindent=0pt\raggedright \rm #1\hfill}}\bigskip \par\nobreak } \def\chfopen #1#2{\chapoddpage {\chapfonts \vbox to 3in{\vfil \hbox to\hsize{\hfil #2} \hbox to\hsize{\hfil #1} \vfil}}% \par\penalty 5000 % } \def\centerchfopen #1{% \chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000 \parindent=0pt \hfill {\rm #1}\hfill}}\bigskip \par\nobreak } \def\CHAPFopen{% \global\let\chapmacro=\chfopen \global\let\centerchapmacro=\centerchfopen} % Section titles. These macros combine the section number parts and % call the generic \sectionheading to do the printing. % \newskip\secheadingskip \def\secheadingbreak{\dobreak \secheadingskip{-1000}} % Subsection titles. \newskip\subsecheadingskip \def\subsecheadingbreak{\dobreak \subsecheadingskip{-500}} % Subsubsection titles. \def\subsubsecheadingskip{\subsecheadingskip} \def\subsubsecheadingbreak{\subsecheadingbreak} % Print any size, any type, section title. % % #1 is the text, #2 is the section level (sec/subsec/subsubsec), #3 is % the section type for xrefs (Ynumbered, Ynothing, Yappendix), #4 is the % section number. % \def\seckeyword{sec} % \def\sectionheading#1#2#3#4{% {% % Switch to the right set of fonts. \csname #2fonts\endcsname \rm % \def\sectionlevel{#2}% \def\temptype{#3}% % % Insert first mark before the heading break (see notes for \domark). \let\prevsectiondefs=\lastsectiondefs \ifx\temptype\Ynothingkeyword \ifx\sectionlevel\seckeyword \gdef\lastsectiondefs{\gdef\thissectionname{#1}\gdef\thissectionnum{}% \gdef\thissection{\thissectionname}}% \fi \else\ifx\temptype\Yomitfromtockeyword % Don't redefine \thissection. \else\ifx\temptype\Yappendixkeyword \ifx\sectionlevel\seckeyword \toks0={#1}% \xdef\lastsectiondefs{% \gdef\noexpand\thissectionname{\the\toks0}% \gdef\noexpand\thissectionnum{#4}% \gdef\noexpand\thissection{\putwordSection{} \noexpand\thissectionnum: \noexpand\thissectionname}% }% \fi \else \ifx\sectionlevel\seckeyword \toks0={#1}% \xdef\lastsectiondefs{% \gdef\noexpand\thissectionname{\the\toks0}% \gdef\noexpand\thissectionnum{#4}% \gdef\noexpand\thissection{\putwordSection{} \noexpand\thissectionnum: \noexpand\thissectionname}% }% \fi \fi\fi\fi % % Output the mark. Pass it through \safewhatsit, to take care of % the preceding space. \safewhatsit\domark % % Insert space above the heading. \csname #2headingbreak\endcsname % % Now the second mark, after the heading break. No break points % between here and the heading. \let\prevsectiondefs=\lastsectiondefs \domark % % Only insert the space after the number if we have a section number. \ifx\temptype\Ynothingkeyword \setbox0 = \hbox{}% \def\toctype{unn}% \gdef\lastsection{#1}% \else\ifx\temptype\Yomitfromtockeyword % for @headings -- no section number, don't include in toc, % and don't redefine \lastsection. \setbox0 = \hbox{}% \def\toctype{omit}% \let\sectionlevel=\empty \else\ifx\temptype\Yappendixkeyword \setbox0 = \hbox{#4\enspace}% \def\toctype{app}% \gdef\lastsection{#1}% \else \setbox0 = \hbox{#4\enspace}% \def\toctype{num}% \gdef\lastsection{#1}% \fi\fi\fi % % Write the toc entry (before \donoderef). See comments in \chapmacro. \writetocentry{\toctype\sectionlevel}{#1}{#4}% % % Write the node reference (= pdf destination for pdftex). % Again, see comments in \chapmacro. \donoderef{#3}% % % Interline glue will be inserted when the vbox is completed. % That glue will be a valid breakpoint for the page, since it'll be % preceded by a whatsit (usually from the \donoderef, or from the % \writetocentry if there was no node). We don't want to allow that % break, since then the whatsits could end up on page n while the % section is on page n+1, thus toc/etc. are wrong. Debian bug 276000. \nobreak % % Output the actual section heading. \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \raggedright \hangindent=\wd0 % zero if no section number \unhbox0 #1}% }% % Add extra space after the heading -- half of whatever came above it. % Don't allow stretch, though. \kern .5 \csname #2headingskip\endcsname % % Do not let the kern be a potential breakpoint, as it would be if it % was followed by glue. \nobreak % % We'll almost certainly start a paragraph next, so don't let that % glue accumulate. (Not a breakpoint because it's preceded by a % discardable item.) \vskip-\parskip % % This is purely so the last item on the list is a known \penalty > % 10000. This is so \startdefun can avoid allowing breakpoints after % section headings. Otherwise, it would insert a valid breakpoint between: % % @section sec-whatever % @deffn def-whatever \penalty 10001 } \message{toc,} % Table of contents. \newwrite\tocfile % Write an entry to the toc file, opening it if necessary. % Called from @chapter, etc. % % Example usage: \writetocentry{sec}{Section Name}{\the\chapno.\the\secno} % We append the current node name (if any) and page number as additional % arguments for the \{chap,sec,...}entry macros which will eventually % read this. The node name is used in the pdf outlines as the % destination to jump to. % % We open the .toc file for writing here instead of at @setfilename (or % any other fixed time) so that @contents can be anywhere in the document. % But if #1 is `omit', then we don't do anything. This is used for the % table of contents chapter openings themselves. % \newif\iftocfileopened \def\omitkeyword{omit}% % \def\writetocentry#1#2#3{% \edef\writetoctype{#1}% \ifx\writetoctype\omitkeyword \else \iftocfileopened\else \immediate\openout\tocfile = \jobname.toc \global\tocfileopenedtrue \fi % \iflinks {\atdummies \edef\temp{% \write\tocfile{@#1entry{#2}{#3}{\lastnode}{\noexpand\folio}}}% \temp }% \fi \fi % % Tell \shipout to create a pdf destination on each page, if we're % writing pdf. These are used in the table of contents. We can't % just write one on every page because the title pages are numbered % 1 and 2 (the page numbers aren't printed), and so are the first % two pages of the document. Thus, we'd have two destinations named % `1', and two named `2'. \ifpdf \global\pdfmakepagedesttrue \fi } % These characters do not print properly in the Computer Modern roman % fonts, so we must take special care. This is more or less redundant % with the Texinfo input format setup at the end of this file. % \def\activecatcodes{% \catcode`\"=\active \catcode`\$=\active \catcode`\<=\active \catcode`\>=\active \catcode`\\=\active \catcode`\^=\active \catcode`\_=\active \catcode`\|=\active \catcode`\~=\active } % Read the toc file, which is essentially Texinfo input. \def\readtocfile{% \setupdatafile \activecatcodes \input \tocreadfilename } \newskip\contentsrightmargin \contentsrightmargin=1in \newcount\savepageno \newcount\lastnegativepageno \lastnegativepageno = -1 % Prepare to read what we've written to \tocfile. % \def\startcontents#1{% % If @setchapternewpage on, and @headings double, the contents should % start on an odd page, unlike chapters. Thus, we maintain % \contentsalignmacro in parallel with \pagealignmacro. % From: Torbjorn Granlund \contentsalignmacro \immediate\closeout\tocfile % % Don't need to put `Contents' or `Short Contents' in the headline. % It is abundantly clear what they are. \chapmacro{#1}{Yomitfromtoc}{}% % \savepageno = \pageno \begingroup % Set up to handle contents files properly. \raggedbottom % Worry more about breakpoints than the bottom. \advance\hsize by -\contentsrightmargin % Don't use the full line length. % % Roman numerals for page numbers. \ifnum \pageno>0 \global\pageno = \lastnegativepageno \fi } % redefined for the two-volume lispref. We always output on % \jobname.toc even if this is redefined. % \def\tocreadfilename{\jobname.toc} % Normal (long) toc. % \def\contents{% \startcontents{\putwordTOC}% \openin 1 \tocreadfilename\space \ifeof 1 \else \readtocfile \fi \vfill \eject \contentsalignmacro % in case @setchapternewpage odd is in effect \ifeof 1 \else \pdfmakeoutlines \fi \closein 1 \endgroup \lastnegativepageno = \pageno \global\pageno = \savepageno } % And just the chapters. \def\summarycontents{% \startcontents{\putwordShortTOC}% % \let\numchapentry = \shortchapentry \let\appentry = \shortchapentry \let\unnchapentry = \shortunnchapentry % We want a true roman here for the page numbers. \secfonts \let\rm=\shortcontrm \let\bf=\shortcontbf \let\sl=\shortcontsl \let\tt=\shortconttt \rm \hyphenpenalty = 10000 \advance\baselineskip by 1pt % Open it up a little. \def\numsecentry##1##2##3##4{} \let\appsecentry = \numsecentry \let\unnsecentry = \numsecentry \let\numsubsecentry = \numsecentry \let\appsubsecentry = \numsecentry \let\unnsubsecentry = \numsecentry \let\numsubsubsecentry = \numsecentry \let\appsubsubsecentry = \numsecentry \let\unnsubsubsecentry = \numsecentry \openin 1 \tocreadfilename\space \ifeof 1 \else \readtocfile \fi \closein 1 \vfill \eject \contentsalignmacro % in case @setchapternewpage odd is in effect \endgroup \lastnegativepageno = \pageno \global\pageno = \savepageno } \let\shortcontents = \summarycontents % Typeset the label for a chapter or appendix for the short contents. % The arg is, e.g., `A' for an appendix, or `3' for a chapter. % \def\shortchaplabel#1{% % This space should be enough, since a single number is .5em, and the % widest letter (M) is 1em, at least in the Computer Modern fonts. % But use \hss just in case. % (This space doesn't include the extra space that gets added after % the label; that gets put in by \shortchapentry above.) % % We'd like to right-justify chapter numbers, but that looks strange % with appendix letters. And right-justifying numbers and % left-justifying letters looks strange when there is less than 10 % chapters. Have to read the whole toc once to know how many chapters % there are before deciding ... \hbox to 1em{#1\hss}% } % These macros generate individual entries in the table of contents. % The first argument is the chapter or section name. % The last argument is the page number. % The arguments in between are the chapter number, section number, ... % Chapters, in the main contents. \def\numchapentry#1#2#3#4{\dochapentry{#2\labelspace#1}{#4}} % % Chapters, in the short toc. % See comments in \dochapentry re vbox and related settings. \def\shortchapentry#1#2#3#4{% \tocentry{\shortchaplabel{#2}\labelspace #1}{\doshortpageno\bgroup#4\egroup}% } % Appendices, in the main contents. % Need the word Appendix, and a fixed-size box. % \def\appendixbox#1{% % We use M since it's probably the widest letter. \setbox0 = \hbox{\putwordAppendix{} M}% \hbox to \wd0{\putwordAppendix{} #1\hss}} % \def\appentry#1#2#3#4{\dochapentry{\appendixbox{#2}\labelspace#1}{#4}} % Unnumbered chapters. \def\unnchapentry#1#2#3#4{\dochapentry{#1}{#4}} \def\shortunnchapentry#1#2#3#4{\tocentry{#1}{\doshortpageno\bgroup#4\egroup}} % Sections. \def\numsecentry#1#2#3#4{\dosecentry{#2\labelspace#1}{#4}} \let\appsecentry=\numsecentry \def\unnsecentry#1#2#3#4{\dosecentry{#1}{#4}} % Subsections. \def\numsubsecentry#1#2#3#4{\dosubsecentry{#2\labelspace#1}{#4}} \let\appsubsecentry=\numsubsecentry \def\unnsubsecentry#1#2#3#4{\dosubsecentry{#1}{#4}} % And subsubsections. \def\numsubsubsecentry#1#2#3#4{\dosubsubsecentry{#2\labelspace#1}{#4}} \let\appsubsubsecentry=\numsubsubsecentry \def\unnsubsubsecentry#1#2#3#4{\dosubsubsecentry{#1}{#4}} % This parameter controls the indentation of the various levels. % Same as \defaultparindent. \newdimen\tocindent \tocindent = 15pt % Now for the actual typesetting. In all these, #1 is the text and #2 is the % page number. % % If the toc has to be broken over pages, we want it to be at chapters % if at all possible; hence the \penalty. \def\dochapentry#1#2{% \penalty-300 \vskip1\baselineskip plus.33\baselineskip minus.25\baselineskip \begingroup \chapentryfonts \tocentry{#1}{\dopageno\bgroup#2\egroup}% \endgroup \nobreak\vskip .25\baselineskip plus.1\baselineskip } \def\dosecentry#1#2{\begingroup \secentryfonts \leftskip=\tocindent \tocentry{#1}{\dopageno\bgroup#2\egroup}% \endgroup} \def\dosubsecentry#1#2{\begingroup \subsecentryfonts \leftskip=2\tocindent \tocentry{#1}{\dopageno\bgroup#2\egroup}% \endgroup} \def\dosubsubsecentry#1#2{\begingroup \subsubsecentryfonts \leftskip=3\tocindent \tocentry{#1}{\dopageno\bgroup#2\egroup}% \endgroup} % We use the same \entry macro as for the index entries. \let\tocentry = \entry % Space between chapter (or whatever) number and the title. \def\labelspace{\hskip1em \relax} \def\dopageno#1{{\rm #1}} \def\doshortpageno#1{{\rm #1}} \def\chapentryfonts{\secfonts \rm} \def\secentryfonts{\textfonts} \def\subsecentryfonts{\textfonts} \def\subsubsecentryfonts{\textfonts} \message{environments,} % @foo ... @end foo. % @point{}, @result{}, @expansion{}, @print{}, @equiv{}. % % Since these characters are used in examples, it should be an even number of % \tt widths. Each \tt character is 1en, so two makes it 1em. % \def\point{$\star$} \def\result{\leavevmode\raise.15ex\hbox to 1em{\hfil$\Rightarrow$\hfil}} \def\expansion{\leavevmode\raise.1ex\hbox to 1em{\hfil$\mapsto$\hfil}} \def\print{\leavevmode\lower.1ex\hbox to 1em{\hfil$\dashv$\hfil}} \def\equiv{\leavevmode\lower.1ex\hbox to 1em{\hfil$\ptexequiv$\hfil}} % The @error{} command. % Adapted from the TeXbook's \boxit. % \newbox\errorbox % {\tentt \global\dimen0 = 3em}% Width of the box. \dimen2 = .55pt % Thickness of rules % The text. (`r' is open on the right, `e' somewhat less so on the left.) \setbox0 = \hbox{\kern-.75pt \reducedsf error\kern-1.5pt} % \setbox\errorbox=\hbox to \dimen0{\hfil \hsize = \dimen0 \advance\hsize by -5.8pt % Space to left+right. \advance\hsize by -2\dimen2 % Rules. \vbox{% \hrule height\dimen2 \hbox{\vrule width\dimen2 \kern3pt % Space to left of text. \vtop{\kern2.4pt \box0 \kern2.4pt}% Space above/below. \kern3pt\vrule width\dimen2}% Space to right. \hrule height\dimen2} \hfil} % \def\error{\leavevmode\lower.7ex\copy\errorbox} % @tex ... @end tex escapes into raw Tex temporarily. % One exception: @ is still an escape character, so that @end tex works. % But \@ or @@ will get a plain tex @ character. \envdef\tex{% \catcode `\\=0 \catcode `\{=1 \catcode `\}=2 \catcode `\$=3 \catcode `\&=4 \catcode `\#=6 \catcode `\^=7 \catcode `\_=8 \catcode `\~=\active \let~=\tie \catcode `\%=14 \catcode `\+=\other \catcode `\"=\other \catcode `\|=\other \catcode `\<=\other \catcode `\>=\other \escapechar=`\\ % \let\b=\ptexb \let\bullet=\ptexbullet \let\c=\ptexc \let\,=\ptexcomma \let\.=\ptexdot \let\dots=\ptexdots \let\equiv=\ptexequiv \let\!=\ptexexclam \let\i=\ptexi \let\indent=\ptexindent \let\noindent=\ptexnoindent \let\{=\ptexlbrace \let\+=\tabalign \let\}=\ptexrbrace \let\/=\ptexslash \let\*=\ptexstar \let\t=\ptext \let\frenchspacing=\plainfrenchspacing % \def\endldots{\mathinner{\ldots\ldots\ldots\ldots}}% \def\enddots{\relax\ifmmode\endldots\else$\mathsurround=0pt \endldots\,$\fi}% \def\@{@}% } % There is no need to define \Etex. % Define @lisp ... @end lisp. % @lisp environment forms a group so it can rebind things, % including the definition of @end lisp (which normally is erroneous). % Amount to narrow the margins by for @lisp. \newskip\lispnarrowing \lispnarrowing=0.4in % This is the definition that ^^M gets inside @lisp, @example, and other % such environments. \null is better than a space, since it doesn't % have any width. \def\lisppar{\null\endgraf} % This space is always present above and below environments. \newskip\envskipamount \envskipamount = 0pt % Make spacing and below environment symmetrical. We use \parskip here % to help in doing that, since in @example-like environments \parskip % is reset to zero; thus the \afterenvbreak inserts no space -- but the % start of the next paragraph will insert \parskip. % \def\aboveenvbreak{{% % =10000 instead of <10000 because of a special case in \itemzzz and % \sectionheading, q.v. \ifnum \lastpenalty=10000 \else \advance\envskipamount by \parskip \endgraf \ifdim\lastskip<\envskipamount \removelastskip % it's not a good place to break if the last penalty was \nobreak % or better ... \ifnum\lastpenalty<10000 \penalty-50 \fi \vskip\envskipamount \fi \fi }} \let\afterenvbreak = \aboveenvbreak % \nonarrowing is a flag. If "set", @lisp etc don't narrow margins; it will % also clear it, so that its embedded environments do the narrowing again. \let\nonarrowing=\relax % @cartouche ... @end cartouche: draw rectangle w/rounded corners around % environment contents. \font\circle=lcircle10 \newdimen\circthick \newdimen\cartouter\newdimen\cartinner \newskip\normbskip\newskip\normpskip\newskip\normlskip \circthick=\fontdimen8\circle % \def\ctl{{\circle\char'013\hskip -6pt}}% 6pt from pl file: 1/2charwidth \def\ctr{{\hskip 6pt\circle\char'010}} \def\cbl{{\circle\char'012\hskip -6pt}} \def\cbr{{\hskip 6pt\circle\char'011}} \def\carttop{\hbox to \cartouter{\hskip\lskip \ctl\leaders\hrule height\circthick\hfil\ctr \hskip\rskip}} \def\cartbot{\hbox to \cartouter{\hskip\lskip \cbl\leaders\hrule height\circthick\hfil\cbr \hskip\rskip}} % \newskip\lskip\newskip\rskip \envdef\cartouche{% \ifhmode\par\fi % can't be in the midst of a paragraph. \startsavinginserts \lskip=\leftskip \rskip=\rightskip \leftskip=0pt\rightskip=0pt % we want these *outside*. \cartinner=\hsize \advance\cartinner by-\lskip \advance\cartinner by-\rskip \cartouter=\hsize \advance\cartouter by 18.4pt % allow for 3pt kerns on either % side, and for 6pt waste from % each corner char, and rule thickness \normbskip=\baselineskip \normpskip=\parskip \normlskip=\lineskip % Flag to tell @lisp, etc., not to narrow margin. \let\nonarrowing = t% \vbox\bgroup \baselineskip=0pt\parskip=0pt\lineskip=0pt \carttop \hbox\bgroup \hskip\lskip \vrule\kern3pt \vbox\bgroup \kern3pt \hsize=\cartinner \baselineskip=\normbskip \lineskip=\normlskip \parskip=\normpskip \vskip -\parskip \comment % For explanation, see the end of \def\group. } \def\Ecartouche{% \ifhmode\par\fi \kern3pt \egroup \kern3pt\vrule \hskip\rskip \egroup \cartbot \egroup \checkinserts } % This macro is called at the beginning of all the @example variants, % inside a group. \def\nonfillstart{% \aboveenvbreak \hfuzz = 12pt % Don't be fussy \sepspaces % Make spaces be word-separators rather than space tokens. \let\par = \lisppar % don't ignore blank lines \obeylines % each line of input is a line of output \parskip = 0pt \parindent = 0pt \emergencystretch = 0pt % don't try to avoid overfull boxes \ifx\nonarrowing\relax \advance \leftskip by \lispnarrowing \exdentamount=\lispnarrowing \else \let\nonarrowing = \relax \fi \let\exdent=\nofillexdent } % If you want all examples etc. small: @set dispenvsize small. % If you want even small examples the full size: @set dispenvsize nosmall. % This affects the following displayed environments: % @example, @display, @format, @lisp % \def\smallword{small} \def\nosmallword{nosmall} \let\SETdispenvsize\relax \def\setnormaldispenv{% \ifx\SETdispenvsize\smallword % end paragraph for sake of leading, in case document has no blank % line. This is redundant with what happens in \aboveenvbreak, but % we need to do it before changing the fonts, and it's inconvenient % to change the fonts afterward. \ifnum \lastpenalty=10000 \else \endgraf \fi \smallexamplefonts \rm \fi } \def\setsmalldispenv{% \ifx\SETdispenvsize\nosmallword \else \ifnum \lastpenalty=10000 \else \endgraf \fi \smallexamplefonts \rm \fi } % We often define two environments, @foo and @smallfoo. % Let's do it by one command: \def\makedispenv #1#2{ \expandafter\envdef\csname#1\endcsname {\setnormaldispenv #2} \expandafter\envdef\csname small#1\endcsname {\setsmalldispenv #2} \expandafter\let\csname E#1\endcsname \afterenvbreak \expandafter\let\csname Esmall#1\endcsname \afterenvbreak } % Define two synonyms: \def\maketwodispenvs #1#2#3{ \makedispenv{#1}{#3} \makedispenv{#2}{#3} } % @lisp: indented, narrowed, typewriter font; @example: same as @lisp. % % @smallexample and @smalllisp: use smaller fonts. % Originally contributed by Pavel@xerox. % \maketwodispenvs {lisp}{example}{% \nonfillstart \tt\quoteexpand \let\kbdfont = \kbdexamplefont % Allow @kbd to do something special. \gobble % eat return } % @display/@smalldisplay: same as @lisp except keep current font. % \makedispenv {display}{% \nonfillstart \gobble } % @format/@smallformat: same as @display except don't narrow margins. % \makedispenv{format}{% \let\nonarrowing = t% \nonfillstart \gobble } % @flushleft: same as @format, but doesn't obey \SETdispenvsize. \envdef\flushleft{% \let\nonarrowing = t% \nonfillstart \gobble } \let\Eflushleft = \afterenvbreak % @flushright. % \envdef\flushright{% \let\nonarrowing = t% \nonfillstart \advance\leftskip by 0pt plus 1fill \gobble } \let\Eflushright = \afterenvbreak % @quotation does normal linebreaking (hence we can't use \nonfillstart) % and narrows the margins. We keep \parskip nonzero in general, since % we're doing normal filling. So, when using \aboveenvbreak and % \afterenvbreak, temporarily make \parskip 0. % \envdef\quotation{% {\parskip=0pt \aboveenvbreak}% because \aboveenvbreak inserts \parskip \parindent=0pt % % @cartouche defines \nonarrowing to inhibit narrowing at next level down. \ifx\nonarrowing\relax \advance\leftskip by \lispnarrowing \advance\rightskip by \lispnarrowing \exdentamount = \lispnarrowing \else \let\nonarrowing = \relax \fi \parsearg\quotationlabel } % We have retained a nonzero parskip for the environment, since we're % doing normal filling. % \def\Equotation{% \par \ifx\quotationauthor\undefined\else % indent a bit. \leftline{\kern 2\leftskip \sl ---\quotationauthor}% \fi {\parskip=0pt \afterenvbreak}% } % If we're given an argument, typeset it in bold with a colon after. \def\quotationlabel#1{% \def\temp{#1}% \ifx\temp\empty \else {\bf #1: }% \fi } % LaTeX-like @verbatim...@end verbatim and @verb{...} % If we want to allow any as delimiter, % we need the curly braces so that makeinfo sees the @verb command, eg: % `@verbx...x' would look like the '@verbx' command. --janneke@gnu.org % % [Knuth]: Donald Ervin Knuth, 1996. The TeXbook. % % [Knuth] p.344; only we need to do the other characters Texinfo sets % active too. Otherwise, they get lost as the first character on a % verbatim line. \def\dospecials{% \do\ \do\\\do\{\do\}\do\$\do\&% \do\#\do\^\do\^^K\do\_\do\^^A\do\%\do\~% \do\<\do\>\do\|\do\@\do+\do\"% } % % [Knuth] p. 380 \def\uncatcodespecials{% \def\do##1{\catcode`##1=\other}\dospecials} % % [Knuth] pp. 380,381,391 % Disable Spanish ligatures ?` and !` of \tt font \begingroup \catcode`\`=\active\gdef`{\relax\lq} \endgroup % % Setup for the @verb command. % % Eight spaces for a tab \begingroup \catcode`\^^I=\active \gdef\tabeightspaces{\catcode`\^^I=\active\def^^I{\ \ \ \ \ \ \ \ }} \endgroup % \def\setupverb{% \tt % easiest (and conventionally used) font for verbatim \def\par{\leavevmode\endgraf}% \catcode`\`=\active \tabeightspaces % Respect line breaks, % print special symbols as themselves, and % make each space count % must do in this order: \obeylines \uncatcodespecials \sepspaces } % Setup for the @verbatim environment % % Real tab expansion \newdimen\tabw \setbox0=\hbox{\tt\space} \tabw=8\wd0 % tab amount % \def\starttabbox{\setbox0=\hbox\bgroup} % Allow an option to not replace quotes with a regular directed right % quote/apostrophe (char 0x27), but instead use the undirected quote % from cmtt (char 0x0d). The undirected quote is ugly, so don't make it % the default, but it works for pasting with more pdf viewers (at least % evince), the lilypond developers report. xpdf does work with the % regular 0x27. % \def\codequoteright{% \expandafter\ifx\csname SETtxicodequoteundirected\endcsname\relax \expandafter\ifx\csname SETcodequoteundirected\endcsname\relax '% \else \char'15 \fi \else \char'15 \fi } % % and a similar option for the left quote char vs. a grave accent. % Modern fonts display ASCII 0x60 as a grave accent, so some people like % the code environments to do likewise. % \def\codequoteleft{% \expandafter\ifx\csname SETtxicodequotebacktick\endcsname\relax \expandafter\ifx\csname SETcodequotebacktick\endcsname\relax `% \else \char'22 \fi \else \char'22 \fi } % \begingroup \catcode`\^^I=\active \gdef\tabexpand{% \catcode`\^^I=\active \def^^I{\leavevmode\egroup \dimen0=\wd0 % the width so far, or since the previous tab \divide\dimen0 by\tabw \multiply\dimen0 by\tabw % compute previous multiple of \tabw \advance\dimen0 by\tabw % advance to next multiple of \tabw \wd0=\dimen0 \box0 \starttabbox }% } \catcode`\'=\active \gdef\rquoteexpand{\catcode\rquoteChar=\active \def'{\codequoteright}}% % \catcode`\`=\active \gdef\lquoteexpand{\catcode\lquoteChar=\active \def`{\codequoteleft}}% % \gdef\quoteexpand{\rquoteexpand \lquoteexpand}% \endgroup % start the verbatim environment. \def\setupverbatim{% \let\nonarrowing = t% \nonfillstart % Easiest (and conventionally used) font for verbatim \tt \def\par{\leavevmode\egroup\box0\endgraf}% \catcode`\`=\active \tabexpand \quoteexpand % Respect line breaks, % print special symbols as themselves, and % make each space count % must do in this order: \obeylines \uncatcodespecials \sepspaces \everypar{\starttabbox}% } % Do the @verb magic: verbatim text is quoted by unique % delimiter characters. Before first delimiter expect a % right brace, after last delimiter expect closing brace: % % \def\doverb'{'#1'}'{#1} % % [Knuth] p. 382; only eat outer {} \begingroup \catcode`[=1\catcode`]=2\catcode`\{=\other\catcode`\}=\other \gdef\doverb{#1[\def\next##1#1}[##1\endgroup]\next] \endgroup % \def\verb{\begingroup\setupverb\doverb} % % % Do the @verbatim magic: define the macro \doverbatim so that % the (first) argument ends when '@end verbatim' is reached, ie: % % \def\doverbatim#1@end verbatim{#1} % % For Texinfo it's a lot easier than for LaTeX, % because texinfo's \verbatim doesn't stop at '\end{verbatim}': % we need not redefine '\', '{' and '}'. % % Inspired by LaTeX's verbatim command set [latex.ltx] % \begingroup \catcode`\ =\active \obeylines % % ignore everything up to the first ^^M, that's the newline at the end % of the @verbatim input line itself. Otherwise we get an extra blank % line in the output. \xdef\doverbatim#1^^M#2@end verbatim{#2\noexpand\end\gobble verbatim}% % We really want {...\end verbatim} in the body of the macro, but % without the active space; thus we have to use \xdef and \gobble. \endgroup % \envdef\verbatim{% \setupverbatim\doverbatim } \let\Everbatim = \afterenvbreak % @verbatiminclude FILE - insert text of file in verbatim environment. % \def\verbatiminclude{\parseargusing\filenamecatcodes\doverbatiminclude} % \def\doverbatiminclude#1{% {% \makevalueexpandable \setupverbatim \input #1 \afterenvbreak }% } % @copying ... @end copying. % Save the text away for @insertcopying later. % % We save the uninterpreted tokens, rather than creating a box. % Saving the text in a box would be much easier, but then all the % typesetting commands (@smallbook, font changes, etc.) have to be done % beforehand -- and a) we want @copying to be done first in the source % file; b) letting users define the frontmatter in as flexible order as % possible is very desirable. % \def\copying{\checkenv{}\begingroup\scanargctxt\docopying} \def\docopying#1@end copying{\endgroup\def\copyingtext{#1}} % \def\insertcopying{% \begingroup \parindent = 0pt % paragraph indentation looks wrong on title page \scanexp\copyingtext \endgroup } \message{defuns,} % @defun etc. \newskip\defbodyindent \defbodyindent=.4in \newskip\defargsindent \defargsindent=50pt \newskip\deflastargmargin \deflastargmargin=18pt \newcount\defunpenalty % Start the processing of @deffn: \def\startdefun{% \ifnum\lastpenalty<10000 \medbreak \defunpenalty=10003 % Will keep this @deffn together with the % following @def command, see below. \else % If there are two @def commands in a row, we'll have a \nobreak, % which is there to keep the function description together with its % header. But if there's nothing but headers, we need to allow a % break somewhere. Check specifically for penalty 10002, inserted % by \printdefunline, instead of 10000, since the sectioning % commands also insert a nobreak penalty, and we don't want to allow % a break between a section heading and a defun. % % As a minor refinement, we avoid "club" headers by signalling % with penalty of 10003 after the very first @deffn in the % sequence (see above), and penalty of 10002 after any following % @def command. \ifnum\lastpenalty=10002 \penalty2000 \else \defunpenalty=10002 \fi % % Similarly, after a section heading, do not allow a break. % But do insert the glue. \medskip % preceded by discardable penalty, so not a breakpoint \fi % \parindent=0in \advance\leftskip by \defbodyindent \exdentamount=\defbodyindent } \def\dodefunx#1{% % First, check whether we are in the right environment: \checkenv#1% % % As above, allow line break if we have multiple x headers in a row. % It's not a great place, though. \ifnum\lastpenalty=10002 \penalty3000 \else \defunpenalty=10002 \fi % % And now, it's time to reuse the body of the original defun: \expandafter\gobbledefun#1% } \def\gobbledefun#1\startdefun{} % \printdefunline \deffnheader{text} % \def\printdefunline#1#2{% \begingroup % call \deffnheader: #1#2 \endheader % common ending: \interlinepenalty = 10000 \advance\rightskip by 0pt plus 1fil \endgraf \nobreak\vskip -\parskip \penalty\defunpenalty % signal to \startdefun and \dodefunx % Some of the @defun-type tags do not enable magic parentheses, % rendering the following check redundant. But we don't optimize. \checkparencounts \endgroup } \def\Edefun{\endgraf\medbreak} % \makedefun{deffn} creates \deffn, \deffnx and \Edeffn; % the only thing remainnig is to define \deffnheader. % \def\makedefun#1{% \expandafter\let\csname E#1\endcsname = \Edefun \edef\temp{\noexpand\domakedefun \makecsname{#1}\makecsname{#1x}\makecsname{#1header}}% \temp } % \domakedefun \deffn \deffnx \deffnheader % % Define \deffn and \deffnx, without parameters. % \deffnheader has to be defined explicitly. % \def\domakedefun#1#2#3{% \envdef#1{% \startdefun \parseargusing\activeparens{\printdefunline#3}% }% \def#2{\dodefunx#1}% \def#3% } %%% Untyped functions: % @deffn category name args \makedefun{deffn}{\deffngeneral{}} % @deffn category class name args \makedefun{defop}#1 {\defopon{#1\ \putwordon}} % \defopon {category on}class name args \def\defopon#1#2 {\deffngeneral{\putwordon\ \code{#2}}{#1\ \code{#2}} } % \deffngeneral {subind}category name args % \def\deffngeneral#1#2 #3 #4\endheader{% % Remember that \dosubind{fn}{foo}{} is equivalent to \doind{fn}{foo}. \dosubind{fn}{\code{#3}}{#1}% \defname{#2}{}{#3}\magicamp\defunargs{#4\unskip}% } %%% Typed functions: % @deftypefn category type name args \makedefun{deftypefn}{\deftypefngeneral{}} % @deftypeop category class type name args \makedefun{deftypeop}#1 {\deftypeopon{#1\ \putwordon}} % \deftypeopon {category on}class type name args \def\deftypeopon#1#2 {\deftypefngeneral{\putwordon\ \code{#2}}{#1\ \code{#2}} } % \deftypefngeneral {subind}category type name args % \def\deftypefngeneral#1#2 #3 #4 #5\endheader{% \dosubind{fn}{\code{#4}}{#1}% \defname{#2}{#3}{#4}\defunargs{#5\unskip}% } %%% Typed variables: % @deftypevr category type var args \makedefun{deftypevr}{\deftypecvgeneral{}} % @deftypecv category class type var args \makedefun{deftypecv}#1 {\deftypecvof{#1\ \putwordof}} % \deftypecvof {category of}class type var args \def\deftypecvof#1#2 {\deftypecvgeneral{\putwordof\ \code{#2}}{#1\ \code{#2}} } % \deftypecvgeneral {subind}category type var args % \def\deftypecvgeneral#1#2 #3 #4 #5\endheader{% \dosubind{vr}{\code{#4}}{#1}% \defname{#2}{#3}{#4}\defunargs{#5\unskip}% } %%% Untyped variables: % @defvr category var args \makedefun{defvr}#1 {\deftypevrheader{#1} {} } % @defcv category class var args \makedefun{defcv}#1 {\defcvof{#1\ \putwordof}} % \defcvof {category of}class var args \def\defcvof#1#2 {\deftypecvof{#1}#2 {} } %%% Type: % @deftp category name args \makedefun{deftp}#1 #2 #3\endheader{% \doind{tp}{\code{#2}}% \defname{#1}{}{#2}\defunargs{#3\unskip}% } % Remaining @defun-like shortcuts: \makedefun{defun}{\deffnheader{\putwordDeffunc} } \makedefun{defmac}{\deffnheader{\putwordDefmac} } \makedefun{defspec}{\deffnheader{\putwordDefspec} } \makedefun{deftypefun}{\deftypefnheader{\putwordDeffunc} } \makedefun{defvar}{\defvrheader{\putwordDefvar} } \makedefun{defopt}{\defvrheader{\putwordDefopt} } \makedefun{deftypevar}{\deftypevrheader{\putwordDefvar} } \makedefun{defmethod}{\defopon\putwordMethodon} \makedefun{deftypemethod}{\deftypeopon\putwordMethodon} \makedefun{defivar}{\defcvof\putwordInstanceVariableof} \makedefun{deftypeivar}{\deftypecvof\putwordInstanceVariableof} % \defname, which formats the name of the @def (not the args). % #1 is the category, such as "Function". % #2 is the return type, if any. % #3 is the function name. % % We are followed by (but not passed) the arguments, if any. % \def\defname#1#2#3{% % Get the values of \leftskip and \rightskip as they were outside the @def... \advance\leftskip by -\defbodyindent % % How we'll format the type name. Putting it in brackets helps % distinguish it from the body text that may end up on the next line % just below it. \def\temp{#1}% \setbox0=\hbox{\kern\deflastargmargin \ifx\temp\empty\else [\rm\temp]\fi} % % Figure out line sizes for the paragraph shape. % The first line needs space for \box0; but if \rightskip is nonzero, % we need only space for the part of \box0 which exceeds it: \dimen0=\hsize \advance\dimen0 by -\wd0 \advance\dimen0 by \rightskip % The continuations: \dimen2=\hsize \advance\dimen2 by -\defargsindent % (plain.tex says that \dimen1 should be used only as global.) \parshape 2 0in \dimen0 \defargsindent \dimen2 % % Put the type name to the right margin. \noindent \hbox to 0pt{% \hfil\box0 \kern-\hsize % \hsize has to be shortened this way: \kern\leftskip % Intentionally do not respect \rightskip, since we need the space. }% % % Allow all lines to be underfull without complaint: \tolerance=10000 \hbadness=10000 \exdentamount=\defbodyindent {% % defun fonts. We use typewriter by default (used to be bold) because: % . we're printing identifiers, they should be in tt in principle. % . in languages with many accents, such as Czech or French, it's % common to leave accents off identifiers. The result looks ok in % tt, but exceedingly strange in rm. % . we don't want -- and --- to be treated as ligatures. % . this still does not fix the ?` and !` ligatures, but so far no % one has made identifiers using them :). \df \tt \def\temp{#2}% return value type \ifx\temp\empty\else \tclose{\temp} \fi #3% output function name }% {\rm\enskip}% hskip 0.5 em of \tenrm % \boldbrax % arguments will be output next, if any. } % Print arguments in slanted roman (not ttsl), inconsistently with using % tt for the name. This is because literal text is sometimes needed in % the argument list (groff manual), and ttsl and tt are not very % distinguishable. Prevent hyphenation at `-' chars. % \def\defunargs#1{% % use sl by default (not ttsl), % tt for the names. \df \sl \hyphenchar\font=0 % % On the other hand, if an argument has two dashes (for instance), we % want a way to get ttsl. Let's try @var for that. \let\var=\ttslanted #1% \sl\hyphenchar\font=45 } % We want ()&[] to print specially on the defun line. % \def\activeparens{% \catcode`\(=\active \catcode`\)=\active \catcode`\[=\active \catcode`\]=\active \catcode`\&=\active } % Make control sequences which act like normal parenthesis chars. \let\lparen = ( \let\rparen = ) % Be sure that we always have a definition for `(', etc. For example, % if the fn name has parens in it, \boldbrax will not be in effect yet, % so TeX would otherwise complain about undefined control sequence. { \activeparens \global\let(=\lparen \global\let)=\rparen \global\let[=\lbrack \global\let]=\rbrack \global\let& = \& \gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb} \gdef\magicamp{\let&=\amprm} } \newcount\parencount % If we encounter &foo, then turn on ()-hacking afterwards \newif\ifampseen \def\amprm#1 {\ampseentrue{\bf\ }} \def\parenfont{% \ifampseen % At the first level, print parens in roman, % otherwise use the default font. \ifnum \parencount=1 \rm \fi \else % The \sf parens (in \boldbrax) actually are a little bolder than % the contained text. This is especially needed for [ and ] . \sf \fi } \def\infirstlevel#1{% \ifampseen \ifnum\parencount=1 #1% \fi \fi } \def\bfafterword#1 {#1 \bf} \def\opnr{% \global\advance\parencount by 1 {\parenfont(}% \infirstlevel \bfafterword } \def\clnr{% {\parenfont)}% \infirstlevel \sl \global\advance\parencount by -1 } \newcount\brackcount \def\lbrb{% \global\advance\brackcount by 1 {\bf[}% } \def\rbrb{% {\bf]}% \global\advance\brackcount by -1 } \def\checkparencounts{% \ifnum\parencount=0 \else \badparencount \fi \ifnum\brackcount=0 \else \badbrackcount \fi } % these should not use \errmessage; the glibc manual, at least, actually % has such constructs (when documenting function pointers). \def\badparencount{% \message{Warning: unbalanced parentheses in @def...}% \global\parencount=0 } \def\badbrackcount{% \message{Warning: unbalanced square brackets in @def...}% \global\brackcount=0 } \message{macros,} % @macro. % To do this right we need a feature of e-TeX, \scantokens, % which we arrange to emulate with a temporary file in ordinary TeX. \ifx\eTeXversion\undefined \newwrite\macscribble \def\scantokens#1{% \toks0={#1}% \immediate\openout\macscribble=\jobname.tmp \immediate\write\macscribble{\the\toks0}% \immediate\closeout\macscribble \input \jobname.tmp } \fi \def\scanmacro#1{% \begingroup \newlinechar`\^^M \let\xeatspaces\eatspaces % Undo catcode changes of \startcontents and \doprintindex % When called from @insertcopying or (short)caption, we need active % backslash to get it printed correctly. Previously, we had % \catcode`\\=\other instead. We'll see whether a problem appears % with macro expansion. --kasal, 19aug04 \catcode`\@=0 \catcode`\\=\active \escapechar=`\@ % ... and \example \spaceisspace % % Append \endinput to make sure that TeX does not see the ending newline. % I've verified that it is necessary both for e-TeX and for ordinary TeX % --kasal, 29nov03 \scantokens{#1\endinput}% \endgroup } \def\scanexp#1{% \edef\temp{\noexpand\scanmacro{#1}}% \temp } \newcount\paramno % Count of parameters \newtoks\macname % Macro name \newif\ifrecursive % Is it recursive? % List of all defined macros in the form % \definedummyword\macro1\definedummyword\macro2... % Currently is also contains all @aliases; the list can be split % if there is a need. \def\macrolist{} % Add the macro to \macrolist \def\addtomacrolist#1{\expandafter \addtomacrolistxxx \csname#1\endcsname} \def\addtomacrolistxxx#1{% \toks0 = \expandafter{\macrolist\definedummyword#1}% \xdef\macrolist{\the\toks0}% } % Utility routines. % This does \let #1 = #2, with \csnames; that is, % \let \csname#1\endcsname = \csname#2\endcsname % (except of course we have to play expansion games). % \def\cslet#1#2{% \expandafter\let \csname#1\expandafter\endcsname \csname#2\endcsname } % Trim leading and trailing spaces off a string. % Concepts from aro-bend problem 15 (see CTAN). {\catcode`\@=11 \gdef\eatspaces #1{\expandafter\trim@\expandafter{#1 }} \gdef\trim@ #1{\trim@@ @#1 @ #1 @ @@} \gdef\trim@@ #1@ #2@ #3@@{\trim@@@\empty #2 @} \def\unbrace#1{#1} \unbrace{\gdef\trim@@@ #1 } #2@{#1} } % Trim a single trailing ^^M off a string. {\catcode`\^^M=\other \catcode`\Q=3% \gdef\eatcr #1{\eatcra #1Q^^MQ}% \gdef\eatcra#1^^MQ{\eatcrb#1Q}% \gdef\eatcrb#1Q#2Q{#1}% } % Macro bodies are absorbed as an argument in a context where % all characters are catcode 10, 11 or 12, except \ which is active % (as in normal texinfo). It is necessary to change the definition of \. % Non-ASCII encodings make 8-bit characters active, so un-activate % them to avoid their expansion. Must do this non-globally, to % confine the change to the current group. % It's necessary to have hard CRs when the macro is executed. This is % done by making ^^M (\endlinechar) catcode 12 when reading the macro % body, and then making it the \newlinechar in \scanmacro. \def\scanctxt{% \catcode`\"=\other \catcode`\+=\other \catcode`\<=\other \catcode`\>=\other \catcode`\@=\other \catcode`\^=\other \catcode`\_=\other \catcode`\|=\other \catcode`\~=\other \ifx\declaredencoding\ascii \else \setnonasciicharscatcodenonglobal\other \fi } \def\scanargctxt{% \scanctxt \catcode`\\=\other \catcode`\^^M=\other } \def\macrobodyctxt{% \scanctxt \catcode`\{=\other \catcode`\}=\other \catcode`\^^M=\other \usembodybackslash } \def\macroargctxt{% \scanctxt \catcode`\\=\other } % \mbodybackslash is the definition of \ in @macro bodies. % It maps \foo\ => \csname macarg.foo\endcsname => #N % where N is the macro parameter number. % We define \csname macarg.\endcsname to be \realbackslash, so % \\ in macro replacement text gets you a backslash. {\catcode`@=0 @catcode`@\=@active @gdef@usembodybackslash{@let\=@mbodybackslash} @gdef@mbodybackslash#1\{@csname macarg.#1@endcsname} } \expandafter\def\csname macarg.\endcsname{\realbackslash} \def\macro{\recursivefalse\parsearg\macroxxx} \def\rmacro{\recursivetrue\parsearg\macroxxx} \def\macroxxx#1{% \getargs{#1}% now \macname is the macname and \argl the arglist \ifx\argl\empty % no arguments \paramno=0% \else \expandafter\parsemargdef \argl;% \fi \if1\csname ismacro.\the\macname\endcsname \message{Warning: redefining \the\macname}% \else \expandafter\ifx\csname \the\macname\endcsname \relax \else \errmessage{Macro name \the\macname\space already defined}\fi \global\cslet{macsave.\the\macname}{\the\macname}% \global\expandafter\let\csname ismacro.\the\macname\endcsname=1% \addtomacrolist{\the\macname}% \fi \begingroup \macrobodyctxt \ifrecursive \expandafter\parsermacbody \else \expandafter\parsemacbody \fi} \parseargdef\unmacro{% \if1\csname ismacro.#1\endcsname \global\cslet{#1}{macsave.#1}% \global\expandafter\let \csname ismacro.#1\endcsname=0% % Remove the macro name from \macrolist: \begingroup \expandafter\let\csname#1\endcsname \relax \let\definedummyword\unmacrodo \xdef\macrolist{\macrolist}% \endgroup \else \errmessage{Macro #1 not defined}% \fi } % Called by \do from \dounmacro on each macro. The idea is to omit any % macro definitions that have been changed to \relax. % \def\unmacrodo#1{% \ifx #1\relax % remove this \else \noexpand\definedummyword \noexpand#1% \fi } % This makes use of the obscure feature that if the last token of a % is #, then the preceding argument is delimited by % an opening brace, and that opening brace is not consumed. \def\getargs#1{\getargsxxx#1{}} \def\getargsxxx#1#{\getmacname #1 \relax\getmacargs} \def\getmacname #1 #2\relax{\macname={#1}} \def\getmacargs#1{\def\argl{#1}} % Parse the optional {params} list. Set up \paramno and \paramlist % so \defmacro knows what to do. Define \macarg.blah for each blah % in the params list, to be ##N where N is the position in that list. % That gets used by \mbodybackslash (above). % We need to get `macro parameter char #' into several definitions. % The technique used is stolen from LaTeX: let \hash be something % unexpandable, insert that wherever you need a #, and then redefine % it to # just before using the token list produced. % % The same technique is used to protect \eatspaces till just before % the macro is used. \def\parsemargdef#1;{\paramno=0\def\paramlist{}% \let\hash\relax\let\xeatspaces\relax\parsemargdefxxx#1,;,} \def\parsemargdefxxx#1,{% \if#1;\let\next=\relax \else \let\next=\parsemargdefxxx \advance\paramno by 1% \expandafter\edef\csname macarg.\eatspaces{#1}\endcsname {\xeatspaces{\hash\the\paramno}}% \edef\paramlist{\paramlist\hash\the\paramno,}% \fi\next} % These two commands read recursive and nonrecursive macro bodies. % (They're different since rec and nonrec macros end differently.) \long\def\parsemacbody#1@end macro% {\xdef\temp{\eatcr{#1}}\endgroup\defmacro}% \long\def\parsermacbody#1@end rmacro% {\xdef\temp{\eatcr{#1}}\endgroup\defmacro}% % This defines the macro itself. There are six cases: recursive and % nonrecursive macros of zero, one, and many arguments. % Much magic with \expandafter here. % \xdef is used so that macro definitions will survive the file % they're defined in; @include reads the file inside a group. \def\defmacro{% \let\hash=##% convert placeholders to macro parameter chars \ifrecursive \ifcase\paramno % 0 \expandafter\xdef\csname\the\macname\endcsname{% \noexpand\scanmacro{\temp}}% \or % 1 \expandafter\xdef\csname\the\macname\endcsname{% \bgroup\noexpand\macroargctxt \noexpand\braceorline \expandafter\noexpand\csname\the\macname xxx\endcsname}% \expandafter\xdef\csname\the\macname xxx\endcsname##1{% \egroup\noexpand\scanmacro{\temp}}% \else % many \expandafter\xdef\csname\the\macname\endcsname{% \bgroup\noexpand\macroargctxt \noexpand\csname\the\macname xx\endcsname}% \expandafter\xdef\csname\the\macname xx\endcsname##1{% \expandafter\noexpand\csname\the\macname xxx\endcsname ##1,}% \expandafter\expandafter \expandafter\xdef \expandafter\expandafter \csname\the\macname xxx\endcsname \paramlist{\egroup\noexpand\scanmacro{\temp}}% \fi \else \ifcase\paramno % 0 \expandafter\xdef\csname\the\macname\endcsname{% \noexpand\norecurse{\the\macname}% \noexpand\scanmacro{\temp}\egroup}% \or % 1 \expandafter\xdef\csname\the\macname\endcsname{% \bgroup\noexpand\macroargctxt \noexpand\braceorline \expandafter\noexpand\csname\the\macname xxx\endcsname}% \expandafter\xdef\csname\the\macname xxx\endcsname##1{% \egroup \noexpand\norecurse{\the\macname}% \noexpand\scanmacro{\temp}\egroup}% \else % many \expandafter\xdef\csname\the\macname\endcsname{% \bgroup\noexpand\macroargctxt \expandafter\noexpand\csname\the\macname xx\endcsname}% \expandafter\xdef\csname\the\macname xx\endcsname##1{% \expandafter\noexpand\csname\the\macname xxx\endcsname ##1,}% \expandafter\expandafter \expandafter\xdef \expandafter\expandafter \csname\the\macname xxx\endcsname \paramlist{% \egroup \noexpand\norecurse{\the\macname}% \noexpand\scanmacro{\temp}\egroup}% \fi \fi} \def\norecurse#1{\bgroup\cslet{#1}{macsave.#1}} % \braceorline decides whether the next nonwhitespace character is a % {. If so it reads up to the closing }, if not, it reads the whole % line. Whatever was read is then fed to the next control sequence % as an argument (by \parsebrace or \parsearg) \def\braceorline#1{\let\macnamexxx=#1\futurelet\nchar\braceorlinexxx} \def\braceorlinexxx{% \ifx\nchar\bgroup\else \expandafter\parsearg \fi \macnamexxx} % @alias. % We need some trickery to remove the optional spaces around the equal % sign. Just make them active and then expand them all to nothing. \def\alias{\parseargusing\obeyspaces\aliasxxx} \def\aliasxxx #1{\aliasyyy#1\relax} \def\aliasyyy #1=#2\relax{% {% \expandafter\let\obeyedspace=\empty \addtomacrolist{#1}% \xdef\next{\global\let\makecsname{#1}=\makecsname{#2}}% }% \next } \message{cross references,} \newwrite\auxfile \newif\ifhavexrefs % True if xref values are known. \newif\ifwarnedxrefs % True if we warned once that they aren't known. % @inforef is relatively simple. \def\inforef #1{\inforefzzz #1,,,,**} \def\inforefzzz #1,#2,#3,#4**{\putwordSee{} \putwordInfo{} \putwordfile{} \file{\ignorespaces #3{}}, node \samp{\ignorespaces#1{}}} % @node's only job in TeX is to define \lastnode, which is used in % cross-references. The @node line might or might not have commas, and % might or might not have spaces before the first comma, like: % @node foo , bar , ... % We don't want such trailing spaces in the node name. % \parseargdef\node{\checkenv{}\donode #1 ,\finishnodeparse} % % also remove a trailing comma, in case of something like this: % @node Help-Cross, , , Cross-refs \def\donode#1 ,#2\finishnodeparse{\dodonode #1,\finishnodeparse} \def\dodonode#1,#2\finishnodeparse{\gdef\lastnode{#1}} \let\nwnode=\node \let\lastnode=\empty % Write a cross-reference definition for the current node. #1 is the % type (Ynumbered, Yappendix, Ynothing). % \def\donoderef#1{% \ifx\lastnode\empty\else \setref{\lastnode}{#1}% \global\let\lastnode=\empty \fi } % @anchor{NAME} -- define xref target at arbitrary point. % \newcount\savesfregister % \def\savesf{\relax \ifhmode \savesfregister=\spacefactor \fi} \def\restoresf{\relax \ifhmode \spacefactor=\savesfregister \fi} \def\anchor#1{\savesf \setref{#1}{Ynothing}\restoresf \ignorespaces} % \setref{NAME}{SNT} defines a cross-reference point NAME (a node or an % anchor), which consists of three parts: % 1) NAME-title - the current sectioning name taken from \lastsection, % or the anchor name. % 2) NAME-snt - section number and type, passed as the SNT arg, or % empty for anchors. % 3) NAME-pg - the page number. % % This is called from \donoderef, \anchor, and \dofloat. In the case of % floats, there is an additional part, which is not written here: % 4) NAME-lof - the text as it should appear in a @listoffloats. % \def\setref#1#2{% \pdfmkdest{#1}% \iflinks {% \atdummies % preserve commands, but don't expand them \edef\writexrdef##1##2{% \write\auxfile{@xrdef{#1-% #1 of \setref, expanded by the \edef ##1}{##2}}% these are parameters of \writexrdef }% \toks0 = \expandafter{\lastsection}% \immediate \writexrdef{title}{\the\toks0 }% \immediate \writexrdef{snt}{\csname #2\endcsname}% \Ynumbered etc. \safewhatsit{\writexrdef{pg}{\folio}}% will be written later, during \shipout }% \fi } % @xref, @pxref, and @ref generate cross-references. For \xrefX, #1 is % the node name, #2 the name of the Info cross-reference, #3 the printed % node name, #4 the name of the Info file, #5 the name of the printed % manual. All but the node name can be omitted. % \def\pxref#1{\putwordsee{} \xrefX[#1,,,,,,,]} \def\xref#1{\putwordSee{} \xrefX[#1,,,,,,,]} \def\ref#1{\xrefX[#1,,,,,,,]} \def\xrefX[#1,#2,#3,#4,#5,#6]{\begingroup \unsepspaces \def\printedmanual{\ignorespaces #5}% \def\printedrefname{\ignorespaces #3}% \setbox1=\hbox{\printedmanual\unskip}% \setbox0=\hbox{\printedrefname\unskip}% \ifdim \wd0 = 0pt % No printed node name was explicitly given. \expandafter\ifx\csname SETxref-automatic-section-title\endcsname\relax % Use the node name inside the square brackets. \def\printedrefname{\ignorespaces #1}% \else % Use the actual chapter/section title appear inside % the square brackets. Use the real section title if we have it. \ifdim \wd1 > 0pt % It is in another manual, so we don't have it. \def\printedrefname{\ignorespaces #1}% \else \ifhavexrefs % We know the real title if we have the xref values. \def\printedrefname{\refx{#1-title}{}}% \else % Otherwise just copy the Info node name. \def\printedrefname{\ignorespaces #1}% \fi% \fi \fi \fi % % Make link in pdf output. \ifpdf \leavevmode \getfilename{#4}% {\indexnofonts \turnoffactive % See comments at \activebackslashdouble. {\activebackslashdouble \xdef\pdfxrefdest{#1}% \backslashparens\pdfxrefdest}% % \ifnum\filenamelength>0 \startlink attr{/Border [0 0 0]}% goto file{\the\filename.pdf} name{\pdfxrefdest}% \else \startlink attr{/Border [0 0 0]}% goto name{\pdfmkpgn{\pdfxrefdest}}% \fi }% \setcolor{\linkcolor}% \fi % % Float references are printed completely differently: "Figure 1.2" % instead of "[somenode], p.3". We distinguish them by the % LABEL-title being set to a magic string. {% % Have to otherify everything special to allow the \csname to % include an _ in the xref name, etc. \indexnofonts \turnoffactive \expandafter\global\expandafter\let\expandafter\Xthisreftitle \csname XR#1-title\endcsname }% \iffloat\Xthisreftitle % If the user specified the print name (third arg) to the ref, % print it instead of our usual "Figure 1.2". \ifdim\wd0 = 0pt \refx{#1-snt}{}% \else \printedrefname \fi % % if the user also gave the printed manual name (fifth arg), append % "in MANUALNAME". \ifdim \wd1 > 0pt \space \putwordin{} \cite{\printedmanual}% \fi \else % node/anchor (non-float) references. % % If we use \unhbox0 and \unhbox1 to print the node names, TeX does not % insert empty discretionaries after hyphens, which means that it will % not find a line break at a hyphen in a node names. Since some manuals % are best written with fairly long node names, containing hyphens, this % is a loss. Therefore, we give the text of the node name again, so it % is as if TeX is seeing it for the first time. \ifdim \wd1 > 0pt \putwordSection{} ``\printedrefname'' \putwordin{} \cite{\printedmanual}% \else % _ (for example) has to be the character _ for the purposes of the % control sequence corresponding to the node, but it has to expand % into the usual \leavevmode...\vrule stuff for purposes of % printing. So we \turnoffactive for the \refx-snt, back on for the % printing, back off for the \refx-pg. {\turnoffactive % Only output a following space if the -snt ref is nonempty; for % @unnumbered and @anchor, it won't be. \setbox2 = \hbox{\ignorespaces \refx{#1-snt}{}}% \ifdim \wd2 > 0pt \refx{#1-snt}\space\fi }% % output the `[mynode]' via a macro so it can be overridden. \xrefprintnodename\printedrefname % % But we always want a comma and a space: ,\space % % output the `page 3'. \turnoffactive \putwordpage\tie\refx{#1-pg}{}% \fi \fi \endlink \endgroup} % This macro is called from \xrefX for the `[nodename]' part of xref % output. It's a separate macro only so it can be changed more easily, % since square brackets don't work well in some documents. Particularly % one that Bob is working on :). % \def\xrefprintnodename#1{[#1]} % Things referred to by \setref. % \def\Ynothing{} \def\Yomitfromtoc{} \def\Ynumbered{% \ifnum\secno=0 \putwordChapter@tie \the\chapno \else \ifnum\subsecno=0 \putwordSection@tie \the\chapno.\the\secno \else \ifnum\subsubsecno=0 \putwordSection@tie \the\chapno.\the\secno.\the\subsecno \else \putwordSection@tie \the\chapno.\the\secno.\the\subsecno.\the\subsubsecno \fi\fi\fi } \def\Yappendix{% \ifnum\secno=0 \putwordAppendix@tie @char\the\appendixno{}% \else \ifnum\subsecno=0 \putwordSection@tie @char\the\appendixno.\the\secno \else \ifnum\subsubsecno=0 \putwordSection@tie @char\the\appendixno.\the\secno.\the\subsecno \else \putwordSection@tie @char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno \fi\fi\fi } % Define \refx{NAME}{SUFFIX} to reference a cross-reference string named NAME. % If its value is nonempty, SUFFIX is output afterward. % \def\refx#1#2{% {% \indexnofonts \otherbackslash \expandafter\global\expandafter\let\expandafter\thisrefX \csname XR#1\endcsname }% \ifx\thisrefX\relax % If not defined, say something at least. \angleleft un\-de\-fined\angleright \iflinks \ifhavexrefs \message{\linenumber Undefined cross reference `#1'.}% \else \ifwarnedxrefs\else \global\warnedxrefstrue \message{Cross reference values unknown; you must run TeX again.}% \fi \fi \fi \else % It's defined, so just use it. \thisrefX \fi #2% Output the suffix in any case. } % This is the macro invoked by entries in the aux file. Usually it's % just a \def (we prepend XR to the control sequence name to avoid % collisions). But if this is a float type, we have more work to do. % \def\xrdef#1#2{% {% The node name might contain 8-bit characters, which in our current % implementation are changed to commands like @'e. Don't let these % mess up the control sequence name. \indexnofonts \turnoffactive \xdef\safexrefname{#1}% }% % \expandafter\gdef\csname XR\safexrefname\endcsname{#2}% remember this xref % % Was that xref control sequence that we just defined for a float? \expandafter\iffloat\csname XR\safexrefname\endcsname % it was a float, and we have the (safe) float type in \iffloattype. \expandafter\let\expandafter\floatlist \csname floatlist\iffloattype\endcsname % % Is this the first time we've seen this float type? \expandafter\ifx\floatlist\relax \toks0 = {\do}% yes, so just \do \else % had it before, so preserve previous elements in list. \toks0 = \expandafter{\floatlist\do}% \fi % % Remember this xref in the control sequence \floatlistFLOATTYPE, % for later use in \listoffloats. \expandafter\xdef\csname floatlist\iffloattype\endcsname{\the\toks0 {\safexrefname}}% \fi } % Read the last existing aux file, if any. No error if none exists. % \def\tryauxfile{% \openin 1 \jobname.aux \ifeof 1 \else \readdatafile{aux}% \global\havexrefstrue \fi \closein 1 } \def\setupdatafile{% \catcode`\^^@=\other \catcode`\^^A=\other \catcode`\^^B=\other \catcode`\^^C=\other \catcode`\^^D=\other \catcode`\^^E=\other \catcode`\^^F=\other \catcode`\^^G=\other \catcode`\^^H=\other \catcode`\^^K=\other \catcode`\^^L=\other \catcode`\^^N=\other \catcode`\^^P=\other \catcode`\^^Q=\other \catcode`\^^R=\other \catcode`\^^S=\other \catcode`\^^T=\other \catcode`\^^U=\other \catcode`\^^V=\other \catcode`\^^W=\other \catcode`\^^X=\other \catcode`\^^Z=\other \catcode`\^^[=\other \catcode`\^^\=\other \catcode`\^^]=\other \catcode`\^^^=\other \catcode`\^^_=\other % It was suggested to set the catcode of ^ to 7, which would allow ^^e4 etc. % in xref tags, i.e., node names. But since ^^e4 notation isn't % supported in the main text, it doesn't seem desirable. Furthermore, % that is not enough: for node names that actually contain a ^ % character, we would end up writing a line like this: 'xrdef {'hat % b-title}{'hat b} and \xrdef does a \csname...\endcsname on the first % argument, and \hat is not an expandable control sequence. It could % all be worked out, but why? Either we support ^^ or we don't. % % The other change necessary for this was to define \auxhat: % \def\auxhat{\def^{'hat }}% extra space so ok if followed by letter % and then to call \auxhat in \setq. % \catcode`\^=\other % % Special characters. Should be turned off anyway, but... \catcode`\~=\other \catcode`\[=\other \catcode`\]=\other \catcode`\"=\other \catcode`\_=\other \catcode`\|=\other \catcode`\<=\other \catcode`\>=\other \catcode`\$=\other \catcode`\#=\other \catcode`\&=\other \catcode`\%=\other \catcode`+=\other % avoid \+ for paranoia even though we've turned it off % % This is to support \ in node names and titles, since the \ % characters end up in a \csname. It's easier than % leaving it active and making its active definition an actual \ % character. What I don't understand is why it works in the *value* % of the xrdef. Seems like it should be a catcode12 \, and that % should not typeset properly. But it works, so I'm moving on for % now. --karl, 15jan04. \catcode`\\=\other % % Make the characters 128-255 be printing characters. {% \count1=128 \def\loop{% \catcode\count1=\other \advance\count1 by 1 \ifnum \count1<256 \loop \fi }% }% % % @ is our escape character in .aux files, and we need braces. \catcode`\{=1 \catcode`\}=2 \catcode`\@=0 } \def\readdatafile#1{% \begingroup \setupdatafile \input\jobname.#1 \endgroup} \message{insertions,} % including footnotes. \newcount \footnoteno % The trailing space in the following definition for supereject is % vital for proper filling; pages come out unaligned when you do a % pagealignmacro call if that space before the closing brace is % removed. (Generally, numeric constants should always be followed by a % space to prevent strange expansion errors.) \def\supereject{\par\penalty -20000\footnoteno =0 } % @footnotestyle is meaningful for info output only. \let\footnotestyle=\comment {\catcode `\@=11 % % Auto-number footnotes. Otherwise like plain. \gdef\footnote{% \let\indent=\ptexindent \let\noindent=\ptexnoindent \global\advance\footnoteno by \@ne \edef\thisfootno{$^{\the\footnoteno}$}% % % In case the footnote comes at the end of a sentence, preserve the % extra spacing after we do the footnote number. \let\@sf\empty \ifhmode\edef\@sf{\spacefactor\the\spacefactor}\ptexslash\fi % % Remove inadvertent blank space before typesetting the footnote number. \unskip \thisfootno\@sf \dofootnote }% % Don't bother with the trickery in plain.tex to not require the % footnote text as a parameter. Our footnotes don't need to be so general. % % Oh yes, they do; otherwise, @ifset (and anything else that uses % \parseargline) fails inside footnotes because the tokens are fixed when % the footnote is read. --karl, 16nov96. % \gdef\dofootnote{% \insert\footins\bgroup % We want to typeset this text as a normal paragraph, even if the % footnote reference occurs in (for example) a display environment. % So reset some parameters. \hsize=\pagewidth \interlinepenalty\interfootnotelinepenalty \splittopskip\ht\strutbox % top baseline for broken footnotes \splitmaxdepth\dp\strutbox \floatingpenalty\@MM \leftskip\z@skip \rightskip\z@skip \spaceskip\z@skip \xspaceskip\z@skip \parindent\defaultparindent % \smallfonts \rm % % Because we use hanging indentation in footnotes, a @noindent appears % to exdent this text, so make it be a no-op. makeinfo does not use % hanging indentation so @noindent can still be needed within footnote % text after an @example or the like (not that this is good style). \let\noindent = \relax % % Hang the footnote text off the number. Use \everypar in case the % footnote extends for more than one paragraph. \everypar = {\hang}% \textindent{\thisfootno}% % % Don't crash into the line above the footnote text. Since this % expands into a box, it must come within the paragraph, lest it % provide a place where TeX can split the footnote. \footstrut \futurelet\next\fo@t } }%end \catcode `\@=11 % In case a @footnote appears in a vbox, save the footnote text and create % the real \insert just after the vbox finished. Otherwise, the insertion % would be lost. % Similarily, if a @footnote appears inside an alignment, save the footnote % text to a box and make the \insert when a row of the table is finished. % And the same can be done for other insert classes. --kasal, 16nov03. % Replace the \insert primitive by a cheating macro. % Deeper inside, just make sure that the saved insertions are not spilled % out prematurely. % \def\startsavinginserts{% \ifx \insert\ptexinsert \let\insert\saveinsert \else \let\checkinserts\relax \fi } % This \insert replacement works for both \insert\footins{foo} and % \insert\footins\bgroup foo\egroup, but it doesn't work for \insert27{foo}. % \def\saveinsert#1{% \edef\next{\noexpand\savetobox \makeSAVEname#1}% \afterassignment\next % swallow the left brace \let\temp = } \def\makeSAVEname#1{\makecsname{SAVE\expandafter\gobble\string#1}} \def\savetobox#1{\global\setbox#1 = \vbox\bgroup \unvbox#1} \def\checksaveins#1{\ifvoid#1\else \placesaveins#1\fi} \def\placesaveins#1{% \ptexinsert \csname\expandafter\gobblesave\string#1\endcsname {\box#1}% } % eat @SAVE -- beware, all of them have catcode \other: { \def\dospecials{\do S\do A\do V\do E} \uncatcodespecials % ;-) \gdef\gobblesave @SAVE{} } % initialization: \def\newsaveins #1{% \edef\next{\noexpand\newsaveinsX \makeSAVEname#1}% \next } \def\newsaveinsX #1{% \csname newbox\endcsname #1% \expandafter\def\expandafter\checkinserts\expandafter{\checkinserts \checksaveins #1}% } % initialize: \let\checkinserts\empty \newsaveins\footins \newsaveins\margin % @image. We use the macros from epsf.tex to support this. % If epsf.tex is not installed and @image is used, we complain. % % Check for and read epsf.tex up front. If we read it only at @image % time, we might be inside a group, and then its definitions would get % undone and the next image would fail. \openin 1 = epsf.tex \ifeof 1 \else % Do not bother showing banner with epsf.tex v2.7k (available in % doc/epsf.tex and on ctan). \def\epsfannounce{\toks0 = }% \input epsf.tex \fi \closein 1 % % We will only complain once about lack of epsf.tex. \newif\ifwarnednoepsf \newhelp\noepsfhelp{epsf.tex must be installed for images to work. It is also included in the Texinfo distribution, or you can get it from ftp://tug.org/tex/epsf.tex.} % \def\image#1{% \ifx\epsfbox\undefined \ifwarnednoepsf \else \errhelp = \noepsfhelp \errmessage{epsf.tex not found, images will be ignored}% \global\warnednoepsftrue \fi \else \imagexxx #1,,,,,\finish \fi } % % Arguments to @image: % #1 is (mandatory) image filename; we tack on .eps extension. % #2 is (optional) width, #3 is (optional) height. % #4 is (ignored optional) html alt text. % #5 is (ignored optional) extension. % #6 is just the usual extra ignored arg for parsing this stuff. \newif\ifimagevmode \def\imagexxx#1,#2,#3,#4,#5,#6\finish{\begingroup \catcode`\^^M = 5 % in case we're inside an example \normalturnoffactive % allow _ et al. in names % If the image is by itself, center it. \ifvmode \imagevmodetrue \nobreak\bigskip % Usually we'll have text after the image which will insert % \parskip glue, so insert it here too to equalize the space % above and below. \nobreak\vskip\parskip \nobreak \line\bgroup \fi % % Output the image. \ifpdf \dopdfimage{#1}{#2}{#3}% \else % \epsfbox itself resets \epsf?size at each figure. \setbox0 = \hbox{\ignorespaces #2}\ifdim\wd0 > 0pt \epsfxsize=#2\relax \fi \setbox0 = \hbox{\ignorespaces #3}\ifdim\wd0 > 0pt \epsfysize=#3\relax \fi \epsfbox{#1.eps}% \fi % \ifimagevmode \egroup \bigbreak \fi % space after the image \endgroup} % @float FLOATTYPE,LABEL,LOC ... @end float for displayed figures, tables, % etc. We don't actually implement floating yet, we always include the % float "here". But it seemed the best name for the future. % \envparseargdef\float{\eatcommaspace\eatcommaspace\dofloat#1, , ,\finish} % There may be a space before second and/or third parameter; delete it. \def\eatcommaspace#1, {#1,} % #1 is the optional FLOATTYPE, the text label for this float, typically % "Figure", "Table", "Example", etc. Can't contain commas. If omitted, % this float will not be numbered and cannot be referred to. % % #2 is the optional xref label. Also must be present for the float to % be referable. % % #3 is the optional positioning argument; for now, it is ignored. It % will somehow specify the positions allowed to float to (here, top, bottom). % % We keep a separate counter for each FLOATTYPE, which we reset at each % chapter-level command. \let\resetallfloatnos=\empty % \def\dofloat#1,#2,#3,#4\finish{% \let\thiscaption=\empty \let\thisshortcaption=\empty % % don't lose footnotes inside @float. % % BEWARE: when the floats start float, we have to issue warning whenever an % insert appears inside a float which could possibly float. --kasal, 26may04 % \startsavinginserts % % We can't be used inside a paragraph. \par % \vtop\bgroup \def\floattype{#1}% \def\floatlabel{#2}% \def\floatloc{#3}% we do nothing with this yet. % \ifx\floattype\empty \let\safefloattype=\empty \else {% % the floattype might have accents or other special characters, % but we need to use it in a control sequence name. \indexnofonts \turnoffactive \xdef\safefloattype{\floattype}% }% \fi % % If label is given but no type, we handle that as the empty type. \ifx\floatlabel\empty \else % We want each FLOATTYPE to be numbered separately (Figure 1, % Table 1, Figure 2, ...). (And if no label, no number.) % \expandafter\getfloatno\csname\safefloattype floatno\endcsname \global\advance\floatno by 1 % {% % This magic value for \lastsection is output by \setref as the % XREFLABEL-title value. \xrefX uses it to distinguish float % labels (which have a completely different output format) from % node and anchor labels. And \xrdef uses it to construct the % lists of floats. % \edef\lastsection{\floatmagic=\safefloattype}% \setref{\floatlabel}{Yfloat}% }% \fi % % start with \parskip glue, I guess. \vskip\parskip % % Don't suppress indentation if a float happens to start a section. \restorefirstparagraphindent } % we have these possibilities: % @float Foo,lbl & @caption{Cap}: Foo 1.1: Cap % @float Foo,lbl & no caption: Foo 1.1 % @float Foo & @caption{Cap}: Foo: Cap % @float Foo & no caption: Foo % @float ,lbl & Caption{Cap}: 1.1: Cap % @float ,lbl & no caption: 1.1 % @float & @caption{Cap}: Cap % @float & no caption: % \def\Efloat{% \let\floatident = \empty % % In all cases, if we have a float type, it comes first. \ifx\floattype\empty \else \def\floatident{\floattype}\fi % % If we have an xref label, the number comes next. \ifx\floatlabel\empty \else \ifx\floattype\empty \else % if also had float type, need tie first. \appendtomacro\floatident{\tie}% \fi % the number. \appendtomacro\floatident{\chaplevelprefix\the\floatno}% \fi % % Start the printed caption with what we've constructed in % \floatident, but keep it separate; we need \floatident again. \let\captionline = \floatident % \ifx\thiscaption\empty \else \ifx\floatident\empty \else \appendtomacro\captionline{: }% had ident, so need a colon between \fi % % caption text. \appendtomacro\captionline{\scanexp\thiscaption}% \fi % % If we have anything to print, print it, with space before. % Eventually this needs to become an \insert. \ifx\captionline\empty \else \vskip.5\parskip \captionline % % Space below caption. \vskip\parskip \fi % % If have an xref label, write the list of floats info. Do this % after the caption, to avoid chance of it being a breakpoint. \ifx\floatlabel\empty \else % Write the text that goes in the lof to the aux file as % \floatlabel-lof. Besides \floatident, we include the short % caption if specified, else the full caption if specified, else nothing. {% \atdummies % % since we read the caption text in the macro world, where ^^M % is turned into a normal character, we have to scan it back, so % we don't write the literal three characters "^^M" into the aux file. \scanexp{% \xdef\noexpand\gtemp{% \ifx\thisshortcaption\empty \thiscaption \else \thisshortcaption \fi }% }% \immediate\write\auxfile{@xrdef{\floatlabel-lof}{\floatident \ifx\gtemp\empty \else : \gtemp \fi}}% }% \fi \egroup % end of \vtop % % place the captured inserts % % BEWARE: when the floats start floating, we have to issue warning % whenever an insert appears inside a float which could possibly % float. --kasal, 26may04 % \checkinserts } % Append the tokens #2 to the definition of macro #1, not expanding either. % \def\appendtomacro#1#2{% \expandafter\def\expandafter#1\expandafter{#1#2}% } % @caption, @shortcaption % \def\caption{\docaption\thiscaption} \def\shortcaption{\docaption\thisshortcaption} \def\docaption{\checkenv\float \bgroup\scanargctxt\defcaption} \def\defcaption#1#2{\egroup \def#1{#2}} % The parameter is the control sequence identifying the counter we are % going to use. Create it if it doesn't exist and assign it to \floatno. \def\getfloatno#1{% \ifx#1\relax % Haven't seen this figure type before. \csname newcount\endcsname #1% % % Remember to reset this floatno at the next chap. \expandafter\gdef\expandafter\resetallfloatnos \expandafter{\resetallfloatnos #1=0 }% \fi \let\floatno#1% } % \setref calls this to get the XREFLABEL-snt value. We want an @xref % to the FLOATLABEL to expand to "Figure 3.1". We call \setref when we % first read the @float command. % \def\Yfloat{\floattype@tie \chaplevelprefix\the\floatno}% % Magic string used for the XREFLABEL-title value, so \xrefX can % distinguish floats from other xref types. \def\floatmagic{!!float!!} % #1 is the control sequence we are passed; we expand into a conditional % which is true if #1 represents a float ref. That is, the magic % \lastsection value which we \setref above. % \def\iffloat#1{\expandafter\doiffloat#1==\finish} % % #1 is (maybe) the \floatmagic string. If so, #2 will be the % (safe) float type for this float. We set \iffloattype to #2. % \def\doiffloat#1=#2=#3\finish{% \def\temp{#1}% \def\iffloattype{#2}% \ifx\temp\floatmagic } % @listoffloats FLOATTYPE - print a list of floats like a table of contents. % \parseargdef\listoffloats{% \def\floattype{#1}% floattype {% % the floattype might have accents or other special characters, % but we need to use it in a control sequence name. \indexnofonts \turnoffactive \xdef\safefloattype{\floattype}% }% % % \xrdef saves the floats as a \do-list in \floatlistSAFEFLOATTYPE. \expandafter\ifx\csname floatlist\safefloattype\endcsname \relax \ifhavexrefs % if the user said @listoffloats foo but never @float foo. \message{\linenumber No `\safefloattype' floats to list.}% \fi \else \begingroup \leftskip=\tocindent % indent these entries like a toc \let\do=\listoffloatsdo \csname floatlist\safefloattype\endcsname \endgroup \fi } % This is called on each entry in a list of floats. We're passed the % xref label, in the form LABEL-title, which is how we save it in the % aux file. We strip off the -title and look up \XRLABEL-lof, which % has the text we're supposed to typeset here. % % Figures without xref labels will not be included in the list (since % they won't appear in the aux file). % \def\listoffloatsdo#1{\listoffloatsdoentry#1\finish} \def\listoffloatsdoentry#1-title\finish{{% % Can't fully expand XR#1-lof because it can contain anything. Just % pass the control sequence. On the other hand, XR#1-pg is just the % page number, and we want to fully expand that so we can get a link % in pdf output. \toksA = \expandafter{\csname XR#1-lof\endcsname}% % % use the same \entry macro we use to generate the TOC and index. \edef\writeentry{\noexpand\entry{\the\toksA}{\csname XR#1-pg\endcsname}}% \writeentry }} \message{localization,} % @documentlanguage is usually given very early, just after % @setfilename. If done too late, it may not override everything % properly. Single argument is the language (de) or locale (de_DE) % abbreviation. It would be nice if we could set up a hyphenation file. % { \catcode`\_ = \active \globaldefs=1 \parseargdef\documentlanguage{\begingroup \let_=\normalunderscore % normal _ character for filenames \tex % read txi-??.tex file in plain TeX. % Read the file by the name they passed if it exists. \openin 1 txi-#1.tex \ifeof 1 \documentlanguagetrywithoutunderscore{#1_\finish}% \else \input txi-#1.tex \fi \closein 1 \endgroup \endgroup} } % % If they passed de_DE, and txi-de_DE.tex doesn't exist, % try txi-de.tex. % \def\documentlanguagetrywithoutunderscore#1_#2\finish{% \openin 1 txi-#1.tex \ifeof 1 \errhelp = \nolanghelp \errmessage{Cannot read language file txi-#1.tex}% \else \input txi-#1.tex \fi \closein 1 } % \newhelp\nolanghelp{The given language definition file cannot be found or is empty. Maybe you need to install it? In the current directory should work if nowhere else does.} % Set the catcode of characters 128 through 255 to the specified number. % \def\setnonasciicharscatcode#1{% \count255=128 \loop\ifnum\count255<256 \global\catcode\count255=#1\relax \advance\count255 by 1 \repeat } \def\setnonasciicharscatcodenonglobal#1{% \count255=128 \loop\ifnum\count255<256 \catcode\count255=#1\relax \advance\count255 by 1 \repeat } % @documentencoding sets the definition of non-ASCII characters % according to the specified encoding. % \parseargdef\documentencoding{% % Encoding being declared for the document. \def\declaredencoding{\csname #1.enc\endcsname}% % % Supported encodings: names converted to tokens in order to be able % to compare them with \ifx. \def\ascii{\csname US-ASCII.enc\endcsname}% \def\latnine{\csname ISO-8859-15.enc\endcsname}% \def\latone{\csname ISO-8859-1.enc\endcsname}% \def\lattwo{\csname ISO-8859-2.enc\endcsname}% \def\utfeight{\csname UTF-8.enc\endcsname}% % \ifx \declaredencoding \ascii \asciichardefs % \else \ifx \declaredencoding \lattwo \setnonasciicharscatcode\active \lattwochardefs % \else \ifx \declaredencoding \latone \setnonasciicharscatcode\active \latonechardefs % \else \ifx \declaredencoding \latnine \setnonasciicharscatcode\active \latninechardefs % \else \ifx \declaredencoding \utfeight \setnonasciicharscatcode\active \utfeightchardefs % \else \message{Unknown document encoding #1, ignoring.}% % \fi % utfeight \fi % latnine \fi % latone \fi % lattwo \fi % ascii } % A message to be logged when using a character that isn't available % the default font encoding (OT1). % \def\missingcharmsg#1{\message{Character missing in OT1 encoding: #1.}} % Take account of \c (plain) vs. \, (Texinfo) difference. \def\cedilla#1{\ifx\c\ptexc\c{#1}\else\,{#1}\fi} % First, make active non-ASCII characters in order for them to be % correctly categorized when TeX reads the replacement text of % macros containing the character definitions. \setnonasciicharscatcode\active % % Latin1 (ISO-8859-1) character definitions. \def\latonechardefs{% \gdef^^a0{~} \gdef^^a1{\exclamdown} \gdef^^a2{\missingcharmsg{CENT SIGN}} \gdef^^a3{{\pounds}} \gdef^^a4{\missingcharmsg{CURRENCY SIGN}} \gdef^^a5{\missingcharmsg{YEN SIGN}} \gdef^^a6{\missingcharmsg{BROKEN BAR}} \gdef^^a7{\S} \gdef^^a8{\"{}} \gdef^^a9{\copyright} \gdef^^aa{\ordf} \gdef^^ab{\missingcharmsg{LEFT-POINTING DOUBLE ANGLE QUOTATION MARK}} \gdef^^ac{$\lnot$} \gdef^^ad{\-} \gdef^^ae{\registeredsymbol} \gdef^^af{\={}} % \gdef^^b0{\textdegree} \gdef^^b1{$\pm$} \gdef^^b2{$^2$} \gdef^^b3{$^3$} \gdef^^b4{\'{}} \gdef^^b5{$\mu$} \gdef^^b6{\P} % \gdef^^b7{$^.$} \gdef^^b8{\cedilla\ } \gdef^^b9{$^1$} \gdef^^ba{\ordm} % \gdef^^bb{\missingcharmsg{RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK}} \gdef^^bc{$1\over4$} \gdef^^bd{$1\over2$} \gdef^^be{$3\over4$} \gdef^^bf{\questiondown} % \gdef^^c0{\`A} \gdef^^c1{\'A} \gdef^^c2{\^A} \gdef^^c3{\~A} \gdef^^c4{\"A} \gdef^^c5{\ringaccent A} \gdef^^c6{\AE} \gdef^^c7{\cedilla C} \gdef^^c8{\`E} \gdef^^c9{\'E} \gdef^^ca{\^E} \gdef^^cb{\"E} \gdef^^cc{\`I} \gdef^^cd{\'I} \gdef^^ce{\^I} \gdef^^cf{\"I} % \gdef^^d0{\missingcharmsg{LATIN CAPITAL LETTER ETH}} \gdef^^d1{\~N} \gdef^^d2{\`O} \gdef^^d3{\'O} \gdef^^d4{\^O} \gdef^^d5{\~O} \gdef^^d6{\"O} \gdef^^d7{$\times$} \gdef^^d8{\O} \gdef^^d9{\`U} \gdef^^da{\'U} \gdef^^db{\^U} \gdef^^dc{\"U} \gdef^^dd{\'Y} \gdef^^de{\missingcharmsg{LATIN CAPITAL LETTER THORN}} \gdef^^df{\ss} % \gdef^^e0{\`a} \gdef^^e1{\'a} \gdef^^e2{\^a} \gdef^^e3{\~a} \gdef^^e4{\"a} \gdef^^e5{\ringaccent a} \gdef^^e6{\ae} \gdef^^e7{\cedilla c} \gdef^^e8{\`e} \gdef^^e9{\'e} \gdef^^ea{\^e} \gdef^^eb{\"e} \gdef^^ec{\`{\dotless i}} \gdef^^ed{\'{\dotless i}} \gdef^^ee{\^{\dotless i}} \gdef^^ef{\"{\dotless i}} % \gdef^^f0{\missingcharmsg{LATIN SMALL LETTER ETH}} \gdef^^f1{\~n} \gdef^^f2{\`o} \gdef^^f3{\'o} \gdef^^f4{\^o} \gdef^^f5{\~o} \gdef^^f6{\"o} \gdef^^f7{$\div$} \gdef^^f8{\o} \gdef^^f9{\`u} \gdef^^fa{\'u} \gdef^^fb{\^u} \gdef^^fc{\"u} \gdef^^fd{\'y} \gdef^^fe{\missingcharmsg{LATIN SMALL LETTER THORN}} \gdef^^ff{\"y} } % Latin9 (ISO-8859-15) encoding character definitions. \def\latninechardefs{% % Encoding is almost identical to Latin1. \latonechardefs % \gdef^^a4{\euro} \gdef^^a6{\v S} \gdef^^a8{\v s} \gdef^^b4{\v Z} \gdef^^b8{\v z} \gdef^^bc{\OE} \gdef^^bd{\oe} \gdef^^be{\"Y} } % Latin2 (ISO-8859-2) character definitions. \def\lattwochardefs{% \gdef^^a0{~} \gdef^^a1{\missingcharmsg{LATIN CAPITAL LETTER A WITH OGONEK}} \gdef^^a2{\u{}} \gdef^^a3{\L} \gdef^^a4{\missingcharmsg{CURRENCY SIGN}} \gdef^^a5{\v L} \gdef^^a6{\'S} \gdef^^a7{\S} \gdef^^a8{\"{}} \gdef^^a9{\v S} \gdef^^aa{\cedilla S} \gdef^^ab{\v T} \gdef^^ac{\'Z} \gdef^^ad{\-} \gdef^^ae{\v Z} \gdef^^af{\dotaccent Z} % \gdef^^b0{\textdegree} \gdef^^b1{\missingcharmsg{LATIN SMALL LETTER A WITH OGONEK}} \gdef^^b2{\missingcharmsg{OGONEK}} \gdef^^b3{\l} \gdef^^b4{\'{}} \gdef^^b5{\v l} \gdef^^b6{\'s} \gdef^^b7{\v{}} \gdef^^b8{\cedilla\ } \gdef^^b9{\v s} \gdef^^ba{\cedilla s} \gdef^^bb{\v t} \gdef^^bc{\'z} \gdef^^bd{\H{}} \gdef^^be{\v z} \gdef^^bf{\dotaccent z} % \gdef^^c0{\'R} \gdef^^c1{\'A} \gdef^^c2{\^A} \gdef^^c3{\u A} \gdef^^c4{\"A} \gdef^^c5{\'L} \gdef^^c6{\'C} \gdef^^c7{\cedilla C} \gdef^^c8{\v C} \gdef^^c9{\'E} \gdef^^ca{\missingcharmsg{LATIN CAPITAL LETTER E WITH OGONEK}} \gdef^^cb{\"E} \gdef^^cc{\v E} \gdef^^cd{\'I} \gdef^^ce{\^I} \gdef^^cf{\v D} % \gdef^^d0{\missingcharmsg{LATIN CAPITAL LETTER D WITH STROKE}} \gdef^^d1{\'N} \gdef^^d2{\v N} \gdef^^d3{\'O} \gdef^^d4{\^O} \gdef^^d5{\H O} \gdef^^d6{\"O} \gdef^^d7{$\times$} \gdef^^d8{\v R} \gdef^^d9{\ringaccent U} \gdef^^da{\'U} \gdef^^db{\H U} \gdef^^dc{\"U} \gdef^^dd{\'Y} \gdef^^de{\cedilla T} \gdef^^df{\ss} % \gdef^^e0{\'r} \gdef^^e1{\'a} \gdef^^e2{\^a} \gdef^^e3{\u a} \gdef^^e4{\"a} \gdef^^e5{\'l} \gdef^^e6{\'c} \gdef^^e7{\cedilla c} \gdef^^e8{\v c} \gdef^^e9{\'e} \gdef^^ea{\missingcharmsg{LATIN SMALL LETTER E WITH OGONEK}} \gdef^^eb{\"e} \gdef^^ec{\v e} \gdef^^ed{\'\i} \gdef^^ee{\^\i} \gdef^^ef{\v d} % \gdef^^f0{\missingcharmsg{LATIN SMALL LETTER D WITH STROKE}} \gdef^^f1{\'n} \gdef^^f2{\v n} \gdef^^f3{\'o} \gdef^^f4{\^o} \gdef^^f5{\H o} \gdef^^f6{\"o} \gdef^^f7{$\div$} \gdef^^f8{\v r} \gdef^^f9{\ringaccent u} \gdef^^fa{\'u} \gdef^^fb{\H u} \gdef^^fc{\"u} \gdef^^fd{\'y} \gdef^^fe{\cedilla t} \gdef^^ff{\dotaccent{}} } % UTF-8 character definitions. % % This code to support UTF-8 is based on LaTeX's utf8.def, with some % changes for Texinfo conventions. It is included here under the GPL by % permission from Frank Mittelbach and the LaTeX team. % \newcount\countUTFx \newcount\countUTFy \newcount\countUTFz \gdef\UTFviiiTwoOctets#1#2{\expandafter \UTFviiiDefined\csname u8:#1\string #2\endcsname} % \gdef\UTFviiiThreeOctets#1#2#3{\expandafter \UTFviiiDefined\csname u8:#1\string #2\string #3\endcsname} % \gdef\UTFviiiFourOctets#1#2#3#4{\expandafter \UTFviiiDefined\csname u8:#1\string #2\string #3\string #4\endcsname} \gdef\UTFviiiDefined#1{% \ifx #1\relax \message{\linenumber Unicode char \string #1 not defined for Texinfo}% \else \expandafter #1% \fi } \begingroup \catcode`\~13 \catcode`\"12 \def\UTFviiiLoop{% \global\catcode\countUTFx\active \uccode`\~\countUTFx \uppercase\expandafter{\UTFviiiTmp}% \advance\countUTFx by 1 \ifnum\countUTFx < \countUTFy \expandafter\UTFviiiLoop \fi} \countUTFx = "C2 \countUTFy = "E0 \def\UTFviiiTmp{% \xdef~{\noexpand\UTFviiiTwoOctets\string~}} \UTFviiiLoop \countUTFx = "E0 \countUTFy = "F0 \def\UTFviiiTmp{% \xdef~{\noexpand\UTFviiiThreeOctets\string~}} \UTFviiiLoop \countUTFx = "F0 \countUTFy = "F4 \def\UTFviiiTmp{% \xdef~{\noexpand\UTFviiiFourOctets\string~}} \UTFviiiLoop \endgroup \begingroup \catcode`\"=12 \catcode`\<=12 \catcode`\.=12 \catcode`\,=12 \catcode`\;=12 \catcode`\!=12 \catcode`\~=13 \gdef\DeclareUnicodeCharacter#1#2{% \countUTFz = "#1\relax \wlog{\space\space defining Unicode char U+#1 (decimal \the\countUTFz)}% \begingroup \parseXMLCharref \def\UTFviiiTwoOctets##1##2{% \csname u8:##1\string ##2\endcsname}% \def\UTFviiiThreeOctets##1##2##3{% \csname u8:##1\string ##2\string ##3\endcsname}% \def\UTFviiiFourOctets##1##2##3##4{% \csname u8:##1\string ##2\string ##3\string ##4\endcsname}% \expandafter\expandafter\expandafter\expandafter \expandafter\expandafter\expandafter \gdef\UTFviiiTmp{#2}% \endgroup} \gdef\parseXMLCharref{% \ifnum\countUTFz < "A0\relax \errhelp = \EMsimple \errmessage{Cannot define Unicode char value < 00A0}% \else\ifnum\countUTFz < "800\relax \parseUTFviiiA,% \parseUTFviiiB C\UTFviiiTwoOctets.,% \else\ifnum\countUTFz < "10000\relax \parseUTFviiiA;% \parseUTFviiiA,% \parseUTFviiiB E\UTFviiiThreeOctets.{,;}% \else \parseUTFviiiA;% \parseUTFviiiA,% \parseUTFviiiA!% \parseUTFviiiB F\UTFviiiFourOctets.{!,;}% \fi\fi\fi } \gdef\parseUTFviiiA#1{% \countUTFx = \countUTFz \divide\countUTFz by 64 \countUTFy = \countUTFz \multiply\countUTFz by 64 \advance\countUTFx by -\countUTFz \advance\countUTFx by 128 \uccode `#1\countUTFx \countUTFz = \countUTFy} \gdef\parseUTFviiiB#1#2#3#4{% \advance\countUTFz by "#10\relax \uccode `#3\countUTFz \uppercase{\gdef\UTFviiiTmp{#2#3#4}}} \endgroup \def\utfeightchardefs{% \DeclareUnicodeCharacter{00A0}{\tie} \DeclareUnicodeCharacter{00A1}{\exclamdown} \DeclareUnicodeCharacter{00A3}{\pounds} \DeclareUnicodeCharacter{00A8}{\"{ }} \DeclareUnicodeCharacter{00A9}{\copyright} \DeclareUnicodeCharacter{00AA}{\ordf} \DeclareUnicodeCharacter{00AB}{\guillemetleft} \DeclareUnicodeCharacter{00AD}{\-} \DeclareUnicodeCharacter{00AE}{\registeredsymbol} \DeclareUnicodeCharacter{00AF}{\={ }} \DeclareUnicodeCharacter{00B0}{\ringaccent{ }} \DeclareUnicodeCharacter{00B4}{\'{ }} \DeclareUnicodeCharacter{00B8}{\cedilla{ }} \DeclareUnicodeCharacter{00BA}{\ordm} \DeclareUnicodeCharacter{00BB}{\guillemetright} \DeclareUnicodeCharacter{00BF}{\questiondown} \DeclareUnicodeCharacter{00C0}{\`A} \DeclareUnicodeCharacter{00C1}{\'A} \DeclareUnicodeCharacter{00C2}{\^A} \DeclareUnicodeCharacter{00C3}{\~A} \DeclareUnicodeCharacter{00C4}{\"A} \DeclareUnicodeCharacter{00C5}{\AA} \DeclareUnicodeCharacter{00C6}{\AE} \DeclareUnicodeCharacter{00C7}{\cedilla{C}} \DeclareUnicodeCharacter{00C8}{\`E} \DeclareUnicodeCharacter{00C9}{\'E} \DeclareUnicodeCharacter{00CA}{\^E} \DeclareUnicodeCharacter{00CB}{\"E} \DeclareUnicodeCharacter{00CC}{\`I} \DeclareUnicodeCharacter{00CD}{\'I} \DeclareUnicodeCharacter{00CE}{\^I} \DeclareUnicodeCharacter{00CF}{\"I} \DeclareUnicodeCharacter{00D1}{\~N} \DeclareUnicodeCharacter{00D2}{\`O} \DeclareUnicodeCharacter{00D3}{\'O} \DeclareUnicodeCharacter{00D4}{\^O} \DeclareUnicodeCharacter{00D5}{\~O} \DeclareUnicodeCharacter{00D6}{\"O} \DeclareUnicodeCharacter{00D8}{\O} \DeclareUnicodeCharacter{00D9}{\`U} \DeclareUnicodeCharacter{00DA}{\'U} \DeclareUnicodeCharacter{00DB}{\^U} \DeclareUnicodeCharacter{00DC}{\"U} \DeclareUnicodeCharacter{00DD}{\'Y} \DeclareUnicodeCharacter{00DF}{\ss} \DeclareUnicodeCharacter{00E0}{\`a} \DeclareUnicodeCharacter{00E1}{\'a} \DeclareUnicodeCharacter{00E2}{\^a} \DeclareUnicodeCharacter{00E3}{\~a} \DeclareUnicodeCharacter{00E4}{\"a} \DeclareUnicodeCharacter{00E5}{\aa} \DeclareUnicodeCharacter{00E6}{\ae} \DeclareUnicodeCharacter{00E7}{\cedilla{c}} \DeclareUnicodeCharacter{00E8}{\`e} \DeclareUnicodeCharacter{00E9}{\'e} \DeclareUnicodeCharacter{00EA}{\^e} \DeclareUnicodeCharacter{00EB}{\"e} \DeclareUnicodeCharacter{00EC}{\`{\dotless{i}}} \DeclareUnicodeCharacter{00ED}{\'{\dotless{i}}} \DeclareUnicodeCharacter{00EE}{\^{\dotless{i}}} \DeclareUnicodeCharacter{00EF}{\"{\dotless{i}}} \DeclareUnicodeCharacter{00F1}{\~n} \DeclareUnicodeCharacter{00F2}{\`o} \DeclareUnicodeCharacter{00F3}{\'o} \DeclareUnicodeCharacter{00F4}{\^o} \DeclareUnicodeCharacter{00F5}{\~o} \DeclareUnicodeCharacter{00F6}{\"o} \DeclareUnicodeCharacter{00F8}{\o} \DeclareUnicodeCharacter{00F9}{\`u} \DeclareUnicodeCharacter{00FA}{\'u} \DeclareUnicodeCharacter{00FB}{\^u} \DeclareUnicodeCharacter{00FC}{\"u} \DeclareUnicodeCharacter{00FD}{\'y} \DeclareUnicodeCharacter{00FF}{\"y} \DeclareUnicodeCharacter{0100}{\=A} \DeclareUnicodeCharacter{0101}{\=a} \DeclareUnicodeCharacter{0102}{\u{A}} \DeclareUnicodeCharacter{0103}{\u{a}} \DeclareUnicodeCharacter{0106}{\'C} \DeclareUnicodeCharacter{0107}{\'c} \DeclareUnicodeCharacter{0108}{\^C} \DeclareUnicodeCharacter{0109}{\^c} \DeclareUnicodeCharacter{010A}{\dotaccent{C}} \DeclareUnicodeCharacter{010B}{\dotaccent{c}} \DeclareUnicodeCharacter{010C}{\v{C}} \DeclareUnicodeCharacter{010D}{\v{c}} \DeclareUnicodeCharacter{010E}{\v{D}} \DeclareUnicodeCharacter{0112}{\=E} \DeclareUnicodeCharacter{0113}{\=e} \DeclareUnicodeCharacter{0114}{\u{E}} \DeclareUnicodeCharacter{0115}{\u{e}} \DeclareUnicodeCharacter{0116}{\dotaccent{E}} \DeclareUnicodeCharacter{0117}{\dotaccent{e}} \DeclareUnicodeCharacter{011A}{\v{E}} \DeclareUnicodeCharacter{011B}{\v{e}} \DeclareUnicodeCharacter{011C}{\^G} \DeclareUnicodeCharacter{011D}{\^g} \DeclareUnicodeCharacter{011E}{\u{G}} \DeclareUnicodeCharacter{011F}{\u{g}} \DeclareUnicodeCharacter{0120}{\dotaccent{G}} \DeclareUnicodeCharacter{0121}{\dotaccent{g}} \DeclareUnicodeCharacter{0124}{\^H} \DeclareUnicodeCharacter{0125}{\^h} \DeclareUnicodeCharacter{0128}{\~I} \DeclareUnicodeCharacter{0129}{\~{\dotless{i}}} \DeclareUnicodeCharacter{012A}{\=I} \DeclareUnicodeCharacter{012B}{\={\dotless{i}}} \DeclareUnicodeCharacter{012C}{\u{I}} \DeclareUnicodeCharacter{012D}{\u{\dotless{i}}} \DeclareUnicodeCharacter{0130}{\dotaccent{I}} \DeclareUnicodeCharacter{0131}{\dotless{i}} \DeclareUnicodeCharacter{0132}{IJ} \DeclareUnicodeCharacter{0133}{ij} \DeclareUnicodeCharacter{0134}{\^J} \DeclareUnicodeCharacter{0135}{\^{\dotless{j}}} \DeclareUnicodeCharacter{0139}{\'L} \DeclareUnicodeCharacter{013A}{\'l} \DeclareUnicodeCharacter{0141}{\L} \DeclareUnicodeCharacter{0142}{\l} \DeclareUnicodeCharacter{0143}{\'N} \DeclareUnicodeCharacter{0144}{\'n} \DeclareUnicodeCharacter{0147}{\v{N}} \DeclareUnicodeCharacter{0148}{\v{n}} \DeclareUnicodeCharacter{014C}{\=O} \DeclareUnicodeCharacter{014D}{\=o} \DeclareUnicodeCharacter{014E}{\u{O}} \DeclareUnicodeCharacter{014F}{\u{o}} \DeclareUnicodeCharacter{0150}{\H{O}} \DeclareUnicodeCharacter{0151}{\H{o}} \DeclareUnicodeCharacter{0152}{\OE} \DeclareUnicodeCharacter{0153}{\oe} \DeclareUnicodeCharacter{0154}{\'R} \DeclareUnicodeCharacter{0155}{\'r} \DeclareUnicodeCharacter{0158}{\v{R}} \DeclareUnicodeCharacter{0159}{\v{r}} \DeclareUnicodeCharacter{015A}{\'S} \DeclareUnicodeCharacter{015B}{\'s} \DeclareUnicodeCharacter{015C}{\^S} \DeclareUnicodeCharacter{015D}{\^s} \DeclareUnicodeCharacter{015E}{\cedilla{S}} \DeclareUnicodeCharacter{015F}{\cedilla{s}} \DeclareUnicodeCharacter{0160}{\v{S}} \DeclareUnicodeCharacter{0161}{\v{s}} \DeclareUnicodeCharacter{0162}{\cedilla{t}} \DeclareUnicodeCharacter{0163}{\cedilla{T}} \DeclareUnicodeCharacter{0164}{\v{T}} \DeclareUnicodeCharacter{0168}{\~U} \DeclareUnicodeCharacter{0169}{\~u} \DeclareUnicodeCharacter{016A}{\=U} \DeclareUnicodeCharacter{016B}{\=u} \DeclareUnicodeCharacter{016C}{\u{U}} \DeclareUnicodeCharacter{016D}{\u{u}} \DeclareUnicodeCharacter{016E}{\ringaccent{U}} \DeclareUnicodeCharacter{016F}{\ringaccent{u}} \DeclareUnicodeCharacter{0170}{\H{U}} \DeclareUnicodeCharacter{0171}{\H{u}} \DeclareUnicodeCharacter{0174}{\^W} \DeclareUnicodeCharacter{0175}{\^w} \DeclareUnicodeCharacter{0176}{\^Y} \DeclareUnicodeCharacter{0177}{\^y} \DeclareUnicodeCharacter{0178}{\"Y} \DeclareUnicodeCharacter{0179}{\'Z} \DeclareUnicodeCharacter{017A}{\'z} \DeclareUnicodeCharacter{017B}{\dotaccent{Z}} \DeclareUnicodeCharacter{017C}{\dotaccent{z}} \DeclareUnicodeCharacter{017D}{\v{Z}} \DeclareUnicodeCharacter{017E}{\v{z}} \DeclareUnicodeCharacter{01C4}{D\v{Z}} \DeclareUnicodeCharacter{01C5}{D\v{z}} \DeclareUnicodeCharacter{01C6}{d\v{z}} \DeclareUnicodeCharacter{01C7}{LJ} \DeclareUnicodeCharacter{01C8}{Lj} \DeclareUnicodeCharacter{01C9}{lj} \DeclareUnicodeCharacter{01CA}{NJ} \DeclareUnicodeCharacter{01CB}{Nj} \DeclareUnicodeCharacter{01CC}{nj} \DeclareUnicodeCharacter{01CD}{\v{A}} \DeclareUnicodeCharacter{01CE}{\v{a}} \DeclareUnicodeCharacter{01CF}{\v{I}} \DeclareUnicodeCharacter{01D0}{\v{\dotless{i}}} \DeclareUnicodeCharacter{01D1}{\v{O}} \DeclareUnicodeCharacter{01D2}{\v{o}} \DeclareUnicodeCharacter{01D3}{\v{U}} \DeclareUnicodeCharacter{01D4}{\v{u}} \DeclareUnicodeCharacter{01E2}{\={\AE}} \DeclareUnicodeCharacter{01E3}{\={\ae}} \DeclareUnicodeCharacter{01E6}{\v{G}} \DeclareUnicodeCharacter{01E7}{\v{g}} \DeclareUnicodeCharacter{01E8}{\v{K}} \DeclareUnicodeCharacter{01E9}{\v{k}} \DeclareUnicodeCharacter{01F0}{\v{\dotless{j}}} \DeclareUnicodeCharacter{01F1}{DZ} \DeclareUnicodeCharacter{01F2}{Dz} \DeclareUnicodeCharacter{01F3}{dz} \DeclareUnicodeCharacter{01F4}{\'G} \DeclareUnicodeCharacter{01F5}{\'g} \DeclareUnicodeCharacter{01F8}{\`N} \DeclareUnicodeCharacter{01F9}{\`n} \DeclareUnicodeCharacter{01FC}{\'{\AE}} \DeclareUnicodeCharacter{01FD}{\'{\ae}} \DeclareUnicodeCharacter{01FE}{\'{\O}} \DeclareUnicodeCharacter{01FF}{\'{\o}} \DeclareUnicodeCharacter{021E}{\v{H}} \DeclareUnicodeCharacter{021F}{\v{h}} \DeclareUnicodeCharacter{0226}{\dotaccent{A}} \DeclareUnicodeCharacter{0227}{\dotaccent{a}} \DeclareUnicodeCharacter{0228}{\cedilla{E}} \DeclareUnicodeCharacter{0229}{\cedilla{e}} \DeclareUnicodeCharacter{022E}{\dotaccent{O}} \DeclareUnicodeCharacter{022F}{\dotaccent{o}} \DeclareUnicodeCharacter{0232}{\=Y} \DeclareUnicodeCharacter{0233}{\=y} \DeclareUnicodeCharacter{0237}{\dotless{j}} \DeclareUnicodeCharacter{1E02}{\dotaccent{B}} \DeclareUnicodeCharacter{1E03}{\dotaccent{b}} \DeclareUnicodeCharacter{1E04}{\udotaccent{B}} \DeclareUnicodeCharacter{1E05}{\udotaccent{b}} \DeclareUnicodeCharacter{1E06}{\ubaraccent{B}} \DeclareUnicodeCharacter{1E07}{\ubaraccent{b}} \DeclareUnicodeCharacter{1E0A}{\dotaccent{D}} \DeclareUnicodeCharacter{1E0B}{\dotaccent{d}} \DeclareUnicodeCharacter{1E0C}{\udotaccent{D}} \DeclareUnicodeCharacter{1E0D}{\udotaccent{d}} \DeclareUnicodeCharacter{1E0E}{\ubaraccent{D}} \DeclareUnicodeCharacter{1E0F}{\ubaraccent{d}} \DeclareUnicodeCharacter{1E1E}{\dotaccent{F}} \DeclareUnicodeCharacter{1E1F}{\dotaccent{f}} \DeclareUnicodeCharacter{1E20}{\=G} \DeclareUnicodeCharacter{1E21}{\=g} \DeclareUnicodeCharacter{1E22}{\dotaccent{H}} \DeclareUnicodeCharacter{1E23}{\dotaccent{h}} \DeclareUnicodeCharacter{1E24}{\udotaccent{H}} \DeclareUnicodeCharacter{1E25}{\udotaccent{h}} \DeclareUnicodeCharacter{1E26}{\"H} \DeclareUnicodeCharacter{1E27}{\"h} \DeclareUnicodeCharacter{1E30}{\'K} \DeclareUnicodeCharacter{1E31}{\'k} \DeclareUnicodeCharacter{1E32}{\udotaccent{K}} \DeclareUnicodeCharacter{1E33}{\udotaccent{k}} \DeclareUnicodeCharacter{1E34}{\ubaraccent{K}} \DeclareUnicodeCharacter{1E35}{\ubaraccent{k}} \DeclareUnicodeCharacter{1E36}{\udotaccent{L}} \DeclareUnicodeCharacter{1E37}{\udotaccent{l}} \DeclareUnicodeCharacter{1E3A}{\ubaraccent{L}} \DeclareUnicodeCharacter{1E3B}{\ubaraccent{l}} \DeclareUnicodeCharacter{1E3E}{\'M} \DeclareUnicodeCharacter{1E3F}{\'m} \DeclareUnicodeCharacter{1E40}{\dotaccent{M}} \DeclareUnicodeCharacter{1E41}{\dotaccent{m}} \DeclareUnicodeCharacter{1E42}{\udotaccent{M}} \DeclareUnicodeCharacter{1E43}{\udotaccent{m}} \DeclareUnicodeCharacter{1E44}{\dotaccent{N}} \DeclareUnicodeCharacter{1E45}{\dotaccent{n}} \DeclareUnicodeCharacter{1E46}{\udotaccent{N}} \DeclareUnicodeCharacter{1E47}{\udotaccent{n}} \DeclareUnicodeCharacter{1E48}{\ubaraccent{N}} \DeclareUnicodeCharacter{1E49}{\ubaraccent{n}} \DeclareUnicodeCharacter{1E54}{\'P} \DeclareUnicodeCharacter{1E55}{\'p} \DeclareUnicodeCharacter{1E56}{\dotaccent{P}} \DeclareUnicodeCharacter{1E57}{\dotaccent{p}} \DeclareUnicodeCharacter{1E58}{\dotaccent{R}} \DeclareUnicodeCharacter{1E59}{\dotaccent{r}} \DeclareUnicodeCharacter{1E5A}{\udotaccent{R}} \DeclareUnicodeCharacter{1E5B}{\udotaccent{r}} \DeclareUnicodeCharacter{1E5E}{\ubaraccent{R}} \DeclareUnicodeCharacter{1E5F}{\ubaraccent{r}} \DeclareUnicodeCharacter{1E60}{\dotaccent{S}} \DeclareUnicodeCharacter{1E61}{\dotaccent{s}} \DeclareUnicodeCharacter{1E62}{\udotaccent{S}} \DeclareUnicodeCharacter{1E63}{\udotaccent{s}} \DeclareUnicodeCharacter{1E6A}{\dotaccent{T}} \DeclareUnicodeCharacter{1E6B}{\dotaccent{t}} \DeclareUnicodeCharacter{1E6C}{\udotaccent{T}} \DeclareUnicodeCharacter{1E6D}{\udotaccent{t}} \DeclareUnicodeCharacter{1E6E}{\ubaraccent{T}} \DeclareUnicodeCharacter{1E6F}{\ubaraccent{t}} \DeclareUnicodeCharacter{1E7C}{\~V} \DeclareUnicodeCharacter{1E7D}{\~v} \DeclareUnicodeCharacter{1E7E}{\udotaccent{V}} \DeclareUnicodeCharacter{1E7F}{\udotaccent{v}} \DeclareUnicodeCharacter{1E80}{\`W} \DeclareUnicodeCharacter{1E81}{\`w} \DeclareUnicodeCharacter{1E82}{\'W} \DeclareUnicodeCharacter{1E83}{\'w} \DeclareUnicodeCharacter{1E84}{\"W} \DeclareUnicodeCharacter{1E85}{\"w} \DeclareUnicodeCharacter{1E86}{\dotaccent{W}} \DeclareUnicodeCharacter{1E87}{\dotaccent{w}} \DeclareUnicodeCharacter{1E88}{\udotaccent{W}} \DeclareUnicodeCharacter{1E89}{\udotaccent{w}} \DeclareUnicodeCharacter{1E8A}{\dotaccent{X}} \DeclareUnicodeCharacter{1E8B}{\dotaccent{x}} \DeclareUnicodeCharacter{1E8C}{\"X} \DeclareUnicodeCharacter{1E8D}{\"x} \DeclareUnicodeCharacter{1E8E}{\dotaccent{Y}} \DeclareUnicodeCharacter{1E8F}{\dotaccent{y}} \DeclareUnicodeCharacter{1E90}{\^Z} \DeclareUnicodeCharacter{1E91}{\^z} \DeclareUnicodeCharacter{1E92}{\udotaccent{Z}} \DeclareUnicodeCharacter{1E93}{\udotaccent{z}} \DeclareUnicodeCharacter{1E94}{\ubaraccent{Z}} \DeclareUnicodeCharacter{1E95}{\ubaraccent{z}} \DeclareUnicodeCharacter{1E96}{\ubaraccent{h}} \DeclareUnicodeCharacter{1E97}{\"t} \DeclareUnicodeCharacter{1E98}{\ringaccent{w}} \DeclareUnicodeCharacter{1E99}{\ringaccent{y}} \DeclareUnicodeCharacter{1EA0}{\udotaccent{A}} \DeclareUnicodeCharacter{1EA1}{\udotaccent{a}} \DeclareUnicodeCharacter{1EB8}{\udotaccent{E}} \DeclareUnicodeCharacter{1EB9}{\udotaccent{e}} \DeclareUnicodeCharacter{1EBC}{\~E} \DeclareUnicodeCharacter{1EBD}{\~e} \DeclareUnicodeCharacter{1ECA}{\udotaccent{I}} \DeclareUnicodeCharacter{1ECB}{\udotaccent{i}} \DeclareUnicodeCharacter{1ECC}{\udotaccent{O}} \DeclareUnicodeCharacter{1ECD}{\udotaccent{o}} \DeclareUnicodeCharacter{1EE4}{\udotaccent{U}} \DeclareUnicodeCharacter{1EE5}{\udotaccent{u}} \DeclareUnicodeCharacter{1EF2}{\`Y} \DeclareUnicodeCharacter{1EF3}{\`y} \DeclareUnicodeCharacter{1EF4}{\udotaccent{Y}} \DeclareUnicodeCharacter{1EF8}{\~Y} \DeclareUnicodeCharacter{1EF9}{\~y} \DeclareUnicodeCharacter{2013}{--} \DeclareUnicodeCharacter{2014}{---} \DeclareUnicodeCharacter{2018}{\quoteleft} \DeclareUnicodeCharacter{2019}{\quoteright} \DeclareUnicodeCharacter{201A}{\quotesinglbase} \DeclareUnicodeCharacter{201C}{\quotedblleft} \DeclareUnicodeCharacter{201D}{\quotedblright} \DeclareUnicodeCharacter{201E}{\quotedblbase} \DeclareUnicodeCharacter{2022}{\bullet} \DeclareUnicodeCharacter{2026}{\dots} \DeclareUnicodeCharacter{2039}{\guilsinglleft} \DeclareUnicodeCharacter{203A}{\guilsinglright} \DeclareUnicodeCharacter{20AC}{\euro} \DeclareUnicodeCharacter{2192}{\expansion} \DeclareUnicodeCharacter{21D2}{\result} \DeclareUnicodeCharacter{2212}{\minus} \DeclareUnicodeCharacter{2217}{\point} \DeclareUnicodeCharacter{2261}{\equiv} }% end of \utfeightchardefs % US-ASCII character definitions. \def\asciichardefs{% nothing need be done \relax } % Make non-ASCII characters printable again for compatibility with % existing Texinfo documents that may use them, even without declaring a % document encoding. % \setnonasciicharscatcode \other \message{formatting,} \newdimen\defaultparindent \defaultparindent = 15pt \chapheadingskip = 15pt plus 4pt minus 2pt \secheadingskip = 12pt plus 3pt minus 2pt \subsecheadingskip = 9pt plus 2pt minus 2pt % Prevent underfull vbox error messages. \vbadness = 10000 % Don't be so finicky about underfull hboxes, either. \hbadness = 2000 % Following George Bush, get rid of widows and orphans. \widowpenalty=10000 \clubpenalty=10000 % Use TeX 3.0's \emergencystretch to help line breaking, but if we're % using an old version of TeX, don't do anything. We want the amount of % stretch added to depend on the line length, hence the dependence on % \hsize. We call this whenever the paper size is set. % \def\setemergencystretch{% \ifx\emergencystretch\thisisundefined % Allow us to assign to \emergencystretch anyway. \def\emergencystretch{\dimen0}% \else \emergencystretch = .15\hsize \fi } % Parameters in order: 1) textheight; 2) textwidth; % 3) voffset; 4) hoffset; 5) binding offset; 6) topskip; % 7) physical page height; 8) physical page width. % % We also call \setleading{\textleading}, so the caller should define % \textleading. The caller should also set \parskip. % \def\internalpagesizes#1#2#3#4#5#6#7#8{% \voffset = #3\relax \topskip = #6\relax \splittopskip = \topskip % \vsize = #1\relax \advance\vsize by \topskip \outervsize = \vsize \advance\outervsize by 2\topandbottommargin \pageheight = \vsize % \hsize = #2\relax \outerhsize = \hsize \advance\outerhsize by 0.5in \pagewidth = \hsize % \normaloffset = #4\relax \bindingoffset = #5\relax % \ifpdf \pdfpageheight #7\relax \pdfpagewidth #8\relax % if we don't reset these, they will remain at "1 true in" of % whatever layout pdftex was dumped with. \pdfhorigin = 1 true in \pdfvorigin = 1 true in \fi % \setleading{\textleading} % \parindent = \defaultparindent \setemergencystretch } % @letterpaper (the default). \def\letterpaper{{\globaldefs = 1 \parskip = 3pt plus 2pt minus 1pt \textleading = 13.2pt % % If page is nothing but text, make it come out even. \internalpagesizes{607.2pt}{6in}% that's 46 lines {\voffset}{.25in}% {\bindingoffset}{36pt}% {11in}{8.5in}% }} % Use @smallbook to reset parameters for 7x9.25 trim size. \def\smallbook{{\globaldefs = 1 \parskip = 2pt plus 1pt \textleading = 12pt % \internalpagesizes{7.5in}{5in}% {-.2in}{0in}% {\bindingoffset}{16pt}% {9.25in}{7in}% % \lispnarrowing = 0.3in \tolerance = 700 \hfuzz = 1pt \contentsrightmargin = 0pt \defbodyindent = .5cm }} % Use @smallerbook to reset parameters for 6x9 trim size. % (Just testing, parameters still in flux.) \def\smallerbook{{\globaldefs = 1 \parskip = 1.5pt plus 1pt \textleading = 12pt % \internalpagesizes{7.4in}{4.8in}% {-.2in}{-.4in}% {0pt}{14pt}% {9in}{6in}% % \lispnarrowing = 0.25in \tolerance = 700 \hfuzz = 1pt \contentsrightmargin = 0pt \defbodyindent = .4cm }} % Use @afourpaper to print on European A4 paper. \def\afourpaper{{\globaldefs = 1 \parskip = 3pt plus 2pt minus 1pt \textleading = 13.2pt % % Double-side printing via postscript on Laserjet 4050 % prints double-sided nicely when \bindingoffset=10mm and \hoffset=-6mm. % To change the settings for a different printer or situation, adjust % \normaloffset until the front-side and back-side texts align. Then % do the same for \bindingoffset. You can set these for testing in % your texinfo source file like this: % @tex % \global\normaloffset = -6mm % \global\bindingoffset = 10mm % @end tex \internalpagesizes{673.2pt}{160mm}% that's 51 lines {\voffset}{\hoffset}% {\bindingoffset}{44pt}% {297mm}{210mm}% % \tolerance = 700 \hfuzz = 1pt \contentsrightmargin = 0pt \defbodyindent = 5mm }} % Use @afivepaper to print on European A5 paper. % From romildo@urano.iceb.ufop.br, 2 July 2000. % He also recommends making @example and @lisp be small. \def\afivepaper{{\globaldefs = 1 \parskip = 2pt plus 1pt minus 0.1pt \textleading = 12.5pt % \internalpagesizes{160mm}{120mm}% {\voffset}{\hoffset}% {\bindingoffset}{8pt}% {210mm}{148mm}% % \lispnarrowing = 0.2in \tolerance = 800 \hfuzz = 1.2pt \contentsrightmargin = 0pt \defbodyindent = 2mm \tableindent = 12mm }} % A specific text layout, 24x15cm overall, intended for A4 paper. \def\afourlatex{{\globaldefs = 1 \afourpaper \internalpagesizes{237mm}{150mm}% {\voffset}{4.6mm}% {\bindingoffset}{7mm}% {297mm}{210mm}% % % Must explicitly reset to 0 because we call \afourpaper. \globaldefs = 0 }} % Use @afourwide to print on A4 paper in landscape format. \def\afourwide{{\globaldefs = 1 \afourpaper \internalpagesizes{241mm}{165mm}% {\voffset}{-2.95mm}% {\bindingoffset}{7mm}% {297mm}{210mm}% \globaldefs = 0 }} % @pagesizes TEXTHEIGHT[,TEXTWIDTH] % Perhaps we should allow setting the margins, \topskip, \parskip, % and/or leading, also. Or perhaps we should compute them somehow. % \parseargdef\pagesizes{\pagesizesyyy #1,,\finish} \def\pagesizesyyy#1,#2,#3\finish{{% \setbox0 = \hbox{\ignorespaces #2}\ifdim\wd0 > 0pt \hsize=#2\relax \fi \globaldefs = 1 % \parskip = 3pt plus 2pt minus 1pt \setleading{\textleading}% % \dimen0 = #1\relax \advance\dimen0 by \voffset % \dimen2 = \hsize \advance\dimen2 by \normaloffset % \internalpagesizes{#1}{\hsize}% {\voffset}{\normaloffset}% {\bindingoffset}{44pt}% {\dimen0}{\dimen2}% }} % Set default to letter. % \letterpaper \message{and turning on texinfo input format.} % Define macros to output various characters with catcode for normal text. \catcode`\"=\other \catcode`\~=\other \catcode`\^=\other \catcode`\_=\other \catcode`\|=\other \catcode`\<=\other \catcode`\>=\other \catcode`\+=\other \catcode`\$=\other \def\normaldoublequote{"} \def\normaltilde{~} \def\normalcaret{^} \def\normalunderscore{_} \def\normalverticalbar{|} \def\normalless{<} \def\normalgreater{>} \def\normalplus{+} \def\normaldollar{$}%$ font-lock fix % This macro is used to make a character print one way in \tt % (where it can probably be output as-is), and another way in other fonts, % where something hairier probably needs to be done. % % #1 is what to print if we are indeed using \tt; #2 is what to print % otherwise. Since all the Computer Modern typewriter fonts have zero % interword stretch (and shrink), and it is reasonable to expect all % typewriter fonts to have this, we can check that font parameter. % \def\ifusingtt#1#2{\ifdim \fontdimen3\font=0pt #1\else #2\fi} % Same as above, but check for italic font. Actually this also catches % non-italic slanted fonts since it is impossible to distinguish them from % italic fonts. But since this is only used by $ and it uses \sl anyway % this is not a problem. \def\ifusingit#1#2{\ifdim \fontdimen1\font>0pt #1\else #2\fi} % Turn off all special characters except @ % (and those which the user can use as if they were ordinary). % Most of these we simply print from the \tt font, but for some, we can % use math or other variants that look better in normal text. \catcode`\"=\active \def\activedoublequote{{\tt\char34}} \let"=\activedoublequote \catcode`\~=\active \def~{{\tt\char126}} \chardef\hat=`\^ \catcode`\^=\active \def^{{\tt \hat}} \catcode`\_=\active \def_{\ifusingtt\normalunderscore\_} \let\realunder=_ % Subroutine for the previous macro. \def\_{\leavevmode \kern.07em \vbox{\hrule width.3em height.1ex}\kern .07em } \catcode`\|=\active \def|{{\tt\char124}} \chardef \less=`\< \catcode`\<=\active \def<{{\tt \less}} \chardef \gtr=`\> \catcode`\>=\active \def>{{\tt \gtr}} \catcode`\+=\active \def+{{\tt \char 43}} \catcode`\$=\active \def${\ifusingit{{\sl\$}}\normaldollar}%$ font-lock fix % If a .fmt file is being used, characters that might appear in a file % name cannot be active until we have parsed the command line. % So turn them off again, and have \everyjob (or @setfilename) turn them on. % \otherifyactive is called near the end of this file. \def\otherifyactive{\catcode`+=\other \catcode`\_=\other} % Used sometimes to turn off (effectively) the active characters even after % parsing them. \def\turnoffactive{% \normalturnoffactive \otherbackslash } \catcode`\@=0 % \backslashcurfont outputs one backslash character in current font, % as in \char`\\. \global\chardef\backslashcurfont=`\\ \global\let\rawbackslashxx=\backslashcurfont % let existing .??s files work % \realbackslash is an actual character `\' with catcode other, and % \doublebackslash is two of them (for the pdf outlines). {\catcode`\\=\other @gdef@realbackslash{\} @gdef@doublebackslash{\\}} % In texinfo, backslash is an active character; it prints the backslash % in fixed width font. \catcode`\\=\active @def@normalbackslash{{@tt@backslashcurfont}} % On startup, @fixbackslash assigns: % @let \ = @normalbackslash % \rawbackslash defines an active \ to do \backslashcurfont. % \otherbackslash defines an active \ to be a literal `\' character with % catcode other. @gdef@rawbackslash{@let\=@backslashcurfont} @gdef@otherbackslash{@let\=@realbackslash} % Same as @turnoffactive except outputs \ as {\tt\char`\\} instead of % the literal character `\'. % @def@normalturnoffactive{% @let\=@normalbackslash @let"=@normaldoublequote @let~=@normaltilde @let^=@normalcaret @let_=@normalunderscore @let|=@normalverticalbar @let<=@normalless @let>=@normalgreater @let+=@normalplus @let$=@normaldollar %$ font-lock fix @unsepspaces } % Make _ and + \other characters, temporarily. % This is canceled by @fixbackslash. @otherifyactive % If a .fmt file is being used, we don't want the `\input texinfo' to show up. % That is what \eatinput is for; after that, the `\' should revert to printing % a backslash. % @gdef@eatinput input texinfo{@fixbackslash} @global@let\ = @eatinput % On the other hand, perhaps the file did not have a `\input texinfo'. Then % the first `\' in the file would cause an error. This macro tries to fix % that, assuming it is called before the first `\' could plausibly occur. % Also turn back on active characters that might appear in the input % file name, in case not using a pre-dumped format. % @gdef@fixbackslash{% @ifx\@eatinput @let\ = @normalbackslash @fi @catcode`+=@active @catcode`@_=@active } % Say @foo, not \foo, in error messages. @escapechar = `@@ % These look ok in all fonts, so just make them not special. @catcode`@& = @other @catcode`@# = @other @catcode`@% = @other @c Local variables: @c eval: (add-hook 'write-file-hooks 'time-stamp) @c page-delimiter: "^\\\\message" @c time-stamp-start: "def\\\\texinfoversion{" @c time-stamp-format: "%:y-%02m-%02d.%02H" @c time-stamp-end: "}" @c End: @c vim:sw=2: @ignore arch-tag: e1b36e32-c96e-4135-a41a-0b2efa2ea115 @end ignore getdp-2.7.0-source/doc/texinfo/CoreSta.pro000644 001750 001750 00000003305 11266605602 022111 0ustar00geuzainegeuzaine000000 000000 /* ------------------------------------------------------------------- File "CoreSta.pro" This file defines the problem dependent data structures for the static core-inductor problem. To compute the solution: getdp CoreSta -msh Core.msh -solve MagSta_a_2D To compute post-results: getdp CoreSta -msh Core.msh -pos Map_a ------------------------------------------------------------------- */ Group { Air = Region[ 101 ]; Core = Region[ 102 ]; Ind = Region[ 103 ]; AirInf = Region[ 111 ]; SurfaceGh0 = Region[ 1100 ]; SurfaceGe0 = Region[ 1101 ]; SurfaceGInf = Region[ 1102 ]; Val_Rint = 200.e-3; Val_Rext = 250.e-3; DomainCC_Mag = Region[ {Air, AirInf, Core, Ind} ]; DomainC_Mag = Region[ {} ]; DomainS_Mag = Region[ {Ind} ]; // Stranded inductor DomainInf = Region[ {AirInf} ]; Domain_Mag = Region[ {DomainCC_Mag, DomainC_Mag} ]; } Function { mu0 = 4.e-7 * Pi; murCore = 100.; nu [ Region[{Air, Ind, AirInf}] ] = 1. / mu0; nu [ Core ] = 1. / (murCore * mu0); Sc[ Ind ] = 2.5e-2 * 5.e-2; } Constraint { { Name MagneticVectorPotential_2D; Case { { Region SurfaceGe0 ; Value 0.; } { Region SurfaceGInf; Value 0.; } } } Val_I_1_ = 0.01 * 1000.; { Name SourceCurrentDensityZ; Case { { Region Ind; Value Val_I_1_/Sc[]; } } } } Include "Jacobian_Lib.pro" Include "Integration_Lib.pro" Include "MagSta_a_2D.pro" e = 1.e-5; p1 = {e,e,0}; p2 = {0.12,e,0}; PostOperation { { Name Map_a; NameOfPostProcessing MagSta_a_2D; Operation { Print[ az, OnElementsOf Domain_Mag, File "CoreSta_a.pos" ]; Print[ b, OnLine{{List[p1]}{List[p2]}} {1000}, File "k_a" ]; } } } getdp-2.7.0-source/doc/texinfo/CoreMassive.pro000644 001750 001750 00000004032 11266605602 022767 0ustar00geuzainegeuzaine000000 000000 /* ------------------------------------------------------------------- File "CoreMassive.pro" This file defines the problem dependent data structures for the dynamic core-inductor problem. To compute the solution: getdp CoreMassive -msh Core.msh -solve MagDyn_av_2D To compute post-results: getdp CoreMassive -msh Core.msh -pos Map_a getdp CoreMassive -msh Core.msh -pos U_av ------------------------------------------------------------------- */ Group { Air = Region[ 101 ]; Core = Region[ 102 ]; Ind = Region[ 103 ]; AirInf = Region[ 111 ]; SurfaceGh0 = Region[ 1100 ]; SurfaceGe0 = Region[ 1101 ]; SurfaceGInf = Region[ 1102 ]; Val_Rint = 200.e-3; Val_Rext = 250.e-3; DomainCC_Mag = Region[ {Air, AirInf} ]; DomainC_Mag = Region[ {Ind, Core} ]; // Massive inductor + conducting core DomainB_Mag = Region[ {} ]; DomainS_Mag = Region[ {} ]; DomainInf = Region[ {AirInf} ]; Domain_Mag = Region[ {DomainCC_Mag, DomainC_Mag} ]; } Function { mu0 = 4.e-7 * Pi; murCore = 100.; nu [ #{Air, Ind, AirInf} ] = 1. / mu0; nu [ Core ] = 1. / (murCore * mu0); sigma [ Ind ] = 5.9e7; sigma [ Core ] = 2.5e7; Freq = 1.; } Constraint { { Name MagneticVectorPotential_2D; Case { { Region SurfaceGe0 ; Value 0.; } { Region SurfaceGInf; Value 0.; } } } { Name SourceCurrentDensityZ; Case { } } Val_I_ = 0.01 * 1000.; { Name Current_2D; Case { { Region Ind; Value Val_I_; } } } { Name Voltage_2D; Case { { Region Core; Value 0.; } } } } Include "Jacobian_Lib.pro" Include "Integration_Lib.pro" Include "MagDyn_av_2D.pro" PostOperation { { Name Map_a; NameOfPostProcessing MagDyn_av_2D; Operation { Print[ az, OnElementsOf Domain_Mag, File "Core_m_a.pos" ]; Print[ j, OnElementsOf Domain_Mag, File "Core_m_j.pos" ]; } } { Name U_av; NameOfPostProcessing MagDyn_av_2D; Operation { Print[ U, OnRegion Ind ]; Print[ I, OnRegion Ind ]; } } } getdp-2.7.0-source/doc/texinfo/objects-wrap.tex000644 001750 001750 00000000501 11266605602 023144 0ustar00geuzainegeuzaine000000 000000 % dvips -E objects-wrap -o objects-wrap.eps \documentclass[12pt]{article} \RequirePackage[latin1]{inputenc} \usepackage{graphicx, color} \newcommand{\code}[1]{\upshape\texttt{#1}} \newcommand{\var}[1]{{\normalfont\itshape#1}} \pagestyle{empty} \thispagestyle{empty} \begin{document} \input{getdp.tex} \end{document} getdp-2.7.0-source/doc/texinfo/Strip.jpg000644 001750 001750 00000044415 11266605602 021641 0ustar00geuzainegeuzaine000000 000000 ÿØÿàJFIFHHÿá€ExifMM*JR(‡iZHH W ÿÛCÿÛCÿÀWÿÄ ÿĵ}!1AQa"q2‘¡#B±ÁRÑð$3br‚ %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖ×ØÙÚáâãäåæçèéêñòóôõö÷øùúÿÄ ÿĵw!1AQaq"2B‘¡±Á #3RðbrÑ $4á%ñ&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚ƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖ×ØÙÚâãäåæçèéêòóôõö÷øùúÿÚ ?þþ( € ( € ( € (äÚö¶ºøñOá'ÁOþÍ´í1ñ7ãÃÿŒß´ | Ô?gþß| ñÁ øß]ñN³ûH~Ðß³ç‡ãóööX-¥ý? € ( € ( € ( €>øÿ)MýÿìÀ?य़úÑ_ðIÚûþ€ ( € ( € ( € ( Äø&oüŸÇ>)ücÿ‚{~Ûký“ûj~Ì?ÿ € ( € ( € ( €>øÿ)MýÿìÀ?य़úÑ_ðIÚûþ€ ( € ( € ( € ( ÈÚÃö3ÿ…{ñOâïü+ះákø·Â_ð©>1k?³@øeÿ Nûâgü+Ÿü ¿ý«î¼  êRø‡SñíñWà—ìû것ü¿øV¶Oì'û>øªÃâ›á/Ž_´þ“ñõ{Â~,ð¯|+á¯xÄÞñ§‚|iáýÅžñ„õ;Ä~ñg…|G§[kñ7†¼C£ÜÞi:÷‡õí&òÓTѵ.òëNÕ4ë«kë+™í§ŠVè( € ( € (àø+ü¢Ëþ Yÿfûdë:üF ¿è € ( € ( € ( €>#ÊScû0ø)gþ´Wüv€>ÿ € ( € ( € ( € ( €>Æ)þÑÞ%ýœ5^>þÕ¿>:þÑÿ³º?дüS×n´Š_´ÿìǯêzæëß|@ø¥ñ7Åÿÿm¿‚òZø«Å~#ñ?5_Ú«Á6øMðö7ðf¡ãð¿è € ( € (àø+ü¢Ëþ Yÿfûdë:üF ¿è € ( € ( € ( €>#ÊScû0ø)gþ´Wüv€>ÿ € ( € ( € ( € ( ý¥þÂþøY«x_BñOü+/‹^ûŒ?g¿Ž–z'ü$#ýŸ>;Yxw^Ñ< ñ‹Ãš@Õü?ÿ ü#ÿðjzG~jÝ—ƒ¾4ü,ñþ|R¶ñÂ_‰¾<ð¾¸~Í?á|,Ò|S®ø_þ—ůýƒÁÿ´'ÀËÝoþþÏŸ¬¼; ë~;ø;â=]´ÿÂAÿÿü$f¯à¯ˆ:~‰eàï? ,ø›Bø¥ñ“á×Ãýcÿ 5¿éÿ to‰zî™âÏéºOÃý_ân¯¥|:Óñ7ÃߌڧÃW>?ðÿ‹|qáïìÅðçBÓ’}^âÃG¹ñ“geâ}d€ý°ÿiØ?c¯€^<ý£5‚ÿ>6x'á_‡üQ㟉Ú_ÁIþ §Š¼ðÏÀþ ñ?Ž¼iñ'P²øÕñƒàÆ“­øÃZO†%·ºÐü®x—⥨êÚT>ðN³mý«y¥€Ïíoð—á_Á¿ ühý®5þÂO‹xÇág€áðퟌ<]ÿ ¯ÄøQð—…á𖣧ø§ÄÛº½‡ö‡oìõ½OìºeÔR|ÿõÿ‚‰ÿÃÂ?´üwðé?d ß‚Oðÿ¾?ÓãøKûkÿÂóý©þÿÂÍò5…¾ ýªfý ö~ðׄ¿gˆ—„­<\¾;ðä´'ÄßøCþ"ø3\ð‡o~!i–ZŸô°Óú( € (àø+ü¢Ëþ Yÿfûdë:üF ¿è € ( € ( € ( €>#ÊScû0ø)gþ´Wüv€>ÿ € ( € ( € (ùáøGÿüýºá~þÏ´_Œ?g_ø%ìûKh_ü?ý” OÁ_jþñ-§Ç¸4í?Qñ_…µÏxOW¶ðæ­àï€{ÿíðSöÐñgíçð/öŸøkû6~ļû/üý£>| ¾ø×ûV|Vøuñ1¼UûL¿ìÇyâ_‰Ö^û|rÒ~øƒÁzOÁˆß mWÃ8ñv£ã߇¿5[»ÿx2Úï]ð.¨è¶ÃÛCÇ¿ÿcÿþΟ ÿfx'öcøÁ¬ü|Õ.þ5þÔ¾ ø«Åž*ñìÕûUþÌw߬<;à_Øçö‚ÒtÏéšOí¡üBµøƒqâÛ­GTÔt WÁ|<Ò­§´ñ³€{ÿlO |ÿ„+Ã_>~Ð|M×~øsÅÞ)Ò¿fÙöâý²>xwXÔþÛa­øwIø×ð3öVÕü?«døƒIÕí¬ ñNðÿÇwþ‹5¿‡^²ñF‘k(ËÿµG|qÿ ý‹ÿjÿÙÓö5øsâüoñsàÿþø«Tý·¾þÛ_°?…|á_ß ~'ø|Bð=÷ÅßØ»ZÕþ5xƒÂ¸°¸Ô~øKCÓôèôëÅ›Å?üs}ákO€zí_ðßöÐý eo†ð÷¿كCý ô¿ÚöWø×ã¯k?µÅfø7¤xWö\ý«¼ûJÚXxOã=—ìsqãoxƒÇöß¼á ›]cà‚4ïÏãßkqj¾,áö—¥üFè<ð¿ö§ø/ñþ 'ãÿøàÄ_øh_ÚàßÇOÙÿIñ‡Ç¿ˆ¿ ¿µ~Ãû,~̳GÅo üb¿Ñf_ŠŸð¬¿áÿ†z¼ñ¯ÃíoÁV?ábÿÂQmáÏé ÿ²åׯ€ø&ßÂÿÚŸöý–> ~Í´¿>xwþ³àÀž ñ¯ÀÏ~1ÂÐÿ…YðêÏÀ>$ñOŠ|9ãÿÙ—öÿ…aö¿øFt[DÑ4{âŸÚÿ·u{ ý_Kÿ„vÎóÄÀÐ@P@ÁX¿å_ðRÏû0Û#ÿY×â5}ÿ@P@P@P@|ñþR›ûÿÙ€ÁK?õ¢¿à“´÷ýP@P@P@P@P@|ñKBý£¾øï]øÃðOÿ…÷á/f]ü\ý™¼{ñJëšÆuáOÓ‡Ä/ÙÆ)ÓÛ\Ò¢ñï‰ÞðŸÄÏj7‘èþ4𦅫¬¶HìP@|ÿbÿ”YÁK?ìÀ?lýg_ˆÔ÷ýP@P@P@ðÄoùJoìoÿfÿ,ÿÖŠÿ‚NÐßôP@P@P@P@P@PÌþø«Å*°øÑðâ‡þþÒ:W‡í| 7|Wý£>|r> ~Ôøâ­Cà‡ÄðÿÂ/ÚÛÁþºñÄOÙ§Rñ¦®xª/ éÚŽ•¢IñŸá-åņµŒÿ³‰õ}oI·ðǽÂ&.£©IðÏ⟆>~Ñ>ø­ð3áÀÓôP@ÁX¿å_ðRÏû0Û#ÿY×â5}ÿ@P@P@P@|ñþR›ûÿÙ€ÁK?õ¢¿à“´÷ýP@P@P@P@P@Pükø)á_Ž^°ÐµÝCÄñ'…|Ak㟅Ÿü u§i> |LÒôíWIÑ~$ü6Öµm+^ÒlüAg¤ëÚÿ†õÍĺ‰þüKø{â| ø¿àŸˆ>!üAøâ€ðŸÇ|ñW†¾þÖZ§ˆ5‹ŸøƒFðŸÁÚÎj0|3øÕ¿¨Ûx{Â^øýâxZßáOì×ûOÍâKà ®4oŸ†ÿj_ˆ^4ø{«~ÈÖÖ¾7ø‹ãÙölû~€ øþ Åÿ(²ÿ‚–Ù€~Ùúο¨ïú( € ( € ( € (àˆßò”ßØßþÌþ Yÿ­ÿ ¿è € ( € ( € ( € ( € ( € çüYá? ø÷¾&ð/Ž¼5áÿx'ÆžÖ|'ãx³FÓ¼Gá_xWÄzuÎâ x›ÃÚŵ擯x^Òo/4½gFÕ-.´íSNº¹²¾¶žÚyb`ˆ?âû~Æôp¶§ìËsÿbwÄOÚŸöZÒôü"¾ ~Ø4_‡úýW/ø(éø‹ ÿÍñk_ã@>¿ðWÅŸ…Ÿ¾Çÿ ëâ_Ãÿhü?ðÅ?þ¯xwÅ_oøYñ_þ?øU¿ìÿ°µ+ÿµ|?ø•ÿw‹¿áñ”ü;ãøE|Gÿÿaêeùþ Åÿ(²ÿ‚–Ù€~Ùúο¨ïú( € ( € ( € (àˆßò”ßØßþÌþ Yÿ­ÿ ¿è € ( € ( € ùöéý¡~)þÊÿ³Œþ:ü%øKðÿãˆ< åÝ\ü-ñÇÆoüÖ<{öû[í3¾jø!ñâ÷âíñ[âmç€þ|ø;'†¼;ÿ /Ç~=Ò¼?¦øÂÏÄèÚˆ@<ÿöoÿ‚‚xãì¬~Ò~,ø}ñÀ>-øUñÆÿ¿i¯ÙãáÖ‰¬~×?~~Ñß >$Éðâ—ÂIü/û(èŸü[ãïì?¥·‰ü;â x=.µÿ‚~!ðÆgÃ^ð–¹p4 `ýž¾;ÏãßØ¿àí9ã­SÃþ4¹ñ§ìÁðÓã¿Œu¯ÙëÀ|Gá_Oâ?…:/ÄêŸþk¼ý õïëÒ^^]ü4ð©à›¯Œº¦u¢øvûÂÓøÞyt–çÿfÛ»ögý°ÿ²ofÿ|@ø›á/|?°ø—áߊÖ?hOü ñ'‡o°bŸNðçíâï…¾ø%âˆÔüA‡ð'ìñ÷ö]ø™ñÊóöø·û~Ê¿³wÆ_x#Ç0~Ì7?ðOx³Â¾ ø™ |=Ð>øÛâN¬|.ý¸¿g­&ßÄ´Ÿ x2Ëĺ‡ü áo‡¶Zw€<'ªi^ ·ø£®ühø¥ñˆÐ?eŸÙƒöÐý˜¿d ~Ìv_µ7ìÁã _à¯Áÿ€ß?gOˆw_±OÅmNðß…~hš_ƒ5ÍCã_áý½5Ÿ‹¾ ñ‚tM.ÓJºð/¾iÞñPÔxªÇ¿ <ž}Câu÷‰ÿi¿ÚIñçˆ,ÖtïxWÂ~ðæs¬x‡ÄÞ&ñ±sg¤è^д›;ÍSYÖuKË];KÓ­no¯®`¶‚YTŸø[ñgágÇh_¾ |Køñƒá—Š?´ÿáø‹ð·Æ^øàObk‡‡uŸì/xORÕü?«ÿdøƒIÕt-Oì…ÇØ53PÓ.¼«Û+˜#ô (àˆßò”ßØßþÌþ Yÿ­ÿ ¿è € ( € ( € ( € ( € ( € ( €>ÿ‚±Ê,¿à¥Ÿö`¶Gþ³¯Äjûþ€ óÿ‹?¼ ð;ágÄ¿µßøEþ|øã/Š_|Mý™¬kðŽøáÿ‡u/x»]þÆðøƒWþÉðþ“¨jÙš•©ëÿgû.™§ÞÞË´ Ìü‡âìàŸÛ'öqðÿ¯‰ÿ°ííñ7ãÏìâMÓöÉýˆþüIøUûkÛZÚØø7âŸÇ¯Š¿ðVMñ#ã‡õ/ø\ž ðÀ?ÿh/ˆÿ ¿hëoÚïâ»ðÇEýŸ¯,¾$ü`ñ‚@=ÿþ _cáŸ~Í u?ø*_ö¯íµáÿø+þ½ûø‹à…·ìm⊴GÂÉ¿à®·ìý´¿Â¯þÏ7%øIý‰ûø]×t‰_ tÿÙú—ˆüA¤êz†©âøÃáÖ‹vïþ/ý°¼1ñ7þ kû@þÊzü‹áÿÀ_‡ö?ÿek_ü*øâ/ø'Þ«ñ²Ëö¿ñ?ÄÿÚ‡àÅٳᇈþ2|1ø›öß±²ømâ‹ß|sðËâÇíeñwâ/ÃsàŸ‰¿þË{ð›âh?ûxüyý4ø*÷ìí£ø«þ ÙáÿØ‹Wøyû~Ø~øƒ¥èß¿`-Qøgâ¯ü`ÿ‚}øëÁþñe—íQðWâýφxö…øào~Ìÿµ_ˆþ,øÅ_¼iá/‹ß|;ðìëûßÚßG¶øû|Býªÿh¿øZ ¿fOø-÷ícû7þØÿ|g¤ø¼;ààÇŒà ÿ ?bícöÇÑ>ø ÂþÂ7ñàŸÿô¿øÓáÿïx'➣ðãåÔž½>ñ•°èÿüûÅžøŸãïø(ÏƯ†¾&ðÿÄ?ƒŸmÿ ø³áůk:w‹~üVð¯†?àžŸ°OÂ?ø›á·4 CÂÞ9ðÿ‡¾+|5øðÇ\Ö|1ªêšv“ñ À6ð]ýÍ¿‰<+®é¶£ôPÀ¿å)¿±¿ý˜ü³ÿZ+þ ;@Ð@P@P@P@P@P@P@|ÿbÿ”YÁK?ìÀ?lýg_ˆÔ÷ýP@PÈ¿aïƒ!hÞ*Òç‹À¾2ðF¿}ûXøïÇ>øƒÀ>$ðv£àïüñ¾Ô~üLÑ|oáïøÂÿƶŽôýP@|ñþR›ûÿÙ€ÁK?õ¢¿à“´÷ýP@P@P@P@P@P@PÀðV/ùE—ü³þÌöÈÿÖuø@Ð@P@òÅ/Ù¿XÓ¼w®þÑß³6±ÿ'í}ý™yâÏøƒÆþ;Ò¿gÚZ×GÑôÿÜøcã¯Ã­OxKÃÿÔüñàƇÿØ“üHøñ‰| Å?hþ/þ×›áÿ‹®®>xïâÃ/|?ø‰e ë­àÿˆ¿ ~#øûÀ—ž#ð¿Ä†:‡ˆ´ÏŒ >/|=ð¿Ð@ðÄoùJoìoÿfÿ,ÿÖŠÿ‚NÐßôP@P@P@P@P@P@P@ÁX¿å_ðRÏû0Û#ÿY×â5}ÿ@P@P@ñÓöoð'ÇøEõWXøðïâoÃ¿í¹¾ükø;ã}cáßÅ?‡—Z÷öEÖ¡imªé’Káÿˆõ?x_Àþ,ñ‡À_>øŸû8üVñÿ‡×?þüD²ðv…afçÿ ~:|Sð÷Žô/_µ·…þø'âo‹¿´íþ |Rø[­øQø'ûKÿÂ)£êŸ‰ì4-?ÆE‡ˆ>~ÐøúïŽOöRñ‰~,}ƒáj ø9ûD~Óv_?i=wàÈ×ôP@|Fÿ”¦þÆÿö`ðRÏýh¯ø$í}ÿ@P@P@ý·‹<+yâ­gÀ¶ž&ðý×ü9áÿ x³Ä>¶ÖtéüU¡xWÆš‹4x›YðôW/«é~ñf¯à/i~Öo­ ÓµíGÁ~,²Òîn®|9¬EfÐP@P@P@P@PÀðV/ùE—ü³þÌöÈÿÖuø@Ð@P@P@ñKá?ÂÏŽ>×~ükøiðÿãÃ/fÂMðëâ—ƒ|;ñÀž"þÄÖ4ÿhßÛ¾ñf›«øWþÉñ“¥kºgö†Ÿqö cLÓõ;_*öÊÚxÀ>@ÿ„×âŸìUÿÿ‹×¿ð³b_þîÃö›ñ7üGâŽß³‡oxÒt¿ÚK×¼9{ÿ 7àÃ/±\iž!ý¸®þ)^üSð‡ƒ¼Aàmwö²ømâ |2ý¥ÿoíXíÿ ø³Â¾=𯆼uà_xÆž ñ§‡ôox;Æ>ÖtïøWÅžñm¬x{ÄÞñsy¤ëÞ×´›ËMSFÖt»Ë­;TÓ®­¯¬®g¶ž)X  €>#ÊScû0ø)gþ´Wüv€>ÿ € ( € óÿ‹?ð«?áV|Kÿ…éÿ ÿþ—ü+ÿÂâÿ…³ÿïü*ÏøUŸðŽê_ð°¿áeÿÂaÿ—ü+ÿøD¿µÿá2ÿ„§þ)ßøG´¿¶ÿâYöªü!ÿ‚J~ØðMÏ…~ ðwì¥û5øóö`¼ø‰ûJÁGÿà§o…þþËž(ø q¨é^о>þÛŸ>|[ñ×€üâ};\±ø?'ì¹ð á¿€¾ø÷Nð?…u/Ù÷ÂÞŽ‡wš¥£zìÁû~þÇ7_ðROÚ›ÁÖÿðSÙƒãö“ñàÿìR>Þj_?aµñTÿ¼oñçöôÒõÙOá/Ž¾øCáÇþ1øá­µç™|ðËâ'ˆ~1üLð^£ñrMbO\êÿ/o¼Fóÿ?lOxcâíññgLÿ‚­ø‚çáßìMÿ_ý…¾x¿áÓÁ=&ø7ðóö`ý¡~&~šÆý/ã_‰mÿf;Œžðÿ€üL×u@ñÿíÏÿø¡ûJüwøaðoö÷ýˆ?e¯Úáÿí¿âŸ ¿d/Ú÷ö—ø_ðƒNñ…|ñ¿K°ø/¥ÞþÈÞ6ÿ‚Y뿵·ÄÏþ׳µ×€|M¡xÿàgüKWÓ¼y⯌øËà÷Š~ÇiÀO€[´P@P@P@P@ÁX¿å_ðRÏû0Û#ÿY×â5}ÿ@P@P@PÄ,øKñ—àŠ¼MñOöPÃþ'øwâok?~4~ÆúÆ›”þ?ñ¦·¨Üê^9ñ·ìŸñ/Tñçƒüû?|`øs¬k?~"xâ>‹â_€_´GÆ]IÕõ-söKø‰ñŸö•ý¬©?ˆ<áíGéq}.®h>ñ·€~0|/¶ñçÃÏ ~׿²ÿÅ_øãïì}ñ—Åšƒ>+x-¾üKý>3|zçþ#ÊScû0ø)gþ´Wüv€>ÿ € ( € ñÿü+ûCü3Òþ.xÃľ ñˆ<¦ø;T×ítè ñß…|ñ Å>ð÷Å¿_hú®·¤øŸàÿÆ}'ÃVŸ¾x÷KÔ§Ó¾"üñ§ÿ‚±Ê,¿à¥Ÿö`¶Gþ³¯Äjûþ€ ( € ( € ( Åžð¯|+âoøëÃ^ñ§‚|iáýgÂ~1ðw‹4m;Ä~ñg…|G§\èþ!ð׉¼=¬[^i:÷‡õí&òóKÖtmRÒëNÕ4ë«›+ëií§–&üøÿoð®‘ñ÷áíaûþÒ¿?cÏŽß¼>Þø{á¹-ôïŽß³ßÂ]sÆž×|qû>øóáŒï4/Š×Ÿ³ç…´(¿ðŸ„ü+à/ økÀ¾ðׇüàŸøF🃼á=Nðç…|'á_iÖÚ?‡¼5á¯höÖzN…áý I³´ÒômK´µÓ´½:ÖÚÊÊÚ h"‰@: ( € ( € ( € ( € ( €?à¬_ò‹/ø)gý˜í‘ÿ¬ëñ€>ÿ € ( € ( € ( €>øÿ)MýÿìÀ?य़úÑ_ðIÚûþ€ ( €<ÿâÏÅ/|øYñ/ã_Å-wþ†_þøËâ—Ä_fkßü#¾øáÝKÅž.×±¼;§êþ Õÿ²|?¤ê‡öf…¥jzÅÿÙþ˦i÷·²Ám(€~É¿ |w¢ÿÂÞøùñ»BþÁøõûKü@¸ñ^½á«½OGñ ÷Áÿ‚~û_„ÿfÙâßYÒuYiŸð¯þDŸ¾/x/Â_þ"|"²ý²~3~Ö_~ x§Pð/Äû ›€¯è € ( € ( € ( € ( € øþ Åÿ(²ÿ‚–Ù€~Ùúο¨ïú( € ( € ( € (àˆßò”ßØßþÌþ Yÿ­ÿ ¿è € (òƒÀ¿ü+ÿ<ñWìúþ°ñ²O…~þËŸ·GÅ+Mv×NÒüU¬ü}ñþ£ðÏöœý†¾k^"ð¦«ã-'EñÀ½'Âöµ/í=ð»Kñ'„üic¨øŸö º±ñwÄ?ÙÛã/Å¿øàõ~€ ( € ( € ( € ( € ( €>ÿ‚±Ê,¿à¥Ÿö`¶Gþ³¯Äjûþ€ ( € ( € ( € øâ7ü¥7ö7ÿ³ÿ‚–ëEÁ'hïú( €?8?à¯V¿uïø&íðïö|ø)âÚã'ÇOƒú—ìÍà_…þÕ`еÍGö£Õ´ŸÙÚóÆ7:Õõ…þ“¤øáN“ñ?Qø­âÍGÄRh~³ð¯‚µ›øÃÀÞTñ–„Á<b~Ì ü+âÚ3ÇøÓû_k>ñÏň¾Óµ+ោ¼Uñ¯âßÇOÚ#Fø á]]„žðÿÆ¿ÚY×>3|gñ5¾áÍGãÄ'ðâCá?…~þË_³ìÔú?@P@P@P@P@P@ÁX¿å_ðRÏû0Û#ÿY×â5}ÿ@P@P@P@~ ÿÁGwìÿ³ÿ„»ö*ý˜?ᬾ)ê>gÆø&DÿðŽkÿ¿á‘?mì_‡÷ŸgþÓÕ|kÿ ·AþÎñ‘á] þý/þ?øG|Tçÿð¹?ë#ð_ïüR¿ÿ˜.€ø\Ÿõ‘¿ø/÷þ)_ÿÌ@ü.OúÈßüûÿ¯ÿæ  þ'ýdoþ ýÿŠWÿóÐÿ “þ²7ÿþÿÅ+ÿù‚èÿ…ÉÿYÿ‚ÿâ•ÿüÁtôìÿ,Òÿá–?fŸøj?‡?·ÿü4×ü(ƒðÑñ©ßø(ïü—oøW^ÿ…»ÿ$ïö7ÿ…ÿ%þù¿âŽÿ¡gþ$¿b ÿ‡–~οôNoÿüTïü7ÿ Þ€øygìëÿDçöÿÿÅNÿÁSú èÿ‡–~οôNoÿüTïü7ÿ Þ€øygìëÿDçöÿÿÅNÿÁSú èÿ‡–~οôNoÿüTïü7ÿ Þ€øygìëÿDçöÿÿÅNÿÁSú èÿ‡–~οôNoÿüTïü7ÿ Þ€øygìëÿDçöÿÿÅNÿÁSú èÿ‡–~οôNoÿüTïü7ÿ Þ€øygìëÿDçöÿÿÅNÿÁSú èÿ‡–~οôNoÿüTïü7ÿ Þ€øygìëÿDçöÿÿÅNÿÁSú èÿ‡–~οôNoÿüTïü7ÿ Þ€øygìëÿDçöÿÿÅNÿÁSú èÿ‡–~οôNoÿüTïü7ÿ Þ€øygìëÿDçöÿÿÅNÿÁSú èÿ‡–~οôNoÿüTïü7ÿ Þ€øygìëÿDçöÿÿÅNÿÁSú èÿ‡–~οôNoÿüTïü7ÿ Þ€øygìëÿDçöÿÿÅNÿÁSú èâø)·üà7?à›ŸðPohþý·ìõ~ĵ†´»ÏÁ2¿à¤ž𭮣¯|ñö—esâoxëöPðç‚|áø.n¢—YñgŒ|C¡xWÚrÜë!Öt½&ÎòúÝê( € ( € ( € (àˆßò”ßØßþÌþ Yÿ­ÿ ¿è € ( € ( € ( € (ŸÑ¼Yá_ê>,Ñü=âoëÚ¿€¼Amá?iz6³§jš‚üUyá_ xêÓÃ^,²²¹žçÞ ºðO<ãmXŠÏQŸÂ¾,ð׈b¶}'^Òï.€: ñÿ‡´/À/Œ~*øà_„_~üTñ¿Á?/„þ3x;áÇÄ¿øãÅ_üTúˆ4tð×Äïxc[Õ5xõ ø«K]ÅVšN¢Ú†¼Ad-ΨÅlÐÂÙøYÿ Oþgü,¿‡ÿð»á_ÿÂÙÿ…;ÿ —‡áiÿ¬ÿ„þÿøY𯿴¿á-ÿ…ÿ oüRßð™dÂ;ÿ üI?´¿´ÿѨÐ( € ( €?à¬_ò‹/ø)gý˜í‘ÿ¬ëñ€>ÿ € ( € ( € ( €>øÿ)MýÿìÀ?य़úÑ_ðIÚûþ€ ( € ( € ( € (óþ ÿ ³þŠ_ø^Ÿð¯ÿáIÃ_ÿÁ3ÿáqÂÙÿ„wþgü*Ïøy_ì‘ÿ þ_ü&ñI¿ÿ„Kû_þ/øJâÿ„wûKûoþ%Ÿj  ý™üYûø ãî§ã¯ø'lj¿fÿÁ;üû0|yñgí£ãÙŸYøSáÏØ¿Â|9ãO€ºÇÀj~!ðEÍŸÀí ã…ð:Ïö§Õ><ë?/-|i¥ü)µø }ûZ\Áá?ciTåÿÙÛþ ðÛžÿ‚³xSö{ýµ¾~Þÿµ×„> |Vø‹ûøûsöNñ'ÇoÛ#XðüöbøáØ?á\~ľø{ûLeüMðçŽþÿÂEà?Oã±àï…ßðªÛÅË7ÂûuЀ9ÿø&wíSûa~ÒŸµÁ}cŸðRÏ؃ö«ý›õƒþ=ñÏÇ1þ×?hÚƒM𮿠xVëá'ÄŸü0øÿ¦ÿ‚n|Dø)â|DÔ|=àï‹Zí/Štë}â6¥áíGÁ>ø£¡øy¦úƒà¯ü'öñü7öŠÿ„GöáýøŸàé>%ü)ð¯ÄÏü}øËñ#þ £ü ð×<<Ú݇ŠuoŒ¾ü1Ñô¿„º7ˆm.~Ðo ü)ñ_ÄÏ„þý¡¼!áÏ|Lý•üUãýö¢ø!áëŽß¾ßXyÿì‡á­;ö,Ôl¿c/\ø-¼Uâ {Xý™~*ë>,ñV©ð÷ã.£xV+™¾ xOÁzƳ{ðïö]øÁðwá߃$Ô.d€>øWû0x«áŸ†üRñßÃ?è_³_í)®ÿÂAâßiÁû<þÐÓéš?‡ôÚƒGðþ¨x‡Sð‹´Ïiú?„¼ û_øÂZ>­âOˆ¿¼7¤øÀŸü áÿ~Ò?³w‡|?á/þгçìzõýP@P@P@P@P@P@P@P@P@P@çÿ¾øãG5߆ßt/øH<%âìÉîm ÔõëV±áýcOñ7„ü]áxkPÑü[àOˆñn¡øÛá×Ä_ëžñßïøþ9ð7ˆ¼?âßèÚ͈€|-ø¥ã¿†~;пf¿ÚS]ÿ„ƒÅ¾ þÓƒöyý¡§Ó4èÿµáýPñ§áižÓô xö¿ð'„´}[ÄŸ~xoIðÿ>7øÃþ"ý¤fïøÂ^ý ÿgÏØô䊵OíOsñwö×Ôô¯Úöý‰d_سâÁŸšÏÅ¿ÚÓá¿Ä_‹ºÇ¾)üBø'ðk㯉¼Sâo[~Õ±¿Ã/‚íl¿i‚Ÿ ~h—ZïÅøÛÇv¾1Ô5 _Ãj^ðÕЯø‡öïÔ~ ü%ýƒµOŠ_ üVøûãOŒ¿üû?x¿àÇÃß„¾ýš¾.üsðOŽüAñ¢çö ø/à¯ÃÄ ñ§Š¤±ñ´þÒtS[µóÿ‡µOÆÿˆ?ðRO…_ |UðïöŸý›|â¯Øƒö ø‹âoÙËãç„f­Sº‡Š¾|yýŽ|5ðÓãgÃß_³×ˆ¾8é:·ˆ5m'ãÅß|Aø\iKQð¦á‡ž,ñWÀ¿‡–Þ5ðþ,€~¯Ð@P@P@P@P@P@P@P@P@ñŽbH5‰Ÿ~.ü ý§iÿÙ/ÆßüA¡ø³ã¬Ÿ5σ~;ð¯ÅŸxKáï‚~ø3ÄڇÿÚÛà—í9ðïῈ<9ðïÀ>ð­Ö³ðÂß uˆ:uŽ”~-ÜüB¹ð—.<(ãúÇüÇþïØŸÀ?¿mÚÿà¿„¿`O‡ÿüðIð ìm®ÿÅGðëàOÄoÙ¢ÓâÇoþ0~Çÿõ?ü@ñÁ/Š~.ðWˆôè/4¯…Ÿé6~#ðïÃOx¶Æz€=ƒãOìIÆ]Gölñô´ïí?ð§öƒý˜|?ã ø[ö”øQ®|Ò>!xÿ¿ü+áŸü]ð×Ɔþ*ø%ãÙsÇÞø£®xá߼oF¸ýž¬4ï üLøyàß|)¶øw’të€Yÿ‚uü,Ô~üGø9¦üTý 4ü^ý > þÖÿiøN<;ãŽÞ*ý¦>xÇàüñwËø³àˆ¼7OöiøO¥¤ðoÁo~Ï~ðv‡ÿ?ÃO„ð”zv§x±ÿ‡±ñ.±ñ›Æ^,ÿ‚‚þßþ-ø›ñÇâì[ãÿüKñ«û_ëÿ†ñß‹~,þÏ øuàÑûEðáÿÃý3ãŠ-¾,ø»Ãžøieÿ ŸŽü;¥¬ÞÉeã_‹šwÄ€ø¡ÿëøYñsGýµü9⟊Ÿ´‡‡ÿm¿ˆ~2ë–~ñLJ~ë~;|ð'Á¯|6øÝû7øÿÁ>о&øOâ{û:üñüiñÆ¿¼mã¿…ú=æ—á-7Ãú÷Ž|9â°áÿìuá/Ú;á‡íSã?Û'ö¿øßñká—Ãÿ‹ßcoŠZ§ìãeàOü"øÃuðßÄ—ÃýwáÂ_Ù·ágÃÿÿÂ;ñág…~"éŸ>ø{áÏÆÏëZ„~/|Oø›ð—¾øqá ¿è € ( € ( € ( € ( € ( € ( € ( € ( € ( € ( € ( € ( € ( € ( € ( € ( € ( € ( € ( € ( € ( € ( € ÿÙgetdp-2.7.0-source/doc/texinfo/Strip.fig000644 001750 001750 00000003176 11266605602 021625 0ustar00geuzainegeuzaine000000 000000 #FIG 3.2 Landscape Center Metric Letter 100.00 Single -2 1200 2 6 1353 3873 3693 3873 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2 3153 3873 3693 3873 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2 1353 3873 3153 3873 -6 6 1358 1532 3698 1532 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2 3158 1532 3698 1532 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2 1358 1532 3158 1532 -6 6 3694 1534 3694 3874 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2 3694 3874 3694 2074 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2 3694 2074 3694 1534 -6 6 1353 1533 1353 3873 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2 1353 3873 1353 2073 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2 1353 2073 1353 1533 -6 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 0 0 1.00 48.00 96.00 813 2865 1317 3261 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 0 0 1.00 48.00 96.00 2685 4197 2397 3909 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2 3692 3605 1892 3605 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 0 0 1.00 48.00 96.00 1988 3182 1772 3542 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 0 0 1.00 48.00 96.00 3144 2149 3648 2545 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 0 0 1.00 48.00 96.00 2922 1926 2706 1566 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2 1891 3605 1355 3605 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2 1890 3604 1890 3561 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2 1890 3563 1353 3563 4 0 0 100 0 12 10 0.0000 4 135 720 381 2793 Surf_dn0\001 4 0 0 100 0 12 10 0.0000 4 105 540 2721 4233 Ground\001 4 0 0 100 0 12 10 0.0000 4 105 450 2677 3785 Diel1\001 4 0 0 100 0 12 10 0.0000 4 105 360 2029 3132 Line\001 4 0 0 100 0 12 10 0.0000 4 135 720 2373 2102 Surf_Inf\001 4 0 0 100 0 12 10 0.0000 4 105 270 2416 2591 Air\001 getdp-2.7.0-source/doc/texinfo/mStrip.pro000644 001750 001750 00000004035 11266605602 022030 0ustar00geuzainegeuzaine000000 000000 /* ------------------------------------------------------------------- File "mStrip.pro" This file defines the problem dependent data structures for the microstrip problem. To compute the solution: getdp mStrip -solve EleSta_v To compute post-results: getdp mStrip -pos Map or getdp mStrip -pos Cut ------------------------------------------------------------------- */ Group { /* Let's start by defining the interface (i.e. elementary groups) between the mesh file and GetDP (no mesh object is defined, so the default mesh will be assumed to be in GMSH format and located in "mStrip.msh") */ Air = Region[101]; Diel1 = Region[111]; Ground = Region[120]; Line = Region[121]; SurfInf = Region[130]; /* We can then define a global group (used in "EleSta_v.pro", the file containing the function spaces and formulations) */ DomainCC_Ele = Region[{Air, Diel1}]; } Function { /* The relative permittivity (needed in the formulation) is piecewise defined in elementary groups */ epsr[Air] = 1.; epsr[Diel1] = 9.8; } Constraint { /* Now, some Dirichlet conditions are defined. The name 'ElectricScalarPotential' refers to the constraint name given in the function space */ { Name ElectricScalarPotential; Type Assign; Case { { Region Region[{Ground, SurfInf}]; Value 0.; } { Region Line; Value 1.e-3; } } } } /* The formulation used and its tools, considered as being in a black box, can now be included */ Include "Jacobian_Lib.pro" Include "Integration_Lib.pro" Include "EleSta_v.pro" /* Finally, we can define some operations to output results */ e = 1.e-7; PostOperation { { Name Map; NameOfPostProcessing EleSta_v; Operation { Print [ v, OnElementsOf DomainCC_Ele, File "mStrip_v.pos" ]; Print [ e, OnElementsOf DomainCC_Ele, File "mStrip_e.pos" ]; } } { Name Cut; NameOfPostProcessing EleSta_v; Operation { Print [ e, OnLine {{e,e,0}{10.e-3,e,0}} {500}, File "Cut_e" ]; } } } getdp-2.7.0-source/doc/texinfo/Core.geo000644 001750 001750 00000003762 11266605602 021422 0ustar00geuzainegeuzaine000000 000000 /* ------------------------------------------------------------------- File "Core.geo" This file is the geometrical description used by GMSH to produce the file "Core.msh". ------------------------------------------------------------------- */ dxCore = 50.e-3; dyCore = 100.e-3; xInd = 75.e-3; dxInd = 25.e-3; dyInd = 50.e-3; rInt = 200.e-3; rExt = 250.e-3; s = 1.; p0 = 12.e-3 *s; pCorex = 4.e-3 *s; pCorey0 = 8.e-3 *s; pCorey = 4.e-3 *s; pIndx = 5.e-3 *s; pIndy = 5.e-3 *s; pInt = 12.5e-3*s; pExt = 12.5e-3*s; Point(1) = {0,0,0,p0}; Point(2) = {dxCore,0,0,pCorex}; Point(3) = {dxCore,dyCore,0,pCorey}; Point(4) = {0,dyCore,0,pCorey0}; Point(5) = {xInd,0,0,pIndx}; Point(6) = {xInd+dxInd,0,0,pIndx}; Point(7) = {xInd+dxInd,dyInd,0,pIndy}; Point(8) = {xInd,dyInd,0,pIndy}; Point(9) = {rInt,0,0,pInt}; Point(10) = {rExt,0,0,pExt}; Point(11) = {0,rInt,0,pInt}; Point(12) = {0,rExt,0,pExt}; Line(1) = {1,2}; Line(2) = {2,5}; Line(3) = {5,6}; Line(4) = {6,9}; Line(5) = {9,10}; Line(6) = {1,4}; Line(7) = {4,11}; Line(8) = {11,12}; Line(9) = {2,3}; Line(10) = {3,4}; Line(11) = {6,7}; Line(12) = {7,8}; Line(13) = {8,5}; Circle(14) = {9,1,11}; Circle(15) = {10,1,12}; Line Loop(16) = {-6,1,9,10}; Plane Surface(17) = {16}; Line Loop(18) = {11,12,13,3}; Plane Surface(19) = {18}; Line Loop(20) = {7,-14,-4,11,12,13,-2,9,10}; Plane Surface(21) = {20}; Line Loop(22) = {8,-15,-5,14}; Plane Surface(23) = {22}; Physical Surface(101) = {21}; /* Air */ Physical Surface(102) = {17}; /* Core */ Physical Surface(103) = {19}; /* Ind */ Physical Surface(111) = {23}; /* AirInf */ Physical Line(1000) = {1,2}; /* Cut */ Physical Line(1001) = {2}; /* CutAir */ Physical Line(202) = {9,10}; /* SkinCore */ Physical Line(203) = {11,12,13}; /* SkinInd */ Physical Line(1100) = {1,2,3,4,5}; /* SurfaceGh0 */ Physical Line(1101) = {6,7,8}; /* SurfaceGe0 */ Physical Line(1102) = {15}; /* SurfaceGInf */ getdp-2.7.0-source/doc/texinfo/Core.pdf000644 001750 001750 00000004030 11266605602 021406 0ustar00geuzainegeuzaine000000 000000 %PDF-1.1 %Çì¢ 4 0 obj << /Length 5 0 R >> stream q 1 i 0.472425 w 175.285 23.4382 m 175.285 86.033 124.542 136.776 61.9468 136.776 c S 175.285 23.3941 m 209.299 23.3941 l S 61.9027 23.3941 m 61.9027 136.776 l S 61.9027 136.776 m 61.9027 170.791 l S 61.9027 23.3941 m 175.285 23.3941 l S 61.9027 68.7469 m 84.5791 68.7469 l 84.5791 23.3941 l S 95.9173 23.3941 11.3382 22.6764 re S 179.82 152.65 m 166.214 129.973 l S 171.505 135.831 m 167.033 131.485 l 168.923 137.406 l S 209.299 23.5127 m 209.157 104.793 143.302 170.649 62.0219 170.791 c S 27.8881 86.8881 m 59.635 61.944 l S 54.4698 67.9281 m 58.2492 63.0149 l 52.5802 65.5344 l S endstream endobj 5 0 obj 585 endobj 6 0 obj << /Type /Font /Name /R6 /Subtype /Type1 /BaseFont /Courier >> endobj 7 0 obj << /Length 8 0 R >> stream BT /R6 9.4485 Tf 1 0 0 1 86.8467 143.579 Tm (AirInf) Tj ET Q q W 0 0 217 16.7 re 0 16.7 217 0.1 re 0 16.8 217 3.1 re 0 19.9 217 0.1 re 0 20 217 0.7 re 0 20.7 217 0.1 re 0 20.8 217 2 re 0 22.8 217 0.1 re 0 22.9 217 149.1 re n 1 i 0.472425 w 145.805 2.98538 m 127.664 21.1265 l S Q q 1 i 0.472425 w 132.074 14.5755 m 128.861 19.9297 l 134.215 16.7172 l S BT /R6 9.4485 Tf 1 0 0 1 157.144 154.917 Tm (SurfaceGInf) Tj 0 1 -1 0 75.5085 34.7324 Tm (Core) Tj 0 1 -1 0 104.988 25.6618 Tm (Ind) Tj 1 0 0 1 0.676392 91.4233 Tm (SurfaceGe0) Tj 1 0 0 1 148.073 0.717734 Tm (SurfaceGh0) Tj 1 0 0 1 102.72 80.0852 Tm (Air) Tj ET Q endstream endobj 8 0 obj 617 endobj 3 0 obj << /Type /Page /MediaBox [0 0 217 172] /Parent 2 0 R /Resources << /ProcSet [/PDF /Text] /Font << /R6 6 0 R >> >> /Contents [ 4 0 R 7 0 R ] >> endobj 2 0 obj << /Type /Pages /Kids [ 3 0 R ] /Count 1 >> endobj 1 0 obj << /Type /Catalog /Pages 2 0 R >> endobj 9 0 obj << /CreationDate (D:19990720175515) /Producer (Aladdin Ghostscript 5.03) >> endobj xref 0 10 0000000000 65535 f 0000001654 00000 n 0000001595 00000 n 0000001437 00000 n 0000000015 00000 n 0000000652 00000 n 0000000671 00000 n 0000000749 00000 n 0000001418 00000 n 0000001703 00000 n trailer << /Size 10 /Root 1 0 R /Info 9 0 R >> startxref 1794 %%EOF getdp-2.7.0-source/doc/texinfo/objects.tex000644 001750 001750 00000003334 11266605602 022204 0ustar00geuzainegeuzaine000000 000000 \begin{picture}(0,0)% \includegraphics{objects}% \end{picture}% \setlength{\unitlength}{3947sp}% % \begingroup\makeatletter\ifx\SetFigFont\undefined% \gdef\SetFigFont#1#2#3#4#5{% \reset@font\fontsize{#1}{#2pt}% \fontfamily{#3}\fontseries{#4}\fontshape{#5}% \selectfont}% \fi\endgroup% \begin{picture}(8552,4875)(300,-6512) \put(1126,-3361){\makebox(0,0)[b]{\smash{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}{\color[rgb]{0,0,0}\code{Group}}% }}} \put(2851,-2686){\makebox(0,0)[b]{\smash{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}{\color[rgb]{0,0,0}\code{Function}}% }}} \put(2851,-3361){\makebox(0,0)[b]{\smash{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}{\color[rgb]{0,0,0}\code{Constraint}}% }}} \put(2851,-4036){\makebox(0,0)[b]{\smash{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}{\color[rgb]{0,0,0}\code{FunctionSpace}}% }}} \put(2851,-5386){\makebox(0,0)[b]{\smash{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}{\color[rgb]{0,0,0}\code{Jacobian}}% }}} \put(4576,-4711){\makebox(0,0)[b]{\smash{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}{\color[rgb]{0,0,0}\code{Integration}}% }}} \put(4576,-4036){\makebox(0,0)[b]{\smash{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}{\color[rgb]{0,0,0}\code{Formulation}}% }}} \put(6301,-4036){\makebox(0,0)[b]{\smash{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}{\color[rgb]{0,0,0}\code{Resolution}}% }}} \put(8026,-3361){\makebox(0,0)[b]{\smash{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}{\color[rgb]{0,0,0}\code{PostOperation}}% }}} \put(8026,-4036){\makebox(0,0)[b]{\smash{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}{\color[rgb]{0,0,0}\code{PostProcessing}}% }}} \end{picture} getdp-2.7.0-source/doc/texinfo/objects.fig000644 001750 001750 00000010004 11266605602 022141 0ustar00geuzainegeuzaine000000 000000 #FIG 3.2 Landscape Center Inches Letter 100.00 Single -2 1200 2 0 32 #ffffae 2 2 0 1 0 7 52 0 20 0.000 0 0 -1 0 0 5 450 3975 1800 3975 1800 4350 450 4350 450 3975 2 2 0 1 0 7 52 0 20 0.000 0 0 -1 0 0 5 2175 3300 3525 3300 3525 3675 2175 3675 2175 3300 2 2 0 1 0 7 52 0 20 0.000 0 0 -1 0 0 5 2175 3975 3525 3975 3525 4350 2175 4350 2175 3975 2 2 0 1 0 7 52 0 20 0.000 0 0 -1 0 0 5 2175 4650 3525 4650 3525 5025 2175 5025 2175 4650 2 2 0 1 0 7 52 0 20 0.000 0 0 -1 0 0 5 2175 6000 3525 6000 3525 6375 2175 6375 2175 6000 2 2 0 1 0 7 52 0 20 0.000 0 0 -1 0 0 5 3900 4650 5250 4650 5250 5025 3900 5025 3900 4650 2 2 0 1 0 7 52 0 20 0.000 0 0 -1 0 0 5 3900 5325 5250 5325 5250 5700 3900 5700 3900 5325 2 2 0 1 0 7 52 0 20 0.000 0 0 -1 0 0 5 5625 4650 6975 4650 6975 5025 5625 5025 5625 4650 2 2 0 1 0 7 52 0 20 0.000 0 0 -1 0 0 5 7350 3975 8700 3975 8700 4350 7350 4350 7350 3975 2 2 0 1 0 7 52 0 20 0.000 0 0 -1 0 0 5 7350 4650 8700 4650 8700 5025 7350 5025 7350 4650 2 2 0 0 0 7 54 0 45 0.000 0 0 -1 0 0 5 300 7350 8850 7350 8850 4500 300 4500 300 7350 3 2 0 1 0 7 50 0 -1 0.000 0 1 0 4 0 0 1.00 75.00 105.00 1200 4350 1725 5175 3000 5400 3900 4950 0.000 -1.000 -1.000 0.000 3 2 0 1 0 7 50 0 -1 0.000 0 1 0 3 0 0 1.00 75.00 105.00 3450 6000 3750 5400 3975 5025 0.000 -1.000 0.000 3 2 0 1 0 7 50 0 -1 0.000 0 1 0 2 0 0 1.00 75.00 105.00 4575 5325 4575 5025 0.000 0.000 3 2 0 1 0 7 50 0 -1 0.000 0 1 0 3 0 0 1.00 75.00 105.00 1200 3975 1500 3675 2175 3525 0.000 -1.000 0.000 3 2 0 1 0 7 50 0 -1 0.000 0 1 0 3 0 0 1.00 75.00 105.00 3527 3582 4200 3900 4650 4650 0.000 -1.000 0.000 3 2 0 1 0 7 50 0 -1 0.000 0 1 0 3 0 0 1.00 75.00 105.00 3527 3469 5325 3900 6300 4650 0.000 -1.000 0.000 3 2 0 1 0 7 50 0 -1 0.000 0 1 0 3 0 0 1.00 75.00 105.00 3521 3366 6136 3830 7350 4650 0.000 -1.000 0.000 3 2 0 1 0 7 50 0 -1 0.000 0 1 0 4 0 0 1.00 75.00 105.00 1050 3975 2700 2700 6300 2700 8025 3975 0.000 -1.000 -1.000 0.000 3 2 0 1 0 7 50 0 -1 0.000 0 1 0 2 0 0 1.00 75.00 105.00 2850 3675 2850 3975 0.000 0.000 3 2 0 1 0 7 50 0 -1 0.000 0 1 0 2 0 0 1.00 75.00 105.00 2850 4350 2850 4650 0.000 0.000 3 2 0 1 0 7 50 0 -1 0.000 0 1 0 3 0 0 1.00 75.00 105.00 5252 5509 7081 5488 7950 5025 0.000 -1.000 0.000 3 2 0 1 0 7 50 0 -1 0.000 0 1 0 2 0 0 1.00 75.00 105.00 1800 4159 2175 4159 0.000 0.000 3 2 0 1 0 7 50 0 -1 0.000 0 1 0 4 0 0 1.00 75.00 105.00 900 4350 2250 6825 6450 6900 8250 5025 0.000 -1.000 -1.000 0.000 3 2 0 1 0 7 50 0 -1 0.000 0 1 0 3 0 0 1.00 75.00 105.00 1050 4350 1383 5544 2174 6195 0.000 -1.000 0.000 3 2 0 1 0 7 50 0 -1 0.000 0 1 0 3 0 0 1.00 75.00 105.00 3530 6195 6723 5964 8100 5025 0.000 -1.000 0.000 3 2 0 1 0 6 50 0 -1 0.000 0 1 0 4 0 0 1.00 75.00 105.00 5250 4950 6015 5311 7094 5318 7800 5025 0.000 -1.000 -1.000 0.000 3 2 0 1 0 7 50 0 -1 0.000 0 1 0 3 0 0 1.00 75.00 105.00 3524 4155 4125 4275 4500 4650 0.000 -1.000 0.000 3 2 0 5 0 7 50 0 -1 0.000 0 1 0 3 0 0 3.00 180.00 180.00 1350 4350 1672 4732 2183 4849 0.000 -1.000 0.000 3 2 0 5 0 7 50 0 -1 0.000 0 1 0 2 0 0 3.00 180.00 180.00 3530 4840 3905 4840 0.000 0.000 3 2 0 5 0 7 50 0 -1 0.000 0 1 0 2 0 0 3.00 180.00 180.00 5260 4840 5635 4840 0.000 0.000 3 2 0 5 0 7 50 0 -1 0.000 0 1 0 2 0 0 3.00 180.00 180.00 6979 4840 7354 4840 0.000 0.000 3 2 0 5 0 7 50 0 -1 0.000 0 1 0 2 0 0 3.00 180.00 180.00 8025 4650 8025 4350 0.000 0.000 4 1 0 50 0 0 10 0.0000 6 135 825 1125 4200 \\code{Group}\001 4 1 0 50 0 0 10 0.0000 6 135 990 2850 3525 \\code{Function}\001 4 1 0 50 0 0 10 0.0000 6 135 1110 2850 4200 \\code{Constraint}\001 4 1 0 50 0 0 10 0.0000 6 135 1320 2850 4875 \\code{FunctionSpace}\001 4 1 0 50 0 0 10 0.0000 6 135 945 2850 6225 \\code{Jacobian}\001 4 1 0 50 0 0 10 0.0000 6 135 1140 4575 5550 \\code{Integration}\001 4 1 0 50 0 0 10 0.0000 6 135 1230 4575 4875 \\code{Formulation}\001 4 1 0 50 0 0 10 0.0000 6 135 1125 6300 4875 \\code{Resolution}\001 4 1 0 50 0 0 10 0.0000 6 135 1335 8025 4200 \\code{PostOperation}\001 4 1 0 50 0 0 10 0.0000 6 135 1380 8025 4875 \\code{PostProcessing}\001 getdp-2.7.0-source/doc/texinfo/cmake_options.texi000644 001750 001750 00000003557 12453526374 023575 0ustar00geuzainegeuzaine000000 000000 @item ENABLE_ARPACK Enable Arpack eigensolver (requires Fortran) (default: ON) @item ENABLE_CONTRIB_ARPACK Enable Arpack eigensolver from GetDP's contrib folder (requires Fortran) (default: OFF) @item ENABLE_BLAS_LAPACK Enable BLAS/Lapack for linear algebra (e.g. for Arpack) (default: ON) @item ENABLE_BUILD_LIB Enable 'lib' target for building static GetDP library (default: OFF) @item ENABLE_BUILD_SHARED Enable 'shared' target for building shared GetDP library (default: OFF) @item ENABLE_BUILD_DYNAMIC Enable dynamic GetDP executable (linked with shared lib) (default: OFF) @item ENABLE_BUILD_ANDROID Enable Android NDK library target (experimental) (default: OFF) @item ENABLE_BUILD_IOS Enable iOS (ARM) library target (experimental) (default: OFF) @item ENABLE_FORTRAN Enable Fortran (needed for Arpack/Sparskit/Zitsol & Bessel) (default: ON) @item ENABLE_GMSH Enable Gmsh functions (for field interpolation) (default: ON) @item ENABLE_GSL Enable GSL functions (for some built-in functions) (default: ON) @item ENABLE_LEGACY Use legacy assembler (required for actual computations) (default: ON) @item ENABLE_MPI Enable MPI parallelization (with PETSc/SLEPc) (default: OFF) @item ENABLE_MULTIHARMONIC Enable multi-harmonic support (default: OFF) @item ENABLE_NR Enable NR functions (if GSL is unavailable) (default: ON) @item ENABLE_NX Enable proprietary NX extension (default: OFF) @item ENABLE_OCTAVE Enable Octave functions (default: ON) @item ENABLE_OPENMP Enable OpenMP parallelization of some functions (experimental) (default: OFF) @item ENABLE_PETSC Enable PETSc linear solver (default: ON) @item ENABLE_PYTHON Enable Python functions (default: ON) @item ENABLE_SLEPC Enable SLEPc eigensolver (default: ON) @item ENABLE_SPARSKIT Enable Sparskit solver instead of PETSc (requires Fortran) (default: ON) @item ENABLE_ZITSOL Enable Zitsol solvers (requires PETSc and Fortran) (default: OFF) getdp-2.7.0-source/doc/texinfo/getdp.texi000644 001750 001750 00000675163 12617441401 022042 0ustar00geuzainegeuzaine000000 000000 \input texinfo.tex @c -*-texinfo-*- @c GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege @c @c See the LICENSE.txt file for license information. Please report all @c bugs and problems to the public mailing list . @c @c ========================================================================= @c @c This is the GetDP documentation texinfo source file @c @c Things to do -> "Ctrl+s todo:" @c @c Indexing: @cindex = concept index, e.g. "Numerical tools, overview" @c @vindex = (metasyntactic) variable index, e.g. "constraint-type" @c /@tindex = type index (=frozen syntax ossature), e.g. "DefineGroup" @c \@findex = function index (=all types in the objects), e.g. "Curl" @c @c Before release, run C-u C-c C-u C-a in GNU Emacs @c This updates all node pointers and menus @c @c ========================================================================= @c %**start of header @setfilename getdp.info @set GETDP-VERSION 2.7 @set COPYRIGHT @copyright{} 1997-2015 P. Dular and C. Geuzaine, University of Liege @settitle GetDP @value{GETDP-VERSION} @footnotestyle separate @setchapternewpage odd @paragraphindent 0 @finalout @c %**end of header @c merge function index into type index @syncodeindex fn tp @c ========================================================================= @c Info directives @c ========================================================================= @ifinfo @dircategory Math @direntry * GetDP: (getdp). General finite element solver @end direntry @noindent This is the @cite{GetDP Reference Manual} for GetDP @value{GETDP-VERSION} (@today{}). @noindent Copyright @value{COPYRIGHT}. @end ifinfo @c ========================================================================= @c Title page @c ========================================================================= @shorttitlepage GetDP @titlepage @title GetDP Reference Manual @subtitle The documentation for GetDP @value{GETDP-VERSION} @subtitle A General environment for the treatment of Discrete Problems @subtitle @subtitle @today{} @author Patrick Dular @author Christophe Geuzaine @page @vskip 0pt plus 1filll Copyright @value{COPYRIGHT} @sp 1 University of Li@`ege @* Department of Electrical Engineering @* Institut d'@'Electricit@'e Montefiore @* Sart Tilman Campus, Building B28 @* B-4000 Li@`ege @* BELGIUM @sp 1 Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice are preserved on all copies. @end titlepage @c ========================================================================= @c Table of contents @c ========================================================================= @ifnothtml @summarycontents @end ifnothtml @contents @c ========================================================================= @c Top node (for all output, except TeX) @c ========================================================================= @ifnottex @node Top, Obtaining GetDP, (dir), (dir) @top GetDP Patrick Dular and Christophe Geuzaine GetDP is a general finite element solver that uses mixed finite elements to discretize de Rham-type complexes in one, two and three dimensions. This is the @cite{GetDP Reference Manual} for GetDP @value{GETDP-VERSION} (@today{}). @end ifnottex @c ========================================================================= @c Master menu @c ========================================================================= @menu * Obtaining GetDP:: * Copying conditions:: Terms and conditions of use. * Overview:: What is GetDP? * How to Read this Manual:: Which parts of this manual should you read? * Running GetDP:: How to run GetDP on your machine. * Expressions:: Definition of basic expressions in GetDP. * Objects:: Definition of the 10 GetDP objects. * Types for objects:: Definition of all available types for the 10 objects. * Short examples:: Simple object examples. * Complete examples:: Some simple complete examples. * File formats:: Input and output file formats. * Gmsh examples:: Sample Gmsh input files. * Compiling the source code:: Information on how to comile GetDP from source * Frequently asked questions:: The GetDP FAQ * Tips and tricks:: Some tips to make your life easier with GetDP. * Version history:: Changelog * Copyright and credits:: Copyright information and list of contributors * License:: Complete copy of the license. * Concept index:: Index of concepts. * Metasyntactic variable index:: Index of metasyntactic variables used in this manual. * Syntax index:: Index of reserved keywords in the GetDP language. @ifnothtml @detailmenu --- The Detailed Node Listing --- Overview * Numerical tools as objects:: * Which problems can GetDP actually solve?:: * Bug reports:: How to read this manual * Syntactic rules:: Expressions * Comments:: * Includes:: * Expression definition:: * Constants:: * Operators:: * Functions:: * Current values:: * Arguments:: * Run-time variables and registers:: * Fields:: * Macros loops and conditionals:: Expressions definition * Operators:: * Constants:: * Functions:: * Current values:: * Fields:: Operators * Operator types:: * Evaluation order:: Objects * Group:: * Function:: * Constraint:: * FunctionSpace:: * Jacobian:: * Integration:: * Formulation:: * Resolution:: * PostProcessing:: * PostOperation:: Types for objects * Types for Group:: * Types for Function:: * Types for Constraint:: * Types for FunctionSpace:: * Types for Jacobian:: * Types for Integration:: * Types for Formulation:: * Types for Resolution:: * Types for PostProcessing:: * Types for PostOperation:: Types for @code{Function} * Math functions:: * Extended math functions:: * Green functions:: * Type manipulation functions:: * Coordinate functions:: * Miscellaneous functions:: Short examples * Constant expression examples:: * Group examples:: * Function examples:: * Constraint examples:: * FunctionSpace examples:: * Jacobian examples:: * Integration examples:: * Formulation examples:: * Resolution examples:: * PostProcessing examples:: * PostOperation examples:: @code{FunctionSpace} examples * Conform space:: * High order space:: * Global values:: * Curl-conform space:: * Gauge condition:: * Coupled spaces:: * Multiply connected domains:: @code{Formulation} examples * Electrostatics:: * Electrostatics 2:: * Magnetostatics:: * Magnetodynamics:: * Other formulations:: @code{Resolution} examples * Static resolution:: * Frequency domain resolution:: * Time domain resolution:: * Nonlinear resolution:: * Coupled formulations:: Complete examples * Electrostatic problem:: * Magnetostatic problem:: * Magnetodynamic problem:: File formats * Input file format:: * Output file format:: Output file format * File pre:: * File res:: Frequently asked questions * The basics:: * Installation:: * Usage:: @end detailmenu @end ifnothtml @end menu @c ========================================================================= @c Obtaining GetDP @c ========================================================================= @node Obtaining GetDP, Copying conditions, Top, Top @unnumbered Obtaining GetDP @cindex Web site @cindex Internet address @cindex Download The source code and various pre-compiled versions of GetDP (for Windows, Linux and MacOS) can be downloaded from @uref{http://geuz.org/getdp}. If you use GetDP, we would appreciate that you mention it in your work. References and the latest news about GetDP are always available on @url{http://geuz.org/getdp}. @c ========================================================================= @c Copying Conditions @c ========================================================================= @node Copying conditions, Overview, Obtaining GetDP, Top @unnumbered Copying conditions @cindex Copyright @cindex License @cindex Web site @cindex Internet address @cindex Mailing list @cindex Download GetDP is ``free software''; this means that everyone is free to use it and to redistribute it on a free basis. GetDP is not in the public domain; it is copyrighted and there are restrictions on its distribution, but these restrictions are designed to permit everything that a good cooperating citizen would want to do. What is not allowed is to try to prevent others from further sharing any version of GetDP that they might get from you. Specifically, we want to make sure that you have the right to give away copies of GetDP, that you receive source code or else can get it if you want it, that you can change GetDP or use pieces of GetDP in new free programs, and that you know you can do these things. To make sure that everyone has such rights, we have to forbid you to deprive anyone else of these rights. For example, if you distribute copies of GetDP, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. Also, for our own protection, we must make certain that everyone finds out that there is no warranty for GetDP. If GetDP is modified by someone else and passed on, we want their recipients to know that what they have is not what we distributed, so that any problems introduced by others will not reflect on our reputation. The precise conditions of the license for GetDP are found in the General Public License that accompanies the source code (@pxref{License}). Further information about this license is available from the GNU Project webpage @uref{http://www.gnu.org/copyleft/gpl-faq.html}. Detailed copyright information can be found in @ref{Copyright and credits}. If you want to integrate parts of GetDP into a closed-source software, or want to sell a modified closed-source version of GetDP, you will need to obtain a different license. Please @uref{http://geuz.org, contact us directly} for more information. @c ========================================================================= @c Overview @c ========================================================================= @node Overview, How to Read this Manual, Copying conditions, Top @chapter Overview @cindex Introduction @cindex Overview GetDP (a ``General environment for the treatment of Discrete Problems'') is a scientific software environment for the numerical solution of integro-differential equations, open to the coupling of physical problems (electromagnetic, thermal, etc.) as well as of numerical methods (finite element method, integral methods, etc.). It can deal with such problems of various dimensions (1D, 2D or 3D) and time states (static, transient or harmonic). The main feature of GetDP is the closeness between its internal structure (written in C), the organization of data defining discrete problems (written by the user in ASCII data files) and the symbolic mathematical expressions of these problems. Its aim is to be welcoming and of easy use for both development and application levels: it consists of a working environment in which the definition of any problem makes use of a limited number of objects, which makes the environment structured and concise. It therefore gives researchers advanced developing tools and a large freedom in adding new functionalities. The modeling tools provided by GetDP can be tackled at various levels of complexity: this opens the software to a wide range of activities, such as research, collaboration, education, training and industrial studies. @c ------------------------------------------------------------------------- @c Numerical Tools as Objects @c ------------------------------------------------------------------------- @menu * Numerical tools as objects:: * Which problems can GetDP actually solve?:: * Bug reports:: @end menu @node Numerical tools as objects, Which problems can GetDP actually solve?, Overview, Overview @section Numerical tools as objects @cindex Objects, dependences @cindex Dependences, objects @cindex Linking, objects @cindex Tools, order of definition @cindex Philosophy, general @cindex Processing cycle An assembly of computational tools (or objects) in GetDP leads to a problem definition structure, which is a transcription of the mathematical expression of the problem, and forms a text data file: the equations describing a phenomenon, written in a mathematical form adapted to a chosen numerical method, directly constitute data for GetDP. The resolution of a discrete problem with GetDP requires the definition, in a text data file, of the GetDP objects listed (together with their dependencies) in the following figure and table. @image{objects-wrap,13.5cm,} @sp 1 @example Group @var{---} Function Group Constraint Group, Function, (Resolution) FunctionSpace Group, Constraint, (Formulation), (Resolution) Jacobian Group Integration @var{---} Formulation Group, Function, (Constraint), FunctionSpace, Jacobian, Integration Resolution Function, Formulation PostProcessing Group, Function, Jacobian, Integration, Formulation, Resolution PostOperation Group, PostProcessing @end example @sp 1 The gathering of all these objects constitutes the problem definition structure, which is a copy of the formal mathematical formulation of the problem. Reading the first column of the table from top to bottom pictures the working philosophy and the linking of operations peculiar to GetDP, from group definition to results visualization. The decomposition highlighted in the figure points out the separation between the objects defining the method of resolution, which may be isolated in a ``black box'' (bottom) and those defining the data peculiar to a given problem (top). The computational tools which are in the center of a problem definition structure are formulations (@code{Formulation}) and function spaces (@code{FunctionSpace}). Formulations define systems of equations that have to be built and solved, while function spaces contain all the quantities, i.e., functions, fields of vectors or covectors, known or not, involved in formulations. Each object of a problem definition structure must be defined before being referred to by others. A linking which always respects this property is the following: it first contains the objects defining particular data of a problem, such as geometry, physical characteristics and boundary conditions (i.e., @code{Group}, @code{Function} and @code{Constraint}) followed by those defining a resolution method, such as unknowns, equations and related objects (i.e., @code{Jacobian}, @code{Integration}, @code{FunctionSpace}, @code{Formulation}, @code{Resolution} and @code{PostProcessing}). The processing cycle ends with the presentation of the results (i.e., lists of numbers in various formats), defined in @code{PostOperation} fields. This decomposition points out the possibility of building black boxes, containing objects of the second group, adapted to treatment of general classes of problems that share the same resolution methods. @c ------------------------------------------------------------------------- @c Which Problems can GetDP actually solve? @c ------------------------------------------------------------------------- @node Which problems can GetDP actually solve?, Bug reports, Numerical tools as objects, Overview @section Which problems can GetDP actually solve? @cindex Scope of GetDP @cindex Future developments @cindex Developments, future @cindex Physical problems @cindex Method of Moments @cindex Finite Element Method @cindex Integral Equation Method @cindex Boundary Element Method @cindex Finite Difference Method @cindex Finite Volume Method @cindex Electromagnetism @cindex Mechanics @cindex Thermics The preceding explanations may seem very (too) general. Which are the problems that GetDP can actually solve? To answer this question, here is a list of methods that we have considered and coupled until now: @table @asis @item Numerical methods finite element method@* boundary element method (experimental, undocumented)@* volume integral methods (experimental, undocumented) @item Geometrical models one-dimensional models (1D)@* two-dimensional models (2D), plane and axisymmetric@* three-dimensional models (3D) @item Time states static states@* sinusoidal and harmonic states@* transient states@* eigenvalue problems @end table These methods have been successfully applied to build coupled physical models involving electromagnetic phenomena (magnetostatics, magnetodynamics, electrostatics, electrokinetics, electrodynamics, wave propagation, lumped electric circuits), acoustic phenomena, thermal phenomena and mechanical phenomena (elasticity, rigid body movement). As can be guessed from the preceding list, GetDP has been initially developed in the field of computational electromagnetics, which fully uses all the offered coupling features. We believe that this does not interfere with the expected generality of the software because a particular modeling forms a problem definition structure which is totally external to the software: GetDP offers computational tools; the user freely applies them to define and solve his problem. Nevertheless, specific numerical tools will @emph{always} need to be implemented to solve specific problems in areas other than those mentionned above. If you think the general phisosophy of GetDP is right for you and your problem, but you discover that GetDP lacks the tools necessary to handle it, let us know: we would love to discuss it with you. For example, at the time of this writing, many areas of GetDP would need to be improved to make GetDP as useful for computational mechanics or computational fluid dynamics as it is for computational electromagnetics... So if you have the skills and some free time, feel free to join the project: we gladly accept all code contributions! @c ------------------------------------------------------------------------- @c Bug reports @c ------------------------------------------------------------------------- @node Bug reports, , Which problems can GetDP actually solve?, Overview @section Bug reports @cindex Bugs, reporting @cindex Reporting bugs @cindex Contact information @cindex Mailing list @cindex Authors, e-mail @cindex E-mail, authors If you think you have found a bug in GetDP, you can report it by electronic mail to the GetDP mailing list at @email{getdp@@geuz.org}, or file it directly into our bug tracking system at @url{https://geuz.org/trac/getdp/report} (login: getdp, password: getdp). Please send as precise a description of the problem as you can, including sample input files that produce the bug (problem definition and mesh files). Don't forget to mention both the version of GetDP and the version of your operation system (@pxref{Running GetDP} to see how to get this information). See @ref{Frequently asked questions}, and the bug tracking system to see which problems we already know about. @c ========================================================================= @c How to Read this Manual @c ========================================================================= @node How to Read this Manual, Running GetDP, Overview, Top @chapter How to read this manual @cindex Reading, guidelines After reading @ref{Overview}, which depicts the general philosophy of GetDP, you might want to skip @ref{Expressions}, @ref{Objects} and @ref{Types for objects} and directly run the demo files bundled in the distribution on your computer (@pxref{Running GetDP}). You should then open these examples with a text editor and compare their structure with the examples given in @ref{Short examples} and @ref{Complete examples}. For each new syntax element that you fall onto, you can then go back to @ref{Expressions}, @ref{Objects}, and @ref{Types for objects}, and find in these chapters the detailed description of the syntactic rules as well as all the available options. Indexes for many concepts (@pxref{Concept index}) and for all the syntax elements (@pxref{Syntax index}) are available at the end of this manual. @c ------------------------------------------------------------------------- @c Syntactic Rules Used in this Document @c ------------------------------------------------------------------------- @menu * Syntactic rules:: @end menu @node Syntactic rules, , How to Read this Manual, How to Read this Manual @section Syntactic rules used in this document @cindex Syntax, rules @cindex Rules, syntactic @cindex Document syntax @vindex @dots{} @vindex <, > @vindex | @vindex : @vindex @var{etc} Here are the rules we tried to follow when writing this user's guide. Note that metasyntactic variable definitions stay valid throughout all the manual (and not only in the sections where the definitions appear). See @ref{Metasyntactic variable index}, for an index of all metasyntactic variables. @enumerate @item Keywords and literal symbols are printed like @code{this}. @item Metasyntactic variables (i.e., text bits that are not part of the syntax, but stand for other text bits) are printed like @var{this}. @item A colon (@code{:}) after a metasyntactic variable separates the variable from its definition. @item Optional rules are enclosed in @code{<} @code{>} pairs. @item Multiple choices are separated by @code{|}. @item Three dots (@dots{}) indicate a possible repetition of the preceding rule. @item For conciseness, the notation @code{@var{rule} <, @var{rule} > @dots{}} is replaced by @code{@var{rule} <,@dots{}>}. @item The @var{etc} symbol replaces nonlisted rules. @end enumerate @c ========================================================================= @c Running GetDP @c ========================================================================= @node Running GetDP, Expressions, How to Read this Manual, Top @chapter Running GetDP @cindex Operating system @cindex Platforms @cindex Command line options @cindex Options, command line @cindex Running GetDP GetDP has no graphical interface@footnote{If you are looking for a graphical front-end to GetDP, you may consider using Gmsh (available at @url{http://geuz.org/gmsh}). Gmsh permits to construct geometries, generate meshes, launch computations and visualize results directly from within a user-friendly graphical interface. The file formats used by Gmsh for mesh generation and post-processing are the default file formats accepted by GetDP (see @ref{Input file format}, and @ref{Types for PostOperation}).}. It is a command-line driven program that reads a problem definition file once at the beginning of the processing. This problem definition file is a regular ASCII text file (@pxref{Numerical tools as objects}), hence created with whatever text editor you like. If you just type the program name at your shell prompt (without any argument), you will get a short help on how to run GetDP. All GetDP calls look like @example getdp @var{filename} @var{options} @end example @noindent where @var{filename} is the ASCII file containing the problem definition, i.e., the structures this user's guide has taught you to create. This file can include other files (@pxref{Includes}), so that only one problem definition file should always be given on the command line. The input files containing the problem definition structure are usually given the @file{.pro} extension (if so, there is no need to specify the extension on the command line). The name of this file (without the extension) is used as a basis for the creation of intermediate files during the pre-processing and the processing stages. The @var{options} are a combination of the following commands (in any order): @ftable @code @item -pre @var{resolution-id} Performs the pre-processing associated with the resolution @var{resolution-id}. In the pre-processing stage, GetDP creates the geometric database (from the mesh file), identifies the degrees of freedom (the unknowns) of the problem and sets up the constraints on these degrees of freedom. The pre-processing creates a file with a @file{.pre} extension. If @var{resolution-id} is omitted, the list of available choices is displayed. @item -cal Performs the processing. This requires that a pre-processing has been performed previously, or that a @code{-pre} option is given on the same command line. The performed resolution is the one given as an argument to the @code{-pre} option. In the processing stage, GetDP executes all the commands given in the @code{Operation} field of the selected @code{Resolution} object (such as matrix assemblies, system resolutions, @dots{}). @item -pos @var{post-operation-id} @dots{} Performs the operations in the @code{PostOperation}(s) selected by the @var{post-operation-id}(s). This requires that a processing has been performed previously, or that a @code{-cal} option is given on the same command line. If @var{post-operation-id} is omitted, the list of available choices is displayed. @item -msh @var{filename} Reads the mesh (in @code{.msh} format) from @var{filename} (@pxref{File formats}) rather than from the default problem file name (with the @file{.msh} extension appended). @item -gmshread @var{filename} @dots{} Read gmsh data files (same as GmshRead in @code{Resolution} operations). Allows to use such datasets outside resolutions (e.g. in pre-processing). @item -split Saves processing results in separate files (one for each timestep). @item -res @var{filename} @dots{} Loads processing results from file(s). @item -name @var{string} Uses @var{string} as the default generic file name for input or output of mesh, pre-processing and processing files. @item -restart Restarts processing of a time stepping resolution interrupted before being complete. @item -solve @var{resolution-id} Same as @code{-pre @var{resolution-id} -cal}. @item -solver @var{filename} Specifies a solver option file (whose format varies depending on the linear algebra toolkit used). @item -slepc Uses SLEPc instead of Arpack as eigensolver. @item -adapt @var{file} Reads adaptation constraints from file. @item -order @var{real} Specifies the maximum interpolation order. @item -cache Caches network computations to disk. @item -bin Selects binary format for output files. @item -v2 Creates mesh-based Gmsh output files when possible. @item -check Lets you check the problem structure interactively. @item -v @itemx -verbose @var{integer} Sets the verbosity level. A value of 0 means that no information will be displayed during the processing. @item -p @itemx -progress @var{integer} Sets the progress update rate. This controls the refreshment rate of the counter indicating the progress of the current computation (in %). @item -onelab @var{name} <@var{address}> Communicates with OneLab (file or server address) @item -setnumber @var{name} @var{value} Sets constant number @var{name} to @var{value} @item -setstring @var{name} @var{value} Sets constant string @var{name} to @var{value} @item -info Displays the version information. @item -version Displays the version number. @item -help Displays a message listing basic usage and available options. @end ftable @c ========================================================================= @c Expressions @c ========================================================================= @node Expressions, Objects, Running GetDP, Top @chapter Expressions This chapter and the next two describe in a rather formal way all the commands that can be used in the ASCII text input files. If you are just beginning to use GetDP, or just want to see what GetDP is all about, you should skip this chapter and the next two for now, have a quick look at @ref{Running GetDP}, and run the demo problems bundled in the distribution on your computer. You should then open the @file{.pro} files in a text editor and compare their structure with the examples given in @ref{Short examples} and @ref{Complete examples}. Once you have a general idea of how the files are organized, you might want to come back here to learn more about the specific syntax of all the objects, and all the available options. @menu * Comments:: * Includes:: * Expression definition:: * Constants:: * Operators:: * Functions:: * Current values:: * Arguments:: * Run-time variables and registers:: * Fields:: * Macros loops and conditionals:: @end menu @c ------------------------------------------------------------------------- @c Comments @c ------------------------------------------------------------------------- @node Comments, Includes, Expressions, Expressions @section Comments @cindex Comments @cindex File, comment @tindex /*, */ @tindex // Both C and C++ style comments are supported and can be used in the input data files to comment selected text regions: @enumerate @item the text region comprised between @code{/*} and @code{*/} pairs is ignored; @item the rest of a line after a double slash @code{//} is ignored. @end enumerate Comments cannot be used inside double quotes or inside GetDP keywords. @c ------------------------------------------------------------------------- @c Includes @c ------------------------------------------------------------------------- @node Includes, Expression definition, Comments, Expressions @section Includes @cindex Includes @cindex File, include @tindex Include @tindex #include An input data file can be included in another input data file by placing one of the following commands (@var{expression-char} represents a file name) on a separate line, outside the GetDP objects. Any text placed after an include command on the same line is ignored. @example @code{Include @var{expression-char}} @code{#include @var{expression-char}} @end example See @ref{Constants}, for the definition of the character expression @var{expression-char}. @c ------------------------------------------------------------------------- @c Definition @c ------------------------------------------------------------------------- @node Expression definition, Constants, Includes, Expressions @section Expressions definition @cindex Expression, definition @vindex @var{expression} @vindex @var{expression-list} Expressions are the basic tool of GetDP. They cover a wide range of functional expressions, from constants to formal expressions containing functions (built-in or user-defined, depending on space and time, etc.), arguments, discrete quantities and their associated differential operators, etc. Note that `white space' (spaces, tabs, new line characters) is ignored inside expressions (as well as inside all GetDP objects). Expressions are denoted by the metasyntactic variable @var{expression} (remember the definition of the syntactic rules in @ref{Syntactic rules}): @example @var{expression}: ( @var{expression} ) | @var{integer} | @var{real} | @var{constant-id} | @var{quantity} | @var{argument} | @var{current-value} | @var{variable-set} | @var{variable-get} | @var{register-set} | @var{register-get} | @var{operator-unary} @var{expression} | @var{expression} @var{operator-binary} @var{expression} | @var{expression} @var{operator-ternary-left} @var{expression} @var{operator-ternary-right} @var{expression} | @var{built-in-function-id} [ < @var{expression-list} > ] < @{ @var{expression-cst-list} @} > | @var{function-id} [ < @var{expression-list} > ] | < Real | Complex > [ @var{expression} ] | Dt [ @var{expression} ] | AtAnteriorTimeStep [ @var{expression}, @var{integer} ] | Order [ @var{quantity} ] | Trace [ @var{expression}, @var{group-id} ] | @var{expression} ##@var{integer} @end example @noindent The following sections introduce the quantities that can appear in expressions, i.e., constant terminals (@var{integer}, @var{real}) and constant expression identifiers (@var{constant-id}, @var{expression-cst-list}), discretized fields (@var{quantity}), arguments (@var{argument}), current values (@var{current-value}), register values (@var{register-set}, @var{register-get}), operators (@var{operator-unary}, @var{operator-binary}, @var{operator-ternary-left}, @var{operator-ternary-right}) and built-in or user-defined functions (@var{built-in-function-id}, @var{function-id}). The last seven cases in this definition permit to cast an expression as real or complex, get the time derivative or evaluate an expression at an anterior time step, retrieve the interpolation order of a discretized quantity, evaluate the trace of an expression, and print the value of an expression for debugging purposes. List of expressions are defined as: @example @var{expression-list}: @var{expression} <,@dots{}> @end example @menu * Operators:: * Constants:: * Functions:: * Current values:: * Fields:: @end menu @c ------------------------------------------------------------------------- @c Constants @c ------------------------------------------------------------------------- @node Constants, Operators, Expression definition, Expressions @section Constants @cindex Constant, definition @cindex Constant, evaluation @cindex Evaluation mechanism @cindex Integer numbers @cindex Real numbers @cindex Floating point numbers @cindex Numbers, real @cindex Numbers, integer @cindex String @tindex DefineConstant @tindex List @tindex ListAlt @tindex Pi @tindex 0D @tindex 1D @tindex 2D @tindex 3D @tindex = @tindex ~ @vindex @var{integer} @vindex @var{real} @vindex @var{string} @vindex @var{expression-cst} @vindex @var{expression-cst-list} @vindex @var{expression-cst-list-item} @vindex @var{constant-id} @vindex @var{constant-def} @vindex @var{string-id} @vindex @var{expression-char} @vindex @var{affectation} The three constant types used in GetDP are @var{integer}, @var{real} and @var{string}. These types have the same meaning and syntax as in the C or C++ programming languages. Besides general expressions (@var{expression}), purely constant expressions, denoted by the metasyntactic variable @var{expression-cst}, are also used: @example @var{expression-cst}: ( @var{expression-cst} ) | @var{integer} | @var{real} | @var{constant-id} | @var{operator-unary} @var{expression-cst} | @var{expression-cst} @var{operator-binary} @var{expression-cst} | @var{expression-cst} @var{operator-ternary-left} @var{expression-cst} @var{operator-ternary-right} @var{expression-cst} | @var{math-function-id} [ < @var{expression-cst-list} > ] | #@var{constant-id}() | @var{constant-id}(@var{expression-cst}) @end example List of constant expressions are defined as: @example @var{expression-cst-list}: @var{expression-cst-list-item} <,@dots{}> @end example @noindent with @example @var{expression-cst-list-item}: @var{expression-cst} | @var{expression-cst} : @var{expression-cst} | @var{expression-cst} : @var{expression-cst} : @var{expression-cst} | @var{constant-id} () | @var{constant-id} ( @{ @var{expression-cst-list} @} ) | List[ @var{constant-id} ] | ListAlt[ @var{constant-id}, @var{constant-id} ] | ListAlt[ @var{expression-cst-list-item}, @var{expression-cst-list-item} ] | LinSpace[ @var{expression-cst}, @var{expression-cst}, @var{expression-cst} ] | LogSpace[ @var{expression-cst}, @var{expression-cst}, @var{expression-cst} ] | - @var{expression-cst-list-item} | @var{expression-cst} * @var{expression-cst-list-item} | @var{expression-cst-list-item} * @var{expression-cst} | @var{expression-cst} / @var{expression-cst-list-item} | @var{expression-cst-list-item} / @var{expression-cst} | @var{expression-cst-list-item} ^ @var{expression-cst} | @var{expression-cst-list-item} + @var{expression-cst-list-item} | @var{expression-cst-list-item} - @var{expression-cst-list-item} | @var{expression-cst-list-item} * @var{expression-cst-list-item} | @var{expression-cst-list-item} / @var{expression-cst-list-item} | ListFromFile [ @var{expression-char} ] @end example The second case in this last definition permits to create a list containing the range of numbers comprised between the two @var{expression-cst}, with a unit incrementation step. The third case also permits to create a list containing the range of numbers comprised between the two @var{expression-cst}, but with a positive or negative incrementation step equal to the third @var{expression-cst}. The fourth and fifth cases permit to reference constant identifiers (@var{constant-id}s) of lists of constants and constant identifiers of sublists of constants (see below for the definition of constant identifiers) . The sixth case is a synonym for the fourth. The seventh case permits to create alternate lists: the arguments of @code{ListAlt} must be @var{constant-id}s of lists of constants of the same dimension. The result is an alternate list of these constants: first constant of argument 1, first constant of argument 2, second constant of argument 1, etc. These kinds of lists of constants are for example often used for function parameters (@pxref{Functions}). The next two cases permit to create linear and logarithmic lists of numbers, respectively. The remaining cases permit to apply arithmetic operators item-wise in lists. @code{ListFromFile} reads a list of numbers from a file. Contrary to a general @var{expression} which is evaluated at runtime (thanks to an internal stack mechanism), an @var{expression-cst} is completely evaluated during the syntactic analysis of the problem (when GetDP reads the @file{.pro} file). The definition of such constants or lists of constants with identifiers can be made outside or inside any GetDP object. The syntax for the definition of constants is: @example @var{affectation}: DefineConstant [ @var{constant-id} < = @var{expression-cst} > <,@dots{}> ]; | DefineConstant [ @var{constant-id} = @{ @var{expression-cst} , @var{onelab-options} @} <,@dots{}> ]; | DefineConstant [ @var{string-id} < = @var{string-def} > <,@dots{}> ]; | DefineConstant [ @var{string-id} = @{ @var{string-def} , @var{onelab-options} @} <,@dots{}> ]; | @var{constant-id} = @var{constant-def}; | @var{constant-id} = DefineNumber[ @var{constant-def}, @var{onelab-options} ]; @var{string-id} = @var{string-def}; | @var{string-id} = DefineString[ @var{string-def}, @var{onelab-options} ]; | Printf [ "@var{string}" ]; | Printf [ "@var{string}", @var{expression-cst-list} ]; | Read [ @var{constant-id} ] ; | Read [ @var{constant-id} , @var{expression-cst} ]; | Delete @var{constant-id}; @end example @noindent with @example @var{constant-id}: @var{string} | @var{string} ( @var{expression-cst-list} ) | @var{string} ~ @{ @var{expression-cst} @} <,@dots{}> @var{constant-def}: @var{expression-cst-list-item} | @{ @var{expression-cst-list} @} @var{string-id}: @var{string} | @var{string} ~ @{ @var{expression-cst} @} <,@dots{}> @var{string-def}: "@var{string}" | StrCat[ @var{expression-char} <,@dots{}> ] | Str[ @var{expression-char} <,@dots{}> ] @end example @noindent Notes: @enumerate @item Five constants are predefined in GetDP: @code{Pi} (3.1415926535897932), @code{0D} (0), @code{1D} (1), @code{2D} (2) and @code{3D} (3). @item When @code{~@{@var{expression-cst}@}} is appended to a string @var{string}, the result is a new string formed by the concatenation of @var{string}, @code{_} (an underscore) and the value of the @var{expression-cst}. This is most useful in loops (@pxref{Macros loops and conditionals}), where it permits to define unique strings automatically. For example, @example For i In @{1:3@} x~@{i@} = i; EndFor @end example is the same as @example x_1 = 1; x_2 = 2; x_3 = 3; @end example @item The assignment in @code{DefineConstant} (zero if no @var{expression-cst} is given) is performed only if @var{constant-id} has not yet been defined. This kind of explicit default definition mechanism is most useful in general problem definition structures making use of a large number of generic constants, functions or groups. When exploiting only a part of a complex problem definition structure, the default definition mechanism allows to define the quantities of interest only, the others being assigned a default value (that will not be used during the processing but that avoids the error messages produced when references to undefined quantities are made). When @var{onelab-options} are provided, the parameter is exchanged with the ONELAB server. See @uref{http://onelab.info/wiki/ONELAB_Syntax_for_Gmsh_and_GetDP} for more information. @item @code{DefineNumber} and @code{DefineString} allow to define a ONELAB parameter. In this case the affectation always takes place. @end enumerate See @ref{Constant expression examples}, as well as @ref{Function examples}, for some examples. Character expressions are defined as follows: @example @var{expression-char}: "@var{string}" | @var{string-id} | StrCat[ @var{expression-char} <,@dots{}> ] | Str[ @var{expression-char} <,@dots{}> ] StrChoice[ @var{expression}, @var{expression-char}, @var{expression-char} ] | UpperCase [ @var{expression-char} ] | Sprintf [ @var{expression-char} ] | Sprintf[ @var{expression-char}, @var{expression-cst-list} ] | Date | CurrentDirectory | CurrentDir | OnelabAction @end example @noindent @code{StrCat} and @code{Str} permit to concatenate character expressions (@code{Str} adds a newline character after each string except the last). @code{StrChoice} returns the first or second @var{expression-char} depending on the value of @var{expression}. @code{UpperCase} converts the @var{expression-char} to upper case. @code{Sprintf} is equivalent to the @code{sprintf} C function (where @var{expression-char} is a format string that can contain floating point formatting characters: @code{%e}, @code{%g}, etc.). @code{Date} permits to access the current date. @code{CurrentDirectory} and @code{CurrentDir} return the directory of the @code{.pro} file. @code{OnelabAction} returns the current ONELAB action (e.g. @code{check} or @code{compute}). @c ------------------------------------------------------------------------- @c Operators @c ------------------------------------------------------------------------- @node Operators, Functions, Constants, Expressions @section Operators @menu * Operator types:: * Evaluation order:: @end menu @c ......................................................................... @c Types @c ......................................................................... @node Operator types, Evaluation order, Operators, Operators @subsection Operator types The operators in GetDP are similar to the corresponding operators in the C or C++ programming languages. @cindex Operators, definition @cindex Unary operators @cindex Binary operators @cindex Ternary operators @vindex @var{operator-unary} @vindex @var{operator-binary} @vindex @var{operator-ternary-left} @vindex @var{operator-ternary-right} @tindex - @tindex ! @tindex + @tindex - @tindex * @tindex /\ @tindex / @tindex ^ @tindex % @tindex > @tindex < @tindex >= @tindex <= @tindex == @tindex != @tindex || @tindex && @tindex | @tindex & @tindex ?: @noindent @var{operator-unary}: @table @code @item - Unary minus. @item ! Logical not. @end table @noindent @var{operator-binary}: @table @code @item ^ Exponentiation. The evaluation of the both arguments must result in a scalar value. @item * Multiplication or scalar product, depending on the type of the arguments. @item /\ Cross product. The evaluation of both arguments must result in vectors. @item / Division. @item % Modulo. The evaluation of the second argument must result in a scalar value. @item + Addition. @item - Subtraction. @item == Equality. @item != Inequality. @item > Greater. The evaluation of both arguments must result in scalar values. @item >= Greater or equality. The evaluation of both arguments must result in scalar values. @item < Less. The evaluation of both arguments must result in scalar values. @item <= Less or equality. The evaluation of both arguments must result in scalar values. @item && Logical `and'. The evaluation of both arguments must result in scalar values. @item || Logical `or'. The evaluation of both arguments must result in floating point values. Warning: the logical `or' always (unlike in C or C++) implies the evaluation of both arguments. That is, the second operand of @code{||} is evaluated even if the first one is true. @item & Binary `and'. @item | Binary `or'. @end table @noindent @var{operator-ternary-left}: @table @code @item ? @end table @var{operator-ternary-right}: @table @code @item : The only ternary operator, formed by @var{operator-ternary-left} and @var{operator-ternary-right} is defined as in the C or C++ programming languages. The ternary operator first evaluates its first argument (the @var{expression-cst} located before the @code{?}), which must result in a scalar value. If it is true (non-zero) the second argument (located between @code{?} and @code{:}) is evaluated and returned; otherwise the third argument (located after @code{:}) is evaluated and returned. @end table @c ......................................................................... @c Evaluation @c ......................................................................... @node Evaluation order, , Operator types, Operators @subsection Evaluation order @cindex Evaluation, order @cindex Order of evaluation @cindex Operation, priorities @cindex Priorities, operations @tindex () The evaluation priorities are summarized below (from stronger to weaker, i.e., @code{^} has the highest evaluation priority). Parentheses @code{()} may be used anywhere to change the order of evaluation. @table @code @item ^ @item - (unary), ! @item | & @item /\ @item *, /, % @item +, - @item <, >, <=, >= @item !=, == @item &&, || @item ?: @end table @c ------------------------------------------------------------------------- @c Functions @c ------------------------------------------------------------------------- @node Functions, Current values, Operators, Expressions @section Functions @cindex Function, definition @cindex Built-in functions @cindex Piecewise functions @cindex Arguments @cindex Parameters @vindex @var{built-in-function-id} Two types of functions coexist in GetDP: user-defined functions (@var{function-id}, see @ref{Function}) and built-in functions (@var{built-in-function-id}, defined in this section). Both types of functions are always followed by a pair of brackets @code{[]} that can possibly contain arguments (@pxref{Arguments}). This makes it simple to distinguish a @var{function-id} or a @var{built-in-function-id} from a @var{constant-id}. As shown below, built-in functions might also have parameters, given between braces @code{@{@}}, and which are completely evaluated during the analysis of the syntax (since they are of @var{expression-cst-list} type): @example @var{built-in-function-id} [ < @var{expression-list} > ] < @{ @var{expression-cst-list} @} > @end example @noindent with @example @var{built-in-function-id}: @var{math-function-id} | @var{extended-math-function-id} | @var{green-function-id} | @var{type-function-id} | @var{coord-function-id} | @var{misc-function-id} @end example @noindent Notes: @enumerate @item All possible values for @var{built-in-function-id} are listed in @ref{Types for Function}. @item Classical mathematical functions (@pxref{Math functions}) are the only functions allowed in a constant definition (see the definition of @var{expression-cst} in @ref{Constants}). @end enumerate @c ------------------------------------------------------------------------- @c Current Values @c ------------------------------------------------------------------------- @node Current values, Arguments, Functions, Expressions @section Current values @cindex Current values @cindex Values, current @tindex $Time @tindex $DTime @tindex $Theta @tindex $TimeStep @tindex $Breakpoint @tindex $Iteration @tindex $EigenvalueReal @tindex $EigenvalueImag @tindex $X @tindex $XS @tindex $Y @tindex $YS @tindex $Z @tindex $ZS @tindex $A @tindex $B @tindex $C Current values return the current floating point value of an internal GetDP variable: @table @code @item $Time Value of the current time. This value is set to zero for non time dependent analyses. @item $DTime Value of the current time increment used in a time stepping algorithm. @item $Theta Current theta value in a theta time stepping algorithm. @item $TimeStep Number of the current time step in a time stepping algorithm. @item $Breakpoint In case of a breakpoint hit in TimeLoopAdaptive it is the number of the current breakpoint. In the other case when $Time corresponds not to a breakpoint the value is -1. @item $Iteration Number of the current iteration in a nonlinear loop. @item $EigenvalueReal Real part of the current eigenvalue. @item $EigenvalueImag Imaginary part of the current eigenvalue. @item $X, $XS Value of the current (destination or source) X-coordinate. @item $Y, $YS Value of the current (destination or source) Y-coordinate. @item $Z, $ZS Value of the current (destination or source) Z-coordinate. @item $A, $B, $C Value of the current parametric coordinates used in the parametric @code{OnGrid} @code{PostOperation} (@pxref{Types for PostOperation}). @end table @noindent Note: @enumerate @item The current X, Y and Z coordinates refer to the `physical world' coordinates, i.e., coordinates in which the mesh is expressed. @end enumerate Current values are ``read-only''. User-defined run-time variables, which share the same syntax but whose value can be changed in an @var{expression}, are defined in @ref{Run-time variables and registers}. @c ------------------------------------------------------------------------- @c Arguments @c ------------------------------------------------------------------------- @node Arguments, Run-time variables and registers, Current values, Expressions @section Arguments @cindex Arguments, definition @vindex @var{argument} @tindex $@var{integer} Function arguments can be used in expressions and have the following syntax (@var{integer} indicates the position of the argument in the @var{expression-list} of the function, starting from 1): @example @var{argument}: $@var{integer} @end example See @ref{Function}, and @ref{Function examples}, for more details. @c ------------------------------------------------------------------------- @c Run-time variables and registers @c ------------------------------------------------------------------------- @node Run-time variables and registers, Fields, Arguments, Expressions @section Run-time variables and registers @cindex Run-time variables, definition @cindex Registers, definition @vindex @var{variable-set} @vindex @var{variable-get} @vindex @var{register-set} @vindex @var{register-get} @tindex #@var{expression-cst} Constant expressions (@var{expression-cst}s) are evaluated only once during the analysis of the problem definition structure, cf.@: @ref{Constants}. While this is perfectly fine in most situations, sometimes it is necessary to store and modify variables at run-time. For example, an iteration in a @code{Resolution} could depend on values computed at run-time. Also, to speed-up the evaluation of @var{expression}s (which are evaluated at runtime through GetDP's internal stack mechanism), it can be useful to save some results in a temporary variable, at run-time, in order to reuse them later on. Two mechanisms exit to handle such cases: run-time variables (which follow the same syntax as @ref{Current values}), and registers. Run-time variables have the following syntax: @example @var{variable-set}: $@var{variable-id} = @var{expression} @var{variable-get}: $@var{variable-id} @var{variable-id}: @var{string} | @var{string} ~ @{ @var{expression-cst} @} <,@dots{}> @end example @noindent Thus, run-time variables can simply be defined anywhere in an @var{expression} and be reused later on. Current values can be seen as special cases of run-time variables, which are read-only. Registers have the following syntax: @example @var{register-set}: @var{expression}#@var{expression-cst} @var{register-get}: #@var{expression-cst} @end example @noindent Thus, to store any expression in the register 5, one should add @code{#5} directly after the expression. To reuse the value stored in this register, one simply uses @code{#5} instead of the expression it should replace. See @ref{Function examples}, for an example. @c ------------------------------------------------------------------------- @c Fields @c ------------------------------------------------------------------------- @node Fields, Macros loops and conditionals, Run-time variables and registers, Expressions @section Fields @cindex Fields @cindex Operators, differential @cindex Differential operators @cindex Discrete quantities @cindex Quantities, discrete @cindex Interpolation @cindex Gradient @cindex Curl @cindex Divergence @cindex Exterior derivative @cindex Derivative, exterior @vindex @var{quantity} @vindex @var{quantity-id} @vindex @var{quantity-dof} @vindex @var{quantity-operator} A discretized quantity (defined in a function space, cf.@: @ref{FunctionSpace}) is represented between braces @code{@{@}}, and can only appear in well-defined expressions in @code{Formulation} (@pxref{Formulation}) and @code{PostProcessing} (@pxref{PostProcessing}) objects: @example @var{quantity}: < @var{quantity-dof} > @{ < @var{quantity-operator} > @var{quantity-id} @} | @{ < @var{quantity-operator} > @var{quantity-id} @} [ @var{expression-cst-list} ] @end example @noindent with @example @var{quantity-id}: @var{string} | @var{string} ~ @{ @var{expression-cst} @} @end example @noindent and @noindent @var{quantity-dof}: @ftable @code @item Dof Defines a vector of discrete quantities (vector of @code{D}egrees @code{o}f @code{f}reedom), to be used only in @code{Equation} terms of formulations to define (elementary) matrices. Roughly said, the @code{Dof} symbol in front of a discrete quantity indicates that this quantity is an unknown quantity, and should therefore not be considered as already computed. An @code{Equation} term must be linear with respect to the @code{Dof}. Thus, for example, a nonlinear term like @example Galerkin @{ [ f[] * Dof@{T@}^4 , @{T@} ]; @dots{} @} @end example must first be linearized; and while @example Galerkin @{ [ f[] * Dof@{T@} , @{T@} ]; @dots{} @} Galerkin @{ [ -f[] * 12 , @{T@} ]; @dots{} @} @end example is valid, the following, which is affine but not linear, is not: @example Galerkin @{ [ f[] * (Dof@{T@} - 12) , @{T@} ]; @dots{} @} @end example GetDP supports two linearization techniques. The first is functional iteration (or Picard method), where one simply plugs the value obtained at the previous iteration into the nonlinear equation (the previous value is known, and is accessed e.g. with @code{@{T@}} instead @code{Dof@{T@}}). The second is the Newton-Raphson iteration, where the Jacobian is specified with a @code{JacNL} equation term (see @url{https://geuz.org/trac/getdp} for an example). @item BF Indicates that only a basis function will be used (only valid with basis functions associated with regions). @end ftable @noindent @var{quantity-operator}: @ftable @code @item d Exterior derivative (d): applied to a @var{p}-form, gives a (@var{p+1})-form. @item Grad Gradient: applied to a scalar field, gives a vector. @item Curl @itemx Rot Curl: applied to a vector field, gives a vector. @item Div Divergence (div): applied to a vector field, gives a scalar. @item D1 Applies the operator specified in the first argument of @code{dFunction @{ @var{basis-function-type}, @var{basis-function-type} @}} (@pxref{FunctionSpace}). This is currently only used for nodal-interpolated vector fields (interpolated with @code{BF_Node_X}, @code{BF_Node_Y}, @code{BF_Node_Z}) When the first @var{basis-function-type} in @code{dFunction} is set to @code{BF_NodeX_D1} for component X, @code{BF_NodeY_D1} for component Y and @code{BF_NodeZ_D1} for component Z, then @code{D1} applied to a vector [u_x, u_y, u_z] gives: @tex $$ \left[{{\partial u_x} \over {\partial x}}, {{\partial u_y} \over {\partial y}}, {{\partial u_z} \over {\partial z}}\right] $$ @end tex @ifnottex [du_x/dx, du_y/dy, du_z/dz] @end ifnottex Note that in this case specifying explicitely @code{dFunction} is not necessary, as @code{BF_NodeX_D1}, @code{BF_NodeY_D1} and @code{BF_NodeZ_D1} are assigned by default as the ``@code{D1} derivatives'' of @code{BF_NodeX}, @code{BF_NodeY} and @code{BF_NodeZ}. This also holds for @code{BF_GroupOfNodes_X}, @code{BF_GroupOfNodes_Y} and @code{BF_GroupOfNodes_Z}. When the first @var{basis-function-type} in @code{dFunction} is set to @code{BF_NodeX_D12} for component X and @code{BF_NodeY_D12} for component Y, then @code{D1} applied to a vector [u_x, u_y] gives: @tex $$ \left[{{\partial u_x} \over {\partial x}}, {{\partial u_y} \over {\partial y}}, {{\partial u_y} \over {\partial x}} + {{\partial u_x} \over {\partial y}}\right] $$ @end tex @ifnottex [du_x/dx, du_y/dy, du_y/dx + du_x/dy] @end ifnottex @noindent @noindent @item D2 Applies the operator specified in the second argument of @code{dFunction @{ @var{basis-function-type}, @var{basis-function-type} @}} (@pxref{FunctionSpace}). This is currently only used for nodal-interpolated vector fields (interpolated with @code{BF_Node_X}, @code{BF_Node_Y}, @code{BF_Node_Z}) More specifically, when the second @var{basis-function-type} is to @code{BF_NodeX_D2} for component X, @code{BF_NodeY_D2} for component Y and @code{BF_NodeZ_D2} for component Z, then @code{D2} applied to a vector [u_x, u_y, u_z] gives: @tex $$ \left[{{\partial u_y} \over {\partial x}} + {{\partial u_x} \over {\partial y}}, {{\partial u_z} \over {\partial y}} + {{\partial u_y} \over {\partial z}}, {{\partial u_x} \over {\partial z}} + {{\partial u_z} \over {\partial x}}\right] $$ @end tex @ifnottex [du_y/dx + du_x/dy, du_z/dy + du_y/dz, du_x/dz + du_z/dx] @end ifnottex Note that in this case specifying explicitely @code{dFunction} is not necessary, as @code{BF_NodeX_D2}, @code{BF_NodeY_D2} and @code{BF_NodeZ_D2} are assigned by default as the ``@code{D2} derivatives'' of @code{BF_NodeX}, @code{BF_NodeY} and @code{BF_NodeZ}. This also holds for @code{BF_GroupOfNodes_X}, @code{BF_GroupOfNodes_Y} and @code{BF_GroupOfNodes_Z}. @c This is very specific, and very rarely used @c @noindent @c @item dInv @c d^(-1): applied to a p-form, gives a (p-1)-form. @c @item GradInv @c Inverse grad: applied to a gradient field, gives a scalar. @c @item CurlInv @c @itemx RotInv @c Inverse curl: applied to a curl field, gives a vector. @c @item DivInv @c Inverse div: applied to a divergence field. @end ftable @noindent Notes: @enumerate @item While the operators @code{Grad}, @code{Curl} and @code{Div} can be applied to 0, 1 and 2-forms respectively, the exterior derivative operator @code{d} is usually preferred with such fields. @item The second case permits to evaluate a discretized quantity at a certain position X, Y, Z (when @var{expression-cst-list} contains three items) or at a specific time, N time steps ago (when @var{expression-cst-list} contains a single item). @end enumerate @c ------------------------------------------------------------------------- @c Macros, loops and conditionals @c ------------------------------------------------------------------------- @node Macros loops and conditionals, , Fields, Expressions @section Macros, loops and conditionals @cindex Macros @cindex Loops @cindex Conditionals @vindex @var{loop} Macros are defined as follows: @ftable @code @item Macro @var{string} | @var{expression-char} Begins the declaration of a user-defined macro named @var{string}. The body of the macro starts on the line after `@code{Macro @var{string}}', and can contain any GetDP command. @item Return Ends the body of the current user-defined macro. Macro declarations cannot be imbricated, and must be made outside any GetDP object. @end ftable Macros, loops and conditionals can be used in any of the following objects: Group, Function, Constraint (as well as in a contraint-case), FunctionSpace, Formulation (as well as in the quantity and equation defintions), Resolution (as well as resolution-term, system defintion and operations), PostProcessing (in the definition of the PostQuantities) and PostOperation (as well as in the operation list). @var{loop}: @ftable @code @item Call @var{string} | @var{expression-char}; Executes the body of a (previously defined) macro named @var{string}. @item For ( @var{expression-cst} : @var{expression-cst} ) Iterates from the value of the first @var{expression-cst} to the value of the second @var{expression-cst}, with a unit incrementation step. At each iteration, the commands comprised between `@code{For ( @var{expression-cst} : @var{expression-cst} )}' and the matching @code{EndFor} are executed. @item For ( @var{expression-cst} : @var{expression-cst} : @var{expression-cst} ) Iterates from the value of the first @var{expression-cst} to the value of the second @var{expression-cst}, with a positive or negative incrementation step equal to the third @var{expression-cst}. At each iteration, the commands comprised between `@code{For ( @var{expression-cst} : @var{expression-cst} : @var{expression-cst} )}' and the matching @code{EndFor} are executed. @item For @var{string} In @{ @var{expression-cst} : @var{expression-cst} @} Iterates from the value of the first @var{expression-cst} to the value of the second @var{expression-cst}, with a unit incrementation step. At each iteration, the value of the iterate is affected to an expression named @var{string}, and the commands comprised between `@code{For @var{string} In @{ @var{expression-cst} : @var{expression-cst} @}}' and the matching @code{EndFor} are executed. @item For @var{string} In @{ @var{expression-cst} : @var{expression-cst} : @var{expression-cst} @} Iterates from the value of the first @var{expression-cst} to the value of the second @var{expression-cst}, with a positive or negative incrementation step equal to the third @var{expression-cst}. At each iteration, the value of the iterate is affected to an expression named @var{string}, and the commands comprised between `@code{For @var{string} In @{ @var{expression-cst} : @var{expression-cst} : @var{expression-cst} @}}' and the matching @code{EndFor} are executed. @item EndFor Ends a matching @code{For} command. @item If ( @var{expression-cst} ) The body enclosed between `@code{If ( @var{expression-cst} )}' and the matching @code{ElseIf}, @code{Else} or @code{EndIf}, is evaluated if @var{expression-cst} is non-zero. @item ElseIf ( @var{expression-cst} ) The body enclosed between `@code{ElseIf ( @var{expression-cst} )}' and the next matching @code{ElseIf}, @code{Else} or @code{EndIf}, is evaluated if @var{expression-cst} is non-zero and none of the @var{expression-cst} of the previous matching codes @code{If} and @code{ElseIf} were non-zero. @item Else The body enclosed between @code{Else} and the matching @code{EndIf} is evaluated if none of the @var{expression-cst} of the previous matching codes @code{If} and @code{ElseIf} were non-zero. @item EndIf Ends a matching @code{If} command. @item TestLevel Variable equal to the level of imbrication of a body in an @code{If}-@code{EndIf} test. @end ftable @c ========================================================================= @c Objects @c ========================================================================= @node Objects, Types for objects, Expressions, Top @chapter Objects @cindex Objects, definition This chapter presents the formal definition of the ten GetDP objects mentioned in @ref{Overview}. To be concise, all the possible parameters for these objects are not given here (cf.@: the @var{etc} syntactic rule defined in @ref{Syntactic rules}). Please refer to @ref{Types for objects}, for the list of all available options. @menu * Group:: * Function:: * Constraint:: * FunctionSpace:: * Jacobian:: * Integration:: * Formulation:: * Resolution:: * PostProcessing:: * PostOperation:: @end menu @c ------------------------------------------------------------------------- @c Group @c ------------------------------------------------------------------------- @node Group, Function, Objects, Objects @section @code{Group}: defining topological entities @cindex Mesh @cindex Grid @cindex Discretized Geometry @cindex Group, definition @cindex Topology @cindex Entities, topological @cindex Region groups @cindex Function groups @cindex Tree @tindex Group @tindex DefineGroup @tindex = @vindex @var{group-id} @vindex @var{group-def} @vindex @var{group-type} @vindex @var{group-list} @vindex @var{group-list-item} @vindex @var{group-sub-type} Meshes (grids) constitute the input data of GetDP. All that is needed by GetDP as a mesh is a file containing a list of nodes (with their coordinates) and a list of geometrical elements with, for each one, a number characterizing its geometrical type (i.e., line, triangle, quadrangle, tetrahedron, hexahedron, prism, etc.), a number characterizing the physical region to which it belongs and the list of its nodes. This minimal input set should be easy to extract from most of the classical mesh file formats (@pxref{Input file format}, for a complete description of the mesh file format read by GetDP). Groups of geometrical entities of various types can be considered and are used in many objects. There are region groups, of which the entities are regions, and function groups, with nodes, edges, facets, volumes, groups of nodes, edges of tree, facets of tree, @dots{} of regions. Amongst region groups, elementary and global groups can be distinguished: elementary groups are relative to single regions (e.g., physical regions in which piecewise defined functions or constraints can be defined) while global groups are relative to sets of regions for which given treatments have to be performed (e.g., domain of integration, support of a function space, etc.). Groups of function type contain lists of entities built on some region groups (e.g., nodes for nodal elements, edges for edge elements, edges of tree for gauge conditions, groups of nodes for floating potentials, elements on one side of a surface for cuts, etc.). A definition of initially empty groups can be obtained thanks to a @code{DefineGroup} command, so that their identifiers exist and can be referred to in other objects, even if these groups are not explicitly defined. This procedure is similar to the @code{DefineConstant} procedure introduced for constants in @ref{Constants}. The syntax for the definition of groups is: @example Group @{ < DefineGroup [ @var{group-id} <@{@var{integer}@}> <,@dots{}> ]; > @dots{} < @var{group-id} = @var{group-def}; > @dots{} < @var{group-id} += @var{group-def}; > @dots{} < @var{affectation} > @dots{} < @var{loop} > @dots{} @} @end example @noindent with @example @var{group-id}: @var{string} | @var{string} ~ @{ @var{expression-cst} @} @var{group-def}: @var{group-type} [ @var{group-list} <, @var{group-sub-type} @var{group-list} > ] | @var{group-id} <@{<@var{integer}>@}> | #@var{group-list} @var{group-type}: Region | Global | NodesOf | EdgesOf | @var{etc} @var{group-list}: All | @var{group-list-item} | @{ @var{group-list-item} <,@dots{}> @} @var{group-list-item}: @var{integer} | @var{integer} : @var{integer} | @var{integer} : @var{integer} : @var{integer} | @var{group-id} <@{<@var{integer}>@}> @var{group-sub-type}: Not | StartingOn | OnOneSideOf | @var{etc} @end example @noindent Notes: @enumerate @item @var{integer} as a @var{group-list-item} is the only interface with the mesh; with each element is associated a region number, being this @var{integer}, and a geometrical type (@pxref{Input file format}). Ranges of integers can be specified in the same way as ranges of constant expressions in an @var{expression-cst-list-item} (@pxref{Constants}). For example, @code{@var{i}:@var{j}} replaces the list of consecutive integers @var{i}, @var{i}+1, @dots{}, @var{j}-1, @var{j}. @item Array of groups: @code{DefineGroup[@var{group-id}@{@var{n}@}]} defines the empty groups @code{@var{group-id}@{@var{i}@}}, @var{i}=1, @dots{}, n. Such a definition is optional, i.e., each @code{@var{group-id}@{@var{i}@}} can be separately defined, in any order. @item @code{#@var{group-list}} is an abbreviation of @code{Region[@var{group-list}]}. @end enumerate See @ref{Types for Group}, for the complete list of options and @ref{Group examples}, for some examples. @c ------------------------------------------------------------------------- @c Function @c ------------------------------------------------------------------------- @node Function, Constraint, Group, Objects @section @code{Function}: defining global and piecewise expressions @cindex Function, definition @cindex Piecewise functions @cindex User-defined functions @tindex Function @tindex DefineFunction @tindex = @vindex @var{function-id} A user-defined function can be global in space or piecewise defined in region groups. A physical characteristic is an example of a piecewise defined function (e.g., magnetic permeability, electric conductivity, etc.) and can be simply a constant, for linear materials, or a function of one or several arguments for nonlinear materials. Such functions can of course depend on space coordinates or time, which can be needed to express complex constraints. A definition of initially empty functions can be made thanks to the @code{DefineFunction} command so that their identifiers exist and can be referred to (but cannot be used) in other objects. The syntax for the definition of functions is: @example Function @{ < DefineFunction [ @var{function-id} <,@dots{}> ]; > @dots{} < @var{function-id} [ < @var{group-def} > ] = @var{expression}; > @dots{} < @var{affectation} > @dots{} < @var{loop} > @dots{} @} @end example @noindent with @example @var{function-id}: @var{string} @end example @noindent Note: @enumerate @item The optional @var{group-def} in brackets must be of @code{Region} type, and indicates on which region the (piecewise) function is defined. Warning: it is incorrect to write @code{f[reg1]=1; g[reg2]=f[]+1;} since the domains of definition of @code{f[]} and @code{g[]} don't match. @item One can also define initially empty functions inline by replacing the expression with @code{***}. @end enumerate See @ref{Types for Function}, for the complete list of built-in functions and @ref{Function examples}, for some examples. @c ------------------------------------------------------------------------- @c Constraint @c ------------------------------------------------------------------------- @node Constraint, FunctionSpace, Function, Objects @section @code{Constraint}: specifying constraints on function spaces and formulations @cindex Constraint, definition @cindex Circuit equations @cindex Boundary conditions @cindex Networks @tindex Constraint @tindex Name @tindex Type @tindex Case @tindex Region @tindex SubRegion @tindex TimeFunction @vindex @var{constraint-id} @vindex @var{constraint-type} @vindex @var{constraint-val} @vindex @var{constraint-case-id} @vindex @var{constraint-case-val} Constraints can be referred to in @code{FunctionSpace} objects to be used for boundary conditions, to impose global quantities or to initialize quantities. These constraints can be expressed with functions or be imposed by the pre-resolution of another discrete problem. Other constraints can also be defined, e.g., constraints of network type for the definition of circuit connections, to be used in @code{Formulation} objects. The syntax for the definition of constraints is: @example Constraint @{ @{ Name @var{constraint-id}; Type @var{constraint-type}; Case @{ @{ Region @var{group-def}; < Type @var{constraint-type}; > < SubRegion @var{group-def}; > < TimeFunction @var{expression}; > < RegionRef @var{group-def}; > < SubRegionRef @var{group-def}; > < Coefficient @var{expression}; > < Function @var{expression}; > < Filter @var{expression}; > @var{constraint-val}; @} @dots{} < @var{loop} > @dots{} @} | Case @var{constraint-case-id} @{ @{ Region @var{group-def}; < Type @var{constraint-type}; > @var{constraint-case-val}; @} @dots{} < @var{loop} > @dots{} @} @dots{} @} @dots{} < @var{affectation} > @dots{} < @var{loop} > @dots{} @} @end example @noindent with @example @var{constraint-id}: @var{constraint-case-id}: @var{string} | @var{string} ~ @{ @var{expression-cst} @} @var{constraint-type}: Assign | Init | Network | Link | @var{etc} @var{constraint-val}: Value @var{expression} | NameOfResolution @var{resolution-id} | @var{etc} @var{constraint-case-val}: Branch @{ @var{integer}, @var{integer} @} | @var{etc} @end example @noindent Notes: @enumerate @item The constraint type @var{constraint-type} defined outside the @code{Case} fields is applied to all the cases of the constraint, unless other types are explicitly given in these cases. The default type is @code{Assign}. @item The region type @code{Region @var{group-def}} will be the main @var{group-list} argument of the @var{group-def} to be built for the constraints of @code{FunctionSpace}s. The optional region type @code{SubRegion @var{group-def}} will be the argument of the associated @var{group-sub-type}. @item @var{expression} in @code{Value} of @var{constraint-val} cannot be time dependent (@code{$Time}) because it is evaluated only once during the pre-processing (for efficiency reasons). Time dependences must be defined in @code{TimeFunction @var{expression}}. @end enumerate See @ref{Types for Constraint}, for the complete list of options and @ref{Constraint examples}, for some examples. @c ------------------------------------------------------------------------- @c FunctionSpace @c ------------------------------------------------------------------------- @node FunctionSpace, Jacobian, Constraint, Objects @section @code{FunctionSpace}: building function spaces @cindex Function space, definition @cindex Discrete function spaces @cindex Spaces, discrete @cindex Approximation spaces @cindex Basis Functions @cindex Interpolation @cindex Hierarchical basis functions @tindex FunctionSpace @tindex Name @tindex Type @tindex BasisFunction @tindex NameOfCoef @tindex Function @tindex dFunction @tindex Quantity @tindex Formulation @tindex Group @tindex Resolution @tindex Support @tindex Entity @tindex SubSpace @tindex NameOfBasisFunction @tindex GlobalQuantity @tindex Constraint @tindex EntityType @tindex EntitySubType @tindex NameOfConstraint @vindex @var{function-space-id} @vindex @var{function-space-type} @vindex @var{basis-function-id} @vindex @var{basis-function-type} @vindex @var{coef-id} @vindex @var{sub-space-id} @vindex @var{basis-function-list} @vindex @var{global-quantity-id} @vindex @var{global-quantity-type} A @code{FunctionSpace} is characterized by the type of its interpolated fields, one or several basis functions and optional constraints (in space and time). Subspaces of a function space can be defined (e.g., for the use with hierarchical elements), as well as direct associations of global quantities (e.g., floating potential, electric charge, current, voltage, magnetomotive force, etc.). A key point is that basis functions are defined by any number of subsets of functions, being added. Each subset is characterized by associated built-in functions for evaluation, a support of definition and a set of associated supporting geometrical entities (e.g., nodes, edges, facets, volumes, groups of nodes, edges incident to a node, etc.). The freedom in defining various kinds of basis functions associated with different geometrical entities to interpolate a field permits to build made-to-measure function spaces adapted to a wide variety of field approximations (@pxref{FunctionSpace examples}). The syntax for the definition of function spaces is: @example FunctionSpace @{ @{ Name @var{function-space-id}; Type @var{function-space-type}; BasisFunction @{ @{ Name @var{basis-function-id}; NameOfCoef @var{coef-id}; Function @var{basis-function-type} < @{ Quantity @var{quantity-id}; Formulation @var{formulation-id} @{ @var{expression-cst} @}; Group @var{group-def}; Resolution @var{resolution-id} @{ @var{expression-cst} @} @} >; < dFunction @{ @var{basis-function-type}, @var{basis-function-type} @} ; > Support @var{group-def}; Entity @var{group-def}; @} @dots{} @} < SubSpace @{ @{ Name @var{sub-space-id}; NameOfBasisFunction @var{basis-function-list}; @} @dots{} @} > < GlobalQuantity @{ @{ Name @var{global-quantity-id}; Type @var{global-quantity-type}; NameOfCoef @var{coef-id}; @} @dots{} @} > < Constraint @{ @{ NameOfCoef @var{coef-id}; EntityType @var{group-type}; < EntitySubType @var{group-sub-type}; > NameOfConstraint @var{constraint-id} <@{@}>; @} @dots{} @} > @} @dots{} < @var{affectation} > @dots{} < @var{loop} > @dots{} @} @end example @noindent with @example @var{function-space-id}: @var{formulation-id}: @var{resolution-id}: @var{string} | @var{string} ~ @{ @var{expression-cst} @} @var{basis-function-id}: @var{coef-id}: @var{sub-space-id}: @var{global-quantity-id}: @var{string} @var{function-space-type}: Scalar | Vector | Form0 | Form1 | @var{etc} @var{basis-function-type}: BF_Node | BF_Edge | @var{etc} @var{basis-function-list}: @var{basis-function-id} | @{ @var{basis-function-id} <,@dots{}> @} @var{global-quantity-type}: AliasOf | AssociatedWith @end example @noindent Notes: @enumerate @item When the definition region of a function type group used as an @code{Entity} of a @code{BasisFunction} is the same as that of the associated @code{Support}, it is replaced by @code{All} for more efficient treatments during the computation process (this prevents the construction and the analysis of a list of geometrical entities). @item The same @code{Name} for several @code{BasisFunction} fields permits to define piecewise basis functions; separate @code{NameOfCoef}s must be defined for those fields. @item A constraint is associated with geometrical entities defined by an automatically created @code{Group} of type @var{group-type}, using the @code{Region} defined in a @code{Constraint} object as its main argument, and the optional @code{SubRegion} in the same object as a @var{group-sub-type} argument. @item A global basis function (@code{BF_Global} or @code{BF_dGlobal}) needs parameters, i.e., it is given by the quantity (@var{quantity-id}) pre-computed from multiresolutions performed on multiformulations. @item Explicit derivatives of the basis functions can be specified using @code{dFunction @{ @var{basis-function-type} , @var{basis-function-type} @}}. These derivates can be accessed using the special @code{D1} and @code{D2} operators (@pxref{Fields}). @end enumerate See @ref{Types for FunctionSpace}, for the complete list of options and @ref{FunctionSpace examples}, for some examples. @c ------------------------------------------------------------------------- @c Jacobian @c ------------------------------------------------------------------------- @node Jacobian, Integration, FunctionSpace, Objects @section @code{Jacobian}: defining jacobian methods @cindex Jacobian, definition @cindex Transformations, geometric @cindex Geometric transformations @cindex Coordinate change @cindex Change of coordinates @cindex Axisymmetric, transformation @tindex Jacobian @tindex Name @tindex Case @tindex Region @tindex All @vindex @var{jacobian-id} @vindex @var{jacobian-type} Jacobian methods can be referred to in @code{Formulation} and @code{PostProcessing} objects to be used in the computation of integral terms and for changes of coordinates. They are based on @code{Group} objects and define the geometrical transformations applied to the reference elements (i.e., lines, triangles, quadrangles, tetrahedra, prisms, hexahedra, etc.). Besides the classical lineic, surfacic and volume Jacobians, the @code{Jacobian} object allows the construction of various transformation methods (e.g., infinite transformations for unbounded domains) thanks to dedicated jacobian methods. The syntax for the definition of Jacobian methods is: @example Jacobian @{ @{ Name @var{jacobian-id}; Case @{ @{ Region @var{group-def} | All; Jacobian @var{jacobian-type} < @{ @var{expression-cst-list} @} >; @} @dots{} @} @} @dots{} @} @end example @noindent with @example @var{jacobian-id}: @var{string} @var{jacobian-type}: Vol | Sur | VolAxi | @var{etc} @end example @noindent Note: @enumerate @item The default case of a @code{Jacobian} object is defined by @code{Region All} and must follow all the other cases. @end enumerate See @ref{Types for Jacobian}, for the complete list of options and @ref{Jacobian examples}, for some examples. @c ------------------------------------------------------------------------- @c Integration @c ------------------------------------------------------------------------- @node Integration, Formulation, Jacobian, Objects @section @code{Integration}: defining integration methods @cindex Integration, definition @cindex Analytical integration @cindex Numerical integration @cindex Gauss, integration @tindex Integration @tindex Name @tindex Criterion @tindex Case @tindex Type @tindex GeoElement @tindex NumberOfPoints @tindex Analytic @vindex @var{integration-id} @vindex @var{element-type} @vindex @var{integration-type} Various numerical or analytical integration methods can be referred to in @code{Formulation} and @code{PostProcessing} objects to be used in the computation of integral terms, each with a set of particular options (number of integration points for quadrature methods---which can be linked to an error criterion for adaptative methods, definition of transformations for singular integrations, etc.). Moreover, a choice can be made between several integration methods according to a criterion (e.g., on the proximity between the source and computation points in integral formulations). The syntax for the definition of integration methods is: @example Integration @{ @{ Name @var{integration-id}; < Criterion @var{expression}; > Case @{ < @{ Type @var{integration-type}; Case @{ @{ GeoElement @var{element-type}; NumberOfPoints @var{expression-cst} @} @dots{} @} @} @dots{} > < @{ Type Analytic; @} @dots{} > @} @} @dots{} @} @end example @noindent with @example @var{integration-id}: @var{string} @var{integration-type}: Gauss | @var{etc} @var{element-type}: Line | Triangle | Tetrahedron @var{etc} @end example See @ref{Types for Integration}, for the complete list of options and @ref{Integration examples}, for some examples. @c ------------------------------------------------------------------------- @c Formulation @c ------------------------------------------------------------------------- @node Formulation, Resolution, Integration, Objects @section @code{Formulation}: building equations @cindex Formulation, definition @cindex Equations @cindex Time derivative @cindex Derivative, time @cindex Elementary matrices @cindex Matrices, elementary @cindex Local quantity @cindex Global quantity @cindex Integral quantity @cindex Quantity, local @cindex Quantity, global @cindex Quantity, integral @cindex Symmetry, integral kernel @tindex Formulation @tindex Name @tindex Type @tindex Quantity @tindex NameOfSpace @tindex Symmetry @tindex In @tindex Jacobian @tindex Integration @tindex IndexOfSystem @tindex Equation @tindex GlobalTerm @tindex GlobalEquation @tindex Network @tindex NameOfConstraint @tindex Node @tindex Loop @vindex @var{formulation-id} @vindex @var{formulation-type} @vindex @var{local-term-type} @vindex @var{quantity-type} @vindex @var{term-op-type} The @code{Formulation} tool permits to deal with volume, surface and line integrals with many kinds of densities to integrate, written in a form that is similar to their symbolic expressions (it uses the same @var{expression} syntax as elsewhere in GetDP), which therefore permits to directly take into account various kinds of elementary matrices (e.g., with scalar or cross products, anisotropies, nonlinearities, time derivatives, various test functions, etc.). In case nonlinear physical characteristics are considered, arguments are used for associated functions. In that way, many formulations can be directly written in the data file, as they are written symbolically. Fields involved in each formulation are declared as belonging to beforehand defined function spaces. The uncoupling between formulations and function spaces allows to maintain a generality in both their definitions. A @code{Formulation} is characterized by its type, the involved quantities (of local, global or integral type) and a list of equation terms. Global equations can also be considered, e.g., for the coupling with network relations. The syntax for the definition of formulations is: @example Formulation @{ @{ Name @var{formulation-id}; Type @var{formulation-type}; Quantity @{ @{ Name @var{quantity-id}; Type @var{quantity-type}; NameOfSpace @var{function-space-id} <@{@}> < [ @var{sub-space-id} | @var{global-quantity-id} ] >; < Symmetry @var{expression-cst}; > < [ @var{expression} ]; In @var{group-def}; Jacobian @var{jacobian-id}; Integration @var{integration-id}; > < IndexOfSystem @var{integer}; > @} @dots{} @} Equation @{ < @var{local-term-type} @{ < @var{term-op-type} > [ @var{expression}, @var{expression} ]; In @var{group-def}; Jacobian @var{jacobian-id}; Integration @var{integration-id}; @} > @dots{} < GlobalTerm @{ < @var{term-op-type} > [ @var{expression}, @var{expression} ]; In @var{group-def}; @} > @dots{} < GlobalEquation @{ Type Network; NameOfConstraint @var{constraint-id}; @{ Node @var{expression}; Loop @var{expression}; Equation @var{expression}; In @var{group-def}; @} @dots{} @} > @dots{} < @var{affectation} > @dots{} < @var{loop} > @dots{} @} @} @dots{} < @var{affectation} > @dots{} < @var{loop} > @dots{} @} @end example @noindent with @example @var{formulation-id}: @var{string} | @var{string} ~ @{ @var{expression-cst} @} @var{formulation-type}: FemEquation | @var{etc} @var{local-term-type}: Galerkin | deRham @var{quantity-type}: Local | Global | Integral @var{term-op-type}: DtDof | DtDtDof | JacNL | @var{etc} @end example @noindent Note: @enumerate @item @code{IndexOfSystem} permits to resolve ambiguous cases when several quantities belong to the same function space, but to different systems of equations. The @var{integer} parameter then specifies the index in the list of an @code{OriginSystem} command (@pxref{Resolution}). @item A @code{GlobalTerm} defines a term to be assembled in an equation associated with a global quantity. This equation is a finite element equation if that global quantity is linked with local quantities. @item A @code{GlobalEquation} defines a global equation to be assembled in the matrix of the system. @end enumerate See @ref{Types for Formulation}, for the complete list of options and @ref{Formulation examples}, for some examples. @c ------------------------------------------------------------------------- @c Resolution @c ------------------------------------------------------------------------- @node Resolution, PostProcessing, Formulation, Objects @section @code{Resolution}: solving systems of equations @cindex Resolution, definition @cindex Linear system solving @cindex Nonlinear system solving @cindex Iterative loop @cindex Relaxation factor @cindex Newton, nonlinear scheme @cindex Picard, nonlinear scheme @cindex Newmark, time scheme @cindex Theta, time scheme @cindex Solving, system @cindex Time stepping @cindex Time, discretization @cindex Frequency @cindex System, definition @cindex Complex-valued, system @tindex Resolution @tindex Name @tindex System @tindex NameOfFormulation @tindex Type @tindex Frequency @tindex DestinationSystem @tindex OriginSystem @tindex NameOfMesh @tindex Solver @tindex Operation @vindex @var{resolution-id} @vindex @var{system-id} @vindex @var{system-type} @vindex @var{formulation-list} @vindex @var{resolution-op} The operations available in a @code{Resolution} include: the generation of a linear system, its solving with various kinds of linear solvers, the saving of the solution or its transfer to another system, the definition of various time stepping methods, the construction of iterative loops for nonlinear problems (Newton-Raphson and fixed point methods), etc. Multi-harmonic resolutions, coupled problems (e.g., magneto-thermal) or linked problems (e.g., pre-computations of source fields) are thus easily defined in GetDP. The @code{Resolution} object is characterized by a list of systems to build and their associated formulations, using time or frequency domain, and a list of elementary operations: @example Resolution @{ @{ Name @var{resolution-id}; < Hidden @var{expression-cst}; > System @{ @{ Name @var{system-id}; NameOfFormulation @var{formulation-list}; < Type @var{system-type}; > < Frequency @var{expression-cst-list-item} | Frequency @{ @var{expression-cst-list} @}; > < DestinationSystem @var{system-id}; > < OriginSystem @var{system-id}; | OriginSystem @{ @var{system-id} <,@dots{}> @}; > < NameOfMesh @var{expression-char} > < Solver @var{expression-char} > < @var{loop} > @} @dots{} < @var{loop} > @dots{} @} Operation @{ < @var{resolution-op}; > @dots{} < @var{loop} > @dots{} @} @} @dots{} < @var{affectation} > @dots{} < @var{loop} > @dots{} @} @end example @noindent with @example @var{resolution-id}: @var{system-id}: @var{string} | @var{string} ~ @{ @var{expression-cst} @} @var{formulation-list}: @var{formulation-id} <@{@}> | @{ @var{formulation-id} <@{@}> <,@dots{}> @} @var{system-type}: Real | Complex @var{resolution-op}: Generate[@var{system-id}] | Solve[@var{system-id}] | @var{etc} @end example @noindent Notes: @enumerate @item The default type for a system of equations is @code{Real}. A frequency domain analysis is defined through the definition of one or several frequencies (@code{Frequency @var{expression-cst-list-item} | Frequency @{ @var{expression-cst-list} @}}). Complex systems of equations with no predefined list of frequencies (e.g., in modal analyses) can be explicitely defined with @code{Type Complex}. @item @code{NameOfMesh} permits to explicitely specify the mesh to be used for the construction of the system of equations. @item @code{Solver} permits to explicitely specify the name of the solver parameter file to use for the solving of the system of equations. This is ony valid if GetDP was compiled against the default solver library (it is the case if you downloaded a pre-compiled copy of GetDP from the internet). @item @code{DestinationSystem} permits to specify the destination system of a @code{TransferSolution} operation (@pxref{Types for Resolution}). @item @code{OriginSystem} permits to specify the systems from which ambiguous quantity definitions can be solved (@pxref{Formulation}). @end enumerate See @ref{Types for Resolution}, for the complete list of options and @ref{Resolution examples}, for some examples. @c ------------------------------------------------------------------------- @c PostProcessing @c ------------------------------------------------------------------------- @node PostProcessing, PostOperation, Resolution, Objects @section @code{PostProcessing}: exploiting computational results @cindex Post-processing, definition @cindex Quantity, post-processing @cindex Results, exploitation @tindex PostProcessing @tindex Name @tindex NameOfFormulation @tindex NameOfSystem @tindex Quantity @tindex Value @tindex Local @tindex Integral @tindex In @tindex Integration @tindex Jacobian @vindex @var{post-processing-id} @vindex @var{post-quantity-id} @vindex @var{post-quantity-type} @vindex @var{post-value} @vindex @var{local-value} @vindex @var{integral-value} The @code{PostProcessing} object is based on the quantities defined in a @code{Formulation} and permits the construction (thanks to the @var{expression} syntax) of any useful piecewise defined quantity of interest: @example PostProcessing @{ @{ Name @var{post-processing-id}; NameOfFormulation @var{formulation-id} <@{@}>; < NameOfSystem @var{system-id}; > Quantity @{ @{ Name @var{post-quantity-id}; Value @{ @var{post-value} @dots{} @} @} @dots{} < @var{loop} > @dots{} @} @} @dots{} < @var{affectation} > @dots{} < @var{loop} > @dots{} @} @end example @noindent with @example @var{post-processing-id}: @var{post-quantity-id}: @var{string} | @var{string} ~ @{ @var{expression-cst} @} @var{post-value}: Local @{ @var{local-value} @} | Integral @{ @var{integral-value} @} @var{local-value}: [ @var{expression} ]; In @var{group-def}; Jacobian @var{jacobian-id}; @var{integral-value}: [ @var{expression} ]; In @var{group-def}; Integration @var{integration-id}; Jacobian @var{jacobian-id}; @end example @noindent Notes: @enumerate @item The quantity defined with @var{integral-value} is piecewise defined over the elements of the mesh of @var{group-def}, and takes, in each element, the value of the integration of @var{expression} over this element. The global integral of @var{expression} over a whole region (being either @var{group-def} or a subset of @var{group-def}) has to be defined in the @code{PostOperation} with the @code{@var{post-quantity-id}[@var{group-def}]} command (@pxref{PostOperation}). @item If @code{NameOfSystem @var{system-id}} is not given, the system is automatically selected as the one to which the first quantity listed in the @code{Quantity} field of @var{formulation-id} is associated. @end enumerate See @ref{Types for PostProcessing}, for the complete list of options and @ref{PostProcessing examples}, for some examples. @c ------------------------------------------------------------------------- @c PostOperation @c ------------------------------------------------------------------------- @node PostOperation, , PostProcessing, Objects @section @code{PostOperation}: exporting results @cindex Post-operation, definition @cindex Exporting results @cindex Results, export @cindex Sections @cindex Maps @cindex Format, output @tindex PostOperation @tindex Name @tindex NameOfPostProcessing @tindex Format @tindex Operation @tindex UsingPost @tindex Print @vindex @var{post-operation-id} @vindex @var{post-operation-op} @vindex @var{post-operation-fmt} @vindex @var{print-support} @vindex @var{print-option} The @code{PostOperation} is the bridge between results obtained with GetDP and the external world. It defines several elementary operations on @code{PostProcessing} quantities (e.g., plot on a region, section on a user-defined plane, etc.), and outputs the results in several file formats. @example PostOperation @{ @{ Name @var{post-operation-id}; NameOfPostProcessing @var{post-processing-id}; < Hidden @var{expression-cst}; > < Format @var{post-operation-fmt}; > < Append @var{expression-char}; > < TimeValue @var{expression-cst-list}; > < TimeImagValue @var{expression-cst-list}; > < LastTimeStepOnly; > < OverrideTimeStepValue @var{expression-cst}; > < NoMesh @var{expression-cst}; > < AppendToExistingFile @var{expression-cst}; > < ResampleTime[@var{expression-cst}, @var{expression-cst}, @var{expression-cst}]; > Operation @{ < @var{post-operation-op}; > @dots{} @} @} @dots{} < @var{affectation} > @dots{} < @var{loop} > @dots{} @} | PostOperation @var{post-operation-id} UsingPost @var{post-processing-id} @{ < @var{post-operation-op}; > @dots{} @} @dots{} @end example @noindent with @example @var{post-operation-id}: @var{string} | @var{string} ~ @{ @var{expression-cst} @} @var{post-operation-op}: Print[ @var{post-quantity-id} <[@var{group-def}]>, @var{print-support} <,@var{print-option}> @dots{} ] | Print[ "@var{string}", @var{expression} <,@var{print-option}> @dots{} ] | Print[ "@var{string}", Str[ @var{expression-char} ] <,@var{print-option}> @dots{} ] | Echo[ "@var{string}" <,@var{print-option}> @dots{} ] | PrintGroup[ @var{group-id}, @var{print-support} <,@var{print-option}> @dots{} ] | SendMergeFileRequest[ @var{expression-char} ] | < @var{loop} > @dots{} @var{etc} @var{print-support}: OnElementsOf @var{group-def} | OnRegion @var{group-def} | OnGlobal | @var{etc} @var{print-option}: File @var{expression-char} | Format @var{post-operation-fmt} | @var{etc} @var{post-operation-fmt}: Table | TimeTable | @var{etc} @end example @noindent Notes: @enumerate @item Both @code{PostOperation} syntaxes are equivalent. The first one conforms to the overall interface, but the second one is more concise. @item The format @var{post-operation-fmt} defined outside the @code{Operation} field is applied to all the post-processing operations, unless other formats are explicitly given in these operations with the @code{Format} option (@pxref{Types for PostOperation}). The default format is @code{Gmsh}. @item The @code{ResampleTime} option allows equidistant resampling of the time steps by a spline interpolation. The parameters are: start time, stop time, time step. @item The optional argument @code{[@var{group-def}]} of the @var{post-quantity-id} can only be used when this quantity has been defined as an @var{integral-value} (@pxref{PostProcessing}). In this case, the sum of all elementary integrals is performed over the region @var{group-def}. @end enumerate See @ref{Types for PostOperation}, for the complete list of options and @ref{PostOperation examples}, for some examples. @c ========================================================================= @c Types for Objects @c ========================================================================= @node Types for objects, Short examples, Objects, Top @chapter Types for objects This chapter presents the complete list of choices associated with metasyntactic variables introduced for the ten GetDP objects. @cindex Types, definition @cindex Objects, types @menu * Types for Group:: * Types for Function:: * Types for Constraint:: * Types for FunctionSpace:: * Types for Jacobian:: * Types for Integration:: * Types for Formulation:: * Types for Resolution:: * Types for PostProcessing:: * Types for PostOperation:: @end menu @c ------------------------------------------------------------------------- @c Group @c ------------------------------------------------------------------------- @node Types for Group, Types for Function, Types for objects, Types for objects @section Types for @code{Group} @cindex Group, types @vindex @var{group-type} @noindent Types in @example @var{group-type} [ @var{R1} <, @var{group-sub-type} @var{R2} > ] @end example @noindent @code{@var{group-type} < @var{group-sub-type} >}: @ftable @code @item Region Regions in @var{R1}. @item Global Regions in @var{R1} (variant of @code{Region} used with global @code{BasisFunction}s @code{BF_Global} and @code{BF_dGlobal}). @item NodesOf Nodes of elements of @var{R1} < @code{Not}: but not those of @var{R2} >. @item EdgesOf Edges of elements of @var{R1} < @code{Not}: but not those of @var{R2} >. @item FacetsOf Facets of elements of @var{R1} < @code{Not}: but not those of @var{R2} >. @item VolumesOf Volumes of elements of @var{R1} < @code{Not}: but not those of @var{R2} >. @item ElementsOf Elements of regions in @var{R1} < @code{OnOneSideOf}: only elements on one side of @var{R2}) >. @item GroupsOfNodesOf Groups of nodes of elements of @var{R1} (a group is associated with each region). @item GroupsOfEdgesOf Groups of edges of elements of @var{R1} (a group is associated with each region). < @code{InSupport}: in a support @var{R2} being a group of type @code{ElementOf}, i.e., containing elements >. @item GroupsOfEdgesOnNodesOf Groups of edges incident to nodes of elements of @var{R1} (a group is associated with each node). < @code{Not}: but not those of @var{R2}) >. @item GroupOfRegionsOf Single group of elements of regions in @var{R1} (with basis function BF_Region just one DOF is created for all elements of @var{R1}). @item EdgesOfTreeIn Edges of a tree of edges of @var{R1} < @code{StartingOn}: a complete tree is first built on @var{R2} >. @item FacetsOfTreeIn Facets of a tree of facets of @var{R1} < @code{StartingOn}: a complete tree is first built on @var{R2} >. @item DualNodesOf Dual nodes of elements of @var{R1}. @item DualEdgesOf Dual edges of elements of @var{R1}. @item DualFacetsOf Dual facets of elements of @var{R1}. @item DualVolumesOf Dual volumes of elements of @var{R1}. @end ftable @c ------------------------------------------------------------------------- @c Function @c ------------------------------------------------------------------------- @node Types for Function, Types for Constraint, Types for Group, Types for objects @section Types for @code{Function} @menu * Math functions:: * Extended math functions:: * Green functions:: * Type manipulation functions:: * Coordinate functions:: * Miscellaneous functions:: @end menu @c ......................................................................... @c Math functions @c ......................................................................... @node Math functions, Extended math functions, Types for Function, Types for Function @subsection Math functions @vindex @var{math-function-id} The following functions are the equivalent of the functions of the C math library, and always return real-valued expressions. These are the only functions allowed in constant expressions (@var{expression-cst}, see @ref{Constants}). @noindent @var{math-function-id}: @ftable @code @item Exp @code{[@var{expression}]} Exponential function: e^@var{expression}. @item Log @code{[@var{expression}]} Natural logarithm: ln(@var{expression}), @var{expression}>0. @item Log10 @code{[@var{expression}]} Base 10 logarithm: log10(@var{expression}), @var{expression}>0. @item Sqrt @code{[@var{expression}]} Square root, @var{expression}>=0. @item Sin @code{[@var{expression}]} Sine of @var{expression}. @item Asin @code{[@var{expression}]} Arc sine (inverse sine) of @var{expression} in [-Pi/2,Pi/2], @var{expression} in [-1,1]. @item Cos @code{[@var{expression}]} Cosine of @var{expression}. @item Acos @code{[@var{expression}]} Arc cosine (inverse cosine) of @var{expression} in [0,Pi], @var{expression} in [-1,1]. @item Tan @code{[@var{expression}]} Tangent of @var{expression}. @item Atan @code{[@var{expression}]} Arc tangent (inverse tangent) of @var{expression} in [-Pi/2,Pi/2]. @item Atan2 @code{[@var{expression},@var{expression}]} Arc tangent (inverse tangent) of the first @var{expression} divided by the second, in [-Pi,Pi]. @item Sinh @code{[@var{expression}]} Hyperbolic sine of @var{expression}. @item Cosh @code{[@var{expression}]} Hyperbolic cosine of @var{expression}. @item Tanh @code{[@var{expression}]} Hyperbolic tangent of the real valued @var{expression}. @item TanhC2 @code{[@var{expression}]} Hyperbolic tangent of a complex valued @var{expression}. @item Fabs @code{[@var{expression}]} Absolute value of @var{expression}. @item Floor @code{[@var{expression}]} Rounds downwards to the nearest integer that is not greater than @var{expression}. @item Ceil @code{[@var{expression}]} Rounds upwards to the nearest integer that is not less than @var{expression}. @item Fmod @code{[@var{expression},@var{expression}]} Remainder of the division of the first @var{expression} by the second, with the sign of the first. @item Sign @code{[@var{expression}]} -1 for @var{expression} less than zero and 1 otherwise. @item Jn @code{[@var{expression}]} Returns the Bessel function of the first kind of order given by the first @var{expression} for the value of the second @var{expression}. @item dJn @code{[@var{expression}]} Returns the derivative of the Bessel function of the first kind of order given by the first @var{expression} for the value of the second @var{expression}. @item Yn @code{[@var{expression}]} Returns the Bessel function of the second kind of order given by the first @var{expression} for the value of the second @var{expression}. @item dYn @code{[@var{expression}]} Returns the derivative of the Bessel function of the second kind of order given by the first @var{expression} for the value of the second @var{expression}. @end ftable @c ......................................................................... @c Extended Math @c ......................................................................... @node Extended math functions, Green functions, Math functions, Types for Function @subsection Extended math functions @vindex @var{extended-math-function-id} @noindent @var{extended-math-function-id}: @ftable @code @item Cross @code{[@var{expression},@var{expression}]} Cross product of the two arguments; @var{expression} must be a vector. @item Hypot @code{[@var{expression},@var{expression}]} Square root of the sum of the squares of its arguments. @item Norm @code{[@var{expression}]} Absolute value if @var{expression} is a scalar; euclidian norm if @var{expression} is a vector. @item SquNorm @code{[@var{expression}]} Square norm: @code{Norm[@var{expression}]^2}. @item Unit @code{[@var{expression}]} Normalization: @code{@var{expression}/Norm[@var{expression}]}. Returns 0 if the norm is smaller than 1.e-30. @item Transpose @code{[@var{expression}]} Transposition; @var{expression} must be a tensor. @item Inv @code{[@var{expression}]} Inverse of the tensor @var{expression}. @item Det @code{[@var{expression}]} Determinant of the tensor @var{expression}. @item Rotate @code{[@var{expression},@var{expression},@var{expression},@var{expression}]} Rotation of a vector or tensor given by the first @var{expression} by the angles in radians given by the last three @var{expression} values around the x-, y- and z-axis. @item TTrace @code{[@var{expression}]} Trace; @var{expression} must be a tensor. @item Cos_wt_p @code{[]@{@var{expression-cst},@var{expression-cst}@}} The first parameter represents the angular frequency and the second represents the phase. If the type of the current system is @code{Real}, @code{F_Cos_wt_p[]@{w,p@}} is identical to @code{Cos[w*$Time+p]}. If the type of the current system is @code{Complex}, it is identical to @code{Complex[Cos[w],Sin[w]]}. @item Sin_wt_p @code{[]@{@var{expression-cst},@var{expression-cst}@}} The first parameter represents the angular frequency and the second represents the phase. If the type of the current system is @code{Real}, @code{F_Sin_wt_p[]@{w,p@}} is identical to @code{Sin[w*$Time+p]}. If the type of the current system is @code{Complex}, it is identical to @code{Complex[Sin[w],-Cos[w]]}. @item Period @code{[@var{expression}]@{@var{expression-cst}@}} @code{Fmod[@var{expression},@var{expression-cst}]} @code{+} @code{(@var{expression}<0 ? @var{expression-cst} : 0)}; the result is always in [0,@var{expression-cst}[. @item Interval @code{[@var{expression},@var{expression},@var{expression}]@{@var{expression-cst}, @var{expression-cst},@var{expression-cst}@}} Not documented yet. @end ftable @c ......................................................................... @c Green functions @c ......................................................................... @node Green functions, Type manipulation functions, Extended math functions, Types for Function @subsection Green functions @vindex @var{green-function-id} The Green functions are only used in integral quantities (@pxref{Formulation}). The first parameter represents the dimension of the problem: @itemize @bullet @item @code{1D}: @code{r = Fabs[$X-$XS]} @item @code{2D}: @code{r = Sqrt[($X-$XS)^2+($Y-$YS)^2]} @item @code{3D}: @code{r = Sqrt[($X-$XS)^2+($Y-$YS)^2+($Z-$ZS)^2]} @end itemize The triplets of values given in the definitions below correspond to the @code{1D}, @code{2D} and @code{3D} cases. @noindent @var{green-function-id}: @ftable @code @item Laplace @code{[]@{@var{expression-cst}@}} @code{r/2}, @code{1/(2*Pi)*ln(1/r)}, @code{1/(4*Pi*r)}. @item GradLaplace @code{[]@{@var{expression-cst}@}} Gradient of @code{Laplace} relative to the destination point (@code{$X}, @code{$Y}, @code{$Z}). @item Helmholtz @code{[]@{@var{expression-cst}, @var{expression-cst}@}} @code{exp(j*k0*r)/(4*Pi*r)}, where @code{k0} is given by the second parameter. @item GradHelmholtz @code{[]@{@var{expression-cst}, @var{expression-cst}@}} Gradient of @code{Helmholtz} relative to the destination point (@code{$X}, @code{$Y}, @code{$Z}). @end ftable @c ......................................................................... @c Type @c ......................................................................... @node Type manipulation functions, Coordinate functions, Green functions, Types for Function @subsection Type manipulation functions @vindex @var{type-function-id} @noindent @var{type-function-id}: @ftable @code @item Complex @code{[@var{expression-list}]} Creates a (multi-harmonic) complex expression from an number of real-valued expressions. The number of expressions in @var{expression-list} must be even. @item Complex_MH @code{[@var{expression-list}]@{@var{expression-cst-list}@}} Not documented yet. @item Re @code{[@var{expression}]} Takes the real part of a complex-valued expression. @item Im @code{[@var{expression}]} Takes the imaginary part of a complex-valued expression. @item Conj @code{[@var{expression}]} Computes the conjugate of a complex-valued expression. @item Cart2Pol @code{[@var{expression}]} Converts the cartesian form (reale, imaginary) of a complex-valued expression into polar form (amplitude, phase [radians]). @item Vector @code{[@var{expression},@var{expression},@var{expression}]} Creates a vector from 3 scalars. @item Tensor @code{[@var{expression},@var{expression},@var{expression},@var{expression},@var{expression},@var{expression},} @code{@var{expression},@var{expression},@var{expression}]} Creates a second-rank tensor of order 3 from 9 scalars. @item TensorV @code{[@var{expression},@var{expression},@var{expression}]} Creates a second-rank tensor of order 3 from 3 vectors. @item TensorSym @code{[@var{expression},@var{expression},@var{expression},@var{expression},@var{expression},@var{expression}]} Creates a symmetrical second-rank tensor of order 3 from 6 scalars. @item TensorDiag @code{[@var{expression},@var{expression},@var{expression}]} Creates a diagonal second-rank tensor of order 3 from 3 scalars. @item SquDyadicProduct @code{[@var{expression}]} Dyadic product of the vector given by @var{expression} with itself. @item CompX @code{[@var{expression}]} Gets the X component of a vector. @item CompY @code{[@var{expression}]} Gets the Y component of a vector. @item CompZ @code{[@var{expression}]} Gets the Z component of a vector. @item CompXX @code{[@var{expression}]} Gets the XX component of a tensor. @item CompXY @code{[@var{expression}]} Gets the XY component of a tensor. @item CompXZ @code{[@var{expression}]} Gets the XZ component of a tensor. @item CompYX @code{[@var{expression}]} Gets the YX component of a tensor. @item CompYY @code{[@var{expression}]} Gets the YY component of a tensor. @item CompYZ @code{[@var{expression}]} Gets the YZ component of a tensor. @item CompZX @code{[@var{expression}]} Gets the ZX component of a tensor. @item CompZY @code{[@var{expression}]} Gets the ZY component of a tensor. @item CompZZ @code{[@var{expression}]} Gets the ZZ component of a tensor. @item Cart2Sph @code{[@var{expression}]} Gets the tensor for transformation of vector from cartesian to spherical coordinates. @item Cart2Cyl @code{[@var{expression}]} Gets the tensor for transformation of vector from cartesian to cylindric coordinates. E.g. to convert a vector with (x,y,z)-components to one with (radial, tangential, axial)-components: Cart2Cyl[XYZ[]] * vector @item UnitVectorX @code{[]} Creates a unit vector in x-direction. @item UnitVectorY @code{[]} Creates a unit vector in y-direction. @item UnitVectorZ @code{[]} Creates a unit vector in z-direction. @end ftable @c ......................................................................... @c Coord @c ......................................................................... @node Coordinate functions, Miscellaneous functions, Type manipulation functions, Types for Function @subsection Coordinate functions @vindex @var{coord-function-id} @noindent @var{coord-function-id}: @ftable @code @item X @code{[]} Gets the X coordinate. @item Y @code{[]} Gets the Y coordinate. @item Z @code{[]} Gets the Z coordinate. @item XYZ @code{[]} Gets X, Y and Z in a vector. @c todo: @c @item F_aX_bY_cZ @c @code{[]@{@var{expression-cst},@var{expression-cst},@var{expression-cst}@}} @c @item F_aX21_bY21_cZ21 @c @code{[]@{@var{expression-cst},@var{expression-cst},@var{expression-cst}@}} @end ftable @c ......................................................................... @c Misc @c ......................................................................... @node Miscellaneous functions, , Coordinate functions, Types for Function @subsection Miscellaneous functions @vindex @var{misc-function-id} @noindent @var{misc-function-id}: @ftable @code @item Printf @code{[@var{expression}]} Prints the value of @var{expression} when evaluated. (@code{MPI_Printf} can be use instead, to print the message for all MPI ranks.) @item Rand @code{[@var{expression}]} Returns a pseudo-random number in [0, @var{expression}]. @item Normal @code{[]} Computes the normal to the element. @item NormalSource @code{[]} Computes the normal to the source element (only valid in a quantity of Integral type). @item Tangent @code{[]} Computes the tangent to the element (only valid for line elements). @item TangentSource @code{[]} Computes the tangent to the source element (only valid in a quantity of Integral type and only for line elements). @item ElementVol @code{[]} Computes the element's volume. @item SurfaceArea @code{[]} Computes the area of the actual surface. @item GetVolume @code{[]} Computes the volume of the actual physical group. @item CompElementNum @code{[]} Returns 0 if the current element and the current source element are identical. @item InterpolationLinear @code{[@var{expression}]@{@var{expression-cst-list}@}} Linear interpolation of points. The number of constant expressions in @var{expression-cst-list} must be even. @item dInterpolationLinear @code{[@var{expression}]@{@var{expression-cst-list}@}} Derivative of linear interpolation of points. The number of constant expressions in @var{expression-cst-list} must be even. @item InterpolationBilinear @code{[@var{expression},@var{expression}]@{@var{expression-cst-list}@}} Bilinear interpolation of a table based on two variables. See @url{https://geuz.org/trac/getdp/wiki/UsageOfTables} for an example. @item dInterpolationBilinear @code{[@var{expression},@var{expression}]@{@var{expression-cst-list}@}} Derivative of bilinear interpolation of a table based on two variables. The result is a vector. See @url{https://geuz.org/trac/getdp/wiki/UsageOfTables} for an example. @item InterpolationAkima @code{[@var{expression}]@{@var{expression-cst-list}@}} Akima interpolation of points. The number of constant expressions in @var{expression-cst-list} must be even. @item dInterpolationAkima @code{[@var{expression}]@{@var{expression-cst-list}@}} Derivative of Akima interpolation of points. The number of constant expressions in @var{expression-cst-list} must be even. @item Order @code{[@var{quantity}]} Returns the interpolation order of the @var{quantity}. @item Field @code{[@var{expression}]} Evaluate the last one of the fields (``views'') loaded with @code{GmshRead} (@pxref{Types for Resolution}), at the point @var{expression}. Common usage is thus @code{Field[XYZ[]]}. @item Field @code{[@var{expression}]@{@var{expression-cst-list}@}} Idem, but evaluate all the fields corresponding to the tags in the list, and sum all the values. A field having no value at the given position does not produce an error: its contribution to the sum is simply zero. @item ScalarField @code{[@var{expression}]@{@var{expression-cst-list}@}} Idem, but consider only real-valued scalar fields. A second optional argument is the value of the time step. A third optional argument is a boolean flag to indicate that the interpolation should be performed (if possible) in the same element as the current element. @item VectorField @code{[@var{expression}]@{@var{expression-cst-list}@}} Idem, but consider only real-valued vector fields. Optional arguments are treated in the same way as for @code{ScalarField}. @item TensorField @code{[@var{expression}]@{@var{expression-cst-list}@}} Idem, but consider only real-valued tensor fields. Optional arguments are treated in the same way as for @code{ScalarField}. @item ComplexScalarField @code{[@var{expression}]@{@var{expression-cst-list}@}} Idem, but consider only complex-valued scalar fields. Optional arguments are treated in the same way as for @code{ScalarField}. @item ComplexVectorField @code{[@var{expression}]@{@var{expression-cst-list}@}} Idem, but consider only complex-valued vector fields. Optional arguments are treated in the same way as for @code{ScalarField}. @item ComplexTensorField @code{[@var{expression}]@{@var{expression-cst-list}@}} Idem, but consider only complex-valued tensor fields. Optional arguments are treated in the same way as for @code{ScalarField}. @item GetCpuTime @code{[]} Returns current CPU time, in seconds (total amount of time spent executing in user mode since GetDP was started). @item GetWallClockTime @code{[]} Returns the current wall clock time, in seconds (total wall clock time since GetDP was started). @item GetMemory @code{[]} Returns the current memory usage, in megabytes (maximum resident set size). @item SetNumber @code{[@var{expression}]@{@var{char-expression}@}} Sets the @var{char-expression} ONELAB variable at run-time to @var{expression}. @item GetNumber @code{[ <@var{expression}> ]@{@var{char-expression}@}} Gets the value of the @var{char-expression} ONELAB variable at run-time. If the optional @var{expression} is provided, it is used as a default value if ONELAB is not available. @end ftable @c ------------------------------------------------------------------------- @c Constraint @c ------------------------------------------------------------------------- @node Types for Constraint, Types for FunctionSpace, Types for Function, Types for objects @section Types for @code{Constraint} @cindex Constraint, types @vindex @var{constraint-type} @noindent @var{constraint-type}: @ftable @code @item Assign To assign a value (e.g., for boundary condition). @item Init To give an initial value (e.g., initial value in a time domain analysis). If two values are provided (with @code{Value [ @var{expression}, @var{expression} ]}), the first value can be used using the @code{InitSolution1} operation. This is mainly useful for the Newmark time-stepping scheme. @item AssignFromResolution To assign a value to be computed by a pre-resolution. @item InitFromResolution To give an initial value to be computed by a pre-resolution. @item Network To describe the node connections of branches in a network. @item Link To define links between degrees of freedom in the constrained region with degrees of freedom in a ``reference'' region, with some coefficient. For example, to link the degrees of freedom in the contrained region @code{Left} with the degrees of freedom in the reference region @code{Right}, located Pi units to the right of the region @code{Left} along the X-axis, with the coeficient @code{-1}, one could write: @example @{ Name periodic; Case @{ @{ Region Left; Type Link ; RegionRef Right; Coefficient -1; Function Vector[$X+Pi,$Y,$Z] ; @} @} @} @end example In this example, @code{Function} defines the mapping that translates the geometrical elements in the region @code{Left} by Pi units along the X-axis, so that they correspond with the elements in the region @code{Right}. For this mapping to work, the meshes of @code{Left} and @code{Right} must be identical. @item LinkCplx To define complex-valued links between degrees of freedom. The syntax is the same as for constraints of type @code{Link}, but @code{Coeficient} can be complex. @end ftable @c ------------------------------------------------------------------------- @c FunctionSpace @c ------------------------------------------------------------------------- @node Types for FunctionSpace, Types for Jacobian, Types for Constraint, Types for objects @section Types for @code{FunctionSpace} @cindex Function space, types @vindex @var{function-space-type} @vindex @var{basis-function-type} @vindex @var{global-quantity-type} @noindent @var{function-space-type}: @ftable @code @item Form0 0-form, i.e., scalar field of potential type. @item Form1 1-form, i.e., curl-conform field (associated with a curl). @item Form2 2-form, i.e., div-conform field (associated with a divergence). @item Form3 3-form, i.e., scalar field of density type. @item Form1P 1-form perpendicular to the @var{z}=0 plane, i.e., perpendicular curl-conform field (associated with a curl). @item Form2P 2-form in the @var{z}=0 plane, i.e., parallel div-conform field (associated with a divergence). @item Scalar Scalar field. @item Vector Vector field. @end ftable @noindent @var{basis-function-type}: @ftable @code @item BF_Node Nodal function (on @code{NodesOf}, value @code{Form0}). @item BF_Edge Edge function (on @code{EdgesOf}, value @code{Form1}). @item BF_Facet Facet function (on @code{FacetsOf}, value @code{Form2}). @item BF_Volume Volume function (on @code{VolumesOf}, value @code{Form3}). @item BF_GradNode Gradient of nodal function (on @code{NodesOf}, value @code{Form1}). @item BF_CurlEdge Curl of edge function (on @code{EdgesOf}, value @code{Form2}). @item BF_DivFacet Divergence of facet function (on @code{FacetsOf}, value @code{Form3}). @item BF_GroupOfNodes Sum of nodal functions (on @code{GroupsOfNodesOf}, value @code{Form0}). @item BF_GradGroupOfNodes Gradient of sum of nodal functions (on @code{GroupsOfNodesOf}, value @code{Form1}). @item BF_GroupOfEdges Sum of edge functions (on @code{GroupsOfEdgesOf}, value @code{Form1}). @item BF_CurlGroupOfEdges Curl of sum of edge functions (on @code{GroupsOfEdgesOf}, value @code{Form2}). @item BF_PerpendicularEdge 1-form (0, 0, @code{BF_Node}) (on @code{NodesOf}, value @code{Form1P}). @item BF_CurlPerpendicularEdge Curl of 1-form (0, 0, @code{BF_Node}) (on @code{NodesOf}, value @code{Form2P}). @item BF_GroupOfPerpendicularEdge Sum of 1-forms (0, 0, @code{BF_Node}) (on @code{NodesOf}, value @code{Form1P}). @item BF_CurlGroupOfPerpendicularEdge Curl of sum of 1-forms (0, 0, @code{BF_Node}) (on @code{NodesOf}, value @code{Form2P}). @item BF_PerpendicularFacet 2-form (90 degree rotation of @code{BF_Edge}) (on @code{EdgesOf}, value @code{Form2P}). @item BF_DivPerpendicularFacet Div of 2-form (90 degree rotation of @code{BF_Edge}) (on @code{EdgesOf}, value @code{Form3}). @item BF_Region Unit value 1 (on @code{Region} or @code{GroupOfRegionsOf}, value @code{Scalar}). @item BF_RegionX Unit vector (1, 0, 0) (on @code{Region}, value @code{Vector}). @item BF_RegionY Unit vector (0, 1, 0) (on @code{Region}, value @code{Vector}). @item BF_RegionZ Unit vector (0, 0, 1) (on @code{Region}, value @code{Vector}). @item BF_Global Global pre-computed quantity (on @code{Global}, value depends on parameters). @item BF_dGlobal Exterior derivative of global pre-computed quantity (on @code{Global}, value depends on parameters). @item BF_NodeX Vector (@code{BF_Node}, 0, 0) (on @code{NodesOf}, value @code{Vector}). @item BF_NodeY Vector (0, @code{BF_Node}, 0) (on @code{NodesOf}, value @code{Vector}). @item BF_NodeZ Vector (0, 0, @code{BF_Node}) (on @code{NodesOf}, value @code{Vector}). @item BF_Zero Zero value 0 (on all regions, value @code{Scalar}). @item BF_One Unit value 1 (on all regions, value @code{Scalar}). @end ftable @noindent @var{global-quantity-type}: @ftable @code @item AliasOf Another name for a name of coefficient of basis function. @item AssociatedWith A global quantity associated with a name of coefficient of basis function, and therefore with this basis function. @end ftable @c ------------------------------------------------------------------------- @c Jacobian @c ------------------------------------------------------------------------- @node Types for Jacobian, Types for Integration, Types for FunctionSpace, Types for objects @section Types for @code{Jacobian} @cindex Jacobian, types @vindex @var{jacobian-type} @noindent @var{jacobian-type}: @ftable @code @item Vol Volume Jacobian, for @var{n}-D regions in @var{n}-D geometries, @var{n} = 1, 2 or 3. @item Sur Surface Jacobian, for (@var{n}-1)-D regions in @var{n}-D geometries, @var{n} = 1, 2 or 3. @item Lin Line Jacobian, for (@var{n}-2)-D regions in @var{n}-D geometries, @var{n} = 2 or 3. @item VolAxi Axisymmetrical volume Jacobian (1st type: @math{r}), for 2-D regions in axisymmetrical geometries. @item SurAxi Axisymmetrical surface Jacobian (1st type: @math{r}), for 1-D regions in axisymmetrical geometries. @item VolAxiSqu Axisymmetrical volume Jacobian (2nd type: @math{r^2}), for 2-D regions in axisymmetrical geometries. @item VolSphShell Volume Jacobian with spherical shell transformation, for @var{n}-D regions in @var{n}-D geometries, @var{n} = 2 or 3. @i{Parameters}: @var{radius-internal}, @var{radius-external} <, @var{center-X}, @var{center-Y}, @var{center-Z}, @var{power}, @var{1/infinity} >. @item VolAxiSphShell Same as @code{VolAxi}, but with spherical shell transformation. @i{Parameters}: @var{radius-internal}, @var{radius-external} <, @var{center-X}, @var{center-Y}, @var{center-Z}, @var{power}, @var{1/infinity} >. @item VolAxiSquSphShell Same as @code{VolAxiSqu}, but with spherical shell transformation. @i{Parameters}: @var{radius-internal}, @var{radius-external} <, @var{center-X}, @var{center-Y}, @var{center-Z}, @var{power}, @var{1/infinity} >. @item VolRectShell Volume Jacobian with rectangular shell transformation, for @var{n}-D regions in @var{n}-D geometries, @var{n} = 2 or 3. @i{Parameters}: @var{radius-internal}, @var{radius-external} <, @var{direction}, @var{center-X}, @var{center-Y}, @var{center-Z}, @var{power}, @var{1/infinity} >. @item VolAxiRectShell Same as @code{VolAxi}, but with rectangular shell transformation. @i{Parameters}: @var{radius-internal}, @var{radius-external} <, @var{direction}, @var{center-X}, @var{center-Y}, @var{center-Z}, @var{power}, @var{1/infinity} >. @item VolAxiSquRectShell Same as @code{VolAxiSqu}, but with rectangular shell transformation. @i{Parameters}: @var{radius-internal}, @var{radius-external} <, @var{direction}, @var{center-X}, @var{center-Y}, @var{center-Z}, @var{power}, @var{1/infinity} >. @end ftable @c ------------------------------------------------------------------------- @c Integration @c ------------------------------------------------------------------------- @node Types for Integration, Types for Formulation, Types for Jacobian, Types for objects @section Types for @code{Integration} @cindex Integration, types @vindex @var{integration-type} @vindex @var{element-type} @noindent @var{integration-type}: @ftable @code @item Gauss Numerical Gauss integration. @item GaussLegendre Numerical Gauss integration obtained by application of a multiplicative rule on the one-dimensional Gauss integration. @end ftable @noindent @var{element-type}: @ftable @code @item Line Line (2 nodes, 1 edge, 1 volume) (#1). @item Triangle Triangle (3 nodes, 3 edges, 1 facet, 1 volume) (#2). @item Quadrangle Quadrangle (4 nodes, 4 edges, 1 facet, 1 volume) (#3). @item Tetrahedron Tetrahedron (4 nodes, 6 edges, 4 facets, 1 volume) (#4). @item Hexahedron Hexahedron (8 nodes, 12 edges, 6 facets, 1 volume) (#5). @item Prism Prism (6 nodes, 9 edges, 5 facets, 1 volume) (#6). @item Pyramid Pyramid (5 nodes, 8 edges, 5 facets, 1 volume) (#7). @item Point Point (1 node) (#15). @end ftable @noindent Note: @enumerate @item @var{n} in (#@var{n}) is the type number of the element (@pxref{Input file format}). @end enumerate @c ------------------------------------------------------------------------- @c Formulation @c ------------------------------------------------------------------------- @node Types for Formulation, Types for Resolution, Types for Integration, Types for objects @section Types for @code{Formulation} @cindex Formulation, types @vindex @var{formulation-type} @vindex @var{local-term-type} @vindex @var{quantity-type} @vindex @var{term-op-type} @noindent @var{formulation-type}: @ftable @code @item FemEquation Finite element method formulation (all methods of moments, integral methods). @end ftable @noindent @var{local-term-type}: @ftable @code @item Galerkin Integral of Galerkin type. @item deRham deRham projection (collocation). @end ftable @noindent @var{quantity-type}: @ftable @code @item Local Local quantity defining a field in a function space. In case a subspace is considered, its identifier has to be given between the brackets following the @code{NameOfSpace @var{function-space-id}}. @item Global Global quantity defining a global quantity from a function space. The identifier of this quantity has to be given between the brackets following the @code{NameOfSpace @var{function-space-id}}. @item Integral Integral quantity obtained by the integration of a @code{LocalQuantity} before its use in an @code{Equation} term. @end ftable @noindent @var{term-op-type}: @ftable @code @item Dt Time derivative applied to the whole term of the equation. (Not implemented yet.) @item DtDof Time derivative applied only to the @code{Dof@{@}} term of the equation. @item DtDt Time derivative of 2nd order applied to the whole term of the equation. (Not implemented yet.) @item DtDtDof Time derivative of 2nd order applied only to the @code{Dof@{@}} term of the equation. @item JacNL Nonlinear part of the Jacobian matrix (tangent stiffness matrix) to be assembled for nonlinear analysis. @item DtDofJacNL Nonlinear part of the Jacobian matrix for the first order time derivative (tangent mass matrix) to be assembled for nonlinear analysis. @item NeverDt No time scheme applied to the term (e.g., Theta is always 1 even if a theta scheme is applied). @end ftable @c ------------------------------------------------------------------------- @c Resolution @c ------------------------------------------------------------------------- @node Types for Resolution, Types for PostProcessing, Types for Formulation, Types for objects @section Types for @code{Resolution} @cindex Resolution, types @vindex @var{resolution-op} @noindent @var{resolution-op}: @ftable @code @item Generate @code{[@var{system-id}]} Generate the system of equations @var{system-id}. @item Solve @code{[@var{system-id}]} Solve the system of equations @var{system-id}. @item SolveAgain @code{[@var{system-id}]} Save as @code{Solve}, but reuses the preconditionner when called multiple times. @item GenerateJac @code{[@var{system-id}]} Generate the system of equations @var{system-id} using a jacobian matrix (of which the unknowns are corrections @var{dx} of the current solution @var{x}). @c FIXME: explain this better @item SolveJac @code{[@var{system-id}]} Solve the system of equations @var{system-id} using a jacobian matrix (of which the unknowns are corrections @var{dx} of the current solution @var{x}). Then, Increment the solution (@var{x}=@var{x}+@var{dx}) and compute the relative error @var{dx}/@var{x}. @c FIXME: explain this better, using equations. Write out explicitly the @c formulas when there is a JacNL term, and when there isn't @c @c (A(x) + JacNL(x)) dx = b(x) - A(x) x ; @c x <- x + dx @item GenerateSeparate @code{[@var{system-id}]} Generate matrices separately for @code{DtDtDof}, @code{DtDof} and @code{NoDt} terms in @var{system-id}. The separate matrices can be used with the @code{Update} operation (for efficient time domain analysis of linear PDEs with constant coefficients), or with the @code{EigenSolve} operation (for solving generalized eigenvalue problems). @item GenerateOnly @code{[@var{system-id}, @var{expression-cst-list}]} Not documented yet. @item GenerateOnlyJac @code{[@var{system-id}, @var{expression-cst-list}]} Not documented yet. @item GenerateGroup Not documented yet. @item GenerateRHSGroup Not documented yet. @item Update @code{[@var{system-id}]} Update the system of equations @var{system-id} (built from sub-matrices generated separately with @code{GenerateSeparate}) with the @code{TimeFunction}(s) provided in @code{Assign} constraints. This assumes that the problem is linear, that the matrix coefficients are independent of time, and that all sources are imposed using @code{Assign} constraints. @item Update @code{[@var{system-id}, @var{expression}]} Update the system of equations @var{system-id} (built from sub-matrices generated separately with @code{GenerateSeparate}) with @var{expression}. This assumes that the problem is linear, that the matrix coefficients are independent of time, and that the right-hand-side of the linear system can simply be multiplied by @var{expression} at each step. @item UpdateConstraint @code{[@var{system-id}, @var{group-id}, @var{constraint-type}]} Recompute the constraint of type @var{constraint-type} acting on @var{group-id} during processing. @item GetResidual @code{[@var{system-id}, $@var{variable-id}]} Compute the residual @code{r = b - A x} and store its L2 norm in the run-time variable $@var{variable-id}. @item SwapSolutionAndResidual @code{[@var{system-id}]} Swap the solution @code{x} and residual @code{r} vectors. @item SwapSolutionAndRHS @code{[@var{system-id}]} Swap the solution @code{x} and RHS @code{b} vectors. @item InitSolution @code{[@var{system-id}]} Creates a new solution vector, adds it to the solution vector list for @var{system-id}, and initializes the solution. The values in the vector are initialized to the the values given in a @code{Constraint} of @code{Init} type (if two values are given in @code{Init}, the second value is used). If no constraint is provided, the values are initialized to zero if the solution vector is the first in the solution list; otherwise the values are initialized using the previous solution in the list. @item InitSolution1 @code{[@var{system-id}]} Same as @{InitSolution}, but uses the first value given in the @code{Init} constraints. @item CreateSolution @code{[@var{system-id}]} Creates a new solution vector, adds it to the solution vector list for @var{system-id}, and initializes the solution to zero. @item CreateSolution @code{[@var{system-id}, @var{expression-cst}]} Same as @code{CreateSolution}, but initialize the solution by copying the @var{expression-cst}th solution in the solution list. @item Apply @code{[@var{system-id}]} @code{x <- Ax} @item SetSolutionAsRHS @code{[@var{system-id}]} @code{b <- x} @item SetRHSAsSolution @code{[@var{system-id}]} @code{x <- b} @item Residual @code{[@var{system-id}]} @code{x <- b - Ax} @item SaveSolution @code{[@var{system-id}]} Save the solution of the system of equations @var{system-id}. @item SaveSolutions @code{[@var{system-id}]} Save all the solutions available for the system of equations @var{system-id}. This should be used with algorithms that generate more than one solution at once, e.g., @code{EigenSolve} or @code{FourierTransform}. @item TransferSolution @code{[@var{system-id}]} Transfer the solution of system @var{system-id}, as an @code{Assign} constraint, to the system of equations defined with a @code{DestinationSystem} command. This is used with the @code{AssignFromResolution} constraint type (@pxref{Types for Constraint}). @item TransferInitSolution @code{[@var{system-id}]} Transfer the solution of system @var{system-id}, as an @code{Init} constraint, to the system of equations defined with a @code{DestinationSystem} command. This is used with the @code{InitFromResolution} constraint type (@pxref{Types for Constraint}). @item Evaluate @code{[@var{expression} <, @var{expression}>]} Evaluate the @var{expression}(s). @item SetTime @code{[@var{expression}]} Change the current time. @item SetTimeStep @code{[@var{expression}]} Change the current time step. @item SetFrequency @code{[@var{system-id}, @var{expression}]} Change the frequency of system @var{system-id}. @item SystemCommand @code{[@var{expression-char}]} Execute the system command given by @var{expression-char}. @item Error @code{[@var{expression-char}]} Output error message @var{expression-char}. @item Test @code{[@var{expression}] @{ @var{resolution-op} @}} If @var{expression} is true (nonzero), perform the operations in @var{resolution-op}. @item Test @code{[@var{expression}] @{ @var{resolution-op} @} @{ @var{resolution-op} @}} If @var{expression} is true (nonzero), perform the operations in the first @var{resolution-op}, else perform the operations in the second @var{resolution-op}. @item While @code{[@var{expression}] @{ @var{resolution-op} @}} While @var{expression} is true (nonzero), perform the operations in @var{resolution-op}. @item Break Aborts an iterative loop, a time loop or a While loop. @item Sleep @code{[@var{expression}]} Sleeps for @var{expression} seconds; @item SetCommSelf Changes MPI communicator to self. @item SetCommWorld Changes MPI communicator to world. @item Barrier MPI barrier (blocks until all processes have reached this call). @item BroadcastFields @code{[ < @var{expression-list} > ]} Broadcast all fields over MPI (except those listed in the list). @item Print @code{[ @{ @var{expression-list} @} <, File @var{expression-char} > <, Format @var{expression-char} > ]} Print the expressions listed in @var{expression-list}. If @code{Format} is given, use it to format the (scalar) expressions like @code{Printf}. @item Print @code{[ @var{system-id} <, File @var{expression-char} > <, @{ @var{expression-cst-list} @} >}@* @code{<, TimeStep @{ @var{expression-cst-list} @} >]} Print the system @var{system-id}. If the @var{expression-cst-list} is given, print only the values of the degrees of freedom given in that list. If the @code{TimeStep} option is present, limit the printing to the selected time steps. @item EigenSolve @code{[@var{system-id}, @var{expression-cst}, @var{expression-cst}, @var{expression-cst} < , @var{expression} > ]} Eigenvalue/eigenvector computation using Arpack or SLEPc. The parameters are: the system (which has to be generated with @code{GenerateSeparate[]}), the number of eigenvalues/eigenvectors to compute and the real and imaginary spectral shift (around which to look for eigenvalues). The last optional argument allows to filter which eigenvalue/eigenvector pairs will be saved. For example, @code{($EigenvalueReal > 0)} would only keep pairs corresponding to eigenvalues with a striclty positive real part. @item Lanczos @code{[@var{system-id}, @var{expression-cst}, @{ @var{expression-cst-list} @} , @var{expression-cst}]} Eigenvalue/eigenvector computation using the Lanczos algorithm. The parameters are: the system (which has to be generated with @code{GenerateSeparate[]}), the size of the Lanczos space, the indices of the eigenvalues/eigenvectors to store, the spectral shift. This routine is deprecated: use @code{EigenSolve} instead. @item FourierTransform @code{[@var{system-id}, @var{system-id}, @{ @var{expression-cst-list} @}]} On-the-fly computation of a discrete Fourier transform. The parameters are: the (time domain) system, the destination system in which the result of the Fourier tranform is to be saved (it should be declared with @code{Type Complex}), the list of frequencies to consider in the discrete Fourier transform. @item TimeLoopTheta @code{[@var{expression-cst},@var{expression-cst},@var{expression},@var{expression-cst}]} @code{@{ @var{resolution-op} @}} Time loop of a theta scheme. The parameters are: the initial time, the end time, the time step and the theta parameter (e.g., 1 for implicit Euler, 0.5 for Crank-Nicholson). Warning: GetDP automatically handles time-dependent constraints when they are provided using the @code{TimeFunction} mechanism in an @code{Assign}-type @code{Constraint} (@pxref{Constraint}). However, GetDP cannot automatically transform general time-dependent source terms in weak formulations (time-dependent functions written in a @code{Galerkin} term). Such source terms will be correctly treated only for implicit Euler, as the expression in the @code{Galerkin} term is evaluated at the current time step. For other schemes, the source term should be written explicitly, by splitting it in two (@code{theta f_n+1 + (1-theta) f_n}), making use of the @code{AtAnteriorTimeStep[]} for the second part, and specifying @code{NeverDt} in the @code{Galerkin} term. @item TimeLoopNewmark @code{[@var{expression-cst},@var{expression-cst},@var{expression},@var{expression-cst},@var{expression-cst}]}@* @{ @var{resolution-op} @} Time loop of a Newmark scheme. The parameters are: the initial time, the end time, the time step, the beta and the gamma parameter. Warning: same restrictions apply for time-dependent functions in the weak formulations as for @code{TimeLoopTheta}. @item TimeLoopAdaptive @code{[@var{expression-cst},@var{expression-cst},@var{expression-cst},@var{expression-cst}, @var{expression-cst},@var{integration-method},<@var{expression-cst-list}>,@* System @{ @{@var{system-id},@var{expression-cst},@var{expression-cst},@var{norm-type}@} ... @} |@* PostOperation @{ @{@var{post-operation-id},@var{expression-cst},@var{expression-cst},@var{norm-type}@} ... @} ]}@* @code{@{ @var{resolution-op} @}}@* @code{@{ @var{resolution-op} @}} Time loop with variable time steps. The step size is adjusted according the local truncation error (LTE) of the specified Systems/PostOperations via a predictor-corrector method.@* The parameters are: start time, end time, initial time step, min. time step, max. time step, integration method, list of breakpoints (time points to be hit). The LTE calculation can be based on all DOFs of a system and/or on a PostOperation result. The parameters here are: System/PostOperation for LTE assessment, relative LTE tolerance, absolute LTE tolerance, norm-type for LTE calculation.@* Possible choices for @var{integration-method} are: @code{Euler, Trapezoidal, Gear_2, Gear_3, Gear_4, Gear_5, Gear_6}. The Gear methods correspond to backward differentiation formulas of order 2..6.@* Possible choices for @var{norm-type}: @code{L1Norm, MeanL1Norm, L2Norm, MeanL2Norm, LinfNorm}.@* @code{MeanL1Norm} and @code{MeanL2Norm} correspond to @code{L1Norm} and @code{L2Norm} divided by the number of degrees of freedom, respectively.@* The first @var{resolution-op} is executed every time step. The second one is only executed if the actual time step is accepted (LTE is in the specified range). E.g. @code{SaveSolution[]} is usually placed in the 2nd @var{resolution-op}.@* See @url{https://geuz.org/trac/getdp/wiki/TimeLoopAdaptive} for more details and an example. @item IterativeLoop @code{[@var{expression-cst},@var{expression},@var{expression-cst}<,@var{expression-cst}>]} @{ @var{resolution-op} @} Iterative loop for nonlinear analysis. The parameters are: the maximum number of iterations (if no convergence), the relaxation factor (multiplies the iterative correction @var{dx}) and the relative error to achieve. The optional parameter is a flag for testing purposes. @item IterativeLoopN @code{[@var{expression-cst},@var{expression},@* System @{ @{@var{system-id},@var{expression-cst},@var{expression-cst}, @var{assessed-object} @var{norm-type}@} ... @} |@* PostOperation @{ @{@var{post-operation-id},@var{expression-cst},@var{expression-cst}, @var{norm-type}@} ... @} ]}@* @{ @var{resolution-op} @} Similar to @code{IterativeLoop[]} but allows to specify in detail the tolerances and the type of norm to be calculated for convergence assessment.@* The parameters are: the maximum number of iterations (if no convergence), the relaxation factor (multiplies the iterative correction @var{dx}). The convergence assessment can be based on all DOFs of a system and/or on a PostOperation result. The parameters here are: System/PostOperation for convergence assessment, relative tolerance, absolute tolerance, assessed object (only applicable for a specified system), norm-type for error calculation.@* Possible choices for @var{assessed-object}: @code{Solution, Residual, RecalcResidual}. @code{Residual} assesses the residual from the last iteration whereas @code{RecalcResidual} calculates the residual once again after each iteration. This means that with @code{Residual} usually one extra iteration is performed, but @code{RecalcResidual} causes higher computational effort per iteration. Assessing the residual can only be used for Newton's method.@* Possible choices for @var{norm-type}: @code{L1Norm, MeanL1Norm, L2Norm, MeanL2Norm, LinfNorm}.@* @code{MeanL1Norm} and @code{MeanL2Norm} correspond to @code{L1Norm} and @code{L2Norm} divided by the number of degrees of freedom, respectively.@* See @url{https://geuz.org/trac/getdp/wiki/IterativeLoopN} for more details and an example. @item IterativeLinearSolver Generic iterative linear solver. To be documented. @item PostOperation @code{[@var{post-operation-id}]} Perform the specified @code{PostOperation}. @item GmshRead @code{[@var{expression-char}]} When GetDP is linked with the Gmsh library, read a file using Gmsh. This file can be in any format recognized by Gmsh. If the file contains one or multiple post-processing fields, these fields will be evaluated using the built-in @code{Field[]}, @code{ScalarField[]}, @code{VectorField[]}, etc., functions (@pxref{Miscellaneous functions}). (Note that @code{GmshOpen} and @code{GmshMerge} can be used instead of @code{GmshRead} to force Gmsh to do classical ``open'' and ``merge'' operations, instead of trying to ``be intelligent'' when reading post-processing datasets, i.e., creating new models on the fly if necessary.) @item GmshRead @code{[@var{expression-char}, @var{expression-cst}]} Same thing as the @code{GmshRead} command above, except that the field is forced to be stored with the given tag. The tag can be used to retrieve the given field with the built-in @code{Field[]}, @code{ScalarField[]}, @code{VectorField[]}, etc., functions (@pxref{Miscellaneous functions}). @item GmshWrite @code{[@var{expression-char}, @var{expression-cst}]} Writes the a Gmsh field to disk. (The format is guessed from the file extension.) @item GmshClearAll Clears all Gmsh data (loaded with @code{GmshRead} and friends). @item DeleteFile @code{[@var{expression-char}]} Delete a file. @item RenameFile @code{[@var{expression-char}, @var{expression-char}]} Rename a file. @item CreateDir | CreateDirectory @code{[@var{expression-char}]} Create a directory. @c todo: @c @item Perturbation @c @item ChangeOfCoordinates @c @item SaveMesh @c @item DeformeMesh @c @item IterativeTimeReduction @c @{ @var{iterative-time-reduction-arg}; @} @c @c Iterative reduction of time interval to delimit variations of solutions @c (e.g., used in types of nonlinear analyses). @end ftable @c todo: Patrick, la suite est-elle comprehensible ? @c @noindent @c @var{iterative-time-reduction-arg}: @c @ftable @code @c @item NbrMaxIteration @c @var{expression-cst} @c Maximum number of iterations (if no convergence). @c @item DivisionCoefficient @c @var{expression-cst} @c Division coefficient of the time interval (usually 2 for dichotomy). @c @item Criterion @c @var{expression-cst} @c Dimension of the time interval to achieve before stopping divisions. @c @item Flag @c @var{expression-cst} @c Option for test. [To be explained later.] @c @item System @c @var{system-id} @c System containing the quantities to test. @c @item ChangeOfState @c @{ @{ @var{change-of-state-arg} @} @dots{} @} @c Tests to perform. @c @item Operation @c @{ < @var{resolution-op}; > @dots{} @} @c Operations to perform at each step. @c @item OperationEnd @c @{ < @var{resolution-op}; > @dots{} @} @c Operations to perform after the last iteration (when leaving the loop). @c @end ftable @c @noindent @c @var{change-of-state-arg}: @c @ftable @code @c @item Type @c @var{change-of-state-type} @c Type of change of state analysis. @c @item Quantity @c @var{quantity-id} @c @itemx In @c @var{group-def} @c Global quantity to analyse. @c @item Criterion @c @var{expression-cst} @c Relative error accepted. @c @item Function @c @var{expression} @c Reference function. @c @end ftable @c @noindent @c @var{change-of-state-type}: @c @ftable @code @c @item ChangeSign @c Test of change of sign of quantities. @c @item ChangeLevel @c Test of change of level of quantities. @c @item ChangeReference @c Compare quantities to reference functions (e.g., for regulation). @c @item ChangeReference2 @c Compare quantities to reference functions (e.g., for regulation). @c @end ftable @c ------------------------------------------------------------------------- @c PostProcessing @c ------------------------------------------------------------------------- @node Types for PostProcessing, Types for PostOperation, Types for Resolution, Types for objects @section Types for @code{PostProcessing} @cindex Post-processing, types @vindex @var{post-value} @noindent @var{post-value}: @ftable @code @item Local @{ @var{local-value} @} To compute a local quantity. @item Integral @{ @var{integral-value} @} To integrate the expression over each element. @end ftable @c ------------------------------------------------------------------------- @c PostOperation @c ------------------------------------------------------------------------- @node Types for PostOperation, , Types for PostProcessing, Types for objects @section Types for @code{PostOperation} @cindex Post-operation, types @vindex @var{print-support} @noindent @var{print-support}: @ftable @code @item OnElementsOf @var{group-def} To compute a quantity on the elements belonging to the region @var{group-def}, where the solution was computed during the processing stage. @item OnRegion @var{group-def} To compute a global quantity associated with the region @var{group-def}. @item OnGlobal To compute a global integral quantity, with no associated region. @item OnSection @{ @{ @var{expression-cst-list} @} @{ @var{expression-cst-list} @} @{ @var{expression-cst-list} @} @} To compute a quantity on a section of the mesh defined by three points (i.e., on the intersection of the mesh with a cutting a plane, specified by three points). Each @var{expression-cst-list} must contain exactly three elements (the coordinates of the points). @item OnGrid @var{group-def} To compute a quantity in elements of a mesh which differs from the real support of the solution. @code{OnGrid @var{group-def}} differs from @code{OnElementsOf @var{group-def}} by the reinterpolation that must be performed. @item OnGrid @code{@{ @var{expression}, @var{expression}, @var{expression} @}}@* @code{@{ @var{expression-cst-list-item} | @{ @var{expression-cst-list} @} ,}@* @code{@: @: @var{expression-cst-list-item} | @{ @var{expression-cst-list} @} ,}@* @code{@: @: @var{expression-cst-list-item} | @{ @var{expression-cst-list} @} @}} To compute a quantity on a parametric grid. The three @var{expression}s represent the three cartesian coordinates @var{x}, @var{y} and @var{z}, and can be functions of the current values @code{$A}, @code{$B} and @code{$C}. The values for @code{$A}, @code{$B} and @code{$C} are specified by each @var{expression-cst-list-item} or @var{expression-cst-list}. For example, @code{OnGrid @{Cos[$A], Sin[$A], 0@} @{ 0:2*Pi:Pi/180, 0, 0 @}} will compute the quantity on 360 points equally distributed on a circle in the z=0 plane, and centered on the origin. @item OnPoint @{ @var{expression-cst-list} @} To compute a quantity at a point. The @var{expression-cst-list} must contain exactly three elements (the coordinates of the point). @item OnLine @{ @{ @var{expression-cst-list} @} @{ @var{expression-cst-list} @} @} @{ @var{expression-cst} @} To compute a quantity along a line (given by its two end points), with an associated number of divisions equal to @var{expression-cst}. The interpolation points on the line are equidistant. Each @var{expression-cst-list} must contain exactly three elements (the coordinates of the points). @item OnPlane @{ @{ @var{expression-cst-list} @} @{ @var{expression-cst-list} @} @{ @var{expression-cst-list} @} @}@* @code{@{ @var{expression-cst}, @var{expression-cst} @}} To compute a quantity on a plane (specified by three points), with an associated number of divisions equal to each @var{expression-cst} along both generating directions. Each @var{expression-cst-list} must contain exactly three elements (the coordinates of the points). @item OnBox @{ @{ @var{expression-cst-list} @} @{ @var{expression-cst-list} @} @{ @var{expression-cst-list} @}@* @code{@: @: @{ @var{expression-cst-list} @} @} @{ @var{expression-cst}, @var{expression-cst}, @var{expression-cst} @}} To compute a quantity in a box (specified by four points), with an associated number of divisions equal to each @var{expression-cst} along the three generating directions. Each @var{expression-cst-list} must contain exactly three elements (the coordinates of the points). @c todo: OnRegion WithArgument @c Il faudrait en fait plutot ajouter WithArgument comme une option @c accessible partout, et retravailler le post en ce sens... @c en tout cas, iul faut changer la syntaxe de WithArgument pour utiliser @c uniquement une expression-cst-list, et non plus uniquement start, end, num. @end ftable @vindex @var{print-option} @noindent @var{print-option}: @ftable @code @item File @code{@var{expression-char}} Outputs the result in a file named @var{expression-char}. @item File @code{> @var{expression-char}} Same as @code{File @var{expression-char}}, except that, if several @code{File > @var{expression-char}} options appear in the same @code{PostOperation}, the results are concatenated in the file @var{expression-char}. @item File @code{>> @var{expression-char}} Appends the result to a file named @var{expression-char}. @item AppendToExistingFile @var{expression-cst} Appends the result to the file specified with @code{File}. (Same behavior as @code{>} if @var{expression-cst} = 1; same behavior as @code{>>} if @var{expression-cst} = 2.) @item Name @code{@var{expression-char}} For formats that support it, sets the label of the output field to @var{expression-char}. @item Depth @var{expression-cst} Recursive division of the elements if @var{expression-cst} is greater than zero, derefinement if @var{expression-cst} is smaller than zero. If @var{expression-cst} is equal to zero, evaluation at the barycenter of the elements. @item Skin Computes the result on the boundary of the region. @item Smoothing < @var{expression-cst} > Smoothes the solution at the nodes. @item HarmonicToTime @var{expression-cst} Converts a harmonic solution into a time-dependent one (with @var{expression-cst} steps). @item Dimension @var{expression-cst} Forces the dimension of the elements to consider in an element search. Specifies the problem dimension during an adaptation (h- or p-refinement). @item TimeStep @code{@var{expression-cst-list-item} | @{ @var{expression-cst-list} @}} Outputs results for the specified time steps only. @item TimeValue @code{@var{expression-cst-list-item} | @{ @var{expression-cst-list} @}} Outputs results for the specified time value(s) only. @item TimeImagValue @code{@var{expression-cst-list-item} | @{ @var{expression-cst-list} @}} Outputs results for the specified imaginary time value(s) only. @item LastTimeStepOnly Outputs results for the last time step only (useful when calling a @code{PostOperation} directly in a @code{Resolution}, for example). @item AppendExpressionToFileName @var{expression} Evaluate the given @var{expression} at run-time and append it to the filename. @item AppendExpressionFormat @var{expression-char} C-style format string for printing the @var{expression} provided in @code{AppendExpressionToFileName}. Default is @code{"%.16g"}. @item AppendTimeStepToFileName < @var{expression-cst} > Appends the time step to the output file; only makes sense with @code{LastTimeStepOnly}. @item AppendStringToFileName @var{expression-char} Append the given @var{expression-char} to the filename. @item OverrideTimeStepValue @var{expression-cst} Overrides the value of the current time step with the given value. @item NoMesh < @var{expression-cst} > Prevents the mesh from being written in the output file (useful with new mesh-based solution formats). @item SendToServer @var{expression-char} Send the value to the Onelab server, using @var{expression-char} as the paramater name. @item Color @var{expression-char} Used with @code{SendToServer}, sets the color of the parameter in the Onelab server. @item Frequency @code{@var{expression-cst-list-item} | @{ @var{expression-cst-list} @}} Outputs results for the specified frequencies only. @item Format @var{post-operation-fmt} Outputs results in the specified format. @item Adapt @code{P1 | H1 | H2} Performs p- or h-refinement on the post-processing result, considered as an error map. @item Target @var{expression-cst} Specifies the target for the optimizer during adaptation (error for @code{P1|H1}, number of elements for @code{H2}). @item Value @code{@var{expression-cst-list-item} | @{ @var{expression-cst-list} @}} Specifies acceptable output values for discrete optimization (e.g. the available interpolation orders with @code{Adapt P1}). @item Sort @code{Position | Connection} Sorts the output by position (x, y, z) or by connection (for @code{LINE} elements only). @item Iso @var{expression-cst} Outputs directly contour prints (with @var{expression-cst} values) instead of elementary values. @item Iso @code{@{ @var{expression-cst-list} @}} Outputs directly contour prints for the values specified in the @var{expression-cst-list} instead of elementary values. @item NoNewLine Suppresses the new lines in the output when printing global quantities (i.e., with @code{Print OnRegion} or @code{Print OnGlobal}). @item ChangeOfCoordinates @code{@{ @var{expression}, @var{expression}, @var{expression} @}} Changes the coordinates of the results according to the three expressions given in argument. The three @var{expression}s represent the three new cartesian coordinates @var{x}, @var{y} and @var{z}, and can be functions of the current values of the cartesian coordinates @code{$X}, @code{$Y} and @code{$Z}. @item ChangeOfValues @code{@{ @var{expression-list} @}} Changes the values of the results according to the expressions given in argument. The @var{expression}s represent the new values (@var{x}-compoment, @var{y}-component, etc.), and can be functions of the current values of the solution (@var{$Val0}, @var{$Val1}, etc.). @item DecomposeInSimplex Decomposes all output elements in simplices (points, lines, triangles or tetrahedra). @item StoreInVariable @code{$@var{expression-char}} Stores the result of a point-wise evaluation or an @code{OnRegion} post-processing operation in the run-time variable $code[$]@var{expression-char}. @item StoreInRegister @code{@var{expression-cst}} Stores the result of point-wise evaluation or an @code{OnRegion} post-processing operation in the register @var{expression-cst}. @item StoreMinInRegister @item StoreMaxInRegister @code{@var{expression-cst}} Stores the minimum or maximum value of an @code{OnElementsOf} post-processing operation in the register @var{expression-cst}. @item StoreMinXinRegister @item StoreMinYinRegister @item StoreMinZinRegister @item StoreMaxXinRegister @item StoreMaxYinRegister @item StoreMaxZinRegister @code{@var{expression-cst}} Stores the X, Y or Z coordinate of the location, where the minimum or maximum of an @code{OnElementsOf} post-processing operation occurs, in the register @var{expression-cst}. @item StoreInField @code{@var{expression-cst}} Stores the result of a post-processing operation in the field (Gmsh list-based post-processing view) with tag @var{expression-cst}. @item StoreInMeshBasedField @code{@var{expression-cst}} Stores the result of a post-processing operation in the mesh-based field (Gmsh mesh-based post-processing view) with tag @var{expression-cst}. @item TimeLegend @code{< @{ @var{expression}, @var{expression}, @var{expression} @} >} Includes a time legend in Gmsh plots. If the three optional expressions giving the position of the legend are not specified, the legend is centered on top of the plot. @item FrequencyLegend @code{< @{ @var{expression}, @var{expression}, @var{expression} @} >} Includes a frequency legend in Gmsh plots. If the three optional expressions giving the position of the legend are not specified, the legend is centered on top of the plot. @item EigenvalueLegend @code{< @{ @var{expression}, @var{expression}, @var{expression} @} >} Includes an eigenvalue legend in Gmsh plots. If the three optional expressions giving the position of the legend are not specified, the legend is centered on top of the plot. @end ftable @vindex @var{post-operation-fmt} @noindent @var{post-operation-fmt}: @ftable @code @item Gmsh @itemx GmshParsed Gmsh output. See @ref{Input file format} and the documentation of Gmsh (@url{http://geuz.org/gmsh}) for a description of the file formats. @item Table Space oriented column output, e.g., suitable for Gnuplot, Excel, Caleida Graph, etc. The columns are: @var{element-type} @var{element-index} @var{x-coord} @var{y-coord} @var{z-coord} <@var{x-coord} @var{y-coord} @var{z-coord}> @dots{} @var{real} @var{real} @var{real} @var{values}. The three @var{real} numbers preceding the @var{values} contain context-dependent information, depending on the type of plot: curvilinear abscissa for @code{OnLine} plots, normal to the plane for @code{OnPlane} plots, parametric coordinates for parametric @code{OnGrid} plots, etc. @item SimpleTable Like @code{Table}, but with only the @var{x-coord} @var{y-coord} @var{z-coord} and @var{values} columns. @item TimeTable Time oriented column output, e.g., suitable for Gnuplot, Excel, Caleida Graph, etc. The columns are: @var{time-step} @var{time} @var{x-coord} @var{y-coord} @var{z-coord} <@var{x-coord} @var{y-coord} @var{z-coord}> @dots{} @var{value}. @item NodeTable Table of node values. The first value corresponds to the number of listed nodes. The columns of the following lines are: @var{node-number} @var{node-value}(s) @item Gnuplot Space oriented column output similar to the @code{Table} format, except that a new line is created for each node of each element, with a repetition of the first node if the number of nodes in the element is greater than 2. This permits to draw unstructured meshes and nice three-dimensional elevation plots in Gnuplot. The columns are: @var{element-type} @var{element-index} @var{x-coord} @var{y-coord} @var{z-coord} @var{real} @var{real} @var{real} @var{values}. The three @var{real} numbers preceding the @var{values} contain context-dependent information, depending on the type of plot: curvilinear abscissa for @code{OnLine} plots, normal to the plane for @code{OnPlane} plots, parametric coordinates for parametric @code{OnGrid} plots, etc. @item Adaptation Adaptation map, suitable for the GetDP @code{-adapt} command line option. @end ftable @c ========================================================================= @c Short Examples @c ========================================================================= @node Short examples, Complete examples, Types for objects, Top @chapter Short examples @cindex Short examples @cindex Examples, short @menu * Constant expression examples:: * Group examples:: * Function examples:: * Constraint examples:: * FunctionSpace examples:: * Jacobian examples:: * Integration examples:: * Formulation examples:: * Resolution examples:: * PostProcessing examples:: * PostOperation examples:: @end menu @c ------------------------------------------------------------------------- @c Constant Expression Examples @c ------------------------------------------------------------------------- @node Constant expression examples, Group examples, Short examples, Short examples @section Constant expression examples The simplest constant expression consists of an @var{integer} or a @var{real} number as in @example 21 -3 @end example @noindent or @example -3.1415 27e3 -290.53e-12 @end example @noindent Using operators and the classic math functions, @var{constant-id}s can be defined: @example c1 = Sin[2/3*3.1415] * 5000^2; c2 = -1/c1; @end example @c todo: ajouter un exemple de liste et de string @c ------------------------------------------------------------------------- @c Group Examples @c ------------------------------------------------------------------------- @node Group examples, Function examples, Constant expression examples, Short examples @section @code{Group} examples @cindex Group, examples Let us assume that some elements in the input mesh have the region numbers 1000, 2000 and 3000. In the definitions @example Group @{ Air = Region[1000]; Core = Region[2000]; Inductor = Region[3000]; NonConductingDomain = Region[@{Air, Core@}]; ConductingDomain = Region[@{Inductor@}]; @} @end example @noindent @code{Air}, @code{Core}, @code{Inductor} are identifiers of elementary region groups while @code{NonConductingDom@-ain} and @code{ConductingDomain} are global region groups. Groups of function type contain lists of entities built on the region groups appearing in their arguments. For example, @example NodesOf[NonConductingDomain] @end example @noindent represents the group of nodes of geometrical elements belonging to the regions in @code{NonConduc@-tingDomain} and @example EdgesOf[DomainC, Not SkinDomainC] @end example @noindent represents the group of edges of geometrical elements belonging to the regions in @code{DomainC} but not to those of @code{SkinDomainC}. @c ------------------------------------------------------------------------- @c Function Examples @c ------------------------------------------------------------------------- @node Function examples, Constraint examples, Group examples, Short examples @section @code{Function} examples @cindex Function, examples A physical characteristic is a piecewise defined function. The magnetic permeability @code{mu[]} can for example be defined in the considered regions by @example Function @{ mu[Air] = 4.e-7*Pi; mu[Core] = 1000.*4.e-7*Pi; @} @end example @noindent A nonlinear characteristic can be defined through an @var{expression} with arguments, e.g., @example Function @{ mu0 = 4.e-7*Pi; a1 = 1000.; b1 = 100.; // Constants mu[NonlinearCore] = mu0 + 1./(a1+b1*Norm[$1]^6); @} @end example @noindent where function @code{mu[]} in region @code{NonLinearCore} has one argument @code{$1} which has to be the magnetic flux density. This function is actually called when writing the equations of a formulation, which permits to directly extend it to a nonlinear form by adding only the necessary arguments. For example, in a magnetic vector potential formulation, one may write @code{mu[@{Curl a@}]} instead of @code{mu[]} in @code{Equation} terms (@pxref{Formulation examples}). Multiple arguments can be specified in a similar way: writing @code{mu[@{Curl a@},@{T@}]} in an @code{Equation} term will provide the function @code{mu[]} with two usable arguments, @code{$1} (the magnetic flux density) and @code{$2} (the temperature). It is also possible to directly interpolate one-dimensional functions from tabulated data. In the following example, the function @var{f}(@var{x}) as well as its derivative @var{f}'(@var{x}) are interpolated from the (@var{x},@var{f}(@var{x})) couples (0,0.65), (1,0.72), (2,0.98) and (3,1.12): @example Function @{ couples = @{0, 0.65 , 1, 0.72 , 2, 0.98 , 3, 1.12@}; f[] = InterpolationLinear[$1]@{List[couples]@}; dfdx[] = dInterpolationLinear[$1]@{List[couples]@}; @} @end example @noindent The function @code{f[]} may then be called in an @code{Equation} term of a @code{Formulation} with one argument, @var{x}. Notice how the list of constants @code{List[couples]} is supplied as a list of parameters to the built-in function @code{InterpolationLinear} (@pxref{Constants}, as well as @ref{Functions}). In order to facilitate the construction of such interpolations, the couples can also be specified in two separate lists, merged with the alternate list @code{ListAlt} command (@pxref{Constants}): @example Function @{ data_x = @{0, 1, 2, 3@}; data_f = @{0.65, 0.72, 0.98, 1.12@}; f[] = InterpolationLinear[$1]@{ListAlt[data_x, data_f]@}; dfdx[] = dInterpolationLinear[$1]@{ListAlt[data_x, data_f]@}; @} @end example @noindent In order to optimize the evaluation time of complex expressions, registers may be used (@pxref{Run-time variables and registers}). For example, the evaluation of @code{g[] = f[$1]*Sin[f[$1]^2]} would require two (costly) linear interpolations. But the result of the evaluation of @code{f[]} may be stored in a register (for example the register 0) with @example g[] = f[$1]#0 * Sin[#0^2]; @end example @noindent thus reducing the number of evaluations of @code{f[]} (and of the argument @code{$1}) to one. The same results can be obtained using a run-time variable @code{$v}: @example g[] = ($v = f[$1]) * Sin[$v^2]; @end example A function can also be time dependent, e.g., @example Function @{ Freq = 50.; Phase = 30./180.*Pi; // Constants TimeFct_Sin[] = Sin [ 2.*Pi*Freq * $Time + Phase ]; TimeFct_Exp[] = Exp [ - $Time / 0.0119 ]; TimeFct_ExtSin[] = Sin_wt_p [] @{2.*Pi*Freq, Phase@}; @} @end example @noindent Note that @code{TimeFct_ExtSin[]} is identical to @code{TimeFct_Sin[]} in a time domain analysis, but also permits to define phasors implicitely in the case of harmonic analyses. @c ------------------------------------------------------------------------- @c Constraint Examples @c ------------------------------------------------------------------------- @node Constraint examples, FunctionSpace examples, Function examples, Short examples @section @code{Constraint} examples @cindex Constraint, examples Constraints are referred to in @code{FunctionSpace}s and are usually used for boundary conditions (@code{Assign} type). For example, essential conditions on two surface regions, @code{Surf0} and @code{Surf1}, will be first defined by @example Constraint @{ @{ Name DirichletBoundaryCondition1; Type Assign; Case @{ @{ Region Surf0; Value 0.; @} @{ Region Surf1; Value 1.; @} @} @} @} @end example @noindent The way the @code{Value}s are associated with @code{Region}s (with their nodes, their edges, their global regions, @dots{}) is defined in the @code{FunctionSpace}s which use the @code{Constraint}. In other words, a @code{Constraint} defines data but does not define the method to process them. A time dependent essential boundary condition on @code{Surf1} would be introduced as (cf.@: @ref{Function examples} for the definition of @code{TimeFct_Exp[]}): @example @{ Region Surf1; Value 1.; TimeFunction 3*TimeFct_Exp[] @} @end example @noindent It is important to notice that the time dependence cannot be introduced in the @code{Value} field, since the @code{Value} is only evaluated once during the pre-processing. Other constraints can be referred to in @code{Formulation}s. It is the case of those defining electrical circuit connections (@code{Network} type), e.g., @example Constraint @{ @{ Name ElectricalCircuit; Type Network; Case Circuit1 @{ @{ Region VoltageSource; Branch @{1,2@}; @} @{ Region PrimaryCoil; Branch @{1,2@}; @} @} Case Circuit2 @{ @{ Region SecondaryCoil; Branch @{1,2@}; @} @{ Region Charge; Branch @{1,2@}; @} @} @} @} @end example @noindent which defines two non-connected circuits (@code{Circuit1} and @code{Circuit2}), with an independent numbering of nodes: region @code{VoltageSource} is connected in parallel with region @code{PrimaryCoil}, and region @code{SecondaryCoil} is connected in parallel with region @code{Charge}. @c todo: ajouter un vrai exemple de circuit @c ------------------------------------------------------------------------- @c FunctionSpace Examples @c ------------------------------------------------------------------------- @node FunctionSpace examples, Jacobian examples, Constraint examples, Short examples @section @code{FunctionSpace} examples @cindex Function space, examples Various discrete function spaces can be defined in the frame of the finite element method. @menu * Conform space:: * High order space:: * Global values:: * Curl-conform space:: * Gauge condition:: * Coupled spaces:: * Multiply connected domains:: @end menu @c ......................................................................... @c Nodal Finite Element Spaces @c ......................................................................... @node Conform space, High order space, FunctionSpace examples, FunctionSpace examples @subsection Nodal finite element spaces The most elementary function space is the nodal finite element space, defined on a mesh of a domain @var{W} and denoted @i{S0(W)} (associated finite elements can be of various geometries), and associated with essential boundary conditions (Dirichlet conditions). It contains 0-forms, i.e., scalar fields of potential type: @tex $$ v = \sum_{n\in N} v_n s_n \quad v\in S^0(W) $$ @end tex @ifnottex @var{v} = Sum [ @var{vn} * @var{sn}, for all @var{n} in @var{N} ], @var{v} in @i{S0(W)} @end ifnottex @noindent where @var{N} is the set of nodes of @var{W}, @var{sn} is the nodal basis function associated with node @var{n} and @var{vn} is the value of @var{v} at node @var{n}. It is defined by @example FunctionSpace @{ @{ Name Hgrad_v; Type Form0; BasisFunction @{ @{ Name sn; NameOfCoef vn; Function BF_Node; Support Domain; Entity NodesOf[All]; @} @} Constraint @{ @{ NameOfCoef vn; EntityType NodesOf; NameOfConstraint DirichletBoundaryCondition1; @} @} @} @} @end example @noindent Function @code{sn} is the built-in basis function BF_Node associated with all nodes (@code{NodesOf}) in the mesh of @var{W} (@code{Domain}). Previously defined @code{Constraint DirichletBoundaryCondition1} (@pxref{Constraint examples}) is used as boundary condition. In the example above, @code{Entity NodesOf[All]} is preferred to @code{Entity NodesOf[Domain]}. In this way, the list of all the nodes of @code{Domain} will not have to be generated. All the nodes of each geometrical element in @code{Support Domain} will be directly taken into account. @c ......................................................................... @c High Order Nodal Finite Element Space @c ......................................................................... @node High order space, Global values, Conform space, FunctionSpace examples @subsection High order nodal finite element space Higher order finite elements can be directly taken into account by @code{BF_Node}. Hierarchical finite elements for 0-forms can be used by simply adding other basis functions (associated with other geometrical entities, e.g., edges and facets) to @code{BasisFunction}, e.g., @example @dots{} BasisFunction @{ @{ Name sn; NameOfCoef vn; Function BF_Node; Support Domain; Entity NodesOf[All]; @} @{ Name s2; NameOfCoef v2; Function BF_Node_2E; Support Domain; Entity EdgesOf[All]; @} @} @dots{} @end example @c ......................................................................... @c Nodal Finite Element Space with Floating Potentials @c ......................................................................... @node Global values, Curl-conform space, High order space, FunctionSpace examples @subsection Nodal finite element space with floating potentials A scalar potential with floating values @var{vf} on certain boundaries @var{Gf}, @var{f} in @var{Cf}, e.g., for electrostatic problems, can be expressed as @tex $$ v = \sum_{n\in N_v} v_n s_n + \sum_{f\in C_f} v_f s_f \quad v\in S^0(W) $$ @end tex @ifnottex @var{v} = Sum [ @var{vn} * @var{sn}, for all @var{n} in @var{Nv} ] + Sum [ @var{vf} * @var{sf}, for all @var{f} in @var{Cf} ], @var{v} in @i{S0(W)} @end ifnottex @noindent where @var{Nv} is the set of inner nodes of @var{W} and each function @var{sf} is associated with the group of nodes of boundary @var{Gf}, @var{f} in @var{Cf} (@code{SkinDomainC}); @var{sf} is the sum of the nodal basis functions of all the nodes of @var{Cf}. Its function space is defined by @example FunctionSpace @{ @{ Name Hgrad_v_floating; Type Form0; BasisFunction @{ @{ Name sn; NameOfCoef vn; Function BF_Node; Support Domain; Entity NodesOf[All, Not SkinDomainC]; @} @{ Name sf; NameOfCoef vf; Function BF_GroupOfNodes; Support Domain; Entity GroupsOfNodesOf[SkinDomainC]; @} @} GlobalQuantity @{ @{ Name GlobalElectricPotential; Type AliasOf; NameOfCoef vf; @} @{ Name GlobalElectricCharge; Type AssociatedWith; NameOfCoef vf; @} @} Constraint @{ @dots{} @} @} @} @end example @noindent Two global quantities have been associated with this space: the electric potential @code{Global@-ElectricPotential}, being an alias of coefficient @code{vf}, and the electric charge @code{GlobalElec@-tricCharge}, being associated with coefficient @code{vf}. @c ......................................................................... @c Edge Finite Element Space @c ......................................................................... @node Curl-conform space, Gauge condition, Global values, FunctionSpace examples @subsection Edge finite element space Another space is the edge finite element space, denoted @i{S1(W)}, containing 1-forms, i.e., curl-conform fields: @tex $$ {\bf h} = \sum_{e\in E} h_e {\bf s}_e \quad{\bf h}\in S^1(W) $$ @end tex @ifnottex @var{h} = Sum [ @var{he} * @var{se}, for all @var{e} in @var{E} ], @var{h} in @i{S1(W)} @end ifnottex @noindent where @var{E} is the set of edges of @var{W}, @var{se} is the edge basis function for edge @var{e} and @var{he} is the circulation of @var{h} along edge @var{e}. It is defined by @example FunctionSpace @{ @{ Name Hcurl_h; Type Form1; BasisFunction @{ @{ Name se; NameOfCoef he; Function BF_Edge; Support Domain; Entity EdgesOf[All]; @} @} Constraint @{ @dots{} @} @} @} @end example @c ......................................................................... @c Edge Finite Element Space with Gauge Condition @c ......................................................................... @node Gauge condition, Coupled spaces, Curl-conform space, FunctionSpace examples @subsection Edge finite element space with gauge condition A 1-form function space containing vector potentials can be associated with a gauge condition, which can be defined as a constraint, e.g., a zero value is fixed for all circulations along edges of a tree (@code{EdgesOfTreeIn}) built in the mesh (@code{Domain}), having to be complete on certain boundaries (@code{StartingOn Surf}): @example Constraint @{ @{ Name GaugeCondition_a_Mag_3D; Type Assign; Case @{ @{ Region Domain; SubRegion Surf; Value 0.; @} @} @} @} FunctionSpace @{ @{ Name Hcurl_a_Gauge; Type Form1; BasisFunction @{ @{ Name se; NameOfCoef ae; Function BF_Edge; Support Domain; Entity EdgesOf[All]; @} @} Constraint @{ @{ NameOfCoef ae; EntityType EdgesOfTreeIn; EntitySubType StartingOn; NameOfConstraint GaugeCondition_a_Mag_3D; @} @dots{} @} @} @} @end example @c ......................................................................... @c Coupled Edge and Nodal Finite Element Spaces @c ......................................................................... @node Coupled spaces, Multiply connected domains, Gauge condition, FunctionSpace examples @subsection Coupled edge and nodal finite element spaces A 1-form function space, containing curl free fields in certain regions @var{WcC} (@code{DomainCC}) of @var{W}, which are the complementary part of @var{Wc} (@code{DomainC}) in @var{W}, can be explicitly characterized by @tex $$ {\bf h} = \sum_{k\in E_c} h_k {\bf s}_k + \sum_{n\in N_c^C} \phi_n {\bf v}_n \quad{\bf h}\in S^1(W) $$ @end tex @ifnottex @var{h} = Sum [ @var{hk} * @var{sk}, for all @var{e} in @var{Ec} ] + Sum [ @var{phin} * @var{vn}, for all @var{n} in @var{NcC} ], @var{h} in @i{S1(W)} @end ifnottex @noindent where @var{Ec} is the set of inner edges of @var{W}, @var{NcC} is the set of nodes inside @var{WcC} and on its boundary @var{dWcC}, @var{sk} is an edge basis function and @var{vn} is a vector nodal function. Such a space, coupling a vector field with a scalar potential, can be defined by @example FunctionSpace @{ @{ Name Hcurl_hphi; Type Form1; BasisFunction @{ @{ Name sk; NameOfCoef hk; Function BF_Edge; Support DomainC; Entity EdgesOf[All, Not SkinDomainC]; @} @{ Name vn; NameOfCoef phin; Function BF_GradNode; Support DomainCC; Entity NodesOf[All]; @} @{ Name vn; NameOfCoef phic; Function BF_GroupOfEdges; Support DomainC; Entity GroupsOfEdgesOnNodesOf[SkinDomainC];@} @} Constraint @{ @{ NameOfCoef hk; EntityType EdgesOf; NameOfConstraint MagneticField; @} @{ NameOfCoef phin; EntityType NodesOf; NameOfConstraint MagneticScalarPotential; @} @{ NameOfCoef phic; EntityType NodesOf; NameOfConstraint MagneticScalarPotential; @} @} @} @} @end example @noindent This example points out the definition of a piecewise defined basis function, e.g., function @code{vn} being defined with @code{BF_GradNode} in @code{DomainCC} and @code{BF_GroupOfEdges} in @code{DomainC}. This leads to an easy coupling between these regions. @c ......................................................................... @c Coupled Edge and Nodal Finite Element Spaces for Multiply Connected Domains @c ......................................................................... @node Multiply connected domains, , Coupled spaces, FunctionSpace examples @subsection Coupled edge and nodal finite element spaces for multiply connected domains In case a multiply connected domain @var{WcC} is considered, basis functions associated with cuts (@code{SurfaceCut}) have to be added to the previous basis functions, which gives the function space below: @example Group @{ _TransitionLayer_SkinDomainC_ = ElementsOf[SkinDomainC, OnOneSideOf SurfaceCut]; @} FunctionSpace @{ @{ Name Hcurl_hphi; Type Form1; BasisFunction @{ @dots{} @var{same as above} @dots{} @{ Name sc; NameOfCoef Ic; Function BF_GradGroupOfNodes; Support ElementsOf[DomainCC, OnOneSideOf SurfaceCut]; Entity GroupsOfNodesOf[SurfaceCut]; @} @{ Name sc; NameOfCoef Icc; Function BF_GroupOfEdges; Support DomainC; Entity GroupsOfEdgesOf [SurfaceCut, InSupport _TransitionLayer_SkinDomainC_]; @} @} GlobalQuantity @{ @{ Name I; Type AliasOf ; NameOfCoef Ic; @} @{ Name U; Type AssociatedWith; NameOfCoef Ic; @} @} Constraint @{ @dots{} @var{same as above} @dots{} @{ NameOfCoef Ic; EntityType GroupsOfNodesOf; NameOfConstraint Current; @} @{ NameOfCoef Icc; EntityType GroupsOfNodesOf; NameOfConstraint Current; @} @{ NameOfCoef U; EntityType GroupsOfNodesOf; NameOfConstraint Voltage; @} @} @} @} @end example @noindent Global quantities associated with the cuts, i.e., currents and voltages if @var{h} is the magnetic field, have also been defined. @c ------------------------------------------------------------------------- @c Jacobian Examples @c ------------------------------------------------------------------------- @node Jacobian examples, Integration examples, FunctionSpace examples, Short examples @section @code{Jacobian} examples @cindex Jacobian, examples A simple Jacobian method is for volume transformations (of @var{n}-D regions in @var{n}-D geometries; @var{n} = 1, 2 or 3), e.g., in region @code{Domain}, @example Jacobian @{ @{ Name Vol; Case @{ @{ Region Domain; Jacobian Vol; @} @} @} @} @end example @noindent @code{Jacobian VolAxi} would define a volume Jacobian for axisymmetrical problems. A Jacobian method can also be piecewise defined, in @code{DomainInf}, where an infinite geometrical transformation has to be made using two constant parameters (inner and outer radius of a spherical shell), and in all the other regions (@code{All}, being the default); in each case, a volume Jacobian is used. This method is defined by: @example Jacobian @{ @{ Name Vol; Case @{ @{ Region DomainInf; Jacobian VolSphShell @{Val_Rint, Val_Rext@}; @} @{ Region All; Jacobian Vol; @} @} @} @} @end example @c ------------------------------------------------------------------------- @c Integration Examples @c ------------------------------------------------------------------------- @node Integration examples, Formulation examples, Jacobian examples, Short examples @section @code{Integration} examples @cindex Integration, examples A commonly used numerical integration method is the @code{Gauss} integration, with a number of integration points (@code{NumberOfPoints}) depending on geometrical element types (@code{GeoElement}), i.e. @example Integration @{ @{ Name Int_1; Case @{ @{Type Gauss; Case @{ @{ GeoElement Triangle ; NumberOfPoints 4; @} @{ GeoElement Quadrangle ; NumberOfPoints 4; @} @{ GeoElement Tetrahedron; NumberOfPoints 4; @} @{ GeoElement Hexahedron ; NumberOfPoints 6; @} @{ GeoElement Prism ; NumberOfPoints 9; @} @} @} @} @} @} @end example @noindent The method above is valid for both 2D and 3D problems, for different kinds of elements. @c ------------------------------------------------------------------------- @c Formulation Examples @c ------------------------------------------------------------------------- @node Formulation examples, Resolution examples, Integration examples, Short examples @section @code{Formulation} examples @cindex Formulation, examples @menu * Electrostatics:: * Electrostatics 2:: * Magnetostatics:: * Magnetodynamics:: * Other formulations:: @end menu @c todo: ajouter un vrai exemple de circuit (cf. constraint example) @c ......................................................................... @c Electrostatic Scalar Potential Formulation @c ......................................................................... @node Electrostatics, Electrostatics 2, Formulation examples, Formulation examples @subsection Electrostatic scalar potential formulation @cindex Electrostatic formulation @cindex Formulation, electrostatics @cindex Nodal function space, example An electrostatic formulation using an electric scalar potential @var{v}, i.e. @tex $$ (\epsilon\,{\rm grad}\,v, {\rm grad}\,v')_W = 0 \quad\forall v'\in S^0(W) $$ @end tex @ifnottex ( epsr grad @var{v}, grad @var{vp} ) @var{W} = 0, for all @var{vp} in @i{S0(W)}, @end ifnottex @noindent is expressed by @example Formulation @{ @{ Name Electrostatics_v; Type FemEquation; Quantity @{ @{ Name v; Type Local; NameOfSpace Hgrad_v; @} @} Equation @{ Galerkin @{ [ epsr[] * Dof@{Grad v@} , @{Grad v@} ]; In Domain; Jacobian Vol; Integration Int_1; @} @} @} @} @end example @noindent The density of the @code{Galerkin} term is a copy of the symbolic form of the formulation, i.e., the product of a relative permittivity function @code{epsr[]} by a vector of degrees of freedom (@code{Dof@{.@}}); the scalar product of this with the gradient of test function @code{v} results in a symmetrical matrix. @noindent Note that another @code{Quantity} could be defined for test functions, e.g., @code{vp} defined by @code{@{ Name vp; Type Local; NameOfSpace Hgrad_v; @}}. However, its use would result in the computation of a full matrix and consequently in a loss of efficiency. @c ......................................................................... @c Electrostatic Scalar Potential Formulation with Floating Potentials and Electric Charges @c ......................................................................... @node Electrostatics 2, Magnetostatics, Electrostatics, Formulation examples @subsection Electrostatic scalar potential formulation with floating potentials and electric charges @cindex Floating potential, example @cindex Global quantity, example An extension of the formulation above can be made to take floating potentials and electrical charges into account (the latter being defined in @code{FunctionSpace Hgrad_v_floating}), i.e. @example Formulation @{ @{ Name Electrostatics_v_floating; Type FemEquation; Quantity @{ @{ Name v; Type Local; NameOfSpace Hgrad_v_floating; @} @{ Name V; Type Global; NameOfSpace Hgrad_v_floating [GlobalElectricPotential]; @} @{ Name Q; Type Global; NameOfSpace Hgrad_v_floating [GlobalElectricCharge]; @} @} Equation @{ Galerkin @{ [ epsr[] * Dof@{Grad v@} , @{Grad v@} ]; In Domain; Jacobian Vol; Integration Int_1; @} GlobalTerm @{ [ - Dof@{Q@}/eps0 , @{V@} ]; In SkinDomainC; @} @} @} @} @end example @noindent with the predefinition @code{Function @{ eps0 = 8.854187818e-12; @}}. @c ......................................................................... @c Magnetostatic 3D Vector Potential Formulation @c ......................................................................... @node Magnetostatics, Magnetodynamics, Electrostatics 2, Formulation examples @subsection Magnetostatic 3D vector potential formulation @cindex Edge element space, example A magnetostatic 3D vector potential formulation @tex $$ (\nu\,{\rm curl}\,{\bf a}, {\rm curl}\,{\bf a}')_W = ({\bf j}_s , {\bf a}')_{W_s} \quad\forall{\bf a}'\in S^1(W), {\rm\ with\ gauge\ condition} $$ @end tex @ifnottex ( @var{nu} curl @var{a} , curl @var{ap} ) @var{W} - ( @var{js} , @var{ap} ) @var{Ws} = 0, for all @var{ap} in @i{S1(W)} with gauge condition, @end ifnottex @noindent with a source current density @var{js} in inductors @var{Ws}, is expressed by @example Formulation @{ @{ Name Magnetostatics_a_3D; Type FemEquation; Quantity @{ @{ Name a; Type Local; NameOfSpace Hcurl_a_Gauge; @} @} Equation @{ Galerkin @{ [ nu[] * Dof@{Curl a@} , @{Curl a@} ]; In Domain; Jacobian Vol; Integration Int_1; @} Galerkin @{ [ - SourceCurrentDensity[] , @{a@} ]; In DomainWithSourceCurrentDensity; Jacobian Vol; Integration Int_1; @} @} @} @} @end example @noindent Note that @var{js} is here given by a function @code{SourceCurrentDensity[]}, but could also be given by data computed from another problem, e.g., from an electrokinetic problem (coupling of formulations) or from a fully fixed function space (constraints fixing the density, which is usually more efficient in time domain analyses). @c ......................................................................... @c Magnetodynamic 3D or 2D Magnetic Field and Magnetic Scalar Potential Formulation @c ......................................................................... @node Magnetodynamics, Other formulations, Magnetostatics, Formulation examples @subsection Magnetodynamic 3D or 2D magnetic field and magnetic scalar potential formulation A magnetodynamic 3D or 2D @var{h-phi} formulation, i.e., coupling the magnetic field @var{h} with a magnetic scalar potential @var{phi}, @tex $$ \partial_t (\mu\,{\bf h}, {\bf h}')_W + (\rho\,{\rm curl}\,{\bf h}, {\rm curl}\,{\bf h}')_{W_c} = 0 \quad\forall{\bf h}'\in S^1(W) $$ @end tex @ifnottex Dt ( @var{mu} @var{h} , @var{hp} ) @var{W} + ( @var{ro} curl @var{h} , curl @var{hp} ) @var{Wc} = 0, for all @var{hp} in @i{S1(W)}, @end ifnottex @noindent can be expressed by @example Formulation @{ @{ Name Magnetodynamics_hphi; Type FemEquation; Quantity @{ @{ Name h; Type Local; NameOfSpace Hcurl_hphi; @} @} Equation @{ Galerkin @{ Dt [ mu[] * Dof@{h@} , @{h@} ]; In Domain; Jacobian Vol; Integration Int_1; @} Galerkin @{ [ rho[] * Dof@{Curl h@} , @{Curl h@} ]; In DomainC; Jacobian Vol; Integration Int_1; @} @} @} @} @end example @c ......................................................................... @c Nonlinearities, Mixed Formulations, ... @c ......................................................................... @node Other formulations, , Magnetodynamics, Formulation examples @subsection Nonlinearities, Mixed formulations, @dots{} In case nonlinear physical characteristics are considered, arguments are used for associated functions, e.g., @code{mu[@{h@}]}. Several test functions can be considered in an @code{Equation} field. Consequently, mixed formulations can be defined. @c ------------------------------------------------------------------------- @c Resolution Examples @c ------------------------------------------------------------------------- @node Resolution examples, PostProcessing examples, Formulation examples, Short examples @section @code{Resolution} examples @cindex Resolution, examples @menu * Static resolution:: * Frequency domain resolution:: * Time domain resolution:: * Nonlinear resolution:: * Coupled formulations:: @end menu @c ......................................................................... @c Static Resolution (Electrostatic Problem) @c ......................................................................... @node Static resolution, Frequency domain resolution, Resolution examples, Resolution examples @subsection Static resolution (electrostatic problem) A static resolution, e.g., for the electrostatic formulation (@pxref{Formulation examples}), can be defined by @example Resolution @{ @{ Name Electrostatics_v; System @{ @{ Name Sys_Ele; NameOfFormulation Electrostatics_v; @} @} Operation @{ Generate[Sys_Ele]; Solve[Sys_Ele]; SaveSolution[Sys_Ele]; @} @} @} @end example @noindent The generation (@code{Generate}) of the matrix of the system @code{Sys_Ele} will be made with the formulation @code{Electrostatics_v}, followed by its solving (@code{Solve}) and the saving of the solution (@code{SaveSolution}). @c ......................................................................... @c Frequency Domain Resolution (Magnetodynamic Problem) @c ......................................................................... @node Frequency domain resolution, Time domain resolution, Static resolution, Resolution examples @subsection Frequency domain resolution (magnetodynamic problem) A frequency domain resolution, e.g., for the magnetodynamic @var{h-phi} formulation (@pxref{Formulation examples}), is given by @example Resolution @{ @{ Name Magnetodynamics_hphi; System @{ @{ Name Sys_Mag; NameOfFormulation Magnetodynamics_hphi; Frequency Freq; @} @} Operation @{ Generate[Sys_Mag]; Solve[Sys_Mag]; SaveSolution[Sys_Mag]; @} @} @} @end example @noindent preceded by the definition of constant @code{Freq}, e.g., @example Function @{ Freq = 50.; @} @end example @c ......................................................................... @c Time Domain Resolution (Magnetodynamic Problem) @c ......................................................................... @node Time domain resolution, Nonlinear resolution, Frequency domain resolution, Resolution examples @subsection Time domain resolution (magnetodynamic problem) A time domain resolution, e.g., for the same magnetodynamic @var{h-phi} formulation (@pxref{Formulation examples}), is given by @example Resolution @{ @{ Name Magnetodynamics_hphi_Time; System @{ @{ Name Sys_Mag; NameOfFormulation Magnetodynamics_hphi; @} @} Operation @{ InitSolution[Sys_Mag]; SaveSolution[Sys_Mag]; TimeLoopTheta[Mag_Time0, Mag_TimeMax, Mag_DTime[], Mag_Theta[]] @{ Generate[Sys_Mag]; Solve[Sys_Mag]; SaveSolution[Sys_Mag]; @} @} @} @} @end example @noindent If, e.g., the @code{Resolution} above is preceded by the constant and function definitions below @example Function @{ Tc = 10.e-3; Mag_Time0 = 0.; Mag_TimeMax = 2.*Tc; Mag_DTime[] = Tc/20.; Mag_Theta[] = 1./2.; @} @end example @noindent the performed time domain analysis will be a Crank-Nicolson scheme (theta-scheme with @code{Theta = 0.5}) with initial time 0 ms, end time 20 ms and time step 1 ms. @c ......................................................................... @c Nonlinear Time Domain Resolution (Magnetodynamic Problem) @c ......................................................................... @node Nonlinear resolution, Coupled formulations, Time domain resolution, Resolution examples @subsection Nonlinear time domain resolution (magnetodynamic problem) In case a nonlinear problem is solved, an iterative loop has to be defined in an appropriate level of the recursive resolution operations, e.g., for the magnetodynamic problem above, @example @dots{} Operation @{ InitSolution[Sys_Mag]; SaveSolution[Sys_Mag]; TimeLoopTheta[Mag_Time0, Mag_TimeMax, Mag_DTime[], Mag_Theta[]] @{ IterativeLoop[NL_NbrMax, NL_Eps, NL_Relax] @{ GenerateJac[Sys_Mag]; SolveJac[Sys_Mag]; @} SaveSolution[Sys_Mag]; @} @} @dots{} @end example @noindent preceded by constant definitions, e.g., @example Function @{ NL_Eps = 1.e-4; NL_Relax = 1.; NL_NbrMax = 80; @} @end example @c ......................................................................... @c Coupled Formulations @c ......................................................................... @node Coupled formulations, , Nonlinear resolution, Resolution examples @subsection Coupled formulations A coupled problem, e.g., magnetodynamic (in frequency domain; @code{Frequency Freq}) - thermal (in time domain) coupling, with temperature dependent characteristics (e.g., @code{rho[@{T@}]}, @dots{}), can be defined by: @example Resolution @{ @{ Name MagnetoThermalCoupling_hphi_T; System @{ @{ Name Sys_Mag; NameOfFormulation Magnetodynamics_hphi; Frequency Freq; @} @{ Name Sys_The; NameOfFormulation Thermal_T; @} @} Operation @{ InitSolution[Sys_Mag]; InitSolution[Sys_The]; IterativeLoop[NL_NbrMax, NL_Eps, NL_Relax] @{ GenerateJac[Sys_Mag]; SolveJac[Sys_Mag]; GenerateJac[Sys_The]; SolveJac[Sys_The]; @} SaveSolution[Sys_Mag]; SaveSolution[Sys_The]; @} @} @} @end example @noindent Two systems of equations, @code{Sys_Mag} and @code{Sys_The}, will be solved iteratively until convergence (@code{Criterion}), using a relaxation factor (@code{RelaxationFactor}). It can be seen through these examples that many resolutions can be linked or nested directly by the user, which gives a great freedom for coupled problems. @c ------------------------------------------------------------------------- @c PostProcessing Examples @c ------------------------------------------------------------------------- @node PostProcessing examples, PostOperation examples, Resolution examples, Short examples @section @code{PostProcessing} examples @cindex Post-processing, examples The quantities to be post-computed based on a solution of a resolution are defined, e.g., for the electrostatic problem (@pxref{Formulation examples}; @pxref{Resolution examples}), for the solution associated with the formulation @code{Electrostatics_v}, by @example PostProcessing @{ @{ Name EleSta_v; NameOfFormulation Electrostatics_v; Quantity @{ @{ Name v; Value @{ Local @{ [ @{v@} ]; In Domain; @} @} @} @{ Name e; Value @{ Local @{ [ -@{Grad v@} ]; In Domain; @} @} @} @{ Name d; Value @{ Local @{ [ -eps0*epsr[] *@{Grad v@} ]; In Domain; @} @} @} @} @} @} @end example @noindent The electric scalar potential @var{v} (@code{v}), the electric field @var{e} (@code{e}) and the electric flux density @var{d} (@code{d}) can all be computed from the solution. They are all defined in the region @code{Domain}. The quantities for the solution associated with the formulation @code{Electrostatics_v_float@-ing} are defined by @example PostProcessing @{ @{ Name EleSta_vf; NameOfFormulation Electrostatics_v_floating; Quantity @{ @dots{} @var{same as above} @dots{} @{ Name Q; Value @{ Local @{ [ @{Q@} ]; In SkinDomainC; @} @} @} @{ Name V; Value @{ Local @{ [ @{V@} ]; In SkinDomainC; @} @} @} @} @} @} @end example @noindent which points out the way to define post-quantities based on global quantities. @c ------------------------------------------------------------------------- @c PostOperation Examples @c ------------------------------------------------------------------------- @node PostOperation examples, , PostProcessing examples, Short examples @section @code{PostOperation} examples @cindex Post-operation, examples The simplest post-processing operation is the generation of maps of local quantities, i.e., the display of the computed fields on the mesh. For example, using the @code{PostProcessing} defined in @ref{PostProcessing examples}, the maps of the electric scalar potential and of the electric field on the elements of the region @code{Domain} are defined as: @example PostOperation @{ @{ Name Map_v_e; NameOfPostProcessing EleSta_v ; Operation @{ Print [ v, OnElementsOf Domain, File "map_v.pos" ]; Print [ e, OnElementsOf Domain, File "map_e.pos" ]; @} @} @} @end example It is also possible to display local quantities on sections of the mesh, here for example on the plane containing the points (0,0,1), (1,0,1) and (0,1,1): @example Print [ v, OnSection @{ @{0,0,1@} @{1,0,1@} @{0,1,1@} @}, File "sec_v.pos" ]; @end example Finally, local quantities can also be interpolated on another mesh than the one on which they have been computed. Six types of grids can be specified for this interpolation: a single point, a set of points evenly distributed on a line, a set of points evenly distributed on a plane, a set of points evenly distributed in a box, a set of points defined by a parametric equation, and a set of elements belonging to a different mesh than the original one: @example Print [ e, OnPoint @{0,0,1@} ]; Print [ e, OnLine @{ @{0,0,1@} @{1,0,1@} @} @{125@} ]; Print [ e, OnPlane @{ @{0,0,1@} @{1,0,1@} @{0,1,1@} @} @{125, 75@} ]; Print [ e, OnBox @{ @{0,0,1@} @{1,0,1@} @{0,1,1@} @{0,0,2@} @} @{125, 75, 85@} ]; Print [ e, OnGrid @{$A, $B, 1@} @{ 0:1:1/125, 0:1:1/75, 0 @} ]; Print [ e, OnGrid Domain2 ]; @end example Many options can be used to modify the aspect of all these maps, as well as the default behaviour of the @code{Print} commands. See @ref{Types for PostOperation}, to get the list of all these options. For example, to obtain a map of the scalar potential at the barycenters of the elements on the boundary of the region @code{Domain}, in a table oriented format appended to an already existing file @code{out.txt}, the operation would be: @example Print [ v, OnElementsOf Domain, Depth 0, Skin, Format Table, File >> "out.txt" ]; @end example Global quantities, which are associated with regions (and not with the elements of the mesh of these regions), are displayed thanks to the @code{OnRegion} operation. For example, the global potential and charge on the region @code{SkinDomainC} can be displayed with: @example PostOperation @{ @{ Name Val_V_Q; NameOfPostProcessing EleSta_vf ; Operation @{ Print [ V, OnRegion SkinDomainC ]; Print [ Q, OnRegion SkinDomainC ]; @} @} @} @end example @c ========================================================================= @c Complete Examples @c ========================================================================= @node Complete examples, File formats, Short examples, Top @chapter Complete examples @cindex Complete examples @cindex Examples, complete @cindex Wiki This chapter presents complete examples that can be run ``as is'' with GetDP (@pxref{Running GetDP}). Many other ready-to-use examples are available on the website of the ONELAB project: @url{http://onelab.info}. @menu * Electrostatic problem:: * Magnetostatic problem:: * Magnetodynamic problem:: @end menu @c ------------------------------------------------------------------------- @c Electrostatic Problem @c ------------------------------------------------------------------------- @node Electrostatic problem, Magnetostatic problem, Complete examples, Complete examples @section Electrostatic problem Let us first consider a simple electrostatic problem. The formulation used is an electric scalar potential formulation (file @file{EleSta_v.pro}, including files @file{Jacobian_Lib.pro} and @file{Integration_Lib.pro}). It is applied to a microstrip line (file @file{mStrip.pro}), whose geometry is defined in the file @file{mStrip.geo} (@pxref{Gmsh examples}). The geometry is two-dimensional and by symmetry only one half of the structure is modeled. @image{Strip,,} Note that the structure of the following files points out the separation of the data describing the particular problem and the method used to solve it (@pxref{Numerical tools as objects}), and therefore how it is possible to build black boxes adapted to well defined categories of problems. The files are commented (@pxref{Comments}) and can be run without any modification. @sp 1 @verbatiminclude mStrip.pro @sp 1 @verbatiminclude EleSta_v.pro @sp 1 @verbatiminclude Jacobian_Lib.pro @sp 1 @verbatiminclude Integration_Lib.pro @page @c ------------------------------------------------------------------------- @c Magnetostatic Problem @c ------------------------------------------------------------------------- @node Magnetostatic problem, Magnetodynamic problem, Electrostatic problem, Complete examples @section Magnetostatic problem We now consider a magnetostatic problem. The formulation used is a 2D magnetic vector potential formulation (see file @file{MagSta_a_2D.pro}). It is applied to a core-inductor system (file @file{CoreSta.pro}), whose geometry is defined in theh file @file{Core.geo} (@pxref{Gmsh examples}). The geometry is two-dimensional and, by symmetry, one fourth of the structure is modeled. @image{Core,,} The jacobian and integration methods used are the same as for the electrostatic problem presented in @ref{Electrostatic problem}. @sp 1 @verbatiminclude CoreSta.pro @sp 1 @verbatiminclude MagSta_a_2D.pro @page @c ------------------------------------------------------------------------- @c Magnetodynamic Problem @c ------------------------------------------------------------------------- @node Magnetodynamic problem, , Magnetostatic problem, Complete examples @section Magnetodynamic problem As a third example we consider a magnetodynamic problem. The formulation is a two-dimensional a-v formulation (see file @file{MagDyn_av_2D.pro}, which includes the same jacobian and integration library files as in @ref{Electrostatic problem}). It is applied to a core-inductor system (defined in file @file{CoreMassive.pro}), whose geometry has already been defined in file @file{Core.geo}. @sp 1 @verbatiminclude CoreMassive.pro @sp 1 @verbatiminclude MagDyn_av_2D.pro @c ========================================================================= @c File Formats @c ========================================================================= @node File formats, Gmsh examples, Complete examples, Top @appendix File formats This chapter describes the file formats that cannot be modified by the user. The format of the problem definition structure is explained in @ref{Objects}, and @ref{Types for objects}. The format of the post-processing files is explained in @ref{Types for PostOperation}. @menu * Input file format:: * Output file format:: @end menu @c ------------------------------------------------------------------------- @c Input File Format @c ------------------------------------------------------------------------- @node Input file format, Output file format, File formats, File formats @section Input file format @cindex Input file format @cindex Gmsh, file format @cindex Mesh, file format @cindex File, mesh @cindex File, @file{.msh} @cindex @file{.msh} file The native mesh format read by GetDP is the mesh file format produced by Gmsh (@url{http://geuz.org/gmsh}). In its ``version 1'' incarnation, an `msh' file is divided into two sections, defining the nodes and the elements in the mesh. @example $NOD @var{number-of-nodes} @var{node-number} @var{x-coord} @var{y-coord} @var{z-coord} @dots{} $ENDNOD $ELM @var{number-of-elements} @var{elm-number} @var{elm-type} @var{elm-region} @var{unused} @var{number-of-nodes} @var{node-numbers} @dots{} $ENDELM @end example @noindent All the syntactic variables stand for integers except @var{x-coord}, @var{y-coord} and @var{z-coord} which stand for floating point values. The @var{elm-type} value defines the geometrical type for the element: @noindent @var{elm-type}: @table @code @item 1 Line (2 nodes, 1 edge). @item 2 Triangle (3 nodes, 3 edges). @item 3 Quadrangle (4 nodes, 4 edges). @item 4 Tetrahedron (4 nodes, 6 edges, 4 facets). @item 5 Hexahedron (8 nodes, 12 edges, 6 facets). @item 6 Prism (6 nodes, 9 edges, 5 facets). @item 7 Pyramid (5 nodes, 8 edges, 5 facets). @item 15 Point (1 node). @end table GetDP can also read more recent versions of the `msh' format (2.0 and above), as well as binary meshes. See the Gmsh documentation for more information about these formats. @c ------------------------------------------------------------------------- @c Output File Format @c ------------------------------------------------------------------------- @node Output file format, , Input file format, File formats @section Output file format @cindex Output file format @menu * File pre:: * File res:: @end menu @c ......................................................................... @c File .pre @c ......................................................................... @node File pre, File res, Output file format, Output file format @subsection File @file{.pre} @cindex File, pre-processing @cindex @file{.pre} file @cindex File, @file{.pre} The @file{.pre} file is generated by the pre-processing stage. It contains all the information about the degrees of freedom to be considered during the processing stage for a given resolution (i.e., unknowns, fixed values, initial values, etc.). @example $Resolution /* '@var{resolution-id}' */ @var{main-resolution-number} @var{number-of-dofdata} $EndResolution $DofData /* #@var{dofdata-number} */ @var{resolution-number} @var{system-number} @var{number-of-function-spaces} @var{function-space-number} @dots{} @var{number-of-time-functions} @var{time-function-number} @dots{} @var{number-of-partitions} @var{partition-index} @dots{} @var{number-of-any-dof} @var{number-of-dof} @var{dof-basis-function-number} @var{dof-entity} @var{dof-harmonic} @var{dof-type} @var{dof-data} @dots{} $EndDofData @dots{} @end example @noindent with @example @var{dof-data}: @var{equation-number} @var{nnz} (@var{dof-type}: 1; @var{unknown}) | @var{dof-value} @var{dof-time-function-number} (@var{dof-type}: 2; @var{fixed value}) | @var{dof-associate-dof-number} @var{dof-value} @var{dof-time-function-number} (@var{dof-type}: 3; @var{associated degree of freedom}) | @var{equation-number} @var{dof-value} (@var{dof-type}: 5; @var{initial value for an unknown}) @end example @noindent Notes: @enumerate @item There is one @code{$DofData} field for each system of equations considered in the resolution (including those considered in pre-resolutions). @item The @var{dofdata-number} of a @code{$DofData} field is determined by the order of this field in the @file{.pre} file. @item @var{number-of-dof} is the dimension of the considered system of equations, while @var{number-of-any-dof} is the total number of degrees of freedom before the application of constraints. @item Each degree of freedom is coded with three integer values, which are the associated basis function, entity and harmonic numbers, i.e., @var{dof-basis-function-number}, @var{dof-entity} and @var{dof-harmonic}. @item @var{nnz} is not used at the moment. @end enumerate @c ......................................................................... @c File .res @c ......................................................................... @node File res, , File pre, Output file format @subsection File @file{.res} @cindex File, result @cindex @file{.res} file @cindex File, @file{.res} The @file{.res} file is generated by the processing stage. It contains the solution of the problem (or a part of it in case of program interruption). @example $ResFormat /* GetDP v@var{getdp-version-number}, @var{string-for-format} */ 1.1 @var{file-res-format} $EndResFormat $Solution /* DofData #@var{dofdata-number} */ @var{dofdata-number} @var{time-value} @var{time-imag-value} @var{time-step-number} @var{solution-value} @dots{} $EndSolution @dots{} @end example @noindent Notes: @enumerate @item A @code{$Solution} field contains the solution associated with a @code{$DofData} field. @item There is one @code{$Solution} field for each time step, of which the time is @var{time-value} (0 for non time dependent or non modal analyses) and the imaginary time is @var{time-imag-value} (0 for non time dependent or non modal analyses). @item The order of the @var{solution-value}s in a @code{$Solution} field follows the numbering of the equations given in the @file{.pre} file (one floating point value for each degree of freedom). @end enumerate @c ========================================================================= @c Gmsh Examples @c ========================================================================= @node Gmsh examples, Compiling the source code, File formats, Top @appendix Gmsh examples @cindex Gmsh, examples @cindex Mesh, examples Gmsh is a three-dimensional finite element mesh generator with simple CAD and post-processing capabilities that can be used as a graphical front-end for GetDP. Gmsh can be downloaded from @url{http://geuz.org/gmsh}. This appendix reproduces verbatim the input files needed by Gmsh to produce the mesh files @file{mStrip.msh} and @file{Core.msh} used in the examples of @ref{Complete examples}. @sp 1 @verbatiminclude mStrip.geo @sp 1 @verbatiminclude Core.geo @c ========================================================================= @c Compiling the source code @c ========================================================================= @node Compiling the source code, Frequently asked questions, Gmsh examples, Top @appendix Compiling the source code Stable releases and nightly source snapshots are available from @uref{http://geuz.org/getdp/src/}. You can also access the subversion repository directly: @enumerate @item The first time you want to download the latest full source, type: @example svn co https://geuz.org/svn/getdp/trunk getdp @end example You will be asked to accept the security certificate and to provide your username and password. (Use getdp/getdp for read-only access.) @item To update your local version to the latest and greatest, go in the getdp directory and type: @example svn update @end example @item If you have write access, to commit your changes to the central repository, go in the getdp directory and type: @example svn commit @end example @end enumerate Once you have the source code, you need to run CMake to configure your build (see the @file{README.txt} file in the top-level source directory for detailed information on how to run CMake). Each build can be configured using a series of options, to selectively enable optional modules or features. Here is the list of CMake options: @ftable @code @include cmake_options.texi @end ftable @c ========================================================================= @c Frequently asked questions @c ========================================================================= @node Frequently asked questions, Tips and tricks, Compiling the source code, Top @appendix Frequently asked questions @cindex Frequently asked questions @cindex Questions, frequently asked @cindex FAQ @c ------------------------------------------------------------------------- @c The basics @c ------------------------------------------------------------------------- @menu * The basics:: * Installation:: * Usage:: @end menu @node The basics, Installation, Frequently asked questions, Frequently asked questions @section The basics @enumerate @item What is GetDP? GetDP is a scientific software environment for the numerical solution of integro-differential equations, open to the coupling of physical problems (electromagnetic, thermal, mechanical, etc) as well as of numerical methods (finite element method, integral methods, etc). It can deal with such problems of various dimensions (1D, 2D, 2D axisymmetric or 3D) and time states (static, transient or harmonic). The main feature of GetDP is the closeness between the organization of data defining discrete problems (written by the user in ASCII data files) and the symbolic mathematical expressions of these problems. @item What are the terms and conditions of use? GetDP is distributed under the terms of the GNU General Public License. See @ref{License} for more information. @item What does `GetDP' mean? It's an acronym for a ``General environment for the treatment of Discrete Problems''. @item Where can I find more information? @url{http://geuz.org/getdp} is the primary site to obtain information about GetDP. You will find a short presentation, a complete reference guide as well as a searchable archive of the GetDP mailing list (@email{getdp@@geuz.org}) on this site. @end enumerate @c ------------------------------------------------------------------------- @c Installation @c ------------------------------------------------------------------------- @node Installation, Usage, The basics, Frequently asked questions @section Installation @enumerate @item Which OSes does GetDP run on? Gmsh runs on Windows, MacOS X, Linux and most Unix variants. @item What do I need to compile GetDP from the sources? You need a C++ and a Fortran compiler as well as the GSL (version 1.2 or higher; freely available from @url{http://sources.redhat.com/gsl}). @item How do I compile GetDP? You need cmake (@url{http://www.cmake.org}) and a C++ compiler (and a Fortran compiler depending on the modules/solvers you want to compile). See @ref{Compiling the source code} and the @file{README.txt} file in the top-level source directory for more information. @item GetDP [from a binary distribution] complains about missing libraries. Try @code{ldd getdp} (or @code{otool -L getdp} on MacOS X) to check if all the required shared libraries are installed on your system. If not, install them. If it still doesn't work, recompile GetDP from the sources. @end enumerate @c ------------------------------------------------------------------------- @c Usage @c ------------------------------------------------------------------------- @node Usage, , Installation, Frequently asked questions @section Usage @enumerate @item How can I provide a mesh to GetDP? The only meshing format accepted by this version of GetDP is the `msh' format created by Gmsh @url{http://geuz.org/gmsh}. This format being very simple (see the Gmsh reference manual for more details), it should be straightforward to write a converter from your mesh format to the `msh' format. @item How can I visualize the results produced by GetDP? You can specify a format in all post-processing operations. Available formats include @code{Table}, @code{SimpleTable}, @code{TimeTable} and @code{Gmsh}. @code{Table}, @code{SimpleTable} and @code{TimeTable} output lists of numbers easily readable by Excel/gnuplot/Caleida Graph/etc. @code{Gmsh} outputs post-processing views directly loadable by Gmsh. @item How do I change the linear solver used by GetDP? It depends on which linear solver toolkit was enabled when GetDP was compiled (PETSc or Sparskit). With PETSc-based linear solvers you can either specify options directly on the command line (e.g. with @code{-ksp_type gmres -pc_type ilu}), through a specific option file (with @code{-solver file}), or through the @file{.petscrc} file located in your home directly. With Sparskit-based linear solvers can either specify options directly on command line (e.g. with @code{-Nb_Fill 200}), specify an option file explicitly (with @code{-solver file}), or edit the @file{solver.par} file in the current working directory. If no @file{solver.par} file exists in the current directory, GetDP will give create it the next time you perform a linear system solution. @end enumerate @c ========================================================================= @c Tips ans Tricks @c ========================================================================= @node Tips and tricks, Version history, Frequently asked questions, Top @appendix Tips and tricks @cindex Tips @cindex Tricks @cindex Efficiency, tips @itemize @bullet @item Install the 'info' version of this user's guide! On your (Unix) system, this can be achieved by 1) copying all getdp.info* files to the place where your info files live (usually /usr/info), and 2) issuing the command 'install-info /usr/info/getdp.info /usr/info/dir'. You will then be able to access the documentation with the command 'info getdp'. Note that particular sections ("nodes") can be accessed directly. For example, 'info getdp functionspace' will take you directly to the definition of the FunctionSpace object. @item Use emacs to edit your files, and load the C++ mode! This permits automatic syntax highlighting and easy indentation. Automatic loading of the C++ mode for @file{.pro} files can be achieved by adding the following command in your @code{.emacs} file: @code{(setq auto-mode-alist (append '(("\\.pro$" . c++-mode)) auto-mode-alist))}. @item Define integration and Jacobian method in separate files, reusable in all your problem definition structures (@pxref{Includes}). Define meshes, groups, functions and constraints in one file dependent of the geometrical model, and function spaces, formulations, resolutions and post-processings in files independent of the geometrical model. @item Use @code{All} as soon as possible in the definition of topological entities used as @code{Entity} of @code{BasisFunction}s. This will prevent GetDP from constructing unnecessary lists of entities. @item Intentionally misspelling an object type in the problem definition structure will produce an error message listing all available types in the particular context. @item If you don't specify the mandatory arguments on the command line, GetDP will give you the available choices. For example, 'getdp test -pos' (the name of the PostOperation is missing) will produce an error message listing all available PostOperations. @end itemize @c ========================================================================= @c Version history @c ========================================================================= @node Version history, Copyright and credits, Tips and tricks, Top @appendix Version history @cindex Versions @cindex History, versions @cindex Changelog @verbatiminclude ../VERSIONS.txt @c ========================================================================= @c Copyright and credits @c ========================================================================= @node Copyright and credits, License, Version history, Top @appendix Copyright and credits @cindex Copyright @cindex Acknowledgments @cindex Contributors, list @cindex Credits @verbatiminclude ../CREDITS.txt @c ========================================================================= @c License @c ========================================================================= @node License, Concept index, Copyright and credits, Top @appendix License @cindex License @verbatiminclude ../LICENSE.txt @c ========================================================================= @c Concept Index (cindex) @c ========================================================================= @node Concept index, Metasyntactic variable index, License, Top @unnumbered Concept index @cindex Index, concepts @cindex Concepts, index @printindex cp @c ========================================================================= @c Variable Index (vindex) @c ========================================================================= @node Metasyntactic variable index, Syntax index, Concept index, Top @unnumbered Metasyntactic variable index @cindex Index, metasyntactic variables @cindex Variables, index @cindex Metasyntactic variables, index @printindex vr @c ========================================================================= @c Syntax Index (tindex+findex) @c ========================================================================= @node Syntax index, , Metasyntactic variable index, Top @unnumbered Syntax index @cindex Index, syntax @cindex Syntax, index @cindex Keywords, index @printindex tp @bye getdp-2.7.0-source/doc/texinfo/objects-wrap.txt000644 001750 001750 00000006002 11266605602 023165 0ustar00geuzainegeuzaine000000 000000 ---------------------------------------------------------------------------- | | | -------------- | | -------->| Function |-------------------------------- | | | -------------- \ \ | | | | | --------------------------- \ | | | | \ | \ | | | \|/ ------------ | \ \|/ -------------- -------------- | | \ -------------- | Group |-->| Constraint |-------- | | \ |PostOperation | -------------- -------------- | | | \ -------------- | | | || | | | | \ /||\ *********************************************************************************************** * | | | || \|/ \|/\|/ \|/ _\| || * * | | | || -------------- -------------- -------------- -------------- * * | | | =====>|FunctionSpace |==>| Formulation |==>| Resolution |==>|PostProcessing| * * | | | -------------- -------------- -------------- -------------- * * | | | /|\/|\/|\ | /|\/|\/|\/|\ * * | | -------------------------------- | | | | | | | * * | | ----------------- | --------------------------- | | | * * | | | -------------- | | | * * | | | | Integration |---------------------------- | | * * | | | -------------- | | * * | | | | | * * | | -------------- | | * * | ----------->| Jacobian |-------------------------------------------------- | * * | -------------- | * * | | * * ------------------------------------------------------------------------------------ * * * *********************************************************************************************** getdp-2.7.0-source/doc/texinfo/Core.jpg000644 001750 001750 00000065045 11266605602 021432 0ustar00geuzainegeuzaine000000 000000 ÿØÿàJFIFHHÿá€ExifMM*JR(‡iZHH \ ÿÛCÿÛCÿÀ\ÿÄ ÿĵ}!1AQa"q2‘¡#B±ÁRÑð$3br‚ %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖ×ØÙÚáâãäåæçèéêñòóôõö÷øùúÿÄ ÿĵw!1AQaq"2B‘¡±Á #3RðbrÑ $4á%ñ&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚ƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖ×ØÙÚâãäåæçèéêòóôõö÷øùúÿÚ ?þþ( € ( € ( € (óá?ükâÇ…Ÿ >5ü-ÿ‚]~ßþ(øeñƒáÿƒ~)|:ñ7ü&ðL­þ/|@ðî›âÏë¿ØÞ"ÿ‚Ži> Òµü?«éú‡öf»¥išÅ‡Ú>Ë©éöW±Om ÃÇþ ißñ/ñ‡Á_ÛÿÁÞ-°ÿCñO„áÚ_·×įøE|Gkûoßð±~~Îßþ xûûSK­3þ_ƒ¿¾%|,ñWÙ·~xÿÆ>¿Òо&xsÆ‹sàÏøSKñMæ‘ÛôP@P@P@P@P@P@P@P@P@P@|ÿÿ”YÁ4ÿìÀ?cýg_‡4÷ýÏø³Â~ñï…|Mà_xkÃþ4ðOñf§x¾,ð¯ˆôëÄ>ñ7‡µ‹kÍ'^ðþ½¤Þ^izΪZ]iÚ¦use}m=´òÄÀêÿàœzwúo€c€<[ü‚~+~ËžÒÿdïŽÞó?uÿ7íû4'¾þÜÓ$¼ð牿á ñþƒÿ Wƒµø+ÄŸÚžñ½¢ê ü0/ü"_ò@¿mOÛÿöþÐÿ‘³þ2;þþß²È þR]àßÛþçöÚuŸù"¿ð¬?á-þÚÿ‹ÿ ¯ü#>ÿ„Hÿ¦ü?ÿ£ý­µ¿ìâ¿àžð¯þÁÿ‹@ÿ…¿ÿ _Ûê‡ÿ¿ÿ„oþj_ü&ßñoÀøo¯øD¿ä¾þÅ·ÿìÿý¡ÿ"Ÿücü6ü%¿dÿïü£GÆ_·ü+Ïì´èßòZ¿áXÂ[ýµÿãþ_øF|yÿÓÿ?h_€_´§…u~Ο~ü~ðN•â ¯ êž1ø)ñ/Á<+¦øªÇNÒµ‹ï j!ð.·¯i6~ ³ÒuíTºÑ®/#ÔmôígJ¾šÙ-µIfö ( € ( € ( € ( € ( € ( € ( € ( € ( €?à“¿ò‹/ø&Ÿý˜ìoÿ¬ëðæ€>ÿ € ( € ùƒã_ì_û0~Ð~*°øñ7á‡çøÉ¡ø~×Â~ý¡ü {â„?µ€ü+k¨êº™ð×ÃoÚ‡á±àoÚᯇõ (ñ™ðÿáÿ‡âÑuí+Xøÿû!þØ?´wÄßé>+²ø«ûHj÷¿4ÿü-?á½ô…_è߶÷Á¿ˆ±•·üKçøßñ/Yð'¿cmkXÓ?Ð|E©é¿µ/ïk~ø?ðþ÷ÄðŸ]ý¹<'ûøïãm÷üá¯ü-¹ø›/‹¾ø4ïú( € (Ïþ,üRð'Àï…Ÿþ5üR×áøeðáÿŒ¾)|Eñ7öf±­ÿÂ;àO‡þÔ¼Yâíwûú~¯â _û'ÃúN¡¨fhZV§¬_ýŸìºfŸ{{,Ò€|AðSþ 5Ä¿j?ÅÏØ·ößýŠü¥þÌ_µ¶©ñÛöÃøðoáçÀ/|3²Ôt«[ïxóâ~<üOÒ~ü`Òt›ýKÆ>(ø9ñj/üBð7‚ü+âøóBðŵ•¢ê_ø³ö…øà/x›À¾:øãðÁ~7ð_Áýgö…ñƒ¼Yñ/Á~ñW„þxsQ¹ÑüCñÇÄÞÖ5»=_Bø?¡jöwš^³ñ/T´µð^—¨ÚÜÙ_kp\Á,Jð·ö±ý–>8ë‡~ ~Òß>0xƒÅõ?‹>оüdøuñXñÂÍÇz‡ÂÝgâ^…¦xOÄz½î¯ðÿIø›¤ê¿µ?XAqáÛ隇„nµ(¼Aes§Æòÿì­ÿNý”mO¿~þ;.ðÿÅo‡žñwˆÅo üký•¼Oá_AàOxwá犛Ã_ ü-ûBkßµŸ‡ìüc®Í¦hß¼oû8x;àߎ4í.ÛÅßþ#ø«Á>>øEâOˆÀPxö±ý–>+üSñ¯ÀÏ…¿´·À‰_~ÂGÿ àï€~2|:ñÅ?ÿÂâ;?ø»þ_‡Þñ£âß ÿÂ+âÝGOð·ˆÿ·t‹ì?ßÙ蚟Ùu;¨-¤çü5ûnþÅþ4øËsû:x;ö¼ý˜2øðoÃßüIá_xWâ7Œ¼-ño[ðQøóyûQü5ø?ñCøq$ß¼yñ_ötð6âéüyð¢Þâ="O‰~ûx x#öÏÖüiû\xïöE“ö?ý§ü'«ü8ðþãŸ|fñ6³û#Ëðn×áŸu¿Ž^øEñ&Ù<+ûUø£ã%ï‡þ/ø“özø‰£xOC·ø<ß¼9Ëyñ·ö.ûF™¢ø»â—Ä}O⎅ñ'ö6ýœþZèÚ¿à¡^1ñmÿØØíÿ ø³Â¾=𯆼uà_xÆž ñ§‡ôox;Æ>ÖtïøWÅžñm¬x{ÄÞñsy¤ëÞ×´›ËMSFÖt»Ë­;TÓ®­¯¬®g¶ž)X  € óÿ‹?ð´ÿáV|Kÿ…ÿ ÿþoü+ÿÂÿ…³ÿ ü*ÏøZðŽê_ð¯¿áeÿÂÿoü+ÿøK²?á2ÿ„_þ*?øG´¿±?âgöjüa¸ÿ‚y~Ò¾$øûmüðÃoÙƒö%øwû@þÄ´—ìçàÙàGí1ñ¿ã¯ìÁñ—ã?‚Ûÿ>*é~ ñoìÁû?ø'ö(ðÿà ™þ Íãÿ þË5ˆ?iß|ñOÅOŒ¶7¿>x2ïÅÀOèžý¾¼cûSøCö—ø¥ðKö@ðü)oÙö¹ø;ðëÁ^ý±~4|Qÿ…“ñOã÷Ä_Ù Çþ¶ñ¯ˆüEûü"ÿ…YðÿKÿ†bÔ4ŸøÃBÐ~-øŽ×þë;ý3áö­ý‘=øûü ý©ÿf„_´î‰ã߀¿²†~&üHý ?joÚ§Âw_ÿhˆ¾ Ñþ3|Sý¥~6|^øÅm¡üzñ†³ûü0ñƒ¿á]ø^øKð2ÓâÖ›áŽ^#ñ<¯|5eá/ |>Ô:ø'÷ÃÛCஉã?†¿´g¿كÃ~ ×>0~×4¿üý¨>+|^ñQñWí;û\|Oý¤¬¾jñ×ìsðI´ðÿƒôŸŒ:ç†.¾ ÛüF¿ÔuGÁúUü?4ëo^CáÎÙïþ ñÿ+ð‡ÅßØsâßÇëï‡ÿþ&üý .þÂZOÄïü?ø‰ðþ éÿ cNøâ] â¯ì÷ámcNÿ…‰ðOâ?ÂOøËOøàø#﯉º/ü.Û߯Ž¾)|4ñüwâßϦxÿâ?ÅÚWÇ_4¿x¸Ð?gOø'¿íáà?ÿÁ;~|VñoÃûƒÿ°WöÂÝ{â¯ìíû~þÞß ÿ᧿g€Ÿ >3x+öhо#ÿÁ=ôŸi?³–“ñWñž¯û?üAøù©ë_>'Zø§þ¯‰¾˨x³àþ½aðÚÐíÿ†ß ÿm +þ ñ·ãߌ~þÌoìùñcàÿÁ_€vš×†¿jŠÞ%øË£xWökñ÷í•ñÀ¿®~jŸ±Ï„¼wâŠW?´Ï‡´O|?‹ãl:w¸<7¬êú?Ä?‹\Yi.|}øñ÷ã/‚î|3áïƒß³Ã-_^ÿ‚þÈ¿|uâ­ã/5üý”þ>þοm>0ø°Y~˾¹Öÿiÿx'öpðwÁ›oƒÚÆ£©ø/Â~³ðÓÅûQëºOƒ4¿ \sþðíõáÿÛëã'íÿ Kö@»ø%ñoáÿìÓû=}·þãDü?ð³öwøÑûXø×þßü ?ðÁ³xKUøã ~Ôoü)ŸøZºo‡|?â?ÿbÿÂïÖôÏÂGáðÓú( € ( € ( € ( €?à“¿ò‹/ø&Ÿý˜ìoÿ¬ëðæ€>ÿ € çüYâm;Á~ñ7Œu‹o^i>ðþ³âmRÓÂ~ñW|Uu§hZuΩ}má¯øFñüiâ í­e‹F🃼=®ø«Äz‹[hþѵM^òÒÊpý•¿lŸÙãöÔð¯Ä_þΞ1ñ‹4Ÿ„<]ðâu§‹>|[ø9â¯üeðáÝSÆŸ|Mà_^ø{ã}/ĶñV‡³ LJ– -FæçGšuÕô½VÊÈßü5âm;ÅšuΩ¥Ûx‚ÖÚ×Ä,ðÔ±x›Â~*ð^¢Ú‚üU¬ø;X¹¶Ñüc£hZ½ç‡ï5} úóÂ~,´²ŸÂ¾=ð¬ú7Ž¼ ¬øÁ>#ð÷ˆu@‚€>@ýžÿnÙÿö ñß>|%‡ö€ÿ„·á~è>![|RýŽÿkÿÙÿGð~±ýàOCáwÅŸ¾ü2ð•—Ä ß |Mð´Ï‡RkŸðê¾ñ6Ÿã7÷~ûF³×ôàðÓ¿¥øíÿ ã¦]ü@ñ'ÄÛoÜxŠüøÙão…Ÿõ†ðwü,(<#ñgã÷„~ë~ü@½ð-Æ…âý7á×Å/‰^ñÞ§áßü4ÕôÿÜÙ|Qøu7Š=þ€ øƒÅŸ²·Š¾x«Äß¿cÿˆ¾ øgã}oÄϼcû;x³ÅÚŽ§ûü|ñV±¨Üë^!³ñ7ƒuüAÕÿeÏxßW×<{â½gã'ìaðëQ×¾9ü@¹ý i¿†¶=Î/Àt kYñÞ…ð#öƒð‡ü2ßí5â?í8ü ð—Ǿ=ð&½£þж¾Ñõ KÆÞ7ý‘¼y¡ëÿÂ÷øáÏìêš¾©ø[á§íðëÀ‘øCÇÿ´7ìßð#Eø¡ðÚ?€}@P@|ûPÿÆKüSð§ì1¡¥xJ×þgÇßÛƒíè'öX¿ñÄïøUÿmþßöÍ3Ç¿ð׿~j ¾/|8Ô<#ã‡^$ý¼ûYx'â–³ðÛÅ¿¾ÂÃûþ€ ( € ( € ( € ( € ( € øþ ;ÿ(²ÿ‚iÿÙ€~Æÿúοhïú( ýª¼eñÛáÿìãñ£Åß²ÿÂø^?´n“ðÿ_ÿ…ð¶}KÁÚNâŠwö§LðGü%Ú‡Žþ%üðý¿ÃýĶ>"ø‹³â/‡|G/4ŸAà¿íË hZ˜âüËöWý´ÿàœßþøj?€ðºÿg-Gþ ð£áˆ$ø)ðGöcý™:xƒö‚ý¤-¿i/‰ Ñ­~ 꿼]ð;Åš?Äõðn³ñ×ÇžúöøMª|(±ÿ‚ü-Ô¿à’¿>~Ì¿þ x“ãÃO€cÿ‚qÇð³ÇÞ“ö6ý”?gï~Î_ðª¾þÖ>.ø¤ü@øÓñáwÅwû7ÆZ~ƒð'\ðî¿ý§ñ/⿇5¯êZ*tðH¿Ù;@ø¢|[Õ)øƒàÇÄ?ìÍ7âöOÀ›ß]éÿð°~+øZ÷W¹ðõ¸ÿÀ?ÙŠƒŸ¶‡Áï| ý’øÇñâ·í1ûOü"ð·„iÝSÆ´Ä[ÏŠºê?|c}á_ÚÇþ$ø³ñ[ý‰?g­+Ã_·/í;ñÿÇ¿ðFÿ| ñ¿ÇŸÚ\ø×ðŸö«ñg†¿àš:¯Š¾ xW]ýŽ~ |7øaâo|ýª>&|qðïˆ>.üqðgÇ­oYµø_áÏiÞ'Ô~9\ø¿Çz­ÏŽ~%Ýh€»ÔP@ñKá?ÂÏŽ>×~ükøiðÿãÃ/fÂMðëâ—ƒ|;ñÀž"þÄÖ4ÿhßÛ¾ñf›«øWþÉñ“¥kºgö†Ÿqö cLÓõ;_*öÊÚxÀ>@þÏý£¿cßô3SøûbþË?ñ0ñ¯ŒµÛ¯þÙ?³§„´Ïø•A¦|'°ðÂÛ¿~Ýô¾…¬êZÅ/ÛŠ üKñ.ŸñKöùøÏñcá×ÁO €}ð·âÏÂÏŽ>о)|ø—ðÿãÃ/iÿÂ5ñáoŒ¼;ñÀž"þÄÖ5ë?Ø^.𞥫øWþÉñ“ªèZŸØ5 °kf¡¦]yW¶W0FèP@?ñûã_…gOƒ¾5xÆÃÄî“à/Í©Zx;Á–ºv©ñ âOŠ¯'ƒGð/Â_…~Õ5]ÛÆ?>/xßRð÷Ä>‹U³Ô|ñ3Åžð^#êúõ”Rp²ÁO|!ø{«kÿµë¿´·Çiÿjÿx2ëQ—áî¹ñöóáŸÃφºÍ‡Â» KJÐ.tƒÿ¼ðÏÀ>ÚêZŸ5/†ü)â_‹š¯Ž~4ëßþ#xÄéú( € ( € ( € ( € ( € (óƒþñâÏ øÓþ CÿÜÖ<âoø³I³ýˆ?f? ÞjžÖtí{NµñW€¾øKÀ¾:ðÕÍö—sumˆ<ãx‡ÁÞ,Ñ¥•ux«BÖ|=¬[Yêú]õ¤£ôP@P@P@P@ |Rýžüw¥øï]øýû.øóþ×Å­cû3XøðÄ £Ãû8þÖZdž4}?Âþã©_xÇâÃoˆ¿ìá^øköøq£xïHµÒþMñÏÁ?µÂ_Ùïáìñ | ý¡4_ð”øSðÄ‚?>ÿbOñ#àÆ%ð$_ü £ø¿û^o‡þ.º¸øa㿉ÿ ¼eðÿâ%–ƒ®·ƒþ"ü-øãï^xÂÿ~ê"Ó>0|$ø½ð÷À@ÿ@|¡ÆXþÖ:Ä88ø ûü@ø¥àßO'úU¯ÆÛ']øm¦|:ñ·Åx‹Cò,Ÿáÿì­ðËâgÇïÙ/XÓfñ7Šì|cûG|Iý¤<ñ á§Ão~Æÿ ¼]ã°¿è € ( € ( € ( € ( € ( €?àÿðOoØãü·þ áñKã_ì=û |`ø›âØö$ÿ„›â/Å/Ù§àÇÄø‹ûö]øSáÝûwÅÞ,ðV¯â _û'ÃúN•¡iŸÚ…ÇØ4}3OÓ-|«++h#úÿþ;ÿ²ÿ¤iþÀø†ÿ³¯ÿ;š?á×ÿ±f‘þð·á×ÄÙ“ÃïûûÏþÅ_´—í;û ü,Õõ†ýÝÇ‹µÿ„¿±×Æ?ß ¼EñþÊ=?FÕ~"ë¾Ô|w«øw@𯆵?]øÂ>Ótþ{â/‡ÿâQðŸþ 7ûü$øiÿ ‡ßð’~Ë´Gü#ÿhÿJÕâñ~Úß²‡íAûMxÃûWZ›RÖÿâåütñÇü#ÿÚ_ð‹ø7þ¯‡ú'…|áðû;þ ›àOø›ÿÂeû~Ôÿiÿ‰wü+ïøVŸ´Wì ýç¥Âeÿ ‹þÇü£þ_ìÿ±ÿb´ÿ…áOíøHá)ÿ…±¡ÂÿŽÀømßü?ý×í+û þ×ÿ쬿âEyñá?€ôÛgágŠñ‡tÏxk]Ótð € ( € ( €<ã§ÀÏøZð‹ø×Á^)ÿ…Yû@|,þÛºø5ñ–ÛDÿ„‹þßøHÿ²Å¿¾!xI5ÿÂÓøñOþßYübø;{â?ÿÂGÿïƒüà|,ý >|øÝð°Ÿø)ñ¯ÅZ‡Šµ€ì=ü·×5]{W³ðýž¯¯xsDøÏðc[ñ‰þ!~Ëÿ¼OáÏx¿Ä¾|Cý?h¿Ú(òƒþ éûHxïÁ~ý‹?cÏ€º?ÄþÓ_¶¯íðá¾è?|£øÏâï„´Ù_XÑ¿h•ý¡>Ú|GŽÓà¥ÿ ïû@xgögñçÄ|yñ?ƒ| ñ#à›|Oð¾§ãÏ„,Þ ý ¾ ~¯þÈ=ð÷Áo†@OÐ@P@P@P@P@P@|ÿÿ”YÁ4ÿìÀ?cýg_‡4÷ýP@xÇOÙWöqý¥ÿá¹øëð_áÿÄ|?þÛŸáou½Ö/ŠudI¨x»àgŽ0X|Møñ;ßøkYÒ>"ü$ñgƒ |LÒôíWIÑ~$ü6Öµm+^ÒlüAg¤ëÚÿ†õÍĺ‰þüKø{â| ø¿àŸˆ>!üAø†ø;ãÿíÏŠvß¿h¿|?ðÿíðËáÿŒ"ðÏô}‹Ã¿~øƒÄ£ñÏÅ_Ù¯Xñ ïˆ<[áÿ‡þ ño‡þÁûF~Ï÷Þ.ñŒgÏŠv_ <;ñZø›ðãIJçí!ñøëú( € ( € ( € ( € ( € ( €>ÿ‚NÿÊ,¿àšö`±¿þ³¯Ãšûþ€ ( € ( €?á†?áKÿÄËöø£ÿ såÍÿ„'þÇì'ªïýÇüšWü%ß¿áKý‡ûWÆ^2ÿŒ+ø±û$ÂÆøÅâøY´wü/¿ìïøF¯€: þØZƒüUᯆ¶§ÃþÉ?<|;øGñâfŽöýP@P@?ñ¯à§…~9xVÃB×uxWÄžñ¯Ž~|Sð5Ö¥üLø5ñ3KÓµ]'Eø“ðÛZÕ´­{I³ñž“¯kþ×4?è'ø{ñ/áï‰ümðƒâÿ‚~!üø‡ñáÿŠ8‚ŸüU¨x«PøñþÃÃþý¤|+áû¯Ã7†-u/áŸí ðÏKÔt­ããßÀK}sU×µ{?Ùêú÷‡4OŒÿ5¿øŸâì¿ñ Äþð‡‹üGñ áwÄ?ÙÓö‹ý¢€>Ÿ € ( € ( € ( € ( € ( € øþ ;ÿ(²ÿ‚iÿÙ€~Æÿúοhïú( € ( € çüYá? ø÷¾&ð/Ž¼5áÿx'ÆžÖ|'ãx³FÓ¼Gá_xWÄzuÎâ x›ÃÚŵ擯x^Òo/4½gFÕ-.´íSNº¹²¾¶žÚyb`ˆ?áF|vý•ÿâmû'x§þ/À¥ÃxÛDðu¿ü"ž±çþ÷ì1ñ³û_á×ü)°ÿjø^ðÁßÚZÿãGÀ™¿°¾~Íüaû|Ò¿á.ðhÓÿ>5øWã—…u wB°ñ…|Iá_]xâŸÂÏÚéÚ_Äσ_4½;JÕµ¯†ßt]'U×´›?Yé:öâ]\ð޿⇿þøŸÁ?þxÛâÁψþ ø Ø( € ( €<ö„øÿ «Gð§áÿÿ¿øÁðGâübøñ"}þýÀßâð'ŽþOuâï‡ójú —ÄO‡þ2øeñ?â?Â߈¾mwÂþ#¼ð'¼E¨|1øƒð“ã™ð÷â÷€€Ùïã§ü.­ÇšgˆøËá—Äÿ‡¾xÁt/ øŽóÀž>ðîŸñ;á÷ÂOŒgÄ/„>÷ú( € ( € ( € ( € ( € (àø$ïü¢Ëþ §ÿfûÿë:ü9 ¿è € ( € ( €>`ø×û/øWâ?Š¬>7ü?ü"ý­¼áû_|;ý¥´ßéÚ犢ð®¨êºÜ>-ÙÛßxkWøÏû0xŸWÖõküÖ¼_¢iÒê:”>xŸáíàÿ…?þ>5ø«PñV¡ðãý‡‡ü+ûHøWÃ÷^'†o Zê:_Ã?Úáž—¨éZÇÇ¿€–ú櫯jö~³ÕõïhŸþ k~#ñ?Ä/Ùâ‰ü9áøâÂ§íûE}?@P@òí ð·Çz_ŽüûQüп¶>-|;Ûáÿ‹Ÿ4}OGðƱûY~Î0èþ;að*Ox§P°økñá·ÄÁñÏöoñ/Ä/ì»]Çz7þCñoö{øKûXþÑ¡÷ÿ„ÿ¼ ñÇágÃO ußøJ>|`øàߊ_¼Mý™¬hŸð‘xâ‡tßxG]þÆñŸ¤øƒIþ×ðþ¯§êٚkhû.§§Ù^Å=´`@P@P@P@P@P@Á'å_ðM?û0ØßÿY×áÍ}ÿ@P@P@Pükøðoö‹ð­‡ƒ¾5|=ðÿt ľ3ðuæ¥ ö~*ømñ KÓµ]/Ãß>øëGŸNñ¿ÂŒ¶×5Y|ñ{áˆ|'ñ3ÀäšÇ‚üW¡jëòyÂߊ^;øgã½ öký¥5ßøH<[âí8?gŸÚ}3GðþûPhþÑõê~ñv™áí?Gð—?kÿxKGÕ¼Iñá׆ôŸøã¿ € ( € ø]ÿŒ.øÙ¨xñÑd_ÚoâÂßëÞо[_ÙûöÉø×ñwSð]—Å?ÂÒý¶÷RøûlüMø«ðÇÀŸ´ß‡ £Xü/ý£´ý3ö„ñÃOEûQ~׿´?Â@¿è € ( € ( € ( € ( € (àø$ïü¢Ëþ §ÿfûÿë:ü9 ¿è € ( € ( € (Ïþ)|-ð'Æk¿ ¾$è_ðxKÄÙ“ÜÛA©ëÖ4­cÃúÆŸâo ø»Â>,ðÖ¡£ø·ÀŸ< âÝCñ·Ã¯ˆ¾ סâOÂ>.Ó<=§èþð'íàO hú·‰>"ü:ðÞ“áÿ|oð'‡üEûHþÍÞðÿ„¼?ûAþÏŸ±è×ôP@PŸüYø[àOŽ? >%üø¥¡ÂQðËãÃÿ|-ø‹á¯í=cDÿ„‹ÀŸ<;©xOÅÚöχu 'ÄOö¿‡õ}BÃûOBÕtÍbÃíjÓ5 +Ø ¹ŒÀ?eߊ^;¸Ö>%~ÌßõßøHÿhÙÿû/ħ‹!Ó4{[_‹³Å?ü\Ñ¿eŸŽ·w>ÓôO AñÇøIâŸ|zðÖ—àÿ…–º'íð¿ã£à„žýžø â&·ð[âÆ¿~Î~4øâ÷~ñ~…ðóÃ? ¦êÀ§þ>ý§`ð7ÇÛ/ÙÒßà¿ÆøßijÆOÚwáî©á9þ Áá_‰p| ñ§Âÿøã࿆¯¼gñƒÂ¾ñ€êÿ¾ÜhÓüDÐü ðoPÓ¼im4Ÿ-nt/ÚxxÏÿdŸÛnÚúËáÙ‹öŸøSá¿øƒãïxÛã^‡ðoÞðçÆÿ?uß‚ÿþ ØOá/¾9Õþ%øƒOÕü=¨ø†×âÁâOìÕs§Z꾎|dð·Œþxlçÿ…µïí…ñ¯öýøÃðoEýœ|AðëöOý›þ0kþ&øïÄÞ øãmGÅ^*ƒötðoǯ üB¶ø¡ ÿÁ@ü3ã…þñÅ·Æ…‡ÂôŸØ{ö‡Ô_·Z6¥ñâÂïøïÇÞý™À:†ŸðVÙâGí“©~ÃÊßðü`_ˆ~øY¿áz~ÅŸá3ñßÁËxƒÅzü+Ùãö©øÑûFü,ÿŠ7á×<[ý§ûB|ø9£øþ¿ø@|w¨xCã‰<ðãÄ ìëÿƒöÔ~ kŸÿbßÛ~Ãö|ý üAâý7áícã/‡ÿü=ðoÄžð÷…~#xËÂßõ¿7ŸµÃ_ƒÿô?‡Mð{ÇŸÿgOiÞ.ŸÇŸ -î#Ò$ø—á_·€sÿ³ïüOágí ã¿€:û;~×ÿ ¾~×ðµáÿi‹ü;áß‚´ü*ÝZñ¼_ðG¡|DñOÆ…?ðµ¾ø[Æ?~ÃLü$øÿ {áƒüAâ_ýºö-øæÙoþ ñ÷â£û xÿö“ý®à”tŸÛ{Ãþø×áßØföÿÆžý®4¿€_´W…~ ÞþÊV þ,x÷ö‘±¶øûñƒQñ¼Ÿ| ãë[Øÿá·‚üO­Éñ“JøoªÉ«øGÂÖ~*úþ§ð³þŸü"_ðÎßµÿü)/økÿøaølÏøT~ÿ†gÿ†˜ÿ„þ—ü"þWü,OøhøWÿðÐÿñ‹?ð¿ÿ៿ážÿá¡?â‹ÿ…§ý™ÿxü6·íõöïøiOìÙþãþÿ ÿ Kû+ãGü4Çü*ÏølŸøvßü4ü/ÿøJÿáVÿÂÀÿ†­ÿ‹Ÿÿ ýÿ çÿïü3ßüHá¡¿ád¦Píõ|ÿÿ”YÁ4ÿìÀ?cýg_‡4÷ýP@P@P@çÿ¾øãG5߆ßt/øH<%âìÉîm ÔõëV±áýcOñ7„ü]áxkPÑü[àOˆñn¡øÛá×Ä_ëžñßïøþ9ð7ˆ¼?âßèÚ͈€~ͼw¦dþËÿ´¾»ý§ûSü8øa}ãùtÍÃþý®¼ áì jßµ?­/AÓôŸé?ÚÞ Õôý >é61k²ÇÅ?è¾ ¿Oüøû4|wý >¿ € ( €> ý³¼'⯠éÞý²¾xkÄ/øãû)øÅÓøgFÔ|g⌿³¼Uð³Å¿µ§Àü<±¶¸¹ñoÆø'à׆ü[û6A¡_ø'ĵÃ/‚Þ×þ!i¿¼_ñ»Áž?úÿÂ~,ð¯|+á¯xÄÞñ§‚|iáýÅžñ„õ;Ä~ñg…|G§[kñ7†¼C£ÜÞi:÷‡õí&òÓTѵ.òëNÕ4ë«kë+™í§ŠVè( € ( €<ÿâÏ€ákü,ø—ð·þ_ˆ ¿áe|?ñ—€ábü'ñü!ßüÿ ‡u/ÿÂkðÓÅßcÔáøá_ííßøû>ÿûÄvn§ö;¯²ùñˆÿà›úÅ ügð÷íûR~Óÿ´ž¯ñwö`ø÷û!éž:øìÁàÏ|ø7ûOéÞ²øëeðÆÓöyý™>x&ûÄ;¹ø{ð·Xm{â*ÏáGះâðl^Òu_À: ~Âþ-Ñ~)¿Æ¿~ÝŸµÿÅÿ‰ºOÀß³ßÃOxÿÃß°ö“ÿ Gøùâ?ƒ^,ñ—<£|'ý‹¾ø^øa‟ 57Å+â_,¿²/mu/jöZ¾¥mpè²ì“uû"xwÇ^ƒö”ý >?xÆß<{ñJŽšìãmÿŽþ.|Sø“ñ¯ã»á{¯€¿³ÏÀ«Ù¿áfüMø¥â/kzg‹®|W£øwìÚFðëOðO‡í®ô«à?ýžÿaþÏÿ|yñmnÏÚÿâßü-¿ˆ ñKãÃߊ^ý‡ ð'ÅÁðOÀŸtMw]›áGì]ð³â‡áøð³áŒzf™ðãǾÑîõéú—ˆ4ýoûoÆPx˜À>ÿÁ <1û;èÿ±ÿ‚|ûk~×ÿð©aψ_~|ŸÁÿðO½À–šÇü Ÿ¾ø¦^øöðWÄÂÈøñ—âÞ‡ñÄZ—Žá;ñ6±ñÄ_dñu·Å¯ì¿i ÿû.~Áw_²'ü Þø[ûdþ×ú¿ìåðÃþm3á×ì§ñ/Týœ~"|,ð5øHG„~é¿|Eû6Ü~×W¿þÅ­éúwÂ}?]ý¦u}cþðwƒ|©ëº÷ƒt™ü?|à²çüOöJý>;xã‡Ááÿ…eÿ 5Ÿ€| ÿ Óÿñ²ÿ„oþ ðwˆ|gáÏøhO~Åý¶¼Aÿÿ†¼@ö?ðšø·ö§ñÅ?}‹Æ_üMÿ„ƒÆ«âÿàwüçÁßÿÂ[ð³ãgÁ=ÁZoÄ+ÿÙö/Ú·Äÿþü-ø÷ã_|'ðçÿiÿÂ1áÝ?Áº=í浦xKI´ˆ€ÿ‡)þÉVµ?ü5w…åÿ„WŲ~ÐðÒ÷^ÿ†iÿ‚xøûí_õˆ¿ð¶üa«ÂõøÅû|Jý±ì?á1ø‘u­øŸíúGí7§xá·öçü#ß5ï…ð¯ÃíÁÀÿü:·ágü-?øKá¢kÿøR_ð×ÿðÝßðÆð·<;ÿ Ïÿ 1ÿ ü,ßøJ<ßøWŸðÐÿð¯ÿá¡ÿã)¿á@Ã@ÿÃ=ÿÃBÅiÿ ·û3þ)Úý? €?à“¿ò‹/ø&Ÿý˜ìoÿ¬ëðæ€>ÿ € ( € ( € ( € ùƒö ø)⯈þOˆ?5ø?ö¶øCáÿj_³OÄOÝj:w…bñV¹§XÜ^|%øÏ&‰¥kz¿‰ÿfŒú¿†¼!¢ü{𾓩j2éÚ†>)ü3“Áÿ´OÂ/Ÿ¾wÿ>5øWã—…u wB°ñ…|Iá_]xâŸÂÏÚéÚ_Äσ_4½;JÕµ¯†ßt]'U×´›?Yé:öâ]\ð޿⇿þøŸÁ?þxÛâÁψþ ø Ø( € ( €?eOø°ÿ?hÏØë\ýÅ•ÿĉ߶·ìí®ß~îëâÂÏÚ«âï‹>)~ÐZºçö<^-øû?þ×^;ø“gã=+ÀÞü*ýœ~8þÂöþ6ñ_ˆ¾&üL×µ À¿è € ( € ( € óÿŠ^ÿ…ŸàMwÁQø×âÃ{ÝOû2÷FñÿÂßÂ/ã¿xÃúÆŸâ? xB½¹³Õü?«ÿdøƒIÓou?x÷Þ3øYñG‹PðÅ¿ü@øeâ_x+^ð…¿´'Žô¿è_j?ÿºøµ¬ièÿ>.x}txgÚËXðƨx§Ä| ã¿ü@ømñ×áýü,/þÍÿàѼw¤ZéáøãÚÇá/ì÷ñ;ö‡„ëú( € øþ ;ÿ(²ÿ‚iÿÙ€~Æÿúοhïú( € (À?j¯ŒzÇìïû8ühø÷£i_õøRÿõÿŠ^ ¶ø¥ãü:ð%§< j|Mñ]×|YðÇà¿íñÓþŸ‡úo‰¼G¦ižø1ã½cÄÚÆ•§øbÛO±þØmgMùÿö*ý¸5Ú_öX×þ:|iøñödøÁð³ûVÚöYûŽþ3üSø3¬7ï üyð_„²ü)ðÃAñŸÄOˆ2ýœ¾'üø£ÿ ëÀÿµø{ÄáIê¾ÿ…ÁáøSOöµ/‚þ6~Ì_í5icâ¤ÙøÇíñÂþøsñ÷]ñW†¾!|ñŠ|ñÏádž¾x×àÂÿÚGÆ> ð'ÅøëÀz7‡ï¿g¿|LñÆ£¡[.—ðÆÏWÖltÏþÍÿ·wìÏû[ëÆ…ðŧðö„ø£ü9ñÃÉðëÇ?þ)x‹âOÂßxáwíá¿,†¡û:üBÔü5ñØxSо)Cðî_†^ Ðü]¨}@P@|û@Æ'|S‹öÌпâ_ðKÅ_ؾ ý¸<¤ÿĺÆoøH|Gð«á÷ÂÿÛŸ^º¿ó¼%£ÿÃ'xKKÔü;ûKø»P›áÏö§ìm¨ßüMø¥ñGÅZgì-ðàî°÷ýP@ñí½á?hÞð?í[ð§Ã^ ñWÆOØóÄÅ_x#FÔuÏ|jøªiË£þÔ¿³†…áï ÛE⟈þ øð¦+üø?ˆü1à¿~Û_ÿdOüDÔ$ðßÃ׈}á?xWǾð׎¼ âoøÓÁ>4ðþâÏxÇÂzÎâ? ø³Â¾#Ó­µx›Ã^!Ñîo4{Ãúö“yiªhÚΗyu§jšuÕµõ•ÌöÓÅ+tP@P@P@yÿÅ/…¾øÑàMwá·Ä þ xƒû2{›h5=cÃúÆ•¬xXÓüMá?xGÅžÔ4øâ<[£è~6øuñÁ:ç‡üwðëÇ~ðïŽ| â/ø·Ãú6³bòü&¿ÿb¯ø—ü^½ÿ…›ûø÷v´ß‰¼â?|vý›ü;{Æ“¥þÔz^½áËßøY¿>}ŠãLñíÅwñJ÷⟄<âk¿µ—Ãoxká—í/ûjÀÐ@ðüwþQeÿÓÿ³ýÿõ~ÐßôP@PÄðPïÙWâí±û0x«ögð/Æ?üÒ~%øƒÁÖ¿µxâgŽ`ñïÁ½Äž!ñçÁF‹áíû1øß@ðÿÆ‹m*ÓáÇÄíWKø'Õ¾ ø‡â?ì¬4ý_ÆoŒ|&óÿÂ/ø'ÇÇ?Ùwã/íoñö[ý©ü? ø'ö•ðÿÁ«­ áÏí9á?Û öÍÔ|ñ—át?†5ÿ~4ø•ñþ 'Š~#øƒâ?˜®¾ëšW†ãøIŸ…~þÌ6é¨_[|ñ-‡Æ `ý‘ÿfÚŸönøEñ£á׋?h߀¼Aã?ˆ´Æ/„¾)ðïìñáÆðûâŸí'ñ³ã_íãÛ¯ˆ¾Ô¿l‰W¿~é~.ÛAáøkÅß|G§xÃSøwYøƒâk©ãM ý†ÿg¿³‚þ!øã7ÇOƒÿtŸü`øÕñ¯Â× gO|Ô|7â¯Ú7ãïÆ/Ú3â퇈&ñWí7ûCÛx·Ãÿð›üZ}/áÅ®iàÝGÂ>ÐVËÄú¯Ä=_S:å€ÛôP@P@~Ç_ñŽZÅçüËÄ%—Àï‡öþ2ý“üDÐ4þÆÓøïÄþøyðŸ@ƒXÙâ âì/áûO‡³ïÆIu_‰—Ú—£âu¤úFßøoáÿÂïÚ7µçì¹ðá>…§xFûá7ìãû7üðÍïƒ[Ãíሿ€>ÿ € ( € ( € ( €>ÿ…ã¿Øãþ&°·ÂO‡ú×À[¯ô¿þÄ:Wˆ4‚žðmÕ—üLuˆ_±SGá«Ÿ†^ øãk+kí+ųŒîþþÎ?>)ë:ƹ~5þ˾:¸ý¤4ðþâÏxÇÂzÎâ? ø³Â¾#Ó­µx›Ã^!Ñîo4{Ãúö“yiªhÚΗyu§jšuÕµõ•ÌöÓÅ+tP@ðí?ÿCöŽý”?j­+þ$þñ_Ä ö*ý§51Æ©|,ý .µ-?öa×õý Cû7Š|Wý£>|róýöñø7áÝ;Åžý£õ¯þϾø~ÛÅ_> k>!ŸÅºƒ>ÿÂUá¯ÞþÒ¾ÕtíKÕü{û.¯âÍX¹ý°&ðw„¾ü3ð¯ü$Ñ~ÓQ~Ï~ü|øcðˆíúü!ÿ‚exûþ IgÿÜÿ‚|ÚxöPýˆñ©¤­¥ö³á­/Ç^4Ó´-F{.ËÅž#¶µ‹X¼ûþ7ü7þŒßöÿÅ•þÑ_ý)ê?ácÁSèÍÿ`üY_íÿÒž þ7ü7þŒßöÿÅ•þÑ_ý)êôÙ'ö…ø§ñÆëö”ðÆ¿„¿þüMý™ÿh ?àg‰´…¿¼Gñ×Àž"þÛýœgŸÚCFñN…ã|ýŸ#ñn—ãÏì¿è € (À?j¯ŸðÒÿ³ÆVÞ)ÿ…â‰õýÀ Ñ?á Ö> üSŠÔê ~:xGOWðõì>|M°ðŸÅ¿‡Z¾â_ øÃÞ;ðg‡|Aá¯økÄf›®éàì¹ñÓþ?àO¾,^ø_þê?ð“x?â·ÃOí¿øJ¿áS|vøQãü'ý >ÿÂe‘¡éž<ÿ…Cñ·Á?øiÿ Úrx;ÇÿðŠÿÂeà«­GÂZæ‹©]€{ýP@P@P@Pçü þ ÿ¨þÚޚߟ|AðsÆ0x~MK²ñg€<+ûB|¹Ô[NñŸ†l|Yâo^:¸Ñ®SÄO‚~*|[ð†³mð·âgÂ? þÑ> ñÝÏÁÛ—Ã_µÇìŸmyû7jàÿ­Òÿà¥ß <+ñ‡örÿ‚‡ø[Ãþ%Ò~xƒÂz_ì·ûWé¿ô¯Þ*ý¢> øŸNÖu+_ |[Ö_ÀøYð_Çöþ ñ«ý»®ü*ø¦÷ýP@ðì}ÿÛã·íëû4Oÿ]3¿´“ûQüðWü„~Áð'öÑðu§ü[ã¯øIí÷_ð²¿à þÿ‚…êßðŒø«^¸ñƒ¿³¾Á¦xÂ߯>ÙÝ}ÿ@P@P@P@P@Á'å_ðM?û0ØßÿY×áÍ}ÿ@ðìoÿ'ÿbÿ³ÿøsÿ®²ÿ‚iÐßôP@P@P@Pþп<+ûJ|øãû:xëPñ•àŸßþ%üñŽ©á;­:ÇÅZo…~*x/Zð/ˆu _kV½¤Ùø‚ÏIׯ.4k­SCÖtë}F;i¯´­FÙ%´˜€ý¾5ø«ã÷ìñàï|C°ðþ›ñ[BñÅ?‚Ÿ­ük¨Ùü=“ãïì×ñoÇ_³§Ç½Cá\:櫬ø‘þêß>øãTøCuâÛÈ|i}ðÎó—Þ3Ò´/ÜjúœôýP@|ñSþ,çüöaø¥iþáÿÛáÿÄØ«â%žŸÿ cÄŸþøcâ'í‹û'ëú¾­¶ËÃþ|2ð‡ü;B×u_j^#ñ'Žþ;ü-Óñ¯ü%Þ³Ô|[á_øE|[¨éïü$~ÓïüG¡ýƒûOD³ºÔím pÄø$‡ì3ñwàWí1â‰×°—ü;Ãà/…¾üVмð#Rø±ðOâ·“¬|yýžÿàžÕ´ÿø§à·Ä‰—¾8ÿ„Wâoü«ã׈>%üRøÀ¿¼wñ7þ·Âˆóiž)ñ׎>1é @?£êøö7ÿ“Šÿ‚±Ùÿü9ÿ×YÁ4èïú( € ( € ( € ( €?e¿ø¶ÿµüö~—÷Wÿ> ~Úß4- ÷~ðgÂÏÚ«áµÇÂßh~˜ßa‹Ã¿*Þø¯Ä_~&|NÓü4÷ýP@|ÿ-ÿŠwög²øÝüJ¿á•ÿhÙwö£ñ?ìÿsâ?…Ÿ~ þП|Gûbøë×–ñRÿÉ’ÿÃHxKƾðB_xÇâŸÂÏøÿàÖáÿÂƸðWˆÀ>ÿ € ( € ( € ( € ( €?à“¿ò‹/ø&Ÿý˜ìoÿ¬ëðæ€=ƒöÝð7Š¾'þÅÿµßÃ_ü6ðÿÆ_üCý˜>>øÁßð¯Åox·áO‹4|6ñ7‰t|5Õü=áÿêú…§†5sKøà GIÓµK›û/xVæÞ-vÀåÿࣞý©þê´Ÿí3ðÿö–ø%àÿÙö‡ð‹¼]ð¿àn©û/ÿmüvÔ~"þÆü:ñ¯Æ‡SþÔŸ|%ñ#⋼%à¿ŽZŸ†ýÿäâ¿à¬_öÿõÖ_ðM:ûþ€>@øÅût~Ïÿ¾)Ý|ñt?´Š>&éÿüñKXð×ÀÏØïö¿ý¦ÿáð'ÄüAðŸ‚5ßë?³À¿ŠÞð·ü%> øSñÃDÓøÍÿÃþ ûüR_ô/þÐßÿh¿Ø«Å~ÿGÖÓ|UñSáO‹< áíCÄ×Ú>•¯jö~³ÕõëKfëKÐõFßNŽæk-+Q¹H­&ïÿg¯~ý¥>|ý£< aâ +Á?¾ü4ø×àí/Å–ºuŠ´ß üTð^‹ã¯XxšËGÕuí&ÏÄzN½io¬Úéz泧[ê1ÜÃeªê6ÉäÀÁ@P@P@P@PÀðIßùE—üOþÌö7ÿÖuøs@@~Ö>ø§ñ_öXý¥¾ü ñ¯ü+o¿¾|dðÁ߈¿ð‘øÁßð€üSñïøwá÷á.ð}ž£âß ÿÂ+âÝGH×á#ð¾Ÿâ=ìÚz%Ö§km€~@Á4c¯üý©ü'ñKáÇü7þ[ðKð…ðãWïøho…Ÿÿá¢ÿhCñÀ~"øqªÿÂ#ð âÄÏ |Pÿ†\ð—…¾5h_ðØÿuþÓ᥿³5Ÿ6™ ë3éÀ¿Ôðìoÿ'ÿbÿ³ÿøsÿ®²ÿ‚iÐßôðßùJoí‘ÿfÿÓÿÖŠÿ‚±PøÏþ ™­ø[âÅO‡:'üWþ ?ñ3WøMáÿ‹Þ9Ö$øwáÙPÔuφ¾&x¯áL_|;ðïÄ?¶'†¾2Â?ñ³Äžñ}ÿì­¡øᯇ~!~Õ~𧋼OðÁ?tŸxÆã@?cO‰ÚÆÏÛCâÇÆmcÃþðž¯ñsþ Aÿˆøªx[Âü+ñ¾Ô|{ñ[þ â«ïøkâïYüñSÃú5έ.£|Gðs¿…|q§[[xŸÃÌÚN©hHêýP@P@PÀðQ?ø§þ~Î_4ôOˆ ?oÿØþö¿ÿðÿÃD~Ôÿ ?b¯Œ_ñ*ºó´]WþÙ—ö øéðÓþ'zv¥ÿÿü'ð™x[ûâ†|⯀}ÿ@P@|ÿ¿ÿ‰OìYðïám·ÏáÿÙ“âí%ûxò›XÕþ~Âÿ´ïÆ?Øëá.¿âëˆü»+ÿˆ"øeð;ÂzïÄ]WFÓôêþ;Ôÿ‚NÿÊ,¿àšö`±¿þ³¯Ãšóÿø*7ìïâ?~ý”õ½3öRøûqøKöý¯ü3ñ‹âßì¥ãûÿ…–¿ð¶>kßh/ÙßÄ^ °øëoÁ/ü@øO©ü{о9øsÁÿ¼Sðóþ'ÿ…a{¤iÿ|3âÛŸ \JÏü&ð¯ÆÿßðRO~×^3ý‡üAû$ø'á?ìAñWöq»ñ÷Æ¿~Í^ øûñÛÅ_~<üø›áßXh?³ÄÏúM—ÁÿÙûIøâÝj×Wø‡ñ‡HÔn¼iûFj¶~økµ·¼Q¨€~¯ÐÀ±¿üœWü‹þÏÿáÏþºËþ §@ÐÀå)¿¶Gý˜üOÿZ+þ Å@ ~ß? ,|}ûSëÿðÏÚ—üþÃöš¿ý<=ðÓöÿ‡qüYý¾lý™þ%|Eø¿ÿ ó©|Eÿ†öñ—…~éß4ïˆýªáE|Yý—þËûB|(ûWÅøKüeàíÆ? ¿·=öÓ< ¢~Ôþ2Ѿü-øð;á–“ÿÿ‚7韾 |YÓõ'âŸÁÿX|Eÿ‚ŸÚøGáoĽ+ÄZïŠÿ € øö7ÿ“Šÿ‚±Ùÿü9ÿ×YÁ4èïúøáÏü¥7öÈÿ³ÿ‚iÿëEÁX¨ŸñÀ-ö²ø¶ßµÇìóûnþÓÿ5} Ãÿ¿d?E𳟅|e¨þÏß´?ÄxîËâûL~ÈŸ|Iã|/øÉៈ¾ø}¯jzï…| §^|CÕ>E¡i?~-x‡â¨~ÁŸ5¿ÚŸÆZÏÂߊ_>8ü2Õÿà?ðFýOá×Æ¿‹:†±«üSøÁàKÿˆ¿ðSû¯üRø—ªø‹Bð¿ˆ5?ˆ&ñ7ˆu‹›Í_^ñ½«Þ^jšÎ³ª^]j:¦£us}}s=ÌòÊÀoÐ@PÀ±¿üœWü‹þÏÿáÏþºËþ §@Ð@P@P@P@øCÿÊÿ‚›Á6üÿÜÿ‚|øÇ_ðP؃Á~7ð_ìAû(xOÆ>ñgí_ðÞ*🊼9ðÀZ?ˆ|5âok>³Õô/hZ½æ—¬èÚ¥¥®£¥ê6·6WÖÐ\Á,Jöÿü=‹þ eÿI,ý€?ñ2?g_þxôÃØ¿à–_ô’ÏØÿ#öuÿç@ü=‹þ eÿI,ý€?ñ2?g_þxôñì¡ÿ6ÿ‚møsãÏüÛXñüö дŸþÛþñguMgö¯ø ¥éÞ4ð­Ÿüsþ óà[ÏxNúûÇÐ[xÃö¾7ð_Œ|s¬èòÞiÐx«Â~&ðô·+«èZ¥¥¨Ûÿðö/ø%—ý$³öÿÄÈýùãÐÄÿ‚›Á6ìÿटµŽ¯?à ÿ±¯‚|GûÁ>|'áïÜþÕÿ ð®½â¯üyÿ‚›k1ðÖâ||ºN©â é>=ð.©â]Êò}GBÓ¼iá;íRÚÖÛÄz<·€ i¿ðluœþ7Öƒ¢iž&Р˜ôÿþÅÿ²ÿ¤–~Àø™³¯ÿx Gñ†¼MáícÇÖz¾…â W³¼ÒõT´µÔt½FÖæÊúÚ ˜%‰@>ßÿ‡±Á,¿é%Ÿ°þ&GìëÿÏ€ø{üËþ’Yûâd~οüñèÿ‡±Á,¿é%Ÿ°þ&GìëÿÏ€ø{üËþ’Yûâd~οüñèÿ‡±Á,¿é%Ÿ°þ&GìëÿÏ€<þ ûûBüø½ûUÁN4?~þÐÚOŠþ0~Í¿µL^=ø ñ/Á~èžø¥û(ü3ý”´‡~#ñOƒµ½NÛMøÁ¢øßö øŸãøEb¹Ó´ï†~ x†×ÄZ†¯â¿øwÁÀ«ôP@P@P@P@P@P@P@~p~ÙðSƒðOÿŒ¿³¯ƒ¿j½Ä~þÔ> ? ¼ ûWÀ³êþüe±ƒ[Ô¯<ûNë7Ún¤üðÿŒ4“á9~øæ×Ä>;ƒÅSÛühÖ>$h~|Õ>#ø˜ïÿ ø³Â¾=𯆼uà_xÆž ñ§‡ôox;Æ>ÖtïøWÅžñm¬x{ÄÞñsy¤ëÞ×´›ËMSFÖt»Ë­;TÓ®­¯¬®g¶ž)X  € ( € ( € ( € ( € ( € ( € ( € ( € ( € ( €>`ý°ÿeÿ þ×¼yðw]èÞ$Õ|Cñ‚ôïˆp|(ø™«x/Äþ Ñ|zÞÕ¯´Í'Ǿ]'Åšÿ…>'|%ñ. Ÿ~>|ñWÄÙûâþ›âƒŸ> øK_ùöhðçü07öO‰^øà‡´GÄ iŸ|yÿ 7ö_íOñoûJ×~ þÕßõ|=ñoÇ?ˆ4ñji~ý›¿o?‹žÑ>"þÕßdðwÁ/ڈ鿶=ÇÂß~ÛÀ§ôP@P@P@P@P@P@P@P@P@P@P@ÿ‹<'á_øWÄÞñ׆¼?ãOøÓÃúÏ„ücàïhÚwˆü+âÏ øN¹ÑüCá¯x{X¶¼ÒuïëÚMåæ—¬èÚ¥¥Öªi×W6WÖÓÛO,Lò„üYâ¯ÙGÅ^ø;ñ‹ÄÞ ñ§ÀxƒFðgìíûDøÓYÔ|Gâ¯x«Äz¶‹àßÙ‡öŸñ–µsy«ë¾ ×µ{Í?Ÿ³í9â½BëQøë¨Ýh³÷í®Oû_Oð¿â‡íÜöýP@P@P@P@P@P@P@P@P@P@P?âÏ øWǾñ7|uá¯øÓÁ>4ðþ³á?ø;Åš6â? ø³Â¾#Ó®tøkÄÞÖ-¯4{Ãúö“yy¥ë:6©iu§jšuÕÍ•õ´öÓËxÁO |eøEâ­Càω.|AñgàuŸ‡îµïƒ? Õm¯<'âo‹š€ôïŒ>ð‡ì{û9þÙ^:Öm¼S¥ü%ø…sàOXø'ãˆ|+á? KáoéÞ&ñWôc¬x³ÁÚO¯¯ü|lý¬?k‡ßµÇ„e¿†²7ÁÿŠ–ßþü]ø·ð_ân¯û]ktí?Nø­þÍZÅ?hï Ïû.ø¯Wø]áû_ö…·ðßÃ]Kà…×íUâ¯øªÏ âÿü5ðO‰ümãß„ÀAû|üCÿ‚‚kµ?ìùû)þÇZÃÿ‡žø‹ðöý¡5߉ßð¼|1ð³âž£¬|ø‹û<ü8Ôü»â—üÏöÿøe£ü?ŠËö“ðLj6Ùü2¼ñßÄ/óo㿃øU¨xö‘çÿnø+æ‰ûüeø™àü3ðÿíáoÙ»àÿ…~5þÖƒáïíqãoŒ¿<+â.ê`¿ñöÉý²u¿‹¿µ§Ã¯ÙöøñçÃÿ±÷ü!ÞñgŠ~0~ØV?³†±ñƒã·Š¾ øgö‡¹ø;ðš7À?vWÿØ? ¾'|‚ïâÇ/|ðuïŽþ$MáÛ ©¼?à¿xÒÜÈ?à _ðW?c?³~ΞðOìÁ¬xßEý˜$ý§u­Sö»ÿ‚€üý‚ü+âØ5ÿxÏÀ¿ > ü¾øƒá/‰¿ÅOŒ:ÕþüM¸×g×´?†þéÚo‚&ñïÆ 6çâ.“idçúïíiñ3ö¯ø…£üQøgûLþÓÿ²¯ìy Á8?boÛ6ÓÁß³7ì“ð÷öŠý®>'x«þ ñ3ã~àX|cáíSàwí¿s‡þ ø'ö}·ƒQð/Á‚ú–£.·ñ?Æ6ñÅyüðêÊ%?fÛkö¸øÃñ @ð—ìÖZ|3ðgŠ ¶×þÛüyè-þ0~ÓðQ¿ŠvðÉ¿¶'ÄØsà•ïüöRý±>ÿb~ÏŸ³ßÄߊ~(ø§û|xöˆÿ…_©ütÿ…Ϧ|bðøð+Â_³m§ö¿Áÿ„_ðƒxǾ#ø›âŸ´~ÐvZg†ü1´ôö"ø×â¯ÚSö/ý‘?hÏXxJñ¿ÇïÙƒàÆ¿é~µÔl|+¦ø«â§ÂŸ øëÄ6²Ö5]{W³ðýž¯¯^[èÖº¦¹¬ê6útvÐßjºÊKy0ÓôP@P@P@P@P@P@P@P@ñ†¿à²·„þ!\üFÒôŒW7_ü,ø±ÿ³Â_nÿá5ø5ðö„ð'Â]cûcá/<#àùþ ÿŠŸÃºŸˆ¿µ?|ò€z‹¿aÙÿÇ´w‡kMû@Âí𗑆µ] öÄý¯ü%àMGûWíCYðŽŸðSÂ4O‚P|?ñƧð“áÆ­ñKáÒü<ÿ„âÞ±á-3XøáßêiºœŸø·ÿòý›¾6|e“ãÿŽ/ÿiû?ŠÃÃú—„ôïü6ý¼?nŸ‚ºw†¼+®Áà8¼Oá¯ø;àÏíàøÃþ1¹ø_ðó[ñÎàÏhZwŽ)Zé?´¾&ø‹áÿÂ߆ž>ø‹ðö×ý¶>xïã‡~ èúŸ‡~ê_¼]ðoö„ð/ˆ?hˆðþ±¨hVŸ~5ê=ø§{£Ë™ªøÊþÊÎÊ p`ø×ûüøùâ«xÍ~0xWÆö^µðߌ~þÓ´¯ì±â¯øWKÔu]cþø…âÙâßÂ-_âg‡ü«ø‹Åº§Ãíâç‰ôŽ¾!ßxÛÃ÷?üm.¼çÿÿಷÅO|1ø‡â}ã—ñ[áÁöøá_ß?j¿Ú»àçÇÝ[àÛê>×Ã߉ßþ|kð?ÆOž$ðÖâÕ‡ã7Ž<{:xÒçÄ3I×Å>,ñV¯¬€t ý„f†ßcÿ…uáˆþÎý<ûéÿð…|ý¡<+öÙŸáGü$ð«|/gý…ñJÃì¿>Âcâïø@~?Á³ö„ðwü%^#ÿ„wâ–ý¹©ý¨çÿÁàž>(ð'ï‡Z—ÁïˆÞø]ðÅß²w†µþÔ¿µ¯„yy_is_interactive = is_interactive; \ } #define yy_set_bol(at_bol) \ { \ if ( ! YY_CURRENT_BUFFER ){\ getdp_yyensure_buffer_stack (); \ YY_CURRENT_BUFFER_LVALUE = \ getdp_yy_create_buffer(getdp_yyin,YY_BUF_SIZE ); \ } \ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \ } #define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol) /* Begin user sect3 */ typedef unsigned char YY_CHAR; FILE *getdp_yyin = (FILE *) 0, *getdp_yyout = (FILE *) 0; typedef int yy_state_type; extern int getdp_yylineno; int getdp_yylineno = 1; extern char *getdp_yytext; #define yytext_ptr getdp_yytext static yy_state_type yy_get_previous_state (void ); static yy_state_type yy_try_NUL_trans (yy_state_type current_state ); static int yy_get_next_buffer (void ); static void yy_fatal_error (yyconst char msg[] ); /* Done after the current pattern has been matched and before the * corresponding action - sets up getdp_yytext. */ #define YY_DO_BEFORE_ACTION \ (yytext_ptr) = yy_bp; \ getdp_yyleng = (size_t) (yy_cp - yy_bp); \ (yy_hold_char) = *yy_cp; \ *yy_cp = '\0'; \ (yy_c_buf_p) = yy_cp; #define YY_NUM_RULES 360 #define YY_END_OF_BUFFER 361 /* This struct is not used in this scanner, but its presence is necessary. */ struct yy_trans_info { flex_int32_t yy_verify; flex_int32_t yy_nxt; }; static yyconst flex_int16_t yy_accept[2343] = { 0, 0, 0, 361, 359, 1, 2, 359, 6, 359, 359, 359, 358, 359, 354, 354, 354, 354, 354, 20, 3, 359, 7, 359, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 359, 359, 13, 21, 0, 11, 8, 358, 356, 358, 4, 5, 9, 355, 354, 23, 0, 24, 25, 26, 18, 15, 12, 16, 17, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 98, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 172, 173, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 245, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 10, 14, 0, 19, 358, 355, 0, 0, 357, 358, 358, 358, 358, 358, 34, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 67, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 121, 358, 358, 358, 358, 358, 358, 358, 130, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 180, 358, 358, 358, 358, 358, 358, 193, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 279, 358, 358, 358, 358, 358, 358, 358, 358, 305, 358, 358, 358, 358, 320, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 0, 0, 356, 0, 0, 355, 27, 28, 29, 358, 358, 358, 358, 358, 41, 358, 45, 358, 358, 49, 358, 358, 358, 53, 55, 56, 358, 358, 358, 358, 358, 68, 358, 358, 358, 358, 358, 358, 79, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 101, 106, 107, 358, 111, 358, 358, 358, 358, 358, 122, 123, 358, 358, 126, 358, 128, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 190, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 209, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 246, 358, 358, 358, 255, 256, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 278, 280, 281, 358, 358, 358, 358, 288, 358, 290, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 321, 358, 323, 358, 358, 358, 358, 358, 340, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 0, 356, 0, 355, 30, 358, 358, 358, 358, 358, 46, 358, 358, 358, 51, 358, 358, 358, 358, 62, 63, 64, 358, 358, 358, 74, 358, 78, 358, 358, 358, 358, 91, 358, 358, 358, 358, 99, 358, 358, 358, 358, 114, 358, 118, 358, 358, 358, 127, 358, 358, 358, 358, 358, 358, 358, 358, 358, 142, 358, 358, 358, 358, 358, 358, 358, 358, 358, 164, 358, 358, 358, 171, 358, 358, 358, 358, 358, 358, 185, 358, 358, 358, 358, 358, 358, 194, 358, 358, 358, 358, 358, 358, 358, 201, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 229, 230, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 242, 358, 358, 358, 358, 358, 250, 358, 358, 358, 358, 358, 358, 358, 264, 358, 358, 358, 358, 358, 358, 358, 358, 358, 282, 358, 358, 358, 358, 358, 292, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 325, 326, 358, 358, 358, 358, 358, 358, 358, 358, 339, 358, 358, 358, 358, 348, 352, 358, 353, 358, 358, 0, 358, 358, 358, 35, 358, 358, 358, 50, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 89, 358, 358, 358, 358, 358, 358, 358, 358, 358, 112, 113, 115, 358, 124, 358, 129, 131, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 169, 170, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 206, 358, 358, 358, 358, 358, 358, 358, 358, 224, 358, 358, 358, 358, 358, 234, 235, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 253, 358, 257, 358, 358, 358, 358, 263, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 287, 358, 358, 358, 358, 306, 358, 308, 358, 358, 358, 358, 358, 358, 358, 358, 318, 322, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 342, 358, 358, 358, 358, 358, 358, 92, 0, 358, 358, 358, 358, 358, 358, 358, 47, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 102, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 175, 358, 358, 358, 358, 358, 187, 358, 358, 191, 358, 358, 358, 196, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 222, 358, 358, 226, 358, 358, 358, 236, 237, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 276, 358, 358, 358, 358, 289, 358, 358, 358, 358, 358, 358, 358, 358, 358, 314, 358, 316, 358, 358, 358, 358, 358, 358, 358, 333, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 22, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 54, 358, 358, 65, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 97, 358, 358, 358, 358, 358, 358, 358, 119, 358, 358, 358, 358, 358, 358, 358, 139, 358, 358, 358, 141, 358, 358, 358, 358, 358, 358, 358, 358, 358, 161, 162, 358, 358, 358, 358, 358, 178, 358, 358, 186, 358, 189, 358, 195, 358, 358, 358, 199, 200, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 233, 238, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 254, 358, 358, 358, 358, 358, 265, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 313, 358, 317, 358, 358, 358, 358, 358, 358, 334, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 70, 358, 72, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 95, 358, 358, 103, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 135, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 154, 358, 358, 358, 358, 358, 160, 163, 358, 174, 358, 358, 358, 358, 358, 358, 345, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 225, 358, 358, 358, 239, 358, 240, 358, 358, 358, 358, 358, 358, 358, 258, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 283, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 307, 358, 358, 311, 358, 358, 324, 358, 358, 358, 358, 358, 358, 358, 335, 358, 358, 358, 358, 344, 347, 358, 350, 358, 94, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 66, 358, 358, 358, 358, 77, 358, 358, 358, 358, 358, 358, 358, 87, 358, 90, 358, 358, 100, 358, 358, 108, 358, 358, 117, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 153, 358, 358, 358, 158, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 198, 358, 358, 358, 358, 358, 358, 358, 358, 212, 358, 358, 215, 358, 358, 358, 358, 358, 221, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 252, 358, 260, 358, 262, 358, 358, 358, 358, 358, 358, 358, 358, 358, 284, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 328, 358, 358, 358, 358, 358, 358, 358, 358, 349, 358, 358, 32, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 61, 358, 358, 358, 358, 358, 358, 358, 358, 83, 358, 358, 358, 88, 358, 358, 104, 358, 358, 358, 358, 358, 358, 132, 358, 358, 358, 358, 138, 358, 358, 358, 358, 358, 358, 358, 358, 358, 155, 358, 358, 358, 358, 358, 358, 179, 358, 358, 358, 358, 358, 346, 197, 358, 43, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 218, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 272, 358, 358, 358, 277, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 310, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 338, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 75, 358, 358, 358, 358, 84, 85, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 149, 358, 358, 358, 159, 358, 358, 358, 358, 358, 358, 358, 192, 358, 358, 358, 205, 207, 358, 358, 358, 358, 358, 358, 358, 219, 358, 358, 358, 358, 231, 232, 241, 243, 358, 358, 358, 249, 358, 358, 261, 358, 358, 358, 271, 273, 274, 358, 358, 358, 358, 294, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 312, 315, 358, 327, 358, 358, 358, 358, 358, 358, 358, 358, 351, 31, 358, 358, 358, 358, 358, 358, 48, 358, 358, 59, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 105, 109, 358, 116, 358, 358, 358, 358, 358, 358, 140, 358, 358, 358, 143, 358, 358, 358, 358, 358, 358, 358, 176, 358, 358, 182, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 247, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 319, 336, 358, 358, 358, 332, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 60, 358, 358, 73, 358, 358, 81, 82, 86, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 156, 157, 168, 358, 358, 183, 358, 358, 358, 358, 358, 358, 210, 358, 358, 358, 358, 358, 358, 223, 358, 228, 358, 248, 251, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 309, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 52, 358, 69, 71, 358, 358, 358, 358, 358, 358, 125, 358, 358, 136, 358, 358, 358, 358, 358, 358, 358, 150, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 220, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 296, 293, 358, 358, 358, 358, 358, 358, 358, 358, 358, 330, 358, 337, 358, 358, 358, 358, 358, 358, 358, 358, 358, 76, 358, 358, 358, 110, 120, 44, 133, 358, 358, 358, 358, 358, 145, 147, 151, 177, 358, 358, 188, 358, 358, 204, 208, 358, 213, 358, 358, 217, 358, 358, 259, 358, 358, 358, 269, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 329, 358, 341, 343, 358, 358, 358, 358, 358, 358, 358, 358, 358, 93, 358, 134, 137, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 203, 358, 214, 358, 227, 358, 358, 358, 358, 358, 358, 358, 358, 291, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 42, 358, 80, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 297, 358, 358, 358, 301, 358, 358, 358, 331, 358, 358, 358, 358, 358, 358, 57, 96, 165, 166, 167, 358, 358, 358, 358, 358, 358, 358, 211, 358, 358, 358, 358, 358, 358, 358, 285, 286, 358, 298, 299, 300, 302, 303, 304, 358, 358, 358, 358, 358, 40, 58, 358, 358, 358, 358, 358, 358, 202, 216, 358, 358, 267, 358, 270, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 358, 181, 358, 244, 358, 358, 358, 295, 358, 38, 358, 39, 358, 358, 358, 358, 358, 184, 266, 358, 275, 33, 358, 358, 144, 358, 358, 358, 358, 358, 36, 358, 148, 358, 358, 358, 358, 358, 268, 37, 146, 152, 0 } ; static yyconst flex_int32_t yy_ec[256] = { 0, 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, 1, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 4, 5, 6, 1, 1, 7, 1, 1, 1, 8, 9, 1, 9, 10, 11, 12, 13, 14, 15, 16, 16, 16, 16, 16, 16, 17, 18, 19, 20, 21, 1, 1, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 1, 48, 1, 49, 50, 1, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 1, 77, 1, 78, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 } ; static yyconst flex_int32_t yy_meta[79] = { 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1 } ; static yyconst flex_int16_t yy_base[2344] = { 0, 0, 0, 2497, 2498, 2498, 2498, 2476, 2498, 73, 2488, 2445, 70, 79, 79, 86, 103, 110, 130, 2498, 2498, 87, 2473, 88, 97, 102, 113, 121, 130, 144, 162, 118, 91, 2441, 0, 131, 168, 176, 150, 167, 2420, 183, 198, 216, 176, 2439, 80, 76, 2412, 2468, 2498, 2498, 2423, 2498, 2498, 2476, 264, 0, 2498, 2498, 2498, 273, 282, 2498, 291, 2498, 2498, 2498, 2498, 2498, 2498, 2498, 2498, 2420, 2425, 2418, 79, 2420, 2415, 2421, 59, 106, 2409, 201, 139, 2419, 2426, 247, 258, 2408, 2416, 2404, 265, 25, 2417, 175, 2414, 2414, 2401, 166, 2401, 2417, 2401, 2414, 125, 186, 2400, 261, 2409, 90, 2422, 181, 250, 2397, 2392, 2395, 2391, 2407, 2403, 2390, 0, 282, 2390, 2399, 2400, 186, 261, 189, 180, 2422, 219, 213, 270, 2389, 2387, 2381, 266, 309, 2385, 323, 2392, 286, 2391, 0, 2380, 2375, 2384, 2391, 2377, 297, 2369, 2367, 306, 300, 2379, 2382, 2371, 303, 2367, 2366, 290, 317, 310, 190, 2364, 2377, 2368, 310, 2379, 2363, 2374, 320, 2368, 2364, 2366, 2354, 2364, 2351, 2382, 2498, 2498, 2367, 0, 375, 380, 388, 395, 400, 2350, 2354, 2348, 2350, 393, 0, 2360, 2350, 2349, 2348, 2343, 2351, 2358, 2344, 2356, 2355, 2343, 2349, 2341, 2338, 2345, 2335, 2336, 2329, 323, 2346, 2326, 2326, 2326, 2330, 2337, 2326, 340, 2335, 2319, 2318, 2332, 2327, 2342, 353, 2351, 2318, 2327, 2326, 392, 2321, 2314, 2316, 0, 2308, 366, 2337, 2318, 2309, 2319, 2302, 2308, 2302, 2302, 2306, 2314, 2341, 2310, 2301, 2308, 2336, 2322, 2308, 2301, 2287, 2294, 2302, 2301, 2289, 2282, 2290, 2296, 2280, 2294, 0, 2280, 114, 2294, 2276, 2305, 2274, 385, 2288, 2291, 2273, 2290, 2271, 395, 2280, 2269, 2265, 2276, 2264, 2278, 394, 2277, 2307, 2275, 2274, 2269, 2275, 2261, 2254, 2262, 358, 2264, 372, 2267, 2266, 2258, 2251, 2263, 2260, 2248, 2245, 2244, 2249, 2248, 2257, 2256, 2250, 2257, 2256, 373, 2235, 2241, 2249, 2248, 2248, 415, 2237, 2242, 2235, 2243, 2232, 373, 2226, 2236, 2224, 309, 416, 414, 2227, 2229, 2221, 2232, 2232, 2218, 2217, 2231, 2230, 2233, 2230, 2227, 2226, 2229, 2224, 2214, 2206, 2214, 2217, 2204, 2209, 2214, 2209, 434, 445, 457, 464, 469, 0, 0, 0, 2200, 2204, 2239, 2201, 2202, 0, 2195, 2250, 2204, 2193, 0, 2208, 2199, 2205, 2217, 0, 0, 2200, 2200, 2187, 2203, 2183, 0, 2188, 2181, 2195, 2180, 2193, 2192, 0, 2183, 2181, 2176, 2173, 2184, 2182, 2176, 2170, 2187, 2181, 2211, 0, 0, 2171, 2204, 2168, 2176, 2161, 2162, 2158, 0, 0, 2173, 2172, 0, 2158, 0, 2170, 282, 2165, 2152, 2172, 2151, 2183, 2151, 2167, 2149, 2154, 2160, 2163, 462, 2147, 2147, 2156, 2155, 2139, 2142, 2136, 2132, 2171, 2147, 2152, 2169, 2149, 2124, 2158, 2132, 440, 2185, 2130, 2127, 2141, 2142, 450, 2127, 2120, 2118, 2155, 2129, 2125, 2122, 2126, 438, 2133, 2128, 2114, 2116, 2111, 2106, 2108, 2122, 2102, 2105, 2119, 2108, 2113, 2107, 2119, 2110, 2111, 2114, 2115, 2114, 2096, 2104, 2094, 0, 455, 2091, 2090, 0, 0, 2094, 2084, 2094, 2093, 2093, 2086, 2099, 454, 2099, 410, 2086, 2082, 2087, 2089, 0, 0, 0, 2081, 2076, 2091, 2089, 0, 2079, 0, 2076, 2086, 444, 2076, 2068, 2083, 2071, 2061, 2108, 2069, 2078, 2077, 0, 2076, 2097, 2078, 485, 2060, 2065, 2071, 0, 2069, 2054, 2055, 2065, 2066, 2065, 2097, 2063, 2064, 2065, 2044, 508, 517, 522, 0, 2046, 2079, 2046, 2057, 2055, 0, 2054, 2081, 2049, 0, 2053, 2050, 2049, 2044, 0, 0, 448, 2047, 2046, 2032, 2062, 2034, 0, 2031, 2041, 2032, 2039, 0, 2029, 2023, 2032, 2028, 2058, 435, 468, 2032, 2019, 0, 2011, 0, 2034, 2016, 2021, 0, 2014, 2011, 2018, 2024, 2023, 2043, 2017, 2025, 2013, 0, 2022, 2017, 395, 2009, 2008, 2014, 2002, 2012, 1998, 0, 2001, 1996, 1999, 0, 1996, 2007, 2024, 1994, 1990, 1987, 0, 1997, 1990, 1995, 2002, 1990, 1983, 0, 1999, 2025, 2013, 1983, 1978, 1994, 1985, 0, 1980, 1987, 1976, 1987, 1974, 1981, 1971, 1968, 1979, 1960, 1976, 2007, 1966, 1972, 1996, 1966, 1959, 0, 0, 1963, 1973, 1970, 1968, 1958, 1957, 1961, 1949, 1966, 1947, 0, 1952, 1956, 1948, 1945, 1941, 485, 1952, 1946, 1958, 1953, 1941, 1935, 1941, 0, 1949, 1938, 1932, 1946, 1935, 1936, 59, 205, 238, 0, 254, 363, 495, 393, 444, 480, 434, 446, 461, 482, 478, 486, 493, 479, 475, 479, 478, 486, 480, 496, 0, 0, 481, 490, 499, 504, 486, 506, 507, 525, 0, 501, 506, 538, 528, 536, 0, 499, 0, 498, 506, 516, 504, 508, 509, 549, 508, 509, 507, 0, 528, 511, 545, 529, 519, 533, 544, 561, 528, 520, 521, 527, 569, 560, 568, 547, 540, 535, 531, 552, 549, 581, 542, 557, 0, 0, 570, 543, 0, 563, 0, 0, 565, 549, 554, 568, 555, 587, 563, 553, 562, 567, 568, 602, 574, 562, 576, 581, 574, 575, 0, 0, 570, 581, 581, 566, 588, 582, 591, 575, 582, 593, 577, 583, 596, 599, 618, 583, 594, 590, 579, 604, 589, 586, 618, 0, 637, 599, 597, 640, 635, 607, 598, 601, 0, 611, 616, 636, 618, 624, 0, 0, 621, 608, 616, 623, 661, 625, 645, 632, 632, 623, 638, 625, 623, 0, 622, 654, 624, 668, 634, 627, 0, 629, 637, 676, 633, 662, 640, 637, 653, 651, 648, 644, 652, 659, 0, 655, 648, 649, 663, 0, 656, 0, 689, 664, 659, 666, 665, 657, 653, 656, 701, 0, 654, 663, 677, 672, 665, 657, 677, 671, 670, 680, 672, 713, 687, 674, 676, 690, 685, 684, 0, 689, 690, 674, 678, 674, 679, 691, 692, 0, 688, 684, 684, 699, 698, 688, 700, 692, 702, 697, 698, 699, 740, 697, 702, 697, 701, 699, 701, 721, 718, 740, 716, 706, 712, 714, 724, 727, 0, 716, 720, 721, 713, 710, 732, 718, 719, 752, 737, 724, 731, 774, 775, 734, 744, 745, 736, 748, 736, 734, 751, 756, 751, 745, 756, 741, 759, 745, 0, 774, 756, 754, 745, 754, 0, 764, 765, 0, 758, 767, 754, 0, 769, 762, 766, 773, 774, 789, 772, 777, 782, 759, 772, 785, 772, 773, 784, 775, 786, 776, 773, 779, 0, 791, 782, 0, 791, 784, 787, 0, 0, 786, 787, 800, 789, 780, 801, 789, 805, 795, 796, 796, 787, 808, 805, 806, 811, 808, 810, 798, 805, 814, 817, 833, 803, 824, 836, 814, 822, 829, 828, 0, 825, 856, 810, 821, 833, 819, 818, 824, 836, 0, 839, 0, 818, 829, 841, 844, 841, 845, 835, 0, 836, 832, 851, 842, 851, 842, 839, 840, 856, 848, 841, 848, 2498, 861, 856, 857, 851, 850, 856, 894, 856, 869, 853, 0, 900, 870, 0, 862, 876, 860, 867, 866, 877, 873, 878, 870, 871, 871, 874, 870, 871, 872, 887, 882, 886, 882, 923, 0, 913, 893, 925, 879, 881, 901, 888, 0, 890, 897, 898, 888, 891, 885, 893, 922, 932, 929, 924, 0, 938, 903, 904, 899, 900, 922, 907, 908, 923, 0, 0, 924, 939, 911, 907, 919, 0, 925, 930, 0, 946, 0, 960, 0, 933, 924, 920, 0, 0, 923, 933, 929, 930, 931, 956, 957, 929, 944, 932, 932, 933, 934, 953, 936, 951, 943, 950, 955, 986, 942, 0, 0, 949, 944, 951, 947, 976, 967, 964, 950, 952, 951, 0, 968, 960, 964, 986, 963, 0, 959, 962, 976, 964, 978, 969, 980, 974, 967, 981, 977, 981, 991, 1018, 984, 989, 990, 995, 1017, 1020, 993, 984, 992, 988, 0, 983, 0, 991, 993, 986, 1014, 994, 1037, 0, 1005, 1006, 1003, 1045, 1006, 1016, 1003, 1019, 1020, 1014, 1015, 1010, 1017, 1012, 1015, 1025, 1030, 1012, 1019, 1018, 1062, 1025, 1021, 1041, 1029, 1024, 1031, 1041, 1026, 0, 1027, 1031, 1070, 1032, 1049, 1032, 1052, 1046, 1047, 1049, 1039, 1054, 1045, 0, 1046, 1079, 0, 1048, 1059, 1060, 1075, 1062, 1055, 1048, 1056, 1067, 1072, 1091, 1066, 1060, 1091, 1092, 1105, 1062, 1081, 1104, 1070, 1106, 1066, 0, 1086, 1087, 1075, 1077, 1119, 0, 0, 1077, 0, 1074, 1087, 1080, 1113, 1077, 1089, 1119, 1082, 1095, 1116, 1090, 1098, 1087, 1103, 1093, 1089, 1101, 1105, 1093, 1100, 1106, 1095, 1101, 1114, 1098, 1101, 1101, 1107, 0, 1113, 1108, 1105, 0, 1116, 1150, 1107, 1119, 1109, 1111, 1122, 1112, 1117, 0, 1120, 1130, 1127, 1123, 1129, 1121, 1163, 1119, 1130, 1125, 1130, 1155, 1141, 0, 1142, 1134, 1177, 1132, 1146, 1133, 1146, 1136, 1141, 1147, 1148, 1149, 1145, 1151, 1152, 1153, 0, 1150, 1149, 1176, 1157, 1154, 0, 1159, 1168, 1166, 1167, 1167, 1152, 1166, 0, 1198, 1158, 1162, 1159, 0, 0, 1155, 0, 1175, 0, 1172, 1175, 1178, 1179, 1171, 1196, 1178, 1197, 1180, 1181, 1176, 1191, 1181, 1174, 0, 1176, 1193, 1177, 1195, 1194, 1186, 1181, 1182, 1187, 1199, 1191, 1205, 0, 1199, 0, 1194, 1204, 0, 1204, 1236, 1231, 1230, 1189, 0, 1228, 1211, 1203, 1209, 1205, 1215, 1205, 1198, 1222, 1235, 1236, 1247, 1212, 1225, 1245, 1218, 1241, 0, 1220, 1213, 1214, 0, 1223, 1245, 1217, 1265, 1225, 1231, 1232, 1237, 1231, 1230, 1232, 0, 1241, 1243, 1276, 1235, 1287, 1240, 1235, 1235, 0, 1235, 1235, 0, 1270, 1246, 1254, 1255, 1260, 0, 1261, 1241, 1255, 1279, 1251, 1253, 1263, 1256, 1261, 1252, 1252, 1272, 0, 1297, 0, 1262, 0, 1261, 1272, 1269, 1274, 1274, 1269, 1279, 1268, 1268, 0, 1291, 1282, 1278, 1276, 1281, 1281, 1282, 1303, 1279, 1280, 1281, 1307, 1283, 1284, 1285, 1315, 1287, 1297, 1288, 1303, 1290, 1294, 0, 1306, 1285, 1295, 1305, 1310, 1287, 1299, 1294, 0, 1301, 1301, 0, 1340, 1299, 1312, 1300, 1302, 1313, 1308, 1319, 1307, 1306, 1306, 0, 1322, 1309, 1321, 1311, 1329, 1343, 1333, 1326, 0, 1318, 1330, 1336, 0, 1349, 1334, 0, 1326, 1341, 1338, 1328, 1330, 1359, 0, 1333, 1329, 1342, 1345, 0, 1348, 1352, 1353, 1354, 1334, 1378, 1342, 1333, 1381, 0, 1351, 1352, 1350, 1354, 1359, 1364, 0, 1352, 1352, 1355, 1353, 1365, 0, 0, 1396, 0, 1371, 1355, 1399, 1354, 1367, 1400, 1360, 1367, 1362, 1360, 0, 1369, 1364, 1365, 1377, 1373, 1382, 1375, 1386, 1378, 1387, 1378, 1385, 1370, 1382, 1396, 1393, 1385, 1397, 1389, 1384, 0, 1399, 1379, 1393, 0, 1397, 1406, 1388, 1405, 1437, 1392, 1411, 1408, 1425, 1426, 1427, 1412, 1429, 1430, 1431, 1420, 0, 1416, 1409, 1410, 1411, 1405, 1411, 1415, 1422, 1410, 1428, 0, 1413, 1415, 1414, 1421, 1415, 1418, 1447, 1434, 1420, 1428, 1428, 1431, 1440, 1440, 1441, 1432, 1433, 1434, 0, 1430, 1442, 1438, 1438, 0, 0, 1442, 1430, 1450, 1451, 1455, 1452, 1455, 1452, 1461, 1450, 1458, 1460, 1463, 1462, 1475, 1476, 1477, 1455, 1454, 1451, 1493, 1457, 1461, 1457, 0, 1465, 1466, 1466, 1476, 1466, 1478, 1498, 0, 1476, 1471, 1473, 0, 0, 1468, 1475, 1469, 1490, 1491, 1478, 1474, 0, 1486, 1491, 1478, 1478, 0, 0, 0, 0, 1509, 1486, 1487, 0, 1482, 1500, 0, 1528, 1485, 1501, 0, 0, 0, 1485, 1488, 1493, 1505, 0, 1510, 1493, 1512, 1508, 1511, 1512, 1513, 1512, 1515, 1516, 1518, 1511, 0, 0, 1521, 0, 1521, 1507, 1527, 1524, 1529, 1511, 1512, 1532, 0, 0, 1522, 1526, 1521, 1521, 1529, 1534, 0, 1536, 1532, 0, 1523, 1525, 1526, 1531, 1531, 1534, 1528, 1535, 1545, 1532, 1543, 0, 0, 1548, 0, 1540, 1535, 1551, 1542, 1544, 1539, 0, 1584, 1585, 1586, 1589, 1549, 1556, 1565, 1552, 1554, 1544, 1565, 0, 1567, 1571, 1588, 1585, 1561, 1554, 1568, 1574, 1570, 1573, 1567, 1573, 1563, 1581, 1576, 1571, 1568, 1579, 1570, 1570, 0, 1584, 1573, 1573, 1570, 1616, 1587, 1588, 1609, 1594, 1592, 1581, 1584, 1584, 1599, 1593, 1597, 1600, 1601, 1602, 1601, 1604, 1605, 1606, 1609, 0, 0, 1606, 1598, 1635, 0, 1603, 1618, 1611, 1609, 1607, 1646, 1633, 1611, 1636, 1608, 1614, 0, 1616, 1605, 0, 1613, 1616, 0, 0, 0, 1613, 1631, 1621, 1616, 1629, 1618, 1621, 1636, 1623, 1653, 1654, 1655, 1624, 1625, 1633, 1645, 1628, 0, 0, 0, 1686, 1633, 0, 1647, 1641, 1645, 1641, 1692, 1642, 0, 1655, 1645, 1651, 1656, 1647, 1649, 0, 1649, 0, 1660, 0, 0, 1651, 1647, 1648, 1649, 1655, 1666, 1654, 1687, 1685, 1666, 1671, 1659, 1673, 1660, 1671, 1672, 1673, 1664, 1675, 1676, 1677, 0, 1665, 1677, 1668, 1672, 1677, 1678, 1703, 1680, 1686, 1681, 1690, 1678, 0, 1698, 0, 0, 1675, 1689, 1697, 1694, 1700, 1686, 0, 1680, 1694, 0, 1687, 1719, 1720, 1721, 1699, 1697, 1707, 0, 1699, 1741, 1727, 1714, 1694, 1701, 1701, 1747, 1709, 1704, 1705, 1711, 1708, 1714, 0, 1715, 1714, 1713, 1727, 1718, 1726, 1721, 1719, 1751, 1718, 1734, 1725, 1737, 0, 0, 1722, 1724, 1725, 1726, 1726, 1728, 1729, 1730, 1745, 0, 1731, 0, 1732, 1733, 1739, 1778, 1744, 1780, 1781, 1754, 1740, 0, 1756, 1749, 1758, 0, 0, 0, 1783, 1752, 1786, 1787, 1788, 1749, 1797, 1782, 1799, 0, 1759, 1754, 0, 1767, 1758, 0, 0, 1769, 0, 1765, 1761, 0, 1762, 1789, 0, 1769, 1793, 1809, 0, 1765, 1771, 1780, 1777, 1776, 1814, 1787, 1773, 1774, 1775, 1791, 1777, 1778, 1779, 0, 1780, 0, 0, 1789, 1787, 1788, 1799, 1796, 1797, 1791, 1803, 1785, 0, 1796, 0, 0, 1825, 1826, 1827, 1802, 1794, 1811, 1796, 1806, 1816, 1805, 0, 1806, 0, 1813, 0, 1822, 1820, 1816, 1812, 1822, 1808, 1824, 1829, 0, 1822, 1814, 1828, 1829, 1830, 1818, 1832, 1833, 1834, 1839, 1820, 1824, 1866, 1859, 1833, 1834, 0, 1828, 0, 1828, 1864, 1865, 1866, 1851, 1840, 1838, 1842, 1834, 1837, 1844, 1845, 1846, 1849, 1857, 1850, 1844, 1846, 1857, 1849, 1844, 1864, 0, 1852, 1853, 1854, 0, 1855, 1856, 1857, 0, 1856, 1864, 1869, 1878, 1875, 1876, 1918, 0, 0, 0, 0, 1863, 1863, 1884, 1865, 1882, 1879, 1870, 0, 1883, 1870, 1888, 1888, 1885, 1875, 1881, 0, 0, 1885, 0, 0, 0, 0, 0, 0, 1889, 1898, 1888, 1888, 1917, 0, 0, 1894, 1892, 1887, 1894, 1889, 1893, 0, 0, 1904, 1926, 0, 1891, 0, 1898, 1909, 1899, 1895, 1911, 1912, 1917, 1897, 1919, 1920, 1921, 0, 1909, 0, 1945, 1900, 1907, 0, 1913, 0, 1943, 0, 1916, 1925, 1911, 1912, 1913, 0, 0, 1949, 0, 0, 1934, 1931, 0, 1928, 1933, 1930, 1919, 1928, 0, 1920, 0, 1921, 1931, 1940, 1941, 1942, 0, 0, 0, 0, 2498, 1996 } ; static yyconst flex_int16_t yy_def[2344] = { 0, 2342, 1, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2343, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2343, 2343, 2343, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2342, 2342, 2342, 2343, 2343, 2342, 2342, 2342, 2342, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2342, 2342, 2343, 2342, 2342, 2342, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2342, 2342, 2342, 2342, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2342, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2342, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2342, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 2343, 0, 2342 } ; static yyconst flex_int16_t yy_nxt[2577] = { 0, 4, 5, 6, 7, 8, 9, 10, 11, 4, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 34, 34, 34, 4, 4, 34, 34, 34, 34, 47, 34, 34, 34, 34, 34, 34, 34, 34, 34, 34, 34, 34, 34, 34, 34, 34, 34, 34, 34, 34, 34, 34, 48, 49, 51, 55, 196, 56, 56, 56, 56, 56, 58, 224, 61, 59, 62, 62, 62, 62, 62, 61, 225, 62, 62, 62, 62, 62, 177, 63, 64, 68, 69, 71, 72, 197, 65, 64, 61, 871, 62, 62, 62, 62, 62, 61, 73, 62, 62, 62, 62, 62, 60, 66, 64, 191, 178, 52, 192, 64, 67, 64, 74, 174, 175, 61, 64, 62, 62, 62, 62, 62, 120, 176, 448, 75, 76, 247, 81, 248, 121, 64, 82, 64, 77, 122, 123, 90, 78, 84, 64, 79, 80, 85, 116, 83, 86, 91, 117, 198, 199, 92, 118, 87, 449, 93, 88, 125, 96, 89, 64, 94, 238, 110, 97, 126, 95, 98, 119, 99, 103, 127, 128, 100, 239, 227, 204, 101, 104, 102, 129, 105, 106, 205, 107, 228, 276, 108, 111, 139, 109, 140, 112, 141, 130, 232, 277, 142, 131, 113, 114, 143, 134, 135, 144, 115, 136, 145, 132, 148, 146, 233, 240, 149, 133, 170, 137, 171, 250, 251, 172, 274, 138, 150, 151, 270, 241, 201, 152, 338, 271, 202, 153, 339, 154, 155, 156, 275, 157, 158, 159, 203, 163, 160, 161, 872, 164, 279, 162, 165, 166, 56, 56, 56, 56, 56, 167, 281, 282, 168, 184, 184, 184, 184, 184, 183, 169, 61, 280, 62, 62, 62, 62, 62, 185, 186, 873, 208, 187, 187, 187, 187, 187, 64, 209, 210, 211, 874, 213, 252, 253, 212, 214, 219, 183, 254, 220, 262, 215, 283, 272, 243, 221, 185, 244, 273, 222, 245, 603, 223, 263, 264, 64, 288, 289, 304, 265, 284, 290, 291, 305, 294, 295, 312, 296, 292, 297, 266, 604, 313, 332, 298, 323, 333, 314, 299, 315, 300, 301, 324, 328, 316, 317, 320, 334, 321, 329, 343, 336, 348, 522, 322, 523, 302, 337, 344, 388, 389, 335, 358, 875, 349, 359, 359, 359, 359, 359, 184, 184, 184, 184, 184, 361, 454, 397, 362, 362, 362, 362, 362, 398, 360, 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, 367, 405, 411, 480, 417, 412, 406, 501, 455, 481, 368, 469, 369, 461, 462, 517, 470, 483, 360, 418, 484, 502, 508, 524, 526, 509, 510, 695, 518, 554, 554, 554, 554, 554, 696, 793, 527, 528, 529, 511, 359, 359, 359, 359, 359, 637, 879, 794, 655, 555, 638, 530, 556, 556, 556, 556, 556, 656, 525, 362, 362, 362, 362, 362, 362, 362, 362, 362, 362, 616, 644, 692, 645, 646, 680, 681, 682, 693, 708, 617, 723, 618, 756, 772, 619, 709, 880, 883, 773, 620, 710, 774, 855, 881, 884, 724, 856, 882, 725, 757, 876, 726, 727, 554, 554, 554, 554, 554, 728, 877, 885, 729, 556, 556, 556, 556, 556, 556, 556, 556, 556, 556, 886, 775, 857, 887, 888, 889, 890, 891, 892, 893, 894, 895, 896, 897, 898, 899, 901, 902, 903, 904, 905, 906, 907, 908, 878, 900, 909, 910, 912, 913, 914, 915, 911, 916, 917, 918, 919, 922, 923, 924, 925, 926, 927, 928, 929, 930, 931, 932, 934, 935, 920, 921, 936, 937, 938, 944, 946, 939, 940, 947, 948, 949, 933, 950, 951, 941, 952, 953, 954, 955, 942, 956, 957, 943, 958, 959, 945, 960, 961, 962, 963, 964, 965, 967, 968, 966, 969, 970, 971, 972, 975, 976, 977, 978, 979, 980, 981, 982, 983, 984, 985, 973, 986, 987, 974, 988, 989, 990, 991, 992, 993, 994, 995, 996, 997, 998, 999, 1000, 1001, 1002, 1003, 1004, 1005, 1006, 1007, 1008, 1014, 1015, 1009, 1016, 1017, 1018, 1019, 1020, 1021, 1010, 1022, 1023, 1011, 1024, 1012, 1013, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 1042, 1043, 1044, 1045, 1046, 1047, 1048, 1049, 1050, 1051, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1059, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 1081, 1082, 1083, 1084, 1085, 1086, 1087, 1088, 1089, 1090, 1091, 1092, 1093, 1094, 1096, 1097, 1098, 1099, 1100, 1095, 1101, 1102, 1103, 1104, 1105, 1106, 1107, 1108, 1109, 1110, 1111, 1112, 1113, 1114, 1115, 1116, 1117, 1118, 1119, 1120, 1121, 1122, 1123, 1124, 1125, 1127, 1128, 1129, 1130, 1126, 1131, 1133, 1134, 1137, 1132, 1135, 1136, 1138, 1139, 1140, 1142, 1143, 1144, 1145, 1146, 1147, 1148, 1141, 1149, 1150, 1151, 1152, 1153, 1154, 1155, 1156, 1157, 1158, 1159, 1160, 1162, 1163, 1164, 1165, 1166, 1167, 1168, 1161, 1169, 1170, 1171, 1172, 1173, 1174, 1175, 1176, 1177, 1178, 1179, 1180, 1181, 1182, 1183, 1184, 1185, 1186, 1188, 1189, 1190, 1191, 1192, 1193, 1194, 1195, 1187, 1196, 1197, 1198, 1199, 1200, 1201, 1202, 1203, 1204, 1205, 1206, 1207, 1208, 1209, 1210, 1211, 1212, 1213, 1214, 1215, 1216, 1217, 1219, 1220, 1221, 1218, 1222, 1223, 1224, 1225, 1226, 1227, 1231, 1232, 1233, 1234, 1235, 1236, 1228, 1237, 1238, 1239, 1240, 1229, 1241, 1242, 1243, 1230, 1244, 1245, 1246, 1247, 1248, 1249, 1250, 1251, 1252, 1253, 1254, 1255, 1256, 1257, 1258, 1259, 1260, 1261, 1262, 1263, 1264, 1265, 1266, 1267, 1268, 1271, 1272, 1273, 1274, 1275, 1276, 1277, 1278, 1279, 1280, 1281, 1282, 1283, 1284, 1285, 1269, 1286, 1287, 1270, 1288, 1289, 1290, 1291, 1292, 1293, 1294, 1295, 1296, 1297, 1298, 1299, 1300, 1301, 1302, 1303, 1304, 1305, 1306, 1307, 1308, 1309, 1310, 1315, 1316, 1311, 1317, 1318, 1312, 1319, 1313, 1320, 1321, 1314, 1322, 1323, 1324, 1325, 1326, 1327, 1328, 1329, 1330, 1331, 1332, 1333, 1334, 1335, 1336, 1337, 1338, 1339, 1340, 1341, 1342, 1343, 1345, 1346, 1347, 1348, 1349, 1350, 1351, 1352, 1344, 1353, 1354, 1355, 1357, 1358, 1359, 1360, 1361, 1362, 1363, 1364, 1365, 1366, 1367, 1356, 1368, 1369, 1370, 1371, 1372, 1373, 1374, 1375, 1376, 1377, 1378, 1379, 1380, 1381, 1382, 1383, 1384, 1385, 1386, 1387, 1388, 1389, 1390, 1391, 1399, 1400, 1395, 1401, 1402, 1403, 1404, 1405, 1406, 1407, 1408, 1409, 1413, 1414, 1392, 1393, 1394, 1396, 1397, 1398, 1415, 1416, 1417, 1418, 1410, 1419, 1420, 1421, 1411, 1422, 1412, 1423, 1424, 1425, 1426, 1427, 1428, 1429, 1430, 1431, 1432, 1433, 1434, 1435, 1436, 1437, 1438, 1439, 1440, 1441, 1442, 1443, 1444, 1445, 1446, 1447, 1448, 1449, 1450, 1451, 1452, 1453, 1454, 1455, 1456, 1457, 1459, 1460, 1461, 1462, 1458, 1463, 1464, 1465, 1466, 1467, 1468, 1470, 1471, 1472, 1473, 1474, 1475, 1469, 1476, 1477, 1478, 1479, 1480, 1481, 1482, 1483, 1484, 1485, 1486, 1487, 1488, 1489, 1490, 1492, 1493, 1494, 1495, 1496, 1497, 1498, 1491, 1499, 1500, 1501, 1502, 1503, 1504, 1505, 1506, 1507, 1508, 1509, 1510, 1511, 1512, 1513, 1514, 1515, 1516, 1517, 1518, 1519, 1520, 1521, 1522, 1523, 1524, 1525, 1526, 1527, 1528, 1529, 1530, 1531, 1532, 1533, 1534, 1535, 1536, 1537, 1538, 1539, 1540, 1541, 1542, 1543, 1544, 1545, 1546, 1547, 1548, 1549, 1550, 1551, 1552, 1553, 1554, 1555, 1556, 1557, 1558, 1559, 1560, 1561, 1562, 1563, 1564, 1565, 1566, 1567, 1568, 1569, 1570, 1571, 1572, 1573, 1574, 1575, 1576, 1577, 1578, 1579, 1580, 1581, 1582, 1583, 1584, 1585, 1586, 1587, 1588, 1589, 1590, 1591, 1592, 1593, 1594, 1595, 1596, 1597, 1598, 1599, 1600, 1601, 1602, 1603, 1604, 1605, 1606, 1607, 1608, 1609, 1610, 1611, 1612, 1613, 1614, 1615, 1616, 1617, 1618, 1619, 1620, 1621, 1622, 1623, 1624, 1625, 1626, 1627, 1628, 1629, 1630, 1631, 1632, 1633, 1634, 1636, 1637, 1638, 1639, 1640, 1635, 1641, 1642, 1643, 1644, 1645, 1646, 1647, 1648, 1649, 1650, 1651, 1652, 1653, 1654, 1655, 1656, 1657, 1658, 1659, 1660, 1661, 1662, 1663, 1664, 1665, 1666, 1667, 1668, 1669, 1670, 1671, 1672, 1673, 1674, 1675, 1676, 1677, 1678, 1679, 1680, 1681, 1682, 1683, 1684, 1685, 1686, 1687, 1688, 1689, 1690, 1691, 1692, 1693, 1694, 1695, 1696, 1697, 1698, 1699, 1700, 1701, 1702, 1703, 1704, 1705, 1706, 1707, 1708, 1709, 1710, 1711, 1712, 1713, 1714, 1715, 1716, 1717, 1718, 1719, 1720, 1721, 1722, 1723, 1724, 1725, 1726, 1727, 1728, 1729, 1730, 1731, 1732, 1733, 1734, 1735, 1736, 1737, 1738, 1739, 1740, 1741, 1742, 1743, 1744, 1745, 1746, 1747, 1748, 1749, 1750, 1751, 1752, 1753, 1754, 1755, 1756, 1757, 1758, 1759, 1760, 1761, 1762, 1763, 1764, 1765, 1767, 1768, 1769, 1770, 1771, 1772, 1773, 1774, 1775, 1776, 1777, 1766, 1778, 1779, 1780, 1781, 1782, 1783, 1784, 1785, 1786, 1787, 1788, 1789, 1790, 1791, 1792, 1793, 1794, 1795, 1796, 1797, 1798, 1799, 1800, 1801, 1802, 1803, 1804, 1805, 1806, 1807, 1808, 1809, 1810, 1811, 1812, 1813, 1814, 1815, 1816, 1817, 1818, 1819, 1820, 1821, 1822, 1823, 1824, 1825, 1826, 1827, 1828, 1829, 1830, 1831, 1832, 1833, 1834, 1835, 1836, 1837, 1838, 1839, 1840, 1841, 1842, 1843, 1844, 1845, 1846, 1847, 1848, 1849, 1850, 1851, 1852, 1853, 1854, 1855, 1856, 1857, 1858, 1859, 1860, 1861, 1862, 1863, 1864, 1865, 1866, 1867, 1868, 1869, 1870, 1871, 1872, 1873, 1874, 1875, 1876, 1877, 1878, 1879, 1880, 1881, 1882, 1883, 1884, 1885, 1886, 1887, 1888, 1889, 1890, 1891, 1892, 1893, 1894, 1895, 1896, 1897, 1898, 1901, 1902, 1903, 1904, 1905, 1906, 1907, 1899, 1908, 1909, 1910, 1911, 1912, 1913, 1914, 1915, 1916, 1900, 1917, 1918, 1919, 1920, 1921, 1922, 1923, 1924, 1925, 1926, 1927, 1928, 1929, 1930, 1931, 1932, 1933, 1934, 1935, 1936, 1937, 1938, 1939, 1940, 1941, 1942, 1943, 1944, 1945, 1946, 1947, 1948, 1949, 1950, 1951, 1952, 1953, 1954, 1955, 1956, 1957, 1958, 1959, 1960, 1961, 1962, 1963, 1964, 1965, 1966, 1967, 1968, 1969, 1970, 1971, 1972, 1973, 1974, 1975, 1976, 1977, 1978, 1979, 1980, 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2022, 2023, 2024, 2025, 2026, 2027, 2028, 2029, 2030, 2031, 2032, 2033, 2034, 2035, 2036, 2037, 2038, 2039, 2040, 2041, 2042, 2043, 2044, 2045, 2046, 2047, 2048, 2049, 2050, 2051, 2052, 2053, 2054, 2055, 2056, 2057, 2058, 2059, 2060, 2061, 2062, 2063, 2064, 2065, 2066, 2067, 2068, 2069, 2070, 2071, 2072, 2073, 2074, 2075, 2076, 2077, 2078, 2079, 2080, 2081, 2082, 2083, 2084, 2085, 2086, 2087, 2088, 2089, 2090, 2091, 2092, 2093, 2094, 2095, 2096, 2097, 2098, 2099, 2100, 2101, 2102, 2103, 2104, 2105, 2106, 2107, 2108, 2109, 2110, 2111, 2112, 2113, 2114, 2115, 2116, 2117, 2118, 2119, 2120, 2121, 2122, 2123, 2124, 2125, 2126, 2127, 2128, 2129, 2130, 2131, 2132, 2133, 2134, 2135, 2136, 2137, 2138, 2139, 2140, 2141, 2142, 2143, 2144, 2145, 2146, 2147, 2148, 2149, 2151, 2152, 2153, 2154, 2155, 2156, 2157, 2158, 2159, 2160, 2161, 2162, 2163, 2150, 2164, 2165, 2166, 2167, 2168, 2169, 2170, 2171, 2172, 2173, 2174, 2175, 2176, 2177, 2178, 2179, 2180, 2181, 2182, 2183, 2184, 2185, 2186, 2187, 2188, 2189, 2190, 2191, 2192, 2193, 2194, 2195, 2196, 2197, 2198, 2199, 2200, 2201, 2202, 2203, 2204, 2205, 2206, 2207, 2208, 2209, 2210, 2211, 2212, 2213, 2214, 2215, 2216, 2217, 2218, 2219, 2220, 2221, 2222, 2223, 2224, 2225, 2226, 2227, 2228, 2229, 2230, 2231, 2232, 2233, 2234, 2235, 2236, 2237, 2238, 2239, 2240, 2241, 2242, 2243, 2244, 2245, 2246, 2247, 2248, 2249, 2250, 2251, 2252, 2253, 2254, 2255, 2256, 2257, 2258, 2259, 2260, 2261, 2262, 2263, 2264, 2265, 2266, 2267, 2268, 2269, 2270, 2271, 2272, 2273, 2274, 2275, 2276, 2277, 2278, 2279, 2280, 2281, 2282, 2283, 2284, 2285, 2286, 2287, 2288, 2289, 2290, 2291, 2292, 2293, 2294, 2295, 2296, 2297, 2298, 2299, 2300, 2301, 2302, 2303, 2304, 2305, 2306, 2307, 2308, 2309, 2310, 2311, 2312, 2313, 2314, 2315, 2316, 2317, 2318, 2319, 2320, 2321, 2322, 2323, 2324, 2325, 2326, 2327, 2328, 2329, 2330, 2331, 2332, 2333, 2334, 2335, 2336, 2337, 2338, 2339, 2340, 2341, 57, 870, 869, 868, 867, 866, 865, 864, 863, 862, 861, 860, 859, 858, 854, 853, 852, 851, 850, 849, 848, 847, 846, 845, 844, 843, 842, 841, 840, 839, 838, 837, 836, 835, 834, 833, 832, 831, 830, 829, 828, 827, 826, 825, 824, 823, 822, 821, 820, 819, 818, 817, 816, 815, 814, 813, 812, 811, 810, 809, 808, 807, 806, 805, 804, 803, 802, 801, 800, 799, 798, 797, 796, 795, 792, 791, 790, 789, 788, 787, 786, 785, 784, 783, 782, 781, 780, 779, 778, 777, 776, 771, 770, 769, 768, 767, 766, 765, 764, 763, 762, 761, 760, 759, 758, 755, 754, 753, 752, 751, 750, 749, 748, 747, 746, 745, 744, 743, 742, 741, 740, 739, 738, 737, 736, 735, 734, 733, 732, 731, 730, 722, 721, 720, 719, 718, 717, 716, 715, 714, 713, 712, 711, 707, 706, 705, 704, 703, 702, 701, 700, 699, 698, 697, 694, 691, 690, 689, 688, 687, 686, 685, 684, 683, 679, 678, 677, 676, 675, 674, 673, 672, 671, 670, 669, 668, 667, 666, 665, 664, 663, 662, 661, 660, 659, 658, 657, 654, 653, 652, 651, 650, 649, 648, 647, 643, 642, 641, 640, 639, 636, 635, 634, 633, 632, 631, 630, 629, 628, 627, 626, 625, 624, 623, 622, 621, 615, 614, 613, 612, 611, 610, 609, 608, 607, 606, 605, 602, 601, 600, 599, 598, 597, 596, 595, 594, 593, 592, 591, 590, 589, 588, 587, 586, 585, 584, 583, 582, 581, 580, 579, 578, 577, 576, 575, 574, 573, 572, 571, 570, 569, 568, 567, 566, 565, 564, 563, 562, 561, 560, 559, 558, 557, 553, 552, 551, 550, 549, 548, 547, 546, 545, 544, 543, 542, 541, 540, 539, 538, 537, 536, 535, 534, 533, 532, 531, 521, 520, 519, 516, 515, 514, 513, 512, 507, 506, 505, 504, 503, 500, 499, 498, 497, 496, 495, 494, 493, 492, 491, 490, 489, 488, 487, 486, 485, 482, 479, 478, 477, 476, 475, 474, 473, 472, 471, 468, 467, 466, 465, 464, 463, 460, 459, 458, 457, 456, 453, 452, 451, 450, 447, 446, 445, 444, 443, 442, 441, 440, 439, 438, 437, 436, 435, 434, 433, 432, 431, 430, 429, 428, 427, 426, 425, 424, 423, 422, 421, 420, 419, 416, 415, 414, 413, 410, 409, 408, 407, 404, 403, 402, 401, 400, 399, 396, 395, 394, 393, 392, 391, 390, 387, 386, 385, 384, 383, 382, 381, 380, 379, 378, 377, 376, 375, 374, 373, 372, 371, 370, 366, 365, 364, 363, 357, 356, 355, 354, 353, 352, 351, 350, 347, 346, 345, 342, 341, 340, 331, 330, 327, 326, 325, 319, 318, 311, 310, 309, 308, 307, 306, 303, 293, 287, 286, 285, 278, 269, 268, 267, 261, 260, 259, 258, 257, 256, 255, 249, 246, 242, 237, 236, 235, 234, 231, 230, 229, 226, 218, 217, 216, 207, 206, 200, 195, 194, 193, 190, 189, 188, 182, 181, 180, 179, 173, 147, 124, 70, 54, 53, 50, 2342, 3, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342 } ; static yyconst flex_int16_t yy_chk[2577] = { 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 9, 12, 80, 12, 12, 12, 12, 12, 13, 93, 14, 13, 14, 14, 14, 14, 14, 15, 93, 15, 15, 15, 15, 15, 47, 14, 14, 21, 21, 23, 23, 80, 15, 15, 16, 698, 16, 16, 16, 16, 16, 17, 24, 17, 17, 17, 17, 17, 13, 16, 16, 76, 47, 9, 76, 14, 17, 17, 24, 46, 46, 18, 15, 18, 18, 18, 18, 18, 32, 46, 269, 24, 24, 109, 25, 109, 32, 18, 25, 16, 24, 32, 32, 27, 24, 26, 17, 24, 24, 26, 31, 25, 26, 27, 31, 81, 81, 27, 31, 26, 269, 27, 26, 35, 28, 26, 18, 27, 104, 30, 28, 35, 27, 28, 31, 28, 29, 35, 36, 28, 104, 95, 84, 28, 29, 28, 36, 29, 29, 84, 29, 95, 128, 29, 30, 38, 29, 38, 30, 38, 36, 99, 128, 38, 36, 30, 30, 39, 37, 37, 39, 30, 37, 39, 36, 41, 39, 99, 105, 41, 36, 44, 37, 44, 111, 111, 44, 127, 37, 41, 42, 125, 105, 83, 42, 163, 125, 83, 42, 163, 42, 42, 42, 127, 42, 42, 42, 83, 43, 42, 42, 699, 43, 130, 42, 43, 43, 56, 56, 56, 56, 56, 43, 131, 131, 43, 61, 61, 61, 61, 61, 56, 43, 62, 130, 62, 62, 62, 62, 62, 61, 64, 700, 87, 64, 64, 64, 64, 64, 62, 87, 87, 87, 702, 88, 112, 112, 87, 88, 92, 56, 112, 92, 121, 88, 132, 126, 107, 92, 61, 107, 126, 92, 107, 424, 92, 121, 121, 62, 136, 136, 141, 121, 132, 137, 137, 141, 139, 139, 149, 139, 137, 139, 121, 424, 149, 160, 139, 153, 160, 149, 139, 149, 139, 139, 153, 157, 149, 149, 152, 161, 152, 157, 167, 162, 171, 332, 152, 332, 139, 162, 167, 212, 212, 161, 183, 703, 171, 183, 183, 183, 183, 183, 184, 184, 184, 184, 184, 185, 274, 220, 185, 185, 185, 185, 185, 220, 184, 186, 186, 186, 186, 186, 187, 187, 187, 187, 187, 192, 227, 232, 297, 238, 232, 227, 316, 274, 297, 192, 287, 192, 280, 280, 328, 287, 299, 184, 238, 299, 316, 322, 333, 334, 322, 322, 507, 328, 358, 358, 358, 358, 358, 507, 614, 334, 334, 334, 322, 359, 359, 359, 359, 359, 453, 705, 614, 468, 360, 453, 334, 360, 360, 360, 360, 360, 468, 333, 361, 361, 361, 361, 361, 362, 362, 362, 362, 362, 436, 459, 505, 459, 459, 493, 493, 493, 505, 524, 436, 538, 436, 574, 591, 436, 524, 706, 708, 591, 436, 524, 592, 683, 707, 709, 538, 683, 707, 538, 574, 704, 538, 538, 554, 554, 554, 554, 554, 538, 704, 710, 538, 555, 555, 555, 555, 555, 556, 556, 556, 556, 556, 711, 592, 683, 712, 713, 714, 715, 716, 717, 718, 719, 720, 721, 724, 725, 726, 727, 728, 729, 730, 731, 733, 734, 735, 704, 726, 736, 737, 739, 741, 742, 743, 737, 744, 745, 746, 747, 748, 749, 750, 752, 753, 754, 755, 756, 757, 758, 759, 760, 761, 747, 747, 762, 763, 764, 765, 766, 764, 764, 767, 768, 769, 759, 770, 771, 764, 772, 773, 774, 775, 764, 778, 778, 764, 779, 781, 765, 784, 785, 786, 787, 788, 789, 790, 791, 789, 792, 793, 794, 795, 796, 797, 798, 799, 800, 801, 804, 805, 806, 807, 808, 795, 809, 810, 795, 811, 812, 813, 814, 815, 816, 817, 818, 819, 820, 821, 822, 823, 824, 825, 826, 828, 829, 830, 831, 831, 832, 833, 831, 834, 835, 837, 838, 839, 840, 831, 841, 844, 831, 845, 831, 831, 846, 847, 848, 849, 850, 851, 852, 853, 854, 855, 856, 858, 859, 860, 861, 862, 863, 865, 866, 867, 868, 869, 870, 871, 872, 873, 874, 875, 876, 877, 879, 880, 881, 882, 884, 886, 887, 888, 889, 890, 891, 882, 892, 893, 894, 896, 897, 898, 899, 900, 901, 902, 903, 904, 905, 906, 907, 908, 909, 910, 911, 912, 913, 915, 916, 917, 918, 919, 920, 921, 922, 924, 925, 926, 927, 921, 928, 929, 930, 931, 932, 933, 934, 935, 936, 937, 938, 939, 940, 941, 942, 943, 944, 945, 946, 947, 948, 949, 950, 951, 953, 954, 955, 956, 957, 953, 958, 959, 960, 962, 958, 961, 961, 963, 964, 965, 966, 967, 968, 969, 970, 971, 972, 965, 973, 974, 975, 976, 977, 978, 979, 980, 981, 983, 984, 985, 986, 987, 989, 990, 992, 993, 994, 985, 996, 997, 998, 999, 1000, 1001, 1002, 1003, 1004, 1005, 1006, 1007, 1008, 1009, 1010, 1011, 1012, 1013, 1014, 1015, 1017, 1018, 1020, 1021, 1022, 1025, 1013, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 1042, 1043, 1044, 1045, 1046, 1047, 1048, 1049, 1050, 1047, 1051, 1052, 1053, 1054, 1056, 1057, 1058, 1059, 1060, 1061, 1062, 1063, 1057, 1064, 1066, 1068, 1069, 1057, 1070, 1071, 1072, 1057, 1073, 1074, 1076, 1077, 1078, 1079, 1080, 1081, 1082, 1083, 1084, 1085, 1086, 1087, 1089, 1090, 1091, 1092, 1093, 1094, 1095, 1096, 1097, 1098, 1100, 1101, 1103, 1104, 1105, 1106, 1107, 1108, 1109, 1110, 1111, 1112, 1113, 1114, 1115, 1116, 1100, 1117, 1118, 1100, 1119, 1120, 1121, 1122, 1124, 1125, 1126, 1127, 1128, 1129, 1130, 1132, 1133, 1134, 1135, 1136, 1137, 1138, 1139, 1140, 1141, 1142, 1144, 1145, 1146, 1144, 1147, 1148, 1144, 1149, 1144, 1150, 1151, 1144, 1152, 1155, 1156, 1157, 1158, 1159, 1161, 1162, 1164, 1166, 1168, 1169, 1170, 1173, 1174, 1175, 1176, 1177, 1178, 1179, 1180, 1181, 1182, 1183, 1184, 1185, 1186, 1187, 1188, 1189, 1181, 1190, 1191, 1192, 1193, 1196, 1197, 1198, 1199, 1200, 1201, 1202, 1203, 1204, 1205, 1192, 1207, 1208, 1209, 1210, 1211, 1213, 1214, 1215, 1216, 1217, 1218, 1219, 1220, 1221, 1222, 1223, 1224, 1225, 1226, 1227, 1228, 1229, 1230, 1231, 1233, 1234, 1232, 1235, 1236, 1238, 1240, 1241, 1242, 1243, 1244, 1245, 1247, 1248, 1231, 1231, 1231, 1232, 1232, 1232, 1249, 1250, 1251, 1252, 1245, 1253, 1254, 1255, 1245, 1256, 1245, 1257, 1258, 1259, 1260, 1261, 1262, 1263, 1264, 1265, 1266, 1267, 1268, 1269, 1270, 1271, 1272, 1273, 1274, 1275, 1277, 1278, 1279, 1280, 1281, 1282, 1283, 1284, 1285, 1286, 1287, 1288, 1289, 1291, 1292, 1294, 1295, 1296, 1297, 1298, 1294, 1299, 1300, 1301, 1302, 1303, 1304, 1305, 1306, 1307, 1308, 1309, 1310, 1304, 1311, 1312, 1313, 1314, 1315, 1317, 1318, 1319, 1320, 1321, 1324, 1326, 1327, 1328, 1329, 1330, 1331, 1332, 1333, 1334, 1335, 1336, 1329, 1337, 1338, 1339, 1340, 1341, 1342, 1343, 1344, 1345, 1346, 1347, 1348, 1349, 1350, 1351, 1352, 1353, 1355, 1356, 1357, 1359, 1360, 1361, 1362, 1363, 1364, 1365, 1366, 1367, 1369, 1370, 1371, 1372, 1373, 1374, 1375, 1376, 1377, 1378, 1379, 1380, 1381, 1383, 1384, 1385, 1386, 1387, 1388, 1389, 1390, 1391, 1392, 1393, 1394, 1395, 1396, 1397, 1398, 1400, 1401, 1402, 1403, 1404, 1406, 1407, 1408, 1409, 1410, 1411, 1412, 1414, 1415, 1416, 1417, 1420, 1422, 1424, 1425, 1426, 1427, 1428, 1429, 1430, 1431, 1432, 1433, 1434, 1435, 1436, 1437, 1439, 1440, 1441, 1442, 1443, 1444, 1445, 1446, 1447, 1448, 1449, 1450, 1452, 1454, 1455, 1457, 1458, 1459, 1460, 1461, 1463, 1464, 1465, 1466, 1467, 1468, 1469, 1470, 1471, 1472, 1473, 1474, 1475, 1476, 1477, 1478, 1479, 1481, 1482, 1483, 1485, 1486, 1487, 1488, 1489, 1490, 1491, 1492, 1493, 1494, 1495, 1490, 1497, 1498, 1499, 1500, 1501, 1502, 1503, 1504, 1506, 1507, 1509, 1510, 1511, 1512, 1513, 1515, 1516, 1517, 1518, 1519, 1520, 1521, 1522, 1523, 1524, 1525, 1526, 1528, 1530, 1532, 1533, 1534, 1535, 1536, 1537, 1538, 1539, 1540, 1542, 1543, 1544, 1545, 1546, 1547, 1548, 1549, 1550, 1551, 1552, 1553, 1554, 1555, 1556, 1557, 1558, 1559, 1560, 1561, 1562, 1563, 1565, 1566, 1567, 1568, 1569, 1570, 1571, 1572, 1574, 1575, 1577, 1578, 1579, 1580, 1581, 1582, 1583, 1584, 1585, 1586, 1587, 1589, 1590, 1591, 1592, 1593, 1594, 1595, 1596, 1598, 1599, 1600, 1602, 1603, 1605, 1606, 1607, 1608, 1609, 1610, 1612, 1613, 1614, 1615, 1617, 1618, 1619, 1620, 1621, 1622, 1623, 1624, 1625, 1627, 1628, 1629, 1630, 1631, 1632, 1634, 1635, 1636, 1637, 1638, 1641, 1643, 1644, 1645, 1646, 1647, 1648, 1649, 1650, 1651, 1652, 1654, 1641, 1655, 1656, 1657, 1658, 1659, 1660, 1661, 1662, 1663, 1664, 1665, 1666, 1667, 1668, 1669, 1670, 1671, 1672, 1673, 1675, 1676, 1677, 1679, 1680, 1681, 1682, 1683, 1684, 1685, 1686, 1687, 1688, 1689, 1690, 1691, 1692, 1693, 1694, 1696, 1697, 1698, 1699, 1700, 1701, 1702, 1703, 1704, 1705, 1707, 1708, 1709, 1710, 1711, 1712, 1713, 1714, 1715, 1716, 1717, 1718, 1719, 1720, 1721, 1722, 1723, 1724, 1726, 1727, 1728, 1729, 1732, 1733, 1734, 1735, 1736, 1737, 1738, 1739, 1740, 1741, 1742, 1743, 1744, 1745, 1746, 1747, 1748, 1749, 1750, 1751, 1752, 1753, 1754, 1755, 1757, 1758, 1759, 1760, 1761, 1762, 1763, 1765, 1766, 1767, 1770, 1771, 1772, 1773, 1774, 1775, 1776, 1778, 1779, 1780, 1781, 1786, 1787, 1788, 1790, 1791, 1793, 1794, 1795, 1799, 1800, 1801, 1802, 1804, 1793, 1805, 1806, 1807, 1808, 1809, 1810, 1811, 1812, 1813, 1793, 1814, 1815, 1818, 1820, 1821, 1822, 1823, 1824, 1825, 1826, 1827, 1830, 1831, 1832, 1833, 1834, 1835, 1837, 1838, 1840, 1841, 1842, 1843, 1844, 1845, 1846, 1847, 1848, 1849, 1850, 1853, 1855, 1856, 1857, 1858, 1859, 1860, 1862, 1863, 1864, 1865, 1866, 1867, 1868, 1869, 1870, 1871, 1872, 1874, 1875, 1876, 1877, 1878, 1879, 1880, 1881, 1882, 1883, 1884, 1885, 1886, 1887, 1888, 1889, 1890, 1891, 1892, 1893, 1895, 1896, 1897, 1898, 1899, 1900, 1901, 1902, 1903, 1904, 1905, 1906, 1907, 1908, 1909, 1910, 1911, 1912, 1913, 1914, 1915, 1916, 1917, 1918, 1921, 1922, 1923, 1925, 1926, 1927, 1928, 1929, 1930, 1931, 1932, 1933, 1934, 1935, 1937, 1938, 1940, 1941, 1945, 1946, 1947, 1948, 1949, 1950, 1951, 1952, 1953, 1954, 1955, 1956, 1957, 1958, 1959, 1960, 1961, 1965, 1966, 1968, 1969, 1970, 1971, 1972, 1973, 1975, 1976, 1977, 1978, 1979, 1980, 1982, 1984, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2022, 2025, 2026, 2027, 2028, 2029, 2030, 2032, 2033, 2035, 2036, 2037, 2038, 2039, 2040, 2041, 2043, 2044, 2045, 2046, 2047, 2048, 2049, 2050, 2051, 2052, 2053, 2054, 2055, 2056, 2058, 2059, 2060, 2061, 2062, 2063, 2064, 2065, 2066, 2067, 2068, 2069, 2070, 2073, 2074, 2075, 2076, 2077, 2078, 2079, 2080, 2081, 2083, 2085, 2086, 2087, 2088, 2089, 2090, 2091, 2092, 2093, 2095, 2096, 2097, 2101, 2102, 2103, 2104, 2105, 2088, 2106, 2107, 2108, 2109, 2111, 2112, 2114, 2115, 2118, 2120, 2121, 2123, 2124, 2126, 2127, 2128, 2130, 2131, 2132, 2133, 2134, 2135, 2136, 2137, 2138, 2139, 2140, 2141, 2142, 2143, 2145, 2148, 2149, 2150, 2151, 2152, 2153, 2154, 2155, 2156, 2158, 2161, 2162, 2163, 2164, 2165, 2166, 2167, 2168, 2169, 2170, 2172, 2174, 2176, 2177, 2178, 2179, 2180, 2181, 2182, 2183, 2185, 2186, 2187, 2188, 2189, 2190, 2191, 2192, 2193, 2194, 2195, 2196, 2197, 2198, 2199, 2200, 2202, 2204, 2205, 2206, 2207, 2208, 2209, 2210, 2211, 2212, 2213, 2214, 2215, 2216, 2217, 2218, 2219, 2220, 2221, 2222, 2223, 2224, 2225, 2227, 2228, 2229, 2231, 2232, 2233, 2235, 2236, 2237, 2238, 2239, 2240, 2241, 2246, 2247, 2248, 2249, 2250, 2251, 2252, 2254, 2255, 2256, 2257, 2258, 2259, 2260, 2263, 2270, 2271, 2272, 2273, 2274, 2277, 2278, 2279, 2280, 2281, 2282, 2285, 2286, 2288, 2290, 2291, 2292, 2293, 2294, 2295, 2296, 2297, 2298, 2299, 2300, 2302, 2304, 2305, 2306, 2308, 2310, 2312, 2313, 2314, 2315, 2316, 2319, 2322, 2323, 2325, 2326, 2327, 2328, 2329, 2331, 2333, 2334, 2335, 2336, 2337, 2343, 697, 696, 695, 694, 693, 692, 690, 689, 688, 687, 686, 685, 684, 682, 681, 680, 679, 678, 676, 675, 674, 673, 672, 671, 670, 669, 668, 667, 664, 663, 662, 661, 660, 659, 658, 657, 656, 655, 654, 653, 652, 651, 650, 649, 648, 646, 645, 644, 643, 642, 641, 640, 638, 637, 636, 635, 634, 633, 631, 630, 629, 628, 627, 626, 624, 623, 622, 620, 619, 618, 617, 616, 615, 613, 612, 610, 609, 608, 607, 606, 605, 604, 603, 602, 600, 599, 598, 596, 594, 593, 590, 589, 588, 587, 586, 584, 583, 582, 581, 579, 578, 577, 576, 575, 571, 570, 569, 568, 566, 565, 564, 562, 561, 560, 559, 558, 553, 552, 551, 550, 549, 548, 547, 546, 545, 544, 543, 541, 540, 539, 537, 536, 535, 533, 532, 531, 530, 529, 528, 527, 526, 525, 523, 522, 520, 518, 517, 516, 515, 511, 510, 509, 508, 506, 504, 503, 502, 501, 500, 499, 498, 495, 494, 491, 490, 489, 488, 487, 486, 485, 484, 483, 482, 481, 480, 479, 478, 477, 476, 475, 474, 473, 472, 471, 470, 469, 467, 466, 465, 464, 463, 462, 461, 460, 458, 457, 456, 455, 454, 452, 451, 450, 449, 448, 447, 446, 445, 444, 443, 442, 441, 440, 439, 438, 437, 435, 434, 433, 432, 431, 430, 429, 428, 427, 426, 425, 423, 421, 419, 418, 415, 414, 413, 412, 411, 410, 409, 406, 405, 404, 403, 402, 401, 400, 399, 398, 397, 396, 394, 393, 392, 391, 390, 389, 387, 386, 385, 384, 383, 380, 379, 378, 377, 375, 374, 373, 372, 370, 369, 368, 367, 366, 357, 356, 355, 354, 353, 352, 351, 350, 349, 348, 347, 346, 345, 344, 343, 342, 341, 340, 339, 338, 337, 336, 335, 331, 330, 329, 327, 326, 325, 324, 323, 321, 320, 319, 318, 317, 315, 314, 313, 312, 311, 310, 309, 308, 307, 306, 305, 304, 303, 302, 301, 300, 298, 296, 295, 294, 293, 292, 291, 290, 289, 288, 286, 285, 284, 283, 282, 281, 279, 278, 277, 276, 275, 273, 272, 271, 270, 268, 266, 265, 264, 263, 262, 261, 260, 259, 258, 257, 256, 255, 254, 253, 252, 251, 250, 249, 248, 247, 246, 245, 244, 243, 242, 241, 240, 239, 237, 235, 234, 233, 231, 230, 229, 228, 226, 225, 224, 223, 222, 221, 219, 218, 217, 216, 215, 214, 213, 211, 210, 209, 208, 207, 206, 205, 204, 203, 202, 201, 200, 199, 198, 197, 196, 195, 194, 191, 190, 189, 188, 181, 178, 177, 176, 175, 174, 173, 172, 170, 169, 168, 166, 165, 164, 159, 158, 156, 155, 154, 151, 150, 148, 147, 146, 145, 144, 142, 140, 138, 135, 134, 133, 129, 124, 123, 122, 119, 118, 117, 116, 115, 114, 113, 110, 108, 106, 103, 102, 101, 100, 98, 97, 96, 94, 91, 90, 89, 86, 85, 82, 79, 78, 77, 75, 74, 73, 55, 52, 49, 48, 45, 40, 33, 22, 11, 10, 7, 3, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342, 2342 } ; static yy_state_type yy_last_accepting_state; static char *yy_last_accepting_cpos; extern int getdp_yy_flex_debug; int getdp_yy_flex_debug = 0; /* The intent behind this definition is that it'll catch * any uses of REJECT which flex missed. */ #define REJECT reject_used_but_not_detected #define yymore() yymore_used_but_not_detected #define YY_MORE_ADJ 0 #define YY_RESTORE_YY_MORE_OFFSET char *getdp_yytext; #line 1 "ProParser.l" #line 2 "ProParser.l" // GetDP - Copyright (C) 1997-2015 P. Dular, C. Geuzaine // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include #include #include #include "ProData.h" #include "ProParser.h" #include "ProParser.tab.hpp" #include "MallocUtils.h" #include "Message.h" // Redefinition of YY_INPUT to allow input character count (this is // slower than fread(), but the .pro files are never that big) #ifdef YY_INPUT #undef YY_INPUT #endif #define YY_INPUT(buf,result,max_size) { \ int c = getc(getdp_yyin); \ getdp_yycolnum++; \ result = (c == EOF) ? YY_NULL : (buf[0] = c, 1); \ } #line 1839 "ProParser.yy.cpp" #define INITIAL 0 #ifndef YY_NO_UNISTD_H /* Special case for "unistd.h", since it is non-ANSI. We include it way * down here because we want the user's section 1 to have been scanned first. * The user has a chance to override it with an option. */ #include #endif #ifndef YY_EXTRA_TYPE #define YY_EXTRA_TYPE void * #endif static int yy_init_globals (void ); /* Accessor methods to globals. These are made visible to non-reentrant scanners for convenience. */ int getdp_yylex_destroy (void ); int getdp_yyget_debug (void ); void getdp_yyset_debug (int debug_flag ); YY_EXTRA_TYPE getdp_yyget_extra (void ); void getdp_yyset_extra (YY_EXTRA_TYPE user_defined ); FILE *getdp_yyget_in (void ); void getdp_yyset_in (FILE * in_str ); FILE *getdp_yyget_out (void ); void getdp_yyset_out (FILE * out_str ); yy_size_t getdp_yyget_leng (void ); char *getdp_yyget_text (void ); int getdp_yyget_lineno (void ); void getdp_yyset_lineno (int line_number ); /* Macros after this point can all be overridden by user definitions in * section 1. */ #ifndef YY_SKIP_YYWRAP #ifdef __cplusplus extern "C" int getdp_yywrap (void ); #else extern int getdp_yywrap (void ); #endif #endif static void yyunput (int c,char *buf_ptr ); #ifndef yytext_ptr static void yy_flex_strncpy (char *,yyconst char *,int ); #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen (yyconst char * ); #endif #ifndef YY_NO_INPUT #ifdef __cplusplus static int yyinput (void ); #else static int input (void ); #endif #endif /* Amount of stuff to slurp up with each read. */ #ifndef YY_READ_BUF_SIZE #define YY_READ_BUF_SIZE 8192 #endif /* Copy whatever the last rule matched to the standard output. */ #ifndef ECHO /* This used to be an fputs(), but since the string might contain NUL's, * we now use fwrite(). */ #define ECHO do { if (fwrite( getdp_yytext, getdp_yyleng, 1, getdp_yyout )) {} } while (0) #endif /* Gets input and stuffs it into "buf". number of characters read, or YY_NULL, * is returned in "result". */ #ifndef YY_INPUT #define YY_INPUT(buf,result,max_size) \ if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \ { \ int c = '*'; \ size_t n; \ for ( n = 0; n < max_size && \ (c = getc( getdp_yyin )) != EOF && c != '\n'; ++n ) \ buf[n] = (char) c; \ if ( c == '\n' ) \ buf[n++] = (char) c; \ if ( c == EOF && ferror( getdp_yyin ) ) \ YY_FATAL_ERROR( "input in flex scanner failed" ); \ result = n; \ } \ else \ { \ errno=0; \ while ( (result = fread(buf, 1, max_size, getdp_yyin))==0 && ferror(getdp_yyin)) \ { \ if( errno != EINTR) \ { \ YY_FATAL_ERROR( "input in flex scanner failed" ); \ break; \ } \ errno=0; \ clearerr(getdp_yyin); \ } \ }\ \ #endif /* No semi-colon after return; correct usage is to write "yyterminate();" - * we don't want an extra ';' after the "return" because that will cause * some compilers to complain about unreachable statements. */ #ifndef yyterminate #define yyterminate() return YY_NULL #endif /* Number of entries by which start-condition stack grows. */ #ifndef YY_START_STACK_INCR #define YY_START_STACK_INCR 25 #endif /* Report a fatal error. */ #ifndef YY_FATAL_ERROR #define YY_FATAL_ERROR(msg) yy_fatal_error( msg ) #endif /* end tables serialization structures and prototypes */ /* Default declaration of generated scanner - a define so the user can * easily add parameters. */ #ifndef YY_DECL #define YY_DECL_IS_OURS 1 extern int getdp_yylex (void); #define YY_DECL int getdp_yylex (void) #endif /* !YY_DECL */ /* Code executed at the beginning of each rule, after getdp_yytext and getdp_yyleng * have been set up. */ #ifndef YY_USER_ACTION #define YY_USER_ACTION #endif /* Code executed at the end of each rule. */ #ifndef YY_BREAK #define YY_BREAK break; #endif #define YY_RULE_SETUP \ YY_USER_ACTION /** The main scanner function which does all the work. */ YY_DECL { register yy_state_type yy_current_state; register char *yy_cp, *yy_bp; register int yy_act; #line 35 "ProParser.l" #line 2024 "ProParser.yy.cpp" if ( !(yy_init) ) { (yy_init) = 1; #ifdef YY_USER_INIT YY_USER_INIT; #endif if ( ! (yy_start) ) (yy_start) = 1; /* first start state */ if ( ! getdp_yyin ) getdp_yyin = stdin; if ( ! getdp_yyout ) getdp_yyout = stdout; if ( ! YY_CURRENT_BUFFER ) { getdp_yyensure_buffer_stack (); YY_CURRENT_BUFFER_LVALUE = getdp_yy_create_buffer(getdp_yyin,YY_BUF_SIZE ); } getdp_yy_load_buffer_state( ); } while ( 1 ) /* loops until end-of-file is reached */ { yy_cp = (yy_c_buf_p); /* Support of getdp_yytext. */ *yy_cp = (yy_hold_char); /* yy_bp points to the position in yy_ch_buf of the start of * the current run. */ yy_bp = yy_cp; yy_current_state = (yy_start); yy_match: do { register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)]; if ( yy_accept[yy_current_state] ) { (yy_last_accepting_state) = yy_current_state; (yy_last_accepting_cpos) = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 2343 ) yy_c = yy_meta[(unsigned int) yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c]; ++yy_cp; } while ( yy_base[yy_current_state] != 2498 ); yy_find_action: yy_act = yy_accept[yy_current_state]; if ( yy_act == 0 ) { /* have to back up */ yy_cp = (yy_last_accepting_cpos); yy_current_state = (yy_last_accepting_state); yy_act = yy_accept[yy_current_state]; } YY_DO_BEFORE_ACTION; do_action: /* This label is used only to access EOF actions. */ switch ( yy_act ) { /* beginning of action switch */ case 0: /* must back up */ /* undo the effects of YY_DO_BEFORE_ACTION */ *yy_cp = (yy_hold_char); yy_cp = (yy_last_accepting_cpos); yy_current_state = (yy_last_accepting_state); goto yy_find_action; case 1: YY_RULE_SETUP #line 37 "ProParser.l" /* nothing to do */; YY_BREAK case 2: /* rule 2 can match eol */ YY_RULE_SETUP #line 38 "ProParser.l" { getdp_yycolnum = 0; getdp_yylinenum++; } YY_BREAK case YY_STATE_EOF(INITIAL): #line 39 "ProParser.l" { getdp_yyincludenum = 0; return(0); } YY_BREAK case 3: YY_RULE_SETUP #line 41 "ProParser.l" return tEND; YY_BREAK case 4: YY_RULE_SETUP #line 42 "ProParser.l" cStyleComments(); YY_BREAK case 5: YY_RULE_SETUP #line 43 "ProParser.l" cxxStyleComments(); YY_BREAK case 6: YY_RULE_SETUP #line 44 "ProParser.l" { parseString('\"'); return tBIGSTR; } YY_BREAK case 7: YY_RULE_SETUP #line 45 "ProParser.l" return tDEF; YY_BREAK case 8: YY_RULE_SETUP #line 46 "ProParser.l" return tCROSSPRODUCT; YY_BREAK case 9: YY_RULE_SETUP #line 47 "ProParser.l" return tCROSSPRODUCT; YY_BREAK case 10: YY_RULE_SETUP #line 48 "ProParser.l" return tOR; YY_BREAK case 11: YY_RULE_SETUP #line 49 "ProParser.l" return tAND; YY_BREAK case 12: YY_RULE_SETUP #line 50 "ProParser.l" return tEQUAL; YY_BREAK case 13: YY_RULE_SETUP #line 51 "ProParser.l" return tNOTEQUAL; YY_BREAK case 14: YY_RULE_SETUP #line 52 "ProParser.l" return tAPPROXEQUAL; YY_BREAK case 15: YY_RULE_SETUP #line 53 "ProParser.l" return tLESSOREQUAL; YY_BREAK case 16: YY_RULE_SETUP #line 54 "ProParser.l" return tGREATEROREQUAL; YY_BREAK case 17: YY_RULE_SETUP #line 55 "ProParser.l" return tGREATERGREATER; YY_BREAK case 18: YY_RULE_SETUP #line 56 "ProParser.l" return tLESSLESS; YY_BREAK case 19: YY_RULE_SETUP #line 57 "ProParser.l" return tDOTS; YY_BREAK case 20: YY_RULE_SETUP #line 58 "ProParser.l" return tDOTS; YY_BREAK case 21: YY_RULE_SETUP #line 59 "ProParser.l" return tSHOW; YY_BREAK case 22: YY_RULE_SETUP #line 61 "ProParser.l" return tInclude; YY_BREAK case 23: YY_RULE_SETUP #line 63 "ProParser.l" return t0D; YY_BREAK case 24: YY_RULE_SETUP #line 64 "ProParser.l" return t1D; YY_BREAK case 25: YY_RULE_SETUP #line 65 "ProParser.l" return t2D; YY_BREAK case 26: YY_RULE_SETUP #line 66 "ProParser.l" return t3D; YY_BREAK case 27: YY_RULE_SETUP #line 68 "ProParser.l" return tAcos; YY_BREAK case 28: YY_RULE_SETUP #line 69 "ProParser.l" return tAsin; YY_BREAK case 29: YY_RULE_SETUP #line 70 "ProParser.l" return tAcos; YY_BREAK case 30: YY_RULE_SETUP #line 71 "ProParser.l" return tAdapt; YY_BREAK case 31: YY_RULE_SETUP #line 72 "ProParser.l" return tAddCorrection ; YY_BREAK case 32: YY_RULE_SETUP #line 73 "ProParser.l" return tAddMHMoving; YY_BREAK case 33: YY_RULE_SETUP #line 74 "ProParser.l" return tAddOppositeFullSolution ; YY_BREAK case 34: YY_RULE_SETUP #line 75 "ProParser.l" return tAll; YY_BREAK case 35: YY_RULE_SETUP #line 76 "ProParser.l" return tAppend; YY_BREAK case 36: YY_RULE_SETUP #line 77 "ProParser.l" return tAppendTimeStepToFileName; YY_BREAK case 37: YY_RULE_SETUP #line 78 "ProParser.l" return tAppendExpressionToFileName; YY_BREAK case 38: YY_RULE_SETUP #line 79 "ProParser.l" return tAppendExpressionFormat; YY_BREAK case 39: YY_RULE_SETUP #line 80 "ProParser.l" return tAppendStringToFileName; YY_BREAK case 40: YY_RULE_SETUP #line 81 "ProParser.l" return tAppendToExistingFile; YY_BREAK case 41: YY_RULE_SETUP #line 82 "ProParser.l" return tAsin; YY_BREAK case 42: YY_RULE_SETUP #line 83 "ProParser.l" return tAtAnteriorTimeStep; YY_BREAK case 43: YY_RULE_SETUP #line 84 "ProParser.l" return tMaxOverTime; YY_BREAK case 44: YY_RULE_SETUP #line 85 "ProParser.l" return tFourierSteinmetz; YY_BREAK case 45: YY_RULE_SETUP #line 86 "ProParser.l" return tAtan; YY_BREAK case 46: YY_RULE_SETUP #line 87 "ProParser.l" return tAtan2; YY_BREAK case 47: YY_RULE_SETUP #line 89 "ProParser.l" return tBarrier; YY_BREAK case 48: YY_RULE_SETUP #line 90 "ProParser.l" return tBasisFunction; YY_BREAK case 49: YY_RULE_SETUP #line 91 "ProParser.l" return tBeta; YY_BREAK case 50: YY_RULE_SETUP #line 92 "ProParser.l" return tBranch; YY_BREAK case 51: YY_RULE_SETUP #line 93 "ProParser.l" return tBreak; YY_BREAK case 52: YY_RULE_SETUP #line 94 "ProParser.l" return tBroadcastFields; YY_BREAK case 53: YY_RULE_SETUP #line 96 "ProParser.l" return tCall; YY_BREAK case 54: YY_RULE_SETUP #line 97 "ProParser.l" return tCallTest; YY_BREAK case 55: YY_RULE_SETUP #line 98 "ProParser.l" return tCase; YY_BREAK case 56: YY_RULE_SETUP #line 99 "ProParser.l" return tCeil; YY_BREAK case 57: YY_RULE_SETUP #line 100 "ProParser.l" return tChangeOfCoordinates; YY_BREAK case 58: YY_RULE_SETUP #line 101 "ProParser.l" return tChangeOfCoordinates2; YY_BREAK case 59: YY_RULE_SETUP #line 102 "ProParser.l" return tChangeOfState; YY_BREAK case 60: YY_RULE_SETUP #line 103 "ProParser.l" return tChangeOfValues; YY_BREAK case 61: YY_RULE_SETUP #line 104 "ProParser.l" return tCoefficient; YY_BREAK case 62: YY_RULE_SETUP #line 105 "ProParser.l" return tColor; YY_BREAK case 63: YY_RULE_SETUP #line 106 "ProParser.l" return tComma; YY_BREAK case 64: YY_RULE_SETUP #line 107 "ProParser.l" return tConstant; YY_BREAK case 65: YY_RULE_SETUP #line 108 "ProParser.l" return tConstant; YY_BREAK case 66: YY_RULE_SETUP #line 109 "ProParser.l" return tConstraint; YY_BREAK case 67: YY_RULE_SETUP #line 110 "ProParser.l" return tCos; YY_BREAK case 68: YY_RULE_SETUP #line 111 "ProParser.l" return tCosh; YY_BREAK case 69: YY_RULE_SETUP #line 112 "ProParser.l" return tCosineTransform; YY_BREAK case 70: YY_RULE_SETUP #line 113 "ProParser.l" return tCreateDir; YY_BREAK case 71: YY_RULE_SETUP #line 114 "ProParser.l" return tCreateDir; YY_BREAK case 72: YY_RULE_SETUP #line 115 "ProParser.l" return tCriterion; YY_BREAK case 73: YY_RULE_SETUP #line 116 "ProParser.l" return tCreateSolution; YY_BREAK case 74: YY_RULE_SETUP #line 117 "ProParser.l" return tCrossProduct; YY_BREAK case 75: YY_RULE_SETUP #line 118 "ProParser.l" return tCrossProduct; YY_BREAK case 76: YY_RULE_SETUP #line 119 "ProParser.l" return tCurrentDirectory; YY_BREAK case 77: YY_RULE_SETUP #line 120 "ProParser.l" return tCurrentDirectory; YY_BREAK case 78: YY_RULE_SETUP #line 122 "ProParser.l" return tDTime; YY_BREAK case 79: YY_RULE_SETUP #line 123 "ProParser.l" return tDate; YY_BREAK case 80: YY_RULE_SETUP #line 124 "ProParser.l" return tDecomposeInSimplex; YY_BREAK case 81: YY_RULE_SETUP #line 125 "ProParser.l" return tDefineConstant; YY_BREAK case 82: YY_RULE_SETUP #line 126 "ProParser.l" return tDefineFunction; YY_BREAK case 83: YY_RULE_SETUP #line 127 "ProParser.l" return tDefineGroup; YY_BREAK case 84: YY_RULE_SETUP #line 128 "ProParser.l" return tDefineNumber; YY_BREAK case 85: YY_RULE_SETUP #line 129 "ProParser.l" return tDefineString; YY_BREAK case 86: YY_RULE_SETUP #line 130 "ProParser.l" return tDefineConstant; YY_BREAK case 87: YY_RULE_SETUP #line 131 "ProParser.l" return tDeformMesh; YY_BREAK case 88: YY_RULE_SETUP #line 132 "ProParser.l" return tDeformMesh; YY_BREAK case 89: YY_RULE_SETUP #line 133 "ProParser.l" return tDelete; YY_BREAK case 90: YY_RULE_SETUP #line 134 "ProParser.l" return tDeleteFile; YY_BREAK case 91: YY_RULE_SETUP #line 135 "ProParser.l" return tDepth; YY_BREAK case 92: YY_RULE_SETUP #line 136 "ProParser.l" return tdeRham; YY_BREAK case 93: YY_RULE_SETUP #line 137 "ProParser.l" return tDestinationSystem; YY_BREAK case 94: YY_RULE_SETUP #line 138 "ProParser.l" return tdFunction; YY_BREAK case 95: YY_RULE_SETUP #line 139 "ProParser.l" return tDimension; YY_BREAK case 96: YY_RULE_SETUP #line 140 "ProParser.l" return tDivisionCoefficient; YY_BREAK case 97: YY_RULE_SETUP #line 141 "ProParser.l" return tDofValue; YY_BREAK case 98: YY_RULE_SETUP #line 142 "ProParser.l" return tDt; YY_BREAK case 99: YY_RULE_SETUP #line 143 "ProParser.l" return tDtDof; YY_BREAK case 100: YY_RULE_SETUP #line 144 "ProParser.l" return tDtDofJacNL; YY_BREAK case 101: YY_RULE_SETUP #line 145 "ProParser.l" return tDtDt; YY_BREAK case 102: YY_RULE_SETUP #line 146 "ProParser.l" return tDtDtDof; YY_BREAK case 103: YY_RULE_SETUP #line 147 "ProParser.l" return tDtDtDtDof; YY_BREAK case 104: YY_RULE_SETUP #line 148 "ProParser.l" return tDtDtDtDtDof; YY_BREAK case 105: YY_RULE_SETUP #line 149 "ProParser.l" return tDtDtDtDtDtDof; YY_BREAK case 106: YY_RULE_SETUP #line 150 "ProParser.l" return tDtNL; YY_BREAK case 107: YY_RULE_SETUP #line 152 "ProParser.l" return tEcho; YY_BREAK case 108: YY_RULE_SETUP #line 153 "ProParser.l" return tEigenSolve; YY_BREAK case 109: YY_RULE_SETUP #line 154 "ProParser.l" return tEigenSolveJac; YY_BREAK case 110: YY_RULE_SETUP #line 155 "ProParser.l" return tEigenvalueLegend; YY_BREAK case 111: YY_RULE_SETUP #line 156 "ProParser.l" return tElse; YY_BREAK case 112: YY_RULE_SETUP #line 157 "ProParser.l" return tElseIf; YY_BREAK case 113: YY_RULE_SETUP #line 158 "ProParser.l" return tEndFor; YY_BREAK case 114: YY_RULE_SETUP #line 159 "ProParser.l" return tEndIf; YY_BREAK case 115: YY_RULE_SETUP #line 160 "ProParser.l" return tEntity; YY_BREAK case 116: YY_RULE_SETUP #line 161 "ProParser.l" return tEntitySubType; YY_BREAK case 117: YY_RULE_SETUP #line 162 "ProParser.l" return tEntityType; YY_BREAK case 118: YY_RULE_SETUP #line 163 "ProParser.l" return tError; YY_BREAK case 119: YY_RULE_SETUP #line 164 "ProParser.l" return tEvaluate; YY_BREAK case 120: YY_RULE_SETUP #line 165 "ProParser.l" return tEvaluationPoints; YY_BREAK case 121: YY_RULE_SETUP #line 166 "ProParser.l" return tExp; YY_BREAK case 122: YY_RULE_SETUP #line 168 "ProParser.l" return tFabs; YY_BREAK case 123: YY_RULE_SETUP #line 169 "ProParser.l" return tFile; YY_BREAK case 124: YY_RULE_SETUP #line 170 "ProParser.l" return tFilter; YY_BREAK case 125: YY_RULE_SETUP #line 171 "ProParser.l" return tFixRelativePath; YY_BREAK case 126: YY_RULE_SETUP #line 172 "ProParser.l" return tFlag; YY_BREAK case 127: YY_RULE_SETUP #line 173 "ProParser.l" return tFloor; YY_BREAK case 128: YY_RULE_SETUP #line 174 "ProParser.l" return tFmod; YY_BREAK case 129: YY_RULE_SETUP #line 175 "ProParser.l" return tFooter; YY_BREAK case 130: YY_RULE_SETUP #line 176 "ProParser.l" return tFor; YY_BREAK case 131: YY_RULE_SETUP #line 177 "ProParser.l" return tFormat; YY_BREAK case 132: YY_RULE_SETUP #line 178 "ProParser.l" return tFormulation; YY_BREAK case 133: YY_RULE_SETUP #line 179 "ProParser.l" return tFourierTransform; YY_BREAK case 134: YY_RULE_SETUP #line 180 "ProParser.l" return tFourierTransformJ; YY_BREAK case 135: YY_RULE_SETUP #line 181 "ProParser.l" return tFrequency; YY_BREAK case 136: YY_RULE_SETUP #line 182 "ProParser.l" return tFrequencyLegend; YY_BREAK case 137: YY_RULE_SETUP #line 183 "ProParser.l" return tFrequencySpectrum; YY_BREAK case 138: YY_RULE_SETUP #line 184 "ProParser.l" return tFull_Matrix; YY_BREAK case 139: YY_RULE_SETUP #line 185 "ProParser.l" return tFunction; YY_BREAK case 140: YY_RULE_SETUP #line 186 "ProParser.l" return tFunctionSpace; YY_BREAK case 141: YY_RULE_SETUP #line 188 "ProParser.l" return tGalerkin; YY_BREAK case 142: YY_RULE_SETUP #line 189 "ProParser.l" return tGamma; YY_BREAK case 143: YY_RULE_SETUP #line 190 "ProParser.l" return tGenerateGroup; YY_BREAK case 144: YY_RULE_SETUP #line 191 "ProParser.l" return tGenerateGroupCumulative; YY_BREAK case 145: YY_RULE_SETUP #line 192 "ProParser.l" return tGenerateJacGroup; YY_BREAK case 146: YY_RULE_SETUP #line 193 "ProParser.l" return tGenerateJacGroupCumulative; YY_BREAK case 147: YY_RULE_SETUP #line 194 "ProParser.l" return tGenerateMHMoving; YY_BREAK case 148: YY_RULE_SETUP #line 195 "ProParser.l" return tGenerateMHMovingSeparate; YY_BREAK case 149: YY_RULE_SETUP #line 196 "ProParser.l" return tGenerateOnly; YY_BREAK case 150: YY_RULE_SETUP #line 197 "ProParser.l" return tGenerateOnlyJac; YY_BREAK case 151: YY_RULE_SETUP #line 198 "ProParser.l" return tGenerateRHSGroup; YY_BREAK case 152: YY_RULE_SETUP #line 199 "ProParser.l" return tGenerateRHSGroupCumulative; YY_BREAK case 153: YY_RULE_SETUP #line 200 "ProParser.l" return tGeoElement; YY_BREAK case 154: YY_RULE_SETUP #line 201 "ProParser.l" return tGetRegion ; YY_BREAK case 155: YY_RULE_SETUP #line 202 "ProParser.l" return tGetResidual; YY_BREAK case 156: YY_RULE_SETUP #line 203 "ProParser.l" return tGlobalEquation; YY_BREAK case 157: YY_RULE_SETUP #line 204 "ProParser.l" return tGlobalQuantity; YY_BREAK case 158: YY_RULE_SETUP #line 205 "ProParser.l" return tGlobalTerm; YY_BREAK case 159: YY_RULE_SETUP #line 206 "ProParser.l" return tGmshClearAll; YY_BREAK case 160: YY_RULE_SETUP #line 207 "ProParser.l" return tGmshMerge; YY_BREAK case 161: YY_RULE_SETUP #line 208 "ProParser.l" return tGmshOpen; YY_BREAK case 162: YY_RULE_SETUP #line 209 "ProParser.l" return tGmshRead; YY_BREAK case 163: YY_RULE_SETUP #line 210 "ProParser.l" return tGmshWrite; YY_BREAK case 164: YY_RULE_SETUP #line 211 "ProParser.l" return tGroup; YY_BREAK case 165: YY_RULE_SETUP #line 212 "ProParser.l" return tGETDP_MAJOR_VERSION; YY_BREAK case 166: YY_RULE_SETUP #line 213 "ProParser.l" return tGETDP_MINOR_VERSION; YY_BREAK case 167: YY_RULE_SETUP #line 214 "ProParser.l" return tGETDP_PATCH_VERSION; YY_BREAK case 168: YY_RULE_SETUP #line 216 "ProParser.l" return tHarmonicToTime; YY_BREAK case 169: YY_RULE_SETUP #line 217 "ProParser.l" return tHeader; YY_BREAK case 170: YY_RULE_SETUP #line 218 "ProParser.l" return tHidden; YY_BREAK case 171: YY_RULE_SETUP #line 219 "ProParser.l" return tHypot; YY_BREAK case 172: YY_RULE_SETUP #line 221 "ProParser.l" return tIf; YY_BREAK case 173: YY_RULE_SETUP #line 222 "ProParser.l" return tIn; YY_BREAK case 174: YY_RULE_SETUP #line 223 "ProParser.l" return tInSupport; YY_BREAK case 175: YY_RULE_SETUP #line 224 "ProParser.l" return tInclude; YY_BREAK case 176: YY_RULE_SETUP #line 225 "ProParser.l" return tIndexOfSystem; YY_BREAK case 177: YY_RULE_SETUP #line 226 "ProParser.l" return tInitMovingBand2D; YY_BREAK case 178: YY_RULE_SETUP #line 227 "ProParser.l" return tGalerkin; YY_BREAK case 179: YY_RULE_SETUP #line 228 "ProParser.l" return tIntegration; YY_BREAK case 180: YY_RULE_SETUP #line 229 "ProParser.l" return tIso; YY_BREAK case 181: YY_RULE_SETUP #line 230 "ProParser.l" return tIterativeLinearSolver; YY_BREAK case 182: YY_RULE_SETUP #line 231 "ProParser.l" return tIterativeLoop; YY_BREAK case 183: YY_RULE_SETUP #line 232 "ProParser.l" return tIterativeLoopN; YY_BREAK case 184: YY_RULE_SETUP #line 233 "ProParser.l" return tIterativeTimeReduction; YY_BREAK case 185: YY_RULE_SETUP #line 235 "ProParser.l" return tJacNL; YY_BREAK case 186: YY_RULE_SETUP #line 236 "ProParser.l" return tJacobian; YY_BREAK case 187: YY_RULE_SETUP #line 238 "ProParser.l" return tLanczos; YY_BREAK case 188: YY_RULE_SETUP #line 239 "ProParser.l" return tLastTimeStepOnly; YY_BREAK case 189: YY_RULE_SETUP #line 240 "ProParser.l" return tLinSpace; YY_BREAK case 190: YY_RULE_SETUP #line 241 "ProParser.l" return tList; YY_BREAK case 191: YY_RULE_SETUP #line 242 "ProParser.l" return tListAlt; YY_BREAK case 192: YY_RULE_SETUP #line 243 "ProParser.l" return tListFromFile; YY_BREAK case 193: YY_RULE_SETUP #line 244 "ProParser.l" return tLog; YY_BREAK case 194: YY_RULE_SETUP #line 245 "ProParser.l" return tLog10; YY_BREAK case 195: YY_RULE_SETUP #line 246 "ProParser.l" return tLogSpace; YY_BREAK case 196: YY_RULE_SETUP #line 248 "ProParser.l" return tMHJacNL; YY_BREAK case 197: YY_RULE_SETUP #line 249 "ProParser.l" return tMHTransform; YY_BREAK case 198: YY_RULE_SETUP #line 250 "ProParser.l" return tMPI_Printf; YY_BREAK case 199: YY_RULE_SETUP #line 251 "ProParser.l" return tMPI_Rank; YY_BREAK case 200: YY_RULE_SETUP #line 252 "ProParser.l" return tMPI_Size; YY_BREAK case 201: YY_RULE_SETUP #line 253 "ProParser.l" return tMacro; YY_BREAK case 202: YY_RULE_SETUP #line 254 "ProParser.l" return tMaxNumberOfDivisions; YY_BREAK case 203: YY_RULE_SETUP #line 255 "ProParser.l" return tMaxNumberOfPoints; YY_BREAK case 204: YY_RULE_SETUP #line 256 "ProParser.l" return tMeshMovingBand2D; YY_BREAK case 205: YY_RULE_SETUP #line 257 "ProParser.l" return tMetricTensor; YY_BREAK case 206: YY_RULE_SETUP #line 258 "ProParser.l" return tModulo; YY_BREAK case 207: YY_RULE_SETUP #line 259 "ProParser.l" return tMovingBand2D; YY_BREAK case 208: YY_RULE_SETUP #line 260 "ProParser.l" return tMultiplySolution ; YY_BREAK case 209: YY_RULE_SETUP #line 262 "ProParser.l" return tName; YY_BREAK case 210: YY_RULE_SETUP #line 263 "ProParser.l" return tNameFromString; YY_BREAK case 211: YY_RULE_SETUP #line 264 "ProParser.l" return tNameOfBasisFunction; YY_BREAK case 212: YY_RULE_SETUP #line 265 "ProParser.l" return tNameOfCoef; YY_BREAK case 213: YY_RULE_SETUP #line 266 "ProParser.l" return tNameOfConstraint; YY_BREAK case 214: YY_RULE_SETUP #line 267 "ProParser.l" return tNameOfFormulation; YY_BREAK case 215: YY_RULE_SETUP #line 268 "ProParser.l" return tNameOfMesh; YY_BREAK case 216: YY_RULE_SETUP #line 269 "ProParser.l" return tNameOfPostProcessing; YY_BREAK case 217: YY_RULE_SETUP #line 270 "ProParser.l" return tNameOfResolution; YY_BREAK case 218: YY_RULE_SETUP #line 271 "ProParser.l" return tNameOfSpace; YY_BREAK case 219: YY_RULE_SETUP #line 272 "ProParser.l" return tNameOfSystem; YY_BREAK case 220: YY_RULE_SETUP #line 273 "ProParser.l" return tNbrMaxIteration; YY_BREAK case 221: YY_RULE_SETUP #line 274 "ProParser.l" return tNbrRegions ; YY_BREAK case 222: YY_RULE_SETUP #line 275 "ProParser.l" return tNeverDt; YY_BREAK case 223: YY_RULE_SETUP #line 276 "ProParser.l" return tNewCoordinates; YY_BREAK case 224: YY_RULE_SETUP #line 277 "ProParser.l" return tNoMesh; YY_BREAK case 225: YY_RULE_SETUP #line 278 "ProParser.l" return tNoNewLine; YY_BREAK case 226: YY_RULE_SETUP #line 279 "ProParser.l" return tNoTitle; YY_BREAK case 227: YY_RULE_SETUP #line 280 "ProParser.l" return tNumberOfDivisions; YY_BREAK case 228: YY_RULE_SETUP #line 281 "ProParser.l" return tNumberOfPoints; YY_BREAK case 229: YY_RULE_SETUP #line 283 "ProParser.l" return tOnBox; YY_BREAK case 230: YY_RULE_SETUP #line 284 "ProParser.l" return tOnSection; YY_BREAK case 231: YY_RULE_SETUP #line 285 "ProParser.l" return tOnElementsOf; YY_BREAK case 232: YY_RULE_SETUP #line 286 "ProParser.l" return tOnelabAction; YY_BREAK case 233: YY_RULE_SETUP #line 287 "ProParser.l" return tOnGlobal; YY_BREAK case 234: YY_RULE_SETUP #line 288 "ProParser.l" return tOnGrid; YY_BREAK case 235: YY_RULE_SETUP #line 289 "ProParser.l" return tOnLine; YY_BREAK case 236: YY_RULE_SETUP #line 290 "ProParser.l" return tOnPlane; YY_BREAK case 237: YY_RULE_SETUP #line 291 "ProParser.l" return tOnPoint; YY_BREAK case 238: YY_RULE_SETUP #line 292 "ProParser.l" return tOnRegion; YY_BREAK case 239: YY_RULE_SETUP #line 293 "ProParser.l" return tOnSection; YY_BREAK case 240: YY_RULE_SETUP #line 294 "ProParser.l" return tOperation; YY_BREAK case 241: YY_RULE_SETUP #line 295 "ProParser.l" return tOperationEnd; YY_BREAK case 242: YY_RULE_SETUP #line 296 "ProParser.l" return tOrder; YY_BREAK case 243: YY_RULE_SETUP #line 297 "ProParser.l" return tOriginSystem; YY_BREAK case 244: YY_RULE_SETUP #line 298 "ProParser.l" return tOverrideTimeStepValue; YY_BREAK case 245: YY_RULE_SETUP #line 300 "ProParser.l" return tPi; YY_BREAK case 246: YY_RULE_SETUP #line 301 "ProParser.l" return tPlot; YY_BREAK case 247: YY_RULE_SETUP #line 302 "ProParser.l" return tPostOperation; YY_BREAK case 248: YY_RULE_SETUP #line 303 "ProParser.l" return tPostProcessing; YY_BREAK case 249: YY_RULE_SETUP #line 304 "ProParser.l" return tQuantity; YY_BREAK case 250: YY_RULE_SETUP #line 305 "ProParser.l" return tPrint; YY_BREAK case 251: YY_RULE_SETUP #line 306 "ProParser.l" return tPrintConstants; YY_BREAK case 252: YY_RULE_SETUP #line 307 "ProParser.l" return tPrintGroup; YY_BREAK case 253: YY_RULE_SETUP #line 308 "ProParser.l" return tPrintf; YY_BREAK case 254: YY_RULE_SETUP #line 310 "ProParser.l" return tQuantity; YY_BREAK case 255: YY_RULE_SETUP #line 312 "ProParser.l" return tRand; YY_BREAK case 256: YY_RULE_SETUP #line 313 "ProParser.l" return tRead; YY_BREAK case 257: YY_RULE_SETUP #line 314 "ProParser.l" return tRegion; YY_BREAK case 258: YY_RULE_SETUP #line 315 "ProParser.l" return tRegionRef; YY_BREAK case 259: YY_RULE_SETUP #line 316 "ProParser.l" return tRelaxationFactor; YY_BREAK case 260: YY_RULE_SETUP #line 317 "ProParser.l" return tRenameFile; YY_BREAK case 261: YY_RULE_SETUP #line 318 "ProParser.l" return tResampleTime; YY_BREAK case 262: YY_RULE_SETUP #line 319 "ProParser.l" return tResolution; YY_BREAK case 263: YY_RULE_SETUP #line 320 "ProParser.l" return tReturn; YY_BREAK case 264: YY_RULE_SETUP #line 321 "ProParser.l" return tRound; YY_BREAK case 265: YY_RULE_SETUP #line 323 "ProParser.l" return tSaveMesh; YY_BREAK case 266: YY_RULE_SETUP #line 324 "ProParser.l" return tSaveSolutionExtendedMH; YY_BREAK case 267: YY_RULE_SETUP #line 325 "ProParser.l" return tSaveSolutionMHtoTime; YY_BREAK case 268: YY_RULE_SETUP #line 326 "ProParser.l" return tSaveSolutionWithEntityNum; YY_BREAK case 269: YY_RULE_SETUP #line 327 "ProParser.l" return tSelectCorrection ; YY_BREAK case 270: YY_RULE_SETUP #line 328 "ProParser.l" return tSendMergeFileRequest; YY_BREAK case 271: YY_RULE_SETUP #line 329 "ProParser.l" return tSendToServer; YY_BREAK case 272: YY_RULE_SETUP #line 330 "ProParser.l" return tSetCommSelf; YY_BREAK case 273: YY_RULE_SETUP #line 331 "ProParser.l" return tSetCommWorld; YY_BREAK case 274: YY_RULE_SETUP #line 332 "ProParser.l" return tSetFrequency; YY_BREAK case 275: YY_RULE_SETUP #line 333 "ProParser.l" return tSetGlobalSolverOptions; YY_BREAK case 276: YY_RULE_SETUP #line 334 "ProParser.l" return tSetTime; YY_BREAK case 277: YY_RULE_SETUP #line 335 "ProParser.l" return tSetTimeStep; YY_BREAK case 278: YY_RULE_SETUP #line 336 "ProParser.l" return tSign; YY_BREAK case 279: YY_RULE_SETUP #line 337 "ProParser.l" return tSin; YY_BREAK case 280: YY_RULE_SETUP #line 338 "ProParser.l" return tSinh; YY_BREAK case 281: YY_RULE_SETUP #line 339 "ProParser.l" return tSkin; YY_BREAK case 282: YY_RULE_SETUP #line 340 "ProParser.l" return tSleep; YY_BREAK case 283: YY_RULE_SETUP #line 341 "ProParser.l" return tSmoothing; YY_BREAK case 284: YY_RULE_SETUP #line 342 "ProParser.l" return tSolidAngle; YY_BREAK case 285: YY_RULE_SETUP #line 343 "ProParser.l" return tSolveAgainWithOther; YY_BREAK case 286: YY_RULE_SETUP #line 344 "ProParser.l" return tSolveJac_AdaptRelax; YY_BREAK case 287: YY_RULE_SETUP #line 345 "ProParser.l" return tSolver; YY_BREAK case 288: YY_RULE_SETUP #line 346 "ProParser.l" return tSort; YY_BREAK case 289: YY_RULE_SETUP #line 347 "ProParser.l" return tSprintf; YY_BREAK case 290: YY_RULE_SETUP #line 348 "ProParser.l" return tSqrt; YY_BREAK case 291: YY_RULE_SETUP #line 349 "ProParser.l" return tStoppingCriterion; YY_BREAK case 292: YY_RULE_SETUP #line 350 "ProParser.l" return tStoreInRegister; YY_BREAK case 293: YY_RULE_SETUP #line 351 "ProParser.l" return tStoreInVariable; YY_BREAK case 294: YY_RULE_SETUP #line 352 "ProParser.l" return tStoreInField; YY_BREAK case 295: YY_RULE_SETUP #line 353 "ProParser.l" return tStoreInMeshBasedField; YY_BREAK case 296: YY_RULE_SETUP #line 354 "ProParser.l" return tStoreInRegister; YY_BREAK case 297: YY_RULE_SETUP #line 355 "ProParser.l" return tStoreMaxInRegister; YY_BREAK case 298: YY_RULE_SETUP #line 356 "ProParser.l" return tStoreMaxXinRegister; YY_BREAK case 299: YY_RULE_SETUP #line 357 "ProParser.l" return tStoreMaxYinRegister; YY_BREAK case 300: YY_RULE_SETUP #line 358 "ProParser.l" return tStoreMaxZinRegister; YY_BREAK case 301: YY_RULE_SETUP #line 359 "ProParser.l" return tStoreMinInRegister; YY_BREAK case 302: YY_RULE_SETUP #line 360 "ProParser.l" return tStoreMinXinRegister; YY_BREAK case 303: YY_RULE_SETUP #line 361 "ProParser.l" return tStoreMinYinRegister; YY_BREAK case 304: YY_RULE_SETUP #line 362 "ProParser.l" return tStoreMinZinRegister; YY_BREAK case 305: YY_RULE_SETUP #line 363 "ProParser.l" return tStr; YY_BREAK case 306: YY_RULE_SETUP #line 364 "ProParser.l" return tStrCat; YY_BREAK case 307: YY_RULE_SETUP #line 365 "ProParser.l" return tStrChoice; YY_BREAK case 308: YY_RULE_SETUP #line 366 "ProParser.l" return tStrCmp; YY_BREAK case 309: YY_RULE_SETUP #line 367 "ProParser.l" return tStringFromName; YY_BREAK case 310: YY_RULE_SETUP #line 368 "ProParser.l" return tSubFunction; YY_BREAK case 311: YY_RULE_SETUP #line 369 "ProParser.l" return tSubRegion; YY_BREAK case 312: YY_RULE_SETUP #line 370 "ProParser.l" return tSubRegionRef; YY_BREAK case 313: YY_RULE_SETUP #line 371 "ProParser.l" return tSubSpace; YY_BREAK case 314: YY_RULE_SETUP #line 372 "ProParser.l" return tSubType; YY_BREAK case 315: YY_RULE_SETUP #line 373 "ProParser.l" return tSubdFunction; YY_BREAK case 316: YY_RULE_SETUP #line 374 "ProParser.l" return tSupport; YY_BREAK case 317: YY_RULE_SETUP #line 375 "ProParser.l" return tSymmetry; YY_BREAK case 318: YY_RULE_SETUP #line 376 "ProParser.l" return tDefineSystem; YY_BREAK case 319: YY_RULE_SETUP #line 377 "ProParser.l" return tSystemCommand; YY_BREAK case 320: YY_RULE_SETUP #line 379 "ProParser.l" return tTan; YY_BREAK case 321: YY_RULE_SETUP #line 380 "ProParser.l" return tTanh; YY_BREAK case 322: YY_RULE_SETUP #line 381 "ProParser.l" return tTarget; YY_BREAK case 323: YY_RULE_SETUP #line 382 "ProParser.l" return tTest; YY_BREAK case 324: YY_RULE_SETUP #line 383 "ProParser.l" return tTestLevel; YY_BREAK case 325: YY_RULE_SETUP #line 384 "ProParser.l" return tTheta; YY_BREAK case 326: YY_RULE_SETUP #line 385 "ProParser.l" return tTime0; YY_BREAK case 327: YY_RULE_SETUP #line 386 "ProParser.l" return tTimeFunction; YY_BREAK case 328: YY_RULE_SETUP #line 387 "ProParser.l" return tTimeLegend; YY_BREAK case 329: YY_RULE_SETUP #line 388 "ProParser.l" return tTimeLoopAdaptive; YY_BREAK case 330: YY_RULE_SETUP #line 389 "ProParser.l" return tTimeLoopNewmark; YY_BREAK case 331: YY_RULE_SETUP #line 390 "ProParser.l" return tTimeLoopRungeKutta; YY_BREAK case 332: YY_RULE_SETUP #line 391 "ProParser.l" return tTimeLoopTheta; YY_BREAK case 333: YY_RULE_SETUP #line 392 "ProParser.l" return tTimeMax; YY_BREAK case 334: YY_RULE_SETUP #line 393 "ProParser.l" return tTimeStep; YY_BREAK case 335: YY_RULE_SETUP #line 394 "ProParser.l" return tTimeValue; YY_BREAK case 336: YY_RULE_SETUP #line 395 "ProParser.l" return tTimeImagValue; YY_BREAK case 337: YY_RULE_SETUP #line 396 "ProParser.l" return tToleranceFactor; YY_BREAK case 338: YY_RULE_SETUP #line 397 "ProParser.l" return tTotalMemory; YY_BREAK case 339: YY_RULE_SETUP #line 398 "ProParser.l" return tTrace; YY_BREAK case 340: YY_RULE_SETUP #line 399 "ProParser.l" return tType; YY_BREAK case 341: YY_RULE_SETUP #line 401 "ProParser.l" return tUndefineConstant; YY_BREAK case 342: YY_RULE_SETUP #line 402 "ProParser.l" return tUpdate; YY_BREAK case 343: YY_RULE_SETUP #line 403 "ProParser.l" return tUpdateConstraint; YY_BREAK case 344: YY_RULE_SETUP #line 404 "ProParser.l" return tUpperCase; YY_BREAK case 345: YY_RULE_SETUP #line 405 "ProParser.l" return tLowerCase; YY_BREAK case 346: YY_RULE_SETUP #line 406 "ProParser.l" return tLowerCaseIn; YY_BREAK case 347: YY_RULE_SETUP #line 407 "ProParser.l" return tUsingPost; YY_BREAK case 348: YY_RULE_SETUP #line 409 "ProParser.l" return tValue; YY_BREAK case 349: YY_RULE_SETUP #line 410 "ProParser.l" return tValueIndex; YY_BREAK case 350: YY_RULE_SETUP #line 411 "ProParser.l" return tValueName; YY_BREAK case 351: YY_RULE_SETUP #line 413 "ProParser.l" return tWithArgument; YY_BREAK case 352: YY_RULE_SETUP #line 414 "ProParser.l" return tWhile; YY_BREAK case 353: YY_RULE_SETUP #line 415 "ProParser.l" return tWrite; YY_BREAK case 354: YY_RULE_SETUP #line 417 "ProParser.l" { getdp_yylval.i = atoi(getdp_yytext); return tINT; } YY_BREAK case 355: #line 420 "ProParser.l" case 356: #line 421 "ProParser.l" case 357: YY_RULE_SETUP #line 421 "ProParser.l" { getdp_yylval.d = atof(getdp_yytext); return tFLOAT; } YY_BREAK case 358: YY_RULE_SETUP #line 423 "ProParser.l" { getdp_yylval.c = strSave(getdp_yytext); return tSTRING; } YY_BREAK case 359: YY_RULE_SETUP #line 425 "ProParser.l" return getdp_yytext[0]; YY_BREAK case 360: YY_RULE_SETUP #line 427 "ProParser.l" ECHO; YY_BREAK #line 3906 "ProParser.yy.cpp" case YY_END_OF_BUFFER: { /* Amount of text matched not including the EOB char. */ int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1; /* Undo the effects of YY_DO_BEFORE_ACTION. */ *yy_cp = (yy_hold_char); YY_RESTORE_YY_MORE_OFFSET if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW ) { /* We're scanning a new file or input source. It's * possible that this happened because the user * just pointed getdp_yyin at a new source and called * getdp_yylex(). If so, then we have to assure * consistency between YY_CURRENT_BUFFER and our * globals. Here is the right place to do so, because * this is the first action (other than possibly a * back-up) that will match for the new input source. */ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; YY_CURRENT_BUFFER_LVALUE->yy_input_file = getdp_yyin; YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL; } /* Note that here we test for yy_c_buf_p "<=" to the position * of the first EOB in the buffer, since yy_c_buf_p will * already have been incremented past the NUL character * (since all states make transitions on EOB to the * end-of-buffer state). Contrast this with the test * in input(). */ if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] ) { /* This was really a NUL. */ yy_state_type yy_next_state; (yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text; yy_current_state = yy_get_previous_state( ); /* Okay, we're now positioned to make the NUL * transition. We couldn't have * yy_get_previous_state() go ahead and do it * for us because it doesn't know how to deal * with the possibility of jamming (and we don't * want to build jamming into it because then it * will run more slowly). */ yy_next_state = yy_try_NUL_trans( yy_current_state ); yy_bp = (yytext_ptr) + YY_MORE_ADJ; if ( yy_next_state ) { /* Consume the NUL. */ yy_cp = ++(yy_c_buf_p); yy_current_state = yy_next_state; goto yy_match; } else { yy_cp = (yy_c_buf_p); goto yy_find_action; } } else switch ( yy_get_next_buffer( ) ) { case EOB_ACT_END_OF_FILE: { (yy_did_buffer_switch_on_eof) = 0; if ( getdp_yywrap( ) ) { /* Note: because we've taken care in * yy_get_next_buffer() to have set up * getdp_yytext, we can now set up * yy_c_buf_p so that if some total * hoser (like flex itself) wants to * call the scanner after we return the * YY_NULL, it'll still work - another * YY_NULL will get returned. */ (yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ; yy_act = YY_STATE_EOF(YY_START); goto do_action; } else { if ( ! (yy_did_buffer_switch_on_eof) ) YY_NEW_FILE; } break; } case EOB_ACT_CONTINUE_SCAN: (yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text; yy_current_state = yy_get_previous_state( ); yy_cp = (yy_c_buf_p); yy_bp = (yytext_ptr) + YY_MORE_ADJ; goto yy_match; case EOB_ACT_LAST_MATCH: (yy_c_buf_p) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)]; yy_current_state = yy_get_previous_state( ); yy_cp = (yy_c_buf_p); yy_bp = (yytext_ptr) + YY_MORE_ADJ; goto yy_find_action; } break; } default: YY_FATAL_ERROR( "fatal flex scanner internal error--no action found" ); } /* end of action switch */ } /* end of scanning one token */ } /* end of getdp_yylex */ /* yy_get_next_buffer - try to read in a new buffer * * Returns a code representing an action: * EOB_ACT_LAST_MATCH - * EOB_ACT_CONTINUE_SCAN - continue scanning from current position * EOB_ACT_END_OF_FILE - end of file */ static int yy_get_next_buffer (void) { register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf; register char *source = (yytext_ptr); register int number_to_move, i; int ret_val; if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] ) YY_FATAL_ERROR( "fatal flex scanner internal error--end of buffer missed" ); if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 ) { /* Don't try to fill the buffer, so this is an EOF. */ if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 ) { /* We matched a single character, the EOB, so * treat this as a final EOF. */ return EOB_ACT_END_OF_FILE; } else { /* We matched some text prior to the EOB, first * process it. */ return EOB_ACT_LAST_MATCH; } } /* Try to read more data. */ /* First move last chars to start of buffer. */ number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1; for ( i = 0; i < number_to_move; ++i ) *(dest++) = *(source++); if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING ) /* don't do the read, it's not guaranteed to return an EOF, * just force an EOF */ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0; else { yy_size_t num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; while ( num_to_read <= 0 ) { /* Not enough room in the buffer - grow it. */ /* just a shorter name for the current buffer */ YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE; int yy_c_buf_p_offset = (int) ((yy_c_buf_p) - b->yy_ch_buf); if ( b->yy_is_our_buffer ) { yy_size_t new_size = b->yy_buf_size * 2; if ( new_size <= 0 ) b->yy_buf_size += b->yy_buf_size / 8; else b->yy_buf_size *= 2; b->yy_ch_buf = (char *) /* Include room in for 2 EOB chars. */ getdp_yyrealloc((void *) b->yy_ch_buf,b->yy_buf_size + 2 ); } else /* Can't grow it, we don't own it. */ b->yy_ch_buf = 0; if ( ! b->yy_ch_buf ) YY_FATAL_ERROR( "fatal error - scanner input buffer overflow" ); (yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset]; num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; } if ( num_to_read > YY_READ_BUF_SIZE ) num_to_read = YY_READ_BUF_SIZE; /* Read in more data. */ YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]), (yy_n_chars), num_to_read ); YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); } if ( (yy_n_chars) == 0 ) { if ( number_to_move == YY_MORE_ADJ ) { ret_val = EOB_ACT_END_OF_FILE; getdp_yyrestart(getdp_yyin ); } else { ret_val = EOB_ACT_LAST_MATCH; YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_EOF_PENDING; } } else ret_val = EOB_ACT_CONTINUE_SCAN; if ((yy_size_t) ((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) { /* Extend the array by 50%, plus the number we really need. */ yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1); YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) getdp_yyrealloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size ); if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" ); } (yy_n_chars) += number_to_move; YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR; YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR; (yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0]; return ret_val; } /* yy_get_previous_state - get the state just before the EOB char was reached */ static yy_state_type yy_get_previous_state (void) { register yy_state_type yy_current_state; register char *yy_cp; yy_current_state = (yy_start); for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp ) { register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1); if ( yy_accept[yy_current_state] ) { (yy_last_accepting_state) = yy_current_state; (yy_last_accepting_cpos) = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 2343 ) yy_c = yy_meta[(unsigned int) yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c]; } return yy_current_state; } /* yy_try_NUL_trans - try to make a transition on the NUL character * * synopsis * next_state = yy_try_NUL_trans( current_state ); */ static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state ) { register int yy_is_jam; register char *yy_cp = (yy_c_buf_p); register YY_CHAR yy_c = 1; if ( yy_accept[yy_current_state] ) { (yy_last_accepting_state) = yy_current_state; (yy_last_accepting_cpos) = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 2343 ) yy_c = yy_meta[(unsigned int) yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c]; yy_is_jam = (yy_current_state == 2342); return yy_is_jam ? 0 : yy_current_state; } static void yyunput (int c, register char * yy_bp ) { register char *yy_cp; yy_cp = (yy_c_buf_p); /* undo effects of setting up getdp_yytext */ *yy_cp = (yy_hold_char); if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 ) { /* need to shift things up to make room */ /* +2 for EOB chars. */ register yy_size_t number_to_move = (yy_n_chars) + 2; register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[ YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2]; register char *source = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]; while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) *--dest = *--source; yy_cp += (int) (dest - source); yy_bp += (int) (dest - source); YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_buf_size; if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 ) YY_FATAL_ERROR( "flex scanner push-back overflow" ); } *--yy_cp = (char) c; (yytext_ptr) = yy_bp; (yy_hold_char) = *yy_cp; (yy_c_buf_p) = yy_cp; } #ifndef YY_NO_INPUT #ifdef __cplusplus static int yyinput (void) #else static int input (void) #endif { int c; *(yy_c_buf_p) = (yy_hold_char); if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR ) { /* yy_c_buf_p now points to the character we want to return. * If this occurs *before* the EOB characters, then it's a * valid NUL; if not, then we've hit the end of the buffer. */ if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] ) /* This was really a NUL. */ *(yy_c_buf_p) = '\0'; else { /* need more input */ yy_size_t offset = (yy_c_buf_p) - (yytext_ptr); ++(yy_c_buf_p); switch ( yy_get_next_buffer( ) ) { case EOB_ACT_LAST_MATCH: /* This happens because yy_g_n_b() * sees that we've accumulated a * token and flags that we need to * try matching the token before * proceeding. But for input(), * there's no matching to consider. * So convert the EOB_ACT_LAST_MATCH * to EOB_ACT_END_OF_FILE. */ /* Reset buffer status. */ getdp_yyrestart(getdp_yyin ); /*FALLTHROUGH*/ case EOB_ACT_END_OF_FILE: { if ( getdp_yywrap( ) ) return EOF; if ( ! (yy_did_buffer_switch_on_eof) ) YY_NEW_FILE; #ifdef __cplusplus return yyinput(); #else return input(); #endif } case EOB_ACT_CONTINUE_SCAN: (yy_c_buf_p) = (yytext_ptr) + offset; break; } } } c = *(unsigned char *) (yy_c_buf_p); /* cast for 8-bit char's */ *(yy_c_buf_p) = '\0'; /* preserve getdp_yytext */ (yy_hold_char) = *++(yy_c_buf_p); return c; } #endif /* ifndef YY_NO_INPUT */ /** Immediately switch to a different input stream. * @param input_file A readable stream. * * @note This function does not reset the start condition to @c INITIAL . */ void getdp_yyrestart (FILE * input_file ) { if ( ! YY_CURRENT_BUFFER ){ getdp_yyensure_buffer_stack (); YY_CURRENT_BUFFER_LVALUE = getdp_yy_create_buffer(getdp_yyin,YY_BUF_SIZE ); } getdp_yy_init_buffer(YY_CURRENT_BUFFER,input_file ); getdp_yy_load_buffer_state( ); } /** Switch to a different input buffer. * @param new_buffer The new input buffer. * */ void getdp_yy_switch_to_buffer (YY_BUFFER_STATE new_buffer ) { /* TODO. We should be able to replace this entire function body * with * getdp_yypop_buffer_state(); * getdp_yypush_buffer_state(new_buffer); */ getdp_yyensure_buffer_stack (); if ( YY_CURRENT_BUFFER == new_buffer ) return; if ( YY_CURRENT_BUFFER ) { /* Flush out information for old buffer. */ *(yy_c_buf_p) = (yy_hold_char); YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p); YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); } YY_CURRENT_BUFFER_LVALUE = new_buffer; getdp_yy_load_buffer_state( ); /* We don't actually know whether we did this switch during * EOF (getdp_yywrap()) processing, but the only time this flag * is looked at is after getdp_yywrap() is called, so it's safe * to go ahead and always set it. */ (yy_did_buffer_switch_on_eof) = 1; } static void getdp_yy_load_buffer_state (void) { (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; (yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos; getdp_yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file; (yy_hold_char) = *(yy_c_buf_p); } /** Allocate and initialize an input buffer state. * @param file A readable stream. * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE. * * @return the allocated buffer state. */ YY_BUFFER_STATE getdp_yy_create_buffer (FILE * file, int size ) { YY_BUFFER_STATE b; b = (YY_BUFFER_STATE) getdp_yyalloc(sizeof( struct yy_buffer_state ) ); if ( ! b ) YY_FATAL_ERROR( "out of dynamic memory in getdp_yy_create_buffer()" ); b->yy_buf_size = size; /* yy_ch_buf has to be 2 characters longer than the size given because * we need to put in 2 end-of-buffer characters. */ b->yy_ch_buf = (char *) getdp_yyalloc(b->yy_buf_size + 2 ); if ( ! b->yy_ch_buf ) YY_FATAL_ERROR( "out of dynamic memory in getdp_yy_create_buffer()" ); b->yy_is_our_buffer = 1; getdp_yy_init_buffer(b,file ); return b; } /** Destroy the buffer. * @param b a buffer created with getdp_yy_create_buffer() * */ void getdp_yy_delete_buffer (YY_BUFFER_STATE b ) { if ( ! b ) return; if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */ YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0; if ( b->yy_is_our_buffer ) getdp_yyfree((void *) b->yy_ch_buf ); getdp_yyfree((void *) b ); } /* Initializes or reinitializes a buffer. * This function is sometimes called more than once on the same buffer, * such as during a getdp_yyrestart() or at EOF. */ static void getdp_yy_init_buffer (YY_BUFFER_STATE b, FILE * file ) { int oerrno = errno; getdp_yy_flush_buffer(b ); b->yy_input_file = file; b->yy_fill_buffer = 1; /* If b is the current buffer, then getdp_yy_init_buffer was _probably_ * called from getdp_yyrestart() or through yy_get_next_buffer. * In that case, we don't want to reset the lineno or column. */ if (b != YY_CURRENT_BUFFER){ b->yy_bs_lineno = 1; b->yy_bs_column = 0; } b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0; errno = oerrno; } /** Discard all buffered characters. On the next scan, YY_INPUT will be called. * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER. * */ void getdp_yy_flush_buffer (YY_BUFFER_STATE b ) { if ( ! b ) return; b->yy_n_chars = 0; /* We always need two end-of-buffer characters. The first causes * a transition to the end-of-buffer state. The second causes * a jam in that state. */ b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR; b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR; b->yy_buf_pos = &b->yy_ch_buf[0]; b->yy_at_bol = 1; b->yy_buffer_status = YY_BUFFER_NEW; if ( b == YY_CURRENT_BUFFER ) getdp_yy_load_buffer_state( ); } /** Pushes the new state onto the stack. The new state becomes * the current state. This function will allocate the stack * if necessary. * @param new_buffer The new state. * */ void getdp_yypush_buffer_state (YY_BUFFER_STATE new_buffer ) { if (new_buffer == NULL) return; getdp_yyensure_buffer_stack(); /* This block is copied from getdp_yy_switch_to_buffer. */ if ( YY_CURRENT_BUFFER ) { /* Flush out information for old buffer. */ *(yy_c_buf_p) = (yy_hold_char); YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p); YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); } /* Only push if top exists. Otherwise, replace top. */ if (YY_CURRENT_BUFFER) (yy_buffer_stack_top)++; YY_CURRENT_BUFFER_LVALUE = new_buffer; /* copied from getdp_yy_switch_to_buffer. */ getdp_yy_load_buffer_state( ); (yy_did_buffer_switch_on_eof) = 1; } /** Removes and deletes the top of the stack, if present. * The next element becomes the new top. * */ void getdp_yypop_buffer_state (void) { if (!YY_CURRENT_BUFFER) return; getdp_yy_delete_buffer(YY_CURRENT_BUFFER ); YY_CURRENT_BUFFER_LVALUE = NULL; if ((yy_buffer_stack_top) > 0) --(yy_buffer_stack_top); if (YY_CURRENT_BUFFER) { getdp_yy_load_buffer_state( ); (yy_did_buffer_switch_on_eof) = 1; } } /* Allocates the stack if it does not exist. * Guarantees space for at least one push. */ static void getdp_yyensure_buffer_stack (void) { yy_size_t num_to_alloc; if (!(yy_buffer_stack)) { /* First allocation is just for 2 elements, since we don't know if this * scanner will even need a stack. We use 2 instead of 1 to avoid an * immediate realloc on the next call. */ num_to_alloc = 1; (yy_buffer_stack) = (struct yy_buffer_state**)getdp_yyalloc (num_to_alloc * sizeof(struct yy_buffer_state*) ); if ( ! (yy_buffer_stack) ) YY_FATAL_ERROR( "out of dynamic memory in getdp_yyensure_buffer_stack()" ); memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*)); (yy_buffer_stack_max) = num_to_alloc; (yy_buffer_stack_top) = 0; return; } if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){ /* Increase the buffer to prepare for a possible push. */ int grow_size = 8 /* arbitrary grow size */; num_to_alloc = (yy_buffer_stack_max) + grow_size; (yy_buffer_stack) = (struct yy_buffer_state**)getdp_yyrealloc ((yy_buffer_stack), num_to_alloc * sizeof(struct yy_buffer_state*) ); if ( ! (yy_buffer_stack) ) YY_FATAL_ERROR( "out of dynamic memory in getdp_yyensure_buffer_stack()" ); /* zero only the new slots.*/ memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*)); (yy_buffer_stack_max) = num_to_alloc; } } /** Setup the input buffer state to scan directly from a user-specified character buffer. * @param base the character buffer * @param size the size in bytes of the character buffer * * @return the newly allocated buffer state object. */ YY_BUFFER_STATE getdp_yy_scan_buffer (char * base, yy_size_t size ) { YY_BUFFER_STATE b; if ( size < 2 || base[size-2] != YY_END_OF_BUFFER_CHAR || base[size-1] != YY_END_OF_BUFFER_CHAR ) /* They forgot to leave room for the EOB's. */ return 0; b = (YY_BUFFER_STATE) getdp_yyalloc(sizeof( struct yy_buffer_state ) ); if ( ! b ) YY_FATAL_ERROR( "out of dynamic memory in getdp_yy_scan_buffer()" ); b->yy_buf_size = size - 2; /* "- 2" to take care of EOB's */ b->yy_buf_pos = b->yy_ch_buf = base; b->yy_is_our_buffer = 0; b->yy_input_file = 0; b->yy_n_chars = b->yy_buf_size; b->yy_is_interactive = 0; b->yy_at_bol = 1; b->yy_fill_buffer = 0; b->yy_buffer_status = YY_BUFFER_NEW; getdp_yy_switch_to_buffer(b ); return b; } /** Setup the input buffer state to scan a string. The next call to getdp_yylex() will * scan from a @e copy of @a str. * @param yystr a NUL-terminated string to scan * * @return the newly allocated buffer state object. * @note If you want to scan bytes that may contain NUL values, then use * getdp_yy_scan_bytes() instead. */ YY_BUFFER_STATE getdp_yy_scan_string (yyconst char * yystr ) { return getdp_yy_scan_bytes(yystr,strlen(yystr) ); } /** Setup the input buffer state to scan the given bytes. The next call to getdp_yylex() will * scan from a @e copy of @a bytes. * @param yybytes the byte buffer to scan * @param _yybytes_len the number of bytes in the buffer pointed to by @a bytes. * * @return the newly allocated buffer state object. */ YY_BUFFER_STATE getdp_yy_scan_bytes (yyconst char * yybytes, yy_size_t _yybytes_len ) { YY_BUFFER_STATE b; char *buf; yy_size_t n; int i; /* Get memory for full buffer, including space for trailing EOB's. */ n = _yybytes_len + 2; buf = (char *) getdp_yyalloc(n ); if ( ! buf ) YY_FATAL_ERROR( "out of dynamic memory in getdp_yy_scan_bytes()" ); for ( i = 0; i < _yybytes_len; ++i ) buf[i] = yybytes[i]; buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR; b = getdp_yy_scan_buffer(buf,n ); if ( ! b ) YY_FATAL_ERROR( "bad buffer in getdp_yy_scan_bytes()" ); /* It's okay to grow etc. this buffer, and we should throw it * away when we're done. */ b->yy_is_our_buffer = 1; return b; } #ifndef YY_EXIT_FAILURE #define YY_EXIT_FAILURE 2 #endif static void yy_fatal_error (yyconst char* msg ) { (void) fprintf( stderr, "%s\n", msg ); exit( YY_EXIT_FAILURE ); } /* Redefine yyless() so it works in section 3 code. */ #undef yyless #define yyless(n) \ do \ { \ /* Undo effects of setting up getdp_yytext. */ \ int yyless_macro_arg = (n); \ YY_LESS_LINENO(yyless_macro_arg);\ getdp_yytext[getdp_yyleng] = (yy_hold_char); \ (yy_c_buf_p) = getdp_yytext + yyless_macro_arg; \ (yy_hold_char) = *(yy_c_buf_p); \ *(yy_c_buf_p) = '\0'; \ getdp_yyleng = yyless_macro_arg; \ } \ while ( 0 ) /* Accessor methods (get/set functions) to struct members. */ /** Get the current line number. * */ int getdp_yyget_lineno (void) { return getdp_yylineno; } /** Get the input stream. * */ FILE *getdp_yyget_in (void) { return getdp_yyin; } /** Get the output stream. * */ FILE *getdp_yyget_out (void) { return getdp_yyout; } /** Get the length of the current token. * */ yy_size_t getdp_yyget_leng (void) { return getdp_yyleng; } /** Get the current token. * */ char *getdp_yyget_text (void) { return getdp_yytext; } /** Set the current line number. * @param line_number * */ void getdp_yyset_lineno (int line_number ) { getdp_yylineno = line_number; } /** Set the input stream. This does not discard the current * input buffer. * @param in_str A readable stream. * * @see getdp_yy_switch_to_buffer */ void getdp_yyset_in (FILE * in_str ) { getdp_yyin = in_str ; } void getdp_yyset_out (FILE * out_str ) { getdp_yyout = out_str ; } int getdp_yyget_debug (void) { return getdp_yy_flex_debug; } void getdp_yyset_debug (int bdebug ) { getdp_yy_flex_debug = bdebug ; } static int yy_init_globals (void) { /* Initialization is the same as for the non-reentrant scanner. * This function is called from getdp_yylex_destroy(), so don't allocate here. */ (yy_buffer_stack) = 0; (yy_buffer_stack_top) = 0; (yy_buffer_stack_max) = 0; (yy_c_buf_p) = (char *) 0; (yy_init) = 0; (yy_start) = 0; /* Defined in main.c */ #ifdef YY_STDINIT getdp_yyin = stdin; getdp_yyout = stdout; #else getdp_yyin = (FILE *) 0; getdp_yyout = (FILE *) 0; #endif /* For future reference: Set errno on error, since we are called by * getdp_yylex_init() */ return 0; } /* getdp_yylex_destroy is for both reentrant and non-reentrant scanners. */ int getdp_yylex_destroy (void) { /* Pop the buffer stack, destroying each element. */ while(YY_CURRENT_BUFFER){ getdp_yy_delete_buffer(YY_CURRENT_BUFFER ); YY_CURRENT_BUFFER_LVALUE = NULL; getdp_yypop_buffer_state(); } /* Destroy the stack itself. */ getdp_yyfree((yy_buffer_stack) ); (yy_buffer_stack) = NULL; /* Reset the globals. This is important in a non-reentrant scanner so the next time * getdp_yylex() is called, initialization will occur. */ yy_init_globals( ); return 0; } /* * Internal utility routines. */ #ifndef yytext_ptr static void yy_flex_strncpy (char* s1, yyconst char * s2, int n ) { register int i; for ( i = 0; i < n; ++i ) s1[i] = s2[i]; } #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen (yyconst char * s ) { register int n; for ( n = 0; s[n]; ++n ) ; return n; } #endif void *getdp_yyalloc (yy_size_t size ) { return (void *) malloc( size ); } void *getdp_yyrealloc (void * ptr, yy_size_t size ) { /* The cast to (char *) in the following accommodates both * implementations that use char* generic pointers, and those * that use void* generic pointers. It works with the latter * because both ANSI C and C++ allow castless assignment from * any pointer type to void*, and deal with argument conversions * as though doing an assignment. */ return (void *) realloc( (char *) ptr, size ); } void getdp_yyfree (void * ptr ) { free( (char *) ptr ); /* see getdp_yyrealloc() for (char *) cast */ } #define YYTABLES_NAME "yytables" #line 427 "ProParser.l" #undef getdp_yywrap int getdp_yywrap() { return 1; } #ifdef __cplusplus #define input yyinput #endif #ifndef yytext_ptr #define yytext_ptr getdp_yytext #endif char *strSave(const char *string) { return ((char *)strcpy((char *)Malloc(strlen(string)+1), string)); } void cStyleComments() { int c; while(1) { while((c = input()) != '*'){ if(c == '\n') getdp_yylinenum++; if(feof(getdp_yyin)) { Message::Error("End of file in commented region"); exit(1); } } if((c = input()) == '/') return; unput(c); } } void cxxStyleComments() { int c; while(1){ c = input(); if(c == '\n' || feof(getdp_yyin)) break; } getdp_yylinenum++; } void parseString(char endchar) { char tmp[2048]; int c = input(); int i = 0; while(c != endchar){ if(feof(getdp_yyin)) { Message::Error("End of file in string"); getdp_yycolnum = 0; break; } else if(c == '\n') { getdp_yycolnum = 0; } else if(i >= (int)sizeof(tmp)-1) { Message::Error("String too long"); break; } else { tmp[i++] = c; } c = input(); } tmp[i] = '\0'; getdp_yylval.c = strSave(tmp); } static bool is_alpha(const int c) { return (c>='a' && c<='z') || (c>='A' && c<='Z') || c=='_'; } void skipUntil(const char *skip, const char *until) { int l_skip, l_until, l_max, l; char chars[256]; int c_next, c_next_skip, c_next_until, c_previous = 0; int nb_skip = 0; l_skip = (skip)? strlen(skip) : 0; l_until = strlen(until); l_max = (l_skip > l_until) ? l_skip : l_until; if(l_max >= (int)sizeof(chars)){ Message::Error("Search pattern too long in skipUntil"); return; } while(1){ while (1){ chars[0] = input(); if(chars[0] == '\n') getdp_yylinenum++; if(feof(getdp_yyin)){ Message::Error("Unexpected end of file"); return; } if(chars[0] == '/'){ c_next = input(); if (c_next == '*') cStyleComments(); else if(c_next == '/') cxxStyleComments(); else unput(c_next); } if(!c_previous || !is_alpha(c_previous)){ if(chars[0] == until[0]) break; if(skip && chars[0] == skip[0]) break; } c_previous = chars[0]; } l = l_max; for(int i = 1; i < l; i++){ chars[i] = input(); if(chars[i] == '\n') getdp_yylinenum++; if(feof(getdp_yyin)){ l = i; break; } } c_next = input(); unput(c_next); c_next_skip = (l_skip0 for skip="For" and until="EndFor", or skip="If" and // until="EndIf"); in particular, because "If" is followed by a minimum of // 3 chars (e.g., '(1)'), with a total lenght thus exactly equal to the // one of "EndIf", one avoid an error when looking then for // "EndIf". (Patrick) } else{ for(int i = 1; i < l - 1; i++){ unput(chars[l-i]); if(chars[l-i] == '\n') getdp_yylinenum--; } } } } void skipUntil_test(const char *skip, const char *until, const char *until2, int l_until2_sub, int *type_until2) { int l_skip, l_until, l_until2, l_max, l; char chars[256]; int c_next, c_next_skip, c_next_until, c_next_until2, c_previous = 0, flag_EOL_EOF = 0; int nb_skip = 0; l_skip = (skip)? strlen(skip) : 0; l_until = strlen(until); l_until2 = (until2)? strlen(until2) : 0; l_max = (l_skip > l_until) ? l_skip : l_until; l_max = (l_until2 > l_max) ? l_until2 : l_max; if(l_max >= (int)sizeof(chars)){ Message::Error("Search pattern too long in skipUntil_test"); return; } while(1){ while (1){ chars[0] = input(); if(chars[0] == '\n') getdp_yylinenum++; if(feof(getdp_yyin)){ Message::Error("Unexpected end of file"); return; } if(chars[0] == '/'){ c_next = input(); if (c_next == '*') cStyleComments(); else if(c_next == '/') cxxStyleComments(); else unput(c_next); } if(!c_previous || !is_alpha(c_previous)){ if(chars[0] == until[0]) break; if(skip && chars[0] == skip[0]) break; if(!nb_skip && until2 && chars[0] == until2[0]) break; // Useless to search for until2 if nb_skip!=0 } c_previous = chars[0]; } l = l_max; flag_EOL_EOF = 0; for(int i = 1; i < l; i++){ chars[i] = input(); if(chars[i] == '\n'){ // getdp_yylinenum++; unput(chars[i]); chars[i] = 0; l = i; flag_EOL_EOF = 1; break; } if(feof(getdp_yyin)){ l = i; flag_EOL_EOF = 1; break; } } if(!flag_EOL_EOF){ c_next = input(); unput(c_next); c_next_skip = (l_skip. */ /* As a special exception, you may create a larger work that contains part or all of the Bison parser skeleton and distribute that work under terms of your choice, so long as that work isn't itself a parser generator using the skeleton or a modified version thereof as a parser skeleton. Alternatively, if you modify or redistribute the parser skeleton itself, you may (at your option) remove this special exception, which will cause the skeleton and the resulting Bison output files to be licensed under the GNU General Public License without this special exception. This special exception was added by the Free Software Foundation in version 2.2 of Bison. */ /* C LALR(1) parser skeleton written by Richard Stallman, by simplifying the original so-called "semantic" parser. */ /* All symbols defined below should begin with yy or YY, to avoid infringing on user name space. This should be done even for local variables, as they might otherwise be expanded by user macros. There are some unavoidable exceptions within include files to define necessary library symbols; they are noted "INFRINGES ON USER NAME SPACE" below. */ /* Identify Bison output. */ #define YYBISON 1 /* Bison version. */ #define YYBISON_VERSION "3.0.4" /* Skeleton name. */ #define YYSKELETON_NAME "yacc.c" /* Pure parsers. */ #define YYPURE 0 /* Push parsers. */ #define YYPUSH 0 /* Pull parsers. */ #define YYPULL 1 /* Substitute the variable and function names. */ #define yyparse getdp_yyparse #define yylex getdp_yylex #define yyerror getdp_yyerror #define yydebug getdp_yydebug #define yynerrs getdp_yynerrs #define yylval getdp_yylval #define yychar getdp_yychar /* Copy the first part of user declarations. */ #line 1 "ProParser.y" /* yacc.c:339 */ // GetDP - Copyright (C) 1997-2015 P. Dular, C. Geuzaine // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Ruth Sabariego // Johan Gyselinck // #include #include #include #include #include #include #include #include #include "GetDPConfig.h" #include "GetDPVersion.h" #include "ProData.h" #include "ProDefine.h" #include "ProDefines.h" #include "ProParser.h" #include "MacroManager.h" #include "MallocUtils.h" #include "TreeUtils.h" #include "Message.h" #include "OS.h" // Global problem structure filled by the parser extern struct Problem Problem_S; // Global parser variables std::string getdp_yyname; char getdp_yyincludename[256] = ""; long int getdp_yylinenum = 0; int getdp_yycolnum = 0; int getdp_yyincludenum = 0; int getdp_yyerrorlevel = 0; std::map > CommandLineNumbers; std::map CommandLineStrings; // Static parser variables (accessible only in this file) static Tree_T *ConstantTable_L = 0; static List_T *ListOfInt_L = 0; static List_T *ListOfPointer_L = 0, *ListOfPointer2_L = 0, *ListOfChar_L = 0; static List_T *ListOfFormulation = 0, *ListOfBasisFunction = 0, *ListOfEntityIndex = 0; static List_T *Operation_L = 0; static List_T *Current_BasisFunction_L = 0, *Current_SubSpace_L = 0; static List_T *Current_GlobalQuantity_L = 0, *Current_WholeQuantity_L = 0; static List_T *Current_System_L = 0; static int Num_BasisFunction = 1; static int FlagError = 0; static int Type_TermOperator = 0, Type_Function = 0, Type_SuppList = 0; static int Quantity_TypeOperator = 0, Quantity_Index = 0; static int Current_DofIndexInWholeQuantity = 0, Last_DofIndexInWholeQuantity = 0; static int Current_NoDofIndexInWholeQuantity = 0; static int Current_System = 0, Constraint_Index = 0; static int TypeOperatorDofInTrace = 0, DefineQuantityIndexDofInTrace = 0; static int ImbricatedLoop = 0, ImbricatedTest = 0; static char *StringForParameter = 0; #define MAX_RECUR_TESTS 100 static int statusImbricatedTests[MAX_RECUR_TESTS]; #define MAX_RECUR_LOOPS 100 static fpos_t FposImbricatedLoopsTab[MAX_RECUR_LOOPS]; static int LinenoImbricatedLoopsTab[MAX_RECUR_LOOPS]; static double LoopControlVariablesTab[MAX_RECUR_LOOPS][3]; static char *LoopControlVariablesNameTab[MAX_RECUR_LOOPS]; static struct Constant Constant_S, Constant1_S, Constant2_S; static struct Expression Expression_S, *Expression_P; static struct ExpressionPerRegion ExpressionPerRegion_S; static struct Group Group_S; static struct Constraint Constraint_S, *Constraint_P; static struct ConstraintPerRegion ConstraintPerRegion_S, *ConstraintPerRegion_P; static struct MultiConstraintPerRegion MultiConstraintPerRegion_S; static struct JacobianMethod JacobianMethod_S; static struct JacobianCase JacobianCase_S; static struct IntegrationMethod IntegrationMethod_S; static struct IntegrationCase IntegrationCase_S; static struct Quadrature QuadratureCase_S; static struct FunctionSpace FunctionSpace_S; static struct BasisFunction BasisFunction_S; static struct GlobalBasisFunction GlobalBasisFunction_S; static struct SubSpace SubSpace_S; static struct GlobalQuantity GlobalQuantity_S; static struct ConstraintInFS ConstraintInFS_S; static struct Formulation Formulation_S; static struct DefineQuantity DefineQuantity_S; static struct EquationTerm EquationTerm_S; static struct WholeQuantity WholeQuantity_S, *WholeQuantity_P; static struct GlobalEquationTerm GlobalEquationTerm_S; static struct Resolution Resolution_S; static struct DefineSystem DefineSystem_S; static struct Operation Operation_S, *Operation_P; static struct ChangeOfState ChangeOfState_S; static struct TimeLoopAdaptiveSystem TimeLoopAdaptiveSystem_S; static struct LoopErrorPostOperation TimeLoopAdaptivePO_S, IterativeLoopPO_S; static struct IterativeLoopSystem IterativeLoopSystem_S; static struct PostProcessing PostProcessing_S, InteractivePostProcessing_S; static struct PostQuantity PostQuantity_S; static struct PostQuantityTerm PostQuantityTerm_S; static struct PostOperation PostOperation_S; static struct PostSubOperation PostSubOperation_S; static std::map > FloatOptions_S; static std::map > CharOptions_S; // External lexer functions void hack_fsetpos(); void hack_fsetpos_printf(); int getdp_yylex(); // Forward function declarations void Alloc_ParserVariables(); void Check_NameOfStructNotExist(const char *Struct, List_T *List_L, void *data, int (*fcmp)(const void *a, const void *b)); int Add_Group(struct Group *Group_P, char *Name, bool Flag_Add, int Flag_Plus, int Num_Index); int Num_Group(struct Group *Group_P, char *Name, int Num_Group); void Fill_GroupInitialListFromString(List_T *list, const char *str); int Add_Expression(struct Expression *Expression_P, char *Name, int Flag_Plus); bool Is_ExpressionPieceWiseDefined(int index); void Pro_DefineQuantityIndex(List_T *WholeQuantity_L,int DefineQuantityIndexEqu, int *NbrQuantityIndex, int **QuantityIndexTable, int **QuantityTraceGroupIndexTable); void Pro_DefineQuantityIndex_1(List_T *WholeQuantity_L, int TraceGroupIndex); void yyerror(const char *s); void vyyerror(const char *fmt, ...); struct doubleXstring{ double d; char *s; }; #line 217 "ProParser.tab.cpp" /* yacc.c:339 */ # ifndef YY_NULLPTR # if defined __cplusplus && 201103L <= __cplusplus # define YY_NULLPTR nullptr # else # define YY_NULLPTR 0 # endif # endif /* Enabling verbose error messages. */ #ifdef YYERROR_VERBOSE # undef YYERROR_VERBOSE # define YYERROR_VERBOSE 1 #else # define YYERROR_VERBOSE 0 #endif /* In a future release of Bison, this section will be replaced by #include "ProParser.tab.hpp". */ #ifndef YY_GETDP_YY_PROPARSER_TAB_HPP_INCLUDED # define YY_GETDP_YY_PROPARSER_TAB_HPP_INCLUDED /* Debug traces. */ #ifndef YYDEBUG # define YYDEBUG 0 #endif #if YYDEBUG extern int getdp_yydebug; #endif /* Token type. */ #ifndef YYTOKENTYPE # define YYTOKENTYPE enum yytokentype { tINT = 258, tFLOAT = 259, tSTRING = 260, tBIGSTR = 261, tEND = 262, tDOTS = 263, tStrCat = 264, tSprintf = 265, tPrintf = 266, tMPI_Printf = 267, tRead = 268, tPrintConstants = 269, tStrCmp = 270, tStrChoice = 271, tUpperCase = 272, tLowerCase = 273, tLowerCaseIn = 274, tNbrRegions = 275, tGetRegion = 276, tNameFromString = 277, tStringFromName = 278, tFor = 279, tEndFor = 280, tIf = 281, tElseIf = 282, tElse = 283, tEndIf = 284, tMacro = 285, tReturn = 286, tCall = 287, tCallTest = 288, tTest = 289, tWhile = 290, tFlag = 291, tInclude = 292, tConstant = 293, tList = 294, tListAlt = 295, tLinSpace = 296, tLogSpace = 297, tListFromFile = 298, tChangeCurrentPosition = 299, tDefineConstant = 300, tUndefineConstant = 301, tDefineNumber = 302, tDefineString = 303, tPi = 304, tMPI_Rank = 305, tMPI_Size = 306, t0D = 307, t1D = 308, t2D = 309, t3D = 310, tTestLevel = 311, tTotalMemory = 312, tCurrentDirectory = 313, tGETDP_MAJOR_VERSION = 314, tGETDP_MINOR_VERSION = 315, tGETDP_PATCH_VERSION = 316, tExp = 317, tLog = 318, tLog10 = 319, tSqrt = 320, tSin = 321, tAsin = 322, tCos = 323, tAcos = 324, tTan = 325, tAtan = 326, tAtan2 = 327, tSinh = 328, tCosh = 329, tTanh = 330, tFabs = 331, tFloor = 332, tCeil = 333, tRound = 334, tSign = 335, tFmod = 336, tModulo = 337, tHypot = 338, tRand = 339, tSolidAngle = 340, tTrace = 341, tOrder = 342, tCrossProduct = 343, tDofValue = 344, tMHTransform = 345, tMHJacNL = 346, tGroup = 347, tDefineGroup = 348, tAll = 349, tInSupport = 350, tMovingBand2D = 351, tDefineFunction = 352, tConstraint = 353, tRegion = 354, tSubRegion = 355, tRegionRef = 356, tSubRegionRef = 357, tFilter = 358, tToleranceFactor = 359, tCoefficient = 360, tValue = 361, tTimeFunction = 362, tBranch = 363, tNameOfResolution = 364, tJacobian = 365, tCase = 366, tMetricTensor = 367, tIntegration = 368, tType = 369, tSubType = 370, tCriterion = 371, tGeoElement = 372, tNumberOfPoints = 373, tMaxNumberOfPoints = 374, tNumberOfDivisions = 375, tMaxNumberOfDivisions = 376, tStoppingCriterion = 377, tFunctionSpace = 378, tName = 379, tBasisFunction = 380, tNameOfCoef = 381, tFunction = 382, tdFunction = 383, tSubFunction = 384, tSubdFunction = 385, tSupport = 386, tEntity = 387, tSubSpace = 388, tNameOfBasisFunction = 389, tGlobalQuantity = 390, tEntityType = 391, tEntitySubType = 392, tNameOfConstraint = 393, tFormulation = 394, tQuantity = 395, tNameOfSpace = 396, tIndexOfSystem = 397, tSymmetry = 398, tGalerkin = 399, tdeRham = 400, tGlobalTerm = 401, tGlobalEquation = 402, tDt = 403, tDtDof = 404, tDtDt = 405, tDtDtDof = 406, tDtDtDtDof = 407, tDtDtDtDtDof = 408, tDtDtDtDtDtDof = 409, tJacNL = 410, tDtDofJacNL = 411, tNeverDt = 412, tDtNL = 413, tAtAnteriorTimeStep = 414, tMaxOverTime = 415, tFourierSteinmetz = 416, tIn = 417, tFull_Matrix = 418, tResolution = 419, tHidden = 420, tDefineSystem = 421, tNameOfFormulation = 422, tNameOfMesh = 423, tFrequency = 424, tSolver = 425, tOriginSystem = 426, tDestinationSystem = 427, tOperation = 428, tOperationEnd = 429, tSetTime = 430, tSetTimeStep = 431, tDTime = 432, tSetFrequency = 433, tFourierTransform = 434, tFourierTransformJ = 435, tLanczos = 436, tEigenSolve = 437, tEigenSolveJac = 438, tPerturbation = 439, tUpdate = 440, tUpdateConstraint = 441, tBreak = 442, tGetResidual = 443, tCreateSolution = 444, tEvaluate = 445, tSelectCorrection = 446, tAddCorrection = 447, tMultiplySolution = 448, tAddOppositeFullSolution = 449, tSolveAgainWithOther = 450, tSetGlobalSolverOptions = 451, tTimeLoopTheta = 452, tTimeLoopNewmark = 453, tTimeLoopRungeKutta = 454, tTimeLoopAdaptive = 455, tTime0 = 456, tTimeMax = 457, tTheta = 458, tBeta = 459, tGamma = 460, tIterativeLoop = 461, tIterativeLoopN = 462, tIterativeLinearSolver = 463, tNbrMaxIteration = 464, tRelaxationFactor = 465, tIterativeTimeReduction = 466, tSetCommSelf = 467, tSetCommWorld = 468, tBarrier = 469, tBroadcastFields = 470, tSleep = 471, tDivisionCoefficient = 472, tChangeOfState = 473, tChangeOfCoordinates = 474, tChangeOfCoordinates2 = 475, tSystemCommand = 476, tError = 477, tGmshRead = 478, tGmshMerge = 479, tGmshOpen = 480, tGmshWrite = 481, tGmshClearAll = 482, tDelete = 483, tDeleteFile = 484, tRenameFile = 485, tCreateDir = 486, tGenerateOnly = 487, tGenerateOnlyJac = 488, tSolveJac_AdaptRelax = 489, tSaveSolutionExtendedMH = 490, tSaveSolutionMHtoTime = 491, tSaveSolutionWithEntityNum = 492, tInitMovingBand2D = 493, tMeshMovingBand2D = 494, tGenerateMHMoving = 495, tGenerateMHMovingSeparate = 496, tAddMHMoving = 497, tGenerateGroup = 498, tGenerateJacGroup = 499, tGenerateRHSGroup = 500, tGenerateGroupCumulative = 501, tGenerateJacGroupCumulative = 502, tGenerateRHSGroupCumulative = 503, tSaveMesh = 504, tDeformMesh = 505, tFrequencySpectrum = 506, tPostProcessing = 507, tNameOfSystem = 508, tPostOperation = 509, tNameOfPostProcessing = 510, tUsingPost = 511, tAppend = 512, tResampleTime = 513, tPlot = 514, tPrint = 515, tPrintGroup = 516, tEcho = 517, tSendMergeFileRequest = 518, tWrite = 519, tAdapt = 520, tOnGlobal = 521, tOnRegion = 522, tOnElementsOf = 523, tOnGrid = 524, tOnSection = 525, tOnPoint = 526, tOnLine = 527, tOnPlane = 528, tOnBox = 529, tWithArgument = 530, tFile = 531, tDepth = 532, tDimension = 533, tComma = 534, tTimeStep = 535, tHarmonicToTime = 536, tCosineTransform = 537, tValueIndex = 538, tValueName = 539, tFormat = 540, tHeader = 541, tFooter = 542, tSkin = 543, tSmoothing = 544, tTarget = 545, tSort = 546, tIso = 547, tNoNewLine = 548, tNoTitle = 549, tDecomposeInSimplex = 550, tChangeOfValues = 551, tTimeLegend = 552, tFrequencyLegend = 553, tEigenvalueLegend = 554, tEvaluationPoints = 555, tStoreInRegister = 556, tStoreInVariable = 557, tStoreInField = 558, tStoreInMeshBasedField = 559, tStoreMaxInRegister = 560, tStoreMaxXinRegister = 561, tStoreMaxYinRegister = 562, tStoreMaxZinRegister = 563, tStoreMinInRegister = 564, tStoreMinXinRegister = 565, tStoreMinYinRegister = 566, tStoreMinZinRegister = 567, tLastTimeStepOnly = 568, tAppendTimeStepToFileName = 569, tTimeValue = 570, tTimeImagValue = 571, tAppendExpressionToFileName = 572, tAppendExpressionFormat = 573, tOverrideTimeStepValue = 574, tNoMesh = 575, tSendToServer = 576, tColor = 577, tStr = 578, tDate = 579, tOnelabAction = 580, tFixRelativePath = 581, tNewCoordinates = 582, tAppendToExistingFile = 583, tAppendStringToFileName = 584, tDEF = 585, tOR = 586, tAND = 587, tEQUAL = 588, tNOTEQUAL = 589, tAPPROXEQUAL = 590, tLESSOREQUAL = 591, tGREATEROREQUAL = 592, tLESSLESS = 593, tGREATERGREATER = 594, tCROSSPRODUCT = 595, UNARYPREC = 596, tSHOW = 597 }; #endif /* Value type. */ #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED union YYSTYPE { #line 145 "ProParser.y" /* yacc.c:355 */ char *c; int i; double d; List_T *l; struct TwoInt t; #line 608 "ProParser.tab.cpp" /* yacc.c:355 */ }; typedef union YYSTYPE YYSTYPE; # define YYSTYPE_IS_TRIVIAL 1 # define YYSTYPE_IS_DECLARED 1 #endif extern YYSTYPE getdp_yylval; int getdp_yyparse (void); #endif /* !YY_GETDP_YY_PROPARSER_TAB_HPP_INCLUDED */ /* Copy the second part of user declarations. */ #line 625 "ProParser.tab.cpp" /* yacc.c:358 */ #ifdef short # undef short #endif #ifdef YYTYPE_UINT8 typedef YYTYPE_UINT8 yytype_uint8; #else typedef unsigned char yytype_uint8; #endif #ifdef YYTYPE_INT8 typedef YYTYPE_INT8 yytype_int8; #else typedef signed char yytype_int8; #endif #ifdef YYTYPE_UINT16 typedef YYTYPE_UINT16 yytype_uint16; #else typedef unsigned short int yytype_uint16; #endif #ifdef YYTYPE_INT16 typedef YYTYPE_INT16 yytype_int16; #else typedef short int yytype_int16; #endif #ifndef YYSIZE_T # ifdef __SIZE_TYPE__ # define YYSIZE_T __SIZE_TYPE__ # elif defined size_t # define YYSIZE_T size_t # elif ! defined YYSIZE_T # include /* INFRINGES ON USER NAME SPACE */ # define YYSIZE_T size_t # else # define YYSIZE_T unsigned int # endif #endif #define YYSIZE_MAXIMUM ((YYSIZE_T) -1) #ifndef YY_ # if defined YYENABLE_NLS && YYENABLE_NLS # if ENABLE_NLS # include /* INFRINGES ON USER NAME SPACE */ # define YY_(Msgid) dgettext ("bison-runtime", Msgid) # endif # endif # ifndef YY_ # define YY_(Msgid) Msgid # endif #endif #ifndef YY_ATTRIBUTE # if (defined __GNUC__ \ && (2 < __GNUC__ || (__GNUC__ == 2 && 96 <= __GNUC_MINOR__))) \ || defined __SUNPRO_C && 0x5110 <= __SUNPRO_C # define YY_ATTRIBUTE(Spec) __attribute__(Spec) # else # define YY_ATTRIBUTE(Spec) /* empty */ # endif #endif #ifndef YY_ATTRIBUTE_PURE # define YY_ATTRIBUTE_PURE YY_ATTRIBUTE ((__pure__)) #endif #ifndef YY_ATTRIBUTE_UNUSED # define YY_ATTRIBUTE_UNUSED YY_ATTRIBUTE ((__unused__)) #endif #if !defined _Noreturn \ && (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112) # if defined _MSC_VER && 1200 <= _MSC_VER # define _Noreturn __declspec (noreturn) # else # define _Noreturn YY_ATTRIBUTE ((__noreturn__)) # endif #endif /* Suppress unused-variable warnings by "using" E. */ #if ! defined lint || defined __GNUC__ # define YYUSE(E) ((void) (E)) #else # define YYUSE(E) /* empty */ #endif #if defined __GNUC__ && 407 <= __GNUC__ * 100 + __GNUC_MINOR__ /* Suppress an incorrect diagnostic about yylval being uninitialized. */ # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ _Pragma ("GCC diagnostic push") \ _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"")\ _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"") # define YY_IGNORE_MAYBE_UNINITIALIZED_END \ _Pragma ("GCC diagnostic pop") #else # define YY_INITIAL_VALUE(Value) Value #endif #ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN # define YY_IGNORE_MAYBE_UNINITIALIZED_END #endif #ifndef YY_INITIAL_VALUE # define YY_INITIAL_VALUE(Value) /* Nothing. */ #endif #if ! defined yyoverflow || YYERROR_VERBOSE /* The parser invokes alloca or malloc; define the necessary symbols. */ # ifdef YYSTACK_USE_ALLOCA # if YYSTACK_USE_ALLOCA # ifdef __GNUC__ # define YYSTACK_ALLOC __builtin_alloca # elif defined __BUILTIN_VA_ARG_INCR # include /* INFRINGES ON USER NAME SPACE */ # elif defined _AIX # define YYSTACK_ALLOC __alloca # elif defined _MSC_VER # include /* INFRINGES ON USER NAME SPACE */ # define alloca _alloca # else # define YYSTACK_ALLOC alloca # if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS # include /* INFRINGES ON USER NAME SPACE */ /* Use EXIT_SUCCESS as a witness for stdlib.h. */ # ifndef EXIT_SUCCESS # define EXIT_SUCCESS 0 # endif # endif # endif # endif # endif # ifdef YYSTACK_ALLOC /* Pacify GCC's 'empty if-body' warning. */ # define YYSTACK_FREE(Ptr) do { /* empty */; } while (0) # ifndef YYSTACK_ALLOC_MAXIMUM /* The OS might guarantee only one guard page at the bottom of the stack, and a page size can be as small as 4096 bytes. So we cannot safely invoke alloca (N) if N exceeds 4096. Use a slightly smaller number to allow for a few compiler-allocated temporary stack slots. */ # define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */ # endif # else # define YYSTACK_ALLOC YYMALLOC # define YYSTACK_FREE YYFREE # ifndef YYSTACK_ALLOC_MAXIMUM # define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM # endif # if (defined __cplusplus && ! defined EXIT_SUCCESS \ && ! ((defined YYMALLOC || defined malloc) \ && (defined YYFREE || defined free))) # include /* INFRINGES ON USER NAME SPACE */ # ifndef EXIT_SUCCESS # define EXIT_SUCCESS 0 # endif # endif # ifndef YYMALLOC # define YYMALLOC malloc # if ! defined malloc && ! defined EXIT_SUCCESS void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */ # endif # endif # ifndef YYFREE # define YYFREE free # if ! defined free && ! defined EXIT_SUCCESS void free (void *); /* INFRINGES ON USER NAME SPACE */ # endif # endif # endif #endif /* ! defined yyoverflow || YYERROR_VERBOSE */ #if (! defined yyoverflow \ && (! defined __cplusplus \ || (defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL))) /* A type that is properly aligned for any stack member. */ union yyalloc { yytype_int16 yyss_alloc; YYSTYPE yyvs_alloc; }; /* The size of the maximum gap between one aligned stack and the next. */ # define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1) /* The size of an array large to enough to hold all stacks, each with N elements. */ # define YYSTACK_BYTES(N) \ ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE)) \ + YYSTACK_GAP_MAXIMUM) # define YYCOPY_NEEDED 1 /* Relocate STACK from its old location to the new one. The local variables YYSIZE and YYSTACKSIZE give the old and new number of elements in the stack, and YYPTR gives the new location of the stack. Advance YYPTR to a properly aligned location for the next stack. */ # define YYSTACK_RELOCATE(Stack_alloc, Stack) \ do \ { \ YYSIZE_T yynewbytes; \ YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \ Stack = &yyptr->Stack_alloc; \ yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \ yyptr += yynewbytes / sizeof (*yyptr); \ } \ while (0) #endif #if defined YYCOPY_NEEDED && YYCOPY_NEEDED /* Copy COUNT objects from SRC to DST. The source and destination do not overlap. */ # ifndef YYCOPY # if defined __GNUC__ && 1 < __GNUC__ # define YYCOPY(Dst, Src, Count) \ __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src))) # else # define YYCOPY(Dst, Src, Count) \ do \ { \ YYSIZE_T yyi; \ for (yyi = 0; yyi < (Count); yyi++) \ (Dst)[yyi] = (Src)[yyi]; \ } \ while (0) # endif # endif #endif /* !YYCOPY_NEEDED */ /* YYFINAL -- State number of the termination state. */ #define YYFINAL 3 /* YYLAST -- Last index in YYTABLE. */ #define YYLAST 14614 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 367 /* YYNNTS -- Number of nonterminals. */ #define YYNNTS 215 /* YYNRULES -- Number of rules. */ #define YYNRULES 939 /* YYNSTATES -- Number of states. */ #define YYNSTATES 2655 /* YYTRANSLATE[YYX] -- Symbol number corresponding to YYX as returned by yylex, with out-of-bounds checking. */ #define YYUNDEFTOK 2 #define YYMAXUTOK 597 #define YYTRANSLATE(YYX) \ ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK) /* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM as returned by yylex, without out-of-bounds checking. */ static const yytype_uint16 yytranslate[] = { 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 351, 2, 359, 360, 347, 350, 2, 354, 355, 345, 343, 364, 344, 358, 346, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 337, 2, 339, 331, 365, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 356, 2, 357, 353, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 362, 349, 363, 366, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 254, 255, 256, 257, 258, 259, 260, 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, 321, 322, 323, 324, 325, 326, 327, 328, 329, 330, 332, 333, 334, 335, 336, 338, 340, 341, 342, 348, 352, 361 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_uint16 yyrline[] = { 0, 332, 332, 332, 342, 346, 345, 353, 354, 355, 356, 357, 358, 359, 360, 361, 362, 364, 366, 368, 380, 383, 389, 392, 396, 412, 395, 423, 425, 431, 430, 447, 458, 463, 481, 484, 497, 498, 505, 507, 510, 529, 541, 548, 555, 559, 566, 577, 582, 590, 602, 639, 646, 660, 675, 679, 685, 692, 698, 706, 710, 723, 722, 743, 762, 762, 769, 772, 777, 779, 800, 845, 849, 852, 863, 887, 893, 901, 901, 908, 916, 920, 926, 929, 936, 936, 949, 952, 965, 951, 993, 1001, 1009, 1017, 1025, 1033, 1041, 1049, 1057, 1065, 1073, 1081, 1089, 1098, 1106, 1114, 1122, 1131, 1138, 1146, 1148, 1157, 1156, 1187, 1189, 1195, 1272, 1306, 1315, 1328, 1327, 1341, 1340, 1355, 1354, 1371, 1370, 1391, 1389, 1407, 1423, 1429, 1436, 1435, 1466, 1492, 1507, 1513, 1520, 1526, 1533, 1540, 1547, 1553, 1563, 1564, 1565, 1570, 1571, 1577, 1579, 1582, 1590, 1602, 1606, 1614, 1616, 1622, 1627, 1635, 1637, 1645, 1648, 1654, 1657, 1660, 1699, 1704, 1712, 1718, 1724, 1731, 1734, 1742, 1744, 1752, 1757, 1763, 1773, 1783, 1791, 1793, 1801, 1810, 1816, 1864, 1867, 1870, 1873, 1876, 1888, 1892, 1897, 1902, 1908, 1914, 1920, 1927, 1936, 1939, 1953, 1962, 1966, 1971, 1981, 1988, 1994, 2004, 2009, 2015, 2022, 2032, 2042, 2050, 2059, 2068, 2087, 2096, 2104, 2112, 2122, 2132, 2141, 2151, 2172, 2177, 2182, 2187, 2194, 2199, 2201, 2207, 2214, 2223, 2226, 2229, 2232, 2240, 2245, 2263, 2273, 2288, 2294, 2297, 2302, 2316, 2339, 2370, 2375, 2380, 2385, 2414, 2418, 2475, 2480, 2490, 2494, 2500, 2507, 2510, 2517, 2535, 2542, 2544, 2565, 2578, 2586, 2590, 2607, 2612, 2618, 2628, 2633, 2639, 2646, 2657, 2673, 2677, 2715, 2725, 2734, 2740, 2760, 2763, 2766, 2784, 2788, 2793, 2798, 2805, 2809, 2815, 2822, 2832, 2834, 2844, 2848, 2853, 2860, 2875, 2881, 2884, 2888, 2891, 2901, 2906, 2905, 2939, 2945, 2944, 3212, 3217, 3228, 3239, 3244, 3247, 3290, 3294, 3299, 3308, 3311, 3314, 3317, 3325, 3330, 3335, 3345, 3356, 3371, 3377, 3381, 3393, 3402, 3420, 3427, 3435, 3426, 3568, 3573, 3584, 3595, 3600, 3607, 3617, 3631, 3636, 3642, 3650, 3641, 3722, 3723, 3724, 3725, 3726, 3727, 3728, 3729, 3730, 3731, 3732, 3733, 3739, 3760, 3785, 3789, 3794, 3799, 3806, 3813, 3819, 3826, 3828, 3832, 3831, 3836, 3842, 3846, 3855, 3865, 3877, 3883, 3892, 3901, 3904, 3910, 3921, 3926, 3931, 3936, 3942, 3952, 3960, 3962, 3975, 3986, 3993, 3995, 4009, 4017, 4028, 4029, 4034, 4035, 4036, 4037, 4040, 4041, 4042, 4043, 4044, 4045, 4051, 4075, 4082, 4089, 4095, 4101, 4107, 4115, 4138, 4145, 4152, 4159, 4165, 4171, 4177, 4184, 4190, 4201, 4213, 4223, 4236, 4258, 4280, 4293, 4306, 4327, 4341, 4362, 4375, 4388, 4406, 4426, 4449, 4465, 4482, 4498, 4505, 4518, 4531, 4544, 4557, 4569, 4604, 4617, 4631, 4650, 4670, 4681, 4694, 4707, 4726, 4747, 4746, 4756, 4755, 4764, 4775, 4787, 4797, 4805, 4813, 4823, 4833, 4840, 4849, 4860, 4869, 4883, 4897, 4912, 4926, 4940, 4951, 4962, 4977, 4992, 5012, 5032, 5044, 5063, 5081, 5098, 5115, 5132, 5150, 5164, 5181, 5188, 5197, 5202, 5215, 5221, 5225, 5228, 5240, 5245, 5261, 5267, 5274, 5281, 5292, 5299, 5304, 5314, 5318, 5339, 5343, 5360, 5367, 5372, 5382, 5386, 5414, 5418, 5439, 5448, 5454, 5458, 5462, 5466, 5471, 5483, 5493, 5499, 5503, 5507, 5511, 5515, 5520, 5532, 5541, 5546, 5550, 5554, 5558, 5562, 5574, 5586, 5591, 5595, 5599, 5603, 5608, 5619, 5625, 5631, 5642, 5644, 5650, 5662, 5667, 5677, 5705, 5708, 5711, 5719, 5738, 5744, 5749, 5754, 5759, 5767, 5771, 5778, 5792, 5797, 5804, 5806, 5809, 5816, 5821, 5826, 5829, 5836, 5839, 5845, 5857, 5863, 5872, 5877, 5876, 5912, 5923, 5928, 5939, 5959, 5965, 5970, 5973, 5978, 5993, 5997, 6004, 6006, 6019, 6030, 6035, 6040, 6045, 6050, 6055, 6060, 6065, 6073, 6078, 6084, 6083, 6119, 6122, 6121, 6209, 6214, 6219, 6228, 6237, 6247, 6246, 6259, 6265, 6274, 6287, 6313, 6314, 6315, 6316, 6322, 6323, 6329, 6335, 6342, 6349, 6373, 6380, 6392, 6405, 6425, 6451, 6485, 6507, 6509, 6513, 6527, 6541, 6555, 6559, 6563, 6567, 6571, 6575, 6579, 6583, 6587, 6597, 6601, 6605, 6609, 6613, 6620, 6631, 6635, 6639, 6648, 6657, 6664, 6673, 6677, 6687, 6691, 6695, 6699, 6708, 6714, 6718, 6726, 6733, 6741, 6748, 6756, 6763, 6771, 6775, 6779, 6783, 6787, 6791, 6795, 6799, 6803, 6807, 6811, 6815, 6819, 6823, 6827, 6831, 6835, 6839, 6843, 6847, 6851, 6855, 6859, 6863, 6876, 6878, 6884, 6901, 6918, 6940, 6961, 6998, 7006, 7014, 7020, 7027, 7035, 7055, 7081, 7093, 7099, 7109, 7110, 7115, 7117, 7119, 7129, 7144, 7152, 7180, 7208, 7236, 7258, 7275, 7310, 7340, 7347, 7352, 7369, 7374, 7388, 7399, 7411, 7426, 7441, 7448, 7454, 7461, 7462, 7467, 7479, 7494, 7503, 7512, 7513, 7518, 7526, 7535, 7543, 7551, 7566, 7569, 7577, 7593, 7601, 7600, 7623, 7631, 7630, 7642, 7645, 7653, 7668, 7669, 7670, 7671, 7672, 7673, 7674, 7675, 7676, 7677, 7678, 7679, 7680, 7681, 7682, 7683, 7684, 7685, 7686, 7687, 7688, 7689, 7690, 7694, 7695, 7699, 7700, 7701, 7702, 7703, 7704, 7705, 7706, 7707, 7708, 7709, 7710, 7711, 7712, 7713, 7714, 7715, 7716, 7717, 7718, 7719, 7720, 7721, 7722, 7723, 7724, 7725, 7726, 7727, 7728, 7729, 7730, 7731, 7732, 7733, 7734, 7735, 7736, 7737, 7738, 7739, 7740, 7741, 7743, 7745, 7747, 7749, 7754, 7755, 7756, 7757, 7758, 7759, 7760, 7761, 7762, 7763, 7764, 7765, 7766, 7767, 7770, 7769, 7778, 7793, 7810, 7835, 7837, 7840, 7846, 7849, 7852, 7861, 7874, 7880, 7883, 7886, 7899, 7908, 7917, 7926, 7935, 7944, 7953, 7968, 7983, 7998, 8013, 8021, 8033, 8051, 8070, 8088, 8114, 8141, 8158, 8199, 8219, 8228, 8237, 8258, 8267, 8280, 8283, 8287, 8293, 8296, 8299, 8304, 8314, 8324, 8335, 8355, 8367, 8372, 8392, 8401, 8408, 8415, 8422, 8421, 8435, 8438, 8457, 8462, 8469, 8469, 8470, 8470, 8474, 8496, 8509, 8520 }; #endif #if YYDEBUG || YYERROR_VERBOSE || 0 /* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. First, the terminals, then, starting at YYNTOKENS, nonterminals. */ static const char *const yytname[] = { "$end", "error", "$undefined", "tINT", "tFLOAT", "tSTRING", "tBIGSTR", "tEND", "tDOTS", "tStrCat", "tSprintf", "tPrintf", "tMPI_Printf", "tRead", "tPrintConstants", "tStrCmp", "tStrChoice", "tUpperCase", "tLowerCase", "tLowerCaseIn", "tNbrRegions", "tGetRegion", "tNameFromString", "tStringFromName", "tFor", "tEndFor", "tIf", "tElseIf", "tElse", "tEndIf", "tMacro", "tReturn", "tCall", "tCallTest", "tTest", "tWhile", "tFlag", "tInclude", "tConstant", "tList", "tListAlt", "tLinSpace", "tLogSpace", "tListFromFile", "tChangeCurrentPosition", "tDefineConstant", "tUndefineConstant", "tDefineNumber", "tDefineString", "tPi", "tMPI_Rank", "tMPI_Size", "t0D", "t1D", "t2D", "t3D", "tTestLevel", "tTotalMemory", "tCurrentDirectory", "tGETDP_MAJOR_VERSION", "tGETDP_MINOR_VERSION", "tGETDP_PATCH_VERSION", "tExp", "tLog", "tLog10", "tSqrt", "tSin", "tAsin", "tCos", "tAcos", "tTan", "tAtan", "tAtan2", "tSinh", "tCosh", "tTanh", "tFabs", "tFloor", "tCeil", "tRound", "tSign", "tFmod", "tModulo", "tHypot", "tRand", "tSolidAngle", "tTrace", "tOrder", "tCrossProduct", "tDofValue", "tMHTransform", "tMHJacNL", "tGroup", "tDefineGroup", "tAll", "tInSupport", "tMovingBand2D", "tDefineFunction", "tConstraint", "tRegion", "tSubRegion", "tRegionRef", "tSubRegionRef", "tFilter", "tToleranceFactor", "tCoefficient", "tValue", "tTimeFunction", "tBranch", "tNameOfResolution", "tJacobian", "tCase", "tMetricTensor", "tIntegration", "tType", "tSubType", "tCriterion", "tGeoElement", "tNumberOfPoints", "tMaxNumberOfPoints", "tNumberOfDivisions", "tMaxNumberOfDivisions", "tStoppingCriterion", "tFunctionSpace", "tName", "tBasisFunction", "tNameOfCoef", "tFunction", "tdFunction", "tSubFunction", "tSubdFunction", "tSupport", "tEntity", "tSubSpace", "tNameOfBasisFunction", "tGlobalQuantity", "tEntityType", "tEntitySubType", "tNameOfConstraint", "tFormulation", "tQuantity", "tNameOfSpace", "tIndexOfSystem", "tSymmetry", "tGalerkin", "tdeRham", "tGlobalTerm", "tGlobalEquation", "tDt", "tDtDof", "tDtDt", "tDtDtDof", "tDtDtDtDof", "tDtDtDtDtDof", "tDtDtDtDtDtDof", "tJacNL", "tDtDofJacNL", "tNeverDt", "tDtNL", "tAtAnteriorTimeStep", "tMaxOverTime", "tFourierSteinmetz", "tIn", "tFull_Matrix", "tResolution", "tHidden", "tDefineSystem", "tNameOfFormulation", "tNameOfMesh", "tFrequency", "tSolver", "tOriginSystem", "tDestinationSystem", "tOperation", "tOperationEnd", "tSetTime", "tSetTimeStep", "tDTime", "tSetFrequency", "tFourierTransform", "tFourierTransformJ", "tLanczos", "tEigenSolve", "tEigenSolveJac", "tPerturbation", "tUpdate", "tUpdateConstraint", "tBreak", "tGetResidual", "tCreateSolution", "tEvaluate", "tSelectCorrection", "tAddCorrection", "tMultiplySolution", "tAddOppositeFullSolution", "tSolveAgainWithOther", "tSetGlobalSolverOptions", "tTimeLoopTheta", "tTimeLoopNewmark", "tTimeLoopRungeKutta", "tTimeLoopAdaptive", "tTime0", "tTimeMax", "tTheta", "tBeta", "tGamma", "tIterativeLoop", "tIterativeLoopN", "tIterativeLinearSolver", "tNbrMaxIteration", "tRelaxationFactor", "tIterativeTimeReduction", "tSetCommSelf", "tSetCommWorld", "tBarrier", "tBroadcastFields", "tSleep", "tDivisionCoefficient", "tChangeOfState", "tChangeOfCoordinates", "tChangeOfCoordinates2", "tSystemCommand", "tError", "tGmshRead", "tGmshMerge", "tGmshOpen", "tGmshWrite", "tGmshClearAll", "tDelete", "tDeleteFile", "tRenameFile", "tCreateDir", "tGenerateOnly", "tGenerateOnlyJac", "tSolveJac_AdaptRelax", "tSaveSolutionExtendedMH", "tSaveSolutionMHtoTime", "tSaveSolutionWithEntityNum", "tInitMovingBand2D", "tMeshMovingBand2D", "tGenerateMHMoving", "tGenerateMHMovingSeparate", "tAddMHMoving", "tGenerateGroup", "tGenerateJacGroup", "tGenerateRHSGroup", "tGenerateGroupCumulative", "tGenerateJacGroupCumulative", "tGenerateRHSGroupCumulative", "tSaveMesh", "tDeformMesh", "tFrequencySpectrum", "tPostProcessing", "tNameOfSystem", "tPostOperation", "tNameOfPostProcessing", "tUsingPost", "tAppend", "tResampleTime", "tPlot", "tPrint", "tPrintGroup", "tEcho", "tSendMergeFileRequest", "tWrite", "tAdapt", "tOnGlobal", "tOnRegion", "tOnElementsOf", "tOnGrid", "tOnSection", "tOnPoint", "tOnLine", "tOnPlane", "tOnBox", "tWithArgument", "tFile", "tDepth", "tDimension", "tComma", "tTimeStep", "tHarmonicToTime", "tCosineTransform", "tValueIndex", "tValueName", "tFormat", "tHeader", "tFooter", "tSkin", "tSmoothing", "tTarget", "tSort", "tIso", "tNoNewLine", "tNoTitle", "tDecomposeInSimplex", "tChangeOfValues", "tTimeLegend", "tFrequencyLegend", "tEigenvalueLegend", "tEvaluationPoints", "tStoreInRegister", "tStoreInVariable", "tStoreInField", "tStoreInMeshBasedField", "tStoreMaxInRegister", "tStoreMaxXinRegister", "tStoreMaxYinRegister", "tStoreMaxZinRegister", "tStoreMinInRegister", "tStoreMinXinRegister", "tStoreMinYinRegister", "tStoreMinZinRegister", "tLastTimeStepOnly", "tAppendTimeStepToFileName", "tTimeValue", "tTimeImagValue", "tAppendExpressionToFileName", "tAppendExpressionFormat", "tOverrideTimeStepValue", "tNoMesh", "tSendToServer", "tColor", "tStr", "tDate", "tOnelabAction", "tFixRelativePath", "tNewCoordinates", "tAppendToExistingFile", "tAppendStringToFileName", "tDEF", "'?'", "tOR", "tAND", "tEQUAL", "tNOTEQUAL", "tAPPROXEQUAL", "'<'", "tLESSOREQUAL", "'>'", "tGREATEROREQUAL", "tLESSLESS", "tGREATERGREATER", "'+'", "'-'", "'*'", "'/'", "'%'", "tCROSSPRODUCT", "'|'", "'&'", "'!'", "UNARYPREC", "'^'", "'('", "')'", "'['", "']'", "'.'", "'#'", "'$'", "tSHOW", "'{'", "'}'", "','", "'@'", "'~'", "$accept", "Stats", "$@1", "ProblemDefinitions", "$@2", "ProblemDefinition", "Groups", "Group", "$@3", "$@4", "ReducedGroupRHS", "$@5", "GroupRHS", "FunctionForGroup", "ListOfRegionOrAll", "SuppListOfRegion", "SuppListTypeForGroup", "ListOfRegion", "RecursiveListOfRegion", "IRegion", "ListOfStringsForCharOptions", "DefineGroups", "$@6", "Comma", "Functions", "Function", "DefineFunctions", "Expression", "$@7", "ListOfExpression", "RecursiveListOfExpression", "WholeQuantityExpression", "$@8", "WholeQuantity", "$@9", "$@10", "$@11", "WholeQuantity_Single", "$@12", "$@13", "$@14", "$@15", "$@16", "$@17", "ArgumentsForFunction", "RecursiveListOfQuantity", "ParametersForFunction", "JacobianMethods", "JacobianMethod", "JacobianMethodTerm", "JacobianCases", "JacobianCase", "JacobianCaseTerm", "IntegrationMethods", "IntegrationMethod", "IntegrationMethodTerm", "IntegrationCases", "IntegrationCase", "IntegrationCaseTerm", "QuadratureCases", "QuadratureCase", "QuadratureCaseTerm", "Constraints", "BracedConstraint", "Constraint", "ConstraintTerm", "ConstraintCases", "ConstraintCase", "ConstraintCaseTerm", "FunctionSpaces", "BracedFunctionSpace", "FunctionSpace", "FunctionSpaceTerm", "BasisFunctions", "BasisFunction", "BasisFunctionTerm", "OptionalParametersForBasisFunction", "SubSpaces", "SubSpace", "SubSpaceTerm", "ListOfBasisFunction", "RecursiveListOfBasisFunction", "ListOfBasisFunctionCoef", "RecursiveListOfBasisFunctionCoef", "GlobalQuantities", "GlobalQuantity", "GlobalQuantityTerm", "ConstraintInFSs", "ConstraintInFS", "ConstraintInFSTerm", "Formulations", "BracedFormulation", "Formulation", "FormulationTerm", "DefineQuantities", "DefineQuantity", "DefineQuantityTerm", "$@18", "$@19", "IndexInFunctionSpace", "Equations", "EquationTerm", "GlobalEquation", "GlobalEquationTerm", "GlobalEquationTermTerm", "GlobalEquationTermTermTerm", "LocalTerm", "LocalTermTerm", "$@20", "$@21", "GlobalTerm", "GlobalTermTerm", "$@22", "$@23", "TermOperator", "Quantity_Def", "Resolutions", "BracedResolution", "Resolution", "ResolutionTerm", "$@24", "DefineSystems", "DefineSystem", "DefineSystemTerm", "ListOfFormulation", "RecursiveListOfFormulation", "ListOfSystem", "RecursiveListOfSystem", "Operation", "CommaFExprOrNothing", "GmshOperation", "GenerateGroupOperation", "OperationTerm", "$@25", "$@26", "PrintOperation", "PrintOperationOptions", "PrintOperationOption", "TLAoptions", "LTEdefinitions", "TimeLoopAdaptiveSystems", "TimeLoopAdaptivePOs", "IterativeLoopDefinitions", "IterativeLoopSystems", "IterativeLoopPOs", "TimeLoopTheta", "TimeLoopThetaTerm", "TimeLoopNewmark", "TimeLoopNewmarkTerm", "IterativeLoop", "IterativeLoopTerm", "IterativeTimeReduction", "IterativeTimeReductionTerm", "ChangeOfStates", "ChangeOfState", "ChangeOfStateTerm", "PostProcessings", "BracedPostProcessing", "PostProcessing", "PostProcessingTerm", "PostQuantities", "PostQuantity", "PostQuantityTerm", "SubPostQuantities", "SubPostQuantity", "SubPostQuantityTerm", "$@27", "PostOperations", "BracedPostOperation", "PostOperation", "PostOperationTerm", "SeparatePostOperation", "$@28", "PostSubOperations", "$@29", "PostSubOperation", "$@30", "PostQuantitiesToPrint", "Combination", "PostQuantitySupport", "PrintSubType", "PrintOptions", "PrintOption", "CallArg", "Loop", "Printf", "Affectation", "Enumeration", "FloatParameterOptions", "FloatParameterOption", "CharParameterOptions", "CharParameterOption", "DefineConstants", "$@31", "$@32", "UndefineConstants", "NameForMathFunction", "NameForFunction", "FExpr", "OneFExpr", "$@33", "ListOfFExpr", "RecursiveListOfFExpr", "MultiFExpr", "StringIndex", "String__Index", "CharExprNoVar", "$@34", "CharExpr", "RecursiveListOfCharExpr", "LP", "RP", "StrCat", "StrCmp", "NbrRegions", YY_NULLPTR }; #endif # ifdef YYPRINT /* YYTOKNUM[NUM] -- (External) token number corresponding to the (internal) symbol number NUM (which must be that of a token). */ static const yytype_uint16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, 321, 322, 323, 324, 325, 326, 327, 328, 329, 330, 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, 351, 352, 353, 354, 355, 356, 357, 358, 359, 360, 361, 362, 363, 364, 365, 366, 367, 368, 369, 370, 371, 372, 373, 374, 375, 376, 377, 378, 379, 380, 381, 382, 383, 384, 385, 386, 387, 388, 389, 390, 391, 392, 393, 394, 395, 396, 397, 398, 399, 400, 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, 411, 412, 413, 414, 415, 416, 417, 418, 419, 420, 421, 422, 423, 424, 425, 426, 427, 428, 429, 430, 431, 432, 433, 434, 435, 436, 437, 438, 439, 440, 441, 442, 443, 444, 445, 446, 447, 448, 449, 450, 451, 452, 453, 454, 455, 456, 457, 458, 459, 460, 461, 462, 463, 464, 465, 466, 467, 468, 469, 470, 471, 472, 473, 474, 475, 476, 477, 478, 479, 480, 481, 482, 483, 484, 485, 486, 487, 488, 489, 490, 491, 492, 493, 494, 495, 496, 497, 498, 499, 500, 501, 502, 503, 504, 505, 506, 507, 508, 509, 510, 511, 512, 513, 514, 515, 516, 517, 518, 519, 520, 521, 522, 523, 524, 525, 526, 527, 528, 529, 530, 531, 532, 533, 534, 535, 536, 537, 538, 539, 540, 541, 542, 543, 544, 545, 546, 547, 548, 549, 550, 551, 552, 553, 554, 555, 556, 557, 558, 559, 560, 561, 562, 563, 564, 565, 566, 567, 568, 569, 570, 571, 572, 573, 574, 575, 576, 577, 578, 579, 580, 581, 582, 583, 584, 585, 63, 586, 587, 588, 589, 590, 60, 591, 62, 592, 593, 594, 43, 45, 42, 47, 37, 595, 124, 38, 33, 596, 94, 40, 41, 91, 93, 46, 35, 36, 597, 123, 125, 44, 64, 126 }; # endif #define YYPACT_NINF -1749 #define yypact_value_is_default(Yystate) \ (!!((Yystate) == (-1749))) #define YYTABLE_NINF -807 #define yytable_value_is_error(Yytable_value) \ 0 /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing STATE-NUM. */ static const yytype_int16 yypact[] = { -1749, 80, -1749, -1749, 139, 10612, -281, -1749, -1749, -216, 182, -263, 46, -1749, -191, -157, -1749, -1749, 1333, -1749, 3361, -149, 3361, -111, -82, -29, -3, 5, 40, 71, 109, 121, 151, 226, 168, 27, -1749, -1749, -1749, 64, -1749, -54, -83, 173, 226, 226, -1749, 3361, 153, 10179, 10179, 10179, -1749, -1749, -77, -77, -77, 72, 185, 215, 251, 284, -1749, 299, -1749, -1749, -77, -1749, -1749, 337, -1749, -1749, 10179, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 365, -1749, -1749, 332, -1749, -1749, 635, 661, 2428, 327, 4573, 380, 389, 9690, 10179, 366, -60, 367, 390, -1749, -1749, -74, -77, 394, 415, 418, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 442, 444, 460, 474, 485, 500, 513, 522, 525, 527, 536, 550, 576, 603, 613, 639, 651, 657, 662, 680, 694, 697, 700, 10179, 10179, 10179, 809, 9549, -1749, -1749, -1749, -1749, 12689, 12718, 3361, 3361, 10179, 3361, 3361, 3361, 226, 2428, 3361, 3361, -1749, 12747, -38, -18, 1750, 2291, 131, 382, 2613, 2861, 3032, 3090, -1749, 3132, 3417, 226, -1749, -1749, 24, 10179, 77, 713, 760, 788, 826, 851, 5662, 3227, 10044, 838, 489, -59, 893, 5744, 5744, 9772, 18, 10100, 208, 489, 12062, 66, 895, 10179, -1749, 10179, 10179, 3361, 226, 226, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, -297, -297, 12776, 856, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, -1749, -1749, -1749, -1749, 359, 403, 9526, 847, 860, 864, 870, -1749, -7, 183, 3361, 1107, -1749, 226, 1224, 3361, 876, -1749, -1749, -1749, -45, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 877, -1749, -1749, -1749, 160, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 9772, 1227, 12095, 5909, 872, 226, 9933, 10179, 10179, 3361, 9772, -297, 892, -1749, 20, 10179, 5826, 9772, -1749, 9772, 9772, 9772, 9772, 10179, 30, -1749, 1241, 1250, 5744, 928, 930, 9772, 166, 9772, -1749, -1749, 10179, -1749, 12128, 10129, 12805, 897, 905, 902, 14255, 12834, 12863, 12892, 12921, 12950, 12979, 13008, 13037, 13066, 13095, 10488, 13124, 13153, 13182, 13211, 13240, 13269, 13298, 13327, 10590, 10613, 10636, 13356, -1749, 912, 2836, 10182, 2020, 682, 1581, 1581, 1178, 1178, 1178, 1178, 540, 540, 178, 178, 178, -297, -297, -297, 3361, -1749, 9772, -1749, 3361, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 1261, -1749, -134, -1749, -1749, -1749, -1749, 3468, 939, -12, 11, -33, 1839, -1749, 85, 61, 2775, 286, 2670, 931, 433, -1749, -1749, -1749, 9772, -1749, 941, 232, 10100, 105, 10659, 10682, 948, 432, -1749, 10211, 9772, 178, 892, 178, 892, 268, 268, 128, 892, 128, 892, 969, -1749, 9772, -1749, -1749, 1289, 5744, 5744, 5744, 981, 984, 10100, 489, 13385, 1306, 10179, -1749, 3361, -1749, 10179, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 10179, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 10179, 10179, 10179, -1749, -1749, 10179, -1749, 10179, -1749, 433, 951, 83, -1749, 5122, 10179, 148, 59, 965, -1749, 42, 1317, 970, 5574, 6, 1320, 226, -1749, 10649, 967, 226, -1749, -1749, 968, 156, 1322, -1749, -1749, 972, 1330, 226, 974, 975, 978, -1749, -1749, -1749, 227, -164, 1014, 52, -1749, 988, -1749, 985, 1348, 226, 992, -1749, -1749, 226, 10179, 996, -1749, -1749, -1749, -1749, 226, 997, 226, 226, -1749, -1749, 226, 10179, 998, 226, 3361, 1010, 1366, 1365, 5744, 5744, 10179, 10179, 10179, -1749, -1749, -1749, -1749, 1375, 463, -1749, 1380, 9772, 10179, 10179, -1749, -1749, 10179, 502, 516, -1749, 1383, 1385, 1386, 5744, 5744, 1387, -1749, 285, 183, 13414, 269, 13443, 13472, 13501, 13530, 13559, 14255, -1749, 3361, -1749, 91, -1749, 4573, 14255, -1749, 12161, 1388, 226, 62, 1389, -48, 9772, -1749, 9772, -1749, -1749, -1749, -1749, 32, 1392, 1034, -1749, 1393, 1394, -1749, -1749, 1395, -1749, 1047, 1049, 1061, 1400, -1749, 1401, -1749, 1403, 1404, -1749, -1749, -1749, 1406, 226, 156, 1084, -1749, 1408, 1409, -1749, 1410, 1030, -1749, 1056, 1415, -1749, 1416, 1417, 1418, 1543, -1749, 1420, 1421, 10179, 1422, -1749, 1424, 1425, 3428, 3675, 4523, 1070, -1749, 1079, 1078, 758, 10705, 10728, 14255, -1749, 1081, -1749, -1749, -1749, 1430, 1433, -1749, 10179, -1749, -1749, -1749, -1749, 98, -1749, -1749, -1749, -1749, -1749, -1749, 183, 5204, 2428, 2428, -1749, -1749, -1749, -1749, -127, -1749, 1441, 3937, 204, 573, 458, -1749, -1749, -1749, -1749, -1749, 3625, -1749, -1749, 612, -1749, 630, 10179, 1442, 1103, -1749, -1749, 5002, -1749, 3667, -1749, -1749, 3724, 649, 3904, -1749, 1087, 1443, 156, 1046, -1749, -1749, 4045, -1749, -1749, 4112, -1749, -1749, 4141, -1749, -1749, -1749, -1749, 1088, -1749, -1749, 10751, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 10554, -1749, -1749, -1749, 10179, 10179, -1749, -1749, -1749, 12194, 4677, 2428, -1749, 3361, 14255, -1749, -1749, -1749, -1749, -1749, 1092, 10179, 1091, 1448, -1749, -1749, -1749, 65, -1749, 288, 4359, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 13588, 1101, -1749, 246, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 1109, -1749, 1110, 1112, 1113, 1116, -1749, -1749, -1749, -1749, 122, 5002, 5002, 5002, 5002, 10268, 76, 247, 3897, 115, 1117, -1749, 1117, -1749, 1119, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 10179, -1749, 1452, 1115, 1122, 1123, 1124, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 6182, -1749, -1749, -1749, -1749, 10179, 1131, 1132, 1152, 1154, 1155, -1749, -1749, 13617, 13646, -1749, 3227, -1749, -1749, -1749, 670, 676, 679, -1749, 12227, 52, 1475, 62, -1749, 1159, 112, -1749, 820, -28, -14, -1749, -1749, -1749, 1150, 1157, 1150, 5002, 4915, 4915, 1161, 1162, 1163, 1164, 1140, 1174, 1179, 1179, 1179, 3470, -1, 260, -1749, -1749, -1749, 1216, 7, 1184, -1749, 5002, 5002, 5002, 5002, 5002, 5002, 5002, 5002, 5002, 5002, 5002, 5002, 5002, 5002, 5002, 5002, 10179, 10179, 4762, -1749, 1186, 407, 110, 179, 92, 12260, -1749, -1749, -1749, -1749, -1749, 667, 119, 21, 1205, 1206, 10, 90, 1209, 1210, 1228, 1246, 1247, 1249, 1251, 1252, 1253, 1576, 1254, 1255, 1256, 1257, 1258, 1259, 1260, 1264, 1265, -112, 136, 1266, 1267, 541, 1268, 1269, 1244, 1619, 1620, 1621, 1275, 1276, 1277, 1279, 1281, -1749, -1749, -1749, -1749, 1632, 1284, 1285, 1287, 1288, 1290, 1291, 1292, 1294, 1295, 1296, 1297, 1299, 1304, 1316, -1749, -1749, -1749, -1749, -1749, -1749, 1321, 1324, 1325, -1749, -1749, -1749, 1327, 1328, -1749, -1749, -47, 10774, 226, 259, 70, 3361, 3361, -1749, -1749, 685, 9073, -1749, -1749, -1749, 1280, -1749, -1749, -1749, -1749, -1749, -1749, 226, 52, 70, 70, 70, 70, 96, 10179, 141, 143, 156, 1283, 226, 1671, 155, -1749, -1749, 120, 226, -1749, -1749, 1323, 1673, 1681, -1749, -1749, 1331, -1749, 1332, 1658, -1749, -1749, 1117, -1749, -1749, -1749, -1749, 1334, 5002, -1749, 10015, 5002, 1329, -1749, 5002, 515, 1156, 1196, 1196, 1196, 319, 319, 319, 319, 491, 491, 1179, 1179, 1179, 1179, 1179, 260, 260, -1749, 1336, 3897, 289, 9608, -1749, 226, 195, 1682, 226, -1749, -1749, 226, 226, 1686, 1335, 1337, 1337, 70, 70, -1749, -1749, 1689, 31, 39, -1749, -1749, 1690, 226, 226, -1749, -1749, -1749, 546, 580, 848, -62, 226, 1693, 114, 226, 226, 10179, 1697, 70, 5744, -1749, -1749, -1749, 1696, 226, 28, 3361, 5744, 3361, 36, 226, -1749, -1749, -1749, 226, 1695, 156, 156, 156, 1698, 156, 1699, 226, 226, 226, 226, 226, 226, 226, 226, 226, -1749, 226, 226, 156, 226, 226, 226, 226, 226, 3361, 10179, -1749, 10179, -1749, 226, 10179, 10179, -1749, 10179, 3361, -1749, -1749, -1749, -1749, 5744, 156, 70, 3361, 3361, -1749, 3361, 3361, 3361, 226, 226, 226, 226, 226, 226, 226, 226, 226, 226, 226, 226, 226, 226, 1347, 1353, 3361, 226, 1350, 226, -1749, -1749, 10179, 1286, 1357, 1351, 1286, -1749, -1749, 1359, -1749, 10179, 3361, 555, 1354, -1749, -1749, 1710, 1714, 1715, 1716, 156, 1717, 4958, 156, 1718, 156, 1719, 1720, 911, 1721, 1723, 156, 1724, 1725, 1726, 1186, -1749, 1728, 1729, -1749, 1374, -1749, 5002, 1358, 1382, 1384, 1378, 1379, 1381, -1749, 3629, 3897, -1749, 2055, -1749, -1749, 5002, 1390, 699, 1391, 1737, -1749, 1740, 1742, 1743, 1744, 1745, 1396, 1752, 156, 1753, 1758, 1759, 1760, 1761, -1749, -1749, 1762, -1749, -1749, 1764, 1777, 1778, 1779, 1431, 226, 156, 1783, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 70, 1782, -1749, -1749, 1434, -1749, 70, -1749, -1749, 1436, 1788, 1792, -1749, -1749, -1749, 1794, 1795, 1796, 1797, 1798, 1799, -1749, 5084, 1800, 1801, 1803, -1749, 1804, 1805, -1749, 1806, -1749, 1807, 1808, 1809, -1749, 1810, -1749, 1812, 1435, -1749, 1463, 1464, 1470, -1749, 1471, -1749, 1465, 1466, 1467, 1468, 1469, 1472, 1473, 349, 361, 1474, 383, -1749, 384, 1476, 399, 1477, 1478, 1482, 1485, 10797, 352, 10820, 388, 1483, 10843, 10866, 544, 10889, 1490, 93, 1492, 1498, 1493, 1499, 1501, 1502, 1496, 1516, 1515, 1527, 1530, 1531, 1534, 404, 1546, 1548, 1542, 1544, 1552, 1547, 1549, 1555, 41, 41, 409, 1553, -1749, 1827, 13675, -1749, 70, 70, 16, 1554, 1560, 1567, 1571, 1573, -1749, 70, 441, 157, -1749, 1572, 425, 1832, 10159, -1749, -1749, -1749, 701, 52, -1749, -1749, -1749, -1749, 1574, -1749, -1749, 1575, -1749, 1577, -1749, -1749, 10179, 1578, -1749, -1749, 1579, -1749, -1749, -1749, 1938, 704, -1749, -1749, 70, 4331, -1749, 1585, -1749, 1945, 10179, 10179, 1592, 1611, -1749, 3897, 70, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 1814, 1949, 1578, 717, -1749, -1749, -1749, -1749, -1749, 719, -1749, 721, -1749, -1749, -1749, -1749, 1954, 1959, 1960, 1961, 1962, -1749, -1749, 1963, -1749, 1964, 1968, 8, -1749, -1749, -1749, -1749, -1749, -1749, 1596, -1749, -1749, -1749, -1749, 1604, -1749, -1749, 731, -1749, -1749, -1749, -1749, 736, -1749, -1749, 10179, 1622, 1615, 1618, 1969, 1974, 156, 226, 226, 10179, 10179, 10179, 226, 1975, 156, 1976, 70, 1624, 1981, 10179, 2003, 156, 10179, 2005, 10179, 10179, 2006, 226, 2007, 10179, 1653, 156, 10179, 10179, 156, -1749, -1749, 10179, 1654, 156, 10179, 10179, 10179, 10179, -1749, -1749, 10179, 10179, 10179, 10179, 10179, 1656, 10179, 156, -1749, -1749, 156, 3361, 10179, 10179, 226, 1657, 1659, 10179, 10179, 1662, -1749, -1749, 2013, 2018, 156, 2021, 2022, 2023, 3361, 2024, 5744, 5744, 5744, 10179, 5744, 2026, 70, 2030, 2031, 226, 226, 2032, 70, 226, 2033, -1749, -1749, -1749, -1749, 2034, 10179, 70, 6107, -1749, 2037, 1770, -1749, 156, -1749, 1665, 9772, 1684, 1685, 1687, 449, 1691, -1749, -1749, -1749, -1749, -1749, 2045, 1700, -1749, 510, 1889, 2048, 10591, -1749, -1749, 3361, -1749, 594, 1688, 156, 156, 156, 13704, 1614, 156, -1749, -1749, -1749, 1702, -1749, 1703, 10179, 1704, 10912, 10935, -1749, -1749, 5002, 1705, 2052, -1749, 2059, -1749, -1749, 2060, -1749, 2061, 1711, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 1150, 70, -1749, -1749, 226, 2062, 2065, -1749, 226, -1749, 226, 14255, 2066, -1749, -1749, -1749, -1749, 1733, 1713, 1722, 10958, 10981, 11004, 1727, -1749, 1735, -1749, 1730, 226, -1749, 13733, -1749, -1749, 13762, -1749, 13791, 13820, -1749, 1736, -1749, 11027, -1749, 2067, 5157, 5987, 2068, 11050, -1749, 2071, 6241, 6331, 6585, 6672, 11073, 11096, 11119, 6929, 7016, -1749, 7270, 2073, 1731, 1734, 7357, 7614, 2075, -1749, -1749, 7701, 7958, -1749, -1749, -1749, 534, -1749, -1749, -1749, 1746, -1749, 1747, 1748, 1738, 11142, 1751, -1749, 1435, -1749, -1749, 1754, 1755, -1749, 1756, 537, -1749, 547, 548, -1749, 13849, 1749, 417, 1767, -1749, -1749, -1749, 2092, 1768, 9772, 749, 9772, 9772, 9772, 2093, -1749, 1357, 3361, 553, 2102, 70, -1749, 5744, 3361, 5744, -1749, 1771, 2094, 10407, 10179, 10179, -1749, 5744, 10179, -1749, 10179, 3361, 2105, -1749, 10179, 10179, 2106, 5997, -1749, -1749, -1749, 1337, 1772, 1773, 1774, 1775, 10179, 1757, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, 10179, -1749, 10179, 5744, 5744, 156, 3361, 10179, 10179, 3361, 3361, 3361, 10179, 3361, -1749, 755, -1749, -1749, 10179, 1765, 1781, 1784, 1578, 1780, 1785, 402, -1749, 1787, 11165, -1749, 10179, 10179, 1789, 3897, 1790, 2107, 757, -1749, -1749, 2109, -1749, -1749, 2133, 2139, 1791, -1749, -1749, -1749, -1749, -1749, 6269, 6525, 2145, 5744, 10179, 5744, 10179, 10179, 226, 2171, 226, 1822, 2173, 2174, 2193, 2194, 2196, 156, 6612, -1749, -1749, -1749, -1749, 156, 6868, -1749, -1749, -1749, -1749, -1749, 10179, 10179, 156, -1749, -1749, 6955, -1749, -1749, -1749, 10179, -1749, -1749, -1749, 7211, 7298, -1749, -1749, 762, 2197, 10179, 2198, 2200, 2201, 10179, 3361, 3361, 1853, 10179, 10179, 3361, 2205, 10097, 2206, 5327, -1749, 2207, 2208, 2209, -1749, -1749, 1855, 156, 763, -1749, 766, 784, 803, -1749, 1854, 1864, 2215, -1749, -1749, -1749, -1749, -1749, 156, -1749, 3361, 3361, -1749, 14255, 14255, -1749, 14255, 14255, -1749, -1749, 14255, 14255, -1749, 9772, 14255, -1749, 10179, 10179, 10179, 9772, 14255, 226, 14255, 14255, 14255, 14255, 14255, 14255, 14255, 14255, 14255, 14255, 14255, -1749, -1749, -1749, -1749, 14255, 14255, -1749, -1749, -1749, 14255, -1749, -1749, 13878, 2216, 2218, 2219, 1873, 2221, 2222, 2225, 10179, 10179, 10179, 10179, 10179, -1749, -1749, 1874, 10179, 13907, 11188, 5002, -1749, 1973, 2228, 2232, -1749, 1875, 1876, -1749, -1749, -1749, 1879, -1749, -1749, 1881, 13936, 1878, 11211, 11234, 1880, -1749, 1886, 2238, -1749, -1749, -1749, -1749, -1749, 1882, -1749, 1883, -1749, 11257, 11280, 578, -1749, -94, 11303, -1749, -1749, -1749, -1749, -1749, 11326, -1749, -1749, -1749, 13965, 1891, 1892, 2243, 11349, 11372, 584, -1749, 3361, 5118, -1749, 3361, 5744, 3361, -1749, -1749, -1749, -1749, 983, 2413, 10179, 1887, 1894, 1895, 1896, 1897, -1749, -1749, -1749, 587, 1898, -1749, -1749, 806, 11395, 11418, 11441, 808, -1749, 2253, -1749, -1749, -1749, 10179, -1749, -1749, 2256, 8045, 8299, 8386, 8643, 8730, 10179, 12293, -1749, 10179, 5811, 226, -1749, 1902, -1749, 1150, -1749, 2259, 2263, 10179, 10179, 10179, 10179, 2265, -1749, 156, 10179, 156, 10179, 1911, 10179, 1912, 1913, 1917, 10179, 218, 156, 2278, 2279, 2280, -1749, 10179, 10179, 2281, 156, 588, 2282, 70, -1749, -1749, -1749, 226, 2285, 2288, 70, -1749, 1943, -1749, -1749, 11464, 156, 9772, 9772, 9772, 9772, 589, 2293, 156, -1749, 10179, 10179, 10179, -1749, -1749, 13994, -1749, -1749, -1749, -1749, -1749, -1749, 12326, -1749, 11487, -1749, 1939, 2303, 1955, 1957, 7554, -1749, -1749, 14023, 5200, 14052, 11510, -1749, 1970, 11533, 1947, 11556, -1749, 14081, -1749, -1749, -1749, 11579, 2321, 2323, 10179, 156, 2324, 70, -1749, -1749, 1977, -1749, -1749, -1749, 14110, 14139, -1749, 1978, 2325, 10179, -1749, 1982, 2331, 2333, 2334, 2335, -1749, 10179, 1967, 812, 815, 821, 825, 2336, -1749, 1980, 11602, 11625, 11648, 1983, -1749, 10179, 10179, -1749, 2338, 2340, -1749, 2341, 2342, 156, 2343, 5744, 1990, 10179, 5744, 10179, 7641, 2000, 832, 836, 7897, 10179, 2361, 2364, 8987, 2367, 2369, 2371, 2374, 2049, 2050, 2375, -1749, 10434, 2377, -1749, -1749, -1749, -1749, -1749, 12359, 2051, 2053, 2054, 2056, 2057, -1749, 156, 10179, 10179, 10179, 2389, 11671, 12392, -1749, -1749, -1749, -1749, 2063, -1749, 2058, -1749, 14168, 2064, 11694, -1749, -1749, 226, -1749, 226, -1749, -1749, 11717, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 2407, 70, -1749, 2069, 2070, 5744, 9772, 2074, 9772, 9772, 2072, 12425, 12458, 12491, -1749, 10179, 2409, 2414, 10179, 7984, 2078, 5744, 3361, 8240, 2077, 2079, 5744, 8327, 8583, -1749, 2076, 2417, 10179, 2088, 837, 10179, 839, 850, -1749, -1749, -1749, -1749, 14197, 2239, -1749, 11740, -1749, -1749, 2090, 2095, -1749, 10179, 10179, 2096, -1749, -1749, 2418, -1749, 12524, 5744, 2100, 12557, 2101, 2080, -1749, 70, 10179, 8670, 5744, 5744, 11763, 11786, 5744, -1749, -1749, 2103, -1749, -1749, 2104, 9772, 2422, 14226, -1749, 2108, 2110, 10179, 10179, 2111, 5744, 10179, 852, 2266, 2424, 2450, -1749, 11809, 11832, 5744, 2115, 11855, 2120, 226, -1749, -1749, -50, 2463, 2464, 2113, -1749, 10179, 2122, 2123, 2125, 2126, 10179, 2114, 2467, 2127, 2130, 12590, 10179, 10179, -1749, -1749, 11878, 2131, 2134, -1749, -1749, -1749, 11901, 12623, 863, 867, 10179, -1749, -1749, 8926, 10179, 2482, 226, -1749, 226, -1749, 11924, 9013, 2140, 11947, 2141, 2132, 2142, 10179, 2143, -1749, 10179, -1749, 10179, 10179, 14255, -1749, 9269, 12656, 11970, 11993, 9356, -1749, -1749, 10179, 10179, -1749, 12016, 12039, 2498, 2502, 2146, 2147, -1749, -1749 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. Performed when YYTABLE does not specify something else to do. Zero means the default is an error. */ static const yytype_uint16 yydefact[] = { 2, 0, 4, 1, 5, 0, 909, 731, 732, 0, 0, 0, 0, 720, 0, 0, 728, 729, 0, 723, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 17, 18, 0, 730, 910, 0, 0, 0, 0, 754, 0, 0, 0, 0, 0, 721, 912, 0, 0, 0, 0, 0, 0, 0, 0, 924, 0, 922, 923, 0, 722, 914, 0, 714, 715, 0, 929, 928, 19, 770, 779, 20, 190, 153, 166, 224, 66, 285, 363, 0, 567, 596, 0, 932, 933, 0, 0, 0, 0, 873, 0, 0, 0, 0, 0, 0, 0, 0, 855, 854, 909, 0, 0, 0, 0, 856, 862, 863, 857, 858, 859, 860, 861, 867, 864, 865, 866, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 807, 870, 851, 852, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 724, 0, 64, 64, 0, 0, 0, 0, 0, 0, 0, 0, 735, 0, 0, 0, 748, 747, 0, 0, 909, 0, 0, 0, 0, 0, 0, 0, 875, 0, 876, 910, 0, 873, 873, 0, 0, 880, 0, 881, 0, 0, 0, 0, 911, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 809, 810, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 853, 726, 727, 930, 0, 0, 0, 0, 0, 0, 0, 926, 0, 0, 0, 0, 65, 0, 0, 0, 0, 7, 21, 28, 0, 194, 9, 191, 193, 155, 10, 168, 11, 228, 12, 225, 227, 0, 8, 67, 71, 0, 289, 13, 286, 288, 367, 14, 364, 366, 571, 15, 568, 570, 600, 16, 597, 599, 616, 934, 935, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 809, 884, 874, 0, 0, 0, 0, 736, 0, 0, 0, 0, 0, 0, 745, 0, 0, 873, 0, 0, 0, 0, 0, 907, 750, 0, 751, 0, 0, 0, 0, 0, 0, 868, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 808, 0, 0, 0, 826, 825, 823, 824, 819, 821, 820, 822, 812, 811, 813, 816, 817, 814, 815, 818, 0, 936, 0, 920, 0, 915, 916, 917, 913, 763, 918, 925, 0, 733, 771, 734, 781, 780, 59, 873, 0, 0, 0, 0, 0, 72, 0, 0, 0, 0, 0, 0, 0, 746, 908, 896, 0, 898, 0, 909, 0, 0, 0, 0, 0, 0, 877, 894, 0, 813, 885, 816, 887, 890, 891, 886, 892, 888, 893, 889, 897, 0, 741, 743, 0, 873, 873, 873, 0, 0, 882, 883, 0, 0, 0, 872, 0, 938, 0, 757, 827, 828, 829, 830, 831, 832, 833, 834, 835, 836, 0, 838, 839, 840, 841, 842, 843, 844, 845, 0, 0, 0, 849, 871, 0, 716, 0, 931, 0, 0, 0, 725, 0, 0, 64, 909, 0, 34, 0, 0, 0, 873, 0, 0, 0, 192, 195, 0, 0, 154, 156, 0, 77, 0, 167, 169, 0, 0, 0, 0, 0, 0, 226, 229, 230, 64, 909, 0, 0, 32, 0, 33, 0, 0, 0, 0, 287, 290, 0, 0, 0, 372, 365, 368, 374, 0, 0, 0, 0, 569, 572, 0, 0, 0, 0, 0, 0, 0, 0, 873, 873, 0, 0, 0, 598, 601, 615, 618, 0, 0, 901, 0, 0, 0, 0, 906, 878, 0, 0, 0, 737, 0, 0, 0, 873, 873, 0, 753, 0, 0, 0, 0, 0, 0, 0, 0, 0, 850, 921, 0, 927, 0, 764, 873, 773, 776, 0, 0, 0, 0, 47, 909, 0, 44, 0, 31, 42, 50, 22, 0, 0, 0, 201, 0, 0, 200, 159, 0, 173, 0, 0, 0, 0, 84, 0, 276, 0, 0, 237, 253, 268, 0, 0, 77, 0, 316, 0, 0, 295, 0, 0, 375, 0, 0, 577, 0, 0, 0, 0, 618, 0, 0, 0, 0, 608, 0, 0, 0, 0, 0, 619, 749, 0, 0, 0, 0, 0, 895, 879, 0, 742, 744, 738, 0, 0, 752, 0, 718, 937, 939, 869, 0, 758, 837, 846, 847, 848, 717, 0, 0, 0, 0, 774, 777, 772, 27, 60, 24, 0, 0, 0, 64, 0, 37, 29, 36, 23, 201, 0, 197, 196, 0, 157, 0, 0, 0, 0, 171, 78, 0, 170, 0, 232, 231, 0, 0, 0, 68, 73, 0, 77, 0, 292, 291, 0, 369, 370, 0, 397, 573, 0, 574, 575, 602, 603, 619, 604, 609, 0, 605, 606, 607, 612, 611, 610, 617, 0, 899, 902, 903, 0, 0, 900, 739, 740, 0, 873, 0, 919, 0, 765, 766, 768, 767, 757, 763, 0, 0, 0, 48, 51, 52, 43, 0, 53, 64, 0, 204, 198, 203, 161, 158, 175, 172, 0, 0, 79, 909, 782, 783, 784, 785, 786, 787, 788, 789, 790, 791, 792, 793, 794, 795, 796, 797, 798, 799, 800, 801, 802, 803, 804, 0, 132, 0, 0, 0, 0, 119, 121, 123, 125, 0, 0, 0, 0, 0, 0, 0, 0, 85, 86, 117, 805, 0, 114, 870, 142, 143, 279, 236, 278, 240, 233, 239, 255, 234, 271, 235, 270, 0, 69, 0, 0, 0, 0, 0, 294, 317, 318, 298, 293, 297, 378, 371, 377, 0, 580, 576, 579, 614, 0, 0, 0, 0, 0, 0, 620, 629, 0, 0, 719, 0, 759, 761, 762, 0, 0, 0, 61, 0, 0, 0, 0, 45, 0, 0, 199, 0, 0, 0, 75, 76, 116, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 109, 108, 110, 0, 909, 140, 138, 137, 136, 135, 909, 0, 87, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 118, 149, 0, 0, 0, 0, 0, 70, 332, 332, 343, 323, 0, 0, 909, 0, 0, 77, 77, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 401, 403, 402, 404, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 405, 406, 407, 408, 409, 410, 0, 0, 0, 462, 464, 373, 0, 0, 398, 498, 0, 0, 0, 0, 0, 0, 0, 904, 905, 0, 880, 769, 775, 778, 0, 63, 25, 49, 46, 30, 41, 0, 0, 0, 0, 0, 0, 77, 0, 77, 77, 77, 0, 0, 0, 77, 202, 205, 0, 0, 160, 162, 0, 0, 0, 174, 176, 0, 84, 0, 0, 127, 806, 0, 84, 84, 84, 84, 0, 0, 113, 0, 0, 0, 362, 0, 106, 105, 102, 103, 104, 98, 100, 99, 101, 94, 95, 90, 93, 96, 91, 97, 139, 141, 145, 0, 147, 0, 0, 115, 0, 0, 0, 0, 277, 280, 0, 0, 0, 0, 80, 80, 0, 0, 238, 241, 0, 0, 0, 254, 256, 0, 0, 0, 269, 272, 74, 349, 349, 349, 0, 0, 0, 0, 0, 0, 0, 0, 0, 873, 308, 296, 299, 0, 0, 0, 0, 873, 0, 0, 0, 376, 379, 388, 0, 0, 77, 77, 77, 0, 77, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 426, 0, 0, 77, 0, 0, 0, 0, 0, 0, 0, 525, 0, 532, 0, 0, 0, 540, 0, 0, 547, 422, 423, 424, 873, 77, 0, 0, 0, 473, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 578, 581, 0, 0, 636, 0, 0, 626, 649, 0, 760, 0, 0, 54, 0, 40, 39, 0, 0, 0, 0, 77, 0, 0, 77, 0, 77, 0, 0, 0, 0, 0, 77, 0, 0, 0, 149, 180, 0, 0, 130, 0, 131, 0, 0, 0, 0, 0, 0, 0, 84, 0, 107, 361, 0, 144, 146, 0, 0, 0, 0, 0, 35, 0, 0, 0, 0, 0, 251, 0, 77, 0, 0, 0, 0, 0, 264, 266, 0, 260, 262, 0, 0, 0, 0, 0, 0, 77, 0, 350, 351, 352, 353, 354, 355, 356, 357, 358, 359, 360, 0, 0, 319, 333, 0, 320, 0, 321, 344, 0, 0, 0, 328, 322, 324, 0, 0, 0, 0, 0, 0, 305, 0, 0, 0, 0, 84, 0, 0, 391, 0, 389, 0, 0, 0, 395, 0, 393, 0, 399, 411, 0, 0, 0, 412, 0, 413, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 82, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 80, 80, 0, 0, 584, 0, 0, 638, 0, 0, 0, 0, 0, 0, 0, 0, 649, 0, 0, 77, 649, 0, 0, 0, 0, 755, 56, 55, 0, 0, 207, 208, 215, 216, 0, 219, 221, 0, 218, 0, 210, 209, 0, 64, 212, 206, 0, 217, 164, 163, 0, 0, 177, 178, 0, 0, 84, 0, 120, 0, 0, 0, 0, 0, 88, 148, 0, 150, 152, 281, 282, 283, 284, 242, 243, 0, 0, 64, 0, 247, 248, 249, 250, 257, 64, 259, 64, 258, 274, 273, 275, 0, 0, 0, 0, 0, 340, 334, 0, 346, 0, 0, 0, 312, 311, 303, 301, 302, 300, 314, 307, 313, 310, 304, 0, 381, 380, 64, 382, 383, 386, 387, 64, 384, 385, 0, 0, 0, 0, 0, 0, 77, 0, 0, 0, 0, 0, 0, 0, 77, 0, 0, 0, 0, 0, 0, 77, 0, 0, 0, 0, 0, 0, 0, 0, 0, 77, 0, 0, 77, 414, 526, 0, 0, 77, 0, 0, 0, 0, 415, 533, 0, 0, 0, 0, 0, 0, 0, 77, 416, 541, 77, 0, 0, 0, 0, 0, 0, 0, 0, 0, 417, 548, 0, 0, 77, 0, 0, 0, 0, 0, 873, 873, 873, 0, 873, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 499, 501, 500, 501, 0, 0, 0, 0, 582, 0, 639, 640, 77, 642, 0, 0, 0, 0, 0, 0, 0, 634, 635, 632, 633, 630, 0, 0, 649, 0, 0, 0, 0, 650, 628, 0, 763, 0, 0, 77, 77, 77, 0, 0, 77, 165, 182, 179, 0, 92, 0, 0, 0, 0, 0, 134, 111, 0, 0, 0, 244, 0, 81, 265, 0, 261, 0, 0, 338, 342, 339, 337, 84, 345, 84, 325, 326, 0, 0, 327, 329, 0, 0, 0, 390, 0, 394, 0, 400, 0, 397, 397, 419, 420, 0, 0, 0, 0, 0, 0, 0, 433, 0, 436, 0, 0, 438, 0, 446, 83, 0, 448, 0, 0, 451, 0, 497, 0, 397, 0, 0, 0, 0, 0, 397, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 397, 0, 0, 0, 0, 0, 0, 0, 397, 397, 0, 0, 557, 425, 421, 0, 469, 470, 474, 0, 476, 0, 0, 0, 0, 0, 478, 399, 482, 483, 0, 0, 488, 0, 0, 468, 0, 0, 471, 0, 0, 909, 0, 583, 587, 613, 0, 0, 0, 0, 0, 0, 0, 0, 637, 636, 0, 0, 0, 0, 625, 873, 0, 873, 661, 0, 0, 0, 0, 0, 663, 873, 0, 660, 0, 0, 0, 656, 657, 0, 0, 0, 677, 678, 679, 80, 683, 685, 687, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 702, 703, 873, 873, 77, 0, 0, 709, 0, 0, 0, 0, 0, 756, 0, 58, 57, 0, 0, 0, 0, 64, 0, 0, 0, 133, 0, 0, 122, 0, 0, 0, 89, 0, 0, 64, 267, 263, 0, 335, 347, 0, 0, 0, 306, 309, 392, 396, 418, 0, 0, 0, 873, 0, 873, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 77, 0, 529, 527, 528, 530, 77, 0, 536, 534, 535, 537, 538, 0, 0, 77, 545, 543, 0, 542, 544, 518, 0, 552, 551, 553, 0, 0, 549, 550, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 873, 502, 0, 0, 0, 588, 588, 0, 77, 0, 644, 0, 0, 0, 621, 0, 0, 0, 622, 649, 674, 666, 680, 77, 671, 0, 0, 651, 655, 667, 668, 659, 664, 665, 662, 658, 673, 672, 0, 675, 682, 0, 0, 0, 0, 691, 0, 700, 701, 696, 697, 698, 699, 692, 693, 694, 695, 704, 669, 670, 705, 706, 708, 710, 711, 712, 713, 654, 707, 62, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 181, 183, 0, 0, 0, 0, 0, 151, 0, 0, 0, 341, 0, 0, 330, 331, 315, 427, 429, 430, 0, 0, 0, 0, 0, 0, 434, 0, 0, 439, 447, 449, 450, 496, 0, 531, 0, 539, 0, 0, 0, 546, 0, 0, 555, 556, 559, 554, 466, 0, 475, 431, 432, 0, 0, 0, 0, 0, 0, 0, 492, 0, 0, 463, 0, 873, 0, 506, 465, 472, 495, 349, 349, 0, 0, 0, 0, 0, 0, 631, 649, 623, 0, 0, 652, 653, 0, 0, 0, 0, 0, 690, 0, 223, 222, 211, 0, 213, 220, 0, 0, 0, 0, 0, 0, 0, 0, 124, 0, 0, 0, 245, 0, 84, 0, 397, 0, 0, 0, 0, 0, 0, 0, 437, 77, 0, 77, 0, 0, 0, 0, 0, 0, 0, 0, 77, 0, 0, 0, 479, 0, 0, 0, 77, 0, 0, 0, 503, 504, 505, 0, 0, 0, 0, 586, 0, 589, 585, 0, 77, 0, 0, 0, 0, 0, 0, 77, 676, 0, 0, 0, 689, 26, 0, 184, 185, 186, 187, 188, 189, 0, 129, 0, 112, 0, 0, 0, 0, 0, 440, 441, 0, 0, 0, 0, 435, 0, 0, 0, 0, 397, 0, 521, 523, 397, 0, 0, 0, 0, 77, 0, 0, 558, 560, 0, 477, 480, 481, 0, 0, 485, 0, 0, 0, 493, 0, 0, 0, 0, 0, 590, 0, 0, 0, 0, 0, 0, 0, 627, 0, 0, 0, 0, 0, 128, 0, 0, 246, 0, 0, 428, 0, 0, 77, 0, 873, 0, 0, 873, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 491, 0, 0, 594, 595, 592, 593, 84, 0, 0, 0, 0, 0, 0, 624, 77, 0, 0, 0, 0, 0, 0, 336, 348, 442, 443, 0, 445, 0, 397, 0, 0, 0, 458, 397, 0, 519, 0, 520, 457, 0, 566, 561, 564, 565, 562, 563, 467, 397, 397, 484, 0, 0, 494, 0, 0, 873, 0, 0, 0, 0, 0, 0, 0, 0, 214, 0, 0, 0, 0, 0, 0, 873, 0, 0, 0, 0, 873, 0, 0, 490, 0, 0, 0, 0, 0, 0, 0, 0, 681, 684, 686, 688, 0, 0, 444, 0, 453, 397, 0, 0, 459, 0, 0, 0, 486, 487, 0, 591, 0, 873, 0, 0, 0, 0, 126, 0, 0, 0, 873, 873, 0, 0, 873, 489, 648, 0, 641, 645, 0, 0, 0, 0, 454, 0, 0, 0, 0, 0, 873, 0, 0, 0, 0, 0, 511, 0, 0, 873, 0, 0, 0, 0, 452, 455, 507, 0, 0, 0, 643, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 514, 516, 508, 0, 0, 524, 397, 646, 0, 0, 0, 0, 0, 397, 522, 0, 0, 0, 0, 512, 0, 513, 509, 0, 460, 0, 0, 0, 0, 0, 0, 397, 0, 252, 0, 0, 510, 397, 0, 0, 0, 0, 0, 461, 647, 0, 0, 456, 0, 0, 0, 0, 0, 0, 515, 517 }; /* YYPGOTO[NTERM-NUM]. */ static const yytype_int16 yypgoto[] = { -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -277, -1749, -1004, 1338, -1749, -1749, 1339, -647, -1749, -628, -1749, -1749, -1749, -167, -1749, -1749, -1749, 1707, -1749, -1183, 1138, -1121, -1749, 605, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -867, -1749, 1173, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 1763, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 1505, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1207, -838, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1748, 636, -1749, -1749, -1749, -1749, -1749, 1012, 796, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 451, -1749, -1749, -1749, -1749, -1749, -1749, -1749, -1749, 1830, -1749, -1749, -1749, 1437, -1749, 617, 1219, -1491, -1749, 2255, 48, -1749, -1749, -1749, 1732, -1749, -815, -1749, -1749, -1749, -1749, -1749, -1749, -11, 1936, -308, -1749, 853, -79, -4, 2402, -5, 86, -1749, 161, -158, 549, -259, -1749, 169, 586 }; /* YYDEFGOTO[NTERM-NUM]. */ static const yytype_int16 yydefgoto[] = { -1, 1, 2, 4, 5, 36, 172, 286, 821, 1317, 562, 828, 563, 533, 747, 947, 1111, 648, 744, 649, 1530, 527, 1103, 281, 177, 303, 558, 1461, 666, 1718, 1462, 761, 762, 882, 1154, 1775, 1986, 883, 962, 963, 964, 965, 1347, 957, 1000, 1176, 1178, 174, 435, 543, 754, 951, 1130, 175, 436, 548, 756, 952, 1135, 1553, 1979, 2151, 173, 291, 434, 539, 751, 950, 1126, 176, 299, 437, 556, 767, 1003, 1194, 1578, 768, 1004, 1199, 1384, 1588, 1381, 1586, 769, 1005, 1204, 764, 1002, 1184, 178, 308, 440, 570, 777, 1012, 1221, 1611, 1429, 1800, 774, 910, 1209, 1417, 1604, 1798, 1206, 1406, 1790, 2162, 1208, 1411, 1792, 2163, 1407, 884, 179, 312, 441, 576, 685, 780, 1013, 1231, 1433, 1619, 1439, 1624, 918, 1628, 1085, 1086, 1087, 1297, 1298, 1719, 1889, 2068, 2592, 2581, 2609, 2610, 2192, 2412, 2413, 1470, 1663, 1472, 1672, 1476, 1682, 1479, 1694, 2051, 2284, 2363, 181, 316, 442, 583, 783, 1089, 1304, 1725, 2221, 2306, 2433, 182, 320, 443, 598, 37, 444, 703, 799, 929, 1523, 1306, 1744, 1520, 1518, 1524, 1751, 69, 1088, 39, 40, 1098, 624, 725, 523, 635, 170, 817, 818, 171, 885, 886, 196, 152, 492, 197, 339, 198, 41, 153, 74, 422, 267, 268, 94, 326, 68, 154, 155 }; /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If positive, shift that token. If negative, reduce the rule whose number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int16 yytable[] = { 42, 1412, 955, 940, 283, 748, 1374, 1375, 276, 414, 416, 654, 6, 1795, 740, 70, 1344, 73, 424, 1001, 206, 559, 1349, 1350, 1351, 1352, 6, 1737, 86, 11, 89, 1747, 6, 6, 93, 643, 1379, 6, 11, 101, 102, 6, 73, 11, 1382, 643, 6, 644, 662, 11, 11, 48, 1413, 38, 11, 643, 263, 6, 11, 1301, 2004, 2005, 264, 11, 11, 643, 565, 6, 643, 6, 6, 1127, 2280, 360, 11, 559, 1414, 1302, 544, 974, 3, 6, 1128, 545, 11, 43, 11, 11, 2022, 1310, 559, 546, 11, 47, 2028, 207, 732, 1131, 11, 535, 1132, 1133, 536, 809, 67, 2039, 71, 11, 1320, 1321, 1322, 1323, 537, 2047, 2048, 530, 2589, 1109, 1136, 1420, 1138, 733, 540, 1338, 6, 559, 746, 966, 662, 1685, 7, 8, 9, 10, 662, 541, 340, 663, 44, -3, 45, 11, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 73, 73, 532, 73, 73, 73, 274, 2281, 73, 73, 50, 23, 24, 967, 288, 42, 530, 1796, 42, 305, 42, 42, 566, 42, 42, 322, 662, 186, 662, 200, 75, 530, 567, 601, 1376, 1377, 46, 337, 207, -35, 662, 662, 662, 525, 51, 946, 337, 1365, 568, 43, 819, 2590, 72, 1200, 1110, 103, 1686, 73, 367, 368, 1427, 1337, 734, 1201, 663, 1202, 530, 287, 292, 810, 663, 300, 304, 309, 313, 526, 317, 321, 6, 1564, 1222, 1185, 820, 1186, 1187, 1188, 1189, 1190, 1191, 1192, 1223, 1260, 76, 445, 96, 11, 1421, 1261, 275, 978, 975, 2356, 1910, 458, 653, 1422, 1687, 97, 98, 631, 2282, 6, 1308, 1688, 1689, 663, 11, 663, 99, 1482, 70, 77, 1348, 427, 90, 429, 91, 214, 11, 663, 663, 663, 432, 1224, 1225, 1226, 1227, 1228, 1229, 43, 719, 530, 349, 1105, 210, 433, 98, 1415, 1416, 1690, 1195, 211, 1196, 394, 95, 1616, 99, 1691, 1692, 95, 1197, 2591, 104, 1303, 1107, 43, 279, 269, 207, 271, 272, 273, 451, 280, 454, 277, 73, 547, 207, 2357, 78, 2358, 1129, 521, 463, 465, 282, 466, 467, 469, 471, 168, 2359, 280, 33, 353, 1134, 423, 538, 463, 1150, 484, 664, 976, 413, 2360, 79, 641, 354, 355, 721, 71, 43, 1237, 80, 655, 430, 602, 1797, 180, 43, 542, 561, 366, 1233, 1730, 323, 2361, 324, 611, 459, 358, 473, 645, 43, 325, 88, 1432, 675, 474, 1380, 646, 612, 645, 647, 1438, 1597, 49, 1383, 81, 1373, 646, 1600, 645, 647, 73, 945, 578, 207, 73, 328, 646, -35, 645, 647, 90, 645, 91, 329, 361, 92, 569, 43, 579, 647, 161, 561, 647, 328, 42, 82, 564, 664, 42, 1768, 42, 329, 633, 664, 560, 43, 561, 207, 1239, 634, 344, 345, 346, 347, 1324, 580, 887, 1203, 1693, 207, 348, 247, 248, 249, 250, 251, 1319, 252, 253, 254, 255, 605, 207, 83, 811, 1193, 997, 260, 998, 261, 262, 561, 1745, 263, 1230, 84, 73, 557, 664, 264, 664, 577, 96, 599, 1262, 293, 294, 457, 480, 1327, 1263, 1329, 664, 664, 664, 97, 98, 640, 1728, 1729, 1731, 481, 482, 1335, 280, 85, 99, 1738, 439, 2338, 200, 2144, 2145, 2146, 2147, 2148, 2149, 1657, 650, 261, 262, 1658, 87, 263, 657, 1179, 42, 100, 660, 264, 323, 581, 324, 162, 1198, 1180, 1181, 1182, 670, 344, 345, 346, 347, 1388, 1766, 1659, 1660, 1661, 650, 348, 1528, 824, 1529, 1665, 680, 357, 1776, 1666, 682, 887, 887, 887, 887, 163, 358, 686, 520, 688, 689, 826, 522, 690, 1676, 2362, 693, 73, 674, 1388, 328, 658, 183, 1667, 1668, 280, 1669, 1670, 329, 2232, 604, 1970, 43, 1971, 214, 707, 2410, 158, 159, 160, 2414, 164, 881, 261, 262, 638, 43, 346, 347, 167, 247, 248, 249, 250, 251, 348, 252, 253, 254, 255, 723, 73, 256, 257, 258, 259, 260, 724, 261, 262, 739, 650, 263, 1822, 165, 743, 184, 745, 264, -38, 1359, 650, 720, 582, 622, 887, 280, 1360, 938, 166, 1389, 215, 1390, 1391, 1677, 948, 990, 991, 992, 993, 994, 995, 185, 1994, 771, 1995, 996, 887, 887, 887, 887, 887, 887, 887, 887, 887, 887, 887, 887, 887, 887, 887, 887, 187, 1389, 887, 1390, 1391, 1392, 1393, 1394, 1395, 1396, 1397, 1398, 1399, 1400, 1401, 1402, 1880, 1640, 2496, 1403, 1404, 201, 1886, 2500, 1641, 323, 1662, 324, 1678, 1642, 202, 1893, 209, 736, 413, 212, 1643, 2504, 2505, 1392, 1393, 1394, 1395, 1396, 1397, 1398, 1399, 1400, 1401, 1402, 2314, 1645, 1647, 1403, 1404, 295, 296, 42, 1646, 1648, 694, 216, 1671, 213, 1679, 1680, 2107, 1650, 888, 323, 42, 324, 1708, 42, 1651, 42, 2150, 1722, 415, 1709, 42, 1183, 217, 42, 1723, 218, 42, 2544, 1210, 42, 2072, 1211, 1212, 1749, 43, 1739, 1740, 1741, 1742, 323, 1750, 324, 1213, 1997, 731, 42, 609, 358, 358, 219, 832, 220, 344, 345, 346, 347, 1743, 1906, 73, 1214, 1215, 1216, 348, 893, 1750, 245, 896, 221, 901, 814, 815, 816, 650, 911, 827, 42, 914, 705, 358, 917, 1217, 222, 921, 344, 345, 346, 347, 992, 993, 994, 995, 887, 223, 348, 887, 996, 343, 887, 930, 982, 983, 984, 985, 986, 987, 988, 989, 224, 2614, 990, 991, 992, 993, 994, 995, 2622, 711, 358, 1911, 996, 225, 888, 888, 888, 888, 1750, 977, 979, 832, 226, 712, 358, 227, 2637, 228, 1756, 258, 259, 260, 2641, 261, 262, 2052, 229, 263, 2064, 936, 937, 1266, 2053, 264, 350, 2065, 362, 1267, 2066, 2069, 230, 1681, 2086, 1405, 2084, 2067, 2067, 42, 105, 106, 107, 1750, 1218, 1112, 1113, 1114, 1115, 1116, 1117, 1118, 1119, 1120, 1121, 1122, 207, 889, 231, 11, 1123, 2278, 825, 280, 650, 1969, 650, 2292, 2279, 1408, 2315, 2372, 2387, 1124, 2293, 1140, 1142, 1750, 2373, 1750, 888, 1141, 1141, 1996, 111, 232, 112, 113, 114, 115, 116, 117, 118, 119, 120, 233, 121, 122, 123, 1152, 833, 834, 888, 888, 888, 888, 888, 888, 888, 888, 888, 888, 888, 888, 888, 888, 888, 888, 835, 836, 888, 234, 1392, 1393, 1394, 1395, 1396, 1397, 1398, 1399, 1400, 1401, 1402, 235, 42, 1234, 1409, 897, 898, 236, 2305, 2305, 250, 251, 237, 252, 253, 254, 255, 1219, 1545, 256, 257, 258, 259, 260, 1220, 261, 262, 1100, 413, 263, 238, 779, 887, 1101, 724, 264, 1102, 634, 889, 889, 889, 889, 1313, 1314, 239, 6, 887, 240, 351, 352, 241, 7, 8, 9, 10, 1232, 1569, 358, 1754, 1755, 1764, 1765, 11, 330, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1780, 1648, 1781, 280, 1783, 280, 1307, 1307, 564, 73, 73, 23, 24, 2300, 1802, 280, 2301, 2302, 1362, 1804, 280, 344, 345, 346, 347, 1318, 650, 564, 564, 564, 564, 348, 2077, 358, 426, 802, 331, 1333, 2136, 634, 2159, 280, 564, 1339, 2196, 2197, 2225, 358, 889, 2226, 358, 1392, 1393, 1394, 1395, 1396, 1397, 1398, 1399, 1400, 1401, 1402, 2336, 888, 332, 2303, 888, 2227, 358, 888, 889, 889, 889, 889, 889, 889, 889, 889, 889, 889, 889, 889, 889, 889, 889, 889, 2228, 358, 889, 2317, 358, 2321, 358, 207, 1364, 2436, 358, 1368, 2437, 358, 1369, 1370, 333, 1125, 2438, 358, 564, 564, 2439, 358, 905, 906, 907, 908, 2461, 2462, 1386, 1387, 2463, 2464, 2537, 358, 2539, 358, 418, 1418, 477, 334, 1423, 1424, 394, 1410, 564, 2540, 358, 2577, 358, 419, 1431, 1434, 73, 420, 73, 1440, 1441, 2617, 2618, 421, 1442, 2619, 2620, 428, 431, 438, 446, 450, 1450, 1451, 1452, 1453, 1454, 1455, 1456, 1457, 1458, 348, 1459, 1460, 475, 1463, 1464, 1465, 1466, 1467, 73, 1311, 1312, 476, 478, 1473, 479, 489, 490, 1363, 73, 1544, 491, 516, 524, 534, 150, 564, 73, 73, 33, 73, 73, 73, 1488, 1489, 1490, 1491, 1492, 1493, 1494, 1495, 1496, 1497, 1498, 1499, 1500, 1501, 2375, 600, 73, 1505, 613, 1507, 603, 2379, 247, 248, 249, 250, 251, 608, 252, 253, 254, 255, 73, 617, 2480, 620, 618, 632, 260, 889, 261, 262, 889, 642, 263, 889, 651, 656, 652, 667, 264, 659, 661, 614, 615, 616, 668, 669, 671, 672, 52, 53, 673, 888, 54, 55, 676, 677, 2304, 678, 890, 56, 57, 58, 59, 679, 681, 888, 60, 2421, 684, 687, 692, 247, 248, 249, 250, 251, 695, 252, 253, 254, 255, 696, 697, 256, 257, 258, 259, 260, 1761, 261, 262, 61, 704, 263, 1594, 706, 1435, 351, 1437, 264, 713, 62, 714, 715, 718, 738, 750, 741, 564, 749, 752, 753, 755, 757, 564, 758, 759, 760, 763, 909, 765, 766, 1779, 770, 773, 775, 776, 778, 781, 1782, 1468, 1784, 782, 784, 785, 786, 2337, 789, 790, 792, 1478, 793, 794, 798, 800, 801, 805, 806, 1483, 1484, 807, 1485, 1486, 1487, 822, 698, 699, 838, 839, 902, 903, 922, 1803, 1977, 941, 943, 944, 1805, 954, 1007, 1504, 890, 890, 890, 890, 956, 958, 887, 959, 960, 716, 717, 961, 999, 2507, -806, 1527, 1008, 1106, 1147, 968, 969, 970, 971, 1009, 1010, 1011, 1091, 1092, 735, 983, 984, 985, 986, 987, 988, 989, 1720, 1720, 990, 991, 992, 993, 994, 995, 564, 564, 564, 1093, 996, 1094, 1095, 881, 1137, 564, 889, 1108, 1143, 1144, 1145, 1146, 256, 257, 258, 259, 260, 650, 261, 262, 889, 1148, 263, 996, 986, 987, 988, 989, 264, 2557, 990, 991, 992, 993, 994, 995, 890, 1151, 1153, 1177, 996, 787, 564, 1509, 1510, 1511, 1512, 1513, 1514, 1515, 1516, 1517, 1235, 1236, 564, 1139, 1241, 1242, 890, 890, 890, 890, 890, 890, 890, 890, 890, 890, 890, 890, 890, 890, 890, 890, 1250, 1243, 890, 1155, 1156, 1157, 1158, 1159, 1160, 1161, 1162, 1163, 1164, 1165, 1166, 1167, 1168, 1169, 1170, 1244, 1245, 1175, 1246, 1270, 1247, 1248, 1249, 1251, 1252, 1253, 1254, 1255, 1256, 1257, 105, 106, 107, 1258, 1259, 1264, 1265, 1268, 1269, 1271, 1272, 1273, 1813, 1814, 1274, 1275, 1276, 1818, 1277, 11, 1278, 564, 1279, 1280, 1281, 1316, 1282, 1283, 1332, 1284, 1285, 1286, 1833, 1287, 1288, 1289, 1290, 1902, 1291, 63, 64, 65, 66, 1292, 111, 935, 112, 113, 114, 115, 116, 117, 118, 119, 120, 1293, 121, 122, 123, 1334, 1294, 1341, 73, 1295, 1296, 1860, 1299, 1300, 1340, 1342, 1109, 1343, 1345, 1353, 1371, 1356, 1358, 1378, 1385, 73, 1372, 1419, 1373, 1426, 1430, 1443, 1502, 564, 1447, 1449, 1883, 1884, 1503, 564, 1887, 1506, 1519, 1558, 1521, 1525, 1532, 1531, 564, 42, 1533, 1534, 1535, 1537, 1540, 1542, 1543, 1546, 207, 1547, 1549, 1550, 1551, 890, 1554, 1555, 890, 1556, 1559, 890, 1560, 1561, 1562, 1571, 1563, 1568, 1572, 73, 1573, 1574, 1575, 1576, 1354, 1570, 6, 1355, 1579, 1577, 1357, 1581, 7, 8, 9, 10, 1582, 1583, 1584, 1585, 1587, 888, 1589, 11, 1897, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1590, 1591, 1592, 1593, 1596, 1598, 1599, 564, 1601, 1602, 1998, 23, 24, 1603, 2001, 1627, 2002, 1605, 1606, 1607, 1608, 1609, 1610, 1613, 1614, 2141, 1615, 1617, 1618, 1620, 1621, 1622, 1623, 1625, 2015, 1626, 1629, 1630, 2076, 2160, 2078, 2079, 2080, 1631, 1632, 1633, 1634, 1635, 1636, 1637, 1726, 1653, 1638, 1639, 1644, 1752, 1649, 1652, 1655, 284, 6, 1857, 1654, 1673, 887, 1695, 7, 8, 9, 10, 1684, 1696, 1698, 1697, 1699, 1700, 1701, 11, 1872, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1702, 247, 248, 249, 250, 251, 1703, 252, 253, 254, 255, 23, 24, 256, 257, 258, 259, 260, 1704, 261, 262, 1705, 1706, 263, 207, 1707, 207, 207, 207, 264, 1710, 73, 1711, 1712, 564, 1713, 1714, 73, 1715, 1717, 1716, 1968, 73, 1732, 1724, 252, 253, 254, 255, 1733, 73, 256, 257, 258, 259, 260, 1734, 261, 262, 890, 1735, 263, 1736, 1748, 549, 1757, 1758, 264, 1759, 280, 1762, 889, 1763, 890, 1769, 1770, 1773, 1774, 1557, 1799, 550, 1777, 73, 1778, 1785, 73, 73, 73, 1801, 73, 551, 552, 1567, 1786, 1787, 1788, 1789, 1791, 1793, 553, 150, 554, 1794, 1810, 1808, 33, 1807, 1809, 1811, 1819, 1821, 1823, 151, 156, 157, 1824, 980, 981, 982, 983, 984, 985, 986, 987, 988, 989, 42, 42, 990, 991, 992, 993, 994, 995, 2175, 169, 2177, 1826, 996, 1829, 1832, 1834, 1836, 1842, 42, 1853, 1861, 1866, 1862, 1346, 42, 1865, 1867, 2236, 1901, 1869, 1870, 1871, 1873, 2240, 1879, 42, 205, 208, 1881, 1882, 1885, 1888, 1891, 42, 42, 1898, 1899, 1903, 1904, 1907, 1905, 1908, 1912, 1972, 73, 73, 1913, 1909, 1989, 73, 1980, 1981, 1983, 1988, 1566, 1990, 1991, 1992, 33, 1993, 1999, 2083, 1428, 2000, 2003, 2023, 2026, 2088, 2007, 2029, 1436, 2041, 2094, 2046, 242, 243, 244, 2008, 73, 73, 2100, 2006, 2012, 2013, 2020, 2014, 2042, 270, 2074, 2043, 2091, 2081, 207, 2057, 2054, 2055, 2056, 2071, 207, 2241, 2085, 2101, 2104, 2260, 285, 2158, 2059, 2161, 2113, 2061, 2062, 2063, 2128, 2138, 327, 2131, 2132, 2133, 1480, 2135, 2073, 336, 205, 2075, 2090, 2108, 2109, 2110, 2111, 2139, 336, 2164, 2140, 2143, 2142, 2152, 2156, 2165, 363, 2166, 364, 365, 888, 2169, 2157, 369, 370, 371, 372, 373, 374, 375, 376, 377, 378, 379, 380, 381, 382, 383, 384, 385, 386, 387, 388, 389, 390, 391, 392, 2176, 2178, 2179, 2180, 395, 396, 397, 398, 399, 400, 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, 411, 412, 2181, 2182, 555, 2183, 2198, 2200, 73, 2201, 2202, 73, 2206, 73, 2210, 2213, 2218, 2219, 2220, 2223, 2229, 2204, 2205, 2230, 2231, 2243, 2209, 2244, 2245, 2246, 2247, 2248, 2249, 2383, 2384, 2385, 2386, 2261, 2255, 2262, 2266, 2263, 2264, 2265, 2268, 2272, 2271, 2273, 2274, 2275, 2287, 2288, 2289, 2309, 665, 2234, 2235, 2334, 2310, 2311, 2312, 2313, 2322, 205, 2316, 2324, 365, 2335, 2339, 453, 455, 456, 2340, 205, 2345, 2350, 2352, 2353, 460, 462, 464, 2354, 453, 453, 468, 470, 472, 2365, 2366, 2367, 2370, 2374, 2377, 564, 462, 2378, 483, 2376, 6, 485, 564, 2380, 2388, 2396, 7, 8, 9, 10, 207, 207, 207, 207, 2397, 2408, 2398, 11, 2399, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 889, 2416, 2406, 2417, 2420, 2435, 2542, 2426, 42, 2422, 2425, 23, 24, 2429, 2428, 2430, 2431, 2432, 2440, 2441, 2448, 2445, 2449, 2450, 2451, 2453, 205, 2455, 249, 250, 251, 564, 252, 253, 254, 255, 890, 2460, 256, 257, 258, 259, 260, 2467, 261, 262, 2468, 2294, 263, 2470, 2297, 2471, 2299, 2472, 264, 1987, 2473, 2476, 772, 2479, 205, 980, 981, 982, 983, 984, 985, 986, 987, 988, 989, 2491, 205, 990, 991, 992, 993, 994, 995, 2511, 42, 2513, 2514, 996, 42, 205, 2474, 2475, 2482, 2506, 2483, 2520, 2484, 2485, 2486, 2494, 2521, 2495, 621, 2534, 2550, 2508, 623, 2498, 2568, 2578, 2579, 2509, 2533, 53, 2515, 2512, 54, 55, 625, 2524, 2528, 2556, 2529, 56, 57, 58, 59, 626, 627, 628, 60, 2536, 629, 2545, 630, 2501, 2580, 2502, 2546, 2549, 637, 639, 2553, 2555, 2570, 2566, 2565, 2593, 2594, 2595, 2602, 2603, 564, 2571, 2574, 61, 2567, 2585, 207, 904, 207, 207, 2587, 2597, 2598, 62, 2599, 2600, 2625, 2604, 42, 2605, 2612, 73, 42, 2633, 2613, 199, 42, 42, 199, 2630, 2651, 2632, 2636, 2634, 2652, 683, 2653, 2654, 1580, 1552, 829, 1207, 1721, 2060, 1890, 1366, 33, 1367, 691, 788, 2300, 2222, 2082, 2301, 2302, 1522, 1309, 700, 701, 702, 425, 0, 0, 0, 564, 0, 42, 0, 453, 708, 709, 0, 0, 710, 0, 0, 939, 0, 0, 207, 0, 0, 0, 1874, 1875, 1876, 0, 1878, 1392, 1393, 1394, 1395, 1396, 1397, 1398, 1399, 1400, 1401, 1402, 0, 2588, 0, 2303, 0, 0, 0, 0, 0, 742, 0, 453, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 199, 199, 0, 0, 0, 0, 0, 199, 199, 199, 0, 0, 0, 42, 0, 0, 2626, 0, 2627, 0, 0, 42, 6, 0, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 791, 42, 0, 0, 11, 42, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 0, 0, 0, 0, 0, 0, 289, 290, 808, 0, 0, 23, 24, 2526, 0, 0, 0, 0, 0, 0, 0, 813, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 0, 0, 11, 837, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 0, 0, 0, 0, 0, 0, 1238, 1240, 0, 199, 0, 0, 0, 0, 0, 199, 0, 0, 0, 199, 0, 931, 932, 0, 890, 199, 199, 0, 199, 199, 199, 199, 0, 63, 64, 65, 66, 199, 942, 0, 199, 0, 199, 2259, 0, 0, 0, 0, 0, 2087, 0, 2089, 0, 0, 0, 0, 0, 0, 2307, 2097, 0, 0, 6, 0, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 584, 0, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 0, 2125, 2126, 0, 0, 0, 973, 0, 199, 0, 0, 23, 24, 0, 1325, 0, 1328, 1330, 1331, 0, 0, 0, 1336, 0, 0, 199, 585, 0, 0, 1006, 0, 0, 33, 0, 586, 517, 0, 0, 0, 0, 0, 0, 199, 0, 0, 0, 0, 0, 0, 0, 1090, 2170, 0, 2172, 199, 0, 0, 6, 0, 0, 0, 1099, 0, 7, 8, 9, 10, 199, 0, 0, 0, 199, 199, 199, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 0, 0, 0, 33, 571, 0, 0, 0, 0, 0, 0, 23, 24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2217, 0, 0, 0, 0, 587, 0, 588, 589, 0, 0, 0, 0, 1171, 1172, 0, 199, 0, 0, 0, 572, 573, 1444, 1445, 1446, 0, 1448, 0, 574, 0, 0, 0, 0, 0, 0, 590, 0, 0, 301, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 297, 298, 0, 0, 0, 0, 0, 1481, 591, 0, 592, 593, 0, 0, 594, 595, 0, 0, 0, 199, 199, 0, 0, 596, 0, 0, 0, 0, 33, 0, 0, 0, 199, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 199, 199, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1536, 0, 597, 1539, 0, 1541, 6, 199, 0, 0, 0, 1548, 7, 8, 9, 10, 199, 0, 199, 0, 0, 0, 1326, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 0, 0, 2298, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 0, 0, 0, 0, 0, 0, 365, 0, 0, 33, 0, 0, 0, 0, 0, 6, 0, 1595, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 0, 0, 11, 205, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 6, 575, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 1425, 0, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 23, 24, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 518, 0, 0, 0, 264, 1469, 0, 1471, 0, 0, 1474, 1475, 0, 1477, 0, 0, 0, 0, 0, 0, 199, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 302, 0, 0, 0, 1746, 0, 105, 106, 188, 0, 0, 0, 0, 0, 0, 0, 0, 1508, 108, 0, 0, 0, 0, 109, 110, 11, 1526, 0, 0, 0, 0, 0, 0, 0, 2454, 0, 33, 2457, 0, 0, 0, 0, 189, 190, 191, 192, 193, 0, 0, 0, 111, 0, 112, 113, 114, 115, 116, 117, 118, 119, 120, 0, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 0, 0, 0, 0, 0, 0, 33, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2510, 199, 0, 0, 0, 1812, 0, 0, 0, 0, 0, 0, 0, 1820, 0, 0, 2525, 0, 0, 0, 1827, 2530, 0, 0, 0, 33, 0, 0, 0, 0, 1837, 6, 53, 1840, 0, 54, 55, 0, 1843, 0, 0, 0, 56, 57, 58, 59, 0, 0, 11, 60, 0, 0, 1855, 0, 2552, 1856, 0, 0, 0, 306, 307, 0, 0, 2560, 2561, 0, 0, 2564, 0, 1868, 0, 0, 0, 0, 61, 0, 0, 0, 0, 0, 0, 0, 0, 2575, 62, 0, 0, 6, 0, 0, 0, 0, 2584, 7, 8, 9, 10, 0, 0, 0, 795, 0, 1900, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 0, 310, 311, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 1973, 1974, 1975, 0, 0, 1978, 0, 105, 106, 528, 53, 0, 0, 54, 55, 0, 1760, 0, 0, 108, 56, 57, 58, 59, 109, 110, 11, 60, 0, 0, 314, 315, 0, 0, 1771, 1772, 0, 0, 0, 0, 0, 0, 0, 189, 190, 191, 192, 193, 0, 0, 0, 111, 61, 112, 113, 114, 115, 116, 117, 118, 119, 120, 62, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1806, 529, 0, 0, 530, 0, 0, 0, 203, 1815, 1816, 1817, 0, 0, 0, 148, 199, 0, 149, 1825, 0, 0, 1828, 150, 1830, 1831, 0, 338, 0, 1835, 0, 0, 1838, 1839, 0, 0, 0, 1841, 0, 0, 1844, 1845, 1846, 1847, 0, 0, 1848, 1849, 1850, 1851, 1852, 0, 1854, 0, 0, 0, 0, 199, 1858, 1859, 0, 0, 0, 1863, 1864, 199, 0, 6, 0, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 1877, 0, 0, 33, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1892, 0, 0, 0, 0, 0, 0, 2127, 0, 0, 205, 23, 24, 6, 0, 0, 0, 199, 0, 7, 8, 9, 10, 796, 0, 63, 64, 65, 66, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 0, 0, 0, 0, 1982, 0, 0, 0, 0, 0, 0, 23, 24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2184, 6, 0, 0, 0, 0, 2186, 7, 8, 9, 10, 0, 0, 0, 0, 2190, 0, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 23, 24, 256, 257, 258, 259, 260, 0, 261, 262, 318, 319, 263, 2224, 0, 0, 0, 0, 264, 0, 0, 0, 63, 64, 65, 66, 0, 0, 2233, 0, 0, 0, 980, 981, 982, 983, 984, 985, 986, 987, 988, 989, 0, 194, 990, 991, 992, 993, 994, 995, 148, 0, 0, 149, 996, 0, 1149, 0, 531, 0, 0, 195, 0, 0, 0, 0, 0, 0, 205, 0, 205, 205, 205, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 33, 0, 0, 0, 2095, 2096, 0, 0, 2098, 0, 2099, 0, 0, 0, 2102, 2103, 0, 2106, 0, 0, 0, 0, 0, 0, 0, 0, 2112, 0, 2114, 2115, 2116, 2117, 2118, 2119, 2120, 2121, 2122, 2123, 0, 2124, 0, 0, 33, 0, 2129, 2130, 0, 0, 0, 2134, 0, 0, 0, 0, 0, 2137, 6, 0, 0, 0, 0, 0, 7, 8, 9, 10, 0, 2154, 2155, 0, 0, 0, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 0, 0, 0, 0, 0, 0, 2171, 340, 2173, 2174, 0, 23, 24, 0, 33, 0, 0, 0, 0, 0, 0, 0, 980, 981, 982, 983, 984, 985, 986, 987, 988, 989, 2188, 2189, 990, 991, 992, 993, 994, 995, 0, 2193, 0, 2346, 996, 2348, 0, 0, 1565, 830, 831, 2199, 0, 0, 2364, 2203, 0, 0, 0, 2207, 2208, 0, 2371, 2212, 0, 0, 0, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 2382, 0, 256, 257, 258, 259, 260, 2389, 261, 262, 0, 0, 263, 891, 892, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 205, 0, 0, 2237, 2238, 2239, 205, 0, 0, 6, 0, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 0, 2419, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 0, 0, 2250, 2251, 2252, 2253, 2254, 894, 895, 0, 2256, 23, 24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 199, 199, 199, 0, 199, 2452, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 33, 0, 11, 199, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 6, 0, 2487, 0, 0, 0, 7, 8, 9, 10, 0, 23, 24, 2308, 0, 0, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 0, 0, 0, 0, 0, 0, 0, 2323, 0, 0, 0, 23, 24, 0, 0, 0, 2330, 0, 0, 2332, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2341, 2342, 2343, 2344, 0, 0, 0, 2347, 0, 2349, 0, 2351, 0, 0, 0, 2355, 0, 0, 0, 0, 0, 0, 2368, 2369, 980, 981, 982, 983, 984, 985, 986, 987, 988, 989, 0, 0, 990, 991, 992, 993, 994, 995, 205, 205, 205, 205, 996, 0, 0, 0, 2390, 2391, 2392, 0, 0, 0, 0, 0, 0, 0, 0, 0, 899, 900, 247, 248, 249, 250, 251, 33, 252, 253, 254, 255, 0, 0, 256, 257, 356, 342, 260, 0, 261, 262, 0, 0, 263, 0, 823, 0, 2418, 0, 264, 0, 0, 0, 0, 0, 0, 199, 0, 199, 199, 199, 0, 2427, 0, 0, 0, 0, 0, 0, 199, 2434, 199, 0, 0, 0, 0, 0, 0, 0, 199, 0, 0, 0, 0, 2446, 2447, 0, 0, 0, 0, 0, 0, 0, 33, 0, 0, 2456, 0, 2458, 0, 0, 0, 0, 0, 2466, 0, 0, 0, 0, 0, 0, 0, 199, 199, 0, 0, 0, 6, 0, 0, 0, 0, 33, 7, 8, 9, 10, 0, 0, 0, 0, 2488, 2489, 2490, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 912, 913, 199, 0, 199, 0, 0, 0, 0, 0, 0, 0, 205, 0, 205, 205, 0, 0, 0, 0, 0, 2519, 0, 0, 2522, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2535, 0, 0, 2538, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2547, 2548, 0, 0, 0, 199, 0, 0, 0, 0, 915, 916, 0, 0, 0, 2558, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 205, 0, 0, 0, 0, 0, 2572, 2573, 0, 0, 2576, 919, 920, 0, 0, 199, 0, 0, 0, 0, 0, 199, 0, 0, 0, 0, 0, 0, 0, 0, 2596, 0, 0, 0, 0, 2601, 0, 0, 797, 0, 0, 2607, 2608, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2621, 0, 0, 0, 2624, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2635, 0, 0, 2638, 0, 2639, 2640, 0, 0, 0, 0, 0, 105, 106, 188, 53, 2647, 2648, 54, 55, 0, 0, 0, 33, 108, 56, 57, 58, 59, 109, 110, 11, 60, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 189, 190, 191, 192, 193, 199, 0, 0, 111, 61, 112, 113, 114, 115, 116, 117, 118, 119, 120, 62, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 0, 0, 0, 0, 980, 981, 982, 983, 984, 985, 986, 987, 988, 989, 0, 0, 990, 991, 992, 993, 994, 995, 105, 106, 188, 53, 996, 0, 54, 55, 1767, 0, 0, 0, 108, 56, 57, 58, 59, 109, 110, 11, 60, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 199, 199, 199, 199, 189, 190, 191, 192, 193, 830, 949, 0, 111, 61, 112, 113, 114, 115, 116, 117, 118, 119, 120, 62, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 0, 0, 0, 105, 106, 840, 0, 0, 0, 0, 0, 0, 0, 0, 0, 108, 0, 0, 0, 0, 109, 110, 11, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 199, 0, 111, 199, 112, 113, 114, 115, 116, 117, 118, 119, 120, 0, 121, 122, 123, 841, 842, 843, 844, 845, 846, 847, 848, 849, 850, 851, 852, 853, 854, 855, 856, 857, 858, 859, 860, 861, 862, 863, 864, 865, 866, 867, 0, 868, 869, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 199, 199, 0, 199, 199, 0, 0, 0, 0, 0, 0, 0, 63, 64, 65, 66, 199, 0, 0, 0, 0, 199, 0, 0, 0, 0, 870, 0, 0, 0, 0, 0, 0, 194, 0, 0, 6, 871, 872, 873, 148, 0, 0, 149, 0, 0, 0, 0, 150, 0, 0, 195, 0, 11, 199, 0, 0, 0, 0, 0, 0, 0, 0, 199, 199, 0, 0, 199, 0, 0, 0, 0, 0, 0, 199, 0, 0, 0, 0, 0, 0, 1538, 0, 199, 0, 0, 0, 0, 0, 0, 0, 0, 199, 841, 842, 843, 844, 845, 846, 847, 848, 849, 850, 851, 852, 853, 854, 855, 856, 857, 858, 859, 860, 861, 862, 863, 63, 64, 65, 66, 0, 105, 106, 840, 0, 0, 0, 0, 0, 0, 0, 0, 0, 108, 0, 0, 0, 194, 109, 110, 11, 0, 0, 0, 148, 0, 0, 149, 0, 0, 0, 0, 150, 0, 0, 934, 0, 0, 0, 0, 0, 0, 0, 0, 0, 111, 0, 112, 113, 114, 115, 116, 117, 118, 119, 120, 0, 121, 122, 123, 841, 842, 843, 844, 845, 846, 847, 848, 849, 850, 851, 852, 853, 854, 855, 856, 857, 858, 859, 860, 861, 862, 863, 864, 865, 866, 867, 1612, 868, 869, 0, 0, 0, 0, 0, 874, 0, 0, 0, 0, 0, 875, 876, 0, 0, 0, 0, 0, 0, 877, 0, 0, 878, 0, 0, 1173, 1174, 879, 880, 0, 881, 105, 106, 107, 53, 0, 0, 54, 55, 0, 0, 0, 0, 108, 56, 57, 58, 59, 109, 110, 11, 60, 0, 0, 0, 0, 870, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 871, 872, 873, 2024, 0, 0, 0, 0, 111, 61, 112, 113, 114, 115, 116, 117, 118, 119, 120, 62, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 105, 106, 107, 53, 0, 0, 54, 55, 0, 0, 0, 0, 108, 56, 57, 58, 59, 109, 110, 11, 60, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 111, 61, 112, 113, 114, 115, 116, 117, 118, 119, 120, 62, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 105, 106, 188, 0, 0, 0, 0, 0, 0, 874, 0, 0, 108, 0, 0, 875, 876, 109, 110, 11, 0, 0, 0, 877, 0, 0, 878, 0, 0, 0, 0, 879, 880, 0, 881, 0, 189, 190, 191, 192, 193, 0, 0, 0, 111, 0, 112, 113, 114, 115, 116, 117, 118, 119, 120, 0, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 0, 0, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 63, 64, 65, 66, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 147, 261, 262, 0, 0, 263, 0, 148, 0, 2295, 149, 264, 0, 0, 0, 150, 2296, 0, 636, 0, 0, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 63, 64, 65, 66, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 147, 261, 262, 0, 0, 263, 0, 148, 0, 2402, 149, 264, 0, 0, 0, 150, 2403, 0, 812, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 105, 106, 528, 0, 0, 0, 0, 0, 0, 0, 0, 0, 108, 0, 0, 0, 0, 109, 110, 11, 0, 0, 0, 0, 0, 0, 2214, 0, 0, 0, 2215, 0, 0, 0, 0, 2216, 189, 190, 191, 192, 193, 0, 0, 0, 111, 0, 112, 113, 114, 115, 116, 117, 118, 119, 120, 0, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 0, 0, 0, 0, 0, 0, 105, 106, 188, 0, 0, 0, 194, 0, 530, 0, 0, 0, 108, 148, 0, 0, 149, 109, 110, 11, 0, 150, 0, 0, 195, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 189, 190, 191, 192, 193, 0, 0, 0, 111, 0, 112, 113, 114, 115, 116, 117, 118, 119, 120, 0, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 105, 106, 188, 0, 0, 0, 0, 0, 0, 0, 0, 0, 108, 0, 0, 0, 0, 109, 110, 11, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 189, 190, 191, 192, 193, 0, 0, 0, 111, 0, 112, 113, 114, 115, 116, 117, 118, 119, 120, 0, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 105, 106, 188, 0, 0, 0, 0, 0, 0, 0, 0, 0, 108, 0, 0, 0, 0, 109, 110, 11, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 189, 190, 191, 192, 193, 0, 0, 0, 111, 0, 112, 113, 114, 115, 116, 117, 118, 119, 120, 0, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 0, 105, 106, 107, 0, 0, 0, 194, 0, 0, 0, 0, 0, 108, 148, 0, 0, 149, 109, 110, 11, 0, 531, 0, 0, 195, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 111, 0, 112, 113, 114, 115, 116, 117, 118, 119, 120, 0, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 2025, 0, 0, 0, 0, 0, 105, 106, 107, 0, 0, 0, 203, 0, 0, 0, 0, 0, 108, 148, 0, 0, 149, 109, 110, 11, 0, 150, 0, 0, 335, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 111, 0, 112, 113, 114, 115, 116, 117, 118, 119, 120, 0, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 0, 0, 0, 0, 0, 0, 194, 0, 0, 0, 0, 0, 0, 148, 0, 0, 149, 0, 0, 0, 0, 150, 0, 0, 195, 0, 0, 0, 0, 0, 1894, 0, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 0, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 0, 980, 981, 982, 983, 984, 985, 986, 987, 988, 989, 23, 24, 990, 991, 992, 993, 994, 995, 0, 0, 0, 0, 996, 0, 0, 0, 2333, 0, 203, 0, 0, 0, 0, 0, 0, 148, 0, 0, 149, 0, 0, 0, 0, 150, 0, 1014, 461, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 0, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2030, 0, 0, 1895, 0, 147, 0, 0, 0, 0, 0, 0, 148, 0, 0, 149, 448, 0, 0, 0, 150, 0, 0, 449, 0, 0, 1014, 0, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 0, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 33, 261, 262, 2031, 0, 263, 147, 0, 0, 0, 0, 264, 0, 148, 0, 0, 149, 0, 0, 0, 0, 150, 1017, 1018, 2105, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 0, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 0, 1017, 1018, 1083, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 1896, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 1014, 0, 0, 1083, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 1084, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 2032, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1014, 0, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 2167, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 0, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 2033, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1017, 1018, 0, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 0, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 0, 1017, 1018, 1083, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 0, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 1014, 0, 0, 1083, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 2168, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 2037, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1014, 0, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 2185, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 2038, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1017, 1018, 0, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 0, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 0, 1017, 1018, 1083, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 0, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 1014, 0, 0, 1083, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 2187, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 2040, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1014, 0, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 2191, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 2044, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1017, 1018, 0, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 0, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 0, 1017, 1018, 1083, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 0, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 1014, 0, 0, 1083, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 2194, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 2045, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1014, 0, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 2195, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 2049, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1017, 1018, 0, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 0, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 0, 1017, 1018, 1083, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 0, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 1014, 0, 0, 1083, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 2400, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 2050, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1014, 0, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 2459, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 2325, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1017, 1018, 0, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 0, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 0, 1017, 1018, 1083, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 0, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 1014, 0, 0, 1083, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 2465, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 2326, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1014, 0, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 2523, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 2327, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1017, 1018, 0, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 0, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 0, 1017, 1018, 1083, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 0, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 1014, 0, 0, 1083, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 2527, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 2328, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1014, 0, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 2531, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 2329, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1017, 1018, 0, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 0, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 0, 1017, 1018, 1083, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 0, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 1014, 0, 0, 1083, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 2532, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 2469, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1014, 0, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 2559, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 340, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1017, 1018, 0, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 0, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 0, 1017, 1018, 1083, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 0, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 1014, 0, 0, 1083, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 2623, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1014, 0, 0, 0, 0, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 2629, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 1015, 1016, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 1315, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 356, 342, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1017, 1018, 0, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 0, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 0, 0, 0, 0, 0, 1082, 0, 1017, 1018, 1083, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036, 1037, 1038, 1039, 1040, 1041, 246, 0, 0, 0, 0, 1042, 1043, 1044, 0, 0, 1045, 1046, 1047, 1048, 1049, 1050, 0, 0, 1051, 0, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 33, 1059, 1060, 1061, 1062, 1063, 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, 1080, 0, 0, 0, 1081, 105, 106, 188, 53, 0, 1082, 54, 55, 0, 1083, 0, 0, 108, 56, 57, 58, 59, 109, 110, 11, 60, 2642, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 189, 190, 191, 192, 193, 0, 0, 0, 111, 61, 112, 113, 114, 115, 116, 117, 118, 119, 120, 62, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 105, 106, 188, 0, 0, 0, 0, 0, 0, 0, 0, 0, 108, 0, 1361, 0, 0, 109, 110, 11, 0, 0, 0, 0, 0, 0, 2646, 0, 0, 0, 0, 0, 0, 0, 0, 0, 189, 190, 191, 192, 193, 0, 0, 0, 111, 0, 112, 113, 114, 115, 116, 117, 118, 119, 120, 0, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 105, 106, 188, 0, 0, 0, 0, 0, 0, 0, 0, 0, 108, 0, 0, 0, 0, 109, 110, 11, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 189, 190, 191, 192, 193, 0, 0, 0, 111, 0, 112, 113, 114, 115, 116, 117, 118, 119, 120, 0, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 417, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 63, 64, 65, 66, 0, 105, 106, 452, 0, 0, 0, 0, 0, 0, 0, 0, 0, 108, 0, 0, 0, 203, 109, 110, 11, 0, 0, 0, 148, 0, 0, 149, 0, 0, 0, 0, 150, 0, 0, 0, 0, 189, 190, 191, 192, 193, 0, 0, 0, 111, 0, 112, 113, 114, 115, 116, 117, 118, 119, 120, 0, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 105, 106, 107, 0, 0, 0, 0, 0, 0, 0, 0, 0, 108, 0, 0, 0, 203, 109, 110, 11, 0, 0, 0, 148, 0, 0, 149, 204, 0, 0, 0, 150, 0, 0, 340, 0, 0, 0, 0, 0, 0, 0, 0, 0, 111, 0, 112, 113, 114, 115, 116, 117, 118, 119, 120, 0, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 105, 106, 107, 0, 0, 0, 0, 0, 340, 0, 0, 0, 108, 0, 0, 0, 203, 109, 110, 11, 0, 0, 0, 148, 0, 0, 149, 0, 0, 0, 0, 150, 0, 0, 0, 0, 0, 487, 0, 0, 0, 0, 0, 0, 111, 0, 112, 113, 114, 115, 116, 117, 118, 119, 120, 0, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 105, 106, 107, 0, 0, 0, 0, 0, 519, 0, 0, 0, 108, 0, 0, 0, 0, 109, 110, 11, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 610, 0, 0, 0, 0, 0, 0, 111, 0, 112, 113, 114, 115, 116, 117, 118, 119, 120, 0, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 0, 2211, 0, 0, 0, 0, 0, 105, 106, 972, 0, 0, 0, 203, 0, 0, 0, 0, 0, 108, 148, 0, 0, 149, 109, 110, 11, 0, 150, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 111, 0, 112, 113, 114, 115, 116, 117, 118, 119, 120, 0, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 0, 0, 0, 0, 0, 0, 147, 0, 0, 0, 0, 0, 0, 148, 0, 0, 149, 516, 0, 0, 0, 150, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 341, 342, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 0, 0, 0, 0, 6, 53, 0, 0, 54, 55, 0, 0, 0, 0, 0, 56, 57, 58, 59, 0, 0, 11, 60, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 147, 0, 256, 257, 356, 342, 260, 148, 261, 262, 149, 0, 263, 0, 61, 150, 0, 0, 264, 247, 248, 249, 250, 251, 62, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 1753, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 147, 0, 256, 257, 258, 259, 260, 148, 261, 262, 149, 0, 263, 0, 0, 150, 0, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 6, 261, 262, 0, 0, 263, 7, 8, 9, 10, 0, 264, 0, 0, 0, 0, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 147, 0, 0, 0, 0, 6, 0, 148, 0, 0, 149, 7, 8, 9, 10, 150, 0, 0, 0, 0, 0, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 0, 0, 0, 22, 0, 0, 0, 0, 6, 0, 0, 23, 24, 0, 7, 8, 9, 10, 0, 0, 0, 0, 0, 0, 0, 11, 0, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 0, 1914, 0, 0, 0, 0, 0, 0, 25, 0, 0, 0, 0, 0, 26, 0, 0, 0, 0, 1915, 0, 0, 0, 0, 0, 0, 27, 0, 0, 28, 0, 0, 0, 0, 63, 64, 65, 66, 0, 29, 0, 0, 0, 30, 0, 0, 0, 0, 0, 0, 2092, 0, 0, 2093, 0, 31, 0, 0, 0, 0, 0, 0, 0, 0, 1916, 0, 0, 0, 0, 247, 248, 249, 250, 251, 1917, 252, 253, 254, 255, 0, 32, 256, 257, 258, 259, 260, 33, 261, 262, 0, 0, 263, 0, 0, 0, 2477, 0, 264, 0, 0, 0, 0, 2478, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1918, 0, 0, 924, 925, 926, 927, 928, 0, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 33, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 0, 503, 0, 0, 0, 1919, 0, 0, 0, 0, 0, 0, 0, 34, 0, 35, 1920, 1921, 1922, 1923, 1924, 1925, 1926, 1927, 1928, 1929, 33, 0, 1930, 1931, 1932, 1933, 1934, 1935, 1936, 1937, 1938, 1939, 1940, 1941, 1942, 1943, 1944, 1945, 1946, 1947, 1948, 1949, 1950, 1951, 1952, 1953, 1954, 1955, 1956, 1957, 1958, 1959, 1960, 1961, 1962, 1963, 1964, 0, 0, 0, 0, 1965, 1966, 1967, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 512, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 513, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 514, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 606, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 607, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 803, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 804, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 923, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 1305, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 1656, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 1664, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 1674, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 1675, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 1683, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 1984, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 1985, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2009, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2010, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2011, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2021, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2027, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2034, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2035, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2036, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2058, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2153, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2258, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2269, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2270, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2276, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2277, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2283, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2285, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2290, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2291, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2318, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2319, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2320, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2381, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2395, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2405, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2407, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2409, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2415, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2442, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2443, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2444, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2492, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2499, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2503, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2543, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2562, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2563, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2582, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2583, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2586, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2611, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2615, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2628, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2631, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2644, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2645, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2649, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 247, 248, 249, 250, 251, 264, 252, 253, 254, 255, 2650, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 359, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 447, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 486, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 737, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 933, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 1104, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 1205, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 2331, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 2394, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 2481, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 2493, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 2516, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 2517, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 2518, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 2551, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 2554, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 2606, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 2616, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264, 0, 0, 0, 2643, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 265, 0, 0, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 266, 0, 0, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 278, 0, 0, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 393, 0, 0, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 488, 0, 0, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 493, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 494, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 495, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 496, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 497, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 498, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 499, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 500, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 501, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 502, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 504, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 505, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 506, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 507, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 508, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 509, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 510, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 511, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 515, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 619, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 722, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 726, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 727, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 728, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 729, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 730, 0, 0, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 953, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 1096, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 1097, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 1727, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 1976, 0, 0, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 2016, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 2017, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 2018, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 2019, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 2070, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 2242, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 2257, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 2267, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 2286, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 2393, 0, 0, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 2401, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 2404, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 2411, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 2423, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 2424, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 2497, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 2541, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 2569, 0, 264, 247, 248, 249, 250, 251, 0, 252, 253, 254, 255, 0, 0, 256, 257, 258, 259, 260, 0, 261, 262, 0, 0, 263, 0, 0, 0, 0, 0, 264 }; static const yytype_int16 yycheck[] = { 5, 1208, 840, 818, 171, 652, 1189, 1190, 166, 268, 269, 5, 5, 5, 642, 20, 1137, 22, 277, 886, 99, 5, 1143, 1144, 1145, 1146, 5, 1518, 33, 22, 35, 1522, 5, 5, 39, 3, 5, 5, 22, 44, 45, 5, 47, 22, 5, 3, 5, 5, 38, 22, 22, 5, 114, 5, 22, 3, 353, 5, 22, 106, 1808, 1809, 359, 22, 22, 3, 5, 5, 3, 5, 5, 99, 166, 7, 22, 5, 138, 124, 111, 3, 0, 5, 110, 116, 22, 366, 22, 22, 1836, 1093, 5, 124, 22, 356, 1842, 99, 5, 111, 22, 111, 114, 115, 114, 5, 18, 1853, 20, 22, 1112, 1113, 1114, 1115, 124, 1861, 1862, 99, 166, 5, 956, 5, 958, 30, 111, 1127, 5, 5, 94, 5, 38, 36, 11, 12, 13, 14, 38, 124, 8, 127, 354, 0, 356, 22, 22, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 158, 159, 432, 161, 162, 163, 164, 254, 166, 167, 354, 45, 46, 44, 172, 173, 99, 162, 176, 177, 178, 179, 114, 181, 182, 183, 38, 94, 38, 96, 22, 99, 124, 445, 1191, 1192, 7, 194, 195, 356, 38, 38, 38, 330, 354, 826, 203, 5, 140, 366, 330, 254, 354, 114, 95, 47, 116, 215, 216, 217, 1217, 94, 124, 124, 127, 126, 99, 172, 173, 124, 127, 176, 177, 178, 179, 362, 181, 182, 5, 1353, 114, 124, 362, 126, 127, 128, 129, 130, 131, 132, 124, 356, 356, 325, 330, 22, 135, 362, 165, 5, 177, 36, 1746, 335, 534, 144, 166, 343, 344, 521, 357, 5, 6, 173, 174, 127, 22, 127, 354, 1276, 278, 356, 1142, 281, 354, 283, 356, 354, 22, 127, 127, 127, 330, 167, 168, 169, 170, 171, 172, 366, 8, 99, 354, 943, 357, 343, 344, 362, 363, 209, 124, 364, 126, 354, 366, 1429, 354, 217, 218, 366, 134, 364, 162, 363, 945, 366, 357, 159, 325, 161, 162, 163, 330, 364, 331, 167, 334, 363, 335, 114, 362, 116, 363, 415, 341, 342, 357, 344, 345, 346, 347, 7, 127, 364, 228, 330, 363, 357, 363, 356, 354, 358, 345, 280, 364, 140, 362, 527, 343, 344, 622, 278, 366, 356, 362, 362, 283, 449, 363, 7, 366, 363, 359, 215, 356, 362, 355, 162, 357, 461, 363, 364, 355, 354, 366, 364, 362, 362, 558, 362, 362, 362, 474, 354, 365, 362, 1403, 354, 362, 362, 362, 362, 1409, 354, 365, 413, 344, 124, 415, 417, 354, 362, 356, 354, 365, 354, 354, 356, 362, 356, 359, 363, 366, 140, 365, 356, 359, 365, 354, 437, 362, 439, 345, 441, 1558, 443, 362, 357, 345, 357, 366, 359, 449, 356, 364, 343, 344, 345, 346, 356, 167, 762, 363, 363, 461, 353, 331, 332, 333, 334, 335, 1111, 337, 338, 339, 340, 364, 474, 362, 731, 363, 359, 347, 361, 349, 350, 359, 323, 353, 363, 362, 489, 437, 345, 359, 345, 441, 330, 443, 356, 362, 363, 334, 330, 356, 362, 356, 345, 345, 345, 343, 344, 357, 1510, 1511, 1512, 343, 344, 356, 364, 362, 354, 1519, 356, 2265, 432, 117, 118, 119, 120, 121, 122, 173, 531, 349, 350, 177, 362, 353, 537, 126, 539, 362, 541, 359, 355, 253, 357, 356, 363, 136, 137, 138, 551, 343, 344, 345, 346, 5, 1556, 201, 202, 203, 561, 353, 3, 355, 5, 173, 567, 355, 1568, 177, 571, 875, 876, 877, 878, 356, 364, 578, 413, 580, 581, 744, 417, 584, 36, 363, 587, 588, 357, 5, 354, 539, 256, 201, 202, 364, 204, 205, 362, 2086, 364, 3, 366, 5, 354, 605, 2350, 54, 55, 56, 2354, 356, 362, 349, 350, 525, 366, 345, 346, 66, 331, 332, 333, 334, 335, 353, 337, 338, 339, 340, 357, 632, 343, 344, 345, 346, 347, 364, 349, 350, 641, 642, 353, 1643, 356, 645, 7, 647, 359, 357, 357, 652, 363, 363, 489, 959, 364, 364, 812, 356, 110, 108, 112, 113, 116, 828, 343, 344, 345, 346, 347, 348, 7, 1790, 675, 1792, 353, 981, 982, 983, 984, 985, 986, 987, 988, 989, 990, 991, 992, 993, 994, 995, 996, 362, 110, 999, 112, 113, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 1709, 357, 2455, 162, 163, 330, 1715, 2460, 364, 355, 363, 357, 173, 357, 330, 1724, 355, 636, 364, 357, 364, 2474, 2475, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 2230, 357, 357, 162, 163, 362, 363, 751, 364, 364, 588, 356, 363, 362, 209, 210, 1938, 357, 762, 355, 764, 357, 357, 767, 364, 769, 363, 357, 364, 364, 774, 363, 356, 777, 364, 356, 780, 2524, 110, 783, 362, 113, 114, 357, 366, 343, 344, 345, 346, 355, 364, 357, 124, 1796, 632, 799, 363, 364, 364, 356, 751, 356, 343, 344, 345, 346, 364, 357, 812, 141, 142, 143, 353, 764, 364, 5, 767, 356, 769, 732, 733, 734, 826, 774, 365, 829, 777, 363, 364, 780, 162, 356, 783, 343, 344, 345, 346, 345, 346, 347, 348, 1148, 356, 353, 1151, 353, 7, 1154, 799, 333, 334, 335, 336, 337, 338, 339, 340, 356, 2605, 343, 344, 345, 346, 347, 348, 2612, 363, 364, 357, 353, 356, 875, 876, 877, 878, 364, 880, 881, 829, 356, 363, 364, 356, 2630, 356, 1531, 345, 346, 347, 2636, 349, 350, 357, 356, 353, 357, 809, 810, 356, 364, 359, 7, 364, 7, 362, 357, 357, 356, 363, 1912, 363, 357, 364, 364, 918, 3, 4, 5, 364, 251, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 934, 762, 356, 22, 114, 357, 363, 364, 943, 1754, 945, 357, 364, 363, 357, 357, 357, 127, 364, 960, 961, 364, 364, 364, 959, 960, 961, 1795, 47, 356, 49, 50, 51, 52, 53, 54, 55, 56, 57, 356, 59, 60, 61, 978, 362, 363, 981, 982, 983, 984, 985, 986, 987, 988, 989, 990, 991, 992, 993, 994, 995, 996, 362, 363, 999, 356, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 356, 1013, 1014, 162, 362, 363, 356, 2221, 2222, 334, 335, 356, 337, 338, 339, 340, 356, 1332, 343, 344, 345, 346, 347, 363, 349, 350, 363, 364, 353, 356, 7, 1346, 363, 364, 359, 363, 364, 875, 876, 877, 878, 363, 364, 356, 5, 1360, 356, 201, 202, 356, 11, 12, 13, 14, 1013, 363, 364, 363, 364, 362, 363, 22, 356, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 363, 364, 363, 364, 363, 364, 1091, 1092, 1093, 1094, 1095, 45, 46, 110, 363, 364, 113, 114, 1177, 363, 364, 343, 344, 345, 346, 1110, 1111, 1112, 1113, 1114, 1115, 353, 363, 364, 7, 357, 356, 1122, 363, 364, 363, 364, 1127, 1128, 362, 363, 363, 364, 959, 363, 364, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 2263, 1148, 356, 162, 1151, 363, 364, 1154, 981, 982, 983, 984, 985, 986, 987, 988, 989, 990, 991, 992, 993, 994, 995, 996, 363, 364, 999, 363, 364, 363, 364, 1177, 1179, 363, 364, 1182, 363, 364, 1185, 1186, 356, 363, 363, 364, 1191, 1192, 363, 364, 144, 145, 146, 147, 362, 363, 1201, 1202, 362, 363, 363, 364, 363, 364, 357, 1210, 353, 356, 1213, 1214, 354, 363, 1217, 363, 364, 363, 364, 357, 1223, 1224, 1225, 357, 1227, 1228, 1229, 362, 363, 357, 1233, 362, 363, 7, 356, 356, 7, 363, 1241, 1242, 1243, 1244, 1245, 1246, 1247, 1248, 1249, 353, 1251, 1252, 7, 1254, 1255, 1256, 1257, 1258, 1259, 1094, 1095, 7, 330, 1264, 330, 364, 357, 1177, 1269, 354, 364, 355, 7, 330, 359, 1276, 1277, 1278, 228, 1280, 1281, 1282, 1283, 1284, 1285, 1286, 1287, 1288, 1289, 1290, 1291, 1292, 1293, 1294, 1295, 1296, 2296, 362, 1299, 1300, 7, 1302, 357, 2303, 331, 332, 333, 334, 335, 357, 337, 338, 339, 340, 1315, 330, 2433, 7, 330, 364, 347, 1148, 349, 350, 1151, 356, 353, 1154, 7, 5, 356, 5, 359, 362, 362, 478, 479, 480, 362, 5, 362, 362, 5, 6, 362, 1346, 9, 10, 330, 357, 363, 362, 762, 16, 17, 18, 19, 5, 362, 1360, 23, 2361, 362, 362, 362, 331, 332, 333, 334, 335, 356, 337, 338, 339, 340, 5, 7, 343, 344, 345, 346, 347, 1545, 349, 350, 48, 7, 353, 1389, 5, 1225, 534, 1227, 359, 7, 58, 7, 7, 7, 7, 362, 8, 1403, 7, 7, 7, 7, 356, 1409, 356, 345, 7, 7, 363, 7, 7, 1579, 7, 330, 7, 7, 7, 362, 1586, 1259, 1588, 7, 7, 7, 7, 2264, 7, 7, 7, 1269, 7, 7, 363, 355, 357, 355, 7, 1277, 1278, 7, 1280, 1281, 1282, 3, 592, 593, 5, 345, 362, 7, 363, 1619, 1761, 362, 364, 8, 1624, 357, 7, 1299, 875, 876, 877, 878, 356, 356, 1775, 356, 356, 617, 618, 356, 356, 2478, 356, 1315, 362, 3, 339, 875, 876, 877, 878, 362, 362, 362, 356, 356, 636, 334, 335, 336, 337, 338, 339, 340, 1502, 1503, 343, 344, 345, 346, 347, 348, 1510, 1511, 1512, 356, 353, 356, 356, 362, 356, 1519, 1346, 357, 356, 356, 356, 356, 343, 344, 345, 346, 347, 1531, 349, 350, 1360, 356, 353, 353, 337, 338, 339, 340, 359, 2542, 343, 344, 345, 346, 347, 348, 959, 330, 363, 362, 353, 7, 1556, 266, 267, 268, 269, 270, 271, 272, 273, 274, 356, 356, 1568, 959, 356, 356, 981, 982, 983, 984, 985, 986, 987, 988, 989, 990, 991, 992, 993, 994, 995, 996, 7, 356, 999, 981, 982, 983, 984, 985, 986, 987, 988, 989, 990, 991, 992, 993, 994, 995, 996, 356, 356, 999, 356, 362, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 3, 4, 5, 356, 356, 356, 356, 356, 356, 7, 7, 7, 1634, 1635, 356, 356, 356, 1639, 356, 22, 356, 1643, 7, 356, 356, 362, 356, 356, 362, 356, 356, 356, 1654, 356, 356, 356, 356, 1733, 356, 323, 324, 325, 326, 356, 47, 809, 49, 50, 51, 52, 53, 54, 55, 56, 57, 356, 59, 60, 61, 5, 356, 5, 1684, 356, 356, 1687, 356, 356, 362, 5, 5, 357, 357, 356, 5, 363, 357, 5, 5, 1701, 362, 5, 362, 3, 5, 7, 356, 1709, 7, 7, 1712, 1713, 356, 1715, 1716, 362, 356, 356, 364, 357, 7, 364, 1724, 1725, 7, 7, 7, 7, 7, 7, 7, 7, 1733, 7, 7, 7, 7, 1148, 7, 7, 1151, 364, 357, 1154, 357, 364, 364, 7, 364, 356, 7, 1753, 7, 7, 7, 7, 1148, 363, 5, 1151, 5, 362, 1154, 7, 11, 12, 13, 14, 7, 7, 7, 7, 7, 1775, 7, 22, 1725, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 7, 7, 7, 356, 5, 7, 356, 1796, 356, 5, 1799, 45, 46, 5, 1803, 364, 1805, 7, 7, 7, 7, 7, 7, 7, 7, 1976, 7, 7, 7, 7, 7, 7, 7, 7, 1823, 7, 357, 357, 1901, 1990, 1903, 1904, 1905, 357, 357, 364, 364, 364, 364, 364, 7, 357, 364, 364, 364, 7, 364, 364, 357, 93, 5, 1684, 364, 364, 2156, 357, 11, 12, 13, 14, 364, 357, 357, 364, 357, 357, 364, 22, 1701, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 357, 331, 332, 333, 334, 335, 364, 337, 338, 339, 340, 45, 46, 343, 344, 345, 346, 347, 364, 349, 350, 364, 364, 353, 1901, 364, 1903, 1904, 1905, 359, 357, 1909, 357, 364, 1912, 364, 357, 1915, 364, 357, 364, 1753, 1920, 362, 364, 337, 338, 339, 340, 362, 1928, 343, 344, 345, 346, 347, 362, 349, 350, 1346, 362, 353, 362, 364, 98, 364, 364, 359, 364, 364, 364, 1775, 7, 1360, 362, 3, 357, 339, 1346, 356, 114, 140, 1960, 7, 3, 1963, 1964, 1965, 357, 1967, 124, 125, 1360, 7, 7, 7, 7, 7, 7, 133, 359, 135, 7, 7, 362, 228, 357, 362, 7, 7, 7, 360, 49, 50, 51, 7, 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, 2004, 2005, 343, 344, 345, 346, 347, 348, 2012, 72, 2014, 7, 353, 7, 7, 7, 362, 362, 2022, 362, 362, 7, 362, 364, 2028, 362, 7, 2105, 362, 7, 7, 7, 7, 2111, 7, 2039, 99, 100, 7, 7, 7, 7, 7, 2047, 2048, 7, 275, 362, 362, 357, 362, 5, 162, 364, 2058, 2059, 7, 356, 5, 2063, 357, 357, 357, 357, 8, 5, 5, 5, 228, 357, 7, 1909, 1218, 7, 7, 7, 7, 1915, 364, 7, 1226, 7, 1920, 7, 147, 148, 149, 364, 2092, 2093, 1928, 357, 364, 357, 357, 364, 364, 160, 5, 364, 5, 7, 2105, 364, 357, 357, 357, 357, 2111, 2113, 7, 5, 5, 139, 363, 7, 364, 7, 360, 364, 364, 364, 1960, 357, 187, 1963, 1964, 1965, 1274, 1967, 362, 194, 195, 364, 362, 362, 362, 362, 362, 357, 203, 7, 357, 357, 363, 357, 356, 7, 211, 357, 213, 214, 2156, 7, 363, 218, 219, 220, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 7, 357, 7, 7, 246, 247, 248, 249, 250, 251, 252, 253, 254, 255, 256, 257, 258, 259, 260, 261, 262, 263, 7, 7, 363, 7, 7, 7, 2211, 7, 7, 2214, 357, 2216, 7, 7, 7, 7, 7, 362, 364, 2058, 2059, 357, 7, 7, 2063, 7, 7, 354, 7, 7, 5, 2310, 2311, 2312, 2313, 7, 362, 5, 357, 364, 364, 362, 364, 357, 364, 7, 364, 364, 357, 357, 7, 364, 545, 2092, 2093, 2260, 362, 362, 362, 362, 7, 325, 364, 7, 328, 363, 7, 331, 332, 333, 7, 335, 7, 362, 362, 362, 340, 341, 342, 362, 344, 345, 346, 347, 348, 7, 7, 7, 7, 7, 5, 2296, 356, 5, 358, 2300, 5, 361, 2303, 356, 7, 362, 11, 12, 13, 14, 2310, 2311, 2312, 2313, 7, 364, 357, 22, 357, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 2156, 5, 357, 5, 5, 363, 92, 7, 2338, 357, 357, 45, 46, 7, 357, 7, 7, 7, 7, 364, 7, 363, 7, 7, 7, 7, 415, 362, 333, 334, 335, 2361, 337, 338, 339, 340, 1775, 362, 343, 344, 345, 346, 347, 7, 349, 350, 7, 2211, 353, 7, 2214, 7, 2216, 7, 359, 1775, 7, 7, 676, 7, 449, 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, 7, 461, 343, 344, 345, 346, 347, 348, 2483, 2410, 2485, 2486, 353, 2414, 474, 362, 362, 362, 7, 362, 7, 363, 362, 362, 357, 7, 364, 487, 7, 7, 357, 491, 364, 7, 164, 7, 362, 357, 6, 363, 362, 9, 10, 503, 362, 364, 362, 364, 16, 17, 18, 19, 512, 513, 514, 23, 364, 517, 364, 519, 2461, 7, 2463, 364, 364, 525, 526, 363, 363, 357, 362, 364, 5, 5, 357, 357, 5, 2478, 364, 364, 48, 2556, 363, 2483, 773, 2485, 2486, 363, 362, 362, 58, 362, 362, 7, 363, 2496, 362, 362, 2499, 2500, 364, 363, 96, 2504, 2505, 99, 362, 5, 363, 362, 364, 5, 572, 363, 363, 1373, 1339, 750, 1009, 1503, 1880, 1721, 1180, 228, 1181, 585, 692, 110, 2073, 1908, 113, 114, 1309, 1092, 594, 595, 596, 278, -1, -1, -1, 2542, -1, 2544, -1, 605, 606, 607, -1, -1, 610, -1, -1, 817, -1, -1, 2556, -1, -1, -1, 1703, 1704, 1705, -1, 1707, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, -1, 2578, -1, 162, -1, -1, -1, -1, -1, 645, -1, 647, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 194, 195, -1, -1, -1, -1, -1, 201, 202, 203, -1, -1, -1, 2614, -1, -1, 2617, -1, 2619, -1, -1, 2622, 5, -1, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, 695, 2637, -1, -1, 22, 2641, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, -1, 362, 363, 719, -1, -1, 45, 46, 2499, -1, -1, -1, -1, -1, -1, -1, 732, -1, -1, -1, -1, -1, -1, 5, -1, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, -1, -1, 22, 757, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, -1, -1, -1, -1, -1, -1, 1017, 1018, -1, 325, -1, -1, -1, -1, -1, 331, -1, -1, -1, 335, -1, 803, 804, -1, 2156, 341, 342, -1, 344, 345, 346, 347, -1, 323, 324, 325, 326, 353, 820, -1, 356, -1, 358, 2156, -1, -1, -1, -1, -1, 1914, -1, 1916, -1, -1, -1, -1, -1, -1, 363, 1924, -1, -1, 5, -1, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, 124, -1, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, 1957, 1958, -1, -1, -1, 879, -1, 415, -1, -1, 45, 46, -1, 1116, -1, 1118, 1119, 1120, -1, -1, -1, 1124, -1, -1, 432, 165, -1, -1, 902, -1, -1, 228, -1, 173, 8, -1, -1, -1, -1, -1, -1, 449, -1, -1, -1, -1, -1, -1, -1, 923, 2007, -1, 2009, 461, -1, -1, 5, -1, -1, -1, 934, -1, 11, 12, 13, 14, 474, -1, -1, -1, 478, 479, 480, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, -1, -1, 228, 124, -1, -1, -1, -1, -1, -1, 45, 46, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 2067, -1, -1, -1, -1, 255, -1, 257, 258, -1, -1, -1, -1, 997, 998, -1, 534, -1, -1, -1, 165, 166, 1235, 1236, 1237, -1, 1239, -1, 173, -1, -1, -1, -1, -1, -1, 285, -1, -1, 97, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 362, 363, -1, -1, -1, -1, -1, 1275, 313, -1, 315, 316, -1, -1, 319, 320, -1, -1, -1, 592, 593, -1, -1, 328, -1, -1, -1, -1, 228, -1, -1, -1, 605, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 617, 618, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 1324, -1, 363, 1327, -1, 1329, 5, 636, -1, -1, -1, 1335, 11, 12, 13, 14, 645, -1, 647, -1, -1, -1, 1117, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, -1, 2215, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, -1, -1, -1, -1, -1, -1, 1150, -1, -1, 228, -1, -1, -1, -1, -1, 5, -1, 1390, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, -1, -1, 22, 1177, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, 5, 363, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, 1215, -1, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, 45, 46, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, 355, -1, -1, -1, 359, 1260, -1, 1262, -1, -1, 1265, 1266, -1, 1268, -1, -1, -1, -1, -1, -1, 809, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 363, -1, -1, -1, 1521, -1, 3, 4, 5, -1, -1, -1, -1, -1, -1, -1, -1, 1305, 15, -1, -1, -1, -1, 20, 21, 22, 1314, -1, -1, -1, -1, -1, -1, -1, 2405, -1, 228, 2408, -1, -1, -1, -1, 39, 40, 41, 42, 43, -1, -1, -1, 47, -1, 49, 50, 51, 52, 53, 54, 55, 56, 57, -1, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, -1, -1, -1, -1, -1, -1, 228, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 2482, 934, -1, -1, -1, 1633, -1, -1, -1, -1, -1, -1, -1, 1641, -1, -1, 2498, -1, -1, -1, 1648, 2503, -1, -1, -1, 228, -1, -1, -1, -1, 1658, 5, 6, 1661, -1, 9, 10, -1, 1666, -1, -1, -1, 16, 17, 18, 19, -1, -1, 22, 23, -1, -1, 1680, -1, 2536, 1683, -1, -1, -1, 362, 363, -1, -1, 2545, 2546, -1, -1, 2549, -1, 1697, -1, -1, -1, -1, 48, -1, -1, -1, -1, -1, -1, -1, -1, 2565, 58, -1, -1, 5, -1, -1, -1, -1, 2574, 11, 12, 13, 14, -1, -1, -1, 7, -1, 1730, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, 362, 363, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, 1757, 1758, 1759, -1, -1, 1762, -1, 3, 4, 5, 6, -1, -1, 9, 10, -1, 1544, -1, -1, 15, 16, 17, 18, 19, 20, 21, 22, 23, -1, -1, 362, 363, -1, -1, 1562, 1563, -1, -1, -1, -1, -1, -1, -1, 39, 40, 41, 42, 43, -1, -1, -1, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 1627, 96, -1, -1, 99, -1, -1, -1, 344, 1636, 1637, 1638, -1, -1, -1, 351, 1177, -1, 354, 1646, -1, -1, 1649, 359, 1651, 1652, -1, 363, -1, 1656, -1, -1, 1659, 1660, -1, -1, -1, 1664, -1, -1, 1667, 1668, 1669, 1670, -1, -1, 1673, 1674, 1675, 1676, 1677, -1, 1679, -1, -1, -1, -1, 1218, 1685, 1686, -1, -1, -1, 1690, 1691, 1226, -1, 5, -1, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, 1706, -1, -1, 228, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 1723, -1, -1, -1, -1, -1, -1, 1959, -1, -1, 1733, 45, 46, 5, -1, -1, -1, 1274, -1, 11, 12, 13, 14, 7, -1, 323, 324, 325, 326, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, 1769, -1, -1, -1, -1, -1, -1, 45, 46, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 2021, 5, -1, -1, -1, -1, 2027, 11, 12, 13, 14, -1, -1, -1, -1, 2036, -1, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, 45, 46, 343, 344, 345, 346, 347, -1, 349, 350, 362, 363, 353, 2075, -1, -1, -1, -1, 359, -1, -1, -1, 323, 324, 325, 326, -1, -1, 2090, -1, -1, -1, 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, -1, 344, 343, 344, 345, 346, 347, 348, 351, -1, -1, 354, 353, -1, 355, -1, 359, -1, -1, 362, -1, -1, -1, -1, -1, -1, 1901, -1, 1903, 1904, 1905, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 228, -1, -1, -1, 1921, 1922, -1, -1, 1925, -1, 1927, -1, -1, -1, 1931, 1932, -1, 1934, -1, -1, -1, -1, -1, -1, -1, -1, 1943, -1, 1945, 1946, 1947, 1948, 1949, 1950, 1951, 1952, 1953, 1954, -1, 1956, -1, -1, 228, -1, 1961, 1962, -1, -1, -1, 1966, -1, -1, -1, -1, -1, 1972, 5, -1, -1, -1, -1, -1, 11, 12, 13, 14, -1, 1984, 1985, -1, -1, -1, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, -1, 2008, 8, 2010, 2011, -1, 45, 46, -1, 228, -1, -1, -1, -1, -1, -1, -1, 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, 2034, 2035, 343, 344, 345, 346, 347, 348, -1, 2043, -1, 2274, 353, 2276, -1, -1, 357, 362, 363, 2053, -1, -1, 2285, 2057, -1, -1, -1, 2061, 2062, -1, 2293, 2065, -1, -1, -1, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, 2309, -1, 343, 344, 345, 346, 347, 2316, 349, 350, -1, -1, 353, 362, 363, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, 2105, -1, -1, 2108, 2109, 2110, 2111, -1, -1, 5, -1, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, -1, 2359, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, -1, 2145, 2146, 2147, 2148, 2149, 362, 363, -1, 2153, 45, 46, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 1703, 1704, 1705, -1, 1707, 2403, -1, -1, -1, -1, -1, -1, 5, -1, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 228, -1, 22, 1733, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 5, -1, 2441, -1, -1, -1, 11, 12, 13, 14, -1, 45, 46, 2223, -1, -1, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, -1, -1, 2246, -1, -1, -1, 45, 46, -1, -1, -1, 2255, -1, -1, 2258, -1, -1, -1, -1, -1, -1, -1, -1, -1, 2268, 2269, 2270, 2271, -1, -1, -1, 2275, -1, 2277, -1, 2279, -1, -1, -1, 2283, -1, -1, -1, -1, -1, -1, 2290, 2291, 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, 348, 2310, 2311, 2312, 2313, 353, -1, -1, -1, 2318, 2319, 2320, -1, -1, -1, -1, -1, -1, -1, -1, -1, 362, 363, 331, 332, 333, 334, 335, 228, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, 355, -1, 2358, -1, 359, -1, -1, -1, -1, -1, -1, 1901, -1, 1903, 1904, 1905, -1, 2373, -1, -1, -1, -1, -1, -1, 1914, 2381, 1916, -1, -1, -1, -1, -1, -1, -1, 1924, -1, -1, -1, -1, 2395, 2396, -1, -1, -1, -1, -1, -1, -1, 228, -1, -1, 2407, -1, 2409, -1, -1, -1, -1, -1, 2415, -1, -1, -1, -1, -1, -1, -1, 1957, 1958, -1, -1, -1, 5, -1, -1, -1, -1, 228, 11, 12, 13, 14, -1, -1, -1, -1, 2442, 2443, 2444, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, 362, 363, 2007, -1, 2009, -1, -1, -1, -1, -1, -1, -1, 2483, -1, 2485, 2486, -1, -1, -1, -1, -1, 2492, -1, -1, 2495, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 2509, -1, -1, 2512, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 2528, 2529, -1, -1, -1, 2067, -1, -1, -1, -1, 362, 363, -1, -1, -1, 2543, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 2556, -1, -1, -1, -1, -1, 2562, 2563, -1, -1, 2566, 362, 363, -1, -1, 2105, -1, -1, -1, -1, -1, 2111, -1, -1, -1, -1, -1, -1, -1, -1, 2586, -1, -1, -1, -1, 2591, -1, -1, 7, -1, -1, 2597, 2598, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 2611, -1, -1, -1, 2615, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 2628, -1, -1, 2631, -1, 2633, 2634, -1, -1, -1, -1, -1, 3, 4, 5, 6, 2644, 2645, 9, 10, -1, -1, -1, 228, 15, 16, 17, 18, 19, 20, 21, 22, 23, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 39, 40, 41, 42, 43, 2215, -1, -1, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, -1, -1, -1, -1, 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, 348, 3, 4, 5, 6, 353, -1, 9, 10, 357, -1, -1, -1, 15, 16, 17, 18, 19, 20, 21, 22, 23, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 2310, 2311, 2312, 2313, 39, 40, 41, 42, 43, 362, 363, -1, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, -1, -1, -1, 3, 4, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, 15, -1, -1, -1, -1, 20, 21, 22, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 2405, -1, 47, 2408, 49, 50, 51, 52, 53, 54, 55, 56, 57, -1, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, -1, 90, 91, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, 2482, 2483, -1, 2485, 2486, -1, -1, -1, -1, -1, -1, -1, 323, 324, 325, 326, 2498, -1, -1, -1, -1, 2503, -1, -1, -1, -1, 148, -1, -1, -1, -1, -1, -1, 344, -1, -1, 5, 159, 160, 161, 351, -1, -1, 354, -1, -1, -1, -1, 359, -1, -1, 362, -1, 22, 2536, -1, -1, -1, -1, -1, -1, -1, -1, 2545, 2546, -1, -1, 2549, -1, -1, -1, -1, -1, -1, 2556, -1, -1, -1, -1, -1, -1, 7, -1, 2565, -1, -1, -1, -1, -1, -1, -1, -1, 2574, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 323, 324, 325, 326, -1, 3, 4, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, 15, -1, -1, -1, 344, 20, 21, 22, -1, -1, -1, 351, -1, -1, 354, -1, -1, -1, -1, 359, -1, -1, 362, -1, -1, -1, -1, -1, -1, -1, -1, -1, 47, -1, 49, 50, 51, 52, 53, 54, 55, 56, 57, -1, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 7, 90, 91, -1, -1, -1, -1, -1, 337, -1, -1, -1, -1, -1, 343, 344, -1, -1, -1, -1, -1, -1, 351, -1, -1, 354, -1, -1, 357, 358, 359, 360, -1, 362, 3, 4, 5, 6, -1, -1, 9, 10, -1, -1, -1, -1, 15, 16, 17, 18, 19, 20, 21, 22, 23, -1, -1, -1, -1, 148, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 159, 160, 161, 7, -1, -1, -1, -1, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 3, 4, 5, 6, -1, -1, 9, 10, -1, -1, -1, -1, 15, 16, 17, 18, 19, 20, 21, 22, 23, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 3, 4, 5, -1, -1, -1, -1, -1, -1, 337, -1, -1, 15, -1, -1, 343, 344, 20, 21, 22, -1, -1, -1, 351, -1, -1, 354, -1, -1, -1, -1, 359, 360, -1, 362, -1, 39, 40, 41, 42, 43, -1, -1, -1, 47, -1, 49, 50, 51, 52, 53, 54, 55, 56, 57, -1, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, -1, -1, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, 323, 324, 325, 326, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, 344, 349, 350, -1, -1, 353, -1, 351, -1, 357, 354, 359, -1, -1, -1, 359, 364, -1, 362, -1, -1, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 323, 324, 325, 326, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, 344, 349, 350, -1, -1, 353, -1, 351, -1, 357, 354, 359, -1, -1, -1, 359, 364, -1, 362, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 3, 4, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, 15, -1, -1, -1, -1, 20, 21, 22, -1, -1, -1, -1, -1, -1, 276, -1, -1, -1, 280, -1, -1, -1, -1, 285, 39, 40, 41, 42, 43, -1, -1, -1, 47, -1, 49, 50, 51, 52, 53, 54, 55, 56, 57, -1, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, -1, -1, -1, -1, -1, -1, 3, 4, 5, -1, -1, -1, 344, -1, 99, -1, -1, -1, 15, 351, -1, -1, 354, 20, 21, 22, -1, 359, -1, -1, 362, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 39, 40, 41, 42, 43, -1, -1, -1, 47, -1, 49, 50, 51, 52, 53, 54, 55, 56, 57, -1, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 3, 4, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, 15, -1, -1, -1, -1, 20, 21, 22, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 39, 40, 41, 42, 43, -1, -1, -1, 47, -1, 49, 50, 51, 52, 53, 54, 55, 56, 57, -1, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 3, 4, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, 15, -1, -1, -1, -1, 20, 21, 22, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 39, 40, 41, 42, 43, -1, -1, -1, 47, -1, 49, 50, 51, 52, 53, 54, 55, 56, 57, -1, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, -1, 3, 4, 5, -1, -1, -1, 344, -1, -1, -1, -1, -1, 15, 351, -1, -1, 354, 20, 21, 22, -1, 359, -1, -1, 362, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 47, -1, 49, 50, 51, 52, 53, 54, 55, 56, 57, -1, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 7, -1, -1, -1, -1, -1, 3, 4, 5, -1, -1, -1, 344, -1, -1, -1, -1, -1, 15, 351, -1, -1, 354, 20, 21, 22, -1, 359, -1, -1, 362, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 47, -1, 49, 50, 51, 52, 53, 54, 55, 56, 57, -1, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, -1, -1, -1, -1, -1, -1, 344, -1, -1, -1, -1, -1, -1, 351, -1, -1, 354, -1, -1, -1, -1, 359, -1, -1, 362, -1, -1, -1, -1, -1, 5, -1, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, -1, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, 45, 46, 343, 344, 345, 346, 347, 348, -1, -1, -1, -1, 353, -1, -1, -1, 357, -1, 344, -1, -1, -1, -1, -1, -1, 351, -1, -1, 354, -1, -1, -1, -1, 359, -1, 5, 362, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, -1, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 7, -1, -1, 144, -1, 344, -1, -1, -1, -1, -1, -1, 351, -1, -1, 354, 355, -1, -1, -1, 359, -1, -1, 362, -1, -1, 5, -1, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, -1, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, 228, 349, 350, 7, -1, 353, 344, -1, -1, -1, -1, 359, -1, 351, -1, -1, 354, -1, -1, -1, -1, 359, 175, 176, 362, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, -1, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, -1, 175, 176, 264, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, 363, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, 5, -1, -1, 264, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 363, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, 7, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 5, -1, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 363, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, -1, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, 7, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, 175, 176, -1, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, -1, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, -1, 175, 176, 264, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, -1, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, 5, -1, -1, 264, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 363, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, 7, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 5, -1, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 363, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, 7, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 175, 176, -1, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, -1, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, -1, 175, 176, 264, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, -1, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, 5, -1, -1, 264, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 363, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, 7, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 5, -1, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 363, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, 7, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 175, 176, -1, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, -1, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, -1, 175, 176, 264, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, -1, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, 5, -1, -1, 264, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 363, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, 7, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 5, -1, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 363, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, 7, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 175, 176, -1, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, -1, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, -1, 175, 176, 264, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, -1, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, 5, -1, -1, 264, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 363, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, 7, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 5, -1, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 363, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, 7, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 175, 176, -1, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, -1, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, -1, 175, 176, 264, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, -1, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, 5, -1, -1, 264, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 363, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, 7, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 5, -1, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 363, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, 7, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 175, 176, -1, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, -1, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, -1, 175, 176, 264, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, -1, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, 5, -1, -1, 264, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 363, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, 7, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 5, -1, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 363, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, 7, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 175, 176, -1, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, -1, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, -1, 175, 176, 264, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, -1, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, 5, -1, -1, 264, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 363, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, 7, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 5, -1, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 363, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, 8, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 175, 176, -1, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, -1, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, -1, 175, 176, 264, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, -1, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, 5, -1, -1, 264, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 363, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 5, -1, -1, -1, -1, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, 363, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, 330, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 175, 176, -1, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, -1, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, -1, -1, -1, -1, -1, 260, -1, 175, 176, 264, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, 8, -1, -1, -1, -1, 206, 207, 208, -1, -1, 211, 212, 213, 214, 215, 216, -1, -1, 219, -1, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, -1, -1, -1, 254, 3, 4, 5, 6, -1, 260, 9, 10, -1, 264, -1, -1, 15, 16, 17, 18, 19, 20, 21, 22, 23, 363, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 39, 40, 41, 42, 43, -1, -1, -1, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 3, 4, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, 15, -1, 99, -1, -1, 20, 21, 22, -1, -1, -1, -1, -1, -1, 363, -1, -1, -1, -1, -1, -1, -1, -1, -1, 39, 40, 41, 42, 43, -1, -1, -1, 47, -1, 49, 50, 51, 52, 53, 54, 55, 56, 57, -1, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 3, 4, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, 15, -1, -1, -1, -1, 20, 21, 22, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 39, 40, 41, 42, 43, -1, -1, -1, 47, -1, 49, 50, 51, 52, 53, 54, 55, 56, 57, -1, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 323, 324, 325, 326, -1, 3, 4, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, 15, -1, -1, -1, 344, 20, 21, 22, -1, -1, -1, 351, -1, -1, 354, -1, -1, -1, -1, 359, -1, -1, -1, -1, 39, 40, 41, 42, 43, -1, -1, -1, 47, -1, 49, 50, 51, 52, 53, 54, 55, 56, 57, -1, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 3, 4, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, 15, -1, -1, -1, 344, 20, 21, 22, -1, -1, -1, 351, -1, -1, 354, 355, -1, -1, -1, 359, -1, -1, 8, -1, -1, -1, -1, -1, -1, -1, -1, -1, 47, -1, 49, 50, 51, 52, 53, 54, 55, 56, 57, -1, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 3, 4, 5, -1, -1, -1, -1, -1, 8, -1, -1, -1, 15, -1, -1, -1, 344, 20, 21, 22, -1, -1, -1, 351, -1, -1, 354, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, 8, -1, -1, -1, -1, -1, -1, 47, -1, 49, 50, 51, 52, 53, 54, 55, 56, 57, -1, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 3, 4, 5, -1, -1, -1, -1, -1, 8, -1, -1, -1, 15, -1, -1, -1, -1, 20, 21, 22, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 8, -1, -1, -1, -1, -1, -1, 47, -1, 49, 50, 51, 52, 53, 54, 55, 56, 57, -1, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, -1, 168, -1, -1, -1, -1, -1, 3, 4, 5, -1, -1, -1, 344, -1, -1, -1, -1, -1, 15, 351, -1, -1, 354, 20, 21, 22, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 47, -1, 49, 50, 51, 52, 53, 54, 55, 56, 57, -1, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, -1, -1, -1, -1, -1, -1, 344, -1, -1, -1, -1, -1, -1, 351, -1, -1, 354, 355, -1, -1, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, -1, -1, -1, -1, 5, 6, -1, -1, 9, 10, -1, -1, -1, -1, -1, 16, 17, 18, 19, -1, -1, 22, 23, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, 344, -1, 343, 344, 345, 346, 347, 351, 349, 350, 354, -1, 353, -1, 48, 359, -1, -1, 359, 331, 332, 333, 334, 335, 58, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, 330, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 344, -1, 343, 344, 345, 346, 347, 351, 349, 350, 354, -1, 353, -1, -1, 359, -1, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, 5, 349, 350, -1, -1, 353, 11, 12, 13, 14, -1, 359, -1, -1, -1, -1, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 344, -1, -1, -1, -1, 5, -1, 351, -1, -1, 354, 11, 12, 13, 14, 359, -1, -1, -1, -1, -1, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, -1, -1, 37, -1, -1, -1, -1, 5, -1, -1, 45, 46, -1, 11, 12, 13, 14, -1, -1, -1, -1, -1, -1, -1, 22, -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 45, 46, -1, 106, -1, -1, -1, -1, -1, -1, 92, -1, -1, -1, -1, -1, 98, -1, -1, -1, -1, 124, -1, -1, -1, -1, -1, -1, 110, -1, -1, 113, -1, -1, -1, -1, 323, 324, 325, 326, -1, 123, -1, -1, -1, 127, -1, -1, -1, -1, -1, -1, 339, -1, -1, 342, -1, 139, -1, -1, -1, -1, -1, -1, -1, -1, 169, -1, -1, -1, -1, 331, 332, 333, 334, 335, 179, 337, 338, 339, 340, -1, 164, 343, 344, 345, 346, 347, 228, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, -1, -1, -1, -1, 364, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 219, -1, -1, 259, 260, 261, 262, 263, -1, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, 228, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, -1, 364, -1, -1, -1, 265, -1, -1, -1, -1, -1, -1, -1, 252, -1, 254, 276, 277, 278, 279, 280, 281, 282, 283, 284, 285, 228, -1, 288, 289, 290, 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, 321, 322, -1, -1, -1, -1, 327, 328, 329, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, 331, 332, 333, 334, 335, 359, 337, 338, 339, 340, 364, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359, -1, -1, -1, 363, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, 355, -1, -1, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, 355, -1, -1, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, 355, -1, -1, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, 355, -1, -1, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, 355, -1, -1, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, 355, -1, -1, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, 355, -1, -1, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, 355, -1, -1, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, 357, -1, 359, 331, 332, 333, 334, 335, -1, 337, 338, 339, 340, -1, -1, 343, 344, 345, 346, 347, -1, 349, 350, -1, -1, 353, -1, -1, -1, -1, -1, 359 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing symbol of state STATE-NUM. */ static const yytype_uint16 yystos[] = { 0, 368, 369, 0, 370, 371, 5, 11, 12, 13, 14, 22, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 37, 45, 46, 92, 98, 110, 113, 123, 127, 139, 164, 228, 252, 254, 372, 538, 551, 552, 553, 571, 572, 366, 354, 356, 7, 356, 5, 354, 354, 354, 5, 6, 9, 10, 16, 17, 18, 19, 23, 48, 58, 323, 324, 325, 326, 573, 579, 550, 572, 573, 354, 572, 573, 575, 356, 356, 362, 362, 362, 362, 362, 362, 362, 362, 572, 362, 362, 572, 354, 356, 359, 572, 577, 366, 330, 343, 344, 354, 362, 572, 572, 575, 162, 3, 4, 5, 15, 20, 21, 47, 49, 50, 51, 52, 53, 54, 55, 56, 57, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 344, 351, 354, 359, 565, 566, 572, 580, 581, 565, 565, 577, 577, 577, 356, 356, 356, 356, 356, 356, 577, 7, 565, 559, 562, 373, 429, 414, 420, 436, 391, 457, 483, 7, 523, 534, 256, 7, 7, 573, 362, 5, 39, 40, 41, 42, 43, 344, 362, 565, 568, 570, 571, 573, 330, 330, 344, 355, 565, 569, 570, 565, 355, 357, 364, 357, 362, 354, 577, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 565, 565, 565, 5, 8, 331, 332, 333, 334, 335, 337, 338, 339, 340, 343, 344, 345, 346, 347, 349, 350, 353, 359, 355, 355, 575, 576, 575, 565, 575, 575, 575, 572, 573, 576, 575, 355, 357, 364, 390, 357, 390, 93, 363, 374, 551, 572, 362, 363, 430, 551, 362, 363, 362, 363, 362, 363, 437, 551, 97, 363, 392, 551, 572, 362, 363, 458, 551, 362, 363, 484, 551, 362, 363, 524, 551, 362, 363, 535, 551, 572, 355, 357, 364, 578, 565, 354, 362, 356, 356, 356, 356, 356, 362, 565, 570, 363, 569, 8, 345, 346, 7, 343, 344, 345, 346, 353, 354, 7, 568, 568, 330, 343, 344, 345, 355, 364, 363, 7, 356, 7, 565, 565, 565, 575, 572, 572, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 355, 354, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 364, 578, 364, 578, 364, 357, 357, 357, 357, 574, 357, 578, 550, 7, 572, 7, 572, 573, 356, 330, 343, 431, 415, 421, 438, 356, 356, 459, 485, 525, 536, 539, 569, 7, 363, 355, 362, 363, 572, 5, 565, 570, 565, 565, 575, 569, 363, 565, 362, 565, 570, 565, 570, 570, 570, 565, 570, 565, 570, 565, 355, 362, 7, 7, 568, 330, 330, 330, 343, 344, 565, 570, 565, 363, 8, 355, 364, 357, 364, 567, 357, 357, 357, 357, 357, 357, 357, 357, 357, 357, 364, 357, 357, 357, 357, 357, 357, 357, 357, 364, 364, 364, 357, 355, 8, 355, 8, 575, 569, 575, 557, 7, 330, 362, 388, 5, 96, 99, 359, 377, 380, 330, 111, 114, 124, 363, 432, 111, 124, 363, 416, 111, 116, 124, 363, 422, 98, 114, 124, 125, 133, 135, 363, 439, 551, 393, 5, 357, 359, 377, 379, 572, 5, 114, 124, 140, 363, 460, 124, 165, 166, 173, 363, 486, 551, 124, 140, 167, 253, 363, 526, 124, 165, 173, 255, 257, 258, 285, 313, 315, 316, 319, 320, 328, 363, 537, 551, 362, 578, 569, 357, 364, 364, 364, 364, 357, 363, 8, 569, 569, 7, 568, 568, 568, 330, 330, 357, 7, 565, 575, 565, 555, 565, 565, 565, 565, 565, 565, 578, 364, 357, 364, 558, 362, 565, 573, 565, 357, 390, 356, 3, 5, 354, 362, 365, 384, 386, 572, 7, 356, 377, 5, 362, 5, 572, 551, 362, 572, 362, 38, 127, 345, 394, 395, 5, 362, 5, 572, 362, 362, 362, 357, 390, 330, 357, 362, 5, 572, 362, 572, 565, 362, 487, 572, 362, 572, 572, 572, 565, 362, 572, 575, 356, 5, 7, 568, 568, 565, 565, 565, 540, 7, 363, 5, 570, 565, 565, 565, 363, 363, 7, 7, 7, 568, 568, 7, 8, 363, 578, 357, 357, 364, 556, 357, 357, 357, 357, 355, 575, 5, 30, 124, 568, 573, 363, 7, 572, 386, 8, 565, 570, 385, 570, 94, 381, 384, 7, 362, 433, 7, 7, 417, 7, 423, 356, 356, 345, 7, 398, 399, 7, 454, 7, 7, 440, 444, 451, 7, 572, 394, 330, 467, 7, 7, 461, 7, 7, 488, 362, 7, 527, 7, 7, 7, 7, 540, 7, 7, 565, 7, 7, 7, 7, 7, 7, 363, 541, 355, 357, 357, 364, 364, 355, 7, 7, 565, 5, 124, 578, 362, 565, 573, 573, 573, 560, 561, 330, 362, 375, 3, 355, 355, 363, 390, 365, 378, 433, 362, 363, 551, 362, 363, 362, 363, 565, 5, 345, 5, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 90, 91, 148, 159, 160, 161, 337, 343, 344, 351, 354, 359, 360, 362, 400, 404, 482, 563, 564, 566, 572, 580, 581, 362, 363, 551, 362, 363, 551, 362, 363, 362, 363, 551, 362, 7, 394, 144, 145, 146, 147, 363, 468, 551, 362, 363, 551, 362, 363, 551, 495, 362, 363, 551, 363, 364, 259, 260, 261, 262, 263, 542, 551, 565, 565, 363, 362, 568, 573, 573, 576, 555, 557, 362, 565, 364, 8, 344, 386, 382, 390, 363, 434, 418, 424, 357, 357, 482, 356, 410, 356, 356, 356, 356, 405, 406, 407, 408, 5, 44, 400, 400, 400, 400, 5, 565, 3, 177, 280, 572, 5, 572, 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, 343, 344, 345, 346, 347, 348, 353, 359, 361, 356, 411, 411, 455, 441, 445, 452, 565, 7, 362, 362, 362, 362, 462, 489, 5, 34, 35, 175, 176, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, 206, 207, 208, 211, 212, 213, 214, 215, 216, 219, 221, 222, 223, 224, 225, 226, 227, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, 254, 260, 264, 363, 497, 498, 499, 551, 528, 565, 356, 356, 356, 356, 356, 357, 357, 554, 565, 363, 363, 363, 389, 363, 384, 3, 386, 357, 5, 95, 383, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 114, 127, 363, 435, 99, 110, 363, 419, 111, 114, 115, 363, 425, 482, 356, 482, 400, 564, 572, 564, 356, 356, 356, 356, 339, 356, 355, 354, 330, 572, 363, 401, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 565, 565, 357, 358, 400, 412, 362, 413, 126, 136, 137, 138, 363, 456, 124, 126, 127, 128, 129, 130, 131, 132, 363, 442, 124, 126, 134, 363, 446, 114, 124, 126, 363, 453, 363, 473, 473, 477, 469, 110, 113, 114, 124, 141, 142, 143, 162, 251, 356, 363, 463, 114, 124, 167, 168, 169, 170, 171, 172, 363, 490, 551, 356, 572, 356, 356, 356, 394, 356, 394, 356, 356, 356, 356, 356, 356, 356, 356, 356, 7, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 362, 356, 362, 356, 356, 356, 362, 356, 356, 362, 7, 7, 7, 356, 356, 356, 356, 356, 7, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 356, 500, 501, 356, 356, 106, 124, 363, 529, 364, 544, 572, 6, 544, 379, 575, 575, 363, 364, 330, 362, 376, 572, 384, 379, 379, 379, 379, 356, 394, 565, 356, 394, 356, 394, 394, 362, 572, 5, 356, 394, 94, 379, 572, 362, 5, 5, 357, 398, 357, 364, 409, 411, 398, 398, 398, 398, 356, 400, 400, 363, 400, 357, 357, 364, 99, 569, 573, 572, 5, 380, 383, 572, 572, 572, 5, 362, 362, 396, 396, 379, 379, 5, 5, 362, 449, 5, 362, 447, 5, 572, 572, 5, 110, 112, 113, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 162, 163, 363, 474, 481, 363, 162, 363, 478, 481, 114, 138, 362, 363, 470, 572, 5, 5, 135, 144, 572, 572, 565, 3, 379, 568, 465, 5, 572, 362, 491, 572, 575, 568, 575, 362, 493, 572, 572, 572, 7, 394, 394, 394, 7, 394, 7, 572, 572, 572, 572, 572, 572, 572, 572, 572, 572, 572, 394, 397, 572, 572, 572, 572, 572, 575, 565, 512, 565, 514, 572, 565, 565, 516, 565, 575, 518, 568, 394, 379, 575, 575, 575, 575, 575, 572, 572, 572, 572, 572, 572, 572, 572, 572, 572, 572, 572, 572, 572, 356, 356, 575, 572, 362, 572, 565, 266, 267, 268, 269, 270, 271, 272, 273, 274, 547, 356, 546, 364, 547, 543, 548, 357, 565, 575, 3, 5, 387, 364, 7, 7, 7, 7, 394, 7, 7, 394, 7, 394, 7, 7, 354, 566, 7, 7, 394, 7, 7, 7, 413, 426, 7, 7, 364, 400, 356, 357, 357, 364, 364, 364, 398, 357, 8, 400, 356, 363, 363, 7, 7, 7, 7, 7, 7, 362, 443, 5, 397, 7, 7, 7, 7, 7, 450, 7, 448, 7, 7, 7, 7, 356, 572, 394, 5, 379, 7, 356, 379, 356, 5, 5, 471, 7, 7, 7, 7, 7, 7, 464, 7, 7, 7, 7, 398, 7, 7, 492, 7, 7, 7, 7, 494, 7, 7, 364, 496, 357, 357, 357, 357, 364, 364, 364, 364, 364, 364, 364, 357, 364, 357, 364, 364, 357, 364, 357, 364, 364, 357, 364, 364, 357, 364, 357, 364, 173, 177, 201, 202, 203, 363, 513, 364, 173, 177, 201, 202, 204, 205, 363, 515, 364, 364, 364, 36, 116, 173, 209, 210, 363, 517, 364, 364, 36, 116, 166, 173, 174, 209, 217, 218, 363, 519, 357, 357, 364, 357, 357, 357, 364, 357, 364, 364, 364, 364, 364, 357, 364, 357, 357, 364, 364, 357, 364, 364, 357, 396, 502, 572, 502, 357, 364, 364, 530, 7, 357, 379, 379, 362, 379, 362, 362, 362, 362, 362, 548, 379, 343, 344, 345, 346, 364, 545, 323, 394, 548, 364, 357, 364, 549, 7, 330, 363, 364, 384, 364, 364, 364, 565, 390, 364, 7, 362, 363, 379, 357, 398, 362, 3, 565, 565, 357, 339, 402, 379, 140, 7, 390, 363, 363, 390, 363, 390, 3, 7, 7, 7, 7, 475, 7, 479, 7, 7, 5, 162, 363, 472, 356, 466, 357, 363, 390, 363, 390, 565, 357, 362, 362, 7, 7, 394, 572, 572, 565, 565, 565, 572, 7, 394, 7, 379, 360, 7, 565, 7, 394, 565, 7, 565, 565, 7, 572, 7, 565, 362, 394, 565, 565, 394, 565, 362, 394, 565, 565, 565, 565, 565, 565, 565, 565, 565, 362, 565, 394, 394, 575, 565, 565, 572, 362, 362, 565, 565, 362, 7, 7, 394, 7, 7, 7, 575, 7, 568, 568, 568, 565, 568, 7, 379, 7, 7, 572, 572, 7, 379, 572, 7, 503, 503, 7, 565, 379, 5, 144, 363, 551, 7, 275, 394, 362, 569, 362, 362, 362, 357, 357, 5, 356, 548, 357, 162, 7, 106, 124, 169, 179, 219, 265, 276, 277, 278, 279, 280, 281, 282, 283, 284, 285, 288, 289, 290, 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, 321, 322, 327, 328, 329, 575, 557, 3, 5, 364, 394, 394, 394, 355, 566, 394, 427, 357, 357, 565, 357, 364, 364, 403, 400, 357, 5, 5, 5, 5, 357, 398, 398, 482, 379, 572, 7, 7, 572, 572, 7, 495, 495, 357, 364, 364, 364, 364, 364, 364, 357, 364, 572, 357, 357, 357, 357, 357, 364, 495, 7, 7, 7, 7, 364, 495, 7, 7, 7, 7, 7, 364, 364, 364, 7, 7, 495, 7, 7, 364, 364, 7, 7, 7, 495, 495, 7, 7, 520, 357, 364, 357, 357, 357, 364, 364, 364, 496, 364, 364, 364, 357, 364, 357, 364, 504, 357, 357, 357, 362, 362, 5, 364, 569, 363, 569, 569, 569, 7, 546, 575, 357, 7, 379, 568, 575, 568, 362, 5, 339, 342, 575, 565, 565, 568, 565, 565, 575, 5, 565, 565, 5, 362, 565, 396, 362, 362, 362, 362, 565, 360, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 568, 568, 394, 575, 565, 565, 575, 575, 575, 565, 575, 363, 565, 357, 357, 357, 390, 363, 357, 117, 118, 119, 120, 121, 122, 363, 428, 357, 364, 565, 565, 356, 363, 7, 363, 390, 7, 476, 480, 7, 7, 357, 363, 363, 7, 568, 565, 568, 565, 565, 572, 7, 572, 357, 7, 7, 7, 7, 7, 394, 363, 394, 363, 565, 565, 394, 363, 509, 565, 363, 363, 362, 363, 7, 565, 7, 7, 7, 565, 575, 575, 357, 565, 565, 575, 7, 168, 565, 7, 276, 280, 285, 568, 7, 7, 7, 531, 531, 362, 394, 363, 363, 363, 363, 364, 357, 7, 548, 394, 575, 575, 569, 565, 565, 565, 569, 572, 357, 7, 7, 7, 354, 7, 7, 5, 565, 565, 565, 565, 565, 362, 565, 357, 364, 400, 139, 7, 5, 364, 364, 362, 357, 357, 364, 364, 364, 364, 357, 7, 364, 364, 364, 364, 357, 364, 166, 254, 357, 364, 521, 364, 357, 357, 357, 7, 364, 364, 357, 364, 575, 357, 364, 575, 568, 575, 110, 113, 114, 162, 363, 481, 532, 363, 565, 364, 362, 362, 362, 362, 548, 357, 364, 363, 364, 364, 364, 363, 7, 565, 7, 7, 7, 7, 7, 7, 565, 363, 565, 357, 572, 363, 398, 482, 495, 7, 7, 565, 565, 565, 565, 7, 394, 565, 394, 565, 362, 565, 362, 362, 362, 565, 36, 114, 116, 127, 140, 162, 363, 522, 394, 7, 7, 7, 565, 565, 7, 394, 357, 364, 7, 379, 572, 5, 5, 379, 356, 364, 394, 569, 569, 569, 569, 357, 7, 394, 565, 565, 565, 355, 363, 364, 362, 7, 357, 357, 363, 357, 357, 364, 357, 364, 357, 364, 364, 364, 495, 357, 510, 511, 495, 364, 5, 5, 565, 394, 5, 379, 357, 357, 357, 357, 7, 565, 357, 7, 7, 7, 7, 533, 565, 363, 363, 363, 363, 363, 7, 364, 364, 364, 364, 363, 565, 565, 7, 7, 7, 7, 394, 7, 568, 362, 565, 568, 565, 363, 362, 362, 363, 362, 363, 363, 565, 7, 7, 7, 7, 7, 7, 7, 362, 362, 7, 357, 364, 7, 398, 363, 362, 362, 363, 362, 362, 394, 565, 565, 565, 7, 364, 363, 357, 364, 495, 357, 364, 364, 495, 572, 572, 364, 495, 495, 7, 379, 357, 362, 568, 569, 362, 569, 569, 363, 363, 363, 363, 565, 7, 7, 565, 363, 362, 568, 575, 363, 364, 364, 568, 363, 363, 357, 7, 565, 364, 363, 565, 363, 363, 357, 92, 364, 495, 364, 364, 565, 565, 364, 7, 363, 568, 363, 363, 363, 362, 379, 565, 363, 568, 568, 364, 364, 568, 364, 362, 569, 7, 357, 357, 364, 565, 565, 364, 568, 565, 363, 164, 7, 7, 506, 364, 364, 568, 363, 364, 363, 572, 166, 254, 364, 505, 5, 5, 357, 565, 362, 362, 362, 362, 565, 357, 5, 363, 362, 363, 565, 565, 507, 508, 364, 362, 363, 495, 364, 363, 362, 363, 362, 363, 565, 495, 363, 565, 7, 572, 572, 364, 363, 362, 364, 363, 364, 364, 565, 362, 495, 565, 565, 565, 495, 363, 363, 364, 364, 363, 565, 565, 364, 364, 5, 5, 363, 363 }; /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ static const yytype_uint16 yyr1[] = { 0, 367, 369, 368, 370, 371, 370, 372, 372, 372, 372, 372, 372, 372, 372, 372, 372, 372, 372, 372, 373, 373, 374, 374, 375, 376, 374, 374, 374, 378, 377, 377, 379, 379, 380, 380, 381, 381, 382, 382, 382, 383, 384, 384, 385, 385, 385, 386, 386, 386, 386, 386, 386, 386, 387, 387, 387, 387, 387, 388, 388, 389, 388, 388, 390, 390, 391, 391, 392, 392, 392, 392, 393, 393, 393, 394, 394, 395, 394, 394, 396, 396, 397, 397, 399, 398, 400, 401, 402, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 400, 403, 400, 404, 404, 404, 404, 404, 404, 405, 404, 406, 404, 407, 404, 408, 404, 409, 404, 404, 404, 404, 410, 404, 404, 404, 404, 404, 404, 404, 404, 404, 404, 404, 411, 411, 411, 412, 412, 413, 413, 413, 413, 414, 414, 415, 415, 416, 416, 417, 417, 418, 418, 419, 419, 419, 420, 420, 421, 421, 422, 422, 422, 423, 423, 424, 424, 425, 425, 425, 426, 426, 427, 427, 428, 428, 428, 428, 428, 428, 429, 429, 430, 430, 431, 431, 432, 432, 432, 432, 432, 433, 433, 433, 434, 434, 435, 435, 435, 435, 435, 435, 435, 435, 435, 435, 435, 435, 435, 435, 435, 435, 435, 435, 436, 436, 437, 437, 438, 438, 438, 439, 439, 439, 439, 439, 439, 440, 440, 440, 441, 441, 442, 442, 442, 442, 442, 442, 442, 442, 442, 443, 443, 444, 444, 445, 445, 446, 446, 446, 447, 447, 448, 448, 449, 449, 450, 450, 451, 451, 451, 452, 452, 453, 453, 453, 454, 454, 454, 455, 455, 456, 456, 456, 456, 457, 457, 458, 458, 459, 459, 460, 460, 460, 460, 461, 461, 461, 462, 462, 463, 463, 463, 463, 463, 464, 463, 463, 465, 463, 463, 463, 463, 463, 466, 466, 467, 467, 467, 468, 468, 468, 468, 469, 469, 470, 470, 470, 471, 471, 472, 472, 473, 473, 475, 476, 474, 474, 474, 474, 474, 474, 474, 477, 477, 478, 479, 480, 478, 481, 481, 481, 481, 481, 481, 481, 481, 481, 481, 481, 481, 482, 482, 483, 483, 484, 484, 485, 485, 486, 486, 486, 487, 486, 486, 488, 488, 488, 489, 489, 490, 490, 490, 490, 490, 490, 490, 490, 490, 491, 491, 492, 492, 493, 493, 494, 494, 495, 495, 496, 496, 497, 497, 497, 497, 498, 498, 498, 498, 498, 498, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 500, 499, 501, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 499, 502, 502, 503, 503, 504, 504, 504, 504, 505, 505, 505, 505, 506, 506, 506, 507, 507, 508, 508, 509, 509, 509, 510, 510, 511, 511, 512, 512, 513, 513, 513, 513, 513, 514, 514, 515, 515, 515, 515, 515, 515, 516, 516, 517, 517, 517, 517, 517, 518, 518, 519, 519, 519, 519, 519, 519, 519, 519, 520, 520, 521, 521, 522, 522, 522, 522, 522, 522, 523, 523, 524, 524, 525, 525, 526, 526, 526, 526, 527, 527, 527, 528, 528, 529, 529, 530, 530, 530, 530, 531, 531, 533, 532, 532, 532, 532, 532, 534, 534, 535, 535, 536, 536, 537, 537, 537, 537, 537, 537, 537, 537, 537, 537, 537, 537, 537, 537, 539, 538, 540, 541, 540, 542, 542, 542, 542, 542, 543, 542, 542, 542, 544, 544, 545, 545, 545, 545, 546, 546, 547, 547, 547, 547, 547, 547, 547, 547, 547, 547, 547, 548, 548, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 549, 550, 550, 551, 551, 551, 551, 551, 551, 551, 551, 551, 551, 551, 551, 551, 551, 551, 552, 552, 553, 553, 553, 553, 553, 553, 553, 553, 553, 553, 553, 553, 553, 553, 553, 553, 553, 553, 553, 553, 553, 553, 554, 554, 555, 555, 556, 556, 556, 556, 557, 557, 558, 558, 558, 558, 558, 559, 559, 559, 559, 560, 559, 559, 561, 559, 562, 562, 562, 563, 563, 563, 563, 563, 563, 563, 563, 563, 563, 563, 563, 563, 563, 563, 563, 563, 563, 563, 563, 563, 563, 563, 564, 564, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 565, 566, 566, 566, 566, 566, 566, 566, 566, 566, 566, 566, 566, 566, 566, 567, 566, 566, 566, 566, 568, 568, 568, 568, 568, 568, 568, 569, 569, 569, 569, 570, 570, 570, 570, 570, 570, 570, 570, 570, 570, 570, 570, 570, 570, 570, 570, 570, 570, 570, 570, 570, 570, 570, 571, 571, 572, 572, 572, 573, 573, 573, 573, 573, 573, 573, 573, 573, 573, 573, 573, 573, 573, 574, 573, 575, 575, 576, 576, 577, 577, 578, 578, 579, 580, 581, 581 }; /* YYR2[YYN] -- Number of symbols on the right hand side of rule YYN. */ static const yytype_uint8 yyr2[] = { 0, 2, 0, 2, 0, 0, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 1, 1, 2, 0, 2, 4, 5, 0, 0, 15, 5, 1, 0, 6, 2, 1, 1, 1, 1, 1, 1, 0, 3, 3, 1, 1, 3, 0, 3, 4, 1, 3, 5, 1, 3, 3, 3, 0, 1, 1, 3, 3, 0, 3, 0, 11, 6, 0, 1, 0, 2, 5, 6, 7, 1, 0, 3, 6, 4, 4, 0, 2, 3, 0, 3, 1, 3, 0, 2, 1, 0, 0, 7, 3, 3, 6, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 2, 2, 2, 0, 10, 3, 1, 3, 2, 1, 2, 0, 5, 0, 7, 0, 9, 0, 15, 0, 11, 10, 4, 4, 0, 7, 6, 2, 2, 2, 2, 3, 2, 3, 1, 1, 3, 2, 3, 1, 3, 0, 3, 6, 3, 0, 4, 0, 2, 3, 4, 0, 4, 0, 2, 3, 3, 4, 0, 4, 0, 2, 3, 3, 4, 0, 4, 0, 2, 3, 3, 4, 0, 4, 0, 2, 3, 3, 3, 3, 3, 3, 0, 2, 3, 1, 0, 2, 3, 3, 4, 5, 2, 0, 4, 2, 0, 2, 3, 3, 3, 3, 3, 7, 3, 7, 11, 3, 3, 3, 3, 3, 7, 3, 7, 7, 0, 2, 3, 1, 0, 2, 2, 3, 3, 4, 4, 4, 4, 0, 4, 2, 0, 2, 3, 3, 4, 7, 9, 3, 3, 3, 3, 0, 20, 0, 4, 0, 2, 3, 3, 3, 1, 3, 0, 3, 1, 3, 0, 3, 0, 4, 2, 0, 2, 3, 3, 3, 0, 4, 2, 0, 2, 3, 3, 3, 3, 0, 2, 3, 1, 0, 2, 3, 3, 4, 4, 0, 4, 2, 0, 2, 3, 3, 3, 3, 3, 0, 5, 3, 0, 5, 3, 3, 3, 3, 0, 3, 0, 2, 2, 4, 4, 4, 4, 0, 2, 3, 3, 3, 0, 2, 3, 3, 0, 2, 0, 0, 9, 3, 3, 3, 2, 5, 3, 0, 2, 3, 0, 0, 9, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 4, 3, 0, 2, 3, 1, 0, 2, 3, 3, 4, 0, 5, 1, 0, 4, 2, 0, 2, 3, 3, 3, 3, 3, 3, 3, 3, 1, 1, 3, 0, 3, 1, 3, 0, 3, 0, 2, 0, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 3, 3, 4, 4, 4, 4, 6, 5, 5, 5, 2, 2, 2, 5, 2, 7, 10, 7, 7, 7, 7, 5, 7, 9, 5, 8, 5, 7, 9, 9, 11, 11, 13, 11, 5, 7, 5, 7, 7, 5, 17, 13, 15, 17, 25, 11, 11, 13, 21, 24, 0, 7, 0, 7, 7, 11, 5, 5, 5, 5, 7, 2, 5, 7, 5, 9, 5, 8, 9, 9, 5, 5, 11, 9, 13, 13, 5, 14, 12, 10, 7, 9, 11, 7, 7, 5, 1, 1, 1, 0, 2, 3, 3, 3, 2, 0, 2, 4, 6, 0, 5, 5, 0, 10, 0, 10, 0, 5, 5, 0, 11, 0, 10, 0, 2, 3, 3, 3, 3, 4, 0, 2, 3, 3, 3, 3, 3, 4, 0, 2, 3, 3, 3, 3, 4, 0, 2, 3, 3, 3, 3, 3, 4, 4, 4, 0, 4, 0, 2, 3, 3, 3, 3, 3, 3, 0, 2, 3, 1, 0, 2, 3, 3, 3, 4, 0, 4, 2, 0, 2, 3, 4, 0, 5, 5, 2, 0, 2, 0, 6, 3, 3, 3, 3, 0, 2, 3, 1, 0, 2, 3, 3, 3, 3, 3, 3, 2, 3, 3, 3, 3, 9, 4, 1, 0, 8, 0, 0, 3, 7, 7, 8, 11, 6, 0, 10, 5, 1, 3, 6, 1, 1, 1, 1, 0, 3, 1, 2, 2, 12, 2, 15, 4, 12, 17, 22, 12, 0, 2, 3, 4, 4, 3, 3, 2, 2, 3, 3, 2, 2, 3, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 5, 2, 2, 2, 3, 9, 3, 2, 9, 2, 9, 2, 9, 5, 4, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 2, 3, 3, 3, 3, 3, 2, 3, 3, 3, 3, 1, 1, 6, 8, 8, 10, 1, 2, 2, 1, 3, 6, 4, 4, 1, 1, 1, 1, 1, 5, 5, 3, 4, 6, 7, 8, 8, 5, 7, 5, 7, 4, 5, 3, 3, 7, 5, 5, 8, 7, 2, 3, 5, 0, 2, 3, 5, 3, 3, 0, 2, 3, 3, 3, 3, 5, 0, 3, 6, 5, 0, 9, 5, 0, 9, 0, 3, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 6, 4, 4, 4, 4, 4, 4, 4, 4, 6, 6, 6, 4, 5, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 6, 1, 4, 4, 0, 2, 1, 1, 3, 4, 5, 1, 1, 3, 3, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 5, 3, 3, 3, 6, 6, 4, 6, 6, 8, 8, 4, 5, 5, 1, 1, 4, 1, 4, 1, 4, 4, 4, 4, 8, 4, 6, 1, 1, 1, 4, 0, 6, 1, 1, 1, 3, 1, 1, 1, 1, 4, 6, 4, 6 }; #define yyerrok (yyerrstatus = 0) #define yyclearin (yychar = YYEMPTY) #define YYEMPTY (-2) #define YYEOF 0 #define YYACCEPT goto yyacceptlab #define YYABORT goto yyabortlab #define YYERROR goto yyerrorlab #define YYRECOVERING() (!!yyerrstatus) #define YYBACKUP(Token, Value) \ do \ if (yychar == YYEMPTY) \ { \ yychar = (Token); \ yylval = (Value); \ YYPOPSTACK (yylen); \ yystate = *yyssp; \ goto yybackup; \ } \ else \ { \ yyerror (YY_("syntax error: cannot back up")); \ YYERROR; \ } \ while (0) /* Error token number */ #define YYTERROR 1 #define YYERRCODE 256 /* Enable debugging if requested. */ #if YYDEBUG # ifndef YYFPRINTF # include /* INFRINGES ON USER NAME SPACE */ # define YYFPRINTF fprintf # endif # define YYDPRINTF(Args) \ do { \ if (yydebug) \ YYFPRINTF Args; \ } while (0) /* This macro is provided for backward compatibility. */ #ifndef YY_LOCATION_PRINT # define YY_LOCATION_PRINT(File, Loc) ((void) 0) #endif # define YY_SYMBOL_PRINT(Title, Type, Value, Location) \ do { \ if (yydebug) \ { \ YYFPRINTF (stderr, "%s ", Title); \ yy_symbol_print (stderr, \ Type, Value); \ YYFPRINTF (stderr, "\n"); \ } \ } while (0) /*----------------------------------------. | Print this symbol's value on YYOUTPUT. | `----------------------------------------*/ static void yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep) { FILE *yyo = yyoutput; YYUSE (yyo); if (!yyvaluep) return; # ifdef YYPRINT if (yytype < YYNTOKENS) YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep); # endif YYUSE (yytype); } /*--------------------------------. | Print this symbol on YYOUTPUT. | `--------------------------------*/ static void yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep) { YYFPRINTF (yyoutput, "%s %s (", yytype < YYNTOKENS ? "token" : "nterm", yytname[yytype]); yy_symbol_value_print (yyoutput, yytype, yyvaluep); YYFPRINTF (yyoutput, ")"); } /*------------------------------------------------------------------. | yy_stack_print -- Print the state stack from its BOTTOM up to its | | TOP (included). | `------------------------------------------------------------------*/ static void yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop) { YYFPRINTF (stderr, "Stack now"); for (; yybottom <= yytop; yybottom++) { int yybot = *yybottom; YYFPRINTF (stderr, " %d", yybot); } YYFPRINTF (stderr, "\n"); } # define YY_STACK_PRINT(Bottom, Top) \ do { \ if (yydebug) \ yy_stack_print ((Bottom), (Top)); \ } while (0) /*------------------------------------------------. | Report that the YYRULE is going to be reduced. | `------------------------------------------------*/ static void yy_reduce_print (yytype_int16 *yyssp, YYSTYPE *yyvsp, int yyrule) { unsigned long int yylno = yyrline[yyrule]; int yynrhs = yyr2[yyrule]; int yyi; YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n", yyrule - 1, yylno); /* The symbols being reduced. */ for (yyi = 0; yyi < yynrhs; yyi++) { YYFPRINTF (stderr, " $%d = ", yyi + 1); yy_symbol_print (stderr, yystos[yyssp[yyi + 1 - yynrhs]], &(yyvsp[(yyi + 1) - (yynrhs)]) ); YYFPRINTF (stderr, "\n"); } } # define YY_REDUCE_PRINT(Rule) \ do { \ if (yydebug) \ yy_reduce_print (yyssp, yyvsp, Rule); \ } while (0) /* Nonzero means print parse trace. It is left uninitialized so that multiple parsers can coexist. */ int yydebug; #else /* !YYDEBUG */ # define YYDPRINTF(Args) # define YY_SYMBOL_PRINT(Title, Type, Value, Location) # define YY_STACK_PRINT(Bottom, Top) # define YY_REDUCE_PRINT(Rule) #endif /* !YYDEBUG */ /* YYINITDEPTH -- initial size of the parser's stacks. */ #ifndef YYINITDEPTH # define YYINITDEPTH 200 #endif /* YYMAXDEPTH -- maximum size the stacks can grow to (effective only if the built-in stack extension method is used). Do not make this value too large; the results are undefined if YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH) evaluated with infinite-precision integer arithmetic. */ #ifndef YYMAXDEPTH # define YYMAXDEPTH 10000 #endif #if YYERROR_VERBOSE # ifndef yystrlen # if defined __GLIBC__ && defined _STRING_H # define yystrlen strlen # else /* Return the length of YYSTR. */ static YYSIZE_T yystrlen (const char *yystr) { YYSIZE_T yylen; for (yylen = 0; yystr[yylen]; yylen++) continue; return yylen; } # endif # endif # ifndef yystpcpy # if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE # define yystpcpy stpcpy # else /* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in YYDEST. */ static char * yystpcpy (char *yydest, const char *yysrc) { char *yyd = yydest; const char *yys = yysrc; while ((*yyd++ = *yys++) != '\0') continue; return yyd - 1; } # endif # endif # ifndef yytnamerr /* Copy to YYRES the contents of YYSTR after stripping away unnecessary quotes and backslashes, so that it's suitable for yyerror. The heuristic is that double-quoting is unnecessary unless the string contains an apostrophe, a comma, or backslash (other than backslash-backslash). YYSTR is taken from yytname. If YYRES is null, do not copy; instead, return the length of what the result would have been. */ static YYSIZE_T yytnamerr (char *yyres, const char *yystr) { if (*yystr == '"') { YYSIZE_T yyn = 0; char const *yyp = yystr; for (;;) switch (*++yyp) { case '\'': case ',': goto do_not_strip_quotes; case '\\': if (*++yyp != '\\') goto do_not_strip_quotes; /* Fall through. */ default: if (yyres) yyres[yyn] = *yyp; yyn++; break; case '"': if (yyres) yyres[yyn] = '\0'; return yyn; } do_not_strip_quotes: ; } if (! yyres) return yystrlen (yystr); return yystpcpy (yyres, yystr) - yyres; } # endif /* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message about the unexpected token YYTOKEN for the state stack whose top is YYSSP. Return 0 if *YYMSG was successfully written. Return 1 if *YYMSG is not large enough to hold the message. In that case, also set *YYMSG_ALLOC to the required number of bytes. Return 2 if the required number of bytes is too large to store. */ static int yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg, yytype_int16 *yyssp, int yytoken) { YYSIZE_T yysize0 = yytnamerr (YY_NULLPTR, yytname[yytoken]); YYSIZE_T yysize = yysize0; enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 }; /* Internationalized format string. */ const char *yyformat = YY_NULLPTR; /* Arguments of yyformat. */ char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM]; /* Number of reported tokens (one for the "unexpected", one per "expected"). */ int yycount = 0; /* There are many possibilities here to consider: - If this state is a consistent state with a default action, then the only way this function was invoked is if the default action is an error action. In that case, don't check for expected tokens because there are none. - The only way there can be no lookahead present (in yychar) is if this state is a consistent state with a default action. Thus, detecting the absence of a lookahead is sufficient to determine that there is no unexpected or expected token to report. In that case, just report a simple "syntax error". - Don't assume there isn't a lookahead just because this state is a consistent state with a default action. There might have been a previous inconsistent state, consistent state with a non-default action, or user semantic action that manipulated yychar. - Of course, the expected token list depends on states to have correct lookahead information, and it depends on the parser not to perform extra reductions after fetching a lookahead from the scanner and before detecting a syntax error. Thus, state merging (from LALR or IELR) and default reductions corrupt the expected token list. However, the list is correct for canonical LR with one exception: it will still contain any token that will not be accepted due to an error action in a later state. */ if (yytoken != YYEMPTY) { int yyn = yypact[*yyssp]; yyarg[yycount++] = yytname[yytoken]; if (!yypact_value_is_default (yyn)) { /* Start YYX at -YYN if negative to avoid negative indexes in YYCHECK. In other words, skip the first -YYN actions for this state because they are default actions. */ int yyxbegin = yyn < 0 ? -yyn : 0; /* Stay within bounds of both yycheck and yytname. */ int yychecklim = YYLAST - yyn + 1; int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; int yyx; for (yyx = yyxbegin; yyx < yyxend; ++yyx) if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR && !yytable_value_is_error (yytable[yyx + yyn])) { if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM) { yycount = 1; yysize = yysize0; break; } yyarg[yycount++] = yytname[yyx]; { YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULLPTR, yytname[yyx]); if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) return 2; yysize = yysize1; } } } } switch (yycount) { # define YYCASE_(N, S) \ case N: \ yyformat = S; \ break YYCASE_(0, YY_("syntax error")); YYCASE_(1, YY_("syntax error, unexpected %s")); YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s")); YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s")); YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s")); YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s")); # undef YYCASE_ } { YYSIZE_T yysize1 = yysize + yystrlen (yyformat); if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) return 2; yysize = yysize1; } if (*yymsg_alloc < yysize) { *yymsg_alloc = 2 * yysize; if (! (yysize <= *yymsg_alloc && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM)) *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM; return 1; } /* Avoid sprintf, as that infringes on the user's name space. Don't have undefined behavior even if the translation produced a string with the wrong number of "%s"s. */ { char *yyp = *yymsg; int yyi = 0; while ((*yyp = *yyformat) != '\0') if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount) { yyp += yytnamerr (yyp, yyarg[yyi++]); yyformat += 2; } else { yyp++; yyformat++; } } return 0; } #endif /* YYERROR_VERBOSE */ /*-----------------------------------------------. | Release the memory associated to this symbol. | `-----------------------------------------------*/ static void yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep) { YYUSE (yyvaluep); if (!yymsg) yymsg = "Deleting"; YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp); YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN YYUSE (yytype); YY_IGNORE_MAYBE_UNINITIALIZED_END } /* The lookahead symbol. */ int yychar; /* The semantic value of the lookahead symbol. */ YYSTYPE yylval; /* Number of syntax errors so far. */ int yynerrs; /*----------. | yyparse. | `----------*/ int yyparse (void) { int yystate; /* Number of tokens to shift before error messages enabled. */ int yyerrstatus; /* The stacks and their tools: 'yyss': related to states. 'yyvs': related to semantic values. Refer to the stacks through separate pointers, to allow yyoverflow to reallocate them elsewhere. */ /* The state stack. */ yytype_int16 yyssa[YYINITDEPTH]; yytype_int16 *yyss; yytype_int16 *yyssp; /* The semantic value stack. */ YYSTYPE yyvsa[YYINITDEPTH]; YYSTYPE *yyvs; YYSTYPE *yyvsp; YYSIZE_T yystacksize; int yyn; int yyresult; /* Lookahead token as an internal (translated) token number. */ int yytoken = 0; /* The variables used to return semantic value and location from the action routines. */ YYSTYPE yyval; #if YYERROR_VERBOSE /* Buffer for error messages, and its allocated size. */ char yymsgbuf[128]; char *yymsg = yymsgbuf; YYSIZE_T yymsg_alloc = sizeof yymsgbuf; #endif #define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N)) /* The number of symbols on the RHS of the reduced rule. Keep to zero when no symbol should be popped. */ int yylen = 0; yyssp = yyss = yyssa; yyvsp = yyvs = yyvsa; yystacksize = YYINITDEPTH; YYDPRINTF ((stderr, "Starting parse\n")); yystate = 0; yyerrstatus = 0; yynerrs = 0; yychar = YYEMPTY; /* Cause a token to be read. */ goto yysetstate; /*------------------------------------------------------------. | yynewstate -- Push a new state, which is found in yystate. | `------------------------------------------------------------*/ yynewstate: /* In all cases, when you get here, the value and location stacks have just been pushed. So pushing a state here evens the stacks. */ yyssp++; yysetstate: *yyssp = yystate; if (yyss + yystacksize - 1 <= yyssp) { /* Get the current used size of the three stacks, in elements. */ YYSIZE_T yysize = yyssp - yyss + 1; #ifdef yyoverflow { /* Give user a chance to reallocate the stack. Use copies of these so that the &'s don't force the real ones into memory. */ YYSTYPE *yyvs1 = yyvs; yytype_int16 *yyss1 = yyss; /* Each stack pointer address is followed by the size of the data in use in that stack, in bytes. This used to be a conditional around just the two extra args, but that might be undefined if yyoverflow is a macro. */ yyoverflow (YY_("memory exhausted"), &yyss1, yysize * sizeof (*yyssp), &yyvs1, yysize * sizeof (*yyvsp), &yystacksize); yyss = yyss1; yyvs = yyvs1; } #else /* no yyoverflow */ # ifndef YYSTACK_RELOCATE goto yyexhaustedlab; # else /* Extend the stack our own way. */ if (YYMAXDEPTH <= yystacksize) goto yyexhaustedlab; yystacksize *= 2; if (YYMAXDEPTH < yystacksize) yystacksize = YYMAXDEPTH; { yytype_int16 *yyss1 = yyss; union yyalloc *yyptr = (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize)); if (! yyptr) goto yyexhaustedlab; YYSTACK_RELOCATE (yyss_alloc, yyss); YYSTACK_RELOCATE (yyvs_alloc, yyvs); # undef YYSTACK_RELOCATE if (yyss1 != yyssa) YYSTACK_FREE (yyss1); } # endif #endif /* no yyoverflow */ yyssp = yyss + yysize - 1; yyvsp = yyvs + yysize - 1; YYDPRINTF ((stderr, "Stack size increased to %lu\n", (unsigned long int) yystacksize)); if (yyss + yystacksize - 1 <= yyssp) YYABORT; } YYDPRINTF ((stderr, "Entering state %d\n", yystate)); if (yystate == YYFINAL) YYACCEPT; goto yybackup; /*-----------. | yybackup. | `-----------*/ yybackup: /* Do appropriate processing given the current state. Read a lookahead token if we need one and don't already have one. */ /* First try to decide what to do without reference to lookahead token. */ yyn = yypact[yystate]; if (yypact_value_is_default (yyn)) goto yydefault; /* Not known => get a lookahead token if don't already have one. */ /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */ if (yychar == YYEMPTY) { YYDPRINTF ((stderr, "Reading a token: ")); yychar = yylex (); } if (yychar <= YYEOF) { yychar = yytoken = YYEOF; YYDPRINTF ((stderr, "Now at end of input.\n")); } else { yytoken = YYTRANSLATE (yychar); YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc); } /* If the proper action on seeing token YYTOKEN is to reduce or to detect an error, take that action. */ yyn += yytoken; if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken) goto yydefault; yyn = yytable[yyn]; if (yyn <= 0) { if (yytable_value_is_error (yyn)) goto yyerrlab; yyn = -yyn; goto yyreduce; } /* Count tokens shifted since error; after three, turn off error status. */ if (yyerrstatus) yyerrstatus--; /* Shift the lookahead token. */ YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); /* Discard the shifted token. */ yychar = YYEMPTY; yystate = yyn; YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN *++yyvsp = yylval; YY_IGNORE_MAYBE_UNINITIALIZED_END goto yynewstate; /*-----------------------------------------------------------. | yydefault -- do the default action for the current state. | `-----------------------------------------------------------*/ yydefault: yyn = yydefact[yystate]; if (yyn == 0) goto yyerrlab; goto yyreduce; /*-----------------------------. | yyreduce -- Do a reduction. | `-----------------------------*/ yyreduce: /* yyn is the number of a rule to reduce with. */ yylen = yyr2[yyn]; /* If YYLEN is nonzero, implement the default value of the action: '$$ = $1'. Otherwise, the following line sets YYVAL to garbage. This behavior is undocumented and Bison users should not rely upon it. Assigning to YYVAL unconditionally makes the parser a bit smaller, and it avoids a GCC warning that YYVAL may be used uninitialized. */ yyval = yyvsp[1-yylen]; YY_REDUCE_PRINT (yyn); switch (yyn) { case 2: #line 332 "ProParser.y" /* yacc.c:1646 */ { Alloc_ParserVariables(); } #line 5937 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 5: #line 346 "ProParser.y" /* yacc.c:1646 */ { Formulation_S.DefineQuantity = NULL; } #line 5943 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 19: #line 369 "ProParser.y" /* yacc.c:1646 */ { strcpy(getdp_yyincludename, (yyvsp[0].c)); getdp_yyincludenum++; return(0); } #line 5951 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 22: #line 390 "ProParser.y" /* yacc.c:1646 */ { Add_Group(&Group_S, (yyvsp[-3].c), false, 0, 0); } #line 5957 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 23: #line 393 "ProParser.y" /* yacc.c:1646 */ { Add_Group(&Group_S, (yyvsp[-4].c), true, 0, 0); } #line 5963 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 24: #line 396 "ProParser.y" /* yacc.c:1646 */ { int j = 0; if(List_Nbr((yyvsp[0].l)) == 1) List_Read((yyvsp[0].l), 0, &j); else vyyerror("Single region number expected for moving band definition"); Group_S.InitialList = List_Create(1, 1, sizeof(int)); List_Add(Group_S.InitialList, &j); Group_S.Type = MOVINGBAND2D; Group_S.FunctionType = REGION; Group_S.InitialSuppList = NULL; Group_S.SuppListType = SUPPLIST_NONE; Group_S.MovingBand2D = (struct MovingBand2D *)Malloc(sizeof(struct MovingBand2D)); Group_S.MovingBand2D->PhysNum = j; } #line 5983 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 25: #line 412 "ProParser.y" /* yacc.c:1646 */ { Group_S.MovingBand2D->InitialList1 = (yyvsp[0].l); Group_S.MovingBand2D->ExtendedList1 = NULL; } #line 5992 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 26: #line 417 "ProParser.y" /* yacc.c:1646 */ { Group_S.MovingBand2D->InitialList2 = (yyvsp[-4].l); Group_S.MovingBand2D->Period2 = (int)(yyvsp[-2].d); Add_Group(&Group_S, (yyvsp[-14].c), false, 0, 0); } #line 6002 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 29: #line 431 "ProParser.y" /* yacc.c:1646 */ { Group_S.FunctionType = (yyvsp[-2].i); switch (Group_S.FunctionType) { case ELEMENTSOF : Group_S.Type = ELEMENTLIST; break; default : Group_S.Type = REGIONLIST; break; } Group_S.InitialList = (yyvsp[0].l); } #line 6015 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 30: #line 440 "ProParser.y" /* yacc.c:1646 */ { Group_S.SuppListType = Type_SuppList; Group_S.InitialSuppList = (yyvsp[-1].l); (yyval.i) = -1; } #line 6025 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 31: #line 448 "ProParser.y" /* yacc.c:1646 */ { Group_S.FunctionType = REGION; Group_S.Type = REGIONLIST; Group_S.InitialList = (yyvsp[0].l); Group_S.SuppListType = SUPPLIST_NONE; Group_S.InitialSuppList = NULL; (yyval.i) = -1; } #line 6036 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 32: #line 459 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = (yyvsp[0].i); } #line 6044 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 33: #line 464 "ProParser.y" /* yacc.c:1646 */ { int i; if(!strcmp((yyvsp[0].c), "All")) { (yyval.i) = -3; } else if((i = List_ISearchSeq(Problem_S.Group, (yyvsp[0].c), fcmp_Group_Name)) >= 0) { List_Read(Problem_S.Group, i, &Group_S); (yyval.i) = i; } else { (yyval.i) = -2; vyyerror("Unknown Group: %s", (yyvsp[0].c)); } Free((yyvsp[0].c)); } #line 6062 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 34: #line 482 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = REGION; } #line 6068 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 35: #line 485 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = Get_DefineForString(FunctionForGroup_Type, (yyvsp[0].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[0].c), FunctionForGroup_Type); vyyerror("Unknown type of Function for Group: %s", (yyvsp[0].c)); } Free((yyvsp[0].c)); } #line 6080 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 36: #line 497 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[0].l); } #line 6086 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 37: #line 498 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = NULL; } #line 6092 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 38: #line 505 "ProParser.y" /* yacc.c:1646 */ { Type_SuppList = SUPPLIST_NONE; (yyval.l) = NULL; } #line 6098 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 39: #line 508 "ProParser.y" /* yacc.c:1646 */ { Type_SuppList = (yyvsp[-1].i); (yyval.l) = (yyvsp[0].l); } #line 6104 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 40: #line 511 "ProParser.y" /* yacc.c:1646 */ { int i; Type_SuppList = SUPPLIST_INSUPPORT; if((i = List_ISearchSeq(Problem_S.Group, (yyvsp[0].c), fcmp_Group_Name)) >= 0) { if(((struct Group *)List_Pointer(Problem_S.Group, i))->Type == ELEMENTLIST) { (yyval.l) = List_Create(1, 5, sizeof(int)); List_Add((yyval.l), &i); } else vyyerror("Not a Support of Element Type: %s", (yyvsp[0].c)); } else vyyerror("Unknown Region for Support: %s", (yyvsp[0].c)); Free((yyvsp[0].c)); } #line 6123 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 41: #line 530 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = Get_DefineForString(FunctionForGroup_SuppList, (yyvsp[0].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[0].c), FunctionForGroup_SuppList); vyyerror("Unknown type of Supplementary Region: %s", (yyvsp[0].c)); } Free((yyvsp[0].c)); } #line 6135 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 42: #line 542 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(((List_Nbr((yyvsp[0].l)) > 0)? List_Nbr((yyvsp[0].l)) : 1), 5, sizeof(int)); for(int i = 0; i < List_Nbr((yyvsp[0].l)); i++) List_Add((yyval.l), (int *)List_Pointer((yyvsp[0].l), i)); } #line 6145 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 43: #line 549 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-1].l); } #line 6151 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 44: #line 555 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(5, 5, sizeof(int)); } #line 6159 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 45: #line 560 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-2].l); for(int i = 0; i < List_Nbr((yyvsp[0].l)); i++) List_Add((yyval.l), (int *)List_Pointer((yyvsp[0].l), i)); } #line 6169 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 46: #line 567 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-3].l); for(int i = 0; i < List_Nbr((yyvsp[0].l)); i++) List_Suppress((yyval.l), (int *)List_Pointer((yyvsp[0].l), i), fcmp_Integer); } #line 6179 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 47: #line 578 "ProParser.y" /* yacc.c:1646 */ { List_Reset(ListOfInt_L); List_Add((yyval.l) = ListOfInt_L, &((yyvsp[0].i))); } #line 6187 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 48: #line 583 "ProParser.y" /* yacc.c:1646 */ { List_Reset((yyval.l) = ListOfInt_L); for(int j = (yyvsp[-2].i); ((yyvsp[-2].i) < (yyvsp[0].i)) ? (j <= (yyvsp[0].i)) : (j >= (yyvsp[0].i)); ((yyvsp[-2].i) < (yyvsp[0].i)) ? (j += 1) : (j -= 1)) List_Add(ListOfInt_L, &j); } #line 6198 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 49: #line 591 "ProParser.y" /* yacc.c:1646 */ { List_Reset((yyval.l) = ListOfInt_L); if(!(yyvsp[0].i) || ((yyvsp[-4].i) < (yyvsp[-2].i) && (yyvsp[0].i) < 0) || ((yyvsp[-4].i) > (yyvsp[-2].i) && (yyvsp[0].i) > 0)){ vyyerror("Wrong increment in '%d : %d : %d'", (yyvsp[-4].i), (yyvsp[-2].i), (yyvsp[0].i)); List_Add(ListOfInt_L, &((yyvsp[-4].i))); } else for(int j = (yyvsp[-4].i); ((yyvsp[0].i) > 0) ? (j <= (yyvsp[-2].i)) : (j >= (yyvsp[-2].i)); j += (yyvsp[0].i)) List_Add((yyval.l), &j); } #line 6213 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 50: #line 603 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Problem_S.Group, (yyvsp[0].c), fcmp_Group_Name)) < 0) { // Si ce n'est pas un nom de groupe, est-ce un nom de constante ? : Constant_S.Name = (yyvsp[0].c); if(!Tree_Query(ConstantTable_L, &Constant_S)) { vyyerror("Unknown Constant: %s", (yyvsp[0].c)); i = 0; List_Reset(ListOfInt_L); List_Add((yyval.l) = ListOfInt_L, &i); } else if(Constant_S.Type == VAR_FLOAT) { i = (int)Constant_S.Value.Float; List_Reset(ListOfInt_L); List_Add((yyval.l) = ListOfInt_L, &i); } else if(Constant_S.Type == VAR_LISTOFFLOAT) { List_Reset((yyval.l) = ListOfInt_L); for(int i = 0; i < List_Nbr(Constant_S.Value.ListOfFloat); i++) { double d; List_Read(Constant_S.Value.ListOfFloat, i, &d); int j = (int)d; List_Add(ListOfInt_L, &j); } } else { vyyerror("Unknown type of Constant: %s", (yyvsp[0].c)); i = 0; List_Reset(ListOfInt_L); List_Add((yyval.l) = ListOfInt_L, &i); } } else // Si c'est un nom de groupe : (yyval.l) = ((struct Group *)List_Pointer(Problem_S.Group, i))->InitialList; Free((yyvsp[0].c)); } #line 6252 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 51: #line 640 "ProParser.y" /* yacc.c:1646 */ { int i = (int)(yyvsp[-1].d); List_Reset(ListOfInt_L); List_Add((yyval.l) = ListOfInt_L, &i); } #line 6261 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 52: #line 647 "ProParser.y" /* yacc.c:1646 */ { List_Reset(ListOfInt_L); for(int i = 0; i < List_Nbr((yyvsp[-1].l)); i++) { double d; List_Read((yyvsp[-1].l), i, &d); int j = (int)d; List_Add(ListOfInt_L, &j); } (yyval.l) = ListOfInt_L; } #line 6277 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 53: #line 661 "ProParser.y" /* yacc.c:1646 */ { List_Reset(ListOfInt_L); for(int i = 0; i < List_Nbr((yyvsp[-1].l)); i++) { double d; List_Read((yyvsp[-1].l), i, &d); int j = (int)d; List_Add(ListOfInt_L, &j); } (yyval.l) = ListOfInt_L; } #line 6293 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 55: #line 680 "ProParser.y" /* yacc.c:1646 */ { CharOptions_S["Strings"].push_back((yyvsp[0].c)); Free((yyvsp[0].c)); } #line 6302 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 56: #line 686 "ProParser.y" /* yacc.c:1646 */ { char tmp[128]; sprintf(tmp, "%d", (yyvsp[0].i)); CharOptions_S["Strings"].push_back(tmp); } #line 6312 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 57: #line 693 "ProParser.y" /* yacc.c:1646 */ { CharOptions_S["Strings"].push_back((yyvsp[0].c)); Free((yyvsp[0].c)); } #line 6321 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 58: #line 699 "ProParser.y" /* yacc.c:1646 */ { char tmp[128]; sprintf(tmp, "%d", (yyvsp[0].i)); CharOptions_S["Strings"].push_back(tmp); } #line 6331 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 60: #line 711 "ProParser.y" /* yacc.c:1646 */ { int i; if ( (i = List_ISearchSeq(Problem_S.Group, (yyvsp[0].c), fcmp_Group_Name)) < 0 ) { Group_S.Type = REGIONLIST ; Group_S.FunctionType = REGION ; Group_S.InitialList = List_Create( 5, 5, sizeof(int)) ; Group_S.SuppListType = SUPPLIST_NONE ; Group_S.InitialSuppList = NULL ; i = Add_Group(&Group_S, (yyvsp[0].c), false, 0, 0) ; } else Free((yyvsp[0].c)) ; } #line 6346 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 61: #line 723 "ProParser.y" /* yacc.c:1646 */ { FloatOptions_S.clear(); CharOptions_S.clear(); } #line 6352 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 62: #line 725 "ProParser.y" /* yacc.c:1646 */ { int i; if ( (i = List_ISearchSeq(Problem_S.Group, (yyvsp[-8].c), fcmp_Group_Name)) < 0 ) { Group_S.Name = (yyvsp[-8].c); // will be overwritten in Add_Group Group_S.Type = REGIONLIST ; Group_S.FunctionType = REGION ; Group_S.InitialList = List_Create( 5, 5, sizeof(int)) ; if(CharOptions_S.count("Strings")){ std::vector vec(CharOptions_S["Strings"]); for(unsigned int i = 0; i < vec.size(); i++) Fill_GroupInitialListFromString(Group_S.InitialList, vec[i].c_str()); } Message::ExchangeOnelabParameter(&Group_S, FloatOptions_S, CharOptions_S); Group_S.SuppListType = SUPPLIST_NONE ; Group_S.InitialSuppList = NULL ; i = Add_Group(&Group_S, (yyvsp[-8].c), false, 0, 0) ; } else Free((yyvsp[-8].c)) ; } #line 6374 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 63: #line 744 "ProParser.y" /* yacc.c:1646 */ { for (int k = 0 ; k < (int)(yyvsp[-1].d) ; k++) { char tmpstr[256]; sprintf(tmpstr, "%s_%d", (yyvsp[-3].c), k+1) ; int i; if ( (i = List_ISearchSeq(Problem_S.Group, tmpstr, fcmp_Group_Name)) < 0 ) { Group_S.Type = REGIONLIST ; Group_S.FunctionType = REGION ; Group_S.SuppListType = SUPPLIST_NONE ; Group_S.InitialSuppList = NULL ; Group_S.InitialList = List_Create( 5, 5, sizeof(int)) ; Add_Group(&Group_S, (yyvsp[-3].c), false, 2, k+1) ; } } Free((yyvsp[-3].c)) ; } #line 6394 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 69: #line 780 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq (Problem_S.Expression, (yyvsp[-5].c), fcmp_Expression_Name)) >= 0) { if(((struct Expression *)List_Pointer(Problem_S.Expression, i))->Type == UNDEFINED_EXP) { Free(((struct Expression *)List_Pointer(Problem_S.Expression, i))->Name); List_Read (Problem_S.Expression, (yyvsp[-1].i), &Expression_S); List_Write(Problem_S.Expression, i, &Expression_S); ((struct Expression *)List_Pointer(Problem_S.Expression, i))->Name = (yyvsp[-5].c); List_Pop(Problem_S.Expression); } else { vyyerror("Redefinition of Function: %s", (yyvsp[-5].c)); } } else { /* new identifier */ Free(((struct Expression *)List_Pointer(Problem_S.Expression, (yyvsp[-1].i)))->Name); ((struct Expression *)List_Pointer(Problem_S.Expression, (yyvsp[-1].i)))->Name = (yyvsp[-5].c); } } #line 6418 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 70: #line 801 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq (Problem_S.Expression, (yyvsp[-6].c), fcmp_Expression_Name)) < 0) { /* Si le nom n'existe pas : */ i = List_Nbr(Problem_S.Expression); Expression_S.Type = PIECEWISEFUNCTION; Expression_S.Case.PieceWiseFunction.ExpressionPerRegion = List_Create(5, 5, sizeof(struct ExpressionPerRegion)); Expression_S.Case.PieceWiseFunction.NumLastRegion = -1; Add_Expression(&Expression_S, (yyvsp[-6].c), 0); Expression_P = (struct Expression*)List_Pointer(Problem_S.Expression, i); } else { Expression_P = (struct Expression*)List_Pointer(Problem_S.Expression, i); if(Expression_P->Type == UNDEFINED_EXP) { Expression_P->Type = PIECEWISEFUNCTION; Expression_P->Case.PieceWiseFunction.ExpressionPerRegion = List_Create(5, 5, sizeof(struct ExpressionPerRegion)); Expression_P->Case.PieceWiseFunction.NumLastRegion = -1; } else if(Expression_P->Type != PIECEWISEFUNCTION) vyyerror("Not piece-wise Expression: %s", (yyvsp[-6].c)); Free((yyvsp[-6].c)); } if((yyvsp[-4].i) >= 0 || (yyvsp[-4].i) == -1) { ExpressionPerRegion_S.ExpressionIndex = (yyvsp[-1].i); for(int i = 0; i < List_Nbr(Group_S.InitialList); i++) { List_Read(Group_S.InitialList, i, &ExpressionPerRegion_S.RegionIndex); if(List_Search(Expression_P->Case.PieceWiseFunction.ExpressionPerRegion, &ExpressionPerRegion_S.RegionIndex, fcmp_Integer)) vyyerror("Redefinition of piece-wise Function: %s [%d]", Expression_P->Name, ExpressionPerRegion_S.RegionIndex); else List_Add(Expression_P->Case.PieceWiseFunction.ExpressionPerRegion, &ExpressionPerRegion_S); } if((yyvsp[-4].i) == -1) { List_Delete(Group_S.InitialList); } } else vyyerror("Bad Group right hand side"); } #line 6466 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 73: #line 853 "ProParser.y" /* yacc.c:1646 */ { int i; if ( (i = List_ISearchSeq (Problem_S.Expression, (yyvsp[0].c), fcmp_Expression_Name)) < 0 ) { Expression_S.Type = UNDEFINED_EXP ; Add_Expression(&Expression_S, (yyvsp[0].c), 0) ; } else Free((yyvsp[0].c)) ; } #line 6480 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 74: #line 864 "ProParser.y" /* yacc.c:1646 */ { for (int k = 0 ; k < (int)(yyvsp[-1].d) ; k++) { char tmpstr[256]; sprintf(tmpstr, "%s_%d", (yyvsp[-3].c), k+1) ; int i; if ( (i = List_ISearchSeq(Problem_S.Expression, tmpstr, fcmp_Expression_Name)) < 0 ) { Expression_S.Type = UNDEFINED_EXP ; Add_Expression(&Expression_S, tmpstr, 2) ; } } Free((yyvsp[-3].c)) ; } #line 6498 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 75: #line 888 "ProParser.y" /* yacc.c:1646 */ { Expression_S.Type = CONSTANT; Expression_S.Case.Constant = (yyvsp[-1].d); (yyval.i) = Add_Expression(&Expression_S, (char*)"Exp_Cst", 1); } #line 6506 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 76: #line 894 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Problem_S.Expression, (yyvsp[-1].c), fcmp_Expression_Name)) < 0) vyyerror("Unknown name of Expression: %s", (yyvsp[-1].c)); Free((yyvsp[-1].c)); (yyval.i) = i; } #line 6516 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 77: #line 901 "ProParser.y" /* yacc.c:1646 */ { Current_DofIndexInWholeQuantity = -2; List_Reset(ListOfPointer_L); List_Reset(ListOfPointer2_L); } #line 6523 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 78: #line 904 "ProParser.y" /* yacc.c:1646 */ { Expression_S.Type = WHOLEQUANTITY; Expression_S.Case.WholeQuantity = (yyvsp[0].l); (yyval.i) = Add_Expression(&Expression_S, (char*)"Exp_Fct", 1); } #line 6530 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 79: #line 909 "ProParser.y" /* yacc.c:1646 */ { Expression_S.Type = UNDEFINED_EXP; (yyval.i) = Add_Expression(&Expression_S, (char*)"Exp_Undefined", 1); } #line 6538 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 80: #line 916 "ProParser.y" /* yacc.c:1646 */ { List_Reset(ListOfInt_L); } #line 6544 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 82: #line 927 "ProParser.y" /* yacc.c:1646 */ { List_Reset(ListOfInt_L); List_Add(ListOfInt_L, &((yyvsp[0].i))); } #line 6550 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 83: #line 930 "ProParser.y" /* yacc.c:1646 */ { List_Add(ListOfInt_L, &((yyvsp[0].i))); } #line 6556 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 84: #line 936 "ProParser.y" /* yacc.c:1646 */ { Current_WholeQuantity_L = List_Create(5, 5, sizeof(struct WholeQuantity)); List_Add(ListOfPointer_L, &Current_WholeQuantity_L); } #line 6564 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 85: #line 940 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = *((List_T **)List_Pointer(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1)); List_Pop(ListOfPointer_L); } #line 6572 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 87: #line 952 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_TEST; List_Add(Current_WholeQuantity_L, &WholeQuantity_S); WholeQuantity_P = (struct WholeQuantity*) List_Pointer(Current_WholeQuantity_L, List_Nbr(Current_WholeQuantity_L)-1); List_Add(ListOfPointer2_L, &WholeQuantity_P); List_Add(ListOfPointer2_L, &WholeQuantity_P); Current_WholeQuantity_L = List_Create(5, 5, sizeof(struct WholeQuantity)); List_Add(ListOfPointer_L, &Current_WholeQuantity_L); } #line 6589 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 88: #line 965 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_P = *((struct WholeQuantity**) List_Pointer(ListOfPointer2_L, List_Nbr(ListOfPointer2_L)-1)); List_Pop(ListOfPointer2_L); WholeQuantity_P->Case.Test.WholeQuantity_True = *((List_T **)List_Pointer(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1)); List_Pop(ListOfPointer_L); Current_WholeQuantity_L = List_Create(5, 5, sizeof(struct WholeQuantity)); List_Add(ListOfPointer_L, &Current_WholeQuantity_L); } #line 6607 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 89: #line 979 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_P = *((struct WholeQuantity**) List_Pointer(ListOfPointer2_L, List_Nbr(ListOfPointer2_L)-1)); List_Pop(ListOfPointer2_L); WholeQuantity_P->Case.Test.WholeQuantity_False = *((List_T **)List_Pointer(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1)); List_Pop(ListOfPointer_L); List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L); } #line 6625 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 90: #line 994 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_TIME; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_ProductValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6637 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 91: #line 1002 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_CROSSPRODUCT; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_CrossProductValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6649 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 92: #line 1010 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_CROSSPRODUCT; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_CrossProductValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6661 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 93: #line 1018 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_DIVIDE; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_DivideValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6673 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 94: #line 1026 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_PLUS; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_AddValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6685 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 95: #line 1034 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_MINUS; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_SubstractValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6697 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 96: #line 1042 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_MODULO; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_ModuloValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6709 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 97: #line 1050 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_POWER; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_PowerValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6721 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 98: #line 1058 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_LESS; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_LessValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6733 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 99: #line 1066 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_GREATER; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_GreaterValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6745 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 100: #line 1074 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_LESSOREQUAL; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_LessOrEqualValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6757 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 101: #line 1082 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_GREATEROREQUAL; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_GreaterOrEqualValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6769 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 102: #line 1090 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_EQUAL; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_EqualValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6781 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 103: #line 1099 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_NOTEQUAL; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_NotEqualValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6793 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 104: #line 1107 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_APPROXEQUAL; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_ApproxEqualValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6805 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 105: #line 1115 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_AND; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_AndValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6817 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 106: #line 1123 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_OR; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_OrValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6829 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 107: #line 1132 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_SAVENAMEDVALUE; WholeQuantity_S.Case.NamedValue.Name = (yyvsp[-2].c); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6839 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 108: #line 1139 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_UNARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_NEG; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_NegValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6850 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 110: #line 1149 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_UNARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_NOT; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_NotValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6861 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 111: #line 1157 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_CHANGECURRENTPOSITION ; List_Add(Current_WholeQuantity_L, &WholeQuantity_S) ; WholeQuantity_P = (struct WholeQuantity*) List_Pointer(Current_WholeQuantity_L, List_Nbr(Current_WholeQuantity_L)-1); List_Add(ListOfPointer2_L, &WholeQuantity_P); Current_WholeQuantity_L = List_Create( 5, 5, sizeof(struct WholeQuantity)) ; List_Add(ListOfPointer_L, &Current_WholeQuantity_L) ; } #line 6877 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 112: #line 1169 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_P = *((struct WholeQuantity**) List_Pointer(ListOfPointer2_L, List_Nbr(ListOfPointer2_L)-1)) ; List_Pop(ListOfPointer2_L) ; WholeQuantity_P->Case.ChangeCurrentPosition.WholeQuantity = *((List_T **)List_Pointer(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1)) ; List_Pop(ListOfPointer_L) ; List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L) ; } #line 6895 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 114: #line 1190 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_CONSTANT; WholeQuantity_S.Case.Constant = (yyvsp[0].d); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 6904 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 115: #line 1196 "ProParser.y" /* yacc.c:1646 */ { /* Expression */ int l; if((l = List_ISearchSeq(Problem_S.Expression, (yyvsp[-2].c), fcmp_Expression_Name)) >= 0) { WholeQuantity_S.Type = WQ_EXPRESSION; WholeQuantity_S.Case.Expression.Index = l; WholeQuantity_S.Case.Expression.NbrArguments = (yyvsp[-1].i); if((yyvsp[-1].i) < 0) vyyerror("Uncompatible argument for Function: %s", (yyvsp[-2].c)); } /* Built in functions */ else { Get_Function2NbrForString(F_Function, (yyvsp[-2].c), &FlagError, &WholeQuantity_S.Case.Function.Fct, &WholeQuantity_S.Case.Function.NbrParameters, &WholeQuantity_S.Case.Function.NbrArguments); WholeQuantity_S.Case.Function.Active = NULL; if(!FlagError) { /* arguments */ if((yyvsp[-1].i) >= 0) { if((yyvsp[-1].i) == WholeQuantity_S.Case.Function.NbrArguments) { WholeQuantity_S.Type = WQ_BUILTINFUNCTION; } else if(WholeQuantity_S.Case.Function.NbrArguments == -1 || (WholeQuantity_S.Case.Function.NbrArguments == -2)) { /* && ($2)%2 == 0)) { */ WholeQuantity_S.Type = WQ_BUILTINFUNCTION; WholeQuantity_S.Case.Function.NbrArguments = (yyvsp[-1].i); } else { vyyerror("Wrong number of arguments for Function '%s' (%d instead of %d)", (yyvsp[-2].c), (yyvsp[-1].i), WholeQuantity_S.Case.Function.NbrArguments); } } else { WholeQuantity_S.Type = WQ_EXTERNBUILTINFUNCTION; } /* parameters */ WholeQuantity_S.Case.Function.Para = 0; WholeQuantity_S.Case.Function.String = StringForParameter; if(WholeQuantity_S.Case.Function.NbrParameters >= 0 && WholeQuantity_S.Case.Function.NbrParameters != List_Nbr((yyvsp[0].l))) { vyyerror("Wrong number of parameters for Function '%s' (%d instead of %d)", (yyvsp[-2].c), List_Nbr((yyvsp[0].l)), WholeQuantity_S.Case.Function.NbrParameters); } else if(WholeQuantity_S.Case.Function.NbrParameters == -2 && List_Nbr((yyvsp[0].l))%2 != 0) { vyyerror("Wrong number of parameters for Function '%s' (%d is not even)", (yyvsp[-2].c), List_Nbr((yyvsp[0].l))); } else { WholeQuantity_S.Case.Function.NbrParameters = List_Nbr((yyvsp[0].l)); if(WholeQuantity_S.Case.Function.NbrParameters > 0) { WholeQuantity_S.Case.Function.Para = (double *)Malloc (WholeQuantity_S.Case.Function.NbrParameters * sizeof(double)); for(int i = 0; i < WholeQuantity_S.Case.Function.NbrParameters; i++) List_Read((yyvsp[0].l), i, &WholeQuantity_S.Case.Function.Para[i]); } } } else { vyyerror("Unknown Function: %s", (yyvsp[-2].c)); } } List_Add(Current_WholeQuantity_L, &WholeQuantity_S); List_Delete((yyvsp[0].l)); StringForParameter = 0; } #line 6984 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 116: #line 1273 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_OPERATORANDQUANTITY; WholeQuantity_S.Case.OperatorAndQuantity.NbrArguments = 0; WholeQuantity_S.Case.OperatorAndQuantity.TypeQuantity = Get_DefineForString(QuantityFromFS_Type, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), QuantityFromFS_Type); vyyerror("Unknown type of discrete Quantity: %s", (yyvsp[-1].c)); } Free((yyvsp[-1].c)); WholeQuantity_S.Case.OperatorAndQuantity.TypeOperator = (yyvsp[0].t).Int1; WholeQuantity_S.Case.OperatorAndQuantity.Index = (yyvsp[0].t).Int2; switch(WholeQuantity_S.Case.OperatorAndQuantity.TypeQuantity) { case QUANTITY_DOF : if(Current_DofIndexInWholeQuantity == -1) Current_DofIndexInWholeQuantity = List_Nbr(Current_WholeQuantity_L); else if(Current_DofIndexInWholeQuantity == -2) vyyerror("Dof{} definition out of context"); else vyyerror("More than one Dof definition in Expression"); break; case QUANTITY_NODOF : if(Current_DofIndexInWholeQuantity == -2) vyyerror("NoDof definition out of context"); else if(Current_NoDofIndexInWholeQuantity == -1) Current_NoDofIndexInWholeQuantity = List_Nbr(Current_WholeQuantity_L); else vyyerror("More than one NoDof definition in Expression"); break; } List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 7021 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 117: #line 1307 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_OPERATORANDQUANTITY; WholeQuantity_S.Case.OperatorAndQuantity.NbrArguments = 0; WholeQuantity_S.Case.OperatorAndQuantity.TypeQuantity = QUANTITY_SIMPLE; WholeQuantity_S.Case.OperatorAndQuantity.TypeOperator = (yyvsp[0].t).Int1; WholeQuantity_S.Case.OperatorAndQuantity.Index = (yyvsp[0].t).Int2; List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 7033 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 118: #line 1316 "ProParser.y" /* yacc.c:1646 */ { if((yyvsp[0].i) != 1 && (yyvsp[0].i) != 2 && (yyvsp[0].i) != 3 && (yyvsp[0].i) != 4) vyyerror("Wrong number of arguments for discrete quantity evaluation (%d)", (yyvsp[0].i)); WholeQuantity_S.Type = WQ_OPERATORANDQUANTITYEVAL; WholeQuantity_S.Case.OperatorAndQuantity.NbrArguments = (yyvsp[0].i); WholeQuantity_S.Case.OperatorAndQuantity.TypeQuantity = QUANTITY_SIMPLE; WholeQuantity_S.Case.OperatorAndQuantity.TypeOperator = (yyvsp[-1].t).Int1; WholeQuantity_S.Case.OperatorAndQuantity.Index = (yyvsp[-1].t).Int2; List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 7048 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 119: #line 1328 "ProParser.y" /* yacc.c:1646 */ { Last_DofIndexInWholeQuantity = Current_DofIndexInWholeQuantity; } #line 7054 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 120: #line 1330 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_TIMEDERIVATIVE; WholeQuantity_S.Case.TimeDerivative.WholeQuantity = (yyvsp[-1].l); List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); if(Current_DofIndexInWholeQuantity != Last_DofIndexInWholeQuantity) vyyerror("Dof{} definition out of context"); } #line 7068 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 121: #line 1341 "ProParser.y" /* yacc.c:1646 */ { Last_DofIndexInWholeQuantity = Current_DofIndexInWholeQuantity; } #line 7074 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 122: #line 1343 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_ATANTERIORTIMESTEP; WholeQuantity_S.Case.AtAnteriorTimeStep.WholeQuantity = (yyvsp[-3].l); WholeQuantity_S.Case.AtAnteriorTimeStep.TimeStep = (yyvsp[-1].i); List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); if(Current_DofIndexInWholeQuantity != Last_DofIndexInWholeQuantity) vyyerror("Dof{} definition out of context"); } #line 7089 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 123: #line 1355 "ProParser.y" /* yacc.c:1646 */ { Last_DofIndexInWholeQuantity = Current_DofIndexInWholeQuantity; } #line 7095 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 124: #line 1357 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_MAXOVERTIME; WholeQuantity_S.Case.MaxOverTime.WholeQuantity = (yyvsp[-5].l); WholeQuantity_S.Case.FourierSteinmetz.TimeInit = (yyvsp[-3].d); WholeQuantity_S.Case.FourierSteinmetz.TimeFinal = (yyvsp[-1].d); List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); if(Current_DofIndexInWholeQuantity != Last_DofIndexInWholeQuantity) vyyerror("Dof{} definition out of context"); } #line 7112 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 125: #line 1371 "ProParser.y" /* yacc.c:1646 */ { Last_DofIndexInWholeQuantity = Current_DofIndexInWholeQuantity; } #line 7118 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 126: #line 1373 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_FOURIERSTEINMETZ; WholeQuantity_S.Case.FourierSteinmetz.WholeQuantity = (yyvsp[-11].l); WholeQuantity_S.Case.FourierSteinmetz.TimeInit = (yyvsp[-9].d); WholeQuantity_S.Case.FourierSteinmetz.TimeFinal = (yyvsp[-7].d); WholeQuantity_S.Case.FourierSteinmetz.NbrFrequency = (int)(yyvsp[-5].d); WholeQuantity_S.Case.FourierSteinmetz.Exponent_f = (yyvsp[-3].d); WholeQuantity_S.Case.FourierSteinmetz.Exponent_b = (yyvsp[-1].d); List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); if(Current_DofIndexInWholeQuantity != Last_DofIndexInWholeQuantity) vyyerror("Dof{} definition out of context"); } #line 7138 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 127: #line 1391 "ProParser.y" /* yacc.c:1646 */ { Last_DofIndexInWholeQuantity = Current_DofIndexInWholeQuantity; } #line 7144 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 128: #line 1393 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Problem_S.Expression, (yyvsp[-8].c), fcmp_Expression_Name)) < 0) vyyerror("Undefined function '%s' used in MHTransform", (yyvsp[-8].c)); if(Current_DofIndexInWholeQuantity != Last_DofIndexInWholeQuantity) vyyerror("Dof{} definition cannot be used in MHTransform"); WholeQuantity_S.Type = WQ_MHTRANSFORM; WholeQuantity_S.Case.MHTransform.Index = i; WholeQuantity_S.Case.MHTransform.WholeQuantity = (yyvsp[-5].l); WholeQuantity_S.Case.MHTransform.NbrPoints = (int)(yyvsp[-1].d); List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 7162 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 129: #line 1409 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Problem_S.Expression, (yyvsp[-7].c),fcmp_Expression_Name)) < 0) vyyerror("Undefined function '%s' used in MHJacNL", (yyvsp[-7].c)); WholeQuantity_S.Type = WQ_MHJACNL; WholeQuantity_S.Case.MHJacNL.Index = i; WholeQuantity_S.Case.MHJacNL.NbrArguments = (yyvsp[-6].i); if((yyvsp[-6].i) != 1) vyyerror("Uncompatible argument %d for Function: %s", (yyvsp[-6].i), (yyvsp[-7].c)); WholeQuantity_S.Case.MHJacNL.NbrPoints = (int)(yyvsp[-3].d); WholeQuantity_S.Case.MHJacNL.FreqOffSet = (int)(yyvsp[-1].d); List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 7180 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 130: #line 1424 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_SOLIDANGLE; WholeQuantity_S.Case.OperatorAndQuantity.Index = (yyvsp[-1].t).Int2; List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 7189 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 131: #line 1430 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_ORDER; WholeQuantity_S.Case.OperatorAndQuantity.Index = (yyvsp[-1].t).Int2; List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 7198 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 132: #line 1436 "ProParser.y" /* yacc.c:1646 */ { Last_DofIndexInWholeQuantity = Current_DofIndexInWholeQuantity; } #line 7204 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 133: #line 1438 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_TRACE; WholeQuantity_S.Case.Trace.WholeQuantity = (yyvsp[-3].l); WholeQuantity_S.Case.Trace.InIndex = Num_Group(&Group_S, (char*)"WQ_Trace_In", (yyvsp[-1].i)); if(Group_S.Type != ELEMENTLIST || Group_S.SuppListType != SUPPLIST_CONNECTEDTO) vyyerror("Group for Trace should be of Type 'ElementsOf[x, ConnectedTo y]'"); WholeQuantity_S.Case.Trace.DofIndexInWholeQuantity = -1; if(Current_DofIndexInWholeQuantity != Last_DofIndexInWholeQuantity){ for(int i = 0; i < List_Nbr((yyvsp[-3].l)); i++){ WholeQuantity_P = (struct WholeQuantity*)List_Pointer((yyvsp[-3].l), i); if(WholeQuantity_P->Type == WQ_OPERATORANDQUANTITY) if(WholeQuantity_P->Case.OperatorAndQuantity.TypeQuantity == QUANTITY_DOF){ WholeQuantity_S.Case.Trace.DofIndexInWholeQuantity = i; Current_DofIndexInWholeQuantity = -4; TypeOperatorDofInTrace = WholeQuantity_P->Case.OperatorAndQuantity.TypeOperator; DefineQuantityIndexDofInTrace = WholeQuantity_P->Case.OperatorAndQuantity.Index; } } if(Current_DofIndexInWholeQuantity != -4) vyyerror("Dof{} definition out of context in Trace operator"); } List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 7236 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 134: #line 1467 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_CAST; WholeQuantity_S.Case.Cast.WholeQuantity = (yyvsp[-1].l); int i; if((i = List_ISearchSeq(Formulation_S.DefineQuantity, (yyvsp[-4].c), fcmp_DefineQuantity_Name)) < 0) { if(!strcmp((yyvsp[-4].c), "Real")) WholeQuantity_S.Case.Cast.NbrHar = 1; else if(!strcmp((yyvsp[-4].c), "Complex")) WholeQuantity_S.Case.Cast.NbrHar = 2; else vyyerror("Unknown Cast: %s", (yyvsp[-4].c)); } else { WholeQuantity_S.Case.Cast.NbrHar = 0; WholeQuantity_S.Case.Cast.FunctionSpaceIndexForType = ((struct DefineQuantity *)List_Pointer(Formulation_S.DefineQuantity, i)) ->FunctionSpaceIndex; } Free((yyvsp[-4].c)); List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 7265 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 135: #line 1493 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_CURRENTVALUE; Get_PointerForString(Current_Value, (yyvsp[0].c), &FlagError, (void **)&WholeQuantity_S.Case.CurrentValue.Value); if(FlagError){ WholeQuantity_S.Type = WQ_NAMEDVALUESAVED; WholeQuantity_S.Case.NamedValue.Name = (yyvsp[0].c); } else{ Free((yyvsp[0].c)); } List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 7282 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 136: #line 1508 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_CURRENTVALUE; Get_PointerForString(Current_Value, "TimeStep", &FlagError, (void **)&WholeQuantity_S.Case.CurrentValue.Value); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 7292 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 137: #line 1514 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_CURRENTVALUE; Get_PointerForString(Current_Value, "DTime", &FlagError, (void **)&WholeQuantity_S.Case.CurrentValue.Value); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 7302 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 138: #line 1521 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_ARGUMENT; WholeQuantity_S.Case.Argument.Index = (yyvsp[0].i); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 7311 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 139: #line 1527 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_SAVEVALUE; WholeQuantity_S.Case.SaveValue.Index = (int)(yyvsp[0].d) - 1; List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 7321 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 140: #line 1534 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_VALUESAVED; WholeQuantity_S.Case.ValueSaved.Index = (int)(yyvsp[0].d) - 1; List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 7331 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 141: #line 1541 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_SHOWVALUE; WholeQuantity_S.Case.ShowValue.Index = (int)(yyvsp[0].d); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } #line 7341 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 142: #line 1548 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_CONSTANT ; WholeQuantity_S.Case.Constant = (yyvsp[0].i) ; List_Add(Current_WholeQuantity_L, &WholeQuantity_S) ; } #line 7350 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 143: #line 1554 "ProParser.y" /* yacc.c:1646 */ { WholeQuantity_S.Type = WQ_CONSTANT ; WholeQuantity_S.Case.Constant = (yyvsp[0].i) ; List_Add(Current_WholeQuantity_L, &WholeQuantity_S) ; } #line 7359 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 144: #line 1563 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = -1; } #line 7365 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 145: #line 1564 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = 0; } #line 7371 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 146: #line 1565 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = (yyvsp[-1].i); } #line 7377 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 147: #line 1570 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = 1; } #line 7383 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 148: #line 1571 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = (yyvsp[-2].i) + 1; } #line 7389 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 149: #line 1577 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = NULL; } #line 7395 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 150: #line 1580 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-1].l); } #line 7401 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 151: #line 1583 "ProParser.y" /* yacc.c:1646 */ { /* Attention: provisoire. Note: Impossible a mettre dans MultiFExpr car conflit avec Affectation dans Group */ (yyval.l) = List_Create(2, 1, sizeof(double)); double d = (double)Num_Group(&Group_S, (char*)"PA_Region", (yyvsp[-2].i)); List_Add((yyval.l), &d); } #line 7412 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 152: #line 1591 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = NULL; StringForParameter = (yyvsp[-1].c); } #line 7418 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 153: #line 1602 "ProParser.y" /* yacc.c:1646 */ { if(!Problem_S.JacobianMethod) Problem_S.JacobianMethod = List_Create(5, 5, sizeof (struct JacobianMethod)); } #line 7427 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 154: #line 1607 "ProParser.y" /* yacc.c:1646 */ { List_Add(Problem_S.JacobianMethod, &JacobianMethod_S); } #line 7433 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 155: #line 1614 "ProParser.y" /* yacc.c:1646 */ { JacobianMethod_S.Name = NULL; JacobianMethod_S.JacobianCase = NULL; } #line 7439 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 157: #line 1623 "ProParser.y" /* yacc.c:1646 */ { Check_NameOfStructNotExist("JacobianMethod", Problem_S.JacobianMethod, (yyvsp[-1].c), fcmp_JacobianMethod_Name); JacobianMethod_S.Name = (yyvsp[-1].c); } #line 7447 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 158: #line 1628 "ProParser.y" /* yacc.c:1646 */ { JacobianMethod_S.JacobianCase = (yyvsp[-1].l); } #line 7453 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 159: #line 1635 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(5, 5, sizeof (struct JacobianCase)); } #line 7459 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 160: #line 1638 "ProParser.y" /* yacc.c:1646 */ { List_Add((yyval.l) = (yyvsp[-3].l), &JacobianCase_S); } #line 7465 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 161: #line 1645 "ProParser.y" /* yacc.c:1646 */ { JacobianCase_S.RegionIndex = -1; JacobianCase_S.TypeJacobian = JACOBIAN_VOL; } #line 7472 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 163: #line 1655 "ProParser.y" /* yacc.c:1646 */ { JacobianCase_S.RegionIndex = Num_Group(&Group_S, (char*)"JA_Region", (yyvsp[-1].i)); } #line 7478 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 164: #line 1658 "ProParser.y" /* yacc.c:1646 */ { JacobianCase_S.RegionIndex = -1; } #line 7484 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 165: #line 1661 "ProParser.y" /* yacc.c:1646 */ { JacobianCase_S.TypeJacobian = Get_Define1NbrForString(Jacobian_Type, (yyvsp[-2].c), &FlagError, &JacobianCase_S.NbrParameters); if(!FlagError) { if(JacobianCase_S.NbrParameters == -2 && (List_Nbr((yyvsp[-1].l)))%2 != 0) vyyerror("Wrong number of parameters for Jacobian '%s' (%d is not even)", (yyvsp[-2].c), List_Nbr((yyvsp[-1].l))); if(JacobianCase_S.NbrParameters < 0) JacobianCase_S.NbrParameters = List_Nbr((yyvsp[-1].l)); if(List_Nbr((yyvsp[-1].l)) == JacobianCase_S.NbrParameters) { if(JacobianCase_S.NbrParameters) { JacobianCase_S.Para = (double *)Malloc(JacobianCase_S.NbrParameters * sizeof(double)); for(int i = 0; i < JacobianCase_S.NbrParameters; i++) List_Read((yyvsp[-1].l), i, &JacobianCase_S.Para[i]); } } else vyyerror("Wrong number of parameters for Jacobian '%s' (%d instead of %d)", (yyvsp[-2].c), List_Nbr((yyvsp[-1].l)), JacobianCase_S.NbrParameters); } else{ Get_Valid_SXD1N((yyvsp[-2].c), Jacobian_Type); vyyerror("Unknown type of Jacobian: %s", (yyvsp[-2].c)); } Free((yyvsp[-2].c)); List_Delete((yyvsp[-1].l)); } #line 7517 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 166: #line 1699 "ProParser.y" /* yacc.c:1646 */ { if(!Problem_S.IntegrationMethod) Problem_S.IntegrationMethod = List_Create(5, 5, sizeof(struct IntegrationMethod)); } #line 7526 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 167: #line 1705 "ProParser.y" /* yacc.c:1646 */ { List_Add(Problem_S.IntegrationMethod, &IntegrationMethod_S); } #line 7532 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 168: #line 1712 "ProParser.y" /* yacc.c:1646 */ { IntegrationMethod_S.Name = NULL; IntegrationMethod_S.IntegrationCase = NULL; IntegrationMethod_S.CriterionIndex = -1; } #line 7542 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 170: #line 1725 "ProParser.y" /* yacc.c:1646 */ { Check_NameOfStructNotExist("IntegrationMethod", Problem_S.IntegrationMethod, (yyvsp[-1].c), fcmp_IntegrationMethod_Name); IntegrationMethod_S.Name = (yyvsp[-1].c); } #line 7552 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 171: #line 1732 "ProParser.y" /* yacc.c:1646 */ { IntegrationMethod_S.CriterionIndex = (yyvsp[-1].i); } #line 7558 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 172: #line 1735 "ProParser.y" /* yacc.c:1646 */ { IntegrationMethod_S.IntegrationCase = (yyvsp[-1].l); } #line 7564 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 173: #line 1742 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(5, 5, sizeof (struct IntegrationCase)); } #line 7570 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 174: #line 1745 "ProParser.y" /* yacc.c:1646 */ { List_Add((yyval.l) = (yyvsp[-3].l), &IntegrationCase_S); } #line 7576 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 175: #line 1752 "ProParser.y" /* yacc.c:1646 */ { IntegrationCase_S.Type = GAUSS; IntegrationCase_S.SubType = STANDARD; } #line 7585 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 177: #line 1764 "ProParser.y" /* yacc.c:1646 */ { IntegrationCase_S.Type = Get_DefineForString(Integration_Type, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), Integration_Type); vyyerror("Unknown type of Integration method: %s", (yyvsp[-1].c)); } Free((yyvsp[-1].c)); } #line 7598 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 178: #line 1774 "ProParser.y" /* yacc.c:1646 */ { IntegrationCase_S.SubType = Get_DefineForString(Integration_SubType, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), Integration_Type); vyyerror("Unknown subtype of Integration method: %s", (yyvsp[-1].c)); } Free((yyvsp[-1].c)); } #line 7611 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 179: #line 1784 "ProParser.y" /* yacc.c:1646 */ { IntegrationCase_S.Case = (yyvsp[-1].l); } #line 7617 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 180: #line 1791 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(5, 5, sizeof (struct Quadrature)); } #line 7623 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 181: #line 1794 "ProParser.y" /* yacc.c:1646 */ { List_Add((yyval.l) = (yyvsp[-3].l), &QuadratureCase_S); } #line 7629 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 182: #line 1801 "ProParser.y" /* yacc.c:1646 */ { QuadratureCase_S.ElementType = TRIANGLE; QuadratureCase_S.NumberOfPoints = 4; QuadratureCase_S.MaxNumberOfPoints = 4; QuadratureCase_S.NumberOfDivisions = 1; QuadratureCase_S.MaxNumberOfDivisions = 1; QuadratureCase_S.StoppingCriterion = 1.E-4; QuadratureCase_S.Function = 0; //FIXME(void (*)())Gauss_Triangle; } #line 7642 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 184: #line 1817 "ProParser.y" /* yacc.c:1646 */ { QuadratureCase_S.ElementType = Get_DefineForString(Element_Type, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), Element_Type); vyyerror("Unknown type of Element: %s", (yyvsp[-1].c)); } switch(IntegrationCase_S.SubType) { case STANDARD : switch (IntegrationCase_S.Type) { case GAUSS : Get_FunctionForDefine (FunctionForGauss, QuadratureCase_S.ElementType, &FlagError, (void (**)())&QuadratureCase_S.Function); break; case GAUSSLEGENDRE : Get_FunctionForDefine (FunctionForGaussLegendre, QuadratureCase_S.ElementType, &FlagError, (void (**)())&QuadratureCase_S.Function); break; default : vyyerror("Incompatible type of Integration method"); break; } break; case SINGULAR : switch (IntegrationCase_S.Type) { case GAUSS : Get_FunctionForDefine (FunctionForSingularGauss, QuadratureCase_S.ElementType, &FlagError, (void (**)())&QuadratureCase_S.Function); break; default : vyyerror("Incompatible type of Integration method"); break; } break; default : vyyerror("Incompatible type of Integration method"); break; } if(FlagError) vyyerror("Bad type of Integration method for Element: %s", (yyvsp[-1].c)); Free((yyvsp[-1].c)); } #line 7693 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 185: #line 1865 "ProParser.y" /* yacc.c:1646 */ { QuadratureCase_S.NumberOfPoints = (int)(yyvsp[-1].d); } #line 7699 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 186: #line 1868 "ProParser.y" /* yacc.c:1646 */ { QuadratureCase_S.MaxNumberOfPoints = (int)(yyvsp[-1].d); } #line 7705 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 187: #line 1871 "ProParser.y" /* yacc.c:1646 */ { QuadratureCase_S.NumberOfDivisions = (int)(yyvsp[-1].d); } #line 7711 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 188: #line 1874 "ProParser.y" /* yacc.c:1646 */ { QuadratureCase_S.MaxNumberOfDivisions = (int)(yyvsp[-1].d); } #line 7717 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 189: #line 1877 "ProParser.y" /* yacc.c:1646 */ { QuadratureCase_S.StoppingCriterion = (yyvsp[-1].d); } #line 7723 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 190: #line 1888 "ProParser.y" /* yacc.c:1646 */ { if(!Problem_S.Constraint) Problem_S.Constraint = List_Create(20, 20, sizeof (struct Constraint)); } #line 7731 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 192: #line 1898 "ProParser.y" /* yacc.c:1646 */ { List_Add(Problem_S.Constraint, &Constraint_S); } #line 7739 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 194: #line 1908 "ProParser.y" /* yacc.c:1646 */ { Constraint_S.Name = NULL; Constraint_S.Type = ASSIGN; Constraint_S.ConstraintPerRegion = NULL; Constraint_S.MultiConstraintPerRegion = NULL; } #line 7749 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 196: #line 1921 "ProParser.y" /* yacc.c:1646 */ { Check_NameOfStructNotExist("Constraint", Problem_S.Constraint, (yyvsp[-1].c), fcmp_Constraint_Name); Constraint_S.Name = (yyvsp[-1].c); } #line 7759 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 197: #line 1928 "ProParser.y" /* yacc.c:1646 */ { Constraint_S.Type = Get_DefineForString(Constraint_Type, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), Constraint_Type); vyyerror("Unknown type of Constraint: %s", (yyvsp[-1].c)); } Free((yyvsp[-1].c)); } #line 7771 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 198: #line 1937 "ProParser.y" /* yacc.c:1646 */ { Constraint_S.ConstraintPerRegion = (yyvsp[-1].l); } #line 7777 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 199: #line 1940 "ProParser.y" /* yacc.c:1646 */ { if(!Constraint_S.MultiConstraintPerRegion) Constraint_S.MultiConstraintPerRegion = List_Create(5, 5, sizeof(struct MultiConstraintPerRegion)); MultiConstraintPerRegion_S.Name = (yyvsp[-3].c); MultiConstraintPerRegion_S.ConstraintPerRegion = (yyvsp[-1].l); MultiConstraintPerRegion_S.Active = NULL; List_Add(Constraint_S.MultiConstraintPerRegion, &MultiConstraintPerRegion_S); } #line 7794 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 200: #line 1954 "ProParser.y" /* yacc.c:1646 */ { } #line 7801 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 201: #line 1962 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(6, 6, sizeof (struct ConstraintPerRegion)); } #line 7809 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 202: #line 1967 "ProParser.y" /* yacc.c:1646 */ { List_Add((yyval.l) = (yyvsp[-3].l), &ConstraintPerRegion_S); } #line 7817 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 203: #line 1972 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-1].l); } #line 7825 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 204: #line 1981 "ProParser.y" /* yacc.c:1646 */ { ConstraintPerRegion_S.Type = Constraint_S.Type; ConstraintPerRegion_S.RegionIndex = -1; ConstraintPerRegion_S.SubRegionIndex = -1; ConstraintPerRegion_S.TimeFunctionIndex = -1; } #line 7836 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 206: #line 1995 "ProParser.y" /* yacc.c:1646 */ { ConstraintPerRegion_S.Type = Get_DefineForString(Constraint_Type, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), Constraint_Type); vyyerror("Unknown type of Constraint: %s", (yyvsp[-1].c)); } Free((yyvsp[-1].c)); } #line 7849 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 207: #line 2005 "ProParser.y" /* yacc.c:1646 */ { ConstraintPerRegion_S.RegionIndex = Num_Group(&Group_S, (char*)"CO_Region", (yyvsp[-1].i)); } #line 7857 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 208: #line 2010 "ProParser.y" /* yacc.c:1646 */ { ConstraintPerRegion_S.SubRegionIndex = Num_Group(&Group_S, (char*)"CO_SubRegion", (yyvsp[-1].i)); } #line 7866 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 209: #line 2016 "ProParser.y" /* yacc.c:1646 */ { ConstraintPerRegion_S.TimeFunctionIndex = (yyvsp[-1].i); if(Is_ExpressionPieceWiseDefined((yyvsp[-1].i))) vyyerror("TimeFunction should never be piece-wise defined"); } #line 7876 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 210: #line 2023 "ProParser.y" /* yacc.c:1646 */ { if(ConstraintPerRegion_S.Type == ASSIGN || ConstraintPerRegion_S.Type == INIT){ ConstraintPerRegion_S.Case.Fixed.ExpressionIndex = (yyvsp[-1].i); ConstraintPerRegion_S.Case.Fixed.ExpressionIndex2 = -1; } else vyyerror("Value incompatible with Type"); } #line 7889 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 211: #line 2033 "ProParser.y" /* yacc.c:1646 */ { if(ConstraintPerRegion_S.Type == ASSIGN || ConstraintPerRegion_S.Type == INIT){ ConstraintPerRegion_S.Case.Fixed.ExpressionIndex = (yyvsp[-2].i); ConstraintPerRegion_S.Case.Fixed.ExpressionIndex2 = (yyvsp[-4].i); } else vyyerror("Value incompatible with Type"); } #line 7902 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 212: #line 2043 "ProParser.y" /* yacc.c:1646 */ { if(ConstraintPerRegion_S.Type == ASSIGNFROMRESOLUTION || ConstraintPerRegion_S.Type == INITFROMRESOLUTION) ConstraintPerRegion_S.Case.Solve.ResolutionName = (yyvsp[-1].c); else vyyerror("NameOfResolution incompatible with Type"); } #line 7913 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 213: #line 2051 "ProParser.y" /* yacc.c:1646 */ { if(ConstraintPerRegion_S.Type == NETWORK) { ConstraintPerRegion_S.Case.Network.Node1 = (int)(yyvsp[-4].d); ConstraintPerRegion_S.Case.Network.Node2 = (int)(yyvsp[-2].d); } else vyyerror("Branch incompatible with Type"); } #line 7925 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 214: #line 2060 "ProParser.y" /* yacc.c:1646 */ { if(ConstraintPerRegion_S.Type == NETWORK) { ConstraintPerRegion_S.Case.Network.Node1 = (int)(yyvsp[-7].d); ConstraintPerRegion_S.Case.Network.Node2 = (int)(yyvsp[-3].d); } else vyyerror("Branch incompatible with Type"); } #line 7937 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 215: #line 2069 "ProParser.y" /* yacc.c:1646 */ { if(ConstraintPerRegion_S.Type == CST_LINK || ConstraintPerRegion_S.Type == CST_LINKCPLX) { ConstraintPerRegion_S.Case.Link.RegionRefIndex = Num_Group(&Group_S, (char*)"CO_RegionRef", (yyvsp[-1].i)); ConstraintPerRegion_S.Case.Link.SubRegionRefIndex = -1; ConstraintPerRegion_S.Case.Link.FilterIndex = -1; ConstraintPerRegion_S.Case.Link.FunctionIndex = -1; ConstraintPerRegion_S.Case.Link.CoefIndex = -1; ConstraintPerRegion_S.Case.Link.FilterIndex2 = -1; ConstraintPerRegion_S.Case.Link.FunctionIndex2 = -1; ConstraintPerRegion_S.Case.Link.CoefIndex2 = -1; ConstraintPerRegion_S.Case.Link.ToleranceFactor = 1.e-8; } else vyyerror("RegionRef incompatible with Type"); } #line 7959 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 216: #line 2088 "ProParser.y" /* yacc.c:1646 */ { if(ConstraintPerRegion_S.Type == CST_LINK || ConstraintPerRegion_S.Type == CST_LINKCPLX) ConstraintPerRegion_S.Case.Link.SubRegionRefIndex = Num_Group(&Group_S, (char*)"CO_RegionRef", (yyvsp[-1].i)); else vyyerror("SubRegionRef incompatible with Type"); } #line 7971 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 217: #line 2097 "ProParser.y" /* yacc.c:1646 */ { if(ConstraintPerRegion_S.Type == CST_LINK || ConstraintPerRegion_S.Type == CST_LINKCPLX) ConstraintPerRegion_S.Case.Link.FunctionIndex = (yyvsp[-1].i); else vyyerror("Function incompatible with Type"); } #line 7982 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 218: #line 2105 "ProParser.y" /* yacc.c:1646 */ { if(ConstraintPerRegion_S.Type == CST_LINK || ConstraintPerRegion_S.Type == CST_LINKCPLX) ConstraintPerRegion_S.Case.Link.CoefIndex = (yyvsp[-1].i); else vyyerror("Coefficient incompatible with Type"); } #line 7993 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 219: #line 2113 "ProParser.y" /* yacc.c:1646 */ { if(ConstraintPerRegion_S.Type == CST_LINK || ConstraintPerRegion_S.Type == CST_LINKCPLX) { ConstraintPerRegion_S.Case.Link.FilterIndex = (yyvsp[-1].i); ConstraintPerRegion_S.Case.Link.FilterIndex2 = -1; } else vyyerror("Filter incompatible with Type"); } #line 8006 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 220: #line 2123 "ProParser.y" /* yacc.c:1646 */ { if(ConstraintPerRegion_S.Type == CST_LINK || ConstraintPerRegion_S.Type == CST_LINKCPLX) { ConstraintPerRegion_S.Case.Link.FunctionIndex = (yyvsp[-4].i); ConstraintPerRegion_S.Case.Link.FunctionIndex2 = (yyvsp[-2].i); } else vyyerror("Function incompatible with Type"); } #line 8019 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 221: #line 2133 "ProParser.y" /* yacc.c:1646 */ { if(ConstraintPerRegion_S.Type == CST_LINK || ConstraintPerRegion_S.Type == CST_LINKCPLX) { ConstraintPerRegion_S.Case.Link.ToleranceFactor = (yyvsp[-1].d); } else vyyerror("ToleranceFactor incompatible with Type"); } #line 8031 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 222: #line 2142 "ProParser.y" /* yacc.c:1646 */ { if(ConstraintPerRegion_S.Type == CST_LINK || ConstraintPerRegion_S.Type == CST_LINKCPLX) { ConstraintPerRegion_S.Case.Link.CoefIndex = (yyvsp[-4].i); ConstraintPerRegion_S.Case.Link.CoefIndex2 = (yyvsp[-2].i); } else vyyerror("Coefficient incompatible with Type"); } #line 8044 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 223: #line 2152 "ProParser.y" /* yacc.c:1646 */ { if(ConstraintPerRegion_S.Type == CST_LINK || ConstraintPerRegion_S.Type == CST_LINKCPLX) { ConstraintPerRegion_S.Case.Link.FilterIndex = (yyvsp[-4].i); ConstraintPerRegion_S.Case.Link.FilterIndex2 = (yyvsp[-2].i); } else vyyerror("Filter incompatible with Type"); } #line 8057 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 224: #line 2172 "ProParser.y" /* yacc.c:1646 */ { if(!Problem_S.FunctionSpace) Problem_S.FunctionSpace = List_Create(10, 5, sizeof (struct FunctionSpace)); } #line 8066 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 226: #line 2183 "ProParser.y" /* yacc.c:1646 */ { List_Add(Problem_S.FunctionSpace, &FunctionSpace_S); } #line 8074 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 228: #line 2194 "ProParser.y" /* yacc.c:1646 */ { FunctionSpace_S.Name = NULL; FunctionSpace_S.Type = FORM0; FunctionSpace_S.BasisFunction = FunctionSpace_S.SubSpace = FunctionSpace_S.GlobalQuantity = FunctionSpace_S.Constraint = NULL; } #line 8083 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 231: #line 2208 "ProParser.y" /* yacc.c:1646 */ { Check_NameOfStructNotExist("FunctionSpace", Problem_S.FunctionSpace, (yyvsp[-1].c), fcmp_FunctionSpace_Name); FunctionSpace_S.Name = (yyvsp[-1].c); } #line 8093 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 232: #line 2215 "ProParser.y" /* yacc.c:1646 */ { FunctionSpace_S.Type = Get_DefineForString(Field_Type, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), Field_Type); vyyerror("Unknown type of FunctionSpace: %s", (yyvsp[-1].c)); } Free((yyvsp[-1].c)); } #line 8105 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 233: #line 2224 "ProParser.y" /* yacc.c:1646 */ { FunctionSpace_S.BasisFunction = (yyvsp[-1].l); } #line 8111 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 234: #line 2227 "ProParser.y" /* yacc.c:1646 */ { FunctionSpace_S.SubSpace = (yyvsp[-1].l); } #line 8117 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 235: #line 2230 "ProParser.y" /* yacc.c:1646 */ { FunctionSpace_S.GlobalQuantity = (yyvsp[-1].l); } #line 8123 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 236: #line 2233 "ProParser.y" /* yacc.c:1646 */ { FunctionSpace_S.Constraint = (yyvsp[-1].l); } #line 8129 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 237: #line 2240 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = Current_BasisFunction_L = List_Create(6, 6, sizeof (struct BasisFunction)); } #line 8138 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 238: #line 2246 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq((yyvsp[-3].l), BasisFunction_S.Name, fcmp_BasisFunction_Name)) < 0) { /* BasisFunction_S.Num = Num_BasisFunction++; */ BasisFunction_S.Num = Num_BasisFunction; Num_BasisFunction += (BasisFunction_S.SubFunction)? List_Nbr(BasisFunction_S.SubFunction) : 1; } else /* BasisFunction definie par morceaux => meme Num */ BasisFunction_S.Num = ((struct BasisFunction *)List_Pointer((yyvsp[-3].l), i))->Num; List_Add((yyval.l) = (yyvsp[-3].l), &BasisFunction_S); } #line 8159 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 239: #line 2264 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-1].l); } #line 8167 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 240: #line 2273 "ProParser.y" /* yacc.c:1646 */ { BasisFunction_S.Name = NULL; BasisFunction_S.NameOfCoef = NULL; BasisFunction_S.Num = 0; BasisFunction_S.GlobalBasisFunction = NULL; BasisFunction_S.Function = NULL; BasisFunction_S.dFunction = NULL; BasisFunction_S.dInvFunction = NULL; BasisFunction_S.dPlusFunction = NULL; BasisFunction_S.SubFunction = NULL; BasisFunction_S.SubdFunction = NULL; BasisFunction_S.SupportIndex = -1; BasisFunction_S.EntityIndex = -1; } #line 8186 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 242: #line 2295 "ProParser.y" /* yacc.c:1646 */ { BasisFunction_S.Name = (yyvsp[-1].c); } #line 8192 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 243: #line 2298 "ProParser.y" /* yacc.c:1646 */ { Check_NameOfStructNotExist("NameOfCoef", Current_BasisFunction_L, (yyvsp[-1].c), fcmp_BasisFunction_NameOfCoef); BasisFunction_S.NameOfCoef = (yyvsp[-1].c); BasisFunction_S.Dimension = 1; } #line 8200 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 244: #line 2303 "ProParser.y" /* yacc.c:1646 */ { Get_3Function3NbrForString (BF_Function, (yyvsp[-2].c), &FlagError, &BasisFunction_S.Function, &BasisFunction_S.dFunction, &BasisFunction_S.dInvFunction, &BasisFunction_S.Order, &BasisFunction_S.ElementType, &BasisFunction_S.Orient); if(FlagError){ Get_Valid_SX3F3N((yyvsp[-2].c), BF_Function); vyyerror("Unknown Function for BasisFunction: %s", (yyvsp[-2].c)); } Free((yyvsp[-2].c)); } #line 8217 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 245: #line 2317 "ProParser.y" /* yacc.c:1646 */ { void (*FunctionDummy)(); int i, j; double d; Get_3Function3NbrForString (BF_Function, (yyvsp[-4].c), &FlagError, &BasisFunction_S.dFunction, &FunctionDummy, &FunctionDummy, &d, &i, &j); if(FlagError){ Get_Valid_SX3F3N((yyvsp[-4].c), BF_Function); vyyerror("Unknown dFunction (1) for BasisFunction: %s", (yyvsp[-4].c)); } Free((yyvsp[-4].c)); Get_3Function3NbrForString (BF_Function, (yyvsp[-2].c), &FlagError, &BasisFunction_S.dInvFunction, &FunctionDummy, &FunctionDummy, &d, &i, &j); if(FlagError){ Get_Valid_SX3F3N((yyvsp[-2].c), BF_Function); vyyerror("Unknown dFunction (2) for BasisFunction: %s", (yyvsp[-2].c)); } Free((yyvsp[-2].c)); } #line 8243 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 246: #line 2340 "ProParser.y" /* yacc.c:1646 */ { void (*FunctionDummy)(); int i, j; double d; Get_3Function3NbrForString (BF_Function, (yyvsp[-6].c), &FlagError, &BasisFunction_S.dFunction, &FunctionDummy, &FunctionDummy, &d, &i, &j); if(FlagError){ Get_Valid_SX3F3N((yyvsp[-6].c), BF_Function); vyyerror("Unknown dFunction (1) for BasisFunction: %s", (yyvsp[-6].c)); } Free((yyvsp[-6].c)); Get_3Function3NbrForString (BF_Function, (yyvsp[-4].c), &FlagError, &BasisFunction_S.dInvFunction, &FunctionDummy, &FunctionDummy, &d, &i, &j); if(FlagError){ Get_Valid_SX3F3N((yyvsp[-4].c), BF_Function); vyyerror("Unknown dFunction (2) for BasisFunction: %s", (yyvsp[-4].c)); } Free((yyvsp[-4].c)); Get_3Function3NbrForString (BF_Function, (yyvsp[-2].c), &FlagError, &BasisFunction_S.dPlusFunction, &FunctionDummy, &FunctionDummy, &d, &i, &j); if(FlagError){ Get_Valid_SX3F3N((yyvsp[-2].c), BF_Function); vyyerror("Unknown dFunction (3) for BasisFunction: %s", (yyvsp[-2].c)); } Free((yyvsp[-2].c)); } #line 8277 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 247: #line 2371 "ProParser.y" /* yacc.c:1646 */ { BasisFunction_S.SubFunction = List_Copy(ListOfInt_L); } #line 8285 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 248: #line 2376 "ProParser.y" /* yacc.c:1646 */ { BasisFunction_S.SubdFunction = List_Copy(ListOfInt_L); } #line 8293 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 249: #line 2381 "ProParser.y" /* yacc.c:1646 */ { BasisFunction_S.SupportIndex = Num_Group(&Group_S, (char*)"BF_Support", (yyvsp[-1].i)); } #line 8301 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 250: #line 2386 "ProParser.y" /* yacc.c:1646 */ { BasisFunction_S.EntityIndex = Num_Group(&Group_S, (char*)"BF_Entity", (yyvsp[-1].i)); if(Group_S.InitialList) List_Sort(Group_S.InitialList, fcmp_Integer); /* Needed for Global Region */ if(BasisFunction_S.GlobalBasisFunction) { /* Function to be defined before Entity */ if(Group_S.FunctionType == GLOBAL) { if(List_Nbr(BasisFunction_S.GlobalBasisFunction) == List_Nbr(Group_S.InitialList)) { for(int k = 0; k < List_Nbr(Group_S.InitialList); k++) if(*((int*)List_Pointer(Group_S.InitialList, k)) != *((int*)List_Pointer(BasisFunction_S.GlobalBasisFunction, k))) { vyyerror("Bad correspondance between Group and Entity (elements differ)"); break; } } else if(List_Nbr(Group_S.InitialList) != 0 || GlobalBasisFunction_S.EntityIndex != -1) vyyerror("Bad correspondance between Group and Entity (#BF %d, #Global %d)", List_Nbr(BasisFunction_S.GlobalBasisFunction), List_Nbr(Group_S.InitialList)); } else vyyerror("Bad correspondance between Group and Entity (Entity must be Global)"); } } #line 8331 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 252: #line 2422 "ProParser.y" /* yacc.c:1646 */ { int dim = (yyvsp[-12].d); if(dim != (yyvsp[-3].d)) vyyerror("Number of formulations different from number of resolutions"); if(List_Nbr(Group_S.InitialList) != dim) vyyerror("Group sould have %d single regions", dim); BasisFunction_S.GlobalBasisFunction = List_Create(dim, 1, sizeof(struct GlobalBasisFunction)); for(int k = 0; k < dim; k++) { int i; List_Read(Group_S.InitialList, k, &i); GlobalBasisFunction_S.EntityIndex = i; char tmpstr[256]; sprintf(tmpstr, "%s_%d", (yyvsp[-14].c), k+1); if((i = List_ISearchSeq(Problem_S.Formulation, tmpstr, fcmp_Formulation_Name)) >= 0) { GlobalBasisFunction_S.FormulationIndex = i; List_Read(Problem_S.Formulation, i, &Formulation_S); if((i = List_ISearchSeq(Formulation_S.DefineQuantity, (yyvsp[-17].c), fcmp_DefineQuantity_Name)) >= 0) GlobalBasisFunction_S.DefineQuantityIndex = i; else { vyyerror("Unknown Quantity '%s' in Formulation '%s'", (yyvsp[-17].c), Formulation_S.Name); break; } } else vyyerror("Unknown Formulation: %s", tmpstr); sprintf(tmpstr, "%s_%d", (yyvsp[-5].c), k+1); if((i = List_ISearchSeq(Problem_S.Resolution, tmpstr, fcmp_Resolution_Name)) >= 0) GlobalBasisFunction_S.ResolutionIndex = i; else vyyerror("Unknown Resolution: %s", tmpstr); GlobalBasisFunction_S.QuantityStorage = NULL; List_Add(BasisFunction_S.GlobalBasisFunction, &GlobalBasisFunction_S); } List_Sort(BasisFunction_S.GlobalBasisFunction, fcmp_Integer); Free((yyvsp[-17].c)); Free((yyvsp[-14].c)); Free((yyvsp[-5].c)); } #line 8383 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 253: #line 2475 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = Current_SubSpace_L = List_Create(6, 6, sizeof (struct SubSpace)); } #line 8392 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 254: #line 2481 "ProParser.y" /* yacc.c:1646 */ { List_Add((yyval.l) = (yyvsp[-3].l), &SubSpace_S); } #line 8400 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 255: #line 2490 "ProParser.y" /* yacc.c:1646 */ { SubSpace_S.Name = NULL; SubSpace_S.BasisFunction = NULL; } #line 8408 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 257: #line 2501 "ProParser.y" /* yacc.c:1646 */ { Check_NameOfStructNotExist("SubSpace", Current_SubSpace_L, (yyvsp[-1].c), fcmp_SubSpace_Name); SubSpace_S.Name = (yyvsp[-1].c); } #line 8418 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 258: #line 2508 "ProParser.y" /* yacc.c:1646 */ { SubSpace_S.BasisFunction = (yyvsp[-1].l); } #line 8424 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 259: #line 2511 "ProParser.y" /* yacc.c:1646 */ { SubSpace_S.BasisFunction = (yyvsp[-1].l); } #line 8430 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 260: #line 2518 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(1, 1, sizeof(int)); int i; if((i = List_ISearchSeq(Current_BasisFunction_L, (yyvsp[0].c), fcmp_BasisFunction_Name)) < 0) vyyerror("Unknown BasisFunction: %s", (yyvsp[0].c)); else { List_Add((yyval.l), &i); int j = i+1; while((i = List_ISearchSeqPartial(Current_BasisFunction_L, (yyvsp[0].c), j, fcmp_BasisFunction_Name)) >= 0) { List_Add((yyval.l), &i); j = i+1; /* for piecewise defined basis functions */ } } Free((yyvsp[0].c)); } #line 8451 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 261: #line 2536 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-1].l); } #line 8457 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 262: #line 2542 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(5, 5, sizeof(int)); } #line 8463 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 263: #line 2545 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Current_BasisFunction_L, (yyvsp[0].c), fcmp_BasisFunction_Name)) < 0) vyyerror("Unknown BasisFunction: %s", (yyvsp[0].c)); else { List_Add((yyvsp[-2].l), &i); int j = i+1; while((i = List_ISearchSeqPartial(Current_BasisFunction_L, (yyvsp[0].c), j, fcmp_BasisFunction_Name)) >= 0) { List_Add((yyvsp[-2].l), &i); j = i+1; /* for piecewise defined basis functions */ } } (yyval.l) = (yyvsp[-2].l); Free((yyvsp[0].c)); } #line 8483 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 264: #line 2566 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(1, 1, sizeof(int)); int i; if((i = List_ISearchSeq(Current_BasisFunction_L, (yyvsp[0].c), fcmp_BasisFunction_NameOfCoef)) < 0) vyyerror("Unknown BasisFunctionCoef: %s", (yyvsp[0].c)); else { List_Add((yyval.l), &i); } Free((yyvsp[0].c)); } #line 8499 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 265: #line 2579 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-1].l); } #line 8505 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 266: #line 2586 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(5, 5, sizeof(int)); } #line 8513 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 267: #line 2591 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Current_BasisFunction_L, (yyvsp[0].c), fcmp_BasisFunction_NameOfCoef)) < 0) vyyerror("Unknown BasisFunctionCoef: %s", (yyvsp[0].c)); else { List_Add((yyvsp[-2].l), &i); } (yyval.l) = (yyvsp[-2].l); Free((yyvsp[0].c)); } #line 8528 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 268: #line 2607 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = Current_GlobalQuantity_L = List_Create(6, 6, sizeof (struct GlobalQuantity)); } #line 8537 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 269: #line 2613 "ProParser.y" /* yacc.c:1646 */ { GlobalQuantity_S.Num = Num_BasisFunction++; List_Add((yyval.l) = (yyvsp[-3].l), &GlobalQuantity_S); } #line 8546 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 270: #line 2619 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-1].l); } #line 8554 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 271: #line 2628 "ProParser.y" /* yacc.c:1646 */ { GlobalQuantity_S.Name = NULL; GlobalQuantity_S.Num = 0; GlobalQuantity_S.Type = ALIASOF; GlobalQuantity_S.ReferenceIndex = -1; } #line 8563 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 273: #line 2640 "ProParser.y" /* yacc.c:1646 */ { Check_NameOfStructNotExist("GlobalQuantity", Current_GlobalQuantity_L, (yyvsp[-1].c), fcmp_GlobalQuantity_Name); GlobalQuantity_S.Name = (yyvsp[-1].c); } #line 8573 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 274: #line 2647 "ProParser.y" /* yacc.c:1646 */ { GlobalQuantity_S.Type = Get_DefineForString(GlobalQuantity_Type, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), GlobalQuantity_Type); vyyerror("Unknown type of GlobalQuantity: %s", (yyvsp[-1].c)); } Free((yyvsp[-1].c)); } #line 8587 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 275: #line 2658 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(FunctionSpace_S.BasisFunction, (yyvsp[-1].c), fcmp_BasisFunction_NameOfCoef)) < 0) vyyerror("Unknown NameOfCoef: %s", (yyvsp[-1].c)); else GlobalQuantity_S.ReferenceIndex = i; Free((yyvsp[-1].c)); } #line 8601 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 276: #line 2673 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(6, 6, sizeof (struct ConstraintInFS)); } #line 8609 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 277: #line 2678 "ProParser.y" /* yacc.c:1646 */ { Group_S.FunctionType = Type_Function; Group_S.SuppListType = Type_SuppList; switch (Group_S.FunctionType) { case ELEMENTSOF : Group_S.Type = ELEMENTLIST; break; default : Group_S.Type = REGIONLIST ; break; } if(Constraint_Index >= 0) { Constraint_P = (struct Constraint *) List_Pointer(Problem_S.Constraint, Constraint_Index); for(int i = 0; i < List_Nbr(Constraint_P->ConstraintPerRegion); i++) { ConstraintPerRegion_P = (struct ConstraintPerRegion *) List_Pointer(Constraint_P->ConstraintPerRegion, i); if(ConstraintPerRegion_P->RegionIndex >= 0) { Group_S.InitialList = ((struct Group *) List_Pointer(Problem_S.Group, ConstraintPerRegion_P->RegionIndex)) ->InitialList; Group_S.InitialSuppList = (ConstraintPerRegion_P->SubRegionIndex >= 0)? ((struct Group *) List_Pointer(Problem_S.Group, ConstraintPerRegion_P->SubRegionIndex)) ->InitialList : NULL; ConstraintInFS_S.EntityIndex = Add_Group(&Group_S, (char*)"CO_Entity", false, 1, 0); ConstraintInFS_S.ConstraintPerRegion = ConstraintPerRegion_P; List_Add((yyval.l) = (yyvsp[-3].l), &ConstraintInFS_S); } } } } #line 8650 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 278: #line 2716 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-1].l); } #line 8658 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 279: #line 2725 "ProParser.y" /* yacc.c:1646 */ { ConstraintInFS_S.QuantityType = LOCALQUANTITY; ConstraintInFS_S.ReferenceIndex = -1; ConstraintInFS_S.EntityIndex = -1; ConstraintInFS_S.ConstraintPerRegion = NULL; ConstraintInFS_S.Active.ResolutionIndex = -1; ConstraintInFS_S.Active.Active = NULL; Constraint_Index = -1; } #line 8671 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 281: #line 2741 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(FunctionSpace_S.BasisFunction, (yyvsp[-1].c), fcmp_BasisFunction_NameOfCoef)) < 0) { if((i = List_ISearchSeq(FunctionSpace_S.GlobalQuantity, (yyvsp[-1].c), fcmp_GlobalQuantity_Name)) < 0) vyyerror("Unknown NameOfCoef: %s", (yyvsp[-1].c)); else { ConstraintInFS_S.QuantityType = GLOBALQUANTITY; ConstraintInFS_S.ReferenceIndex = i; } } else { ConstraintInFS_S.QuantityType = LOCALQUANTITY; ConstraintInFS_S.ReferenceIndex = i; } Free((yyvsp[-1].c)); } #line 8694 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 282: #line 2761 "ProParser.y" /* yacc.c:1646 */ { Type_Function = (yyvsp[-1].i); } #line 8700 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 283: #line 2764 "ProParser.y" /* yacc.c:1646 */ { Type_SuppList = (yyvsp[-1].i); } #line 8706 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 284: #line 2767 "ProParser.y" /* yacc.c:1646 */ { Constraint_Index = List_ISearchSeq(Problem_S.Constraint, (yyvsp[-1].c), fcmp_Constraint_Name); if(Constraint_Index < 0) Message::Warning("Constraint '%s' is not provided", (yyvsp[-1].c)); Free((yyvsp[-1].c)); } #line 8718 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 285: #line 2784 "ProParser.y" /* yacc.c:1646 */ { if(!Problem_S.Formulation) Problem_S.Formulation = List_Create(10, 5, sizeof (struct Formulation)); } #line 8726 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 287: #line 2794 "ProParser.y" /* yacc.c:1646 */ { List_Add(Problem_S.Formulation, &Formulation_S); } #line 8734 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 289: #line 2805 "ProParser.y" /* yacc.c:1646 */ { Formulation_S.Name = NULL; Formulation_S.Type = FEMEQUATION; Formulation_S.DefineQuantity = NULL; Formulation_S.Equation = NULL; } #line 8742 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 291: #line 2816 "ProParser.y" /* yacc.c:1646 */ { Check_NameOfStructNotExist("Formulation", Problem_S.Formulation, (yyvsp[-1].c), fcmp_Formulation_Name); Formulation_S.Name = (yyvsp[-1].c); } #line 8752 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 292: #line 2823 "ProParser.y" /* yacc.c:1646 */ { Formulation_S.Type = Get_DefineForString(Formulation_Type, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), Formulation_Type); vyyerror("Unknown type of Formulation: %s", (yyvsp[-1].c)); } Free((yyvsp[-1].c)); } #line 8765 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 294: #line 2835 "ProParser.y" /* yacc.c:1646 */ { Formulation_S.Equation = (yyvsp[-1].l); Free((yyvsp[-3].c)); } #line 8774 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 295: #line 2844 "ProParser.y" /* yacc.c:1646 */ { Formulation_S.DefineQuantity = List_Create(6, 6, sizeof (struct DefineQuantity)); } #line 8782 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 296: #line 2849 "ProParser.y" /* yacc.c:1646 */ { List_Add(Formulation_S.DefineQuantity, &DefineQuantity_S); } #line 8790 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 298: #line 2860 "ProParser.y" /* yacc.c:1646 */ { DefineQuantity_S.Name = NULL; DefineQuantity_S.Type = LOCALQUANTITY; DefineQuantity_S.IndexInFunctionSpace = NULL; DefineQuantity_S.FunctionSpaceIndex = -1; DefineQuantity_S.DofDataIndex = -1; DefineQuantity_S.DofData = NULL; DefineQuantity_S.FrequencySpectrum = NULL; DefineQuantity_S.IntegralQuantity.InIndex = -1; DefineQuantity_S.IntegralQuantity.IntegrationMethodIndex = -1; DefineQuantity_S.IntegralQuantity.JacobianMethodIndex = -1; DefineQuantity_S.IntegralQuantity.Symmetry = 0; DefineQuantity_S.IntegralQuantity.WholeQuantity = NULL; } #line 8809 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 300: #line 2882 "ProParser.y" /* yacc.c:1646 */ { DefineQuantity_S.Name = (yyvsp[-1].c); } #line 8815 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 301: #line 2885 "ProParser.y" /* yacc.c:1646 */ { DefineQuantity_S.Type = GLOBALQUANTITY; } #line 8821 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 302: #line 2889 "ProParser.y" /* yacc.c:1646 */ { DefineQuantity_S.Type = INTEGRALQUANTITY; } #line 8827 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 303: #line 2892 "ProParser.y" /* yacc.c:1646 */ { DefineQuantity_S.Type = Get_DefineForString(DefineQuantity_Type, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), DefineQuantity_Type); vyyerror("Unknown type of Quantity: %s", (yyvsp[-1].c)); } Free((yyvsp[-1].c)); } #line 8840 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 304: #line 2902 "ProParser.y" /* yacc.c:1646 */ { DefineQuantity_S.FrequencySpectrum = (yyvsp[-1].l); } #line 8847 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 305: #line 2906 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Problem_S.FunctionSpace, (yyvsp[0].c), fcmp_FunctionSpace_Name)) < 0) vyyerror("Unknown FunctionSpace: %s", (yyvsp[0].c)); else DefineQuantity_S.FunctionSpaceIndex = i; } #line 8860 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 306: #line 2915 "ProParser.y" /* yacc.c:1646 */ { if(DefineQuantity_S.FunctionSpaceIndex >= 0) { if(DefineQuantity_S.Type == GLOBALQUANTITY && !DefineQuantity_S.IndexInFunctionSpace) { if(DefineQuantity_S.Name) { List_Read(Problem_S.FunctionSpace, DefineQuantity_S.FunctionSpaceIndex, &FunctionSpace_S); int i; if((i = List_ISearchSeq(FunctionSpace_S.GlobalQuantity, DefineQuantity_S.Name, fcmp_GlobalQuantity_Name)) < 0) { vyyerror("Unknown GlobalQuantity: %s", DefineQuantity_S.Name); } else { DefineQuantity_S.IndexInFunctionSpace = List_Create(1, 1, sizeof(int)); List_Add(DefineQuantity_S.IndexInFunctionSpace, &i); } } else vyyerror("No Name pre-defined for GlobalQuantity"); } } } #line 8888 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 307: #line 2940 "ProParser.y" /* yacc.c:1646 */ { DefineQuantity_S.DofDataIndex = (int)(yyvsp[-1].d); } #line 8896 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 308: #line 2945 "ProParser.y" /* yacc.c:1646 */ { Current_DofIndexInWholeQuantity = -1; Current_NoDofIndexInWholeQuantity = -1; List_Reset(ListOfPointer_L); } #line 8906 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 309: #line 2951 "ProParser.y" /* yacc.c:1646 */ { DefineQuantity_S.IntegralQuantity.WholeQuantity = (yyvsp[-2].l); DefineQuantity_S.IntegralQuantity.DofIndexInWholeQuantity = Current_DofIndexInWholeQuantity; WholeQuantity_P = (struct WholeQuantity*) List_Pointer(DefineQuantity_S.IntegralQuantity.WholeQuantity, 0); /* Ce qui suit ne suffit pas : il faudrait aussi gerer des Quantity_def sans Dof */ if(Current_DofIndexInWholeQuantity >= 0) { DefineQuantity_S.IntegralQuantity.TypeOperatorDof = (WholeQuantity_P+Current_DofIndexInWholeQuantity)-> Case.OperatorAndQuantity.TypeOperator; DefineQuantity_S.IntegralQuantity.DefineQuantityIndexDof = (WholeQuantity_P+Current_DofIndexInWholeQuantity)-> Case.OperatorAndQuantity.Index; DefineQuantity_S.FunctionSpaceIndex = ((struct DefineQuantity*) List_Pointer(Formulation_S.DefineQuantity, DefineQuantity_S.IntegralQuantity.DefineQuantityIndexDof))-> FunctionSpaceIndex; } else { /* No Dof{} */ DefineQuantity_S.IntegralQuantity.TypeOperatorDof = NOOP; DefineQuantity_S.IntegralQuantity.DefineQuantityIndexDof = -1; } if(Current_NoDofIndexInWholeQuantity >= 0) { DefineQuantity_S.IntegralQuantity.DefineQuantityIndexNoDof = (WholeQuantity_P+Current_NoDofIndexInWholeQuantity)-> Case.OperatorAndQuantity.Index; } else { /* No NoDof{} */ DefineQuantity_S.IntegralQuantity.DefineQuantityIndexNoDof = -1; } /* Check if the WholeQuantity is a Canonical Form */ DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_NONE; if(List_Nbr(DefineQuantity_S.IntegralQuantity.WholeQuantity) == 1){ /* GF_FUNCTION */ if((WholeQuantity_P+0)->Type == WQ_BUILTINFUNCTION) { Get_FunctionForFunction(GF_Function, (WholeQuantity_P+0)->Case.Function.Fct, &FlagError, &DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Fct); if(!FlagError){ DefineQuantity_S.IntegralQuantity.FunctionForCanonical.NbrParameters = (WholeQuantity_P+0)->Case.Function.NbrParameters; DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Para = (WholeQuantity_P+0)->Case.Function.Para; } DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_GF; } } else if(List_Nbr(DefineQuantity_S.IntegralQuantity.WholeQuantity) == 3){ /* GF_FUNCTION OPER DOF */ if ((WholeQuantity_P+0)->Type == WQ_BUILTINFUNCTION && (WholeQuantity_P+1)->Type == WQ_OPERATORANDQUANTITY && (WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR && Current_DofIndexInWholeQuantity == 1) { Get_FunctionForFunction(GF_Function, (WholeQuantity_P+0)->Case.Function.Fct, &FlagError, &DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Fct); if(!FlagError){ DefineQuantity_S.IntegralQuantity.FunctionForCanonical.NbrParameters = (WholeQuantity_P+0)->Case.Function.NbrParameters; DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Para = (WholeQuantity_P+0)->Case.Function.Para; } if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_TIME) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_GF_PSCA_DOF; if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_CROSSPRODUCT) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_GF_PVEC_DOF; } /* DOF OPER GF_FUNCTION */ else if((WholeQuantity_P+0)->Type == WQ_OPERATORANDQUANTITY && (WholeQuantity_P+1)->Type == WQ_BUILTINFUNCTION && (WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR && Current_DofIndexInWholeQuantity == 0) { Get_FunctionForFunction(GF_Function, (WholeQuantity_P+1)->Case.Function.Fct, &FlagError, &DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Fct); if(!FlagError){ DefineQuantity_S.IntegralQuantity.FunctionForCanonical.NbrParameters = (WholeQuantity_P+1)->Case.Function.NbrParameters; DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Para = (WholeQuantity_P+1)->Case.Function.Para; } if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_TIME) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_GF_PSCA_DOF;/* Scalar Prod Transitive */ if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_CROSSPRODUCT) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_DOF_PVEC_GF; } /* GF_FUNCTION OPER EXPR */ else if((WholeQuantity_P+0)->Type == WQ_BUILTINFUNCTION && (WholeQuantity_P+1)->Type == WQ_EXPRESSION && (WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR ) { Get_FunctionForFunction(GF_Function, (WholeQuantity_P+0)->Case.Function.Fct, &FlagError, &DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Fct); if(!FlagError){ DefineQuantity_S.IntegralQuantity.FunctionForCanonical.NbrParameters = (WholeQuantity_P+0)->Case.Function.NbrParameters; DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Para = (WholeQuantity_P+0)->Case.Function.Para; } DefineQuantity_S.IntegralQuantity.ExpressionIndexForCanonical = (WholeQuantity_P+1)->Case.Expression.Index; if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_TIME) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_GF_PSCA_EXP; if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_CROSSPRODUCT) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_GF_PVEC_EXP; /* DefineQuantity_S.IntegralQuantity.FunctionForCanonical.NbrParameters = (WholeQuantity_P+0)->Case.Function.NbrParameters; DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Para = (WholeQuantity_P+0)->Case.Function.Para; */ } /* EXPR OPER GF_FUNCTION */ else if((WholeQuantity_P+0)->Type == WQ_EXPRESSION && (WholeQuantity_P+1)->Type == WQ_BUILTINFUNCTION && (WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR ) { Get_FunctionForFunction(GF_Function, (WholeQuantity_P+1)->Case.Function.Fct, &FlagError, &DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Fct); if(!FlagError){ DefineQuantity_S.IntegralQuantity.FunctionForCanonical.NbrParameters = (WholeQuantity_P+1)->Case.Function.NbrParameters; DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Para = (WholeQuantity_P+1)->Case.Function.Para; } DefineQuantity_S.IntegralQuantity.ExpressionIndexForCanonical = (WholeQuantity_P+0)->Case.Expression.Index; if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_TIME) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_GF_PSCA_EXP;/* Transitive product */ if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_CROSSPRODUCT) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_EXP_PVEC_GF; } } else if(List_Nbr(DefineQuantity_S.IntegralQuantity.WholeQuantity) == 5){ /* EXPR OPER GF_FUNCTION OPER DOF */ if ((WholeQuantity_P+0)->Type == WQ_EXPRESSION && (WholeQuantity_P+1)->Type == WQ_BUILTINFUNCTION && (WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR && (WholeQuantity_P+3)->Type == WQ_OPERATORANDQUANTITY && (WholeQuantity_P+4)->Type == WQ_BINARYOPERATOR && Current_DofIndexInWholeQuantity == 3) { Get_FunctionForFunction(GF_Function, (WholeQuantity_P+1)->Case.Function.Fct, &FlagError, &DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Fct); if(!FlagError){ DefineQuantity_S.IntegralQuantity.FunctionForCanonical.NbrParameters = (WholeQuantity_P+1)->Case.Function.NbrParameters; DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Para = (WholeQuantity_P+1)->Case.Function.Para; } DefineQuantity_S.IntegralQuantity.ExpressionIndexForCanonical = (WholeQuantity_P+0)->Case.Expression.Index; if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_TIME){ if((WholeQuantity_P+4)->Case.Operator.TypeOperator == OP_TIME) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_EXP_TIME_GF_PSCA_DOF; if((WholeQuantity_P+4)->Case.Operator.TypeOperator == OP_CROSSPRODUCT) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_EXP_TIME_GF_PVEC_DOF; } else if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_CROSSPRODUCT){ if((WholeQuantity_P+4)->Case.Operator.TypeOperator == OP_TIME) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_EXP_PVEC_GF_PSCA_DOF; if((WholeQuantity_P+4)->Case.Operator.TypeOperator == OP_CROSSPRODUCT) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_EXP_PVEC_GF_PVEC_DOF; } } /* FCT OPER GF_FUNCTION OPER DOF */ else if((WholeQuantity_P+0)->Type == WQ_BUILTINFUNCTION && (WholeQuantity_P+1)->Type == WQ_BUILTINFUNCTION && (WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR && (WholeQuantity_P+3)->Type == WQ_OPERATORANDQUANTITY && (WholeQuantity_P+4)->Type == WQ_BINARYOPERATOR && Current_DofIndexInWholeQuantity == 3) { Get_FunctionForFunction(GF_Function, (WholeQuantity_P+1)->Case.Function.Fct, &FlagError, &DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Fct); if(!FlagError){ DefineQuantity_S.IntegralQuantity.FunctionForCanonical.NbrParameters = (WholeQuantity_P+1)->Case.Function.NbrParameters; DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Para = (WholeQuantity_P+1)->Case.Function.Para; } DefineQuantity_S.IntegralQuantity.AnyFunction.Fct = (WholeQuantity_P+0)->Case.Function.Fct; DefineQuantity_S.IntegralQuantity.AnyFunction.NbrParameters = (WholeQuantity_P+0)->Case.Function.NbrParameters; DefineQuantity_S.IntegralQuantity.AnyFunction.Para = (WholeQuantity_P+0)->Case.Function.Para; if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_TIME){ if((WholeQuantity_P+4)->Case.Operator.TypeOperator == OP_TIME) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_FCT_TIME_GF_PSCA_DOF; if((WholeQuantity_P+4)->Case.Operator.TypeOperator == OP_CROSSPRODUCT) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_FCT_TIME_GF_PVEC_DOF; } else if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_CROSSPRODUCT){ if((WholeQuantity_P+4)->Case.Operator.TypeOperator == OP_TIME) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_FCT_PVEC_GF_PSCA_DOF; if((WholeQuantity_P+4)->Case.Operator.TypeOperator == OP_CROSSPRODUCT) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_FCT_PVEC_GF_PVEC_DOF; } } } Pro_DefineQuantityIndex (DefineQuantity_S.IntegralQuantity.WholeQuantity, -1, &DefineQuantity_S.IntegralQuantity.NbrQuantityIndex, &DefineQuantity_S.IntegralQuantity.QuantityIndexTable, &DefineQuantity_S.IntegralQuantity.QuantityTraceGroupIndexTable); if(DefineQuantity_S.IntegralQuantity.NbrQuantityIndex > 1) vyyerror("More than one LocalQuantity in IntegralQuantity"); } #line 9171 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 310: #line 3213 "ProParser.y" /* yacc.c:1646 */ { DefineQuantity_S.IntegralQuantity.InIndex = Num_Group(&Group_S, (char*)"IQ_In", (yyvsp[-1].i)); } #line 9179 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 311: #line 3218 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Problem_S.IntegrationMethod, (yyvsp[-1].c), fcmp_IntegrationMethod_Name)) < 0) vyyerror("Unknown Integration method: %s", (yyvsp[-1].c)); else DefineQuantity_S.IntegralQuantity.IntegrationMethodIndex = i; Free((yyvsp[-1].c)); } #line 9193 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 312: #line 3229 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Problem_S.JacobianMethod, (yyvsp[-1].c), fcmp_JacobianMethod_Name)) < 0) vyyerror("Unknown Jacobian method: %s", (yyvsp[-1].c)); else DefineQuantity_S.IntegralQuantity.JacobianMethodIndex = i; Free((yyvsp[-1].c)); } #line 9207 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 313: #line 3240 "ProParser.y" /* yacc.c:1646 */ { DefineQuantity_S.IntegralQuantity.Symmetry = (yyvsp[-1].i); } #line 9213 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 315: #line 3248 "ProParser.y" /* yacc.c:1646 */ { if(DefineQuantity_S.FunctionSpaceIndex >= 0) { if(DefineQuantity_S.Type == LOCALQUANTITY) { int i; if((i = List_ISearchSeq (((struct FunctionSpace *) List_Pointer(Problem_S.FunctionSpace, DefineQuantity_S.FunctionSpaceIndex))->SubSpace, (yyvsp[-1].c), fcmp_SubSpace_Name)) < 0) vyyerror("Unknown SubSpace: %s", (yyvsp[-1].c)); else { DefineQuantity_S.IndexInFunctionSpace = ((struct SubSpace *) List_Pointer (((struct FunctionSpace *) List_Pointer(Problem_S.FunctionSpace, DefineQuantity_S.FunctionSpaceIndex))->SubSpace, i)) ->BasisFunction; } } else if(DefineQuantity_S.Type == GLOBALQUANTITY) { List_Read(Problem_S.FunctionSpace, DefineQuantity_S.FunctionSpaceIndex, &FunctionSpace_S); int i; if((i = List_ISearchSeq(FunctionSpace_S.GlobalQuantity, (yyvsp[-1].c), fcmp_GlobalQuantity_Name)) < 0) { vyyerror("Unknown GlobalQuantity: %s", (yyvsp[-1].c)); } else { DefineQuantity_S.IndexInFunctionSpace = List_Create(1, 1, sizeof(int)); List_Add(DefineQuantity_S.IndexInFunctionSpace, &i); } } } Free((yyvsp[-1].c)); } #line 9254 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 316: #line 3290 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(6, 6, sizeof(struct EquationTerm)); } #line 9262 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 317: #line 3295 "ProParser.y" /* yacc.c:1646 */ { List_Add((yyval.l) = (yyvsp[-1].l), &EquationTerm_S); } #line 9270 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 318: #line 3300 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-1].l); } #line 9278 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 319: #line 3309 "ProParser.y" /* yacc.c:1646 */ { EquationTerm_S.Type = GALERKIN; } #line 9284 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 320: #line 3312 "ProParser.y" /* yacc.c:1646 */ { EquationTerm_S.Type = DERHAM; } #line 9290 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 321: #line 3315 "ProParser.y" /* yacc.c:1646 */ { EquationTerm_S.Type = GLOBALTERM; } #line 9296 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 322: #line 3318 "ProParser.y" /* yacc.c:1646 */ { EquationTerm_S.Type = GLOBALEQUATION; } #line 9302 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 323: #line 3325 "ProParser.y" /* yacc.c:1646 */ { EquationTerm_S.Case.GlobalEquation.Type = NETWORK; EquationTerm_S.Case.GlobalEquation.ConstraintIndex = -1; EquationTerm_S.Case.GlobalEquation.GlobalEquationTerm = NULL; } #line 9312 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 325: #line 3336 "ProParser.y" /* yacc.c:1646 */ { EquationTerm_S.Case.GlobalEquation.Type = Get_DefineForString(Constraint_Type, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), Constraint_Type); vyyerror("Unknown type of GlobalEquation: %s", (yyvsp[-1].c)); } Free((yyvsp[-1].c)); } #line 9325 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 326: #line 3346 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Problem_S.Constraint, (yyvsp[-1].c), fcmp_Constraint_Name)) >= 0) EquationTerm_S.Case.GlobalEquation.ConstraintIndex = i; else EquationTerm_S.Case.GlobalEquation.ConstraintIndex = -1; Free((yyvsp[-1].c)); } #line 9339 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 327: #line 3357 "ProParser.y" /* yacc.c:1646 */ { if(!EquationTerm_S.Case.GlobalEquation.GlobalEquationTerm) EquationTerm_S.Case.GlobalEquation.GlobalEquationTerm = List_Create(3, 3, sizeof(struct GlobalEquationTerm)); List_Add(EquationTerm_S.Case.GlobalEquation.GlobalEquationTerm, &GlobalEquationTerm_S); } #line 9351 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 328: #line 3371 "ProParser.y" /* yacc.c:1646 */ { GlobalEquationTerm_S.DefineQuantityIndexNode = -1; GlobalEquationTerm_S.DefineQuantityIndexLoop = -1; GlobalEquationTerm_S.DefineQuantityIndexEqu = -1; GlobalEquationTerm_S.InIndex = -1; } #line 9362 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 330: #line 3382 "ProParser.y" /* yacc.c:1646 */ { if(!strcmp((yyvsp[-2].c), "Node")) GlobalEquationTerm_S.DefineQuantityIndexNode = (yyvsp[-1].t).Int2; else if(!strcmp((yyvsp[-2].c), "Loop")) GlobalEquationTerm_S.DefineQuantityIndexLoop = (yyvsp[-1].t).Int2; else if(!strcmp((yyvsp[-2].c), "Equation")) GlobalEquationTerm_S.DefineQuantityIndexEqu = (yyvsp[-1].t).Int2; else vyyerror("Unknown global equation term: %s", (yyvsp[-2].c)); Free((yyvsp[-2].c)); } #line 9378 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 331: #line 3394 "ProParser.y" /* yacc.c:1646 */ { GlobalEquationTerm_S.InIndex = Num_Group(&Group_S, (char*)"FO_In", (yyvsp[-1].i)); } #line 9384 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 332: #line 3402 "ProParser.y" /* yacc.c:1646 */ { EquationTerm_S.Case.LocalTerm.Term.TypeTimeDerivative = NODT_; EquationTerm_S.Case.LocalTerm.Term.TypeOperatorEqu = NOOP; EquationTerm_S.Case.LocalTerm.Term.TypeOperatorDof = NOOP; EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexEqu = -1; EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexDof = -1; EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexNoDof = -1; EquationTerm_S.Case.LocalTerm.Term.WholeQuantity = NULL; EquationTerm_S.Case.LocalTerm.Term.DofIndexInWholeQuantity = -1; EquationTerm_S.Case.LocalTerm.Term.DofInTrace = 0; EquationTerm_S.Case.LocalTerm.InIndex = -1; EquationTerm_S.Case.LocalTerm.IntegrationMethodIndex = -1; EquationTerm_S.Case.LocalTerm.MatrixIndex = -1; EquationTerm_S.Case.LocalTerm.JacobianMethodIndex = -1; EquationTerm_S.Case.LocalTerm.ExpressionIndexForMetricTensor = -1; EquationTerm_S.Case.LocalTerm.Active = NULL; EquationTerm_S.Case.LocalTerm.Full_Matrix = 0; } #line 9406 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 334: #line 3427 "ProParser.y" /* yacc.c:1646 */ { EquationTerm_S.Case.LocalTerm.Term.TypeTimeDerivative = Type_TermOperator; Current_DofIndexInWholeQuantity = -1; Current_NoDofIndexInWholeQuantity = -1; List_Reset(ListOfPointer_L); } #line 9417 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 335: #line 3435 "ProParser.y" /* yacc.c:1646 */ { EquationTerm_S.Case.LocalTerm.Term.WholeQuantity = (yyvsp[0].l); EquationTerm_S.Case.LocalTerm.Term.DofIndexInWholeQuantity = Current_DofIndexInWholeQuantity; WholeQuantity_P = (struct WholeQuantity*) List_Pointer(EquationTerm_S.Case.LocalTerm.Term.WholeQuantity, 0); if(Current_DofIndexInWholeQuantity == -4){ EquationTerm_S.Case.LocalTerm.Term.DofInTrace = 1; EquationTerm_S.Case.LocalTerm.Term.TypeOperatorDof = TypeOperatorDofInTrace; EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexDof = DefineQuantityIndexDofInTrace; } else if(Current_DofIndexInWholeQuantity >= 0) { EquationTerm_S.Case.LocalTerm.Term.TypeOperatorDof = (WholeQuantity_P+Current_DofIndexInWholeQuantity)-> Case.OperatorAndQuantity.TypeOperator; EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexDof = (WholeQuantity_P+Current_DofIndexInWholeQuantity)-> Case.OperatorAndQuantity.Index; } else { /* No Dof{} */ EquationTerm_S.Case.LocalTerm.Term.TypeOperatorDof = NOOP; EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexDof = -1; } if(Current_NoDofIndexInWholeQuantity >= 0) { EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexNoDof = (WholeQuantity_P+Current_NoDofIndexInWholeQuantity)-> Case.OperatorAndQuantity.Index; } else { /* No NoDof{} */ EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexNoDof = -1; } /* Check if the WholeQuantity is a Canonical Form of type 'expr[] * Dof{}'*/ if((List_Nbr(EquationTerm_S.Case.LocalTerm.Term.WholeQuantity) == 3) && ((WholeQuantity_P+0)->Type == WQ_EXPRESSION) && ((WholeQuantity_P+1)->Type == WQ_OPERATORANDQUANTITY) && ((WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR) && ((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_TIME) && (Current_DofIndexInWholeQuantity == 1)) { EquationTerm_S.Case.LocalTerm.Term.CanonicalWholeQuantity = CWQ_EXP_TIME_DOF; EquationTerm_S.Case.LocalTerm.Term.ExpressionIndexForCanonical = (WholeQuantity_P+0)->Case.Expression.Index; } else if((List_Nbr(EquationTerm_S.Case.LocalTerm.Term.WholeQuantity) == 3) && ((WholeQuantity_P+0)->Type == WQ_BUILTINFUNCTION) && ((WholeQuantity_P+1)->Type == WQ_OPERATORANDQUANTITY) && ((WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR) && (Current_DofIndexInWholeQuantity == 1)) { if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_TIME) EquationTerm_S.Case.LocalTerm.Term.CanonicalWholeQuantity = CWQ_FCT_TIME_DOF; if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_CROSSPRODUCT) EquationTerm_S.Case.LocalTerm.Term.CanonicalWholeQuantity = CWQ_FCT_PVEC_DOF; EquationTerm_S.Case.LocalTerm.Term.FunctionForCanonical.Fct = (WholeQuantity_P+0)->Case.Function.Fct; EquationTerm_S.Case.LocalTerm.Term.FunctionForCanonical.NbrParameters = (WholeQuantity_P+0)->Case.Function.NbrParameters; EquationTerm_S.Case.LocalTerm.Term.FunctionForCanonical.Para = (WholeQuantity_P+0)->Case.Function.Para; } else if((List_Nbr(EquationTerm_S.Case.LocalTerm.Term.WholeQuantity) == 1) && ((WholeQuantity_P+0)->Type == WQ_OPERATORANDQUANTITY) && (Current_DofIndexInWholeQuantity == 0)) { EquationTerm_S.Case.LocalTerm.Term.CanonicalWholeQuantity = CWQ_DOF; } else { EquationTerm_S.Case.LocalTerm.Term.CanonicalWholeQuantity = CWQ_NONE; } } #line 9499 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 336: #line 3514 "ProParser.y" /* yacc.c:1646 */ { EquationTerm_S.Case.LocalTerm.Term.TypeOperatorEqu = Quantity_TypeOperator; EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexEqu = Quantity_Index; EquationTerm_S.Case.LocalTerm.Term.CanonicalWholeQuantity_Equ = CWQ_NONE; WholeQuantity_P = (struct WholeQuantity*) List_Pointer((yyvsp[-2].l), 0); if(List_Nbr((yyvsp[-2].l)) == 1){ if((WholeQuantity_P+0)->Type != WQ_OPERATORANDQUANTITY) vyyerror("Missing Quantity in Equation"); } else if(List_Nbr((yyvsp[-2].l)) == 3 && ((WholeQuantity_P+0)->Type == WQ_EXPRESSION && (WholeQuantity_P+1)->Type == WQ_OPERATORANDQUANTITY && (WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR)) { // FIXME: should also add the case (BUILTINFUNCTION OPERATORANDQUANTITY BINARYOPERATOR) EquationTerm_S.Case.LocalTerm.Term.CanonicalWholeQuantity_Equ = CWQ_EXP_TIME_DOF; EquationTerm_S.Case.LocalTerm.Term.ExpressionIndexForCanonical_Equ = (WholeQuantity_P+0)->Case.Expression.Index; EquationTerm_S.Case.LocalTerm.Term.OperatorTypeForCanonical_Equ = (WholeQuantity_P+2)->Case.Operator.TypeOperator; } else if(List_Nbr((yyvsp[-2].l)) == 2 && ((WholeQuantity_P+0)->Type == WQ_OPERATORANDQUANTITY && (WholeQuantity_P+1)->Type == WQ_BUILTINFUNCTION)) { EquationTerm_S.Case.LocalTerm.Term.CanonicalWholeQuantity_Equ = CWQ_FCT_DOF; EquationTerm_S.Case.LocalTerm.Term.BuiltInFunction_Equ = (WholeQuantity_P+1)->Case.Function.Fct; } else{ vyyerror("Unrecognized quantity structure in Equation"); } Pro_DefineQuantityIndex (EquationTerm_S.Case.LocalTerm.Term.WholeQuantity, EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexEqu, &EquationTerm_S.Case.LocalTerm.Term.NbrQuantityIndex, &EquationTerm_S.Case.LocalTerm.Term.QuantityIndexTable, &EquationTerm_S.Case.LocalTerm.Term.QuantityTraceGroupIndexTable); EquationTerm_S.Case.LocalTerm.Term.QuantityIndexPost = 0; for(int i = 0; i < EquationTerm_S.Case.LocalTerm.Term.NbrQuantityIndex; i++) { if((EquationTerm_S.Case.LocalTerm.Term.QuantityIndexTable[i] != EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexEqu) && (EquationTerm_S.Case.LocalTerm.Term.QuantityIndexTable[i] != EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexDof)) { EquationTerm_S.Case.LocalTerm.Term.QuantityIndexPost = 1; break; } } } #line 9557 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 337: #line 3569 "ProParser.y" /* yacc.c:1646 */ { EquationTerm_S.Case.LocalTerm.InIndex = Num_Group(&Group_S, (char*)"FO_In", (yyvsp[-1].i)); } #line 9565 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 338: #line 3574 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Problem_S.JacobianMethod, (yyvsp[-1].c), fcmp_JacobianMethod_Name)) < 0) vyyerror("Unknown Jacobian method: %s",(yyvsp[-1].c)); else EquationTerm_S.Case.LocalTerm.JacobianMethodIndex = i; Free((yyvsp[-1].c)); } #line 9579 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 339: #line 3585 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Problem_S.IntegrationMethod, (yyvsp[-1].c), fcmp_IntegrationMethod_Name)) < 0) vyyerror("Unknown Integration method: %s", (yyvsp[-1].c)); else EquationTerm_S.Case.LocalTerm.IntegrationMethodIndex = i; Free((yyvsp[-1].c)); } #line 9593 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 340: #line 3596 "ProParser.y" /* yacc.c:1646 */ { EquationTerm_S.Case.LocalTerm.Full_Matrix = 1; } #line 9601 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 341: #line 3601 "ProParser.y" /* yacc.c:1646 */ { if((yyvsp[-2].i) == 1 || (yyvsp[-2].i) == 2 || (yyvsp[-2].i) == 3) EquationTerm_S.Case.LocalTerm.MatrixIndex = (yyvsp[-2].i); else vyyerror("Unknown Matrix123: %d", (yyvsp[-2].i)); } #line 9611 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 342: #line 3608 "ProParser.y" /* yacc.c:1646 */ { EquationTerm_S.Case.LocalTerm.ExpressionIndexForMetricTensor = (yyvsp[-1].i); } #line 9619 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 343: #line 3617 "ProParser.y" /* yacc.c:1646 */ { EquationTerm_S.Case.GlobalTerm.TypeTimeDerivative = NODT_; EquationTerm_S.Case.GlobalTerm.DefineQuantityIndex = -1; EquationTerm_S.Case.GlobalTerm.Term.TypeTimeDerivative = NODT_; EquationTerm_S.Case.GlobalTerm.Term.TypeOperatorEqu = NOOP; EquationTerm_S.Case.GlobalTerm.Term.TypeOperatorDof = NOOP; EquationTerm_S.Case.GlobalTerm.Term.DefineQuantityIndexEqu = -1; EquationTerm_S.Case.GlobalTerm.Term.DefineQuantityIndexDof = -1; EquationTerm_S.Case.GlobalTerm.Term.DefineQuantityIndexNoDof = -1; EquationTerm_S.Case.GlobalTerm.Term.WholeQuantity = NULL; EquationTerm_S.Case.GlobalTerm.Term.DofIndexInWholeQuantity = -1; EquationTerm_S.Case.GlobalTerm.InIndex = -1; } #line 9637 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 345: #line 3637 "ProParser.y" /* yacc.c:1646 */ { EquationTerm_S.Case.GlobalTerm.InIndex = Num_Group(&Group_S, (char*)"FO_In", (yyvsp[-1].i)); } #line 9645 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 346: #line 3642 "ProParser.y" /* yacc.c:1646 */ { EquationTerm_S.Case.GlobalTerm.Term.TypeTimeDerivative = Type_TermOperator; Current_DofIndexInWholeQuantity = -1; Current_NoDofIndexInWholeQuantity = -1; List_Reset(ListOfPointer_L); } #line 9656 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 347: #line 3650 "ProParser.y" /* yacc.c:1646 */ { EquationTerm_S.Case.GlobalTerm.Term.WholeQuantity = (yyvsp[0].l); EquationTerm_S.Case.GlobalTerm.Term.DofIndexInWholeQuantity = Current_DofIndexInWholeQuantity; WholeQuantity_P = (struct WholeQuantity*) List_Pointer(EquationTerm_S.Case.GlobalTerm.Term.WholeQuantity, 0); if(Current_DofIndexInWholeQuantity >= 0) { EquationTerm_S.Case.GlobalTerm.Term.TypeOperatorDof = (WholeQuantity_P+Current_DofIndexInWholeQuantity)-> Case.OperatorAndQuantity.TypeOperator; EquationTerm_S.Case.GlobalTerm.Term.DefineQuantityIndexDof = (WholeQuantity_P+Current_DofIndexInWholeQuantity)-> Case.OperatorAndQuantity.Index; } else { /* No Dof{} */ EquationTerm_S.Case.GlobalTerm.Term.TypeOperatorDof = NOOP; EquationTerm_S.Case.GlobalTerm.Term.DefineQuantityIndexDof = -1; } if(Current_NoDofIndexInWholeQuantity >= 0) { EquationTerm_S.Case.GlobalTerm.Term.DefineQuantityIndexNoDof = (WholeQuantity_P+Current_NoDofIndexInWholeQuantity)-> Case.OperatorAndQuantity.Index; } else { /* No NoDof{} */ EquationTerm_S.Case.GlobalTerm.Term.DefineQuantityIndexNoDof = -1; } /* Check if the WholeQuantity is a Canonical Form of type 'expr[] * Dof{}'*/ if((List_Nbr(EquationTerm_S.Case.GlobalTerm.Term.WholeQuantity) == 3) && ((WholeQuantity_P+0)->Type == WQ_EXPRESSION) && ((WholeQuantity_P+1)->Type == WQ_OPERATORANDQUANTITY) && ((WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR) && ((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_TIME) && (Current_DofIndexInWholeQuantity == 1)) { EquationTerm_S.Case.GlobalTerm.Term.CanonicalWholeQuantity = CWQ_EXP_TIME_DOF; EquationTerm_S.Case.GlobalTerm.Term.ExpressionIndexForCanonical = (WholeQuantity_P+0)->Case.Expression.Index; } else if((List_Nbr(EquationTerm_S.Case.GlobalTerm.Term.WholeQuantity) == 1) && ((WholeQuantity_P+0)->Type == WQ_OPERATORANDQUANTITY) && (Current_DofIndexInWholeQuantity == 0)) { EquationTerm_S.Case.GlobalTerm.Term.CanonicalWholeQuantity = CWQ_DOF; } else { EquationTerm_S.Case.GlobalTerm.Term.CanonicalWholeQuantity = CWQ_NONE; } } #line 9714 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 348: #line 3705 "ProParser.y" /* yacc.c:1646 */ { EquationTerm_S.Case.GlobalTerm.Term.TypeOperatorEqu = (yyvsp[-2].t).Int1; EquationTerm_S.Case.GlobalTerm.Term.DefineQuantityIndexEqu = (yyvsp[-2].t).Int2; Pro_DefineQuantityIndex (EquationTerm_S.Case.GlobalTerm.Term.WholeQuantity, EquationTerm_S.Case.GlobalTerm.Term.DefineQuantityIndexEqu, &EquationTerm_S.Case.GlobalTerm.Term.NbrQuantityIndex, &EquationTerm_S.Case.GlobalTerm.Term.QuantityIndexTable, &EquationTerm_S.Case.GlobalTerm.Term.QuantityTraceGroupIndexTable); } #line 9729 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 349: #line 3722 "ProParser.y" /* yacc.c:1646 */ { Type_TermOperator = NODT_ ; } #line 9735 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 350: #line 3723 "ProParser.y" /* yacc.c:1646 */ { Type_TermOperator = DT_ ; } #line 9741 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 351: #line 3724 "ProParser.y" /* yacc.c:1646 */ { Type_TermOperator = DTDOF_ ; } #line 9747 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 352: #line 3725 "ProParser.y" /* yacc.c:1646 */ { Type_TermOperator = DTDT_ ; } #line 9753 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 353: #line 3726 "ProParser.y" /* yacc.c:1646 */ { Type_TermOperator = DTDTDOF_ ; } #line 9759 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 354: #line 3727 "ProParser.y" /* yacc.c:1646 */ { Type_TermOperator = DTDTDTDOF_ ; } #line 9765 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 355: #line 3728 "ProParser.y" /* yacc.c:1646 */ { Type_TermOperator = DTDTDTDTDOF_ ; } #line 9771 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 356: #line 3729 "ProParser.y" /* yacc.c:1646 */ { Type_TermOperator = DTDTDTDTDTDOF_ ; } #line 9777 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 357: #line 3730 "ProParser.y" /* yacc.c:1646 */ { Type_TermOperator = JACNL_ ; } #line 9783 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 358: #line 3731 "ProParser.y" /* yacc.c:1646 */ { Type_TermOperator = DTDOFJACNL_ ; } #line 9789 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 359: #line 3732 "ProParser.y" /* yacc.c:1646 */ { Type_TermOperator = NEVERDT_ ; } #line 9795 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 360: #line 3733 "ProParser.y" /* yacc.c:1646 */ { Type_TermOperator = DTNL_ ; } #line 9801 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 361: #line 3740 "ProParser.y" /* yacc.c:1646 */ { (yyval.t).Int1 = Get_DefineForString(Operator_Type, (yyvsp[-2].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-2].c), Operator_Type); vyyerror("Unknown Operator for discrete Quantity: %s", (yyvsp[-2].c)); } Free((yyvsp[-2].c)); int i; if((i = List_ISearchSeq(Formulation_S.DefineQuantity, (yyvsp[-1].c), fcmp_DefineQuantity_Name)) < 0) vyyerror("Unknown discrete Quantity: %s", (yyvsp[-1].c)); (yyval.t).Int2 = i; /* the following should be suppressed as soon as the test function part in the formulations is correctly treated */ Quantity_TypeOperator = (yyval.t).Int1; Quantity_Index = (yyval.t).Int2; Free((yyvsp[-1].c)); } #line 9825 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 362: #line 3761 "ProParser.y" /* yacc.c:1646 */ { (yyval.t).Int1 = NOOP; int i; if((i = List_ISearchSeq(Formulation_S.DefineQuantity, (yyvsp[-1].c), fcmp_DefineQuantity_Name)) < 0) vyyerror("Unknown discrete Quantity: %s", (yyvsp[-1].c)); (yyval.t).Int2 = i; /* the following should be suppressed as soon as the test function part in the formulations is correctly treated */ Quantity_TypeOperator = (yyval.t).Int1; Quantity_Index = (yyval.t).Int2; Free((yyvsp[-1].c)); } #line 9844 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 363: #line 3785 "ProParser.y" /* yacc.c:1646 */ { if(!Problem_S.Resolution) Problem_S.Resolution = List_Create(10, 5, sizeof (struct Resolution)); } #line 9852 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 365: #line 3795 "ProParser.y" /* yacc.c:1646 */ { List_Add(Problem_S.Resolution, &Resolution_S); } #line 9860 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 367: #line 3806 "ProParser.y" /* yacc.c:1646 */ { Resolution_S.Name = NULL; Resolution_S.Hidden = false; Resolution_S.DefineSystem = NULL; Resolution_S.Operation = NULL; } #line 9871 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 369: #line 3820 "ProParser.y" /* yacc.c:1646 */ { Check_NameOfStructNotExist("Resolution", Problem_S.Resolution, (yyvsp[-1].c), fcmp_Resolution_Name); Resolution_S.Name = (yyvsp[-1].c); } #line 9881 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 370: #line 3826 "ProParser.y" /* yacc.c:1646 */ { Resolution_S.Hidden = (yyvsp[-1].d) ? true : false; } #line 9887 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 371: #line 3829 "ProParser.y" /* yacc.c:1646 */ { Resolution_S.DefineSystem = (yyvsp[-1].l); } #line 9893 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 372: #line 3832 "ProParser.y" /* yacc.c:1646 */ { Operation_L = List_Create(5, 5, sizeof(struct Operation)); } #line 9899 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 373: #line 3834 "ProParser.y" /* yacc.c:1646 */ { Resolution_S.Operation = (yyvsp[-1].l); List_Delete(Operation_L); } #line 9905 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 375: #line 3842 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = Current_System_L = List_Create(6, 6, sizeof (struct DefineSystem)); } #line 9913 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 376: #line 3847 "ProParser.y" /* yacc.c:1646 */ { int i ; if ((i = List_ISearchSeq(Current_System_L, DefineSystem_S.Name, fcmp_DefineSystem_Name)) < 0) List_Add((yyval.l) = Current_System_L = (yyvsp[-3].l), &DefineSystem_S) ; else List_Write(Current_System_L, i, &DefineSystem_S) ; } #line 9925 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 377: #line 3856 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-1].l); } #line 9933 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 378: #line 3865 "ProParser.y" /* yacc.c:1646 */ { DefineSystem_S.Name = NULL; DefineSystem_S.Type = VAL_REAL; DefineSystem_S.FormulationIndex = NULL; DefineSystem_S.MeshName = NULL; DefineSystem_S.AdaptName = NULL; DefineSystem_S.FrequencyValue = NULL; DefineSystem_S.SolverDataFileName = NULL; DefineSystem_S.OriginSystemIndex = NULL; DefineSystem_S.DestinationSystemName = NULL; DefineSystem_S.DestinationSystemIndex = -1; } #line 9949 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 380: #line 3884 "ProParser.y" /* yacc.c:1646 */ { int i; if ((i = List_ISearchSeq(Current_System_L, (yyvsp[-1].c), fcmp_DefineSystem_Name)) < 0) DefineSystem_S.Name = (yyvsp[-1].c) ; else List_Read(Current_System_L, i, &DefineSystem_S) ; } #line 9961 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 381: #line 3893 "ProParser.y" /* yacc.c:1646 */ { DefineSystem_S.Type = Get_DefineForString(DefineSystem_Type, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), DefineSystem_Type); vyyerror("Unknown type of System: %s", (yyvsp[-1].c)); } Free((yyvsp[-1].c)); } #line 9973 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 382: #line 3902 "ProParser.y" /* yacc.c:1646 */ { DefineSystem_S.FormulationIndex = (yyvsp[-1].l); } #line 9979 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 383: #line 3905 "ProParser.y" /* yacc.c:1646 */ { DefineSystem_S.MeshName = strSave(Fix_RelativePath((yyvsp[-1].c)).c_str()); Free((yyvsp[-1].c)); } #line 9988 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 384: #line 3911 "ProParser.y" /* yacc.c:1646 */ { if (!DefineSystem_S.OriginSystemIndex) { DefineSystem_S.OriginSystemIndex = (yyvsp[-1].l) ; } else { for (int i = 0 ; i < List_Nbr((yyvsp[-1].l)) ; i++) List_Add(DefineSystem_S.OriginSystemIndex, (int *)List_Pointer((yyvsp[-1].l), i) ) ; } } #line 10002 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 385: #line 3922 "ProParser.y" /* yacc.c:1646 */ { DefineSystem_S.DestinationSystemName = (yyvsp[-1].c); } #line 10010 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 386: #line 3927 "ProParser.y" /* yacc.c:1646 */ { DefineSystem_S.FrequencyValue = (yyvsp[-1].l); DefineSystem_S.Type = VAL_COMPLEX; } #line 10018 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 387: #line 3932 "ProParser.y" /* yacc.c:1646 */ { DefineSystem_S.SolverDataFileName = (yyvsp[-1].c); } #line 10026 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 389: #line 3943 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(1, 1, sizeof(int)); int i; if((i = List_ISearchSeq(Problem_S.Formulation, (yyvsp[0].c), fcmp_Formulation_Name)) < 0) vyyerror("Unknown Formulation: %s", (yyvsp[0].c)); else List_Add((yyval.l), &i); Free((yyvsp[0].c)); } #line 10039 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 390: #line 3953 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-1].l); } #line 10045 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 391: #line 3960 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(2, 2, sizeof(int)); } #line 10051 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 392: #line 3963 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Problem_S.Formulation, (yyvsp[0].c), fcmp_Formulation_Name)) < 0) vyyerror("Unknown Formulation: %s", (yyvsp[0].c)); else List_Add((yyvsp[-2].l), &i); (yyval.l) = (yyvsp[-2].l); Free((yyvsp[0].c)); } #line 10064 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 393: #line 3976 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(1, 1, sizeof(int)); int i; if((i = List_ISearchSeq(Current_System_L, (yyvsp[0].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[0].c)); else List_Add((yyval.l), &i); Free((yyvsp[0].c)); } #line 10078 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 394: #line 3987 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-1].l); } #line 10084 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 395: #line 3993 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(2, 2, sizeof(int)); } #line 10090 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 396: #line 3996 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Current_System_L, (yyvsp[0].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[0].c)); else List_Add((yyvsp[-2].l), &i); (yyval.l) = (yyvsp[-2].l); Free((yyvsp[0].c)); } #line 10103 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 397: #line 4009 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(6, 6, sizeof (struct Operation)); Operation_S.Type = OPERATION_NONE; Operation_S.DefineSystemIndex = -1; Operation_S.Flag = -1; List_Add(Operation_L, &Operation_S); } #line 10115 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 398: #line 4018 "ProParser.y" /* yacc.c:1646 */ { if(((struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1))->Type != OPERATION_NONE){ List_Add((yyval.l) = (yyvsp[-1].l), (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1)); } } #line 10127 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 399: #line 4028 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = -1; } #line 10133 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 400: #line 4030 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = (int)(yyvsp[0].d); } #line 10139 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 401: #line 4034 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = OPERATION_GMSHREAD; } #line 10145 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 402: #line 4035 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = OPERATION_GMSHOPEN; } #line 10151 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 403: #line 4036 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = OPERATION_GMSHMERGE; } #line 10157 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 404: #line 4037 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = OPERATION_GMSHWRITE; } #line 10163 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 405: #line 4040 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = OPERATION_GENERATE; } #line 10169 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 406: #line 4041 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = OPERATION_GENERATEJAC; } #line 10175 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 407: #line 4042 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = OPERATION_GENERATERHS; } #line 10181 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 408: #line 4043 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = OPERATION_GENERATE_CUMULATIVE; } #line 10187 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 409: #line 4044 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = OPERATION_GENERATEJAC_CUMULATIVE; } #line 10193 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 410: #line 4045 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = OPERATION_GENERATERHS_CUMULATIVE; } #line 10199 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 411: #line 4052 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = Get_DefineForString(Operation_Type, (yyvsp[-2].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-2].c), Operation_Type); vyyerror("Unknown type of Operation: %s", (yyvsp[-2].c)); } Free((yyvsp[-2].c)); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-1].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-1].c)); Free((yyvsp[-1].c)); Operation_P->DefineSystemIndex = i; if(Operation_P->Type == OPERATION_GENERATE || Operation_P->Type == OPERATION_GENERATERHS || Operation_P->Type == OPERATION_GENERATEJAC || Operation_P->Type == OPERATION_GENERATESEPARATE) Operation_P->Case.Generate.GroupIndex = -1; } #line 10226 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 412: #line 4076 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SETTIME; Operation_P->Case.SetTime.ExpressionIndex = (yyvsp[-1].i); } #line 10236 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 413: #line 4083 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SETTIMESTEP; Operation_P->Case.SetTime.ExpressionIndex = (yyvsp[-1].i); } #line 10246 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 414: #line 4090 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_TIMELOOPTHETA; } #line 10255 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 415: #line 4096 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_TIMELOOPNEWMARK; } #line 10264 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 416: #line 4102 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_ITERATIVELOOP; } #line 10273 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 417: #line 4108 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_ITERATIVETIMEREDUCTION; } #line 10282 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 418: #line 4116 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = Get_DefineForString(Operation_Type, (yyvsp[-5].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-5].c), Operation_Type); vyyerror("Unknown type of Operation: %s", (yyvsp[-5].c)); } Free((yyvsp[-5].c)); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-3].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-3].c)); Free((yyvsp[-3].c)); Operation_P->DefineSystemIndex = i; if(Operation_P->Type == OPERATION_GENERATE || Operation_P->Type == OPERATION_GENERATERHS || Operation_P->Type == OPERATION_GENERATEJAC || Operation_P->Type == OPERATION_GENERATESEPARATE) Operation_P->Case.Generate.GroupIndex = -1; Operation_P->Flag = (yyvsp[-2].i); } #line 10308 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 419: #line 4139 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SETTIME; Operation_P->Case.SetTime.ExpressionIndex = (yyvsp[-2].i); } #line 10318 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 420: #line 4146 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SETTIMESTEP; Operation_P->Case.SetTime.ExpressionIndex = (yyvsp[-2].i); } #line 10328 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 421: #line 4153 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SLEEP; Operation_P->Case.Sleep.ExpressionIndex = (yyvsp[-2].i); } #line 10338 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 422: #line 4160 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SETCOMMSELF; } #line 10347 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 423: #line 4166 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SETCOMMWORLD; } #line 10356 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 424: #line 4172 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_BARRIER; } #line 10365 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 425: #line 4178 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_BROADCASTFIELDS; Operation_P->Case.BroadcastFields.FieldsToSkip = (yyvsp[-2].l); } #line 10375 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 426: #line 4185 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_BREAK; } #line 10384 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 427: #line 4191 "ProParser.y" /* yacc.c:1646 */ { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_TEST; Operation_P->Case.Test.ExpressionIndex = (yyvsp[-4].i); Operation_P->Case.Test.Operation_True = (yyvsp[-1].l); Operation_P->Case.Test.Operation_False = NULL; } #line 10398 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 428: #line 4202 "ProParser.y" /* yacc.c:1646 */ { List_Pop(Operation_L); List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_TEST; Operation_P->Case.Test.ExpressionIndex = (yyvsp[-7].i); Operation_P->Case.Test.Operation_True = (yyvsp[-4].l); Operation_P->Case.Test.Operation_False = (yyvsp[-1].l); } #line 10413 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 429: #line 4214 "ProParser.y" /* yacc.c:1646 */ { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_WHILE; Operation_P->Case.While.ExpressionIndex = (yyvsp[-4].i); Operation_P->Case.While.Operation = (yyvsp[-1].l); } #line 10426 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 430: #line 4224 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SETFREQUENCY; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-4].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-4].c)); Free((yyvsp[-4].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.SetFrequency.ExpressionIndex = (yyvsp[-2].i); } #line 10442 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 431: #line 4237 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_GENERATEONLY; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-4].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-4].c)); Free((yyvsp[-4].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.GenerateOnly.MatrixIndex_L = List_Create(List_Nbr((yyvsp[-2].l)),1,sizeof(int)); for(int i = 0; i < List_Nbr((yyvsp[-2].l)); i++){ double d; List_Read((yyvsp[-2].l),i,&d); int j = (int)d; List_Add(Operation_P->Case.GenerateOnly.MatrixIndex_L, &j); } List_Delete((yyvsp[-2].l)); } #line 10467 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 432: #line 4259 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_GENERATEONLYJAC; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-4].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-4].c)); Free((yyvsp[-4].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.GenerateOnly.MatrixIndex_L = List_Create(List_Nbr((yyvsp[-2].l)),1,sizeof(int)); for(int i = 0; i < List_Nbr((yyvsp[-2].l)); i++){ double d; List_Read((yyvsp[-2].l),i,&d); int j = (int)d; List_Add(Operation_P->Case.GenerateOnly.MatrixIndex_L, &j); } List_Delete((yyvsp[-2].l)); } #line 10492 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 433: #line 4281 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_UPDATE; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-2].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-2].c)); Free((yyvsp[-2].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.Update.ExpressionIndex = -1; } #line 10508 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 434: #line 4294 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_UPDATE; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-4].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-4].c)); Free((yyvsp[-4].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.Update.ExpressionIndex = (yyvsp[-2].i); } #line 10524 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 435: #line 4307 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_UPDATECONSTRAINT; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-6].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-6].c)); Free((yyvsp[-6].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.UpdateConstraint.GroupIndex = Num_Group(&Group_S, (char*)"OP_UpdateCst", (yyvsp[-4].i)); Operation_P->Case.UpdateConstraint.Type = Get_DefineForString(Constraint_Type, (yyvsp[-2].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-2].c), Constraint_Type); vyyerror("Unknown type of Constraint: %s", (yyvsp[-2].c)); } Free((yyvsp[-2].c)); } #line 10548 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 436: #line 4328 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1) ; Operation_P->Type = OPERATION_UPDATECONSTRAINT ; int i; if ((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-2].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-2].c)) ; Free((yyvsp[-2].c)) ; Operation_P->DefineSystemIndex = i ; Operation_P->Case.UpdateConstraint.GroupIndex = -1; Operation_P->Case.UpdateConstraint.Type = ASSIGN; } #line 10565 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 437: #line 4342 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_GETRESIDUAL; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-5].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-5].c)); Free((yyvsp[-5].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.GetResidual.VariableName = (yyvsp[-2].c); Operation_P->Case.GetResidual.NormType = L2NORM; /* NormType = Get_DefineForString(ErrorNorm_Type, $xx, &FlagError); if(FlagError){ Get_Valid_SXD($xx, ErrorNorm_Type); vyyerror("Unknown error norm type for residual calculation"); } */ } #line 10589 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 438: #line 4363 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_CREATESOLUTION; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-2].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-2].c)); Free((yyvsp[-2].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.CreateSolution.CopyFromTimeStep = -1; } #line 10605 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 439: #line 4376 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_CREATESOLUTION; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-4].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-4].c)); Free((yyvsp[-4].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.CreateSolution.CopyFromTimeStep = (yyvsp[-2].d); } #line 10621 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 440: #line 4389 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_FOURIERTRANSFORM; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-6].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-6].c)); Free((yyvsp[-6].c)); Operation_P->Case.FourierTransform.DefineSystemIndex[0] = i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-4].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-4].c)); Free((yyvsp[-4].c)); Operation_P->Case.FourierTransform.DefineSystemIndex[1] = i; Operation_P->Case.FourierTransform.Frequency = (yyvsp[-2].l); } #line 10642 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 441: #line 4407 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_FOURIERTRANSFORM2; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-6].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-6].c)); Free((yyvsp[-6].c)); Operation_P->Case.FourierTransform2.DefineSystemIndex[0] = i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-4].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-4].c)); Free((yyvsp[-4].c)); Operation_P->Case.FourierTransform2.DefineSystemIndex[1] = i; Operation_P->Case.FourierTransform2.Period = (yyvsp[-2].d); Operation_P->Case.FourierTransform2.Period_sofar = 0.; Operation_P->Case.FourierTransform2.Scales = NULL; } #line 10665 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 442: #line 4427 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_LANCZOS; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-8].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-8].c)); Free((yyvsp[-8].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.Lanczos.Size = (int)(yyvsp[-6].d); Operation_P->Case.Lanczos.Save = List_Create(List_Nbr((yyvsp[-4].l)), 1, sizeof(int)); for(int l = 0; l < List_Nbr((yyvsp[-4].l)); l++) { double d; List_Read((yyvsp[-4].l), l, &d); int j = (int)d; List_Add(Operation_P->Case.Lanczos.Save, &j); } List_Delete((yyvsp[-4].l)); Operation_P->Case.Lanczos.Shift = (yyvsp[-2].d); } #line 10691 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 443: #line 4450 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_EIGENSOLVE; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-8].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-8].c)); Free((yyvsp[-8].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.EigenSolve.NumEigenvalues = (int)(yyvsp[-6].d); Operation_P->Case.EigenSolve.Shift_r = (yyvsp[-4].d); Operation_P->Case.EigenSolve.Shift_i = (yyvsp[-2].d); Operation_P->Case.EigenSolve.FilterExpressionIndex = -1; } #line 10710 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 444: #line 4467 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_EIGENSOLVE; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-10].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-10].c)); Free((yyvsp[-10].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.EigenSolve.NumEigenvalues = (int)(yyvsp[-8].d); Operation_P->Case.EigenSolve.Shift_r = (yyvsp[-6].d); Operation_P->Case.EigenSolve.Shift_i = (yyvsp[-4].d); Operation_P->Case.EigenSolve.FilterExpressionIndex = (yyvsp[-2].i); } #line 10729 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 445: #line 4483 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_EIGENSOLVEJAC; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-8].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-8].c)); Free((yyvsp[-8].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.EigenSolve.NumEigenvalues = (int)(yyvsp[-6].d); Operation_P->Case.EigenSolve.Shift_r = (yyvsp[-4].d); Operation_P->Case.EigenSolve.Shift_i = (yyvsp[-2].d); Operation_P->Case.EigenSolve.FilterExpressionIndex = -1; } #line 10748 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 446: #line 4499 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_EVALUATE; Operation_P->Case.Evaluate.Expressions = List_Copy(ListOfInt_L); } #line 10758 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 447: #line 4506 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1) ; Operation_P->Type = OPERATION_SELECTCORRECTION; int i; if ((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-4].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-4].c)) ; Free((yyvsp[-4].c)) ; Operation_P->DefineSystemIndex = i ; Operation_P->Case.SelectCorrection.Iteration = (int)(yyvsp[-2].d) ; } #line 10774 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 448: #line 4519 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1) ; Operation_P->Type = OPERATION_ADDCORRECTION; int i; if ((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-2].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-2].c)) ; Free((yyvsp[-2].c)) ; Operation_P->DefineSystemIndex = i ; Operation_P->Case.AddCorrection.Alpha = 1. ; } #line 10790 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 449: #line 4532 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1) ; Operation_P->Type = OPERATION_ADDCORRECTION; int i; if ((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-4].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-4].c)) ; Free((yyvsp[-4].c)) ; Operation_P->DefineSystemIndex = i ; Operation_P->Case.AddCorrection.Alpha = (yyvsp[-2].d) ; } #line 10806 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 450: #line 4545 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1) ; Operation_P->Type = OPERATION_MULTIPLYSOLUTION; int i; if ((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-4].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-4].c)) ; Free((yyvsp[-4].c)) ; Operation_P->DefineSystemIndex = i ; Operation_P->Case.MultiplySolution.Alpha = (yyvsp[-2].d) ; } #line 10822 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 451: #line 4558 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1) ; Operation_P->Type = OPERATION_ADDOPPOSITEFULLSOLUTION; int i; if ((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-2].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-2].c)) ; Free((yyvsp[-2].c)) ; Operation_P->DefineSystemIndex = i ; } #line 10837 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 452: #line 4571 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_PERTURBATION; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-14].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-14].c)); Free((yyvsp[-14].c)); Operation_P->DefineSystemIndex = i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-12].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-12].c)); Free((yyvsp[-12].c)); Operation_P->Case.Perturbation.DefineSystemIndex2 = i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-10].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-10].c)); Free((yyvsp[-10].c)); Operation_P->Case.Perturbation.DefineSystemIndex3 = i; Operation_P->Case.Perturbation.Size = (int)(yyvsp[-8].d); Operation_P->Case.Perturbation.Save = List_Create(List_Nbr((yyvsp[-6].l)), 1, sizeof(int)); for(int l = 0; l < List_Nbr((yyvsp[-6].l)); l++) { double d; List_Read((yyvsp[-6].l), l, &d); int j = (int)d; List_Add(Operation_P->Case.Perturbation.Save, &j); } List_Delete((yyvsp[-6].l)); Operation_P->Case.Perturbation.Shift = (yyvsp[-4].d); Operation_P->Case.Perturbation.PertFreq = (int)(yyvsp[-2].d); } #line 10874 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 453: #line 4606 "ProParser.y" /* yacc.c:1646 */ { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_TIMELOOPTHETA; Operation_P->Case.TimeLoopTheta.Time0 = (yyvsp[-10].d); Operation_P->Case.TimeLoopTheta.TimeMax = (yyvsp[-8].d); Operation_P->Case.TimeLoopTheta.DTimeIndex = (yyvsp[-6].i); Operation_P->Case.TimeLoopTheta.ThetaIndex = (yyvsp[-4].i); Operation_P->Case.TimeLoopTheta.Operation = (yyvsp[-1].l); } #line 10889 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 454: #line 4619 "ProParser.y" /* yacc.c:1646 */ { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_TIMELOOPNEWMARK; Operation_P->Case.TimeLoopNewmark.Time0 = (yyvsp[-12].d); Operation_P->Case.TimeLoopNewmark.TimeMax = (yyvsp[-10].d); Operation_P->Case.TimeLoopNewmark.DTimeIndex = (yyvsp[-8].i); Operation_P->Case.TimeLoopNewmark.Beta = (yyvsp[-6].d); Operation_P->Case.TimeLoopNewmark.Gamma = (yyvsp[-4].d); Operation_P->Case.TimeLoopNewmark.Operation = (yyvsp[-1].l); } #line 10905 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 455: #line 4633 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_TIMELOOPRUNGEKUTTA; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-14].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-14].c)); Free((yyvsp[-14].c)); Operation_P->DefineSystemIndex = i ; Operation_P->Case.TimeLoopRungeKutta.Time0 = (yyvsp[-12].d); Operation_P->Case.TimeLoopRungeKutta.TimeMax = (yyvsp[-10].d); Operation_P->Case.TimeLoopRungeKutta.DTimeIndex = (yyvsp[-8].i); Operation_P->Case.TimeLoopRungeKutta.ButcherA = (yyvsp[-6].l); Operation_P->Case.TimeLoopRungeKutta.ButcherB = (yyvsp[-4].l); Operation_P->Case.TimeLoopRungeKutta.ButcherC = (yyvsp[-2].l); } #line 10926 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 456: #line 4653 "ProParser.y" /* yacc.c:1646 */ { List_Pop(Operation_L); List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_TIMELOOPADAPTIVE; Operation_P->Case.TimeLoopAdaptive.Time0 = (yyvsp[-22].d); Operation_P->Case.TimeLoopAdaptive.TimeMax = (yyvsp[-20].d); Operation_P->Case.TimeLoopAdaptive.DTimeInit = (yyvsp[-18].d); Operation_P->Case.TimeLoopAdaptive.DTimeMin = (yyvsp[-16].d); Operation_P->Case.TimeLoopAdaptive.DTimeMax = (yyvsp[-14].d); Operation_P->Case.TimeLoopAdaptive.Scheme = (yyvsp[-12].c); Operation_P->Case.TimeLoopAdaptive.Breakpoints_L = (yyvsp[-10].l); Operation_P->Case.TimeLoopAdaptive.Operation = (yyvsp[-4].l); Operation_P->Case.TimeLoopAdaptive.OperationEnd = (yyvsp[-1].l); } #line 10947 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 457: #line 4672 "ProParser.y" /* yacc.c:1646 */ { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_ITERATIVELOOPN; Operation_P->Case.IterativeLoop.NbrMaxIteration = (int)(yyvsp[-8].d); Operation_P->Case.IterativeLoop.RelaxationFactorIndex = (yyvsp[-6].i); Operation_P->Case.IterativeLoop.Operation = (yyvsp[-1].l); } #line 10960 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 458: #line 4683 "ProParser.y" /* yacc.c:1646 */ { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_ITERATIVELOOP; Operation_P->Case.IterativeLoop.NbrMaxIteration = (int)(yyvsp[-8].d); Operation_P->Case.IterativeLoop.Criterion = (yyvsp[-6].d); Operation_P->Case.IterativeLoop.RelaxationFactorIndex = (yyvsp[-4].i); Operation_P->Case.IterativeLoop.Flag = 0; Operation_P->Case.IterativeLoop.Operation = (yyvsp[-1].l); } #line 10975 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 459: #line 4696 "ProParser.y" /* yacc.c:1646 */ { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_ITERATIVELOOP; Operation_P->Case.IterativeLoop.NbrMaxIteration = (int)(yyvsp[-10].d); Operation_P->Case.IterativeLoop.Criterion = (yyvsp[-8].d); Operation_P->Case.IterativeLoop.RelaxationFactorIndex = (yyvsp[-6].i); Operation_P->Case.IterativeLoop.Flag = (int)(yyvsp[-4].d); Operation_P->Case.IterativeLoop.Operation = (yyvsp[-1].l); } #line 10990 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 460: #line 4710 "ProParser.y" /* yacc.c:1646 */ { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_ITERATIVELINEARSOLVER; Operation_P->Case.IterativeLinearSolver.OpMatMult = (yyvsp[-18].c); Operation_P->Case.IterativeLinearSolver.Type = (yyvsp[-16].c); Operation_P->Case.IterativeLinearSolver.Tolerance = (yyvsp[-14].d); Operation_P->Case.IterativeLinearSolver.MaxIter = (int)(yyvsp[-12].d); Operation_P->Case.IterativeLinearSolver.Restart = (int)(yyvsp[-10].d); Operation_P->Case.IterativeLinearSolver.MyFieldTag = (yyvsp[-8].l); Operation_P->Case.IterativeLinearSolver.NeighborFieldTag = (yyvsp[-6].l); Operation_P->Case.IterativeLinearSolver.DeflationIndices = (yyvsp[-4].l); Operation_P->Case.IterativeLinearSolver.Operations_Ax = (yyvsp[-1].l); Operation_P->Case.IterativeLinearSolver.Operations_Mx = NULL; } #line 11010 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 461: #line 4730 "ProParser.y" /* yacc.c:1646 */ { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_ITERATIVELINEARSOLVER; Operation_P->Case.IterativeLinearSolver.OpMatMult = (yyvsp[-21].c); Operation_P->Case.IterativeLinearSolver.Type = (yyvsp[-19].c); Operation_P->Case.IterativeLinearSolver.Tolerance = (yyvsp[-17].d); Operation_P->Case.IterativeLinearSolver.MaxIter = (int)(yyvsp[-15].d); Operation_P->Case.IterativeLinearSolver.Restart = (int)(yyvsp[-13].d); Operation_P->Case.IterativeLinearSolver.MyFieldTag = (yyvsp[-11].l); Operation_P->Case.IterativeLinearSolver.NeighborFieldTag = (yyvsp[-9].l); Operation_P->Case.IterativeLinearSolver.DeflationIndices = (yyvsp[-7].l); Operation_P->Case.IterativeLinearSolver.Operations_Ax = (yyvsp[-4].l); Operation_P->Case.IterativeLinearSolver.Operations_Mx = (yyvsp[-1].l); } #line 11030 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 462: #line 4747 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_PRINT; Operation_P->Case.Print.Expressions = NULL; Operation_P->DefineSystemIndex = -1; } #line 11041 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 464: #line 4756 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_WRITE; Operation_P->Case.Print.Expressions = NULL; Operation_P->DefineSystemIndex = -1; } #line 11052 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 466: #line 4765 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_CHANGEOFCOORDINATES; Operation_P->Case.ChangeOfCoordinates.GroupIndex = Num_Group(&Group_S, (char*)"OP_ChgCoord", (yyvsp[-4].i)); Operation_P->Case.ChangeOfCoordinates.ExpressionIndex = (yyvsp[-2].i); Operation_P->Case.ChangeOfCoordinates.ExpressionIndex2 = -1; } #line 11066 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 467: #line 4776 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_CHANGEOFCOORDINATES; Operation_P->Case.ChangeOfCoordinates.GroupIndex = Num_Group(&Group_S, (char*)"OP_ChgCoord", (yyvsp[-8].i)); Operation_P->Case.ChangeOfCoordinates.ExpressionIndex = (yyvsp[-6].i); Operation_P->Case.ChangeOfCoordinates.NumNode = (int)(yyvsp[-4].d); Operation_P->Case.ChangeOfCoordinates.ExpressionIndex2 = (yyvsp[-2].i); } #line 11081 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 468: #line 4788 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_POSTOPERATION; Operation_P->Case.PostOperation.PostOperations = List_Create(1,1,sizeof(char*)); List_Add(Operation_P->Case.PostOperation.PostOperations, &(yyvsp[-2].c)); } #line 11094 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 469: #line 4798 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SYSTEMCOMMAND; Operation_P->Case.SystemCommand.String = (yyvsp[-2].c); } #line 11105 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 470: #line 4806 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_ERROR; Operation_P->Case.Error.String = (yyvsp[-2].c); } #line 11116 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 471: #line 4814 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = (yyvsp[-4].i); Operation_P->Case.GmshRead.FileName = strSave(Fix_RelativePath((yyvsp[-2].c)).c_str()); Operation_P->Case.GmshRead.ViewTag = -1; Free((yyvsp[-2].c)); } #line 11129 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 472: #line 4824 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = (yyvsp[-6].i); Operation_P->Case.GmshRead.FileName = strSave(Fix_RelativePath((yyvsp[-4].c)).c_str()); Operation_P->Case.GmshRead.ViewTag = (int)(yyvsp[-2].d); Free((yyvsp[-4].c)); } #line 11142 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 473: #line 4834 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_GMSHCLEARALL; } #line 11152 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 474: #line 4841 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_DELETEFILE; Operation_P->Case.DeleteFile.FileName = strSave(Fix_RelativePath((yyvsp[-2].c)).c_str()); Free((yyvsp[-2].c)); } #line 11164 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 475: #line 4850 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_RENAMEFILE; Operation_P->Case.RenameFile.OldFileName = strSave(Fix_RelativePath((yyvsp[-4].c)).c_str()); Operation_P->Case.RenameFile.NewFileName = strSave(Fix_RelativePath((yyvsp[-2].c)).c_str()); Free((yyvsp[-4].c)); Free((yyvsp[-2].c)); } #line 11178 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 476: #line 4861 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_CREATEDIR; Operation_P->Case.CreateDir.DirName = strSave(Fix_RelativePath((yyvsp[-2].c)).c_str()); Free((yyvsp[-2].c)); } #line 11190 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 477: #line 4870 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SOLVEJACADAPTRELAX; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-6].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-6].c)); Free((yyvsp[-6].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.SolveJac_AdaptRelax.CheckAll = (int)(yyvsp[-2].d); Operation_P->Case.SolveJac_AdaptRelax.Factor_L = (yyvsp[-4].l); } #line 11207 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 478: #line 4884 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SAVESOLUTION_WITH_ENTITY_NUM; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-2].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-2].c)); Free((yyvsp[-2].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.SaveSolutionWithEntityNum.GroupIndex = -1; Operation_P->Case.SaveSolutionWithEntityNum.SaveFixed = -1; } #line 11224 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 479: #line 4898 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SAVESOLUTION_WITH_ENTITY_NUM; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-5].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-5].c)); Free((yyvsp[-5].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.SaveSolutionWithEntityNum.GroupIndex = Num_Group(&Group_S, (char*)"OP_SaveSolutionWithEntityNum", (yyvsp[-3].i)); Operation_P->Case.SaveSolutionWithEntityNum.SaveFixed = ((yyvsp[-2].i) >= 0) ? (yyvsp[-2].i) : 0; } #line 11242 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 480: #line 4913 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SAVESOLUTIONEXTENDEDMH; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-6].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-6].c)); Free((yyvsp[-6].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.SaveSolutionExtendedMH.NbrFreq = (int)(yyvsp[-4].d); Operation_P->Case.SaveSolutionExtendedMH.ResFile = (yyvsp[-2].c); } #line 11259 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 481: #line 4927 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SAVESOLUTIONMHTOTIME; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-6].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-6].c)); Free((yyvsp[-6].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.SaveSolutionMHtoTime.Time = (yyvsp[-4].l); Operation_P->Case.SaveSolutionMHtoTime.ResFile = (yyvsp[-2].c); } #line 11276 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 482: #line 4941 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Problem_S.Group, (yyvsp[-2].c), fcmp_Group_Name)) < 0) vyyerror("Unknown Group: %s", (yyvsp[-2].c)); Operation_P->Type = OPERATION_INIT_MOVINGBAND2D; Operation_P->Case.Init_MovingBand2D.GroupIndex = i; Free((yyvsp[-2].c)); } #line 11290 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 483: #line 4952 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Problem_S.Group, (yyvsp[-2].c), fcmp_Group_Name)) < 0) vyyerror("Unknown Group: %s", (yyvsp[-2].c)); Operation_P->Type = OPERATION_MESH_MOVINGBAND2D; Operation_P->Case.Mesh_MovingBand2D.GroupIndex = i; Free((yyvsp[-2].c)); } #line 11304 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 484: #line 4963 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-8].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-8].c)); Free((yyvsp[-8].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.SaveMesh.GroupIndex = Num_Group(&Group_S, (char*)"OP_SaveMesh", (yyvsp[-6].i)); Operation_P->Case.SaveMesh.FileName = (yyvsp[-4].c); Operation_P->Case.SaveMesh.ExprIndex = (yyvsp[-2].i); Operation_P->Type = OPERATION_SAVEMESH; } #line 11322 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 485: #line 4978 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-6].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-6].c)); Free((yyvsp[-6].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.SaveMesh.GroupIndex = Num_Group(&Group_S, (char*)"OP_SaveMesh", (yyvsp[-4].i)); Operation_P->Case.SaveMesh.FileName = (yyvsp[-2].c); Operation_P->Case.SaveMesh.ExprIndex = -1; Operation_P->Type = OPERATION_SAVEMESH; } #line 11340 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 486: #line 4994 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-10].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-10].c)); Free((yyvsp[-10].c)); Operation_P->DefineSystemIndex = i; if((i = List_ISearchSeq(Problem_S.Group, (yyvsp[-8].c), fcmp_Group_Name)) < 0) vyyerror("Unknown Group: %s", (yyvsp[-8].c)); Free((yyvsp[-8].c)); Operation_P->Type = OPERATION_GENERATE_MH_MOVING; Operation_P->Case.Generate_MH_Moving.GroupIndex = i; Operation_P->Case.Generate_MH_Moving.Period = (yyvsp[-6].d); Operation_P->Case.Generate_MH_Moving.NbrStep = (int)(yyvsp[-4].d); Operation_P->Case.Generate_MH_Moving.Operation = (yyvsp[-1].l); } #line 11362 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 487: #line 5014 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-10].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-10].c)); Free((yyvsp[-10].c)); Operation_P->DefineSystemIndex = i; if((i = List_ISearchSeq(Problem_S.Group, (yyvsp[-8].c), fcmp_Group_Name)) < 0) vyyerror("Unknown Group: %s", (yyvsp[-8].c)); Free((yyvsp[-8].c)); Operation_P->Type = OPERATION_GENERATE_MH_MOVING_S; Operation_P->Case.Generate_MH_Moving_S.GroupIndex = i; Operation_P->Case.Generate_MH_Moving_S.Period = (yyvsp[-6].d); Operation_P->Case.Generate_MH_Moving_S.NbrStep = (int)(yyvsp[-4].d); Operation_P->Case.Generate_MH_Moving_S.Operation = (yyvsp[-1].l); } #line 11384 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 488: #line 5033 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-2].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-2].c)); Free((yyvsp[-2].c)); Operation_P->DefineSystemIndex = i; Operation_P->Type = OPERATION_ADDMHMOVING; } #line 11399 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 489: #line 5046 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-11].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-11].c)); Free((yyvsp[-11].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.DeformeMesh.Quantity = (yyvsp[-9].c); Operation_P->Case.DeformeMesh.Name_MshFile = (yyvsp[-6].c); Operation_P->Case.DeformeMesh.GeoDataIndex = -1; Operation_P->Case.DeformeMesh.Factor = (yyvsp[-4].d); Operation_P->Case.DeformeMesh.GroupIndex = Num_Group(&Group_S, (char*)"OP_DeformMesh", (yyvsp[-2].i)); Operation_P->Type = OPERATION_DEFORMEMESH; } #line 11420 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 490: #line 5065 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-9].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-9].c)); Free((yyvsp[-9].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.DeformeMesh.Quantity = (yyvsp[-7].c); Operation_P->Case.DeformeMesh.Name_MshFile = (yyvsp[-4].c); Operation_P->Case.DeformeMesh.GeoDataIndex = -1; Operation_P->Case.DeformeMesh.Factor = (yyvsp[-2].d); Operation_P->Case.DeformeMesh.GroupIndex = -1; Operation_P->Type = OPERATION_DEFORMEMESH; } #line 11440 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 491: #line 5082 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-7].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-7].c)); Free((yyvsp[-7].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.DeformeMesh.Quantity = (yyvsp[-5].c); Operation_P->Case.DeformeMesh.Name_MshFile = (yyvsp[-2].c); Operation_P->Case.DeformeMesh.GeoDataIndex = -1; Operation_P->Case.DeformeMesh.Factor = 1; Operation_P->Case.DeformeMesh.GroupIndex = -1; Operation_P->Type = OPERATION_DEFORMEMESH; } #line 11460 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 492: #line 5099 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-4].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-4].c)); Free((yyvsp[-4].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.DeformeMesh.Quantity = (yyvsp[-2].c); Operation_P->Case.DeformeMesh.Name_MshFile = NULL; Operation_P->Case.DeformeMesh.GeoDataIndex = -1; Operation_P->Case.DeformeMesh.Factor = 1; Operation_P->Case.DeformeMesh.GroupIndex = -1; Operation_P->Type = OPERATION_DEFORMEMESH; } #line 11480 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 493: #line 5116 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-6].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-6].c)); Free((yyvsp[-6].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.DeformeMesh.Quantity = (yyvsp[-4].c); Operation_P->Case.DeformeMesh.Name_MshFile = NULL; Operation_P->Case.DeformeMesh.GeoDataIndex = -1; Operation_P->Case.DeformeMesh.Factor = (yyvsp[-2].d); Operation_P->Case.DeformeMesh.GroupIndex = -1; Operation_P->Type = OPERATION_DEFORMEMESH; } #line 11500 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 494: #line 5133 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-8].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-8].c)); Free((yyvsp[-8].c)); Operation_P->DefineSystemIndex = i; Operation_P->Case.DeformeMesh.Quantity = (yyvsp[-6].c); Operation_P->Case.DeformeMesh.Name_MshFile = NULL; Operation_P->Case.DeformeMesh.GeoDataIndex = -1; Operation_P->Case.DeformeMesh.Factor = (yyvsp[-4].d); Operation_P->Case.DeformeMesh.GroupIndex = Num_Group(&Group_S, (char*)"OP_DeformMesh", (yyvsp[-2].i)); Operation_P->Type = OPERATION_DEFORMEMESH; } #line 11521 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 495: #line 5151 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-4].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-4].c)); Free((yyvsp[-4].c)); Operation_P->DefineSystemIndex = i; Operation_P->Type = (yyvsp[-6].i); Operation_P->Case.Generate.GroupIndex = Num_Group(&Group_S, (char*)"OP_GenerateGroup", (yyvsp[-2].i)); } #line 11538 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 496: #line 5165 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SOLVEAGAINWITHOTHER; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-4].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-4].c)); Free((yyvsp[-4].c)); Operation_P->DefineSystemIndex = i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-2].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-2].c)); Free((yyvsp[-2].c)); Operation_P->Case.SolveAgainWithOther.DefineSystemIndex = i; } #line 11558 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 497: #line 5182 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SETGLOBALSOLVEROPTIONS; Operation_P->Case.SetGlobalSolverOptions.String = (yyvsp[-2].c); } #line 11568 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 498: #line 5189 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = NONE; } #line 11578 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 499: #line 5198 "ProParser.y" /* yacc.c:1646 */ { Operation_P->Case.Print.Expressions = List_Copy(ListOfInt_L); } #line 11586 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 500: #line 5203 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[0].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[0].c)); Free((yyvsp[0].c)); Operation_P->DefineSystemIndex = i; } #line 11599 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 501: #line 5215 "ProParser.y" /* yacc.c:1646 */ { Operation_P->Case.Print.FileOut = NULL; Operation_P->Case.Print.TimeStep = NULL; Operation_P->Case.Print.DofNumber = NULL; Operation_P->Case.Print.FormatString = NULL; } #line 11610 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 503: #line 5226 "ProParser.y" /* yacc.c:1646 */ { Operation_P->Case.Print.FileOut = (yyvsp[0].c); } #line 11616 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 504: #line 5229 "ProParser.y" /* yacc.c:1646 */ { Operation_P->Case.Print.TimeStep = List_Create(List_Nbr((yyvsp[0].l)), 1, sizeof(int)); for(int i = 0; i < List_Nbr((yyvsp[0].l)); i++){ double d; List_Read((yyvsp[0].l),i,&d); int j = (int)d; List_Add(Operation_P->Case.Print.TimeStep, &j); } List_Delete((yyvsp[0].l)); } #line 11631 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 505: #line 5241 "ProParser.y" /* yacc.c:1646 */ { Operation_P->Case.Print.FormatString = (yyvsp[0].c); } #line 11639 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 506: #line 5246 "ProParser.y" /* yacc.c:1646 */ { Operation_P->Case.Print.DofNumber = List_Create(List_Nbr((yyvsp[0].l)), 1, sizeof(int)); for(int i = 0; i < List_Nbr((yyvsp[0].l)); i++) { double d; List_Read((yyvsp[0].l), i, &d); int j = (int)d; List_Add(Operation_P->Case.Print.DofNumber, &j); } List_Delete((yyvsp[0].l)); } #line 11654 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 507: #line 5261 "ProParser.y" /* yacc.c:1646 */ { Operation_P->Case.TimeLoopAdaptive.LTEtarget = -1.; Operation_P->Case.TimeLoopAdaptive.DTimeMaxScal = -1.; Operation_P->Case.TimeLoopAdaptive.DTimeScal_NotConverged = -1.; } #line 11664 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 508: #line 5268 "ProParser.y" /* yacc.c:1646 */ { Operation_P->Case.TimeLoopAdaptive.LTEtarget = (yyvsp[0].d); Operation_P->Case.TimeLoopAdaptive.DTimeMaxScal = -1.; Operation_P->Case.TimeLoopAdaptive.DTimeScal_NotConverged = -1.; } #line 11674 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 509: #line 5275 "ProParser.y" /* yacc.c:1646 */ { Operation_P->Case.TimeLoopAdaptive.LTEtarget = (yyvsp[-2].d); Operation_P->Case.TimeLoopAdaptive.DTimeMaxScal = (yyvsp[0].d); Operation_P->Case.TimeLoopAdaptive.DTimeScal_NotConverged = -1.; } #line 11684 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 510: #line 5282 "ProParser.y" /* yacc.c:1646 */ { Operation_P->Case.TimeLoopAdaptive.LTEtarget = (yyvsp[-4].d); Operation_P->Case.TimeLoopAdaptive.DTimeMaxScal = (yyvsp[-2].d); Operation_P->Case.TimeLoopAdaptive.DTimeScal_NotConverged = (yyvsp[0].d); } #line 11694 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 511: #line 5292 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopAdaptive.TimeLoopAdaptiveSystems_L = NULL; Operation_P->Case.TimeLoopAdaptive.TimeLoopAdaptivePOs_L = NULL; } #line 11705 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 512: #line 5300 "ProParser.y" /* yacc.c:1646 */ { Operation_P->Case.TimeLoopAdaptive.TimeLoopAdaptiveSystems_L = (yyvsp[-1].l); } #line 11713 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 513: #line 5305 "ProParser.y" /* yacc.c:1646 */ { Operation_P->Case.TimeLoopAdaptive.TimeLoopAdaptivePOs_L = (yyvsp[-1].l); } #line 11721 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 514: #line 5314 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(4, 4, sizeof(struct TimeLoopAdaptiveSystem)); } #line 11729 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 515: #line 5319 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-7].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-7].c)); TimeLoopAdaptiveSystem_S.SystemIndex = i; TimeLoopAdaptiveSystem_S.SystemLTEreltol = (yyvsp[-5].d); TimeLoopAdaptiveSystem_S.SystemLTEabstol = (yyvsp[-3].d); TimeLoopAdaptiveSystem_S.NormType = Get_DefineForString(ErrorNorm_Type, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), ErrorNorm_Type); vyyerror("Unknown error norm type of TimeLoopAdaptive system %s", (yyvsp[-7].c)); } TimeLoopAdaptiveSystem_S.NormTypeString = (yyvsp[-1].c); List_Add((yyval.l) = (yyvsp[-9].l), &TimeLoopAdaptiveSystem_S); Free((yyvsp[-7].c)); } #line 11750 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 516: #line 5339 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(4, 4, sizeof(struct LoopErrorPostOperation)); } #line 11758 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 517: #line 5344 "ProParser.y" /* yacc.c:1646 */ { TimeLoopAdaptivePO_S.PostOperationName = (yyvsp[-7].c); TimeLoopAdaptivePO_S.PostOperationReltol = (yyvsp[-5].d); TimeLoopAdaptivePO_S.PostOperationAbstol = (yyvsp[-3].d); TimeLoopAdaptivePO_S.NormType = Get_DefineForString(ErrorNorm_Type, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), ErrorNorm_Type); vyyerror("Unknown error norm type of TimeLoopAdaptive PostOperation %s", (yyvsp[-7].c)); } TimeLoopAdaptivePO_S.NormTypeString = (yyvsp[-1].c); List_Add((yyval.l) = (yyvsp[-9].l), &TimeLoopAdaptivePO_S); } #line 11775 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 518: #line 5360 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeLoop.IterativeLoopSystems_L = NULL; Operation_P->Case.IterativeLoop.IterativeLoopPOs_L = NULL; } #line 11786 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 519: #line 5368 "ProParser.y" /* yacc.c:1646 */ { Operation_P->Case.IterativeLoop.IterativeLoopSystems_L = (yyvsp[-1].l); } #line 11794 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 520: #line 5373 "ProParser.y" /* yacc.c:1646 */ { Operation_P->Case.IterativeLoop.IterativeLoopPOs_L = (yyvsp[-1].l); } #line 11802 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 521: #line 5382 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(4, 4, sizeof(struct IterativeLoopSystem)); } #line 11810 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 522: #line 5387 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-8].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-8].c)); IterativeLoopSystem_S.SystemIndex = i; IterativeLoopSystem_S.SystemILreltol = (yyvsp[-6].d); IterativeLoopSystem_S.SystemILabstol = (yyvsp[-4].d); IterativeLoopSystem_S.NormOf = Get_DefineForString(NormOf_Type, (yyvsp[-2].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-8].c), ChangeOfState_Type); vyyerror("Unknown object for error norm of IterativeLoop system: %s", (yyvsp[-8].c)); } IterativeLoopSystem_S.NormOfString = (yyvsp[-2].c); IterativeLoopSystem_S.NormType = Get_DefineForString(ErrorNorm_Type, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), ErrorNorm_Type); vyyerror("Unknown error norm type of IterativeLoop system: %s", (yyvsp[-8].c)); } IterativeLoopSystem_S.NormTypeString = (yyvsp[-1].c); List_Add((yyval.l) = (yyvsp[-10].l), &IterativeLoopSystem_S); Free((yyvsp[-8].c)); } #line 11837 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 523: #line 5414 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(4, 4, sizeof(struct LoopErrorPostOperation)); } #line 11845 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 524: #line 5419 "ProParser.y" /* yacc.c:1646 */ { IterativeLoopPO_S.PostOperationName = (yyvsp[-7].c); IterativeLoopPO_S.PostOperationReltol = (yyvsp[-5].d); IterativeLoopPO_S.PostOperationAbstol = (yyvsp[-3].d); IterativeLoopPO_S.NormType = Get_DefineForString(ErrorNorm_Type, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), ErrorNorm_Type); vyyerror("Unknown error norm type of IterativeLoopN PostOperation %s", (yyvsp[-7].c)); } IterativeLoopPO_S.NormTypeString = (yyvsp[-1].c); List_Add((yyval.l) = (yyvsp[-9].l), &IterativeLoopPO_S); } #line 11862 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 525: #line 5439 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopTheta.Time0 = 0.; Operation_P->Case.TimeLoopTheta.TimeMax = 1.; Operation_P->Case.TimeLoopTheta.DTimeIndex = -1; Operation_P->Case.TimeLoopTheta.ThetaIndex = -1; Operation_P->Case.TimeLoopTheta.Operation = NULL; } #line 11875 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 527: #line 5455 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopTheta.Time0 = (yyvsp[-1].d); } #line 11883 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 528: #line 5459 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopTheta.TimeMax = (yyvsp[-1].d); } #line 11891 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 529: #line 5463 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopTheta.DTimeIndex = (yyvsp[-1].i); } #line 11899 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 530: #line 5467 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopTheta.ThetaIndex = (yyvsp[-1].i); } #line 11907 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 531: #line 5472 "ProParser.y" /* yacc.c:1646 */ { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopTheta.Operation = (yyvsp[-1].l); } #line 11917 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 532: #line 5483 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopNewmark.Time0 = 0.; Operation_P->Case.TimeLoopNewmark.TimeMax = 1.; Operation_P->Case.TimeLoopNewmark.DTimeIndex = -1; Operation_P->Case.TimeLoopNewmark.Beta = 0.25; Operation_P->Case.TimeLoopNewmark.Gamma = 0.5; Operation_P->Case.TimeLoopNewmark.Operation = NULL; } #line 11931 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 534: #line 5500 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopNewmark.Time0 = (yyvsp[-1].d); } #line 11939 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 535: #line 5504 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopNewmark.TimeMax = (yyvsp[-1].d); } #line 11947 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 536: #line 5508 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopNewmark.DTimeIndex = (yyvsp[-1].i); } #line 11955 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 537: #line 5512 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopNewmark.Beta = (yyvsp[-1].d); } #line 11963 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 538: #line 5516 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopNewmark.Gamma = (yyvsp[-1].d); } #line 11971 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 539: #line 5521 "ProParser.y" /* yacc.c:1646 */ { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopNewmark.Operation = (yyvsp[-1].l); } #line 11981 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 540: #line 5532 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeLoop.NbrMaxIteration = 20; Operation_P->Case.IterativeLoop.Criterion = 1.e-3; Operation_P->Case.IterativeLoop.RelaxationFactorIndex = -1; Operation_P->Case.IterativeLoop.Flag = 0; Operation_P->Case.IterativeLoop.Operation = NULL; } #line 11994 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 542: #line 5547 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeLoop.NbrMaxIteration = (int)(yyvsp[-1].d); } #line 12002 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 543: #line 5551 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeLoop.Criterion = (yyvsp[-1].d); } #line 12010 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 544: #line 5555 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeLoop.RelaxationFactorIndex = (yyvsp[-1].i); } #line 12018 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 545: #line 5559 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeLoop.Flag = (int)(yyvsp[-1].d); } #line 12026 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 546: #line 5563 "ProParser.y" /* yacc.c:1646 */ { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeLoop.Operation = (yyvsp[-1].l); } #line 12036 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 547: #line 5574 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeTimeReduction.NbrMaxIteration = 20; Operation_P->Case.IterativeTimeReduction.DivisionCoefficient = 2.; Operation_P->Case.IterativeTimeReduction.Criterion = 1.e-3; Operation_P->Case.IterativeTimeReduction.Flag = 0; Current_System = Operation_P->DefineSystemIndex = -1; Operation_P->Case.IterativeTimeReduction.ChangeOfState = NULL; Operation_P->Case.IterativeTimeReduction.Operation = NULL; Operation_P->Case.IterativeTimeReduction.OperationEnd = NULL; } #line 12052 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 549: #line 5592 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeTimeReduction.NbrMaxIteration = (int)(yyvsp[-1].d); } #line 12060 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 550: #line 5596 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeTimeReduction.DivisionCoefficient = (yyvsp[-1].d); } #line 12068 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 551: #line 5600 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeTimeReduction.Criterion = (yyvsp[-1].d); } #line 12076 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 552: #line 5604 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeTimeReduction.Flag = (int)(yyvsp[-1].d); } #line 12084 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 553: #line 5609 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, (yyvsp[-1].c), fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", (yyvsp[-1].c)); Free((yyvsp[-1].c)); Current_System = Operation_P->DefineSystemIndex = i; } #line 12098 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 554: #line 5620 "ProParser.y" /* yacc.c:1646 */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeTimeReduction.ChangeOfState = (yyvsp[-1].l); } #line 12107 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 555: #line 5626 "ProParser.y" /* yacc.c:1646 */ { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeTimeReduction.Operation = (yyvsp[-1].l); } #line 12117 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 556: #line 5632 "ProParser.y" /* yacc.c:1646 */ { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeTimeReduction.OperationEnd = (yyvsp[-1].l); } #line 12127 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 557: #line 5642 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(3, 3, sizeof (struct ChangeOfState)); } #line 12133 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 558: #line 5645 "ProParser.y" /* yacc.c:1646 */ { List_Add((yyval.l) = (yyvsp[-3].l), &ChangeOfState_S); } #line 12139 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 559: #line 5650 "ProParser.y" /* yacc.c:1646 */ { ChangeOfState_S.Type = CHANGEOFSTATE_CHANGESIGN; ChangeOfState_S.QuantityIndex = -1; ChangeOfState_S.FormulationIndex = -1; ChangeOfState_S.InIndex = -1; ChangeOfState_S.Criterion = 1.e-2; ChangeOfState_S.ExpressionIndex = ChangeOfState_S.ExpressionIndex2 = -1; ChangeOfState_S.FlagIndex = -1; ChangeOfState_S.ActiveList[0] = NULL; ChangeOfState_S.ActiveList[1] = NULL; } #line 12155 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 561: #line 5668 "ProParser.y" /* yacc.c:1646 */ { ChangeOfState_S.Type = Get_DefineForString(ChangeOfState_Type, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), ChangeOfState_Type); vyyerror("Unknown type of ChangeOfState: %s", (yyvsp[-1].c)); } Free((yyvsp[-1].c)); } #line 12168 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 562: #line 5678 "ProParser.y" /* yacc.c:1646 */ { if(Current_System >= 0) { List_T *ListOfInt_Lnew = ((struct DefineSystem *)List_Pointer(Resolution_S.DefineSystem, Current_System))->FormulationIndex; int *ListOfInt_P =(int *)List_Pointer(ListOfInt_Lnew, 0); int i = 0, j; for(j = 0; j < List_Nbr(ListOfInt_Lnew); j++) { Formulation_S.DefineQuantity = ((struct Formulation *) List_Pointer(Problem_S.Formulation, ListOfInt_P[j]))->DefineQuantity; if((i = List_ISearchSeq(Formulation_S.DefineQuantity, (yyvsp[-1].c), fcmp_DefineQuantity_Name)) >= 0) break; } if(j= 0) j = ((struct DefineQuantity *) List_Pointer (((struct Formulation *) List_Pointer(Problem_S.Formulation, PostProcessing_S.FormulationIndex))->DefineQuantity, PostQuantityTerm_S.QuantityIndexTable[i])) -> Type; if(PostQuantityTerm_S.Type == 0) PostQuantityTerm_S.Type = j; else if(PostQuantityTerm_S.Type != j) vyyerror("Mixed discrete Quantity types in term (should be split in separate terms)"); } if(PostQuantityTerm_S.Type == 0) PostQuantityTerm_S.Type = LOCALQUANTITY; } } #line 12435 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 592: #line 5913 "ProParser.y" /* yacc.c:1646 */ { /* force the Type */ PostQuantityTerm_S.Type = Get_DefineForString(DefineQuantity_Type, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), DefineQuantity_Type); vyyerror("Unknown type of Operation: %s", (yyvsp[-1].c)); } Free((yyvsp[-1].c)); } #line 12449 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 593: #line 5924 "ProParser.y" /* yacc.c:1646 */ { PostQuantityTerm_S.InIndex = Num_Group(&Group_S, (char*)"PQ_In", (yyvsp[-1].i)); } #line 12457 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 594: #line 5929 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Problem_S.JacobianMethod, (yyvsp[-1].c), fcmp_JacobianMethod_Name)) < 0) vyyerror("Unknown Jacobian method: %s",(yyvsp[-1].c)); else PostQuantityTerm_S.JacobianMethodIndex = i; Free((yyvsp[-1].c)); } #line 12471 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 595: #line 5940 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Problem_S.IntegrationMethod, (yyvsp[-1].c), fcmp_IntegrationMethod_Name)) < 0) vyyerror("Unknown Integration method: %s",(yyvsp[-1].c)); else PostQuantityTerm_S.IntegrationMethodIndex = i; Free((yyvsp[-1].c)); } #line 12485 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 596: #line 5959 "ProParser.y" /* yacc.c:1646 */ { if(!Problem_S.PostOperation) Problem_S.PostOperation = List_Create(10, 5, sizeof (struct PostOperation)); } #line 12495 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 598: #line 5971 "ProParser.y" /* yacc.c:1646 */ { List_Add(Problem_S.PostOperation, &PostOperation_S); } #line 12501 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 600: #line 5978 "ProParser.y" /* yacc.c:1646 */ { PostOperation_S.Name = NULL; PostOperation_S.Hidden = false; PostOperation_S.AppendString = NULL; PostOperation_S.Format = FORMAT_GMSH; PostOperation_S.PostProcessingIndex = -1; PostOperation_S.ResampleTime = false; PostOperation_S.TimeValue_L = NULL; PostOperation_S.TimeImagValue_L = NULL; PostOperation_S.LastTimeStepOnly = 0; PostOperation_S.OverrideTimeStepValue = -1; PostOperation_S.NoMesh = 0; PostOperation_S.CatFile = 0; } #line 12520 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 602: #line 5998 "ProParser.y" /* yacc.c:1646 */ { Check_NameOfStructNotExist("PostOperation", Problem_S.PostOperation, (yyvsp[-1].c), fcmp_PostOperation_Name); PostOperation_S.Name = (yyvsp[-1].c); } #line 12530 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 603: #line 6004 "ProParser.y" /* yacc.c:1646 */ { PostOperation_S.Hidden = (yyvsp[-1].d) ? true : false; } #line 12536 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 604: #line 6007 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(Problem_S.PostProcessing, (yyvsp[-1].c), fcmp_PostProcessing_Name)) < 0) vyyerror("Unknown PostProcessing: %s", (yyvsp[-1].c)); else { PostOperation_S.PostProcessingIndex = i; List_Read(Problem_S.PostProcessing, i, &InteractivePostProcessing_S); } Free((yyvsp[-1].c)); } #line 12552 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 605: #line 6020 "ProParser.y" /* yacc.c:1646 */ { PostOperation_S.Format = Get_DefineForString(PostSubOperation_Format, (yyvsp[-1].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[-1].c), PostSubOperation_Format); vyyerror("Unknown PostProcessing Format: %s", (yyvsp[-1].c)); } Free((yyvsp[-1].c)); } #line 12566 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 606: #line 6031 "ProParser.y" /* yacc.c:1646 */ { PostOperation_S.TimeValue_L = (yyvsp[-1].l); } #line 12574 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 607: #line 6036 "ProParser.y" /* yacc.c:1646 */ { PostOperation_S.TimeImagValue_L = (yyvsp[-1].l); } #line 12582 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 608: #line 6041 "ProParser.y" /* yacc.c:1646 */ { PostOperation_S.LastTimeStepOnly = 1; } #line 12590 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 609: #line 6046 "ProParser.y" /* yacc.c:1646 */ { PostOperation_S.AppendString = (yyvsp[-1].c); } #line 12598 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 610: #line 6051 "ProParser.y" /* yacc.c:1646 */ { PostOperation_S.CatFile = (yyvsp[-1].d); } #line 12606 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 611: #line 6056 "ProParser.y" /* yacc.c:1646 */ { PostOperation_S.NoMesh = (yyvsp[-1].d); } #line 12614 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 612: #line 6061 "ProParser.y" /* yacc.c:1646 */ { PostOperation_S.OverrideTimeStepValue = (yyvsp[-1].d); } #line 12622 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 613: #line 6066 "ProParser.y" /* yacc.c:1646 */ { PostOperation_S.ResampleTime = true; PostOperation_S.ResampleTimeStart = (yyvsp[-6].d); PostOperation_S.ResampleTimeStop = (yyvsp[-4].d); PostOperation_S.ResampleTimeStep = (yyvsp[-2].d); } #line 12633 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 614: #line 6074 "ProParser.y" /* yacc.c:1646 */ { PostOperation_S.PostSubOperation = (yyvsp[-1].l); } #line 12641 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 616: #line 6084 "ProParser.y" /* yacc.c:1646 */ { PostOperation_S.Hidden = false; PostOperation_S.AppendString = NULL; PostOperation_S.Format = FORMAT_GMSH; PostOperation_S.PostProcessingIndex = -1; PostOperation_S.ResampleTime = false; PostOperation_S.TimeValue_L = NULL; PostOperation_S.TimeImagValue_L = NULL; PostOperation_S.LastTimeStepOnly = 0; PostOperation_S.OverrideTimeStepValue = -1; PostOperation_S.NoMesh = 0; int i; if((i = List_ISearchSeq(Problem_S.PostProcessing, (yyvsp[0].c), fcmp_PostProcessing_Name)) < 0) vyyerror("Unknown PostProcessing: %s", (yyvsp[0].c)); else { PostOperation_S.PostProcessingIndex = i; List_Read(Problem_S.PostProcessing, i, &InteractivePostProcessing_S); if(!Problem_S.PostOperation) Problem_S.PostOperation = List_Create(5, 5, sizeof (struct PostOperation)); PostOperation_S.Name = (yyvsp[-2].c); } Free((yyvsp[0].c)); } #line 12670 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 617: #line 6109 "ProParser.y" /* yacc.c:1646 */ { PostOperation_S.PostSubOperation = (yyvsp[-1].l); if(PostOperation_S.PostProcessingIndex >= 0) List_Add(Problem_S.PostOperation, &PostOperation_S); } #line 12680 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 618: #line 6119 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(5, 5, sizeof (struct PostSubOperation)); } #line 12686 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 619: #line 6122 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Format = -1; PostSubOperation_S.FileOut = NULL; PostSubOperation_S.Depth = 1; PostSubOperation_S.Smoothing = 0; PostSubOperation_S.Skin = 0; PostSubOperation_S.Comma = 0; PostSubOperation_S.Dimension = _ALL; PostSubOperation_S.Adapt = 0; PostSubOperation_S.Target = -1.; PostSubOperation_S.HarmonicToTime = 1; PostSubOperation_S.FourierTransform = 0; PostSubOperation_S.FrozenTimeStepList = 0; PostSubOperation_S.TimeStep_L = List_Create(10,10,sizeof(int));; PostSubOperation_S.Frequency_L = List_Create(10,10,sizeof(double));; PostSubOperation_S.Value_L = List_Create(10,10,sizeof(double));; PostSubOperation_S.Iso = 0; PostSubOperation_S.Iso_L = List_Create(10,10,sizeof(double));; PostSubOperation_S.Sort = 0; PostSubOperation_S.NoNewLine = 0; PostSubOperation_S.NoTitle = 0; PostSubOperation_S.DecomposeInSimplex = 0; PostSubOperation_S.NewCoordinates = 0; PostSubOperation_S.NewCoordinatesFile = NULL; PostSubOperation_S.ChangeOfCoordinates[0] = -1; PostSubOperation_S.ChangeOfCoordinates[1] = -1; PostSubOperation_S.ChangeOfCoordinates[2] = -1; PostSubOperation_S.ChangeOfValues = NULL; PostSubOperation_S.Legend = LEGEND_NONE; PostSubOperation_S.LegendPosition[0] = 0.; PostSubOperation_S.LegendPosition[1] = 0.; PostSubOperation_S.LegendPosition[2] = 0.; PostSubOperation_S.EvaluationPoints = NULL; PostSubOperation_S.StoreInVariable = NULL; PostSubOperation_S.StoreInRegister = -1; PostSubOperation_S.StoreMinInRegister = -1; PostSubOperation_S.StoreMinXinRegister = -1; PostSubOperation_S.StoreMinYinRegister = -1; PostSubOperation_S.StoreMinZinRegister = -1; PostSubOperation_S.StoreMaxInRegister = -1; PostSubOperation_S.StoreMaxXinRegister = -1; PostSubOperation_S.StoreMaxYinRegister = -1; PostSubOperation_S.StoreMaxZinRegister = -1; PostSubOperation_S.StoreInField = -1; PostSubOperation_S.StoreInMeshBasedField = -1; PostSubOperation_S.LastTimeStepOnly = 0; PostSubOperation_S.AppendTimeStepToFileName = 0; PostSubOperation_S.AppendExpressionToFileName = -1; PostSubOperation_S.AppendExpressionFormat = NULL; PostSubOperation_S.AppendStringToFileName = NULL; PostSubOperation_S.OverrideTimeStepValue = -1; PostSubOperation_S.NoMesh = 0; PostSubOperation_S.CatFile = 0; PostSubOperation_S.SendToServer = NULL; PostSubOperation_S.Color = NULL; PostSubOperation_S.ValueIndex = 0; PostSubOperation_S.ValueName = NULL; PostSubOperation_S.Label = NULL; PostSubOperation_S.TimeValue_L = NULL; PostSubOperation_S.TimeImagValue_L = NULL; } #line 12752 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 620: #line 6184 "ProParser.y" /* yacc.c:1646 */ { if(PostSubOperation_S.Type != POP_NONE) { if(PostSubOperation_S.Format < 0) PostSubOperation_S.Format = PostOperation_S.Format; if(!PostSubOperation_S.TimeValue_L) PostSubOperation_S.TimeValue_L = PostOperation_S.TimeValue_L; if(!PostSubOperation_S.TimeImagValue_L) PostSubOperation_S.TimeImagValue_L = PostOperation_S.TimeImagValue_L; if(!PostSubOperation_S.LastTimeStepOnly) PostSubOperation_S.LastTimeStepOnly = PostOperation_S.LastTimeStepOnly; if(!PostSubOperation_S.NoMesh) PostSubOperation_S.NoMesh = PostOperation_S.NoMesh; if(PostSubOperation_S.OverrideTimeStepValue < 0) PostSubOperation_S.OverrideTimeStepValue = PostOperation_S.OverrideTimeStepValue; if(!PostSubOperation_S.CatFile) PostSubOperation_S.CatFile = PostOperation_S.CatFile; List_Add((yyval.l) = (yyvsp[-2].l), &PostSubOperation_S); } } #line 12777 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 621: #line 6210 "ProParser.y" /* yacc.c:1646 */ { vyyerror("Plot has been superseded by Print (Plot OnRegion becomes Print OnElementsOf)"); } #line 12785 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 622: #line 6215 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Type = POP_PRINT; } #line 12793 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 623: #line 6220 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Type = POP_EXPRESSION; PostSubOperation_S.Case.Expression.String = (yyvsp[-5].c); PostSubOperation_S.Case.Expression.String2 = NULL; PostSubOperation_S.Case.Expression.ExpressionIndex = (yyvsp[-3].i); PostSubOperation_S.PostQuantityIndex[0] = -1; } #line 12805 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 624: #line 6229 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Type = POP_EXPRESSION; PostSubOperation_S.Case.Expression.String = (yyvsp[-8].c); PostSubOperation_S.Case.Expression.String2 = (yyvsp[-4].c); PostSubOperation_S.Case.Expression.ExpressionIndex = -1; PostSubOperation_S.PostQuantityIndex[0] = -1; } #line 12817 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 625: #line 6238 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Type = POP_EXPRESSION; PostSubOperation_S.Case.Expression.String = (yyvsp[-3].c); PostSubOperation_S.Case.Expression.String2 = NULL; PostSubOperation_S.Case.Expression.ExpressionIndex = -1; PostSubOperation_S.PostQuantityIndex[0] = -1; } #line 12829 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 626: #line 6247 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Type = POP_GROUP; PostSubOperation_S.Case.Group.ExtendedGroupIndex = Num_Group(&Group_S, (char*)"PO_Group", (yyvsp[0].i)); PostSubOperation_S.PostQuantityIndex[0] = -1; } #line 12840 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 627: #line 6254 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Case.Group.GroupIndex = Num_Group(&Group_S, (char*)"PO_Group", (yyvsp[-3].i)); } #line 12849 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 628: #line 6260 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Type = POP_MERGE; PostSubOperation_S.FileOut = (yyvsp[-2].c); } #line 12858 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 629: #line 6266 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Type = POP_NONE; } #line 12866 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 630: #line 6275 "ProParser.y" /* yacc.c:1646 */ { int i; if((i = List_ISearchSeq(InteractivePostProcessing_S.PostQuantity, (yyvsp[-2].c), fcmp_PostQuantity_Name)) < 0) vyyerror("Unknown PostProcessing Quantity: %s", (yyvsp[-2].c)); PostSubOperation_S.PostQuantityIndex[0] = i; PostSubOperation_S.PostQuantityIndex[1] = -1; PostSubOperation_S.PostQuantitySupport[0] = (yyvsp[-1].i); PostSubOperation_S.PostQuantitySupport[1] = -1; Free((yyvsp[-2].c)); } #line 12882 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 631: #line 6288 "ProParser.y" /* yacc.c:1646 */ { Message::Warning("Combined post-quantities are deprecated: use registers instead"); int i; if((i = List_ISearchSeq(InteractivePostProcessing_S.PostQuantity, (yyvsp[-5].c), fcmp_PostQuantity_Name)) < 0) vyyerror("Unknown PostProcessing Quantity: %s", (yyvsp[-5].c)); PostSubOperation_S.PostQuantityIndex[0] = i; PostSubOperation_S.PostQuantitySupport[0] = (yyvsp[-4].i); int j = -1; if((j = List_ISearchSeq(InteractivePostProcessing_S.PostQuantity, (yyvsp[-2].c), fcmp_PostQuantity_Name)) < 0) vyyerror("Unknown PostProcessing Quantity: %s", (yyvsp[-2].c)); PostSubOperation_S.PostQuantityIndex[1] = j; PostSubOperation_S.PostQuantitySupport[1] = (yyvsp[-1].i); if(((yyvsp[-4].i) < 0 && (yyvsp[-1].i) < 0) || ((yyvsp[-4].i) >= 0 && (yyvsp[-1].i) >= 0)) { vyyerror("Postprocessing Quantities '%s' and '%s' of same type (%s)", (yyvsp[-5].c), (yyvsp[-2].c), ((yyvsp[-4].i)>0)? "with Support":"without Support"); } Free((yyvsp[-5].c)); Free((yyvsp[-2].c)); } #line 12908 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 632: #line 6313 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.CombinationType = MULTIPLICATION; } #line 12914 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 633: #line 6314 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.CombinationType = DIVISION; } #line 12920 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 634: #line 6315 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.CombinationType = ADDITION; } #line 12926 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 635: #line 6316 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.CombinationType = SOUSTRACTION; } #line 12932 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 636: #line 6322 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = -1; } #line 12938 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 637: #line 6324 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = Num_Group(&Group_S, (char*)"PO_Support", (yyvsp[-1].i)); } #line 12944 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 638: #line 6330 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.SubType = PRINT_ONREGION; PostSubOperation_S.Case.OnRegion.RegionIndex = -1; } #line 12953 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 639: #line 6336 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.SubType = PRINT_ONREGION; PostSubOperation_S.Case.OnRegion.RegionIndex = Num_Group(&Group_S, (char*)"PO_OnRegion", (yyvsp[0].i)); } #line 12963 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 640: #line 6343 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.SubType = PRINT_ONELEMENTSOF; PostSubOperation_S.Case.OnRegion.RegionIndex = Num_Group(&Group_S, (char*)"PO_OnElementsOf", (yyvsp[0].i)); } #line 12973 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 641: #line 6352 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.SubType = PRINT_ONSECTION_2D; if(List_Nbr((yyvsp[-8].l)) != 3 || List_Nbr((yyvsp[-5].l)) != 3 || List_Nbr((yyvsp[-2].l)) != 3) vyyerror("Expected {3}{3}{3} coordinates, got {%d}{%d}{%d}", List_Nbr((yyvsp[-8].l)), List_Nbr((yyvsp[-5].l)), List_Nbr((yyvsp[-2].l))); else{ List_Read((yyvsp[-8].l), 0, &PostSubOperation_S.Case.OnSection.x[0]); List_Read((yyvsp[-8].l), 1, &PostSubOperation_S.Case.OnSection.y[0]); List_Read((yyvsp[-8].l), 2, &PostSubOperation_S.Case.OnSection.z[0]); List_Read((yyvsp[-5].l), 0, &PostSubOperation_S.Case.OnSection.x[1]); List_Read((yyvsp[-5].l), 1, &PostSubOperation_S.Case.OnSection.y[1]); List_Read((yyvsp[-5].l), 2, &PostSubOperation_S.Case.OnSection.z[1]); List_Read((yyvsp[-2].l), 0, &PostSubOperation_S.Case.OnSection.x[2]); List_Read((yyvsp[-2].l), 1, &PostSubOperation_S.Case.OnSection.y[2]); List_Read((yyvsp[-2].l), 2, &PostSubOperation_S.Case.OnSection.z[2]); } List_Delete((yyvsp[-8].l)); List_Delete((yyvsp[-5].l)); List_Delete((yyvsp[-2].l)); } #line 12998 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 642: #line 6374 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.SubType = PRINT_ONGRID; PostSubOperation_S.Case.OnRegion.RegionIndex = Num_Group(&Group_S, (char*)"PO_OnGrid", (yyvsp[0].i)); } #line 13008 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 643: #line 6382 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.SubType = PRINT_ONGRID_PARAM; PostSubOperation_S.Case.OnParamGrid.ExpressionIndex[0] = (yyvsp[-12].i); PostSubOperation_S.Case.OnParamGrid.ExpressionIndex[1] = (yyvsp[-10].i); PostSubOperation_S.Case.OnParamGrid.ExpressionIndex[2] = (yyvsp[-8].i); PostSubOperation_S.Case.OnParamGrid.ParameterValue[0] = (yyvsp[-5].l); PostSubOperation_S.Case.OnParamGrid.ParameterValue[1] = (yyvsp[-3].l); PostSubOperation_S.Case.OnParamGrid.ParameterValue[2] = (yyvsp[-1].l); } #line 13022 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 644: #line 6393 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.SubType = PRINT_ONGRID_0D; if(List_Nbr((yyvsp[-1].l)) != 3) vyyerror("Expected {3} coordinates, got {%d}", List_Nbr((yyvsp[-1].l))); else{ List_Read((yyvsp[-1].l), 0, &PostSubOperation_S.Case.OnGrid.x[0]); List_Read((yyvsp[-1].l), 1, &PostSubOperation_S.Case.OnGrid.y[0]); List_Read((yyvsp[-1].l), 2, &PostSubOperation_S.Case.OnGrid.z[0]); } List_Delete((yyvsp[-1].l)); } #line 13038 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 645: #line 6407 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.SubType = PRINT_ONGRID_1D; if(List_Nbr((yyvsp[-8].l)) != 3 || List_Nbr((yyvsp[-5].l)) != 3) vyyerror("Expected {3}{3} coordinates, got {%d}{%d}", List_Nbr((yyvsp[-8].l)), List_Nbr((yyvsp[-5].l))); else{ List_Read((yyvsp[-8].l), 0, &PostSubOperation_S.Case.OnGrid.x[0]); List_Read((yyvsp[-8].l), 1, &PostSubOperation_S.Case.OnGrid.y[0]); List_Read((yyvsp[-8].l), 2, &PostSubOperation_S.Case.OnGrid.z[0]); List_Read((yyvsp[-5].l), 0, &PostSubOperation_S.Case.OnGrid.x[1]); List_Read((yyvsp[-5].l), 1, &PostSubOperation_S.Case.OnGrid.y[1]); List_Read((yyvsp[-5].l), 2, &PostSubOperation_S.Case.OnGrid.z[1]); } PostSubOperation_S.Case.OnGrid.n[0] = (int)(yyvsp[-1].d); List_Delete((yyvsp[-8].l)); List_Delete((yyvsp[-5].l)); } #line 13060 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 646: #line 6428 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.SubType = PRINT_ONGRID_2D; if(List_Nbr((yyvsp[-13].l)) != 3 || List_Nbr((yyvsp[-10].l)) != 3 || List_Nbr((yyvsp[-7].l)) != 3) vyyerror("Expected {3}{3}{3} coordinates, got {%d}{%d}{%d}", List_Nbr((yyvsp[-13].l)), List_Nbr((yyvsp[-10].l)), List_Nbr((yyvsp[-7].l))); else{ List_Read((yyvsp[-13].l), 0, &PostSubOperation_S.Case.OnGrid.x[0]); List_Read((yyvsp[-13].l), 1, &PostSubOperation_S.Case.OnGrid.y[0]); List_Read((yyvsp[-13].l), 2, &PostSubOperation_S.Case.OnGrid.z[0]); List_Read((yyvsp[-10].l), 0, &PostSubOperation_S.Case.OnGrid.x[1]); List_Read((yyvsp[-10].l), 1, &PostSubOperation_S.Case.OnGrid.y[1]); List_Read((yyvsp[-10].l), 2, &PostSubOperation_S.Case.OnGrid.z[1]); List_Read((yyvsp[-7].l), 0, &PostSubOperation_S.Case.OnGrid.x[2]); List_Read((yyvsp[-7].l), 1, &PostSubOperation_S.Case.OnGrid.y[2]); List_Read((yyvsp[-7].l), 2, &PostSubOperation_S.Case.OnGrid.z[2]); } PostSubOperation_S.Case.OnGrid.n[0] = (int)(yyvsp[-3].d); PostSubOperation_S.Case.OnGrid.n[1] = (int)(yyvsp[-1].d); List_Delete((yyvsp[-13].l)); List_Delete((yyvsp[-10].l)); List_Delete((yyvsp[-7].l)); } #line 13087 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 647: #line 6455 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.SubType = PRINT_ONGRID_3D; if(List_Nbr((yyvsp[-18].l)) != 3 || List_Nbr((yyvsp[-15].l)) != 3 || List_Nbr((yyvsp[-12].l)) != 3 || List_Nbr((yyvsp[-9].l)) != 3) vyyerror("Expected {3}{3}{3}{3} coordinates, got {%d}{%d}{%d}{%d}", List_Nbr((yyvsp[-18].l)), List_Nbr((yyvsp[-15].l)), List_Nbr((yyvsp[-12].l)), List_Nbr((yyvsp[-9].l))); else{ List_Read((yyvsp[-18].l), 0, &PostSubOperation_S.Case.OnGrid.x[0]); List_Read((yyvsp[-18].l), 1, &PostSubOperation_S.Case.OnGrid.y[0]); List_Read((yyvsp[-18].l), 2, &PostSubOperation_S.Case.OnGrid.z[0]); List_Read((yyvsp[-15].l), 0, &PostSubOperation_S.Case.OnGrid.x[1]); List_Read((yyvsp[-15].l), 1, &PostSubOperation_S.Case.OnGrid.y[1]); List_Read((yyvsp[-15].l), 2, &PostSubOperation_S.Case.OnGrid.z[1]); List_Read((yyvsp[-12].l), 0, &PostSubOperation_S.Case.OnGrid.x[2]); List_Read((yyvsp[-12].l), 1, &PostSubOperation_S.Case.OnGrid.y[2]); List_Read((yyvsp[-12].l), 2, &PostSubOperation_S.Case.OnGrid.z[2]); List_Read((yyvsp[-9].l), 0, &PostSubOperation_S.Case.OnGrid.x[3]); List_Read((yyvsp[-9].l), 1, &PostSubOperation_S.Case.OnGrid.y[3]); List_Read((yyvsp[-9].l), 2, &PostSubOperation_S.Case.OnGrid.z[3]); } PostSubOperation_S.Case.OnGrid.n[0] = (int)(yyvsp[-5].d); PostSubOperation_S.Case.OnGrid.n[1] = (int)(yyvsp[-3].d); PostSubOperation_S.Case.OnGrid.n[2] = (int)(yyvsp[-1].d); List_Delete((yyvsp[-18].l)); List_Delete((yyvsp[-15].l)); List_Delete((yyvsp[-12].l)); List_Delete((yyvsp[-9].l)); } #line 13120 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 648: #line 6487 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.SubType = PRINT_WITHARGUMENT; PostSubOperation_S.Case.WithArgument.RegionIndex = Num_Group(&Group_S, (char*)"PO_On", (yyvsp[-10].i)); int i; if((i = List_ISearchSeq(Problem_S.Expression, (yyvsp[-8].c), fcmp_Expression_Name)) < 0) vyyerror("Unknown Name of Expression: %s", (yyvsp[-8].c)); Free((yyvsp[-8].c)); PostSubOperation_S.Case.WithArgument.ArgumentIndex = i; PostSubOperation_S.Case.WithArgument.x[0] = (yyvsp[-6].d); PostSubOperation_S.Case.WithArgument.x[1] = (yyvsp[-4].d); PostSubOperation_S.Case.WithArgument.n = (int)(yyvsp[-1].d); } #line 13140 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 649: #line 6507 "ProParser.y" /* yacc.c:1646 */ { } #line 13147 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 651: #line 6514 "ProParser.y" /* yacc.c:1646 */ { if(!PostOperation_S.AppendString){ PostSubOperation_S.FileOut = (yyvsp[0].c); } else{ PostSubOperation_S.FileOut = (char *)Malloc((strlen((yyvsp[0].c))+strlen(PostOperation_S.AppendString)+1)*sizeof(char)); strcpy(PostSubOperation_S.FileOut, (yyvsp[0].c)); strcat(PostSubOperation_S.FileOut, PostOperation_S.AppendString); Free((yyvsp[0].c)); } PostSubOperation_S.CatFile = 0; } #line 13165 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 652: #line 6528 "ProParser.y" /* yacc.c:1646 */ { if(!PostOperation_S.AppendString){ PostSubOperation_S.FileOut = (yyvsp[0].c); } else{ PostSubOperation_S.FileOut = (char *)Malloc((strlen((yyvsp[0].c))+strlen(PostOperation_S.AppendString)+1)*sizeof(char)); strcpy(PostSubOperation_S.FileOut, (yyvsp[0].c)); strcat(PostSubOperation_S.FileOut, PostOperation_S.AppendString); Free((yyvsp[0].c)); } PostSubOperation_S.CatFile = 1; } #line 13183 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 653: #line 6542 "ProParser.y" /* yacc.c:1646 */ { if(!PostOperation_S.AppendString){ PostSubOperation_S.FileOut = (yyvsp[0].c); } else{ PostSubOperation_S.FileOut = (char *)Malloc((strlen((yyvsp[0].c))+strlen(PostOperation_S.AppendString)+1)*sizeof(char)); strcpy(PostSubOperation_S.FileOut, (yyvsp[0].c)); strcat(PostSubOperation_S.FileOut, PostOperation_S.AppendString); Free((yyvsp[0].c)); } PostSubOperation_S.CatFile = 2; } #line 13201 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 654: #line 6556 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.CatFile = (yyvsp[0].d); } #line 13209 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 655: #line 6560 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Depth = (int)(yyvsp[0].d); } #line 13217 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 656: #line 6564 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Skin = 1; } #line 13225 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 657: #line 6568 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Smoothing = 1; } #line 13233 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 658: #line 6572 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Smoothing = (int)(yyvsp[0].d); } #line 13241 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 659: #line 6576 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.HarmonicToTime = (int)(yyvsp[0].d); } #line 13249 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 660: #line 6580 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.FourierTransform = 2; } #line 13257 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 661: #line 6584 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.FourierTransform = 1; } #line 13265 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 662: #line 6588 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Format = Get_DefineForString(PostSubOperation_Format, (yyvsp[0].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[0].c), PostSubOperation_Format); vyyerror("Unknown PostProcessing Format: %s", (yyvsp[0].c)); } Free((yyvsp[0].c)); } #line 13279 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 663: #line 6598 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Comma = 1; } #line 13287 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 664: #line 6602 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.ValueIndex = (yyvsp[0].d); } #line 13295 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 665: #line 6606 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.ValueName = (yyvsp[0].c); } #line 13303 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 666: #line 6610 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Label = (yyvsp[0].c); } #line 13311 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 667: #line 6614 "ProParser.y" /* yacc.c:1646 */ { if((int)(yyvsp[0].d) >= 1 && (int)(yyvsp[0].d) <= 3) PostSubOperation_S.Dimension = (int)(yyvsp[0].d); else vyyerror("Wrong Dimension in Print"); } #line 13322 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 668: #line 6621 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.FrozenTimeStepList = 1; for(int i = 0; i < List_Nbr((yyvsp[0].l)); i++){ double d; List_Read((yyvsp[0].l),i,&d); int j = (int)d; List_Add(PostSubOperation_S.TimeStep_L, &j); } List_Delete((yyvsp[0].l)); } #line 13337 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 669: #line 6632 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.TimeValue_L = (yyvsp[0].l); } #line 13345 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 670: #line 6636 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.TimeImagValue_L = (yyvsp[0].l); } #line 13353 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 671: #line 6640 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Adapt = Get_DefineForString(PostSubOperation_AdaptationType, (yyvsp[0].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[0].c), PostSubOperation_AdaptationType); vyyerror("Unknown Adaptation method: %s", (yyvsp[0].c)); } } #line 13366 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 672: #line 6649 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Sort = Get_DefineForString(PostSubOperation_SortType, (yyvsp[0].c), &FlagError); if(FlagError){ Get_Valid_SXD((yyvsp[0].c), PostSubOperation_SortType); vyyerror("Unknown Sort method: %s", (yyvsp[0].c)); } } #line 13379 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 673: #line 6658 "ProParser.y" /* yacc.c:1646 */ { if((yyvsp[0].d) >= 0.) PostSubOperation_S.Target = (yyvsp[0].d); else vyyerror("Bad Target value"); } #line 13390 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 674: #line 6665 "ProParser.y" /* yacc.c:1646 */ { for(int i = 0; i < List_Nbr((yyvsp[0].l)); i++){ double d; List_Read((yyvsp[0].l),i,&d); List_Add(PostSubOperation_S.Value_L, &d); } List_Delete((yyvsp[0].l)); } #line 13403 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 675: #line 6674 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Iso = (int)(yyvsp[0].d); } #line 13411 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 676: #line 6678 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Iso = -1; for(int i = 0; i < List_Nbr((yyvsp[-1].l)); i++){ double d; List_Read((yyvsp[-1].l),i,&d); List_Add(PostSubOperation_S.Iso_L, &d); } List_Delete((yyvsp[-1].l)); } #line 13425 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 677: #line 6688 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.NoNewLine = 1; } #line 13433 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 678: #line 6692 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.NoTitle = 1; } #line 13441 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 679: #line 6696 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.DecomposeInSimplex = 1; } #line 13449 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 680: #line 6700 "ProParser.y" /* yacc.c:1646 */ { for(int i = 0; i < List_Nbr((yyvsp[0].l)); i++){ double d; List_Read((yyvsp[0].l),i,&d); List_Add(PostSubOperation_S.Frequency_L, &d); } List_Delete((yyvsp[0].l)); } #line 13462 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 681: #line 6709 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.ChangeOfCoordinates[0] = (yyvsp[-5].i); PostSubOperation_S.ChangeOfCoordinates[1] = (yyvsp[-3].i); PostSubOperation_S.ChangeOfCoordinates[2] = (yyvsp[-1].i); } #line 13472 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 682: #line 6715 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.ChangeOfValues = List_Copy(ListOfInt_L); } #line 13480 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 683: #line 6719 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Legend = LEGEND_TIME; PostSubOperation_S.LegendPosition[0] = 1.e5; PostSubOperation_S.LegendPosition[1] = 30.; /* (align<<16)|(font<<8)|(fontsize) */ PostSubOperation_S.LegendPosition[2] = 66574; } #line 13492 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 684: #line 6727 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Legend = LEGEND_TIME; PostSubOperation_S.LegendPosition[0] = (yyvsp[-5].d); PostSubOperation_S.LegendPosition[1] = (yyvsp[-3].d); PostSubOperation_S.LegendPosition[2] = (yyvsp[-1].d); } #line 13503 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 685: #line 6734 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Legend = LEGEND_FREQUENCY; PostSubOperation_S.LegendPosition[0] = 1.e5; PostSubOperation_S.LegendPosition[1] = 30.; /* (align<<16)|(font<<8)|(fontsize) */ PostSubOperation_S.LegendPosition[2] = 66574; } #line 13515 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 686: #line 6742 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Legend = LEGEND_FREQUENCY; PostSubOperation_S.LegendPosition[0] = (yyvsp[-5].d); PostSubOperation_S.LegendPosition[1] = (yyvsp[-3].d); PostSubOperation_S.LegendPosition[2] = (yyvsp[-1].d); } #line 13526 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 687: #line 6749 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Legend = LEGEND_EIGENVALUES; PostSubOperation_S.LegendPosition[0] = 1.e5; PostSubOperation_S.LegendPosition[1] = 30.; /* (align<<16)|(font<<8)|(fontsize) */ PostSubOperation_S.LegendPosition[2] = 66574; } #line 13538 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 688: #line 6757 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Legend = LEGEND_EIGENVALUES; PostSubOperation_S.LegendPosition[0] = (yyvsp[-5].d); PostSubOperation_S.LegendPosition[1] = (yyvsp[-3].d); PostSubOperation_S.LegendPosition[2] = (yyvsp[-1].d); } #line 13549 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 689: #line 6764 "ProParser.y" /* yacc.c:1646 */ { if(List_Nbr((yyvsp[-1].l))%3 != 0) vyyerror("Expected 3n coordinates, got %d", List_Nbr((yyvsp[-1].l))); else { PostSubOperation_S.EvaluationPoints = (yyvsp[-1].l); } } #line 13561 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 690: #line 6772 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.StoreInVariable = (yyvsp[0].c); } #line 13569 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 691: #line 6776 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.StoreInRegister = (int)(yyvsp[0].d) - 1; } #line 13577 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 692: #line 6780 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.StoreMinInRegister = (int)(yyvsp[0].d) - 1; } #line 13585 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 693: #line 6784 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.StoreMinXinRegister = (int)(yyvsp[0].d) - 1; } #line 13593 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 694: #line 6788 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.StoreMinYinRegister = (int)(yyvsp[0].d) - 1; } #line 13601 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 695: #line 6792 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.StoreMinZinRegister = (int)(yyvsp[0].d) - 1; } #line 13609 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 696: #line 6796 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.StoreMaxInRegister = (int)(yyvsp[0].d) - 1; } #line 13617 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 697: #line 6800 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.StoreMaxXinRegister = (int)(yyvsp[0].d) - 1; } #line 13625 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 698: #line 6804 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.StoreMaxYinRegister = (int)(yyvsp[0].d) - 1; } #line 13633 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 699: #line 6808 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.StoreMaxZinRegister = (int)(yyvsp[0].d) - 1; } #line 13641 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 700: #line 6812 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.StoreInField = (yyvsp[0].d); } #line 13649 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 701: #line 6816 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.StoreInMeshBasedField = (yyvsp[0].d); } #line 13657 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 702: #line 6820 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.LastTimeStepOnly = 1; } #line 13665 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 703: #line 6824 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.AppendTimeStepToFileName = 1; } #line 13673 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 704: #line 6828 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.AppendTimeStepToFileName = (yyvsp[0].d); } #line 13681 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 705: #line 6832 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.AppendExpressionToFileName = (yyvsp[0].i); } #line 13689 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 706: #line 6836 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.AppendExpressionFormat = (yyvsp[0].c); } #line 13697 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 707: #line 6840 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.AppendStringToFileName = (yyvsp[0].c); } #line 13705 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 708: #line 6844 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.OverrideTimeStepValue = (yyvsp[0].d); } #line 13713 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 709: #line 6848 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.NoMesh = 1; } #line 13721 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 710: #line 6852 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.NoMesh = (yyvsp[0].d); } #line 13729 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 711: #line 6856 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.SendToServer = (yyvsp[0].c); } #line 13737 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 712: #line 6860 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.Color = (yyvsp[0].c); } #line 13745 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 713: #line 6864 "ProParser.y" /* yacc.c:1646 */ { PostSubOperation_S.NewCoordinates = 1; PostSubOperation_S.NewCoordinatesFile = (yyvsp[0].c); } #line 13754 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 714: #line 6877 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (yyvsp[0].c); } #line 13760 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 715: #line 6879 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (yyvsp[0].c); } #line 13766 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 716: #line 6885 "ProParser.y" /* yacc.c:1646 */ { LoopControlVariablesTab[ImbricatedLoop][0] = (yyvsp[-3].d); LoopControlVariablesTab[ImbricatedLoop][1] = (yyvsp[-1].d); LoopControlVariablesTab[ImbricatedLoop][2] = 1.0; LoopControlVariablesNameTab[ImbricatedLoop] = (char*)""; fgetpos(getdp_yyin, &FposImbricatedLoopsTab[ImbricatedLoop]); LinenoImbricatedLoopsTab[ImbricatedLoop] = getdp_yylinenum; if((yyvsp[-3].d) > (yyvsp[-1].d)) skipUntil("For", "EndFor"); else ImbricatedLoop++; if(ImbricatedLoop > MAX_RECUR_LOOPS-1){ vyyerror("Reached maximum number of imbricated loops"); ImbricatedLoop = MAX_RECUR_LOOPS-1; } } #line 13787 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 717: #line 6902 "ProParser.y" /* yacc.c:1646 */ { LoopControlVariablesTab[ImbricatedLoop][0] = (yyvsp[-5].d); LoopControlVariablesTab[ImbricatedLoop][1] = (yyvsp[-3].d); LoopControlVariablesTab[ImbricatedLoop][2] = (yyvsp[-1].d); LoopControlVariablesNameTab[ImbricatedLoop] = (char*)""; fgetpos(getdp_yyin, &FposImbricatedLoopsTab[ImbricatedLoop]); LinenoImbricatedLoopsTab[ImbricatedLoop] = getdp_yylinenum; if(((yyvsp[-1].d) > 0. && (yyvsp[-5].d) > (yyvsp[-3].d)) || ((yyvsp[-1].d) < 0. && (yyvsp[-5].d) < (yyvsp[-3].d))) skipUntil("For", "EndFor"); else ImbricatedLoop++; if(ImbricatedLoop > MAX_RECUR_LOOPS-1){ vyyerror("Reached maximum number of imbricated loops"); ImbricatedLoop = MAX_RECUR_LOOPS-1; } } #line 13808 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 718: #line 6919 "ProParser.y" /* yacc.c:1646 */ { LoopControlVariablesTab[ImbricatedLoop][0] = (yyvsp[-3].d); LoopControlVariablesTab[ImbricatedLoop][1] = (yyvsp[-1].d); LoopControlVariablesTab[ImbricatedLoop][2] = 1.0; LoopControlVariablesNameTab[ImbricatedLoop] = (yyvsp[-6].c); Constant_S.Name = (yyvsp[-6].c); Constant_S.Type = VAR_FLOAT; Constant_S.Value.Float = (yyvsp[-3].d); Tree_Replace(ConstantTable_L, &Constant_S); fgetpos(getdp_yyin, &FposImbricatedLoopsTab[ImbricatedLoop]); /* hack_fsetpos_printf(); */ LinenoImbricatedLoopsTab[ImbricatedLoop] = getdp_yylinenum; if((yyvsp[-3].d) > (yyvsp[-1].d)) skipUntil("For", "EndFor"); else ImbricatedLoop++; if(ImbricatedLoop > MAX_RECUR_LOOPS-1){ vyyerror("Reached maximum number of imbricated loops"); ImbricatedLoop = MAX_RECUR_LOOPS-1; } } #line 13834 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 719: #line 6941 "ProParser.y" /* yacc.c:1646 */ { LoopControlVariablesTab[ImbricatedLoop][0] = (yyvsp[-5].d); LoopControlVariablesTab[ImbricatedLoop][1] = (yyvsp[-3].d); LoopControlVariablesTab[ImbricatedLoop][2] = (yyvsp[-1].d); LoopControlVariablesNameTab[ImbricatedLoop] = (yyvsp[-8].c); Constant_S.Name = (yyvsp[-8].c); Constant_S.Type = VAR_FLOAT; Constant_S.Value.Float = (yyvsp[-5].d); Tree_Replace(ConstantTable_L, &Constant_S); fgetpos(getdp_yyin, &FposImbricatedLoopsTab[ImbricatedLoop]); LinenoImbricatedLoopsTab[ImbricatedLoop] = getdp_yylinenum; if(((yyvsp[-1].d) > 0. && (yyvsp[-5].d) > (yyvsp[-3].d)) || ((yyvsp[-1].d) < 0. && (yyvsp[-5].d) < (yyvsp[-3].d))) skipUntil("For", "EndFor"); else ImbricatedLoop++; if(ImbricatedLoop > MAX_RECUR_LOOPS-1){ vyyerror("Reached maximum number of imbricated loops"); ImbricatedLoop = MAX_RECUR_LOOPS-1; } } #line 13859 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 720: #line 6962 "ProParser.y" /* yacc.c:1646 */ { if(ImbricatedLoop <= 0){ vyyerror("Invalid For/EndFor loop"); ImbricatedLoop = 0; } else{ double x0 = LoopControlVariablesTab[ImbricatedLoop-1][0]; double x1 = LoopControlVariablesTab[ImbricatedLoop-1][1]; double step = LoopControlVariablesTab[ImbricatedLoop-1][2]; int do_next = (step > 0.) ? (x0+step <= x1) : (x0+step >= x1); if(do_next){ LoopControlVariablesTab[ImbricatedLoop-1][0] += LoopControlVariablesTab[ImbricatedLoop-1][2]; if(strlen(LoopControlVariablesNameTab[ImbricatedLoop-1])){ Constant_S.Name = LoopControlVariablesNameTab[ImbricatedLoop-1]; Constant_S.Type = VAR_FLOAT; Constant_S.Value.Float = LoopControlVariablesTab[ImbricatedLoop-1][0]; if(!Tree_Search(ConstantTable_L, &Constant_S)) vyyerror("Unknown For/EndFor loop control variable %s", Constant_S.Name); Tree_Replace(ConstantTable_L, &Constant_S); } fsetpos(getdp_yyin, &FposImbricatedLoopsTab[ImbricatedLoop-1]); /* fsetpos() seems to position the file just after the For but with one additional character (the one after EndFor) at the beginning. I do not understand why there is such a mixing of two separate data. hack_fsetpos() removes the useless additional character. */ hack_fsetpos(); /* hack_fsetpos_printf(); */ getdp_yylinenum = LinenoImbricatedLoopsTab[ImbricatedLoop-1]; } else{ ImbricatedLoop--; } } } #line 13900 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 721: #line 6999 "ProParser.y" /* yacc.c:1646 */ { if(!MacroManager::Instance()->createMacro (std::string((yyvsp[0].c)), getdp_yyin, getdp_yyname, getdp_yylinenum + 1)) vyyerror("Redefinition of macro '%s'", (yyvsp[0].c)); skipUntil(NULL, "Return"); Free((yyvsp[0].c)); } #line 13912 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 722: #line 7007 "ProParser.y" /* yacc.c:1646 */ { if(!MacroManager::Instance()->createMacro (std::string((yyvsp[0].c)), getdp_yyin, getdp_yyname, getdp_yylinenum + 1)) vyyerror("Redefinition of macro '%s'", (yyvsp[0].c)); skipUntil(NULL, "Return"); Free((yyvsp[0].c)); } #line 13924 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 723: #line 7015 "ProParser.y" /* yacc.c:1646 */ { if(!MacroManager::Instance()->leaveMacro (&getdp_yyin, getdp_yyname, getdp_yylinenum)) vyyerror("Error while exiting macro"); } #line 13934 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 724: #line 7021 "ProParser.y" /* yacc.c:1646 */ { if(!MacroManager::Instance()->enterMacro (std::string((yyvsp[-1].c)), &getdp_yyin, getdp_yyname, getdp_yylinenum)) vyyerror("Unknown macro '%s'", (yyvsp[-1].c)); Free((yyvsp[-1].c)); } #line 13945 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 725: #line 7028 "ProParser.y" /* yacc.c:1646 */ { if((yyvsp[-3].d)) if(!MacroManager::Instance()->enterMacro (std::string((yyvsp[-1].c)), &getdp_yyin, getdp_yyname, getdp_yylinenum)) vyyerror("Unknown macro '%s'", (yyvsp[-1].c)); Free((yyvsp[-1].c)); } #line 13957 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 726: #line 7036 "ProParser.y" /* yacc.c:1646 */ { ImbricatedTest++; if(ImbricatedTest > MAX_RECUR_TESTS-1){ vyyerror("Reached maximum number of imbricated tests"); ImbricatedTest = MAX_RECUR_TESTS-1; } if((yyvsp[-1].d)){ // Current test is true statusImbricatedTests[ImbricatedTest] = 1; } else{ statusImbricatedTests[ImbricatedTest] = 0; // Go after the next ElseIf or Else or EndIf int type_until2 = 0; skipUntil_test("If", "EndIf", "ElseIf", 4, &type_until2); if(!type_until2) ImbricatedTest--; // EndIf reached } } #line 13981 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 727: #line 7056 "ProParser.y" /* yacc.c:1646 */ { if(ImbricatedTest > 0){ if (statusImbricatedTests[ImbricatedTest]){ // Last test (If or ElseIf) was true, thus go after EndIf (out of If EndIf) skipUntil("If", "EndIf"); ImbricatedTest--; } else{ // Previous test(s) (If and ElseIf) not yet true if((yyvsp[-1].d)){ statusImbricatedTests[ImbricatedTest] = 1; } else{ // Current test still not true: statusImbricatedTests[ImbricatedTest] = 0; // Go after the next ElseIf or Else or EndIf int type_until2 = 0; skipUntil_test("If", "EndIf", "ElseIf", 4, &type_until2); if(!type_until2) ImbricatedTest--; } } } else{ Message::Error("Orphan ElseIf"); } } #line 14011 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 728: #line 7082 "ProParser.y" /* yacc.c:1646 */ { if(ImbricatedTest > 0){ if(statusImbricatedTests[ImbricatedTest]){ skipUntil("If", "EndIf"); ImbricatedTest--; } } else{ Message::Error("Orphan Else"); } } #line 14027 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 729: #line 7094 "ProParser.y" /* yacc.c:1646 */ { ImbricatedTest--; if(ImbricatedTest < 0) Message::Warning("line %ld : Orphan EndIf", getdp_yylinenum); } #line 14037 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 731: #line 7109 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = 3; } #line 14043 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 732: #line 7110 "ProParser.y" /* yacc.c:1646 */ { (yyval.i) = -3; } #line 14049 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 735: #line 7120 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[-1].c); // FIXME: leak if constant is list or char; all Tree_Replace functions // below also leak; correct fix is to replace all of this with a std::map // like in Gmsh Tree_Suppress(ConstantTable_L, &Constant_S); Free((yyvsp[-1].c)); } #line 14062 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 736: #line 7130 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[-3].c); if(List_Nbr((yyvsp[-1].l)) == 1){ Constant_S.Type = VAR_FLOAT; List_Read((yyvsp[-1].l), 0, &Constant_S.Value.Float); List_Delete((yyvsp[-1].l)); } else{ Constant_S.Type = VAR_LISTOFFLOAT; Constant_S.Value.ListOfFloat = (yyvsp[-1].l); } Tree_Replace(ConstantTable_L, &Constant_S); } #line 14080 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 737: #line 7145 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[-5].c); Constant_S.Type = VAR_LISTOFFLOAT; Constant_S.Value.ListOfFloat = (yyvsp[-1].l); Tree_Replace(ConstantTable_L, &Constant_S); } #line 14091 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 738: #line 7153 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[-6].c); Constant *c = (Constant*)Tree_PQuery(ConstantTable_L, &Constant_S); if(c && (c->Type == VAR_LISTOFFLOAT)){ if(List_Nbr((yyvsp[-4].l)) == List_Nbr((yyvsp[-1].l))){ for(int i = 0; i < List_Nbr((yyvsp[-4].l)); i++){ double d; List_Read((yyvsp[-4].l), i, &d); int idx = (int)d; if(idx >= 0 && idx < List_Nbr(c->Value.ListOfFloat)){ double *pd = (double*)List_Pointer(c->Value.ListOfFloat, idx); double d2 = *(double*)List_Pointer((yyvsp[-1].l), i); *pd = d2; } else vyyerror("Index %d out of range", idx); } } else vyyerror("Bad list sizes for affectation %d != %d", List_Nbr((yyvsp[-4].l)), List_Nbr((yyvsp[-1].l))); } else vyyerror("Unknown list Constant: %s", (yyvsp[-6].c)); List_Delete((yyvsp[-4].l)); List_Delete((yyvsp[-1].l)); } #line 14122 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 739: #line 7181 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[-7].c); Constant *c = (Constant*)Tree_PQuery(ConstantTable_L, &Constant_S); if(c && (c->Type == VAR_LISTOFFLOAT)){ if(List_Nbr((yyvsp[-5].l)) == List_Nbr((yyvsp[-1].l))){ for(int i = 0; i < List_Nbr((yyvsp[-5].l)); i++){ double d; List_Read((yyvsp[-5].l), i, &d); int idx = (int)d; if(idx >= 0 && idx < List_Nbr(c->Value.ListOfFloat)){ double *pd = (double*)List_Pointer(c->Value.ListOfFloat, idx); double d2 = *(double*)List_Pointer((yyvsp[-1].l), i); *pd += d2; } else vyyerror("Index %d out of range", idx); } } else vyyerror("Bad list sizes (%d, %d) for += operation", List_Nbr((yyvsp[-5].l)), List_Nbr((yyvsp[-1].l))); } else vyyerror("Unknown list Constant: %s", (yyvsp[-7].c)); List_Delete((yyvsp[-5].l)); List_Delete((yyvsp[-1].l)); } #line 14153 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 740: #line 7209 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[-7].c); Constant *c = (Constant*)Tree_PQuery(ConstantTable_L, &Constant_S); if(c && (c->Type == VAR_LISTOFFLOAT)){ if(List_Nbr((yyvsp[-5].l)) == List_Nbr((yyvsp[-1].l))){ for(int i = 0; i < List_Nbr((yyvsp[-5].l)); i++){ double d; List_Read((yyvsp[-5].l), i, &d); int idx = (int)d; if(idx >= 0 && idx < List_Nbr(c->Value.ListOfFloat)){ double *pd = (double*)List_Pointer(c->Value.ListOfFloat, idx); double d2 = *(double*)List_Pointer((yyvsp[-1].l), i); *pd -= d2; } else vyyerror("Index %d out of range", idx); } } else vyyerror("Bad list sizes (%d, %d) for -= operation", List_Nbr((yyvsp[-5].l)), List_Nbr((yyvsp[-1].l))); } else vyyerror("Unknown list Constant: %s", (yyvsp[-7].c)); List_Delete((yyvsp[-5].l)); List_Delete((yyvsp[-1].l)); } #line 14184 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 741: #line 7237 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[-4].c); Constant *c = (Constant*)Tree_PQuery(ConstantTable_L, &Constant_S); if(c){ if(c->Type == VAR_FLOAT && List_Nbr((yyvsp[-1].l)) == 1){ double d; List_Read((yyvsp[-1].l), 0, &d); c->Value.Float += d; } else if(c->Type == VAR_LISTOFFLOAT){ for(int i = 0; i < List_Nbr((yyvsp[-1].l)); i++) List_Add(c->Value.ListOfFloat, List_Pointer((yyvsp[-1].l), i)); } else vyyerror("Cannot append list to float"); } else vyyerror("Unknown Constant: %s", (yyvsp[-4].c)); List_Delete((yyvsp[-1].l)); } #line 14209 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 742: #line 7259 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[-6].c); Constant *c = (Constant*)Tree_PQuery(ConstantTable_L, &Constant_S); if(c){ if(c->Type == VAR_LISTOFFLOAT){ for(int i = 0; i < List_Nbr((yyvsp[-1].l)); i++) List_Add(c->Value.ListOfFloat, List_Pointer((yyvsp[-1].l), i)); } else vyyerror("Cannot append list to float"); } else vyyerror("Unknown Constant: %s", (yyvsp[-6].c)); List_Delete((yyvsp[-1].l)); } #line 14229 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 743: #line 7276 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[-4].c); Constant *c = (Constant*)Tree_PQuery(ConstantTable_L, &Constant_S); if(c){ if(c->Type == VAR_FLOAT && List_Nbr((yyvsp[-1].l)) == 1){ double d; List_Read((yyvsp[-1].l), 0, &d); c->Value.Float -= d; } else if(c->Type == VAR_LISTOFFLOAT){ std::vector tmp; for(int i = 0; i < List_Nbr(c->Value.ListOfFloat); i++){ double d; List_Read(c->Value.ListOfFloat, i, &d); tmp.push_back(d); } for(int i = 0; i < List_Nbr((yyvsp[-1].l)); i++){ double d; List_Read((yyvsp[-1].l), i, &d); std::vector::iterator it = std::find(tmp.begin(), tmp.end(), d); if(it != tmp.end()) tmp.erase(it); } List_Reset(c->Value.ListOfFloat); for(unsigned int i = 0; i < tmp.size(); i++) List_Add(c->Value.ListOfFloat, &tmp[i]); } else vyyerror("Cannot erase list from float"); } else vyyerror("Unknown Constant: %s", (yyvsp[-4].c)); List_Delete((yyvsp[-1].l)); } #line 14267 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 744: #line 7311 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[-6].c); Constant *c = (Constant*)Tree_PQuery(ConstantTable_L, &Constant_S); if(c){ if(c->Type == VAR_LISTOFFLOAT){ std::vector tmp; for(int i = 0; i < List_Nbr(c->Value.ListOfFloat); i++){ double d; List_Read(c->Value.ListOfFloat, i, &d); tmp.push_back(d); } for(int i = 0; i < List_Nbr((yyvsp[-1].l)); i++){ double d; List_Read((yyvsp[-1].l), i, &d); std::vector::iterator it = std::find(tmp.begin(), tmp.end(), d); if(it != tmp.end()) tmp.erase(it); } List_Reset(c->Value.ListOfFloat); for(unsigned int i = 0; i < tmp.size(); i++) List_Add(c->Value.ListOfFloat, &tmp[i]); } else vyyerror("Cannot erase list from float"); } else vyyerror("Unknown Constant: %s", (yyvsp[-6].c)); List_Delete((yyvsp[-1].l)); } #line 14300 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 745: #line 7341 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[-3].c); Constant_S.Type = VAR_CHAR; Constant_S.Value.Char = (yyvsp[-1].c); Tree_Replace(ConstantTable_L, &Constant_S); } #line 14310 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 746: #line 7348 "ProParser.y" /* yacc.c:1646 */ { Message::Direct((yyvsp[-4].i), (yyvsp[-2].c)); } #line 14318 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 747: #line 7353 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[-1].c); if(!Tree_Query(ConstantTable_L, &Constant_S)) vyyerror("Unknown Constant: %s", (yyvsp[-1].c)); else if(Constant_S.Type != VAR_LISTOFFLOAT) Message::Direct((yyvsp[-2].i), "%s: %g", (yyvsp[-1].c), Constant_S.Value.Float); else Message::Direct((yyvsp[-2].i), "%s: Dimension %d", (yyvsp[-1].c), List_Nbr(Constant_S.Value.ListOfFloat)); for(int i = 0; i < List_Nbr(Constant_S.Value.ListOfFloat); i++) { double d; List_Read(Constant_S.Value.ListOfFloat, i, &d); Message::Direct((yyvsp[-2].i), " (%d) %g", i, d); } } #line 14338 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 748: #line 7370 "ProParser.y" /* yacc.c:1646 */ { Message::Direct((yyvsp[-2].i), "Line number: %d", getdp_yylinenum); } #line 14346 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 749: #line 7375 "ProParser.y" /* yacc.c:1646 */ { char tmpstr[256]; int i = Print_ListOfDouble((yyvsp[-4].c), (yyvsp[-2].l), tmpstr); if(i < 0) vyyerror("Too few arguments in Printf"); else if(i > 0) vyyerror("Too many arguments (%d) in Printf", i); else Message::Direct((yyvsp[-6].i), tmpstr); List_Delete((yyvsp[-2].l)); } #line 14362 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 750: #line 7389 "ProParser.y" /* yacc.c:1646 */ { Message::Info("? "); char tmpstr[256]; fgets(tmpstr, sizeof(tmpstr), stdin); Constant_S.Value.Float = atof(tmpstr); Constant_S.Name = (yyvsp[-2].c); Constant_S.Type = VAR_FLOAT; Tree_Replace(ConstantTable_L, &Constant_S); } #line 14376 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 751: #line 7400 "ProParser.y" /* yacc.c:1646 */ { Message::Info("? "); char tmpstr[256]; fgets(tmpstr, sizeof(tmpstr), stdin); Constant_S.Value.Float = atof(tmpstr); Constant_S.Name = (yyvsp[-2].c); Constant_S.Type = VAR_FLOAT; Tree_Replace(ConstantTable_L, &Constant_S); } #line 14390 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 752: #line 7412 "ProParser.y" /* yacc.c:1646 */ { Message::Info("[=%g] ? ",(yyvsp[-2].d)); char tmpstr[256]; fgets(tmpstr, sizeof(tmpstr), stdin); if(!strcmp(tmpstr,"\n")) Constant_S.Value.Float = (yyvsp[-2].d); else Constant_S.Value.Float = atof(tmpstr); Constant_S.Name = (yyvsp[-5].c); Constant_S.Type = VAR_FLOAT; Tree_Replace(ConstantTable_L, &Constant_S); } #line 14408 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 753: #line 7427 "ProParser.y" /* yacc.c:1646 */ { Message::Info("[=%g] ? ",(yyvsp[-2].d)); char tmpstr[256]; fgets(tmpstr, sizeof(tmpstr), stdin); if(!strcmp(tmpstr,"\n")) Constant_S.Value.Float = (yyvsp[-2].d); else Constant_S.Value.Float = atof(tmpstr); Constant_S.Name = (yyvsp[-4].c); Constant_S.Type = VAR_FLOAT; Tree_Replace(ConstantTable_L, &Constant_S); } #line 14426 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 754: #line 7442 "ProParser.y" /* yacc.c:1646 */ { Print_Constants(); } #line 14434 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 755: #line 7449 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(20,20,sizeof(doubleXstring)); doubleXstring v = {(yyvsp[-2].d), (yyvsp[0].c)}; List_Add((yyval.l), &v); } #line 14444 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 756: #line 7455 "ProParser.y" /* yacc.c:1646 */ { doubleXstring v = {(yyvsp[-2].d), (yyvsp[0].c)}; List_Add((yyval.l), &v); } #line 14453 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 759: #line 7468 "ProParser.y" /* yacc.c:1646 */ { std::string key((yyvsp[-1].c)); for(int i = 0; i < List_Nbr((yyvsp[0].l)); i++){ double v; List_Read((yyvsp[0].l), i, &v); FloatOptions_S[key].push_back(v); } Free((yyvsp[-1].c)); List_Delete((yyvsp[0].l)); } #line 14468 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 760: #line 7480 "ProParser.y" /* yacc.c:1646 */ { std::string key((yyvsp[-3].c)); for(int i = 0; i < List_Nbr((yyvsp[-1].l)); i++){ doubleXstring v; List_Read((yyvsp[-1].l), i, &v); FloatOptions_S[key].push_back(v.d); CharOptions_S[key].push_back(v.s); } Free((yyvsp[-3].c)); for(int i = 0; i < List_Nbr((yyvsp[-1].l)); i++) Free(((doubleXstring*)List_Pointer((yyvsp[-1].l), i))->s); List_Delete((yyvsp[-1].l)); } #line 14486 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 761: #line 7495 "ProParser.y" /* yacc.c:1646 */ { std::string key((yyvsp[-1].c)); std::string val((yyvsp[0].c)); CharOptions_S[key].push_back(val); Free((yyvsp[-1].c)); Free((yyvsp[0].c)); } #line 14498 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 762: #line 7504 "ProParser.y" /* yacc.c:1646 */ { std::string key("Name"); std::string val((yyvsp[0].c)); CharOptions_S[key].push_back(val); Free((yyvsp[0].c)); } #line 14509 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 765: #line 7519 "ProParser.y" /* yacc.c:1646 */ { std::string key((yyvsp[-1].c)); double val = (yyvsp[0].d); FloatOptions_S[key].push_back(val); Free((yyvsp[-1].c)); } #line 14520 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 766: #line 7527 "ProParser.y" /* yacc.c:1646 */ { std::string key((yyvsp[-1].c)); std::string val((yyvsp[0].c)); CharOptions_S[key].push_back(val); Free((yyvsp[-1].c)); Free((yyvsp[0].c)); } #line 14532 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 767: #line 7536 "ProParser.y" /* yacc.c:1646 */ { std::string key("Name"); std::string val((yyvsp[0].c)); CharOptions_S[key].push_back(val); Free((yyvsp[0].c)); } #line 14543 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 768: #line 7544 "ProParser.y" /* yacc.c:1646 */ { std::string key("Macro"); std::string val((yyvsp[0].c)); CharOptions_S[key].push_back(val); Free((yyvsp[0].c)); } #line 14554 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 769: #line 7552 "ProParser.y" /* yacc.c:1646 */ { std::string key((yyvsp[-3].c)); for(int i = 0; i < List_Nbr((yyvsp[-1].l)); i++){ char *s; List_Read((yyvsp[-1].l), i, &s); std::string val(s); Free(s); CharOptions_S[key].push_back(val); } Free((yyvsp[-3].c)); List_Delete((yyvsp[-1].l)); } #line 14571 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 771: #line 7570 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[0].c); Constant_S.Type = VAR_FLOAT; FloatOptions_S.clear(); CharOptions_S.clear(); if(!Tree_Search(ConstantTable_L, &Constant_S)){ Constant_S.Value.Float = 0.; Tree_Replace(ConstantTable_L, &Constant_S); } } #line 14583 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 772: #line 7578 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Type = VAR_FLOAT ; FloatOptions_S.clear(); CharOptions_S.clear(); for (int k = 0 ; k < (int)(yyvsp[-1].d) ; k++) { char tmpstr[256]; sprintf(tmpstr, "%s_%d", (yyvsp[-3].c), k+1) ; Constant_S.Name = tmpstr ; if (!Tree_Search(ConstantTable_L, &Constant_S)) { Constant_S.Name = strSave(tmpstr); Constant_S.Value.Float = 0. ; Tree_Replace(ConstantTable_L, &Constant_S) ; } } Free((yyvsp[-3].c)) ; } #line 14603 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 773: #line 7594 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[-2].c); Constant_S.Type = VAR_FLOAT; if(!Tree_Search(ConstantTable_L, &Constant_S)){ Constant_S.Value.Float = (yyvsp[0].d); Tree_Replace(ConstantTable_L, &Constant_S); } } #line 14614 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 774: #line 7601 "ProParser.y" /* yacc.c:1646 */ { FloatOptions_S.clear(); CharOptions_S.clear(); } #line 14620 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 775: #line 7603 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[-6].c); if(List_Nbr((yyvsp[-3].l)) == 1){ Constant_S.Type = VAR_FLOAT; if(!Tree_Search(ConstantTable_L, &Constant_S)){ double d; List_Read((yyvsp[-3].l), 0, &d); Constant_S.Value.Float = d; Message::ExchangeOnelabParameter(&Constant_S, FloatOptions_S, CharOptions_S); Tree_Replace(ConstantTable_L, &Constant_S); } List_Delete((yyvsp[-3].l)); } else{ Constant_S.Type = VAR_LISTOFFLOAT; if(!Tree_Search(ConstantTable_L, &Constant_S)){ Constant_S.Value.ListOfFloat = (yyvsp[-3].l); Tree_Replace(ConstantTable_L, &Constant_S); } } } #line 14645 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 776: #line 7624 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[-2].c); Constant_S.Type = VAR_CHAR; if(!Tree_Search(ConstantTable_L, &Constant_S)){ Constant_S.Value.Char = (yyvsp[0].c); Tree_Replace(ConstantTable_L, &Constant_S); } } #line 14656 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 777: #line 7631 "ProParser.y" /* yacc.c:1646 */ { FloatOptions_S.clear(); CharOptions_S.clear(); } #line 14662 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 778: #line 7633 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[-6].c); Constant_S.Type = VAR_CHAR; if(!Tree_Search(ConstantTable_L, &Constant_S)){ Constant_S.Value.Char = (yyvsp[-3].c); Message::ExchangeOnelabParameter(&Constant_S, FloatOptions_S, CharOptions_S); Tree_Replace(ConstantTable_L, &Constant_S); } } #line 14674 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 780: #line 7646 "ProParser.y" /* yacc.c:1646 */ { // undefine the onelab parameter std::string name((yyvsp[0].c)); Message::UndefineOnelabParameter(name); Free((yyvsp[0].c)); } #line 14685 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 781: #line 7654 "ProParser.y" /* yacc.c:1646 */ { // undefine the onelab parameter and the getdp constant std::string name((yyvsp[0].c)); Message::UndefineOnelabParameter(name); Constant_S.Name = (yyvsp[0].c); Tree_Suppress(ConstantTable_L, &Constant_S); Free((yyvsp[0].c)); } #line 14698 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 782: #line 7668 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Exp"; } #line 14704 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 783: #line 7669 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Log"; } #line 14710 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 784: #line 7670 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Log10"; } #line 14716 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 785: #line 7671 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Sqrt"; } #line 14722 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 786: #line 7672 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Sin"; } #line 14728 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 787: #line 7673 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Asin"; } #line 14734 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 788: #line 7674 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Cos"; } #line 14740 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 789: #line 7675 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Acos"; } #line 14746 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 790: #line 7676 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Tan"; } #line 14752 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 791: #line 7677 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Atan"; } #line 14758 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 792: #line 7678 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Atan2"; } #line 14764 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 793: #line 7679 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Sinh"; } #line 14770 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 794: #line 7680 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Cosh"; } #line 14776 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 795: #line 7681 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Tanh"; } #line 14782 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 796: #line 7682 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Fabs"; } #line 14788 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 797: #line 7683 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Floor"; } #line 14794 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 798: #line 7684 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Ceil"; } #line 14800 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 799: #line 7685 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Round"; } #line 14806 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 800: #line 7686 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Sign"; } #line 14812 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 801: #line 7687 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Fmod"; } #line 14818 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 802: #line 7688 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Modulo"; } #line 14824 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 803: #line 7689 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Hypot"; } #line 14830 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 804: #line 7690 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"Rand"; } #line 14836 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 805: #line 7694 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (yyvsp[0].c); } #line 14842 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 806: #line 7695 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (yyvsp[0].c); } #line 14848 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 807: #line 7699 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[0].d); } #line 14854 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 808: #line 7700 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[-1].d); } #line 14860 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 809: #line 7701 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = -(yyvsp[0].d); } #line 14866 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 810: #line 7702 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = !(yyvsp[0].d); } #line 14872 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 811: #line 7703 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[-2].d) - (yyvsp[0].d); } #line 14878 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 812: #line 7704 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[-2].d) + (yyvsp[0].d); } #line 14884 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 813: #line 7705 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[-2].d) * (yyvsp[0].d); } #line 14890 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 814: #line 7706 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (int)(yyvsp[-2].d) | (int)(yyvsp[0].d); } #line 14896 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 815: #line 7707 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (int)(yyvsp[-2].d) & (int)(yyvsp[0].d); } #line 14902 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 816: #line 7708 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[-2].d) / (yyvsp[0].d); } #line 14908 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 817: #line 7709 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (int)(yyvsp[-2].d) % (int)(yyvsp[0].d); } #line 14914 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 818: #line 7710 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = pow((yyvsp[-2].d),(yyvsp[0].d)); } #line 14920 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 819: #line 7711 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[-2].d) < (yyvsp[0].d); } #line 14926 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 820: #line 7712 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[-2].d) > (yyvsp[0].d); } #line 14932 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 821: #line 7713 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[-2].d) <= (yyvsp[0].d); } #line 14938 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 822: #line 7714 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[-2].d) >= (yyvsp[0].d); } #line 14944 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 823: #line 7715 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[-2].d) == (yyvsp[0].d); } #line 14950 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 824: #line 7716 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[-2].d) != (yyvsp[0].d); } #line 14956 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 825: #line 7717 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[-2].d) && (yyvsp[0].d); } #line 14962 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 826: #line 7718 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[-2].d) || (yyvsp[0].d); } #line 14968 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 827: #line 7719 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = exp((yyvsp[-1].d)); } #line 14974 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 828: #line 7720 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = log((yyvsp[-1].d)); } #line 14980 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 829: #line 7721 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = log10((yyvsp[-1].d)); } #line 14986 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 830: #line 7722 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = sqrt((yyvsp[-1].d)); } #line 14992 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 831: #line 7723 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = sin((yyvsp[-1].d)); } #line 14998 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 832: #line 7724 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = asin((yyvsp[-1].d)); } #line 15004 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 833: #line 7725 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = cos((yyvsp[-1].d)); } #line 15010 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 834: #line 7726 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = acos((yyvsp[-1].d)); } #line 15016 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 835: #line 7727 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = tan((yyvsp[-1].d)); } #line 15022 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 836: #line 7728 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = atan((yyvsp[-1].d)); } #line 15028 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 837: #line 7729 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = atan2((yyvsp[-3].d),(yyvsp[-1].d)); } #line 15034 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 838: #line 7730 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = sinh((yyvsp[-1].d)); } #line 15040 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 839: #line 7731 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = cosh((yyvsp[-1].d)); } #line 15046 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 840: #line 7732 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = tanh((yyvsp[-1].d)); } #line 15052 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 841: #line 7733 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = fabs((yyvsp[-1].d)); } #line 15058 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 842: #line 7734 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = floor((yyvsp[-1].d)); } #line 15064 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 843: #line 7735 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = ceil((yyvsp[-1].d)); } #line 15070 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 844: #line 7736 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = floor((yyvsp[-1].d) + 0.5); } #line 15076 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 845: #line 7737 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (((yyvsp[-1].d) > 0.) ? 1. : ((yyvsp[-1].d) < 0.) ? -1. : 0.); } #line 15082 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 846: #line 7738 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = fmod((yyvsp[-3].d),(yyvsp[-1].d)); } #line 15088 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 847: #line 7739 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = fmod((yyvsp[-3].d),(yyvsp[-1].d)); } #line 15094 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 848: #line 7740 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = sqrt((yyvsp[-3].d)*(yyvsp[-3].d)+(yyvsp[-1].d)*(yyvsp[-1].d)); } #line 15100 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 849: #line 7741 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[-1].d) * (double)rand() / (double)RAND_MAX; } #line 15106 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 850: #line 7743 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[-4].d)? (yyvsp[-2].d) : (yyvsp[0].d); } #line 15112 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 851: #line 7745 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[0].i); } #line 15118 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 852: #line 7747 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[0].i); } #line 15124 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 853: #line 7749 "ProParser.y" /* yacc.c:1646 */ { Message::Direct("Value (line %ld) --> %.16g", getdp_yylinenum, (yyvsp[-1].d)); } #line 15130 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 854: #line 7754 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (yyvsp[0].d); } #line 15136 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 855: #line 7755 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (double)(yyvsp[0].i); } #line 15142 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 856: #line 7756 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = 3.1415926535897932; } #line 15148 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 857: #line 7757 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (double)_0D; } #line 15154 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 858: #line 7758 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (double)_1D; } #line 15160 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 859: #line 7759 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (double)_2D; } #line 15166 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 860: #line 7760 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (double)_3D; } #line 15172 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 861: #line 7761 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = (double)ImbricatedTest; } #line 15178 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 862: #line 7762 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = Message::GetCommRank(); } #line 15184 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 863: #line 7763 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = Message::GetCommSize(); } #line 15190 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 864: #line 7764 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = GETDP_MAJOR_VERSION; } #line 15196 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 865: #line 7765 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = GETDP_MINOR_VERSION; } #line 15202 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 866: #line 7766 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = GETDP_PATCH_VERSION; } #line 15208 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 867: #line 7767 "ProParser.y" /* yacc.c:1646 */ { (yyval.d) = GetTotalRam(); } #line 15214 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 868: #line 7770 "ProParser.y" /* yacc.c:1646 */ { FloatOptions_S.clear(); CharOptions_S.clear(); } #line 15220 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 869: #line 7772 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (char*)""; Constant_S.Type = VAR_FLOAT; Constant_S.Value.Float = (yyvsp[-3].d); Message::ExchangeOnelabParameter(&Constant_S, FloatOptions_S, CharOptions_S); (yyval.d) = Constant_S.Value.Float; } #line 15231 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 870: #line 7779 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[0].c); if(!Tree_Query(ConstantTable_L, &Constant_S)) { vyyerror("Unknown Constant: %s", (yyvsp[0].c)); (yyval.d) = 0.; } else { if(Constant_S.Type == VAR_FLOAT) (yyval.d) = Constant_S.Value.Float; else { vyyerror("Single value Constant needed: %s", (yyvsp[0].c)); (yyval.d) = 0.; } } Free((yyvsp[0].c)); } #line 15250 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 871: #line 7794 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[-2].c); int ret = 0; if(!Tree_Query(ConstantTable_L, &Constant_S)) vyyerror("Unknown Constant: %s", (yyvsp[-2].c)); else{ if(Constant_S.Type == VAR_LISTOFFLOAT) ret = List_Nbr(Constant_S.Value.ListOfFloat); else if(Constant_S.Type == VAR_FLOAT) ret = 1; else vyyerror("Float Constant needed: %s", (yyvsp[-2].c)); } (yyval.d) = ret; Free((yyvsp[-2].c)); } #line 15271 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 872: #line 7811 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[-3].c); double ret = 0.; if(!Tree_Query(ConstantTable_L, &Constant_S)) vyyerror("Unknown Constant: %s", (yyvsp[-3].c)); else{ if(Constant_S.Type != VAR_LISTOFFLOAT) vyyerror("Multi value Constant needed: %s", (yyvsp[-3].c)); else{ int j = (int)(yyvsp[-1].d); if(j >= 0 && j < List_Nbr(Constant_S.Value.ListOfFloat)) List_Read(Constant_S.Value.ListOfFloat, j, &ret); else vyyerror("Index %d out of range", j); } } (yyval.d) = ret; Free((yyvsp[-3].c)); } #line 15295 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 873: #line 7835 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = NULL; } #line 15301 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 874: #line 7838 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(1,1,sizeof(double)); } #line 15307 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 875: #line 7841 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(1,1,sizeof(double)); List_Add((yyval.l), &((yyvsp[0].d))); } #line 15316 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 876: #line 7847 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[0].l); } #line 15322 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 877: #line 7850 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-1].l); } #line 15328 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 878: #line 7853 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-1].l); for(int i = 0; i < List_Nbr((yyval.l)); i++){ double *pd = (double*)List_Pointer((yyval.l), i); (*pd) = - (*pd); } } #line 15340 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 879: #line 7862 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-1].l); for(int i = 0; i < List_Nbr((yyval.l)); i++){ double *pd = (double*)List_Pointer((yyval.l), i); (*pd) *= (yyvsp[-4].d); } } #line 15352 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 880: #line 7875 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(20,20,sizeof(double)); List_Add((yyval.l), &((yyvsp[0].d))); } #line 15361 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 881: #line 7881 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[0].l); } #line 15367 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 882: #line 7884 "ProParser.y" /* yacc.c:1646 */ { List_Add((yyval.l), &((yyvsp[0].d))); } #line 15373 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 883: #line 7887 "ProParser.y" /* yacc.c:1646 */ { for(int i = 0; i < List_Nbr((yyvsp[0].l)); i++){ double d; List_Read((yyvsp[0].l), i, &d); List_Add((yyval.l), &d); } List_Delete((yyvsp[0].l)); } #line 15386 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 884: #line 7900 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[0].l); for(int i = 0; i < List_Nbr((yyval.l)); i++){ double *pd = (double*)List_Pointer((yyval.l), i); *pd *= -1.0; } } #line 15398 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 885: #line 7909 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[0].l); for(int i = 0; i < List_Nbr((yyval.l)); i++){ double *pd = (double*)List_Pointer((yyval.l), i); *pd *= (yyvsp[-2].d); } } #line 15410 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 886: #line 7918 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-2].l); for(int i = 0; i < List_Nbr((yyval.l)); i++){ double *pd = (double*)List_Pointer((yyval.l), i); *pd *= (yyvsp[0].d); } } #line 15422 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 887: #line 7927 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[0].l); for(int i = 0; i < List_Nbr((yyval.l)); i++){ double *pd = (double*)List_Pointer((yyval.l), i); if(*pd) *pd = (yyvsp[-2].d) / *pd; } } #line 15434 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 888: #line 7936 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-2].l); for(int i = 0; i < List_Nbr((yyval.l)); i++){ double *pd = (double*)List_Pointer((yyval.l), i); if((yyvsp[0].d)) *pd /= (yyvsp[0].d); } } #line 15446 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 889: #line 7945 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-2].l); for(int i = 0; i < List_Nbr((yyval.l)); i++){ double *pd = (double*)List_Pointer((yyval.l), i); *pd = pow(*pd, (yyvsp[0].d)); } } #line 15458 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 890: #line 7954 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-2].l); if(List_Nbr((yyval.l)) == List_Nbr((yyvsp[0].l))){ for(int i = 0; i < List_Nbr((yyval.l)); i++){ double *pd = (double*)List_Pointer((yyval.l), i); double d = *(double*)List_Pointer((yyvsp[0].l), i); *pd += d; } } else vyyerror("Wrong list sizes %d != %d", List_Nbr((yyval.l)), List_Nbr((yyvsp[0].l))); List_Delete((yyvsp[0].l)); } #line 15476 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 891: #line 7969 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-2].l); if(List_Nbr((yyval.l)) == List_Nbr((yyvsp[0].l))){ for(int i = 0; i < List_Nbr((yyval.l)); i++){ double *pd = (double*)List_Pointer((yyval.l), i); double d = *(double*)List_Pointer((yyvsp[0].l), i); *pd -= d; } } else vyyerror("Wrong list sizes %d != %d", List_Nbr((yyval.l)), List_Nbr((yyvsp[0].l))); List_Delete((yyvsp[0].l)); } #line 15494 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 892: #line 7984 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-2].l); if(List_Nbr((yyval.l)) == List_Nbr((yyvsp[0].l))){ for(int i = 0; i < List_Nbr((yyval.l)); i++){ double *pd = (double*)List_Pointer((yyval.l), i); double d = *(double*)List_Pointer((yyvsp[0].l), i); *pd *= d; } } else vyyerror("Wrong list sizes %d != %d", List_Nbr((yyval.l)), List_Nbr((yyvsp[0].l))); List_Delete((yyvsp[0].l)); } #line 15512 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 893: #line 7999 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = (yyvsp[-2].l); if(List_Nbr((yyval.l)) == List_Nbr((yyvsp[0].l))){ for(int i = 0; i < List_Nbr((yyval.l)); i++){ double *pd = (double*)List_Pointer((yyval.l), i); double d = *(double*)List_Pointer((yyvsp[0].l), i); if(d) *pd /= d; } } else vyyerror("Wrong list sizes %d != %d", List_Nbr((yyval.l)), List_Nbr((yyvsp[0].l))); List_Delete((yyvsp[0].l)); } #line 15530 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 894: #line 8014 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(20,20,sizeof(double)); for(double d = (yyvsp[-2].d); ((yyvsp[-2].d) < (yyvsp[0].d)) ? (d <= (yyvsp[0].d)) : (d >= (yyvsp[0].d)); ((yyvsp[-2].d) < (yyvsp[0].d)) ? (d += 1.) : (d -= 1.)) List_Add((yyval.l), &d); } #line 15541 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 895: #line 8022 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(20,20,sizeof(double)); if(!(yyvsp[0].d) || ((yyvsp[-4].d)<(yyvsp[-2].d) && (yyvsp[0].d)<0) || ((yyvsp[-4].d)>(yyvsp[-2].d) && (yyvsp[0].d)>0)){ vyyerror("Wrong increment in '%g : %g : %g'", (yyvsp[-4].d), (yyvsp[-2].d), (yyvsp[0].d)); List_Add((yyval.l), &((yyvsp[-4].d))); } else for(double d = (yyvsp[-4].d); ((yyvsp[0].d) > 0) ? (d <= (yyvsp[-2].d)) : (d >= (yyvsp[-2].d)); d += (yyvsp[0].d)) List_Add((yyval.l), &d); } #line 15556 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 896: #line 8034 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(20,20,sizeof(double)); Constant_S.Name = (yyvsp[-2].c); if(!Tree_Query(ConstantTable_L, &Constant_S)) vyyerror("Unknown Constant: %s", (yyvsp[-2].c)); else if(Constant_S.Type != VAR_LISTOFFLOAT) /* vyyerror("Multi value Constant needed: %s", $1); */ List_Add((yyval.l), &Constant_S.Value.Float); else for(int i = 0; i < List_Nbr(Constant_S.Value.ListOfFloat); i++) { double d; List_Read(Constant_S.Value.ListOfFloat, i, &d); List_Add((yyval.l), &d); } } #line 15577 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 897: #line 8052 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(20,20,sizeof(double)); Constant_S.Name = (yyvsp[-2].c); if(!Tree_Query(ConstantTable_L, &Constant_S)) vyyerror("Unknown Constant: %s", (yyvsp[-2].c)); else if(Constant_S.Type != VAR_LISTOFFLOAT) /* vyyerror("Multi value Constant needed: %s", $1); */ List_Add((yyval.l), &Constant_S.Value.Float); else for(int i = 0; i < List_Nbr(Constant_S.Value.ListOfFloat); i++) { double d; List_Read(Constant_S.Value.ListOfFloat, i, &d); List_Add((yyval.l), &d); } } #line 15598 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 898: #line 8071 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(20,20,sizeof(double)); Constant_S.Name = (yyvsp[-2].c); if(!Tree_Query(ConstantTable_L, &Constant_S)) vyyerror("Unknown Constant: %s", (yyvsp[-2].c)); else if(Constant_S.Type != VAR_LISTOFFLOAT) /* vyyerror("Multi value Constant needed: %s", $1); */ List_Add((yyval.l), &Constant_S.Value.Float); else for(int i = 0; i < List_Nbr(Constant_S.Value.ListOfFloat); i++) { double d; List_Read(Constant_S.Value.ListOfFloat, i, &d); List_Add((yyval.l), &d); } } #line 15619 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 899: #line 8089 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(20,20,sizeof(double)); Constant_S.Name = (yyvsp[-5].c); if(!Tree_Query(ConstantTable_L, &Constant_S)) vyyerror("Unknown Constant: %s", (yyvsp[-5].c)); else if(Constant_S.Type != VAR_LISTOFFLOAT) vyyerror("Multi value Constant needed: %s", (yyvsp[-5].c)); else for(int i = 0; i < List_Nbr((yyvsp[-2].l)); i++) { int j = (int)(*(double*)List_Pointer((yyvsp[-2].l), i)); if(j >= 0 && j < List_Nbr(Constant_S.Value.ListOfFloat)){ double d; List_Read(Constant_S.Value.ListOfFloat, j, &d); List_Add((yyval.l), &d); } else{ vyyerror("Index %d out of range", j); double d = 0.; List_Add((yyval.l), &d); } } List_Delete((yyvsp[-2].l)); } #line 15648 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 900: #line 8115 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(20,20,sizeof(double)); Constant_S.Name = (yyvsp[-5].c); if(!Tree_Query(ConstantTable_L, &Constant_S)) vyyerror("Unknown Constant: %s", (yyvsp[-5].c)); else if(Constant_S.Type != VAR_LISTOFFLOAT) vyyerror("Multi value Constant needed: %s", (yyvsp[-5].c)); else for(int i = 0; i < List_Nbr((yyvsp[-2].l)); i++) { int j = (int)(*(double*)List_Pointer((yyvsp[-2].l), i)); if(j >= 0 && j < List_Nbr(Constant_S.Value.ListOfFloat)){ double d; List_Read(Constant_S.Value.ListOfFloat, j, &d); List_Add((yyval.l), &d); } else{ vyyerror("Index %d out of range", j); double d = 0.; List_Add((yyval.l), &d); } } List_Delete((yyvsp[-2].l)); } #line 15677 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 901: #line 8142 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(20,20,sizeof(double)); Constant_S.Name = (yyvsp[-1].c); if(!Tree_Query(ConstantTable_L, &Constant_S)) vyyerror("Unknown Constant: %s", (yyvsp[-1].c)); else if(Constant_S.Type != VAR_LISTOFFLOAT) vyyerror("Multi value Constant needed: %s", (yyvsp[-1].c)); else for(int i = 0; i < List_Nbr(Constant_S.Value.ListOfFloat); i++) { double d; List_Read(Constant_S.Value.ListOfFloat, i, &d); List_Add((yyval.l), &d); } } #line 15697 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 902: #line 8159 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(20,20,sizeof(double)); Constant1_S.Name = (yyvsp[-3].c); Constant2_S.Name = (yyvsp[-1].c); if(!Tree_Query(ConstantTable_L, &Constant1_S)) { vyyerror("Unknown Constant: %s", (yyvsp[-3].c)); } else if(Constant1_S.Type != VAR_LISTOFFLOAT) { vyyerror("Multi value Constant needed: %s", (yyvsp[-3].c)); } else { if(!Tree_Query(ConstantTable_L, &Constant2_S)) { vyyerror("Unknown Constant: %s", (yyvsp[-1].c)); } else if(Constant2_S.Type != VAR_LISTOFFLOAT) { vyyerror("Multi value Constant needed: %s", (yyvsp[-1].c)); } else { if(List_Nbr(Constant1_S.Value.ListOfFloat) != List_Nbr(Constant2_S.Value.ListOfFloat)) { vyyerror("Different dimensions of Multi value Constants: " "%s {%d}, %s {%d}", (yyvsp[-3].c), List_Nbr(Constant1_S.Value.ListOfFloat), (yyvsp[-1].c), List_Nbr(Constant2_S.Value.ListOfFloat)); } else { for(int i = 0; i < List_Nbr(Constant1_S.Value.ListOfFloat); i++) { double d; List_Read(Constant1_S.Value.ListOfFloat, i, &d); List_Add((yyval.l), &d); List_Read(Constant2_S.Value.ListOfFloat, i, &d); List_Add((yyval.l), &d); } } } } Free((yyvsp[-3].c)); Free((yyvsp[-1].c)); } #line 15741 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 903: #line 8200 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(20,20,sizeof(double)); if(List_Nbr((yyvsp[-3].l)) != List_Nbr((yyvsp[-1].l))) { vyyerror("Different dimensions of lists: %d != %d", List_Nbr((yyvsp[-3].l)), List_Nbr((yyvsp[-1].l))); } else { for(int i = 0; i < List_Nbr((yyvsp[-3].l)); i++) { double d; List_Read((yyvsp[-3].l), i, &d); List_Add((yyval.l), &d); List_Read((yyvsp[-1].l), i, &d); List_Add((yyval.l), &d); } } List_Delete((yyvsp[-3].l)); List_Delete((yyvsp[-1].l)); } #line 15764 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 904: #line 8220 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(20,20,sizeof(double)); for(int i = 0; i < (int)(yyvsp[-1].d); i++) { double d = (yyvsp[-5].d) + ((yyvsp[-3].d)-(yyvsp[-5].d))*(double)i/((yyvsp[-1].d)-1); List_Add((yyval.l), &d); } } #line 15776 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 905: #line 8229 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(20,20,sizeof(double)); for(int i = 0; i < (int)(yyvsp[-1].d); i++) { double d = pow(10,(yyvsp[-5].d) + ((yyvsp[-3].d)-(yyvsp[-5].d))*(double)i/((yyvsp[-1].d)-1)); List_Add((yyval.l), &d); } } #line 15788 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 906: #line 8238 "ProParser.y" /* yacc.c:1646 */ { Message::Barrier(); FILE *File; if(!(File = FOpen(Fix_RelativePath((yyvsp[-1].c)).c_str(), "rb"))){ Message::Warning("Could not open file '%s'", (yyvsp[-1].c)); } else{ (yyval.l) = List_Create(100,100,sizeof(double)); double d; while(!feof(File)) if(fscanf(File, "%lf", &d) != EOF) List_Add((yyval.l), &d); fclose(File); } Free((yyvsp[-1].c)); } #line 15809 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 907: #line 8259 "ProParser.y" /* yacc.c:1646 */ { char tmpstr[256]; sprintf(tmpstr, "_%d", (int)(yyvsp[-1].d)); (yyval.c) = (char *)Malloc((strlen((yyvsp[-4].c))+strlen(tmpstr)+1)*sizeof(char)); strcpy((yyval.c), (yyvsp[-4].c)); strcat((yyval.c), tmpstr); Free((yyvsp[-4].c)); } #line 15821 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 908: #line 8268 "ProParser.y" /* yacc.c:1646 */ { char tmpstr[256]; sprintf(tmpstr, "_%d", (int)(yyvsp[-1].d)); (yyval.c) = (char *)Malloc((strlen((yyvsp[-4].c))+strlen(tmpstr)+1)*sizeof(char)) ; strcpy((yyval.c), (yyvsp[-4].c)) ; strcat((yyval.c), tmpstr) ; Free((yyvsp[-4].c)); } #line 15833 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 909: #line 8281 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (yyvsp[0].c); } #line 15839 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 910: #line 8284 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (yyvsp[0].c); } #line 15845 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 911: #line 8288 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (yyvsp[-1].c); } #line 15851 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 912: #line 8294 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (yyvsp[0].c); } #line 15857 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 913: #line 8297 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (yyvsp[-1].c); } #line 15863 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 914: #line 8300 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (yyvsp[0].c); } #line 15871 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 915: #line 8305 "ProParser.y" /* yacc.c:1646 */ { int i = 0; while ((yyvsp[-1].c)[i]) { (yyvsp[-1].c)[i] = toupper((yyvsp[-1].c)[i]); i++; } (yyval.c) = (yyvsp[-1].c); } #line 15884 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 916: #line 8315 "ProParser.y" /* yacc.c:1646 */ { int i = 0; while ((yyvsp[-1].c)[i]) { (yyvsp[-1].c)[i] = tolower((yyvsp[-1].c)[i]); i++; } (yyval.c) = (yyvsp[-1].c); } #line 15897 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 917: #line 8325 "ProParser.y" /* yacc.c:1646 */ { int i=0; while ((yyvsp[-1].c)[i]) { if (i > 0 && (yyvsp[-1].c)[i-1] != '_') (yyvsp[-1].c)[i] = tolower((yyvsp[-1].c)[i]); i++; } (yyval.c) = (yyvsp[-1].c); } #line 15911 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 918: #line 8336 "ProParser.y" /* yacc.c:1646 */ { int size = 1; for(int i = 0; i < List_Nbr((yyvsp[-1].l)); i++){ char *s; List_Read((yyvsp[-1].l), i, &s); size += strlen(s) + 1; } (yyval.c) = (char*)Malloc(size * sizeof(char)); (yyval.c)[0] = '\0'; for(int i = 0; i < List_Nbr((yyvsp[-1].l)); i++){ char *s; List_Read((yyvsp[-1].l), i, &s); strcat((yyval.c), s); Free(s);//FIXME if(i != List_Nbr((yyvsp[-1].l)) - 1) strcat((yyval.c), "\n"); } List_Delete((yyvsp[-1].l)); } #line 15934 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 919: #line 8356 "ProParser.y" /* yacc.c:1646 */ { if((yyvsp[-5].d)){ (yyval.c) = (yyvsp[-3].c); Free((yyvsp[-1].c)); } else{ (yyval.c) = (yyvsp[-1].c); Free((yyvsp[-3].c)); } } #line 15949 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 920: #line 8368 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (yyvsp[-1].c); } #line 15957 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 921: #line 8373 "ProParser.y" /* yacc.c:1646 */ { char tmpstr[256]; int i = Print_ListOfDouble((yyvsp[-3].c),(yyvsp[-1].l),tmpstr); if(i<0){ vyyerror("Too few arguments in Sprintf"); (yyval.c) = (yyvsp[-3].c); } else if(i>0){ vyyerror("Too many arguments (%d) in Sprintf", i); (yyval.c) = (yyvsp[-3].c); } else{ (yyval.c) = (char*)Malloc((strlen(tmpstr)+1)*sizeof(char)); strcpy((yyval.c), tmpstr); Free((yyvsp[-3].c)); } List_Delete((yyvsp[-1].l)); } #line 15980 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 922: #line 8393 "ProParser.y" /* yacc.c:1646 */ { time_t date_info; time(&date_info); (yyval.c) = (char *)Malloc((strlen(ctime(&date_info))+1)*sizeof(char)); strcpy((yyval.c), ctime(&date_info)); (yyval.c)[strlen((yyval.c))-1] = 0; } #line 15992 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 923: #line 8402 "ProParser.y" /* yacc.c:1646 */ { std::string action = Message::GetOnelabAction(); (yyval.c) = (char *)Malloc(action.size() + 1); strcpy((yyval.c), action.c_str()); } #line 16002 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 924: #line 8409 "ProParser.y" /* yacc.c:1646 */ { std::string tmp = GetDir(getdp_yyname); (yyval.c) = (char*)Malloc((tmp.size() + 1) * sizeof(char)); strcpy((yyval.c), tmp.c_str()); } #line 16012 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 925: #line 8416 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = strSave(Fix_RelativePath((yyvsp[-1].c)).c_str()); Free((yyvsp[-1].c)); } #line 16021 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 926: #line 8422 "ProParser.y" /* yacc.c:1646 */ { FloatOptions_S.clear(); CharOptions_S.clear(); } #line 16027 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 927: #line 8424 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (char*)""; Constant_S.Type = VAR_CHAR; Constant_S.Value.Char = (yyvsp[-3].c); Message::ExchangeOnelabParameter(&Constant_S, FloatOptions_S, CharOptions_S); (yyval.c) = strSave(Constant_S.Value.Char); Free((yyvsp[-3].c)); } #line 16039 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 928: #line 8436 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (yyvsp[0].c); } #line 16045 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 929: #line 8439 "ProParser.y" /* yacc.c:1646 */ { Constant_S.Name = (yyvsp[0].c); if(!Tree_Query(ConstantTable_L, &Constant_S)) { vyyerror("Unknown Constant: %s", (yyvsp[0].c)); (yyval.c) = NULL; } else { if(Constant_S.Type == VAR_CHAR) (yyval.c) = strSave(Constant_S.Value.Char); else { vyyerror("String Constant needed: %s", (yyvsp[0].c)); (yyval.c) = NULL; } } Free((yyvsp[0].c)); } #line 16064 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 930: #line 8458 "ProParser.y" /* yacc.c:1646 */ { (yyval.l) = List_Create(20,20,sizeof(char*)); List_Add((yyval.l), &((yyvsp[0].c))); } #line 16073 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 931: #line 8463 "ProParser.y" /* yacc.c:1646 */ { List_Add((yyval.l), &((yyvsp[0].c))); } #line 16079 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 932: #line 8469 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"("; } #line 16085 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 933: #line 8469 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"["; } #line 16091 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 934: #line 8470 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)")"; } #line 16097 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 935: #line 8470 "ProParser.y" /* yacc.c:1646 */ { (yyval.c) = (char*)"]"; } #line 16103 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 936: #line 8475 "ProParser.y" /* yacc.c:1646 */ { int size = 1; for(int i = 0; i < List_Nbr((yyvsp[-1].l)); i++){ char *s; List_Read((yyvsp[-1].l), i, &s); size += strlen(s) + 1; } (yyval.c) = (char*)Malloc(size * sizeof(char)); (yyval.c)[0] = '\0'; for(int i = 0; i < List_Nbr((yyvsp[-1].l)); i++){ char *s; List_Read((yyvsp[-1].l), i, &s); strcat((yyval.c), s); Free(s); } List_Delete((yyvsp[-1].l)); } #line 16125 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 937: #line 8497 "ProParser.y" /* yacc.c:1646 */ { if ((yyvsp[-3].c) != NULL && (yyvsp[-1].c) != NULL) { (yyval.i) = strcmp((yyvsp[-3].c), (yyvsp[-1].c)); } else { vyyerror("Undefined argument for StrCmp function") ; (yyval.i) = 1 ; } } #line 16138 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 938: #line 8510 "ProParser.y" /* yacc.c:1646 */ { int i; if ( (i = List_ISearchSeq(Problem_S.Group, (yyvsp[-1].c), fcmp_Group_Name)) >= 0 ) { (yyval.i) = List_Nbr(((struct Group *)List_Pointer(Problem_S.Group, i)) ->InitialList) ; } else { vyyerror("Unknown Group: %s", (yyvsp[-1].c)) ; (yyval.i) = 0 ; } } #line 16153 "ProParser.tab.cpp" /* yacc.c:1646 */ break; case 939: #line 8521 "ProParser.y" /* yacc.c:1646 */ { int i, j, indexInGroup; indexInGroup = (int)(yyvsp[-1].d); if ( (i = List_ISearchSeq(Problem_S.Group, (yyvsp[-3].c), fcmp_Group_Name)) >= 0 ) { if (indexInGroup >= 1 && indexInGroup <= List_Nbr(((struct Group *)List_Pointer(Problem_S.Group, i)) ->InitialList)) { List_Read(((struct Group *)List_Pointer(Problem_S.Group, i))->InitialList, indexInGroup-1, &j) ; (yyval.i) = j; } else { vyyerror("GetRegion: Index out of range [1..%d]", List_Nbr(((struct Group *)List_Pointer(Problem_S.Group, i)) ->InitialList)) ; (yyval.i) = 0 ; } } else { vyyerror("Unknown Group: %s", (yyvsp[-3].c)) ; (yyval.i) = 0 ; } } #line 16180 "ProParser.tab.cpp" /* yacc.c:1646 */ break; #line 16184 "ProParser.tab.cpp" /* yacc.c:1646 */ default: break; } /* User semantic actions sometimes alter yychar, and that requires that yytoken be updated with the new translation. We take the approach of translating immediately before every use of yytoken. One alternative is translating here after every semantic action, but that translation would be missed if the semantic action invokes YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or if it invokes YYBACKUP. In the case of YYABORT or YYACCEPT, an incorrect destructor might then be invoked immediately. In the case of YYERROR or YYBACKUP, subsequent parser actions might lead to an incorrect destructor call or verbose syntax error message before the lookahead is translated. */ YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc); YYPOPSTACK (yylen); yylen = 0; YY_STACK_PRINT (yyss, yyssp); *++yyvsp = yyval; /* Now 'shift' the result of the reduction. Determine what state that goes to, based on the state we popped back to and the rule number reduced by. */ yyn = yyr1[yyn]; yystate = yypgoto[yyn - YYNTOKENS] + *yyssp; if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp) yystate = yytable[yystate]; else yystate = yydefgoto[yyn - YYNTOKENS]; goto yynewstate; /*--------------------------------------. | yyerrlab -- here on detecting error. | `--------------------------------------*/ yyerrlab: /* Make sure we have latest lookahead translation. See comments at user semantic actions for why this is necessary. */ yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar); /* If not already recovering from an error, report this error. */ if (!yyerrstatus) { ++yynerrs; #if ! YYERROR_VERBOSE yyerror (YY_("syntax error")); #else # define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \ yyssp, yytoken) { char const *yymsgp = YY_("syntax error"); int yysyntax_error_status; yysyntax_error_status = YYSYNTAX_ERROR; if (yysyntax_error_status == 0) yymsgp = yymsg; else if (yysyntax_error_status == 1) { if (yymsg != yymsgbuf) YYSTACK_FREE (yymsg); yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc); if (!yymsg) { yymsg = yymsgbuf; yymsg_alloc = sizeof yymsgbuf; yysyntax_error_status = 2; } else { yysyntax_error_status = YYSYNTAX_ERROR; yymsgp = yymsg; } } yyerror (yymsgp); if (yysyntax_error_status == 2) goto yyexhaustedlab; } # undef YYSYNTAX_ERROR #endif } if (yyerrstatus == 3) { /* If just tried and failed to reuse lookahead token after an error, discard it. */ if (yychar <= YYEOF) { /* Return failure if at end of input. */ if (yychar == YYEOF) YYABORT; } else { yydestruct ("Error: discarding", yytoken, &yylval); yychar = YYEMPTY; } } /* Else will try to reuse lookahead token after shifting the error token. */ goto yyerrlab1; /*---------------------------------------------------. | yyerrorlab -- error raised explicitly by YYERROR. | `---------------------------------------------------*/ yyerrorlab: /* Pacify compilers like GCC when the user code never invokes YYERROR and the label yyerrorlab therefore never appears in user code. */ if (/*CONSTCOND*/ 0) goto yyerrorlab; /* Do not reclaim the symbols of the rule whose action triggered this YYERROR. */ YYPOPSTACK (yylen); yylen = 0; YY_STACK_PRINT (yyss, yyssp); yystate = *yyssp; goto yyerrlab1; /*-------------------------------------------------------------. | yyerrlab1 -- common code for both syntax error and YYERROR. | `-------------------------------------------------------------*/ yyerrlab1: yyerrstatus = 3; /* Each real token shifted decrements this. */ for (;;) { yyn = yypact[yystate]; if (!yypact_value_is_default (yyn)) { yyn += YYTERROR; if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) { yyn = yytable[yyn]; if (0 < yyn) break; } } /* Pop the current state because it cannot handle the error token. */ if (yyssp == yyss) YYABORT; yydestruct ("Error: popping", yystos[yystate], yyvsp); YYPOPSTACK (1); yystate = *yyssp; YY_STACK_PRINT (yyss, yyssp); } YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN *++yyvsp = yylval; YY_IGNORE_MAYBE_UNINITIALIZED_END /* Shift the error token. */ YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp); yystate = yyn; goto yynewstate; /*-------------------------------------. | yyacceptlab -- YYACCEPT comes here. | `-------------------------------------*/ yyacceptlab: yyresult = 0; goto yyreturn; /*-----------------------------------. | yyabortlab -- YYABORT comes here. | `-----------------------------------*/ yyabortlab: yyresult = 1; goto yyreturn; #if !defined yyoverflow || YYERROR_VERBOSE /*-------------------------------------------------. | yyexhaustedlab -- memory exhaustion comes here. | `-------------------------------------------------*/ yyexhaustedlab: yyerror (YY_("memory exhausted")); yyresult = 2; /* Fall through. */ #endif yyreturn: if (yychar != YYEMPTY) { /* Make sure we have latest lookahead translation. See comments at user semantic actions for why this is necessary. */ yytoken = YYTRANSLATE (yychar); yydestruct ("Cleanup: discarding lookahead", yytoken, &yylval); } /* Do not reclaim the symbols of the rule whose action triggered this YYABORT or YYACCEPT. */ YYPOPSTACK (yylen); YY_STACK_PRINT (yyss, yyssp); while (yyssp != yyss) { yydestruct ("Cleanup: popping", yystos[*yyssp], yyvsp); YYPOPSTACK (1); } #ifndef yyoverflow if (yyss != yyssa) YYSTACK_FREE (yyss); #endif #if YYERROR_VERBOSE if (yymsg != yymsgbuf) YYSTACK_FREE (yymsg); #endif return yyresult; } #line 8545 "ProParser.y" /* yacc.c:1906 */ // This is a hack... Bison redefines 'const' if !__cplusplus and !__STDC__ #ifdef const #undef const #endif void Alloc_ParserVariables() { if(!ConstantTable_L) { ConstantTable_L = Tree_Create(sizeof(struct Constant), fcmp_Constant); for(std::map >::iterator it = CommandLineNumbers.begin(); it != CommandLineNumbers.end(); it++){ std::vector &v(it->second); Constant_S.Name = strdup(it->first.c_str()); if(v.size() == 1){ Message::Info("Adding number %s = %g", it->first.c_str(), v[0]); Constant_S.Type = VAR_FLOAT; Constant_S.Value.Float = v[0]; } else{ Message::Info("Adding list of numbers %s", it->first.c_str()); Constant_S.Type = VAR_LISTOFFLOAT; Constant_S.Value.ListOfFloat = List_Create(v.size(), 1, sizeof(double)); for(unsigned int i = 0; i < v.size(); i ++) List_Add(Constant_S.Value.ListOfFloat, &v[i]); } Tree_Add(ConstantTable_L, &Constant_S); } for(std::map::iterator it = CommandLineStrings.begin(); it != CommandLineStrings.end(); it++){ Message::Info("Adding string %s = \"%s\"", it->first.c_str(), it->second.c_str()); Constant_S.Name = strdup(it->first.c_str()); Constant_S.Type = VAR_CHAR; Constant_S.Value.Char = strdup(it->second.c_str()); Tree_Add(ConstantTable_L, &Constant_S); } ListOfInt_L = List_Create(20, 10, sizeof(int)); ListOfPointer_L = List_Create(10, 10, sizeof(void *)); ListOfPointer2_L= List_Create(10, 10, sizeof(void *)); ListOfChar_L = List_Create(128, 128, sizeof(char)); ListOfFormulation = List_Create(5,5, sizeof(int)); ListOfBasisFunction = List_Create(5,5, sizeof(List_T *)); ListOfEntityIndex = List_Create(5,5, sizeof(int)); } } void Free_ParserVariables() { Tree_Delete(ConstantTable_L); ConstantTable_L = 0; List_Delete(ListOfInt_L); ListOfInt_L = 0; List_Delete(ListOfPointer_L); ListOfPointer_L = 0; List_Delete(ListOfPointer2_L); ListOfPointer2_L = 0; List_Delete(ListOfChar_L); ListOfChar_L = 0; List_Delete(ListOfFormulation); ListOfFormulation = 0; List_Delete(ListOfBasisFunction); ListOfBasisFunction = 0; List_Delete(ListOfEntityIndex); ListOfEntityIndex = 0; getdp_yyname = ""; strcpy(getdp_yyincludename, ""); getdp_yylinenum = 0; getdp_yycolnum = 0; getdp_yyincludenum = 0; getdp_yyerrorlevel = 0; CommandLineNumbers.clear(); CommandLineStrings.clear(); } /* A d d _ G r o u p & C o . */ int Add_Group(struct Group *Group_P, char *Name, bool Flag_Add, int Flag_Plus, int Num_Index) { if(!Problem_S.Group) Problem_S.Group = List_Create(50, 50, sizeof (struct Group)); char tmpstr[256]; switch (Flag_Plus) { case 1 : sprintf(tmpstr, "_%s_%d", Name, List_Nbr(Problem_S.Group)); Group_P->Name = strSave(tmpstr); break; case 2 : sprintf(tmpstr, "%s_%d", Name, Num_Index); Group_P->Name = strSave(tmpstr); break; default : Group_P->Name = Name; } int i; if((i = List_ISearchSeq(Problem_S.Group, Group_P->Name, fcmp_Group_Name)) < 0) { i = Group_P->Num = List_Nbr(Problem_S.Group); Group_P->ExtendedList = NULL; Group_P->ExtendedSuppList = NULL; List_Add(Problem_S.Group, Group_P); } else if(Flag_Add) { List_T *InitialList = ((struct Group *)List_Pointer(Problem_S.Group, i))->InitialList; for(int j = 0; j < List_Nbr(Group_P->InitialList); j++) { List_Add(InitialList, (int *)List_Pointer(Group_P->InitialList, j)); } } else List_Write(Problem_S.Group, i, Group_P); return i; } int Num_Group(struct Group *Group_P, char *Name, int Num_Group) { if (Num_Group >= 0) /* OK */; else if(Num_Group == -1) Num_Group = Add_Group(Group_P, Name, false, 1, 0); else vyyerror("Bad Group right hand side"); return Num_Group; } void Fill_GroupInitialListFromString(List_T *list, const char *str) { bool found = false; // try to find a group with name "str" for(int i = 0; i < List_Nbr(Problem_S.Group); i++){ struct Group *Group_P = (struct Group*)List_Pointer(Problem_S.Group, i); if(!strcmp(str, Group_P->Name)){ List_Copy(Group_P->InitialList, list); found = true; break; } } // try to find a constant with name "str" Constant_S.Name = (char*)str; Constant *Constant_P = (Constant*)Tree_PQuery(ConstantTable_L, &Constant_S); if(Constant_P){ switch(Constant_P->Type){ case VAR_FLOAT: { int num = (int)Constant_P->Value.Float; List_Add(list, &num); } found = true; break; case VAR_LISTOFFLOAT: for(int j = 0; j < List_Nbr(Constant_P->Value.ListOfFloat); j++){ double d; List_Read(Constant_P->Value.ListOfFloat, j, &d); int num = (int)d; List_Add(list, &num); } found = true; break; } } // if not, try to convert "str" to an integer if(!found){ int num = atoi(str); if(num > 0){ List_Add(list, &num); found = true; } } if(!found) vyyerror("Unknown Group '%s'", str); } /* A d d _ E x p r e s s i o n */ int Add_Expression(struct Expression *Expression_P, char *Name, int Flag_Plus) { if(!Problem_S.Expression) Problem_S.Expression = List_Create(50, 50, sizeof (struct Expression)); switch (Flag_Plus) { case 1 : char tmpstr[256]; sprintf(tmpstr, "_%s_%d", Name, List_Nbr(Problem_S.Expression)) ; Expression_P->Name = strSave(tmpstr) ; break ; case 2 : Expression_P->Name = strSave(Name) ; break ; default : Expression_P->Name = Name ; } int i; if((i = List_ISearchSeq (Problem_S.Expression, Name, fcmp_Expression_Name)) < 0) { i = List_Nbr(Problem_S.Expression); List_Add(Problem_S.Expression, Expression_P); } else List_Write(Problem_S.Expression, i, Expression_P); return i; } bool Is_ExpressionPieceWiseDefined(int index) { struct Expression *e = (struct Expression *)List_Pointer(Problem_S.Expression, index); if(e->Type == PIECEWISEFUNCTION) return true; else if(e->Type == WHOLEQUANTITY){ for(int i = 0; i < List_Nbr(e->Case.WholeQuantity); i++){ struct WholeQuantity *w = (struct WholeQuantity *)List_Pointer(e->Case.WholeQuantity, i); if(w->Type == WQ_EXPRESSION) return Is_ExpressionPieceWiseDefined(w->Case.Expression.Index); } } return false; } /* L i s t e I n d e x d e s D e f i n e Q u a n t i t y */ void Pro_DefineQuantityIndex_1(List_T *WholeQuantity_L, int TraceGroupIndex, std::vector > &pairs) { struct WholeQuantity *WholeQuantity_P; WholeQuantity_P = (List_Nbr(WholeQuantity_L) > 0)? (struct WholeQuantity*)List_Pointer(WholeQuantity_L, 0) : NULL; for(int i = 0; i < List_Nbr(WholeQuantity_L); i++) switch ((WholeQuantity_P+i)->Type) { case WQ_OPERATORANDQUANTITY : case WQ_OPERATORANDQUANTITYEVAL : case WQ_SOLIDANGLE : case WQ_ORDER : { std::pair p((WholeQuantity_P+i)->Case.OperatorAndQuantity.Index, TraceGroupIndex); if(std::find(pairs.begin(), pairs.end(), p) == pairs.end()) pairs.push_back(p); } break; case WQ_MHTRANSFORM : Pro_DefineQuantityIndex_1 ((WholeQuantity_P+i)->Case.MHTransform.WholeQuantity, TraceGroupIndex, pairs); case WQ_TIMEDERIVATIVE : Pro_DefineQuantityIndex_1 ((WholeQuantity_P+i)->Case.TimeDerivative.WholeQuantity, TraceGroupIndex, pairs); break; case WQ_ATANTERIORTIMESTEP : Pro_DefineQuantityIndex_1 ((WholeQuantity_P+i)->Case.AtAnteriorTimeStep.WholeQuantity, TraceGroupIndex, pairs); break; case WQ_MAXOVERTIME : case WQ_FOURIERSTEINMETZ : Pro_DefineQuantityIndex_1 ((WholeQuantity_P+i)->Case.AtAnteriorTimeStep.WholeQuantity, TraceGroupIndex, pairs); break; case WQ_CAST : Pro_DefineQuantityIndex_1 ((WholeQuantity_P+i)->Case.Cast.WholeQuantity, TraceGroupIndex, pairs); break; case WQ_TRACE : Pro_DefineQuantityIndex_1 ((WholeQuantity_P+i)->Case.Trace.WholeQuantity, (WholeQuantity_P+i)->Case.Trace.InIndex, pairs); break; case WQ_TEST : Pro_DefineQuantityIndex_1 ((WholeQuantity_P+i)->Case.Test.WholeQuantity_True, TraceGroupIndex, pairs); Pro_DefineQuantityIndex_1 ((WholeQuantity_P+i)->Case.Test.WholeQuantity_False, TraceGroupIndex, pairs); break; } std::sort(pairs.begin(), pairs.end()); } void Pro_DefineQuantityIndex(List_T *WholeQuantity_L, int DefineQuantityIndexEqu, int *NbrQuantityIndex, int **QuantityIndexTable, int **QuantityTraceGroupIndexTable) { std::vector > pairs; /* special case for the Equ part (right of the comma) FIXME: change this when we allow a full WholeQuantity expression there */ Pro_DefineQuantityIndex_1(WholeQuantity_L, -1, pairs); if(DefineQuantityIndexEqu >= 0){ std::pair p(DefineQuantityIndexEqu, -1); pairs.push_back(p); } *NbrQuantityIndex = pairs.size(); *QuantityIndexTable = (int *)Malloc(pairs.size() * sizeof(int)); *QuantityTraceGroupIndexTable = (int *)Malloc(pairs.size() * sizeof(int)); for(unsigned int i = 0; i < pairs.size(); i++){ (*QuantityIndexTable)[i] = pairs[i].first; (*QuantityTraceGroupIndexTable)[i] = pairs[i].second; } } /* C h e c k _ N a m e O f S t r u c t N o t E x i s t */ void Check_NameOfStructNotExist(const char *Struct, List_T *List_L, void *data, int (*fcmp)(const void *a, const void *b)) { if(List_ISearchSeq(List_L, data, fcmp) >= 0) vyyerror("Redefinition of %s %s", Struct, (char*)data); } /* P r i n t _ C o n s t a n t */ int Print_ListOfDouble(char *format, List_T *list, char *buffer) { // if format does not contain formatting characters, dump the list (useful for // quick debugging of lists) int numFormats = 0; for(unsigned int i = 0; i < strlen(format); i++) if(format[i] == '%') numFormats++; if(!numFormats){ strcpy(buffer, format); for(int i = 0; i < List_Nbr(list); i++){ double d; List_Read(list, i, &d); char tmp[256]; sprintf(tmp, " [%d]%g", i, d); strcat(buffer, tmp); } return 0; } char tmp1[256], tmp2[256]; int j = 0, k = 0; buffer[j] = '\0'; while(j < (int)strlen(format) && format[j] != '%') j++; strncpy(buffer, format, j); buffer[j] = '\0'; for(int i = 0; i < List_Nbr(list); i++){ k = j; j++; if(j < (int)strlen(format)){ if(format[j] == '%'){ strcat(buffer, "%"); j++; } while(j < (int)strlen(format) && format[j] != '%') j++; if(k != j){ strncpy(tmp1, &(format[k]), j-k); tmp1[j-k] = '\0'; sprintf(tmp2, tmp1, *(double*)List_Pointer(list, i)); strcat(buffer, tmp2); } } else return List_Nbr(list) - i; } if(j != (int)strlen(format)) return -1; return 0; } void Print_Constants() { struct Constant *Constant_P; Message::Check("Constants:\n"); List_T *tmp = Tree2List(ConstantTable_L); for(int i = 0; i < List_Nbr(tmp); i++){ Constant_P = (struct Constant*)List_Pointer(tmp, i); switch(Constant_P->Type){ case VAR_FLOAT: Message::Check("%s = %g;\n", Constant_P->Name, Constant_P->Value.Float); break; case VAR_LISTOFFLOAT: { std::string str(Constant_P->Name); str += " = {"; for(int j = 0; j < List_Nbr(Constant_P->Value.ListOfFloat); j++){ if(j) str += ","; double d; List_Read(Constant_P->Value.ListOfFloat, j, &d); char tmp[32]; sprintf(tmp, "%g", d); str += tmp; } str += "};\n"; Message::Check(str.c_str()); } break; case VAR_CHAR: Message::Check("%s = \"%s\";\n", Constant_P->Name, Constant_P->Value.Char); break; } } List_Delete(tmp); } /* E r r o r h a n d l i n g */ void yyerror(const char *s) { extern char *getdp_yytext; Message::Error("'%s', line %ld : %s (%s)", getdp_yyname.c_str(), getdp_yylinenum, s, getdp_yytext); getdp_yyerrorlevel = 1; } void vyyerror(const char *fmt, ...) { char str[256]; va_list args; va_start(args, fmt); vsprintf(str, fmt, args); va_end(args); Message::Error("'%s', line %ld : %s", getdp_yyname.c_str(), getdp_yylinenum, str); getdp_yyerrorlevel = 1; } getdp-2.7.0-source/Interface/MacroManager.cpp000644 001750 001750 00000004011 12606421313 022533 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular, C. Geuzaine // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include #include #include #include "MacroManager.h" class File_Position { public: long int lineno; fpos_t position; FILE *file; std::string filename; }; class mystack { public: std::stack s; }; class mymap { public: std::map m; }; MacroManager *MacroManager::instance = 0; MacroManager::MacroManager() { macros = new mymap; calls = new mystack; } MacroManager *MacroManager::Instance() { if(!instance) { instance = new MacroManager; } return instance; } void MacroManager::clear() { macros->m.clear(); } int MacroManager::enterMacro(const std::string &name, FILE **f, std::string &filename, long int &lno) const { if(macros->m.find(name) == macros->m.end()) return 0; File_Position fpold; fpold.lineno = lno; fpold.filename = filename; fpold.file = *f; fgetpos(fpold.file, &fpold.position); calls->s.push(fpold); File_Position fp = (macros->m)[name]; fsetpos(fp.file, &fp.position); *f = fp.file; filename = fp.filename; lno = fp.lineno; return 1; } int MacroManager::leaveMacro(FILE **f, std::string &filename, long int &lno) { if(!calls->s.size()) return 0; File_Position fp; fp = calls->s.top(); calls->s.pop(); fsetpos(fp.file, &fp.position); *f = fp.file; filename = fp.filename; // lno = fp.lineno; // To fix: bad line number after leaving macro if not -1 lno = fp.lineno-1; return 1; } int MacroManager::createMacro(const std::string &name, FILE *f, const std::string &filename, long int lno) { if(macros->m.find(name) != macros->m.end()) return 0; File_Position fp; fp.file = f; fp.filename = filename; fp.lineno = lno; fgetpos(fp.file, &fp.position); (macros->m)[name] = fp; return 1; } getdp-2.7.0-source/Interface/ProParser.h000644 001750 001750 00000002624 12611677027 021604 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _PRO_PARSER_H_ #define _PRO_PARSER_H_ #include #include #include #include #include #include "ListUtils.h" struct Constant { char *Name; int Type; union { double Float; List_T *ListOfFloat; char *Char; } Value; }; #define VAR_FLOAT 1 #define VAR_LISTOFFLOAT 2 #define VAR_CHAR 3 extern FILE *getdp_yyin; extern std::string getdp_yyname; extern char getdp_yyincludename[256]; extern long int getdp_yylinenum; extern int getdp_yycolnum; extern int getdp_yyincludenum; extern int getdp_yyerrorlevel; extern std::map > CommandLineNumbers; extern std::map CommandLineStrings; int getdp_yyparse(); void getdp_yyrestart(FILE*); void Free_ParserVariables(); char *strSave(const char *string); void cStyleComments(); void cxxStyleComments(); void parseString(char endchar); void skipUntil(const char *skip, const char *until); void skipUntil_test(const char *skip, const char *until, const char *until2, int l_until2_sub, int *type_until2); void Print_Constants(); int Print_ListOfDouble(char *format, List_T *list, char *buffer); #endif getdp-2.7.0-source/Interface/ProDefine.h000644 001750 001750 00000010177 12531661501 021533 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _PRO_DEFINE_H_ #define _PRO_DEFINE_H_ #include "ProData.h" struct StringXDefine { const char *string; int define; }; struct StringXDefine1Nbr { const char *string; int define, Nbr1; }; struct StringXPointer { const char *string; void *Pointer; }; struct StringX3Function3Nbr { const char *string; void (*Function1)(); void (*Function2)(); void (*Function3)(); double Nbr1; int Nbr2; int Nbr3; }; struct DefineXFunction { int define; void (*Function)(); }; struct StringXFunction2Nbr { const char *string; void (*Function)(); int Nbr1, Nbr2; }; struct FunctionXFunction { void (*Function1)(); void (*Function2)(); }; extern struct StringXDefine Mesh_Format[]; extern struct StringXDefine Field_Type[]; extern struct StringXDefine FunctionForGroup_Type[]; extern struct StringXDefine FunctionForGroup_SuppList[]; extern struct StringXDefine1Nbr Jacobian_Type[]; extern struct StringXDefine Integration_Type[]; extern struct StringXDefine Integration_SubType[]; extern struct StringXDefine Element_Type[]; extern struct StringXDefine GlobalQuantity_Type[]; extern struct StringXDefine Constraint_Type[]; extern struct StringXDefine Formulation_Type[]; extern struct StringXDefine DefineQuantity_Type[]; extern struct StringXDefine Operator_Type[]; extern struct StringXDefine QuantityFromFS_Type[]; extern struct StringXDefine DefineSystem_Type[]; extern struct StringXDefine Operation_Type[]; extern struct StringXDefine ChangeOfState_Type[]; extern struct StringXDefine PostQuantityTerm_EvaluationType[]; extern struct StringXDefine PostSubOperation_CombinationType[]; extern struct StringXDefine PostSubOperation_Format[]; extern struct StringXDefine PostSubOperation_FormatTag[]; extern struct StringXDefine PostSubOperation_AdaptationType[]; extern struct StringXDefine PostSubOperation_SortType[]; extern struct StringXPointer Current_Value[]; extern struct DefineXFunction FunctionForGauss[]; extern struct DefineXFunction FunctionForGaussLegendre[]; extern struct DefineXFunction FunctionForSingularGauss[]; extern struct StringX3Function3Nbr BF_Function[]; extern struct StringXFunction2Nbr F_Function[]; extern struct FunctionXFunction GF_Function[]; const char *Get_StringForDefine(struct StringXDefine SXD[], int define); int Get_DefineForString(struct StringXDefine SXD[], const char *string, int *FlagError); const char *Get_StringForDefine1Nbr(struct StringXDefine1Nbr SXD[], int define); int Get_Define1NbrForString(struct StringXDefine1Nbr SXD[], const char *string, int *FlagError, int *Nbr1); const char *Get_StringForPointer(struct StringXPointer SXF[], void *Pointer); void Get_PointerForString(struct StringXPointer SXF[], const char *string, int *FlagError, void **Pointer); const char *Get_StringFor3Function3Nbr(struct StringX3Function3Nbr SXF[], void (*Function1)()); void Get_3Function3NbrForString(struct StringX3Function3Nbr SXF[], const char *string, int *FlagError, void (**Function1)(), void (**Function2)(), void (**Function3)(), double *Nbr1, int *Nbr2, int *Nbr3); void Get_FunctionForDefine(struct DefineXFunction DXF[], int define, int *FlagError, void (**Function)()); void Get_Function2NbrForString(struct StringXFunction2Nbr SXF[], const char *string, int *FlagError, void (**Function)(), int *Nbr1, int *Nbr2); void Get_FunctionForFunction(struct FunctionXFunction FXF[], void (*Function1)(), int *FlagError, void (**Function2)() ); const char *Get_StringForFunction2Nbr(struct StringXFunction2Nbr SXF[], void (*Function)()); void Get_Valid_SXD(const char *value, struct StringXDefine V[]); void Get_Valid_SXD1N(const char *value, struct StringXDefine1Nbr V[]); void Get_Valid_SXP(const char *value, struct StringXPointer V[]); void Get_Valid_SX3F3N(const char *value, struct StringX3Function3Nbr V[]); void Get_Valid_SXF2N(const char *value, struct StringXFunction2Nbr V[]); #endif getdp-2.7.0-source/Interface/ProData.h000644 001750 001750 00000135013 12575221110 021203 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _PRO_DATA_H_ #define _PRO_DATA_H_ #include #include #include "GetDPConfig.h" #include "ListUtils.h" #define _0D 0 #define _1D 1 #define _2D 2 #define _3D 3 #define _ALL 4 #define _AXI 5 #define NBR_MAX_RES 2500 #define NBR_MAX_POS 10 #define _PRE 1 // pre-processing #define _CAL 2 // processing #define _POS 3 // post-processing #define _CST 5 // update constraint #define TIME_STATIC 1 #define TIME_THETA 2 #define TIME_NEWMARK 3 #define TIME_GEAR 4 #define ASSEMBLY_AGGREGATE 1 #define ASSEMBLY_SEPARATE 2 /* ------------------------------------------------------------------------ */ /* V a l u e */ /* ------------------------------------------------------------------------ */ #define MAX_DIM 9 /* second-rank tensor of order 3 : 3^2 = 9 */ // - NBR_MAX_HARMONIC controls the size of a 'Value' ; keep this small by // default for efficient operations in recursive expression evaluation and // post-processing // // - MAX_STACK_SIZE controls the size of the stack used in the evaluation of // expressions ; keep this large enough by default to allow for complex expressions #if !defined(HAVE_MULTIHARMONIC) #define NBR_MAX_HARMONIC 2 #else #define NBR_MAX_HARMONIC 100 #endif #define MAX_STACK_SIZE 40 struct Value { int Type; double Val [NBR_MAX_HARMONIC * MAX_DIM]; }; struct TwoInt { int Int1, Int2; }; /* ------------------------------------------------------------------------ */ /* P r o b l e m */ /* ------------------------------------------------------------------------ */ struct Problem { List_T *Group , *Expression; List_T *FunctionSpace , *Constraint , *Formulation; List_T *JacobianMethod, *IntegrationMethod; List_T *Resolution , *PostProcessing , *PostOperation; }; /* ------------------------------------------------------------------------ */ /* G r o u p */ /* ------------------------------------------------------------------------ */ struct Group { char *Name; int Num, Type, FunctionType, SuppListType; List_T *InitialList, *InitialSuppList; List_T *ExtendedList, *ExtendedSuppList; std::multimap ExtendedListForSearch; struct MovingBand2D *MovingBand2D; }; struct MovingBand2D { List_T *InitialList1, *InitialList2; List_T *ExtendedList1, *ExtendedList2; int NbrNodes1, *NumNodes1, NbrNodes2, *NumNodes2; double *x1, *y1, *z1, *x2, *y2, *z2, Area; int Period2, ntr1, ntr2, Closed1, Closed2; int PhysNum, StartNumTr, StartIndexTr; int *b1_p1, *b1_p2, *b1_p3, *b2_p1, *b2_p2, *b2_p3; }; /* Group.Type */ #define REGIONLIST 1 #define ELEMENTLIST 2 #define MOVINGBAND2D 3 /* Group.FunctionType */ #define REGION 1 #define NODESOF 2 #define EDGESOF 3 #define FACETSOF 4 #define VOLUMESOF 5 #define ELEMENTSOF 6 #define GLOBAL 7 #define GROUPSOFNODESOF 11 #define GROUPSOFEDGESOF 12 #define GROUPSOFFACETSOF 13 #define GROUPSOFEDGESONNODESOF 14 #define GROUPOFREGIONSOF 15 #define EDGESOFTREEIN 21 #define FACETSOFTREEIN 22 #define DUALNODESOF 30 #define DUALEDGESOF 31 #define DUALFACETSOF 32 #define DUALVOLUMESOF 33 #define BOUNDARYOFDUALNODESOF 40 #define BOUNDARYOFDUALEDGESOF 41 #define BOUNDARYOFDUALFACETSOF 42 /* Group.SuppListType */ #define SUPPLIST_NONE 0 #define SUPPLIST_NOT 1 #define SUPPLIST_STARTINGON 2 #define SUPPLIST_ONONESIDEOF 3 #define SUPPLIST_INSUPPORT 4 #define SUPPLIST_CONNECTEDTO 5 /* ------------------------------------------------------------------------ */ /* E x p r e s s i o n */ /* ------------------------------------------------------------------------ */ struct Expression { char *Name; int Type; union { double Constant; List_T *WholeQuantity; struct { List_T *ExpressionPerRegion; int NumLastRegion; struct Expression *ExpressionForLastRegion; } PieceWiseFunction; } Case; }; struct ExpressionPerRegion { int RegionIndex, ExpressionIndex; }; /* Expression.Type */ #define UNDEFINED_EXP 0 #define CONSTANT 1 #define WHOLEQUANTITY 2 #define PIECEWISEFUNCTION 3 /* ------------------------------------------------------------------------ */ /* C o n s t r a i n t */ /* ------------------------------------------------------------------------ */ struct Constraint { char *Name; int Type; List_T *ConstraintPerRegion; List_T *MultiConstraintPerRegion; }; struct ConstraintPerRegion { int Type, RegionIndex, SubRegionIndex, TimeFunctionIndex; union { struct { int ExpressionIndex, ExpressionIndex2; } Fixed; struct { char *ResolutionName; } Solve; struct { int Node1, Node2; } Network; struct { int RegionRefIndex, SubRegionRefIndex; int FilterIndex, CoefIndex, FunctionIndex; int FilterIndex2, CoefIndex2, FunctionIndex2; double ToleranceFactor; } Link; } Case; }; struct MultiConstraintPerRegion { char *Name; List_T *ConstraintPerRegion; struct ConstraintActive *Active; }; struct ConstraintActive { int TimeStep, SubTimeStep; union { struct { int NbrNode, NbrBranch, NbrLoop; int **MatNode, **MatLoop; } Network; struct { List_T *Couples; } Link; } Case; }; /* Constraint.Type & ConstraintPerRegion.Type */ #define NONE 0 #define ASSIGN 1 #define INIT 2 #define ASSIGNFROMRESOLUTION 3 #define INITFROMRESOLUTION 4 #define NETWORK 5 #define CST_LINK 6 #define CST_LINKCPLX 7 #define ASSIGN_LOCALPROJ 8 #define INIT_LOCALPROJ 9 /* ------------------------------------------------------------------------ */ /* J a c o b i a n M e t h o d */ /* ------------------------------------------------------------------------ */ struct JacobianMethod { char *Name; List_T *JacobianCase; }; struct JacobianCase { int RegionIndex, TypeJacobian; int NbrParameters; double *Para; }; /* JacobianCase.TypeJacobian */ /* WARNING! The numbering is important (boundary operator -> -1) */ #define JACOBIAN_PNT 0 #define JACOBIAN_LIN 1 #define JACOBIAN_SUR 2 #define JACOBIAN_VOL 3 #define JACOBIAN_SUR_AXI 10 #define JACOBIAN_VOL_AXI 11 #define JACOBIAN_SUR_AXI_SQU 20 #define JACOBIAN_VOL_AXI_SQU 21 #define JACOBIAN_SUR_SPH_SHELL 30 #define JACOBIAN_VOL_SPH_SHELL 31 #define JACOBIAN_SUR_AXI_SPH_SHELL 40 #define JACOBIAN_VOL_AXI_SPH_SHELL 41 #define JACOBIAN_SUR_AXI_SQU_SPH_SHELL 50 #define JACOBIAN_VOL_AXI_SQU_SPH_SHELL 51 #define JACOBIAN_SUR_RECT_SHELL 60 #define JACOBIAN_VOL_RECT_SHELL 61 #define JACOBIAN_SUR_AXI_RECT_SHELL 70 #define JACOBIAN_VOL_AXI_RECT_SHELL 71 #define JACOBIAN_SUR_AXI_SQU_RECT_SHELL 80 #define JACOBIAN_VOL_AXI_SQU_RECT_SHELL 81 #define JACOBIAN_VOL_PLPD_X 90 #define JACOBIAN_VOL_AXI_PLPD_X 100 /* type of transformation */ #define JACOBIAN_SPH 0 #define JACOBIAN_RECT 1 /* ------------------------------------------------------------------------ */ /* I n t e g r a t i o n M e t h o d */ /* ------------------------------------------------------------------------ */ struct IntegrationMethod { char *Name; List_T *IntegrationCase; int CriterionIndex; }; struct IntegrationCase { int Type, SubType; List_T *Case; }; /* IntegrationCase.Type */ #define ANALYTIC 1 #define GAUSS 2 #define GAUSSLEGENDRE 3 /* IntegrationCase.SubType */ #define STANDARD 1 #define SINGULAR 2 #define ADAPTATIVE 3 struct Quadrature { int ElementType; int NumberOfPoints, MaxNumberOfPoints; int NumberOfDivisions, MaxNumberOfDivisions; double StoppingCriterion; void (*Function)(); }; /* ------------------------------------------------------------------------ */ /* F u n c t i o n S p a c e */ /* ------------------------------------------------------------------------ */ struct FunctionSpace { char *Name; int Type; List_T *BasisFunction, *SubSpace, *GlobalQuantity, *Constraint; struct DofData *DofData, *MainDofData; }; struct BasisFunction { char *Name, *NameOfCoef; List_T *GlobalBasisFunction; int Dimension, Num; void (*Function)(); void (*dFunction)(); void (*dInvFunction)(); void (*dPlusFunction)(); List_T *SubFunction, *SubdFunction; int SupportIndex, EntityIndex; double Order; int ElementType; int Orient; }; struct GlobalBasisFunction { int EntityIndex; /* Must be the first element of the structure */ int FormulationIndex, DefineQuantityIndex, ResolutionIndex; struct QuantityStorage *QuantityStorage; }; /* BasisFunction.Type */ /* WARNING! The numbering is important (exterior derivative -> +1) */ #define FORM0 0 #define FORM1 1 #define FORM2 2 #define FORM3 3 #define FORM0S 4 #define FORM1S 5 #define FORM2S 6 #define FORM3S 7 #define FORM0P 10 #define FORM1P 11 #define FORM2P 12 #define FORM3P 13 #define SCALAR 20 #define VECTOR 21 #define TENSOR 22 /* second-rank tensor of order 3 */ #define TENSOR_SYM 23 #define TENSOR_DIAG 24 #define TENSOR_MH 25 /* VECTOR TENSOR_DIAG TENSOR_SYM TENSOR |0| |0 | |0 1 2| |0 1 2| |1| | 1 | |s 3 4| |3 4 5| |2| | 2| |s s 5| |6 7 8| */ #define VECTORP 31 struct SubSpace { char *Name; List_T *BasisFunction; }; struct GlobalQuantity { char *Name; int Num, Type, ReferenceIndex; }; /* GlobalQuantity.Type */ #define ALIASOF 1 #define ASSOCIATEDWITH 2 struct ConstraintInFS { int QuantityType, ReferenceIndex, EntityIndex; struct ConstraintPerRegion *ConstraintPerRegion; struct { int ResolutionIndex; struct ConstraintActive *Active; } Active; /* a deplacer lorsque sera necessaire */ }; /* ConstraintInFS.QuantityType */ #define LOCALQUANTITY 1 #define GLOBALQUANTITY 2 #define INTEGRALQUANTITY 3 #define NODOF 4 /* ------------------------------------------------------------------------ */ /* F u n c t i o n */ /* ------------------------------------------------------------------------ */ struct Function { void (*Fct)(); /* ANSI C++ forbids data member `Function' with same name as enclosing class */ int TypeOfValue, NbrArguments, NbrParameters; double *Para; char *String; struct FunctionActive *Active; }; struct FunctionActive { union { struct { int NbrPoint; double *x, *y, *xc, *yc; double *mi, *bi, *ci, *di; /* Akima */ } Interpolation; struct { double Value; } SurfaceArea; struct { double Value; } GetVolume; struct { int Value; } GetNumElements; struct { List_T *Table; } ValueFromIndex; struct { int NbrLines, NbrColumns; double *x, *y ; double *data ; } ListMatrix; } Case; }; /* ------------------------------------------------------------------------ */ /* F o r m u l a t i o n */ /* ------------------------------------------------------------------------ */ struct Formulation { char *Name; int Type; List_T *DefineQuantity, *Equation; }; /* Formulation.Type */ #define FEMEQUATION 1 #define BEMEQUATION 2 #define GLOBALEQUATION 3 struct IntegralQuantity { List_T *WholeQuantity; int DofIndexInWholeQuantity; int TypeOperatorDof, DefineQuantityIndexDof; int DefineQuantityIndexNoDof; int NbrQuantityIndex, *QuantityIndexTable; int *QuantityTraceGroupIndexTable ; int InIndex; int IntegrationMethodIndex, JacobianMethodIndex; int Symmetry; int CanonicalWholeQuantity, ExpressionIndexForCanonical; struct Function FunctionForCanonical, AnyFunction; }; struct IntegralQuantityActive { int Type_FormDof, Type_ValueDof; List_T *IntegrationCase_L; struct IntegrationCase *IntegrationCase_P; int CriterionIndex; void (*Get_IntPoint)(); int Nbr_IntPoints; List_T *JacobianCase_L; double (*Get_Jacobian)(); int Type_Dimension; void (*xChangeOfCoordinates)(); }; struct FirstElement { struct Dof *Equ; struct Dof *Dof; double Value; }; struct DefineQuantity { char *Name; int Type; int FunctionSpaceIndex; /* for subspaces */ List_T *IndexInFunctionSpace; /* for MH calculation - possibly reduced frequency spectrum for some quantities*/ List_T *FrequencySpectrum; /* for multiple DofData vs. one FunctionSpace */ int DofDataIndex; struct DofData *DofData; /* for integral quantities */ struct IntegralQuantity IntegralQuantity; }; // second order hex with 3 BFs per node for elasticity #define NBR_MAX_BASISFUNCTIONS 81 struct QuantityStorage { struct DefineQuantity *DefineQuantity; int NumLastElementForFunctionSpace; int NumLastElementForDofDefinition; int NumLastElementForEquDefinition; struct FunctionSpace *FunctionSpace; int NbrElementaryBasisFunction; int TypeQuantity; struct { struct Dof *Dof; int NumEntityInElement; int CodeBasisFunction, CodeEntity; int CodeAssociateBasisFunction; int Constraint; int Constraint_Index; double Value[NBR_MAX_HARMONIC]; double Value2[NBR_MAX_HARMONIC]; // for two-step INIT int TimeFunctionIndex; int CodeEntity_Link; struct BasisFunction *BasisFunction; } BasisFunction [NBR_MAX_BASISFUNCTIONS]; }; /* DefineQuantity.Type */ /* LOCALQUANTITY GLOBALQUANTITY INTEGRALQUANTITY */ struct EquationTerm { int Type; union { struct FemLocalTerm { struct { int TypeTimeDerivative; List_T *WholeQuantity; int DofIndexInWholeQuantity; int CanonicalWholeQuantity, ExpressionIndexForCanonical; struct Function FunctionForCanonical; int CanonicalWholeQuantity_Equ, ExpressionIndexForCanonical_Equ, OperatorTypeForCanonical_Equ; void (*BuiltInFunction_Equ)(); int NbrQuantityIndex, *QuantityIndexTable, QuantityIndexPost; int *QuantityTraceGroupIndexTable; int TypeOperatorEqu, DefineQuantityIndexEqu; int TypeOperatorDof, DefineQuantityIndexDof; int DefineQuantityIndexNoDof, DofInTrace; } Term; int InIndex; int Full_Matrix; int IntegrationMethodIndex, JacobianMethodIndex; int ExpressionIndexForMetricTensor; int MatrixIndex; struct FemLocalTermActive *Active; } LocalTerm; struct FemGlobalTerm { int TypeTimeDerivative; int DefineQuantityIndex; struct { int TypeTimeDerivative; List_T *WholeQuantity; int DofIndexInWholeQuantity; int CanonicalWholeQuantity, ExpressionIndexForCanonical; int NbrQuantityIndex, *QuantityIndexTable; int *QuantityTraceGroupIndexTable ; int TypeOperatorEqu, DefineQuantityIndexEqu; int TypeOperatorDof, DefineQuantityIndexDof; int DefineQuantityIndexNoDof; } Term; int InIndex; } GlobalTerm; struct GlobalEquation { int Type, ConstraintIndex; List_T *GlobalEquationTerm; } GlobalEquation; } Case; }; struct FemLocalTermActive { struct QuantityStorage *QuantityStorageEqu_P; struct QuantityStorage *QuantityStorageDof_P; struct Dof *DofForNoDof_P; int Type_FormEqu, Type_FormDof, Type_ValueDof; int Type_DefineQuantityDof; int SymmetricalMatrix; List_T *IntegrationCase_L, *JacobianCase_L; int CriterionIndex; struct JacobianCase *JacobianCase_P0; int NbrJacobianCase, Flag_ChangeCoord, Flag_InvJac; void (*xChangeOfCoordinatesEqu)(); void (*xChangeOfCoordinatesDof)(); double (*Cal_Productx)(); void (*Function_AssembleTerm)(); struct IntegralQuantityActive IntegralQuantityActive; int MHJacNL, MHJacNL_Index, MHJacNL_NbrPointsX, MHJacNL_HarOffSet; double MHJacNL_Factor; double **MHJacNL_H, ***MHJacNL_HH, *MHJacNL_t, *MHJacNL_w; int Full_Matrix; int NbrEqu, NbrHar, *NumEqu, *NumDof; struct Dof *Equ, *Dof; List_T *FirstElements; double **Matrix; }; struct GlobalQuantityStorage { int NumEquation; int NumDof; int CodeGlobalQuantity, CodeAssociateBasisFunction; int CodeEntity; int Constraint; double Value[NBR_MAX_HARMONIC]; int TimeFunctionIndex; }; struct GlobalEquationTerm { int DefineQuantityIndexNode, DefineQuantityIndexLoop; int DefineQuantityIndexEqu; int InIndex; }; /* EquationTerm.Type */ #define GALERKIN 1 #define GLOBALTERM 2 #define GLOBALEQUATION 3 #define DERHAM 4 /* Term.TypeOfTimeDerivative */ #define NODT_ 0 #define DT_ 1 #define DTDOF_ 2 #define DTDT_ 3 #define DTDTDOF_ 4 #define DTDTDTDOF_ 5 #define DTDTDTDTDOF_ 6 #define DTDTDTDTDTDOF_ 7 #define JACNL_ 10 #define NEVERDT_ 11 #define DTNL_ 12 #define DTDOFJACNL_ 13 /* Term.TypeOperator */ #define NOOP 0 #define EXTDER 1 #define GRAD 2 #define CURL 3 #define DIV 4 #define EXTDERINV 5 #define GRADINV 6 #define CURLINV 7 #define DIVINV 8 /* Tous ces operateurs de trace ne servent a RIEN pour le moment De plus, les 'x' sont ambigus. Il faut penser a definir des operateurs de trace (T ou T*), qui doivent avoir, outre \Gamma=\partial\Omega, l'info concernant \Omega. */ #define NPx 9 #define NPxEXTDER 10 #define NPxGRAD 11 #define NPxCURL 12 #define NPxDIV 13 #define NSx 14 #define NSxEXTDER 15 #define NSxGRAD 16 #define NSxCURL 17 #define NSxDIV 18 #define _D1 21 #define _D2 22 #define _D3 23 /* CanonicalWholeQuantity */ #define CWQ_NONE 0 #define CWQ_DOF 1 #define CWQ_EXP_TIME_DOF 2 #define CWQ_FCT_TIME_DOF 3 #define CWQ_FCT_PVEC_DOF 4 #define CWQ_FCT_DOF 20 #define CWQ_GF 5 #define CWQ_GF_PSCA_DOF 6 #define CWQ_GF_PSCA_EXP 7 #define CWQ_GF_PVEC_DOF 8 #define CWQ_DOF_PVEC_GF 9 #define CWQ_GF_PVEC_EXP 10 #define CWQ_EXP_PVEC_GF 11 #define CWQ_EXP_TIME_GF_PSCA_DOF 12 #define CWQ_EXP_TIME_GF_PVEC_DOF 13 #define CWQ_EXP_PVEC_GF_PSCA_DOF 14 #define CWQ_EXP_PVEC_GF_PVEC_DOF 15 #define CWQ_FCT_TIME_GF_PSCA_DOF 16 #define CWQ_FCT_TIME_GF_PVEC_DOF 17 #define CWQ_FCT_PVEC_GF_PSCA_DOF 18 #define CWQ_FCT_PVEC_GF_PVEC_DOF 19 /* ------------------------------------------------------------------------ */ /* W h o l e Q u a n t i t y */ /* ------------------------------------------------------------------------ */ struct WholeQuantity { int Type; union { double Constant; struct Function Function; struct { int TypeOperator, Index, NbrArguments; int TypeQuantity; } OperatorAndQuantity; struct { int Index, NbrArguments; } Expression; struct { List_T *WholeQuantity; } TimeDerivative; struct { List_T *WholeQuantity; int TimeStep; } AtAnteriorTimeStep; struct { List_T *WholeQuantity; double TimeInit; double TimeFinal; } MaxOverTime; struct { List_T *WholeQuantity; double TimeInit; double TimeFinal; int NbrFrequency; double Exponent_f; double Exponent_b; } FourierSteinmetz; struct { double *Value; } CurrentValue; struct { char *Name; } NamedValue; struct { int Index; } Argument; struct { List_T *WholeQuantity_True, *WholeQuantity_False; } Test; struct { int Index; } SaveValue; struct { int Index; } ShowValue; struct { int Index; } ValueSaved; struct { int TypeOperator; void (*Function)(); } Operator; /* binary or unary */ struct { List_T *WholeQuantity; int FunctionSpaceIndexForType, NbrHar; } Cast; struct { List_T *WholeQuantity ; } ChangeCurrentPosition ; struct { List_T *WholeQuantity ; int InIndex, DofIndexInWholeQuantity; } Trace; struct { char *SystemName; int DefineSystemIndex; int DofNumber; } DofValue; struct { List_T *WholeQuantity; int Index, NbrPoints; } MHTransform; struct { List_T *WholeQuantity; int Index, NbrArguments, NbrPoints, FreqOffSet; } MHJacNL; } Case; }; /* WholeQuantity.Type */ #define WQ_OPERATORANDQUANTITY 1 #define WQ_OPERATORANDQUANTITYEVAL 2 #define WQ_BINARYOPERATOR 3 #define WQ_UNARYOPERATOR 4 #define WQ_EXPRESSION 5 #define WQ_BUILTINFUNCTION 6 #define WQ_EXTERNBUILTINFUNCTION 7 #define WQ_CONSTANT 8 #define WQ_CURRENTVALUE 9 #define WQ_ARGUMENT 10 #define WQ_TIMEDERIVATIVE 11 #define WQ_CAST 12 #define WQ_TEST 13 #define WQ_SAVEVALUE 14 #define WQ_VALUESAVED 15 #define WQ_SOLIDANGLE 16 #define WQ_TRACE 17 #define WQ_ORDER 18 #define WQ_MHTIMEINTEGRATION 19 #define WQ_MHTRANSFORM 20 #define WQ_SHOWVALUE 21 #define WQ_MHTIMEEVAL 22 #define WQ_MHJACNL 23 #define WQ_POSTSAVE 24 #define WQ_ATANTERIORTIMESTEP 25 #define WQ_CHANGECURRENTPOSITION 26 #define WQ_MAXOVERTIME 27 #define WQ_FOURIERSTEINMETZ 28 #define WQ_SAVENAMEDVALUE 29 #define WQ_NAMEDVALUESAVED 30 /* TypeOperator */ #define OP_PLUS 1 #define OP_MINUS 2 #define OP_TIME 3 #define OP_DIVIDE 4 #define OP_MODULO 5 #define OP_POWER 6 #define OP_CROSSPRODUCT 7 #define OP_LESS 8 #define OP_GREATER 9 #define OP_LESSOREQUAL 10 #define OP_GREATEROREQUAL 11 #define OP_EQUAL 12 #define OP_NOTEQUAL 13 #define OP_APPROXEQUAL 14 #define OP_AND 15 #define OP_OR 16 #define OP_NEG 17 #define OP_NOT 18 /* OperatorAndQuantity.TypeQuantity */ #define QUANTITY_SIMPLE 1 #define QUANTITY_DOF 2 #define QUANTITY_NODOF 3 #define QUANTITY_BF 4 /* ------------------------------------------------------------------------ */ /* R e s o l u t i o n */ /* ------------------------------------------------------------------------ */ struct Resolution { char *Name; bool Hidden; List_T *DefineSystem, *Operation; }; struct DefineSystem { char *Name; int Type; List_T *FormulationIndex, *FrequencyValue; char *SolverDataFileName; char *MeshName, *AdaptName; List_T *OriginSystemIndex; char *DestinationSystemName; int DestinationSystemIndex; }; /* DefineSystem.Type */ #define VAL_REAL 1 #define VAL_COMPLEX 2 struct Operation { int Type, DefineSystemIndex, Flag; union { struct { List_T *MatrixIndex_L; } GenerateOnly; struct { int DefineSystemIndex; } SolveAgainWithOther; struct { char *String; } SystemCommand; struct { char *String; } Error; struct { char *FileName; int ViewTag; } GmshRead; struct { char *FileName; } DeleteFile; struct { char *OldFileName, *NewFileName; } RenameFile; struct { char *DirName; } CreateDir; struct { int ExpressionIndex; } SetTime; struct { int ExpressionIndex; } Sleep; struct { int ExpressionIndex; } Update; struct { int GroupIndex, Type; } UpdateConstraint; struct { char *VariableName; int NormType; } GetResidual; struct { int CopyFromTimeStep; } CreateSolution; struct { int ExpressionIndex; } SetFrequency; struct { List_T *Frequency; int DefineSystemIndex[2]; } FourierTransform; struct { int DefineSystemIndex[2]; double Period, Period_sofar; double *Scales; } FourierTransform2; struct { int Size; List_T *Save; double Shift; } Lanczos; struct { int NumEigenvalues; double Shift_r, Shift_i; int FilterExpressionIndex; } EigenSolve; struct { List_T *Expressions; } Evaluate; struct { int Iteration ; } SelectCorrection ; struct { double Alpha ; } AddCorrection ; struct { double Alpha ; } MultiplySolution ; struct { int Size; List_T *Save; double Shift; int PertFreq; int DefineSystemIndex2, DefineSystemIndex3; } Perturbation; struct { double Time0, TimeMax; int DTimeIndex, ThetaIndex; List_T *Operation; } TimeLoopTheta; struct { double Time0, TimeMax, Beta, Gamma; int DTimeIndex; List_T *Operation; } TimeLoopNewmark; struct { double Time0, TimeMax; List_T *ButcherA, *ButcherB, *ButcherC; int DTimeIndex; } TimeLoopRungeKutta; struct { double Time0, TimeMax, DTimeInit, DTimeMin, DTimeMax; double LTEtarget, DTimeMaxScal, DTimeScal_NotConverged; char *Scheme; List_T *Breakpoints_L; List_T *TimeLoopAdaptiveSystems_L; List_T *TimeLoopAdaptivePOs_L; List_T *Operation, *OperationEnd; } TimeLoopAdaptive; struct { double Criterion; int NbrMaxIteration, RelaxationFactorIndex, Flag; List_T *IterativeLoopSystems_L; List_T *IterativeLoopPOs_L; List_T *Operation; } IterativeLoop; struct { double Criterion, DivisionCoefficient; int NbrMaxIteration, Flag; List_T *ChangeOfState; List_T *Operation, *OperationEnd; } IterativeTimeReduction; struct { char *OpMatMult; char *Type; double Tolerance; int MaxIter; int Restart; List_T *MyFieldTag; List_T *NeighborFieldTag; List_T *DeflationIndices; List_T *Operations_Ax, *Operations_Mx; } IterativeLinearSolver; struct { int ExpressionIndex; List_T *Operation_True, *Operation_False; } Test; struct { int ExpressionIndex; List_T *Operation; } While; struct { List_T *DofNumber, *TimeStep, *Expressions; char *FileOut, *FormatString; } Print; struct { int GroupIndex, ExpressionIndex; int NumNode, ExpressionIndex2; } ChangeOfCoordinates; struct { int CheckAll; List_T *Factor_L; } SolveJac_AdaptRelax; struct{ int GroupIndex; bool SaveFixed; } SaveSolutionWithEntityNum; struct { int NbrFreq; char *ResFile; } SaveSolutionExtendedMH; struct { List_T *Time; char *ResFile; } SaveSolutionMHtoTime; struct { List_T *PostOperations; } PostOperation; struct { int GroupIndex; } Init_MovingBand2D; struct { int GroupIndex; } Mesh_MovingBand2D; struct { int GroupIndex; double Period; int NbrStep; List_T *Operation; } Generate_MH_Moving; struct { int GroupIndex; double Period; int NbrStep; List_T *Operation; } Generate_MH_Moving_S; struct { int GroupIndex; } Generate; struct { int GroupIndex; char *FileName; int ExprIndex; } SaveMesh; struct { char *Quantity; char *Name_MshFile; int GeoDataIndex; double Factor; int GroupIndex; } DeformeMesh; struct { char *String; } SetGlobalSolverOptions; struct { List_T *FieldsToSkip; } BroadcastFields; } Case; }; struct ChangeOfState { int Type; int QuantityIndex, InIndex, FormulationIndex; double Criterion; double *ActiveList[2]; int ExpressionIndex, ExpressionIndex2, FlagIndex; }; struct TimeLoopAdaptiveSystem { int SystemIndex; double SystemLTEreltol; double SystemLTEabstol; int NormType; char *NormTypeString; }; struct LoopErrorPostOperation { char *PostOperationName; int PostOperationIndex; double PostOperationReltol; double PostOperationAbstol; int NormType; char *NormTypeString; List_T *Save_Format_L, *Save_LastTimeStepOnly_L; List_T *Save_FileOut_L; }; struct IterativeLoopSystem { int SystemIndex; double SystemILreltol; double SystemILabstol; int NormType; char *NormTypeString; int NormOf; char *NormOfString; }; /* Operation.Type */ #define OPERATION_NONE 0 #define OPERATION_ADDCORRECTION 1 #define OPERATION_ADDOPPOSITEFULLSOLUTION 2 #define OPERATION_ADDMHMOVING 3 #define OPERATION_APPLY 4 #define OPERATION_BARRIER 5 #define OPERATION_BREAK 6 #define OPERATION_BROADCASTFIELDS 7 #define OPERATION_CHANGEOFCOORDINATES 8 #define OPERATION_CHANGEOFCOORDINATES2 9 #define OPERATION_CREATEDIR 10 #define OPERATION_DEFORMEMESH 11 #define OPERATION_DELETEFILE 12 #define OPERATION_DOFSFREQUENCYSPECTRUM 13 #define OPERATION_EIGENSOLVE 14 #define OPERATION_EIGENSOLVEJAC 15 #define OPERATION_EVALUATE 16 #define OPERATION_FOURIERTRANSFORM 17 #define OPERATION_FOURIERTRANSFORM2 18 #define OPERATION_GENERATE 19 #define OPERATION_GENERATEJAC 20 #define OPERATION_GENERATEJAC_CUMULATIVE 21 #define OPERATION_GENERATEONLY 22 #define OPERATION_GENERATEONLYJAC 23 #define OPERATION_GENERATERHS 24 #define OPERATION_GENERATERHS_CUMULATIVE 25 #define OPERATION_GENERATESEPARATE 26 #define OPERATION_GENERATE_CUMULATIVE 27 #define OPERATION_GENERATE_MH_MOVING 28 #define OPERATION_GENERATE_MH_MOVING_S 29 #define OPERATION_GMSHCLEARALL 30 #define OPERATION_GMSHMERGE 31 #define OPERATION_GMSHOPEN 32 #define OPERATION_GMSHREAD 33 #define OPERATION_GMSHWRITE 34 #define OPERATION_INITCORRECTION 35 #define OPERATION_INITSOLUTION 36 #define OPERATION_INITSOLUTION1 37 #define OPERATION_INIT_MOVINGBAND2D 38 #define OPERATION_ITERATIVELINEARSOLVER 39 #define OPERATION_ITERATIVELOOP 40 #define OPERATION_ITERATIVELOOPN 41 #define OPERATION_ITERATIVETIMEREDUCTION 42 #define OPERATION_LANCZOS 43 #define OPERATION_MESH_MOVINGBAND2D 44 #define OPERATION_MULTIPLYSOLUTION 45 #define OPERATION_PERTURBATION 46 #define OPERATION_POSTOPERATION 47 #define OPERATION_PRINT 48 #define OPERATION_READ 49 #define OPERATION_READSOLUTION 50 #define OPERATION_SAVEMESH 51 #define OPERATION_SAVESOLUTION 52 #define OPERATION_SAVESOLUTIONEXTENDEDMH 53 #define OPERATION_SAVESOLUTIONMHTOTIME 54 #define OPERATION_SAVESOLUTIONS 55 #define OPERATION_SAVESOLUTION_WITH_ENTITY_NUM 56 #define OPERATION_SCAN 57 #define OPERATION_SELECTCORRECTION 58 #define OPERATION_SETCOMMSELF 59 #define OPERATION_SETCOMMWORLD 60 #define OPERATION_SETCURRENTSYSTEM 61 #define OPERATION_SETFREQUENCY 62 #define OPERATION_SETGLOBALSOLVEROPTIONS 63 #define OPERATION_SETRHSASSOLUTION 64 #define OPERATION_SETSOLUTIONASRHS 65 #define OPERATION_SETTIME 66 #define OPERATION_SOLVE 67 #define OPERATION_SOLVEAGAIN 68 #define OPERATION_SOLVEAGAINWITHOTHER 69 #define OPERATION_SOLVEJAC 70 #define OPERATION_SOLVEJACADAPTRELAX 71 #define OPERATION_SOLVEJACAGAIN 72 #define OPERATION_SOLVENL 73 #define OPERATION_SYSTEMCOMMAND 74 #define OPERATION_TEST 75 #define OPERATION_TIMELOOPADAPTIVE 76 #define OPERATION_TIMELOOPNEWMARK 77 #define OPERATION_TIMELOOPRUNGEKUTTA 78 #define OPERATION_TIMELOOPTHETA 79 #define OPERATION_TRANSFERSOLUTION 80 #define OPERATION_UPDATE 81 #define OPERATION_UPDATECONSTRAINT 82 #define OPERATION_WRITE 83 #define OPERATION_GETRESIDUAL 84 #define OPERATION_RENAMEFILE 85 #define OPERATION_WHILE 86 #define OPERATION_SETTIMESTEP 87 #define OPERATION_ERROR 88 #define OPERATION_SLEEP 89 #define OPERATION_SWAPSOLUTIONANDRHS 90 #define OPERATION_SWAPSOLUTIONANDRESIDUAL 91 #define OPERATION_CREATESOLUTION 92 /* ChangeOfState.Type */ #define CHANGEOFSTATE_NOCHANGE 0 #define CHANGEOFSTATE_CHANGESIGN 1 #define CHANGEOFSTATE_CHANGELEVEL 2 #define CHANGEOFSTATE_CHANGEREFERENCE 3 #define CHANGEOFSTATE_CHANGEREFERENCE2 4 /* TimeLoopAdaptiveSystem.NormType */ #define LINFNORM 1 #define L1NORM 2 #define MEANL1NORM 3 #define L2NORM 4 #define MEANL2NORM 5 /* IterativeLoopSystem.NormOf */ #define SOLUTION 1 #define RESIDUAL 2 #define RECALCRESIDUAL 3 /* ------------------------------------------------------------------------ */ /* P r e R e s o l u t i o n I n f o */ /* ------------------------------------------------------------------------ */ struct PreResolutionInfo { int Index, Type ; } ; /* Type PreResolution */ #define PR_CONSTRAINT 1 #define PR_GLOBALBASISFUNCTION 2 /* ------------------------------------------------------------------------ */ /* P o s t P r o c e s s i n g */ /* ------------------------------------------------------------------------ */ struct PostProcessing { char *Name; int FormulationIndex; List_T *OriginSystemIndex; char *NameOfSystem; List_T *PostQuantity; int Rank; }; struct PostQuantity { char *Name; List_T *PostQuantityTerm; }; struct PostQuantityTerm { int Type, EvaluationType; int TypeTimeDerivative; List_T *WholeQuantity; int NbrQuantityIndex, *QuantityIndexTable; int *QuantityTraceGroupIndexTable; int InIndex, JacobianMethodIndex, IntegrationMethodIndex; }; /* PostQuantityTerm.Type */ /* LOCALQUANTITY GLOBALQUANTITY INTEGRALQUANTITY */ /* PostQuantityTerm.EvaluationType */ #define LOCAL 1 #define INTEGRAL 2 /* ------------------------------------------------------------------------ */ /* P o s t O p e r a t i o n */ /* ------------------------------------------------------------------------ */ struct PostOperation { char *Name, *AppendString; bool Hidden; int PostProcessingIndex, Format; List_T *PostSubOperation; int Rank; double ResampleTimeStart, ResampleTimeStop, ResampleTimeStep; bool ResampleTime; List_T *TimeValue_L, *TimeImagValue_L; int LastTimeStepOnly, OverrideTimeStepValue, NoMesh, CatFile; }; struct PostSubOperation { int PostQuantityIndex[2], PostQuantitySupport[2]; int Type, SubType, CombinationType; int Depth, Skin, Smoothing, Dimension, Comma, HarmonicToTime, CatFile; int FourierTransform; int Format, Adapt, Sort, Iso, NoNewLine, NoTitle, DecomposeInSimplex; int NewCoordinates; char *NewCoordinatesFile; int ValueIndex; int ChangeOfCoordinates[3], LastTimeStepOnly, AppendTimeStepToFileName; int AppendExpressionToFileName; char *AppendStringToFileName, *AppendExpressionFormat; int OverrideTimeStepValue, NoMesh; char *StoreInVariable; int StoreInRegister, StoreMinInRegister, StoreMinXinRegister; int StoreMinYinRegister, StoreMinZinRegister, StoreMaxInRegister; int StoreMaxXinRegister, StoreMaxYinRegister, StoreMaxZinRegister; char *SendToServer, *Color; int StoreInField, StoreInMeshBasedField; int Legend, FrozenTimeStepList; double LegendPosition[3]; double Target; char *ValueName, *Label; char *FileOut; List_T *TimeStep_L, *Value_L, *Iso_L, *Frequency_L; List_T *TimeValue_L, *TimeImagValue_L; List_T *ChangeOfValues; List_T *EvaluationPoints; union { struct { int RegionIndex; } OnRegion; struct { double x[4], y[4], z[4]; int n[3]; } OnGrid; struct { int ExpressionIndex[3]; List_T *ParameterValue[3]; } OnParamGrid; struct { double x[3], y[3], z[3]; } OnSection; struct { int RegionIndex, ArgumentIndex; double x[2]; int n; } WithArgument; struct { int ExtendedGroupIndex, GroupIndex; } Group; struct { char *String; char *String2; int ExpressionIndex; } Expression; } Case; }; struct PostOpSolutions { PostOperation *PostOperation_P; List_T *Solutions_L; }; /* PostOperation.Type */ #define POP_NONE 0 #define POP_PRINT 1 #define POP_GROUP 2 #define POP_EXPRESSION 4 #define POP_MERGE 5 /* PostOperation.SubType */ #define PRINT_ONREGION 1 #define PRINT_ONELEMENTSOF 2 #define PRINT_ONSECTION_1D 3 #define PRINT_ONSECTION_2D 4 #define PRINT_ONGRID 5 #define PRINT_ONGRID_0D 6 #define PRINT_ONGRID_1D 7 #define PRINT_ONGRID_2D 8 #define PRINT_ONGRID_3D 9 #define PRINT_ONGRID_PARAM 10 #define PRINT_WITHARGUMENT 11 /* PostOperation.CombinationType */ #define ADDITION 1 #define SOUSTRACTION 2 #define MULTIPLICATION 3 #define DIVISION 4 /* Unsuccessful search results */ #define NO_BRICK -999 #define NO_ELEMENT -999 #define NO_REGION -999 /* PostSubOperation Tags */ #define TAG_TIME 1 #define TAG_TIMESTEP 2 #define TAG_VALUE 3 #define TAG_X 4 #define TAG_Y 5 #define TAG_Z 6 #define TAG_NODES 7 #define TAG_TYPE 8 #define TAG_VERSION 9 #define TAG_DATE 10 #define TAG_HOST 11 #define TAG_FILENAME 12 #define TAG_USER 13 #define TAG_ABSCISSA 14 #define TAG_NORMAL 15 #define TAG_COMMAND 16 /* PostSubOperation.Format */ #define FORMAT_SPACE_TABLE 1 #define FORMAT_TIME_TABLE 2 #define FORMAT_SIMPLE_SPACE_TABLE 3 #define FORMAT_FREQUENCY_TABLE 4 #define FORMAT_VALUE_ONLY 5 #define FORMAT_ADAPT 9 #define FORMAT_GMSH 10 #define FORMAT_GMSH_PARSED 11 #define FORMAT_MATLAB 14 #define FORMAT_GNUPLOT 15 #define FORMAT_REGION_TABLE 16 #define FORMAT_REGION_VALUE 17 #define FORMAT_UNV 18 #define FORMAT_NODE_TABLE 19 #define FORMAT_LOOP_ERROR 20 /* PostSubOperation.Sort */ #define SORT_BY_POSITION 1 #define SORT_BY_CONNECTIVITY 2 /* PostSubOperation.Legend */ #define LEGEND_NONE 0 #define LEGEND_TIME 1 #define LEGEND_FREQUENCY 2 #define LEGEND_EIGENVALUES 3 /* ------------------------------------------------------------------------ */ /* C u r r e n t D a t a */ /* ------------------------------------------------------------------------ */ struct CurrentData { char *Name; int NbrSystem; struct DefineSystem *DefineSystem_P ; struct DofData *DofData_P0; struct DofData *DofData; struct GeoData *GeoData; //PostOperation based solutions for TimeLoopAdaptive, IterativeLoopN List_T *PostOpData_L; int PostOpDataIndex; int NbrHar; int Region, SubRegion; int NumEntity, NumEntityInElement; int NumEntities[NBR_MAX_BASISFUNCTIONS]; struct Element *Element; int IntegrationSupportIndex; struct Element *ElementSource; int SourceIntegrationSupportIndex; int TypeTime, TypeAssembly; int SubTimeStep; int flagAssDiag; // All values below must be double double x, y, z; double u, v, w; double xs, ys, zs; double us, vs, ws; double a, b, c; double xp, yp, zp; double ut, vt, wt; double Val[NBR_MAX_HARMONIC * MAX_DIM]; double QuadraturePointIndex; // For TimeLoopTheta and TimeLoopNewmark double Time, TimeImag, TimeStep, DTime; double Theta, Beta, Gamma; // For TimeLoopAdaptive double PredOrder, CorrOrder; double aPredCoeff[7], aCorrCoeff[6], bCorrCoeff, PredErrorConst, CorrErrorConst; double Breakpoint; // For IterativeLoop double Iteration, RelativeDifference, RelativeDifferenceOld; double RelaxationFactor; // Iterative linear system solvers double KSPIts; }; /* ------------------------------------------------------------------------ */ /* E l e m e n t */ /* ------------------------------------------------------------------------ */ #define NBR_MAX_NODES_IN_ELEMENT 60 #define NBR_MAX_ENTITIES_IN_ELEMENT 60 #define NBR_MAX_GROUPS_IN_ELEMENT 60 #define NBR_MAX_SUBENTITIES_IN_ELEMENT 5 struct IntxList { int Int ; List_T * List ; } ; struct Matrix3x3 { double c11, c12, c13 ; double c21, c22, c23 ; double c31, c32, c33 ; } ; typedef struct Matrix3x3 MATRIX3x3 ; struct Element { struct Geo_Element * GeoElement ; int Num, Type, Region ; struct Element * ElementSource, * ElementTrace ; int NumLastElementForNodesCoordinates ; double x [NBR_MAX_NODES_IN_ELEMENT] ; double y [NBR_MAX_NODES_IN_ELEMENT] ; double z [NBR_MAX_NODES_IN_ELEMENT] ; int NumLastElementForSolidAngle ; double angle [NBR_MAX_NODES_IN_ELEMENT] ; int NumLastElementForSortedNodesByFacet ; struct TwoInt SortedNodesByFacet [6][NBR_MAX_SUBENTITIES_IN_ELEMENT] ; double n [NBR_MAX_NODES_IN_ELEMENT] ; double dndu [NBR_MAX_NODES_IN_ELEMENT] [3] ; struct JacobianCase * JacobianCase ; MATRIX3x3 Jac ; double DetJac ; MATRIX3x3 InvJac ; int NumLastElementForGroupsOfEntities ; int NbrGroupsOfEntities ; int NumGroupsOfEntities [NBR_MAX_GROUPS_IN_ELEMENT] ; int NbrEntitiesInGroups [NBR_MAX_GROUPS_IN_ELEMENT] ; int NumEntitiesInGroups [NBR_MAX_GROUPS_IN_ELEMENT] [NBR_MAX_ENTITIES_IN_ELEMENT] ; int NumSubFunction [3][NBR_MAX_GROUPS_IN_ELEMENT] ; struct GlobalBasisFunction * GlobalBasisFunction [NBR_MAX_GROUPS_IN_ELEMENT] ; } ; /* Element.Type */ #define POINT (1<<0) #define LINE (1<<1) #define TRIANGLE (1<<2) #define QUADRANGLE (1<<3) #define TETRAHEDRON (1<<4) #define HEXAHEDRON (1<<5) #define PRISM (1<<6) #define PYRAMID (1<<7) #define LINE_2 (1<<8) #define TRIANGLE_2 (1<<9) #define QUADRANGLE_2 (1<<10) #define TETRAHEDRON_2 (1<<11) #define HEXAHEDRON_2 (1<<12) #define PRISM_2 (1<<13) #define PYRAMID_2 (1<<14) #define QUADRANGLE_2_8N (1<<16) /* Adapt.Type */ #define P1 1 #define P2 2 #define H1 3 #define H2 4 struct Geo_Node { int Num ; double x, y, z ; } ; struct Geo_Element { int Num ; int Type, Region, ElementaryRegion ; int NbrNodes , * NumNodes ; int NbrEdges , * NumEdges ; int NbrFacets, * NumFacets ; } ; struct Entity2XEntity1 { int Num ; int NbrEntities, * NumEntities ; } ; struct EntityXVector { int Num; double Vector[3]; } ; struct EntityInTree { int Num, Index ; } ; /* ------------------------------------------------------------------------ */ /* I n t e r f a c e F u n c t i o n s */ /* ------------------------------------------------------------------------ */ int fcmp_Integer (const void *a, const void *b); int fcmp_Constant (const void *a, const void *b); int fcmp_Expression_Name (const void *a, const void *b); int fcmp_Group_Name (const void *a, const void *b); int fcmp_Constraint_Name (const void *a, const void *b); int fcmp_JacobianMethod_Name (const void *a, const void *b); int fcmp_IntegrationMethod_Name (const void *a, const void *b); int fcmp_BasisFunction_Name (const void *a, const void *b); int fcmp_FunctionSpace_Name (const void *a, const void *b); int fcmp_BasisFunction_NameOfCoef (const void *a, const void *b); int fcmp_SubSpace_Name (const void *a, const void *b); int fcmp_GlobalQuantity_Name (const void *a, const void *b); int fcmp_Formulation_Name (const void *a, const void *b); int fcmp_DefineQuantity_Name (const void *a, const void *b); int fcmp_DefineSystem_Name (const void *a, const void *b); int fcmp_Resolution_Name (const void *a, const void *b); int fcmp_PostProcessing_Name (const void *a, const void *b); int fcmp_PostQuantity_Name (const void *a, const void *b); int fcmp_PostOperation_Name (const void *a, const void *b); void Init_ProblemStructure(); void Read_ProblemStructure(const char *fileName); void Finalize_ProblemStructure(); void Print_ProblemStructure(); void Free_ProblemStructure(); std::string Fix_RelativePath(const char *fileName, const char *reference=0); void Print_ListResolution(int choice, int flag_lres, char **name); void Print_ListPostOperation(int choice, int flag_lpos, char *name[NBR_MAX_POS]); #endif getdp-2.7.0-source/Interface/ProParser.l000644 001750 001750 00000062152 12611677027 021612 0ustar00geuzainegeuzaine000000 000000 %{ // GetDP - Copyright (C) 1997-2015 P. Dular, C. Geuzaine // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include #include #include #include "ProData.h" #include "ProParser.h" #include "ProParser.tab.hpp" #include "MallocUtils.h" #include "Message.h" // Redefinition of YY_INPUT to allow input character count (this is // slower than fread(), but the .pro files are never that big) #ifdef YY_INPUT #undef YY_INPUT #endif #define YY_INPUT(buf,result,max_size) { \ int c = getc(getdp_yyin); \ getdp_yycolnum++; \ result = (c == EOF) ? YY_NULL : (buf[0] = c, 1); \ } %} alpha [a-zA-Z\_\.] digit [0-9] exp [Ee][-+]?{digit}+ string {alpha}({alpha}|{digit})* %% [\ \t\r\f] /* nothing to do */; [\n] { getdp_yycolnum = 0; getdp_yylinenum++; } <> { getdp_yyincludenum = 0; return(0); } ";" return tEND; "/*" cStyleComments(); "//" cxxStyleComments(); "\"" { parseString('\"'); return tBIGSTR; } "=" return tDEF; "*^" return tCROSSPRODUCT; "/\\" return tCROSSPRODUCT; "||" return tOR; "&&" return tAND; "==" return tEQUAL; "!=" return tNOTEQUAL; "~=" return tAPPROXEQUAL; "<=" return tLESSOREQUAL; ">=" return tGREATEROREQUAL; ">>" return tGREATERGREATER; "<<" return tLESSLESS; "..." return tDOTS; ":" return tDOTS; "##" return tSHOW; #include return tInclude; 0D return t0D; 1D return t1D; 2D return t2D; 3D return t3D; ACos return tAcos; ASin return tAsin; Acos return tAcos; Adapt return tAdapt; AddCorrection return tAddCorrection ; AddMHMoving return tAddMHMoving; AddOppositeFullSolution return tAddOppositeFullSolution ; All return tAll; Append return tAppend; AppendTimeStepToFileName return tAppendTimeStepToFileName; AppendExpressionToFileName return tAppendExpressionToFileName; AppendExpressionFormat return tAppendExpressionFormat; AppendStringToFileName return tAppendStringToFileName; AppendToExistingFile return tAppendToExistingFile; Asin return tAsin; AtAnteriorTimeStep return tAtAnteriorTimeStep; MaxOverTime return tMaxOverTime; FourierSteinmetz return tFourierSteinmetz; Atan return tAtan; Atan2 return tAtan2; Barrier return tBarrier; BasisFunction return tBasisFunction; Beta return tBeta; Branch return tBranch; Break return tBreak; BroadcastFields return tBroadcastFields; Call return tCall; CallTest return tCallTest; Case return tCase; Ceil return tCeil; ChangeOfCoordinates return tChangeOfCoordinates; ChangeOfCoordinates2 return tChangeOfCoordinates2; ChangeOfState return tChangeOfState; ChangeOfValues return tChangeOfValues; Coefficient return tCoefficient; Color return tColor; Comma return tComma; Const return tConstant; Constant return tConstant; Constraint return tConstraint; Cos return tCos; Cosh return tCosh; CosineTransform return tCosineTransform; CreateDir return tCreateDir; CreateDirectory return tCreateDir; Criterion return tCriterion; CreateSolution return tCreateSolution; Cross return tCrossProduct; CrossProduct return tCrossProduct; CurrentDirectory return tCurrentDirectory; CurrentDir return tCurrentDirectory; DTime return tDTime; Date return tDate; DecomposeInSimplex return tDecomposeInSimplex; DefineConstant return tDefineConstant; DefineFunction return tDefineFunction; DefineGroup return tDefineGroup; DefineNumber return tDefineNumber; DefineString return tDefineString; DefineVariable return tDefineConstant; DeformMesh return tDeformMesh; DeformeMesh return tDeformMesh; Delete return tDelete; DeleteFile return tDeleteFile; Depth return tDepth; deRham return tdeRham; DestinationSystem return tDestinationSystem; dFunction return tdFunction; Dimension return tDimension; DivisionCoefficient return tDivisionCoefficient; DofValue return tDofValue; Dt return tDt; DtDof return tDtDof; DtDofJacNL return tDtDofJacNL; DtDt return tDtDt; DtDtDof return tDtDtDof; DtDtDtDof return tDtDtDtDof; DtDtDtDtDof return tDtDtDtDtDof; DtDtDtDtDtDof return tDtDtDtDtDtDof; DtNL return tDtNL; Echo return tEcho; EigenSolve return tEigenSolve; EigenSolveJac return tEigenSolveJac; EigenvalueLegend return tEigenvalueLegend; Else return tElse; ElseIf return tElseIf; EndFor return tEndFor; EndIf return tEndIf; Entity return tEntity; EntitySubType return tEntitySubType; EntityType return tEntityType; Error return tError; Evaluate return tEvaluate; EvaluationPoints return tEvaluationPoints; Exp return tExp; Fabs return tFabs; File return tFile; Filter return tFilter; FixRelativePath return tFixRelativePath; Flag return tFlag; Floor return tFloor; Fmod return tFmod; Footer return tFooter; For return tFor; Format return tFormat; Formulation return tFormulation; FourierTransform return tFourierTransform; FourierTransformJ return tFourierTransformJ; Frequency return tFrequency; FrequencyLegend return tFrequencyLegend; FrequencySpectrum return tFrequencySpectrum; Full_Matrix return tFull_Matrix; Function return tFunction; FunctionSpace return tFunctionSpace; Galerkin return tGalerkin; Gamma return tGamma; GenerateGroup return tGenerateGroup; GenerateGroupCumulative return tGenerateGroupCumulative; GenerateJacGroup return tGenerateJacGroup; GenerateJacGroupCumulative return tGenerateJacGroupCumulative; GenerateMHMoving return tGenerateMHMoving; GenerateMHMovingSeparate return tGenerateMHMovingSeparate; GenerateOnly return tGenerateOnly; GenerateOnlyJac return tGenerateOnlyJac; GenerateRHSGroup return tGenerateRHSGroup; GenerateRHSGroupCumulative return tGenerateRHSGroupCumulative; GeoElement return tGeoElement; GetRegion return tGetRegion ; GetResidual return tGetResidual; GlobalEquation return tGlobalEquation; GlobalQuantity return tGlobalQuantity; GlobalTerm return tGlobalTerm; GmshClearAll return tGmshClearAll; GmshMerge return tGmshMerge; GmshOpen return tGmshOpen; GmshRead return tGmshRead; GmshWrite return tGmshWrite; Group return tGroup; GETDP_MAJOR_VERSION return tGETDP_MAJOR_VERSION; GETDP_MINOR_VERSION return tGETDP_MINOR_VERSION; GETDP_PATCH_VERSION return tGETDP_PATCH_VERSION; HarmonicToTime return tHarmonicToTime; Header return tHeader; Hidden return tHidden; Hypot return tHypot; If return tIf; In return tIn; InSupport return tInSupport; Include return tInclude; IndexOfSystem return tIndexOfSystem; InitMovingBand2D return tInitMovingBand2D; Integral return tGalerkin; Integration return tIntegration; Iso return tIso; IterativeLinearSolver return tIterativeLinearSolver; IterativeLoop return tIterativeLoop; IterativeLoopN return tIterativeLoopN; IterativeTimeReduction return tIterativeTimeReduction; JacNL return tJacNL; Jacobian return tJacobian; Lanczos return tLanczos; LastTimeStepOnly return tLastTimeStepOnly; LinSpace return tLinSpace; List return tList; ListAlt return tListAlt; ListFromFile return tListFromFile; Log return tLog; Log10 return tLog10; LogSpace return tLogSpace; MHJacNL return tMHJacNL; MHTransform return tMHTransform; MPI_Printf return tMPI_Printf; MPI_Rank return tMPI_Rank; MPI_Size return tMPI_Size; Macro return tMacro; MaxNumberOfDivisions return tMaxNumberOfDivisions; MaxNumberOfPoints return tMaxNumberOfPoints; MeshMovingBand2D return tMeshMovingBand2D; MetricTensor return tMetricTensor; Modulo return tModulo; MovingBand2D return tMovingBand2D; MultiplySolution return tMultiplySolution ; Name return tName; NameFromString return tNameFromString; NameOfBasisFunction return tNameOfBasisFunction; NameOfCoef return tNameOfCoef; NameOfConstraint return tNameOfConstraint; NameOfFormulation return tNameOfFormulation; NameOfMesh return tNameOfMesh; NameOfPostProcessing return tNameOfPostProcessing; NameOfResolution return tNameOfResolution; NameOfSpace return tNameOfSpace; NameOfSystem return tNameOfSystem; NbrMaxIteration return tNbrMaxIteration; NbrRegions return tNbrRegions ; NeverDt return tNeverDt; NewCoordinates return tNewCoordinates; NoMesh return tNoMesh; NoNewLine return tNoNewLine; NoTitle return tNoTitle; NumberOfDivisions return tNumberOfDivisions; NumberOfPoints return tNumberOfPoints; OnBox return tOnBox; OnCut return tOnSection; OnElementsOf return tOnElementsOf; OnelabAction return tOnelabAction; OnGlobal return tOnGlobal; OnGrid return tOnGrid; OnLine return tOnLine; OnPlane return tOnPlane; OnPoint return tOnPoint; OnRegion return tOnRegion; OnSection return tOnSection; Operation return tOperation; OperationEnd return tOperationEnd; Order return tOrder; OriginSystem return tOriginSystem; OverrideTimeStepValue return tOverrideTimeStepValue; Pi return tPi; Plot return tPlot; PostOperation return tPostOperation; PostProcessing return tPostProcessing; PostQuantity return tQuantity; Print return tPrint; PrintConstants return tPrintConstants; PrintGroup return tPrintGroup; Printf return tPrintf; Quantity return tQuantity; Rand return tRand; Read return tRead; Region return tRegion; RegionRef return tRegionRef; RelaxationFactor return tRelaxationFactor; RenameFile return tRenameFile; ResampleTime return tResampleTime; Resolution return tResolution; Return return tReturn; Round return tRound; SaveMesh return tSaveMesh; SaveSolutionExtendedMH return tSaveSolutionExtendedMH; SaveSolutionMHtoTime return tSaveSolutionMHtoTime; SaveSolutionWithEntityNum return tSaveSolutionWithEntityNum; SelectCorrection return tSelectCorrection ; SendMergeFileRequest return tSendMergeFileRequest; SendToServer return tSendToServer; SetCommSelf return tSetCommSelf; SetCommWorld return tSetCommWorld; SetFrequency return tSetFrequency; SetGlobalSolverOptions return tSetGlobalSolverOptions; SetTime return tSetTime; SetTimeStep return tSetTimeStep; Sign return tSign; Sin return tSin; Sinh return tSinh; Skin return tSkin; Sleep return tSleep; Smoothing return tSmoothing; SolidAngle return tSolidAngle; SolveAgainWithOther return tSolveAgainWithOther; SolveJac_AdaptRelax return tSolveJac_AdaptRelax; Solver return tSolver; Sort return tSort; Sprintf return tSprintf; Sqrt return tSqrt; StoppingCriterion return tStoppingCriterion; Store return tStoreInRegister; StoreInVariable return tStoreInVariable; StoreInField return tStoreInField; StoreInMeshBasedField return tStoreInMeshBasedField; StoreInRegister return tStoreInRegister; StoreMaxInRegister return tStoreMaxInRegister; StoreMaxXinRegister return tStoreMaxXinRegister; StoreMaxYinRegister return tStoreMaxYinRegister; StoreMaxZinRegister return tStoreMaxZinRegister; StoreMinInRegister return tStoreMinInRegister; StoreMinXinRegister return tStoreMinXinRegister; StoreMinYinRegister return tStoreMinYinRegister; StoreMinZinRegister return tStoreMinZinRegister; Str return tStr; StrCat return tStrCat; StrChoice return tStrChoice; StrCmp return tStrCmp; StringFromName return tStringFromName; SubFunction return tSubFunction; SubRegion return tSubRegion; SubRegionRef return tSubRegionRef; SubSpace return tSubSpace; SubType return tSubType; SubdFunction return tSubdFunction; Support return tSupport; Symmetry return tSymmetry; System return tDefineSystem; SystemCommand return tSystemCommand; Tan return tTan; Tanh return tTanh; Target return tTarget; Test return tTest; TestLevel return tTestLevel; Theta return tTheta; Time0 return tTime0; TimeFunction return tTimeFunction; TimeLegend return tTimeLegend; TimeLoopAdaptive return tTimeLoopAdaptive; TimeLoopNewmark return tTimeLoopNewmark; TimeLoopRungeKutta return tTimeLoopRungeKutta; TimeLoopTheta return tTimeLoopTheta; TimeMax return tTimeMax; TimeStep return tTimeStep; TimeValue return tTimeValue; TimeImagValue return tTimeImagValue; ToleranceFactor return tToleranceFactor; TotalMemory return tTotalMemory; Trace return tTrace; Type return tType; UndefineConstant return tUndefineConstant; Update return tUpdate; UpdateConstraint return tUpdateConstraint; UpperCase return tUpperCase; LowerCase return tLowerCase; LowerCaseIn return tLowerCaseIn; UsingPost return tUsingPost; Value return tValue; ValueIndex return tValueIndex; ValueName return tValueName; WithArgument return tWithArgument; While return tWhile; Write return tWrite; {digit}+ { getdp_yylval.i = atoi(yytext); return tINT; } {digit}+"."{digit}*({exp})? | {digit}*"."{digit}+({exp})? | {digit}+{exp} { getdp_yylval.d = atof(yytext); return tFLOAT; } {string} { getdp_yylval.c = strSave(yytext); return tSTRING; } . return yytext[0]; %% #undef getdp_yywrap int getdp_yywrap() { return 1; } #ifdef __cplusplus #define input yyinput #endif #ifndef yytext_ptr #define yytext_ptr yytext #endif char *strSave(const char *string) { return ((char *)strcpy((char *)Malloc(strlen(string)+1), string)); } void cStyleComments() { int c; while(1) { while((c = input()) != '*'){ if(c == '\n') getdp_yylinenum++; if(feof(getdp_yyin)) { Message::Error("End of file in commented region"); exit(1); } } if((c = input()) == '/') return; unput(c); } } void cxxStyleComments() { int c; while(1){ c = input(); if(c == '\n' || feof(getdp_yyin)) break; } getdp_yylinenum++; } void parseString(char endchar) { char tmp[2048]; int c = input(); int i = 0; while(c != endchar){ if(feof(getdp_yyin)) { Message::Error("End of file in string"); getdp_yycolnum = 0; break; } else if(c == '\n') { getdp_yycolnum = 0; } else if(i >= (int)sizeof(tmp)-1) { Message::Error("String too long"); break; } else { tmp[i++] = c; } c = input(); } tmp[i] = '\0'; getdp_yylval.c = strSave(tmp); } static bool is_alpha(const int c) { return (c>='a' && c<='z') || (c>='A' && c<='Z') || c=='_'; } void skipUntil(const char *skip, const char *until) { int l_skip, l_until, l_max, l; char chars[256]; int c_next, c_next_skip, c_next_until, c_previous = 0; int nb_skip = 0; l_skip = (skip)? strlen(skip) : 0; l_until = strlen(until); l_max = (l_skip > l_until) ? l_skip : l_until; if(l_max >= (int)sizeof(chars)){ Message::Error("Search pattern too long in skipUntil"); return; } while(1){ while (1){ chars[0] = input(); if(chars[0] == '\n') getdp_yylinenum++; if(feof(getdp_yyin)){ Message::Error("Unexpected end of file"); return; } if(chars[0] == '/'){ c_next = input(); if (c_next == '*') cStyleComments(); else if(c_next == '/') cxxStyleComments(); else unput(c_next); } if(!c_previous || !is_alpha(c_previous)){ if(chars[0] == until[0]) break; if(skip && chars[0] == skip[0]) break; } c_previous = chars[0]; } l = l_max; for(int i = 1; i < l; i++){ chars[i] = input(); if(chars[i] == '\n') getdp_yylinenum++; if(feof(getdp_yyin)){ l = i; break; } } c_next = input(); unput(c_next); c_next_skip = (l_skip0 for skip="For" and until="EndFor", or skip="If" and // until="EndIf"); in particular, because "If" is followed by a minimum of // 3 chars (e.g., '(1)'), with a total lenght thus exactly equal to the // one of "EndIf", one avoid an error when looking then for // "EndIf". (Patrick) } else{ for(int i = 1; i < l - 1; i++){ unput(chars[l-i]); if(chars[l-i] == '\n') getdp_yylinenum--; } } } } void skipUntil_test(const char *skip, const char *until, const char *until2, int l_until2_sub, int *type_until2) { int l_skip, l_until, l_until2, l_max, l; char chars[256]; int c_next, c_next_skip, c_next_until, c_next_until2, c_previous = 0, flag_EOL_EOF = 0; int nb_skip = 0; l_skip = (skip)? strlen(skip) : 0; l_until = strlen(until); l_until2 = (until2)? strlen(until2) : 0; l_max = (l_skip > l_until) ? l_skip : l_until; l_max = (l_until2 > l_max) ? l_until2 : l_max; if(l_max >= (int)sizeof(chars)){ Message::Error("Search pattern too long in skipUntil_test"); return; } while(1){ while (1){ chars[0] = input(); if(chars[0] == '\n') getdp_yylinenum++; if(feof(getdp_yyin)){ Message::Error("Unexpected end of file"); return; } if(chars[0] == '/'){ c_next = input(); if (c_next == '*') cStyleComments(); else if(c_next == '/') cxxStyleComments(); else unput(c_next); } if(!c_previous || !is_alpha(c_previous)){ if(chars[0] == until[0]) break; if(skip && chars[0] == skip[0]) break; if(!nb_skip && until2 && chars[0] == until2[0]) break; // Useless to search for until2 if nb_skip!=0 } c_previous = chars[0]; } l = l_max; flag_EOL_EOF = 0; for(int i = 1; i < l; i++){ chars[i] = input(); if(chars[i] == '\n'){ // getdp_yylinenum++; unput(chars[i]); chars[i] = 0; l = i; flag_EOL_EOF = 1; break; } if(feof(getdp_yyin)){ l = i; flag_EOL_EOF = 1; break; } } if(!flag_EOL_EOF){ c_next = input(); unput(c_next); c_next_skip = (l_skip. #ifndef _PRO_DEFINES_H_ #define _PRO_DEFINES_H_ #include "GetDPConfig.h" #include "ProDefine.h" #if defined(HAVE_LEGACY) #include "Gauss.h" #include "F.h" #include "BF.h" #include "GF.h" #include "Cal_Value.h" extern struct CurrentData Current; #endif struct StringXDefine Mesh_Format[] = { {"gmsh" , FORMAT_GMSH}, {"Gmsh" , FORMAT_GMSH}, {NULL , FORMAT_GMSH} } ; struct StringXDefine Field_Type[] = { {"Form0" , FORM0 }, {"Form1" , FORM1 }, {"Form2" , FORM2 }, {"Form3" , FORM3 }, {"Form0P" , FORM0P}, {"Form1P" , FORM1P}, {"Form2P" , FORM2P }, {"Form3P" , FORM3P}, {"Form0S" , FORM0S}, {"Form1S" , FORM1S}, {"Form2S" , FORM2S }, {"Form3S" , FORM3S}, {"Scalar" , SCALAR}, {"Vector" , VECTOR}, {"VectorP" , VECTORP}, {"Tensor" , TENSOR}, {"TensorSym" , TENSOR_SYM}, {"TensorDiag" , TENSOR_DIAG}, {NULL , FORM0} } ; struct StringXDefine FunctionForGroup_Type[] = { {"Region" , REGION}, {"Global" , GLOBAL}, {"NodesOf" , NODESOF}, {"EdgesOf" , EDGESOF}, {"FacetsOf" , FACETSOF}, {"VolumesOf" , VOLUMESOF}, {"ElementsOf" , ELEMENTSOF}, {"GroupsOfNodesOf" , GROUPSOFNODESOF}, {"GroupsOfEdgesOnNodesOf" , GROUPSOFEDGESONNODESOF}, {"GroupsOfEdgesOf" , GROUPSOFEDGESOF}, {"GroupsOfFacetsOf" , GROUPSOFFACETSOF}, {"GroupOfRegionsOf" , GROUPOFREGIONSOF}, {"EdgesOfTreeIn" , EDGESOFTREEIN}, {"FacetsOfTreeIn" , FACETSOFTREEIN}, {"DualNodesOf" , DUALNODESOF}, {"DualEdgesOf" , DUALEDGESOF}, {"DualFacetsOf" , DUALFACETSOF}, {"DualVolumesOf" , DUALVOLUMESOF}, {"BoundaryOfDualNodesOf" , BOUNDARYOFDUALNODESOF}, {"BoundaryOfDualEdgesOf" , BOUNDARYOFDUALEDGESOF}, {"BoundaryOfDualFacetsOf" , BOUNDARYOFDUALFACETSOF}, {"MovingBand2D" , MOVINGBAND2D}, {NULL , 0} } ; struct StringXDefine FunctionForGroup_SuppList[] = { {"Not" , SUPPLIST_NOT}, {"StartingOn" , SUPPLIST_STARTINGON}, {"OnOneSideOf" , SUPPLIST_ONONESIDEOF}, {"InSupport" , SUPPLIST_INSUPPORT}, {"ConnectedTo" , SUPPLIST_CONNECTEDTO}, {NULL , 0} } ; struct StringXDefine1Nbr Jacobian_Type[] = { {"Vol" , JACOBIAN_VOL , 0} , {"VolSphShell" , JACOBIAN_VOL_SPH_SHELL , -1} , {"VolRectShell" , JACOBIAN_VOL_RECT_SHELL , -1} , {"VolPlpdX" , JACOBIAN_VOL_PLPD_X , 2} , {"VolAxi" , JACOBIAN_VOL_AXI , 0} , {"VolAxiSphShell" , JACOBIAN_VOL_AXI_SPH_SHELL , -1} , {"VolAxiRectShell" , JACOBIAN_VOL_AXI_RECT_SHELL , -1} , {"VolAxiPlpdX" , JACOBIAN_VOL_AXI_PLPD_X , 2} , {"VolAxiSqu" , JACOBIAN_VOL_AXI_SQU , 0} , {"VolAxiSquSphShell" , JACOBIAN_VOL_AXI_SQU_SPH_SHELL , -1} , {"VolAxiSquRectShell", JACOBIAN_VOL_AXI_SQU_RECT_SHELL, -1} , {"Sur" , JACOBIAN_SUR , 0} , {"SurSphShell" , JACOBIAN_SUR_SPH_SHELL , -1} , {"SurRectShell" , JACOBIAN_SUR_RECT_SHELL , -1} , {"SurAxi" , JACOBIAN_SUR_AXI , 0} , {"Lin" , JACOBIAN_LIN , 0} , {NULL , JACOBIAN_VOL , 0} } ; struct StringXDefine Integration_Type[] = { {"Gauss" , GAUSS}, {"GaussLegendre" , GAUSSLEGENDRE}, {"Analytic" , ANALYTIC}, {NULL , GAUSS} } ; struct StringXDefine Integration_SubType[] = { {"Standard" , STANDARD}, {"Singular" , SINGULAR}, {"Adaptative" , ADAPTATIVE}, {NULL , STANDARD} } ; struct StringXDefine Element_Type[] = { {"Point" , POINT}, {"Line" , LINE}, {"Triangle" , TRIANGLE}, {"Quadrangle" , QUADRANGLE}, {"Tetrahedron" , TETRAHEDRON}, {"Hexahedron" , HEXAHEDRON}, {"Prism" , PRISM}, {"Pyramid" , PYRAMID}, {"Line2" , LINE_2}, {"Triangle2" , TRIANGLE_2}, {"Quadrangle2" , QUADRANGLE_2}, {"Quadrangle2_8N" , QUADRANGLE_2_8N}, {NULL , TRIANGLE} } ; struct StringXDefine GlobalQuantity_Type[] = { {"AliasOf" , ALIASOF}, {"AssociatedWith" , ASSOCIATEDWITH}, {NULL , ALIASOF} } ; struct StringXDefine Constraint_Type[] = { {"Assign" , ASSIGN}, {"Init" , INIT}, {"AssignFromResolution" , ASSIGNFROMRESOLUTION}, {"InitFromResolution" , INITFROMRESOLUTION}, {"AssignLocalProjection", ASSIGN_LOCALPROJ}, {"InitLocalProjection" , INIT_LOCALPROJ}, {"Network" , NETWORK}, {"Link" , CST_LINK}, {"LinkCplx" , CST_LINKCPLX}, {NULL , ASSIGN} } ; struct StringXDefine Formulation_Type[] = { {"FemEquation" , FEMEQUATION}, {"BemEquation" , BEMEQUATION}, {"GlobalEquation" , GLOBALEQUATION}, {NULL , FEMEQUATION} } ; struct StringXDefine DefineQuantity_Type[] = { /* a supprimer */ {"LocalQuantity" , LOCALQUANTITY}, {"GlobalQuantity" , GLOBALQUANTITY}, {"IntegralQuantity" , INTEGRALQUANTITY}, {"Local" , LOCALQUANTITY}, {"Global" , GLOBALQUANTITY}, {"Integral" , INTEGRALQUANTITY}, {NULL , LOCALQUANTITY} } ; struct StringXDefine Operator_Type[] = { {"NoOp" , NOOP } , {"d" , EXTDER } , {"dInv" , EXTDERINV} , {"Grad" , GRAD } , {"GradInv" , GRADINV } , {"Curl" , CURL } , {"CurlInv" , CURLINV } , {"Rot" , CURL } , {"RotInv" , CURLINV } , {"Div" , DIV } , {"DivInv" , DIVINV } , // unused {"NSx" , NSx } , {"NSxd" , NSxEXTDER} , {"NSxGrad" , NSxGRAD } , {"NPxGrad" , NPxGRAD } , {"D1" , _D1 } , {"D2" , _D2 } , {"D3" , _D3 } , {NULL , NOOP } } ; struct StringXDefine QuantityFromFS_Type[] = { {"Dof" , QUANTITY_DOF } , {"BF" , QUANTITY_BF } , {"NoDof" , QUANTITY_NODOF } , {NULL , QUANTITY_SIMPLE } } ; struct StringXDefine DefineSystem_Type[] = { {"RealValue" , VAL_REAL}, {"Real" , VAL_REAL}, {"ComplexValue" , VAL_COMPLEX}, {"Complex" , VAL_COMPLEX}, {NULL , VAL_REAL} } ; struct StringXDefine Operation_Type[] = { {"Apply" , OPERATION_APPLY}, {"DofsFrequencySpectrum" , OPERATION_DOFSFREQUENCYSPECTRUM}, {"Generate" , OPERATION_GENERATE}, {"GenerateCumulative" , OPERATION_GENERATE_CUMULATIVE}, {"GenerateJac" , OPERATION_GENERATEJAC}, {"GenerateJacCumulative" , OPERATION_GENERATEJAC_CUMULATIVE}, {"GenerateOnly" , OPERATION_GENERATEONLY}, {"GenerateOnlyJac" , OPERATION_GENERATEONLYJAC}, {"GenerateRHS" , OPERATION_GENERATERHS}, {"GenerateRHSCumulative" , OPERATION_GENERATERHS_CUMULATIVE}, {"GenerateSeparate" , OPERATION_GENERATESEPARATE}, {"InitCorrection" , OPERATION_INITCORRECTION}, {"InitSolution" , OPERATION_INITSOLUTION}, {"InitSolution1" , OPERATION_INITSOLUTION1}, {"ReadSolution" , OPERATION_READSOLUTION}, {"SaveSolution" , OPERATION_SAVESOLUTION}, {"SaveSolutionExtendedMH" , OPERATION_SAVESOLUTIONEXTENDEDMH}, {"SaveSolutions" , OPERATION_SAVESOLUTIONS}, {"SetCurrentSystem" , OPERATION_SETCURRENTSYSTEM}, {"SetRHSAsSolution" , OPERATION_SETRHSASSOLUTION}, {"SetSolutionAsRHS" , OPERATION_SETSOLUTIONASRHS}, {"SwapSolutionAndRHS" , OPERATION_SWAPSOLUTIONANDRHS}, {"SwapSolutionAndResidual", OPERATION_SWAPSOLUTIONANDRESIDUAL}, {"Solve" , OPERATION_SOLVE}, {"SolveAgain" , OPERATION_SOLVEAGAIN}, {"SolveJac" , OPERATION_SOLVEJAC}, {"SolveJacAgain" , OPERATION_SOLVEJACAGAIN}, {"SolveJac_AdaptRelax" , OPERATION_SOLVEJACADAPTRELAX}, {"SolveNL" , OPERATION_SOLVENL}, {"TransferSolution" , OPERATION_TRANSFERSOLUTION}, {"Update" , OPERATION_UPDATE}, {NULL , OPERATION_NONE} } ; struct StringXDefine ChangeOfState_Type[] = { {"ChangeSign" , CHANGEOFSTATE_CHANGESIGN}, {"ChangeLevel" , CHANGEOFSTATE_CHANGELEVEL}, {"ChangeReference" , CHANGEOFSTATE_CHANGEREFERENCE}, {"ChangeReference2" , CHANGEOFSTATE_CHANGEREFERENCE2}, {NULL , CHANGEOFSTATE_CHANGESIGN} } ; struct StringXDefine ErrorNorm_Type[] = { {"LinfNorm" , LINFNORM}, {"L1Norm" , L1NORM}, {"MeanL1Norm" , MEANL1NORM}, {"L2Norm" , L2NORM}, {"MeanL2Norm" , MEANL2NORM}, {NULL , LINFNORM} } ; struct StringXDefine NormOf_Type[] = { {"Solution" , SOLUTION}, {"Residual" , RESIDUAL}, {"RecalcResidual" , RECALCRESIDUAL}, {NULL , SOLUTION} } ; struct StringXPointer Current_Value[] = { #if defined(HAVE_LEGACY) {"Time" , &Current.Time}, {"DTime" , &Current.DTime}, {"Theta" , &Current.Theta}, {"TimeStep" , &Current.TimeStep}, {"Iteration", &Current.Iteration}, {"Iter" , &Current.Iteration}, {"TimeImag" , &Current.TimeImag}, {"Eigenvalue", &Current.Time}, {"EigenvalueReal" , &Current.Time}, {"EigenvalueImag" , &Current.TimeImag}, {"ReOmega" , &Current.Time}, {"ImOmega" , &Current.TimeImag}, {"wr" , &Current.Time}, {"wi" , &Current.TimeImag}, {"Breakpoint" , &Current.Breakpoint}, {"X" , &Current.x}, {"Y" , &Current.y}, {"Z" , &Current.z}, {"XS" , &Current.xs},{"YS" , &Current.ys}, {"ZS" , &Current.zs}, {"XP" , &Current.xp},{"YP" , &Current.yp}, {"ZP" , &Current.zp}, {"U" , &Current.x}, {"V" , &Current.y}, {"W" , &Current.z}, {"US" , &Current.xs},{"VS" , &Current.ys}, {"WS" , &Current.zs}, {"A" , &Current.a} ,{"B" , &Current.b} , {"C" , &Current.c}, {"Val0" , &Current.Val[0]}, {"Val1" , &Current.Val[1]}, {"Val2" , &Current.Val[2]}, {"Val3" , &Current.Val[3]}, {"Val4" , &Current.Val[4]}, {"Val5" , &Current.Val[5]}, {"Val6" , &Current.Val[6]}, {"Val7" , &Current.Val[7]}, {"Val8" , &Current.Val[8]}, {"QuadraturePointIndex", &Current.QuadraturePointIndex}, {"QP", &Current.QuadraturePointIndex}, {"KSPIts", &Current.KSPIts}, #endif {NULL , NULL} } ; struct StringXDefine PostQuantityTerm_EvaluationType[] = { {"Local" , LOCAL}, {"Term" , LOCAL}, {"Integral" , INTEGRAL}, {NULL , LOCAL} } ; struct StringXDefine PostSubOperation_CombinationType[] = { {"*" , MULTIPLICATION}, {"/" , DIVISION}, {"+" , ADDITION}, {"-" , SOUSTRACTION}, {NULL , MULTIPLICATION} } ; struct StringXDefine PostSubOperation_Format[] = { {"Table" , FORMAT_SPACE_TABLE }, {"SimpleTable" , FORMAT_SIMPLE_SPACE_TABLE }, {"NodeTable" , FORMAT_NODE_TABLE }, {"ValueOnly" , FORMAT_VALUE_ONLY }, {"TimeTable" , FORMAT_TIME_TABLE }, {"RegionTable" , FORMAT_REGION_TABLE }, {"RegionValue" , FORMAT_REGION_VALUE }, {"HarmonicToTimeTable" , FORMAT_TIME_TABLE }, // a supprimer {"FrequencyTable" , FORMAT_FREQUENCY_TABLE }, {"Gmsh" , FORMAT_GMSH}, {"GmshParsed" , FORMAT_GMSH_PARSED}, {"Unv" , FORMAT_UNV}, {"Gnuplot" , FORMAT_GNUPLOT }, {"Matlab" , FORMAT_MATLAB }, {"Adaptation" , FORMAT_ADAPT }, {NULL , FORMAT_GMSH } } ; struct StringXDefine PostSubOperation_FormatTag[] = { {"Time" , TAG_TIME}, {"TimeStep" , TAG_TIMESTEP}, {"Value" , TAG_VALUE}, {"X" , TAG_X}, {"Y" , TAG_Y}, {"Z" , TAG_Z}, {"Nodes" , TAG_NODES}, {"Type" , TAG_TYPE}, {"Version" , TAG_VERSION}, {"Date" , TAG_DATE}, {"Host" , TAG_HOST}, {"Filename" , TAG_FILENAME}, {"User" , TAG_USER}, {"Abscissa" , TAG_ABSCISSA}, {"Normal" , TAG_NORMAL}, {"Command" , TAG_COMMAND}, {NULL , 0} } ; struct StringXDefine PostSubOperation_AdaptationType[] = { {"P1" , P1}, {"H1" , H1}, {"H2" , H2}, {NULL , P1} } ; struct StringXDefine PostSubOperation_SortType[] = { {"Position" , SORT_BY_POSITION }, {"Connection" , SORT_BY_CONNECTIVITY }, {NULL , 0 } } ; /* ------------------------------------------------------------------------ */ /* Types (int) and their assigned functions */ /* ------------------------------------------------------------------------ */ #define CAST void(*)() struct DefineXFunction FunctionForGauss[] = { #if defined(HAVE_LEGACY) {POINT , (CAST)Gauss_Point}, {LINE , (CAST)Gauss_Line}, {TRIANGLE , (CAST)Gauss_Triangle}, {QUADRANGLE , (CAST)Gauss_Quadrangle}, {TETRAHEDRON , (CAST)Gauss_Tetrahedron}, {HEXAHEDRON , (CAST)Gauss_Hexahedron}, {PRISM , (CAST)Gauss_Prism}, {PYRAMID , (CAST)Gauss_Pyramid}, {LINE_2 , (CAST)Gauss_Line}, {TRIANGLE_2 , (CAST)Gauss_Triangle}, {QUADRANGLE_2 , (CAST)Gauss_Quadrangle}, {QUADRANGLE_2_8N, (CAST)Gauss_Quadrangle}, #endif {0 , 0} } ; struct DefineXFunction FunctionForSingularGauss[] = { #if defined(HAVE_LEGACY) {TRIANGLE , (CAST)GaussSingularR_Triangle}, {QUADRANGLE , (CAST)GaussSingularR_Quadrangle}, #endif {0 , 0} } ; struct DefineXFunction FunctionForGaussLegendre[] = { #if defined(HAVE_LEGACY) {POINT , (CAST)Gauss_Point}, {LINE , (CAST)Gauss_Line}, {TRIANGLE , (CAST)GaussLegendre_Triangle}, {QUADRANGLE , (CAST)GaussLegendre_Quadrangle}, {TETRAHEDRON , (CAST)GaussLegendre_Tetrahedron}, {HEXAHEDRON , (CAST)GaussLegendre_Hexahedron}, #endif {0 , 0} } ; #define POI POINT #define LIN LINE | LINE_2 #define TRI TRIANGLE | TRIANGLE_2 #define QUA QUADRANGLE | QUADRANGLE_2 | QUADRANGLE_2_8N #define TET TETRAHEDRON | TETRAHEDRON_2 #define HEX HEXAHEDRON | HEXAHEDRON_2 #define PRI PRISM | PRISM_2 #define PYR PYRAMID | PYRAMID_2 #define ALL POI|LIN|TRI|QUA|TET|HEX|PRI|PYR struct StringX3Function3Nbr BF_Function[] = { #if defined(HAVE_LEGACY) // H^1 Basis Functions and their gradients {"BF_Node", (CAST)BF_Node, (CAST)BF_GradNode, (CAST)BF_Zero, 1., ALL, 0 }, {"BF_Node_1N", (CAST)BF_Node, (CAST)BF_GradNode, (CAST)BF_Zero, 1., ALL, 0 }, {"BF_Node_2E", (CAST)BF_Node_2E, (CAST)BF_GradNode_2E, (CAST)BF_Zero, 2., ALL, 0 }, {"BF_Node_2F", (CAST)BF_Node_2F, (CAST)BF_GradNode_2F, (CAST)BF_Zero, 2., QUA|HEX/*|PRI|PYR*/, 0 }, {"BF_Node_2V", (CAST)BF_Node_2V, (CAST)BF_GradNode_2V, (CAST)BF_Zero, 2., HEX, 0 }, {"BF_Node_3E", (CAST)BF_Node_3E, (CAST)BF_GradNode_3E, (CAST)BF_Zero, 3., ALL, 0 }, {"BF_Node_3F", (CAST)BF_Node_3F, (CAST)BF_GradNode_3F, (CAST)BF_Zero, 3., TRI|QUA|TET|HEX|PRI|PYR, 0 }, {"BF_Node_3V", (CAST)BF_Node_3V, (CAST)BF_GradNode_3V, (CAST)BF_Zero, 3., HEX|PRI|PYR, 0 }, {"BF_GradNodeRealCoord", (CAST)BF_GradNodeRealCoord, (CAST)BF_Zero, (CAST)BF_Node, 0., ALL, 0 }, {"BF_GradNode", (CAST)BF_GradNode, (CAST)BF_Zero, (CAST)BF_Node, 0., ALL, 0 }, {"BF_GradNode_1N", (CAST)BF_GradNode, (CAST)BF_Zero, (CAST)BF_Node, 0., ALL, 0 }, {"BF_GradNode_2E", (CAST)BF_GradNode_2E, (CAST)BF_Zero, (CAST)BF_Node_2E, 1., ALL, 0 }, {"BF_GradNode_2F", (CAST)BF_GradNode_2F, (CAST)BF_Zero, (CAST)BF_Node_2F, 1., QUA|HEX/*|PRI|PYR*/, 0 }, {"BF_GradNode_2V", (CAST)BF_GradNode_2V, (CAST)BF_Zero, (CAST)BF_Node_2V, 1., HEX, 0 }, {"BF_GradNode_3E", (CAST)BF_GradNode_3E, (CAST)BF_Zero, (CAST)BF_Node_3E, 2., ALL, 0 }, {"BF_GradNode_3F", (CAST)BF_GradNode_3F, (CAST)BF_Zero, (CAST)BF_Node_3F, 2., TRI|QUA|TET|HEX|PRI|PYR, 0 }, {"BF_GradNode_3V", (CAST)BF_GradNode_3V, (CAST)BF_Zero, (CAST)BF_Node_3V, 2., HEX|PRI|PYR, 0 }, {"BF_GroupOfNodes", (CAST)BF_GroupOfNodes, (CAST)BF_GradGroupOfNodes, (CAST)BF_Zero, 1., ALL, 0 }, {"BF_GroupOfNodes_1N", (CAST)BF_GroupOfNodes, (CAST)BF_GradGroupOfNodes, (CAST)BF_Zero, 1., ALL, 0 }, {"BF_GroupOfNodes_2E", (CAST)BF_GroupOfNodes_2E, (CAST)BF_GradGroupOfNodes_2E, (CAST)BF_Zero, 2., ALL, 0 }, {"BF_GroupOfNodes_2F", (CAST)BF_GroupOfNodes_2F, (CAST)BF_GradGroupOfNodes_2F, (CAST)BF_Zero, 2., QUA|HEX/*|PRI|PYR*/, 0 }, {"BF_GroupOfNodes_2V", (CAST)BF_GroupOfNodes_2V, (CAST)BF_GradGroupOfNodes_2V, (CAST)BF_Zero, 2., HEX, 0 }, {"BF_GroupOfNodes_3E", (CAST)BF_GroupOfNodes_3E, (CAST)BF_GradGroupOfNodes_3E, (CAST)BF_Zero, 3., ALL, 0 }, {"BF_GroupOfNodes_3F", (CAST)BF_GroupOfNodes_3F, (CAST)BF_GradGroupOfNodes_3F, (CAST)BF_Zero, 3., HEX|PRI|TET|HEX|PRI|PYR, 0 }, {"BF_GroupOfNodes_3V", (CAST)BF_GroupOfNodes_3V, (CAST)BF_GradGroupOfNodes_3V, (CAST)BF_Zero, 3., HEX|PRI|PYR, 0 }, {"BF_GradGroupOfNodes", (CAST)BF_GradGroupOfNodes, (CAST)BF_Zero, (CAST)BF_GroupOfNodes, 0., ALL, 0 }, {"BF_GradGroupOfNodes_1N", (CAST)BF_GradGroupOfNodes, (CAST)BF_Zero, (CAST)BF_GroupOfNodes, 0., ALL, 0 }, {"BF_GradGroupOfNodes_2E", (CAST)BF_GradGroupOfNodes_2E, (CAST)BF_Zero, (CAST)BF_GroupOfNodes_2E, 1., ALL, 0 }, {"BF_GradGroupOfNodes_2F", (CAST)BF_GradGroupOfNodes_2F, (CAST)BF_Zero, (CAST)BF_GroupOfNodes_2F, 1., QUA|HEX/*|PRI|PYR*/, 0 }, {"BF_GradGroupOfNodes_2V", (CAST)BF_GradGroupOfNodes_2V, (CAST)BF_Zero, (CAST)BF_GroupOfNodes_2V, 1., HEX, 0 }, {"BF_GradGroupOfNodes_3E", (CAST)BF_GradGroupOfNodes_3E, (CAST)BF_Zero, (CAST)BF_GroupOfNodes_3E, 2., ALL, 0 }, {"BF_GradGroupOfNodes_3F", (CAST)BF_GradGroupOfNodes_3F, (CAST)BF_Zero, (CAST)BF_GroupOfNodes_3F, 2., HEX|PRI|TET|HEX|PRI|PYR, 0 }, {"BF_GradGroupOfNodes_3V", (CAST)BF_GradGroupOfNodes_2V, (CAST)BF_Zero, (CAST)BF_GroupOfNodes_3V, 2., HEX|PRI|PYR, 0 }, // H(curl) basis Functions and their curls {"BF_Edge", (CAST)BF_Edge, (CAST)BF_CurlEdge, (CAST)BF_Zero, 0.5, ALL, 1 }, {"BF_Edge_1E", (CAST)BF_Edge, (CAST)BF_CurlEdge, (CAST)BF_Zero, 0.5, ALL, 1 }, {"BF_Edge_2E", (CAST)BF_Edge_2E, (CAST)BF_CurlEdge_2E, (CAST)BF_Zero, 1., ALL, 0 }, {"BF_Edge_2F", (CAST)BF_Edge_2F, (CAST)BF_CurlEdge_2F, (CAST)BF_Zero, 1., ALL, 0 }, {"BF_Edge_2V", (CAST)BF_Edge_2V, (CAST)BF_CurlEdge_2V, (CAST)BF_Zero, 1., ALL, 0 }, {"BF_Edge_3E", (CAST)BF_Edge_3E, (CAST)BF_CurlEdge_3E, (CAST)BF_Zero, 1.5, TRI|QUA|TET|HEX|PRI, 0 }, {"BF_Edge_3F_a", (CAST)BF_Edge_3F_a, (CAST)BF_CurlEdge_3F_a, (CAST)BF_Zero, 1.5, TRI|QUA|TET|HEX|PRI, 0 }, {"BF_Edge_3F_b", (CAST)BF_Edge_3F_b, (CAST)BF_CurlEdge_3F_b, (CAST)BF_Zero, 1.5, TRI|QUA|TET|HEX|PRI, 0 }, {"BF_Edge_3F_c", (CAST)BF_Edge_3F_c, (CAST)BF_CurlEdge_3F_c, (CAST)BF_Zero, 1.5, TRI|QUA|TET|HEX|PRI, 0 }, {"BF_Edge_3V", (CAST)BF_Edge_3V, (CAST)BF_CurlEdge_3V, (CAST)BF_Zero, 1.5, TRI|QUA|TET|HEX|PRI, 0 }, {"BF_Edge_4E", (CAST)BF_Edge_4E, (CAST)BF_CurlEdge_4E, (CAST)BF_Zero, 2., ALL, 0 }, {"BF_Edge_4F", (CAST)BF_Edge_4F, (CAST)BF_CurlEdge_4F, (CAST)BF_Zero, 2., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_Edge_4V", (CAST)BF_Edge_4V, (CAST)BF_CurlEdge_4V, (CAST)BF_Zero, 2., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_CurlEdge", (CAST)BF_CurlEdge, (CAST)BF_Zero, (CAST)BF_Edge, 0., ALL, 1 }, {"BF_CurlEdge_1E", (CAST)BF_CurlEdge, (CAST)BF_Zero, (CAST)BF_Edge, 0., ALL, 0 }, {"BF_CurlEdge_2E", (CAST)BF_CurlEdge_2E, (CAST)BF_Zero, (CAST)BF_Edge_2E, 0., ALL, 0 }, {"BF_CurlEdge_2F", (CAST)BF_CurlEdge_2F, (CAST)BF_Zero, (CAST)BF_Edge_2F, 0., ALL, 0 }, {"BF_CurlEdge_2V", (CAST)BF_CurlEdge_2V, (CAST)BF_Zero, (CAST)BF_Edge_2V, 0., ALL, 0 }, {"BF_CurlEdge_3E", (CAST)BF_CurlEdge_3E, (CAST)BF_Zero, (CAST)BF_Edge_3E, 1., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_CurlEdge_3F_a", (CAST)BF_CurlEdge_3F_a, (CAST)BF_Zero, (CAST)BF_Edge_3F_a, 1., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_CurlEdge_3F_b", (CAST)BF_CurlEdge_3F_b, (CAST)BF_Zero, (CAST)BF_Edge_3F_b, 1., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_CurlEdge_3F_c", (CAST)BF_CurlEdge_3F_c, (CAST)BF_Zero, (CAST)BF_Edge_3F_c, 1., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_CurlEdge_3V", (CAST)BF_CurlEdge_3V, (CAST)BF_Zero, (CAST)BF_Edge_3V, 1., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_CurlEdge_4E", (CAST)BF_CurlEdge_4E, (CAST)BF_Zero, (CAST)BF_Edge_4E, 1., ALL, 0 }, {"BF_CurlEdge_4F", (CAST)BF_CurlEdge_4F, (CAST)BF_Zero, (CAST)BF_Edge_4F, 1., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_CurlEdge_4V", (CAST)BF_CurlEdge_4V, (CAST)BF_Zero, (CAST)BF_Edge_4V, 1., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_GroupOfEdges", (CAST)BF_GroupOfEdges, (CAST)BF_CurlGroupOfEdges, (CAST)BF_Zero, 0.5, ALL, 1 }, {"BF_GroupOfEdges_1E", (CAST)BF_GroupOfEdges, (CAST)BF_CurlGroupOfEdges, (CAST)BF_Zero, 0.5, ALL, 0 }, {"BF_GroupOfEdges_2E", (CAST)BF_GroupOfEdges_2E, (CAST)BF_CurlGroupOfEdges_2E, (CAST)BF_Zero, 1., ALL, 0 }, {"BF_GroupOfEdges_2F", (CAST)BF_GroupOfEdges_2F, (CAST)BF_CurlGroupOfEdges_2F, (CAST)BF_Zero, 1., ALL, 0 }, {"BF_GroupOfEdges_2V", (CAST)BF_GroupOfEdges_2V, (CAST)BF_CurlGroupOfEdges_2V, (CAST)BF_Zero, 1., ALL, 0 }, {"BF_GroupOfEdges_3E", (CAST)BF_GroupOfEdges_3E, (CAST)BF_CurlGroupOfEdges_3E, (CAST)BF_Zero, 1.5, TRI|QUA|TET|HEX|PRI, 0 }, {"BF_GroupOfEdges_3F_a", (CAST)BF_GroupOfEdges_3F_a, (CAST)BF_CurlGroupOfEdges_3F_a, (CAST)BF_Zero, 1.5, TRI|QUA|TET|HEX|PRI, 0 }, {"BF_GroupOfEdges_3F_b", (CAST)BF_GroupOfEdges_3F_b, (CAST)BF_CurlGroupOfEdges_3F_b, (CAST)BF_Zero, 1.5, TRI|QUA|TET|HEX|PRI, 0 }, {"BF_GroupOfEdges_3F_c", (CAST)BF_GroupOfEdges_3F_c, (CAST)BF_CurlGroupOfEdges_3F_c, (CAST)BF_Zero, 1.5, TRI|QUA|TET|HEX|PRI, 0 }, {"BF_GroupOfEdges_3V", (CAST)BF_GroupOfEdges_3V, (CAST)BF_CurlGroupOfEdges_3V, (CAST)BF_Zero, 1.5, TRI|QUA|TET|HEX|PRI, 0 }, {"BF_GroupOfEdges_4E", (CAST)BF_GroupOfEdges_4E, (CAST)BF_CurlGroupOfEdges_4E, (CAST)BF_Zero, 2., ALL, 0 }, {"BF_GroupOfEdges_4F", (CAST)BF_GroupOfEdges_4F, (CAST)BF_CurlGroupOfEdges_4F, (CAST)BF_Zero, 2., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_GroupOfEdges_4V", (CAST)BF_GroupOfEdges_4V, (CAST)BF_CurlGroupOfEdges_4V, (CAST)BF_Zero, 2., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_CurlGroupOfEdges", (CAST)BF_CurlGroupOfEdges, (CAST)BF_Zero, (CAST)BF_GroupOfEdges, 0., ALL, 1 }, {"BF_CurlGroupOfEdges_1E", (CAST)BF_CurlGroupOfEdges, (CAST)BF_Zero, (CAST)BF_GroupOfEdges, 0., ALL, 0 }, {"BF_CurlGroupOfEdges_2E", (CAST)BF_CurlGroupOfEdges_2E, (CAST)BF_Zero, (CAST)BF_GroupOfEdges_2E, 0., ALL, 0 }, {"BF_CurlGroupOfEdges_2F", (CAST)BF_CurlGroupOfEdges_2F, (CAST)BF_Zero, (CAST)BF_GroupOfEdges_2F, 0., ALL, 0 }, {"BF_CurlGroupOfEdges_2V", (CAST)BF_CurlGroupOfEdges_2V, (CAST)BF_Zero, (CAST)BF_GroupOfEdges_2V, 0., ALL, 0 }, {"BF_CurlGroupOfEdges_3E", (CAST)BF_CurlGroupOfEdges_3E, (CAST)BF_Zero, (CAST)BF_GroupOfEdges_3E, 1., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_CurlGroupOfEdges_3F_a", (CAST)BF_CurlGroupOfEdges_3F_a, (CAST)BF_Zero, (CAST)BF_GroupOfEdges_3F_a, 1., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_CurlGroupOfEdges_3F_b", (CAST)BF_CurlGroupOfEdges_3F_b, (CAST)BF_Zero, (CAST)BF_GroupOfEdges_3F_b, 1., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_CurlGroupOfEdges_3F_c", (CAST)BF_CurlGroupOfEdges_3F_c, (CAST)BF_Zero, (CAST)BF_GroupOfEdges_3F_c, 1., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_CurlGroupOfEdges_3V", (CAST)BF_CurlGroupOfEdges_3V, (CAST)BF_Zero, (CAST)BF_GroupOfEdges_3V, 1., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_CurlGroupOfEdges_4E", (CAST)BF_CurlGroupOfEdges_4E, (CAST)BF_Zero, (CAST)BF_GroupOfEdges_4E, 1., ALL, 0 }, {"BF_CurlGroupOfEdges_4F", (CAST)BF_CurlGroupOfEdges_4F, (CAST)BF_Zero, (CAST)BF_GroupOfEdges_4F, 1., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_CurlGroupOfEdges_4V", (CAST)BF_CurlGroupOfEdges_4V, (CAST)BF_Zero, (CAST)BF_GroupOfEdges_4V, 1., TRI|QUA|TET|HEX|PRI, 0 }, // H(curl, perp) basis Functions and their curls {"BF_PerpendicularEdge", (CAST)BF_PerpendicularEdge, (CAST)BF_CurlPerpendicularEdge, (CAST)BF_Zero, 1., ALL, 0 }, {"BF_PerpendicularEdge_1N", (CAST)BF_PerpendicularEdge, (CAST)BF_CurlPerpendicularEdge, (CAST)BF_Zero, 1., ALL, 0 }, {"BF_PerpendicularEdge_2E", (CAST)BF_PerpendicularEdge_2E, (CAST)BF_CurlPerpendicularEdge_2E, (CAST)BF_Zero, 2., ALL, 0 }, {"BF_PerpendicularEdge_2F", (CAST)BF_PerpendicularEdge_2F, (CAST)BF_CurlPerpendicularEdge_2F, (CAST)BF_Zero, 2., QUA|HEX|PRI, 0 }, {"BF_PerpendicularEdge_2V", (CAST)BF_PerpendicularEdge_2V, (CAST)BF_CurlPerpendicularEdge_2V, (CAST)BF_Zero, 2., QUA|HEX, 0 }, {"BF_PerpendicularEdge_3E", (CAST)BF_PerpendicularEdge_3E, (CAST)BF_CurlPerpendicularEdge_3E, (CAST)BF_Zero, 3., ALL, 0 }, {"BF_PerpendicularEdge_3F", (CAST)BF_PerpendicularEdge_3F, (CAST)BF_CurlPerpendicularEdge_3F, (CAST)BF_Zero, 3., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_PerpendicularEdge_3V", (CAST)BF_PerpendicularEdge_3V, (CAST)BF_CurlPerpendicularEdge_3V, (CAST)BF_Zero, 3., HEX|PRI, 0 }, {"BF_CurlPerpendicularEdge", (CAST)BF_CurlPerpendicularEdge, (CAST)BF_Zero, (CAST)BF_PerpendicularEdge, 0., ALL, 0 }, {"BF_CurlPerpendicularEdge_1N", (CAST)BF_CurlPerpendicularEdge, (CAST)BF_Zero, (CAST)BF_PerpendicularEdge, 0., ALL, 0 }, {"BF_CurlPerpendicularEdge_2E", (CAST)BF_CurlPerpendicularEdge_2E, (CAST)BF_Zero, (CAST)BF_PerpendicularEdge_2E, 1., ALL, 0 }, {"BF_CurlPerpendicularEdge_2F", (CAST)BF_CurlPerpendicularEdge_2F, (CAST)BF_Zero, (CAST)BF_PerpendicularEdge_2F, 1., QUA|HEX|PRI, 0 }, {"BF_CurlPerpendicularEdge_2V", (CAST)BF_CurlPerpendicularEdge_2V, (CAST)BF_Zero, (CAST)BF_PerpendicularEdge_2V, 1., QUA|HEX, 0 }, {"BF_CurlPerpendicularEdge_3E", (CAST)BF_CurlPerpendicularEdge_3E, (CAST)BF_Zero, (CAST)BF_PerpendicularEdge_3E, 2., ALL, 0 }, {"BF_CurlPerpendicularEdge_3F", (CAST)BF_CurlPerpendicularEdge_3F, (CAST)BF_Zero, (CAST)BF_PerpendicularEdge_3F, 2., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_CurlPerpendicularEdge_3V", (CAST)BF_CurlPerpendicularEdge_3V, (CAST)BF_Zero, (CAST)BF_PerpendicularEdge_3V, 2., HEX|PRI, 0 }, {"BF_GroupOfPerpendicularEdges", (CAST)BF_GroupOfPerpendicularEdges, (CAST)BF_CurlGroupOfPerpendicularEdges, (CAST)BF_Zero, 1., ALL, 0 }, {"BF_GroupOfPerpendicularEdges_1N", (CAST)BF_GroupOfPerpendicularEdges, (CAST)BF_CurlGroupOfPerpendicularEdges, (CAST)BF_Zero, 1., ALL, 0 }, {"BF_GroupOfPerpendicularEdges_2E", (CAST)BF_GroupOfPerpendicularEdges_2E, (CAST)BF_CurlGroupOfPerpendicularEdges_2E, (CAST)BF_Zero, 2., ALL, 0 }, {"BF_GroupOfPerpendicularEdges_2F", (CAST)BF_GroupOfPerpendicularEdges_2F, (CAST)BF_CurlGroupOfPerpendicularEdges_2F, (CAST)BF_Zero, 2., QUA|HEX|PRI, 0 }, {"BF_GroupOfPerpendicularEdges_2V", (CAST)BF_GroupOfPerpendicularEdges_2V, (CAST)BF_CurlGroupOfPerpendicularEdges_2V, (CAST)BF_Zero, 2., QUA|HEX, 0 }, {"BF_GroupOfPerpendicularEdges_3E", (CAST)BF_GroupOfPerpendicularEdges_3E, (CAST)BF_CurlGroupOfPerpendicularEdges_3E, (CAST)BF_Zero, 3., ALL, 0 }, {"BF_GroupOfPerpendicularEdges_3F", (CAST)BF_GroupOfPerpendicularEdges_3F, (CAST)BF_CurlGroupOfPerpendicularEdges_3F, (CAST)BF_Zero, 3., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_GroupOfPerpendicularEdges_3V", (CAST)BF_GroupOfPerpendicularEdges_3V, (CAST)BF_CurlGroupOfPerpendicularEdges_3V, (CAST)BF_Zero, 3., HEX|PRI, 0 }, {"BF_CurlGroupOfPerpendicularEdges", (CAST)BF_CurlGroupOfPerpendicularEdges, (CAST)BF_Zero, (CAST)BF_GroupOfPerpendicularEdges, 0., ALL, 0 }, {"BF_CurlGroupOfPerpendicularEdges_1N", (CAST)BF_CurlGroupOfPerpendicularEdges, (CAST)BF_Zero, (CAST)BF_GroupOfPerpendicularEdges, 0., ALL, 0 }, {"BF_CurlGroupOfPerpendicularEdges_2E", (CAST)BF_CurlGroupOfPerpendicularEdges_2E, (CAST)BF_Zero, (CAST)BF_GroupOfPerpendicularEdges_2E, 1., ALL, 0 }, {"BF_CurlGroupOfPerpendicularEdges_2F", (CAST)BF_CurlGroupOfPerpendicularEdges_2F, (CAST)BF_Zero, (CAST)BF_GroupOfPerpendicularEdges_2F, 1., QUA|HEX|PRI, 0 }, {"BF_CurlGroupOfPerpendicularEdges_2V", (CAST)BF_CurlGroupOfPerpendicularEdges_2V, (CAST)BF_Zero, (CAST)BF_GroupOfPerpendicularEdges_2V, 1., QUA|HEX, 0 }, {"BF_CurlGroupOfPerpendicularEdges_3E", (CAST)BF_CurlGroupOfPerpendicularEdges_3E, (CAST)BF_Zero, (CAST)BF_GroupOfPerpendicularEdges_3E, 2., ALL, 0 }, {"BF_CurlGroupOfPerpendicularEdges_3F", (CAST)BF_CurlGroupOfPerpendicularEdges_3F, (CAST)BF_Zero, (CAST)BF_GroupOfPerpendicularEdges_3F, 2., TRI|QUA|TET|HEX|PRI, 0 }, {"BF_CurlGroupOfPerpendicularEdges_3V", (CAST)BF_CurlGroupOfPerpendicularEdges_3V, (CAST)BF_Zero, (CAST)BF_GroupOfPerpendicularEdges_3V, 2., HEX|PRI, 0 }, // H(div) basis Functions and their divergences {"BF_Facet", (CAST)BF_Facet, (CAST)BF_DivFacet, (CAST)BF_Zero, 0.5, ALL, 1 }, {"BF_DivFacet", (CAST)BF_DivFacet, (CAST)BF_Zero, (CAST)BF_Facet, 0., ALL, 1 }, {"BF_GroupOfFacets", (CAST)BF_GroupOfFacets, (CAST)BF_DivGroupOfFacets, (CAST)BF_Zero, 0.5, ALL, 1 }, {"BF_DivGroupOfFacets", (CAST)BF_DivGroupOfFacets, (CAST)BF_Zero, (CAST)BF_GroupOfFacets, 0., ALL, 1 }, // Current along wire {"BF_Wire", (CAST)BF_Wire, (CAST)BF_DivWire, (CAST)BF_Zero, 1., LIN, 0 }, {"BF_DivWire", (CAST)BF_DivWire, (CAST)BF_Zero, (CAST)BF_Wire, 0., LIN, 0 }, // H(div, perp) basis Functions and their divergences {"BF_PerpendicularFacet", (CAST)BF_PerpendicularFacet, (CAST)BF_DivPerpendicularFacet, (CAST)BF_Zero, 0.5, ALL, 1 }, {"BF_PerpendicularFacet_1E", (CAST)BF_PerpendicularFacet, (CAST)BF_DivPerpendicularFacet, (CAST)BF_Zero, 0.5, ALL, 0 }, {"BF_PerpendicularFacet_2E", (CAST)BF_PerpendicularFacet_2E, (CAST)BF_DivPerpendicularFacet_2E, (CAST)BF_Zero, 1., ALL, 0 }, {"BF_PerpendicularFacet_2F", (CAST)BF_PerpendicularFacet_2F, (CAST)BF_DivPerpendicularFacet_2F, (CAST)BF_Zero, 1., ALL, 0 }, {"BF_PerpendicularFacet_2V", (CAST)BF_PerpendicularFacet_2V, (CAST)BF_DivPerpendicularFacet_2V, (CAST)BF_Zero, 1., ALL, 0 }, {"BF_PerpendicularFacet_3E", (CAST)BF_PerpendicularFacet_3E, (CAST)BF_DivPerpendicularFacet_3E, (CAST)BF_Zero, 1.5, ALL, 0 }, {"BF_PerpendicularFacet_3F_a", (CAST)BF_PerpendicularFacet_3F_a, (CAST)BF_DivPerpendicularFacet_3F_a, (CAST)BF_Zero, 1.5, ALL, 0 }, {"BF_PerpendicularFacet_3F_b", (CAST)BF_PerpendicularFacet_3F_b, (CAST)BF_DivPerpendicularFacet_3F_b, (CAST)BF_Zero, 1.5, ALL, 0 }, {"BF_PerpendicularFacet_3F_c", (CAST)BF_PerpendicularFacet_3F_c, (CAST)BF_DivPerpendicularFacet_3F_c, (CAST)BF_Zero, 1.5, ALL, 0 }, {"BF_PerpendicularFacet_3V", (CAST)BF_PerpendicularFacet_3V, (CAST)BF_DivPerpendicularFacet_3V, (CAST)BF_Zero, 1.5, ALL, 0 }, {"BF_PerpendicularFacet_4E", (CAST)BF_PerpendicularFacet_4E, (CAST)BF_DivPerpendicularFacet_4E, (CAST)BF_Zero, 2., ALL, 0 }, {"BF_PerpendicularFacet_4F", (CAST)BF_PerpendicularFacet_4F, (CAST)BF_DivPerpendicularFacet_4F, (CAST)BF_Zero, 2., ALL, 0 }, {"BF_PerpendicularFacet_4V", (CAST)BF_PerpendicularFacet_4V, (CAST)BF_DivPerpendicularFacet_4V, (CAST)BF_Zero, 2., ALL, 0 }, {"BF_DivPerpendicularFacet", (CAST)BF_DivPerpendicularFacet, (CAST)BF_Zero, (CAST)BF_PerpendicularFacet, 0., ALL, 1 }, {"BF_DivPerpendicularFacet_1E", (CAST)BF_DivPerpendicularFacet, (CAST)BF_Zero, (CAST)BF_PerpendicularFacet, 0., ALL, 0 }, {"BF_DivPerpendicularFacet_2E", (CAST)BF_DivPerpendicularFacet_2E, (CAST)BF_Zero, (CAST)BF_PerpendicularFacet_2E, 0., ALL, 0 }, {"BF_DivPerpendicularFacet_2F", (CAST)BF_DivPerpendicularFacet_2F, (CAST)BF_Zero, (CAST)BF_PerpendicularFacet_2F, 0., ALL, 0 }, {"BF_DivPerpendicularFacet_2V", (CAST)BF_DivPerpendicularFacet_2V, (CAST)BF_Zero, (CAST)BF_PerpendicularFacet_2V, 0., ALL, 0 }, {"BF_DivPerpendicularFacet_3E", (CAST)BF_DivPerpendicularFacet_3E, (CAST)BF_Zero, (CAST)BF_PerpendicularFacet_3E, 1., ALL, 0 }, {"BF_DivPerpendicularFacet_3F_a", (CAST)BF_DivPerpendicularFacet_3F_a, (CAST)BF_Zero, (CAST)BF_PerpendicularFacet_3F_a, 1., ALL, 0 }, {"BF_DivPerpendicularFacet_3F_b", (CAST)BF_DivPerpendicularFacet_3F_b, (CAST)BF_Zero, (CAST)BF_PerpendicularFacet_3F_b, 1., ALL, 0 }, {"BF_DivPerpendicularFacet_3F_c", (CAST)BF_DivPerpendicularFacet_3F_c, (CAST)BF_Zero, (CAST)BF_PerpendicularFacet_3F_c, 1., ALL, 0 }, {"BF_DivPerpendicularFacet_3V", (CAST)BF_DivPerpendicularFacet_3V, (CAST)BF_Zero, (CAST)BF_PerpendicularFacet_3V, 1., ALL, 0 }, {"BF_DivPerpendicularFacet_4E", (CAST)BF_DivPerpendicularFacet_4E, (CAST)BF_Zero, (CAST)BF_PerpendicularFacet_4E, 1., ALL, 0 }, {"BF_DivPerpendicularFacet_4F", (CAST)BF_DivPerpendicularFacet_4F, (CAST)BF_Zero, (CAST)BF_PerpendicularFacet_4F, 1., ALL, 0 }, {"BF_DivPerpendicularFacet_4V", (CAST)BF_DivPerpendicularFacet_4V, (CAST)BF_Zero, (CAST)BF_PerpendicularFacet_4V, 1., ALL, 0 }, // L^2 basis Functions {"BF_Volume", (CAST)BF_Volume, (CAST)BF_Volume, (CAST)BF_Zero, 0., ALL, 0 }, {"BF_VolumeX", (CAST)BF_VolumeX, (CAST)BF_VolumeX, (CAST)BF_Zero, 0., ALL, 0 }, {"BF_VolumeY", (CAST)BF_VolumeY, (CAST)BF_VolumeY, (CAST)BF_Zero, 0., ALL, 0 }, {"BF_VolumeZ", (CAST)BF_VolumeZ, (CAST)BF_VolumeZ, (CAST)BF_Zero, 0., ALL, 0 }, // (H^1)^3 Basis Functions {"BF_NodeX" , (CAST)BF_NodeX , (CAST)BF_NodeX_D1 , (CAST)BF_NodeX_D2 , 1. , ALL, 0 }, {"BF_NodeY" , (CAST)BF_NodeY , (CAST)BF_NodeY_D1 , (CAST)BF_NodeY_D2 , 1. , ALL, 0 }, {"BF_NodeZ" , (CAST)BF_NodeZ , (CAST)BF_NodeZ_D1 , (CAST)BF_NodeZ_D2 , 1. , ALL, 0 }, {"BF_NodeX_2E" , (CAST)BF_NodeX_2E , (CAST)BF_NodeX_D1_2E , (CAST)BF_NodeX_D2_2E , 2. , ALL, 0 }, {"BF_NodeY_2E" , (CAST)BF_NodeY_2E , (CAST)BF_NodeY_D1_2E , (CAST)BF_NodeY_D2_2E , 2. , ALL, 0 }, {"BF_NodeZ_2E" , (CAST)BF_NodeZ_2E , (CAST)BF_NodeZ_D1_2E , (CAST)BF_NodeZ_D2_2E , 2. , ALL, 0 }, {"BF_NodeX_2F" , (CAST)BF_NodeX_2F , (CAST)BF_NodeX_D1_2F , (CAST)BF_NodeX_D2_2F , 2. , QUA|HEX/*|PRI*/, 0 }, {"BF_NodeY_2F" , (CAST)BF_NodeY_2F , (CAST)BF_NodeY_D1_2F , (CAST)BF_NodeY_D2_2F , 2. , QUA|HEX/*|PRI*/, 0 }, {"BF_NodeZ_2F" , (CAST)BF_NodeZ_2F , (CAST)BF_NodeZ_D1_2F , (CAST)BF_NodeZ_D2_2F , 2. , QUA|HEX/*|PRI*/, 0 }, {"BF_NodeX_2V" , (CAST)BF_NodeX_2V , (CAST)BF_NodeX_D1_2V , (CAST)BF_NodeX_D2_2V , 2. , HEX, 0 }, {"BF_NodeY_2V" , (CAST)BF_NodeY_2V , (CAST)BF_NodeY_D1_2V , (CAST)BF_NodeY_D2_2V , 2. , HEX, 0 }, {"BF_NodeZ_2V" , (CAST)BF_NodeZ_2V , (CAST)BF_NodeZ_D1_2V , (CAST)BF_NodeZ_D2_2V , 2. , HEX, 0 }, {"BF_NodeX_3E" , (CAST)BF_NodeX_3E , (CAST)BF_NodeX_D1_3E , (CAST)BF_NodeX_D2_3E , 3. , ALL, 0 }, {"BF_NodeY_3E" , (CAST)BF_NodeY_3E , (CAST)BF_NodeY_D1_3E , (CAST)BF_NodeY_D2_3E , 3. , ALL, 0 }, {"BF_NodeZ_3E" , (CAST)BF_NodeZ_3E , (CAST)BF_NodeZ_D1_3E , (CAST)BF_NodeZ_D2_3E , 3. , ALL, 0 }, {"BF_NodeX_3F" , (CAST)BF_NodeX_3F , (CAST)BF_NodeX_D1_3F , (CAST)BF_NodeX_D2_3F , 3. , TRI|QUA|TET|HEX|PRI, 0 }, {"BF_NodeY_3F" , (CAST)BF_NodeY_3F , (CAST)BF_NodeY_D1_3F , (CAST)BF_NodeY_D2_3F , 3. , TRI|QUA|TET|HEX|PRI, 0 }, {"BF_NodeZ_3F" , (CAST)BF_NodeZ_3F , (CAST)BF_NodeZ_D1_3F , (CAST)BF_NodeZ_D2_3F , 3. , TRI|QUA|TET|HEX|PRI, 0 }, {"BF_NodeX_3V" , (CAST)BF_NodeX_3V , (CAST)BF_NodeX_D1_3V , (CAST)BF_NodeX_D2_3V , 3. , HEX|PRI, 0 }, {"BF_NodeY_3V" , (CAST)BF_NodeY_3V , (CAST)BF_NodeY_D1_3V , (CAST)BF_NodeY_D2_3V , 3. , HEX|PRI, 0 }, {"BF_NodeZ_3V" , (CAST)BF_NodeZ_3V , (CAST)BF_NodeZ_D1_3V , (CAST)BF_NodeZ_D2_3V , 3. , HEX|PRI, 0 }, {"BF_NodeX_D1" , (CAST)BF_NodeX_D1 , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_NodeY_D1" , (CAST)BF_NodeY_D1 , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_NodeZ_D1" , (CAST)BF_NodeZ_D1 , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_NodeX_D1_2E" , (CAST)BF_NodeX_D1_2E , (CAST)BF_Zero , (CAST)BF_Zero , 1. , ALL, 0 }, {"BF_NodeY_D1_2E" , (CAST)BF_NodeY_D1_2E , (CAST)BF_Zero , (CAST)BF_Zero , 1. , ALL, 0 }, {"BF_NodeZ_D1_2E" , (CAST)BF_NodeZ_D1_2E , (CAST)BF_Zero , (CAST)BF_Zero , 1. , ALL, 0 }, {"BF_NodeX_D1_2F" , (CAST)BF_NodeX_D1_2F , (CAST)BF_Zero , (CAST)BF_Zero , 1. , QUA|HEX/*|PRI*/, 0 }, {"BF_NodeY_D1_2F" , (CAST)BF_NodeY_D1_2F , (CAST)BF_Zero , (CAST)BF_Zero , 1. , QUA|HEX/*|PRI*/, 0 }, {"BF_NodeZ_D1_2F" , (CAST)BF_NodeZ_D1_2F , (CAST)BF_Zero , (CAST)BF_Zero , 1. , QUA|HEX/*|PRI*/, 0 }, {"BF_NodeX_D1_2V" , (CAST)BF_NodeX_D1_2V , (CAST)BF_Zero , (CAST)BF_Zero , 1. , HEX, 0 }, {"BF_NodeY_D1_2V" , (CAST)BF_NodeY_D1_2V , (CAST)BF_Zero , (CAST)BF_Zero , 1. , HEX, 0 }, {"BF_NodeZ_D1_2V" , (CAST)BF_NodeZ_D1_2V , (CAST)BF_Zero , (CAST)BF_Zero , 1. , HEX, 0 }, {"BF_NodeX_D1_3E" , (CAST)BF_NodeX_D1_3E , (CAST)BF_Zero , (CAST)BF_Zero , 2. , ALL, 0 }, {"BF_NodeY_D1_3E" , (CAST)BF_NodeY_D1_3E , (CAST)BF_Zero , (CAST)BF_Zero , 2. , ALL, 0 }, {"BF_NodeZ_D1_3E" , (CAST)BF_NodeZ_D1_3E , (CAST)BF_Zero , (CAST)BF_Zero , 2. , ALL, 0 }, {"BF_NodeX_D1_3F" , (CAST)BF_NodeX_D1_3F , (CAST)BF_Zero , (CAST)BF_Zero , 2. , TRI|QUA|TET|HEX|PRI, 0 }, {"BF_NodeY_D1_3F" , (CAST)BF_NodeY_D1_3F , (CAST)BF_Zero , (CAST)BF_Zero , 2. , TRI|QUA|TET|HEX|PRI, 0 }, {"BF_NodeZ_D1_3F" , (CAST)BF_NodeZ_D1_3F , (CAST)BF_Zero , (CAST)BF_Zero , 2. , TRI|QUA|TET|HEX|PRI, 0 }, {"BF_NodeX_D1_3V" , (CAST)BF_NodeX_D1_3V , (CAST)BF_Zero , (CAST)BF_Zero , 2. , HEX|PRI, 0 }, {"BF_NodeY_D1_3V" , (CAST)BF_NodeY_D1_3V , (CAST)BF_Zero , (CAST)BF_Zero , 2. , HEX|PRI, 0 }, {"BF_NodeZ_D1_3V" , (CAST)BF_NodeZ_D1_3V , (CAST)BF_Zero , (CAST)BF_Zero , 2. , HEX|PRI, 0 }, {"BF_NodeX_D2" , (CAST)BF_NodeX_D2 , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_NodeY_D2" , (CAST)BF_NodeY_D2 , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_NodeZ_D2" , (CAST)BF_NodeZ_D2 , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_NodeX_D2_2E" , (CAST)BF_NodeX_D2_2E , (CAST)BF_Zero , (CAST)BF_Zero , 1. , ALL, 0 }, {"BF_NodeY_D2_2E" , (CAST)BF_NodeY_D2_2E , (CAST)BF_Zero , (CAST)BF_Zero , 1. , ALL, 0 }, {"BF_NodeZ_D2_2E" , (CAST)BF_NodeZ_D2_2E , (CAST)BF_Zero , (CAST)BF_Zero , 1. , ALL, 0 }, {"BF_NodeX_D2_2F" , (CAST)BF_NodeX_D2_2F , (CAST)BF_Zero , (CAST)BF_Zero , 1. , QUA|HEX/*|PRI*/, 0 }, {"BF_NodeY_D2_2F" , (CAST)BF_NodeY_D2_2F , (CAST)BF_Zero , (CAST)BF_Zero , 1. , QUA|HEX/*|PRI*/, 0 }, {"BF_NodeZ_D2_2F" , (CAST)BF_NodeZ_D2_2F , (CAST)BF_Zero , (CAST)BF_Zero , 1. , QUA|HEX/*|PRI*/, 0 }, {"BF_NodeX_D2_2V" , (CAST)BF_NodeX_D2_2V , (CAST)BF_Zero , (CAST)BF_Zero , 1. , HEX, 0 }, {"BF_NodeY_D2_2V" , (CAST)BF_NodeY_D2_2V , (CAST)BF_Zero , (CAST)BF_Zero , 1. , HEX, 0 }, {"BF_NodeZ_D2_2V" , (CAST)BF_NodeZ_D2_2V , (CAST)BF_Zero , (CAST)BF_Zero , 1. , HEX, 0 }, {"BF_NodeX_D2_3E" , (CAST)BF_NodeX_D2_3E , (CAST)BF_Zero , (CAST)BF_Zero , 2. , ALL, 0 }, {"BF_NodeY_D2_3E" , (CAST)BF_NodeY_D2_3E , (CAST)BF_Zero , (CAST)BF_Zero , 2. , ALL, 0 }, {"BF_NodeZ_D2_3E" , (CAST)BF_NodeZ_D2_3E , (CAST)BF_Zero , (CAST)BF_Zero , 2. , ALL, 0 }, {"BF_NodeX_D2_3F" , (CAST)BF_NodeX_D2_3F , (CAST)BF_Zero , (CAST)BF_Zero , 2. , TRI|QUA|TET|HEX|PRI, 0 }, {"BF_NodeY_D2_3F" , (CAST)BF_NodeY_D2_3F , (CAST)BF_Zero , (CAST)BF_Zero , 2. , TRI|QUA|TET|HEX|PRI, 0 }, {"BF_NodeZ_D2_3F" , (CAST)BF_NodeZ_D2_3F , (CAST)BF_Zero , (CAST)BF_Zero , 2. , TRI|QUA|TET|HEX|PRI, 0 }, {"BF_NodeX_D2_3V" , (CAST)BF_NodeX_D2_3V , (CAST)BF_Zero , (CAST)BF_Zero , 2. , HEX|PRI, 0 }, {"BF_NodeY_D2_3V" , (CAST)BF_NodeY_D2_3V , (CAST)BF_Zero , (CAST)BF_Zero , 2. , HEX|PRI, 0 }, {"BF_NodeZ_D2_3V" , (CAST)BF_NodeZ_D2_3V , (CAST)BF_Zero , (CAST)BF_Zero , 2. , HEX|PRI, 0 }, {"BF_NodeX_D12" , (CAST)BF_NodeX_D12 , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_NodeY_D12" , (CAST)BF_NodeY_D12 , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_NodeZ_D12" , (CAST)BF_NodeZ_D12 , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_NodeX_D12_2E" , (CAST)BF_NodeX_D12_2E , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_NodeY_D12_2E" , (CAST)BF_NodeY_D12_2E , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_NodeZ_D12_2E" , (CAST)BF_NodeZ_D12_2E , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_GroupOfNodesX" , (CAST)BF_GroupOfNodesX , (CAST)BF_GroupOfNodesX_D1 , (CAST)BF_GroupOfNodesX_D2 , 1. , ALL, 0 }, {"BF_GroupOfNodesY" , (CAST)BF_GroupOfNodesY , (CAST)BF_GroupOfNodesY_D1 , (CAST)BF_GroupOfNodesY_D2 , 1. , ALL, 0 }, {"BF_GroupOfNodesZ" , (CAST)BF_GroupOfNodesZ , (CAST)BF_GroupOfNodesZ_D1 , (CAST)BF_GroupOfNodesZ_D2 , 1. , ALL, 0 }, {"BF_GroupOfNodesX_D1" , (CAST)BF_GroupOfNodesX_D1 , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_GroupOfNodesY_D1" , (CAST)BF_GroupOfNodesY_D1 , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_GroupOfNodesZ_D1" , (CAST)BF_GroupOfNodesZ_D1 , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_GroupOfNodesX_D2" , (CAST)BF_GroupOfNodesX_D2 , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_GroupOfNodesY_D2" , (CAST)BF_GroupOfNodesY_D2 , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_GroupOfNodesZ_D2" , (CAST)BF_GroupOfNodesZ_D2 , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_GroupOfNodesX_D12" , (CAST)BF_GroupOfNodesX_D12 , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_GroupOfNodesY_D12" , (CAST)BF_GroupOfNodesY_D12 , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_GroupOfNodesZ_D12" , (CAST)BF_GroupOfNodesZ_D12 , (CAST)BF_Zero , (CAST)BF_Zero , 0. , ALL, 0 }, // Special basis Functions {"BF_Zero", (CAST)BF_Zero, (CAST)BF_Zero, (CAST)BF_Zero, 0., ALL, 0 }, {"BF_One", (CAST)BF_One, (CAST)BF_Zero, (CAST)BF_One, 0., ALL, 0 }, {"BF_OneZ", (CAST)BF_OneZ, (CAST)BF_Zero, (CAST)BF_One, 0., ALL, 0 }, {"BF_Region" , (CAST)BF_Region , (CAST)BF_dRegion , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_RegionX" , (CAST)BF_RegionX , (CAST)BF_dRegionX , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_RegionY" , (CAST)BF_RegionY , (CAST)BF_dRegionY , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_RegionZ" , (CAST)BF_RegionZ , (CAST)BF_dRegionZ , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_Global" , (CAST)BF_Global , (CAST)BF_dGlobal , (CAST)BF_Zero , 0. , ALL, 0 }, {"BF_dGlobal" , (CAST)BF_dGlobal , (CAST)BF_Zero , (CAST)BF_Global, 0. , ALL, 0 }, #endif {NULL , NULL , NULL , NULL , 0. , ALL, 0 } } ; #undef POI #undef LIN #undef TRI #undef QUA #undef TET #undef HEX #undef PRI #undef PYR #undef ALL struct StringXFunction2Nbr F_Function[] = { /* #Par #Arg */ /* #Par = -1 => free number of Parameters ; = -2 free even number */ /* #Arg ... same */ #if defined(HAVE_LEGACY) // F_Math {"Exp" , (CAST)F_Exp , 0, 1 }, {"Log" , (CAST)F_Log , 0, 1 }, {"Log10" , (CAST)F_Log10 , 0, 1 }, {"Sqrt" , (CAST)F_Sqrt , 0, 1 }, {"Sin" , (CAST)F_Sin , 0, 1 }, {"Asin" , (CAST)F_Asin , 0, 1 }, {"Cos" , (CAST)F_Cos , 0, 1 }, {"Acos" , (CAST)F_Acos , 0, 1 }, {"Tan" , (CAST)F_Tan , 0, 1 }, {"Atan" , (CAST)F_Atan , 0, 1 }, {"Sinh" , (CAST)F_Sinh , 0, 1 }, {"Cosh" , (CAST)F_Cosh , 0, 1 }, {"Tanh" , (CAST)F_Tanh , 0, 1 }, {"Fabs" , (CAST)F_Fabs , 0, 1 }, {"Floor" , (CAST)F_Floor , 0, 1 }, {"Ceil" , (CAST)F_Ceil , 0, 1 }, {"Atan2" , (CAST)F_Atan2 , 0, 2 }, {"Fmod" , (CAST)F_Fmod , 0, 2 }, {"Sign" , (CAST)F_Sign , 0, 1 }, {"Jn" , (CAST)F_Jn , 0, 2 }, {"Yn" , (CAST)F_Yn , 0, 2 }, {"dJn" , (CAST)F_dJn , 0, 2 }, {"dYn" , (CAST)F_dYn , 0, 2 }, // F_ExtMath {"Hypot" , (CAST)F_Hypot , 0, 2 }, {"TanhC2" , (CAST)F_TanhC2 , 0, 1 }, {"Transpose" , (CAST)F_Transpose , 0, 1 }, {"Inv" , (CAST)F_Inv , 0, 1 }, {"Det" , (CAST)F_Det , 0, 1 }, {"TTrace" , (CAST)F_Trace , 0, 1 }, {"Rotate" , (CAST)F_RotateXYZ , 0, 4 }, {"Norm" , (CAST)F_Norm , 0, 1 }, {"SquNorm" , (CAST)F_SquNorm , 0, 1 }, {"Unit" , (CAST)F_Unit , 0, 1 }, {"ScalarUnit" , (CAST)F_ScalarUnit , 0, 1 }, {"Normalized" , (CAST)F_Unit , 0, 1 }, {"Cos_wt_p" , (CAST)F_Cos_wt_p , 2, 0 }, {"Sin_wt_p" , (CAST)F_Sin_wt_p , 2, 0 }, {"F_Cos_wt_p" , (CAST)F_Cos_wt_p , 2, 0 }, {"F_Sin_wt_p" , (CAST)F_Sin_wt_p , 2, 0 }, {"Period" , (CAST)F_Period , 1, 1 }, {"F_Period" , (CAST)F_Period , 1, 1 }, {"Interval" , (CAST)F_Interval , 3, 3 }, {"Complex" , (CAST)F_Complex , 0, -2 }, {"Complex_MH" , (CAST)F_Complex_MH , -1, -2 }, {"Re" , (CAST)F_Re , 0, 1 }, {"Im" , (CAST)F_Im , 0, 1 }, {"Conj" , (CAST)F_Conj , 0, 1 }, {"Cart2Pol" , (CAST)F_Cart2Pol , 0, 1 }, {"Vector" , (CAST)F_Vector , 0, 3 }, {"Tensor" , (CAST)F_Tensor , 0, 9 }, {"TensorV" , (CAST)F_TensorV , 0, 3 }, {"TensorSym" , (CAST)F_TensorSym , 0, 6 }, {"TensorDiag" , (CAST)F_TensorDiag , 0, 3 }, {"SquDyadicProduct" , (CAST)F_SquDyadicProduct , 0, 1 }, {"Comp" , (CAST)F_Comp , 1, 1 }, {"CompX" , (CAST)F_CompX , 0, 1 }, {"CompY" , (CAST)F_CompY , 0, 1 }, {"CompZ" , (CAST)F_CompZ , 0, 1 }, {"CompXX" , (CAST)F_CompXX , 0, 1 }, {"CompXY" , (CAST)F_CompXY , 0, 1 }, {"CompXZ" , (CAST)F_CompXZ , 0, 1 }, {"CompYX" , (CAST)F_CompYX , 0, 1 }, {"CompYY" , (CAST)F_CompYY , 0, 1 }, {"CompYZ" , (CAST)F_CompYZ , 0, 1 }, {"CompZX" , (CAST)F_CompZX , 0, 1 }, {"CompZY" , (CAST)F_CompZY , 0, 1 }, {"CompZZ" , (CAST)F_CompZZ , 0, 1 }, {"Cart2Sph" , (CAST)F_Cart2Sph , 0, 1 }, {"Cart2Cyl" , (CAST)F_Cart2Cyl , 0, 1 }, {"UnitVectorX" , (CAST)F_UnitVectorX , 0, 0 }, {"UnitVectorY" , (CAST)F_UnitVectorY , 0, 0 }, {"UnitVectorZ" , (CAST)F_UnitVectorZ , 0, 0 }, // F_Coord {"CoordX" , (CAST)F_CoordX , 0, 0 }, {"CoordY" , (CAST)F_CoordY , 0, 0 }, {"CoordZ" , (CAST)F_CoordZ , 0, 0 }, {"CoordXYZ" , (CAST)F_CoordXYZ , 0, 0 }, {"X" , (CAST)F_CoordX , 0, 0 }, {"Y" , (CAST)F_CoordY , 0, 0 }, {"Z" , (CAST)F_CoordZ , 0, 0 }, {"XYZ" , (CAST)F_CoordXYZ , 0, 0 }, {"F_aX_bY_cZ" , (CAST)F_aX_bY_cZ , 3, 0 }, {"F_aX21_bY21_cZ21" , (CAST)F_aX21_bY21_cZ21 , 3, 0 }, {"XS" , (CAST)F_CoordXS , 0, 0 }, {"YS" , (CAST)F_CoordYS , 0, 0 }, {"ZS" , (CAST)F_CoordZS , 0, 0 }, {"XYZS" , (CAST)F_CoordXYZS , 0, 0 }, // F_Geometry {"Normal" , (CAST)F_Normal , 0, 0 }, {"NormalSource" , (CAST)F_NormalSource , 0, 0 }, {"Tangent" , (CAST)F_Tangent , 0, 0 }, {"TangentSource" , (CAST)F_TangentSource , 0, 0 }, {"ElementVol" , (CAST)F_ElementVol , 0, 0 }, {"SurfaceArea" , (CAST)F_SurfaceArea , -1, 0 }, {"GetVolume" , (CAST)F_GetVolume , -1, 0 }, {"GetNumElements" , (CAST)F_GetNumElements , -1, 0 }, {"CellSize" , (CAST)F_CellSize , -1, 0 }, {"ProjectPointOnEllipse", (CAST)F_ProjectPointOnEllipse, 2, 1 }, {"SquNormEdgeValues" , (CAST)F_SquNormEdgeValues, 2, 0 }, // F_Misc {"Printf" , (CAST)F_Printf , 0, 1 }, {"Rand" , (CAST)F_Rand , 0, 1 }, {"CompElementNum" , (CAST)F_CompElementNum , 0, 0 }, {"ElementNum" , (CAST)F_ElementNum , 0, 0 }, {"QuadraturePointIndex" , (CAST)F_QuadraturePointIndex , 0, 0 }, {"CpuTime" , (CAST)F_GetCpuTime , 0, 0 }, {"GetCpuTime" , (CAST)F_GetCpuTime , 0, 0 }, {"GetWallClockTime" , (CAST)F_GetWallClockTime , 0, 0 }, {"Memory" , (CAST)F_GetMemory , 0, 0 }, {"GetMemory" , (CAST)F_GetMemory , 0, 0 }, {"SetNumber" , (CAST)F_SetNumber , -1, -1 }, {"GetNumber" , (CAST)F_GetNumber , -1, -1 }, {"VirtualWork" , (CAST)F_VirtualWork , 0, 1 }, {"Felec" , (CAST)F_Felec , 0, 1 }, {"dFxdux" , (CAST)F_dFxdux , 0, 1 }, {"dFydux" , (CAST)F_dFydux , 0, 1 }, {"dFzdux" , (CAST)F_dFzdux , 0, 1 }, {"dFxduy" , (CAST)F_dFxduy , 0, 1 }, {"dFyduy" , (CAST)F_dFyduy , 0, 1 }, {"dFzduy" , (CAST)F_dFzduy , 0, 1 }, {"dFxduz" , (CAST)F_dFxduz , 0, 1 }, {"dFyduz" , (CAST)F_dFyduz , 0, 1 }, {"dFzduz" , (CAST)F_dFzduz , 0, 1 }, {"dFxdv" , (CAST)F_dFxdv , 0, 1 }, {"dFydv" , (CAST)F_dFydv , 0, 1 }, {"dFzdv" , (CAST)F_dFzdv , 0, 1 }, {"dWedxdv" , (CAST)F_dWedxdv , 0, 1 }, {"dWedydv" , (CAST)F_dWedydv , 0, 1 }, {"dWedzdv" , (CAST)F_dWedzdv , 0, 1 }, {"NodeForceDensity" , (CAST)F_NodeForceDensity , 0, 1 }, {"AssDiag" , (CAST)F_AssDiag , -1, 0 }, // F_Interpolation {"InterpolationLinear" , (CAST)F_InterpolationLinear , -2, 1 }, {"dInterpolationLinear" , (CAST)F_dInterpolationLinear , -2, 1 }, {"dInterpolationLinear2" , (CAST)F_dInterpolationLinear2 , -2, 1 }, {"InterpolationAkima" , (CAST)F_InterpolationAkima , -2, 1 }, {"dInterpolationAkima" , (CAST)F_dInterpolationAkima , -2, 1 }, {"InterpolationBilinear" , (CAST)F_InterpolationBilinear , -1, 2 }, {"dInterpolationBilinear", (CAST)F_dInterpolationBilinear, -1, 2 }, {"ValueFromIndex" , (CAST)F_ValueFromIndex , -1, 0 }, {"VectorFromIndex" , (CAST)F_VectorFromIndex , -1, 0 }, // F_Hysteresis {"dhdb_Jiles" , (CAST)F_dhdb_Jiles , -1, 3 }, {"dbdh_Jiles" , (CAST)F_dbdh_Jiles , -1, 3 }, {"h_Jiles" , (CAST)F_h_Jiles , -1, 3 }, {"b_Jiles" , (CAST)F_b_Jiles , -1, 3 }, {"dhdb_Ducharne" , (CAST)F_dhdb_Ducharne , -1, 3 }, {"h_Ducharne" , (CAST)F_h_Ducharne , -1, 3 }, {"nu_Ducharne" , (CAST)F_nu_Ducharne , -1, 3 }, {"mu_Vinch" , (CAST)F_mu_Vinch , -1, 3 }, {"nu_Vinch" , (CAST)F_nu_Vinch , -1, 3 }, {"h_Vinch" , (CAST)F_h_Vinch , -1, 4 }, {"dhdb_Vinch" , (CAST)F_dhdb_Vinch , -1, 3 }, {"dbdh_Vinch" , (CAST)F_dbdh_Vinch , -1, 3 }, {"Update_Jk" , (CAST)F_Update_Jk , -1, 6 }, {"Update_Jk_sd" , (CAST)F_Update_Jk_sd , -1, 6 }, {"b_Vinch_K" , (CAST)F_b_Vinch_K , -1, 15 }, // 3+3*4=15 {"h_Vinch_K" , (CAST)F_h_Vinch_K , 1, 17 }, // parameter is dimension {2},{3}, 5+3*4=17 {"dbdh_Vinch_K" , (CAST)F_dbdh_Vinch_K , 1, 15 }, // parameter is dimension {2},{3}, 3+3*4=15 {"dhdb_Vinch_K" , (CAST)F_dhdb_Vinch_K , 1, 15 }, // parameter is dimension {2},{3}, 3+3*4=15 {"nu_Vinch_K" , (CAST)F_nu_Vinch_K , 1, 17 }, // parameter is dimension {2},{3}, 5+3*4=17 // F_MultiHar {"MHToTime" , (CAST)F_MHToTime , 0, 2 }, // F_Analytic {"JFIE_ZPolAnalyticOnCyl", (CAST)F_JFIE_ZPolCyl , 4, 1 }, {"RCS_ZPolAnalyticCyl", (CAST)F_RCS_ZPolCyl , 3, 1 }, {"JFIE_TransZPolAnalyticOnCyl", (CAST)F_JFIE_TransZPolCyl, 3, 1 }, {"JFIE_OnSphCutTheta", (CAST)F_JFIE_SphTheta, 4, 1 }, {"RCS_SphTheta", (CAST)F_RCS_SphTheta, 4, 1 }, {"JFIE_OnSphCutPhi", (CAST)F_JFIE_SphPhi, 4, 1 }, {"RCS_SphPhi", (CAST)F_RCS_SphPhi, 4, 1 }, {"CurrentPerfectlyConductingSphere",(CAST)F_CurrentPerfectlyConductingSphere, 3, 1 }, {"ElectricFieldPerfectlyConductingSphereMwt", (CAST)F_ElectricFieldPerfectlyConductingSphereMwt, 2, 1 }, {"ElectricFieldDielectricSphereMwt", (CAST)F_ElectricFieldDielectricSphereMwt, 2, 1 }, {"ExactOsrcSolutionPerfectlyConductingSphereMwt", (CAST)F_ExactOsrcSolutionPerfectlyConductingSphereMwt, 3, 1 }, {"CurrentPerfectlyConductingSphereMwt",(CAST)F_CurrentPerfectlyConductingSphereMwt, 3, 1 }, {"AcousticFieldSoftSphere", (CAST)F_AcousticFieldSoftSphere, 2, 1 }, {"DrAcousticFieldSoftSphere", (CAST)F_DrAcousticFieldSoftSphere, 2, 1 }, {"RCSSoftSphere", (CAST)F_RCSSoftSphere, 2, 1 }, {"AcousticFieldHardSphere", (CAST)F_AcousticFieldHardSphere, 2, 1 }, {"RCSHardSphere", (CAST)F_RCSHardSphere, 2, 1 }, {"AcousticFieldSoftCylinder", (CAST)F_AcousticFieldSoftCylinder, 2, 1 }, {"AcousticFieldSoftCylinderABC", (CAST)F_AcousticFieldSoftCylinderABC, 5, 1 }, {"DrAcousticFieldSoftCylinder", (CAST)F_DrAcousticFieldSoftCylinder, 2, 1 }, {"RCSSoftCylinder", (CAST)F_RCSSoftCylinder, 2, 1 }, {"AcousticFieldHardCylinder", (CAST)F_AcousticFieldHardCylinder, 2, 1 }, {"AcousticFieldHardCylinderABC", (CAST)F_AcousticFieldHardCylinderABC, 5, 1 }, {"DthetaAcousticFieldHardCylinder", (CAST)F_DthetaAcousticFieldHardCylinder, 2, 1 }, {"RCSHardCylinder", (CAST)F_RCSHardCylinder, 2, 1 }, {"OSRC_C0", (CAST)F_OSRC_C0, 2, 0}, {"OSRC_R0", (CAST)F_OSRC_R0, 2, 0}, {"OSRC_Aj", (CAST)F_OSRC_Aj, 3, 0}, {"OSRC_Bj", (CAST)F_OSRC_Bj, 3, 0}, // F_Raytracing: ray tracing functions {"CylinderPhase", (CAST)F_CylinderPhase, 0, 1 }, {"DiamondPhase", (CAST)F_DiamondPhase, 0, 1 }, // F_BiotSavart {"BiotSavart", (CAST)F_BiotSavart , 1, 0 }, {"Pocklington", (CAST)F_Pocklington , 2, 0 }, // F_Gmsh {"Field", (CAST)F_Field , -1, -1 }, {"ScalarField", (CAST)F_ScalarField , -1, -1 }, {"VectorField", (CAST)F_VectorField , -1, -1 }, {"TensorField", (CAST)F_TensorField , -1, -1 }, {"ComplexScalarField", (CAST)F_ComplexScalarField, -1, -1 }, {"ComplexVectorField", (CAST)F_ComplexVectorField, -1, -1 }, {"ComplexTensorField", (CAST)F_ComplexTensorField, -1, -1 }, {"GradScalarField", (CAST)F_GradScalarField , -1, -1 }, {"GradVectorField", (CAST)F_GradVectorField , -1, -1 }, {"GradComplexScalarField", (CAST)F_GradComplexScalarField, -1, -1 }, {"GradComplexVectorField", (CAST)F_GradComplexVectorField, -1, -1 }, // F_DiffGeom {"Hodge", (CAST)F_Hodge , 1, 2 }, {"Sharp", (CAST)F_Sharp , 1, 2 }, {"Flat", (CAST)F_Flat , 1, 2 }, {"InnerProduct", (CAST)F_InnerProduct , 1, 3 }, {"WedgeProduct", (CAST)F_WedgeProduct , 2, 2 }, {"InteriorProduct", (CAST)F_InteriorProduct , 1, 2 }, {"TensorProduct", (CAST)F_TensorProduct , 0, 2 }, {"PullBack", (CAST)F_PullBack , 1, 2 }, {"PullBackMetric", (CAST)F_PullBackMetric , 0, 2 }, {"PushForward", (CAST)F_PushForward , 1, 2 }, {"InvPullBack", (CAST)F_InvPullBack , 1, 2 }, {"InvPushForward", (CAST)F_InvPushForward , 1, 2 }, // F_Octave {"Octave", (CAST)F_Octave , -1, -1 }, // F_Python {"Python", (CAST)F_Python , -1, -1 }, // GF_XXX : Green Functions {"Laplace" , (CAST)GF_Laplace , 1, 0 }, {"GradLaplace" , (CAST)GF_GradLaplace , 1, 0 }, {"NPxGradLaplace" , (CAST)GF_NPxGradLaplace , 1, 0 }, {"NSxGradLaplace" , (CAST)GF_NSxGradLaplace , 1, 0 }, {"ApproximateLaplace", (CAST)GF_ApproximateLaplace, 2, 0 }, {"Helmholtz" , (CAST)GF_Helmholtz , 2, 0 }, {"HelmholtzThinWire" , (CAST)GF_HelmholtzThinWire, 3, 0 }, {"GradHelmholtz" , (CAST)GF_GradHelmholtz , 2, 0 }, {"NPxGradHelmholtz" , (CAST)GF_NPxGradHelmholtz , 2, 0 }, {"NSxGradHelmholtz" , (CAST)GF_NSxGradHelmholtz , 2, 0 }, #endif {NULL , NULL , 0, 0 } } ; struct FunctionXFunction GF_Function[] = { #if defined(HAVE_LEGACY) {(CAST)GF_Laplace , (CAST)GF_LaplacexForm } , {(CAST)GF_GradLaplace , (CAST)GF_GradLaplacexForm } , {(CAST)GF_NPxGradLaplace , (CAST)GF_NPxGradLaplacexForm } , {(CAST)GF_NSxGradLaplace , (CAST)GF_NSxGradLaplacexForm } , {(CAST)GF_ApproximateLaplace , (CAST)GF_ApproximateLaplacexForm } , {(CAST)GF_Helmholtz , (CAST)GF_HelmholtzxForm } , #endif {NULL , NULL } } ; #undef CAST #endif getdp-2.7.0-source/Interface/ProParser.y000644 001750 001750 00001036356 12611677027 021637 0ustar00geuzainegeuzaine000000 000000 %{ // GetDP - Copyright (C) 1997-2015 P. Dular, C. Geuzaine // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Ruth Sabariego // Johan Gyselinck // #include #include #include #include #include #include #include #include #include "GetDPConfig.h" #include "GetDPVersion.h" #include "ProData.h" #include "ProDefine.h" #include "ProDefines.h" #include "ProParser.h" #include "MacroManager.h" #include "MallocUtils.h" #include "TreeUtils.h" #include "Message.h" #include "OS.h" // Global problem structure filled by the parser extern struct Problem Problem_S; // Global parser variables std::string getdp_yyname; char getdp_yyincludename[256] = ""; long int getdp_yylinenum = 0; int getdp_yycolnum = 0; int getdp_yyincludenum = 0; int getdp_yyerrorlevel = 0; std::map > CommandLineNumbers; std::map CommandLineStrings; // Static parser variables (accessible only in this file) static Tree_T *ConstantTable_L = 0; static List_T *ListOfInt_L = 0; static List_T *ListOfPointer_L = 0, *ListOfPointer2_L = 0, *ListOfChar_L = 0; static List_T *ListOfFormulation = 0, *ListOfBasisFunction = 0, *ListOfEntityIndex = 0; static List_T *Operation_L = 0; static List_T *Current_BasisFunction_L = 0, *Current_SubSpace_L = 0; static List_T *Current_GlobalQuantity_L = 0, *Current_WholeQuantity_L = 0; static List_T *Current_System_L = 0; static int Num_BasisFunction = 1; static int FlagError = 0; static int Type_TermOperator = 0, Type_Function = 0, Type_SuppList = 0; static int Quantity_TypeOperator = 0, Quantity_Index = 0; static int Current_DofIndexInWholeQuantity = 0, Last_DofIndexInWholeQuantity = 0; static int Current_NoDofIndexInWholeQuantity = 0; static int Current_System = 0, Constraint_Index = 0; static int TypeOperatorDofInTrace = 0, DefineQuantityIndexDofInTrace = 0; static int ImbricatedLoop = 0, ImbricatedTest = 0; static char *StringForParameter = 0; #define MAX_RECUR_TESTS 100 static int statusImbricatedTests[MAX_RECUR_TESTS]; #define MAX_RECUR_LOOPS 100 static fpos_t FposImbricatedLoopsTab[MAX_RECUR_LOOPS]; static int LinenoImbricatedLoopsTab[MAX_RECUR_LOOPS]; static double LoopControlVariablesTab[MAX_RECUR_LOOPS][3]; static char *LoopControlVariablesNameTab[MAX_RECUR_LOOPS]; static struct Constant Constant_S, Constant1_S, Constant2_S; static struct Expression Expression_S, *Expression_P; static struct ExpressionPerRegion ExpressionPerRegion_S; static struct Group Group_S; static struct Constraint Constraint_S, *Constraint_P; static struct ConstraintPerRegion ConstraintPerRegion_S, *ConstraintPerRegion_P; static struct MultiConstraintPerRegion MultiConstraintPerRegion_S; static struct JacobianMethod JacobianMethod_S; static struct JacobianCase JacobianCase_S; static struct IntegrationMethod IntegrationMethod_S; static struct IntegrationCase IntegrationCase_S; static struct Quadrature QuadratureCase_S; static struct FunctionSpace FunctionSpace_S; static struct BasisFunction BasisFunction_S; static struct GlobalBasisFunction GlobalBasisFunction_S; static struct SubSpace SubSpace_S; static struct GlobalQuantity GlobalQuantity_S; static struct ConstraintInFS ConstraintInFS_S; static struct Formulation Formulation_S; static struct DefineQuantity DefineQuantity_S; static struct EquationTerm EquationTerm_S; static struct WholeQuantity WholeQuantity_S, *WholeQuantity_P; static struct GlobalEquationTerm GlobalEquationTerm_S; static struct Resolution Resolution_S; static struct DefineSystem DefineSystem_S; static struct Operation Operation_S, *Operation_P; static struct ChangeOfState ChangeOfState_S; static struct TimeLoopAdaptiveSystem TimeLoopAdaptiveSystem_S; static struct LoopErrorPostOperation TimeLoopAdaptivePO_S, IterativeLoopPO_S; static struct IterativeLoopSystem IterativeLoopSystem_S; static struct PostProcessing PostProcessing_S, InteractivePostProcessing_S; static struct PostQuantity PostQuantity_S; static struct PostQuantityTerm PostQuantityTerm_S; static struct PostOperation PostOperation_S; static struct PostSubOperation PostSubOperation_S; static std::map > FloatOptions_S; static std::map > CharOptions_S; // External lexer functions void hack_fsetpos(); void hack_fsetpos_printf(); int getdp_yylex(); // Forward function declarations void Alloc_ParserVariables(); void Check_NameOfStructNotExist(const char *Struct, List_T *List_L, void *data, int (*fcmp)(const void *a, const void *b)); int Add_Group(struct Group *Group_P, char *Name, bool Flag_Add, int Flag_Plus, int Num_Index); int Num_Group(struct Group *Group_P, char *Name, int Num_Group); void Fill_GroupInitialListFromString(List_T *list, const char *str); int Add_Expression(struct Expression *Expression_P, char *Name, int Flag_Plus); bool Is_ExpressionPieceWiseDefined(int index); void Pro_DefineQuantityIndex(List_T *WholeQuantity_L,int DefineQuantityIndexEqu, int *NbrQuantityIndex, int **QuantityIndexTable, int **QuantityTraceGroupIndexTable); void Pro_DefineQuantityIndex_1(List_T *WholeQuantity_L, int TraceGroupIndex); void yyerror(const char *s); void vyyerror(const char *fmt, ...); struct doubleXstring{ double d; char *s; }; %} /* ------------------------------------------------------------------ */ %union { char *c; int i; double d; List_T *l; struct TwoInt t; } %token tINT %token tFLOAT %token tSTRING tBIGSTR %type GroupRHS ReducedGroupRHS %type FunctionForGroup SuppListTypeForGroup %type Expression Printf %type ArgumentsForFunction RecursiveListOfQuantity %type PostQuantitySupport %type IRegion RecursiveListOfRegion Enumeration %type StrCmp NbrRegions CommaFExprOrNothing %type GmshOperation GenerateGroupOperation %type FExpr OneFExpr %type MultiFExpr ListOfFExpr RecursiveListOfFExpr %type RecursiveListOfCharExpr ParametersForFunction %type ListOfRegion ListOfRegionOrAll SuppListOfRegion %type ConstraintCases IntegrationCases QuadratureCases JacobianCases %type BasisFunctions SubSpaces GlobalQuantities ConstraintInFSs %type ListOfBasisFunction RecursiveListOfBasisFunction %type ListOfBasisFunctionCoef RecursiveListOfBasisFunctionCoef %type Equations WholeQuantityExpression %type DefineSystems Operation ChangeOfStates %type ListOfFormulation RecursiveListOfFormulation %type ListOfSystem RecursiveListOfSystem %type PostQuantities SubPostQuantities PostSubOperations %type NameForMathFunction NameForFunction CharExpr CharExprNoVar %type StrCat StringIndex String__Index CallArg %type LP RP %type Quantity_Def %type TimeLoopAdaptiveSystems TimeLoopAdaptivePOs IterativeLoopSystems %type IterativeLoopPOs /* ------------------------------------------------------------------ */ %token tEND tDOTS %token tStrCat tSprintf tPrintf tMPI_Printf tRead tPrintConstants tStrCmp %token tStrChoice tUpperCase tLowerCase tLowerCaseIn %token tNbrRegions tGetRegion tNameFromString tStringFromName %token tFor tEndFor tIf tElseIf tElse tEndIf tMacro tReturn tCall tCallTest %token tTest tWhile %token tFlag %token tInclude %token tConstant tList tListAlt tLinSpace tLogSpace tListFromFile %token tChangeCurrentPosition %token tDefineConstant tUndefineConstant tDefineNumber tDefineString %token tPi tMPI_Rank tMPI_Size t0D t1D t2D t3D tTestLevel %token tTotalMemory tCurrentDirectory %token tGETDP_MAJOR_VERSION tGETDP_MINOR_VERSION tGETDP_PATCH_VERSION %token tExp tLog tLog10 tSqrt tSin tAsin tCos tAcos tTan %token tAtan tAtan2 tSinh tCosh tTanh tFabs tFloor tCeil tRound tSign %token tFmod tModulo tHypot tRand %token tSolidAngle tTrace tOrder tCrossProduct tDofValue %token tMHTransform tMHJacNL %token tGroup tDefineGroup tAll tInSupport tMovingBand2D %token tDefineFunction %token tConstraint %token tRegion tSubRegion tRegionRef tSubRegionRef %token tFilter tToleranceFactor tCoefficient tValue tTimeFunction %token tBranch tNameOfResolution %token tJacobian %token tCase %token tMetricTensor %token tIntegration %token tType tSubType tCriterion tGeoElement %token tNumberOfPoints tMaxNumberOfPoints %token tNumberOfDivisions tMaxNumberOfDivisions %token tStoppingCriterion %token tFunctionSpace %token tName %token tBasisFunction %token tNameOfCoef tFunction tdFunction tSubFunction tSubdFunction tSupport tEntity %token tSubSpace tNameOfBasisFunction %token tGlobalQuantity %token tEntityType tEntitySubType tNameOfConstraint %token tFormulation %token tQuantity %token tNameOfSpace tIndexOfSystem %token tSymmetry %token tGalerkin tdeRham tGlobalTerm tGlobalEquation %token tDt tDtDof tDtDt tDtDtDof tDtDtDtDof tDtDtDtDtDof tDtDtDtDtDtDof %token tJacNL tDtDofJacNL tNeverDt tDtNL %token tAtAnteriorTimeStep tMaxOverTime tFourierSteinmetz %token tIn %token tFull_Matrix %token tResolution tHidden %token tDefineSystem %token tNameOfFormulation tNameOfMesh tFrequency tSolver %token tOriginSystem tDestinationSystem %token tOperation tOperationEnd %token tSetTime tSetTimeStep tDTime tSetFrequency tFourierTransform tFourierTransformJ %token tLanczos tEigenSolve tEigenSolveJac tPerturbation %token tUpdate tUpdateConstraint tBreak tGetResidual tCreateSolution %token tEvaluate tSelectCorrection tAddCorrection tMultiplySolution %token tAddOppositeFullSolution tSolveAgainWithOther tSetGlobalSolverOptions %token tTimeLoopTheta tTimeLoopNewmark tTimeLoopRungeKutta tTimeLoopAdaptive %token tTime0 tTimeMax tTheta %token tBeta tGamma %token tIterativeLoop tIterativeLoopN tIterativeLinearSolver %token tNbrMaxIteration tRelaxationFactor %token tIterativeTimeReduction %token tSetCommSelf tSetCommWorld tBarrier tBroadcastFields tSleep %token tDivisionCoefficient tChangeOfState %token tChangeOfCoordinates tChangeOfCoordinates2 tSystemCommand tError %token tGmshRead tGmshMerge tGmshOpen tGmshWrite tGmshClearAll %token tDelete tDeleteFile tRenameFile tCreateDir %token tGenerateOnly tGenerateOnlyJac %token tSolveJac_AdaptRelax %token tSaveSolutionExtendedMH tSaveSolutionMHtoTime tSaveSolutionWithEntityNum %token tInitMovingBand2D tMeshMovingBand2D %token tGenerateMHMoving tGenerateMHMovingSeparate tAddMHMoving %token tGenerateGroup tGenerateJacGroup tGenerateRHSGroup %token tGenerateGroupCumulative tGenerateJacGroupCumulative tGenerateRHSGroupCumulative %token tSaveMesh %token tDeformMesh %token tFrequencySpectrum %token tPostProcessing %token tNameOfSystem %token tPostOperation %token tNameOfPostProcessing tUsingPost tAppend tResampleTime %token tPlot tPrint tPrintGroup tEcho tSendMergeFileRequest tWrite tAdapt %token tOnGlobal tOnRegion tOnElementsOf %token tOnGrid tOnSection tOnPoint tOnLine tOnPlane tOnBox %token tWithArgument %token tFile tDepth tDimension tComma tTimeStep tHarmonicToTime %token tCosineTransform %token tValueIndex tValueName %token tFormat tHeader tFooter tSkin tSmoothing %token tTarget tSort tIso tNoNewLine tNoTitle tDecomposeInSimplex tChangeOfValues %token tTimeLegend tFrequencyLegend tEigenvalueLegend %token tEvaluationPoints tStoreInRegister tStoreInVariable %token tStoreInField tStoreInMeshBasedField %token tStoreMaxInRegister tStoreMaxXinRegister tStoreMaxYinRegister %token tStoreMaxZinRegister tStoreMinInRegister tStoreMinXinRegister %token tStoreMinYinRegister tStoreMinZinRegister %token tLastTimeStepOnly tAppendTimeStepToFileName tTimeValue tTimeImagValue %token tAppendExpressionToFileName tAppendExpressionFormat %token tOverrideTimeStepValue tNoMesh tSendToServer tColor tStr %token tDate tOnelabAction tFixRelativePath %token tNewCoordinates tAppendToExistingFile tAppendStringToFileName /* ------------------------------------------------------------------ */ /* Operators (with ascending priority): cf. C language */ /* */ /* Notes: - associativity (%left, %right) */ /* - UNARYPREC is a dummy terminal to resolve ambiguous cases */ /* for + and - (which exist in both unary and binary form) */ /* ------------------------------------------------------------------ */ %right tDEF %right '?' tDOTS %left tOR %left tAND %left tEQUAL tNOTEQUAL tAPPROXEQUAL %left '<' tLESSOREQUAL '>' tGREATEROREQUAL tLESSLESS tGREATERGREATER %left '+' '-' %left '*' '/' '%' tCROSSPRODUCT %left '|' '&' %right '!' UNARYPREC %right '^' %left '(' ')' '[' ']' '.' %left '#' '$' tSHOW /* ------------------------------------------------------------------ */ %start Stats %% Stats : { Alloc_ParserVariables(); } ProblemDefinitions ; /* ------------------------------------------------------------------------ */ /* P r o b l e m */ /* ------------------------------------------------------------------------ */ ProblemDefinitions : /* none */ | ProblemDefinitions { Formulation_S.DefineQuantity = NULL; } ProblemDefinition ; ProblemDefinition : tGroup '{' Groups '}' | tFunction '{' Functions '}' | tConstraint '{' Constraints '}' | tJacobian '{' JacobianMethods '}' | tIntegration '{' IntegrationMethods '}' | tFunctionSpace '{' FunctionSpaces '}' | tFormulation '{' Formulations '}' | tResolution '{' Resolutions '}' | tPostProcessing '{' PostProcessings '}' | tPostOperation '{' PostOperations '}' | SeparatePostOperation | Loop // contains For, EndFor, If, EndIf, Affectation | tInclude CharExpr { strcpy(getdp_yyincludename, $2); getdp_yyincludenum++; return(0); } ; /* ------------------------------------------------------------------------ */ /* G r o u p */ /* ------------------------------------------------------------------------ */ Groups : /* none */ | Groups Group ; Group : String__Index tDEF ReducedGroupRHS tEND { Add_Group(&Group_S, $1, false, 0, 0); } | String__Index '+' tDEF ReducedGroupRHS tEND { Add_Group(&Group_S, $1, true, 0, 0); } | String__Index tDEF tMovingBand2D '[' IRegion { int j = 0; if(List_Nbr($5) == 1) List_Read($5, 0, &j); else vyyerror("Single region number expected for moving band definition"); Group_S.InitialList = List_Create(1, 1, sizeof(int)); List_Add(Group_S.InitialList, &j); Group_S.Type = MOVINGBAND2D; Group_S.FunctionType = REGION; Group_S.InitialSuppList = NULL; Group_S.SuppListType = SUPPLIST_NONE; Group_S.MovingBand2D = (struct MovingBand2D *)Malloc(sizeof(struct MovingBand2D)); Group_S.MovingBand2D->PhysNum = j; } ',' ListOfRegion { Group_S.MovingBand2D->InitialList1 = $8; Group_S.MovingBand2D->ExtendedList1 = NULL; } ',' ListOfRegion ',' FExpr ']' tEND { Group_S.MovingBand2D->InitialList2 = $11; Group_S.MovingBand2D->Period2 = (int)$13; Add_Group(&Group_S, $1, false, 0, 0); } | tDefineGroup '[' DefineGroups ']' tEND | Loop ; ReducedGroupRHS : FunctionForGroup '[' ListOfRegionOrAll { Group_S.FunctionType = $1; switch (Group_S.FunctionType) { case ELEMENTSOF : Group_S.Type = ELEMENTLIST; break; default : Group_S.Type = REGIONLIST; break; } Group_S.InitialList = $3; } SuppListOfRegion ']' { Group_S.SuppListType = Type_SuppList; Group_S.InitialSuppList = $5; $$ = -1; } /* shortcut: #list == Region[ list ] */ | '#' ListOfRegion { Group_S.FunctionType = REGION; Group_S.Type = REGIONLIST; Group_S.InitialList = $2; Group_S.SuppListType = SUPPLIST_NONE; Group_S.InitialSuppList = NULL; $$ = -1; } ; GroupRHS : ReducedGroupRHS { $$ = $1; } | String__Index { int i; if(!strcmp($1, "All")) { $$ = -3; } else if((i = List_ISearchSeq(Problem_S.Group, $1, fcmp_Group_Name)) >= 0) { List_Read(Problem_S.Group, i, &Group_S); $$ = i; } else { $$ = -2; vyyerror("Unknown Group: %s", $1); } Free($1); } ; FunctionForGroup : tRegion { $$ = REGION; } | tSTRING { $$ = Get_DefineForString(FunctionForGroup_Type, $1, &FlagError); if(FlagError){ Get_Valid_SXD($1, FunctionForGroup_Type); vyyerror("Unknown type of Function for Group: %s", $1); } Free($1); } ; ListOfRegionOrAll : ListOfRegion { $$ = $1; } | tAll { $$ = NULL; } ; SuppListOfRegion : /* none */ { Type_SuppList = SUPPLIST_NONE; $$ = NULL; } | Comma SuppListTypeForGroup ListOfRegion { Type_SuppList = $2; $$ = $3; } | Comma tInSupport String__Index { int i; Type_SuppList = SUPPLIST_INSUPPORT; if((i = List_ISearchSeq(Problem_S.Group, $3, fcmp_Group_Name)) >= 0) { if(((struct Group *)List_Pointer(Problem_S.Group, i))->Type == ELEMENTLIST) { $$ = List_Create(1, 5, sizeof(int)); List_Add($$, &i); } else vyyerror("Not a Support of Element Type: %s", $3); } else vyyerror("Unknown Region for Support: %s", $3); Free($3); } ; SuppListTypeForGroup : tSTRING { $$ = Get_DefineForString(FunctionForGroup_SuppList, $1, &FlagError); if(FlagError){ Get_Valid_SXD($1, FunctionForGroup_SuppList); vyyerror("Unknown type of Supplementary Region: %s", $1); } Free($1); } ; ListOfRegion : IRegion { $$ = List_Create(((List_Nbr($1) > 0)? List_Nbr($1) : 1), 5, sizeof(int)); for(int i = 0; i < List_Nbr($1); i++) List_Add($$, (int *)List_Pointer($1, i)); } | '{' RecursiveListOfRegion '}' { $$ = $2; } ; RecursiveListOfRegion : // none { $$ = List_Create(5, 5, sizeof(int)); } | RecursiveListOfRegion Comma IRegion { $$ = $1; for(int i = 0; i < List_Nbr($3); i++) List_Add($$, (int *)List_Pointer($3, i)); } | RecursiveListOfRegion Comma '-' IRegion { $$ = $1; for(int i = 0; i < List_Nbr($4); i++) List_Suppress($$, (int *)List_Pointer($4, i), fcmp_Integer); } ; IRegion : tINT { List_Reset(ListOfInt_L); List_Add($$ = ListOfInt_L, &($1)); } | tINT tDOTS tINT { List_Reset($$ = ListOfInt_L); for(int j = $1; ($1 < $3) ? (j <= $3) : (j >= $3); ($1 < $3) ? (j += 1) : (j -= 1)) List_Add(ListOfInt_L, &j); } | tINT tDOTS tINT tDOTS tINT { List_Reset($$ = ListOfInt_L); if(!$5 || ($1 < $3 && $5 < 0) || ($1 > $3 && $5 > 0)){ vyyerror("Wrong increment in '%d : %d : %d'", $1, $3, $5); List_Add(ListOfInt_L, &($1)); } else for(int j = $1; ($5 > 0) ? (j <= $3) : (j >= $3); j += $5) List_Add($$, &j); } | String__Index { int i; if((i = List_ISearchSeq(Problem_S.Group, $1, fcmp_Group_Name)) < 0) { // Si ce n'est pas un nom de groupe, est-ce un nom de constante ? : Constant_S.Name = $1; if(!Tree_Query(ConstantTable_L, &Constant_S)) { vyyerror("Unknown Constant: %s", $1); i = 0; List_Reset(ListOfInt_L); List_Add($$ = ListOfInt_L, &i); } else if(Constant_S.Type == VAR_FLOAT) { i = (int)Constant_S.Value.Float; List_Reset(ListOfInt_L); List_Add($$ = ListOfInt_L, &i); } else if(Constant_S.Type == VAR_LISTOFFLOAT) { List_Reset($$ = ListOfInt_L); for(int i = 0; i < List_Nbr(Constant_S.Value.ListOfFloat); i++) { double d; List_Read(Constant_S.Value.ListOfFloat, i, &d); int j = (int)d; List_Add(ListOfInt_L, &j); } } else { vyyerror("Unknown type of Constant: %s", $1); i = 0; List_Reset(ListOfInt_L); List_Add($$ = ListOfInt_L, &i); } } else // Si c'est un nom de groupe : $$ = ((struct Group *)List_Pointer(Problem_S.Group, i))->InitialList; Free($1); } // (.) used to access all the FExpr syntax | '(' FExpr ')' { int i = (int)$2; List_Reset(ListOfInt_L); List_Add($$ = ListOfInt_L, &i); } // (.) used to access all the FExpr syntax | '(' MultiFExpr ')' { List_Reset(ListOfInt_L); for(int i = 0; i < List_Nbr($2); i++) { double d; List_Read($2, i, &d); int j = (int)d; List_Add(ListOfInt_L, &j); } $$ = ListOfInt_L; } // deprecated: for backward compatibility only (for Ruth :-) | '@' MultiFExpr '@' { List_Reset(ListOfInt_L); for(int i = 0; i < List_Nbr($2); i++) { double d; List_Read($2, i, &d); int j = (int)d; List_Add(ListOfInt_L, &j); } $$ = ListOfInt_L; } ; ListOfStringsForCharOptions : /* none */ | tSTRING { CharOptions_S["Strings"].push_back($1); Free($1); } | tINT { char tmp[128]; sprintf(tmp, "%d", $1); CharOptions_S["Strings"].push_back(tmp); } | ListOfStringsForCharOptions ',' tSTRING { CharOptions_S["Strings"].push_back($3); Free($3); } | ListOfStringsForCharOptions ',' tINT { char tmp[128]; sprintf(tmp, "%d", $3); CharOptions_S["Strings"].push_back(tmp); } ; DefineGroups : /* none */ | DefineGroups Comma String__Index { int i; if ( (i = List_ISearchSeq(Problem_S.Group, $3, fcmp_Group_Name)) < 0 ) { Group_S.Type = REGIONLIST ; Group_S.FunctionType = REGION ; Group_S.InitialList = List_Create( 5, 5, sizeof(int)) ; Group_S.SuppListType = SUPPLIST_NONE ; Group_S.InitialSuppList = NULL ; i = Add_Group(&Group_S, $3, false, 0, 0) ; } else Free($3) ; } | DefineGroups Comma String__Index tDEF '{' { FloatOptions_S.clear(); CharOptions_S.clear(); } '{' ListOfStringsForCharOptions '}' CharParameterOptions '}' { int i; if ( (i = List_ISearchSeq(Problem_S.Group, $3, fcmp_Group_Name)) < 0 ) { Group_S.Name = $3; // will be overwritten in Add_Group Group_S.Type = REGIONLIST ; Group_S.FunctionType = REGION ; Group_S.InitialList = List_Create( 5, 5, sizeof(int)) ; if(CharOptions_S.count("Strings")){ std::vector vec(CharOptions_S["Strings"]); for(unsigned int i = 0; i < vec.size(); i++) Fill_GroupInitialListFromString(Group_S.InitialList, vec[i].c_str()); } Message::ExchangeOnelabParameter(&Group_S, FloatOptions_S, CharOptions_S); Group_S.SuppListType = SUPPLIST_NONE ; Group_S.InitialSuppList = NULL ; i = Add_Group(&Group_S, $3, false, 0, 0) ; } else Free($3) ; } | DefineGroups Comma String__Index '{' FExpr '}' { for (int k = 0 ; k < (int)$5 ; k++) { char tmpstr[256]; sprintf(tmpstr, "%s_%d", $3, k+1) ; int i; if ( (i = List_ISearchSeq(Problem_S.Group, tmpstr, fcmp_Group_Name)) < 0 ) { Group_S.Type = REGIONLIST ; Group_S.FunctionType = REGION ; Group_S.SuppListType = SUPPLIST_NONE ; Group_S.InitialSuppList = NULL ; Group_S.InitialList = List_Create( 5, 5, sizeof(int)) ; Add_Group(&Group_S, $3, false, 2, k+1) ; } } Free($3) ; } ; Comma : /* none */ | ',' ; /* ------------------------------------------------------------------------ */ /* F u n c t i o n */ /* ------------------------------------------------------------------------ */ Functions : /* none */ | Functions Function ; Function : tDefineFunction '[' DefineFunctions ']' tEND | String__Index '[' ']' tDEF Expression tEND { int i; if((i = List_ISearchSeq (Problem_S.Expression, $1, fcmp_Expression_Name)) >= 0) { if(((struct Expression *)List_Pointer(Problem_S.Expression, i))->Type == UNDEFINED_EXP) { Free(((struct Expression *)List_Pointer(Problem_S.Expression, i))->Name); List_Read (Problem_S.Expression, $5, &Expression_S); List_Write(Problem_S.Expression, i, &Expression_S); ((struct Expression *)List_Pointer(Problem_S.Expression, i))->Name = $1; List_Pop(Problem_S.Expression); } else { vyyerror("Redefinition of Function: %s", $1); } } else { /* new identifier */ Free(((struct Expression *)List_Pointer(Problem_S.Expression, $5))->Name); ((struct Expression *)List_Pointer(Problem_S.Expression, $5))->Name = $1; } } | String__Index '[' GroupRHS ']' tDEF Expression tEND { int i; if((i = List_ISearchSeq (Problem_S.Expression, $1, fcmp_Expression_Name)) < 0) { /* Si le nom n'existe pas : */ i = List_Nbr(Problem_S.Expression); Expression_S.Type = PIECEWISEFUNCTION; Expression_S.Case.PieceWiseFunction.ExpressionPerRegion = List_Create(5, 5, sizeof(struct ExpressionPerRegion)); Expression_S.Case.PieceWiseFunction.NumLastRegion = -1; Add_Expression(&Expression_S, $1, 0); Expression_P = (struct Expression*)List_Pointer(Problem_S.Expression, i); } else { Expression_P = (struct Expression*)List_Pointer(Problem_S.Expression, i); if(Expression_P->Type == UNDEFINED_EXP) { Expression_P->Type = PIECEWISEFUNCTION; Expression_P->Case.PieceWiseFunction.ExpressionPerRegion = List_Create(5, 5, sizeof(struct ExpressionPerRegion)); Expression_P->Case.PieceWiseFunction.NumLastRegion = -1; } else if(Expression_P->Type != PIECEWISEFUNCTION) vyyerror("Not piece-wise Expression: %s", $1); Free($1); } if($3 >= 0 || $3 == -1) { ExpressionPerRegion_S.ExpressionIndex = $6; for(int i = 0; i < List_Nbr(Group_S.InitialList); i++) { List_Read(Group_S.InitialList, i, &ExpressionPerRegion_S.RegionIndex); if(List_Search(Expression_P->Case.PieceWiseFunction.ExpressionPerRegion, &ExpressionPerRegion_S.RegionIndex, fcmp_Integer)) vyyerror("Redefinition of piece-wise Function: %s [%d]", Expression_P->Name, ExpressionPerRegion_S.RegionIndex); else List_Add(Expression_P->Case.PieceWiseFunction.ExpressionPerRegion, &ExpressionPerRegion_S); } if($3 == -1) { List_Delete(Group_S.InitialList); } } else vyyerror("Bad Group right hand side"); } | Loop ; DefineFunctions : /* none */ | DefineFunctions Comma String__Index { int i; if ( (i = List_ISearchSeq (Problem_S.Expression, $3, fcmp_Expression_Name)) < 0 ) { Expression_S.Type = UNDEFINED_EXP ; Add_Expression(&Expression_S, $3, 0) ; } else Free($3) ; } | DefineFunctions Comma String__Index '{' FExpr '}' { for (int k = 0 ; k < (int)$5 ; k++) { char tmpstr[256]; sprintf(tmpstr, "%s_%d", $3, k+1) ; int i; if ( (i = List_ISearchSeq(Problem_S.Expression, tmpstr, fcmp_Expression_Name)) < 0 ) { Expression_S.Type = UNDEFINED_EXP ; Add_Expression(&Expression_S, tmpstr, 2) ; } } Free($3) ; } ; /* ------------------------------------------------------------------------ E x p r e s s i o n s ------------------------------------------------------------------------ */ Expression : /* expressions constantes: evaluees lors de l'analyse syntaxique */ tConstant '[' FExpr ']' { Expression_S.Type = CONSTANT; Expression_S.Case.Constant = $3; $$ = Add_Expression(&Expression_S, (char*)"Exp_Cst", 1); } /* reutilisation de fonctions deja definies en amont */ | tFunction '[' tSTRING ']' { int i; if((i = List_ISearchSeq(Problem_S.Expression, $3, fcmp_Expression_Name)) < 0) vyyerror("Unknown name of Expression: %s", $3); Free($3); $$ = i; } /* whole quantity */ | { Current_DofIndexInWholeQuantity = -2; List_Reset(ListOfPointer_L); List_Reset(ListOfPointer2_L); } WholeQuantityExpression { Expression_S.Type = WHOLEQUANTITY; Expression_S.Case.WholeQuantity = $2; $$ = Add_Expression(&Expression_S, (char*)"Exp_Fct", 1); } /* undefined expression (same as DefineFunction, but inline) */ | '*' '*' '*' { Expression_S.Type = UNDEFINED_EXP; $$ = Add_Expression(&Expression_S, (char*)"Exp_Undefined", 1); } ; ListOfExpression : /* none */ { List_Reset(ListOfInt_L); } /* shift/reduce | Expression { List_Reset(ListOfInt_L); List_Add(ListOfInt_L, &($1)); } */ | '{' RecursiveListOfExpression '}' ; RecursiveListOfExpression : Expression { List_Reset(ListOfInt_L); List_Add(ListOfInt_L, &($1)); } | RecursiveListOfExpression ',' Expression { List_Add(ListOfInt_L, &($3)); } ; WholeQuantityExpression : { Current_WholeQuantity_L = List_Create(5, 5, sizeof(struct WholeQuantity)); List_Add(ListOfPointer_L, &Current_WholeQuantity_L); } WholeQuantity { $$ = *((List_T **)List_Pointer(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1)); List_Pop(ListOfPointer_L); } ; WholeQuantity : WholeQuantity_Single | WholeQuantity '?' { WholeQuantity_S.Type = WQ_TEST; List_Add(Current_WholeQuantity_L, &WholeQuantity_S); WholeQuantity_P = (struct WholeQuantity*) List_Pointer(Current_WholeQuantity_L, List_Nbr(Current_WholeQuantity_L)-1); List_Add(ListOfPointer2_L, &WholeQuantity_P); List_Add(ListOfPointer2_L, &WholeQuantity_P); Current_WholeQuantity_L = List_Create(5, 5, sizeof(struct WholeQuantity)); List_Add(ListOfPointer_L, &Current_WholeQuantity_L); } WholeQuantity tDOTS { WholeQuantity_P = *((struct WholeQuantity**) List_Pointer(ListOfPointer2_L, List_Nbr(ListOfPointer2_L)-1)); List_Pop(ListOfPointer2_L); WholeQuantity_P->Case.Test.WholeQuantity_True = *((List_T **)List_Pointer(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1)); List_Pop(ListOfPointer_L); Current_WholeQuantity_L = List_Create(5, 5, sizeof(struct WholeQuantity)); List_Add(ListOfPointer_L, &Current_WholeQuantity_L); } WholeQuantity { WholeQuantity_P = *((struct WholeQuantity**) List_Pointer(ListOfPointer2_L, List_Nbr(ListOfPointer2_L)-1)); List_Pop(ListOfPointer2_L); WholeQuantity_P->Case.Test.WholeQuantity_False = *((List_T **)List_Pointer(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1)); List_Pop(ListOfPointer_L); List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L); } | WholeQuantity '*' WholeQuantity { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_TIME; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_ProductValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | WholeQuantity tCROSSPRODUCT WholeQuantity { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_CROSSPRODUCT; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_CrossProductValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | tCrossProduct '[' WholeQuantity ',' WholeQuantity ']' { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_CROSSPRODUCT; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_CrossProductValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | WholeQuantity '/' WholeQuantity { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_DIVIDE; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_DivideValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | WholeQuantity '+' WholeQuantity { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_PLUS; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_AddValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | WholeQuantity '-' WholeQuantity { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_MINUS; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_SubstractValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | WholeQuantity '%' WholeQuantity { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_MODULO; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_ModuloValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | WholeQuantity '^' WholeQuantity { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_POWER; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_PowerValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | WholeQuantity '<' WholeQuantity { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_LESS; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_LessValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | WholeQuantity '>' WholeQuantity { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_GREATER; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_GreaterValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | WholeQuantity tLESSOREQUAL WholeQuantity { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_LESSOREQUAL; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_LessOrEqualValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | WholeQuantity tGREATEROREQUAL WholeQuantity { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_GREATEROREQUAL; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_GreaterOrEqualValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | WholeQuantity tEQUAL WholeQuantity { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_EQUAL; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_EqualValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | WholeQuantity tNOTEQUAL WholeQuantity { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_NOTEQUAL; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_NotEqualValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | WholeQuantity tAPPROXEQUAL WholeQuantity { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_APPROXEQUAL; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_ApproxEqualValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | WholeQuantity tAND WholeQuantity { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_AND; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_AndValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | WholeQuantity tOR WholeQuantity { WholeQuantity_S.Type = WQ_BINARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_OR; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_OrValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | '$' String__Index tDEF WholeQuantity { WholeQuantity_S.Type = WQ_SAVENAMEDVALUE; WholeQuantity_S.Case.NamedValue.Name = $2; List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | '-' WholeQuantity %prec UNARYPREC { WholeQuantity_S.Type = WQ_UNARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_NEG; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_NegValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | '+' WholeQuantity %prec UNARYPREC | '!' WholeQuantity { WholeQuantity_S.Type = WQ_UNARYOPERATOR; WholeQuantity_S.Case.Operator.TypeOperator = OP_NOT; #if defined(HAVE_LEGACY) WholeQuantity_S.Case.Operator.Function = (void (*)())Cal_NotValue; #endif List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | '<' tChangeCurrentPosition '[' WholeQuantity ']' '>' { WholeQuantity_S.Type = WQ_CHANGECURRENTPOSITION ; List_Add(Current_WholeQuantity_L, &WholeQuantity_S) ; WholeQuantity_P = (struct WholeQuantity*) List_Pointer(Current_WholeQuantity_L, List_Nbr(Current_WholeQuantity_L)-1); List_Add(ListOfPointer2_L, &WholeQuantity_P); Current_WholeQuantity_L = List_Create( 5, 5, sizeof(struct WholeQuantity)) ; List_Add(ListOfPointer_L, &Current_WholeQuantity_L) ; } '[' WholeQuantity ']' { WholeQuantity_P = *((struct WholeQuantity**) List_Pointer(ListOfPointer2_L, List_Nbr(ListOfPointer2_L)-1)) ; List_Pop(ListOfPointer2_L) ; WholeQuantity_P->Case.ChangeCurrentPosition.WholeQuantity = *((List_T **)List_Pointer(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1)) ; List_Pop(ListOfPointer_L) ; List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L) ; } ; WholeQuantity_Single : '(' WholeQuantity ')' | OneFExpr { WholeQuantity_S.Type = WQ_CONSTANT; WholeQuantity_S.Case.Constant = $1; List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | NameForFunction ArgumentsForFunction ParametersForFunction { /* Expression */ int l; if((l = List_ISearchSeq(Problem_S.Expression, $1, fcmp_Expression_Name)) >= 0) { WholeQuantity_S.Type = WQ_EXPRESSION; WholeQuantity_S.Case.Expression.Index = l; WholeQuantity_S.Case.Expression.NbrArguments = $2; if($2 < 0) vyyerror("Uncompatible argument for Function: %s", $1); } /* Built in functions */ else { Get_Function2NbrForString(F_Function, $1, &FlagError, &WholeQuantity_S.Case.Function.Fct, &WholeQuantity_S.Case.Function.NbrParameters, &WholeQuantity_S.Case.Function.NbrArguments); WholeQuantity_S.Case.Function.Active = NULL; if(!FlagError) { /* arguments */ if($2 >= 0) { if($2 == WholeQuantity_S.Case.Function.NbrArguments) { WholeQuantity_S.Type = WQ_BUILTINFUNCTION; } else if(WholeQuantity_S.Case.Function.NbrArguments == -1 || (WholeQuantity_S.Case.Function.NbrArguments == -2)) { /* && ($2)%2 == 0)) { */ WholeQuantity_S.Type = WQ_BUILTINFUNCTION; WholeQuantity_S.Case.Function.NbrArguments = $2; } else { vyyerror("Wrong number of arguments for Function '%s' (%d instead of %d)", $1, $2, WholeQuantity_S.Case.Function.NbrArguments); } } else { WholeQuantity_S.Type = WQ_EXTERNBUILTINFUNCTION; } /* parameters */ WholeQuantity_S.Case.Function.Para = 0; WholeQuantity_S.Case.Function.String = StringForParameter; if(WholeQuantity_S.Case.Function.NbrParameters >= 0 && WholeQuantity_S.Case.Function.NbrParameters != List_Nbr($3)) { vyyerror("Wrong number of parameters for Function '%s' (%d instead of %d)", $1, List_Nbr($3), WholeQuantity_S.Case.Function.NbrParameters); } else if(WholeQuantity_S.Case.Function.NbrParameters == -2 && List_Nbr($3)%2 != 0) { vyyerror("Wrong number of parameters for Function '%s' (%d is not even)", $1, List_Nbr($3)); } else { WholeQuantity_S.Case.Function.NbrParameters = List_Nbr($3); if(WholeQuantity_S.Case.Function.NbrParameters > 0) { WholeQuantity_S.Case.Function.Para = (double *)Malloc (WholeQuantity_S.Case.Function.NbrParameters * sizeof(double)); for(int i = 0; i < WholeQuantity_S.Case.Function.NbrParameters; i++) List_Read($3, i, &WholeQuantity_S.Case.Function.Para[i]); } } } else { vyyerror("Unknown Function: %s", $1); } } List_Add(Current_WholeQuantity_L, &WholeQuantity_S); List_Delete($3); StringForParameter = 0; } | tSTRING Quantity_Def { WholeQuantity_S.Type = WQ_OPERATORANDQUANTITY; WholeQuantity_S.Case.OperatorAndQuantity.NbrArguments = 0; WholeQuantity_S.Case.OperatorAndQuantity.TypeQuantity = Get_DefineForString(QuantityFromFS_Type, $1, &FlagError); if(FlagError){ Get_Valid_SXD($1, QuantityFromFS_Type); vyyerror("Unknown type of discrete Quantity: %s", $1); } Free($1); WholeQuantity_S.Case.OperatorAndQuantity.TypeOperator = $2.Int1; WholeQuantity_S.Case.OperatorAndQuantity.Index = $2.Int2; switch(WholeQuantity_S.Case.OperatorAndQuantity.TypeQuantity) { case QUANTITY_DOF : if(Current_DofIndexInWholeQuantity == -1) Current_DofIndexInWholeQuantity = List_Nbr(Current_WholeQuantity_L); else if(Current_DofIndexInWholeQuantity == -2) vyyerror("Dof{} definition out of context"); else vyyerror("More than one Dof definition in Expression"); break; case QUANTITY_NODOF : if(Current_DofIndexInWholeQuantity == -2) vyyerror("NoDof definition out of context"); else if(Current_NoDofIndexInWholeQuantity == -1) Current_NoDofIndexInWholeQuantity = List_Nbr(Current_WholeQuantity_L); else vyyerror("More than one NoDof definition in Expression"); break; } List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | Quantity_Def { WholeQuantity_S.Type = WQ_OPERATORANDQUANTITY; WholeQuantity_S.Case.OperatorAndQuantity.NbrArguments = 0; WholeQuantity_S.Case.OperatorAndQuantity.TypeQuantity = QUANTITY_SIMPLE; WholeQuantity_S.Case.OperatorAndQuantity.TypeOperator = $1.Int1; WholeQuantity_S.Case.OperatorAndQuantity.Index = $1.Int2; List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | Quantity_Def ArgumentsForFunction { if($2 != 1 && $2 != 2 && $2 != 3 && $2 != 4) vyyerror("Wrong number of arguments for discrete quantity evaluation (%d)", $2); WholeQuantity_S.Type = WQ_OPERATORANDQUANTITYEVAL; WholeQuantity_S.Case.OperatorAndQuantity.NbrArguments = $2; WholeQuantity_S.Case.OperatorAndQuantity.TypeQuantity = QUANTITY_SIMPLE; WholeQuantity_S.Case.OperatorAndQuantity.TypeOperator = $1.Int1; WholeQuantity_S.Case.OperatorAndQuantity.Index = $1.Int2; List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | tDt { Last_DofIndexInWholeQuantity = Current_DofIndexInWholeQuantity; } '[' WholeQuantityExpression ']' { WholeQuantity_S.Type = WQ_TIMEDERIVATIVE; WholeQuantity_S.Case.TimeDerivative.WholeQuantity = $4; List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); if(Current_DofIndexInWholeQuantity != Last_DofIndexInWholeQuantity) vyyerror("Dof{} definition out of context"); } | tAtAnteriorTimeStep { Last_DofIndexInWholeQuantity = Current_DofIndexInWholeQuantity; } '[' WholeQuantityExpression ',' tINT ']' { WholeQuantity_S.Type = WQ_ATANTERIORTIMESTEP; WholeQuantity_S.Case.AtAnteriorTimeStep.WholeQuantity = $4; WholeQuantity_S.Case.AtAnteriorTimeStep.TimeStep = $6; List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); if(Current_DofIndexInWholeQuantity != Last_DofIndexInWholeQuantity) vyyerror("Dof{} definition out of context"); } | tMaxOverTime { Last_DofIndexInWholeQuantity = Current_DofIndexInWholeQuantity; } '[' WholeQuantityExpression ',' FExpr ',' FExpr ']' { WholeQuantity_S.Type = WQ_MAXOVERTIME; WholeQuantity_S.Case.MaxOverTime.WholeQuantity = $4; WholeQuantity_S.Case.FourierSteinmetz.TimeInit = $6; WholeQuantity_S.Case.FourierSteinmetz.TimeFinal = $8; List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); if(Current_DofIndexInWholeQuantity != Last_DofIndexInWholeQuantity) vyyerror("Dof{} definition out of context"); } | tFourierSteinmetz { Last_DofIndexInWholeQuantity = Current_DofIndexInWholeQuantity; } '[' WholeQuantityExpression ',' FExpr ',' FExpr ',' FExpr ',' FExpr ',' FExpr ']' { WholeQuantity_S.Type = WQ_FOURIERSTEINMETZ; WholeQuantity_S.Case.FourierSteinmetz.WholeQuantity = $4; WholeQuantity_S.Case.FourierSteinmetz.TimeInit = $6; WholeQuantity_S.Case.FourierSteinmetz.TimeFinal = $8; WholeQuantity_S.Case.FourierSteinmetz.NbrFrequency = (int)$10; WholeQuantity_S.Case.FourierSteinmetz.Exponent_f = $12; WholeQuantity_S.Case.FourierSteinmetz.Exponent_b = $14; List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); if(Current_DofIndexInWholeQuantity != Last_DofIndexInWholeQuantity) vyyerror("Dof{} definition out of context"); } | tMHTransform '[' NameForFunction { Last_DofIndexInWholeQuantity = Current_DofIndexInWholeQuantity; } '[' WholeQuantityExpression ']' ']' '{' FExpr '}' { int i; if((i = List_ISearchSeq(Problem_S.Expression, $3, fcmp_Expression_Name)) < 0) vyyerror("Undefined function '%s' used in MHTransform", $3); if(Current_DofIndexInWholeQuantity != Last_DofIndexInWholeQuantity) vyyerror("Dof{} definition cannot be used in MHTransform"); WholeQuantity_S.Type = WQ_MHTRANSFORM; WholeQuantity_S.Case.MHTransform.Index = i; WholeQuantity_S.Case.MHTransform.WholeQuantity = $6; WholeQuantity_S.Case.MHTransform.NbrPoints = (int)$10; List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | tMHJacNL '[' NameForFunction ArgumentsForFunction ']' '{' FExpr ',' FExpr '}' { int i; if((i = List_ISearchSeq(Problem_S.Expression, $3,fcmp_Expression_Name)) < 0) vyyerror("Undefined function '%s' used in MHJacNL", $3); WholeQuantity_S.Type = WQ_MHJACNL; WholeQuantity_S.Case.MHJacNL.Index = i; WholeQuantity_S.Case.MHJacNL.NbrArguments = $4; if($4 != 1) vyyerror("Uncompatible argument %d for Function: %s", $4, $3); WholeQuantity_S.Case.MHJacNL.NbrPoints = (int)$7; WholeQuantity_S.Case.MHJacNL.FreqOffSet = (int)$9; List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | tSolidAngle '[' Quantity_Def ']' { WholeQuantity_S.Type = WQ_SOLIDANGLE; WholeQuantity_S.Case.OperatorAndQuantity.Index = $3.Int2; List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | tOrder '[' Quantity_Def ']' { WholeQuantity_S.Type = WQ_ORDER; WholeQuantity_S.Case.OperatorAndQuantity.Index = $3.Int2; List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | tTrace { Last_DofIndexInWholeQuantity = Current_DofIndexInWholeQuantity; } '[' WholeQuantityExpression ',' GroupRHS ']' { WholeQuantity_S.Type = WQ_TRACE; WholeQuantity_S.Case.Trace.WholeQuantity = $4; WholeQuantity_S.Case.Trace.InIndex = Num_Group(&Group_S, (char*)"WQ_Trace_In", $6); if(Group_S.Type != ELEMENTLIST || Group_S.SuppListType != SUPPLIST_CONNECTEDTO) vyyerror("Group for Trace should be of Type 'ElementsOf[x, ConnectedTo y]'"); WholeQuantity_S.Case.Trace.DofIndexInWholeQuantity = -1; if(Current_DofIndexInWholeQuantity != Last_DofIndexInWholeQuantity){ for(int i = 0; i < List_Nbr($4); i++){ WholeQuantity_P = (struct WholeQuantity*)List_Pointer($4, i); if(WholeQuantity_P->Type == WQ_OPERATORANDQUANTITY) if(WholeQuantity_P->Case.OperatorAndQuantity.TypeQuantity == QUANTITY_DOF){ WholeQuantity_S.Case.Trace.DofIndexInWholeQuantity = i; Current_DofIndexInWholeQuantity = -4; TypeOperatorDofInTrace = WholeQuantity_P->Case.OperatorAndQuantity.TypeOperator; DefineQuantityIndexDofInTrace = WholeQuantity_P->Case.OperatorAndQuantity.Index; } } if(Current_DofIndexInWholeQuantity != -4) vyyerror("Dof{} definition out of context in Trace operator"); } List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | '<' tSTRING '>' '[' WholeQuantityExpression ']' { WholeQuantity_S.Type = WQ_CAST; WholeQuantity_S.Case.Cast.WholeQuantity = $5; int i; if((i = List_ISearchSeq(Formulation_S.DefineQuantity, $2, fcmp_DefineQuantity_Name)) < 0) { if(!strcmp($2, "Real")) WholeQuantity_S.Case.Cast.NbrHar = 1; else if(!strcmp($2, "Complex")) WholeQuantity_S.Case.Cast.NbrHar = 2; else vyyerror("Unknown Cast: %s", $2); } else { WholeQuantity_S.Case.Cast.NbrHar = 0; WholeQuantity_S.Case.Cast.FunctionSpaceIndexForType = ((struct DefineQuantity *)List_Pointer(Formulation_S.DefineQuantity, i)) ->FunctionSpaceIndex; } Free($2); List_Read(ListOfPointer_L, List_Nbr(ListOfPointer_L)-1, &Current_WholeQuantity_L); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | '$' String__Index { WholeQuantity_S.Type = WQ_CURRENTVALUE; Get_PointerForString(Current_Value, $2, &FlagError, (void **)&WholeQuantity_S.Case.CurrentValue.Value); if(FlagError){ WholeQuantity_S.Type = WQ_NAMEDVALUESAVED; WholeQuantity_S.Case.NamedValue.Name = $2; } else{ Free($2); } List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } /* a changer */ | '$' tTimeStep { WholeQuantity_S.Type = WQ_CURRENTVALUE; Get_PointerForString(Current_Value, "TimeStep", &FlagError, (void **)&WholeQuantity_S.Case.CurrentValue.Value); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | '$' tDTime { WholeQuantity_S.Type = WQ_CURRENTVALUE; Get_PointerForString(Current_Value, "DTime", &FlagError, (void **)&WholeQuantity_S.Case.CurrentValue.Value); List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | '$' tINT { WholeQuantity_S.Type = WQ_ARGUMENT; WholeQuantity_S.Case.Argument.Index = $2; List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | WholeQuantity_Single '#' FExpr { WholeQuantity_S.Type = WQ_SAVEVALUE; WholeQuantity_S.Case.SaveValue.Index = (int)$3 - 1; List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | '#' FExpr { WholeQuantity_S.Type = WQ_VALUESAVED; WholeQuantity_S.Case.ValueSaved.Index = (int)$2 - 1; List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | WholeQuantity_Single tSHOW FExpr { WholeQuantity_S.Type = WQ_SHOWVALUE; WholeQuantity_S.Case.ShowValue.Index = (int)$3; List_Add(Current_WholeQuantity_L, &WholeQuantity_S); } | StrCmp { WholeQuantity_S.Type = WQ_CONSTANT ; WholeQuantity_S.Case.Constant = $1 ; List_Add(Current_WholeQuantity_L, &WholeQuantity_S) ; } | NbrRegions { WholeQuantity_S.Type = WQ_CONSTANT ; WholeQuantity_S.Case.Constant = $1 ; List_Add(Current_WholeQuantity_L, &WholeQuantity_S) ; } ; ArgumentsForFunction : '[' '.' ']' { $$ = -1; } | '[' ']' { $$ = 0; } | '[' RecursiveListOfQuantity ']' { $$ = $2; } ; RecursiveListOfQuantity : WholeQuantity { $$ = 1; } | RecursiveListOfQuantity ',' WholeQuantity { $$ = $1 + 1; } ; ParametersForFunction : /* none */ { $$ = NULL; } | '{' RecursiveListOfFExpr '}' { $$ = $2; } | '{' tRegion '[' GroupRHS ']' '}' { /* Attention: provisoire. Note: Impossible a mettre dans MultiFExpr car conflit avec Affectation dans Group */ $$ = List_Create(2, 1, sizeof(double)); double d = (double)Num_Group(&Group_S, (char*)"PA_Region", $4); List_Add($$, &d); } | '{' CharExprNoVar '}' { $$ = NULL; StringForParameter = $2; } ; /* ------------------------------------------------------------------------ */ /* J a c o b i a n M e t h o d */ /* ------------------------------------------------------------------------ */ JacobianMethods : /* none */ { if(!Problem_S.JacobianMethod) Problem_S.JacobianMethod = List_Create(5, 5, sizeof (struct JacobianMethod)); } | JacobianMethods '{' JacobianMethod '}' { List_Add(Problem_S.JacobianMethod, &JacobianMethod_S); } ; JacobianMethod : /* none */ { JacobianMethod_S.Name = NULL; JacobianMethod_S.JacobianCase = NULL; } | JacobianMethod JacobianMethodTerm ; JacobianMethodTerm : tName String__Index tEND { Check_NameOfStructNotExist("JacobianMethod", Problem_S.JacobianMethod, $2, fcmp_JacobianMethod_Name); JacobianMethod_S.Name = $2; } | tCase '{' JacobianCases '}' { JacobianMethod_S.JacobianCase = $3; } ; JacobianCases : /* none */ { $$ = List_Create(5, 5, sizeof (struct JacobianCase)); } | JacobianCases '{' JacobianCase '}' { List_Add($$ = $1, &JacobianCase_S); } ; JacobianCase : /* none */ { JacobianCase_S.RegionIndex = -1; JacobianCase_S.TypeJacobian = JACOBIAN_VOL; } | JacobianCase JacobianCaseTerm ; JacobianCaseTerm : tRegion GroupRHS tEND { JacobianCase_S.RegionIndex = Num_Group(&Group_S, (char*)"JA_Region", $2); } | tRegion tAll tEND { JacobianCase_S.RegionIndex = -1; } | tJacobian String__Index ParametersForFunction tEND { JacobianCase_S.TypeJacobian = Get_Define1NbrForString(Jacobian_Type, $2, &FlagError, &JacobianCase_S.NbrParameters); if(!FlagError) { if(JacobianCase_S.NbrParameters == -2 && (List_Nbr($3))%2 != 0) vyyerror("Wrong number of parameters for Jacobian '%s' (%d is not even)", $2, List_Nbr($3)); if(JacobianCase_S.NbrParameters < 0) JacobianCase_S.NbrParameters = List_Nbr($3); if(List_Nbr($3) == JacobianCase_S.NbrParameters) { if(JacobianCase_S.NbrParameters) { JacobianCase_S.Para = (double *)Malloc(JacobianCase_S.NbrParameters * sizeof(double)); for(int i = 0; i < JacobianCase_S.NbrParameters; i++) List_Read($3, i, &JacobianCase_S.Para[i]); } } else vyyerror("Wrong number of parameters for Jacobian '%s' (%d instead of %d)", $2, List_Nbr($3), JacobianCase_S.NbrParameters); } else{ Get_Valid_SXD1N($2, Jacobian_Type); vyyerror("Unknown type of Jacobian: %s", $2); } Free($2); List_Delete($3); } ; /* ------------------------------------------------------------------------ */ /* I n t e g r a t i o n M e t h o d */ /* ------------------------------------------------------------------------ */ IntegrationMethods : /* none */ { if(!Problem_S.IntegrationMethod) Problem_S.IntegrationMethod = List_Create(5, 5, sizeof(struct IntegrationMethod)); } | IntegrationMethods '{' IntegrationMethod '}' { List_Add(Problem_S.IntegrationMethod, &IntegrationMethod_S); } ; IntegrationMethod : /* none */ { IntegrationMethod_S.Name = NULL; IntegrationMethod_S.IntegrationCase = NULL; IntegrationMethod_S.CriterionIndex = -1; } | IntegrationMethod IntegrationMethodTerm ; IntegrationMethodTerm : tName tSTRING tEND { Check_NameOfStructNotExist("IntegrationMethod", Problem_S.IntegrationMethod, $2, fcmp_IntegrationMethod_Name); IntegrationMethod_S.Name = $2; } | tCriterion Expression tEND { IntegrationMethod_S.CriterionIndex = $2; } | tCase '{' IntegrationCases '}' { IntegrationMethod_S.IntegrationCase = $3; } ; IntegrationCases : /* none */ { $$ = List_Create(5, 5, sizeof (struct IntegrationCase)); } | IntegrationCases '{' IntegrationCase '}' { List_Add($$ = $1, &IntegrationCase_S); } ; IntegrationCase : /* none */ { IntegrationCase_S.Type = GAUSS; IntegrationCase_S.SubType = STANDARD; } | IntegrationCase IntegrationCaseTerm ; IntegrationCaseTerm : tType tSTRING tEND { IntegrationCase_S.Type = Get_DefineForString(Integration_Type, $2, &FlagError); if(FlagError){ Get_Valid_SXD($2, Integration_Type); vyyerror("Unknown type of Integration method: %s", $2); } Free($2); } | tSubType tSTRING tEND { IntegrationCase_S.SubType = Get_DefineForString(Integration_SubType, $2, &FlagError); if(FlagError){ Get_Valid_SXD($2, Integration_Type); vyyerror("Unknown subtype of Integration method: %s", $2); } Free($2); } | tCase '{' QuadratureCases '}' { IntegrationCase_S.Case = $3; } ; QuadratureCases : /* none */ { $$ = List_Create(5, 5, sizeof (struct Quadrature)); } | QuadratureCases '{' QuadratureCase '}' { List_Add($$ = $1, &QuadratureCase_S); } ; QuadratureCase : /* none */ { QuadratureCase_S.ElementType = TRIANGLE; QuadratureCase_S.NumberOfPoints = 4; QuadratureCase_S.MaxNumberOfPoints = 4; QuadratureCase_S.NumberOfDivisions = 1; QuadratureCase_S.MaxNumberOfDivisions = 1; QuadratureCase_S.StoppingCriterion = 1.E-4; QuadratureCase_S.Function = 0; //FIXME(void (*)())Gauss_Triangle; } | QuadratureCase QuadratureCaseTerm ; QuadratureCaseTerm : tGeoElement tSTRING tEND { QuadratureCase_S.ElementType = Get_DefineForString(Element_Type, $2, &FlagError); if(FlagError){ Get_Valid_SXD($2, Element_Type); vyyerror("Unknown type of Element: %s", $2); } switch(IntegrationCase_S.SubType) { case STANDARD : switch (IntegrationCase_S.Type) { case GAUSS : Get_FunctionForDefine (FunctionForGauss, QuadratureCase_S.ElementType, &FlagError, (void (**)())&QuadratureCase_S.Function); break; case GAUSSLEGENDRE : Get_FunctionForDefine (FunctionForGaussLegendre, QuadratureCase_S.ElementType, &FlagError, (void (**)())&QuadratureCase_S.Function); break; default : vyyerror("Incompatible type of Integration method"); break; } break; case SINGULAR : switch (IntegrationCase_S.Type) { case GAUSS : Get_FunctionForDefine (FunctionForSingularGauss, QuadratureCase_S.ElementType, &FlagError, (void (**)())&QuadratureCase_S.Function); break; default : vyyerror("Incompatible type of Integration method"); break; } break; default : vyyerror("Incompatible type of Integration method"); break; } if(FlagError) vyyerror("Bad type of Integration method for Element: %s", $2); Free($2); } | tNumberOfPoints FExpr tEND { QuadratureCase_S.NumberOfPoints = (int)$2; } | tMaxNumberOfPoints FExpr tEND { QuadratureCase_S.MaxNumberOfPoints = (int)$2; } | tNumberOfDivisions FExpr tEND { QuadratureCase_S.NumberOfDivisions = (int)$2; } | tMaxNumberOfDivisions FExpr tEND { QuadratureCase_S.MaxNumberOfDivisions = (int)$2; } | tStoppingCriterion FExpr tEND { QuadratureCase_S.StoppingCriterion = $2; } ; /* ------------------------------------------------------------------------ */ /* C o n s t r a i n t */ /* ------------------------------------------------------------------------ */ Constraints : /* none */ { if(!Problem_S.Constraint) Problem_S.Constraint = List_Create(20, 20, sizeof (struct Constraint)); } | Constraints BracedConstraint ; BracedConstraint : '{' Constraint '}' { List_Add(Problem_S.Constraint, &Constraint_S); } | Loop ; Constraint : /* none */ { Constraint_S.Name = NULL; Constraint_S.Type = ASSIGN; Constraint_S.ConstraintPerRegion = NULL; Constraint_S.MultiConstraintPerRegion = NULL; } | Constraint ConstraintTerm ; ConstraintTerm : tName String__Index tEND { Check_NameOfStructNotExist("Constraint", Problem_S.Constraint, $2, fcmp_Constraint_Name); Constraint_S.Name = $2; } | tType tSTRING tEND { Constraint_S.Type = Get_DefineForString(Constraint_Type, $2, &FlagError); if(FlagError){ Get_Valid_SXD($2, Constraint_Type); vyyerror("Unknown type of Constraint: %s", $2); } Free($2); } | tCase '{' ConstraintCases '}' { Constraint_S.ConstraintPerRegion = $3; } | tCase tSTRING '{' ConstraintCases '}' { if(!Constraint_S.MultiConstraintPerRegion) Constraint_S.MultiConstraintPerRegion = List_Create(5, 5, sizeof(struct MultiConstraintPerRegion)); MultiConstraintPerRegion_S.Name = $2; MultiConstraintPerRegion_S.ConstraintPerRegion = $4; MultiConstraintPerRegion_S.Active = NULL; List_Add(Constraint_S.MultiConstraintPerRegion, &MultiConstraintPerRegion_S); } | ConstraintTerm Loop { } ; ConstraintCases : /* none */ { $$ = List_Create(6, 6, sizeof (struct ConstraintPerRegion)); } | ConstraintCases '{' ConstraintCase '}' { List_Add($$ = $1, &ConstraintPerRegion_S); } | ConstraintCases Loop { $$ = $1; } ; ConstraintCase : /* none */ { ConstraintPerRegion_S.Type = Constraint_S.Type; ConstraintPerRegion_S.RegionIndex = -1; ConstraintPerRegion_S.SubRegionIndex = -1; ConstraintPerRegion_S.TimeFunctionIndex = -1; } | ConstraintCase ConstraintCaseTerm ; ConstraintCaseTerm : tType tSTRING tEND { ConstraintPerRegion_S.Type = Get_DefineForString(Constraint_Type, $2, &FlagError); if(FlagError){ Get_Valid_SXD($2, Constraint_Type); vyyerror("Unknown type of Constraint: %s", $2); } Free($2); } | tRegion GroupRHS tEND { ConstraintPerRegion_S.RegionIndex = Num_Group(&Group_S, (char*)"CO_Region", $2); } | tSubRegion GroupRHS tEND { ConstraintPerRegion_S.SubRegionIndex = Num_Group(&Group_S, (char*)"CO_SubRegion", $2); } | tTimeFunction Expression tEND { ConstraintPerRegion_S.TimeFunctionIndex = $2; if(Is_ExpressionPieceWiseDefined($2)) vyyerror("TimeFunction should never be piece-wise defined"); } | tValue Expression tEND { if(ConstraintPerRegion_S.Type == ASSIGN || ConstraintPerRegion_S.Type == INIT){ ConstraintPerRegion_S.Case.Fixed.ExpressionIndex = $2; ConstraintPerRegion_S.Case.Fixed.ExpressionIndex2 = -1; } else vyyerror("Value incompatible with Type"); } | tValue '[' Expression ',' Expression ']' tEND { if(ConstraintPerRegion_S.Type == ASSIGN || ConstraintPerRegion_S.Type == INIT){ ConstraintPerRegion_S.Case.Fixed.ExpressionIndex = $5; ConstraintPerRegion_S.Case.Fixed.ExpressionIndex2 = $3; } else vyyerror("Value incompatible with Type"); } | tNameOfResolution String__Index tEND { if(ConstraintPerRegion_S.Type == ASSIGNFROMRESOLUTION || ConstraintPerRegion_S.Type == INITFROMRESOLUTION) ConstraintPerRegion_S.Case.Solve.ResolutionName = $2; else vyyerror("NameOfResolution incompatible with Type"); } | tBranch '{' OneFExpr Comma OneFExpr '}' tEND { if(ConstraintPerRegion_S.Type == NETWORK) { ConstraintPerRegion_S.Case.Network.Node1 = (int)$3; ConstraintPerRegion_S.Case.Network.Node2 = (int)$5; } else vyyerror("Branch incompatible with Type"); } | tBranch '{' '(' FExpr ')' Comma '(' FExpr ')' '}' tEND { if(ConstraintPerRegion_S.Type == NETWORK) { ConstraintPerRegion_S.Case.Network.Node1 = (int)$4; ConstraintPerRegion_S.Case.Network.Node2 = (int)$8; } else vyyerror("Branch incompatible with Type"); } | tRegionRef GroupRHS tEND { if(ConstraintPerRegion_S.Type == CST_LINK || ConstraintPerRegion_S.Type == CST_LINKCPLX) { ConstraintPerRegion_S.Case.Link.RegionRefIndex = Num_Group(&Group_S, (char*)"CO_RegionRef", $2); ConstraintPerRegion_S.Case.Link.SubRegionRefIndex = -1; ConstraintPerRegion_S.Case.Link.FilterIndex = -1; ConstraintPerRegion_S.Case.Link.FunctionIndex = -1; ConstraintPerRegion_S.Case.Link.CoefIndex = -1; ConstraintPerRegion_S.Case.Link.FilterIndex2 = -1; ConstraintPerRegion_S.Case.Link.FunctionIndex2 = -1; ConstraintPerRegion_S.Case.Link.CoefIndex2 = -1; ConstraintPerRegion_S.Case.Link.ToleranceFactor = 1.e-8; } else vyyerror("RegionRef incompatible with Type"); } | tSubRegionRef GroupRHS tEND { if(ConstraintPerRegion_S.Type == CST_LINK || ConstraintPerRegion_S.Type == CST_LINKCPLX) ConstraintPerRegion_S.Case.Link.SubRegionRefIndex = Num_Group(&Group_S, (char*)"CO_RegionRef", $2); else vyyerror("SubRegionRef incompatible with Type"); } | tFunction Expression tEND { if(ConstraintPerRegion_S.Type == CST_LINK || ConstraintPerRegion_S.Type == CST_LINKCPLX) ConstraintPerRegion_S.Case.Link.FunctionIndex = $2; else vyyerror("Function incompatible with Type"); } | tCoefficient Expression tEND { if(ConstraintPerRegion_S.Type == CST_LINK || ConstraintPerRegion_S.Type == CST_LINKCPLX) ConstraintPerRegion_S.Case.Link.CoefIndex = $2; else vyyerror("Coefficient incompatible with Type"); } | tFilter Expression tEND { if(ConstraintPerRegion_S.Type == CST_LINK || ConstraintPerRegion_S.Type == CST_LINKCPLX) { ConstraintPerRegion_S.Case.Link.FilterIndex = $2; ConstraintPerRegion_S.Case.Link.FilterIndex2 = -1; } else vyyerror("Filter incompatible with Type"); } | tFunction '[' Expression ',' Expression ']' tEND { if(ConstraintPerRegion_S.Type == CST_LINK || ConstraintPerRegion_S.Type == CST_LINKCPLX) { ConstraintPerRegion_S.Case.Link.FunctionIndex = $3; ConstraintPerRegion_S.Case.Link.FunctionIndex2 = $5; } else vyyerror("Function incompatible with Type"); } | tToleranceFactor FExpr tEND { if(ConstraintPerRegion_S.Type == CST_LINK || ConstraintPerRegion_S.Type == CST_LINKCPLX) { ConstraintPerRegion_S.Case.Link.ToleranceFactor = $2; } else vyyerror("ToleranceFactor incompatible with Type"); } | tCoefficient '[' Expression ',' Expression ']' tEND { if(ConstraintPerRegion_S.Type == CST_LINK || ConstraintPerRegion_S.Type == CST_LINKCPLX) { ConstraintPerRegion_S.Case.Link.CoefIndex = $3; ConstraintPerRegion_S.Case.Link.CoefIndex2 = $5; } else vyyerror("Coefficient incompatible with Type"); } | tFilter '[' Expression ',' Expression ']' tEND { if(ConstraintPerRegion_S.Type == CST_LINK || ConstraintPerRegion_S.Type == CST_LINKCPLX) { ConstraintPerRegion_S.Case.Link.FilterIndex = $3; ConstraintPerRegion_S.Case.Link.FilterIndex2 = $5; } else vyyerror("Filter incompatible with Type"); } ; /* ------------------------------------------------------------------------ */ /* F u n c t i o n S p a c e */ /* ------------------------------------------------------------------------ */ FunctionSpaces : /* none */ { if(!Problem_S.FunctionSpace) Problem_S.FunctionSpace = List_Create(10, 5, sizeof (struct FunctionSpace)); } | FunctionSpaces BracedFunctionSpace ; BracedFunctionSpace : '{' FunctionSpace '}' { List_Add(Problem_S.FunctionSpace, &FunctionSpace_S); } | Loop ; FunctionSpace : /* none */ { FunctionSpace_S.Name = NULL; FunctionSpace_S.Type = FORM0; FunctionSpace_S.BasisFunction = FunctionSpace_S.SubSpace = FunctionSpace_S.GlobalQuantity = FunctionSpace_S.Constraint = NULL; } | FunctionSpace FunctionSpaceTerm | FunctionSpace Loop ; FunctionSpaceTerm : tName String__Index tEND { Check_NameOfStructNotExist("FunctionSpace", Problem_S.FunctionSpace, $2, fcmp_FunctionSpace_Name); FunctionSpace_S.Name = $2; } | tType tSTRING tEND { FunctionSpace_S.Type = Get_DefineForString(Field_Type, $2, &FlagError); if(FlagError){ Get_Valid_SXD($2, Field_Type); vyyerror("Unknown type of FunctionSpace: %s", $2); } Free($2); } | tBasisFunction '{' BasisFunctions '}' { FunctionSpace_S.BasisFunction = $3; } | tSubSpace '{' SubSpaces '}' { FunctionSpace_S.SubSpace = $3; } | tGlobalQuantity '{' GlobalQuantities '}' { FunctionSpace_S.GlobalQuantity = $3; } | tConstraint '{' ConstraintInFSs '}' { FunctionSpace_S.Constraint = $3; } ; BasisFunctions : /* none */ { $$ = Current_BasisFunction_L = List_Create(6, 6, sizeof (struct BasisFunction)); } | BasisFunctions '{' BasisFunction '}' { int i; if((i = List_ISearchSeq($1, BasisFunction_S.Name, fcmp_BasisFunction_Name)) < 0) { /* BasisFunction_S.Num = Num_BasisFunction++; */ BasisFunction_S.Num = Num_BasisFunction; Num_BasisFunction += (BasisFunction_S.SubFunction)? List_Nbr(BasisFunction_S.SubFunction) : 1; } else /* BasisFunction definie par morceaux => meme Num */ BasisFunction_S.Num = ((struct BasisFunction *)List_Pointer($1, i))->Num; List_Add($$ = $1, &BasisFunction_S); } | BasisFunctions Loop { $$ = $1; } ; BasisFunction : /* none */ { BasisFunction_S.Name = NULL; BasisFunction_S.NameOfCoef = NULL; BasisFunction_S.Num = 0; BasisFunction_S.GlobalBasisFunction = NULL; BasisFunction_S.Function = NULL; BasisFunction_S.dFunction = NULL; BasisFunction_S.dInvFunction = NULL; BasisFunction_S.dPlusFunction = NULL; BasisFunction_S.SubFunction = NULL; BasisFunction_S.SubdFunction = NULL; BasisFunction_S.SupportIndex = -1; BasisFunction_S.EntityIndex = -1; } | BasisFunction BasisFunctionTerm ; BasisFunctionTerm : tName String__Index tEND { BasisFunction_S.Name = $2; } | tNameOfCoef String__Index tEND { Check_NameOfStructNotExist("NameOfCoef", Current_BasisFunction_L, $2, fcmp_BasisFunction_NameOfCoef); BasisFunction_S.NameOfCoef = $2; BasisFunction_S.Dimension = 1; } | tFunction tSTRING OptionalParametersForBasisFunction tEND { Get_3Function3NbrForString (BF_Function, $2, &FlagError, &BasisFunction_S.Function, &BasisFunction_S.dFunction, &BasisFunction_S.dInvFunction, &BasisFunction_S.Order, &BasisFunction_S.ElementType, &BasisFunction_S.Orient); if(FlagError){ Get_Valid_SX3F3N($2, BF_Function); vyyerror("Unknown Function for BasisFunction: %s", $2); } Free($2); } | tdFunction '{' tSTRING Comma tSTRING '}' tEND { void (*FunctionDummy)(); int i, j; double d; Get_3Function3NbrForString (BF_Function, $3, &FlagError, &BasisFunction_S.dFunction, &FunctionDummy, &FunctionDummy, &d, &i, &j); if(FlagError){ Get_Valid_SX3F3N($3, BF_Function); vyyerror("Unknown dFunction (1) for BasisFunction: %s", $3); } Free($3); Get_3Function3NbrForString (BF_Function, $5, &FlagError, &BasisFunction_S.dInvFunction, &FunctionDummy, &FunctionDummy, &d, &i, &j); if(FlagError){ Get_Valid_SX3F3N($5, BF_Function); vyyerror("Unknown dFunction (2) for BasisFunction: %s", $5); } Free($5); } | tdFunction '{' tSTRING Comma tSTRING Comma tSTRING '}' tEND { void (*FunctionDummy)(); int i, j; double d; Get_3Function3NbrForString (BF_Function, $3, &FlagError, &BasisFunction_S.dFunction, &FunctionDummy, &FunctionDummy, &d, &i, &j); if(FlagError){ Get_Valid_SX3F3N($3, BF_Function); vyyerror("Unknown dFunction (1) for BasisFunction: %s", $3); } Free($3); Get_3Function3NbrForString (BF_Function, $5, &FlagError, &BasisFunction_S.dInvFunction, &FunctionDummy, &FunctionDummy, &d, &i, &j); if(FlagError){ Get_Valid_SX3F3N($5, BF_Function); vyyerror("Unknown dFunction (2) for BasisFunction: %s", $5); } Free($5); Get_3Function3NbrForString (BF_Function, $7, &FlagError, &BasisFunction_S.dPlusFunction, &FunctionDummy, &FunctionDummy, &d, &i, &j); if(FlagError){ Get_Valid_SX3F3N($7, BF_Function); vyyerror("Unknown dFunction (3) for BasisFunction: %s", $7); } Free($7); } | tSubFunction ListOfExpression tEND { BasisFunction_S.SubFunction = List_Copy(ListOfInt_L); } | tSubdFunction ListOfExpression tEND { BasisFunction_S.SubdFunction = List_Copy(ListOfInt_L); } | tSupport GroupRHS tEND { BasisFunction_S.SupportIndex = Num_Group(&Group_S, (char*)"BF_Support", $2); } | tEntity GroupRHS tEND { BasisFunction_S.EntityIndex = Num_Group(&Group_S, (char*)"BF_Entity", $2); if(Group_S.InitialList) List_Sort(Group_S.InitialList, fcmp_Integer); /* Needed for Global Region */ if(BasisFunction_S.GlobalBasisFunction) { /* Function to be defined before Entity */ if(Group_S.FunctionType == GLOBAL) { if(List_Nbr(BasisFunction_S.GlobalBasisFunction) == List_Nbr(Group_S.InitialList)) { for(int k = 0; k < List_Nbr(Group_S.InitialList); k++) if(*((int*)List_Pointer(Group_S.InitialList, k)) != *((int*)List_Pointer(BasisFunction_S.GlobalBasisFunction, k))) { vyyerror("Bad correspondance between Group and Entity (elements differ)"); break; } } else if(List_Nbr(Group_S.InitialList) != 0 || GlobalBasisFunction_S.EntityIndex != -1) vyyerror("Bad correspondance between Group and Entity (#BF %d, #Global %d)", List_Nbr(BasisFunction_S.GlobalBasisFunction), List_Nbr(Group_S.InitialList)); } else vyyerror("Bad correspondance between Group and Entity (Entity must be Global)"); } } ; OptionalParametersForBasisFunction : /* none */ | '{' tQuantity tSTRING tEND tFormulation String__Index '{' FExpr '}' tEND tGroup GroupRHS tEND tResolution String__Index '{' FExpr '}' tEND '}' { int dim = $8; if(dim != $17) vyyerror("Number of formulations different from number of resolutions"); if(List_Nbr(Group_S.InitialList) != dim) vyyerror("Group sould have %d single regions", dim); BasisFunction_S.GlobalBasisFunction = List_Create(dim, 1, sizeof(struct GlobalBasisFunction)); for(int k = 0; k < dim; k++) { int i; List_Read(Group_S.InitialList, k, &i); GlobalBasisFunction_S.EntityIndex = i; char tmpstr[256]; sprintf(tmpstr, "%s_%d", $6, k+1); if((i = List_ISearchSeq(Problem_S.Formulation, tmpstr, fcmp_Formulation_Name)) >= 0) { GlobalBasisFunction_S.FormulationIndex = i; List_Read(Problem_S.Formulation, i, &Formulation_S); if((i = List_ISearchSeq(Formulation_S.DefineQuantity, $3, fcmp_DefineQuantity_Name)) >= 0) GlobalBasisFunction_S.DefineQuantityIndex = i; else { vyyerror("Unknown Quantity '%s' in Formulation '%s'", $3, Formulation_S.Name); break; } } else vyyerror("Unknown Formulation: %s", tmpstr); sprintf(tmpstr, "%s_%d", $15, k+1); if((i = List_ISearchSeq(Problem_S.Resolution, tmpstr, fcmp_Resolution_Name)) >= 0) GlobalBasisFunction_S.ResolutionIndex = i; else vyyerror("Unknown Resolution: %s", tmpstr); GlobalBasisFunction_S.QuantityStorage = NULL; List_Add(BasisFunction_S.GlobalBasisFunction, &GlobalBasisFunction_S); } List_Sort(BasisFunction_S.GlobalBasisFunction, fcmp_Integer); Free($3); Free($6); Free($15); } ; SubSpaces : /* none */ { $$ = Current_SubSpace_L = List_Create(6, 6, sizeof (struct SubSpace)); } | SubSpaces '{' SubSpace '}' { List_Add($$ = $1, &SubSpace_S); } ; SubSpace : /* none */ { SubSpace_S.Name = NULL; SubSpace_S.BasisFunction = NULL; } | SubSpace SubSpaceTerm ; SubSpaceTerm : tName tSTRING tEND { Check_NameOfStructNotExist("SubSpace", Current_SubSpace_L, $2, fcmp_SubSpace_Name); SubSpace_S.Name = $2; } | tNameOfBasisFunction ListOfBasisFunction tEND { SubSpace_S.BasisFunction = $2; } | tNameOfCoef ListOfBasisFunctionCoef tEND { SubSpace_S.BasisFunction = $2; } ; ListOfBasisFunction : tSTRING { $$ = List_Create(1, 1, sizeof(int)); int i; if((i = List_ISearchSeq(Current_BasisFunction_L, $1, fcmp_BasisFunction_Name)) < 0) vyyerror("Unknown BasisFunction: %s", $1); else { List_Add($$, &i); int j = i+1; while((i = List_ISearchSeqPartial(Current_BasisFunction_L, $1, j, fcmp_BasisFunction_Name)) >= 0) { List_Add($$, &i); j = i+1; /* for piecewise defined basis functions */ } } Free($1); } | '{' RecursiveListOfBasisFunction '}' { $$ = $2; } ; RecursiveListOfBasisFunction : /* none */ { $$ = List_Create(5, 5, sizeof(int)); } | RecursiveListOfBasisFunction Comma tSTRING { int i; if((i = List_ISearchSeq(Current_BasisFunction_L, $3, fcmp_BasisFunction_Name)) < 0) vyyerror("Unknown BasisFunction: %s", $3); else { List_Add($1, &i); int j = i+1; while((i = List_ISearchSeqPartial(Current_BasisFunction_L, $3, j, fcmp_BasisFunction_Name)) >= 0) { List_Add($1, &i); j = i+1; /* for piecewise defined basis functions */ } } $$ = $1; Free($3); } ; ListOfBasisFunctionCoef : tSTRING { $$ = List_Create(1, 1, sizeof(int)); int i; if((i = List_ISearchSeq(Current_BasisFunction_L, $1, fcmp_BasisFunction_NameOfCoef)) < 0) vyyerror("Unknown BasisFunctionCoef: %s", $1); else { List_Add($$, &i); } Free($1); } | '{' RecursiveListOfBasisFunctionCoef '}' { $$ = $2; } ; RecursiveListOfBasisFunctionCoef : /* none */ { $$ = List_Create(5, 5, sizeof(int)); } | RecursiveListOfBasisFunctionCoef Comma tSTRING { int i; if((i = List_ISearchSeq(Current_BasisFunction_L, $3, fcmp_BasisFunction_NameOfCoef)) < 0) vyyerror("Unknown BasisFunctionCoef: %s", $3); else { List_Add($1, &i); } $$ = $1; Free($3); } ; GlobalQuantities : /* none */ { $$ = Current_GlobalQuantity_L = List_Create(6, 6, sizeof (struct GlobalQuantity)); } | GlobalQuantities '{' GlobalQuantity '}' { GlobalQuantity_S.Num = Num_BasisFunction++; List_Add($$ = $1, &GlobalQuantity_S); } | GlobalQuantities Loop { $$ = $1; } ; GlobalQuantity : /* none */ { GlobalQuantity_S.Name = NULL; GlobalQuantity_S.Num = 0; GlobalQuantity_S.Type = ALIASOF; GlobalQuantity_S.ReferenceIndex = -1; } | GlobalQuantity GlobalQuantityTerm ; GlobalQuantityTerm : tName String__Index tEND { Check_NameOfStructNotExist("GlobalQuantity", Current_GlobalQuantity_L, $2, fcmp_GlobalQuantity_Name); GlobalQuantity_S.Name = $2; } | tType tSTRING tEND { GlobalQuantity_S.Type = Get_DefineForString(GlobalQuantity_Type, $2, &FlagError); if(FlagError){ Get_Valid_SXD($2, GlobalQuantity_Type); vyyerror("Unknown type of GlobalQuantity: %s", $2); } Free($2); } | tNameOfCoef String__Index tEND { int i; if((i = List_ISearchSeq(FunctionSpace_S.BasisFunction, $2, fcmp_BasisFunction_NameOfCoef)) < 0) vyyerror("Unknown NameOfCoef: %s", $2); else GlobalQuantity_S.ReferenceIndex = i; Free($2); } ; ConstraintInFSs : /* none */ { $$ = List_Create(6, 6, sizeof (struct ConstraintInFS)); } | ConstraintInFSs '{' ConstraintInFS '}' { Group_S.FunctionType = Type_Function; Group_S.SuppListType = Type_SuppList; switch (Group_S.FunctionType) { case ELEMENTSOF : Group_S.Type = ELEMENTLIST; break; default : Group_S.Type = REGIONLIST ; break; } if(Constraint_Index >= 0) { Constraint_P = (struct Constraint *) List_Pointer(Problem_S.Constraint, Constraint_Index); for(int i = 0; i < List_Nbr(Constraint_P->ConstraintPerRegion); i++) { ConstraintPerRegion_P = (struct ConstraintPerRegion *) List_Pointer(Constraint_P->ConstraintPerRegion, i); if(ConstraintPerRegion_P->RegionIndex >= 0) { Group_S.InitialList = ((struct Group *) List_Pointer(Problem_S.Group, ConstraintPerRegion_P->RegionIndex)) ->InitialList; Group_S.InitialSuppList = (ConstraintPerRegion_P->SubRegionIndex >= 0)? ((struct Group *) List_Pointer(Problem_S.Group, ConstraintPerRegion_P->SubRegionIndex)) ->InitialList : NULL; ConstraintInFS_S.EntityIndex = Add_Group(&Group_S, (char*)"CO_Entity", false, 1, 0); ConstraintInFS_S.ConstraintPerRegion = ConstraintPerRegion_P; List_Add($$ = $1, &ConstraintInFS_S); } } } } | ConstraintInFSs Loop { $$ = $1; } ; ConstraintInFS : /* none */ { ConstraintInFS_S.QuantityType = LOCALQUANTITY; ConstraintInFS_S.ReferenceIndex = -1; ConstraintInFS_S.EntityIndex = -1; ConstraintInFS_S.ConstraintPerRegion = NULL; ConstraintInFS_S.Active.ResolutionIndex = -1; ConstraintInFS_S.Active.Active = NULL; Constraint_Index = -1; } | ConstraintInFS ConstraintInFSTerm ; ConstraintInFSTerm : tNameOfCoef String__Index tEND { int i; if((i = List_ISearchSeq(FunctionSpace_S.BasisFunction, $2, fcmp_BasisFunction_NameOfCoef)) < 0) { if((i = List_ISearchSeq(FunctionSpace_S.GlobalQuantity, $2, fcmp_GlobalQuantity_Name)) < 0) vyyerror("Unknown NameOfCoef: %s", $2); else { ConstraintInFS_S.QuantityType = GLOBALQUANTITY; ConstraintInFS_S.ReferenceIndex = i; } } else { ConstraintInFS_S.QuantityType = LOCALQUANTITY; ConstraintInFS_S.ReferenceIndex = i; } Free($2); } | tEntityType FunctionForGroup tEND { Type_Function = $2; } | tEntitySubType SuppListTypeForGroup tEND { Type_SuppList = $2; } | tNameOfConstraint String__Index tEND { Constraint_Index = List_ISearchSeq(Problem_S.Constraint, $2, fcmp_Constraint_Name); if(Constraint_Index < 0) Message::Warning("Constraint '%s' is not provided", $2); Free($2); } ; /* ------------------------------------------------------------------------ */ /* F o r m u l a t i o n */ /* ------------------------------------------------------------------------ */ Formulations : /* none */ { if(!Problem_S.Formulation) Problem_S.Formulation = List_Create(10, 5, sizeof (struct Formulation)); } | Formulations BracedFormulation ; BracedFormulation : '{' Formulation '}' { List_Add(Problem_S.Formulation, &Formulation_S); } | Loop ; Formulation : /* none */ { Formulation_S.Name = NULL; Formulation_S.Type = FEMEQUATION; Formulation_S.DefineQuantity = NULL; Formulation_S.Equation = NULL; } | Formulation FormulationTerm ; FormulationTerm : tName String__Index tEND { Check_NameOfStructNotExist("Formulation", Problem_S.Formulation, $2, fcmp_Formulation_Name); Formulation_S.Name = $2; } | tType tSTRING tEND { Formulation_S.Type = Get_DefineForString(Formulation_Type, $2, &FlagError); if(FlagError){ Get_Valid_SXD($2, Formulation_Type); vyyerror("Unknown type of Formulation: %s", $2); } Free($2); } | tQuantity '{' DefineQuantities '}' | tSTRING '{' Equations '}' { Formulation_S.Equation = $3; Free($1); } ; DefineQuantities : /* none */ { Formulation_S.DefineQuantity = List_Create(6, 6, sizeof (struct DefineQuantity)); } | DefineQuantities '{' DefineQuantity '}' { List_Add(Formulation_S.DefineQuantity, &DefineQuantity_S); } | DefineQuantities Loop ; DefineQuantity : /* none */ { DefineQuantity_S.Name = NULL; DefineQuantity_S.Type = LOCALQUANTITY; DefineQuantity_S.IndexInFunctionSpace = NULL; DefineQuantity_S.FunctionSpaceIndex = -1; DefineQuantity_S.DofDataIndex = -1; DefineQuantity_S.DofData = NULL; DefineQuantity_S.FrequencySpectrum = NULL; DefineQuantity_S.IntegralQuantity.InIndex = -1; DefineQuantity_S.IntegralQuantity.IntegrationMethodIndex = -1; DefineQuantity_S.IntegralQuantity.JacobianMethodIndex = -1; DefineQuantity_S.IntegralQuantity.Symmetry = 0; DefineQuantity_S.IntegralQuantity.WholeQuantity = NULL; } | DefineQuantity DefineQuantityTerm ; DefineQuantityTerm : tName String__Index tEND { DefineQuantity_S.Name = $2; } | tType tGlobalQuantity tEND { DefineQuantity_S.Type = GLOBALQUANTITY; } /* Doit rester tant qu'on ne supprime pas l'association 'Integral <-> tGalerkin' */ | tType tGalerkin tEND { DefineQuantity_S.Type = INTEGRALQUANTITY; } | tType tSTRING tEND { DefineQuantity_S.Type = Get_DefineForString(DefineQuantity_Type, $2, &FlagError); if(FlagError){ Get_Valid_SXD($2, DefineQuantity_Type); vyyerror("Unknown type of Quantity: %s", $2); } Free($2); } | tFrequencySpectrum ListOfFExpr tEND { DefineQuantity_S.FrequencySpectrum = $2; } | tNameOfSpace String__Index { int i; if((i = List_ISearchSeq(Problem_S.FunctionSpace, $2, fcmp_FunctionSpace_Name)) < 0) vyyerror("Unknown FunctionSpace: %s", $2); else DefineQuantity_S.FunctionSpaceIndex = i; } IndexInFunctionSpace tEND { if(DefineQuantity_S.FunctionSpaceIndex >= 0) { if(DefineQuantity_S.Type == GLOBALQUANTITY && !DefineQuantity_S.IndexInFunctionSpace) { if(DefineQuantity_S.Name) { List_Read(Problem_S.FunctionSpace, DefineQuantity_S.FunctionSpaceIndex, &FunctionSpace_S); int i; if((i = List_ISearchSeq(FunctionSpace_S.GlobalQuantity, DefineQuantity_S.Name, fcmp_GlobalQuantity_Name)) < 0) { vyyerror("Unknown GlobalQuantity: %s", DefineQuantity_S.Name); } else { DefineQuantity_S.IndexInFunctionSpace = List_Create(1, 1, sizeof(int)); List_Add(DefineQuantity_S.IndexInFunctionSpace, &i); } } else vyyerror("No Name pre-defined for GlobalQuantity"); } } } | tIndexOfSystem FExpr tEND { DefineQuantity_S.DofDataIndex = (int)$2; } | '[' { Current_DofIndexInWholeQuantity = -1; Current_NoDofIndexInWholeQuantity = -1; List_Reset(ListOfPointer_L); } WholeQuantityExpression ']' tEND { DefineQuantity_S.IntegralQuantity.WholeQuantity = $3; DefineQuantity_S.IntegralQuantity.DofIndexInWholeQuantity = Current_DofIndexInWholeQuantity; WholeQuantity_P = (struct WholeQuantity*) List_Pointer(DefineQuantity_S.IntegralQuantity.WholeQuantity, 0); /* Ce qui suit ne suffit pas : il faudrait aussi gerer des Quantity_def sans Dof */ if(Current_DofIndexInWholeQuantity >= 0) { DefineQuantity_S.IntegralQuantity.TypeOperatorDof = (WholeQuantity_P+Current_DofIndexInWholeQuantity)-> Case.OperatorAndQuantity.TypeOperator; DefineQuantity_S.IntegralQuantity.DefineQuantityIndexDof = (WholeQuantity_P+Current_DofIndexInWholeQuantity)-> Case.OperatorAndQuantity.Index; DefineQuantity_S.FunctionSpaceIndex = ((struct DefineQuantity*) List_Pointer(Formulation_S.DefineQuantity, DefineQuantity_S.IntegralQuantity.DefineQuantityIndexDof))-> FunctionSpaceIndex; } else { /* No Dof{} */ DefineQuantity_S.IntegralQuantity.TypeOperatorDof = NOOP; DefineQuantity_S.IntegralQuantity.DefineQuantityIndexDof = -1; } if(Current_NoDofIndexInWholeQuantity >= 0) { DefineQuantity_S.IntegralQuantity.DefineQuantityIndexNoDof = (WholeQuantity_P+Current_NoDofIndexInWholeQuantity)-> Case.OperatorAndQuantity.Index; } else { /* No NoDof{} */ DefineQuantity_S.IntegralQuantity.DefineQuantityIndexNoDof = -1; } /* Check if the WholeQuantity is a Canonical Form */ DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_NONE; if(List_Nbr(DefineQuantity_S.IntegralQuantity.WholeQuantity) == 1){ /* GF_FUNCTION */ if((WholeQuantity_P+0)->Type == WQ_BUILTINFUNCTION) { Get_FunctionForFunction(GF_Function, (WholeQuantity_P+0)->Case.Function.Fct, &FlagError, &DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Fct); if(!FlagError){ DefineQuantity_S.IntegralQuantity.FunctionForCanonical.NbrParameters = (WholeQuantity_P+0)->Case.Function.NbrParameters; DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Para = (WholeQuantity_P+0)->Case.Function.Para; } DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_GF; } } else if(List_Nbr(DefineQuantity_S.IntegralQuantity.WholeQuantity) == 3){ /* GF_FUNCTION OPER DOF */ if ((WholeQuantity_P+0)->Type == WQ_BUILTINFUNCTION && (WholeQuantity_P+1)->Type == WQ_OPERATORANDQUANTITY && (WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR && Current_DofIndexInWholeQuantity == 1) { Get_FunctionForFunction(GF_Function, (WholeQuantity_P+0)->Case.Function.Fct, &FlagError, &DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Fct); if(!FlagError){ DefineQuantity_S.IntegralQuantity.FunctionForCanonical.NbrParameters = (WholeQuantity_P+0)->Case.Function.NbrParameters; DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Para = (WholeQuantity_P+0)->Case.Function.Para; } if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_TIME) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_GF_PSCA_DOF; if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_CROSSPRODUCT) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_GF_PVEC_DOF; } /* DOF OPER GF_FUNCTION */ else if((WholeQuantity_P+0)->Type == WQ_OPERATORANDQUANTITY && (WholeQuantity_P+1)->Type == WQ_BUILTINFUNCTION && (WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR && Current_DofIndexInWholeQuantity == 0) { Get_FunctionForFunction(GF_Function, (WholeQuantity_P+1)->Case.Function.Fct, &FlagError, &DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Fct); if(!FlagError){ DefineQuantity_S.IntegralQuantity.FunctionForCanonical.NbrParameters = (WholeQuantity_P+1)->Case.Function.NbrParameters; DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Para = (WholeQuantity_P+1)->Case.Function.Para; } if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_TIME) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_GF_PSCA_DOF;/* Scalar Prod Transitive */ if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_CROSSPRODUCT) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_DOF_PVEC_GF; } /* GF_FUNCTION OPER EXPR */ else if((WholeQuantity_P+0)->Type == WQ_BUILTINFUNCTION && (WholeQuantity_P+1)->Type == WQ_EXPRESSION && (WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR ) { Get_FunctionForFunction(GF_Function, (WholeQuantity_P+0)->Case.Function.Fct, &FlagError, &DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Fct); if(!FlagError){ DefineQuantity_S.IntegralQuantity.FunctionForCanonical.NbrParameters = (WholeQuantity_P+0)->Case.Function.NbrParameters; DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Para = (WholeQuantity_P+0)->Case.Function.Para; } DefineQuantity_S.IntegralQuantity.ExpressionIndexForCanonical = (WholeQuantity_P+1)->Case.Expression.Index; if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_TIME) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_GF_PSCA_EXP; if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_CROSSPRODUCT) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_GF_PVEC_EXP; /* DefineQuantity_S.IntegralQuantity.FunctionForCanonical.NbrParameters = (WholeQuantity_P+0)->Case.Function.NbrParameters; DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Para = (WholeQuantity_P+0)->Case.Function.Para; */ } /* EXPR OPER GF_FUNCTION */ else if((WholeQuantity_P+0)->Type == WQ_EXPRESSION && (WholeQuantity_P+1)->Type == WQ_BUILTINFUNCTION && (WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR ) { Get_FunctionForFunction(GF_Function, (WholeQuantity_P+1)->Case.Function.Fct, &FlagError, &DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Fct); if(!FlagError){ DefineQuantity_S.IntegralQuantity.FunctionForCanonical.NbrParameters = (WholeQuantity_P+1)->Case.Function.NbrParameters; DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Para = (WholeQuantity_P+1)->Case.Function.Para; } DefineQuantity_S.IntegralQuantity.ExpressionIndexForCanonical = (WholeQuantity_P+0)->Case.Expression.Index; if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_TIME) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_GF_PSCA_EXP;/* Transitive product */ if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_CROSSPRODUCT) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_EXP_PVEC_GF; } } else if(List_Nbr(DefineQuantity_S.IntegralQuantity.WholeQuantity) == 5){ /* EXPR OPER GF_FUNCTION OPER DOF */ if ((WholeQuantity_P+0)->Type == WQ_EXPRESSION && (WholeQuantity_P+1)->Type == WQ_BUILTINFUNCTION && (WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR && (WholeQuantity_P+3)->Type == WQ_OPERATORANDQUANTITY && (WholeQuantity_P+4)->Type == WQ_BINARYOPERATOR && Current_DofIndexInWholeQuantity == 3) { Get_FunctionForFunction(GF_Function, (WholeQuantity_P+1)->Case.Function.Fct, &FlagError, &DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Fct); if(!FlagError){ DefineQuantity_S.IntegralQuantity.FunctionForCanonical.NbrParameters = (WholeQuantity_P+1)->Case.Function.NbrParameters; DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Para = (WholeQuantity_P+1)->Case.Function.Para; } DefineQuantity_S.IntegralQuantity.ExpressionIndexForCanonical = (WholeQuantity_P+0)->Case.Expression.Index; if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_TIME){ if((WholeQuantity_P+4)->Case.Operator.TypeOperator == OP_TIME) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_EXP_TIME_GF_PSCA_DOF; if((WholeQuantity_P+4)->Case.Operator.TypeOperator == OP_CROSSPRODUCT) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_EXP_TIME_GF_PVEC_DOF; } else if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_CROSSPRODUCT){ if((WholeQuantity_P+4)->Case.Operator.TypeOperator == OP_TIME) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_EXP_PVEC_GF_PSCA_DOF; if((WholeQuantity_P+4)->Case.Operator.TypeOperator == OP_CROSSPRODUCT) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_EXP_PVEC_GF_PVEC_DOF; } } /* FCT OPER GF_FUNCTION OPER DOF */ else if((WholeQuantity_P+0)->Type == WQ_BUILTINFUNCTION && (WholeQuantity_P+1)->Type == WQ_BUILTINFUNCTION && (WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR && (WholeQuantity_P+3)->Type == WQ_OPERATORANDQUANTITY && (WholeQuantity_P+4)->Type == WQ_BINARYOPERATOR && Current_DofIndexInWholeQuantity == 3) { Get_FunctionForFunction(GF_Function, (WholeQuantity_P+1)->Case.Function.Fct, &FlagError, &DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Fct); if(!FlagError){ DefineQuantity_S.IntegralQuantity.FunctionForCanonical.NbrParameters = (WholeQuantity_P+1)->Case.Function.NbrParameters; DefineQuantity_S.IntegralQuantity.FunctionForCanonical.Para = (WholeQuantity_P+1)->Case.Function.Para; } DefineQuantity_S.IntegralQuantity.AnyFunction.Fct = (WholeQuantity_P+0)->Case.Function.Fct; DefineQuantity_S.IntegralQuantity.AnyFunction.NbrParameters = (WholeQuantity_P+0)->Case.Function.NbrParameters; DefineQuantity_S.IntegralQuantity.AnyFunction.Para = (WholeQuantity_P+0)->Case.Function.Para; if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_TIME){ if((WholeQuantity_P+4)->Case.Operator.TypeOperator == OP_TIME) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_FCT_TIME_GF_PSCA_DOF; if((WholeQuantity_P+4)->Case.Operator.TypeOperator == OP_CROSSPRODUCT) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_FCT_TIME_GF_PVEC_DOF; } else if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_CROSSPRODUCT){ if((WholeQuantity_P+4)->Case.Operator.TypeOperator == OP_TIME) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_FCT_PVEC_GF_PSCA_DOF; if((WholeQuantity_P+4)->Case.Operator.TypeOperator == OP_CROSSPRODUCT) DefineQuantity_S.IntegralQuantity.CanonicalWholeQuantity = CWQ_FCT_PVEC_GF_PVEC_DOF; } } } Pro_DefineQuantityIndex (DefineQuantity_S.IntegralQuantity.WholeQuantity, -1, &DefineQuantity_S.IntegralQuantity.NbrQuantityIndex, &DefineQuantity_S.IntegralQuantity.QuantityIndexTable, &DefineQuantity_S.IntegralQuantity.QuantityTraceGroupIndexTable); if(DefineQuantity_S.IntegralQuantity.NbrQuantityIndex > 1) vyyerror("More than one LocalQuantity in IntegralQuantity"); } | tIn GroupRHS tEND { DefineQuantity_S.IntegralQuantity.InIndex = Num_Group(&Group_S, (char*)"IQ_In", $2); } | tIntegration tSTRING tEND { int i; if((i = List_ISearchSeq(Problem_S.IntegrationMethod, $2, fcmp_IntegrationMethod_Name)) < 0) vyyerror("Unknown Integration method: %s", $2); else DefineQuantity_S.IntegralQuantity.IntegrationMethodIndex = i; Free($2); } | tJacobian String__Index tEND { int i; if((i = List_ISearchSeq(Problem_S.JacobianMethod, $2, fcmp_JacobianMethod_Name)) < 0) vyyerror("Unknown Jacobian method: %s", $2); else DefineQuantity_S.IntegralQuantity.JacobianMethodIndex = i; Free($2); } | tSymmetry tINT tEND { DefineQuantity_S.IntegralQuantity.Symmetry = $2; } ; IndexInFunctionSpace : /* none */ | '[' String__Index ']' { if(DefineQuantity_S.FunctionSpaceIndex >= 0) { if(DefineQuantity_S.Type == LOCALQUANTITY) { int i; if((i = List_ISearchSeq (((struct FunctionSpace *) List_Pointer(Problem_S.FunctionSpace, DefineQuantity_S.FunctionSpaceIndex))->SubSpace, $2, fcmp_SubSpace_Name)) < 0) vyyerror("Unknown SubSpace: %s", $2); else { DefineQuantity_S.IndexInFunctionSpace = ((struct SubSpace *) List_Pointer (((struct FunctionSpace *) List_Pointer(Problem_S.FunctionSpace, DefineQuantity_S.FunctionSpaceIndex))->SubSpace, i)) ->BasisFunction; } } else if(DefineQuantity_S.Type == GLOBALQUANTITY) { List_Read(Problem_S.FunctionSpace, DefineQuantity_S.FunctionSpaceIndex, &FunctionSpace_S); int i; if((i = List_ISearchSeq(FunctionSpace_S.GlobalQuantity, $2, fcmp_GlobalQuantity_Name)) < 0) { vyyerror("Unknown GlobalQuantity: %s", $2); } else { DefineQuantity_S.IndexInFunctionSpace = List_Create(1, 1, sizeof(int)); List_Add(DefineQuantity_S.IndexInFunctionSpace, &i); } } } Free($2); } ; Equations : /* none */ { $$ = List_Create(6, 6, sizeof(struct EquationTerm)); } | Equations EquationTerm { List_Add($$ = $1, &EquationTerm_S); } | Equations Loop { $$ = $1; } ; EquationTerm : tGalerkin '{' LocalTerm '}' { EquationTerm_S.Type = GALERKIN; } | tdeRham '{' LocalTerm '}' { EquationTerm_S.Type = DERHAM; } | tGlobalTerm '{' GlobalTerm '}' { EquationTerm_S.Type = GLOBALTERM; } | tGlobalEquation '{' GlobalEquation '}' { EquationTerm_S.Type = GLOBALEQUATION; } ; GlobalEquation : /* none */ { EquationTerm_S.Case.GlobalEquation.Type = NETWORK; EquationTerm_S.Case.GlobalEquation.ConstraintIndex = -1; EquationTerm_S.Case.GlobalEquation.GlobalEquationTerm = NULL; } | GlobalEquation GlobalEquationTerm ; GlobalEquationTerm : tType tSTRING tEND { EquationTerm_S.Case.GlobalEquation.Type = Get_DefineForString(Constraint_Type, $2, &FlagError); if(FlagError){ Get_Valid_SXD($2, Constraint_Type); vyyerror("Unknown type of GlobalEquation: %s", $2); } Free($2); } | tNameOfConstraint tSTRING tEND { int i; if((i = List_ISearchSeq(Problem_S.Constraint, $2, fcmp_Constraint_Name)) >= 0) EquationTerm_S.Case.GlobalEquation.ConstraintIndex = i; else EquationTerm_S.Case.GlobalEquation.ConstraintIndex = -1; Free($2); } | '{' GlobalEquationTermTerm '}' { if(!EquationTerm_S.Case.GlobalEquation.GlobalEquationTerm) EquationTerm_S.Case.GlobalEquation.GlobalEquationTerm = List_Create(3, 3, sizeof(struct GlobalEquationTerm)); List_Add(EquationTerm_S.Case.GlobalEquation.GlobalEquationTerm, &GlobalEquationTerm_S); } ; GlobalEquationTermTerm : /* none */ { GlobalEquationTerm_S.DefineQuantityIndexNode = -1; GlobalEquationTerm_S.DefineQuantityIndexLoop = -1; GlobalEquationTerm_S.DefineQuantityIndexEqu = -1; GlobalEquationTerm_S.InIndex = -1; } | GlobalEquationTermTerm GlobalEquationTermTermTerm ; GlobalEquationTermTermTerm : tSTRING Quantity_Def tEND { if(!strcmp($1, "Node")) GlobalEquationTerm_S.DefineQuantityIndexNode = $2.Int2; else if(!strcmp($1, "Loop")) GlobalEquationTerm_S.DefineQuantityIndexLoop = $2.Int2; else if(!strcmp($1, "Equation")) GlobalEquationTerm_S.DefineQuantityIndexEqu = $2.Int2; else vyyerror("Unknown global equation term: %s", $1); Free($1); } | tIn GroupRHS tEND { GlobalEquationTerm_S.InIndex = Num_Group(&Group_S, (char*)"FO_In", $2); } ; LocalTerm : /* none */ { EquationTerm_S.Case.LocalTerm.Term.TypeTimeDerivative = NODT_; EquationTerm_S.Case.LocalTerm.Term.TypeOperatorEqu = NOOP; EquationTerm_S.Case.LocalTerm.Term.TypeOperatorDof = NOOP; EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexEqu = -1; EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexDof = -1; EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexNoDof = -1; EquationTerm_S.Case.LocalTerm.Term.WholeQuantity = NULL; EquationTerm_S.Case.LocalTerm.Term.DofIndexInWholeQuantity = -1; EquationTerm_S.Case.LocalTerm.Term.DofInTrace = 0; EquationTerm_S.Case.LocalTerm.InIndex = -1; EquationTerm_S.Case.LocalTerm.IntegrationMethodIndex = -1; EquationTerm_S.Case.LocalTerm.MatrixIndex = -1; EquationTerm_S.Case.LocalTerm.JacobianMethodIndex = -1; EquationTerm_S.Case.LocalTerm.ExpressionIndexForMetricTensor = -1; EquationTerm_S.Case.LocalTerm.Active = NULL; EquationTerm_S.Case.LocalTerm.Full_Matrix = 0; } | LocalTerm LocalTermTerm ; LocalTermTerm : TermOperator '[' { EquationTerm_S.Case.LocalTerm.Term.TypeTimeDerivative = Type_TermOperator; Current_DofIndexInWholeQuantity = -1; Current_NoDofIndexInWholeQuantity = -1; List_Reset(ListOfPointer_L); } WholeQuantityExpression { EquationTerm_S.Case.LocalTerm.Term.WholeQuantity = $4; EquationTerm_S.Case.LocalTerm.Term.DofIndexInWholeQuantity = Current_DofIndexInWholeQuantity; WholeQuantity_P = (struct WholeQuantity*) List_Pointer(EquationTerm_S.Case.LocalTerm.Term.WholeQuantity, 0); if(Current_DofIndexInWholeQuantity == -4){ EquationTerm_S.Case.LocalTerm.Term.DofInTrace = 1; EquationTerm_S.Case.LocalTerm.Term.TypeOperatorDof = TypeOperatorDofInTrace; EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexDof = DefineQuantityIndexDofInTrace; } else if(Current_DofIndexInWholeQuantity >= 0) { EquationTerm_S.Case.LocalTerm.Term.TypeOperatorDof = (WholeQuantity_P+Current_DofIndexInWholeQuantity)-> Case.OperatorAndQuantity.TypeOperator; EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexDof = (WholeQuantity_P+Current_DofIndexInWholeQuantity)-> Case.OperatorAndQuantity.Index; } else { /* No Dof{} */ EquationTerm_S.Case.LocalTerm.Term.TypeOperatorDof = NOOP; EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexDof = -1; } if(Current_NoDofIndexInWholeQuantity >= 0) { EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexNoDof = (WholeQuantity_P+Current_NoDofIndexInWholeQuantity)-> Case.OperatorAndQuantity.Index; } else { /* No NoDof{} */ EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexNoDof = -1; } /* Check if the WholeQuantity is a Canonical Form of type 'expr[] * Dof{}'*/ if((List_Nbr(EquationTerm_S.Case.LocalTerm.Term.WholeQuantity) == 3) && ((WholeQuantity_P+0)->Type == WQ_EXPRESSION) && ((WholeQuantity_P+1)->Type == WQ_OPERATORANDQUANTITY) && ((WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR) && ((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_TIME) && (Current_DofIndexInWholeQuantity == 1)) { EquationTerm_S.Case.LocalTerm.Term.CanonicalWholeQuantity = CWQ_EXP_TIME_DOF; EquationTerm_S.Case.LocalTerm.Term.ExpressionIndexForCanonical = (WholeQuantity_P+0)->Case.Expression.Index; } else if((List_Nbr(EquationTerm_S.Case.LocalTerm.Term.WholeQuantity) == 3) && ((WholeQuantity_P+0)->Type == WQ_BUILTINFUNCTION) && ((WholeQuantity_P+1)->Type == WQ_OPERATORANDQUANTITY) && ((WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR) && (Current_DofIndexInWholeQuantity == 1)) { if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_TIME) EquationTerm_S.Case.LocalTerm.Term.CanonicalWholeQuantity = CWQ_FCT_TIME_DOF; if((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_CROSSPRODUCT) EquationTerm_S.Case.LocalTerm.Term.CanonicalWholeQuantity = CWQ_FCT_PVEC_DOF; EquationTerm_S.Case.LocalTerm.Term.FunctionForCanonical.Fct = (WholeQuantity_P+0)->Case.Function.Fct; EquationTerm_S.Case.LocalTerm.Term.FunctionForCanonical.NbrParameters = (WholeQuantity_P+0)->Case.Function.NbrParameters; EquationTerm_S.Case.LocalTerm.Term.FunctionForCanonical.Para = (WholeQuantity_P+0)->Case.Function.Para; } else if((List_Nbr(EquationTerm_S.Case.LocalTerm.Term.WholeQuantity) == 1) && ((WholeQuantity_P+0)->Type == WQ_OPERATORANDQUANTITY) && (Current_DofIndexInWholeQuantity == 0)) { EquationTerm_S.Case.LocalTerm.Term.CanonicalWholeQuantity = CWQ_DOF; } else { EquationTerm_S.Case.LocalTerm.Term.CanonicalWholeQuantity = CWQ_NONE; } } ',' WholeQuantityExpression ']' tEND { EquationTerm_S.Case.LocalTerm.Term.TypeOperatorEqu = Quantity_TypeOperator; EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexEqu = Quantity_Index; EquationTerm_S.Case.LocalTerm.Term.CanonicalWholeQuantity_Equ = CWQ_NONE; WholeQuantity_P = (struct WholeQuantity*) List_Pointer($7, 0); if(List_Nbr($7) == 1){ if((WholeQuantity_P+0)->Type != WQ_OPERATORANDQUANTITY) vyyerror("Missing Quantity in Equation"); } else if(List_Nbr($7) == 3 && ((WholeQuantity_P+0)->Type == WQ_EXPRESSION && (WholeQuantity_P+1)->Type == WQ_OPERATORANDQUANTITY && (WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR)) { // FIXME: should also add the case (BUILTINFUNCTION OPERATORANDQUANTITY BINARYOPERATOR) EquationTerm_S.Case.LocalTerm.Term.CanonicalWholeQuantity_Equ = CWQ_EXP_TIME_DOF; EquationTerm_S.Case.LocalTerm.Term.ExpressionIndexForCanonical_Equ = (WholeQuantity_P+0)->Case.Expression.Index; EquationTerm_S.Case.LocalTerm.Term.OperatorTypeForCanonical_Equ = (WholeQuantity_P+2)->Case.Operator.TypeOperator; } else if(List_Nbr($7) == 2 && ((WholeQuantity_P+0)->Type == WQ_OPERATORANDQUANTITY && (WholeQuantity_P+1)->Type == WQ_BUILTINFUNCTION)) { EquationTerm_S.Case.LocalTerm.Term.CanonicalWholeQuantity_Equ = CWQ_FCT_DOF; EquationTerm_S.Case.LocalTerm.Term.BuiltInFunction_Equ = (WholeQuantity_P+1)->Case.Function.Fct; } else{ vyyerror("Unrecognized quantity structure in Equation"); } Pro_DefineQuantityIndex (EquationTerm_S.Case.LocalTerm.Term.WholeQuantity, EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexEqu, &EquationTerm_S.Case.LocalTerm.Term.NbrQuantityIndex, &EquationTerm_S.Case.LocalTerm.Term.QuantityIndexTable, &EquationTerm_S.Case.LocalTerm.Term.QuantityTraceGroupIndexTable); EquationTerm_S.Case.LocalTerm.Term.QuantityIndexPost = 0; for(int i = 0; i < EquationTerm_S.Case.LocalTerm.Term.NbrQuantityIndex; i++) { if((EquationTerm_S.Case.LocalTerm.Term.QuantityIndexTable[i] != EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexEqu) && (EquationTerm_S.Case.LocalTerm.Term.QuantityIndexTable[i] != EquationTerm_S.Case.LocalTerm.Term.DefineQuantityIndexDof)) { EquationTerm_S.Case.LocalTerm.Term.QuantityIndexPost = 1; break; } } } | tIn GroupRHS tEND { EquationTerm_S.Case.LocalTerm.InIndex = Num_Group(&Group_S, (char*)"FO_In", $2); } | tJacobian String__Index tEND { int i; if((i = List_ISearchSeq(Problem_S.JacobianMethod, $2, fcmp_JacobianMethod_Name)) < 0) vyyerror("Unknown Jacobian method: %s",$2); else EquationTerm_S.Case.LocalTerm.JacobianMethodIndex = i; Free($2); } | tIntegration tSTRING tEND { int i; if((i = List_ISearchSeq(Problem_S.IntegrationMethod, $2, fcmp_IntegrationMethod_Name)) < 0) vyyerror("Unknown Integration method: %s", $2); else EquationTerm_S.Case.LocalTerm.IntegrationMethodIndex = i; Free($2); } | tFull_Matrix tEND { EquationTerm_S.Case.LocalTerm.Full_Matrix = 1; } | tSTRING '[' tINT ']' tEND { if($3 == 1 || $3 == 2 || $3 == 3) EquationTerm_S.Case.LocalTerm.MatrixIndex = $3; else vyyerror("Unknown Matrix123: %d", $3); } | tMetricTensor Expression tEND { EquationTerm_S.Case.LocalTerm.ExpressionIndexForMetricTensor = $2; } ; GlobalTerm : /* none */ { EquationTerm_S.Case.GlobalTerm.TypeTimeDerivative = NODT_; EquationTerm_S.Case.GlobalTerm.DefineQuantityIndex = -1; EquationTerm_S.Case.GlobalTerm.Term.TypeTimeDerivative = NODT_; EquationTerm_S.Case.GlobalTerm.Term.TypeOperatorEqu = NOOP; EquationTerm_S.Case.GlobalTerm.Term.TypeOperatorDof = NOOP; EquationTerm_S.Case.GlobalTerm.Term.DefineQuantityIndexEqu = -1; EquationTerm_S.Case.GlobalTerm.Term.DefineQuantityIndexDof = -1; EquationTerm_S.Case.GlobalTerm.Term.DefineQuantityIndexNoDof = -1; EquationTerm_S.Case.GlobalTerm.Term.WholeQuantity = NULL; EquationTerm_S.Case.GlobalTerm.Term.DofIndexInWholeQuantity = -1; EquationTerm_S.Case.GlobalTerm.InIndex = -1; } | GlobalTerm GlobalTermTerm ; GlobalTermTerm : tIn GroupRHS tEND { EquationTerm_S.Case.GlobalTerm.InIndex = Num_Group(&Group_S, (char*)"FO_In", $2); } | TermOperator '[' { EquationTerm_S.Case.GlobalTerm.Term.TypeTimeDerivative = Type_TermOperator; Current_DofIndexInWholeQuantity = -1; Current_NoDofIndexInWholeQuantity = -1; List_Reset(ListOfPointer_L); } WholeQuantityExpression { EquationTerm_S.Case.GlobalTerm.Term.WholeQuantity = $4; EquationTerm_S.Case.GlobalTerm.Term.DofIndexInWholeQuantity = Current_DofIndexInWholeQuantity; WholeQuantity_P = (struct WholeQuantity*) List_Pointer(EquationTerm_S.Case.GlobalTerm.Term.WholeQuantity, 0); if(Current_DofIndexInWholeQuantity >= 0) { EquationTerm_S.Case.GlobalTerm.Term.TypeOperatorDof = (WholeQuantity_P+Current_DofIndexInWholeQuantity)-> Case.OperatorAndQuantity.TypeOperator; EquationTerm_S.Case.GlobalTerm.Term.DefineQuantityIndexDof = (WholeQuantity_P+Current_DofIndexInWholeQuantity)-> Case.OperatorAndQuantity.Index; } else { /* No Dof{} */ EquationTerm_S.Case.GlobalTerm.Term.TypeOperatorDof = NOOP; EquationTerm_S.Case.GlobalTerm.Term.DefineQuantityIndexDof = -1; } if(Current_NoDofIndexInWholeQuantity >= 0) { EquationTerm_S.Case.GlobalTerm.Term.DefineQuantityIndexNoDof = (WholeQuantity_P+Current_NoDofIndexInWholeQuantity)-> Case.OperatorAndQuantity.Index; } else { /* No NoDof{} */ EquationTerm_S.Case.GlobalTerm.Term.DefineQuantityIndexNoDof = -1; } /* Check if the WholeQuantity is a Canonical Form of type 'expr[] * Dof{}'*/ if((List_Nbr(EquationTerm_S.Case.GlobalTerm.Term.WholeQuantity) == 3) && ((WholeQuantity_P+0)->Type == WQ_EXPRESSION) && ((WholeQuantity_P+1)->Type == WQ_OPERATORANDQUANTITY) && ((WholeQuantity_P+2)->Type == WQ_BINARYOPERATOR) && ((WholeQuantity_P+2)->Case.Operator.TypeOperator == OP_TIME) && (Current_DofIndexInWholeQuantity == 1)) { EquationTerm_S.Case.GlobalTerm.Term.CanonicalWholeQuantity = CWQ_EXP_TIME_DOF; EquationTerm_S.Case.GlobalTerm.Term.ExpressionIndexForCanonical = (WholeQuantity_P+0)->Case.Expression.Index; } else if((List_Nbr(EquationTerm_S.Case.GlobalTerm.Term.WholeQuantity) == 1) && ((WholeQuantity_P+0)->Type == WQ_OPERATORANDQUANTITY) && (Current_DofIndexInWholeQuantity == 0)) { EquationTerm_S.Case.GlobalTerm.Term.CanonicalWholeQuantity = CWQ_DOF; } else { EquationTerm_S.Case.GlobalTerm.Term.CanonicalWholeQuantity = CWQ_NONE; } } ',' Quantity_Def ']' tEND { EquationTerm_S.Case.GlobalTerm.Term.TypeOperatorEqu = $7.Int1; EquationTerm_S.Case.GlobalTerm.Term.DefineQuantityIndexEqu = $7.Int2; Pro_DefineQuantityIndex (EquationTerm_S.Case.GlobalTerm.Term.WholeQuantity, EquationTerm_S.Case.GlobalTerm.Term.DefineQuantityIndexEqu, &EquationTerm_S.Case.GlobalTerm.Term.NbrQuantityIndex, &EquationTerm_S.Case.GlobalTerm.Term.QuantityIndexTable, &EquationTerm_S.Case.GlobalTerm.Term.QuantityTraceGroupIndexTable); } ; TermOperator : /* none */ { Type_TermOperator = NODT_ ; } | tDt { Type_TermOperator = DT_ ; } | tDtDof { Type_TermOperator = DTDOF_ ; } | tDtDt { Type_TermOperator = DTDT_ ; } | tDtDtDof { Type_TermOperator = DTDTDOF_ ; } | tDtDtDtDof { Type_TermOperator = DTDTDTDOF_ ; } | tDtDtDtDtDof { Type_TermOperator = DTDTDTDTDOF_ ; } | tDtDtDtDtDtDof { Type_TermOperator = DTDTDTDTDTDOF_ ; } | tJacNL { Type_TermOperator = JACNL_ ; } | tDtDofJacNL { Type_TermOperator = DTDOFJACNL_ ; } | tNeverDt { Type_TermOperator = NEVERDT_ ; } | tDtNL { Type_TermOperator = DTNL_ ; } ; Quantity_Def : '{' tSTRING String__Index '}' { $$.Int1 = Get_DefineForString(Operator_Type, $2, &FlagError); if(FlagError){ Get_Valid_SXD($2, Operator_Type); vyyerror("Unknown Operator for discrete Quantity: %s", $2); } Free($2); int i; if((i = List_ISearchSeq(Formulation_S.DefineQuantity, $3, fcmp_DefineQuantity_Name)) < 0) vyyerror("Unknown discrete Quantity: %s", $3); $$.Int2 = i; /* the following should be suppressed as soon as the test function part in the formulations is correctly treated */ Quantity_TypeOperator = $$.Int1; Quantity_Index = $$.Int2; Free($3); } | '{' String__Index '}' { $$.Int1 = NOOP; int i; if((i = List_ISearchSeq(Formulation_S.DefineQuantity, $2, fcmp_DefineQuantity_Name)) < 0) vyyerror("Unknown discrete Quantity: %s", $2); $$.Int2 = i; /* the following should be suppressed as soon as the test function part in the formulations is correctly treated */ Quantity_TypeOperator = $$.Int1; Quantity_Index = $$.Int2; Free($2); } ; /* ------------------------------------------------------------------------ */ /* R e s o l u t i o n */ /* ------------------------------------------------------------------------ */ Resolutions : /* none */ { if(!Problem_S.Resolution) Problem_S.Resolution = List_Create(10, 5, sizeof (struct Resolution)); } | Resolutions BracedResolution ; BracedResolution : '{' Resolution '}' { List_Add(Problem_S.Resolution, &Resolution_S); } | Loop ; Resolution : /* none */ { Resolution_S.Name = NULL; Resolution_S.Hidden = false; Resolution_S.DefineSystem = NULL; Resolution_S.Operation = NULL; } | Resolution ResolutionTerm ; ResolutionTerm : tName String__Index tEND { Check_NameOfStructNotExist("Resolution", Problem_S.Resolution, $2, fcmp_Resolution_Name); Resolution_S.Name = $2; } | tHidden FExpr tEND { Resolution_S.Hidden = $2 ? true : false; } | tDefineSystem '{' DefineSystems '}' { Resolution_S.DefineSystem = $3; } | tOperation { Operation_L = List_Create(5, 5, sizeof(struct Operation)); } '{' Operation '}' { Resolution_S.Operation = $4; List_Delete(Operation_L); } | Loop ; DefineSystems : /* none */ { $$ = Current_System_L = List_Create(6, 6, sizeof (struct DefineSystem)); } | DefineSystems '{' DefineSystem '}' { int i ; if ((i = List_ISearchSeq(Current_System_L, DefineSystem_S.Name, fcmp_DefineSystem_Name)) < 0) List_Add($$ = Current_System_L = $1, &DefineSystem_S) ; else List_Write(Current_System_L, i, &DefineSystem_S) ; } | DefineSystems Loop { $$ = $1; } ; DefineSystem : /* none */ { DefineSystem_S.Name = NULL; DefineSystem_S.Type = VAL_REAL; DefineSystem_S.FormulationIndex = NULL; DefineSystem_S.MeshName = NULL; DefineSystem_S.AdaptName = NULL; DefineSystem_S.FrequencyValue = NULL; DefineSystem_S.SolverDataFileName = NULL; DefineSystem_S.OriginSystemIndex = NULL; DefineSystem_S.DestinationSystemName = NULL; DefineSystem_S.DestinationSystemIndex = -1; } | DefineSystem DefineSystemTerm ; DefineSystemTerm : tName String__Index tEND { int i; if ((i = List_ISearchSeq(Current_System_L, $2, fcmp_DefineSystem_Name)) < 0) DefineSystem_S.Name = $2 ; else List_Read(Current_System_L, i, &DefineSystem_S) ; } | tType tSTRING tEND { DefineSystem_S.Type = Get_DefineForString(DefineSystem_Type, $2, &FlagError); if(FlagError){ Get_Valid_SXD($2, DefineSystem_Type); vyyerror("Unknown type of System: %s", $2); } Free($2); } | tNameOfFormulation ListOfFormulation tEND { DefineSystem_S.FormulationIndex = $2; } | tNameOfMesh CharExpr tEND { DefineSystem_S.MeshName = strSave(Fix_RelativePath($2).c_str()); Free($2); } | tOriginSystem ListOfSystem tEND { if (!DefineSystem_S.OriginSystemIndex) { DefineSystem_S.OriginSystemIndex = $2 ; } else { for (int i = 0 ; i < List_Nbr($2) ; i++) List_Add(DefineSystem_S.OriginSystemIndex, (int *)List_Pointer($2, i) ) ; } } | tDestinationSystem String__Index tEND { DefineSystem_S.DestinationSystemName = $2; } | tFrequency ListOfFExpr tEND { DefineSystem_S.FrequencyValue = $2; DefineSystem_S.Type = VAL_COMPLEX; } | tSolver CharExpr tEND { DefineSystem_S.SolverDataFileName = $2; } | Loop ; ListOfFormulation : String__Index { $$ = List_Create(1, 1, sizeof(int)); int i; if((i = List_ISearchSeq(Problem_S.Formulation, $1, fcmp_Formulation_Name)) < 0) vyyerror("Unknown Formulation: %s", $1); else List_Add($$, &i); Free($1); } | '{' RecursiveListOfFormulation '}' { $$ = $2; } ; RecursiveListOfFormulation : /* none */ { $$ = List_Create(2, 2, sizeof(int)); } | RecursiveListOfFormulation Comma String__Index { int i; if((i = List_ISearchSeq(Problem_S.Formulation, $3, fcmp_Formulation_Name)) < 0) vyyerror("Unknown Formulation: %s", $3); else List_Add($1, &i); $$ = $1; Free($3); } ; ListOfSystem : String__Index { $$ = List_Create(1, 1, sizeof(int)); int i; if((i = List_ISearchSeq(Current_System_L, $1, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $1); else List_Add($$, &i); Free($1); } | '{' RecursiveListOfSystem '}' { $$ = $2; } ; RecursiveListOfSystem : /* none */ { $$ = List_Create(2, 2, sizeof(int)); } | RecursiveListOfSystem Comma String__Index { int i; if((i = List_ISearchSeq(Current_System_L, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); else List_Add($1, &i); $$ = $1; Free($3); } ; Operation : /* none */ { $$ = List_Create(6, 6, sizeof (struct Operation)); Operation_S.Type = OPERATION_NONE; Operation_S.DefineSystemIndex = -1; Operation_S.Flag = -1; List_Add(Operation_L, &Operation_S); } | Operation OperationTerm { if(((struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1))->Type != OPERATION_NONE){ List_Add($$ = $1, (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1)); } } ; CommaFExprOrNothing : { $$ = -1; } | ',' FExpr { $$ = (int)$2; } ; GmshOperation : tGmshRead { $$ = OPERATION_GMSHREAD; } | tGmshOpen { $$ = OPERATION_GMSHOPEN; } | tGmshMerge { $$ = OPERATION_GMSHMERGE; } | tGmshWrite { $$ = OPERATION_GMSHWRITE; } GenerateGroupOperation : tGenerateGroup { $$ = OPERATION_GENERATE; } | tGenerateJacGroup { $$ = OPERATION_GENERATEJAC; } | tGenerateRHSGroup { $$ = OPERATION_GENERATERHS; } | tGenerateGroupCumulative { $$ = OPERATION_GENERATE_CUMULATIVE; } | tGenerateJacGroupCumulative { $$ = OPERATION_GENERATEJAC_CUMULATIVE; } | tGenerateRHSGroupCumulative { $$ = OPERATION_GENERATERHS_CUMULATIVE; } OperationTerm : /* OLD syntax */ tSTRING String__Index tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = Get_DefineForString(Operation_Type, $1, &FlagError); if(FlagError){ Get_Valid_SXD($1, Operation_Type); vyyerror("Unknown type of Operation: %s", $1); } Free($1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $2, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $2); Free($2); Operation_P->DefineSystemIndex = i; if(Operation_P->Type == OPERATION_GENERATE || Operation_P->Type == OPERATION_GENERATERHS || Operation_P->Type == OPERATION_GENERATEJAC || Operation_P->Type == OPERATION_GENERATESEPARATE) Operation_P->Case.Generate.GroupIndex = -1; } | tSetTime Expression tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SETTIME; Operation_P->Case.SetTime.ExpressionIndex = $2; } | tSetTimeStep Expression tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SETTIMESTEP; Operation_P->Case.SetTime.ExpressionIndex = $2; } | tTimeLoopTheta '{' TimeLoopTheta '}' { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_TIMELOOPTHETA; } | tTimeLoopNewmark '{' TimeLoopNewmark '}' { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_TIMELOOPNEWMARK; } | tIterativeLoop '{' IterativeLoop '}' { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_ITERATIVELOOP; } | tIterativeTimeReduction '{' IterativeTimeReduction '}' { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_ITERATIVETIMEREDUCTION; } /* NEW syntax (function style): Only missing is IterativeTimeReduction */ | tSTRING '[' String__Index CommaFExprOrNothing ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = Get_DefineForString(Operation_Type, $1, &FlagError); if(FlagError){ Get_Valid_SXD($1, Operation_Type); vyyerror("Unknown type of Operation: %s", $1); } Free($1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; if(Operation_P->Type == OPERATION_GENERATE || Operation_P->Type == OPERATION_GENERATERHS || Operation_P->Type == OPERATION_GENERATEJAC || Operation_P->Type == OPERATION_GENERATESEPARATE) Operation_P->Case.Generate.GroupIndex = -1; Operation_P->Flag = $4; } | tSetTime '[' Expression ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SETTIME; Operation_P->Case.SetTime.ExpressionIndex = $3; } | tSetTimeStep '[' Expression ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SETTIMESTEP; Operation_P->Case.SetTime.ExpressionIndex = $3; } | tSleep '[' Expression ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SLEEP; Operation_P->Case.Sleep.ExpressionIndex = $3; } | tSetCommSelf tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SETCOMMSELF; } | tSetCommWorld tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SETCOMMWORLD; } | tBarrier tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_BARRIER; } | tBroadcastFields '[' ListOfFExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_BROADCASTFIELDS; Operation_P->Case.BroadcastFields.FieldsToSkip = $3; } | tBreak tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_BREAK; } | tTest '[' Expression ']' '{' Operation '}' { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_TEST; Operation_P->Case.Test.ExpressionIndex = $3; Operation_P->Case.Test.Operation_True = $6; Operation_P->Case.Test.Operation_False = NULL; } | tTest '[' Expression ']' '{' Operation '}' '{' Operation '}' { List_Pop(Operation_L); List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_TEST; Operation_P->Case.Test.ExpressionIndex = $3; Operation_P->Case.Test.Operation_True = $6; Operation_P->Case.Test.Operation_False = $9; } | tWhile '[' Expression ']' '{' Operation '}' { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_WHILE; Operation_P->Case.While.ExpressionIndex = $3; Operation_P->Case.While.Operation = $6; } | tSetFrequency '[' String__Index ',' Expression ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SETFREQUENCY; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.SetFrequency.ExpressionIndex = $5; } | tGenerateOnly '[' String__Index ',' ListOfFExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_GENERATEONLY; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.GenerateOnly.MatrixIndex_L = List_Create(List_Nbr($5),1,sizeof(int)); for(int i = 0; i < List_Nbr($5); i++){ double d; List_Read($5,i,&d); int j = (int)d; List_Add(Operation_P->Case.GenerateOnly.MatrixIndex_L, &j); } List_Delete($5); } | tGenerateOnlyJac '[' String__Index ',' ListOfFExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_GENERATEONLYJAC; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.GenerateOnly.MatrixIndex_L = List_Create(List_Nbr($5),1,sizeof(int)); for(int i = 0; i < List_Nbr($5); i++){ double d; List_Read($5,i,&d); int j = (int)d; List_Add(Operation_P->Case.GenerateOnly.MatrixIndex_L, &j); } List_Delete($5); } | tUpdate '[' String__Index ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_UPDATE; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.Update.ExpressionIndex = -1; } | tUpdate '[' String__Index ',' Expression ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_UPDATE; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.Update.ExpressionIndex = $5; } | tUpdateConstraint '[' String__Index ',' GroupRHS ',' String__Index ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_UPDATECONSTRAINT; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.UpdateConstraint.GroupIndex = Num_Group(&Group_S, (char*)"OP_UpdateCst", $5); Operation_P->Case.UpdateConstraint.Type = Get_DefineForString(Constraint_Type, $7, &FlagError); if(FlagError){ Get_Valid_SXD($7, Constraint_Type); vyyerror("Unknown type of Constraint: %s", $7); } Free($7); } | tUpdateConstraint '[' String__Index ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1) ; Operation_P->Type = OPERATION_UPDATECONSTRAINT ; int i; if ((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3) ; Free($3) ; Operation_P->DefineSystemIndex = i ; Operation_P->Case.UpdateConstraint.GroupIndex = -1; Operation_P->Case.UpdateConstraint.Type = ASSIGN; } | tGetResidual '[' String__Index ',' '$' String__Index ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_GETRESIDUAL; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.GetResidual.VariableName = $6; Operation_P->Case.GetResidual.NormType = L2NORM; /* NormType = Get_DefineForString(ErrorNorm_Type, $xx, &FlagError); if(FlagError){ Get_Valid_SXD($xx, ErrorNorm_Type); vyyerror("Unknown error norm type for residual calculation"); } */ } | tCreateSolution '[' String__Index ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_CREATESOLUTION; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.CreateSolution.CopyFromTimeStep = -1; } | tCreateSolution '[' String__Index ',' FExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_CREATESOLUTION; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.CreateSolution.CopyFromTimeStep = $5; } | tFourierTransform '[' String__Index ',' String__Index ',' ListOfFExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_FOURIERTRANSFORM; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->Case.FourierTransform.DefineSystemIndex[0] = i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $5, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $5); Free($5); Operation_P->Case.FourierTransform.DefineSystemIndex[1] = i; Operation_P->Case.FourierTransform.Frequency = $7; } | tFourierTransformJ '[' String__Index ',' String__Index ',' FExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_FOURIERTRANSFORM2; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->Case.FourierTransform2.DefineSystemIndex[0] = i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $5, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $5); Free($5); Operation_P->Case.FourierTransform2.DefineSystemIndex[1] = i; Operation_P->Case.FourierTransform2.Period = $7; Operation_P->Case.FourierTransform2.Period_sofar = 0.; Operation_P->Case.FourierTransform2.Scales = NULL; } | tLanczos '[' String__Index ',' FExpr ',' ListOfFExpr ',' FExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_LANCZOS; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.Lanczos.Size = (int)$5; Operation_P->Case.Lanczos.Save = List_Create(List_Nbr($7), 1, sizeof(int)); for(int l = 0; l < List_Nbr($7); l++) { double d; List_Read($7, l, &d); int j = (int)d; List_Add(Operation_P->Case.Lanczos.Save, &j); } List_Delete($7); Operation_P->Case.Lanczos.Shift = $9; } | tEigenSolve '[' String__Index ',' FExpr ',' FExpr ',' FExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_EIGENSOLVE; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.EigenSolve.NumEigenvalues = (int)$5; Operation_P->Case.EigenSolve.Shift_r = $7; Operation_P->Case.EigenSolve.Shift_i = $9; Operation_P->Case.EigenSolve.FilterExpressionIndex = -1; } | tEigenSolve '[' String__Index ',' FExpr ',' FExpr ',' FExpr ',' Expression ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_EIGENSOLVE; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.EigenSolve.NumEigenvalues = (int)$5; Operation_P->Case.EigenSolve.Shift_r = $7; Operation_P->Case.EigenSolve.Shift_i = $9; Operation_P->Case.EigenSolve.FilterExpressionIndex = $11; } | tEigenSolveJac '[' String__Index ',' FExpr ',' FExpr ',' FExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_EIGENSOLVEJAC; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.EigenSolve.NumEigenvalues = (int)$5; Operation_P->Case.EigenSolve.Shift_r = $7; Operation_P->Case.EigenSolve.Shift_i = $9; Operation_P->Case.EigenSolve.FilterExpressionIndex = -1; } | tEvaluate '[' RecursiveListOfExpression ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_EVALUATE; Operation_P->Case.Evaluate.Expressions = List_Copy(ListOfInt_L); } | tSelectCorrection '[' String__Index ',' FExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1) ; Operation_P->Type = OPERATION_SELECTCORRECTION; int i; if ((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3) ; Free($3) ; Operation_P->DefineSystemIndex = i ; Operation_P->Case.SelectCorrection.Iteration = (int)$5 ; } | tAddCorrection '[' String__Index ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1) ; Operation_P->Type = OPERATION_ADDCORRECTION; int i; if ((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3) ; Free($3) ; Operation_P->DefineSystemIndex = i ; Operation_P->Case.AddCorrection.Alpha = 1. ; } | tAddCorrection '[' String__Index ',' FExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1) ; Operation_P->Type = OPERATION_ADDCORRECTION; int i; if ((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3) ; Free($3) ; Operation_P->DefineSystemIndex = i ; Operation_P->Case.AddCorrection.Alpha = $5 ; } | tMultiplySolution '[' String__Index ',' FExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1) ; Operation_P->Type = OPERATION_MULTIPLYSOLUTION; int i; if ((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3) ; Free($3) ; Operation_P->DefineSystemIndex = i ; Operation_P->Case.MultiplySolution.Alpha = $5 ; } | tAddOppositeFullSolution '[' String__Index ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1) ; Operation_P->Type = OPERATION_ADDOPPOSITEFULLSOLUTION; int i; if ((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3) ; Free($3) ; Operation_P->DefineSystemIndex = i ; } | tPerturbation '[' String__Index ',' String__Index ',' String__Index ',' FExpr ',' ListOfFExpr ',' FExpr ',' FExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_PERTURBATION; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $5, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $5); Free($5); Operation_P->Case.Perturbation.DefineSystemIndex2 = i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $7, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $7); Free($7); Operation_P->Case.Perturbation.DefineSystemIndex3 = i; Operation_P->Case.Perturbation.Size = (int)$9; Operation_P->Case.Perturbation.Save = List_Create(List_Nbr($11), 1, sizeof(int)); for(int l = 0; l < List_Nbr($11); l++) { double d; List_Read($11, l, &d); int j = (int)d; List_Add(Operation_P->Case.Perturbation.Save, &j); } List_Delete($11); Operation_P->Case.Perturbation.Shift = $13; Operation_P->Case.Perturbation.PertFreq = (int)$15; } | tTimeLoopTheta '[' FExpr ',' FExpr ',' Expression ',' Expression ']' '{' Operation '}' { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_TIMELOOPTHETA; Operation_P->Case.TimeLoopTheta.Time0 = $3; Operation_P->Case.TimeLoopTheta.TimeMax = $5; Operation_P->Case.TimeLoopTheta.DTimeIndex = $7; Operation_P->Case.TimeLoopTheta.ThetaIndex = $9; Operation_P->Case.TimeLoopTheta.Operation = $12; } | tTimeLoopNewmark '[' FExpr ',' FExpr ',' Expression ',' FExpr ',' FExpr ']' '{' Operation '}' { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_TIMELOOPNEWMARK; Operation_P->Case.TimeLoopNewmark.Time0 = $3; Operation_P->Case.TimeLoopNewmark.TimeMax = $5; Operation_P->Case.TimeLoopNewmark.DTimeIndex = $7; Operation_P->Case.TimeLoopNewmark.Beta = $9; Operation_P->Case.TimeLoopNewmark.Gamma = $11; Operation_P->Case.TimeLoopNewmark.Operation = $14; } | tTimeLoopRungeKutta '[' String__Index ',' FExpr ',' FExpr ',' Expression ',' ListOfFExpr ',' ListOfFExpr ',' ListOfFExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_TIMELOOPRUNGEKUTTA; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i ; Operation_P->Case.TimeLoopRungeKutta.Time0 = $5; Operation_P->Case.TimeLoopRungeKutta.TimeMax = $7; Operation_P->Case.TimeLoopRungeKutta.DTimeIndex = $9; Operation_P->Case.TimeLoopRungeKutta.ButcherA = $11; Operation_P->Case.TimeLoopRungeKutta.ButcherB = $13; Operation_P->Case.TimeLoopRungeKutta.ButcherC = $15; } | tTimeLoopAdaptive '[' FExpr ',' FExpr ',' FExpr ',' FExpr ',' FExpr ',' CharExpr ',' ListOfFExpr ',' LTEdefinitions TLAoptions ']' '{' Operation '}' '{' Operation '}' { List_Pop(Operation_L); List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_TIMELOOPADAPTIVE; Operation_P->Case.TimeLoopAdaptive.Time0 = $3; Operation_P->Case.TimeLoopAdaptive.TimeMax = $5; Operation_P->Case.TimeLoopAdaptive.DTimeInit = $7; Operation_P->Case.TimeLoopAdaptive.DTimeMin = $9; Operation_P->Case.TimeLoopAdaptive.DTimeMax = $11; Operation_P->Case.TimeLoopAdaptive.Scheme = $13; Operation_P->Case.TimeLoopAdaptive.Breakpoints_L = $15; Operation_P->Case.TimeLoopAdaptive.Operation = $21; Operation_P->Case.TimeLoopAdaptive.OperationEnd = $24; } | tIterativeLoopN '[' FExpr ',' Expression ',' IterativeLoopDefinitions ']' '{' Operation '}' { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_ITERATIVELOOPN; Operation_P->Case.IterativeLoop.NbrMaxIteration = (int)$3; Operation_P->Case.IterativeLoop.RelaxationFactorIndex = $5; Operation_P->Case.IterativeLoop.Operation = $10; } | tIterativeLoop '[' FExpr ',' FExpr ',' Expression ']' '{' Operation '}' { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_ITERATIVELOOP; Operation_P->Case.IterativeLoop.NbrMaxIteration = (int)$3; Operation_P->Case.IterativeLoop.Criterion = $5; Operation_P->Case.IterativeLoop.RelaxationFactorIndex = $7; Operation_P->Case.IterativeLoop.Flag = 0; Operation_P->Case.IterativeLoop.Operation = $10; } | tIterativeLoop '[' FExpr ',' FExpr ',' Expression ',' FExpr ']' '{' Operation '}' { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_ITERATIVELOOP; Operation_P->Case.IterativeLoop.NbrMaxIteration = (int)$3; Operation_P->Case.IterativeLoop.Criterion = $5; Operation_P->Case.IterativeLoop.RelaxationFactorIndex = $7; Operation_P->Case.IterativeLoop.Flag = (int)$9; Operation_P->Case.IterativeLoop.Operation = $12; } | tIterativeLinearSolver '[' CharExpr ',' CharExpr ',' FExpr ',' FExpr ',' FExpr',' ListOfFExpr',' ListOfFExpr',' ListOfFExpr ']' '{' Operation '}' { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_ITERATIVELINEARSOLVER; Operation_P->Case.IterativeLinearSolver.OpMatMult = $3; Operation_P->Case.IterativeLinearSolver.Type = $5; Operation_P->Case.IterativeLinearSolver.Tolerance = $7; Operation_P->Case.IterativeLinearSolver.MaxIter = (int)$9; Operation_P->Case.IterativeLinearSolver.Restart = (int)$11; Operation_P->Case.IterativeLinearSolver.MyFieldTag = $13; Operation_P->Case.IterativeLinearSolver.NeighborFieldTag = $15; Operation_P->Case.IterativeLinearSolver.DeflationIndices = $17; Operation_P->Case.IterativeLinearSolver.Operations_Ax = $20; Operation_P->Case.IterativeLinearSolver.Operations_Mx = NULL; } | tIterativeLinearSolver '[' CharExpr ',' CharExpr ',' FExpr ',' FExpr ',' FExpr',' ListOfFExpr',' ListOfFExpr',' ListOfFExpr ']' '{' Operation '}' '{' Operation '}' { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_ITERATIVELINEARSOLVER; Operation_P->Case.IterativeLinearSolver.OpMatMult = $3; Operation_P->Case.IterativeLinearSolver.Type = $5; Operation_P->Case.IterativeLinearSolver.Tolerance = $7; Operation_P->Case.IterativeLinearSolver.MaxIter = (int)$9; Operation_P->Case.IterativeLinearSolver.Restart = (int)$11; Operation_P->Case.IterativeLinearSolver.MyFieldTag = $13; Operation_P->Case.IterativeLinearSolver.NeighborFieldTag = $15; Operation_P->Case.IterativeLinearSolver.DeflationIndices = $17; Operation_P->Case.IterativeLinearSolver.Operations_Ax = $20; Operation_P->Case.IterativeLinearSolver.Operations_Mx = $23; } | tPrint { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_PRINT; Operation_P->Case.Print.Expressions = NULL; Operation_P->DefineSystemIndex = -1; } '[' PrintOperation PrintOperationOptions ']' tEND | tWrite { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_WRITE; Operation_P->Case.Print.Expressions = NULL; Operation_P->DefineSystemIndex = -1; } '[' PrintOperation PrintOperationOptions ']' tEND | tChangeOfCoordinates '[' GroupRHS ',' Expression ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_CHANGEOFCOORDINATES; Operation_P->Case.ChangeOfCoordinates.GroupIndex = Num_Group(&Group_S, (char*)"OP_ChgCoord", $3); Operation_P->Case.ChangeOfCoordinates.ExpressionIndex = $5; Operation_P->Case.ChangeOfCoordinates.ExpressionIndex2 = -1; } | tChangeOfCoordinates '[' GroupRHS ',' Expression ',' FExpr ',' Expression ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_CHANGEOFCOORDINATES; Operation_P->Case.ChangeOfCoordinates.GroupIndex = Num_Group(&Group_S, (char*)"OP_ChgCoord", $3); Operation_P->Case.ChangeOfCoordinates.ExpressionIndex = $5; Operation_P->Case.ChangeOfCoordinates.NumNode = (int)$7; Operation_P->Case.ChangeOfCoordinates.ExpressionIndex2 = $9; } | tPostOperation '[' String__Index ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_POSTOPERATION; Operation_P->Case.PostOperation.PostOperations = List_Create(1,1,sizeof(char*)); List_Add(Operation_P->Case.PostOperation.PostOperations, &$3); } | tSystemCommand '[' CharExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SYSTEMCOMMAND; Operation_P->Case.SystemCommand.String = $3; } | tError '[' CharExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_ERROR; Operation_P->Case.Error.String = $3; } | GmshOperation '[' CharExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = $1; Operation_P->Case.GmshRead.FileName = strSave(Fix_RelativePath($3).c_str()); Operation_P->Case.GmshRead.ViewTag = -1; Free($3); } | GmshOperation '[' CharExpr ',' FExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = $1; Operation_P->Case.GmshRead.FileName = strSave(Fix_RelativePath($3).c_str()); Operation_P->Case.GmshRead.ViewTag = (int)$5; Free($3); } | tGmshClearAll tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_GMSHCLEARALL; } | tDeleteFile '[' CharExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_DELETEFILE; Operation_P->Case.DeleteFile.FileName = strSave(Fix_RelativePath($3).c_str()); Free($3); } | tRenameFile '[' CharExpr ',' CharExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_RENAMEFILE; Operation_P->Case.RenameFile.OldFileName = strSave(Fix_RelativePath($3).c_str()); Operation_P->Case.RenameFile.NewFileName = strSave(Fix_RelativePath($5).c_str()); Free($3); Free($5); } | tCreateDir '[' CharExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_CREATEDIR; Operation_P->Case.CreateDir.DirName = strSave(Fix_RelativePath($3).c_str()); Free($3); } | tSolveJac_AdaptRelax '[' String__Index ',' ListOfFExpr ',' FExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SOLVEJACADAPTRELAX; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.SolveJac_AdaptRelax.CheckAll = (int)$7; Operation_P->Case.SolveJac_AdaptRelax.Factor_L = $5; } | tSaveSolutionWithEntityNum '[' String__Index ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SAVESOLUTION_WITH_ENTITY_NUM; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.SaveSolutionWithEntityNum.GroupIndex = -1; Operation_P->Case.SaveSolutionWithEntityNum.SaveFixed = -1; } | tSaveSolutionWithEntityNum '[' String__Index ',' GroupRHS CommaFExprOrNothing ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SAVESOLUTION_WITH_ENTITY_NUM; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.SaveSolutionWithEntityNum.GroupIndex = Num_Group(&Group_S, (char*)"OP_SaveSolutionWithEntityNum", $5); Operation_P->Case.SaveSolutionWithEntityNum.SaveFixed = ($6 >= 0) ? $6 : 0; } | tSaveSolutionExtendedMH '[' String__Index ',' FExpr ',' CharExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SAVESOLUTIONEXTENDEDMH; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.SaveSolutionExtendedMH.NbrFreq = (int)$5; Operation_P->Case.SaveSolutionExtendedMH.ResFile = $7; } | tSaveSolutionMHtoTime '[' String__Index ',' ListOfFExpr ',' CharExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SAVESOLUTIONMHTOTIME; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.SaveSolutionMHtoTime.Time = $5; Operation_P->Case.SaveSolutionMHtoTime.ResFile = $7; } | tInitMovingBand2D '[' String__Index ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Problem_S.Group, $3, fcmp_Group_Name)) < 0) vyyerror("Unknown Group: %s", $3); Operation_P->Type = OPERATION_INIT_MOVINGBAND2D; Operation_P->Case.Init_MovingBand2D.GroupIndex = i; Free($3); } | tMeshMovingBand2D '[' String__Index ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Problem_S.Group, $3, fcmp_Group_Name)) < 0) vyyerror("Unknown Group: %s", $3); Operation_P->Type = OPERATION_MESH_MOVINGBAND2D; Operation_P->Case.Mesh_MovingBand2D.GroupIndex = i; Free($3); } | tSaveMesh '[' String__Index ',' GroupRHS ',' CharExpr ',' Expression ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.SaveMesh.GroupIndex = Num_Group(&Group_S, (char*)"OP_SaveMesh", $5); Operation_P->Case.SaveMesh.FileName = $7; Operation_P->Case.SaveMesh.ExprIndex = $9; Operation_P->Type = OPERATION_SAVEMESH; } | tSaveMesh '[' String__Index ',' GroupRHS ',' CharExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.SaveMesh.GroupIndex = Num_Group(&Group_S, (char*)"OP_SaveMesh", $5); Operation_P->Case.SaveMesh.FileName = $7; Operation_P->Case.SaveMesh.ExprIndex = -1; Operation_P->Type = OPERATION_SAVEMESH; } | tGenerateMHMoving '[' String__Index ',' String__Index ',' FExpr ',' FExpr ']' '{' Operation '}' { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; if((i = List_ISearchSeq(Problem_S.Group, $5, fcmp_Group_Name)) < 0) vyyerror("Unknown Group: %s", $5); Free($5); Operation_P->Type = OPERATION_GENERATE_MH_MOVING; Operation_P->Case.Generate_MH_Moving.GroupIndex = i; Operation_P->Case.Generate_MH_Moving.Period = $7; Operation_P->Case.Generate_MH_Moving.NbrStep = (int)$9; Operation_P->Case.Generate_MH_Moving.Operation = $12; } | tGenerateMHMovingSeparate '[' String__Index ',' String__Index ',' FExpr ',' FExpr ']' '{' Operation '}' { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; if((i = List_ISearchSeq(Problem_S.Group, $5, fcmp_Group_Name)) < 0) vyyerror("Unknown Group: %s", $5); Free($5); Operation_P->Type = OPERATION_GENERATE_MH_MOVING_S; Operation_P->Case.Generate_MH_Moving_S.GroupIndex = i; Operation_P->Case.Generate_MH_Moving_S.Period = $7; Operation_P->Case.Generate_MH_Moving_S.NbrStep = (int)$9; Operation_P->Case.Generate_MH_Moving_S.Operation = $12; } | tAddMHMoving '[' String__Index ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Type = OPERATION_ADDMHMOVING; } | tDeformMesh '[' String__Index ',' String__Index ',' tNameOfMesh CharExpr ',' FExpr ',' GroupRHS ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.DeformeMesh.Quantity = $5; Operation_P->Case.DeformeMesh.Name_MshFile = $8; Operation_P->Case.DeformeMesh.GeoDataIndex = -1; Operation_P->Case.DeformeMesh.Factor = $10; Operation_P->Case.DeformeMesh.GroupIndex = Num_Group(&Group_S, (char*)"OP_DeformMesh", $12); Operation_P->Type = OPERATION_DEFORMEMESH; } | tDeformMesh '[' String__Index ',' String__Index ',' tNameOfMesh CharExpr ',' FExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.DeformeMesh.Quantity = $5; Operation_P->Case.DeformeMesh.Name_MshFile = $8; Operation_P->Case.DeformeMesh.GeoDataIndex = -1; Operation_P->Case.DeformeMesh.Factor = $10; Operation_P->Case.DeformeMesh.GroupIndex = -1; Operation_P->Type = OPERATION_DEFORMEMESH; } | tDeformMesh '[' String__Index ',' String__Index ',' tNameOfMesh CharExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.DeformeMesh.Quantity = $5; Operation_P->Case.DeformeMesh.Name_MshFile = $8; Operation_P->Case.DeformeMesh.GeoDataIndex = -1; Operation_P->Case.DeformeMesh.Factor = 1; Operation_P->Case.DeformeMesh.GroupIndex = -1; Operation_P->Type = OPERATION_DEFORMEMESH; } | tDeformMesh '[' String__Index ',' String__Index ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.DeformeMesh.Quantity = $5; Operation_P->Case.DeformeMesh.Name_MshFile = NULL; Operation_P->Case.DeformeMesh.GeoDataIndex = -1; Operation_P->Case.DeformeMesh.Factor = 1; Operation_P->Case.DeformeMesh.GroupIndex = -1; Operation_P->Type = OPERATION_DEFORMEMESH; } | tDeformMesh '[' String__Index ',' String__Index ',' FExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.DeformeMesh.Quantity = $5; Operation_P->Case.DeformeMesh.Name_MshFile = NULL; Operation_P->Case.DeformeMesh.GeoDataIndex = -1; Operation_P->Case.DeformeMesh.Factor = $7; Operation_P->Case.DeformeMesh.GroupIndex = -1; Operation_P->Type = OPERATION_DEFORMEMESH; } | tDeformMesh '[' String__Index ',' String__Index ',' FExpr ',' GroupRHS ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Case.DeformeMesh.Quantity = $5; Operation_P->Case.DeformeMesh.Name_MshFile = NULL; Operation_P->Case.DeformeMesh.GeoDataIndex = -1; Operation_P->Case.DeformeMesh.Factor = $7; Operation_P->Case.DeformeMesh.GroupIndex = Num_Group(&Group_S, (char*)"OP_DeformMesh", $9); Operation_P->Type = OPERATION_DEFORMEMESH; } | GenerateGroupOperation '[' String__Index ',' GroupRHS ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; Operation_P->Type = $1; Operation_P->Case.Generate.GroupIndex = Num_Group(&Group_S, (char*)"OP_GenerateGroup", $5); } | tSolveAgainWithOther '[' String__Index ',' String__Index ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SOLVEAGAINWITHOTHER; int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); Free($3); Operation_P->DefineSystemIndex = i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $5, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $5); Free($5); Operation_P->Case.SolveAgainWithOther.DefineSystemIndex = i; } | tSetGlobalSolverOptions '[' CharExpr ']' tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = OPERATION_SETGLOBALSOLVEROPTIONS; Operation_P->Case.SetGlobalSolverOptions.String = $3; } | Loop { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Type = NONE; } ; PrintOperation : ListOfExpression { Operation_P->Case.Print.Expressions = List_Copy(ListOfInt_L); } | String__Index { int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $1, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $1); Free($1); Operation_P->DefineSystemIndex = i; } ; PrintOperationOptions : { Operation_P->Case.Print.FileOut = NULL; Operation_P->Case.Print.TimeStep = NULL; Operation_P->Case.Print.DofNumber = NULL; Operation_P->Case.Print.FormatString = NULL; } | PrintOperationOptions PrintOperationOption ; PrintOperationOption : ',' tFile CharExpr { Operation_P->Case.Print.FileOut = $3; } | ',' tTimeStep ListOfFExpr { Operation_P->Case.Print.TimeStep = List_Create(List_Nbr($3), 1, sizeof(int)); for(int i = 0; i < List_Nbr($3); i++){ double d; List_Read($3,i,&d); int j = (int)d; List_Add(Operation_P->Case.Print.TimeStep, &j); } List_Delete($3); } | ',' tFormat CharExpr { Operation_P->Case.Print.FormatString = $3; } | ',' ListOfFExpr { Operation_P->Case.Print.DofNumber = List_Create(List_Nbr($2), 1, sizeof(int)); for(int i = 0; i < List_Nbr($2); i++) { double d; List_Read($2, i, &d); int j = (int)d; List_Add(Operation_P->Case.Print.DofNumber, &j); } List_Delete($2); } ; TLAoptions : /* none */ { Operation_P->Case.TimeLoopAdaptive.LTEtarget = -1.; Operation_P->Case.TimeLoopAdaptive.DTimeMaxScal = -1.; Operation_P->Case.TimeLoopAdaptive.DTimeScal_NotConverged = -1.; } | ',' FExpr { Operation_P->Case.TimeLoopAdaptive.LTEtarget = $2; Operation_P->Case.TimeLoopAdaptive.DTimeMaxScal = -1.; Operation_P->Case.TimeLoopAdaptive.DTimeScal_NotConverged = -1.; } | ',' FExpr ',' FExpr { Operation_P->Case.TimeLoopAdaptive.LTEtarget = $2; Operation_P->Case.TimeLoopAdaptive.DTimeMaxScal = $4; Operation_P->Case.TimeLoopAdaptive.DTimeScal_NotConverged = -1.; } | ',' FExpr ',' FExpr ',' FExpr { Operation_P->Case.TimeLoopAdaptive.LTEtarget = $2; Operation_P->Case.TimeLoopAdaptive.DTimeMaxScal = $4; Operation_P->Case.TimeLoopAdaptive.DTimeScal_NotConverged = $6; } ; LTEdefinitions : /* none */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopAdaptive.TimeLoopAdaptiveSystems_L = NULL; Operation_P->Case.TimeLoopAdaptive.TimeLoopAdaptivePOs_L = NULL; } | LTEdefinitions tDefineSystem '{' TimeLoopAdaptiveSystems '}' { Operation_P->Case.TimeLoopAdaptive.TimeLoopAdaptiveSystems_L = $4; } | LTEdefinitions tPostOperation '{' TimeLoopAdaptivePOs '}' { Operation_P->Case.TimeLoopAdaptive.TimeLoopAdaptivePOs_L = $4; } ; TimeLoopAdaptiveSystems : /* none */ { $$ = List_Create(4, 4, sizeof(struct TimeLoopAdaptiveSystem)); } | TimeLoopAdaptiveSystems '{' String__Index ',' FExpr ',' FExpr ',' tSTRING '}' { int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); TimeLoopAdaptiveSystem_S.SystemIndex = i; TimeLoopAdaptiveSystem_S.SystemLTEreltol = $5; TimeLoopAdaptiveSystem_S.SystemLTEabstol = $7; TimeLoopAdaptiveSystem_S.NormType = Get_DefineForString(ErrorNorm_Type, $9, &FlagError); if(FlagError){ Get_Valid_SXD($9, ErrorNorm_Type); vyyerror("Unknown error norm type of TimeLoopAdaptive system %s", $3); } TimeLoopAdaptiveSystem_S.NormTypeString = $9; List_Add($$ = $1, &TimeLoopAdaptiveSystem_S); Free($3); } ; TimeLoopAdaptivePOs : /* none */ { $$ = List_Create(4, 4, sizeof(struct LoopErrorPostOperation)); } | TimeLoopAdaptivePOs '{' String__Index ',' FExpr ',' FExpr ',' tSTRING '}' { TimeLoopAdaptivePO_S.PostOperationName = $3; TimeLoopAdaptivePO_S.PostOperationReltol = $5; TimeLoopAdaptivePO_S.PostOperationAbstol = $7; TimeLoopAdaptivePO_S.NormType = Get_DefineForString(ErrorNorm_Type, $9, &FlagError); if(FlagError){ Get_Valid_SXD($9, ErrorNorm_Type); vyyerror("Unknown error norm type of TimeLoopAdaptive PostOperation %s", $3); } TimeLoopAdaptivePO_S.NormTypeString = $9; List_Add($$ = $1, &TimeLoopAdaptivePO_S); } ; IterativeLoopDefinitions : /* none */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeLoop.IterativeLoopSystems_L = NULL; Operation_P->Case.IterativeLoop.IterativeLoopPOs_L = NULL; } | IterativeLoopDefinitions tDefineSystem '{' IterativeLoopSystems '}' { Operation_P->Case.IterativeLoop.IterativeLoopSystems_L = $4; } | IterativeLoopDefinitions tPostOperation '{' IterativeLoopPOs '}' { Operation_P->Case.IterativeLoop.IterativeLoopPOs_L = $4; } ; IterativeLoopSystems : /* none */ { $$ = List_Create(4, 4, sizeof(struct IterativeLoopSystem)); } | IterativeLoopSystems '{' String__Index ',' FExpr ',' FExpr ',' tSTRING tSTRING '}' { int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $3, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $3); IterativeLoopSystem_S.SystemIndex = i; IterativeLoopSystem_S.SystemILreltol = $5; IterativeLoopSystem_S.SystemILabstol = $7; IterativeLoopSystem_S.NormOf = Get_DefineForString(NormOf_Type, $9, &FlagError); if(FlagError){ Get_Valid_SXD($3, ChangeOfState_Type); vyyerror("Unknown object for error norm of IterativeLoop system: %s", $3); } IterativeLoopSystem_S.NormOfString = $9; IterativeLoopSystem_S.NormType = Get_DefineForString(ErrorNorm_Type, $10, &FlagError); if(FlagError){ Get_Valid_SXD($10, ErrorNorm_Type); vyyerror("Unknown error norm type of IterativeLoop system: %s", $3); } IterativeLoopSystem_S.NormTypeString = $10; List_Add($$ = $1, &IterativeLoopSystem_S); Free($3); } ; IterativeLoopPOs : /* none */ { $$ = List_Create(4, 4, sizeof(struct LoopErrorPostOperation)); } | IterativeLoopPOs '{' String__Index ',' FExpr ',' FExpr ',' tSTRING '}' { IterativeLoopPO_S.PostOperationName = $3; IterativeLoopPO_S.PostOperationReltol = $5; IterativeLoopPO_S.PostOperationAbstol = $7; IterativeLoopPO_S.NormType = Get_DefineForString(ErrorNorm_Type, $9, &FlagError); if(FlagError){ Get_Valid_SXD($9, ErrorNorm_Type); vyyerror("Unknown error norm type of IterativeLoopN PostOperation %s", $3); } IterativeLoopPO_S.NormTypeString = $9; List_Add($$ = $1, &IterativeLoopPO_S); } ; /* ------ the following should disapear with the new syntax ------------- */ TimeLoopTheta : /* none */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopTheta.Time0 = 0.; Operation_P->Case.TimeLoopTheta.TimeMax = 1.; Operation_P->Case.TimeLoopTheta.DTimeIndex = -1; Operation_P->Case.TimeLoopTheta.ThetaIndex = -1; Operation_P->Case.TimeLoopTheta.Operation = NULL; } | TimeLoopTheta TimeLoopThetaTerm ; TimeLoopThetaTerm : tTime0 FExpr tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopTheta.Time0 = $2; } | tTimeMax FExpr tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopTheta.TimeMax = $2; } | tDTime Expression tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopTheta.DTimeIndex = $2; } | tTheta Expression tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopTheta.ThetaIndex = $2; } | tOperation '{' Operation '}' { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopTheta.Operation = $3; } ; TimeLoopNewmark : /* none */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopNewmark.Time0 = 0.; Operation_P->Case.TimeLoopNewmark.TimeMax = 1.; Operation_P->Case.TimeLoopNewmark.DTimeIndex = -1; Operation_P->Case.TimeLoopNewmark.Beta = 0.25; Operation_P->Case.TimeLoopNewmark.Gamma = 0.5; Operation_P->Case.TimeLoopNewmark.Operation = NULL; } | TimeLoopNewmark TimeLoopNewmarkTerm ; TimeLoopNewmarkTerm : tTime0 FExpr tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopNewmark.Time0 = $2; } | tTimeMax FExpr tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopNewmark.TimeMax = $2; } | tDTime Expression tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopNewmark.DTimeIndex = $2; } | tBeta FExpr tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopNewmark.Beta = $2; } | tGamma FExpr tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopNewmark.Gamma = $2; } | tOperation '{' Operation '}' { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.TimeLoopNewmark.Operation = $3; } ; IterativeLoop : /* none */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeLoop.NbrMaxIteration = 20; Operation_P->Case.IterativeLoop.Criterion = 1.e-3; Operation_P->Case.IterativeLoop.RelaxationFactorIndex = -1; Operation_P->Case.IterativeLoop.Flag = 0; Operation_P->Case.IterativeLoop.Operation = NULL; } | IterativeLoop IterativeLoopTerm ; IterativeLoopTerm : tNbrMaxIteration FExpr tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeLoop.NbrMaxIteration = (int)$2; } | tCriterion FExpr tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeLoop.Criterion = $2; } | tRelaxationFactor Expression tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeLoop.RelaxationFactorIndex = $2; } | tFlag FExpr tEND /* Attention: phase test */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeLoop.Flag = (int)$2; } | tOperation '{' Operation '}' { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeLoop.Operation = $3; } ; IterativeTimeReduction : /* none */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeTimeReduction.NbrMaxIteration = 20; Operation_P->Case.IterativeTimeReduction.DivisionCoefficient = 2.; Operation_P->Case.IterativeTimeReduction.Criterion = 1.e-3; Operation_P->Case.IterativeTimeReduction.Flag = 0; Current_System = Operation_P->DefineSystemIndex = -1; Operation_P->Case.IterativeTimeReduction.ChangeOfState = NULL; Operation_P->Case.IterativeTimeReduction.Operation = NULL; Operation_P->Case.IterativeTimeReduction.OperationEnd = NULL; } | IterativeTimeReduction IterativeTimeReductionTerm ; IterativeTimeReductionTerm : tNbrMaxIteration FExpr tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeTimeReduction.NbrMaxIteration = (int)$2; } | tDivisionCoefficient FExpr tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeTimeReduction.DivisionCoefficient = $2; } | tCriterion FExpr tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeTimeReduction.Criterion = $2; } | tFlag FExpr tEND /* Attention: phase test */ { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeTimeReduction.Flag = (int)$2; } | tDefineSystem String__Index tEND { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); int i; if((i = List_ISearchSeq(Resolution_S.DefineSystem, $2, fcmp_DefineSystem_Name)) < 0) vyyerror("Unknown System: %s", $2); Free($2); Current_System = Operation_P->DefineSystemIndex = i; } | tChangeOfState '{' ChangeOfStates '}' { Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeTimeReduction.ChangeOfState = $3; } | tOperation '{' Operation '}' { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeTimeReduction.Operation = $3; } | tOperationEnd '{' Operation '}' { List_Pop(Operation_L); Operation_P = (struct Operation*) List_Pointer(Operation_L, List_Nbr(Operation_L)-1); Operation_P->Case.IterativeTimeReduction.OperationEnd = $3; } ; ChangeOfStates : /* none */ { $$ = List_Create(3, 3, sizeof (struct ChangeOfState)); } | ChangeOfStates '{' ChangeOfState '}' { List_Add($$ = $1, &ChangeOfState_S); } ; ChangeOfState : /* none */ { ChangeOfState_S.Type = CHANGEOFSTATE_CHANGESIGN; ChangeOfState_S.QuantityIndex = -1; ChangeOfState_S.FormulationIndex = -1; ChangeOfState_S.InIndex = -1; ChangeOfState_S.Criterion = 1.e-2; ChangeOfState_S.ExpressionIndex = ChangeOfState_S.ExpressionIndex2 = -1; ChangeOfState_S.FlagIndex = -1; ChangeOfState_S.ActiveList[0] = NULL; ChangeOfState_S.ActiveList[1] = NULL; } | ChangeOfState ChangeOfStateTerm ; ChangeOfStateTerm : tType tSTRING tEND { ChangeOfState_S.Type = Get_DefineForString(ChangeOfState_Type, $2, &FlagError); if(FlagError){ Get_Valid_SXD($2, ChangeOfState_Type); vyyerror("Unknown type of ChangeOfState: %s", $2); } Free($2); } | tQuantity tSTRING tEND { if(Current_System >= 0) { List_T *ListOfInt_Lnew = ((struct DefineSystem *)List_Pointer(Resolution_S.DefineSystem, Current_System))->FormulationIndex; int *ListOfInt_P =(int *)List_Pointer(ListOfInt_Lnew, 0); int i = 0, j; for(j = 0; j < List_Nbr(ListOfInt_Lnew); j++) { Formulation_S.DefineQuantity = ((struct Formulation *) List_Pointer(Problem_S.Formulation, ListOfInt_P[j]))->DefineQuantity; if((i = List_ISearchSeq(Formulation_S.DefineQuantity, $2, fcmp_DefineQuantity_Name)) >= 0) break; } if(j tGalerkin' */ | SubPostQuantities tGalerkin '{' SubPostQuantity '}' { PostQuantityTerm_S.EvaluationType = INTEGRAL; List_Add($$ = $1, &PostQuantityTerm_S); } | SubPostQuantities tSTRING '{' SubPostQuantity '}' { PostQuantityTerm_S.EvaluationType = Get_DefineForString(PostQuantityTerm_EvaluationType, $2, &FlagError); if(FlagError){ Get_Valid_SXD($2, PostQuantityTerm_EvaluationType); vyyerror("Unknown EvaluationType for PostQuantityTerm: %s", $2); } Free($2); List_Add($$ = $1, &PostQuantityTerm_S); } | SubPostQuantities Loop { $$ = $1 ; } ; SubPostQuantity : /* none */ { PostQuantityTerm_S.Type = 0; PostQuantityTerm_S.TypeTimeDerivative = NODT_; PostQuantityTerm_S.WholeQuantity = NULL; PostQuantityTerm_S.InIndex = -1; PostQuantityTerm_S.JacobianMethodIndex = -1; PostQuantityTerm_S.IntegrationMethodIndex = -1; } | SubPostQuantity SubPostQuantityTerm ; SubPostQuantityTerm : TermOperator '[' { PostQuantityTerm_S.TypeTimeDerivative = Type_TermOperator; Current_DofIndexInWholeQuantity = -2; List_Reset(ListOfPointer_L); } WholeQuantityExpression ']' tEND { PostQuantityTerm_S.WholeQuantity = $4; Pro_DefineQuantityIndex (PostQuantityTerm_S.WholeQuantity, -1, &PostQuantityTerm_S.NbrQuantityIndex, &PostQuantityTerm_S.QuantityIndexTable, &PostQuantityTerm_S.QuantityTraceGroupIndexTable); if(!PostQuantityTerm_S.Type) { PostQuantityTerm_S.Type = 0; for(int i = 0; i < PostQuantityTerm_S.NbrQuantityIndex; i++) { int j = -1; if(PostQuantityTerm_S.QuantityIndexTable[i] >= 0) j = ((struct DefineQuantity *) List_Pointer (((struct Formulation *) List_Pointer(Problem_S.Formulation, PostProcessing_S.FormulationIndex))->DefineQuantity, PostQuantityTerm_S.QuantityIndexTable[i])) -> Type; if(PostQuantityTerm_S.Type == 0) PostQuantityTerm_S.Type = j; else if(PostQuantityTerm_S.Type != j) vyyerror("Mixed discrete Quantity types in term (should be split in separate terms)"); } if(PostQuantityTerm_S.Type == 0) PostQuantityTerm_S.Type = LOCALQUANTITY; } } | tType tSTRING tEND { /* force the Type */ PostQuantityTerm_S.Type = Get_DefineForString(DefineQuantity_Type, $2, &FlagError); if(FlagError){ Get_Valid_SXD($2, DefineQuantity_Type); vyyerror("Unknown type of Operation: %s", $2); } Free($2); } | tIn GroupRHS tEND { PostQuantityTerm_S.InIndex = Num_Group(&Group_S, (char*)"PQ_In", $2); } | tJacobian String__Index tEND { int i; if((i = List_ISearchSeq(Problem_S.JacobianMethod, $2, fcmp_JacobianMethod_Name)) < 0) vyyerror("Unknown Jacobian method: %s",$2); else PostQuantityTerm_S.JacobianMethodIndex = i; Free($2); } | tIntegration tSTRING tEND { int i; if((i = List_ISearchSeq(Problem_S.IntegrationMethod, $2, fcmp_IntegrationMethod_Name)) < 0) vyyerror("Unknown Integration method: %s",$2); else PostQuantityTerm_S.IntegrationMethodIndex = i; Free($2); } ; /* ------------------------------------------------------------------------ */ /* P o s t O p e r a t i o n */ /* ------------------------------------------------------------------------ */ PostOperations : /* none */ { if(!Problem_S.PostOperation) Problem_S.PostOperation = List_Create(10, 5, sizeof (struct PostOperation)); } | PostOperations BracedPostOperation ; BracedPostOperation : '{' PostOperation '}' { List_Add(Problem_S.PostOperation, &PostOperation_S); } | Loop ; PostOperation : /* none */ { PostOperation_S.Name = NULL; PostOperation_S.Hidden = false; PostOperation_S.AppendString = NULL; PostOperation_S.Format = FORMAT_GMSH; PostOperation_S.PostProcessingIndex = -1; PostOperation_S.ResampleTime = false; PostOperation_S.TimeValue_L = NULL; PostOperation_S.TimeImagValue_L = NULL; PostOperation_S.LastTimeStepOnly = 0; PostOperation_S.OverrideTimeStepValue = -1; PostOperation_S.NoMesh = 0; PostOperation_S.CatFile = 0; } | PostOperation PostOperationTerm ; PostOperationTerm : tName String__Index tEND { Check_NameOfStructNotExist("PostOperation", Problem_S.PostOperation, $2, fcmp_PostOperation_Name); PostOperation_S.Name = $2; } | tHidden FExpr tEND { PostOperation_S.Hidden = $2 ? true : false; } | tNameOfPostProcessing String__Index tEND { int i; if((i = List_ISearchSeq(Problem_S.PostProcessing, $2, fcmp_PostProcessing_Name)) < 0) vyyerror("Unknown PostProcessing: %s", $2); else { PostOperation_S.PostProcessingIndex = i; List_Read(Problem_S.PostProcessing, i, &InteractivePostProcessing_S); } Free($2); } | tFormat tSTRING tEND { PostOperation_S.Format = Get_DefineForString(PostSubOperation_Format, $2, &FlagError); if(FlagError){ Get_Valid_SXD($2, PostSubOperation_Format); vyyerror("Unknown PostProcessing Format: %s", $2); } Free($2); } | tTimeValue ListOfFExpr tEND { PostOperation_S.TimeValue_L = $2; } | tTimeImagValue ListOfFExpr tEND { PostOperation_S.TimeImagValue_L = $2; } | tLastTimeStepOnly tEND { PostOperation_S.LastTimeStepOnly = 1; } | tAppend CharExpr tEND { PostOperation_S.AppendString = $2; } | tAppendToExistingFile FExpr tEND { PostOperation_S.CatFile = $2; } | tNoMesh FExpr tEND { PostOperation_S.NoMesh = $2; } | tOverrideTimeStepValue FExpr tEND { PostOperation_S.OverrideTimeStepValue = $2; } | tResampleTime '[' FExpr ',' FExpr ',' FExpr ']' tEND { PostOperation_S.ResampleTime = true; PostOperation_S.ResampleTimeStart = $3; PostOperation_S.ResampleTimeStop = $5; PostOperation_S.ResampleTimeStep = $7; } | tOperation '{' PostSubOperations '}' { PostOperation_S.PostSubOperation = $3; } | Loop ; SeparatePostOperation : tPostOperation String__Index tUsingPost String__Index { PostOperation_S.Hidden = false; PostOperation_S.AppendString = NULL; PostOperation_S.Format = FORMAT_GMSH; PostOperation_S.PostProcessingIndex = -1; PostOperation_S.ResampleTime = false; PostOperation_S.TimeValue_L = NULL; PostOperation_S.TimeImagValue_L = NULL; PostOperation_S.LastTimeStepOnly = 0; PostOperation_S.OverrideTimeStepValue = -1; PostOperation_S.NoMesh = 0; int i; if((i = List_ISearchSeq(Problem_S.PostProcessing, $4, fcmp_PostProcessing_Name)) < 0) vyyerror("Unknown PostProcessing: %s", $4); else { PostOperation_S.PostProcessingIndex = i; List_Read(Problem_S.PostProcessing, i, &InteractivePostProcessing_S); if(!Problem_S.PostOperation) Problem_S.PostOperation = List_Create(5, 5, sizeof (struct PostOperation)); PostOperation_S.Name = $2; } Free($4); } '{' PostSubOperations '}' { PostOperation_S.PostSubOperation = $7; if(PostOperation_S.PostProcessingIndex >= 0) List_Add(Problem_S.PostOperation, &PostOperation_S); } ; PostSubOperations : /* none */ { $$ = List_Create(5, 5, sizeof (struct PostSubOperation)); } | PostSubOperations { PostSubOperation_S.Format = -1; PostSubOperation_S.FileOut = NULL; PostSubOperation_S.Depth = 1; PostSubOperation_S.Smoothing = 0; PostSubOperation_S.Skin = 0; PostSubOperation_S.Comma = 0; PostSubOperation_S.Dimension = _ALL; PostSubOperation_S.Adapt = 0; PostSubOperation_S.Target = -1.; PostSubOperation_S.HarmonicToTime = 1; PostSubOperation_S.FourierTransform = 0; PostSubOperation_S.FrozenTimeStepList = 0; PostSubOperation_S.TimeStep_L = List_Create(10,10,sizeof(int));; PostSubOperation_S.Frequency_L = List_Create(10,10,sizeof(double));; PostSubOperation_S.Value_L = List_Create(10,10,sizeof(double));; PostSubOperation_S.Iso = 0; PostSubOperation_S.Iso_L = List_Create(10,10,sizeof(double));; PostSubOperation_S.Sort = 0; PostSubOperation_S.NoNewLine = 0; PostSubOperation_S.NoTitle = 0; PostSubOperation_S.DecomposeInSimplex = 0; PostSubOperation_S.NewCoordinates = 0; PostSubOperation_S.NewCoordinatesFile = NULL; PostSubOperation_S.ChangeOfCoordinates[0] = -1; PostSubOperation_S.ChangeOfCoordinates[1] = -1; PostSubOperation_S.ChangeOfCoordinates[2] = -1; PostSubOperation_S.ChangeOfValues = NULL; PostSubOperation_S.Legend = LEGEND_NONE; PostSubOperation_S.LegendPosition[0] = 0.; PostSubOperation_S.LegendPosition[1] = 0.; PostSubOperation_S.LegendPosition[2] = 0.; PostSubOperation_S.EvaluationPoints = NULL; PostSubOperation_S.StoreInVariable = NULL; PostSubOperation_S.StoreInRegister = -1; PostSubOperation_S.StoreMinInRegister = -1; PostSubOperation_S.StoreMinXinRegister = -1; PostSubOperation_S.StoreMinYinRegister = -1; PostSubOperation_S.StoreMinZinRegister = -1; PostSubOperation_S.StoreMaxInRegister = -1; PostSubOperation_S.StoreMaxXinRegister = -1; PostSubOperation_S.StoreMaxYinRegister = -1; PostSubOperation_S.StoreMaxZinRegister = -1; PostSubOperation_S.StoreInField = -1; PostSubOperation_S.StoreInMeshBasedField = -1; PostSubOperation_S.LastTimeStepOnly = 0; PostSubOperation_S.AppendTimeStepToFileName = 0; PostSubOperation_S.AppendExpressionToFileName = -1; PostSubOperation_S.AppendExpressionFormat = NULL; PostSubOperation_S.AppendStringToFileName = NULL; PostSubOperation_S.OverrideTimeStepValue = -1; PostSubOperation_S.NoMesh = 0; PostSubOperation_S.CatFile = 0; PostSubOperation_S.SendToServer = NULL; PostSubOperation_S.Color = NULL; PostSubOperation_S.ValueIndex = 0; PostSubOperation_S.ValueName = NULL; PostSubOperation_S.Label = NULL; PostSubOperation_S.TimeValue_L = NULL; PostSubOperation_S.TimeImagValue_L = NULL; } PostSubOperation { if(PostSubOperation_S.Type != POP_NONE) { if(PostSubOperation_S.Format < 0) PostSubOperation_S.Format = PostOperation_S.Format; if(!PostSubOperation_S.TimeValue_L) PostSubOperation_S.TimeValue_L = PostOperation_S.TimeValue_L; if(!PostSubOperation_S.TimeImagValue_L) PostSubOperation_S.TimeImagValue_L = PostOperation_S.TimeImagValue_L; if(!PostSubOperation_S.LastTimeStepOnly) PostSubOperation_S.LastTimeStepOnly = PostOperation_S.LastTimeStepOnly; if(!PostSubOperation_S.NoMesh) PostSubOperation_S.NoMesh = PostOperation_S.NoMesh; if(PostSubOperation_S.OverrideTimeStepValue < 0) PostSubOperation_S.OverrideTimeStepValue = PostOperation_S.OverrideTimeStepValue; if(!PostSubOperation_S.CatFile) PostSubOperation_S.CatFile = PostOperation_S.CatFile; List_Add($$ = $1, &PostSubOperation_S); } } ; PostSubOperation : tPlot '[' PostQuantitiesToPrint PrintSubType PrintOptions ']' tEND { vyyerror("Plot has been superseded by Print (Plot OnRegion becomes Print OnElementsOf)"); } | tPrint '[' PostQuantitiesToPrint PrintSubType PrintOptions ']' tEND { PostSubOperation_S.Type = POP_PRINT; } | tPrint '[' tBIGSTR ',' Expression PrintOptions ']' tEND { PostSubOperation_S.Type = POP_EXPRESSION; PostSubOperation_S.Case.Expression.String = $3; PostSubOperation_S.Case.Expression.String2 = NULL; PostSubOperation_S.Case.Expression.ExpressionIndex = $5; PostSubOperation_S.PostQuantityIndex[0] = -1; } | tPrint '[' tBIGSTR ',' tStr '[' CharExpr ']' PrintOptions ']' tEND { PostSubOperation_S.Type = POP_EXPRESSION; PostSubOperation_S.Case.Expression.String = $3; PostSubOperation_S.Case.Expression.String2 = $7; PostSubOperation_S.Case.Expression.ExpressionIndex = -1; PostSubOperation_S.PostQuantityIndex[0] = -1; } | tEcho '[' CharExpr PrintOptions ']' tEND { PostSubOperation_S.Type = POP_EXPRESSION; PostSubOperation_S.Case.Expression.String = $3; PostSubOperation_S.Case.Expression.String2 = NULL; PostSubOperation_S.Case.Expression.ExpressionIndex = -1; PostSubOperation_S.PostQuantityIndex[0] = -1; } | tPrintGroup '[' GroupRHS { PostSubOperation_S.Type = POP_GROUP; PostSubOperation_S.Case.Group.ExtendedGroupIndex = Num_Group(&Group_S, (char*)"PO_Group", $3); PostSubOperation_S.PostQuantityIndex[0] = -1; } ',' tIn GroupRHS PrintOptions ']' tEND { PostSubOperation_S.Case.Group.GroupIndex = Num_Group(&Group_S, (char*)"PO_Group", $7); } | tSendMergeFileRequest '[' CharExpr ']' tEND { PostSubOperation_S.Type = POP_MERGE; PostSubOperation_S.FileOut = $3; } | Loop { PostSubOperation_S.Type = POP_NONE; } ; PostQuantitiesToPrint : String__Index PostQuantitySupport ',' { int i; if((i = List_ISearchSeq(InteractivePostProcessing_S.PostQuantity, $1, fcmp_PostQuantity_Name)) < 0) vyyerror("Unknown PostProcessing Quantity: %s", $1); PostSubOperation_S.PostQuantityIndex[0] = i; PostSubOperation_S.PostQuantityIndex[1] = -1; PostSubOperation_S.PostQuantitySupport[0] = $2; PostSubOperation_S.PostQuantitySupport[1] = -1; Free($1); } | String__Index PostQuantitySupport Combination tSTRING PostQuantitySupport ',' { Message::Warning("Combined post-quantities are deprecated: use registers instead"); int i; if((i = List_ISearchSeq(InteractivePostProcessing_S.PostQuantity, $1, fcmp_PostQuantity_Name)) < 0) vyyerror("Unknown PostProcessing Quantity: %s", $1); PostSubOperation_S.PostQuantityIndex[0] = i; PostSubOperation_S.PostQuantitySupport[0] = $2; int j = -1; if((j = List_ISearchSeq(InteractivePostProcessing_S.PostQuantity, $4, fcmp_PostQuantity_Name)) < 0) vyyerror("Unknown PostProcessing Quantity: %s", $4); PostSubOperation_S.PostQuantityIndex[1] = j; PostSubOperation_S.PostQuantitySupport[1] = $5; if(($2 < 0 && $5 < 0) || ($2 >= 0 && $5 >= 0)) { vyyerror("Postprocessing Quantities '%s' and '%s' of same type (%s)", $1, $4, ($2>0)? "with Support":"without Support"); } Free($1); Free($4); } ; Combination : '*' { PostSubOperation_S.CombinationType = MULTIPLICATION; } | '/' { PostSubOperation_S.CombinationType = DIVISION; } | '+' { PostSubOperation_S.CombinationType = ADDITION; } | '-' { PostSubOperation_S.CombinationType = SOUSTRACTION; } ; PostQuantitySupport : /* none */ { $$ = -1; } | '[' GroupRHS ']' { $$ = Num_Group(&Group_S, (char*)"PO_Support", $2); } ; PrintSubType : tOnGlobal { PostSubOperation_S.SubType = PRINT_ONREGION; PostSubOperation_S.Case.OnRegion.RegionIndex = -1; } | tOnRegion GroupRHS { PostSubOperation_S.SubType = PRINT_ONREGION; PostSubOperation_S.Case.OnRegion.RegionIndex = Num_Group(&Group_S, (char*)"PO_OnRegion", $2); } | tOnElementsOf GroupRHS { PostSubOperation_S.SubType = PRINT_ONELEMENTSOF; PostSubOperation_S.Case.OnRegion.RegionIndex = Num_Group(&Group_S, (char*)"PO_OnElementsOf", $2); } | tOnSection '{' '{' RecursiveListOfFExpr '}' '{' RecursiveListOfFExpr '}' '{' RecursiveListOfFExpr '}' '}' { PostSubOperation_S.SubType = PRINT_ONSECTION_2D; if(List_Nbr($4) != 3 || List_Nbr($7) != 3 || List_Nbr($10) != 3) vyyerror("Expected {3}{3}{3} coordinates, got {%d}{%d}{%d}", List_Nbr($4), List_Nbr($7), List_Nbr($10)); else{ List_Read($4, 0, &PostSubOperation_S.Case.OnSection.x[0]); List_Read($4, 1, &PostSubOperation_S.Case.OnSection.y[0]); List_Read($4, 2, &PostSubOperation_S.Case.OnSection.z[0]); List_Read($7, 0, &PostSubOperation_S.Case.OnSection.x[1]); List_Read($7, 1, &PostSubOperation_S.Case.OnSection.y[1]); List_Read($7, 2, &PostSubOperation_S.Case.OnSection.z[1]); List_Read($10, 0, &PostSubOperation_S.Case.OnSection.x[2]); List_Read($10, 1, &PostSubOperation_S.Case.OnSection.y[2]); List_Read($10, 2, &PostSubOperation_S.Case.OnSection.z[2]); } List_Delete($4); List_Delete($7); List_Delete($10); } | tOnGrid GroupRHS { PostSubOperation_S.SubType = PRINT_ONGRID; PostSubOperation_S.Case.OnRegion.RegionIndex = Num_Group(&Group_S, (char*)"PO_OnGrid", $2); } | tOnGrid '{' Expression ',' Expression ',' Expression '}' '{' ListOfFExpr ',' ListOfFExpr ',' ListOfFExpr '}' { PostSubOperation_S.SubType = PRINT_ONGRID_PARAM; PostSubOperation_S.Case.OnParamGrid.ExpressionIndex[0] = $3; PostSubOperation_S.Case.OnParamGrid.ExpressionIndex[1] = $5; PostSubOperation_S.Case.OnParamGrid.ExpressionIndex[2] = $7; PostSubOperation_S.Case.OnParamGrid.ParameterValue[0] = $10; PostSubOperation_S.Case.OnParamGrid.ParameterValue[1] = $12; PostSubOperation_S.Case.OnParamGrid.ParameterValue[2] = $14; } | tOnPoint '{' RecursiveListOfFExpr '}' { PostSubOperation_S.SubType = PRINT_ONGRID_0D; if(List_Nbr($3) != 3) vyyerror("Expected {3} coordinates, got {%d}", List_Nbr($3)); else{ List_Read($3, 0, &PostSubOperation_S.Case.OnGrid.x[0]); List_Read($3, 1, &PostSubOperation_S.Case.OnGrid.y[0]); List_Read($3, 2, &PostSubOperation_S.Case.OnGrid.z[0]); } List_Delete($3); } | tOnLine '{' '{' RecursiveListOfFExpr '}' '{' RecursiveListOfFExpr '}' '}' '{' FExpr '}' { PostSubOperation_S.SubType = PRINT_ONGRID_1D; if(List_Nbr($4) != 3 || List_Nbr($7) != 3) vyyerror("Expected {3}{3} coordinates, got {%d}{%d}", List_Nbr($4), List_Nbr($7)); else{ List_Read($4, 0, &PostSubOperation_S.Case.OnGrid.x[0]); List_Read($4, 1, &PostSubOperation_S.Case.OnGrid.y[0]); List_Read($4, 2, &PostSubOperation_S.Case.OnGrid.z[0]); List_Read($7, 0, &PostSubOperation_S.Case.OnGrid.x[1]); List_Read($7, 1, &PostSubOperation_S.Case.OnGrid.y[1]); List_Read($7, 2, &PostSubOperation_S.Case.OnGrid.z[1]); } PostSubOperation_S.Case.OnGrid.n[0] = (int)$11; List_Delete($4); List_Delete($7); } | tOnPlane '{' '{' RecursiveListOfFExpr '}' '{' RecursiveListOfFExpr '}' '{' RecursiveListOfFExpr '}' '}' '{' FExpr ',' FExpr '}' { PostSubOperation_S.SubType = PRINT_ONGRID_2D; if(List_Nbr($4) != 3 || List_Nbr($7) != 3 || List_Nbr($10) != 3) vyyerror("Expected {3}{3}{3} coordinates, got {%d}{%d}{%d}", List_Nbr($4), List_Nbr($7), List_Nbr($10)); else{ List_Read($4, 0, &PostSubOperation_S.Case.OnGrid.x[0]); List_Read($4, 1, &PostSubOperation_S.Case.OnGrid.y[0]); List_Read($4, 2, &PostSubOperation_S.Case.OnGrid.z[0]); List_Read($7, 0, &PostSubOperation_S.Case.OnGrid.x[1]); List_Read($7, 1, &PostSubOperation_S.Case.OnGrid.y[1]); List_Read($7, 2, &PostSubOperation_S.Case.OnGrid.z[1]); List_Read($10, 0, &PostSubOperation_S.Case.OnGrid.x[2]); List_Read($10, 1, &PostSubOperation_S.Case.OnGrid.y[2]); List_Read($10, 2, &PostSubOperation_S.Case.OnGrid.z[2]); } PostSubOperation_S.Case.OnGrid.n[0] = (int)$14; PostSubOperation_S.Case.OnGrid.n[1] = (int)$16; List_Delete($4); List_Delete($7); List_Delete($10); } | tOnBox '{' '{' RecursiveListOfFExpr '}' '{' RecursiveListOfFExpr '}' '{' RecursiveListOfFExpr '}' '{' RecursiveListOfFExpr '}' '}' '{' FExpr ',' FExpr ',' FExpr '}' { PostSubOperation_S.SubType = PRINT_ONGRID_3D; if(List_Nbr($4) != 3 || List_Nbr($7) != 3 || List_Nbr($10) != 3 || List_Nbr($13) != 3) vyyerror("Expected {3}{3}{3}{3} coordinates, got {%d}{%d}{%d}{%d}", List_Nbr($4), List_Nbr($7), List_Nbr($10), List_Nbr($13)); else{ List_Read($4, 0, &PostSubOperation_S.Case.OnGrid.x[0]); List_Read($4, 1, &PostSubOperation_S.Case.OnGrid.y[0]); List_Read($4, 2, &PostSubOperation_S.Case.OnGrid.z[0]); List_Read($7, 0, &PostSubOperation_S.Case.OnGrid.x[1]); List_Read($7, 1, &PostSubOperation_S.Case.OnGrid.y[1]); List_Read($7, 2, &PostSubOperation_S.Case.OnGrid.z[1]); List_Read($10, 0, &PostSubOperation_S.Case.OnGrid.x[2]); List_Read($10, 1, &PostSubOperation_S.Case.OnGrid.y[2]); List_Read($10, 2, &PostSubOperation_S.Case.OnGrid.z[2]); List_Read($13, 0, &PostSubOperation_S.Case.OnGrid.x[3]); List_Read($13, 1, &PostSubOperation_S.Case.OnGrid.y[3]); List_Read($13, 2, &PostSubOperation_S.Case.OnGrid.z[3]); } PostSubOperation_S.Case.OnGrid.n[0] = (int)$17; PostSubOperation_S.Case.OnGrid.n[1] = (int)$19; PostSubOperation_S.Case.OnGrid.n[2] = (int)$21; List_Delete($4); List_Delete($7); List_Delete($10); List_Delete($13); } /* should be generalized with a '{' RecursiveListOfFExpr '}' */ | tOnRegion GroupRHS tWithArgument tSTRING '{' FExpr ',' FExpr '}' '{' FExpr '}' { PostSubOperation_S.SubType = PRINT_WITHARGUMENT; PostSubOperation_S.Case.WithArgument.RegionIndex = Num_Group(&Group_S, (char*)"PO_On", $2); int i; if((i = List_ISearchSeq(Problem_S.Expression, $4, fcmp_Expression_Name)) < 0) vyyerror("Unknown Name of Expression: %s", $4); Free($4); PostSubOperation_S.Case.WithArgument.ArgumentIndex = i; PostSubOperation_S.Case.WithArgument.x[0] = $6; PostSubOperation_S.Case.WithArgument.x[1] = $8; PostSubOperation_S.Case.WithArgument.n = (int)$11; } ; PrintOptions : /* none */ { } | PrintOptions PrintOption ; PrintOption : ',' tFile CharExpr { if(!PostOperation_S.AppendString){ PostSubOperation_S.FileOut = $3; } else{ PostSubOperation_S.FileOut = (char *)Malloc((strlen($3)+strlen(PostOperation_S.AppendString)+1)*sizeof(char)); strcpy(PostSubOperation_S.FileOut, $3); strcat(PostSubOperation_S.FileOut, PostOperation_S.AppendString); Free($3); } PostSubOperation_S.CatFile = 0; } | ',' tFile '>' CharExpr { if(!PostOperation_S.AppendString){ PostSubOperation_S.FileOut = $4; } else{ PostSubOperation_S.FileOut = (char *)Malloc((strlen($4)+strlen(PostOperation_S.AppendString)+1)*sizeof(char)); strcpy(PostSubOperation_S.FileOut, $4); strcat(PostSubOperation_S.FileOut, PostOperation_S.AppendString); Free($4); } PostSubOperation_S.CatFile = 1; } | ',' tFile tGREATERGREATER CharExpr { if(!PostOperation_S.AppendString){ PostSubOperation_S.FileOut = $4; } else{ PostSubOperation_S.FileOut = (char *)Malloc((strlen($4)+strlen(PostOperation_S.AppendString)+1)*sizeof(char)); strcpy(PostSubOperation_S.FileOut, $4); strcat(PostSubOperation_S.FileOut, PostOperation_S.AppendString); Free($4); } PostSubOperation_S.CatFile = 2; } | ',' tAppendToExistingFile FExpr { PostSubOperation_S.CatFile = $3; } | ',' tDepth FExpr { PostSubOperation_S.Depth = (int)$3; } | ',' tSkin { PostSubOperation_S.Skin = 1; } | ',' tSmoothing { PostSubOperation_S.Smoothing = 1; } | ',' tSmoothing FExpr { PostSubOperation_S.Smoothing = (int)$3; } | ',' tHarmonicToTime FExpr { PostSubOperation_S.HarmonicToTime = (int)$3; } | ',' tCosineTransform { PostSubOperation_S.FourierTransform = 2; } | ',' tFourierTransform { PostSubOperation_S.FourierTransform = 1; } | ',' tFormat tSTRING { PostSubOperation_S.Format = Get_DefineForString(PostSubOperation_Format, $3, &FlagError); if(FlagError){ Get_Valid_SXD($3, PostSubOperation_Format); vyyerror("Unknown PostProcessing Format: %s", $3); } Free($3); } | ',' tComma { PostSubOperation_S.Comma = 1; } | ',' tValueIndex FExpr { PostSubOperation_S.ValueIndex = $3; } | ',' tValueName CharExpr { PostSubOperation_S.ValueName = $3; } | ',' tName CharExpr { PostSubOperation_S.Label = $3; } | ',' tDimension FExpr { if((int)$3 >= 1 && (int)$3 <= 3) PostSubOperation_S.Dimension = (int)$3; else vyyerror("Wrong Dimension in Print"); } | ',' tTimeStep ListOfFExpr { PostSubOperation_S.FrozenTimeStepList = 1; for(int i = 0; i < List_Nbr($3); i++){ double d; List_Read($3,i,&d); int j = (int)d; List_Add(PostSubOperation_S.TimeStep_L, &j); } List_Delete($3); } | ',' tTimeValue ListOfFExpr { PostSubOperation_S.TimeValue_L = $3; } | ',' tTimeImagValue ListOfFExpr { PostSubOperation_S.TimeImagValue_L = $3; } | ',' tAdapt tSTRING { PostSubOperation_S.Adapt = Get_DefineForString(PostSubOperation_AdaptationType, $3, &FlagError); if(FlagError){ Get_Valid_SXD($3, PostSubOperation_AdaptationType); vyyerror("Unknown Adaptation method: %s", $3); } } | ',' tSort tSTRING { PostSubOperation_S.Sort = Get_DefineForString(PostSubOperation_SortType, $3, &FlagError); if(FlagError){ Get_Valid_SXD($3, PostSubOperation_SortType); vyyerror("Unknown Sort method: %s", $3); } } | ',' tTarget FExpr { if($3 >= 0.) PostSubOperation_S.Target = $3; else vyyerror("Bad Target value"); } | ',' tValue ListOfFExpr { for(int i = 0; i < List_Nbr($3); i++){ double d; List_Read($3,i,&d); List_Add(PostSubOperation_S.Value_L, &d); } List_Delete($3); } | ',' tIso FExpr { PostSubOperation_S.Iso = (int)$3; } | ',' tIso '{' RecursiveListOfFExpr '}' { PostSubOperation_S.Iso = -1; for(int i = 0; i < List_Nbr($4); i++){ double d; List_Read($4,i,&d); List_Add(PostSubOperation_S.Iso_L, &d); } List_Delete($4); } | ',' tNoNewLine { PostSubOperation_S.NoNewLine = 1; } | ',' tNoTitle { PostSubOperation_S.NoTitle = 1; } | ',' tDecomposeInSimplex { PostSubOperation_S.DecomposeInSimplex = 1; } | ',' tFrequency ListOfFExpr { for(int i = 0; i < List_Nbr($3); i++){ double d; List_Read($3,i,&d); List_Add(PostSubOperation_S.Frequency_L, &d); } List_Delete($3); } | ',' tChangeOfCoordinates '{' Expression ',' Expression ',' Expression '}' { PostSubOperation_S.ChangeOfCoordinates[0] = $4; PostSubOperation_S.ChangeOfCoordinates[1] = $6; PostSubOperation_S.ChangeOfCoordinates[2] = $8; } | ',' tChangeOfValues ListOfExpression { PostSubOperation_S.ChangeOfValues = List_Copy(ListOfInt_L); } | ',' tTimeLegend { PostSubOperation_S.Legend = LEGEND_TIME; PostSubOperation_S.LegendPosition[0] = 1.e5; PostSubOperation_S.LegendPosition[1] = 30.; /* (align<<16)|(font<<8)|(fontsize) */ PostSubOperation_S.LegendPosition[2] = 66574; } | ',' tTimeLegend '{' FExpr ',' FExpr ',' FExpr '}' { PostSubOperation_S.Legend = LEGEND_TIME; PostSubOperation_S.LegendPosition[0] = $4; PostSubOperation_S.LegendPosition[1] = $6; PostSubOperation_S.LegendPosition[2] = $8; } | ',' tFrequencyLegend { PostSubOperation_S.Legend = LEGEND_FREQUENCY; PostSubOperation_S.LegendPosition[0] = 1.e5; PostSubOperation_S.LegendPosition[1] = 30.; /* (align<<16)|(font<<8)|(fontsize) */ PostSubOperation_S.LegendPosition[2] = 66574; } | ',' tFrequencyLegend '{' FExpr ',' FExpr ',' FExpr '}' { PostSubOperation_S.Legend = LEGEND_FREQUENCY; PostSubOperation_S.LegendPosition[0] = $4; PostSubOperation_S.LegendPosition[1] = $6; PostSubOperation_S.LegendPosition[2] = $8; } | ',' tEigenvalueLegend { PostSubOperation_S.Legend = LEGEND_EIGENVALUES; PostSubOperation_S.LegendPosition[0] = 1.e5; PostSubOperation_S.LegendPosition[1] = 30.; /* (align<<16)|(font<<8)|(fontsize) */ PostSubOperation_S.LegendPosition[2] = 66574; } | ',' tEigenvalueLegend '{' FExpr ',' FExpr ',' FExpr '}' { PostSubOperation_S.Legend = LEGEND_EIGENVALUES; PostSubOperation_S.LegendPosition[0] = $4; PostSubOperation_S.LegendPosition[1] = $6; PostSubOperation_S.LegendPosition[2] = $8; } | ',' tEvaluationPoints '{' RecursiveListOfFExpr '}' { if(List_Nbr($4)%3 != 0) vyyerror("Expected 3n coordinates, got %d", List_Nbr($4)); else { PostSubOperation_S.EvaluationPoints = $4; } } | ',' tStoreInVariable '$' String__Index { PostSubOperation_S.StoreInVariable = $4; } | ',' tStoreInRegister FExpr { PostSubOperation_S.StoreInRegister = (int)$3 - 1; } | ',' tStoreMinInRegister FExpr { PostSubOperation_S.StoreMinInRegister = (int)$3 - 1; } | ',' tStoreMinXinRegister FExpr { PostSubOperation_S.StoreMinXinRegister = (int)$3 - 1; } | ',' tStoreMinYinRegister FExpr { PostSubOperation_S.StoreMinYinRegister = (int)$3 - 1; } | ',' tStoreMinZinRegister FExpr { PostSubOperation_S.StoreMinZinRegister = (int)$3 - 1; } | ',' tStoreMaxInRegister FExpr { PostSubOperation_S.StoreMaxInRegister = (int)$3 - 1; } | ',' tStoreMaxXinRegister FExpr { PostSubOperation_S.StoreMaxXinRegister = (int)$3 - 1; } | ',' tStoreMaxYinRegister FExpr { PostSubOperation_S.StoreMaxYinRegister = (int)$3 - 1; } | ',' tStoreMaxZinRegister FExpr { PostSubOperation_S.StoreMaxZinRegister = (int)$3 - 1; } | ',' tStoreInField FExpr { PostSubOperation_S.StoreInField = $3; } | ',' tStoreInMeshBasedField FExpr { PostSubOperation_S.StoreInMeshBasedField = $3; } | ',' tLastTimeStepOnly { PostSubOperation_S.LastTimeStepOnly = 1; } | ',' tAppendTimeStepToFileName { PostSubOperation_S.AppendTimeStepToFileName = 1; } | ',' tAppendTimeStepToFileName FExpr { PostSubOperation_S.AppendTimeStepToFileName = $3; } | ',' tAppendExpressionToFileName Expression { PostSubOperation_S.AppendExpressionToFileName = $3; } | ',' tAppendExpressionFormat CharExpr { PostSubOperation_S.AppendExpressionFormat = $3; } | ',' tAppendStringToFileName CharExpr { PostSubOperation_S.AppendStringToFileName = $3; } | ',' tOverrideTimeStepValue FExpr { PostSubOperation_S.OverrideTimeStepValue = $3; } | ',' tNoMesh { PostSubOperation_S.NoMesh = 1; } | ',' tNoMesh FExpr { PostSubOperation_S.NoMesh = $3; } | ',' tSendToServer CharExpr { PostSubOperation_S.SendToServer = $3; } | ',' tColor CharExpr { PostSubOperation_S.Color = $3; } | ',' tNewCoordinates CharExpr { PostSubOperation_S.NewCoordinates = 1; PostSubOperation_S.NewCoordinatesFile = $3; } ; /* ------------------------------------------------------------------------ */ /* L o o p */ /* ------------------------------------------------------------------------ */ CallArg : String__Index { $$ = $1; } | CharExprNoVar { $$ = $1; } ; Loop : tFor '(' FExpr tDOTS FExpr ')' { LoopControlVariablesTab[ImbricatedLoop][0] = $3; LoopControlVariablesTab[ImbricatedLoop][1] = $5; LoopControlVariablesTab[ImbricatedLoop][2] = 1.0; LoopControlVariablesNameTab[ImbricatedLoop] = (char*)""; fgetpos(getdp_yyin, &FposImbricatedLoopsTab[ImbricatedLoop]); LinenoImbricatedLoopsTab[ImbricatedLoop] = getdp_yylinenum; if($3 > $5) skipUntil("For", "EndFor"); else ImbricatedLoop++; if(ImbricatedLoop > MAX_RECUR_LOOPS-1){ vyyerror("Reached maximum number of imbricated loops"); ImbricatedLoop = MAX_RECUR_LOOPS-1; } } | tFor '(' FExpr tDOTS FExpr tDOTS FExpr ')' { LoopControlVariablesTab[ImbricatedLoop][0] = $3; LoopControlVariablesTab[ImbricatedLoop][1] = $5; LoopControlVariablesTab[ImbricatedLoop][2] = $7; LoopControlVariablesNameTab[ImbricatedLoop] = (char*)""; fgetpos(getdp_yyin, &FposImbricatedLoopsTab[ImbricatedLoop]); LinenoImbricatedLoopsTab[ImbricatedLoop] = getdp_yylinenum; if(($7 > 0. && $3 > $5) || ($7 < 0. && $3 < $5)) skipUntil("For", "EndFor"); else ImbricatedLoop++; if(ImbricatedLoop > MAX_RECUR_LOOPS-1){ vyyerror("Reached maximum number of imbricated loops"); ImbricatedLoop = MAX_RECUR_LOOPS-1; } } | tFor tSTRING tIn '{' FExpr tDOTS FExpr '}' { LoopControlVariablesTab[ImbricatedLoop][0] = $5; LoopControlVariablesTab[ImbricatedLoop][1] = $7; LoopControlVariablesTab[ImbricatedLoop][2] = 1.0; LoopControlVariablesNameTab[ImbricatedLoop] = $2; Constant_S.Name = $2; Constant_S.Type = VAR_FLOAT; Constant_S.Value.Float = $5; Tree_Replace(ConstantTable_L, &Constant_S); fgetpos(getdp_yyin, &FposImbricatedLoopsTab[ImbricatedLoop]); /* hack_fsetpos_printf(); */ LinenoImbricatedLoopsTab[ImbricatedLoop] = getdp_yylinenum; if($5 > $7) skipUntil("For", "EndFor"); else ImbricatedLoop++; if(ImbricatedLoop > MAX_RECUR_LOOPS-1){ vyyerror("Reached maximum number of imbricated loops"); ImbricatedLoop = MAX_RECUR_LOOPS-1; } } | tFor tSTRING tIn '{' FExpr tDOTS FExpr tDOTS FExpr '}' { LoopControlVariablesTab[ImbricatedLoop][0] = $5; LoopControlVariablesTab[ImbricatedLoop][1] = $7; LoopControlVariablesTab[ImbricatedLoop][2] = $9; LoopControlVariablesNameTab[ImbricatedLoop] = $2; Constant_S.Name = $2; Constant_S.Type = VAR_FLOAT; Constant_S.Value.Float = $5; Tree_Replace(ConstantTable_L, &Constant_S); fgetpos(getdp_yyin, &FposImbricatedLoopsTab[ImbricatedLoop]); LinenoImbricatedLoopsTab[ImbricatedLoop] = getdp_yylinenum; if(($9 > 0. && $5 > $7) || ($9 < 0. && $5 < $7)) skipUntil("For", "EndFor"); else ImbricatedLoop++; if(ImbricatedLoop > MAX_RECUR_LOOPS-1){ vyyerror("Reached maximum number of imbricated loops"); ImbricatedLoop = MAX_RECUR_LOOPS-1; } } | tEndFor { if(ImbricatedLoop <= 0){ vyyerror("Invalid For/EndFor loop"); ImbricatedLoop = 0; } else{ double x0 = LoopControlVariablesTab[ImbricatedLoop-1][0]; double x1 = LoopControlVariablesTab[ImbricatedLoop-1][1]; double step = LoopControlVariablesTab[ImbricatedLoop-1][2]; int do_next = (step > 0.) ? (x0+step <= x1) : (x0+step >= x1); if(do_next){ LoopControlVariablesTab[ImbricatedLoop-1][0] += LoopControlVariablesTab[ImbricatedLoop-1][2]; if(strlen(LoopControlVariablesNameTab[ImbricatedLoop-1])){ Constant_S.Name = LoopControlVariablesNameTab[ImbricatedLoop-1]; Constant_S.Type = VAR_FLOAT; Constant_S.Value.Float = LoopControlVariablesTab[ImbricatedLoop-1][0]; if(!Tree_Search(ConstantTable_L, &Constant_S)) vyyerror("Unknown For/EndFor loop control variable %s", Constant_S.Name); Tree_Replace(ConstantTable_L, &Constant_S); } fsetpos(getdp_yyin, &FposImbricatedLoopsTab[ImbricatedLoop-1]); /* fsetpos() seems to position the file just after the For but with one additional character (the one after EndFor) at the beginning. I do not understand why there is such a mixing of two separate data. hack_fsetpos() removes the useless additional character. */ hack_fsetpos(); /* hack_fsetpos_printf(); */ getdp_yylinenum = LinenoImbricatedLoopsTab[ImbricatedLoop-1]; } else{ ImbricatedLoop--; } } } | tMacro tSTRING { if(!MacroManager::Instance()->createMacro (std::string($2), getdp_yyin, getdp_yyname, getdp_yylinenum + 1)) vyyerror("Redefinition of macro '%s'", $2); skipUntil(NULL, "Return"); Free($2); } | tMacro CharExprNoVar { if(!MacroManager::Instance()->createMacro (std::string($2), getdp_yyin, getdp_yyname, getdp_yylinenum + 1)) vyyerror("Redefinition of macro '%s'", $2); skipUntil(NULL, "Return"); Free($2); } | tReturn { if(!MacroManager::Instance()->leaveMacro (&getdp_yyin, getdp_yyname, getdp_yylinenum)) vyyerror("Error while exiting macro"); } | tCall CallArg tEND { if(!MacroManager::Instance()->enterMacro (std::string($2), &getdp_yyin, getdp_yyname, getdp_yylinenum)) vyyerror("Unknown macro '%s'", $2); Free($2); } | tCallTest '(' FExpr ')' CallArg tEND { if($3) if(!MacroManager::Instance()->enterMacro (std::string($5), &getdp_yyin, getdp_yyname, getdp_yylinenum)) vyyerror("Unknown macro '%s'", $5); Free($5); } | tIf '(' FExpr ')' { ImbricatedTest++; if(ImbricatedTest > MAX_RECUR_TESTS-1){ vyyerror("Reached maximum number of imbricated tests"); ImbricatedTest = MAX_RECUR_TESTS-1; } if($3){ // Current test is true statusImbricatedTests[ImbricatedTest] = 1; } else{ statusImbricatedTests[ImbricatedTest] = 0; // Go after the next ElseIf or Else or EndIf int type_until2 = 0; skipUntil_test("If", "EndIf", "ElseIf", 4, &type_until2); if(!type_until2) ImbricatedTest--; // EndIf reached } } | tElseIf '(' FExpr ')' { if(ImbricatedTest > 0){ if (statusImbricatedTests[ImbricatedTest]){ // Last test (If or ElseIf) was true, thus go after EndIf (out of If EndIf) skipUntil("If", "EndIf"); ImbricatedTest--; } else{ // Previous test(s) (If and ElseIf) not yet true if($3){ statusImbricatedTests[ImbricatedTest] = 1; } else{ // Current test still not true: statusImbricatedTests[ImbricatedTest] = 0; // Go after the next ElseIf or Else or EndIf int type_until2 = 0; skipUntil_test("If", "EndIf", "ElseIf", 4, &type_until2); if(!type_until2) ImbricatedTest--; } } } else{ Message::Error("Orphan ElseIf"); } } | tElse { if(ImbricatedTest > 0){ if(statusImbricatedTests[ImbricatedTest]){ skipUntil("If", "EndIf"); ImbricatedTest--; } } else{ Message::Error("Orphan Else"); } } | tEndIf { ImbricatedTest--; if(ImbricatedTest < 0) Message::Warning("line %ld : Orphan EndIf", getdp_yylinenum); } | Affectation ; /* ------------------------------------------------------------------------ */ /* C o n s t a n t E x p r e s s i o n s (FExpr) */ /* ------------------------------------------------------------------------ */ Printf : tPrintf { $$ = 3; } | tMPI_Printf { $$ = -3; } ; Affectation : tDefineConstant '[' DefineConstants ']' tEND | tUndefineConstant '[' UndefineConstants ']' tEND | tDelete String__Index tEND { Constant_S.Name = $2; // FIXME: leak if constant is list or char; all Tree_Replace functions // below also leak; correct fix is to replace all of this with a std::map // like in Gmsh Tree_Suppress(ConstantTable_L, &Constant_S); Free($2); } | String__Index tDEF ListOfFExpr tEND { Constant_S.Name = $1; if(List_Nbr($3) == 1){ Constant_S.Type = VAR_FLOAT; List_Read($3, 0, &Constant_S.Value.Float); List_Delete($3); } else{ Constant_S.Type = VAR_LISTOFFLOAT; Constant_S.Value.ListOfFloat = $3; } Tree_Replace(ConstantTable_L, &Constant_S); } | String__Index '(' ')' tDEF ListOfFExpr tEND { Constant_S.Name = $1; Constant_S.Type = VAR_LISTOFFLOAT; Constant_S.Value.ListOfFloat = $5; Tree_Replace(ConstantTable_L, &Constant_S); } | String__Index '(' RecursiveListOfFExpr ')' tDEF ListOfFExpr tEND { Constant_S.Name = $1; Constant *c = (Constant*)Tree_PQuery(ConstantTable_L, &Constant_S); if(c && (c->Type == VAR_LISTOFFLOAT)){ if(List_Nbr($3) == List_Nbr($6)){ for(int i = 0; i < List_Nbr($3); i++){ double d; List_Read($3, i, &d); int idx = (int)d; if(idx >= 0 && idx < List_Nbr(c->Value.ListOfFloat)){ double *pd = (double*)List_Pointer(c->Value.ListOfFloat, idx); double d2 = *(double*)List_Pointer($6, i); *pd = d2; } else vyyerror("Index %d out of range", idx); } } else vyyerror("Bad list sizes for affectation %d != %d", List_Nbr($3), List_Nbr($6)); } else vyyerror("Unknown list Constant: %s", $1); List_Delete($3); List_Delete($6); } | String__Index '(' RecursiveListOfFExpr ')' '+' tDEF ListOfFExpr tEND { Constant_S.Name = $1; Constant *c = (Constant*)Tree_PQuery(ConstantTable_L, &Constant_S); if(c && (c->Type == VAR_LISTOFFLOAT)){ if(List_Nbr($3) == List_Nbr($7)){ for(int i = 0; i < List_Nbr($3); i++){ double d; List_Read($3, i, &d); int idx = (int)d; if(idx >= 0 && idx < List_Nbr(c->Value.ListOfFloat)){ double *pd = (double*)List_Pointer(c->Value.ListOfFloat, idx); double d2 = *(double*)List_Pointer($7, i); *pd += d2; } else vyyerror("Index %d out of range", idx); } } else vyyerror("Bad list sizes (%d, %d) for += operation", List_Nbr($3), List_Nbr($7)); } else vyyerror("Unknown list Constant: %s", $1); List_Delete($3); List_Delete($7); } | String__Index '(' RecursiveListOfFExpr ')' '-' tDEF ListOfFExpr tEND { Constant_S.Name = $1; Constant *c = (Constant*)Tree_PQuery(ConstantTable_L, &Constant_S); if(c && (c->Type == VAR_LISTOFFLOAT)){ if(List_Nbr($3) == List_Nbr($7)){ for(int i = 0; i < List_Nbr($3); i++){ double d; List_Read($3, i, &d); int idx = (int)d; if(idx >= 0 && idx < List_Nbr(c->Value.ListOfFloat)){ double *pd = (double*)List_Pointer(c->Value.ListOfFloat, idx); double d2 = *(double*)List_Pointer($7, i); *pd -= d2; } else vyyerror("Index %d out of range", idx); } } else vyyerror("Bad list sizes (%d, %d) for -= operation", List_Nbr($3), List_Nbr($7)); } else vyyerror("Unknown list Constant: %s", $1); List_Delete($3); List_Delete($7); } | String__Index '+' tDEF ListOfFExpr tEND { Constant_S.Name = $1; Constant *c = (Constant*)Tree_PQuery(ConstantTable_L, &Constant_S); if(c){ if(c->Type == VAR_FLOAT && List_Nbr($4) == 1){ double d; List_Read($4, 0, &d); c->Value.Float += d; } else if(c->Type == VAR_LISTOFFLOAT){ for(int i = 0; i < List_Nbr($4); i++) List_Add(c->Value.ListOfFloat, List_Pointer($4, i)); } else vyyerror("Cannot append list to float"); } else vyyerror("Unknown Constant: %s", $1); List_Delete($4); } | String__Index '(' ')' '+' tDEF ListOfFExpr tEND { Constant_S.Name = $1; Constant *c = (Constant*)Tree_PQuery(ConstantTable_L, &Constant_S); if(c){ if(c->Type == VAR_LISTOFFLOAT){ for(int i = 0; i < List_Nbr($6); i++) List_Add(c->Value.ListOfFloat, List_Pointer($6, i)); } else vyyerror("Cannot append list to float"); } else vyyerror("Unknown Constant: %s", $1); List_Delete($6); } | String__Index '-' tDEF ListOfFExpr tEND { Constant_S.Name = $1; Constant *c = (Constant*)Tree_PQuery(ConstantTable_L, &Constant_S); if(c){ if(c->Type == VAR_FLOAT && List_Nbr($4) == 1){ double d; List_Read($4, 0, &d); c->Value.Float -= d; } else if(c->Type == VAR_LISTOFFLOAT){ std::vector tmp; for(int i = 0; i < List_Nbr(c->Value.ListOfFloat); i++){ double d; List_Read(c->Value.ListOfFloat, i, &d); tmp.push_back(d); } for(int i = 0; i < List_Nbr($4); i++){ double d; List_Read($4, i, &d); std::vector::iterator it = std::find(tmp.begin(), tmp.end(), d); if(it != tmp.end()) tmp.erase(it); } List_Reset(c->Value.ListOfFloat); for(unsigned int i = 0; i < tmp.size(); i++) List_Add(c->Value.ListOfFloat, &tmp[i]); } else vyyerror("Cannot erase list from float"); } else vyyerror("Unknown Constant: %s", $1); List_Delete($4); } | String__Index '(' ')' '-' tDEF ListOfFExpr tEND { Constant_S.Name = $1; Constant *c = (Constant*)Tree_PQuery(ConstantTable_L, &Constant_S); if(c){ if(c->Type == VAR_LISTOFFLOAT){ std::vector tmp; for(int i = 0; i < List_Nbr(c->Value.ListOfFloat); i++){ double d; List_Read(c->Value.ListOfFloat, i, &d); tmp.push_back(d); } for(int i = 0; i < List_Nbr($6); i++){ double d; List_Read($6, i, &d); std::vector::iterator it = std::find(tmp.begin(), tmp.end(), d); if(it != tmp.end()) tmp.erase(it); } List_Reset(c->Value.ListOfFloat); for(unsigned int i = 0; i < tmp.size(); i++) List_Add(c->Value.ListOfFloat, &tmp[i]); } else vyyerror("Cannot erase list from float"); } else vyyerror("Unknown Constant: %s", $1); List_Delete($6); } | String__Index tDEF CharExprNoVar tEND { Constant_S.Name = $1; Constant_S.Type = VAR_CHAR; Constant_S.Value.Char = $3; Tree_Replace(ConstantTable_L, &Constant_S); } | Printf LP CharExprNoVar RP tEND { Message::Direct($1, $3); } | Printf String__Index tEND { Constant_S.Name = $2; if(!Tree_Query(ConstantTable_L, &Constant_S)) vyyerror("Unknown Constant: %s", $2); else if(Constant_S.Type != VAR_LISTOFFLOAT) Message::Direct($1, "%s: %g", $2, Constant_S.Value.Float); else Message::Direct($1, "%s: Dimension %d", $2, List_Nbr(Constant_S.Value.ListOfFloat)); for(int i = 0; i < List_Nbr(Constant_S.Value.ListOfFloat); i++) { double d; List_Read(Constant_S.Value.ListOfFloat, i, &d); Message::Direct($1, " (%d) %g", i, d); } } | Printf '#' tEND { Message::Direct($1, "Line number: %d", getdp_yylinenum); } | Printf LP CharExprNoVar ',' RecursiveListOfFExpr RP tEND { char tmpstr[256]; int i = Print_ListOfDouble($3, $5, tmpstr); if(i < 0) vyyerror("Too few arguments in Printf"); else if(i > 0) vyyerror("Too many arguments (%d) in Printf", i); else Message::Direct($1, tmpstr); List_Delete($5); } // deprectated | tRead '(' String__Index ')' tEND { Message::Info("? "); char tmpstr[256]; fgets(tmpstr, sizeof(tmpstr), stdin); Constant_S.Value.Float = atof(tmpstr); Constant_S.Name = $3; Constant_S.Type = VAR_FLOAT; Tree_Replace(ConstantTable_L, &Constant_S); } | tRead '[' String__Index ']' tEND { Message::Info("? "); char tmpstr[256]; fgets(tmpstr, sizeof(tmpstr), stdin); Constant_S.Value.Float = atof(tmpstr); Constant_S.Name = $3; Constant_S.Type = VAR_FLOAT; Tree_Replace(ConstantTable_L, &Constant_S); } // deprectated | tRead '(' String__Index ')' '[' FExpr ']' tEND { Message::Info("[=%g] ? ",$6); char tmpstr[256]; fgets(tmpstr, sizeof(tmpstr), stdin); if(!strcmp(tmpstr,"\n")) Constant_S.Value.Float = $6; else Constant_S.Value.Float = atof(tmpstr); Constant_S.Name = $3; Constant_S.Type = VAR_FLOAT; Tree_Replace(ConstantTable_L, &Constant_S); } | tRead '[' String__Index ',' FExpr '}' tEND { Message::Info("[=%g] ? ",$5); char tmpstr[256]; fgets(tmpstr, sizeof(tmpstr), stdin); if(!strcmp(tmpstr,"\n")) Constant_S.Value.Float = $5; else Constant_S.Value.Float = atof(tmpstr); Constant_S.Name = $3; Constant_S.Type = VAR_FLOAT; Tree_Replace(ConstantTable_L, &Constant_S); } | tPrintConstants tEND { Print_Constants(); } ; Enumeration : FExpr tDEF CharExpr { $$ = List_Create(20,20,sizeof(doubleXstring)); doubleXstring v = {$1, $3}; List_Add($$, &v); } | Enumeration ',' FExpr tDEF CharExpr { doubleXstring v = {$3, $5}; List_Add($$, &v); } ; FloatParameterOptions : | FloatParameterOptions FloatParameterOption ; FloatParameterOption : ',' tSTRING ListOfFExpr { std::string key($2); for(int i = 0; i < List_Nbr($3); i++){ double v; List_Read($3, i, &v); FloatOptions_S[key].push_back(v); } Free($2); List_Delete($3); } | ',' tSTRING '{' Enumeration '}' { std::string key($2); for(int i = 0; i < List_Nbr($4); i++){ doubleXstring v; List_Read($4, i, &v); FloatOptions_S[key].push_back(v.d); CharOptions_S[key].push_back(v.s); } Free($2); for(int i = 0; i < List_Nbr($4); i++) Free(((doubleXstring*)List_Pointer($4, i))->s); List_Delete($4); } | ',' tSTRING CharExprNoVar { std::string key($2); std::string val($3); CharOptions_S[key].push_back(val); Free($2); Free($3); } | ',' tName CharExprNoVar { std::string key("Name"); std::string val($3); CharOptions_S[key].push_back(val); Free($3); } ; CharParameterOptions : | CharParameterOptions CharParameterOption ; CharParameterOption : ',' tSTRING FExpr { std::string key($2); double val = $3; FloatOptions_S[key].push_back(val); Free($2); } | ',' tSTRING CharExprNoVar { std::string key($2); std::string val($3); CharOptions_S[key].push_back(val); Free($2); Free($3); } | ',' tName CharExprNoVar // Name is already a reserved GetDP keyword { std::string key("Name"); std::string val($3); CharOptions_S[key].push_back(val); Free($3); } | ',' tMacro CharExprNoVar // Macro is already a reserved GetDP keyword { std::string key("Macro"); std::string val($3); CharOptions_S[key].push_back(val); Free($3); } | ',' tSTRING '{' RecursiveListOfCharExpr '}' { std::string key($2); for(int i = 0; i < List_Nbr($4); i++){ char *s; List_Read($4, i, &s); std::string val(s); Free(s); CharOptions_S[key].push_back(val); } Free($2); List_Delete($4); } ; DefineConstants : /* none */ | DefineConstants Comma String__Index { Constant_S.Name = $3; Constant_S.Type = VAR_FLOAT; FloatOptions_S.clear(); CharOptions_S.clear(); if(!Tree_Search(ConstantTable_L, &Constant_S)){ Constant_S.Value.Float = 0.; Tree_Replace(ConstantTable_L, &Constant_S); } } | DefineConstants Comma String__Index '{' FExpr '}' { Constant_S.Type = VAR_FLOAT ; FloatOptions_S.clear(); CharOptions_S.clear(); for (int k = 0 ; k < (int)$5 ; k++) { char tmpstr[256]; sprintf(tmpstr, "%s_%d", $3, k+1) ; Constant_S.Name = tmpstr ; if (!Tree_Search(ConstantTable_L, &Constant_S)) { Constant_S.Name = strSave(tmpstr); Constant_S.Value.Float = 0. ; Tree_Replace(ConstantTable_L, &Constant_S) ; } } Free($3) ; } | DefineConstants Comma String__Index tDEF FExpr { Constant_S.Name = $3; Constant_S.Type = VAR_FLOAT; if(!Tree_Search(ConstantTable_L, &Constant_S)){ Constant_S.Value.Float = $5; Tree_Replace(ConstantTable_L, &Constant_S); } } | DefineConstants Comma String__Index tDEF '{' ListOfFExpr { FloatOptions_S.clear(); CharOptions_S.clear(); } FloatParameterOptions '}' { Constant_S.Name = $3; if(List_Nbr($6) == 1){ Constant_S.Type = VAR_FLOAT; if(!Tree_Search(ConstantTable_L, &Constant_S)){ double d; List_Read($6, 0, &d); Constant_S.Value.Float = d; Message::ExchangeOnelabParameter(&Constant_S, FloatOptions_S, CharOptions_S); Tree_Replace(ConstantTable_L, &Constant_S); } List_Delete($6); } else{ Constant_S.Type = VAR_LISTOFFLOAT; if(!Tree_Search(ConstantTable_L, &Constant_S)){ Constant_S.Value.ListOfFloat = $6; Tree_Replace(ConstantTable_L, &Constant_S); } } } | DefineConstants Comma String__Index tDEF CharExprNoVar { Constant_S.Name = $3; Constant_S.Type = VAR_CHAR; if(!Tree_Search(ConstantTable_L, &Constant_S)){ Constant_S.Value.Char = $5; Tree_Replace(ConstantTable_L, &Constant_S); } } | DefineConstants Comma String__Index tDEF '{' CharExprNoVar { FloatOptions_S.clear(); CharOptions_S.clear(); } CharParameterOptions '}' { Constant_S.Name = $3; Constant_S.Type = VAR_CHAR; if(!Tree_Search(ConstantTable_L, &Constant_S)){ Constant_S.Value.Char = $6; Message::ExchangeOnelabParameter(&Constant_S, FloatOptions_S, CharOptions_S); Tree_Replace(ConstantTable_L, &Constant_S); } } ; UndefineConstants : /* none */ | UndefineConstants Comma CharExprNoVar { // undefine the onelab parameter std::string name($3); Message::UndefineOnelabParameter(name); Free($3); } | UndefineConstants Comma String__Index { // undefine the onelab parameter and the getdp constant std::string name($3); Message::UndefineOnelabParameter(name); Constant_S.Name = $3; Tree_Suppress(ConstantTable_L, &Constant_S); Free($3); } /* Ce bricolage affreux (?) est necessaire pour permettre la meme syntaxe dans les expressions constantes et dans les whole_expressions */ NameForMathFunction : tExp { $$ = (char*)"Exp"; } | tLog { $$ = (char*)"Log"; } | tLog10 { $$ = (char*)"Log10"; } | tSqrt { $$ = (char*)"Sqrt"; } | tSin { $$ = (char*)"Sin"; } | tAsin { $$ = (char*)"Asin"; } | tCos { $$ = (char*)"Cos"; } | tAcos { $$ = (char*)"Acos"; } | tTan { $$ = (char*)"Tan"; } | tAtan { $$ = (char*)"Atan"; } | tAtan2 { $$ = (char*)"Atan2"; } | tSinh { $$ = (char*)"Sinh"; } | tCosh { $$ = (char*)"Cosh"; } | tTanh { $$ = (char*)"Tanh"; } | tFabs { $$ = (char*)"Fabs"; } | tFloor { $$ = (char*)"Floor"; } | tCeil { $$ = (char*)"Ceil"; } | tRound { $$ = (char*)"Round"; } | tSign { $$ = (char*)"Sign"; } | tFmod { $$ = (char*)"Fmod"; } | tModulo { $$ = (char*)"Modulo"; } | tHypot { $$ = (char*)"Hypot"; } | tRand { $$ = (char*)"Rand"; } ; NameForFunction : NameForMathFunction { $$ = $1; } | String__Index { $$ = $1; } ; FExpr : OneFExpr { $$ = $1; } | '(' FExpr ')' { $$ = $2; } | '-' FExpr %prec UNARYPREC { $$ = -$2; } | '!' FExpr { $$ = !$2; } | FExpr '-' FExpr { $$ = $1 - $3; } | FExpr '+' FExpr { $$ = $1 + $3; } | FExpr '*' FExpr { $$ = $1 * $3; } | FExpr '|' FExpr { $$ = (int)$1 | (int)$3; } | FExpr '&' FExpr { $$ = (int)$1 & (int)$3; } | FExpr '/' FExpr { $$ = $1 / $3; } | FExpr '%' FExpr { $$ = (int)$1 % (int)$3; } | FExpr '^' FExpr { $$ = pow($1,$3); } | FExpr '<' FExpr { $$ = $1 < $3; } | FExpr '>' FExpr { $$ = $1 > $3; } | FExpr tLESSOREQUAL FExpr { $$ = $1 <= $3; } | FExpr tGREATEROREQUAL FExpr { $$ = $1 >= $3; } | FExpr tEQUAL FExpr { $$ = $1 == $3; } | FExpr tNOTEQUAL FExpr { $$ = $1 != $3; } | FExpr tAND FExpr { $$ = $1 && $3; } | FExpr tOR FExpr { $$ = $1 || $3; } | tExp '[' FExpr ']' { $$ = exp($3); } | tLog '[' FExpr ']' { $$ = log($3); } | tLog10 '[' FExpr ']' { $$ = log10($3); } | tSqrt '[' FExpr ']' { $$ = sqrt($3); } | tSin '[' FExpr ']' { $$ = sin($3); } | tAsin '[' FExpr ']' { $$ = asin($3); } | tCos '[' FExpr ']' { $$ = cos($3); } | tAcos '[' FExpr ']' { $$ = acos($3); } | tTan '[' FExpr ']' { $$ = tan($3); } | tAtan '[' FExpr ']' { $$ = atan($3); } | tAtan2 '[' FExpr ',' FExpr ']' { $$ = atan2($3,$5); } | tSinh '[' FExpr ']' { $$ = sinh($3); } | tCosh '[' FExpr ']' { $$ = cosh($3); } | tTanh '[' FExpr ']' { $$ = tanh($3); } | tFabs '[' FExpr ']' { $$ = fabs($3); } | tFloor '[' FExpr ']' { $$ = floor($3); } | tCeil '[' FExpr ']' { $$ = ceil($3); } | tRound '[' FExpr ']' { $$ = floor($3 + 0.5); } | tSign '[' FExpr ']' { $$ = (($3 > 0.) ? 1. : ($3 < 0.) ? -1. : 0.); } | tFmod '[' FExpr ',' FExpr ']' { $$ = fmod($3,$5); } | tModulo '[' FExpr ',' FExpr ']' { $$ = fmod($3,$5); } | tHypot '[' FExpr ',' FExpr ']' { $$ = sqrt($3*$3+$5*$5); } | tRand '[' FExpr ']' { $$ = $3 * (double)rand() / (double)RAND_MAX; } | FExpr '?' FExpr tDOTS FExpr { $$ = $1? $3 : $5; } | StrCmp { $$ = $1; } | NbrRegions { $$ = $1; } | FExpr '#' { Message::Direct("Value (line %ld) --> %.16g", getdp_yylinenum, $1); } ; OneFExpr : tFLOAT { $$ = $1; } | tINT { $$ = (double)$1; } | tPi { $$ = 3.1415926535897932; } | t0D { $$ = (double)_0D; } | t1D { $$ = (double)_1D; } | t2D { $$ = (double)_2D; } | t3D { $$ = (double)_3D; } | tTestLevel { $$ = (double)ImbricatedTest; } | tMPI_Rank { $$ = Message::GetCommRank(); } | tMPI_Size { $$ = Message::GetCommSize(); } | tGETDP_MAJOR_VERSION { $$ = GETDP_MAJOR_VERSION; } | tGETDP_MINOR_VERSION { $$ = GETDP_MINOR_VERSION; } | tGETDP_PATCH_VERSION { $$ = GETDP_PATCH_VERSION; } | tTotalMemory { $$ = GetTotalRam(); } | tDefineNumber '[' FExpr { FloatOptions_S.clear(); CharOptions_S.clear(); } FloatParameterOptions ']' { Constant_S.Name = (char*)""; Constant_S.Type = VAR_FLOAT; Constant_S.Value.Float = $3; Message::ExchangeOnelabParameter(&Constant_S, FloatOptions_S, CharOptions_S); $$ = Constant_S.Value.Float; } | String__Index { Constant_S.Name = $1; if(!Tree_Query(ConstantTable_L, &Constant_S)) { vyyerror("Unknown Constant: %s", $1); $$ = 0.; } else { if(Constant_S.Type == VAR_FLOAT) $$ = Constant_S.Value.Float; else { vyyerror("Single value Constant needed: %s", $1); $$ = 0.; } } Free($1); } | '#' tSTRING '(' ')' { Constant_S.Name = $2; int ret = 0; if(!Tree_Query(ConstantTable_L, &Constant_S)) vyyerror("Unknown Constant: %s", $2); else{ if(Constant_S.Type == VAR_LISTOFFLOAT) ret = List_Nbr(Constant_S.Value.ListOfFloat); else if(Constant_S.Type == VAR_FLOAT) ret = 1; else vyyerror("Float Constant needed: %s", $2); } $$ = ret; Free($2); } | tSTRING '(' FExpr ')' { Constant_S.Name = $1; double ret = 0.; if(!Tree_Query(ConstantTable_L, &Constant_S)) vyyerror("Unknown Constant: %s", $1); else{ if(Constant_S.Type != VAR_LISTOFFLOAT) vyyerror("Multi value Constant needed: %s", $1); else{ int j = (int)$3; if(j >= 0 && j < List_Nbr(Constant_S.Value.ListOfFloat)) List_Read(Constant_S.Value.ListOfFloat, j, &ret); else vyyerror("Index %d out of range", j); } } $$ = ret; Free($1); } ; ListOfFExpr : /* none */ { $$ = NULL; } | '{' '}' { $$ = List_Create(1,1,sizeof(double)); } | FExpr { $$ = List_Create(1,1,sizeof(double)); List_Add($$, &($1)); } | MultiFExpr { $$ = $1; } | '{' RecursiveListOfFExpr '}' { $$ = $2; } | '-' '{' RecursiveListOfFExpr '}' { $$ = $3; for(int i = 0; i < List_Nbr($$); i++){ double *pd = (double*)List_Pointer($$, i); (*pd) = - (*pd); } } | FExpr '*' '{' RecursiveListOfFExpr '}' { $$ = $4; for(int i = 0; i < List_Nbr($$); i++){ double *pd = (double*)List_Pointer($$, i); (*pd) *= $1; } } ; RecursiveListOfFExpr : FExpr { $$ = List_Create(20,20,sizeof(double)); List_Add($$, &($1)); } | MultiFExpr { $$ = $1; } | RecursiveListOfFExpr ',' FExpr { List_Add($$, &($3)); } | RecursiveListOfFExpr ',' MultiFExpr { for(int i = 0; i < List_Nbr($3); i++){ double d; List_Read($3, i, &d); List_Add($$, &d); } List_Delete($3); } ; MultiFExpr : '-' MultiFExpr %prec UNARYPREC { $$ = $2; for(int i = 0; i < List_Nbr($$); i++){ double *pd = (double*)List_Pointer($$, i); *pd *= -1.0; } } | FExpr '*' MultiFExpr { $$ = $3; for(int i = 0; i < List_Nbr($$); i++){ double *pd = (double*)List_Pointer($$, i); *pd *= $1; } } | MultiFExpr '*' FExpr { $$ = $1; for(int i = 0; i < List_Nbr($$); i++){ double *pd = (double*)List_Pointer($$, i); *pd *= $3; } } | FExpr '/' MultiFExpr { $$ = $3; for(int i = 0; i < List_Nbr($$); i++){ double *pd = (double*)List_Pointer($$, i); if(*pd) *pd = $1 / *pd; } } | MultiFExpr '/' FExpr { $$ = $1; for(int i = 0; i < List_Nbr($$); i++){ double *pd = (double*)List_Pointer($$, i); if($3) *pd /= $3; } } | MultiFExpr '^' FExpr { $$ = $1; for(int i = 0; i < List_Nbr($$); i++){ double *pd = (double*)List_Pointer($$, i); *pd = pow(*pd, $3); } } | MultiFExpr '+' MultiFExpr { $$ = $1; if(List_Nbr($$) == List_Nbr($3)){ for(int i = 0; i < List_Nbr($$); i++){ double *pd = (double*)List_Pointer($$, i); double d = *(double*)List_Pointer($3, i); *pd += d; } } else vyyerror("Wrong list sizes %d != %d", List_Nbr($$), List_Nbr($3)); List_Delete($3); } | MultiFExpr '-' MultiFExpr { $$ = $1; if(List_Nbr($$) == List_Nbr($3)){ for(int i = 0; i < List_Nbr($$); i++){ double *pd = (double*)List_Pointer($$, i); double d = *(double*)List_Pointer($3, i); *pd -= d; } } else vyyerror("Wrong list sizes %d != %d", List_Nbr($$), List_Nbr($3)); List_Delete($3); } | MultiFExpr '*' MultiFExpr { $$ = $1; if(List_Nbr($$) == List_Nbr($3)){ for(int i = 0; i < List_Nbr($$); i++){ double *pd = (double*)List_Pointer($$, i); double d = *(double*)List_Pointer($3, i); *pd *= d; } } else vyyerror("Wrong list sizes %d != %d", List_Nbr($$), List_Nbr($3)); List_Delete($3); } | MultiFExpr '/' MultiFExpr { $$ = $1; if(List_Nbr($$) == List_Nbr($3)){ for(int i = 0; i < List_Nbr($$); i++){ double *pd = (double*)List_Pointer($$, i); double d = *(double*)List_Pointer($3, i); if(d) *pd /= d; } } else vyyerror("Wrong list sizes %d != %d", List_Nbr($$), List_Nbr($3)); List_Delete($3); } | FExpr tDOTS FExpr { $$ = List_Create(20,20,sizeof(double)); for(double d = $1; ($1 < $3) ? (d <= $3) : (d >= $3); ($1 < $3) ? (d += 1.) : (d -= 1.)) List_Add($$, &d); } | FExpr tDOTS FExpr tDOTS FExpr { $$ = List_Create(20,20,sizeof(double)); if(!$5 || ($1<$3 && $5<0) || ($1>$3 && $5>0)){ vyyerror("Wrong increment in '%g : %g : %g'", $1, $3, $5); List_Add($$, &($1)); } else for(double d = $1; ($5 > 0) ? (d <= $3) : (d >= $3); d += $5) List_Add($$, &d); } | tSTRING '(' ')' { $$ = List_Create(20,20,sizeof(double)); Constant_S.Name = $1; if(!Tree_Query(ConstantTable_L, &Constant_S)) vyyerror("Unknown Constant: %s", $1); else if(Constant_S.Type != VAR_LISTOFFLOAT) /* vyyerror("Multi value Constant needed: %s", $1); */ List_Add($$, &Constant_S.Value.Float); else for(int i = 0; i < List_Nbr(Constant_S.Value.ListOfFloat); i++) { double d; List_Read(Constant_S.Value.ListOfFloat, i, &d); List_Add($$, &d); } } | StringIndex '(' ')' { $$ = List_Create(20,20,sizeof(double)); Constant_S.Name = $1; if(!Tree_Query(ConstantTable_L, &Constant_S)) vyyerror("Unknown Constant: %s", $1); else if(Constant_S.Type != VAR_LISTOFFLOAT) /* vyyerror("Multi value Constant needed: %s", $1); */ List_Add($$, &Constant_S.Value.Float); else for(int i = 0; i < List_Nbr(Constant_S.Value.ListOfFloat); i++) { double d; List_Read(Constant_S.Value.ListOfFloat, i, &d); List_Add($$, &d); } } // deprecated | tSTRING '{' '}' { $$ = List_Create(20,20,sizeof(double)); Constant_S.Name = $1; if(!Tree_Query(ConstantTable_L, &Constant_S)) vyyerror("Unknown Constant: %s", $1); else if(Constant_S.Type != VAR_LISTOFFLOAT) /* vyyerror("Multi value Constant needed: %s", $1); */ List_Add($$, &Constant_S.Value.Float); else for(int i = 0; i < List_Nbr(Constant_S.Value.ListOfFloat); i++) { double d; List_Read(Constant_S.Value.ListOfFloat, i, &d); List_Add($$, &d); } } | tSTRING '(' '{' RecursiveListOfFExpr '}' ')' { $$ = List_Create(20,20,sizeof(double)); Constant_S.Name = $1; if(!Tree_Query(ConstantTable_L, &Constant_S)) vyyerror("Unknown Constant: %s", $1); else if(Constant_S.Type != VAR_LISTOFFLOAT) vyyerror("Multi value Constant needed: %s", $1); else for(int i = 0; i < List_Nbr($4); i++) { int j = (int)(*(double*)List_Pointer($4, i)); if(j >= 0 && j < List_Nbr(Constant_S.Value.ListOfFloat)){ double d; List_Read(Constant_S.Value.ListOfFloat, j, &d); List_Add($$, &d); } else{ vyyerror("Index %d out of range", j); double d = 0.; List_Add($$, &d); } } List_Delete($4); } | StringIndex '(' '{' RecursiveListOfFExpr '}' ')' { $$ = List_Create(20,20,sizeof(double)); Constant_S.Name = $1; if(!Tree_Query(ConstantTable_L, &Constant_S)) vyyerror("Unknown Constant: %s", $1); else if(Constant_S.Type != VAR_LISTOFFLOAT) vyyerror("Multi value Constant needed: %s", $1); else for(int i = 0; i < List_Nbr($4); i++) { int j = (int)(*(double*)List_Pointer($4, i)); if(j >= 0 && j < List_Nbr(Constant_S.Value.ListOfFloat)){ double d; List_Read(Constant_S.Value.ListOfFloat, j, &d); List_Add($$, &d); } else{ vyyerror("Index %d out of range", j); double d = 0.; List_Add($$, &d); } } List_Delete($4); } // same as tSTRING '(' ')' | tList '[' String__Index ']' { $$ = List_Create(20,20,sizeof(double)); Constant_S.Name = $3; if(!Tree_Query(ConstantTable_L, &Constant_S)) vyyerror("Unknown Constant: %s", $3); else if(Constant_S.Type != VAR_LISTOFFLOAT) vyyerror("Multi value Constant needed: %s", $3); else for(int i = 0; i < List_Nbr(Constant_S.Value.ListOfFloat); i++) { double d; List_Read(Constant_S.Value.ListOfFloat, i, &d); List_Add($$, &d); } } | tListAlt '[' tSTRING ',' tSTRING ']' { $$ = List_Create(20,20,sizeof(double)); Constant1_S.Name = $3; Constant2_S.Name = $5; if(!Tree_Query(ConstantTable_L, &Constant1_S)) { vyyerror("Unknown Constant: %s", $3); } else if(Constant1_S.Type != VAR_LISTOFFLOAT) { vyyerror("Multi value Constant needed: %s", $3); } else { if(!Tree_Query(ConstantTable_L, &Constant2_S)) { vyyerror("Unknown Constant: %s", $5); } else if(Constant2_S.Type != VAR_LISTOFFLOAT) { vyyerror("Multi value Constant needed: %s", $5); } else { if(List_Nbr(Constant1_S.Value.ListOfFloat) != List_Nbr(Constant2_S.Value.ListOfFloat)) { vyyerror("Different dimensions of Multi value Constants: " "%s {%d}, %s {%d}", $3, List_Nbr(Constant1_S.Value.ListOfFloat), $5, List_Nbr(Constant2_S.Value.ListOfFloat)); } else { for(int i = 0; i < List_Nbr(Constant1_S.Value.ListOfFloat); i++) { double d; List_Read(Constant1_S.Value.ListOfFloat, i, &d); List_Add($$, &d); List_Read(Constant2_S.Value.ListOfFloat, i, &d); List_Add($$, &d); } } } } Free($3); Free($5); } | tListAlt '[' MultiFExpr ',' MultiFExpr ']' { $$ = List_Create(20,20,sizeof(double)); if(List_Nbr($3) != List_Nbr($5)) { vyyerror("Different dimensions of lists: %d != %d", List_Nbr($3), List_Nbr($5)); } else { for(int i = 0; i < List_Nbr($3); i++) { double d; List_Read($3, i, &d); List_Add($$, &d); List_Read($5, i, &d); List_Add($$, &d); } } List_Delete($3); List_Delete($5); } | tLinSpace '[' FExpr ',' FExpr ',' FExpr ']' { $$ = List_Create(20,20,sizeof(double)); for(int i = 0; i < (int)$7; i++) { double d = $3 + ($5-$3)*(double)i/($7-1); List_Add($$, &d); } } | tLogSpace '[' FExpr ',' FExpr ',' FExpr ']' { $$ = List_Create(20,20,sizeof(double)); for(int i = 0; i < (int)$7; i++) { double d = pow(10,$3 + ($5-$3)*(double)i/($7-1)); List_Add($$, &d); } } | tListFromFile '[' CharExpr ']' { Message::Barrier(); FILE *File; if(!(File = FOpen(Fix_RelativePath($3).c_str(), "rb"))){ Message::Warning("Could not open file '%s'", $3); } else{ $$ = List_Create(100,100,sizeof(double)); double d; while(!feof(File)) if(fscanf(File, "%lf", &d) != EOF) List_Add($$, &d); fclose(File); } Free($3); } ; StringIndex : tSTRING '~' '{' FExpr '}' { char tmpstr[256]; sprintf(tmpstr, "_%d", (int)$4); $$ = (char *)Malloc((strlen($1)+strlen(tmpstr)+1)*sizeof(char)); strcpy($$, $1); strcat($$, tmpstr); Free($1); } | StringIndex '~' '{' FExpr '}' { char tmpstr[256]; sprintf(tmpstr, "_%d", (int)$4); $$ = (char *)Malloc((strlen($1)+strlen(tmpstr)+1)*sizeof(char)) ; strcpy($$, $1) ; strcat($$, tmpstr) ; Free($1); } ; String__Index : tSTRING { $$ = $1; } | StringIndex { $$ = $1; } // Name from any string | tNameFromString '[' CharExpr ']' { $$ = $3; } ; CharExprNoVar : tBIGSTR { $$ = $1; } | tStringFromName '[' String__Index ']' { $$ = $3; } | StrCat { $$ = $1; } | tUpperCase '[' CharExpr ']' { int i = 0; while ($3[i]) { $3[i] = toupper($3[i]); i++; } $$ = $3; } | tLowerCase '[' CharExpr ']' { int i = 0; while ($3[i]) { $3[i] = tolower($3[i]); i++; } $$ = $3; } | tLowerCaseIn '[' CharExpr ']' { int i=0; while ($3[i]) { if (i > 0 && $3[i-1] != '_') $3[i] = tolower($3[i]); i++; } $$ = $3; } | tStr '[' RecursiveListOfCharExpr ']' { int size = 1; for(int i = 0; i < List_Nbr($3); i++){ char *s; List_Read($3, i, &s); size += strlen(s) + 1; } $$ = (char*)Malloc(size * sizeof(char)); $$[0] = '\0'; for(int i = 0; i < List_Nbr($3); i++){ char *s; List_Read($3, i, &s); strcat($$, s); Free(s);//FIXME if(i != List_Nbr($3) - 1) strcat($$, "\n"); } List_Delete($3); } | tStrChoice LP FExpr ',' CharExpr ',' CharExpr RP { if($3){ $$ = $5; Free($7); } else{ $$ = $7; Free($5); } } | tSprintf LP CharExpr RP { $$ = $3; } | tSprintf LP CharExpr ',' RecursiveListOfFExpr RP { char tmpstr[256]; int i = Print_ListOfDouble($3,$5,tmpstr); if(i<0){ vyyerror("Too few arguments in Sprintf"); $$ = $3; } else if(i>0){ vyyerror("Too many arguments (%d) in Sprintf", i); $$ = $3; } else{ $$ = (char*)Malloc((strlen(tmpstr)+1)*sizeof(char)); strcpy($$, tmpstr); Free($3); } List_Delete($5); } | tDate { time_t date_info; time(&date_info); $$ = (char *)Malloc((strlen(ctime(&date_info))+1)*sizeof(char)); strcpy($$, ctime(&date_info)); $$[strlen($$)-1] = 0; } | tOnelabAction { std::string action = Message::GetOnelabAction(); $$ = (char *)Malloc(action.size() + 1); strcpy($$, action.c_str()); } | tCurrentDirectory { std::string tmp = GetDir(getdp_yyname); $$ = (char*)Malloc((tmp.size() + 1) * sizeof(char)); strcpy($$, tmp.c_str()); } | tFixRelativePath LP CharExpr RP { $$ = strSave(Fix_RelativePath($3).c_str()); Free($3); } | tDefineString '[' CharExprNoVar { FloatOptions_S.clear(); CharOptions_S.clear(); } CharParameterOptions ']' { Constant_S.Name = (char*)""; Constant_S.Type = VAR_CHAR; Constant_S.Value.Char = $3; Message::ExchangeOnelabParameter(&Constant_S, FloatOptions_S, CharOptions_S); $$ = strSave(Constant_S.Value.Char); Free($3); } ; CharExpr : CharExprNoVar { $$ = $1; } | String__Index { Constant_S.Name = $1; if(!Tree_Query(ConstantTable_L, &Constant_S)) { vyyerror("Unknown Constant: %s", $1); $$ = NULL; } else { if(Constant_S.Type == VAR_CHAR) $$ = strSave(Constant_S.Value.Char); else { vyyerror("String Constant needed: %s", $1); $$ = NULL; } } Free($1); } ; RecursiveListOfCharExpr : CharExpr { $$ = List_Create(20,20,sizeof(char*)); List_Add($$, &($1)); } | RecursiveListOfCharExpr ',' CharExpr { List_Add($$, &($3)); } ; // these are for compatibility with the syntax in Gmsh (parentheses instead of // square brackets) LP : '(' { $$ = (char*)"("; } | '[' { $$ = (char*)"["; } ; RP : ')' { $$ = (char*)")"; } | ']' { $$ = (char*)"]"; } ; StrCat : tStrCat LP RecursiveListOfCharExpr RP { int size = 1; for(int i = 0; i < List_Nbr($3); i++){ char *s; List_Read($3, i, &s); size += strlen(s) + 1; } $$ = (char*)Malloc(size * sizeof(char)); $$[0] = '\0'; for(int i = 0; i < List_Nbr($3); i++){ char *s; List_Read($3, i, &s); strcat($$, s); Free(s); } List_Delete($3); } ; StrCmp : tStrCmp LP CharExpr ',' CharExpr RP { if ($3 != NULL && $5 != NULL) { $$ = strcmp($3, $5); } else { vyyerror("Undefined argument for StrCmp function") ; $$ = 1 ; } } ; NbrRegions : tNbrRegions '[' String__Index ']' { int i; if ( (i = List_ISearchSeq(Problem_S.Group, $3, fcmp_Group_Name)) >= 0 ) { $$ = List_Nbr(((struct Group *)List_Pointer(Problem_S.Group, i)) ->InitialList) ; } else { vyyerror("Unknown Group: %s", $3) ; $$ = 0 ; } } | tGetRegion '[' String__Index ',' FExpr ']' { int i, j, indexInGroup; indexInGroup = (int)$5; if ( (i = List_ISearchSeq(Problem_S.Group, $3, fcmp_Group_Name)) >= 0 ) { if (indexInGroup >= 1 && indexInGroup <= List_Nbr(((struct Group *)List_Pointer(Problem_S.Group, i)) ->InitialList)) { List_Read(((struct Group *)List_Pointer(Problem_S.Group, i))->InitialList, indexInGroup-1, &j) ; $$ = j; } else { vyyerror("GetRegion: Index out of range [1..%d]", List_Nbr(((struct Group *)List_Pointer(Problem_S.Group, i)) ->InitialList)) ; $$ = 0 ; } } else { vyyerror("Unknown Group: %s", $3) ; $$ = 0 ; } } ; %% // This is a hack... Bison redefines 'const' if !__cplusplus and !__STDC__ #ifdef const #undef const #endif void Alloc_ParserVariables() { if(!ConstantTable_L) { ConstantTable_L = Tree_Create(sizeof(struct Constant), fcmp_Constant); for(std::map >::iterator it = CommandLineNumbers.begin(); it != CommandLineNumbers.end(); it++){ std::vector &v(it->second); Constant_S.Name = strdup(it->first.c_str()); if(v.size() == 1){ Message::Info("Adding number %s = %g", it->first.c_str(), v[0]); Constant_S.Type = VAR_FLOAT; Constant_S.Value.Float = v[0]; } else{ Message::Info("Adding list of numbers %s", it->first.c_str()); Constant_S.Type = VAR_LISTOFFLOAT; Constant_S.Value.ListOfFloat = List_Create(v.size(), 1, sizeof(double)); for(unsigned int i = 0; i < v.size(); i ++) List_Add(Constant_S.Value.ListOfFloat, &v[i]); } Tree_Add(ConstantTable_L, &Constant_S); } for(std::map::iterator it = CommandLineStrings.begin(); it != CommandLineStrings.end(); it++){ Message::Info("Adding string %s = \"%s\"", it->first.c_str(), it->second.c_str()); Constant_S.Name = strdup(it->first.c_str()); Constant_S.Type = VAR_CHAR; Constant_S.Value.Char = strdup(it->second.c_str()); Tree_Add(ConstantTable_L, &Constant_S); } ListOfInt_L = List_Create(20, 10, sizeof(int)); ListOfPointer_L = List_Create(10, 10, sizeof(void *)); ListOfPointer2_L= List_Create(10, 10, sizeof(void *)); ListOfChar_L = List_Create(128, 128, sizeof(char)); ListOfFormulation = List_Create(5,5, sizeof(int)); ListOfBasisFunction = List_Create(5,5, sizeof(List_T *)); ListOfEntityIndex = List_Create(5,5, sizeof(int)); } } void Free_ParserVariables() { Tree_Delete(ConstantTable_L); ConstantTable_L = 0; List_Delete(ListOfInt_L); ListOfInt_L = 0; List_Delete(ListOfPointer_L); ListOfPointer_L = 0; List_Delete(ListOfPointer2_L); ListOfPointer2_L = 0; List_Delete(ListOfChar_L); ListOfChar_L = 0; List_Delete(ListOfFormulation); ListOfFormulation = 0; List_Delete(ListOfBasisFunction); ListOfBasisFunction = 0; List_Delete(ListOfEntityIndex); ListOfEntityIndex = 0; getdp_yyname = ""; strcpy(getdp_yyincludename, ""); getdp_yylinenum = 0; getdp_yycolnum = 0; getdp_yyincludenum = 0; getdp_yyerrorlevel = 0; CommandLineNumbers.clear(); CommandLineStrings.clear(); } /* A d d _ G r o u p & C o . */ int Add_Group(struct Group *Group_P, char *Name, bool Flag_Add, int Flag_Plus, int Num_Index) { if(!Problem_S.Group) Problem_S.Group = List_Create(50, 50, sizeof (struct Group)); char tmpstr[256]; switch (Flag_Plus) { case 1 : sprintf(tmpstr, "_%s_%d", Name, List_Nbr(Problem_S.Group)); Group_P->Name = strSave(tmpstr); break; case 2 : sprintf(tmpstr, "%s_%d", Name, Num_Index); Group_P->Name = strSave(tmpstr); break; default : Group_P->Name = Name; } int i; if((i = List_ISearchSeq(Problem_S.Group, Group_P->Name, fcmp_Group_Name)) < 0) { i = Group_P->Num = List_Nbr(Problem_S.Group); Group_P->ExtendedList = NULL; Group_P->ExtendedSuppList = NULL; List_Add(Problem_S.Group, Group_P); } else if(Flag_Add) { List_T *InitialList = ((struct Group *)List_Pointer(Problem_S.Group, i))->InitialList; for(int j = 0; j < List_Nbr(Group_P->InitialList); j++) { List_Add(InitialList, (int *)List_Pointer(Group_P->InitialList, j)); } } else List_Write(Problem_S.Group, i, Group_P); return i; } int Num_Group(struct Group *Group_P, char *Name, int Num_Group) { if (Num_Group >= 0) /* OK */; else if(Num_Group == -1) Num_Group = Add_Group(Group_P, Name, false, 1, 0); else vyyerror("Bad Group right hand side"); return Num_Group; } void Fill_GroupInitialListFromString(List_T *list, const char *str) { bool found = false; // try to find a group with name "str" for(int i = 0; i < List_Nbr(Problem_S.Group); i++){ struct Group *Group_P = (struct Group*)List_Pointer(Problem_S.Group, i); if(!strcmp(str, Group_P->Name)){ List_Copy(Group_P->InitialList, list); found = true; break; } } // try to find a constant with name "str" Constant_S.Name = (char*)str; Constant *Constant_P = (Constant*)Tree_PQuery(ConstantTable_L, &Constant_S); if(Constant_P){ switch(Constant_P->Type){ case VAR_FLOAT: { int num = (int)Constant_P->Value.Float; List_Add(list, &num); } found = true; break; case VAR_LISTOFFLOAT: for(int j = 0; j < List_Nbr(Constant_P->Value.ListOfFloat); j++){ double d; List_Read(Constant_P->Value.ListOfFloat, j, &d); int num = (int)d; List_Add(list, &num); } found = true; break; } } // if not, try to convert "str" to an integer if(!found){ int num = atoi(str); if(num > 0){ List_Add(list, &num); found = true; } } if(!found) vyyerror("Unknown Group '%s'", str); } /* A d d _ E x p r e s s i o n */ int Add_Expression(struct Expression *Expression_P, char *Name, int Flag_Plus) { if(!Problem_S.Expression) Problem_S.Expression = List_Create(50, 50, sizeof (struct Expression)); switch (Flag_Plus) { case 1 : char tmpstr[256]; sprintf(tmpstr, "_%s_%d", Name, List_Nbr(Problem_S.Expression)) ; Expression_P->Name = strSave(tmpstr) ; break ; case 2 : Expression_P->Name = strSave(Name) ; break ; default : Expression_P->Name = Name ; } int i; if((i = List_ISearchSeq (Problem_S.Expression, Name, fcmp_Expression_Name)) < 0) { i = List_Nbr(Problem_S.Expression); List_Add(Problem_S.Expression, Expression_P); } else List_Write(Problem_S.Expression, i, Expression_P); return i; } bool Is_ExpressionPieceWiseDefined(int index) { struct Expression *e = (struct Expression *)List_Pointer(Problem_S.Expression, index); if(e->Type == PIECEWISEFUNCTION) return true; else if(e->Type == WHOLEQUANTITY){ for(int i = 0; i < List_Nbr(e->Case.WholeQuantity); i++){ struct WholeQuantity *w = (struct WholeQuantity *)List_Pointer(e->Case.WholeQuantity, i); if(w->Type == WQ_EXPRESSION) return Is_ExpressionPieceWiseDefined(w->Case.Expression.Index); } } return false; } /* L i s t e I n d e x d e s D e f i n e Q u a n t i t y */ void Pro_DefineQuantityIndex_1(List_T *WholeQuantity_L, int TraceGroupIndex, std::vector > &pairs) { struct WholeQuantity *WholeQuantity_P; WholeQuantity_P = (List_Nbr(WholeQuantity_L) > 0)? (struct WholeQuantity*)List_Pointer(WholeQuantity_L, 0) : NULL; for(int i = 0; i < List_Nbr(WholeQuantity_L); i++) switch ((WholeQuantity_P+i)->Type) { case WQ_OPERATORANDQUANTITY : case WQ_OPERATORANDQUANTITYEVAL : case WQ_SOLIDANGLE : case WQ_ORDER : { std::pair p((WholeQuantity_P+i)->Case.OperatorAndQuantity.Index, TraceGroupIndex); if(std::find(pairs.begin(), pairs.end(), p) == pairs.end()) pairs.push_back(p); } break; case WQ_MHTRANSFORM : Pro_DefineQuantityIndex_1 ((WholeQuantity_P+i)->Case.MHTransform.WholeQuantity, TraceGroupIndex, pairs); case WQ_TIMEDERIVATIVE : Pro_DefineQuantityIndex_1 ((WholeQuantity_P+i)->Case.TimeDerivative.WholeQuantity, TraceGroupIndex, pairs); break; case WQ_ATANTERIORTIMESTEP : Pro_DefineQuantityIndex_1 ((WholeQuantity_P+i)->Case.AtAnteriorTimeStep.WholeQuantity, TraceGroupIndex, pairs); break; case WQ_MAXOVERTIME : case WQ_FOURIERSTEINMETZ : Pro_DefineQuantityIndex_1 ((WholeQuantity_P+i)->Case.AtAnteriorTimeStep.WholeQuantity, TraceGroupIndex, pairs); break; case WQ_CAST : Pro_DefineQuantityIndex_1 ((WholeQuantity_P+i)->Case.Cast.WholeQuantity, TraceGroupIndex, pairs); break; case WQ_TRACE : Pro_DefineQuantityIndex_1 ((WholeQuantity_P+i)->Case.Trace.WholeQuantity, (WholeQuantity_P+i)->Case.Trace.InIndex, pairs); break; case WQ_TEST : Pro_DefineQuantityIndex_1 ((WholeQuantity_P+i)->Case.Test.WholeQuantity_True, TraceGroupIndex, pairs); Pro_DefineQuantityIndex_1 ((WholeQuantity_P+i)->Case.Test.WholeQuantity_False, TraceGroupIndex, pairs); break; } std::sort(pairs.begin(), pairs.end()); } void Pro_DefineQuantityIndex(List_T *WholeQuantity_L, int DefineQuantityIndexEqu, int *NbrQuantityIndex, int **QuantityIndexTable, int **QuantityTraceGroupIndexTable) { std::vector > pairs; /* special case for the Equ part (right of the comma) FIXME: change this when we allow a full WholeQuantity expression there */ Pro_DefineQuantityIndex_1(WholeQuantity_L, -1, pairs); if(DefineQuantityIndexEqu >= 0){ std::pair p(DefineQuantityIndexEqu, -1); pairs.push_back(p); } *NbrQuantityIndex = pairs.size(); *QuantityIndexTable = (int *)Malloc(pairs.size() * sizeof(int)); *QuantityTraceGroupIndexTable = (int *)Malloc(pairs.size() * sizeof(int)); for(unsigned int i = 0; i < pairs.size(); i++){ (*QuantityIndexTable)[i] = pairs[i].first; (*QuantityTraceGroupIndexTable)[i] = pairs[i].second; } } /* C h e c k _ N a m e O f S t r u c t N o t E x i s t */ void Check_NameOfStructNotExist(const char *Struct, List_T *List_L, void *data, int (*fcmp)(const void *a, const void *b)) { if(List_ISearchSeq(List_L, data, fcmp) >= 0) vyyerror("Redefinition of %s %s", Struct, (char*)data); } /* P r i n t _ C o n s t a n t */ int Print_ListOfDouble(char *format, List_T *list, char *buffer) { // if format does not contain formatting characters, dump the list (useful for // quick debugging of lists) int numFormats = 0; for(unsigned int i = 0; i < strlen(format); i++) if(format[i] == '%') numFormats++; if(!numFormats){ strcpy(buffer, format); for(int i = 0; i < List_Nbr(list); i++){ double d; List_Read(list, i, &d); char tmp[256]; sprintf(tmp, " [%d]%g", i, d); strcat(buffer, tmp); } return 0; } char tmp1[256], tmp2[256]; int j = 0, k = 0; buffer[j] = '\0'; while(j < (int)strlen(format) && format[j] != '%') j++; strncpy(buffer, format, j); buffer[j] = '\0'; for(int i = 0; i < List_Nbr(list); i++){ k = j; j++; if(j < (int)strlen(format)){ if(format[j] == '%'){ strcat(buffer, "%"); j++; } while(j < (int)strlen(format) && format[j] != '%') j++; if(k != j){ strncpy(tmp1, &(format[k]), j-k); tmp1[j-k] = '\0'; sprintf(tmp2, tmp1, *(double*)List_Pointer(list, i)); strcat(buffer, tmp2); } } else return List_Nbr(list) - i; } if(j != (int)strlen(format)) return -1; return 0; } void Print_Constants() { struct Constant *Constant_P; Message::Check("Constants:\n"); List_T *tmp = Tree2List(ConstantTable_L); for(int i = 0; i < List_Nbr(tmp); i++){ Constant_P = (struct Constant*)List_Pointer(tmp, i); switch(Constant_P->Type){ case VAR_FLOAT: Message::Check("%s = %g;\n", Constant_P->Name, Constant_P->Value.Float); break; case VAR_LISTOFFLOAT: { std::string str(Constant_P->Name); str += " = {"; for(int j = 0; j < List_Nbr(Constant_P->Value.ListOfFloat); j++){ if(j) str += ","; double d; List_Read(Constant_P->Value.ListOfFloat, j, &d); char tmp[32]; sprintf(tmp, "%g", d); str += tmp; } str += "};\n"; Message::Check(str.c_str()); } break; case VAR_CHAR: Message::Check("%s = \"%s\";\n", Constant_P->Name, Constant_P->Value.Char); break; } } List_Delete(tmp); } /* E r r o r h a n d l i n g */ void yyerror(const char *s) { extern char *getdp_yytext; Message::Error("'%s', line %ld : %s (%s)", getdp_yyname.c_str(), getdp_yylinenum, s, getdp_yytext); getdp_yyerrorlevel = 1; } void vyyerror(const char *fmt, ...) { char str[256]; va_list args; va_start(args, fmt); vsprintf(str, fmt, args); va_end(args); Message::Error("'%s', line %ld : %s", getdp_yyname.c_str(), getdp_yylinenum, str); getdp_yyerrorlevel = 1; } getdp-2.7.0-source/Interface/ProDefine.cpp000644 001750 001750 00000013726 12531661501 022071 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "ProData.h" #include "ProDefine.h" #include "Message.h" /* --------------------------------------------------------------------------- */ /* G e t S t r i n g , D e f i n e , F u n c t i o n , P o i n t e r */ /* --------------------------------------------------------------------------- */ int Get_DefineForString(struct StringXDefine SXD[], const char *string, int *FlagError) { int i = 0, define ; while ((SXD[i].string != NULL) && (strcmp(SXD[i].string, string))) i++ ; define = SXD[i].define ; *FlagError = (SXD[i].string == NULL)? 1 : 0 ; return(define) ; } int Get_Define1NbrForString(struct StringXDefine1Nbr SXD[], const char *string, int *FlagError, int *Nbr1) { int i = 0, define ; while ((SXD[i].string != NULL) && (strcmp(SXD[i].string, string))) i++ ; define = SXD[i].define ; *Nbr1 = SXD[i].Nbr1 ; *FlagError = (SXD[i].string == NULL)? 1 : 0 ; return(define) ; } void Get_PointerForString(struct StringXPointer SXF[], const char *string, int *FlagError, void **Pointer) { int i = 0 ; while ((SXF[i].string != NULL) && (strcmp(SXF[i].string, string))) i++ ; *Pointer = SXF[i].Pointer ; *FlagError = (SXF[i].string == NULL)? 1 : 0 ; } void Get_3Function3NbrForString(struct StringX3Function3Nbr SXF[], const char *string, int *FlagError, void (**Function1)(), void (**Function2)(), void (**Function3)(), double *Nbr1, int *Nbr2, int *Nbr3) { int i = 0 ; while ((SXF[i].string != NULL) && (strcmp(SXF[i].string, string))) i++ ; *Function1 = SXF[i].Function1 ; *Function2 = SXF[i].Function2 ; *Function3 = SXF[i].Function3 ; *Nbr1 = SXF[i].Nbr1 ; *Nbr2 = SXF[i].Nbr2 ; *Nbr3 = SXF[i].Nbr3 ; *FlagError = (SXF[i].string == NULL)? 1 : 0 ; } void Get_Function2NbrForString(struct StringXFunction2Nbr SXF[], const char *string, int *FlagError, void (**Function)(), int *Nbr1, int *Nbr2) { int i = 0 ; while ((SXF[i].string != NULL) && (strcmp(SXF[i].string, string))) i++ ; *Function = SXF[i].Function ; *Nbr1 = SXF[i].Nbr1 ; *Nbr2 = SXF[i].Nbr2 ; *FlagError = (SXF[i].string == NULL)? 1 : 0 ; } void Get_FunctionForFunction(struct FunctionXFunction FXF[], void (*Function1)(), int *FlagError, void (**Function2)() ) { int i = 0 ; while ((FXF[i].Function1 != NULL) && (FXF[i].Function1 != Function1)) i++ ; *Function2 = FXF[i].Function2 ; *FlagError = (FXF[i].Function1 == NULL)? 1 : 0 ; } void Get_FunctionForDefine(struct DefineXFunction DXF[], int define, int *FlagError, void (**Function)()) { int i = 0 ; while ((DXF[i].define != 0) && (DXF[i].define != define)) i++ ; *Function = DXF[i].Function ; *FlagError = (DXF[i].define == 0)? 1 : 0 ; } const char *Get_StringForDefine(struct StringXDefine SXD[], int define) { int i = 0 ; const char *string ; while ((SXD[i].string != NULL) && (SXD[i].define != define)) i++ ; if (SXD[i].string != NULL) string = SXD[i].string ; else string = "?" ; return(string) ; } const char *Get_StringForDefine1Nbr(struct StringXDefine1Nbr SXD[], int define) { int i = 0 ; const char *string ; while ((SXD[i].string != NULL) && (SXD[i].define != define)) i++ ; if (SXD[i].string != NULL) string = SXD[i].string ; else string = "?" ; return(string) ; } const char *Get_StringForPointer(struct StringXPointer SXF[], void *Pointer) { int i = 0 ; const char *string ; while ((SXF[i].string != NULL) && (SXF[i].Pointer != Pointer)) i++ ; if (SXF[i].string != NULL) string = SXF[i].string ; else string = "?" ; return(string) ; } const char *Get_StringFor3Function3Nbr(struct StringX3Function3Nbr SXF[], void (*Function1)()) { int i = 0 ; const char *string ; while ((SXF[i].string != NULL) && (SXF[i].Function1 != Function1)) i++ ; if (SXF[i].string != NULL) string = SXF[i].string ; else string = "?" ; return(string) ; } const char *Get_StringForFunction2Nbr(struct StringXFunction2Nbr SXF[], void (*Function)()) { int i = 0 ; const char *string ; while ((SXF[i].string != NULL) && (SXF[i].Function != Function)) i++ ; if (SXF[i].string != NULL) string = SXF[i].string ; else string = "?" ; return(string) ; } /* ------------------------------------------------------------------------ Get_Valid_XXX ------------------------------------------------------------------------ */ static char Valid[5000]; #define GV(value, Get_Valid_X) \ int i = 0; \ Message::Direct("Value '%s' not amongst valid choices:", value); \ while (V[i].string != NULL){ \ if(!(i%3)){ \ if(i) Message::Direct(" %s", Valid); \ strcpy(Valid, V[i].string); \ } \ else strcat(Valid, V[i].string); \ strcat(Valid, " "); \ i++ ; \ } \ Message::Direct(" %s", Valid); void Get_Valid_SXD (const char *value, struct StringXDefine V[]) { GV(value, "Get_Valid_SXD"); } void Get_Valid_SXD1N (const char *value, struct StringXDefine1Nbr V[]) { GV(value, "Get_Valid_SXD1N"); } void Get_Valid_SXP (const char *value, struct StringXPointer V[]) { GV(value, "Get_Valid_SXP"); } void Get_Valid_SX3F3N(const char *value, struct StringX3Function3Nbr V[]) { GV(value, "Get_Valid_SX3F3N"); } void Get_Valid_SXF2N (const char *value, struct StringXFunction2Nbr V[]) { GV(value, "Get_Valid_SXF2N"); } #undef GV getdp-2.7.0-source/Interface/ProParser.tab.hpp000644 001750 001750 00000023752 12611677027 022716 0ustar00geuzainegeuzaine000000 000000 /* A Bison parser, made by GNU Bison 3.0.4. */ /* Bison interface for Yacc-like parsers in C Copyright (C) 1984, 1989-1990, 2000-2015 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ /* As a special exception, you may create a larger work that contains part or all of the Bison parser skeleton and distribute that work under terms of your choice, so long as that work isn't itself a parser generator using the skeleton or a modified version thereof as a parser skeleton. Alternatively, if you modify or redistribute the parser skeleton itself, you may (at your option) remove this special exception, which will cause the skeleton and the resulting Bison output files to be licensed under the GNU General Public License without this special exception. This special exception was added by the Free Software Foundation in version 2.2 of Bison. */ #ifndef YY_GETDP_YY_PROPARSER_TAB_HPP_INCLUDED # define YY_GETDP_YY_PROPARSER_TAB_HPP_INCLUDED /* Debug traces. */ #ifndef YYDEBUG # define YYDEBUG 0 #endif #if YYDEBUG extern int getdp_yydebug; #endif /* Token type. */ #ifndef YYTOKENTYPE # define YYTOKENTYPE enum yytokentype { tINT = 258, tFLOAT = 259, tSTRING = 260, tBIGSTR = 261, tEND = 262, tDOTS = 263, tStrCat = 264, tSprintf = 265, tPrintf = 266, tMPI_Printf = 267, tRead = 268, tPrintConstants = 269, tStrCmp = 270, tStrChoice = 271, tUpperCase = 272, tLowerCase = 273, tLowerCaseIn = 274, tNbrRegions = 275, tGetRegion = 276, tNameFromString = 277, tStringFromName = 278, tFor = 279, tEndFor = 280, tIf = 281, tElseIf = 282, tElse = 283, tEndIf = 284, tMacro = 285, tReturn = 286, tCall = 287, tCallTest = 288, tTest = 289, tWhile = 290, tFlag = 291, tInclude = 292, tConstant = 293, tList = 294, tListAlt = 295, tLinSpace = 296, tLogSpace = 297, tListFromFile = 298, tChangeCurrentPosition = 299, tDefineConstant = 300, tUndefineConstant = 301, tDefineNumber = 302, tDefineString = 303, tPi = 304, tMPI_Rank = 305, tMPI_Size = 306, t0D = 307, t1D = 308, t2D = 309, t3D = 310, tTestLevel = 311, tTotalMemory = 312, tCurrentDirectory = 313, tGETDP_MAJOR_VERSION = 314, tGETDP_MINOR_VERSION = 315, tGETDP_PATCH_VERSION = 316, tExp = 317, tLog = 318, tLog10 = 319, tSqrt = 320, tSin = 321, tAsin = 322, tCos = 323, tAcos = 324, tTan = 325, tAtan = 326, tAtan2 = 327, tSinh = 328, tCosh = 329, tTanh = 330, tFabs = 331, tFloor = 332, tCeil = 333, tRound = 334, tSign = 335, tFmod = 336, tModulo = 337, tHypot = 338, tRand = 339, tSolidAngle = 340, tTrace = 341, tOrder = 342, tCrossProduct = 343, tDofValue = 344, tMHTransform = 345, tMHJacNL = 346, tGroup = 347, tDefineGroup = 348, tAll = 349, tInSupport = 350, tMovingBand2D = 351, tDefineFunction = 352, tConstraint = 353, tRegion = 354, tSubRegion = 355, tRegionRef = 356, tSubRegionRef = 357, tFilter = 358, tToleranceFactor = 359, tCoefficient = 360, tValue = 361, tTimeFunction = 362, tBranch = 363, tNameOfResolution = 364, tJacobian = 365, tCase = 366, tMetricTensor = 367, tIntegration = 368, tType = 369, tSubType = 370, tCriterion = 371, tGeoElement = 372, tNumberOfPoints = 373, tMaxNumberOfPoints = 374, tNumberOfDivisions = 375, tMaxNumberOfDivisions = 376, tStoppingCriterion = 377, tFunctionSpace = 378, tName = 379, tBasisFunction = 380, tNameOfCoef = 381, tFunction = 382, tdFunction = 383, tSubFunction = 384, tSubdFunction = 385, tSupport = 386, tEntity = 387, tSubSpace = 388, tNameOfBasisFunction = 389, tGlobalQuantity = 390, tEntityType = 391, tEntitySubType = 392, tNameOfConstraint = 393, tFormulation = 394, tQuantity = 395, tNameOfSpace = 396, tIndexOfSystem = 397, tSymmetry = 398, tGalerkin = 399, tdeRham = 400, tGlobalTerm = 401, tGlobalEquation = 402, tDt = 403, tDtDof = 404, tDtDt = 405, tDtDtDof = 406, tDtDtDtDof = 407, tDtDtDtDtDof = 408, tDtDtDtDtDtDof = 409, tJacNL = 410, tDtDofJacNL = 411, tNeverDt = 412, tDtNL = 413, tAtAnteriorTimeStep = 414, tMaxOverTime = 415, tFourierSteinmetz = 416, tIn = 417, tFull_Matrix = 418, tResolution = 419, tHidden = 420, tDefineSystem = 421, tNameOfFormulation = 422, tNameOfMesh = 423, tFrequency = 424, tSolver = 425, tOriginSystem = 426, tDestinationSystem = 427, tOperation = 428, tOperationEnd = 429, tSetTime = 430, tSetTimeStep = 431, tDTime = 432, tSetFrequency = 433, tFourierTransform = 434, tFourierTransformJ = 435, tLanczos = 436, tEigenSolve = 437, tEigenSolveJac = 438, tPerturbation = 439, tUpdate = 440, tUpdateConstraint = 441, tBreak = 442, tGetResidual = 443, tCreateSolution = 444, tEvaluate = 445, tSelectCorrection = 446, tAddCorrection = 447, tMultiplySolution = 448, tAddOppositeFullSolution = 449, tSolveAgainWithOther = 450, tSetGlobalSolverOptions = 451, tTimeLoopTheta = 452, tTimeLoopNewmark = 453, tTimeLoopRungeKutta = 454, tTimeLoopAdaptive = 455, tTime0 = 456, tTimeMax = 457, tTheta = 458, tBeta = 459, tGamma = 460, tIterativeLoop = 461, tIterativeLoopN = 462, tIterativeLinearSolver = 463, tNbrMaxIteration = 464, tRelaxationFactor = 465, tIterativeTimeReduction = 466, tSetCommSelf = 467, tSetCommWorld = 468, tBarrier = 469, tBroadcastFields = 470, tSleep = 471, tDivisionCoefficient = 472, tChangeOfState = 473, tChangeOfCoordinates = 474, tChangeOfCoordinates2 = 475, tSystemCommand = 476, tError = 477, tGmshRead = 478, tGmshMerge = 479, tGmshOpen = 480, tGmshWrite = 481, tGmshClearAll = 482, tDelete = 483, tDeleteFile = 484, tRenameFile = 485, tCreateDir = 486, tGenerateOnly = 487, tGenerateOnlyJac = 488, tSolveJac_AdaptRelax = 489, tSaveSolutionExtendedMH = 490, tSaveSolutionMHtoTime = 491, tSaveSolutionWithEntityNum = 492, tInitMovingBand2D = 493, tMeshMovingBand2D = 494, tGenerateMHMoving = 495, tGenerateMHMovingSeparate = 496, tAddMHMoving = 497, tGenerateGroup = 498, tGenerateJacGroup = 499, tGenerateRHSGroup = 500, tGenerateGroupCumulative = 501, tGenerateJacGroupCumulative = 502, tGenerateRHSGroupCumulative = 503, tSaveMesh = 504, tDeformMesh = 505, tFrequencySpectrum = 506, tPostProcessing = 507, tNameOfSystem = 508, tPostOperation = 509, tNameOfPostProcessing = 510, tUsingPost = 511, tAppend = 512, tResampleTime = 513, tPlot = 514, tPrint = 515, tPrintGroup = 516, tEcho = 517, tSendMergeFileRequest = 518, tWrite = 519, tAdapt = 520, tOnGlobal = 521, tOnRegion = 522, tOnElementsOf = 523, tOnGrid = 524, tOnSection = 525, tOnPoint = 526, tOnLine = 527, tOnPlane = 528, tOnBox = 529, tWithArgument = 530, tFile = 531, tDepth = 532, tDimension = 533, tComma = 534, tTimeStep = 535, tHarmonicToTime = 536, tCosineTransform = 537, tValueIndex = 538, tValueName = 539, tFormat = 540, tHeader = 541, tFooter = 542, tSkin = 543, tSmoothing = 544, tTarget = 545, tSort = 546, tIso = 547, tNoNewLine = 548, tNoTitle = 549, tDecomposeInSimplex = 550, tChangeOfValues = 551, tTimeLegend = 552, tFrequencyLegend = 553, tEigenvalueLegend = 554, tEvaluationPoints = 555, tStoreInRegister = 556, tStoreInVariable = 557, tStoreInField = 558, tStoreInMeshBasedField = 559, tStoreMaxInRegister = 560, tStoreMaxXinRegister = 561, tStoreMaxYinRegister = 562, tStoreMaxZinRegister = 563, tStoreMinInRegister = 564, tStoreMinXinRegister = 565, tStoreMinYinRegister = 566, tStoreMinZinRegister = 567, tLastTimeStepOnly = 568, tAppendTimeStepToFileName = 569, tTimeValue = 570, tTimeImagValue = 571, tAppendExpressionToFileName = 572, tAppendExpressionFormat = 573, tOverrideTimeStepValue = 574, tNoMesh = 575, tSendToServer = 576, tColor = 577, tStr = 578, tDate = 579, tOnelabAction = 580, tFixRelativePath = 581, tNewCoordinates = 582, tAppendToExistingFile = 583, tAppendStringToFileName = 584, tDEF = 585, tOR = 586, tAND = 587, tEQUAL = 588, tNOTEQUAL = 589, tAPPROXEQUAL = 590, tLESSOREQUAL = 591, tGREATEROREQUAL = 592, tLESSLESS = 593, tGREATERGREATER = 594, tCROSSPRODUCT = 595, UNARYPREC = 596, tSHOW = 597 }; #endif /* Value type. */ #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED union YYSTYPE { #line 145 "ProParser.y" /* yacc.c:1909 */ char *c; int i; double d; List_T *l; struct TwoInt t; #line 405 "ProParser.tab.hpp" /* yacc.c:1909 */ }; typedef union YYSTYPE YYSTYPE; # define YYSTYPE_IS_TRIVIAL 1 # define YYSTYPE_IS_DECLARED 1 #endif extern YYSTYPE getdp_yylval; int getdp_yyparse (void); #endif /* !YY_GETDP_YY_PROPARSER_TAB_HPP_INCLUDED */ getdp-2.7.0-source/Interface/CMakeLists.txt000644 001750 001750 00000000641 12521343344 022243 0ustar00geuzainegeuzaine000000 000000 # GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege # # See the LICENSE.txt file for license information. Please report all # bugs and problems to the public mailing list . set(SRC ProData.cpp ProDefine.cpp ProParser.yy.cpp ProParser.tab.cpp MacroManager.cpp ) file(GLOB HDR RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} *.h) append_getdp_src(Interface "${SRC};${HDR}") getdp-2.7.0-source/Interface/ProData.cpp000644 001750 001750 00000206317 12606421313 021546 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include #include #include "GetDPConfig.h" #include "ProData.h" #include "ProDefine.h" #include "ProParser.h" #include "MacroManager.h" #include "Message.h" #include "MallocUtils.h" #include "OS.h" #if defined(HAVE_LEGACY) #include "Generate_Network.h" #endif // Global problem structure: this is the only problem structure that // is instanciated, and it is filled by the parser struct Problem Problem_S; // Global run-time current data: this is the only current data // structure that is instantiated struct CurrentData Current; // Sorting functions int fcmp_Integer(const void *a, const void *b) { return(*(int*)a - *(int*)b ); } int fcmp_Constant (const void *a, const void *b) { return ( strcmp(((struct Constant *)a)->Name, ((struct Constant *)b)->Name)); } int fcmp_Expression_Name(const void *a, const void *b) { return ( strcmp((char *)a, ((struct Expression *)b)->Name ) ); } int fcmp_Group_Name(const void *a, const void *b) { return ( strcmp((char *)a, ((struct Group *)b)->Name ) ); } int fcmp_Constraint_Name(const void *a, const void *b) { return ( strcmp((char *)a, ((struct Constraint *)b)->Name ) ); } int fcmp_JacobianMethod_Name(const void *a, const void *b) { return ( strcmp((char *)a, ((struct JacobianMethod *)b)->Name ) ); } int fcmp_IntegrationMethod_Name(const void *a, const void *b) { return ( strcmp((char *)a, ((struct IntegrationMethod *)b)->Name ) ); } int fcmp_BasisFunction_Name(const void *a, const void *b) { return ( strcmp((char *)a, ((struct BasisFunction *)b)->Name ) ); } int fcmp_FunctionSpace_Name(const void *a, const void *b) { return ( strcmp((char *)a, ((struct FunctionSpace *)b)->Name ) ); } int fcmp_BasisFunction_NameOfCoef(const void *a, const void *b) { return ( strcmp((char *)a, ((struct BasisFunction *)b)->NameOfCoef ) ); } int fcmp_SubSpace_Name(const void *a, const void *b) { return ( strcmp((char *)a, ((struct SubSpace *)b)->Name ) ); } int fcmp_GlobalQuantity_Name(const void *a, const void *b) { return ( strcmp((char *)a, ((struct GlobalQuantity *)b)->Name ) ); } int fcmp_Formulation_Name(const void *a, const void *b) { return ( strcmp((char *)a, ((struct Formulation *)b)->Name ) ); } int fcmp_DefineQuantity_Name(const void *a, const void *b) { return ( strcmp((char *)a, ((struct DefineQuantity *)b)->Name ) ); } int fcmp_DefineSystem_Name(const void *a, const void *b) { return ( strcmp((char *)a, ((struct DefineSystem *)b)->Name ) ); } int fcmp_Resolution_Name(const void *a, const void *b) { return ( strcmp((char *)a, ((struct Resolution *)b)->Name ) ); } int fcmp_PostProcessing_Name(const void *a, const void *b) { return ( strcmp((char *)a, ((struct PostProcessing *)b)->Name ) ); } int fcmp_PostQuantity_Name(const void *a, const void *b) { return ( strcmp((char *)a, ((struct PostQuantity *)b)->Name ) ); } int fcmp_PostOperation_Name(const void *a, const void *b) { return ( strcmp((char *)a, ((struct PostOperation *)b)->Name ) ); } // I/O routines void Init_ProblemStructure() { Problem_S.Group = NULL ; Problem_S.Expression = NULL ; Problem_S.FunctionSpace = NULL ; Problem_S.Constraint = NULL ; Problem_S.Formulation = NULL ; Problem_S.JacobianMethod = NULL ; Problem_S.IntegrationMethod = NULL ; Problem_S.Resolution = NULL ; Problem_S.PostProcessing = NULL ; Problem_S.PostOperation = NULL ; Current.Name = NULL; Current.NbrSystem = 0; Current.DefineSystem_P = NULL ; Current.DofData_P0 = NULL; Current.DofData = NULL; Current.GeoData = NULL; Current.PostOpData_L = NULL; Current.PostOpDataIndex = 0; Current.NbrHar = 0; Current.Region = 0; Current.SubRegion = 0; Current.NumEntity = 0; Current.NumEntityInElement = 0; Current.NumEntities[0] = 0; Current.Element = NULL; Current.IntegrationSupportIndex = 0; Current.ElementSource = 0; Current.SourceIntegrationSupportIndex = 0; Current.TypeTime = 0; Current.TypeAssembly = 0; Current.SubTimeStep = 0; Current.flagAssDiag = 0; Current.x = 0.0; Current.y = 0.0; Current.z = 0.0; Current.u = 0.0; Current.v = 0.0; Current.w = 0.0; Current.xs = 0.0; Current.ys = 0.0; Current.zs = 0.0; Current.us = 0.0; Current.vs = 0.0; Current.ws = 0.0; Current.a = 0.0; Current.b = 0.0; Current.c = 0.0; Current.xp = 0.0; Current.yp = 0.0; Current.zp = 0.0; Current.ut = 0.0; Current.vt = 0.0; Current.wt = 0.0; Current.Val[0] = 0.0; Current.QuadraturePointIndex = 0.0; Current.Time = 0.0; Current.TimeImag = 0.0; Current.TimeStep = 0.0; Current.DTime = 0.0; Current.Theta = 0.0; Current.Beta = 0.0; Current.Gamma = 0.0; Current.PredOrder = 0.0; Current.CorrOrder = 0.0; Current.aPredCoeff[0] = 0.0; Current.aCorrCoeff[0] = 0.0; Current.bCorrCoeff = 0.0; Current.PredErrorConst = 0.0; Current.CorrErrorConst = 0.0; Current.Breakpoint = 0.0; Current.Iteration = 0.0; Current.RelativeDifference = 0.0; Current.RelativeDifferenceOld = 0.0; Current.RelaxationFactor = 0.0; Current.KSPIts = 0.0; } // FIXME: TODO to remove parser memory leaks! void Free_Group(struct Group* a) { // we should convert all the structs into classes and add a default // constructor with proper initializations ; cleanup the parser to make sure // who owns what, so we can safely delete // // List_Delete(a->ExtendedList); List_Delete(a->ExtendedSuppList); } void Free_Expression(struct Expression* a){} void Free_FunctinSpace(struct FunctionSpace* a){} void Free_Constraint(struct Constraint* a){} void Free_Formulation(struct Formuation* a){} void Free_JacobianMethod(struct JacobianMethod* a){} void Free_IntegrationMethod(struct IntegrationMethod* a){} void Free_Resolution(struct Resolution* a){} void Free_PostProcessing(struct PostProcessing* a){} void Free_PostOperation(struct PostOperation* a){} void Free_ProblemStructure() { if(Problem_S.Group){ for(int i = 0; i < List_Nbr(Problem_S.Group); i++) Free_Group((Group*)List_Pointer(Problem_S.Group, i)); List_Delete(Problem_S.Group); } if(Problem_S.Expression){ for(int i = 0; i < List_Nbr(Problem_S.Expression); i++) Free_Expression((Expression*)List_Pointer(Problem_S.Expression, i)); List_Delete(Problem_S.Expression); } if(Problem_S.FunctionSpace){ for(int i = 0; i < List_Nbr(Problem_S.FunctionSpace); i++) Free_FunctinSpace((FunctionSpace*)List_Pointer(Problem_S.FunctionSpace, i)); List_Delete(Problem_S.FunctionSpace); } if(Problem_S.Constraint){ for(int i = 0; i < List_Nbr(Problem_S.Constraint); i++) Free_Constraint((Constraint*)List_Pointer(Problem_S.Constraint, i)); List_Delete(Problem_S.Constraint); } if(Problem_S.Formulation){ for(int i = 0; i < List_Nbr(Problem_S.Formulation); i++) Free_Formulation((Formuation*)List_Pointer(Problem_S.Formulation, i)); List_Delete(Problem_S.Formulation); } if(Problem_S.JacobianMethod){ for(int i = 0; i < List_Nbr(Problem_S.JacobianMethod); i++) Free_JacobianMethod((JacobianMethod*)List_Pointer(Problem_S.JacobianMethod, i)); List_Delete(Problem_S.JacobianMethod); } if(Problem_S.IntegrationMethod){ for(int i = 0; i < List_Nbr(Problem_S.IntegrationMethod); i++) Free_IntegrationMethod((IntegrationMethod*)List_Pointer(Problem_S.IntegrationMethod, i)); List_Delete(Problem_S.IntegrationMethod); } if(Problem_S.Resolution){ for(int i = 0; i < List_Nbr(Problem_S.Resolution); i++) Free_Resolution((Resolution*)List_Pointer(Problem_S.Resolution, i)); List_Delete(Problem_S.Resolution); } if(Problem_S.PostProcessing){ for(int i = 0; i < List_Nbr(Problem_S.PostProcessing); i++) Free_PostProcessing((PostProcessing*)List_Pointer(Problem_S.PostProcessing, i)); List_Delete(Problem_S.PostProcessing); } if(Problem_S.PostOperation){ for(int i = 0; i < List_Nbr(Problem_S.PostOperation); i++) Free_PostOperation((PostOperation*)List_Pointer(Problem_S.PostOperation, i)); List_Delete(Problem_S.PostOperation); } Init_ProblemStructure(); } std::string Fix_RelativePath(const char *name, const char *reference) { if(!name || !strlen(name)) return ""; std::string in(name); if(in[0] == '/' || in[0] == '\\' || (in.size() > 3 && in[1] == ':' && (in[2] == '/' || in[2] == '\\'))){ // do nothing: 'in' is an absolute path return in; } else{ char AbsPath[2048]; strcpy(AbsPath, reference ? reference : getdp_yyname.c_str()); int i = strlen(AbsPath) - 1; while(i >= 0 && AbsPath[i] != '/' && AbsPath[i] != '\\') i--; AbsPath[i+1] = '\0'; return std::string(AbsPath) + in; } } static std::vector openFiles; void Read_ProblemStructure(const char *name) { int Last_yylinenum = getdp_yylinenum; std::string Last_yyname = getdp_yyname; int Last_ErrorLevel = getdp_yyerrorlevel; int Last_yyincludenum = getdp_yyincludenum; char AbsPath[4096]; int i; if((strlen(name) > 0 && (name[0] == '/' || name[0] == '\\')) || (strlen(name) > 3 && name[1] == ':' && (name[2] == '\\' || name[2] == '/'))){ // name is an absolute path strcpy(AbsPath, name); } else{ strcpy(AbsPath, getdp_yyname.c_str()); i = getdp_yyname.size() - 1; while(i >= 0 && getdp_yyname[i] != '/' && getdp_yyname[i] != '\\') i--; AbsPath[i+1] = '\0'; strcat(AbsPath, name); } Message::Info("Loading problem definition '%s'", AbsPath); // opening the file in text mode messes up the loops (they use // fsetpos/fgetpos) on Windows without Cygwin; not sure why, but // opening the file in binary mode fixes the problem if(!(getdp_yyin = FOpen(AbsPath, "rb"))){ Message::Error("Unable to open file '%s'", AbsPath); return; } getdp_yyerrorlevel = 0; getdp_yylinenum = 1; getdp_yyincludenum=0; getdp_yyname = std::string(AbsPath); getdp_yyrestart(getdp_yyin); getdp_yyparse(); // don't close the file here: we'll need it if there is a Macro in it: //fclose(getdp_yyin); openFiles.push_back(getdp_yyin); if(getdp_yyerrorlevel) return; while(getdp_yyincludenum > 0){ Read_ProblemStructure(getdp_yyincludename); getdp_yyin = FOpen(getdp_yyname.c_str(), "rb"); // same comment as above getdp_yyrestart(getdp_yyin); for(i = 0; i < getdp_yylinenum; i++) fgets(AbsPath, sizeof(AbsPath), getdp_yyin); getdp_yylinenum++; getdp_yyparse(); // don't close the file here: we'll need it if there is a Macro in it: //fclose(getdp_yyin); openFiles.push_back(getdp_yyin); if(getdp_yyerrorlevel) return; } getdp_yylinenum = Last_yylinenum; getdp_yyname = Last_yyname; getdp_yyerrorlevel = Last_ErrorLevel; getdp_yyincludenum = Last_yyincludenum; } void Finalize_ProblemStructure() { for(unsigned int i = 0; i < openFiles.size(); i++) fclose(openFiles[i]); MacroManager::Instance()->clear(); // Here we should parse any ONELAB-defined functions (+ their context) } char *Get_ExpressionName(int Index) { return(((struct Expression *)List_Pointer(Problem_S.Expression, Index))->Name); } void Print_WholeQuantity(List_T *WholeQuantity, List_T *DQ_L) { int j, k; struct WholeQuantity *WQ; WQ = (struct WholeQuantity*)List_Pointer(WholeQuantity, 0); for (k = 0; k < List_Nbr(WholeQuantity); k++) { switch ((WQ+k)->Type) { case WQ_OPERATORANDQUANTITY : Message::Check(" {%s %s}", Get_StringForDefine (Operator_Type, (WQ+k)->Case.OperatorAndQuantity.TypeOperator), ((struct DefineQuantity *) List_Pointer(DQ_L, (WQ+k)->Case.OperatorAndQuantity.Index)) ->Name); break; case WQ_OPERATORANDQUANTITYEVAL : Message::Check(" {%s %s} ExplicitEvaluation", Get_StringForDefine (Operator_Type, (WQ+k)->Case.OperatorAndQuantity.TypeOperator), ((struct DefineQuantity *) List_Pointer(DQ_L, (WQ+k)->Case.OperatorAndQuantity.Index)) ->Name); break; case WQ_BINARYOPERATOR : switch ((WQ+k)->Case.Operator.TypeOperator) { case OP_PLUS : Message::Check(" +"); break; case OP_MINUS : Message::Check(" -"); break; case OP_TIME : Message::Check(" *"); break; case OP_DIVIDE : Message::Check(" /"); break; case OP_MODULO : Message::Check(" %%"); break; case OP_POWER : Message::Check(" ^"); break; case OP_CROSSPRODUCT : Message::Check(" x"); break; case OP_LESS : Message::Check(" <"); break; case OP_GREATER : Message::Check(" >"); break; case OP_LESSOREQUAL : Message::Check(" <="); break; case OP_GREATEROREQUAL : Message::Check(" >="); break; case OP_EQUAL : Message::Check(" =="); break; case OP_NOTEQUAL : Message::Check(" !="); break; default : Message::Check(" UnknownBinaryOperator[]"); break; } break; case WQ_UNARYOPERATOR : switch ((WQ+k)->Case.Operator.TypeOperator) { case OP_NEG : Message::Check(" -(unary)"); break; case OP_NOT : Message::Check(" !"); break; default : Message::Check(" UnknownUnaryOperator[]"); break; } break; case WQ_EXPRESSION : Message::Check(" %s[]", ((struct Expression *) List_Pointer(Problem_S.Expression, (WQ+k)->Case.Expression.Index))->Name); break; case WQ_BUILTINFUNCTION : case WQ_EXTERNBUILTINFUNCTION : #if defined(HAVE_LEGACY) Message::Check(" %s", Get_StringForFunction2Nbr(F_Function, (WQ+k)->Case.Function.Fct)); #endif if ((WQ+k)->Type == WQ_EXTERNBUILTINFUNCTION) Message::Check("[.]"); if ((WQ+k)->Type == WQ_BUILTINFUNCTION) Message::Check("[]"); if ((WQ+k)->Case.Function.NbrParameters) { Message::Check("{"); for (j = 0; j < (WQ+k)->Case.Function.NbrParameters; j++) { if (j) Message::Check(","); Message::Check(" %.10g", (WQ+k)->Case.Function.Para[j]); } Message::Check(" }"); } break; case WQ_CONSTANT : Message::Check(" %.8g", (WQ+k)->Case.Constant); break; case WQ_MHTRANSFORM : //**** Message::Check(" MHTransform[ "); Message::Check("%s", Get_ExpressionName((WQ+k)->Case.MHTransform.Index)); Message::Check("["); Print_WholeQuantity((WQ+k)->Case.MHTransform.WholeQuantity, DQ_L); Message::Check(" ] ]{ %d }", (WQ+k)->Case.MHTransform.NbrPoints); break; case WQ_MHJACNL : Message::Check(" MHJacNL[ "); Message::Check("%s", Get_ExpressionName((WQ+k)->Case.MHJacNL.Index)); //Message::Check("["); //Print_WholeQuantity((WQ+k)->Case.MHTransform.WholeQuantity, DQ_L); //Message::Check("] ]{ %d, %d}", (WQ+k)->Case.MHJacNL.NbrPoints, (WQ+k)->Case.MHJacNL.FreqOffSet); Message::Check("]{ %d, %d}", (WQ+k)->Case.MHJacNL.NbrPoints, (WQ+k)->Case.MHJacNL.FreqOffSet); break; case WQ_TIMEDERIVATIVE : Message::Check(" Dt["); Print_WholeQuantity((WQ+k)->Case.TimeDerivative.WholeQuantity, DQ_L); Message::Check(" ]"); break; case WQ_TRACE : Message::Check(" Trace["); Print_WholeQuantity((WQ+k)->Case.Trace.WholeQuantity, DQ_L); Message::Check(" , %s ]", ((struct Group*) List_Pointer(Problem_S.Group, (WQ+k)->Case.Trace.InIndex))->Name); break; case WQ_CAST : if(!(WQ+k)->Case.Cast.NbrHar) Message::Check(" <%s>[", ((struct FunctionSpace *) List_Pointer(Problem_S.FunctionSpace, (WQ+k)->Case.Cast.FunctionSpaceIndexForType))->Name); else Message::Check(" ["); Print_WholeQuantity((WQ+k)->Case.Cast.WholeQuantity, DQ_L); Message::Check(" ]"); break; case WQ_CURRENTVALUE : Message::Check(" $%s", Get_StringForPointer(Current_Value, (void *)((WQ+k)->Case.CurrentValue.Value))); break; case WQ_ARGUMENT : Message::Check(" $%d", (WQ+k)->Case.Argument.Index); break; case WQ_TEST : Message::Check(" ?"); Print_WholeQuantity((WQ+k)->Case.Test.WholeQuantity_True , DQ_L); Message::Check(" :"); Print_WholeQuantity((WQ+k)->Case.Test.WholeQuantity_False, DQ_L); break; case WQ_SAVEVALUE : Message::Check(" ->#%d", (WQ+k)->Case.SaveValue.Index + 1); break; case WQ_VALUESAVED : Message::Check(" #%d", (WQ+k)->Case.ValueSaved.Index + 1); break; case WQ_SHOWVALUE : Message::Check(" ->show with prefix #%d", (WQ+k)->Case.ShowValue.Index + 1); break; default : Message::Check(" ???"); break; } } } void Print_Group() { int i, Nbr, j; struct Group *GR; Nbr = List_Nbr(Problem_S.Group); Message::Check("Group { /* nbr = %d */\n", Nbr); Message::Check("\n"); for (i = 0; i < Nbr; i++) { GR = (struct Group*)List_Pointer(Problem_S.Group, i); Message::Check(" %s = %s [", GR->Name, Get_StringForDefine(FunctionForGroup_Type, GR->FunctionType)); if (GR->InitialList != NULL) { Message::Check(" {"); for (j = 0; j < List_Nbr(GR->InitialList); j++) Message::Check(" %d", *((int *)List_Pointer(GR->InitialList, j)) ); Message::Check(" }"); } else Message::Check(" All"); if (GR->InitialSuppList != NULL) { if (GR->SuppListType != SUPPLIST_INSUPPORT) { Message::Check(", %s {", Get_StringForDefine(FunctionForGroup_SuppList, GR->SuppListType)); for (j = 0; j < List_Nbr(GR->InitialSuppList); j++) Message::Check(" %d", *((int *)List_Pointer(GR->InitialSuppList, j)) ); Message::Check(" }"); } else { Message::Check(", %s", Get_StringForDefine(FunctionForGroup_SuppList, GR->SuppListType)); Message::Check(" %s", ((struct Group *) List_Pointer(Problem_S.Group, *((int *)List_Pointer(GR->InitialSuppList, 0)))) ->Name); } } Message::Check(" ]"); if (GR->Type == MOVINGBAND2D) { Message::Check(" = MovingBand2D [ {"); for (j = 0; j < List_Nbr(GR->MovingBand2D->InitialList1); j++) Message::Check(" %d", *((int *)List_Pointer(GR->MovingBand2D->InitialList1, j)) ); Message::Check(" } , {"); for (j = 0; j < List_Nbr(GR->MovingBand2D->InitialList2); j++) Message::Check(" %d", *((int *)List_Pointer(GR->MovingBand2D->InitialList2, j)) ); Message::Check(" } ]"); } Message::Check("; /* Num %d */\n", i); } Message::Check("\n"); Message::Check("}\n"); } void Print_Expression() { int i, Nbr, j; struct Expression *EX; struct ExpressionPerRegion *EXPR; Nbr = List_Nbr(Problem_S.Expression); Message::Check("Function { /* nbr = %d */\n", Nbr); Message::Check("\n"); for (i = 0; i < Nbr; i++) { EX = (struct Expression*)List_Pointer(Problem_S.Expression, i); switch (EX->Type) { case CONSTANT : Message::Check(" %s[] = %.10g;\n", EX->Name, EX->Case.Constant); break; case WHOLEQUANTITY : Message::Check(" %s[] = ", EX->Name); Print_WholeQuantity(EX->Case.WholeQuantity, NULL); Message::Check(";\n"); break; case PIECEWISEFUNCTION : for (j = 0; j < List_Nbr(EX->Case.PieceWiseFunction.ExpressionPerRegion); j++) { EXPR = (struct ExpressionPerRegion*) List_Pointer(EX->Case.PieceWiseFunction.ExpressionPerRegion, j); Message::Check(" %s[%d] = Exp[%s];\n", EX->Name, EXPR->RegionIndex, Get_ExpressionName(EXPR->ExpressionIndex)); } if (!List_Nbr(EX->Case.PieceWiseFunction.ExpressionPerRegion)) Message::Check(" DefineFunction[ %s ];\n", EX->Name); break; case UNDEFINED_EXP : Message::Check(" DefineFunction[ %s ];\n", EX->Name); break; default : Message::Check("???;\n"); break; } } Message::Check("\n"); Message::Check("}\n"); } void Print_Network(struct MultiConstraintPerRegion *MCPR_P) { int i, j; struct ConstraintActive *CA; CA = MCPR_P->Active; Message::Check("NbrNode = %d, NbrBranch = %d\n", CA->Case.Network.NbrNode, CA->Case.Network.NbrBranch); Message::Check("\n"); Message::Check("MatNode (NbrNode x NbrBranch):\n"); for (i = 0; i < CA->Case.Network.NbrNode; i++) { for (j = 0; j < CA->Case.Network.NbrBranch; j++) { Message::Check("%2d ", CA->Case.Network.MatNode[i][j]); } Message::Check("\n"); } Message::Check("\n"); Message::Check("MatLoop (NbrLoop x NbrBranch):\n"); for (i = 0; i < CA->Case.Network.NbrLoop; i++) { for (j = 0; j < CA->Case.Network.NbrBranch; j++) { Message::Check("%2d ", CA->Case.Network.MatLoop[i][j]); } Message::Check("\n"); } } void Print_Constraint() { int i, Nbr, j, Nbrj, k, Nbrk, index, index2; struct Constraint *CO; struct ConstraintPerRegion *CPR; struct MultiConstraintPerRegion MCPR_S; Nbr = List_Nbr(Problem_S.Constraint); Message::Check("Constraint { /* nbr = %d */\n", Nbr); Message::Check("\n"); for (i = 0; i < Nbr; i++) { Message::Check(" /* Num : %d */\n", i); CO = (struct Constraint*)List_Pointer(Problem_S.Constraint, i); Message::Check(" { Name %s; Type %s;\n", CO->Name, Get_StringForDefine(Constraint_Type, CO->Type)); if (CO->Type == NETWORK){ Nbrk = List_Nbr(CO->MultiConstraintPerRegion); for (k = 0; k < Nbrk; k++) { List_Read(CO->MultiConstraintPerRegion, k, &MCPR_S); Message::Check(" Case %s {\n", MCPR_S.Name); Nbrj = List_Nbr(MCPR_S.ConstraintPerRegion); for (j = 0; j < Nbrj; j++) { CPR = (struct ConstraintPerRegion*) List_Pointer(MCPR_S.ConstraintPerRegion, j); Message::Check(" { Region %s;", ((struct Group *) List_Pointer(Problem_S.Group, CPR->RegionIndex))->Name); Message::Check(" Branch { %d, %d };", CPR->Case.Network.Node1, CPR->Case.Network.Node2); Message::Check(" }\n"); } #if defined(HAVE_LEGACY) if (!MCPR_S.Active) MCPR_S.Active = Generate_Network(MCPR_S.Name, MCPR_S.ConstraintPerRegion); #endif Print_Network(&MCPR_S); } } else { Message::Check(" Case {\n"); Nbrj = List_Nbr(CO->ConstraintPerRegion); for (j = 0; j < Nbrj; j++) { CPR = (struct ConstraintPerRegion*)List_Pointer(CO->ConstraintPerRegion, j); Message::Check(" { Region %s;", ((struct Group *) List_Pointer(Problem_S.Group, CPR->RegionIndex))->Name); if (CPR->SubRegionIndex >= 0) Message::Check(" SubRegion %s;", ((struct Group *) List_Pointer(Problem_S.Group, CPR->SubRegionIndex))->Name); if (CPR->Type != CO->Type) Message::Check(" Type %s;", Get_StringForDefine(Constraint_Type, CPR->Type)); switch (CPR->Type) { case ASSIGN : case INIT : Message::Check(" Value Exp[%s];", Get_ExpressionName(CPR->Case.Fixed.ExpressionIndex)); break; case ASSIGNFROMRESOLUTION : case INITFROMRESOLUTION : Message::Check(" NameOfResolution %s;", CPR->Case.Solve.ResolutionName); break; case CST_LINK : case CST_LINKCPLX : if ( (index = CPR->Case.Link.RegionRefIndex) >= 0) Message::Check(" RegionRef %s;", ((struct Group *) List_Pointer(Problem_S.Group, index))->Name); if ( (index = CPR->Case.Link.SubRegionRefIndex) >= 0) Message::Check(" SubRegionRef %s;", ((struct Group *) List_Pointer(Problem_S.Group, index))->Name); if ( (index = CPR->Case.Link.FilterIndex) >= 0) { if ( (index2 = CPR->Case.Link.FilterIndex2) < 0) Message::Check(" Filter Exp[%s];", Get_ExpressionName(index)); else Message::Check(" Filter [ Exp[%s], Exp[%s] ];", Get_ExpressionName(index), Get_ExpressionName(index2)); } if ( (index = CPR->Case.Link.FunctionIndex) >= 0) { if ( (index2 = CPR->Case.Link.FunctionIndex2) < 0) Message::Check(" Function Exp[%s];", Get_ExpressionName(index)); else Message::Check(" Function [ Exp[%s], Exp[%s] ];", Get_ExpressionName(index), Get_ExpressionName(index2)); } if ( (index = CPR->Case.Link.CoefIndex) >= 0) { if ( (index2 = CPR->Case.Link.CoefIndex2) < 0) Message::Check(" Coefficient Exp[%s];", Get_ExpressionName(index)); else Message::Check(" Coefficient [ Exp[%s], Exp[%s] ];", Get_ExpressionName(index), Get_ExpressionName(index2)); } Message::Check(" ToleranceFactor %g;", CPR->Case.Link.ToleranceFactor); break; } if (CPR->TimeFunctionIndex >= 0) Message::Check(" TimeFunction Exp[%s];", Get_ExpressionName(CPR->TimeFunctionIndex)); Message::Check(" }\n"); } } Message::Check(" }\n"); Message::Check(" }\n"); } Message::Check("\n"); Message::Check("}\n"); } void Print_Jacobian() { int i, Nbr, j, Nbrj, k; struct JacobianMethod *JM; struct JacobianCase *JC; Nbr = List_Nbr(Problem_S.JacobianMethod); Message::Check("Jacobian { /* nbr = %d */\n", Nbr); Message::Check("\n"); for (i = 0; i < Nbr; i++) { Message::Check(" /* Num : %d */\n", i); JM = (struct JacobianMethod*)List_Pointer(Problem_S.JacobianMethod, i); Message::Check(" { Name %s;\n", JM->Name); Message::Check(" Case {\n"); Nbrj = List_Nbr(JM->JacobianCase); for (j = 0; j < Nbrj; j++) { JC = (struct JacobianCase*)List_Pointer(JM->JacobianCase, j); Message::Check(" { Region "); if (JC->RegionIndex >= 0) Message::Check("%s;", ((struct Group *) List_Pointer(Problem_S.Group, JC->RegionIndex))->Name); else Message::Check("All;"); Message::Check(" Jacobian %s", Get_StringForDefine1Nbr(Jacobian_Type, JC->TypeJacobian)); if (JC->NbrParameters) { for (k = 0; k < JC->NbrParameters; k++) { if (k) Message::Check(","); else Message::Check(" {"); Message::Check(" %.10g", JC->Para[k]); } Message::Check(" }"); } Message::Check("; }\n"); } Message::Check(" }\n"); Message::Check(" }\n"); } Message::Check("\n"); Message::Check("}\n"); } void Print_Integration() { int i, j, k, Nbrm, Nbrc, Nbrq; struct IntegrationMethod *IM; struct IntegrationCase *IC; struct Quadrature *Q; Nbrm = List_Nbr(Problem_S.IntegrationMethod); Message::Check("Integration { /* nbr = %d */\n", Nbrm); Message::Check("\n"); for (i = 0; i < Nbrm; i++) { Message::Check(" /* Num : %d */\n", i); IM = (struct IntegrationMethod*)List_Pointer(Problem_S.IntegrationMethod, i); Message::Check(" { Name %s; \n", IM->Name); if(IM->CriterionIndex>=0) Message::Check(" Criterion Exp[%s]; \n", Get_ExpressionName(IM->CriterionIndex)); Nbrc = List_Nbr(IM->IntegrationCase); Message::Check(" Case {"); Message::Check(" /* nbr = %d */\n", Nbrc); for (j = 0; j < Nbrc; j++) { IC = (struct IntegrationCase*)List_Pointer(IM->IntegrationCase, j); Message::Check(" { Type %s;", Get_StringForDefine(Integration_Type, IC->Type)); switch (IC->Type) { case GAUSS : Message::Check("\n"); Message::Check(" Case {\n"); Nbrq = List_Nbr(IC->Case); for (k = 0; k < Nbrq; k++) { Q = (struct Quadrature*)List_Pointer(IC->Case, k); Message::Check(" { GeoElement %s; NumberOfPoints %d; }\n", Get_StringForDefine(Element_Type, Q->ElementType), Q->NumberOfPoints); } Message::Check(" }\n"); Message::Check(" }\n"); break; default : Message::Check(" }\n"); break; } } Message::Check(" }\n"); Message::Check(" }\n"); } Message::Check("\n"); Message::Check("}\n"); } void Print_FunctionSpace() { struct FunctionSpace *FS; struct BasisFunction *BF; struct SubSpace *SS; struct GlobalQuantity *GQ; struct ConstraintInFS *CO; List_T *BF_L, *SS_L, *GQ_L, *CO_L; int i0, i, Nbr0, Nbr, j, Nbrj; Nbr0 = List_Nbr(Problem_S.FunctionSpace); Message::Check("FunctionSpace { /* nbr = %d */\n", Nbr0); Message::Check("\n"); for (i0=0; i0BasisFunction; SS_L = FS->SubSpace; GQ_L = FS->GlobalQuantity; CO_L = FS->Constraint; Message::Check(" { Name %s; Type %s;", FS->Name, Get_StringForDefine(Field_Type, FS->Type)); Message::Check("\n"); Nbr = List_Nbr(BF_L); if (Nbr > 0) { Message::Check(" BasisFunction {\n"); BF = (struct BasisFunction*)List_Pointer(BF_L, 0); for (i=0; iNum); #if defined(HAVE_LEGACY) Message::Check(" Name %s; NameOfCoef %s; Function %s;\n", BF->Name, BF->NameOfCoef, Get_StringFor3Function3Nbr(BF_Function, BF->Function)); #endif if (BF->SubFunction) { Message::Check(" SubFunction {"); Nbrj = List_Nbr(BF->SubFunction); for (j=0; jSubFunction, j))))->Name); Message::Check(" };\n"); } if (BF->SubdFunction) { Message::Check(" SubdFunction {"); Nbrj = List_Nbr(BF->SubdFunction); for (j=0; jSubdFunction, j))))->Name); Message::Check(" };\n"); } Message::Check(" Support %s;", (BF->SupportIndex >=0)? ((struct Group *)List_Pointer(Problem_S.Group, BF->SupportIndex)) ->Name : "?"); Message::Check(" Entity %s;\n", (BF->EntityIndex >=0)? ((struct Group *)List_Pointer(Problem_S.Group, BF->EntityIndex)) ->Name : "?"); BF += 1; } Message::Check(" }\n"); } BF = (Nbr>0)? (struct BasisFunction*)List_Pointer(BF_L, 0) : NULL; Nbr = List_Nbr(SS_L); if (Nbr > 0) { Message::Check(" SubSpace {\n"); SS = (struct SubSpace*)List_Pointer(SS_L, 0); for (i=0; iName); Nbrj = List_Nbr(SS->BasisFunction); for (j=0; jBasisFunction, j)))) ->Name, *((int *)List_Pointer(SS->BasisFunction, j))); Message::Check(" };\n"); SS += 1; } Message::Check(" }\n"); } Nbr = List_Nbr(GQ_L); if (Nbr > 0) { Message::Check(" GlobalQuantity {\n"); GQ = (struct GlobalQuantity*)List_Pointer(GQ_L, 0); for (i=0; iNum); Message::Check(" Name %s; Type %s;", GQ->Name, Get_StringForDefine(GlobalQuantity_Type, GQ->Type)); Message::Check(" NameOfCoef %s;\n", ((struct BasisFunction *) List_Pointer(BF_L, GQ->ReferenceIndex))->NameOfCoef); GQ += 1; } Message::Check(" }\n"); } Nbr = List_Nbr(CO_L); if (Nbr > 0) { Message::Check(" Constraint {\n"); CO = (struct ConstraintInFS*)List_Pointer(CO_L, 0); for (i=0; iQuantityType == LOCALQUANTITY) Message::Check("%s;", ((struct BasisFunction *) List_Pointer(BF_L, CO->ReferenceIndex))->NameOfCoef); else if (CO->QuantityType == GLOBALQUANTITY) Message::Check("%s;", ((struct GlobalQuantity *) List_Pointer(GQ_L, CO->ReferenceIndex))->Name); else Message::Check("?;"); Message::Check(" // Entity %s;\n", ((struct Group *)List_Pointer(Problem_S.Group, CO->EntityIndex)) ->Name ); switch(CO->ConstraintPerRegion->Type) { case INIT : Message::Check(" // Type Init;"); case ASSIGN : Message::Check(" // Value Exp[%s];", Get_ExpressionName (CO->ConstraintPerRegion->Case.Fixed.ExpressionIndex)); break; case ASSIGNFROMRESOLUTION : case INITFROMRESOLUTION : Message::Check(" // Resolution %s;", CO->ConstraintPerRegion->Case.Solve.ResolutionName); break; } if (CO->ConstraintPerRegion->TimeFunctionIndex >= 0) Message::Check(" TimeFunction Exp[%s];", Get_ExpressionName(CO->ConstraintPerRegion->TimeFunctionIndex)); Message::Check("\n"); CO += 1; } Message::Check(" }\n"); } Message::Check(" }\n"); } Message::Check("\n"); Message::Check("}\n"); } void Print_Formulation() { struct Formulation *FO; struct DefineQuantity *DQ; struct EquationTerm *FE; struct GlobalEquationTerm *GET; List_T *DQ_L, *FE_L; int i, Nbr, j, Nbrj, k, Nbrk; Nbr = List_Nbr(Problem_S.Formulation); Message::Check("Formulation { /* nbr = %d */\n", Nbr); Message::Check("\n"); for (i = 0; i < Nbr; i++) { Message::Check(" /* Num : %d */\n", i); FO = (struct Formulation*)List_Pointer(Problem_S.Formulation, i); Message::Check(" { Name %s; Type %s;\n", FO->Name, Get_StringForDefine(Formulation_Type, FO->Type)); DQ_L = FO->DefineQuantity; FE_L = FO->Equation; Message::Check(" Quantity {\n"); Nbrj = List_Nbr(DQ_L); for (j=0; jName, Get_StringForDefine(DefineQuantity_Type, DQ->Type), (DQ->FunctionSpaceIndex < 0) ? "?" : ((struct FunctionSpace *) List_Pointer(Problem_S.FunctionSpace, DQ->FunctionSpaceIndex))->Name); if (DQ->IndexInFunctionSpace) { if (DQ->Type == GLOBALQUANTITY) Message::Check("[%s]", ((struct GlobalQuantity *) List_Pointer (((struct FunctionSpace *) List_Pointer(Problem_S.FunctionSpace, DQ->FunctionSpaceIndex)) ->GlobalQuantity, *((int *)List_Pointer(DQ->IndexInFunctionSpace, 0))))->Name); else if (DQ->Type == LOCALQUANTITY) { Message::Check("["); Nbrk = List_Nbr(DQ->IndexInFunctionSpace); for (k=0; kIndexInFunctionSpace, k))); Message::Check("]"); } } Message::Check(";"); if (DQ->Type == INTEGRALQUANTITY) { Message::Check("\n"); Message::Check(" Integration %s;\n", ((struct IntegrationMethod *) List_Pointer(Problem_S.IntegrationMethod, DQ->IntegralQuantity.IntegrationMethodIndex))->Name); Message::Check(" Jacobian %s;", ((struct JacobianMethod *) List_Pointer(Problem_S.JacobianMethod, DQ->IntegralQuantity.JacobianMethodIndex))->Name); } Message::Check(" }\n"); } Message::Check(" }\n"); Message::Check(" Equation {\n"); Nbrj = List_Nbr(FE_L); for (j=0; jType == GALERKIN || FE->Type == DERHAM) { if(FE->Type == GALERKIN) Message::Check(" Galerkin { Density [ ... ];\n"); if(FE->Type == DERHAM) Message::Check(" deRham { Density [ ... ];\n"); Message::Check(" In %s;\n", ((struct Group *) List_Pointer(Problem_S.Group, FE->Case.LocalTerm.InIndex))->Name ); Message::Check(" Jacobian %s; \n", ((struct JacobianMethod *) List_Pointer(Problem_S.JacobianMethod, FE->Case.LocalTerm.JacobianMethodIndex))->Name ); Message::Check(" Integration %s; }\n", ((struct IntegrationMethod *) List_Pointer(Problem_S.IntegrationMethod, FE->Case.LocalTerm.IntegrationMethodIndex))->Name ); Message::Check(" /* Inventaire des DQ (%d) [%d] :", FE->Case.LocalTerm.Term.NbrQuantityIndex, FE->Case.LocalTerm.Term.QuantityIndexPost); for (k = 0; k < FE->Case.LocalTerm.Term.NbrQuantityIndex; k++) Message::Check(" {%s}", ((struct DefineQuantity *) List_Pointer (DQ_L, FE->Case.LocalTerm.Term.QuantityIndexTable[k]))->Name); Message::Check(" */\n"); Message::Check(" /* WholeQuantity (%d) :", List_Nbr(FE->Case.LocalTerm.Term.WholeQuantity)); Print_WholeQuantity(FE->Case.LocalTerm.Term.WholeQuantity, DQ_L); Message::Check(" */\n"); } else if (FE->Type == GLOBALTERM ) { Message::Check(" GlobalTerm { [ ... ];\n"); Message::Check(" In %s;\n", ((struct Group *) List_Pointer(Problem_S.Group, FE->Case.GlobalTerm.InIndex))->Name ); Message::Check(" /* Inventaire des DQ (%d) [%d,%d] :", FE->Case.GlobalTerm.Term.NbrQuantityIndex, FE->Case.GlobalTerm.Term.DefineQuantityIndexDof, FE->Case.GlobalTerm.Term.DefineQuantityIndexEqu); for (k = 0; k < FE->Case.GlobalTerm.Term.NbrQuantityIndex; k++) Message::Check(" {%s}", ((struct DefineQuantity *) List_Pointer (DQ_L, FE->Case.GlobalTerm.Term.QuantityIndexTable[k]))->Name); Message::Check(" */\n"); Message::Check(" /* WholeQuantity (%d) :", List_Nbr(FE->Case.GlobalTerm.Term.WholeQuantity)); Print_WholeQuantity(FE->Case.GlobalTerm.Term.WholeQuantity, DQ_L); Message::Check(" */\n"); } else if (FE->Type == GLOBALEQUATION) { Message::Check(" GlobalEquation { Type %s; UsingConstraint %s;\n", Get_StringForDefine(Constraint_Type, FE->Case.GlobalEquation.Type), ((struct Constraint *) List_Pointer(Problem_S.Constraint, FE->Case.GlobalEquation.ConstraintIndex))->Name); Nbrk = List_Nbr(FE->Case.GlobalEquation.GlobalEquationTerm); for (k = 0; k < Nbrk; k++) { GET = (struct GlobalEquationTerm*) List_Pointer(FE->Case.GlobalEquation.GlobalEquationTerm, k); Message::Check(" { Node {%s}; Loop {%s}; Equation {%s};", ((struct DefineQuantity *) List_Pointer(DQ_L, GET->DefineQuantityIndexNode))->Name, ((struct DefineQuantity *) List_Pointer(DQ_L, GET->DefineQuantityIndexLoop))->Name, ((struct DefineQuantity *) List_Pointer(DQ_L, GET->DefineQuantityIndexEqu))->Name); Message::Check(" In %s; }\n", ((struct Group *) List_Pointer(Problem_S.Group, GET->InIndex))->Name); } } } Message::Check(" }\n"); Message::Check(" }\n"); } Message::Check("\n"); Message::Check("}\n"); } void Print_Operation(struct Resolution *RE, List_T *Operation_L) { struct Operation *OPE; int i, j, Nbrj; static int NbrBlk = -1; NbrBlk++; Nbrj = List_Nbr(Operation_L); for (j=0; jType) { case OPERATION_GENERATE : case OPERATION_GENERATEONLY : case OPERATION_SOLVE : case OPERATION_GENERATEJAC : case OPERATION_SOLVEJAC : case OPERATION_SOLVENL : case OPERATION_GENERATESEPARATE : case OPERATION_INITSOLUTION : case OPERATION_SAVESOLUTION : case OPERATION_SAVESOLUTIONS : case OPERATION_READSOLUTION : case OPERATION_TRANSFERSOLUTION : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" %s [%s];\n", Get_StringForDefine(Operation_Type, OPE->Type), ((struct DefineSystem *) List_Pointer(RE->DefineSystem, OPE->DefineSystemIndex))->Name); break; case OPERATION_UPDATE : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" Update [ %s, Exp[%s] ];\n", ((struct DefineSystem *) List_Pointer(RE->DefineSystem, OPE->DefineSystemIndex))->Name, Get_ExpressionName(OPE->Case.Update.ExpressionIndex)); break; case OPERATION_SELECTCORRECTION : for (i=0 ; i<2*NbrBlk ; i++) Message::Check(" "); Message::Check(" SelectCorrection [ %s, %d ] ;\n", ((struct DefineSystem *) List_Pointer(RE->DefineSystem, OPE->DefineSystemIndex))->Name, OPE->Case.SelectCorrection.Iteration) ; break ; case OPERATION_ADDCORRECTION : for (i=0 ; i<2*NbrBlk ; i++) Message::Check(" "); Message::Check(" AddCorrection [ %s, %g ] ;\n", ((struct DefineSystem *) List_Pointer(RE->DefineSystem, OPE->DefineSystemIndex))->Name, OPE->Case.AddCorrection.Alpha) ; break ; case OPERATION_UPDATECONSTRAINT : for (i=0 ; i<2*NbrBlk ; i++) Message::Check(" "); Message::Check(" UpdateConstraint [ %s ] ;\n", ((struct DefineSystem *) List_Pointer(RE->DefineSystem, OPE->DefineSystemIndex))->Name) ; break ; case OPERATION_FOURIERTRANSFORM : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" FourierTransform [ %s, %s, {...} ];\n", ((struct DefineSystem *) List_Pointer(RE->DefineSystem, OPE->Case.FourierTransform.DefineSystemIndex[0]))->Name, ((struct DefineSystem *) List_Pointer(RE->DefineSystem, OPE->Case.FourierTransform.DefineSystemIndex[1]))->Name); break; case OPERATION_TIMELOOPTHETA : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" TimeLoopTheta [ %.10g, %.10g, Exp[%s], Exp[%s] ] {\n", OPE->Case.TimeLoopTheta.Time0, OPE->Case.TimeLoopTheta.TimeMax, Get_ExpressionName(OPE->Case.TimeLoopTheta.DTimeIndex), Get_ExpressionName(OPE->Case.TimeLoopTheta.ThetaIndex)); Print_Operation(RE, OPE->Case.TimeLoopTheta.Operation); for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" }\n"); break; case OPERATION_TIMELOOPNEWMARK : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" TimeLoopNewmark [ %.10g, %.10g, Exp[%s], %.10g, %.10g ] {\n", OPE->Case.TimeLoopNewmark.Time0, OPE->Case.TimeLoopNewmark.TimeMax, Get_ExpressionName(OPE->Case.TimeLoopNewmark.DTimeIndex), OPE->Case.TimeLoopNewmark.Beta, OPE->Case.TimeLoopNewmark.Gamma); Print_Operation(RE, OPE->Case.TimeLoopNewmark.Operation); for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" }\n"); break; case OPERATION_ITERATIVELOOP : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" IterativeLoop [ %d, %.10g, Exp[%s] ] {\n", OPE->Case.IterativeLoop.NbrMaxIteration, OPE->Case.IterativeLoop.Criterion, Get_ExpressionName(OPE->Case.IterativeLoop.RelaxationFactorIndex)); Print_Operation(RE, OPE->Case.IterativeLoop.Operation); for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" }\n"); break; case OPERATION_LANCZOS : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" Lanczos [ %s, %d, { ... } , %.10g ];\n", ((struct DefineSystem *) List_Pointer(RE->DefineSystem, OPE->DefineSystemIndex))->Name, OPE->Case.Lanczos.Size, OPE->Case.Lanczos.Shift); break; case OPERATION_EIGENSOLVE : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" EigenSolve [ %s, %d, %.10g , %.10g ];\n", ((struct DefineSystem *) List_Pointer(RE->DefineSystem, OPE->DefineSystemIndex))->Name, OPE->Case.EigenSolve.NumEigenvalues, OPE->Case.EigenSolve.Shift_r, OPE->Case.EigenSolve.Shift_i); break; case OPERATION_POSTOPERATION : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" PostOperation [ ... ];\n"); break; case OPERATION_EVALUATE : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" Evaluate [ ... ];\n"); break; case OPERATION_SETTIME : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" SetTime [ Exp[%s] ];\n", Get_ExpressionName(OPE->Case.SetTime.ExpressionIndex)); break; case OPERATION_SETFREQUENCY : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" SetFrequency [ %s, Exp[%s] ];\n", ((struct DefineSystem *) List_Pointer(RE->DefineSystem, OPE->DefineSystemIndex))->Name, Get_ExpressionName(OPE->Case.SetFrequency.ExpressionIndex)); break; case OPERATION_BREAK : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" Break;\n"); break; case OPERATION_SYSTEMCOMMAND : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" SystemCommand \" %s \";\n", OPE->Case.SystemCommand.String); break; case OPERATION_TEST : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" If [ Exp[%s] ] {\n", Get_ExpressionName(OPE->Case.Test.ExpressionIndex)); Print_Operation(RE, OPE->Case.Test.Operation_True); for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" }\n"); for (i=0; i<2*NbrBlk; i++) Message::Check(" "); if(OPE->Case.Test.Operation_False){ Message::Check(" Else {\n"); Print_Operation(RE, OPE->Case.Test.Operation_False); Message::Check(" }\n"); } break; case OPERATION_CHANGEOFCOORDINATES : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" ChangeOfCoordinates [ %s, Exp[%s] ];\n", ((struct Group *) List_Pointer(Problem_S.Group, OPE->Case.ChangeOfCoordinates.GroupIndex))->Name, Get_ExpressionName(OPE->Case.ChangeOfCoordinates.ExpressionIndex)); break; case OPERATION_INIT_MOVINGBAND2D : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" Init_MovingBand2D [ %s ];\n", ((struct Group *) List_Pointer(Problem_S.Group, OPE->Case.Init_MovingBand2D.GroupIndex))->Name); break; case OPERATION_MESH_MOVINGBAND2D : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" Mesh_MovingBand2D [ %s ];\n", ((struct Group *) List_Pointer(Problem_S.Group, OPE->Case.Mesh_MovingBand2D.GroupIndex))->Name); break; case OPERATION_GENERATE_MH_MOVING : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" GenerateMHMoving [ %s, %s, %g, %d ];\n", ((struct DefineSystem *) List_Pointer(RE->DefineSystem, OPE->DefineSystemIndex))->Name, ((struct Group *) List_Pointer(Problem_S.Group, OPE->Case.Generate_MH_Moving.GroupIndex))->Name, OPE->Case.Generate_MH_Moving.Period, OPE->Case.Generate_MH_Moving.NbrStep); break; case OPERATION_GENERATE_MH_MOVING_S : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" GenerateMHMovingSeparate [ %s, %s, %g, %d ];\n", ((struct DefineSystem *) List_Pointer(RE->DefineSystem, OPE->DefineSystemIndex))->Name, ((struct Group *) List_Pointer(Problem_S.Group, OPE->Case.Generate_MH_Moving_S.GroupIndex))->Name, OPE->Case.Generate_MH_Moving_S.Period, OPE->Case.Generate_MH_Moving_S.NbrStep); break; case OPERATION_ADDMHMOVING : for (i=0; i<2*NbrBlk; i++) Message::Check(" "); Message::Check(" AddMHMoving [%s];\n", ((struct DefineSystem *) List_Pointer(RE->DefineSystem, OPE->DefineSystemIndex))->Name); break; case OPERATION_DEFORMEMESH : Message::Check(" DeformeMesh [%s, %s, '%s']; \n", ((struct DefineSystem *) List_Pointer(RE->DefineSystem, OPE->DefineSystemIndex))->Name, OPE->Case.DeformeMesh.Quantity, OPE->Case.DeformeMesh.Name_MshFile); break; case OPERATION_GMSHREAD : Message::Check(" GmshRead [%s]; \n", OPE->Case.GmshRead.FileName); break; case OPERATION_GMSHMERGE : Message::Check(" GmshMerge [%s]; \n", OPE->Case.GmshRead.FileName); break; case OPERATION_GMSHOPEN : Message::Check(" GmshOpen [%s]; \n", OPE->Case.GmshRead.FileName); break; case OPERATION_GMSHWRITE : Message::Check(" GmshWrite [%s]; \n", OPE->Case.GmshRead.FileName); break; case OPERATION_GMSHCLEARALL : Message::Check(" GmshClearAll; \n"); break; case OPERATION_DELETEFILE: Message::Check(" DeleteFile [%s]; \n", OPE->Case.DeleteFile.FileName); break; case OPERATION_RENAMEFILE: Message::Check(" RenameFile [%s, %s]; \n", OPE->Case.RenameFile.OldFileName, OPE->Case.RenameFile.NewFileName); break; case OPERATION_CREATEDIR: Message::Check(" CreateDir [%s]; \n", OPE->Case.CreateDir.DirName); break; default : Message::Check(" ???;\n"); break; } } NbrBlk--; } void Print_Resolution() { struct Resolution *RE; struct DefineSystem *DS; List_T *DS_L; int i, Nbr, j, Nbrj, k; Nbr = List_Nbr(Problem_S.Resolution); Message::Check("Resolution { /* nbr = %d */\n", Nbr); Message::Check("\n"); for (i = 0; i < Nbr; i++) { Message::Check(" /* Num : %d */\n", i); RE = (struct Resolution*)List_Pointer(Problem_S.Resolution, i); Message::Check(" { Name %s\n", RE->Name); DS_L = RE->DefineSystem; Message::Check(" System {\n"); Nbrj = List_Nbr(DS_L); for (j=0; jName, Get_StringForDefine(DefineSystem_Type, DS->Type)); Message::Check("NameOfFormulation {"); for (k = 0; k < List_Nbr(DS->FormulationIndex); k++) Message::Check(" %s", ((struct Formulation *) List_Pointer(Problem_S.Formulation, *((int *)List_Pointer(DS->FormulationIndex, k))))->Name); Message::Check(" }; "); if(DS->MeshName) Message::Check("NameOfMesh %s; ", DS->MeshName); if(DS->OriginSystemIndex) { Message::Check("OriginSystem {") ; for (k = 0 ; k < List_Nbr(DS->OriginSystemIndex) ; k++) { if (k) Message::Check(",") ; Message::Check(" %d", *((int *)List_Pointer(DS->OriginSystemIndex, k))) ; } Message::Check(" } ;") ; } if (DS->Type == VAL_COMPLEX) { Message::Check("Frequency {"); for (k = 0; k < List_Nbr(DS->FrequencyValue); k++) { if (k) Message::Check(","); Message::Check(" %.10g", *((double *)List_Pointer(DS->FrequencyValue, k))); } Message::Check(" };"); } Message::Check(" }\n"); } Message::Check(" }\n"); Message::Check(" Operation {\n"); Print_Operation(RE, RE->Operation); Message::Check(" }\n"); Message::Check(" }\n"); } Message::Check("\n"); Message::Check("}\n"); } void Print_PostProcessing() { struct PostProcessing *PP; struct PostQuantity *PQ; struct PostQuantityTerm *PQT; int i, Nbr, j, Nbrj, k, Nbrk; Nbr = List_Nbr(Problem_S.PostProcessing); Message::Check("PostProcessing { /* nbr = %d */\n", Nbr); Message::Check("\n"); for (i = 0; i < Nbr; i++) { Message::Check(" /* Num : %d */\n", i); PP = (struct PostProcessing*)List_Pointer(Problem_S.PostProcessing, i); Message::Check(" { Name %s; NameOfFormulation %s; \n", PP->Name, ((struct Formulation *) List_Pointer(Problem_S.Formulation, PP->FormulationIndex))->Name); if(PP->NameOfSystem) Message::Check("NameOfSystem %s;", PP->NameOfSystem); Nbrj = List_Nbr(PP->PostQuantity); if (Nbrj > 0) { Message::Check(" Quantity {\n"); for (j = 0; j < Nbrj; j++) { PQ = (struct PostQuantity*)List_Pointer(PP->PostQuantity, j); Message::Check(" { Name %s;\n", PQ->Name); Message::Check(" Value {\n"); Nbrk = List_Nbr(PQ->PostQuantityTerm); for (k = 0; k < Nbrk; k++) { PQT = (struct PostQuantityTerm*)List_Pointer(PQ->PostQuantityTerm, k); Message::Check(" { %s { ['", Get_StringForDefine(PostQuantityTerm_EvaluationType, PQT->EvaluationType)); Print_WholeQuantity (PQT->WholeQuantity, ((struct Formulation *) List_Pointer(Problem_S.Formulation, PP->FormulationIndex)) ->DefineQuantity); Message::Check(" ']; /* DefineQuantityType %s */\n", Get_StringForDefine(DefineQuantity_Type, PQT->Type)); if(PQT->InIndex > 0) Message::Check(" In %s;\n", ((struct Group *)List_Pointer(Problem_S.Group, PQT->InIndex))->Name); if(PQT->IntegrationMethodIndex > 0) Message::Check(" Integration %s;\n", ((struct IntegrationMethod *) List_Pointer(Problem_S.IntegrationMethod, PQT->IntegrationMethodIndex))->Name); if(PQT->JacobianMethodIndex > 0) Message::Check(" Jacobian %s;\n", ((struct JacobianMethod *) List_Pointer(Problem_S.JacobianMethod, PQT->JacobianMethodIndex))->Name); } Message::Check(" } } }\n"); Message::Check(" }\n"); } Message::Check(" }\n"); } Message::Check(" }\n"); } Message::Check("\n}"); Message::Check("\n"); } void Print_PostOperation() { struct PostProcessing *PP; struct PostOperation *PO; struct PostSubOperation *PSO; int i, Nbr, k, Nbrk; Nbr = List_Nbr(Problem_S.PostOperation); Message::Check("PostOperation { /* nbr = %d */\n", Nbr); Message::Check("\n"); for (i = 0; i < Nbr; i++) { PO = (struct PostOperation*)List_Pointer(Problem_S.PostOperation, i); PP = (struct PostProcessing*)List_Pointer(Problem_S.PostProcessing, PO->PostProcessingIndex); Message::Check(" { Name %s; NameOfPostProcessing %s;\n", PO->Name, PP->Name); Message::Check(" Operation {\n"); Nbrk = List_Nbr(PO->PostSubOperation); for (k = 0; k < Nbrk; k++) { PSO = (struct PostSubOperation*)List_Pointer(PO->PostSubOperation, k); switch (PSO->Type) { case POP_PRINT : Message::Check(" Print[%s", ((struct PostQuantity *) List_Pointer(PP->PostQuantity, PSO->PostQuantityIndex[0]))->Name); if(PSO->PostQuantitySupport[0] >= 0) Message::Check(" [%s]", ((struct Group *) List_Pointer(Problem_S.Group, PSO->PostQuantitySupport[0]))->Name); if(PSO->PostQuantityIndex[1] >= 0) { Message::Check(" %s %s", Get_StringForDefine(PostSubOperation_CombinationType, PSO->CombinationType), ((struct PostQuantity *) List_Pointer(PP->PostQuantity, PSO->PostQuantityIndex[1]))->Name); if(PSO->PostQuantitySupport[1] >= 0) Message::Check(" [%s]", ((struct Group *) List_Pointer(Problem_S.Group, PSO->PostQuantitySupport[1]))->Name); } switch (PSO->SubType) { case PRINT_ONREGION : if (PSO->Case.OnRegion.RegionIndex >=0) Message::Check(", OnRegion %s", ((struct Group *) List_Pointer(Problem_S.Group, PSO->Case.OnRegion.RegionIndex))->Name ); else Message::Check(", OnGlobal"); break; case PRINT_ONELEMENTSOF : Message::Check(", OnElementsOf %s", ((struct Group *) List_Pointer(Problem_S.Group, PSO->Case.OnRegion.RegionIndex))->Name ); break; case PRINT_ONGRID : Message::Check(", OnGrid %s", ((struct Group *) List_Pointer(Problem_S.Group, PSO->Case.OnRegion.RegionIndex))->Name ); break; case PRINT_ONGRID_0D : Message::Check(", OnPoint {%.10g,%.10g,%.10g}", PSO->Case.OnGrid.x[0], PSO->Case.OnGrid.y[0], PSO->Case.OnGrid.z[0]); break; case PRINT_ONGRID_1D : Message::Check(", OnLine {{%.10g,%.10g,%.10g}{%.10g,%.10g,%.10g}} {%d}", PSO->Case.OnGrid.x[0], PSO->Case.OnGrid.y[0], PSO->Case.OnGrid.z[0], PSO->Case.OnGrid.x[1], PSO->Case.OnGrid.y[1], PSO->Case.OnGrid.z[1], PSO->Case.OnGrid.n[0]); break; case PRINT_ONGRID_2D : Message::Check(", OnPlane {{%.10g,%.10g,%.10g}{%.10g,%.10g,%.10g}" "{%.10g,%.10g,%.10g}} {%d,%d}", PSO->Case.OnGrid.x[0], PSO->Case.OnGrid.y[0], PSO->Case.OnGrid.z[0], PSO->Case.OnGrid.x[1], PSO->Case.OnGrid.y[1], PSO->Case.OnGrid.z[1], PSO->Case.OnGrid.x[2], PSO->Case.OnGrid.y[2], PSO->Case.OnGrid.z[2], PSO->Case.OnGrid.n[0], PSO->Case.OnGrid.n[1]); break; default : /* parametric grid, ... */ break; } break; default : /* POP_EXPRESSION, POP_GROUP, etc. */ break; } if(PSO->Depth != 1) Message::Check(", Depth %d", PSO->Depth); if(PSO->Skin) Message::Check(", Skin"); if(PSO->NoNewLine) Message::Check(", NoNewLine"); if(PSO->Smoothing) Message::Check(", Smoothing %d", PSO->Smoothing); if(PSO->Dimension != _ALL) Message::Check(", Dimension %d", PSO->Dimension); if(PSO->HarmonicToTime > 1) Message::Check(", HarmonicToTime %d", PSO->HarmonicToTime); if(PSO->FourierTransform == 1) Message::Check(", FourierTransform"); if(PSO->FourierTransform == 2) Message::Check(", CosineTransform"); if(PSO->Sort) Message::Check(", Sort %s", Get_StringForDefine(PostSubOperation_SortType, PSO->Adapt)); if(PSO->Adapt) Message::Check(", Adapt %s", Get_StringForDefine(PostSubOperation_AdaptationType, PSO->Adapt)); if(PSO->Target >= 0) Message::Check(", Target %g", PSO->Target); if(PSO->Iso){ if(PSO->Iso < 0){ Message::Check(", Iso {"); for(i=0; iIso_L); i++){ if(i!=List_Nbr(PSO->Iso_L)-1) Message::Check("%g,", *(double*)List_Pointer(PSO->Iso_L,i)); else Message::Check("%g}", *(double*)List_Pointer(PSO->Iso_L,i)); } } else{ Message::Check(", Iso %d", PSO->Iso); } } /* todo: time steps, frequencies, values, changeofcoord, ... */ Message::Check(", Format %s", Get_StringForDefine(PostSubOperation_Format, PSO->Format)); if(PSO->FileOut){ Message::Check(", File %s\"%s\"", (PSO->CatFile==2)?">> ":(PSO->CatFile==1)?"> ":"", PSO->FileOut); } Message::Check("];\n"); } Message::Check(" }\n "); Message::Check(" }\n"); } Message::Check("\n"); Message::Check("}\n"); } int Print_Object(int ichoice) { switch (ichoice) { case 0 : Print_Constants (); break; case 1 : Print_Group (); break; case 2 : Print_Expression (); break; case 3 : Print_Constraint (); break; case 4 : Print_Jacobian (); break; case 5 : Print_Integration (); break; case 6 : Print_FunctionSpace (); break; case 7 : Print_Formulation (); break; case 8 : Print_Resolution (); break; case 9 : Print_PostProcessing(); break; case 10 : Print_PostOperation (); break; default : return 1; } return 0; } void Print_ProblemStructure() { char buff[128]; int ichoice; while (1) { Message::Info("Checking"); Message::Direct("(1) Constants (2) Groups (3) Functions"); Message::Direct("(4) Constraints (5) Jacobians (6) Integrations"); Message::Direct("(7) FunctionSpaces (8) Formulations (9) Resolution"); Message::Direct("(10) PostProcessings (11) PostOperations (other) Quit"); Message::Check("Choice: "); fgets(buff, 128, stdin); ichoice = atoi(buff); if(Print_Object(ichoice ? ichoice - 1 : -1)){ Message::Check("E n d C h e c k i n g\n"); return; } } } void Print_ListResolution(int choose, int Flag_LRES, char **name) { struct Resolution *RE; int ichoice = 0; char buff[128]; bool print = (!choose || (!Message::UseSocket() && !Message::UseOnelab())); std::vector choices; for (int i = 0; i < List_Nbr(Problem_S.Resolution); i++) { RE = (struct Resolution*)List_Pointer(Problem_S.Resolution, i); if(!RE->Hidden) choices.push_back(RE->Name); } if(choices.size()){ if(Flag_LRES < 0){ ichoice = - Flag_LRES; } else{ if(print) Message::Info("Available Resolutions"); for (unsigned i = 0; i < choices.size(); i++) { if(print) Message::Direct("(%d) %s", i + 1, choices[i].c_str()); if(Message::UseSocket()) Message::SendOptionOnSocket(1, choices[i].c_str()); } if(Message::UseOnelab() && choices.size()){ Constant c; c.Name = (char*)"ResolutionChoices"; c.Type = VAR_CHAR; c.Value.Char = strSave(choices[0].c_str()); std::map > floatOptions; std::map > charOptions; charOptions["Choices"] = choices; charOptions["Name"].push_back(Message::GetOnelabClientName() + "/1ResolutionChoices"); charOptions["Label"].push_back("Resolution"); Message::ExchangeOnelabParameter(&c, floatOptions, charOptions); if(choose){ *name = c.Value.Char; return; } } if(choose){ Message::Check("Choice: "); fgets(buff, 128, stdin); ichoice = atoi(buff); } } if(ichoice > 0 && ichoice < (int)choices.size() + 1){ *name = strSave(choices[ichoice - 1].c_str()); return; } else if(choose) Message::Error("Unknown Resolution"); } else Message::Info("No Resolution available"); } static std::string removeWhiteSpace(const std::string &s) { std::string::size_type beg = s.find_first_not_of(' '); std::string::size_type end = s.find_last_not_of(' '); if(beg == std::string::npos || end == std::string::npos) return ""; return s.substr(beg, end + 1 - beg); } void Print_ListPostOperation(int choose, int Flag_LPOS, char *name[NBR_MAX_POS]) { struct PostOperation *PO; int ichoice = 0; char buff[128]; bool print = (!choose || (!Message::UseSocket() && !Message::UseOnelab())); std::vector choices; for (int i = 0; i < List_Nbr(Problem_S.PostOperation); i++) { PO = (struct PostOperation*)List_Pointer(Problem_S.PostOperation, i); if(!PO->Hidden) choices.push_back(PO->Name); } if(choices.size()){ if(Flag_LPOS < 0){ ichoice = - Flag_LPOS; } else{ if(print) Message::Info("Available PostOperations"); for (unsigned i = 0; i < choices.size(); i++) { if(print) Message::Direct("(%d) %s", i + 1, choices[i].c_str()); if(Message::UseSocket()) Message::SendOptionOnSocket(2, choices[i].c_str()); } if(Message::UseOnelab() && choices.size()){ Constant c; c.Name = (char*)"PostOperationChoices"; c.Type = VAR_CHAR; c.Value.Char = strSave(choices[0].c_str()); std::map > floatOptions; std::map > charOptions; charOptions["Choices"] = choices; charOptions["Name"].push_back(Message::GetOnelabClientName() + "/2PostOperationChoices"); charOptions["Label"].push_back("Post-processing"); charOptions["MultipleSelection"].push_back("1"); Message::ExchangeOnelabParameter(&c, floatOptions, charOptions); if(choose){ std::string str(c.Value.Char); int i = 0; std::string::size_type first = 0; while(1){ std::string::size_type last = str.find_first_of(",", first); std::string next = str.substr(first, last - first); name[i++] = strSave(removeWhiteSpace(next).c_str()); if(last == std::string::npos) break; first = last + 1; if(i == NBR_MAX_POS - 1) break; } name[i] = NULL; return; } } if(choose){ Message::Check("Choice: "); fgets(buff, 128, stdin); ichoice = atoi(buff); } } if(ichoice > 0 && ichoice < (int)choices.size() + 1){ name[0] = strSave(choices[ichoice - 1].c_str()); name[1] = NULL; return; } else if(choose) Message::Error("Unknown PostOperation"); } else Message::Info("No PostOperation available"); } getdp-2.7.0-source/Interface/MacroManager.h000644 001750 001750 00000001500 12531661501 022202 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular, C. Geuzaine // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _MACRO_MANAGER_H_ #define _MACRO_MANAGER_H_ class mystack; class mymap; #include // Singleton, one macro manager for all parsers. class MacroManager { mymap *macros; mystack *calls; MacroManager (); static MacroManager *instance; public : static MacroManager* Instance(); void clear(); int createMacro(const std::string &name, FILE *f, const std::string &filename, long int lineno); int enterMacro(const std::string &name, FILE **f, std::string &filename, long int &lineno) const; int leaveMacro(FILE **f, std::string &filename, long int &lineno); }; #endif getdp-2.7.0-source/Main/Main.cpp000644 001750 001750 00000001561 12473553042 020065 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include "MainLegacy.h" #include "Message.h" #include "GetDP.h" int main(int argc, char **argv) { #if 1 Message::SetExitOnError(true); MainLegacy(argc, argv); #endif #if 0 // debug memory leaks for(int i = 0; i < 100; i++){ printf("solving problem %d\n", i); MainLegacy(argc, argv); } #endif #if 0 // test simple standalone interface std::vector args; args.push_back("getdp"); args.push_back("benchmarks/machines/pmsm.pro"); args.push_back("-solve"); args.push_back("TimeDomain"); args.push_back("-pos"); args.push_back("Get_LocalFields"); for(int i = 1; i < 10; i++) GetDP(args); #endif } getdp-2.7.0-source/README.txt000644 001750 001750 00000005753 12473553043 017317 0ustar00geuzainegeuzaine000000 000000 This is GetDP, a General environment for the treatment of Discrete Problems. GetDP is copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege, and is distributed under the terms of the GNU General Public License, Version 2 or later. See doc/LICENSE.txt and doc/CREDITS.txt for more information. See the doc/ and demos/ directories for documentation. The reference manual is located in doc/texinfo/. See the web site http://geuz.org/getdp for additional examples. Building a bare-bones version of GetDP from its source code requires a C++ compiler and CMake (http://cmake.org). By default GetDP also uses the GSL (http://www.gnu.org/software/gsl) and PETSc (http://www.mcs.anl.gov/petsc), using either real or complex arithmetic. If PETSc is available, GetDP can use SLEPc (http://www.grycap.upv.es/slepc) to solve eigenvalue problems. Instead of PETsc (and SLEPc), GetDP can also use a built-in set of linear solvers derived from Sparskit Version 2 (http://www-users.cs.umn.edu/~saad/) and eigensolvers from Arpack (http://www.caam.rice.edu/software/ARPACK). Sparskit and Arpack, as well GetDP's special mathematical functions require a Fortan compiler and BLAS/LAPACK. Build GetDP using CMake's graphical user interface ------------------------------------------------- * Launch CMake and fill-in the two top input fields (telling where the GetDP source directory is located and where you want the GetDP binary to be created). * Click on "Add entry" and define the variable CMAKE_PREFIX_PATH, of type "PATH", pointing to the location(s) of any external package(s) (BLAS/LAPACK, etc.) installed in non-standard directories. * Click on "Configure" and choose your compiler. * Optionally change some configuration options (re-run "Configure" every time you change some options). * Once you are happy with all the configuration options, click on "Generate". * Go to the build directory and build Gmsh using your chosen compiler. Build GetDP from the command line -------------------------------- * Create a build directory, for example as a subdirectory of GetDP's source directory: mkdir build * Run cmake from within the build directory, pointing to GetDP's source directory: cd build cmake .. * To build and install GetDP then simply type make make install * To change build options you can use "ccmake" instead of "cmake", e.g.: ccmake .. or you can specify options directly on the command line. For example, you can use cmake -DCMAKE_PREFIX_PATH=/opt/local .. to specify the location of external packages installed in non-standard directories. You can use cmake -DCMAKE_INSTALL_PREFIX=/opt to change the installation directory. Or you can use cmake -DENABLE_PETSC=0 -DENABLE_SPARSKIT=1 .. to build a version of GetDP that uses Sparskit instead of PETSc. * You can keep multiple builds with different build options at the same time: just configure the builds in separate directories. * To see a detailed compilation log use make VERBOSE=1 getdp-2.7.0-source/Common/ListUtils.h000644 001750 001750 00000005605 12614106256 021147 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _LIST_UTILS_H_ #define _LIST_UTILS_H_ #include #define LIST_FORMAT_ASCII 0 #define LIST_FORMAT_BINARY 1 class List_T { public: int nmax; int size; int incr; int n; int isorder; char *array; }; List_T *List_Create(int n, int incr, int size); void List_Delete(List_T *liste); void List_Realloc(List_T *liste,int n); void List_Add(List_T *liste, void *data); int List_Nbr(List_T *liste); void List_Insert(List_T *liste, void *data, int (*fcmp)(const void *a, const void *b)); int List_Replace(List_T *liste, void *data, int (*fcmp)(const void *a, const void *b)); void List_Read(List_T *liste, int index, void *data); void List_Write(List_T *liste, int index, void *data); void List_Put(List_T *liste, int index, void *data); void List_Pop(List_T *liste); void *List_Pointer(List_T *liste, int index); void *List_Pointer_NoChange(List_T *liste, int index); void *List_Pointer_Fast(List_T *liste, int index); void *List_Pointer_Test(List_T *liste, int index); void List_Sort(List_T *liste, int (*fcmp)(const void *a, const void *b)); int List_Search(List_T *liste, void *data, int (*fcmp)(const void *a, const void *b)); int List_ISearch(List_T *liste, void *data, int (*fcmp)(const void *a, const void *b)); int List_ISearchSeq(List_T *liste, void * data, int (*fcmp)(const void *a, const void *b)); int List_ISearchSeqPartial(List_T *liste, void * data, int i_Start, int (*fcmp)(const void *a, const void *b)); int List_LQuery(List_T *liste, void *data, int (*fcmp)(const void *a, const void *b), int first); int List_Query(List_T *liste, void *data, int (*fcmp)(const void *a, const void *b)); void *List_PQuery(List_T *liste, void *data, int (*fcmp)(const void *a, const void *b)); int List_Suppress(List_T *liste, void *data, int (*fcmp)(const void *a, const void *b)); int List_PSuppress(List_T *liste, int index); void List_Invert(List_T *a, List_T *b); void List_Reset(List_T *liste); void List_Action(List_T *liste, void (*action)(void *data, void *dummy)); void List_Copy(List_T *a , List_T *b); List_T *List_Copy(List_T *src); void List_Merge(List_T *a , List_T *b); List_T *List_CreateFromFile(int n, int incr, int size, FILE *file, int format, int swap); void List_WriteToFile(List_T *liste, FILE *file, int format); // for backward compatibility List_T *List_CreateFromFileOld(int n, int incr, int size, FILE *file, int format, int swap); int fcmp_int(const void *a, const void *b); int fcmp_absint(const void *a, const void *b); int fcmp_double(const void *a, const void *b); List_T *ListOfDouble2ListOfInt(List_T *dList); #endif getdp-2.7.0-source/Common/TreeUtils.h000644 001750 001750 00000001736 12473553042 021136 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _TREE_UTILS_H_ #define _TREE_UTILS_H_ #include "avl.h" #include "ListUtils.h" typedef struct { int size; avl_tree *root; } Tree_T; Tree_T *Tree_Create(int size, int (*fcmp)(const void *a, const void *b)); void Tree_Delete(Tree_T *Tree); void *Tree_Add(Tree_T *tree, void *data); int Tree_Nbr(Tree_T *Tree); int Tree_Insert(Tree_T *Tree, void *data); int Tree_Replace(Tree_T *Tree, void *data); int Tree_Search(Tree_T *Tree, void *data); int Tree_Query(Tree_T *Tree, void *data); void *Tree_PQuery(Tree_T *Tree, void *data); int Tree_Suppress(Tree_T *Tree, void *data); int Tree_Size(Tree_T *tree); void Tree_Action(Tree_T *tree, void (*action) (void *data, void *dummy)); List_T *Tree2List(Tree_T *pTree); #endif getdp-2.7.0-source/Common/avl.cpp000644 001750 001750 00000030751 12473553042 020332 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // $Id: avl.cpp,v 1.2 2009-09-26 06:44:38 geuzaine Exp $ /* * avl package * * Copyright (c) 1988-1993, The Regents of the University of California. * * Permission to use, copy, modify, and distribute this software and its * documentation for any purpose and without fee is hereby granted, provided * that the above copyright notice appear in all copies and that both that * copyright notice and this permission notice appear in supporting * documentation, and that the name of the University of California not * be used in advertising or publicity pertaining to distribution of * the software without specific, written prior permission. The University * of California makes no representations about the suitability of this * software for any purpose. It is provided "as is" without express or * implied warranty. * * THE UNIVERSITY OF CALIFORNIA DISCLAIMS ALL WARRANTIES WITH REGARD TO * THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND * FITNESS, IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE FOR * ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER * RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF * CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN * CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ // Modified for Gmsh (C++, 64 bits, ...) #include "GetDPConfig.h" #if !defined(HAVE_NO_STDINT_H) #include #elif defined(HAVE_NO_INTPTR_T) typedef unsigned long intptr_t; #endif #include #include "avl.h" #include "MallocUtils.h" #define ALLOC(type, number) (type *) Malloc((unsigned) sizeof(type) * number) #define FREE(item) (void) Free(item) #define XRNMAX(a,b) ((a) > (b) ? (a) : (b)) #define HEIGHT(node) (node == NIL(avl_node) ? -1 : (node)->height) #define BALANCE(node) (HEIGHT((node)->right) - HEIGHT((node)->left)) #define compute_height(node) { \ int x=HEIGHT(node->left), y=HEIGHT(node->right); \ (node)->height = XRNMAX(x,y) + 1; \ } #define COMPARE(key, nodekey, compare) \ ((compare == avl_numcmp) ? \ (intptr_t) key - (intptr_t) nodekey : \ (*compare)(key, nodekey)) static void avl_record_gen_forward(avl_node *node, avl_generator *gen); static void avl_record_gen_backward(avl_node *node, avl_generator *gen); static avl_node *find_rightmost(avl_node **node_p); static void do_rebalance(avl_node ***stack_nodep, int stack_n); static void rotate_left(avl_node **node_p); static void rotate_right(avl_node **node_p); static void free_entry(avl_node *node, void (*key_free)(void *key), void (*value_free)(void *value)); static avl_node *new_node(void *key, void *value); static int do_check_tree(avl_node *node, int (*compar)(const void *key1, const void *key2), int *error); avl_tree *avl_init_table(int (*compar)(const void *key1, const void *key2)) { avl_tree *tree; tree = ALLOC(avl_tree, 1); tree->root = NIL(avl_node); tree->compar = compar; tree->num_entries = 0; return tree; } int avl_lookup(avl_tree *tree, void *key, void **value_p) { register avl_node *node; register int (*compare)(const void*, const void *) = tree->compar, diff; node = tree->root; while (node != NIL(avl_node)) { diff = COMPARE(key, node->key, compare); if (diff == 0) { /* got a match, give the user a 'value' only if non-null */ if (value_p != NIL(void *)) *value_p = node->value; return 1; } node = (diff < 0) ? node->left : node->right; } return 0; } int avl_insert(avl_tree *tree, void *key, void *value) { register avl_node **node_p, *node; register int stack_n = 0; register int (*compare)(const void*, const void *) = tree->compar; avl_node **stack_nodep[32]; int diff, status; node_p = &tree->root; /* walk down the tree (saving the path); stop at insertion point */ status = 0; while ((node = *node_p) != NIL(avl_node)) { stack_nodep[stack_n++] = node_p; diff = COMPARE(key, node->key, compare); if (diff == 0) status = 1; node_p = (diff < 0) ? &node->left : &node->right; } /* insert the item and re-balance the tree */ *node_p = new_node(key, value); do_rebalance(stack_nodep, stack_n); tree->num_entries++; tree->modified = 1; return status; } int avl_delete(avl_tree *tree, void **key_p, void **value_p) { register avl_node **node_p, *node, *rightmost; register int stack_n = 0; void *key = *key_p; int (*compare)(const void*, const void*) = tree->compar, diff; avl_node **stack_nodep[32]; node_p = &tree->root; /* Walk down the tree saving the path; return if not found */ while ((node = *node_p) != NIL(avl_node)) { diff = COMPARE(key, node->key, compare); if (diff == 0) goto delete_item; stack_nodep[stack_n++] = node_p; node_p = (diff < 0) ? &node->left : &node->right; } return 0; /* not found */ /* prepare to delete node and replace it with rightmost of left tree */ delete_item: *key_p = node->key; if (value_p != 0) *value_p = node->value; if (node->left == NIL(avl_node)) { *node_p = node->right; } else { rightmost = find_rightmost(&node->left); rightmost->left = node->left; rightmost->right = node->right; rightmost->height = -2; /* mark bogus height for do_rebal */ *node_p = rightmost; stack_nodep[stack_n++] = node_p; } FREE(node); /* work our way back up, re-balancing the tree */ do_rebalance(stack_nodep, stack_n); tree->num_entries--; tree->modified = 1; return 1; } static void avl_record_gen_forward(avl_node *node, avl_generator *gen) { if (node != NIL(avl_node)) { avl_record_gen_forward(node->left, gen); gen->nodelist[gen->count++] = node; avl_record_gen_forward(node->right, gen); } } static void avl_record_gen_backward(avl_node *node, avl_generator *gen) { if (node != NIL(avl_node)) { avl_record_gen_backward(node->right, gen); gen->nodelist[gen->count++] = node; avl_record_gen_backward(node->left, gen); } } avl_generator *avl_init_gen(avl_tree *tree, int dir) { avl_generator *gen; /* what a hack */ gen = ALLOC(avl_generator, 1); gen->tree = tree; gen->nodelist = ALLOC(avl_node *, avl_count(tree)); gen->count = 0; if (dir == AVL_FORWARD) { avl_record_gen_forward(tree->root, gen); } else { avl_record_gen_backward(tree->root, gen); } gen->count = 0; /* catch any attempt to modify the tree while we generate */ tree->modified = 0; return gen; } int avl_gen(avl_generator *gen, void **key_p, void **value_p) { avl_node *node; if (gen->count == gen->tree->num_entries) { return 0; } else { node = gen->nodelist[gen->count++]; if (key_p != NIL(void *)) *key_p = node->key; if (value_p != NIL(void *)) *value_p = node->value; return 1; } } void avl_free_gen(avl_generator *gen) { FREE(gen->nodelist); FREE(gen); } static avl_node *find_rightmost(avl_node **node_p) { register avl_node *node; register int stack_n = 0; avl_node **stack_nodep[32]; node = *node_p; while (node->right != NIL(avl_node)) { stack_nodep[stack_n++] = node_p; node_p = &node->right; node = *node_p; } *node_p = node->left; do_rebalance(stack_nodep, stack_n); return node; } static void do_rebalance(avl_node ***stack_nodep, int stack_n) { register avl_node **node_p, *node; register int hl, hr; int height; /* work our way back up, re-balancing the tree */ while (--stack_n >= 0) { node_p = stack_nodep[stack_n]; node = *node_p; hl = HEIGHT(node->left); /* watch for NIL */ hr = HEIGHT(node->right); /* watch for NIL */ if ((hr - hl) < -1) { rotate_right(node_p); } else if ((hr - hl) > 1) { rotate_left(node_p); } else { height = XRNMAX(hl, hr) + 1; if (height == node->height) break; node->height = height; } } } static void rotate_left(avl_node **node_p) { register avl_node *old_root = *node_p, *new_root, *new_right; if (BALANCE(old_root->right) >= 0) { *node_p = new_root = old_root->right; old_root->right = new_root->left; new_root->left = old_root; } else { new_right = old_root->right; *node_p = new_root = new_right->left; old_root->right = new_root->left; new_right->left = new_root->right; new_root->right = new_right; new_root->left = old_root; compute_height(new_right); } compute_height(old_root); compute_height(new_root); } static void rotate_right(avl_node **node_p) { register avl_node *old_root = *node_p, *new_root, *new_left; if (BALANCE(old_root->left) <= 0) { *node_p = new_root = old_root->left; old_root->left = new_root->right; new_root->right = old_root; } else { new_left = old_root->left; *node_p = new_root = new_left->right; old_root->left = new_root->right; new_left->right = new_root->left; new_root->left = new_left; new_root->right = old_root; compute_height(new_left); } compute_height(old_root); compute_height(new_root); } int avl_extremum(avl_tree *tree, int side, void **value_p) { register avl_node *node; node = tree->root; if (node == NIL(avl_node)) return 0; if (side == AVL_MOST_LEFT) while (node->left != NIL(avl_node)) node = node->left; else while (node->right != NIL(avl_node)) node = node->right; if (value_p != NIL(void *)) { *value_p = node->value; return 1; } return 0; } static void free_entry(avl_node *node, void (*key_free)(void *key), void (*value_free)(void *value)) { if (node != NIL(avl_node)) { free_entry(node->left, key_free, value_free); free_entry(node->right, key_free, value_free); if (key_free != 0) (*key_free)(node->key); if (value_free != 0) (*value_free)(node->value); FREE(node); } } void avl_free_table(avl_tree *tree, void (*key_free)(void *key), void (*value_free)(void *value)) { free_entry(tree->root, key_free, value_free); FREE(tree); } int avl_count(avl_tree *tree) { return tree->num_entries; } static avl_node *new_node(void *key, void *value) { register avl_node *newn; newn = ALLOC(avl_node, 1); newn->key = key; newn->value = value; newn->height = 0; newn->left = newn->right = NIL(avl_node); return newn; } int avl_numcmp(const void *x, const void*y) { return (intptr_t) x - (intptr_t) y; } int avl_check_tree(avl_tree *tree) { int error = 0; (void) do_check_tree(tree->root, tree->compar, &error); return error; } static int do_check_tree(avl_node *node, int (*compar)(const void *key1, const void *key2), int *error) { int l_height, r_height, comp_height, bal; if (node == NIL(avl_node)) { return -1; } r_height = do_check_tree(node->right, compar, error); l_height = do_check_tree(node->left, compar, error); comp_height = XRNMAX(l_height, r_height) + 1; bal = r_height - l_height; if (comp_height != node->height) { (void) printf("Bad height for %p: computed=%d stored=%d\n", (void*)node, comp_height, node->height); ++*error; } if (bal > 1 || bal < -1) { (void) printf("Out of balance at node %p, balance = %d\n", (void*)node, bal); ++*error; } if (node->left != NIL(avl_node) && (*compar)(node->left->key, node->key) > 0) { (void) printf("Bad ordering between %p and %p", (void*)node, (void*)node->left); ++*error; } if (node->right != NIL(avl_node) && (*compar)(node->key, node->right->key) > 0) { (void) printf("Bad ordering between %p and %p", (void*)node, (void*)node->right); ++*error; } return comp_height; } getdp-2.7.0-source/Common/avl.h000644 001750 001750 00000007442 12473553042 020000 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _AVL_H_ #define _AVL_H_ /* * avl package * * Copyright (c) 1988-1993, The Regents of the University of California. * * Permission to use, copy, modify, and distribute this software and its * documentation for any purpose and without fee is hereby granted, provided * that the above copyright notice appear in all copies and that both that * copyright notice and this permission notice appear in supporting * documentation, and that the name of the University of California not * be used in advertising or publicity pertaining to distribution of * the software without specific, written prior permission. The University * of California makes no representations about the suitability of this * software for any purpose. It is provided "as is" without express or * implied warranty. * * THE UNIVERSITY OF CALIFORNIA DISCLAIMS ALL WARRANTIES WITH REGARD TO * THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND * FITNESS, IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE FOR * ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER * RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF * CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN * CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ // Modified for Gmsh (C++, 64 bits, ...) typedef struct avl_node_struct avl_node; struct avl_node_struct { avl_node *left, *right; void *key; void *value; int height; }; typedef struct avl_tree_struct avl_tree; struct avl_tree_struct { avl_node *root; int (*compar)(const void *key1, const void *key2); int num_entries; int modified; }; typedef struct avl_generator_struct avl_generator; struct avl_generator_struct { avl_tree *tree; avl_node **nodelist; int count; }; #define AVL_FORWARD 0 #define AVL_BACKWARD 1 #define AVL_MOST_LEFT 0 #define AVL_MOST_RIGHT 1 #define avl_is_member(tree, key) avl_lookup(tree, key, (void **) 0) #define NIL(type) (type *) 0 #define avl_foreach_item(table, gen, dir, key_p, value_p) \ for(gen = avl_init_gen(table, dir); \ avl_gen(gen, key_p, value_p) || (avl_free_gen(gen),0);) inline void avl_walk_forward(avl_node *node, void (*func)(void *key, void *value)) { if (node != NIL(avl_node)) { avl_walk_forward(node->left, func); (*func)(node->key, node->value); avl_walk_forward(node->right, func); } } inline void avl_walk_backward(avl_node *node, void (*func)(void *key, void *value)) { if (node != NIL(avl_node)) { avl_walk_backward(node->right, func); (*func)(node->key, node->value); avl_walk_backward(node->left, func); } } inline void avl_foreach(avl_tree *tree, void (*func)(void *key, void *value), int direction) { if (direction == AVL_FORWARD) { avl_walk_forward(tree->root, func); } else { avl_walk_backward(tree->root, func); } } avl_tree *avl_init_table(int (*compar)(const void *key1, const void *key2)); int avl_lookup(avl_tree *tree, void *key, void **value_p); int avl_insert(avl_tree *tree, void *key, void *value); int avl_delete(avl_tree *tree, void **key_p, void **value_p); void avl_free_table(avl_tree *tree, void (*key_free)(void *key), void (*value_free)(void *value)); int avl_count(avl_tree *tree); int avl_check_tree(avl_tree *tree); int avl_extremum(avl_tree *tree, int side, void **value_p); avl_generator *avl_init_gen(avl_tree *tree, int dir); int avl_gen(avl_generator *gen, void **key_p, void **value_p); void avl_free_gen(avl_generator *gen); int avl_numcmp(const void *x, const void*y); #endif getdp-2.7.0-source/Common/TreeUtils.cpp000644 001750 001750 00000004742 12473553042 021471 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to . // // Contributor(s): // Marc Ume // #include #include #include "GetDPConfig.h" #include "MallocUtils.h" #include "TreeUtils.h" #if !defined(HAVE_GMSH) Tree_T *Tree_Create(int size, int (*fcmp) (const void *a, const void *b)) { Tree_T *tree = (Tree_T*)Malloc(sizeof(Tree_T)); tree->size = size; tree->root = avl_init_table(fcmp); return tree; } void Tree_Delete(Tree_T * tree) { if(!tree) return; avl_free_table(tree->root, Free, 0); Free(tree); } void *Tree_Add(Tree_T * tree, void *data) { if(!tree) return 0; void *ptr = Malloc(tree->size); memcpy(ptr, data, tree->size); avl_insert(tree->root, ptr, ptr); return ptr; } int Tree_Nbr(Tree_T * tree) { if(!tree) return 0; return avl_count(tree->root); } int Tree_Insert(Tree_T * tree, void *data) { if(!Tree_Search(tree, data)){ Tree_Add(tree, data); return 1; } return 0; } int Tree_Search(Tree_T * tree, void *data) { if(!tree) return 0; void *ptr; return avl_lookup(tree->root, data, &ptr); } int Tree_Query(Tree_T * tree, void *data) { if(!tree) return 0; void *ptr; if(!avl_lookup(tree->root, data, &ptr)) return 0; memcpy(data, ptr, tree->size); return 1; } void *Tree_PQuery(Tree_T * tree, void *data) { if(!tree) return 0; void *ptr; if(!avl_lookup(tree->root, data, &ptr)) return 0; return ptr; } int Tree_Suppress(Tree_T * tree, void *data) { if(!tree) return 0; void *ptr = data; if(!avl_delete(tree->root, &ptr, &ptr)) return 0; Free(ptr); return 1; } int Tree_Size(Tree_T * tree) { if(!tree) return 0; return tree->size; } void Tree_Action(Tree_T *tree, void (*action) (void *data, void *dummy)) { if(!tree) return; avl_foreach(tree->root, action, AVL_FORWARD); } static List_T *pListTransfer; void TransferList(void *a, void *b) { List_Add(pListTransfer, a); } List_T *Tree2List(Tree_T * pTree) { int Nb; Nb = Tree_Nbr(pTree); if(Nb == 0) Nb = 1; pListTransfer = List_Create(Nb, Nb, Tree_Size(pTree)); Tree_Action(pTree, TransferList); return pListTransfer; } #endif int Tree_Replace(Tree_T *tree, void *data) { void *ptr; int state; state = avl_lookup(tree->root, data, &ptr); if (state == 0) { Tree_Add(tree,data); return 0; } else { memcpy(ptr, data, tree->size); return 1; } } getdp-2.7.0-source/Common/GmshSocket.h000644 001750 001750 00000033536 12472330274 021267 0ustar00geuzainegeuzaine000000 000000 // Gmsh - Copyright (C) 1997-2014 C. Geuzaine, J.-F. Remacle // // Permission is hereby granted, free of charge, to any person // obtaining a copy of this software and associated documentation // files (the "Software"), to deal in the Software without // restriction, including without limitation the rights to use, copy, // modify, merge, publish, distribute, and/or sell copies of the // Software, and to permit persons to whom the Software is furnished // to do so, provided that the above copyright notice(s) and this // permission notice appear in all copies of the Software and that // both the above copyright notice(s) and this permission notice // appear in supporting documentation. // // THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, // EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF // MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND // NONINFRINGEMENT OF THIRD PARTY RIGHTS. IN NO EVENT SHALL THE // COPYRIGHT HOLDER OR HOLDERS INCLUDED IN THIS NOTICE BE LIABLE FOR // ANY CLAIM, OR ANY SPECIAL INDIRECT OR CONSEQUENTIAL DAMAGES, OR ANY // DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, // WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS // ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE // OF THIS SOFTWARE. // // Please report all bugs and problems to the public mailing list // . #ifndef _GMSH_SOCKET_H_ #define _GMSH_SOCKET_H_ #include "GetDPConfig.h" #include #include #include #include #if defined(_AIX) #include #endif #if !defined(WIN32) || defined(__CYGWIN__) #include #include #include #include #include #include #include #include #if defined(HAVE_NO_SOCKLEN_T) typedef int socklen_t; #endif #else #include #include typedef int socklen_t; #endif class GmshSocket{ public: // types of messages that can be exchanged (never use values greater // that 65535: if we receive a type > 65535 we assume that we // receive data from a machine with a different byte ordering, and // we swap the bytes in the payload) enum MessageType{ GMSH_START = 1, GMSH_STOP = 2, GMSH_INFO = 10, GMSH_WARNING = 11, GMSH_ERROR = 12, GMSH_PROGRESS = 13, GMSH_MERGE_FILE = 20, GMSH_PARSE_STRING = 21, GMSH_VERTEX_ARRAY = 22, GMSH_PARAMETER = 23, GMSH_PARAMETER_QUERY = 24, GMSH_PARAMETER_QUERY_ALL = 25, GMSH_PARAMETER_QUERY_END = 26, GMSH_CONNECT = 27, GMSH_OLPARSE = 28, GMSH_PARAMETER_NOT_FOUND = 29, GMSH_SPEED_TEST = 30, GMSH_PARAMETER_CLEAR = 31, GMSH_PARAMETER_UPDATE = 32, GMSH_OPEN_PROJECT = 33, GMSH_CLIENT_CHANGED = 34, GMSH_OPTION_1 = 100, GMSH_OPTION_2 = 101, GMSH_OPTION_3 = 102, GMSH_OPTION_4 = 103, GMSH_OPTION_5 = 104}; protected: // the socket descriptor int _sock; // the socket name std::string _sockname; // send some data over the socket int _SendData(const void *buffer, int bytes) { const char *buf = (const char *)buffer; int sofar = 0; int remaining = bytes; do { int len = send(_sock, buf + sofar, remaining, 0); if(len < 0) return -1; // error sofar += len; remaining -= len; } while(remaining > 0); return bytes; } // receive some data over the socket int _ReceiveData(void *buffer, int bytes) { char *buf = (char *)buffer; int sofar = 0; int remaining = bytes; do { int len = recv(_sock, buf + sofar, remaining, 0); if(len == 0) break; // we're done! if(len < 0) return -1; // error sofar += len; remaining -= len; } while(remaining > 0); return bytes; } // utility function to swap bytes in an array void _SwapBytes(char *array, int size, int n) { char *x = new char[size]; for(int i = 0; i < n; i++) { char *a = &array[i * size]; memcpy(x, a, size); for(int c = 0; c < size; c++) a[size - 1 - c] = x[c]; } delete [] x; } // sleep for some milliseconds void _Sleep(int ms) { #if !defined(WIN32) || defined(__CYGWIN__) usleep(1000 * ms); #else Sleep(ms); #endif } public: GmshSocket() : _sock(0) { #if defined(WIN32) && !defined(__CYGWIN__) WSADATA wsaData; WSAStartup(MAKEWORD(2, 2), &wsaData); #endif } ~GmshSocket() { #if defined(WIN32) && !defined(__CYGWIN__) WSACleanup(); #endif } // Wait for some data to read on the socket (if seconds and microseconds == 0 // we check for available data and return immediately, i.e., we do // polling). Returns 1 when data is available, 0 when nothing happened before // the time delay, -1 on error. int Select(int seconds, int microseconds, int socket=-1) { int s = (socket < 0) ? _sock : socket; struct timeval tv; tv.tv_sec = seconds; tv.tv_usec = microseconds; fd_set rfds; FD_ZERO(&rfds); FD_SET(s, &rfds); // select checks all IO descriptors between 0 and its first arg, minus 1; // hence the +1 below return select(s + 1, &rfds, NULL, NULL, &tv); } void SendMessage(int type, int length, const void *msg) { // send header (type + length) _SendData(&type, sizeof(int)); _SendData(&length, sizeof(int)); // send body _SendData(msg, length); } void SendString(int type, const char *str) { SendMessage(type, strlen(str), str); } void Info(const char *str){ SendString(GMSH_INFO, str); } void Warning(const char *str){ SendString(GMSH_WARNING, str); } void Error(const char *str){ SendString(GMSH_ERROR, str); } void Progress(const char *str){ SendString(GMSH_PROGRESS, str); } void MergeFile(const char *str){ SendString(GMSH_MERGE_FILE, str); } void OpenProject(const char *str){ SendString(GMSH_OPEN_PROJECT, str); } void ParseString(const char *str){ SendString(GMSH_PARSE_STRING, str); } void SpeedTest(const char *str){ SendString(GMSH_SPEED_TEST, str); } void Option(int num, const char *str) { if(num < 1) num = 1; if(num > 5) num = 5; SendString(GMSH_OPTION_1 + num - 1, str); } int ReceiveHeader(int *type, int *len, int *swap) { *swap = 0; if(_ReceiveData(type, sizeof(int)) > 0){ if(*type > 65535){ // the data comes from a machine with different endianness and // we must swap the bytes *swap = 1; _SwapBytes((char*)type, sizeof(int), 1); } if(_ReceiveData(len, sizeof(int)) > 0){ if(*swap) _SwapBytes((char*)len, sizeof(int), 1); return 1; } } return 0; } int ReceiveMessage(int len, void *buffer) { if(_ReceiveData(buffer, len) == len) return 1; return 0; } // str should be allocated with size (len+1) int ReceiveString(int len, char *str) { if(_ReceiveData(str, len) == len) { str[len] = '\0'; return 1; } return 0; } void CloseSocket(int s) { #if !defined(WIN32) || defined(__CYGWIN__) close(s); #else closesocket(s); #endif } void ShutdownSocket(int s) { #if !defined(WIN32) || defined(__CYGWIN__) shutdown(s, SHUT_RDWR); #endif } }; class GmshClient : public GmshSocket { public: GmshClient() : GmshSocket() {} ~GmshClient(){} int Connect(const char *sockname) { if(strstr(sockname, "/") || strstr(sockname, "\\") || !strstr(sockname, ":")){ #if !defined(WIN32) || defined(__CYGWIN__) // UNIX socket (testing ":" is not enough with Windows paths) _sock = socket(PF_UNIX, SOCK_STREAM, 0); if(_sock < 0) return -1; // try to connect socket to given name struct sockaddr_un addr_un; memset((char *) &addr_un, 0, sizeof(addr_un)); addr_un.sun_family = AF_UNIX; strcpy(addr_un.sun_path, sockname); for(int tries = 0; tries < 5; tries++) { if(connect(_sock, (struct sockaddr *)&addr_un, sizeof(addr_un)) >= 0) return _sock; _Sleep(100); } #else return -1; // Unix sockets are not available on Windows #endif } else{ // TCP/IP socket _sock = socket(AF_INET, SOCK_STREAM, 0); if(_sock < 0) return -1; // try to connect socket to host:port const char *port = strstr(sockname, ":"); int portno = atoi(port + 1); int remotelen = strlen(sockname) - strlen(port); char remote[256]; if(remotelen > 0) strncpy(remote, sockname, remotelen); remote[remotelen] = '\0'; struct hostent *server; if(!(server = gethostbyname(remote))){ CloseSocket(_sock); return -3; // no such host } struct sockaddr_in addr_in; memset((char *) &addr_in, 0, sizeof(addr_in)); addr_in.sin_family = AF_INET; memcpy((char *)&addr_in.sin_addr.s_addr, (char *)server->h_addr, server->h_length); addr_in.sin_port = htons(portno); for(int tries = 0; tries < 5; tries++) { if(connect(_sock, (struct sockaddr *)&addr_in, sizeof(addr_in)) >= 0){ return _sock; } _Sleep(100); } } CloseSocket(_sock); return -2; // couldn't connect } void Start() { char tmp[256]; #if !defined(WIN32) || defined(__CYGWIN__) sprintf(tmp, "%d", getpid()); #else sprintf(tmp, "%d", _getpid()); #endif SendString(GMSH_START, tmp); } void Stop(){ SendString(GMSH_STOP, "Goodbye!"); } void Disconnect(){ CloseSocket(_sock); } }; class GmshServer : public GmshSocket{ private: int _portno; public: GmshServer() : GmshSocket(), _portno(-1) {} virtual ~GmshServer(){} virtual int NonBlockingSystemCall(const char *exe, const char *args) = 0; virtual int NonBlockingWait(double waitint, double timeout, int socket=-1) = 0; // start the client by launching "exe args" (args is supposed to contain // '%s' where the socket name should appear) int Start(const char *exe, const char *args, const char *sockname, double timeout) { if(!sockname) throw "Invalid (null) socket name"; _sockname = sockname; int tmpsock; if(strstr(_sockname.c_str(), "/") || strstr(_sockname.c_str(), "\\") || !strstr(_sockname.c_str(), ":")){ // UNIX socket (testing ":" is not enough with Windows paths) _portno = -1; #if !defined(WIN32) || defined(__CYGWIN__) // delete the file if it already exists unlink(_sockname.c_str()); // create a socket tmpsock = socket(PF_UNIX, SOCK_STREAM, 0); if(tmpsock < 0) throw "Couldn't create socket"; // bind the socket to its name struct sockaddr_un addr_un; memset((char *) &addr_un, 0, sizeof(addr_un)); strcpy(addr_un.sun_path, _sockname.c_str()); addr_un.sun_family = AF_UNIX; if(bind(tmpsock, (struct sockaddr *)&addr_un, sizeof(addr_un)) < 0){ CloseSocket(tmpsock); throw "Couldn't bind socket to name"; } // change permissions on the socket name in case it has to be rm'd later chmod(_sockname.c_str(), 0666); #else throw "Unix sockets not available on Windows"; #endif } else{ // TCP/IP socket: valid names are either explicit ("hostname:12345") // or implicit ("hostname:", "hostname: ", "hostname:0") in which case // the system attributes at random an available port const char *port = strstr(_sockname.c_str(), ":"); _portno = atoi(port + 1); // create a socket tmpsock = socket(AF_INET, SOCK_STREAM, 0); #if !defined(WIN32) || defined(__CYGWIN__) if(tmpsock < 0) #else if(tmpsock == (int)INVALID_SOCKET) #endif throw "Couldn't create socket"; // bind the socket to its name struct sockaddr_in addr_in; memset((char *) &addr_in, 0, sizeof(addr_in)); addr_in.sin_family = AF_INET; addr_in.sin_addr.s_addr = INADDR_ANY; addr_in.sin_port = htons(_portno); // random assign if _portno == 0 if(bind(tmpsock, (struct sockaddr *)&addr_in, sizeof(addr_in)) < 0){ CloseSocket(tmpsock); throw "Couldn't bind socket to name"; } if(!_portno){ // retrieve name if randomly assigned port socklen_t addrlen = sizeof(addr_in); getsockname(tmpsock, (struct sockaddr *)&addr_in, &addrlen); _portno = ntohs(addr_in.sin_port); int pos = _sockname.find(':'); // remove trailing ' ' or '0' char tmp[256]; sprintf(tmp, "%s:%d", _sockname.substr(0, pos).c_str(), _portno); _sockname.assign(tmp); } } if(exe && strlen(exe) && args && strlen(args)){ char s[1024]; sprintf(s, args, _sockname.c_str()); NonBlockingSystemCall(exe, s); // starts the solver } else{ timeout = 0.; // no command launched: don't set a timeout } // listen on socket (queue up to 20 connections before having // them automatically rejected) if(listen(tmpsock, 20)){ CloseSocket(tmpsock); throw "Socket listen failed"; } // wait until we get data int ret = NonBlockingWait(0.001, timeout, tmpsock); if(ret){ CloseSocket(tmpsock); if(ret == 2){ throw "Socket listening timeout"; } else{ return -1; // stopped listening } } // accept connection request if(_portno < 0){ #if !defined(WIN32) || defined(__CYGWIN__) struct sockaddr_un from_un; socklen_t len = sizeof(from_un); _sock = accept(tmpsock, (struct sockaddr *)&from_un, &len); #endif } else{ struct sockaddr_in from_in; socklen_t len = sizeof(from_in); _sock = accept(tmpsock, (struct sockaddr *)&from_in, &len); } CloseSocket(tmpsock); if(_sock < 0) throw "Socket accept failed"; return _sock; } int Shutdown() { #if !defined(WIN32) || defined(__CYGWIN__) if(_portno < 0) unlink(_sockname.c_str()); #endif ShutdownSocket(_sock); CloseSocket(_sock); return 0; } }; #endif getdp-2.7.0-source/Common/ListUtils.cpp000644 001750 001750 00000024670 12614106256 021505 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // // Contributor(s): // Marc Ume // #include "GetDPConfig.h" #if !defined(HAVE_NO_STDINT_H) #include #elif defined(HAVE_NO_INTPTR_T) typedef unsigned long intptr_t; #endif #include #include #include #include #include #include "MallocUtils.h" #include "ListUtils.h" #include "TreeUtils.h" #include "Message.h" #if !defined(HAVE_GMSH) int fcmp_int(const void *a, const void *b) { return (*(int *)a - *(int *)b); } int fcmp_absint(const void *a, const void *b) { return (abs(*(int *)a) - abs(*(int *)b)); } int fcmp_double(const void *a, const void *b) { double cmp; cmp = *(double *)a - *(double *)b; if(cmp > 1.e-16) return 1; else if(cmp < -1.e-16) return -1; else return 0; } List_T *List_Create(int n, int incr, int size) { List_T *liste; if(n <= 0) n = 1; if(incr <= 0) incr = 1; liste = (List_T *) Malloc(sizeof(List_T)); liste->nmax = 0; liste->incr = incr; liste->size = size; liste->n = 0; liste->isorder = 0; liste->array = NULL; List_Realloc(liste, n); return (liste); } void List_Delete(List_T * liste) { if(!liste) return; Free(liste->array); Free(liste); } void List_Realloc(List_T * liste, int n) { if(n <= 0) return; if(liste->array == NULL) { // This does not permit to allocate lists smaller that liste->incr: //liste->nmax = ((n - 1) / liste->incr + 1) * liste->incr; // So this is much better liste->nmax = n; liste->array = (char *)Malloc(liste->nmax * liste->size); } else if(n > liste->nmax) { liste->nmax = ((n - 1) / liste->incr + 1) * liste->incr; liste->array = (char *)Realloc(liste->array, liste->nmax * liste->size); } } void List_Add(List_T * liste, void *data) { liste->n++; List_Realloc(liste, liste->n); liste->isorder = 0; memcpy(&liste->array[(liste->n - 1) * liste->size], data, liste->size); } int List_Nbr(List_T * liste) { return (liste) ? liste->n : 0; } void List_Read(List_T * liste, int index, void *data) { if((index < 0) || (index >= liste->n)) Message::Fatal("Wrong list index (read)"); memcpy(data, &liste->array[index * liste->size], liste->size); } void List_Write(List_T * liste, int index, void *data) { if((index < 0) || (index >= liste->n)) Message::Error("Wrong list index (write)"); else { liste->isorder = 0; memcpy(&liste->array[index * liste->size], data, liste->size); } } void List_Put(List_T * liste, int index, void *data) { if(index < 0) Message::Error("Wrong list index (put)"); else { if(index >= liste->n) { liste->n = index + 1; List_Realloc(liste, liste->n); List_Write(liste, index, data); } else { List_Write(liste, index, data); } } } void List_Pop(List_T * liste) { if(liste->n > 0) liste->n--; } void *List_Pointer(List_T * liste, int index) { if((index < 0) || (index >= liste->n)) Message::Fatal("Wrong list index (pointer)"); liste->isorder = 0; return (&liste->array[index * liste->size]); } void *List_Pointer_NoChange(List_T * liste, int index) { if((index < 0) || (index >= liste->n)) Message::Fatal("Wrong list index (pointer)"); return (&liste->array[index * liste->size]); } void *List_Pointer_Fast(List_T * liste, int index) { return (&liste->array[index * liste->size]); } void *List_Pointer_Test(List_T * liste, int index) { if(!liste || (index < 0) || (index >= liste->n)) return NULL; liste->isorder = 0; return (&liste->array[index * liste->size]); } void List_Sort(List_T * liste, int (*fcmp) (const void *a, const void *b)) { qsort(liste->array, liste->n, liste->size, fcmp); } int List_Search(List_T * liste, void *data, int (*fcmp) (const void *a, const void *b)) { void *ptr; if(liste->isorder != 1) { List_Sort(liste, fcmp); liste->isorder = 1; } ptr = (void *)bsearch(data, liste->array, liste->n, liste->size, fcmp); if(ptr == NULL) return (0); return (1); } int List_ISearchSeq(List_T * liste, void *data, int (*fcmp) (const void *a, const void *b)) { int i; if(!liste) return -1; i = 0; while((i < List_Nbr(liste)) && fcmp(data, (void *)List_Pointer(liste, i))) i++; if(i == List_Nbr(liste)) i = -1; return i; } void *List_PQuery(List_T * liste, void *data, int (*fcmp) (const void *a, const void *b)) { void *ptr; if(liste->isorder != 1) List_Sort(liste, fcmp); liste->isorder = 1; ptr = (void *)bsearch(data, liste->array, liste->n, liste->size, fcmp); return (ptr); } int List_PSuppress(List_T * liste, int index) { char *ptr; int len; ptr = (char *)List_Pointer_NoChange(liste, index); if(ptr == NULL) return (0); liste->n--; len = liste->n - (((intptr_t)ptr - (intptr_t)liste->array) / liste->size); if(len > 0) memmove(ptr, ptr + liste->size, len * liste->size); return (1); } void List_Invert(List_T * a, List_T * b) { int i, N; N = List_Nbr(a); for(i = 0; i < N; i++) { List_Add(b, List_Pointer(a, N - i - 1)); } } void List_Reset(List_T * liste) { if(!liste) return; liste->n = 0; } void List_Action(List_T * liste, void (*action) (void *data, void *dummy)) { int i, dummy; for(i = 0; i < List_Nbr(liste); i++) (*action) (List_Pointer_NoChange(liste, i), &dummy); } void List_Copy(List_T * a, List_T * b) { int i, N; N = List_Nbr(a); for(i = 0; i < N; i++) { List_Add(b, List_Pointer(a, i)); } } List_T *ListOfDouble2ListOfInt(List_T *dList) { int n = List_Nbr(dList); List_T *iList = List_Create(n, n, sizeof(int)); for(int i = 0; i < n; i++){ double d; List_Read(dList, i, &d); int j = (int)d; List_Add(iList, &j); } return iList; } #endif // These are not defined in Gmsh: static int safe_fwrite(const void *ptr, size_t size, size_t nmemb, FILE * stream) { size_t result = fwrite(ptr, size, nmemb, stream); if(result < nmemb) { Message::Error(strerror(errno)); if(fflush(stream) < 0) Message::Error("EOF reached"); if(fclose(stream) < 0) Message::Error(strerror(errno)); return 1; } return 0; } void List_WriteToFile(List_T * liste, FILE * file, int format) { int i, n; if(!(n = List_Nbr(liste))) return; switch (format) { case LIST_FORMAT_ASCII: if(liste->size == sizeof(double)) for(i = 0; i < n; i++) fprintf(file, " %.16g", *((double *)&liste->array[i * liste->size])); else if(liste->size == sizeof(float)) for(i = 0; i < n; i++) fprintf(file, " %.16g", *((float *)&liste->array[i * liste->size])); else if(liste->size == sizeof(int)) for(i = 0; i < n; i++) fprintf(file, " %d", *((int *)&liste->array[i * liste->size])); else if(liste->size == sizeof(char)) for(i = 0; i < n; i++) fputc(*((char *)&liste->array[i * liste->size]), file); else Message::Error("Bad type of data to write list to file (size = %d)", liste->size); break; case LIST_FORMAT_BINARY: safe_fwrite(liste->array, liste->size, n, file); break; default: Message::Error("Unknown list format"); break; } } int List_Query(List_T *liste, void *data, int (*fcmp)(const void *a, const void *b)) { void *ptr; if (liste->isorder != 1) List_Sort(liste,fcmp); liste->isorder = 1; ptr = (void *) bsearch(data,liste->array,liste->n,liste->size,fcmp); if (ptr == NULL) return(0); memcpy(data,ptr,liste->size); return (1); } int List_Suppress(List_T *liste, void *data, int (*fcmp)(const void *a, const void *b)) { char *ptr; int len; ptr = (char*)List_PQuery(liste,data,fcmp) ; if (ptr == NULL) return(0); liste->n--; len = liste->n - (((intptr_t)ptr - (intptr_t)liste->array) / liste->size); if (len > 0) memmove(ptr, ptr + liste->size, len * liste->size); return(1); } void List_Insert(List_T *liste, void *data, int (*fcmp)(const void *a, const void *b)) { if (List_Search(liste,data,fcmp) == 0) List_Add(liste,data); } List_T *List_Copy(List_T *src) { List_T *dest = (List_T *)Malloc(sizeof(List_T)); dest->nmax = src->nmax; dest->incr = src->incr; dest->size = src->size; dest->n = src->n; dest->isorder = src->isorder; dest->array = (char *)Malloc(src->nmax * src->size); memcpy(dest->array, src->array, src->nmax * src->size); return dest; } int List_ISearch(List_T * liste, void *data, int (*fcmp) (const void *a, const void *b)) { void *ptr; if(liste->isorder != 1) List_Sort(liste, fcmp); liste->isorder = 1; ptr = (void *)bsearch(data, liste->array, liste->n, liste->size, fcmp); if(ptr == NULL) return (-1); return (((intptr_t)ptr - (intptr_t)liste->array) / liste->size); } int List_ISearchSeqPartial(List_T *liste, void * data, int i_Start, int (*fcmp)(const void *a, const void *b)) { int i ; if (!liste) return -1 ; i = i_Start ; while ((i < List_Nbr(liste)) && fcmp(data, (void *)List_Pointer(liste, i)) ) i++ ; if (i == List_Nbr(liste)) i = -1 ; return i ; } int List_Replace(List_T *liste, void *data, int (*fcmp)(const void *a, const void *b)) { void *ptr; if (liste->isorder != 1) List_Sort(liste,fcmp); liste->isorder = 1; ptr = (void *) bsearch(data,liste->array,liste->n,liste->size,fcmp); if (ptr == NULL) { List_Add(liste,data); return(0); } else { memcpy(ptr,data,liste->size); return (1); } } static void *lolofind(void *data, void *array, int n, int size, int (*fcmp)(const void *a, const void *b) ) { char *ptr; int i; ptr = (char*)array; for (i = 0; i < n; i++) { if (fcmp(ptr,data) == 0) break; ptr += size; } if (i < n) return(ptr); return(NULL); } static char *startptr = NULL; int List_LQuery(List_T *liste, void *data, int (*fcmp)(const void *a, const void *b), int first) { char *ptr; if (first == 1) { ptr = (char *) lolofind(data,liste->array,liste->n,liste->size,fcmp); } else { if (startptr != NULL) ptr = (char *) lolofind(data,startptr, liste->n - (startptr-liste->array)/liste->size, liste->size,fcmp); else return(0); } if (ptr == NULL) return(0); startptr = ptr + liste->size; if ( startptr >= ( liste->array + liste->n * liste->size)) startptr = NULL; memcpy(data,ptr,liste->size); return (1); } getdp-2.7.0-source/Common/MallocUtils.h000644 001750 001750 00000000656 12473553042 021446 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _MALLOC_UTILS_H_ #define _MALLOC_UTILS_H_ #include void *Malloc(size_t size); void *Calloc(size_t num, size_t size); void *Realloc(void *ptr, size_t size); void Free(void *ptr); #endif getdp-2.7.0-source/Common/GetDPVersion.h.in000644 001750 001750 00000001377 12473553042 022135 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _GETDP_VERSION_H_ #define _GETDP_VERSION_H_ #define GETDP_MAJOR_VERSION ${GETDP_MAJOR_VERSION} #define GETDP_MINOR_VERSION ${GETDP_MINOR_VERSION} #define GETDP_PATCH_VERSION ${GETDP_PATCH_VERSION} #define GETDP_EXTRA_VERSION "${GETDP_EXTRA_VERSION}" #define GETDP_VERSION "${GETDP_VERSION}" #define GETDP_DATE "${GETDP_DATE}" #define GETDP_HOST "${GETDP_HOST}" #define GETDP_PACKAGER "${GETDP_PACKAGER}" #define GETDP_OS "${GETDP_OS}" #define GETDP_SHORT_LICENSE "${GETDP_SHORT_LICENSE}" #endif getdp-2.7.0-source/Common/GetDPConfig.h.in000644 001750 001750 00000001660 12473553042 021710 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _GETDP_CONFIG_H_ #define _GETDP_CONFIG_H_ #cmakedefine HAVE_ARPACK #cmakedefine HAVE_GMSH #cmakedefine HAVE_GSL #cmakedefine HAVE_LEGACY #cmakedefine HAVE_MPI #cmakedefine HAVE_MULTIHARMONIC #cmakedefine HAVE_NO_FORTRAN #cmakedefine HAVE_NO_INTPTR_T #cmakedefine HAVE_NO_SOCKLEN_T #cmakedefine HAVE_NO_STDINT_H #cmakedefine HAVE_NO_VSNPRINTF #cmakedefine HAVE_NR #cmakedefine HAVE_NX #cmakedefine HAVE_OCTAVE #cmakedefine HAVE_PETSC #cmakedefine HAVE_PYTHON // FIXME HAVE_ONELAB2 from Gmsh #cmakedefine HAVE_ONELAB2 #cmakedefine HAVE_SLEPC #cmakedefine HAVE_SPARSKIT #cmakedefine HAVE_ZITSOL #cmakedefine HAVE_MULTIHARMONIC #define GETDP_CONFIG_OPTIONS "${GETDP_CONFIG_OPTIONS}" ${GETDP_CONFIG_PRAGMAS} #endif getdp-2.7.0-source/Common/OS.h000644 001750 001750 00000001420 12606421311 017514 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _OS_H_ #define _OS_H_ #include #include FILE *FOpen(const char *f, const char *mode); void GetResources(double *s, long *mem); double GetTotalRam(); double GetTimeOfDay(); void IncreaseStackSize(); void SleepSeconds(double s); int BlockingSystemCall(const char *command); int RemoveFile(const std::string &fileName); int RenameFile(const std::string &oldName, const std::string &newName); int CreateDir(const std::string &dirName); int CreateDirs(const std::string &dirName); std::string GetDir(const std::string &fileName); #endif getdp-2.7.0-source/Common/MallocUtils.cpp000644 001750 001750 00000001707 12473553042 021777 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include #include "MallocUtils.h" #include "Message.h" void *Malloc(size_t size) { void *ptr; if(!size) return (NULL); ptr = malloc(size); if(ptr == NULL) Message::Fatal("Out of memory (buy some more RAM!)"); return (ptr); } void *Calloc(size_t num, size_t size) { void *ptr; if(!size) return (NULL); ptr = calloc(num, size); if(ptr == NULL) Message::Fatal("Out of memory (buy some more RAM!)"); return (ptr); } void *Realloc(void *ptr, size_t size) { if(!size) return (NULL); ptr = realloc(ptr, size); if(ptr == NULL) Message::Fatal("Out of memory (buy some more RAM!)"); return (ptr); } void Free(void *ptr) { if(ptr == NULL) return; free(ptr); } getdp-2.7.0-source/Common/Message.h000644 001750 001750 00000012253 12606421311 020565 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #ifndef _MESSAGE_H_ #define _MESSAGE_H_ #include #include #include #include class GmshClient; struct Constant; struct Expression; struct Group; #ifdef HAVE_ONELAB2 class OnelabNetworkClient; #else namespace onelab{ class client; } #endif // a class to manage messages class Message { private: // current cpu number and total number of cpus static int _commRank, _commSize, _isCommWorld; // error count static int _warningCount, _errorCount; // last PETSc error code static int _lastPETScError; // should we exit on error? static bool _exitOnError, _operatingInTimeLoopAdaptive; // verbosity level (0: silent except fatal errors, 1: +errors, 2: +warnings, // 3: +direct+important info, 4: +info+progress, 5: normal, 6: +matinfo, 10: // elementary matrices, 99: debug) static int _verbosity; // step (in %) of the progress meter and current progress % static int _progressMeterStep, _progressMeterCurrent; // starting time (gettimeofday at startup) static double _startTime; // timers static std::map _timers; // communication with Gmsh static GmshClient *_client; // communication with onelab server #ifdef HAVE_ONELAB2 static OnelabNetworkClient *_onelabClient; #else static onelab::client *_onelabClient; #endif public: Message() {} static void Initialize(int argc, char **argv); static void Finalize(); static void Exit(int level); static int GetCommRank(){ return _commRank; } static int GetCommSize(){ return _commSize; } static void SetCommRank(int val){ _commRank = val; } static void SetCommSize(int val){ _commSize = val; } static void Barrier(); static int GetIsCommWorld(){return _isCommWorld; } static void SetIsCommWorld(int val){ _isCommWorld = val; } static int GetNumThreads(); static int GetMaxThreads(); static int GetThreadNum(); static void SetVerbosity(int val){ _verbosity = val; } static int GetVerbosity(){ return _verbosity; } static void Fatal(const char *fmt, ...); static void Error(const char *fmt, ...); static void ResetErrorCounter(){ _errorCount = 0; } static int GetErrorCount(){ return _errorCount; } static void SetExitOnError(bool val){ _exitOnError = val; } static void SetOperatingInTimeLoopAdaptive(bool val){ _operatingInTimeLoopAdaptive = val; } static bool GetOperatingInTimeLoopAdaptive(){ return _operatingInTimeLoopAdaptive; } static void Warning(const char *fmt, ...); static void Info(const char *fmt, ...); static void Info(int level, const char *fmt, ...); static void Direct(const char *fmt, ...); static void Direct(int level, const char *fmt, ...); static void Check(const char *fmt, ...); static void Debug(const char *fmt, ...); static double GetWallClockTime(); static void Cpu(const char *fmt, ...); static void Cpu(int level, bool printDate, bool printWallTime, bool printCpu, bool printMem, const char *fmt, ...); static void ProgressMeter(int n, int N, const char *fmt, ...); static void ProgressMeter(int n, int N){ ProgressMeter(n, N, ""); } static void SetProgressMeterStep(int step){ _progressMeterStep = step; } static int GetProgressMeterStep(){ return _progressMeterStep; } static void ResetProgressMeter(){ if(!_commRank) _progressMeterCurrent = 0; } static void PrintErrorCounter(const char *title); static void SetLastPETScError(int ierr){ _lastPETScError = ierr; } static int GetLastPETScError(){ return _lastPETScError; } static double &Timer(std::string str){ return _timers[str]; } static void PrintTimers(); static void InitializeSocket(std::string sockname); static void FinalizeSocket(); static bool UseSocket(){ return _client ? true : false; } static void SendMergeFileRequest(const std::string &filename); static void SendOptionOnSocket(int num, std::string option); static void TestSocket(); static void InitializeOnelab(std::string name, std::string sockname); static void FinalizeOnelab(); #ifdef HAVE_ONELAB2 static bool UseOnelab(){ return _onelabClient; } #else static bool UseOnelab(){ return _onelabClient ? true : false; } #endif static std::string GetOnelabClientName(); static void SetOnelabNumber(std::string name, double val, bool visible=true); static double GetOnelabNumber(std::string name); static void GetOnelabString(std::string name, char **val); static std::string GetOnelabAction(); static void AddOnelabNumberChoice(std::string name, double val, const char *color=0); static void AddOnelabStringChoice(std::string name, std::string kind, std::string choice); typedef std::map > fmap; typedef std::map > cmap; static void ExchangeOnelabParameter(Constant *c, fmap &fopt, cmap &copt); static void ExchangeOnelabParameter(Group *p, fmap &fopt, cmap &copt); static void ExchangeOnelabParameter(Expression *p, fmap &fopt, cmap &copt); static void UndefineOnelabParameter(const std::string &name); }; #endif getdp-2.7.0-source/Common/Message.cpp000644 001750 001750 00000107701 12614106256 021132 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . #include #include #include #include #include #include #include "GetDPConfig.h" #include "Message.h" #include "GmshSocket.h" #include "onelab.h" #include "OS.h" #include "ProData.h" // for onelab #include "ProParser.h" // for onelab #if defined(HAVE_ONELAB2) #include "NetworkUtils.h" #include "OnelabNetworkClient.h" #ifndef WIN32 #include #include #else #include #endif #endif #if !defined(WIN32) || defined(__CYGWIN__) #include #include #endif #if defined(WIN32) #include #include #endif #if defined(HAVE_PETSC) #include "petsc.h" #endif #if defined(HAVE_GSL) #include #endif #if defined(HAVE_GMSH) #include #include #include #endif #if defined(HAVE_OCTAVE) #undef _D1 #undef _D2 #undef HAVE_ARPACK #include #include #include #endif #if defined(HAVE_PYTHON) #include #endif int Message::_commRank = 0; int Message::_commSize = 1; int Message::_isCommWorld = 1; // is the communicator set to WORLD (==1) or SELF (!=1) int Message::_errorCount = 0; int Message::_lastPETScError = 0; bool Message::_exitOnError = false; bool Message::_operatingInTimeLoopAdaptive = false; int Message::_verbosity = 5; int Message::_progressMeterStep = 10; int Message::_progressMeterCurrent = 0; double Message::_startTime = 0.; std::map Message::_timers; GmshClient* Message::_client = 0; #ifdef HAVE_ONELAB2 OnelabNetworkClient* Message::_onelabClient = 0; #else onelab::client* Message::_onelabClient = 0; #endif #if !defined(HAVE_ONELAB) // if Gmsh is compiled without onelab onelab::server *onelab::server::_server = 0; #endif #if defined(HAVE_NO_VSNPRINTF) static int vsnprintf(char *str, size_t size, const char *fmt, va_list ap) { if(strlen(fmt) > size - 1){ // just copy the format strncpy(str, fmt, size - 1); str[size - 1] = '\0'; return size; } return vsprintf(str, fmt, ap); } #endif #if defined(_MSC_VER) && (_MSC_VER == 1310) //NET 2003 #define vsnprintf _vsnprintf #endif #if defined(HAVE_GSL) static void gslErrorHandler(const char *reason, const char *file, int line, int gsl_errno) { Message::Error("GSL: %s (%s, line %d)", reason, file, line); } #endif void Message::Initialize(int argc, char **argv) { _startTime = GetTimeOfDay(); _errorCount = 0; #if defined(HAVE_PETSC) MPI_Init(&argc, &argv); MPI_Comm_rank(MPI_COMM_WORLD, &_commRank); MPI_Comm_size(MPI_COMM_WORLD, &_commSize); MPI_Errhandler_set(MPI_COMM_WORLD, MPI_ERRORS_RETURN); #endif #if defined(HAVE_GSL) gsl_set_error_handler(&gslErrorHandler); #endif #if defined(HAVE_OCTAVE) string_vector oargv(2); oargv(0) = "embedded"; oargv(1) = "-q"; octave_main(2, oargv.c_str_vec(), 1); #endif #if defined(HAVE_PYTHON) Py_SetProgramName(argv[0]); Py_InitializeEx(0); // Py_Initialize() handles signals PySys_SetArgv(argc, argv); #endif } void Message::Finalize() { #if defined(HAVE_PETSC) int initialized, finalized; MPI_Initialized(&initialized); MPI_Finalized(&finalized); if(initialized && !finalized) MPI_Finalize(); #endif FinalizeSocket(); FinalizeOnelab(); #if defined(HAVE_PYTHON) Py_Finalize(); #endif } void Message::Exit(int level) { #if defined(HAVE_PETSC) if(level && _commSize > 1){ // abort (and not finalize) in order to terminate the full job *now* MPI_Abort(MPI_COMM_WORLD, level); } #endif Finalize(); #if defined(HAVE_OCTAVE) clean_up_and_exit(level); #else exit(level); #endif } static int streamIsFile(FILE* stream) { // the given stream is definitely not interactive if it is a regular file struct stat stream_stat; if(fstat(fileno(stream), &stream_stat) == 0){ if(stream_stat.st_mode & S_IFREG) return 1; } return 0; } static int streamIsVT100(FILE* stream) { // if running inside emacs the terminal is not VT100 const char* emacs = getenv("EMACS"); if(emacs && *emacs == 't') return 0; // list of known terminal names (from cmake) static const char* names[] = {"Eterm", "ansi", "color-xterm", "con132x25", "con132x30", "con132x43", "con132x60", "con80x25", "con80x28", "con80x30", "con80x43", "con80x50", "con80x60", "cons25", "console", "cygwin", "dtterm", "eterm-color", "gnome", "gnome-256color", "konsole", "konsole-256color", "kterm", "linux", "msys", "linux-c", "mach-color", "mlterm", "putty", "rxvt", "rxvt-256color", "rxvt-cygwin", "rxvt-cygwin-native", "rxvt-unicode", "rxvt-unicode-256color", "screen", "screen-256color", "screen-256color-bce", "screen-bce", "screen-w", "screen.linux", "vt100", "xterm", "xterm-16color", "xterm-256color", "xterm-88color", "xterm-color", "xterm-debian", 0}; const char** t = 0; const char* term = getenv("TERM"); if(term){ for(t = names; *t && strcmp(term, *t) != 0; ++t) {} } if(!(t && *t)) return 0; return 1; } void Message::Fatal(const char *fmt, ...) { _errorCount++; char str[1024]; va_list args; va_start(args, fmt); vsnprintf(str, sizeof(str), fmt, args); va_end(args); if(_client){ _client->Error(str); } else if(_onelabClient && _onelabClient->getName() != "GetDPServer"){ _onelabClient->sendError(str); } else{ const char *c0 = "", *c1 = ""; if(!streamIsFile(stderr) && streamIsVT100(stderr)){ c0 = "\33[1m\33[31m"; c1 = "\33[0m"; // bold red } if(_commSize > 1) fprintf(stderr, "%sFatal : [rank %3d] %s%s\n", c0, _commRank, str, c1); else fprintf(stderr, "%sFatal : %s%s\n", c0, str, c1); fflush(stderr); } Exit(1); } void Message::Error(const char *fmt, ...) { _errorCount++; if(!_exitOnError && _verbosity < 1) return; char str[1024]; va_list args; va_start(args, fmt); vsnprintf(str, sizeof(str), fmt, args); va_end(args); if(_client){ _client->Error(str); } else if(_onelabClient && _onelabClient->getName() != "GetDPServer"){ _onelabClient->sendError(str); } else{ const char *c0 = "", *c1 = ""; if(!streamIsFile(stderr) && streamIsVT100(stderr)){ c0 = "\33[1m\33[31m"; c1 = "\33[0m"; // bold red } if(_commSize > 1) fprintf(stderr, "%sError : [rank %3d] %s%s\n", c0, _commRank, str, c1); else fprintf(stderr, "%sError : %s%s\n", c0, str, c1); fflush(stderr); } if(_exitOnError){ // Error() should normally not exit; use Fatal() for that Exit(1); } } void Message::Warning(const char *fmt, ...) { if((_commRank && _isCommWorld) || _verbosity < 2) return; char str[1024]; va_list args; va_start(args, fmt); vsnprintf(str, sizeof(str), fmt, args); va_end(args); if(_client){ _client->Warning(str); } else if(_onelabClient && _onelabClient->getName() != "GetDPServer"){ _onelabClient->sendWarning(str); } else{ const char *c0 = "", *c1 = ""; if(!streamIsFile(stdout) && streamIsVT100(stdout)){ c0 = "\33[35m"; c1 = "\33[0m"; // magenta } if(_isCommWorld) fprintf(stdout, "%sWarning : %s%s\n", c0, str, c1); else fprintf(stdout, "%sWarning : [rank %3d] %s%s\n", c0, _commRank, str, c1); fflush(stdout); } } void Message::Info(const char *fmt, ...) { if((_commRank && _isCommWorld) || _verbosity < 4) return; char str[1024]; va_list args; va_start(args, fmt); vsnprintf(str, sizeof(str), fmt, args); va_end(args); Info(4, str); } void Message::Info(int level, const char *fmt, ...) { if((_commRank && _isCommWorld && level > 0) || _verbosity < abs(level)) return; char str[1024]; va_list args; va_start(args, fmt); vsnprintf(str, sizeof(str), fmt, args); va_end(args); if(_client){ _client->Info(str); } else if(_onelabClient && _onelabClient->getName() != "GetDPServer"){ _onelabClient->sendInfo(str); } else{ if(_isCommWorld && (_commSize == 1 || level > 0)) fprintf(stdout, "Info : %s\n", str); else fprintf(stdout, "Info : [rank %3d] %s\n", _commRank, str); fflush(stdout); } } void Message::Direct(const char *fmt, ...) { if((_commRank && _isCommWorld) || _verbosity < 3) return; va_list args; va_start(args, fmt); char str[1024]; vsnprintf(str, sizeof(str), fmt, args); va_end(args); Direct(3, str); } void Message::Direct(int level, const char *fmt, ...) { if((_commRank && _isCommWorld && level > 0) || _verbosity < abs(level)) return; va_list args; va_start(args, fmt); char str[1024]; vsnprintf(str, sizeof(str), fmt, args); va_end(args); if(_client){ _client->Info(str); } else if(_onelabClient && _onelabClient->getName() != "GetDPServer"){ _onelabClient->sendInfo(str); } else{ const char *c0 = "", *c1 = ""; if(abs(level) == 3 && !streamIsFile(stdout) && streamIsVT100(stdout)){ c0 = "\33[34m"; c1 = "\33[0m"; // blue } if(_isCommWorld && (_commSize == 1 || level > 0)) fprintf(stdout, "%s%s%s\n", c0, str, c1); else fprintf(stdout, "%s[rank %3d] %s%s\n", c0, _commRank, str, c1); fflush(stdout); } } void Message::Check(const char *fmt, ...) { if(_commRank && _isCommWorld) return; char str[5000]; va_list args; va_start(args, fmt); vsnprintf(str, sizeof(str), fmt, args); va_end(args); if(_client){ _client->Info(str); } else if(_onelabClient && _onelabClient->getName() != "GetDPServer"){ _onelabClient->sendInfo(str); } else{ fprintf(stdout, "%s", str); fflush(stdout); } } void Message::Debug(const char *fmt, ...) { if(_verbosity < 99) return; va_list args; va_start(args, fmt); char str[1024]; vsnprintf(str, sizeof(str), fmt, args); va_end(args); if(_client){ _client->Info(str); } else if(_onelabClient && _onelabClient->getName() != "GetDPServer"){ _onelabClient->sendInfo(str); } else{ if(_commSize > 1) fprintf(stdout, "Debug : [rank %3d] %s\n", _commRank, str); else fprintf(stdout, "Debug : %s\n", str); fflush(stdout); } } double Message::GetWallClockTime() { return GetTimeOfDay() - _startTime; } void Message::Cpu(const char *fmt, ...) { if(_verbosity < 5) return; va_list args; va_start(args, fmt); char str[1024]; vsnprintf(str, sizeof(str), fmt, args); va_end(args); Cpu(5, false, true, true, true, str); } void Message::Cpu(int level, bool printDate, bool printWallTime, bool printCpu, bool printMem, const char *fmt, ...) { if(_verbosity < abs(level)) return; double s = 0.; long mem = 0; GetResources(&s, &mem); double val[2] = {s, (double)mem / 1024. / 1024.}; double min[2] = {val[0], val[1]}; double max[2] = {val[0], val[1]}; double sum[2] = {val[0], val[1]}; #if defined(HAVE_PETSC) if(_commSize > 1 && _isCommWorld){ MPI_Reduce(val, min, 2, MPI_DOUBLE, MPI_MIN, 0, MPI_COMM_WORLD); MPI_Reduce(val, max, 2, MPI_DOUBLE, MPI_MAX, 0, MPI_COMM_WORLD); MPI_Reduce(val, sum, 2, MPI_DOUBLE, MPI_SUM, 0, MPI_COMM_WORLD); } #endif if(_commRank && _isCommWorld && level > 0) return; char str[1024]; va_list args; va_start(args, fmt); vsnprintf(str, sizeof(str), fmt, args); va_end(args); if(strlen(fmt)) strcat(str, " "); std::string pdate = ""; if(printDate){ time_t now; time(&now); pdate = ctime(&now); pdate.resize(pdate.size() - 1); if(printWallTime || printCpu || (printMem && mem)) pdate += ", "; } std::string pwall = ""; if(printWallTime){ char tmp[128]; sprintf(tmp, "Wall = %gs", GetWallClockTime()); pwall = tmp; if(printCpu || (printMem && mem)) pwall += ", "; } std::string pcpu = ""; if(printCpu){ char tmp[128]; if(_commSize > 1 && _isCommWorld) sprintf(tmp, "CPU = %gs [%gs,%gs]", sum[0], min[0], max[0]); else sprintf(tmp, "CPU = %gs", max[0]); pcpu = tmp; if(printMem && mem) pcpu += ", "; } std::string pmem = ""; if(mem && printMem){ char tmp[128]; if(_commSize > 1 && _isCommWorld) sprintf(tmp, "Mem = %gMb [%gMb,%gMb]", sum[1], min[1], max[1]); else sprintf(tmp, "Mem = %gMb", max[1]); pmem = tmp; } char str2[256] = ""; if(pdate.size() || pwall.size() || pcpu.size() || pmem.size()) sprintf(str2, "(%s%s%s%s)", pdate.c_str(), pwall.c_str(), pcpu.c_str(), pmem.c_str()); strcat(str, str2); if(_client){ _client->Info(str); } else if(_onelabClient && _onelabClient->getName() != "GetDPServer"){ _onelabClient->sendInfo(str); } else{ if(_isCommWorld && (_commSize == 1 || level > 0)) fprintf(stdout, "Info : %s\n", str); else fprintf(stdout, "Info : [rank %3d] %s\n", _commRank, str); fflush(stdout); } } void Message::ProgressMeter(int n, int N, const char *fmt, ...) { if((_commRank && _isCommWorld) || _verbosity < 4 || _progressMeterStep <= 0 || _progressMeterStep >= 100) return; double percent = 100. * (double)n/(double)N; if(N <= 0 || percent >= _progressMeterCurrent || n > N - 1){ char str[1024], str2[1024]; va_list args; va_start(args, fmt); vsnprintf(str, sizeof(str), fmt, args); va_end(args); sprintf(str2, "%3d%% : %s", _progressMeterCurrent, str); #ifndef HAVE_ONELAB2 if(_onelabClient && _onelabClient->getName() == "GetDP"){ _onelabClient->sendProgress(str); } #endif if(N <= 0){ if(_onelabClient && _onelabClient->getName() != "GetDPServer"){ onelab::number o(_onelabClient->getName() + "/Progress", n); o.setLabel(std::string("GetDP ") + str); o.setMin(0); o.setMax(N); o.setVisible(false); o.setReadOnly(true); _onelabClient->set(o); } return; } if(_client){ _client->Progress(str2); } else if(_onelabClient && _onelabClient->getName() != "GetDPServer"){ onelab::number o(_onelabClient->getName() + "/Progress", (n > N - 1) ? 0 : n); o.setLabel(std::string("GetDP ") + str); o.setMin(0); o.setMax(N); o.setVisible(false); o.setReadOnly(true); _onelabClient->set(o); } else if(!streamIsFile(stdout)){ fprintf(stdout, "%s \r", (n > N - 1) ? "" : str2); fflush(stdout); } while(_progressMeterCurrent < percent) _progressMeterCurrent += _progressMeterStep; } } void Message::PrintTimers() { // do a single stdio call! std::string str; for(std::map::iterator it = _timers.begin(); it != _timers.end(); it++){ if(it != _timers.begin()) str += ", "; char tmp[256]; sprintf(tmp, "%s = %gs ", it->first.c_str(), it->second); str += std::string(tmp); } if(!str.size()) return; if(_client){ _client->Info((char*)str.c_str()); } else if(_onelabClient && _onelabClient->getName() != "GetDPServer"){ _onelabClient->sendInfo(str); } else{ if(_commSize > 1) fprintf(stdout, "Timers : [rank %3d] %s\n", _commRank, str.c_str()); else fprintf(stdout, "Timers : %s\n", str.c_str()); fflush(stdout); } } void Message::PrintErrorCounter(const char *title) { if(!_errorCount || _commRank || _verbosity < 1) return; Message::Error("%s encountered %d error%s - check the log for details", title, _errorCount, (_errorCount > 1) ? "s" : ""); } void Message::InitializeSocket(std::string sockname) { if(sockname.size()){ _client = new GmshClient(); if(_client->Connect(sockname.c_str()) < 0){ Message::Error("Could not connect to socket `%s'", sockname.c_str()); delete _client; _client = 0; } else{ _client->Start(); } } } void Message::SendMergeFileRequest(const std::string &filename) { if(_client){ _client->MergeFile((char*)filename.c_str()); } else if(_onelabClient && _onelabClient->getName() != "GetDPServer"){ #ifdef HAVE_ONELAB2 _onelabClient->mergeFile(filename); #else _onelabClient->sendMergeFileRequest(filename); #endif } } void Message::TestSocket() { if(_client){ std::string tmp("View \"test\" {\n"); for(int i= 0; i < 1000000; i++) tmp += "ST(0,0,0, 1,0,0, 0,1,0){1,2,3};\n"; tmp += "};\n"; _client->SpeedTest(tmp.c_str()); } } void Message::SendOptionOnSocket(int num, std::string option) { if(_client){ _client->Option(num, option.c_str()); } } void Message::FinalizeSocket() { if(_client){ _client->Stop(); _client->Disconnect(); delete _client; _client = 0; } } class localGetDP : public onelab::localClient { public: localGetDP() : onelab::localClient("GetDP") {} #if defined(HAVE_GMSH) void sendMergeFileRequest(const std::string &name) { GmshMergePostProcessingFile(name); Msg::RequestRender(); } void sendInfo(const std::string &msg){ Msg::Info("%s", msg.c_str()); } void sendWarning(const std::string &msg){ Msg::Warning("%s", msg.c_str()); } void sendError(const std::string &msg){ Msg::Error("%s", msg.c_str()); } void sendProgress(const std::string &msg){ Msg::ProgressMeter(0, 0, true, msg.c_str()); } #endif }; void Message::InitializeOnelab(std::string name, std::string sockname) { #ifdef HAVE_ONELAB2 if(sockname.size()){ UInt32 address = 0; UInt16 port = 1148; size_t colon = sockname.find(':'); if(colon != std::string::npos) { address = ip4_inet_pton(sockname.substr(0,colon).c_str()); port = atoi(sockname.substr(colon+1).c_str()); } OnelabNetworkClient *c = new OnelabNetworkClient(name, address, port); if(!c->connect()) { Error("Could not connect to ONELAB server"); delete c; } else { _onelabClient = c; onelab::string o(name + "/FileExtension", ".pro"); o.setVisible(false); o.setAttribute("Persistent", "1"); _onelabClient->set(o); onelab::number o2(name + "/UseCommandLine", 1.); o2.setVisible(false); o2.setAttribute("Persistent", "1"); _onelabClient->set(o2); onelab::number o3(name + "/GuessModelName", 1.); o3.setVisible(false); o3.setAttribute("Persistent", "1"); _onelabClient->set(o3); std::vector ps; _onelabClient->get(ps, name + "/Action", true); if(ps.size()){ Info("Performing ONELAB '%s'", ps[0].getValue().c_str()); if(ps[0].getValue() == "initialize") Exit(0); } else { Warning("No action for GetDP in ONELAB database"); } } } #else if(sockname.size()){ // getdp is called by a distant onelab server onelab::remoteNetworkClient *c = new onelab::remoteNetworkClient(name, sockname); if(!c->getGmshClient()){ Message::Error("Could not connect to ONELAB server"); delete c; } else{ _onelabClient = c; // send configuration options (we send them even if Action != initialize), // so that they are also sent e.g. when the database is reset onelab::string o(name + "/FileExtension", ".pro"); o.setVisible(false); o.setAttribute("Persistent", "1"); _onelabClient->set(o); onelab::number o2(name + "/UseCommandLine", 1.); o2.setVisible(false); o2.setAttribute("Persistent", "1"); _onelabClient->set(o2); onelab::number o3(name + "/GuessModelName", 1.); o3.setVisible(false); o3.setAttribute("Persistent", "1"); _onelabClient->set(o3); std::vector ps; _onelabClient->get(ps, name + "/Action"); if(ps.size()){ Info("Performing ONELAB '%s'", ps[0].getValue().c_str()); if(ps[0].getValue() == "initialize") Exit(0); } } } else{ if(name == "GetDP"){ // getdp is called within the same memory space as the server _onelabClient = new localGetDP(); } else{ // getdp is called without a connection to a onelab server, but with the // name of a onelab database file; GetDP in this case becomes the onelab // server _onelabClient = new onelab::localClient("GetDPServer"); FILE *fp = FOpen(name.c_str(), "rb"); if(fp){ Message::Info("Reading ONELAB database '%s'", name.c_str()); _onelabClient->fromFile(fp); fclose(fp); } else Message::Error("Could not open file '%s'", name.c_str()); } } #endif } void Message::AddOnelabNumberChoice(std::string name, double val, const char *color) { if(_onelabClient){ std::vector choices; std::vector ps; _onelabClient->get(ps, name); #ifdef HAVE_ONELAB2 _onelabClient->recvfrom(); #endif if(ps.size()){ choices = ps[0].getChoices(); } else{ ps.resize(1); ps[0].setName(name); ps[0].setReadOnly(true); } if(color) ps[0].setAttribute("Highlight", color); ps[0].setValue(val); choices.push_back(val); ps[0].setChoices(choices); _onelabClient->set(ps[0]); #if !defined(BUILD_ANDROID) // FIXME: understand why this leads to crashes // ask Gmsh to refresh onelab::string o("Gmsh/Action", "refresh"); o.setVisible(false); _onelabClient->set(o); #endif } } void Message::AddOnelabStringChoice(std::string name, std::string kind, std::string value) { if(_onelabClient){ std::vector choices; std::vector ps; _onelabClient->get(ps, name); #ifdef HAVE_ONELAB2 _onelabClient->recvfrom(); #endif if(ps.size()){ choices = ps[0].getChoices(); if(std::find(choices.begin(), choices.end(), value) == choices.end()) choices.push_back(value); } else{ ps.resize(1); ps[0].setName(name); ps[0].setKind(kind); choices.push_back(value); } ps[0].setValue(value); ps[0].setChoices(choices); _onelabClient->set(ps[0]); } } void Message::SetOnelabNumber(std::string name, double val, bool visible) { if(_onelabClient){ std::vector numbers; #if defined(HAVE_ONELAB2) _onelabClient->get(numbers, name, "GetDP"); #else _onelabClient->get(numbers, name); #endif if(numbers.empty()){ numbers.resize(1); numbers[0].setName(name); } numbers[0].setValue(val); numbers[0].setVisible(visible); #if defined(HAVE_ONELAB2) _onelabClient->set(numbers[0], "GetDP"); #else _onelabClient->set(numbers[0]); #endif } } double Message::GetOnelabNumber(std::string name) { if(_onelabClient){ std::vector numbers; #if defined(HAVE_ONELAB2) _onelabClient->get(numbers, name, "GetDP"); #else _onelabClient->get(numbers, name); #endif if(numbers.empty()){ Message::Error("Unknown ONELAB number parameter '%s'", name.c_str()); return 0.; } else return numbers[0].getValue(); } Message::Warning("GetNumber requires a ONELAB client"); return 0.; } void Message::GetOnelabString(std::string name, char **val) { if(_onelabClient){ std::vector ps; _onelabClient->get(ps, name); #ifdef HAVE_ONELAB2 _onelabClient->recvfrom(); #endif if(ps.size() && ps[0].getValue().size()){ *val = strSave(ps[0].getValue().c_str()); return; } } *val = 0; } std::string Message::GetOnelabAction() { if(_onelabClient){ std::vector ps; _onelabClient->get(ps, _onelabClient->getName() + "/Action"); #ifdef HAVE_ONELAB2 _onelabClient->recvfrom(); #endif if(ps.size()) return ps[0].getValue(); } return ""; } std::string Message::GetOnelabClientName() { if(_onelabClient) return _onelabClient->getName(); return ""; } static std::string _getParameterName(char *Name, Message::cmap &copt) { std::string name(Name); if(copt.count("Path")){ std::string path = copt["Path"][0]; // if path ends with a number, assume it's for ordering purposes if(path.size() && path[path.size() - 1] >= '0' && path[path.size() - 1] <= '9') name = path + name; else if(path.size() && path[path.size() - 1] == '/') name = path + name; else name = path + "/" + name; } return name; } static void _setStandardOptions(onelab::parameter *p, Message::fmap &fopt, Message::cmap &copt) { // strings if(copt.count("Label")) p->setLabel(copt["Label"][0]); if(copt.count("ShortHelp")) // for backward compatibility p->setLabel(copt["ShortHelp"][0]); if(copt.count("Help")) p->setHelp(copt["Help"][0]); if(copt.count("Highlight")) p->setAttribute("Highlight", copt["Highlight"][0]); if(copt.count("Macro")) p->setAttribute("Macro", copt["Macro"][0]); if(copt.count("GmshOption")) p->setAttribute("GmshOption", copt["GmshOption"][0]); if(copt.count("AutoCheck")) // for backward compatibility p->setAttribute("AutoCheck", copt["AutoCheck"][0]); // numbers if(fopt.count("Visible")) p->setVisible(fopt["Visible"][0] ? true : false); if(fopt.count("ReadOnly")) p->setReadOnly(fopt["ReadOnly"][0] ? true : false); if(fopt.count("NeverChanged")) p->setNeverChanged(fopt["NeverChanged"][0] ? true : false); if(fopt.count("ReadOnlyRange")) p->setAttribute("ReadOnlyRange", fopt["ReadOnlyRange"][0] ? "1" : "0"); if(fopt.count("AutoCheck")) p->setAttribute("AutoCheck", fopt["AutoCheck"][0] ? "1" : "0"); } void Message::ExchangeOnelabParameter(Constant *c, fmap &fopt, cmap &copt) { if(!_onelabClient) return; std::string name; if(copt.count("Name")) name = copt["Name"][0]; if(name.empty()){ if(copt.size() || fopt.size()) Message::Error("From now on you need to use the `Name' attribute to create a " "ONELAB parameter: `Name \"%s\"'", _getParameterName(c->Name, copt).c_str()); return; } if(c->Type == VAR_FLOAT){ std::vector ps; _onelabClient->get(ps, name); bool noRange = true, noChoices = true, noLoop = true; bool noGraph = true, noClosed = true; if(ps.size()){ if(fopt.count("ReadOnly") && fopt["ReadOnly"][0]) ps[0].setValue(c->Value.Float); // use local value else c->Value.Float = ps[0].getValue(); // use value from server // keep track of these attributes, which can be changed server-side // (unless they are not visible, or, for the range/choices, when // explicitely setting these attributes as ReadOnly) if(ps[0].getVisible()){ if(!(fopt.count("ReadOnlyRange") && fopt["ReadOnlyRange"][0])){ if(ps[0].getMin() != -onelab::parameter::maxNumber() || ps[0].getMax() != onelab::parameter::maxNumber() || ps[0].getStep() != 0.) noRange = false; if(ps[0].getChoices().size()) noChoices = false; } if(ps[0].getAttribute("Loop").size()) noLoop = false; if(ps[0].getAttribute("Graph").size()) noGraph = false; if(ps[0].getAttribute("Closed").size()) noClosed = false; } } else{ ps.resize(1); ps[0].setName(name); ps[0].setValue(c->Value.Float); } // send updated parameter to server if(noRange && fopt.count("Range") && fopt["Range"].size() == 2){ ps[0].setMin(fopt["Range"][0]); ps[0].setMax(fopt["Range"][1]); } else if(noRange && fopt.count("Min") && fopt.count("Max")){ ps[0].setMin(fopt["Min"][0]); ps[0].setMax(fopt["Max"][0]); } else if(noRange && fopt.count("Min")){ ps[0].setMin(fopt["Min"][0]); ps[0].setMax(onelab::parameter::maxNumber()); } else if(noRange && fopt.count("Max")){ ps[0].setMax(fopt["Max"][0]); ps[0].setMin(-onelab::parameter::maxNumber()); } if(noRange && fopt.count("Step")) ps[0].setStep(fopt["Step"][0]); // if no range/min/max/step info is provided, try to compute a reasonnable // range and step (this makes the gui much nicer to use) if(noRange && !fopt.count("Range") && !fopt.count("Step") && !fopt.count("Min") && !fopt.count("Max")){ bool isInteger = (floor(c->Value.Float) == c->Value.Float); double fact = isInteger ? 10. : 100.; if(c->Value.Float > 0){ ps[0].setMin(c->Value.Float / fact); ps[0].setMax(c->Value.Float * fact); ps[0].setStep((ps[0].getMax() - ps[0].getMin()) / 100.); } else if(c->Value.Float < 0){ ps[0].setMin(c->Value.Float * fact); ps[0].setMax(c->Value.Float / fact); ps[0].setStep((ps[0].getMax() - ps[0].getMin()) / 100.); } if(c->Value.Float && isInteger){ ps[0].setMin((int)ps[0].getMin()); ps[0].setMax((int)ps[0].getMax()); ps[0].setStep((int)ps[0].getStep()); } } if(noChoices && fopt.count("Choices")){ ps[0].setChoices(fopt["Choices"]); if(copt.count("Choices")) ps[0].setChoiceLabels(copt["Choices"]); } if(noLoop && copt.count("Loop")) // for backward compatibility ps[0].setAttribute("Loop", copt["Loop"][0]); if(noLoop && fopt.count("Loop")) ps[0].setAttribute("Loop", (fopt["Loop"][0] == 3.) ? "3" : (fopt["Loop"][0] == 2.) ? "2" : (fopt["Loop"][0] == 1.) ? "1" : ""); if(noGraph && copt.count("Graph")) ps[0].setAttribute("Graph", copt["Graph"][0]); if(noClosed && copt.count("Closed")) // for backward compatibility ps[0].setAttribute("Closed", copt["Closed"][0]); if(noClosed && fopt.count("Closed")) ps[0].setAttribute("Closed", fopt["Closed"][0] ? "1" : "0"); _setStandardOptions(&ps[0], fopt, copt); _onelabClient->set(ps[0]); } else if(c->Type == VAR_CHAR){ std::vector ps; _onelabClient->get(ps, name); bool noClosed = true, noMultipleSelection = true; if(ps.size()){ if(fopt.count("ReadOnly") && fopt["ReadOnly"][0]) ps[0].setValue(c->Value.Char); // use local value else c->Value.Char = strSave(ps[0].getValue().c_str()); // use value from server // keep track of these attributes, which can be changed server-side // (unless they are not visible) if(ps[0].getVisible()){ if(ps[0].getAttribute("Closed").size()) noClosed = false; if(ps[0].getAttribute("MultipleSelection").size()) noMultipleSelection = false; } } else{ ps.resize(1); ps[0].setName(name); ps[0].setValue(c->Value.Char); } // send updated parameter to server if(copt.count("Kind")) ps[0].setKind(copt["Kind"][0]); if(copt.count("Choices")) ps[0].setChoices(copt["Choices"]); if(noClosed && copt.count("Closed")) // for backward compatibility ps[0].setAttribute("Closed", copt["Closed"][0]); if(noClosed && fopt.count("Closed")) // for backward compatibility ps[0].setAttribute("Closed", fopt["Closed"][0] ? "1" : "0"); if(noMultipleSelection && copt.count("MultipleSelection")) ps[0].setAttribute("MultipleSelection", copt["MultipleSelection"][0]); _setStandardOptions(&ps[0], fopt, copt); _onelabClient->set(ps[0]); } } extern void Fill_GroupInitialListFromString(List_T *list, const char *str); void Message::ExchangeOnelabParameter(Group *g, fmap &fopt, cmap &copt) { if(!_onelabClient) return; std::string name; if(copt.count("Name")) name = copt["Name"][0]; if(name.empty()){ if(copt.size() || fopt.size()) Message::Error("From now on you need to use the `Name' attribute to create a " "ONELAB parameter: `Name \"%s\"'", _getParameterName(g->Name, copt).c_str()); return; } std::vector ps; _onelabClient->get(ps, name); bool noClosed = true; if(ps.size()){ if(fopt.count("ReadOnly") && fopt["ReadOnly"][0]){ // use local value std::vector vec(copt["Strings"]); std::set val; for(unsigned int i = 0; i < vec.size(); i++) val.insert(vec[i]); ps[0].setValue(val); } else{ // use value from server List_Reset(g->InitialList); std::set val(ps[0].getValue()); for(std::set::iterator it = val.begin(); it != val.end(); it++) Fill_GroupInitialListFromString(g->InitialList, it->c_str()); } // keep track of these attributes, which can be changed server-side (unless // they are not visible) if(ps[0].getVisible()){ if(ps[0].getAttribute("Closed").size()) noClosed = false; } } else{ ps.resize(1); ps[0].setName(name); std::vector vec(copt["Strings"]); std::set val; for(unsigned int i = 0; i < vec.size(); i++) val.insert(vec[i]); ps[0].setValue(val); } // send updated parameter to server if(noClosed && copt.count("Closed")) // for backward compatibility ps[0].setAttribute("Closed", copt["Closed"][0]); if(noClosed && fopt.count("Closed")) // for backward compatibility ps[0].setAttribute("Closed", fopt["Closed"][0] ? "1" : "0"); _setStandardOptions(&ps[0], fopt, copt); _onelabClient->set(ps[0]); } void Message::ExchangeOnelabParameter(Expression *e, fmap &fopt, cmap &copt) { if(!_onelabClient) return; Message::Error("Exchanging functions with ONELAB in not implemented yet"); } void Message::UndefineOnelabParameter(const std::string &name) { if(!_onelabClient) return; bool found = false; #ifndef HAVE_ONELAB2 { // try to clear number with short name == name std::vector ps; _onelabClient->get(ps); for(unsigned int i = 0; i < ps.size(); i++){ if(ps[i].getShortName() == name){ found = true; _onelabClient->clear(ps[i].getName()); } } } if(!found){ // try to clear string with short name == name std::vector ps; _onelabClient->get(ps); for(unsigned int i = 0; i < ps.size(); i++){ if(ps[i].getShortName() == name){ found = true; _onelabClient->clear(ps[i].getName()); } } } // TODO for ONELAB2 (search only in local parameter ?) #endif if(!found) _onelabClient->clear(name); } void Message::FinalizeOnelab() { #ifdef HAVE_ONELAB2 if(_onelabClient){ // add default computation modes std::string name = ((VirtualClient *)_onelabClient)->getName(); std::vector ps; _onelabClient->get(ps, name + "/Action"); if(ps.size()){ if(ps[0].getValue() != "initialize"){ _onelabClient->get(ps, name + "/9ComputeCommand"); if(ps.empty()){ // only change value if none exists ps.resize(1); ps[0].setName(name + "/9ComputeCommand"); ps[0].setValue("-solve -pos"); } ps[0].setLabel("Compute command"); std::vector choices; choices.push_back("-pre"); choices.push_back("-cal"); choices.push_back("-pos"); choices.push_back("-solve"); choices.push_back("-solve -pos"); ps[0].setChoices(choices); _onelabClient->set(ps[0]); } } _onelabClient->disconnect(true); delete _onelabClient; _onelabClient = 0; #else if(_onelabClient){ // add default computation modes std::string name = _onelabClient->getName(); std::vector ps; _onelabClient->get(ps, name + "/Action"); if(ps.size()){ if(ps[0].getValue() != "initialize"){ _onelabClient->get(ps, name + "/9ComputeCommand"); if(ps.empty()){ // only change value if none exists ps.resize(1); ps[0].setName(name + "/9ComputeCommand"); ps[0].setValue("-solve -pos"); } ps[0].setLabel("Compute command"); std::vector choices; choices.push_back("-pre"); choices.push_back("-cal"); choices.push_back("-pos"); choices.push_back("-solve"); choices.push_back("-solve -pos"); ps[0].setChoices(choices); _onelabClient->set(ps[0]); } } delete _onelabClient; _onelabClient = 0; #endif } } void Message::Barrier() { #if defined(HAVE_PETSC) if(_isCommWorld) { MPI_Barrier(PETSC_COMM_WORLD); } #endif } #if defined(_OPENMP) #include int Message::GetNumThreads(){ return omp_get_num_threads(); } int Message::GetMaxThreads(){ return omp_get_max_threads(); } int Message::GetThreadNum(){ return omp_get_thread_num(); } #else int Message::GetNumThreads(){ return 1; } int Message::GetMaxThreads(){ return 1; } int Message::GetThreadNum(){ return 0; } #endif getdp-2.7.0-source/Common/OS.cpp000644 001750 001750 00000025020 12606421311 020051 0ustar00geuzainegeuzaine000000 000000 // GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege // // See the LICENSE.txt file for license information. Please report all // bugs and problems to the public mailing list . // This file contains a bunch of functions that depend on OS-dependent // features and/or system calls // these are available on all OSes #include #include #include #include #include #include #include #if defined(__APPLE__) #include #endif #if defined(__linux__) && !defined(BUILD_ANDROID) #include #endif #if !defined(WIN32) || defined(__CYGWIN__) #include #include #include #endif #if defined(WIN32) #include #include #include #include #include #include #endif #include "Message.h" #if defined(WIN32) && !defined(__CYGWIN__) // Unicode utility routines borrowed from FLTK static unsigned int utf8decode(const char* p, const char* end, int* len) { static unsigned short cp1252[32] = { 0x20ac, 0x0081, 0x201a, 0x0192, 0x201e, 0x2026, 0x2020, 0x2021, 0x02c6, 0x2030, 0x0160, 0x2039, 0x0152, 0x008d, 0x017d, 0x008f, 0x0090, 0x2018, 0x2019, 0x201c, 0x201d, 0x2022, 0x2013, 0x2014, 0x02dc, 0x2122, 0x0161, 0x203a, 0x0153, 0x009d, 0x017e, 0x0178 }; unsigned char c = *(unsigned char*)p; if (c < 0x80) { if (len) *len = 1; return c; } else if (c < 0xa0) { if (len) *len = 1; return cp1252[c-0x80]; } else if (c < 0xc2) { goto FAIL; } if ( (end && p+1 >= end) || (p[1]&0xc0) != 0x80) goto FAIL; if (c < 0xe0) { if (len) *len = 2; return ((p[0] & 0x1f) << 6) + ((p[1] & 0x3f)); } else if (c == 0xe0) { if (((unsigned char*)p)[1] < 0xa0) goto FAIL; goto UTF8_3; } else if (c < 0xf0) { UTF8_3: if ( (end && p+2 >= end) || (p[2]&0xc0) != 0x80) goto FAIL; if (len) *len = 3; return ((p[0] & 0x0f) << 12) + ((p[1] & 0x3f) << 6) + ((p[2] & 0x3f)); } else if (c == 0xf0) { if (((unsigned char*)p)[1] < 0x90) goto FAIL; goto UTF8_4; } else if (c < 0xf4) { UTF8_4: if ( (end && p+3 >= end) || (p[2]&0xc0) != 0x80 || (p[3]&0xc0) != 0x80) goto FAIL; if (len) *len = 4; return ((p[0] & 0x07) << 18) + ((p[1] & 0x3f) << 12) + ((p[2] & 0x3f) << 6) + ((p[3] & 0x3f)); } else if (c == 0xf4) { if (((unsigned char*)p)[1] > 0x8f) goto FAIL; // after 0x10ffff goto UTF8_4; } else { FAIL: if (len) *len = 1; return c; } } static unsigned int utf8toUtf16(const char* src, unsigned int srclen, unsigned short* dst, unsigned int dstlen) { const char* p = src; const char* e = src+srclen; unsigned int count = 0; if (dstlen) for (;;) { if (p >= e) {dst[count] = 0; return count;} if (!(*p & 0x80)) { // ascii dst[count] = *p++; } else { int len; unsigned int ucs = utf8decode(p,e,&len); p += len; if (ucs < 0x10000) { dst[count] = ucs; } else { // make a surrogate pair: if (count+2 >= dstlen) {dst[count] = 0; count += 2; break;} dst[count] = (((ucs-0x10000u)>>10)&0x3ff) | 0xd800; dst[++count] = (ucs&0x3ff) | 0xdc00; } } if (++count == dstlen) {dst[count-1] = 0; break;} } // we filled dst, measure the rest: while (p < e) { if (!(*p & 0x80)) p++; else { int len; unsigned int ucs = utf8decode(p,e,&len); p += len; if (ucs >= 0x10000) ++count; } ++count; } return count; } static unsigned int utf8FromUtf16(char* dst, unsigned int dstlen, const wchar_t* src, unsigned int srclen) { unsigned int i = 0; unsigned int count = 0; if (dstlen) { for (;;) { unsigned int ucs; if (i >= srclen) {dst[count] = 0; return count;} ucs = src[i++]; if (ucs < 0x80U) { dst[count++] = ucs; if (count >= dstlen) {dst[count-1] = 0; break;} } else if (ucs < 0x800U) { /* 2 bytes */ if (count+2 >= dstlen) {dst[count] = 0; count += 2; break;} dst[count++] = 0xc0 | (ucs >> 6); dst[count++] = 0x80 | (ucs & 0x3F); } else if (ucs >= 0xd800 && ucs <= 0xdbff && i < srclen && src[i] >= 0xdc00 && src[i] <= 0xdfff) { /* surrogate pair */ unsigned int ucs2 = src[i++]; ucs = 0x10000U + ((ucs&0x3ff)<<10) + (ucs2&0x3ff); /* all surrogate pairs turn into 4-byte utf8 */ if (count+4 >= dstlen) {dst[count] = 0; count += 4; break;} dst[count++] = 0xf0 | (ucs >> 18); dst[count++] = 0x80 | ((ucs >> 12) & 0x3F); dst[count++] = 0x80 | ((ucs >> 6) & 0x3F); dst[count++] = 0x80 | (ucs & 0x3F); } else { /* all others are 3 bytes: */ if (count+3 >= dstlen) {dst[count] = 0; count += 3; break;} dst[count++] = 0xe0 | (ucs >> 12); dst[count++] = 0x80 | ((ucs >> 6) & 0x3F); dst[count++] = 0x80 | (ucs & 0x3F); } } } /* we filled dst, measure the rest: */ while (i < srclen) { unsigned int ucs = src[i++]; if (ucs < 0x80U) { count++; } else if (ucs < 0x800U) { /* 2 bytes */ count += 2; } else if (ucs >= 0xd800 && ucs <= 0xdbff && i < srclen-1 && src[i+1] >= 0xdc00 && src[i+1] <= 0xdfff) { /* surrogate pair */ ++i; count += 4; } else { count += 3; } } return count; } static wchar_t *wbuf[2] = {NULL, NULL}; static void setwbuf(int i, const char *f) { // all strings in GetDP are supposed to be UTF8-encoded, which is natively // supported by Mac and Linux. Windows does not support UTF-8, but UTF-16 // (through wchar_t), so we need to convert. if(i != 0 && i != 1) return; size_t l = strlen(f); unsigned int wn = utf8toUtf16(f, (unsigned int) l, NULL, 0) + 1; wbuf[i] = (wchar_t*)realloc(wbuf[i], sizeof(wchar_t)*wn); wn = utf8toUtf16(f, (unsigned int) l, (unsigned short *)wbuf[i], wn); wbuf[i][wn] = 0; } #endif FILE *FOpen(const char *f, const char *mode) { #if defined (WIN32) && !defined(__CYGWIN__) setwbuf(0, f); setwbuf(1, mode); return _wfopen(wbuf[0], wbuf[1]); #else return fopen(f, mode); #endif } void GetResources(double *s, long *mem) { #if defined(WIN32) && !defined(__CYGWIN__) FILETIME creation, exit, kernel, user; if(GetProcessTimes(GetCurrentProcess(), &creation, &exit, &kernel, &user)){ *s = 1.e-7 * 4294967296. * (double)user.dwHighDateTime + 1.e-7 * (double)user.dwLowDateTime; } PROCESS_MEMORY_COUNTERS info; GetProcessMemoryInfo(GetCurrentProcess(), &info, sizeof(info)); *mem = (long)info.PeakWorkingSetSize; #else static struct rusage r; getrusage(RUSAGE_SELF, &r); *s = (double)r.ru_utime.tv_sec + 1.e-6 * (double)r.ru_utime.tv_usec; #if defined(__APPLE__) *mem = (long)r.ru_maxrss; #else *mem = (long)(r.ru_maxrss * 1024L); #endif #endif } double GetTotalRam() { double ram = 0; #if defined(__APPLE__) int name[] = {CTL_HW, HW_MEMSIZE}; int64_t value; size_t len = sizeof(value); if(sysctl(name, 2, &value, &len, NULL, 0) != -1) ram = value / (1024 * 1024); #elif defined (WIN32) MEMORYSTATUSEX status; status.dwLength = sizeof(status); GlobalMemoryStatusEx(&status); ram = status.ullTotalPhys / ((double)1024 * 1024); #elif defined(BUILD_ANDROID) ram = 1024; #elif defined(__linux__) struct sysinfo infos; if(sysinfo(&infos) != -1) ram = infos.totalram * (unsigned long)infos.mem_unit / ((double)1024 * 1024); #endif return ram; } double GetTimeOfDay() { #if defined(WIN32) && !defined(__CYGWIN__) struct _timeb localTime; _ftime(&localTime); return localTime.time + 1.e-3 * localTime.millitm; #else struct timeval t; gettimeofday(&t, NULL); return t.tv_sec + 1.e-6 * t.tv_usec; #endif } void IncreaseStackSize() { #if !defined (WIN32) || defined(__CYGWIN__) static struct rlimit r; getrlimit(RLIMIT_STACK, &r); // Try to get at least 16 MB of stack. Running with too small a stack // can cause crashes in the recursive calls (cf. Cal_Quantity) if(r.rlim_cur < 16 * 1024 * 1024){ Message::Info("Increasing process stack size (%d kB < 16 MB)", r.rlim_cur / 1024); r.rlim_cur = r.rlim_max; setrlimit(RLIMIT_STACK, &r); } #endif } void SleepSeconds(double s) { #if defined(WIN32) && !defined(__CYGWIN__) Sleep((long)(1.e3 * s)); #else usleep((long)(1.e6 * s)); #endif } int BlockingSystemCall(const char *command) { #if defined(WIN32) STARTUPINFO suInfo; PROCESS_INFORMATION prInfo; memset(&suInfo, 0, sizeof(suInfo)); suInfo.cb = sizeof(suInfo); Message::Info("Calling '%s'", command); CreateProcess(NULL, (char*)command, NULL, NULL, FALSE, NORMAL_PRIORITY_CLASS, NULL, NULL, &suInfo, &prInfo); // wait until child process exits. WaitForSingleObject(prInfo.hProcess, INFINITE); // close process and thread handles. CloseHandle(prInfo.hProcess); CloseHandle(prInfo.hThread); return 0; #else if(!system(NULL)) { Message::Error("Could not find /bin/sh: aborting system call"); return 1; } Message::Info("Calling '%s'", command); return system(command); #endif } int RemoveFile(const std::string &fileName) { #if defined(WIN32) && !defined(__CYGWIN__) setwbuf(0, fileName.c_str()); return _wunlink(wbuf[0]); #else return unlink(fileName.c_str()); #endif } int RenameFile(const std::string &oldName, const std::string &newName) { #if defined(WIN32) && !defined(__CYGWIN__) setwbuf(0, oldName.c_str()); setwbuf(1, newName.c_str()); return _wrename(wbuf[0], wbuf[1]); #else return rename(oldName.c_str(), newName.c_str()); #endif } int CreateDir(const std::string &dirName) { if(dirName.empty()) return 1; #if defined(WIN32) && !defined(__CYGWIN__) setwbuf(0, dirName.c_str()); if(_wmkdir(wbuf[0])) return 0; #else if(mkdir(dirName.c_str(), 0777)) return 0; #endif return 1; } int CreateDirs(const std::string &dirName) { size_t cur = 0; int ret = 1; do { cur = dirName.find("/", cur + 1); if(!CreateDir(dirName.substr(0, cur))) ret = 0; } while(cur != std::string::npos); return ret; } std::string GetDir(const std::string &fileName) { #if defined(WIN32) && !defined(__CYGWIN__) setwbuf(0, fileName.c_str()); wchar_t path[MAX_PATH]; unsigned long size = GetFullPathNameW(wbuf[0], MAX_PATH, path, NULL); char dst[MAX_PATH] = ""; if(size) utf8FromUtf16(dst, MAX_PATH, path, size); #else char dst[4096] = ""; if(!realpath(fileName.c_str(), dst)) dst[0] = '\0'; #endif int i = strlen(dst); while(i > 0 && dst[i-1] != '/' && dst[i-1] != '\\') i--; dst[i] = '\0'; return dst; } getdp-2.7.0-source/Common/CMakeLists.txt000644 001750 001750 00000000640 12473553042 021576 0ustar00geuzainegeuzaine000000 000000 # GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege # # See the LICENSE.txt file for license information. Please report all # bugs and problems to the public mailing list . set(SRC ListUtils.cpp TreeUtils.cpp avl.cpp MallocUtils.cpp Message.cpp OS.cpp ) file(GLOB HDR RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} *.h) append_getdp_src(Common "${SRC};${HDR}") getdp-2.7.0-source/Common/onelab.h000644 001750 001750 00000170711 12534250750 020454 0ustar00geuzainegeuzaine000000 000000 // ONELAB - Copyright (C) 2011-2014 ULg-UCL // // Permission is hereby granted, free of charge, to any person // obtaining a copy of this software and associated documentation // files (the "Software"), to deal in the Software without // restriction, including without limitation the rights to use, copy, // modify, merge, publish, distribute, and/or sell copies of the // Software, and to permit persons to whom the Software is furnished // to do so, provided that the above copyright notice(s) and this // permission notice appear in all copies of the Software and that // both the above copyright notice(s) and this permission notice // appear in supporting documentation. // // THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, // EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF // MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND // NONINFRINGEMENT OF THIRD PARTY RIGHTS. IN NO EVENT SHALL THE // COPYRIGHT HOLDER OR HOLDERS INCLUDED IN THIS NOTICE BE LIABLE FOR // ANY CLAIM, OR ANY SPECIAL INDIRECT OR CONSEQUENTIAL DAMAGES, OR ANY // DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, // WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS // ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE // OF THIS SOFTWARE. // // Please report all bugs and problems to the public mailing list // . #ifndef _ONELAB_H_ #define _ONELAB_H_ #include #include #include #include #include #include #include #include #include "GmshSocket.h" #ifdef HAVE_ONELAB2 #include "NetworkUtils.h" #include "OnelabAttributes.h" #endif namespace onelab{ // The base parameter class. #ifdef HAVE_ONELAB2 class parameter : public OnelabAttr{ #else class parameter { #endif private: // the name of the parameter, including its '/'-separated path in the // parameter hierarchy. Parameters or subpaths can start with numbers to // force their relative ordering (such numbers are automatically hidden in // the interface). All strings in onelab are supposed to be UTF8-encoded. std::string _name; // the parameter label: if provided it serves as a better way to display the // parameter in the interface std::string _label; // a help string std::string _help; // map of clients that use this parameter, associated with a "changed" flag // (set to false if the client has already been run with the current value of // the parameter) std::map _clients; // flag indicating that the "changed" flags of this parameter will always be // reset to false when the parameter is updated bool _neverChanged; // should the parameter be visible in the interface? bool _visible; // sould the paramete be "read-only" (not settable by the user) bool _readOnly; protected: // optional additional attributes std::map _attributes; public: parameter(const std::string &name="", const std::string &label="", const std::string &help="") : _name(name), _label(label), _help(help), _neverChanged(false), _visible(true), _readOnly(false) {} virtual ~parameter(){} void setName(const std::string &name){ _name = name; } void setLabel(const std::string &label){ _label = label; } void setHelp(const std::string &help){ _help = help; } void setChanged(bool changed, const std::string &client="") { if(client.size()){ std::map::iterator it = _clients.find(client); if(it != _clients.end()) it->second = changed; } else{ for(std::map::iterator it = _clients.begin(); it != _clients.end(); it++) it->second = changed; } } void setNeverChanged(bool never){ _neverChanged = never; } void setVisible(bool visible){ _visible = visible; } void setReadOnly(bool readOnly){ _readOnly = readOnly; } void setAttribute(const std::string &key, const std::string &value) { _attributes[key] = value; } void setAttributes(const std::map &attributes) { _attributes = attributes; } void setClients(const std::map &clients){ _clients = clients; } void addClient(const std::string &client, bool changed) { if(_clients.find(client) == _clients.end()) _clients[client] = changed; } void addClients(const std::map &clients) { _clients.insert(clients.begin(), clients.end()); } bool hasClient(const std::string &client) { return (_clients.find(client) != _clients.end()); } int getNumClients() { return (int)_clients.size(); }; virtual std::string getType() const = 0; const std::string &getName() const { return _name; } const std::string &getLabel() const { return _label; } const std::string &getHelp() const { return _help; } std::string getPath() const { std::string::size_type last = _name.find_last_of('/'); return _name.substr(0, last); } std::string getShortName() const { if(_label.size()) return _label; std::string s = _name; // remove path std::string::size_type last = _name.find_last_of('/'); if(last != std::string::npos) s = _name.substr(last + 1); // remove starting braces: can be used to order parameters 'from the end', // as the ASCII code is after numbers and letters while(s.size() && (s[0] == '}' || s[0] == '{' || s[0] == '{')) s = s.substr(1); // remove starting numbers: can be used to order parameters 'from the // start' while(s.size() && s[0] >= '0' && s[0] <= '9') s = s.substr(1); return s; } bool getChanged(const std::string &client="") const { if(client.size()){ std::map::const_iterator it = _clients.find(client); if(it != _clients.end()) return it->second; else return false; } else{ for(std::map::const_iterator it = _clients.begin(); it != _clients.end(); it++){ if(it->second) return true; } return false; } } bool getNeverChanged() const { return _neverChanged; } bool getVisible() const { return _visible; } bool getReadOnly() const { return _readOnly; } std::string getAttribute(const std::string &key) const { std::map::const_iterator it = _attributes.find(key); if(it != _attributes.end()) return it->second; return ""; } const std::map &getAttributes() const { return _attributes; } const std::map &getClients() const { return _clients; } static char charSep() { return '\0'; } static double maxNumber() { return 1e200; } static std::string version() { return "1.1"; } static std::string getNextToken(const std::string &msg, std::string::size_type &first, char separator=charSep()) { if(first == std::string::npos) return ""; std::string::size_type last = msg.find_first_of(separator, first); std::string next(""); if(last == std::string::npos){ next = msg.substr(first); first = last; } else if(first == last){ next = ""; first = last + 1; } else{ next = msg.substr(first, last - first); first = last + 1; } return next; } static std::vector split(const std::string &msg, char separator=charSep()) { std::vector out; std::string::size_type first = 0; while(first != std::string::npos) out.push_back(getNextToken(msg, first, separator)); return out; } std::string sanitize(const std::string &in) const { std::string out(in); for(unsigned int i = 0; i < in.size(); i++) if(out[i] == charSep()) out[i] = ' '; return out; } virtual std::string toChar() const { std::ostringstream sstream; sstream << version() << charSep() << getType() << charSep() << sanitize(getName()) << charSep() << sanitize(getLabel()) << charSep() << sanitize(getHelp()) << charSep() << (getNeverChanged() ? 1 : 0) << charSep() << (getVisible() ? 1 : 0) << charSep() << (getReadOnly() ? 1 : 0) << charSep() << _attributes.size() << charSep(); for(std::map::const_iterator it = _attributes.begin(); it != _attributes.end(); it++) sstream << sanitize(it->first) << charSep() << sanitize(it->second) << charSep(); sstream << getClients().size() << charSep(); for(std::map::const_iterator it = getClients().begin(); it != getClients().end(); it++) sstream << sanitize(it->first) << charSep() << (it->second ? 1 : 0) << charSep(); return sstream.str(); } virtual std::string::size_type fromChar(const std::string &msg) { std::string::size_type pos = 0; if(getNextToken(msg, pos) != version()) return 0; if(getNextToken(msg, pos) != getType()) return 0; setName(getNextToken(msg, pos)); setLabel(getNextToken(msg, pos)); setHelp(getNextToken(msg, pos)); setNeverChanged(atoi(getNextToken(msg, pos).c_str())); setVisible(atoi(getNextToken(msg, pos).c_str())); setReadOnly(atoi(getNextToken(msg, pos).c_str())); int numAttributes = atoi(getNextToken(msg, pos).c_str()); for(int i = 0; i < numAttributes; i++){ std::string key(getNextToken(msg, pos)); setAttribute(key, getNextToken(msg, pos)); } int numClients = atoi(getNextToken(msg, pos).c_str()); for(int i = 0; i < numClients; i++){ std::string client(getNextToken(msg, pos)); int changed = atoi(getNextToken(msg, pos).c_str()); addClient(client, changed ? true : false); } return pos; } static void getInfoFromChar(const std::string &msg, std::string &version, std::string &type, std::string &name) { std::string::size_type first = 0; version = getNextToken(msg, first); type = getNextToken(msg, first); name = getNextToken(msg, first); } static bool fromFile(std::vector &msg, FILE *fp) { msg.clear(); char tmp[1000]; if(!fgets(tmp, sizeof(tmp), fp)) return false; // first line is comment while(!feof(fp)){ int numc = 0; if(!fscanf(fp, "%d ", &numc)) break; // space is important if(!numc) break; msg.push_back(""); for(int i = 0; i < numc; i++) msg.back() += fgetc(fp); if(!fgets(tmp, sizeof(tmp), fp)) break; // end of line } return true; } static bool toFile(const std::vector &msg, FILE *fp, const std::string &creator) { time_t now; time(&now); fprintf(fp, "ONELAB database created by %s on %s", creator.c_str(), ctime(&now)); for(unsigned int i = 0; i < msg.size(); i++){ fprintf(fp, "%d ", (int)msg[i].size()); for(unsigned int j = 0; j < msg[i].size(); j++) fputc(msg[i][j], fp); fputc('\n', fp); } return true; } #ifdef HAVE_ONELAB2 static UInt16 attributeType() {return 0x05;} virtual inline UInt16 getAttributeType() const {return this->attributeType();} virtual inline UInt16 getAttributeLength() const { UInt16 len = _name.length()+_label.length()+_help.length()+10; for(std::map::const_iterator it = getClients().begin(); it != getClients().end(); it++) len += it->first.size()+2; for(std::map::const_iterator it = _attributes.begin(); it != _attributes.end(); it++) len += it->first.size()+it->second.size()+2; return len; } virtual UInt8 *encodeAttribute(UInt8 *dst) { dst = encode(dst, getAttributeType()); dst = encode(dst, getAttributeLength()); dst = encode(dst, (UInt8 *)_name.c_str(), this->_name.length()+1); dst = encode(dst, (UInt8 *)_label.c_str(), this->_label.length()+1); dst = encode(dst, (UInt8 *)_help.c_str(), this->_help.length()+1); dst = encode(dst, (UInt8)_readOnly); dst = encode(dst, (UInt8)_neverChanged); dst = encode(dst, (UInt8)_visible); dst = encode(dst, (UInt16)_attributes.size()); for(std::map::const_iterator it = _attributes.begin(); it != _attributes.end(); it++) { dst = encode(dst, (UInt8 *)it->first.c_str(), it->first.size()+1); dst = encode(dst, (UInt8 *)it->second.c_str(), it->second.size()+1); } dst = encode(dst, (UInt16)_clients.size()); for(std::map::const_iterator it = getClients().begin(); it != getClients().end(); it++) { dst = encode(dst, (UInt8 *)it->first.c_str(), it->first.size()+1); dst = encode(dst, (UInt8)it->second); } return dst; } virtual UInt8 *parseAttribute(UInt8 *src, UInt32 length) { UInt8 tmp; UInt16 n; src = parse(src, _name, '\0'); src = parse(src, _label, '\0'); src = parse(src, _help, '\0'); src = parse(src, tmp); this->_readOnly = (bool)tmp; src = parse(src, tmp); this->_neverChanged = (bool)tmp; src = parse(src, tmp); this->_visible = (bool)tmp; src = parse(src, n); for(int i=0; igetName() < p2->getName(); } }; // The number class. Numbers are stored internally as double precision real // numbers. All more complicated types (complex numbers, vectors, etc.) are // supposed to be either exchanged as strings or encapsulated in functions. class number : public parameter{ private: double _value, _min, _max, _step; // when in a loop, indicates current index in the vector _choices; // is -1 when not in a loop int _index; std::vector _choices; std::map _valueLabels; public: number(const std::string &name="", double value=0., const std::string &label="", const std::string &help="") : parameter(name, label, help), _value(value), _min(-maxNumber()), _max(maxNumber()), _step(0.), _index(-1) {} void setValue(double value){ _value = value; } void setMin(double min){ _min = min; } void setMax(double max){ _max = max; } void setStep(double step){ _step = step; } void setIndex(int index){ _index = index; } void setChoices(const std::vector &choices){ _choices = choices; } void setChoiceLabels(const std::vector &labels) { if(labels.size() != _choices.size()) return; for(unsigned int i = 0; i < _choices.size(); i++) _valueLabels[_choices[i]] = labels[i]; } void setValueLabels(const std::map &valueLabels) { _valueLabels = valueLabels; } void setValueLabel(double value, const std::string &label) { _valueLabels[value] = label; } std::string getType() const { return "number"; } double getValue() const { return _value; } double getMin() const { return _min; } double getMax() const { return _max; } double getStep() const { return _step; } int getIndex() const { return _index; } const std::vector &getChoices() const { return _choices; } const std::map &getValueLabels() const { return _valueLabels; } std::string getValueLabel(double value) const { std::map::const_iterator it = _valueLabels.find(value); if(it != _valueLabels.end()) return it->second; return ""; } void update(const number &p) { addClients(p.getClients()); setLabel(p.getLabel()); setHelp(p.getHelp()); setVisible(p.getVisible()); setReadOnly(p.getReadOnly()); setAttributes(p.getAttributes()); if(p.getValue() != getValue()){ setValue(p.getValue()); setChanged(true); } setMin(p.getMin()); setMax(p.getMax()); setStep(p.getStep()); setIndex(p.getIndex()); setChoices(p.getChoices()); setValueLabels(p.getValueLabels()); if(getNeverChanged()) setChanged(false); } std::string toChar() const { std::ostringstream sstream; sstream.precision(16); sstream << parameter::toChar() << _value << charSep() << _min << charSep() << _max << charSep() << _step << charSep() << _index << charSep() << _choices.size() << charSep(); for(unsigned int i = 0; i < _choices.size(); i++) sstream << _choices[i] << charSep(); sstream << _valueLabels.size() << charSep(); for(std::map::const_iterator it = _valueLabels.begin(); it != _valueLabels.end(); it++){ sstream << it->first << charSep(); sstream << sanitize(it->second) << charSep(); } return sstream.str(); } std::string::size_type fromChar(const std::string &msg) { std::string::size_type pos = parameter::fromChar(msg); if(!pos) return 0; setValue(atof(getNextToken(msg, pos).c_str())); setMin(atof(getNextToken(msg, pos).c_str())); setMax(atof(getNextToken(msg, pos).c_str())); setStep(atof(getNextToken(msg, pos).c_str())); setIndex(atoi(getNextToken(msg, pos).c_str())); _choices.resize(atoi(getNextToken(msg, pos).c_str())); for(unsigned int i = 0; i < _choices.size(); i++) _choices[i] = atof(getNextToken(msg, pos).c_str()); int numValueLabels = atoi(getNextToken(msg, pos).c_str()); for(int i = 0; i < numValueLabels; i++){ double value = atof(getNextToken(msg, pos).c_str()); _valueLabels[value] = getNextToken(msg, pos); } return pos; } #ifdef HAVE_ONELAB2 static UInt16 attributeType() {return 0x06;} virtual inline UInt16 getAttributeType() const {return this->attributeType();} virtual inline UInt16 getAttributeLength() const { UInt16 len = parameter::getAttributeLength()+sizeof(double)*4+8+sizeof(double)*_choices.size(); for(std::map::const_iterator it = _valueLabels.begin(); it != _valueLabels.end(); it++) len += it->second.size()+1+sizeof(double); return len; } UInt8 *encodeAttribute(UInt8 *dst) { dst = parameter::encodeAttribute(dst); dst = encode(dst, _value); dst = encode(dst, _min); dst = encode(dst, _max); dst = encode(dst, _step); dst = encode(dst, (UInt32)_index); dst = encode(dst, (UInt16)_choices.size()); for(unsigned int i = 0; i < _choices.size(); i++) dst = encode(dst, _choices[i]); dst = encode(dst, (UInt16)_valueLabels.size()); for(std::map::const_iterator it = _valueLabels.begin(); it != _valueLabels.end(); it++) { dst = encode(dst, it->first); dst = encode(dst, (UInt8 *)it->second.c_str(), it->second.size()+1); } return dst; } UInt8 *parseAttribute(UInt8 *src, UInt32 length) { UInt16 n; src = parameter::parseAttribute(src, length); src = parse(src, _value); src = parse(src, _min); src = parse(src, _max); src = parse(src, _step); src = parse(src, *(UInt32 *)&_index); src = parse(src, n); _choices.resize(n); for(unsigned int i = 0; i < n; i++) src = parse(src, _choices[i]); src = parse(src, n); for(int i=0; i_value << std::endl << "Min: " << this->_min << std::endl << "Max: " << this->_max << std::endl; } #endif }; // The string class. A string has a mutable "kind": we do not derive // specialized classes, because the kind should be changeable at runtime // (e.g. from a client-dependent mathematical expression to a table of // values). Kinds currently recognized by Gmsh are: "file". Possible // kinds could be "complex", "matrix m n", "hostname", client-dependent // mathematical expression, onelab mathematical expression (through mathex?), // ... class string : public parameter{ private: std::string _value, _kind; std::vector _choices; public: string(const std::string &name="", const std::string &value="", const std::string &label="", const std::string &help="") : parameter(name, label, help), _value(value), _kind("generic") {} void setValue(const std::string &value){ _value = value; } void setKind(const std::string &kind){ _kind = kind; } void setChoices(const std::vector &choices){ _choices = choices; } std::string getType() const { return "string"; } const std::string &getValue() const { return _value; } const std::string &getKind() const { return _kind; } const std::vector &getChoices() const { return _choices; } void update(const string &p) { addClients(p.getClients()); setLabel(p.getLabel()); setHelp(p.getHelp()); setVisible(p.getVisible()); setReadOnly(p.getReadOnly()); setAttributes(p.getAttributes()); if(p.getValue() != getValue()){ setValue(p.getValue()); setChanged(true); } if(p.getKind() != getKind()){ setKind(p.getKind()); setChanged(true); } setChoices(p.getChoices()); if(getNeverChanged()) setChanged(false); } std::string toChar() const { std::ostringstream sstream; sstream << parameter::toChar() << sanitize(_value) << charSep() << sanitize(_kind) << charSep() << _choices.size() << charSep(); for(unsigned int i = 0; i < _choices.size(); i++) sstream << sanitize(_choices[i]) << charSep(); return sstream.str(); } std::string::size_type fromChar(const std::string &msg) { std::string::size_type pos = parameter::fromChar(msg); if(!pos) return 0; setValue(getNextToken(msg, pos)); setKind(getNextToken(msg, pos)); _choices.resize(atoi(getNextToken(msg, pos).c_str())); for(unsigned int i = 0; i < _choices.size(); i++) _choices[i] = getNextToken(msg, pos); return pos; } #ifdef HAVE_ONELAB2 static UInt16 attributeType() {return 0x07;} virtual inline UInt16 getAttributeType() const {return this->attributeType();} virtual inline UInt16 getAttributeLength() const { UInt16 len = parameter::getAttributeLength(); len += _value.size()+_kind.size()+4; for(unsigned int i = 0; i < _choices.size(); i++) len += _choices[i].size()+1; return len; } UInt8 *encodeAttribute(UInt8 *dst) { dst = parameter::encodeAttribute(dst); dst = encode(dst, (UInt8 *)_value.c_str(), _value.size()+1); dst = encode(dst, (UInt8 *)_kind.c_str(), _kind.size()+1); dst = encode(dst, (UInt16)_choices.size()); for(unsigned int i = 0; i < _choices.size(); i++) dst = encode(dst, (UInt8 *)_choices[i].c_str(), _choices[i].size()+1); return dst; } UInt8 *parseAttribute(UInt8 *src, UInt32 length) { UInt16 n; src = parameter::parseAttribute(src, length); src = parse(src, _value, '\0'); src = parse(src, _kind, '\0'); src = parse(src, n); _choices.resize(n); for(unsigned int i=0; i_value << std::endl; } #endif }; // The region class. A region can be any kind of geometrical entity, // represented as identifiers of physical regions. Operations on regions will // include union, intersection, etc. class region : public parameter{ private: std::set _value; // optional geometrical dimension int _dimension; std::vector > _choices; public: region(const std::string &name="", const std::set &value = std::set(), const std::string &label="", const std::string &help="") : parameter(name, label, help), _value(value), _dimension(-1) {} region(const std::string &name, const std::string &value, const std::string &label="", const std::string &help="") : parameter(name, label, help), _dimension(-1) { if(value.size()) _value.insert(value); } void setValue(const std::set &value){ _value = value; } void setDimension(int dim){ _dimension = dim; } void setChoices(const std::vector > &choices) { _choices = choices; } std::string getType() const { return "region"; } const std::set &getValue() const { return _value; } int getDimension() const { return _dimension; } const std::vector > &getChoices() const { return _choices; } void update(const region &p) { addClients(p.getClients()); setLabel(p.getLabel()); setHelp(p.getHelp()); setAttributes(p.getAttributes()); if(p.getValue() != getValue()){ setValue(p.getValue()); setChanged(true); } setDimension(p.getDimension()); setChoices(p.getChoices()); if(getNeverChanged()) setChanged(false); } std::string toChar() const { std::ostringstream sstream; sstream << parameter::toChar() << _value.size() << charSep(); for(std::set::const_iterator it = _value.begin(); it != _value.end(); it++) sstream << sanitize(*it) << charSep(); sstream << _dimension << charSep(); sstream << _choices.size() << charSep(); for(unsigned int i = 0; i < _choices.size(); i++){ sstream << _choices[i].size() << charSep(); for(std::set::const_iterator it = _choices[i].begin(); it != _choices[i].end(); it++) sstream << sanitize(*it) << charSep(); } return sstream.str(); } std::string::size_type fromChar(const std::string &msg) { std::string::size_type pos = parameter::fromChar(msg); if(!pos) return 0; int n = atoi(getNextToken(msg, pos).c_str()); for(int i = 0; i < n; i++) _value.insert(getNextToken(msg, pos)); setDimension(atoi(getNextToken(msg, pos).c_str())); _choices.resize(atoi(getNextToken(msg, pos).c_str())); for(unsigned int i = 0; i < _choices.size(); i++){ n = atoi(getNextToken(msg, pos).c_str()); for(int i = 0; i < n; i++) _choices[i].insert(getNextToken(msg, pos)); } return pos; } #ifdef HAVE_ONELAB2 static UInt16 attributeType() {return 0x08;} virtual inline UInt16 getAttributeType() const {return this->attributeType();} virtual inline UInt16 getAttributeLength() const { UInt16 len = parameter::getAttributeLength(); len += 2; for(std::set::const_iterator it = _value.begin(); it != _value.end(); it++) len += it->size()+1; len += 4; len += 2; for(unsigned int i = 0; i < _choices.size(); i++){ len += 2; for(std::set::const_iterator it = _choices[i].begin(); it != _choices[i].end(); it++) len += it->size()+1; } return len; } UInt8 *encodeAttribute(UInt8 *dst) { dst = parameter::encodeAttribute(dst); dst = encode(dst, (UInt16)this->_value.size()); for(std::set::const_iterator it = _value.begin(); it != _value.end(); it++) dst = encode(dst, (UInt8 *)it->c_str(), it->size()+1); dst = encode(dst, (UInt32)_dimension); dst = encode(dst, (UInt16)_choices.size()); for(unsigned int i = 0; i < _choices.size(); i++){ dst = encode(dst, (UInt16)_choices[i].size()); for(std::set::const_iterator it = _choices[i].begin(); it != _choices[i].end(); it++) dst = encode(dst, (UInt8 *)it->c_str(), it->size()+1); } return dst; } UInt8 *parseAttribute(UInt8 *src, UInt32 len) { src = parameter::parseAttribute(src, len); UInt16 m = 0, n = 0; std::string value; src = parse(src, n); for(int i=0; i _value; std::vector > _choices; public: function(const std::string &name="") : parameter(name, "", "") {} function(const std::string &name, const std::map &value, const std::string &label="", const std::string &help="") : parameter(name, label, help), _value(value) {} void setValue(const std::map &value) { _value = value; } void setChoices(const std::vector > &choices) { _choices = choices; } std::string getType() const { return "function"; } const std::map &getValue() const { return _value; } const std::string getValue(const std::string ®ion) const { std::map::const_iterator it = _value.find(region); if(it != _value.end()) return it->second; return ""; } const std::vector > &getChoices() const { return _choices; } void update(const function &p) { addClients(p.getClients()); setLabel(p.getLabel()); setHelp(p.getHelp()); setAttributes(p.getAttributes()); if(p.getValue() != getValue()){ setValue(p.getValue()); setChanged(true); } setChoices(p.getChoices()); if(getNeverChanged()) setChanged(false); } std::string toChar() const { std::ostringstream sstream; sstream << parameter::toChar() << _value.size() << charSep(); for(std::map::const_iterator it = _value.begin(); it != _value.end(); it++) sstream << sanitize(it->first) << charSep() << sanitize(it->second) << charSep(); sstream << _choices.size() << charSep(); for(unsigned int i = 0; i < _choices.size(); i++){ sstream << _choices[i].size() << charSep(); for(std::map::const_iterator it = _choices[i].begin(); it != _choices[i].end(); it++) sstream << sanitize(it->first) << charSep() << sanitize(it->second) << charSep(); } return sstream.str(); } std::string::size_type fromChar(const std::string &msg) { std::string::size_type pos = parameter::fromChar(msg); if(!pos) return 0; int n = atoi(getNextToken(msg, pos).c_str()); for(int i = 0; i < n; i++){ std::string key = getNextToken(msg, pos); _value[key] = getNextToken(msg, pos); } _choices.resize(atoi(getNextToken(msg, pos).c_str())); for(unsigned int i = 0; i < _choices.size(); i++){ n = atoi(getNextToken(msg, pos).c_str()); for(int i = 0; i < n; i++){ std::string key = getNextToken(msg, pos); _choices[i][key] = getNextToken(msg, pos); } } return pos; } #ifdef HAVE_ONELAB2 static UInt16 attributeType() {return 0x09;} virtual inline UInt16 getAttributeType() const {return this->attributeType();} virtual inline UInt16 getAttributeLength() const { UInt16 len = parameter::getAttributeLength(); len += 2; for(std::map::const_iterator it = _value.begin(); it != _value.end(); it++) len += 2+it->first.size()+it->second.size(); for(unsigned int i = 0; i < _choices.size(); i++){ len += 2; for(std::map::const_iterator it = _choices[i].begin(); it != _choices[i].end(); it++) { len += 2+it->first.size()+it->second.size(); } } return len; } UInt8 *encodeAttribute(UInt8 *dst) { dst = parameter::encodeAttribute(dst), dst = encode(dst, (UInt16)this->_value.size()); for(std::map::const_iterator it = _value.begin(); it != _value.end(); it++) { dst = encode(dst, (UInt8 *)it->first.c_str(), it->first.size()+1); dst = encode(dst, (UInt8 *)it->second.c_str(), it->second.size()+1); } dst = encode(dst, (UInt16)_choices.size()); for(unsigned int i = 0; i < _choices.size(); i++){ dst = encode(dst, (UInt16)_choices[i].size()); for(std::map::const_iterator it = _choices[i].begin(); it != _choices[i].end(); it++) { dst = encode(dst, (UInt8 *)it->first.c_str(), it->first.size()+1); dst = encode(dst, (UInt8 *)it->second.c_str(), it->second.size()+1); } } return dst; } UInt8 *parseAttribute(UInt8 *src, UInt32 len) { src = parameter::parseAttribute(src, len); UInt16 m = 0, n = 0; std::string key, value; src = parse(src, n); for(int i=0; i _numbers; std::set _strings; std::set _regions; std::set _functions; // delete a parameter from the parameter space template bool _clear(const std::string &name, const std::string &client, std::set &ps) { if(name.empty() && client.size()){ std::vector toDelete; for(typename std::set::iterator it = ps.begin(); it != ps.end(); ){ T *p = *it; if(p->hasClient(client)){ ps.erase(it++); // to avoid invalid iterator delete p; } else{ it++; } } } else{ T tmp(name); typename std::set::iterator it = ps.find(&tmp); if(it != ps.end()){ T *p = *it; if(client.empty() || p->hasClient(client)){ ps.erase(it); delete p; return true; } } } return false; } // set a parameter in the parameter space; if it already exists, update it // (adding new clients if necessary). This would need to be locked to avoid // race conditions when several clients try to set a parameter at the same // time. template bool _set(const T &p, const std::string &client, std::set &ps) { typename std::set::iterator it = ps.find((T*)&p); if(it != ps.end()){ (*it)->update(p); if(client.size()) (*it)->addClient(client, true); } else{ T* newp = new T(p); #ifdef HAVE_ONELAB2 newp->isInDatabase(true); #endif if(client.size()) newp->addClient(client, true); ps.insert(newp); } return true; } // get the parameter matching the given name, or all the parameters in the // category if no name is given. If we find a given parameter by name, we // add the client requesting the parameter to the list of clients for this // parameter. This would also need to be locked. template bool _get(std::vector &p, const std::string &name, const std::string &client, std::set &ps) { p.clear(); if(name.empty()){ for(typename std::set::iterator it = ps.begin(); it != ps.end(); it++) p.push_back(**it); } else{ T tmp(name); typename std::set::iterator it = ps.find(&tmp); if(it != ps.end()){ if(client.size()) (*it)->addClient(client, true); p.push_back(**it); } } return true; } template T* _getPtr(std::string name, const std::string client, std::set ps) { T tmp(name); typename std::set::iterator it = ps.find(&tmp); if(it != ps.end()){ if(client.size()) (*it)->addClient(client, true); return *it; } return NULL; } void _getAllParameters(std::set &ps) const { ps.insert(_numbers.begin(), _numbers.end()); ps.insert(_strings.begin(), _strings.end()); ps.insert(_regions.begin(), _regions.end()); ps.insert(_functions.begin(), _functions.end()); } public: parameterSpace(){} ~parameterSpace(){ clear(); } void clear(const std::string &name="", const std::string &client="") { if(name.empty() && client.empty()){ std::set ps; _getAllParameters(ps); for(std::set::iterator it = ps.begin(); it != ps.end(); it++) delete *it; _numbers.clear(); _strings.clear(); _regions.clear(); _functions.clear(); } else{ bool done = _clear(name, client, _numbers); if(!done) done = _clear(name, client, _strings); if(!done) done = _clear(name, client, _regions); if(!done) done = _clear(name, client, _functions); } } bool set(const number &p, const std::string &client=""){ return _set(p, client, _numbers); } bool set(const string &p, const std::string &client=""){ return _set(p, client, _strings); } bool set(const region &p, const std::string &client=""){ return _set(p, client, _regions); } bool set(const function &p, const std::string &client=""){ return _set(p, client, _functions); } bool get(std::vector &ps, const std::string &name="", const std::string &client=""){ return _get(ps, name, client, _numbers); } bool get(std::vector &ps, const std::string &name="", const std::string &client=""){ return _get(ps, name, client, _strings); } bool get(std::vector &ps, const std::string &name="", const std::string &client=""){ return _get(ps, name, client, _regions); } bool get(std::vector &ps, const std::string &name="", const std::string &client=""){ return _get(ps, name, client, _functions); } void getPtr(number **ptr, const std::string name, const std::string client="") {*ptr = _getPtr(name, client, _numbers);} void getPtr(string **ptr, const std::string name, const std::string client="") {*ptr = _getPtr(name, client, _strings);} void getPtr(region **ptr, const std::string name, const std::string client="") {*ptr = _getPtr(name, client, _regions);} void getPtr(function **ptr, const std::string name, const std::string client="") {*ptr = _getPtr(name, client, _functions);} void getAllParameters(std::set &ps) const { ps.insert(_numbers.begin(), _numbers.end()); ps.insert(_strings.begin(), _strings.end()); ps.insert(_regions.begin(), _regions.end()); ps.insert(_functions.begin(), _functions.end()); } unsigned int getNumParameters() { return (int)(_numbers.size() + _strings.size() + _regions.size() + _functions.size()); } // check if at least one parameter depends on the given client bool hasClient(const std::string &client) const { std::set ps; _getAllParameters(ps); for(std::set::iterator it = ps.begin(); it != ps.end(); it++) if((*it)->hasClient(client)) return true; return false; } // check if some parameters have changed (optionnally only check the // parameters that depend on a given client) bool getChanged(const std::string &client="") const { std::set ps; _getAllParameters(ps); for(std::set::iterator it = ps.begin(); it != ps.end(); it++){ if((*it)->getChanged(client)){ return true; } } return false; } // set the changed flag for all the parameters that depend on the given // client (or for all parameters if no client name is provided) void setChanged(bool changed, const std::string &client="") { std::set ps; _getAllParameters(ps); for(std::set::iterator it = ps.begin(); it != ps.end(); it++) (*it)->setChanged(changed, client); } // serialize the parameter space (optionally only serialize those parameters // that depend on the given client) std::vector toChar(const std::string &client="") const { std::vector s; std::set ps; _getAllParameters(ps); for(std::set::const_iterator it = ps.begin(); it != ps.end(); it++) if(client.empty() || (*it)->hasClient(client)){ if((*it)->getAttribute("NotInDb") != "True") s.push_back((*it)->toChar()); } return s; } // unserialize the parameter space bool fromChar(const std::vector &msg, const std::string &client="") { for(unsigned int i = 0; i < msg.size(); i++){ std::string version, type, name; onelab::parameter::getInfoFromChar(msg[i], version, type, name); if(onelab::parameter::version() != version) return false; if(type == "number"){ onelab::number p; p.fromChar(msg[i]); set(p, client); } else if(type == "string"){ onelab::string p; p.fromChar(msg[i]); set(p, client); } else if(type == "region"){ onelab::region p; p.fromChar(msg[i]); set(p, client); } else if(type == "function"){ onelab::function p; p.fromChar(msg[i]); set(p, client); } else return false; } return true; } }; // The onelab client: a class that communicates with the onelab server. Each // client should be derived from this one. A client can be understood as "one // simulation step in a complex computation". class client{ protected: // the name of the client std::string _name; // the id of the client, used to create a unique socket for this client int _id; // the index of the client in an external client list (if any) int _index; public: client(const std::string &name) : _name(name), _id(0), _index(-1){} virtual ~client(){} std::string getName(){ return _name; } void setId(int id){ _id = id; } int getId(){ return _id; } void setIndex(int index){ _index = index; } int getIndex(){ return _index; } virtual bool run(){ return false; } virtual bool isNetworkClient(){ return false; } virtual bool kill(){ return false; } virtual void sendInfo(const std::string &msg){ std::cout << msg << std::endl; } virtual void sendWarning(const std::string &msg){ std::cerr << msg << std::endl; } virtual void sendError(const std::string &msg){ std::cerr << msg << std::endl; } virtual void sendProgress(const std::string &msg){ std::cout << msg << std::endl; } virtual void sendMergeFileRequest(const std::string &msg){} virtual void sendOpenProjectRequest(const std::string &msg){} virtual void sendParseStringRequest(const std::string &msg){} virtual void sendVertexArray(const std::string &msg){} virtual bool clear(const std::string &name) = 0; virtual bool set(const number &p) = 0; virtual bool set(const string &p) = 0; virtual bool set(const region &p) = 0; virtual bool set(const function &p) = 0; virtual bool get(std::vector &ps, const std::string &name="") = 0; virtual bool get(std::vector &ps, const std::string &name="") = 0; virtual bool get(std::vector &ps, const std::string &name="") = 0; virtual bool get(std::vector &ps, const std::string &name="") = 0; std::vector toChar() { std::vector out; std::vector n; get(n); for(unsigned int i = 0; i < n.size(); i++) out.push_back(n[i].toChar()); std::vector s; get(s); for(unsigned int i = 0; i < s.size(); i++) out.push_back(s[i].toChar()); std::vector r; get(r); for(unsigned int i = 0; i < r.size(); i++) out.push_back(r[i].toChar()); std::vector f; get(f); for(unsigned int i = 0; i < f.size(); i++) out.push_back(f[i].toChar()); return out; } bool fromChar(const std::vector &msg) { for(unsigned int i = 0; i < msg.size(); i++){ std::string version, type, name; onelab::parameter::getInfoFromChar(msg[i], version, type, name); if(onelab::parameter::version() != version) return false; if(type == "number"){ onelab::number p; p.fromChar(msg[i]); set(p); } else if(type == "string"){ onelab::string p; p.fromChar(msg[i]); set(p); } else if(type == "region"){ onelab::region p; p.fromChar(msg[i]); set(p); } else if(type == "function"){ onelab::function p; p.fromChar(msg[i]); set(p); } else return false; } return true; } bool toFile(FILE *fp) { return parameter::toFile(toChar(), fp, getName()); } bool fromFile(FILE *fp) { std::vector msg; if(parameter::fromFile(msg, fp)) return fromChar(msg); return false; } }; // The onelab server: a singleton that stores the parameter space and // interacts with onelab clients. class server{ private: // the unique server (singleton behaviour due to the "static" specifier) static server *_server; // the address of the server std::string _address; // the connected clients std::set _clients; // the parameter space parameterSpace _parameterSpace; public: server(const std::string &address="") : _address(address) {} ~server(){} static server *instance(const std::string &address="") { if(!_server) _server = new server(address); return _server; } static void setInstance(server *s) { _server = s; } void clear(const std::string &name="", const std::string &client="") { _parameterSpace.clear(name, client); } template bool set(const T &p, const std::string &client="") { return _parameterSpace.set(p, client); } template bool get(std::vector &ps, const std::string &name="", const std::string &client="") { return _parameterSpace.get(ps, name, client); } typedef std::set::iterator citer; citer firstClient(){ return _clients.begin(); } citer lastClient(){ return _clients.end(); } int getNumClients() { return (int)_clients.size(); }; citer findClient(const std::string &name) { for(citer it = _clients.begin(); it != _clients.end(); it++) if((*it)->getName() == name) return it; return _clients.end(); } void registerClient(client *c) { _clients.insert(c); c->setId(_clients.size()); } void unregisterClient(client *c){ _clients.erase(c); } void setChanged(bool changed, const std::string &client="") { _parameterSpace.setChanged(changed, client); } bool getChanged(const std::string &client="") { return _parameterSpace.getChanged(client); } unsigned int getNumParameters(){ return _parameterSpace.getNumParameters(); } std::vector toChar(const std::string &client="") { return _parameterSpace.toChar(client); } bool fromChar(const std::vector &msg, const std::string &client="") { return _parameterSpace.fromChar(msg, client); } bool toFile(FILE *fp, const std::string &client="") { return parameter::toFile(toChar(client), fp, "onelab server"); } bool fromFile(FILE *fp, const std::string &client="") { std::vector msg; if(parameter::fromFile(msg, fp)) return fromChar(msg, client); return false; } }; // A local client, which lives in the same memory space as the server. class localClient : public client{ private: template bool _set(const T &p) { server::instance()->set(p, _name); return true; } template bool _get(std::vector &ps, const std::string &name="") { server::instance()->get(ps, name, _name); return true; } public: localClient(const std::string &name) : client(name) { server::instance()->registerClient(this); } virtual ~localClient() { server::instance()->unregisterClient(this); } virtual bool clear(const std::string &name="") { server::instance()->clear(name); return true; } virtual bool set(const number &p){ return _set(p); } virtual bool set(const string &p){ return _set(p); } virtual bool set(const function &p){ return _set(p); } virtual bool set(const region &p){ return _set(p); } virtual bool get(std::vector &ps, const std::string &name=""){ return _get(ps, name); } virtual bool get(std::vector &ps, const std::string &name=""){ return _get(ps, name); } virtual bool get(std::vector &ps, const std::string &name=""){ return _get(ps, name); } virtual bool get(std::vector &ps, const std::string &name=""){ return _get(ps, name); } }; // The local part of a network client. class localNetworkClient : public localClient{ private: // executable of the client (including filesystem path, if necessary) std::string _executable; // treat the executable name as a full command line (will prevent the // escaping of the exe name, and will assume that the command line has been // correcly escaped) bool _treatExecutableAsFullCommandLine; // command to login to a remote host (if necessary) std::string _remoteLogin; // command line option to specify socket std::string _socketSwitch; // pid of the remote network client while it is running (-1 otherwise) int _pid; // underlying GmshServer GmshServer *_gmshServer; public: localNetworkClient(const std::string &name, const std::string &executable, const std::string &remoteLogin="", bool treatExecutableAsFullCommandLine=false) : localClient(name), _executable(executable), _treatExecutableAsFullCommandLine(treatExecutableAsFullCommandLine), _remoteLogin(remoteLogin), _socketSwitch("-onelab"), _pid(-1), _gmshServer(0) {} virtual ~localNetworkClient(){} virtual bool isNetworkClient(){ return true; } const std::string &getExecutable(){ return _executable; } void setExecutable(const std::string &s){ _executable = s; } const std::string &getRemoteLogin(){ return _remoteLogin; } bool treatExecutableAsFullCommandLine() const { return _treatExecutableAsFullCommandLine; } void setRemoteLogin(const std::string &s){ _remoteLogin = s; } const std::string &getSocketSwitch(){ return _socketSwitch; } void setSocketSwitch(const std::string &s){ _socketSwitch = s; } int getPid(){ return _pid; } void setPid(int pid){ _pid = pid; } GmshServer *getGmshServer(){ return _gmshServer; } void setGmshServer(GmshServer *server){ _gmshServer = server; } virtual bool run() = 0; virtual bool kill() = 0; }; // The remote part of a network client. class remoteNetworkClient : public client{ private: // address (inet:port or unix socket) of the server std::string _serverAddress; // underlying GmshClient GmshClient *_gmshClient; // number of subclients int _numSubClients; template bool _set(const T &p) { if(!_gmshClient) return false; std::string msg = p.toChar(); _gmshClient->SendMessage(GmshSocket::GMSH_PARAMETER, msg.size(), &msg[0]); return true; } template bool _get(std::vector &ps, const std::string &name="") { ps.clear(); if(!_gmshClient) return false; T p(name); std::string msg = p.toChar(); if (name.size()) _gmshClient->SendMessage(GmshSocket::GMSH_PARAMETER_QUERY, msg.size(), &msg[0]); else // get all parameters _gmshClient->SendMessage(GmshSocket::GMSH_PARAMETER_QUERY_ALL, msg.size(), &msg[0]); while(1){ // stop if we have no communications for 5 minutes int ret = _gmshClient->Select(500, 0); if(!ret){ _gmshClient->Info("Timout: aborting remote get"); return false; } else if(ret < 0){ _gmshClient->Error("Error on select: aborting remote get"); return false; } int type, length, swap; if(!_gmshClient->ReceiveHeader(&type, &length, &swap)){ _gmshClient->Error("Did not receive message header: aborting remote get"); return false; } std::string msg(length, ' '); if(!_gmshClient->ReceiveMessage(length, &msg[0])){ _gmshClient->Error("Did not receive message body: aborting remote get"); return false; } if(type == GmshSocket::GMSH_PARAMETER){ T p; p.fromChar(msg); ps.push_back(p); return true; } if(type == GmshSocket::GMSH_PARAMETER_QUERY_ALL){ T p; p.fromChar(msg); ps.push_back(p); // do NOT return until all parameters have been downloaded } else if(type == GmshSocket::GMSH_PARAMETER_QUERY_END){ // all parameters have been sent return true; } else if(type == GmshSocket::GMSH_PARAMETER_NOT_FOUND){ // parameter not found return true; } else if(type == GmshSocket::GMSH_INFO){ return true; } else{ _gmshClient->Error("Unknown message type: aborting remote get"); return false; } } return true; } public: void waitOnSubClients() { if(!_gmshClient) return; while(_numSubClients > 0){ int ret = _gmshClient->Select(500, 0); if(!ret){ _gmshClient->Info("Timout: aborting wait on subclients"); return; } else if(ret < 0){ _gmshClient->Error("Error on select: aborting wait on subclients"); return; } int type, length, swap; if(!_gmshClient->ReceiveHeader(&type, &length, &swap)){ _gmshClient->Error("Did not receive message header: aborting wait on subclients"); return; } std::string msg(length, ' '); if(!_gmshClient->ReceiveMessage(length, &msg[0])){ _gmshClient->Error("Did not receive message body: aborting wait on subclients"); return; } if(type == GmshSocket::GMSH_STOP) _numSubClients -= 1; } } public: remoteNetworkClient(const std::string &name, const std::string &serverAddress) : client(name), _serverAddress(serverAddress), _numSubClients(0) { _gmshClient = new GmshClient(); if(_gmshClient->Connect(_serverAddress.c_str()) < 0){ delete _gmshClient; _gmshClient = 0; } else{ _gmshClient->Start(); } } virtual ~remoteNetworkClient() { if(_gmshClient){ waitOnSubClients(); _gmshClient->Stop(); _gmshClient->Disconnect(); delete _gmshClient; _gmshClient = 0; } } GmshClient *getGmshClient(){ return _gmshClient; } virtual bool isNetworkClient(){ return true; } virtual bool clear(const std::string &name="") { if(!_gmshClient) return false; std::string msg = name; if(msg.empty()) msg = "*"; _gmshClient->SendMessage(GmshSocket::GMSH_PARAMETER_CLEAR, msg.size(), &msg[0]); return true; } virtual bool set(const number &p){ return _set(p); } virtual bool set(const string &p){ return _set(p); } virtual bool set(const function &p){ return _set(p); } virtual bool set(const region &p){ return _set(p); } virtual bool get(std::vector &ps, const std::string &name=""){ return _get(ps, name); } virtual bool get(std::vector &ps, const std::string &name=""){ return _get(ps, name); } virtual bool get(std::vector &ps, const std::string &name=""){ return _get(ps, name); } virtual bool get(std::vector &ps, const std::string &name=""){ return _get(ps, name); } void sendInfo(const std::string &msg) { if(_gmshClient) _gmshClient->Info(msg.c_str()); } void sendWarning(const std::string &msg) { if(_gmshClient) _gmshClient->Warning(msg.c_str()); } void sendError(const std::string &msg) { if(_gmshClient) _gmshClient->Error(msg.c_str()); } void sendProgress(const std::string &msg) { if(_gmshClient) _gmshClient->Progress(msg.c_str()); } void sendMergeFileRequest(const std::string &msg) { if(_gmshClient) _gmshClient->MergeFile(msg.c_str()); } void sendOpenProjectRequest(const std::string &msg) { if(_gmshClient) _gmshClient->OpenProject(msg.c_str()); } void sendParseStringRequest(const std::string &msg) { if(_gmshClient) _gmshClient->ParseString(msg.c_str()); } void runNonBlockingSubClient(const std::string &name, const std::string &command) { if(!_gmshClient){ system(command.c_str()); return; } std::string msg = name + parameter::charSep() + command; _gmshClient->SendMessage(GmshSocket::GMSH_CONNECT, msg.size(), &msg[0]); _numSubClients += 1; } void runSubClient(const std::string &name, const std::string &command) { runNonBlockingSubClient(name, command); waitOnSubClients(); } }; } #endif getdp-2.7.0-source/CMakeLists.txt000644 001750 001750 00000124045 12617441403 020351 0ustar00geuzainegeuzaine000000 000000 # GetDP - Copyright (C) 1997-2015 P. Dular and C. Geuzaine, University of Liege # # See the LICENSE.txt file for license information. Please report all # bugs and problems to the public mailing list . cmake_minimum_required(VERSION 2.8 FATAL_ERROR) # do not warn about non-definition of WIN32 on cygwin set(CMAKE_LEGACY_CYGWIN_WIN32 0) # if CMAKE_BUILD_TYPE is specified use it; otherwise set the default # build type to "RelWithDebInfo" ("-O2 -g" with gcc) prior to calling # project() if(DEFINED CMAKE_BUILD_TYPE) set(CMAKE_BUILD_TYPE ${CMAKE_BUILD_TYPE} CACHE STRING "Choose build type") else(DEFINED CMAKE_BUILD_TYPE) set(CMAKE_BUILD_TYPE RelWithDebInfo CACHE STRING "Choose build type") endif(DEFINED CMAKE_BUILD_TYPE) # this variable controls the default value of the options which are normally set # to ON (useful if you want to configure a minimal version of GetDP: e.g. "cmake # -DDEFAULT=0 -DENABLE_PETSC=1") set(DEFAULT ON CACHE INTERNAL "Default value for enabled-by-default options") macro(opt OPTION HELP VALUE) option(ENABLE_${OPTION} ${HELP} ${VALUE}) set(OPT_TEXI "${OPT_TEXI}\n@item ENABLE_${OPTION}\n${HELP} (default: ${VALUE})") endmacro(opt) opt(ARPACK "Enable Arpack eigensolver (requires Fortran)" ${DEFAULT}) opt(CONTRIB_ARPACK "Enable Arpack eigensolver from GetDP's contrib folder (requires Fortran)" OFF) opt(BLAS_LAPACK "Enable BLAS/Lapack for linear algebra (e.g. for Arpack)" ${DEFAULT}) opt(BUILD_LIB "Enable 'lib' target for building static GetDP library" OFF) opt(BUILD_SHARED "Enable 'shared' target for building shared GetDP library" OFF) opt(BUILD_DYNAMIC "Enable dynamic GetDP executable (linked with shared lib)" OFF) opt(BUILD_ANDROID "Enable Android NDK library target (experimental)" OFF) opt(BUILD_IOS "Enable iOS (ARM) library target (experimental)" OFF) opt(ONELAB2 "Enable experimental ONELAB-Cloud solver interface" OFF) opt(FORTRAN "Enable Fortran (needed for Arpack/Sparskit/Zitsol & Bessel)" ${DEFAULT}) opt(GMSH "Enable Gmsh functions (for field interpolation)" ${DEFAULT}) opt(GSL "Enable GSL functions (for some built-in functions)" ${DEFAULT}) opt(LEGACY "Use legacy assembler (required for actual computations)" ON) opt(MPI "Enable MPI parallelization (with PETSc/SLEPc)" OFF) opt(MULTIHARMONIC "Enable multi-harmonic support" OFF) opt(NR "Enable NR functions (if GSL is unavailable)" ${DEFAULT}) opt(NX "Enable proprietary NX extension" OFF) opt(OCTAVE "Enable Octave functions" ${DEFAULT}) opt(OPENMP "Enable OpenMP parallelization of some functions (experimental)" OFF) opt(PETSC "Enable PETSc linear solver" ${DEFAULT}) opt(PYTHON "Enable Python functions" ${DEFAULT}) opt(SLEPC "Enable SLEPc eigensolver" ${DEFAULT}) opt(SPARSKIT "Enable Sparskit solver instead of PETSc (requires Fortran)" ${DEFAULT}) opt(ZITSOL "Enable Zitsol solvers (requires PETSc and Fortran)" OFF) if(ENABLE_FORTRAN) project(getdp CXX C Fortran) else(ENABLE_FORTRAN) project(getdp CXX C) endif(ENABLE_FORTRAN) set(GETDP_MAJOR_VERSION 2) set(GETDP_MINOR_VERSION 7) set(GETDP_PATCH_VERSION 0) set(GETDP_EXTRA_VERSION "" CACHE STRING "GetDP extra version string") set(GETDP_VERSION "${GETDP_MAJOR_VERSION}.${GETDP_MINOR_VERSION}") set(GETDP_VERSION "${GETDP_VERSION}.${GETDP_PATCH_VERSION}${GETDP_EXTRA_VERSION}") set(GETDP_SHORT_LICENSE "GNU General Public License") set(GETDP_API ${CMAKE_CURRENT_BINARY_DIR}/Common/GetDPConfig.h ${CMAKE_CURRENT_BINARY_DIR}/Common/GetDPVersion.h Legacy/GetDP.h ) execute_process(COMMAND date "+%Y%m%d" OUTPUT_VARIABLE DATE OUTPUT_STRIP_TRAILING_WHITESPACE) execute_process(COMMAND hostname OUTPUT_VARIABLE HOSTNAME OUTPUT_STRIP_TRAILING_WHITESPACE) execute_process(COMMAND whoami OUTPUT_VARIABLE PACKAGER OUTPUT_STRIP_TRAILING_WHITESPACE) if(NOT DATE) set(DATE "unknown") endif(NOT DATE) set(GETDP_DATE "${DATE}") if(NOT HOSTNAME) set(HOSTNAME "unknown") endif(NOT HOSTNAME) set(GETDP_HOST "${HOSTNAME}") if(NOT PACKAGER) set(PACKAGER "unknown") endif(NOT PACKAGER) set(GETDP_PACKAGER "${PACKAGER}") if(APPLE) set(GETDP_OS "MacOSX") elseif(CYGWIN) set(GETDP_OS "Windows") else(APPLE) set(GETDP_OS "${CMAKE_SYSTEM_NAME}") endif(APPLE) include(CheckTypeSize) include(CheckFunctionExists) include(CheckIncludeFile) include(CheckCXXCompilerFlag) if(MSVC) if(ENABLE_MSVC_STATIC_RUNTIME) foreach(VAR CMAKE_CXX_FLAGS CMAKE_CXX_FLAGS_DEBUG CMAKE_CXX_FLAGS_RELEASE CMAKE_CXX_FLAGS_MINSIZEREL CMAKE_CXX_FLAGS_RELWITHDEBINFO CMAKE_C_FLAGS CMAKE_C_FLAGS_DEBUG CMAKE_C_FLAGS_RELEASE CMAKE_C_FLAGS_MINSIZEREL CMAKE_C_FLAGS_RELWITHDEBINFO) if(${VAR} MATCHES "/MD") string(REGEX REPLACE "/MD" "/MT" ${VAR} "${${VAR}}") endif(${VAR} MATCHES "/MD") endforeach(VAR) endif(ENABLE_MSVC_STATIC_RUNTIME) endif(MSVC) if(ENABLE_OPENMP) find_package(OpenMP) if(OPENMP_FOUND) set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} ${OpenMP_C_FLAGS}") set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} ${OpenMP_CXX_FLAGS}") endif(OPENMP_FOUND) endif(ENABLE_OPENMP) macro(append_getdp_src DIRNAME FILES) foreach(FILE ${FILES}) list(APPEND LIST ${DIRNAME}/${FILE}) endforeach(FILE) set(GETDP_SRC ${GETDP_SRC};${LIST} PARENT_SCOPE) set(GETDP_DIRS ${GETDP_DIRS};${DIRNAME} PARENT_SCOPE) endmacro(append_getdp_src) macro(find_all_libraries VARNAME LISTNAME PATH SUFFIX) set(${VARNAME}) list(LENGTH ${LISTNAME} NUM_LIST) foreach(LIB ${${LISTNAME}}) if("${PATH}" STREQUAL "") find_library(FOUND_LIB ${LIB} PATH_SUFFIXES ${SUFFIX}) else("${PATH}" STREQUAL "") find_library(FOUND_LIB ${LIB} PATHS ${PATH} NO_DEFAULT_PATH) endif("${PATH}" STREQUAL "") if(FOUND_LIB) list(APPEND ${VARNAME} ${FOUND_LIB}) endif(FOUND_LIB) unset(FOUND_LIB CACHE) endforeach(LIB) list(LENGTH ${VARNAME} NUM_FOUND_LIBRARIES) if(NUM_FOUND_LIBRARIES LESS NUM_LIST) set(${VARNAME}) endif(NUM_FOUND_LIBRARIES LESS NUM_LIST) endmacro(find_all_libraries) macro(set_config_option VARNAME STRING) set(${VARNAME} TRUE) list(APPEND CONFIG_OPTIONS ${STRING}) message(STATUS "Found " ${STRING}) endmacro(set_config_option) # check if the machine is 64 bits (this is more reliable than using # CMAKE_SIZEOF_VOID_P, which does not seem to work e.g. on some Suse # machines) check_type_size("void*" SIZEOF_VOID_P) if(SIZEOF_VOID_P EQUAL 8) set_config_option(HAVE_64BIT_SIZE_T "64Bit") endif(SIZEOF_VOID_P EQUAL 8) if(ENABLE_BLAS_LAPACK) if(BLAS_LAPACK_LIBRARIES) # use libs as specified in the BLAS_LAPACK_LIBRARIES variable set_config_option(HAVE_BLAS "Blas(Custom)") set_config_option(HAVE_LAPACK "Lapack(Custom)") set(LAPACK_LIBRARIES ${BLAS_LAPACK_LIBRARIES}) else(BLAS_LAPACK_LIBRARIES) if(MSVC) # on Windows with Visual C++ try really hard to find blas/lapack *without* # requiring a Fortran compiler: 1) try to find the Intel MKL libs using # the standard search path; if not found 2) try to get the reference # blas/lapack libs (useful for users with no Fortran compiler and no MKL # license, who can just download our precompiled "gmsh-dep" package) if(HAVE_64BIT_SIZE_T) set(MKL_PATH em64t/lib) set(MKL_LIBS_REQUIRED libguide40 mkl_intel_lp64 mkl_intel_thread mkl_core) else(HAVE_64BIT_SIZE_T) set(MKL_PATH ia32/lib) set(MKL_LIBS_REQUIRED libguide40 mkl_intel_c mkl_intel_thread mkl_core) endif(HAVE_64BIT_SIZE_T) find_all_libraries(LAPACK_LIBRARIES MKL_LIBS_REQUIRED "" ${MKL_PATH}) if(LAPACK_LIBRARIES) set_config_option(HAVE_BLAS "Blas(IntelMKL)") set_config_option(HAVE_LAPACK "Lapack(IntelMKL)") else(LAPACK_LIBRARIES) set(REFLAPACK_LIBS_REQUIRED lapack blas g2c gcc) find_all_libraries(LAPACK_LIBRARIES REFLAPACK_LIBS_REQUIRED "" "") if(LAPACK_LIBRARIES) set_config_option(HAVE_BLAS "Blas(Reference)") set_config_option(HAVE_LAPACK "Lapack(Reference)") endif(LAPACK_LIBRARIES) endif(LAPACK_LIBRARIES) elseif(${CMAKE_SYSTEM_NAME} MATCHES "Linux") # on Linux try to find the Intel MKL without a Fortran compiler if(HAVE_64BIT_SIZE_T) set(MKL_PATH lib/em64t) else(HAVE_64BIT_SIZE_T) set(MKL_PATH lib/32) endif(HAVE_64BIT_SIZE_T) set(MKL_LIBS_REQUIRED mkl_gf_lp64 iomp5 mkl_gnu_thread mkl_core guide pthread) find_all_libraries(LAPACK_LIBRARIES MKL_LIBS_REQUIRED "" ${MKL_PATH}) if(NOT LAPACK_LIBRARIES) # match lapack 9.0 on 64bit set(MKL_LIBS_REQUIRED mkl_lapack mkl_em64t guide) find_all_libraries(LAPACK_LIBRARIES MKL_LIBS_REQUIRED "" ${MKL_PATH}) endif(NOT LAPACK_LIBRARIES) if(LAPACK_LIBRARIES) set_config_option(HAVE_BLAS "Blas(IntelMKL)") set_config_option(HAVE_LAPACK "Lapack(IntelMKL)") else(LAPACK_LIBRARIES) # on Linux also try to find ATLAS without a Fortran compiler, because # cmake ships with a buggy FindBLAS e.g. on Ubuntu Lucid Lynx set(ATLAS_LIBS_REQUIRED lapack f77blas cblas atlas) find_all_libraries(LAPACK_LIBRARIES ATLAS_LIBS_REQUIRED "" "") if(LAPACK_LIBRARIES) set_config_option(HAVE_BLAS "Blas(ATLAS)") set_config_option(HAVE_LAPACK "Lapack(ATLAS)") else(LAPACK_LIBRARIES) # try with generic names set(GENERIC_LIBS_REQUIRED lapack blas pthread) find_all_libraries(LAPACK_LIBRARIES GENERIC_LIBS_REQUIRED "" "") if(LAPACK_LIBRARIES) set_config_option(HAVE_BLAS "Blas(Generic)") set_config_option(HAVE_LAPACK "Lapack(Generic)") find_library(GFORTRAN_LIB gfortran) if(GFORTRAN_LIB) list(APPEND LAPACK_LIBRARIES ${GFORTRAN_LIB}) endif(GFORTRAN_LIB) endif(LAPACK_LIBRARIES) endif(LAPACK_LIBRARIES) endif(LAPACK_LIBRARIES) elseif(${CMAKE_SYSTEM_NAME} MATCHES "SunOS") # on SunOS we know blas and lapack are available in sunperf set(LAPACK_FLAGS -library=sunperf) set_config_option(HAVE_BLAS "Blas(SunPerf)") set_config_option(HAVE_LAPACK "Lapack(SunPerf)") elseif(APPLE) # on Mac we also know that blas and lapack are available set(LAPACK_LIBRARIES "-llapack -lblas") set_config_option(HAVE_BLAS "Blas(VecLib)") set_config_option(HAVE_LAPACK "Lapack(VecLib)") endif(MSVC) if(NOT HAVE_BLAS OR NOT HAVE_LAPACK) # if we haven't found blas and lapack check for OpenBlas set(OPENBLAS_LIBS_REQUIRED openblas) find_all_libraries(LAPACK_LIBRARIES OPENBLAS_LIBS_REQUIRED "" "") if(LAPACK_LIBRARIES) set_config_option(HAVE_BLAS "Blas(OpenBlas)") set_config_option(HAVE_LAPACK "Lapack(OpenBlas)") find_library(GFORTRAN_LIB gfortran) if(GFORTRAN_LIB) list(APPEND LAPACK_LIBRARIES ${GFORTRAN_LIB}) endif(GFORTRAN_LIB) endif(LAPACK_LIBRARIES) endif(NOT HAVE_BLAS OR NOT HAVE_LAPACK) if(NOT HAVE_BLAS OR NOT HAVE_LAPACK) # if we still haven't found blas and lapack, use the standard cmake tests, # which require a working Fortran compiler enable_language(Fortran) find_package(BLAS) if(BLAS_FOUND) set_config_option(HAVE_BLAS "Blas") find_package(LAPACK) if(LAPACK_FOUND) set_config_option(HAVE_LAPACK "Lapack") else(LAPACK_FOUND) set(LAPACK_LIBRARIES ${BLAS_LIBRARIES}) endif(LAPACK_FOUND) endif(BLAS_FOUND) endif(NOT HAVE_BLAS OR NOT HAVE_LAPACK) endif(BLAS_LAPACK_LIBRARIES) endif(ENABLE_BLAS_LAPACK) if(ENABLE_ONELAB2) set_config_option(HAVE_ONELAB2 "ONELAB") # temporary use ONELAB files from gmsh sources find_path(GMSH_SRC "gmsh/CMakeLists.txt" PATH_SUFFIXES src) if(GMSH_SRC) set(GETDP_SRC ${GETDP_SRC};${GMSH_SRC}/contrib/onelab2/NetworkUtils.h;${GMSH_SRC}/contrib/onelab2/NetworkUtils.cpp;${GMSH_SRC}/contrib/onelab2/OnelabAttributes.h;${GMSH_SRC}/contrib/onelab2/OnelabAttributes.cpp;${GMSH_SRC}/contrib/onelab2/OnelabProtocol.h;${GMSH_SRC}/contrib/onelab2/OnelabProtocol.cpp;${GMSH_SRC}/contrib/onelab2/VirtualClient.h;${GMSH_SRC}/contrib/onelab2/OnelabNetworkClient.h;${GMSH_SRC}/contrib/onelab2/OnelabNetworkClient.cpp) include_directories(${GMSH_SRC}/contrib/onelab2/) else(GMSH_SRC) message(FATAL_ERROR "Unable to find Gmsh sources for ONELAB2") endif(GMSH_SRC) endif(ENABLE_ONELAB2) add_subdirectory(Common) add_subdirectory(Interface) add_subdirectory(Numeric) if(ENABLE_LEGACY) add_subdirectory(Legacy) set_config_option(HAVE_LEGACY "Legacy") endif(ENABLE_LEGACY) if(ENABLE_MPI) find_package(MPI) if(MPI_FOUND) set_config_option(HAVE_MPI "MPI") list(APPEND EXTERNAL_INCLUDES ${MPI_INCLUDE_DIR}) list(APPEND EXTERNAL_LIBRARIES ${MPI_LIBRARIES}) include(CMakeForceCompiler) # Warning: this actually requires cmake >= 2.8.5 cmake_force_c_compiler(${MPI_C_COMPILER} "MPI C Compiler") cmake_force_cxx_compiler(${MPI_CXX_COMPILER} "MPI C++ Compiler") cmake_force_fortran_compiler(${MPI_Fortran_COMPILER} "MPI Fortran Compiler") endif(MPI_FOUND) endif(ENABLE_MPI) if(ENABLE_GMSH) find_library(GMSH_LIB Gmsh PATH_SUFFIXES lib) find_path(GMSH_INC "gmsh/Gmsh.h" PATH_SUFFIXES include) if(GMSH_LIB AND GMSH_INC) list(APPEND EXTERNAL_LIBRARIES ${GMSH_LIB}) list(APPEND EXTERNAL_INCLUDES ${GMSH_INC}) set_config_option(HAVE_GMSH "Gmsh") endif(GMSH_LIB AND GMSH_INC) endif(ENABLE_GMSH) if(ENABLE_PETSC) if(PETSC_DIR) set(ENV_PETSC_DIR ${PETSC_DIR}) else(PETSC_DIR) set(ENV_PETSC_DIR $ENV{PETSC_DIR}) endif(PETSC_DIR) if(PETSC_ARCH) set(ENV_PETSC_ARCH ${PETSC_ARCH}) else(PETSC_ARCH) set(ENV_PETSC_ARCH $ENV{PETSC_ARCH}) endif(PETSC_ARCH) set(PETSC_POSSIBLE_CONF_FILES ${ENV_PETSC_DIR}/${ENV_PETSC_ARCH}/conf/petscvariables ${ENV_PETSC_DIR}/${ENV_PETSC_ARCH}/lib/petsc-conf/petscvariables ${ENV_PETSC_DIR}/${ENV_PETSC_ARCH}/lib/petsc/conf/petscvariables) foreach(FILE ${PETSC_POSSIBLE_CONF_FILES}) if(EXISTS ${FILE}) # old-style PETSc installations (using PETSC_DIR and PETSC_ARCH) message(STATUS "Using PETSc dir: ${ENV_PETSC_DIR}") message(STATUS "Using PETSc arch: ${ENV_PETSC_ARCH}") # find includes by parsing the petscvariables file file(STRINGS ${FILE} PETSC_VARIABLES NEWLINE_CONSUME) endif(EXISTS ${FILE}) endforeach(FILE) if(PETSC_VARIABLES) # try to find PETSC_CC_INCLUDES for PETSc >= 3.4 string(REGEX MATCH "PETSC_CC_INCLUDES = [^\n\r]*" PETSC_PACKAGES_INCLUDES ${PETSC_VARIABLES}) if(PETSC_PACKAGES_INCLUDES) string(REPLACE "PETSC_CC_INCLUDES = " "" PETSC_PACKAGES_INCLUDES ${PETSC_PACKAGES_INCLUDES}) else(PETSC_PACKAGES_INCLUDES) # try to find PETSC_PACKAGES_INCLUDES in older versions list(APPEND EXTERNAL_INCLUDES ${ENV_PETSC_DIR}/include) list(APPEND EXTERNAL_INCLUDES ${ENV_PETSC_DIR}/${ENV_PETSC_ARCH}/include) string(REGEX MATCH "PACKAGES_INCLUDES = [^\n\r]*" PETSC_PACKAGES_INCLUDES ${PETSC_VARIABLES}) string(REPLACE "PACKAGES_INCLUDES = " "" PETSC_PACKAGES_INCLUDES ${PETSC_PACKAGES_INCLUDES}) endif(PETSC_PACKAGES_INCLUDES) if(PETSC_PACKAGES_INCLUDES) if(PETSC_PACKAGES_INCLUDES) string(REPLACE "-I" "" PETSC_PACKAGES_INCLUDES ${PETSC_PACKAGES_INCLUDES}) string(REPLACE " " ";" PETSC_PACKAGES_INCLUDES ${PETSC_PACKAGES_INCLUDES}) foreach(VAR ${PETSC_PACKAGES_INCLUDES}) list(APPEND EXTERNAL_INCLUDES ${VAR}) endforeach(VAR) endif(PETSC_PACKAGES_INCLUDES) endif(PETSC_PACKAGES_INCLUDES) # find libraries (<= 3.0) set(PETSC_LIBS_REQUIRED petscksp petscdm petscmat petscvec petsc) find_all_libraries(PETSC_LIBS PETSC_LIBS_REQUIRED ${ENV_PETSC_DIR}/${ENV_PETSC_ARCH}/lib "") # petsc 3.1 creates only one library (libpetsc) if(NOT PETSC_LIBS) find_library(PETSC_LIBS petsc PATHS ${ENV_PETSC_DIR}/${ENV_PETSC_ARCH}/lib NO_DEFAULT_PATH) endif(NOT PETSC_LIBS) if(PETSC_LIBS) set_config_option(HAVE_PETSC "PETSc") if(NOT HAVE_BLAS) set_config_option(HAVE_BLAS "Blas(PETSc)") endif(NOT HAVE_BLAS) if(NOT HAVE_LAPACK) set_config_option(HAVE_LAPACK "Lapack(PETSc)") endif(NOT HAVE_LAPACK) endif(PETSC_LIBS) # find slepc (needs to be linked in before petsc) if(ENABLE_SLEPC) if(SLEPC_DIR) set(ENV_SLEPC_DIR ${SLEPC_DIR}) else(SLEPC_DIR) set(ENV_SLEPC_DIR $ENV{SLEPC_DIR}) endif(SLEPC_DIR) find_library(SLEPC_LIB slepc PATHS ${ENV_SLEPC_DIR}/${ENV_PETSC_ARCH}/lib NO_DEFAULT_PATH) if(SLEPC_LIB) find_path(SLEPC_INC "slepc.h" PATHS ${ENV_SLEPC_DIR} PATH_SUFFIXES include ${ENV_PETSC_ARCH}/include include/slepc NO_DEFAULT_PATH) if(SLEPC_INC) message(STATUS "Using SLEPc dir: ${ENV_SLEPC_DIR}") set_config_option(HAVE_SLEPC "SLEPc") list(APPEND EXTERNAL_LIBRARIES ${SLEPC_LIB}) list(APPEND EXTERNAL_INCLUDES ${SLEPC_INC}) find_path(SLEPC_INC2 "slepcconf.h" PATHS ${ENV_SLEPC_DIR} PATH_SUFFIXES ${ENV_PETSC_ARCH}/include NO_DEFAULT_PATH) if(SLEPC_INC2) list(APPEND EXTERNAL_INCLUDES ${SLEPC_INC2}) endif(SLEPC_INC2) endif(SLEPC_INC) endif(SLEPC_LIB) endif(ENABLE_SLEPC) list(APPEND EXTERNAL_LIBRARIES ${PETSC_LIBS}) # find additional libraries to link with string(REGEX MATCH "PACKAGES_LIBS = [^\n\r]*" PLIBS ${PETSC_VARIABLES}) if(PLIBS) string(REPLACE "PACKAGES_LIBS = " "" PLIBS ${PLIBS}) string(STRIP ${PLIBS} PLIBS) list(APPEND EXTERNAL_LIBRARIES "${PLIBS}") endif(PLIBS) string(REGEX MATCH "PETSC_EXTERNAL_LIB_BASIC = [^\n\r]*" PLIBS_BASIC ${PETSC_VARIABLES}) if(PLIBS_BASIC) string(REPLACE "PETSC_EXTERNAL_LIB_BASIC = " "" PLIBS_BASIC ${PLIBS_BASIC}) string(STRIP ${PLIBS_BASIC} PLIBS_BASIC) list(APPEND EXTERNAL_LIBRARIES "${PLIBS_BASIC}") endif(PLIBS_BASIC) string(REGEX MATCH "PCC_LINKER_LIBS = [^\n\r]*" LLIBS ${PETSC_VARIABLES}) if(LLIBS) string(REPLACE "PCC_LINKER_LIBS = " "" LLIBS ${LLIBS}) string(STRIP ${LLIBS} LLIBS) list(APPEND EXTERNAL_LIBRARIES "${LLIBS}") endif(LLIBS) else(PETSC_VARIABLES) # new-style PETSc installations (in standard system directories) find_library(PETSC_LIBS petsc) find_path(PETSC_INC "petsc.h" PATH_SUFFIXES include/petsc) if(PETSC_LIBS AND PETSC_INC) set_config_option(HAVE_PETSC "PETSc") if(ENABLE_SLEPC) find_library(SLEPC_LIB slepc) find_path(SLEPC_INC "slepc.h" PATH_SUFFIXES include/slepc) if(SLEPC_LIB AND SLEPC_INC) set_config_option(HAVE_SLEPC "SLEPc") list(APPEND EXTERNAL_LIBRARIES ${SLEPC_LIB}) list(APPEND EXTERNAL_INCLUDES ${SLEPC_INC}) endif(SLEPC_LIB AND SLEPC_INC) endif(ENABLE_SLEPC) list(APPEND EXTERNAL_LIBRARIES ${PETSC_LIBS}) list(APPEND EXTERNAL_INCLUDES ${PETSC_INC}) endif(PETSC_LIBS AND PETSC_INC) endif(PETSC_VARIABLES) endif(ENABLE_PETSC) if(ENABLE_ARPACK AND NOT ENABLE_CONTRIB_ARPACK) if(HAVE_LAPACK OR HAVE_PETSC) find_library(ARPACK_LIB arpack PATH_SUFFIXES lib) if(ARPACK_LIB) list(APPEND EXTERNAL_LIBRARIES ${ARPACK_LIB}) set_config_option(HAVE_ARPACK "Arpack") endif(ARPACK_LIB) endif(HAVE_LAPACK OR HAVE_PETSC) endif(ENABLE_ARPACK AND NOT ENABLE_CONTRIB_ARPACK) if(ENABLE_FORTRAN) if(ENABLE_SPARSKIT AND NOT HAVE_PETSC) add_subdirectory(contrib/Sparskit) include_directories(contrib/Sparskit) set_config_option(HAVE_SPARSKIT "Sparskit") file(GLOB_RECURSE SPARSKIT_SRC contrib/Sparskit/*.cpp contrib/Sparskit/*.f contrib/Sparskit/*.F) set_source_files_properties(${SPARSKIT_SRC} COMPILE_FLAGS "-DHAVE_ILU_FLOAT") endif(ENABLE_SPARSKIT AND NOT HAVE_PETSC) if(ENABLE_ZITSOL AND HAVE_PETSC) if(EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/contrib/ZITSOL_1/getdp.c) add_subdirectory(contrib/ZITSOL_1) set_config_option(HAVE_ZITSOL "Zitsol") endif(EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/contrib/ZITSOL_1/getdp.c) endif(ENABLE_ZITSOL AND HAVE_PETSC) if(ENABLE_ARPACK OR ENABLE_CONTRIB_ARPACK) if(HAVE_LAPACK OR HAVE_PETSC) if(NOT ARPACK_LIB) if(ENABLE_CONTRIB_ARPACK) message(STATUS "Using contrib/ARPACK") else(ENABLE_CONTRIB_ARPACK) message(STATUS "System ARPACK not found: using contrib/Arpack instead") endif(ENABLE_CONTRIB_ARPACK) add_subdirectory(contrib/Arpack) set_config_option(HAVE_ARPACK "Arpack") endif(NOT ARPACK_LIB) endif(HAVE_LAPACK OR HAVE_PETSC) endif(ENABLE_ARPACK OR ENABLE_CONTRIB_ARPACK) if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") if(CMAKE_Fortran_COMPILER MATCHES "gfortran") list(APPEND LAPACK_LIBRARIES -lgfortran) elseif(CMAKE_Fortran_COMPILER MATCHES "f95") list(APPEND LAPACK_LIBRARIES -lgfortran) elseif(CMAKE_Fortran_COMPILER MATCHES "g77") list(APPEND LAPACK_LIBRARIES -lg2c) endif(CMAKE_Fortran_COMPILER MATCHES "gfortran") endif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") else(ENABLE_FORTRAN) set_config_option(HAVE_NO_FORTRAN "NoFortran") endif(ENABLE_FORTRAN) if(NOT HAVE_PETSC AND NOT HAVE_SPARSKIT) message(STATUS "Warning: building without PETSc and without Sparskit") endif(NOT HAVE_PETSC AND NOT HAVE_SPARSKIT) if(ENABLE_NX) if(EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/contrib/NX/Unv_Format.cpp) message(STATUS "Note: Building non-free version of GetDP with code " "(C) 2012 Dr. Binde Ingenieure.") add_subdirectory(contrib/NX) set_config_option(HAVE_NX "NX") endif(EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/contrib/NX/Unv_Format.cpp) endif(ENABLE_NX) if(ENABLE_GSL) find_library(GSL_LIB gsl PATH_SUFFIXES lib) find_library(GSLCBLAS_LIB gslcblas PATH_SUFFIXES lib) find_path(GSL_INC "gsl/gsl_min.h" PATH_SUFFIXES include) if(GSL_LIB AND GSLCBLAS_LIB AND GSL_INC) list(APPEND EXTERNAL_LIBRARIES ${GSL_LIB} ${GSLCBLAS_LIB}) list(APPEND EXTERNAL_INCLUDES ${GSL_INC}) set_config_option(HAVE_GSL "Gsl") endif(GSL_LIB AND GSLCBLAS_LIB AND GSL_INC) endif(ENABLE_GSL) if(ENABLE_NR AND NOT HAVE_GSL) if(EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/contrib/NR/newt.cpp) message(STATUS "Note: Building non-free version of GetDP, with code " "(C) 1986-92 Numerical Recipes Software.") add_subdirectory(contrib/NR) set_config_option(HAVE_NR "NR") endif(EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/contrib/NR/newt.cpp) endif(ENABLE_NR AND NOT HAVE_GSL) if(ENABLE_OCTAVE) find_library(OCTAVE_LIB octave) find_library(OCTINTERP_LIB octinterp) find_path(OCTAVE_INC "octave/oct.h") if(OCTAVE_LIB AND OCTINTERP_LIB AND OCTAVE_INC) list(APPEND EXTERNAL_LIBRARIES ${OCTAVE_LIB} ${OCTINTERP_LIB}) list(APPEND EXTERNAL_INCLUDES ${OCTAVE_INC}) set_config_option(HAVE_OCTAVE "Octave") endif(OCTAVE_LIB AND OCTINTERP_LIB AND OCTAVE_INC) endif(ENABLE_OCTAVE) if(ENABLE_PYTHON) find_package(PythonLibs) if(PYTHONLIBS_FOUND) list(APPEND EXTERNAL_LIBRARIES ${PYTHON_LIBRARIES}) list(APPEND EXTERNAL_INCLUDES ${PYTHON_INCLUDE_DIRS}) set_config_option(HAVE_PYTHON "Python") endif(PYTHONLIBS_FOUND) endif(ENABLE_PYTHON) if(ENABLE_MULTIHARMONIC) message(STATUS "Warning: building with multi-harmonic support (tested and working with a real version of Petsc!)") set_config_option(HAVE_MULTIHARMONIC "Multi-Harmonic") endif(ENABLE_MULTIHARMONIC) check_function_exists(vsnprintf HAVE_VSNPRINTF) if(NOT HAVE_VSNPRINTF AND NOT ENABLE_BUILD_IOS) set_config_option(HAVE_NO_VSNPRINTF "NoVsnprintf") endif(NOT HAVE_VSNPRINTF AND NOT ENABLE_BUILD_IOS) check_include_file(sys/socket.h HAVE_SYS_SOCKET_H) if(HAVE_SYS_SOCKET_H) set(CMAKE_EXTRA_INCLUDE_FILES sys/socket.h) endif(HAVE_SYS_SOCKET_H) check_type_size(socklen_t SOCKLEN_T_SIZE) set(CMAKE_EXTRA_INCLUDE_FILES) if(NOT SOCKLEN_T_SIZE AND NOT ENABLE_BUILD_IOS) set_config_option(HAVE_NO_SOCKLEN_T "NoSocklenT") endif(NOT SOCKLEN_T_SIZE AND NOT ENABLE_BUILD_IOS) check_include_file(stdint.h HAVE_STDINT_H) if(HAVE_STDINT_H) set(CMAKE_EXTRA_INCLUDE_FILES stdint.h) else(HAVE_STDINT_H) set_config_option(HAVE_NO_STDINT_H "NoStdintH") endif(HAVE_STDINT_H) check_type_size(intptr_t INTPTR_T_SIZE) set(CMAKE_EXTRA_INCLUDE_FILES) if(NOT INTPTR_T_SIZE AND NOT ENABLE_BUILD_IOS) set_config_option(HAVE_NO_INTPTR_T "NoIntptrT") endif(NOT INTPTR_T_SIZE AND NOT ENABLE_BUILD_IOS) if(MSVC) add_definitions(-D_USE_MATH_DEFINES -DNOMINMAX -D_CRT_SECURE_NO_DEPRECATE -D_SCL_SECURE_NO_DEPRECATE) endif(MSVC) if(WIN32 OR CYGWIN) list(APPEND EXTERNAL_LIBRARIES winmm wsock32 ws2_32 psapi) endif(WIN32 OR CYGWIN) # disable compile optimization on some known problematic files check_cxx_compiler_flag("-O0" NOOPT) if(NOOPT) file(GLOB_RECURSE NON_OPTIMIZED_SRC contrib/NR/*.cpp) set_source_files_properties(${NON_OPTIMIZED_SRC} COMPILE_FLAGS "-O0") endif(NOOPT) # force full warnings to encourage everybody to write clean(er) code check_cxx_compiler_flag("-Wall" WALL) if(WALL) file(GLOB_RECURSE WALL_SRC Common/*.cpp Interface/*.cpp Legacy/*.cpp Main/*.cpp Numeric/*.cpp) set_source_files_properties(${WALL_SRC} COMPILE_FLAGS "-Wall") endif(WALL) # don't issue warnings for contributed libraries check_cxx_compiler_flag("-w" NOWARN) if(NOWARN) file(GLOB_RECURSE NOWARN_SRC contrib/*.cpp contrib/*.c contrib/*.f) set_source_files_properties(${NOWARN_SRC} PROPERTIES COMPILE_FLAGS "-w") endif(NOWARN) list(SORT CONFIG_OPTIONS) set(GETDP_CONFIG_OPTIONS "") foreach(OPT ${CONFIG_OPTIONS}) set(GETDP_CONFIG_OPTIONS "${GETDP_CONFIG_OPTIONS} ${OPT}") endforeach(OPT) configure_file(${CMAKE_CURRENT_SOURCE_DIR}/Common/GetDPConfig.h.in ${CMAKE_CURRENT_BINARY_DIR}/Common/GetDPConfig.h) configure_file(${CMAKE_CURRENT_SOURCE_DIR}/Common/GetDPVersion.h.in ${CMAKE_CURRENT_BINARY_DIR}/Common/GetDPVersion.h) # process cmake environment variables so we can append them to the -I # include commands. This is not recommended (we should only use the # cache variables) but it is very convenient: otherwise we have to # remember providing the -D... options to cmake for each new build. set(ENV_CMAKE_PREFIX_PATH $ENV{CMAKE_PREFIX_PATH}) set(ENV_CMAKE_INCLUDE_PATH $ENV{CMAKE_INCLUDE_PATH}) if(UNIX) if(ENV_CMAKE_PREFIX_PATH) string(REPLACE ":" ";" ENV_CMAKE_PREFIX_PATH ${ENV_CMAKE_PREFIX_PATH}) endif(ENV_CMAKE_PREFIX_PATH) if(ENV_CMAKE_INCLUDE_PATH) string(REPLACE ":" ";" ENV_CMAKE_INCLUDE_PATH ${ENV_CMAKE_INCLUDE_PATH}) endif(ENV_CMAKE_INCLUDE_PATH) endif(UNIX) list(APPEND EXTERNAL_INCLUDES ${CMAKE_INCLUDE_PATH} ${ENV_CMAKE_INCLUDE_PATH}) list(APPEND EXTERNAL_INCLUDES ${CMAKE_PREFIX_PATH} ${ENV_CMAKE_PREFIX_PATH}) foreach(DIR ${CMAKE_PREFIX_PATH} ${ENV_CMAKE_PREFIX_PATH}) list(APPEND EXTERNAL_INCLUDES ${DIR}/include) endforeach(DIR) if(EXTERNAL_INCLUDES) list(REMOVE_DUPLICATES EXTERNAL_INCLUDES) endif(EXTERNAL_INCLUDES) set(LINK_LIBRARIES ${EXTERNAL_LIBRARIES} ${LAPACK_LIBRARIES}) # Linux-specific linking if(${CMAKE_SYSTEM_NAME} MATCHES "Linux") # try to use static gfortran on static Linux builds if(NOT ENABLE_BUILD_DYNAMIC AND NOT ENABLE_BUILD_SHARED) set(CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES) set(CMAKE_EXE_LINK_DYNAMIC_C_FLAGS) set(CMAKE_EXE_LINK_DYNAMIC_CXX_FLAGS) find_library(GFORTRAN_STATIC libgfortran.a) if(GFORTRAN_STATIC) message(STATUS "Using static libgfortran") foreach(STR ${LINK_LIBRARIES}) string(REPLACE "-lgfortran" ${GFORTRAN_STATIC} STR2 ${STR}) list(APPEND LINK_LIBRARIES2 ${STR2}) endforeach(STR) set(LINK_LIBRARIES ${LINK_LIBRARIES2}) endif(GFORTRAN_STATIC) endif(NOT ENABLE_BUILD_DYNAMIC AND NOT ENABLE_BUILD_SHARED) endif(${CMAKE_SYSTEM_NAME} MATCHES "Linux") # we could specify include dirs more selectively, but this is simpler include_directories(Common Interface Legacy Numeric ${EXTERNAL_INCLUDES} ${CMAKE_CURRENT_BINARY_DIR}/Common) # set this for external codes that might include this CMakeList file set(GETDP_EXTERNAL_INCLUDE_DIRS ${EXTERNAL_INCLUDES} CACHE STRING "External include directories" FORCE) set(GETDP_EXTERNAL_LIBRARIES ${EXTERNAL_LIBRARIES} CACHE STRING "External libraries" FORCE) # group sources for easier navigation in IDEs foreach(DIR ${GETDP_DIRS}) string(REGEX REPLACE "\\+" "\\\\+" DIR ${DIR}) source_group(${DIR} REGULAR_EXPRESSION ${DIR}/.*) endforeach(DIR) # static library target if(ENABLE_BUILD_LIB) add_library(lib STATIC ${GETDP_SRC}) set_target_properties(lib PROPERTIES OUTPUT_NAME GetDP) if(MSVC) set_target_properties(lib PROPERTIES DEBUG_POSTFIX d) if(ENABLE_MSVC_STATIC_RUNTIME) set_target_properties(lib PROPERTIES LINK_FLAGS_RELEASE "/nodefaultlib:LIBCMT") endif(ENABLE_MSVC_STATIC_RUNTIME) endif(MSVC) endif(ENABLE_BUILD_LIB) # shared library target if(ENABLE_BUILD_SHARED OR ENABLE_BUILD_DYNAMIC) add_library(shared SHARED ${GETDP_SRC}) set_target_properties(shared PROPERTIES OUTPUT_NAME GetDP) set_target_properties(shared PROPERTIES VERSION ${GETDP_MAJOR_VERSION}.${GETDP_MINOR_VERSION}.${GETDP_PATCH_VERSION} SOVERSION ${GETDP_MAJOR_VERSION}.${GETDP_MINOR_VERSION}) if(HAVE_LAPACK AND LAPACK_FLAGS) set_target_properties(shared PROPERTIES LINK_FLAGS ${LAPACK_FLAGS}) endif(HAVE_LAPACK AND LAPACK_FLAGS) if(MSVC AND ENABLE_MSVC_STATIC_RUNTIME) message(STATUS "Note: By enabling ENABLE_MSVC_STATIC_RUNTIME, shared library " "won't link. In MSVC change /MT to /MD in the shared project properties") endif(MSVC AND ENABLE_MSVC_STATIC_RUNTIME) target_link_libraries(shared ${LINK_LIBRARIES}) endif(ENABLE_BUILD_SHARED OR ENABLE_BUILD_DYNAMIC) if(ENABLE_BUILD_IOS) find_file(CMAKE_TOOLCHAIN_FILE "ios.cmake") if(NOT CMAKE_TOOLCHAIN_FILE) message(FATAL_ERROR "Cannot compile GetDP for iOS without a toolchain") endif(NOT CMAKE_TOOLCHAIN_FILE) endif(ENABLE_BUILD_IOS) if(ENABLE_BUILD_ANDROID) find_file(CMAKE_TOOLCHAIN_FILE "android.toolchain.cmake") if(NOT CMAKE_TOOLCHAIN_FILE) message(SEND_ERROR "Cannot compile Getdp for android without a toolchain.") endif(NOT CMAKE_TOOLCHAIN_FILE) set(CMAKE_BUILD_TYPE Release) set(LIBRARY_OUTPUT_PATH_ROOT ${CMAKE_CURRENT_BINARY_DIR}) set(LIBRARY_OUTPUT_PATH ${CMAKE_CURRENT_BINARY_DIR}/libs/) add_definitions(-DBUILD_ANDROID) add_library(androidGetdp SHARED ${GETDP_SRC}) set_target_properties(androidGetdp PROPERTIES OUTPUT_NAME GetDP) target_link_libraries(androidGetdp ${LINK_LIBRARIES} ${LIBRARY_DEPS}) endif(ENABLE_BUILD_ANDROID) # binary target if(ENABLE_BUILD_DYNAMIC) add_executable(getdp Main/Main.cpp) target_link_libraries(getdp shared) else(ENABLE_BUILD_DYNAMIC) add_executable(getdp Main/Main.cpp ${GETDP_SRC}) target_link_libraries(getdp ${LINK_LIBRARIES}) endif(ENABLE_BUILD_DYNAMIC) # force static linking of system libraries with cygwin/mingw if(WIN32 AND NOT MSVC OR CYGWIN) if(NOT ENABLE_BUILD_DYNAMIC) set_target_properties(getdp PROPERTIES LINK_FLAGS "-static") # remove stupid -Wl,-Bdynamic flags set(CMAKE_EXE_LINK_DYNAMIC_C_FLAGS) set(CMAKE_EXE_LINK_DYNAMIC_CXX_FLAGS) endif(NOT ENABLE_BUILD_DYNAMIC) endif(WIN32 AND NOT MSVC OR CYGWIN) # parser target find_program(BISON bison) find_program(FLEX flex) if(BISON AND FLEX) add_custom_target(parser COMMAND ${BISON} -p getdp_yy --output ProParser.tab.cpp -d ProParser.y COMMAND ${FLEX} -P getdp_yy -o ProParser.yy.cpp ProParser.l WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}/Interface) endif(BISON AND FLEX) # miscellaneaous targets if(UNIX) # cannot use cmake's file search functions here (they would only # find files existing at configuration time) add_custom_target(purge COMMAND rm -f `find . -name *~ -o -name *~~` WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) add_custom_target(etags COMMAND etags `find . -name *.cpp -o -name *.h -o -name *.y` WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) endif(UNIX) set(WELCOME_FILE ${CMAKE_CURRENT_SOURCE_DIR}/doc/WELCOME.txt) set(LICENSE_FILE ${CMAKE_CURRENT_SOURCE_DIR}/doc/LICENSE.txt) set(CREDITS_FILE ${CMAKE_CURRENT_SOURCE_DIR}/doc/CREDITS.txt) file(GLOB DEMO_FILES ${CMAKE_CURRENT_SOURCE_DIR}/demos/*.pro ${CMAKE_CURRENT_SOURCE_DIR}/demos/*.geo ${CMAKE_CURRENT_SOURCE_DIR}/demos/*.msh) file(GLOB DEMO_FILES_TMP ${CMAKE_CURRENT_SOURCE_DIR}/demos/*.pre ${CMAKE_CURRENT_SOURCE_DIR}/demos/*.res ${CMAKE_CURRENT_SOURCE_DIR}/demos/*.txt ${CMAKE_CURRENT_SOURCE_DIR}/demos/*.pos ${CMAKE_CURRENT_SOURCE_DIR}/demos/*.par) set(TEX_DIR ${CMAKE_CURRENT_SOURCE_DIR}/doc/texinfo) file(GLOB TEX_SRC ${TEX_DIR}/*.texi) set(TEX_OBJ ${TEX_DIR}/getdp.aux ${TEX_DIR}/getdp.cp ${TEX_DIR}/getdp.cps ${TEX_DIR}/getdp.fn ${TEX_DIR}/getdp.html ${TEX_DIR}/getdp.info ${TEX_DIR}/getdp.ky ${TEX_DIR}/getdp.log ${TEX_DIR}/getdp.pdf ${TEX_DIR}/getdp.pg ${TEX_DIR}/getdp.toc ${TEX_DIR}/getdp.tp ${TEX_DIR}/getdp.tps ${TEX_DIR}/getdp.txt ${TEX_DIR}/getdp.vr ${TEX_DIR}/getdp.vrs) macro(unix2dos VARNAME) file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/unix2dos) set(UNIX2DOS_FILES) foreach(FILE ${${VARNAME}}) file(READ ${FILE} F0) get_filename_component(N ${FILE} NAME) if(CYGWIN) string(REGEX REPLACE "\n" "\r\n" F1 "${F0}") file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/unix2dos/${N} "${F1}") else(CYGWIN) # if not in cygwin, cmake adds '\r's automatically file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/unix2dos/${N} "${F0}") endif(CYGWIN) list(APPEND UNIX2DOS_FILES ${CMAKE_CURRENT_BINARY_DIR}/unix2dos/${N}) endforeach(FILE) set(${VARNAME} ${UNIX2DOS_FILES}) endmacro(unix2dos) if(WIN32 OR CYGWIN) set(GETDP_BIN .) set(GETDP_LIB .) set(GETDP_DOC .) set(GETDP_MAN .) if(CYGWIN) unix2dos(GETDP_API) unix2dos(WELCOME_FILE) unix2dos(LICENSE_FILE) unix2dos(CREDITS_FILE) unix2dos(DEMO_FILES) endif(CYGWIN) else(WIN32 OR CYGWIN) set(GETDP_BIN bin) set(GETDP_LIB lib) set(GETDP_DOC share/doc/getdp) set(GETDP_MAN share/man/man1) endif(WIN32 OR CYGWIN) # mark targets as optional so we can install them separately if needed # (e.g. "make lib" or "make shared" followed by "make install/fast") install(TARGETS getdp DESTINATION ${GETDP_BIN} OPTIONAL) if(ENABLE_BUILD_LIB) install(TARGETS lib DESTINATION ${GETDP_LIB} OPTIONAL) endif(ENABLE_BUILD_LIB) if(ENABLE_BUILD_SHARED OR ENABLE_BUILD_DYNAMIC) install(TARGETS shared DESTINATION ${GETDP_LIB} OPTIONAL) endif(ENABLE_BUILD_SHARED OR ENABLE_BUILD_DYNAMIC) if(ENABLE_BUILD_LIB OR ENABLE_BUILD_SHARED OR ENABLE_BUILD_DYNAMIC) install(FILES ${GETDP_API} DESTINATION include/getdp) endif(ENABLE_BUILD_LIB OR ENABLE_BUILD_SHARED OR ENABLE_BUILD_DYNAMIC) install(FILES ${WELCOME_FILE} DESTINATION ${GETDP_DOC} RENAME README.txt) install(FILES ${LICENSE_FILE} DESTINATION ${GETDP_DOC}) install(FILES ${CREDITS_FILE} DESTINATION ${GETDP_DOC}) install(FILES ${DEMO_FILES} DESTINATION ${GETDP_DOC}/demos) if(UNIX AND NOT CYGWIN) install(FILES ${CMAKE_CURRENT_SOURCE_DIR}/doc/getdp.1 DESTINATION ${GETDP_MAN}) endif(UNIX AND NOT CYGWIN) add_custom_target(clean_demos COMMAND ${CMAKE_COMMAND} -E remove ${DEMO_FILES_TMP}) add_custom_target(get_headers COMMAND ${CMAKE_COMMAND} -E make_directory Headers/getdp WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}) foreach(FILE ${GETDP_API}) add_custom_command(TARGET get_headers POST_BUILD COMMAND ${CMAKE_COMMAND} -E copy_if_different ${FILE} ${CMAKE_CURRENT_BINARY_DIR}/Headers/getdp/ WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) endforeach(FILE) find_program(MAKEINFO makeinfo) if(MAKEINFO) add_custom_command(OUTPUT ${TEX_DIR}/getdp.info DEPENDS ${TEX_SRC} COMMAND ${MAKEINFO} --split-size 1000000 ARGS ${TEX_DIR}/getdp.texi WORKING_DIRECTORY ${TEX_DIR}) add_custom_target(info DEPENDS ${TEX_DIR}/getdp.info) add_custom_command(OUTPUT ${TEX_DIR}/getdp.txt DEPENDS ${TEX_SRC} COMMAND ${MAKEINFO} --plaintext -o getdp.txt ARGS ${TEX_DIR}/getdp.texi WORKING_DIRECTORY ${TEX_DIR}) add_custom_target(txt DEPENDS ${TEX_DIR}/getdp.txt) add_custom_command(OUTPUT ${TEX_DIR}/getdp.html DEPENDS ${TEX_SRC} COMMAND ${MAKEINFO} --html --css-ref=http://geuz.org/geuz.css --no-split --set-customization-variable EXTRA_HEAD='' ARGS ${TEX_DIR}/getdp.texi WORKING_DIRECTORY ${TEX_DIR}) add_custom_target(html DEPENDS ${TEX_DIR}/getdp.html) install(FILES ${TEX_DIR}/getdp.html DESTINATION ${GETDP_DOC} OPTIONAL) endif(MAKEINFO) find_program(TEXI2PDF texi2pdf) if(TEXI2PDF) add_custom_command(OUTPUT ${TEX_DIR}/getdp.pdf DEPENDS ${TEX_SRC} COMMAND ${TEXI2PDF} ARGS ${TEX_DIR}/getdp.texi WORKING_DIRECTORY ${TEX_DIR}) add_custom_target(pdf DEPENDS ${TEX_DIR}/getdp.pdf) install(FILES ${TEX_DIR}/getdp.pdf DESTINATION ${GETDP_DOC} OPTIONAL) endif(TEXI2PDF) execute_process(COMMAND ${CMAKE_COMMAND} -E echo "${OPT_TEXI}" OUTPUT_FILE cmake_options.texi) if(MAKEINFO AND TEXI2PDF) add_custom_target(doc COMMAND ${CMAKE_COMMAND} -E tar zcf ${CMAKE_CURRENT_BINARY_DIR}/getdp-${GETDP_VERSION}-doc.tgz doc/CREDITS.txt doc/LICENSE.txt doc/VERSIONS.txt doc/getdp.1 doc/getdp.bib doc/texinfo/getdp.html doc/texinfo/getdp.info doc/texinfo/getdp.pdf doc/texinfo/getdp.txt COMMAND ${CMAKE_COMMAND} -E remove ${TEX_OBJ} DEPENDS ${TEX_DIR}/getdp.info ${TEX_DIR}/getdp.txt ${TEX_DIR}/getdp.html ${TEX_DIR}/getdp.pdf WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) endif(MAKEINFO AND TEXI2PDF) if(MAKEINFO OR TEXI2PDF) add_custom_target(clean_doc COMMAND ${CMAKE_COMMAND} -E remove ${TEX_OBJ}) endif(MAKEINFO OR TEXI2PDF) if(APPLE AND ENABLE_BUILD_LIB) file(READ ${CMAKE_CURRENT_SOURCE_DIR}/utils/misc/getdp_framework.plist F0) string(REPLACE GETDP_VERSION "${GETDP_VERSION}" F1 "${F0}") file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/Info_framework.plist "${F1}") get_target_property(LIBNAME lib LOCATION) #set(LIBNAME $) # FIXME: use this in the future add_custom_target(framework DEPENDS lib COMMAND ${CMAKE_COMMAND} -E remove_directory GetDP.framework COMMAND ${CMAKE_COMMAND} -E make_directory GetDP.framework/Headers COMMAND ${CMAKE_COMMAND} -E make_directory GetDP.framework/Resources COMMAND ${CMAKE_COMMAND} -E copy ${LIBNAME} GetDP.framework/GetDP COMMAND ${CMAKE_COMMAND} -E copy Info_framework.plist GetDP.framework/Resources/Info.plist WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}) foreach(FILE ${GETDP_API}) add_custom_command(TARGET framework POST_BUILD COMMAND ${CMAKE_COMMAND} -E copy ${FILE} ${CMAKE_CURRENT_BINARY_DIR}/GetDP.framework/Headers/ WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) endforeach(FILE) endif(APPLE AND ENABLE_BUILD_LIB) set(CPACK_PACKAGE_VENDOR "Patrick Dular and Christophe Geuzaine") set(CPACK_PACKAGE_VERSION_MAJOR ${GETDP_MAJOR_VERSION}) set(CPACK_PACKAGE_VERSION_MINOR ${GETDP_MINOR_VERSION}) set(CPACK_PACKAGE_VERSION_PATCH ${GETDP_PATCH_VERSION}) set(CPACK_PACKAGE_DESCRIPTION_FILE ${WELCOME_FILE}) set(CPACK_PACKAGE_DESCRIPTION_SUMMARY "General Environment for the Treatment of Discrete Problems") set(CPACK_PACKAGE_FILE_NAME getdp-${GETDP_VERSION}-${GETDP_OS}) set(CPACK_PACKAGE_INSTALL_DIRECTORY "GetDP") set(CPACK_RESOURCE_FILE_LICENSE ${LICENSE_FILE}) set(CPACK_RESOURCE_FILE_README ${WELCOME_FILE}) set(CPACK_RESOURCE_FILE_WELCOME ${WELCOME_FILE}) set(CPACK_PACKAGE_EXECUTABLE "getdp;GetDP") set(CPACK_STRIP_FILES TRUE) set(CPACK_SOURCE_PACKAGE_FILE_NAME getdp-${GETDP_VERSION}-source) set(CPACK_SOURCE_GENERATOR TGZ) set(CPACK_SOURCE_IGNORE_FILES "${CMAKE_CURRENT_BINARY_DIR}" "/CVS/" "/.svn" "~$" "DS_Store$" "GetDPConfig.h$" "GetDPVersion.h$" "/benchmarks*" "/tmp/" "/bin/" "/lib/" "/nightly/" "GPATH" "GRTAGS" "GSYMS" "GTAGS" "/HTML/" "/contrib/NR/" "/contrib/NX/" "/contrib/ZITSOL_1/") if(UNIX) # make sure we remove previous installs before doing the next one # (on Mac for example "make package; make package_source" would lead # to huge file lists getting generated due to the 'Applications' # symlink in the bundle) set(CPACK_INSTALL_COMMANDS "rm -rf ${CMAKE_CURRENT_BINARY_DIR}/_CPack_Packages") endif(UNIX) if(WIN32 OR CYGWIN) set(CPACK_GENERATOR ZIP) else(WIN32 OR CYGWIN) set(CPACK_GENERATOR TGZ) endif(WIN32 OR CYGWIN) include(CPack) include(CTest) file(GLOB_RECURSE TESTS demos/magnet.pro benchmarks/academic_eigenvalues/main.pro benchmarks/acoustic_scattering/scattering.pro benchmarks/inductor/inductor.pro benchmarks/machines/pmsm.pro benchmarks/magnetometer/magnetometer.pro benchmarks/magnets/magnets.pro benchmarks/thermal_conduction/contact.pro benchmarks/transfo_simple/transfo.pro benchmarks/waveguides/waveguide3D_rectangle.pro) if(HAVE_PETSC) file(GLOB_RECURSE TESTS_PETSC benchmarks/ddm_waves/main.pro) endif(HAVE_PETSC) find_program(TEST_BIN ../../gmsh/bin/gmsh) if(TEST_BIN) message(STATUS "Will test GetDP with Gmsh through ONELAB") else(TEST_BIN) message(STATUS "Will test GetDP stand-alone") set(TEST_BIN getdp) endif(TEST_BIN) foreach(TESTFILE ${TESTS} ${TESTS_PETSC}) # use relative path for cygwin/mingw (the pure win exe built with the mingw # compilers does not understand a full cygwin-style path) FILE(RELATIVE_PATH TEST ${CMAKE_CURRENT_BINARY_DIR} ${TESTFILE}) add_test(${TEST} ${TEST_BIN} ${TEST} - ) endforeach(TESTFILE) message(STATUS "") message(STATUS "GetDP ${GETDP_VERSION} has been configured for ${GETDP_OS}:") message(STATUS "") message(STATUS " * Build options:" ${GETDP_CONFIG_OPTIONS}) message(STATUS " * Build type: " ${CMAKE_BUILD_TYPE}) message(STATUS " * C compiler: " ${CMAKE_C_COMPILER}) message(STATUS " * C++ compiler: " ${CMAKE_CXX_COMPILER}) message(STATUS " * Fortran compiler: " ${CMAKE_Fortran_COMPILER}) message(STATUS " * Install prefix: " ${CMAKE_INSTALL_PREFIX}) message(STATUS "") mark_as_advanced(GETDP_EXTRA_VERSION ARPACK_LIB GMSH_INC GMSH_LIB GSLCBLAS_LIB GSL_INC GSL_LIB PETSC_LIBS SLEPC_INC SLEPC_INC2 SLEPC_LIB BISON FLEX MAKEINFO TEXI2PDF GETDP_EXTERNAL_INCLUDE_DIRS GETDP_EXTERNAL_LIBRARIES) getdp-2.7.0-source/aaa000644 001750 001750 00000006614 12575245473 016273 0ustar00geuzainegeuzaine000000 000000 """ Author: Erin Kuci Topology optimization using SIMP method and MMA algorithm (matlab) """ import sys sys.path.insert(0,'/Users/erinkuci/Desktop/src/getdp/benchmarks_kst/tool') from tool4 import * # ************************************************************************ # ***** Create the parameters ***** # ************************************************************************ parameters = Dictionnaire() parameters['plot'] = 1 # Model parameters['modelName'] = 'v' parameters['AnalysisModelType']='FEM' parameters['flagParallel'] = 0 parameters['flagOptType'] = 'Topology' #'Shape', 'Topology' parameters['simpPenal'] = 1.0 parameters['modelType'] = 'machine' parameters['analysisType'] = 0.0 parameters['NLferro'] = 1.0 parameters['NLferroLaw'] = 1.0 parameters['TorqueNominal'] = -130.0 # Design variables parameters['paramNameDisp'] = 'nu' parameters['VolFrac'] = 0.6 parameters['elementOfDomainTopOptTAG'] = 1001 # Performance function #parameters['performance'] = ['Compliance', 'Volume', 'MeanTorqueConstr'] #parameters['performance'] = ['TorqueVariance', 'Volume'] parameters['performance'] = ['TorqueVariance'] parameters['rotorAngles'] = np.zeros(1) #np.linspace(7.5,15.0,5) parameters['m'] = len(parameters['performance']) - 1 # number of constraint #parameters['sign'] = [-1.0,1.0,-1.0] parameters['sign'] = [1.0,1.0] parameters['fiMax'] = np.zeros(parameters['m']+1) # Sensitivity analysis parameters['flag_computeGrad'] = 1 parameters['SensitivityMethod'] = ['AnalyticAvmFixedDom'] #parameters['SensitivityMethod'] = ['AnalyticAvmFixedDom','Analytic'] parameters['FilterSensitivity'] = [1]#[1, 0] parameters['rmin'] = 0.0001*7.0 # Optimizer set-up parameters['optimizer'] = 'openopt' parameters['solverName'] = 'mma' parameters['xtol'] = 1.0e-08 # ************************************************************************ # ***** Instantiate the Model and the Optimizer ***** # ************************************************************************ op = OPTIMIZATION(parameters) # ************************************************************************ # ***** Optimization routine ***** # ************************************************************************ # Preprocess op.preprocessing(op.parameters) # Create optimizer op.create(op.parameters) # Call Optimizer f0Call = op.ObjFunc df0Call = op.ObjFuncDeriv fjCall = []#op.ineqConstr dfjCall = []#op.ineqConstrDeriv op.openOptCall(op.x0,op.xmax,op.xmin,op.parameters, f0Call,df0Call,fjCall,dfjCall) # Close optimizer op.close() # ************************************************************************ # ***** Optimization Post-Process ***** # ************************************************************************ # Optimization history x,f = op.postprocessing(op.parameters) ## Threeshold design variables #pathIn = 'res/designVar69.pos' #pathOut = 'res/designVarFilt.pos' #xf = op.threesoldDesignVar(0.6,op.n,op.parameters['indexStart'],pathIn,pathOut) # ## Compute torque #pathSave = ['resOpt/torqueBasic.npy','resOpt/torqueBasic.eps', # 'resOpt/torqueOpt.npy','resOpt/torqueOpt.eps', # 'resOpt/torqueCompare.eps'] ##pathLoad = ['resOpt/torqueBasic.npy','resOpt/torqueOpt.npy'] #angles=np.linspace(7.5,15.0+7.5,15*3) #op.compareTorque(x0,xf,angles,op.parameters,pathSave)