From 7e147e56794b06b4eb695c17d9ca79c51b4d89d1 Mon Sep 17 00:00:00 2001 From: Chris Bradley Date: Sun, 24 Sep 2017 14:56:19 +1300 Subject: [PATCH 1/6] Change Computational to Computation to avoid symbol length problems. Rename computational environment module to ComputationalRoutines. Change computational_environment.f90 to computational_routines.f90. Fix up comptuational routines module for new style. --- bindings/c/tests/laplace.c | 12 +- cmake/Sources.cmake | 2 +- src/Darcy_equations_routines.f90 | 8 +- src/Navier_Stokes_equations_routines.f90 | 122 +-- src/analytic_analysis_routines.f90 | 44 +- src/base_routines.f90 | 52 +- src/boundary_condition_routines.f90 | 30 +- src/cmiss.f90 | 16 +- src/computation_routines.f90 | 818 +++++++++++++++++ src/computational_environment.f90 | 820 ------------------ src/data_projection_routines.f90 | 114 +-- src/distributed_matrix_vector.f90 | 105 +-- src/domain_mappings.f90 | 24 +- src/equations_set_routines.f90 | 14 +- src/field_IO_routines.f90 | 342 ++++---- src/field_routines.f90 | 32 +- src/fieldml_input_routines.f90 | 8 +- src/fieldml_output_routines.f90 | 8 +- src/finite_elasticity_routines.f90 | 28 +- src/generated_mesh_routines.f90 | 28 +- src/mesh_routines.f90 | 160 ++-- src/opencmiss_iron.f90 | 223 ++--- src/reaction_diffusion_IO_routines.f90 | 264 +++--- src/reaction_diffusion_equation_routines.f90 | 22 +- src/solver_mapping_routines.f90 | 32 +- src/solver_routines.f90 | 16 +- src/types.f90 | 10 +- tests/CellML/CellMLModelIntegration.f90 | 24 +- tests/CellML/Monodomain.f90 | 20 +- tests/ClassicalField/AnalyticHelmholtz.f90 | 2 +- tests/ClassicalField/AnalyticLaplace.f90 | 2 +- .../AnalyticNonlinearPoisson.f90 | 10 +- tests/ClassicalField/Laplace.f90 | 14 +- tests/FieldML_IO/cube.f90 | 10 +- tests/FieldML_IO/fieldml_io.f90 | 8 +- tests/FiniteElasticity/Cantilever.f90 | 12 +- tests/FiniteElasticity/SimpleShear.f90 | 14 +- tests/LinearElasticity/CantileverBeam.f90 | 10 +- tests/LinearElasticity/Extension.f90 | 10 +- 39 files changed, 1745 insertions(+), 1745 deletions(-) create mode 100755 src/computation_routines.f90 delete mode 100755 src/computational_environment.f90 diff --git a/bindings/c/tests/laplace.c b/bindings/c/tests/laplace.c index e2759f9a..f7166def 100755 --- a/bindings/c/tests/laplace.c +++ b/bindings/c/tests/laplace.c @@ -103,7 +103,7 @@ int main() cmfe_SolverType Solver=(cmfe_SolverType)NULL; cmfe_SolverEquationsType SolverEquations=(cmfe_SolverEquationsType)NULL; - int NumberOfComputationalNodes,ComputationalNodeNumber; + int NumberOfComputationNodes,ComputationNodeNumber; int EquationsSetIndex; int FirstNodeNumber,LastNodeNumber; int FirstNodeDomain,LastNodeDomain; @@ -127,8 +127,8 @@ int main() CHECK_ERROR("Initialising OpenCMISS-Iron"); Err = cmfe_ErrorHandlingModeSet(CMFE_ERRORS_TRAP_ERROR); - Err = cmfe_ComputationalNumberOfNodesGet(&NumberOfComputationalNodes); - Err = cmfe_ComputationalNodeNumberGet(&ComputationalNodeNumber); + Err = cmfe_ComputationNumberOfNodesGet(&NumberOfComputationNodes); + Err = cmfe_ComputationNodeNumberGet(&ComputationNodeNumber); /* Start the creation of a new RC coordinate system */ Err = cmfe_CoordinateSystem_Initialise(&CoordinateSystem); @@ -200,7 +200,7 @@ int main() Err = cmfe_Decomposition_CreateStart(DECOMPOSITION_USER_NUMBER,Mesh,Decomposition); /* Set the decomposition to be a general decomposition with the specified number of domains */ Err = cmfe_Decomposition_TypeSet(Decomposition,CMFE_DECOMPOSITION_CALCULATED_TYPE); - Err = cmfe_Decomposition_NumberOfDomainsSet(Decomposition,NumberOfComputationalNodes); + Err = cmfe_Decomposition_NumberOfDomainsSet(Decomposition,NumberOfComputationNodes); /* Finish the decomposition */ Err = cmfe_Decomposition_CreateFinish(Decomposition); @@ -313,12 +313,12 @@ int main() } Err = cmfe_Decomposition_NodeDomainGet(Decomposition,FirstNodeNumber,1,&FirstNodeDomain); Err = cmfe_Decomposition_NodeDomainGet(Decomposition,LastNodeNumber,1,&LastNodeDomain); - if(FirstNodeDomain==ComputationalNodeNumber) + if(FirstNodeDomain==ComputationNodeNumber) { Err = cmfe_BoundaryConditions_SetNode(BoundaryConditions,DependentField,CMFE_FIELD_U_VARIABLE_TYPE,1,1,FirstNodeNumber,1, \ CMFE_BOUNDARY_CONDITION_FIXED,0.0); } - if(LastNodeDomain==ComputationalNodeNumber) + if(LastNodeDomain==ComputationNodeNumber) { Err = cmfe_BoundaryConditions_SetNode(BoundaryConditions,DependentField,CMFE_FIELD_U_VARIABLE_TYPE,1,1,LastNodeNumber,1, \ CMFE_BOUNDARY_CONDITION_FIXED,1.0); diff --git a/cmake/Sources.cmake b/cmake/Sources.cmake index 9bbfed0b..ac10c9c2 100644 --- a/cmake/Sources.cmake +++ b/cmake/Sources.cmake @@ -36,7 +36,7 @@ set(IRON_Fortran_SRC cmiss_petsc_types.f90 cmiss_petsc.f90 cmiss.f90 - computational_environment.f90 + computation_routines.f90 constants.f90 control_loop_routines.f90 control_loop_access_routines.f90 diff --git a/src/Darcy_equations_routines.f90 b/src/Darcy_equations_routines.f90 index 88f78b70..d3e70fc0 100755 --- a/src/Darcy_equations_routines.f90 +++ b/src/Darcy_equations_routines.f90 @@ -51,7 +51,7 @@ MODULE DARCY_EQUATIONS_ROUTINES USE Constants USE CONTROL_LOOP_ROUTINES USE ControlLoopAccessRoutines - USE ComputationEnvironment + USE ComputationRoutines USE COORDINATE_ROUTINES USE DISTRIBUTED_MATRIX_VECTOR USE DOMAIN_MAPPINGS @@ -7253,7 +7253,7 @@ SUBROUTINE DARCY_EQUATION_MONITOR_CONVERGENCE(CONTROL_LOOP,SOLVER,err,error,*) INTEGER(INTG) :: FIELD_VAR_TYPE INTEGER(INTG) :: dof_number,NUMBER_OF_DOFS,equations_set_idx - INTEGER(INTG) :: COMPUTATIONAL_NODE_NUMBER + INTEGER(INTG) :: COMPUTATION_NODE_NUMBER INTEGER(INTG) :: FILEUNIT_N, FILEUNIT_N1 ENTERS("DARCY_EQUATION_MONITOR_CONVERGENCE",err,error,*999) @@ -7266,8 +7266,8 @@ SUBROUTINE DARCY_EQUATION_MONITOR_CONVERGENCE(CONTROL_LOOP,SOLVER,err,error,*) NULLIFY(vectorMapping) NULLIFY(FIELD_VARIABLE) - COMPUTATIONAL_NODE_NUMBER=ComputationalEnvironment_NodeNumberGet(err,error) - WRITE(FILENAME,'("Darcy_",I3.3,".conv")') COMPUTATIONAL_NODE_NUMBER + COMPUTATION_NODE_NUMBER=ComputationEnvironment_NodeNumberGet(err,error) + WRITE(FILENAME,'("Darcy_",I3.3,".conv")') COMPUTATION_NODE_NUMBER FILEPATH = "./output/"//FILENAME OPEN(UNIT=23, FILE=CHAR(FILEPATH),STATUS='unknown',ACCESS='append') diff --git a/src/Navier_Stokes_equations_routines.f90 b/src/Navier_Stokes_equations_routines.f90 index b8931e8d..2522dadc 100644 --- a/src/Navier_Stokes_equations_routines.f90 +++ b/src/Navier_Stokes_equations_routines.f90 @@ -26,7 +26,7 @@ !> Auckland, the University of Oxford and King's College, London. !> All Rights Reserved. !> -!> Contributor(s): David Ladd, Soroush Safaei, Chris Bradley +!> Contributor(s): Sebastian Krittian, David Ladd, Soroush Safaei, Chris Bradley !> !> Alternatively, the contents of this file may be used under the terms of !> either the GNU General Public License Version 2 or later (the "GPL"), or @@ -53,7 +53,7 @@ MODULE NAVIER_STOKES_EQUATIONS_ROUTINES USE CmissMPI USE CmissPetsc USE CmissPetscTypes - USE ComputationEnvironment + USE ComputationRoutines USE Constants USE CONTROL_LOOP_ROUTINES USE COORDINATE_ROUTINES @@ -7007,7 +7007,7 @@ SUBROUTINE NavierStokes_PreSolveUpdateBoundaryConditions(SOLVER,err,error,*) INTEGER(INTG) :: componentNumberVelocity,numberOfDimensions,numberOfNodes,numberOfGlobalNodes INTEGER(INTG) :: dependentVariableType,independentVariableType,dependentDof,independentDof,userNodeNumber,localNodeNumber INTEGER(INTG) :: EquationsSetIndex,SolidNodeNumber,FluidNodeNumber,equationsSetIdx - INTEGER(INTG) :: currentTimeLoopIteration,outputIterationNumber,numberOfFittedNodes,computationalNode + INTEGER(INTG) :: currentTimeLoopIteration,outputIterationNumber,numberOfFittedNodes,computationNode INTEGER(INTG), ALLOCATABLE :: InletNodes(:) REAL(DP) :: CURRENT_TIME,TIME_INCREMENT,DISPLACEMENT_VALUE,VALUE,XI_COORDINATES(3),timeData,QP,QPP,componentValues(3) REAL(DP) :: T_COORDINATES(20,3),MU_PARAM,RHO_PARAM,X(3),FluidGFValue,SolidDFValue,NewLaplaceBoundaryValue,Lref,Tref,Mref @@ -7100,7 +7100,7 @@ SUBROUTINE NavierStokes_PreSolveUpdateBoundaryConditions(SOLVER,err,error,*) IF(ASSOCIATED(independentField)) THEN componentNumberVelocity = 1 numberOfDimensions = dependentFieldVariable%NUMBER_OF_COMPONENTS - 1 - ! Get the nodes on this computational domain + ! Get the nodes on this computation domain IF(independentFieldVariable%COMPONENTS(componentNumberVelocity)%INTERPOLATION_TYPE== & & FIELD_NODE_BASED_INTERPOLATION) THEN domain=>independentFieldVariable%COMPONENTS(componentNumberVelocity)%DOMAIN @@ -7123,7 +7123,7 @@ SUBROUTINE NavierStokes_PreSolveUpdateBoundaryConditions(SOLVER,err,error,*) CALL FlagError("Only node based interpolation is implemented.",err,error,*999) END IF - ! Construct the filename based on the computational node and time step + ! Construct the filename based on the computation node and time step inputFile = './../interpolatedData/fitData' //TRIM(NUMBER_TO_VSTRING(currentTimeLoopIteration, & & "*",ERR,ERROR)) // '.dat' @@ -7142,7 +7142,7 @@ SUBROUTINE NavierStokes_PreSolveUpdateBoundaryConditions(SOLVER,err,error,*) CALL DOMAIN_TOPOLOGY_NODE_CHECK_EXISTS(domain%Topology,userNodeNumber,nodeExists, & & localNodeNumber,ghostNode,err,error,*999) IF(nodeExists .AND. .NOT. ghostNode) THEN - ! Node found on this computational node + ! Node found on this computation node READ(10,*) (componentValues(componentIdx), componentIdx=1,numberOfDimensions) DO componentIdx=1,numberOfDimensions dependentDof = dependentFieldVariable%COMPONENTS(componentIdx)%PARAM_TO_DOF_MAP% & @@ -7161,7 +7161,7 @@ SUBROUTINE NavierStokes_PreSolveUpdateBoundaryConditions(SOLVER,err,error,*) END IF END DO !componentIdx ELSE - ! Dummy read if this node not on this computational node + ! Dummy read if this node not on this computation node READ(10,*) END IF END DO @@ -7739,7 +7739,7 @@ SUBROUTINE NavierStokes_PreSolveUpdateBoundaryConditions(SOLVER,err,error,*) IF(ASSOCIATED(independentField)) THEN componentNumberVelocity = 1 numberOfDimensions = dependentFieldVariable%NUMBER_OF_COMPONENTS - 1 - ! Get the nodes on this computational domain + ! Get the nodes on this computation domain IF(independentFieldVariable%COMPONENTS(componentNumberVelocity)%INTERPOLATION_TYPE== & & FIELD_NODE_BASED_INTERPOLATION) THEN domain=>independentFieldVariable%COMPONENTS(componentNumberVelocity)%DOMAIN @@ -7762,15 +7762,15 @@ SUBROUTINE NavierStokes_PreSolveUpdateBoundaryConditions(SOLVER,err,error,*) CALL FlagError("Only node based interpolation is implemented.",ERR,ERROR,*999) END IF - ! Construct the filename based on the computational node and time step + ! Construct the filename based on the computation node and time step inputFile = './../interpolatedData/fitData' //TRIM(NUMBER_TO_VSTRING(currentTimeLoopIteration, & & "*",ERR,ERROR)) // '.dat' INQUIRE(FILE=inputFile, EXIST=importDataFromFile) IF(importDataFromFile) THEN !Read fitted data from input file (if exists) - computationalNode = ComputationalEnvironment_NodeNumberGet(ERR,ERROR) - IF(computationalNode==0) THEN + computationNode = ComputationEnvironment_NodeNumberGet(ERR,ERROR) + IF(computationNode==0) THEN CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Updating independent field and boundary nodes from " & & //inputFile,ERR,ERROR,*999) END IF @@ -7784,7 +7784,7 @@ SUBROUTINE NavierStokes_PreSolveUpdateBoundaryConditions(SOLVER,err,error,*) CALL DOMAIN_TOPOLOGY_NODE_CHECK_EXISTS(domain%Topology,userNodeNumber,nodeExists, & & localNodeNumber,ghostNode,err,error,*999) IF(nodeExists .AND. .NOT. ghostNode) THEN - ! Node found on this computational node + ! Node found on this computation node READ(10,*) (componentValues(componentIdx), componentIdx=1,numberOfDimensions) DO componentIdx=1,numberOfDimensions dependentDof = dependentFieldVariable%COMPONENTS(componentIdx)%PARAM_TO_DOF_MAP% & @@ -7803,7 +7803,7 @@ SUBROUTINE NavierStokes_PreSolveUpdateBoundaryConditions(SOLVER,err,error,*) END IF END DO !componentIdx ELSE - ! Dummy read if this node not on this computational node + ! Dummy read if this node not on this computation node READ(10,*) END IF END DO @@ -12560,8 +12560,8 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux(equationsSet,coupledEquationsSet,i INTEGER(INTG) :: faceNodeDerivativeIdx, meshComponentNumber INTEGER(INTG) :: normalComponentIdx INTEGER(INTG) :: boundaryID,numberOfBoundaries,boundaryType,coupledNodeNumber,numberOfGlobalBoundaries - INTEGER(INTG) :: MPI_IERROR,numberOfComputationalNodes - INTEGER(INTG) :: i,j,computationalNode + INTEGER(INTG) :: MPI_IERROR,numberOfComputationNodes + INTEGER(INTG) :: i,j,computationNode REAL(DP) :: gaussWeight, normalProjection,elementNormal(3) REAL(DP) :: normalDifference,normalTolerance REAL(DP) :: courant,maxCourant,toleranceCourant @@ -12875,28 +12875,28 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux(equationsSet,coupledEquationsSet,i ! G a t h e r v a l u e s o v e r t h r e a d s ! ------------------------------------------------------ - ! Need to add boundary flux for any boundaries split accross computational nodes + ! Need to add boundary flux for any boundaries split accross computation nodes numberOfGlobalBoundaries = 0 globalBoundaryFlux = 0.0_DP globalBoundaryArea = 0.0_DP globalBoundaryPressure = 0.0_DP globalBoundaryNormalStress = 0.0_DP - numberOfComputationalNodes=computationalEnvironment%numberOfComputationalNodes - IF(numberOfComputationalNodes>1) THEN !use mpi + numberOfComputationNodes=computationEnvironment%numberOfComputationNodes + IF(numberOfComputationNodes>1) THEN !use mpi CALL MPI_ALLREDUCE(localBoundaryFlux,globalBoundaryFlux,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,err,error,*999) CALL MPI_ALLREDUCE(localBoundaryArea,globalBoundaryArea,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(localBoundaryNormalStress,globalBoundaryNormalStress,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(localBoundaryPressure,globalBoundaryPressure,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(numberOfBoundaries,numberOfGlobalBoundaries,1,MPI_INTEGER,MPI_MAX, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) ELSE numberOfGlobalBoundaries = numberOfBoundaries @@ -12914,8 +12914,8 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux(equationsSet,coupledEquationsSet,i END DO DO boundaryID=2,numberOfGlobalBoundaries IF(globalBoundaryArea(boundaryID) > ZERO_TOLERANCE) THEN - computationalNode = ComputationalEnvironment_NodeNumberGet(ERR,ERROR) - IF(computationalNode==0) THEN + computationNode = ComputationEnvironment_NodeNumberGet(ERR,ERROR) + IF(computationNode==0) THEN CALL WriteStringTwoValue(DIAGNOSTIC_OUTPUT_TYPE,"3D boundary ",boundaryID," flow: ", & & globalBoundaryFlux(boundaryID),err,error,*999) CALL WriteStringTwoValue(DIAGNOSTIC_OUTPUT_TYPE,"3D boundary ",boundaryID," area: ", & @@ -13179,11 +13179,11 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux(equationsSet,coupledEquationsSet,i END DO !elementIdx !allocate array for mpi communication - IF(numberOfComputationalNodes>1) THEN !use mpi - ALLOCATE(globalConverged(numberOfComputationalNodes),STAT=ERR) + IF(numberOfComputationNodes>1) THEN !use mpi + ALLOCATE(globalConverged(numberOfComputationNodes),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate global convergence check array.",ERR,ERROR,*999) CALL MPI_ALLGATHER(convergedFlag,1,MPI_LOGICAL,globalConverged,1,MPI_LOGICAL, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPI_IERROR,ERR,ERROR,*999) IF(ALL(globalConverged)) THEN convergedFlag = .TRUE. @@ -13253,7 +13253,7 @@ SUBROUTINE NavierStokes_Couple1D0D(controlLoop,solver,err,error,*) TYPE(VARYING_STRING) :: localError INTEGER(INTG) :: nodeNumber,nodeIdx,derivativeIdx,versionIdx,componentIdx,numberOfLocalNodes1D INTEGER(INTG) :: solver1dNavierStokesNumber,solverNumber,MPI_IERROR,timestep,iteration - INTEGER(INTG) :: boundaryNumber,numberOfBoundaries,numberOfComputationalNodes + INTEGER(INTG) :: boundaryNumber,numberOfBoundaries,numberOfComputationNodes INTEGER(INTG) :: dependentDof,boundaryConditionType REAL(DP) :: A0_PARAM,E_PARAM,H_PARAM,beta,pCellML,normalWave(2) REAL(DP) :: qPrevious,pPrevious,aPrevious,q1d,a1d,qError,aError,couplingTolerance @@ -13475,13 +13475,13 @@ SUBROUTINE NavierStokes_Couple1D0D(controlLoop,solver,err,error,*) localConverged = .FALSE. END IF ! Need to check that boundaries have converged globally (on all domains) if this is a parallel problem - numberOfComputationalNodes=computationalEnvironment%numberOfComputationalNodes - IF(numberOfComputationalNodes>1) THEN !use mpi + numberOfComputationNodes=computationEnvironment%numberOfComputationNodes + IF(numberOfComputationNodes>1) THEN !use mpi !allocate array for mpi communication - ALLOCATE(globalConverged(numberOfComputationalNodes),STAT=ERR) + ALLOCATE(globalConverged(numberOfComputationNodes),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate global convergence check array.",ERR,ERROR,*999) CALL MPI_ALLGATHER(localConverged,1,MPI_LOGICAL,globalConverged,1,MPI_LOGICAL, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPI_IERROR,err,error,*999) IF(ALL(globalConverged)) THEN !CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"1D/0D coupling converged; # iterations: ", & @@ -13544,8 +13544,8 @@ SUBROUTINE NavierStokes_Couple3D1D(controlLoop,err,error,*) TYPE(VARYING_STRING) :: localError INTEGER(INTG) :: nodeNumber,nodeIdx,derivativeIdx,versionIdx,componentIdx,numberOfLocalNodes1D INTEGER(INTG) :: solver1dNavierStokesNumber,MPI_IERROR,timestep,iteration - INTEGER(INTG) :: boundaryNumber,boundaryType1D,numberOfBoundaries,numberOfComputationalNodes - INTEGER(INTG) :: solver3dNavierStokesNumber,userNodeNumber,localDof,globalDof,computationalNode + INTEGER(INTG) :: boundaryNumber,boundaryType1D,numberOfBoundaries,numberOfComputationNodes + INTEGER(INTG) :: solver3dNavierStokesNumber,userNodeNumber,localDof,globalDof,computationNode REAL(DP) :: normalWave(2) REAL(DP) :: flow1D,stress1D,flow1DPrevious,stress1DPrevious,flow3D,stress3D,flowError,stressError REAL(DP) :: maxStressError,maxFlowError,flowTolerance,stressTolerance,absoluteCouplingTolerance @@ -13764,22 +13764,22 @@ SUBROUTINE NavierStokes_Couple3D1D(controlLoop,err,error,*) localConverged = .TRUE. END IF ! Need to check that boundaries have converged globally (on all domains) if this is a MPI problem - numberOfComputationalNodes=computationalEnvironment%numberOfComputationalNodes - IF(numberOfComputationalNodes>1) THEN !use mpi + numberOfComputationNodes=computationEnvironment%numberOfComputationNodes + IF(numberOfComputationNodes>1) THEN !use mpi !allocate array for mpi communication IF(ERR/=0) CALL FlagError("Could not allocate global convergence check array.",ERR,ERROR,*999) - CALL MPI_ALLREDUCE(localConverged,globalConverged,1,MPI_LOGICAL,MPI_LAND,computationalEnvironment%mpiCommunicator,MPI_IERROR) + CALL MPI_ALLREDUCE(localConverged,globalConverged,1,MPI_LOGICAL,MPI_LAND,computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) IF(globalConverged) THEN CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"3D/1D coupling converged; # iterations: ", & & iteration,err,error,*999) iterativeLoop%CONTINUE_LOOP=.FALSE. ELSE - computationalNode = ComputationalEnvironment_NodeNumberGet(ERR,ERROR) - CALL WriteStringTwoValue(DIAGNOSTIC_OUTPUT_TYPE,"Rank ",computationalNode," 3D/1D max flow error: ", & + computationNode = ComputationEnvironment_NodeNumberGet(ERR,ERROR) + CALL WriteStringTwoValue(DIAGNOSTIC_OUTPUT_TYPE,"Rank ",computationNode," 3D/1D max flow error: ", & & maxFlowError,err,error,*999) - CALL WriteStringTwoValue(DIAGNOSTIC_OUTPUT_TYPE,"Rank ",computationalNode," 3D/1D max stress error: ", & + CALL WriteStringTwoValue(DIAGNOSTIC_OUTPUT_TYPE,"Rank ",computationNode," 3D/1D max stress error: ", & & maxStressError,err,error,*999) END IF ELSE @@ -13844,7 +13844,7 @@ SUBROUTINE NavierStokes_CoupleCharacteristics(controlLoop,solver,err,error,*) TYPE(VARYING_STRING) :: localError INTEGER(INTG) :: nodeNumber,nodeIdx,derivativeIdx,versionIdx,componentIdx,i INTEGER(INTG) :: solver1dNavierStokesNumber,solverNumber - INTEGER(INTG) :: branchNumber,numberOfBranches,numberOfComputationalNodes,numberOfVersions + INTEGER(INTG) :: branchNumber,numberOfBranches,numberOfComputationNodes,numberOfVersions INTEGER(INTG) :: MPI_IERROR,timestep,iteration,outputIteration REAL(DP) :: couplingTolerance,l2ErrorW(30),wPrevious(2,7),wNavierStokes(2,7),wCharacteristic(2,7),wError(2,7) REAL(DP) :: l2ErrorQ(100),qCharacteristic(7),qNavierStokes(7),wNext(2,7) @@ -14055,13 +14055,13 @@ SUBROUTINE NavierStokes_CoupleCharacteristics(controlLoop,solver,err,error,*) localConverged = .FALSE. END IF ! Need to check that boundaries have converged globally (on all domains) if this is a parallel problem - numberOfComputationalNodes=computationalEnvironment%numberOfComputationalNodes - IF(numberOfComputationalNodes>1) THEN !use mpi + numberOfComputationNodes=computationEnvironment%numberOfComputationNodes + IF(numberOfComputationNodes>1) THEN !use mpi !allocate array for mpi communication - ALLOCATE(globalConverged(numberOfComputationalNodes),STAT=ERR) + ALLOCATE(globalConverged(numberOfComputationNodes),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate global convergence check array.",ERR,ERROR,*999) CALL MPI_ALLGATHER(localConverged,1,MPI_LOGICAL,globalConverged,1,MPI_LOGICAL, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPI_IERROR,err,error,*999) IF(ALL(globalConverged)) THEN !CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"Navier-Stokes/Characteristic converged; # iterations: ", & @@ -14169,7 +14169,7 @@ SUBROUTINE NavierStokes_ShearRateCalculate(equationsSet,err,error,*) DO elementIdx=startElement,stopElement localElementNumber=elementsMapping%DOMAIN_LIST(elementIdx) userElementNumber = elementsMapping%LOCAL_TO_GLOBAL_MAP(localElementNumber) - !Check computational node for elementIdx + !Check computation node for elementIdx elementExists=.FALSE. ghostElement=.TRUE. CALL DECOMPOSITION_TOPOLOGY_ELEMENT_CHECK_EXISTS(decomposition%TOPOLOGY, & @@ -15020,8 +15020,8 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux3D0D(equationsSet,err,error,*) INTEGER(INTG) :: faceNodeIdx, elementNodeIdx INTEGER(INTG) :: faceNodeDerivativeIdx, meshComponentNumber INTEGER(INTG) :: boundaryID,numberOfBoundaries,boundaryType,coupledNodeNumber,numberOfGlobalBoundaries - INTEGER(INTG) :: MPI_IERROR,numberOfComputationalNodes - INTEGER(INTG) :: computationalNode,xiDirection(3),orientation + INTEGER(INTG) :: MPI_IERROR,numberOfComputationNodes + INTEGER(INTG) :: computationNode,xiDirection(3),orientation REAL(DP) :: gaussWeight, elementNormal(3) REAL(DP) :: normalDifference,normalTolerance REAL(DP) :: courant,maxCourant,toleranceCourant,boundaryValueTemp @@ -15248,24 +15248,24 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux3D0D(equationsSet,err,error,*) ! G a t h e r v a l u e s o v e r t h r e a d s ! ------------------------------------------------------ - ! Need to add boundary flux for any boundaries split accross computational nodes + ! Need to add boundary flux for any boundaries split accross computation nodes numberOfGlobalBoundaries = 0 globalBoundaryFlux = 0.0_DP globalBoundaryArea = 0.0_DP globalBoundaryPressure = 0.0_DP - numberOfComputationalNodes=computationalEnvironment%numberOfComputationalNodes - IF(numberOfComputationalNodes>1) THEN !use mpi + numberOfComputationNodes=computationEnvironment%numberOfComputationNodes + IF(numberOfComputationNodes>1) THEN !use mpi CALL MPI_ALLREDUCE(localBoundaryFlux,globalBoundaryFlux,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(localBoundaryArea,globalBoundaryArea,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(localBoundaryPressure,globalBoundaryPressure,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(numberOfBoundaries,numberOfGlobalBoundaries,1,MPI_INTEGER,MPI_MAX, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) ELSE numberOfGlobalBoundaries = numberOfBoundaries @@ -15281,8 +15281,8 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux3D0D(equationsSet,err,error,*) END DO DO boundaryID=2,numberOfGlobalBoundaries IF(globalBoundaryArea(boundaryID) > ZERO_TOLERANCE) THEN - computationalNode = ComputationalEnvironment_NodeNumberGet(ERR,ERROR) - IF(computationalNode==0) THEN + computationNode = ComputationEnvironment_NodeNumberGet(ERR,ERROR) + IF(computationNode==0) THEN CALL WriteStringTwoValue(DIAGNOSTIC_OUTPUT_TYPE,"3D boundary ",boundaryID," flow: ", & & globalBoundaryFlux(boundaryID),err,error,*999) CALL WriteStringTwoValue(DIAGNOSTIC_OUTPUT_TYPE,"3D boundary ",boundaryID," mean pressure: ", & @@ -15409,11 +15409,11 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux3D0D(equationsSet,err,error,*) END DO !elementIdx !allocate array for mpi communication - IF(numberOfComputationalNodes>1) THEN !use mpi - ALLOCATE(globalConverged(numberOfComputationalNodes),STAT=ERR) + IF(numberOfComputationNodes>1) THEN !use mpi + ALLOCATE(globalConverged(numberOfComputationNodes),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate global convergence check array.",ERR,ERROR,*999) CALL MPI_ALLGATHER(convergedFlag,1,MPI_LOGICAL,globalConverged,1,MPI_LOGICAL, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPI_IERROR,ERR,ERROR,*999) IF(ALL(globalConverged)) THEN convergedFlag = .TRUE. diff --git a/src/analytic_analysis_routines.f90 b/src/analytic_analysis_routines.f90 index e480155b..873d0950 100755 --- a/src/analytic_analysis_routines.f90 +++ b/src/analytic_analysis_routines.f90 @@ -46,7 +46,7 @@ MODULE ANALYTIC_ANALYSIS_ROUTINES USE BASIS_ROUTINES USE CmissMPI - USE ComputationEnvironment + USE ComputationRoutines USE CONSTANTS USE FIELD_ROUTINES USE FieldAccessRoutines @@ -147,9 +147,9 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) IF(FIELD%DEPENDENT_TYPE==FIELD_DEPENDENT_TYPE) THEN IF(LEN_TRIM(FILENAME)>=1) THEN !!TODO \todo have more general ascii file mechanism - IF(computationalEnvironment%numberOfComputationalNodes>1) THEN - WRITE(FILE_NAME,'(A,".opanal.",I0)') FILENAME(1:LEN_TRIM(FILENAME)),computationalEnvironment% & - & myComputationalNodeNumber + IF(computationEnvironment%numberOfComputationNodes>1) THEN + WRITE(FILE_NAME,'(A,".opanal.",I0)') FILENAME(1:LEN_TRIM(FILENAME)),computationEnvironment% & + & myComputationNodeNumber ELSE FILE_NAME=FILENAME(1:LEN_TRIM(FILENAME))//".opanal" ENDIF @@ -270,7 +270,7 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) !Output RMS errors CALL WRITE_STRING(OUTPUT_ID,"",ERR,ERROR,*999) IF(NUMBER(1)>0) THEN - IF(computationalEnvironment%numberOfComputationalNodes>1) THEN + IF(computationEnvironment%numberOfComputationNodes>1) THEN !Local elements only CALL WRITE_STRING(OUTPUT_ID,"Local RMS errors:",ERR,ERROR,*999) LOCAL_STRING= & @@ -294,16 +294,16 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) !Global RMS values !Collect the values across the ranks CALL MPI_ALLREDUCE(MPI_IN_PLACE,NUMBER,1,MPI_INTEGER,MPI_SUM, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR_PER,1,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR_ABS,1,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR_REL,1,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL WRITE_STRING(OUTPUT_ID,"Global RMS errors:",ERR,ERROR,*999) LOCAL_STRING= & @@ -400,7 +400,7 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) ENDDO !node_idx !Output RMS errors CALL WRITE_STRING(OUTPUT_ID,"",ERR,ERROR,*999) - IF(computationalEnvironment%numberOfComputationalNodes>1) THEN + IF(computationEnvironment%numberOfComputationNodes>1) THEN IF(ANY(NUMBER>0)) THEN !Local nodes only CALL WRITE_STRING(OUTPUT_ID,"Local RMS errors:",ERR,ERROR,*999) @@ -438,16 +438,16 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) !Global RMS values !Collect the values across the ranks CALL MPI_ALLREDUCE(MPI_IN_PLACE,NUMBER,8,MPI_INTEGER,MPI_SUM, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR_PER,8,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR_ABS,8,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR_REL,8,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL WRITE_STRING(OUTPUT_ID,"Global RMS errors:",ERR,ERROR,*999) LOCAL_STRING= & @@ -517,7 +517,7 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) ALLOCATE(GHOST_INTEGRAL_ERRORS(6,FIELD_VARIABLE%NUMBER_OF_COMPONENTS),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate ghost integral errors.",ERR,ERROR,*999) CALL ANALYTIC_ANALYSIS_INTEGRAL_ERRORS(FIELD_VARIABLE,INTEGRAL_ERRORS,GHOST_INTEGRAL_ERRORS,ERR,ERROR,*999) - IF(computationalEnvironment%numberOfComputationalNodes>1) THEN + IF(computationEnvironment%numberOfComputationNodes>1) THEN CALL WRITE_STRING(OUTPUT_ID,"Local Integral errors:",ERR,ERROR,*999) LOCAL_STRING="Component# Numerical Analytic % error Absolute err Relative err" CALL WRITE_STRING(OUTPUT_ID,LOCAL_STRING,ERR,ERROR,*999) @@ -590,7 +590,7 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) ENDDO !component_idx !Collect the values across the ranks CALL MPI_ALLREDUCE(MPI_IN_PLACE,INTEGRAL_ERRORS,6*FIELD_VARIABLE%NUMBER_OF_COMPONENTS,MPI_DOUBLE_PRECISION, & - & MPI_SUM,computationalEnvironment%mpiCommunicator,MPI_IERROR) + & MPI_SUM,computationEnvironment%mpiCommunicator,MPI_IERROR) CALL WRITE_STRING(OUTPUT_ID,"Global Integral errors:",ERR,ERROR,*999) LOCAL_STRING="Component# Numerical Analytic % error Absolute err Relative err" CALL WRITE_STRING(OUTPUT_ID,LOCAL_STRING,ERR,ERROR,*999) @@ -1709,7 +1709,7 @@ SUBROUTINE AnalyticAnalysis_RMSErrorGetNode(FIELD,VARIABLE_TYPE,COMPONENT_NUMBER ENDDO !deriv_idx ENDDO !node_idx - IF(computationalEnvironment%numberOfComputationalNodes>1) THEN + IF(computationEnvironment%numberOfComputationNodes>1) THEN IF(ANY(NUMBER>0)) THEN DO deriv_idx=1,8 IF(NUMBER(deriv_idx)>0) THEN @@ -1724,9 +1724,9 @@ SUBROUTINE AnalyticAnalysis_RMSErrorGetNode(FIELD,VARIABLE_TYPE,COMPONENT_NUMBER ENDDO !deriv_idx !Global RMS values !Collect the values across the ranks - CALL MPI_ALLREDUCE(MPI_IN_PLACE,NUMBER,8,MPI_INTEGER,MPI_SUM,computationalEnvironment%mpiCommunicator,MPI_IERROR) + CALL MPI_ALLREDUCE(MPI_IN_PLACE,NUMBER,8,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) - CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR,8,MPI_DOUBLE_PRECISION,MPI_SUM,computationalEnvironment%mpiCommunicator, & + CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR,8,MPI_DOUBLE_PRECISION,MPI_SUM,computationEnvironment%mpiCommunicator, & & MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) DO deriv_idx=1,8 @@ -1838,7 +1838,7 @@ SUBROUTINE AnalyticAnalysis_RMSErrorGetElement(FIELD,VARIABLE_TYPE,COMPONENT_NUM GHOST_RMS_ERROR=GHOST_RMS_ERROR+ERROR_VALUE*ERROR_VALUE ENDDO !element_idx IF(NUMBER>0) THEN - IF(computationalEnvironment%numberOfComputationalNodes>1) THEN + IF(computationEnvironment%numberOfComputationNodes>1) THEN !Local elements only LOCAL_RMS=SQRT(RMS_ERROR/NUMBER) !Local and ghost elements @@ -1846,10 +1846,10 @@ SUBROUTINE AnalyticAnalysis_RMSErrorGetElement(FIELD,VARIABLE_TYPE,COMPONENT_NUM !Global RMS values !Collect the values across the ranks CALL MPI_ALLREDUCE(MPI_IN_PLACE,NUMBER,1,MPI_INTEGER,MPI_SUM, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR,1,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) GLOBAL_RMS=SQRT(RMS_ERROR/NUMBER) ENDIF diff --git a/src/base_routines.f90 b/src/base_routines.f90 index e6d26ade..1613c481 100755 --- a/src/base_routines.f90 +++ b/src/base_routines.f90 @@ -146,8 +146,8 @@ MODULE BaseRoutines !Module variables - INTEGER(INTG), SAVE :: myComputationalNodeNumber !Set the computational node numbers. Note: this is done as a subroutine as ComputationalEnvironment depends on BaseRoutines. - SUBROUTINE ComputationalNodeNumbersSet(myNodeNumber,numberOfNodes,err,error,*) + !>Set the computation node numbers. Note: this is done as a subroutine as ComputationEnvironment depends on BaseRoutines. + SUBROUTINE ComputationNodeNumbersSet(myNodeNumber,numberOfNodes,err,error,*) !Argument variables INTEGER(INTG), INTENT(IN) :: myNodeNumber !0) THEN IF(myNodeNumber>=0.AND.myNodeNumber<=numberOfNodes-1) THEN - myComputationalNodeNumber=myNodeNumber - numberOfComputationalNodes=numberOfNodes + myComputationNodeNumber=myNodeNumber + numberOfComputationNodes=numberOfNodes ELSE CALL FlagError("Invalid node number.",err,error,*999) ENDIF @@ -562,12 +562,12 @@ SUBROUTINE ComputationalNodeNumbersSet(myNodeNumber,numberOfNodes,err,error,*) CALL FlagError("Invalid number of nodes.",err,error,*999) ENDIF - EXITS("ComputationalNodeNumbersSet") + EXITS("ComputationNodeNumbersSet") RETURN -999 ERRORSEXITS("ComputationalNodeNumbersSet",err,error) +999 ERRORSEXITS("ComputationNodeNumbersSet",err,error) RETURN 1 - END SUBROUTINE ComputationalNodeNumbersSet + END SUBROUTINE ComputationNodeNumbersSet ! !================================================================================================================================ @@ -708,8 +708,8 @@ SUBROUTINE FlagWarningC(string,err,error,*) TYPE(VARYING_STRING), INTENT(OUT) :: error !1) THEN - WRITE(outputString,'(">>WARNING (",I0,"): ",A)') myComputationalNodeNumber,string + IF(numberOfComputationNodes>1) THEN + WRITE(outputString,'(">>WARNING (",I0,"): ",A)') myComputationNodeNumber,string ELSE WRITE(outputString,'(">>WARNING: ",A)') string ENDIF @@ -734,8 +734,8 @@ SUBROUTINE FlagWarningVS(string,err,error,*) TYPE(VARYING_STRING), INTENT(OUT) :: error !1) THEN - WRITE(outputString,'(">>WARNING (",I0,"): ",A)') myComputationalNodeNumber,CHAR(string) + IF(numberOfComputationNodes>1) THEN + WRITE(outputString,'(">>WARNING (",I0,"): ",A)') myComputationNodeNumber,CHAR(string) ELSE WRITE(outputString,'(">>WARNING: ",A)') CHAR(string) ENDIF @@ -783,8 +783,8 @@ SUBROUTINE BaseRoutinesInitialise(err,error,*) err=0 error="" - myComputationalNodeNumber=0 - numberOfComputationalNodes=1 + myComputationNodeNumber=0 + numberOfComputationNodes=1 diagnostics=.FALSE. diagnostics1=.FALSE. diagnostics2=.FALSE. @@ -928,8 +928,8 @@ SUBROUTINE DiagnosticsSetOn(diagType,levelList,diagFilename,routineList,err,erro IF(LEN_TRIM(diagFilename)>=1) THEN IF(diagFileOpen) CLOSE(UNIT=DIAGNOSTICS_FILE_UNIT) - IF(numberOfComputationalNodes>1) THEN - WRITE(filename,'(A,".diag.",I0)') diagFilename(1:LEN_TRIM(diagFilename)),myComputationalNodeNumber + IF(numberOfComputationNodes>1) THEN + WRITE(filename,'(A,".diag.",I0)') diagFilename(1:LEN_TRIM(diagFilename)),myComputationNodeNumber ELSE filename=diagFilename(1:LEN_TRIM(diagFilename))//".diag" ENDIF @@ -1063,8 +1063,8 @@ SUBROUTINE OutputSetOn(echoFilename,err,error,*) IF(echoOutput) THEN CALL FlagError("Write output is already on.",err,error,*999) ELSE - IF(numberOfComputationalNodes>1) THEN - WRITE(filename,'(A,".out.",I0)') echoFilename(1:LEN_TRIM(echoFilename)),myComputationalNodeNumber + IF(numberOfComputationNodes>1) THEN + WRITE(filename,'(A,".out.",I0)') echoFilename(1:LEN_TRIM(echoFilename)),myComputationNodeNumber ELSE filename=echoFilename(1:LEN_TRIM(echoFilename))//".out" ENDIF @@ -1233,8 +1233,8 @@ SUBROUTINE TimingSetOn(timingType,timingSummaryFlag,timingFilename,routineList,e NULLIFY(routine) IF(LEN_TRIM(timingFilename)>=1) THEN IF(timingFileOpen) CLOSE(UNIT=TIMING_FILE_UNIT) - IF(numberOfComputationalNodes>1) THEN - WRITE(filename,'(A,".timing.",I0)') timingFilename(1:LEN_TRIM(timingFilename)),myComputationalNodeNumber + IF(numberOfComputationNodes>1) THEN + WRITE(filename,'(A,".timing.",I0)') timingFilename(1:LEN_TRIM(timingFilename)),myComputationNodeNumber ELSE filename=timingFilename(1:LEN_TRIM(timingFilename))//".timing" ENDIF @@ -1389,8 +1389,8 @@ SUBROUTINE WriteError(err,error,*) TYPE(VARYING_STRING) :: localError,localError2 indent=2 - IF(numberOfComputationalNodes>1) THEN - WRITE(startString,'(A,A,I0,A,X,I0,A)') indentString(1:indent),"ERROR (",myComputationalNodeNumber,"):", & + IF(numberOfComputationNodes>1) THEN + WRITE(startString,'(A,A,I0,A,X,I0,A)') indentString(1:indent),"ERROR (",myComputationNodeNumber,"):", & & ERR,":" startStringLength=LEN_TRIM(startString) ELSE diff --git a/src/boundary_condition_routines.f90 b/src/boundary_condition_routines.f90 index a606886c..51c5f06e 100755 --- a/src/boundary_condition_routines.f90 +++ b/src/boundary_condition_routines.f90 @@ -47,7 +47,7 @@ MODULE BOUNDARY_CONDITIONS_ROUTINES USE BaseRoutines USE BASIS_ROUTINES USE CmissMPI - USE ComputationEnvironment + USE ComputationRoutines USE CONSTANTS USE COORDINATE_ROUTINES USE DISTRIBUTED_MATRIX_VECTOR @@ -222,8 +222,8 @@ SUBROUTINE BOUNDARY_CONDITIONS_CREATE_FINISH(BOUNDARY_CONDITIONS,ERR,ERROR,*) CALL FlagError("Boundary conditions have already been finished.",ERR,ERROR,*999) ELSE IF(ALLOCATED(BOUNDARY_CONDITIONS%BOUNDARY_CONDITIONS_VARIABLES)) THEN - IF(computationalEnvironment%numberOfComputationalNodes>0) THEN - !Transfer all the boundary conditions to all the computational nodes. + IF(computationEnvironment%numberOfComputationNodes>0) THEN + !Transfer all the boundary conditions to all the computation nodes. !\todo Look at this. DO variable_idx=1,BOUNDARY_CONDITIONS%NUMBER_OF_BOUNDARY_CONDITIONS_VARIABLES BOUNDARY_CONDITION_VARIABLE=>BOUNDARY_CONDITIONS%BOUNDARY_CONDITIONS_VARIABLES(variable_idx)%PTR @@ -236,10 +236,10 @@ SUBROUTINE BOUNDARY_CONDITIONS_CREATE_FINISH(BOUNDARY_CONDITIONS,ERR,ERROR,*) !\todo This operation is a little expensive as we are doing an unnecessary sum across all the ranks in order to combin !\todo the data from each rank into all ranks. We will see how this goes for now. CALL MPI_ALLREDUCE(MPI_IN_PLACE,BOUNDARY_CONDITION_VARIABLE%DOF_TYPES, & - & SEND_COUNT,MPI_INTEGER,MPI_SUM,computationalEnvironment%mpiCommunicator,MPI_IERROR) + & SEND_COUNT,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,BOUNDARY_CONDITION_VARIABLE%CONDITION_TYPES, & - & SEND_COUNT,MPI_INTEGER,MPI_SUM,computationalEnvironment%mpiCommunicator,MPI_IERROR) + & SEND_COUNT,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) ELSE LOCAL_ERROR="Field variable domain mapping is not associated for variable type "// & @@ -249,18 +249,18 @@ SUBROUTINE BOUNDARY_CONDITIONS_CREATE_FINISH(BOUNDARY_CONDITIONS,ERR,ERROR,*) ! Update the total number of boundary condition types by summing across all nodes CALL MPI_ALLREDUCE(MPI_IN_PLACE,BOUNDARY_CONDITION_VARIABLE%DOF_COUNTS, & - & MAX_BOUNDARY_CONDITION_NUMBER,MPI_INTEGER,MPI_SUM,computationalEnvironment%mpiCommunicator,MPI_IERROR) + & MAX_BOUNDARY_CONDITION_NUMBER,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,BOUNDARY_CONDITION_VARIABLE%NUMBER_OF_DIRICHLET_CONDITIONS, & - & 1,MPI_INTEGER,MPI_SUM,computationalEnvironment%mpiCommunicator,MPI_IERROR) + & 1,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) ! Check that the boundary conditions set are appropriate for equations sets CALL BoundaryConditions_CheckEquations(BOUNDARY_CONDITION_VARIABLE,ERR,ERROR,*999) - !Make sure the required parameter sets are created on all computational nodes and begin updating them + !Make sure the required parameter sets are created on all computation nodes and begin updating them CALL MPI_ALLREDUCE(MPI_IN_PLACE,BOUNDARY_CONDITION_VARIABLE%parameterSetRequired, & - & FIELD_NUMBER_OF_SET_TYPES,MPI_LOGICAL,MPI_LOR,computationalEnvironment%mpiCommunicator,MPI_IERROR) + & FIELD_NUMBER_OF_SET_TYPES,MPI_LOGICAL,MPI_LOR,computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) DO parameterSetIdx=1,FIELD_NUMBER_OF_SET_TYPES IF(BOUNDARY_CONDITION_VARIABLE%parameterSetRequired(parameterSetIdx)) THEN @@ -2125,7 +2125,7 @@ SUBROUTINE BoundaryConditions_NeumannMatricesInitialise(boundaryConditionsVariab TYPE(DOMAIN_LINE_TYPE), POINTER :: line TYPE(DOMAIN_FACE_TYPE), POINTER :: face TYPE(LIST_TYPE), POINTER :: columnIndicesList, rowColumnIndicesList - INTEGER(INTG) :: myComputationalNodeNumber + INTEGER(INTG) :: myComputationNodeNumber INTEGER(INTG) :: numberOfPointDofs, numberNonZeros, numberRowEntries, neumannConditionNumber, localNeumannConditionIdx INTEGER(INTG) :: neumannIdx, globalDof, localDof, localDofNyy, domainIdx, numberOfDomains, domainNumber, componentNumber INTEGER(INTG) :: nodeIdx, derivIdx, nodeNumber, versionNumber, derivativeNumber, columnNodeNumber, lineIdx, faceIdx, columnDof @@ -2420,11 +2420,11 @@ SUBROUTINE BoundaryConditions_NeumannMatricesInitialise(boundaryConditionsVariab !Set up vector of Neumann point values CALL DISTRIBUTED_VECTOR_CREATE_START(pointDofMapping,boundaryConditionsNeumann%pointValues,err,error,*999) CALL DISTRIBUTED_VECTOR_CREATE_FINISH(boundaryConditionsNeumann%pointValues,err,error,*999) - myComputationalNodeNumber=ComputationalEnvironment_NodeNumberGet(err,error) + myComputationNodeNumber=ComputationEnvironment_NodeNumberGet(err,error) !Set point values vector from boundary conditions field parameter set DO neumannIdx=1,numberOfPointDofs globalDof=boundaryConditionsNeumann%setDofs(neumannIdx) - IF(rhsVariable%DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(globalDof)%DOMAIN_NUMBER(1)==myComputationalNodeNumber) THEN + IF(rhsVariable%DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(globalDof)%DOMAIN_NUMBER(1)==myComputationNodeNumber) THEN localDof=rhsVariable%DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(globalDof)%LOCAL_NUMBER(1) ! Set point DOF vector value localNeumannConditionIdx=boundaryConditionsNeumann%pointDofMapping%GLOBAL_TO_LOCAL_MAP(neumannIdx)%LOCAL_NUMBER(1) @@ -2546,7 +2546,7 @@ SUBROUTINE BoundaryConditions_NeumannIntegrate(rhsBoundaryConditions,err,error,* TYPE(VARYING_STRING), INTENT(OUT) :: error ! Auckland, the University of Oxford and King's College, London. !> All Rights Reserved. !> -!> Contributor(s): +!> Contributor(s): Chris Bradley !> !> Alternatively, the contents of this file may be used under the terms of !> either the GNU General Public License Version 2 or later (the "GPL"), or @@ -54,7 +54,7 @@ MODULE Cmiss USE BaseRoutines USE BASIS_ROUTINES - USE ComputationEnvironment + USE ComputationRoutines USE Constants USE COORDINATE_ROUTINES USE GENERATED_MESH_ROUTINES @@ -217,8 +217,8 @@ SUBROUTINE cmfe_Finalise_(err,error,*) CALL BASES_FINALISE(err,error,*999) !Reset the signal handler CALL cmfe_ResetFatalHandler() - !Finalise computational enviroment - CALL ComputationalEnvironment_Finalise(err,error,*999) + !Finalise computation enviroment + CALL Computation_EnvironmentFinalise(err,error,*999) !Finalise the base routines CALL BaseRoutinesFinalise(err,error,*999) @@ -233,7 +233,7 @@ END SUBROUTINE cmfe_Finalise_ !!TODO Underscore to avoid name clash. Can be removed upon prefix rename. - !>Initialises CMISS. \see OPENOpenCMISS::Iron::CMISSInitialise + !>Initialises CMISS. \see OpenCMISS::Iron::cmfe_Initialise SUBROUTINE cmfe_Initialise_(worldRegion,err,error,*) !Argument variables @@ -247,8 +247,8 @@ SUBROUTINE cmfe_Initialise_(worldRegion,err,error,*) cmfe_ErrorHandlingMode = CMFE_OUTPUT_ERROR !Default for now, maybe make CMFE_RETURN_ERROR_CODE the default !Initialise the base routines CALL BaseRoutinesInitialise(err,error,*999) - !Intialise the computational environment - CALL ComputationalEnvironment_Initialise(err,error,*999) + !Intialise the computation environment + CALL Computation_EnvironmentInitialise(err,error,*999) !Setup signal handling CALL cmfe_InitFatalHandler() CALL cmfe_SetFatalHandler() @@ -265,7 +265,7 @@ SUBROUTINE cmfe_Initialise_(worldRegion,err,error,*) CALL PROBLEMS_INITIALISE(err,error,*999) !Write out the CMISS version - IF(computationalEnvironment%myComputationalNodeNumber==0) THEN + IF(computationEnvironment%myComputationNodeNumber==0) THEN versionString="OpenCMISS(Iron) version "//TRIM(NumberToVString(CMFE_MAJOR_VERSION,"*",err,error)) versionString=versionString//"." versionString=versionString//TRIM(NumberToVString(CMFE_MINOR_VERSION,"*",err,error)) diff --git a/src/computation_routines.f90 b/src/computation_routines.f90 new file mode 100755 index 00000000..9ccfa987 --- /dev/null +++ b/src/computation_routines.f90 @@ -0,0 +1,818 @@ +!> \file +!> \author Chris Bradley +!> \brief This module contains all computation routines. +!> +!> \section LICENSE +!> +!> Version: MPL 1.1/GPL 2.0/LGPL 2.1 +!> +!> The contents of this file are subject to the Mozilla Public License +!> Version 1.1 (the "License"); you may not use this file except in +!> compliance with the License. You may obtain a copy of the License at +!> http://www.mozilla.org/MPL/ +!> +!> Software distributed under the License is distributed on an "AS IS" +!> basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the +!> License for the specific language governing rights and limitations +!> under the License. +!> +!> The Original Code is OpenCMISS +!> +!> The Initial Developer of the Original Code is University of Auckland, +!> Auckland, New Zealand, the University of Oxford, Oxford, United +!> Kingdom and King's College, London, United Kingdom. Portions created +!> by the University of Auckland, the University of Oxford and King's +!> College, London are Copyright (C) 2007-2010 by the University of +!> Auckland, the University of Oxford and King's College, London. +!> All Rights Reserved. +!> +!> Contributor(s): +!> +!> Alternatively, the contents of this file may be used under the terms of +!> either the GNU General Public License Version 2 or later (the "GPL"), or +!> the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), +!> in which case the provisions of the GPL or the LGPL are applicable instead +!> of those above. If you wish to allow use of your version of this file only +!> under the terms of either the GPL or the LGPL, and not to allow others to +!> use your version of this file under the terms of the MPL, indicate your +!> decision by deleting the provisions above and replace them with the notice +!> and other provisions required by the GPL or the LGPL. If you do not delete +!> the provisions above, a recipient may use your version of this file under +!> the terms of any one of the MPL, the GPL or the LGPL. +!> + +!> This module contains all computation routines. + +MODULE ComputationRoutines + + USE BaseRoutines + USE CmissMPI + USE CmissPetsc + USE Constants + USE Kinds +#ifndef NOMPIMOD + USE MPI +#endif + USE INPUT_OUTPUT + USE ISO_VARYING_STRING + USE Strings + +#include "macros.h" + + IMPLICIT NONE + +#ifdef NOMPIMOD +#include "mpif.h" +#endif + + PRIVATE + + !Module parameters + + !Module types + + !>pointer type to ComputationWorkGroupType + TYPE :: ComputationWorkGroupPtrType + TYPE(ComputationWorkGroupType), POINTER :: ptr + END TYPE ComputationWorkGroupPtrType + + !>Contains information on logical working groups + TYPE :: ComputationWorkGroupType + INTEGER(INTG) :: numberOfComputationNodes !Contains information on a cache heirarchy + TYPE ComputationCacheType + INTEGER(INTG) :: numberOfLevels !Contains information on a computation node containing a number of processors + TYPE ComputationNodeType + INTEGER(INTG) :: numberOfProcessors !Contains information on the MPI type to transfer information about a computation node + TYPE MPIComputationNodeType + INTEGER(INTG) :: mpiType !Contains information on the computation environment the program is running in. + TYPE ComputationEnvironmentType + LOGICAL :: cmissMPIInitialised !Add the work sub-group to the parent group based on the computation requirements (called by user) + SUBROUTINE Computation_WorkGroupSubGroupAdd(parentWorkGroup,numberOfComputationNodes,subWorkGroup,err,error,*) + + !Argument Variables + TYPE(ComputationWorkGroupType),POINTER, INTENT(INOUT) :: parentWorkGroup + TYPE(ComputationWorkGroupType),POINTER, INTENT(INOUT) :: subWorkGroup + INTEGER(INTG),INTENT(IN) :: numberOfComputationNodes + INTEGER(INTG), INTENT(OUT) :: err !parentWorkGroup%subWorkGroups(I)%ptr + ENDDO + !subWorkGroups(1:parentWorkGroup%numberOfSubWorkGroups)=>parentWorkGroup%subWorkGroups(:) + + IF(ALLOCATED(parentWorkGroup%subWorkGroups)) THEN + DEALLOCATE(parentWorkGroup%subWorkGroups) + ENDIF + subWorkGroups(1+parentWorkGroup%numberOfSubWorkGroups)%ptr=>newWorkGroup%ptr + ALLOCATE(parentWorkGroup%subWorkGroups(SIZE(subWorkGroups,1))) + DO I=1,SIZE(subWorkGroups,1) + parentWorkGroup%subWorkGroups(I)%ptr => subWorkGroups(I)%ptr + ENDDO + !parentWorkGroup%subWorkGroups(:) => subWorkGroups(:) + + DEALLOCATE(subWorkGroups) + parentWorkGroup%numberOfSubWorkGroups = 1+parentWorkGroup%numberOfSubWorkGroups + newWorkGroup%ptr%PARENT => parentWorkGroup + tmpParentWorkGroup => parentWorkGroup + DO WHILE(ASSOCIATED(tmpParentWorkGroup)) !Update the computation number of its ancestors + tmpParentWorkGroup%numberOfComputationNodes = tmpParentWorkGroup%numberOfComputationNodes & + & + newWorkGroup%ptr%numberOfComputationNodes + tmpParentWorkGroup => tmpParentWorkGroup%PARENT + ENDDO + ELSE !Top level group + CALL FlagError('parentWorkGroup is not associated, call COMPUTATION_WORK_GROUP_CREATE_START first',& + & err,error,*999) + ENDIF + subWorkGroup => newWorkGroup%ptr + + EXITS("Computation_WorkGroupSubGroupAdd") + RETURN +999 ERRORSEXITS("Computation_WorkGroupSubGroupAdd",err,error) + RETURN 1 + + END SUBROUTINE Computation_WorkGroupSubGroupAdd + + ! + !================================================================================================================================ + ! + + !>Create the highest level work group (Default: GROUP_WORLD) + SUBROUTINE Computation_WorkGroupCreateStart(worldWorkGroup,numberOfComputationNodes,err,error,*) + + !Argument Variables + TYPE(ComputationWorkGroupType),POINTER, INTENT(INOUT) :: worldWorkGroup + INTEGER(INTG),INTENT(IN) :: numberOfComputationNodes + INTEGER(INTG), INTENT(OUT) :: err !newWorkGroup%ptr + ENDIF + + EXITS("Computation_WorkGroupCreateStart") + RETURN +999 ERRORSEXITS("Computation_WorkGroupCreateStart",err,error) + RETURN 1 + + END SUBROUTINE Computation_WorkGroupCreateStart + + ! + !================================================================================================================================ + ! + + !>Generate computation environment for current level work group tree and all it's subgroups recursively + RECURSIVE SUBROUTINE Computation_WorkGroupGenerateCompEnviron(workGroup,availableRankList,err,error,*) + + !Argument Variables + TYPE(ComputationWorkGroupType),POINTER, INTENT(INOUT) :: workGroup + INTEGER(INTG), ALLOCATABLE, INTENT(INOUT) :: availableRankList(:) + INTEGER(INTG), INTENT(OUT) :: err !Generate the hierarchy computation environment based on work group tree + SUBROUTINE Computation_WorkGroupCreateFinish(worldWorkGroup,err,error,*) + + !Argument Variables + TYPE(ComputationWorkGroupType),POINTER,INTENT(INOUT) :: worldWorkGroup + INTEGER(INTG),INTENT(OUT) :: err ! computationEnvironment + worldWorkGroup%computationEnvironmentFinished = .TRUE. + + !generate the communicators for subgroups if any + ALLOCATE(availableRankList(worldWorkGroup%computationEnvironment%numberOfComputationNodes)) + DO rankIdx=0,SIZE(availableRankList,1)-1 + availableRankList(rankIdx+1) = rankIdx + ENDDO !rankIdx + DO subGroupIdx=1,worldWorkGroup%numberOfSubWorkGroups,1 + CALL Computation_WorkGroupGenerateCompEnviron(worldWorkGroup%subWorkGroups(subGroupIdx)%ptr,availableRankList, & + & err,error,*999) + ENDDO !subGroupIdx + + EXITS("Computation_WorkGroupCreateFinish") + RETURN +999 ERRORSEXITS("Computation_WorkGroupCreateFinish",err,error) + RETURN 1 + + END SUBROUTINE Computation_WorkGroupCreateFinish + + ! + !================================================================================================================================ + ! + + !>Finalises the computation node data structures and deallocates all memory. + SUBROUTINE ComputationEnvironment_ComputationNodeFinalise(computationNode,err,error,*) + + !Argument Variables + TYPE(ComputationNodeType),INTENT(INOUT) :: computationNode !Initialises the computation node data structures. + SUBROUTINE ComputationEnvironment_ComputationNodeInitialise(computationNode,rank,err,error,*) + + !Argument Variables + TYPE(ComputationNodeType), INTENT(OUT) :: computationNode !Finalises the data structure containing the MPI type information for the ComputationNodeType. + SUBROUTINE ComputationEnvironment_ComputationNodeTypeFinalise(err,error,*) + + !Argument Variables + INTEGER(INTG), INTENT(OUT) :: err !Initialises the data structure containing the MPI type information for the ComputationNodeType. + SUBROUTINE ComputationEnvironment_ComputationNodeTypeInitialise(computationNode,err,error,*) + + !Argument Variables + TYPE(ComputationNodeType), INTENT(IN) :: computationNode !Finalises the computation environment data structures and deallocates all memory. + SUBROUTINE Computation_EnvironmentFinalise(err,error,*) + + !Argument Variables + INTEGER(INTG), INTENT(OUT) :: err !Initialises the computation environment data structures. + SUBROUTINE Computation_EnvironmentInitialise(err,error,*) + + !Argument Variables + INTEGER(INTG), INTENT(OUT) :: err !Sets the world communicator to the given on. Note: This routine should be called straight after the main OpenCMISS initialise + !>routine. If it is called after objects have started to be setup then good luck! + SUBROUTINE ComputationEnvironment_WorldCommunicatorSet(worldCommunicator,err,error,*) + + !Argument Variables + INTEGER(INTG), INTENT(IN) :: worldCommunicator !Gets the current world communicator. + SUBROUTINE ComputationEnvironment_WorldCommunicatorGet(worldCommunicator,err,error,*) + + !Argument Variables + INTEGER(INTG), INTENT(OUT) :: worldCommunicator !Returns the number/rank of the computation nodes. + FUNCTION ComputationEnvironment_NodeNumberGet(err,error) + + !Argument Variables + INTEGER(INTG), INTENT(OUT) :: err !Returns the number of computation nodes. + FUNCTION ComputationEnvironment_NumberOfNodesGet(err,error) + + !Argument Variables + INTEGER(INTG), INTENT(OUT) :: err ! \file -!> \author Chris Bradley -!> \brief This module contains all computational environment variables. -!> -!> \section LICENSE -!> -!> Version: MPL 1.1/GPL 2.0/LGPL 2.1 -!> -!> The contents of this file are subject to the Mozilla Public License -!> Version 1.1 (the "License"); you may not use this file except in -!> compliance with the License. You may obtain a copy of the License at -!> http://www.mozilla.org/MPL/ -!> -!> Software distributed under the License is distributed on an "AS IS" -!> basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the -!> License for the specific language governing rights and limitations -!> under the License. -!> -!> The Original Code is OpenCMISS -!> -!> The Initial Developer of the Original Code is University of Auckland, -!> Auckland, New Zealand, the University of Oxford, Oxford, United -!> Kingdom and King's College, London, United Kingdom. Portions created -!> by the University of Auckland, the University of Oxford and King's -!> College, London are Copyright (C) 2007-2010 by the University of -!> Auckland, the University of Oxford and King's College, London. -!> All Rights Reserved. -!> -!> Contributor(s): -!> -!> Alternatively, the contents of this file may be used under the terms of -!> either the GNU General Public License Version 2 or later (the "GPL"), or -!> the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), -!> in which case the provisions of the GPL or the LGPL are applicable instead -!> of those above. If you wish to allow use of your version of this file only -!> under the terms of either the GPL or the LGPL, and not to allow others to -!> use your version of this file under the terms of the MPL, indicate your -!> decision by deleting the provisions above and replace them with the notice -!> and other provisions required by the GPL or the LGPL. If you do not delete -!> the provisions above, a recipient may use your version of this file under -!> the terms of any one of the MPL, the GPL or the LGPL. -!> - -!> This module contains all computational environment variables. - -MODULE ComputationEnvironment - - USE BaseRoutines - USE CmissMPI - USE CmissPetsc - USE Constants - USE Kinds -#ifndef NOMPIMOD - USE MPI -#endif - USE INPUT_OUTPUT - USE ISO_VARYING_STRING - USE Strings - -#include "macros.h" - - IMPLICIT NONE - -#ifdef NOMPIMOD -#include "mpif.h" -#endif - - PRIVATE - - !Module parameters - - !Module types - - !>pointer type to ComputationalWorkGroupType - TYPE :: ComputationalWorkGroupPtrType - TYPE(ComputationalWorkGroupType), POINTER :: ptr - END TYPE ComputationalWorkGroupPtrType - - !>Contains information on logical working groups (added by Robert on 01/04/2010) - TYPE :: ComputationalWorkGroupType - INTEGER(INTG) :: numberOfComputationalNodes !Contains information on a cache heirarchy - TYPE ComputationalCacheType - INTEGER(INTG) :: NUMBER_LEVELS !Contains information on a computational node containing a number of processors - TYPE ComputationalNodeType - INTEGER(INTG) :: NUMBER_PROCESSORS !Contains information on the MPI type to transfer information about a computational node - TYPE MPIComputationalNodeType - INTEGER(INTG) :: MPI_TYPE !Contains information on the computational environment the program is running in. - TYPE ComputationalEnvironmentType - LOGICAL :: cmissMPIInitialised !Add the work sub-group to the parent group based on the computational requirements (called by user) - SUBROUTINE COMPUTATIONAL_WORK_GROUP_SUBGROUP_ADD(PARENT_WORK_GROUP, numberOfComputationalNodes, & - & ADDED_WORK_GROUP,err,error,*) - - !Argument Variables - TYPE(ComputationalWorkGroupType),POINTER, INTENT(INOUT) :: PARENT_WORK_GROUP - TYPE(ComputationalWorkGroupType),POINTER, INTENT(INOUT) :: ADDED_WORK_GROUP - INTEGER(INTG),INTENT(IN) :: numberOfComputationalNodes - INTEGER(INTG), INTENT(OUT) :: err !PARENT_WORK_GROUP%SUB_WORK_GROUPS(I)%ptr - ENDDO - !SUB_WORK_GROUPS(1:PARENT_WORK_GROUP%numberOfSubWorkGroups)=>PARENT_WORK_GROUP%SUB_WORK_GROUPS(:) - - IF(ALLOCATED(PARENT_WORK_GROUP%SUB_WORK_GROUPS)) THEN - DEALLOCATE(PARENT_WORK_GROUP%SUB_WORK_GROUPS) - ENDIF - SUB_WORK_GROUPS(1+PARENT_WORK_GROUP%numberOfSubWorkGroups)%ptr=>NEW_WORK_GROUP%ptr - ALLOCATE(PARENT_WORK_GROUP%SUB_WORK_GROUPS(SIZE(SUB_WORK_GROUPS,1))) - DO I=1,SIZE(SUB_WORK_GROUPS,1) - PARENT_WORK_GROUP%SUB_WORK_GROUPS(I)%ptr => SUB_WORK_GROUPS(I)%ptr - ENDDO - !PARENT_WORK_GROUP%SUB_WORK_GROUPS(:) => SUB_WORK_GROUPS(:) - - DEALLOCATE(SUB_WORK_GROUPS) - PARENT_WORK_GROUP%numberOfSubWorkGroups = 1+PARENT_WORK_GROUP%numberOfSubWorkGroups - NEW_WORK_GROUP%ptr%PARENT => PARENT_WORK_GROUP - TMP_PARENT_WORK_GROUP => PARENT_WORK_GROUP - DO WHILE(ASSOCIATED(TMP_PARENT_WORK_GROUP)) !Update the computational number of its ancestors - TMP_PARENT_WORK_GROUP%numberOfComputationalNodes = TMP_PARENT_WORK_GROUP%numberOfComputationalNodes & - & + NEW_WORK_GROUP%ptr%numberOfComputationalNodes - TMP_PARENT_WORK_GROUP => TMP_PARENT_WORK_GROUP%PARENT - ENDDO - ELSE !Top level group - CALL FlagError('PARENT_WORK_GROUP is not associated, call COMPUTATIONAL_WORK_GROUP_CREATE_START first',& - & err,error,*999) - ENDIF - ADDED_WORK_GROUP => NEW_WORK_GROUP%ptr - - EXITS("COMPUTATIONAL_WORK_GROUP_SUBGROUP_ADD") - RETURN -999 ERRORSEXITS("COMPUTATIONAL_WORK_GROUP_SUBGROUP_ADD",err,error) - RETURN 1 - END SUBROUTINE COMPUTATIONAL_WORK_GROUP_SUBGROUP_ADD - - ! - !================================================================================================================================ - ! - - !>Create the highest level work group (Default: GROUP_WORLD) - SUBROUTINE COMPUTATIONAL_WORK_GROUP_CREATE_START(WORLD_WORK_GROUP,numberOfComputationalNodes,err,error,*) - - !Argument Variables - TYPE(ComputationalWorkGroupType),POINTER, INTENT(INOUT) :: WORLD_WORK_GROUP - INTEGER(INTG),INTENT(IN) :: numberOfComputationalNodes - INTEGER(INTG), INTENT(OUT) :: err !NEW_WORK_GROUP%ptr - ENDIF - - EXITS("COMPUTATIONAL_WORK_GROUP_CREATE_START") - RETURN -999 ERRORSEXITS("COMPUTATIONAL_WORK_GROUP_CREATE_START",err,error) - RETURN 1 - END SUBROUTINE COMPUTATIONAL_WORK_GROUP_CREATE_START - - ! - !================================================================================================================================ - ! - - !>Generate computational environment for current level work group tree and all it's subgroups recursively - RECURSIVE SUBROUTINE Computational_WorkGroupGenerateCompEnviron(WORK_GROUP,AVAILABLE_RANK_LIST,err,error,*) - - !Argument Variables - TYPE(ComputationalWorkGroupType),POINTER, INTENT(INOUT) :: WORK_GROUP - INTEGER(INTG), ALLOCATABLE, INTENT(INOUT) :: AVAILABLE_RANK_LIST(:) - INTEGER(INTG), INTENT(OUT) :: err !Generate the hierarchy computational environment based on work group tree - SUBROUTINE COMPUTATIONAL_WORK_GROUP_CREATE_FINISH(WORLD_WORK_GROUP,err,error,*) - - !Argument Variables - TYPE(ComputationalWorkGroupType),POINTER,INTENT(INOUT) :: WORLD_WORK_GROUP - INTEGER(INTG),INTENT(OUT) :: err ! computationalEnvironment - WORLD_WORK_GROUP%computationalEnvironmentFinished = .TRUE. - - !generate the communicators for subgroups if any - ALLOCATE(AVAILABLE_RANK_LIST(WORLD_WORK_GROUP%computationalEnvironment%numberOfComputationalNodes)) - DO I=0,SIZE(AVAILABLE_RANK_LIST,1)-1 - AVAILABLE_RANK_LIST(I+1) = I - END DO - DO I=1,WORLD_WORK_GROUP%numberOfSubWorkGroups,1 - CALL Computational_WorkGroupGenerateCompEnviron(WORLD_WORK_GROUP%SUB_WORK_GROUPS(I)%ptr,AVAILABLE_RANK_LIST,err,error,*999) - END DO - - EXITS("COMPUTATIONAL_WORK_GROUP_CREATE_FINISH") - RETURN -999 ERRORSEXITS("COMPUTATIONAL_WORK_GROUP_CREATE_FINISH",err,error) - RETURN 1 - END SUBROUTINE COMPUTATIONAL_WORK_GROUP_CREATE_FINISH - - ! - !================================================================================================================================ - ! - - !>Finalises the computational node data structures and deallocates all memory. - SUBROUTINE COMPUTATIONAL_NODE_FINALISE(COMPUTATIONAL_NODE,err,error,*) - - !Argument Variables - TYPE(ComputationalNodeType),INTENT(INOUT) :: COMPUTATIONAL_NODE !Initialises the computational node data structures. - SUBROUTINE COMPUTATIONAL_NODE_INITIALISE(COMPUTATIONAL_NODE,RANK,err,error,*) - - !Argument Variables - TYPE(ComputationalNodeType), INTENT(OUT) :: COMPUTATIONAL_NODE !Finalises the data structure containing the MPI type information for the ComputationalNodeType. - SUBROUTINE COMPUTATIONAL_NODE_MPI_TYPE_FINALISE(err,error,*) - - !Argument Variables - INTEGER(INTG), INTENT(OUT) :: err !Initialises the data structure containing the MPI type information for the ComputationalNodeType. - SUBROUTINE COMPUTATIONAL_NODE_MPI_TYPE_INITIALISE(COMPUTATIONAL_NODE,err,error,*) - - !Argument Variables - TYPE(ComputationalNodeType), INTENT(IN) :: COMPUTATIONAL_NODE !Finalises the computational environment data structures and deallocates all memory. - SUBROUTINE COMPUTATIONAL_ENVIRONMENT_FINALISE(err,error,*) - - !Argument Variables - INTEGER(INTG), INTENT(OUT) :: err !Initialises the computational environment data structures. - SUBROUTINE COMPUTATIONAL_ENVIRONMENT_INITIALISE(err,error,*) - - !Argument Variables - INTEGER(INTG), INTENT(OUT) :: err !Sets the world communicator to the given on. Note: This routine should be called straight after the main OpenCMISS initialise - !>routine. If it is called after objects have started to be setup then good luck! - SUBROUTINE ComputationalEnvironment_WorldCommunicatorSet(worldCommunicator,err,error,*) - - !Argument Variables - INTEGER(INTG), INTENT(IN) :: worldCommunicator !Gets the current world communicator. - SUBROUTINE ComputationalEnvironment_WorldCommunicatorGet(worldCommunicator,err,error,*) - - !Argument Variables - INTEGER(INTG), INTENT(OUT) :: worldCommunicator !Returns the number/rank of the computational nodes. - FUNCTION COMPUTATIONAL_NODE_NUMBER_GET(err,error) - - !Argument Variables - INTEGER(INTG), INTENT(OUT) :: err !Returns the number of computational nodes. - FUNCTION COMPUTATIONAL_NODES_NUMBER_GET(err,error) - - !Argument Variables - INTEGER(INTG), INTENT(OUT) :: err ! Auckland, the University of Oxford and King's College, London. !> All Rights Reserved. !> -!> Contributor(s): Chris Bradley, Kumar Mithraratne, Xiani (Nancy) Yan, Prasad Babarenda Gamage +!> Contributor(s): Tim Wu, Chris Bradley, Kumar Mithraratne, Xiani (Nancy) Yan, Prasad Babarenda Gamage !> !> Alternatively, the contents of this file may be used under the terms of !> either the GNU General Public License Version 2 or later (the "GPL"), or @@ -48,7 +48,7 @@ MODULE DataProjectionRoutines USE BASIS_ROUTINES USE BasisAccessRoutines USE CmissMPI - USE ComputationEnvironment + USE ComputationRoutines USE Constants USE CoordinateSystemAccessRoutines USE DataPointAccessRoutines @@ -1354,7 +1354,7 @@ SUBROUTINE DataProjection_DataPointsProjectionEvaluate(dataProjection,projection TYPE(DOMAIN_MAPPING_TYPE), POINTER :: domainMappingElements TYPE(DOMAIN_MAPPINGS_TYPE), POINTER :: domainMappings TYPE(DOMAIN_TOPOLOGY_TYPE), POINTER :: domainTopology - INTEGER(INTG) :: myComputationalNode,numberOfComputationalNodes !1) THEN + !use MPI if number of computation nodes is greater than 1 + IF(numberOfComputationNodes>1) THEN !Use MPI !Allocate arrays for MPI communication ALLOCATE(globalToLocalNumberOfClosestCandidates(numberOfDataPoints),STAT=err) IF(err/=0) CALL FlagError("Could not allocate global to local number of closest elements.",err,error,*999) - ALLOCATE(globalNumberOfClosestCandidates(numberOfComputationalNodes),STAT=err) + ALLOCATE(globalNumberOfClosestCandidates(numberOfComputationNodes),STAT=err) IF(err/=0) CALL FlagError("Could not allocate global number of closest candidates.",err,error,*999) - ALLOCATE(globalMPIDisplacements(numberOfComputationalNodes),STAT=err) + ALLOCATE(globalMPIDisplacements(numberOfComputationNodes),STAT=err) IF(err/=0) CALL FlagError("Could not allocate global MPI displacements.",err,error,*999) - ALLOCATE(globalNumberOfProjectedPoints(numberOfComputationalNodes),STAT=err) + ALLOCATE(globalNumberOfProjectedPoints(numberOfComputationNodes),STAT=err) IF(err/=0) CALL FlagError("Could not allocate all number of projected points.",err,error,*999) ALLOCATE(projectionExitTag(numberOfDataPoints),STAT=err) IF(err/=0) CALL FlagError("Could not allocate projected.",err,error,*999) @@ -1684,13 +1684,13 @@ SUBROUTINE DataProjection_DataPointsProjectionEvaluate(dataProjection,projection IF(err/=0) CALL FlagError("Could not allocate projected vectors.",err,error,*999) ALLOCATE(sortingIndices2(numberOfDataPoints),STAT=err) IF(err/=0) CALL FlagError("Could not allocate sorting indices 2.",err,error,*999) - !gather and distribute the number of closest elements from all computational nodes + !gather and distribute the number of closest elements from all computation nodes CALL MPI_ALLGATHER(numberOfClosestCandidates,1,MPI_INTEGER,globalNumberOfClosestCandidates,1,MPI_INTEGER, & - & computationalEnvironment%mpiCommunicator,MPIIError) + & computationEnvironment%mpiCommunicator,MPIIError) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPIIError,err,error,*999) - !Sum all number of closest candidates from all computational nodes + !Sum all number of closest candidates from all computation nodes totalNumberOfClosestCandidates=SUM(globalNumberOfClosestCandidates,1) - !Allocate arrays to store information gathered from all computational node + !Allocate arrays to store information gathered from all computation node !The information for each data point is stored in the corresponding row so they are contiguous in memory for !easy MPI access ALLOCATE(globalClosestDistances(numberOfDataPoints,totalNumberOfClosestCandidates),STAT=err) @@ -1704,27 +1704,27 @@ SUBROUTINE DataProjection_DataPointsProjectionEvaluate(dataProjection,projection CALL MPI_ERROR_CHECK("MPI_TYPE_COMMIT",MPIIError,err,error,*999) !Create displacement vectors for MPI_ALLGATHERV globalMPIDisplacements(1)=0 - DO computationalNodeIdx=1,(numberOfComputationalNodes-1) - globalMPIDisplacements(computationalNodeIdx+1)=globalMPIDisplacements(computationalNodeIdx)+ & - & globalNumberOfClosestCandidates(computationalNodeIdx) - ENDDO !computationalNodeIdx + DO computationNodeIdx=1,(numberOfComputationNodes-1) + globalMPIDisplacements(computationNodeIdx+1)=globalMPIDisplacements(computationNodeIdx)+ & + & globalNumberOfClosestCandidates(computationNodeIdx) + ENDDO !computationNodeIdx !Share closest element distances between all domains CALL MPI_ALLGATHERV(closestDistances(1,1),numberOfClosestCandidates,MPIClosestDistances, & & globalClosestDistances,globalNumberOfClosestCandidates,globalMPIDisplacements, & - & MPIClosestDistances,computationalEnvironment%mpiCommunicator,MPIIError) + & MPIClosestDistances,computationEnvironment%mpiCommunicator,MPIIError) CALL MPI_ERROR_CHECK("MPI_ALLGATHERV",MPIIError,err,error,*999) reducedNumberOfCLosestCandidates=MIN(dataProjection%numberOfClosestElements,totalNumberOfClosestCandidates) - projectedDistance(2,:)=myComputationalNode + projectedDistance(2,:)=myComputationNode !Find the globally closest distance in the current domain DO dataPointIdx=1,numberOfDataPoints CALL Sorting_BubbleIndexSort(globalClosestDistances(dataPointIdx,:),sortingIndices1,err,error,*999) sortingIndices1(1:totalNumberOfClosestCandidates)=sortingIndices1(1:totalNumberOfClosestCandidates)- & - & globalMPIDisplacements(myComputationalNode+1) !shift the index to current computational node + & globalMPIDisplacements(myComputationNode+1) !shift the index to current computation node globalToLocalNumberOfClosestCandidates(dataPointIdx)=0 DO elementIdx=1,reducedNumberOfCLosestCandidates - !Sorted index indicates it is in the current computational domain + !Sorted index indicates it is in the current computation domain IF((sortingIndices1(elementIdx)>=1).AND. & - & (sortingIndices1(elementIdx)<=globalNumberOfClosestCandidates(myComputationalNode+1))) & + & (sortingIndices1(elementIdx)<=globalNumberOfClosestCandidates(myComputationNode+1))) & & globalToLocalNumberOfClosestCandidates(dataPointIdx)= & & globalToLocalNumberOfClosestCandidates(dataPointIdx)+1 ENDDO !elementIdx @@ -1818,46 +1818,46 @@ SUBROUTINE DataProjection_DataPointsProjectionEvaluate(dataProjection,projection END SELECT !Find the shortest projected distance in all domains CALL MPI_ALLREDUCE(MPI_IN_PLACE,projectedDistance,numberOfDataPoints,MPI_2DOUBLE_PRECISION,MPI_MINLOC, & - & computationalEnvironment%mpiCommunicator,MPIIError) + & computationEnvironment%mpiCommunicator,MPIIError) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPIIError,err,error,*999) - !Sort the computational node/rank from 0 to number of computational node + !Sort the computation node/rank from 0 to number of computation node CALL Sorting_BubbleIndexSort(projectedDistance(2,:),sortingIndices2,err,error,*999) - DO computationalNodeIdx=0,(numberOfComputationalNodes-1) - globalNumberOfProjectedPoints(computationalNodeIdx+1)=COUNT(ABS(projectedDistance(2,:)- & - & REAL(computationalNodeIdx))1 + ENDIF !numberOfComputationNodes>1 !Compute full elemental xi IF(dataProjection%numberOfXi==dataProjection%numberOfElementXi) THEN DO dataPointIdx=1,numberOfDataPoints @@ -2230,7 +2230,7 @@ SUBROUTINE DataProjection_NewtonElementsEvaluate_1(dataProjection,interpolatedPo TYPE(VARYING_STRING), INTENT(OUT) :: error !=1) THEN - IF(numberOfComputationalNodes>1) THEN - WRITE(analFilename,('(A,A,I0)')) filename(1:filenameLength),".opdataproj.",myComputationalNodeNumber + IF(numberOfComputationNodes>1) THEN + WRITE(analFilename,('(A,A,I0)')) filename(1:filenameLength),".opdataproj.",myComputationNodeNumber ELSE analFilename=filename(1:filenameLength)//".opdataproj" ENDIF diff --git a/src/distributed_matrix_vector.f90 b/src/distributed_matrix_vector.f90 index 6577b3f9..27f1c425 100755 --- a/src/distributed_matrix_vector.f90 +++ b/src/distributed_matrix_vector.f90 @@ -47,7 +47,7 @@ MODULE DISTRIBUTED_MATRIX_VECTOR USE BaseRoutines USE CmissMPI USE CmissPetsc - USE ComputationEnvironment + USE ComputationRoutines USE INPUT_OUTPUT USE ISO_VARYING_STRING USE ISO_C_BINDING @@ -1150,7 +1150,7 @@ SUBROUTINE DISTRIBUTED_MATRIX_DATA_GET_INTG(DISTRIBUTED_MATRIX,DATA,ERR,ERROR,*) !Argument variables TYPE(DISTRIBUTED_MATRIX_TYPE), POINTER :: DISTRIBUTED_MATRIX !Gets the dimensions of a matrix on this computational node. + !>Gets the dimensions of a matrix on this computation node. SUBROUTINE DistributedMatrix_DimensionsGet(distributedMatrix,m,n,err,error,*) !Argument variables @@ -2713,7 +2713,7 @@ SUBROUTINE DISTRIBUTED_MATRIX_PETSC_CREATE_FINISH(PETSC_MATRIX,ERR,ERROR,*) !Set up the matrix ALLOCATE(PETSC_MATRIX%DATA_DP(PETSC_MATRIX%DATA_SIZE),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate PETSc matrix data.",ERR,ERROR,*999) - CALL Petsc_MatCreateDense(computationalEnvironment%mpiCommunicator,PETSC_MATRIX%M,PETSC_MATRIX%N, & + CALL Petsc_MatCreateDense(computationEnvironment%mpiCommunicator,PETSC_MATRIX%M,PETSC_MATRIX%N, & & PETSC_MATRIX%GLOBAL_M,PETSC_MATRIX%GLOBAL_N,PETSC_MATRIX%DATA_DP,PETSC_MATRIX%MATRIX,ERR,ERROR,*999) CASE(DISTRIBUTED_MATRIX_DIAGONAL_STORAGE_TYPE) PETSC_MATRIX%NUMBER_NON_ZEROS=PETSC_MATRIX%M @@ -2733,7 +2733,7 @@ SUBROUTINE DISTRIBUTED_MATRIX_PETSC_CREATE_FINISH(PETSC_MATRIX,ERR,ERROR,*) PETSC_MATRIX%DIAGONAL_NUMBER_NON_ZEROS=1 PETSC_MATRIX%OFFDIAGONAL_NUMBER_NON_ZEROS=0 !Create the PETsc AIJ matrix - CALL Petsc_MatCreateAIJ(computationalEnvironment%mpiCommunicator,PETSC_MATRIX%M,PETSC_MATRIX%N, & + CALL Petsc_MatCreateAIJ(computationEnvironment%mpiCommunicator,PETSC_MATRIX%M,PETSC_MATRIX%N, & & PETSC_MATRIX%GLOBAL_M,PETSC_MATRIX%GLOBAL_N,PETSC_NULL_INTEGER,PETSC_MATRIX%DIAGONAL_NUMBER_NON_ZEROS, & & PETSC_NULL_INTEGER,PETSC_MATRIX%OFFDIAGONAL_NUMBER_NON_ZEROS,PETSC_MATRIX%MATRIX,ERR,ERROR,*999) CASE(DISTRIBUTED_MATRIX_COLUMN_MAJOR_STORAGE_TYPE) @@ -2744,7 +2744,7 @@ SUBROUTINE DISTRIBUTED_MATRIX_PETSC_CREATE_FINISH(PETSC_MATRIX,ERR,ERROR,*) IF(ALLOCATED(PETSC_MATRIX%DIAGONAL_NUMBER_NON_ZEROS)) THEN IF(ALLOCATED(PETSC_MATRIX%OFFDIAGONAL_NUMBER_NON_ZEROS)) THEN !Create the PETSc AIJ matrix - CALL Petsc_MatCreateAIJ(computationalEnvironment%mpiCommunicator,PETSC_MATRIX%M,PETSC_MATRIX%N, & + CALL Petsc_MatCreateAIJ(computationEnvironment%mpiCommunicator,PETSC_MATRIX%M,PETSC_MATRIX%N, & & PETSC_MATRIX%GLOBAL_M,PETSC_MATRIX%GLOBAL_N,PETSC_NULL_INTEGER,PETSC_MATRIX%DIAGONAL_NUMBER_NON_ZEROS, & & PETSC_NULL_INTEGER,PETSC_MATRIX%OFFDIAGONAL_NUMBER_NON_ZEROS,PETSC_MATRIX%MATRIX,ERR,ERROR,*999) !Set matrix options @@ -6439,7 +6439,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_CMISS_CREATE_FINISH(CMISS_VECTOR,ERR,ERROR,*) INTEGER(INTG), INTENT(OUT) :: ERR !0) THEN - my_computational_node_number=ComputationalEnvironment_NodeNumberGet(ERR,ERROR) + my_computation_node_number=ComputationEnvironment_NodeNumberGet(ERR,ERROR) IF(ERR/=0) GOTO 999 IF(DISTRIBUTED_VECTOR%GHOSTING_TYPE==DISTRIBUTED_MATRIX_VECTOR_INCLUDE_GHOSTS_TYPE) THEN ALLOCATE(CMISS_VECTOR%TRANSFERS(DOMAIN_MAPPING%NUMBER_OF_ADJACENT_DOMAINS),STAT=ERR) @@ -6496,11 +6496,11 @@ SUBROUTINE DISTRIBUTED_VECTOR_CMISS_CREATE_FINISH(CMISS_VECTOR,ERR,ERROR,*) & DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%NUMBER_OF_RECEIVE_GHOSTS CMISS_VECTOR%TRANSFERS(domain_idx)%DATA_TYPE=DISTRIBUTED_VECTOR%DATA_TYPE CMISS_VECTOR%TRANSFERS(domain_idx)%SEND_TAG_NUMBER=CMISS_VECTOR%BASE_TAG_NUMBER + & - & DOMAIN_MAPPING%ADJACENT_DOMAINS_PTR(my_computational_node_number)+domain_idx-1 + & DOMAIN_MAPPING%ADJACENT_DOMAINS_PTR(my_computation_node_number)+domain_idx-1 domain_no=DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER FOUND=.FALSE. DO domain_idx2=DOMAIN_MAPPING%ADJACENT_DOMAINS_PTR(domain_no),DOMAIN_MAPPING%ADJACENT_DOMAINS_PTR(domain_no+1)-1 - IF(DOMAIN_MAPPING%ADJACENT_DOMAINS_LIST(domain_idx2)==my_computational_node_number) THEN + IF(DOMAIN_MAPPING%ADJACENT_DOMAINS_LIST(domain_idx2)==my_computation_node_number) THEN FOUND=.TRUE. EXIT ENDIF @@ -7152,7 +7152,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_DATA_RESTORE_INTG(DISTRIBUTED_VECTOR,DATA,ERR,ERRO !Argument variables TYPE(DISTRIBUTED_VECTOR_TYPE), POINTER :: DISTRIBUTED_VECTOR !1) THEN + IF(NUMBER_OF_COMPUTATION_NODES>1) THEN CALL DISTRIBUTED_VECTOR_UPDATE_WAITFINISHED(DISTRIBUTED_VECTOR,ERR,ERROR,*999) !Copy the receive buffers back to the ghost positions in the data vector DO domain_idx=1,DISTRIBUTED_VECTOR%DOMAIN_MAPPING%NUMBER_OF_ADJACENT_DOMAINS @@ -8170,7 +8170,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) INTEGER(INTG), INTENT(OUT) :: ERR !1) THEN + IF(NUMBER_OF_COMPUTATION_NODES>1) THEN IF(DISTRIBUTED_VECTOR%DOMAIN_MAPPING%NUMBER_OF_ADJACENT_DOMAINS>0) THEN !Fill in the send buffers with the send ghost values DO domain_idx=1,DISTRIBUTED_VECTOR%DOMAIN_MAPPING%NUMBER_OF_ADJACENT_DOMAINS @@ -8230,7 +8230,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_BUFFER_SIZE,MPI_INTEGER, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER, & - & computationalEnvironment%mpiCommunicator, & + & computationEnvironment%mpiCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_IRECV",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8243,7 +8243,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive comm = ", & - & computationalEnvironment%mpiCommunicator,ERR,ERROR,*999) + & computationEnvironment%mpiCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,ERR,ERROR,*999) ENDIF @@ -8252,7 +8252,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_BUFFER_SIZE,MPI_REAL, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER, & - & computationalEnvironment%mpiCommunicator, & + & computationEnvironment%mpiCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_IRECV",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8265,7 +8265,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive comm = ", & - & computationalEnvironment%mpiCommunicator,ERR,ERROR,*999) + & computationEnvironment%mpiCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,ERR,ERROR,*999) ENDIF @@ -8274,7 +8274,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_BUFFER_SIZE,MPI_DOUBLE_PRECISION, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER, & - & computationalEnvironment%mpiCommunicator, & + & computationEnvironment%mpiCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_IRECV",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8287,7 +8287,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive comm = ", & - & computationalEnvironment%mpiCommunicator,ERR,ERROR,*999) + & computationEnvironment%mpiCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,ERR,ERROR,*999) ENDIF @@ -8296,7 +8296,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_BUFFER_SIZE,MPI_LOGICAL, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER, & - & computationalEnvironment%mpiCommunicator, & + & computationEnvironment%mpiCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_IRECV",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8309,7 +8309,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive comm = ", & - & computationalEnvironment%mpiCommunicator,ERR,ERROR,*999) + & computationEnvironment%mpiCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,ERR,ERROR,*999) ENDIF @@ -8331,7 +8331,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_BUFFER_SIZE,MPI_INTEGER, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER, & - & computationalEnvironment%mpiCommunicator, & + & computationEnvironment%mpiCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ISEND",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8344,7 +8344,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send comm = ", & - & computationalEnvironment%mpiCommunicator,ERR,ERROR,*999) + & computationEnvironment%mpiCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,ERR,ERROR,*999) ENDIF @@ -8353,7 +8353,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_BUFFER_SIZE,MPI_REAL, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER, & - & computationalEnvironment%mpiCommunicator, & + & computationEnvironment%mpiCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ISEND",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8366,7 +8366,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send comm = ", & - & computationalEnvironment%mpiCommunicator,ERR,ERROR,*999) + & computationEnvironment%mpiCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,ERR,ERROR,*999) ENDIF @@ -8375,7 +8375,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_BUFFER_SIZE,MPI_DOUBLE_PRECISION, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER, & - & computationalEnvironment%mpiCommunicator, & + & computationEnvironment%mpiCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ISEND",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8387,7 +8387,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER,ERR,ERROR,*999) - CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send comm = ",computationalEnvironment%mpiCommunicator, & + CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send comm = ",computationEnvironment%mpiCommunicator, & & ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,ERR,ERROR,*999) @@ -8397,7 +8397,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_BUFFER_SIZE,MPI_LOGICAL, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER, & - & computationalEnvironment%mpiCommunicator, & + & computationEnvironment%mpiCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ISEND",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8410,7 +8410,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send comm = ", & - & computationalEnvironment%mpiCommunicator,ERR,ERROR,*999) + & computationEnvironment%mpiCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,ERR,ERROR,*999) ENDIF @@ -8522,12 +8522,12 @@ END SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START !================================================================================================================================ ! - !>Calculates the L2 norm of a distributed vector values on this computational node + !>Calculates the L2 norm of a distributed vector values on this computation node SUBROUTINE DistributedVector_L2Norm(distributedVector,norm,err,error,*) !Argument variables TYPE(DISTRIBUTED_VECTOR_TYPE), INTENT(IN), POINTER :: distributedVector !Calculates the dot product of 2 distributed integer vectors on this computational node + !>Calculates the dot product of 2 distributed integer vectors on this computation node SUBROUTINE DistributedVector_VecDotIntg(distributedVectorA,distributedVectorB,dotProduct,err,error,*) !Argument variables TYPE(DISTRIBUTED_VECTOR_TYPE), INTENT(IN), POINTER :: distributedVectorA !Calculates the dot product of 2 distributed single-precision vectors on this computational node + !>Calculates the dot product of 2 distributed single-precision vectors on this computation node SUBROUTINE DistributedVector_VecDotSp(distributedVectorA,distributedVectorB,dotProduct,err,error,*) !Argument variables TYPE(DISTRIBUTED_VECTOR_TYPE), INTENT(IN), POINTER :: distributedVectorA !Calculates the dot product of 2 distributed double-precision vectors on this computational node + !>Calculates the dot product of 2 distributed double-precision vectors on this computation node SUBROUTINE DistributedVector_VecDotDp(distributedVectorA,distributedVectorB,dotProduct,err,error,*) !Argument variables TYPE(DISTRIBUTED_VECTOR_TYPE), INTENT(IN), POINTER :: distributedVectorA ! Auckland, the University of Oxford and King's College, London. !> All Rights Reserved. !> -!> Contributor(s): +!> Contributor(s): Chris Bradley !> !> Alternatively, the contents of this file may be used under the terms of !> either the GNU General Public License Version 2 or later (the "GPL"), or @@ -45,7 +45,7 @@ MODULE DOMAIN_MAPPINGS USE BaseRoutines - USE ComputationEnvironment + USE ComputationRoutines USE INPUT_OUTPUT USE ISO_VARYING_STRING USE KINDS @@ -159,7 +159,7 @@ SUBROUTINE DOMAIN_MAPPINGS_GLOBAL_TO_LOCAL_GET(DOMAIN_MAPPING,GLOBAL_NUMBER,LOCA IF(ASSOCIATED(DOMAIN_MAPPING)) THEN IF(GLOBAL_NUMBER>=1.AND.GLOBAL_NUMBER<=DOMAIN_MAPPING%NUMBER_OF_GLOBAL) THEN IF(DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(GLOBAL_NUMBER)%DOMAIN_NUMBER(1)== & - & computationalEnvironment%myComputationalNodeNumber) THEN + & computationEnvironment%myComputationNodeNumber) THEN LOCAL_NUMBER=DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(GLOBAL_NUMBER)%LOCAL_NUMBER(1) LOCAL_EXISTS=.TRUE. ENDIF @@ -192,7 +192,7 @@ SUBROUTINE DOMAIN_MAPPINGS_LOCAL_FROM_GLOBAL_CALCULATE(DOMAIN_MAPPING,ERR,ERROR, TYPE(VARYING_STRING), INTENT(OUT) :: ERROR !0) THEN TOTAL_NUMBER_OF_ADJACENT_DOMAINS=TOTAL_NUMBER_OF_ADJACENT_DOMAINS+1 - IF(domain_no==myComputationalNodeNumber) NUMBER_OF_ADJACENT_DOMAINS=NUMBER_OF_ADJACENT_DOMAINS+1 + IF(domain_no==myComputationNodeNumber) NUMBER_OF_ADJACENT_DOMAINS=NUMBER_OF_ADJACENT_DOMAINS+1 ENDIF ENDIF ENDDO !domain_no2 @@ -335,7 +335,7 @@ SUBROUTINE DOMAIN_MAPPINGS_LOCAL_FROM_GLOBAL_CALCULATE(DOMAIN_MAPPING,ERR,ERROR, DO domain_idx=1,DOMAIN_MAPPING%NUMBER_OF_ADJACENT_DOMAINS CALL DOMAIN_MAPPINGS_ADJACENT_DOMAIN_INITIALISE(DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx),ERR,ERROR,*999) domain_no= & - & DOMAIN_MAPPING%ADJACENT_DOMAINS_LIST(DOMAIN_MAPPING%ADJACENT_DOMAINS_PTR(myComputationalNodeNumber)+domain_idx-1) + & DOMAIN_MAPPING%ADJACENT_DOMAINS_LIST(DOMAIN_MAPPING%ADJACENT_DOMAINS_PTR(myComputationNodeNumber)+domain_idx-1) DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER=domain_no ADJACENT_DOMAIN_MAP(domain_no)=domain_idx NULLIFY(GHOST_SEND_LISTS(domain_idx)%PTR) @@ -368,7 +368,7 @@ SUBROUTINE DOMAIN_MAPPINGS_LOCAL_FROM_GLOBAL_CALCULATE(DOMAIN_MAPPING,ERR,ERROR, domain_no=DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(global_number)%DOMAIN_NUMBER(domain_idx) local_type=DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_TYPE(domain_idx) IF(local_type/=DOMAIN_LOCAL_GHOST) THEN - IF(domain_no==myComputationalNodeNumber) SEND_GLOBAL=.TRUE. + IF(domain_no==myComputationNodeNumber) SEND_GLOBAL=.TRUE. IF(RECEIVE_FROM_DOMAIN==-1) THEN RECEIVE_FROM_DOMAIN=domain_no ELSE @@ -390,7 +390,7 @@ SUBROUTINE DOMAIN_MAPPINGS_LOCAL_FROM_GLOBAL_CALCULATE(DOMAIN_MAPPING,ERR,ERROR, domain_no=DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(global_number)%DOMAIN_NUMBER(domain_idx) local_number=DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_NUMBER(domain_idx) local_type=DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_TYPE(domain_idx) - IF(domain_no==myComputationalNodeNumber) THEN + IF(domain_no==myComputationNodeNumber) THEN DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_number)=global_number SELECT CASE(DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_TYPE(domain_idx)) CASE(DOMAIN_LOCAL_INTERNAL) diff --git a/src/equations_set_routines.f90 b/src/equations_set_routines.f90 index 7cb7fdeb..24702e6a 100644 --- a/src/equations_set_routines.f90 +++ b/src/equations_set_routines.f90 @@ -50,7 +50,7 @@ MODULE EQUATIONS_SET_ROUTINES USE BOUNDARY_CONDITIONS_ROUTINES USE CLASSICAL_FIELD_ROUTINES USE CmissMPI - USE ComputationEnvironment + USE ComputationRoutines USE Constants USE COORDINATE_ROUTINES USE DISTRIBUTED_MATRIX_VECTOR @@ -6305,7 +6305,7 @@ SUBROUTINE EQUATIONS_SET_BOUNDARY_CONDITIONS_INCREMENT(EQUATIONS_SET,BOUNDARY_CO TYPE(BOUNDARY_CONDITIONS_DIRICHLET_TYPE), POINTER :: DIRICHLET_BOUNDARY_CONDITIONS TYPE(BOUNDARY_CONDITIONS_PRESSURE_INCREMENTED_TYPE), POINTER :: PRESSURE_INCREMENTED_BOUNDARY_CONDITIONS INTEGER(INTG) :: variable_idx,variable_type,dirichlet_idx,dirichlet_dof_idx,neumann_point_dof - INTEGER(INTG) :: condition_idx, condition_global_dof, condition_local_dof, myComputationalNodeNumber + INTEGER(INTG) :: condition_idx, condition_global_dof, condition_local_dof, myComputationNodeNumber REAL(DP), POINTER :: FULL_LOADS(:),CURRENT_LOADS(:), PREV_LOADS(:) REAL(DP) :: FULL_LOAD, CURRENT_LOAD, NEW_LOAD, PREV_LOAD TYPE(VARYING_STRING) :: localError @@ -6320,7 +6320,7 @@ SUBROUTINE EQUATIONS_SET_BOUNDARY_CONDITIONS_INCREMENT(EQUATIONS_SET,BOUNDARY_CO NULLIFY(PREV_LOADS) NULLIFY(CURRENT_LOADS) - myComputationalNodeNumber=ComputationalEnvironment_NodeNumberGet(err,error) + myComputationNodeNumber=ComputationEnvironment_NodeNumberGet(err,error) !Take the stored load, scale it down appropriately then apply to the unknown variables IF(ASSOCIATED(EQUATIONS_SET)) THEN @@ -6367,7 +6367,7 @@ SUBROUTINE EQUATIONS_SET_BOUNDARY_CONDITIONS_INCREMENT(EQUATIONS_SET,BOUNDARY_CO & BOUNDARY_CONDITION_MOVED_WALL_INCREMENTED) !Convert dof index to local index IF(DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(dirichlet_dof_idx)%DOMAIN_NUMBER(1)== & - & myComputationalNodeNumber) THEN + & myComputationNodeNumber) THEN dirichlet_dof_idx=DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(dirichlet_dof_idx)%LOCAL_NUMBER(1) IF(0=NUMBER_OF_EXNODE_FILES) EXIT ENDIF - !IF(MASTER_COMPUTATIONAL_NUMBER/=myComputationalNodeNumber) PRINT * , idx_exnode + !IF(MASTER_COMPUTATION_NUMBER/=myComputationNodeNumber) PRINT * , idx_exnode !goto the start of mesh part - IF(MASTER_COMPUTATIONAL_NUMBER==myComputationalNodeNumber) THEN + IF(MASTER_COMPUTATION_NUMBER==myComputationNodeNumber) THEN IF(FILE_END) THEN FILE_ID=1030+idx_exnode @@ -1286,14 +1286,14 @@ SUBROUTINE FIELD_IO_CREATE_FIELDS(NAME, REGION, DECOMPOSITION, FIELD_VALUES_SET_ NODE_SECTION=.TRUE. ENDDO !idx_field ENDIF !FILE_END==.FALSE..AND.SECTION_START=.TRUE..AND.NODE_SECTION=.FALSE. - ENDIF !MASTER_COMPUTATIONAL_NUMBER + ENDIF !MASTER_COMPUTATION_NUMBER !broadcasting total_number_of_devs - CALL MPI_BCAST(total_number_of_devs,1,MPI_INTEGER,MASTER_COMPUTATIONAL_NUMBER, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + CALL MPI_BCAST(total_number_of_devs,1,MPI_INTEGER,MASTER_COMPUTATION_NUMBER, & + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_BCAST",MPI_IERROR,ERR,ERROR,*999) - IF(MASTER_COMPUTATIONAL_NUMBER/=myComputationalNodeNumber) THEN + IF(MASTER_COMPUTATION_NUMBER/=myComputationNodeNumber) THEN CALL REALLOCATE( LIST_DEV, total_number_of_devs, & & "Could not allocate memory for nodal derivative index in non-master node", ERR, ERROR, *999 ) ENDIF @@ -1302,16 +1302,16 @@ SUBROUTINE FIELD_IO_CREATE_FIELDS(NAME, REGION, DECOMPOSITION, FIELD_VALUES_SET_ & "Could not allocate memory for nodal derivative index in non-master node", ERR, ERROR, *999 ) !broadcasting total_number_of_comps - CALL MPI_BCAST(LIST_DEV_POS,total_number_of_comps,MPI_INTEGER,MASTER_COMPUTATIONAL_NUMBER, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + CALL MPI_BCAST(LIST_DEV_POS,total_number_of_comps,MPI_INTEGER,MASTER_COMPUTATION_NUMBER, & + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_BCAST",MPI_IERROR,ERR,ERROR,*999) !broadcasting total_number_of_devs - CALL MPI_BCAST(LIST_DEV,total_number_of_devs,MPI_INTEGER,MASTER_COMPUTATIONAL_NUMBER, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + CALL MPI_BCAST(LIST_DEV,total_number_of_devs,MPI_INTEGER,MASTER_COMPUTATION_NUMBER, & + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_BCAST",MPI_IERROR,ERR,ERROR,*999) !goto the start of mesh part - IF(MASTER_COMPUTATIONAL_NUMBER==myComputationalNodeNumber) THEN + IF(MASTER_COMPUTATION_NUMBER==myComputationNodeNumber) THEN !have not touched the end IF((.NOT.FILE_END).AND.SECTION_START.AND.NODE_SECTION) THEN @@ -1363,17 +1363,17 @@ SUBROUTINE FIELD_IO_CREATE_FIELDS(NAME, REGION, DECOMPOSITION, FIELD_VALUES_SET_ IF(VERIFY(CMISS_KEYWORD_NODE, LINE)/=0) NODE_SECTION=.FALSE. ENDIF ENDIF !FILE_END==.FALSE..AND.SECTION_START=.TRUE..AND.NODE_SECTION=.TRUE. - ENDIF !(MASTER_COMPUTATIONAL_NUMBER==myComputationalNodeNumber) + ENDIF !(MASTER_COMPUTATION_NUMBER==myComputationNodeNumber) !broadcasting total_number_of_devs - CALL MPI_BCAST(LIST_DEV_VALUE,total_number_of_devs,MPI_REAL8,MASTER_COMPUTATIONAL_NUMBER, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + CALL MPI_BCAST(LIST_DEV_VALUE,total_number_of_devs,MPI_REAL8,MASTER_COMPUTATION_NUMBER, & + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_BCAST",MPI_IERROR,ERR,ERROR,*999) - CALL MPI_BCAST(NODAL_USER_NUMBER,1,MPI_INTEGER,MASTER_COMPUTATIONAL_NUMBER, & - & computationalEnvironment%mpiCommunicator,MPI_IERROR) + CALL MPI_BCAST(NODAL_USER_NUMBER,1,MPI_INTEGER,MASTER_COMPUTATION_NUMBER, & + & computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_BCAST",MPI_IERROR,ERR,ERROR,*999) - !IF(MASTER_COMPUTATIONAL_NUMBER/=myComputationalNodeNumber) THEN + !IF(MASTER_COMPUTATION_NUMBER/=myComputationNodeNumber) THEN print *, "user number:" print *, NODAL_USER_NUMBER print *, LIST_DEV_VALUE @@ -1491,7 +1491,7 @@ END SUBROUTINE FIELD_IO_CREATE_DECOMPISTION !================================================================================================================================ ! - !>Import fields from files into different computational nodes + !>Import fields from files into different computation nodes SUBROUTINE FIELD_IO_FIELDS_IMPORT(NAME, METHOD, REGION, MESH, MESH_USER_NUMBER, DECOMPOSITION, DECOMPOSITION_USER_NUMBER, & &DECOMPOSITION_METHOD, FIELD_VALUES_SET_TYPE, FIELD_SCALING_TYPE, ERR, ERROR, *) !Argument variables @@ -1509,9 +1509,9 @@ SUBROUTINE FIELD_IO_FIELDS_IMPORT(NAME, METHOD, REGION, MESH, MESH_USER_NUMBER, INTEGER(INTG), INTENT(OUT) :: ERR !Read the global mesh into one computational node first and then broadcasting to others nodes - SUBROUTINE FIELD_IO_IMPORT_GLOBAL_MESH(NAME, REGION, MESH, MESH_USER_NUMBER, MASTER_COMPUTATIONAL_NUMBER, & - & myComputationalNodeNumber, &!USER_NODAL_NUMBER_MAP_GLOBAL_NODAL_NUMBER, + !>Read the global mesh into one computation node first and then broadcasting to others nodes + SUBROUTINE FIELD_IO_IMPORT_GLOBAL_MESH(NAME, REGION, MESH, MESH_USER_NUMBER, MASTER_COMPUTATION_NUMBER, & + & myComputationNodeNumber, &!USER_NODAL_NUMBER_MAP_GLOBAL_NODAL_NUMBER, &MESH_COMPONENTS_OF_FIELD_COMPONENTS, & & COMPONENTS_IN_FIELDS, NUMBER_OF_FIELDS, NUMBER_OF_EXNODE_FILES, ERR, ERROR, *) !Argument variables @@ -1618,8 +1618,8 @@ SUBROUTINE FIELD_IO_IMPORT_GLOBAL_MESH(NAME, REGION, MESH, MESH_USER_NUMBER, MAS TYPE(MESH_TYPE), POINTER :: MESH !Write the header of a group elements using FORTRAN SUBROUTINE FieldIO_ExportElementalGroupHeaderFortran( global_number, MAX_NODE_COMP_INDEX,NUM_OF_SCALING_FACTOR_SETS, & - & LIST_COMP_SCALE, myComputationalNodeNumber, elementalInfoSet, sessionHandle, ERR,ERROR, *) + & LIST_COMP_SCALE, myComputationNodeNumber, elementalInfoSet, sessionHandle, ERR,ERROR, *) !Argument variables INTEGER(INTG), INTENT(IN) :: global_number !elementalInfoSet%COMPONENTS(comp_idx)%PTR%DOMAIN !get the domain index for this variable component according to my own computional node number local_number = FindMyLocalDomainNumber( componentDomain%MAPPINGS%ELEMENTS%GLOBAL_TO_LOCAL_MAP( global_number ),& - & myComputationalNodeNumber ) + & myComputationNodeNumber ) GROUP_LOCAL_NUMBER(comp_idx)=local_number !use local domain information find the out the maximum number of derivatives DOMAIN_ELEMENTS=>componentDomain%TOPOLOGY%ELEMENTS @@ -3444,13 +3444,13 @@ END SUBROUTINE FieldIO_ExportElementalGroupHeaderFortran ! SUBROUTINE FIELD_IO_EXPORT_ELEMENT_SCALE_FACTORS( sessionHandle, components, componentScales, globalNumber, & - & myComputationalNodeNumber, ERR, ERROR, * ) + & myComputationNodeNumber, ERR, ERROR, * ) !Argument variables INTEGER(INTG) :: sessionHandle TYPE(FIELD_IO_COMPONENT_INFO_SET), INTENT(INOUT) :: components ! component%DOMAIN%TOPOLOGY%ELEMENTS domainNodes => component%DOMAIN%TOPOLOGY%NODES @@ -3558,13 +3558,13 @@ END SUBROUTINE FIELD_IO_EXPORT_ELEMENT_SCALE_FACTORS ! !>Write all the elemental information from LOCAL_PROCESS_NODAL_INFO_SET to exelem files - SUBROUTINE FIELD_IO_EXPORT_ELEMENTS_INTO_LOCAL_FILE(ELEMENTAL_INFO_SET, NAME, myComputationalNodeNumber, & + SUBROUTINE FIELD_IO_EXPORT_ELEMENTS_INTO_LOCAL_FILE(ELEMENTAL_INFO_SET, NAME, myComputationNodeNumber, & & ERR, ERROR, *) - !the reason that myComputationalNodeNumber is used in the argument is for future extension + !the reason that myComputationNodeNumber is used in the argument is for future extension !Argument variables TYPE(FIELD_IO_INFO_SET), INTENT(INOUT) :: ELEMENTAL_INFO_SET !component%DOMAIN%TOPOLOGY%ELEMENTS !get the domain index for this variable component according to my own computional node number local_number = FindMyLocalDomainNumber( DOMAIN_MAPPING_ELEMENTS%GLOBAL_TO_LOCAL_MAP( global_number ), & - & myComputationalNodeNumber ) + & myComputationNodeNumber ) !use local domain information find the out the maximum number of derivatives BASIS => DOMAIN_ELEMENTS%ELEMENTS( local_number )%BASIS @@ -3861,7 +3861,7 @@ SUBROUTINE FIELD_IO_EXPORT_ELEMENTS_INTO_LOCAL_FILE(ELEMENTAL_INFO_SET, NAME, my ENDIF CALL FIELD_IO_EXPORT_ELEMENT_SCALE_FACTORS( sessionHandle, components, & - & LIST_COMP_SCALE, global_number, myComputationalNodeNumber, ERR, ERROR, *999 ) + & LIST_COMP_SCALE, global_number, myComputationNodeNumber, ERR, ERROR, *999 ) ENDDO !elem_idx @@ -3887,10 +3887,10 @@ END SUBROUTINE FIELD_IO_EXPORT_ELEMENTS_INTO_LOCAL_FILE ! !>Sort the Elemental_info_set according to the type of field variable components - SUBROUTINE FIELD_IO_ELEMENTAL_INFO_SET_SORT(ELEMENTAL_INFO_SET, myComputationalNodeNumber, ERR,ERROR,*) + SUBROUTINE FIELD_IO_ELEMENTAL_INFO_SET_SORT(ELEMENTAL_INFO_SET, myComputationNodeNumber, ERR,ERROR,*) !Argument variables TYPE(FIELD_IO_INFO_SET), INTENT(INOUT) :: ELEMENTAL_INFO_SET !& & ELEMENTAL_INFO_SET%COMPONENT_INFO_SET(nn1)%PTR%COMPONENTS(component_idx)%PTR% & & DOMAIN%TOPOLOGY%ELEMENTS @@ -3991,7 +3991,7 @@ SUBROUTINE FIELD_IO_ELEMENTAL_INFO_SET_SORT(ELEMENTAL_INFO_SET, myComputationalN !get the domain index for this variable component according to my own computional node number !local number of nn2'th node in the damain assoicated with component(component_idx) local_number2 = FindMyLocalDomainNumber( DOMAIN_MAPPING_ELEMENTS%GLOBAL_TO_LOCAL_MAP( global_number2 ), & - & myComputationalNodeNumber ) + & myComputationNodeNumber ) DOMAIN_ELEMENTS2=>& & ELEMENTAL_INFO_SET%COMPONENT_INFO_SET(nn2)%PTR%COMPONENTS(component_idx)%PTR% & & DOMAIN%TOPOLOGY%ELEMENTS @@ -4281,23 +4281,23 @@ END SUBROUTINE FieldIO_ElementalInfoSetAttachLocalProcess ! TYPE(VARYING_STRING), INTENT(OUT) :: ERROR !Sort nodal information according to the type of field variable component - SUBROUTINE FIELD_IO_NODAL_INFO_SET_SORT(NODAL_INFO_SET, myComputationalNodeNumber, ERR,ERROR,*) + SUBROUTINE FIELD_IO_NODAL_INFO_SET_SORT(NODAL_INFO_SET, myComputationNodeNumber, ERR,ERROR,*) !Argument variables TYPE(FIELD_IO_INFO_SET), INTENT(INOUT) :: NODAL_INFO_SET !Write the header of a group nodes using FORTRAIN !SUBROUTINE FIELD_IO_IMPORT_NODAL_GROUP_HEADER_FORTRAN(NODAL_INFO_SET, LOCAL_NODAL_NUMBER, MAX_NUM_OF_NODAL_DERIVATIVES, & - !&myComputationalNodeNumber, FILE_ID, ERR,ERROR, *) + !&myComputationNodeNumber, FILE_ID, ERR,ERROR, *) ! !Argument variables ! TYPE(FIELD_IO_INFO_SET), INTENT(INOUT) :: NODAL_INFO_SET !NODAL_INFO_SET%COMPONENT_INFO_SET(LOCAL_NODAL_NUMBER)%& ! &COMPONENTS(comp_idx)%PTR%DOMAIN%MAPPINGS%NODES ! !get the domain index for this variable component according to my own computional node number - ! local_number = FindMyLocalDomainNumber( DOMAIN_MAPPING_NODES%GLOBAL_TO_LOCAL_MAP(global_number), myComputationalNodeNumber ) + ! local_number = FindMyLocalDomainNumber( DOMAIN_MAPPING_NODES%GLOBAL_TO_LOCAL_MAP(global_number), myComputationNodeNumber ) ! !use local domain information find the out the maximum number of derivatives ! DOMAIN_NODES=>NODAL_INFO_SET%COMPONENT_INFO_SET(LOCAL_NODAL_NUMBER)%COMPONENTS(comp_idx)%PTR%DOMAIN%TOPOLOGY%NODES ! MAX_NUM_OF_NODAL_DERIVATIVES=MAX(DOMAIN_NODES%NODES(local_number)%NUMBER_OF_DERIVATIVES,MAX_NUM_OF_NODAL_DERIVATIVES) @@ -5091,7 +5091,7 @@ END FUNCTION FIELD_IO_GET_COMPONENT_INFO_LABEL ! DOMAIN_MAPPING_NODES=>NODAL_INFO_SET%COMPONENT_INFO_SET(LOCAL_NODAL_NUMBER)%COMPONENTS(comp_idx)%PTR%& ! &DOMAIN%MAPPINGS%NODES ! !get the domain index for this variable component according to my own computional node number - ! local_number = FindMyLocalDomainNumber( DOMAIN_MAPPING_NODES%GLOBAL_TO_LOCAL_MAP(global_number), myComputationalNodeNumber ) + ! local_number = FindMyLocalDomainNumber( DOMAIN_MAPPING_NODES%GLOBAL_TO_LOCAL_MAP(global_number), myComputationNodeNumber ) ! !use local domain information find the out the maximum number of derivatives ! DOMAIN_NODES=>NODAL_INFO_SET%COMPONENT_INFO_SET(LOCAL_NODAL_NUMBER)%COMPONENTS(comp_idx)%PTR%DOMAIN%TOPOLOGY%NODES ! !get the nodal partial derivatives @@ -5137,12 +5137,12 @@ END FUNCTION FIELD_IO_GET_COMPONENT_INFO_LABEL !>Write the header of a group nodes using FORTRAIN SUBROUTINE FIELD_IO_EXPORT_NODAL_GROUP_HEADER_FORTRAN(fieldInfoSet, global_number, MAX_NUM_OF_NODAL_DERIVATIVES, & - &myComputationalNodeNumber, sessionHandle, paddingInfo, ERR,ERROR, *) + &myComputationNodeNumber, sessionHandle, paddingInfo, ERR,ERROR, *) !Argument variables TYPE(FIELD_IO_COMPONENT_INFO_SET), INTENT(IN) :: fieldInfoSet INTEGER(INTG), INTENT(IN) :: global_number INTEGER(INTG), INTENT(INOUT) :: MAX_NUM_OF_NODAL_DERIVATIVES !Write all the nodal information from NODAL_INFO_SET to local exnode files - SUBROUTINE FIELD_IO_EXPORT_NODES_INTO_LOCAL_FILE(NODAL_INFO_SET, NAME, myComputationalNodeNumber,ERR, ERROR, *) - !the reason that myComputationalNodeNumber is used in the argument is for future extension + SUBROUTINE FIELD_IO_EXPORT_NODES_INTO_LOCAL_FILE(NODAL_INFO_SET, NAME, myComputationNodeNumber,ERR, ERROR, *) + !the reason that myComputationNodeNumber is used in the argument is for future extension !Argument variables TYPE(FIELD_IO_INFO_SET), INTENT(INOUT):: NODAL_INFO_SET !Collect nodal information from each MPI process - SUBROUTINE FieldIO_NodelInfoSetAttachLocalProcess(NODAL_INFO_SET, FIELDS, myComputationalNodeNumber, ERR,ERROR,*) + SUBROUTINE FieldIO_NodelInfoSetAttachLocalProcess(NODAL_INFO_SET, FIELDS, myComputationNodeNumber, ERR,ERROR,*) !Argument variables TYPE(FIELD_IO_INFO_SET), INTENT(INOUT):: NODAL_INFO_SET ! Auckland, the University of Oxford and King's College, London. !> All Rights Reserved. !> -!> Contributor(s): +!> Contributor(s): Chris Bradley !> !> Alternatively, the contents of this file may be used under the terms of !> either the GNU General Public License Version 2 or later (the "GPL"), or @@ -46,7 +46,7 @@ MODULE FIELD_ROUTINES USE BaseRoutines USE BASIS_ROUTINES - USE ComputationEnvironment + USE ComputationRoutines USE COORDINATE_ROUTINES USE CmissMPI USE DISTRIBUTED_MATRIX_VECTOR @@ -10010,8 +10010,8 @@ SUBROUTINE FIELD_MAPPINGS_CALCULATE(FIELD,ERR,ERROR,*) & NUMBER_OF_CONSTANT_DOFS,NUMBER_OF_ELEMENT_DOFS,NUMBER_OF_NODE_DOFS,NUMBER_OF_GRID_POINT_DOFS,NUMBER_OF_GAUSS_POINT_DOFS, & & NUMBER_OF_LOCAL_VARIABLE_DOFS,TOTAL_NUMBER_OF_VARIABLE_DOFS,NUMBER_OF_DOMAINS,variable_global_ny, & & variable_local_ny,domain_idx,domain_no,constant_nyy,element_ny,element_nyy,node_ny,node_nyy,grid_point_nyy, & - & Gauss_point_nyy,version_idx,derivative_idx,ny,NUMBER_OF_COMPUTATIONAL_NODES, & - & myComputationalNodeNumber,domain_type_stop,start_idx,stop_idx,element_idx,node_idx,NUMBER_OF_LOCAL, NGP, MAX_NGP, & + & Gauss_point_nyy,version_idx,derivative_idx,ny,NUMBER_OF_COMPUTATION_NODES, & + & myComputationNodeNumber,domain_type_stop,start_idx,stop_idx,element_idx,node_idx,NUMBER_OF_LOCAL, NGP, MAX_NGP, & & gp,MPI_IERROR,NUMBER_OF_GLOBAL_DOFS,gauss_point_idx,NUMBER_OF_DATA_POINT_DOFS,data_point_nyy,dataPointIdx,elementIdx, & & localDataNumber,globalElementNumber INTEGER(INTG), ALLOCATABLE :: VARIABLE_LOCAL_DOFS_OFFSETS(:),VARIABLE_GHOST_DOFS_OFFSETS(:), & @@ -10028,9 +10028,9 @@ SUBROUTINE FIELD_MAPPINGS_CALCULATE(FIELD,ERR,ERROR,*) ENTERS("FIELD_MAPPINGS_CALCULATE",ERR,ERROR,*999) IF(ASSOCIATED(FIELD)) THEN - NUMBER_OF_COMPUTATIONAL_NODES=ComputationalEnvironment_NumberOfNodesGet(ERR,ERROR) + NUMBER_OF_COMPUTATION_NODES=ComputationEnvironment_NumberOfNodesGet(ERR,ERROR) IF(ERR/=0) GOTO 999 - myComputationalNodeNumber=ComputationalEnvironment_NodeNumberGet(ERR,ERROR) + myComputationNodeNumber=ComputationEnvironment_NodeNumberGet(ERR,ERROR) IF(ERR/=0) GOTO 999 !Calculate the number of global and local degrees of freedom for the field variables and components. Each field variable !component has a set of DOFs so loop over the components for each variable component and count up the DOFs. @@ -10077,7 +10077,7 @@ SUBROUTINE FIELD_MAPPINGS_CALCULATE(FIELD,ERR,ERROR,*) NGP=BASIS%QUADRATURE%QUADRATURE_SCHEME_MAP(BASIS_DEFAULT_QUADRATURE_SCHEME)%PTR%NUMBER_OF_GAUSS MAX_NGP=MAX(MAX_NGP,NGP) ENDDO !element_idx - CALL MPI_ALLREDUCE(MPI_IN_PLACE,MAX_NGP,1,MPI_INTEGER,MPI_MAX,computationalEnvironment%mpiCommunicator,MPI_IERROR) + CALL MPI_ALLREDUCE(MPI_IN_PLACE,MAX_NGP,1,MPI_INTEGER,MPI_MAX,computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) NUMBER_OF_GAUSS_POINT_DOFS=NUMBER_OF_GAUSS_POINT_DOFS+DOMAIN_TOPOLOGY%ELEMENTS%TOTAL_NUMBER_OF_ELEMENTS*MAX_NGP NUMBER_OF_LOCAL_VARIABLE_DOFS=NUMBER_OF_LOCAL_VARIABLE_DOFS+DOMAIN_TOPOLOGY%ELEMENTS%NUMBER_OF_ELEMENTS*MAX_NGP @@ -10146,7 +10146,7 @@ SUBROUTINE FIELD_MAPPINGS_CALCULATE(FIELD,ERR,ERROR,*) IF(ERR/=0) CALL FlagError("Could not allocate variable ghost dofs offsets.",ERR,ERROR,*999) !We want to ensure that the ghost DOFs are at the end so loop over the DOFs in two passes. The first pass will process !the local DOFs for each variable component and the second pass will process the ghost DOFs for each variable component. - IF(NUMBER_OF_COMPUTATIONAL_NODES==1) THEN + IF(NUMBER_OF_COMPUTATION_NODES==1) THEN domain_type_stop=1 !Local only ELSE domain_type_stop=2 !Local+Ghosts @@ -10192,7 +10192,7 @@ SUBROUTINE FIELD_MAPPINGS_CALCULATE(FIELD,ERR,ERROR,*) variable_global_ny=1+VARIABLE_GLOBAL_DOFS_OFFSET CALL DOMAIN_MAPPINGS_MAPPING_GLOBAL_INITIALISE(FIELD_VARIABLE_DOFS_MAPPING% & & GLOBAL_TO_LOCAL_MAP(variable_global_ny),ERR,ERROR,*999) - NUMBER_OF_DOMAINS=NUMBER_OF_COMPUTATIONAL_NODES !Constant is in all domains + NUMBER_OF_DOMAINS=NUMBER_OF_COMPUTATION_NODES !Constant is in all domains ALLOCATE(FIELD_VARIABLE_DOFS_MAPPING%GLOBAL_TO_LOCAL_MAP(variable_global_ny)%LOCAL_NUMBER(NUMBER_OF_DOMAINS), & & STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate field variable dofs global to local map local number.", & @@ -10572,7 +10572,7 @@ SUBROUTINE FIELD_MAPPINGS_CALCULATE(FIELD,ERR,ERROR,*) decompositionTopology=>domain%DECOMPOSITION%TOPOLOGY IF(domain_type_idx==1) THEN ! domain_type_idx==1 -> non ghosts !Allocate parameter to dof map for this field variable component - !including both local and ghost data points on this computational domain. + !including both local and ghost data points on this computation domain. ALLOCATE(FIELD_COMPONENT%PARAM_TO_DOF_MAP%DATA_POINT_PARAM2DOF_MAP%DATA_POINTS(decompositionTopology% & & dataPoints%totalNumberOfDataPoints),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate field component parameter to dof data point map.",ERR,ERROR,*999) @@ -10720,13 +10720,13 @@ SUBROUTINE FIELD_MAPPINGS_CALCULATE(FIELD,ERR,ERROR,*) CASE(FIELD_CONSTANT_INTERPOLATION) DO component_idx=1,FIELD%VARIABLES(variable_idx)%NUMBER_OF_COMPONENTS FIELD_COMPONENT=>FIELD%VARIABLES(variable_idx)%COMPONENTS(component_idx) - variable_local_ny=1+VARIABLE_LOCAL_DOFS_OFFSETS(myComputationalNodeNumber) + variable_local_ny=1+VARIABLE_LOCAL_DOFS_OFFSETS(myComputationNodeNumber) !Allocate and set up global to local domain map for variable mapping IF(ASSOCIATED(FIELD_VARIABLE_DOFS_MAPPING)) THEN variable_global_ny=1+VARIABLE_GLOBAL_DOFS_OFFSET CALL DOMAIN_MAPPINGS_MAPPING_GLOBAL_INITIALISE(FIELD_VARIABLE_DOFS_MAPPING% & & GLOBAL_TO_LOCAL_MAP(variable_global_ny),ERR,ERROR,*999) - NUMBER_OF_DOMAINS=NUMBER_OF_COMPUTATIONAL_NODES !Constant is in all domains + NUMBER_OF_DOMAINS=NUMBER_OF_COMPUTATION_NODES !Constant is in all domains ALLOCATE(FIELD_VARIABLE_DOFS_MAPPING%GLOBAL_TO_LOCAL_MAP(variable_global_ny)%LOCAL_NUMBER(NUMBER_OF_DOMAINS), & & STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate field variable dofs global to local map local number.", & @@ -10828,7 +10828,7 @@ SUBROUTINE FIELD_MAPPINGS_CALCULATE(FIELD,ERR,ERROR,*) DO component_idx=1,FIELD%VARIABLES(variable_idx)%NUMBER_OF_COMPONENTS FIELD_COMPONENT=>FIELD%VARIABLES(variable_idx)%COMPONENTS(component_idx) element_ny=element_ny+1 - variable_local_ny=element_ny+VARIABLE_LOCAL_DOFS_OFFSETS(myComputationalNodeNumber) + variable_local_ny=element_ny+VARIABLE_LOCAL_DOFS_OFFSETS(myComputationNodeNumber) element_nyy=element_nyy+1 !Setup dof to parameter map FIELD%VARIABLES(variable_idx)%DOF_TO_PARAM_MAP%DOF_TYPE(1,variable_local_ny)=FIELD_ELEMENT_DOF_TYPE @@ -10935,7 +10935,7 @@ SUBROUTINE FIELD_MAPPINGS_CALCULATE(FIELD,ERR,ERROR,*) FIELD_COMPONENT=>FIELD%VARIABLES(variable_idx)%COMPONENTS(component_idx) DOMAIN=>FIELD_COMPONENT%DOMAIN node_ny=node_ny+1 - variable_local_ny=node_ny+VARIABLE_LOCAL_DOFS_OFFSETS(myComputationalNodeNumber) + variable_local_ny=node_ny+VARIABLE_LOCAL_DOFS_OFFSETS(myComputationNodeNumber) node_nyy=node_nyy+1 version_idx=DOMAIN%TOPOLOGY%DOFS%DOF_INDEX(1,ny) derivative_idx=DOMAIN%TOPOLOGY%DOFS%DOF_INDEX(2,ny) @@ -11036,7 +11036,7 @@ SUBROUTINE FIELD_MAPPINGS_CALCULATE(FIELD,ERR,ERROR,*) FIELD_COMPONENT=>FIELD%VARIABLES(variable_idx)%COMPONENTS(component_idx) DOMAIN=>FIELD_COMPONENT%DOMAIN element_ny=element_ny+1 - variable_local_ny=element_ny+VARIABLE_LOCAL_DOFS_OFFSETS(myComputationalNodeNumber) + variable_local_ny=element_ny+VARIABLE_LOCAL_DOFS_OFFSETS(myComputationNodeNumber) node_nyy=node_nyy+1 !Setup dof to parameter map FIELD%VARIABLES(variable_idx)%DOF_TO_PARAM_MAP%DOF_TYPE(1,variable_local_ny)=FIELD_GAUSS_POINT_DOF_TYPE @@ -23577,7 +23577,7 @@ SUBROUTINE Field_ParameterSetUpdateElementDataPointDP(field,variableType,fieldSe IF(ASSOCIATED(decompositionTopology)) THEN dataProjection=>field%dataProjection IF(ASSOCIATED(dataProjection)) THEN - ! Use element topology to check if data point is on current computational node + ! Use element topology to check if data point is on current computation node CALL DECOMPOSITION_TOPOLOGY_ELEMENT_CHECK_EXISTS(decompositionTopology,userElementNumber, & & userElementExists,decompositionLocalElementNumber,ghostElement,err,error,*999) IF(userElementExists) THEN diff --git a/src/fieldml_input_routines.f90 b/src/fieldml_input_routines.f90 index ede199f2..0322f565 100755 --- a/src/fieldml_input_routines.f90 +++ b/src/fieldml_input_routines.f90 @@ -50,7 +50,7 @@ MODULE FIELDML_INPUT_ROUTINES USE BasisAccessRoutines USE CMISS USE CONSTANTS - USE ComputationEnvironment + USE ComputationRoutines USE COORDINATE_ROUTINES USE FIELD_ROUTINES USE FIELDML_API @@ -1261,7 +1261,7 @@ SUBROUTINE FieldmlInput_FieldNodalParametersUpdate( FIELDML_INFO, EVALUATOR_NAME INTEGER(INTG), TARGET :: OFFSETS(2), SIZES(2) REAL(C_DOUBLE), ALLOCATABLE, TARGET :: BUFFER(:) INTEGER(INTG) :: READER - INTEGER(INTG) :: myComputationalNodeNumber,nodeDomain,meshComponentNumber + INTEGER(INTG) :: myComputationNodeNumber,nodeDomain,meshComponentNumber ENTERS( "FieldmlInput_FieldNodalParametersUpdate", ERR, ERROR, *999 ) @@ -1312,10 +1312,10 @@ SUBROUTINE FieldmlInput_FieldNodalParametersUpdate( FIELDML_INFO, EVALUATOR_NAME !Default to version 1 of each node derivative (value hardcoded in loop) VERSION_NUMBER = 1 - myComputationalNodeNumber = ComputationalEnvironment_NodeNumberGet(err,error) + myComputationNodeNumber = ComputationEnvironment_NodeNumberGet(err,error) CALL DECOMPOSITION_MESH_COMPONENT_NUMBER_GET(FIELD%DECOMPOSITION,meshComponentNumber,err,error,*999) CALL DECOMPOSITION_NODE_DOMAIN_GET(FIELD%DECOMPOSITION,NODE_NUMBER,meshComponentNumber,nodeDomain,err,error,*999) - IF(nodeDomain==myComputationalNodeNumber) THEN + IF(nodeDomain==myComputationNodeNumber) THEN CALL FIELD_PARAMETER_SET_UPDATE_NODE( FIELD, VARIABLE_TYPE, SET_TYPE, VERSION_NUMBER, & & NO_GLOBAL_DERIV, NODE_NUMBER, COMPONENT_NUMBER, BUFFER( COMPONENT_NUMBER ), ERR, ERROR, *999 ) ENDIF diff --git a/src/fieldml_output_routines.f90 b/src/fieldml_output_routines.f90 index 2e4a2984..68cca8a9 100755 --- a/src/fieldml_output_routines.f90 +++ b/src/fieldml_output_routines.f90 @@ -49,7 +49,7 @@ MODULE FIELDML_OUTPUT_ROUTINES USE BASIS_ROUTINES USE COORDINATE_ROUTINES USE CONSTANTS - USE ComputationEnvironment + USE ComputationRoutines USE FIELD_ROUTINES USE FIELDML_API USE FIELDML_TYPES @@ -1532,7 +1532,7 @@ SUBROUTINE FIELDML_OUTPUT_ADD_FIELD_NODE_DOFS( FIELDML_INFO, BASE_NAME, DOF_FORM LOGICAL, ALLOCATABLE :: IS_NODE_BASED(:) TYPE(C_PTR) :: SIZE_POINTER TYPE(VARYING_STRING) :: ARRAY_LOCATION - INTEGER(INTG) :: myComputationalNodeNumber,nodeDomain,meshComponentNumber + INTEGER(INTG) :: myComputationNodeNumber,nodeDomain,meshComponentNumber ENTERS( "FIELDML_OUTPUT_ADD_FIELD_NODE_DOFS", ERR, ERROR, *999 ) @@ -1629,10 +1629,10 @@ SUBROUTINE FIELDML_OUTPUT_ADD_FIELD_NODE_DOFS( FIELDML_INFO, BASE_NAME, DOF_FORM !Default to version 1 of each node derivative (value hardcoded in loop) VERSION_NUMBER = 1 - myComputationalNodeNumber = ComputationalEnvironment_NodeNumberGet(err,error) + myComputationNodeNumber = ComputationEnvironment_NodeNumberGet(err,error) CALL DECOMPOSITION_MESH_COMPONENT_NUMBER_GET(FIELD%DECOMPOSITION,meshComponentNumber,err,error,*999) CALL DECOMPOSITION_NODE_DOMAIN_GET(FIELD%DECOMPOSITION,I,meshComponentNumber,nodeDomain,err,error,*999) - IF(nodeDomain==myComputationalNodeNumber) THEN + IF(nodeDomain==myComputationNodeNumber) THEN CALL FIELD_PARAMETER_SET_GET_NODE( FIELD, VARIABLE_TYPE, SET_TYPE, VERSION_NUMBER, & & NO_GLOBAL_DERIV, I, FIELD_COMPONENT_NUMBERS(J), DVALUE, ERR, ERROR, *999 ) ENDIF diff --git a/src/finite_elasticity_routines.f90 b/src/finite_elasticity_routines.f90 index e3b3030d..81036fda 100644 --- a/src/finite_elasticity_routines.f90 +++ b/src/finite_elasticity_routines.f90 @@ -26,7 +26,7 @@ !> Auckland, the University of Oxford and King's College, London. !> All Rights Reserved. !> -!> Contributor(s): Kumar Mithraratne, Jack Lee, Alice Hung, Sander Arens +!> Contributor(s): Chris Bradley, Kumar Mithraratne, Jack Lee, Alice Hung, Sander Arens !> !> Alternatively, the contents of this file may be used under the terms of !> either the GNU General Public License Version 2 or later (the "GPL"), or @@ -47,7 +47,7 @@ MODULE FINITE_ELASTICITY_ROUTINES USE BaseRoutines USE BASIS_ROUTINES USE BOUNDARY_CONDITIONS_ROUTINES - USE ComputationEnvironment + USE ComputationRoutines USE Constants USE CONTROL_LOOP_ROUTINES USE ControlLoopAccessRoutines @@ -166,7 +166,7 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO !BC stuff INTEGER(INTG),ALLOCATABLE :: INNER_SURFACE_NODES(:),OUTER_SURFACE_NODES(:),TOP_SURFACE_NODES(:),BOTTOM_SURFACE_NODES(:) INTEGER(INTG) :: INNER_NORMAL_XI,OUTER_NORMAL_XI,TOP_NORMAL_XI,BOTTOM_NORMAL_XI,MESH_COMPONENT - INTEGER(INTG) :: myComputationalNodeNumber, DOMAIN_NUMBER, MPI_IERROR + INTEGER(INTG) :: myComputationNodeNumber, DOMAIN_NUMBER, MPI_IERROR REAL(DP) :: PIN,POUT,LAMBDA,DEFORMED_Z LOGICAL :: X_FIXED,Y_FIXED,NODE_EXISTS, X_OKAY,Y_OKAY TYPE(VARYING_STRING) :: LOCAL_ERROR @@ -175,7 +175,7 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO ENTERS("FiniteElasticity_BoundaryConditionsAnalyticCalculate",err,error,*999) - myComputationalNodeNumber=ComputationalEnvironment_NodeNumberGet(err,error) + myComputationNodeNumber=ComputationEnvironment_NodeNumberGet(err,error) IF(ASSOCIATED(EQUATIONS_SET)) THEN IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN @@ -215,7 +215,7 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO user_node=INNER_SURFACE_NODES(node_idx) !Need to test if this node is in current decomposition CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,user_node,1,DOMAIN_NUMBER,err,error,*999) - IF(DOMAIN_NUMBER==myComputationalNodeNumber) THEN + IF(DOMAIN_NUMBER==myComputationNodeNumber) THEN !Default to version 1 of each node derivative CALL BOUNDARY_CONDITIONS_SET_NODE(BOUNDARY_CONDITIONS,DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE,1,1, & & user_node,ABS(INNER_NORMAL_XI),BOUNDARY_CONDITION_PRESSURE_INCREMENTED,PIN,err,error,*999) @@ -227,7 +227,7 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO user_node=OUTER_SURFACE_NODES(node_idx) !Need to test if this node is in current decomposition CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,user_node,1,DOMAIN_NUMBER,err,error,*999) - IF(DOMAIN_NUMBER==myComputationalNodeNumber) THEN + IF(DOMAIN_NUMBER==myComputationNodeNumber) THEN !Default to version 1 of each node derivative CALL BOUNDARY_CONDITIONS_SET_NODE(BOUNDARY_CONDITIONS,DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE,1,1, & & user_node,ABS(OUTER_NORMAL_XI),BOUNDARY_CONDITION_PRESSURE_INCREMENTED,POUT,err,error,*999) @@ -239,7 +239,7 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO user_node=TOP_SURFACE_NODES(node_idx) !Need to test if this node is in current decomposition CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,user_node,1,DOMAIN_NUMBER,err,error,*999) - IF(DOMAIN_NUMBER==myComputationalNodeNumber) THEN + IF(DOMAIN_NUMBER==myComputationNodeNumber) THEN CALL MeshTopology_NodeCheckExists(MESH,1,user_node,NODE_EXISTS,global_node,err,error,*999) IF(.NOT.NODE_EXISTS) CYCLE CALL DOMAIN_MAPPINGS_GLOBAL_TO_LOCAL_GET(NODES_MAPPING,global_node,NODE_EXISTS,local_node,err,error,*999) @@ -257,7 +257,7 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO user_node=BOTTOM_SURFACE_NODES(node_idx) !Need to check this node exists in the current domain CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,user_node,1,DOMAIN_NUMBER,err,error,*999) - IF(DOMAIN_NUMBER==myComputationalNodeNumber) THEN + IF(DOMAIN_NUMBER==myComputationNodeNumber) THEN !Default to version 1 of each node derivative CALL BOUNDARY_CONDITIONS_SET_NODE(BOUNDARY_CONDITIONS,DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE,1,1, & & user_node,ABS(BOTTOM_NORMAL_XI),BOUNDARY_CONDITION_FIXED,0.0_DP,err,error,*999) @@ -270,7 +270,7 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO DO node_idx=1,SIZE(BOTTOM_SURFACE_NODES,1) user_node=BOTTOM_SURFACE_NODES(node_idx) CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,user_node,1,DOMAIN_NUMBER,err,error,*999) - IF(DOMAIN_NUMBER==myComputationalNodeNumber) THEN + IF(DOMAIN_NUMBER==myComputationNodeNumber) THEN CALL MeshTopology_NodeCheckExists(MESH,1,user_node,NODE_EXISTS,global_node,err,error,*999) IF(.NOT.NODE_EXISTS) CYCLE CALL DOMAIN_MAPPINGS_GLOBAL_TO_LOCAL_GET(NODES_MAPPING,global_node,NODE_EXISTS,local_node,err,error,*999) @@ -303,9 +303,9 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO ENDIF ENDDO !Check it went well - CALL MPI_REDUCE(X_FIXED,X_OKAY,1,MPI_LOGICAL,MPI_LOR,0,computationalEnvironment%mpiCommunicator,MPI_IERROR) - CALL MPI_REDUCE(Y_FIXED,Y_OKAY,1,MPI_LOGICAL,MPI_LOR,0,computationalEnvironment%mpiCommunicator,MPI_IERROR) - IF(myComputationalNodeNumber==0) THEN + CALL MPI_REDUCE(X_FIXED,X_OKAY,1,MPI_LOGICAL,MPI_LOR,0,computationEnvironment%mpiCommunicator,MPI_IERROR) + CALL MPI_REDUCE(Y_FIXED,Y_OKAY,1,MPI_LOGICAL,MPI_LOR,0,computationEnvironment%mpiCommunicator,MPI_IERROR) + IF(myComputationNodeNumber==0) THEN IF(.NOT.(X_OKAY.AND.Y_OKAY)) THEN CALL FlagError("Could not fix nodes to prevent rigid body motion",err,error,*999) ENDIF @@ -422,7 +422,7 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO IF(NODE_EXISTS) THEN CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,user_node, & & DOMAIN_PRESSURE%MESH_COMPONENT_NUMBER,DOMAIN_NUMBER,err,error,*999) - IF(DOMAIN_NUMBER==myComputationalNodeNumber) THEN + IF(DOMAIN_NUMBER==myComputationNodeNumber) THEN !\todo: test the domain node mappings pointer properly local_node=DOMAIN_PRESSURE%mappings%nodes%global_to_local_map(global_node)%local_number(1) !Default to version 1 of each node derivative @@ -12616,7 +12616,7 @@ END SUBROUTINE FiniteElasticity_PreSolveUpdateBoundaryConditions ! !>Evaluates the functions f(J) and f\'(J); - !> Eq.(21) in Chapelle, Gerbeau, Sainte-Marie, Vignon-Clementel, Computational Mechanics (2010) + !> Eq.(21) in Chapelle, Gerbeau, Sainte-Marie, Vignon-Clementel, Computation Mechanics (2010) SUBROUTINE EVALUATE_CHAPELLE_FUNCTION(Jznu,ffact,dfdJfact,err,error,*) !Argument variables diff --git a/src/generated_mesh_routines.f90 b/src/generated_mesh_routines.f90 index bd5f3655..5b7af100 100755 --- a/src/generated_mesh_routines.f90 +++ b/src/generated_mesh_routines.f90 @@ -46,7 +46,7 @@ MODULE GENERATED_MESH_ROUTINES USE BaseRoutines USE BASIS_ROUTINES - USE ComputationEnvironment + USE ComputationRoutines USE CONSTANTS USE COORDINATE_ROUTINES USE FIELD_ROUTINES @@ -3305,7 +3305,7 @@ SUBROUTINE GeneratedMesh_RegularGeometricParametersCalculate(REGULAR_MESH,FIELD, END IF ENDIF END SELECT - !Update geometric parameters in this computational domain only + !Update geometric parameters in this computation domain only DOMAIN=>FIELD_VARIABLE_COMPONENT%DOMAIN DOMAIN_NODES=>DOMAIN%TOPOLOGY%NODES DO component_node=1,TOTAL_NUMBER_OF_NODES_XI(1)*TOTAL_NUMBER_OF_NODES_XI(2)*TOTAL_NUMBER_OF_NODES_XI(3) @@ -3570,7 +3570,7 @@ SUBROUTINE GeneratedMesh_EllipsoidGeometricParametersCalculate(ELLIPSOID_MESH,FI TYPE(DOMAIN_NODES_TYPE), POINTER :: DOMAIN_NODES TYPE(FIELD_VARIABLE_TYPE), POINTER :: FIELD_VARIABLE TYPE(FIELD_VARIABLE_COMPONENT_TYPE), POINTER :: FIELD_VARIABLE_COMPONENT - INTEGER(INTG) :: MY_COMPUTATIONAL_NODE,DOMAIN_NUMBER,MESH_COMPONENT,basis_idx + INTEGER(INTG) :: MY_COMPUTATION_NODE,DOMAIN_NUMBER,MESH_COMPONENT,basis_idx INTEGER(INTG) :: NUMBER_ELEMENTS_XI(3),NUMBER_OF_NODES_XIC(3) INTEGER(INTG) :: TOTAL_NUMBER_NODES_XI(3),INTERPOLATION_TYPES(3) INTEGER(INTG) :: component_idx,xi_idx @@ -3586,7 +3586,7 @@ SUBROUTINE GeneratedMesh_EllipsoidGeometricParametersCalculate(ELLIPSOID_MESH,FI ENTERS("GeneratedMesh_EllipsoidGeometricParametersCalculate",ERR,ERROR,*999) - MY_COMPUTATIONAL_NODE=ComputationalEnvironment_NodeNumberGet(ERR,ERROR) + MY_COMPUTATION_NODE=ComputationEnvironment_NodeNumberGet(ERR,ERROR) ! assign to the field np=0 @@ -3649,7 +3649,7 @@ SUBROUTINE GeneratedMesh_EllipsoidGeometricParametersCalculate(ELLIPSOID_MESH,FI np=1 npg=COMPONENT_NODE_TO_USER_NUMBER(ELLIPSOID_MESH%GENERATED_MESH,basis_idx,np,ERR,ERROR) CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,npg,MESH_COMPONENT,DOMAIN_NUMBER,ERR,ERROR,*999) - IF(DOMAIN_NUMBER==MY_COMPUTATIONAL_NODE) THEN + IF(DOMAIN_NUMBER==MY_COMPUTATION_NODE) THEN RECT_COORDS(1)=0 RECT_COORDS(2)=0 RECT_COORDS(3)=-ELLIPSOID_EXTENT(1) @@ -3676,7 +3676,7 @@ SUBROUTINE GeneratedMesh_EllipsoidGeometricParametersCalculate(ELLIPSOID_MESH,FI np=np+1 npg=COMPONENT_NODE_TO_USER_NUMBER(ELLIPSOID_MESH%GENERATED_MESH,basis_idx,np,ERR,ERROR) CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,npg,MESH_COMPONENT,DOMAIN_NUMBER,ERR,ERROR,*999) - IF(DOMAIN_NUMBER==MY_COMPUTATIONAL_NODE) THEN + IF(DOMAIN_NUMBER==MY_COMPUTATION_NODE) THEN DO component_idx=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS CALL FIELD_PARAMETER_SET_UPDATE_NODE(FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,1,1,npg, & & component_idx,RECT_COORDS(component_idx),ERR,ERROR,*999) @@ -3699,7 +3699,7 @@ SUBROUTINE GeneratedMesh_EllipsoidGeometricParametersCalculate(ELLIPSOID_MESH,FI np=np+1 npg=COMPONENT_NODE_TO_USER_NUMBER(ELLIPSOID_MESH%GENERATED_MESH,basis_idx,np,ERR,ERROR) CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,npg,MESH_COMPONENT,DOMAIN_NUMBER,ERR,ERROR,*999) - IF(DOMAIN_NUMBER==MY_COMPUTATIONAL_NODE) THEN + IF(DOMAIN_NUMBER==MY_COMPUTATION_NODE) THEN DO component_idx=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS CALL FIELD_PARAMETER_SET_UPDATE_NODE(FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,1,1,npg, & & component_idx,RECT_COORDS(component_idx),ERR,ERROR,*999) @@ -3730,7 +3730,7 @@ SUBROUTINE GeneratedMesh_EllipsoidGeometricParametersCalculate(ELLIPSOID_MESH,FI np=np+1 npg=COMPONENT_NODE_TO_USER_NUMBER(ELLIPSOID_MESH%GENERATED_MESH,basis_idx,np,ERR,ERROR) CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,npg,MESH_COMPONENT,DOMAIN_NUMBER,ERR,ERROR,*999) - IF(DOMAIN_NUMBER==MY_COMPUTATIONAL_NODE) THEN + IF(DOMAIN_NUMBER==MY_COMPUTATION_NODE) THEN DO component_idx=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS CALL FIELD_PARAMETER_SET_UPDATE_NODE(FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,1,1,npg, & & component_idx,RECT_COORDS(component_idx),ERR,ERROR,*999) @@ -3757,7 +3757,7 @@ SUBROUTINE GeneratedMesh_EllipsoidGeometricParametersCalculate(ELLIPSOID_MESH,FI np=np+1 npg=COMPONENT_NODE_TO_USER_NUMBER(ELLIPSOID_MESH%GENERATED_MESH,basis_idx,np,ERR,ERROR) CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,npg,MESH_COMPONENT,DOMAIN_NUMBER,ERR,ERROR,*999) - IF(DOMAIN_NUMBER==MY_COMPUTATIONAL_NODE) THEN + IF(DOMAIN_NUMBER==MY_COMPUTATION_NODE) THEN DO component_idx=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS CALL FIELD_PARAMETER_SET_UPDATE_NODE(FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,1,1,npg, & & component_idx,RECT_COORDS(component_idx),ERR,ERROR,*999) @@ -3780,7 +3780,7 @@ SUBROUTINE GeneratedMesh_EllipsoidGeometricParametersCalculate(ELLIPSOID_MESH,FI np=np+1 npg=COMPONENT_NODE_TO_USER_NUMBER(ELLIPSOID_MESH%GENERATED_MESH,basis_idx,np,ERR,ERROR) CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,npg,MESH_COMPONENT,DOMAIN_NUMBER,ERR,ERROR,*999) - IF(DOMAIN_NUMBER==MY_COMPUTATIONAL_NODE) THEN + IF(DOMAIN_NUMBER==MY_COMPUTATION_NODE) THEN DO component_idx=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS CALL FIELD_PARAMETER_SET_UPDATE_NODE(FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,1,1,npg, & & component_idx,RECT_COORDS(component_idx),ERR,ERROR,*999) @@ -3807,7 +3807,7 @@ SUBROUTINE GeneratedMesh_EllipsoidGeometricParametersCalculate(ELLIPSOID_MESH,FI np=1 npg=COMPONENT_NODE_TO_USER_NUMBER(ELLIPSOID_MESH%GENERATED_MESH,basis_idx,np,ERR,ERROR) CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,npg,MESH_COMPONENT,DOMAIN_NUMBER,ERR,ERROR,*999) - IF(DOMAIN_NUMBER==MY_COMPUTATIONAL_NODE) THEN + IF(DOMAIN_NUMBER==MY_COMPUTATION_NODE) THEN RECT_COORDS(1)=0 RECT_COORDS(2)=0 RECT_COORDS(3)=-ELLIPSOID_EXTENT(1) @@ -3833,7 +3833,7 @@ SUBROUTINE GeneratedMesh_EllipsoidGeometricParametersCalculate(ELLIPSOID_MESH,FI np=np+1 npg=COMPONENT_NODE_TO_USER_NUMBER(ELLIPSOID_MESH%GENERATED_MESH,basis_idx,np,ERR,ERROR) CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,npg,MESH_COMPONENT,DOMAIN_NUMBER,ERR,ERROR,*999) - IF(DOMAIN_NUMBER==MY_COMPUTATIONAL_NODE) THEN + IF(DOMAIN_NUMBER==MY_COMPUTATION_NODE) THEN DO component_idx=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS CALL FIELD_PARAMETER_SET_UPDATE_NODE(FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,1,1,npg, & & component_idx,RECT_COORDS(component_idx),ERR,ERROR,*999) @@ -3856,7 +3856,7 @@ SUBROUTINE GeneratedMesh_EllipsoidGeometricParametersCalculate(ELLIPSOID_MESH,FI np=np+1 npg=COMPONENT_NODE_TO_USER_NUMBER(ELLIPSOID_MESH%GENERATED_MESH,basis_idx,np,ERR,ERROR) CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,npg,MESH_COMPONENT,DOMAIN_NUMBER,ERR,ERROR,*999) - IF(DOMAIN_NUMBER==MY_COMPUTATIONAL_NODE) THEN + IF(DOMAIN_NUMBER==MY_COMPUTATION_NODE) THEN DO component_idx=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS CALL FIELD_PARAMETER_SET_UPDATE_NODE(FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,1,1,npg, & & component_idx,RECT_COORDS(component_idx),ERR,ERROR,*999) @@ -3887,7 +3887,7 @@ SUBROUTINE GeneratedMesh_EllipsoidGeometricParametersCalculate(ELLIPSOID_MESH,FI np=np+1 npg=COMPONENT_NODE_TO_USER_NUMBER(ELLIPSOID_MESH%GENERATED_MESH,basis_idx,np,ERR,ERROR) CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,npg,MESH_COMPONENT,DOMAIN_NUMBER,ERR,ERROR,*999) - IF(DOMAIN_NUMBER==MY_COMPUTATIONAL_NODE) THEN + IF(DOMAIN_NUMBER==MY_COMPUTATION_NODE) THEN DO component_idx=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS CALL FIELD_PARAMETER_SET_UPDATE_NODE(FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,1,1,npg, & & component_idx,RECT_COORDS(component_idx),ERR,ERROR,*999) diff --git a/src/mesh_routines.f90 b/src/mesh_routines.f90 index 1547e1ad..4c950cc5 100644 --- a/src/mesh_routines.f90 +++ b/src/mesh_routines.f90 @@ -26,7 +26,7 @@ !> Auckland, the University of Oxford and King's College, London. !> All Rights Reserved. !> -!> Contributor(s): +!> Contributor(s): Chris Bradley !> !> Alternatively, the contents of this file may be used under the terms of !> either the GNU General Public License Version 2 or later (the "GPL"), or @@ -48,7 +48,7 @@ MODULE MESH_ROUTINES USE BASIS_ROUTINES USE CmissMPI USE CMISS_PARMETIS - USE ComputationEnvironment + USE ComputationRoutines USE COORDINATE_ROUTINES USE DataProjectionAccessRoutines USE DOMAIN_MAPPINGS @@ -299,7 +299,7 @@ SUBROUTINE DECOMPOSITION_CREATE_FINISH(DECOMPOSITION,ERR,ERROR,*) CALL DECOMPOSITION_ELEMENT_DOMAIN_CALCULATE(DECOMPOSITION,ERR,ERROR,*999) !Initialise the topology information for this decomposition CALL DECOMPOSITION_TOPOLOGY_INITIALISE(DECOMPOSITION,ERR,ERROR,*999) - !Initialise the domain for this computational node + !Initialise the domain for this computation node CALL DOMAIN_INITIALISE(DECOMPOSITION,ERR,ERROR,*999) !Calculate the decomposition topology CALL DECOMPOSITION_TOPOLOGY_CALCULATE(DECOMPOSITION,ERR,ERROR,*999) @@ -595,8 +595,8 @@ SUBROUTINE DECOMPOSITION_ELEMENT_DOMAIN_CALCULATE(DECOMPOSITION,ERR,ERROR,*) INTEGER(INTG), INTENT(OUT) :: ERR !(MESH%NUMBER_OF_ELEMENTS-ELEMENT_STOP)) & - & ELEMENT_STOP=MESH%NUMBER_OF_ELEMENTS-(number_computational_nodes-1-no_computational_node) + IF((number_computation_nodes-1-no_computation_node)>(MESH%NUMBER_OF_ELEMENTS-ELEMENT_STOP)) & + & ELEMENT_STOP=MESH%NUMBER_OF_ELEMENTS-(number_computation_nodes-1-no_computation_node) IF(ELEMENT_START>MESH%NUMBER_OF_ELEMENTS) ELEMENT_START=MESH%NUMBER_OF_ELEMENTS IF(ELEMENT_STOP>MESH%NUMBER_OF_ELEMENTS) ELEMENT_STOP=MESH%NUMBER_OF_ELEMENTS - DISPLACEMENTS(no_computational_node)=ELEMENT_START-1 - ELEMENT_DISTANCE(no_computational_node+1)=ELEMENT_STOP !C numbering + DISPLACEMENTS(no_computation_node)=ELEMENT_START-1 + ELEMENT_DISTANCE(no_computation_node+1)=ELEMENT_STOP !C numbering NUMBER_OF_ELEMENTS=ELEMENT_STOP-ELEMENT_START+1 - RECEIVE_COUNTS(no_computational_node)=NUMBER_OF_ELEMENTS + RECEIVE_COUNTS(no_computation_node)=NUMBER_OF_ELEMENTS IF(NUMBER_OF_ELEMENTS>MAX_NUMBER_ELEMENTS_PER_NODE) MAX_NUMBER_ELEMENTS_PER_NODE=NUMBER_OF_ELEMENTS - IF(no_computational_node==my_computational_node_number) THEN + IF(no_computation_node==my_computation_node_number) THEN MY_ELEMENT_START=ELEMENT_START MY_ELEMENT_STOP=ELEMENT_STOP MY_NUMBER_OF_ELEMENTS=ELEMENT_STOP-ELEMENT_START+1 @@ -675,7 +675,7 @@ SUBROUTINE DECOMPOSITION_ELEMENT_DOMAIN_CALCULATE(DECOMPOSITION,ERR,ERROR,*) number_elem_indicies=number_elem_indicies+BASIS%NUMBER_OF_NODES ENDDO !ne ENDIF - ENDDO !no_computational_node + ENDDO !no_computation_node ALLOCATE(ELEMENT_PTR(0:MY_NUMBER_OF_ELEMENTS),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate element pointer list.",ERR,ERROR,*999) @@ -721,14 +721,14 @@ SUBROUTINE DECOMPOSITION_ELEMENT_DOMAIN_CALCULATE(DECOMPOSITION,ERR,ERROR,*) !Call ParMETIS to calculate the partitioning of the mesh graph. CALL PARMETIS_PARTMESHKWAY(ELEMENT_DISTANCE,ELEMENT_PTR,ELEMENT_INDICIES,ELEMENT_WEIGHT,WEIGHT_FLAG,NUMBER_FLAG, & & NUMBER_OF_CONSTRAINTS,NUMBER_OF_COMMON_NODES,DECOMPOSITION%NUMBER_OF_DOMAINS,TPWGTS,UBVEC,PARMETIS_OPTIONS, & - & DECOMPOSITION%NUMBER_OF_EDGES_CUT,DECOMPOSITION%ELEMENT_DOMAIN(DISPLACEMENTS(my_computational_node_number)+1:), & - & computationalEnvironment%mpiCommunicator,ERR,ERROR,*999) + & DECOMPOSITION%NUMBER_OF_EDGES_CUT,DECOMPOSITION%ELEMENT_DOMAIN(DISPLACEMENTS(my_computation_node_number)+1:), & + & computationEnvironment%mpiCommunicator,ERR,ERROR,*999) - !Transfer all the element domain information to the other computational nodes so that each rank has all the info - IF(number_computational_nodes>1) THEN + !Transfer all the element domain information to the other computation nodes so that each rank has all the info + IF(number_computation_nodes>1) THEN !This should work on a single processor but doesn't for mpich2 under windows. Maybe a bug? Avoid for now. CALL MPI_ALLGATHERV(MPI_IN_PLACE,MAX_NUMBER_ELEMENTS_PER_NODE,MPI_INTEGER,DECOMPOSITION%ELEMENT_DOMAIN, & - & RECEIVE_COUNTS,DISPLACEMENTS,MPI_INTEGER,computationalEnvironment%mpiCommunicator,MPI_IERROR) + & RECEIVE_COUNTS,DISPLACEMENTS,MPI_INTEGER,computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHERV",MPI_IERROR,ERR,ERROR,*999) ENDIF @@ -748,28 +748,28 @@ SUBROUTINE DECOMPOSITION_ELEMENT_DOMAIN_CALCULATE(DECOMPOSITION,ERR,ERROR,*) END SELECT !Check decomposition and check that each domain has an element in it. - ALLOCATE(ELEMENT_COUNT(0:number_computational_nodes-1),STAT=ERR) + ALLOCATE(ELEMENT_COUNT(0:number_computation_nodes-1),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate element count.",ERR,ERROR,*999) ELEMENT_COUNT=0 DO elem_index=1,MESH%NUMBER_OF_ELEMENTS - no_computational_node=DECOMPOSITION%ELEMENT_DOMAIN(elem_index) - IF(no_computational_node>=0.AND.no_computational_node=0.AND.no_computation_nodeMESH%TOPOLOGY(DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR IF(ASSOCIATED(MESH_TOPOLOGY)) THEN IF(GLOBAL_ELEMENT_NUMBER>0.AND.GLOBAL_ELEMENT_NUMBER<=MESH_TOPOLOGY%ELEMENTS%NUMBER_OF_ELEMENTS) THEN - number_computational_nodes=ComputationalEnvironment_NumberOfNodesGet(ERR,ERROR) + number_computation_nodes=ComputationEnvironment_NumberOfNodesGet(ERR,ERROR) IF(ERR/=0) GOTO 999 - IF(DOMAIN_NUMBER>=0.AND.DOMAIN_NUMBER=0.AND.DOMAIN_NUMBER=1) THEN !wolfye???<=? IF(NUMBER_OF_DOMAINS<=DECOMPOSITION%numberOfElements) THEN - !Get the number of computational nodes - numberOfComputationalNodes=ComputationalEnvironment_NumberOfNodesGet(ERR,ERROR) + !Get the number of computation nodes + numberOfComputationNodes=ComputationEnvironment_NumberOfNodesGet(ERR,ERROR) IF(ERR/=0) GOTO 999 !!TODO: relax this later - !IF(NUMBER_OF_DOMAINS==numberOfComputationalNodes) THEN + !IF(NUMBER_OF_DOMAINS==numberOfComputationNodes) THEN DECOMPOSITION%NUMBER_OF_DOMAINS=NUMBER_OF_DOMAINS !ELSE ! LOCAL_ERROR="The number of domains ("//TRIM(NUMBER_TO_VSTRING(NUMBER_OF_DOMAINSS,"*",ERR,ERROR))// & - ! & ") is not equal to the number of computational nodes ("// & - ! & TRIM(NUMBER_TO_VSTRING(numberOfComputationalNodes,"*",ERR,ERROR))//")" + ! & ") is not equal to the number of computation nodes ("// & + ! & TRIM(NUMBER_TO_VSTRING(numberOfComputationNodes,"*",ERR,ERROR))//")" ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) !ENDIF ELSE @@ -1275,7 +1275,7 @@ SUBROUTINE DecompositionTopology_DataPointsCalculate(TOPOLOGY,ERR,ERROR,*) TYPE(VARYING_STRING), INTENT(OUT) :: ERROR !decomposition%MESH%TOPOLOGY(meshComponentNumber)%PTR%dataPoints IF(ASSOCIATED(meshData)) THEN - NUMBER_OF_COMPUTATIONAL_NODES=ComputationalEnvironment_NumberOfNodesGet(ERR,ERROR) + NUMBER_OF_COMPUTATION_NODES=ComputationEnvironment_NumberOfNodesGet(ERR,ERROR) IF(ERR/=0) GOTO 999 - myComputationalNodeNumber=ComputationalEnvironment_NodeNumberGet(ERR,ERROR) + myComputationNodeNumber=ComputationEnvironment_NodeNumberGet(ERR,ERROR) IF(ERR/=0) GOTO 999 - ALLOCATE(decompositionData%numberOfDomainLocal(0:NUMBER_OF_COMPUTATIONAL_NODES-1),STAT=ERR) - ALLOCATE(decompositionData%numberOfDomainGhost(0:NUMBER_OF_COMPUTATIONAL_NODES-1),STAT=ERR) + ALLOCATE(decompositionData%numberOfDomainLocal(0:NUMBER_OF_COMPUTATION_NODES-1),STAT=ERR) + ALLOCATE(decompositionData%numberOfDomainGhost(0:NUMBER_OF_COMPUTATION_NODES-1),STAT=ERR) ALLOCATE(decompositionData%numberOfElementDataPoints(decompositionElements%NUMBER_OF_GLOBAL_ELEMENTS),STAT=ERR) ALLOCATE(decompositionData%elementDataPoint(decompositionElements%TOTAL_NUMBER_OF_ELEMENTS),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate decomposition element data points.",ERR,ERROR,*999) @@ -1340,16 +1340,16 @@ SUBROUTINE DecompositionTopology_DataPointsCalculate(TOPOLOGY,ERR,ERROR,*) & INSERT_STATUS,ERR,ERROR,*999) ENDDO !dataPointIdx ENDDO !localElement - !Calculate number of ghost data points on the current computational domain + !Calculate number of ghost data points on the current computation domain NUMBER_OF_LOCAL_DATA=decompositionData%numberOfDataPoints NUMBER_OF_GHOST_DATA=decompositionData%totalNumberOfDataPoints-decompositionData%numberOfDataPoints - !Gather number of local data points on all computational nodes + !Gather number of local data points on all computation nodes CALL MPI_ALLGATHER(NUMBER_OF_LOCAL_DATA,1,MPI_INTEGER,decompositionData% & - & numberOfDomainLocal,1,MPI_INTEGER,computationalEnvironment%mpiCommunicator,MPI_IERROR) + & numberOfDomainLocal,1,MPI_INTEGER,computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPI_IERROR,ERR,ERROR,*999) - !Gather number of ghost data points on all computational nodes + !Gather number of ghost data points on all computation nodes CALL MPI_ALLGATHER(NUMBER_OF_GHOST_DATA,1,MPI_INTEGER,decompositionData% & - & numberOfDomainGhost,1,MPI_INTEGER,computationalEnvironment%mpiCommunicator,MPI_IERROR) + & numberOfDomainGhost,1,MPI_INTEGER,computationEnvironment%mpiCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPI_IERROR,ERR,ERROR,*999) ELSE CALL FlagError("Mesh data points topology is not associated.",ERR,ERROR,*999) @@ -4050,7 +4050,7 @@ SUBROUTINE DOMAIN_MAPPINGS_ELEMENTS_CALCULATE(DOMAIN,ERR,ERROR,*) TYPE(VARYING_STRING), INTENT(OUT) :: ERROR !DOMAIN%MESH component_idx=DOMAIN%MESH_COMPONENT_NUMBER - myComputationalNodeNumber=ComputationalEnvironment_NodeNumberGet(ERR,ERROR) + myComputationNodeNumber=ComputationEnvironment_NodeNumberGet(ERR,ERROR) IF(ERR/=0) GOTO 999 !Calculate the local and global numbers and set up the mappings @@ -4097,7 +4097,7 @@ SUBROUTINE DOMAIN_MAPPINGS_ELEMENTS_CALCULATE(DOMAIN,ERR,ERROR,*) !Calculate the local numbers domain_no=DECOMPOSITION%ELEMENT_DOMAIN(ne) LOCAL_ELEMENT_NUMBERS(domain_no)=LOCAL_ELEMENT_NUMBERS(domain_no)+1 - !Calculate the adjacent elements to the computational domains and the adjacent domain numbers themselves + !Calculate the adjacent elements to the computation domains and the adjacent domain numbers themselves BASIS=>MESH%TOPOLOGY(component_idx)%PTR%ELEMENTS%ELEMENTS(ne)%BASIS NULLIFY(ADJACENT_DOMAINS_LIST) CALL LIST_CREATE_START(ADJACENT_DOMAINS_LIST,ERR,ERROR,*999) @@ -4132,7 +4132,7 @@ SUBROUTINE DOMAIN_MAPPINGS_ELEMENTS_CALCULATE(DOMAIN,ERR,ERROR,*) !Element is an internal element ELEMENTS_MAPPING%GLOBAL_TO_LOCAL_MAP(ne)%LOCAL_TYPE(1)=DOMAIN_LOCAL_INTERNAL ELSE - !Element is on the boundary of computational domains + !Element is on the boundary of computation domains ELEMENTS_MAPPING%GLOBAL_TO_LOCAL_MAP(ne)%LOCAL_TYPE(1)=DOMAIN_LOCAL_BOUNDARY ENDIF ENDDO !ne @@ -4407,9 +4407,9 @@ SUBROUTINE DOMAIN_MAPPINGS_NODES_DOFS_CALCULATE(DOMAIN,ERR,ERROR,*) INTEGER(INTG), INTENT(OUT) :: ERR !MESH%TOPOLOGY(component_idx)%PTR - numberOfComputationalNodes=ComputationalEnvironment_NumberOfNodesGet(ERR,ERROR) + numberOfComputationNodes=ComputationEnvironment_NumberOfNodesGet(ERR,ERROR) IF(ERR/=0) GOTO 999 - myComputationalNodeNumber=ComputationalEnvironment_NodeNumberGet(ERR,ERROR) + myComputationNodeNumber=ComputationEnvironment_NodeNumberGet(ERR,ERROR) IF(ERR/=0) GOTO 999 !Calculate the local and global numbers and set up the mappings @@ -4551,7 +4551,7 @@ SUBROUTINE DOMAIN_MAPPINGS_NODES_DOFS_CALCULATE(DOMAIN,ERR,ERROR,*) ENDDO !version_idx ENDDO !derivative_idx ELSE - !Node is on the boundary of computational domains + !Node is on the boundary of computation domains NODES_MAPPING%GLOBAL_TO_LOCAL_MAP(node_idx)%NUMBER_OF_DOMAINS=NUMBER_OF_DOMAINS DO derivative_idx=1,MESH_TOPOLOGY%NODES%NODES(node_idx)%numberOfDerivatives DO version_idx=1,MESH_TOPOLOGY%NODES%NODES(node_idx)%DERIVATIVES(derivative_idx)%numberOfVersions @@ -4677,29 +4677,29 @@ SUBROUTINE DOMAIN_MAPPINGS_NODES_DOFS_CALCULATE(DOMAIN,ERR,ERROR,*) ENDDO !domain_idx !Check decomposition and check that each domain has a node in it. - ALLOCATE(NODE_COUNT(0:numberOfComputationalNodes-1),STAT=ERR) + ALLOCATE(NODE_COUNT(0:numberOfComputationNodes-1),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate node count.",ERR,ERROR,*999) NODE_COUNT=0 DO node_idx=1,MESH_TOPOLOGY%NODES%numberOfNodes - no_computational_node=DOMAIN%NODE_DOMAIN(node_idx) - IF(no_computational_node>=0.AND.no_computational_node=0.AND.no_computation_node Auckland, the University of Oxford and King's College, London. !> All Rights Reserved. !> -!> Contributor(s): +!> Contributor(s): Chris Bradley !> !> Alternatively, the contents of this file may be used under the terms of !> either the GNU General Public License Version 2 or later (the "GPL"), or @@ -64,7 +64,7 @@ MODULE OpenCMISS_Iron USE Cmiss USE CmissPetsc USE CMISS_CELLML - USE ComputationEnvironment + USE ComputationRoutines USE Constants USE CONTROL_LOOP_ROUTINES USE ControlLoopAccessRoutines @@ -248,14 +248,14 @@ MODULE OpenCMISS_Iron TYPE(InterfacePointsConnectivityType), POINTER :: pointsConnectivity END TYPE cmfe_InterfacePointsConnectivityType - !>A matrix that may be distributed across multiple computational nodes + !>A matrix that may be distributed across multiple computation nodes !>and may use sparse or full storage. TYPE cmfe_DistributedMatrixType PRIVATE TYPE(DISTRIBUTED_MATRIX_TYPE), POINTER :: distributedMatrix END TYPE cmfe_DistributedMatrixType - !>A vector that may be distributed across multiple computational nodes + !>A vector that may be distributed across multiple computation nodes TYPE cmfe_DistributedVectorType PRIVATE TYPE(DISTRIBUTED_VECTOR_TYPE), POINTER :: distributedVector @@ -321,11 +321,11 @@ MODULE OpenCMISS_Iron TYPE(SOLVER_EQUATIONS_TYPE), POINTER :: solverEquations END TYPE cmfe_SolverEquationsType - !>Contains information on a computational work group - TYPE cmfe_ComputationalWorkGroupType + !>Contains information on a computation work group + TYPE cmfe_ComputationWorkGroupType PRIVATE - TYPE(ComputationalWorkGroupType), POINTER :: computationalWorkGroup - END TYPE cmfe_ComputationalWorkGroupType + TYPE(ComputationWorkGroupType), POINTER :: computationWorkGroup + END TYPE cmfe_ComputationWorkGroupType !Module variables @@ -360,7 +360,7 @@ MODULE OpenCMISS_Iron PUBLIC cmfe_CellMLEquationsType,cmfe_CellMLEquations_Finalise,cmfe_CellMLEquations_Initialise - PUBLIC cmfe_ComputationalWorkGroupType,cmfe_ComputationalWorkGroup_Initialise + PUBLIC cmfe_ComputationWorkGroupType,cmfe_ComputationWorkGroup_Initialise PUBLIC cmfe_ControlLoopType,cmfe_ControlLoop_Finalise,cmfe_ControlLoop_Initialise,cmfe_ControlLoop_LoadOutputSet @@ -1258,7 +1258,7 @@ MODULE OpenCMISS_Iron !!================================================================================================================================== !! -!! ComputationalEnvironment +!! ComputationEnvironment !! !!================================================================================================================================== @@ -1270,17 +1270,17 @@ MODULE OpenCMISS_Iron !Interfaces - PUBLIC cmfe_ComputationalWorldCommunicatorGet,cmfe_ComputationalWorldCommunicatorSet + PUBLIC cmfe_ComputationWorldCommunicatorGet,cmfe_ComputationWorldCommunicatorSet - PUBLIC cmfe_ComputationalNodeNumberGet + PUBLIC cmfe_ComputationNodeNumberGet - PUBLIC cmfe_ComputationalNumberOfNodesGet + PUBLIC cmfe_ComputationNumberOfNodesGet - PUBLIC cmfe_ComputationalWorkGroup_CreateStart + PUBLIC cmfe_Computation_WorkGroupCreateStart - PUBLIC cmfe_ComputationalWorkGroup_CreateFinish + PUBLIC cmfe_Computation_WorkGroupCreateFinish - PUBLIC cmfe_ComputationalWorkGroup_SubgroupAdd + PUBLIC cmfe_Computation_WorkGroupSubgroupAdd PUBLIC cmfe_Decomposition_WorldWorkGroupSet @@ -1835,7 +1835,7 @@ MODULE OpenCMISS_Iron INTEGER(INTG), PARAMETER :: CMFE_DATA_PROJECTION_EXIT_TAG_CONVERGED = DATA_PROJECTION_EXIT_TAG_CONVERGED !@} !> \addtogroup OPENCMISS_DataProjectionDistanceRelations OpenCMISS::Iron::DataProjection::DataProjectionDistanceRelations !> \brief Datapoint projection distance relations to select data points based on distance. @@ -5599,7 +5599,7 @@ MODULE OpenCMISS_Iron MODULE PROCEDURE cmfe_DistributedMatrix_DataTypeGetObj END INTERFACE cmfe_DistributedMatrix_DataTypeGet - !>Get the dimensions for a distributed matrix on this computational node + !>Get the dimensions for a distributed matrix on this computation node INTERFACE cmfe_DistributedMatrix_DimensionsGet MODULE PROCEDURE cmfe_DistributedMatrix_DimensionsGetObj END INTERFACE cmfe_DistributedMatrix_DimensionsGet @@ -5609,7 +5609,7 @@ MODULE OpenCMISS_Iron MODULE PROCEDURE cmfe_DistributedMatrix_StorageLocationsGetObj END INTERFACE cmfe_DistributedMatrix_StorageLocationsGet - !>Get the data array for this matrix on this computational node + !>Get the data array for this matrix on this computation node INTERFACE cmfe_DistributedMatrix_DataGet MODULE PROCEDURE cmfe_DistributedMatrix_DataGetIntgObj MODULE PROCEDURE cmfe_DistributedMatrix_DataGetDPObj @@ -5630,7 +5630,7 @@ MODULE OpenCMISS_Iron MODULE PROCEDURE cmfe_DistributedVector_DataTypeGetObj END INTERFACE cmfe_DistributedVector_DataTypeGet - !>Get the data array for this vector on this computational node + !>Get the data array for this vector on this computation node INTERFACE cmfe_DistributedVector_DataGet MODULE PROCEDURE cmfe_DistributedVector_DataGetIntgObj MODULE PROCEDURE cmfe_DistributedVector_DataGetDPObj @@ -8081,26 +8081,26 @@ END SUBROUTINE cmfe_CellMLEquations_Initialise !================================================================================================================================ ! - !>Initialises a cmfe_ComputationalWorkGroupType object. - SUBROUTINE cmfe_ComputationalWorkGroup_Initialise(cmfe_ComputationalWorkGroup,err) - !DLLEXPORT(cmfe_ComputationalWorkGroup_Initialise) + !>Initialises a cmfe_ComputationWorkGroupType object. + SUBROUTINE cmfe_ComputationWorkGroup_Initialise(cmfe_ComputationWorkGroup,err) + !DLLEXPORT(cmfe_ComputationWorkGroup_Initialise) !Argument variables - TYPE(cmfe_ComputationalWorkGroupType), INTENT(OUT) :: cmfe_ComputationalWorkGroup !Returns the current world communicator. - SUBROUTINE cmfe_ComputationalWorldCommunicatorGet(worldCommunicator,err) - !DLLEXPORT(cmfe_ComputationalWorldCommunicatorGet) + SUBROUTINE cmfe_ComputationWorldCommunicatorGet(worldCommunicator,err) + !DLLEXPORT(cmfe_ComputationWorldCommunicatorGet) !Argument variables INTEGER(INTG), INTENT(OUT) :: worldCommunicator !Sets/changes the current world communicator. - SUBROUTINE cmfe_ComputationalWorldCommunicatorSet(worldCommunicator,err) - !DLLEXPORT(cmfe_ComputationalWorldCommunicatorSet) + SUBROUTINE cmfe_ComputationWorldCommunicatorSet(worldCommunicator,err) + !DLLEXPORT(cmfe_ComputationWorldCommunicatorSet) !Argument variables INTEGER(INTG), INTENT(IN) :: worldCommunicator !Returns the computational node number of the running process. - SUBROUTINE cmfe_ComputationalNodeNumberGet(nodeNumber,err) - !DLLEXPORT(cmfe_ComputationalNodeNumberGet) + !>Returns the computation node number of the running process. + SUBROUTINE cmfe_ComputationNodeNumberGet(nodeNumber,err) + !DLLEXPORT(cmfe_ComputationNodeNumberGet) !Argument variables - INTEGER(INTG), INTENT(OUT) :: nodeNumber !Returns the number of computational nodes for the running process. - SUBROUTINE cmfe_ComputationalNumberOfNodesGet(numberOfNodes,err) - !DLLEXPORT(cmfe_ComputationalNumberOfNodesGet) + !>Returns the number of computation nodes for the running process. + SUBROUTINE cmfe_ComputationNumberOfNodesGet(numberOfNodes,err) + !DLLEXPORT(cmfe_ComputationNumberOfNodesGet) !Argument variables - INTEGER(INTG), INTENT(OUT) :: numberOfNodes !CREATE THE HIGHEST LEVEL WORK GROUP (DEFAULT: GROUP_WORLD) - SUBROUTINE cmfe_ComputationalWorkGroup_CreateStart(worldWorkGroup, numberComputationalNodes, err) - !DLLEXPORT(cmfe_ComputationalWorkGroup_CreateStart) + !>Start the creation of a computation work group + SUBROUTINE cmfe_Computation_WorkGroupCreateStart(worldWorkGroup,numberComputationNodes,err) + !DLLEXPORT(cmfe_Computation_WorkGroupCreateStart) !Argument Variables - TYPE(cmfe_ComputationalWorkGroupType), INTENT(INOUT) :: worldWorkGroup - INTEGER(INTG),INTENT(IN) :: numberComputationalNodes + TYPE(cmfe_ComputationWorkGroupType), INTENT(INOUT) :: worldWorkGroup + INTEGER(INTG),INTENT(IN) :: numberComputationNodes INTEGER(INTG), INTENT(OUT) :: err !GENERATE THE HIERARCHY COMPUTATIONAL ENVIRONMENT BASED ON WORK GROUP TREE - SUBROUTINE cmfe_ComputationalWorkGroup_CreateFinish(worldWorkGroup, err) - !DLLEXPORT(cmfe_ComputationalWorkGroup_CreateFinish) + !>Finish the creation of a computation work group + SUBROUTINE cmfe_Computation_WorkGroupCreateFinish(worldWorkGroup, err) + !DLLEXPORT(cmfe_Computation_WorkGroupCreateFinish) !Argument Variables - TYPE(cmfe_ComputationalWorkGroupType), INTENT(INOUT) :: worldWorkGroup + TYPE(cmfe_ComputationWorkGroupType), INTENT(INOUT) :: worldWorkGroup INTEGER(INTG), INTENT(OUT) :: err !ADD WORK SUB-GROUP TO THE PARENT GROUP BASED ON THE COMPUTATIONAL REQUIREMENTS (CALLED BY THE USER) - SUBROUTINE cmfe_ComputationalWorkGroup_SubgroupAdd(parentWorkGroup, numberComputationalNodes,addedWorkGroup, err) - !DLLEXPORT(cmfe_ComputationalWorkGroup_SubgroupAdd) + !>Add a work sub-group to the parent work group based on the computational requirements + SUBROUTINE cmfe_Computation_WorkGroupSubGroupAdd(parentWorkGroup,numberComputationNodes,addedWorkGroup,err) + !DLLEXPORT(cmfe_Computation_WorkGroupSubGroupAdd) !Argument Variables - TYPE(cmfe_ComputationalWorkGroupType), INTENT(INOUT) :: parentWorkGroup - TYPE(cmfe_ComputationalWorkGroupType), INTENT(INOUT) :: addedWorkGroup - INTEGER(INTG),INTENT(IN) :: numberComputationalNodes + TYPE(cmfe_ComputationWorkGroupType), INTENT(INOUT) :: parentWorkGroup + TYPE(cmfe_ComputationWorkGroupType), INTENT(INOUT) :: addedWorkGroup + INTEGER(INTG),INTENT(IN) :: numberComputationNodes INTEGER(INTG), INTENT(OUT) :: err !Get the dimensions of a distributed matrix on this computational node + !>Get the dimensions of a distributed matrix on this computation node SUBROUTINE cmfe_DistributedMatrix_DimensionsGetObj(matrix,m,n,err) !DLLEXPORT(cmfe_DistributedMatrix_DimensionsGetObj) !Argument variables TYPE(cmfe_DistributedMatrixType), INTENT(IN) :: matrix !Get the data array for this matrix on this computational node + !>Get the data array for this matrix on this computation node SUBROUTINE cmfe_DistributedMatrix_DataGetIntgObj(matrix,data,err) !DLLEXPORT(cmfe_DistributedMatrix_DataGetIntgObj) @@ -45482,7 +45483,7 @@ END SUBROUTINE cmfe_DistributedMatrix_DataRestoreIntgObj !================================================================================================================================ ! - !>Get the data array for this matrix on this computational node + !>Get the data array for this matrix on this computation node SUBROUTINE cmfe_DistributedMatrix_DataGetDPObj(matrix,data,err) !DLLEXPORT(cmfe_DistributedMatrix_DataGetDPObj) @@ -45534,7 +45535,7 @@ END SUBROUTINE cmfe_DistributedMatrix_DataRestoreDPObj !================================================================================================================================ ! - !>Get the data array for this matrix on this computational node + !>Get the data array for this matrix on this computation node SUBROUTINE cmfe_DistributedMatrix_DataGetSPObj(matrix,data,err) !DLLEXPORT(cmfe_DistributedMatrix_DataGetSPObj) @@ -45586,7 +45587,7 @@ END SUBROUTINE cmfe_DistributedMatrix_DataRestoreSPObj !================================================================================================================================ ! - !>Get the data array for this matrix on this computational node + !>Get the data array for this matrix on this computation node SUBROUTINE cmfe_DistributedMatrix_DataGetLObj(matrix,data,err) !DLLEXPORT(cmfe_DistributedMatrix_DataGetLObj) @@ -45664,7 +45665,7 @@ END SUBROUTINE cmfe_DistributedVector_DataTypeGetObj !================================================================================================================================ ! - !>Get the data array for this vector on this computational node + !>Get the data array for this vector on this computation node SUBROUTINE cmfe_DistributedVector_DataGetIntgObj(vector,data,err) !DLLEXPORT(cmfe_DistributedVector_DataGetIntgObj) @@ -45716,7 +45717,7 @@ END SUBROUTINE cmfe_DistributedVector_DataRestoreIntgObj !================================================================================================================================ ! - !>Get the data array for this vector on this computational node + !>Get the data array for this vector on this computation node SUBROUTINE cmfe_DistributedVector_DataGetDPObj(vector,data,err) !DLLEXPORT(cmfe_DistributedVector_DataGetDPObj) @@ -45768,7 +45769,7 @@ END SUBROUTINE cmfe_DistributedVector_DataRestoreDPObj !================================================================================================================================ ! - !>Get the data array for this vector on this computational node + !>Get the data array for this vector on this computation node SUBROUTINE cmfe_DistributedVector_DataGetSPObj(vector,data,err) !DLLEXPORT(cmfe_DistributedVector_DataGetSPObj) @@ -45820,7 +45821,7 @@ END SUBROUTINE cmfe_DistributedVector_DataRestoreSPObj !================================================================================================================================ ! - !>Get the data array for this vector on this computational node + !>Get the data array for this vector on this computation node SUBROUTINE cmfe_DistributedVector_DataGetLObj(vector,data,err) !DLLEXPORT(cmfe_DistributedVector_DataGetLObj) diff --git a/src/reaction_diffusion_IO_routines.f90 b/src/reaction_diffusion_IO_routines.f90 index 148f4cd7..ab719a46 100755 --- a/src/reaction_diffusion_IO_routines.f90 +++ b/src/reaction_diffusion_IO_routines.f90 @@ -27,7 +27,7 @@ !> Auckland, the University of Oxford and King's College, London. !> All Rights Reserved. !> -!> Contributor(s): +!> Contributor(s): Vijay Rajagopal !> !> Alternatively, the contents of this file may be used under the terms of !> either the GNU General Public License Version 2 or later (the "GPL"), or @@ -47,7 +47,7 @@ MODULE REACTION_DIFFUSION_IO_ROUTINES USE BaseRoutines - USE ComputationEnvironment + USE ComputationRoutines USE EQUATIONS_SET_CONSTANTS USE FIELD_ROUTINES USE FieldAccessRoutines @@ -90,10 +90,10 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER !Local Variables TYPE(EQUATIONS_SET_TYPE), POINTER :: EQUATIONS_SET - TYPE(DOMAIN_TYPE), POINTER :: COMPUTATIONAL_DOMAIN + TYPE(DOMAIN_TYPE), POINTER :: COMPUTATION_DOMAIN TYPE(FIELD_TYPE), POINTER :: SOURCE_FIELD REAL(DP) :: NodeXValue,NodeYValue,NodeZValue,NodeUValue - INTEGER(INTG):: myComputationalNodeNumber,NumberOfOutputFields,NumberOfDimensions,NumberOfElements,NumberOfNodes + INTEGER(INTG):: myComputationNodeNumber,NumberOfOutputFields,NumberOfDimensions,NumberOfElements,NumberOfNodes INTEGER(INTG):: NumberOfVariableComponents,NumberOfSourceComponents,I,J,K,ValueIndex,NODE_GLOBAL_NUMBER INTEGER(INTG) :: NodesInMeshComponent,BasisType,MaxNodesPerElement,NumberOfFieldComponents(3),ELEMENT_GLOBAL_NUMBER INTEGER(INTG) :: NODE_LOCAL_NUMBER @@ -106,18 +106,18 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER ENTERS("REACTION_DIFFUSION_IO_WRITE_CMGUI",ERR,ERROR,*999) - myComputationalNodeNumber = ComputationalEnvironment_NodeNumberGet(err,error) + myComputationNodeNumber = ComputationEnvironment_NodeNumberGet(err,error) EQUATIONS_SET => REGION%equations_sets%equations_sets(EQUATIONS_SET_GLOBAL_NUMBER)%ptr NULLIFY(SOURCE_FIELD) - COMPUTATIONAL_DOMAIN=>REGION%MESHES%MESHES(1) & + COMPUTATION_DOMAIN=>REGION%MESHES%MESHES(1) & & %ptr%DECOMPOSITIONS%DECOMPOSITIONS(1)%ptr%DOMAIN(1)%ptr - myComputationalNodeNumber = ComputationalEnvironment_NodeNumberGet(ERR,ERROR) - NumberOfDimensions = COMPUTATIONAL_DOMAIN%NUMBER_OF_DIMENSIONS - NumberOfNodes = COMPUTATIONAL_DOMAIN%TOPOLOGY%NODES%NUMBER_OF_NODES + myComputationNodeNumber = ComputationEnvironment_NodeNumberGet(ERR,ERROR) + NumberOfDimensions = COMPUTATION_DOMAIN%NUMBER_OF_DIMENSIONS + NumberOfNodes = COMPUTATION_DOMAIN%TOPOLOGY%NODES%NUMBER_OF_NODES NodesInMeshComponent = REGION%meshes%meshes(1)%ptr%topology(1)%ptr%nodes%numberOfNodes - NumberOfElements = COMPUTATIONAL_DOMAIN%TOPOLOGY%ELEMENTS%NUMBER_OF_ELEMENTS + NumberOfElements = COMPUTATION_DOMAIN%TOPOLOGY%ELEMENTS%NUMBER_OF_ELEMENTS NumberOfVariableComponents=REGION%equations_sets%equations_sets(EQUATIONS_SET_GLOBAL_NUMBER)%ptr%dependent%dependent_field% & & variables(1)%number_of_components NumberOfOutputFields=2 @@ -142,50 +142,50 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER FILENAME="./output/"//NAME//".exnode" - OPEN(UNIT=myComputationalNodeNumber, FILE=CHAR(FILENAME),STATUS='unknown') + OPEN(UNIT=myComputationNodeNumber, FILE=CHAR(FILENAME),STATUS='unknown') ! WRITING HEADER INFORMATION - WRITE(myComputationalNodeNumber,*) 'Group name: Cell' + WRITE(myComputationNodeNumber,*) 'Group name: Cell' WRITE(INTG_STRING,'(I0)'),NumberOfOutputFields - WRITE(myComputationalNodeNumber,*) '#Fields=',TRIM(INTG_STRING) + WRITE(myComputationNodeNumber,*) '#Fields=',TRIM(INTG_STRING) ValueIndex=1 WRITE(INTG_STRING,'(I0)'),NumberOfDimensions - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' 1) coordinates, coordinate, rectangular cartesian, #Components=',TRIM(INTG_STRING) DO I=1,NumberOfDimensions IF(I==1) THEN WRITE(INTG_STRING,'(I0)'),ValueIndex - WRITE(myComputationalNodeNumber,*) ' x. Value index= ',TRIM(INTG_STRING),', #Derivatives= 0' + WRITE(myComputationNodeNumber,*) ' x. Value index= ',TRIM(INTG_STRING),', #Derivatives= 0' ELSE IF(I==2) THEN WRITE(INTG_STRING,'(I0)'),ValueIndex - WRITE(myComputationalNodeNumber,*) ' y. Value index= ',TRIM(INTG_STRING),', #Derivatives= 0' + WRITE(myComputationNodeNumber,*) ' y. Value index= ',TRIM(INTG_STRING),', #Derivatives= 0' ELSE WRITE(INTG_STRING,'(I0)'),ValueIndex - WRITE(myComputationalNodeNumber,*) ' z. Value index= ',TRIM(INTG_STRING),', #Derivatives= 0' + WRITE(myComputationNodeNumber,*) ' z. Value index= ',TRIM(INTG_STRING),', #Derivatives= 0' END IF ValueIndex=ValueIndex+1 END DO WRITE(INTG_STRING,'(I0)'),NumberOfVariableComponents - WRITE(myComputationalNodeNumber,*) ' 2) dependent, field, rectangular cartesian, #Components=', & + WRITE(myComputationNodeNumber,*) ' 2) dependent, field, rectangular cartesian, #Components=', & & TRIM(INTG_STRING) DO I=1,NumberOfVariableComponents WRITE(INTG_STRING,'(I0)'),ValueIndex WRITE(INTG_STRING2,'(I0)'),I - WRITE(myComputationalNodeNumber,*) ' ',TRIM(INTG_STRING2),'. Value index= ',TRIM(INTG_STRING), & + WRITE(myComputationNodeNumber,*) ' ',TRIM(INTG_STRING2),'. Value index= ',TRIM(INTG_STRING), & & ', #Derivatives= 0' ValueIndex=ValueIndex+1 END DO IF( OUTPUT_SOURCE ) THEN !Watch out that no numbering conflict occurs with Analytic: 4.) WRITE(INTG_STRING,'(I0)'),NumberOfSourceComponents - WRITE(myComputationalNodeNumber,*) ' 3) source, field, rectangular cartesian, #Components=', & + WRITE(myComputationNodeNumber,*) ' 3) source, field, rectangular cartesian, #Components=', & & TRIM(INTG_STRING) DO I=1,NumberOfSourceComponents WRITE(INTG_STRING,'(I0)'),ValueIndex WRITE(INTG_STRING2,'(I0)'),I - WRITE(myComputationalNodeNumber,*) ' ',TRIM(INTG_STRING2),'. Value index= ', & + WRITE(myComputationNodeNumber,*) ' ',TRIM(INTG_STRING2),'. Value index= ', & & TRIM(INTG_STRING),', #Derivatives= 0' ValueIndex=ValueIndex+1 END DO @@ -193,7 +193,7 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER !WRITE OUT NODE VALUES DO I = 1,NumberOfNodes - NODE_GLOBAL_NUMBER = COMPUTATIONAL_DOMAIN%TOPOLOGY%NODES%NODES(I)%GLOBAL_NUMBER + NODE_GLOBAL_NUMBER = COMPUTATION_DOMAIN%TOPOLOGY%NODES%NODES(I)%GLOBAL_NUMBER NodeXValue = REGION%equations_sets%equations_sets(EQUATIONS_SET_GLOBAL_NUMBER)%ptr%geometry%geometric_field%variables(1) & & %parameter_sets%parameter_sets(1)%ptr%parameters%cmiss%data_dp(I) IF(NumberOfDimensions==2 .OR. NumberOfDimensions==3) THEN @@ -207,17 +207,17 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER NodeUValue=REGION%equations_sets%equations_sets(EQUATIONS_SET_GLOBAL_NUMBER)%ptr%dependent%dependent_field% & & variables(1)%parameter_sets%parameter_sets(1)%ptr%parameters%cmiss%data_dp(I) - WRITE(myComputationalNodeNumber,*) ' Node: ',NODE_GLOBAL_NUMBER - WRITE(myComputationalNodeNumber,'(" ", es25.16 )')NodeXValue + WRITE(myComputationNodeNumber,*) ' Node: ',NODE_GLOBAL_NUMBER + WRITE(myComputationNodeNumber,'(" ", es25.16 )')NodeXValue IF(NumberOfDimensions==2 .OR. NumberOfDimensions==3) THEN - WRITE(myComputationalNodeNumber,'(" ", es25.16 )')NodeYValue + WRITE(myComputationNodeNumber,'(" ", es25.16 )')NodeYValue END IF IF(NumberOfDimensions==3) THEN - WRITE(myComputationalNodeNumber,'(" ", es25.16 )')NodeZValue + WRITE(myComputationNodeNumber,'(" ", es25.16 )')NodeZValue END IF - WRITE(myComputationalNodeNumber,'(" ", es25.16 )')NodeUValue + WRITE(myComputationNodeNumber,'(" ", es25.16 )')NodeUValue IF( (EQUATIONS_SET%SPECIFICATION(1)==EQUATIONS_SET_CLASSICAL_FIELD_CLASS) & & .AND.(EQUATIONS_SET%SPECIFICATION(2)==EQUATIONS_SET_REACTION_DIFFUSION_EQUATION_TYPE) & @@ -225,14 +225,14 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER !source field IF( OUTPUT_SOURCE ) THEN !NodeSourceValue = SOURCE_INTERPOLATED_POINT(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(1,1) - !WRITE(myComputationalNodeNumber,'(" ", es25.16 )')NodeSourceValue + !WRITE(myComputationNodeNumber,'(" ", es25.16 )')NodeSourceValue END IF END IF END DO !nodes I - CLOSE(myComputationalNodeNumber) + CLOSE(myComputationNodeNumber) !OUTPUT ELEMENTS IN CURRENT DOMAIN - MaxNodesPerElement=COMPUTATIONAL_DOMAIN%TOPOLOGY%ELEMENTS%ELEMENTS(1)%basis%number_of_element_parameters + MaxNodesPerElement=COMPUTATION_DOMAIN%TOPOLOGY%ELEMENTS%ELEMENTS(1)%basis%number_of_element_parameters BasisType = 1 IF(NumberOfDimensions==2) THEN IF(MaxNodesPerElement==4.OR.MaxNodesPerElement==9.OR.MaxNodesPerElement==16) THEN @@ -246,110 +246,110 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER ENDIF CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Writing Elements...",ERR,ERROR,*999) FILENAME="./output/"//NAME//".exelem" - OPEN(UNIT=myComputationalNodeNumber, FILE=CHAR(FILENAME),STATUS='unknown') - WRITE(myComputationalNodeNumber,*) 'Group name: Cell' + OPEN(UNIT=myComputationNodeNumber, FILE=CHAR(FILENAME),STATUS='unknown') + WRITE(myComputationNodeNumber,*) 'Group name: Cell' IF (BasisType==1) THEN !lagrange basis in 1 and 2D WRITE(INTG_STRING,'(I0)'),NumberOfDimensions - WRITE(myComputationalNodeNumber,*) 'Shape. Dimension= ',TRIM(INTG_STRING) - WRITE(myComputationalNodeNumber,*) '#Scale factor sets= 1' + WRITE(myComputationNodeNumber,*) 'Shape. Dimension= ',TRIM(INTG_STRING) + WRITE(myComputationNodeNumber,*) '#Scale factor sets= 1' IF(NumberOfDimensions==1) THEN WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationalNodeNumber,*) 'q.Lagrange, #Scale factors=',TRIM(INTG_STRING) + WRITE(myComputationNodeNumber,*) 'q.Lagrange, #Scale factors=',TRIM(INTG_STRING) ELSE IF (NumberOfDimensions==2) THEN IF(MaxNodesPerElement==4) THEN WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & 'l.Lagrange*l.Lagrange, #Scale factors=',TRIM(INTG_STRING) !linear lagrange ELSE IF(MaxNodesPerElement==9) THEN WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & 'q.Lagrange*q.Lagrange, #Scale factors=',TRIM(INTG_STRING) !quadratic lagrange ELSE IF(MaxNodesPerElement==16) THEN WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & 'c.Lagrange*c.Lagrange, #Scale factors=',TRIM(INTG_STRING) !cubic lagrange END IF ELSE !three dimensions IF(MaxNodesPerElement==8) THEN WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & 'l.Lagrange*l.Lagrange*l.Lagrange, #Scale factors=',TRIM(INTG_STRING) ELSE IF(MaxNodesPerElement==27) THEN WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & 'q.Lagrange*q.Lagrange*q.Lagrange, #Scale factors=',TRIM(INTG_STRING) ELSE IF(MaxNodesPerElement==64) THEN WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & 'c.Lagrange*c.Lagrange*c.Lagrange, #Scale factors=',TRIM(INTG_STRING) END IF END IF ELSEIF(BasisType==2) THEN IF(NumberOfDimensions==2) THEN - WRITE(myComputationalNodeNumber,*) 'Shape. Dimension=', & + WRITE(myComputationNodeNumber,*) 'Shape. Dimension=', & & NumberOfDimensions,', simplex(2)*simplex' IF(MaxNodesPerElement==3) THEN - WRITE(myComputationalNodeNumber,*) '#Scale factor sets= 1' + WRITE(myComputationNodeNumber,*) '#Scale factor sets= 1' WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' l.simplex(2)*l.simplex, #Scale factors= ', TRIM(INTG_STRING) ELSE IF(MaxNodesPerElement==6) THEN - WRITE(myComputationalNodeNumber,*) '#Scale factor sets= 1' + WRITE(myComputationNodeNumber,*) '#Scale factor sets= 1' WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' l.simplex(2)*l.simplex, #Scale factors= ', TRIM(INTG_STRING) ELSE IF (MaxNodesPerElement== 10 ) THEN - WRITE(myComputationalNodeNumber,*) '#Scale factor sets= 1' + WRITE(myComputationNodeNumber,*) '#Scale factor sets= 1' WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' q.simplex(2)*q.simplex, #Scale factors= ', TRIM(INTG_STRING) ENDIF ELSE IF(NumberOfDimensions==3) THEN WRITE(INTG_STRING2,'(I0)'),NumberOfDimensions - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & 'Shape. Dimension=',TRIM(INTG_STRING2),', simplex(2;3)*simplex*simplex' IF(MaxNodesPerElement==4) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & '#Scale factor sets= 1' WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' l.simplex(2;3)*l.simplex*l.simplex, #Scale factors= ', TRIM(INTG_STRING) ELSE IF (MaxNodesPerElement== 10 ) THEN - WRITE(myComputationalNodeNumber,*) '#Scale factor sets= 1' + WRITE(myComputationNodeNumber,*) '#Scale factor sets= 1' WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' q.simplex(2;3)*q.simplex*q.simplex, #Scale factors= ', TRIM(INTG_STRING) ELSE IF(MaxNodesPerElement==20) THEN - WRITE(myComputationalNodeNumber,*) '#Scale factor sets= 1' + WRITE(myComputationNodeNumber,*) '#Scale factor sets= 1' WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' q.simplex(2;3)*q.simplex*q.simplex, #Scale factors= ', TRIM(INTG_STRING) ENDIF ELSE - WRITE(myComputationalNodeNumber,*) '#Scale factor sets= 0' + WRITE(myComputationNodeNumber,*) '#Scale factor sets= 0' END IF END IF WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationalNodeNumber,*) '#Nodes= ',TRIM(INTG_STRING) + WRITE(myComputationNodeNumber,*) '#Nodes= ',TRIM(INTG_STRING) WRITE(INTG_STRING,'(I0)'),NumberOfOutputFields - WRITE(myComputationalNodeNumber,*) '#Fields= ',TRIM(INTG_STRING) + WRITE(myComputationNodeNumber,*) '#Fields= ',TRIM(INTG_STRING) NumberOfFieldComponents(1) = NumberOfDimensions NumberOfFieldComponents(2) = NumberOfVariableComponents NumberOfFieldComponents(3) = NumberOfSourceComponents DO I=1,NumberOfOutputFields IF(I==1)THEN WRITE(INTG_STRING,'(I0)'),NumberOfDimensions - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' 1) coordinates, coordinate, rectangular cartesian, #Components= ',TRIM(INTG_STRING) ELSE IF(I==2) THEN WRITE(INTG_STRING,'(I0)'),NumberOfVariableComponents - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' 2) dependent, field, rectangular cartesian, #Components= ',TRIM(INTG_STRING) ELSE IF(I==3) THEN WRITE(INTG_STRING,'(I0)'),NumberOfSourceComponents - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' 3) source, field, rectangular cartesian, #Components= ',TRIM(INTG_STRING) END IF @@ -357,98 +357,98 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER IF(NumberOfDimensions==1) THEN IF(I==1)THEN IF(J==1) THEN - WRITE(myComputationalNodeNumber,*)' x. l.Lagrange, no modify, standard node based.' + WRITE(myComputationNodeNumber,*)' x. l.Lagrange, no modify, standard node based.' ELSE IF(J==2) THEN - WRITE(myComputationalNodeNumber,*)' y. l.Lagrange, no modify, standard node based.' + WRITE(myComputationNodeNumber,*)' y. l.Lagrange, no modify, standard node based.' ELSE IF(J==3) THEN - WRITE(myComputationalNodeNumber,*)' z. l.Lagrange, no modify, standard node based.' + WRITE(myComputationNodeNumber,*)' z. l.Lagrange, no modify, standard node based.' END IF ELSE - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' ',J,'. l.Lagrange, no modify, standard node based.' END IF ELSE IF(NumberOfDimensions==2) THEN IF(I==1)THEN IF(J==1) THEN IF(MaxNodesPerElement==4)THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' x. l.Lagrange*l.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==9) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' x. q.Lagrange*q.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==16) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' x. c.Lagrange*c.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==3) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' x. l.simplex(2)*l.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==6) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' x. q.simplex(2)*q.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==10) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' x. c.simplex(2)*c.simplex, no modify, standard node based.' END IF ELSE IF(J==2) THEN IF(MaxNodesPerElement==4) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' y. l.Lagrange*l.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==9) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' y. q.Lagrange*q.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==16) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' y. c.Lagrange*c.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==3) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' y. l.simplex(2)*l.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==6) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' y. q.simplex(2)*q.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==10) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' y. c.simplex(2)*c.simplex, no modify, standard node based.' END IF ELSE IF(J==3) THEN IF(MaxNodesPerElement==4) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' z. l.Lagrange*l.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==9) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' z. q.Lagrange*q.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==16) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' z. c.Lagrange*c.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==3) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' z. l.simplex(2)*l.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==6) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' z. q.simplex(2)*q.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==10) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' z. c.simplex(2)*c.simplex, no modify, standard node based.' END IF END IF ELSE IF(MaxNodesPerElement==4) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' ',J,'. l.Lagrange*l.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==9) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' ',J,'. q.Lagrange*q.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==16) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' ',J,'. c.Lagrange*c.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==3) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' ',J,'. l.simplex(2)*l.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==6) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' ',J,'. q.simplex(2)*q.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==10) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' ',J,'. c.simplex(2)*c.simplex, no modify, standard node based.' END IF END IF @@ -456,105 +456,105 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER IF(I==1)THEN IF(J==1) THEN IF(MaxNodesPerElement==8) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' x. l.Lagrange*l.Lagrange*l.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==27) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' x. q.Lagrange*q.Lagrange*q.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==64) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' x. c.Lagrange*c.Lagrange*c.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==4) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' x. l.simplex(2;3)*l.simplex*l.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==10) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' x. q.simplex(2;3)*q.simplex*q.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==20) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' x. c.simplex(2;3)*c.simplex*c.simplex, no modify, standard node based.' END IF ELSE IF(J==2) THEN IF(MaxNodesPerElement==8) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' y. l.Lagrange*l.Lagrange*l.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==27) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' y. q.Lagrange*q.Lagrange*q.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==64) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' y. c.Lagrange*c.Lagrange*c.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==4) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' y. l.simplex(2;3)*l.simplex*l.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==10) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' y. q.simplex(2;3)*q.simplex*q.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==20) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' y. c.simplex(2;3)*c.simplex*c.simplex, no modify, standard node based.' END IF ELSE IF(J==3) THEN IF(MaxNodesPerElement==8) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' z. l.Lagrange*l.Lagrange*l.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==27) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' z. q.Lagrange*q.Lagrange*q.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==64) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' z. c.Lagrange*c.Lagrange*c.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==4) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' z. l.simplex(2;3)*l.simplex*l.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==10) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' z. q.simplex(2;3)*q.simplex*q.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==20) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' z. c.simplex(2;3)*c.simplex*c.simplex, no modify, standard node based.' END IF END IF ELSE IF(MaxNodesPerElement==8) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' ',J,'. l.Lagrange*l.Lagrange*l.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==27) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' ',J,'. q.Lagrange*q.Lagrange*q.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==64) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' ',J,'. c.Lagrange*c.Lagrange*c.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==4) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' ',J,'. l.simplex(2;3)*l.simplex*l.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==10) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' ',J,'. q.simplex(2;3)*q.simplex*q.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==20) THEN - WRITE(myComputationalNodeNumber,*) & + WRITE(myComputationNodeNumber,*) & & ' ',J,'. c.simplex(2;3)*c.simplex*c.simplex, no modify, standard node based.' END IF END IF END IF WRITE(INTG_STRING,'(I0)') MaxNodesPerElement - WRITE(myComputationalNodeNumber,*) ' #Nodes= ',TRIM(INTG_STRING) + WRITE(myComputationNodeNumber,*) ' #Nodes= ',TRIM(INTG_STRING) DO K = 1,MaxNodesPerElement WRITE(INTG_STRING,'(I0)'),K - WRITE(myComputationalNodeNumber,*) ' ',TRIM(INTG_STRING),'. #Values=1' - WRITE(myComputationalNodeNumber,*) ' Value indices: 1' - WRITE(myComputationalNodeNumber,*) ' Scale factor indices: ',TRIM(INTG_STRING) + WRITE(myComputationNodeNumber,*) ' ',TRIM(INTG_STRING),'. #Values=1' + WRITE(myComputationNodeNumber,*) ' Value indices: 1' + WRITE(myComputationNodeNumber,*) ' Scale factor indices: ',TRIM(INTG_STRING) END DO END DO !J loop END DO !I loop IF(.NOT.ALLOCATED(ElementNodes)) ALLOCATE(ElementNodes(NumberOfElements,MaxNodesPerElement)) IF(.NOT.ALLOCATED(ElementNodesScales)) ALLOCATE(ElementNodesScales(NumberOfElements,MaxNodesPerElement)) DO I=1,NumberOfElements - ELEMENT_GLOBAL_NUMBER=COMPUTATIONAL_DOMAIN%DECOMPOSITION%TOPOLOGY%ELEMENTS%ELEMENTS(K)%GLOBAL_NUMBER + ELEMENT_GLOBAL_NUMBER=COMPUTATION_DOMAIN%DECOMPOSITION%TOPOLOGY%ELEMENTS%ELEMENTS(K)%GLOBAL_NUMBER DO J=1,MaxNodesPerElement - NODE_LOCAL_NUMBER=COMPUTATIONAL_DOMAIN%TOPOLOGY%ELEMENTS%ELEMENTS(I)%ELEMENT_NODES(J) - NODE_GLOBAL_NUMBER=COMPUTATIONAL_DOMAIN%MAPPINGS%NODES%LOCAL_TO_GLOBAL_MAP(NODE_LOCAL_NUMBER) + NODE_LOCAL_NUMBER=COMPUTATION_DOMAIN%TOPOLOGY%ELEMENTS%ELEMENTS(I)%ELEMENT_NODES(J) + NODE_GLOBAL_NUMBER=COMPUTATION_DOMAIN%MAPPINGS%NODES%LOCAL_TO_GLOBAL_MAP(NODE_LOCAL_NUMBER) ElementNodes(I,J)=NODE_GLOBAL_NUMBER ElementNodesScales(I,J)=1.0000000000000000E+00 END DO @@ -562,14 +562,14 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER DO K=1,NumberOfElements - ELEMENT_GLOBAL_NUMBER=COMPUTATIONAL_DOMAIN%DECOMPOSITION%TOPOLOGY%ELEMENTS%ELEMENTS(K)%GLOBAL_NUMBER + ELEMENT_GLOBAL_NUMBER=COMPUTATION_DOMAIN%DECOMPOSITION%TOPOLOGY%ELEMENTS%ELEMENTS(K)%GLOBAL_NUMBER IF (BasisType==1) THEN WRITE(INTG_STRING,'(I0)'),ELEMENT_GLOBAL_NUMBER - WRITE(myComputationalNodeNumber,*) 'Element: ', TRIM(INTG_STRING),' 0 0' - WRITE(myComputationalNodeNumber,*) ' Nodes:' - WRITE(myComputationalNodeNumber,*) ' ', ElementNodes(K,1:MaxNodesPerElement) - WRITE(myComputationalNodeNumber,*) ' Scale factors:' - WRITE(myComputationalNodeNumber,*) ' ',ElementNodesScales(K,1:MaxNodesPerElement) + WRITE(myComputationNodeNumber,*) 'Element: ', TRIM(INTG_STRING),' 0 0' + WRITE(myComputationNodeNumber,*) ' Nodes:' + WRITE(myComputationNodeNumber,*) ' ', ElementNodes(K,1:MaxNodesPerElement) + WRITE(myComputationNodeNumber,*) ' Scale factors:' + WRITE(myComputationNodeNumber,*) ' ',ElementNodesScales(K,1:MaxNodesPerElement) ELSEIF(BasisType==2) THEN IF(.NOT.ALLOCATED(SimplexOutputHelp)) ALLOCATE(SimplexOutputHelp(MaxNodesPerElement)) @@ -584,14 +584,14 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER SimplexOutputHelp(4)=ElementNodes(K,3) END IF WRITE(INTG_STRING,'(I0)') ELEMENT_GLOBAL_NUMBER - WRITE(myComputationalNodeNumber,*) 'Element: ', TRIM(INTG_STRING),' 0 0' - WRITE(myComputationalNodeNumber,*) ' Nodes:' - WRITE(myComputationalNodeNumber,*) ' ', SimplexOutputHelp - WRITE(myComputationalNodeNumber,*) ' Scale factors:' - WRITE(myComputationalNodeNumber,*) ' ',ElementNodesScales(K,1:MaxNodesPerElement) + WRITE(myComputationNodeNumber,*) 'Element: ', TRIM(INTG_STRING),' 0 0' + WRITE(myComputationNodeNumber,*) ' Nodes:' + WRITE(myComputationNodeNumber,*) ' ', SimplexOutputHelp + WRITE(myComputationNodeNumber,*) ' Scale factors:' + WRITE(myComputationNodeNumber,*) ' ',ElementNodesScales(K,1:MaxNodesPerElement) END IF ENDDO - CLOSE(myComputationalNodeNumber) + CLOSE(myComputationNodeNumber) EXITS("REACTION_DIFFUSION_IO_WRITE_CMGUI") RETURN diff --git a/src/reaction_diffusion_equation_routines.f90 b/src/reaction_diffusion_equation_routines.f90 index 9eaaa1f3..eda5b326 100755 --- a/src/reaction_diffusion_equation_routines.f90 +++ b/src/reaction_diffusion_equation_routines.f90 @@ -26,7 +26,7 @@ !> Auckland, the University of Oxford and King's College, London. !> All Rights Reserved. !> -!> Contributor(s): Chris Bradley +!> Contributor(s): Vijay Rajagopal,Chris Bradley !> !> Alternatively, the contents of this file may be used under the terms of !> either the GNU General Public License Version 2 or later (the "GPL"), or @@ -47,7 +47,7 @@ MODULE REACTION_DIFFUSION_EQUATION_ROUTINES USE BaseRoutines USE BASIS_ROUTINES USE BOUNDARY_CONDITIONS_ROUTINES - USE ComputationEnvironment + USE ComputationRoutines USE Constants USE CONTROL_LOOP_ROUTINES USE ControlLoopAccessRoutines @@ -1529,7 +1529,7 @@ SUBROUTINE REACTION_DIFFUSION_POST_SOLVE_OUTPUT_DATA(CONTROL_LOOP,SOLVER,err,err REAL(DP) :: CURRENT_TIME,TIME_INCREMENT INTEGER(INTG) :: EQUATIONS_SET_IDX,CURRENT_LOOP_ITERATION,OUTPUT_FREQUENCY - INTEGER(INTG) :: myComputationalNodeNumber + INTEGER(INTG) :: myComputationNodeNumber CHARACTER(28) :: FILE CHARACTER(28) :: OUTPUT_FILE @@ -1558,20 +1558,20 @@ SUBROUTINE REACTION_DIFFUSION_POST_SOLVE_OUTPUT_DATA(CONTROL_LOOP,SOLVER,err,err CURRENT_LOOP_ITERATION=CONTROL_LOOP%TIME_LOOP%ITERATION_NUMBER OUTPUT_FREQUENCY=CONTROL_LOOP%TIME_LOOP%OUTPUT_NUMBER - myComputationalNodeNumber = ComputationalEnvironment_NodeNumberGet(err,error) + myComputationNodeNumber = ComputationEnvironment_NodeNumberGet(err,error) IF(OUTPUT_FREQUENCY>0) THEN IF(MOD(CURRENT_LOOP_ITERATION,OUTPUT_FREQUENCY)==0) THEN IF(CONTROL_LOOP%TIME_LOOP%CURRENT_TIME<=CONTROL_LOOP%TIME_LOOP%STOP_TIME) THEN IF(SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS.EQ.1) THEN IF(CURRENT_LOOP_ITERATION<10) THEN WRITE(OUTPUT_FILE,'("TIME_STEP_SPEC_1.part",I2.2,".000",I0)') & - & myComputationalNodeNumber, CURRENT_LOOP_ITERATION + & myComputationNodeNumber, CURRENT_LOOP_ITERATION ELSE IF(CURRENT_LOOP_ITERATION<100) THEN WRITE(OUTPUT_FILE,'("TIME_STEP_SPEC_1.part",I2.2,".00",I0)') & - & myComputationalNodeNumber,CURRENT_LOOP_ITERATION + & myComputationNodeNumber,CURRENT_LOOP_ITERATION ELSE IF(CURRENT_LOOP_ITERATION<1000) THEN WRITE(OUTPUT_FILE,'("TIME_STEP_SPEC_1.part",I2.2,".0",I0)') & - & myComputationalNodeNumber,CURRENT_LOOP_ITERATION + & myComputationNodeNumber,CURRENT_LOOP_ITERATION ELSE IF(CURRENT_LOOP_ITERATION<10000) THEN WRITE(OUTPUT_FILE,'("TIME_STEP_SPEC_1.part",I2.2,".",I0)') & & CURRENT_LOOP_ITERATION @@ -1579,16 +1579,16 @@ SUBROUTINE REACTION_DIFFUSION_POST_SOLVE_OUTPUT_DATA(CONTROL_LOOP,SOLVER,err,err ELSE IF(CURRENT_LOOP_ITERATION<10) THEN WRITE(OUTPUT_FILE, '("TIME_STEP_SPEC_",I0,".part",I2.2,".000",I0)') & - & equations_set_idx,myComputationalNodeNumber,CURRENT_LOOP_ITERATION + & equations_set_idx,myComputationNodeNumber,CURRENT_LOOP_ITERATION ELSE IF(CURRENT_LOOP_ITERATION<100) THEN WRITE(OUTPUT_FILE, '("TIME_STEP_SPEC_",I0,".part",I2.2,".00",I0)') & - & equations_set_idx,myComputationalNodeNumber,CURRENT_LOOP_ITERATION + & equations_set_idx,myComputationNodeNumber,CURRENT_LOOP_ITERATION ELSE IF(CURRENT_LOOP_ITERATION<1000) THEN WRITE(OUTPUT_FILE, '("TIME_STEP_SPEC_",I0,".part",I2.2,".0",I0)') & - & equations_set_idx,myComputationalNodeNumber,CURRENT_LOOP_ITERATION + & equations_set_idx,myComputationNodeNumber,CURRENT_LOOP_ITERATION ELSE IF(CURRENT_LOOP_ITERATION<10000) THEN WRITE(OUTPUT_FILE, '("TIME_STEP_SPEC_",I0,".part",I2.2,".",I0)') & - & equations_set_idx,myComputationalNodeNumber,CURRENT_LOOP_ITERATION + & equations_set_idx,myComputationNodeNumber,CURRENT_LOOP_ITERATION END IF ENDIF WRITE(*,*) OUTPUT_FILE diff --git a/src/solver_mapping_routines.f90 b/src/solver_mapping_routines.f90 index 750d9021..4b01decd 100755 --- a/src/solver_mapping_routines.f90 +++ b/src/solver_mapping_routines.f90 @@ -26,7 +26,7 @@ !> Auckland, the University of Oxford and King's College, London. !> All Rights Reserved. !> -!> Contributor(s): +!> Contributor(s): Chris Bradley !> !> Alternatively, the contents of this file may be used under the terms of !> either the GNU General Public License Version 2 or later (the "GPL"), or @@ -46,7 +46,7 @@ MODULE SOLVER_MAPPING_ROUTINES USE BaseRoutines USE BOUNDARY_CONDITIONS_ROUTINES - USE ComputationEnvironment + USE ComputationRoutines USE DISTRIBUTED_MATRIX_VECTOR USE EquationsAccessRoutines USE DOMAIN_MAPPINGS @@ -319,7 +319,7 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) ! for each rank. ! !Calculate the row mappings. - myrank=computationalEnvironment%myComputationalNodeNumber + myrank=computationEnvironment%myComputationNodeNumber NUMBER_OF_GLOBAL_SOLVER_ROWS=0 NUMBER_OF_LOCAL_SOLVER_ROWS=0 !Add in the rows from any equations sets that have been added to the solver equations @@ -327,10 +327,10 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) ! !Allocate and initialise the rank lists. ALLOCATE(RANK_GLOBAL_ROWS_LISTS(SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS+SOLVER_MAPPING% & - & NUMBER_OF_INTERFACE_CONDITIONS,0:computationalEnvironment%numberOfComputationalNodes-1),STAT=ERR) + & NUMBER_OF_INTERFACE_CONDITIONS,0:computationEnvironment%numberOfComputationNodes-1),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate rank global rows lists.",ERR,ERROR,*999) CALL SolverDofCouplings_Initialise(rowCouplings,err,error,*999) - DO rank=0,computationalEnvironment%numberOfComputationalNodes-1 + DO rank=0,computationEnvironment%numberOfComputationNodes-1 equations_idx=0 DO equations_set_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS equations_idx=equations_idx+1 @@ -346,7 +346,7 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) CALL LIST_CREATE_START(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR,ERR,ERROR,*999) CALL LIST_DATA_TYPE_SET(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR,LIST_INTG_TYPE,ERR,ERROR,*999) CALL LIST_INITIAL_SIZE_SET(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR,INT(vectorMapping% & - & numberOfGlobalRows/computationalEnvironment%numberOfComputationalNodes,INTG), & + & numberOfGlobalRows/computationEnvironment%numberOfComputationNodes,INTG), & & ERR,ERROR,*999) CALL LIST_DATA_DIMENSION_SET(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR,4,ERR,ERROR,*999) CALL LIST_KEY_DIMENSION_SET(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR,1,ERR,ERROR,*999) @@ -369,7 +369,7 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) CALL LIST_CREATE_START(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR,ERR,ERROR,*999) CALL LIST_DATA_TYPE_SET(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR,LIST_INTG_TYPE,ERR,ERROR,*999) CALL LIST_INITIAL_SIZE_SET(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR, & - & INT(INTERFACE_MAPPING%NUMBER_OF_GLOBAL_COLUMNS/computationalEnvironment%numberOfComputationalNodes, & + & INT(INTERFACE_MAPPING%NUMBER_OF_GLOBAL_COLUMNS/computationEnvironment%numberOfComputationNodes, & & INTG),ERR,ERROR,*999) CALL LIST_DATA_DIMENSION_SET(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR,4,ERR,ERROR,*999) CALL LIST_KEY_DIMENSION_SET(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR,1,ERR,ERROR,*999) @@ -676,8 +676,8 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) ALLOCATE(SOLVER_MAPPING%ROW_DOFS_MAPPING,STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate solver mapping row dofs mapping.",ERR,ERROR,*999) !!TODO: what is the real number of domains for a solver??? - CALL DOMAIN_MAPPINGS_MAPPING_INITIALISE(SOLVER_MAPPING%ROW_DOFS_MAPPING,computationalEnvironment% & - & numberOfComputationalNodes,ERR,ERROR,*999) + CALL DOMAIN_MAPPINGS_MAPPING_INITIALISE(SOLVER_MAPPING%ROW_DOFS_MAPPING,computationEnvironment% & + & numberOfComputationNodes,ERR,ERROR,*999) ROW_DOMAIN_MAPPING=>SOLVER_MAPPING%ROW_DOFS_MAPPING ALLOCATE(ROW_DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(NUMBER_OF_GLOBAL_SOLVER_ROWS),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate row dofs mapping global to local map.",ERR,ERROR,*999) @@ -788,7 +788,7 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) IF(err/=0) CALL FlagError("Could not allocate dummy DOF coupling values.",err,error,*999) dummyDofCoupling%numberOfDofs=1 !Loop over the ranks to ensure that the lowest ranks have the lowest numbered solver variables - DO rank=0,computationalEnvironment%numberOfComputationalNodes-1 + DO rank=0,computationEnvironment%numberOfComputationNodes-1 NUMBER_OF_LOCAL_SOLVER_ROWS=0 !Calculate the solver row <-> equations row & interface row mappings. @@ -1226,9 +1226,9 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) !dof_type is 1 for domain local DOFs and 2 for ghost DOFs ALLOCATE(RANK_GLOBAL_COLS_LISTS(2,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS+SOLVER_MAPPING% & & NUMBER_OF_INTERFACE_CONDITIONS,SOLVER_MAPPING%VARIABLES_LIST(solver_matrix_idx)%NUMBER_OF_VARIABLES, & - & 0:computationalEnvironment%numberOfComputationalNodes-1),STAT=ERR) + & 0:computationEnvironment%numberOfComputationNodes-1),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate rank global columns lists.",ERR,ERROR,*999) - DO rank=0,computationalEnvironment%numberOfComputationalNodes-1 + DO rank=0,computationEnvironment%numberOfComputationNodes-1 DO solver_variable_idx=1,SOLVER_MAPPING%VARIABLES_LIST(solver_matrix_idx)%NUMBER_OF_VARIABLES DO equations_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS+SOLVER_MAPPING%NUMBER_OF_INTERFACE_CONDITIONS DO dof_type=1,2 @@ -1870,13 +1870,13 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) IF(ERR/=0) CALL FlagError("Could not allocate solver col to equations sets map column dofs mapping.",ERR,ERROR,*999) !!TODO: what is the real number of domains for a solver??? CALL DOMAIN_MAPPINGS_MAPPING_INITIALISE(SOLVER_MAPPING%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% & - & COLUMN_DOFS_MAPPING,computationalEnvironment%numberOfComputationalNodes,ERR,ERROR,*999) + & COLUMN_DOFS_MAPPING,computationEnvironment%numberOfComputationNodes,ERR,ERROR,*999) COL_DOMAIN_MAPPING=>SOLVER_MAPPING%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)%COLUMN_DOFS_MAPPING ALLOCATE(COL_DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(NUMBER_OF_GLOBAL_SOLVER_DOFS),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate column dofs mapping global to local.",ERR,ERROR,*999) COL_DOMAIN_MAPPING%NUMBER_OF_GLOBAL=NUMBER_OF_GLOBAL_SOLVER_DOFS ALLOCATE(VARIABLE_RANK_PROCESSED(SOLVER_MAPPING%VARIABLES_LIST(solver_matrix_idx)%NUMBER_OF_VARIABLES, & - & 0:computationalEnvironment%numberOfComputationalNodes-1),STAT=ERR) + & 0:computationEnvironment%numberOfComputationNodes-1),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate variable rank processed.",ERR,ERROR,*999) VARIABLE_RANK_PROCESSED=.FALSE. !Calculate the column mappings @@ -2260,7 +2260,7 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) DOF_MAP(solver_variable_idx)%PTR=0 ENDDO !solver_variable_idx - ALLOCATE(solver_local_dof(0:computationalEnvironment%numberOfComputationalNodes-1),STAT=ERR) + ALLOCATE(solver_local_dof(0:computationEnvironment%numberOfComputationNodes-1),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate solver local dof array.",ERR,ERROR,*999) ! @@ -2271,7 +2271,7 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) solver_global_dof=0 solver_local_dof=0 DO dof_type=1,2 - DO rank=0,computationalEnvironment%numberOfComputationalNodes-1 + DO rank=0,computationEnvironment%numberOfComputationNodes-1 DO solver_variable_idx=1,SOLVER_MAPPING%VARIABLES_LIST(solver_matrix_idx)%NUMBER_OF_VARIABLES diff --git a/src/solver_routines.f90 b/src/solver_routines.f90 index 408cc841..9c1f69b5 100644 --- a/src/solver_routines.f90 +++ b/src/solver_routines.f90 @@ -26,7 +26,7 @@ !> Auckland, the University of Oxford and King's College, London. !> All Rights Reserved. !> -!> Contributor(s): +!> Contributor(s): Chris Bradley !> !> Alternatively, the contents of this file may be used under the terms of !> either the GNU General Public License Version 2 or later (the "GPL"), or @@ -52,7 +52,7 @@ MODULE SOLVER_ROUTINES USE CMISS_CELLML USE CmissPetsc USE CmissPetscTypes - USE ComputationEnvironment + USE ComputationRoutines USE Constants USE DISTRIBUTED_MATRIX_VECTOR USE EquationsAccessRoutines @@ -9807,7 +9807,7 @@ SUBROUTINE SOLVER_LINEAR_DIRECT_CREATE_FINISH(LINEAR_DIRECT_SOLVER,ERR,ERROR,*) !Nothing else to do CASE(SOLVER_MUMPS_LIBRARY,SOLVER_SUPERLU_LIBRARY,SOLVER_PASTIX_LIBRARY,SOLVER_LAPACK_LIBRARY) !Set up solver through PETSc - CALL Petsc_KSPCreate(computationalEnvironment%mpiCommunicator,LINEAR_DIRECT_SOLVER%KSP,ERR,ERROR,*999) + CALL Petsc_KSPCreate(computationEnvironment%mpiCommunicator,LINEAR_DIRECT_SOLVER%KSP,ERR,ERROR,*999) !Set any further KSP options from the command line options CALL Petsc_KSPSetFromOptions(LINEAR_DIRECT_SOLVER%KSP,ERR,ERROR,*999) @@ -11060,7 +11060,7 @@ SUBROUTINE SOLVER_LINEAR_ITERATIVE_CREATE_FINISH(LINEAR_ITERATIVE_SOLVER,ERR,ERR CALL FlagError("Solver linking solve is not associated.",ERR,ERROR,*999) ENDIF ELSE - CALL Petsc_KSPCreate(computationalEnvironment%mpiCommunicator,LINEAR_ITERATIVE_SOLVER%KSP,ERR,ERROR,*999) + CALL Petsc_KSPCreate(computationEnvironment%mpiCommunicator,LINEAR_ITERATIVE_SOLVER%KSP,ERR,ERROR,*999) ENDIF !Set the iterative solver type SELECT CASE(LINEAR_ITERATIVE_SOLVER%ITERATIVE_SOLVER_TYPE) @@ -15893,7 +15893,7 @@ SUBROUTINE Solver_QuasiNewtonLinesearchCreateFinish(LINESEARCH_SOLVER,ERR,ERROR, ENDIF ENDDO !interface_idx !Create the PETSc SNES solver - CALL Petsc_SnesCreate(computationalEnvironment%mpiCommunicator,LINESEARCH_SOLVER%snes,ERR,ERROR,*999) + CALL Petsc_SnesCreate(computationEnvironment%mpiCommunicator,LINESEARCH_SOLVER%snes,ERR,ERROR,*999) !Set the nonlinear solver type to be a Quasi-Newton line search solver CALL Petsc_SnesSetType(LINESEARCH_SOLVER%snes,PETSC_SNESQN,ERR,ERROR,*999) !Following routines don't work for petsc version < 3.5. @@ -17075,7 +17075,7 @@ SUBROUTINE Solver_QuasiNewtonTrustRegionCreateFinish(TRUSTREGION_SOLVER,ERR,ERRO END SELECT CALL SOLVER_MATRICES_CREATE_FINISH(SOLVER_MATRICES,ERR,ERROR,*999) !Create the PETSc SNES solver - CALL Petsc_SnesCreate(computationalEnvironment%mpiCommunicator,TRUSTREGION_SOLVER%snes,ERR,ERROR,*999) + CALL Petsc_SnesCreate(computationEnvironment%mpiCommunicator,TRUSTREGION_SOLVER%snes,ERR,ERROR,*999) !Set the nonlinear solver type to be a Quasi-Newton trust region solver CALL Petsc_SnesSetType(TRUSTREGION_SOLVER%snes,PETSC_SNESNEWTONTR,ERR,ERROR,*999) !Set the nonlinear function @@ -18667,7 +18667,7 @@ SUBROUTINE SOLVER_NEWTON_LINESEARCH_CREATE_FINISH(LINESEARCH_SOLVER,ERR,ERROR,*) ENDIF ENDDO !interface_idx !Create the PETSc SNES solver - CALL Petsc_SnesCreate(computationalEnvironment%mpiCommunicator,LINESEARCH_SOLVER%snes,ERR,ERROR,*999) + CALL Petsc_SnesCreate(computationEnvironment%mpiCommunicator,LINESEARCH_SOLVER%snes,ERR,ERROR,*999) !Set the nonlinear solver type to be a Newton line search solver CALL Petsc_SnesSetType(LINESEARCH_SOLVER%snes,PETSC_SNESNEWTONLS,ERR,ERROR,*999) @@ -19832,7 +19832,7 @@ SUBROUTINE SOLVER_NEWTON_TRUSTREGION_CREATE_FINISH(TRUSTREGION_SOLVER,ERR,ERROR, END SELECT CALL SOLVER_MATRICES_CREATE_FINISH(SOLVER_MATRICES,ERR,ERROR,*999) !Create the PETSc SNES solver - CALL Petsc_SnesCreate(computationalEnvironment%mpiCommunicator,TRUSTREGION_SOLVER%snes,ERR,ERROR,*999) + CALL Petsc_SnesCreate(computationEnvironment%mpiCommunicator,TRUSTREGION_SOLVER%snes,ERR,ERROR,*999) !Set the nonlinear solver type to be a Newton trust region solver CALL Petsc_SnesSetType(TRUSTREGION_SOLVER%snes,PETSC_SNESNEWTONTR,ERR,ERROR,*999) !Set the solver as the SNES application context diff --git a/src/types.f90 b/src/types.f90 index a42ca135..1f9b0398 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -26,7 +26,7 @@ !> Auckland, the University of Oxford and King's College, London. !> All Rights Reserved. !> -!> Contributor(s): +!> Contributor(s): Chris Bradley !> !> Alternatively, the contents of this file may be used under the terms of !> either the GNU General Public License Version 2 or later (the "GPL"), or @@ -1093,8 +1093,8 @@ MODULE Types INTEGER(INTG) :: numberOfDataPoints !>NOTE: ",A)') "It doesn't make any sense to use more than 2 computational nodes for this example?" +! IF (NumberOfComputationNodes .gt. 2) +! WRITE(*,'(">>NOTE: ",A)') "It doesn't make any sense to use more than 2 computation nodes for this example?" ! STOP ! ENDIF @@ -248,7 +248,7 @@ PROGRAM CELLMLINTEGRATIONFORTRANEXAMPLE CALL cmfe_Decomposition_CreateStart(DecompositionUserNumber,Mesh,Decomposition,Err) !Set the decomposition to be a general decomposition with the specified number of domains CALL cmfe_Decomposition_TypeSet(Decomposition,CMFE_DECOMPOSITION_CALCULATED_TYPE,Err) - CALL cmfe_Decomposition_NumberOfDomainsSet(Decomposition,NumberOfComputationalNodes,Err) + CALL cmfe_Decomposition_NumberOfDomainsSet(Decomposition,NumberOfComputationNodes,Err) !Finish the decomposition CALL cmfe_Decomposition_CreateFinish(Decomposition,Err) @@ -384,7 +384,7 @@ PROGRAM CELLMLINTEGRATIONFORTRANEXAMPLE !Set the Stimulus all nodes? DO node_idx=1,NUMBER_OF_ELEMENTS+1 CALL cmfe_Decomposition_NodeDomainGet(Decomposition,node_idx,1,NodeDomain,Err) - IF(NodeDomain==ComputationalNodeNumber) THEN + IF(NodeDomain==ComputationNodeNumber) THEN CALL cmfe_Field_ParameterSetUpdateNode(CellMLParametersField,CMFE_FIELD_U_VARIABLE_TYPE,CMFE_FIELD_VALUES_SET_TYPE,1,1, & & node_idx,stimcomponent,STIM_VALUE,Err) ENDIF @@ -396,7 +396,7 @@ PROGRAM CELLMLINTEGRATIONFORTRANEXAMPLE ! !Loop over the nodes ! DO node_idx=1,LastNodeNumber ! CALL cmfe_Decomposition_NodeDomainGet(Decomposition,node_idx,1,NodeDomain,Err) -! IF(NodeDomain==ComputationalNodeNumber) THEN +! IF(NodeDomain==ComputationNodeNumber) THEN ! CALL cmfe_Field_ParameterSetGetNode(GeometricField,CMFE_FIELD_U_VARIABLE_TYPE,CMFE_FIELD_VALUES_SET_TYPE,1,1,node_idx,1, & ! & X,Err) ! CALL cmfe_Field_ParameterSetGetNode(GeometricField,CMFE_FIELD_U_VARIABLE_TYPE,CMFE_FIELD_VALUES_SET_TYPE,1,1,node_idx,2, & @@ -488,11 +488,11 @@ PROGRAM CELLMLINTEGRATIONFORTRANEXAMPLE CALL cmfe_BoundaryConditions_Initialise(BoundaryConditions,Err) CALL cmfe_SolverEquations_BoundaryConditionsCreateStart(SolverEquations,BoundaryConditions,Err) !Set the first node to 0.0 and the last node to 1.0 - IF(FirstNodeDomain==ComputationalNodeNumber) THEN + IF(FirstNodeDomain==ComputationNodeNumber) THEN !CALL cmfe_BoundaryConditions_SetNode(BoundaryConditions,DependentField,CMFE_FIELD_U_VARIABLE_TYPE,1,1,FirstNodeNumber,1, & ! & CMFE_BOUNDARY_CONDITION_FIXED,0.0_CMISSRP,Err) ENDIF - IF(LastNodeDomain==ComputationalNodeNumber) THEN + IF(LastNodeDomain==ComputationNodeNumber) THEN !CALL cmfe_BoundaryConditions_SetNode(BoundaryConditions,DependentField,CMFE_FIELD_U_VARIABLE_TYPE,1,1,LastNodeNumber,1, & ! & CMFE_BOUNDARY_CONDITION_FIXED,1.0_CMISSRP,Err) ENDIF @@ -506,7 +506,7 @@ PROGRAM CELLMLINTEGRATIONFORTRANEXAMPLE !Set the Stimulus at node 1 DO node_idx=1,NUMBER_OF_ELEMENTS+1 CALL cmfe_Decomposition_NodeDomainGet(Decomposition,node_idx,1,NodeDomain,Err) - IF(NodeDomain==ComputationalNodeNumber) THEN + IF(NodeDomain==ComputationNodeNumber) THEN CALL cmfe_Field_ParameterSetUpdateNode(CellMLParametersField,CMFE_FIELD_U_VARIABLE_TYPE,CMFE_FIELD_VALUES_SET_TYPE,1,1, & & node_idx,stimcomponent,0.0_CMISSRP,Err) ENDIF diff --git a/tests/CellML/Monodomain.f90 b/tests/CellML/Monodomain.f90 index a89b230c..a8ef4804 100644 --- a/tests/CellML/Monodomain.f90 +++ b/tests/CellML/Monodomain.f90 @@ -139,7 +139,7 @@ PROGRAM MONODOMAINEXAMPLE !Generic CMISS variables - INTEGER(CMISSIntg) :: NumberOfComputationalNodes,ComputationalNodeNumber + INTEGER(CMISSIntg) :: NumberOfComputationNodes,ComputationNodeNumber INTEGER(CMISSIntg) :: EquationsSetIndex,CellMLIndex INTEGER(CMISSIntg) :: FirstNodeNumber,LastNodeNumber INTEGER(CMISSIntg) :: FirstNodeDomain,LastNodeDomain,NodeDomain @@ -180,9 +180,9 @@ PROGRAM MONODOMAINEXAMPLE !Trap errors CALL cmfe_ErrorHandlingModeSet(CMFE_ERRORS_TRAP_ERROR,Err) - !Get the computational nodes information - CALL cmfe_ComputationalNumberOfNodesGet(NumberOfComputationalNodes,Err) - CALL cmfe_ComputationalNodeNumberGet(ComputationalNodeNumber,Err) + !Get the computation nodes information + CALL cmfe_ComputationNumberOfNodesGet(NumberOfComputationNodes,Err) + CALL cmfe_ComputationNodeNumberGet(ComputationNodeNumber,Err) !CALL cmfe_OutputSetOn("Monodomain",Err) @@ -250,7 +250,7 @@ PROGRAM MONODOMAINEXAMPLE CALL cmfe_Decomposition_CreateStart(DecompositionUserNumber,Mesh,Decomposition,Err) !Set the decomposition to be a general decomposition with the specified number of domains CALL cmfe_Decomposition_TypeSet(Decomposition,CMFE_DECOMPOSITION_CALCULATED_TYPE,Err) - CALL cmfe_Decomposition_NumberOfDomainsSet(Decomposition,NumberOfComputationalNodes,Err) + CALL cmfe_Decomposition_NumberOfDomainsSet(Decomposition,NumberOfComputationNodes,Err) !Finish the decomposition CALL cmfe_Decomposition_CreateFinish(Decomposition,Err) @@ -397,7 +397,7 @@ PROGRAM MONODOMAINEXAMPLE !Set the Stimulus at half the bottom nodes DO node_idx=1,NUMBER_OF_ELEMENTS/2 CALL cmfe_Decomposition_NodeDomainGet(Decomposition,node_idx,1,NodeDomain,Err) - IF(NodeDomain==ComputationalNodeNumber) THEN + IF(NodeDomain==ComputationNodeNumber) THEN CALL cmfe_Field_ParameterSetUpdateNode(CellMLParametersField,CMFE_FIELD_U_VARIABLE_TYPE,CMFE_FIELD_VALUES_SET_TYPE,1,1, & & node_idx,stimcomponent,STIM_VALUE,Err) ENDIF @@ -409,7 +409,7 @@ PROGRAM MONODOMAINEXAMPLE !Loop over the nodes DO node_idx=1,LastNodeNumber CALL cmfe_Decomposition_NodeDomainGet(Decomposition,node_idx,1,NodeDomain,Err) - IF(NodeDomain==ComputationalNodeNumber) THEN + IF(NodeDomain==ComputationNodeNumber) THEN CALL cmfe_Field_ParameterSetGetNode(GeometricField,CMFE_FIELD_U_VARIABLE_TYPE,CMFE_FIELD_VALUES_SET_TYPE,1,1,node_idx,1, & & X,Err) CALL cmfe_Field_ParameterSetGetNode(GeometricField,CMFE_FIELD_U_VARIABLE_TYPE,CMFE_FIELD_VALUES_SET_TYPE,1,1,node_idx,2, & @@ -500,11 +500,11 @@ PROGRAM MONODOMAINEXAMPLE CALL cmfe_BoundaryConditions_Initialise(BoundaryConditions,Err) CALL cmfe_SolverEquations_BoundaryConditionsCreateStart(SolverEquations,BoundaryConditions,Err) !Set the first node to 0.0 and the last node to 1.0 - IF(FirstNodeDomain==ComputationalNodeNumber) THEN + IF(FirstNodeDomain==ComputationNodeNumber) THEN !CALL cmfe_BoundaryConditions_SetNode(BoundaryConditions,DependentField,CMFE_FIELD_U_VARIABLE_TYPE,1,1,FirstNodeNumber,1, & ! & CMFE_BOUNDARY_CONDITION_FIXED,0.0_CMISSRP,Err) ENDIF - IF(LastNodeDomain==ComputationalNodeNumber) THEN + IF(LastNodeDomain==ComputationNodeNumber) THEN !CALL cmfe_BoundaryConditions_SetNode(BoundaryConditions,DependentField,CMFE_FIELD_U_VARIABLE_TYPE,1,1,LastNodeNumber,1, & ! & CMFE_BOUNDARY_CONDITION_FIXED,1.0_CMISSRP,Err) ENDIF @@ -518,7 +518,7 @@ PROGRAM MONODOMAINEXAMPLE !Set the Stimulus at node 1 DO node_idx=1,NUMBER_OF_ELEMENTS/2 CALL cmfe_Decomposition_NodeDomainGet(Decomposition,node_idx,1,NodeDomain,Err) - IF(NodeDomain==ComputationalNodeNumber) THEN + IF(NodeDomain==ComputationNodeNumber) THEN CALL cmfe_Field_ParameterSetUpdateNode(CellMLParametersField,CMFE_FIELD_U_VARIABLE_TYPE,CMFE_FIELD_VALUES_SET_TYPE,1,1, & & node_idx,stimcomponent,0.0_CMISSRP,Err) ENDIF diff --git a/tests/ClassicalField/AnalyticHelmholtz.f90 b/tests/ClassicalField/AnalyticHelmholtz.f90 index 34eb7922..ae6c2363 100644 --- a/tests/ClassicalField/AnalyticHelmholtz.f90 +++ b/tests/ClassicalField/AnalyticHelmholtz.f90 @@ -281,7 +281,7 @@ SUBROUTINE ANALYTICHELMHOLTZ_GENERIC(NUMBER_GLOBAL_X_ELEMENTS,NUMBER_GLOBAL_Y_EL NUMBER_OF_DOMAINS=1 - !Broadcast the number of elements in the X & Y directions and the number of partitions to the other computational nodes + !Broadcast the number of elements in the X & Y directions and the number of partitions to the other computation nodes CALL MPI_BCAST(NUMBER_GLOBAL_X_ELEMENTS,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR) CALL MPI_BCAST(NUMBER_GLOBAL_Y_ELEMENTS,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR) CALL MPI_BCAST(NUMBER_GLOBAL_Z_ELEMENTS,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR) diff --git a/tests/ClassicalField/AnalyticLaplace.f90 b/tests/ClassicalField/AnalyticLaplace.f90 index 0deec29a..91522b43 100644 --- a/tests/ClassicalField/AnalyticLaplace.f90 +++ b/tests/ClassicalField/AnalyticLaplace.f90 @@ -381,7 +381,7 @@ SUBROUTINE ANALYTICLAPLACE_GENERIC(NUMBER_GLOBAL_X_ELEMENTS,NUMBER_GLOBAL_Y_ELEM NUMBER_OF_DOMAINS=1 - !Broadcast the number of elements in the X & Y directions and the number of partitions to the other computational nodes + !Broadcast the number of elements in the X & Y directions and the number of partitions to the other computation nodes CALL MPI_BCAST(NUMBER_GLOBAL_X_ELEMENTS,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR) CALL MPI_BCAST(NUMBER_GLOBAL_Y_ELEMENTS,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR) CALL MPI_BCAST(NUMBER_GLOBAL_Z_ELEMENTS,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR) diff --git a/tests/ClassicalField/AnalyticNonlinearPoisson.f90 b/tests/ClassicalField/AnalyticNonlinearPoisson.f90 index 3e96d89f..a40f8769 100644 --- a/tests/ClassicalField/AnalyticNonlinearPoisson.f90 +++ b/tests/ClassicalField/AnalyticNonlinearPoisson.f90 @@ -116,7 +116,7 @@ PROGRAM NONLINEARPOISSONEXAMPLE INTEGER(CMISSIntg) :: EquationsSetIndex INTEGER(CMISSIntg) :: Err - INTEGER(CMISSIntg) :: NumberOfComputationalNodes,ComputationalNodeNumber + INTEGER(CMISSIntg) :: NumberOfComputationNodes,ComputationNodeNumber #ifdef WIN32 !Quickwin type @@ -179,9 +179,9 @@ PROGRAM NONLINEARPOISSONEXAMPLE !Output to a file CALL cmfe_OutputSetOn("NonlinearPoisson",Err) - !Get the computational nodes information - CALL cmfe_ComputationalNumberOfNodesGet(NumberOfComputationalNodes,Err) - CALL cmfe_ComputationalNodeNumberGet(ComputationalNodeNumber,Err) + !Get the computation nodes information + CALL cmfe_ComputationNumberOfNodesGet(NumberOfComputationNodes,Err) + CALL cmfe_ComputationNodeNumberGet(ComputationNodeNumber,Err) !Start the creation of a new RC coordinate system CALL cmfe_CoordinateSystem_Initialise(CoordinateSystem,Err) @@ -268,7 +268,7 @@ PROGRAM NONLINEARPOISSONEXAMPLE CALL cmfe_Decomposition_CreateStart(DecompositionUserNumber,Mesh,Decomposition,Err) !Set the decomposition to be a general decomposition with the specified number of domains CALL cmfe_Decomposition_TypeSet(Decomposition,CMFE_DECOMPOSITION_CALCULATED_TYPE,Err) - CALL cmfe_Decomposition_NumberOfDomainsSet(Decomposition,NumberOfComputationalNodes,Err) + CALL cmfe_Decomposition_NumberOfDomainsSet(Decomposition,NumberOfComputationNodes,Err) !Finish the decomposition CALL cmfe_Decomposition_CreateFinish(Decomposition,Err) diff --git a/tests/ClassicalField/Laplace.f90 b/tests/ClassicalField/Laplace.f90 index c4ff1b80..b84b501f 100644 --- a/tests/ClassicalField/Laplace.f90 +++ b/tests/ClassicalField/Laplace.f90 @@ -119,7 +119,7 @@ PROGRAM LAPLACEEXAMPLE !Generic CMISS variables - INTEGER(CMISSIntg) :: NumberOfComputationalNodes,ComputationalNodeNumber + INTEGER(CMISSIntg) :: NumberOfComputationNodes,ComputationNodeNumber INTEGER(CMISSIntg) :: EquationsSetIndex INTEGER(CMISSIntg) :: FirstNodeNumber,LastNodeNumber INTEGER(CMISSIntg) :: FirstNodeDomain,LastNodeDomain @@ -183,9 +183,9 @@ PROGRAM LAPLACEEXAMPLE CALL cmfe_OutputSetOn(Filename,Err) - !Get the computational nodes information - CALL cmfe_ComputationalNumberOfNodesGet(NumberOfComputationalNodes,Err) - CALL cmfe_ComputationalNodeNumberGet(ComputationalNodeNumber,Err) + !Get the computation nodes information + CALL cmfe_ComputationNumberOfNodesGet(NumberOfComputationNodes,Err) + CALL cmfe_ComputationNodeNumberGet(ComputationNodeNumber,Err) !Start the creation of a new RC coordinate system CALL cmfe_CoordinateSystem_Initialise(CoordinateSystem,Err) @@ -273,7 +273,7 @@ PROGRAM LAPLACEEXAMPLE CALL cmfe_Decomposition_CreateStart(DecompositionUserNumber,Mesh,Decomposition,Err) !Set the decomposition to be a general decomposition with the specified number of domains CALL cmfe_Decomposition_TypeSet(Decomposition,CMFE_DECOMPOSITION_CALCULATED_TYPE,Err) - CALL cmfe_Decomposition_NumberOfDomainsSet(Decomposition,NumberOfComputationalNodes,Err) + CALL cmfe_Decomposition_NumberOfDomainsSet(Decomposition,NumberOfComputationNodes,Err) !Finish the decomposition CALL cmfe_Decomposition_CreateFinish(Decomposition,Err) @@ -394,11 +394,11 @@ PROGRAM LAPLACEEXAMPLE CALL cmfe_Nodes_NumberOfNodesGet(Nodes,LastNodeNumber,Err) CALL cmfe_Decomposition_NodeDomainGet(Decomposition,FirstNodeNumber,1,FirstNodeDomain,Err) CALL cmfe_Decomposition_NodeDomainGet(Decomposition,LastNodeNumber,1,LastNodeDomain,Err) - IF(FirstNodeDomain==ComputationalNodeNumber) THEN + IF(FirstNodeDomain==ComputationNodeNumber) THEN CALL cmfe_BoundaryConditions_SetNode(BoundaryConditions,DependentField,CMFE_FIELD_U_VARIABLE_TYPE,1,1,FirstNodeNumber,1, & & CMFE_BOUNDARY_CONDITION_FIXED,0.0_CMISSRP,Err) ENDIF - IF(LastNodeDomain==ComputationalNodeNumber) THEN + IF(LastNodeDomain==ComputationNodeNumber) THEN CALL cmfe_BoundaryConditions_SetNode(BoundaryConditions,DependentField,CMFE_FIELD_U_VARIABLE_TYPE,1,1,LastNodeNumber,1, & & CMFE_BOUNDARY_CONDITION_FIXED,1.0_CMISSRP,Err) ENDIF diff --git a/tests/FieldML_IO/cube.f90 b/tests/FieldML_IO/cube.f90 index e8b7b595..fa1ff835 100644 --- a/tests/FieldML_IO/cube.f90 +++ b/tests/FieldML_IO/cube.f90 @@ -121,15 +121,15 @@ SUBROUTINE ReadCube(worldRegion, inputFilename, region, mesh, geometricField, & TYPE(cmfe_DecompositionType) :: decomposition TYPE(cmfe_NodesType) :: nodes TYPE(cmfe_FieldMLIOType) :: fieldmlInfo - INTEGER(CMISSIntg) :: numberOfComputationalNodes, computationalNodeNumber + INTEGER(CMISSIntg) :: numberOfComputationNodes, computationNodeNumber INTEGER(CMISSIntg) :: err err = 0 - ! Get computational nodes information + ! Get computation nodes information - CALL cmfe_ComputationalNumberOfNodesGet(numberOfComputationalNodes, err) - CALL cmfe_ComputationalNodeNumberGet(computationalNodeNumber, err) + CALL cmfe_ComputationNumberOfNodesGet(numberOfComputationNodes, err) + CALL cmfe_ComputationNodeNumberGet(computationNodeNumber, err) ! Initialise FieldML and parse input file @@ -178,7 +178,7 @@ SUBROUTINE ReadCube(worldRegion, inputFilename, region, mesh, geometricField, & CALL cmfe_Decomposition_Initialise(decomposition, err) CALL cmfe_Decomposition_CreateStart(AUTO_USER_NUMBER(), mesh, decomposition, err) CALL cmfe_Decomposition_TypeSet(decomposition, CMFE_DECOMPOSITION_ALL_TYPE, err) - CALL cmfe_Decomposition_NumberOfDomainsSet(decomposition, numberOfComputationalNodes, err) + CALL cmfe_Decomposition_NumberOfDomainsSet(decomposition, numberOfComputationNodes, err) CALL cmfe_Decomposition_CreateFinish(decomposition, err) ! Define Geometric Field diff --git a/tests/FieldML_IO/fieldml_io.f90 b/tests/FieldML_IO/fieldml_io.f90 index 7fbfcad2..170f1871 100644 --- a/tests/FieldML_IO/fieldml_io.f90 +++ b/tests/FieldML_IO/fieldml_io.f90 @@ -53,7 +53,7 @@ PROGRAM IRON_TEST_FIELDML_IO ! Generic CMISS variables - INTEGER(CMISSIntg) :: numberOfComputationalNodes, computationalNodeNumber + INTEGER(CMISSIntg) :: numberOfComputationNodes, computationNodeNumber INTEGER(CMISSIntg) :: err CALL INITIALISE_TESTS() @@ -63,10 +63,10 @@ PROGRAM IRON_TEST_FIELDML_IO CALL cmfe_Initialise(worldCoordinateSystem, worldRegion, err) CALL cmfe_ErrorHandlingModeSet(CMFE_ERRORS_TRAP_ERROR, err) - ! Get computational nodes information + ! Get computation nodes information - CALL cmfe_ComputationalNumberOfNodesGet(numberOfComputationalNodes, err) - CALL cmfe_ComputationalNodeNumberGet(computationalNodeNumber, err) + CALL cmfe_ComputationNumberOfNodesGet(numberOfComputationNodes, err) + CALL cmfe_ComputationNodeNumberGet(computationNodeNumber, err) CALL TestFieldMLIOCube(worldRegion) CALL TestFieldMLArguments(worldRegion) diff --git a/tests/FiniteElasticity/Cantilever.f90 b/tests/FiniteElasticity/Cantilever.f90 index 22184bc8..be9ef1ca 100644 --- a/tests/FiniteElasticity/Cantilever.f90 +++ b/tests/FiniteElasticity/Cantilever.f90 @@ -98,7 +98,7 @@ PROGRAM CANTILEVEREXAMPLE !Program variables INTEGER(CMISSIntg) :: NumberGlobalXElements,NumberGlobalYElements,NumberGlobalZElements INTEGER(CMISSIntg) :: EquationsSetIndex - INTEGER(CMISSIntg) :: NumberOfComputationalNodes,NumberOfDomains,ComputationalNodeNumber + INTEGER(CMISSIntg) :: NumberOfComputationNodes,NumberOfDomains,ComputationNodeNumber INTEGER(CMISSIntg) :: NodeNumber,NodeDomain,node_idx,component_idx,deriv_idx INTEGER(CMISSIntg),ALLOCATABLE :: LeftSurfaceNodes(:) INTEGER(CMISSIntg) :: LeftNormalXi @@ -208,11 +208,11 @@ PROGRAM CANTILEVEREXAMPLE WRITE(*,'("Elements: ", 3 i3)') NumberGlobalXElements,NumberGlobalYElements,NumberGlobalZElements WRITE(*,'("Scaling type: ", i3)') ScalingType - !Get the number of computational nodes and this computational node number - CALL cmfe_ComputationalNumberOfNodesGet(NumberOfComputationalNodes,Err) - CALL cmfe_ComputationalNodeNumberGet(ComputationalNodeNumber,Err) + !Get the number of computation nodes and this computation node number + CALL cmfe_ComputationNumberOfNodesGet(NumberOfComputationNodes,Err) + CALL cmfe_ComputationNodeNumberGet(ComputationNodeNumber,Err) - NumberOfDomains=NumberOfComputationalNodes + NumberOfDomains=NumberOfComputationNodes !Create a 3D rectangular cartesian coordinate system CALL cmfe_CoordinateSystem_Initialise(CoordinateSystem,Err) @@ -430,7 +430,7 @@ PROGRAM CANTILEVEREXAMPLE DO node_idx=1,SIZE(LeftSurfaceNodes,1) NodeNumber=LeftSurfaceNodes(node_idx) CALL cmfe_Decomposition_NodeDomainGet(Decomposition,NodeNumber,1,NodeDomain,Err) - IF(NodeDomain==ComputationalNodeNumber) THEN + IF(NodeDomain==ComputationNodeNumber) THEN DO component_idx=1,3 CALL cmfe_BoundaryConditions_AddNode(BoundaryConditions,DependentField,CMFE_FIELD_U_VARIABLE_TYPE,1,1,NodeNumber, & & component_idx,CMFE_BOUNDARY_CONDITION_FIXED,0.0_CMISSRP,Err) diff --git a/tests/FiniteElasticity/SimpleShear.f90 b/tests/FiniteElasticity/SimpleShear.f90 index fecaa8d4..73cc83fe 100644 --- a/tests/FiniteElasticity/SimpleShear.f90 +++ b/tests/FiniteElasticity/SimpleShear.f90 @@ -100,7 +100,7 @@ PROGRAM SIMPLESHEAREXAMPLE INTEGER(CMISSIntg) :: NumberGlobalXElements,NumberGlobalYElements,NumberGlobalZElements INTEGER(CMISSIntg) :: EquationsSetIndex - INTEGER(CMISSIntg) :: NumberOfComputationalNodes,NumberOfDomains,ComputationalNodeNumber + INTEGER(CMISSIntg) :: NumberOfComputationNodes,NumberOfDomains,ComputationNodeNumber INTEGER(CMISSIntg) :: NodeNumber,NodeDomain,node_idx INTEGER(CMISSIntg),ALLOCATABLE :: LeftSurfaceNodes(:) INTEGER(CMISSIntg),ALLOCATABLE :: RightSurfaceNodes(:) @@ -158,14 +158,14 @@ PROGRAM SIMPLESHEAREXAMPLE CALL cmfe_OutputSetOn("SimpleShear",Err) - !Get the number of computational nodes and this computational node number - CALL cmfe_ComputationalNumberOfNodesGet(NumberOfComputationalNodes,Err) - CALL cmfe_ComputationalNodeNumberGet(ComputationalNodeNumber,Err) + !Get the number of computation nodes and this computation node number + CALL cmfe_ComputationNumberOfNodesGet(NumberOfComputationNodes,Err) + CALL cmfe_ComputationNodeNumberGet(ComputationNodeNumber,Err) NumberGlobalXElements=2 NumberGlobalYElements=2 NumberGlobalZElements=2 - NumberOfDomains=NumberOfComputationalNodes + NumberOfDomains=NumberOfComputationNodes !Create a 3D rectangular cartesian coordinate system CALL cmfe_CoordinateSystem_Initialise(CoordinateSystem,Err) @@ -396,7 +396,7 @@ PROGRAM SIMPLESHEAREXAMPLE DO node_idx=1,SIZE(TopSurfaceNodes,1) NodeNumber=TopSurfaceNodes(node_idx) CALL cmfe_Decomposition_NodeDomainGet(Decomposition,NodeNumber,1,NodeDomain,Err) - IF(NodeDomain==ComputationalNodeNumber) THEN + IF(NodeDomain==ComputationNodeNumber) THEN ! x-direction CALL cmfe_Field_ParameterSetGetNode(GeometricField,CMFE_FIELD_U_VARIABLE_TYPE,CMFE_FIELD_VALUES_SET_TYPE,1,1,NodeNumber,1,& & VALUE,Err) @@ -419,7 +419,7 @@ PROGRAM SIMPLESHEAREXAMPLE DO node_idx=1,SIZE(BottomSurfaceNodes,1) NodeNumber=BottomSurfaceNodes(node_idx) CALL cmfe_Decomposition_NodeDomainGet(Decomposition,NodeNumber,1,NodeDomain,Err) - IF(NodeDomain==ComputationalNodeNumber) THEN + IF(NodeDomain==ComputationNodeNumber) THEN ! x-direction CALL cmfe_Field_ParameterSetGetNode(GeometricField,CMFE_FIELD_U_VARIABLE_TYPE,CMFE_FIELD_VALUES_SET_TYPE,1,1,NodeNumber,1,& & VALUE,Err) diff --git a/tests/LinearElasticity/CantileverBeam.f90 b/tests/LinearElasticity/CantileverBeam.f90 index ad59c101..f7435318 100644 --- a/tests/LinearElasticity/CantileverBeam.f90 +++ b/tests/LinearElasticity/CantileverBeam.f90 @@ -185,7 +185,7 @@ SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_GENERIC(NumberGlobalXElements,NumberGlobal INTEGER(CMISSIntg) :: FieldGeometryNumberOfComponents,FieldDependentNumberOfComponents,NumberOfElements(3) INTEGER(CMISSIntg) :: MPI_IERROR INTEGER(CMISSIntg) :: EquationsSetIndex,FieldComponentIndex,FieldMaterialNumberOfComponents,NumberOfXi - INTEGER(CMISSIntg) :: NumberOfComputationalNodes,ComputationalNodeNumber + INTEGER(CMISSIntg) :: NumberOfComputationNodes,ComputationNodeNumber !CMISS variables @@ -232,11 +232,11 @@ SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_GENERIC(NumberGlobalXElements,NumberGlobal FieldGeometryNumberOfComponents=NumberOfXi FieldDependentNumberOfComponents=NumberOfXi - !Get the number of computational nodes and this computational node number - CALL cmfe_ComputationalNumberOfNodesGet(NumberOfComputationalNodes,Err) - CALL cmfe_ComputationalNodeNumberGet(ComputationalNodeNumber,Err) + !Get the number of computation nodes and this computation node number + CALL cmfe_ComputationNumberOfNodesGet(NumberOfComputationNodes,Err) + CALL cmfe_ComputationNodeNumberGet(ComputationNodeNumber,Err) - !Broadcast the number of elements in the X,Y and Z directions and the number of partitions to the other computational nodes + !Broadcast the number of elements in the X,Y and Z directions and the number of partitions to the other computation nodes CALL MPI_BCAST(NumberGlobalXElements,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR) CALL MPI_BCAST(NumberGlobalYElements,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR) CALL MPI_BCAST(NumberGlobalZElements,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR) diff --git a/tests/LinearElasticity/Extension.f90 b/tests/LinearElasticity/Extension.f90 index 983ff9e2..f286bdd4 100644 --- a/tests/LinearElasticity/Extension.f90 +++ b/tests/LinearElasticity/Extension.f90 @@ -237,7 +237,7 @@ SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_GENERIC(NumberGlobalXElements,NumberGlobal INTEGER(CMISSIntg) :: FieldGeometryNumberOfComponents,FieldDependentNumberOfComponents,NumberOfElements(3) INTEGER(CMISSIntg) :: MPI_IERROR INTEGER(CMISSIntg) :: EquationsSetIndex,FieldComponentIndex,FieldMaterialNumberOfComponents,NumberOfXi - INTEGER(CMISSIntg) :: NumberOfComputationalNodes,ComputationalNodeNumber + INTEGER(CMISSIntg) :: NumberOfComputationNodes,ComputationNodeNumber !CMISS variables @@ -284,11 +284,11 @@ SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_GENERIC(NumberGlobalXElements,NumberGlobal FieldGeometryNumberOfComponents=NumberOfXi FieldDependentNumberOfComponents=NumberOfXi - !Get the number of computational nodes and this computational node number - CALL cmfe_ComputationalNumberOfNodesGet(NumberOfComputationalNodes,Err) - CALL cmfe_ComputationalNodeNumberGet(ComputationalNodeNumber,Err) + !Get the number of computation nodes and this computation node number + CALL cmfe_ComputationNumberOfNodesGet(NumberOfComputationNodes,Err) + CALL cmfe_ComputationNodeNumberGet(ComputationNodeNumber,Err) - !Broadcast the number of elements in the X,Y and Z directions and the number of partitions to the other computational nodes + !Broadcast the number of elements in the X,Y and Z directions and the number of partitions to the other computation nodes CALL MPI_BCAST(NumberGlobalXElements,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR) CALL MPI_BCAST(NumberGlobalYElements,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR) CALL MPI_BCAST(NumberGlobalZElements,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR) From 4e8040f6d3fa3033d0910558467055491a45d093 Mon Sep 17 00:00:00 2001 From: Chris Bradley Date: Mon, 25 Sep 2017 11:28:38 +1300 Subject: [PATCH 2/6] Tidy up computation routines. Make mpiCommunicator mpiWorldCommunicator and make numberOfComputationNodes and myComputationNodeNumber to be numberOfWorldComputationNodes and myWorldComputationNodeNumber --- src/Navier_Stokes_equations_routines.f90 | 71 +-- src/analytic_analysis_routines.f90 | 40 +- src/base_routines.f90 | 36 +- src/boundary_condition_routines.f90 | 24 +- src/cmiss.f90 | 32 +- src/computation_routines.f90 | 608 ++++++++++++------- src/data_projection_routines.f90 | 46 +- src/distributed_matrix_vector.f90 | 42 +- src/domain_mappings.f90 | 18 +- src/equations_set_routines.f90 | 12 +- src/field_IO_routines.f90 | 228 +++---- src/field_routines.f90 | 14 +- src/fieldml_input_routines.f90 | 6 +- src/fieldml_output_routines.f90 | 6 +- src/finite_elasticity_routines.f90 | 22 +- src/mesh_routines.f90 | 38 +- src/opencmiss_iron.f90 | 31 +- src/reaction_diffusion_IO_routines.f90 | 238 ++++---- src/reaction_diffusion_equation_routines.f90 | 18 +- src/solver_mapping_routines.f90 | 26 +- src/solver_routines.f90 | 12 +- 21 files changed, 878 insertions(+), 690 deletions(-) diff --git a/src/Navier_Stokes_equations_routines.f90 b/src/Navier_Stokes_equations_routines.f90 index 2522dadc..331aeb16 100644 --- a/src/Navier_Stokes_equations_routines.f90 +++ b/src/Navier_Stokes_equations_routines.f90 @@ -12560,7 +12560,7 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux(equationsSet,coupledEquationsSet,i INTEGER(INTG) :: faceNodeDerivativeIdx, meshComponentNumber INTEGER(INTG) :: normalComponentIdx INTEGER(INTG) :: boundaryID,numberOfBoundaries,boundaryType,coupledNodeNumber,numberOfGlobalBoundaries - INTEGER(INTG) :: MPI_IERROR,numberOfComputationNodes + INTEGER(INTG) :: MPI_IERROR,numberOfWorldComputationNodes INTEGER(INTG) :: i,j,computationNode REAL(DP) :: gaussWeight, normalProjection,elementNormal(3) REAL(DP) :: normalDifference,normalTolerance @@ -12881,22 +12881,22 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux(equationsSet,coupledEquationsSet,i globalBoundaryArea = 0.0_DP globalBoundaryPressure = 0.0_DP globalBoundaryNormalStress = 0.0_DP - numberOfComputationNodes=computationEnvironment%numberOfComputationNodes - IF(numberOfComputationNodes>1) THEN !use mpi + numberOfWorldComputationNodes=computationEnvironment%numberOfWorldComputationNodes + IF(numberOfWorldComputationNodes>1) THEN !use mpi CALL MPI_ALLREDUCE(localBoundaryFlux,globalBoundaryFlux,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,err,error,*999) CALL MPI_ALLREDUCE(localBoundaryArea,globalBoundaryArea,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(localBoundaryNormalStress,globalBoundaryNormalStress,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(localBoundaryPressure,globalBoundaryPressure,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(numberOfBoundaries,numberOfGlobalBoundaries,1,MPI_INTEGER,MPI_MAX, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) ELSE numberOfGlobalBoundaries = numberOfBoundaries @@ -13179,11 +13179,11 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux(equationsSet,coupledEquationsSet,i END DO !elementIdx !allocate array for mpi communication - IF(numberOfComputationNodes>1) THEN !use mpi - ALLOCATE(globalConverged(numberOfComputationNodes),STAT=ERR) + IF(numberOfWorldComputationNodes>1) THEN !use mpi + ALLOCATE(globalConverged(numberOfWorldComputationNodes),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate global convergence check array.",ERR,ERROR,*999) CALL MPI_ALLGATHER(convergedFlag,1,MPI_LOGICAL,globalConverged,1,MPI_LOGICAL, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPI_IERROR,ERR,ERROR,*999) IF(ALL(globalConverged)) THEN convergedFlag = .TRUE. @@ -13253,7 +13253,7 @@ SUBROUTINE NavierStokes_Couple1D0D(controlLoop,solver,err,error,*) TYPE(VARYING_STRING) :: localError INTEGER(INTG) :: nodeNumber,nodeIdx,derivativeIdx,versionIdx,componentIdx,numberOfLocalNodes1D INTEGER(INTG) :: solver1dNavierStokesNumber,solverNumber,MPI_IERROR,timestep,iteration - INTEGER(INTG) :: boundaryNumber,numberOfBoundaries,numberOfComputationNodes + INTEGER(INTG) :: boundaryNumber,numberOfBoundaries,numberOfWorldComputationNodes INTEGER(INTG) :: dependentDof,boundaryConditionType REAL(DP) :: A0_PARAM,E_PARAM,H_PARAM,beta,pCellML,normalWave(2) REAL(DP) :: qPrevious,pPrevious,aPrevious,q1d,a1d,qError,aError,couplingTolerance @@ -13475,13 +13475,13 @@ SUBROUTINE NavierStokes_Couple1D0D(controlLoop,solver,err,error,*) localConverged = .FALSE. END IF ! Need to check that boundaries have converged globally (on all domains) if this is a parallel problem - numberOfComputationNodes=computationEnvironment%numberOfComputationNodes - IF(numberOfComputationNodes>1) THEN !use mpi + numberOfWorldComputationNodes=computationEnvironment%numberOfWorldComputationNodes + IF(numberOfWorldComputationNodes>1) THEN !use mpi !allocate array for mpi communication - ALLOCATE(globalConverged(numberOfComputationNodes),STAT=ERR) + ALLOCATE(globalConverged(numberOfWorldComputationNodes),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate global convergence check array.",ERR,ERROR,*999) CALL MPI_ALLGATHER(localConverged,1,MPI_LOGICAL,globalConverged,1,MPI_LOGICAL, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPI_IERROR,err,error,*999) IF(ALL(globalConverged)) THEN !CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"1D/0D coupling converged; # iterations: ", & @@ -13544,7 +13544,7 @@ SUBROUTINE NavierStokes_Couple3D1D(controlLoop,err,error,*) TYPE(VARYING_STRING) :: localError INTEGER(INTG) :: nodeNumber,nodeIdx,derivativeIdx,versionIdx,componentIdx,numberOfLocalNodes1D INTEGER(INTG) :: solver1dNavierStokesNumber,MPI_IERROR,timestep,iteration - INTEGER(INTG) :: boundaryNumber,boundaryType1D,numberOfBoundaries,numberOfComputationNodes + INTEGER(INTG) :: boundaryNumber,boundaryType1D,numberOfBoundaries,numberOfWorldComputationNodes INTEGER(INTG) :: solver3dNavierStokesNumber,userNodeNumber,localDof,globalDof,computationNode REAL(DP) :: normalWave(2) REAL(DP) :: flow1D,stress1D,flow1DPrevious,stress1DPrevious,flow3D,stress3D,flowError,stressError @@ -13764,12 +13764,13 @@ SUBROUTINE NavierStokes_Couple3D1D(controlLoop,err,error,*) localConverged = .TRUE. END IF ! Need to check that boundaries have converged globally (on all domains) if this is a MPI problem - numberOfComputationNodes=computationEnvironment%numberOfComputationNodes - IF(numberOfComputationNodes>1) THEN !use mpi + numberOfWorldComputationNodes=computationEnvironment%numberOfWorldComputationNodes + IF(numberOfWorldComputationNodes>1) THEN !use mpi !allocate array for mpi communication IF(ERR/=0) CALL FlagError("Could not allocate global convergence check array.",ERR,ERROR,*999) - CALL MPI_ALLREDUCE(localConverged,globalConverged,1,MPI_LOGICAL,MPI_LAND,computationEnvironment%mpiCommunicator,MPI_IERROR) + CALL MPI_ALLREDUCE(localConverged,globalConverged,1,MPI_LOGICAL,MPI_LAND, & + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) IF(globalConverged) THEN CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"3D/1D coupling converged; # iterations: ", & @@ -13844,7 +13845,7 @@ SUBROUTINE NavierStokes_CoupleCharacteristics(controlLoop,solver,err,error,*) TYPE(VARYING_STRING) :: localError INTEGER(INTG) :: nodeNumber,nodeIdx,derivativeIdx,versionIdx,componentIdx,i INTEGER(INTG) :: solver1dNavierStokesNumber,solverNumber - INTEGER(INTG) :: branchNumber,numberOfBranches,numberOfComputationNodes,numberOfVersions + INTEGER(INTG) :: branchNumber,numberOfBranches,numberOfWorldComputationNodes,numberOfVersions INTEGER(INTG) :: MPI_IERROR,timestep,iteration,outputIteration REAL(DP) :: couplingTolerance,l2ErrorW(30),wPrevious(2,7),wNavierStokes(2,7),wCharacteristic(2,7),wError(2,7) REAL(DP) :: l2ErrorQ(100),qCharacteristic(7),qNavierStokes(7),wNext(2,7) @@ -14055,13 +14056,13 @@ SUBROUTINE NavierStokes_CoupleCharacteristics(controlLoop,solver,err,error,*) localConverged = .FALSE. END IF ! Need to check that boundaries have converged globally (on all domains) if this is a parallel problem - numberOfComputationNodes=computationEnvironment%numberOfComputationNodes - IF(numberOfComputationNodes>1) THEN !use mpi + numberOfWorldComputationNodes=computationEnvironment%numberOfWorldComputationNodes + IF(numberOfWorldComputationNodes>1) THEN !use mpi !allocate array for mpi communication - ALLOCATE(globalConverged(numberOfComputationNodes),STAT=ERR) + ALLOCATE(globalConverged(numberOfWorldComputationNodes),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate global convergence check array.",ERR,ERROR,*999) CALL MPI_ALLGATHER(localConverged,1,MPI_LOGICAL,globalConverged,1,MPI_LOGICAL, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPI_IERROR,err,error,*999) IF(ALL(globalConverged)) THEN !CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"Navier-Stokes/Characteristic converged; # iterations: ", & @@ -15020,7 +15021,7 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux3D0D(equationsSet,err,error,*) INTEGER(INTG) :: faceNodeIdx, elementNodeIdx INTEGER(INTG) :: faceNodeDerivativeIdx, meshComponentNumber INTEGER(INTG) :: boundaryID,numberOfBoundaries,boundaryType,coupledNodeNumber,numberOfGlobalBoundaries - INTEGER(INTG) :: MPI_IERROR,numberOfComputationNodes + INTEGER(INTG) :: MPI_IERROR,numberOfWorldComputationNodes INTEGER(INTG) :: computationNode,xiDirection(3),orientation REAL(DP) :: gaussWeight, elementNormal(3) REAL(DP) :: normalDifference,normalTolerance @@ -15253,19 +15254,19 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux3D0D(equationsSet,err,error,*) globalBoundaryFlux = 0.0_DP globalBoundaryArea = 0.0_DP globalBoundaryPressure = 0.0_DP - numberOfComputationNodes=computationEnvironment%numberOfComputationNodes - IF(numberOfComputationNodes>1) THEN !use mpi + numberOfWorldComputationNodes=computationEnvironment%numberOfWorldComputationNodes + IF(numberOfWorldComputationNodes>1) THEN !use mpi CALL MPI_ALLREDUCE(localBoundaryFlux,globalBoundaryFlux,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(localBoundaryArea,globalBoundaryArea,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(localBoundaryPressure,globalBoundaryPressure,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(numberOfBoundaries,numberOfGlobalBoundaries,1,MPI_INTEGER,MPI_MAX, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) ELSE numberOfGlobalBoundaries = numberOfBoundaries @@ -15409,11 +15410,11 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux3D0D(equationsSet,err,error,*) END DO !elementIdx !allocate array for mpi communication - IF(numberOfComputationNodes>1) THEN !use mpi - ALLOCATE(globalConverged(numberOfComputationNodes),STAT=ERR) + IF(numberOfWorldComputationNodes>1) THEN !use mpi + ALLOCATE(globalConverged(numberOfWorldComputationNodes),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate global convergence check array.",ERR,ERROR,*999) CALL MPI_ALLGATHER(convergedFlag,1,MPI_LOGICAL,globalConverged,1,MPI_LOGICAL, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPI_IERROR,ERR,ERROR,*999) IF(ALL(globalConverged)) THEN convergedFlag = .TRUE. diff --git a/src/analytic_analysis_routines.f90 b/src/analytic_analysis_routines.f90 index 873d0950..2e3db391 100755 --- a/src/analytic_analysis_routines.f90 +++ b/src/analytic_analysis_routines.f90 @@ -147,9 +147,9 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) IF(FIELD%DEPENDENT_TYPE==FIELD_DEPENDENT_TYPE) THEN IF(LEN_TRIM(FILENAME)>=1) THEN !!TODO \todo have more general ascii file mechanism - IF(computationEnvironment%numberOfComputationNodes>1) THEN + IF(computationEnvironment%numberOfWorldComputationNodes>1) THEN WRITE(FILE_NAME,'(A,".opanal.",I0)') FILENAME(1:LEN_TRIM(FILENAME)),computationEnvironment% & - & myComputationNodeNumber + & myWorldComputationNodeNumber ELSE FILE_NAME=FILENAME(1:LEN_TRIM(FILENAME))//".opanal" ENDIF @@ -270,7 +270,7 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) !Output RMS errors CALL WRITE_STRING(OUTPUT_ID,"",ERR,ERROR,*999) IF(NUMBER(1)>0) THEN - IF(computationEnvironment%numberOfComputationNodes>1) THEN + IF(computationEnvironment%numberOfWorldComputationNodes>1) THEN !Local elements only CALL WRITE_STRING(OUTPUT_ID,"Local RMS errors:",ERR,ERROR,*999) LOCAL_STRING= & @@ -294,16 +294,16 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) !Global RMS values !Collect the values across the ranks CALL MPI_ALLREDUCE(MPI_IN_PLACE,NUMBER,1,MPI_INTEGER,MPI_SUM, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR_PER,1,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR_ABS,1,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR_REL,1,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL WRITE_STRING(OUTPUT_ID,"Global RMS errors:",ERR,ERROR,*999) LOCAL_STRING= & @@ -400,7 +400,7 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) ENDDO !node_idx !Output RMS errors CALL WRITE_STRING(OUTPUT_ID,"",ERR,ERROR,*999) - IF(computationEnvironment%numberOfComputationNodes>1) THEN + IF(computationEnvironment%numberOfWorldComputationNodes>1) THEN IF(ANY(NUMBER>0)) THEN !Local nodes only CALL WRITE_STRING(OUTPUT_ID,"Local RMS errors:",ERR,ERROR,*999) @@ -438,16 +438,16 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) !Global RMS values !Collect the values across the ranks CALL MPI_ALLREDUCE(MPI_IN_PLACE,NUMBER,8,MPI_INTEGER,MPI_SUM, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR_PER,8,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR_ABS,8,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR_REL,8,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL WRITE_STRING(OUTPUT_ID,"Global RMS errors:",ERR,ERROR,*999) LOCAL_STRING= & @@ -517,7 +517,7 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) ALLOCATE(GHOST_INTEGRAL_ERRORS(6,FIELD_VARIABLE%NUMBER_OF_COMPONENTS),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate ghost integral errors.",ERR,ERROR,*999) CALL ANALYTIC_ANALYSIS_INTEGRAL_ERRORS(FIELD_VARIABLE,INTEGRAL_ERRORS,GHOST_INTEGRAL_ERRORS,ERR,ERROR,*999) - IF(computationEnvironment%numberOfComputationNodes>1) THEN + IF(computationEnvironment%numberOfWorldComputationNodes>1) THEN CALL WRITE_STRING(OUTPUT_ID,"Local Integral errors:",ERR,ERROR,*999) LOCAL_STRING="Component# Numerical Analytic % error Absolute err Relative err" CALL WRITE_STRING(OUTPUT_ID,LOCAL_STRING,ERR,ERROR,*999) @@ -590,7 +590,7 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) ENDDO !component_idx !Collect the values across the ranks CALL MPI_ALLREDUCE(MPI_IN_PLACE,INTEGRAL_ERRORS,6*FIELD_VARIABLE%NUMBER_OF_COMPONENTS,MPI_DOUBLE_PRECISION, & - & MPI_SUM,computationEnvironment%mpiCommunicator,MPI_IERROR) + & MPI_SUM,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL WRITE_STRING(OUTPUT_ID,"Global Integral errors:",ERR,ERROR,*999) LOCAL_STRING="Component# Numerical Analytic % error Absolute err Relative err" CALL WRITE_STRING(OUTPUT_ID,LOCAL_STRING,ERR,ERROR,*999) @@ -1709,7 +1709,7 @@ SUBROUTINE AnalyticAnalysis_RMSErrorGetNode(FIELD,VARIABLE_TYPE,COMPONENT_NUMBER ENDDO !deriv_idx ENDDO !node_idx - IF(computationEnvironment%numberOfComputationNodes>1) THEN + IF(computationEnvironment%numberOfWorldComputationNodes>1) THEN IF(ANY(NUMBER>0)) THEN DO deriv_idx=1,8 IF(NUMBER(deriv_idx)>0) THEN @@ -1724,9 +1724,9 @@ SUBROUTINE AnalyticAnalysis_RMSErrorGetNode(FIELD,VARIABLE_TYPE,COMPONENT_NUMBER ENDDO !deriv_idx !Global RMS values !Collect the values across the ranks - CALL MPI_ALLREDUCE(MPI_IN_PLACE,NUMBER,8,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiCommunicator,MPI_IERROR) + CALL MPI_ALLREDUCE(MPI_IN_PLACE,NUMBER,8,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) - CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR,8,MPI_DOUBLE_PRECISION,MPI_SUM,computationEnvironment%mpiCommunicator, & + CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR,8,MPI_DOUBLE_PRECISION,MPI_SUM,computationEnvironment%mpiWorldCommunicator, & & MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) DO deriv_idx=1,8 @@ -1838,7 +1838,7 @@ SUBROUTINE AnalyticAnalysis_RMSErrorGetElement(FIELD,VARIABLE_TYPE,COMPONENT_NUM GHOST_RMS_ERROR=GHOST_RMS_ERROR+ERROR_VALUE*ERROR_VALUE ENDDO !element_idx IF(NUMBER>0) THEN - IF(computationEnvironment%numberOfComputationNodes>1) THEN + IF(computationEnvironment%numberOfWorldComputationNodes>1) THEN !Local elements only LOCAL_RMS=SQRT(RMS_ERROR/NUMBER) !Local and ghost elements @@ -1846,10 +1846,10 @@ SUBROUTINE AnalyticAnalysis_RMSErrorGetElement(FIELD,VARIABLE_TYPE,COMPONENT_NUM !Global RMS values !Collect the values across the ranks CALL MPI_ALLREDUCE(MPI_IN_PLACE,NUMBER,1,MPI_INTEGER,MPI_SUM, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR,1,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) GLOBAL_RMS=SQRT(RMS_ERROR/NUMBER) ENDIF diff --git a/src/base_routines.f90 b/src/base_routines.f90 index 1613c481..95c00b52 100755 --- a/src/base_routines.f90 +++ b/src/base_routines.f90 @@ -146,8 +146,8 @@ MODULE BaseRoutines !Module variables - INTEGER(INTG), SAVE :: myComputationNodeNumber !0) THEN IF(myNodeNumber>=0.AND.myNodeNumber<=numberOfNodes-1) THEN - myComputationNodeNumber=myNodeNumber - numberOfComputationNodes=numberOfNodes + myWorldComputationNodeNumber=myNodeNumber + numberOfWorldComputationNodes=numberOfNodes ELSE CALL FlagError("Invalid node number.",err,error,*999) ENDIF @@ -708,8 +708,8 @@ SUBROUTINE FlagWarningC(string,err,error,*) TYPE(VARYING_STRING), INTENT(OUT) :: error !1) THEN - WRITE(outputString,'(">>WARNING (",I0,"): ",A)') myComputationNodeNumber,string + IF(numberOfWorldComputationNodes>1) THEN + WRITE(outputString,'(">>WARNING (",I0,"): ",A)') myWorldComputationNodeNumber,string ELSE WRITE(outputString,'(">>WARNING: ",A)') string ENDIF @@ -734,8 +734,8 @@ SUBROUTINE FlagWarningVS(string,err,error,*) TYPE(VARYING_STRING), INTENT(OUT) :: error !1) THEN - WRITE(outputString,'(">>WARNING (",I0,"): ",A)') myComputationNodeNumber,CHAR(string) + IF(numberOfWorldComputationNodes>1) THEN + WRITE(outputString,'(">>WARNING (",I0,"): ",A)') myWorldComputationNodeNumber,CHAR(string) ELSE WRITE(outputString,'(">>WARNING: ",A)') CHAR(string) ENDIF @@ -783,8 +783,8 @@ SUBROUTINE BaseRoutinesInitialise(err,error,*) err=0 error="" - myComputationNodeNumber=0 - numberOfComputationNodes=1 + myWorldComputationNodeNumber=0 + numberOfWorldComputationNodes=1 diagnostics=.FALSE. diagnostics1=.FALSE. diagnostics2=.FALSE. @@ -928,8 +928,8 @@ SUBROUTINE DiagnosticsSetOn(diagType,levelList,diagFilename,routineList,err,erro IF(LEN_TRIM(diagFilename)>=1) THEN IF(diagFileOpen) CLOSE(UNIT=DIAGNOSTICS_FILE_UNIT) - IF(numberOfComputationNodes>1) THEN - WRITE(filename,'(A,".diag.",I0)') diagFilename(1:LEN_TRIM(diagFilename)),myComputationNodeNumber + IF(numberOfWorldComputationNodes>1) THEN + WRITE(filename,'(A,".diag.",I0)') diagFilename(1:LEN_TRIM(diagFilename)),myWorldComputationNodeNumber ELSE filename=diagFilename(1:LEN_TRIM(diagFilename))//".diag" ENDIF @@ -1063,8 +1063,8 @@ SUBROUTINE OutputSetOn(echoFilename,err,error,*) IF(echoOutput) THEN CALL FlagError("Write output is already on.",err,error,*999) ELSE - IF(numberOfComputationNodes>1) THEN - WRITE(filename,'(A,".out.",I0)') echoFilename(1:LEN_TRIM(echoFilename)),myComputationNodeNumber + IF(numberOfWorldComputationNodes>1) THEN + WRITE(filename,'(A,".out.",I0)') echoFilename(1:LEN_TRIM(echoFilename)),myWorldComputationNodeNumber ELSE filename=echoFilename(1:LEN_TRIM(echoFilename))//".out" ENDIF @@ -1233,8 +1233,8 @@ SUBROUTINE TimingSetOn(timingType,timingSummaryFlag,timingFilename,routineList,e NULLIFY(routine) IF(LEN_TRIM(timingFilename)>=1) THEN IF(timingFileOpen) CLOSE(UNIT=TIMING_FILE_UNIT) - IF(numberOfComputationNodes>1) THEN - WRITE(filename,'(A,".timing.",I0)') timingFilename(1:LEN_TRIM(timingFilename)),myComputationNodeNumber + IF(numberOfWorldComputationNodes>1) THEN + WRITE(filename,'(A,".timing.",I0)') timingFilename(1:LEN_TRIM(timingFilename)),myWorldComputationNodeNumber ELSE filename=timingFilename(1:LEN_TRIM(timingFilename))//".timing" ENDIF @@ -1389,8 +1389,8 @@ SUBROUTINE WriteError(err,error,*) TYPE(VARYING_STRING) :: localError,localError2 indent=2 - IF(numberOfComputationNodes>1) THEN - WRITE(startString,'(A,A,I0,A,X,I0,A)') indentString(1:indent),"ERROR (",myComputationNodeNumber,"):", & + IF(numberOfWorldComputationNodes>1) THEN + WRITE(startString,'(A,A,I0,A,X,I0,A)') indentString(1:indent),"ERROR (",myWorldComputationNodeNumber,"):", & & ERR,":" startStringLength=LEN_TRIM(startString) ELSE diff --git a/src/boundary_condition_routines.f90 b/src/boundary_condition_routines.f90 index 51c5f06e..069870f9 100755 --- a/src/boundary_condition_routines.f90 +++ b/src/boundary_condition_routines.f90 @@ -222,7 +222,7 @@ SUBROUTINE BOUNDARY_CONDITIONS_CREATE_FINISH(BOUNDARY_CONDITIONS,ERR,ERROR,*) CALL FlagError("Boundary conditions have already been finished.",ERR,ERROR,*999) ELSE IF(ALLOCATED(BOUNDARY_CONDITIONS%BOUNDARY_CONDITIONS_VARIABLES)) THEN - IF(computationEnvironment%numberOfComputationNodes>0) THEN + IF(computationEnvironment%numberOfWorldComputationNodes>0) THEN !Transfer all the boundary conditions to all the computation nodes. !\todo Look at this. DO variable_idx=1,BOUNDARY_CONDITIONS%NUMBER_OF_BOUNDARY_CONDITIONS_VARIABLES @@ -236,10 +236,10 @@ SUBROUTINE BOUNDARY_CONDITIONS_CREATE_FINISH(BOUNDARY_CONDITIONS,ERR,ERROR,*) !\todo This operation is a little expensive as we are doing an unnecessary sum across all the ranks in order to combin !\todo the data from each rank into all ranks. We will see how this goes for now. CALL MPI_ALLREDUCE(MPI_IN_PLACE,BOUNDARY_CONDITION_VARIABLE%DOF_TYPES, & - & SEND_COUNT,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiCommunicator,MPI_IERROR) + & SEND_COUNT,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,BOUNDARY_CONDITION_VARIABLE%CONDITION_TYPES, & - & SEND_COUNT,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiCommunicator,MPI_IERROR) + & SEND_COUNT,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) ELSE LOCAL_ERROR="Field variable domain mapping is not associated for variable type "// & @@ -249,10 +249,10 @@ SUBROUTINE BOUNDARY_CONDITIONS_CREATE_FINISH(BOUNDARY_CONDITIONS,ERR,ERROR,*) ! Update the total number of boundary condition types by summing across all nodes CALL MPI_ALLREDUCE(MPI_IN_PLACE,BOUNDARY_CONDITION_VARIABLE%DOF_COUNTS, & - & MAX_BOUNDARY_CONDITION_NUMBER,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiCommunicator,MPI_IERROR) + & MAX_BOUNDARY_CONDITION_NUMBER,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,BOUNDARY_CONDITION_VARIABLE%NUMBER_OF_DIRICHLET_CONDITIONS, & - & 1,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiCommunicator,MPI_IERROR) + & 1,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) ! Check that the boundary conditions set are appropriate for equations sets @@ -260,7 +260,7 @@ SUBROUTINE BOUNDARY_CONDITIONS_CREATE_FINISH(BOUNDARY_CONDITIONS,ERR,ERROR,*) !Make sure the required parameter sets are created on all computation nodes and begin updating them CALL MPI_ALLREDUCE(MPI_IN_PLACE,BOUNDARY_CONDITION_VARIABLE%parameterSetRequired, & - & FIELD_NUMBER_OF_SET_TYPES,MPI_LOGICAL,MPI_LOR,computationEnvironment%mpiCommunicator,MPI_IERROR) + & FIELD_NUMBER_OF_SET_TYPES,MPI_LOGICAL,MPI_LOR,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) DO parameterSetIdx=1,FIELD_NUMBER_OF_SET_TYPES IF(BOUNDARY_CONDITION_VARIABLE%parameterSetRequired(parameterSetIdx)) THEN @@ -2125,7 +2125,7 @@ SUBROUTINE BoundaryConditions_NeumannMatricesInitialise(boundaryConditionsVariab TYPE(DOMAIN_LINE_TYPE), POINTER :: line TYPE(DOMAIN_FACE_TYPE), POINTER :: face TYPE(LIST_TYPE), POINTER :: columnIndicesList, rowColumnIndicesList - INTEGER(INTG) :: myComputationNodeNumber + INTEGER(INTG) :: myWorldComputationNodeNumber INTEGER(INTG) :: numberOfPointDofs, numberNonZeros, numberRowEntries, neumannConditionNumber, localNeumannConditionIdx INTEGER(INTG) :: neumannIdx, globalDof, localDof, localDofNyy, domainIdx, numberOfDomains, domainNumber, componentNumber INTEGER(INTG) :: nodeIdx, derivIdx, nodeNumber, versionNumber, derivativeNumber, columnNodeNumber, lineIdx, faceIdx, columnDof @@ -2420,11 +2420,11 @@ SUBROUTINE BoundaryConditions_NeumannMatricesInitialise(boundaryConditionsVariab !Set up vector of Neumann point values CALL DISTRIBUTED_VECTOR_CREATE_START(pointDofMapping,boundaryConditionsNeumann%pointValues,err,error,*999) CALL DISTRIBUTED_VECTOR_CREATE_FINISH(boundaryConditionsNeumann%pointValues,err,error,*999) - myComputationNodeNumber=ComputationEnvironment_NodeNumberGet(err,error) + myWorldComputationNodeNumber=ComputationEnvironment_NodeNumberGet(err,error) !Set point values vector from boundary conditions field parameter set DO neumannIdx=1,numberOfPointDofs globalDof=boundaryConditionsNeumann%setDofs(neumannIdx) - IF(rhsVariable%DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(globalDof)%DOMAIN_NUMBER(1)==myComputationNodeNumber) THEN + IF(rhsVariable%DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(globalDof)%DOMAIN_NUMBER(1)==myWorldComputationNodeNumber) THEN localDof=rhsVariable%DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(globalDof)%LOCAL_NUMBER(1) ! Set point DOF vector value localNeumannConditionIdx=boundaryConditionsNeumann%pointDofMapping%GLOBAL_TO_LOCAL_MAP(neumannIdx)%LOCAL_NUMBER(1) @@ -2546,7 +2546,7 @@ SUBROUTINE BoundaryConditions_NeumannIntegrate(rhsBoundaryConditions,err,error,* TYPE(VARYING_STRING), INTENT(OUT) :: error ! \addtogroup CMFE_ErrorHandlingModes OpenCMISS::Iron::ErrorHandlingModes !> \brief Error handling mode parameters - !> \see CMISS + !> \see OpenCMISS !>@{ - INTEGER(INTG), PARAMETER :: CMFE_RETURN_ERROR_CODE = 0 !@} !Module types !Module variables - INTEGER(INTG), SAVE :: cmfe_ErrorHandlingMode !Returns the error handling mode for CMISS \see OPENOpenCMISS::Iron::CMISSErrorHandlingModeGet + !>Returns the error handling mode for OpenCMISS \see OpenCMISS::Iron::cmfe_ErrorHandlingModeGet SUBROUTINE cmfe_ErrorHandlingModeGet_(errorHandlingMode,err,error,*) !Argument variables - INTEGER(INTG), INTENT(OUT) :: errorHandlingMode !Sets the error handling mode for cmiss \see OPENOpenCMISS::Iron::CMISSErrorHandlingModeSet + !>Sets the error handling mode for cmiss \see OpenCMISS::Iron::cmfe_ErrorHandlingModeSet SUBROUTINE cmfe_ErrorHandlingModeSet_(errorHandlingMode,err,error,*) !Argument variables - INTEGER(INTG), INTENT(IN) :: errorHandlingMode !Finalises CMISS. \see OPENOpenCMISS::Iron::CMISSFinalise + !>Finalises OpenCMISS. \see OpenCMISS::Iron::cmfe_Finalise SUBROUTINE cmfe_Finalise_(err,error,*) !Argument variables @@ -217,8 +217,8 @@ SUBROUTINE cmfe_Finalise_(err,error,*) CALL BASES_FINALISE(err,error,*999) !Reset the signal handler CALL cmfe_ResetFatalHandler() - !Finalise computation enviroment - CALL Computation_EnvironmentFinalise(err,error,*999) + !Finalise computation + CALL Computation_Finalise(err,error,*999) !Finalise the base routines CALL BaseRoutinesFinalise(err,error,*999) @@ -233,7 +233,7 @@ END SUBROUTINE cmfe_Finalise_ !!TODO Underscore to avoid name clash. Can be removed upon prefix rename. - !>Initialises CMISS. \see OpenCMISS::Iron::cmfe_Initialise + !>Initialises OpenCMISS. \see OpenCMISS::Iron::cmfe_Initialise SUBROUTINE cmfe_Initialise_(worldRegion,err,error,*) !Argument variables @@ -247,8 +247,8 @@ SUBROUTINE cmfe_Initialise_(worldRegion,err,error,*) cmfe_ErrorHandlingMode = CMFE_OUTPUT_ERROR !Default for now, maybe make CMFE_RETURN_ERROR_CODE the default !Initialise the base routines CALL BaseRoutinesInitialise(err,error,*999) - !Intialise the computation environment - CALL Computation_EnvironmentInitialise(err,error,*999) + !Intialise the computation + CALL Computation_Initialise(err,error,*999) !Setup signal handling CALL cmfe_InitFatalHandler() CALL cmfe_SetFatalHandler() @@ -265,7 +265,7 @@ SUBROUTINE cmfe_Initialise_(worldRegion,err,error,*) CALL PROBLEMS_INITIALISE(err,error,*999) !Write out the CMISS version - IF(computationEnvironment%myComputationNodeNumber==0) THEN + IF(computationEnvironment%myWorldComputationNodeNumber==0) THEN versionString="OpenCMISS(Iron) version "//TRIM(NumberToVString(CMFE_MAJOR_VERSION,"*",err,error)) versionString=versionString//"." versionString=versionString//TRIM(NumberToVString(CMFE_MINOR_VERSION,"*",err,error)) diff --git a/src/computation_routines.f90 b/src/computation_routines.f90 index 9ccfa987..f505edc5 100755 --- a/src/computation_routines.f90 +++ b/src/computation_routines.f90 @@ -73,18 +73,21 @@ MODULE ComputationRoutines !>pointer type to ComputationWorkGroupType TYPE :: ComputationWorkGroupPtrType - TYPE(ComputationWorkGroupType), POINTER :: ptr + TYPE(ComputationWorkGroupType), POINTER :: ptr END TYPE ComputationWorkGroupPtrType !>Contains information on logical working groups TYPE :: ComputationWorkGroupType - INTEGER(INTG) :: numberOfComputationNodes !Contains information on a computation node containing a number of processors TYPE ComputationNodeType INTEGER(INTG) :: numberOfProcessors !Contains information on the computation environment the program is running in. TYPE ComputationEnvironmentType - LOGICAL :: cmissMPIInitialised !Finalise a work group and deallocate all memory + RECURSIVE SUBROUTINE Computation_WorkGroupFinalise(workGroup,err,error,*) + + !Argument Variables + TYPE(ComputationWorkGroupType),POINTER :: workGroup !Add the work sub-group to the parent group based on the computation requirements (called by user) + SUBROUTINE Computation_WorkGroupInitialise(workGroup,err,error,*) + + !Argument Variables + TYPE(ComputationWorkGroupType),POINTER, INTENT(OUT) :: workGroup !parentWorkGroup%subWorkGroups(I)%ptr + ALLOCATE(subGroups(parentWorkGroup%numberOfSubGroups+1)) + DO I=1,parentWorkGroup%numberOfSubGroups + subGroups(I)%ptr=>parentWorkGroup%subGroups(I)%ptr ENDDO - !subWorkGroups(1:parentWorkGroup%numberOfSubWorkGroups)=>parentWorkGroup%subWorkGroups(:) + !subGroups(1:parentWorkGroup%numberOfSubGroups)=>parentWorkGroup%subGroups(:) - IF(ALLOCATED(parentWorkGroup%subWorkGroups)) THEN - DEALLOCATE(parentWorkGroup%subWorkGroups) + IF(ALLOCATED(parentWorkGroup%subGroups)) THEN + DEALLOCATE(parentWorkGroup%subGroups) ENDIF - subWorkGroups(1+parentWorkGroup%numberOfSubWorkGroups)%ptr=>newWorkGroup%ptr - ALLOCATE(parentWorkGroup%subWorkGroups(SIZE(subWorkGroups,1))) - DO I=1,SIZE(subWorkGroups,1) - parentWorkGroup%subWorkGroups(I)%ptr => subWorkGroups(I)%ptr + subGroups(1+parentWorkGroup%numberOfSubGroups)%ptr=>newWorkGroup%ptr + ALLOCATE(parentWorkGroup%subGroups(SIZE(subGroups,1))) + DO I=1,SIZE(subGroups,1) + parentWorkGroup%subGroups(I)%ptr => subGroups(I)%ptr ENDDO - !parentWorkGroup%subWorkGroups(:) => subWorkGroups(:) + !parentWorkGroup%subGroups(:) => subGroups(:) - DEALLOCATE(subWorkGroups) - parentWorkGroup%numberOfSubWorkGroups = 1+parentWorkGroup%numberOfSubWorkGroups + DEALLOCATE(subGroups) + parentWorkGroup%numberOfSubGroups = 1+parentWorkGroup%numberOfSubGroups newWorkGroup%ptr%PARENT => parentWorkGroup tmpParentWorkGroup => parentWorkGroup DO WHILE(ASSOCIATED(tmpParentWorkGroup)) !Update the computation number of its ancestors @@ -219,29 +302,29 @@ END SUBROUTINE Computation_WorkGroupSubGroupAdd !================================================================================================================================ ! - !>Create the highest level work group (Default: GROUP_WORLD) - SUBROUTINE Computation_WorkGroupCreateStart(worldWorkGroup,numberOfComputationNodes,err,error,*) + !>Start the creation of a work group + SUBROUTINE Computation_WorkGroupCreateStart(parentWorkGroup,numberOfComputationNodes,workGroup,err,error,*) !Argument Variables - TYPE(ComputationWorkGroupType),POINTER, INTENT(INOUT) :: worldWorkGroup - INTEGER(INTG),INTENT(IN) :: numberOfComputationNodes + TYPE(ComputationWorkGroupType), POINTER, INTENT(INOUT) :: parentWorkGroup !newWorkGroup%ptr + IF(.NOT.ASSOCIATED(parentWorkGroup)) CALL FlagError('Parent work group is not associated.',err,error,*999) + IF(ASSOCIATED(workGroup)) CALL FlagError("Work group is already associated.",err,error,*999) + IF(numberOfComputationNodes<1.OR.numberOfComputationNodes>parentWorkGroup%numberOfAvailableRanks) THEN + localError="The requested number of computation nodes is invalid. The number of computation nodes must be > 0 and <= "// & + & TRIM(NumberToVString(parentWorkGroup%numberOfAvailableRanks,"*",err,error))//"." + CALL FlagError(localError,err,error,*999) ENDIF + + CALL Computation_WorkGroupInitialise(workGroup,err,error,*999) EXITS("Computation_WorkGroupCreateStart") RETURN @@ -271,19 +354,19 @@ RECURSIVE SUBROUTINE Computation_WorkGroupGenerateCompEnviron(workGroup,availabl ALLOCATE(workGroup%computationEnvironment) !Set size of computation nodes in this communicator - workGroup%computationEnvironment%numberOfComputationNodes = workGroup%numberOfComputationNodes + workGroup%computationEnvironment%numberOfWorldComputationNodes = workGroup%numberOfComputationNodes !Determine my processes rank - CALL MPI_COMM_RANK(computationEnvironment%mpiCommunicator,rank,mpiIError) + CALL MPI_COMM_RANK(computationEnvironment%mpiWorldCommunicator,rank,mpiIError) CALL MPI_ERROR_CHECK("MPI_COMM_RANK",mpiIError,err,error,*999) - workGroup%computationEnvironment%myComputationNodeNumber=rank + workGroup%computationEnvironment%myWorldComputationNodeNumber=rank !Fill in the information for every computation node in this group - ALLOCATE(workGroup%computationEnvironment%computationNodes(workGroup%computationEnvironment%numberOfComputationNodes)) - IF(SIZE(availableRankList,1)-workGroup%computationEnvironment%numberOfComputationNodes < 0) THEN + ALLOCATE(workGroup%computationEnvironment%computationNodes(workGroup%computationEnvironment%numberOfWorldComputationNodes)) + IF(SIZE(availableRankList,1)-workGroup%computationEnvironment%numberOfWorldComputationNodes < 0) THEN CALL FlagError("NOT ENOUGH RANKS",err,error,*999) ENDIF - DO rankIdx=1,workGroup%computationEnvironment%numberOfComputationNodes,1 + DO rankIdx=1,workGroup%computationEnvironment%numberOfWorldComputationNodes,1 workGroup%computationEnvironment%computationNodes(rankIdx) = & & computationEnvironment%computationNodes(availableRankList(rankIdx)) ENDDO !rankIdx @@ -293,7 +376,7 @@ RECURSIVE SUBROUTINE Computation_WorkGroupGenerateCompEnviron(workGroup,availabl CALL MPI_ERROR_CHECK("MPI_COMM_RANK",mpiIError,err,error,*999) CALL MPI_GROUP_INCL(originalGroup,rankIdx-1,availableRankList(1:rankIdx-1),newGroup,mpiIError) !Choose the first I-1 ranks CALL MPI_ERROR_CHECK("MPI_COMM_RANK",mpiIError,err,error,*999) - CALL MPI_COMM_CREATE(MPI_COMM_WORLD,newGroup,workGroup%computationEnvironment%mpiCommunicator,mpiIError) + CALL MPI_COMM_CREATE(MPI_COMM_WORLD,newGroup,workGroup%computationEnvironment%mpiWorldCommunicator,mpiIError) CALL MPI_ERROR_CHECK("MPI_COMM_RANK",mpiIError,err,error,*999) CALL MPI_GROUP_FREE(originalGroup,mpiIError) CALL MPI_ERROR_CHECK("MPI_COMM_RANK",mpiIError,err,error,*999) @@ -301,7 +384,7 @@ RECURSIVE SUBROUTINE Computation_WorkGroupGenerateCompEnviron(workGroup,availabl CALL MPI_ERROR_CHECK("MPI_COMM_RANK",mpiIError,err,error,*999) !Shrink the availableRankList - ALLOCATE(newAvailableRankList(SIZE(availableRankList,1)-workGroup%computationEnvironment%numberOfComputationNodes)) + ALLOCATE(newAvailableRankList(SIZE(availableRankList,1)-workGroup%computationEnvironment%numberOfWorldComputationNodes)) newAvailableRankList(1:SIZE(newAvailableRankList)) = availableRankList(rankIdx:SIZE(availableRankList,1)) DEALLOCATE(availableRankList) ALLOCATE(availableRankList(SIZE(newAvailableRankList,1))) @@ -310,8 +393,8 @@ RECURSIVE SUBROUTINE Computation_WorkGroupGenerateCompEnviron(workGroup,availabl workGroup%computationEnvironmentFinished = .TRUE. !Recursively do this to all its subgroups - DO subGroupIdx=1,workGroup%numberOfSubWorkGroups,1 - CALL Computation_WorkGroupGenerateCompEnviron(workGroup%subWorkGroups(subGroupIdx)%ptr,& + DO subGroupIdx=1,workGroup%numberOfSubGroups,1 + CALL Computation_WorkGroupGenerateCompEnviron(workGroup%subGroups(subGroupIdx)%ptr,& & availableRankList,err,error,*999) ENDDO !subGroupIdx @@ -345,12 +428,12 @@ SUBROUTINE Computation_WorkGroupCreateFinish(worldWorkGroup,err,error,*) worldWorkGroup%computationEnvironmentFinished = .TRUE. !generate the communicators for subgroups if any - ALLOCATE(availableRankList(worldWorkGroup%computationEnvironment%numberOfComputationNodes)) + ALLOCATE(availableRankList(worldWorkGroup%computationEnvironment%numberOfWorldComputationNodes)) DO rankIdx=0,SIZE(availableRankList,1)-1 availableRankList(rankIdx+1) = rankIdx ENDDO !rankIdx - DO subGroupIdx=1,worldWorkGroup%numberOfSubWorkGroups,1 - CALL Computation_WorkGroupGenerateCompEnviron(worldWorkGroup%subWorkGroups(subGroupIdx)%ptr,availableRankList, & + DO subGroupIdx=1,worldWorkGroup%numberOfSubGroups,1 + CALL Computation_WorkGroupGenerateCompEnviron(worldWorkGroup%subGroups(subGroupIdx)%ptr,availableRankList, & & err,error,*999) ENDDO !subGroupIdx @@ -366,7 +449,7 @@ END SUBROUTINE Computation_WorkGroupCreateFinish ! !>Finalises the computation node data structures and deallocates all memory. - SUBROUTINE ComputationEnvironment_ComputationNodeFinalise(computationNode,err,error,*) + SUBROUTINE Computation_ComputationNodeFinalise(computationNode,err,error,*) !Argument Variables TYPE(ComputationNodeType),INTENT(INOUT) :: computationNode !Initialises the computation node data structures. - SUBROUTINE ComputationEnvironment_ComputationNodeInitialise(computationNode,rank,err,error,*) + SUBROUTINE Computation_ComputationNodeInitialise(computationNode,rank,err,error,*) !Argument Variables TYPE(ComputationNodeType), INTENT(OUT) :: computationNode !Finalises the data structure containing the MPI type information for the ComputationNodeType. - SUBROUTINE ComputationEnvironment_ComputationNodeTypeFinalise(err,error,*) + !>Finalises the MPI computation node type data structure and deallocates all memory. + SUBROUTINE Computation_MPIComputationNodeFinalise(mpiComputationNode,err,error,*) !Argument Variables + TYPE(MPIComputationNodeType) :: mpiComputationNode !Initialises the data structure containing the MPI type information for the ComputationNodeType. - SUBROUTINE ComputationEnvironment_ComputationNodeTypeInitialise(computationNode,err,error,*) + SUBROUTINE Computation_MPIComputationNodeInitialise(computationEnvironment,rank,err,error,*) !Argument Variables - TYPE(ComputationNodeType), INTENT(IN) :: computationNode !computationEnvironment%numberOfWorldComputationNodes) THEN + localError="The specified rank of "//TRIM(NumberToVString(rank,"*",err,error))// & + & " is invalid. The rank should be >= 0 and <= "// & + & TRIM(NumberToVString(computationEnvironment%numberOfWorldComputationNodes,"*",err,error))//"." + CALL FlagError(localError,err,error,*999) + ENDIF - mpiComputationNodeTypeData%mpiType=MPI_DATATYPE_NULL + computationEnvironment%mpiComputationNode%mpiType=MPI_DATATYPE_NULL - mpiComputationNodeTypeData%numberOfBlocks=4 - mpiComputationNodeTypeData%types=[MPI_INTEGER,MPI_INTEGER,MPI_INTEGER,MPI_CHARACTER] - mpiComputationNodeTypeData%blockLengths=[1,1,1,MPI_MAX_PROCESSOR_NAME] + computationEnvironment%mpiComputationNode%numberOfBlocks=4 + computationEnvironment%mpiComputationNode%types=[MPI_INTEGER,MPI_INTEGER,MPI_INTEGER,MPI_CHARACTER] + computationEnvironment%mpiComputationNode%blockLengths=[1,1,1,MPI_MAX_PROCESSOR_NAME] - CALL MPI_GET_ADDRESS(computationNode%numberOfProcessors,mpiComputationNodeTypeData%displacements(1),mpiIError) + CALL MPI_GET_ADDRESS(computationEnvironment%computationNodes(rank)%numberOfProcessors, & + & computationEnvironment%mpiComputationNode%displacements(1),mpiIError) CALL MPI_ERROR_CHECK("MPI_GET_ADDRESS",mpiIError,err,error,*999) - CALL MPI_GET_ADDRESS(computationNode%RANK,mpiComputationNodeTypeData%displacements(2),mpiIError) + CALL MPI_GET_ADDRESS(computationEnvironment%computationNodes(rank)%rank, & + & computationEnvironment%mpiComputationNode%displacements(2),mpiIError) CALL MPI_ERROR_CHECK("MPI_GET_ADDRESS",mpiIError,err,error,*999) - CALL MPI_GET_ADDRESS(computationNode%nodeNameLength,mpiComputationNodeTypeData%displacements(3),mpiIError) + CALL MPI_GET_ADDRESS(computationEnvironment%computationNodes(rank)%nodeNameLength, & + & computationEnvironment%mpiComputationNode%displacements(3),mpiIError) CALL MPI_ERROR_CHECK("MPI_GET_ADDRESS",mpiIError,err,error,*999) !CPB 19/02/07 AIX compiler complains about the type of the first parameter i.e., the previous 3 have been integers !and this one is not so cast the type. - CALL MPI_GET_ADDRESS(computationNode%nodeName,mpiComputationNodeTypeData%displacements(4),mpiIError) + CALL MPI_GET_ADDRESS(computationEnvironment%computationNodes(rank)%nodeName, & + & computationEnvironment%mpiComputationNode%displacements(4),mpiIError) CALL MPI_ERROR_CHECK("MPI_GET_ADDRESS",mpiIError,err,error,*999) - DO i=4,1,-1 - mpiComputationNodeTypeData%displacements(I)=mpiComputationNodeTypeData%displacements(I)- & - & mpiComputationNodeTypeData%displacements(1) - ENDDO !i - - CALL MPI_TYPE_CREATE_STRUCT(mpiComputationNodeTypeData%numberOfBlocks,mpiComputationNodeTypeData%blockLengths, & - & mpiComputationNodeTypeData%displacements,mpiComputationNodeTypeData%types, & - & mpiComputationNodeTypeData%mpiType,mpiIError) + DO blockIdx=4,1,-1 + computationEnvironment%mpiComputationNode%displacements(blockIdx)= & + & computationEnvironment%mpiComputationNode%displacements(blockIdx)- & + & computationEnvironment%mpiComputationNode%displacements(1) + ENDDO !blockIdx + + CALL MPI_TYPE_CREATE_STRUCT(computationEnvironment%mpiComputationNode%numberOfBlocks, & + & computationEnvironment%mpiComputationNode%blockLengths, & + & computationEnvironment%mpiComputationNode%displacements, & + & computationEnvironment%mpiComputationNode%types, & + & computationEnvironment%mpiComputationNode%mpiType,mpiIError) CALL MPI_ERROR_CHECK("MPI_TYPE_CREATE_STRUCT",mpiIError,err,error,*999) - CALL MPI_TYPE_COMMIT(mpiComputationNodeTypeData%mpiType, mpiIError) + CALL MPI_TYPE_COMMIT(computationEnvironment%mpiComputationNode%mpiType,mpiIError) CALL MPI_ERROR_CHECK("MPI_TYPE_COMMIT",mpiIError,err,error,*999) - IF(DIAGNOSTICS3) THEN + IF(diagnostics1) THEN CALL WriteString(DIAGNOSTIC_OUTPUT_TYPE,"MPI Computation Node Type Data:",err,error,*999) - CALL WriteStringValue(DIAGNOSTIC_OUTPUT_TYPE," MPI type = ",mpiComputationNodeTypeData%mpiType,err,error,*999) - CALL WriteStringValue(DIAGNOSTIC_OUTPUT_TYPE," Number blocks = ",mpiComputationNodeTypeData%numberOfBlocks,err,error,*999) - CALL WriteStringVector(DIAGNOSTIC_OUTPUT_TYPE,1,1,mpiComputationNodeTypeData%numberOfBlocks,4,4, & - & mpiComputationNodeTypeData%types,'(" Block types =",4(X,I15))','(15X,4(X,I15))',err,error,*999) - CALL WriteStringVector(DIAGNOSTIC_OUTPUT_TYPE,1,1,mpiComputationNodeTypeData%numberOfBlocks,8,8, & - & mpiComputationNodeTypeData%blockLengths,'(" Block lengths =",8(X,I5))','(17X,8(X,I5))',err,error,*999) - CALL WriteStringVector(DIAGNOSTIC_OUTPUT_TYPE,1,1,mpiComputationNodeTypeData%numberOfBlocks,8,8, & - & mpiComputationNodeTypeData%displacements,'(" Displacements =",8(X,I5))','(17X,8(X,I5))',err,error,*999) + CALL WriteStringValue(DIAGNOSTIC_OUTPUT_TYPE," MPI type = ", & + & computationEnvironment%mpiComputationNode%mpiType,err,error,*999) + CALL WriteStringValue(DIAGNOSTIC_OUTPUT_TYPE," Number of blocks = ", & + & computationEnvironment%mpiComputationNode%numberOfBlocks,err,error,*999) + CALL WriteStringVector(DIAGNOSTIC_OUTPUT_TYPE,1,1,computationEnvironment%mpiComputationNode%numberOfBlocks,4,4, & + & computationEnvironment%mpiComputationNode%types,'(" Block types =",4(X,I15))','(15X,4(X,I15))',err,error,*999) + CALL WriteStringVector(DIAGNOSTIC_OUTPUT_TYPE,1,1,computationEnvironment%mpiComputationNode%numberOfBlocks,8,8, & + & computationEnvironment%mpiComputationNode%blockLengths,'(" Block lengths =",8(X,I5))','(17X,8(X,I5))',err,error,*999) + CALL WriteStringVector(DIAGNOSTIC_OUTPUT_TYPE,1,1,computationEnvironment%mpiComputationNode%numberOfBlocks,8,8, & + & computationEnvironment%mpiComputationNode%displacements,'(" Displacements =",8(X,I5))','(17X,8(X,I5))',err,error,*999) ENDIF - EXITS("ComputationEnvironment_ComputationNodeTypeInitialise") + EXITS("Computation_MPIComputationNodeInitialise") RETURN -999 CALL ComputationEnvironment_ComputationNodeTypeFinalise(err,error,*998) -998 ERRORS("ComputationEnvironment_ComputationNodeTypeInitialise",err,error) - EXITS("ComputationEnvironment_ComputationNodeTypeInitialise") +999 CALL Computation_MPIComputationNodeFinalise(computationEnvironment%mpiComputationNode,dummyErr,dummyError,*998) +998 ERRORS("Computation_MPIComputationNodeInitialise",err,error) + EXITS("Computation_MPIComputationNodeInitialise") RETURN 1 - END SUBROUTINE ComputationEnvironment_ComputationNodeTypeInitialise + END SUBROUTINE Computation_MPIComputationNodeInitialise ! !================================================================================================================================= ! !>Finalises the computation environment data structures and deallocates all memory. - SUBROUTINE Computation_EnvironmentFinalise(err,error,*) + SUBROUTINE Computation_ComputationEnvironmentFinalise(computationEnvironment,err,error,*) !Argument Variables + TYPE(ComputationEnvironmentType) :: computationEnvironment !Initialises the computation environment data structures. - SUBROUTINE Computation_EnvironmentInitialise(err,error,*) + SUBROUTINE Computation_ComputationEnvironmentInitialise(computationEnvironment,err,error,*) !Argument Variables + TYPE(ComputationEnvironmentType) :: computationEnvironment !Finalises the computation data structures and deallocates all memory. + SUBROUTINE Computation_Finalise(err,error,*) - EXITS("Computation_EnvironmentInitialise") + !Argument Variables + INTEGER(INTG), INTENT(OUT) :: err !Initialises the computation data structures. + SUBROUTINE Computation_Initialise(err,error,*) + + !Argument Variables + INTEGER(INTG), INTENT(OUT) :: err !1) THEN + IF(numberOfWorldComputationNodes>1) THEN !Use MPI !Allocate arrays for MPI communication ALLOCATE(globalToLocalNumberOfClosestCandidates(numberOfDataPoints),STAT=err) IF(err/=0) CALL FlagError("Could not allocate global to local number of closest elements.",err,error,*999) - ALLOCATE(globalNumberOfClosestCandidates(numberOfComputationNodes),STAT=err) + ALLOCATE(globalNumberOfClosestCandidates(numberOfWorldComputationNodes),STAT=err) IF(err/=0) CALL FlagError("Could not allocate global number of closest candidates.",err,error,*999) - ALLOCATE(globalMPIDisplacements(numberOfComputationNodes),STAT=err) + ALLOCATE(globalMPIDisplacements(numberOfWorldComputationNodes),STAT=err) IF(err/=0) CALL FlagError("Could not allocate global MPI displacements.",err,error,*999) - ALLOCATE(globalNumberOfProjectedPoints(numberOfComputationNodes),STAT=err) + ALLOCATE(globalNumberOfProjectedPoints(numberOfWorldComputationNodes),STAT=err) IF(err/=0) CALL FlagError("Could not allocate all number of projected points.",err,error,*999) ALLOCATE(projectionExitTag(numberOfDataPoints),STAT=err) IF(err/=0) CALL FlagError("Could not allocate projected.",err,error,*999) @@ -1686,7 +1686,7 @@ SUBROUTINE DataProjection_DataPointsProjectionEvaluate(dataProjection,projection IF(err/=0) CALL FlagError("Could not allocate sorting indices 2.",err,error,*999) !gather and distribute the number of closest elements from all computation nodes CALL MPI_ALLGATHER(numberOfClosestCandidates,1,MPI_INTEGER,globalNumberOfClosestCandidates,1,MPI_INTEGER, & - & computationEnvironment%mpiCommunicator,MPIIError) + & computationEnvironment%mpiWorldCommunicator,MPIIError) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPIIError,err,error,*999) !Sum all number of closest candidates from all computation nodes totalNumberOfClosestCandidates=SUM(globalNumberOfClosestCandidates,1) @@ -1704,14 +1704,14 @@ SUBROUTINE DataProjection_DataPointsProjectionEvaluate(dataProjection,projection CALL MPI_ERROR_CHECK("MPI_TYPE_COMMIT",MPIIError,err,error,*999) !Create displacement vectors for MPI_ALLGATHERV globalMPIDisplacements(1)=0 - DO computationNodeIdx=1,(numberOfComputationNodes-1) + DO computationNodeIdx=1,(numberOfWorldComputationNodes-1) globalMPIDisplacements(computationNodeIdx+1)=globalMPIDisplacements(computationNodeIdx)+ & & globalNumberOfClosestCandidates(computationNodeIdx) ENDDO !computationNodeIdx !Share closest element distances between all domains CALL MPI_ALLGATHERV(closestDistances(1,1),numberOfClosestCandidates,MPIClosestDistances, & & globalClosestDistances,globalNumberOfClosestCandidates,globalMPIDisplacements, & - & MPIClosestDistances,computationEnvironment%mpiCommunicator,MPIIError) + & MPIClosestDistances,computationEnvironment%mpiWorldCommunicator,MPIIError) CALL MPI_ERROR_CHECK("MPI_ALLGATHERV",MPIIError,err,error,*999) reducedNumberOfCLosestCandidates=MIN(dataProjection%numberOfClosestElements,totalNumberOfClosestCandidates) projectedDistance(2,:)=myComputationNode @@ -1818,47 +1818,47 @@ SUBROUTINE DataProjection_DataPointsProjectionEvaluate(dataProjection,projection END SELECT !Find the shortest projected distance in all domains CALL MPI_ALLREDUCE(MPI_IN_PLACE,projectedDistance,numberOfDataPoints,MPI_2DOUBLE_PRECISION,MPI_MINLOC, & - & computationEnvironment%mpiCommunicator,MPIIError) + & computationEnvironment%mpiWorldCommunicator,MPIIError) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPIIError,err,error,*999) !Sort the computation node/rank from 0 to number of computation node CALL Sorting_BubbleIndexSort(projectedDistance(2,:),sortingIndices2,err,error,*999) - DO computationNodeIdx=0,(numberOfComputationNodes-1) + DO computationNodeIdx=0,(numberOfWorldComputationNodes-1) globalNumberOfProjectedPoints(computationNodeIdx+1)=COUNT(ABS(projectedDistance(2,:)- & & REAL(computationNodeIdx))1 + ENDIF !numberOfWorldComputationNodes>1 !Compute full elemental xi IF(dataProjection%numberOfXi==dataProjection%numberOfElementXi) THEN DO dataPointIdx=1,numberOfDataPoints @@ -4691,7 +4691,7 @@ SUBROUTINE DataProjection_ResultAnalysisOutput(dataProjection,filename,err,error TYPE(VARYING_STRING), INTENT(OUT) :: error !=1) THEN - IF(numberOfComputationNodes>1) THEN - WRITE(analFilename,('(A,A,I0)')) filename(1:filenameLength),".opdataproj.",myComputationNodeNumber + IF(numberOfWorldComputationNodes>1) THEN + WRITE(analFilename,('(A,A,I0)')) filename(1:filenameLength),".opdataproj.",myWorldComputationNodeNumber ELSE analFilename=filename(1:filenameLength)//".opdataproj" ENDIF diff --git a/src/distributed_matrix_vector.f90 b/src/distributed_matrix_vector.f90 index 27f1c425..f43ba74e 100755 --- a/src/distributed_matrix_vector.f90 +++ b/src/distributed_matrix_vector.f90 @@ -2713,7 +2713,7 @@ SUBROUTINE DISTRIBUTED_MATRIX_PETSC_CREATE_FINISH(PETSC_MATRIX,ERR,ERROR,*) !Set up the matrix ALLOCATE(PETSC_MATRIX%DATA_DP(PETSC_MATRIX%DATA_SIZE),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate PETSc matrix data.",ERR,ERROR,*999) - CALL Petsc_MatCreateDense(computationEnvironment%mpiCommunicator,PETSC_MATRIX%M,PETSC_MATRIX%N, & + CALL Petsc_MatCreateDense(computationEnvironment%mpiWorldCommunicator,PETSC_MATRIX%M,PETSC_MATRIX%N, & & PETSC_MATRIX%GLOBAL_M,PETSC_MATRIX%GLOBAL_N,PETSC_MATRIX%DATA_DP,PETSC_MATRIX%MATRIX,ERR,ERROR,*999) CASE(DISTRIBUTED_MATRIX_DIAGONAL_STORAGE_TYPE) PETSC_MATRIX%NUMBER_NON_ZEROS=PETSC_MATRIX%M @@ -2733,7 +2733,7 @@ SUBROUTINE DISTRIBUTED_MATRIX_PETSC_CREATE_FINISH(PETSC_MATRIX,ERR,ERROR,*) PETSC_MATRIX%DIAGONAL_NUMBER_NON_ZEROS=1 PETSC_MATRIX%OFFDIAGONAL_NUMBER_NON_ZEROS=0 !Create the PETsc AIJ matrix - CALL Petsc_MatCreateAIJ(computationEnvironment%mpiCommunicator,PETSC_MATRIX%M,PETSC_MATRIX%N, & + CALL Petsc_MatCreateAIJ(computationEnvironment%mpiWorldCommunicator,PETSC_MATRIX%M,PETSC_MATRIX%N, & & PETSC_MATRIX%GLOBAL_M,PETSC_MATRIX%GLOBAL_N,PETSC_NULL_INTEGER,PETSC_MATRIX%DIAGONAL_NUMBER_NON_ZEROS, & & PETSC_NULL_INTEGER,PETSC_MATRIX%OFFDIAGONAL_NUMBER_NON_ZEROS,PETSC_MATRIX%MATRIX,ERR,ERROR,*999) CASE(DISTRIBUTED_MATRIX_COLUMN_MAJOR_STORAGE_TYPE) @@ -2744,7 +2744,7 @@ SUBROUTINE DISTRIBUTED_MATRIX_PETSC_CREATE_FINISH(PETSC_MATRIX,ERR,ERROR,*) IF(ALLOCATED(PETSC_MATRIX%DIAGONAL_NUMBER_NON_ZEROS)) THEN IF(ALLOCATED(PETSC_MATRIX%OFFDIAGONAL_NUMBER_NON_ZEROS)) THEN !Create the PETSc AIJ matrix - CALL Petsc_MatCreateAIJ(computationEnvironment%mpiCommunicator,PETSC_MATRIX%M,PETSC_MATRIX%N, & + CALL Petsc_MatCreateAIJ(computationEnvironment%mpiWorldCommunicator,PETSC_MATRIX%M,PETSC_MATRIX%N, & & PETSC_MATRIX%GLOBAL_M,PETSC_MATRIX%GLOBAL_N,PETSC_NULL_INTEGER,PETSC_MATRIX%DIAGONAL_NUMBER_NON_ZEROS, & & PETSC_NULL_INTEGER,PETSC_MATRIX%OFFDIAGONAL_NUMBER_NON_ZEROS,PETSC_MATRIX%MATRIX,ERR,ERROR,*999) !Set matrix options @@ -7675,7 +7675,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_PETSC_CREATE_FINISH(PETSC_VECTOR,ERR,ERROR,*) IF(ASSOCIATED(DOMAIN_MAPPING)) THEN !Create the PETSc vector PETSC_VECTOR%DATA_SIZE=PETSC_VECTOR%N - CALL Petsc_VecCreateMPI(computationEnvironment%mpiCommunicator,PETSC_VECTOR%N,PETSC_VECTOR%GLOBAL_N, & + CALL Petsc_VecCreateMPI(computationEnvironment%mpiWorldCommunicator,PETSC_VECTOR%N,PETSC_VECTOR%GLOBAL_N, & & PETSC_VECTOR%VECTOR,ERR,ERROR,*999) !Set up the Local to Global Mappings DO i=1,PETSC_VECTOR%N @@ -8230,7 +8230,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_BUFFER_SIZE,MPI_INTEGER, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER, & - & computationEnvironment%mpiCommunicator, & + & computationEnvironment%mpiWorldCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_IRECV",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8243,7 +8243,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive comm = ", & - & computationEnvironment%mpiCommunicator,ERR,ERROR,*999) + & computationEnvironment%mpiWorldCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,ERR,ERROR,*999) ENDIF @@ -8252,7 +8252,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_BUFFER_SIZE,MPI_REAL, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER, & - & computationEnvironment%mpiCommunicator, & + & computationEnvironment%mpiWorldCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_IRECV",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8265,7 +8265,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive comm = ", & - & computationEnvironment%mpiCommunicator,ERR,ERROR,*999) + & computationEnvironment%mpiWorldCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,ERR,ERROR,*999) ENDIF @@ -8274,7 +8274,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_BUFFER_SIZE,MPI_DOUBLE_PRECISION, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER, & - & computationEnvironment%mpiCommunicator, & + & computationEnvironment%mpiWorldCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_IRECV",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8287,7 +8287,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive comm = ", & - & computationEnvironment%mpiCommunicator,ERR,ERROR,*999) + & computationEnvironment%mpiWorldCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,ERR,ERROR,*999) ENDIF @@ -8296,7 +8296,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_BUFFER_SIZE,MPI_LOGICAL, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER, & - & computationEnvironment%mpiCommunicator, & + & computationEnvironment%mpiWorldCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_IRECV",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8309,7 +8309,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive comm = ", & - & computationEnvironment%mpiCommunicator,ERR,ERROR,*999) + & computationEnvironment%mpiWorldCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,ERR,ERROR,*999) ENDIF @@ -8331,7 +8331,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_BUFFER_SIZE,MPI_INTEGER, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER, & - & computationEnvironment%mpiCommunicator, & + & computationEnvironment%mpiWorldCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ISEND",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8344,7 +8344,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send comm = ", & - & computationEnvironment%mpiCommunicator,ERR,ERROR,*999) + & computationEnvironment%mpiWorldCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,ERR,ERROR,*999) ENDIF @@ -8353,7 +8353,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_BUFFER_SIZE,MPI_REAL, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER, & - & computationEnvironment%mpiCommunicator, & + & computationEnvironment%mpiWorldCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ISEND",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8366,7 +8366,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send comm = ", & - & computationEnvironment%mpiCommunicator,ERR,ERROR,*999) + & computationEnvironment%mpiWorldCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,ERR,ERROR,*999) ENDIF @@ -8375,7 +8375,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_BUFFER_SIZE,MPI_DOUBLE_PRECISION, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER, & - & computationEnvironment%mpiCommunicator, & + & computationEnvironment%mpiWorldCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ISEND",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8387,8 +8387,8 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER,ERR,ERROR,*999) - CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send comm = ",computationEnvironment%mpiCommunicator, & - & ERR,ERROR,*999) + CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send comm = ",computationEnvironment% & + & mpiWorldCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,ERR,ERROR,*999) ENDIF @@ -8397,7 +8397,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_BUFFER_SIZE,MPI_LOGICAL, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER, & - & computationEnvironment%mpiCommunicator, & + & computationEnvironment%mpiWorldCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ISEND",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8410,7 +8410,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send comm = ", & - & computationEnvironment%mpiCommunicator,ERR,ERROR,*999) + & computationEnvironment%mpiWorldCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,ERR,ERROR,*999) ENDIF diff --git a/src/domain_mappings.f90 b/src/domain_mappings.f90 index d8759a83..8fb51b61 100755 --- a/src/domain_mappings.f90 +++ b/src/domain_mappings.f90 @@ -159,7 +159,7 @@ SUBROUTINE DOMAIN_MAPPINGS_GLOBAL_TO_LOCAL_GET(DOMAIN_MAPPING,GLOBAL_NUMBER,LOCA IF(ASSOCIATED(DOMAIN_MAPPING)) THEN IF(GLOBAL_NUMBER>=1.AND.GLOBAL_NUMBER<=DOMAIN_MAPPING%NUMBER_OF_GLOBAL) THEN IF(DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(GLOBAL_NUMBER)%DOMAIN_NUMBER(1)== & - & computationEnvironment%myComputationNodeNumber) THEN + & computationEnvironment%myWorldComputationNodeNumber) THEN LOCAL_NUMBER=DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(GLOBAL_NUMBER)%LOCAL_NUMBER(1) LOCAL_EXISTS=.TRUE. ENDIF @@ -192,7 +192,7 @@ SUBROUTINE DOMAIN_MAPPINGS_LOCAL_FROM_GLOBAL_CALCULATE(DOMAIN_MAPPING,ERR,ERROR, TYPE(VARYING_STRING), INTENT(OUT) :: ERROR !0) THEN TOTAL_NUMBER_OF_ADJACENT_DOMAINS=TOTAL_NUMBER_OF_ADJACENT_DOMAINS+1 - IF(domain_no==myComputationNodeNumber) NUMBER_OF_ADJACENT_DOMAINS=NUMBER_OF_ADJACENT_DOMAINS+1 + IF(domain_no==myWorldComputationNodeNumber) NUMBER_OF_ADJACENT_DOMAINS=NUMBER_OF_ADJACENT_DOMAINS+1 ENDIF ENDIF ENDDO !domain_no2 @@ -335,7 +335,7 @@ SUBROUTINE DOMAIN_MAPPINGS_LOCAL_FROM_GLOBAL_CALCULATE(DOMAIN_MAPPING,ERR,ERROR, DO domain_idx=1,DOMAIN_MAPPING%NUMBER_OF_ADJACENT_DOMAINS CALL DOMAIN_MAPPINGS_ADJACENT_DOMAIN_INITIALISE(DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx),ERR,ERROR,*999) domain_no= & - & DOMAIN_MAPPING%ADJACENT_DOMAINS_LIST(DOMAIN_MAPPING%ADJACENT_DOMAINS_PTR(myComputationNodeNumber)+domain_idx-1) + & DOMAIN_MAPPING%ADJACENT_DOMAINS_LIST(DOMAIN_MAPPING%ADJACENT_DOMAINS_PTR(myWorldComputationNodeNumber)+domain_idx-1) DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER=domain_no ADJACENT_DOMAIN_MAP(domain_no)=domain_idx NULLIFY(GHOST_SEND_LISTS(domain_idx)%PTR) @@ -368,7 +368,7 @@ SUBROUTINE DOMAIN_MAPPINGS_LOCAL_FROM_GLOBAL_CALCULATE(DOMAIN_MAPPING,ERR,ERROR, domain_no=DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(global_number)%DOMAIN_NUMBER(domain_idx) local_type=DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_TYPE(domain_idx) IF(local_type/=DOMAIN_LOCAL_GHOST) THEN - IF(domain_no==myComputationNodeNumber) SEND_GLOBAL=.TRUE. + IF(domain_no==myWorldComputationNodeNumber) SEND_GLOBAL=.TRUE. IF(RECEIVE_FROM_DOMAIN==-1) THEN RECEIVE_FROM_DOMAIN=domain_no ELSE @@ -390,7 +390,7 @@ SUBROUTINE DOMAIN_MAPPINGS_LOCAL_FROM_GLOBAL_CALCULATE(DOMAIN_MAPPING,ERR,ERROR, domain_no=DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(global_number)%DOMAIN_NUMBER(domain_idx) local_number=DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_NUMBER(domain_idx) local_type=DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_TYPE(domain_idx) - IF(domain_no==myComputationNodeNumber) THEN + IF(domain_no==myWorldComputationNodeNumber) THEN DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_number)=global_number SELECT CASE(DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_TYPE(domain_idx)) CASE(DOMAIN_LOCAL_INTERNAL) diff --git a/src/equations_set_routines.f90 b/src/equations_set_routines.f90 index 24702e6a..a10803a7 100644 --- a/src/equations_set_routines.f90 +++ b/src/equations_set_routines.f90 @@ -6305,7 +6305,7 @@ SUBROUTINE EQUATIONS_SET_BOUNDARY_CONDITIONS_INCREMENT(EQUATIONS_SET,BOUNDARY_CO TYPE(BOUNDARY_CONDITIONS_DIRICHLET_TYPE), POINTER :: DIRICHLET_BOUNDARY_CONDITIONS TYPE(BOUNDARY_CONDITIONS_PRESSURE_INCREMENTED_TYPE), POINTER :: PRESSURE_INCREMENTED_BOUNDARY_CONDITIONS INTEGER(INTG) :: variable_idx,variable_type,dirichlet_idx,dirichlet_dof_idx,neumann_point_dof - INTEGER(INTG) :: condition_idx, condition_global_dof, condition_local_dof, myComputationNodeNumber + INTEGER(INTG) :: condition_idx, condition_global_dof, condition_local_dof, myWorldComputationNodeNumber REAL(DP), POINTER :: FULL_LOADS(:),CURRENT_LOADS(:), PREV_LOADS(:) REAL(DP) :: FULL_LOAD, CURRENT_LOAD, NEW_LOAD, PREV_LOAD TYPE(VARYING_STRING) :: localError @@ -6320,7 +6320,7 @@ SUBROUTINE EQUATIONS_SET_BOUNDARY_CONDITIONS_INCREMENT(EQUATIONS_SET,BOUNDARY_CO NULLIFY(PREV_LOADS) NULLIFY(CURRENT_LOADS) - myComputationNodeNumber=ComputationEnvironment_NodeNumberGet(err,error) + myWorldComputationNodeNumber=ComputationEnvironment_NodeNumberGet(err,error) !Take the stored load, scale it down appropriately then apply to the unknown variables IF(ASSOCIATED(EQUATIONS_SET)) THEN @@ -6367,7 +6367,7 @@ SUBROUTINE EQUATIONS_SET_BOUNDARY_CONDITIONS_INCREMENT(EQUATIONS_SET,BOUNDARY_CO & BOUNDARY_CONDITION_MOVED_WALL_INCREMENTED) !Convert dof index to local index IF(DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(dirichlet_dof_idx)%DOMAIN_NUMBER(1)== & - & myComputationNodeNumber) THEN + & myWorldComputationNodeNumber) THEN dirichlet_dof_idx=DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(dirichlet_dof_idx)%LOCAL_NUMBER(1) IF(0=NUMBER_OF_EXNODE_FILES) EXIT ENDIF - !IF(MASTER_COMPUTATION_NUMBER/=myComputationNodeNumber) PRINT * , idx_exnode + !IF(MASTER_COMPUTATION_NUMBER/=myWorldComputationNodeNumber) PRINT * , idx_exnode !goto the start of mesh part - IF(MASTER_COMPUTATION_NUMBER==myComputationNodeNumber) THEN + IF(MASTER_COMPUTATION_NUMBER==myWorldComputationNodeNumber) THEN IF(FILE_END) THEN FILE_ID=1030+idx_exnode @@ -1290,10 +1290,10 @@ SUBROUTINE FIELD_IO_CREATE_FIELDS(NAME, REGION, DECOMPOSITION, FIELD_VALUES_SET_ !broadcasting total_number_of_devs CALL MPI_BCAST(total_number_of_devs,1,MPI_INTEGER,MASTER_COMPUTATION_NUMBER, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_BCAST",MPI_IERROR,ERR,ERROR,*999) - IF(MASTER_COMPUTATION_NUMBER/=myComputationNodeNumber) THEN + IF(MASTER_COMPUTATION_NUMBER/=myWorldComputationNodeNumber) THEN CALL REALLOCATE( LIST_DEV, total_number_of_devs, & & "Could not allocate memory for nodal derivative index in non-master node", ERR, ERROR, *999 ) ENDIF @@ -1303,15 +1303,15 @@ SUBROUTINE FIELD_IO_CREATE_FIELDS(NAME, REGION, DECOMPOSITION, FIELD_VALUES_SET_ !broadcasting total_number_of_comps CALL MPI_BCAST(LIST_DEV_POS,total_number_of_comps,MPI_INTEGER,MASTER_COMPUTATION_NUMBER, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_BCAST",MPI_IERROR,ERR,ERROR,*999) !broadcasting total_number_of_devs CALL MPI_BCAST(LIST_DEV,total_number_of_devs,MPI_INTEGER,MASTER_COMPUTATION_NUMBER, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_BCAST",MPI_IERROR,ERR,ERROR,*999) !goto the start of mesh part - IF(MASTER_COMPUTATION_NUMBER==myComputationNodeNumber) THEN + IF(MASTER_COMPUTATION_NUMBER==myWorldComputationNodeNumber) THEN !have not touched the end IF((.NOT.FILE_END).AND.SECTION_START.AND.NODE_SECTION) THEN @@ -1363,17 +1363,17 @@ SUBROUTINE FIELD_IO_CREATE_FIELDS(NAME, REGION, DECOMPOSITION, FIELD_VALUES_SET_ IF(VERIFY(CMISS_KEYWORD_NODE, LINE)/=0) NODE_SECTION=.FALSE. ENDIF ENDIF !FILE_END==.FALSE..AND.SECTION_START=.TRUE..AND.NODE_SECTION=.TRUE. - ENDIF !(MASTER_COMPUTATION_NUMBER==myComputationNodeNumber) + ENDIF !(MASTER_COMPUTATION_NUMBER==myWorldComputationNodeNumber) !broadcasting total_number_of_devs CALL MPI_BCAST(LIST_DEV_VALUE,total_number_of_devs,MPI_REAL8,MASTER_COMPUTATION_NUMBER, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_BCAST",MPI_IERROR,ERR,ERROR,*999) CALL MPI_BCAST(NODAL_USER_NUMBER,1,MPI_INTEGER,MASTER_COMPUTATION_NUMBER, & - & computationEnvironment%mpiCommunicator,MPI_IERROR) + & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_BCAST",MPI_IERROR,ERR,ERROR,*999) - !IF(MASTER_COMPUTATION_NUMBER/=myComputationNodeNumber) THEN + !IF(MASTER_COMPUTATION_NUMBER/=myWorldComputationNodeNumber) THEN print *, "user number:" print *, NODAL_USER_NUMBER print *, LIST_DEV_VALUE @@ -1509,7 +1509,7 @@ SUBROUTINE FIELD_IO_FIELDS_IMPORT(NAME, METHOD, REGION, MESH, MESH_USER_NUMBER, INTEGER(INTG), INTENT(OUT) :: ERR !Read the global mesh into one computation node first and then broadcasting to others nodes SUBROUTINE FIELD_IO_IMPORT_GLOBAL_MESH(NAME, REGION, MESH, MESH_USER_NUMBER, MASTER_COMPUTATION_NUMBER, & - & myComputationNodeNumber, &!USER_NODAL_NUMBER_MAP_GLOBAL_NODAL_NUMBER, + & myWorldComputationNodeNumber, &!USER_NODAL_NUMBER_MAP_GLOBAL_NODAL_NUMBER, &MESH_COMPONENTS_OF_FIELD_COMPONENTS, & & COMPONENTS_IN_FIELDS, NUMBER_OF_FIELDS, NUMBER_OF_EXNODE_FILES, ERR, ERROR, *) !Argument variables @@ -1619,7 +1619,7 @@ SUBROUTINE FIELD_IO_IMPORT_GLOBAL_MESH(NAME, REGION, MESH, MESH_USER_NUMBER, MAS TYPE(REGION_TYPE), POINTER :: REGION !Write the header of a group elements using FORTRAN SUBROUTINE FieldIO_ExportElementalGroupHeaderFortran( global_number, MAX_NODE_COMP_INDEX,NUM_OF_SCALING_FACTOR_SETS, & - & LIST_COMP_SCALE, myComputationNodeNumber, elementalInfoSet, sessionHandle, ERR,ERROR, *) + & LIST_COMP_SCALE, myWorldComputationNodeNumber, elementalInfoSet, sessionHandle, ERR,ERROR, *) !Argument variables INTEGER(INTG), INTENT(IN) :: global_number !elementalInfoSet%COMPONENTS(comp_idx)%PTR%DOMAIN !get the domain index for this variable component according to my own computional node number local_number = FindMyLocalDomainNumber( componentDomain%MAPPINGS%ELEMENTS%GLOBAL_TO_LOCAL_MAP( global_number ),& - & myComputationNodeNumber ) + & myWorldComputationNodeNumber ) GROUP_LOCAL_NUMBER(comp_idx)=local_number !use local domain information find the out the maximum number of derivatives DOMAIN_ELEMENTS=>componentDomain%TOPOLOGY%ELEMENTS @@ -3444,13 +3444,13 @@ END SUBROUTINE FieldIO_ExportElementalGroupHeaderFortran ! SUBROUTINE FIELD_IO_EXPORT_ELEMENT_SCALE_FACTORS( sessionHandle, components, componentScales, globalNumber, & - & myComputationNodeNumber, ERR, ERROR, * ) + & myWorldComputationNodeNumber, ERR, ERROR, * ) !Argument variables INTEGER(INTG) :: sessionHandle TYPE(FIELD_IO_COMPONENT_INFO_SET), INTENT(INOUT) :: components ! component%DOMAIN%TOPOLOGY%ELEMENTS domainNodes => component%DOMAIN%TOPOLOGY%NODES @@ -3558,13 +3558,13 @@ END SUBROUTINE FIELD_IO_EXPORT_ELEMENT_SCALE_FACTORS ! !>Write all the elemental information from LOCAL_PROCESS_NODAL_INFO_SET to exelem files - SUBROUTINE FIELD_IO_EXPORT_ELEMENTS_INTO_LOCAL_FILE(ELEMENTAL_INFO_SET, NAME, myComputationNodeNumber, & + SUBROUTINE FIELD_IO_EXPORT_ELEMENTS_INTO_LOCAL_FILE(ELEMENTAL_INFO_SET, NAME, myWorldComputationNodeNumber, & & ERR, ERROR, *) - !the reason that myComputationNodeNumber is used in the argument is for future extension + !the reason that myWorldComputationNodeNumber is used in the argument is for future extension !Argument variables TYPE(FIELD_IO_INFO_SET), INTENT(INOUT) :: ELEMENTAL_INFO_SET !component%DOMAIN%TOPOLOGY%ELEMENTS !get the domain index for this variable component according to my own computional node number local_number = FindMyLocalDomainNumber( DOMAIN_MAPPING_ELEMENTS%GLOBAL_TO_LOCAL_MAP( global_number ), & - & myComputationNodeNumber ) + & myWorldComputationNodeNumber ) !use local domain information find the out the maximum number of derivatives BASIS => DOMAIN_ELEMENTS%ELEMENTS( local_number )%BASIS @@ -3861,7 +3861,7 @@ SUBROUTINE FIELD_IO_EXPORT_ELEMENTS_INTO_LOCAL_FILE(ELEMENTAL_INFO_SET, NAME, my ENDIF CALL FIELD_IO_EXPORT_ELEMENT_SCALE_FACTORS( sessionHandle, components, & - & LIST_COMP_SCALE, global_number, myComputationNodeNumber, ERR, ERROR, *999 ) + & LIST_COMP_SCALE, global_number, myWorldComputationNodeNumber, ERR, ERROR, *999 ) ENDDO !elem_idx @@ -3887,10 +3887,10 @@ END SUBROUTINE FIELD_IO_EXPORT_ELEMENTS_INTO_LOCAL_FILE ! !>Sort the Elemental_info_set according to the type of field variable components - SUBROUTINE FIELD_IO_ELEMENTAL_INFO_SET_SORT(ELEMENTAL_INFO_SET, myComputationNodeNumber, ERR,ERROR,*) + SUBROUTINE FIELD_IO_ELEMENTAL_INFO_SET_SORT(ELEMENTAL_INFO_SET, myWorldComputationNodeNumber, ERR,ERROR,*) !Argument variables TYPE(FIELD_IO_INFO_SET), INTENT(INOUT) :: ELEMENTAL_INFO_SET !& & ELEMENTAL_INFO_SET%COMPONENT_INFO_SET(nn1)%PTR%COMPONENTS(component_idx)%PTR% & & DOMAIN%TOPOLOGY%ELEMENTS @@ -3991,7 +3991,7 @@ SUBROUTINE FIELD_IO_ELEMENTAL_INFO_SET_SORT(ELEMENTAL_INFO_SET, myComputationNod !get the domain index for this variable component according to my own computional node number !local number of nn2'th node in the damain assoicated with component(component_idx) local_number2 = FindMyLocalDomainNumber( DOMAIN_MAPPING_ELEMENTS%GLOBAL_TO_LOCAL_MAP( global_number2 ), & - & myComputationNodeNumber ) + & myWorldComputationNodeNumber ) DOMAIN_ELEMENTS2=>& & ELEMENTAL_INFO_SET%COMPONENT_INFO_SET(nn2)%PTR%COMPONENTS(component_idx)%PTR% & & DOMAIN%TOPOLOGY%ELEMENTS @@ -4281,7 +4281,7 @@ END SUBROUTINE FieldIO_ElementalInfoSetAttachLocalProcess ! TYPE(VARYING_STRING), INTENT(OUT) :: ERROR !Sort nodal information according to the type of field variable component - SUBROUTINE FIELD_IO_NODAL_INFO_SET_SORT(NODAL_INFO_SET, myComputationNodeNumber, ERR,ERROR,*) + SUBROUTINE FIELD_IO_NODAL_INFO_SET_SORT(NODAL_INFO_SET, myWorldComputationNodeNumber, ERR,ERROR,*) !Argument variables TYPE(FIELD_IO_INFO_SET), INTENT(INOUT) :: NODAL_INFO_SET !Write the header of a group nodes using FORTRAIN !SUBROUTINE FIELD_IO_IMPORT_NODAL_GROUP_HEADER_FORTRAN(NODAL_INFO_SET, LOCAL_NODAL_NUMBER, MAX_NUM_OF_NODAL_DERIVATIVES, & - !&myComputationNodeNumber, FILE_ID, ERR,ERROR, *) + !&myWorldComputationNodeNumber, FILE_ID, ERR,ERROR, *) ! !Argument variables ! TYPE(FIELD_IO_INFO_SET), INTENT(INOUT) :: NODAL_INFO_SET !NODAL_INFO_SET%COMPONENT_INFO_SET(LOCAL_NODAL_NUMBER)%& ! &COMPONENTS(comp_idx)%PTR%DOMAIN%MAPPINGS%NODES ! !get the domain index for this variable component according to my own computional node number - ! local_number = FindMyLocalDomainNumber( DOMAIN_MAPPING_NODES%GLOBAL_TO_LOCAL_MAP(global_number), myComputationNodeNumber ) + ! local_number = FindMyLocalDomainNumber( DOMAIN_MAPPING_NODES%GLOBAL_TO_LOCAL_MAP(global_number), myWorldComputationNodeNumber ) ! !use local domain information find the out the maximum number of derivatives ! DOMAIN_NODES=>NODAL_INFO_SET%COMPONENT_INFO_SET(LOCAL_NODAL_NUMBER)%COMPONENTS(comp_idx)%PTR%DOMAIN%TOPOLOGY%NODES ! MAX_NUM_OF_NODAL_DERIVATIVES=MAX(DOMAIN_NODES%NODES(local_number)%NUMBER_OF_DERIVATIVES,MAX_NUM_OF_NODAL_DERIVATIVES) @@ -5091,7 +5091,7 @@ END FUNCTION FIELD_IO_GET_COMPONENT_INFO_LABEL ! DOMAIN_MAPPING_NODES=>NODAL_INFO_SET%COMPONENT_INFO_SET(LOCAL_NODAL_NUMBER)%COMPONENTS(comp_idx)%PTR%& ! &DOMAIN%MAPPINGS%NODES ! !get the domain index for this variable component according to my own computional node number - ! local_number = FindMyLocalDomainNumber( DOMAIN_MAPPING_NODES%GLOBAL_TO_LOCAL_MAP(global_number), myComputationNodeNumber ) + ! local_number = FindMyLocalDomainNumber( DOMAIN_MAPPING_NODES%GLOBAL_TO_LOCAL_MAP(global_number), myWorldComputationNodeNumber ) ! !use local domain information find the out the maximum number of derivatives ! DOMAIN_NODES=>NODAL_INFO_SET%COMPONENT_INFO_SET(LOCAL_NODAL_NUMBER)%COMPONENTS(comp_idx)%PTR%DOMAIN%TOPOLOGY%NODES ! !get the nodal partial derivatives @@ -5137,12 +5137,12 @@ END FUNCTION FIELD_IO_GET_COMPONENT_INFO_LABEL !>Write the header of a group nodes using FORTRAIN SUBROUTINE FIELD_IO_EXPORT_NODAL_GROUP_HEADER_FORTRAN(fieldInfoSet, global_number, MAX_NUM_OF_NODAL_DERIVATIVES, & - &myComputationNodeNumber, sessionHandle, paddingInfo, ERR,ERROR, *) + &myWorldComputationNodeNumber, sessionHandle, paddingInfo, ERR,ERROR, *) !Argument variables TYPE(FIELD_IO_COMPONENT_INFO_SET), INTENT(IN) :: fieldInfoSet INTEGER(INTG), INTENT(IN) :: global_number INTEGER(INTG), INTENT(INOUT) :: MAX_NUM_OF_NODAL_DERIVATIVES !Write all the nodal information from NODAL_INFO_SET to local exnode files - SUBROUTINE FIELD_IO_EXPORT_NODES_INTO_LOCAL_FILE(NODAL_INFO_SET, NAME, myComputationNodeNumber,ERR, ERROR, *) - !the reason that myComputationNodeNumber is used in the argument is for future extension + SUBROUTINE FIELD_IO_EXPORT_NODES_INTO_LOCAL_FILE(NODAL_INFO_SET, NAME, myWorldComputationNodeNumber,ERR, ERROR, *) + !the reason that myWorldComputationNodeNumber is used in the argument is for future extension !Argument variables TYPE(FIELD_IO_INFO_SET), INTENT(INOUT):: NODAL_INFO_SET !Collect nodal information from each MPI process - SUBROUTINE FieldIO_NodelInfoSetAttachLocalProcess(NODAL_INFO_SET, FIELDS, myComputationNodeNumber, ERR,ERROR,*) + SUBROUTINE FieldIO_NodelInfoSetAttachLocalProcess(NODAL_INFO_SET, FIELDS, myWorldComputationNodeNumber, ERR,ERROR,*) !Argument variables TYPE(FIELD_IO_INFO_SET), INTENT(INOUT):: NODAL_INFO_SET !FIELD%VARIABLES(variable_idx)%COMPONENTS(component_idx) - variable_local_ny=1+VARIABLE_LOCAL_DOFS_OFFSETS(myComputationNodeNumber) + variable_local_ny=1+VARIABLE_LOCAL_DOFS_OFFSETS(myWorldComputationNodeNumber) !Allocate and set up global to local domain map for variable mapping IF(ASSOCIATED(FIELD_VARIABLE_DOFS_MAPPING)) THEN variable_global_ny=1+VARIABLE_GLOBAL_DOFS_OFFSET @@ -10828,7 +10828,7 @@ SUBROUTINE FIELD_MAPPINGS_CALCULATE(FIELD,ERR,ERROR,*) DO component_idx=1,FIELD%VARIABLES(variable_idx)%NUMBER_OF_COMPONENTS FIELD_COMPONENT=>FIELD%VARIABLES(variable_idx)%COMPONENTS(component_idx) element_ny=element_ny+1 - variable_local_ny=element_ny+VARIABLE_LOCAL_DOFS_OFFSETS(myComputationNodeNumber) + variable_local_ny=element_ny+VARIABLE_LOCAL_DOFS_OFFSETS(myWorldComputationNodeNumber) element_nyy=element_nyy+1 !Setup dof to parameter map FIELD%VARIABLES(variable_idx)%DOF_TO_PARAM_MAP%DOF_TYPE(1,variable_local_ny)=FIELD_ELEMENT_DOF_TYPE @@ -10935,7 +10935,7 @@ SUBROUTINE FIELD_MAPPINGS_CALCULATE(FIELD,ERR,ERROR,*) FIELD_COMPONENT=>FIELD%VARIABLES(variable_idx)%COMPONENTS(component_idx) DOMAIN=>FIELD_COMPONENT%DOMAIN node_ny=node_ny+1 - variable_local_ny=node_ny+VARIABLE_LOCAL_DOFS_OFFSETS(myComputationNodeNumber) + variable_local_ny=node_ny+VARIABLE_LOCAL_DOFS_OFFSETS(myWorldComputationNodeNumber) node_nyy=node_nyy+1 version_idx=DOMAIN%TOPOLOGY%DOFS%DOF_INDEX(1,ny) derivative_idx=DOMAIN%TOPOLOGY%DOFS%DOF_INDEX(2,ny) @@ -11036,7 +11036,7 @@ SUBROUTINE FIELD_MAPPINGS_CALCULATE(FIELD,ERR,ERROR,*) FIELD_COMPONENT=>FIELD%VARIABLES(variable_idx)%COMPONENTS(component_idx) DOMAIN=>FIELD_COMPONENT%DOMAIN element_ny=element_ny+1 - variable_local_ny=element_ny+VARIABLE_LOCAL_DOFS_OFFSETS(myComputationNodeNumber) + variable_local_ny=element_ny+VARIABLE_LOCAL_DOFS_OFFSETS(myWorldComputationNodeNumber) node_nyy=node_nyy+1 !Setup dof to parameter map FIELD%VARIABLES(variable_idx)%DOF_TO_PARAM_MAP%DOF_TYPE(1,variable_local_ny)=FIELD_GAUSS_POINT_DOF_TYPE diff --git a/src/fieldml_input_routines.f90 b/src/fieldml_input_routines.f90 index 0322f565..a68b76e2 100755 --- a/src/fieldml_input_routines.f90 +++ b/src/fieldml_input_routines.f90 @@ -1261,7 +1261,7 @@ SUBROUTINE FieldmlInput_FieldNodalParametersUpdate( FIELDML_INFO, EVALUATOR_NAME INTEGER(INTG), TARGET :: OFFSETS(2), SIZES(2) REAL(C_DOUBLE), ALLOCATABLE, TARGET :: BUFFER(:) INTEGER(INTG) :: READER - INTEGER(INTG) :: myComputationNodeNumber,nodeDomain,meshComponentNumber + INTEGER(INTG) :: myWorldComputationNodeNumber,nodeDomain,meshComponentNumber ENTERS( "FieldmlInput_FieldNodalParametersUpdate", ERR, ERROR, *999 ) @@ -1312,10 +1312,10 @@ SUBROUTINE FieldmlInput_FieldNodalParametersUpdate( FIELDML_INFO, EVALUATOR_NAME !Default to version 1 of each node derivative (value hardcoded in loop) VERSION_NUMBER = 1 - myComputationNodeNumber = ComputationEnvironment_NodeNumberGet(err,error) + myWorldComputationNodeNumber = ComputationEnvironment_NodeNumberGet(err,error) CALL DECOMPOSITION_MESH_COMPONENT_NUMBER_GET(FIELD%DECOMPOSITION,meshComponentNumber,err,error,*999) CALL DECOMPOSITION_NODE_DOMAIN_GET(FIELD%DECOMPOSITION,NODE_NUMBER,meshComponentNumber,nodeDomain,err,error,*999) - IF(nodeDomain==myComputationNodeNumber) THEN + IF(nodeDomain==myWorldComputationNodeNumber) THEN CALL FIELD_PARAMETER_SET_UPDATE_NODE( FIELD, VARIABLE_TYPE, SET_TYPE, VERSION_NUMBER, & & NO_GLOBAL_DERIV, NODE_NUMBER, COMPONENT_NUMBER, BUFFER( COMPONENT_NUMBER ), ERR, ERROR, *999 ) ENDIF diff --git a/src/fieldml_output_routines.f90 b/src/fieldml_output_routines.f90 index 68cca8a9..a7d0b809 100755 --- a/src/fieldml_output_routines.f90 +++ b/src/fieldml_output_routines.f90 @@ -1532,7 +1532,7 @@ SUBROUTINE FIELDML_OUTPUT_ADD_FIELD_NODE_DOFS( FIELDML_INFO, BASE_NAME, DOF_FORM LOGICAL, ALLOCATABLE :: IS_NODE_BASED(:) TYPE(C_PTR) :: SIZE_POINTER TYPE(VARYING_STRING) :: ARRAY_LOCATION - INTEGER(INTG) :: myComputationNodeNumber,nodeDomain,meshComponentNumber + INTEGER(INTG) :: myWorldComputationNodeNumber,nodeDomain,meshComponentNumber ENTERS( "FIELDML_OUTPUT_ADD_FIELD_NODE_DOFS", ERR, ERROR, *999 ) @@ -1629,10 +1629,10 @@ SUBROUTINE FIELDML_OUTPUT_ADD_FIELD_NODE_DOFS( FIELDML_INFO, BASE_NAME, DOF_FORM !Default to version 1 of each node derivative (value hardcoded in loop) VERSION_NUMBER = 1 - myComputationNodeNumber = ComputationEnvironment_NodeNumberGet(err,error) + myWorldComputationNodeNumber = ComputationEnvironment_NodeNumberGet(err,error) CALL DECOMPOSITION_MESH_COMPONENT_NUMBER_GET(FIELD%DECOMPOSITION,meshComponentNumber,err,error,*999) CALL DECOMPOSITION_NODE_DOMAIN_GET(FIELD%DECOMPOSITION,I,meshComponentNumber,nodeDomain,err,error,*999) - IF(nodeDomain==myComputationNodeNumber) THEN + IF(nodeDomain==myWorldComputationNodeNumber) THEN CALL FIELD_PARAMETER_SET_GET_NODE( FIELD, VARIABLE_TYPE, SET_TYPE, VERSION_NUMBER, & & NO_GLOBAL_DERIV, I, FIELD_COMPONENT_NUMBERS(J), DVALUE, ERR, ERROR, *999 ) ENDIF diff --git a/src/finite_elasticity_routines.f90 b/src/finite_elasticity_routines.f90 index 81036fda..586b1cec 100644 --- a/src/finite_elasticity_routines.f90 +++ b/src/finite_elasticity_routines.f90 @@ -166,7 +166,7 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO !BC stuff INTEGER(INTG),ALLOCATABLE :: INNER_SURFACE_NODES(:),OUTER_SURFACE_NODES(:),TOP_SURFACE_NODES(:),BOTTOM_SURFACE_NODES(:) INTEGER(INTG) :: INNER_NORMAL_XI,OUTER_NORMAL_XI,TOP_NORMAL_XI,BOTTOM_NORMAL_XI,MESH_COMPONENT - INTEGER(INTG) :: myComputationNodeNumber, DOMAIN_NUMBER, MPI_IERROR + INTEGER(INTG) :: myWorldComputationNodeNumber, DOMAIN_NUMBER, MPI_IERROR REAL(DP) :: PIN,POUT,LAMBDA,DEFORMED_Z LOGICAL :: X_FIXED,Y_FIXED,NODE_EXISTS, X_OKAY,Y_OKAY TYPE(VARYING_STRING) :: LOCAL_ERROR @@ -175,7 +175,7 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO ENTERS("FiniteElasticity_BoundaryConditionsAnalyticCalculate",err,error,*999) - myComputationNodeNumber=ComputationEnvironment_NodeNumberGet(err,error) + myWorldComputationNodeNumber=ComputationEnvironment_NodeNumberGet(err,error) IF(ASSOCIATED(EQUATIONS_SET)) THEN IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN @@ -215,7 +215,7 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO user_node=INNER_SURFACE_NODES(node_idx) !Need to test if this node is in current decomposition CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,user_node,1,DOMAIN_NUMBER,err,error,*999) - IF(DOMAIN_NUMBER==myComputationNodeNumber) THEN + IF(DOMAIN_NUMBER==myWorldComputationNodeNumber) THEN !Default to version 1 of each node derivative CALL BOUNDARY_CONDITIONS_SET_NODE(BOUNDARY_CONDITIONS,DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE,1,1, & & user_node,ABS(INNER_NORMAL_XI),BOUNDARY_CONDITION_PRESSURE_INCREMENTED,PIN,err,error,*999) @@ -227,7 +227,7 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO user_node=OUTER_SURFACE_NODES(node_idx) !Need to test if this node is in current decomposition CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,user_node,1,DOMAIN_NUMBER,err,error,*999) - IF(DOMAIN_NUMBER==myComputationNodeNumber) THEN + IF(DOMAIN_NUMBER==myWorldComputationNodeNumber) THEN !Default to version 1 of each node derivative CALL BOUNDARY_CONDITIONS_SET_NODE(BOUNDARY_CONDITIONS,DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE,1,1, & & user_node,ABS(OUTER_NORMAL_XI),BOUNDARY_CONDITION_PRESSURE_INCREMENTED,POUT,err,error,*999) @@ -239,7 +239,7 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO user_node=TOP_SURFACE_NODES(node_idx) !Need to test if this node is in current decomposition CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,user_node,1,DOMAIN_NUMBER,err,error,*999) - IF(DOMAIN_NUMBER==myComputationNodeNumber) THEN + IF(DOMAIN_NUMBER==myWorldComputationNodeNumber) THEN CALL MeshTopology_NodeCheckExists(MESH,1,user_node,NODE_EXISTS,global_node,err,error,*999) IF(.NOT.NODE_EXISTS) CYCLE CALL DOMAIN_MAPPINGS_GLOBAL_TO_LOCAL_GET(NODES_MAPPING,global_node,NODE_EXISTS,local_node,err,error,*999) @@ -257,7 +257,7 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO user_node=BOTTOM_SURFACE_NODES(node_idx) !Need to check this node exists in the current domain CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,user_node,1,DOMAIN_NUMBER,err,error,*999) - IF(DOMAIN_NUMBER==myComputationNodeNumber) THEN + IF(DOMAIN_NUMBER==myWorldComputationNodeNumber) THEN !Default to version 1 of each node derivative CALL BOUNDARY_CONDITIONS_SET_NODE(BOUNDARY_CONDITIONS,DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE,1,1, & & user_node,ABS(BOTTOM_NORMAL_XI),BOUNDARY_CONDITION_FIXED,0.0_DP,err,error,*999) @@ -270,7 +270,7 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO DO node_idx=1,SIZE(BOTTOM_SURFACE_NODES,1) user_node=BOTTOM_SURFACE_NODES(node_idx) CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,user_node,1,DOMAIN_NUMBER,err,error,*999) - IF(DOMAIN_NUMBER==myComputationNodeNumber) THEN + IF(DOMAIN_NUMBER==myWorldComputationNodeNumber) THEN CALL MeshTopology_NodeCheckExists(MESH,1,user_node,NODE_EXISTS,global_node,err,error,*999) IF(.NOT.NODE_EXISTS) CYCLE CALL DOMAIN_MAPPINGS_GLOBAL_TO_LOCAL_GET(NODES_MAPPING,global_node,NODE_EXISTS,local_node,err,error,*999) @@ -303,9 +303,9 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO ENDIF ENDDO !Check it went well - CALL MPI_REDUCE(X_FIXED,X_OKAY,1,MPI_LOGICAL,MPI_LOR,0,computationEnvironment%mpiCommunicator,MPI_IERROR) - CALL MPI_REDUCE(Y_FIXED,Y_OKAY,1,MPI_LOGICAL,MPI_LOR,0,computationEnvironment%mpiCommunicator,MPI_IERROR) - IF(myComputationNodeNumber==0) THEN + CALL MPI_REDUCE(X_FIXED,X_OKAY,1,MPI_LOGICAL,MPI_LOR,0,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + CALL MPI_REDUCE(Y_FIXED,Y_OKAY,1,MPI_LOGICAL,MPI_LOR,0,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + IF(myWorldComputationNodeNumber==0) THEN IF(.NOT.(X_OKAY.AND.Y_OKAY)) THEN CALL FlagError("Could not fix nodes to prevent rigid body motion",err,error,*999) ENDIF @@ -422,7 +422,7 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO IF(NODE_EXISTS) THEN CALL DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,user_node, & & DOMAIN_PRESSURE%MESH_COMPONENT_NUMBER,DOMAIN_NUMBER,err,error,*999) - IF(DOMAIN_NUMBER==myComputationNodeNumber) THEN + IF(DOMAIN_NUMBER==myWorldComputationNodeNumber) THEN !\todo: test the domain node mappings pointer properly local_node=DOMAIN_PRESSURE%mappings%nodes%global_to_local_map(global_node)%local_number(1) !Default to version 1 of each node derivative diff --git a/src/mesh_routines.f90 b/src/mesh_routines.f90 index 4c950cc5..baabd2aa 100644 --- a/src/mesh_routines.f90 +++ b/src/mesh_routines.f90 @@ -722,13 +722,13 @@ SUBROUTINE DECOMPOSITION_ELEMENT_DOMAIN_CALCULATE(DECOMPOSITION,ERR,ERROR,*) CALL PARMETIS_PARTMESHKWAY(ELEMENT_DISTANCE,ELEMENT_PTR,ELEMENT_INDICIES,ELEMENT_WEIGHT,WEIGHT_FLAG,NUMBER_FLAG, & & NUMBER_OF_CONSTRAINTS,NUMBER_OF_COMMON_NODES,DECOMPOSITION%NUMBER_OF_DOMAINS,TPWGTS,UBVEC,PARMETIS_OPTIONS, & & DECOMPOSITION%NUMBER_OF_EDGES_CUT,DECOMPOSITION%ELEMENT_DOMAIN(DISPLACEMENTS(my_computation_node_number)+1:), & - & computationEnvironment%mpiCommunicator,ERR,ERROR,*999) + & computationEnvironment%mpiWorldCommunicator,ERR,ERROR,*999) !Transfer all the element domain information to the other computation nodes so that each rank has all the info IF(number_computation_nodes>1) THEN !This should work on a single processor but doesn't for mpich2 under windows. Maybe a bug? Avoid for now. CALL MPI_ALLGATHERV(MPI_IN_PLACE,MAX_NUMBER_ELEMENTS_PER_NODE,MPI_INTEGER,DECOMPOSITION%ELEMENT_DOMAIN, & - & RECEIVE_COUNTS,DISPLACEMENTS,MPI_INTEGER,computationEnvironment%mpiCommunicator,MPI_IERROR) + & RECEIVE_COUNTS,DISPLACEMENTS,MPI_INTEGER,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHERV",MPI_IERROR,ERR,ERROR,*999) ENDIF @@ -1163,7 +1163,7 @@ SUBROUTINE DECOMPOSITION_NUMBER_OF_DOMAINS_SET(DECOMPOSITION,NUMBER_OF_DOMAINS,E INTEGER(INTG), INTENT(OUT) :: ERR !DOMAIN%MESH component_idx=DOMAIN%MESH_COMPONENT_NUMBER - myComputationNodeNumber=ComputationEnvironment_NodeNumberGet(ERR,ERROR) + myWorldComputationNodeNumber=ComputationEnvironment_NodeNumberGet(ERR,ERROR) IF(ERR/=0) GOTO 999 !Calculate the local and global numbers and set up the mappings @@ -4409,7 +4409,7 @@ SUBROUTINE DOMAIN_MAPPINGS_NODES_DOFS_CALCULATE(DOMAIN,ERR,ERROR,*) !Local Variables INTEGER(INTG) :: DUMMY_ERR,no_adjacent_element,no_computation_node,no_ghost_node,adjacent_element,ghost_node, & & NUMBER_OF_NODES_PER_DOMAIN,domain_idx,domain_idx2,domain_no,node_idx,derivative_idx,version_idx,ny,NUMBER_OF_DOMAINS, & - & MAX_NUMBER_DOMAINS,NUMBER_OF_GHOST_NODES,myComputationNodeNumber,numberOfComputationNodes,component_idx + & MAX_NUMBER_DOMAINS,NUMBER_OF_GHOST_NODES,myWorldComputationNodeNumber,numberOfWorldComputationNodes,component_idx INTEGER(INTG), ALLOCATABLE :: LOCAL_NODE_NUMBERS(:),LOCAL_DOF_NUMBERS(:),NODE_COUNT(:),NUMBER_INTERNAL_NODES(:), & & NUMBER_BOUNDARY_NODES(:) INTEGER(INTG), ALLOCATABLE :: DOMAINS(:),ALL_DOMAINS(:),GHOST_NODES(:) @@ -4441,9 +4441,9 @@ SUBROUTINE DOMAIN_MAPPINGS_NODES_DOFS_CALCULATE(DOMAIN,ERR,ERROR,*) component_idx=DOMAIN%MESH_COMPONENT_NUMBER MESH_TOPOLOGY=>MESH%TOPOLOGY(component_idx)%PTR - numberOfComputationNodes=ComputationEnvironment_NumberOfNodesGet(ERR,ERROR) + numberOfWorldComputationNodes=ComputationEnvironment_NumberOfNodesGet(ERR,ERROR) IF(ERR/=0) GOTO 999 - myComputationNodeNumber=ComputationEnvironment_NodeNumberGet(ERR,ERROR) + myWorldComputationNodeNumber=ComputationEnvironment_NodeNumberGet(ERR,ERROR) IF(ERR/=0) GOTO 999 !Calculate the local and global numbers and set up the mappings @@ -4677,23 +4677,23 @@ SUBROUTINE DOMAIN_MAPPINGS_NODES_DOFS_CALCULATE(DOMAIN,ERR,ERROR,*) ENDDO !domain_idx !Check decomposition and check that each domain has a node in it. - ALLOCATE(NODE_COUNT(0:numberOfComputationNodes-1),STAT=ERR) + ALLOCATE(NODE_COUNT(0:numberOfWorldComputationNodes-1),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate node count.",ERR,ERROR,*999) NODE_COUNT=0 DO node_idx=1,MESH_TOPOLOGY%NODES%numberOfNodes no_computation_node=DOMAIN%NODE_DOMAIN(node_idx) - IF(no_computation_node>=0.AND.no_computation_node=0.AND.no_computation_nodeStart the creation of a computation work group - SUBROUTINE cmfe_Computation_WorkGroupCreateStart(worldWorkGroup,numberComputationNodes,err) + !>Start the creation of a computation work group under a parent work group + SUBROUTINE cmfe_Computation_WorkGroupCreateStart(parentWorkGroup,numberOfComputationNodes,workGroup,err) !DLLEXPORT(cmfe_Computation_WorkGroupCreateStart) !Argument Variables - TYPE(cmfe_ComputationWorkGroupType), INTENT(INOUT) :: worldWorkGroup - INTEGER(INTG),INTENT(IN) :: numberComputationNodes + TYPE(cmfe_ComputationWorkGroupType), INTENT(INOUT) :: parentWorkGroup !Finish the creation of a computation work group - SUBROUTINE cmfe_Computation_WorkGroupCreateFinish(worldWorkGroup, err) + SUBROUTINE cmfe_Computation_WorkGroupCreateFinish(workGroup,err) !DLLEXPORT(cmfe_Computation_WorkGroupCreateFinish) !Argument Variables - TYPE(cmfe_ComputationWorkGroupType), INTENT(INOUT) :: worldWorkGroup + TYPE(cmfe_ComputationWorkGroupType), INTENT(INOUT) :: workGroup !Set the working group tree in order to performe mesh decomposition - SUBROUTINE cmfe_Decomposition_WorldWorkGroupSet(decomposition, worldWorkGroup, err) + !>Set the decomposition work group + SUBROUTINE cmfe_Decomposition_WorldWorkGroupSet(decomposition,workGroup,err) !DLLEXPORT(cmfe_Decomposition_WorldWorkGroupSet) !Argument Variables - TYPE(cmfe_DecompositionType), INTENT(INOUT) :: decomposition - TYPE(cmfe_ComputationWorkGroupType),INTENT(IN) :: worldWorkGroup + TYPE(cmfe_DecompositionType), INTENT(INOUT) :: decomposition ! REGION%equations_sets%equations_sets(EQUATIONS_SET_GLOBAL_NUMBER)%ptr NULLIFY(SOURCE_FIELD) COMPUTATION_DOMAIN=>REGION%MESHES%MESHES(1) & & %ptr%DECOMPOSITIONS%DECOMPOSITIONS(1)%ptr%DOMAIN(1)%ptr - myComputationNodeNumber = ComputationEnvironment_NodeNumberGet(ERR,ERROR) + myWorldComputationNodeNumber = ComputationEnvironment_NodeNumberGet(ERR,ERROR) NumberOfDimensions = COMPUTATION_DOMAIN%NUMBER_OF_DIMENSIONS NumberOfNodes = COMPUTATION_DOMAIN%TOPOLOGY%NODES%NUMBER_OF_NODES NodesInMeshComponent = REGION%meshes%meshes(1)%ptr%topology(1)%ptr%nodes%numberOfNodes @@ -142,50 +142,50 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER FILENAME="./output/"//NAME//".exnode" - OPEN(UNIT=myComputationNodeNumber, FILE=CHAR(FILENAME),STATUS='unknown') + OPEN(UNIT=myWorldComputationNodeNumber, FILE=CHAR(FILENAME),STATUS='unknown') ! WRITING HEADER INFORMATION - WRITE(myComputationNodeNumber,*) 'Group name: Cell' + WRITE(myWorldComputationNodeNumber,*) 'Group name: Cell' WRITE(INTG_STRING,'(I0)'),NumberOfOutputFields - WRITE(myComputationNodeNumber,*) '#Fields=',TRIM(INTG_STRING) + WRITE(myWorldComputationNodeNumber,*) '#Fields=',TRIM(INTG_STRING) ValueIndex=1 WRITE(INTG_STRING,'(I0)'),NumberOfDimensions - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' 1) coordinates, coordinate, rectangular cartesian, #Components=',TRIM(INTG_STRING) DO I=1,NumberOfDimensions IF(I==1) THEN WRITE(INTG_STRING,'(I0)'),ValueIndex - WRITE(myComputationNodeNumber,*) ' x. Value index= ',TRIM(INTG_STRING),', #Derivatives= 0' + WRITE(myWorldComputationNodeNumber,*) ' x. Value index= ',TRIM(INTG_STRING),', #Derivatives= 0' ELSE IF(I==2) THEN WRITE(INTG_STRING,'(I0)'),ValueIndex - WRITE(myComputationNodeNumber,*) ' y. Value index= ',TRIM(INTG_STRING),', #Derivatives= 0' + WRITE(myWorldComputationNodeNumber,*) ' y. Value index= ',TRIM(INTG_STRING),', #Derivatives= 0' ELSE WRITE(INTG_STRING,'(I0)'),ValueIndex - WRITE(myComputationNodeNumber,*) ' z. Value index= ',TRIM(INTG_STRING),', #Derivatives= 0' + WRITE(myWorldComputationNodeNumber,*) ' z. Value index= ',TRIM(INTG_STRING),', #Derivatives= 0' END IF ValueIndex=ValueIndex+1 END DO WRITE(INTG_STRING,'(I0)'),NumberOfVariableComponents - WRITE(myComputationNodeNumber,*) ' 2) dependent, field, rectangular cartesian, #Components=', & + WRITE(myWorldComputationNodeNumber,*) ' 2) dependent, field, rectangular cartesian, #Components=', & & TRIM(INTG_STRING) DO I=1,NumberOfVariableComponents WRITE(INTG_STRING,'(I0)'),ValueIndex WRITE(INTG_STRING2,'(I0)'),I - WRITE(myComputationNodeNumber,*) ' ',TRIM(INTG_STRING2),'. Value index= ',TRIM(INTG_STRING), & + WRITE(myWorldComputationNodeNumber,*) ' ',TRIM(INTG_STRING2),'. Value index= ',TRIM(INTG_STRING), & & ', #Derivatives= 0' ValueIndex=ValueIndex+1 END DO IF( OUTPUT_SOURCE ) THEN !Watch out that no numbering conflict occurs with Analytic: 4.) WRITE(INTG_STRING,'(I0)'),NumberOfSourceComponents - WRITE(myComputationNodeNumber,*) ' 3) source, field, rectangular cartesian, #Components=', & + WRITE(myWorldComputationNodeNumber,*) ' 3) source, field, rectangular cartesian, #Components=', & & TRIM(INTG_STRING) DO I=1,NumberOfSourceComponents WRITE(INTG_STRING,'(I0)'),ValueIndex WRITE(INTG_STRING2,'(I0)'),I - WRITE(myComputationNodeNumber,*) ' ',TRIM(INTG_STRING2),'. Value index= ', & + WRITE(myWorldComputationNodeNumber,*) ' ',TRIM(INTG_STRING2),'. Value index= ', & & TRIM(INTG_STRING),', #Derivatives= 0' ValueIndex=ValueIndex+1 END DO @@ -207,17 +207,17 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER NodeUValue=REGION%equations_sets%equations_sets(EQUATIONS_SET_GLOBAL_NUMBER)%ptr%dependent%dependent_field% & & variables(1)%parameter_sets%parameter_sets(1)%ptr%parameters%cmiss%data_dp(I) - WRITE(myComputationNodeNumber,*) ' Node: ',NODE_GLOBAL_NUMBER - WRITE(myComputationNodeNumber,'(" ", es25.16 )')NodeXValue + WRITE(myWorldComputationNodeNumber,*) ' Node: ',NODE_GLOBAL_NUMBER + WRITE(myWorldComputationNodeNumber,'(" ", es25.16 )')NodeXValue IF(NumberOfDimensions==2 .OR. NumberOfDimensions==3) THEN - WRITE(myComputationNodeNumber,'(" ", es25.16 )')NodeYValue + WRITE(myWorldComputationNodeNumber,'(" ", es25.16 )')NodeYValue END IF IF(NumberOfDimensions==3) THEN - WRITE(myComputationNodeNumber,'(" ", es25.16 )')NodeZValue + WRITE(myWorldComputationNodeNumber,'(" ", es25.16 )')NodeZValue END IF - WRITE(myComputationNodeNumber,'(" ", es25.16 )')NodeUValue + WRITE(myWorldComputationNodeNumber,'(" ", es25.16 )')NodeUValue IF( (EQUATIONS_SET%SPECIFICATION(1)==EQUATIONS_SET_CLASSICAL_FIELD_CLASS) & & .AND.(EQUATIONS_SET%SPECIFICATION(2)==EQUATIONS_SET_REACTION_DIFFUSION_EQUATION_TYPE) & @@ -225,11 +225,11 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER !source field IF( OUTPUT_SOURCE ) THEN !NodeSourceValue = SOURCE_INTERPOLATED_POINT(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(1,1) - !WRITE(myComputationNodeNumber,'(" ", es25.16 )')NodeSourceValue + !WRITE(myWorldComputationNodeNumber,'(" ", es25.16 )')NodeSourceValue END IF END IF END DO !nodes I - CLOSE(myComputationNodeNumber) + CLOSE(myWorldComputationNodeNumber) !OUTPUT ELEMENTS IN CURRENT DOMAIN MaxNodesPerElement=COMPUTATION_DOMAIN%TOPOLOGY%ELEMENTS%ELEMENTS(1)%basis%number_of_element_parameters @@ -246,110 +246,110 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER ENDIF CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Writing Elements...",ERR,ERROR,*999) FILENAME="./output/"//NAME//".exelem" - OPEN(UNIT=myComputationNodeNumber, FILE=CHAR(FILENAME),STATUS='unknown') - WRITE(myComputationNodeNumber,*) 'Group name: Cell' + OPEN(UNIT=myWorldComputationNodeNumber, FILE=CHAR(FILENAME),STATUS='unknown') + WRITE(myWorldComputationNodeNumber,*) 'Group name: Cell' IF (BasisType==1) THEN !lagrange basis in 1 and 2D WRITE(INTG_STRING,'(I0)'),NumberOfDimensions - WRITE(myComputationNodeNumber,*) 'Shape. Dimension= ',TRIM(INTG_STRING) - WRITE(myComputationNodeNumber,*) '#Scale factor sets= 1' + WRITE(myWorldComputationNodeNumber,*) 'Shape. Dimension= ',TRIM(INTG_STRING) + WRITE(myWorldComputationNodeNumber,*) '#Scale factor sets= 1' IF(NumberOfDimensions==1) THEN WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationNodeNumber,*) 'q.Lagrange, #Scale factors=',TRIM(INTG_STRING) + WRITE(myWorldComputationNodeNumber,*) 'q.Lagrange, #Scale factors=',TRIM(INTG_STRING) ELSE IF (NumberOfDimensions==2) THEN IF(MaxNodesPerElement==4) THEN WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & 'l.Lagrange*l.Lagrange, #Scale factors=',TRIM(INTG_STRING) !linear lagrange ELSE IF(MaxNodesPerElement==9) THEN WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & 'q.Lagrange*q.Lagrange, #Scale factors=',TRIM(INTG_STRING) !quadratic lagrange ELSE IF(MaxNodesPerElement==16) THEN WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & 'c.Lagrange*c.Lagrange, #Scale factors=',TRIM(INTG_STRING) !cubic lagrange END IF ELSE !three dimensions IF(MaxNodesPerElement==8) THEN WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & 'l.Lagrange*l.Lagrange*l.Lagrange, #Scale factors=',TRIM(INTG_STRING) ELSE IF(MaxNodesPerElement==27) THEN WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & 'q.Lagrange*q.Lagrange*q.Lagrange, #Scale factors=',TRIM(INTG_STRING) ELSE IF(MaxNodesPerElement==64) THEN WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & 'c.Lagrange*c.Lagrange*c.Lagrange, #Scale factors=',TRIM(INTG_STRING) END IF END IF ELSEIF(BasisType==2) THEN IF(NumberOfDimensions==2) THEN - WRITE(myComputationNodeNumber,*) 'Shape. Dimension=', & + WRITE(myWorldComputationNodeNumber,*) 'Shape. Dimension=', & & NumberOfDimensions,', simplex(2)*simplex' IF(MaxNodesPerElement==3) THEN - WRITE(myComputationNodeNumber,*) '#Scale factor sets= 1' + WRITE(myWorldComputationNodeNumber,*) '#Scale factor sets= 1' WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' l.simplex(2)*l.simplex, #Scale factors= ', TRIM(INTG_STRING) ELSE IF(MaxNodesPerElement==6) THEN - WRITE(myComputationNodeNumber,*) '#Scale factor sets= 1' + WRITE(myWorldComputationNodeNumber,*) '#Scale factor sets= 1' WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' l.simplex(2)*l.simplex, #Scale factors= ', TRIM(INTG_STRING) ELSE IF (MaxNodesPerElement== 10 ) THEN - WRITE(myComputationNodeNumber,*) '#Scale factor sets= 1' + WRITE(myWorldComputationNodeNumber,*) '#Scale factor sets= 1' WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' q.simplex(2)*q.simplex, #Scale factors= ', TRIM(INTG_STRING) ENDIF ELSE IF(NumberOfDimensions==3) THEN WRITE(INTG_STRING2,'(I0)'),NumberOfDimensions - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & 'Shape. Dimension=',TRIM(INTG_STRING2),', simplex(2;3)*simplex*simplex' IF(MaxNodesPerElement==4) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & '#Scale factor sets= 1' WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' l.simplex(2;3)*l.simplex*l.simplex, #Scale factors= ', TRIM(INTG_STRING) ELSE IF (MaxNodesPerElement== 10 ) THEN - WRITE(myComputationNodeNumber,*) '#Scale factor sets= 1' + WRITE(myWorldComputationNodeNumber,*) '#Scale factor sets= 1' WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' q.simplex(2;3)*q.simplex*q.simplex, #Scale factors= ', TRIM(INTG_STRING) ELSE IF(MaxNodesPerElement==20) THEN - WRITE(myComputationNodeNumber,*) '#Scale factor sets= 1' + WRITE(myWorldComputationNodeNumber,*) '#Scale factor sets= 1' WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' q.simplex(2;3)*q.simplex*q.simplex, #Scale factors= ', TRIM(INTG_STRING) ENDIF ELSE - WRITE(myComputationNodeNumber,*) '#Scale factor sets= 0' + WRITE(myWorldComputationNodeNumber,*) '#Scale factor sets= 0' END IF END IF WRITE(INTG_STRING,'(I0)'),MaxNodesPerElement - WRITE(myComputationNodeNumber,*) '#Nodes= ',TRIM(INTG_STRING) + WRITE(myWorldComputationNodeNumber,*) '#Nodes= ',TRIM(INTG_STRING) WRITE(INTG_STRING,'(I0)'),NumberOfOutputFields - WRITE(myComputationNodeNumber,*) '#Fields= ',TRIM(INTG_STRING) + WRITE(myWorldComputationNodeNumber,*) '#Fields= ',TRIM(INTG_STRING) NumberOfFieldComponents(1) = NumberOfDimensions NumberOfFieldComponents(2) = NumberOfVariableComponents NumberOfFieldComponents(3) = NumberOfSourceComponents DO I=1,NumberOfOutputFields IF(I==1)THEN WRITE(INTG_STRING,'(I0)'),NumberOfDimensions - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' 1) coordinates, coordinate, rectangular cartesian, #Components= ',TRIM(INTG_STRING) ELSE IF(I==2) THEN WRITE(INTG_STRING,'(I0)'),NumberOfVariableComponents - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' 2) dependent, field, rectangular cartesian, #Components= ',TRIM(INTG_STRING) ELSE IF(I==3) THEN WRITE(INTG_STRING,'(I0)'),NumberOfSourceComponents - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' 3) source, field, rectangular cartesian, #Components= ',TRIM(INTG_STRING) END IF @@ -357,98 +357,98 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER IF(NumberOfDimensions==1) THEN IF(I==1)THEN IF(J==1) THEN - WRITE(myComputationNodeNumber,*)' x. l.Lagrange, no modify, standard node based.' + WRITE(myWorldComputationNodeNumber,*)' x. l.Lagrange, no modify, standard node based.' ELSE IF(J==2) THEN - WRITE(myComputationNodeNumber,*)' y. l.Lagrange, no modify, standard node based.' + WRITE(myWorldComputationNodeNumber,*)' y. l.Lagrange, no modify, standard node based.' ELSE IF(J==3) THEN - WRITE(myComputationNodeNumber,*)' z. l.Lagrange, no modify, standard node based.' + WRITE(myWorldComputationNodeNumber,*)' z. l.Lagrange, no modify, standard node based.' END IF ELSE - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' ',J,'. l.Lagrange, no modify, standard node based.' END IF ELSE IF(NumberOfDimensions==2) THEN IF(I==1)THEN IF(J==1) THEN IF(MaxNodesPerElement==4)THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' x. l.Lagrange*l.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==9) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' x. q.Lagrange*q.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==16) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' x. c.Lagrange*c.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==3) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' x. l.simplex(2)*l.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==6) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' x. q.simplex(2)*q.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==10) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' x. c.simplex(2)*c.simplex, no modify, standard node based.' END IF ELSE IF(J==2) THEN IF(MaxNodesPerElement==4) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' y. l.Lagrange*l.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==9) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' y. q.Lagrange*q.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==16) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' y. c.Lagrange*c.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==3) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' y. l.simplex(2)*l.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==6) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' y. q.simplex(2)*q.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==10) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' y. c.simplex(2)*c.simplex, no modify, standard node based.' END IF ELSE IF(J==3) THEN IF(MaxNodesPerElement==4) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' z. l.Lagrange*l.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==9) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' z. q.Lagrange*q.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==16) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' z. c.Lagrange*c.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==3) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' z. l.simplex(2)*l.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==6) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' z. q.simplex(2)*q.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==10) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' z. c.simplex(2)*c.simplex, no modify, standard node based.' END IF END IF ELSE IF(MaxNodesPerElement==4) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' ',J,'. l.Lagrange*l.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==9) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' ',J,'. q.Lagrange*q.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==16) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' ',J,'. c.Lagrange*c.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==3) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' ',J,'. l.simplex(2)*l.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==6) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' ',J,'. q.simplex(2)*q.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==10) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' ',J,'. c.simplex(2)*c.simplex, no modify, standard node based.' END IF END IF @@ -456,95 +456,95 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER IF(I==1)THEN IF(J==1) THEN IF(MaxNodesPerElement==8) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' x. l.Lagrange*l.Lagrange*l.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==27) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' x. q.Lagrange*q.Lagrange*q.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==64) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' x. c.Lagrange*c.Lagrange*c.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==4) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' x. l.simplex(2;3)*l.simplex*l.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==10) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' x. q.simplex(2;3)*q.simplex*q.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==20) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' x. c.simplex(2;3)*c.simplex*c.simplex, no modify, standard node based.' END IF ELSE IF(J==2) THEN IF(MaxNodesPerElement==8) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' y. l.Lagrange*l.Lagrange*l.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==27) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' y. q.Lagrange*q.Lagrange*q.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==64) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' y. c.Lagrange*c.Lagrange*c.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==4) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' y. l.simplex(2;3)*l.simplex*l.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==10) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' y. q.simplex(2;3)*q.simplex*q.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==20) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' y. c.simplex(2;3)*c.simplex*c.simplex, no modify, standard node based.' END IF ELSE IF(J==3) THEN IF(MaxNodesPerElement==8) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' z. l.Lagrange*l.Lagrange*l.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==27) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' z. q.Lagrange*q.Lagrange*q.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==64) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' z. c.Lagrange*c.Lagrange*c.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==4) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' z. l.simplex(2;3)*l.simplex*l.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==10) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' z. q.simplex(2;3)*q.simplex*q.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==20) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' z. c.simplex(2;3)*c.simplex*c.simplex, no modify, standard node based.' END IF END IF ELSE IF(MaxNodesPerElement==8) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' ',J,'. l.Lagrange*l.Lagrange*l.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==27) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' ',J,'. q.Lagrange*q.Lagrange*q.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==64) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' ',J,'. c.Lagrange*c.Lagrange*c.Lagrange, no modify, standard node based.' ELSE IF(MaxNodesPerElement==4) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' ',J,'. l.simplex(2;3)*l.simplex*l.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==10) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' ',J,'. q.simplex(2;3)*q.simplex*q.simplex, no modify, standard node based.' ELSE IF(MaxNodesPerElement==20) THEN - WRITE(myComputationNodeNumber,*) & + WRITE(myWorldComputationNodeNumber,*) & & ' ',J,'. c.simplex(2;3)*c.simplex*c.simplex, no modify, standard node based.' END IF END IF END IF WRITE(INTG_STRING,'(I0)') MaxNodesPerElement - WRITE(myComputationNodeNumber,*) ' #Nodes= ',TRIM(INTG_STRING) + WRITE(myWorldComputationNodeNumber,*) ' #Nodes= ',TRIM(INTG_STRING) DO K = 1,MaxNodesPerElement WRITE(INTG_STRING,'(I0)'),K - WRITE(myComputationNodeNumber,*) ' ',TRIM(INTG_STRING),'. #Values=1' - WRITE(myComputationNodeNumber,*) ' Value indices: 1' - WRITE(myComputationNodeNumber,*) ' Scale factor indices: ',TRIM(INTG_STRING) + WRITE(myWorldComputationNodeNumber,*) ' ',TRIM(INTG_STRING),'. #Values=1' + WRITE(myWorldComputationNodeNumber,*) ' Value indices: 1' + WRITE(myWorldComputationNodeNumber,*) ' Scale factor indices: ',TRIM(INTG_STRING) END DO END DO !J loop END DO !I loop @@ -565,11 +565,11 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER ELEMENT_GLOBAL_NUMBER=COMPUTATION_DOMAIN%DECOMPOSITION%TOPOLOGY%ELEMENTS%ELEMENTS(K)%GLOBAL_NUMBER IF (BasisType==1) THEN WRITE(INTG_STRING,'(I0)'),ELEMENT_GLOBAL_NUMBER - WRITE(myComputationNodeNumber,*) 'Element: ', TRIM(INTG_STRING),' 0 0' - WRITE(myComputationNodeNumber,*) ' Nodes:' - WRITE(myComputationNodeNumber,*) ' ', ElementNodes(K,1:MaxNodesPerElement) - WRITE(myComputationNodeNumber,*) ' Scale factors:' - WRITE(myComputationNodeNumber,*) ' ',ElementNodesScales(K,1:MaxNodesPerElement) + WRITE(myWorldComputationNodeNumber,*) 'Element: ', TRIM(INTG_STRING),' 0 0' + WRITE(myWorldComputationNodeNumber,*) ' Nodes:' + WRITE(myWorldComputationNodeNumber,*) ' ', ElementNodes(K,1:MaxNodesPerElement) + WRITE(myWorldComputationNodeNumber,*) ' Scale factors:' + WRITE(myWorldComputationNodeNumber,*) ' ',ElementNodesScales(K,1:MaxNodesPerElement) ELSEIF(BasisType==2) THEN IF(.NOT.ALLOCATED(SimplexOutputHelp)) ALLOCATE(SimplexOutputHelp(MaxNodesPerElement)) @@ -584,14 +584,14 @@ SUBROUTINE REACTION_DIFFUSION_IO_WRITE_CMGUI(REGION, EQUATIONS_SET_GLOBAL_NUMBER SimplexOutputHelp(4)=ElementNodes(K,3) END IF WRITE(INTG_STRING,'(I0)') ELEMENT_GLOBAL_NUMBER - WRITE(myComputationNodeNumber,*) 'Element: ', TRIM(INTG_STRING),' 0 0' - WRITE(myComputationNodeNumber,*) ' Nodes:' - WRITE(myComputationNodeNumber,*) ' ', SimplexOutputHelp - WRITE(myComputationNodeNumber,*) ' Scale factors:' - WRITE(myComputationNodeNumber,*) ' ',ElementNodesScales(K,1:MaxNodesPerElement) + WRITE(myWorldComputationNodeNumber,*) 'Element: ', TRIM(INTG_STRING),' 0 0' + WRITE(myWorldComputationNodeNumber,*) ' Nodes:' + WRITE(myWorldComputationNodeNumber,*) ' ', SimplexOutputHelp + WRITE(myWorldComputationNodeNumber,*) ' Scale factors:' + WRITE(myWorldComputationNodeNumber,*) ' ',ElementNodesScales(K,1:MaxNodesPerElement) END IF ENDDO - CLOSE(myComputationNodeNumber) + CLOSE(myWorldComputationNodeNumber) EXITS("REACTION_DIFFUSION_IO_WRITE_CMGUI") RETURN diff --git a/src/reaction_diffusion_equation_routines.f90 b/src/reaction_diffusion_equation_routines.f90 index eda5b326..05c4525c 100755 --- a/src/reaction_diffusion_equation_routines.f90 +++ b/src/reaction_diffusion_equation_routines.f90 @@ -1529,7 +1529,7 @@ SUBROUTINE REACTION_DIFFUSION_POST_SOLVE_OUTPUT_DATA(CONTROL_LOOP,SOLVER,err,err REAL(DP) :: CURRENT_TIME,TIME_INCREMENT INTEGER(INTG) :: EQUATIONS_SET_IDX,CURRENT_LOOP_ITERATION,OUTPUT_FREQUENCY - INTEGER(INTG) :: myComputationNodeNumber + INTEGER(INTG) :: myWorldComputationNodeNumber CHARACTER(28) :: FILE CHARACTER(28) :: OUTPUT_FILE @@ -1558,20 +1558,20 @@ SUBROUTINE REACTION_DIFFUSION_POST_SOLVE_OUTPUT_DATA(CONTROL_LOOP,SOLVER,err,err CURRENT_LOOP_ITERATION=CONTROL_LOOP%TIME_LOOP%ITERATION_NUMBER OUTPUT_FREQUENCY=CONTROL_LOOP%TIME_LOOP%OUTPUT_NUMBER - myComputationNodeNumber = ComputationEnvironment_NodeNumberGet(err,error) + myWorldComputationNodeNumber = ComputationEnvironment_NodeNumberGet(err,error) IF(OUTPUT_FREQUENCY>0) THEN IF(MOD(CURRENT_LOOP_ITERATION,OUTPUT_FREQUENCY)==0) THEN IF(CONTROL_LOOP%TIME_LOOP%CURRENT_TIME<=CONTROL_LOOP%TIME_LOOP%STOP_TIME) THEN IF(SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS.EQ.1) THEN IF(CURRENT_LOOP_ITERATION<10) THEN WRITE(OUTPUT_FILE,'("TIME_STEP_SPEC_1.part",I2.2,".000",I0)') & - & myComputationNodeNumber, CURRENT_LOOP_ITERATION + & myWorldComputationNodeNumber, CURRENT_LOOP_ITERATION ELSE IF(CURRENT_LOOP_ITERATION<100) THEN WRITE(OUTPUT_FILE,'("TIME_STEP_SPEC_1.part",I2.2,".00",I0)') & - & myComputationNodeNumber,CURRENT_LOOP_ITERATION + & myWorldComputationNodeNumber,CURRENT_LOOP_ITERATION ELSE IF(CURRENT_LOOP_ITERATION<1000) THEN WRITE(OUTPUT_FILE,'("TIME_STEP_SPEC_1.part",I2.2,".0",I0)') & - & myComputationNodeNumber,CURRENT_LOOP_ITERATION + & myWorldComputationNodeNumber,CURRENT_LOOP_ITERATION ELSE IF(CURRENT_LOOP_ITERATION<10000) THEN WRITE(OUTPUT_FILE,'("TIME_STEP_SPEC_1.part",I2.2,".",I0)') & & CURRENT_LOOP_ITERATION @@ -1579,16 +1579,16 @@ SUBROUTINE REACTION_DIFFUSION_POST_SOLVE_OUTPUT_DATA(CONTROL_LOOP,SOLVER,err,err ELSE IF(CURRENT_LOOP_ITERATION<10) THEN WRITE(OUTPUT_FILE, '("TIME_STEP_SPEC_",I0,".part",I2.2,".000",I0)') & - & equations_set_idx,myComputationNodeNumber,CURRENT_LOOP_ITERATION + & equations_set_idx,myWorldComputationNodeNumber,CURRENT_LOOP_ITERATION ELSE IF(CURRENT_LOOP_ITERATION<100) THEN WRITE(OUTPUT_FILE, '("TIME_STEP_SPEC_",I0,".part",I2.2,".00",I0)') & - & equations_set_idx,myComputationNodeNumber,CURRENT_LOOP_ITERATION + & equations_set_idx,myWorldComputationNodeNumber,CURRENT_LOOP_ITERATION ELSE IF(CURRENT_LOOP_ITERATION<1000) THEN WRITE(OUTPUT_FILE, '("TIME_STEP_SPEC_",I0,".part",I2.2,".0",I0)') & - & equations_set_idx,myComputationNodeNumber,CURRENT_LOOP_ITERATION + & equations_set_idx,myWorldComputationNodeNumber,CURRENT_LOOP_ITERATION ELSE IF(CURRENT_LOOP_ITERATION<10000) THEN WRITE(OUTPUT_FILE, '("TIME_STEP_SPEC_",I0,".part",I2.2,".",I0)') & - & equations_set_idx,myComputationNodeNumber,CURRENT_LOOP_ITERATION + & equations_set_idx,myWorldComputationNodeNumber,CURRENT_LOOP_ITERATION END IF ENDIF WRITE(*,*) OUTPUT_FILE diff --git a/src/solver_mapping_routines.f90 b/src/solver_mapping_routines.f90 index 4b01decd..96bfef51 100755 --- a/src/solver_mapping_routines.f90 +++ b/src/solver_mapping_routines.f90 @@ -319,7 +319,7 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) ! for each rank. ! !Calculate the row mappings. - myrank=computationEnvironment%myComputationNodeNumber + myrank=computationEnvironment%myWorldComputationNodeNumber NUMBER_OF_GLOBAL_SOLVER_ROWS=0 NUMBER_OF_LOCAL_SOLVER_ROWS=0 !Add in the rows from any equations sets that have been added to the solver equations @@ -327,10 +327,10 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) ! !Allocate and initialise the rank lists. ALLOCATE(RANK_GLOBAL_ROWS_LISTS(SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS+SOLVER_MAPPING% & - & NUMBER_OF_INTERFACE_CONDITIONS,0:computationEnvironment%numberOfComputationNodes-1),STAT=ERR) + & NUMBER_OF_INTERFACE_CONDITIONS,0:computationEnvironment%numberOfWorldComputationNodes-1),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate rank global rows lists.",ERR,ERROR,*999) CALL SolverDofCouplings_Initialise(rowCouplings,err,error,*999) - DO rank=0,computationEnvironment%numberOfComputationNodes-1 + DO rank=0,computationEnvironment%numberOfWorldComputationNodes-1 equations_idx=0 DO equations_set_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS equations_idx=equations_idx+1 @@ -346,7 +346,7 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) CALL LIST_CREATE_START(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR,ERR,ERROR,*999) CALL LIST_DATA_TYPE_SET(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR,LIST_INTG_TYPE,ERR,ERROR,*999) CALL LIST_INITIAL_SIZE_SET(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR,INT(vectorMapping% & - & numberOfGlobalRows/computationEnvironment%numberOfComputationNodes,INTG), & + & numberOfGlobalRows/computationEnvironment%numberOfWorldComputationNodes,INTG), & & ERR,ERROR,*999) CALL LIST_DATA_DIMENSION_SET(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR,4,ERR,ERROR,*999) CALL LIST_KEY_DIMENSION_SET(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR,1,ERR,ERROR,*999) @@ -369,7 +369,7 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) CALL LIST_CREATE_START(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR,ERR,ERROR,*999) CALL LIST_DATA_TYPE_SET(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR,LIST_INTG_TYPE,ERR,ERROR,*999) CALL LIST_INITIAL_SIZE_SET(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR, & - & INT(INTERFACE_MAPPING%NUMBER_OF_GLOBAL_COLUMNS/computationEnvironment%numberOfComputationNodes, & + & INT(INTERFACE_MAPPING%NUMBER_OF_GLOBAL_COLUMNS/computationEnvironment%numberOfWorldComputationNodes, & & INTG),ERR,ERROR,*999) CALL LIST_DATA_DIMENSION_SET(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR,4,ERR,ERROR,*999) CALL LIST_KEY_DIMENSION_SET(RANK_GLOBAL_ROWS_LISTS(equations_idx,rank)%PTR,1,ERR,ERROR,*999) @@ -677,7 +677,7 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) IF(ERR/=0) CALL FlagError("Could not allocate solver mapping row dofs mapping.",ERR,ERROR,*999) !!TODO: what is the real number of domains for a solver??? CALL DOMAIN_MAPPINGS_MAPPING_INITIALISE(SOLVER_MAPPING%ROW_DOFS_MAPPING,computationEnvironment% & - & numberOfComputationNodes,ERR,ERROR,*999) + & numberOfWorldComputationNodes,ERR,ERROR,*999) ROW_DOMAIN_MAPPING=>SOLVER_MAPPING%ROW_DOFS_MAPPING ALLOCATE(ROW_DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(NUMBER_OF_GLOBAL_SOLVER_ROWS),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate row dofs mapping global to local map.",ERR,ERROR,*999) @@ -788,7 +788,7 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) IF(err/=0) CALL FlagError("Could not allocate dummy DOF coupling values.",err,error,*999) dummyDofCoupling%numberOfDofs=1 !Loop over the ranks to ensure that the lowest ranks have the lowest numbered solver variables - DO rank=0,computationEnvironment%numberOfComputationNodes-1 + DO rank=0,computationEnvironment%numberOfWorldComputationNodes-1 NUMBER_OF_LOCAL_SOLVER_ROWS=0 !Calculate the solver row <-> equations row & interface row mappings. @@ -1226,9 +1226,9 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) !dof_type is 1 for domain local DOFs and 2 for ghost DOFs ALLOCATE(RANK_GLOBAL_COLS_LISTS(2,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS+SOLVER_MAPPING% & & NUMBER_OF_INTERFACE_CONDITIONS,SOLVER_MAPPING%VARIABLES_LIST(solver_matrix_idx)%NUMBER_OF_VARIABLES, & - & 0:computationEnvironment%numberOfComputationNodes-1),STAT=ERR) + & 0:computationEnvironment%numberOfWorldComputationNodes-1),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate rank global columns lists.",ERR,ERROR,*999) - DO rank=0,computationEnvironment%numberOfComputationNodes-1 + DO rank=0,computationEnvironment%numberOfWorldComputationNodes-1 DO solver_variable_idx=1,SOLVER_MAPPING%VARIABLES_LIST(solver_matrix_idx)%NUMBER_OF_VARIABLES DO equations_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS+SOLVER_MAPPING%NUMBER_OF_INTERFACE_CONDITIONS DO dof_type=1,2 @@ -1870,13 +1870,13 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) IF(ERR/=0) CALL FlagError("Could not allocate solver col to equations sets map column dofs mapping.",ERR,ERROR,*999) !!TODO: what is the real number of domains for a solver??? CALL DOMAIN_MAPPINGS_MAPPING_INITIALISE(SOLVER_MAPPING%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% & - & COLUMN_DOFS_MAPPING,computationEnvironment%numberOfComputationNodes,ERR,ERROR,*999) + & COLUMN_DOFS_MAPPING,computationEnvironment%numberOfWorldComputationNodes,ERR,ERROR,*999) COL_DOMAIN_MAPPING=>SOLVER_MAPPING%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)%COLUMN_DOFS_MAPPING ALLOCATE(COL_DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(NUMBER_OF_GLOBAL_SOLVER_DOFS),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate column dofs mapping global to local.",ERR,ERROR,*999) COL_DOMAIN_MAPPING%NUMBER_OF_GLOBAL=NUMBER_OF_GLOBAL_SOLVER_DOFS ALLOCATE(VARIABLE_RANK_PROCESSED(SOLVER_MAPPING%VARIABLES_LIST(solver_matrix_idx)%NUMBER_OF_VARIABLES, & - & 0:computationEnvironment%numberOfComputationNodes-1),STAT=ERR) + & 0:computationEnvironment%numberOfWorldComputationNodes-1),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate variable rank processed.",ERR,ERROR,*999) VARIABLE_RANK_PROCESSED=.FALSE. !Calculate the column mappings @@ -2260,7 +2260,7 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) DOF_MAP(solver_variable_idx)%PTR=0 ENDDO !solver_variable_idx - ALLOCATE(solver_local_dof(0:computationEnvironment%numberOfComputationNodes-1),STAT=ERR) + ALLOCATE(solver_local_dof(0:computationEnvironment%numberOfWorldComputationNodes-1),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate solver local dof array.",ERR,ERROR,*999) ! @@ -2271,7 +2271,7 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) solver_global_dof=0 solver_local_dof=0 DO dof_type=1,2 - DO rank=0,computationEnvironment%numberOfComputationNodes-1 + DO rank=0,computationEnvironment%numberOfWorldComputationNodes-1 DO solver_variable_idx=1,SOLVER_MAPPING%VARIABLES_LIST(solver_matrix_idx)%NUMBER_OF_VARIABLES diff --git a/src/solver_routines.f90 b/src/solver_routines.f90 index 9c1f69b5..de41f789 100644 --- a/src/solver_routines.f90 +++ b/src/solver_routines.f90 @@ -9807,7 +9807,7 @@ SUBROUTINE SOLVER_LINEAR_DIRECT_CREATE_FINISH(LINEAR_DIRECT_SOLVER,ERR,ERROR,*) !Nothing else to do CASE(SOLVER_MUMPS_LIBRARY,SOLVER_SUPERLU_LIBRARY,SOLVER_PASTIX_LIBRARY,SOLVER_LAPACK_LIBRARY) !Set up solver through PETSc - CALL Petsc_KSPCreate(computationEnvironment%mpiCommunicator,LINEAR_DIRECT_SOLVER%KSP,ERR,ERROR,*999) + CALL Petsc_KSPCreate(computationEnvironment%mpiWorldCommunicator,LINEAR_DIRECT_SOLVER%KSP,ERR,ERROR,*999) !Set any further KSP options from the command line options CALL Petsc_KSPSetFromOptions(LINEAR_DIRECT_SOLVER%KSP,ERR,ERROR,*999) @@ -11060,7 +11060,7 @@ SUBROUTINE SOLVER_LINEAR_ITERATIVE_CREATE_FINISH(LINEAR_ITERATIVE_SOLVER,ERR,ERR CALL FlagError("Solver linking solve is not associated.",ERR,ERROR,*999) ENDIF ELSE - CALL Petsc_KSPCreate(computationEnvironment%mpiCommunicator,LINEAR_ITERATIVE_SOLVER%KSP,ERR,ERROR,*999) + CALL Petsc_KSPCreate(computationEnvironment%mpiWorldCommunicator,LINEAR_ITERATIVE_SOLVER%KSP,ERR,ERROR,*999) ENDIF !Set the iterative solver type SELECT CASE(LINEAR_ITERATIVE_SOLVER%ITERATIVE_SOLVER_TYPE) @@ -15893,7 +15893,7 @@ SUBROUTINE Solver_QuasiNewtonLinesearchCreateFinish(LINESEARCH_SOLVER,ERR,ERROR, ENDIF ENDDO !interface_idx !Create the PETSc SNES solver - CALL Petsc_SnesCreate(computationEnvironment%mpiCommunicator,LINESEARCH_SOLVER%snes,ERR,ERROR,*999) + CALL Petsc_SnesCreate(computationEnvironment%mpiWorldCommunicator,LINESEARCH_SOLVER%snes,ERR,ERROR,*999) !Set the nonlinear solver type to be a Quasi-Newton line search solver CALL Petsc_SnesSetType(LINESEARCH_SOLVER%snes,PETSC_SNESQN,ERR,ERROR,*999) !Following routines don't work for petsc version < 3.5. @@ -17075,7 +17075,7 @@ SUBROUTINE Solver_QuasiNewtonTrustRegionCreateFinish(TRUSTREGION_SOLVER,ERR,ERRO END SELECT CALL SOLVER_MATRICES_CREATE_FINISH(SOLVER_MATRICES,ERR,ERROR,*999) !Create the PETSc SNES solver - CALL Petsc_SnesCreate(computationEnvironment%mpiCommunicator,TRUSTREGION_SOLVER%snes,ERR,ERROR,*999) + CALL Petsc_SnesCreate(computationEnvironment%mpiWorldCommunicator,TRUSTREGION_SOLVER%snes,ERR,ERROR,*999) !Set the nonlinear solver type to be a Quasi-Newton trust region solver CALL Petsc_SnesSetType(TRUSTREGION_SOLVER%snes,PETSC_SNESNEWTONTR,ERR,ERROR,*999) !Set the nonlinear function @@ -18667,7 +18667,7 @@ SUBROUTINE SOLVER_NEWTON_LINESEARCH_CREATE_FINISH(LINESEARCH_SOLVER,ERR,ERROR,*) ENDIF ENDDO !interface_idx !Create the PETSc SNES solver - CALL Petsc_SnesCreate(computationEnvironment%mpiCommunicator,LINESEARCH_SOLVER%snes,ERR,ERROR,*999) + CALL Petsc_SnesCreate(computationEnvironment%mpiWorldCommunicator,LINESEARCH_SOLVER%snes,ERR,ERROR,*999) !Set the nonlinear solver type to be a Newton line search solver CALL Petsc_SnesSetType(LINESEARCH_SOLVER%snes,PETSC_SNESNEWTONLS,ERR,ERROR,*999) @@ -19832,7 +19832,7 @@ SUBROUTINE SOLVER_NEWTON_TRUSTREGION_CREATE_FINISH(TRUSTREGION_SOLVER,ERR,ERROR, END SELECT CALL SOLVER_MATRICES_CREATE_FINISH(SOLVER_MATRICES,ERR,ERROR,*999) !Create the PETSc SNES solver - CALL Petsc_SnesCreate(computationEnvironment%mpiCommunicator,TRUSTREGION_SOLVER%snes,ERR,ERROR,*999) + CALL Petsc_SnesCreate(computationEnvironment%mpiWorldCommunicator,TRUSTREGION_SOLVER%snes,ERR,ERROR,*999) !Set the nonlinear solver type to be a Newton trust region solver CALL Petsc_SnesSetType(TRUSTREGION_SOLVER%snes,PETSC_SNESNEWTONTR,ERR,ERROR,*999) !Set the solver as the SNES application context From 9c25f680c3d810f6fe5cc0f3de21d4dcd8fdef2d Mon Sep 17 00:00:00 2001 From: Chris Bradley Date: Wed, 27 Sep 2017 12:17:39 +1300 Subject: [PATCH 3/6] Initial code for work groups. --- bindings/c/tests/laplace.c | 4 +- cmake/Sources.cmake | 1 + src/Darcy_equations_routines.f90 | 3 +- src/Navier_Stokes_equations_routines.f90 | 72 +- src/analytic_analysis_routines.f90 | 90 +- src/boundary_condition_routines.f90 | 28 +- src/cmiss.f90 | 5 +- src/computation_access_routines.f90 | 620 ++++++++++ src/computation_routines.f90 | 1047 +++++++++-------- src/data_projection_routines.f90 | 34 +- src/distributed_matrix_vector.f90 | 80 +- src/domain_mappings.f90 | 8 +- src/equations_set_routines.f90 | 5 +- src/field_IO_routines.f90 | 95 +- src/field_routines.f90 | 12 +- src/fieldml_input_routines.f90 | 5 +- src/fieldml_output_routines.f90 | 4 +- src/finite_elasticity_routines.f90 | 10 +- src/generated_mesh_routines.f90 | 3 +- src/mesh_routines.f90 | 79 +- src/opencmiss_iron.f90 | 674 +++++++++-- src/reaction_diffusion_IO_routines.f90 | 7 +- src/reaction_diffusion_equation_routines.f90 | 4 +- src/region_routines.f90 | 2 +- src/solver_access_routines.f90 | 2 - src/solver_mapping_routines.f90 | 33 +- src/solver_routines.f90 | 29 +- tests/CellML/CellMLModelIntegration.f90 | 4 +- tests/CellML/Monodomain.f90 | 4 +- .../AnalyticNonlinearPoisson.f90 | 4 +- tests/ClassicalField/Laplace.f90 | 4 +- tests/FieldML_IO/cube.f90 | 4 +- tests/FieldML_IO/fieldml_io.f90 | 4 +- tests/FiniteElasticity/Cantilever.f90 | 4 +- tests/FiniteElasticity/SimpleShear.f90 | 4 +- tests/LinearElasticity/CantileverBeam.f90 | 4 +- tests/LinearElasticity/Extension.f90 | 4 +- 37 files changed, 2054 insertions(+), 942 deletions(-) create mode 100644 src/computation_access_routines.f90 diff --git a/bindings/c/tests/laplace.c b/bindings/c/tests/laplace.c index f7166def..8e9dd05b 100755 --- a/bindings/c/tests/laplace.c +++ b/bindings/c/tests/laplace.c @@ -127,8 +127,8 @@ int main() CHECK_ERROR("Initialising OpenCMISS-Iron"); Err = cmfe_ErrorHandlingModeSet(CMFE_ERRORS_TRAP_ERROR); - Err = cmfe_ComputationNumberOfNodesGet(&NumberOfComputationNodes); - Err = cmfe_ComputationNodeNumberGet(&ComputationNodeNumber); + Err = cmfe_ComputationEnvironment_NumberOfWorldNodesGet(&NumberOfComputationNodes); + Err = cmfe_ComputationEnvironment_WorldNodeNumberGet(&ComputationNodeNumber); /* Start the creation of a new RC coordinate system */ Err = cmfe_CoordinateSystem_Initialise(&CoordinateSystem); diff --git a/cmake/Sources.cmake b/cmake/Sources.cmake index ac10c9c2..a51cd7dd 100644 --- a/cmake/Sources.cmake +++ b/cmake/Sources.cmake @@ -37,6 +37,7 @@ set(IRON_Fortran_SRC cmiss_petsc.f90 cmiss.f90 computation_routines.f90 + computation_access_routines.f90 constants.f90 control_loop_routines.f90 control_loop_access_routines.f90 diff --git a/src/Darcy_equations_routines.f90 b/src/Darcy_equations_routines.f90 index d3e70fc0..bc06065c 100755 --- a/src/Darcy_equations_routines.f90 +++ b/src/Darcy_equations_routines.f90 @@ -52,6 +52,7 @@ MODULE DARCY_EQUATIONS_ROUTINES USE CONTROL_LOOP_ROUTINES USE ControlLoopAccessRoutines USE ComputationRoutines + USE ComputationAccessRoutines USE COORDINATE_ROUTINES USE DISTRIBUTED_MATRIX_VECTOR USE DOMAIN_MAPPINGS @@ -7266,7 +7267,7 @@ SUBROUTINE DARCY_EQUATION_MONITOR_CONVERGENCE(CONTROL_LOOP,SOLVER,err,error,*) NULLIFY(vectorMapping) NULLIFY(FIELD_VARIABLE) - COMPUTATION_NODE_NUMBER=ComputationEnvironment_NodeNumberGet(err,error) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,COMPUTATION_NODE_NUMBER,err,error,*999) WRITE(FILENAME,'("Darcy_",I3.3,".conv")') COMPUTATION_NODE_NUMBER FILEPATH = "./output/"//FILENAME OPEN(UNIT=23, FILE=CHAR(FILEPATH),STATUS='unknown',ACCESS='append') diff --git a/src/Navier_Stokes_equations_routines.f90 b/src/Navier_Stokes_equations_routines.f90 index 331aeb16..d22c0099 100644 --- a/src/Navier_Stokes_equations_routines.f90 +++ b/src/Navier_Stokes_equations_routines.f90 @@ -50,10 +50,11 @@ MODULE NAVIER_STOKES_EQUATIONS_ROUTINES USE BASIS_ROUTINES USE BOUNDARY_CONDITIONS_ROUTINES USE CHARACTERISTIC_EQUATION_ROUTINES - USE CmissMPI + USE CmissMPI USE CmissPetsc USE CmissPetscTypes USE ComputationRoutines + USE ComputationAccessRoutines USE Constants USE CONTROL_LOOP_ROUTINES USE COORDINATE_ROUTINES @@ -7769,7 +7770,8 @@ SUBROUTINE NavierStokes_PreSolveUpdateBoundaryConditions(SOLVER,err,error,*) INQUIRE(FILE=inputFile, EXIST=importDataFromFile) IF(importDataFromFile) THEN !Read fitted data from input file (if exists) - computationNode = ComputationEnvironment_NodeNumberGet(ERR,ERROR) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,computationNode, & + & err,error,*999) IF(computationNode==0) THEN CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Updating independent field and boundary nodes from " & & //inputFile,ERR,ERROR,*999) @@ -12561,7 +12563,7 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux(equationsSet,coupledEquationsSet,i INTEGER(INTG) :: normalComponentIdx INTEGER(INTG) :: boundaryID,numberOfBoundaries,boundaryType,coupledNodeNumber,numberOfGlobalBoundaries INTEGER(INTG) :: MPI_IERROR,numberOfWorldComputationNodes - INTEGER(INTG) :: i,j,computationNode + INTEGER(INTG) :: i,j,computationNode,worldCommunicator REAL(DP) :: gaussWeight, normalProjection,elementNormal(3) REAL(DP) :: normalDifference,normalTolerance REAL(DP) :: courant,maxCourant,toleranceCourant @@ -12881,22 +12883,21 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux(equationsSet,coupledEquationsSet,i globalBoundaryArea = 0.0_DP globalBoundaryPressure = 0.0_DP globalBoundaryNormalStress = 0.0_DP - numberOfWorldComputationNodes=computationEnvironment%numberOfWorldComputationNodes + CALL ComputationEnvironment_NumberOfWorldNodesGet(computationEnvironment,numberOfWorldComputationNodes,err,error,*999) + CALL ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*999) IF(numberOfWorldComputationNodes>1) THEN !use mpi - CALL MPI_ALLREDUCE(localBoundaryFlux,globalBoundaryFlux,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + CALL MPI_ALLREDUCE(localBoundaryFlux,globalBoundaryFlux,10,MPI_DOUBLE_PRECISION,MPI_SUM,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,err,error,*999) - CALL MPI_ALLREDUCE(localBoundaryArea,globalBoundaryArea,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + CALL MPI_ALLREDUCE(localBoundaryArea,globalBoundaryArea,10,MPI_DOUBLE_PRECISION,MPI_SUM,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(localBoundaryNormalStress,globalBoundaryNormalStress,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(localBoundaryPressure,globalBoundaryPressure,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(numberOfBoundaries,numberOfGlobalBoundaries,1,MPI_INTEGER,MPI_MAX, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) ELSE numberOfGlobalBoundaries = numberOfBoundaries @@ -12914,7 +12915,7 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux(equationsSet,coupledEquationsSet,i END DO DO boundaryID=2,numberOfGlobalBoundaries IF(globalBoundaryArea(boundaryID) > ZERO_TOLERANCE) THEN - computationNode = ComputationEnvironment_NodeNumberGet(ERR,ERROR) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,computationNode,err,error,*999) IF(computationNode==0) THEN CALL WriteStringTwoValue(DIAGNOSTIC_OUTPUT_TYPE,"3D boundary ",boundaryID," flow: ", & & globalBoundaryFlux(boundaryID),err,error,*999) @@ -13182,8 +13183,7 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux(equationsSet,coupledEquationsSet,i IF(numberOfWorldComputationNodes>1) THEN !use mpi ALLOCATE(globalConverged(numberOfWorldComputationNodes),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate global convergence check array.",ERR,ERROR,*999) - CALL MPI_ALLGATHER(convergedFlag,1,MPI_LOGICAL,globalConverged,1,MPI_LOGICAL, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + CALL MPI_ALLGATHER(convergedFlag,1,MPI_LOGICAL,globalConverged,1,MPI_LOGICAL,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPI_IERROR,ERR,ERROR,*999) IF(ALL(globalConverged)) THEN convergedFlag = .TRUE. @@ -13253,7 +13253,7 @@ SUBROUTINE NavierStokes_Couple1D0D(controlLoop,solver,err,error,*) TYPE(VARYING_STRING) :: localError INTEGER(INTG) :: nodeNumber,nodeIdx,derivativeIdx,versionIdx,componentIdx,numberOfLocalNodes1D INTEGER(INTG) :: solver1dNavierStokesNumber,solverNumber,MPI_IERROR,timestep,iteration - INTEGER(INTG) :: boundaryNumber,numberOfBoundaries,numberOfWorldComputationNodes + INTEGER(INTG) :: boundaryNumber,numberOfBoundaries,numberOfWorldComputationNodes,worldCommunicator INTEGER(INTG) :: dependentDof,boundaryConditionType REAL(DP) :: A0_PARAM,E_PARAM,H_PARAM,beta,pCellML,normalWave(2) REAL(DP) :: qPrevious,pPrevious,aPrevious,q1d,a1d,qError,aError,couplingTolerance @@ -13475,13 +13475,13 @@ SUBROUTINE NavierStokes_Couple1D0D(controlLoop,solver,err,error,*) localConverged = .FALSE. END IF ! Need to check that boundaries have converged globally (on all domains) if this is a parallel problem - numberOfWorldComputationNodes=computationEnvironment%numberOfWorldComputationNodes + CALL ComputationEnvironment_NumberOfWorldNodesGet(computationEnvironment,numberOfWorldComputationNodes,err,error,*999) + CALL ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*999) IF(numberOfWorldComputationNodes>1) THEN !use mpi !allocate array for mpi communication ALLOCATE(globalConverged(numberOfWorldComputationNodes),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate global convergence check array.",ERR,ERROR,*999) - CALL MPI_ALLGATHER(localConverged,1,MPI_LOGICAL,globalConverged,1,MPI_LOGICAL, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + CALL MPI_ALLGATHER(localConverged,1,MPI_LOGICAL,globalConverged,1,MPI_LOGICAL,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPI_IERROR,err,error,*999) IF(ALL(globalConverged)) THEN !CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"1D/0D coupling converged; # iterations: ", & @@ -13545,7 +13545,7 @@ SUBROUTINE NavierStokes_Couple3D1D(controlLoop,err,error,*) INTEGER(INTG) :: nodeNumber,nodeIdx,derivativeIdx,versionIdx,componentIdx,numberOfLocalNodes1D INTEGER(INTG) :: solver1dNavierStokesNumber,MPI_IERROR,timestep,iteration INTEGER(INTG) :: boundaryNumber,boundaryType1D,numberOfBoundaries,numberOfWorldComputationNodes - INTEGER(INTG) :: solver3dNavierStokesNumber,userNodeNumber,localDof,globalDof,computationNode + INTEGER(INTG) :: solver3dNavierStokesNumber,userNodeNumber,localDof,globalDof,computationNode,worldCommunicator REAL(DP) :: normalWave(2) REAL(DP) :: flow1D,stress1D,flow1DPrevious,stress1DPrevious,flow3D,stress3D,flowError,stressError REAL(DP) :: maxStressError,maxFlowError,flowTolerance,stressTolerance,absoluteCouplingTolerance @@ -13764,20 +13764,20 @@ SUBROUTINE NavierStokes_Couple3D1D(controlLoop,err,error,*) localConverged = .TRUE. END IF ! Need to check that boundaries have converged globally (on all domains) if this is a MPI problem - numberOfWorldComputationNodes=computationEnvironment%numberOfWorldComputationNodes + CALL ComputationEnvironment_NumberOfWorldNodesGet(computationEnvironment,numberOfWorldComputationNodes,err,error,*999) + CALL ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*999) IF(numberOfWorldComputationNodes>1) THEN !use mpi !allocate array for mpi communication IF(ERR/=0) CALL FlagError("Could not allocate global convergence check array.",ERR,ERROR,*999) - CALL MPI_ALLREDUCE(localConverged,globalConverged,1,MPI_LOGICAL,MPI_LAND, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + CALL MPI_ALLREDUCE(localConverged,globalConverged,1,MPI_LOGICAL,MPI_LAND,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) IF(globalConverged) THEN CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"3D/1D coupling converged; # iterations: ", & & iteration,err,error,*999) iterativeLoop%CONTINUE_LOOP=.FALSE. ELSE - computationNode = ComputationEnvironment_NodeNumberGet(ERR,ERROR) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,computationNode,err,error,*999) CALL WriteStringTwoValue(DIAGNOSTIC_OUTPUT_TYPE,"Rank ",computationNode," 3D/1D max flow error: ", & & maxFlowError,err,error,*999) CALL WriteStringTwoValue(DIAGNOSTIC_OUTPUT_TYPE,"Rank ",computationNode," 3D/1D max stress error: ", & @@ -13846,7 +13846,7 @@ SUBROUTINE NavierStokes_CoupleCharacteristics(controlLoop,solver,err,error,*) INTEGER(INTG) :: nodeNumber,nodeIdx,derivativeIdx,versionIdx,componentIdx,i INTEGER(INTG) :: solver1dNavierStokesNumber,solverNumber INTEGER(INTG) :: branchNumber,numberOfBranches,numberOfWorldComputationNodes,numberOfVersions - INTEGER(INTG) :: MPI_IERROR,timestep,iteration,outputIteration + INTEGER(INTG) :: MPI_IERROR,timestep,iteration,outputIteration,worldCommunicator REAL(DP) :: couplingTolerance,l2ErrorW(30),wPrevious(2,7),wNavierStokes(2,7),wCharacteristic(2,7),wError(2,7) REAL(DP) :: l2ErrorQ(100),qCharacteristic(7),qNavierStokes(7),wNext(2,7) REAL(DP) :: totalErrorWPrevious,startTime,stopTime,currentTime,timeIncrement @@ -14056,13 +14056,13 @@ SUBROUTINE NavierStokes_CoupleCharacteristics(controlLoop,solver,err,error,*) localConverged = .FALSE. END IF ! Need to check that boundaries have converged globally (on all domains) if this is a parallel problem - numberOfWorldComputationNodes=computationEnvironment%numberOfWorldComputationNodes + CALL ComputationEnvironment_NumberOfWorldNodesGet(computationEnvironment,numberOfWorldComputationNodes,err,error,*999) + CALL ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*999) IF(numberOfWorldComputationNodes>1) THEN !use mpi !allocate array for mpi communication ALLOCATE(globalConverged(numberOfWorldComputationNodes),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate global convergence check array.",ERR,ERROR,*999) - CALL MPI_ALLGATHER(localConverged,1,MPI_LOGICAL,globalConverged,1,MPI_LOGICAL, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + CALL MPI_ALLGATHER(localConverged,1,MPI_LOGICAL,globalConverged,1,MPI_LOGICAL,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPI_IERROR,err,error,*999) IF(ALL(globalConverged)) THEN !CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"Navier-Stokes/Characteristic converged; # iterations: ", & @@ -15022,7 +15022,7 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux3D0D(equationsSet,err,error,*) INTEGER(INTG) :: faceNodeDerivativeIdx, meshComponentNumber INTEGER(INTG) :: boundaryID,numberOfBoundaries,boundaryType,coupledNodeNumber,numberOfGlobalBoundaries INTEGER(INTG) :: MPI_IERROR,numberOfWorldComputationNodes - INTEGER(INTG) :: computationNode,xiDirection(3),orientation + INTEGER(INTG) :: computationNode,xiDirection(3),orientation,worldCommunicator REAL(DP) :: gaussWeight, elementNormal(3) REAL(DP) :: normalDifference,normalTolerance REAL(DP) :: courant,maxCourant,toleranceCourant,boundaryValueTemp @@ -15254,19 +15254,20 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux3D0D(equationsSet,err,error,*) globalBoundaryFlux = 0.0_DP globalBoundaryArea = 0.0_DP globalBoundaryPressure = 0.0_DP - numberOfWorldComputationNodes=computationEnvironment%numberOfWorldComputationNodes + CALL ComputationEnvironment_NumberOfWorldNodesGet(computationEnvironment,numberOfWorldComputationNodes,err,error,*999) + CALL ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*999) IF(numberOfWorldComputationNodes>1) THEN !use mpi CALL MPI_ALLREDUCE(localBoundaryFlux,globalBoundaryFlux,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(localBoundaryArea,globalBoundaryArea,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(localBoundaryPressure,globalBoundaryPressure,10,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(numberOfBoundaries,numberOfGlobalBoundaries,1,MPI_INTEGER,MPI_MAX, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) ELSE numberOfGlobalBoundaries = numberOfBoundaries @@ -15282,7 +15283,7 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux3D0D(equationsSet,err,error,*) END DO DO boundaryID=2,numberOfGlobalBoundaries IF(globalBoundaryArea(boundaryID) > ZERO_TOLERANCE) THEN - computationNode = ComputationEnvironment_NodeNumberGet(ERR,ERROR) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,computationNode,err,error,*999) IF(computationNode==0) THEN CALL WriteStringTwoValue(DIAGNOSTIC_OUTPUT_TYPE,"3D boundary ",boundaryID," flow: ", & & globalBoundaryFlux(boundaryID),err,error,*999) @@ -15413,8 +15414,7 @@ SUBROUTINE NavierStokes_CalculateBoundaryFlux3D0D(equationsSet,err,error,*) IF(numberOfWorldComputationNodes>1) THEN !use mpi ALLOCATE(globalConverged(numberOfWorldComputationNodes),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate global convergence check array.",ERR,ERROR,*999) - CALL MPI_ALLGATHER(convergedFlag,1,MPI_LOGICAL,globalConverged,1,MPI_LOGICAL, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + CALL MPI_ALLGATHER(convergedFlag,1,MPI_LOGICAL,globalConverged,1,MPI_LOGICAL,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPI_IERROR,ERR,ERROR,*999) IF(ALL(globalConverged)) THEN convergedFlag = .TRUE. diff --git a/src/analytic_analysis_routines.f90 b/src/analytic_analysis_routines.f90 index 2e3db391..2d3095f0 100755 --- a/src/analytic_analysis_routines.f90 +++ b/src/analytic_analysis_routines.f90 @@ -47,6 +47,7 @@ MODULE ANALYTIC_ANALYSIS_ROUTINES USE BASIS_ROUTINES USE CmissMPI USE ComputationRoutines + USE ComputationAccessRoutines USE CONSTANTS USE FIELD_ROUTINES USE FieldAccessRoutines @@ -107,7 +108,7 @@ MODULE ANALYTIC_ANALYSIS_ROUTINES CONTAINS ! - !================================================================================================================================ + !================================================================================================================================= ! !>Output the analytic error analysis for a dependent field compared to the analytic values parameter set. \see OPENCMISS::CMISSAnalyticAnalytisOutput @@ -120,7 +121,7 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) TYPE(VARYING_STRING), INTENT(OUT) :: ERROR !=1) THEN -!!TODO \todo have more general ascii file mechanism - IF(computationEnvironment%numberOfWorldComputationNodes>1) THEN - WRITE(FILE_NAME,'(A,".opanal.",I0)') FILENAME(1:LEN_TRIM(FILENAME)),computationEnvironment% & - & myWorldComputationNodeNumber - ELSE - FILE_NAME=FILENAME(1:LEN_TRIM(FILENAME))//".opanal" - ENDIF - OUTPUT_ID=IO1_FILE_UNIT - OPEN(UNIT=OUTPUT_ID,FILE=FILE_NAME(1:LEN_TRIM(FILE_NAME)),STATUS="REPLACE",FORM="FORMATTED",IOSTAT=ERR) - IF(ERR/=0) CALL FlagError("Error opening analysis output file.",ERR,ERROR,*999) - ELSE - OUTPUT_ID=GENERAL_OUTPUT_TYPE - ENDIF DECOMPOSITION=>FIELD%DECOMPOSITION IF(ASSOCIATED(DECOMPOSITION)) THEN + CALL ComputationEnvironment_NumberOfWorldNodesGet(computationEnvironment,numberOfWorldComputationNodes,err,error,*999) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,myWorldComputationNodeNumber,err,error,*999) + CALL ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*999) DECOMPOSITION_TOPOLOGY=>DECOMPOSITION%TOPOLOGY IF(ASSOCIATED(DECOMPOSITION_TOPOLOGY)) THEN + IF(LEN_TRIM(FILENAME)>=1) THEN +!!TODO \todo have more general ascii file mechanism + IF(numberOfWorldComputationNodes>1) THEN + WRITE(FILE_NAME,'(A,".opanal.",I0)') FILENAME(1:LEN_TRIM(FILENAME)),myWorldComputationNodeNumber + ELSE + FILE_NAME=FILENAME(1:LEN_TRIM(FILENAME))//".opanal" + ENDIF + OUTPUT_ID=IO1_FILE_UNIT + OPEN(UNIT=OUTPUT_ID,FILE=FILE_NAME(1:LEN_TRIM(FILE_NAME)),STATUS="REPLACE",FORM="FORMATTED",IOSTAT=ERR) + IF(ERR/=0) CALL FlagError("Error opening analysis output file.",ERR,ERROR,*999) + ELSE + OUTPUT_ID=GENERAL_OUTPUT_TYPE + ENDIF CALL WRITE_STRING(OUTPUT_ID,"Analytic error analysis:",ERR,ERROR,*999) CALL WRITE_STRING(OUTPUT_ID,"",ERR,ERROR,*999) LOCAL_STRING="Field "//TRIM(NUMBER_TO_VSTRING(FIELD%USER_NUMBER,"*",ERR,ERROR))//" : "//FIELD%LABEL @@ -270,7 +273,7 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) !Output RMS errors CALL WRITE_STRING(OUTPUT_ID,"",ERR,ERROR,*999) IF(NUMBER(1)>0) THEN - IF(computationEnvironment%numberOfWorldComputationNodes>1) THEN + IF(numberOfWorldComputationNodes>1) THEN !Local elements only CALL WRITE_STRING(OUTPUT_ID,"Local RMS errors:",ERR,ERROR,*999) LOCAL_STRING= & @@ -293,17 +296,16 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) & ERR,ERROR,*999) !Global RMS values !Collect the values across the ranks - CALL MPI_ALLREDUCE(MPI_IN_PLACE,NUMBER,1,MPI_INTEGER,MPI_SUM, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + CALL MPI_ALLREDUCE(MPI_IN_PLACE,NUMBER,1,MPI_INTEGER,MPI_SUM,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR_PER,1,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR_ABS,1,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR_REL,1,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL WRITE_STRING(OUTPUT_ID,"Global RMS errors:",ERR,ERROR,*999) LOCAL_STRING= & @@ -400,7 +402,7 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) ENDDO !node_idx !Output RMS errors CALL WRITE_STRING(OUTPUT_ID,"",ERR,ERROR,*999) - IF(computationEnvironment%numberOfWorldComputationNodes>1) THEN + IF(numberOfWorldComputationNodes>1) THEN IF(ANY(NUMBER>0)) THEN !Local nodes only CALL WRITE_STRING(OUTPUT_ID,"Local RMS errors:",ERR,ERROR,*999) @@ -437,17 +439,16 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) ENDDO !deriv_idx !Global RMS values !Collect the values across the ranks - CALL MPI_ALLREDUCE(MPI_IN_PLACE,NUMBER,8,MPI_INTEGER,MPI_SUM, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + CALL MPI_ALLREDUCE(MPI_IN_PLACE,NUMBER,8,MPI_INTEGER,MPI_SUM,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR_PER,8,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR_ABS,8,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR_REL,8,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL WRITE_STRING(OUTPUT_ID,"Global RMS errors:",ERR,ERROR,*999) LOCAL_STRING= & @@ -517,7 +518,7 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) ALLOCATE(GHOST_INTEGRAL_ERRORS(6,FIELD_VARIABLE%NUMBER_OF_COMPONENTS),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate ghost integral errors.",ERR,ERROR,*999) CALL ANALYTIC_ANALYSIS_INTEGRAL_ERRORS(FIELD_VARIABLE,INTEGRAL_ERRORS,GHOST_INTEGRAL_ERRORS,ERR,ERROR,*999) - IF(computationEnvironment%numberOfWorldComputationNodes>1) THEN + IF(numberOfWorldComputationNodes>1) THEN CALL WRITE_STRING(OUTPUT_ID,"Local Integral errors:",ERR,ERROR,*999) LOCAL_STRING="Component# Numerical Analytic % error Absolute err Relative err" CALL WRITE_STRING(OUTPUT_ID,LOCAL_STRING,ERR,ERROR,*999) @@ -590,7 +591,7 @@ SUBROUTINE AnalyticAnalysis_Output(FIELD,FILENAME,ERR,ERROR,*) ENDDO !component_idx !Collect the values across the ranks CALL MPI_ALLREDUCE(MPI_IN_PLACE,INTEGRAL_ERRORS,6*FIELD_VARIABLE%NUMBER_OF_COMPONENTS,MPI_DOUBLE_PRECISION, & - & MPI_SUM,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & MPI_SUM,worldCommunicator,MPI_IERROR) CALL WRITE_STRING(OUTPUT_ID,"Global Integral errors:",ERR,ERROR,*999) LOCAL_STRING="Component# Numerical Analytic % error Absolute err Relative err" CALL WRITE_STRING(OUTPUT_ID,LOCAL_STRING,ERR,ERROR,*999) @@ -1648,7 +1649,8 @@ SUBROUTINE AnalyticAnalysis_RMSErrorGetNode(FIELD,VARIABLE_TYPE,COMPONENT_NUMBER TYPE(VARYING_STRING), INTENT(OUT) :: ERROR !FIELD%VARIABLE_TYPE_MAP(VARIABLE_TYPE)%PTR%COMPONENTS(COMPONENT_NUMBER)%DOMAIN%TOPOLOGY%NODES IF(ASSOCIATED(NODES_DOMAIN)) THEN NUMBER=0 @@ -1709,7 +1714,7 @@ SUBROUTINE AnalyticAnalysis_RMSErrorGetNode(FIELD,VARIABLE_TYPE,COMPONENT_NUMBER ENDDO !deriv_idx ENDDO !node_idx - IF(computationEnvironment%numberOfWorldComputationNodes>1) THEN + IF(numberOfWorldComputationNodes>1) THEN IF(ANY(NUMBER>0)) THEN DO deriv_idx=1,8 IF(NUMBER(deriv_idx)>0) THEN @@ -1719,15 +1724,14 @@ SUBROUTINE AnalyticAnalysis_RMSErrorGetNode(FIELD,VARIABLE_TYPE,COMPONENT_NUMBER DO deriv_idx=1,8 IF(NUMBER(deriv_idx)>0) THEN LOCAL_GHOST_RMS(deriv_idx)=SQRT((RMS_ERROR(deriv_idx)+GHOST_RMS_ERROR(deriv_idx))/(NUMBER(deriv_idx) & - & +GHOST_NUMBER(deriv_idx))) + & +GHOST_NUMBER(deriv_idx))) ENDIF ENDDO !deriv_idx !Global RMS values !Collect the values across the ranks - CALL MPI_ALLREDUCE(MPI_IN_PLACE,NUMBER,8,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + CALL MPI_ALLREDUCE(MPI_IN_PLACE,NUMBER,8,MPI_INTEGER,MPI_SUM,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) - CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR,8,MPI_DOUBLE_PRECISION,MPI_SUM,computationEnvironment%mpiWorldCommunicator, & - & MPI_IERROR) + CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR,8,MPI_DOUBLE_PRECISION,MPI_SUM,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) DO deriv_idx=1,8 IF(NUMBER(deriv_idx)>0) THEN @@ -1756,6 +1760,7 @@ SUBROUTINE AnalyticAnalysis_RMSErrorGetNode(FIELD,VARIABLE_TYPE,COMPONENT_NUMBER RETURN 999 ERRORSEXITS("AnalyticAnalysis_RMSErrorGetNode",ERR,ERROR) RETURN 1 + END SUBROUTINE AnalyticAnalysis_RMSErrorGetNode ! @@ -1778,7 +1783,7 @@ SUBROUTINE AnalyticAnalysis_RMSErrorGetElement(FIELD,VARIABLE_TYPE,COMPONENT_NUM TYPE(VARYING_STRING), INTENT(OUT) :: ERROR !FIELD%VARIABLE_TYPE_MAP(VARIABLE_TYPE)%PTR%COMPONENTS(COMPONENT_NUMBER)%DOMAIN ELEMENTS_DOMAIN=>DOMAIN%TOPOLOGY%ELEMENTS IF(ASSOCIATED(ELEMENTS_DOMAIN)) THEN @@ -1838,18 +1846,16 @@ SUBROUTINE AnalyticAnalysis_RMSErrorGetElement(FIELD,VARIABLE_TYPE,COMPONENT_NUM GHOST_RMS_ERROR=GHOST_RMS_ERROR+ERROR_VALUE*ERROR_VALUE ENDDO !element_idx IF(NUMBER>0) THEN - IF(computationEnvironment%numberOfWorldComputationNodes>1) THEN + IF(numberOfWorldComputationNodes>1) THEN !Local elements only LOCAL_RMS=SQRT(RMS_ERROR/NUMBER) !Local and ghost elements LOCAL_GHOST_RMS=SQRT((RMS_ERROR+GHOST_RMS_ERROR)/(NUMBER+GHOST_NUMBER)) !Global RMS values !Collect the values across the ranks - CALL MPI_ALLREDUCE(MPI_IN_PLACE,NUMBER,1,MPI_INTEGER,MPI_SUM, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + CALL MPI_ALLREDUCE(MPI_IN_PLACE,NUMBER,1,MPI_INTEGER,MPI_SUM,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) - CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR,1,MPI_DOUBLE_PRECISION,MPI_SUM, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + CALL MPI_ALLREDUCE(MPI_IN_PLACE,RMS_ERROR,1,MPI_DOUBLE_PRECISION,MPI_SUM,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) GLOBAL_RMS=SQRT(RMS_ERROR/NUMBER) ENDIF diff --git a/src/boundary_condition_routines.f90 b/src/boundary_condition_routines.f90 index 069870f9..601b4d96 100755 --- a/src/boundary_condition_routines.f90 +++ b/src/boundary_condition_routines.f90 @@ -26,7 +26,7 @@ !> Auckland, the University of Oxford and King's College, London. !> All Rights Reserved. !> -!> Contributor(s): Chris Bradley +!> Contributor(s): Ting Yu, Chris Bradley !> !> Alternatively, the contents of this file may be used under the terms of !> either the GNU General Public License Version 2 or later (the "GPL"), or @@ -48,6 +48,7 @@ MODULE BOUNDARY_CONDITIONS_ROUTINES USE BASIS_ROUTINES USE CmissMPI USE ComputationRoutines + USE ComputationAccessRoutines USE CONSTANTS USE COORDINATE_ROUTINES USE DISTRIBUTED_MATRIX_VECTOR @@ -192,7 +193,7 @@ SUBROUTINE BOUNDARY_CONDITIONS_CREATE_FINISH(BOUNDARY_CONDITIONS,ERR,ERROR,*) INTEGER(INTG) :: MPI_IERROR,SEND_COUNT,STORAGE_TYPE, NUMBER_OF_NON_ZEROS, NUMBER_OF_ROWS,COUNT INTEGER(INTG) :: variable_idx,dof_idx, equ_matrix_idx, dirichlet_idx, row_idx, DUMMY, LAST, DIRICHLET_DOF INTEGER(INTG) :: col_idx,equations_set_idx,parameterSetIdx - INTEGER(INTG) :: pressureIdx,neumannIdx + INTEGER(INTG) :: pressureIdx,neumannIdx,numberOfWorldComputationNodes,myWorldComputationNodeNumber,worldCommunicator INTEGER(INTG), POINTER :: ROW_INDICES(:), COLUMN_INDICES(:) TYPE(BOUNDARY_CONDITIONS_VARIABLE_TYPE), POINTER :: BOUNDARY_CONDITION_VARIABLE TYPE(DOMAIN_MAPPING_TYPE), POINTER :: VARIABLE_DOMAIN_MAPPING @@ -222,7 +223,10 @@ SUBROUTINE BOUNDARY_CONDITIONS_CREATE_FINISH(BOUNDARY_CONDITIONS,ERR,ERROR,*) CALL FlagError("Boundary conditions have already been finished.",ERR,ERROR,*999) ELSE IF(ALLOCATED(BOUNDARY_CONDITIONS%BOUNDARY_CONDITIONS_VARIABLES)) THEN - IF(computationEnvironment%numberOfWorldComputationNodes>0) THEN + CALL ComputationEnvironment_NumberOfWorldNodesGet(computationEnvironment,numberOfWorldComputationNodes,err,error,*999) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,myWorldComputationNodeNumber,err,error,*999) + CALL ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*999) + IF(numberOfWorldComputationNodes>0) THEN !Transfer all the boundary conditions to all the computation nodes. !\todo Look at this. DO variable_idx=1,BOUNDARY_CONDITIONS%NUMBER_OF_BOUNDARY_CONDITIONS_VARIABLES @@ -236,10 +240,10 @@ SUBROUTINE BOUNDARY_CONDITIONS_CREATE_FINISH(BOUNDARY_CONDITIONS,ERR,ERROR,*) !\todo This operation is a little expensive as we are doing an unnecessary sum across all the ranks in order to combin !\todo the data from each rank into all ranks. We will see how this goes for now. CALL MPI_ALLREDUCE(MPI_IN_PLACE,BOUNDARY_CONDITION_VARIABLE%DOF_TYPES, & - & SEND_COUNT,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & SEND_COUNT,MPI_INTEGER,MPI_SUM,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,BOUNDARY_CONDITION_VARIABLE%CONDITION_TYPES, & - & SEND_COUNT,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & SEND_COUNT,MPI_INTEGER,MPI_SUM,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) ELSE LOCAL_ERROR="Field variable domain mapping is not associated for variable type "// & @@ -249,10 +253,10 @@ SUBROUTINE BOUNDARY_CONDITIONS_CREATE_FINISH(BOUNDARY_CONDITIONS,ERR,ERROR,*) ! Update the total number of boundary condition types by summing across all nodes CALL MPI_ALLREDUCE(MPI_IN_PLACE,BOUNDARY_CONDITION_VARIABLE%DOF_COUNTS, & - & MAX_BOUNDARY_CONDITION_NUMBER,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & MAX_BOUNDARY_CONDITION_NUMBER,MPI_INTEGER,MPI_SUM,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) CALL MPI_ALLREDUCE(MPI_IN_PLACE,BOUNDARY_CONDITION_VARIABLE%NUMBER_OF_DIRICHLET_CONDITIONS, & - & 1,MPI_INTEGER,MPI_SUM,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & 1,MPI_INTEGER,MPI_SUM,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) ! Check that the boundary conditions set are appropriate for equations sets @@ -260,7 +264,7 @@ SUBROUTINE BOUNDARY_CONDITIONS_CREATE_FINISH(BOUNDARY_CONDITIONS,ERR,ERROR,*) !Make sure the required parameter sets are created on all computation nodes and begin updating them CALL MPI_ALLREDUCE(MPI_IN_PLACE,BOUNDARY_CONDITION_VARIABLE%parameterSetRequired, & - & FIELD_NUMBER_OF_SET_TYPES,MPI_LOGICAL,MPI_LOR,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & FIELD_NUMBER_OF_SET_TYPES,MPI_LOGICAL,MPI_LOR,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPI_IERROR,ERR,ERROR,*999) DO parameterSetIdx=1,FIELD_NUMBER_OF_SET_TYPES IF(BOUNDARY_CONDITION_VARIABLE%parameterSetRequired(parameterSetIdx)) THEN @@ -1141,7 +1145,7 @@ SUBROUTINE BOUNDARY_CONDITIONS_ADD_LOCAL_DOF1(BOUNDARY_CONDITIONS,FIELD,VARIABLE ENTERS("BOUNDARY_CONDITIONS_ADD_LOCAL_DOF1",ERR,ERROR,*999) - CALL BOUNDARY_CONDITIONS_ADD_LOCAL_DOFS(BOUNDARY_CONDITIONS,FIELD,VARIABLE_TYPE,(/DOF_INDEX/),(/CONDITION/),(/VALUE/), & + CALL BOUNDARY_CONDITIONS_ADD_LOCAL_DOFS(BOUNDARY_CONDITIONS,FIELD,VARIABLE_TYPE,[DOF_INDEX],[CONDITION],[VALUE], & & ERR,ERROR,*999) EXITS("BOUNDARY_CONDITIONS_ADD_LOCAL_DOF1") @@ -1335,7 +1339,7 @@ SUBROUTINE BOUNDARY_CONDITIONS_SET_LOCAL_DOF1(BOUNDARY_CONDITIONS,FIELD,VARIABLE ENTERS("BOUNDARY_CONDITIONS_SET_LOCAL_DOF1",ERR,ERROR,*999) - CALL BOUNDARY_CONDITIONS_SET_LOCAL_DOFS(BOUNDARY_CONDITIONS,FIELD,VARIABLE_TYPE,(/DOF_INDEX/),(/CONDITION/),(/VALUE/), & + CALL BOUNDARY_CONDITIONS_SET_LOCAL_DOFS(BOUNDARY_CONDITIONS,FIELD,VARIABLE_TYPE,[DOF_INDEX],[CONDITION],[VALUE], & & ERR,ERROR,*999) EXITS("BOUNDARY_CONDITIONS_SET_LOCAL_DOF1") @@ -2420,7 +2424,7 @@ SUBROUTINE BoundaryConditions_NeumannMatricesInitialise(boundaryConditionsVariab !Set up vector of Neumann point values CALL DISTRIBUTED_VECTOR_CREATE_START(pointDofMapping,boundaryConditionsNeumann%pointValues,err,error,*999) CALL DISTRIBUTED_VECTOR_CREATE_FINISH(boundaryConditionsNeumann%pointValues,err,error,*999) - myWorldComputationNodeNumber=ComputationEnvironment_NodeNumberGet(err,error) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,myWorldComputationNodeNumber,err,error,*999) !Set point values vector from boundary conditions field parameter set DO neumannIdx=1,numberOfPointDofs globalDof=boundaryConditionsNeumann%setDofs(neumannIdx) @@ -2592,7 +2596,7 @@ SUBROUTINE BoundaryConditions_NeumannIntegrate(rhsBoundaryConditions,err,error,* numberOfNeumann=rhsBoundaryConditions%DOF_COUNTS(BOUNDARY_CONDITION_NEUMANN_POINT) + & & rhsBoundaryConditions%DOF_COUNTS(BOUNDARY_CONDITION_NEUMANN_POINT_INCREMENTED) - myWorldComputationNodeNumber=ComputationEnvironment_NodeNumberGet(err,error) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,myWorldComputationNodeNumber,err,error,*999) ! Initialise field interpolation parameters for the geometric field, which are required for the ! face/line Jacobian and scale factors diff --git a/src/cmiss.f90 b/src/cmiss.f90 index b27691c2..2d56a3fe 100755 --- a/src/cmiss.f90 +++ b/src/cmiss.f90 @@ -55,6 +55,7 @@ MODULE Cmiss USE BaseRoutines USE BASIS_ROUTINES USE ComputationRoutines + USE ComputationAccessRoutines USE Constants USE COORDINATE_ROUTINES USE GENERATED_MESH_ROUTINES @@ -241,6 +242,7 @@ SUBROUTINE cmfe_Initialise_(worldRegion,err,error,*) INTEGER(INTG), INTENT(INOUT) :: err ! \file +!> \author Chris Bradley +!> \brief This module contains all computation access method routines. +!> +!> \section LICENSE +!> +!> Version: MPL 1.1/GPL 2.0/LGPL 2.1 +!> +!> The contents of this file are subject to the Mozilla Public License +!> Version 1.1 (the "License"); you may not use this file except in +!> compliance with the License. You may obtain a copy of the License at +!> http://www.mozilla.org/MPL/ +!> +!> Software distributed under the License is distributed on an "AS IS" +!> basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the +!> License for the specific language governing rights and limitations +!> under the License. +!> +!> The Original Code is OpenCMISS +!> +!> The Initial Developer of the Original Code is University of Auckland, +!> Auckland, New Zealand, the University of Oxford, Oxford, United +!> Kingdom and King's College, London, United Kingdom. Portions created +!> by the University of Auckland, the University of Oxford and King's +!> College, London are Copyright (C) 2007-2010 by the University of +!> Auckland, the University of Oxford and King's College, London. +!> All Rights Reserved. +!> +!> Contributor(s): Chris Bradley +!> +!> Alternatively, the contents of this file may be used under the terms of +!> either the GNU General Public License Version 2 or later (the "GPL"), or +!> the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), +!> in which case the provisions of the GPL or the LGPL are applicable instead +!> of those above. If you wish to allow use of your version of this file only +!> under the terms of either the GPL or the LGPL, and not to allow others to +!> use your version of this file under the terms of the MPL, indicate your +!> decision by deleting the provisions above and replace them with the notice +!> and other provisions required by the GPL or the LGPL. If you do not delete +!> the provisions above, a recipient may use your version of this file under +!> the terms of any one of the MPL, the GPL or the LGPL. +!> + +!> This module contains all computation access method routines. +MODULE ComputationAccessRoutines + + USE BaseRoutines + USE Kinds +#ifndef NOMPIMOD + USE MPI +#endif + USE Strings + USE Types + +#include "macros.h" + + IMPLICIT NONE + + PRIVATE + +#ifdef NOMPIMOD +#include "mpif.h" +#endif + + !Module parameters + + !Module types + + !>pointer type to WorkGroupType + TYPE WorkGroupPtrType + TYPE(WorkGroupType), POINTER :: ptr + END TYPE WorkGroupPtrType + + !>Contains information on logical working groups + TYPE WorkGroupType + INTEGER(INTG) :: userNumber !Contains information on a cache heirarchy + TYPE ComputationCacheType + INTEGER(INTG) :: numberOfLevels !Contains information on a computation node containing a number of processors + TYPE ComputationNodeType + INTEGER(INTG) :: numberOfProcessors !Contains information on the MPI type to transfer information about a computation node + TYPE MPIComputationNodeType + INTEGER(INTG) :: mpiType !Contains information on the computation environment the program is running in. + TYPE ComputationEnvironmentType + INTEGER(INTG) :: mpiVersion !Gets the current world communicator. + SUBROUTINE ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*) + + !Argument Variables + TYPE(ComputationEnvironmentType), INTENT(IN) :: computationEnvironment !Returns the number/rank of the computation node in the world communicator + SUBROUTINE ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,worldNodeNumber,err,error,*) + + !Argument Variables + TYPE(ComputationEnvironmentType), INTENT(IN) :: computationEnvironment !Gets the number of computation nodes in the world communicator. + SUBROUTINE ComputationEnvironment_NumberOfWorldNodesGet(computationEnvironment,numberOfWorldNodes,err,error,*) + + !Argument Variables + TYPE(ComputationEnvironmentType), INTENT(IN) :: computationEnvironment !Gets the world work group from a computational environment. + SUBROUTINE ComputationEnvironment_WorldWorkGroupGet(computationEnvironment,worldWorkGroup,err,error,*) + + !Argument variables + TYPE(ComputationEnvironmentType), INTENT(IN) :: computationEnvironment !computationEnvironment%worldWorkGroup + !Check world work group is associated. + IF(.NOT.ASSOCIATED(worldWorkGroup)) & + & CALL FlagError("World work group is not associated for the computation environment.",err,error,*999) + + EXITS("ComputationEnvironment_WorldWorkGroupGet") + RETURN +999 NULLIFY(worldWorkGroup) +998 ERRORSEXITS("ComputationEnvironment_WorldWorkGroupGet",err,error) + RETURN 1 + + END SUBROUTINE ComputationEnvironment_WorldWorkGroupGet + + ! + !================================================================================================================================ + ! + + !>Gets the group communicator from a work group. + SUBROUTINE WorkGroup_GroupCommunicatorGet(workGroup,groupCommunicator,err,error,*) + + !Argument variables + TYPE(WorkGroupType), POINTER, INTENT(IN) :: workGroup !Gets the number/rank of the computation node in the work group communicator + SUBROUTINE WorkGroup_GroupNodeNumberGet(workGroup,groupNodeNumber,err,error,*) + + !Argument Variables + TYPE(WorkGroupType), POINTER, INTENT(IN) :: workGroup !Returns the character label of a work group \see OpenCMISS::Iron::cmfe_WorkGroup_LabelGet + SUBROUTINE WorkGroup_LabelGetC(workGroup,label,err,error,*) + + !Argument Variables + TYPE(WorkGroupType), POINTER, INTENT(IN) :: workGroup !Returns the varying string label of a work group \see OpenCMISS::Iron::cmfe_WorkGroup_LabelGet + SUBROUTINE WorkGroup_LabelGetVS(workGroup,label,err,error,*) + + !Argument Variables + TYPE(WorkGroupType), POINTER, INTENT(IN) :: workGroup !Gets the number of computation nodes in the work group communicator. + SUBROUTINE WorkGroup_NumberOfGroupNodesGet(workGroup,numberOfGroupNodes,err,error,*) + + !Argument Variables + TYPE(WorkGroupType), POINTER, INTENT(IN) :: workGroup !Gets the parent work group from a work group. + SUBROUTINE WorkGroup_ParentWorkGroupGet(workGroup,parentWorkGroup,err,error,*) + + !Argument variables + TYPE(WorkGroupType), POINTER, INTENT(IN) :: workGroup !workGroup%parentWorkGroup + !Check parent work group is associated. + IF(.NOT.ASSOCIATED(parentWorkGroup)) THEN + localError="Parent work group is not associated for work group "// & + & TRIM(NumberToVString(workGroup%userNumber,"*",err,error))//"." + CALL FlagError(localError,err,error,*999) + ENDIF + + EXITS("WorkGroup_ParentWorkGroupGet") + RETURN +999 NULLIFY(parentWorkGroup) +998 ERRORSEXITS("WorkGroup_ParentWorkGroupGet",err,error) + RETURN 1 + + END SUBROUTINE WorkGroup_ParentWorkGroupGet + + ! + !================================================================================================================================ + ! + + !>Finds and returns a pointer to the work group with the given user number. If no work group with that number exists work group is left nullified. + SUBROUTINE WorkGroup_UserNumberFind(userNumber,computationEnvironment,workGroup,err,error,*) + + !Argument variables + INTEGER(INTG), INTENT(IN) :: userNumber !computationEnvironment%worldWorkGroup + IF(.NOT.ASSOCIATED(worldWorkGroup)) CALL FlagError("World work group is not associated.",err,error,*999) + + NULLIFY(workGroup) + IF(userNumber==0) THEN + workGroup=>worldWorkGroup + ELSE + CALL WorkGroup_UserNumberFindPtr(userNumber,worldWorkGroup,workGroup,err,error,*999) + ENDIF + + EXITS("WorkGroup_UserNumberFind") + RETURN +999 ERRORSEXITS("WorkGroup_UserNumberFind",err,error) + RETURN 1 + + END SUBROUTINE WorkGroup_UserNumberFind + + ! + !================================================================================================================================ + ! + + !>Finds and returns a pointer to the work group with the given user number starting from the given start work group and searching all sub-groups under the start work group. If no work group with that number exists work group is left nullified. + RECURSIVE SUBROUTINE WorkGroup_UserNumberFindPtr(userNumber,startWorkGroup,workGroup,err,error,*) + + !Argument variables + INTEGER(INTG), INTENT(IN) :: userNumber !startWorkGroup + ELSE + IF(ALLOCATED(startWorkGroup%subGroups)) THEN + DO workGroupIdx=1,startWorkGroup%numberOfSubGroups + CALL WorkGroup_UserNumberFindPtr(userNumber,startWorkGroup%subGroups(workGroupIdx)%ptr,workGroup,err,error,*999) + IF(ASSOCIATED(workGroup)) EXIT + ENDDO !workGroupIdx + ENDIF + ENDIF + + EXITS("WorkGroup_UserNumberFindPtr") + RETURN +999 ERRORSEXITS("WorkGroup_UserNumberFindPtr",err,error) + RETURN 1 + + END SUBROUTINE WorkGroup_UserNumberFindPtr + + ! + !================================================================================================================================ + ! + + !>Returns the user number for a region. + SUBROUTINE WorkGroup_UserNumberGet(workGroup,userNumber,err,error,*) + + !Argument variables + TYPE(WorkGroupType), POINTER, INTENT(IN) :: workGroup !Gets a sub work group from a work group. + SUBROUTINE WorkGroup_WorkSubGroupGet(workGroup,subGroupIdx,subWorkGroup,err,error,*) + + !Argument variables + TYPE(WorkGroupType), POINTER, INTENT(IN) :: workGroup !workGroup%numberOfSubGroups) THEN + localError="The specified sub group index of "//TRIM(NumberToVString(subGroupIdx,"*",err,error))// & + & " is invalid. The sub group index must be >=1 and <= "// & + & TRIM(NumberToVString(workGroup%numberOfSubGroups,"*",err,error))//"." + CALL FlagError(localError,err,error,*999) + ENDIF + + !Get the parent work group + subWorkGroup=>workGroup%subGroups(subGroupIdx)%ptr + !Check sub work group is associated. + IF(.NOT.ASSOCIATED(subWorkGroup)) THEN + localError="The sub work group is not associated for sub group index "// & + & TRIM(NumberToVString(subGroupIdx,"*",err,error))//" of work group "// & + & TRIM(NumberToVString(workGroup%userNumber,"*",err,error))//"." + CALL FlagError(localError,err,error,*999) + ENDIF + + EXITS("WorkGroup_WorkSubGroupGet") + RETURN +999 NULLIFY(subWorkGroup) +998 ERRORSEXITS("WorkGroup_WorkSubGroupGet",err,error) + RETURN 1 + + END SUBROUTINE WorkGroup_WorkSubGroupGet + + ! + !================================================================================================================================ + ! + +END MODULE ComputationAccessRoutines diff --git a/src/computation_routines.f90 b/src/computation_routines.f90 index f505edc5..33eed5c0 100755 --- a/src/computation_routines.f90 +++ b/src/computation_routines.f90 @@ -48,6 +48,7 @@ MODULE ComputationRoutines USE BaseRoutines USE CmissMPI USE CmissPetsc + USE ComputationAccessRoutines USE Constants USE Kinds #ifndef NOMPIMOD @@ -55,394 +56,47 @@ MODULE ComputationRoutines #endif USE INPUT_OUTPUT USE ISO_VARYING_STRING + USE Sorting USE Strings #include "macros.h" IMPLICIT NONE + PRIVATE + #ifdef NOMPIMOD #include "mpif.h" #endif - PRIVATE - !Module parameters !Module types - !>pointer type to ComputationWorkGroupType - TYPE :: ComputationWorkGroupPtrType - TYPE(ComputationWorkGroupType), POINTER :: ptr - END TYPE ComputationWorkGroupPtrType - - !>Contains information on logical working groups - TYPE :: ComputationWorkGroupType - LOGICAL :: workGroupFinished !Contains information on a cache heirarchy - TYPE ComputationCacheType - INTEGER(INTG) :: numberOfLevels !Contains information on a computation node containing a number of processors - TYPE ComputationNodeType - INTEGER(INTG) :: numberOfProcessors !Contains information on the MPI type to transfer information about a computation node - TYPE MPIComputationNodeType - INTEGER(INTG) :: mpiType !Contains information on the computation environment the program is running in. - TYPE ComputationEnvironmentType - INTEGER(INTG) :: mpiVersion !Finalise a work group and deallocate all memory - RECURSIVE SUBROUTINE Computation_WorkGroupFinalise(workGroup,err,error,*) + PUBLIC WorkGroup_CreateFinish,WorkGroup_CreateStart - !Argument Variables - TYPE(ComputationWorkGroupType),POINTER :: workGroup !Add the work sub-group to the parent group based on the computation requirements (called by user) - SUBROUTINE Computation_WorkGroupInitialise(workGroup,err,error,*) - - !Argument Variables - TYPE(ComputationWorkGroupType),POINTER, INTENT(OUT) :: workGroup !Add the work sub-group to the parent group based on the computation requirements (called by user) - SUBROUTINE Computation_WorkGroupSubGroupAdd(parentWorkGroup,numberOfComputationNodes,subWorkGroup,err,error,*) - - !Argument Variables - TYPE(ComputationWorkGroupType),POINTER, INTENT(INOUT) :: parentWorkGroup - TYPE(ComputationWorkGroupType),POINTER, INTENT(INOUT) :: subWorkGroup - INTEGER(INTG),INTENT(IN) :: numberOfComputationNodes - INTEGER(INTG), INTENT(OUT) :: err !parentWorkGroup%subGroups(I)%ptr - ENDDO - !subGroups(1:parentWorkGroup%numberOfSubGroups)=>parentWorkGroup%subGroups(:) - - IF(ALLOCATED(parentWorkGroup%subGroups)) THEN - DEALLOCATE(parentWorkGroup%subGroups) - ENDIF - subGroups(1+parentWorkGroup%numberOfSubGroups)%ptr=>newWorkGroup%ptr - ALLOCATE(parentWorkGroup%subGroups(SIZE(subGroups,1))) - DO I=1,SIZE(subGroups,1) - parentWorkGroup%subGroups(I)%ptr => subGroups(I)%ptr - ENDDO - !parentWorkGroup%subGroups(:) => subGroups(:) - - DEALLOCATE(subGroups) - parentWorkGroup%numberOfSubGroups = 1+parentWorkGroup%numberOfSubGroups - newWorkGroup%ptr%PARENT => parentWorkGroup - tmpParentWorkGroup => parentWorkGroup - DO WHILE(ASSOCIATED(tmpParentWorkGroup)) !Update the computation number of its ancestors - tmpParentWorkGroup%numberOfComputationNodes = tmpParentWorkGroup%numberOfComputationNodes & - & + newWorkGroup%ptr%numberOfComputationNodes - tmpParentWorkGroup => tmpParentWorkGroup%PARENT - ENDDO - ELSE !Top level group - CALL FlagError('parentWorkGroup is not associated, call COMPUTATION_WORK_GROUP_CREATE_START first',& - & err,error,*999) - ENDIF - subWorkGroup => newWorkGroup%ptr - - EXITS("Computation_WorkGroupSubGroupAdd") - RETURN -999 ERRORSEXITS("Computation_WorkGroupSubGroupAdd",err,error) - RETURN 1 - - END SUBROUTINE Computation_WorkGroupSubGroupAdd - - ! - !================================================================================================================================ - ! - - !>Start the creation of a work group - SUBROUTINE Computation_WorkGroupCreateStart(parentWorkGroup,numberOfComputationNodes,workGroup,err,error,*) - - !Argument Variables - TYPE(ComputationWorkGroupType), POINTER, INTENT(INOUT) :: parentWorkGroup !parentWorkGroup%numberOfAvailableRanks) THEN - localError="The requested number of computation nodes is invalid. The number of computation nodes must be > 0 and <= "// & - & TRIM(NumberToVString(parentWorkGroup%numberOfAvailableRanks,"*",err,error))//"." - CALL FlagError(localError,err,error,*999) - ENDIF - - CALL Computation_WorkGroupInitialise(workGroup,err,error,*999) - - EXITS("Computation_WorkGroupCreateStart") - RETURN -999 ERRORSEXITS("Computation_WorkGroupCreateStart",err,error) - RETURN 1 - - END SUBROUTINE Computation_WorkGroupCreateStart - - ! - !================================================================================================================================ - ! - - !>Generate computation environment for current level work group tree and all it's subgroups recursively - RECURSIVE SUBROUTINE Computation_WorkGroupGenerateCompEnviron(workGroup,availableRankList,err,error,*) - - !Argument Variables - TYPE(ComputationWorkGroupType),POINTER, INTENT(INOUT) :: workGroup - INTEGER(INTG), ALLOCATABLE, INTENT(INOUT) :: availableRankList(:) - INTEGER(INTG), INTENT(OUT) :: err !Generate the hierarchy computation environment based on work group tree - SUBROUTINE Computation_WorkGroupCreateFinish(worldWorkGroup,err,error,*) - - !Argument Variables - TYPE(ComputationWorkGroupType),POINTER,INTENT(INOUT) :: worldWorkGroup - INTEGER(INTG),INTENT(OUT) :: err ! computationEnvironment - worldWorkGroup%computationEnvironmentFinished = .TRUE. - - !generate the communicators for subgroups if any - ALLOCATE(availableRankList(worldWorkGroup%computationEnvironment%numberOfWorldComputationNodes)) - DO rankIdx=0,SIZE(availableRankList,1)-1 - availableRankList(rankIdx+1) = rankIdx - ENDDO !rankIdx - DO subGroupIdx=1,worldWorkGroup%numberOfSubGroups,1 - CALL Computation_WorkGroupGenerateCompEnviron(worldWorkGroup%subGroups(subGroupIdx)%ptr,availableRankList, & - & err,error,*999) - ENDDO !subGroupIdx - - EXITS("Computation_WorkGroupCreateFinish") - RETURN -999 ERRORSEXITS("Computation_WorkGroupCreateFinish",err,error) - RETURN 1 - - END SUBROUTINE Computation_WorkGroupCreateFinish +CONTAINS ! !================================================================================================================================ @@ -630,8 +284,97 @@ END SUBROUTINE Computation_MPIComputationNodeInitialise !================================================================================================================================= ! + !>Finalises the computation data structures and deallocates all memory. + SUBROUTINE Computation_Finalise(err,error,*) + + !Argument Variables + INTEGER(INTG), INTENT(OUT) :: err !Initialises the computation data structures. + SUBROUTINE Computation_Initialise(err,error,*) + + !Argument Variables + INTEGER(INTG), INTENT(OUT) :: err !Finalises the computation environment data structures and deallocates all memory. - SUBROUTINE Computation_ComputationEnvironmentFinalise(computationEnvironment,err,error,*) + SUBROUTINE ComputationEnvironment_Finalise(computationEnvironment,err,error,*) !Argument Variables TYPE(ComputationEnvironmentType) :: computationEnvironment !Initialises the computation environment data structures. - SUBROUTINE Computation_ComputationEnvironmentInitialise(computationEnvironment,err,error,*) + SUBROUTINE ComputationEnvironment_Initialise(computationEnvironment,err,error,*) !Argument Variables TYPE(ComputationEnvironmentType) :: computationEnvironment !computationEnvironment%worldWorkGroup + computationEnvironment%worldWorkGroup%numberOfGroupComputationNodes=computationEnvironment%numberOfWorldComputationNodes + !computationEnvironment%worldWorkGroup%computationEnvironment=>computationEnvironment + ALLOCATE(computationEnvironment%worldWorkGroup%worldRanks(computationEnvironment%numberOfWorldComputationNodes),STAT=err) + IF(err/=0) CALL FlagError("Could not allocate world work group world ranks.",err,error,*999) + ALLOCATE(computationEnvironment%worldWorkGroup%availableRanks(computationEnvironment%numberOfWorldComputationNodes),STAT=err) + IF(err/=0) CALL FlagError("Could not allocate world work group available ranks.",err,error,*999) + DO rankIdx=1,computationEnvironment%numberOfWorldComputationNodes + computationEnvironment%worldWorkGroup%worldRanks(rankIdx)=rankIdx-1 + computationEnvironment%worldWorkGroup%availableRanks(rankIdx)=rankIdx-1 + ENDDO !rankIdx + computationEnvironment%worldWorkGroup%numberOfAvailableRanks=computationEnvironment%numberOfWorldComputationNodes + !Create a new MPI group + CALL MPI_GROUP_INCL(computationEnvironment%mpiGroupWorld,computationEnvironment%worldWorkGroup%numberOfGroupComputationNodes, & + & computationEnvironment%worldWorkGroup%worldRanks,computationEnvironment%worldWorkGroup%mpiGroup,mpiIError) + CALL MPI_ERROR_CHECK("MPI_GROUP_INCL",mpiIError,err,error,*999) + CALL MPI_COMM_CREATE(computationEnvironment%mpiWorldCommunicator,computationEnvironment%worldWorkGroup%mpiGroup, & + & computationEnvironment%worldWorkGroup%mpiGroupCommunicator,mpiIError) + CALL MPI_ERROR_CHECK("MPI_COMM_CREATE",mpiIError,err,error,*999) + !Determine ranks + CALL MPI_COMM_RANK(computationEnvironment%mpiWorldCommunicator,rank,mpiIError) + CALL MPI_ERROR_CHECK("MPI_COMM_RANK",mpiIError,err,error,*999) + computationEnvironment%worldWorkGroup%myWorldComputationNodeNumber=rank + CALL MPI_COMM_RANK(computationEnvironment%worldWorkGroup%mpiGroupCommunicator,rank,mpiIError) + CALL MPI_ERROR_CHECK("MPI_COMM_RANK",mpiIError,err,error,*999) + computationEnvironment%worldWorkGroup%myWorldComputationNodeNumber=rank + + computationEnvironment%worldWorkGroup%workGroupFinished=.TRUE. IF(diagnostics1) THEN !Just let the master node write out this information - IF(RANK==0) THEN + IF(rank==0) THEN CALL WriteString(DIAGNOSTIC_OUTPUT_TYPE,"Computation environment:",err,error,*999) CALL WriteStringValue(DIAGNOSTIC_OUTPUT_TYPE," MPI version = ", & & computationEnvironment%mpiVersion,err,error,*999) CALL WriteStringValue(DIAGNOSTIC_OUTPUT_TYPE," MPI subversion = ", & & computationEnvironment%mpiSubversion,err,error,*999) + CALL WriteStringValue(DIAGNOSTIC_OUTPUT_TYPE," MPI world communicator = ", & + & computationEnvironment%mpiCommWorld,err,error,*999) + CALL WriteStringValue(DIAGNOSTIC_OUTPUT_TYPE," MPI world group = ", & + & computationEnvironment%mpiGroupWorld,err,error,*999) CALL WriteStringValue(DIAGNOSTIC_OUTPUT_TYPE," Number of world computation nodes = ", & & computationEnvironment%numberOfWorldComputationNodes,err,error,*999) CALL WriteStringValue(DIAGNOSTIC_OUTPUT_TYPE," My world computation node number = ", & @@ -774,103 +556,14 @@ SUBROUTINE Computation_ComputationEnvironmentInitialise(computationEnvironment,e ENDIF ENDIF - EXITS("Computation_ComputationEnvironmentInitialise") - RETURN -999 CALL Computation_ComputationEnvironmentFinalise(computationEnvironment,dummyErr,dummyError,*998) -998 ERRORS("Computation_ComputationEnvironmentInitialise",err,error) - EXITS("Computation_ComputationEnvironmentInitialise") - RETURN 1 - - END SUBROUTINE Computation_ComputationEnvironmentInitialise - - ! - !================================================================================================================================= - ! - - !>Finalises the computation data structures and deallocates all memory. - SUBROUTINE Computation_Finalise(err,error,*) - - !Argument Variables - INTEGER(INTG), INTENT(OUT) :: err !Initialises the computation data structures. - SUBROUTINE Computation_Initialise(err,error,*) - - !Argument Variables - INTEGER(INTG), INTENT(OUT) :: err !Start the creation of a work group \see OpenCMISS::Iron::cmfe_WorkGroup_CreateStart + SUBROUTINE WorkGroup_CreateStart(userNumber,parentWorkGroup,workGroup,err,error,*) + + !Argument Variables + INTEGER(INTG), INTENT(IN) :: userNumber !parentWorkGroup%computationEnvironment + !Add the work group to the list of parent sub groups + ALLOCATE(newSubGroups(parentWorkGroup%numberOfSubGroups+1),STAT=err) + IF(err/=0) CALL FlagError("Could not allocate new sub groups.",err,error,*999) + workGroup%parentWorkGroup=>parentWorkGroup + DO subGroupIdx=1,parentWorkGroup%numberOfSubGroups + newSubGroups(subGroupIdx)%ptr=parentWorkGroup%subGroups(subGroupIdx)%ptr + ENDDO !subGroupIdx + newSubGroups(parentWorkGroup%numberOfSubGroups+1)%ptr=>workGroup + CALL MOVE_ALLOC(newSubGroups,parentWorkGroup%subGroups) + parentWorkGroup%numberOfSubGroups=parentWorkGroup%numberOfSubGroups+1 + + EXITS("WorkGroup_CreateStart") + RETURN +999 ERRORSEXITS("WorkGroup_CreateStart",err,error) + RETURN 1 + + END SUBROUTINE WorkGroup_CreateStart ! !================================================================================================================================ ! - !>Gets the current world communicator. - SUBROUTINE ComputationEnvironment_WorldCommunicatorGet(worldCommunicator,err,error,*) + !>Finish the creation of a work group \see OpenCMISS::Iron::cmfe_WorkGroup_CreateFinish + SUBROUTINE WorkGroup_CreateFinish(workGroup,err,error,*) + + !Argument Variables + TYPE(WorkGroupType), POINTER, INTENT(INOUT) :: workGroup !SIZE(parentWorkGroup%availableRanks,1)) THEN + localError="There are insufficient parent work group available ranks. There are "// & + & TRIM(NumberToVString(SIZE(parentWorkGroup%availableRanks,1),"*",err,error))// & + & " parent ranks available and "// & + & TRIM(NumberToVString(workGroup%numberOfGroupComputationNodes,"*",err,error))//" ranks are required." + CALL FlagError(localError,err,error,*999) + ENDIF + + !Get the ranks from the list of available ranks of the parent. + ALLOCATE(workGroup%worldRanks(workGroup%numberOfGroupComputationNodes),STAT=err) + IF(err/=0) CALL FlagError("Could not allocate work group world ranks.",err,error,*999) + newNumberOfAvailableRanks=parentWorkGroup%numberOfAvailableRanks-workGroup%numberOfGroupComputationNodes + ALLOCATE(newAvailableRanks(newNumberOfAvailableRanks),STAT=err) + IF(err/=0) CALL FlagError("Could not allocate work group parent new available ranks.",err,error,*999) + DO rankIdx=1,workGroup%numberOfGroupComputationNodes + workGroup%worldRanks(rankIdx)=parentWorkGroup%availableRanks(rankIdx) + ENDDO !rankIdx + DO rankIdx=1,newNumberOfAvailableRanks + newAvailableRanks(rankIdx)=parentWorkGroup%availableRanks(rankIdx+workGroup%numberOfGroupComputationNodes) + ENDDO !rankIdx + CALL Sorting_HeapSort(newAvailableRanks,err,error,*999) + CALL MOVE_ALLOC(newAvailableRanks,parentWorkGroup%availableRanks) + parentWorkGroup%numberOfAvailableRanks=newNumberOfAvailableRanks + + !Create a new MPI group + CALL MPI_GROUP_INCL(computationEnvironment%mpiGroupWorld,workGroup%numberOfGroupComputationNodes,workGroup%worldRanks, & + & workGroup%mpiGroup,mpiIError) + CALL MPI_ERROR_CHECK("MPI_GROUP_INCL",mpiIError,err,error,*999) + CALL MPI_COMM_CREATE(computationEnvironment%mpiGroupWorld,workGroup%mpiGroup,workGroup%mpiGroupCommunicator,mpiIError) + CALL MPI_ERROR_CHECK("MPI_COMM_CREATE",mpiIError,err,error,*999) + + !Determine my processes rank in the group communicator + CALL MPI_COMM_RANK(workGroup%mpiGroupCommunicator,groupRank,mpiIError) + CALL MPI_ERROR_CHECK("MPI_COMM_RANK",mpiIError,err,error,*999) + workGroup%myGroupComputationNodeNumber=groupRank + + workGroup%workGroupFinished=.TRUE. + + EXITS("WorkGroup_CreateFinish") + RETURN +999 IF(ALLOCATED(newAvailableRanks)) DEALLOCATE(newAvailableRanks) + ERRORSEXITS("WorkGroup_CreateFinish",err,error) + RETURN 1 + + END SUBROUTINE WorkGroup_CreateFinish + + ! + !================================================================================================================================= + ! + + !>Destroy a work group \see OpenCMISS::Iron::cmfe_WorkGroup_Destroy + SUBROUTINE WorkGroup_Destroy(workGroup,err,error,*) !Argument Variables - INTEGER(INTG), INTENT(OUT) :: worldCommunicator !Destroy a work group given by a user number and all sub groups under it + RECURSIVE SUBROUTINE WorkGroup_DestroyNumber(workGroupUserNumber,err,error,*) - worldCommunicator=computationEnvironment%mpiWorldCommunicator + !Argument Variables + INTEGER(INTG), INTENT(IN) :: workGroupUserNumber !1) THEN + !If the parentWorkGroup has more than one sub groups then remove this work group from the list of sub groups. + ALLOCATE(newSubGroups(parentWorkGroup%numberOfSubGroups-1),STAT=err) + IF(err/=0) CALL FlagError("Could not allocate new sub groups.",err,error,*999) + count=0 + DO subGroupIdx=1,parentWorkGroup%numberOfSubGroups + NULLIFY(subGroup) + CALL WorkGroup_WorkSubGroupGet(workGroup,subGroupIdx,subGroup,err,error,*999) + IF(subGroup%userNumber/=workGroup%userNumber) THEN + count=count+1 + newSubGroups(count)%ptr=>parentWorkGroup%subGroups(subGroupIdx)%ptr + ENDIF + ENDDO !subGroupIdx + CALL MOVE_ALLOC(newSubGroups,parentWorkGroup%subGroups) + parentWorkGroup%numberOfSubGroups=parentWorkGroup%numberOfSubGroups-1 + ELSE + IF(ALLOCATED(parentWorkGroup%subGroups)) DEALLOCATE(parentWorkGroup%subGroups) + parentWorkGroup%numberOfSubGroups=0 + ENDIF + !Put the work group ranks back into the parent work group available ranks + ALLOCATE(newAvailableRanks(parentWorkGroup%numberOfAvailableRanks+workGroup%numberOfGroupComputationNodes),STAT=err) + IF(err/=0) CALL FlagError("Could not allocate new available ranks.",err,error,*999) + DO rankIdx=1,parentWorkGroup%numberOfAvailableRanks + newAvailableRanks(rankIdx)=parentWorkGroup%availableRanks(rankIdx) + ENDDO !rankIdx + DO rankIdx=1,workGroup%numberOfGroupComputationNodes + newAvailableRanks(parentWorkGroup%numberOfAvailableRanks+rankIdx)=workGroup%worldRanks(rankIdx) + ENDDO !rankIdx + CALL Sorting_HeapSort(newAvailableRanks,err,error,*999) + CALL MOVE_ALLOC(newAvailableRanks,parentWorkGroup%availableRanks) + parentWorkGroup%numberOfAvailableRanks=parentWorkGroup%numberOfAvailableRanks+workGroup%numberOfGroupComputationNodes + !Finalise the work group + CALL WorkGroup_Finalise(workGroup,err,error,*999) + ELSE + !Recursively delete the sub groups first + DO WHILE(workGroup%numberOfSubGroups>0) + NULLIFY(workGroup2) + CALL WorkGroup_WorkSubGroupGet(workGroup,1,workGroup2,err,error,*999) + CALL WorkGroup_DestroyNumber(workGroup2%userNumber,err,error,*999) + ENDDO + !Now delete this instance + CALL WorkGroup_DestroyNumber(workGroup%userNumber,err,error,*999) + ENDIF + + EXITS("WorkGroup_DestroyNumber") RETURN -999 ERRORS("ComputationEnvironment_WorldCommunicatorGet",err,error) - EXITS("ComputationEnvironment_WorldCommunicatorGet") +999 IF(ALLOCATED(newSubGroups)) DEALLOCATE(newSubGroups) + IF(ALLOCATED(newAvailableRanks)) DEALLOCATE(newAvailableRanks) + ERRORSEXITS("WorkGroup_DestroyNumber",err,error) RETURN 1 - END SUBROUTINE ComputationEnvironment_WorldCommunicatorGet + END SUBROUTINE WorkGroup_DestroyNumber ! - !================================================================================================================================ + !================================================================================================================================= ! - !>Returns the number/rank of the computation nodes. - FUNCTION ComputationEnvironment_NodeNumberGet(err,error) - + !>Finalise a work group and deallocate all memory + RECURSIVE SUBROUTINE WorkGroup_Finalise(workGroup,err,error,*) + !Argument Variables + TYPE(WorkGroupType),POINTER :: workGroup !Add the work sub-group to the parent group based on the computation requirements (called by user) + SUBROUTINE WorkGroup_Initialise(workGroup,err,error,*) + + !Argument Variables + TYPE(WorkGroupType),POINTER, INTENT(OUT) :: workGroup !Set the character label of a work group \see OpenCMISS::Iron::cmfe_WorkGroup_LabelSet + SUBROUTINE WorkGroup_LabelSetC(workGroup,label,err,error,*) + + !Argument Variables + TYPE(WorkGroupType), POINTER, INTENT(IN) :: workGroup !Returns the number of computation nodes. - FUNCTION ComputationEnvironment_NumberOfNodesGet(err,error) - + + !>Set the varying string label of a work group \see OpenCMISS::Iron::cmfe_WorkGroup_LabelSet + SUBROUTINE WorkGroup_LabelSetVS(workGroup,label,err,error,*) + !Argument Variables + TYPE(WorkGroupType), POINTER, INTENT(IN) :: workGroup !Set the number of group nodes in a work group \see OpenCMISS::Iron::cmfe_WorkGroup_NumberOfGroupNodesSet + SUBROUTINE WorkGroup_NumberOfGroupNodesSet(workGroup,numberOfGroupComputationNodes,err,error,*) + + !Argument Variables + TYPE(WorkGroupType), POINTER, INTENT(OUT) :: workGroup !parentWorkGroup%numberOfAvailableRanks) THEN + localError="The number of group nodes of "//TRIM(NumberToVString(numberOfGroupComputationNodes,"*",err,error))// & + & " is invalid. The number of group nodes should be > 0 and <= "// & + & TRIM(NumberToVString(parentWorkGroup%numberOfAvailableRanks,"*",err,error))//"." + CALL FlagError(localError,err,error,*999) + ENDIF + + workGroup%numberOfGroupComputationNodes=numberOfGroupComputationNodes + + EXITS("WorkGroup_NumberOfGroupNodesSet") RETURN +999 ERRORSEXITS("WorkGroup_NumberOfGroupNodesSet",err,error) + RETURN 1 - END FUNCTION ComputationEnvironment_NumberOfNodesGet + END SUBROUTINE WorkGroup_NumberOfGroupNodesSet ! - !================================================================================================================================ + !================================================================================================================================= ! END MODULE ComputationRoutines diff --git a/src/data_projection_routines.f90 b/src/data_projection_routines.f90 index 7d03b3d8..8f8d4818 100644 --- a/src/data_projection_routines.f90 +++ b/src/data_projection_routines.f90 @@ -49,6 +49,7 @@ MODULE DataProjectionRoutines USE BasisAccessRoutines USE CmissMPI USE ComputationRoutines + USE ComputationAccessRoutines USE Constants USE CoordinateSystemAccessRoutines USE DataPointAccessRoutines @@ -1364,7 +1365,7 @@ SUBROUTINE DataProjection_DataPointsProjectionEvaluate(dataProjection,projection INTEGER(INTG), ALLOCATABLE :: globalMPIDisplacements(:),sortingIndices1(:),sortingIndices2(:) INTEGER(INTG), ALLOCATABLE :: globalNumberOfProjectedPoints(:) INTEGER(INTG) :: MPIClosestDistances,dataProjectionGlobalNumber - INTEGER(INTG) :: MPIIError + INTEGER(INTG) :: MPIIError,worldCommunicator INTEGER(INTG), ALLOCATABLE :: projectedElement(:),projectedLineFace(:),projectionExitTag(:) REAL(DP) :: distance REAL(DP), ALLOCATABLE :: closestDistances(:,:),globalClosestDistances(:,:) @@ -1413,10 +1414,9 @@ SUBROUTINE DataProjection_DataPointsProjectionEvaluate(dataProjection,projection IF(.NOT.ASSOCIATED(domainElements%elements)) CALL FlagError("Domain elements elements is not associated.",err,error,*999) numberOfDataPoints=dataPoints%numberOfDataPoints - myComputationNode=ComputationEnvironment_NodeNumberGet(err,error) - IF(err/=0) GOTO 999 - numberOfWorldComputationNodes=ComputationEnvironment_NumberOfNodesGet(err,error) - IF(err/=0) GOTO 999 + CALL ComputationEnvironment_NumberOfWorldNodesGet(computationEnvironment,numberOfWorldComputationNodes,err,error,*999) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,myComputationNode,err,error,*999) + CALL ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*999) boundaryProjection=(dataProjection%projectionType==DATA_PROJECTION_BOUNDARY_LINES_PROJECTION_TYPE).OR. & & (dataProjection%projectionType==DATA_PROJECTION_BOUNDARY_FACES_PROJECTION_TYPE) !######################################################################################################### @@ -1686,7 +1686,7 @@ SUBROUTINE DataProjection_DataPointsProjectionEvaluate(dataProjection,projection IF(err/=0) CALL FlagError("Could not allocate sorting indices 2.",err,error,*999) !gather and distribute the number of closest elements from all computation nodes CALL MPI_ALLGATHER(numberOfClosestCandidates,1,MPI_INTEGER,globalNumberOfClosestCandidates,1,MPI_INTEGER, & - & computationEnvironment%mpiWorldCommunicator,MPIIError) + & worldCommunicator,MPIIError) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPIIError,err,error,*999) !Sum all number of closest candidates from all computation nodes totalNumberOfClosestCandidates=SUM(globalNumberOfClosestCandidates,1) @@ -1711,7 +1711,7 @@ SUBROUTINE DataProjection_DataPointsProjectionEvaluate(dataProjection,projection !Share closest element distances between all domains CALL MPI_ALLGATHERV(closestDistances(1,1),numberOfClosestCandidates,MPIClosestDistances, & & globalClosestDistances,globalNumberOfClosestCandidates,globalMPIDisplacements, & - & MPIClosestDistances,computationEnvironment%mpiWorldCommunicator,MPIIError) + & MPIClosestDistances,worldCommunicator,MPIIError) CALL MPI_ERROR_CHECK("MPI_ALLGATHERV",MPIIError,err,error,*999) reducedNumberOfCLosestCandidates=MIN(dataProjection%numberOfClosestElements,totalNumberOfClosestCandidates) projectedDistance(2,:)=myComputationNode @@ -1818,7 +1818,7 @@ SUBROUTINE DataProjection_DataPointsProjectionEvaluate(dataProjection,projection END SELECT !Find the shortest projected distance in all domains CALL MPI_ALLREDUCE(MPI_IN_PLACE,projectedDistance,numberOfDataPoints,MPI_2DOUBLE_PRECISION,MPI_MINLOC, & - & computationEnvironment%mpiWorldCommunicator,MPIIError) + & worldCommunicator,MPIIError) CALL MPI_ERROR_CHECK("MPI_ALLREDUCE",MPIIError,err,error,*999) !Sort the computation node/rank from 0 to number of computation node CALL Sorting_BubbleIndexSort(projectedDistance(2,:),sortingIndices2,err,error,*999) @@ -1836,29 +1836,29 @@ SUBROUTINE DataProjection_DataPointsProjectionEvaluate(dataProjection,projection !Shares minimum projection information between all domains CALL MPI_ALLGATHERV(projectedElement(sortingIndices2(startIdx:finishIdx)),globalNumberOfProjectedPoints( & & myComputationNode+1),MPI_INTEGER,projectedElement,globalNumberOfProjectedPoints, & - & globalMPIDisplacements,MPI_INTEGER,computationEnvironment%mpiWorldCommunicator,MPIIError) !projectedElement + & globalMPIDisplacements,MPI_INTEGER,worldCommunicator,MPIIError) !projectedElement CALL MPI_ERROR_CHECK("MPI_ALLGATHERV",MPIIError,err,error,*999) IF(boundaryProjection) THEN CALL MPI_ALLGATHERV(projectedLineFace(sortingIndices2(startIdx:finishIdx)),globalNumberOfProjectedPoints( & & myComputationNode+1),MPI_INTEGER,projectedLineFace,globalNumberOfProjectedPoints, & - & globalMPIDisplacements,MPI_INTEGER,computationEnvironment%mpiWorldCommunicator,MPIIError) !projectedLineFace + & globalMPIDisplacements,MPI_INTEGER,worldCommunicator,MPIIError) !projectedLineFace CALL MPI_ERROR_CHECK("MPI_ALLGATHERV",MPIIError,err,error,*999) ENDIF DO xiIdx=1,dataProjection%numberOfXi CALL MPI_ALLGATHERV(projectedXi(xiIdx,sortingIndices2(startIdx:finishIdx)),globalNumberOfProjectedPoints( & & myComputationNode+1),MPI_DOUBLE_PRECISION,projectedXi(xiIdx,:),globalNumberOfProjectedPoints, & - & globalMPIDisplacements,MPI_DOUBLE_PRECISION,computationEnvironment%mpiWorldCommunicator,MPIIError) !projectedXi + & globalMPIDisplacements,MPI_DOUBLE_PRECISION,worldCommunicator,MPIIError) !projectedXi CALL MPI_ERROR_CHECK("MPI_ALLGATHERV",MPIIError,err,error,*999) ENDDO !xiIdx CALL MPI_ALLGATHERV(projectionExitTag(sortingIndices2(startIdx:finishIdx)),globalNumberOfProjectedPoints( & & myComputationNode+1),MPI_INTEGER,projectionExitTag,globalNumberOfProjectedPoints, & - & globalMPIDisplacements,MPI_INTEGER,computationEnvironment%mpiWorldCommunicator,MPIIError) !projectionExitTag + & globalMPIDisplacements,MPI_INTEGER,worldCommunicator,MPIIError) !projectionExitTag CALL MPI_ERROR_CHECK("MPI_ALLGATHERV",MPIIError,err,error,*999) DO xiIdx=1,dataProjection%numberOfCoordinates CALL MPI_ALLGATHERV(projectionVectors(xiIdx, sortingIndices2(startIdx:finishIdx)), & & globalNumberOfProjectedPoints(myComputationNode+1),MPI_DOUBLE_PRECISION,projectionVectors(xiIdx,:), & - & globalNumberOfProjectedPoints,globalMPIDisplacements,MPI_DOUBLE_PRECISION,computationEnvironment% & - & mpiWorldCommunicator,MPIIError) !projectionVectors + & globalNumberOfProjectedPoints,globalMPIDisplacements,MPI_DOUBLE_PRECISION,worldCommunicator, & + & MPIIError) !projectionVectors CALL MPI_ERROR_CHECK("MPI_ALLGATHERV",MPIIError,err,error,*999) ENDDO !Assign projection information to projected points @@ -4727,10 +4727,8 @@ SUBROUTINE DataProjection_ResultAnalysisOutput(dataProjection,filename,err,error CALL Domain_TopologyGet(domain,domainTopology,err,error,*999) NULLIFY(domainElements) CALL DomainTopology_ElementsGet(domainTopology,domainElements,err,error,*999) - numberOfWorldComputationNodes=ComputationEnvironment_NumberOfNodesGet(err,error) - IF(err/=0) GOTO 999 - myWorldComputationNodeNumber=ComputationEnvironment_NodeNumberGet(err,error) - IF(err/=0) GOTO 999 + CALL ComputationEnvironment_NumberOfWorldNodesGet(computationEnvironment,numberOfWorldComputationNodes,err,error,*999) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,myWorldComputationNodeNumber,err,error,*999) !Find the correct output ID and open a file if necessary filenameLength=LEN_TRIM(filename) IF(filenameLength>=1) THEN diff --git a/src/distributed_matrix_vector.f90 b/src/distributed_matrix_vector.f90 index f43ba74e..a7d76360 100755 --- a/src/distributed_matrix_vector.f90 +++ b/src/distributed_matrix_vector.f90 @@ -48,6 +48,7 @@ MODULE DISTRIBUTED_MATRIX_VECTOR USE CmissMPI USE CmissPetsc USE ComputationRoutines + USE ComputationAccessRoutines USE INPUT_OUTPUT USE ISO_VARYING_STRING USE ISO_C_BINDING @@ -2684,7 +2685,7 @@ SUBROUTINE DISTRIBUTED_MATRIX_PETSC_CREATE_FINISH(PETSC_MATRIX,ERR,ERROR,*) INTEGER(INTG), INTENT(OUT) :: ERR !DISTRIBUTED_MATRIX%COLUMN_DOMAIN_MAPPING IF(ASSOCIATED(ROW_DOMAIN_MAPPING)) THEN IF(ASSOCIATED(COLUMN_DOMAIN_MAPPING)) THEN + CALL ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*999) SELECT CASE(PETSC_MATRIX%STORAGE_TYPE) CASE(DISTRIBUTED_MATRIX_BLOCK_STORAGE_TYPE) PETSC_MATRIX%NUMBER_NON_ZEROS=PETSC_MATRIX%M*PETSC_MATRIX%GLOBAL_N @@ -2713,8 +2715,8 @@ SUBROUTINE DISTRIBUTED_MATRIX_PETSC_CREATE_FINISH(PETSC_MATRIX,ERR,ERROR,*) !Set up the matrix ALLOCATE(PETSC_MATRIX%DATA_DP(PETSC_MATRIX%DATA_SIZE),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate PETSc matrix data.",ERR,ERROR,*999) - CALL Petsc_MatCreateDense(computationEnvironment%mpiWorldCommunicator,PETSC_MATRIX%M,PETSC_MATRIX%N, & - & PETSC_MATRIX%GLOBAL_M,PETSC_MATRIX%GLOBAL_N,PETSC_MATRIX%DATA_DP,PETSC_MATRIX%MATRIX,ERR,ERROR,*999) + CALL Petsc_MatCreateDense(WorldCommunicator,PETSC_MATRIX%M,PETSC_MATRIX%N,PETSC_MATRIX%GLOBAL_M, & + & PETSC_MATRIX%GLOBAL_N,PETSC_MATRIX%DATA_DP,PETSC_MATRIX%MATRIX,ERR,ERROR,*999) CASE(DISTRIBUTED_MATRIX_DIAGONAL_STORAGE_TYPE) PETSC_MATRIX%NUMBER_NON_ZEROS=PETSC_MATRIX%M PETSC_MATRIX%MAXIMUM_COLUMN_INDICES_PER_ROW=1 @@ -2733,8 +2735,8 @@ SUBROUTINE DISTRIBUTED_MATRIX_PETSC_CREATE_FINISH(PETSC_MATRIX,ERR,ERROR,*) PETSC_MATRIX%DIAGONAL_NUMBER_NON_ZEROS=1 PETSC_MATRIX%OFFDIAGONAL_NUMBER_NON_ZEROS=0 !Create the PETsc AIJ matrix - CALL Petsc_MatCreateAIJ(computationEnvironment%mpiWorldCommunicator,PETSC_MATRIX%M,PETSC_MATRIX%N, & - & PETSC_MATRIX%GLOBAL_M,PETSC_MATRIX%GLOBAL_N,PETSC_NULL_INTEGER,PETSC_MATRIX%DIAGONAL_NUMBER_NON_ZEROS, & + CALL Petsc_MatCreateAIJ(worldCommunicator,PETSC_MATRIX%M,PETSC_MATRIX%N,PETSC_MATRIX%GLOBAL_M, & + & PETSC_MATRIX%GLOBAL_N,PETSC_NULL_INTEGER,PETSC_MATRIX%DIAGONAL_NUMBER_NON_ZEROS, & & PETSC_NULL_INTEGER,PETSC_MATRIX%OFFDIAGONAL_NUMBER_NON_ZEROS,PETSC_MATRIX%MATRIX,ERR,ERROR,*999) CASE(DISTRIBUTED_MATRIX_COLUMN_MAJOR_STORAGE_TYPE) CALL FlagError("Column major storage is not implemented for PETSc matrices.",ERR,ERROR,*999) @@ -2744,7 +2746,7 @@ SUBROUTINE DISTRIBUTED_MATRIX_PETSC_CREATE_FINISH(PETSC_MATRIX,ERR,ERROR,*) IF(ALLOCATED(PETSC_MATRIX%DIAGONAL_NUMBER_NON_ZEROS)) THEN IF(ALLOCATED(PETSC_MATRIX%OFFDIAGONAL_NUMBER_NON_ZEROS)) THEN !Create the PETSc AIJ matrix - CALL Petsc_MatCreateAIJ(computationEnvironment%mpiWorldCommunicator,PETSC_MATRIX%M,PETSC_MATRIX%N, & + CALL Petsc_MatCreateAIJ(worldCommunicator,PETSC_MATRIX%M,PETSC_MATRIX%N, & & PETSC_MATRIX%GLOBAL_M,PETSC_MATRIX%GLOBAL_N,PETSC_NULL_INTEGER,PETSC_MATRIX%DIAGONAL_NUMBER_NON_ZEROS, & & PETSC_NULL_INTEGER,PETSC_MATRIX%OFFDIAGONAL_NUMBER_NON_ZEROS,PETSC_MATRIX%MATRIX,ERR,ERROR,*999) !Set matrix options @@ -6483,7 +6485,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_CMISS_CREATE_FINISH(CMISS_VECTOR,ERR,ERROR,*) & DOMAIN_MAPPING%ADJACENT_DOMAINS_PTR(DOMAIN_MAPPING%NUMBER_OF_DOMAINS) END IF IF(DOMAIN_MAPPING%NUMBER_OF_ADJACENT_DOMAINS>0) THEN - my_computation_node_number=ComputationEnvironment_NodeNumberGet(ERR,ERROR) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,my_computation_node_number,err,error,*999) IF(ERR/=0) GOTO 999 IF(DISTRIBUTED_VECTOR%GHOSTING_TYPE==DISTRIBUTED_MATRIX_VECTOR_INCLUDE_GHOSTS_TYPE) THEN ALLOCATE(CMISS_VECTOR%TRANSFERS(DOMAIN_MAPPING%NUMBER_OF_ADJACENT_DOMAINS),STAT=ERR) @@ -7660,7 +7662,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_PETSC_CREATE_FINISH(PETSC_VECTOR,ERR,ERROR,*) INTEGER(INTG), INTENT(OUT) :: ERR !DISTRIBUTED_VECTOR%DOMAIN_MAPPING IF(ASSOCIATED(DOMAIN_MAPPING)) THEN + CALL ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*999) !Create the PETSc vector PETSC_VECTOR%DATA_SIZE=PETSC_VECTOR%N - CALL Petsc_VecCreateMPI(computationEnvironment%mpiWorldCommunicator,PETSC_VECTOR%N,PETSC_VECTOR%GLOBAL_N, & + CALL Petsc_VecCreateMPI(worldCommunicator,PETSC_VECTOR%N,PETSC_VECTOR%GLOBAL_N, & & PETSC_VECTOR%VECTOR,ERR,ERROR,*999) !Set up the Local to Global Mappings DO i=1,PETSC_VECTOR%N @@ -7912,7 +7915,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_FINISH(DISTRIBUTED_VECTOR,ERR,ERROR,*) CASE(DISTRIBUTED_MATRIX_VECTOR_CMISS_TYPE) IF(ASSOCIATED(DISTRIBUTED_VECTOR%CMISS)) THEN IF(ASSOCIATED(DISTRIBUTED_VECTOR%DOMAIN_MAPPING)) THEN - NUMBER_OF_COMPUTATION_NODES=ComputationEnvironment_NumberOfNodesGet(ERR,ERROR) + CALL ComputationEnvironment_NumberOfWorldNodesGet(computationEnvironment,NUMBER_OF_COMPUTATION_NODES,err,error,*999) IF(ERR/=0) GOTO 999 IF(NUMBER_OF_COMPUTATION_NODES>1) THEN CALL DISTRIBUTED_VECTOR_UPDATE_WAITFINISHED(DISTRIBUTED_VECTOR,ERR,ERROR,*999) @@ -8170,9 +8173,9 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) INTEGER(INTG), INTENT(OUT) :: ERR !1) THEN + IF(numberOfComputationNodes>1) THEN IF(DISTRIBUTED_VECTOR%DOMAIN_MAPPING%NUMBER_OF_ADJACENT_DOMAINS>0) THEN !Fill in the send buffers with the send ghost values DO domain_idx=1,DISTRIBUTED_VECTOR%DOMAIN_MAPPING%NUMBER_OF_ADJACENT_DOMAINS @@ -8229,8 +8233,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL MPI_IRECV(DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_BUFFER_INTG, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_BUFFER_SIZE,MPI_INTEGER, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & - & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER, & - & computationEnvironment%mpiWorldCommunicator, & + & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER,worldCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_IRECV",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8242,8 +8245,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER,ERR,ERROR,*999) - CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive comm = ", & - & computationEnvironment%mpiWorldCommunicator,ERR,ERROR,*999) + CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive comm = ",worldCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,ERR,ERROR,*999) ENDIF @@ -8251,8 +8253,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL MPI_IRECV(DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_BUFFER_SP, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_BUFFER_SIZE,MPI_REAL, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & - & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER, & - & computationEnvironment%mpiWorldCommunicator, & + & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER,worldCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_IRECV",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8264,8 +8265,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER,ERR,ERROR,*999) - CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive comm = ", & - & computationEnvironment%mpiWorldCommunicator,ERR,ERROR,*999) + CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive comm = ",worldCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,ERR,ERROR,*999) ENDIF @@ -8273,8 +8273,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL MPI_IRECV(DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_BUFFER_DP, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_BUFFER_SIZE,MPI_DOUBLE_PRECISION, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & - & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER, & - & computationEnvironment%mpiWorldCommunicator, & + & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER,worldCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_IRECV",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8286,8 +8285,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER,ERR,ERROR,*999) - CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive comm = ", & - & computationEnvironment%mpiWorldCommunicator,ERR,ERROR,*999) + CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive comm = ",worldCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,ERR,ERROR,*999) ENDIF @@ -8295,8 +8293,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL MPI_IRECV(DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_BUFFER_L, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_BUFFER_SIZE,MPI_LOGICAL, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & - & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER, & - & computationEnvironment%mpiWorldCommunicator, & + & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER,worldCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_IRECV",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8308,8 +8305,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%RECEIVE_TAG_NUMBER,ERR,ERROR,*999) - CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive comm = ", & - & computationEnvironment%mpiWorldCommunicator,ERR,ERROR,*999) + CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive comm = ",worldCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Receive request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_RECEIVE_REQUEST,ERR,ERROR,*999) ENDIF @@ -8330,8 +8326,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL MPI_ISEND(DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_BUFFER_INTG, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_BUFFER_SIZE,MPI_INTEGER, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & - & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER, & - & computationEnvironment%mpiWorldCommunicator, & + & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER,worldCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ISEND",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8343,8 +8338,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER,ERR,ERROR,*999) - CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send comm = ", & - & computationEnvironment%mpiWorldCommunicator,ERR,ERROR,*999) + CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send comm = ",worldCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,ERR,ERROR,*999) ENDIF @@ -8352,8 +8346,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL MPI_ISEND(DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_BUFFER_SP, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_BUFFER_SIZE,MPI_REAL, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & - & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER, & - & computationEnvironment%mpiWorldCommunicator, & + & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER,worldCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ISEND",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8365,8 +8358,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER,ERR,ERROR,*999) - CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send comm = ", & - & computationEnvironment%mpiWorldCommunicator,ERR,ERROR,*999) + CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send comm = ",worldCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,ERR,ERROR,*999) ENDIF @@ -8374,8 +8366,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL MPI_ISEND(DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_BUFFER_DP, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_BUFFER_SIZE,MPI_DOUBLE_PRECISION, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & - & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER, & - & computationEnvironment%mpiWorldCommunicator, & + & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER,worldCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ISEND",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8387,8 +8378,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER,ERR,ERROR,*999) - CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send comm = ",computationEnvironment% & - & mpiWorldCommunicator,ERR,ERROR,*999) + CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send comm = ",worldCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,ERR,ERROR,*999) ENDIF @@ -8396,8 +8386,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) CALL MPI_ISEND(DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_BUFFER_L, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_BUFFER_SIZE,MPI_LOGICAL, & & DISTRIBUTED_VECTOR%DOMAIN_MAPPING%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER, & - & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER, & - & computationEnvironment%mpiWorldCommunicator, & + & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER,worldCommunicator, & & DISTRIBUTED_VECTOR%CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ISEND",MPI_IERROR,ERR,ERROR,*999) IF(DIAGNOSTICS5) THEN @@ -8409,8 +8398,7 @@ SUBROUTINE DISTRIBUTED_VECTOR_UPDATE_START(DISTRIBUTED_VECTOR,ERR,ERROR,*) & ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send tag = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%SEND_TAG_NUMBER,ERR,ERROR,*999) - CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send comm = ", & - & computationEnvironment%mpiWorldCommunicator,ERR,ERROR,*999) + CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send comm = ",worldCommunicator,ERR,ERROR,*999) CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE," Send request = ",DISTRIBUTED_VECTOR% & & CMISS%TRANSFERS(domain_idx)%MPI_SEND_REQUEST,ERR,ERROR,*999) ENDIF diff --git a/src/domain_mappings.f90 b/src/domain_mappings.f90 index 8fb51b61..cd946bfb 100755 --- a/src/domain_mappings.f90 +++ b/src/domain_mappings.f90 @@ -46,6 +46,7 @@ MODULE DOMAIN_MAPPINGS USE BaseRoutines USE ComputationRoutines + USE ComputationAccessRoutines USE INPUT_OUTPUT USE ISO_VARYING_STRING USE KINDS @@ -150,6 +151,7 @@ SUBROUTINE DOMAIN_MAPPINGS_GLOBAL_TO_LOCAL_GET(DOMAIN_MAPPING,GLOBAL_NUMBER,LOCA INTEGER(INTG), INTENT(OUT) :: ERR !=1.AND.GLOBAL_NUMBER<=DOMAIN_MAPPING%NUMBER_OF_GLOBAL) THEN - IF(DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(GLOBAL_NUMBER)%DOMAIN_NUMBER(1)== & - & computationEnvironment%myWorldComputationNodeNumber) THEN + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,myWorldComputationNodeNumber,err,error,*999) + IF(DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(GLOBAL_NUMBER)%DOMAIN_NUMBER(1)==myWorldComputationNodeNumber) THEN LOCAL_NUMBER=DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(GLOBAL_NUMBER)%LOCAL_NUMBER(1) LOCAL_EXISTS=.TRUE. ENDIF @@ -203,7 +205,7 @@ SUBROUTINE DOMAIN_MAPPINGS_LOCAL_FROM_GLOBAL_CALCULATE(DOMAIN_MAPPING,ERR,ERROR, ENTERS("DOMAIN_MAPPINGS_LOCAL_FROM_GLOBAL_CALCULATE",ERR,ERROR,*999) IF(ASSOCIATED(DOMAIN_MAPPING)) THEN - myWorldComputationNodeNumber=ComputationEnvironment_NodeNumberGet(ERR,ERROR) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,myWorldComputationNodeNumber,err,error,*999) IF(ERR/=0) GOTO 999 !Calculate local to global maps from global to local map ALLOCATE(DOMAIN_MAPPING%NUMBER_OF_DOMAIN_LOCAL(0:DOMAIN_MAPPING%NUMBER_OF_DOMAINS-1),STAT=ERR) diff --git a/src/equations_set_routines.f90 b/src/equations_set_routines.f90 index a10803a7..e9c7f449 100644 --- a/src/equations_set_routines.f90 +++ b/src/equations_set_routines.f90 @@ -51,6 +51,7 @@ MODULE EQUATIONS_SET_ROUTINES USE CLASSICAL_FIELD_ROUTINES USE CmissMPI USE ComputationRoutines + USE ComputationAccessRoutines USE Constants USE COORDINATE_ROUTINES USE DISTRIBUTED_MATRIX_VECTOR @@ -6320,9 +6321,9 @@ SUBROUTINE EQUATIONS_SET_BOUNDARY_CONDITIONS_INCREMENT(EQUATIONS_SET,BOUNDARY_CO NULLIFY(PREV_LOADS) NULLIFY(CURRENT_LOADS) - myWorldComputationNodeNumber=ComputationEnvironment_NodeNumberGet(err,error) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,myWorldComputationNodeNumber,err,error,*999) - !Take the stored load, scale it down appropriately then apply to the unknown variables + !Take the stored load, scale it down appropriately then apply to the unknown variables IF(ASSOCIATED(EQUATIONS_SET)) THEN IF(DIAGNOSTICS1) THEN CALL WriteStringValue(DIAGNOSTIC_OUTPUT_TYPE," equations set",EQUATIONS_SET%USER_NUMBER,err,error,*999) diff --git a/src/field_IO_routines.f90 b/src/field_IO_routines.f90 index d72c30c9..f44468fb 100755 --- a/src/field_IO_routines.f90 +++ b/src/field_IO_routines.f90 @@ -27,7 +27,7 @@ !> Auckland, the University of Oxford and King's College, London. !> All Rights Reserved. !> -!> Contributor(s): +!> Contributor(s): Heye Zhang !> !> Alternatively, the contents of this file may be used under the terms of !> either the GNU General Public License Version 2 or later (the "GPL"), or @@ -51,6 +51,7 @@ MODULE FIELD_IO_ROUTINES USE MESH_ROUTINES USE NODE_ROUTINES USE ComputationRoutines + USE ComputationAccessRoutines USE COORDINATE_ROUTINES USE ISO_VARYING_STRING USE MACHINE_CONSTANTS @@ -1031,7 +1032,7 @@ SUBROUTINE FIELD_IO_CREATE_FIELDS(NAME, REGION, DECOMPOSITION, FIELD_VALUES_SET_ TYPE(VARYING_STRING) :: CMISS_KEYWORD_FIELDS, CMISS_KEYWORD_NODE, CMISS_KEYWORD_COMPONENTS TYPE(VARYING_STRING) :: CMISS_KEYWORD_VALUE_INDEX, CMISS_KEYWORD_DERIVATIVE INTEGER(INTG), ALLOCATABLE :: tmp_pointer(:), LIST_DEV(:), LIST_DEV_POS(:) - INTEGER(INTG) :: FILE_ID + INTEGER(INTG) :: FILE_ID,worldCommunicator !INTEGER(INTG) :: NUMBER_FIELDS INTEGER(INTG) :: NODAL_USER_NUMBER, NODAL_LOCAL_NUMBER, FIELDTYPE, NUMBER_NODAL_VALUE_LINES, NUMBER_OF_LINES, & & NUMBER_OF_COMPONENTS !, LABEL_TYPE, FOCUS @@ -1055,6 +1056,8 @@ SUBROUTINE FIELD_IO_CREATE_FIELDS(NAME, REGION, DECOMPOSITION, FIELD_VALUES_SET_ GOTO 999 ENDIF + CALL ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*999) + CMISS_KEYWORD_FIELDS="#Fields=" CMISS_KEYWORD_COMPONENTS="#Components=" CMISS_KEYWORD_VALUE_INDEX="Value index=" @@ -1149,7 +1152,7 @@ SUBROUTINE FIELD_IO_CREATE_FIELDS(NAME, REGION, DECOMPOSITION, FIELD_VALUES_SET_ IF(MASTER_COMPUTATION_NUMBER==myWorldComputationNodeNumber) THEN CALL FIELD_IO_FIELD_INFO(LIST_STR(idx_field), FIELD_IO_FIELD_LABEL, FIELDTYPE, ERR, ERROR, *999) ENDIF - CALL MPI_BCAST(FIELDTYPE,1,MPI_LOGICAL,MASTER_COMPUTATION_NUMBER,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + CALL MPI_BCAST(FIELDTYPE,1,MPI_LOGICAL,MASTER_COMPUTATION_NUMBER,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_BCAST",MPI_IERROR,ERR,ERROR,*999) !Set FIELD TYPE CALL FIELD_TYPE_SET(FIELD, FIELDTYPE, ERR, ERROR, *999) @@ -1167,8 +1170,7 @@ SUBROUTINE FIELD_IO_CREATE_FIELDS(NAME, REGION, DECOMPOSITION, FIELD_VALUES_SET_ FILE_STATUS="OLD" !broadcasting total_number_of_comps - CALL MPI_BCAST(total_number_of_comps,1,MPI_INTEGER,MASTER_COMPUTATION_NUMBER, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + CALL MPI_BCAST(total_number_of_comps,1,MPI_INTEGER,MASTER_COMPUTATION_NUMBER,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_BCAST",MPI_IERROR,ERR,ERROR,*999) CALL REALLOCATE( LIST_DEV_POS, total_number_of_comps, & @@ -1176,7 +1178,7 @@ SUBROUTINE FIELD_IO_CREATE_FIELDS(NAME, REGION, DECOMPOSITION, FIELD_VALUES_SET_ DO WHILE(idx_exnode Auckland, the University of Oxford and King's College, London. !> All Rights Reserved. !> -!> Contributor(s): +!> Contributor(s): Caton Little !> !> Alternatively, the contents of this file may be used under the terms of !> either the GNU General Public License Version 2 or later (the "GPL"), or @@ -51,6 +51,7 @@ MODULE FIELDML_INPUT_ROUTINES USE CMISS USE CONSTANTS USE ComputationRoutines + USE ComputationAccessRoutines USE COORDINATE_ROUTINES USE FIELD_ROUTINES USE FIELDML_API @@ -1312,7 +1313,7 @@ SUBROUTINE FieldmlInput_FieldNodalParametersUpdate( FIELDML_INFO, EVALUATOR_NAME !Default to version 1 of each node derivative (value hardcoded in loop) VERSION_NUMBER = 1 - myWorldComputationNodeNumber = ComputationEnvironment_NodeNumberGet(err,error) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,myWorldComputationNodeNumber,err,error,*999) CALL DECOMPOSITION_MESH_COMPONENT_NUMBER_GET(FIELD%DECOMPOSITION,meshComponentNumber,err,error,*999) CALL DECOMPOSITION_NODE_DOMAIN_GET(FIELD%DECOMPOSITION,NODE_NUMBER,meshComponentNumber,nodeDomain,err,error,*999) IF(nodeDomain==myWorldComputationNodeNumber) THEN diff --git a/src/fieldml_output_routines.f90 b/src/fieldml_output_routines.f90 index a7d0b809..5bfc0e22 100755 --- a/src/fieldml_output_routines.f90 +++ b/src/fieldml_output_routines.f90 @@ -49,7 +49,7 @@ MODULE FIELDML_OUTPUT_ROUTINES USE BASIS_ROUTINES USE COORDINATE_ROUTINES USE CONSTANTS - USE ComputationRoutines + USE ComputationAccessRoutines USE FIELD_ROUTINES USE FIELDML_API USE FIELDML_TYPES @@ -1629,7 +1629,7 @@ SUBROUTINE FIELDML_OUTPUT_ADD_FIELD_NODE_DOFS( FIELDML_INFO, BASE_NAME, DOF_FORM !Default to version 1 of each node derivative (value hardcoded in loop) VERSION_NUMBER = 1 - myWorldComputationNodeNumber = ComputationEnvironment_NodeNumberGet(err,error) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,myWorldComputationNodeNumber,err,error,*999) CALL DECOMPOSITION_MESH_COMPONENT_NUMBER_GET(FIELD%DECOMPOSITION,meshComponentNumber,err,error,*999) CALL DECOMPOSITION_NODE_DOMAIN_GET(FIELD%DECOMPOSITION,I,meshComponentNumber,nodeDomain,err,error,*999) IF(nodeDomain==myWorldComputationNodeNumber) THEN diff --git a/src/finite_elasticity_routines.f90 b/src/finite_elasticity_routines.f90 index 586b1cec..00fd9c90 100644 --- a/src/finite_elasticity_routines.f90 +++ b/src/finite_elasticity_routines.f90 @@ -48,6 +48,7 @@ MODULE FINITE_ELASTICITY_ROUTINES USE BASIS_ROUTINES USE BOUNDARY_CONDITIONS_ROUTINES USE ComputationRoutines + USE ComputationAccessRoutines USE Constants USE CONTROL_LOOP_ROUTINES USE ControlLoopAccessRoutines @@ -152,7 +153,7 @@ SUBROUTINE FiniteElasticity_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BO TYPE(VARYING_STRING), INTENT(OUT) :: ERROR !1) THEN !This should work on a single processor but doesn't for mpich2 under windows. Maybe a bug? Avoid for now. CALL MPI_ALLGATHERV(MPI_IN_PLACE,MAX_NUMBER_ELEMENTS_PER_NODE,MPI_INTEGER,DECOMPOSITION%ELEMENT_DOMAIN, & - & RECEIVE_COUNTS,DISPLACEMENTS,MPI_INTEGER,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & RECEIVE_COUNTS,DISPLACEMENTS,MPI_INTEGER,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHERV",MPI_IERROR,ERR,ERROR,*999) ENDIF @@ -920,8 +918,8 @@ SUBROUTINE DECOMPOSITION_ELEMENT_DOMAIN_SET(DECOMPOSITION,GLOBAL_ELEMENT_NUMBER, MESH_TOPOLOGY=>MESH%TOPOLOGY(DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR IF(ASSOCIATED(MESH_TOPOLOGY)) THEN IF(GLOBAL_ELEMENT_NUMBER>0.AND.GLOBAL_ELEMENT_NUMBER<=MESH_TOPOLOGY%ELEMENTS%NUMBER_OF_ELEMENTS) THEN - number_computation_nodes=ComputationEnvironment_NumberOfNodesGet(ERR,ERROR) - IF(ERR/=0) GOTO 999 + CALL ComputationEnvironment_NumberOfWorldNodesGet(computationEnvironment,number_computation_nodes, & + & err,error,*999) IF(DOMAIN_NUMBER>=0.AND.DOMAIN_NUMBERdecompositionData%DECOMPOSITION IF(ASSOCIATED(decomposition)) THEN - decompositionElements=>TOPOLOGY%ELEMENTS - IF(ASSOCIATED(decompositionElements)) THEN - elementsMapping=>decomposition%DOMAIN(decomposition%MESH_COMPONENT_NUMBER)%PTR%MAPPINGS%ELEMENTS - IF(ASSOCIATED(elementsMapping)) THEN + CALL ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*999) + decompositionElements=>TOPOLOGY%ELEMENTS + IF(ASSOCIATED(decompositionElements)) THEN + elementsMapping=>decomposition%DOMAIN(decomposition%MESH_COMPONENT_NUMBER)%PTR%MAPPINGS%ELEMENTS + IF(ASSOCIATED(elementsMapping)) THEN meshComponentNumber=decomposition%MESH_COMPONENT_NUMBER meshData=>decomposition%MESH%TOPOLOGY(meshComponentNumber)%PTR%dataPoints IF(ASSOCIATED(meshData)) THEN - NUMBER_OF_COMPUTATION_NODES=ComputationEnvironment_NumberOfNodesGet(ERR,ERROR) - IF(ERR/=0) GOTO 999 - myWorldComputationNodeNumber=ComputationEnvironment_NodeNumberGet(ERR,ERROR) - IF(ERR/=0) GOTO 999 + CALL ComputationEnvironment_NumberOfWorldNodesGet(computationEnvironment,NUMBER_OF_COMPUTATION_NODES, & + & err,error,*999) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,myWorldComputationNodeNumber, & + & err,error,*999) ALLOCATE(decompositionData%numberOfDomainLocal(0:NUMBER_OF_COMPUTATION_NODES-1),STAT=ERR) ALLOCATE(decompositionData%numberOfDomainGhost(0:NUMBER_OF_COMPUTATION_NODES-1),STAT=ERR) ALLOCATE(decompositionData%numberOfElementDataPoints(decompositionElements%NUMBER_OF_GLOBAL_ELEMENTS),STAT=ERR) @@ -1345,11 +1344,11 @@ SUBROUTINE DecompositionTopology_DataPointsCalculate(TOPOLOGY,ERR,ERROR,*) NUMBER_OF_GHOST_DATA=decompositionData%totalNumberOfDataPoints-decompositionData%numberOfDataPoints !Gather number of local data points on all computation nodes CALL MPI_ALLGATHER(NUMBER_OF_LOCAL_DATA,1,MPI_INTEGER,decompositionData% & - & numberOfDomainLocal,1,MPI_INTEGER,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & numberOfDomainLocal,1,MPI_INTEGER,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPI_IERROR,ERR,ERROR,*999) !Gather number of ghost data points on all computation nodes CALL MPI_ALLGATHER(NUMBER_OF_GHOST_DATA,1,MPI_INTEGER,decompositionData% & - & numberOfDomainGhost,1,MPI_INTEGER,computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & numberOfDomainGhost,1,MPI_INTEGER,worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",MPI_IERROR,ERR,ERROR,*999) ELSE CALL FlagError("Mesh data points topology is not associated.",ERR,ERROR,*999) @@ -1374,6 +1373,7 @@ SUBROUTINE DecompositionTopology_DataPointsCalculate(TOPOLOGY,ERR,ERROR,*) RETURN 999 ERRORSEXITS("DecompositionTopology_DataPointsCalculate",ERR,ERROR) RETURN 1 + END SUBROUTINE DecompositionTopology_DataPointsCalculate ! @@ -4071,10 +4071,11 @@ SUBROUTINE DOMAIN_MAPPINGS_ELEMENTS_CALCULATE(DOMAIN,ERR,ERROR,*) IF(ASSOCIATED(DOMAIN%MESH)) THEN MESH=>DOMAIN%MESH component_idx=DOMAIN%MESH_COMPONENT_NUMBER - myWorldComputationNodeNumber=ComputationEnvironment_NodeNumberGet(ERR,ERROR) - IF(ERR/=0) GOTO 999 - !Calculate the local and global numbers and set up the mappings + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,myWorldComputationNodeNumber, & + & err,error,*999) + + !Calculate the local and global numbers and set up the mappings ALLOCATE(ELEMENTS_MAPPING%GLOBAL_TO_LOCAL_MAP(MESH%NUMBER_OF_ELEMENTS),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate element mapping global to local map.",ERR,ERROR,*999) ELEMENTS_MAPPING%NUMBER_OF_GLOBAL=MESH%TOPOLOGY(component_idx)%PTR%ELEMENTS%NUMBER_OF_ELEMENTS @@ -4440,12 +4441,12 @@ SUBROUTINE DOMAIN_MAPPINGS_NODES_DOFS_CALCULATE(DOMAIN,ERR,ERROR,*) MESH=>DOMAIN%MESH component_idx=DOMAIN%MESH_COMPONENT_NUMBER MESH_TOPOLOGY=>MESH%TOPOLOGY(component_idx)%PTR - - numberOfWorldComputationNodes=ComputationEnvironment_NumberOfNodesGet(ERR,ERROR) - IF(ERR/=0) GOTO 999 - myWorldComputationNodeNumber=ComputationEnvironment_NodeNumberGet(ERR,ERROR) - IF(ERR/=0) GOTO 999 - + + CALL ComputationEnvironment_NumberOfWorldNodesGet(computationEnvironment,numberOfWorldComputationNodes, & + & err,error,*999) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,myWorldComputationNodeNumber, & + & err,error,*999) + !Calculate the local and global numbers and set up the mappings ALLOCATE(NODES_MAPPING%GLOBAL_TO_LOCAL_MAP(MESH_TOPOLOGY%NODES%numberOfNodes),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate node mapping global to local map.",ERR,ERROR,*999) @@ -9791,11 +9792,7 @@ SUBROUTINE MeshTopology_NodeOnBoundaryGet(meshNodes,userNumber,onBoundary,err,er INTEGER(INTG), INTENT(OUT) :: err !Contains information on a computation work group - TYPE cmfe_ComputationWorkGroupType + !>Contains information on a work group + TYPE cmfe_WorkGroupType PRIVATE - TYPE(ComputationWorkGroupType), POINTER :: computationWorkGroup - END TYPE cmfe_ComputationWorkGroupType + TYPE(WorkGroupType), POINTER :: workGroup + END TYPE cmfe_WorkGroupType !Module variables @@ -355,7 +356,7 @@ MODULE OpenCMISS_Iron PUBLIC cmfe_CellMLEquationsType,cmfe_CellMLEquations_Finalise,cmfe_CellMLEquations_Initialise - PUBLIC cmfe_ComputationWorkGroupType,cmfe_ComputationWorkGroup_Initialise + PUBLIC cmfe_WorkGroupType,cmfe_WorkGroup_Initialise,cmfe_WorkGroup_Finalise PUBLIC cmfe_ControlLoopType,cmfe_ControlLoop_Finalise,cmfe_ControlLoop_Initialise,cmfe_ControlLoop_LoadOutputSet @@ -1253,7 +1254,7 @@ MODULE OpenCMISS_Iron !!================================================================================================================================== !! -!! ComputationEnvironment +!! Computation !! !!================================================================================================================================== @@ -1264,24 +1265,72 @@ MODULE OpenCMISS_Iron !Module variables !Interfaces + + !>Gets the group communicator for a work group + INTERFACE cmfe_WorkGroup_GroupCommunicatorGet + MODULE PROCEDURE cmfe_WorkGroup_GroupCommunicatorGetNumber + MODULE PROCEDURE cmfe_WorkGroup_GroupCommunicatorGetObj + END INTERFACE cmfe_WorkGroup_GroupCommunicatorGet + + !>Returns the label of a work group. + INTERFACE cmfe_WorkGroup_LabelGet + MODULE PROCEDURE cmfe_WorkGroup_LabelGetCNumber + MODULE PROCEDURE cmfe_WorkGroup_LabelGetCObj + MODULE PROCEDURE cmfe_WorkGroup_LabelGetVSNumber + MODULE PROCEDURE cmfe_WorkGroup_LabelGetVSObj + END INTERFACE cmfe_WorkGroup_LabelGet + + !>Sets/changes the label of a work group. + INTERFACE cmfe_WorkGroup_LabelSet + MODULE PROCEDURE cmfe_WorkGroup_LabelSetCNumber + MODULE PROCEDURE cmfe_WorkGroup_LabelSetCObj + MODULE PROCEDURE cmfe_WorkGroup_LabelSetVSNumber + MODULE PROCEDURE cmfe_WorkGroup_LabelSetVSObj + END INTERFACE cmfe_WorkGroup_LabelSet + + !>Gets the group node number in a work group + INTERFACE cmfe_WorkGroup_GroupNodeNumberGet + MODULE PROCEDURE cmfe_WorkGroup_GroupNodeNumberGetNumber + MODULE PROCEDURE cmfe_WorkGroup_GroupNodeNumberGetObj + END INTERFACE cmfe_WorkGroup_GroupNodeNumberGet + + !>Gets the number of group nodes in a work group + INTERFACE cmfe_WorkGroup_NumberOfGroupNodesGet + MODULE PROCEDURE cmfe_WorkGroup_NumberOfGroupNodesGetNumber + MODULE PROCEDURE cmfe_WorkGroup_NumberOfGroupNodesGetObj + END INTERFACE cmfe_WorkGroup_NumberOfGroupNodesGet + + !>Sets/changes the number of group nodes in a work group + INTERFACE cmfe_WorkGroup_NumberOfGroupNodesSet + MODULE PROCEDURE cmfe_WorkGroup_NumberOfGroupNodesSetNumber + MODULE PROCEDURE cmfe_WorkGroup_NumberOfGroupNodesSetObj + END INTERFACE cmfe_WorkGroup_NumberOfGroupNodesSet - PUBLIC cmfe_ComputationWorldCommunicatorGet,cmfe_ComputationWorldCommunicatorSet + PUBLIC cmfe_ComputationEnvironment_NumberOfWorldNodesGet + + PUBLIC cmfe_ComputationEnvironment_WorldCommunicatorGet - PUBLIC cmfe_ComputationNodeNumberGet + PUBLIC cmfe_ComputationEnvironment_WorldNodeNumberGet + + PUBLIC cmfe_ComputationEnvironment_WorldWorkGroupGet + + PUBLIC cmfe_WorkGroup_CreateStart - PUBLIC cmfe_ComputationNumberOfNodesGet + PUBLIC cmfe_WorkGroup_CreateFinish - PUBLIC cmfe_Computation_WorkGroupCreateStart + PUBLIC cmfe_WorkGroup_GroupCommunicatorGet - PUBLIC cmfe_Computation_WorkGroupCreateFinish + PUBLIC cmfe_WorkGroup_GroupNodeNumberGet - PUBLIC cmfe_Computation_WorkGroupSubgroupAdd + PUBLIC cmfe_WorkGroup_LabelGet,cmfe_WorkGroup_LabelSet + + PUBLIC cmfe_WorkGroup_NumberOfGroupNodesGet,cmfe_WorkGroup_NumberOfGroupNodesSet PUBLIC cmfe_Decomposition_WorldWorkGroupSet !!================================================================================================================================== !! -!! CONSTANTS +!! Constants !! !!================================================================================================================================== @@ -8076,26 +8125,51 @@ END SUBROUTINE cmfe_CellMLEquations_Initialise !================================================================================================================================ ! - !>Initialises a cmfe_ComputationWorkGroupType object. - SUBROUTINE cmfe_ComputationWorkGroup_Initialise(cmfe_ComputationWorkGroup,err) - !DLLEXPORT(cmfe_ComputationWorkGroup_Initialise) + !>Finalises a cmfe_WorkGroupType object. + SUBROUTINE cmfe_WorkGroup_Finalise(cmfe_WorkGroup,err) + !DLLEXPORT(cmfe_WorkGroup_Finalise) !Argument variables - TYPE(cmfe_ComputationWorkGroupType), INTENT(OUT) :: cmfe_ComputationWorkGroup !Initialises a cmfe_WorkGroupType object. + SUBROUTINE cmfe_WorkGroup_Initialise(cmfe_WorkGroup,err) + !DLLEXPORT(cmfe_WorkGroup_Initialise) + + !Argument variables + TYPE(cmfe_WorkGroupType), INTENT(OUT) :: cmfe_WorkGroup !Returns the current world communicator. - SUBROUTINE cmfe_ComputationWorldCommunicatorGet(worldCommunicator,err) - !DLLEXPORT(cmfe_ComputationWorldCommunicatorGet) + !>Returns the number of computation nodes in the world communicator. + SUBROUTINE cmfe_ComputationEnvironment_NumberOfWorldNodesGet(numberOfWorldNodes,err) + !DLLEXPORT(cmfe_ComputationEnvironment_NumberOfWorldNodesGet) !Argument variables - INTEGER(INTG), INTENT(OUT) :: worldCommunicator !Sets/changes the current world communicator. - SUBROUTINE cmfe_ComputationWorldCommunicatorSet(worldCommunicator,err) - !DLLEXPORT(cmfe_ComputationWorldCommunicatorSet) + !>Returns the current world communicator for the computation environment. + SUBROUTINE cmfe_ComputationEnvironment_WorldCommunicatorGet(worldCommunicator,err) + !DLLEXPORT(cmfe_ComputationEnvironment_WorldCommunicatorGet) !Argument variables - INTEGER(INTG), INTENT(IN) :: worldCommunicator !Returns the computation node number of the running process. - SUBROUTINE cmfe_ComputationNodeNumberGet(nodeNumber,err) - !DLLEXPORT(cmfe_ComputationNodeNumberGet) + !>Returns the computation node number in the world communicator. + SUBROUTINE cmfe_ComputationEnvironment_WorldNodeNumberGet(worldNodeNumber,err) + !DLLEXPORT(cmfe_ComputationEnvironment_WorldNodeNumberGet) !Argument variables - INTEGER(INTG), INTENT(OUT) :: nodeNumber !Returns the number of computation nodes for the running process. - SUBROUTINE cmfe_ComputationNumberOfNodesGet(numberOfNodes,err) - !DLLEXPORT(cmfe_ComputationNumberOfNodesGet) + !>Returns the world work group for the computation environment. + SUBROUTINE cmfe_ComputationEnvironment_WorldWorkGroupGet(worldWorkGroup,err) + !DLLEXPORT(cmfe_ComputationEnvironment_WorldWorkGroupGet) !Argument variables - INTEGER(INTG), INTENT(OUT) :: numberOfNodes !Start the creation of a computation work group under a parent work group - SUBROUTINE cmfe_Computation_WorkGroupCreateStart(parentWorkGroup,numberOfComputationNodes,workGroup,err) - !DLLEXPORT(cmfe_Computation_WorkGroupCreateStart) + SUBROUTINE cmfe_WorkGroup_CreateStart(userNumber,parentWorkGroup,workGroup,err) + !DLLEXPORT(cmfe_WorkGroup_CreateStart) !Argument Variables - TYPE(cmfe_ComputationWorkGroupType), INTENT(INOUT) :: parentWorkGroup !Finish the creation of a computation work group - SUBROUTINE cmfe_Computation_WorkGroupCreateFinish(workGroup,err) - !DLLEXPORT(cmfe_Computation_WorkGroupCreateFinish) + SUBROUTINE cmfe_WorkGroup_CreateFinish(workGroup,err) + !DLLEXPORT(cmfe_WorkGroup_CreateFinish) + !Argument Variables + TYPE(cmfe_WorkGroupType), INTENT(INOUT) :: workGroup !Returns the group communicator for a work group specified by a user number. + SUBROUTINE cmfe_WorkGroup_GroupCommunicatorGetNumber(workGroupUserNumber,groupCommunicator,err) + !DLLEXPORT(cmfe_WorkGroup_GroupCommunicatorNumber) + !Argument Variables + INTEGER(INTG), INTENT(IN) :: workGroupUserNumber !Returns the group communicator for a work group specified by an object. + SUBROUTINE cmfe_WorkGroup_GroupCommunicatorGetObj(workGroup,groupCommunicator,err) + !DLLEXPORT(cmfe_WorkGroup_GroupCommunicatorGetObj) !Argument Variables - TYPE(cmfe_ComputationWorkGroupType), INTENT(INOUT) :: workGroup !Returns the group node number a work group specified by a user number. + SUBROUTINE cmfe_WorkGroup_GroupNodeNumberGetNumber(workGroupUserNumber,groupNodeNumber,err) + !DLLEXPORT(cmfe_WorkGroup_GroupNodeNumberGetNumber) + !Argument Variables + INTEGER(INTG), INTENT(IN) :: workGroupUserNumber !Add a work sub-group to the parent work group based on the computational requirements - SUBROUTINE cmfe_Computation_WorkGroupSubGroupAdd(parentWorkGroup,numberComputationNodes,addedWorkGroup,err) - !DLLEXPORT(cmfe_Computation_WorkGroupSubGroupAdd) + !>Returns the group node number for a work group specified by an object. + SUBROUTINE cmfe_WorkGroup_GroupNodeNumberGetObj(workGroup,groupNodeNumber,err) + !DLLEXPORT(cmfe_WorkGroup_GroupNodeNumberGetObj) !Argument Variables - TYPE(cmfe_ComputationWorkGroupType), INTENT(INOUT) :: parentWorkGroup - TYPE(cmfe_ComputationWorkGroupType), INTENT(INOUT) :: addedWorkGroup - INTEGER(INTG),INTENT(IN) :: numberComputationNodes + TYPE(cmfe_WorkGroupType), INTENT(INOUT) :: workGroup !Returns the character label a work group specified by a user number. + SUBROUTINE cmfe_WorkGroup_LabelGetCNumber(workGroupUserNumber,label,err) + !DLLEXPORT(cmfe_WorkGroup_LabelGetCNumber) + !Argument Variables + INTEGER(INTG), INTENT(IN) :: workGroupUserNumber !Returns the character label for a work group specified by an object. + SUBROUTINE cmfe_WorkGroup_LabelGetCObj(workGroup,label,err) + !DLLEXPORT(cmfe_WorkGroup_LabelGetCObj) + !Argument Variables + TYPE(cmfe_WorkGroupType), INTENT(INOUT) :: workGroup !Returns the varying string label a work group specified by a user number. + SUBROUTINE cmfe_WorkGroup_LabelGetVSNumber(workGroupUserNumber,label,err) + !DLLEXPORT(cmfe_WorkGroup_LabelGetVSNumber) + !Argument Variables + INTEGER(INTG), INTENT(IN) :: workGroupUserNumber !Returns the varying string label for a work group specified by an object. + SUBROUTINE cmfe_WorkGroup_LabelGetVSObj(workGroup,label,err) + !DLLEXPORT(cmfe_WorkGroup_LabelGetVSObj) + !Argument Variables + TYPE(cmfe_WorkGroupType), INTENT(INOUT) :: workGroup !Sets/changes the character label a work group specified by a user number. + SUBROUTINE cmfe_WorkGroup_LabelSetCNumber(workGroupUserNumber,label,err) + !DLLEXPORT(cmfe_WorkGroup_LabelSetCNumber) + !Argument Variables + INTEGER(INTG), INTENT(IN) :: workGroupUserNumber !Sets/changes the character label for a work group specified by an object. + SUBROUTINE cmfe_WorkGroup_LabelSetCObj(workGroup,label,err) + !DLLEXPORT(cmfe_WorkGroup_LabelSetCObj) + !Argument Variables + TYPE(cmfe_WorkGroupType), INTENT(INOUT) :: workGroup !Sets/changes the varying string label a work group specified by a user number. + SUBROUTINE cmfe_WorkGroup_LabelSetVSNumber(workGroupUserNumber,label,err) + !DLLEXPORT(cmfe_WorkGroup_LabelSetVSNumber) + !Argument Variables + INTEGER(INTG), INTENT(IN) :: workGroupUserNumber !Sets/changes the varying string label for a work group specified by an object. + SUBROUTINE cmfe_WorkGroup_LabelSetVSObj(workGroup,label,err) + !DLLEXPORT(cmfe_WorkGroup_LabelSetVSObj) + !Argument Variables + TYPE(cmfe_WorkGroupType), INTENT(INOUT) :: workGroup !Returns the group number of nodes in a work group specified by a user number. + SUBROUTINE cmfe_WorkGroup_NumberOfGroupNodesGetNumber(workGroupUserNumber,numberOfGroupNodes,err) + !DLLEXPORT(cmfe_WorkGroup_NumberOfGroupNodesGetNumber) + !Argument Variables + INTEGER(INTG), INTENT(IN) :: workGroupUserNumber !Returns the group number of nodes for a work group specified by an object. + SUBROUTINE cmfe_WorkGroup_NumberOfGroupNodesGetObj(workGroup,numberOfGroupNodes,err) + !DLLEXPORT(cmfe_WorkGroup_NumberOfGroupNodesGetObj) + !Argument Variables + TYPE(cmfe_WorkGroupType), INTENT(INOUT) :: workGroup !Sets/Changes the group number of nodes for a work group specified by a user number. + SUBROUTINE cmfe_WorkGroup_NumberOfGroupNodesSetNumber(workGroupUserNumber,numberOfGroupNodes,err) + !DLLEXPORT(cmfe_WorkGroup_NumberOfGroupNodesSetNumber) + !Argument Variables + INTEGER(INTG), INTENT(IN) :: workGroupUserNumber !Sets/Changes the group number of nodes for a work group specified by an object. + SUBROUTINE cmfe_WorkGroup_NumberOfGroupNodesSetObj(workGroup,numberOfGroupNodes,err) + !DLLEXPORT(cmfe_WorkGroup_NumberOfGroupNodesSetObj) + !Argument Variables + TYPE(cmfe_WorkGroupType), INTENT(INOUT) :: workGroup ! REGION%equations_sets%equations_sets(EQUATIONS_SET_GLOBAL_NUMBER)%ptr NULLIFY(SOURCE_FIELD) COMPUTATION_DOMAIN=>REGION%MESHES%MESHES(1) & & %ptr%DECOMPOSITIONS%DECOMPOSITIONS(1)%ptr%DOMAIN(1)%ptr - myWorldComputationNodeNumber = ComputationEnvironment_NodeNumberGet(ERR,ERROR) NumberOfDimensions = COMPUTATION_DOMAIN%NUMBER_OF_DIMENSIONS NumberOfNodes = COMPUTATION_DOMAIN%TOPOLOGY%NODES%NUMBER_OF_NODES NodesInMeshComponent = REGION%meshes%meshes(1)%ptr%topology(1)%ptr%nodes%numberOfNodes diff --git a/src/reaction_diffusion_equation_routines.f90 b/src/reaction_diffusion_equation_routines.f90 index 05c4525c..edc6c7f9 100755 --- a/src/reaction_diffusion_equation_routines.f90 +++ b/src/reaction_diffusion_equation_routines.f90 @@ -48,6 +48,7 @@ MODULE REACTION_DIFFUSION_EQUATION_ROUTINES USE BASIS_ROUTINES USE BOUNDARY_CONDITIONS_ROUTINES USE ComputationRoutines + USE ComputationAccessRoutines USE Constants USE CONTROL_LOOP_ROUTINES USE ControlLoopAccessRoutines @@ -1558,7 +1559,8 @@ SUBROUTINE REACTION_DIFFUSION_POST_SOLVE_OUTPUT_DATA(CONTROL_LOOP,SOLVER,err,err CURRENT_LOOP_ITERATION=CONTROL_LOOP%TIME_LOOP%ITERATION_NUMBER OUTPUT_FREQUENCY=CONTROL_LOOP%TIME_LOOP%OUTPUT_NUMBER - myWorldComputationNodeNumber = ComputationEnvironment_NodeNumberGet(err,error) + CALL ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,myWorldComputationNodeNumber, & + & err,error,*999) IF(OUTPUT_FREQUENCY>0) THEN IF(MOD(CURRENT_LOOP_ITERATION,OUTPUT_FREQUENCY)==0) THEN IF(CONTROL_LOOP%TIME_LOOP%CURRENT_TIME<=CONTROL_LOOP%TIME_LOOP%STOP_TIME) THEN diff --git a/src/region_routines.f90 b/src/region_routines.f90 index 4be8544e..6885bf03 100755 --- a/src/region_routines.f90 +++ b/src/region_routines.f90 @@ -278,7 +278,7 @@ END SUBROUTINE REGION_CREATE_START !================================================================================================================================ ! - !>Destroys a region given by USER_NUMBER and all sub-regions under it. \todo create destroy by pointer method. \see OPENCMISS::Iron::cmfe_RegionDestroy + !>Destroys a region given by USER_NUMBER and all sub-regions under it. \todo create destroy by pointer method. \see OpenCMISS::Iron::cmfe_Region_Destroy RECURSIVE SUBROUTINE REGION_DESTROY_NUMBER(USER_NUMBER,ERR,ERROR,*) !Argument variables diff --git a/src/solver_access_routines.f90 b/src/solver_access_routines.f90 index f4983319..241c1492 100644 --- a/src/solver_access_routines.f90 +++ b/src/solver_access_routines.f90 @@ -250,7 +250,6 @@ SUBROUTINE Solver_SolversGet(solver,solvers,err,error,*) INTEGER(INTG), INTENT(OUT) :: err !SOLVER_MAPPING%ROW_DOFS_MAPPING ALLOCATE(ROW_DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(NUMBER_OF_GLOBAL_SOLVER_ROWS),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate row dofs mapping global to local map.",ERR,ERROR,*999) @@ -788,7 +787,7 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) IF(err/=0) CALL FlagError("Could not allocate dummy DOF coupling values.",err,error,*999) dummyDofCoupling%numberOfDofs=1 !Loop over the ranks to ensure that the lowest ranks have the lowest numbered solver variables - DO rank=0,computationEnvironment%numberOfWorldComputationNodes-1 + DO rank=0,numberOfWorldComputationNodes-1 NUMBER_OF_LOCAL_SOLVER_ROWS=0 !Calculate the solver row <-> equations row & interface row mappings. @@ -1226,9 +1225,9 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) !dof_type is 1 for domain local DOFs and 2 for ghost DOFs ALLOCATE(RANK_GLOBAL_COLS_LISTS(2,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS+SOLVER_MAPPING% & & NUMBER_OF_INTERFACE_CONDITIONS,SOLVER_MAPPING%VARIABLES_LIST(solver_matrix_idx)%NUMBER_OF_VARIABLES, & - & 0:computationEnvironment%numberOfWorldComputationNodes-1),STAT=ERR) + & 0:numberOfWorldComputationNodes-1),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate rank global columns lists.",ERR,ERROR,*999) - DO rank=0,computationEnvironment%numberOfWorldComputationNodes-1 + DO rank=0,numberOfWorldComputationNodes-1 DO solver_variable_idx=1,SOLVER_MAPPING%VARIABLES_LIST(solver_matrix_idx)%NUMBER_OF_VARIABLES DO equations_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS+SOLVER_MAPPING%NUMBER_OF_INTERFACE_CONDITIONS DO dof_type=1,2 @@ -1870,13 +1869,13 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) IF(ERR/=0) CALL FlagError("Could not allocate solver col to equations sets map column dofs mapping.",ERR,ERROR,*999) !!TODO: what is the real number of domains for a solver??? CALL DOMAIN_MAPPINGS_MAPPING_INITIALISE(SOLVER_MAPPING%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% & - & COLUMN_DOFS_MAPPING,computationEnvironment%numberOfWorldComputationNodes,ERR,ERROR,*999) + & COLUMN_DOFS_MAPPING,numberOfWorldComputationNodes,ERR,ERROR,*999) COL_DOMAIN_MAPPING=>SOLVER_MAPPING%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)%COLUMN_DOFS_MAPPING ALLOCATE(COL_DOMAIN_MAPPING%GLOBAL_TO_LOCAL_MAP(NUMBER_OF_GLOBAL_SOLVER_DOFS),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate column dofs mapping global to local.",ERR,ERROR,*999) COL_DOMAIN_MAPPING%NUMBER_OF_GLOBAL=NUMBER_OF_GLOBAL_SOLVER_DOFS ALLOCATE(VARIABLE_RANK_PROCESSED(SOLVER_MAPPING%VARIABLES_LIST(solver_matrix_idx)%NUMBER_OF_VARIABLES, & - & 0:computationEnvironment%numberOfWorldComputationNodes-1),STAT=ERR) + & 0:numberOfWorldComputationNodes-1),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate variable rank processed.",ERR,ERROR,*999) VARIABLE_RANK_PROCESSED=.FALSE. !Calculate the column mappings @@ -2260,7 +2259,7 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) DOF_MAP(solver_variable_idx)%PTR=0 ENDDO !solver_variable_idx - ALLOCATE(solver_local_dof(0:computationEnvironment%numberOfWorldComputationNodes-1),STAT=ERR) + ALLOCATE(solver_local_dof(0:numberOfWorldComputationNodes-1),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate solver local dof array.",ERR,ERROR,*999) ! @@ -2271,7 +2270,7 @@ SUBROUTINE SOLVER_MAPPING_CALCULATE(SOLVER_MAPPING,ERR,ERROR,*) solver_global_dof=0 solver_local_dof=0 DO dof_type=1,2 - DO rank=0,computationEnvironment%numberOfWorldComputationNodes-1 + DO rank=0,numberOfWorldComputationNodes-1 DO solver_variable_idx=1,SOLVER_MAPPING%VARIABLES_LIST(solver_matrix_idx)%NUMBER_OF_VARIABLES diff --git a/src/solver_routines.f90 b/src/solver_routines.f90 index de41f789..09a3bb89 100644 --- a/src/solver_routines.f90 +++ b/src/solver_routines.f90 @@ -53,6 +53,7 @@ MODULE SOLVER_ROUTINES USE CmissPetsc USE CmissPetscTypes USE ComputationRoutines + USE ComputationAccessRoutines USE Constants USE DISTRIBUTED_MATRIX_VECTOR USE EquationsAccessRoutines @@ -9717,6 +9718,7 @@ SUBROUTINE SOLVER_LINEAR_DIRECT_CREATE_FINISH(LINEAR_DIRECT_SOLVER,ERR,ERROR,*) INTEGER(INTG), INTENT(OUT) :: ERR !LINEAR_SOLVER%SOLVER IF(ASSOCIATED(SOLVER)) THEN + CALL ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*999) SELECT CASE(LINEAR_DIRECT_SOLVER%DIRECT_SOLVER_TYPE) CASE(SOLVER_DIRECT_LU) IF(ASSOCIATED(SOLVER%LINKING_SOLVER)) THEN @@ -9807,7 +9810,7 @@ SUBROUTINE SOLVER_LINEAR_DIRECT_CREATE_FINISH(LINEAR_DIRECT_SOLVER,ERR,ERROR,*) !Nothing else to do CASE(SOLVER_MUMPS_LIBRARY,SOLVER_SUPERLU_LIBRARY,SOLVER_PASTIX_LIBRARY,SOLVER_LAPACK_LIBRARY) !Set up solver through PETSc - CALL Petsc_KSPCreate(computationEnvironment%mpiWorldCommunicator,LINEAR_DIRECT_SOLVER%KSP,ERR,ERROR,*999) + CALL Petsc_KSPCreate(worldCommunicator,LINEAR_DIRECT_SOLVER%KSP,ERR,ERROR,*999) !Set any further KSP options from the command line options CALL Petsc_KSPSetFromOptions(LINEAR_DIRECT_SOLVER%KSP,ERR,ERROR,*999) @@ -10923,6 +10926,7 @@ SUBROUTINE SOLVER_LINEAR_ITERATIVE_CREATE_FINISH(LINEAR_ITERATIVE_SOLVER,ERR,ERR INTEGER(INTG), INTENT(OUT) :: ERR !LINEAR_SOLVER%SOLVER IF(ASSOCIATED(SOLVER)) THEN + CALL ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*999) !Should really check iterative types here and then the solver library but as they are all PETSc for now hold off. SELECT CASE(LINEAR_ITERATIVE_SOLVER%SOLVER_LIBRARY) CASE(SOLVER_CMISS_LIBRARY) @@ -11060,7 +11065,7 @@ SUBROUTINE SOLVER_LINEAR_ITERATIVE_CREATE_FINISH(LINEAR_ITERATIVE_SOLVER,ERR,ERR CALL FlagError("Solver linking solve is not associated.",ERR,ERROR,*999) ENDIF ELSE - CALL Petsc_KSPCreate(computationEnvironment%mpiWorldCommunicator,LINEAR_ITERATIVE_SOLVER%KSP,ERR,ERROR,*999) + CALL Petsc_KSPCreate(worldCommunicator,LINEAR_ITERATIVE_SOLVER%KSP,ERR,ERROR,*999) ENDIF !Set the iterative solver type SELECT CASE(LINEAR_ITERATIVE_SOLVER%ITERATIVE_SOLVER_TYPE) @@ -15715,7 +15720,7 @@ SUBROUTINE Solver_QuasiNewtonLinesearchCreateFinish(LINESEARCH_SOLVER,ERR,ERROR, EXTERNAL :: Problem_SolverResidualEvaluatePetsc EXTERNAL :: Problem_SolverConvergenceTestPetsc EXTERNAL :: Problem_SolverNonlinearMonitorPETSC - INTEGER(INTG) :: equations_matrix_idx,equations_set_idx,interface_condition_idx,interface_matrix_idx + INTEGER(INTG) :: equations_matrix_idx,equations_set_idx,interface_condition_idx,interface_matrix_idx,worldCommunicator TYPE(DISTRIBUTED_MATRIX_TYPE), POINTER :: JACOBIAN_MATRIX TYPE(DISTRIBUTED_VECTOR_TYPE), POINTER :: RESIDUAL_VECTOR TYPE(EquationsType), POINTER :: equations @@ -15752,6 +15757,7 @@ SUBROUTINE Solver_QuasiNewtonLinesearchCreateFinish(LINESEARCH_SOLVER,ERR,ERROR, IF(ASSOCIATED(NONLINEAR_SOLVER)) THEN SOLVER=>NONLINEAR_SOLVER%SOLVER IF(ASSOCIATED(SOLVER)) THEN + CALL ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*999) SOLVER_EQUATIONS=>SOLVER%SOLVER_EQUATIONS IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN SELECT CASE(LINESEARCH_SOLVER%SOLVER_LIBRARY) @@ -15893,7 +15899,7 @@ SUBROUTINE Solver_QuasiNewtonLinesearchCreateFinish(LINESEARCH_SOLVER,ERR,ERROR, ENDIF ENDDO !interface_idx !Create the PETSc SNES solver - CALL Petsc_SnesCreate(computationEnvironment%mpiWorldCommunicator,LINESEARCH_SOLVER%snes,ERR,ERROR,*999) + CALL Petsc_SnesCreate(worldCommunicator,LINESEARCH_SOLVER%snes,ERR,ERROR,*999) !Set the nonlinear solver type to be a Quasi-Newton line search solver CALL Petsc_SnesSetType(LINESEARCH_SOLVER%snes,PETSC_SNESQN,ERR,ERROR,*999) !Following routines don't work for petsc version < 3.5. @@ -16956,7 +16962,7 @@ SUBROUTINE Solver_QuasiNewtonTrustRegionCreateFinish(TRUSTREGION_SOLVER,ERR,ERRO TYPE(VARYING_STRING), INTENT(OUT) :: ERROR !NONLINEAR_SOLVER%SOLVER IF(ASSOCIATED(SOLVER)) THEN + CALL ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*999) SOLVER_EQUATIONS=>SOLVER%SOLVER_EQUATIONS IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN SELECT CASE(TRUSTREGION_SOLVER%SOLVER_LIBRARY) @@ -17075,7 +17082,7 @@ SUBROUTINE Solver_QuasiNewtonTrustRegionCreateFinish(TRUSTREGION_SOLVER,ERR,ERRO END SELECT CALL SOLVER_MATRICES_CREATE_FINISH(SOLVER_MATRICES,ERR,ERROR,*999) !Create the PETSc SNES solver - CALL Petsc_SnesCreate(computationEnvironment%mpiWorldCommunicator,TRUSTREGION_SOLVER%snes,ERR,ERROR,*999) + CALL Petsc_SnesCreate(worldCommunicator,TRUSTREGION_SOLVER%snes,ERR,ERROR,*999) !Set the nonlinear solver type to be a Quasi-Newton trust region solver CALL Petsc_SnesSetType(TRUSTREGION_SOLVER%snes,PETSC_SNESNEWTONTR,ERR,ERROR,*999) !Set the nonlinear function @@ -18489,7 +18496,7 @@ SUBROUTINE SOLVER_NEWTON_LINESEARCH_CREATE_FINISH(LINESEARCH_SOLVER,ERR,ERROR,*) EXTERNAL :: Problem_SolverResidualEvaluatePetsc EXTERNAL :: Problem_SolverConvergenceTestPetsc EXTERNAL :: Problem_SolverNonlinearMonitorPetsc - INTEGER(INTG) :: equations_matrix_idx,equations_set_idx,interface_condition_idx,interface_matrix_idx + INTEGER(INTG) :: equations_matrix_idx,equations_set_idx,interface_condition_idx,interface_matrix_idx,worldCommunicator TYPE(DISTRIBUTED_MATRIX_TYPE), POINTER :: JACOBIAN_MATRIX TYPE(DISTRIBUTED_VECTOR_TYPE), POINTER :: RESIDUAL_VECTOR TYPE(EquationsType), POINTER :: equations @@ -18526,6 +18533,7 @@ SUBROUTINE SOLVER_NEWTON_LINESEARCH_CREATE_FINISH(LINESEARCH_SOLVER,ERR,ERROR,*) IF(ASSOCIATED(NONLINEAR_SOLVER)) THEN SOLVER=>NONLINEAR_SOLVER%SOLVER IF(ASSOCIATED(SOLVER)) THEN + CALL ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*999) SOLVER_EQUATIONS=>SOLVER%SOLVER_EQUATIONS IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN SELECT CASE(LINESEARCH_SOLVER%SOLVER_LIBRARY) @@ -18667,7 +18675,7 @@ SUBROUTINE SOLVER_NEWTON_LINESEARCH_CREATE_FINISH(LINESEARCH_SOLVER,ERR,ERROR,*) ENDIF ENDDO !interface_idx !Create the PETSc SNES solver - CALL Petsc_SnesCreate(computationEnvironment%mpiWorldCommunicator,LINESEARCH_SOLVER%snes,ERR,ERROR,*999) + CALL Petsc_SnesCreate(worldCommunicator,LINESEARCH_SOLVER%snes,ERR,ERROR,*999) !Set the nonlinear solver type to be a Newton line search solver CALL Petsc_SnesSetType(LINESEARCH_SOLVER%snes,PETSC_SNESNEWTONLS,ERR,ERROR,*999) @@ -19713,7 +19721,7 @@ SUBROUTINE SOLVER_NEWTON_TRUSTREGION_CREATE_FINISH(TRUSTREGION_SOLVER,ERR,ERROR, TYPE(VARYING_STRING), INTENT(OUT) :: ERROR !NONLINEAR_SOLVER%SOLVER IF(ASSOCIATED(SOLVER)) THEN + CALL ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*999) SOLVER_EQUATIONS=>SOLVER%SOLVER_EQUATIONS IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN SELECT CASE(TRUSTREGION_SOLVER%SOLVER_LIBRARY) @@ -19832,7 +19841,7 @@ SUBROUTINE SOLVER_NEWTON_TRUSTREGION_CREATE_FINISH(TRUSTREGION_SOLVER,ERR,ERROR, END SELECT CALL SOLVER_MATRICES_CREATE_FINISH(SOLVER_MATRICES,ERR,ERROR,*999) !Create the PETSc SNES solver - CALL Petsc_SnesCreate(computationEnvironment%mpiWorldCommunicator,TRUSTREGION_SOLVER%snes,ERR,ERROR,*999) + CALL Petsc_SnesCreate(worldCommunicator,TRUSTREGION_SOLVER%snes,ERR,ERROR,*999) !Set the nonlinear solver type to be a Newton trust region solver CALL Petsc_SnesSetType(TRUSTREGION_SOLVER%snes,PETSC_SNESNEWTONTR,ERR,ERROR,*999) !Set the solver as the SNES application context diff --git a/tests/CellML/CellMLModelIntegration.f90 b/tests/CellML/CellMLModelIntegration.f90 index c09eeec2..4aabc8a5 100644 --- a/tests/CellML/CellMLModelIntegration.f90 +++ b/tests/CellML/CellMLModelIntegration.f90 @@ -189,8 +189,8 @@ PROGRAM CELLMLINTEGRATIONFORTRANEXAMPLE CALL cmfe_ErrorHandlingModeSet(CMFE_ERRORS_TRAP_ERROR,Err) !Get the computation nodes information - CALL cmfe_ComputationNumberOfNodesGet(NumberOfComputationNodes,Err) - CALL cmfe_ComputationNodeNumberGet(ComputationNodeNumber,Err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(NumberOfComputationNodes,Err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationNodeNumber,Err) ! IF (NumberOfComputationNodes .gt. 2) ! WRITE(*,'(">>NOTE: ",A)') "It doesn't make any sense to use more than 2 computation nodes for this example?" diff --git a/tests/CellML/Monodomain.f90 b/tests/CellML/Monodomain.f90 index a8ef4804..68c79aef 100644 --- a/tests/CellML/Monodomain.f90 +++ b/tests/CellML/Monodomain.f90 @@ -181,8 +181,8 @@ PROGRAM MONODOMAINEXAMPLE CALL cmfe_ErrorHandlingModeSet(CMFE_ERRORS_TRAP_ERROR,Err) !Get the computation nodes information - CALL cmfe_ComputationNumberOfNodesGet(NumberOfComputationNodes,Err) - CALL cmfe_ComputationNodeNumberGet(ComputationNodeNumber,Err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(NumberOfComputationNodes,Err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationNodeNumber,Err) !CALL cmfe_OutputSetOn("Monodomain",Err) diff --git a/tests/ClassicalField/AnalyticNonlinearPoisson.f90 b/tests/ClassicalField/AnalyticNonlinearPoisson.f90 index a40f8769..0834dc48 100644 --- a/tests/ClassicalField/AnalyticNonlinearPoisson.f90 +++ b/tests/ClassicalField/AnalyticNonlinearPoisson.f90 @@ -180,8 +180,8 @@ PROGRAM NONLINEARPOISSONEXAMPLE CALL cmfe_OutputSetOn("NonlinearPoisson",Err) !Get the computation nodes information - CALL cmfe_ComputationNumberOfNodesGet(NumberOfComputationNodes,Err) - CALL cmfe_ComputationNodeNumberGet(ComputationNodeNumber,Err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(NumberOfComputationNodes,Err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationNodeNumber,Err) !Start the creation of a new RC coordinate system CALL cmfe_CoordinateSystem_Initialise(CoordinateSystem,Err) diff --git a/tests/ClassicalField/Laplace.f90 b/tests/ClassicalField/Laplace.f90 index b84b501f..26378da6 100644 --- a/tests/ClassicalField/Laplace.f90 +++ b/tests/ClassicalField/Laplace.f90 @@ -184,8 +184,8 @@ PROGRAM LAPLACEEXAMPLE CALL cmfe_OutputSetOn(Filename,Err) !Get the computation nodes information - CALL cmfe_ComputationNumberOfNodesGet(NumberOfComputationNodes,Err) - CALL cmfe_ComputationNodeNumberGet(ComputationNodeNumber,Err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(NumberOfComputationNodes,Err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationNodeNumber,Err) !Start the creation of a new RC coordinate system CALL cmfe_CoordinateSystem_Initialise(CoordinateSystem,Err) diff --git a/tests/FieldML_IO/cube.f90 b/tests/FieldML_IO/cube.f90 index fa1ff835..ad1b2b83 100644 --- a/tests/FieldML_IO/cube.f90 +++ b/tests/FieldML_IO/cube.f90 @@ -128,8 +128,8 @@ SUBROUTINE ReadCube(worldRegion, inputFilename, region, mesh, geometricField, & ! Get computation nodes information - CALL cmfe_ComputationNumberOfNodesGet(numberOfComputationNodes, err) - CALL cmfe_ComputationNodeNumberGet(computationNodeNumber, err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(numberOfComputationNodes, err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(computationNodeNumber, err) ! Initialise FieldML and parse input file diff --git a/tests/FieldML_IO/fieldml_io.f90 b/tests/FieldML_IO/fieldml_io.f90 index 170f1871..24bf9ec8 100644 --- a/tests/FieldML_IO/fieldml_io.f90 +++ b/tests/FieldML_IO/fieldml_io.f90 @@ -65,8 +65,8 @@ PROGRAM IRON_TEST_FIELDML_IO ! Get computation nodes information - CALL cmfe_ComputationNumberOfNodesGet(numberOfComputationNodes, err) - CALL cmfe_ComputationNodeNumberGet(computationNodeNumber, err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(numberOfComputationNodes, err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(computationNodeNumber, err) CALL TestFieldMLIOCube(worldRegion) CALL TestFieldMLArguments(worldRegion) diff --git a/tests/FiniteElasticity/Cantilever.f90 b/tests/FiniteElasticity/Cantilever.f90 index be9ef1ca..85085ea9 100644 --- a/tests/FiniteElasticity/Cantilever.f90 +++ b/tests/FiniteElasticity/Cantilever.f90 @@ -209,8 +209,8 @@ PROGRAM CANTILEVEREXAMPLE WRITE(*,'("Scaling type: ", i3)') ScalingType !Get the number of computation nodes and this computation node number - CALL cmfe_ComputationNumberOfNodesGet(NumberOfComputationNodes,Err) - CALL cmfe_ComputationNodeNumberGet(ComputationNodeNumber,Err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(NumberOfComputationNodes,Err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationNodeNumber,Err) NumberOfDomains=NumberOfComputationNodes diff --git a/tests/FiniteElasticity/SimpleShear.f90 b/tests/FiniteElasticity/SimpleShear.f90 index 73cc83fe..c1825d3a 100644 --- a/tests/FiniteElasticity/SimpleShear.f90 +++ b/tests/FiniteElasticity/SimpleShear.f90 @@ -159,8 +159,8 @@ PROGRAM SIMPLESHEAREXAMPLE CALL cmfe_OutputSetOn("SimpleShear",Err) !Get the number of computation nodes and this computation node number - CALL cmfe_ComputationNumberOfNodesGet(NumberOfComputationNodes,Err) - CALL cmfe_ComputationNodeNumberGet(ComputationNodeNumber,Err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(NumberOfComputationNodes,Err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationNodeNumber,Err) NumberGlobalXElements=2 NumberGlobalYElements=2 diff --git a/tests/LinearElasticity/CantileverBeam.f90 b/tests/LinearElasticity/CantileverBeam.f90 index f7435318..002a79fc 100644 --- a/tests/LinearElasticity/CantileverBeam.f90 +++ b/tests/LinearElasticity/CantileverBeam.f90 @@ -233,8 +233,8 @@ SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_GENERIC(NumberGlobalXElements,NumberGlobal FieldDependentNumberOfComponents=NumberOfXi !Get the number of computation nodes and this computation node number - CALL cmfe_ComputationNumberOfNodesGet(NumberOfComputationNodes,Err) - CALL cmfe_ComputationNodeNumberGet(ComputationNodeNumber,Err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(NumberOfComputationNodes,Err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationNodeNumber,Err) !Broadcast the number of elements in the X,Y and Z directions and the number of partitions to the other computation nodes CALL MPI_BCAST(NumberGlobalXElements,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR) diff --git a/tests/LinearElasticity/Extension.f90 b/tests/LinearElasticity/Extension.f90 index f286bdd4..944c7e52 100644 --- a/tests/LinearElasticity/Extension.f90 +++ b/tests/LinearElasticity/Extension.f90 @@ -285,8 +285,8 @@ SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_GENERIC(NumberGlobalXElements,NumberGlobal FieldDependentNumberOfComponents=NumberOfXi !Get the number of computation nodes and this computation node number - CALL cmfe_ComputationNumberOfNodesGet(NumberOfComputationNodes,Err) - CALL cmfe_ComputationNodeNumberGet(ComputationNodeNumber,Err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(NumberOfComputationNodes,Err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationNodeNumber,Err) !Broadcast the number of elements in the X,Y and Z directions and the number of partitions to the other computation nodes CALL MPI_BCAST(NumberGlobalXElements,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR) From 107492b7ac84109ffa72ff2819d0293384833aeb Mon Sep 17 00:00:00 2001 From: Chris Bradley Date: Wed, 27 Sep 2017 15:58:37 +1300 Subject: [PATCH 4/6] Fixes for workgroups. --- bindings/c/tests/laplace.c | 6 +- src/Navier_Stokes_equations_routines.f90 | 2 +- src/computation_access_routines.f90 | 34 +-- src/computation_routines.f90 | 87 ++++--- src/equations_matrices_routines.f90 | 4 +- src/equations_routines.f90 | 2 +- src/opencmiss_iron.f90 | 236 +++++++++++------- tests/CellML/CellMLModelIntegration.f90 | 6 +- tests/CellML/Monodomain.f90 | 6 +- .../AnalyticNonlinearPoisson.f90 | 6 +- tests/ClassicalField/Laplace.f90 | 6 +- tests/FieldML_IO/cube.f90 | 7 +- tests/FieldML_IO/fieldml_io.f90 | 7 +- tests/FiniteElasticity/Cantilever.f90 | 6 +- tests/FiniteElasticity/SimpleShear.f90 | 6 +- tests/LinearElasticity/CantileverBeam.f90 | 6 +- tests/LinearElasticity/Extension.f90 | 6 +- 17 files changed, 268 insertions(+), 165 deletions(-) diff --git a/bindings/c/tests/laplace.c b/bindings/c/tests/laplace.c index 8e9dd05b..30d4afc6 100755 --- a/bindings/c/tests/laplace.c +++ b/bindings/c/tests/laplace.c @@ -90,6 +90,7 @@ int main() { cmfe_BasisType Basis = (cmfe_BasisType)NULL; cmfe_BoundaryConditionsType BoundaryConditions=(cmfe_BoundaryConditionsType)NULL; + cmfe_ComputationEnvironmentType ComputationEnvironment = (cmfe_ComputationEnvironmentType)NULL; cmfe_CoordinateSystemType CoordinateSystem=(cmfe_CoordinateSystemType)NULL,WorldCoordinateSystem=(cmfe_CoordinateSystemType)NULL; cmfe_DecompositionType Decomposition=(cmfe_DecompositionType)NULL; cmfe_EquationsType Equations=(cmfe_EquationsType)NULL; @@ -127,8 +128,9 @@ int main() CHECK_ERROR("Initialising OpenCMISS-Iron"); Err = cmfe_ErrorHandlingModeSet(CMFE_ERRORS_TRAP_ERROR); - Err = cmfe_ComputationEnvironment_NumberOfWorldNodesGet(&NumberOfComputationNodes); - Err = cmfe_ComputationEnvironment_WorldNodeNumberGet(&ComputationNodeNumber); + Err = cmfe_ComputationEnvironment_Initialise(&ComputationEnvironment); + Err = cmfe_ComputationEnvironment_NumberOfWorldNodesGet(ComputationEnvironment,&NumberOfComputationNodes); + Err = cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationEnvironment,&ComputationNodeNumber); /* Start the creation of a new RC coordinate system */ Err = cmfe_CoordinateSystem_Initialise(&CoordinateSystem); diff --git a/src/Navier_Stokes_equations_routines.f90 b/src/Navier_Stokes_equations_routines.f90 index d22c0099..0f1d45e3 100644 --- a/src/Navier_Stokes_equations_routines.f90 +++ b/src/Navier_Stokes_equations_routines.f90 @@ -8763,7 +8763,7 @@ SUBROUTINE NavierStokes_PreSolveAleUpdateMesh(solver,err,error,*) LOGICAL :: fluidEquationsSetFound=.FALSE. LOGICAL :: solidEquationsSetFound=.FALSE. - ENTERS("NavierStokes_PreSolveALEUpdateMesh",err,error,*999) + ENTERS("NavierStokes_PreSolveAleUpdateMesh",err,error,*999) NULLIFY(controlLoop) NULLIFY(dynamicSolver) diff --git a/src/computation_access_routines.f90 b/src/computation_access_routines.f90 index f7866d6b..edb69536 100644 --- a/src/computation_access_routines.f90 +++ b/src/computation_access_routines.f90 @@ -130,7 +130,7 @@ MODULE ComputationAccessRoutines !Module variables - TYPE(ComputationEnvironmentType), TARGET :: computationEnvironment !Gets the current world communicator. - SUBROUTINE ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err,error,*) + SUBROUTINE ComputationEnvironment_WorldCommunicatorGet(computationEnviron,worldCommunicator,err,error,*) !Argument Variables - TYPE(ComputationEnvironmentType), INTENT(IN) :: computationEnvironment !Returns the number/rank of the computation node in the world communicator - SUBROUTINE ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,worldNodeNumber,err,error,*) + SUBROUTINE ComputationEnvironment_WorldNodeNumberGet(computationEnviron,worldNodeNumber,err,error,*) !Argument Variables - TYPE(ComputationEnvironmentType), INTENT(IN) :: computationEnvironment !Gets the number of computation nodes in the world communicator. - SUBROUTINE ComputationEnvironment_NumberOfWorldNodesGet(computationEnvironment,numberOfWorldNodes,err,error,*) + SUBROUTINE ComputationEnvironment_NumberOfWorldNodesGet(computationEnviron,numberOfWorldNodes,err,error,*) !Argument Variables - TYPE(ComputationEnvironmentType), INTENT(IN) :: computationEnvironment !Gets the world work group from a computational environment. - SUBROUTINE ComputationEnvironment_WorldWorkGroupGet(computationEnvironment,worldWorkGroup,err,error,*) + SUBROUTINE ComputationEnvironment_WorldWorkGroupGet(computationEnviron,worldWorkGroup,err,error,*) !Argument variables - TYPE(ComputationEnvironmentType), INTENT(IN) :: computationEnvironment !computationEnvironment%worldWorkGroup + worldWorkGroup=>computationEnviron%worldWorkGroup !Check world work group is associated. IF(.NOT.ASSOCIATED(worldWorkGroup)) & & CALL FlagError("World work group is not associated for the computation environment.",err,error,*999) diff --git a/src/computation_routines.f90 b/src/computation_routines.f90 index 33eed5c0..18e2390c 100755 --- a/src/computation_routines.f90 +++ b/src/computation_routines.f90 @@ -200,7 +200,7 @@ END SUBROUTINE Computation_MPIComputationNodeFinalise SUBROUTINE Computation_MPIComputationNodeInitialise(computationEnvironment,rank,err,error,*) !Argument Variables - TYPE(ComputationEnvironmentType), INTENT(INOUT) :: computationEnvironment !computationEnvironment%numberOfWorldComputationNodes) THEN @@ -348,6 +348,7 @@ SUBROUTINE Computation_Initialise(err,error,*) cmissMPIInitialised=.TRUE. ENDIF + NULLIFY(computationEnvironment) CALL ComputationEnvironment_Initialise(computationEnvironment,err,error,*999) !Initialise node numbers in base routines. @@ -377,7 +378,7 @@ END SUBROUTINE Computation_Initialise SUBROUTINE ComputationEnvironment_Finalise(computationEnvironment,err,error,*) !Argument Variables - TYPE(ComputationEnvironmentType) :: computationEnvironment !parentWorkGroup%computationEnvironment + workGroup%computationEnvironment=>parentWorkGroup%computationEnvironment !Add the work group to the list of parent sub groups ALLOCATE(newSubGroups(parentWorkGroup%numberOfSubGroups+1),STAT=err) IF(err/=0) CALL FlagError("Could not allocate new sub groups.",err,error,*999) @@ -676,7 +677,7 @@ SUBROUTINE WorkGroup_CreateFinish(workGroup,err,error,*) TYPE(VARYING_STRING),INTENT(OUT) :: error !Contains information on a computation environment + TYPE cmfe_ComputationEnvironmentType + PRIVATE + TYPE(ComputationEnvironmentType), POINTER :: computationEnvironment_ + END TYPE cmfe_ComputationEnvironmentType + !>Contains information on a control loop. TYPE cmfe_ControlLoopType PRIVATE @@ -356,7 +362,7 @@ MODULE OpenCMISS_Iron PUBLIC cmfe_CellMLEquationsType,cmfe_CellMLEquations_Finalise,cmfe_CellMLEquations_Initialise - PUBLIC cmfe_WorkGroupType,cmfe_WorkGroup_Initialise,cmfe_WorkGroup_Finalise + PUBLIC cmfe_ComputationEnvironmentType,cmfe_ComputationEnvironment_Initialise,cmfe_ComputationEnvironment_Finalise PUBLIC cmfe_ControlLoopType,cmfe_ControlLoop_Finalise,cmfe_ControlLoop_Initialise,cmfe_ControlLoop_LoadOutputSet @@ -370,6 +376,10 @@ MODULE OpenCMISS_Iron PUBLIC cmfe_Decomposition_CalculateFacesSet,cmfe_Decomposition_CalculateLinesSet + PUBLIC cmfe_DistributedMatrixType,cmfe_DistributedVectorType + + PUBLIC cmfe_DistributedMatrix_Initialise,cmfe_DistributedVector_Initialise + PUBLIC cmfe_EquationsType,cmfe_Equations_Finalise,cmfe_Equations_Initialise PUBLIC cmfe_EquationsSetType,cmfe_EquationsSet_Finalise,cmfe_EquationsSet_Initialise @@ -394,10 +404,6 @@ MODULE OpenCMISS_Iron PUBLIC cmfe_InterfacePointsConnectivityType,cmfe_InterfacePointsConnectivity_Initialise, & & cmfe_InterfacePointsConnectivity_Finalise - PUBLIC cmfe_DistributedMatrixType,cmfe_DistributedVectorType - - PUBLIC cmfe_DistributedMatrix_Initialise,cmfe_DistributedVector_Initialise - PUBLIC cmfe_MeshType,cmfe_Mesh_Finalise,cmfe_Mesh_Initialise PUBLIC cmfe_MeshElementsType,cmfe_MeshElements_Finalise,cmfe_MeshElements_Initialise @@ -416,6 +422,8 @@ MODULE OpenCMISS_Iron PUBLIC cmfe_SolverEquationsType,cmfe_SolverEquations_Finalise,cmfe_SolverEquations_Initialise + PUBLIC cmfe_WorkGroupType,cmfe_WorkGroup_Initialise,cmfe_WorkGroup_Finalise + !!================================================================================================================================== !! !! ANALYTIC_ANALYSIS_ROUTINES @@ -8125,51 +8133,51 @@ END SUBROUTINE cmfe_CellMLEquations_Initialise !================================================================================================================================ ! - !>Finalises a cmfe_WorkGroupType object. - SUBROUTINE cmfe_WorkGroup_Finalise(cmfe_WorkGroup,err) - !DLLEXPORT(cmfe_WorkGroup_Finalise) + !>Finalises a cmfe_ComputationEnvironmentType object. + SUBROUTINE cmfe_ComputationEnvironment_Finalise(cmfe_ComputationEnvironment,err) + !DLLEXPORT(cmfe_ComputationEnvironment_Finalise) !Argument variables - TYPE(cmfe_WorkGroupType), INTENT(OUT) :: cmfe_WorkGroup !Initialises a cmfe_WorkGroupType object. - SUBROUTINE cmfe_WorkGroup_Initialise(cmfe_WorkGroup,err) - !DLLEXPORT(cmfe_WorkGroup_Initialise) + !>Initialises a cmfe_ComputationEnvironmentType object. + SUBROUTINE cmfe_ComputationEnvironment_Initialise(cmfe_ComputationEnvironment,err) + !DLLEXPORT(cmfe_ComputationEnvironment_Initialise) !Argument variables - TYPE(cmfe_WorkGroupType), INTENT(OUT) :: cmfe_WorkGroup !computationEnvironment - EXITS("cmfe_WorkGroup_Initialise") + EXITS("cmfe_ComputationEnvironment_Initialise") RETURN -999 ERRORSEXITS("cmfe_WorkGroup_Initialise",err,error) +999 ERRORSEXITS("cmfe_ComputationEnvironment_Initialise",err,error) CALL cmfe_HandleError(err,error) RETURN - END SUBROUTINE cmfe_WorkGroup_Initialise + END SUBROUTINE cmfe_ComputationEnvironment_Initialise ! !================================================================================================================================ @@ -8429,6 +8437,56 @@ END SUBROUTINE cmfe_Decomposition_Initialise !================================================================================================================================ ! + !>Initialises a cmfe_DistributedMatrixType object. + SUBROUTINE cmfe_DistributedMatrix_Initialise(cmfe_DistributedMatrix,err) + !DLLEXPORT(cmfe_DistributedMatrix_Initialise) + + !Argument variables + TYPE(cmfe_DistributedMatrixType), INTENT(OUT) :: cmfe_DistributedMatrix !Initialises a cmfe_DistributedVectorType object. + SUBROUTINE cmfe_DistributedVector_Initialise(cmfe_DistributedVector,err) + !DLLEXPORT(cmfe_DistributedVector_Initialise) + + !Argument variables + TYPE(cmfe_DistributedVectorType), INTENT(OUT) :: cmfe_DistributedVector !Finalises a cmfe_EquationsType object. SUBROUTINE cmfe_Equations_Finalise(cmfe_Equations,err) !DLLEXPORT(cmfe_Equations_Finalise) @@ -9064,56 +9122,6 @@ END SUBROUTINE cmfe_History_Initialise !================================================================================================================================ ! - !>Initialises a cmfe_DistributedMatrixType object. - SUBROUTINE cmfe_DistributedMatrix_Initialise(cmfe_DistributedMatrix,err) - !DLLEXPORT(cmfe_DistributedMatrix_Initialise) - - !Argument variables - TYPE(cmfe_DistributedMatrixType), INTENT(OUT) :: cmfe_DistributedMatrix !Initialises a cmfe_DistributedVectorType object. - SUBROUTINE cmfe_DistributedVector_Initialise(cmfe_DistributedVector,err) - !DLLEXPORT(cmfe_DistributedVector_Initialise) - - !Argument variables - TYPE(cmfe_DistributedVectorType), INTENT(OUT) :: cmfe_DistributedVector !Finalises a cmfe_MeshType object. SUBROUTINE cmfe_Mesh_Finalise(cmfe_Mesh,err) !DLLEXPORT(cmfe_Mesh_Finalise) @@ -9566,6 +9574,56 @@ SUBROUTINE cmfe_SolverEquations_Initialise(cmfe_SolverEquations,err) END SUBROUTINE cmfe_SolverEquations_Initialise + ! + !================================================================================================================================ + ! + + !>Finalises a cmfe_WorkGroupType object. + SUBROUTINE cmfe_WorkGroup_Finalise(cmfe_WorkGroup,err) + !DLLEXPORT(cmfe_WorkGroup_Finalise) + + !Argument variables + TYPE(cmfe_WorkGroupType), INTENT(OUT) :: cmfe_WorkGroup !Initialises a cmfe_WorkGroupType object. + SUBROUTINE cmfe_WorkGroup_Initialise(cmfe_WorkGroup,err) + !DLLEXPORT(cmfe_WorkGroup_Initialise) + + !Argument variables + TYPE(cmfe_WorkGroupType), INTENT(OUT) :: cmfe_WorkGroup !Returns the number of computation nodes in the world communicator. - SUBROUTINE cmfe_ComputationEnvironment_NumberOfWorldNodesGet(numberOfWorldNodes,err) + SUBROUTINE cmfe_ComputationEnvironment_NumberOfWorldNodesGet(computationEnvironment,numberOfWorldNodes,err) !DLLEXPORT(cmfe_ComputationEnvironment_NumberOfWorldNodesGet) !Argument variables - !TYPE(cmfe_ComputationEnvironmentType), INTENT(IN) :: computationEnvironment !Returns the current world communicator for the computation environment. - SUBROUTINE cmfe_ComputationEnvironment_WorldCommunicatorGet(worldCommunicator,err) + SUBROUTINE cmfe_ComputationEnvironment_WorldCommunicatorGet(computationEnvironment,worldCommunicator,err) !DLLEXPORT(cmfe_ComputationEnvironment_WorldCommunicatorGet) !Argument variables - !TYPE(cmfe_ComputationEnvironmentType), INTENT(IN) :: computationEnvironment !Returns the computation node number in the world communicator. - SUBROUTINE cmfe_ComputationEnvironment_WorldNodeNumberGet(worldNodeNumber,err) + SUBROUTINE cmfe_ComputationEnvironment_WorldNodeNumberGet(computationEnvironment,worldNodeNumber,err) !DLLEXPORT(cmfe_ComputationEnvironment_WorldNodeNumberGet) !Argument variables - !TYPE(cmfe_ComputationEnvironmentType), INTENT(IN) :: computationEnvironment !Returns the world work group for the computation environment. - SUBROUTINE cmfe_ComputationEnvironment_WorldWorkGroupGet(worldWorkGroup,err) + SUBROUTINE cmfe_ComputationEnvironment_WorldWorkGroupGet(computationEnvironment,worldWorkGroup,err) !DLLEXPORT(cmfe_ComputationEnvironment_WorldWorkGroupGet) !Argument variables - !TYPE(cmfe_ComputationEnvironmentType), INTENT(IN) :: computationEnvironment !>NOTE: ",A)') "It doesn't make any sense to use more than 2 computation nodes for this example?" diff --git a/tests/CellML/Monodomain.f90 b/tests/CellML/Monodomain.f90 index 68c79aef..9e2fecc2 100644 --- a/tests/CellML/Monodomain.f90 +++ b/tests/CellML/Monodomain.f90 @@ -122,6 +122,7 @@ PROGRAM MONODOMAINEXAMPLE TYPE(cmfe_BoundaryConditionsType) :: BoundaryConditions TYPE(cmfe_CellMLType) :: CellML TYPE(cmfe_CellMLEquationsType) :: CellMLEquations + TYPE(cmfe_ComputationEnvironmentType) :: ComputationEnvironment TYPE(cmfe_ControlLoopType) :: ControlLoop TYPE(cmfe_CoordinateSystemType) :: CoordinateSystem,WorldCoordinateSystem TYPE(cmfe_DecompositionType) :: Decomposition @@ -181,8 +182,9 @@ PROGRAM MONODOMAINEXAMPLE CALL cmfe_ErrorHandlingModeSet(CMFE_ERRORS_TRAP_ERROR,Err) !Get the computation nodes information - CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(NumberOfComputationNodes,Err) - CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationNodeNumber,Err) + CALL cmfe_ComputationEnvironment_Initialise(ComputationEnvironment,Err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(ComputationEnvironment,NumberOfComputationNodes,Err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationEnvironment,ComputationNodeNumber,Err) !CALL cmfe_OutputSetOn("Monodomain",Err) diff --git a/tests/ClassicalField/AnalyticNonlinearPoisson.f90 b/tests/ClassicalField/AnalyticNonlinearPoisson.f90 index 0834dc48..dcb7e8eb 100644 --- a/tests/ClassicalField/AnalyticNonlinearPoisson.f90 +++ b/tests/ClassicalField/AnalyticNonlinearPoisson.f90 @@ -97,6 +97,7 @@ PROGRAM NONLINEARPOISSONEXAMPLE !CMISS variables TYPE(cmfe_BasisType) :: Basis + TYPE(cmfe_ComputationEnvironmentType) :: ComputationEnvironment TYPE(cmfe_CoordinateSystemType) :: CoordinateSystem,WorldCoordinateSystem TYPE(cmfe_DecompositionType) :: Decomposition TYPE(cmfe_EquationsType) :: Equations @@ -180,8 +181,9 @@ PROGRAM NONLINEARPOISSONEXAMPLE CALL cmfe_OutputSetOn("NonlinearPoisson",Err) !Get the computation nodes information - CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(NumberOfComputationNodes,Err) - CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationNodeNumber,Err) + CALL cmfe_ComputationEnvironment_Initialise(ComputationEnvironment,Err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(ComputationEnvironment,NumberOfComputationNodes,Err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationEnvironment,ComputationNodeNumber,Err) !Start the creation of a new RC coordinate system CALL cmfe_CoordinateSystem_Initialise(CoordinateSystem,Err) diff --git a/tests/ClassicalField/Laplace.f90 b/tests/ClassicalField/Laplace.f90 index 26378da6..592e8fcd 100644 --- a/tests/ClassicalField/Laplace.f90 +++ b/tests/ClassicalField/Laplace.f90 @@ -97,6 +97,7 @@ PROGRAM LAPLACEEXAMPLE TYPE(cmfe_BasisType) :: Basis TYPE(cmfe_BoundaryConditionsType) :: BoundaryConditions + TYPE(cmfe_ComputationEnvironmentType) :: ComputationEnvironment TYPE(cmfe_CoordinateSystemType) :: CoordinateSystem,WorldCoordinateSystem TYPE(cmfe_DecompositionType) :: Decomposition TYPE(cmfe_EquationsType) :: Equations @@ -184,8 +185,9 @@ PROGRAM LAPLACEEXAMPLE CALL cmfe_OutputSetOn(Filename,Err) !Get the computation nodes information - CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(NumberOfComputationNodes,Err) - CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationNodeNumber,Err) + CALL cmfe_ComputationEnvironment_Initialise(ComputationEnvironment,Err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(ComputationEnvironment,NumberOfComputationNodes,Err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationEnvironment,ComputationNodeNumber,Err) !Start the creation of a new RC coordinate system CALL cmfe_CoordinateSystem_Initialise(CoordinateSystem,Err) diff --git a/tests/FieldML_IO/cube.f90 b/tests/FieldML_IO/cube.f90 index ad1b2b83..6e5d73ce 100644 --- a/tests/FieldML_IO/cube.f90 +++ b/tests/FieldML_IO/cube.f90 @@ -117,6 +117,7 @@ SUBROUTINE ReadCube(worldRegion, inputFilename, region, mesh, geometricField, & TYPE(cmfe_FieldType), INTENT(OUT) :: geometricField ! local variables TYPE(cmfe_BasisType) :: basis + TYPE(cmfe_ComputationEnvironmentType) :: ComputationEnvironment TYPE(cmfe_CoordinateSystemType) :: coordinateSystem TYPE(cmfe_DecompositionType) :: decomposition TYPE(cmfe_NodesType) :: nodes @@ -127,9 +128,9 @@ SUBROUTINE ReadCube(worldRegion, inputFilename, region, mesh, geometricField, & err = 0 ! Get computation nodes information - - CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(numberOfComputationNodes, err) - CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(computationNodeNumber, err) + CALL cmfe_ComputationEnvironment_Initialise(ComputationEnvironment,Err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(ComputationEnvironment,NumberOfComputationNodes,Err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationEnvironment,ComputationNodeNumber,Err) ! Initialise FieldML and parse input file diff --git a/tests/FieldML_IO/fieldml_io.f90 b/tests/FieldML_IO/fieldml_io.f90 index 24bf9ec8..74c1662d 100644 --- a/tests/FieldML_IO/fieldml_io.f90 +++ b/tests/FieldML_IO/fieldml_io.f90 @@ -48,6 +48,7 @@ PROGRAM IRON_TEST_FIELDML_IO IMPLICIT NONE ! CMISS variables + TYPE(cmfe_ComputationEnvironmentType) :: ComputationEnvironment TYPE(cmfe_CoordinateSystemType) :: worldCoordinateSystem TYPE(cmfe_RegionType) :: worldRegion @@ -64,9 +65,9 @@ PROGRAM IRON_TEST_FIELDML_IO CALL cmfe_ErrorHandlingModeSet(CMFE_ERRORS_TRAP_ERROR, err) ! Get computation nodes information - - CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(numberOfComputationNodes, err) - CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(computationNodeNumber, err) + CALL cmfe_ComputationEnvironment_Initialise(ComputationEnvironment,Err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(ComputationEnvironment,NumberOfComputationNodes,Err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationEnvironment,ComputationNodeNumber,Err) CALL TestFieldMLIOCube(worldRegion) CALL TestFieldMLArguments(worldRegion) diff --git a/tests/FiniteElasticity/Cantilever.f90 b/tests/FiniteElasticity/Cantilever.f90 index 85085ea9..36cec906 100644 --- a/tests/FiniteElasticity/Cantilever.f90 +++ b/tests/FiniteElasticity/Cantilever.f90 @@ -108,6 +108,7 @@ PROGRAM CANTILEVEREXAMPLE !CMISS variables TYPE(cmfe_BasisType) :: DisplacementBasis,PressureBasis TYPE(cmfe_BoundaryConditionsType) :: BoundaryConditions + TYPE(cmfe_ComputationEnvironmentType) :: ComputationEnvironment TYPE(cmfe_CoordinateSystemType) :: CoordinateSystem, WorldCoordinateSystem TYPE(cmfe_MeshType) :: Mesh TYPE(cmfe_DecompositionType) :: Decomposition @@ -209,8 +210,9 @@ PROGRAM CANTILEVEREXAMPLE WRITE(*,'("Scaling type: ", i3)') ScalingType !Get the number of computation nodes and this computation node number - CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(NumberOfComputationNodes,Err) - CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationNodeNumber,Err) + CALL cmfe_ComputationEnvironment_Initialise(ComputationEnvironment,Err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(ComputationEnvironment,NumberOfComputationNodes,Err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationEnvironment,ComputationNodeNumber,Err) NumberOfDomains=NumberOfComputationNodes diff --git a/tests/FiniteElasticity/SimpleShear.f90 b/tests/FiniteElasticity/SimpleShear.f90 index c1825d3a..dbb7159b 100644 --- a/tests/FiniteElasticity/SimpleShear.f90 +++ b/tests/FiniteElasticity/SimpleShear.f90 @@ -115,6 +115,7 @@ PROGRAM SIMPLESHEAREXAMPLE !CMISS variables TYPE(cmfe_BasisType) :: Basis, PressureBasis TYPE(cmfe_BoundaryConditionsType) :: BoundaryConditions + TYPE(cmfe_ComputationEnvironmentType) :: ComputationEnvironment TYPE(cmfe_CoordinateSystemType) :: CoordinateSystem, WorldCoordinateSystem TYPE(cmfe_MeshType) :: Mesh TYPE(cmfe_DecompositionType) :: Decomposition @@ -159,8 +160,9 @@ PROGRAM SIMPLESHEAREXAMPLE CALL cmfe_OutputSetOn("SimpleShear",Err) !Get the number of computation nodes and this computation node number - CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(NumberOfComputationNodes,Err) - CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationNodeNumber,Err) + CALL cmfe_ComputationEnvironment_Initialise(ComputationEnvironment,Err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(ComputationEnvironment,NumberOfComputationNodes,Err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationEnvironment,ComputationNodeNumber,Err) NumberGlobalXElements=2 NumberGlobalYElements=2 diff --git a/tests/LinearElasticity/CantileverBeam.f90 b/tests/LinearElasticity/CantileverBeam.f90 index 002a79fc..c1a2810b 100644 --- a/tests/LinearElasticity/CantileverBeam.f90 +++ b/tests/LinearElasticity/CantileverBeam.f90 @@ -190,6 +190,7 @@ SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_GENERIC(NumberGlobalXElements,NumberGlobal !CMISS variables TYPE(cmfe_BasisType) :: Basis + TYPE(cmfe_ComputationEnvironmentType) :: ComputationEnvironment TYPE(cmfe_CoordinateSystemType) :: CoordinateSystem TYPE(cmfe_GeneratedMeshType) :: GeneratedMesh TYPE(cmfe_DecompositionType) :: Decomposition @@ -233,8 +234,9 @@ SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_GENERIC(NumberGlobalXElements,NumberGlobal FieldDependentNumberOfComponents=NumberOfXi !Get the number of computation nodes and this computation node number - CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(NumberOfComputationNodes,Err) - CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationNodeNumber,Err) + CALL cmfe_ComputationEnvironment_Initialise(ComputationEnvironment,Err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(ComputationEnvironment,NumberOfComputationNodes,Err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationEnvironment,ComputationNodeNumber,Err) !Broadcast the number of elements in the X,Y and Z directions and the number of partitions to the other computation nodes CALL MPI_BCAST(NumberGlobalXElements,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR) diff --git a/tests/LinearElasticity/Extension.f90 b/tests/LinearElasticity/Extension.f90 index 944c7e52..fae01d9d 100644 --- a/tests/LinearElasticity/Extension.f90 +++ b/tests/LinearElasticity/Extension.f90 @@ -242,6 +242,7 @@ SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_GENERIC(NumberGlobalXElements,NumberGlobal !CMISS variables TYPE(cmfe_BasisType) :: Basis + TYPE(cmfe_ComputationEnvironmentType) :: ComputationEnvironment TYPE(cmfe_CoordinateSystemType) :: CoordinateSystem TYPE(cmfe_GeneratedMeshType) :: GeneratedMesh TYPE(cmfe_DecompositionType) :: Decomposition @@ -285,8 +286,9 @@ SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_GENERIC(NumberGlobalXElements,NumberGlobal FieldDependentNumberOfComponents=NumberOfXi !Get the number of computation nodes and this computation node number - CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(NumberOfComputationNodes,Err) - CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationNodeNumber,Err) + CALL cmfe_ComputationEnvironment_Initialise(ComputationEnvironment,Err) + CALL cmfe_ComputationEnvironment_NumberOfWorldNodesGet(ComputationEnvironment,NumberOfComputationNodes,Err) + CALL cmfe_ComputationEnvironment_WorldNodeNumberGet(ComputationEnvironment,ComputationNodeNumber,Err) !Broadcast the number of elements in the X,Y and Z directions and the number of partitions to the other computation nodes CALL MPI_BCAST(NumberGlobalXElements,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR) From cea17d45712ba2a09ac23f52db801c7fd8155458 Mon Sep 17 00:00:00 2001 From: Chris Bradley Date: Thu, 28 Sep 2017 10:14:38 +1300 Subject: [PATCH 5/6] More work group tidy ups. Allow decompositions and problem to have their work group set. --- src/computation_access_routines.f90 | 39 +++- src/computation_routines.f90 | 67 +----- src/field_IO_routines.f90 | 4 +- src/mesh_routines.f90 | 115 +++++++--- src/opencmiss_iron.f90 | 338 ++++++++++++++++++++++++---- src/problem_routines.f90 | 37 +++ src/types.f90 | 3 + 7 files changed, 454 insertions(+), 149 deletions(-) diff --git a/src/computation_access_routines.f90 b/src/computation_access_routines.f90 index edb69536..ebb19bde 100644 --- a/src/computation_access_routines.f90 +++ b/src/computation_access_routines.f90 @@ -45,12 +45,12 @@ MODULE ComputationAccessRoutines USE BaseRoutines + USE ISO_VARYING_STRING USE Kinds #ifndef NOMPIMOD USE MPI #endif USE Strings - USE Types #include "macros.h" @@ -118,7 +118,6 @@ MODULE ComputationAccessRoutines TYPE ComputationEnvironmentType INTEGER(INTG) :: mpiVersion !Finds and returns a pointer to the work group with the given user number. + SUBROUTINE WorkGroup_Get(computationEnvironment,workGroupUserNumber,workGroup,err,error,*) + + !Argument variables + TYPE(ComputationEnvironmentType), POINTER, INTENT(IN) :: computationEnvironment !Gets the group communicator from a work group. SUBROUTINE WorkGroup_GroupCommunicatorGet(workGroup,groupCommunicator,err,error,*) diff --git a/src/computation_routines.f90 b/src/computation_routines.f90 index 18e2390c..6375d292 100755 --- a/src/computation_routines.f90 +++ b/src/computation_routines.f90 @@ -86,8 +86,6 @@ MODULE ComputationRoutines PUBLIC Computation_Initialise,Computation_Finalise - PUBLIC ComputationEnvironment_WorldCommunicatorSet - PUBLIC WorkGroup_CreateFinish,WorkGroup_CreateStart PUBLIC WorkGroup_Destroy @@ -442,7 +440,6 @@ SUBROUTINE ComputationEnvironment_Initialise(computationEnvironment,err,error,*) computationEnvironment%mpiVersion=0 computationEnvironment%mpiSubversion=0 - computationEnvironment%mpiWorldCommunicator=MPI_COMM_NULL computationEnvironment%mpiCommWorld=MPI_COMM_NULL computationEnvironment%mpiGroupWorld=MPI_GROUP_NULL computationEnvironment%numberOfWorldComputationNodes=0 @@ -460,10 +457,10 @@ SUBROUTINE ComputationEnvironment_Initialise(computationEnvironment,err,error,*) CALL MPI_COMM_GROUP(computationEnvironment%mpiCommWorld,computationEnvironment%mpiGroupWorld,mpiIError) CALL MPI_ERROR_CHECK("MPI_COMM_GROUP",mpiIError,err,error,*999) !Set the default MPI world communicator to be the cloned communicator - computationEnvironment%mpiWorldCommunicator=computationEnvironment%mpiCommWorld + computationEnvironment%mpiCommWorld=computationEnvironment%mpiCommWorld !Determine the number of ranks/computation nodes we have in our world computation environment - CALL MPI_COMM_SIZE(computationEnvironment%mpiWorldCommunicator,computationEnvironment%numberOfWorldComputationNodes,mpiIError) + CALL MPI_COMM_SIZE(computationEnvironment%mpiCommWorld,computationEnvironment%numberOfWorldComputationNodes,mpiIError) CALL MPI_ERROR_CHECK("MPI_COMM_SIZE",mpiIError,err,error,*999) !Allocate the computation node data structures @@ -471,7 +468,7 @@ SUBROUTINE ComputationEnvironment_Initialise(computationEnvironment,err,error,*) IF(ERR /=0) CALL FlagError("Could not allocate computation environment computation nodes.",err,error,*999) !Determine my processes rank in the world communicator - CALL MPI_COMM_RANK(computationEnvironment%mpiWorldCommunicator,rank,mpiIError) + CALL MPI_COMM_RANK(computationEnvironment%mpiCommWorld,rank,mpiIError) CALL MPI_ERROR_CHECK("MPI_COMM_RANK",mpiIError,err,error,*999) computationEnvironment%myWorldComputationNodeNumber=rank @@ -489,7 +486,7 @@ SUBROUTINE ComputationEnvironment_Initialise(computationEnvironment,err,error,*) !information. CALL MPI_ALLGATHER(MPI_IN_PLACE,1,computationEnvironment%mpiComputationNode%mpiType, & & computationEnvironment%computationNodes(0),1,computationEnvironment%mpiComputationNode%mpiType, & - & computationEnvironment%mpiWorldCommunicator,mpiIError) + & computationEnvironment%mpiCommWorld,mpiIError) CALL MPI_ERROR_CHECK("MPI_ALLGATHER",mpiIError,err,error,*999) !Setup the world work group. @@ -514,11 +511,11 @@ SUBROUTINE ComputationEnvironment_Initialise(computationEnvironment,err,error,*) CALL MPI_GROUP_INCL(computationEnvironment%mpiGroupWorld,computationEnvironment%worldWorkGroup%numberOfGroupComputationNodes, & & computationEnvironment%worldWorkGroup%worldRanks,computationEnvironment%worldWorkGroup%mpiGroup,mpiIError) CALL MPI_ERROR_CHECK("MPI_GROUP_INCL",mpiIError,err,error,*999) - CALL MPI_COMM_CREATE(computationEnvironment%mpiWorldCommunicator,computationEnvironment%worldWorkGroup%mpiGroup, & + CALL MPI_COMM_CREATE(computationEnvironment%mpiCommWorld,computationEnvironment%worldWorkGroup%mpiGroup, & & computationEnvironment%worldWorkGroup%mpiGroupCommunicator,mpiIError) CALL MPI_ERROR_CHECK("MPI_COMM_CREATE",mpiIError,err,error,*999) !Determine ranks - CALL MPI_COMM_RANK(computationEnvironment%mpiWorldCommunicator,rank,mpiIError) + CALL MPI_COMM_RANK(computationEnvironment%mpiCommWorld,rank,mpiIError) CALL MPI_ERROR_CHECK("MPI_COMM_RANK",mpiIError,err,error,*999) computationEnvironment%worldWorkGroup%myWorldComputationNodeNumber=rank CALL MPI_COMM_RANK(computationEnvironment%worldWorkGroup%mpiGroupCommunicator,rank,mpiIError) @@ -566,52 +563,6 @@ SUBROUTINE ComputationEnvironment_Initialise(computationEnvironment,err,error,*) END SUBROUTINE ComputationEnvironment_Initialise - ! - !================================================================================================================================ - ! - - !>Sets the world communicator to the given on. Note: This routine should be called straight after the main OpenCMISS initialise - !>routine. If it is called after objects have started to be setup then good luck! - SUBROUTINE ComputationEnvironment_WorldCommunicatorSet(worldCommunicator,err,error,*) - - !Argument Variables - INTEGER(INTG), INTENT(IN) :: worldCommunicator !parentWorkGroup DO subGroupIdx=1,parentWorkGroup%numberOfSubGroups - newSubGroups(subGroupIdx)%ptr=parentWorkGroup%subGroups(subGroupIdx)%ptr + newSubGroups(subGroupIdx)%ptr=>parentWorkGroup%subGroups(subGroupIdx)%ptr ENDDO !subGroupIdx newSubGroups(parentWorkGroup%numberOfSubGroups+1)%ptr=>workGroup CALL MOVE_ALLOC(newSubGroups,parentWorkGroup%subGroups) @@ -736,7 +687,7 @@ SUBROUTINE WorkGroup_CreateFinish(workGroup,err,error,*) workGroup%myGroupComputationNodeNumber=-1 ENDIF !Determine my process rank in the world communicator - CALL MPI_COMM_RANK(computationEnvironment%mpiWorldCommunicator,worldRank,mpiIError) + CALL MPI_COMM_RANK(computationEnvironment%mpiCommWorld,worldRank,mpiIError) CALL MPI_ERROR_CHECK("MPI_COMM_RANK",mpiIError,err,error,*999) workGroup%myWorldComputationNodeNumber=worldRank @@ -824,7 +775,7 @@ RECURSIVE SUBROUTINE WorkGroup_DestroyNumber(workGroupUserNumber,err,error,*) count=0 DO subGroupIdx=1,parentWorkGroup%numberOfSubGroups NULLIFY(subGroup) - CALL WorkGroup_WorkSubGroupGet(workGroup,subGroupIdx,subGroup,err,error,*999) + CALL WorkGroup_WorkSubGroupGet(parentWorkGroup,subGroupIdx,subGroup,err,error,*999) IF(subGroup%userNumber/=workGroup%userNumber) THEN count=count+1 newSubGroups(count)%ptr=>parentWorkGroup%subGroups(subGroupIdx)%ptr diff --git a/src/field_IO_routines.f90 b/src/field_IO_routines.f90 index f44468fb..cbdd0d63 100755 --- a/src/field_IO_routines.f90 +++ b/src/field_IO_routines.f90 @@ -1780,7 +1780,7 @@ SUBROUTINE FIELD_IO_IMPORT_GLOBAL_MESH(NAME, REGION, MESH, MESH_USER_NUMBER, MAS !broadcasting the number of components in each field CALL MPI_BCAST(NUMBER_OF_FIELDS,1,MPI_INTEGER,MASTER_COMPUTATION_NUMBER, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_BCAST",MPI_IERROR,ERR,ERROR,*999) IF(MASTER_COMPUTATION_NUMBER/=myWorldComputationNodeNumber) THEN CALL REALLOCATE( COMPONENTS_IN_FIELDS, NUMBER_OF_FIELDS, & @@ -2085,7 +2085,7 @@ SUBROUTINE FIELD_IO_IMPORT_GLOBAL_MESH(NAME, REGION, MESH, MESH_USER_NUMBER, MAS !broadcast the list of elements for mapping gloabl numbers and user numbers (elemental labels) CALL MPI_BCAST(LIST_ELEMENT_NUMBER,NUMBER_OF_ELEMENTS,MPI_INTEGER,MASTER_COMPUTATION_NUMBER, & - & computationEnvironment%mpiWorldCommunicator,MPI_IERROR) + & worldCommunicator,MPI_IERROR) CALL MPI_ERROR_CHECK("MPI_BCAST",MPI_IERROR,ERR,ERROR,*999) !change the mapping between global elemental numbering and user elemental numbering diff --git a/src/mesh_routines.f90 b/src/mesh_routines.f90 index 63c68479..eb1f5324 100644 --- a/src/mesh_routines.f90 +++ b/src/mesh_routines.f90 @@ -154,6 +154,8 @@ MODULE MESH_ROUTINES PUBLIC DECOMPOSITION_NUMBER_OF_DOMAINS_GET,DECOMPOSITION_NUMBER_OF_DOMAINS_SET + PUBLIC Decomposition_WorkGroupSet + PUBLIC DecompositionTopology_DataPointCheckExists PUBLIC DecompositionTopology_DataProjectionCalculate @@ -282,7 +284,7 @@ END SUBROUTINE DECOMPOSITION_ADJACENT_ELEMENT_INITIALISE !================================================================================================================================ ! - !>Finishes the creation of a domain decomposition on a given mesh. \see OPENCMISS::Iron::cmfe_DecompositionCreateFinish + !>Finishes the creation of a domain decomposition on a given mesh. \see OpenCMISS::Iron::cmfe_Decomposition_CreateFinish SUBROUTINE DECOMPOSITION_CREATE_FINISH(DECOMPOSITION,ERR,ERROR,*) !Argument variables @@ -332,13 +334,14 @@ SUBROUTINE DECOMPOSITION_CREATE_FINISH(DECOMPOSITION,ERR,ERROR,*) RETURN 999 ERRORSEXITS("DECOMPOSITION_CREATE_FINISH",ERR,ERROR) RETURN 1 + END SUBROUTINE DECOMPOSITION_CREATE_FINISH ! !================================================================================================================================ ! - !>Starts the creation of a domain decomposition for a given mesh. \see OPENCMISS::Iron::cmfe_DecompositionCreateStart + !>Starts the creation of a domain decomposition for a given mesh. \see OpenCMISS::Iron::cmfe_Decomposition_CreateStart SUBROUTINE DECOMPOSITION_CREATE_START(USER_NUMBER,MESH,DECOMPOSITION,ERR,ERROR,*) !Argument variables @@ -349,9 +352,10 @@ SUBROUTINE DECOMPOSITION_CREATE_START(USER_NUMBER,MESH,DECOMPOSITION,ERR,ERROR,* TYPE(VARYING_STRING), INTENT(OUT) :: ERROR !worldWorkGroup newDecomposition%NUMBER_OF_DOMAINS=1 newDecomposition%numberOfElements=mesh%NUMBER_OF_ELEMENTS ALLOCATE(newDecomposition%ELEMENT_DOMAIN(MESH%NUMBER_OF_ELEMENTS),STAT=ERR) @@ -433,7 +440,7 @@ END SUBROUTINE DECOMPOSITION_CREATE_START !================================================================================================================================ ! - !>Destroys a domain decomposition identified by a user number and deallocates all memory. \see OPENCMISS::Iron::cmfe_DecompositionDestroy + !>Destroys a domain decomposition identified by a user number and deallocates all memory. \see OpenCMISS::Iron::cmfe_Decomposition_Destroy SUBROUTINE DECOMPOSITION_DESTROY_NUMBER(USER_NUMBER,MESH,ERR,ERROR,*) !Argument variables @@ -514,7 +521,7 @@ END SUBROUTINE DECOMPOSITION_DESTROY_NUMBER !================================================================================================================================ ! - !>Destroys a domain decomposition identified by an object and deallocates all memory. \see OPENCMISS::Iron::cmfe_DecompositionDestroy + !>Destroys a domain decomposition identified by an object and deallocates all memory. \see OpenCMISS::Iron::cmfe_Decomposition_Destroy SUBROUTINE DECOMPOSITION_DESTROY(DECOMPOSITION,ERR,ERROR,*) !Argument variables @@ -588,7 +595,7 @@ END SUBROUTINE DECOMPOSITION_DESTROY !================================================================================================================================ ! - !>Calculates the element domains for a decomposition of a mesh. \see OPENCMISS::Iron::cmfe_DecompositionElementDomainCalculate + !>Calculates the element domains for a decomposition of a mesh. \see OpenCMISS::Iron::cmfe_Decomposition_ElementDomainCalculate SUBROUTINE DECOMPOSITION_ELEMENT_DOMAIN_CALCULATE(DECOMPOSITION,ERR,ERROR,*) !Argument variables @@ -818,7 +825,7 @@ END SUBROUTINE DECOMPOSITION_ELEMENT_DOMAIN_CALCULATE !================================================================================================================================ ! - !>Gets the domain for a given element in a decomposition of a mesh. \todo should be able to specify lists of elements. \see OPENCMISS::Iron::cmfe_DecompositionElementDomainGet + !>Gets the domain for a given element in a decomposition of a mesh. \todo should be able to specify lists of elements. \see OpenCMISS::Iron::cmfe_Decomposition_ElementDomainGet SUBROUTINE DECOMPOSITION_ELEMENT_DOMAIN_GET(DECOMPOSITION,USER_ELEMENT_NUMBER,DOMAIN_NUMBER,ERR,ERROR,*) !Argument variables @@ -890,7 +897,7 @@ END SUBROUTINE DECOMPOSITION_ELEMENT_DOMAIN_GET !================================================================================================================================ ! - !>Sets the domain for a given element in a decomposition of a mesh. \todo move to user number, should be able to specify lists of elements. \see OPENCMISS::Iron::cmfe_DecompositionElementDomainSet + !>Sets the domain for a given element in a decomposition of a mesh. \todo move to user number, should be able to specify lists of elements. \see OpenCMISS::Iron::cmfe_Decomposition_ElementDomainSet SUBROUTINE DECOMPOSITION_ELEMENT_DOMAIN_SET(DECOMPOSITION,GLOBAL_ELEMENT_NUMBER,DOMAIN_NUMBER,ERR,ERROR,*) !Argument variables @@ -1013,6 +1020,7 @@ SUBROUTINE Decomposition_Initialise(decomposition,err,error,*) decomposition%numberOfDimensions=0 decomposition%numberOfComponents=0 decomposition%DECOMPOSITION_TYPE=DECOMPOSITION_ALL_TYPE + NULLIFY(decomposition%workGroup) decomposition%NUMBER_OF_DOMAINS=0 decomposition%NUMBER_OF_EDGES_CUT=0 decomposition%numberOfElements=0 @@ -1036,7 +1044,7 @@ END SUBROUTINE Decomposition_Initialise !!MERGE: ditto - !>Gets the mesh component number which will be used for the decomposition of a mesh. \see OPENCMISS::Iron::cmfe_DecompositionMeshComponentGet + !>Gets the mesh component number which will be used for the decomposition of a mesh. \see OpenCMISS::Iron::cmfe_DecompositionMeshComponentGet SUBROUTINE DECOMPOSITION_MESH_COMPONENT_NUMBER_GET(DECOMPOSITION,MESH_COMPONENT_NUMBER,ERR,ERROR,*) !Argument variables @@ -1073,7 +1081,7 @@ END SUBROUTINE DECOMPOSITION_MESH_COMPONENT_NUMBER_GET !================================================================================================================================ ! - !>Sets/changes the mesh component number which will be used for the decomposition of a mesh. \see OPENCMISS::Iron::cmfe_DecompositionMeshComponentSet + !>Sets/changes the mesh component number which will be used for the decomposition of a mesh. \see OpenCMISS::Iron::cmfe_DecompositionMeshComponentSet SUBROUTINE DECOMPOSITION_MESH_COMPONENT_NUMBER_SET(DECOMPOSITION,MESH_COMPONENT_NUMBER,ERR,ERROR,*) !Argument variables @@ -1119,7 +1127,7 @@ END SUBROUTINE DECOMPOSITION_MESH_COMPONENT_NUMBER_SET !!MERGE: ditto - !>Gets the number of domains for a decomposition. \see OPENCMISS::Iron::cmfe_DecompositionNumberOfDomainsGet + !>Gets the number of domains for a decomposition. \see OpenCMISS::Iron::cmfe_DecompositionNumberOfDomainsGet SUBROUTINE DECOMPOSITION_NUMBER_OF_DOMAINS_GET(DECOMPOSITION,NUMBER_OF_DOMAINS,ERR,ERROR,*) !Argument variables @@ -1152,7 +1160,7 @@ END SUBROUTINE DECOMPOSITION_NUMBER_OF_DOMAINS_GET !================================================================================================================================ ! - !>Sets/changes the number of domains for a decomposition. \see OPENCMISS::Iron::cmfe_DecompositionNumberOfDomainsSet + !>Sets/changes the number of domains for a decomposition. \see OpenCMISS::Iron::cmfe_DecompositionNumberOfDomainsSet SUBROUTINE DECOMPOSITION_NUMBER_OF_DOMAINS_SET(DECOMPOSITION,NUMBER_OF_DOMAINS,ERR,ERROR,*) !Argument variables @@ -1222,6 +1230,38 @@ END SUBROUTINE DECOMPOSITION_NUMBER_OF_DOMAINS_SET !================================================================================================================================ ! + !>Sets the workgroup to use for a decomposition on a given mesh. \see OpenCMISS::Iron::cmfe_Decomposition_WorkGroupSet + SUBROUTINE Decomposition_WorkGroupSet(decomposition,workGroup,err,error,*) + + !Argument variables + TYPE(DECOMPOSITION_TYPE), POINTER :: decomposition !workGroup + + EXITS("Decomposition_WorkGroupSet") + RETURN +999 ERRORSEXITS("Decomposition_WorkGroupSet",err,error) + RETURN 1 + + END SUBROUTINE Decomposition_WorkGroupSet + + ! + !================================================================================================================================ + ! + !>Calculates the topology for a decomposition. SUBROUTINE DECOMPOSITION_TOPOLOGY_CALCULATE(DECOMPOSITION,ERR,ERROR,*) @@ -3676,7 +3716,7 @@ END SUBROUTINE DECOMPOSITION_TOPOLOGY_FACES_INITIALISE !================================================================================================================================ ! - !>Gets the decomposition type for a decomposition. \see OPENCMISS::Iron::cmfe_DecompositionTypeGet + !>Gets the decomposition type for a decomposition. \see OpenCMISS::Iron::cmfe_DecompositionTypeGet SUBROUTINE DECOMPOSITION_TYPE_GET(DECOMPOSITION,TYPE,ERR,ERROR,*) !Argument variables @@ -3708,7 +3748,7 @@ END SUBROUTINE DECOMPOSITION_TYPE_GET !================================================================================================================================ ! - !>Sets/changes the decomposition type for a decomposition. \see OPENCMISS::Iron::cmfe_DecompositionTypeSet + !>Sets/changes the decomposition type for a decomposition. \see OpenCMISS::Iron::cmfe_DecompositionTypeSet SUBROUTINE DECOMPOSITION_TYPE_SET(DECOMPOSITION,TYPE,ERR,ERROR,*) !Argument variables @@ -3752,7 +3792,7 @@ END SUBROUTINE DECOMPOSITION_TYPE_SET !================================================================================================================================ ! - !>Sets/changes whether lines should be calculated in the the decomposition. \see OPENCMISS::Iron::cmfe_DecompositionCalculateLinesSet + !>Sets/changes whether lines should be calculated in the the decomposition. \see OpenCMISS::Iron::cmfe_DecompositionCalculateLinesSet SUBROUTINE DECOMPOSITION_CALCULATE_LINES_SET(DECOMPOSITION,CALCULATE_LINES_FLAG,ERR,ERROR,*) !Argument variables @@ -3783,7 +3823,7 @@ END SUBROUTINE DECOMPOSITION_CALCULATE_LINES_SET !================================================================================================================================ ! - !>Sets/changes whether faces should be calculated in the the decomposition. \see OPENCMISS::Iron::cmfe_DecompositionCalculateFacesSet + !>Sets/changes whether faces should be calculated in the the decomposition. \see OpenCMISS::Iron::cmfe_DecompositionCalculateFacesSet SUBROUTINE DECOMPOSITION_CALCULATE_FACES_SET(DECOMPOSITION,CALCULATE_FACES_FLAG,ERR,ERROR,*) !Argument variables @@ -6163,7 +6203,7 @@ END SUBROUTINE MESH_ADJACENT_ELEMENT_INITIALISE !================================================================================================================================ ! - !>Finishes the process of creating a mesh. \see OPENCMISS::Iron::cmfe_MeshCreateFinish + !>Finishes the process of creating a mesh. \see OpenCMISS::Iron::cmfe_MeshCreateFinish SUBROUTINE MESH_CREATE_FINISH(MESH,ERR,ERROR,*) !Argument variables @@ -6292,7 +6332,7 @@ END SUBROUTINE MESH_CREATE_START_GENERIC !================================================================================================================================ ! - !>Starts the process of creating a mesh defined by a user number with the specified NUMBER_OF_DIMENSIONS in an interface. \see OPENCMISS::Iron::cmfe_MeshCreateStart + !>Starts the process of creating a mesh defined by a user number with the specified NUMBER_OF_DIMENSIONS in an interface. \see OpenCMISS::Iron::cmfe_MeshCreateStart !>Default values set for the MESH's attributes are: !>- NUMBER_OF_COMPONENTS: 1 SUBROUTINE MESH_CREATE_START_INTERFACE(USER_NUMBER,INTERFACE,NUMBER_OF_DIMENSIONS,MESH,ERR,ERROR,*) @@ -6371,7 +6411,7 @@ END SUBROUTINE MESH_CREATE_START_INTERFACE !================================================================================================================================ ! - !>Starts the process of creating a mesh defined by a user number with the specified NUMBER_OF_DIMENSIONS in the region identified by REGION. \see OPENCMISS::Iron::cmfe_MeshCreateStart + !>Starts the process of creating a mesh defined by a user number with the specified NUMBER_OF_DIMENSIONS in the region identified by REGION. \see OpenCMISS::Iron::cmfe_MeshCreateStart !>Default values set for the MESH's attributes are: !>- NUMBER_OF_COMPONENTS: 1 SUBROUTINE MESH_CREATE_START_REGION(USER_NUMBER,REGION,NUMBER_OF_DIMENSIONS,MESH,ERR,ERROR,*) @@ -6441,7 +6481,7 @@ END SUBROUTINE MESH_CREATE_START_REGION !================================================================================================================================ ! - !>Destroys the mesh identified by a user number on the given region and deallocates all memory. \see OPENCMISS::Iron::cmfe_MeshDestroy + !>Destroys the mesh identified by a user number on the given region and deallocates all memory. \see OpenCMISS::Iron::cmfe_MeshDestroy SUBROUTINE MESH_DESTROY_NUMBER(USER_NUMBER,REGION,ERR,ERROR,*) !Argument variables @@ -6524,7 +6564,7 @@ END SUBROUTINE MESH_DESTROY_NUMBER !================================================================================================================================ ! - !>Destroys the mesh and deallocates all memory. \see OPENCMISS::Iron::cmfe_MeshDestroy + !>Destroys the mesh and deallocates all memory. \see OpenCMISS::Iron::cmfe_MeshDestroy SUBROUTINE MESH_DESTROY(MESH,ERR,ERROR,*) !Argument variables @@ -6716,7 +6756,7 @@ END SUBROUTINE MESH_INITIALISE !================================================================================================================================ ! - !>Gets the number of mesh components for a mesh identified by a pointer. \see OPENCMISS::Iron::cmfe_MeshNumberOfComponentsGet + !>Gets the number of mesh components for a mesh identified by a pointer. \see OpenCMISS::Iron::cmfe_MeshNumberOfComponentsGet SUBROUTINE MESH_NUMBER_OF_COMPONENTS_GET(MESH,NUMBER_OF_COMPONENTS,ERR,ERROR,*) !Argument variables @@ -6748,7 +6788,7 @@ END SUBROUTINE MESH_NUMBER_OF_COMPONENTS_GET !================================================================================================================================ ! - !>Changes/sets the number of mesh components for a mesh. \see OPENCMISS::Iron::cmfe_MeshNumberOfComponentsSet + !>Changes/sets the number of mesh components for a mesh. \see OpenCMISS::Iron::cmfe_MeshNumberOfComponentsSet SUBROUTINE MESH_NUMBER_OF_COMPONENTS_SET(MESH,NUMBER_OF_COMPONENTS,ERR,ERROR,*) !Argument variables @@ -6824,7 +6864,7 @@ END SUBROUTINE MESH_NUMBER_OF_COMPONENTS_SET !================================================================================================================================ ! - !>Gets the number of elements for a mesh identified by a pointer. \see OPENCMISS::Iron::cmfe_MeshNumberOfElementsGet + !>Gets the number of elements for a mesh identified by a pointer. \see OpenCMISS::Iron::cmfe_MeshNumberOfElementsGet SUBROUTINE MESH_NUMBER_OF_ELEMENTS_GET(MESH,NUMBER_OF_ELEMENTS,ERR,ERROR,*) !Argument variables @@ -6856,7 +6896,7 @@ END SUBROUTINE MESH_NUMBER_OF_ELEMENTS_GET !================================================================================================================================ ! - !>Changes/sets the number of elements for a mesh. \see OPENCMISS::Iron::cmfe_MeshNumberOfElementsSet + !>Changes/sets the number of elements for a mesh. \see OpenCMISS::Iron::cmfe_MeshNumberOfElementsSet SUBROUTINE MESH_NUMBER_OF_ELEMENTS_SET(MESH,NUMBER_OF_ELEMENTS,ERR,ERROR,*) !Argument variables @@ -6915,7 +6955,7 @@ END SUBROUTINE MESH_NUMBER_OF_ELEMENTS_SET !================================================================================================================================ ! - !>Changes/sets the surrounding elements calculate flag. \see OPENCMISS::Iron::cmfe_MeshSurroundingElementsCalculateSet + !>Changes/sets the surrounding elements calculate flag. \see OpenCMISS::Iron::cmfe_MeshSurroundingElementsCalculateSet SUBROUTINE MESH_SURROUNDING_ELEMENTS_CALCULATE_SET(MESH,SURROUNDING_ELEMENTS_CALCULATE_FLAG,ERR,ERROR,*) !Argument variables @@ -7215,7 +7255,7 @@ END SUBROUTINE MeshTopology_DofsInitialise !================================================================================================================================ ! - !>Finishes the process of creating elements for a specified mesh component in a mesh topology. \see OPENCMISS::Iron::cmfe_MeshElementsCreateFinish + !>Finishes the process of creating elements for a specified mesh component in a mesh topology. \see OpenCMISS::Iron::cmfe_MeshElementsCreateFinish SUBROUTINE MESH_TOPOLOGY_ELEMENTS_CREATE_FINISH(ELEMENTS,ERR,ERROR,*) !Argument variables @@ -7292,7 +7332,7 @@ END SUBROUTINE MESH_TOPOLOGY_ELEMENTS_CREATE_FINISH !================================================================================================================================ ! - !>Starts the process of creating elements in the mesh component identified by MESH and component_idx. The elements will be created with a default basis of BASIS. ELEMENTS is the returned pointer to the MESH_ELEMENTS data structure. \see OPENCMISS::Iron::cmfe_MeshElementsCreateStart + !>Starts the process of creating elements in the mesh component identified by MESH and component_idx. The elements will be created with a default basis of BASIS. ELEMENTS is the returned pointer to the MESH_ELEMENTS data structure. \see OpenCMISS::Iron::cmfe_MeshElementsCreateStart SUBROUTINE MESH_TOPOLOGY_ELEMENTS_CREATE_START(MESH,MESH_COMPONENT_NUMBER,BASIS,ELEMENTS,ERR,ERROR,*) !Argument variables @@ -7468,7 +7508,7 @@ END SUBROUTINE MESH_TOPOLOGY_ELEMENT_INITIALISE !!MERGE: Take user number - !>Gets the basis for a mesh element identified by a given global number. \todo should take user number \see OPENCMISS::Iron::cmfe_MeshElementsBasisGet + !>Gets the basis for a mesh element identified by a given global number. \todo should take user number \see OpenCMISS::Iron::cmfe_MeshElementsBasisGet SUBROUTINE MESH_TOPOLOGY_ELEMENTS_ELEMENT_BASIS_GET(GLOBAL_NUMBER,ELEMENTS,BASIS,ERR,ERROR,*) !Argument variables @@ -7589,7 +7629,7 @@ END SUBROUTINE MESH_TOPOLOGY_ELEMENTS_ELEMENT_BASIS_SET !================================================================================================================================ ! - !>Returns the adjacent element number for a mesh element identified by a global number. \todo specify by user number not global number \see OPENCMISS::Iron::cmfe_MeshElementsNo + !>Returns the adjacent element number for a mesh element identified by a global number. \todo specify by user number not global number \see OpenCMISS::Iron::cmfe_MeshElementsNo SUBROUTINE MESH_TOPOLOGY_ELEMENTS_ADJACENT_ELEMENT_GET(GLOBAL_NUMBER,ELEMENTS,ADJACENT_ELEMENT_XI,ADJACENT_ELEMENT_NUMBER, & & ERR,ERROR,*) @@ -7645,7 +7685,7 @@ END SUBROUTINE MESH_TOPOLOGY_ELEMENTS_ADJACENT_ELEMENT_GET !================================================================================================================================ ! - !>Gets the element nodes for a mesh element identified by a given global number. \todo specify by user number not global number \see OPENCMISS::Iron::cmfe_MeshElementsNodesGet + !>Gets the element nodes for a mesh element identified by a given global number. \todo specify by user number not global number \see OpenCMISS::Iron::cmfe_MeshElementsNodesGet SUBROUTINE MESH_TOPOLOGY_ELEMENTS_ELEMENT_NODES_GET(GLOBAL_NUMBER,ELEMENTS,USER_ELEMENT_NODES,ERR,ERROR,*) !Argument variables @@ -7693,7 +7733,7 @@ END SUBROUTINE MESH_TOPOLOGY_ELEMENTS_ELEMENT_NODES_GET !================================================================================================================================ ! - !>Changes/sets the element nodes for a mesh element identified by a given global number. \todo specify by user number not global number \see OPENCMISS::Iron::cmfe_MeshElementsNodesSet + !>Changes/sets the element nodes for a mesh element identified by a given global number. \todo specify by user number not global number \see OpenCMISS::Iron::cmfe_MeshElementsNodesSet SUBROUTINE MESH_TOPOLOGY_ELEMENTS_ELEMENT_NODES_SET(GLOBAL_NUMBER,ELEMENTS,USER_ELEMENT_NODES,ERR,ERROR,*) !Argument variables @@ -7824,7 +7864,7 @@ END SUBROUTINE MESH_TOPOLOGY_ELEMENTS_ELEMENT_NODES_SET !================================================================================================================================ ! - !>Changes/sets an element node's version for a mesh element identified by a given global number. \todo specify by user number not global number \see OPENCMISS::Iron::cmfe_MeshElementsNodesSet + !>Changes/sets an element node's version for a mesh element identified by a given global number. \todo specify by user number not global number \see OpenCMISS::Iron::cmfe_MeshElementsNodesSet SUBROUTINE MeshElements_ElementNodeVersionSet(GLOBAL_NUMBER,ELEMENTS,VERSION_NUMBER,DERIVATIVE_NUMBER, & & USER_ELEMENT_NODE_INDEX,ERR,ERROR,*) @@ -8307,7 +8347,7 @@ END SUBROUTINE MESH_TOPOLOGY_DATA_POINTS_INITIALISE !!MERGE: ditto. - !>Gets the user number for a global element identified by a given global number. \todo Check that the user number doesn't already exist. \see OPENCMISS::Iron::cmfe_MeshElementsUserNumberGet + !>Gets the user number for a global element identified by a given global number. \todo Check that the user number doesn't already exist. \see OpenCMISS::Iron::cmfe_MeshElementsUserNumberGet SUBROUTINE MESH_TOPOLOGY_ELEMENTS_NUMBER_GET(GLOBAL_NUMBER,USER_NUMBER,ELEMENTS,ERR,ERROR,*) !Argument variables @@ -8348,7 +8388,7 @@ END SUBROUTINE MESH_TOPOLOGY_ELEMENTS_NUMBER_GET !================================================================================================================================ ! - !>Returns the user number for a global element identified by a given global number. \see OPENCMISS::Iron::cmfe_MeshElementsUserNumberGet + !>Returns the user number for a global element identified by a given global number. \see OpenCMISS::Iron::cmfe_MeshElementsUserNumberGet SUBROUTINE MeshElements_ElementUserNumberGet(GLOBAL_NUMBER,USER_NUMBER,ELEMENTS,ERR,ERROR,*) !Argument variables @@ -8390,7 +8430,7 @@ END SUBROUTINE MeshElements_ElementUserNumberGet !================================================================================================================================ ! - !>Changes/sets the user number for a global element identified by a given global number. \see OPENCMISS::Iron::cmfe_MeshElementsUserNumberSet + !>Changes/sets the user number for a global element identified by a given global number. \see OpenCMISS::Iron::cmfe_MeshElementsUserNumberSet SUBROUTINE MeshElements_ElementUserNumberSet(GLOBAL_NUMBER,USER_NUMBER,ELEMENTS,ERR,ERROR,*) !Argument variables @@ -10108,7 +10148,7 @@ END SUBROUTINE MESHES_INITIALISE_REGION !================================================================================================================================ ! - !>Gets the domain for a given node in a decomposition of a mesh. \todo should be able to specify lists of elements. \see OPENCMISS::Iron::cmfe_DecompositionNodeDomainGet + !>Gets the domain for a given node in a decomposition of a mesh. \todo should be able to specify lists of elements. \see OpenCMISS::Iron::cmfe_Decomposition_NodeDomainGet SUBROUTINE DECOMPOSITION_NODE_DOMAIN_GET(DECOMPOSITION,USER_NODE_NUMBER,MESH_COMPONENT_NUMBER,DOMAIN_NUMBER,ERR,ERROR,*) !Argument variables @@ -10347,3 +10387,4 @@ END SUBROUTINE MESH_EMBEDDING_SET_GAUSS_POINT_DATA END MODULE MESH_ROUTINES + diff --git a/src/opencmiss_iron.f90 b/src/opencmiss_iron.f90 index a949b8c0..1fec8835 100644 --- a/src/opencmiss_iron.f90 +++ b/src/opencmiss_iron.f90 @@ -1274,6 +1274,24 @@ MODULE OpenCMISS_Iron !Interfaces + !>Starts the creation of a work group + INTERFACE cmfe_WorkGroup_CreateStart + MODULE PROCEDURE cmfe_WorkGroup_CreateStartNumber + MODULE PROCEDURE cmfe_WorkGroup_CreateStartObj + END INTERFACE cmfe_WorkGroup_CreateStart + + !>Finishes the creation of a work group + INTERFACE cmfe_WorkGroup_CreateFinish + MODULE PROCEDURE cmfe_WorkGroup_CreateFinishNumber + MODULE PROCEDURE cmfe_WorkGroup_CreateFinishObj + END INTERFACE cmfe_WorkGroup_CreateFinish + + !>Destroys a work group + INTERFACE cmfe_WorkGroup_Destroy + MODULE PROCEDURE cmfe_WorkGroup_DestroyNumber + MODULE PROCEDURE cmfe_WorkGroup_DestroyObj + END INTERFACE cmfe_WorkGroup_Destroy + !>Gets the group communicator for a work group INTERFACE cmfe_WorkGroup_GroupCommunicatorGet MODULE PROCEDURE cmfe_WorkGroup_GroupCommunicatorGetNumber @@ -1326,6 +1344,8 @@ MODULE OpenCMISS_Iron PUBLIC cmfe_WorkGroup_CreateFinish + PUBLIC cmfe_WorkGroup_Destroy + PUBLIC cmfe_WorkGroup_GroupCommunicatorGet PUBLIC cmfe_WorkGroup_GroupNodeNumberGet @@ -1333,8 +1353,6 @@ MODULE OpenCMISS_Iron PUBLIC cmfe_WorkGroup_LabelGet,cmfe_WorkGroup_LabelSet PUBLIC cmfe_WorkGroup_NumberOfGroupNodesGet,cmfe_WorkGroup_NumberOfGroupNodesSet - - PUBLIC cmfe_Decomposition_WorldWorkGroupSet !!================================================================================================================================== !! @@ -5301,6 +5319,12 @@ MODULE OpenCMISS_Iron MODULE PROCEDURE cmfe_Decomposition_TypeSetObj END INTERFACE cmfe_Decomposition_TypeSet + !>Sets/changes the work group for a decomposition. + INTERFACE cmfe_Decomposition_WorkGroupSet + MODULE PROCEDURE cmfe_Decomposition_WorkGroupSetNumber + MODULE PROCEDURE cmfe_Decomposition_WorkGroupSetObj + END INTERFACE cmfe_Decomposition_WorkGroupSet + !>Sets/changes whether lines should be calculated for the decomposition. INTERFACE cmfe_Decomposition_CalculateLinesSet MODULE PROCEDURE cmfe_Decomposition_CalculateLinesSetNumber @@ -5553,6 +5577,8 @@ MODULE OpenCMISS_Iron PUBLIC cmfe_Decomposition_TypeGet,cmfe_Decomposition_TypeSet + PUBLIC cmfe_Decomposition_WorkGroupSet + PUBLIC cmfe_Decomposition_NodeDomainGet PUBLIC cmfe_Mesh_CreateFinish,cmfe_Mesh_CreateStart @@ -6308,6 +6334,12 @@ MODULE OpenCMISS_Iron MODULE PROCEDURE cmfe_Problem_SpecificationSizeGetObj END INTERFACE cmfe_Problem_SpecificationSizeGet + !>Sets/changes the work group for a problem. + INTERFACE cmfe_Problem_WorkGroupSet + MODULE PROCEDURE cmfe_Problem_WorkGroupSetNumber + MODULE PROCEDURE cmfe_Problem_WorkGroupSetObj + END INTERFACE cmfe_Problem_WorkGroupSet + PUBLIC cmfe_Problem_CellMLEquationsCreateFinish,cmfe_Problem_CellMLEquationsCreateStart PUBLIC cmfe_Problem_CellMLEquationsGet @@ -6340,6 +6372,8 @@ MODULE OpenCMISS_Iron PUBLIC cmfe_Problem_SpecificationGet,cmfe_Problem_SpecificationSizeGet + PUBLIC cmfe_Problem_WorkGroupSet + !!================================================================================================================================== !! !! REGION_ROUTINES @@ -15952,53 +15986,159 @@ SUBROUTINE cmfe_ComputationEnvironment_WorldWorkGroupGet(computationEnvironment, END SUBROUTINE cmfe_ComputationEnvironment_WorldWorkGroupGet + ! + !================================================================================================================================ + ! + + !>Start the creation of a computation work group specified by number. + SUBROUTINE cmfe_WorkGroup_CreateStartNumber(workGroupUserNumber,parentWorkGroupUserNumber,err) + !DLLEXPORT(cmfe_WorkGroup_CreateStartNumber) + !Argument Variables + INTEGER(INTG), INTENT(IN) :: workGroupUserNumber !Start the creation of a computation work group under a parent work group - SUBROUTINE cmfe_WorkGroup_CreateStart(userNumber,parentWorkGroup,workGroup,err) - !DLLEXPORT(cmfe_WorkGroup_CreateStart) + !>Start the creation of a computation work group specified by object under a parent work group + SUBROUTINE cmfe_WorkGroup_CreateStartObj(userNumber,parentWorkGroup,workGroup,err) + !DLLEXPORT(cmfe_WorkGroup_CreateStartObj) !Argument Variables INTEGER(INTG), INTENT(IN) :: userNumber !Finish the creation of a computation work group - SUBROUTINE cmfe_WorkGroup_CreateFinish(workGroup,err) - !DLLEXPORT(cmfe_WorkGroup_CreateFinish) + !>Finish the creation of a computation work group specified by number. + SUBROUTINE cmfe_WorkGroup_CreateFinishNumber(workGroupUserNumber,err) + !DLLEXPORT(cmfe_WorkGroup_CreateFinishNumber) + !Argument Variables + INTEGER(INTG), INTENT(IN) :: workGroupUserNumber !Finish the creation of a computation work group specified by object. + SUBROUTINE cmfe_WorkGroup_CreateFinishObj(workGroup,err) + !DLLEXPORT(cmfe_WorkGroup_CreateFinishObj) !Argument Variables TYPE(cmfe_WorkGroupType), INTENT(INOUT) :: workGroup !Destroy a work group specified by number. + SUBROUTINE cmfe_WorkGroup_DestroyNumber(workGroupUserNumber,err) + !DLLEXPORT(cmfe_WorkGroup_DestroyNumber) + !Argument Variables + INTEGER(INTG), INTENT(IN) :: workGroupUserNumber !Destroy a work group specified by object. + SUBROUTINE cmfe_WorkGroup_DestroyObj(workGroup,err) + !DLLEXPORT(cmfe_WorkGroup_DestroyObj) + !Argument Variables + TYPE(cmfe_WorkGroupType), INTENT(INOUT) :: workGroup !Set the decomposition work group - SUBROUTINE cmfe_Decomposition_WorldWorkGroupSet(decomposition,workGroup,err) - !DLLEXPORT(cmfe_Decomposition_WorldWorkGroupSet) - !Argument Variables - TYPE(cmfe_DecompositionType), INTENT(INOUT) :: decomposition !Sets/changes the work group of a decomposition identified by a user number. + SUBROUTINE cmfe_Decomposition_WorkGroupSetNumber(regionUserNumber,meshUserNumber,decompositionUserNumber,workGroupUserNumber,err) + !DLLEXPORT(cmfe_Decomposition_WorkGroupSetNumber) + + !Argument variables + INTEGER(INTG), INTENT(IN) :: regionUserNumber !Sets/changes the work group for a decomposition identified by an object. + SUBROUTINE cmfe_Decomposition_WorkGroupSetObj(decomposition,workGroup,err) + !DLLEXPORT(cmfe_Decomposition_WorkGroupSetObj) + + !Argument variables + TYPE(cmfe_DecompositionType), INTENT(IN) :: decomposition !Sets whether lines should be calculated SUBROUTINE cmfe_Decomposition_CalculateLinesSetNumber(regionUserNumber,meshUserNumber,& & decompositionUserNumber,calculateLinesFlag,err) @@ -48670,6 +48851,65 @@ SUBROUTINE cmfe_Problem_SpecificationSizeGetObj(problem,specificationSize,err) RETURN END SUBROUTINE cmfe_Problem_SpecificationSizeGetObj + + ! + !================================================================================================================================ + ! + + !>Sets/changes the work group of a problem identified by a user number. + SUBROUTINE cmfe_Problem_WorkGroupSetNumber(problemUserNumber,workGroupUserNumber,err) + !DLLEXPORT(cmfe_Problem_WorkGroupSetNumber) + + !Argument variables + INTEGER(INTG), INTENT(IN) :: problemUserNumber !Sets/changes the work group for a problem identified by an object. + SUBROUTINE cmfe_Problem_WorkGroupSetObj(problem,workGroup,err) + !DLLEXPORT(cmfe_Problem_WorkGroupSetObj) + + !Argument variables + TYPE(cmfe_ProblemType), INTENT(INOUT) :: problem !PROBLEMS + NULLIFY(worldWorkGroup) + CALL ComputationEnvironment_WorldWorkGroupGet(computationEnvironment,worldWorkGroup,err,error,*999) + NEW_PROBLEM%workGroup=>worldWorkGroup !Set problem specification CALL Problem_SpecificationSet(NEW_PROBLEM,PROBLEM_SPECIFICATION,err,error,*999) !For compatibility with old code, set class, type and subtype @@ -923,6 +929,7 @@ SUBROUTINE PROBLEM_INITIALISE(PROBLEM,err,error,*) PROBLEM%GLOBAL_NUMBER=0 PROBLEM%PROBLEM_FINISHED=.FALSE. NULLIFY(PROBLEM%PROBLEMS) + NULLIFY(problem%workGroup) NULLIFY(PROBLEM%CONTROL_LOOP) ELSE CALL FlagError("Problem is not associated.",err,error,*999) @@ -3777,6 +3784,36 @@ END SUBROUTINE Problem_SpecificationSizeGet !================================================================================================================================ ! + !>Sets the work group for a problem. \see OpenCMISS::cmfe_Problem_WorkGroupGet + SUBROUTINE Problem_WorkGroupSet(problem,workGroup,err,error,*) + + !Argument variables + TYPE(PROBLEM_TYPE), POINTER, INTENT(INOUT) :: problem !workGroup + + EXITS("Problem_WorkGroupSet") + RETURN +999 ERRORSEXITS("Problem_WorkGroupSet",err,error) + RETURN 1 + + END SUBROUTINE Problem_WorkGroupSet + + ! + !================================================================================================================================ + ! + !>Finalises all problems and deallocates all memory. SUBROUTINE PROBLEMS_FINALISE(err,error,*) diff --git a/src/types.f90 b/src/types.f90 index 1f9b0398..0cabfd4a 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -71,6 +71,7 @@ MODULE Types USE CmissPetscTypes, ONLY : PetscISColoringType,PetscKspType,PetscMatType,PetscMatColoringType,PetscMatFDColoringType, & & PetscPCType,PetscSnesType,PetscSnesLineSearchType,PetscTaoType,PetscVecType + USE ComputationAccessRoutines USE Constants USE Kinds USE ISO_C_BINDING @@ -1122,6 +1123,7 @@ MODULE Types INTEGER(INTG) :: numberOfComponents ! Date: Wed, 11 Apr 2018 12:49:55 +1200 Subject: [PATCH 6/6] Tidy up --- doc/latex/Latex_Makefile | 293 - doc/latex/Latex_make.sh | 77 - doc/latex/Makefigs | 48 - doc/latex/Makeplots | 76 - doc/latex/Makesvgs | 57 - doc/latex/abbreviations.tex | 156 - doc/latex/abconference.tex | 24 - doc/latex/defns.tex | 36 - doc/latex/genfigs.sh | 15 - doc/latex/genfigs1.sh | 12 - doc/latex/genpstex.sh | 17 - doc/latex/genpstex1.sh | 16 - doc/latex/macros.tex | 814 -- doc/latex/references.tex | 12 - doc/latex/shell.tex | 21 - doc/latex/shell_article.tex | 23 - doc/latex/shell_book.tex | 29 - doc/latex/shell_letter.tex | 30 - doc/latex/shell_report.tex | 34 - .../ElasticityClass/FiniteElasticity.tex | 878 -- doc/notes/Latex_make.sh | 105 - doc/notes/OpenCMISSNotes.tex | 56 - doc/notes/Theory/Theory.tex | 2054 ----- doc/notes/TitlePage/TitlePage.tex | 32 - doc/notes/svgs/Theory/cubichermiteelem.svg | 397 - src/#1657# | 0 src/Burgers_equation_routines.f90.fsicpb | 2576 ------ src/Darcy_equations_routines.f90.fsicpb | 8009 ----------------- src/Stokes_equations_routines.f90.fsicpb | 4170 --------- src/developerslines.txt | 137 - 30 files changed, 20204 deletions(-) delete mode 100755 doc/latex/Latex_Makefile delete mode 100755 doc/latex/Latex_make.sh delete mode 100755 doc/latex/Makefigs delete mode 100755 doc/latex/Makeplots delete mode 100755 doc/latex/Makesvgs delete mode 100755 doc/latex/abbreviations.tex delete mode 100755 doc/latex/abconference.tex delete mode 100755 doc/latex/defns.tex delete mode 100755 doc/latex/genfigs.sh delete mode 100755 doc/latex/genfigs1.sh delete mode 100755 doc/latex/genpstex.sh delete mode 100755 doc/latex/genpstex1.sh delete mode 100755 doc/latex/macros.tex delete mode 100755 doc/latex/references.tex delete mode 100755 doc/latex/shell.tex delete mode 100755 doc/latex/shell_article.tex delete mode 100755 doc/latex/shell_book.tex delete mode 100755 doc/latex/shell_letter.tex delete mode 100755 doc/latex/shell_report.tex delete mode 100755 doc/notes/EquationSets/ElasticityClass/FiniteElasticity.tex delete mode 100755 doc/notes/Latex_make.sh delete mode 100755 doc/notes/OpenCMISSNotes.tex delete mode 100755 doc/notes/Theory/Theory.tex delete mode 100755 doc/notes/TitlePage/TitlePage.tex delete mode 100755 doc/notes/svgs/Theory/cubichermiteelem.svg delete mode 100644 src/#1657# delete mode 100644 src/Burgers_equation_routines.f90.fsicpb delete mode 100644 src/Darcy_equations_routines.f90.fsicpb delete mode 100644 src/Stokes_equations_routines.f90.fsicpb delete mode 100644 src/developerslines.txt diff --git a/doc/latex/Latex_Makefile b/doc/latex/Latex_Makefile deleted file mode 100755 index 3daba123..00000000 --- a/doc/latex/Latex_Makefile +++ /dev/null @@ -1,293 +0,0 @@ -#*********************************************************************** -# FILE : -# Latex_Makefile -# -# CREATED : -# Chris Bradley and Martyn Nash, Feburary 1996 -# UPDATES : -# Leo Cheng, November 1998 - Adding option to generate 2 to a page ps. -# Martyn Nash, Feb 2006 - Adding option to generate 2 to a page pdf. -# Chris Bradley, Feb 2011 - Adding option to have svg figures. -# -# -# DESCRIPTION : -# Generic Makefile for LaTeX documents. Document specific parameters -# defined anare invoked from the shell script within the individual -# directory. See the Latex_make.sh script. -# -# The following options are implemented. -# -# (none) - Latex the document. -# clean - Clean up. Removes as in qclean + figs and plot cleans -# clobber - Removes as in clean + the .aux, .toc, .dvi and .ps files -# help - print this message -# html - Generate the html version of the document -# index - Generate the index of the document -# qclean - Quick clean. Removes .log, .bbl and .blg files -# quick - Always latex the document quickly (i.e. no rerun) -# pdf - Generate the pdf version of the document -# pdf2 - Generate the 2 page landscape pdf version of the document -# pics - Make sure the .pstex versions of the figures, svgs and the plots -# are up to date. -# pics_clean - Clean the figures, svgs and the plots. -# print - Print the document to the specified printer. -# print_range FIRST=# LAST=# - Print only the pages in the range -# FIRST-LAST to the specified printer. -# ps - Generate the postcript version of the document. -# ps2 - Generate 2 to a page landscape postscipt version." -# ps_range FIRST=# LAST=# - Generate the postscript version of only -# the pages in the range FIRST-LAST. -# update_html - Move the html version of the document to the -# directory where the html version will be referenced -# -#*********************************************************************** - -SHELL = /bin/sh - -# fixed commands -BIBTEX = bibtex - -# This cannot be found on esu1 - using ps2pdf now -#DVIPDF = dvipdf -#DVIPDF_OPTS = - -PS2PDF = ps2pdf -PS2PDF_OPTS = - - -DVIPS = dvips -DVIPS_OPTS = -Z -n 500 -t a4 -K0 -N0 - -# latex2html98.1 uses undef as a list operator which is not perl5.6 -LATEX2HTML = perl -S latex2html -LATEX2HTML_OPTS = -address ' ' -no_navigation -info ' ' -split 0 -tmp /tmp -FIXL2HTML = ${OPENCMISS_ROOT}/src/iron/doc/html_utils/fixl2html.sh -MAKEINDEX = makeindex -PRINT = lpr -PSNUP = psnup -2 -d0.1 - -# plot, figure and svg files -MAKEFIGS = make -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Makefigs -MAKESVGS = make -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Makesvgs -MAKEPLOTS = make -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Makeplots - -# -# Standard TeX makefile follows -# - -.SUFFIXES: .pdf .ps .tex .fig .svg .gnu .eps - -.PRECIOUS: $(MAINFILE).dvi - -LATEX_CHECK = latex '\def\inputfigure{\input}' \\syntax \\input -LATEX_DVI = latex '\def\inputfigure{\input}' \\input -LATEX_DVIQ = latex \\batchmode '\def\inputfigure{\input}' \\input -LATEX_PS = latex '\def\inputfigure\#1{\psfig{figure=\#1.ps,silent=}}' \\input -LATEX_PSQ = latex \\batchmode \ - '\def\inputfigure\#1{\psfig{figure=\#1.ps}}' \ - \\input - -$(MAINFILE).dvi : $(MAINFILE).tex $(TEX_SRC) $(BIBS) $(EPS_SRC) $(FIG_SRC) $(PLOT_SRC) - @if test -d figs ; \ - then $(MAKE) -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Latex_Makefile figsmake ; \ - else : ; \ - fi - @if test -d svgs ; \ - then $(MAKE) -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Latex_Makefile svgsmake ; \ - else : ; \ - fi - @if test -d plots ; \ - then $(MAKE) -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Latex_Makefile plotsmake ; \ - else : ; \ - fi - @if test -r $(MAINFILE).aux ; \ - then : ; \ - else $(LATEX_DVI) $(MAINFILE) ; \ - fi - @if grep 'Warning.*: Citation' $(MAINFILE).log >/dev/null ; \ - then $(BIBTEX) $(MAINFILE) ; $(LATEX_DVIQ) $(MAINFILE) ; \ - fi - $(LATEX_DVI) $(MAINFILE) - @if grep Rerun $(MAINFILE).log >/dev/null ; \ - then $(LATEX_DVIQ) $(MAINFILE) ; \ - else : ; \ - fi - -$(MAINFILE).pdf : $(MAINFILE).ps - $(PS2PDF) $(PS2PDF_OPTS) $(MAINFILE).ps $@ - -$(MAINFILE)_2.pdf : $(MAINFILE)_2.ps - $(PS2PDF) $(PS2PDF_OPTS) $(MAINFILE)_2.ps $@ - -$(MAINFILE)_range.pdf : range.ps - $(PS2PDF) $(PS2PDF_OPTS) range.ps $@ - -$(MAINFILE).ps : $(MAINFILE).dvi - $(DVIPS) $(DVIPS_OPTS) -o $@ $(MAINFILE) - -$(MAINFILE)_2.ps : $(MAINFILE).ps - $(PSNUP) $(MAINFILE).ps $(MAINFILE)_2.ps - -help : - @echo "General make for OpenCMISS latex documents:" - @echo "" - @echo "Usage: latexmake [options]" - @echo - @echo "The following options are implemented -" - @echo - @echo " (none) - Latex the document." - @echo " bib - Always bibtex then latex the document." - @echo " clean - Clean up. Removes as in qclean + figs and plot cleans." - @echo " clobber - Removes as in clean + the .aux, .toc, .dvi and .ps files." - @echo " help - print this message." - @echo " html - Generate the html version of the document." - @echo " index - Generate the index of the document." - @echo " qclean - Quick clean. Removes .log, .bbl and .blg files." - @echo " quick - Always latex the document quickly (i.e. no rerun)." - @echo " pdf - Generate the pdf version of the document." - @echo " pdf2 - Generate the 2 page landscape pdf version of the document." - @echo " pdf_range FIRST=# LAST=# - Generate the pdf version of only" - @echo " the pages in the range FIRST-LAST." - @echo " pics - Make sure the .pstex versions of the figures, svgs and " - @echo " the plots are up to date." - @echo " pics_clean - Clean the figures, svgs and plots." - @echo " print - Print the document to the specified printer." - @echo " print_range FIRST=# LAST=# - Print only the pages in the range" - @echo " FIRST-LAST to the specified printer." - @echo " ps - Generate the postcript version of the document." - @echo " ps2 - Generate 2 to a page landscape postscipt version." - @echo " ps_range FIRST=# LAST=# - Generate the postscript version of only" - @echo " the pages in the range FIRST-LAST." - @echo " update_html - Move the html version of the document to the" - @echo " directory where the html version will be referenced." - @echo "" - @echo "See the file Latex_make.sh for document specific options." - -bib : - $(BIBTEX) $(MAINFILE) - $(LATEX_DVI) $(MAINFILE) - @if grep Rerun $(MAINFILE).log >/dev/null ; \ - then $(LATEX_DVIQ) $(MAINFILE) ; \ - else : ; \ - fi - -html : $(MAINFILE)/index.html - -$(MAINFILE)/index.html : $(MAINFILE).tex - $(LATEX2HTML) $(LATEX2HTML_OPTS) $(MAINFILE).tex - -quick : - $(LATEX_DVI) $(MAINFILE) - -pics : $(FIG_SRC) $(SVG_SRC) $(PLOT_SRC) - @if test -d figs ; \ - then $(MAKE) -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Latex_Makefile figsmake ; \ - else : ; \ - fi - @if test -d svgs ; \ - then $(MAKE) -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Latex_Makefile svgsmake ; \ - else : ; \ - fi - @if test -d plots ; \ - then $(MAKE) -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Latex_Makefile plotsmake ; \ - else : ; \ - fi - -pics_clean : - @if test -d figs ; \ - then $(MAKE) -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Latex_Makefile figsclean ; \ - else : ; \ - fi - @if test -d svgs ; \ - then $(MAKE) -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Latex_Makefile svgsclean ; \ - else : ; \ - fi - @if test -d plots ; \ - then $(MAKE) -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Latex_Makefile plotsclean ; \ - else : ; \ - fi - -pdf : $(MAINFILE).pdf - -pdf2 : $(MAINFILE)_2.pdf - -pdf_range : $(MAINFILE)_range.pdf - -ps : $(MAINFILE).ps - -ps2: $(MAINFILE)_2.ps - -ps_range : $(MAINFILE).dvi - $(DVIPS) $(DVIPS_OPTS) -p $(FIRST) -l $(LAST) -o range.ps $(MAINFILE) - -range.ps : $(MAINFILE).dvi - $(DVIPS) $(DVIPS_OPTS) -p $(FIRST) -l $(LAST) -o range.ps $(MAINFILE) - -print : $(MAINFILE).ps - $(PRINT) -P$(PRINTER) $(MAINFILE).ps - -print_range : $(MAINFILE).dvi - $(DVIPS) $(DVIPS_OPTS) -p $(FIRST) -l $(LAST) -o range.ps $(MAINFILE) - $(PRINT) -P$(PRINTER) range.ps - - -update_html : $(HTMLUPDATE_DIR)/$(MAINFILE)/index.html - -$(HTMLUPDATE_DIR)/$(MAINFILE)/index.html : $(MAINFILE)/index.html - $(FIXL2HTML) $(HTMLIDXTYPE) $(MAINFILE)/index.html $(MAINFILE) - @if test -d $(HTMLUPDATE_DIR)/$(MAINFILE) ; \ - then : ; \ - else mkdir $(HTMLUPDATE_DIR)/$(MAINFILE) ; \ - fi - cp $(MAINFILE)/*.* $(HTMLUPDATE_DIR)/$(MAINFILE)/. - -index : $(MAINFILE).ind - -$(MAINFILE).ind : $(MAINFILE).idx - $(MAKEINDEX) $(MAINFILE).idx - @if grep 'Output written in '$(MAINFILE)'.ind' $(MAINFILE).ilg >/dev/null ; \ - then $(LATEX_DVIQ) $(MAINFILE) ; \ - else : ; \ - fi - -qclean : - -rm -f $(MAINFILE).dvi $(MAINFILE).bbl $(MAINFILE).blg $(MAINFILE).log - -clean : qclean - @if test -d figs ; \ - then $(MAKE) -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Latex_Makefile figsclean ; \ - else : ; \ - fi - @if test -d svgs ; \ - then $(MAKE) -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Latex_Makefile svgsclean ; \ - else : ; \ - fi - @if test -d plots ; \ - then $(MAKE) -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Latex_Makefile plotsclean ; \ - else : ; \ - fi - -clobber : clean - find . -name "*.aux" -exec rm -f {} \; - -rm -f *.toc *.lof *.lot - -rm -f $(MAINFILE).dvi $(MAINFILE).ps range.ps - -figsmake : - @(cd figs ; $(MAKEFIGS)) - -figsclean : - @(cd figs ; $(MAKEFIGS) clean) - -svgsmake : - @(cd svgs ; $(MAKESVGS)) - -svgsclean : - @(cd svgs ; $(MAKESVGS) clean) - -plotsmake : - @(cd plots ; $(MAKEPLOTS)) - -plotsclean : - @(cd plots ; $(MAKEPLOTS) clean) - - diff --git a/doc/latex/Latex_make.sh b/doc/latex/Latex_make.sh deleted file mode 100755 index f4c68e3a..00000000 --- a/doc/latex/Latex_make.sh +++ /dev/null @@ -1,77 +0,0 @@ -#!/bin/sh -f -# -# This shell script is used to invoke the Latex_Makefile for general -# documents. It should be copied into the individual document directory -# as a new document is created. It is used to pass document specific -# parameters to the makefile. NOTE that if parameters may be omitted -# by simply deleting them from the "make" command line. -# -# Usage: -# Latex_make.sh [makefile_options] -# Created: -# Martyn Nash, 22 March 1996 -# Updates: -# -# Changable options: -# -# This is the overall name of the document - -MY_MAINFILE=themainfilename - -# -# These are the names of the tex sources for the document. If there is -# more than one source quotation (") marks must be used around the -# individual sources seperated by spaces. - -MY_TEX_SRC="chapter1/chapter1.tex chapter2/chapter2.tex" - -# -# The names of the eps/figs/(gnu)plot files that go into the document. -# if there are none then leave after the ='s sign blank. If there is -# more than one source quotation (") marks must be used around the -# individual sources seperated by spaces. - -MY_EPS_SRC=epsfiles/*.eps -MY_FIG_SRC=figs/*.fig -MY_PLOT_SRC=plots/*.gnu - -# -# The name of the directory to place the html version of the document. -# Note that the actual file will be placed in the directory -# MY_HTMLUPDATE_DIR/MY_MAINFILE with filename index.html - -MY_HTMLUPDATE_DIR=${OPENCMISS_ROOT}/src/iron/doc/www/help - -# -# This next option controls the type of backlinks to add to the footer -# of the HTML file. It should be "user" if the document is intended for -# general users or "programmer" if the document is intended for -# cmiss programmers. If no backlinks are required use "none". - -MY_HTMLIDXTYPE=user - -# -# The name of the bibliography database for the document - -MY_BIBS=${OPENCMISS_ROOT}/src/iron/doc/references/references.bib - -# -# The name of the printer to print the document to - -MY_PRINTER=laserjet_postscript - -# -# Below this line should not need changing -# -# Actual make command: -# -make -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Latex_Makefile $* \ - MAINFILE=$MY_MAINFILE \ - TEX_SRC="$MY_TEX_SRC" \ - EPS_SRC="$MY_EPS_SRC" \ - FIG_SRC="$MY_FIG_SRC" \ - PLOT_SRC="$MY_PLOT_SRC" \ - HTMLUPDATE_DIR=$MY_HTMLUPDATE_DIR \ - HTMLIDXTYPE=$MY_HTMLIDXTYPE \ - BIBS=$MY_BIBS \ - PRINTER=$MY_PRINTER diff --git a/doc/latex/Makefigs b/doc/latex/Makefigs deleted file mode 100755 index 7a9d1481..00000000 --- a/doc/latex/Makefigs +++ /dev/null @@ -1,48 +0,0 @@ -# -# Makefile for figs -# -# Usage: -# make -f Makefigs filename.fig -# Created: -# Chris Bradley -# Updates: -# Glen Harris 8 August 1996 -# Correcting rule for '*.fig' so that new .fig files are picked up -# Chris Bradley 4 October 1996 -# Adding directories under the 'plots' directory -# Leo Cheng 27 November 1998 -# Allowing specfication of fig2dev -# - -#FIGS = *.fig -#EPS_FIGS = $(FIGS:.fig=.eps) -#PSTEX_FIGS = $(FIGS:.fig=.pstex) -#FIG2DEV = /usr/local/bin/fig2dev -FIG2DEV=fig2dev - - -SHELL=/bin/bash - -.SUFFIXES: .ps .tex .pstex .fig - -all : all_pstex - -.fig.ps: - ( cd ${@D} ; ${FIG2DEV} -Lps ${*F}.fig > ${@F} ) - -.fig.tex: - ( cd ${@D} ; ${FIG2DEV} -Leepic ${*F}.fig > ${@F} ) - -.fig.pstex: - ( cd ${@D} ; ${FIG2DEV} -Lpstex ${*F}.fig > ${*F}.eps ) - ( cd ${@D} ; ${FIG2DEV} -Lpstex_t -F -p${*F}.eps ${*F}.fig | sed -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Strip_pstex_figs | sed s%CUR_DIR%${@D}% | sed s%=figs/./%=figs/% | sed s%=figs//%=figs/% | sed s%{figs/./%{figs/% | sed s%{figs//%{figs/% > ${@F} ) - -all_pstex: - @${OPENCMISS_ROOT}/src/iron/doc/latex/call_makefile.sh ${OPENCMISS_ROOT}/src/iron/doc/latex/Makefigs pstex `find . -name "*.fig" -print` - -clean: - find . -name "*.eps" -exec rm -f {} \; - find . -name "*.pstex" -exec rm -f {} \; - -clobber: clean - diff --git a/doc/latex/Makeplots b/doc/latex/Makeplots deleted file mode 100755 index 45ad971f..00000000 --- a/doc/latex/Makeplots +++ /dev/null @@ -1,76 +0,0 @@ -# -# Makefile for plots -# -# Usage: -# make -f Makeplots filename.gnu -# Created: -# Chris Bradley -# Updates: -# Glen Harris 8 August 1996 -# Correcting rule for '*.gnu' so that new .gnu files are picked up -# Chris Bradley 4 October 1996 -# Adding directories under the 'plots' directory -# Chris Bradley 4 October 1996 -# Automatically convert gnuplot \ to \\\\ so that the escape -# sequence is read by xfig properly -# Chris Bradley 25 October 1996 -# Directly output pstex from gnuplot. The old gnuplot->xfig->pstex -# way is in the Makeplots_old file. -# Chris Bradley 20 April 1998 -# Added .gnus for small gnuplots which can then be used in subfigures. -# Chris Bradley 29 November 1999 -# Added code to translate title "$\\ sequences into title "$\ sequences. -# - -SHELL=/bin/bash - -.SUFFIXES: .pstex .gnu .gnuc .gnucs .gnus .ps .eepic - -all : all_pstex all_pstexc all_pstexcs all_pstexs - -.gnu.pstex: - ( cd ${@D} ; echo "set terminal pslatex rotate auxfile" > Output_pstex.gnu_tmp ; echo "set output \""${*F}.pstex"\"" >> Output_pstex.gnu_tmp ; sed -e s%'\\\([A-Za-z#\]\)'%'\\\\\1'%g ${*F}.gnu |sed -e s%'title '\"'\\'%"title "\"%g | sed -e s%'title '\"'$$\\'%"title "\"$$%g > ${*F}.gnu_tmp ; gnuplot Output_pstex.gnu_tmp ${*F}.gnu_tmp ; rm -f Output_pstex.gnu_tmp ; rm -f ${*F}.gnu_tmp ) - ( cd ${@D} ; grep -v showpage ${*F}.ps > ${*F}.eps ; rm -f ${*F}.ps ; echo '\begin{picture}(-5,0)' > ${*F}.pstex_tmp ; echo '\epsfig{file='${*F}.eps"}" >> ${*F}.pstex_tmp ; echo '\end{picture}' >> ${*F}.pstex_tmp ; grep -v "special{psfile=" ${*F}.pstex >> ${*F}.pstex_tmp ; mv ${*F}.pstex_tmp ${*F}.pstex ; cp ${*F}.pstex junk.pstex ) - ( cd ${@D} ; sed -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Strip_pstex_gnuplot ${*F}.pstex | sed s%CUR_DIR%${@D}% | sed s%=plots/./%=plots/% | sed s%=plots//%=plots/% > ${@F}_tmp ; mv ${@F}_tmp ${@F} ) - -.gnuc.pstex: - ( cd ${@D} ; echo "set terminal pslatex color rotate auxfile" > Output_pstex.gnuc_tmp ; echo "set output \""${*F}.pstex"\"" >> Output_pstex.gnuc_tmp; sed -e s%'\\\([A-Za-z#\]\)'%'\\\\\1'%g ${*F}.gnuc | sed -e s%'title '\"'\\'%"title "\"%g | sed -e s%'title '\"'$$\\'%"title "\"$$%g > ${*F}.gnuc_tmp ; gnuplot Output_pstex.gnuc_tmp ${*F}.gnuc_tmp ; rm -f Output_pstex.gnuc_tmp ; rm -f ${*F}.gnuc_tmp ) - ( cd ${@D} ; grep -v showpage ${*F}.ps > ${*F}.eps ; rm -f ${*F}.ps ; echo '\\begin{picture}(-5,0)' > ${*F}.pstex_tmp ; echo '\\epsfig{file='${*F}.eps"}" >> ${*F}.pstex_tmp ; echo '\\end{picture}' >> ${*F}.pstex_tmp ; grep -v "special{psfile=" ${*F}.pstex >> ${*F}.pstex_tmp ; mv ${*F}.pstex_tmp ${*F}.pstex ) - ( cd ${@D} ; sed -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Strip_pstex_gnuplot ${*F}.pstex | sed s%CUR_DIR%${@D}% | sed s%=plots/./%=plots/% | sed s%=plots//%=plots/% > ${@F}_tmp ; mv ${@F}_tmp ${@F} ) - -.gnucs.pstex: - ( cd ${@D} ; echo "set terminal pslatex color rotate auxfile" > Output_pstex.gnucs_tmp ; echo "set output \""${*F}.pstex"\"" >> Output_pstex.gnucs_tmp ; echo "set size 0.55,0.55" >> Output_pstex.gnus_tmp ; sed -e s%'\\\([A-Za-z#\]\)'%'\\\\\1'%g ${*F}.gnucs | sed -e s%'title '\"'\\'%"title "\"%g | sed -e s%'title '\"'$$\\'%"title "\"$$%g > ${*F}.gnucs_tmp ; gnuplot Output_pstex.gnucs_tmp ${*F}.gnucs_tmp ; rm -f Output_pstex.gnucs_tmp ; rm -f ${*F}.gnucs_tmp ) - ( cd ${@D} ; grep -v showpage ${*F}.ps > ${*F}.eps ; rm -f ${*F}.ps ; echo '\\begin{picture}(-5,0)' > ${*F}.pstex_tmp ; echo '\\epsfig{file='${*F}.eps"}" >> ${*F}.pstex_tmp ; echo '\\end{picture}' >> ${*F}.pstex_tmp ; grep -v "special{psfile=" ${*F}.pstex >> ${*F}.pstex_tmp ; mv ${*F}.pstex_tmp ${*F}.pstex ) - ( cd ${@D} ; sed -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Strip_pstex_gnuplot ${*F}.pstex | sed s%CUR_DIR%${@D}% | sed s%=plots/./%=plots/% | sed s%=plots//%=plots/% > ${@F}_tmp ; mv ${@F}_tmp ${@F} ) - -.gnus.pstex: - ( cd ${@D} ; echo "set terminal pslatex rotate auxfile" > Output_pstex.gnus_tmp ; echo "set output \""${*F}.pstex"\"" >> Output_pstex.gnus_tmp ; echo "set size 0.55,0.55" >> Output_pstex.gnus_tmp ; sed -e s%'\\\([A-Za-z#\]\)'%'\\\\\1'%g ${*F}.gnus | sed -e s%'title '\"'\\'%"title "\"%g | sed -e s%'title '\"'$$\\'%"title "\"$$%g > ${*F}.gnus_tmp ; gnuplot Output_pstex.gnus_tmp ${*F}.gnus_tmp ; rm -f Output_pstex.gnus_tmp ; rm -f ${*F}.gnus_tmp ) - ( cd ${@D} ; grep -v showpage ${*F}.ps > ${*F}.eps ; rm -f ${*F}.ps ; echo '\\begin{picture}(-5,0)' > ${*F}.pstex_tmp ; echo '\\epsfig{file='${*F}.eps"}" >> ${*F}.pstex_tmp ; echo '\\end{picture}' >> ${*F}.pstex_tmp ; grep -v "special{psfile=" ${*F}.pstex >> ${*F}.pstex_tmp ; mv ${*F}.pstex_tmp ${*F}.pstex ) - ( cd ${@D} ; sed -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Strip_pstex_gnuplot ${*F}.pstex | sed s%CUR_DIR%${@D}% | sed s%=plots/./%=plots/% | sed s%=plots//%=plots/% > ${@F}_tmp ; mv ${@F}_tmp ${@F} ) - -.gnu.eepic: - ( cd ${@D} ; gnuplot ${OPENCMISS_ROOT}/src/iron/doc/latex/Output_eepic.gnu ${*F}.gnu > ${@F} ) - -.gnu.ps: - ( cd ${@D} ; gnuplot ${OPENCMISS_ROOT}/src/iron/doc/latex/Output_ps ${*F}.gnu > ${@F} ) - -all_pstex: - @${OPENCMISS_ROOT}/src/iron/doc/latex/call_makefile.sh ${OPENCMISS_ROOT}/src/iron/doc/latex/Makeplots pstex `find . -name "*.gnu" -print` - -all_pstexc: - @${OPENCMISS_ROOT}/src/iron/doc/latex/call_makefile.sh ${OPENCMISS_ROOT}/src/iron/doc/latex/Makeplots pstex `find . -name "*.gnuc" -print` - -all_pstexcs: - @${OPENCMISS_ROOT}/src/iron/doc/latex/call_makefile.sh ${OPENCMISS_ROOT}/src/iron/doc/latex/Makeplots pstex `find . -name "*.gnucs" -print` - -all_pstexs: - @${OPENCMISS_ROOT}/src/iron/doc/latex/call_makefile.sh ${OPENCMISS_ROOT}/src/iron/doc/latex/Makeplots pstex `find . -name "*.gnus" -print` - -clean: - find . -name "*.eps" -exec rm -f {} \; - find . -name "*.pstex" -exec rm -f {} \; - find . -name "*.eepic" -exec rm -f {} \; - find . -name "*.ps" -exec rm -f {} \; - -clobber: clean - diff --git a/doc/latex/Makesvgs b/doc/latex/Makesvgs deleted file mode 100755 index 98198d12..00000000 --- a/doc/latex/Makesvgs +++ /dev/null @@ -1,57 +0,0 @@ -# -# Makefile for svgs -# -# Usage: -# make -f Makesvgs filename.svg -# Created: -# Chris Bradley -# Updates: -# - -INKSCAPE=inkscape - -SHELL=/bin/bash - -.SUFFIXES: .pdf .ps .eps .tex .pdf_tex .ps_tex .eps_tex .svg - -#all : all_pdf_tex -#all : all_ps_tex -all : all_eps_tex - -.svg.pdf: - ( cd ${@D} ; ${INKSCAPE} -D -z --export-pdf=${@F} ${*F}.svg ) - -.svg.ps: - ( cd ${@D} ; ${INKSCAPE} -D -z --export-ps=${@F} ${*F}.svg ) - -.svg.eps: - ( cd ${@D} ; ${INKSCAPE} -D -z --export-eps=${@F} ${*F}.svg ) - -.svg.tex: - ( cd ${@D} ; ${INKSCAPE} -D -z --export-latex ${*F}.svg ) - -.svg.pdf_tex: - ( cd ${@D} ; ${INKSCAPE} -D -z --export-pdf=${*F}.pdf --export-latex ${*F}.svg ; sed -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Strip_pdftex_svgs ${@F} | sed s%CUR_DIR%${@D}% | sed s%=svgs/./%=svgs/% | sed s%=svgs//%=svgs/% | sed s%{svgs/./%{svgs/% | sed s%{svgs//%{svgs/% > ${*F}.tmp ; mv ${*F}.tmp ${@F} ) - -.svg.ps_tex: - ( cd ${@D} ; ${INKSCAPE} -D -z --export-ps=${*F}.ps --export-latex ${*F}.svg ; sed -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Strip_pdftex_svgs ${@F} | sed s%CUR_DIR%${@D}% | sed s%=svgs/./%=svgs/% | sed s%=svgs//%=svgs/% | sed s%{svgs/./%{svgs/% | sed s%{svgs//%{svgs/% > ${*F}.tmp ; mv ${*F}.tmp ${@F} ) - -.svg.eps_tex: - ( cd ${@D} ; ${INKSCAPE} -D -z --export-eps=${*F}.eps --export-latex ${*F}.svg ; sed -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Strip_epstex_svgs ${@F} | sed s%CUR_DIR%${@D}% | sed s%=svgs/./%=svgs/% | sed s%=svgs//%=svgs/% | sed s%{svgs/./%{svgs/% | sed s%{svgs//#%{svgs/% > ${*F}.tmp ; mv ${*F}.tmp ${@F} ) - -all_pdf_tex: - @${OPENCMISS_ROOT}/src/iron/doc/latex/call_makefile.sh ${OPENCMISS_ROOT}/src/iron/doc/latex/Makesvgs pdf_tex `find . -name "*.svg" -print` - -all_ps_tex: - @${OPENCMISS_ROOT}/src/iron/doc/latex/call_makefile.sh ${OPENCMISS_ROOT}/src/iron/doc/latex/Makesvgs ps_tex `find . -name "*.svg" -print` - -all_eps_tex: - @${OPENCMISS_ROOT}/src/iron/doc/latex/call_makefile.sh ${OPENCMISS_ROOT}/src/iron/doc/latex/Makesvgs eps_tex `find . -name "*.svg" -print` - -clean: - find . -name "*.pdf_tex" -exec rm -f {} \; - find . -name "*.ps_tex" -exec rm -f {} \; - find . -name "*.eps_tex" -exec rm -f {} \; - -clobber: clean - diff --git a/doc/latex/abbreviations.tex b/doc/latex/abbreviations.tex deleted file mode 100755 index aca33d9d..00000000 --- a/doc/latex/abbreviations.tex +++ /dev/null @@ -1,156 +0,0 @@ -% -% abbreviations.tex -% -% This file contains the list of common words and phrases and their tex -% abbreviations -% -% Created: -% 10 September 1996 -% -% Updated: -% Leo Cheng 31 May 1998 Moved \CMISS to macros.tex -% Leo Cheng 24 Apr 1999 experimental terms -% Mark Trew 14 Feb 2001 added abbreviation for cf. -% Leo Cheng 26 Feb 2001 added insilico - - - - -\newcommand{\wrt}{with respect to\xspace} - - - -% -% Experimental terms -% -\newcommand{\invivo}{\emph{in-vivo\xspace}} -\newcommand{\Invivo}{\emph{In-vivo}\xspace} - -\newcommand{\exvivo}{\emph{ex-vivo\xspace}} -\newcommand{\Exvivo}{\emph{Ex-vivo\xspace}} - - -\newcommand{\invitro}{\emph{in-vitro}\xspace} -\newcommand{\Invitro}{\emph{In-vitro}\xspace} - -\newcommand{\insitu}{\emph{in-situ}\xspace} -\newcommand{\Insitu}{\emph{In-situ}\xspace} - -\newcommand{\insilico}{\emph{in-silico}\xspace} -\newcommand{\Insilico}{\emph{In-silico}\xspace} - - - - -% -% Latin abbreviations -% -\newcommand{\eg}{\emph{e.g.,}\xspace} % e.g., -\newcommand{\apriori}{\emph{a priori}\xspace} % a priori -\newcommand{\etal}{\emph{et al.}\xspace} % et al. -\newcommand{\etc}{\emph{etc.}\xspace} % etc. -\newcommand{\ie}{\emph{i.e.,}\xspace} % i.e., -\newcommand{\nb}{\emph{n.b.}\xspace} % n.b. -\newcommand{\cf}{\emph{cf.}\xspace} % cf. confer -% - - -% -% Numerical methods -% -\newcommand{\boundelem}{boundary element\xspace} -\newcommand{\boundelems}{boundary elements\xspace} -\newcommand{\Boundelem}{Boundary element\xspace} -\newcommand{\Boundelems}{Boundary elements\xspace} -\newcommand{\finelem}{finite element\xspace} -\newcommand{\finelems}{finite elements\xspace} -\newcommand{\Finelem}{Finite element\xspace} -\newcommand{\Finelems}{Finite elements\xspace} -\newcommand{\findiff}{finite difference\xspace} -\newcommand{\findiffs}{finite differences\xspace} -\newcommand{\Findiff}{Finite difference\xspace} -\newcommand{\Findiffs}{Finite differences\xspace} -\newcommand{\bem}{boundary element method\xspace} -\newcommand{\bems}{boundary element methods\xspace} -\newcommand{\Bem}{Boundary element method\xspace} -\newcommand{\Bems}{Boundary element methods\xspace} -\newcommand{\fem}{finite element method\xspace} -\newcommand{\fems}{finite element methods\xspace} -\newcommand{\Fem}{Finite element method\xspace} -\newcommand{\Fems}{Finite element methods\xspace} -\newcommand{\fdm}{finite difference method\xspace} -\newcommand{\fdms}{finite difference methods\xspace} -\newcommand{\Fdm}{Finite difference method\xspace} -\newcommand{\Fdms}{Finite difference methods\xspace} -\newcommand{\nonlin}{non-linear\xspace} -\newcommand{\Nonlin}{Non-linear\xspace} - - -% -% Differential equations -% -\newcommand{\diffeqn}{differential equation\xspace} -\newcommand{\diffeqns}{differential equations\xspace} -\newcommand{\pde}{partial differential equation\xspace} -\newcommand{\pdes}{partial differential equations\xspace} - -% -% Geometry -% -\newcommand{\arclen}{arc-length\xspace} -\newcommand{\arclens}{arc-lengths\xspace} -\newcommand{\Arclen}{Arc-length\xspace} -\newcommand{\Arclens}{Arc-lengths\xspace} - -% -% Basis functions and interpolation -% -\newcommand{\bicubicherm}{bicubic Hermite\xspace} -\newcommand{\Bicubicherm}{Bicubic Hermite\xspace} -\newcommand{\cubicherm}{cubic Hermite\xspace} -\newcommand{\Cubicherm}{Cubic Hermite\xspace} -\newcommand{\linlagran}{linear Lagrange\xspace} -\newcommand{\Linlagran}{Linear Lagrange\xspace} - -% -% Coordinates and dimensions -% -\newcommand{\xicoord}{$\xi$-coordinate\xspace} -\newcommand{\xicoords}{$\xi$-coordinates\xspace} - -\newcommand{\xcoord}{$x$-coordinate\xspace} -\newcommand{\ycoord}{$y$-coordinate\xspace} -\newcommand{\zcoord}{$z$-coordinate\xspace} - -\newcommand{\rcoord}{$r$-coordinate\xspace} -\newcommand{\tcoord}{$\theta$-coordinate\xspace} -\newcommand{\pcoord}{$\phi$-coordinate\xspace} -\newcommand{\mcoord}{$\mu$-coordinate\xspace} -\newcommand{\lcoord}{$\lambda$-coordinate\xspace} - - -\newcommand{\oned}{one-dimension\xspace} -\newcommand{\oneds}{one-dimensions\xspace} -\newcommand{\Oned}{One-dimension\xspace} -\newcommand{\Oneds}{One-dimensions\xspace} -\newcommand{\onedal}{one-dimensional\xspace} -\newcommand{\Onedal}{One-dimensional\xspace} - -\newcommand{\twod}{two-dimension\xspace} -\newcommand{\twods}{two-dimensions\xspace} -\newcommand{\Twod}{Two-dimension\xspace} -\newcommand{\Twods}{Two-dimensions\xspace} -\newcommand{\twodal}{two-dimensional\xspace} -\newcommand{\Twodal}{Two-dimensional\xspace} - -\newcommand{\threed}{three-dimension\xspace} -\newcommand{\threeds}{three-dimensions\xspace} -\newcommand{\Threed}{Three-dimension\xspace} -\newcommand{\Threeds}{Three-dimensions\xspace} -\newcommand{\threedal}{three-dimensional\xspace} -\newcommand{\Threedal}{Three-dimensional\xspace} - -%%% Local Variables: -%%% mode: latex -%%% TeX-master: t -%%% End: diff --git a/doc/latex/abconference.tex b/doc/latex/abconference.tex deleted file mode 100755 index 100c1a87..00000000 --- a/doc/latex/abconference.tex +++ /dev/null @@ -1,24 +0,0 @@ -\documentclass[12pt,twoside,dvips]{article} - -\usepackage{times} -\usepackage{/data/OpenCMISS/src/iron/doc/latex/abconference} - -%\starteven -\startodd - -\title{The Title} -\author{The Authors} - -\begin{document} - -\maketitle - -\section{INTRODUCTION} - -\bibliographystyle{plain} - -\section{SPEAKER INFORMATION} - -\end{document} - - diff --git a/doc/latex/defns.tex b/doc/latex/defns.tex deleted file mode 100755 index 6feb71c9..00000000 --- a/doc/latex/defns.tex +++ /dev/null @@ -1,36 +0,0 @@ -\usepackage{etex} %increase the size of fixed (register) arrays -\usepackage{epic} %package for epic -\usepackage{eepic} %package for extended epic -\def\tenrm{} -\usepackage{rotating} -\usepackage{subfigure} -\usepackage{ifthen} -\usepackage{epsfig} -\usepackage{graphicx} -\usepackage{harvard} -\usepackage{color} -\usepackage{multirow} -\usepackage{makeidx} % makes index - -\gdef\SetFigFont#1#2#3{#3} -\gdef\SetFigFontNFSS#1#2#3{#3} - -% line spacing definitions -\usepackage{setspace} % Line spacing package -\newcommand{\singlespc}{\setstretch{1.00}} % Single spacing -\newcommand{\oneandhalfspc}{\setstretch{1.24}} % One and a half spacing -\newcommand{\doublespc}{\setstretch{1.66}} % Double spacing -\oneandhalfspc - -% Page style definitions -%\setlength{\parskip}{\baselineskip} % these two lines for -%\setlength{\parindent}{0mm} % no paragraph indents -\usepackage{vmargin} -\setpapersize{A4} -\setmargrb{25mm}{35mm}{25mm}{35mm} -\addtolength{\headheight}{6pt} - -% Local Variables: -% mode: latex -% TeX-master: t -% End: diff --git a/doc/latex/genfigs.sh b/doc/latex/genfigs.sh deleted file mode 100755 index 1c6c9e7f..00000000 --- a/doc/latex/genfigs.sh +++ /dev/null @@ -1,15 +0,0 @@ -#!/bin/sh -# -# Shell file for generating fig files (for the first time) from -# gnu files. -# -# Usage: -# genfigs *.gnu -# Created: -# Chris Bradley 9 March 1996 -# Updates: -# -for filename -do - ${OPENCMISS_ROOT}/src/iron/doc/latex/genfigs1.sh $filename -done diff --git a/doc/latex/genfigs1.sh b/doc/latex/genfigs1.sh deleted file mode 100755 index e380e743..00000000 --- a/doc/latex/genfigs1.sh +++ /dev/null @@ -1,12 +0,0 @@ -#!/bin/csh -f -# -# Shell file for generating fig files (for the first time) from -# gnu files. -# -# Usage: -# see genfigs.sh for usage details -# Created: -# Chris Bradley -# Updates: -# -make -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Makeplots $1:r.fig diff --git a/doc/latex/genpstex.sh b/doc/latex/genpstex.sh deleted file mode 100755 index 0745ae83..00000000 --- a/doc/latex/genpstex.sh +++ /dev/null @@ -1,17 +0,0 @@ -#!/bin/sh -# -# Shell file for generating pstex files (for the first time) -# -# Usage: -# genpstex [figs]/plots *.fig -# Created: -# Chris Bradley -# Updates: -# Chris Bradley 10/3/96 Added figs/plots option -# -type=$1 -shift -for filename -do - ${OPENCMISS_ROOT}/src/iron/doc/latex/genpstex1.sh $type $filename -done diff --git a/doc/latex/genpstex1.sh b/doc/latex/genpstex1.sh deleted file mode 100755 index e2987a0b..00000000 --- a/doc/latex/genpstex1.sh +++ /dev/null @@ -1,16 +0,0 @@ -#!/bin/csh -f -# -# Shell file for generating pstex files (for the first time) -# -# Usage: -# see genpstex.sh for usage details -# Created: -# Chris Bradley -# Updates: -# Chris Braldey 10/3/96 Using the same file for plots and figs -# -if($1 == 'plots') then -make -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Makeplots $2:r.pstex -else -make -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Makefigs $2:r.pstex -endif diff --git a/doc/latex/macros.tex b/doc/latex/macros.tex deleted file mode 100755 index 9b9c2784..00000000 --- a/doc/latex/macros.tex +++ /dev/null @@ -1,814 +0,0 @@ -% -% Macros.tex - global macros file -% -% Created: -% 10 September 1996 -% -% Updates: -% Leo Cheng 31 May 1998, macros for DES software names -% Leo Cheng 19 August 1998, added units for grams and kg -% Leo Cheng 18 January 1999, added units for ohmcm -% Leo Cheng 17 May 1999, adding modified url package and macros -% Chris Bradley, 1 Dec 1999, adding \unitseparator. -% Chris Bradley, 7 September 2000, Changed \lps to \Lps and \mMpLpms etc. -% to \mmolpLpms etc. -% Mark Trew, 8 June 2001. Made all macro arguments raised to a power -% protected by {}, e.g. replaced #2^ with {#2}^. -% Chris Bradley, 22 Feb 2011. Added svg figure support. -% Chris Bradley, 6 August 2014, Differential geometry support. - - -% -% Necessary packages -% -\usepackage{alltt} -\usepackage[centertags]{amsmath} -\usepackage{amssymb} -\usepackage{calc} -\usepackage{epsfig} %package for eps figures -\usepackage{eufrak} %For math Fraktur fonts -\usepackage{ifthen} -\usepackage{xspace} -\usepackage{url} - - -% URL commands -% -\newcommand{\email} {\begingroup \urlstyle{sf}\Url} -\newcommand{\directory} {\begingroup \urlstyle{sf}\Url} -\newcommand{\file} {\begingroup \urlstyle{sf}\Url} -\renewcommand{\url} {\begingroup \urlstyle{sf}\Url} - - -% -% Software and systmes -% -\newcommand{\OpenCMISS} {\textsf{OpenCMISS}\xspace} -\newcommand{\CMISS} {\textsf{CMISS}\xspace} -\newcommand{\CM} {\textsf{CM}\xspace} %note upper case to distinguish from centimeters -\newcommand{\CMGUI} {\textsf{CMGUI}\xspace} -\newcommand{\UNEMAP}{\textsf{UnEmap}\xspace} -\newcommand{\FieldML}{\textsf{FieldML}\xspace} -\newcommand{\CellML}{\textsf{CellML}\xspace} - -% -% New commands -% -\newcommand{\Index}[1]{#1\index{#1}} -\newcommand{\subsubsubsection}[1]{\noindent\textbf{#1}} -%\newcommand{\newabbrev}[2]{\newcommand{#1}{#2\xspace}} -%\newcommand{\newabbrevs}[3]{\newcommand{#1}{#2\xspace}\newcommand{#3}{#2s\xspace}} -\newcommand{\clearemptydoublepage}{\newpage{\pagestyle{empty}\cleardoublepage}} -%\newcommand{\newion}[3]{\newcommand{#1}{\ion{#2}{#3}}} % new ion -%\newcommand{\newunit}[2]{\newcommand{#1}{\units{#2}}} % new unit -% -% New enironments -% -\newenvironment{code}[0]{\small\begin{alltt}}{\end{alltt}\normalsize} -% -% Figures etc. -% -\newcommand{\pdftexfigure}[5]{ % - \begin{figure}[htbp] \centering % - \ifthenelse{\equal{#5}{}}{ % - \def\svgwidth{\columnwidth}}{ % - \def\svgscale{#5} % - } % - \input{#1} % - \ifthenelse{\equal{#2}{}}{ % - \caption{#3}}{ % - \caption[#2]{#3} % - } % - \label{#4} % - \end{figure} % - } % pdftex figure i.e. inkscape svgs - % e.g. \pdftexfigure{figure}{short caption}{long caption}{label}{scale} - % or \pdftexfigure{figure}{}{caption}{label}{} - -\newcommand{\epstexfigure}[5]{ % - \begin{figure}[htbp] \centering % - \ifthenelse{\equal{#5}{}}{ % - \def\svgwidth{\columnwidth}}{ % - \def\svgscale{#5} % - } % - \input{#1} % - \ifthenelse{\equal{#2}{}}{ % - \caption{#3}}{ % - \caption[#2]{#3} % - } % - \label{#4} % - \end{figure} % - } % epstex figure i.e. inkscape svgs - % e.g. \epstexfigure{figure}{short caption}{long caption}{label}{scale} - % or \epstexfigure{figure}{}{caption}{label}{} - -\newcommand{\pstexfigure}[5]{ % - \begin{figure}[htbp] \centering % - \ifthenelse{\equal{#5}{}}{ % - \def\svgwidth{\columnwidth}}{ % - \def\svgscale{#5} % - } % - \input{#1} % - \ifthenelse{\equal{#2}{}}{ % - \caption{#3}}{ % - \caption[#2]{#3} % - } % - \label{#4} % - \end{figure} % - } % pstex figure i.e. inkscape, xfig or gnuplot - % e.g. \pstexfigure{figure}{short caption}{long caption}{label}{scale} - % or \pstexfigure{figure}{}{caption}{label}{} - -\newcommand{\epsfigure}[4]{ % - \begin{figure}[htbp] \centering % - \epsfig{#1} % - \ifthenelse{\equal{#2}{}}{ % - \caption{#3}}{ % - \caption[#2]{#3} % - } % - \label{#4} % - \end{figure} % - } % eps figure - % e.g. \epsfigure{epsfig options}{short caption}{long caption}{label} - % or \epsfigure{epsfig options}{}{caption}{label} - -\newcommand{\incgrfigure}[5]{ % - \begin{figure}[htbp] \centering % - \includegraphics[#1]{#2} % - \ifthenelse{\equal{#3}{}}{ % - \caption{#4}}{ % - \caption[#3]{#4} % - } % - \label{#5} % - \end{figure} % - } % include graphics figure - % e.g. \incgrfigure{height/width options}{epsfig options}{short caption} - % {long caption}{label} - % or \incgrfigure{height/width options}{epsfig options}{}{caption}{label} - -% -% Formats for references to equations, tables etc. -% -\newcommand{\appendref}[1]{Appendix~\ref{#1}} % Appendix reference -\newcommand{\Appendref}[1]{Appendix~\ref{#1}} % Appendix reference -\newcommand{\appendrefs}[2]{Appendices~\ref{#1} and~\ref{#2}} % Appendices ref. -\newcommand{\Appendrefs}[2]{Appendices~\ref{#1} and~\ref{#2}} % Appendices ref. -\newcommand{\appendthrurefs}[2]{Appendices~\ref{#1}--\ref{#2}} % Appendices-- -\newcommand{\Appendthrurefs}[2]{Appendices~\ref{#1}--\ref{#2}} % Appendices-- -\newcommand{\bref}[1]{(\ref{#1})} % bracketed () reference -\newcommand{\chapref}[1]{Chapter~\ref{#1}} % Chapter reference -\newcommand{\Chapref}[1]{Chapter~\ref{#1}} % Chapter reference -\newcommand{\chaprefs}[2]{Chapters~\ref{#1} and~\ref{#2}} % Chapters reference -\newcommand{\Chaprefs}[2]{Chapters~\ref{#1} and~\ref{#2}} % Chapters reference -\newcommand{\chathrurefs}[2]{Chapters~\bref{#1}--\bref{#2}} % Chapters-- ref. -\newcommand{\Chathrurefs}[2]{Chapters~\bref{#1}--\bref{#2}} % Chapters-- ref. -\newcommand{\eqnref}[1]{Equation~\bref{#1}} % Equation reference -\newcommand{\Eqnref}[1]{Equation~\bref{#1}} % Equation reference -\newcommand{\eqnrefs}[2]{Equations~\bref{#1} and~\bref{#2}} % Equations ref. -\newcommand{\Eqnrefs}[2]{Equations~\bref{#1} and~\bref{#2}} % Equations ref. -\newcommand{\eqnthrurefs}[2]{Equations~\bref{#1}--\bref{#2}} % Equations-- ref. -\newcommand{\Eqnthrurefs}[2]{Equations~\bref{#1}--\bref{#2}} % Equations-- ref. -\newcommand{\figref}[1]{Figure~\ref{#1}} % Figure reference -\newcommand{\Figref}[1]{Figure~\ref{#1}} % Figure reference -\newcommand{\figrefs}[2]{Figures~\ref{#1} and~\ref{#2}} % Figures reference -\newcommand{\Figrefs}[2]{Figures~\ref{#1} and~\ref{#2}} % Figures reference -\newcommand{\figthrurefs}[2]{Figures~\bref{#1}--\bref{#2}} % Figures-- ref. -\newcommand{\Figthrurefs}[2]{Figures~\bref{#1}--\bref{#2}} % Figures-- ref. -\newcommand{\pagref}[1]{page~\pageref{#1}} % page reference -\newcommand{\Pagref}[1]{Page~\pageref{#1}} % Page reference -\newcommand{\pagrefs}[2]{pages~\pageref{#1} and~\pageref{#2}} % pages reference -\newcommand{\Pagrefs}[2]{Pages~\pageref{#1} and~\pageref{#2}} % Pages reference -\newcommand{\pagthrurefs}[2]{pages~\pageref{#1}--\pageref{#2}} % pages-- -\newcommand{\Pagthrurefs}[2]{Pages~\pageref{#1}--\pageref{#2}} % Pages-- -\newcommand{\secref}[1]{Section~\ref{#1}} % Section reference -\newcommand{\Secref}[1]{Section~\ref{#1}} % Section reference -\newcommand{\secrefs}[2]{Sections~\ref{#1} and~\ref{#2}} % Sections reference -\newcommand{\Secrefs}[2]{Sections~\ref{#1} and~\ref{#2}} % Sections reference -\newcommand{\secthrurefs}[2]{Sections~\bref{#1}--\bref{#2}} % Sections-- ref. -\newcommand{\Secthrurefs}[2]{Sections~\bref{#1}--\bref{#2}} % Sections-- ref. -\newcommand{\tabref}[1]{Table~\ref{#1}} % Table reference -\newcommand{\Tabref}[1]{Table~\ref{#1}} % Table reference -\newcommand{\tabrefs}[2]{Tables~\ref{#1} and~\ref{#2}} % Tables reference -\newcommand{\Tabrefs}[2]{Tables~\ref{#1} and~\ref{#2}} % Tables reference -\newcommand{\tabthrurefs}[2]{Tables~\bref{#1}--\bref{#2}} % Tables-- ref. -\newcommand{\Tabthrurefs}[2]{Tables~\bref{#1}--\bref{#2}} % Tables-- ref. - -% -% Miscellaneous -% -\newcommand{\remark}[1]{\textbf{[Remark: #1]}} -\newcommand{\todo}[1]{\textbf{[#1]}} -\newcommand{\colloq}[1]{``#1''} % colloquialism -\newcommand{\compfile}[1]{\texttt{#1}} -\newcommand{\compcode}[1]{\texttt{#1}} -\newcommand{\compcom}[1]{\texttt{#1}} -\newcommand{\compin}[1]{\texttt{#1}} -\newcommand{\compout}[1]{\texttt{#1}} - -% -% Ions -% -\newcommand{\chemical}[1]{\ensuremath{\mathrm{#1}}} % chemical formulae -\newcommand{\conc}[2]{\ensuremath{ % - [\mathrm{#1}]_{#2} % - }} % concentration e.g. \conc{Na}{o} => [Na]_o -\newcommand{\ion}[2]{\ensuremath{\mathrm{{#1}^{#2}}}\xspace} % ion -\newcommand{\ionCa}{\ion{Ca}{2+}} % calcium ion - - -\newcommand{\ionCl}{\ion{Cl}{-}} % chloride ion -\newcommand{\ionH}{\ion{H}{+}} % hydrogen ion -\newcommand{\ionK}{\ion{K}{+}} % potassium ion -\newcommand{\ionMg}{\ion{Mg}{2+}} % magnessium ion -\newcommand{\ionNa}{\ion{Na}{+}} % sodium ion -\newcommand{\ionphosphate}{\ion{PO_{4}}{3-}} % phosphate ion -\newcommand{\ionbicarbonate}{\ion{HCO_{3}}{-}} % bicarbonate ion -% -% Units -% -\newcommand{\units}[1]{\ensuremath{\mathrm{#1}}\xspace} % units -\newcommand{\nunit}[2]{\ensuremath{ % - #1~#2 % - }} % number + unit e.g. \nunit{10}{\m} => 10 m -\newcommand{\nrunit}[3]{\ensuremath{ % - #1\text{--}#2~#3 % - }} % number range + unit e.g. \nrunit{10}{20}{\m} => 10--20 m - - -\newcommand{\mg}{\units{mg}} % milligrams -\newcommand{\g}{\units{g}} % grams -\newcommand{\kg}{\units{kg}} % kilograms -\newcommand{\dB}{\units{dB}} % decibels -\newcommand{\degC}{\units{\degree C}} % degrees Celcius -\newcommand{\kPa}{\units{kPa}} % kilopascals -\newcommand{\MPa}{\units{MPa}} % Megapascals -\newcommand{\GPa}{\units{GPa}} % Gigapascals -\newcommand{\N}{\units{N}} % Newtons -\newcommand{\kN}{\units{kN}} % kilonewtons -\newcommand{\ml}{\units{ml}} % millilitres -%\newcommand{\L}{\units{L}} % litres -\newcommand{\Hz}{\units{Hz}} % Hertz -\newcommand{\kHz}{\units{kHz}} % kilohertz -\newcommand{\MHz}{\units{MHz}} % Megahertz -\newcommand{\nm}{\units{nm}} % nanometres -\newcommand{\um}{\units{\mu m}} % micrometres -\newcommand{\mm}{\units{mm}} % millimetres -\newcommand{\cm}{\units{cm}} % centimetres -\newcommand{\m}{\units{m}} % metres -\newcommand{\A}{\units{A}} % amps -\newcommand{\mA}{\units{mA}} % milliamps -\newcommand{\uA}{\units{\mu A}} % microamps -\newcommand{\nA}{\units{nA}} % nanoamps -\newcommand{\mM}{\units{mM}} % milliMolar -\newcommand{\mmol}{\units{mmol}} % millimolar -\newcommand{\us}{\units{\mu s}} % microseconds -\newcommand{\ms}{\units{ms}} % milliseconds -\newcommand{\s}{\units{s}} % seconds -\newcommand{\uS}{\units{\mu S}} % microSiemens -\newcommand{\mS}{\units{mS}} % milliSiemens -\newcommand{\V}{\units{V}} % volts -\newcommand{\mV}{\units{mV}} % millivolts -\newcommand{\uV}{\units{\mu V}} % micro volts -\newcommand{\ohm}{\units{\Omega}} % Ohms -\newcommand{\mohm}{\units{m\Omega}} % milli Ohms -\newcommand{\percent}{\units{\%}} % percent -\newcommand{\Henrys}{\units{H}} % Henrys -\newcommand{\uF}{\units{\mu F}} %micro-Farads -\newcommand{\kB}{\units{kB}} % kilobyte -\newcommand{\MB}{\units{MB}} % megabyte -\newcommand{\GB}{\units{GB}} % gigabyte - -% Derived units -%\newcommand{\unitseparator}{\cdot} -\newcommand{\unitseparator}{\thickspace} - - -\newcommand{\Hpm}{\units{\H\unitseparator\m^{-1}}} % Henrys/metre -\newcommand{\kNpm}{\units{\kN\unitseparator\m^{-1}}} % kilo-Newtons/metre -\newcommand{\Lps}{\units{L\unitseparator\s^{-1}}} % litres/second -\newcommand{\mhom}{\units{\mho\unitseparator\m}} % mho-metres -\newcommand{\mhopm}{\units{\mho\unitseparator\m^{-1}}} % mho/metres -\newcommand{\mps}{\units{\m\unitseparator\s^{-1}}} % metres/second -\newcommand{\msqps}{\units{\m^{2}\unitseparator\s^{-1}}} % metres/second -\newcommand{\mpsps}{\units{\m\unitseparator\s^{-2}}} % metres/(second^2) -\newcommand{\mmps}{\units{\mm\unitseparator\s^{-1}}} % millimetres/second -\newcommand{\mmpms}{\units{\mm\unitseparator\ms^{-1}}} % millimetres/millisecond -\newcommand{\mmtwops}{\units{\mm^{2}\unitseparator\s^{-1}}} % millimetres squared/second -\newcommand{\mtwo}{\units{\m^{2}}} % metres squared -\newcommand{\mmtwo}{\units{\mm^{2}}} % millimetres squared -\newcommand{\mmthree}{\units{\mm^{3}}} % millimetres cubed -\newcommand{\pum}{\units{\um^{-1}}} % per micrometer -\newcommand{\pmm}{\units{\mm^{-1}}} % per millimeter -\newcommand{\pms}{\units{\ms^{-1}}} % per millisecond -\newcommand{\uSpmmpmm}{\units{\uS\unitseparator\mm^{-2}}} % microSiemens per millimeter -\newcommand{\mSpmm}{\units{\mS\unitseparator\mm^{-1}}} % milliSiemens per millimeter -\newcommand{\Spm}{\units{S\unitseparator\m^{-1}}} % Siemens per meter -\newcommand{\Spmm}{\units{S\unitseparator\mm^{-1}}} % Siemens per millimeter -\newcommand{\nApmmpmm}{\units{\nA\unitseparator\mm^{-2}}} % nanoamps per millimeter^2 -\newcommand{\uAmm}{\units{\mu A\unitseparator\mm}} % microamps millimeter -\newcommand{\uApmmpmm}{\units{\uA\unitseparator\mm^{-2}}} % microamps per millimeter^2 -\newcommand{\uApmmpmmpmm}{\units{\uA\unitseparator\mm^{-3}}} % microamps per millimeter^3 -\newcommand{\ohmcm}{\units{\ohm\unitseparator\cm}} % ohm-cm -\newcommand{\uFpmmpmm}{\units{\mu F\unitseparator\mm^{-2}}} %micro-Farads per millimeter squared -\newcommand{\uFpcmpcm}{\units{\mu F\unitseparator\cm^{-2}}} %micro-Farads per centimeter squared -\newcommand{\mmolpL}{\units{\mmol\unitseparator L^{-1}}} %milli-moles per Litre -\newcommand{\mmolpLpms}{\units{\mmol\unitseparator L^{-1}\unitseparator\ms^{-1}}} %milli-moles per Litre per millisecond -\newcommand{\mVpms}{\units{\mV\unitseparator\ms^{-1}}} %microvolts per millisecond -\newcommand{\mgpkg}{\units{\mg\unitseparator\kg^{-1}}} % milligram/kilogram - -% -% Base numbers -% -\newcommand{\naturalnums}{\ensuremath{ % - \mathbb{N} % - }} % Natural numbers -\newcommand{\integernums}{\ensuremath{ % - \mathbb{Z} % - }} % Integer numbers -\newcommand{\realnums}{\ensuremath{ % - \mathbb{R} % - }} % Real numbers -\newcommand{\complexnums}{\ensuremath{ % - \mathbb{C} % - }} % Complex numbers -\newcommand{\quaternionnums}{\ensuremath{ % - \mathbb{H} % - }} % Quaternion numbers -\newcommand{\rationalnums}{\ensuremath{ % - \mathbb{Q} % - }} % Rational numbers -\newcommand{\irrationalnums}{\ensuremath{ % - \mathbb{I} % - }} % Irrational numbers - -% -% Sets -% -\newcommand{\union}[2]{\ensuremath{#1\cup#2}} % Union -\newcommand{\intersection}[2]{\ensuremath{#1\cap#2}} % Intersection - -% -% Topologies -% -\newcommand{\rntopology}[1]{\ensuremath{ % - \ifthenelse{\equal{#1}{}}{ % - \realnums}{ % - \realnums^{#1} % - } % - }} % R^n (real) topology -\newcommand{\sntopology}[1]{\ensuremath{ % - \ifthenelse{\equal{#1}{}}{ % - \mathbb{S}}{ % - \mathbb{S}^{#1} % - } % - }} % S^n (spherical) topology -\newcommand{\dntopology}[1]{\ensuremath{ % - \ifthenelse{\equal{#1}{}}{ % - \mathbb{D}}{ % - \mathbb{D}^{#1} % - } % - }} % D^n (discrete) topology - -% -% Commonly-used Math Symbols and operations -% -\newcommand{\brac}[3]{\ensuremath{\left#1 #2 \right#3}} % bracket -\newcommand{\dotprod}[2]{\ensuremath{#1\cdot#2}} % dot product -\newcommand{\doubledotprod}[2]{\ensuremath{#1:#2}} % double dot product -\newcommand{\crossprod}[2]{\ensuremath{#1\times#2}} % cross product -\newcommand{\pbrac}[1]{\brac{(}{#1}{)}} % parenthesis () bracket -\newcommand{\pbracr}[1]{\brac{(}{#1}{.}} % parenthesis ( bracket -\newcommand{\pbracl}[1]{\brac{.}{#1}{)}} % parenthesis ) bracket -\newcommand{\transpose}[1]{\ensuremath{{#1}^{T}}} % transpose -% -\newcommand{\abs}[1]{\brac{|}{#1}{|}} % absolute value -\newcommand{\bbrac}[1]{\brac{\{}{#1}{\}}} % Braces { bracket -\newcommand{\conjugate}[1]{\ensuremath{ % - \overline{#1} % _ - }} %% complex conjugate e.g. \conjugate{Z} => Z -\newcommand{\const}[1]{\ensuremath{\mathrm{#1}}} % constant -\newcommand{\cont}[1]{\ensuremath{C^{#1}}} % continuity e.g. \cont{1} => C1 -\newcommand{\convolution}[2]{\ensuremath{#1*#2}} % convolution e.g. \convolution{a}{b} => a*b -\newcommand{\curl}[1]{\ensuremath{ % - \crossprod{\nabla}{#1} % - }} % curl e.g. \curl{a} => nabla x a -\newcommand{\degree}{\ensuremath{^{\circ}}\xspace} % degree sign -\newcommand{\del}{\ensuremath{\partial}} % partial derivative sign -\newcommand{\diverg}[1]{\ensuremath{ % - \dotprod{\nabla}{#1} % - }} % divergence e.g. \diverg{a} => nabla . a -\newcommand{\dint}{\ensuremath{\displaystyle\int}} % display integral -\newcommand{\dintl}[2]{\ensuremath{ % - \displaystyle\int\limits_{#1}^{#2} % - }} % display integral with limits -\newcommand{\dotover}[1]{\ensuremath{ % - \stackrel{\scriptscriptstyle \bullet}{#1} % - }} % time derivative -\newcommand{\ddotover}[1]{\ensuremath{ % - \stackrel{\scriptscriptstyle \bullet\bullet}{#1} % - }} % double time derivative -\newcommand{\dprod}{\ensuremath{\displaystyle\prod}} % display product -\newcommand{\dprodl}[2]{\ensuremath{ % - \displaystyle\prod_{#1}^{#2} % - }} % display product with limits -\newcommand{\dsum}{\ensuremath{\displaystyle\sum}} % display summation -\newcommand{\dsuml}[2]{\ensuremath{ % - \displaystyle\sum_{#1}^{#2} % - }} % display summation with limits -\newcommand{\evalat}[2]{\ensuremath{ % - \brac{.}{#1}{|}_{#2} % - }} % Evaluation at e.g. \evalat{x}{1} => x|_1 -\newcommand{\factorial}[1]{\ensuremath{\pbrac{#1}!}} % factorial e.g. \factorial{n} => (n)! -\newcommand{\fnof}[2]{\ensuremath{ % - #1\brac{(}{#2}{)} % - }} % function of e.g. \fnof{x}{\xi} => x(xi) -\newcommand{\fntof}[2]{\ensuremath{ % - \transpose{#1}\brac{(}{#2}{)} % - }} % function transpose of e.g. \fntof{x}{\xi} => x^T(xi) -\newcommand{\gegenbauer}[3]{\ensuremath{ % - \fnof{C_{#1}^{#2}}{#3} % - }} % gegenbauer polynomial e.g. \gengenbauer{1}{2}{x} => C_1^2(x) -\newcommand{\genlimit}[2]{\ensuremath{ % - \operatornamewithlimits{\lim}_{#1\rightarrow#2} - }} % general limit e.g. \genlimit{a}{b} => lim a->b -\newcommand{\gint}[4]{\ensuremath{ % - \dintl{#1}{#2}\,#3\,d#4 % - }} % general integral with two limits. e.g. - % \gint{a}{b}{xxx}{c} => int_a^b xxx dc -\newcommand{\giint}[7]{\ensuremath{ % - \dintl{#1}{#2}\!\dintl{#3}{#4}\,#5\,d#6d#7 % - }} % general double integral with two limits. e.g. - % \gint{a}{b}{c}{d}{xxx}{e}{f} => int_a^b int_c^d xxx dedf -\newcommand{\gprod}[3]{\ensuremath{ % - \dprodl{#1}{#2}\,#3 % - }} % general product e.g. \gprod{a}{b}{c} => prod_a^b c -\newcommand{\gsum}[3]{\ensuremath{ % - \dsuml{#1}{#2}\,#3 % - }} % general sum e.g. \gsum{a}{b}{c} => sum_a^b c -\newcommand{\gssum}[5]{\ensuremath{ % - \dsuml{#1}{#2}\dsuml{#3}{#4}\,#5 % - }} % general double sum e.g. \gsum{a}{b}{c}{d}{e} => sum_a^b sum_c^d e -\newcommand{\goneint}[2]{\ensuremath{ % - \gint{#2}{}{#1}{#2} % - }} % general integral with one limit. eg. \goneint{xxx}{a} => int_a xxx da -\newcommand{\gonesum}[2]{\ensuremath{ % - \gsum{#1}{}{#2} % - }} % general sum with one limit e.g. \gonesum{a}{b} => sum_a b -\newcommand{\grad}{\ensuremath{\nabla}} % gradient -\newcommand{\gradsq}{\ensuremath{\nabla^{2}}} % gradient squared -\newcommand{\gradient}[1]{ % - \ensuremath{\grad #1} % - } % gradient e.g. \gradient{u} => \grad u -\newcommand{\innerprod}[2]{\ensuremath{ % - \left<#1,#2\right> % - }} % inner product e.g. \innerprod{a,b} => -\newcommand{\inteval}[3]{\ensuremath{ % - \displaystyle\sqbrac{#1}_{#2}^{#3} % - }} % display evaluated integral with limits e.g. - % \inteval{xxx}{a}{b} => [xxx]_a^b -\newcommand{\inverse}[1]{\ensuremath{{#1}^{-1}}} % inverse e.g. \inverse{A} => A^-1 -\newcommand{\invtranspose}[1]{\ensuremath{{#1}^{-T}}} % inverse transpose e.g. \invtranspose{A} => A^-T -\newcommand{\circcomposition}[2]{\ensuremath{#1\circ#2}} % composition with - % circ e.g. \circcomposition{A}{B} => A o -\newcommand{\funccomposition}[2]{\ensuremath{\fnof{#1}{#2}} % composition with - % function e.g. \funccomposition{A}{B} => A(B) -\newcommand{\composition}[2]{\circcomposition{#1}{#2}}} % composition -\newcommand{\contrakronecker}[2]{\ensuremath{\delta^{{#1}{#2}}}} % - % contravariant kronecker delta tensor e.g., \contrakronecker{i}{j} => delta^{ij} -\newcommand{\covarkronecker}[2]{\ensuremath{\delta_{{#1}{#2}}}} % - % covariant kronecker delta tensor e.g., \contrakronecker{i}{j} => delta_{ij} -\newcommand{\mixedkronecker}[2]{\ensuremath{\delta_{#1}^{#2}}} % - % mixed kronecker delta tensor e.g., \mixedkronecker{i}{j} => delta_{i}^{j} -\newcommand{\kronecker}[2]{\covarkronecker{#1}{#2}} % kronecker delta - % tensor. Default to covariant. -\newcommand{\laplacian}[1]{\ensuremath{\gradsq {#1}}} % laplacian -\newcommand{\legendre}[3]{\ensuremath{\fnof{P_{#1}^{#2}}{#3}}} % Legendre polynomial -\newcommand{\limit}[3]{\ensuremath{ % - \operatornamewithlimits{\lim}_{#1\rightarrow#2} #3 % - }} % limit e.g. \limit{a}{b}{c} => lim a->b c -\newcommand{\limita}[3]{\ensuremath{ % - \operatornamewithlimits{\lim}_{#1\downarrow#2} #3 % - }} % limit from above e.g. \limita{a}{b}{c} => lim a->b c -\newcommand{\limitb}[3]{\ensuremath{ % - \operatornamewithlimits{\lim}_{#1\uparrow#2} #3 % - }} % limit from below e.g. \limita{a}{b}{c} => lim a->b c -\newcommand{\lnorm}[2]{\ensuremath{ % - {\brac{\|}{#2}{\|}_{#1}} % - }} % l-n norm e.g. \lnorm{x}{3} => ||x||_3 -\newcommand{\mapping}[3]{\ensuremath{#1:#2\rightarrow#3}} % mapping - % e.g. \mapping{a}{b}{c} => a:b->c -\newcommand{\nth}[1]{\ensuremath{{#1}^{\text{th}}}} % ^th e.g. \nth{n} => n^th -\newcommand{\orderof}[1]{\ensuremath{\fnof{\mathrm{O}}{#1}}} % order e.g. O(n) -\newcommand{\pochhammer}[2]{\ensuremath{ % - \pbrac{#1}_{#2} % -}} % Pochhammer polynomial e.g. \pochhammer{a}{n} => (a)_n n.b. (a)_n = -% (a,n) where (a,n) is Appell's symbol. -\newcommand{\sphericalharmonic}[4]{\ensuremath{% - \fnof{Y_{{#1}{#2}}^{#3}}{#4} % -}} % Spherical harmonic e.g. \sphericalharmonic{a}{b}{c}{d} => Y_ab^c(d) -\newcommand{\set}[1]{\ensuremath{ - \bbrac{#1} -}} % e.g. \set{1,2,3} => {1,2,3} -\newcommand{\sqbrac}[1]{\brac{[}{#1}{]}} % square [ bracket -\newcommand{\symover}[2]{\ensuremath{ - \stackrel{\scriptscriptstyle #1}{#2} % -}} % over -\newcommand{\tento}[1]{\ensuremath{ % - 10^{#1} % -}} % e.g. \tento{3} ten to the power of 3 -\newcommand{\ttento}[1]{\ensuremath{ % - \times \tento{#1} % - }\xspace} % e.g. \ttento{5} => times ten the power of 5 -\newcommand{\nttento}[2]{\ensuremath{ % - #1\ttento{#2} % - }} % number times ten to power e.g. \nttento{2}{3} => 2 x 10^3 -% -% Fractions -% -%\newcommand{\dfrac}[2]{\ensuremath{ % -% \dfrac{\displaystyle #1}{\displaystyle #2} % -% }} % display fraction -\newcommand{\dby}[2]{\ensuremath{ % - \dfrac{ d #1}{d #2} % - }} % e.g. \dby{u}{v} => d u / d v -\newcommand{\Dby}[2]{\ensuremath{ % - \dfrac{ D #1}{D #2} % - }} % e.g. \Dby{u}{v} => D u / D v i.e. the full derivative -\newcommand{\dtwoby}[3]{\ensuremath{ % - \dfrac{ d^{2} #1}{d #2 d #3} % - }} % e.g. \dtwoby{u}{x}{y} => d^2 u / d x d y -\newcommand{\dtwosqby}[2]{\ensuremath{ % - \dfrac{ d^{2} #1}{d {#2}^{2}} % - }} % e.g. \dtwosqby{u}{x} => d^2 u / d x^2 -\newcommand{\dthreeby}[4]{\ensuremath{ % - \dfrac{ d^{3} #1}{d #2 d #3 d #4} % - }} % e.g. \dthreeby{u}{x}{y}{z} => d^2 u / d x d y d z -\newcommand{\dnby}[3]{\ensuremath{ % - \dfrac{ d^{#1} #2}{d {#3}^{#1}} % - }} % e.g. \dnby{3}{u}{v} => d^3 u / d v^3 -\newcommand{\dntwoby}[6]{\ensuremath{ % - \dfrac{ d^{#1} #2}{d {#3}^{#4} d {#5}^{#6}} % - }} % e.g. \dntwoby{3}{u}{x}{1}{y}{2} => d^3 u / d x d y^2 -\newcommand{\delby}[2]{\ensuremath{ % - \dfrac{\del #1}{\del #2} % - }} % e.g. \delby{u}{v} => del u / del v -\newcommand{\deltwoby}[3]{\ensuremath{ % - \dfrac{\del^{2} #1}{\del #2 \del #3} % - }} % e.g. \delnby{u}{x}{y} => del^2 u / del x del y -\newcommand{\deltwosqby}[2]{\ensuremath{ % - \dfrac{\del^{2} #1}{\del {#2}^{2}} % - }} % e.g. \delnby{u}{x} => del^2 u / del x^2 -\newcommand{\delthreeby}[4]{\ensuremath{ % - \dfrac{ \del^{3} #1}{\del #2 \del #3 \del #4} % - }} % e.g. \delthreeby{u}{x}{y}{z} => del^3 u / del x del y del z -\newcommand{\delthreecuby}[2]{\ensuremath{ % - \dfrac{ \del^{3} #1}{\del #2^{3}} % - }} % e.g. \delthreecuby{u}{x} => del^3 u / del x^3 -\newcommand{\deldeltwoby}[3]{\ensuremath{ % - \dfrac{ \del^{3} #1}{\del #2 \del #3^{2}} % - }} % e.g. \deldeltwoby{u}{x}{y} => del^3 u / del x del y^2 -\newcommand{\deltwodelby}[3]{\ensuremath{ % - \dfrac{ \del^{3} #1}{\del #2^{2} \del #3} % - }} % e.g. \deltwodelby{u}{x}{y} => del^3 u / del x^2 del y -\newcommand{\delnby}[3]{\ensuremath{ % - \dfrac{\del #1}{\del #2} % - }} % e.g. \delnby{3}{u}{v} => del^3 u / del v^3 -\newcommand{\delntwoby}[6]{\ensuremath{ % - \dfrac{ \del^{#1} #2}{\del {#3}^{#4} \del {#5}^{#6}} % - }} % e.g. \delntwoby{3}{u}{x}{1}{y}{2} => del^3 u / del x del y^2 -\newcommand{\hdby}[2]{ % - \dby{}{#2}\pbrac{#1} % - } % horizontal dby e.g. \hdby{u}{x} => d/dx (u) -\newcommand{\hdtwoby}[3]{ % - \dtwoby{}{#2}{#3}\pbrac{#1} % - } % horizontal dtwoby e.g. \hdtwoby{u}{x}{y} => d/dxdy (u) -\newcommand{\hdtwosqby}[2]{ % - \dtwosqby{}{#2}\pbrac{#1} % - } % horizontal dtwosqby e.g. \hdtwosqby{u}{x} => d^2/dx^2 (u) -\newcommand{\hdthreesqby}[4]{ % - \dthreeby{}{#2}{#3}{#4}\pbrac{#1} % - } % horizontal dthreeby e.g. \hdthreeby{u}{x}{y}{z} => d^3/dxdydz (u) -\newcommand{\hdnby}[3]{ % - \dnby{#1}{}{#3}\pbrac{#2} % - } % horizontal dnby e.g. \hdnby{3}{u}{x} => d^3/dx^3 (u) -\newcommand{\hdntwoby}[6]{ % - \dntwoby{#1}{}{#3}{#4}{#5}{#6}\pbrac{#2} % - } % horizontal dntwoby e.g. \hdntwoby{3}{u}{x}{1}{y}{2} => d^3/dx^1dy^2 (u) -\newcommand{\hdelby}[2]{ % - \delby{}{#2}\pbrac{#1} % - } % horizontal delby e.g. \hdelby{u}{x} => del/del x (u) -\newcommand{\hdeltwoby}[3]{ % - \deltwoby{}{#2}{#3}\pbrac{#1} % - } % horizontal deltwoby e.g. \hdeltwoby{u}{x}{y} => del/del x del y (u) -\newcommand{\hdeltwosqby}[2]{ % - \deltwosqby{}{#2}\pbrac{#1} % - } % horizontal deltwosqby e.g. \hdeltwosqby{u}{x} => del^2/del x^2 (u) -\newcommand{\hdelthreesqby}[4]{ % - \delthreeby{}{#2}{#3}{#4}\pbrac{#1} % - } % horizontal delthreeby e.g. \hdelthreeby{u}{x}{y}{z} => - % del^3/del x del y del z (u) -\newcommand{\hdelnby}[3]{ % - \delnby{#1}{}{#3}\pbrac{#2} % - } % horizontal delnby e.g. \hdelnby{3}{u}{x} => del^3/del x^3 (u) -\newcommand{\hdelntwoby}[6]{ % - \delntwoby{#1}{}{#3}{#4}{#5}{#6}\pbrac{#2} % - } % horizontal delntwoby e.g. \hdelntwoby{3}{u}{x}{1}{y}{2} => - % del^3/del x^1 del y^2 (u) -% -% Differential Geometry -% - -\newcommand{\manifold}[1]{\ensuremath{ % - \mathfrak{#1} % - }} % manifold symbol -\newcommand{\boundary}[1]{\ensuremath{ % - \del{#1} % - }} % boundary symbol -\newcommand{\embedmanifold}[1]{\ensuremath{ % - \mathcal{#1} % - }} % embedded manifold symbol -\newcommand{\coordspacesymbol}{\ensuremath{ % - \mathcal{C} % - }} % Coordinate space symbol => C -\newcommand{\tangentspacesymbol}{\ensuremath{ % - \mathcal{T} % - }} % Tangent space symbol => T -\newcommand{\cotangentspacesymbol}{\ensuremath{ % - \tangentspacesymbol^{*} % - }} % Cotangent space symbol => T^* -\newcommand{\coordspace}[2]{\ensuremath{ % - \coordspacesymbol_{#2} \manifold{#1} % - }} % Coordinate space e.g., \coordspace{M}{p} => C_p M -\newcommand{\tangentspace}[2]{\ensuremath{ % - \tangentspacesymbol_{#2} \manifold{#1} % - }} % Tangent space e.g., \tangentspace{M}{p} => T_p M -\newcommand{\cotangentspace}[2]{\ensuremath{ % - \cotangentspacesymbol_{#2} \manifold{#1} % - }} % Cotangent space e.g., \cotangentspace{M}{p} => T_p^* M -\newcommand{\coordbundle}[1]{\ensuremath{ % - \coordspacesymbol \manifold{#1} % - }} % Coordinate bundle e.g., \coordbundle{M} => CM -\newcommand{\tangentbundle}[1]{\ensuremath{ % - \tangentspacesymbol \manifold{#1} % - }} % Tangent bundle e.g., \tangentbundle{M} => TM -\newcommand{\cotangentbundle}[1]{\ensuremath{ % - \cotangentspacesymbol \manifold{#1} % - }} % Cotangent bundle e.g., \cotangentbundle{M} => T^*M - -\newcommand{\christoffel}[3]{\christoffelsecond{#1}{#2}{#3}} % Christoffel symbol - % (defaults to Christoffel symbol of the - % second kind) -\newcommand{\christoffelfirst}[3]{\ensuremath{ % - \Gamma_{#1#2#3} - }} % Christoffel symbol of the first kind e.g. \christoffelfirst{i}{j}{k} => Gamma_{ijk} -\newcommand{\christoffelsecond}[3]{\ensuremath{ % - \Gamma^{#1}_{#2#3} - }} % Christoffel symbol of the second kind e.g. \christoffelsecond{i}{j}{k} => Gamma^{i}_{jk} -\newcommand{\partialderiv}[2]{\ensuremath{ - {#1}_{,#2} - }} % partial derivative. e.g., \partialderiv{i}{j} => i_{,j} -\newcommand{\covarpartialderiv}[2]{\ensuremath{ % - {#1}_{,#2} - }} % covariant partial derivative e.g. \convarpartialderiv{i}{j} => i_{,j} -\newcommand{\contrapartialderiv}[2]{\ensuremath{ % - {#1}^{,#2} - }} % contravariant partial derivative e.g. \contrapartialderiv{i}{j} => i^{,j} -\newcommand{\covarderiv}[2]{\ensuremath{ % - {#1}_{;#2} - }} % covariant derivative e.g. \covarderiv{i}{j} => i_{;j} -\newcommand{\mixedderiv}[3]{\ensuremath{ % - \brac{.}{#1}{|}^{#2}_{#3} - }} % mixed derivative e.g. \mixedderiv{i}{j}{k} => i | ^{j}_{k} -\newcommand{\exteriorderiv}[2]{\ensuremath{ % - \boldsymbol{d}#1 - }} % Exterior derivative e.g., \exteriorderiv{a} => da -% cpb 19/9/96 Changing from \mathbf to \boldsymbol to allow bold greek tensors -%\newcommand{\tensor}[1]{\ensuremath{\mathbf{#1}}} % tensor -\newcommand{\tensor}[1]{\ensuremath{\boldsymbol{#1}}} % tensor -\newcommand{\covartensor}[3]{\ensuremath{{#1}_{#2#3}}} % covariant tensor -\newcommand{\contratensor}[3]{\ensuremath{{#1}^{#2#3}}} % contravariant tensor -\newcommand{\mixedtensor}[3]{\ensuremath{{#1}_{#2}^{#3}}} % mixed tensor -\newcommand{\vectr}[1]{\ensuremath{\boldsymbol{#1}}} % vector -\newcommand{\covectr}[1]{\ensuremath{\boldsymbol{#1}}} % covector -\newcommand{\tensorproduct}[2]{\ensuremath{ % - #1 \otimes #2 % - }} % tensor product e.g., \tensorproduct{a}{b} => a x b. -\newcommand{\wedgeproduct}[2]{\ensuremath{ % - #1 \wedge #2 % - }} % wedge product e.g., \wedgeproduct{a}{b} => a^b. -\newcommand{\exteriorproduct}[2]{\ensuremath{ % - \wedgeproduct{#1}{#2} % - }} % exterior product e.g., \exteriorproduct{a}{b} => a^b. - -% -% Matrices and vectors -% -% cpb 19/9/96 Changing from \mathbf to \boldsymbol to allow bold greek matrices -%\newcommand{\matr}[1]{\ensuremath{\uppercase{\mathbf{#1}}}} % matrix -\newcommand{\matr}[1]{\ensuremath{\uppercase{\boldsymbol{#1}}}} % matrix -% cpb 19/9/96 Changing from \mathbf to \boldsymbol to allow bold greek vectors -\newcommand{\vect}[1]{\ensuremath{\lowercase{\boldsymbol{#1}}}} % vector -\newcommand{\norm}[1]{\lnorm{2}{#1}} % normalise i.e. l-2 norm -\newcommand{\normal}{\vectr{n}} % normal - -% -% Basis functions and interpolation -% -\newcommand{\nodept}[2]{\ensuremath{ % - {#1}^{#2} % - }} % Nodal point (without derivative) e.g., \nodept{\psi}{n}=> nodal dof of \psi at node n. -\newcommand{\nodedof}[3]{\ensuremath{ % - \nodept{#1}{#2}_{,#3} % -}} % Nodal DOF e.g., \nodedof{\psi}{n}{u} => nodal dof of \psi at node n - % derivative u. -\newcommand{\idxnodedof}[4]{\ensuremath{ % - \nodept{#1}{#3}_{#2,#4} % -}} % Indexed nodal DOF e.g., \nodedof{\psi}{i}{n}{u} => nodal dof of ith - % component of \psi at node n derivative u. -\newcommand{\elementdof}[2]{\ensuremath{ % - #1_{#2} % -}} % Element DOF e.g., \elementdof{\psi}{e} => element dof of \psi at element e -\newcommand{\chbfnsymb}[2]{\ensuremath{ % - \Psi_{#1}^{#2} % - }} % Cubic Hermite basis function symbol -\newcommand{\chbfn}[3]{\ensuremath{ % - \fnof{\chbfnsymb{#1}{#2}}{#3} % - }} % \chbfn{n}{u}{xi} => cubic Hermite basis function at node n deriv u - % evaluated at xi -\newcommand{\hsonebfnsymb}[1]{\ensuremath{ % - \zeta_{#1} % - }} % Hermite sector 1 basis function symbol -\newcommand{\hsonebfn}[2]{\ensuremath{ % - \fnof{\hsonebfnsymb{#1}}{#2} % - }} % \hsonebfn{n}{xi} => Hermite sector 1 basis function at node n - % evaluated at xi -\newcommand{\hsthreebfnsymb}[1]{\ensuremath{ % - \eta_{#1} % - }} % Hermite sector 3 basis function symbol -\newcommand{\hsthreebfn}[2]{\ensuremath{ % - \fnof{\hsthreebfnsymb{#1}}{#2} % - }} % \hsonebfn{n}{xi} => Hermite sector 3 basis function at node n - % evaluated at xi -\newcommand{\lbfnsymb}[1]{\ensuremath{ % - \varphi_{#1} % - }} % Lagrange basis function symbol -\newcommand{\lbfn}[2]{\ensuremath{ % - \fnof{\lbfnsymb{#1}}{#2} % - }} % \lbfn{n}{xi} => Lagrange basis function at node n evaluated at xi -\newcommand{\sbfnsymb}[1]{\ensuremath{ % - N_{#1} % - }} % Simplex basis function symbol -\newcommand{\sbfn}[2]{\ensuremath{ % - \fnof{\sbfnsymb{#1}}{#2} % - }} % \sbfn{n}{xi} => Simplex basis function at node n evaluated at xi -\newcommand{\gbfnsymb}[2]{\ensuremath{ % - \psi_{#1}^{#2} % - }} % Generic basis function symbol -\newcommand{\idxgbfnsymb}[3]{\ensuremath{ % - \psi_{#1#2}^{#3} % - }} % Indexed generic basis function symbol -\newcommand{\gbfn}[3]{\ensuremath{ % - \fnof{\gbfnsymb{#1}{#2}}{#3} % - }} % \gbfn{n}{i}{xi} => Generic bais function at n,i evaluated at xi -\newcommand{\idxgbfn}[4]{\ensuremath{ % - \fnof{\idxgbfnsymb{#1}{#2}{#3}}{#4} % - }} % \gbfn{j}{n}{i}{xi} => Indexed j'th generic bais function at n,i evaluated at xi -\newcommand{\esfsymb}{\ensuremath{ % - S % - }} % Element scale factor symbol -\newcommand{\esfone}[1]{\ensuremath{ % - \fnof{\esfsymb}{{#1}} % - }} % \esfone{e} => Element scale factor in one direction in element e -\newcommand{\esftwo}[2]{\ensuremath{ % - \fnof{\esfsymb}{#1,#2} % - }} % \esftwo{e}{i} => Element scale factor in two directions in element e - % and xi direction i -\newcommand{\gsfsymb}{\ensuremath{ % - \mathrm{S} % - }} % Generic scale factor symbol -\newcommand{\gsf}[2]{\ensuremath{ % - \fnof{\gsfsymb}{#1,#2} % - }} % \gsf{n}{i} => Generic scale factor in at position n,i -\newcommand{\idxgsf}[3]{\ensuremath{ % - \fnof{\gsfsymb}{#1,#2,#3} % - }} % \gsf{j}{n}{i} => Generic scale factor in at position n,i for the j'th - % component idx -\newcommand{\nsfsymb}{\ensuremath{ % - \mathcal{S} % - }} % Nodal scale factor symbol -\newcommand{\nsfone}[1]{\ensuremath{ % - \fnof{\nsfsymb}{#1} % - }} % \nsfone{n} => Nodal scale factor in one direction at node n -\newcommand{\nsftwo}[2]{\ensuremath{ % - \fnof{\nsfsymb}{#1,#2} % - }} % \nsftwo{n}{i} => Nodal scale factor in two directions at node n and xi - % direction i -\newcommand{\xione}{\ensuremath{\xi_{1}}\xspace} % xi 1 -\newcommand{\xitwo}{\ensuremath{\xi_{2}}\xspace} % xi 2 -\newcommand{\xithree}{\ensuremath{\xi_{3}}\xspace} % xi 3 - - -%%% Local Variables: -%%% mode: latex -%%% TeX-master: t -%%% End: diff --git a/doc/latex/references.tex b/doc/latex/references.tex deleted file mode 100755 index 6f6e7561..00000000 --- a/doc/latex/references.tex +++ /dev/null @@ -1,12 +0,0 @@ -\clearemptydoublepage -\addcontentsline{toc}{chapter}{\numberline{}References} - -\renewcommand{\bibname}{References} - -\bibliographystyle{agsm} -\bibliography{/data/OpenCMISS/src/iron/doc/references/references} - -%%% Local Variables: -%%% mode: latex -%%% TeX-master: -%%% End: diff --git a/doc/latex/shell.tex b/doc/latex/shell.tex deleted file mode 100755 index 57c7019a..00000000 --- a/doc/latex/shell.tex +++ /dev/null @@ -1,21 +0,0 @@ -\documentclass[12pt,dvips]{article} - -\input{/data/OpenCMISS/src/iron/doc/latex/macros} %define new commands etc. -\input{/data/OpenCMISS/src/iron/doc/latex/defns} %define pagesetup and std. packages etc. - -\usepackage{times} %use the times font - -\title{} -\author{} - -\begin{document} - -\maketitle - -\begin{abstract} - -\end{abstract} - -\section{Introduction} - -\end{document} diff --git a/doc/latex/shell_article.tex b/doc/latex/shell_article.tex deleted file mode 100755 index f257eff4..00000000 --- a/doc/latex/shell_article.tex +++ /dev/null @@ -1,23 +0,0 @@ -%\documentclass[12pt,dvips]{article} - -\input{/data/OpenCMISS/src/iron/doc/latex/macros} %define new commands etc. -\input{/data/OpenCMISS/src/iron/doc/latex/defns} %define pagesetup and std. packages etc. - -\usepackage{times} %use the times font - -\title{} -\author{} -\date{} - -\begin{document} - -\maketitle - -\begin{abstract} -\end{abstract} - -\section{Introduction} -\section{Findings} -\section{Conclusions} - -\end{document} diff --git a/doc/latex/shell_book.tex b/doc/latex/shell_book.tex deleted file mode 100755 index dc860b59..00000000 --- a/doc/latex/shell_book.tex +++ /dev/null @@ -1,29 +0,0 @@ -\documentclass[12pt,twoside,a4paper]{book} - -\input{/data/OpenCMISS/src/iron/doc/latex/macros} %define new commands etc. -\input{/data/OpenCMISS/src/iron/doc/latex/defns} %define pagesetup and std. packages etc. - -\usepackage{times} %use the times font -\makeindex - -\title{} -\author{} -\date{} - -\begin{document} - -\maketitle -\tableofcontents -\listoffigures -\listoftables - -\include{chapter1/intro} %input from chapter1/intro.tex -\clearemptydoublepage -\include{chapter2/theory} %input from chapter2/theory.tex -\clearemptydoublepage -\include{chapter3/results} %input from chapter3/results.tex -\clearemptydoublepage -\include{references} -\clearemptydoublepage -\printindex -\end{document} diff --git a/doc/latex/shell_letter.tex b/doc/latex/shell_letter.tex deleted file mode 100755 index 1b2a381f..00000000 --- a/doc/latex/shell_letter.tex +++ /dev/null @@ -1,30 +0,0 @@ -\documentclass[12pt,dvips]{letter} - -\input{/data/OpenCMISS/src/iron/doc/latex/macros} %define new commands etc. -\input{/data/OpenCMISS/src/iron/doc/latex/defns} %define pagesetup and std. packages etc. -\usepackage{times} %use the times font - -\begin{document} - - \address - { - Name \\ - email @auckand.ac.nz - Auckland Bioengineering Institute \\ - The University of Auckland \\ - } - \begin{letter} - { - To whom your writing to \\ - Their address\\ - } - - \opening{Dear Bob} - - Main body of text - - \signature{Your name again} - \closing {Yours sincerely \etc} - \end{letter} - -\end{document} diff --git a/doc/latex/shell_report.tex b/doc/latex/shell_report.tex deleted file mode 100755 index 49cf0571..00000000 --- a/doc/latex/shell_report.tex +++ /dev/null @@ -1,34 +0,0 @@ -\documentclass[12pt,dvips]{report} - -\input{/data/OpenCMISS/src/iron/doc/latex/macros} %define new commands etc. -\input{/data/OpenCMISS/src/iron/doc/latex/defns} %define pagesetup and std. packages etc. - -\usepackage{times} %use the times font - -\title{} -\author{} -\date{} - -\begin{document} - -\maketitle -\tableofcontents - -\chapter{The first chapter} -\section{} -\subsection{} - -\chapter{Other chapter} - -\appendix -\chapter{Some proofs} - -%the reference section - -\addcontentsline{toc}{chapter}{\numberline{}References} -\bibliographystyel{agsm} -\bibliography{/data/OpenCMISS/src/iron/doc/references/references} -\printindex -\end{document} - - diff --git a/doc/notes/EquationSets/ElasticityClass/FiniteElasticity.tex b/doc/notes/EquationSets/ElasticityClass/FiniteElasticity.tex deleted file mode 100755 index dbbe619d..00000000 --- a/doc/notes/EquationSets/ElasticityClass/FiniteElasticity.tex +++ /dev/null @@ -1,878 +0,0 @@ - -\subsection{Finite Elasticity} -\label{subsec:FiniteElasticity} - -%Deformation can be viewed three ways: A point to point transformation; A -%coordinate transformation; or as a transformation of metrics (convected coordinates). - -\subsubsection{Kinematics} - -As shown in \figref{fig:configurationsetting}, consider a \textit{material - body} which is a three-dimensional smooth manifold with a boundary, $\manifold{B}$, -which consists of a set of points which are refered to as \textit{material - points}. Consider also an ambient space manifold, -$\manifold{S}\in\rntopology{n}$. The material body is only accessible to -the observer when it moves through the ambient space. This motion is a -time-dependent embedding on the material body into the ambient space. The -embedding is known as a \textit{placement of the body}. It is given by the -mapping -\begin{equation} - \mapping{\fnof{\kappa}{\mathcal{X},t}}{\manifold{B}}{\manifold{S}} -\end{equation} - -The embedded submanifold occupying a location in the ambient space is is -called a \textit{configuration} of $\manifold{B}$ and is given by -\begin{equation} - \embedmanifold{B}_{t}=\fnof{\kappa_{t}}{\manifold{B}}=\fnof{\kappa}{\manifold{B},t} -\end{equation} - -The customary (but not necessary) \textit{reference placement} is given by -\begin{equation} - \mapping{\kappa_{0}}{\manifold{B}}{\manifold{S}} -\end{equation} -and the region of space occupied by the reference placement \ie the -\textit{reference configuration} is given by -\begin{equation} - \embedmanifold{B}_{0}=\fnof{\kappa_{0}}{\manifold{B}} -\end{equation} -Points in $\embedmanifold{B}_{0}$ are denoted by capital letters \ie $X, Y, -\ldots$. Points in $\embedmanifold{B}$ are denoted by lower case leters \ie -$x, y, \dots$. - -\epstexfigure{svgs/EquationSets/Elasticity/FiniteElasticity/setup.eps_tex}{}{}{fig:configurationsetting}{0.75} - -A new configuration of $\manifold{B}$ is given by the deformation mapping -\begin{equation} - \mapping{\chi}{\embedmanifold{B}}{\rntopology{3}} -\end{equation} -where a configuration represents a deformed state of the body. As the body -moves we obtain a family of configurations. If we hold $X\in\embedmanifold{B}$ -fixed can write $\fnof{V_{t}}{X}=\fnof{V}{X,t}$. We then have -\begin{equation} - \fnof{V_{t}}{X}=\fnof{V}{X,t}=\delby{\fnof{\chi}{X,t}}{t}=\dby{\fnof{\chi_{X}}{t}}{t} -\end{equation} - -Here $V_{t}$ is called the \textit{material velocity} of the motion. The -\textit{material acceleration} of the body is defined as -\begin{equation} - \fnof{A_{t}}{X}=\fnof{A}{X,t}=\delby{\fnof{V}{X,t}}{t}=\dby{\fnof{V_{X}}{t}}{t} -\end{equation} - -The \textit{spatial velocity} of the motion is defined by $v_{t}$ and the -\textit{spatial acceleration} of the motion is defined by $a_{t}$. - -\subsubsection{Deformation Gradient} - -Let -$\mapping{\chi}{\embedmanifold{B}_{0}}{\fnof{\chi}{\embedmanifold{B}_{0}}\subset\manifold{S}}$ -be a deformation configuration of $\embedmanifold{B}$ in $\manifold{S}$. The -tangent of the mapping \ie $\tangentbundle{\chi}$ is denoted as $\tensor{F}$ -and is called the \textit{deformation gradient} of $\chi$ \ie -$\tensor{F}=\tangentbundle{\chi}$. For $X\in\embedmanifold{B}$ we have -\begin{equation} - \tensor{F}_{X}=\mapping{\fnof{\tensor{F}}{X}}{\tangentspace{\embedmanifold{B}}{X}}{\tangentspace{\manifold{S}}{\fnof{\chi}{X}}} -\end{equation} - -If $X^{A}$ and $x^{a}$ are the coordinates on $\embedmanifold{B}$ and -$\manifold{S}$ then the deformation gradient tensor with respect to the -coordinate bases are -\begin{equation} - \fnof{F^{a}_{A}}{X}=\delby{\fnof{\chi^{a}}{X}}{X^{A}} -\end{equation} - -Note that $\tensor{F}$ is a two-point tensor. - -The \textit{right Cauchy-Green (or Green) deformation tensor}, $\tensor{C}$, is defined by -\begin{equation} - \mapping{\fnof{\tensor{C}}{X}}{\tangentspace{\embedmanifold{B}}{X}}{\tangentspace{\embedmanifold{B}}{X}} -\end{equation} -as the pullback of the spatial metric tensor \ie $\fnof{\tensor{C}}{X}=\transpose{\fnof{\tensor{F}}{X}}\fnof{\tensor{g}}{x}\fnof{\tensor{F}}{X}$ -or $\tensor{C}=\transpose{\tensor{F}}\tensor{g}\tensor{F}$ where $x=\fnof{\chi}{X}$. In terms of coordinates we -have -\begin{equation} - C_{AB}=g_{ab}F^{a}_{A}F^{b}_{B} -\end{equation} - -If $\tensor{C}$ is invertible we also have $\tensor{B}=\inverse{\tensor{C}}$ -called the \textit{Piola deformation tensor}. - -The \textit{left Cauchy-Green (or Finger) deformation tensor}, $\tensor{b}$, is defined by -\begin{equation} - \mapping{\fnof{\tensor{b}}{x}}{\tangentspace{\fnof{\chi}{\embedmanifold{B}}}{x}}{\tangentspace{\fnof{\chi}{\embedmanifold{B}}}{x}} -\end{equation} -as the push forward of the material metric tensor \ie $\fnof{\tensor{b}}{x}=\fnof{\tensor{F}}{X}\fnof{\tensor{G}}{X}\transpose{\fnof{\tensor{F}}{X}}$ -or $\tensor{b}=\tensor{F}\tensor{G}\transpose{\tensor{F}}$ where $X=\fnof{\inverse{\chi}}{x}$. In terms of coordinates we -have -\begin{equation} - b^{ab}=G^{AB}F^{a}_{A}F^{b}_{B} -\end{equation} - -We also have $\tensor{c}=\inverse{\tensor{b}}$. - -The polar decomposition - -\begin{diagram} - & & \tangentspace{B}{X} & & \\ - & \ruTo^{\tensor{U}} & & \rdTo^{\tensor{R}} \\ -\tangentspace{B}{X} & & \rTo^{\tensor{F}} & & \tangentspace{S}{x}\\ - & \rdTo_{\tensor{R}} & & \ruTo_{\tensor{V}} \\ - & & \tangentspace{S}{x} & & -\end{diagram} - - -If we let the deformed coordinates be given by the position vector, -$\fnof{\vectr{z}}{\vectr{x},t}$ then the deformation gradient tensor with -respect to the undeformed $\vectr{X}$ coordinates is given by -\begin{equation} - \fnof{\tensor{F}}{\vectr{X}}=\delby{\vectr{z}}{\vectr{X}} -\end{equation} -or, in component form, -\begin{equation} - F^{i}_{M}=\delby{z^{i}}{X^{M}}=\delby{z^{i}}{\xi^{k}}\delby{\xi^{k}}{X^{M}} -\end{equation} - -In order to deal with anisotropy we wish to base our stress and strain -calculation on fibre, $\vectr{\nu}$, coordinates. To change our reference -coordinate system from $\vectr{X}$ to $\vectr{\nu}$ we need to transform -$\fnof{\tensor{F}}{\vectr{X}}$. As $\fnof{\tensor{F}}{\vectr{X}}$ is a two point tensor the transformation -rule for transforming just the reference coordinates is given by -\begin{equation} -\fnof{\tensor{F}}{\vectr{\nu}}=\tensor{Q}\fnof{\tensor{F}}{\vectr{X}} -\end{equation} -where $\tensor{Q}$ is the rotation matrix from $\vectr{X}$ to $\vectr{\nu}$ \ie -\begin{equation} - F^{i}_{A}=\delby{X^{M}}{\nu^{A}}F^{i}_{M}=\delby{X^{M}}{\nu^{A}}\delby{z^{i}}{\xi^{k}}\delby{\xi^{k}}{X^{M}} -\end{equation} - -To allow for growth we use a multiplicative decomposition approach \ie -\begin{equation} - \fnof{\tensor{F}}{\vectr{\nu}}=\fnof{\tensor{F}_{e}}{\vectr{\nu}}\fnof{\tensor{F}_{g}}{\vectr{\nu}} -\end{equation} -where $\fnof{\tensor{F}_{g}}{\vectr{\nu}}$ is the growth tensor with -respect to fibre coordinates and $\fnof{\tensor{F}_{e}}{\vectr{\nu}}$ is the -elastic component of the deformation gradient tensor in fibre coordinates. - -The elastic component of the deformation gradient tensor can be calculated -from -\begin{equation} - \fnof{\tensor{F}_{e}}{\vectr{\nu}}=\fnof{\tensor{F}}{\vectr{\nu}}\fnof{\inverse{\tensor{F}_{g}}}{\vectr{\nu}} -\end{equation} - -In component form we have -\begin{equation} - F^{i}_{A}=\pbrac{F_{e}}^{i}_{B}\pbrac{F_{g}}^{B}_{A} -\end{equation} -and -\begin{equation} - \pbrac{F_{e}}^{i}_{B}=F^{i}_{A}\pbrac{\inverse{F_{g}}}^{A}_{B} -\end{equation} - -The Jacobian of the growth component of the deformation is given by -$J_{g}=\det{\fnof{\tensor{F}_{g}}{\vectr{\nu}}}$ and the Jacobian of the -elastic component of the deformation is given by -$J_{e}=\det{\fnof{\tensor{F}_{e}}{\vectr{\nu}}}$. - -The right Cauchy Green deformation tensor in fibre coordinates is now given by -the pullback of the current configuration metric tensor, $\tensor{g}$, -\begin{equation} - \fnof{\tensor{C}}{\vectr{\nu}}=\fnof{\transpose{\tensor{F}_{e}}}{\vectr{\nu}}\tensor{g}\fnof{\tensor{F}_{e}}{\vectr{\nu}} -\end{equation} -and the Lagrange strain tensor is given by the difference in metric tensors -\begin{equation} - \fnof{\tensor{E}}{\vectr{\nu}}=\frac{1}{2}\pbrac{\fnof{\tensor{C}}{\vectr{\nu}}-\tensor{G}} -\end{equation} - -In component form we have -\begin{equation} - C_{AB}=g_{ij}\pbrac{F_{e}}^{i}_{A}\pbrac{F_{e}}^{j}_{B} -\end{equation} -and -\begin{equation} - E_{AB}=\frac{1}{2}\pbrac{C_{AB}-G_{AB}} -\end{equation} - -The constituative law can then be used to derive the second Piola Kirchhoff -stress tensor in fibre coordinates, $\fnof{\tensor{T}}{\vectr{\nu}}$, from -either the right Cauchy-Green deformation tensor or the Green-Lagrange strain -tensor \ie -\begin{equation} - \fnof{\tensor{T}}{\vectr{\nu}}=2\delby{\fnof{W}{\fnof{\tensor{C}}{\vectr{\nu}}}}{\fnof{\tensor{C}}{\vectr{\nu}}} -\end{equation} -or -\begin{equation} - \fnof{\tensor{T}}{\vectr{\nu}}=\delby{\fnof{W}{\fnof{\tensor{E}}{\vectr{\nu}}}}{\fnof{\tensor{E}}{\vectr{\nu}}} -\end{equation} -where $\fnof{W}{\fnof{\tensor{C}}{\vectr{\nu}}}$ or -$\fnof{W}{\fnof{\tensor{E}}{\vectr{\nu}}}$ is the strain energy -function. In component form we have -\begin{equation} - T^{AB}=2\delby{W}{C_{AB}} -\end{equation} -or -\begin{equation} - T^{AB}=\delby{W}{E_{AB}} -\end{equation} - -Because $\tensor{C}$ is symmetric then we can deal with the invariants. The -three invariants are -\begin{equation} - \begin{split} - I_{1} &= \operatorname{tr}\tensor{C} \\ - &= C_{11} + C_{22} + C_{33} \\ - I_{2} &= - \dfrac{1}{2}\pbrac{\pbrac{\operatorname{tr}\tensor{C}}^{2}-\operatorname{tr}\tensor{C}^{2}} \\ - &= - \dfrac{1}{2}\left(\pbrac{C_{11}+C_{22}+C_{33}}^{2}\right. \\ - & \quad\left.-\pbrac{C_{11}^{2}+C_{12}C_{21}+C_{13}C_{31}+ - C_{21}C_{12}+C_{22}^{2}+C_{23}C_{32}+C_{31}C_{13}+C_{32}C_{23}+C_{33}^{2}}\right) \\ - I_{3} &= \det{\tensor{C}} \\ - &=C_{11}C_{22}C_{33}+C_{12}C_{23}C_{31}+C_{13}C_{21}C_{32}\\ - &\quad-C_{13}C_{22}C_{31}-C_{12}C_{21}C_{33}-C_{11}C_{23}C_{32} - \end{split} -\end{equation} -We thus have -$\fnof{W}{\fnof{\tensor{C}}{\vectr{\nu}}}=\fnof{W}{I_{1},I_{2},I_{3}}$ and -thus -\begin{equation} - T^{AB}=2\pbrac{\delby{W}{I_{1}}\delby{I_{1}}{C_{AB}}+\delby{W}{I_{2}}\delby{I_{2}}{C_{AB}}+\delby{W}{I_{3}}\delby{I_{3}}{C_{AB}}} -\end{equation} -or if we have -$\fnof{W}{\fnof{\tensor{E}}{\vectr{\nu}}}=\fnof{W}{I_{1},I_{2},I_{3}}$ and -thus -\begin{equation} - T^{AB}=\pbrac{\delby{W}{I_{1}}\delby{I_{1}}{E_{AB}}+\delby{W}{I_{2}}\delby{I_{2}}{E_{AB}}+\delby{W}{I_{3}}\delby{I_{3}}{E_{AB}}} -\end{equation} - -Now we have -\begin{equation} - \delby{I_{1}}{C_{AB}}=\begin{bmatrix} - 1 & 0 & 0 \\ - 0 & 1 & 0 \\ - 0 & 0 & 1 - \end{bmatrix} -\end{equation} -and -\begin{equation} - \delby{I_{2}}{C_{AB}}=\begin{bmatrix} - C_{22}+C_{33} & -C_{21} & -C_{31} \\ - -C_{12} & C_{11}+C_{33} & -C_{32} \\ - -C_{13} & -C_{23} & C_{11}+C_{22} - \end{bmatrix} -\end{equation} -and -\begin{equation} - \delby{I_{3}}{C_{AB}}=\begin{bmatrix} - C_{22}C_{33}-C_{23}C_{32} & C_{23}C_{31}-C_{21}C_{33} & C_{23}C_{32}-C_{22}C_{31} \\ - C_{13}C_{32}-C_{12}C_{33} & C_{11}C_{33}-C_{13}C_{31} & C_{12}C_{31}-C_{11}C_{32} \\ - C_{12}C_{32}-C_{22}C_{31} & C_{13}C_{23}-C_{11}C_{23} & C_{11}C_{22}-C_{12}C_{21} - \end{bmatrix} -\end{equation} - -As an example consider a Mooney-Rivlin material. The strain energy function is -given by -\begin{equation} - \fnof{W}{I_{1},I_{2}}=c_{1}\pbrac{I_{1}-3}+c_{2}\pbrac{I_{2}-3} -\end{equation} - -The second Piola Kirchhoff tensor is thus -\begin{equation} - T^{AB}=\begin{bmatrix} - 2c_{1}+2c_{2}\pbrac{C_{22}+C_{33}} & -2c_{2}C_{21} & -2c_{2}C_{31} \\ - -2c_{2}C_{12} & 2c_{1}+2c_{2}\pbrac{C_{11}+C_{33}} & -2c_{2}C_{32} \\ - -2c_{2}C_{13} & -2c_{2}C_{23} & 2c_{1}+2c_{2}\pbrac{C_{11}+C_{22}} - \end{bmatrix} -\end{equation} -or -\begin{equation} - T^{AB}=\begin{bmatrix} - c_{1}+c_{2}\pbrac{E_{22}+E_{33}} & -c_{2}E_{21} & -c_{2}E_{31} \\ - -c_{2}E_{12} & c_{1}+c_{2}\pbrac{E_{11}+E_{33}} & -c_{2}E_{32} \\ - -c_{2}E_{13} & -c_{2}E_{23} & c_{1}+c_{2}\pbrac{E_{11}+E_{22}} - \end{bmatrix} -\end{equation} - -For incompressible materials we need to add in the volumetric stress. The -hydrostatic stress is a Cauchy stress and so we have -\begin{equation} - \tensor{\sigma}_{p} = -p\tensor{g} -\end{equation} -or in component form -\begin{equation} - \sigma_{p}^{ij} = -p g^{ij} -\end{equation} - -We can pull this stress back to give a second Piola Kirchhoff stress via the -pullback operation for a second order tensor \ie -\begin{equation} - \tensor{T}_{p}= - -\inverse{\tensor{F}_{e}}\tensor{\sigma}_{p}\invtranspose{\tensor{F}_{e}} = -p\inverse{\tensor{C}} -\end{equation} -or in component form -\begin{equation} - T_{p}^{AB}=-\pbrac{F_{e}}^{A}_{i}p g^{ij}\pbrac{F_{e}}^{B}_{j}=-p\pbrac{\inverse{C}}^{AB} -\end{equation} - -To find the stress tensors in deformed coordinates we need to push the second -Piola Kirchhoff tensor in the reference coordinates forward to the deformed -coordinates, $\vectr{x}$, to give the Kirchhoff stress tensor, -$\fnof{\tensor{\tau}}{\vectr{x}}$. The push foward is given by -\begin{equation} - \fnof{\tensor{\tau}}{\vectr{x}}=\fnof{\tensor{F}_{e}}{\vectr{\nu}}\fnof{\tensor{T}}{\vectr{\nu}} - \fnof{\transpose{\tensor{F}_{e}}}{\vectr{\nu}} -\end{equation} - -The Cauchy stress tensor, $\fnof{\tensor{\sigma}}{\vectr{x}}$, can then be calculated from the Kirchhoff stress -tensor using the Jacobian of the deformation \ie -\begin{equation} - \fnof{\tensor{\sigma}}{\vectr{x}}=\inverse{J_{e}}\fnof{\tensor{\tau}}{\vectr{x}}=\inverse{J_{e}} - \fnof{\tensor{F}_{e}}{\vectr{\nu}}\fnof{\tensor{T}}{\vectr{\nu}}\fnof{\transpose{\tensor{F}_{e}}}{\vectr{\nu}} -\end{equation} - -In component form we have -\begin{equation} - \tau^{ij}=\pbrac{F_{e}}^{i}_{B}T^{BC}\pbrac{\transpose{F_{e}}}^{j}_{C} -\end{equation} -and -\begin{equation} - \sigma^{ij}=\inverse{J_{e}}\pbrac{F_{e}}^{i}_{B}T^{BC}\pbrac{\transpose{F_{e}}}^{j}_{C} -\end{equation} - -Now the principle of virtual work (Marsden and Hughes, pg 168) can be stated as -\begin{equation} - \gint{\embedmanifold{B}}{}{\rho\dotprod{\vectr{a}}{\delta\vectr{u}}}{v}= - \gint{\embedmanifold{B}}{}{\rho\dotprod{\vectr{b}}{\delta\vectr{u}}}{v}- - \gint{\embedmanifold{B}}{}{\doubledotprod{\tensor{\sigma}}{\gradient{\delta\vectr{u}}}}{v}+ - \gint{\boundary{\embedmanifold{B}}}{}{\dotprod{\pbrac{\dotprod{\tensor{\sigma}}{\vectr{n}}}}{\delta\vectr{u}}}{a} -\end{equation} -where $\delta\vectr{u}$ are the virtual displacements. - -In component form we have -\begin{equation} - \gint{\embedmanifold{B}}{}{\sigma^{ij}\covarderiv{\delta u_{j}}{i}}{v}= - \gint{\embedmanifold{B}}{}{\rho\pbrac{b^{j}-a^{j}}\delta u_{j}}{v}+ - \gint{\boundary{\embedmanifold{B}}}{}{t^{j}\delta u_{j}}{a} -\end{equation} - -The left hand side of the virtual work statement is -\begin{equation} - \begin{split} - \gint{\embedmanifold{B}}{}{\sigma^{ij}\covarderiv{\delta u_{j}}{i}}{v} - &= \gint{\embedmanifold{B}}{}{\sigma^{ij}\pbrac{\partialderiv{\delta - u_{j}}{i}-\christoffel{k}{j}{i}\delta u_{k}}}{v} \\ - &= \gint{\embedmanifold{B}}{}{\sigma^{ij}\pbrac{\delby{\delta - u_{j}}{x^{i}}-\christoffel{k}{j}{i}\delta u_{k}}}{v} - \end{split} -\end{equation} - -Now -\begin{equation} - \vectr{u}=\vectr{z}-\vectr{x} -\end{equation} -and so -\begin{equation} - \begin{split} - \delta\vectr{u} &=\delta\pbrac{\vectr{z} -\vectr{X}} \\ - &=\delta\vectr{z}-\delta\vectr{X} \\ - &=\delta\vectr{z} - \end{split} -\end{equation} - -If we now substitute $\delta\vectr{u}=\delta\vectr{z}$ and convert the left -hand side of the virtual work statement from an integral with respect to -spatial coordinates to an integral with respect to $\vectr{\xi}$ coordinates we obtain - -\begin{equation} - \begin{split} - \gint{\embedmanifold{B}}{}{\sigma^{ij}\pbrac{\delby{\delta - u_{j}}{x^{i}}-\christoffel{k}{j}{i}\delta u_{k}}}{v} - &= \gint{\embedmanifold{B}}{}{\sigma^{ij}\pbrac{\delby{\delta - z_{j}}{x^{i}}-\christoffel{k}{j}{i}\delta z_{k}}}{v} \\ - &= \gint{\vectr{0}}{\vectr{1}}{\fnof{\sigma^{ij}}{\vectr{\xi}}\pbrac{\delby{\xi_{l}}{x^{i}}\delby{\delta - \fnof{z_{j}}{\vectr{\xi}}}{\xi^{l}}-\christoffel{k}{j}{i}\delta\fnof{z_{k}}{\vect{\xi}}}\fnof{J_{\embedmanifold{B}}}{\vectr{\xi}}}{\vectr{\xi}} - \end{split} -\end{equation} - -Note that in rectangular cartesian coordinates $\christoffel{k}{j}{i}=0$ -$\forall i,j,k$. In addition it is not necessary to transform either the -Cauchy stress tensor or gradient of the virtual displacements so that the -components are with respect to $\vectr{\xi}$ coordinates. What is important is that -the stress and displacement are with respect to the same coordinate -system. Because the gradient of $\delta \vectr{z}$ is with respect to $\vectr{x}$ coordinates -then $\tensor{\sigma}$ needs to be with respect to $\vectr{x}$ coordinates. As there -is no coordinate transformations the Christoffel symbols are all zero and can -be dropped. - -The right hand side of the virtual work statement is -\begin{equation} - \begin{split} - \gint{\embedmanifold{B}}{}{\rho\pbrac{b^{j}-a^{j}}\delta u_{j}}{v}+ - \gint{\boundary{\embedmanifold{B}}}{}{t^{j}\delta u_{j}}{a} - &= \gint{\embedmanifold{B}}{}{\rho\pbrac{b^{j}-a^{j}}\delta z_{j}}{v}+ - \gint{\boundary{\embedmanifold{B}}}{}{Pn^{j}\delta z_{j}}{a} \\ - &= \gint{\vectr{0}}{\vectr{1}}{\rho\pbrac{\fnof{b^{j}}{\vectr{\xi}}-\fnof{a^{j}}{\vectr{\xi}}}\delta - \fnof{z_{j}}{\vectr{\xi}}\fnof{J_{\embedmanifold{B}}}{\vectr{\xi}}}{\vectr{\xi}}\\ - &\quad+\gint{\vectr{0}}{\vectr{1}}{\fnof{P}{\vectr{\xi}}\fnof{n^{j}}{\vectr{\xi}}\delta - \fnof{z_{j}}{\vectr{\xi}}\fnof{J_{\embedmanifold{B}}}{\vectr{\xi}}}{\vectr{\xi}} - \end{split} -\end{equation} -where $P$ is the applied surface pressure. - -If we now use basis functions to interpolate the virtual displacements \ie -\begin{equation} - \delta \fnof{z_{j}}{\vectr{\xi}} = \idxgbfn{j}{m}{\alpha}{\vectr{\xi}}\delta z_{j,\alpha}^{m}\gsf{m}{\alpha} -\end{equation} -which, assuming rectangular cartesian coordinates, gives for the left hand side integral -\begin{equation} - \begin{split} - \gint{\vectr{0}}{\vectr{1}}{\fnof{\sigma^{ij}}{\vectr{\xi}}\delby{\xi_{l}}{x^{i}}\delby{\delta - \fnof{z_{j}}{\vectr{\xi}}}{\xi^{l}}\fnof{J_{\embedmanifold{B}}}{\vectr{\xi}}}{\vectr{\xi}} - &= \gint{\vectr{0}}{\vectr{1}}{\fnof{\sigma^{ij}}{\vectr{\xi}}\delby{\xi_{l}}{x^{i}}\delby{ - \pbrac{\idxgbfn{j}{m}{\alpha}{\vectr{\xi}}\delta z_{j,\alpha}^{m}\gsf{m}{\alpha}}}{\xi^{l}} - \fnof{J_{\embedmanifold{B}}}{\vectr{\xi}}}{\vectr{\xi}} \\ - &= \gint{\vectr{0}}{\vectr{1}}{\fnof{\sigma^{ij}}{\vectr{\xi}}\delby{\xi_{l}}{x^{i}}\delby{ - \idxgbfn{j}{m}{\alpha}{\vectr{\xi}}}{\xi^{l}}\delta z_{j,\alpha}^{m}\gsf{m}{\alpha} - \fnof{J_{\embedmanifold{B}}}{\vectr{\xi}}}{\vectr{\xi}} \\ - &= \delta z_{j,\alpha}^{m}\gsf{m}{\alpha} - \gint{\vectr{0}}{\vectr{1}}{\fnof{\sigma^{ij}}{\vectr{\xi}}\delby{\xi_{l}}{x^{i}}\delby{ - \gbfn{m}{j\alpha}{\vectr{\xi}}}{\xi^{l}} - \fnof{J_{\embedmanifold{B}}}{\vectr{\xi}}}{\vectr{\xi}} - \end{split} -\end{equation} -and for the first integral on the right hand side integral we have -\begin{equation} - \begin{split} - \gint{\vectr{0}}{\vectr{1}}{\rho\pbrac{\fnof{b^{j}}{\vectr{\xi}}-\fnof{a^{j}}{\vectr{\xi}}}\delta - \fnof{z_{j}}{\vectr{\xi}}\fnof{J_{\embedmanifold{B}}}{\vectr{\xi}}}{\vectr{\xi}} - &= \gint{\vectr{0}}{\vectr{1}}{\rho\pbrac{\fnof{b^{j}}{\vectr{\xi}}-\fnof{a^{j}}{\vectr{\xi}}} - \idxgbfn{j}{m}{\alpha}{\vectr{\xi}}\delta - z_{j,\alpha}^{m}\gsf{m}{\alpha} - \fnof{J_{\embedmanifold{B}}}{\vectr{\xi}}}{\vectr{\xi}} \\ - &= \delta - z_{j,\alpha}^{m}\gsf{m}{\alpha}\gint{\vectr{0}}{\vectr{1}}{\rho\pbrac{\fnof{b^{j}}{\vectr{\xi}}- - \fnof{a^{j}}{\vectr{\xi}}}\gbfn{m}{j\alpha}{\vectr{\xi}} - \fnof{J_{\embedmanifold{B}}}{\vectr{\xi}}}{\vectr{\xi}} - \end{split} -\end{equation} -and for the second integral on the right hand side we have -\begin{equation} - \begin{split} - \gint{\vectr{0}}{\vectr{1}}{\fnof{P}{\vectr{\xi}}\fnof{n^{j}}{\vectr{\xi}}\delta - \fnof{z_{j}}{\vectr{\xi}}\fnof{J_{\embedmanifold{B}}}{\vectr{\xi}}}{\vectr{\xi}} - &= \gint{\vectr{0}}{\vectr{1}}{\fnof{P}{\vectr{\xi}}\fnof{n^{j}}{\vectr{\xi}} - \idxgbfn{j}{m}{\alpha}{\vectr{\xi}}\delta - z_{j,\alpha}^{m}\gsf{m}{\alpha} - \fnof{J_{\embedmanifold{B}}}{\vectr{\xi}}}{\vectr{\xi}} - \\ - &= \delta z_{j,\alpha}^{m}\gsf{m}{\alpha}\gint{\vectr{0}}{\vectr{1}}{\fnof{P}{\vectr{\xi}}\fnof{n^{j}}{\vectr{\xi}} - \gbfn{m}{j\alpha}{\vectr{\xi}} - \fnof{J_{\embedmanifold{B}}}{\vectr{\xi}}}{\vectr{\xi}} - \end{split} -\end{equation} - -This can be formulated as -\begin{equation} - r_{m}^{j\alpha}\delta z_{j,\alpha}^{m}=0 -\end{equation} -where the residual vector is thus given by -\begin{multline} - r_{m}^{j\alpha}=\gsf{m}{\alpha}\left( - \gint{\vectr{0}}{\vectr{1}}{\pbrac{\fnof{\sigma^{ij}}{\vectr{\xi}}\delby{\xi_{l}}{x^{i}}\delby{ - \gbfn{m}{j\alpha}{\vectr{\xi}}}{\xi^{l}}+\rho\pbrac{ - \fnof{a^{j}}{\vectr{\xi}}-\fnof{b^{j}}{\vectr{\xi}}}\gbfn{m}{j\alpha}{\vectr{\xi}}} - \fnof{J_{\embedmanifold{B}}}{\vectr{\xi}}}{\vectr{\xi}}\right. \\ - \left.-\gint{\vectr{0}}{\vectr{1}}{\fnof{P}{\vectr{\xi}}\fnof{n^{j}}{\vectr{\xi}} - \gbfn{m}{j\alpha}{\vectr{\xi}} - \fnof{J_{\embedmanifold{B}}}{\vectr{\xi}}}{\vectr{\xi}}\right) -\end{multline} - -Now, as the virtual displacements are arbitrary we have the residual statement -\begin{equation} - r_{m}^{j\alpha}=0 -\end{equation} - -In order to handle incompressible materials we need an additional constraint -which penalises change in volume. The change in volume is given by -\begin{equation} - \Delta V = \dfrac{J_{\embedmanifold{B}}}{J_{g}J_{\embedmanifold{B}_{0}}} -\end{equation} -and the residual equation is -\begin{equation} - \begin{split} - r_{m}^{\pbrac{N+1}\alpha}&=\gint{\vectr{0}}{\vectr{1}}{\pbrac{\fnof{\Delta V}{\vectr{\xi}} - - 1}\gbfn{m}{\pbrac{N+1}\alpha}{\vectr{\xi}}\gsf{m}{\alpha}\fnof{J_{\embedmanifold{B}}}{\vectr{\xi}}}{\vectr{\xi}} - \\ - &=\gsf{m}{\alpha}\gint{\vectr{0}}{\vectr{1}}{\pbrac{\dfrac{\fnof{J_{\embedmanifold{B}}}{\vectr{\xi}}}{\fnof{J_{g}}{\vectr{\xi}}\fnof{J_{\embedmanifold{B}_{0}}}{\vectr{\xi}}} - - 1}\gbfn{m}{\pbrac{N+1}\alpha}{\vectr{\xi}}\fnof{J_{\embedmanifold{B}}}{\vectr{\xi}}}{\vectr{\xi}} - \end{split} -\end{equation} -where $N$ is the number of dimensions. - -In order to solve the nonlinear system of equations a Newton scheme can be -used. To calculate the Jacobian of the system we need to calculate the -variation of the virtual work statement. - -This requires a linerization. - -Consider a linearisation of the second Piola-Kirchoff stress. -\begin{equation} - L\fnof{\tensor{T}}{\vectr{u},\delta\vectr{u}}=\fnof{\tensor{T}}{\vectr{u},\delta\vectr{u}}+ - \delta\fnof{\tensor{T}}{\vectr{u},\delta\vectr{u}} -\end{equation} - -A linearisation of the Kirchoff stress can thus be calculated from a push -forward of the linearisation of the second Piola-Kirchoff stress - -\begin{equation} - \begin{split} - L\fnof{\tensor{\tau}}{\vectr{u},\delta\vectr{u}}&=\tensor{F}_{e}L\fnof{\tensor{T}}{\vectr{u},\delta\vectr{u}}\transpose{\tensor{F}_{e}} \\ - &= \tensor{F}_{e}\pbrac{\fnof{\tensor{T}}{\vectr{u},\delta\vectr{u}}+ - \delta\fnof{\tensor{T}}{\vectr{u},\delta\vectr{u}}}\transpose{\tensor{F}_{e}} - \\ - &= - \tensor{F}_{e}\fnof{\tensor{T}}{\vectr{u},\delta\vectr{u}}\transpose{\tensor{F}_{e}}+ - \tensor{F}_{e}\delta\fnof{\tensor{T}}{\vectr{u},\delta\vectr{u}}\transpose{\tensor{F}_{e}} - \\ - & =\fnof{\tensor{\tau}}{\vectr{u},\delta\vectr{u}}+\tensor{F}_{e}\delta\fnof{\tensor{T}}{\vectr{u},\delta\vectr{u}}\transpose{\tensor{F}_{e}} - \end{split} -\end{equation} - - -\clearpage - -\subsection{Old Stuff} - -Formulation of finite element equations for finite elasticity (large -deformation mechanics) implemented in OpenCMISS is based on the -\textit{\textbf{principle of virtual work}}. The finite element model consists -of a set of non-linear algebraic equations. Non-linearity of equations stems -from non-linear stress-strain relationship and quadratic terms present in the -strain tensor. A typical problem in large deformation mechanics involves -determination of the deformed geometry or mesh nodal parameters, from the -finite element point of view, of the continuum from a known undeformed -geometry, subject to boundary conditions and satisfying stress-strain -(constitutive) relationship. - -The boundary conditions can be either \textit{\textbf{Dirichlet}} -(displacement), \textit{\textbf{Neumann}} (force) or a combination of them, -known as the mixed boundary conditions. Displacement boundary conditions are -generally nodal based. However, force boundary conditions can take any of the -following forms or a combination of them - nodal-based, distributed load -(e.g. pressure) or force acting at a discrete point on the boundary. In the -latter two forms, the equivalent nodal forces are determined using the -\textit{\textbf{method of work equivalence}} \cite{hutton:2004} and the forces -so obtained will then be added to the right hand side or the residual vector -of the linear equation system. - -There are a numerous ways of describing the mechanical characteristics of -deformable materials in large deformation mechanics or finite elasticity -analyses. A predominantly used form for representing constitutive properties -is a strain energy density function. This model gives the energy required to -deform a unit volume (hence energy density) of the deformable continuum as a -function of Green-Lagrange strain tensor components or its derived variables -such as invariants or principal stretches. A material that has a strain energy -density function is known as a \textit{\textbf{hyperelastic}} or -\textit{\textbf{Green-elastic material}}. - -The deformed equilibrium state should also give the minimum total elastic -potential energy. One can therefore formulate finite element equations using -the \textit{\textbf{Variational method}} approach where an extremum of a -functional (in this case total strain energy) is determined to obtain mesh -nodal parameters of the deformed continuum. It is also possible to derive the -finite element equations starting from the governing equilibrium equations -known as Cauchy equation of motion. The weak form of the governing equations -is obtained by multiplying them with suitable weighting functions and -integrating over the domain (method of weighted residuals). If interpolation -or shape functions are used as weighting functions, then the method is called -the Galerkin finite element method. All three approaches (virtual work, -variational method and Galerkin formulation) result in the same finite element -equations. - -In the following sections the derivation of kinematic relationships of -deformation, energy conjugacy, constitutive relationships and final form the -finite element equations using the virtual work approach will be discussed in -detail. - -\subsubsection{Kinematics of Deformation} -In order to track the deformation of an infinitesimal length at a particle of -the continuum, two coordinates systems are defined. An arbitrary orthogonal -spatial coordinate system, which is fixed in space and a material coordinate -system which is attached to the continuum and deforms with the continuum. The -material coordinate system, in general, is a curvi-linear coordinate system -but must have mutually orthogonal axes at the undeformed state. However, in -the deformed state, these axes are no longer orthogonal as they deform with -the continuum (fig 1). In addition to these coordinate systems, there exist -finite element coordinate systems (one for each element) as well. These -coordinates are normalised and vary from 0.0 to 1.0. The following notations are used to represent various coordinate systems and coordinates of a particle of the continuum.\\ - -\noindent $Y_{1}$-$Y_{2}$-$Y_{3}$ - fixed spatial coordinate system axes - orthogonal\\ -$N_{1}$-$N_{2}$-$N_{3}$ - deforming material coordinate system axes - orthogonal in the undeformed state\\ -$\Xi_{1}$-$\Xi_{2}$-$\Xi_{3}$ - element coordinate system - non-orthogonal in general and deforms with continuum\\ - -\noindent $x_{1}$-$x_{2}$-$x_{3}$ [$\vect{x}$] - spatial coordinates of a particle in the undeformed state wrt $Y_{1}$-$Y_{2}$-$Y_{3}$ CS \\ -$z_{1}$-$z_{2}$-$z_{3}$ [$\vect{z}$] - spatial coordinates of the same particle in the deformed state wrt $Y_{1}$-$Y_{2}$-$Y_{3}$ CS \\ -$\nu_{1}$-$\nu_{2}$-$\nu_{3}$ [$\vect{\nu}$] - material coordinates of the particle wrt $N_{1}$-$N_{2}$-$N_{3}$ CS (these do not change) \\ -$\xi_{1}$-$\xi_{2}$-$\xi_{3}$ [$\vect{\xi}$] - element coordinates of the particle wrt $\Xi_{1}$-$\Xi_{2}$-$\Xi_{3}$ CS (these too do not change)\\ - -Since the directional vectors of the material coordinate system at any given -point in the undeformed state is mutually orthogonal, the relationship between -spatial $\vect{x}$ and material $\vect{\nu}$ coordinates is simply a -rotation. The user must define the undeformed material coordinate -system. Typically a nodal based interpolatable field known as fibre -information (fibre, imbrication and sheet angles) is input to OpenCMISS. These -angles define how much the \textit{\textbf{reference or default material - coordinate system}} must be rotated about the reference material axes. The -reference material coordinate system at a given point is defined as -follows. The first direction $\nu_{1}$ is in the $\xi_{1}$ direction. The -second direction, $\nu_{2}$ is in the $\xi_{1}-\xi_{2}$ plane but orthogonal -to $\nu_{1}$. Finally the third direction $\nu_{3}$ is determined to be normal -to both $\nu_{1}$ and $\nu_{2}$. Once the reference coordinate system is -defined, it is then rotated about $\nu_{3}$ by an angle equal to the -interpolated fibre value at the point in counter-clock wise direction. This -will be followed by a rotation about new $\nu_{2}$ axis again in the -counter-clock wise direction by an angle equal to the sheet value. The final -rotation is performed about the current $\nu_{1}$ by an angle defined by -interpolated sheet value. Note that before a rotation is carried out about an -arbitrary axis one must first align(transform) the axis of rotation with one -of the spatial coordinate system axes. Once the rotation is done, the rotated -coordinate system (material) must be inverse-transformed. - -Having defined the undeformed orthogonal material coordinate system, the -metric tensor $\delby{\vect{x}}{\vect{\nu}}$ can be determined. As mentioned, -the tensor $\delby{\vect{x}}{\vect{\nu}}$ contains rotation required to align -material coordinate system with spatial coordinate system. This tensor is -therefore orthogonal. A similar metric tensor can be defined to relate the -deformed coordinates $\vect{z}$ of the point to its material coordinates -$\vect{\nu}$. Note that the latter coordinates do not change as the continuum -deforms and more importantly this tensor is not orthogonal as well. The metric -tensor, $\delby{\vect{z}}{\vect{\nu}}$ is called the -\textit{\textbf{deformation gradient tensor}} and denoted as $\matr{F}$. - -\begin{equation} - \matr{F}=\delby{\vect{z}}{\vect{\nu}} - \label{eqn:deformationgradienttensor} -\end{equation} - -It can be shown that the deformation gradient tensor contains rotation when an -infinitesimal length $\vect{dr_{0}}$ in the undeformed state undergoes -deformation. Since rotation does not contribute to any strain, it must be -removed from the deformation gradient tensor. Any tensor can be decomposed -into an orthogonal tensor and a symmetric tensor (known as polar -decomposition). In other words, the same deformation can be achieved by first -rotating $\vect{dr}$ and then stretching (shearing and scaling) or -vice-verse. Thus, the deformation gradient tensor can be given by, - -\begin{equation} - \matr{F}=\delby{\vect{z}}{\vect{\nu}}=\matr{R}\matr{U}=\matr{V}\matr{R_{1}} - \label{eqn:polardecomposition} -\end{equation} - -The rotation present in the deformation gradient tensor can be removed either -by right or left multiplication of $\matr{F}$. The resulting tensors lead to -different strain measures. The right Cauchy deformation tensor $\matr{C}$ is -obtained from, - -\begin{equation} - \matr{C}=\transpose{[\matr{R}\matr{U}]}[\matr{R}\matr{U}]=\transpose{\matr{U}}\transpose{\matr{R}}\matr{R}\matr{U}=\transpose{\matr{U}}\matr{U} - \label{eqn:rightCauchy} -\end{equation} - -Similarly the left Cauchy deformation tensor or the Finger tensor \matr{B} is -obtained from the left multiplication of \matr{F}, - -\begin{equation} - \matr{B}=[\matr{V}\matr{R_{1}}]\transpose{[\matr{V}\matr{R_{1}}]}=\matr{V}\matr{R_{1}}\transpose{\matr{R_{1}}}\transpose{\matr{V}}=\matr{V}\transpose{\matr{V}} - \label{eqn:leftCauchy} -\end{equation} - -\noindent Note that both $\matr{R}$ and $\matr{R_{1}}$ are orthogonal tensors -and therefore satisfy the following condition, - -\begin{equation} - \transpose{\matr{R}}\matr{R}=\matr{R_{1}}\transpose{\matr{R_{1}}}=\matr{I} - \label{eqn:orthoganality} -\end{equation} - -Since there is no rotation present in both $\matr{C}$ and $\matr{B}$, they can -be used to define suitable strain measures as follows, - -\begin{equation} - \matr{E}=\frac{1}{2}\pbrac{\transpose{\delby{\vect{z}}{\vect{\nu}}}\delby{\vect{z}}{\vect{\nu}}- - \transpose{\delby{\vect{x}}{\vect{\nu}}}\delby{\vect{x}}{\vect{\nu}}}= - \frac{1}{2}(\matr{C}-\matr{I}) - \label{eqn:greenstrain} -\end{equation} - -\noindent and - -\begin{equation} - \vect{e}=\frac{1}{2}\bbrac{\pbrac{\delby{\vect{x}}{\vect{\nu}}\transpose{\delby{\vect{x}}{\vect{\nu}}}}^{-1}- - \pbrac{\delby{\vect{z}}{\vect{\nu}}\transpose{\delby{\vect{z}}{\vect{\nu}}}}^{-1}}= - \frac{1}{2}\pbrac{\matr{I}-\matr{B}^{-1}} - \label{eqn:almansistrain} -\end{equation} - -\noindent where $\matr{E}$ and $\vect{e}$ are called Green and Almansi strain tensors respectively. -Also note that $\delby{\vect{x}}{\vect{\nu}}$ is an orthogonal tensor. \\ - -It is now necessary to establish a relationship between strain and displacement. Referring to figure 1, - -\begin{equation} - \vect{z}=\vect{x}+\vect{u} - \label{eqn:displacement} -\end{equation} - -\noindent where \vect{u} is the displacement vector. \\ - -\noindent Differentiating \eqnref{eqn:displacement} using the chain rule, - -\begin{equation} - \delby{\vect{z}}{\vect{\nu}}=\delby{\vect{x}}{\vect{\nu}}+\delby{\vect{u}}{\vect{x}}\delby{\vect{x}}{\vect{\nu}}= - \pbrac{\matr{I}+\delby{\vect{u}}{\vect{x}}}\delby{\vect{x}}{\vect{\nu}} - \label{eqn:displacementgradient} -\end{equation} - -\noindent Substituting \eqnref{eqn:displacementgradient} into \eqnref{eqn:greenstrain}, - -\begin{equation} - \matr{E}=\frac{1}{2}\bbrac{\transpose{\delby{\vect{x}}{\vect{\nu}}}\transpose{\pbrac{\matr{I}+\delby{\vect{u}}{\vect{x}}}} - \pbrac{\matr{I}+\delby{\vect{u}}{\vect{x}}}\delby{\vect{x}}{\vect{\nu}}-\matr{I}} - \label{eqn:greendisplacement1} -\end{equation} - -\noindent Simplifying, - -\begin{equation} - \matr{E}=\frac{1}{2}\transpose{\delby{\vect{x}}{\vect{\nu}}} - \pbrac{\delby{\vect{u}}{\vect{x}}+\transpose{\delby{\vect{u}}{\vect{x}}}+ - \transpose{\delby{\vect{u}}{\vect{x}}}\delby{\vect{u}}{\vect{x}}} - \delby{\vect{x}}{\vect{\nu}} - \label{eqn:greendisplacement2} -\end{equation} - -As can be seen from \eqnref{eqn:greendisplacement2} the displacement gradient -tensor $\delby{\vect{u}}{\vect{x}}$ is defined with respect to undeformed -coordinates $\vect{x}$. This means that the strain tensor $\matr{E}$ has -Lagrangian description and hence it is also also called the Green-Lagrange -strain tensor. - -A similar derivation can be employed to establish a relationship between the -Almansi and displacement gradient tensors and the final form is given by, - -\begin{equation} - \vect{e}=\frac{1}{2}\delby{\vect{u}}{\vect{z}}+\transpose{\delby{\vect{u}}{\vect{z}}}- - \transpose{\delby{\vect{u}}{\vect{z}}}\delby{\vect{u}}{\vect{z}} - \label{eqn:almansidisplacement} -\end{equation} - -The displacement gradient tensor terms in \eqnref{eqn:almansidisplacement} are defined with respect to deformed coordinates $\vect{z}$ and -therefore the strain tensor has Eulerian description. Thus it is also known as the Almansi-Euler strain tensor. - -\subsubsection{Energy Conjugacy} - - - -\subsubsection{Constitutive models} - - - -\subsubsection{Principle of Virtual Work} -Elastic potential energy or simply elastic energy associated with the -deformation can be given by strain and its energetically conjugate stress. -Note that the Cauchy stress and Almansi-Euler strain tensors and Second -Piola-Kirchhoff (2PK) and Green-Lagrange tensors are energetically -conjugate. Thus, the \textit{\textbf{total internal energy}} due to strain in -the body at the deformed state (fig. 3.1) can be given by, - -\begin{equation} - W_{int}=\gint{0}{v}{(\vect{e}:\vect{\sigma})}v - \label{eqn:totalenergy} -\end{equation} - -where \vect{e} and \vect{\sigma} are Almansi strain tensor and Cauchy stress -tensor respectively. - -If the deformed body is further deformed by introducing virtual displacements, -then the new internal elastic energy can be given by, - -\begin{equation} - {W_{int}+\delta W_{int}}=\gint{0}{v}{[\vect{(e+\delta{e})}:\vect{\sigma}]}v - \label{eqn:virtualtotalenergy} -\end{equation} - -Deducting \eqnref{eqn:totalenergy} from \eqnref{eqn:virtualtotalenergy}, - -\begin{equation} - \delta W_{int}=\gint{0}{v}{\pbrac{\vect{\delta \epsilon} : \vect{\sigma}}}v - \label{eqn:virtualenergy} -\end{equation} - -Using \eqnref{eqn:almansidisplacement} for virtual strain, - -\begin{equation} - \vect{\delta e}=\delby{\vect{\delta u}}{\vect{z}} + \transpose{\delby{\vect{\delta u}}{\vect{z}}} + - \transpose{\delby{\vect{\delta u}}{\vect{z}}}\delby{\vect{\delta u}}{\vect{z}} - \label{eqn:virtualalmansidisplacement} -\end{equation} - -Since virtual displacements are infinitesimally small, quadratic terms in -\eqnref{eqn:virtualalmansidisplacement} can be neglected. The resulting -strain tensor, known as small strain tensor \vect{\epsilon}, can be given as, - -\begin{equation} - \vect{\delta \epsilon}=\delby{\vect{\delta u}}{\vect{z}} + \transpose{\delby{\vect{\delta u}}{\vect{z}}} - \label{eqn:virtualsmalldisplacement} -\end{equation} - -Since both $\vect{\sigma}$ and $\vect{\delta \epsilon}$ are symmetric, new -vectors are defined by inserting tensor components as follows, - -\begin{equation} - \vect{\delta \epsilon}=\transpose{\sqbrac{\delta \epsilon_{11} \hspace{4 pt} \delta \epsilon_{22} \hspace{4 pt} \delta \epsilon_{33} - \hspace{4 pt} 2\delta \epsilon_{12} \hspace{4 pt} 2\delta \epsilon_{23} \hspace{4 pt} 2\delta \epsilon_{13}}} : - \vect{\sigma}=\transpose{\sqbrac{\delta \sigma_{11} \hspace{4 pt} \delta \sigma_{22} \hspace{4 pt} \delta \sigma_{33} - \hspace{4 pt} 2\delta \sigma_{12} \hspace{4 pt} 2\delta \sigma_{23} \hspace{4 pt} 2\delta \sigma_{13} }} - \label{eqn:newvectors} -\end{equation} - -Substituting \eqnref{eqn:newvectors} into \eqnref{eqn:virtualenergy}, - -\begin{equation} - \delta W_{int}=\gint{0}{v}{\pbrac{\transpose{\vect{\delta \epsilon}} \vect{\sigma}}}v - \label{eqn:virtualenergy1} -\end{equation} - -The strain vector $\vect{\delta \epsilon}$ can be related to displacement -vector using the following equation, - -\begin{equation} - \vect{\delta \epsilon}=\matr{D} \vect{\delta u} - \label{eqn:virtualsmalldisplacement1} -\end{equation} - -\noindent where $\matr{D}$ and $\vect{u}$ are linear differential operator and -displacement vector respectively and given by, - -\begin{equation} - \begin{array}{c} \matr{D} \end{array} = - \pbrac{ \begin{array}{ccc} \delby{}{z_{1}} & 0 & 0 \\ - 0 & \delby{}{z_{2}} & 0 \\ - 0 & 0 & \delby{}{z_{3}} \\ - \delby{}{z_{2}} & \delby{}{z_{1}} & 0 \\ - 0 & \delby{}{z_{3}} & \delby{}{z_{2}} \\ - \delby{}{z_{3}} & 0 & \delby{}{z_{1}} \\ \end{array} } - \label{eqn:differentialoperator} -\end{equation} - -\begin{equation} - \vect{\delta u}=\transpose{\pbrac{\delta u_{1} \hspace{4 pt} \delta u_{2} \hspace{4 pt} \delta u_{3}}} - \label{eqn:displacementvector} -\end{equation} - -The virtual displacement is a finite element field and hence the value at any -point can be obtained by interpolating nodal virtual displacements. - -\begin{equation} - \vect{\delta u}=\matr{\Phi}\matr{\Delta} - \label{eqn:interpolation} -\end{equation} - diff --git a/doc/notes/Latex_make.sh b/doc/notes/Latex_make.sh deleted file mode 100755 index 37e4d125..00000000 --- a/doc/notes/Latex_make.sh +++ /dev/null @@ -1,105 +0,0 @@ -#!/bin/bash -f -# -# This shell script is used to invoke the Latex_Makefile for general -# documents. It should be copied into the individual document directory -# as a new document is created. It is used to pass document specific -# parameters to the makefile. NOTE that if parameters may be omitted -# by simply deleting them from the "make" command line. -# -# Usage: -# Latex_make.sh [makefile_options] -# Created: -# Martyn Nash, 22 March 1996 -# Updates: -# -# Changable options: -# -# This is the overall name of the document - -MY_MAINFILE=OpenCMISSNotes - -# -# These are the names of the tex sources for the document. If there is -# more than one source quotation (") marks must be used around the -# individual sources seperated by spaces. - -MY_TEX_SRC="TitlePage/TitlePage.tex "\ -"Introduction/Introduction.tex "\ -"DifferentialGeometry/DifferentialGeometry.tex "\ -"Theory/Theory.tex "\ -"EquationSets/EquationSets.tex "\ -"EquationSets/ClassicalFieldClass/AdvectionDiffusionEquation.tex "\ -"EquationSets/ClassicalFieldClass/GeneralisedLaplaceEquation.tex "\ -"EquationSets/ClassicalFieldClass/BiharmonicEquation.tex "\ -"EquationSets/ClassicalFieldClass/DiffusionEquation.tex "\ -"EquationSets/ClassicalFieldClass/HelmholtzEquation.tex "\ -"EquationSets/ClassicalFieldClass/PoissonEquation.tex "\ -"EquationSets/ClassicalFieldClass/ReactionDiffusionEquation.tex "\ -"EquationSets/ClassicalFieldClass/WaveEquation.tex "\ -"EquationSets/ElasticityClass/LinearElasticity.tex "\ -"EquationSets/ElasticityClass/FiniteElasticity.tex "\ -"EquationSets/FluidMechanicsClass/BurgersEquation.tex "\ -"EquationSets/FluidMechanicsClass/PoiseuilleFlow.tex "\ -"EquationSets/FluidMechanicsClass/StokesEquation.tex "\ -"EquationSets/FluidMechanicsClass/DarcyEquation.tex "\ -"EquationSets/FluidMechanicsClass/NavierStokesEquation.tex "\ -"EquationSets/MultiphysicsClass/Poroelasticity.tex "\ -"AnalyticSolutions/AnalyticSolutions.tex "\ -"AnalyticSolutions/ClassicalFieldClass/DiffusionEquation.tex "\ -"AnalyticSolutions/FluidMechanicsClass/BurgersEquation.tex "\ -"References/References.tex "\ -"Index/Index.tex" - -# -# The names of the eps/figs/(gnu)plot files that go into the document. -# if there are none then leave after the ='s sign blank. If there is -# more than one source quotation (") marks must be used around the -# individual sources seperated by spaces. - -#MY_EPS_SRC="epsfiles/*.eps" -MY_EPS_SRC= -MY_FIG_SRC=figs/Theory/*.fig -MY_SVG_SRC="svgs/DifferentialGeometry/*.svg svgs/Theory/*.svg" -MY_PLOT_SRC=plots/Theory/*.gnu - -# -# The name of the directory to place the html version of the document. -# Note that the actual file will be placed in the directory -# MY_HTMLUPDATE_DIR/MY_MAINFILE with filename index.html - -MY_HTMLUPDATE_DIR=${OPENCMISS_ROOT}/src/iron/doc/www/help - -# -# This next option controls the type of backlinks to add to the footer -# of the HTML file. It should be "user" if the document is intended for -# general users or "programmer" if the document is intended for -# cmiss programmers. If no backlinks are required use "none". - -MY_HTMLIDXTYPE=user - -# -# The name of the bibliography database for the document - -MY_BIBS=${OPENCMISS_ROOT}/src/iron/doc/references/references.bib - -# -# The name of the printer to print the document to - -MY_PRINTER=laserjet_postscript - -# -# Below this line should not need changing -# -# Actual make command: -# -make -f ${OPENCMISS_ROOT}/src/iron/doc/latex/Latex_Makefile $* \ - MAINFILE=$MY_MAINFILE \ - TEX_SRC="$MY_TEX_SRC" \ - EPS_SRC="$MY_EPS_SRC" \ - FIG_SRC="$MY_FIG_SRC" \ - SVG_SRC="$MY_SVG_SRC" \ - PLOT_SRC="$MY_PLOT_SRC" \ - HTMLUPDATE_DIR=$MY_HTMLUPDATE_DIR \ - HTMLIDXTYPE=$MY_HTMLIDXTYPE \ - BIBS=$MY_BIBS \ - PRINTER=$MY_PRINTER diff --git a/doc/notes/OpenCMISSNotes.tex b/doc/notes/OpenCMISSNotes.tex deleted file mode 100755 index 14922103..00000000 --- a/doc/notes/OpenCMISSNotes.tex +++ /dev/null @@ -1,56 +0,0 @@ -\documentclass[12pt,twoside,a4paper]{book} - -\input{../latex/macros} %define new commands etc. -\input{../latex/defns} %define pagesetup and std. packages etc. -\input{../latex/abbreviations} %define packages etc. -%\input{ParameterEstimation/include} %define new commands etc. - -%\usepackage{mybook} %define book style -\usepackage[center,sc,small]{caption} % Alter caption styles -\setcaptionmargin{0.25in} -\usepackage{listings} -\usepackage{times} %use the times font -\usepackage{listings} -\usepackage[small,nohug,heads=littlevee]{styles/diagrams} %commutative diagrams - -\makeindex - -\title{OpenCMISS Notes} -\author{} -\date{\today} - -\begin{document} - -\include{TitlePage/TitlePage} %input from TitlePage/TitlePage.tex -%\clearemptydoublepage - -\pagenumbering{roman} - -\tableofcontents -%\listoffigures -%\listoftables - -\pagenumbering{arabic} - -\include{Introduction/Introduction} %input from Introduction/Introduction.tex -\include{DifferentialGeometry/DifferentialGeometry} %input from Introduction/Introduction.tex -\include{Theory/Theory} %input from Theory/Theory.tex -\include{EquationSets/EquationSets} %input from EquationSets/EquationSets.tex -\include{AnalyticSolutions/AnalyticSolutions} %input from AnalyticSolutions/AnalyticSolutions.tex -\include{Solvers/Solvers} %input from Solvers/Solvers.tex -\include{Coupling/Coupling} %input from Coupling/Coupling.tex -\include{BoundaryConditions/BoundaryConditions} -%\include{Modules/Modules} %input from Modules/Modules.tex -\include{DevelopersDocument/DevelopersDoc} -%\include{ParameterEstimation/ParameterEstimation} %input from ParameterEstimation/ParameterEstimation.tex - -\include{References/References} %input from References/References.tex - -\include{Index/Index} %input from Index/Index.tex - -\end{document} - -%%% Local Variables: -%%% mode: latex -%%% TeX-master: t -%%% End: diff --git a/doc/notes/Theory/Theory.tex b/doc/notes/Theory/Theory.tex deleted file mode 100755 index aa343574..00000000 --- a/doc/notes/Theory/Theory.tex +++ /dev/null @@ -1,2054 +0,0 @@ -\clearemptydoublepage -\chapter{Theory} -\label{cha:theory} - -\section{Basis Functions and Interpolation} -\label{sec:basisfunctions} - -Both the finite element method (FEM) and the boundary element method (BEM) use -interpolation in finding a field solution \ie the methods find the solution at -a number of points in the domain of interest and then approximate the solution -between these points using interpolation. The points at which the solution is -found are known as \emph{nodes}. \emph{Basis functions} are used to -interpolate the field between nodes within a subregion of the domain known as -an \emph{element}. Interpolation is achieved by mapping the field coordinate -onto a \emph{local parametric}, or $\xi$, coordinate (which varies from $0$ to -$1$) within each element. The global nodes which make up each element are also -mapped onto local element nodes and the basis functions are chosen (in terms -of polynomials of the local parametric coordinate) such that the interpolated -field is equal to the known nodal values at each node and is thus continuous -between elements. A schematic of this -scheme is shown in \figref{fig:nodesandelements}. - -\epstexfigure{svgs/Theory/nodesandelements.eps_tex}{A schematic of the - relationship between local and global nodes, elements and the parametric - elemental $\xi$ coordinate.} {A schematic of the relationship between local - and global nodes, elements and the parametric elemental $\xi$ - coordinate.}{fig:nodesandelements}{0.3} - -\subsection{Summation Notation} -\label{subsec:summation notation} - -The following (Einstein) summation notation will be used throughout these notes. In order to -eliminate summation symbols repeated ``dummy'' indices will be used \ie -\begin{equation} - \gsum{i=1}{n}{a^{i}b_{i}}=a^{i}b_{i} -\end{equation} - -To indicate an index that is not summed, parentheses will be used -\ie $a^{(i)}b_{(i)}$ is talking about the singular expression for $i$ \eg -$a^{1}b_{1}$, $a^{2}b_{2}$ \etc - -In order to indicate a summation the sum must occur over indices that are -different sub/super-script \ie the sum must be over an ``upper'' and a -``lower'' index or a ``lower'' and an ``upper'' index. Note that it may be -useful to remember that if an index appears in the denominator of a fractional -expression then the index upper- or lower- ness is ``reversed''. - -For some quantities with both upper and lower indices a dot will be used to -indicate the ``second'' index \eg in the expression $A^{i}_{.j}$ then $i$ can -be considered the first index and $j$ the second index. - -\subsection{Lagrangian Basis Functions} -\label{sec:lagrangebasisfunctions} - -One important family of basis functions are the Lagrange basis functions. This -family has one basis function for each of the local element nodes and are -defined such that, at a particular node, only one basis function is non-zero -and has the value of one. In this sense a basis function can be thought of as -being associated with a local node and serves to weight the interpolated -solution in terms of the field value at that node. Lagrange basis functions -hence provide only $C^{0}$ continuity of the field variable across element -boundaries. - -\subsubsection{Linear Lagrange basis functions} - -The simplest basis functions of the Lagrange family are the \onedal linear -Lagrange basis functions. These basis functions involve two local nodes and -are defined as -\begin{equation} - \begin{split} - \lbfn{1}{\xi}&=1-\xi \\ - \lbfn{2}{\xi}&=\xi - \end{split} - \label{eqn:linearlbfuns} -\end{equation} - -The two \onedal linear Lagrange basis functions are gshown in \figref{fig:linlagrangebfuns}. - -\pstexfigure{plots/Theory/linlagrangebfuns.pstex}{Linear Lagrange basis functions.} -{Linear Lagrange basis functions.}{fig:linlagrangebfuns} - -The interpolation of a field variable, $u$, using these basis functions is -given by -\begin{equation} - \begin{split} - \fnof{u}{\xi}&=\lbfn{1}{\xi}\nodept{u}{1}+\lbfn{2}{\xi}\nodept{u}{2} \\ - &=\pbrac{1-\xi}\nodept{u}{1}+\xi\nodept{u}{2} - \end{split} -\end{equation} -where $\nodept{u}{1}$ and $\nodept{u}{2}$ are the values of the field variable at -the first and second local nodes respectively. These basis functions hence -provide a linear variation between the local nodal values with the local -element coordinate, $\xi$. - -\subsubsection{Quadratic Lagrange basis functions} - -Lagrange basis functions can also be used to provide higher order variations, -for example the one-dimensional quadratic Lagrange basis functions involve -three local nodes and can provide a quadratic variation of field parameter -with $\xi$. They are defined as -\begin{equation} - \begin{split} - \lbfn{1}{\xi}&=2\pbrac{\xi-\frac12}\pbrac{\xi-1} \\ - \lbfn{2}{\xi}&=4\xi\pbrac{1-\xi} \\ - \lbfn{3}{\xi}&=2\xi\pbrac{\xi-\frac12} - \end{split} - \label{eqn:quadraticlbfuns} -\end{equation} - -The three \onedal quadratic Lagrange basis functions are shown in \figref{fig:quadlagrangebfuns}. - -\pstexfigure{plots/Theory/quadlagrangebfuns.pstex}{Quadratic Lagrange basis functions.} -{Quadratic Lagrange basis functions.}{fig:quadlagrangebfuns} - -The interpolation formula is -\begin{equation} - \begin{split} - \fnof{u}{\xi}&=\lbfn{1}{\xi}\nodept{u}{1}+\lbfn{2}{\xi}\nodept{u}{2}+ - \lbfn{3}{\xi}\nodept{u}{3}\\ - &=2\pbrac{\xi-\frac12}\pbrac{\xi-1}\nodept{u}{1}+ - 4\xi\pbrac{1-\xi}\nodept{u}{2}+2\xi\pbrac{\xi-\frac12}\nodept{u}{3} - \end{split} -\end{equation} - -\subsubsection{Cubic Lagrange basis functions} - -One-dimensional cubic Lagrange basis functions involve -four local nodes and can provide a cubic variation of field parameter -with $\xi$. They are defined as -\begin{equation} - \begin{split} - \lbfn{1}{\xi}&=\frac12\pbrac{3\xi-1}\pbrac{3\xi-2}\pbrac{1-\xi} \\ - \lbfn{2}{\xi}&=\frac92\xi\pbrac{3\xi-2}\pbrac{\xi-1} \\ - \lbfn{3}{\xi}&=\frac92\xi\pbrac{3\xi-1}\pbrac{1-\xi} \\ - \lbfn{4}{\xi}&=\frac12\xi\pbrac{3\xi-1}\pbrac{3\xi-2} - \end{split} - \label{eqn:cubiclbfuns} -\end{equation} - -The four \onedal cubic Lagrange basis functions are shown in \figref{fig:cublagrangebfuns}. - -\pstexfigure{plots/Theory/cublagrangebfuns.pstex}{Cubic Lagrange basis functions.} -{Cubic Lagrange basis functions.}{fig:cublagrangebfuns} - -The interpolation formula is -\begin{equation} - \begin{split} - \fnof{u}{\xi}&=\lbfn{1}{\xi}\nodept{u}{1}+\lbfn{2}{\xi}\nodept{u}{2}+ - \lbfn{3}{\xi}\nodept{u}{3}+\lbfn{4}{\xi}\nodept{u}{4}\\ - &=\frac12\pbrac{3\xi-1}\pbrac{3\xi-2}\pbrac{1-\xi}\nodept{u}{1}+ - \frac92\xi\pbrac{3\xi-2}\pbrac{\xi-1}\nodept{u}{2} \\ - &\quad+\frac92\xi\pbrac{3\xi-1}\pbrac{1-\xi}\nodept{u}{3}+ - \frac12\xi\pbrac{3\xi-1}\pbrac{3\xi-2}\nodept{u}{4} - \end{split} -\end{equation} - -\subsubsection{General Lagrange basis functions} - -In general the interpolation formula for the Lagrange family of basis -functions is, using \index{Einstein summation notation}\emph{Einstein - summation notation}, given by -\begin{equation} - \fnof{u}{\xi}=\lbfn{\alpha}{\xi}\nodept{u}{\alpha}\quad \alpha=1,\ldots,n_{e} - \label{eqn:lagrangeinterpolation} -\end{equation} -where $n_{e}$ is the number of local nodes in the element. Einstein summation -notation uses a repeated index in a product expression to imply summation. For -example \eqnref{eqn:lagrangeinterpolation} is equivalent to -\begin{equation} - \fnof{u}{\xi}=\gsum{\alpha=1}{n_{e}}{\lbfn{\alpha}{\xi}\nodept{u}{\alpha}} -\end{equation} - -\subsubsection{Bilinear Lagrange basis functions} - -Multi-dimensional Lagrange basis functions can be constructed from the tensor, -or outer, products of the one-dimensional Lagrange basis functions. For -example the two-dimensional bilinear Lagrange basis functions have four local -nodes with the basis functions given by -\begin{equation} - \begin{split} - \lbfn{1}{\xione,\xitwo}&=\lbfn{1}{\xione}\lbfn{1}{\xitwo}= - \pbrac{1-\xione}\pbrac{1-\xitwo}\\ - \lbfn{2}{\xione,\xitwo}&=\lbfn{2}{\xione}\lbfn{1}{\xitwo}= - \xione\pbrac{1-\xitwo}\\ - \lbfn{3}{\xione,\xitwo}&=\lbfn{1}{\xione}\lbfn{2}{\xitwo}= - \pbrac{1-\xione}\xitwo \\ - \lbfn{4}{\xione,\xitwo}&=\lbfn{2}{\xione}\lbfn{2}{\xitwo}= - \xione\xitwo - \end{split} -\end{equation} - -The four \twodal bilinear Lagrange basis functions are shown in \figref{fig:bilinlagrangebfuns}. - -\pstexfigure{plots/Theory/bilinlagrangebfuns.pstex}{Bilinear Lagrange basis functions.} - {Bilinear Lagrange basis functions.}{fig:bilinlagrangebfuns} - -The multi-dimensional interpolation formula is still a sum of the products of -the nodal basis function and the field value at the node. For example the -interpolated geometric position vector within an element is given by -\begin{equation} - \begin{split} - \fnof{\vect{x}}{\xione,\xitwo}&=\lbfn{\alpha}{\xione,\xitwo} - \nodept{\vect{x}}{\alpha}\\ - &=\lbfn{1}{\xione,\xitwo}\nodept{\vect{x}}{1}+\lbfn{2}{\xione,\xitwo} - \nodept{\vect{x}}{2}+\lbfn{3}{\xione,\xitwo}\nodept{\vect{x}}{3}+ - \lbfn{4}{\xione,\xitwo}\nodept{\vect{x}}{4} - \end{split} -\end{equation} -where, for the vector field, each component is interpolated separately using -the given basis functions. - -\subsection{Hermitian Basis Functions} -\label{sec:Hermitianbasisfunctions} - -Hermitian basis functions preserve continuity of the derivative of the -interpolating variable \ie $C^{1}$ continuity, with respect to $\xi$ across -element boundaries by defining additional nodal derivative parameters. Like -Lagrange bases, Hermitian basis functions are also chosen so that, at a -particular node, only one basis function is non-zero and equal to one. They -also are chosen so that, at a particular node, the \emph{derivative} of only -one of four basis functions is non-zero and is equal to one. Hermitian basis -functions hence serve to weight the interpolated solution in terms of the -field value and derivative of the field value at nodes. - -\subsubsection{Cubic Hermite basis functions} - -\Cubicherm basis functions are the simplest of the Hermitian family and -involve two local nodes per element. The interpolation within each element is -in terms of $\nodept{\vect{x}}{\alpha}$ and \evalat{\dby{\vect{x}}{\xi}}{\alpha} -and is given by \index{cubic Hermite basis!$\xi$ interpolation formula} -\begin{equation} - \fnof{\vect{x}}{\xi}=\chbfn{1}{0}{\xi}\nodept{\vect{x}}{1}+\chbfn{1}{1}{\xi} - \evalat{\dby{\vect{x}}{\xi}}{1}+\chbfn{2}{0}{\xi}\nodept{\vect{x}}{2}+ - \chbfn{2}{1}{\xi}\evalat{\dby{\vect{x}}{\xi}}{2} - \label{eqn:chxiinterpolation} -\end{equation} -where the four \onedal \cubicherm basis functions are given in -\eqnref{eqn:chbfuns} and shown in \figref{fig:chbfuns}. -\index{cubic Hermite basis!basis functions formulae} -\begin{equation} - \begin{split} - \chbfn{1}{0}{\xi} &= 1-3\xi^{2}+2\xi^{3} \\ - \chbfn{1}{1}{\xi} &= \xi(\xi-1)^{2} \\ - \chbfn{2}{0}{\xi} &= \xi^{2}(3-2\xi) \\ - \chbfn{2}{1}{\xi} &= \xi^{2}(\xi-1) - \end{split} - \label{eqn:chbfuns} -\end{equation} -\pstexfigure{plots/Theory/chbfuns.pstex}{Cubic Hermite basis functions.} -{Cubic Hermite basis functions.}{fig:chbfuns} - -\subsubsection{Scaling} - -One further step is required to make \cubicherm basis functions useful in -practice. Consider the two \cubicherm elements shown in -\figref{fig:chelements}. - -\epstexfigure{svgs/Theory/cubichermiteelem.eps_tex}{Two - cubic Hermite elements formed from three nodes.}{Two cubic Hermite elements - (denoted by $\mathit{1}$ and $\mathit{2}$) formed from three nodes (shown as - a $\bullet$ and denoted by $\mathbf{1}, \mathbf{2}$ and $\mathbf{3}$) and - having \arclens $s_{1}$ and $s_{2}$ respectively.}{fig:chelements}{0.35} - -The derivative $\evalat{\dby{\vect{x}}{\xi}}{\alpha}$ defined at local node -$\alpha$ is dependent upon the local element \xicoord and is therefore, in -general, different in the two adjacent elements. Interpretation of the -derivative is hence difficult as two derivatives with the same magnitude in -different parts of the mesh might represent two completely different physical -derivatives. This is problematic for modelling and computation if the interpretation of the -magnitude of the derivative (or \emph{scaling}) is unknown \eg we cannot -assign physical units. If the scaling varies throughout the mesh then a -derivative at a node that has a magnitude of, say, 5 will be different from -another derivative at another node that also has the magnitude of 5. Thus, a -numerical solver that is given a vector of derivative values would assume that -the scalings are the same and interpret the magnitudes identically. This would -mean that algorithms may fail \eg if, say, we needed to compute the -norm of a vector of derivatives then by assuming the same scaling the wrong -result would be computed. - -In order to the have a consistent interpretation of the derivative -throughout the mesh it is better to base the interpolation on a physical -coordinate. Whilst we are free to choose the physical coordinate to be -anything the optimum choice is arc length as this is what physical processes -are based on. However, arc-length is extremely difficult to use as an -interpolation parameter as the inherent nonlinearity involved in its -calculation makes conversion to and from coordinates non trivial. -The solution is to find a parameter that scales -in the same way as arc-length or as close to it as we can. - -Consider then basing the derivatives on an \arclen coordinate at nodes, -$\dby{\nodept{\vect{x}}{\alpha}}{s}$, with -\begin{equation} - \begin{split} - \evalat{\dby{\vect{x}}{\xi}}{\alpha}&=\dby{\nodept{\vect{x}}{ - \fnof{\Delta}{\alpha,e}}}{s}\pbrac{\dby{s}{\xi}}_{e} \\ &= - \dby{\nodept{\vect{x}}{\fnof{\Delta}{\alpha,e}}}{s}\esfone{e} - \end{split} - \label{eqn:xitosch} -\end{equation} -used to determine $\evalat{\dby{\vect{x}}{\xi}}{\alpha}$. Here -$\dby{\vect{x}}{s}$ is a physical \arclen derivative, -$\fnof{\Delta}{\alpha,e}$ is the global node number of local node $\alpha$ in -element $e$, $\pbrac{\dby{s}{\xi}}_{e}$ is an \index{element scale - factor}element \emph{scale factor}, denoted by $\esfone{e}$, which scales -the \arclen derivative to the \xicoord derivative. Thus $\dby{\vect{x}}{s}$ -is constrained to be continuous across element boundaries rather than -$\dby{\vect{x}}{\xi}$. The \cubicherm interpolation formula now becomes -\begin{equation} - \fnof{\vect{x}}{\xi}=\chbfn{1}{0}{\xi}\nodept{\vect{x}}{1}+\chbfn{1}{1}{\xi} - \dby{\nodept{\vect{x}}{1}}{s}\esfone{e}+\chbfn{2}{0}{\xi}\nodept{\vect{x}}{2}+ - \chbfn{2}{1}{\xi}\dby{\nodept{\vect{x}}{2}}{s}\esfone{e} - \label{eqn:chseinterpolation} -\end{equation} - -By interpolating with respect to $s$ rather than with respect to $\xi$ there is some -liberty as to the choice of the element scale factor, $\esfone{e}$. The choice -of the scale factor will, however, affect how $\xi$ changes with $s$. It is -computationally desirable to have a relatively uniform change of $\xi$ with -$s$ (for example not biasing the Gaussian quadrature -- see later -- scheme to -one end of the element). For this reason the element scale factor is chosen as -some function of the \arclen of the element, $s_{e}$. The simplest linear -function that can be chosen is the \arclen itself. This type of scaling is -called \index{arc-length scaling}\emph{\arclen scaling}. - -To calculate the \arclen for a particular element an iterative process is -needed. The \arclen for a \onedal element in \twods is defined as -\index{arc-length definition} -\begin{equation} - \text{\arclen, }s_{e}=\gint{0}{1}{\norm{\dby{\fnof{\vect{x}}{\xi}}{\xi}}} - {\xi}=\gint{0}{1}{\sqrt{\pbrac{\dby{\fnof{x}{\xi}}{\xi}}^{2}+ - \pbrac{\dby{\fnof{y}{\xi}}{\xi}}^{2}}}{\xi} - \label{eqn:arclendef} -\end{equation} - -However, since the interpolation of $\fnof{\vect{x}}{\xi}$, as defined in -\eqnref{eqn:chseinterpolation}, uses the \arclen in the calculation of the -scaling factor, an iterative root finding technique is needed to obtain the -\arclen. - -Thus, for an element $e$, the \onedal \cubicherm interpolation -formula in \eqnref{eqn:chseinterpolation} becomes -\begin{equation} - \fnof{\vect{x}}{\xi}=\chbfn{\alpha}{u}{\xi}\nodept{\vect{x}}{\alpha}_{,u} - \esftwo{e}{u} - \label{eqn:chsfinterpolation} -\end{equation} -where $\alpha$ varies from $1$ to $2$, $u$ varies from $0$ to $1$, -$\nodept{\vect{x}}{\alpha}_{,0}=\nodept{\vect{x}}{\alpha}$, -$\nodept{\vect{x}}{\alpha}_{,1}= \dby{\nodept{\vect{x}}{\alpha}}{s}$, -$\esftwo{e}{0}=1$ and $\esftwo{e}{1}=\esfone{e}=s_{e}$. \Eqnref{eqn:chsfinterpolation} is equivalent to -\begin{equation} - \fnof{\vect{x}}{\xi}=\chbfn{1}{0}{\xi}\nodept{\vect{x}}{1}_{,0}\esftwo{e}{0} - +\chbfn{1}{1}{\xi}\nodept{\vect{x}}{1}_{,1}\esftwo{e}{1}+ - \chbfn{2}{0}{\xi}\nodept{\vect{x}}{2}_{,0}\esftwo{e}{0} - +\chbfn{2}{1}{\xi}\nodept{\vect{x}}{2}_{,1}\esftwo{e}{1} -\end{equation} -\ie there is an implied sum with $\alpha$ and $u$ for $\chbfn{\alpha}{u}{\xi}$ -and $\nodept{\vect{x}}{\alpha}_{,u}$ but not for $\esftwo{e}{u}$. - -There is one final condition that must be placed on the $\xi$ to \arclen -transformation to ensure \arclen derivatives. This condition is based on the -geometric defintion of \arclen which is given by Pythagorus \ie for \twods in -rectangular cartesian coordinate we have -\begin{equation} - ds^{2}=dx^{2}+dy^{2} - \label{eqn:arclengthpythagorus} -\end{equation} -or, in general coordinates, -\begin{equation} - ds^{2}=g_{ij}dx^{i}dx^{j} - \label{eqn:genarclengthpythagorus} -\end{equation} -where $g_{ij}$ are the components of the metric tensor. - -Rearranging \eqnref{eqn:arclengthpythagorus} we find that the \arclen derivative vector at a -node for geometric like fields, for rectangular cartesian coordinates, must -have unit magnitude. Thus for global node $A$ we have -\begin{equation} - \norm{\dby{\nodept{\vect{x}}{A}}{s}}=1 - \label{eqn:chnormconstraint} -\end{equation} - -In general coordinates this condition becomes -\begin{equation} - \norm{\delby{\nodept{\vect{x}}{A}}{s_{k}}}=\sqrt{\det{\tensor{g}}} - \label{eqn:genchnormconstraint} -\end{equation} -where $s_{k}$ is the \nth{k} global arc-length direction and $\tensor{g}$ is the metric tensor. - -The use of this constraint on \arclen derivative magnitude ensures that there is continuity with respect to a physical parameter, -$s$, rather than with respect to a mathematical parameter $\xi$. The set of -mesh parameters, $\vect{u}$, for \cubicherm interpolation hence contains the -set of nodal values (or positions), the set of nodal \arclen derivatives and -the set of scale factors. - -\subsubsection{Extension to higher orders} - -\Bicubicherm basis functions are the \twodal extension of the \onedal -\cubicherm basis functions. They are formed from the tensor (or outer) product -of two of the \onedal cubic Hermite basis functions defined in -\eqnref{eqn:chbfuns}. The interpolation formula for the point -$\fnof{\vect{x}}{\xione,\xitwo}$ within an element is obtained from the -\bicubicherm interpolation formula \cite{nielsen:1991a}, \index{bicubic - Hermite basis!$\xi$ interpolation formula} -\begin{equation} - \begin{split} - \fnof{\vect{x}}{\xione,\xitwo} &= - \chbfn{1}{0}{\xione}\chbfn{1}{0}{\xitwo}\nodept{\vect{x}}{1} + - \chbfn{2}{0}{\xione}\chbfn{1}{0}{\xitwo}\nodept{\vect{x}}{2} + \\ - & \chbfn{1}{0}{\xione}\chbfn{2}{0}{\xitwo}\nodept{\vect{x}}{3} + - \chbfn{2}{0}{\xione}\chbfn{2}{0}{\xitwo}\nodept{\vect{x}}{4} + \\ - & \chbfn{1}{1}{\xione}\chbfn{1}{0}{\xitwo}\evalat{\delby{\vect{x}}{\xione}} - {1}+ - \chbfn{2}{1}{\xione}\chbfn{1}{0}{\xitwo}\evalat{\delby{\vect{x}}{\xione}} - {2}+ \\ - & \chbfn{1}{1}{\xione}\chbfn{2}{0}{\xitwo}\evalat{\delby{\vect{x}}{\xione}} - {3}+ - \chbfn{2}{1}{\xione}\chbfn{2}{0}{\xitwo}\evalat{\delby{\vect{x}}{\xione}} - {4} + \\ - & \chbfn{1}{0}{\xione}\chbfn{1}{1}{\xitwo}\evalat{\delby{\vect{x}}{\xitwo}} - {1}+ - \chbfn{2}{0}{\xione}\chbfn{1}{1}{\xitwo}\evalat{\delby{\vect{x}}{\xitwo}} - {2} + \\ - & \chbfn{1}{0}{\xione}\chbfn{2}{1}{\xitwo}\evalat{\delby{\vect{x}}{\xitwo}} - {3}+ - \chbfn{2}{0}{\xione}\chbfn{2}{1}{\xitwo}\evalat{\delby{\vect{x}}{\xitwo}} - {4} + \\ - & \chbfn{1}{1}{\xione}\chbfn{1}{1}{\xitwo}\evalat{\deltwoby{\vect{x}} - {\xione}{\xitwo}}{1} + - \chbfn{2}{1}{\xione}\chbfn{1}{1}{\xitwo}\evalat{\deltwoby{\vect{x}} - {\xione}{\xitwo}}{2} + \\ - & \chbfn{1}{1}{\xione}\chbfn{2}{1}{\xitwo}\evalat{\deltwoby{\vect{x}} - {\xione}{\xitwo}}{3} + - \chbfn{2}{1}{\xione}\chbfn{2}{1}{\xitwo}\evalat{ \deltwoby{\vect{x}} - {\xione}{\xitwo}}{4} - \end{split} - \label{eqn:bichxiinterp} -\end{equation} - -As with \onedal \cubicherm elements, the derivatives with respect to $\xi$ in -the \twodal interpolation formula above are expressed as the product of a -nodal \arclen derivative and a scale factor. This is, however, complicated by -the fact that there are now multiple $\xi$ directions at each node. From the -product rule the transformation from an $\xi$ based derivative to an \arclen -based derivative is given by, -\begin{equation} - \delby{\vect{x}}{\xi_{l}}=\delby{\vect{x}}{s_{1}}\delby{s_{1}}{\xi_{l}}+ - \delby{\vect{x}}{s_{2}}\delby{s_{2}}{\xi_{l}} - \label{eqn:xitosproductrule} -\end{equation} - -Now, by definition, the $\nth{l}$ \arclen direction is only a function of the -$\nth{l}$ $\xi$ direction, hence the derivative at local node $\alpha$ is -\begin{equation} - \evalat{\delby{\vect{x}}{\xi_{l}}}{\alpha}=\delby{\nodept{\vect{x}}{ - \fnof{\Delta}{\alpha,e}}}{s_{l}}\esftwo{e}{l} - \label{eqn:xitosbich} -\end{equation} -and the cross-derivative is -\begin{equation} - \evalat{\deltwoby{\vect{x}}{\xione}{\xitwo}}{\alpha}= - \deltwoby{\nodept{\vect{x}}{\fnof{\Delta}{\alpha,e}}}{s_{1}}{s_{2}}\esftwo{e}{1} - \esftwo{e}{2} - \label{eqn:xitosbichcd} -\end{equation} - -Unlike the \onedal \cubicherm case a condition must be placed on -this transformation in order to maintain $C^{1}$ continuity across element -boundaries. - -Consider the line between global nodes $\mathbf{1}$ and $\mathbf{2}$ in the -two \bicubicherm elements shown in \figref{fig:bichelementcont}. -\epstexfigure{svgs/Theory/C1bicubicHermite.eps_tex}{Continuity of two bicubic - Hermite elements.}{Two bicubic Hermite elements (denoted by $\mathit{1}$ and - $\mathit{2}$). The global node numbers are given in boldface, the local node - numbers in normal text and the element scale factors used along each line - are denoted by $\esfone{l}$.}{fig:bichelementcont}{0.35} - -For $C^{1}$ continuity, as opposed to $G^{1}$ continuity, between these -elements the derivative with respect to $\xione$, that is -\delby{\fnof{\vect{x}}{\xitwo}}{\xione}, must be continuous\footnote{For - $C^{1}$ continuity the normals either side of an element boundary must be in - the same direction \emph{and} have the same magnitude. For $G^{1}$ - continuity the normals must only have the same direction.}. The formula for -this derivative in element $\mathit{1}$ along the boundary between elements -$\mathit{1}$ and $\mathit{2}$ is -\begin{equation} - \delby{\fnof{\vect{x}}{1,\xitwo}}{\xione}=\chbfn{0}{1}{\xitwo}\evalat{ - \delby{\vect{x}}{\xione}}{2}+\chbfn{0}{2}{\xitwo}\evalat{ - \delby{\vect{x}}{\xione}}{4}+\chbfn{1}{1}{\xitwo}\evalat{ - \deltwoby{\vect{x}}{\xione}{\xitwo}}{2}+\chbfn{1}{2}{\xitwo}\evalat{ - \deltwoby{\vect{x}}{\xione}{\xitwo}}{4} - \label{eqn:c1contelem1} -\end{equation} -and for element $\mathit{2}$ is -\begin{equation} - \delby{\fnof{\vect{x}}{0,\xitwo}}{\xione}=\chbfn{0}{1}{\xitwo}\evalat{ - \delby{\vect{x}}{\xione}}{1}+\chbfn{0}{2}{\xitwo}\evalat{ - \delby{\vect{x}}{\xione}}{3}+\chbfn{1}{1}{\xitwo}\evalat{ - \deltwoby{\vect{x}}{\xione}{\xitwo}}{1}+\chbfn{1}{2}{\xitwo}\evalat{ - \deltwoby{\vect{x}}{\xione}{\xitwo}}{3} - \label{eqn:c1contelem2} -\end{equation} - -Now substituting \eqnrefs{eqn:xitosbich}{eqn:xitosbichcd} into the -above equations yields for element $\mathit{1}$ -\begin{equation} - \begin{split} - \delby{\fnof{\vect{x}}{1,\xitwo}}{\xione} &= - \chbfn{0}{1}{\xitwo}\delby{\nodept{\vect{x}}{2}}{s_{1}}\esfone{2}+ - \chbfn{0}{2}{\xitwo}\delby{\nodept{\vect{x}}{4}}{s_{1}}\esfone{5}+ \\ - &\quad\chbfn{1}{1}{\xitwo}\deltwoby{\nodept{\vect{x}}{2}}{s_{1}}{s_{2}} - \esfone{2}\esfone{4}+ - \chbfn{1}{2}{\xitwo}\deltwoby{\nodept{\vect{x}}{4}}{s_{1}}{s_{2}} - \esfone{5}\esfone{4} - \end{split} -\end{equation} -and for element $\mathit{2}$ -\begin{equation} - \begin{split} - \delby{\fnof{\vect{x}}{0,\xitwo}}{\xione} &= - \chbfn{0}{1}{\xione}\delby{\nodept{\vect{x}}{1}}{s_{1}}\esfone{3}+ - \chbfn{0}{2}{\xitwo}\delby{\nodept{\vect{x}}{3}}{s_{1}}\esfone{6}+ \\ - &\quad\chbfn{1}{1}{\xitwo}\deltwoby{\nodept{\vect{x}}{1}}{s_{1}}{s_{2}} - \esfone{3}\esfone{4}+ - \chbfn{1}{2}{\xitwo}\deltwoby{\nodept{\vect{x}}{3}}{s_{1}}{s_{2}} - \esfone{6}\esfone{4} - \end{split} -\end{equation} - -Now local node $2$ in element $\mathit{1}$ and local node $1$ in element -$\mathit{2}$ is the same as global node $\mathbf{1}$ and local node $4$ in -element $\mathit{1}$ and local node $3$ in element $\mathit{2}$ is the same as -global node $\mathbf{2}$. Hence for a given $\xitwo$ the condition for $C^{1}$ -continuity across the element boundary is -\begin{multline} - \chbfn{0}{1}{\xitwo}\delby{\nodept{\vect{x}}{\mathbf{1}}}{s_{1}}\esfone{2}+ - \chbfn{0}{2}{\xitwo}\delby{\nodept{\vect{x}}{\mathbf{2}}}{s_{1}}\esfone{5}+ - \chbfn{1}{1}{\xitwo}\deltwoby{\nodept{\vect{x}}{\mathbf{1}}}{s_{1}}{s_{2}} - \esfone{2}\esfone{4} \\ - +\chbfn{1}{2}{\xitwo}\deltwoby{\nodept{\vect{x}}{\mathbf{2}}}{s_{1}}{s_{2}} - \esfone{5}\esfone{4} = \chbfn{0}{1}{\xitwo}\delby{\nodept{\vect{x}} - {\mathbf{1}}}{s_{1}}\esfone{3}+\chbfn{0}{2}{\xitwo}\delby{\nodept{\vect{x}} - {\mathbf{2}}}{s_{1}}\esfone{6} \\ - +\chbfn{1}{1}{\xitwo}\deltwoby{\nodept{\vect{x}}{\mathbf{1}}}{s_{1}}{s_{2}} - \esfone{3}\esfone{4}+\chbfn{1}{2}{\xitwo}\deltwoby{\nodept{\vect{x}} - {\mathbf{2}}}{s_{1}}{s_{2}}\esfone{6}\esfone{4} -\end{multline} -or -\begin{multline} - \pbrac{\esfone{2}-\esfone{3}}\pbrac{\chbfn{0}{1}{\xitwo} - \delby{\nodept{\vect{x}}{\mathbf{1}}}{s_{1}}+\chbfn{1}{1}{\xitwo} - \deltwoby{\nodept{\vect{x}}{\mathbf{1}}}{s_{1}}{s_{2}}\esfone{4}} = \\ - \pbrac{\esfone{6}-\esfone{5}}\pbrac{\chbfn{0}{2}{\xitwo} - \delby{\nodept{\vect{x}}{\mathbf{2}}}{s_{1}}+\chbfn{1}{2}{\xitwo} - \deltwoby{\nodept{\vect{x}}{\mathbf{2}}}{s_{1}}{s_{2}}\esfone{4}} - \label{eqn:bchc1condition} -\end{multline} - -Now by choosing the scale factors to be equal on either side of node -$\mathbf{1}$ and $\mathbf{2}$ (\ie $\esfone{2}=\esfone{3}=\nsfone{\mathbf{1}}$ -and $\esfone{5}=\esfone{6}=\nsfone{\mathbf{2}}$), that is nodal based scale -factors, \eqnref{eqn:bchc1condition} is satisfied for any choice of the scale -factors. Hence nodal scale factors are a sufficient condition to ensure -$C^{1}$ continuity. If it is desired that the scale factors be different -either side of the node then \eqnref{eqn:bchc1condition} must be satisfied to -ensure continuity. - -The choice of the scale factors again determines the $\xi$ -to $s$ spacing. We have a number of choices for the scale factor depending on -whether or not the $\xi$ to $s$ spacing should favour bigger or smaller -elements. One choice which equally favours both elements either side of the -node is for the scale factors to be chosen to be nodally based and equal to the average \arclen on either side -of the node for each $\xi$ direction \ie for the $\nth{l}$ direction -\begin{equation} - \nsftwo{A}{l}=\dfrac{\fnof{s_{l}}{\fnof{A_{\ominus}}{l}}+ - \fnof{s_{l}}{\fnof{A_{\oplus}}{l}}}{2} - \label{eqn:arithmeanarclenscale} -\end{equation} -where $\nsftwo{A}{l}$ is the nodal scale factor in the $\nth{l}$ $\xi$ -direction at global node $A$, $\fnof{A_{\ominus}}{l}$ is the element -immediately preceding (in the \nth{l} direction) node $A$, and -$\fnof{A_{\oplus}}{l}$ is the element immediately after (in the \nth{l} -direction) node $A$ and $\fnof{s_{l}}{e}$ is the \arclen in the \nth{l} $\xi$ -direction from node $A$ in element $e$. This type of scaling is known as -\emph{arithmetic mean \arclen scaling}. - -Other means can be used \ie \emph{geometric mean \arclen scaling} -\begin{equation} - \nsftwo{A}{l}=\sqrt{\fnof{s_{l}}{\fnof{A_{\ominus}}{l}} - \fnof{s_{l}}{\fnof{A_{\oplus}}{l}}} - \label{eqn:geomeanarclenscale} -\end{equation} -or \emph{harmonic mean \arclen scaling} -\begin{equation} - \nsftwo{A}{l}=\dfrac{\fnof{s_{l}}{\fnof{A_{\ominus}}{l}} - \fnof{s_{l}}{\fnof{A_{\oplus}}{l}}}{\fnof{s_{l}}{\fnof{A_{\ominus}}{l}}+ - \fnof{s_{l}}{\fnof{A_{\oplus}}{l}}} - \label{eqn:harmonicmeanarclenscale} -\end{equation} - - - -\pstexfigure{plots/Theory/funcscaling.pstex}{Function scaling.} -{Function scaling.}{fig:functionscaling}{1.5} - -\pstexfigure{plots/Theory/firstdscaling.pstex}{First derivative scaling.} -{First derivative scaling.}{fig:firstdscaling}{1.5} - -\pstexfigure{plots/Theory/seconddscaling.pstex}{Second derivative scaling.} -{Second derivative scaling.}{fig:seconddscaling}{1.5} - - -\subsubsection{Hermite-sector elements} -\label{sec:hselements} - -One problem that arises when using quadrilateral elements (such as -\bicubicherm elements) to describe a surface is that it is impossible to -'close the surface' in three-dimensions whilst maintaining consistent $\xione$ -and $\xitwo$ directions throughout the mesh. This is important as $C^{1}$ -continuity requires either consistent $\xi$ directions or a transformation at -each node to take into account the inconsistent directions \cite{petera:1994}. - -One solution to this problem is to \emph{collapse} a \bicubicherm element. -This entails placing one of the four local nodes of the element at the same -geometric location as another local node of the element and results in a -triangular element from which it is possible to close the surface. There are -two main problems with this solution. The first is that one of the two $\xi$ -directions at the collapsed node is undefined. The second is that the -distance between the two nodes at the same location is zero. Numerical -problems can result from this zero distance. An alternative strategy has -been developed in which special elements, called ``Hermite-sector'' -elements\index{Hermite-sector elements}, are used to close a \bicubicherm -surface in three-dimensions. There are two types of elements depending on -whether the $\xi$ (or $s$) directions come together at local node one or local -node three. These two elements are shown in \figref{fig:hermitesectors}. - -\epstexfigure{svgs/Theory/hermitesectors.eps_tex}{Hermite-sector elements.} -{Hermite-sector elements. (a) Apex node one element. (b) Apex node three - element.}{fig:hermitesectors}{0.3} - -From \figref{fig:hermitesectors} it can be seen that the $s_{2}$ direction is -not unique at the apex nodes. This gives us two choices for the interpolation -within the element: ignore the $s_{2}$ derivative when interpolating or set -the $s_{2}$ derivative identically to zero. - -\textbf{Ignore $s_{2}$ apex derivative}: For this case it can be seen from -\figref{fig:hermitesectors} that the interpolation in the $\xione$ direction -is just the standard cubic Hermite interpolation. The interpolation in the -$\xitwo$ direction is now a little different in that the nodal \arclen -derivative has been dropped as it is no longer defined at the apex node. For -an apex node one element shown in \figref{fig:hermitesectors}(a) the -interpolation for the line between local node one and local node $n$ is now -quadratic and is given by -\begin{equation} - \fnof{\vect{x}}{\xitwo}=\hsonebfn{1}{\xitwo}\nodept{\vect{x}}{1}+ - \hsonebfn{2}{\xitwo}\nodept{\vect{x}}{n}+ - \hsonebfn{3}{\xitwo}\evalat{\delby{\vect{x}}{\xitwo}}{n} - \label{eqn:hsapex1xiinterp} -\end{equation} -with the basis functions given by -\index{quadratic Hermite basis!apex node one!basis functions formulae} -\begin{equation} - \begin{split} - \hsonebfn{1}{\xi}&=\pbrac{\xi-1}^{2} \\ - \hsonebfn{2}{\xi}&=2\xi-\xi^{2} \\ - \hsonebfn{3}{\xi}&=\xi^{2}-\xi - \end{split} - \label{eqn:hsapex1bfuns} -\end{equation} - -For the apex node three element shown in \figref{fig:hermitesectors}(b) the -interpolation for the line connecting local node $n$ with local node three is -given by -\begin{equation} - \fnof{\vect{x}}{\xitwo}=\hsthreebfn{1}{\xitwo}\nodept{\vect{x}}{3}+ - \hsthreebfn{2}{\xitwo}\nodept{\vect{x}}{n}+ - \hsthreebfn{3}{\xitwo}\evalat{\delby{\vect{x}}{\xitwo}}{n} - \label{eqn:hsapex3xiinterp} -\end{equation} -with the basis functions given by -\index{quadratic Hermite basis!apex node three!basis functions formulae} -\begin{equation} - \begin{split} - \hsthreebfn{1}{\xi}&=\xi^{2} \\ - \hsthreebfn{2}{\xi}&=1-\xi^{2} \\ - \hsthreebfn{3}{\xi}&=\xi-\xi^{2} - \end{split} - \label{eqn:hsapex3Bfuns} -\end{equation} - -The full interpolation formula for the sector element can then be found by -taking the tensor product of the interpolation in the $\xione$ direction, -given in \eqnref{eqn:chxiinterpolation}, with the interpolation in the -$\xitwo$ direction (given by either Equations \bref{eqn:hsapex1xiinterp} or -\bref{eqn:hsapex3xiinterp}). The interpolation formula can be converted from -nodal $\xi$ derivatives to nodal \arclen derivatives using the procedure -outlined for the \bicubicherm case. For example, the interpolation formulae for -an apex node one element is \index{Hermite-sector basis!apex node one!\arclen - interpolation formula} -\begin{equation} - \begin{split} - \fnof{\vect{x}}{\xione,\xitwo} &= - \hsonebfn{1}{\xitwo}\nodept{\vect{x}}{1}+\chbfn{1}{0}{\xione}\hsonebfn{2} - {\xitwo}\nodept{\vect{x}}{2}+\chbfn{2}{0}{\xione}\hsonebfn{2}{\xitwo} - \nodept{\vect{x}}{3} + \\ - & \chbfn{1}{1}{\xione}\hsonebfn{2}{\xitwo}\delby{\nodept{\vect{x}}{2}}{s_{1}} - \nsftwo{2}{1}+\chbfn{2}{1}{\xione}\hsonebfn{2}{\xitwo}\delby{\nodept{\vect{x}} - {3}}{s_{1}}\nsftwo{3}{1} + \\ - & \chbfn{1}{0}{\xione}\hsonebfn{3}{\xitwo}\delby{\nodept{\vect{x}}{2}}{s_{2}} - \nsftwo{2}{2} + \chbfn{2}{0}{\xione}\hsonebfn{3}{\xitwo} - \delby{\nodept{\vect{x}}{3}}{s_{2}}\nsftwo{3}{2} + \\ - & \chbfn{1}{1}{\xione}\hsonebfn{3}{\xitwo}\deltwoby{\nodept{\vect{x}}{2}} - {s_{1}}{s_{2}}\nsftwo{2}{1}\nsftwo{2}{2} + - \chbfn{2}{1}{\xione}\hsonebfn{3}{\xitwo}\deltwoby{\nodept{\vect{x}}{3}} - {s_{1}}{s_{2}}\nsftwo{3}{1}\nsftwo{3}{2} - \end{split} - \label{eqn:hsapex1sinterp} -\end{equation} - -Care must be taken when using Hermite-sector elements for rapidly changing -surfaces. Consider an apex node one element with undefined $s_{2}$ apex -derivatives. The rate of change of $\vect{x}$ with respect to -$\xione$ along the line from node one to node three (\ie $\xione=1$) is -\begin{equation} - \begin{split} - \delby{\fnof{\vect{x}}{1,\xitwo}}{\xione} &= \hsonebfn{2}{\xitwo}\delby{ - \nodept{\vect{x}}{3}}{s_{1}}\nsftwo{3}{1}+\hsonebfn{3}{\xitwo}\deltwoby{ - \nodept{\vect{x}}{3}}{s_{1}}{s_{2}}\nsftwo{3}{1}\nsftwo{3}{2} \\ - &= \nsftwo{3}{1}\pbrac{\pbrac{2\xitwo-\xitwo^{2}}\delby{\nodept{\vect{x}}{3}} - {s_{1}}+\pbrac{\xitwo^{2}-\xitwo}\deltwoby{\nodept{\vect{x}}{3}}{s_{1}}{s_{2}} - \nsftwo{3}{2}} - \end{split} -\end{equation} - -Taking the dot product of $\delby{\fnof{\vect{x}}{1,\xitwo}}{\xione}$ with -$\delby{\nodept{\vect{x}}{3}}{s_{1}}$ gives -\begin{equation} - \dotprod{\delby{\fnof{\vect{x}}{1,\xitwo}}{\xione}}{\delby{\nodept{\vect{x}}{3}} - {s_{1}}} = \nsftwo{3}{1} - \pbrac{\pbrac{2\xitwo-\xitwo^{2}}\dotprod{\delby{\nodept{\vect{x}}{3}}{s_{1}}} - {\delby{\nodept{\vect{x}}{3}}{s_{1}}}+\pbrac{\xitwo^{2}-\xitwo}\nsftwo{3}{2} - \dotprod{\deltwoby{\nodept{\vect{x}}{3}}{s_{1}}{s_{2}}} - {\delby{\nodept{\vect{x}}{3}}{s_{1}}}} - \label{eqn:hsonedirectiondotprod} -\end{equation} - -The normality constraint for \arclen derivatives means that -$\dotprod{\delby{\nodept{\vect{x}}{3}}{s_{1}}}{\delby{\nodept{\vect{x}}{3}} - {s_{1}}}=1$ and thus the right hand side of -\eqnref{eqn:hsonedirectiondotprod} divided by $\nsftwo{3}{1}$ (\ie normalised -by $\nsftwo{3}{1}$) is the quadratic -\begin{equation*} - \pbrac{2\xitwo-\xitwo^{2}}+\pbrac{\xitwo^{2}-\xitwo}\nsftwo{3}{2} - \dotprod{\deltwoby{\nodept{\vect{x}}{3}}{s_{1}}{s_{2}}}{\delby{\nodept{\vect{x}} - {3}}{s_{1}}} -\end{equation*} -or -\begin{equation*} - \pbrac{\nsftwo{3}{2}\dotprod{\deltwoby{\nodept{\vect{x}}{3}}{s_{1}}{s_{2}}} - {\delby{\nodept{\vect{x}}{3}}{s_{1}}} -1}\xitwo^{2}+ - \pbrac{2-\nsftwo{3}{2}\dotprod{\deltwoby{\nodept{\vect{x}}{3}}{s_{1}}{s_{2}}} - {\delby{\nodept{\vect{x}}{3}}{s_{1}}}}\xitwo - \label{eqn:hsonedirectionpolynomial} -\end{equation*} - -This quadratic is $1$ at $\xitwo=1$ and always has a root at $\xitwo=0$. -Consider the case of this quadratic having its second root in the interval -$(0,1)$. This would mean that at some point in the interval $(0,1)$ the dot -product of \delby{\fnof{\vect{x}}{1,\xitwo}}{\xione} and -\delby{\nodept{\vect{x}}{3}}{s_{1}} would go from zero to negative and then -positive as $\xitwo$ changed from $0$ to $1$ \ie the angle between -$\delby{\fnof{\vect{x}}{1,\xitwo}}{\xione}$ and -$\delby{\nodept{\vect{x}}{3}}{s_{1}}$ would, at some stage, be greater than -ninety degrees. As the direction of the normal to the surface along the line -between local node one and three is given by the cross product of -$\delby{\fnof{\vect{x}}{1,\xitwo}}{\xione}$ and -$\delby{\fnof{\vect{x}}{1,\xitwo}}{\xitwo}$ then, if the quadratic became -sufficiently negative, the normal to the surface could reverse direction from -an outward to an inward normal as $\xitwo$ changed from $0$ to $1$. This is -clearly undesirable. In fact even if the quadratic is only slightly negative -the resulting surface would be grossly deformed. - -To avoid these effects the second root of the quadratic must be outside the -interval $(0,1)$. From the quadratic formula the conditions for this are -\begin{equation} - \dfrac{\nsftwo{3}{2}\dotprod{\deltwoby{\nodept{\vect{x}}{3}}{s_{1}}{s_{2}}} - {\delby{\nodept{\vect{x}}{3}}{s_{1}}}-2}{\nsftwo{3}{2}\dotprod{ - \deltwoby{\nodept{\vect{x}}{3}}{s_{1}}{s_{2}}}{\delby{\nodept{\vect{x}}{3}} - {s_{1}}}-1}<0 -\end{equation} -and -\begin{equation} - \dfrac{\nsftwo{3}{2}\dotprod{\deltwoby{\nodept{\vect{x}}{3}}{s_{1}}{s_{2}}} - {\delby{\nodept{\vect{x}}{3}}{s_{1}}}-2}{\nsftwo{3}{2}\dotprod{ - \deltwoby{\nodept{\vect{x}}{3}}{s_{1}}{s_{2}}}{\delby{\nodept{\vect{x}}{3}} - {s_{1}}}-1}>1 -\end{equation} -that is (for the line from local node one to local node $n$) -\index{Hermite-sector basis!apex node one!cross-derivative condition} -\begin{equation} - \dotprod{\deltwoby{\nodept{\vect{x}}{n}}{s_{1}}{s_{2}}}{\delby{\nodept{\vect{x}} - {n}}{s_{1}}}<\dfrac{2}{\nsftwo{n}{2}} -\end{equation} - -The simplest way to interpret this constraint is that if the element is large -(\ie $\nsftwo{n}{2}$ is large) then $\dotprod{\deltwoby{\nodept{\vect{x}}{n}} - {s_{1}}{s_{2}}}{\delby{\nodept{\vect{x}}{n}}{s_{1}}}$ must be small. The -simplest way for this to happen is to ensure the magnitude of the components of -$\deltwoby{\nodept{\vect{x}}{n}}{s_{1}}{s_{2}}$ are small (or of opposite sign to -the comparable components of $\delby{\nodept{\vect{x}}{n}}{s_{1}}$). - -The equivalent interpolation formula to \eqnref{eqn:hsapex1sinterp} for an -apex node three Hermite-sector element is -\index{Hermite-sector basis!apex node three!\arclen interpolation formula} -\begin{equation} - \begin{split} - \fnof{\vect{x}}{\xione,\xitwo} &= - \chbfn{1}{0}{\xione}\hsthreebfn{2}{\xitwo}\nodept{\vect{x}}{1}+ - \chbfn{2}{0}{\xione}\hsthreebfn{2}{\xitwo}\nodept{\vect{x}}{2}+ - \hsthreebfn{1}{\xitwo}\nodept{\vect{x}}{3}+ \\ - & \chbfn{1}{1}{\xione}\hsthreebfn{2}{\xitwo}\delby{\nodept{\vect{x}}{1}} - {s_{1}}\nsftwo{1}{1}+\chbfn{2}{1}{\xione}\hsthreebfn{2}{\xitwo} - \delby{\nodept{\vect{x}}{2}}{s_{1}}\nsftwo{2}{1} + \\ - & \chbfn{1}{0}{\xione}\hsthreebfn{3}{\xitwo}\delby{\nodept{\vect{x}}{1}} - {s_{2}}\nsftwo{1}{2}+\chbfn{2}{0}{\xione}\hsthreebfn{3}{\xitwo} - \delby{\nodept{\vect{x}}{2}}{s_{2}}\nsftwo{2}{2} + \\ - & \chbfn{1}{1}{\xione}\hsthreebfn{3}{\xitwo}\deltwoby{\nodept{\vect{x}}{1}} - {s_{1}}{s_{2}}\nsftwo{1}{1}\nsftwo{1}{2} + - \chbfn{2}{1}{\xione}\hsthreebfn{3}{\xitwo}\deltwoby{\nodept{\vect{x}}{2}} - {s_{1}}{s_{2}}\nsftwo{2}{1}\nsftwo{2}{2} - \end{split} - \label{eqn:hsapex3sinterp} -\end{equation} -and the equivalent constraint for apex node three Hermite-sector elements (for -the line from local node $n$ to local node three) is -\index{Hermite-sector basis!apex node three!cross-derivative condition} -\begin{equation} - \dotprod{\deltwoby{\nodept{\vect{x}}{n}}{s_{1}}{s_{2}}}{\delby{\nodept{\vect{x}} - {n}}{s_{1}}}>\dfrac{-2}{\nsftwo{n}{2}} -\end{equation} - -\textbf{Zero $s_{2}$ apex derivative}: For this case the sector basis -functions are just the cubic Hermite basis functions. The corresponding -interpolation formulae for an apex node one element is hence -\begin{equation} - \begin{split} - \fnof{\vect{x}}{\xione,\xitwo} &= \chbfn{1}{0}{\xitwo} - \nodept{\vect{x}}{1} + - \chbfn{1}{0}{\xione}\chbfn{2}{0}{\xitwo}\nodept{\vect{x}}{2} + - \chbfn{2}{0}{\xione}\chbfn{2}{0}{\xitwo}\nodept{\vect{x}}{3} + \\ - & \chbfn{1}{1}{\xione}\chbfn{2}{0}{\xitwo}\delby{\nodept{\vect{x}}{2}}{s_{1}} - \nsftwo{2}{1}+ - \chbfn{2}{1}{\xione}\chbfn{2}{0}{\xitwo}\delby{\nodept{\vect{x}}{3}}{s_{1}} - \nsftwo{3}{1} + \\ - & \chbfn{1}{0}{\xione}\chbfn{2}{1}{\xitwo}\delby{\nodept{\vect{x}}{2}}{s_{2}} - \nsftwo{2}{2}+ - \chbfn{2}{0}{\xione}\chbfn{2}{1}{\xitwo}\delby{\nodept{\vect{x}}{2}}{s_{2}} - \nsftwo{3}{2} + \\ - & \chbfn{1}{1}{\xione}\chbfn{2}{1}{\xitwo}\deltwoby{\nodept{\vect{x}}{2}} - {s_{1}}{s_{2}}\nsftwo{2}{1}\nsftwo{2}{2} + - \chbfn{2}{1}{\xione}\chbfn{2}{1}{\xitwo}\deltwoby{\nodept{\vect{x}}{3}} - {s_{1}}{s_{2}}\nsftwo{3}{1}\nsftwo{3}{2} - \end{split} -\end{equation} -and the condition to avoid reversal of the normal is -\begin{equation} - \dotprod{\deltwoby{\nodept{\vect{x}}{n}}{s_{1}}{s_{2}}}{\delby{\nodept{\vect{x}} - {n}}{s_{1}}}<\dfrac{3}{\nsftwo{n}{2}} -\end{equation} -and for the apex node three element the interpolation formula is -\begin{equation} - \begin{split} - \fnof{\vect{x}}{\xione,\xitwo} &= - \chbfn{1}{0}{\xione}\chbfn{2}{0}{\xitwo}\nodept{\vect{x}}{1} + - \chbfn{2}{0}{\xione}\chbfn{2}{0}{\xitwo}\nodept{\vect{x}}{2} + - \chbfn{2}{0}{\xitwo}\nodept{\vect{x}}{3} + \\ - & \chbfn{1}{1}{\xione}\chbfn{1}{0}{\xitwo}\delby{\nodept{\vect{x}}{1}}{s_{1}} - \nsftwo{1}{1}+ - \chbfn{2}{1}{\xione}\chbfn{1}{0}{\xitwo}\delby{\nodept{\vect{x}}{2}}{s_{1}} - \nsftwo{2}{1} + \\ - & \chbfn{1}{0}{\xione}\chbfn{1}{1}{\xitwo}\delby{\nodept{\vect{x}}{1}}{s_{2}} - \nsftwo{1}{2}+ - \chbfn{2}{0}{\xione}\chbfn{1}{1}{\xitwo}\delby{\nodept{\vect{x}}{2}}{s_{2}} - \nsftwo{2}{2} + \\ - & \chbfn{1}{1}{\xione}\chbfn{1}{1}{\xitwo}\deltwoby{\nodept{\vect{x}}{1}} - {s_{1}}{s_{2}}\nsftwo{1}{1}\nsftwo{1}{2} + - \chbfn{2}{1}{\xione}\chbfn{1}{1}{\xitwo}\deltwoby{\nodept{\vect{x}}{2}} - {s_{1}}{s_{2}}\nsftwo{2}{1}\nsftwo{2}{2} - \end{split} -\end{equation} -with a condition of -\begin{equation} - \dotprod{\deltwoby{\nodept{\vect{x}}{n}}{s_{1}}{s_{2}}}{\delby{\nodept{\vect{x}} - {n}}{s_{1}}}>\dfrac{-3}{\nsftwo{n}{2}} -\end{equation} - -Although the Hermite-sector basis function in which the $s_{2}$ apex node -derivatives are identically zero have an increased limit on the -cross-derivative constraints (a right hand side numerator of $\pm 3$ instead -of $\pm 2$) they have the problem that as all derivatives vanish at the apex -any interpolated function has a zero Hessian at the apex. As this can cause -numerical problems the Hermite-sector basis functions which have an undefined -$s_{2}$ derivative are prefered. - - -\subsection{Simplex Basis Functions} - -Simplex basis function and its derivatives are evaluated with respect to external $\vect{\xi}$ coordinates. - -For Simplex line elements there are two area coordinates which are a function of $\xi_{1}$ \ie -\begin{align} - L_{1} &= 1 - \xi_{1} \\ - L_{2} &= \xi_{1} - 1 -\end{align} - -The derivatives wrt to external coordinates are then given by -\begin{align} - \delby{\vect{\sbfnsymb{}}}{\xi_{1}} &= \delby{\vect{\sbfnsymb{}}}{L_{2}}-\delby{\vect{\sbfnsymb{}}}{L_{1}} \\ - \deltwosqby{\vect{\sbfnsymb{}}}{\xi_{1}} &= \deltwosqby{\vect{\sbfnsymb{}}}{L_{1}}- - 2\deltwoby{\vect{\sbfnsymb{}}}{L_{1}}{L_{2}}+\deltwosqby{\vect{\sbfnsymb{}}}{L_{2}} -\end{align} - -For Simplex triangle elements there are three area coordinates which are a function of $\xi_{1}$ and -$\xi_{2}$ \ie -\begin{align} - L_{1} &= 1 - \xi_{1} \\ - L_{2} &= 1 - \xi_{2} \\ - L_{3} &= \xi_{1} + \xi_{2} - 1 -\end{align} - -The derivatives wrt to external coordinates are then given by -\begin{align} - \delby{\vect{\sbfnsymb{}}}{\xi_{1}} &= \delby{\vect{\sbfnsymb{}}}{L_{3}}-\delby{\vect{\sbfnsymb{}}}{L_{1}} \\ - \delby{\vect{\sbfnsymb{}}}{\xi_{2}} &= \delby{\vect{\sbfnsymb{}}}{L_{3}}-\delby{\vect{\sbfnsymb{}}}{L_{2}} \\ - \deltwosqby{\vect{\sbfnsymb{}}}{\xi_{1}} &= \deltwosqby{\vect{\sbfnsymb{}}}{L_{1}}- - 2\deltwoby{\vect{\sbfnsymb{}}}{L_{1}}{L_{3}}+\deltwosqby{\vect{\sbfnsymb{}}}{L_{3}} \\ - \deltwosqby{\vect{\sbfnsymb{}}}{\xi_{2}} &= \deltwosqby{\vect{\sbfnsymb{}}}{L_{2}}- - 2\deltwoby{\vect{\sbfnsymb{}}}{L_{2}}{L_{3}}+\deltwosqby{\vect{\sbfnsymb{}}}{L_{3}} \\ - \deltwoby{\vect{\sbfnsymb{}}}{\xi_{1}}{\xi_{2}} &= \deltwosqby{\vect{\sbfnsymb{}}}{L_{3}}- - \deltwoby{\vect{\sbfnsymb{}}}{L_{1}}{L_{3}}-\deltwoby{\vect{\sbfnsymb{}}}{L_{2}}{L_{3}}+ - \deltwoby{\vect{\sbfnsymb{}}}{L_{1}}{L_{2}} -\end{align} - -For Simplex tetrahedral elements there are four area coordinates which are a -function of $\xi_{1}$, $\xi_{2}$ and $\xi_{3}$ \ie -\begin{align} - L_{1} &= 1 - \xi_{1} \\ - L_{2} &= 1 - \xi_{2} \\ - L_{3} &= 1 - \xi_{3} \\ - L_{4} &= \xi_{1} + \xi_{2} + \xi_{3} - 2 -\end{align} - -The derivatives wrt to external coordinates are then given by -\begin{align} - \delby{\vect{\sbfnsymb{}}}{\xi_{1}} &= \delby{\vect{\sbfnsymb{}}}{L_{4}}-\delby{\vect{\sbfnsymb{}}}{L_{1}} \\ - \delby{\vect{\sbfnsymb{}}}{\xi_{2}} &= \delby{\vect{\sbfnsymb{}}}{L_{4}}-\delby{\vect{\sbfnsymb{}}}{L_{2}} \\ - \delby{\vect{\sbfnsymb{}}}{\xi_{3}} &= \delby{\vect{\sbfnsymb{}}}{L_{4}}-\delby{\vect{\sbfnsymb{}}}{L_{3}} \\ - \deltwosqby{\vect{\sbfnsymb{}}}{\xi_{1}} &= \deltwosqby{\vect{\sbfnsymb{}}}{L_{1}}- - 2\deltwoby{\vect{\sbfnsymb{}}}{L_{1}}{L_{4}}+\deltwosqby{\vect{\sbfnsymb{}}}{L_{4}} \\ - \deltwosqby{\vect{\sbfnsymb{}}}{\xi_{2}} &= \deltwosqby{\vect{\sbfnsymb{}}}{L_{2}}- - 2\deltwoby{\vect{\sbfnsymb{}}}{L_{2}}{L_{4}}+\deltwosqby{\vect{\sbfnsymb{}}}{L_{4}} \\ - \deltwosqby{\vect{\sbfnsymb{}}}{\xi_{3}} &= \deltwosqby{\vect{\sbfnsymb{}}}{L_{3}}- - 2\deltwoby{\vect{\sbfnsymb{}}}{L_{3}}{L_{4}}+\deltwosqby{\vect{\sbfnsymb{}}}{L_{4}} \\ - \deltwoby{\vect{\sbfnsymb{}}}{\xi_{1}}{\xi_{2}} &= \deltwosqby{\vect{\sbfnsymb{}}}{L_{4}}- - \deltwoby{\vect{\sbfnsymb{}}}{L_{1}}{L_{4}}-\deltwoby{\vect{\sbfnsymb{}}}{L_{2}}{L_{4}}+ - \deltwoby{\vect{\sbfnsymb{}}}{L_{1}}{L_{2}} \\ - \deltwoby{\vect{\sbfnsymb{}}}{\xi_{1}}{\xi_{3}} &= \deltwosqby{\vect{\sbfnsymb{}}}{L_{4}}- - \deltwoby{\vect{\sbfnsymb{}}}{L_{1}}{L_{4}}-\deltwoby{\vect{\sbfnsymb{}}}{L_{3}}{L_{4}}+ - \deltwoby{\vect{\sbfnsymb{}}}{L_{1}}{L_{3}} \\ - \deltwoby{\vect{\sbfnsymb{}}}{\xi_{2}}{\xi_{3}} &= \deltwosqby{\vect{\sbfnsymb{}}}{L_{4}}- - \deltwoby{\vect{\sbfnsymb{}}}{L_{2}}{L_{4}}-\deltwoby{\vect{\sbfnsymb{}}}{L_{3}}{L_{4}}+ - \deltwoby{\vect{\sbfnsymb{}}}{L_{2}}{L_{3}} \\ - \delthreeby{\vect{\sbfnsymb{}}}{\xi_{1}}{\xi_{2}}{\xi_{3}} &= \delthreecuby{\vect{\sbfnsymb{}}}{L_{4}}- - \deldeltwoby{\vect{\sbfnsymb{}}}{L_{1}}{L_{4}}-\deldeltwoby{\vect{\sbfnsymb{}}}{L_{2}}{L_{4}}- - \deldeltwoby{\vect{\sbfnsymb{}}}{L_{3}}{L_{4}}+ \\ - &\delthreeby{\vect{\sbfnsymb{}}}{L_{1}}{L_{2}}{L_{4}}+\delthreeby{\vect{\sbfnsymb{}}}{L_{1}}{L_{3}}{L_{4}}+ - \delthreeby{\vect{\sbfnsymb{}}}{L_{2}}{L_{3}}{L_{4}}-\delthreeby{\vect{\sbfnsymb{}}}{L_{1}}{L_{2}}{L_{3}} -\end{align} - -\section{Tensor Analysis} -\subsection{Base vectors} - -Now, if we have a vector, $\vect{v}$ we can write -\begin{equation} - \vect{v}=v^{i}\vect{g}_{i} -\end{equation} -where $v^{i}$ are the components of the contravariant vector, and -$\vect{g}_{i}$ are the covariant base vectors. - -Similarly, the vector $\vect{v}$ can also be written as -\begin{equation} - \vect{v}=v_{i}\vect{g}^{i} -\end{equation} -where $v_{i}$ are the components of the covariant vector, and -$\vect{g}^{i}$ are the contravariant base vectors. - -We now note that -\begin{equation} - \vect{v}=v^{i}\vect{g}_{i}=v^{i}\sqrt{g_{ii}}\hat{\vect{g}_{i}} -\end{equation} -where $v^{i}\sqrt{g_{ii}}$ are the physical components of the vector and -$\hat{\vect{g}_{i}}$ are the unit vectors given by -\begin{equation} - \hat{\vect{g}_{i}}=\dfrac{\vect{g}_{i}}{\sqrt{g_{ii}}} -\end{equation} - -\subsection{Metric Tensors} -\label{sec:metric tensors} - -Metric tensors are the inner product of base vectors. If $\vect{g}_{i}$ are the -covariant base vectors then the covariant metric tensor is given by -\begin{equation} - g_{ij}=\dotprod{\vect{g}_{i}}{\vect{g}_{j}} -\end{equation} - -Similarily if $\vect{g}^{i}$ are the contravariant base vectors then the -contravariant metric tensor is given by -\begin{equation} - g^{ij}=\dotprod{\vect{g}^{i}}{\vect{g}^{j}} -\end{equation} - -We can also form a mixed metric tensor from the dot product of a contravariant -and a covariant base vector \ie -\begin{equation} - g^{i}_{.j}=\dotprod{\vect{g}^{i}}{\vect{g}_{j}} -\end{equation} -and -\begin{equation} - g_{i}^{.j}=\dotprod{\vect{g}_{i}}{\vect{g}^{j}} -\end{equation} - -Note that for mixed tensors the ``.'' indicates the order of the index \ie -$g^{i}_{.j}$ indicates that the first index is contravariant and the second -index is covariant whereas $g_{i}^{.j}$ indicates that the first index is -covariant and the second index is contravariant. - -If the base vectors are all mutually orthogonal and constant then -$\vect{g}_{i}=\vect{g}^{i}$ and $g_{ij}=g^{ij}$. - -The metric tensors generalise (Euclidean) distance \ie -\begin{equation} - ds^{2}=g_{ij}dx^{i}dx^{j} -\end{equation} - -Note that multiplying by the covariant metric tensor lowers indices \ie -\begin{equation} - \begin{split} - \vect{A}_{i} &= g_{ij}\vect{A}^{j} \\ - A_{ij} &= g_{ik}g_{jl}A^{kl} = g_{jk}A_{i}^{.k} = g_{ik}A^{k}_{.j} - \end{split} -\end{equation} -and that multiplying by the contravariant metric tensor raises indices \ie -\begin{equation} - \begin{split} - \vect{A}^{i} &= g^{ij}\vect{A}_{j} \\ - A^{ij} &= g^{ik}g^{jl}A_{kl} = g^{ik}A_{k}^{.j} = g^{jk}A^{i}_{.k} - \end{split} -\end{equation} -and for the mixed tensors -\begin{equation} - \begin{split} - A_{i}^{.j} &= g^{jk}A_{ik} = g_{ik}A^{kj} \\ - A^{i}_{.j} &= g^{ik}A_{kj} = g_{jk}A^{ik} \\ - \end{split} -\end{equation} - -\subsection{Transformations} - -The transformation rules for tensors in going from a $\vect{\nu}$ coordinate -system to a $\vect{\xi}$ coordinate system are as follows: - - -For a covariant vector (a rank (0,1) tensor) -\begin{equation} - {\tilde{a}}_{i}=\delby{\nu^{a}}{\xi^{i}}a_{a} -\end{equation} - -For a contravariant vector (a rank (1,0) tensor) -\begin{equation} - {\tilde{a}}^{i}=\delby{\xi^{i}}{\nu^{a}}a^{a} -\end{equation} - -For a covariant tensor (a rank (0,2) tensor) -\begin{equation} - {\tilde{A}}_{ij}=\delby{\nu^{a}}{\xi^{i}}\delby{\nu^{b}}{\xi^{j}}A_{ab} -\end{equation} - -For a contravariant tensor (a rank (2,0) tensor) -\begin{equation} - {\tilde{A}}^{ij}=\delby{\xi^{i}}{\nu^{a}}\delby{\xi^{j}}{\nu^{b}}A^{ab} -\end{equation} - -and for Mixed tensors (rank (1,1) tensors) -\begin{equation} - {\tilde{A}}^{i}_{.j}=\delby{\xi^{i}}{\nu^{a}}\delby{\nu^{b}}{\xi^{j}}A^{a}_{.b} -\end{equation} -and -\begin{equation} - {\tilde{A}}_{i}^{.j}=\delby{\nu^{a}}{\xi^{i}}\delby{\xi^{j}}{\nu^{b}}A_{a}^{.b} -\end{equation} - -\subsection{Derivatives} -\label{subsec:function derivatives} - -\subsubsection{Scalars} - -We note that a scalar quantity $\fnof{u}{\vect{\xi}}$ has derivatives -\begin{equation} - \delby{u}{\xi^{i}}=\partialderiv{u}{i} -\end{equation} - -Or more formally, the covariant derivative ($\covarderiv{\cdot}{\cdot}$) of a -rank 0 tensor $u$ is -\begin{equation} - \covarderiv{u}{i}=\delby{u}{\xi^{i}}=\partialderiv{u}{i} -\end{equation} - -\subsubsection{Vectors} - -The derivatives of a vector $\vect{v}$ are given by -\begin{equation} - \begin{split} - \delby{\vect{v}}{\xi^{i}} &= - \delby{}{\xi^{i}}\pbrac{v^{k}\vect{g}_{k}} \\ - &= \delby{v^{k}}{\xi^{i}}\vect{g}_{k}+v^{k}\delby{\vect{g}_{k}}{\xi^{i}} \\ - &= \partialderiv{v^{k}}{i}\vect{g}_{k}+v^{k}\partialderiv{\vect{g}_{k}}{i} - \end{split} -\end{equation} - -Now introducing the notation -\begin{equation} - \christoffelsecond{i}{j}{k} = \dotprod{\vect{g}^{i}}{\delby{\vect{g}_{j}}{x^{k}}} -\end{equation} -where $\christoffelsecond{i}{j}{k}$ are the Christoffel symbols of the second -kind. - -Note that the Christoffel symbols of the first kind are given by -\begin{equation} - \christoffelfirst{i}{j}{k} = \dotprod{\vect{g}_{i}}{\delby{\vect{g}_{j}}{x^{k}}} -\end{equation} - -Note that -\begin{equation} - \begin{split} - \christoffel{i}{j}{k} &= \dotprod{\vect{g}^{i}}{\partialderiv{\vect{g}_{j}}{k}} \\ - &=\dotprod{\vect{g}^{i}}{\christoffelsecond{l}{j}{k}\vect{g}_{l}} \\ - &= \christoffel{i}{j}{l}g^{i}_{.l} - \end{split} -\end{equation} - -The Christoffel symbols of the first kind are also given by -\begin{equation} - \christoffelfirst{i}{j}{k}=\frac{1}{2}\pbrac{\delby{g_{ij}}{\xi^{k}}+\delby{g_{ik}}{\xi^{j}}-\delby{g_{jk}}{\xi^{i}}} -\end{equation} -and that Christoffel symbols of the second kind are given by -\begin{equation} - \begin{split} - \christoffelsecond{i}{j}{k} &= g^{il}\christoffelfirst{l}{j}{k} \\ - &= \frac{1}{2}g^{il}\pbrac{\delby{g_{lj}}{\xi^{k}}+\delby{g_{lk}}{\xi^{j}}-\delby{g_{jk}}{\xi^{l}}} - \end{split} -\end{equation} - -Note that Christoffel symbols are not tensors and the have the following -transformation laws from $\vect{\nu}$ to $\vect{\xi}$ coordinates -\begin{align} - \christoffelfirst{i}{j}{k} &= - \christoffelfirst{a}{b}{c}\delby{\nu^{b}}{\xi^{j}}\delby{\nu^{c}}{\xi^{k}}\delby{\nu^{a}}{\xi^{i}}+ - g_{ab}\delby{\nu^{c}}{\xi^{i}}\deltwoby{\nu^{c}}{\xi^{j}}{\xi^{k}} \\ - \christoffelsecond{i}{j}{k} &= \christoffelsecond{a}{b}{c}\delby{\xi^{i}}{\nu^{a}}\delby{\nu^{b}}{\xi^{k}}\delby{\nu^{c}}{\xi^{j}}+ - \delby{\xi^{i}}{\nu^{a}}\deltwoby{\nu^{a}}{\xi^{j}}{\xi^{k}} \\ -\end{align} - -We can now write (BELOW SEEMS WRONG - CHECK) -\begin{equation} - \begin{split} - \partialderiv{\vect{v}}{i}&=\partialderiv{v^{k}}{i}\vect{g}_{k}+\christoffel{k}{i}{j}v^{j}\vect{g}_{j}\\ - &=\partialderiv{v^{k}}{i}\vect{g}_{k}+\christoffel{j}{i}{k}v^{k}\vect{g}_{k}\\ - &=\pbrac{\partialderiv{v^{k}}{i}+\christoffel{j}{i}{k}v^{k}}\vect{g}_{k}\\ - &=\covarderiv{v^{k}}{i}\vect{g}_{k} - \end{split} -\end{equation} -where $\covarderiv{v^{k}}{i}$ is the covariant derivative of $v^{k}$ . - -The covariant derivative of a contravariant (rank (0,1)) tensor $v^{k}$ is -\begin{equation} - \covarderiv{v^{k}}{i} =\partialderiv{v^{k}}{i}+\christoffel{k}{i}{j}v^{j} -\end{equation} -and the covariant derivative of a covariant tensor (rank (1,0)) $v_{k}$ is -\begin{equation} - \covarderiv{v_{k}}{i} =\partialderiv{v_{k}}{i}-\christoffel{j}{k}{i}v_{j} -\end{equation} - -\subsubsection{Tensors} - -The covariant derivative of a contravariant (rank (0,2)) tensor $W^{mn}$ is -\begin{equation} - \covarderiv{W^{mn}}{i}=\partialderiv{W^{mn}}{i}+\christoffel{m}{j}{i}W^{jn}+\christoffel{n}{j}{i}W^{mj} -\end{equation} -and the covariant derivative of a covariant (rank (2,0)) tensor $W_{mn}$ is -\begin{equation} - \covarderiv{W_{mn}}{i}=\partialderiv{W_{mn}}{i}-\christoffel{j}{m}{i}W_{jn}-\christoffel{j}{n}{i}W_{mj} -\end{equation} -and the covariant derivative of a mixed (rank (1,1)) tensor $W^{m}_{.n}$ is -\begin{equation} - \covarderiv{W^{m}_{.n}}{i}=\partialderiv{W^{m}_{.n}}{i}+\christoffel{m}{j}{i}W^{j}_{.n}-\christoffel{j}{n}{i}W^{m}_{.j} -\end{equation} - -\subsection{Common Operators} - -For tensor equations to hold in any coordinate system the equations must -involve tensor quantities \ie covariant derivatives rather than partial derivatives. - -\subsubsection{Gradient} - -As the covariant derivative of a scalar is just the partial derivative the -gradient of a scalar function $\phi$ using covariant derivatives is -\begin{equation} - \text{grad } \phi = \gradient{\phi}=\covarderiv{\phi}{i}\vect{g}^{i}=\partialderiv{\phi}{i}\vect{g}^{i} -\end{equation} -and -\begin{equation} - \gradient{\phi}=\partialderiv{\phi}{i}\vect{g}^{i}=\partialderiv{\phi}{i}g^{ij}\vect{g}_{j} -\end{equation} - -\subsubsection{Divergence} - -The divergence of a vector using covariant derivatives is -\begin{equation} - \text{div } \vect{\phi} = \diverg{\vect{\phi}}=\covarderiv{\phi^{i}}{i}=\frac{1}{\sqrt{\abs{g}}}\partialderiv{\pbrac{\sqrt{\abs{g}}\phi^{i}}}{i} -\end{equation} -where $g$ is the determinant of the covariant metric tensor $g_{ij}$. - -\subsubsection{Curl} - -The curl of a vector using covariant derivatives is -\begin{equation} - \text{curl } \vect{\phi} = \curl{\vect{\phi}}=\frac{1}{\sqrt{g}}\pbrac{\covarderiv{\phi_{j}}{i}-\covarderiv{\phi_{i}}{j}}\vect{g}_{k} -\end{equation} -where $g$ is the determinant of the covariant metric tensor $g_{ij}$. - -\subsubsection{Laplacian} - -The Laplacian of a scalar using covariant derivatives is -\begin{equation} - \laplacian{\phi}=\text{div}\pbrac{\text{grad }\phi}=\diverg{\gradient{\phi}}=\mixedderiv{\phi}{i}{i}=\frac{1}{\sqrt{g}}\partialderiv{\pbrac{\sqrt{g}g^{ij}\partialderiv{\phi}{j}}}{i} -\end{equation} -where $g$ is the determinant of the covariant metric tensor $g_{ij}$. - -The Laplacian of a vector using covariant derivatives is -\begin{equation} - \laplacian{\vect{\phi}}=\text{grad }\pbrac{\text{div }\vect{\phi}}-\text{curl } \pbrac{\text{curl }\vect{\phi}}==\mixedderiv{\vect{\phi}}{i}{i} -\end{equation} - -The Laplacian of a contravariant (rank (0,1)) tensor $\phi^{k}$ is -\begin{equation} - \laplacian{\vect{\phi}}=\pbrac{\laplacian{\phi_{k}}-2g^{ij}\christoffel{K}{j}{H}\delby{\phi^{h}}{x^{i}}+\phi^{h}\delby{g^{ij}\christoffel{K}{i}{j}}{x^{h}}}\vect{e}^{k} -\end{equation} -and the covariant derivative of a covariant tensor (rank (1,0)) $\phi_{k}$ is -\begin{equation} - \laplacian{\vect{\phi}}=\pbrac{\laplacian{\phi_{k}}-2g^{ij}\christoffel{h}{j}{k}\delby{\phi_{h}}{x^{i}}+\phi_{h}g^{ij}\delby{\christoffel{h}{i}{j}}{x^{i}}}\vect{e}_{k} -\end{equation} - -\subsection{Coordinate Systems} -\label{sec:coordinate systems} - -\subsubsection{Rectangular Cartesian} - -The base vectors with respect to the global coordinate system are -\begin{equation} - \vect{g}_{i}=\begin{bmatrix} - \vect{i}_{1} \\ - \vect{i}_{2} \\ - \vect{i}_{3} - \end{bmatrix} -\end{equation} - -The covariant metric tensor is -\begin{equation} - g_{ij}=\begin{bmatrix} - 1 & 0 & 0 \\ - 0 & 1 & 0 \\ - 0 & 0 & 1 - \end{bmatrix} -\end{equation} -and the contravariant metric tensor is -\begin{equation} - g^{ij}=\begin{bmatrix} - 1 & 0 & 0 \\ - 0 & 1 & 0 \\ - 0 & 0 & 1 - \end{bmatrix} -\end{equation} - -The Christoffel symbols of the second kind are all zero. - -\subsubsection{Cylindrical Polar} - -The global coordinates $\pbrac{x,y,z}$ with respect to the cylindrical polar -coordinates $\pbrac{r,\theta,z}$ are defined by -\begin{equation} - \begin{aligned} - x = r\cos\theta & \qquad r \ge0 \\ - y = r\sin\theta & \qquad 0 \le\theta\le2\pi \\ - z = z & \qquad -\infty < z < \infty - \end{aligned} -\end{equation} - -The base vectors with respect to the global coordinate system are -\begin{equation} - \vect{g}_{i}=\begin{bmatrix} - \cos\theta\vect{i}_{1} + \sin\theta\vect{i}_{2} \\ - -r\sin\theta\vect{i}_{1}+ r\cos\theta\vect{i}_{2} \\ - \vect{i}_{3} - \end{bmatrix} -\end{equation} - -The covariant metric tensor is -\begin{equation} - g_{ij}=\begin{bmatrix} - 1 & 0 & 0 \\ - 0 & r^{2} & 0 \\ - 0 & 0 & 1 - \end{bmatrix} -\end{equation} -and the contravariant metric tensor is -\begin{equation} - g^{ij}=\begin{bmatrix} - 1 & 0 & 0 \\ - 0 & \frac{1}{r^{2}} & 0 \\ - 0 & 0 & 1 - \end{bmatrix} -\end{equation} - -The Christoffell symbols of the second kind are -\begin{align} - \christoffelsecond{r}{\theta}{\theta}&=-r \\ - \christoffelsecond{\theta}{r}{\theta}=\christoffelsecond{\theta}{\theta}{r}&=\frac{1}{r} -\end{align} -with all other Christoffell symbols zero. - -\subsubsection{Spherical Polar} - -The global coordinates $\pbrac{x,y,z}$ with respect to the cylindrical polar -coordinates $\pbrac{r,\theta,\phi}$ are defined by -\begin{equation} - \begin{aligned} - x = r\cos\theta\sin\phi & \qquad r \ge 0 \\ - y = r\sin\theta\sin\phi & \qquad 0 \le \theta \le 2\pi \\ - z = r\cos\phi & \qquad 0 \le \phi \le \pi - \end{aligned} -\end{equation} - -The base vectors with respect to the spherical polar coordinate system are -\begin{equation} - \vect{g}_{i}=\begin{bmatrix} - \cos\theta\sin\phi\vect{i}_{1}+\sin\theta\sin\phi\vect{i}_{2}+\cos\phi\vect{i}_{3} \\ - -r\sin\theta\sin\phi\vect{i}_{1}+r\cos\theta\sin\phi\vect{i}_{2} \\ - r\cos\theta\cos\phi\vect{i}_{1}+r\sin\theta\cos\phi\vect{i}_{2}-r\sin\phi\vect{i}_{3} - \end{bmatrix} -\end{equation} - -The covariant metric tensor is -\begin{equation} - g_{ij}=\begin{bmatrix} - 1 & 0 & 0 \\ - 0 & r^{2}\sin^{2}\phi & 0 \\ - 0 & 0 & r^{2} - \end{bmatrix} -\end{equation} -and the contravariant metric tensor is -\begin{equation} - g^{ij}=\begin{bmatrix} - 1 & 0 & 0 \\ - 0 & \frac{1}{r^{2}\sin^{2}\phi} & 0 \\ - 0 & 0 & \frac{1}{r^{2}} - \end{bmatrix} -\end{equation} - -The Christoffell symbols of the second kind are -\begin{align} - \christoffelsecond{r}{\theta}{\theta}&=-r\sin^{2}\phi \\ - \christoffelsecond{r}{\phi}{\phi}&=-r \\ - \christoffelsecond{\phi}{\theta}{\theta}&=-\sin\phi\cos\phi \\ - \christoffelsecond{\theta}{r}{\theta}=\christoffelsecond{\theta}{\theta}{r}&=\frac{1}{r} \\ - \christoffelsecond{\phi}{r}{\phi}=\christoffelsecond{\phi}{\phi}{r}&=\frac{1}{r} \\ - \christoffelsecond{\theta}{\theta}{\phi}=\christoffelsecond{\theta}{\phi}{\theta}&=\cot\phi -\end{align} -with all other Christofell symbols zero. - -\subsubsection{Prolate Spheroidal} - -The global coordinates $\pbrac{x,y,z}$ with respect to the prolate spheroidal -coordinates $\pbrac{\lambda,\mu,\theta}$ are defined by -\begin{equation} - \begin{aligned} - x = a\sinh\lambda\sin\mu\cos\theta & \qquad \lambda \ge 0 \\ - y = a\sinh\lambda\sin\mu\sin\theta & \qquad 0 \le \mu \le \pi \\ - z = a\cosh\lambda\cos\mu & \qquad 0 \le \theta \le 2\pi - \end{aligned} -\end{equation} -where $a\ge0$ is the focus. - -The base vectors with respect to the global coordinate system are -\begin{equation} - \vect{g}_{i}=\begin{bmatrix} - a\cosh\lambda\sin\mu\cos\theta\vect{i}_{1}+a\cosh\lambda\sin\mu\sin\theta\vect{i}_{2}+a\sinh\lambda\cos\mu\vect{i}_{3}\\ - a\sinh\lambda\cos\mu\cos\theta\vect{i}_{1}+a\sinh\lambda\cos\mu\sin\theta\vect{i}_{2}-a\cosh\lambda\sin\mu\vect{i}_{3}\\ - -a\sinh\lambda\sin\mu\sin\theta\vect{i}_{1}+a\sinh\lambda\sin\mu\cos\theta\vect{i}_{2} - \end{bmatrix} -\end{equation} - -The covariant metric tensor is -\begin{equation} - g_{ij}=\begin{bmatrix} - a^{2}\pbrac{\sinh^{2}\lambda+\sin^{2}\mu} & 0 & 0 \\ - 0 & a^{2}\pbrac{\sinh^{2}\lambda+\sin^{2}\mu} & 0 \\ - 0 & 0 & a^{2}\sinh^{2}\lambda\sin^{2}\mu - \end{bmatrix} -\end{equation} -and the contravariant metric tensor is -\begin{equation} - g^{ij}=\begin{bmatrix} - \frac{1}{a^{2}\pbrac{\sinh^{2}\lambda+\sin^{2}\mu}}& 0 & 0 \\ - 0 & \frac{1}{a^{2}\pbrac{\sinh^{2}\lambda+\sin^{2}\mu}} & 0 \\ - 0 & 0 & \frac{1}{a^{2}\sinh^{2}\lambda\sin^{2}\mu} - \end{bmatrix} -\end{equation} - -The Christoffell symbols of the second kind are -\begin{align} - \christoffelsecond{\lambda}{\lambda}{\lambda}&=\frac{\sinh\lambda\cosh\lambda}{\sinh^{2}\lambda+\sin^{2}\mu} \\ - \christoffelsecond{\lambda}{\mu}{\mu}&=\frac{-\sinh\lambda\cosh\lambda}{\sinh^{2}\lambda+\sin^{2}\mu} \\ - \christoffelsecond{\lambda}{\theta}{\theta}&=\frac{-\sinh\lambda\cosh\lambda\sin^{2}\mu}{\sinh^{2}\lambda+\sin^{2}\mu} \\ - \christoffelsecond{\lambda}{\lambda}{\mu}&=\frac{\sin\mu\cos\mu}{\sinh^{2}\lambda+\sin^{2}\mu} \\ - \christoffelsecond{\mu}{\mu}{\mu}&=\frac{\sin\mu\cos\mu}{\sinh^{2}\lambda+\sin^{2}\mu} \\ - \christoffelsecond{\mu}{\lambda}{\lambda}&=\frac{-\sin\mu\cos\mu}{\sinh^{2}\lambda+\sin^{2}\mu} \\ - \christoffelsecond{\mu}{\theta}{\theta}&=\frac{-\sinh^{2}\lambda\sin\mu\cos\mu}{\sinh^{2}\lambda+\sin^{2}\mu} \\ - \christoffelsecond{\mu}{\mu}{\lambda}&=\frac{\sinh\lambda\cosh\lambda}{\sinh^{2}\lambda+\sin^{2}\mu} \\ - \christoffelsecond{\theta}{\theta}{\lambda}&=\frac{\cosh\lambda}{\sinh\lambda} \\ - \christoffelsecond{\theta}{\theta}{\mu}&=\frac{\cos\mu}{\sin\mu} \\ - \end{align} -with all other Christofell symbols zero. - -\subsubsection{Oblate Spheroidal} - -The global coordinates $\pbrac{x,y,z}$ with respect to the oblate spheroidal -coordinates $\pbrac{\lambda,\mu,\theta}$ are defined by -\begin{equation} - \begin{aligned} - x = a\cosh\lambda\cos\mu\cos\theta & \qquad \lambda \ge 0 \\ - y = a\cosh\lambda\cos\mu\sin\theta & \qquad \frac{-\pi}{2} \le \mu \le \frac{\pi}{2} \\ - z = a\sinh\lambda\sin\mu & \qquad 0 \le \theta \le 2\pi - \end{aligned} -\end{equation} -where $a\ge0$ is the focus. - -The base vectors with respect to the global coordinate system are -\begin{equation} - \vect{g}_{i}=\begin{bmatrix} - a\sinh\lambda\cos\mu\cos\theta\vect{i}_{1}+a\sinh\lambda\cos\mu\sin\theta\vect{i}_{2}+a\cosh\lambda\sin\mu\vect{i}_{3}\\ - -a\cosh\lambda\sin\mu\cos\theta\vect{i}_{1}-a\cosh\lambda\sin\mu\sin\theta\vect{i}_{2}+a\sinh\lambda\cos\mu\vect{i}_{3}\\ - -a\cosh\lambda\cos\mu\sin\theta\vect{i}_{1}+a\cosh\lambda\cos\mu\cos\theta\vect{i}_{2} - \end{bmatrix} -\end{equation} - -The covariant metric tensor is -\begin{equation} - g_{ij}=\begin{bmatrix} - a^{2}\pbrac{\sinh^{2}\lambda+\sin^{2}\mu} & 0 & 0 \\ - 0 & a^{2}\pbrac{\sinh^{2}\lambda+\sin^{2}\mu} & 0 \\ - 0 & 0 & a^{2}\cosh^{2}\lambda\cos^{2}\mu - \end{bmatrix} -\end{equation} -and the contravariant metric tensor is -\begin{equation} - g^{ij}=\begin{bmatrix} - \frac{1}{a^{2}\pbrac{\sinh^{2}\lambda+\sin^{2}\mu}}& 0 & 0 \\ - 0 & \frac{1}{a^{2}\pbrac{\sinh^{2}\lambda+\sin^{2}\mu}} & 0 \\ - 0 & 0 & \frac{1}{a^{2}\cosh^{2}\lambda\cos^{2}\mu} - \end{bmatrix} -\end{equation} - -The Christoffell symbols of the second kind are -\begin{align} - \christoffelsecond{\lambda}{\lambda}{\lambda}&=\frac{\sinh\lambda\cosh\lambda}{\sinh^{2}\lambda+\sin^{2}\mu} \\ - \christoffelsecond{\lambda}{\mu}{\mu}&=\frac{-\sinh\lambda\cosh\lambda}{\sinh^{2}\lambda+\sin^{2}\mu} \\ - \christoffelsecond{\lambda}{\theta}{\theta}&=\frac{-\sinh\lambda\cosh\lambda\cos^{2}\mu}{\sinh^{2}\lambda+\sin^{2}\mu} \\ - \christoffelsecond{\lambda}{\lambda}{\mu}&=\frac{\sin\mu\cos\mu}{\sinh^{2}\lambda+\sin^{2}\mu} \\ - \christoffelsecond{\mu}{\mu}{\mu}&=\frac{\sin\mu\cos\mu}{\sinh^{2}\lambda+\sin^{2}\mu} \\ - \christoffelsecond{\mu}{\lambda}{\lambda}&=\frac{-\sin\mu\cos\mu}{\sinh^{2}\lambda+\sin^{2}\mu} \\ - \christoffelsecond{\mu}{\theta}{\theta}&=\frac{\cosh^{2}\lambda\sin\mu\cos\mu}{\sinh^{2}\lambda+\sin^{2}\mu} \\ - \christoffelsecond{\mu}{\mu}{\lambda}&=\frac{\sinh\lambda\cosh\lambda}{\sinh^{2}\lambda+\sin^{2}\mu} \\ - \christoffelsecond{\theta}{\theta}{\lambda}&=\frac{\sinh\lambda}{\cosh\lambda} \\ - \christoffelsecond{\theta}{\theta}{\mu}&=\frac{-\sin\mu}{\cos\mu} \\ -\end{align} -with all other Christofell symbols zero. - -\subsubsection{Cylindrical parabolic} - -The global coordinates $\pbrac{x,y,z}$ with respect to the cylindrical parabolic -coordinates $\pbrac{\xi,\eta,z}$ are defined by -\begin{equation} - \begin{aligned} - x = \xi\eta & \qquad -\infty < \xi < \infty \\ - y = \frac{1}{2}\pbrac{\xi^{2}-\eta^{2}} & \qquad \eta \ge 0 \\ - z = z & \qquad -\infty < z < \infty - \end{aligned} -\end{equation} - -The base vectors with respect to the global coordinate system are -\begin{equation} - \vect{g}_{i}=\begin{bmatrix} - \eta\vect{i}_{1}+\xi\vect{i}_{2}\\ - \xi\vect{i}_{1}-\eta\vect{i}_{2}\\ - \vect{i}_{3} - \end{bmatrix} -\end{equation} - -The covariant metric tensor is -\begin{equation} - g_{ij}=\begin{bmatrix} - \xi^{2}+\eta^{2} & 0 & 0 \\ - 0 & \xi^{2}+\eta^{2} & 0 \\ - 0 & 0 & 1 - \end{bmatrix} -\end{equation} -and the contravariant metric tensor is -\begin{equation} - g^{ij}=\begin{bmatrix} - \frac{1}{\xi^{2}+\eta^{2}}& 0 & 0 \\ - 0 & \frac{1}{\xi^{2}+\eta^{2}} & 0 \\ - 0 & 0 & 1 - \end{bmatrix} -\end{equation} - -The Christoffell symbols of the second kind are -\begin{align} - \christoffelsecond{\xi}{\xi}{\xi}&=\frac{\xi}{\xi^{2}+\eta^{2}} \\ - \christoffelsecond{\eta}{\eta}{\eta}&=\frac{\eta}{\xi^{2}+\eta^{2}} \\ - \christoffelsecond{\eta}{\xi}{\xi}&=\frac{-\eta}{\xi^{2}+\eta^{2}} \\ - \christoffelsecond{\xi}{\eta}{\eta}&=\frac{-\xi}{\xi^{2}+\eta^{2}} \\ - \christoffelsecond{\xi}{\xi}{\eta}=\christoffelsecond{\xi}{\eta}{\xi}&=\frac{\eta}{\xi^{2}+\eta^{2}} \\ - \christoffelsecond{\eta}{\xi}{\eta}=\christoffelsecond{\eta}{\eta}{\xi}&=\frac{\xi}{\xi^{2}+\eta^{2}} \\ -\end{align} -with all other Christofell symbols zero. - -\subsubsection{Parabolic polar} - -The global coordinates $\pbrac{x,y,z}$ with respect to the cylindrical parabolic -coordinates $\pbrac{\xi,\eta,\theta}$ are defined by -\begin{equation} - \begin{aligned} - x = \xi\eta\cos\theta & \qquad \xi \ge 0 \\ - y = \xi\eta\sin\theta & \qquad \eta \ge 0 \\ - z = \frac{1}{2}\pbrac{\xi^{2}-\eta^{2}} & \qquad 0 \le \theta < 2\pi - \end{aligned} -\end{equation} - -The base vectors with respect to the global coordinate system are -\begin{equation} - \vect{g}_{i}=\begin{bmatrix} - \eta\cos\theta\vect{i}_{1}+\eta\sin\theta\vect{i}_{3}+\xi\vect{i}_{3}\\ - \xi\cos\theta\vect{i}_{1}+\xi\sin\theta\vect{i}_{3}-\eta\vect{i}_{3}\\ - -\xi\eta\sin\theta\vect{i}_{1}+\xi\eta\cos\theta\vect{i}_{2} - \end{bmatrix} -\end{equation} - -The covariant metric tensor is -\begin{equation} - g_{ij}=\begin{bmatrix} - \xi^{2}+\eta^{2} & 0 & 0 \\ - 0 & \xi^{2}+\eta^{2} & 0 \\ - 0 & 0 & \xi\eta - \end{bmatrix} -\end{equation} -and the contravariant metric tensor is -\begin{equation} - g^{ij}=\begin{bmatrix} - \frac{1}{\xi^{2}+\eta^{2}}& 0 & 0 \\ - 0 & \frac{1}{\xi^{2}+\eta^{2}} & 0 \\ - 0 & 0 & \frac{1}{\xi\eta} - \end{bmatrix} -\end{equation} - -The Christoffell symbols of the second kind are -\begin{align} - \christoffelsecond{\xi}{\xi}{\xi}&=\frac{\xi}{\xi^{2}+\eta^{2}} \\ - \christoffelsecond{\eta}{\eta}{\eta}&=\frac{\eta}{\xi^{2}+\eta^{2}} \\ - \christoffelsecond{\xi}{\eta}{\eta}&=\frac{-\xi}{\xi^{2}+\eta^{2}} \\ - \christoffelsecond{\eta}{\xi}{\xi}&=\frac{-\eta}{\xi^{2}+\eta^{2}} \\ - \christoffelsecond{\eta}{\theta}{\theta}&=\frac{-\xi^{2}\eta}{\xi^{2}+\eta^{2}} \\ - \christoffelsecond{\xi}{\theta}{\theta}&=\frac{-\xi\eta^{2}}{\xi^{2}+\eta^{2}} \\ - \christoffelsecond{\xi}{\xi}{\eta}=\christoffelsecond{\xi}{\eta}{\xi}&=\frac{\eta}{\xi^{2}+\eta^{2}} \\ - \christoffelsecond{\eta}{\xi}{\eta}=\christoffelsecond{\eta}{\eta}{\xi}&=\frac{\xi}{\xi^{2}+\eta^{2}} \\ - \christoffelsecond{\theta}{\xi}{\theta}=\christoffelsecond{\theta}{\theta}{\xi}&=\frac{1}{\xi} \\ - \christoffelsecond{\theta}{\eta}{\theta}=\christoffelsecond{\theta}{\theta}{\eta}&=\frac{1}{\eta} \\ -\end{align} -with all other Christofell symbols zero. - -\section{Equation set types} - -\subsection{Static Equations} - -The general form for static equations is - -\subsection{Dynamic Equations} - -The general form for dynamic equations is -\begin{equation} - \matr{M}\fnof{\ddot{\vect{u}}}{t}+\matr{C}\fnof{\dot{\vect{u}}}{t}+\matr{K}\fnof{\vect{u}}{t}+ - \fnof{\vect{g}}{\fnof{\vect{u}}{t}}+\fnof{\vect{f}}{t}=\vect{0} - \label{eqn:generaldynamicnonlinear} -\end{equation} -where $\fnof{\vect{u}}{t}$ is the unknown ``displacement vector'', $\matr{M}$ -is the mass matrix, $\matr{C}$ is the damping matrix, $\matr{K}$ is the -stiffness matrix, $\fnof{\vect{g}}{\fnof{\vect{u}}{t}}$ a non-linear vector -function and $\fnof{\vect{f}}{t}$ the forcing vector. - -From \cite{zienkiewicz:2006_1} we now expand the unknown vector $\fnof{\vect{u}}{t}$ in terms of a polynomial of degree -$p$. With the known values of $\vect{u}_{n}$, $\dot{\vect{u}}_{n}$, -$\ddot{\vect{u}}_{n}$ up to $\symover{p-1}{\vect{u}}_{n}$ at the beginning of -the time step $\Delta t$ we can write the polynomial expansion as -\begin{equation} - \fnof{\vect{u}}{t_{n}+\tau}\approx\fnof{\tilde{\vect{u}}}{t_{n}+\tau}=\vect{u}_{n}+\tau\dot{\vect{u}}_{n}+ - \frac{1}{2!}\tau^{2}\ddot{\vect{u}}_{n}+\cdots+\dfrac{1}{\factorial{p-1}}\tau^{p-1}\symover{p-1}{\vect{u}}_{n}+ - \dfrac{1}{p!}\tau^{p}\vect{\alpha}^{p}_{n} - \label{eqn:timepolyexpansion} -\end{equation} -where the only unknown is the the vector $\vect{\alpha}^{p}_{n}$, -\begin{equation} - \vect{\alpha}^{p}_{n}\approx\symover{p}{\vect{u}}\equiv\dnby{p}{\vect{u}}{t} -\end{equation} - -A recurrance relationship can be established by substituting -\eqnref{eqn:timepolyexpansion} into \eqnref{eqn:generaldynamicnonlinear} and -taking a weighted residual approach \ie -\begin{multline} - \dintl{0}{\Delta - t}\fnof{W}{\tau}\left[\matr{M}\pbrac{\ddot{\vect{u}}_{n}+\tau\dddot{\vect{u}}_{n}+\cdots+ - \dfrac{1}{\factorial{p-2}}\tau^{p-2}\vect{\alpha}^{p}_{n}} \right.\\ - +\matr{C}\pbrac{\dot{\vect{u}}_{n}+\tau\ddot{\vect{u}}_{n}+\cdots+ - \dfrac{1}{\factorial{p-1}}\tau^{p-1}\vect{\alpha}^{p}_{n}} \\ - +\matr{K}\pbrac{\vect{u}_{n}+\tau\dot{\vect{u}}_{n}+\cdots+ - \dfrac{1}{p!}\tau^{p}\vect{\alpha}^{p}_{n}} \\ - +\left.\fnof{\vect{g}}{\vect{u}_{n}+\tau\dot{\vect{u}}_{n}+\cdots+ - \dfrac{1}{p!}\tau^{p}\vect{\alpha}^{p}_{n}}+\fnof{\vect{f}}{t_{n}+\tau}\right] d\tau = \vect{0} -\end{multline} -where $\fnof{W}{\tau}$ is some weight function, $\tau=t-t_{n}$ and $\Delta -t=t_{n+1}-t_{n}$. Dividing by $\gint{0}{\Delta t}{\fnof{W}{\tau}}{\tau}$ we obtain -\begin{multline} - \dfrac{\gint{0}{\Delta t}{\fnof{W}{\tau}\matr{M}\pbrac{\ddot{\vect{u}}_{n}+\tau\dddot{\vect{u}}_{n}+\cdots+ - \dfrac{1}{\factorial{p-2}}\tau^{p-2}\vect{\alpha}^{p}_{n}}}{\tau}}{\gint{0}{\Delta - t}{\fnof{W}{\tau}}{\tau}} \\ - + \dfrac{\gint{0}{\Delta t}{\fnof{W}{\tau}\matr{C}\pbrac{\dot{\vect{u}}_{n}+\tau\ddot{\vect{u}}_{n}+\cdots+ - \dfrac{1}{\factorial{p-1}}\tau^{p-1}\vect{\alpha}^{p}_{n}}}{\tau}}{\gint{0}{\Delta - t}{\fnof{W}{\tau}}{\tau}} \\ - + \dfrac{\gint{0}{\Delta t}{\fnof{W}{\tau}\matr{K}\pbrac{\vect{u}_{n}+\tau\dot{\vect{u}}_{n}+\cdots+ - \dfrac{1}{p!}\tau^{p}\vect{\alpha}^{p}_{n}}}{\tau}}{\gint{0}{\Delta - t}{\fnof{W}{\tau}}{\tau}} \\ - + \dfrac{\gint{0}{\Delta t}{\fnof{W}{\tau}\fnof{\vect{g}}{\vect{u}_{n}+\tau\dot{\vect{u}}_{n}+\cdots+ - \dfrac{1}{p!}\tau^{p}\vect{\alpha}^{p}_{n}}}{\tau}}{\gint{0}{\Delta - t}{\fnof{W}{\tau}}{\tau}} - + \dfrac{\gint{0}{\Delta t}{\fnof{W}{\tau}\fnof{\vect{f}}{t_{n}+ - \tau}}{\tau}}{\gint{0}{\Delta t}{\fnof{W}{\tau}}{\tau}}=\vect{0} -\end{multline} - -Now if -\begin{equation} - \theta_{k}=\dfrac{\gint{0}{\Delta t}{\fnof{W}{\tau}\tau^{k}}{\tau}}{{\Delta - t}^{k}\gint{0}{\Delta t}{\fnof{W}{\tau}}{\tau}} \text{ for } k=0,1,\ldots,p -\end{equation} -and -\begin{equation} - \bar{\vect{f}}=\dfrac{\gint{0}{\Delta - t}{\fnof{W}{\tau}\fnof{\vect{f}}{t_{n}+\tau}}{\tau}}{ - \gint{0}{\Delta t}{\fnof{W}{\tau}}{\tau}} - \label{eqn:meanweightedloadvector} -\end{equation} -we can write -\begin{multline} - \matr{M}\pbrac{\ddot{\bar{\vect{u}}}_{n+1}+\dfrac{\theta_{p-2}{\Delta - t}^{p-2}}{\factorial{p-2}}\vect{\alpha}^{p}_{n}}+ - \matr{C}\pbrac{\dot{\bar{\vect{u}}}_{n+1}+\dfrac{\theta_{p-1}{\Delta - t}^{p-1}}{\factorial{p-1}}\vect{\alpha}^{p}_{n}}+ - \matr{K}\pbrac{\bar{\vect{u}}_{n+1}+\dfrac{\theta_{p}{\Delta - t}^{p}}{p!}\vect{\alpha}^{p}_{n}}+ \\ - + \dfrac{\gint{0}{\Delta t}{\fnof{W}{\tau}\fnof{\vect{g}}{\vect{u}_{n}+\tau\dot{\vect{u}}_{n}+\cdots+ - \dfrac{1}{p!}\tau^{p}\vect{\alpha}^{p}_{n}}}{\tau}}{\gint{0}{\Delta - t}{\fnof{W}{\tau}}{\tau}}+\bar{\vect{f}}=\vect{0} - \label{eqn:dynamic1} -\end{multline} -where -\begin{equation} - \begin{split} - \bar{\vect{u}}_{n+1} &= \gsum{q=0}{p-1}{\dfrac{\theta_{q}{\Delta - t}^{q}}{q!}\symover{q}{\vect{u}}_{n}} \\ - \dot{\bar{\vect{u}}}_{n+1} &= \gsum{q=1}{p-1}{\dfrac{\theta_{q-1}{\Delta - t}^{q-1}}{\factorial{q-1}}\symover{q}{\vect{u}}_{n}} \\ - \ddot{\bar{\vect{u}}}_{n+1} &= \gsum{q=2}{p-1}{\dfrac{\theta_{q-2}{\Delta - t}^{q-2}}{\factorial{q-2}}\symover{q}{\vect{u}}_{n}} - \end{split} -\end{equation} - -We note that as $\fnof{\vect{g}}{\fnof{\vect{u}}{t}}$ is nonlinear we need to -evaluate an integral of the form -\begin{equation} - \gint{0}{\Delta t}{\fnof{W}{\tau}\fnof{\vect{g}}{\fnof{\vect{u}}{t_{n}+\tau}}}{\tau} -\end{equation} - -To do this we form Taylor's series expansions for -$\fnof{\vect{g}}{\fnof{\vect{u}}{t}}$ about the point $\fnof{\vect{u}}{t_{n}+\tau}$ \ie -\begin{equation} - \fnof{\vect{g}}{\fnof{\vect{u}}{t_{n}}}=\fnof{\vect{g}}{\fnof{\vect{u}}{t_{n}+\tau}}- - \tau\delby{\fnof{\vect{g}}{\fnof{\vect{u}}{t}}}{\vect{u}}\evalat{\delby{\fnof{\vect{u}}{t}}{t}}{t_{n}+\tau} - + \orderof{\tau^{2}} - \label{eqn:firstTaylorexpansion} -\end{equation} -and -\begin{equation} - \fnof{\vect{g}}{\fnof{\vect{u}}{t_{n+1}}}=\fnof{\vect{g}}{\fnof{\vect{u}}{t_{n}+\tau}}+ - \pbrac{t_{n+1}-t_{n}-\tau}\delby{\fnof{\vect{g}}{\fnof{\vect{u}}{t}}}{\vect{u}} - \evalat{\delby{\fnof{\vect{u}}{t}}{t}}{t_{n}+\tau}+ \orderof{\tau^{2}} - \label{eqn:secondTaylorexpansion} -\end{equation} - -Now if we add $\dfrac{1}{\tau}$ times \eqnref{eqn:firstTaylorexpansion} and -$\dfrac{1}{t_{n+1}-t_{n}-\tau}=\dfrac{1}{\Delta t-\tau}$ times -\eqnref{eqn:secondTaylorexpansion} we obtain -\begin{equation} - \dfrac{\fnof{\vect{g}}{\fnof{\vect{u}}{t_{n}}}}{\tau}+\dfrac{\fnof{\vect{g}}{\fnof{\vect{u}}{t_{n+1}}}}{\Delta - t-\tau}=\pbrac{\dfrac{\Delta t}{\tau\pbrac{\Delta t-\tau}}}\fnof{\vect{g}}{\fnof{\vect{u}}{t_{n}+\tau}}+ - \pbrac{\dfrac{\Delta t}{\tau\pbrac{\Delta t-\tau}}}\orderof{\tau^{2}} -\end{equation} - -Multiplying through by $\dfrac{\tau\pbrac{\Delta t-\tau}}{\Delta t}$ gives -\begin{equation} - \dfrac{\Delta t-\tau}{\Delta t}\fnof{\vect{g}}{\fnof{\vect{u}}{t_{n}}}+ - \dfrac{\tau}{\Delta t}\fnof{\vect{g}}{\fnof{\vect{u}}{t_{n+1}}}= - \fnof{\vect{g}}{\fnof{\vect{u}}{t_{n}+\tau}}+\orderof{\tau^{2}} -\end{equation} - -Therefore -\begin{equation} - \dfrac{\gint{0}{\Delta t}{\fnof{W}{\tau}\fnof{\vect{g}}{\fnof{\vect{u}}{t_{n}+\tau}}}{\tau}} - {\gint{0}{\Delta t}{\fnof{W}{\tau}}{\tau}}=\dfrac{\gint{0}{\Delta t}{\fnof{W}{\tau} - \pbrac{\dfrac{\Delta t-\tau}{\Delta t}\fnof{\vect{g}}{\fnof{\vect{u}}{t_{n}}}+ - \dfrac{\tau}{\Delta t}\fnof{\vect{g}}{\fnof{\vect{u}}{t_{n+1}}}+\orderof{\tau^{2}}}}{\tau}} - {\gint{0}{\Delta t}{\fnof{W}{\tau}}{\tau}} -\end{equation} - -Now if we recall that -\begin{equation} -\theta_{1}=\dfrac{\gint{0}{\Delta t}{\fnof{W}{\tau}\tau}{\tau}}{\Delta t\gint{0}{\Delta t}{\fnof{W}{\tau}}{\tau}} -\end{equation} -we can write -\begin{equation} - \dfrac{\gint{0}{\Delta t}{\fnof{W}{\tau}\fnof{\vect{g}}{\fnof{\vect{u}}{t_{n+1}}}}{\tau}} - {\gint{0}{\Delta t}{\fnof{W}{\tau}}{\tau}}=\pbrac{1-\theta_{1}}\fnof{\vect{g}}{\fnof{\vect{u}}{t_{n}}}+ - \theta_{1}\fnof{\vect{g}}{\fnof{\vect{u}}{t_{n+1}}}+\text{Error} -\end{equation} -where -\begin{equation} - \text{Error}=\dfrac{\gint{0}{\Delta t}{\fnof{W}{\tau}\orderof{\tau^{2}}}{\tau}}{ - \gint{0}{\Delta t}{\fnof{W}{\tau}}{\tau}} -\end{equation} - -\Eqnref{eqn:dynamic1} now becomes -\begin{multline} - \matr{M}\pbrac{\ddot{\bar{\vect{u}}}_{n+1}+\dfrac{\theta_{p-2}{\Delta - t}^{p-2}}{\factorial{p-2}}\vect{\alpha}^{p}_{n}}+ - \matr{C}\pbrac{\dot{\bar{\vect{u}}}_{n+1}+\dfrac{\theta_{p-1}{\Delta - t}^{p-1}}{\factorial{p-1}}\vect{\alpha}^{p}_{n}}\\ - +\matr{K}\pbrac{\bar{\vect{u}}_{n+1}+\dfrac{\theta_{p}{\Delta - t}^{p}}{p!}\vect{\alpha}^{p}_{n}}+ - \pbrac{1-\theta_{1}}\fnof{\vect{g}}{\vect{u}_{n}}+\theta_{1}\fnof{\vect{g}}{\vect{u}_{n+1}}+\bar{\vect{f}}+ - \text{Error}=\vect{0} - \label{eqn:dynamic2} -\end{multline} -as $\fnof{\vect{u}}{t_{n}}=\vect{u}_{n}$ and -$\fnof{\vect{u}}{t_{n+1}}=\vect{u}_{n+1}=\hat{\vect{u}}_{n+1}+ -\dfrac{{\Delta t}^{p}}{p!}\vect{\alpha}^{p}_{n}$ where $\hat{\vect{u}}_{n+1}$ -is the \emph{predicted displacement} at the new time step and is given by -\begin{equation} - \hat{\vect{u}}_{n+1}=\gsum{q=0}{p-1}{\dfrac{{\Delta - t}^{q}}{q!}\symover{q}{\vect{u}}_{n}} -\end{equation} - -Rearranging gives -\begin{multline} - \fnof{\vect{\psi}}{\vect{\alpha}^{p}_{n}}=\pbrac{\dfrac{\theta_{p-2}{\Delta - t}^{p-2}}{\factorial{p-2}}\matr{M}+\dfrac{\theta_{p-1}{\Delta - t}^{p-1}}{\factorial{p-1}}\matr{C}+\dfrac{\theta_{p}{\Delta - t}^{p}}{p!}\matr{K}}\vect{\alpha}^{p}_{n}+\theta_{1}\fnof{\vect{g}}{\hat{\vect{u}}_{n+1}+ - \dfrac{{\Delta t}^{p}}{p!}\vect{\alpha}^{p}_{n}} \\ - +\pbrac{1-\theta_{1}}\fnof{\vect{g}}{\vect{u}_{n}}+ - \pbrac{\matr{M}\ddot{\bar{\vect{u}}}_{n+1}+\matr{C}\dot{\bar{\vect{u}}}_{n+1}+\matr{K}\bar{\vect{u}}_{n+1}+ - \bar{\vect{f}}}= \vect{0} - \label{eqn:dynamic} -\end{multline} -or -\begin{equation} -\fnof{\vect{\psi}}{\vect{\alpha}^{p}_{n}}=\matr{A}\vect{\alpha}^{p}_{n}+ -\theta_{1}\fnof{\vect{g}}{\hat{\vect{u}}_{n+1}+ \dfrac{{\Delta - t}^{p}}{p!}\vect{\alpha}^{p}_{n}}+\pbrac{1-\theta_{1}}\fnof{\vect{g}}{\vect{u}_{n}}+\vect{b}= \vect{0} -\end{equation} -where $\matr{A}$ is the \emph{Amplification matrix} given by -\begin{equation} - \matr{A}=\dfrac{\theta_{p-2}{\Delta t}^{p-2}}{\factorial{p-2}}\matr{M}+ - \dfrac{\theta_{p-1}{\Delta t}^{p-1}}{\factorial{p-1}}\matr{C}+ - \dfrac{\theta_{p}{\Delta t}^{p}}{p!}\matr{K} -\end{equation} -and $\vect{b}$ is the right hand side vector given by -\begin{equation} - \vect{b}=\matr{M}\ddot{\bar{\vect{u}}}_{n+1}+\matr{C}\dot{\bar{\vect{u}}}_{n+1}+ - \matr{K}\bar{\vect{u}}_{n+1}+\bar{\vect{f}} -\end{equation} - -If $\fnof{\vect{g}}{\vect{u}}\equiv\vect{0}$ then \eqnref{eqn:dynamic} is linear in -$\vect{\alpha}^{p}_{n}$ and $\vect{\alpha}^{p}_{n}$ can be found by solving -the linear equation -\begin{equation} - \vect{\alpha}^{p}_{n} =-\inverse{\pbrac{\dfrac{\theta_{p-2}{\Delta t}^{p-2}}{\factorial{p-2}}\matr{M}+ - \dfrac{\theta_{p-1}{\Delta t}^{p-1}}{\factorial{p-1}}\matr{C}+ - \dfrac{\theta_{p}{\Delta - t}^{p}}{p!}\matr{K}}}\pbrac{\matr{M}\ddot{\bar{\vect{u}}}_{n+1}+ - \matr{C}\dot{\bar{\vect{u}}}_{n+1}+\matr{K}\bar{\vect{u}}_{n+1}+\bar{\vect{f}}} -\end{equation} -or -\begin{equation} - \vect{\alpha}^{p}_{n} =-\inverse{\matr{A}}\vect{b} -\end{equation} - -If $\fnof{\vect{g}}{\vect{u}}$ is not $\equiv\vect{0}$ then -\eqnref{eqn:dynamic} is nonlinear in $\vect{\alpha}^{p}_{n}$. To solve this -equation we use Newton's method \ie -\begin{equation} - \begin{split} - \text{1. } & \fnof{\matr{J}}{\vect{\alpha}^{p}_{n(i)}}.\delta - \vect{\alpha}^{p}_{n(i)} = - -\fnof{\vect{\psi}}{\vect{\alpha}^{p}_{n(i)}} \\ - \text{2. } & \vect{\alpha}^{p}_{n(i+1)}=\vect{\alpha}^{p}_{n(i)}+\delta - \vect{\alpha}^{p}_{n(i)} - \end{split} -\end{equation} -where $\fnof{\matr{J}}{\vect{\alpha}^{p}_{n}}$ is the Jacobian and is given by -\begin{equation} - \fnof{\matr{J}}{\vect{\alpha}^{p}_{n}}=\dfrac{\theta_{p-2}{\Delta t}^{p-2}}{\factorial{p-2}}\matr{M}+ - \dfrac{\theta_{p-1}{\Delta - t}^{p-1}}{\factorial{p-1}}\matr{C}+\dfrac{\theta_{p}{\Delta t}^{p}}{p!}\matr{K}+ - \dfrac{\theta_{1}{\Delta t}^{p}}{p!} - \delby{\fnof{\vect{g}}{\hat{\vect{u}}_{n+1}+\dfrac{{\Delta - t}^{p}}{p!} - \vect{\alpha}^{p}_{n}}}{\vect{\alpha}^{p}_{n}} -\end{equation} -or -\begin{equation} - \fnof{\matr{J}}{\vect{\alpha}^{p}_{n}}=\matr{A}+\dfrac{\theta_{1}{\Delta - t}^{p}}{p!} - \delby{\fnof{\vect{g}}{\hat{\vect{u}}_{n+1}+\dfrac{{\Delta t}^{p}}{p!}\vect{\alpha}^{p}_{n}}}{\vect{\alpha}^{p}_{n}} -\end{equation} - -Once $\vect{\alpha}^{p}_{n}$ has been obtained the values at the next time step can be obtained from -\begin{equation} - \begin{split} - \vect{u}_{n+1} &= \vect{u}_{n}+\Delta t - \dot{\vect{u}}_{n}+\cdots+\dfrac{{\Delta - t}^{p}}{p!}\vect{\alpha}^{p}_{n}=\hat{\vect{u}}_{n+1}+ - \dfrac{{\Delta t}^{p}}{p!}\vect{\alpha}^{p}_{n}\\ - \dot{\vect{u}}_{n+1} &= \dot{\vect{u}}_{n}+\Delta t - \ddot{\vect{u}}_{n}+\cdots+\dfrac{{\Delta - t}^{p-1}}{\factorial{p-1}}\vect{\alpha}^{p}_{n}=\dot{\hat{\vect{u}}}_{n+1}+\dfrac{{\Delta - t}^{p-1}}{\factorial{p-1}}\vect{\alpha}^{p}_{n} \\ - &\vdots \\ - \symover{p-1}{\vect{u}}_{n+1} &= \symover{p-1}{\vect{u}}_{n}+\Delta t\vect{\alpha}^{p}_{n} - \end{split} -\end{equation} - -For algorithms in which the degree of the polynomial, $p$, is higher than the -order we require the algorithm to be initialised so that the initial velocity -or acceleration can be computed. The initial velocity or acceleration values -can be obtained by substituting the initial displacement or initial -displacement and velocity values into \eqnref{eqn:generaldynamicnonlinear}, -rearranging and solving. For example consider an the case of a second degree -polynomial and a first order system. Substituing the initial displacement -$\vect{u}_{0}$ into \eqnref{eqn:generaldynamicnonlinear} gives -\begin{equation} - \matr{C}\dot{\vect{u}}_{0}+\matr{K}\vect{u}_{0}+\fnof{\vect{g}}{\vect{u}_{0}}+\bar{\vect{f}}_{0}=\vect{0} -\end{equation} -and therefore an approximation to the initial velocity can be found from -\begin{equation} - \dot{\vect{u}}_{0}=-\inverse{\matr{C}}\pbrac{\matr{K}\vect{u}_{0}+\fnof{\vect{g}}{\vect{u}_{0}}+\bar{\vect{f}}_{0}} -\end{equation} - -Similarily for a third degree polynomial and a second order system the initial -acceleration can be found from -\begin{equation} - \ddot{\vect{u}}_{0}=-\inverse{\matr{M}}\pbrac{\matr{C}\dot{\vect{u}}_{0}+\matr{K}\vect{u}_{0}+ - \fnof{\vect{g}}{\vect{u}_{0}}+\bar{\vect{f}}_{0}} -\end{equation} - -To evaluate the mean weighted load vector, $\bar{\vect{f}}$, we need to -evaluate the integral in \eqnref{eqn:meanweightedloadvector}. In some cases, -however, we can make the assumption that the load vector varies linearly -during the time step. In these cases the mean weighted load vector can be -computed from -\begin{equation} - \bar{\vect{f}}=\theta_{1}\vect{f}_{n+1}+\pbrac{1-\theta_{1}}\vect{f}_{n} -\end{equation} - -\subsubsection{Special SN11 case, p=1} - -For this special case, the mean predicited values are given by -\begin{equation} - \bar{\vect{u}}_{n+1} = \vect{u}_{n} -\end{equation} - -The predicted displacement values are given by -\begin{equation} - \hat{\vect{u}}_{n+1} = \vect{u}_{n} -\end{equation} - -The amplification matrix is given by -\begin{equation} - \matr{A}=\matr{C}+\theta_{1}\Delta t \matr{K} -\end{equation} - -The right hand side vector is given by -\begin{equation} - \vect{b}=\matr{K}\bar{\vect{u}}_{n+1}+\bar{\vect{f}} -\end{equation} - -The nonlinear function is given by -\begin{equation} - \fnof{\vect{\psi}}{\vect{\alpha}^{1}_{n}}=\matr{A}\vect{\alpha}^{1}_{n}+\theta_{1}\fnof{\vect{g}}{\hat{\vect{u}}_{n+1}+ - \Delta t\vect{\alpha}^{1}_{n}}+\pbrac{1-\theta_{1}}\fnof{\vect{g}}{\vect{u}_{n}}+\vect{b}=\vect{0} -\end{equation} - -The Jacobian matrix is given by -\begin{equation} - \fnof{\matr{J}}{\vect{\alpha}^{1}_{n}}=\matr{A}+\theta_{1}\Delta t - \delby{\fnof{\vect{g}}{\hat{\vect{u}}_{n+1}+\Delta t\vect{\alpha}^{1}_{n}}}{\vect{\alpha}^{1}_{n}} -\end{equation} - -And the time step update is given by -\begin{equation} - \vect{u}_{n+1} = \vect{u}_{n}+\Delta t\vect{\alpha}^{1}_{n} -\end{equation} - -\subsubsection{Special SN21 case, p=2} - -For this special case, the mean predicited values are given by -\begin{equation} - \begin{split} - \bar{\vect{u}}_{n+1} &= \vect{u}_{n}+\theta_{1}\Delta t\dot{\vect{u}}_{n}\\ - \dot{\bar{\vect{u}}}_{n+1} &= \dot{\vect{u}}_{n} - \end{split} -\end{equation} -where -\begin{equation} - \dot{\vect{u}}_{0}=-\inverse{\matr{C}}\pbrac{\matr{K}\vect{u}_{0}+\fnof{\vect{g}}{\vect{u}_{0}}+\bar{\vect{f}}_{0}} -\end{equation} - -The predicted displacement values are given by -\begin{equation} - \hat{\vect{u}}_{n+1} = \vect{u}_{n}+\Delta t\dot{\vect{u}}_{n} -\end{equation} - -The amplification matrix is given by -\begin{equation} - \matr{A}=\theta_{1}\Delta t\matr{C}+\dfrac{\theta_{2}{\Delta t}^{2}}{2}\matr{K} -\end{equation} - -The right hand side vector is given by -\begin{equation} - \vect{b}=\matr{C}\dot{\bar{\vect{u}}}_{n+1}+\matr{K}\bar{\vect{u}}_{n+1}+\bar{\vect{f}} -\end{equation} - -The nonlinear function is given by -\begin{equation} - \fnof{\vect{\psi}}{\vect{\alpha}^{2}_{n}}=\matr{A}\vect{\alpha}^{2}_{n}+\theta_{1}\fnof{\vect{g}}{\hat{\vect{u}}_{n+1}+ - \dfrac{{\Delta t}^{2}}{2}\vect{\alpha}^{2}_{n}}+\pbrac{1-\theta_{1}}\fnof{\vect{g}}{\vect{u}_{n}}+\vect{b}=\vect{0} -\end{equation} - -The Jacobian matrix is given by -\begin{equation} - \fnof{\matr{J}}{\vect{\alpha}^{2}_{n}}=\matr{A}+\dfrac{\theta_{1}{\Delta t}^{2}}{2} - \delby{\fnof{\vect{g}}{\hat{\vect{u}}_{n+1}+\dfrac{{\Delta t}^{2}}{2}\vect{\alpha}^{2}_{n}}}{\vect{\alpha}^{2}_{n}} -\end{equation} - -And the time step update is given by -\begin{equation} - \begin{split} - \vect{u}_{n+1} &= \vect{u}_{n}+\Delta t\dot{\vect{u}}_{n} +\dfrac{{\Delta t}^{2}}{2}\vect{\alpha}^{2}_{n} \\ - \dot{\vect{u}}_{n+1} &= \dot{\vect{u}}_{n}+\Delta t\vect{\alpha}^{2}_{n} - \end{split} -\end{equation} - -\subsubsection{Special SN22 case, p=2} - -For this special case, the mean predicited values are given by -\begin{equation} - \begin{split} - \bar{\vect{u}}_{n+1} &= \vect{u}_{n}+\theta_{1}\Delta t\dot{\vect{u}}_{n}\\ - \dot{\bar{\vect{u}}}_{n+1} &= \dot{\vect{u}}_{n} - \end{split} -\end{equation} - -The predicted displacement values are given by -\begin{equation} - \hat{\vect{u}}_{n+1} = \vect{u}_{n}+\Delta t\dot{\vect{u}}_{n} -\end{equation} - -The amplification matrix is given by -\begin{equation} - \matr{A}=\matr{M}+\theta_{1}\Delta t\matr{C}+\dfrac{\theta_{2}{\Delta t}^{2}}{2}\matr{K} -\end{equation} - -The right hand side vector is given by -\begin{equation} - \vect{b}=\matr{C}\dot{\bar{\vect{u}}}_{n+1}+\matr{K}\bar{\vect{u}}_{n+1}+\bar{\vect{f}} -\end{equation} - -The nonlinear function is given by -\begin{equation} - \fnof{\vect{\psi}}{\vect{\alpha}^{2}_{n}}=\matr{A}\vect{\alpha}^{2}_{n}+\theta_{1}\fnof{\vect{g}}{\hat{\vect{u}}_{n+1}+ - \dfrac{{\Delta t}^{2}}{2}\vect{\alpha}^{2}_{n}}+\pbrac{1-\theta_{1}}\fnof{\vect{g}}{\vect{u}_{n}}+\vect{b}=\vect{0} -\end{equation} - -The Jacobian matrix is given by -\begin{equation} - \fnof{\matr{J}}{\vect{\alpha}^{2}_{n}}=\matr{A}+\dfrac{\theta_{1}{\Delta t}^{2}}{2} - \delby{\fnof{\vect{g}}{{\hat{\vect{u}}_{n+1}+\dfrac{{\Delta t}^{2}}{2}\vect{\alpha}^{2}_{n}}}}{\vect{\alpha}^{2}_{n}} -\end{equation} - -And the time step update is given by -\begin{equation} - \begin{split} - \vect{u}_{n+1} &= \vect{u}_{n}+\Delta t\dot{\vect{u}}_{n} +\dfrac{{\Delta t}^{2}}{2}\vect{\alpha}^{2}_{n} \\ - \dot{\vect{u}}_{n+1} &= \dot{\vect{u}}_{n}+\Delta t\vect{\alpha}^{2}_{n} - \end{split} -\end{equation} - -\section{Interface Conditions} - -\subsection{Variational principles} - -The branch of mathematics concerned with the problem of finding a function for -which a certain integral of that function is either at its largest or smallest -value is called the \emph{calculus of variations}. When scientific laws are formulated in terms of the principles of the calculus -of variations they are termed \emph{variational principles}. - -\subsection{Lagrange Multipliers} - diff --git a/doc/notes/TitlePage/TitlePage.tex b/doc/notes/TitlePage/TitlePage.tex deleted file mode 100755 index 468ecdd2..00000000 --- a/doc/notes/TitlePage/TitlePage.tex +++ /dev/null @@ -1,32 +0,0 @@ -\thispagestyle{empty} - -\begin{center} - \huge OpenCMISS NOTES - \vspace{10mm} - - \large http://www.opencmiss.org/ - \vspace{10mm} - - \begin{figure}[htbp] \centering - \epsfig{file=OpenCMISS_Logo.eps,width=8.3cm,height=7cm} - \end{figure} % - \vspace{10mm} - - \vspace{5mm} - \today\\ % today's date - \vspace{20mm} - \small - \textcopyright \thickspace Copyright 2009-\\ - Auckland Bioengineering Institute, University of Auckland, \\ - University of Oxford and \\ - King's College London, University of London. -\end{center} - - - - - -%%% Local Variables: -%%% mode: latex -%%% TeX-master: t -%%% End: diff --git a/doc/notes/svgs/Theory/cubichermiteelem.svg b/doc/notes/svgs/Theory/cubichermiteelem.svg deleted file mode 100755 index 3ddb73b1..00000000 --- a/doc/notes/svgs/Theory/cubichermiteelem.svg +++ /dev/null @@ -1,397 +0,0 @@ - - - - - - - - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/#1657# b/src/#1657# deleted file mode 100644 index e69de29b..00000000 diff --git a/src/Burgers_equation_routines.f90.fsicpb b/src/Burgers_equation_routines.f90.fsicpb deleted file mode 100644 index f5acdf87..00000000 --- a/src/Burgers_equation_routines.f90.fsicpb +++ /dev/null @@ -1,2576 +0,0 @@ -!> \file -!> \author David Ladd -!> \brief This module handles all Burgers equation routines. -!> -!> \section LICENSE -!> -!> Version: MPL 1.1/GPL 2.0/LGPL 2.1 -!> -!> The contents of this file are subject to the Mozilla Public License -!> Version 1.1 (the "License"); you may not use this file except in -!> compliance with the License. You may obtain a copy of the License at -!> http://www.mozilla.org/MPL/ -!> -!> Software distributed under the License is distributed on an "AS IS" -!> basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the -!> License for the specific language governing rights and limitations -!> under the License. -!> -!> The Original Code is OpenCMISS -!> -!> The Initial Developer of the Original Code is University of Auckland, -!> Auckland, New Zealand, the University of Oxford, Oxford, United -!> Kingdom and King's College, London, United Kingdom. Portions created -!> by the University of Auckland, the University of Oxford and King's -!> College, London are Copyright (C) 2007-2010 by the University of -!> Auckland, the University of Oxford and King's College, London. -!> All Rights Reserved. -!> -!> Contributor(s): Chris Bradley -!> -!> Alternatively, the contents of this file may be used under the terms of -!> either the GNU General Public License Version 2 or later (the "GPL"), or -!> the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), -!> in which case the provisions of the GPL or the LGPL are applicable instead -!> of those above. If you wish to allow use of your version of this file only -!> under the terms of either the GPL or the LGPL, and not to allow others to -!> use your version of this file under the terms of the MPL, indicate your -!> decision by deleting the provisions above and replace them with the notice -!> and other provisions required by the GPL or the LGPL. If you do not delete -!> the provisions above, a recipient may use your version of this file under -!> the terms of any one of the MPL, the GPL or the LGPL. -!> - -!>This module handles all Burgers equation routines. -MODULE BURGERS_EQUATION_ROUTINES - - USE ANALYTIC_ANALYSIS_ROUTINES - USE BaseRoutines - USE BASIS_ROUTINES - USE BOUNDARY_CONDITIONS_ROUTINES - USE Constants - USE CONTROL_LOOP_ROUTINES - USE ControlLoopAccessRoutines - USE DISTRIBUTED_MATRIX_VECTOR - USE DOMAIN_MAPPINGS - USE EquationsRoutines - USE EquationsAccessRoutines - USE EquationsMappingRoutines - USE EquationsMatricesRoutines - USE EQUATIONS_SET_CONSTANTS - USE EquationsSetAccessRoutines - USE FIELD_ROUTINES - USE FieldAccessRoutines - USE FIELD_IO_ROUTINES - USE INPUT_OUTPUT - USE ISO_VARYING_STRING - USE Kinds - USE MATRIX_VECTOR - USE PROBLEM_CONSTANTS - USE Strings - USE SOLVER_ROUTINES - USE SolverAccessRoutines - USE Timer - USE Types - - USE FLUID_MECHANICS_IO_ROUTINES - -#include "macros.h" - - IMPLICIT NONE - - PRIVATE - - !Module parameters - - !Module types - - !Module variables - - !Interfaces - - PUBLIC Burgers_AnalyticFunctionsEvaluate - - PUBLIC Burgers_BoundaryConditionsAnalyticCalculate - - PUBLIC BURGERS_EQUATION_EQUATIONS_SET_SETUP - - PUBLIC Burgers_EquationsSetSolutionMethodSet - - PUBLIC Burgers_EquationsSetSpecificationSet - - PUBLIC Burgers_FiniteElementJacobianEvaluate - - PUBLIC Burgers_FiniteElementResidualEvaluate - - PUBLIC Burgers_ProblemSpecificationSet - - PUBLIC BURGERS_EQUATION_PROBLEM_SETUP - - PUBLIC BURGERS_EQUATION_PRE_SOLVE,BURGERS_EQUATION_POST_SOLVE - -CONTAINS - - ! - !================================================================================================================================ - ! - - - !>Calculates the analytic solution and sets the boundary conditions for an analytic problem. - !Calculates a one-dimensional dynamic solution to the burgers equation - SUBROUTINE Burgers_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BOUNDARY_CONDITIONS,err,error,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: EQUATIONS_SET - TYPE(BOUNDARY_CONDITIONS_TYPE), POINTER :: BOUNDARY_CONDITIONS - INTEGER(INTG), INTENT(OUT) :: ERR !EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD - IF(ASSOCIATED(dependentField)) THEN - geometricField=>EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD - IF(ASSOCIATED(geometricField)) THEN - ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE - ANALYTIC_FIELD=>EQUATIONS_SET%ANALYTIC%ANALYTIC_FIELD - CALL FIELD_NUMBER_OF_COMPONENTS_GET(geometricField,FIELD_U_VARIABLE_TYPE,NUMBER_OF_DIMENSIONS,err,error,*999) - NULLIFY(GEOMETRIC_VARIABLE) - NULLIFY(GEOMETRIC_PARAMETERS) - CALL Field_VariableGet(geometricField,FIELD_U_VARIABLE_TYPE,GEOMETRIC_VARIABLE,err,error,*999) - CALL FIELD_PARAMETER_SET_DATA_GET(geometricField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,GEOMETRIC_PARAMETERS, & - & err,error,*999) - NULLIFY(ANALYTIC_VARIABLE) - NULLIFY(ANALYTIC_PARAMETERS) - IF(ASSOCIATED(ANALYTIC_FIELD)) THEN - CALL Field_VariableGet(ANALYTIC_FIELD,FIELD_U_VARIABLE_TYPE,ANALYTIC_VARIABLE,err,error,*999) - CALL FIELD_PARAMETER_SET_DATA_GET(ANALYTIC_FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, & - & ANALYTIC_PARAMETERS,err,error,*999) - ENDIF - NULLIFY(materialsField) - NULLIFY(MATERIALS_VARIABLE) - NULLIFY(MATERIALS_PARAMETERS) - IF(ASSOCIATED(EQUATIONS_SET%MATERIALS)) THEN - materialsField=>EQUATIONS_SET%MATERIALS%MATERIALS_FIELD - CALL Field_VariableGet(materialsField,FIELD_U_VARIABLE_TYPE,MATERIALS_VARIABLE,err,error,*999) - CALL FIELD_PARAMETER_SET_DATA_GET(materialsField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, & - & MATERIALS_PARAMETERS,err,error,*999) - ENDIF - ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE - TIME=EQUATIONS_SET%ANALYTIC%ANALYTIC_TIME - IF(ASSOCIATED(BOUNDARY_CONDITIONS)) THEN - DO variable_idx=1,dependentField%NUMBER_OF_VARIABLES - variable_type=dependentField%VARIABLES(variable_idx)%VARIABLE_TYPE - FIELD_VARIABLE=>dependentField%VARIABLE_TYPE_MAP(variable_type)%ptr - IF(ASSOCIATED(FIELD_VARIABLE)) THEN - CALL Field_ParameterSetEnsureCreated(dependentField,variable_type,FIELD_ANALYTIC_VALUES_SET_TYPE,err,error,*999) - DO component_idx=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - IF(FIELD_VARIABLE%COMPONENTS(component_idx)%INTERPOLATION_TYPE==FIELD_NODE_BASED_INTERPOLATION) THEN - DOMAIN=>FIELD_VARIABLE%COMPONENTS(component_idx)%DOMAIN - IF(ASSOCIATED(DOMAIN)) THEN - IF(ASSOCIATED(DOMAIN%TOPOLOGY)) THEN - DOMAIN_NODES=>DOMAIN%TOPOLOGY%NODES - IF(ASSOCIATED(DOMAIN_NODES)) THEN - !Loop over the local nodes excluding the ghosts. - DO node_idx=1,DOMAIN_NODES%NUMBER_OF_NODES -!!TODO \todo We should interpolate the geometric field here and the node position. - DO dim_idx=1,NUMBER_OF_DIMENSIONS - !Default to version 1 of each node derivative - local_ny=GEOMETRIC_VARIABLE%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% & - & NODES(node_idx)%DERIVATIVES(1)%VERSIONS(1) - X(dim_idx)=GEOMETRIC_PARAMETERS(local_ny) - ENDDO !dim_idx - !Loop over the derivatives - DO deriv_idx=1,DOMAIN_NODES%NODES(node_idx)%NUMBER_OF_DERIVATIVES - GLOBAL_DERIV_INDEX=DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX - CALL Burgers_AnalyticFunctionsEvaluate(EQUATIONS_SET,ANALYTIC_FUNCTION_TYPE, & - & X,TANGENTS,NORMAL,0.0_DP,variable_type,GLOBAL_DERIV_INDEX,component_idx, & - & ANALYTIC_PARAMETERS,MATERIALS_PARAMETERS,INITIAL_VALUE,err,error,*999) - CALL Burgers_AnalyticFunctionsEvaluate(EQUATIONS_SET,ANALYTIC_FUNCTION_TYPE, & - & X,TANGENTS,NORMAL,TIME,variable_type,GLOBAL_DERIV_INDEX,component_idx, & - & ANALYTIC_PARAMETERS,MATERIALS_PARAMETERS,VALUE,err,error,*999) - DO version_idx=1,DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%numberOfVersions - local_ny=FIELD_VARIABLE%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% & - & NODE_PARAM2DOF_MAP%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(version_idx) - CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(dependentField,variable_type, & - & FIELD_ANALYTIC_VALUES_SET_TYPE,local_ny,VALUE,err,error,*999) - IF(variable_type==FIELD_U_VARIABLE_TYPE) THEN - IF(DOMAIN_NODES%NODES(node_idx)%BOUNDARY_NODE) THEN - !If we are a boundary node then set the analytic value on the boundary - CALL BOUNDARY_CONDITIONS_SET_LOCAL_DOF(BOUNDARY_CONDITIONS,dependentField,variable_type, & - & local_ny,BOUNDARY_CONDITION_FIXED,VALUE,err,error,*999) - ELSE - !Set the initial condition. - CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(dependentField,variable_type, & - & FIELD_VALUES_SET_TYPE,local_ny,INITIAL_VALUE,err,error,*999) - ENDIF - ENDIF - ENDDO !version_idx - ENDDO !deriv_idx - ENDDO !node_idx - ELSE - CALL FlagError("Domain topology nodes is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Domain topology is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Domain is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Only node based interpolation is implemented.",err,error,*999) - ENDIF - ENDDO !component_idx - CALL FIELD_PARAMETER_SET_UPDATE_START(dependentField,variable_type,FIELD_ANALYTIC_VALUES_SET_TYPE, & - & err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_START(dependentField,variable_type,FIELD_VALUES_SET_TYPE, & - & err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(dependentField,variable_type,FIELD_ANALYTIC_VALUES_SET_TYPE, & - & err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(dependentField,variable_type,FIELD_VALUES_SET_TYPE, & - & err,error,*999) - ELSE - CALL FlagError("Field variable is not associated.",err,error,*999) - ENDIF - ENDDO !variable_idx - CALL FIELD_PARAMETER_SET_DATA_RESTORE(geometricField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, & - & GEOMETRIC_PARAMETERS,err,error,*999) - ELSE - CALL FlagError("Boundary conditions are not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set geometric field is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set dependent field is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set analytic is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - ENDIF - - EXITS("Burgers_BoundaryConditionsAnalyticCalculate") - RETURN -999 ERRORSEXITS("Burgers_BoundaryConditionsAnalyticCalculate",err,error) - RETURN 1 - - END SUBROUTINE Burgers_BoundaryConditionsAnalyticCalculate - - - ! - !================================================================================================================================ - ! - !>Evaluate the analytic solutions for a Burgers equation - SUBROUTINE Burgers_AnalyticFunctionsEvaluate(EQUATIONS_SET,ANALYTIC_FUNCTION_TYPE,X, & - & TANGENTS,NORMAL,TIME,VARIABLE_TYPE,GLOBAL_DERIVATIVE,COMPONENT_NUMBER,ANALYTIC_PARAMETERS,MATERIALS_PARAMETERS, & - & VALUE,err,error,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER, INTENT(IN) :: EQUATIONS_SET !Sets/changes the solution method for a burgers equation type of an fluid mechanics equations set class. - SUBROUTINE Burgers_EquationsSetSolutionMethodSet(EQUATIONS_SET,SOLUTION_METHOD,err,error,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: EQUATIONS_SET !Sets the equation specification for a Burgers type of a fluid mechanics equations set. - SUBROUTINE Burgers_EquationsSetSpecificationSet(equationsSet,specification,err,error,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: equationsSet !Sets up the Burgers equation type of a fluid mechanics equations set class. - SUBROUTINE BURGERS_EQUATION_EQUATIONS_SET_SETUP(EQUATIONS_SET,EQUATIONS_SET_SETUP,err,error,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: EQUATIONS_SET !EQUATIONS_SET%MATERIALS - IF(ASSOCIATED(EQUATIONS_MATERIALS)) THEN - IF(EQUATIONS_SET%SPECIFICATION(3)/=EQUATIONS_SET_INVISCID_BURGERS_SUBTYPE) THEN - !Not an inviscid Burgers equation - IF(EQUATIONS_MATERIALS%MATERIALS_FIELD_AUTO_CREATED) THEN - !Create the auto created materials field - CALL FIELD_CREATE_START(EQUATIONS_SET_SETUP%FIELD_USER_NUMBER,EQUATIONS_SET%REGION,EQUATIONS_MATERIALS% & - & MATERIALS_FIELD,err,error,*999) - CALL FIELD_LABEL_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,"Materials Field",err,error,*999) - CALL FIELD_TYPE_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_MATERIAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999) - CALL FIELD_MESH_DECOMPOSITION_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_DECOMPOSITION,err,error,*999) - CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,GEOMETRIC_DECOMPOSITION, & - & err,error,*999) - CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,EQUATIONS_SET%GEOMETRY% & - & GEOMETRIC_FIELD,err,error,*999) - CALL FIELD_NUMBER_OF_VARIABLES_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,1,err,error,*999) - CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,[FIELD_U_VARIABLE_TYPE], & - & err,error,*999) - CALL FIELD_VARIABLE_LABEL_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & "Materials",err,error,*999) - CALL FIELD_DIMENSION_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_DP_TYPE,err,error,*999) - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_BURGERS_SUBTYPE,EQUATIONS_SET_STATIC_BURGERS_SUBTYPE) - !1 materials field component - !i.e., k = viscosity*(-1) in du/dt + k*(d^2u/dx^2)+ u*(du/dx) = 0 - NUMBER_OF_MATERIALS_COMPONENTS=1 - CASE(EQUATIONS_SET_GENERALISED_BURGERS_SUBTYPE) - !3 materials field components - !i.e., a.du/dt + b.(d^2u/dx^2) + c.u*(du/dx) = 0 - NUMBER_OF_MATERIALS_COMPONENTS=3 - CASE DEFAULT - localError="The action type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a nonlinear Burgers equation." - CALL FlagError(localError,err,error,*999) - END SELECT - !Set the number of materials components - CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_MATERIALS_COMPONENTS,err,error,*999) - !Default the materials components to the 1st geometric component interpolation setup with constant interpolation - CALL FIELD_COMPONENT_MESH_COMPONENT_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & 1,GEOMETRIC_MESH_COMPONENT,err,error,*999) - DO component_idx=1,NUMBER_OF_MATERIALS_COMPONENTS - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & component_idx,GEOMETRIC_MESH_COMPONENT,err,error,*999) - CALL FIELD_COMPONENT_INTERPOLATION_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & component_idx,FIELD_CONSTANT_INTERPOLATION,err,error,*999) - ENDDO !component_idx - !Default the field scaling to that of the geometric field - CALL FIELD_SCALING_TYPE_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_SCALING_TYPE,err,error,*999) - CALL FIELD_SCALING_TYPE_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,GEOMETRIC_SCALING_TYPE,err,error,*999) - ELSE - !Check the user specified field - CALL FIELD_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_MATERIAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_VARIABLES_CHECK(EQUATIONS_SET_SETUP%FIELD,1,err,error,*999) - CALL FIELD_VARIABLE_TYPES_CHECK(EQUATIONS_SET_SETUP%FIELD,[FIELD_U_VARIABLE_TYPE],err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999) - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_BURGERS_SUBTYPE,EQUATIONS_SET_STATIC_BURGERS_SUBTYPE) - !1 materials field component - !i.e., k = viscosity*(-1) in du/dt + k*(d^2u/dx^2)+ u*(du/dx) = 0 - NUMBER_OF_MATERIALS_COMPONENTS=1 - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_SCALAR_DIMENSION_TYPE, & - & err,error,*999) - CASE(EQUATIONS_SET_GENERALISED_BURGERS_SUBTYPE) - !3 materials field components - !i.e., a.du/dt + b.(d^2u/dx^2) + c.u*(du/dx) = 0 - NUMBER_OF_MATERIALS_COMPONENTS=3 - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a nonlinear Burgers equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_MATERIALS_COMPONENTS,err,error,*999) - ENDIF - ENDIF - ELSE - CALL FlagError("Equations set materials is not associated.",err,error,*999) - ENDIF - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - EQUATIONS_MATERIALS=>EQUATIONS_SET%MATERIALS - IF(ASSOCIATED(EQUATIONS_MATERIALS)) THEN - IF(EQUATIONS_SET%SPECIFICATION(3)/=EQUATIONS_SET_INVISCID_BURGERS_SUBTYPE) THEN - !Not an inviscid Burgers equation - IF(EQUATIONS_MATERIALS%MATERIALS_FIELD_AUTO_CREATED) THEN - !Finish creating the materials field - CALL FIELD_CREATE_FINISH(EQUATIONS_MATERIALS%MATERIALS_FIELD,err,error,*999) - !Set the default values for the materials field - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_BURGERS_SUBTYPE,EQUATIONS_SET_STATIC_BURGERS_SUBTYPE) - !1 materials field component. Default to - !du/dt - d^2u/dx^2 + u*(du/dx) = 0 - CALL FIELD_COMPONENT_VALUES_INITIALISE(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,1,-1.0_DP,err,error,*999) - CASE(EQUATIONS_SET_GENERALISED_BURGERS_SUBTYPE) - !3 materials field components. Default to - !du/dt - d^2u/dx^2 + u*(du/dx) = 0 - CALL FIELD_COMPONENT_VALUES_INITIALISE(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,1,1.0_DP,err,error,*999) - CALL FIELD_COMPONENT_VALUES_INITIALISE(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,2,-1.0_DP,err,error,*999) - CALL FIELD_COMPONENT_VALUES_INITIALISE(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,3,1.0_DP,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a nonlinear Burgers equation." - CALL FlagError(localError,err,error,*999) - END SELECT - ENDIF - ENDIF - ELSE - CALL FlagError("Equations set materials is not associated.",err,error,*999) - ENDIF - CASE DEFAULT - localError="The action type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a nonlinear Burgers equation." - CALL FlagError(localError,err,error,*999) - END SELECT - !----------------------------------------------------------------- - ! S o u r c e f i e l d - !----------------------------------------------------------------- - CASE(EQUATIONS_SET_SETUP_SOURCE_TYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - CASE(EQUATIONS_SET_SETUP_START_ACTION) - !Do nothing - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - !Do nothing - CASE DEFAULT - localError="The action type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a nonlinear Burgers equation." - CALL FlagError(localError,err,error,*999) - END SELECT - !----------------------------------------------------------------- - ! A n a l y t i c t y p e - !----------------------------------------------------------------- - CASE(EQUATIONS_SET_SETUP_ANALYTIC_TYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - CASE(EQUATIONS_SET_SETUP_START_ACTION) - EQUATIONS_ANALYTIC=>EQUATIONS_SET%ANALYTIC - IF(ASSOCIATED(EQUATIONS_ANALYTIC)) THEN - IF(EQUATIONS_SET%DEPENDENT%DEPENDENT_FINISHED) THEN - dependentField=>EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD - IF(ASSOCIATED(dependentField)) THEN - EQUATIONS_MATERIALS=>EQUATIONS_SET%MATERIALS - IF(ASSOCIATED(EQUATIONS_MATERIALS)) THEN - IF(EQUATIONS_MATERIALS%MATERIALS_FINISHED) THEN - geometricField=>EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD - IF(ASSOCIATED(geometricField)) THEN - CALL FIELD_NUMBER_OF_COMPONENTS_GET(geometricField,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_GEOMETRIC_COMPONENTS,err,error,*999) - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_BURGERS_SUBTYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE) - CASE(EQUATIONS_SET_BURGERS_EQUATION_ONE_DIM_1) - !Check that domain is 1D - IF(NUMBER_OF_GEOMETRIC_COMPONENTS/=1) THEN - localError="The number of geometric dimensions of "// & - & TRIM(NUMBER_TO_VSTRING(NUMBER_OF_GEOMETRIC_COMPONENTS,"*",err,error))// & - & " is invalid. The analytic function type of "// & - & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",err,error))// & - & " requires that there be 1 geometric dimension." - CALL FlagError(localError,err,error,*999) - ENDIF - !Check the materials values are constant - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & 1,FIELD_CONSTANT_INTERPOLATION,err,error,*999) - !Set analytic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_BURGERS_EQUATION_ONE_DIM_1 - NUMBER_OF_ANALYTIC_COMPONENTS=1 - CASE DEFAULT - localError="The specified analytic function type of "// & - & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",err,error))// & - & " is invalid for a Burgers equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(EQUATIONS_SET_GENERALISED_BURGERS_SUBTYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE) - CASE(EQUATIONS_SET_GENERALISED_BURGERS_EQUATION_ONE_DIM_1, & - & EQUATIONS_SET_GENERALISED_BURGERS_EQUATION_ONE_DIM_2) - !Check that domain is 1D - IF(NUMBER_OF_GEOMETRIC_COMPONENTS/=1) THEN - localError="The number of geometric dimensions of "// & - & TRIM(NUMBER_TO_VSTRING(NUMBER_OF_GEOMETRIC_COMPONENTS,"*",err,error))// & - & " is invalid. The analytic function type of "// & - & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",err,error))// & - & " requires that there be 1 geometric dimension." - CALL FlagError(localError,err,error,*999) - ENDIF - !Check the materials values are constant - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & 1,FIELD_CONSTANT_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & 2,FIELD_CONSTANT_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & 3,FIELD_CONSTANT_INTERPOLATION,err,error,*999) - !Set analytic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE - NUMBER_OF_ANALYTIC_COMPONENTS=2 - CASE DEFAULT - localError="The specified analytic function type of "// & - & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",err,error))// & - & " is invalid for a generalised Burgers equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(EQUATIONS_SET_STATIC_BURGERS_SUBTYPE) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_INVISCID_BURGERS_SUBTYPE) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The equation set subtype of "// & - & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " is invalid for an analytical nonlinear Burgers equation." - CALL FlagError(localError,err,error,*999) - END SELECT - !Create analytic field if required - IF(NUMBER_OF_ANALYTIC_COMPONENTS>=1) THEN - IF(EQUATIONS_ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED) THEN - !Create the auto created source field - CALL FIELD_CREATE_START(EQUATIONS_SET_SETUP%FIELD_USER_NUMBER,EQUATIONS_SET%REGION, & - & EQUATIONS_ANALYTIC%ANALYTIC_FIELD,err,error,*999) - CALL FIELD_LABEL_SET(EQUATIONS_ANALYTIC%ANALYTIC_FIELD,"Analytic Field",err,error,*999) - CALL FIELD_TYPE_SET_AND_LOCK(EQUATIONS_ANALYTIC%ANALYTIC_FIELD,FIELD_GENERAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(EQUATIONS_ANALYTIC%ANALYTIC_FIELD,FIELD_INDEPENDENT_TYPE, & - & err,error,*999) - CALL FIELD_MESH_DECOMPOSITION_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_DECOMPOSITION, & - & err,error,*999) - CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(EQUATIONS_ANALYTIC%ANALYTIC_FIELD, & - & GEOMETRIC_DECOMPOSITION,err,error,*999) - CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(EQUATIONS_ANALYTIC%ANALYTIC_FIELD,EQUATIONS_SET%GEOMETRY% & - & GEOMETRIC_FIELD,err,error,*999) - CALL FIELD_NUMBER_OF_VARIABLES_SET_AND_LOCK(EQUATIONS_ANALYTIC%ANALYTIC_FIELD,1,err,error,*999) - CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(EQUATIONS_ANALYTIC%ANALYTIC_FIELD,[FIELD_U_VARIABLE_TYPE], & - & err,error,*999) - CALL FIELD_VARIABLE_LABEL_SET(EQUATIONS_ANALYTIC%ANALYTIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & "Analytic",err,error,*999) - CALL FIELD_DIMENSION_SET_AND_LOCK(EQUATIONS_ANALYTIC%ANALYTIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_SET_AND_LOCK(EQUATIONS_ANALYTIC%ANALYTIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_DP_TYPE,err,error,*999) - !Set the number of analytic components - CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_ANALYTIC%ANALYTIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_ANALYTIC_COMPONENTS,err,error,*999) - !Default the analytic components to the 1st geometric interpolation setup with constant interpolation - CALL FIELD_COMPONENT_MESH_COMPONENT_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD, & - & FIELD_U_VARIABLE_TYPE,1,GEOMETRIC_MESH_COMPONENT,err,error,*999) - DO component_idx=1,NUMBER_OF_ANALYTIC_COMPONENTS - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_ANALYTIC%ANALYTIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & component_idx,GEOMETRIC_MESH_COMPONENT,err,error,*999) - CALL FIELD_COMPONENT_INTERPOLATION_SET(EQUATIONS_ANALYTIC%ANALYTIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & component_idx,FIELD_CONSTANT_INTERPOLATION,err,error,*999) - ENDDO !component_idx - !Default the field scaling to that of the geometric field - CALL FIELD_SCALING_TYPE_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_SCALING_TYPE, & - & err,error,*999) - CALL FIELD_SCALING_TYPE_SET(EQUATIONS_ANALYTIC%ANALYTIC_FIELD,GEOMETRIC_SCALING_TYPE,err,error,*999) - ELSE - !Check the user specified field - CALL FIELD_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_GENERAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_VARIABLES_CHECK(EQUATIONS_SET_SETUP%FIELD,1,err,error,*999) - CALL FIELD_VARIABLE_TYPES_CHECK(EQUATIONS_SET_SETUP%FIELD,[FIELD_U_VARIABLE_TYPE],err,error,*999) - IF(NUMBER_OF_ANALYTIC_COMPONENTS==1) THEN - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_SCALAR_DIMENSION_TYPE,err,error,*999) - ELSE - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - ENDIF - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE, & - & err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_ANALYTIC_COMPONENTS,err,error,*999) - ENDIF - ENDIF - ELSE - CALL FlagError("Equations set materials is not finished.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set materials is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set geometric field is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set dependent field is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set dependent field has not been finished.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations analytic is not associated.",err,error,*999) - ENDIF - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - EQUATIONS_ANALYTIC=>EQUATIONS_SET%ANALYTIC - IF(ASSOCIATED(EQUATIONS_ANALYTIC)) THEN - ANALYTIC_FIELD=>EQUATIONS_ANALYTIC%ANALYTIC_FIELD - IF(ASSOCIATED(ANALYTIC_FIELD)) THEN - IF(EQUATIONS_ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED) THEN - !Finish creating the analytic field - CALL FIELD_CREATE_FINISH(EQUATIONS_ANALYTIC%ANALYTIC_FIELD,err,error,*999) - !Set the default values for the analytic field - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_BURGERS_SUBTYPE) - !Default the analytic parameter value to 0.0 - CALL FIELD_COMPONENT_VALUES_INITIALISE(EQUATIONS_ANALYTIC%ANALYTIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,1,0.0_DP,err,error,*999) - CASE(EQUATIONS_SET_GENERALISED_BURGERS_SUBTYPE) - !Default the analytic parameter values to 1.0 - CALL FIELD_COMPONENT_VALUES_INITIALISE(EQUATIONS_ANALYTIC%ANALYTIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,1,1.0_DP,err,error,*999) - CALL FIELD_COMPONENT_VALUES_INITIALISE(EQUATIONS_ANALYTIC%ANALYTIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,2,1.0_DP,err,error,*999) - CASE(EQUATIONS_SET_STATIC_BURGERS_SUBTYPE) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_INVISCID_BURGERS_SUBTYPE) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The equation set subtype of "// & - & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " is invalid for an analytical nonlinear Burgers equation." - CALL FlagError(localError,err,error,*999) - END SELECT - ENDIF - ENDIF - ELSE - CALL FlagError("Equations set analytic is not associated.",err,error,*999) - ENDIF - CASE DEFAULT - localError="The action type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a nonlinear Burgers equation." - CALL FlagError(localError,err,error,*999) - END SELECT - !----------------------------------------------------------------- - ! E q u a t i o n s t y p e - !----------------------------------------------------------------- - CASE(EQUATIONS_SET_SETUP_EQUATIONS_TYPE) - SELECT CASE (EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_BURGERS_SUBTYPE,EQUATIONS_SET_GENERALISED_BURGERS_SUBTYPE,EQUATIONS_SET_INVISCID_BURGERS_SUBTYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - CASE(EQUATIONS_SET_SETUP_START_ACTION) - IF(EQUATIONS_SET%DEPENDENT%DEPENDENT_FINISHED) THEN - CALL Equations_CreateStart(EQUATIONS_SET,EQUATIONS,err,error,*999) - CALL Equations_LinearityTypeSet(equations,EQUATIONS_NONLINEAR,err,error,*999) - CALL Equations_TimeDependenceTypeSet(equations,EQUATIONS_FIRST_ORDER_DYNAMIC,err,error,*999) - ELSE - CALL FlagError("Equations set dependent field has not been finished.",err,error,*999) - ENDIF - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - SELECT CASE(EQUATIONS_SET%SOLUTION_METHOD) - CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD) - !Finish the equations - CALL EquationsSet_EquationsGet(EQUATIONS_SET,EQUATIONS,err,error,*999) - CALL Equations_CreateFinish(equations,err,error,*999) - NULLIFY(vectorEquations) - CALL Equations_VectorEquationsGet(equations,vectorEquations,err,error,*999) - !Create the equations mapping. - CALL EquationsMapping_VectorCreateStart(vectorEquations,FIELD_DELUDELN_VARIABLE_TYPE,vectorMapping,err,error,*999) - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_INVISCID_BURGERS_SUBTYPE) THEN - CALL EquationsMapping_DynamicMatricesSet(vectorMapping,.TRUE.,.FALSE.,err,error,*999) - ELSE - CALL EquationsMapping_DynamicMatricesSet(vectorMapping,.TRUE.,.TRUE.,err,error,*999) - ENDIF - CALL EquationsMapping_ResidualVariableTypesSet(vectorMapping,[FIELD_U_VARIABLE_TYPE],err,error,*999) - CALL EquationsMapping_DynamicVariableTypeSet(vectorMapping,FIELD_U_VARIABLE_TYPE,err,error,*999) - CALL EquationsMapping_RHSVariableTypeSet(vectorMapping,FIELD_DELUDELN_VARIABLE_TYPE,err,error,*999) - CALL EquationsMapping_VectorCreateFinish(vectorMapping,err,error,*999) - !Create the equations matrices - CALL EquationsMatrices_VectorCreateStart(vectorEquations,vectorMatrices,err,error,*999) - !Set up matrix storage and structure - IF(equations%lumpingType==EQUATIONS_LUMPED_MATRICES) THEN - !Set up lumping - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_INVISCID_BURGERS_SUBTYPE) THEN - CALL EquationsMatrices_DynamicLumpingTypeSet(vectorMatrices, & - & [EQUATIONS_MATRIX_LUMPED],err,error,*999) - ELSE - CALL EquationsMatrices_DynamicLumpingTypeSet(vectorMatrices, & - & [EQUATIONS_MATRIX_UNLUMPED,EQUATIONS_MATRIX_LUMPED],err,error,*999) - ENDIF - SELECT CASE(equations%sparsityType) - CASE(EQUATIONS_MATRICES_FULL_MATRICES) - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_INVISCID_BURGERS_SUBTYPE) THEN - CALL EquationsMatrices_DynamicStorageTypeSet(vectorMatrices, & - & [DISTRIBUTED_MATRIX_DIAGONAL_STORAGE_TYPE],err,error,*999) - CALL EquationsMatrices_DynamicStructureTypeSet(vectorMatrices, & - [EQUATIONS_MATRIX_DIAGONAL_STRUCTURE],err,error,*999) - ELSE - CALL EquationsMatrices_DynamicStorageTypeSet(vectorMatrices, & - & [DISTRIBUTED_MATRIX_BLOCK_STORAGE_TYPE,DISTRIBUTED_MATRIX_DIAGONAL_STORAGE_TYPE],err,error,*999) - CALL EquationsMatrices_DynamicStructureTypeSet(vectorMatrices, & - [EQUATIONS_MATRIX_FEM_STRUCTURE,EQUATIONS_MATRIX_DIAGONAL_STRUCTURE],err,error,*999) - ENDIF - CALL EquationsMatrices_NonlinearStorageTypeSet(vectorMatrices,DISTRIBUTED_MATRIX_BLOCK_STORAGE_TYPE, & - & err,error,*999) - CASE(EQUATIONS_MATRICES_SPARSE_MATRICES) - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_INVISCID_BURGERS_SUBTYPE) THEN - CALL EquationsMatrices_DynamicStorageTypeSet(vectorMatrices, & - & [DISTRIBUTED_MATRIX_DIAGONAL_STORAGE_TYPE],err,error,*999) - CALL EquationsMatrices_DynamicStructureTypeSet(vectorMatrices, & - & [EQUATIONS_MATRIX_DIAGONAL_STRUCTURE],err,error,*999) - ELSE - CALL EquationsMatrices_DynamicStorageTypeSet(vectorMatrices, & - & [DISTRIBUTED_MATRIX_COMPRESSED_ROW_STORAGE_TYPE,DISTRIBUTED_MATRIX_DIAGONAL_STORAGE_TYPE],err,error,*999) - CALL EquationsMatrices_DynamicStructureTypeSet(vectorMatrices, & - & [EQUATIONS_MATRIX_FEM_STRUCTURE,EQUATIONS_MATRIX_DIAGONAL_STRUCTURE],err,error,*999) - ENDIF - CALL EquationsMatrices_NonlinearStorageTypeSet(vectorMatrices, & - & DISTRIBUTED_MATRIX_COMPRESSED_ROW_STORAGE_TYPE,err,error,*999) - CALL EquationsMatrices_NonlinearStructureTypeSet(vectorMatrices,EQUATIONS_MATRIX_FEM_STRUCTURE, & - & err,error,*999) - CASE DEFAULT - localError="The equations matrices sparsity type of "// & - & TRIM(NUMBER_TO_VSTRING(equations%sparsityType,"*",err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - SELECT CASE(equations%sparsityType) - CASE(EQUATIONS_MATRICES_FULL_MATRICES) - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_INVISCID_BURGERS_SUBTYPE) THEN - CALL EquationsMatrices_DynamicStorageTypeSet(vectorMatrices, & - & [DISTRIBUTED_MATRIX_BLOCK_STORAGE_TYPE],err,error,*999) - ELSE - CALL EquationsMatrices_DynamicStorageTypeSet(vectorMatrices, & - & [DISTRIBUTED_MATRIX_BLOCK_STORAGE_TYPE,DISTRIBUTED_MATRIX_BLOCK_STORAGE_TYPE],err,error,*999) - ENDIF - CALL EquationsMatrices_NonlinearStorageTypeSet(vectorMatrices,DISTRIBUTED_MATRIX_BLOCK_STORAGE_TYPE, & - & err,error,*999) - CASE(EQUATIONS_MATRICES_SPARSE_MATRICES) - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_INVISCID_BURGERS_SUBTYPE) THEN - CALL EquationsMatrices_DynamicStorageTypeSet(vectorMatrices, & - & [DISTRIBUTED_MATRIX_COMPRESSED_ROW_STORAGE_TYPE], & - & err,error,*999) - CALL EquationsMatrices_DynamicStructureTypeSet(vectorMatrices, & - [EQUATIONS_MATRIX_FEM_STRUCTURE],err,error,*999) - ELSE - CALL EquationsMatrices_DynamicStorageTypeSet(vectorMatrices, & - & [DISTRIBUTED_MATRIX_COMPRESSED_ROW_STORAGE_TYPE,DISTRIBUTED_MATRIX_COMPRESSED_ROW_STORAGE_TYPE], & - & err,error,*999) - CALL EquationsMatrices_DynamicStructureTypeSet(vectorMatrices, & - [EQUATIONS_MATRIX_FEM_STRUCTURE,EQUATIONS_MATRIX_FEM_STRUCTURE],err,error,*999) - ENDIF - CALL EquationsMatrices_NonlinearStorageTypeSet(vectorMatrices, & - & DISTRIBUTED_MATRIX_COMPRESSED_ROW_STORAGE_TYPE,err,error,*999) - CALL EquationsMatrices_NonlinearStructureTypeSet(vectorMatrices, & - EQUATIONS_MATRIX_FEM_STRUCTURE,err,error,*999) - CASE DEFAULT - localError="The equations matrices sparsity type of "// & - & TRIM(NUMBER_TO_VSTRING(equations%sparsityType,"*",err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - ENDIF - ! Use the analytic Jacobian calculation - CALL EquationsMatrices_JacobianTypesSet(vectorMatrices,[EQUATIONS_JACOBIAN_ANALYTIC_CALCULATED], & - & err,error,*999) - CALL EquationsMatrices_VectorCreateFinish(vectorMatrices,err,error,*999) - CASE(EQUATIONS_SET_BEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FD_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The solution method of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET%SOLUTION_METHOD,"*",err,error))// & - & " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The action type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a nonlinear Burgers equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(EQUATIONS_SET_STATIC_BURGERS_SUBTYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - CASE(EQUATIONS_SET_SETUP_START_ACTION) - IF(EQUATIONS_SET%DEPENDENT%DEPENDENT_FINISHED) THEN - CALL Equations_CreateStart(EQUATIONS_SET,EQUATIONS,err,error,*999) - CALL Equations_LinearityTypeSet(equations,EQUATIONS_NONLINEAR,err,error,*999) - CALL Equations_TimeDependenceTypeSet(equations,EQUATIONS_STATIC,err,error,*999) - ELSE - CALL FlagError("Equations set dependent field has not been finished.",err,error,*999) - ENDIF - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - SELECT CASE(EQUATIONS_SET%SOLUTION_METHOD) - CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD) - !Finish the equations - CALL EquationsSet_EquationsGet(EQUATIONS_SET,EQUATIONS,err,error,*999) - CALL Equations_CreateFinish(equations,err,error,*999) - NULLIFY(vectorEquations) - CALL Equations_VectorEquationsGet(equations,vectorEquations,err,error,*999) - !Create the equations mapping. - CALL EquationsMapping_VectorCreateStart(vectorEquations,FIELD_DELUDELN_VARIABLE_TYPE,vectorMapping,err,error,*999) - CALL EquationsMapping_LinearMatricesNumberSet(vectorMapping,1,err,error,*999) - CALL EquationsMapping_LinearMatricesVariableTypesSet(vectorMapping,[FIELD_U_VARIABLE_TYPE],err,error,*999) - CALL EquationsMapping_RHSVariableTypeSet(vectorMapping,FIELD_DELUDELN_VARIABLE_TYPE,err,error,*999) - CALL EquationsMapping_VectorCreateFinish(vectorMapping,err,error,*999) - !Create the equations matrices - CALL EquationsMatrices_VectorCreateStart(vectorEquations,vectorMatrices,err,error,*999) - SELECT CASE(equations%sparsityType) - CASE(EQUATIONS_MATRICES_FULL_MATRICES) - CALL EquationsMatrices_LinearStorageTypeSet(vectorMatrices,[MATRIX_BLOCK_STORAGE_TYPE], & - & err,error,*999) - CALL EquationsMatrices_NonlinearStorageTypeSet(vectorMatrices,MATRIX_BLOCK_STORAGE_TYPE, & - & err,error,*999) - CASE(EQUATIONS_MATRICES_SPARSE_MATRICES) - CALL EquationsMatrices_LinearStorageTypeSet(vectorMatrices, & - & [MATRIX_COMPRESSED_ROW_STORAGE_TYPE],err,error,*999) - CALL EquationsMatrices_LinearStructureTypeSet(vectorMatrices, & - & [EQUATIONS_MATRIX_FEM_STRUCTURE],err,error,*999) - CALL EquationsMatrices_NonlinearStorageTypeSet(vectorMatrices, & - & MATRIX_COMPRESSED_ROW_STORAGE_TYPE,err,error,*999) - CALL EquationsMatrices_NonlinearStructureTypeSet(vectorMatrices, & - & EQUATIONS_MATRIX_FEM_STRUCTURE,err,error,*999) - CASE DEFAULT - localError="The equations matrices sparsity type of "// & - & TRIM(NUMBER_TO_VSTRING(equations%sparsityType,"*",err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - ! Use the analytic Jacobian calculation - CALL EquationsMatrices_JacobianTypesSet(vectorMatrices,[EQUATIONS_JACOBIAN_ANALYTIC_CALCULATED], & - & err,error,*999) - CALL EquationsMatrices_VectorCreateFinish(vectorMatrices,err,error,*999) - CASE(EQUATIONS_SET_BEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FD_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The solution method of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET%SOLUTION_METHOD,"*",err,error))// & - & " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The action type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a nonlinear Burgers equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The equation set subtype of "// & - & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " is invalid for an analytical nonlinear Burgers equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The setup type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a nonlinear Burgers equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The equations set subtype of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " is not a nonlinear Burgers equation subtype." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - ENDIF - - EXITS("BURGERS_EQUATION_EQUATIONS_SET_SETUP") - RETURN -999 ERRORSEXITS("BURGERS_EQUATION_EQUATIONS_SET_SETUP",err,error) - RETURN 1 - - END SUBROUTINE BURGERS_EQUATION_EQUATIONS_SET_SETUP - - ! - !================================================================================================================================ - ! - - !>Sets up the BURGERS problem pre-solve. - SUBROUTINE BURGERS_EQUATION_PRE_SOLVE(SOLVER,err,error,*) - - !Argument variables - TYPE(SOLVER_TYPE), POINTER :: SOLVER !SOLVER%SOLVERS - IF(ASSOCIATED(SOLVERS)) THEN - CONTROL_LOOP=>SOLVERS%CONTROL_LOOP - IF(ASSOCIATED(CONTROL_LOOP)) THEN - IF(ASSOCIATED(CONTROL_LOOP%PROBLEM)) THEN - IF(.NOT.ALLOCATED(CONTROL_LOOP%PROBLEM%SPECIFICATION)) THEN - CALL FlagError("Problem specification array is not allocated.",err,error,*999) - ELSE IF(SIZE(CONTROL_LOOP%PROBLEM%SPECIFICATION,1)<3) THEN - CALL FlagError("Problem specification must have three entries for a Burgers equation problem.",err,error,*999) - END IF - SELECT CASE(CONTROL_LOOP%PROBLEM%SPECIFICATION(3)) - CASE(PROBLEM_STATIC_BURGERS_SUBTYPE) - ! do nothing ??? - CASE(PROBLEM_DYNAMIC_BURGERS_SUBTYPE) - DYNAMIC_SOLVER=>SOLVER%DYNAMIC_SOLVER - IF(ASSOCIATED(DYNAMIC_SOLVER)) THEN - IF(DYNAMIC_SOLVER%SOLVER_INITIALISED) & - & CALL Burgers_PreSolveUpdateAnalyticValues(CONTROL_LOOP,SOLVER,err,error,*999) - ELSE - CALL FlagError("Solver dynamic solver is not associated.",err,error,*999) - ENDIF - CASE DEFAULT - localError="Problem subtype "//TRIM(NUMBER_TO_VSTRING(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Burgers equation type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver solvers is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - - EXITS("BURGERS_EQUATION_PRE_SOLVE") - RETURN -999 ERRORSEXITS("BURGERS_EQUATION_PRE_SOLVE",err,error) - RETURN 1 - END SUBROUTINE BURGERS_EQUATION_PRE_SOLVE - - - ! - !================================================================================================================================ - ! - !updates the boundary conditions and source term to the required analytic values - SUBROUTINE Burgers_PreSolveUpdateAnalyticValues(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !SOLVER%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN - !Loop over all the equation sets and set the appropriate field variable type BCs and - !the source field associated with each equation set - DO eqnset_idx=1,SOLVER_equations%SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS - SOLVER_MAPPING=>SOLVER_equations%SOLVER_MAPPING - EQUATIONS=>SOLVER_MAPPING%EQUATIONS_SET_TO_SOLVER_MAP(eqnset_idx)%EQUATIONS - IF(ASSOCIATED(EQUATIONS)) THEN - EQUATIONS_SET=>equations%equationsSet - IF(ASSOCIATED(EQUATIONS_SET)) THEN - IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN - dependentField=>EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD - IF(ASSOCIATED(dependentField)) THEN - geometricField=>EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD - IF(ASSOCIATED(geometricField)) THEN - ANALYTIC_FIELD=>EQUATIONS_SET%ANALYTIC%ANALYTIC_FIELD - CALL FIELD_NUMBER_OF_COMPONENTS_GET(geometricField,FIELD_U_VARIABLE_TYPE,& - & NUMBER_OF_DIMENSIONS,err,error,*999) - NULLIFY(GEOMETRIC_VARIABLE) - NULLIFY(GEOMETRIC_PARAMETERS) - CALL Field_VariableGet(geometricField,FIELD_U_VARIABLE_TYPE,GEOMETRIC_VARIABLE,err,error,*999) - CALL FIELD_PARAMETER_SET_DATA_GET(geometricField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,& - & GEOMETRIC_PARAMETERS,err,error,*999) - EQUATIONS_SET%ANALYTIC%ANALYTIC_USER_PARAMS(1)=CURRENT_TIME - NULLIFY(ANALYTIC_VARIABLE) - NULLIFY(ANALYTIC_PARAMETERS) - IF(ASSOCIATED(ANALYTIC_FIELD)) THEN - CALL Field_VariableGet(ANALYTIC_FIELD,FIELD_U_VARIABLE_TYPE,ANALYTIC_VARIABLE,err,error,*999) - CALL FIELD_PARAMETER_SET_DATA_GET(ANALYTIC_FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, & - & ANALYTIC_PARAMETERS,err,error,*999) - ENDIF - NULLIFY(materialsField) - NULLIFY(MATERIALS_VARIABLE) - NULLIFY(MATERIALS_PARAMETERS) - IF(ASSOCIATED(EQUATIONS_SET%MATERIALS)) THEN - materialsField=>EQUATIONS_SET%MATERIALS%MATERIALS_FIELD - CALL Field_VariableGet(materialsField,FIELD_U_VARIABLE_TYPE,MATERIALS_VARIABLE,err,error,*999) - CALL FIELD_PARAMETER_SET_DATA_GET(materialsField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, & - & MATERIALS_PARAMETERS,err,error,*999) - ENDIF - DO variable_idx=1,dependentField%NUMBER_OF_VARIABLES - variable_type=dependentField%VARIABLES(variable_idx)%VARIABLE_TYPE - FIELD_VARIABLE=>dependentField%VARIABLE_TYPE_MAP(variable_type)%ptr - IF(ASSOCIATED(FIELD_VARIABLE)) THEN - DO component_idx=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - IF(FIELD_VARIABLE%COMPONENTS(component_idx)%INTERPOLATION_TYPE== & - & FIELD_NODE_BASED_INTERPOLATION) THEN - DOMAIN=>FIELD_VARIABLE%COMPONENTS(component_idx)%DOMAIN - IF(ASSOCIATED(DOMAIN)) THEN - IF(ASSOCIATED(DOMAIN%TOPOLOGY)) THEN - DOMAIN_NODES=>DOMAIN%TOPOLOGY%NODES - IF(ASSOCIATED(DOMAIN_NODES)) THEN - !Loop over the local nodes excluding the ghosts. - DO node_idx=1,DOMAIN_NODES%NUMBER_OF_NODES -!!TODO \todo We should interpolate the geometric field here and the node position. - DO dim_idx=1,NUMBER_OF_DIMENSIONS - !Default to version 1 of each node derivative - local_ny=GEOMETRIC_VARIABLE%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP% & - & NODE_PARAM2DOF_MAP%NODES(node_idx)%DERIVATIVES(1)%VERSIONS(1) - X(dim_idx)=GEOMETRIC_PARAMETERS(local_ny) - ENDDO !dim_idx - !Loop over the derivatives - DO deriv_idx=1,DOMAIN_NODES%NODES(node_idx)%NUMBER_OF_DERIVATIVES - ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE - GLOBAL_DERIV_INDEX=DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)% & - & GLOBAL_DERIVATIVE_INDEX - CALL Burgers_AnalyticFunctionsEvaluate(EQUATIONS_SET, & - & ANALYTIC_FUNCTION_TYPE,X,TANGENTS,NORMAL,CURRENT_TIME,variable_type, & - & GLOBAL_DERIV_INDEX,component_idx,ANALYTIC_PARAMETERS,MATERIALS_PARAMETERS, & - & VALUE,err,error,*999) - !Default to version 1 of each node derivative - local_ny=FIELD_VARIABLE%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% & - & NODE_PARAM2DOF_MAP%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1) - CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(dependentField,variable_type, & - & FIELD_ANALYTIC_VALUES_SET_TYPE,local_ny,VALUE,err,error,*999) - CALL BOUNDARY_CONDITIONS_VARIABLE_GET(SOLVER_equations%BOUNDARY_CONDITIONS, & - & FIELD_VARIABLE,BOUNDARY_CONDITIONS_VARIABLE,err,error,*999) - IF(ASSOCIATED(BOUNDARY_CONDITIONS_VARIABLE)) THEN - BOUNDARY_CONDITION_CHECK_VARIABLE=BOUNDARY_CONDITIONS_VARIABLE% & - & CONDITION_TYPES(local_ny) - IF(BOUNDARY_CONDITION_CHECK_VARIABLE==BOUNDARY_CONDITION_FIXED) THEN - CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(dependentField, & - & variable_type,FIELD_VALUES_SET_TYPE,local_ny, & - & VALUE,err,error,*999) - ENDIF - ELSE - CALL FlagError("Boundary conditions variable is not associated",err,error,*999) - ENDIF - ENDDO !deriv_idx - ENDDO !node_idx - ELSE - CALL FlagError("Domain topology nodes is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Domain topology is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Domain is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Only node based interpolation is implemented.",err,error,*999) - ENDIF - ENDDO !component_idx - CALL FIELD_PARAMETER_SET_UPDATE_START(dependentField,variable_type, & - & FIELD_ANALYTIC_VALUES_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(dependentField,variable_type, & - & FIELD_ANALYTIC_VALUES_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_START(dependentField,variable_type, & - & FIELD_VALUES_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(dependentField,variable_type, & - & FIELD_VALUES_SET_TYPE,err,error,*999) - ELSE - CALL FlagError("Field variable is not associated.",err,error,*999) - ENDIF - - ENDDO !variable_idx - CALL FIELD_PARAMETER_SET_DATA_RESTORE(geometricField,FIELD_U_VARIABLE_TYPE,& - & FIELD_VALUES_SET_TYPE,GEOMETRIC_PARAMETERS,err,error,*999) - ELSE - CALL FlagError("Equations set geometric field is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set dependent field is not associated.",err,error,*999) - ENDIF - ENDIF - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations are not associated.",err,error,*999) - END IF - CALL FIELD_PARAMETER_SET_UPDATE_START(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,err,error,*999) - ENDDO !eqnset_idx - ELSE - CALL FlagError("Solver equations are not associated.",err,error,*999) - END IF - CASE DEFAULT - localError="Problem subtype "//TRIM(NUMBER_TO_VSTRING(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a BURGERS equation type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - - EXITS("Burgers_PreSolveUpdateAnalyticValues") - RETURN -999 ERRORS("Burgers_PreSolveUpdateAnalyticValues",err,error) - EXITS("Burgers_PreSolveUpdateAnalyticValues") - RETURN 1 - - END SUBROUTINE Burgers_PreSolveUpdateAnalyticValues - - - ! - !================================================================================================================================ - ! - SUBROUTINE Burgers_PreSolveStoreCurrentSolution(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !Sets up the Burgers problem post solve. - SUBROUTINE BURGERS_EQUATION_POST_SOLVE(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !Output data post solve - SUBROUTINE BURGERS_EQUATION_POST_SOLVE_OUTPUT_DATA(SOLVER,err,error,*) - - !Argument variables - TYPE(SOLVER_TYPE), POINTER :: SOLVER !SOLVER%SOLVERS - IF(ASSOCIATED(SOLVERS)) THEN - CONTROL_LOOP=>SOLVERS%CONTROL_LOOP - IF(ASSOCIATED(CONTROL_LOOP)) THEN - IF(ASSOCIATED(CONTROL_LOOP%PROBLEM)) THEN - IF(.NOT.ALLOCATED(CONTROL_LOOP%PROBLEM%SPECIFICATION)) THEN - CALL FlagError("Problem specification array is not allocated.",err,error,*999) - ELSE IF(SIZE(CONTROL_LOOP%PROBLEM%SPECIFICATION,1)<3) THEN - CALL FlagError("Problem specification must have three entries for a Burgers equation problem.",err,error,*999) - END IF - CALL SYSTEM('mkdir -p ./output') - SELECT CASE(CONTROL_LOOP%PROBLEM%SPECIFICATION(3)) - CASE(PROBLEM_STATIC_BURGERS_SUBTYPE,PROBLEM_DYNAMIC_BURGERS_SUBTYPE) - CALL CONTROL_LOOP_TIMES_GET(CONTROL_LOOP,START_TIME,STOP_TIME,CURRENT_TIME,TIME_INCREMENT, & - & CURRENT_LOOP_ITERATION,OUTPUT_ITERATION_NUMBER,err,error,*999) - SOLVER_EQUATIONS=>SOLVER%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN - SOLVER_MAPPING=>SOLVER_EQUATIONS%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING)) THEN - !Make sure the equations sets are up to date - DO equations_set_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS - EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(equations_set_idx)%ptr - IF(OUTPUT_ITERATION_NUMBER/=0) THEN - IF(CURRENT_TIME<=STOP_TIME) THEN - IF(CURRENT_LOOP_ITERATION<10) THEN - WRITE(OUTPUT_FILE,'("TIME_STEP_000",I0)') CURRENT_LOOP_ITERATION - ELSE IF(CURRENT_LOOP_ITERATION<100) THEN - WRITE(OUTPUT_FILE,'("TIME_STEP_00",I0)') CURRENT_LOOP_ITERATION - ELSE IF(CURRENT_LOOP_ITERATION<1000) THEN - WRITE(OUTPUT_FILE,'("TIME_STEP_0",I0)') CURRENT_LOOP_ITERATION - ELSE IF(CURRENT_LOOP_ITERATION<10000) THEN - WRITE(OUTPUT_FILE,'("TIME_STEP_",I0)') CURRENT_LOOP_ITERATION - END IF - FILE=OUTPUT_FILE - FILENAME="./output/"//"MainTime_"//TRIM(NumberToVString(CURRENT_LOOP_ITERATION,"*",err,error)) - METHOD="FORTRAN" - IF(MOD(CURRENT_LOOP_ITERATION,OUTPUT_ITERATION_NUMBER)==0) THEN - IF(CONTROL_LOOP%outputtype >= CONTROL_LOOP_PROGRESS_OUTPUT) THEN - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"...",err,error,*999) - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Now export fields... ",err,error,*999) - ENDIF - Fields=>EQUATIONS_SET%REGION%FIELDS - CALL FIELD_IO_NODES_EXPORT(Fields,FILENAME,METHOD,err,error,*999) - CALL FIELD_IO_ELEMENTS_EXPORT(Fields,FILENAME,METHOD,err,error,*999) - NULLIFY(Fields) - IF(CONTROL_LOOP%outputtype >= CONTROL_LOOP_PROGRESS_OUTPUT) THEN - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,FILENAME,err,error,*999) - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"...",err,error,*999) - ENDIF - END IF - IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN - CALL AnalyticAnalysis_Output(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FILE,err,error,*999) - ENDIF - ENDIF - ENDIF - ENDDO - ENDIF - ENDIF - CASE DEFAULT - localError="Problem subtype "//TRIM(NUMBER_TO_VSTRING(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a BURGERS equation type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver solvers is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - - EXITS("BURGERS_EQUATION_POST_SOLVE_OUTPUT_DATA") - RETURN -999 ERRORSEXITS("BURGERS_EQUATION_POST_SOLVE_OUTPUT_DATA",err,error) - RETURN 1 - - END SUBROUTINE BURGERS_EQUATION_POST_SOLVE_OUTPUT_DATA - - ! - !================================================================================================================================ - ! - - !>Sets the problem specification for a Burgers problem. - SUBROUTINE Burgers_ProblemSpecificationSet(problem,problemSpecification,err,error,*) - - !Argument variables - TYPE(PROBLEM_TYPE), POINTER :: problem !Sets up the Burgers problem. - SUBROUTINE BURGERS_EQUATION_PROBLEM_SETUP(PROBLEM,PROBLEM_SETUP,err,error,*) - - !Argument variables - TYPE(PROBLEM_TYPE), POINTER :: PROBLEM !PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_CREATE_FINISH(CONTROL_LOOP,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NUMBER_TO_VSTRING(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a Burgers problem." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVERS_TYPE) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Start the solvers creation - CALL SOLVERS_CREATE_START(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_NUMBER_SET(SOLVERS,1,err,error,*999) - !Set the solver to be a static nonlinear solver - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - CALL SOLVER_TYPE_SET(SOLVER,SOLVER_NONLINEAR_TYPE,err,error,*999) - CALL SOLVER_LABEL_SET(SOLVER,"Nonlinear solver",err,error,*999) - CALL SOLVER_LIBRARY_TYPE_SET(SOLVER,SOLVER_PETSC_LIBRARY,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the solvers - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - !Finish the solvers creation - CALL SOLVERS_CREATE_FINISH(SOLVERS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NUMBER_TO_VSTRING(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a Burgers problem." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVER_EQUATIONS_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - !Get the solver - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - !Create the solver equations - CALL SOLVER_EQUATIONS_CREATE_START(SOLVER,SOLVER_EQUATIONS,err,error,*999) - CALL SOLVER_EQUATIONS_LINEARITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_NONLINEAR,err,error,*999) - CALL SOLVER_EQUATIONS_TIME_DEPENDENCE_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_STATIC,err,error,*999) - CALL SOLVER_EQUATIONS_SPARSITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_SPARSE_MATRICES,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - !Get the solver equations - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - CALL SOLVER_SOLVER_EQUATIONS_GET(SOLVER,SOLVER_EQUATIONS,err,error,*999) - !Finish the solver equations creation - CALL SOLVER_EQUATIONS_CREATE_FINISH(SOLVER_EQUATIONS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NUMBER_TO_VSTRING(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a Burgers problem." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The setup type of "//TRIM(NUMBER_TO_VSTRING(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a Burgers problem." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_DYNAMIC_BURGERS_SUBTYPE) - SELECT CASE(PROBLEM_SETUP%SETUP_TYPE) - CASE(PROBLEM_SETUP_INITIAL_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Do nothing???? - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Do nothing???? - CASE DEFAULT - localError="The action type of "//TRIM(NUMBER_TO_VSTRING(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a Burgers problem." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_CONTROL_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Set up a time control loop - CALL CONTROL_LOOP_CREATE_START(PROBLEM,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_TYPE_SET(CONTROL_LOOP,PROBLEM_CONTROL_TIME_LOOP_TYPE,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Finish the control loops - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_CREATE_FINISH(CONTROL_LOOP,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NUMBER_TO_VSTRING(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a Burgers problem." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVERS_TYPE) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Start the solvers creation - CALL SOLVERS_CREATE_START(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_NUMBER_SET(SOLVERS,1,err,error,*999) - !Set the solver to be a static nonlinear solver - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - CALL SOLVER_TYPE_SET(SOLVER,SOLVER_DYNAMIC_TYPE,err,error,*999) - CALL SOLVER_LABEL_SET(SOLVER,"Nonlinear dynamic solver",err,error,*999) - CALL SOLVER_DYNAMIC_LINEARITY_TYPE_SET(SOLVER,SOLVER_DYNAMIC_NONLINEAR,err,error,*999) - CALL SOLVER_DYNAMIC_ORDER_SET(SOLVER,SOLVER_DYNAMIC_FIRST_ORDER,err,error,*999) - !Set solver defaults - CALL SOLVER_DYNAMIC_DEGREE_SET(SOLVER,SOLVER_DYNAMIC_FIRST_DEGREE,err,error,*999) - CALL SOLVER_DYNAMIC_SCHEME_SET(SOLVER,SOLVER_DYNAMIC_CRANK_NICOLSON_SCHEME,err,error,*999) - CALL SOLVER_LIBRARY_TYPE_SET(SOLVER,SOLVER_CMISS_LIBRARY,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the solvers - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - !Finish the solvers creation - CALL SOLVERS_CREATE_FINISH(SOLVERS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NUMBER_TO_VSTRING(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a nonlinear burgers problem." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVER_EQUATIONS_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - !Get the solver - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - !Create the solver equations - CALL SOLVER_EQUATIONS_CREATE_START(SOLVER,SOLVER_EQUATIONS,err,error,*999) - CALL SOLVER_EQUATIONS_LINEARITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_NONLINEAR,err,error,*999) - CALL SOLVER_EQUATIONS_TIME_DEPENDENCE_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_FIRST_ORDER_DYNAMIC, & - & err,error,*999) - CALL SOLVER_EQUATIONS_SPARSITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_SPARSE_MATRICES,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - !Get the solver equations - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - CALL SOLVER_SOLVER_EQUATIONS_GET(SOLVER,SOLVER_EQUATIONS,err,error,*999) - !Finish the solver equations creation - CALL SOLVER_EQUATIONS_CREATE_FINISH(SOLVER_EQUATIONS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NUMBER_TO_VSTRING(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a Burgers problem." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The setup type of "//TRIM(NUMBER_TO_VSTRING(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a Burgers problem." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The problem subtype of "//TRIM(NUMBER_TO_VSTRING(PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " does not equal a Burgers problem subtype." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - - EXITS("BURGERS_EQUATION_PROBLEM_SETUP") - RETURN -999 ERRORSEXITS("BURGERS_EQUATION_PROBLEM_SETUP",err,error) - RETURN 1 - - END SUBROUTINE BURGERS_EQUATION_PROBLEM_SETUP - - ! - !================================================================================================================================ - ! - - !>Evaluates the Jacobian element stiffness matrices for a BURGERS equation finite element equations set. - SUBROUTINE Burgers_FiniteElementJacobianEvaluate(EQUATIONS_SET,ELEMENT_NUMBER,err,error,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: EQUATIONS_SET !EQUATIONS_SET%EQUATIONS - IF(ASSOCIATED(EQUATIONS)) THEN - NULLIFY(vectorEquations) - CALL Equations_VectorEquationsGet(equations,vectorEquations,err,error,*999) - vectorMatrices=>vectorEquations%vectorMatrices - nonlinearMatrices=>vectorMatrices%nonlinearMatrices - jacobianMatrix=>nonlinearMatrices%jacobians(1)%ptr - updateJacobianMatrix=jacobianMatrix%updateJacobian - evaluateJacobian=updateJacobianMatrix - IF(evaluateJacobian) THEN - dependentField=>equations%interpolation%dependentField - geometricField=>equations%interpolation%geometricField - materialsField=>equations%interpolation%materialsField - GEOMETRIC_BASIS=>geometricField%DECOMPOSITION%DOMAIN(geometricField%DECOMPOSITION%MESH_COMPONENT_NUMBER)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - DEPENDENT_BASIS1=>dependentField%DECOMPOSITION%DOMAIN(dependentField%DECOMPOSITION%MESH_COMPONENT_NUMBER)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - QUADRATURE_SCHEME1=>DEPENDENT_BASIS1%QUADRATURE%QUADRATURE_SCHEME_MAP(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr - vectorMapping=>vectorEquations%vectorMapping - nonlinearMapping=>vectorMapping%nonlinearMapping - FIELD_VARIABLE=>nonlinearMapping%residualVariables(1)%ptr - FIELD_VAR_TYPE=FIELD_VARIABLE%VARIABLE_TYPE - GEOMETRIC_VARIABLE=>geometricField%VARIABLE_TYPE_MAP(FIELD_U_VARIABLE_TYPE)%ptr - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER,equations%interpolation% & - & dependentInterpParameters(FIELD_VAR_TYPE)%ptr,err,error,*999) - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER,equations%interpolation% & - & geometricInterpParameters(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_GENERALISED_BURGERS_SUBTYPE) & - & CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER,equations%interpolation% & - & materialsInterpParameters(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - C_PARAM=1.0_DP - !Loop over all Gauss points - DO ng=1,QUADRATURE_SCHEME1%NUMBER_OF_GAUSS - CALL FIELD_INTERPOLATE_GAUSS(SECOND_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng,equations%interpolation% & - & dependentInterpPoint(FIELD_VAR_TYPE)%ptr,err,error,*999) - CALL FIELD_INTERPOLATE_GAUSS(FIRST_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng,equations%interpolation% & - & geometricInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - CALL FIELD_INTERPOLATED_POINT_METRICS_CALCULATE(GEOMETRIC_BASIS%NUMBER_OF_XI,equations%interpolation% & - & geometricInterpPointMetrics(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_GENERALISED_BURGERS_SUBTYPE) THEN - CALL FIELD_INTERPOLATE_GAUSS(NO_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng,equations%interpolation% & - & materialsInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - C_PARAM=equations%interpolation%materialsInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(3,NO_PART_DERIV) - ENDIF - !Loop over rows - mhs=0 - DO mh=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - MESH_COMPONENT1=FIELD_VARIABLE%COMPONENTS(mh)%MESH_COMPONENT_NUMBER - DEPENDENT_BASIS1=>dependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT1)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - QUADRATURE_SCHEME1=>DEPENDENT_BASIS1%QUADRATURE%QUADRATURE_SCHEME_MAP(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr - JGW=equations%interpolation%geometricInterpPointMetrics(FIELD_U_VARIABLE_TYPE)%ptr%JACOBIAN* & - & QUADRATURE_SCHEME1%GAUSS_WEIGHTS(ng) - DO ms=1,DEPENDENT_BASIS1%NUMBER_OF_ELEMENT_PARAMETERS - mhs=mhs+1 - nhs=0 - PHIMS=QUADRATURE_SCHEME1%GAUSS_BASIS_FNS(ms,NO_PART_DERIV,ng) - !Loop over element columns - DO nh=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - MESH_COMPONENT2=FIELD_VARIABLE%COMPONENTS(nh)%MESH_COMPONENT_NUMBER - DEPENDENT_BASIS2=>dependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT2)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - QUADRATURE_SCHEME2=>DEPENDENT_BASIS2%QUADRATURE%QUADRATURE_SCHEME_MAP& - &(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr - DO ns=1,DEPENDENT_BASIS2%NUMBER_OF_ELEMENT_PARAMETERS - nhs=nhs+1 - PHINS=QUADRATURE_SCHEME2%GAUSS_BASIS_FNS(ns,NO_PART_DERIV,ng) - !Loop over xi directions - SUM1=0.0_DP - DO ni=1,DEPENDENT_BASIS1%NUMBER_OF_XI - U_DERIV=equations%interpolation%dependentInterpPoint(FIELD_VAR_TYPE)%ptr% & - & VALUES(mh,PARTIAL_DERIVATIVE_FIRST_DERIVATIVE_MAP(ni)) - DXI_DX=equations%interpolation%geometricInterpPointMetrics(FIELD_U_VARIABLE_TYPE)%ptr%DXI_DX(ni,nh) - SUM1=SUM1+U_DERIV*DXI_DX - ENDDO !ni - SUM1=SUM1*PHINS - SUM2=0.0_DP - IF(nh==mh) THEN - !Loop over spatial directions - DO nj=1,GEOMETRIC_VARIABLE%NUMBER_OF_COMPONENTS - U_VALUE=equations%interpolation%dependentInterpPoint(FIELD_VAR_TYPE)%ptr%VALUES(nj,NO_PART_DERIV) - SUM3=0.0_DP - DO ni=1,DEPENDENT_BASIS1%NUMBER_OF_XI - DPHINS_DXI=QUADRATURE_SCHEME1%GAUSS_BASIS_FNS(ns,PARTIAL_DERIVATIVE_FIRST_DERIVATIVE_MAP(ni),ng) - DXI_DX=equations%interpolation%geometricInterpPointMetrics(FIELD_U_VARIABLE_TYPE)%ptr%DXI_DX(ni,nj) - SUM3=SUM3+DPHINS_DXI*DXI_DX - ENDDO !ni - SUM2=SUM2+U_VALUE*SUM3 - ENDDO !nj - ENDIF - VALUE=C_PARAM*(SUM1+SUM2)*PHIMS - jacobianMatrix%elementJacobian%matrix(mhs,nhs)=jacobianMatrix%elementJacobian%matrix(mhs,nhs)+VALUE*JGW - ENDDO !ns - ENDDO !nh - ENDDO !ms - ENDDO !mh - ENDDO !ng - ENDIF - ELSE - CALL FlagError("Equations set equations is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - ENDIF - - EXITS("Burgers_FiniteElementJacobianEvaluate") - RETURN -999 ERRORS("Burgers_FiniteElementJacobianEvaluate",err,error) - EXITS("Burgers_FiniteElementJacobianEvaluate") - RETURN 1 - - END SUBROUTINE Burgers_FiniteElementJacobianEvaluate - - ! - !================================================================================================================================ - ! - - !>Evaluates the residual element stiffness matrices and RHS for a Burgers equation finite element equations set. - SUBROUTINE Burgers_FiniteElementResidualEvaluate(EQUATIONS_SET,ELEMENT_NUMBER,err,error,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: EQUATIONS_SET !EQUATIONS_SET%EQUATIONS - IF(ASSOCIATED(EQUATIONS)) THEN - NULLIFY(vectorEquations) - CALL Equations_VectorEquationsGet(equations,vectorEquations,err,error,*999) - vectorMatrices=>vectorEquations%vectorMatrices - rhsVector=>vectorMatrices%rhsVector - nonlinearMatrices=>vectorMatrices%nonlinearMatrices - vectorMapping=>vectorEquations%vectorMapping - nonlinearMapping=>vectorMapping%nonlinearMapping - dependentField=>equations%interpolation%dependentField - geometricField=>equations%interpolation%geometricField - GEOMETRIC_VARIABLE=>geometricField%VARIABLE_TYPE_MAP(FIELD_U_VARIABLE_TYPE)%ptr - materialsField=>equations%interpolation%materialsField - GEOMETRIC_BASIS=>geometricField%DECOMPOSITION%DOMAIN(geometricField%DECOMPOSITION%MESH_COMPONENT_NUMBER)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - DEPENDENT_BASIS=>dependentField%DECOMPOSITION%DOMAIN(dependentField%DECOMPOSITION%MESH_COMPONENT_NUMBER)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - QUADRATURE_SCHEME=>DEPENDENT_BASIS%QUADRATURE%QUADRATURE_SCHEME_MAP(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_BURGERS_SUBTYPE) - dynamicMatrices=>vectorMatrices%dynamicMatrices - stiffnessMatrix=>dynamicMatrices%matrices(1)%ptr - dampingMatrix=>dynamicMatrices%matrices(2)%ptr - dynamicMapping=>vectorMapping%dynamicMapping - FIELD_VARIABLE=>nonlinearMapping%residualVariables(1)%ptr - FIELD_VAR_TYPE=FIELD_VARIABLE%VARIABLE_TYPE - CASE(EQUATIONS_SET_GENERALISED_BURGERS_SUBTYPE) - dynamicMatrices=>vectorMatrices%dynamicMatrices - stiffnessMatrix=>dynamicMatrices%matrices(1)%ptr - dampingMatrix=>dynamicMatrices%matrices(2)%ptr - dynamicMapping=>vectorMapping%dynamicMapping - FIELD_VARIABLE=>nonlinearMapping%residualVariables(1)%ptr - FIELD_VAR_TYPE=FIELD_VARIABLE%VARIABLE_TYPE - CASE(EQUATIONS_SET_STATIC_BURGERS_SUBTYPE) - linearMatrices=>vectorMatrices%linearMatrices - stiffnessMatrix=>linearMatrices%matrices(1)%ptr - linearMapping=>vectorMapping%linearMapping - FIELD_VARIABLE=>nonlinearMapping%residualVariables(1)%ptr - FIELD_VAR_TYPE=FIELD_VARIABLE%VARIABLE_TYPE - CASE(EQUATIONS_SET_INVISCID_BURGERS_SUBTYPE) - dynamicMatrices=>vectorMatrices%dynamicMatrices - dampingMatrix=>dynamicMatrices%matrices(1)%ptr - dynamicMapping=>vectorMapping%dynamicMapping - FIELD_VARIABLE=>nonlinearMapping%residualVariables(1)%ptr - FIELD_VAR_TYPE=FIELD_VARIABLE%VARIABLE_TYPE - CASE DEFAULT - localError="Equations set subtype "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a BURGERS equation type of a fluid mechanics equations set class." - CALL FlagError(localError,err,error,*999) - END SELECT - IF(ASSOCIATED(stiffnessMatrix)) THEN - updateStiffness=stiffnessMatrix%updateMatrix - firstStiffness=stiffnessMatrix%firstAssembly - ENDIF - IF(ASSOCIATED(dampingMatrix)) THEN - updateDamping=dampingMatrix%updateMatrix - firstDamping=dampingMatrix%firstAssembly - ENDIF - IF(ASSOCIATED(rhsVector)) THEN - updateRHS=rhsVector%updateVector - firstRHS=rhsVector%firstAssembly - ENDIF - IF(ASSOCIATED(nonlinearMatrices)) updateResidual=nonlinearMatrices%updateResidual - evaluateResidual=updateResidual - evaluateStiffness=firstStiffness.OR.updateStiffness - evaluateDamping=firstDamping.OR.updateDamping - evaluateRHS=firstRHS.OR.updateRHS - evaluateLinearDynamic=evaluateStiffness.OR.evaluateDamping.OR.evaluateRHS - evaluateAny=evaluateLinearDynamic.OR.updateResidual - IF(evaluateAny) THEN - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER,equations%interpolation% & - & dependentInterpParameters(FIELD_VAR_TYPE)%ptr,err,error,*999) - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER,equations%interpolation% & - & geometricInterpParameters(FIELD_VAR_TYPE)%ptr,err,error,*999) - IF(EQUATIONS_SET%SPECIFICATION(3)/=EQUATIONS_SET_INVISCID_BURGERS_SUBTYPE) & - & CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER,equations%interpolation% & - & materialsInterpParameters(FIELD_VAR_TYPE)%ptr,err,error,*999) - A_PARAM=1.0_DP - B_PARAM=1.0_DP - C_PARAM=1.0_DP - !Loop over gauss points - DO ng=1,QUADRATURE_SCHEME%NUMBER_OF_GAUSS - CALL FIELD_INTERPOLATE_GAUSS(FIRST_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng,equations%interpolation% & - & dependentInterpPoint(FIELD_VAR_TYPE)%ptr,err,error,*999) - CALL FIELD_INTERPOLATE_GAUSS(FIRST_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng,equations%interpolation% & - & geometricInterpPoint(FIELD_VAR_TYPE)%ptr,err,error,*999) - CALL FIELD_INTERPOLATED_POINT_METRICS_CALCULATE(GEOMETRIC_BASIS%NUMBER_OF_XI,equations%interpolation% & - & geometricInterpPointMetrics(FIELD_VAR_TYPE)%ptr,err,error,*999) - IF(EQUATIONS_SET%SPECIFICATION(3)/=EQUATIONS_SET_INVISCID_BURGERS_SUBTYPE) THEN - CALL FIELD_INTERPOLATE_GAUSS(NO_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng,equations%interpolation% & - & materialsInterpPoint(FIELD_VAR_TYPE)%ptr,err,error,*999) - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_GENERALISED_BURGERS_SUBTYPE) THEN - A_PARAM=equations%interpolation%materialsInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(1,NO_PART_DERIV) - B_PARAM=equations%interpolation%materialsInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(2,NO_PART_DERIV) - C_PARAM=equations%interpolation%materialsInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(3,NO_PART_DERIV) - ELSE - B_PARAM=equations%interpolation%materialsInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(1,NO_PART_DERIV) - ENDIF - ENDIF - mhs=0 - DO mh=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - MESH_COMPONENT1=FIELD_VARIABLE%COMPONENTS(mh)%MESH_COMPONENT_NUMBER - DEPENDENT_BASIS1=>dependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT1)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - QUADRATURE_SCHEME1=>DEPENDENT_BASIS1%QUADRATURE%QUADRATURE_SCHEME_MAP(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr - JGW=equations%interpolation%geometricInterpPointMetrics(FIELD_U_VARIABLE_TYPE)%ptr%JACOBIAN* & - & QUADRATURE_SCHEME1%GAUSS_WEIGHTS(ng) - !Loop over element rows - DO ms=1,DEPENDENT_BASIS%NUMBER_OF_ELEMENT_PARAMETERS - mhs=mhs+1 - IF(evaluateLinearDynamic) THEN - IF(evaluateStiffness.OR.evaluateDamping) THEN - nhs=0 - !Loop over element columns - DO nh=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - MESH_COMPONENT2=FIELD_VARIABLE%COMPONENTS(mh)%MESH_COMPONENT_NUMBER - DEPENDENT_BASIS2=>dependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT2)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - QUADRATURE_SCHEME2=>DEPENDENT_BASIS2%QUADRATURE%QUADRATURE_SCHEME_MAP& - &(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr - DO ns=1,DEPENDENT_BASIS%NUMBER_OF_ELEMENT_PARAMETERS - nhs=nhs+1 - !Diffusion matrix - IF(evaluateStiffness) THEN - DO ni=1,DEPENDENT_BASIS1%NUMBER_OF_XI - DPHIMS_DXI(ni)=QUADRATURE_SCHEME1%GAUSS_BASIS_FNS(ms,PARTIAL_DERIVATIVE_FIRST_DERIVATIVE_MAP(ni),ng) - DPHINS_DXI(ni)=QUADRATURE_SCHEME2%GAUSS_BASIS_FNS(ns,PARTIAL_DERIVATIVE_FIRST_DERIVATIVE_MAP(ni),ng) - END DO !ni - SUM=0.0_DP - !Calculate SUM - DO mi=1,DEPENDENT_BASIS1%NUMBER_OF_XI - DO ni=1,DEPENDENT_BASIS2%NUMBER_OF_XI - SUM=SUM+DPHINS_DXI(ni)*DPHIMS_DXI(mi)*equations%interpolation% & - & geometricInterpPointMetrics(FIELD_U_VARIABLE_TYPE)%ptr%GU(mi,ni) - ENDDO !ni - ENDDO !mi - stiffnessMatrix%elementMatrix%matrix(mhs,nhs)=stiffnessMatrix%elementMatrix%matrix(mhs,nhs)- & - & B_PARAM*SUM*JGW - ENDIF - !Mass matrix - IF(evaluateDamping) THEN - PHIMS=QUADRATURE_SCHEME1%GAUSS_BASIS_FNS(ms,NO_PART_DERIV,ng) - PHINS=QUADRATURE_SCHEME2%GAUSS_BASIS_FNS(ns,NO_PART_DERIV,ng) - dampingMatrix%elementMatrix%matrix(mhs,nhs)=dampingMatrix%elementMatrix%matrix(mhs,nhs)+ & - & A_PARAM*PHIMS*PHINS*JGW - ENDIF - ENDDO !ns - ENDDO !nh - ENDIF !Stiffness or Damping - !Calculate RHS - IF(evaluateRHS) THEN - rhsVector%elementVector%vector(mhs)=0.0_DP - ENDIF - ENDIF !Evaluate linear dynamic - !Calculate nonlinear vector - IF(evaluateResidual) THEN - PHIMS=QUADRATURE_SCHEME1%GAUSS_BASIS_FNS(ms,NO_PART_DERIV,ng) - SUM=0.0_DP - DO nj=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - U_VALUE=equations%interpolation%dependentInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(nj,NO_PART_DERIV) - SUM1=0.0_DP - !Calculate SUM - DO ni=1,DEPENDENT_BASIS1%NUMBER_OF_XI - SUM1=SUM1+equations%interpolation%dependentInterpPoint(FIELD_VAR_TYPE)%ptr%VALUES(nj, & - & PARTIAL_DERIVATIVE_FIRST_DERIVATIVE_MAP(ni))*equations%interpolation% & - & geometricInterpPointMetrics(FIELD_U_VARIABLE_TYPE)%ptr%DXI_DX(ni,nj) - ENDDO !ni - SUM=SUM+U_VALUE*SUM1 - ENDDO !nj - nonlinearMatrices%elementResidual%vector(mhs)=nonlinearMatrices% & - & elementResidual%vector(mhs)+C_PARAM*SUM*PHIMS*JGW - ENDIF - ENDDO !ms - ENDDO !mh - ENDDO !ng - - !Scale factor adjustment - IF(dependentField%SCALINGS%SCALING_TYPE/=FIELD_NO_SCALING) THEN - CALL Field_InterpolationParametersScaleFactorsElementGet(ELEMENT_NUMBER,equations%interpolation% & - & dependentInterpParameters(FIELD_VAR_TYPE)%ptr,err,error,*999) - mhs=0 - DO mh=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - !Loop over element rows - DO ms=1,DEPENDENT_BASIS%NUMBER_OF_ELEMENT_PARAMETERS - mhs=mhs+1 - nhs=0 - IF(evaluateStiffness.OR.evaluateDamping) THEN - !Loop over element columns - DO nh=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - DO ns=1,DEPENDENT_BASIS%NUMBER_OF_ELEMENT_PARAMETERS - nhs=nhs+1 - IF(evaluateStiffness) & - stiffnessMatrix%elementMatrix%matrix(mhs,nhs)=stiffnessMatrix%elementMatrix%matrix(mhs,nhs)* & - & equations%interpolation%dependentInterpParameters(FIELD_VAR_TYPE)%ptr%SCALE_FACTORS(ms,mh)* & - & equations%interpolation%dependentInterpParameters(FIELD_VAR_TYPE)%ptr%SCALE_FACTORS(ns,nh) - IF(evaluateDamping) & - dampingMatrix%elementMatrix%matrix(mhs,nhs)=dampingMatrix%elementMatrix%matrix(mhs,nhs)* & - & equations%interpolation%dependentInterpParameters(FIELD_VAR_TYPE)%ptr%SCALE_FACTORS(ms,mh)* & - & equations%interpolation%dependentInterpParameters(FIELD_VAR_TYPE)%ptr%SCALE_FACTORS(ns,nh) - ENDDO !ns - ENDDO !nh - ENDIF - IF(evaluateRHS) & - & rhsVector%elementVector%vector(mhs)=rhsVector%elementVector%vector(mhs)* & - & equations%interpolation%dependentInterpParameters(FIELD_VAR_TYPE)%ptr%SCALE_FACTORS(ms,mh) - IF(evaluateResidual) & - & nonlinearMatrices%elementResidual%vector(mhs)=nonlinearMatrices%elementResidual%vector(mhs)* & - & equations%interpolation%dependentInterpParameters(FIELD_VAR_TYPE)%ptr%SCALE_FACTORS(ms,mh) - ENDDO !ms - ENDDO !mh - ENDIF - - ENDIF !Evaluate any - - ELSE - CALL FlagError("Equations set equations is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - ENDIF - - EXITS("Burgers_FiniteElementResidualEvaluate") - RETURN -999 ERRORS("Burgers_FiniteElementResidualEvaluate",err,error) - EXITS("Burgers_FiniteElementResidualEvaluate") - RETURN 1 - - END SUBROUTINE Burgers_FiniteElementResidualEvaluate - - ! - !================================================================================================================================ - ! - -END MODULE BURGERS_EQUATION_ROUTINES diff --git a/src/Darcy_equations_routines.f90.fsicpb b/src/Darcy_equations_routines.f90.fsicpb deleted file mode 100644 index 256ce763..00000000 --- a/src/Darcy_equations_routines.f90.fsicpb +++ /dev/null @@ -1,8009 +0,0 @@ -MODULE DARCY_EQUATIONS_ROUTINES - - USE BaseRoutines - USE BASIS_ROUTINES - USE BOUNDARY_CONDITIONS_ROUTINES - USE Constants - USE CONTROL_LOOP_ROUTINES - USE ControlLoopAccessRoutines - USE ComputationEnvironment - USE COORDINATE_ROUTINES - USE DISTRIBUTED_MATRIX_VECTOR - USE DOMAIN_MAPPINGS - USE EquationsRoutines - USE EquationsAccessRoutines - USE EquationsMappingRoutines - USE EquationsMatricesRoutines - USE EQUATIONS_SET_CONSTANTS - USE EquationsSetAccessRoutines - USE FIELD_ROUTINES - USE FIELD_IO_ROUTINES - USE FieldAccessRoutines - USE FINITE_ELASTICITY_ROUTINES - USE FLUID_MECHANICS_IO_ROUTINES - USE INPUT_OUTPUT - USE ISO_VARYING_STRING - USE Kinds - USE Maths - USE MATRIX_VECTOR - USE MESH_ROUTINES - USE NODE_ROUTINES - USE PROBLEM_CONSTANTS - USE Strings - USE SOLVER_ROUTINES - USE SolverAccessRoutines - USE Timer - USE Types - -#include "macros.h" - - IMPLICIT NONE - - PUBLIC DARCY_EQUATION_EQUATIONS_SET_SETUP - PUBLIC Darcy_EquationsSetSpecificationSet - PUBLIC Darcy_EquationsSetSolutionMethodSet - PUBLIC Darcy_BoundaryConditionsAnalyticCalculate - - PUBLIC DARCY_EQUATION_PROBLEM_SETUP - PUBLIC Darcy_ProblemSpecificationSet - - PUBLIC DARCY_EQUATION_FINITE_ELEMENT_CALCULATE - - PUBLIC DARCY_EQUATION_PRE_SOLVE - PUBLIC DARCY_EQUATION_POST_SOLVE - PUBLIC DARCY_EQUATION_POST_SOLVE_OUTPUT_DATA - - PUBLIC DARCY_CONTROL_TIME_LOOP_PRE_LOOP - - PUBLIC Darcy_PreSolveStorePreviousIterate - - PUBLIC DARCY_EQUATION_MONITOR_CONVERGENCE - - INTEGER(INTG) :: SOLVER_NUMBER_SOLID,SOLVER_NUMBER_MAT_PROPERTIES,SOLVER_NUMBER_DARCY - INTEGER(INTG) :: SOLVER_INDEX_SOLID,SOLVER_INDEX_MAT_PROPERTIES,SOLVER_INDEX_DARCY - - REAL(DP) :: RESIDUAL_NORM_0 - - LOGICAL :: idebug1, idebug2, idebug3 - -CONTAINS - - ! - !================================================================================================================================ - ! - - !>Sets/changes the solution method for a Darcy equation type of a fluid mechanics equations set class. - SUBROUTINE Darcy_EquationsSetSolutionMethodSet(EQUATIONS_SET,SOLUTION_METHOD,err,error,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: equations_SET !Sets up the Darcy equation. - SUBROUTINE DARCY_EQUATION_EQUATIONS_SET_SETUP(EQUATIONS_SET,EQUATIONS_SET_SETUP,err,error,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: equations_SET !EQUATIONS_SET%EQUATIONS_SET_FIELD - IF(EQUATIONS_EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN - !Create the auto created equations set field - CALL FIELD_CREATE_START(EQUATIONS_SET_SETUP%FIELD_USER_NUMBER,EQUATIONS_SET%REGION, & - & EQUATIONS_EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,err,error,*999) - EQUATIONS_SET_FIELD_FIELD=>EQUATIONS_EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD - CALL FIELD_LABEL_SET(EQUATIONS_SET_FIELD_FIELD,"Equations Set Field",err,error,*999) - CALL FIELD_TYPE_SET_AND_LOCK(EQUATIONS_SET_FIELD_FIELD,FIELD_GENERAL_TYPE,& - & err,error,*999) - CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(EQUATIONS_SET_FIELD_FIELD,& - & FIELD_INDEPENDENT_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_VARIABLES_SET(EQUATIONS_SET_FIELD_FIELD, & - & EQUATIONS_SET_FIELD_NUMBER_OF_VARIABLES,err,error,*999) - CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(EQUATIONS_SET_FIELD_FIELD,& - & [FIELD_U_VARIABLE_TYPE],err,error,*999) - CALL FIELD_DIMENSION_SET_AND_LOCK(EQUATIONS_SET_FIELD_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_SET_AND_LOCK(EQUATIONS_SET_FIELD_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_INTG_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_SET_FIELD_FIELD,& - & FIELD_U_VARIABLE_TYPE,EQUATIONS_SET_FIELD_NUMBER_OF_COMPONENTS,err,error,*999) - ELSE - !Check the user specified field - CALL FIELD_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_GENERAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_VARIABLES_CHECK(EQUATIONS_SET_SETUP%FIELD,EQUATIONS_SET_FIELD_NUMBER_OF_VARIABLES, & - & err,error,*999) - CALL FIELD_VARIABLE_TYPES_CHECK(EQUATIONS_SET_SETUP%FIELD,[FIELD_U_VARIABLE_TYPE],err,error,*999) - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_INTG_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE, & - & EQUATIONS_SET_FIELD_NUMBER_OF_COMPONENTS,err,error,*999) - ENDIF - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - IF(EQUATIONS_SET%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN - CALL FIELD_CREATE_FINISH(EQUATIONS_SET%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,err,error,*999) - CALL FIELD_COMPONENT_VALUES_INITIALISE(EQUATIONS_SET%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,& - & FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, 1, 1_INTG, ERR, ERROR, *999) - CALL FIELD_COMPONENT_VALUES_INITIALISE(EQUATIONS_SET%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,& - & FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, 2, 1_INTG, ERR, ERROR, *999) - ENDIF -!!TODO: Check valid setup - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard or quasistatic Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - END SELECT - - !----------------------------------------------------------------- - ! g e o m e t r y f i e l d - !----------------------------------------------------------------- - CASE(EQUATIONS_SET_SETUP_GEOMETRY_TYPE) - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE, EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_DARCY_SUBTYPE) - !Do nothing - CASE(EQUATIONS_SET_ALE_DARCY_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE,EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE,EQUATIONS_SET_MULTI_COMPARTMENT_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - CASE(EQUATIONS_SET_SETUP_START_ACTION) - - FIELD_VARIABLE=>EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD%VARIABLE_TYPE_MAP(FIELD_U_VARIABLE_TYPE)%ptr - - CALL Field_ParameterSetEnsureCreated(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD, FIELD_U_VARIABLE_TYPE, & - & FIELD_INITIAL_VALUES_SET_TYPE, ERR, ERROR, *999) - - CALL Field_ParameterSetEnsureCreated(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD, FIELD_U_VARIABLE_TYPE, & - & FIELD_PREVIOUS_VALUES_SET_TYPE, ERR, ERROR, *999) - - CALL Field_ParameterSetEnsureCreated(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD, FIELD_U_VARIABLE_TYPE, & - & FIELD_MESH_DISPLACEMENT_SET_TYPE, ERR, ERROR, *999) - - CALL Field_ParameterSetEnsureCreated(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD, FIELD_U_VARIABLE_TYPE, & - & FIELD_MESH_VELOCITY_SET_TYPE, ERR, ERROR, *999) - - CALL Field_ParameterSetEnsureCreated(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD, FIELD_U_VARIABLE_TYPE, & - & FIELD_NEGATIVE_MESH_VELOCITY_SET_TYPE, ERR, ERROR, *999) - - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_MULTI_COMPARTMENT_DARCY_SUBTYPE .OR. & - EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) THEN - !Create the equations set field for multi-compartment Darcy - EQUATIONS_SET_FIELD_NUMBER_OF_COMPONENTS = 2 - - EQUATIONS_EQUATIONS_SET_FIELD=>EQUATIONS_SET%EQUATIONS_SET_FIELD - EQUATIONS_SET_FIELD_FIELD=>EQUATIONS_EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD - - IF(EQUATIONS_EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN - CALL FIELD_MESH_DECOMPOSITION_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_DECOMPOSITION,err,error,*999) - CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(EQUATIONS_SET_FIELD_FIELD,& - & GEOMETRIC_DECOMPOSITION,err,error,*999) - CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(EQUATIONS_SET_FIELD_FIELD,& - & EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,err,error,*999) - CALL FIELD_COMPONENT_MESH_COMPONENT_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & 1,GEOMETRIC_COMPONENT_NUMBER,err,error,*999) - DO component_idx = 1, EQUATIONS_SET_FIELD_NUMBER_OF_COMPONENTS - CALL FIELD_COMPONENT_MESH_COMPONENT_SET_AND_LOCK(EQUATIONS_SET%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, & - & FIELD_U_VARIABLE_TYPE,component_idx,GEOMETRIC_COMPONENT_NUMBER,err,error,*999) - CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(EQUATIONS_SET%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, & - & FIELD_U_VARIABLE_TYPE,component_idx,FIELD_CONSTANT_INTERPOLATION,err,error,*999) - END DO - - !Default the field scaling to that of the geometric field - CALL FIELD_SCALING_TYPE_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_SCALING_TYPE,err,error,*999) - CALL FIELD_SCALING_TYPE_SET(EQUATIONS_SET%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,GEOMETRIC_SCALING_TYPE, & - & err,error,*999) - ELSE - !Do nothing - ENDIF - ENDIF - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - ! do nothing - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a linear diffusion equation." - CALL FlagError(localError,err,error,*999) - END SELECT - END SELECT - - !----------------------------------------------------------------- - ! d e p e n d e n t f i e l d - !----------------------------------------------------------------- - CASE(EQUATIONS_SET_SETUP_DEPENDENT_TYPE) - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE, EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE, EQUATIONS_SET_ALE_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_DARCY_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE,EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - CASE(EQUATIONS_SET_SETUP_START_ACTION) - IF(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN - !Create the auto created dependent field - CALL FIELD_CREATE_START(EQUATIONS_SET_SETUP%FIELD_USER_NUMBER,EQUATIONS_SET%REGION, & - & EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,err,error,*999) - CALL FIELD_TYPE_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_GEOMETRIC_GENERAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_DEPENDENT_TYPE,err,error,*999) - - CALL FIELD_MESH_DECOMPOSITION_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_DECOMPOSITION,err,error,*999) - CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,GEOMETRIC_DECOMPOSITION, & - & err,error,*999) - CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD, & - & EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,err,error,*999) - - DEPENDENT_FIELD_NUMBER_OF_VARIABLES = 2 ! U and the normal component of its flux - CALL FIELD_NUMBER_OF_VARIABLES_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD, & - & DEPENDENT_FIELD_NUMBER_OF_VARIABLES,err,error,*999) - CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,[FIELD_U_VARIABLE_TYPE, & - & FIELD_DELUDELN_VARIABLE_TYPE],err,error,*999) - CALL FIELD_VARIABLE_LABEL_SET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE,"U",err,error,*999) - CALL FIELD_VARIABLE_LABEL_SET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE,"del U/del n", & - & err,error,*999) - CALL FIELD_DIMENSION_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - CALL FIELD_DIMENSION_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE, & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_DP_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE, & - & FIELD_DP_TYPE,err,error,*999) - - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD, FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS, ERR, ERROR, *999) - DEPENDENT_FIELD_NUMBER_OF_COMPONENTS = NUMBER_OF_DIMENSIONS + 1 - CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD, FIELD_U_VARIABLE_TYPE, & - & DEPENDENT_FIELD_NUMBER_OF_COMPONENTS, ERR, ERROR, *999) - CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD, & - & FIELD_DELUDELN_VARIABLE_TYPE, DEPENDENT_FIELD_NUMBER_OF_COMPONENTS, ERR, ERROR, *999) - !Default to the geometric interpolation setup - CALL FIELD_COMPONENT_MESH_COMPONENT_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE,1, & - & GEOMETRIC_MESH_COMPONENT,err,error,*999) - DO i=1,DEPENDENT_FIELD_NUMBER_OF_COMPONENTS - IF( i < DEPENDENT_FIELD_NUMBER_OF_COMPONENTS ) THEN - !Set velocity mesh component (default to the geometric one) - MESH_COMPONENT = GEOMETRIC_MESH_COMPONENT - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & i, MESH_COMPONENT,err,error,*999) - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE, & - & i, MESH_COMPONENT,err,error,*999) - ELSE - !Set pressure mesh component (default to the geometric one) - MESH_COMPONENT = GEOMETRIC_MESH_COMPONENT - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & i, MESH_COMPONENT,err,error,*999) - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE, & - & i, MESH_COMPONENT,err,error,*999) - ENDIF - ENDDO - - SELECT CASE(EQUATIONS_SET%SOLUTION_METHOD) - CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD) - DO i = 1, DEPENDENT_FIELD_NUMBER_OF_COMPONENTS - CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD, & - & FIELD_U_VARIABLE_TYPE,i,FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD, & - & FIELD_DELUDELN_VARIABLE_TYPE,i,FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - ENDDO - !Default the scaling to the geometric field scaling - CALL FIELD_SCALING_TYPE_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_SCALING_TYPE,err,error,*999) - CALL FIELD_SCALING_TYPE_SET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,GEOMETRIC_SCALING_TYPE,err,error,*999) - CASE(EQUATIONS_SET_BEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FD_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The solution method of "//TRIM(NumberToVString(EQUATIONS_SET%SOLUTION_METHOD,"*",err,error))// & - & " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - !----------------------------------- - ! DEPENDENT_FIELD: not AUTO_CREATED - !----------------------------------- - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE, & - & EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE) - !----------------------------------------------------------------------- - ! Check the shared dependent field set up in finite elasticity routines - !----------------------------------------------------------------------- - CALL FIELD_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_GEOMETRIC_GENERAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DEPENDENT_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_VARIABLES_CHECK(EQUATIONS_SET_SETUP%FIELD,4,err,error,*999) - CALL FIELD_VARIABLE_TYPES_CHECK(EQUATIONS_SET_SETUP%FIELD,[FIELD_U_VARIABLE_TYPE,FIELD_DELUDELN_VARIABLE_TYPE, & - & FIELD_V_VARIABLE_TYPE,FIELD_DELVDELN_VARIABLE_TYPE],err,error,*999) - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_V_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELVDELN_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_V_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELVDELN_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD, FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS, ERR, ERROR, *999) - - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE) !compressible elasticity - DEPENDENT_FIELD_ELASTICITY_NUMBER_OF_COMPONENTS = NUMBER_OF_DIMENSIONS - DEPENDENT_FIELD_DARCY_NUMBER_OF_COMPONENTS = NUMBER_OF_DIMENSIONS + 2 !(u,v,w,p,m) - CASE(EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE) - DEPENDENT_FIELD_ELASTICITY_NUMBER_OF_COMPONENTS = NUMBER_OF_DIMENSIONS + 1 - DEPENDENT_FIELD_DARCY_NUMBER_OF_COMPONENTS = NUMBER_OF_DIMENSIONS + 1 - CASE(EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE) - DEPENDENT_FIELD_ELASTICITY_NUMBER_OF_COMPONENTS = NUMBER_OF_DIMENSIONS + 1 !(u1,u2,u3,p) - DEPENDENT_FIELD_DARCY_NUMBER_OF_COMPONENTS = NUMBER_OF_DIMENSIONS + 1 !(u,v,w,m) - END SELECT - - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE, & - & DEPENDENT_FIELD_ELASTICITY_NUMBER_OF_COMPONENTS,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE, & - & DEPENDENT_FIELD_ELASTICITY_NUMBER_OF_COMPONENTS,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_V_VARIABLE_TYPE, & - & DEPENDENT_FIELD_DARCY_NUMBER_OF_COMPONENTS,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELVDELN_VARIABLE_TYPE, & - & DEPENDENT_FIELD_DARCY_NUMBER_OF_COMPONENTS,err,error,*999) - - SELECT CASE(EQUATIONS_SET%SOLUTION_METHOD) - CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD) - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,1, & - & FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - !Mind that elastic hydrostatic pressure might be interpolated element-wise - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,1, & - & FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_V_VARIABLE_TYPE,1, & - & FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELVDELN_VARIABLE_TYPE,1, & - & FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CASE(EQUATIONS_SET_BEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FD_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The solution method of "//TRIM(NumberToVString(EQUATIONS_SET%SOLUTION_METHOD,"*",err,error))// & - & " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - !----------------------------------------------------------------------- - ! Check the shared dependent field set up in finite elasticity routines - ! Must have 2+2*Ncompartments number of variable types - !----------------------------------------------------------------------- - CALL FIELD_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_GEOMETRIC_GENERAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DEPENDENT_TYPE,err,error,*999) - !Get the number of Darcy compartments from the equations set field - EQUATIONS_SET_FIELD_FIELD=>EQUATIONS_SET%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD - CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET_FIELD_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,EQUATIONS_SET_FIELD_DATA,err,error,*999) - Ncompartments=EQUATIONS_SET_FIELD_DATA(2) - CALL FIELD_NUMBER_OF_VARIABLES_CHECK(EQUATIONS_SET_SETUP%FIELD,(2+2*Ncompartments),err,error,*999) - ALLOCATE(VARIABLE_TYPES(2*Ncompartments+2)) - DO num_var=1,Ncompartments+1 - VARIABLE_TYPES(2*num_var-1)=FIELD_U_VARIABLE_TYPE+(FIELD_NUMBER_OF_VARIABLE_SUBTYPES*(num_var-1)) - VARIABLE_TYPES(2*num_var)=FIELD_DELUDELN_VARIABLE_TYPE+(FIELD_NUMBER_OF_VARIABLE_SUBTYPES*(num_var-1)) - ENDDO - CALL FIELD_VARIABLE_TYPES_CHECK(EQUATIONS_SET_SETUP%FIELD,VARIABLE_TYPES,err,error,*999) - - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS,err,error,*999) - NUMBER_OF_COMPONENTS=NUMBER_OF_DIMENSIONS+1 - NUMBER_OF_DARCY_COMPONENTS=NUMBER_OF_DIMENSIONS+1 - - DO num_var=1,2*Ncompartments+2 - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,VARIABLE_TYPES(num_var),FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,VARIABLE_TYPES(num_var),FIELD_DP_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,VARIABLE_TYPES(num_var),NUMBER_OF_COMPONENTS, & - & err,error,*999) - ENDDO - - SELECT CASE(EQUATIONS_SET%SOLUTION_METHOD) - CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD) - !Elasticity: - DO component_idx=1,NUMBER_OF_DIMENSIONS - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,component_idx, & - & FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,component_idx,& - & FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - ENDDO !component_idx - !If solid hydrostatic pressure is driving Darcy flow, check that pressure uses node based interpolation - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,NUMBER_OF_COMPONENTS,& - & FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE, & - & NUMBER_OF_COMPONENTS,FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - DO num_var=3,2*Ncompartments+2 - !Darcy: - DO component_idx=1,NUMBER_OF_DARCY_COMPONENTS - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,VARIABLE_TYPES(num_var),component_idx, & - & FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - ENDDO !component_idx - ENDDO - CASE(EQUATIONS_SET_BEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FD_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The solution method of "//TRIM(NumberToVString(EQUATIONS_SET%SOLUTION_METHOD,"*",err,error))// & - & " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(EQUATIONS_SET_MULTI_COMPARTMENT_DARCY_SUBTYPE) - !Check the field created by Darcy routines for the multi-compartment model - CALL FIELD_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_GENERAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DEPENDENT_TYPE,err,error,*999) - EQUATIONS_SET_FIELD_FIELD=>EQUATIONS_SET%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD - CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET_FIELD_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,EQUATIONS_SET_FIELD_DATA,err,error,*999) - Ncompartments=EQUATIONS_SET_FIELD_DATA(2) - CALL FIELD_NUMBER_OF_VARIABLES_CHECK(EQUATIONS_SET_SETUP%FIELD,2*Ncompartments,err,error,*999) - !Create & populate array storing all of the relevant variable types against which to check the field variables - ALLOCATE(VARIABLE_TYPES(2*Ncompartments)) - DO num_var=1,Ncompartments - VARIABLE_TYPES(2*num_var-1)=FIELD_U_VARIABLE_TYPE+(FIELD_NUMBER_OF_VARIABLE_SUBTYPES*(num_var-1)) - VARIABLE_TYPES(2*num_var)=FIELD_DELUDELN_VARIABLE_TYPE+(FIELD_NUMBER_OF_VARIABLE_SUBTYPES*(num_var-1)) - ENDDO - CALL FIELD_VARIABLE_TYPES_CHECK(EQUATIONS_SET_SETUP%FIELD,VARIABLE_TYPES,err,error,*999) - - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS,err,error,*999) - DO num_var=1,2*Ncompartments - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,VARIABLE_TYPES(num_var), & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,VARIABLE_TYPES(num_var),FIELD_DP_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,VARIABLE_TYPES(num_var), & - & NUMBER_OF_DIMENSIONS+1,err,error,*999) - ENDDO - - SELECT CASE(EQUATIONS_SET%SOLUTION_METHOD) - CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD) - component_idx=1 - DO num_var=1,2*Ncompartments - DO component_idx=1,NUMBER_OF_DIMENSIONS+1 - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,VARIABLE_TYPES(num_var),component_idx, & - & FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - !NOTE-pressure might use element based interpolation - need to account for this - ENDDO - ENDDO - CASE(EQUATIONS_SET_BEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FD_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The solution method of "//TRIM(NumberToVString(EQUATIONS_SET%SOLUTION_METHOD,"*",err,error))// & - & " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - - CASE DEFAULT - !-------------------------------- - ! Check the user specified field - !-------------------------------- - CALL FIELD_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_GENERAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DEPENDENT_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_VARIABLES_CHECK(EQUATIONS_SET_SETUP%FIELD,2,err,error,*999) - CALL FIELD_VARIABLE_TYPES_CHECK(EQUATIONS_SET_SETUP%FIELD,[FIELD_U_VARIABLE_TYPE,FIELD_DELUDELN_VARIABLE_TYPE],& - & err,error,*999) - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD, FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS, ERR, ERROR, *999) - DEPENDENT_FIELD_NUMBER_OF_COMPONENTS = NUMBER_OF_DIMENSIONS + 1 - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE, & - & DEPENDENT_FIELD_NUMBER_OF_COMPONENTS,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE, & - & DEPENDENT_FIELD_NUMBER_OF_COMPONENTS,err,error,*999) - - SELECT CASE(EQUATIONS_SET%SOLUTION_METHOD) - CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD) - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,1, & - & FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,1, & - & FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CASE(EQUATIONS_SET_BEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FD_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The solution method of "//TRIM(NumberToVString(EQUATIONS_SET%SOLUTION_METHOD,"*",err,error))// & - & " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - END SELECT ! on (EQUATIONS_SET%SPECIFICATION(3)) - ENDIF ! on (EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - IF(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN - CALL FIELD_CREATE_FINISH(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,err,error,*999) - CALL FIELD_PARAMETER_SET_CREATE(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_INITIAL_VALUES_SET_TYPE,err,error,*999) - ENDIF - IF(EQUATIONS_SET%SPECIFICATION(3)/=EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE)THEN - !Actually, only needed for PGM (for elasticity_Darcy defined in elasticity V var): - CALL FIELD_PARAMETER_SET_CREATE(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_RELATIVE_VELOCITY_SET_TYPE,err,error,*999) - ENDIF - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard, quasistatic or ALE Darcy equation" - CALL FlagError(localError,err,error,*999) - END SELECT - END SELECT - - !----------------------------------------------------------------- - ! I N d e p e n d e n t f i e l d - !----------------------------------------------------------------- - CASE(EQUATIONS_SET_SETUP_INDEPENDENT_TYPE) - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE, EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE, EQUATIONS_SET_ALE_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_DARCY_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE,EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - !\todo: revise: do they all need an independent field ? - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - CASE(EQUATIONS_SET_SETUP_START_ACTION) - IF(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN - !Create the auto created INdependent field - CALL FIELD_CREATE_START(EQUATIONS_SET_SETUP%FIELD_USER_NUMBER,EQUATIONS_SET%REGION, & - & EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999) - CALL FIELD_TYPE_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_GENERAL_TYPE,err,error,*999) - - CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_INDEPENDENT_TYPE,& - & err,error,*999) - - CALL FIELD_MESH_DECOMPOSITION_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_DECOMPOSITION,err,error,*999) - CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,GEOMETRIC_DECOMPOSITION, & - & err,error,*999) - CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD, & - & EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,err,error,*999) - - INDEPENDENT_FIELD_NUMBER_OF_VARIABLES = 2 ! U and the normal component of its flux - CALL FIELD_NUMBER_OF_VARIABLES_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD, & - & INDEPENDENT_FIELD_NUMBER_OF_VARIABLES,err,error,*999) - CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,[FIELD_U_VARIABLE_TYPE, & - & FIELD_DELUDELN_VARIABLE_TYPE],err,error,*999) - CALL FIELD_VARIABLE_LABEL_SET(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE,"Independent U", & - & err,error,*999) - CALL FIELD_VARIABLE_LABEL_SET(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE, & - & "Independent del U/del n",err,error,*999) - CALL FIELD_DIMENSION_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - CALL FIELD_DIMENSION_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE, & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_DP_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE, & - & FIELD_DP_TYPE,err,error,*999) - - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD, FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS, ERR, ERROR, *999) - INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS = NUMBER_OF_DIMENSIONS !+ 1 - CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD, FIELD_U_VARIABLE_TYPE, & - & INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS, ERR, ERROR, *999) - CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD, & - & FIELD_DELUDELN_VARIABLE_TYPE, INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS, ERR, ERROR, *999) - !Default to the geometric interpolation setup - CALL FIELD_COMPONENT_MESH_COMPONENT_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE,1, & - & GEOMETRIC_MESH_COMPONENT,err,error,*999) - DO i=1,INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS - IF( i < INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS ) THEN - !Set velocity mesh component (default to the geometric one) - MESH_COMPONENT = GEOMETRIC_MESH_COMPONENT - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & i, MESH_COMPONENT,err,error,*999) - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,& - & FIELD_DELUDELN_VARIABLE_TYPE, i, MESH_COMPONENT,err,error,*999) - ELSE - !Set pressure mesh component (default to the geometric one) - MESH_COMPONENT = GEOMETRIC_MESH_COMPONENT - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & i, MESH_COMPONENT,err,error,*999) - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,& - & FIELD_DELUDELN_VARIABLE_TYPE, i, MESH_COMPONENT,err,error,*999) - ENDIF - ENDDO - - SELECT CASE(EQUATIONS_SET%SOLUTION_METHOD) - CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD) - DO i = 1, INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS - CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD, & - & FIELD_U_VARIABLE_TYPE,i,FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD, & - & FIELD_DELUDELN_VARIABLE_TYPE,i,FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - ENDDO - !Default the scaling to the geometric field scaling - CALL FIELD_SCALING_TYPE_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_SCALING_TYPE,err,error,*999) - CALL FIELD_SCALING_TYPE_SET(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,GEOMETRIC_SCALING_TYPE,err,error,*999) - CASE(EQUATIONS_SET_BEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FD_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The solution method of "//TRIM(NumberToVString(EQUATIONS_SET%SOLUTION_METHOD,"*",err,error))// & - & " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - !Check the user specified field - CALL FIELD_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_GENERAL_TYPE,err,error,*999) - - CALL FIELD_DEPENDENT_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999) - - CALL FIELD_NUMBER_OF_VARIABLES_CHECK(EQUATIONS_SET_SETUP%FIELD,2,err,error,*999) - CALL FIELD_VARIABLE_TYPES_CHECK(EQUATIONS_SET_SETUP%FIELD,[FIELD_U_VARIABLE_TYPE,FIELD_DELUDELN_VARIABLE_TYPE], & - & err,error,*999) - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD, FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS, ERR, ERROR, *999) - INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS = NUMBER_OF_DIMENSIONS !+ 1 - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE, & - & INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE, & - & INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS,err,error,*999) - - SELECT CASE(EQUATIONS_SET%SOLUTION_METHOD) - CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD) - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,1, & - & FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,1, & - & FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CASE(EQUATIONS_SET_BEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FD_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The solution method of "//TRIM(NumberToVString(EQUATIONS_SET%SOLUTION_METHOD,"*",err,error))// & - & " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - ENDIF - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - IF(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN - CALL FIELD_CREATE_FINISH(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999) - ENDIF - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard, quasistatic or ALE Darcy equation" - CALL FlagError(localError,err,error,*999) - END SELECT - END SELECT - - !----------------------------------------------------------------- - ! m a t e r i a l f i e l d - !----------------------------------------------------------------- - CASE(EQUATIONS_SET_SETUP_MATERIALS_TYPE) - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE, EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE, EQUATIONS_SET_ALE_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_DARCY_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE,EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE, EQUATIONS_SET_MULTI_COMPARTMENT_DARCY_SUBTYPE) - MATERIAL_FIELD_NUMBER_OF_VARIABLES = 1 - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE,EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE,EQUATIONS_SET_ALE_DARCY_SUBTYPE) - !Porosity + scalar permeability/viscosity - MATERIAL_FIELD_NUMBER_OF_COMPONENTS = 2 - CASE DEFAULT - !Porosity + symmetric permeability/viscosity tensor - MATERIAL_FIELD_NUMBER_OF_COMPONENTS = 7 - END SELECT - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - CASE(EQUATIONS_SET_SETUP_START_ACTION) - EQUATIONS_MATERIALS=>EQUATIONS_SET%MATERIALS - IF(ASSOCIATED(EQUATIONS_MATERIALS)) THEN - IF(EQUATIONS_MATERIALS%MATERIALS_FIELD_AUTO_CREATED) THEN - !Create the auto created materials field - CALL FIELD_CREATE_START(EQUATIONS_SET_SETUP%FIELD_USER_NUMBER,EQUATIONS_SET%REGION,EQUATIONS_MATERIALS% & - & MATERIALS_FIELD,err,error,*999) - CALL FIELD_TYPE_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_MATERIAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999) - CALL FIELD_MESH_DECOMPOSITION_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_DECOMPOSITION,err,error,*999) - CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,GEOMETRIC_DECOMPOSITION, & - & err,error,*999) - CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,EQUATIONS_SET%GEOMETRY% & - & GEOMETRIC_FIELD,err,error,*999) - CALL FIELD_NUMBER_OF_VARIABLES_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD, & - & MATERIAL_FIELD_NUMBER_OF_VARIABLES,err,error,*999) - CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,[FIELD_U_VARIABLE_TYPE], & - & err,error,*999) - CALL FIELD_VARIABLE_LABEL_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE,"Material", & - & err,error,*999) - CALL FIELD_DIMENSION_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_DP_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & MATERIAL_FIELD_NUMBER_OF_COMPONENTS,err,error,*999) - CALL FIELD_COMPONENT_MESH_COMPONENT_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & 1,GEOMETRIC_COMPONENT_NUMBER,err,error,*999) - - !Auto-created / default is node_based_interpolation: that's an expensive default ... - !Maybe default should be constant; node_based should be requested by the user \todo - DO i = 1, MATERIAL_FIELD_NUMBER_OF_COMPONENTS - CALL FIELD_COMPONENT_INTERPOLATION_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & i,FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & i,GEOMETRIC_COMPONENT_NUMBER,err,error,*999) - END DO - - !Default the field scaling to that of the geometric field - CALL FIELD_SCALING_TYPE_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_SCALING_TYPE,err,error,*999) - CALL FIELD_SCALING_TYPE_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,GEOMETRIC_SCALING_TYPE,err,error,*999) - ELSE - !Check the user specified field - CALL FIELD_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_MATERIAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_VARIABLES_CHECK(EQUATIONS_SET_SETUP%FIELD,MATERIAL_FIELD_NUMBER_OF_VARIABLES,err,error,*999) - CALL FIELD_VARIABLE_TYPES_CHECK(EQUATIONS_SET_SETUP%FIELD,[FIELD_U_VARIABLE_TYPE],err,error,*999) - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE, & - & MATERIAL_FIELD_NUMBER_OF_COMPONENTS,err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set materials is not associated.",err,error,*999) - ENDIF - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - EQUATIONS_MATERIALS=>EQUATIONS_SET%MATERIALS - IF( ASSOCIATED(EQUATIONS_MATERIALS) ) THEN - IF( EQUATIONS_MATERIALS%MATERIALS_FIELD_AUTO_CREATED ) THEN - CALL FIELD_CREATE_FINISH(EQUATIONS_MATERIALS%MATERIALS_FIELD,err,error,*999) - !Set the default values for the materials field - DO i=1,MATERIAL_FIELD_NUMBER_OF_COMPONENTS - CALL FIELD_COMPONENT_VALUES_INITIALISE(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE, i, 1.0_DP, ERR, ERROR, *999) - ENDDO - ENDIF - ELSE - CALL FlagError("Equations set materials is not associated.",err,error,*999) - ENDIF - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard, quasistatic or ALE Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - !Materials field needs two extra variable types - !The V variable type stores the Darcy coupling coefficients that govern flux between compartments - !The U1 variable type stores the parameters for the constitutive laws that determine the partial pressure in each compartment - !For a first attempt at this, it will be assumed that the functional form of this law is the same for each compartment, with only the paramenters varying (default will be three components) - EQUATIONS_SET_FIELD_FIELD=>EQUATIONS_SET%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD - CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET_FIELD_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,EQUATIONS_SET_FIELD_DATA,err,error,*999) - Ncompartments=EQUATIONS_SET_FIELD_DATA(2) - MATERIAL_FIELD_NUMBER_OF_VARIABLES = 3 - MATERIAL_FIELD_NUMBER_OF_U_VAR_COMPONENTS = 2 - MATERIAL_FIELD_NUMBER_OF_V_VAR_COMPONENTS = Ncompartments - MATERIAL_FIELD_NUMBER_OF_U1_VAR_COMPONENTS = 3 - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - CASE(EQUATIONS_SET_SETUP_START_ACTION) - EQUATIONS_MATERIALS=>EQUATIONS_SET%MATERIALS - IF(ASSOCIATED(EQUATIONS_MATERIALS)) THEN - IF(EQUATIONS_MATERIALS%MATERIALS_FIELD_AUTO_CREATED) THEN - !Create the auto created materials field - CALL FIELD_CREATE_START(EQUATIONS_SET_SETUP%FIELD_USER_NUMBER,EQUATIONS_SET%REGION,EQUATIONS_MATERIALS% & - & MATERIALS_FIELD,err,error,*999) - CALL FIELD_TYPE_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_MATERIAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999) - CALL FIELD_MESH_DECOMPOSITION_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_DECOMPOSITION,err,error,*999) - CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,GEOMETRIC_DECOMPOSITION, & - & err,error,*999) - CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,EQUATIONS_SET%GEOMETRY% & - & GEOMETRIC_FIELD,err,error,*999) - CALL FIELD_NUMBER_OF_VARIABLES_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD, & - & MATERIAL_FIELD_NUMBER_OF_VARIABLES,err,error,*999) - CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,[FIELD_U_VARIABLE_TYPE, & - & FIELD_V_VARIABLE_TYPE,FIELD_U1_VARIABLE_TYPE],err,error,*999) - CALL FIELD_DIMENSION_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_DP_TYPE,err,error,*999) - CALL FIELD_DIMENSION_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_V_VARIABLE_TYPE, & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_V_VARIABLE_TYPE, & - & FIELD_DP_TYPE,err,error,*999) - CALL FIELD_DIMENSION_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U1_VARIABLE_TYPE, & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U1_VARIABLE_TYPE, & - & FIELD_DP_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & MATERIAL_FIELD_NUMBER_OF_U_VAR_COMPONENTS,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_V_VARIABLE_TYPE, & - & MATERIAL_FIELD_NUMBER_OF_V_VAR_COMPONENTS,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U1_VARIABLE_TYPE, & - & MATERIAL_FIELD_NUMBER_OF_U1_VAR_COMPONENTS,err,error,*999) - CALL FIELD_COMPONENT_MESH_COMPONENT_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & 1,GEOMETRIC_COMPONENT_NUMBER,err,error,*999) - - !Auto-created / default is node_based_interpolation: that's an expensive default ... - !Maybe default should be constant; node_based should be requested by the user \todo - DO i = 1, MATERIAL_FIELD_NUMBER_OF_U_VAR_COMPONENTS - CALL FIELD_COMPONENT_INTERPOLATION_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & i,FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & i,GEOMETRIC_COMPONENT_NUMBER,err,error,*999) - END DO - DO i = 1, MATERIAL_FIELD_NUMBER_OF_V_VAR_COMPONENTS - CALL FIELD_COMPONENT_INTERPOLATION_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_V_VARIABLE_TYPE, & - & i,FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_V_VARIABLE_TYPE, & - & i,GEOMETRIC_COMPONENT_NUMBER,err,error,*999) - END DO - DO i = 1, MATERIAL_FIELD_NUMBER_OF_U1_VAR_COMPONENTS - CALL FIELD_COMPONENT_INTERPOLATION_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U1_VARIABLE_TYPE, & - & i,FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U1_VARIABLE_TYPE, & - & i,GEOMETRIC_COMPONENT_NUMBER,err,error,*999) - END DO - - !Default the field scaling to that of the geometric field - CALL FIELD_SCALING_TYPE_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_SCALING_TYPE,err,error,*999) - CALL FIELD_SCALING_TYPE_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,GEOMETRIC_SCALING_TYPE,err,error,*999) - ELSE - !Check the user specified field - CALL FIELD_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_MATERIAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_VARIABLES_CHECK(EQUATIONS_SET_SETUP%FIELD,MATERIAL_FIELD_NUMBER_OF_VARIABLES,err,error,*999) - CALL FIELD_VARIABLE_TYPES_CHECK(EQUATIONS_SET_SETUP%FIELD,[FIELD_U_VARIABLE_TYPE, & - & FIELD_V_VARIABLE_TYPE,FIELD_U1_VARIABLE_TYPE],err,error,*999) - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_V_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U1_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_V_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U1_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE, & - & MATERIAL_FIELD_NUMBER_OF_U_VAR_COMPONENTS,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_V_VARIABLE_TYPE, & - & MATERIAL_FIELD_NUMBER_OF_V_VAR_COMPONENTS,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U1_VARIABLE_TYPE, & - & MATERIAL_FIELD_NUMBER_OF_U1_VAR_COMPONENTS,err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set materials is not associated.",err,error,*999) - ENDIF - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - EQUATIONS_MATERIALS=>EQUATIONS_SET%MATERIALS - IF( ASSOCIATED(EQUATIONS_MATERIALS) ) THEN - IF( EQUATIONS_MATERIALS%MATERIALS_FIELD_AUTO_CREATED ) THEN - CALL FIELD_CREATE_FINISH(EQUATIONS_MATERIALS%MATERIALS_FIELD,err,error,*999) - !Set the default values for the materials field - DO i=1,MATERIAL_FIELD_NUMBER_OF_U_VAR_COMPONENTS - CALL FIELD_COMPONENT_VALUES_INITIALISE(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE, i, 1.0_DP, ERR, ERROR, *999) - ENDDO - DO i=1,MATERIAL_FIELD_NUMBER_OF_V_VAR_COMPONENTS - CALL FIELD_COMPONENT_VALUES_INITIALISE(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_V_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE, i, 0.0_DP, ERR, ERROR, *999) - ENDDO - DO i=1,MATERIAL_FIELD_NUMBER_OF_U1_VAR_COMPONENTS - CALL FIELD_COMPONENT_VALUES_INITIALISE(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U1_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE, i, 0.0_DP, ERR, ERROR, *999) - ENDDO - ENDIF - ELSE - CALL FlagError("Equations set materials is not associated.",err,error,*999) - ENDIF - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard, quasistatic or ALE Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - END SELECT - - !----------------------------------------------------------------- - ! a n a l y t i c f i e l d - !----------------------------------------------------------------- - - CASE(EQUATIONS_SET_SETUP_ANALYTIC_TYPE) - - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - !Set start action - CASE(EQUATIONS_SET_SETUP_START_ACTION) - IF(EQUATIONS_SET%DEPENDENT%DEPENDENT_FINISHED) THEN - IF(ASSOCIATED(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD)) THEN - IF(ASSOCIATED(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD)) THEN - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS,err,error,*999) - SELECT CASE(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE) - CASE(EQUATIONS_SET_DARCY_EQUATION_TWO_DIM_1) - !Set analytic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_DARCY_EQUATION_TWO_DIM_1 - CASE(EQUATIONS_SET_DARCY_EQUATION_TWO_DIM_2) - !Set analytic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_DARCY_EQUATION_TWO_DIM_2 - CASE(EQUATIONS_SET_DARCY_EQUATION_TWO_DIM_3) - !Set analytic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_DARCY_EQUATION_TWO_DIM_3 - CASE(EQUATIONS_SET_DARCY_EQUATION_THREE_DIM_1) - !Set analytic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_DARCY_EQUATION_THREE_DIM_1 - CASE(EQUATIONS_SET_DARCY_EQUATION_THREE_DIM_2) - !Set analytic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_DARCY_EQUATION_THREE_DIM_2 - CASE(EQUATIONS_SET_DARCY_EQUATION_THREE_DIM_3) - !Set analytic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_DARCY_EQUATION_THREE_DIM_3 - CASE(EQUATIONS_SET_INCOMP_ELAST_DARCY_ANALYTIC_DARCY) - !Set analytic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_INCOMP_ELAST_DARCY_ANALYTIC_DARCY - CASE DEFAULT - localError="The specified analytic function type of "// & - & TRIM(NumberToVString(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",err,error))// & - & " is invalid for an analytic Darcy problem." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Equations set geometric field is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set dependent field is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set dependent field has not been finished.",err,error,*999) - ENDIF - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN - IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC%ANALYTIC_FIELD)) THEN - IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED) THEN - !--- Why finish the dependent field and not the analytic one ??? - CALL FIELD_CREATE_FINISH(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,err,error,*999) - ENDIF - ENDIF - ELSE - CALL FlagError("Equations set analytic is not associated.",err,error,*999) - ENDIF - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for an analytic Darcy problem." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - !Set start action - CASE(EQUATIONS_SET_SETUP_START_ACTION) - IF(EQUATIONS_SET%DEPENDENT%DEPENDENT_FINISHED) THEN - IF(ASSOCIATED(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD)) THEN - IF(ASSOCIATED(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD)) THEN - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS,err,error,*999) - !Initialise analytic parameter which stores value of time to zero - need to update this somewhere in a pre_solve routine - EQUATIONS_SET%ANALYTIC%ANALYTIC_USER_PARAMS(1)=0.0_DP - SELECT CASE(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE) - CASE(EQUATIONS_SET_INCOMP_ELAST_DARCY_ANALYTIC_DARCY) - !Set analytic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_INCOMP_ELAST_DARCY_ANALYTIC_DARCY - CASE DEFAULT - localError="The specified analytic function type of "// & - & TRIM(NumberToVString(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",err,error))// & - & " is invalid for an analytic Darcy problem." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Equations set geometric field is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set dependent field is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set dependent field has not been finished.",err,error,*999) - ENDIF - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN - IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC%ANALYTIC_FIELD)) THEN - IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED) THEN - !--- Why finish the dependent field and not the analytic one ??? - CALL FIELD_CREATE_FINISH(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,err,error,*999) - ENDIF - ENDIF - ELSE - CALL FlagError("Equations set analytic is not associated.",err,error,*999) - ENDIF - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for an analytic Darcy problem." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The equation set subtype of "//TRIM(NumberToVString(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - - !----------------------------------------------------------------- - ! s o u r c e t y p e - include gravity at some point - !----------------------------------------------------------------- - CASE(EQUATIONS_SET_SETUP_SOURCE_TYPE) - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE, EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE, EQUATIONS_SET_ALE_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_DARCY_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE,EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - CASE(EQUATIONS_SET_SETUP_START_ACTION) - EQUATIONS_SOURCE=>EQUATIONS_SET%SOURCE - IF(ASSOCIATED(EQUATIONS_SOURCE)) THEN - IF(EQUATIONS_SOURCE%SOURCE_FIELD_AUTO_CREATED) THEN - CALL FIELD_CREATE_START(EQUATIONS_SET_SETUP%FIELD_USER_NUMBER,EQUATIONS_SET%REGION,EQUATIONS_SOURCE% & - & SOURCE_FIELD,err,error,*999) - CALL FIELD_LABEL_SET(EQUATIONS_SOURCE%SOURCE_FIELD,"Source Field",err,error,*999) - CALL FIELD_TYPE_SET_AND_LOCK(EQUATIONS_SOURCE%SOURCE_FIELD,FIELD_GENERAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(EQUATIONS_SOURCE%SOURCE_FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999) - CALL FIELD_MESH_DECOMPOSITION_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_DECOMPOSITION,err,error,*999) - CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(EQUATIONS_SOURCE%SOURCE_FIELD,GEOMETRIC_DECOMPOSITION, & - & err,error,*999) - CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(EQUATIONS_SOURCE%SOURCE_FIELD,EQUATIONS_SET%GEOMETRY% & - & GEOMETRIC_FIELD,err,error,*999) - CALL FIELD_NUMBER_OF_VARIABLES_SET_AND_LOCK(EQUATIONS_SOURCE%SOURCE_FIELD,1,err,error,*999) - CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(EQUATIONS_SOURCE%SOURCE_FIELD,[FIELD_U_VARIABLE_TYPE], & - & err,error,*999) - CALL FIELD_VARIABLE_LABEL_SET(EQUATIONS_SOURCE%SOURCE_FIELD,FIELD_U_VARIABLE_TYPE,"Source", & - & err,error,*999) - CALL FIELD_DIMENSION_SET_AND_LOCK(EQUATIONS_SOURCE%SOURCE_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_SET_AND_LOCK(EQUATIONS_SOURCE%SOURCE_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_DP_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD, FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS, ERR, ERROR, *999) - NUMBER_OF_SOURCE_COMPONENTS = NUMBER_OF_DIMENSIONS + 1 - CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_SOURCE%SOURCE_FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_SOURCE_COMPONENTS,err,error,*999) - - !Default the source components to the geometric interpolation setup with nodal interpolation - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE .OR. & - & EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) THEN - !nodal / mesh based - DO component_idx=1,NUMBER_OF_DIMENSIONS !NUMBER_OF_SOURCE_COMPONENTS - CALL FIELD_COMPONENT_MESH_COMPONENT_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & component_idx,GEOMETRIC_MESH_COMPONENT,err,error,*999) - CALL FIELD_COMPONENT_INTERPOLATION_SET(EQUATIONS_SOURCE%SOURCE_FIELD,FIELD_U_VARIABLE_TYPE, & - & component_idx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_SOURCE%SOURCE_FIELD,FIELD_U_VARIABLE_TYPE, & - & component_idx,GEOMETRIC_MESH_COMPONENT,err,error,*999) - ENDDO !component_idx - !Set source component 'NUMBER_OF_DIMENSIONS + 1' according to GEOMETRIC_MESH_COMPONENT 'NUMBER_OF_DIMENSIONS' - CALL FIELD_COMPONENT_INTERPOLATION_SET(EQUATIONS_SOURCE%SOURCE_FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS + 1,FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_SOURCE%SOURCE_FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS + 1,GEOMETRIC_MESH_COMPONENT,err,error,*999) - ENDIF - !Default the field scaling to that of the geometric field - CALL FIELD_SCALING_TYPE_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_SCALING_TYPE,err,error,*999) - CALL FIELD_SCALING_TYPE_SET(EQUATIONS_SOURCE%SOURCE_FIELD,GEOMETRIC_SCALING_TYPE,err,error,*999) - ELSE - !Check the user specified field - CALL FIELD_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_GENERAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_VARIABLES_CHECK(EQUATIONS_SET_SETUP%FIELD,1,err,error,*999) - CALL FIELD_VARIABLE_TYPES_CHECK(EQUATIONS_SET_SETUP%FIELD,[FIELD_U_VARIABLE_TYPE],err,error,*999) - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD, FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS, ERR, ERROR, *999) - NUMBER_OF_SOURCE_COMPONENTS = NUMBER_OF_DIMENSIONS + 1 - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_SOURCE_COMPONENTS,err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set source is not associated.",err,error,*999) - ENDIF - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - EQUATIONS_SOURCE=>EQUATIONS_SET%SOURCE - IF(ASSOCIATED(EQUATIONS_SOURCE)) THEN - IF(EQUATIONS_SOURCE%SOURCE_FIELD_AUTO_CREATED) THEN - !Finish creating the source field - CALL FIELD_CREATE_FINISH(EQUATIONS_SOURCE%SOURCE_FIELD,err,error,*999) - !Set the default values for the source field - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS,err,error,*999) - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE .OR. & - & EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) THEN - NUMBER_OF_SOURCE_COMPONENTS = NUMBER_OF_DIMENSIONS + 1 - ELSE - NUMBER_OF_SOURCE_COMPONENTS=0 - ENDIF - !Now set the source values to 0.0 - DO component_idx=1,NUMBER_OF_SOURCE_COMPONENTS - CALL FIELD_COMPONENT_VALUES_INITIALISE(EQUATIONS_SOURCE%SOURCE_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,component_idx,0.0_DP,err,error,*999) - ENDDO !component_idx - ENDIF - ELSE - CALL FlagError("Equations set source is not associated.",err,error,*999) - ENDIF - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard, quasistatic or ALE Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - END SELECT - - !----------------------------------------------------------------- - ! e q u a t i o n s t y p e - !----------------------------------------------------------------- - CASE(EQUATIONS_SET_SETUP_EQUATIONS_TYPE) - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - !----------------------------------------------------------------- - ! s t a t i c - !----------------------------------------------------------------- - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE,EQUATIONS_SET_MULTI_COMPARTMENT_DARCY_SUBTYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - CASE(EQUATIONS_SET_SETUP_START_ACTION) - EQUATIONS_MATERIALS=>EQUATIONS_SET%MATERIALS - IF(ASSOCIATED(EQUATIONS_MATERIALS)) THEN - IF(EQUATIONS_MATERIALS%MATERIALS_FINISHED) THEN - CALL Equations_CreateStart(EQUATIONS_SET,equations,err,error,*999) - CALL Equations_LinearityTypeSet(equations,EQUATIONS_LINEAR,err,error,*999) - CALL Equations_TimeDependenceTypeSet(equations,EQUATIONS_STATIC,err,error,*999) - ELSE - CALL FlagError("Equations set materials has not been finished.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set materials is not associated.",err,error,*999) - ENDIF - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - SELECT CASE(EQUATIONS_SET%SOLUTION_METHOD) - CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD) - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_MULTI_COMPARTMENT_DARCY_SUBTYPE) - !!!!!THE FOLLOWING IF STATEMENT IS ILLUSTRATIVE ONLY - need to implement the equation set field thing, and make a generalised case statement - CALL EquationsSet_EquationsGet(EQUATIONS_SET,equations,err,error,*999) - CALL Equations_CreateFinish(equations,err,error,*999) - NULLIFY(vectorEquations) - CALL Equations_VectorEquationsGet(equations,vectorEquations,err,error,*999) - !Create the equations mapping. - CALL EquationsMapping_VectorCreateStart(vectorEquations,FIELD_DELUDELN_VARIABLE_TYPE,vectorMapping,err,error,*999) - CALL EquationsMapping_LinearMatricesNumberSet(vectorMapping,1,err,error,*999) - EQUATIONS_SET_FIELD_FIELD=>EQUATIONS_SET%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD - CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET_FIELD_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,EQUATIONS_SET_FIELD_DATA,err,error,*999) - imy_matrix = EQUATIONS_SET_FIELD_DATA(1) - Ncompartments = EQUATIONS_SET_FIELD_DATA(2) - ALLOCATE(VARIABLE_TYPES(2*Ncompartments)) - DO num_var=1,Ncompartments - VARIABLE_TYPES(2*num_var-1)=FIELD_U_VARIABLE_TYPE+(FIELD_NUMBER_OF_VARIABLE_SUBTYPES*(num_var-1)) - VARIABLE_TYPES(2*num_var)=FIELD_DELUDELN_VARIABLE_TYPE+(FIELD_NUMBER_OF_VARIABLE_SUBTYPES*(num_var-1)) - ENDDO - CALL EquationsMapping_LinearMatricesVariableTypesSet(vectorMapping,[VARIABLE_TYPES(2*imy_matrix-1)], & - & err,error,*999) - CALL EquationsMapping_RHSVariableTypeSet(vectorMapping,VARIABLE_TYPES(2*imy_matrix),err,error,*999) - CALL EquationsMapping_VectorCreateFinish(vectorMapping,err,error,*999) - !Create the equations matrices - CALL EquationsMatrices_VectorCreateStart(vectorEquations,vectorMatrices,err,error,*999) - SELECT CASE(equations%sparsityType) - CASE(EQUATIONS_MATRICES_FULL_MATRICES) - CALL EquationsMatrices_LinearStorageTypeSet(vectorMatrices,[MATRIX_BLOCK_STORAGE_TYPE], & - & err,error,*999) - CASE(EQUATIONS_MATRICES_SPARSE_MATRICES) - CALL EquationsMatrices_LinearStorageTypeSet(vectorMatrices,[MATRIX_COMPRESSED_ROW_STORAGE_TYPE], & - & err,error,*999) - CALL EquationsMatrices_LinearStructureTypeSet(vectorMatrices,[EQUATIONS_MATRIX_FEM_STRUCTURE], & - & err,error,*999) - CASE DEFAULT - localError="The equations matrices sparsity type of "// & - & TRIM(NumberToVString(equations%sparsityType,"*",err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CALL EquationsMatrices_VectorCreateFinish(vectorMatrices,err,error,*999) - CASE DEFAULT - !Finish the equations creation - CALL EquationsSet_EquationsGet(EQUATIONS_SET,equations,err,error,*999) - CALL Equations_CreateFinish(equations,err,error,*999) - NULLIFY(vectorEquations) - CALL Equations_VectorEquationsGet(equations,vectorEquations,err,error,*999) - !Create the equations mapping. - CALL EquationsMapping_VectorCreateStart(vectorEquations,FIELD_DELUDELN_VARIABLE_TYPE,vectorMapping,err,error,*999) - CALL EquationsMapping_LinearMatricesNumberSet(vectorMapping,1,err,error,*999) - CALL EquationsMapping_LinearMatricesVariableTypesSet(vectorMapping,[FIELD_U_VARIABLE_TYPE], & - & err,error,*999) - CALL EquationsMapping_RHSVariableTypeSet(vectorMapping,FIELD_DELUDELN_VARIABLE_TYPE,err,error,*999) - CALL EquationsMapping_VectorCreateFinish(vectorMapping,err,error,*999) - !Create the equations matrices - CALL EquationsMatrices_VectorCreateStart(vectorEquations,vectorMatrices,err,error,*999) - SELECT CASE(equations%sparsityType) - CASE(EQUATIONS_MATRICES_FULL_MATRICES) - CALL EquationsMatrices_LinearStorageTypeSet(vectorMatrices,[MATRIX_BLOCK_STORAGE_TYPE], & - & err,error,*999) - CASE(EQUATIONS_MATRICES_SPARSE_MATRICES) - CALL EquationsMatrices_LinearStorageTypeSet(vectorMatrices,[MATRIX_COMPRESSED_ROW_STORAGE_TYPE], & - & err,error,*999) - CALL EquationsMatrices_LinearStructureTypeSet(vectorMatrices,[EQUATIONS_MATRIX_FEM_STRUCTURE], & - & err,error,*999) - CASE DEFAULT - localError="The equations matrices sparsity type of "// & - & TRIM(NumberToVString(equations%sparsityType,"*",err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CALL EquationsMatrices_VectorCreateFinish(vectorMatrices,err,error,*999) - END SELECT - CASE(EQUATIONS_SET_BEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FD_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The solution method of "//TRIM(NumberToVString(EQUATIONS_SET%SOLUTION_METHOD,"*",err,error))// & - & " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - !----------------------------------------------------------------- - ! q u a s i s t a t i c and A L E - !----------------------------------------------------------------- - CASE(EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE, EQUATIONS_SET_ALE_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - CASE(EQUATIONS_SET_SETUP_START_ACTION) - EQUATIONS_MATERIALS=>EQUATIONS_SET%MATERIALS - IF( ASSOCIATED(EQUATIONS_MATERIALS) ) THEN - IF( EQUATIONS_MATERIALS%MATERIALS_FINISHED ) THEN - CALL Equations_CreateStart(EQUATIONS_SET,equations,err,error,*999) - CALL Equations_LinearityTypeSet(equations,EQUATIONS_LINEAR,err,error,*999) - CALL Equations_TimeDependenceTypeSet(equations,EQUATIONS_QUASISTATIC,err,error,*999) - ELSE - CALL FlagError("Equations set materials has not been finished.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set materials is not associated.",err,error,*999) - ENDIF - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - SELECT CASE(EQUATIONS_SET%SOLUTION_METHOD) - CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD) - !Finish the equations creation - CALL EquationsSet_EquationsGet(EQUATIONS_SET,equations,err,error,*999) - CALL Equations_CreateFinish(equations,err,error,*999) - NULLIFY(vectorEquations) - CALL Equations_VectorEquationsGet(equations,vectorEquations,err,error,*999) - !Create the equations mapping. - CALL EquationsMapping_VectorCreateStart(vectorEquations,FIELD_DELUDELN_VARIABLE_TYPE,vectorMapping,err,error,*999) - CALL EquationsMapping_LinearMatricesNumberSet(vectorMapping,1,err,error,*999) - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE) - CALL EquationsMapping_LinearMatricesVariableTypesSet(vectorMapping,[FIELD_V_VARIABLE_TYPE], & - & err,error,*999) - CALL EquationsMapping_RHSVariableTypeSet(vectorMapping,FIELD_DELVDELN_VARIABLE_TYPE,err,error,*999) - CASE DEFAULT - CALL EquationsMapping_LinearMatricesVariableTypesSet(vectorMapping,[FIELD_U_VARIABLE_TYPE], & - & err,error,*999) - CALL EquationsMapping_RHSVariableTypeSet(vectorMapping,FIELD_DELUDELN_VARIABLE_TYPE,err,error,*999) - END SELECT - CALL EquationsMapping_VectorCreateFinish(vectorMapping,err,error,*999) - !Create the equations matrices - CALL EquationsMatrices_VectorCreateStart(vectorEquations,vectorMatrices,err,error,*999) - SELECT CASE(equations%sparsityType) - CASE(EQUATIONS_MATRICES_FULL_MATRICES) - CALL EquationsMatrices_LinearStorageTypeSet(vectorMatrices,[MATRIX_BLOCK_STORAGE_TYPE], & - & err,error,*999) - CASE(EQUATIONS_MATRICES_SPARSE_MATRICES) - CALL EquationsMatrices_LinearStorageTypeSet(vectorMatrices,[MATRIX_COMPRESSED_ROW_STORAGE_TYPE], & - & err,error,*999) - CALL EquationsMatrices_LinearStructureTypeSet(vectorMatrices,[EQUATIONS_MATRIX_FEM_STRUCTURE], & - & err,error,*999) - CASE DEFAULT - localError="The equations matrices sparsity type of "// & - & TRIM(NumberToVString(equations%sparsityType,"*",err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CALL EquationsMatrices_VectorCreateFinish(vectorMatrices,err,error,*999) - CASE(EQUATIONS_SET_BEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FD_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_FV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFEM_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE(EQUATIONS_SET_GFV_SOLUTION_METHOD) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The solution method of "//TRIM(NumberToVString(EQUATIONS_SET%SOLUTION_METHOD,"*",err,error))// & - & " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a quasistatic Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - !----------------------------------------------------------------- - ! d y n a m i c - !----------------------------------------------------------------- - CASE(EQUATIONS_SET_TRANSIENT_DARCY_SUBTYPE,EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE, & - & EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - CASE(EQUATIONS_SET_SETUP_START_ACTION) - EQUATIONS_MATERIALS=>EQUATIONS_SET%MATERIALS - IF(ASSOCIATED(EQUATIONS_MATERIALS)) THEN - IF(EQUATIONS_MATERIALS%MATERIALS_FINISHED) THEN - CALL Equations_CreateStart(EQUATIONS_SET,equations,err,error,*999) - CALL Equations_LinearityTypeSet(equations,EQUATIONS_LINEAR,err,error,*999) - CALL Equations_TimeDependenceTypeSet(equations,EQUATIONS_FIRST_ORDER_DYNAMIC,err,error,*999) - ELSE - CALL FlagError("Equations set materials has not been finished.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations materials is not associated.",err,error,*999) - ENDIF - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - SELECT CASE(EQUATIONS_SET%SOLUTION_METHOD) - CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD) - !Finish the equations creation - CALL EquationsSet_EquationsGet(EQUATIONS_SET,equations,err,error,*999) - CALL Equations_CreateFinish(equations,err,error,*999) - NULLIFY(vectorEquations) - CALL Equations_VectorEquationsGet(equations,vectorEquations,err,error,*999) - !Create the equations mapping. - CALL EquationsMapping_VectorCreateStart(vectorEquations,FIELD_DELUDELN_VARIABLE_TYPE,vectorMapping, & - & err,error,*999) - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE .OR. & - & EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE) THEN - CALL EquationsMapping_LinearMatricesNumberSet(vectorMapping,0,err,error,*999) - ENDIF - CALL EquationsMapping_DynamicMatricesSet(vectorMapping,.TRUE.,.TRUE.,err,error,*999) - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE) - CALL EquationsMapping_DynamicVariableTypeSet(vectorMapping,FIELD_V_VARIABLE_TYPE,err,error,*999) - CALL EquationsMapping_RHSVariableTypeSet(vectorMapping,FIELD_DELVDELN_VARIABLE_TYPE, & - & err,error,*999) - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE) THEN - CALL EquationsMapping_SourceVariableTypeSet(vectorMapping,FIELD_U_VARIABLE_TYPE,err,error,*999) - ENDIF - CASE(EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - EQUATIONS_SET_FIELD_FIELD=>EQUATIONS_SET%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD - CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET_FIELD_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,EQUATIONS_SET_FIELD_DATA,err,error,*999) - imy_matrix = EQUATIONS_SET_FIELD_DATA(1) - Ncompartments = EQUATIONS_SET_FIELD_DATA(2) - CALL EquationsMapping_LinearMatricesNumberSet(vectorMapping,Ncompartments-1,err,error,*999) - ALLOCATE(VARIABLE_TYPES(2*Ncompartments+2)) - ALLOCATE(VARIABLE_U_TYPES(Ncompartments-1)) - DO num_var=1,Ncompartments+1 - VARIABLE_TYPES(2*num_var-1)=FIELD_U_VARIABLE_TYPE+(FIELD_NUMBER_OF_VARIABLE_SUBTYPES*(num_var-1)) - VARIABLE_TYPES(2*num_var)=FIELD_DELUDELN_VARIABLE_TYPE+(FIELD_NUMBER_OF_VARIABLE_SUBTYPES*(num_var-1)) - ENDDO - num_var_count=0 - DO num_var=2,Ncompartments+1 - IF((num_var-1)/=imy_matrix)THEN - num_var_count=num_var_count+1 - VARIABLE_U_TYPES(num_var_count)=VARIABLE_TYPES(2*num_var-1) - ENDIF - ENDDO - CALL EquationsMapping_DynamicVariableTypeSet(vectorMapping,VARIABLE_TYPES(2*imy_matrix+1), & - & err,error,*999) - CALL EquationsMapping_LinearMatricesVariableTypesSet(vectorMapping,VARIABLE_U_TYPES,err,error,*999) - CALL EquationsMapping_RHSVariableTypeSet(vectorMapping,VARIABLE_TYPES(2*imy_matrix+2),err,error,*999) - CALL EquationsMapping_SourceVariableTypeSet(vectorMapping,FIELD_U_VARIABLE_TYPE,err,error,*999) - CASE DEFAULT - CALL EquationsMapping_DynamicVariableTypeSet(vectorMapping,FIELD_U_VARIABLE_TYPE,err,error,*999) - CALL EquationsMapping_RHSVariableTypeSet(vectorMapping,FIELD_DELUDELN_VARIABLE_TYPE, & - & err,error,*999) - END SELECT - CALL EquationsMapping_VectorCreateFinish(vectorMapping,err,error,*999) - !Create the equations matrices - CALL EquationsMatrices_VectorCreateStart(vectorEquations,vectorMatrices,err,error,*999) - !Set up matrix storage and structure - IF(equations%lumpingType==EQUATIONS_LUMPED_MATRICES) THEN - !Set up lumping - CALL EquationsMatrices_DynamicLumpingTypeSet(vectorMatrices, & - & [EQUATIONS_MATRIX_UNLUMPED,EQUATIONS_MATRIX_LUMPED],err,error,*999) - CALL EquationsMatrices_DynamicStorageTypeSet(vectorMatrices, & - & [DISTRIBUTED_MATRIX_COMPRESSED_ROW_STORAGE_TYPE,DISTRIBUTED_MATRIX_DIAGONAL_STORAGE_TYPE] & - & ,err,error,*999) - CALL EquationsMatrices_DynamicStructureTypeSet(vectorMatrices, & - & [EQUATIONS_MATRIX_FEM_STRUCTURE,EQUATIONS_MATRIX_DIAGONAL_STRUCTURE],err,error,*999) - ELSE - SELECT CASE(equations%sparsityType) - CASE(EQUATIONS_MATRICES_FULL_MATRICES) - CALL EquationsMatrices_LinearStorageTypeSet(vectorMatrices, & - & [DISTRIBUTED_MATRIX_BLOCK_STORAGE_TYPE,DISTRIBUTED_MATRIX_BLOCK_STORAGE_TYPE],err,error,*999) - CASE(EQUATIONS_MATRICES_SPARSE_MATRICES) - CALL EquationsMatrices_DynamicStorageTypeSet(vectorMatrices, & - & [DISTRIBUTED_MATRIX_COMPRESSED_ROW_STORAGE_TYPE, & - & DISTRIBUTED_MATRIX_COMPRESSED_ROW_STORAGE_TYPE],err,error,*999) - CALL EquationsMatrices_DynamicStructureTypeSet(vectorMatrices, & - & [EQUATIONS_MATRIX_FEM_STRUCTURE,EQUATIONS_MATRIX_FEM_STRUCTURE],err,error,*999) - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE)THEN - ALLOCATE(COUPLING_MATRIX_STORAGE_TYPE(Ncompartments-1)) - ALLOCATE(COUPLING_MATRIX_STRUCTURE_TYPE(Ncompartments-1)) - DO num_var=1,Ncompartments-1 - COUPLING_MATRIX_STORAGE_TYPE(num_var)=DISTRIBUTED_MATRIX_COMPRESSED_ROW_STORAGE_TYPE - COUPLING_MATRIX_STRUCTURE_TYPE(num_var)=EQUATIONS_MATRIX_FEM_STRUCTURE - ENDDO - CALL EquationsMatrices_LinearStorageTypeSet(vectorMatrices,COUPLING_MATRIX_STORAGE_TYPE, & - & err,error,*999) - CALL EquationsMatrices_LinearStructureTypeSet(vectorMatrices,COUPLING_MATRIX_STRUCTURE_TYPE, & - & err,error,*999) - ENDIF - CASE DEFAULT - localError="The equations matrices sparsity type of "// & - & TRIM(NumberToVString(equations%sparsityType,"*",err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - ENDIF - CALL EquationsMatrices_VectorCreateFinish(vectorMatrices,err,error,*999) - CASE DEFAULT - localError="The solution method of "//TRIM(NumberToVString(EQUATIONS_SET%SOLUTION_METHOD,"*", & - & err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - !----------------------------------------------------------------- - ! D e f a u l t - !----------------------------------------------------------------- - CASE DEFAULT - localError="The equation set subtype of "//TRIM(NumberToVString(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " for a setup of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - - !----------------------------------------------------------------- - ! c a s e d e f a u l t - !----------------------------------------------------------------- - CASE DEFAULT - localError="The setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard, quasistatic, ALE or dynamic Darcy equation." - CALL FlagError(localError,err,error,*999) - - END SELECT - CASE DEFAULT - localError="The equations set subtype of "//TRIM(NumberToVString(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " does not equal a standard, quasistatic, ALE or dynamic Darcy equation subtype." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - ENDIF - - EXITS("DARCY_EQUATION_EQUATIONS_SET_SETUP") - RETURN -999 ERRORSEXITS("DARCY_EQUATION_EQUATIONS_SET_SETUP",err,error) - RETURN 1 - END SUBROUTINE DARCY_EQUATION_EQUATIONS_SET_SETUP - - ! - !================================================================================================================================ - ! - - !>Calculates the element stiffness matrices and RHS for a Darcy equation finite element equations set. - SUBROUTINE DARCY_EQUATION_FINITE_ELEMENT_CALCULATE(EQUATIONS_SET,ELEMENT_NUMBER,err,error,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: equations_SET !EQUATIONS_SET%EQUATIONS - IF(ASSOCIATED(EQUATIONS)) THEN - NULLIFY(vectorEquations) - CALL Equations_VectorEquationsGet(equations,vectorEquations,err,error,*999) - IF(.NOT.ALLOCATED(EQUATIONS_SET%SPECIFICATION)) THEN - CALL FlagError("Equations set specification is not allocated.",err,error,*999) - ELSE IF(SIZE(EQUATIONS_SET%SPECIFICATION,1)/=3) THEN - CALL FlagError("Equations set specification must have three entries for a Darcy type equations set.", & - & err,error,*999) - END IF - EQUATIONS_SET_SUBTYPE=EQUATIONS_SET%SPECIFICATION(3) - SELECT CASE(EQUATIONS_SET_SUBTYPE) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE, EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE, EQUATIONS_SET_ALE_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_DARCY_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE,EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE,EQUATIONS_SET_MULTI_COMPARTMENT_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) -!!TODO: move these and scale factor adjustment out once generalised Darcy is put in. - !Store all these in equations matrices/somewhere else????? - dependentField=>equations%interpolation%dependentField - geometricField=>equations%interpolation%geometricField - materialsField=>equations%interpolation%materialsField - IF(EQUATIONS_SET_SUBTYPE==EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE .OR. & - & EQUATIONS_SET_SUBTYPE==EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) THEN - sourceField=>equations%interpolation%sourceField - END IF - - vectorMatrices=>vectorEquations%vectorMatrices - rhsVector=>vectorMatrices%rhsVector - vectorMapping=>vectorEquations%vectorMapping - - IF(EQUATIONS_SET_SUBTYPE==EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE .OR. & - & EQUATIONS_SET_SUBTYPE==EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) THEN - sourceVector=>vectorMatrices%sourceVector - sourceVector%elementVector%vector = 0.0_DP - END IF - - SELECT CASE(EQUATIONS_SET_SUBTYPE) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE, EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE, EQUATIONS_SET_ALE_DARCY_SUBTYPE, & - EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE) - linearMatrices=>vectorMatrices%linearMatrices - stiffnessMatrix=>linearMatrices%matrices(1)%ptr - - linearMapping=>vectorMapping%linearMapping - FIELD_VARIABLE=>linearMapping%equationsMatrixToVarMaps(1)%VARIABLE - FIELD_VAR_TYPE=FIELD_VARIABLE%VARIABLE_TYPE - - stiffnessMatrix%elementMatrix%matrix=0.0_DP - - CASE(EQUATIONS_SET_TRANSIENT_DARCY_SUBTYPE,EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE, & - & EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE) - dynamicMatrices=>vectorMatrices%dynamicMatrices - stiffnessMatrix=>dynamicMatrices%matrices(1)%ptr - dampingMatrix=>dynamicMatrices%matrices(2)%ptr - - dynamicMapping=>vectorMapping%dynamicMapping - FIELD_VARIABLE=>dynamicMapping%equationsMatrixToVarMaps(1)%VARIABLE - FIELD_VAR_TYPE=FIELD_VARIABLE%VARIABLE_TYPE - - stiffnessMatrix%elementMatrix%matrix=0.0_DP - dampingMatrix%elementMatrix%matrix=0.0_DP - - !Stuff used to check if this element is on the mesh boundary - DECOMPOSITION => dependentField%DECOMPOSITION - MESH_COMPONENT_NUMBER = DECOMPOSITION%MESH_COMPONENT_NUMBER - global_element_idx = DECOMPOSITION%DOMAIN(MESH_COMPONENT_NUMBER)%ptr%MAPPINGS%ELEMENTS% & - & LOCAL_TO_GLOBAL_MAP(ELEMENT_NUMBER) - MESH_ELEMENT => DECOMPOSITION%MESH%TOPOLOGY(MESH_COMPONENT_NUMBER)%ptr%ELEMENTS%ELEMENTS(global_element_idx) - - CASE(EQUATIONS_SET_MULTI_COMPARTMENT_DARCY_SUBTYPE) - EQUATIONS_SET_FIELD=>EQUATIONS_SET%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD - CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,EQUATIONS_SET_FIELD_DATA,err,error,*999) - - my_compartment = EQUATIONS_SET_FIELD_DATA(1) - Ncompartments = EQUATIONS_SET_FIELD_DATA(2) - linearMatrices=>vectorMatrices%linearMatrices - stiffnessMatrix=>linearMatrices%matrices(1)%ptr - - linearMapping=>vectorMapping%linearMapping - FIELD_VARIABLE=>linearMapping%equationsMatrixToVarMaps(1)%VARIABLE - FIELD_VAR_TYPE=FIELD_VARIABLE%VARIABLE_TYPE - - stiffnessMatrix%elementMatrix%matrix=0.0_DP - - CASE(EQUATIONS_SET_ELASTICITY_MULTI_COMPARTMENT_DARCY_INRIA_SUBTYPE) - - EQUATIONS_SET_FIELD=>EQUATIONS_SET%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD - CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,EQUATIONS_SET_FIELD_DATA,err,error,*999) - - my_compartment = EQUATIONS_SET_FIELD_DATA(1) - Ncompartments = EQUATIONS_SET_FIELD_DATA(2) - - !if Ncompartments>99 then flag error - - linearMatrices=>vectorMatrices%linearMatrices - linearMapping=>vectorMapping%linearMapping - -! DO imatrix = 1,Ncompartments -! COUPLING_MATRICES(imatrix)%ptr=>linearMatrices%matrices(imatrix)%ptr -! FIELD_VARIABLES(imatrix)%ptr=>linearMapping%equationsMatrixToVarMaps(imatrix)%VARIABLE -! FIELD_VAR_TYPES(imatrix)=FIELD_VARIABLES(imatrix)%ptr%VARIABLE_TYPE -! COUPLING_MATRICES(imatrix)%ptr%elementMatrix%matrix=0.0_DP -! END DO - - dynamicMatrices=>vectorMatrices%dynamicMatrices - stiffnessMatrix=>dynamicMatrices%matrices(1)%ptr - dampingMatrix=>dynamicMatrices%matrices(2)%ptr - - - - dynamicMapping=>vectorMapping%dynamicMapping - FIELD_VARIABLE=>dynamicMapping%equationsMatrixToVarMaps(1)%VARIABLE - FIELD_VAR_TYPE=FIELD_VARIABLE%VARIABLE_TYPE - - stiffnessMatrix%elementMatrix%matrix=0.0_DP - dampingMatrix%elementMatrix%matrix=0.0_DP - CASE(EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - EQUATIONS_SET_FIELD=>EQUATIONS_SET%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD - CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,EQUATIONS_SET_FIELD_DATA,err,error,*999) - - my_compartment = EQUATIONS_SET_FIELD_DATA(1) - Ncompartments = EQUATIONS_SET_FIELD_DATA(2) - !These linear matrices are actually only required if we are coupling the momentum terms too - !If it is just a mass coupling, then all of the additional terms are placed in the RHS of the mass-increase equation - linearMatrices=>vectorMatrices%linearMatrices - linearMapping=>vectorMapping%linearMapping - - num_var_count=0 - DO imatrix = 1,Ncompartments - IF(imatrix/=my_compartment)THEN - num_var_count=num_var_count+1 - COUPLING_MATRICES(num_var_count)%ptr=>linearMatrices%matrices(num_var_count)%ptr - FIELD_VARIABLES(num_var_count)%ptr=>linearMapping%equationsMatrixToVarMaps(num_var_count)%VARIABLE - FIELD_VAR_TYPES(num_var_count)=FIELD_VARIABLES(num_var_count)%ptr%VARIABLE_TYPE - COUPLING_MATRICES(num_var_count)%ptr%elementMatrix%matrix=0.0_DP - ENDIF - END DO - - dynamicMatrices=>vectorMatrices%dynamicMatrices - stiffnessMatrix=>dynamicMatrices%matrices(1)%ptr - dampingMatrix=>dynamicMatrices%matrices(2)%ptr - - dynamicMapping=>vectorMapping%dynamicMapping - FIELD_VARIABLE=>dynamicMapping%equationsMatrixToVarMaps(1)%VARIABLE - FIELD_VAR_TYPE=FIELD_VARIABLE%VARIABLE_TYPE - - stiffnessMatrix%elementMatrix%matrix=0.0_DP - dampingMatrix%elementMatrix%matrix=0.0_DP - - ALLOCATE(PRESSURE_COEFF(Ncompartments)) - - ALLOCATE(PRESSURE(Ncompartments)) - ALLOCATE(GRAD_PRESSURE(3,Ncompartments)) - PRESSURE = 0.0_DP - GRAD_PRESSURE = 0.0_DP - PRESSURE_COEFF(1)=0.25_DP - PRESSURE_COEFF(2)=0.25_DP - PRESSURE_COEFF(3)=0.25_DP - PRESSURE_COEFF(4)=0.25_DP - END SELECT - - !\ToDo: DEPENDENT_BASIS, DEPENDENT_BASIS_1, DEPENDENT_BASIS_2 - consistency !!! - - GEOMETRIC_BASIS=>geometricField%DECOMPOSITION%DOMAIN(geometricField%DECOMPOSITION%MESH_COMPONENT_NUMBER)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - DEPENDENT_BASIS=>dependentField%DECOMPOSITION%DOMAIN(dependentField%DECOMPOSITION%MESH_COMPONENT_NUMBER)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - - QUADRATURE_SCHEME=>DEPENDENT_BASIS%QUADRATURE%QUADRATURE_SCHEME_MAP(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr - - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER,equations%interpolation% & - & geometricInterpParameters(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER,equations%interpolation% & - & materialsInterpParameters(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - IF(EQUATIONS_SET_SUBTYPE==EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) THEN - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER,equations%interpolation% & - & materialsInterpParameters(FIELD_V_VARIABLE_TYPE)%ptr,err,error,*999) - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER,equations%interpolation% & - & materialsInterpParameters(FIELD_U1_VARIABLE_TYPE)%ptr,err,error,*999) - ENDIF - - IF(EQUATIONS_SET_SUBTYPE==EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE .OR. & - & EQUATIONS_SET_SUBTYPE==EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) THEN - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER,equations%interpolation% & - & sourceInterpParameters(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - END IF - - IF(EQUATIONS_SET_SUBTYPE==EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE .OR. & - & EQUATIONS_SET_SUBTYPE==EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) THEN - ELASTICITY_DEPENDENT_INTERPOLATION_PARAMETERS=>equations%interpolation% & - & dependentInterpParameters(FIELD_U_VARIABLE_TYPE)%ptr - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER, & - & ELASTICITY_DEPENDENT_INTERPOLATION_PARAMETERS,err,error,*999) - ELASTICITY_DEPENDENT_INTERPOLATED_POINT=>equations%interpolation% & - & dependentInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr - ENDIF - - - SELECT CASE(EQUATIONS_SET_SUBTYPE) - CASE(EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - NUMBER_OF_VEL_PRESS_COMPONENTS = FIELD_VARIABLE%NUMBER_OF_COMPONENTS - 1 !last component: mass increase - CASE DEFAULT - NUMBER_OF_VEL_PRESS_COMPONENTS = FIELD_VARIABLE%NUMBER_OF_COMPONENTS - END SELECT - - !--------------------------------------------------------------------------------------------------------- - !Invoke penalty term to enforce impermeable BC - ! should only be executed if THIS element lies on the surface - ! (within the routine we check whether the element nodes have actually been set impermeable) - SELECT CASE(EQUATIONS_SET_SUBTYPE) - CASE(EQUATIONS_SET_TRANSIENT_DARCY_SUBTYPE,EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE, & - & EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE) - IF( MESH_ELEMENT%BOUNDARY_ELEMENT ) THEN - CALL DARCY_EQUATION_IMPERMEABLE_BC_VIA_PENALTY(EQUATIONS_SET,ELEMENT_NUMBER,err,error,*999) - ENDIF - END SELECT - !--------------------------------------------------------------------------------------------------------- - - !--- Loop over gauss points - ! Given that also materials field is interpolated, ensure sufficient number of Gauss points !!! - DO ng=1,QUADRATURE_SCHEME%NUMBER_OF_GAUSS - - - IF(EQUATIONS_SET_SUBTYPE==EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE.OR. & - & EQUATIONS_SET_SUBTYPE==EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE .OR. & - & EQUATIONS_SET_SUBTYPE==EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) THEN - !------------------------------------------------------------------------------ - !--- begin: Compute the Jacobian of the mapping - - !--- Interpolation of Reference Geometry - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_INITIAL_VALUES_SET_TYPE,ELEMENT_NUMBER, & - & equations%interpolation%geometricInterpParameters(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - REFERENCE_GEOMETRIC_INTERPOLATED_POINT => equations%interpolation%geometricInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr - CALL FIELD_INTERPOLATE_GAUSS(FIRST_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng, & - & REFERENCE_GEOMETRIC_INTERPOLATED_POINT,err,error,*999) - !--- Retrieve local map DYDXI - DO component_idx=1,DEPENDENT_BASIS%NUMBER_OF_XI - DO xi_idx=1,DEPENDENT_BASIS%NUMBER_OF_XI - derivative_idx=PARTIAL_DERIVATIVE_FIRST_DERIVATIVE_MAP(xi_idx) !2,4,7 - DYDXI(component_idx,xi_idx)=REFERENCE_GEOMETRIC_INTERPOLATED_POINT%VALUES(component_idx,derivative_idx) !dy/dxi (y = referential) - ENDDO - ENDDO - - !--- Interpolation of (actual) Geometry and Metrics - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER, & - & equations%interpolation%geometricInterpParameters(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - GEOMETRIC_INTERPOLATED_POINT => equations%interpolation%geometricInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr - CALL FIELD_INTERPOLATE_GAUSS(FIRST_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng, & - & GEOMETRIC_INTERPOLATED_POINT,err,error,*999) - CALL FIELD_INTERPOLATED_POINT_METRICS_CALCULATE(GEOMETRIC_BASIS%NUMBER_OF_XI, & - & equations%interpolation%geometricInterpPointMetrics(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - !--- Retrieve local map DXDXI - DO component_idx=1,DEPENDENT_BASIS%NUMBER_OF_XI - DO xi_idx=1,DEPENDENT_BASIS%NUMBER_OF_XI - derivative_idx=PARTIAL_DERIVATIVE_FIRST_DERIVATIVE_MAP(xi_idx) !2,4,7 - DXDXI(component_idx,xi_idx)=GEOMETRIC_INTERPOLATED_POINT%VALUES(component_idx,derivative_idx) !dx/dxi - ENDDO - ENDDO - - !--- Compute deformation gradient tensor DXDY and its Jacobian Jxy - CALL Invert(DYDXI,DXIDY,Jyxi,err,error,*999) !dy/dxi -> dxi/dy - CALL MatrixProduct(DXDXI,DXIDY,DXDY,err,error,*999) !dx/dxi * dxi/dy = dx/dy (deformation gradient tensor, F) - CALL Determinant(DXDY,Jxy,err,error,*999) - - IF( ABS(Jxy) < 1.0E-10_DP ) THEN - localError="DARCY_EQUATION_FINITE_ELEMENT_CALCULATE: Jacobian Jxy is smaller than 1.0E-10_DP." - CALL FlagError(localError,err,error,*999) - END IF - - !ffact = f(Jxy) of the INRIA model, dfdJfact is not relevant here - CALL EVALUATE_CHAPELLE_FUNCTION(Jxy,ffact,dfdJfact,err,error,*999) - - !--- end: Compute the Jacobian of the mapping - !------------------------------------------------------------------------------ - END IF - - !--- Interpolate geometric and mesh velocity field (if applicable) - GEOMETRIC_INTERPOLATED_POINT => equations%interpolation%geometricInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr - CALL FIELD_INTERPOLATE_GAUSS(FIRST_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng, & - & GEOMETRIC_INTERPOLATED_POINT,err,error,*999) - CALL FIELD_INTERPOLATED_POINT_METRICS_CALCULATE(GEOMETRIC_BASIS%NUMBER_OF_XI, & - & equations%interpolation%geometricInterpPointMetrics(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - - !--- Calculate 'geometricInterpParameters' from 'FIELD_VALUES_SET_TYPE' - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER, & - & equations%interpolation%geometricInterpParameters(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - CALL FIELD_INTERPOLATE_GAUSS(FIRST_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng, & - & GEOMETRIC_INTERPOLATED_POINT,err,error,*999) - - -! !--- Material Settings ---! -! !*** If material is variable, need to account for this in deriving the variational statement ***! - - - !--- Interpolate materials field - !Get the Darcy permeability - MATERIALS_INTERPOLATED_POINT => equations%interpolation%materialsInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr - CALL FIELD_INTERPOLATE_GAUSS(FIRST_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng, & - & MATERIALS_INTERPOLATED_POINT,err,error,*999) - IF(EQUATIONS_SET_SUBTYPE==EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) THEN - !Get the intercompartmental permeabilities - CALL FIELD_INTERPOLATE_GAUSS(NO_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng,equations%interpolation% & - & materialsInterpPoint(FIELD_V_VARIABLE_TYPE)%ptr,err,error,*999) - !Get the material parameters for the constitutive law for each Darcy compartment (for determining the partial pressures) - CALL FIELD_INTERPOLATE_GAUSS(NO_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng,equations%interpolation% & - & materialsInterpPoint(FIELD_U1_VARIABLE_TYPE)%ptr,err,error,*999) - ENDIF - - IF(EQUATIONS_SET_SUBTYPE==EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE .OR. & - & EQUATIONS_SET_SUBTYPE==EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) THEN - CALL FIELD_INTERPOLATE_GAUSS(NO_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng,equations%interpolation% & - & sourceInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - END IF - - SELECT CASE(EQUATIONS_SET_SUBTYPE) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE,EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE,EQUATIONS_SET_ALE_DARCY_SUBTYPE) - !scalar permeability/viscosity - PERM_TENSOR_OVER_VIS=0.0_DP - PERM_TENSOR_OVER_VIS(1,1) = MATERIALS_INTERPOLATED_POINT%VALUES(2,NO_PART_DERIV) - PERM_TENSOR_OVER_VIS(2,2) = MATERIALS_INTERPOLATED_POINT%VALUES(2,NO_PART_DERIV) - PERM_TENSOR_OVER_VIS(3,3) = MATERIALS_INTERPOLATED_POINT%VALUES(2,NO_PART_DERIV) - !Multiply by porosity - PERM_TENSOR_OVER_VIS=PERM_TENSOR_OVER_VIS*MATERIALS_INTERPOLATED_POINT%VALUES(1,NO_PART_DERIV) - CASE DEFAULT - !symmetric permeability/viscosity tensor - PERM_TENSOR_OVER_VIS(1,1) = MATERIALS_INTERPOLATED_POINT%VALUES(2,NO_PART_DERIV) - PERM_TENSOR_OVER_VIS(1,2) = MATERIALS_INTERPOLATED_POINT%VALUES(3,NO_PART_DERIV) - PERM_TENSOR_OVER_VIS(1,3) = MATERIALS_INTERPOLATED_POINT%VALUES(4,NO_PART_DERIV) - PERM_TENSOR_OVER_VIS(2,2) = MATERIALS_INTERPOLATED_POINT%VALUES(5,NO_PART_DERIV) - PERM_TENSOR_OVER_VIS(2,3) = MATERIALS_INTERPOLATED_POINT%VALUES(6,NO_PART_DERIV) - PERM_TENSOR_OVER_VIS(3,3) = MATERIALS_INTERPOLATED_POINT%VALUES(7,NO_PART_DERIV) - - PERM_TENSOR_OVER_VIS(2,1) = PERM_TENSOR_OVER_VIS(1,2) - PERM_TENSOR_OVER_VIS(3,1) = PERM_TENSOR_OVER_VIS(1,3) - PERM_TENSOR_OVER_VIS(3,2) = PERM_TENSOR_OVER_VIS(2,3) - END SELECT - - IF(DIAGNOSTICS3) THEN - IF(idebug2) THEN - CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"MATERIALS_INTERPOLATED_POINT%VALUES(1,NO_PART_DERIV) = ", & - & MATERIALS_INTERPOLATED_POINT%VALUES(1,NO_PART_DERIV),err,error,*999) - CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"MATERIALS_INTERPOLATED_POINT%VALUES(2,NO_PART_DERIV) = ", & - & MATERIALS_INTERPOLATED_POINT%VALUES(2,NO_PART_DERIV),err,error,*999) - CALL WRITE_STRING(DIAGNOSTIC_OUTPUT_TYPE,"",err,error,*999) - idebug2 = .FALSE. - ENDIF - ENDIF - - CALL Determinant(PERM_TENSOR_OVER_VIS,Jmat,err,error,*999) - IF(Jmat>ZERO_TOLERANCE) THEN - CALL INVERT(PERM_TENSOR_OVER_VIS,VIS_OVER_PERM_TENSOR,Jmat,err,error,*999) - ELSE - VIS_OVER_PERM_TENSOR = 0.0_DP - DO idx_tensor=1,3 - VIS_OVER_PERM_TENSOR(idx_tensor,idx_tensor) = 1.0e10_DP - END DO -! CALL WRITE_STRING(GENERAL_OUTPUT_TYPE, & -! & "WARNING: Jmat dependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT_1)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - QUADRATURE_SCHEME_1 => DEPENDENT_BASIS_1%QUADRATURE% & - & QUADRATURE_SCHEME_MAP(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr - RWG = equations%interpolation%geometricInterpPointMetrics(FIELD_U_VARIABLE_TYPE)%ptr%JACOBIAN * & - & QUADRATURE_SCHEME_1%GAUSS_WEIGHTS(ng) - - DO ms=1,DEPENDENT_BASIS_1%NUMBER_OF_ELEMENT_PARAMETERS - mhs=mhs+1 - - !=================================================================================================================== - !stiffnessMatrix - IF(stiffnessMatrix%updateMatrix) THEN - - !Loop over element columns - nhs=0 - DO nh=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - - MESH_COMPONENT_2 = FIELD_VARIABLE%COMPONENTS(nh)%MESH_COMPONENT_NUMBER - DEPENDENT_BASIS_2 => dependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT_2)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - !--- We cannot use two different quadrature schemes here !!! - QUADRATURE_SCHEME_2 => DEPENDENT_BASIS_2%QUADRATURE% & - & QUADRATURE_SCHEME_MAP(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr - !RWG = equations%interpolation%geometricInterpPointMetrics%JACOBIAN * & - ! & QUADRATURE_SCHEME_2%GAUSS_WEIGHTS(ng) - - DO ns=1,DEPENDENT_BASIS_2%NUMBER_OF_ELEMENT_PARAMETERS - nhs=nhs+1 - - SELECT CASE(EQUATIONS_SET_SUBTYPE) - !==================================================================================================== - ! i n c o m p r e s s i b l e e l a s t i c i t y d r i v e n D a r c y : M A T R I C E S - CASE(EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE) - !------------------------------------------------------------------------------------------------------------- - !velocity test function, velocity trial function - IF(mh==nh.AND.nh1.0E-08) WRITE(*,*)'C_PARAM = ',C_PARAM - - SUM = 0.0_DP - PGM=QUADRATURE_SCHEME_1%GAUSS_BASIS_FNS(ms,NO_PART_DERIV,ng) - SUM = SUM + PGM * C_PARAM - sourceVector%elementVector%vector(mhs) = sourceVector%elementVector%vector(mhs) + SUM * RWG - ENDIF - END IF - END IF - ENDDO !ms - ENDDO !mh - - IF(EQUATIONS_SET_SUBTYPE==EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) THEN - !Calculate the momentum coupling matrices - - !Loop over element rows - mhs=0 - DO mh=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS !field_variable is the variable associated with the equations set under consideration - - MESH_COMPONENT_1 = FIELD_VARIABLE%COMPONENTS(mh)%MESH_COMPONENT_NUMBER - DEPENDENT_BASIS_1 => dependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT_1)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - QUADRATURE_SCHEME_1 => DEPENDENT_BASIS_1%QUADRATURE% & - & QUADRATURE_SCHEME_MAP(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr - RWG = equations%interpolation%geometricInterpPointMetrics(FIELD_U_VARIABLE_TYPE)%ptr%JACOBIAN * & - & QUADRATURE_SCHEME_1%GAUSS_WEIGHTS(ng) - - DO ms=1,DEPENDENT_BASIS_1%NUMBER_OF_ELEMENT_PARAMETERS - mhs=mhs+1 - - num_var_count=0 - DO imatrix = 1,Ncompartments - IF(imatrix/=my_compartment)THEN - num_var_count=num_var_count+1 - -!need to test for the case where imatrix==mycompartment -!the coupling terms then needs to be added into the stiffness matrix - IF(COUPLING_MATRICES(num_var_count)%ptr%updateMatrix) THEN - - !Loop over element columns - nhs=0 - DO nh=1,FIELD_VARIABLES(num_var_count)%ptr%NUMBER_OF_COMPONENTS - - MESH_COMPONENT_2 = FIELD_VARIABLE%COMPONENTS(nh)%MESH_COMPONENT_NUMBER - DEPENDENT_BASIS_2 => dependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT_2)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - !--- We cannot use two different quadrature schemes here !!! - QUADRATURE_SCHEME_2 => DEPENDENT_BASIS_2%QUADRATURE% & - & QUADRATURE_SCHEME_MAP(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr - !RWG = equations%interpolation%geometricInterpPointMetrics%JACOBIAN * & - ! & QUADRATURE_SCHEME_2%GAUSS_WEIGHTS(ng) - - DO ns=1,DEPENDENT_BASIS_2%NUMBER_OF_ELEMENT_PARAMETERS - nhs=nhs+1 - -! !------------------------------------------------------------------------------------------------------------- -! !concentration test function, concentration trial function -! !For now, this is only a dummy implementation - this still has to be properly set up. -! IF(mh==nh.AND.nhdependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT_1)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - QUADRATURE_SCHEME_1=>DEPENDENT_BASIS_1%QUADRATURE%QUADRATURE_SCHEME_MAP(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr - RWG=equations%interpolation%geometricInterpPointMetrics(FIELD_U_VARIABLE_TYPE)%ptr%JACOBIAN* & - & QUADRATURE_SCHEME_1%GAUSS_WEIGHTS(ng) - DO ms=1,DEPENDENT_BASIS_1%NUMBER_OF_ELEMENT_PARAMETERS - mhs=mhs+1 - PGM=QUADRATURE_SCHEME_1%GAUSS_BASIS_FNS(ms,NO_PART_DERIV,ng) - !note mh value derivative - SUM=0.0_DP - - X(1) = equations%interpolation%geometricInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(1,1) - X(2) = equations%interpolation%geometricInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(2,1) - IF(DEPENDENT_BASIS_1%NUMBER_OF_XI==3) THEN - X(3) = equations%interpolation%geometricInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(3,1) - END IF - IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_DARCY_EQUATION_TWO_DIM_1) THEN - SUM=0.0_DP - ELSE IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_DARCY_EQUATION_TWO_DIM_2) THEN - IF(mh==3) THEN - FACT = PERM_OVER_VIS_PARAM / L - ARG(1) = X(1) / L - ARG(2) = X(2) / L - SOURCE = -2.0_DP / L * FACT * EXP( ARG(1) ) * EXP( ARG(2) ) - SUM = PGM * SOURCE - ELSE - SUM = 0.0_DP - ENDIF - ELSE IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_DARCY_EQUATION_TWO_DIM_3) THEN - IF(mh==3) THEN - FACT = 2.0_DP * PI * PERM_OVER_VIS_PARAM / L - ARG(1) = 2.0_DP * PI * X(1) / L - ARG(2) = 2.0_DP * PI * X(2) / L - SOURCE = +2.0_DP * (2.0_DP * PI / L) * FACT * SIN( ARG(1) ) * SIN( ARG(2) ) - SUM = PGM * SOURCE - ELSE - SUM = 0.0_DP - ENDIF - ELSE IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_DARCY_EQUATION_THREE_DIM_1) THEN - SUM=0.0_DP - ELSE IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_DARCY_EQUATION_THREE_DIM_2) THEN - IF(mh==4) THEN - FACT = PERM_OVER_VIS_PARAM / L - ARG(1) = X(1) / L - ARG(2) = X(2) / L - ARG(3) = X(3) / L - SOURCE = -3.0_DP / L * FACT * EXP( ARG(1) ) * EXP( ARG(2) ) * EXP( ARG(3) ) - SUM = PGM * SOURCE - ELSE - SUM = 0.0_DP - ENDIF - ELSE IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_DARCY_EQUATION_THREE_DIM_3) THEN - IF(mh==4) THEN - FACT = 2.0_DP * PI * PERM_OVER_VIS_PARAM / L - ARG(1) = 2.0_DP * PI * X(1) / L - ARG(2) = 2.0_DP * PI * X(2) / L - ARG(3) = 2.0_DP * PI * X(3) / L - SOURCE = +3.0_DP * ( 2.0_DP * PI / L ) * FACT * SIN( ARG(1) ) * SIN( ARG(2) ) * SIN( ARG(3) ) - SUM = PGM * SOURCE - ELSE - SUM = 0.0_DP - END IF - ENDIF - - !Calculate RHS VECTOR - rhsVector%elementVector%vector(mhs)=rhsVector%elementVector%vector(mhs)+SUM*RWG - ENDDO !ms - ENDDO !mh - ELSE - rhsVector%elementVector%vector(mhs)=0.0_DP - ENDIF - ENDIF - - ! end: RIGHT HAND SIDE FOR ANALYTIC SOLUTION - !----------------------------------------------------------------------------------------------------------------------------------- - -! !=================================================================================================================== -! !COUPLING_MATRICES -! SELECT CASE(EQUATIONS_SET_SUBTYPE) -! CASE(EQUATIONS_SET_MULTI_COMPARTMENT_DARCY_SUBTYPE,EQUATIONS_SET_ELASTICITY_MULTI_COMPARTMENT_DARCY_INRIA_SUBTYPE) -! -! !Create FIELD_VARIABLES type, COUPLING_MATRICES type -! -! !Loop over element rows -! mhs=0 -! DO mh=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS -! -! MESH_COMPONENT_1 = FIELD_VARIABLE%COMPONENTS(mh)%MESH_COMPONENT_NUMBER -! DEPENDENT_BASIS_1 => dependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT_1)%ptr% & -! & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS -! QUADRATURE_SCHEME_1 => DEPENDENT_BASIS_1%QUADRATURE% & -! & QUADRATURE_SCHEME_MAP(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr -! RWG = equations%interpolation%geometricInterpPointMetrics(FIELD_U_VARIABLE_TYPE)%ptr%JACOBIAN * & -! & QUADRATURE_SCHEME_1%GAUSS_WEIGHTS(ng) -! -! DO ms=1,DEPENDENT_BASIS_1%NUMBER_OF_ELEMENT_PARAMETERS -! mhs=mhs+1 -! -! DO imatrix=1,Ncompartments -! -! IF(COUPLING_MATRICES(imatrix)%ptr%updateMatrix) THEN -! -! !Loop over element columns -! nhs=0 -! ! DO nh=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS -! DO nh=1,FIELD_VARIABLES(imatrix)%ptr%NUMBER_OF_COMPONENTS -! -! MESH_COMPONENT_2 = FIELD_VARIABLE%COMPONENTS(nh)%MESH_COMPONENT_NUMBER -! DEPENDENT_BASIS_2 => dependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT_2)%ptr% & -! & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS -! !--- We cannot use two different quadrature schemes here !!! -! QUADRATURE_SCHEME_2 => DEPENDENT_BASIS_2%QUADRATURE% & -! & QUADRATURE_SCHEME_MAP(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr -! !RWG = equations%interpolation%geometricInterpPointMetrics%JACOBIAN * & -! ! & QUADRATURE_SCHEME_2%GAUSS_WEIGHTS(ng) -! -! DO ns=1,DEPENDENT_BASIS_2%NUMBER_OF_ELEMENT_PARAMETERS -! nhs=nhs+1 -! -! !------------------------------------------------------------------------------------------------------------- -! !velocity test function, velocity trial function -! !For now, this is only a dummy implementation - this still has to be properly set up. -! IF(mh==nh.AND.nh dependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT_1)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - NDOFS = NDOFS + DEPENDENT_BASIS_1%NUMBER_OF_ELEMENT_PARAMETERS - END DO - - CALL WRITE_STRING(DIAGNOSTIC_OUTPUT_TYPE,"Element Matrix for element number 1 (Darcy):",err,error,*999) - DO mhs=1,NDOFS - CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"row number = ",mhs,err,error,*999) - CALL WRITE_STRING_VECTOR(DIAGNOSTIC_OUTPUT_TYPE,1,1,NDOFS,NDOFS,NDOFS,& - & stiffnessMatrix%elementMatrix%matrix(mhs,:), & - & '("",4(X,E13.6))','4(4(X,E13.6))',err,error,*999) - CALL WRITE_STRING(DIAGNOSTIC_OUTPUT_TYPE," ",err,error,*999) - END DO - END IF - END IF - - !Scale factor adjustment - IF(dependentField%SCALINGS%SCALING_TYPE/=FIELD_NO_SCALING) THEN - CALL Field_InterpolationParametersScaleFactorsElementGet(ELEMENT_NUMBER,equations%interpolation% & - & dependentInterpParameters(FIELD_VAR_TYPE)%ptr,err,error,*999) - mhs=0 - DO mh=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - !Loop over element rows - MESH_COMPONENT_1=FIELD_VARIABLE%COMPONENTS(mh)%MESH_COMPONENT_NUMBER - DEPENDENT_BASIS_1=>dependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT_1)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - DO ms=1,DEPENDENT_BASIS_1%NUMBER_OF_ELEMENT_PARAMETERS - mhs=mhs+1 - nhs=0 - IF(ASSOCIATED(stiffnessMatrix).AND.ASSOCIATED(dampingMatrix)) THEN - IF(stiffnessMatrix%updateMatrix.OR.dampingMatrix%updateMatrix) THEN - !Loop over element columns - DO nh=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - MESH_COMPONENT_2=FIELD_VARIABLE%COMPONENTS(nh)%MESH_COMPONENT_NUMBER - DEPENDENT_BASIS_2=>dependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT_2)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - DO ns=1,DEPENDENT_BASIS_2%NUMBER_OF_ELEMENT_PARAMETERS - nhs=nhs+1 - IF(stiffnessMatrix%updateMatrix)THEN - stiffnessMatrix%elementMatrix%matrix(mhs,nhs)=stiffnessMatrix%elementMatrix%matrix(mhs,nhs)* & - & equations%interpolation%dependentInterpParameters(FIELD_VAR_TYPE)%ptr%SCALE_FACTORS(ms,mh)* & - & equations%interpolation%dependentInterpParameters(FIELD_VAR_TYPE)%ptr%SCALE_FACTORS(ns,nh) - END IF - IF(dampingMatrix%updateMatrix)THEN - dampingMatrix%elementMatrix%matrix(mhs,nhs)=dampingMatrix%elementMatrix%matrix(mhs,nhs)* & - & equations%interpolation%dependentInterpParameters(FIELD_VAR_TYPE)%ptr%SCALE_FACTORS(ms,mh)* & - & equations%interpolation%dependentInterpParameters(FIELD_VAR_TYPE)%ptr%SCALE_FACTORS(ns,nh) - END IF - ENDDO !ns - ENDDO !nh - ENDIF - ENDIF - IF(ASSOCIATED(rhsVector)) THEN - IF(rhsVector%updateVector) rhsVector%elementVector%vector(mhs)=rhsVector%elementVector%vector(mhs)* & - & equations%interpolation%dependentInterpParameters(FIELD_VAR_TYPE)%ptr%SCALE_FACTORS(ms,mh) - ENDIF - IF(ASSOCIATED(sourceVector)) THEN - IF(sourceVector%updateVector) sourceVector%elementVector%vector(mhs)= & - & sourceVector%elementVector%vector(mhs)* & - & equations%interpolation%dependentInterpParameters(FIELD_VAR_TYPE)%ptr%SCALE_FACTORS(ms,mh) - ENDIF - ENDDO !ms - ENDDO !mh - ENDIF - - ! RESTORE ALL POINTERS CALL PARAMATER_SET_FIELD_DATA_RESTORE - - CASE DEFAULT - localError="Equations set subtype "//TRIM(NumberToVString(EQUATIONS_SET_SUBTYPE,"*",err,error))// & - & " is not valid for a Darcy equation type of a fluid mechanics equations set class." - CALL FlagError(localError,err,error,*999) - END SELECT - - ELSE - CALL FlagError("Equations set equations is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - ENDIF - - EXITS("DARCY_EQUATION_FINITE_ELEMENT_CALCULATE") - RETURN -999 ERRORSEXITS("DARCY_EQUATION_FINITE_ELEMENT_CALCULATE",err,error) - RETURN 1 - END SUBROUTINE DARCY_EQUATION_FINITE_ELEMENT_CALCULATE - - ! - !================================================================================================================================ - ! - - !>Calculates the face integration term of the finite element formulation for Darcy's equation, - !>required for pressure boundary conditions. - SUBROUTINE Darcy_FiniteElementFaceIntegrate(equationsSet,elementNumber,dependentVariable,err,error,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: equationsSet !equationsSet%EQUATIONS - IF(ASSOCIATED(equations)) THEN - NULLIFY(vectorEquations) - CALL Equations_VectorEquationsGet(equations,vectorEquations,err,error,*999) - equationsMatrices=>vectorEquations%vectorMatrices - IF(ASSOCIATED(equationsMatrices)) THEN - rhsVector=>equationsMatrices%rhsVector - END IF - ELSE - CALL FlagError("Equations set equations is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - END IF - - IF(.NOT.ALLOCATED(equationsSet%specification)) THEN - CALL FlagError("Equations set specification is not allocated.",err,error,*999) - ELSE IF(SIZE(equationsSet%specification,1)/=3) THEN - CALL FlagError("Equations set specification must have three entries for a Darcy type equations set.", & - & err,error,*999) - END IF - SELECT CASE(equationsSet%specification(3)) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE, & - & EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE, & - & EQUATIONS_SET_ALE_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_DARCY_SUBTYPE) - - !Get the mesh decomposition and basis for this element - decomposition=>dependentVariable%FIELD%DECOMPOSITION - !These RHS terms are associated with the equations for the three velocity components, - !rather than the pressure term - meshComponentNumber=dependentVariable%COMPONENTS(1)%MESH_COMPONENT_NUMBER - dependentBasis=>decomposition%DOMAIN(meshComponentNumber)%ptr%TOPOLOGY%ELEMENTS%ELEMENTS(elementNumber)%BASIS - decompElement=>DECOMPOSITION%TOPOLOGY%ELEMENTS%ELEMENTS(elementNumber) - - !Only add RHS terms if the face geometric parameters are calculated - IF(decomposition%CALCULATE_FACES) THEN - !Get interpolation parameters and point for Darcy pressure - dependentInterpolationParameters=>equations%interpolation%dependentInterpParameters(dependentVariable%VARIABLE_TYPE)%ptr - dependentInterpolatedPoint=>equations%interpolation%dependentInterpPoint(dependentVariable%VARIABLE_TYPE)%ptr - - DO faceIdx=1,dependentBasis%NUMBER_OF_LOCAL_FACES - !Get the face normal and quadrature information - IF(ALLOCATED(decompElement%ELEMENT_FACES)) THEN - faceNumber=decompElement%ELEMENT_FACES(faceIdx) - ELSE - CALL FlagError("Decomposition element faces is not allocated.",err,error,*999) - END IF - face=>decomposition%TOPOLOGY%FACES%FACES(faceNumber) - !This speeds things up but is also important, as non-boundary faces have an XI_DIRECTION that might - !correspond to the other element. - IF(.NOT.(face%BOUNDARY_FACE)) CYCLE - CALL FIELD_INTERPOLATION_PARAMETERS_FACE_GET(FIELD_VALUES_SET_TYPE,faceNumber,dependentInterpolationParameters, & - & err,error,*999) - normalComponentIdx=ABS(face%XI_DIRECTION) - faceBasis=>decomposition%DOMAIN(meshComponentNumber)%ptr%TOPOLOGY%FACES%FACES(faceNumber)%BASIS - faceQuadratureScheme=>faceBasis%QUADRATURE%QUADRATURE_SCHEME_MAP(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr - - DO gaussIdx=1,faceQuadratureScheme%NUMBER_OF_GAUSS - gaussWeight=faceQuadratureScheme%GAUSS_WEIGHTS(gaussIdx) - !Get interpolated Darcy pressure - CALL FIELD_INTERPOLATE_GAUSS(NO_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,gaussIdx, & - & dependentInterpolatedPoint,err,error,*999) - pressureGauss=dependentInterpolatedPoint%values(4,1) !(component,derivative) - - !Use the geometric field to find the face normal and the Jacobian for the face integral - geometricInterpolationParameters=>equations%interpolation%geometricInterpParameters( & - & FIELD_U_VARIABLE_TYPE)%ptr - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,elementNumber, & - & geometricInterpolationParameters,err,error,*999) - geometricInterpolatedPoint=>equations%interpolation%geometricInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr - CALL FIELD_INTERPOLATE_LOCAL_FACE_GAUSS(FIRST_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,faceIdx,gaussIdx, & - & geometricInterpolatedPoint,err,error,*999) - !Calculate the metric tensors and Jacobian - pointMetrics=>equations%interpolation%geometricInterpPointMetrics(FIELD_U_VARIABLE_TYPE)%ptr - CALL FIELD_INTERPOLATED_POINT_METRICS_CALCULATE(COORDINATE_JACOBIAN_VOLUME_TYPE,pointMetrics,err,error,*999) - - DO componentIdx=1,dependentVariable%NUMBER_OF_COMPONENTS-1 - normalProjection=DOT_PRODUCT(pointMetrics%GU(normalComponentIdx,:),pointMetrics%DX_DXI(componentIdx,:)) - IF(face%XI_DIRECTION<0) THEN - normalProjection=-normalProjection - END IF - IF(ABS(normalProjection)Sets the equation specification for a Darcy equation type of a fluid mechanics equations set class. - SUBROUTINE Darcy_EquationsSetSpecificationSet(equationsSet,specification,err,error,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: equationsSet !Sets the problem specification for a Darcy problem. - SUBROUTINE Darcy_ProblemSpecificationSet(problem,problemSpecification,err,error,*) - - !Argument variables - TYPE(PROBLEM_TYPE), POINTER :: problem !Sets up the Darcy equations problem. -! SUBROUTINE DARCY_EQUATION_PROBLEM_STANDARD_SETUP(PROBLEM,PROBLEM_SETUP,err,error,*) - SUBROUTINE DARCY_EQUATION_PROBLEM_SETUP(PROBLEM,PROBLEM_SETUP,err,error,*) - - !Argument variables - TYPE(PROBLEM_TYPE), POINTER :: PROBLEM !PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_CREATE_FINISH(CONTROL_LOOP,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVERS_TYPE) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Start the solvers creation - CALL SOLVERS_CREATE_START(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_NUMBER_SET(SOLVERS,1,err,error,*999) - !Set the solver to be a linear solver - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - CALL SOLVER_TYPE_SET(SOLVER,SOLVER_LINEAR_TYPE,err,error,*999) - !Set solver defaults - CALL SOLVER_LIBRARY_TYPE_SET(SOLVER,SOLVER_PETSC_LIBRARY,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the solvers - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - !Finish the solvers creation - CALL SOLVERS_CREATE_FINISH(SOLVERS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVER_EQUATIONS_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - !Get the solver - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - !Create the solver equations - CALL SOLVER_EQUATIONS_CREATE_START(SOLVER,SOLVER_EQUATIONS,err,error,*999) - CALL SOLVER_EQUATIONS_LINEARITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_LINEAR,err,error,*999) - CALL SOLVER_EQUATIONS_TIME_DEPENDENCE_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_STATIC,err,error,*999) - CALL SOLVER_EQUATIONS_SPARSITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_SPARSE_MATRICES,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - !Get the solver equations - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - CALL SOLVER_SOLVER_EQUATIONS_GET(SOLVER,SOLVER_EQUATIONS,err,error,*999) - !Finish the solver equations creation - CALL SOLVER_EQUATIONS_CREATE_FINISH(SOLVER_EQUATIONS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - - !----------------------------------------------------------------- - ! q u a s i s t a t i c D a r c y - !----------------------------------------------------------------- - CASE(PROBLEM_QUASISTATIC_DARCY_SUBTYPE) - SELECT CASE(PROBLEM_SETUP%SETUP_TYPE) - CASE(PROBLEM_SETUP_INITIAL_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Do nothing???? - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Do nothing??? - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a quasistatic Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_CONTROL_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Set up a time control loop - CALL CONTROL_LOOP_CREATE_START(PROBLEM,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_TYPE_SET(CONTROL_LOOP,PROBLEM_CONTROL_TIME_LOOP_TYPE,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Finish the control loops - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_CREATE_FINISH(CONTROL_LOOP,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a quasistatic Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVERS_TYPE) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Start the solvers creation - CALL SOLVERS_CREATE_START(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_NUMBER_SET(SOLVERS,1,err,error,*999) - !Set the solver to be a linear solver - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - CALL SOLVER_TYPE_SET(SOLVER,SOLVER_LINEAR_TYPE,err,error,*999) - !Set solver defaults - CALL SOLVER_LIBRARY_TYPE_SET(SOLVER,SOLVER_PETSC_LIBRARY,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the solvers - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - !Finish the solvers creation - CALL SOLVERS_CREATE_FINISH(SOLVERS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a quasistatic Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVER_EQUATIONS_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - !Get the solver - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - !Create the solver equations - CALL SOLVER_EQUATIONS_CREATE_START(SOLVER,SOLVER_EQUATIONS,err,error,*999) - CALL SOLVER_EQUATIONS_LINEARITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_LINEAR,err,error,*999) - CALL SOLVER_EQUATIONS_TIME_DEPENDENCE_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_QUASISTATIC,err,error,*999) - CALL SOLVER_EQUATIONS_SPARSITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_SPARSE_MATRICES,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - !Get the solver equations - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - CALL SOLVER_SOLVER_EQUATIONS_GET(SOLVER,SOLVER_EQUATIONS,err,error,*999) - !Finish the solver equations creation - CALL SOLVER_EQUATIONS_CREATE_FINISH(SOLVER_EQUATIONS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a quasistatic Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a quasistatic Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - - !----------------------------------------------------------------- - ! A L E / P G M D a r c y - !----------------------------------------------------------------- - CASE(PROBLEM_ALE_DARCY_SUBTYPE,PROBLEM_PGM_DARCY_SUBTYPE) - SELECT CASE(PROBLEM_SETUP%SETUP_TYPE) - CASE(PROBLEM_SETUP_INITIAL_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Do nothing???? - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Do nothing??? - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for an ALE Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_CONTROL_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Set up a time control loop - CALL CONTROL_LOOP_CREATE_START(PROBLEM,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_TYPE_SET(CONTROL_LOOP,PROBLEM_CONTROL_TIME_LOOP_TYPE,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Finish the control loops - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_CREATE_FINISH(CONTROL_LOOP,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for an ALE Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVERS_TYPE) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Start the solvers creation - CALL SOLVERS_CREATE_START(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_NUMBER_SET(SOLVERS,2,err,error,*999) - ! - !Set the first solver to be a linear solver for the material update - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER_MAT_PROPERTIES,err,error,*999) - CALL SOLVER_TYPE_SET(SOLVER_MAT_PROPERTIES,SOLVER_LINEAR_TYPE,err,error,*999) - CALL SOLVER_LIBRARY_TYPE_SET(SOLVER_MAT_PROPERTIES,SOLVER_PETSC_LIBRARY,err,error,*999) - ! - !Set the second solver to be a linear solver for the ALE Darcy - CALL SOLVERS_SOLVER_GET(SOLVERS,2,SOLVER,err,error,*999) - CALL SOLVER_TYPE_SET(SOLVER,SOLVER_LINEAR_TYPE,err,error,*999) - CALL SOLVER_LIBRARY_TYPE_SET(SOLVER,SOLVER_PETSC_LIBRARY,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the solvers - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - !Finish the solvers creation - CALL SOLVERS_CREATE_FINISH(SOLVERS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for an ALE Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVER_EQUATIONS_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Get the control loop and solvers - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - !Get the material-properties solver and create the material-properties solver equations - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER_MAT_PROPERTIES,err,error,*999) - CALL SOLVER_EQUATIONS_CREATE_START(SOLVER_MAT_PROPERTIES,SOLVER_EQUATIONS_MAT_PROPERTIES,err,error,*999) - CALL SOLVER_EQUATIONS_LINEARITY_TYPE_SET(SOLVER_EQUATIONS_MAT_PROPERTIES,SOLVER_EQUATIONS_LINEAR,err,error,*999) - CALL SOLVER_EQUATIONS_TIME_DEPENDENCE_TYPE_SET(SOLVER_EQUATIONS_MAT_PROPERTIES,SOLVER_EQUATIONS_QUASISTATIC, & - & err,error,*999) - CALL SOLVER_EQUATIONS_SPARSITY_TYPE_SET(SOLVER_EQUATIONS_MAT_PROPERTIES,SOLVER_SPARSE_MATRICES,err,error,*999) - !Get the Darcy-ALE solver and create the Darcy-ALE solver equations - CALL SOLVERS_SOLVER_GET(SOLVERS,2,SOLVER,err,error,*999) - CALL SOLVER_EQUATIONS_CREATE_START(SOLVER,SOLVER_EQUATIONS,err,error,*999) - CALL SOLVER_EQUATIONS_LINEARITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_LINEAR,err,error,*999) - CALL SOLVER_EQUATIONS_TIME_DEPENDENCE_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_QUASISTATIC,err,error,*999) - CALL SOLVER_EQUATIONS_SPARSITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_SPARSE_MATRICES,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - !Finish the creation of the material-properties solver equations - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER_MAT_PROPERTIES,err,error,*999) - CALL SOLVER_SOLVER_EQUATIONS_GET(SOLVER_MAT_PROPERTIES,SOLVER_EQUATIONS_MAT_PROPERTIES,err,error,*999) - CALL SOLVER_EQUATIONS_CREATE_FINISH(SOLVER_EQUATIONS_MAT_PROPERTIES,err,error,*999) - !Finish the creation of the Darcy-ALE solver equations - CALL SOLVERS_SOLVER_GET(SOLVERS,2,SOLVER,err,error,*999) - CALL SOLVER_SOLVER_EQUATIONS_GET(SOLVER,SOLVER_EQUATIONS,err,error,*999) - CALL SOLVER_EQUATIONS_CREATE_FINISH(SOLVER_EQUATIONS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for an ALE Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for an ALE Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - - !----------------------------------------------------------------- - ! D Y N A M I C A L E / P G M D a r c y - !----------------------------------------------------------------- - CASE(PROBLEM_PGM_TRANSIENT_DARCY_SUBTYPE) - SELECT CASE(PROBLEM_SETUP%SETUP_TYPE) - CASE(PROBLEM_SETUP_INITIAL_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Do nothing???? - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Do nothing??? - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for an ALE Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_CONTROL_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Set up a time control loop - CALL CONTROL_LOOP_CREATE_START(PROBLEM,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_TYPE_SET(CONTROL_LOOP,PROBLEM_CONTROL_TIME_LOOP_TYPE,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Finish the control loops - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_CREATE_FINISH(CONTROL_LOOP,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for an ALE Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVERS_TYPE) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Start the solvers creation - CALL SOLVERS_CREATE_START(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_NUMBER_SET(SOLVERS,2,err,error,*999) - ! - !Set the first solver to be a linear solver for the material update - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER_MAT_PROPERTIES,err,error,*999) - CALL SOLVER_TYPE_SET(SOLVER_MAT_PROPERTIES,SOLVER_LINEAR_TYPE,err,error,*999) - CALL SOLVER_LIBRARY_TYPE_SET(SOLVER_MAT_PROPERTIES,SOLVER_PETSC_LIBRARY,err,error,*999) - ! - !Set the second solver to be a first order dynamic solver for the ALE Darcy - CALL SOLVERS_SOLVER_GET(SOLVERS,2,SOLVER,err,error,*999) - CALL SOLVER_TYPE_SET(SOLVER,SOLVER_DYNAMIC_TYPE,err,error,*999) - CALL SOLVER_DYNAMIC_ORDER_SET(SOLVER,SOLVER_DYNAMIC_FIRST_ORDER,err,error,*999) - !Set solver defaults - CALL SOLVER_DYNAMIC_DEGREE_SET(SOLVER,SOLVER_DYNAMIC_FIRST_DEGREE,err,error,*999) - CALL SOLVER_DYNAMIC_SCHEME_SET(SOLVER,SOLVER_DYNAMIC_CRANK_NICOLSON_SCHEME,err,error,*999) - CALL SOLVER_LIBRARY_TYPE_SET(SOLVER,SOLVER_CMISS_LIBRARY,err,error,*999) -! CALL SOLVER_LIBRARY_TYPE_SET(SOLVER,SOLVER_PETSC_LIBRARY,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the solvers - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - !Finish the solvers creation - CALL SOLVERS_CREATE_FINISH(SOLVERS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for an ALE Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVER_EQUATIONS_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Get the control loop and solvers - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - !Get the material-properties solver and create the material-properties solver equations - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER_MAT_PROPERTIES,err,error,*999) - CALL SOLVER_EQUATIONS_CREATE_START(SOLVER_MAT_PROPERTIES,SOLVER_EQUATIONS_MAT_PROPERTIES,err,error,*999) - CALL SOLVER_EQUATIONS_LINEARITY_TYPE_SET(SOLVER_EQUATIONS_MAT_PROPERTIES,SOLVER_EQUATIONS_LINEAR,err,error,*999) - CALL SOLVER_EQUATIONS_TIME_DEPENDENCE_TYPE_SET(SOLVER_EQUATIONS_MAT_PROPERTIES,SOLVER_EQUATIONS_QUASISTATIC, & - & err,error,*999) - CALL SOLVER_EQUATIONS_SPARSITY_TYPE_SET(SOLVER_EQUATIONS_MAT_PROPERTIES,SOLVER_SPARSE_MATRICES,err,error,*999) - !Get the Darcy-ALE solver and create the Darcy-ALE solver equations - CALL SOLVERS_SOLVER_GET(SOLVERS,2,SOLVER,err,error,*999) - CALL SOLVER_EQUATIONS_CREATE_START(SOLVER,SOLVER_EQUATIONS,err,error,*999) - CALL SOLVER_EQUATIONS_LINEARITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_LINEAR,err,error,*999) - CALL SOLVER_EQUATIONS_TIME_DEPENDENCE_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_FIRST_ORDER_DYNAMIC,err,error,*999) - CALL SOLVER_EQUATIONS_SPARSITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_SPARSE_MATRICES,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - !Finish the creation of the material-properties solver equations - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER_MAT_PROPERTIES,err,error,*999) - CALL SOLVER_SOLVER_EQUATIONS_GET(SOLVER_MAT_PROPERTIES,SOLVER_EQUATIONS_MAT_PROPERTIES,err,error,*999) - CALL SOLVER_EQUATIONS_CREATE_FINISH(SOLVER_EQUATIONS_MAT_PROPERTIES,err,error,*999) - !Finish the creation of the Darcy-ALE solver equations - CALL SOLVERS_SOLVER_GET(SOLVERS,2,SOLVER,err,error,*999) - CALL SOLVER_SOLVER_EQUATIONS_GET(SOLVER,SOLVER_EQUATIONS,err,error,*999) - CALL SOLVER_EQUATIONS_CREATE_FINISH(SOLVER_EQUATIONS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for an ALE Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for an ALE Darcy equation." - CALL FlagError(localError,err,error,*999) - END SELECT - - !----------------------------------------------------------------- - ! d y n a m i c D a r c y - !----------------------------------------------------------------- - CASE(PROBLEM_TRANSIENT_DARCY_SUBTYPE) - SELECT CASE(PROBLEM_SETUP%SETUP_TYPE) - CASE(PROBLEM_SETUP_INITIAL_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Do nothing???? - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Do nothing???? - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a transient Darcy fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_CONTROL_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Set up a time control loop - CALL CONTROL_LOOP_CREATE_START(PROBLEM,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_TYPE_SET(CONTROL_LOOP,PROBLEM_CONTROL_TIME_LOOP_TYPE,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Finish the control loops - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_CREATE_FINISH(CONTROL_LOOP,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a transient Darcy fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVERS_TYPE) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Start the solvers creation - CALL SOLVERS_CREATE_START(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_NUMBER_SET(SOLVERS,1,err,error,*999) - !Set the solver to be a first order dynamic solver - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - CALL SOLVER_TYPE_SET(SOLVER,SOLVER_DYNAMIC_TYPE,err,error,*999) - CALL SOLVER_DYNAMIC_ORDER_SET(SOLVER,SOLVER_DYNAMIC_FIRST_ORDER,err,error,*999) - !Set solver defaults - CALL SOLVER_DYNAMIC_DEGREE_SET(SOLVER,SOLVER_DYNAMIC_FIRST_DEGREE,err,error,*999) - CALL SOLVER_DYNAMIC_SCHEME_SET(SOLVER,SOLVER_DYNAMIC_CRANK_NICOLSON_SCHEME,err,error,*999) - CALL SOLVER_LIBRARY_TYPE_SET(SOLVER,SOLVER_CMISS_LIBRARY,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the solvers - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - !Finish the solvers creation - CALL SOLVERS_CREATE_FINISH(SOLVERS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a transient Darcy fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVER_EQUATIONS_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - !Get the solver - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - !Create the solver equations - CALL SOLVER_EQUATIONS_CREATE_START(SOLVER,SOLVER_EQUATIONS,err,error,*999) - CALL SOLVER_EQUATIONS_LINEARITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_LINEAR,err,error,*999) - CALL SOLVER_EQUATIONS_TIME_DEPENDENCE_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_FIRST_ORDER_DYNAMIC,& - & err,error,*999) - CALL SOLVER_EQUATIONS_SPARSITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_SPARSE_MATRICES,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - !Get the solver equations - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - CALL SOLVER_SOLVER_EQUATIONS_GET(SOLVER,SOLVER_EQUATIONS,err,error,*999) - !Finish the solver equations creation - CALL SOLVER_EQUATIONS_CREATE_FINISH(SOLVER_EQUATIONS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a transient Darcy fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a transient Darcy fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - - !----------------------------------------------------------------- - ! c a s e d e f a u l t - !----------------------------------------------------------------- - CASE DEFAULT - localError="The problem subtype of "//TRIM(NumberToVString(PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " does not equal a standard, quasistatic or ALE Darcy equation subtype." - CALL FlagError(localError,err,error,*999) - - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - -! EXITS("DARCY_EQUATION_PROBLEM_STANDARD_SETUP") - EXITS("DARCY_EQUATION_PROBLEM_SETUP") - RETURN -! 999 ERRORSEXITS("DARCY_EQUATION_PROBLEM_STANDARD_SETUP",err,error) -999 ERRORSEXITS("DARCY_EQUATION_PROBLEM_SETUP",err,error) - RETURN 1 -! END SUBROUTINE DARCY_EQUATION_PROBLEM_STANDARD_SETUP - END SUBROUTINE DARCY_EQUATION_PROBLEM_SETUP - - ! - !================================================================================================================================ - ! - - !>Sets up the Darcy problem pre-solve. - SUBROUTINE DARCY_EQUATION_PRE_SOLVE(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !SOLVER%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN - SOLVER_MAPPING=>SOLVER_equations%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING)) THEN - SOLVER_MATRICES=>SOLVER_equations%SOLVER_MATRICES - IF(ASSOCIATED(SOLVER_MATRICES)) THEN - DO solver_matrix_idx=1,SOLVER_MAPPING%NUMBER_OF_SOLVER_MATRICES - SOLVER_MATRIX=>SOLVER_MATRICES%matrices(solver_matrix_idx)%ptr - IF(ASSOCIATED(SOLVER_MATRIX)) THEN - SOLVER_MATRIX%UPDATE_MATRIX=.TRUE. - ELSE - CALL FlagError("Solver Matrix is not associated.",err,error,*999) - ENDIF - ENDDO - ELSE - CALL FlagError("Solver Matrices is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver mapping is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver equations is not associated.",err,error,*999) - ENDIF - - !--- pre_solve calls for various actions - SELECT CASE(CONTROL_LOOP%PROBLEM%SPECIFICATION(3)) - CASE(PROBLEM_STANDARD_DARCY_SUBTYPE) - ! do nothing - CASE(PROBLEM_QUASISTATIC_DARCY_SUBTYPE) - ! do nothing - CASE(PROBLEM_TRANSIENT_DARCY_SUBTYPE) - CALL Darcy_PreSolveUpdateBoundaryConditions(CONTROL_LOOP,SOLVER,err,error,*999) - CASE(PROBLEM_QUASISTATIC_ELASTICITY_TRANSIENT_DARCY_SUBTYPE) - - IF((CONTROL_LOOP%LOOP_TYPE==PROBLEM_CONTROL_SIMPLE_TYPE.OR.CONTROL_LOOP%LOOP_TYPE==PROBLEM_CONTROL_TIME_LOOP_TYPE) & - & .AND.SOLVER%GLOBAL_NUMBER==SOLVER_NUMBER_DARCY) THEN - !--- flags to ensure once-per-time-step output in conjunction with diagnostics - idebug1 = .TRUE. - idebug2 = .TRUE. - idebug3 = .TRUE. - - NULLIFY(SOLVER_ALE_DARCY) - CALL SOLVERS_SOLVER_GET(SOLVER%SOLVERS,SOLVER_NUMBER_DARCY,SOLVER_ALE_DARCY,err,error,*999) - EQUATIONS=>SOLVER_ALE_DARCY%SOLVER_equations%SOLVER_MAPPING%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS - IF(ASSOCIATED(EQUATIONS)) THEN - EQUATIONS_SET=>equations%equationsSet - IF(ASSOCIATED(EQUATIONS_SET)) THEN - IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN - IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_INCOMP_ELAST_DARCY_ANALYTIC_DARCY)THEN - !call only analytic update and DO NOT call the other standard pre-solve routines as the mesh does not require deformation - CALL Darcy_PreSolveUpdateAnalyticValues(CONTROL_LOOP,SOLVER_ALE_DARCY,err,error,*999) - ENDIF - ELSE - !default - !--- 1.1 Transfer solid displacement to Darcy geometric field - CALL Darcy_PreSolveGetSolidDisplacement(CONTROL_LOOP,SOLVER_ALE_DARCY,err,error,*999) - - !--- 1.2 Update the mesh (and calculate boundary velocities) PRIOR to solving for new material properties - CALL DARCY_EQUATION_PRE_SOLVE_ALE_UPDATE_MESH(CONTROL_LOOP,SOLVER_ALE_DARCY,err,error,*999) - - ! ! ! !i n p r i n c i p l e c u r r e n t l y d o n o t n e e d t o u p d a t e B C s - ! ! ! !unless: - ! ! ! !--- 1.3 Apply both normal and moving mesh boundary conditions, OR: - ! ! ! !--- 1.3 (Iteratively) Render the boundary impermeable (ellipsoid, general curvilinear mesh) - ! ! ! CALL Darcy_PreSolveUpdateBoundaryConditions(CONTROL_LOOP,SOLVER_ALE_DARCY,err,error,*999) - ENDIF - ENDIF - ENDIF - END IF - CASE(PROBLEM_ALE_DARCY_SUBTYPE,PROBLEM_PGM_DARCY_SUBTYPE,PROBLEM_STANDARD_ELASTICITY_DARCY_SUBTYPE, & - & PROBLEM_PGM_ELASTICITY_DARCY_SUBTYPE,PROBLEM_PGM_TRANSIENT_DARCY_SUBTYPE, & - & PROBLEM_QUASISTATIC_ELAST_TRANS_DARCY_MAT_SOLVE_SUBTYPE) - - IF((CONTROL_LOOP%LOOP_TYPE==PROBLEM_CONTROL_SIMPLE_TYPE.OR.CONTROL_LOOP%LOOP_TYPE==PROBLEM_CONTROL_TIME_LOOP_TYPE) & - & .AND.SOLVER%GLOBAL_NUMBER==SOLVER_NUMBER_MAT_PROPERTIES) THEN - !--- flags to ensure once-per-time-step output in conjunction with diagnostics - idebug1 = .TRUE. - idebug2 = .TRUE. - idebug3 = .TRUE. - - NULLIFY(SOLVER_ALE_DARCY) - CALL SOLVERS_SOLVER_GET(SOLVER%SOLVERS,SOLVER_NUMBER_DARCY,SOLVER_ALE_DARCY,err,error,*999) - EQUATIONS=>SOLVER_ALE_DARCY%SOLVER_equations%SOLVER_MAPPING%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS - IF(ASSOCIATED(EQUATIONS)) THEN - EQUATIONS_SET=>equations%equationsSet - IF(ASSOCIATED(EQUATIONS_SET)) THEN - IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN - IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_INCOMP_ELAST_DARCY_ANALYTIC_DARCY)THEN - !call only analytic update and DO NOT call the other standard pre-solve routines as the mesh does not require deformation - CALL Darcy_PreSolveUpdateAnalyticValues(CONTROL_LOOP,SOLVER_ALE_DARCY,err,error,*999) - ENDIF - ELSE - !default - !--- 1.1 Transfer solid displacement to Darcy geometric field - CALL Darcy_PreSolveGetSolidDisplacement(CONTROL_LOOP,SOLVER_ALE_DARCY,err,error,*999) - - !--- 1.2 Update the mesh (and calculate boundary velocities) PRIOR to solving for new material properties - CALL DARCY_EQUATION_PRE_SOLVE_ALE_UPDATE_MESH(CONTROL_LOOP,SOLVER_ALE_DARCY,err,error,*999) - - ! ! ! !i n p r i n c i p l e c u r r e n t l y d o n o t n e e d t o u p d a t e B C s - ! ! ! !--- 1.3 Apply both normal and moving mesh boundary conditions - ! ! ! CALL Darcy_PreSolveUpdateBoundaryConditions(CONTROL_LOOP,SOLVER_ALE_DARCY,err,error,*999) - ENDIF - ENDIF - ENDIF - ELSE IF((CONTROL_LOOP%LOOP_TYPE==PROBLEM_CONTROL_SIMPLE_TYPE.OR. & - & CONTROL_LOOP%LOOP_TYPE==PROBLEM_CONTROL_TIME_LOOP_TYPE).AND.SOLVER%GLOBAL_NUMBER==SOLVER_NUMBER_DARCY) THEN -! ! ! !n o t f o r n o w ! ! ! -! ! ! !--- 2.1 Update the material field -! ! ! CALL Darcy_PreSolveUpdateMatrixProperties(CONTROL_LOOP,SOLVER,err,error,*999) - END IF - CASE DEFAULT - localError="Problem subtype "//TRIM(NumberToVString(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - - EXITS("DARCY_EQUATION_PRE_SOLVE") - RETURN -999 ERRORSEXITS("DARCY_EQUATION_PRE_SOLVE",err,error) - RETURN 1 - END SUBROUTINE DARCY_EQUATION_PRE_SOLVE - - ! - !================================================================================================================================ - ! - - SUBROUTINE DARCY_CONTROL_TIME_LOOP_PRE_LOOP(CONTROL_LOOP,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !=CONTROL_LOOP_PROGRESS_OUTPUT) THEN - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,'== Storing reference data',err,error,*999) - ENDIF - CALL Darcy_PreSolveStoreReferenceData(CONTROL_LOOP,SOLVER_DARCY,err,error,*999) - ENDIF - - !Store data of previous time step (mesh position); executed once per time step before subiteration - IF(CONTROL_LOOP%outputType>=CONTROL_LOOP_PROGRESS_OUTPUT) THEN - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,'== Storing previous data',err,error,*999) - ENDIF - CALL Darcy_PreSolveStorePreviousData(CONTROL_LOOP,SOLVER_DARCY,err,error,*999) - - EXITS("DARCY_CONTROL_TIME_LOOP_PRE_LOOP") - RETURN -999 ERRORSEXITS("DARCY_CONTROL_TIME_LOOP_PRE_LOOP",err,error) - RETURN 1 - END SUBROUTINE DARCY_CONTROL_TIME_LOOP_PRE_LOOP - - ! - !================================================================================================================================ - ! - - !>Store some reference data for ALE Darcy problem - SUBROUTINE Darcy_PreSolveStoreReferenceData(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !SOLVER%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN - SOLVER_MAPPING=>SOLVER_equations%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING)) THEN - DO equations_set_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS - EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(equations_set_idx)%ptr - IF(ASSOCIATED(EQUATIONS_SET)) THEN - IF(.NOT.ALLOCATED(EQUATIONS_SET%SPECIFICATION)) THEN - CALL FlagError("Equations set specification is not allocated.",err,error,*999) - ELSE IF(SIZE(EQUATIONS_SET%SPECIFICATION,1)/=3) THEN - CALL FlagError("Equations set specification must have three entries for a Darcy type equations set.", & - & err,error,*999) - END IF - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE) - ! do nothing - CASE(EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE) - ! do nothing - CASE(EQUATIONS_SET_TRANSIENT_DARCY_SUBTYPE) - ! do nothing - CASE(EQUATIONS_SET_ALE_DARCY_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE,EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - dependentField=>EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD - geometricField=>EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD - IF(ASSOCIATED(dependentField).AND.ASSOCIATED(geometricField)) THEN - !--- Store the initial (= reference) GEOMETRY field values - ALPHA = 1.0_DP - CALL FIELD_PARAMETER_SETS_COPY(geometricField,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,FIELD_INITIAL_VALUES_SET_TYPE,ALPHA,err,error,*999) - NULLIFY(vectorEquations) - CALL Equations_VectorEquationsGet(EQUATIONS_SET%equations,vectorEquations,err,error,*999) - vectorMapping=>vectorEquations%vectorMapping - IF(ASSOCIATED(vectorMapping)) THEN - - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_ALE_DARCY_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE) - FIELD_VARIABLE=>vectorMapping%linearMapping%equationsMatrixToVarMaps(1)%VARIABLE - ! '1' associated with linear matrix - CASE(EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE,EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - FIELD_VARIABLE=>vectorMapping%dynamicMapping%equationsMatrixToVarMaps(1)%VARIABLE - END SELECT - - IF(ASSOCIATED(FIELD_VARIABLE)) THEN - FIELD_VAR_TYPE=FIELD_VARIABLE%VARIABLE_TYPE - !--- Store the initial DEPENDENT field values - ALPHA = 1.0_DP - CALL FIELD_PARAMETER_SETS_COPY(dependentField,FIELD_VAR_TYPE, & - & FIELD_VALUES_SET_TYPE,FIELD_INITIAL_VALUES_SET_TYPE,ALPHA,err,error,*999) - - IF(DIAGNOSTICS1) THEN - NULLIFY(INITIAL_VALUES) - CALL FIELD_PARAMETER_SET_DATA_GET(dependentField,FIELD_VAR_TYPE, & - & FIELD_INITIAL_VALUES_SET_TYPE,INITIAL_VALUES,err,error,*999) - NDOFS_TO_PRINT = SIZE(INITIAL_VALUES,1) - CALL WRITE_STRING_VECTOR(DIAGNOSTIC_OUTPUT_TYPE,1,1,NDOFS_TO_PRINT,NDOFS_TO_PRINT,NDOFS_TO_PRINT,& - & INITIAL_VALUES, & - & '(" dependentField,FIELD_U_VARIABLE_TYPE,FIELD_INITIAL_VALUES_SET_TYPE = ",4(X,E13.6))', & - & '4(4(X,E13.6))',err,error,*999) - CALL FIELD_PARAMETER_SET_DATA_RESTORE(dependentField,FIELD_VAR_TYPE, & - & FIELD_INITIAL_VALUES_SET_TYPE,INITIAL_VALUES,err,error,*999) - ENDIF - ELSE - CALL FlagError("FIELD_VAR_TYPE is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("vectorMapping is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Dependent field and / or geometric field is / are not associated.",err,error,*999) - ENDIF - CASE DEFAULT - localError="Equations set subtype " & - & //TRIM(NumberToVString(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - ENDIF - ENDDO - ELSE - CALL FlagError("Solver mapping is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver equations is not associated.",err,error,*999) - ENDIF - CASE DEFAULT - localError="Problem subtype "//TRIM(NumberToVString(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - ! do nothing - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - - - EXITS("Darcy_PreSolveStoreReferenceData") - RETURN -999 ERRORSEXITS("Darcy_PreSolveStoreReferenceData",err,error) - RETURN 1 - - END SUBROUTINE Darcy_PreSolveStoreReferenceData - - ! - !================================================================================================================================ - ! - - !>Store data of previous time step (mesh position) for ALE Darcy problem - SUBROUTINE Darcy_PreSolveStorePreviousData(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !SOLVER%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN - SOLVER_MAPPING=>SOLVER_equations%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING)) THEN - EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(1)%ptr - IF(ASSOCIATED(EQUATIONS_SET)) THEN - IF(.NOT.ALLOCATED(EQUATIONS_SET%SPECIFICATION)) THEN - CALL FlagError("Equations set specification is not allocated.",err,error,*999) - ELSE IF(SIZE(EQUATIONS_SET%SPECIFICATION,1)/=3) THEN - CALL FlagError("Equations set specification must have three entries for a Darcy type equations set.", & - & err,error,*999) - END IF - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE) - ! do nothing - CASE(EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE) - ! do nothing - CASE(EQUATIONS_SET_TRANSIENT_DARCY_SUBTYPE) - ! do nothing - CASE(EQUATIONS_SET_ALE_DARCY_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE,EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - geometricField=>EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD - IF(ASSOCIATED(geometricField)) THEN - !--- Store the GEOMETRY field values of the previous time step - ALPHA = 1.0_DP - CALL FIELD_PARAMETER_SETS_COPY(geometricField,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,FIELD_PREVIOUS_VALUES_SET_TYPE,ALPHA,err,error,*999) - ELSE - CALL FlagError("Dependent field and / or geometric field is / are not associated.",err,error,*999) - ENDIF - CASE DEFAULT - localError="Equations set subtype " & - & //TRIM(NumberToVString(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver mapping is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver equations is not associated.",err,error,*999) - ENDIF - CASE DEFAULT - localError="Problem subtype "//TRIM(NumberToVString(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - ! do nothing - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - - EXITS("Darcy_PreSolveStorePreviousData") - RETURN -999 ERRORSEXITS("Darcy_PreSolveStorePreviousData",err,error) - RETURN 1 - - END SUBROUTINE Darcy_PreSolveStorePreviousData - - ! - !================================================================================================================================ - ! - - !>Update mesh position and velocity for ALE Darcy problem - SUBROUTINE DARCY_EQUATION_PRE_SOLVE_ALE_UPDATE_MESH(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !CONTROL_LOOP - DO loop_idx=1,CONTROL_LOOP%CONTROL_LOOP_LEVEL - IF(CONTROL_TIME_LOOP%LOOP_TYPE==PROBLEM_CONTROL_TIME_LOOP_TYPE) THEN - CALL CONTROL_LOOP_CURRENT_TIMES_GET(CONTROL_TIME_LOOP,CURRENT_TIME,TIME_INCREMENT,err,error,*999) - EXIT - ENDIF - IF (ASSOCIATED(CONTROL_LOOP%PARENT_LOOP)) THEN - CONTROL_TIME_LOOP=>CONTROL_TIME_LOOP%PARENT_LOOP - ELSE - CALL FlagError("Could not find a time control loop.",err,error,*999) - ENDIF - ENDDO - - IF(ASSOCIATED(SOLVER)) THEN - IF(ASSOCIATED(CONTROL_LOOP%PROBLEM)) THEN - IF(.NOT.ALLOCATED(CONTROL_LOOP%PROBLEM%SPECIFICATION)) THEN - CALL FlagError("Problem specification is not allocated.",err,error,*999) - ELSE IF(SIZE(CONTROL_LOOP%PROBLEM%SPECIFICATION,1)<3) THEN - CALL FlagError("Problem specification must have three entries for a Darcy equation problem.",err,error,*999) - END IF - PROBLEM_SUBTYPE=CONTROL_LOOP%PROBLEM%SPECIFICATION(3) - SELECT CASE(PROBLEM_SUBTYPE) - CASE(PROBLEM_STANDARD_DARCY_SUBTYPE) - ! do nothing - CASE(PROBLEM_QUASISTATIC_DARCY_SUBTYPE) - ! do nothing - CASE(PROBLEM_TRANSIENT_DARCY_SUBTYPE) - ! do nothing - CASE(PROBLEM_ALE_DARCY_SUBTYPE,PROBLEM_STANDARD_ELASTICITY_DARCY_SUBTYPE,PROBLEM_PGM_DARCY_SUBTYPE, & - & PROBLEM_PGM_ELASTICITY_DARCY_SUBTYPE,PROBLEM_PGM_TRANSIENT_DARCY_SUBTYPE, & - & PROBLEM_QUASISTATIC_ELASTICITY_TRANSIENT_DARCY_SUBTYPE,PROBLEM_QUASISTATIC_ELAST_TRANS_DARCY_MAT_SOLVE_SUBTYPE) - IF(SOLVER%GLOBAL_NUMBER==SOLVER_NUMBER_DARCY) THEN - SOLVER_EQUATIONS=>SOLVER%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN - SOLVER_MAPPING=>SOLVER_equations%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING)) THEN - EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(1)%ptr - IF(ASSOCIATED(EQUATIONS_SET)) THEN - IF(.NOT.ALLOCATED(EQUATIONS_SET%SPECIFICATION)) THEN - CALL FlagError("Equations set specification is not allocated.",err,error,*999) - ELSE IF(SIZE(EQUATIONS_SET%SPECIFICATION,1)/=3) THEN - CALL FlagError("Equations set specification must have three entries for a Darcy type equations set.", & - & err,error,*999) - END IF - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE) - ! do nothing - CASE(EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE) - ! do nothing - CASE(EQUATIONS_SET_ALE_DARCY_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE,EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - IF(SOLVER%outputType>=SOLVER_PROGRESS_OUTPUT) THEN - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Darcy update mesh ... ",err,error,*999) - ENDIF - geometricField=>EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD - IF(ASSOCIATED(geometricField)) THEN - !--- First, get pointer to mesh displacement values - NULLIFY(MESH_DISPLACEMENT_VALUES) - CALL FIELD_PARAMETER_SET_DATA_GET(geometricField,FIELD_U_VARIABLE_TYPE, & - & FIELD_MESH_DISPLACEMENT_SET_TYPE,MESH_DISPLACEMENT_VALUES,err,error,*999) - IF(DIAGNOSTICS1) THEN - NDOFS_TO_PRINT = SIZE(MESH_DISPLACEMENT_VALUES,1) - CALL WRITE_STRING_VECTOR(DIAGNOSTIC_OUTPUT_TYPE,1,1,NDOFS_TO_PRINT,NDOFS_TO_PRINT,NDOFS_TO_PRINT,& - & MESH_DISPLACEMENT_VALUES,'(" MESH_DISPLACEMENT_VALUES = ",3(X,E13.6))','3(3(X,E13.6))', & - & err,error,*999) - ENDIF - - NUMBER_OF_DOFS = geometricField%VARIABLE_TYPE_MAP(FIELD_U_VARIABLE_TYPE)%ptr%NUMBER_OF_DOFS - - IF(PROBLEM_SUBTYPE==PROBLEM_QUASISTATIC_ELASTICITY_TRANSIENT_DARCY_SUBTYPE & - & .OR. PROBLEM_SUBTYPE==PROBLEM_QUASISTATIC_ELAST_TRANS_DARCY_MAT_SOLVE_SUBTYPE & - & .OR. PROBLEM_SUBTYPE==PROBLEM_STANDARD_ELASTICITY_DARCY_SUBTYPE) THEN - !--- Don't update geometric field here, this is done in - ! darcy_equation_pre_solve_get_solid_displacement for these problems, but - ! needs to be made consistent between the different problem types - ELSE - !--- Second, update geometric field - DO dof_number=1,NUMBER_OF_DOFS - CALL FIELD_PARAMETER_SET_ADD_LOCAL_DOF(geometricField, & - & FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,dof_number, & - & MESH_DISPLACEMENT_VALUES(dof_number), & - & err,error,*999) - END DO - CALL FIELD_PARAMETER_SET_UPDATE_START(geometricField, & - & FIELD_U_VARIABLE_TYPE, FIELD_VALUES_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(geometricField, & - & FIELD_U_VARIABLE_TYPE, FIELD_VALUES_SET_TYPE,err,error,*999) - ENDIF - - !--- Third, use displacement values to calculate velocity values - ALPHA=1.0_DP/TIME_INCREMENT - CALL FIELD_PARAMETER_SETS_COPY(geometricField,FIELD_U_VARIABLE_TYPE, & - & FIELD_MESH_DISPLACEMENT_SET_TYPE,FIELD_MESH_VELOCITY_SET_TYPE,ALPHA,err,error,*999) - CALL FIELD_PARAMETER_SET_DATA_RESTORE(geometricField,FIELD_U_VARIABLE_TYPE, & - & FIELD_MESH_DISPLACEMENT_SET_TYPE,MESH_DISPLACEMENT_VALUES,err,error,*999) - ELSE - CALL FlagError("Geometric field is not associated.",err,error,*999) - ENDIF - CASE DEFAULT - localError="Equations set subtype " & - & //TRIM(NumberToVString(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver mapping is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver equations is not associated.",err,error,*999) - ENDIF - ELSE - ! do nothing - ENDIF - CASE DEFAULT - localError="Problem subtype "//TRIM(NumberToVString(PROBLEM_SUBTYPE,"*",err,error))// & - & " is not valid for a Darcy equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - - EXITS("DARCY_EQUATION_PRE_SOLVE_ALE_UPDATE_MESH") - RETURN -999 ERRORSEXITS("DARCY_EQUATION_PRE_SOLVE_ALE_UPDATE_MESH",err,error) - RETURN 1 - END SUBROUTINE DARCY_EQUATION_PRE_SOLVE_ALE_UPDATE_MESH - - ! - !================================================================================================================================ - ! - - !>Update boundary conditions for Darcy equation pre solve - SUBROUTINE Darcy_PreSolveUpdateBoundaryConditions(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !CONTROL_LOOP - DO loop_idx=1,CONTROL_LOOP%CONTROL_LOOP_LEVEL - IF(CONTROL_TIME_LOOP%LOOP_TYPE==PROBLEM_CONTROL_TIME_LOOP_TYPE) THEN - CALL CONTROL_LOOP_CURRENT_TIMES_GET(CONTROL_TIME_LOOP,CURRENT_TIME,TIME_INCREMENT,err,error,*999) - EXIT - ENDIF - IF (ASSOCIATED(CONTROL_LOOP%PARENT_LOOP)) THEN - CONTROL_TIME_LOOP=>CONTROL_TIME_LOOP%PARENT_LOOP - ELSE - CALL FlagError("Could not find a time control loop.",err,error,*999) - ENDIF - ENDDO - - IF(ASSOCIATED(SOLVER)) THEN - IF(SOLVER%GLOBAL_NUMBER==SOLVER_NUMBER_DARCY) THEN - IF(ASSOCIATED(CONTROL_LOOP%PROBLEM)) THEN - IF(.NOT.ALLOCATED(CONTROL_LOOP%PROBLEM%SPECIFICATION)) THEN - CALL FlagError("Problem specification is not allocated.",err,error,*999) - ELSE IF(SIZE(CONTROL_LOOP%PROBLEM%SPECIFICATION,1)<3) THEN - CALL FlagError("Problem specification must have three entries for a Darcy equation problem.",err,error,*999) - END IF - SELECT CASE(CONTROL_LOOP%PROBLEM%SPECIFICATION(3)) - CASE(PROBLEM_STANDARD_DARCY_SUBTYPE) - ! do nothing - CASE(PROBLEM_QUASISTATIC_DARCY_SUBTYPE) - ! do nothing - CASE(PROBLEM_TRANSIENT_DARCY_SUBTYPE) - ! do nothing - CASE(PROBLEM_ALE_DARCY_SUBTYPE,PROBLEM_PGM_DARCY_SUBTYPE,PROBLEM_STANDARD_ELASTICITY_DARCY_SUBTYPE, & - & PROBLEM_PGM_ELASTICITY_DARCY_SUBTYPE,PROBLEM_PGM_TRANSIENT_DARCY_SUBTYPE, & - & PROBLEM_QUASISTATIC_ELASTICITY_TRANSIENT_DARCY_SUBTYPE,PROBLEM_QUASISTATIC_ELAST_TRANS_DARCY_MAT_SOLVE_SUBTYPE) - SOLVER_EQUATIONS=>SOLVER%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN - SOLVER_MAPPING=>SOLVER_equations%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING)) THEN - EQUATIONS=>SOLVER_MAPPING%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS - IF(ASSOCIATED(EQUATIONS)) THEN - EQUATIONS_SET=>equations%equationsSet - IF(ASSOCIATED(EQUATIONS_SET)) THEN - IF(.NOT.ALLOCATED(EQUATIONS_SET%SPECIFICATION)) THEN - CALL FlagError("Equations set specification is not allocated.",err,error,*999) - ELSE IF(SIZE(EQUATIONS_SET%SPECIFICATION,1)/=3) THEN - CALL FlagError("Equations set specification must have three entries for a Darcy type equations set.", & - & err,error,*999) - END IF - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE) - ! do nothing - CASE(EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE) - ! do nothing - CASE(EQUATIONS_SET_ALE_DARCY_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE,EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - IF(SOLVER%outputType>=SOLVER_PROGRESS_OUTPUT) THEN - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Darcy update boundary conditions ... ",err,error,*999) - ENDIF - dependentField=>EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD - geometricField=>EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD - IF(ASSOCIATED(dependentField).AND.ASSOCIATED(geometricField)) THEN - BOUNDARY_CONDITIONS=>SOLVER_equations%BOUNDARY_CONDITIONS - IF(ASSOCIATED(BOUNDARY_CONDITIONS)) THEN - vectorMapping=>EQUATIONS_SET%equations%vectorEquations%vectorMapping - IF(ASSOCIATED(vectorMapping)) THEN - - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_ALE_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE) - FIELD_VARIABLE=>vectorMapping%linearMapping%equationsMatrixToVarMaps(1)%VARIABLE - ! '1' associated with linear matrix - CASE(EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE, & - & EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - FIELD_VARIABLE=>vectorMapping%dynamicMapping%equationsMatrixToVarMaps(1)%VARIABLE - END SELECT - - IF(ASSOCIATED(FIELD_VARIABLE)) THEN - FIELD_VAR_TYPE=FIELD_VARIABLE%VARIABLE_TYPE - - CALL BOUNDARY_CONDITIONS_VARIABLE_GET(BOUNDARY_CONDITIONS,FIELD_VARIABLE, & - & BOUNDARY_CONDITIONS_VARIABLE,err,error,*999) - IF(ASSOCIATED(BOUNDARY_CONDITIONS_VARIABLE)) THEN - NULLIFY(MESH_VELOCITY_VALUES) - CALL FIELD_PARAMETER_SET_DATA_GET(geometricField,FIELD_U_VARIABLE_TYPE, & - & FIELD_MESH_VELOCITY_SET_TYPE,MESH_VELOCITY_VALUES,err,error,*999) - NULLIFY(INITIAL_VALUES) - CALL FIELD_PARAMETER_SET_DATA_GET(dependentField,FIELD_VAR_TYPE, & - & FIELD_INITIAL_VALUES_SET_TYPE,INITIAL_VALUES,err,error,*999) - IF(DIAGNOSTICS1) THEN - NULLIFY( DUMMY_VALUES1 ) - CALL FIELD_PARAMETER_SET_DATA_GET(dependentField,FIELD_VAR_TYPE, & - & FIELD_VALUES_SET_TYPE,DUMMY_VALUES1,err,error,*999) - NDOFS_TO_PRINT = SIZE(DUMMY_VALUES1,1) - CALL WRITE_STRING_VECTOR(DIAGNOSTIC_OUTPUT_TYPE,1,1,NDOFS_TO_PRINT,NDOFS_TO_PRINT, & - & NDOFS_TO_PRINT,DUMMY_VALUES1, & - & '(" dependentField,FIELD_VAR_TYPE,FIELD_VALUES_SET_TYPE (before) = ",4(X,E13.6))', & - & '4(4(X,E13.6))',err,error,*999) - ENDIF - NUMBER_OF_DOFS = dependentField%VARIABLE_TYPE_MAP(FIELD_VAR_TYPE)%ptr%NUMBER_OF_DOFS - DO dof_number=1,NUMBER_OF_DOFS - BOUNDARY_CONDITION_CHECK_VARIABLE=BOUNDARY_CONDITIONS_VARIABLE% & - & CONDITION_TYPES(dof_number) - IF(BOUNDARY_CONDITION_CHECK_VARIABLE==BOUNDARY_CONDITION_MOVED_WALL) THEN - !--- Reset boundary condition to the initial normal-velocity boundary condition - CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(dependentField, & - & FIELD_VAR_TYPE,FIELD_VALUES_SET_TYPE,dof_number, & - & INITIAL_VALUES(dof_number),err,error,*999) - !--- Add the velocity of the moving boundary on top of the initial boundary condition - !! === If we solve in terms of Darcy flow vector, then do not add mesh velocity === !! - !! === The BC is kept to the initial BC, for instance: null-flux === !! -! CALL FIELD_PARAMETER_SET_ADD_LOCAL_DOF(dependentField, & -! & FIELD_VAR_TYPE,FIELD_VALUES_SET_TYPE,dof_number, & -! & MESH_VELOCITY_VALUES(dof_number),err,error,*999) -! ! dependent field ( V_u, V_v, V_w, P_p ) -! ! MESH_VELOCITY_VALUES ( V_u, V_v, V_w ) - - ELSE IF( BOUNDARY_CONDITION_CHECK_VARIABLE==BOUNDARY_CONDITION_FIXED .AND. & - & EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE) THEN - !\ToDo: Check component number; this way we can also apply it to velocity - !--- Set the time-dependent pressure BC - PRESSURE = INITIAL_VALUES(dof_number) * (1.0_DP - exp(- CURRENT_TIME**2.0_DP / 0.25_DP)) - - CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(dependentField, & - & FIELD_VAR_TYPE,FIELD_VALUES_SET_TYPE,dof_number, & - & PRESSURE,err,error,*999) - ELSE - ! do nothing - END IF - END DO - CALL FIELD_PARAMETER_SET_UPDATE_START(dependentField, & - & FIELD_VAR_TYPE, FIELD_VALUES_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(dependentField, & - & FIELD_VAR_TYPE, FIELD_VALUES_SET_TYPE,err,error,*999) - IF(DIAGNOSTICS1) THEN - NDOFS_TO_PRINT = SIZE(MESH_VELOCITY_VALUES,1) - CALL WRITE_STRING_VECTOR(DIAGNOSTIC_OUTPUT_TYPE,1,1,NDOFS_TO_PRINT,NDOFS_TO_PRINT, & - & NDOFS_TO_PRINT,MESH_VELOCITY_VALUES, & - & '(" MESH_VELOCITY_VALUES = ",4(X,E13.6))','4(4(X,E13.6))',err,error,*999) - CALL WRITE_STRING(DIAGNOSTIC_OUTPUT_TYPE," ",err,error,*999) - ! - NDOFS_TO_PRINT = SIZE(INITIAL_VALUES,1) - CALL WRITE_STRING_VECTOR(DIAGNOSTIC_OUTPUT_TYPE,1,1,NDOFS_TO_PRINT,NDOFS_TO_PRINT, & - & NDOFS_TO_PRINT,INITIAL_VALUES, & - & '(" INITIAL_VALUES = ",4(X,E13.6))', & - & '4(4(X,E13.6))',err,error,*999) - ! - NULLIFY( DUMMY_VALUES1 ) - CALL FIELD_PARAMETER_SET_DATA_GET(dependentField,FIELD_VAR_TYPE, & - & FIELD_VALUES_SET_TYPE,DUMMY_VALUES1,err,error,*999) - NDOFS_TO_PRINT = SIZE(DUMMY_VALUES1,1) - CALL WRITE_STRING_VECTOR(DIAGNOSTIC_OUTPUT_TYPE,1,1,NDOFS_TO_PRINT,NDOFS_TO_PRINT, & - & NDOFS_TO_PRINT,DUMMY_VALUES1, & - & '(" dependentField,FIELD_VAR_TYPE,FIELD_VALUES_SET_TYPE (after) = ",4(X,E13.6))', & - & '4(4(X,E13.6))',err,error,*999) - CALL FIELD_PARAMETER_SET_DATA_RESTORE(dependentField,FIELD_VAR_TYPE, & - & FIELD_VALUES_SET_TYPE,DUMMY_VALUES1,err,error,*999) - ENDIF - CALL FIELD_PARAMETER_SET_DATA_RESTORE(geometricField,FIELD_U_VARIABLE_TYPE, & - & FIELD_MESH_VELOCITY_SET_TYPE,MESH_VELOCITY_VALUES,err,error,*999) - CALL FIELD_PARAMETER_SET_DATA_RESTORE(dependentField,FIELD_VAR_TYPE, & - & FIELD_INITIAL_VALUES_SET_TYPE,INITIAL_VALUES,err,error,*999) - ELSE - CALL FlagError("Boundary condition variable is not associated.",err,error,*999) - END IF - - CALL FIELD_PARAMETER_SET_UPDATE_START(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_VAR_TYPE, & - & FIELD_VALUES_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_VAR_TYPE, & - & FIELD_VALUES_SET_TYPE,err,error,*999) - - ELSE - CALL FlagError("FIELD_VAR_TYPE is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("vectorMapping is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Boundary conditions are not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Dependent field and/or geometric field is/are not associated.",err,error,*999) - END IF - CASE DEFAULT - localError="Equations set subtype " & - & //TRIM(NumberToVString(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Equations are not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Solver mapping is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver equations are not associated.",err,error,*999) - END IF - CASE DEFAULT - localError="Problem subtype "//TRIM(NumberToVString(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - ! do nothing - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - - EXITS("Darcy_PreSolveUpdateBoundaryConditions") - RETURN -999 ERRORS("Darcy_PreSolveUpdateBoundaryConditions",err,error) - EXITS("Darcy_PreSolveUpdateBoundaryConditions") - RETURN 1 - - END SUBROUTINE Darcy_PreSolveUpdateBoundaryConditions - - ! - !================================================================================================================================ - ! - - !>Update materials field for ALE Darcy problem - SUBROUTINE Darcy_PreSolveUpdateMatrixProperties(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !=SOLVER_PROGRESS_OUTPUT) THEN - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Darcy update materials ... ",err,error,*999) - ENDIF - CALL SOLVERS_SOLVER_GET(SOLVER%SOLVERS,SOLVER_NUMBER_MAT_PROPERTIES,SOLVER_MAT_PROPERTIES,err,error,*999) - SOLVER_EQUATIONS_MAT_PROPERTIES=>SOLVER_MAT_PROPERTIES%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS_MAT_PROPERTIES)) THEN - SOLVER_MAPPING_MAT_PROPERTIES=>SOLVER_EQUATIONS_MAT_PROPERTIES%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING_MAT_PROPERTIES)) THEN - EQUATIONS_SET_MAT_PROPERTIES=>SOLVER_MAPPING_MAT_PROPERTIES%EQUATIONS_SETS(1)%ptr - IF(ASSOCIATED(EQUATIONS_SET_MAT_PROPERTIES)) THEN - DEPENDENT_FIELD_MAT_PROPERTIES=>EQUATIONS_SET_MAT_PROPERTIES%DEPENDENT%DEPENDENT_FIELD - IF(ASSOCIATED(DEPENDENT_FIELD_MAT_PROPERTIES)) THEN - CALL FIELD_NUMBER_OF_COMPONENTS_GET(DEPENDENT_FIELD_MAT_PROPERTIES, & - & FIELD_U_VARIABLE_TYPE,NUMBER_OF_COMPONENTS_DEPENDENT_FIELD_MAT_PROPERTIES,err,error,*999) - ELSE - CALL FlagError("DEPENDENT_FIELD_MAT_PROPERTIES is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Galerkin Projection equations set is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Galerkin Projection solver mapping is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Galerkin Projection solver equations are not associated.",err,error,*999) - END IF - - !--- Get the materials field for the ALE Darcy equations - CALL SOLVERS_SOLVER_GET(SOLVER%SOLVERS,SOLVER_NUMBER_DARCY,SOLVER_ALE_DARCY,err,error,*999) - SOLVER_EQUATIONS_ALE_DARCY=>SOLVER_ALE_DARCY%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS_ALE_DARCY)) THEN - SOLVER_MAPPING_ALE_DARCY=>SOLVER_EQUATIONS_ALE_DARCY%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING_ALE_DARCY)) THEN - EQUATIONS_SET_ALE_DARCY=>SOLVER_MAPPING_ALE_DARCY%EQUATIONS_SETS(1)%ptr - IF(ASSOCIATED(EQUATIONS_SET_ALE_DARCY)) THEN - MATERIALS_FIELD_ALE_DARCY=>EQUATIONS_SET_ALE_DARCY%MATERIALS%MATERIALS_FIELD - IF(ASSOCIATED(MATERIALS_FIELD_ALE_DARCY)) THEN - CALL FIELD_NUMBER_OF_COMPONENTS_GET(MATERIALS_FIELD_ALE_DARCY, & - & FIELD_U_VARIABLE_TYPE,NUMBER_OF_COMPONENTS_MATERIALS_FIELD_ALE_DARCY,err,error,*999) - ELSE - CALL FlagError("MATERIALS_FIELD_ALE_DARCY is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("ALE Darcy equations set is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("ALE Darcy solver mapping is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("ALE Darcy solver equations are not associated.",err,error,*999) - END IF - - !--- Copy the result from Galerkin-Projection's dependent field to ALE Darcy's material field - IF(NUMBER_OF_COMPONENTS_MATERIALS_FIELD_ALE_DARCY==NUMBER_OF_COMPONENTS_DEPENDENT_FIELD_MAT_PROPERTIES) THEN - DO I=1,NUMBER_OF_COMPONENTS_MATERIALS_FIELD_ALE_DARCY - CALL Field_ParametersToFieldParametersCopy(DEPENDENT_FIELD_MAT_PROPERTIES, & - & FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,I,MATERIALS_FIELD_ALE_DARCY, & - & FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,I,err,error,*999) - END DO - ELSE -! CALL FlagError("Dimension of Galerkin Projection and ALE Darcy equations set is not consistent",err,error,*999) - localError="Number of components of Galerkin-Projection dependent field "// & - & "is not consistent with ALE-Darcy-equation material field." - CALL FlagError(localError,err,error,*999) - END IF - - IF(DIAGNOSTICS3) THEN - NULLIFY( DUMMY_VALUES2 ) - CALL FIELD_PARAMETER_SET_DATA_GET(DEPENDENT_FIELD_MAT_PROPERTIES,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,DUMMY_VALUES2,err,error,*999) - NDOFS_TO_PRINT = SIZE(DUMMY_VALUES2,1) - CALL WRITE_STRING_VECTOR(DIAGNOSTIC_OUTPUT_TYPE,1,1,NDOFS_TO_PRINT,NDOFS_TO_PRINT,NDOFS_TO_PRINT,DUMMY_VALUES2, & - & '(" DEPENDENT_FIELD_MAT_PROPERTIES,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE = ",4(X,E13.6))',& - & '4(4(X,E13.6))',err,error,*999) - CALL FIELD_PARAMETER_SET_DATA_RESTORE(DEPENDENT_FIELD_MAT_PROPERTIES,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,DUMMY_VALUES2,err,error,*999) - ENDIF - - ELSE - ! do nothing - END IF - CASE DEFAULT - localError="The third problem specification of "// & - & TRIM(NumberToVString(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for Darcy_PreSolveUpdateMatrixProperties." - CALL FLAG_ERROR(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - - EXITS("Darcy_PreSolveUpdateMatrixProperties") - RETURN -999 ERRORS("Darcy_PreSolveUpdateMatrixProperties",err,error) - EXITS("Darcy_PreSolveUpdateMatrixProperties") - RETURN 1 - - END SUBROUTINE Darcy_PreSolveUpdateMatrixProperties - - ! - !================================================================================================================================ - ! - - !>Sets up the Darcy problem post solve. - SUBROUTINE DARCY_EQUATION_POST_SOLVE(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !Sets up the Darcy problem post solve output data. - SUBROUTINE DARCY_EQUATION_POST_SOLVE_OUTPUT_DATA(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !SOLVER%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN - SOLVER_MAPPING=>SOLVER_equations%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING)) THEN - !Make sure the equations sets are up to date - DO equations_set_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS - EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(equations_set_idx)%ptr - FILENAME="./output/"//"STATIC_SOLUTION" - METHOD="FORTRAN" - IF(SOLVER%outputType>=SOLVER_PROGRESS_OUTPUT) THEN - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"...",err,error,*999) - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Now export fields... ",err,error,*999) - ENDIF - Fields=>EQUATIONS_SET%REGION%FIELDS - CALL FIELD_IO_NODES_EXPORT(Fields,FILENAME,METHOD,err,error,*999) - CALL FIELD_IO_ELEMENTS_EXPORT(Fields,FILENAME,METHOD,err,error,*999) - NULLIFY(Fields) - ENDDO - ENDIF - ENDIF - CASE(PROBLEM_QUASISTATIC_DARCY_SUBTYPE, PROBLEM_ALE_DARCY_SUBTYPE, PROBLEM_PGM_DARCY_SUBTYPE, & - & PROBLEM_TRANSIENT_DARCY_SUBTYPE, PROBLEM_STANDARD_ELASTICITY_DARCY_SUBTYPE, & - & PROBLEM_PGM_ELASTICITY_DARCY_SUBTYPE,PROBLEM_PGM_TRANSIENT_DARCY_SUBTYPE, & - & PROBLEM_QUASISTATIC_ELASTICITY_TRANSIENT_DARCY_SUBTYPE,PROBLEM_QUASISTATIC_ELAST_TRANS_DARCY_MAT_SOLVE_SUBTYPE) - CALL CONTROL_LOOP_CURRENT_TIMES_GET(CONTROL_LOOP,CURRENT_TIME,TIME_INCREMENT,err,error,*999) - SOLVER_EQUATIONS=>SOLVER%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN - SOLVER_MAPPING=>SOLVER_equations%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING)) THEN - !Make sure the equations sets are up to date - DO equations_set_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS - EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(equations_set_idx)%ptr - IF(EQUATIONS_SET%SPECIFICATION(2)==EQUATIONS_SET_DARCY_EQUATION_TYPE)THEN - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE)THEN - CONTROL_TIME_LOOP=>CONTROL_LOOP - DO loop_idx=1,CONTROL_LOOP%CONTROL_LOOP_LEVEL - IF(CONTROL_TIME_LOOP%LOOP_TYPE==PROBLEM_CONTROL_TIME_LOOP_TYPE) THEN - CURRENT_LOOP_ITERATION=CONTROL_TIME_LOOP%TIME_LOOP%ITERATION_NUMBER - OUTPUT_ITERATION_NUMBER=CONTROL_TIME_LOOP%TIME_LOOP%OUTPUT_NUMBER - EXIT - ENDIF - IF (ASSOCIATED(CONTROL_LOOP%PARENT_LOOP)) THEN - CONTROL_TIME_LOOP=>CONTROL_TIME_LOOP%PARENT_LOOP - ELSE - CURRENT_LOOP_ITERATION=0 - OUTPUT_ITERATION_NUMBER=0 - ENDIF - ENDDO - IF(CONTROL_LOOP%PARENT_LOOP%LOOP_TYPE==PROBLEM_CONTROL_WHILE_LOOP_TYPE) THEN - SUBITERATION_NUMBER=CONTROL_LOOP%PARENT_LOOP%WHILE_LOOP%ITERATION_NUMBER - ENDIF - - IF(OUTPUT_ITERATION_NUMBER/=0) THEN - IF(CONTROL_TIME_LOOP%TIME_LOOP%CURRENT_TIME<=CONTROL_TIME_LOOP%TIME_LOOP%STOP_TIME) THEN - IF(CURRENT_LOOP_ITERATION<10) THEN - WRITE(OUTPUT_FILE,'("TIME_STEP_000",I0)') CURRENT_LOOP_ITERATION - ELSE IF(CURRENT_LOOP_ITERATION<100) THEN - WRITE(OUTPUT_FILE,'("TIME_STEP_00",I0)') CURRENT_LOOP_ITERATION - ELSE IF(CURRENT_LOOP_ITERATION<1000) THEN - WRITE(OUTPUT_FILE,'("TIME_STEP_0",I0)') CURRENT_LOOP_ITERATION - ELSE IF(CURRENT_LOOP_ITERATION<10000) THEN - WRITE(OUTPUT_FILE,'("TIME_STEP_",I0)') CURRENT_LOOP_ITERATION - END IF - - FILENAME="./output/"//"MainTime_"//TRIM(NumberToVString(CURRENT_LOOP_ITERATION,"*",err,error)) - METHOD="FORTRAN" - IF(MOD(CURRENT_LOOP_ITERATION,OUTPUT_ITERATION_NUMBER)==0) THEN - IF(CONTROL_LOOP%outputtype >= CONTROL_LOOP_PROGRESS_OUTPUT) THEN - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"...",err,error,*999) - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Now export fields... ",err,error,*999) - ENDIF - Fields=>EQUATIONS_SET%REGION%FIELDS - CALL FIELD_IO_NODES_EXPORT(Fields,FILENAME,METHOD,err,error,*999) - CALL FIELD_IO_ELEMENTS_EXPORT(Fields,FILENAME,METHOD,err,error,*999) - NULLIFY(Fields) - IF(CONTROL_LOOP%outputtype >= CONTROL_LOOP_PROGRESS_OUTPUT) THEN - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,FILENAME,err,error,*999) - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"...",err,error,*999) - ENDIF - END IF - ENDIF - ENDIF - - !Subiteration intermediate solutions / iterates output: -! IF(CONTROL_LOOP%PARENT_LOOP%LOOP_TYPE==PROBLEM_CONTROL_WHILE_LOOP_TYPE) THEN !subiteration exists -! IF(CURRENT_LOOP_ITERATION<10) THEN -! IF(SUBITERATION_NUMBER<10) THEN -! WRITE(OUTPUT_FILE,'("T_00",I0,"_SB_0",I0,"_C",I0)') CURRENT_LOOP_ITERATION,SUBITERATION_NUMBER, & -! & equations_set_idx -! ELSE IF(SUBITERATION_NUMBER<100) THEN -! WRITE(OUTPUT_FILE,'("T_00",I0,"_SB_",I0,"_C",I0)') CURRENT_LOOP_ITERATION,SUBITERATION_NUMBER, & -! & equations_set_idx -! END IF -! FILE=OUTPUT_FILE -! METHOD="FORTRAN" -! EXPORT_FIELD=.TRUE. -! IF(EXPORT_FIELD) THEN -! CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Darcy export subiterates ...",err,error,*999) -! CALL FLUID_MECHANICS_IO_WRITE_CMGUI(EQUATIONS_SET%REGION,EQUATIONS_SET%GLOBAL_NUMBER,FILE, & -! & err,error,*999) -! CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,OUTPUT_FILE,err,error,*999) -! ENDIF -! ENDIF -! ENDIF - - ELSE !for single compartment (i.e. standary Darcy flow) equations sets - !Find the time loop - CONTROL_TIME_LOOP=>CONTROL_LOOP - DO loop_idx=1,CONTROL_LOOP%CONTROL_LOOP_LEVEL - IF(CONTROL_TIME_LOOP%LOOP_TYPE==PROBLEM_CONTROL_TIME_LOOP_TYPE) THEN - CURRENT_LOOP_ITERATION=CONTROL_TIME_LOOP%TIME_LOOP%ITERATION_NUMBER - OUTPUT_ITERATION_NUMBER=CONTROL_TIME_LOOP%TIME_LOOP%OUTPUT_NUMBER - EXIT - ENDIF - IF (ASSOCIATED(CONTROL_LOOP%PARENT_LOOP)) THEN - CONTROL_TIME_LOOP=>CONTROL_TIME_LOOP%PARENT_LOOP - ELSE - CURRENT_LOOP_ITERATION=0 - OUTPUT_ITERATION_NUMBER=0 - ENDIF - ENDDO - !If coupled with finite elasticity and using subiterations, get the while loop iteration number - IF (ASSOCIATED(CONTROL_LOOP%PARENT_LOOP)) THEN - IF(CONTROL_LOOP%PARENT_LOOP%LOOP_TYPE==PROBLEM_CONTROL_WHILE_LOOP_TYPE) THEN - SUBITERATION_NUMBER=CONTROL_LOOP%PARENT_LOOP%WHILE_LOOP%ITERATION_NUMBER - ELSE - SUBITERATION_NUMBER=0 - ENDIF - ENDIF - - IF(OUTPUT_ITERATION_NUMBER/=0) THEN - IF(CONTROL_TIME_LOOP%TIME_LOOP%CURRENT_TIME<=CONTROL_TIME_LOOP%TIME_LOOP%STOP_TIME) THEN - IF(CURRENT_LOOP_ITERATION<10) THEN - WRITE(OUTPUT_FILE,'("TIME_STEP_000",I0)') CURRENT_LOOP_ITERATION - ELSE IF(CURRENT_LOOP_ITERATION<100) THEN - WRITE(OUTPUT_FILE,'("TIME_STEP_00",I0)') CURRENT_LOOP_ITERATION - ELSE IF(CURRENT_LOOP_ITERATION<1000) THEN - WRITE(OUTPUT_FILE,'("TIME_STEP_0",I0)') CURRENT_LOOP_ITERATION - ELSE IF(CURRENT_LOOP_ITERATION<10000) THEN - WRITE(OUTPUT_FILE,'("TIME_STEP_",I0)') CURRENT_LOOP_ITERATION - END IF - - FILENAME="./output/"//"MainTime_"//TRIM(NumberToVString(CURRENT_LOOP_ITERATION,"*",err,error)) - METHOD="FORTRAN" - IF(MOD(CURRENT_LOOP_ITERATION,OUTPUT_ITERATION_NUMBER)==0) THEN - IF(CONTROL_LOOP%outputtype >= CONTROL_LOOP_PROGRESS_OUTPUT) THEN - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"...",err,error,*999) - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Now export fields... ",err,error,*999) - ENDIF - Fields=>EQUATIONS_SET%REGION%FIELDS - CALL FIELD_IO_NODES_EXPORT(Fields,FILENAME,METHOD,err,error,*999) - CALL FIELD_IO_ELEMENTS_EXPORT(Fields,FILENAME,METHOD,err,error,*999) - NULLIFY(Fields) - IF(CONTROL_LOOP%outputtype >= CONTROL_LOOP_PROGRESS_OUTPUT) THEN - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,FILENAME,err,error,*999) - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"...",err,error,*999) - ENDIF - END IF - ENDIF - ENDIF - - -! !Subiteration intermediate solutions / iterates output: -! IF(CONTROL_LOOP%PARENT_LOOP%LOOP_TYPE==PROBLEM_CONTROL_WHILE_LOOP_TYPE) THEN !subiteration exists -! IF(CURRENT_LOOP_ITERATION<10) THEN -! IF(SUBITERATION_NUMBER<10) THEN -! WRITE(OUTPUT_FILE,'("T_00",I0,"_SUB_000",I0)') CURRENT_LOOP_ITERATION,SUBITERATION_NUMBER -! ELSE IF(SUBITERATION_NUMBER<100) THEN -! WRITE(OUTPUT_FILE,'("T_00",I0,"_SUB_00",I0)') CURRENT_LOOP_ITERATION,SUBITERATION_NUMBER -! END IF -! FILE=OUTPUT_FILE -! METHOD="FORTRAN" -! EXPORT_FIELD=.TRUE. -! IF(EXPORT_FIELD) THEN -! CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Darcy export subiterates ...",err,error,*999) -! CALL FLUID_MECHANICS_IO_WRITE_CMGUI(EQUATIONS_SET%REGION,EQUATIONS_SET%GLOBAL_NUMBER,FILE, & -! & err,error,*999) -! CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,OUTPUT_FILE,err,error,*999) -! ENDIF -! ENDIF -! ENDIF - - ENDIF - ENDIF - ENDDO - ENDIF - ENDIF - CASE DEFAULT - localError="Problem subtype "//TRIM(NumberToVString(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - - EXITS("DARCY_EQUATION_POST_SOLVE_OUTPUT_DATA") - RETURN -999 ERRORSEXITS("DARCY_EQUATION_POST_SOLVE_OUTPUT_DATA",err,error) - RETURN 1 - END SUBROUTINE DARCY_EQUATION_POST_SOLVE_OUTPUT_DATA - - ! - !================================================================================================================================ - ! - - !>Calculates the analytic solution and sets the boundary conditions for an analytic problem. - SUBROUTINE Darcy_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BOUNDARY_CONDITIONS,err,error,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: equations_SET - TYPE(BOUNDARY_CONDITIONS_TYPE), POINTER :: BOUNDARY_CONDITIONS - INTEGER(INTG), INTENT(OUT) :: ERR !EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD - IF(ASSOCIATED(DEPENDENT_FIELD)) THEN - geometricField=>EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD - IF(ASSOCIATED(geometricField)) THEN - CALL FIELD_NUMBER_OF_COMPONENTS_GET(geometricField,FIELD_U_VARIABLE_TYPE,NUMBER_OF_DIMENSIONS,err,error,*999) - NULLIFY(GEOMETRIC_VARIABLE) - CALL Field_VariableGet(geometricField,FIELD_U_VARIABLE_TYPE,GEOMETRIC_VARIABLE,err,error,*999) - NULLIFY(GEOMETRIC_PARAMETERS) - CALL FIELD_PARAMETER_SET_DATA_GET(geometricField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,GEOMETRIC_PARAMETERS, & - & err,error,*999) - IF(ASSOCIATED(BOUNDARY_CONDITIONS)) THEN - CURRENT_TIME=EQUATIONS_SET%ANALYTIC%ANALYTIC_USER_PARAMS(1) - DO variable_idx=3,DEPENDENT_FIELD%NUMBER_OF_VARIABLES - variable_type=DEPENDENT_FIELD%VARIABLES(variable_idx)%VARIABLE_TYPE - FIELD_VARIABLE=>DEPENDENT_FIELD%VARIABLE_TYPE_MAP(variable_type)%ptr - IF(ASSOCIATED(FIELD_VARIABLE)) THEN - CALL FIELD_PARAMETER_SET_CREATE(DEPENDENT_FIELD,variable_type,FIELD_ANALYTIC_VALUES_SET_TYPE,err,error,*999) - DO component_idx=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - IF(FIELD_VARIABLE%COMPONENTS(component_idx)%INTERPOLATION_TYPE==FIELD_NODE_BASED_INTERPOLATION) THEN - DOMAIN=>FIELD_VARIABLE%COMPONENTS(component_idx)%DOMAIN - IF(ASSOCIATED(DOMAIN)) THEN - IF(ASSOCIATED(DOMAIN%TOPOLOGY)) THEN - DOMAIN_NODES=>DOMAIN%TOPOLOGY%NODES - IF(ASSOCIATED(DOMAIN_NODES)) THEN - !Loop over the local nodes excluding the ghosts. - DO node_idx=1,DOMAIN_NODES%NUMBER_OF_NODES - !!TODO \todo We should interpolate the geometric field here and the node position. - DO dim_idx=1,NUMBER_OF_DIMENSIONS - !Default to version 1 of each node derivative - local_ny=GEOMETRIC_VARIABLE%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% & - & NODES(node_idx)%DERIVATIVES(1)%VERSIONS(1) - X(dim_idx)=GEOMETRIC_PARAMETERS(local_ny) - ENDDO !dim_idx - !Loop over the derivatives - DO deriv_idx=1,DOMAIN_NODES%NODES(node_idx)%NUMBER_OF_DERIVATIVES - ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE - GLOBAL_DERIV_INDEX=DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX -! CALL DIFFUSION_EQUATION_ANALYTIC_FUNCTIONS(VALUE,X,CURRENT_TIME,variable_type, & -! & GLOBAL_DERIV_INDEX,ANALYTIC_FUNCTION_TYPE,err,error,*999) -!!!!!!!!!!!!NEED TO SET APPROPRIATE VALUE DEPENDING ON WHETHER IT IS A VELOCITY COMPONENT OR THE MASS INCREASE COMPONENT - VALUE=0.0_DP - !Default to version 1 of each node derivative - local_ny=FIELD_VARIABLE%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% & - & NODE_PARAM2DOF_MAP%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1) - CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(DEPENDENT_FIELD,variable_type, & - & FIELD_ANALYTIC_VALUES_SET_TYPE,local_ny,VALUE,err,error,*999) - IF(variable_type==FIELD_V_VARIABLE_TYPE) THEN - IF(DOMAIN_NODES%NODES(node_idx)%BOUNDARY_NODE) THEN - !If we are a boundary node then set the analytic value on the boundary - CALL BOUNDARY_CONDITIONS_SET_LOCAL_DOF(BOUNDARY_CONDITIONS,DEPENDENT_FIELD,variable_type, & - & local_ny,BOUNDARY_CONDITION_FIXED,VALUE,err,error,*999) - ELSE - CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(DEPENDENT_FIELD,variable_type, & - & FIELD_VALUES_SET_TYPE,local_ny,VALUE,err,error,*999) - ENDIF - ENDIF - ENDDO !deriv_idx - ENDDO !node_idx - ELSE - CALL FlagError("Domain topology nodes is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Domain topology is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Domain is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Only node based interpolation is implemented.",err,error,*999) - ENDIF - ENDDO !component_idx - CALL FIELD_PARAMETER_SET_UPDATE_START(DEPENDENT_FIELD,variable_type,FIELD_ANALYTIC_VALUES_SET_TYPE, & - & err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(DEPENDENT_FIELD,variable_type,FIELD_ANALYTIC_VALUES_SET_TYPE, & - & err,error,*999) - ELSE - CALL FlagError("Field variable is not associated.",err,error,*999) - ENDIF - ENDDO !variable_idx - CALL FIELD_PARAMETER_SET_DATA_RESTORE(geometricField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, & - & GEOMETRIC_PARAMETERS,err,error,*999) - ELSE - CALL FlagError("Equations set boundary conditions is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set geometric field is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set dependent field is not associated.",err,error,*999) - ENDIF - CASE DEFAULT - DEPENDENT_FIELD=>EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD - IF(ASSOCIATED(DEPENDENT_FIELD)) THEN - geometricField=>EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD - IF(ASSOCIATED(geometricField)) THEN - NULLIFY(INTERPOLATION_PARAMETERS) - NULLIFY(INTERPOLATED_POINT) - CALL FIELD_INTERPOLATION_PARAMETERS_INITIALISE(geometricField,INTERPOLATION_PARAMETERS,err,error,*999) - CALL FIELD_INTERPOLATED_POINTS_INITIALISE(INTERPOLATION_PARAMETERS,INTERPOLATED_POINT,err,error,*999) - - CALL FIELD_NUMBER_OF_COMPONENTS_GET(geometricField,FIELD_U_VARIABLE_TYPE,NUMBER_OF_DIMENSIONS,err,error,*999) - - IF(NUMBER_OF_DIMENSIONS==2) THEN - BOUNDARY_X(1,1)=0.0_DP - BOUNDARY_X(1,2)=10.0_DP - BOUNDARY_X(2,1)=0.0_DP - BOUNDARY_X(2,2)=10.0_DP - ELSE IF(NUMBER_OF_DIMENSIONS==3) THEN - BOUNDARY_X(1,1)=-5.0_DP - BOUNDARY_X(1,2)=5.0_DP - BOUNDARY_X(2,1)=-5.0_DP - BOUNDARY_X(2,2)=5.0_DP - BOUNDARY_X(3,1)=-5.0_DP - BOUNDARY_X(3,2)=5.0_DP - ENDIF - - NULLIFY(GEOMETRIC_VARIABLE) - CALL Field_VariableGet(geometricField,FIELD_U_VARIABLE_TYPE,GEOMETRIC_VARIABLE,err,error,*999) - NULLIFY(GEOMETRIC_PARAMETERS) - CALL FIELD_PARAMETER_SET_DATA_GET(geometricField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, & - & GEOMETRIC_PARAMETERS,err,error,*999) - IF(ASSOCIATED(BOUNDARY_CONDITIONS)) THEN - DO variable_idx=1,DEPENDENT_FIELD%NUMBER_OF_VARIABLES - variable_type=DEPENDENT_FIELD%VARIABLES(variable_idx)%VARIABLE_TYPE - FIELD_VARIABLE=>DEPENDENT_FIELD%VARIABLE_TYPE_MAP(variable_type)%ptr - IF(ASSOCIATED(FIELD_VARIABLE)) THEN - CALL FIELD_PARAMETER_SET_CREATE(DEPENDENT_FIELD,variable_type,FIELD_ANALYTIC_VALUES_SET_TYPE,err,error,*999) - DO component_idx=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - BOUND_COUNT=0 - IF(FIELD_VARIABLE%COMPONENTS(component_idx)%INTERPOLATION_TYPE==FIELD_NODE_BASED_INTERPOLATION) THEN - DOMAIN=>FIELD_VARIABLE%COMPONENTS(component_idx)%DOMAIN - IF(ASSOCIATED(DOMAIN)) THEN - IF(ASSOCIATED(DOMAIN%TOPOLOGY)) THEN - DOMAIN_NODES=>DOMAIN%TOPOLOGY%NODES - IF(ASSOCIATED(DOMAIN_NODES)) THEN - !Loop over the local nodes excluding the ghosts. - DO node_idx=1,DOMAIN_NODES%NUMBER_OF_NODES - - element_idx=DOMAIN%topology%nodes%nodes(node_idx)%surrounding_elements(1) - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,element_idx, & - & INTERPOLATION_PARAMETERS(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - -! DO I=1,DOMAIN%topology%elements%maximum_number_of_element_parameters -! IF(DOMAIN%topology%elements%elements(element_idx)%element_nodes(I)=node_idx THEN - - en_idx=0 - XI_COORDINATES=0.0_DP - number_of_nodes_xic(1)=DOMAIN%topology%elements%elements(element_idx)%basis%number_of_nodes_xic(1) - number_of_nodes_xic(2)=DOMAIN%topology%elements%elements(element_idx)%basis%number_of_nodes_xic(2) - IF(NUMBER_OF_DIMENSIONS==3) THEN - number_of_nodes_xic(3)=DOMAIN%topology%elements%elements(element_idx)%basis%number_of_nodes_xic(3) - ELSE - number_of_nodes_xic(3)=1 - ENDIF - - IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==4.AND.NUMBER_OF_DIMENSIONS==2 .OR. & - & DOMAIN%topology%elements%maximum_number_of_element_parameters==9.OR. & - & DOMAIN%topology%elements%maximum_number_of_element_parameters==16.OR. & - & DOMAIN%topology%elements%maximum_number_of_element_parameters==8.OR. & - & DOMAIN%topology%elements%maximum_number_of_element_parameters==27.OR. & - & DOMAIN%topology%elements%maximum_number_of_element_parameters==64) THEN - - DO K=1,number_of_nodes_xic(3) - DO J=1,number_of_nodes_xic(2) - DO I=1,number_of_nodes_xic(1) - en_idx=en_idx+1 - IF(DOMAIN%topology%elements%elements(element_idx)%element_nodes(en_idx)==node_idx) EXIT - XI_COORDINATES(1)=XI_COORDINATES(1)+(1.0_DP/(number_of_nodes_xic(1)-1)) - ENDDO - IF(DOMAIN%topology%elements%elements(element_idx)%element_nodes(en_idx)==node_idx) EXIT - XI_COORDINATES(1)=0.0_DP - XI_COORDINATES(2)=XI_COORDINATES(2)+(1.0_DP/(number_of_nodes_xic(2)-1)) - ENDDO - IF(DOMAIN%topology%elements%elements(element_idx)%element_nodes(en_idx)==node_idx) EXIT - XI_COORDINATES(1)=0.0_DP - XI_COORDINATES(2)=0.0_DP - IF(number_of_nodes_xic(3)/=1) THEN - XI_COORDINATES(3)=XI_COORDINATES(3)+(1.0_DP/(number_of_nodes_xic(3)-1)) - ENDIF - ENDDO - CALL FIELD_INTERPOLATE_XI(NO_PART_DERIV,XI_COORDINATES, & - & INTERPOLATED_POINT(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - ELSE - IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==3) THEN - T_COORDINATES(1,1:2)=[0.0_DP,1.0_DP] - T_COORDINATES(2,1:2)=[1.0_DP,0.0_DP] - T_COORDINATES(3,1:2)=[1.0_DP,1.0_DP] - ELSE IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==6) THEN - T_COORDINATES(1,1:2)=[0.0_DP,1.0_DP] - T_COORDINATES(2,1:2)=[1.0_DP,0.0_DP] - T_COORDINATES(3,1:2)=[1.0_DP,1.0_DP] - T_COORDINATES(4,1:2)=[0.5_DP,0.5_DP] - T_COORDINATES(5,1:2)=[1.0_DP,0.5_DP] - T_COORDINATES(6,1:2)=[0.5_DP,1.0_DP] - ELSE IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==10.AND. & - & NUMBER_OF_DIMENSIONS==2) THEN - T_COORDINATES(1,1:2)=[0.0_DP,1.0_DP] - T_COORDINATES(2,1:2)=[1.0_DP,0.0_DP] - T_COORDINATES(3,1:2)=[1.0_DP,1.0_DP] - T_COORDINATES(4,1:2)=[1.0_DP/3.0_DP,2.0_DP/3.0_DP] - T_COORDINATES(5,1:2)=[2.0_DP/3.0_DP,1.0_DP/3.0_DP] - T_COORDINATES(6,1:2)=[1.0_DP,1.0_DP/3.0_DP] - T_COORDINATES(7,1:2)=[1.0_DP,2.0_DP/3.0_DP] - T_COORDINATES(8,1:2)=[2.0_DP/3.0_DP,1.0_DP] - T_COORDINATES(9,1:2)=[1.0_DP/3.0_DP,1.0_DP] - T_COORDINATES(10,1:2)=[2.0_DP/3.0_DP,2.0_DP/3.0_DP] - ELSE IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==4) THEN - T_COORDINATES(1,1:3)=[0.0_DP,1.0_DP,1.0_DP] - T_COORDINATES(2,1:3)=[1.0_DP,0.0_DP,1.0_DP] - T_COORDINATES(3,1:3)=[1.0_DP,1.0_DP,0.0_DP] - T_COORDINATES(4,1:3)=[1.0_DP,1.0_DP,1.0_DP] - ELSE IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==10.AND. & - & NUMBER_OF_DIMENSIONS==3) THEN - T_COORDINATES(1,1:3)=[0.0_DP,1.0_DP,1.0_DP] - T_COORDINATES(2,1:3)=[1.0_DP,0.0_DP,1.0_DP] - T_COORDINATES(3,1:3)=[1.0_DP,1.0_DP,0.0_DP] - T_COORDINATES(4,1:3)=[1.0_DP,1.0_DP,1.0_DP] - T_COORDINATES(5,1:3)=[0.5_DP,0.5_DP,1.0_DP] - T_COORDINATES(6,1:3)=[0.5_DP,1.0_DP,0.5_DP] - T_COORDINATES(7,1:3)=[0.5_DP,1.0_DP,1.0_DP] - T_COORDINATES(8,1:3)=[1.0_DP,0.5_DP,0.5_DP] - T_COORDINATES(9,1:3)=[1.0_DP,1.0_DP,0.5_DP] - T_COORDINATES(10,1:3)=[1.0_DP,0.5_DP,1.0_DP] - ELSE IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==20) THEN - T_COORDINATES(1,1:3)=[0.0_DP,1.0_DP,1.0_DP] - T_COORDINATES(2,1:3)=[1.0_DP,0.0_DP,1.0_DP] - T_COORDINATES(3,1:3)=[1.0_DP,1.0_DP,0.0_DP] - T_COORDINATES(4,1:3)=[1.0_DP,1.0_DP,1.0_DP] - T_COORDINATES(5,1:3)=[1.0_DP/3.0_DP,2.0_DP/3.0_DP,1.0_DP] - T_COORDINATES(6,1:3)=[2.0_DP/3.0_DP,1.0_DP/3.0_DP,1.0_DP] - T_COORDINATES(7,1:3)=[1.0_DP/3.0_DP,1.0_DP,2.0_DP/3.0_DP] - T_COORDINATES(8,1:3)=[2.0_DP/3.0_DP,1.0_DP,1.0_DP/3.0_DP] - T_COORDINATES(9,1:3)=[1.0_DP/3.0_DP,1.0_DP,1.0_DP] - T_COORDINATES(10,1:3)=[2.0_DP/3.0_DP,1.0_DP,1.0_DP] - T_COORDINATES(11,1:3)=[1.0_DP,1.0_DP/3.0_DP,2.0_DP/3.0_DP] - T_COORDINATES(12,1:3)=[1.0_DP,2.0_DP/3.0_DP,1.0_DP/3.0_DP] - T_COORDINATES(13,1:3)=[1.0_DP,1.0_DP,1.0_DP/3.0_DP] - T_COORDINATES(14,1:3)=[1.0_DP,1.0_DP,2.0_DP/3.0_DP] - T_COORDINATES(15,1:3)=[1.0_DP,1.0_DP/3.0_DP,1.0_DP] - T_COORDINATES(16,1:3)=[1.0_DP,2.0_DP/3.0_DP,1.0_DP] - T_COORDINATES(17,1:3)=[2.0_DP/3.0_DP,2.0_DP/3.0_DP,2.0_DP/3.0_DP] - T_COORDINATES(18,1:3)=[2.0_DP/3.0_DP,2.0_DP/3.0_DP,1.0_DP] - T_COORDINATES(19,1:3)=[2.0_DP/3.0_DP,1.0_DP,2.0_DP/3.0_DP] - T_COORDINATES(20,1:3)=[1.0_DP,2.0_DP/3.0_DP,2.0_DP/3.0_DP] - ENDIF - - DO K=1,DOMAIN%topology%elements%maximum_number_of_element_parameters - IF(DOMAIN%topology%elements%elements(element_idx)%element_nodes(K)==node_idx) EXIT - ENDDO - - IF(NUMBER_OF_DIMENSIONS==2) THEN - CALL FIELD_INTERPOLATE_XI(NO_PART_DERIV,T_COORDINATES(K,1:2), & - & INTERPOLATED_POINT(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - ELSE IF(NUMBER_OF_DIMENSIONS==3) THEN - CALL FIELD_INTERPOLATE_XI(NO_PART_DERIV,T_COORDINATES(K,1:3), & - & INTERPOLATED_POINT(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - ENDIF - ENDIF - - X=0.0_DP - DO dim_idx=1,NUMBER_OF_DIMENSIONS - X(dim_idx)=INTERPOLATED_POINT(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(dim_idx,1) - ENDDO !dim_idx - - !Loop over the derivatives - DO deriv_idx=1,DOMAIN_NODES%NODES(node_idx)%NUMBER_OF_DERIVATIVES - SELECT CASE(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE) - CASE(EQUATIONS_SET_DARCY_EQUATION_TWO_DIM_1) - IF(NUMBER_OF_DIMENSIONS==2.AND.FIELD_VARIABLE%NUMBER_OF_COMPONENTS==3) THEN -!POLYNOM - SELECT CASE(variable_type) - CASE(FIELD_U_VARIABLE_TYPE) - SELECT CASE(DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX) - CASE(NO_GLOBAL_DERIV) - FACT = PERM_OVER_VIS_PARAM - IF(component_idx==1) THEN - !calculate u - VALUE = - FACT * ( 2.0_DP*X(1) + 2.0_DP*X(2) ) - ELSE IF(component_idx==2) THEN - !calculate v - VALUE = - FACT * ( 2.0_DP*X(1) - 2.0_DP*X(2) ) - ELSE IF(component_idx==3) THEN - !calculate p - VALUE = X(1)**2.0_DP + 2.0_DP*X(1)*X(2) - X(2)**2.0_DP - ELSE - CALL FlagError("Not implemented.",err,error,*999) - ENDIF - CASE(GLOBAL_DERIV_S1) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S1_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The global derivative index of "//TRIM(NumberToVString( & - & DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", & - & err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(FIELD_DELUDELN_VARIABLE_TYPE) - SELECT CASE(DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX) - CASE(NO_GLOBAL_DERIV) - VALUE= 0.0_DP - CASE(GLOBAL_DERIV_S1) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S1_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The global derivative index of "//TRIM(NumberToVString( & - & DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", & - & err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The variable type of "//TRIM(NumberToVString(variable_type,"*",err,error))//& - & " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - localError="The number of components does not correspond to the number of dimensions." - CALL FlagError(localError,err,error,*999) - ENDIF - - - CASE(EQUATIONS_SET_DARCY_EQUATION_TWO_DIM_2) - IF(NUMBER_OF_DIMENSIONS==2.AND.FIELD_VARIABLE%NUMBER_OF_COMPONENTS==3) THEN -!EXPONENTIAL - SELECT CASE(variable_type) - CASE(FIELD_U_VARIABLE_TYPE) - SELECT CASE(DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX) - CASE(NO_GLOBAL_DERIV) - FACT = PERM_OVER_VIS_PARAM / L - ARG(1) = X(1) / L - ARG(2) = X(2) / L - IF(component_idx==1) THEN - !calculate u - VALUE = - FACT * EXP( ARG(1) ) * EXP( ARG(2) ) - ELSE IF(component_idx==2) THEN - !calculate v - VALUE = - FACT * EXP( ARG(1) ) * EXP( ARG(2) ) - ELSE IF(component_idx==3) THEN - !calculate p - VALUE = EXP( ARG(1) ) * EXP( ARG(2) ) - ELSE - CALL FlagError("Not implemented.",err,error,*999) - ENDIF - CASE(GLOBAL_DERIV_S1) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S1_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The global derivative index of "//TRIM(NumberToVString( & - & DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", & - & err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(FIELD_DELUDELN_VARIABLE_TYPE) - SELECT CASE(DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX) - CASE(NO_GLOBAL_DERIV) - IF(component_idx==1) THEN - !calculate u - VALUE= 0.0_DP - ELSE IF(component_idx==2) THEN - !calculate v - VALUE= 0.0_DP - ELSE IF(component_idx==3) THEN - !calculate p - VALUE= 0.0_DP - ELSE - CALL FlagError("Not implemented.",err,error,*999) - ENDIF - CASE(GLOBAL_DERIV_S1) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S1_S2) - CALL FlagError("Not implemented.",err,error,*999) - - CASE DEFAULT - localError="The global derivative index of "//TRIM(NumberToVString( & - & DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", & - & err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - - - CASE DEFAULT - localError="The variable type of "//TRIM(NumberToVString(variable_type,"*",err,error))//& - & " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - localError="The number of components does not correspond to the number of dimensions." - CALL FlagError(localError,err,error,*999) - ENDIF - - - CASE(EQUATIONS_SET_DARCY_EQUATION_TWO_DIM_3) - IF(NUMBER_OF_DIMENSIONS==2.AND.FIELD_VARIABLE%NUMBER_OF_COMPONENTS==3) THEN -!SINUS/COSINUS - SELECT CASE(variable_type) - CASE(FIELD_U_VARIABLE_TYPE) - SELECT CASE(DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX) - CASE(NO_GLOBAL_DERIV) - FACT = 2.0_DP * PI * PERM_OVER_VIS_PARAM / L - ARG(1) = 2.0_DP * PI * X(1) / L - ARG(2) = 2.0_DP * PI * X(2) / L - IF(component_idx==1) THEN - !calculate u - VALUE = - FACT * COS( ARG(1) ) * SIN( ARG(2) ) - ELSE IF(component_idx==2) THEN - !calculate v - VALUE = - FACT * SIN( ARG(1) ) * COS( ARG(2) ) - ELSE IF(component_idx==3) THEN - !calculate p - VALUE = SIN( ARG(1) ) * SIN( ARG(2) ) - ELSE - CALL FlagError("Not implemented.",err,error,*999) - ENDIF - CASE(GLOBAL_DERIV_S1) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S1_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The global derivative index of "//TRIM(NumberToVString( & - & DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", & - & err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(FIELD_DELUDELN_VARIABLE_TYPE) - SELECT CASE(DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX) - CASE(NO_GLOBAL_DERIV) - IF(component_idx==1) THEN - !calculate u - VALUE=0.0_DP - ELSE IF(component_idx==2) THEN - !calculate v - VALUE=0.0_DP - ELSE IF(component_idx==3) THEN - !calculate p - VALUE=0.0_DP - ELSE - CALL FlagError("Not implemented.",err,error,*999) - ENDIF - CASE(GLOBAL_DERIV_S1) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S1_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The global derivative index of "//TRIM(NumberToVString( & - & DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", & - & err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The variable type of "//TRIM(NumberToVString(variable_type,"*",err,error))//& - & " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - localError="The number of components does not correspond to the number of dimensions." - CALL FlagError(localError,err,error,*999) - ENDIF - - CASE(EQUATIONS_SET_DARCY_EQUATION_THREE_DIM_1) - IF(NUMBER_OF_DIMENSIONS==3.AND.FIELD_VARIABLE%NUMBER_OF_COMPONENTS==4) THEN -!POLYNOM - SELECT CASE(variable_type) - CASE(FIELD_U_VARIABLE_TYPE) - SELECT CASE(DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX) - CASE(NO_GLOBAL_DERIV) - FACT = PERM_OVER_VIS_PARAM - IF(component_idx==1) THEN - !calculate u - VALUE = - FACT * ( 2.0_DP*X(1) + 2.0_DP*X(2) + X(3) ) - ELSE IF(component_idx==2) THEN - !calculate v - VALUE = - FACT * ( 2.0_DP*X(1) - 2.0_DP*X(2) + X(3) ) - ELSE IF(component_idx==3) THEN - !calculate w - VALUE = - FACT * ( 3.0_DP + X(1) + X(2) ) - ELSE IF(component_idx==4) THEN - !calculate p - VALUE = X(1)**2.0_DP + 2.0_DP*X(1)*X(2) - X(2)**2.0_DP + & - & 3.0_DP*X(3) + X(3)*X(1) + X(3)*X(2) - ELSE - CALL FlagError("Not implemented.",err,error,*999) - ENDIF - CASE(GLOBAL_DERIV_S1) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S1_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The global derivative index of "//TRIM(NumberToVString( & - & DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", & - & err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(FIELD_DELUDELN_VARIABLE_TYPE) - SELECT CASE(DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX) - CASE(NO_GLOBAL_DERIV) - VALUE=0.0_DP - CASE(GLOBAL_DERIV_S1) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S1_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The global derivative index of "//TRIM(NumberToVString( & - & DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", & - & err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The variable type of "//TRIM(NumberToVString(variable_type,"*",err,error))//& - & " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - localError="The number of components does not correspond to the number of dimensions." - CALL FlagError(localError,err,error,*999) - ENDIF - - - CASE(EQUATIONS_SET_DARCY_EQUATION_THREE_DIM_2) - IF(NUMBER_OF_DIMENSIONS==3.AND.FIELD_VARIABLE%NUMBER_OF_COMPONENTS==4) THEN -!EXPONENTIAL - SELECT CASE(variable_type) - CASE(FIELD_U_VARIABLE_TYPE) - SELECT CASE(DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX) - CASE(NO_GLOBAL_DERIV) - FACT = PERM_OVER_VIS_PARAM / L - ARG(1) = X(1) / L - ARG(2) = X(2) / L - ARG(3) = X(3) / L - IF(component_idx==1) THEN - !calculate u - VALUE = - FACT * EXP( ARG(1) ) * EXP( ARG(2) ) * EXP( ARG(3) ) - ELSE IF(component_idx==2) THEN - !calculate v - VALUE = - FACT * EXP( ARG(1) ) * EXP( ARG(2) ) * EXP( ARG(3) ) - ELSE IF(component_idx==3) THEN - !calculate w - VALUE = - FACT * EXP( ARG(1) ) * EXP( ARG(2) ) * EXP( ARG(3) ) - ELSE IF(component_idx==4) THEN - !calculate p - VALUE = EXP( ARG(1) ) * EXP( ARG(2) ) * EXP( ARG(3) ) - ELSE - CALL FlagError("Not implemented.",err,error,*999) - ENDIF - CASE(GLOBAL_DERIV_S1) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S1_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The global derivative index of "//TRIM(NumberToVString( & - & DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", & - & err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(FIELD_DELUDELN_VARIABLE_TYPE) - SELECT CASE(DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX) - CASE(NO_GLOBAL_DERIV) - IF(component_idx==1) THEN - !calculate u - VALUE=0.0_DP - ELSE IF(component_idx==2) THEN - !calculate v - VALUE=0.0_DP - ELSE IF(component_idx==3) THEN - !calculate w - VALUE=0.0_DP - ELSE IF(component_idx==4) THEN - !calculate p - VALUE=0.0_DP - ELSE - CALL FlagError("Not implemented.",err,error,*999) - ENDIF - - CASE(GLOBAL_DERIV_S1) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S1_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The global derivative index of "//TRIM(NumberToVString( & - & DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", & - & err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The variable type of "//TRIM(NumberToVString(variable_type,"*",err,error))//& - & " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - localError="The number of components does not correspond to the number of dimensions." - CALL FlagError(localError,err,error,*999) - ENDIF - - CASE(EQUATIONS_SET_DARCY_EQUATION_THREE_DIM_3) - IF(NUMBER_OF_DIMENSIONS==3.AND.FIELD_VARIABLE%NUMBER_OF_COMPONENTS==4) THEN - !SINE/COSINE - SELECT CASE(variable_type) - CASE(FIELD_U_VARIABLE_TYPE) - SELECT CASE(DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX) - CASE(NO_GLOBAL_DERIV) - FACT = 2.0_DP * PI * PERM_OVER_VIS_PARAM / L - ARG(1) = 2.0_DP * PI * X(1) / L - ARG(2) = 2.0_DP * PI * X(2) / L - ARG(3) = 2.0_DP * PI * X(3) / L - IF(component_idx==1) THEN - !calculate u - VALUE = - FACT * COS( ARG(1) ) * SIN( ARG(2) ) * SIN( ARG(3) ) - ELSE IF(component_idx==2) THEN - !calculate v - VALUE = - FACT * SIN( ARG(1) ) * COS( ARG(2) ) * SIN( ARG(3) ) - ELSE IF(component_idx==3) THEN - !calculate w - VALUE = - FACT * SIN( ARG(1) ) * SIN( ARG(2) ) * COS( ARG(3) ) - ELSE IF(component_idx==4) THEN - !calculate p - VALUE = SIN( ARG(1) ) * SIN( ARG(2) ) * SIN( ARG(3) ) - ELSE - CALL FlagError("Not implemented.",err,error,*999) - ENDIF - CASE(GLOBAL_DERIV_S1) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S1_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The global derivative index of "//TRIM(NumberToVString( & - & DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", & - & err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(FIELD_DELUDELN_VARIABLE_TYPE) - SELECT CASE(DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX) - CASE(NO_GLOBAL_DERIV) - IF(component_idx==1) THEN - !calculate u - VALUE=0.0_DP - ELSE IF(component_idx==2) THEN - !calculate v - VALUE=0.0_DP - ELSE IF(component_idx==3) THEN - !calculate w - VALUE=0.0_DP - ELSE IF(component_idx==4) THEN - !calculate p - VALUE=0.0_DP - ELSE - CALL FlagError("Not implemented.",err,error,*999) - ENDIF - CASE(GLOBAL_DERIV_S1) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE(GLOBAL_DERIV_S1_S2) - CALL FlagError("Not implemented.",err,error,*999) - CASE DEFAULT - localError="The global derivative index of "//TRIM(NumberToVString( & - & DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", & - & err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The variable type of "//TRIM(NumberToVString(variable_type,"*",err,error))//& - & " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - localError="The number of components does not correspond to the number of dimensions." - CALL FlagError(localError,err,error,*999) - ENDIF - CASE DEFAULT - localError="The analytic function type of "// & - & TRIM(NumberToVString(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE,"*",err,error))// & - & " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - !Default to version 1 of each node derivative - local_ny=FIELD_VARIABLE%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% & - & NODE_PARAM2DOF_MAP%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1) - CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(DEPENDENT_FIELD,variable_type, & - & FIELD_ANALYTIC_VALUES_SET_TYPE,local_ny,VALUE,err,error,*999) - IF(variable_type==FIELD_U_VARIABLE_TYPE) THEN - - -! ! ! IF(DOMAIN_NODES%NODES(node_idx)%BOUNDARY_NODE) THEN -! ! ! !If we are a boundary node then set the analytic value on the boundary -! ! ! IF(component_idx<=NUMBER_OF_DIMENSIONS) THEN -! ! ! CALL BOUNDARY_CONDITIONS_SET_LOCAL_DOF(BOUNDARY_CONDITIONS,variable_type,local_ny, & -! ! ! & BOUNDARY_CONDITION_FIXED,VALUE,err,error,*999) -! ! ! BOUND_COUNT=BOUND_COUNT+1 -! ! ! ENDIF -! ! ! ELSE -! ! ! IF(component_idx<=NUMBER_OF_DIMENSIONS) THEN -! ! ! CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(DEPENDENT_FIELD,variable_type, & -! ! ! & FIELD_VALUES_SET_TYPE,local_ny,VALUE,err,error,*999) -! ! ! ENDIF -! ! ! ENDIF - - - - - !If we are a boundary node then set the analytic value on the boundary - IF(NUMBER_OF_DIMENSIONS==2) THEN - IF(ABS(X(1)-BOUNDARY_X(1,1))NUMBER_OF_DIMENSIONS) THEN - IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==3.OR. & - & DOMAIN%topology%elements%maximum_number_of_element_parameters==6.OR. & - & DOMAIN%topology%elements%maximum_number_of_element_parameters==10) THEN - - IF(ABS(X(1)-BOUNDARY_X(1,1))NUMBER_OF_DIMENSIONS) THEN - IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==4.OR. & - & DOMAIN%topology%elements%maximum_number_of_element_parameters==10.OR. & - & DOMAIN%topology%elements%maximum_number_of_element_parameters==20) THEN - IF(ABS(X(1)-BOUNDARY_X(1,1))Update geometric field for ALE Darcy problem - SUBROUTINE Darcy_PreSolveGetSolidDisplacement(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !CONTROL_LOOP - DO loop_idx=1,CONTROL_LOOP%CONTROL_LOOP_LEVEL - IF(CONTROL_TIME_LOOP%LOOP_TYPE==PROBLEM_CONTROL_TIME_LOOP_TYPE) THEN - CALL CONTROL_LOOP_CURRENT_TIMES_GET(CONTROL_TIME_LOOP,CURRENT_TIME,TIME_INCREMENT,err,error,*999) - EXIT - ENDIF - IF (ASSOCIATED(CONTROL_LOOP%PARENT_LOOP)) THEN - CONTROL_TIME_LOOP=>CONTROL_TIME_LOOP%PARENT_LOOP - ELSE - CALL FlagError("Could not find a time control loop.",err,error,*999) - ENDIF - ENDDO - - IF(DIAGNOSTICS1) THEN - CALL WRITE_STRING(DIAGNOSTIC_OUTPUT_TYPE, & - & "*******************************************************************************************************", & - & err,error,*999) - CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"CURRENT_TIME = ",CURRENT_TIME,err,error,*999) - CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"TIME_INCREMENT = ",TIME_INCREMENT,err,error,*999) - CALL WRITE_STRING(DIAGNOSTIC_OUTPUT_TYPE, & - & "*******************************************************************************************************", & - & err,error,*999) - ENDIF - - IF(ASSOCIATED(SOLVER)) THEN - IF(ASSOCIATED(CONTROL_LOOP%PROBLEM)) THEN - ROOT_CONTROL_LOOP=>CONTROL_LOOP%PROBLEM%CONTROL_LOOP - IF(.NOT.ALLOCATED(CONTROL_LOOP%PROBLEM%SPECIFICATION)) THEN - CALL FlagError("Problem specification is not allocated.",err,error,*999) - ELSE IF(SIZE(CONTROL_LOOP%PROBLEM%SPECIFICATION,1)<3) THEN - CALL FlagError("Problem specification must have three entries for a Darcy equation problem.",err,error,*999) - END IF - SELECT CASE(CONTROL_LOOP%PROBLEM%SPECIFICATION(3)) - CASE(PROBLEM_STANDARD_DARCY_SUBTYPE) - ! do nothing - CASE(PROBLEM_QUASISTATIC_DARCY_SUBTYPE) - ! do nothing - CASE(PROBLEM_TRANSIENT_DARCY_SUBTYPE) - ! do nothing - CASE(PROBLEM_ALE_DARCY_SUBTYPE) - !--- Motion: specified - IF(SOLVER%GLOBAL_NUMBER==SOLVER_NUMBER_DARCY) THEN - SOLVER_EQUATIONS_DARCY=>SOLVER%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS_DARCY)) THEN - SOLVER_MAPPING_DARCY=>SOLVER_EQUATIONS_DARCY%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING_DARCY)) THEN - EQUATIONS_SET_DARCY=>SOLVER_MAPPING_DARCY%EQUATIONS_SETS(1)%ptr - IF(ASSOCIATED(EQUATIONS_SET_DARCY)) THEN - IF(.NOT.ALLOCATED(equations_set_darcy%specification)) THEN - CALL FlagError("Equations set specification is not allocated.",err,error,*999) - ELSE IF(SIZE(equations_set_darcy%specification,1)/=3) THEN - CALL FlagError("Equations set specification must have three entries for a Darcy type equations set.", & - & err,error,*999) - END IF - SELECT CASE(EQUATIONS_SET_DARCY%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE) - ! do nothing - CASE(EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE) - ! do nothing - CASE(EQUATIONS_SET_ALE_DARCY_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE,EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE) - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Darcy motion specified ... ",err,error,*999) - GEOMETRIC_FIELD_DARCY=>EQUATIONS_SET_DARCY%GEOMETRY%GEOMETRIC_FIELD - IF(ASSOCIATED(GEOMETRIC_FIELD_DARCY)) THEN - ALPHA = 0.085_DP * sin( 2.0_DP * PI * CURRENT_TIME / 4.0_DP ) - - CALL FIELD_PARAMETER_SETS_COPY(GEOMETRIC_FIELD_DARCY,FIELD_U_VARIABLE_TYPE, & - & FIELD_INITIAL_VALUES_SET_TYPE,FIELD_MESH_DISPLACEMENT_SET_TYPE,ALPHA,err,error,*999) - ELSE - CALL FlagError("Geometric field is not associated.",err,error,*999) - ENDIF - CASE DEFAULT - localError="Equations set subtype " & - & //TRIM(NumberToVString(EQUATIONS_SET_DARCY%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver mapping is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver equations is not associated.",err,error,*999) - ENDIF - ELSE - ! do nothing - ENDIF - CASE(PROBLEM_PGM_DARCY_SUBTYPE,PROBLEM_PGM_TRANSIENT_DARCY_SUBTYPE,PROBLEM_PGM_ELASTICITY_DARCY_SUBTYPE) - !--- Motion: read in from a file - IF(SOLVER%GLOBAL_NUMBER==SOLVER_NUMBER_DARCY) THEN - CALL SOLVERS_SOLVER_GET(SOLVER%SOLVERS,SOLVER_NUMBER_DARCY,SOLVER_DARCY,err,error,*999) - SOLVER_EQUATIONS_DARCY=>SOLVER_DARCY%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS_DARCY)) THEN - SOLVER_MAPPING_DARCY=>SOLVER_EQUATIONS_DARCY%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING_DARCY)) THEN - EQUATIONS_SET_DARCY=>SOLVER_MAPPING_DARCY%EQUATIONS_SETS(1)%ptr - IF(ASSOCIATED(EQUATIONS_SET_DARCY)) THEN - GEOMETRIC_FIELD_DARCY=>EQUATIONS_SET_DARCY%GEOMETRY%GEOMETRIC_FIELD - ELSE - CALL FlagError("Darcy equations set is not associated.",err,error,*999) - END IF - IF(SOLVER%outputType>=SOLVER_PROGRESS_OUTPUT) THEN - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Darcy motion read from a file ... ",err,error,*999) - ENDIF - - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET_DARCY%GEOMETRY%GEOMETRIC_FIELD, & - & FIELD_U_VARIABLE_TYPE,NUMBER_OF_DIMENSIONS,err,error,*999) - - !Copy input to Darcy' geometric field - INPUT_TYPE=42 - INPUT_OPTION=2 - CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET_DARCY%GEOMETRY%GEOMETRIC_FIELD, & - & FIELD_U_VARIABLE_TYPE,FIELD_MESH_DISPLACEMENT_SET_TYPE,MESH_DISPLACEMENT_VALUES,err,error,*999) - CALL FLUID_MECHANICS_IO_READ_DATA(SOLVER_LINEAR_TYPE,MESH_DISPLACEMENT_VALUES, & - & NUMBER_OF_DIMENSIONS,INPUT_TYPE,INPUT_OPTION,CONTROL_LOOP%TIME_LOOP%ITERATION_NUMBER,1.0_DP, & - & err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_START(EQUATIONS_SET_DARCY%GEOMETRY%GEOMETRIC_FIELD, & - & FIELD_U_VARIABLE_TYPE,FIELD_MESH_DISPLACEMENT_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(EQUATIONS_SET_DARCY%GEOMETRY%GEOMETRIC_FIELD, & - & FIELD_U_VARIABLE_TYPE,FIELD_MESH_DISPLACEMENT_SET_TYPE,err,error,*999) - ELSE - CALL FlagError("Darcy solver mapping is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Darcy solver equations are not associated.",err,error,*999) - END IF - - IF(DIAGNOSTICS1) THEN - NDOFS_TO_PRINT = SIZE(MESH_DISPLACEMENT_VALUES,1) - CALL WRITE_STRING_VECTOR(DIAGNOSTIC_OUTPUT_TYPE,1,1,NDOFS_TO_PRINT,NDOFS_TO_PRINT,NDOFS_TO_PRINT,& - & MESH_DISPLACEMENT_VALUES,'(" MESH_DISPLACEMENT_VALUES = ",4(X,E13.6))','4(4(X,E13.6))', & - & err,error,*999) - ENDIF - ELSE - ! in case of a solver number different from 2: do nothing - ENDIF - CASE(PROBLEM_STANDARD_ELASTICITY_DARCY_SUBTYPE,PROBLEM_QUASISTATIC_ELASTICITY_TRANSIENT_DARCY_SUBTYPE, & - & PROBLEM_QUASISTATIC_ELAST_TRANS_DARCY_MAT_SOLVE_SUBTYPE) - !--- Motion: defined by fluid-solid interaction (thus read from solid's dependent field) - IF(SOLVER%GLOBAL_NUMBER==SOLVER_NUMBER_DARCY) THEN !It is called with 'SOLVER%GLOBAL_NUMBER=SOLVER_NUMBER_DARCY', otherwise it doesn't work - !--- Get the dependent field of the finite elasticity equations - IF(SOLVER%outputType>=SOLVER_PROGRESS_OUTPUT) THEN - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Darcy motion read from solid's dependent field ... ",err,error,*999) - ENDIF - SELECT CASE(CONTROL_LOOP%PROBLEM%SPECIFICATION(3)) - CASE(PROBLEM_STANDARD_ELASTICITY_DARCY_SUBTYPE) - CALL CONTROL_LOOP_GET(ROOT_CONTROL_LOOP,[1,CONTROL_LOOP_NODE],CONTROL_LOOP_SOLID,err,error,*999) - CASE(PROBLEM_QUASISTATIC_ELASTICITY_TRANSIENT_DARCY_SUBTYPE,PROBLEM_QUASISTATIC_ELAST_TRANS_DARCY_MAT_SOLVE_SUBTYPE) - CALL CONTROL_LOOP_GET(ROOT_CONTROL_LOOP,[1,1,CONTROL_LOOP_NODE],CONTROL_LOOP_SOLID,err,error,*999) - END SELECT - CALL SOLVERS_SOLVER_GET(CONTROL_LOOP_SOLID%SOLVERS,SOLVER_NUMBER_SOLID, & - & SOLVER_FINITE_ELASTICITY,err,error,*999) - SOLVER_EQUATIONS_FINITE_ELASTICITY=>SOLVER_FINITE_ELASTICITY%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS_FINITE_ELASTICITY)) THEN - SOLVER_MAPPING_FINITE_ELASTICITY=>SOLVER_EQUATIONS_FINITE_ELASTICITY%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING_FINITE_ELASTICITY)) THEN - EQUATIONS_SET_FINITE_ELASTICITY=>SOLVER_MAPPING_FINITE_ELASTICITY%EQUATIONS_SETS(1)%ptr - IF(ASSOCIATED(EQUATIONS_SET_FINITE_ELASTICITY)) THEN - DEPENDENT_FIELD_FINITE_ELASTICITY=>EQUATIONS_SET_FINITE_ELASTICITY%DEPENDENT%DEPENDENT_FIELD - IF(ASSOCIATED(DEPENDENT_FIELD_FINITE_ELASTICITY)) THEN - !No longer needed, since no more 'Field_ParametersToFieldParametersCopy' -! CALL FIELD_NUMBER_OF_COMPONENTS_GET(DEPENDENT_FIELD_FINITE_ELASTICITY, & -! & FIELD_U_VARIABLE_TYPE,NUMBER_OF_COMPONENTS_DEPENDENT_FIELD_FINITE_ELASTICITY,err,error,*999) - ELSE - CALL FlagError("DEPENDENT_FIELD_FINITE_ELASTICITY is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Finite elasticity equations set is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Finite elasticity solver mapping is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Finite elasticity solver equations are not associated.",err,error,*999) - END IF - - !--- Get the geometric field for the ALE Darcy equations - CALL SOLVERS_SOLVER_GET(SOLVER%SOLVERS,SOLVER_NUMBER_DARCY,SOLVER_DARCY,err,error,*999) - SOLVER_EQUATIONS_DARCY=>SOLVER_DARCY%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS_DARCY)) THEN - SOLVER_MAPPING_DARCY=>SOLVER_EQUATIONS_DARCY%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING_DARCY)) THEN - EQUATIONS_SET_DARCY=>SOLVER_MAPPING_DARCY%EQUATIONS_SETS(1)%ptr - IF(ASSOCIATED(EQUATIONS_SET_DARCY)) THEN - GEOMETRIC_FIELD_DARCY=>EQUATIONS_SET_DARCY%GEOMETRY%GEOMETRIC_FIELD - IF(ASSOCIATED(GEOMETRIC_FIELD_DARCY)) THEN - !No longer needed, since no more 'Field_ParametersToFieldParametersCopy' -! CALL FIELD_NUMBER_OF_COMPONENTS_GET(GEOMETRIC_FIELD_DARCY, & -! & FIELD_U_VARIABLE_TYPE,NUMBER_OF_COMPONENTS_GEOMETRIC_FIELD_DARCY,err,error,*999) - ELSE - CALL FlagError("GEOMETRIC_FIELD_DARCY is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Darcy equations set is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Darcy solver mapping is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Darcy solver equations are not associated.",err,error,*999) - END IF - - !--- Copy the result from Finite-elasticity's dependent field to ALE Darcy's geometric field - !--- First: FIELD_MESH_DISPLACEMENT_SET_TYPE = - FIELD_PREVIOUS_VALUES_SET_TYPE - ALPHA=-1.0_DP - CALL FIELD_PARAMETER_SETS_COPY(GEOMETRIC_FIELD_DARCY,FIELD_U_VARIABLE_TYPE, & - & FIELD_PREVIOUS_VALUES_SET_TYPE,FIELD_MESH_DISPLACEMENT_SET_TYPE,ALPHA,err,error,*999) - - ! Write 'FIELD_PREVIOUS_VALUES_SET_TYPE' - IF(DIAGNOSTICS3) THEN - NULLIFY( DUMMY_VALUES2 ) - CALL FIELD_PARAMETER_SET_DATA_GET(GEOMETRIC_FIELD_DARCY,FIELD_U_VARIABLE_TYPE, & - & FIELD_PREVIOUS_VALUES_SET_TYPE,DUMMY_VALUES2,err,error,*999) - NDOFS_TO_PRINT = SIZE(DUMMY_VALUES2,1) - CALL WRITE_STRING_VECTOR(DIAGNOSTIC_OUTPUT_TYPE,1,1,NDOFS_TO_PRINT,NDOFS_TO_PRINT,NDOFS_TO_PRINT,DUMMY_VALUES2, & - & '(" GEOMETRIC_FIELD_DARCY,FIELD_U_VARIABLE_TYPE,FIELD_PREVIOUS_VALUES_SET_TYPE = ",4(X,E13.6))',& - & '4(4(X,E13.6))',err,error,*999) - CALL FIELD_PARAMETER_SET_DATA_RESTORE(GEOMETRIC_FIELD_DARCY,FIELD_U_VARIABLE_TYPE, & - & FIELD_PREVIOUS_VALUES_SET_TYPE,DUMMY_VALUES2,err,error,*999) - ENDIF - - !--- Second: Get a pointer to the solution values of the solid - ! (deformed absolute positions in x, y, z; possibly solid pressure) - CALL FIELD_PARAMETER_SET_DATA_GET(DEPENDENT_FIELD_FINITE_ELASTICITY,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,SOLUTION_VALUES_SOLID,err,error,*999) -! CALL FIELD_PARAMETER_SET_DATA_RESTORE(DEPENDENT_FIELD_FINITE_ELASTICITY,FIELD_U_VARIABLE_TYPE, & -! & FIELD_VALUES_SET_TYPE,SOLUTION_VALUES_SOLID,err,error,*999) ! necessary ??? - - ! Write 'DEPENDENT_FIELD_FINITE_ELASTICITY' - IF(DIAGNOSTICS3) THEN - NULLIFY( DUMMY_VALUES2 ) - CALL FIELD_PARAMETER_SET_DATA_GET(DEPENDENT_FIELD_FINITE_ELASTICITY,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,DUMMY_VALUES2,err,error,*999) - NDOFS_TO_PRINT = SIZE(DUMMY_VALUES2,1) - CALL WRITE_STRING_VECTOR(DIAGNOSTIC_OUTPUT_TYPE,1,1,NDOFS_TO_PRINT,NDOFS_TO_PRINT,NDOFS_TO_PRINT,DUMMY_VALUES2, & - & '(" DEPENDENT_FIELD_FINITE_ELASTICITY,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE = ",4(X,E13.6))',& - & '4(4(X,E13.6))',err,error,*999) - CALL FIELD_PARAMETER_SET_DATA_RESTORE(DEPENDENT_FIELD_FINITE_ELASTICITY,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,DUMMY_VALUES2,err,error,*999) - ENDIF - - !--- Third: FIELD_MESH_DISPLACEMENT_SET_TYPE += Deformed absolute position of solid - NUMBER_OF_DOFS = GEOMETRIC_FIELD_DARCY%VARIABLE_TYPE_MAP(FIELD_U_VARIABLE_TYPE)%ptr%NUMBER_OF_DOFS - DO dof_number=1,NUMBER_OF_DOFS - ! assumes fluid-geometry and solid-dependent mesh are identical \todo: introduce check - CALL FIELD_PARAMETER_SET_ADD_LOCAL_DOF(GEOMETRIC_FIELD_DARCY, & - & FIELD_U_VARIABLE_TYPE,FIELD_MESH_DISPLACEMENT_SET_TYPE,dof_number, & - & SOLUTION_VALUES_SOLID(dof_number), & - & err,error,*999) - -!--- !!! Why not directly do the mesh update here ??? !!! - CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(GEOMETRIC_FIELD_DARCY, & - & FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,dof_number, & - & SOLUTION_VALUES_SOLID(dof_number), & - & err,error,*999) -!--- - - END DO - CALL FIELD_PARAMETER_SET_UPDATE_START(GEOMETRIC_FIELD_DARCY, & - & FIELD_U_VARIABLE_TYPE, FIELD_MESH_DISPLACEMENT_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(GEOMETRIC_FIELD_DARCY, & - & FIELD_U_VARIABLE_TYPE, FIELD_MESH_DISPLACEMENT_SET_TYPE,err,error,*999) - ! - CALL FIELD_PARAMETER_SET_UPDATE_START(GEOMETRIC_FIELD_DARCY, & - & FIELD_U_VARIABLE_TYPE, FIELD_VALUES_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(GEOMETRIC_FIELD_DARCY, & - & FIELD_U_VARIABLE_TYPE, FIELD_VALUES_SET_TYPE,err,error,*999) - - ! Write 'FIELD_MESH_DISPLACEMENT_SET_TYPE' - IF(DIAGNOSTICS3) THEN - NULLIFY( DUMMY_VALUES2 ) - CALL FIELD_PARAMETER_SET_DATA_GET(GEOMETRIC_FIELD_DARCY,FIELD_U_VARIABLE_TYPE, & - & FIELD_MESH_DISPLACEMENT_SET_TYPE,DUMMY_VALUES2,err,error,*999) - NDOFS_TO_PRINT = SIZE(DUMMY_VALUES2,1) - CALL WRITE_STRING_VECTOR(DIAGNOSTIC_OUTPUT_TYPE,1,1,NDOFS_TO_PRINT,NDOFS_TO_PRINT,NDOFS_TO_PRINT,DUMMY_VALUES2, & - & '(" GEOMETRIC_FIELD_DARCY,FIELD_U_VARIABLE_TYPE,FIELD_MESH_DISPLACEMENT_SET_TYPE = ",4(X,E13.6))',& - & '4(4(X,E13.6))',err,error,*999) - CALL FIELD_PARAMETER_SET_DATA_RESTORE(GEOMETRIC_FIELD_DARCY,FIELD_U_VARIABLE_TYPE, & - & FIELD_MESH_DISPLACEMENT_SET_TYPE,DUMMY_VALUES2,err,error,*999) - ENDIF - ELSE - ! do nothing - END IF - CASE DEFAULT - localError="Problem subtype "//TRIM(NumberToVString(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - - EXITS("Darcy_PreSolveGetSolidDisplacement") - RETURN -999 ERRORSEXITS("Darcy_PreSolveGetSolidDisplacement",err,error) - RETURN 1 - - END SUBROUTINE Darcy_PreSolveGetSolidDisplacement - - ! - !================================================================================================================================ - - !>Store solution of previous subiteration iterate - SUBROUTINE Darcy_PreSolveStorePreviousIterate(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !SOLVER%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN - SOLVER_MAPPING=>SOLVER_equations%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING)) THEN - !loop over the equations sets - DO equations_set_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS - EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(equations_set_idx)%ptr - IF(ASSOCIATED(EQUATIONS_SET)) THEN - IF(.NOT.ALLOCATED(EQUATIONS_SET%SPECIFICATION)) THEN - CALL FlagError("Equations set specification is not allocated.",err,error,*999) - ELSE IF(SIZE(EQUATIONS_SET%SPECIFICATION,1)/=3) THEN - CALL FlagError("Equations set specification must have three entries for a Darcy type equations set.", & - & err,error,*999) - END IF - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE) - ! do nothing - CASE(EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE) - ! do nothing - CASE(EQUATIONS_SET_ALE_DARCY_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE,EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - DEPENDENT_FIELD=>EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD - - IF(ASSOCIATED(DEPENDENT_FIELD)) THEN - write(*,*)'-------------------------------------------------------' - write(*,*)'+++ Storing previous subiteration iterate +++' - write(*,*)'-------------------------------------------------------' - !--- Store the DEPENDENT field values of the previous subiteration iterate - vectorMapping=>EQUATIONS_SET%equations%vectorEquations%vectorMapping - IF(ASSOCIATED(vectorMapping)) THEN - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_ALE_DARCY_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE) - FIELD_VARIABLE=>vectorMapping%linearMapping%equationsMatrixToVarMaps(1)%VARIABLE - ! '1' associated with linear matrix - CASE(EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE,EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - FIELD_VARIABLE=>vectorMapping%dynamicMapping%equationsMatrixToVarMaps(1)%VARIABLE - END SELECT - IF(ASSOCIATED(FIELD_VARIABLE)) THEN - FIELD_VAR_TYPE=FIELD_VARIABLE%VARIABLE_TYPE - ALPHA = 1.0_DP - CALL FIELD_PARAMETER_SETS_COPY(DEPENDENT_FIELD,FIELD_VAR_TYPE, & - & FIELD_VALUES_SET_TYPE,FIELD_PREVIOUS_ITERATION_VALUES_SET_TYPE,ALPHA,err,error,*999) - ELSE - CALL FlagError("FIELD_VAR_TYPE is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("vectorMapping is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Dependent field is not associated.",err,error,*999) - ENDIF - CASE DEFAULT - localError="Equations set subtype " & - & //TRIM(NumberToVString(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - ENDIF - ENDDO - ELSE - CALL FlagError("Solver mapping is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver equations is not associated.",err,error,*999) - ENDIF - CASE DEFAULT - localError="Problem subtype "//TRIM(NumberToVString(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - ! do nothing - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - - EXITS("Darcy_PreSolveStorePreviousIterate") - RETURN -999 ERRORSEXITS("Darcy_PreSolveStorePreviousIterate",err,error) - RETURN 1 - - END SUBROUTINE Darcy_PreSolveStorePreviousIterate - - ! - !================================================================================================================================ - ! - !updates the boundary conditions etc to the required analytic values - !for the case EquationsSetIncompElastDarcyAnalyticDarcy the pressure field obtained from the finite elasticity solve is overwritten - !by the appropriate mass increase for that time step - SUBROUTINE Darcy_PreSolveUpdateAnalyticValues(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !CONTROL_LOOP - DO loop_idx=1,CONTROL_LOOP%CONTROL_LOOP_LEVEL - IF(CONTROL_TIME_LOOP%LOOP_TYPE==PROBLEM_CONTROL_TIME_LOOP_TYPE) THEN - CALL CONTROL_LOOP_CURRENT_TIMES_GET(CONTROL_TIME_LOOP,CURRENT_TIME,TIME_INCREMENT,err,error,*999) - EXIT - ENDIF - IF (ASSOCIATED(CONTROL_LOOP%PARENT_LOOP)) THEN - CONTROL_TIME_LOOP=>CONTROL_TIME_LOOP%PARENT_LOOP - ELSE - CALL FlagError("Could not find a time control loop.",err,error,*999) - ENDIF - ENDDO - -! IF(ASSOCIATED(CONTROL_LOOP)) THEN -! CALL CONTROL_LOOP_CURRENT_TIMES_GET(CONTROL_LOOP,CURRENT_TIME,TIME_INCREMENT,err,error,*999) - !write(*,*)'CURRENT_TIME = ',CURRENT_TIME - !write(*,*)'TIME_INCREMENT = ',TIME_INCREMENT - IF(ASSOCIATED(SOLVER)) THEN - IF(ASSOCIATED(CONTROL_LOOP%PROBLEM)) THEN - IF(.NOT.ALLOCATED(CONTROL_LOOP%PROBLEM%SPECIFICATION)) THEN - CALL FlagError("Problem specification is not allocated.",err,error,*999) - ELSE IF(SIZE(CONTROL_LOOP%PROBLEM%SPECIFICATION,1)<3) THEN - CALL FlagError("Problem specification must have three entries for a Darcy equation problem.",err,error,*999) - END IF - SELECT CASE(CONTROL_LOOP%PROBLEM%SPECIFICATION(3)) - CASE(PROBLEM_QUASISTATIC_ELASTICITY_TRANSIENT_DARCY_SUBTYPE,PROBLEM_QUASISTATIC_ELAST_TRANS_DARCY_MAT_SOLVE_SUBTYPE) - SOLVER_EQUATIONS=>SOLVER%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN - !loop over all the equation sets and set the appropriate field variable type BCs and - !the source field associated with each equation set - DO eqnset_idx=1,SOLVER_equations%SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS - SOLVER_MAPPING=>SOLVER_equations%SOLVER_MAPPING - EQUATIONS=>SOLVER_MAPPING%EQUATIONS_SET_TO_SOLVER_MAP(eqnset_idx)%EQUATIONS - IF(ASSOCIATED(EQUATIONS)) THEN - EQUATIONS_SET=>equations%equationsSet - IF(ASSOCIATED(EQUATIONS_SET)) THEN - IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN - IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_INCOMP_ELAST_DARCY_ANALYTIC_DARCY)THEN - !for this analytic case we copy the mass variable to the pressure variable - DEPENDENT_FIELD=>EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD - IF(ASSOCIATED(DEPENDENT_FIELD)) THEN - GEOMETRIC_FIELD=>EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD - IF(ASSOCIATED(GEOMETRIC_FIELD)) THEN - CALL FIELD_NUMBER_OF_COMPONENTS_GET(GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE,& - & NUMBER_OF_DIMENSIONS,err,error,*999) - NULLIFY(GEOMETRIC_VARIABLE) - NULLIFY(GEOMETRIC_PARAMETERS) - CALL Field_VariableGet(GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE,GEOMETRIC_VARIABLE,err,error,*999) - CALL FIELD_PARAMETER_SET_DATA_GET(GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,& - & GEOMETRIC_PARAMETERS,err,error,*999) - EQUATIONS_SET%ANALYTIC%ANALYTIC_USER_PARAMS(1)=CURRENT_TIME -! DO variable_idx=1,DEPENDENT_FIELD%NUMBER_OF_VARIABLES - !variable_type=DEPENDENT_FIELD%VARIABLES(2*eqnset_idx-1)%VARIABLE_TYPE - variable_type=FIELD_V_VARIABLE_TYPE - FIELD_VARIABLE=>DEPENDENT_FIELD%VARIABLE_TYPE_MAP(variable_type)%ptr - IF(ASSOCIATED(FIELD_VARIABLE)) THEN -! DO component_idx=4,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - - - CALL Field_ParametersToFieldParametersCopy(DEPENDENT_FIELD,FIELD_V_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,4,DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,4,err,error,*999) - -! IF(FIELD_VARIABLE%COMPONENTS(component_idx)%INTERPOLATION_TYPE== & -! & FIELD_NODE_BASED_INTERPOLATION) THEN -! DOMAIN=>FIELD_VARIABLE%COMPONENTS(component_idx)%DOMAIN -! IF(ASSOCIATED(DOMAIN)) THEN -! IF(ASSOCIATED(DOMAIN%TOPOLOGY)) THEN -! DOMAIN_NODES=>DOMAIN%TOPOLOGY%NODES -! IF(ASSOCIATED(DOMAIN_NODES)) THEN -! !Loop over the local nodes excluding the ghosts. -! DO node_idx=1,DOMAIN_NODES%NUMBER_OF_NODES -! CALL FIELD_PARAMETER_SET_GET_NODE(DEPENDENT_FIELD,FIELD_V_VARIABLE_TYPE, & -! & FIELD_VALUES_SET_TYPE,1,node_idx,4,MASS_INCREASE,err,error,*999) -! CALL FIELD_PARAMETER_SET_UPDATE_NODE(DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & -! & FIELD_VALUES_SET_TYPE,1,node_idx,4,0.1*MASS_INCREASE,err,error,*999) -! write(*,*) MASS_INCREASE -! -! !!TODO \todo We should interpolate the geometric field here and the node position. -! ! DO dim_idx=1,NUMBER_OF_DIMENSIONS -! ! local_ny= & -! ! & GEOMETRIC_VARIABLE%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP(1,node_idx) -! ! X(dim_idx)=GEOMETRIC_PARAMETERS(local_ny) -! ! ENDDO !dim_idx -! ! !Loop over the derivatives -! ! DO deriv_idx=1,DOMAIN_NODES%NODES(node_idx)%NUMBER_OF_DERIVATIVES -! ! ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE -! ! GLOBAL_DERIV_INDEX=DOMAIN_NODES%NODES(node_idx)%GLOBAL_DERIVATIVE_INDEX(deriv_idx) -! ! ! CALL DIFFUSION_EQUATION_ANALYTIC_FUNCTIONS(VALUE,X, & -! ! ! & CURRENT_TIME,variable_type,GLOBAL_DERIV_INDEX, & -! ! ! & ANALYTIC_FUNCTION_TYPE,err,error,*999) -! ! local_ny=FIELD_VARIABLE%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% & -! ! & NODE_PARAM2DOF_MAP(deriv_idx,node_idx) -! ! CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(DEPENDENT_FIELD,variable_type, & -! ! & FIELD_ANALYTIC_VALUES_SET_TYPE,local_ny,VALUE,err,error,*999) -! ! ! BOUNDARY_CONDITION_CHECK_VARIABLE=SOLVER_equations%BOUNDARY_CONDITIONS% & -! ! ! & BOUNDARY_CONDITIONS_VARIABLE_TYPE_MAP(variable_type)%ptr% & -! ! ! & CONDITION_TYPES(local_ny) -! ! ! IF(BOUNDARY_CONDITION_CHECK_VARIABLE==BOUNDARY_CONDITION_FIXED) THEN -! ! ! CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(DEPENDENT_FIELD, & -! ! ! & variable_type,FIELD_VALUES_SET_TYPE,local_ny, & -! ! ! & VALUE,err,error,*999) -! ! ! ENDIF -! ! -! ! ! IF(variable_type==FIELD_U_VARIABLE_TYPE) THEN -! ! ! IF(DOMAIN_NODES%NODES(node_idx)%BOUNDARY_NODE) THEN -! ! !If we are a boundary node then set the analytic value on the boundary -! ! ! CALL BOUNDARY_CONDITIONS_SET_LOCAL_DOF(BOUNDARY_CONDITIONS,variable_type,local_ny, & -! ! ! & BOUNDARY_CONDITION_FIXED,VALUE,err,error,*999) -! ! ! ENDIF -! ! ! ENDIF -! ! ENDDO !deriv_idx -! ENDDO !node_idx -! ELSE -! CALL FlagError("Domain topology nodes is not associated.",err,error,*999) -! ENDIF -! ELSE -! CALL FlagError("Domain topology is not associated.",err,error,*999) -! ENDIF -! ELSE -! CALL FlagError("Domain is not associated.",err,error,*999) -! ENDIF -! ELSE -! CALL FlagError("Only node based interpolation is implemented.",err,error,*999) -! ENDIF -! ENDDO !component_idx - CALL FIELD_PARAMETER_SET_UPDATE_START(DEPENDENT_FIELD,variable_type, & - & FIELD_ANALYTIC_VALUES_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(DEPENDENT_FIELD,variable_type, & - & FIELD_ANALYTIC_VALUES_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_START(DEPENDENT_FIELD,variable_type, & - & FIELD_VALUES_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(DEPENDENT_FIELD,variable_type, & - & FIELD_VALUES_SET_TYPE,err,error,*999) - ELSE - CALL FlagError("Field variable is not associated.",err,error,*999) - ENDIF - -! ENDDO !variable_idx - CALL FIELD_PARAMETER_SET_DATA_RESTORE(GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE,& - & FIELD_VALUES_SET_TYPE,GEOMETRIC_PARAMETERS,err,error,*999) - ELSE - CALL FlagError("Equations set geometric field is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set dependent field is not associated.",err,error,*999) - ENDIF - ENDIF - ELSE - !CALL FlagError("Equations set analytic is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations are not associated.",err,error,*999) - END IF -! ELSE -! CALL FlagError("Solver equations are not associated.",err,error,*999) -! END IF - CALL FIELD_PARAMETER_SET_UPDATE_START(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_V_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_V_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,err,error,*999) -! IF(CONTROL_LOOP%PROBLEM%SPECIFICATION(3)==PROBLEM_LINEAR_SOURCE_DIFFUSION_SUBTYPE)THEN -! !>Set the source field to a specified analytical function -!MAY NEED TO USE THIS ULTIMATELY - BUT WILL REQUIRE IMPLEMENTING SOURCE FIELD & VECTOR FUNCTIONALITY FOR DARCY EQUATION -! IF(ASSOCIATED(EQUATIONS_SET)) THEN -! IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN -! sourceField=>EQUATIONS_SET%SOURCE%SOURCE_FIELD -! IF(ASSOCIATED(sourceField)) THEN -! GEOMETRIC_FIELD=>EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD -! IF(ASSOCIATED(GEOMETRIC_FIELD)) THEN -! CALL FIELD_NUMBER_OF_COMPONENTS_GET(GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE,NUMBER_OF_DIMENSIONS,err,error,*999) -! NULLIFY(GEOMETRIC_VARIABLE) -! CALL Field_VariableGet(GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE,GEOMETRIC_VARIABLE,err,error,*999) -! CALL FIELD_PARAMETER_SET_DATA_GET(GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, & -! & GEOMETRIC_PARAMETERS,err,error,*999) -! variable_type=FIELD_U_VARIABLE_TYPE -! FIELD_VARIABLE=>sourceField%VARIABLE_TYPE_MAP(variable_type)%ptr -! IF(ASSOCIATED(FIELD_VARIABLE)) THEN -! DO component_idx=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS -! IF(FIELD_VARIABLE%COMPONENTS(component_idx)%INTERPOLATION_TYPE==FIELD_NODE_BASED_INTERPOLATION) THEN -! DOMAIN=>FIELD_VARIABLE%COMPONENTS(component_idx)%DOMAIN -! IF(ASSOCIATED(DOMAIN)) THEN -! IF(ASSOCIATED(DOMAIN%TOPOLOGY)) THEN -! DOMAIN_NODES=>DOMAIN%TOPOLOGY%NODES -! IF(ASSOCIATED(DOMAIN_NODES)) THEN -! !Loop over the local nodes excluding the ghosts. -! DO node_idx=1,DOMAIN_NODES%NUMBER_OF_NODES -! !!TODO \todo We should interpolate the geometric field here and the node position. -! DO dim_idx=1,NUMBER_OF_DIMENSIONS -! local_ny=GEOMETRIC_VARIABLE%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP(1,& -! & node_idx) -! X(dim_idx)=GEOMETRIC_PARAMETERS(local_ny) -! ENDDO !dim_idx -! !Loop over the derivatives -! DO deriv_idx=1,DOMAIN_NODES%NODES(node_idx)%NUMBER_OF_DERIVATIVES -! SELECT CASE(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE) -! CASE(EQUATIONS_SET_DIFFUSION_EQUATION_THREE_DIM_1) -! VALUE_SOURCE=-1*A1*EXP(-1*CURRENT_TIME)*(X(1)*X(1)+X(2)*X(2)+X(3)*X(3)+6) -! CASE DEFAULT -! localError="The analytic function type of "// & -! & TRIM(NumberToVString(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE,"*",err,error))//& -! & " is invalid." -! CALL FlagError(localError,err,error,*999) -! END SELECT -! local_ny=FIELD_VARIABLE%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% & -! & NODE_PARAM2DOF_MAP(deriv_idx,node_idx) -! CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(sourceField,FIELD_U_VARIABLE_TYPE, & -! & FIELD_VALUES_SET_TYPE,local_ny,VALUE_SOURCE,err,error,*999) -! ENDDO !deriv_idx -! ENDDO !node_idx -! ELSE -! CALL FlagError("Domain topology nodes is not associated.",err,error,*999) -! ENDIF -! ELSE -! CALL FlagError("Domain topology is not associated.",err,error,*999) -! ENDIF -! ELSE -! CALL FlagError("Domain is not associated.",err,error,*999) -! ENDIF -! ELSE -! CALL FlagError("Only node based interpolation is implemented.",err,error,*999) -! ENDIF -! ENDDO !component_idx -! CALL FIELD_PARAMETER_SET_UPDATE_START(sourceField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, & -! & err,error,*999) -! CALL FIELD_PARAMETER_SET_UPDATE_FINISH(sourceField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, & -! & err,error,*999) -! ELSE -! CALL FlagError("Field variable is not associated.",err,error,*999) -! ENDIF -! CALL FIELD_PARAMETER_SET_DATA_RESTORE(GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, & -! & GEOMETRIC_PARAMETERS,err,error,*999) -! ELSE -! CALL FlagError("Equations set geometric field is not associated.",err,error,*999) -! ENDIF -! ELSE -! CALL FlagError("Equations set source field is not associated.",err,error,*999) -! ENDIF -! ELSE -! CALL FlagError("Equations set analytic is not associated.",err,error,*999) -! ENDIF -! ELSE -! CALL FlagError("Equations set is not associated.",err,error,*999) -! ENDIF -! ENDIF - ENDDO !eqnset_idx - ELSE - CALL FlagError("Solver equations are not associated.",err,error,*999) - END IF - CASE DEFAULT - localError="Problem subtype "//TRIM(NumberToVString(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy equation type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - - EXITS("Darcy_PreSolveUpdateAnalyticValues") - RETURN -999 ERRORSEXITS("Darcy_PreSolveUpdateAnalyticValues",err,error) - RETURN 1 - - END SUBROUTINE Darcy_PreSolveUpdateAnalyticValues - - ! - !================================================================================================================================ - ! - !> Monitor convergence of the Darcy solution - SUBROUTINE DARCY_EQUATION_MONITOR_CONVERGENCE(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !SOLVER%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN - SOLVER_MAPPING=>SOLVER_equations%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING)) THEN -! EQUATIONS=>SOLVER_MAPPING%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS -! IF(ASSOCIATED(EQUATIONS)) THEN -! EQUATIONS_SET=>equations%equationsSet - DO equations_set_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS - EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(equations_set_idx)%ptr - IF(ASSOCIATED(EQUATIONS_SET)) THEN - IF(.NOT.ALLOCATED(EQUATIONS_SET%SPECIFICATION)) THEN - CALL FlagError("Equations set specification is not allocated.",err,error,*999) - ELSE IF(SIZE(EQUATIONS_SET%SPECIFICATION,1)/=3) THEN - CALL FlagError("Equations set specification must have three entries for a Darcy type equations set.", & - & err,error,*999) - END IF - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE,EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE, & - & EQUATIONS_SET_ALE_DARCY_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE) - ! do nothing - CASE(EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Darcy monitor convergence ... ",err,error,*999) - DEPENDENT_FIELD=>EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD - IF(ASSOCIATED(DEPENDENT_FIELD)) THEN - vectorMapping=>EQUATIONS_SET%equations%vectorEquations%vectorMapping - IF(ASSOCIATED(vectorMapping)) THEN - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_ALE_DARCY_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE) - FIELD_VARIABLE=>vectorMapping%linearMapping%equationsMatrixToVarMaps(1)%VARIABLE - ! '1' associated with linear matrix - CASE(EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE,EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - FIELD_VARIABLE=>vectorMapping%dynamicMapping%equationsMatrixToVarMaps(1)%VARIABLE - END SELECT - IF(ASSOCIATED(FIELD_VARIABLE)) THEN - FIELD_VAR_TYPE=FIELD_VARIABLE%VARIABLE_TYPE - - !iter 1 - NULLIFY(ITERATION_VALUES_N) - CALL FIELD_PARAMETER_SET_DATA_GET(DEPENDENT_FIELD,FIELD_VAR_TYPE, & - & FIELD_PREVIOUS_ITERATION_VALUES_SET_TYPE,ITERATION_VALUES_N,err,error,*999) - - !iter 2 - NULLIFY(ITERATION_VALUES_N1) - CALL FIELD_PARAMETER_SET_DATA_GET(DEPENDENT_FIELD,FIELD_VAR_TYPE, & - & FIELD_VALUES_SET_TYPE,ITERATION_VALUES_N1,err,error,*999) - - RESIDUAL_NORM = 0.0_DP - NUMBER_OF_DOFS = DEPENDENT_FIELD%VARIABLE_TYPE_MAP(FIELD_VAR_TYPE)%ptr%NUMBER_OF_DOFS - DO dof_number=1,NUMBER_OF_DOFS - RESIDUAL_NORM = RESIDUAL_NORM + & - & ( ITERATION_VALUES_N1(dof_number) - ITERATION_VALUES_N(dof_number) )**2.0_DP - END DO - RESIDUAL_NORM = SQRT(RESIDUAL_NORM / NUMBER_OF_DOFS) - - IF(CONTROL_LOOP%LOOP_TYPE==PROBLEM_CONTROL_WHILE_LOOP_TYPE) THEN - IF(CONTROL_LOOP%WHILE_LOOP%ITERATION_NUMBER>=2) THEN !Omit initialised solution - IF(CONTROL_LOOP%WHILE_LOOP%ITERATION_NUMBER==2) THEN - RESIDUAL_NORM_0 = RESIDUAL_NORM - WRITE(23,*) 'RESIDUAL_NORM_0 = ',RESIDUAL_NORM_0 - WRITE(23,*) 'R / R0 :' - ENDIF - write(*,*)'-------------------------------------------------------' - write(*,*)'+++ RESIDUAL_NORM = +++',RESIDUAL_NORM - write(*,*)'+++ RESIDUAL_NORM_0 = +++',RESIDUAL_NORM_0 - write(*,*)'+++ R / R_0 = +++',RESIDUAL_NORM / RESIDUAL_NORM_0 - write(*,*)'-------------------------------------------------------' - WRITE(23,*) RESIDUAL_NORM / RESIDUAL_NORM_0 - - !End subiteration loop if residual is small relative to residual in first step - IF((RESIDUAL_NORM/RESIDUAL_NORM_0)<=RESIDUAL_TOLERANCE_RELATIVE .OR. & - & RESIDUAL_NORM<=RESIDUAL_TOLERANCE_ABSOLUTE ) THEN - write(*,*)'++++++++++++++++++++++++++++++++++++' - write(*,*)'+++ SUBITERATION CONVERGED +++' - write(*,*)'++++++++++++++++++++++++++++++++++++' - CONTROL_LOOP%WHILE_LOOP%CONTINUE_LOOP=.FALSE. - ELSE IF(CONTROL_LOOP%WHILE_LOOP%ITERATION_NUMBER== & - & CONTROL_LOOP%WHILE_LOOP%MAXIMUM_NUMBER_OF_ITERATIONS) THEN - CALL FLAG_WARNING("Subiterations between solid and fluid "// & - & "equations did not converge.",err,error,*999) - ENDIF - ENDIF - ELSE - CALL FlagError("DARCY_EQUATION_MONITOR_CONVERGENCE must be called "// & - & "with a while control loop",err,error,*999) - ENDIF - - -! SUBITERATION_NUMBER = CONTROL_LOOP%WHILE_LOOP%ITERATION_NUMBER -! -! WRITE(FILENAME,'("Darcy_DOFs_N_",I2.2,".dat")') SUBITERATION_NUMBER -! FILEPATH = "./output/"//FILENAME -! FILEUNIT_N = 7777 + 2*SUBITERATION_NUMBER -! OPEN(UNIT=FILEUNIT_N,FILE=CHAR(FILEPATH),STATUS='unknown',ACCESS='append') -! DO dof_number=1,NUMBER_OF_DOFS -! WRITE(FILEUNIT_N,*) ITERATION_VALUES_N(dof_number) -! END DO -! -! -! WRITE(FILENAME,'("Darcy_DOFs_N1_",I2.2,".dat")') SUBITERATION_NUMBER -! FILEPATH = "./output/"//FILENAME -! FILEUNIT_N1 = 7777 + 2*SUBITERATION_NUMBER+1 -! OPEN(UNIT=FILEUNIT_N1,FILE=CHAR(FILEPATH),STATUS='unknown',ACCESS='append') -! DO dof_number=1,NUMBER_OF_DOFS -! WRITE(FILEUNIT_N1,*) ITERATION_VALUES_N1(dof_number) -! END DO - - - CALL FIELD_PARAMETER_SET_DATA_RESTORE(DEPENDENT_FIELD,FIELD_VAR_TYPE, & - & FIELD_PREVIOUS_ITERATION_VALUES_SET_TYPE,ITERATION_VALUES_N,err,error,*999) - CALL FIELD_PARAMETER_SET_DATA_RESTORE(DEPENDENT_FIELD,FIELD_VAR_TYPE, & - & FIELD_VALUES_SET_TYPE,ITERATION_VALUES_N1,err,error,*999) - - ELSE - CALL FlagError("FIELD_VAR_TYPE is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("vectorMapping is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Dependent field is not associated.",err,error,*999) - END IF - CASE DEFAULT - localError="Equations set subtype " & - & //TRIM(NumberToVString(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - END IF - ENDDO -! ELSE -! CALL FlagError("Equations are not associated.",err,error,*999) -! END IF - ELSE - CALL FlagError("Solver mapping is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver equations are not associated.",err,error,*999) - END IF - CASE DEFAULT - localError="Problem subtype "//TRIM(NumberToVString(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - ! do nothing - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - - CLOSE(23) - CLOSE(FILEUNIT_N) - CLOSE(FILEUNIT_N1) - - EXITS("DARCY_EQUATION_MONITOR_CONVERGENCE") - RETURN -999 ERRORSEXITS("DARCY_EQUATION_MONITOR_CONVERGENCE",err,error) - RETURN 1 - END SUBROUTINE DARCY_EQUATION_MONITOR_CONVERGENCE - - ! - !================================================================================================================================ - ! - - !> Accelerate convergence of the Darcy solution - SUBROUTINE DARCY_EQUATION_ACCELERATE_CONVERGENCE(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !SOLVER%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN - SOLVER_MAPPING=>SOLVER_equations%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING)) THEN - DO equations_set_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS - EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(equations_set_idx)%ptr -! EQUATIONS=>SOLVER_MAPPING%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS -! IF(ASSOCIATED(EQUATIONS)) THEN -! EQUATIONS_SET=>equations%equationsSet - IF(ASSOCIATED(EQUATIONS_SET)) THEN - IF(.NOT.ALLOCATED(EQUATIONS_SET%SPECIFICATION)) THEN - CALL FlagError("Equations set specification is not allocated.",err,error,*999) - ELSE IF(SIZE(EQUATIONS_SET%SPECIFICATION,1)/=3) THEN - CALL FlagError("Equations set specification must have three entries for a Darcy type equations set.", & - & err,error,*999) - END IF - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STANDARD_DARCY_SUBTYPE,EQUATIONS_SET_QUASISTATIC_DARCY_SUBTYPE, & - & EQUATIONS_SET_ALE_DARCY_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE) - ! do nothing - CASE(EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) -! CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Darcy accelerate convergence ... ",err,error,*999) - DEPENDENT_FIELD=>EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD - IF(ASSOCIATED(DEPENDENT_FIELD)) THEN - vectorMapping=>EQUATIONS_SET%equations%vectorEquations%vectorMapping - IF(ASSOCIATED(vectorMapping)) THEN - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_ALE_DARCY_SUBTYPE,EQUATIONS_SET_INCOMPRESSIBLE_FINITE_ELASTICITY_DARCY_SUBTYPE) - FIELD_VARIABLE=>vectorMapping%linearMapping%equationsMatrixToVarMaps(1)%VARIABLE - ! '1' associated with linear matrix - CASE(EQUATIONS_SET_TRANSIENT_ALE_DARCY_SUBTYPE,EQUATIONS_SET_ELASTICITY_DARCY_INRIA_MODEL_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELASTICITY_DRIVEN_DARCY_SUBTYPE, & - & EQUATIONS_SET_INCOMPRESSIBLE_ELAST_MULTI_COMP_DARCY_SUBTYPE) - FIELD_VARIABLE=>vectorMapping%dynamicMapping%equationsMatrixToVarMaps(1)%VARIABLE - END SELECT - IF(ASSOCIATED(FIELD_VARIABLE)) THEN - FIELD_VAR_TYPE=FIELD_VARIABLE%VARIABLE_TYPE - - !iter 1 - NULLIFY(ITERATION_VALUES_N) - CALL FIELD_PARAMETER_SET_DATA_GET(DEPENDENT_FIELD,FIELD_VAR_TYPE, & - & FIELD_PREVIOUS_ITERATION_VALUES_SET_TYPE,ITERATION_VALUES_N,err,error,*999) - - !iter 2 - NULLIFY(ITERATION_VALUES_N1) - CALL FIELD_PARAMETER_SET_DATA_GET(DEPENDENT_FIELD,FIELD_VAR_TYPE, & - & FIELD_VALUES_SET_TYPE,ITERATION_VALUES_N1,err,error,*999) - -! RESIDUAL_NORM = 0.0_DP - NUMBER_OF_DOFS = DEPENDENT_FIELD%VARIABLE_TYPE_MAP(FIELD_VAR_TYPE)%ptr%NUMBER_OF_DOFS - -! DO dof_number=1,NUMBER_OF_DOFS -! RESIDUAL_NORM = RESIDUAL_NORM + & -! & ( ITERATION_VALUES_N1(dof_number) - ITERATION_VALUES_N(dof_number) )**2.0_DP -! END DO -! RESIDUAL_NORM = SQRT(RESIDUAL_NORM / NUMBER_OF_DOFS) - - RELAXATION_PARAM = 2.0_DP !\ToDo Devise better way of determining optimal Aitken parameter - - IF( CONTROL_LOOP%WHILE_LOOP%ITERATION_NUMBER>2 )THEN - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Darcy accelerate convergence ... ",err,error,*999) - DO dof_number=1,NUMBER_OF_DOFS - ACCELERATED_VALUE = ITERATION_VALUES_N(dof_number) & - & + RELAXATION_PARAM * ( ITERATION_VALUES_N1(dof_number) - ITERATION_VALUES_N(dof_number) ) - CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(DEPENDENT_FIELD, & - & FIELD_VAR_TYPE,FIELD_VALUES_SET_TYPE,dof_number, & - & ACCELERATED_VALUE,err,error,*999) - END DO - CALL FIELD_PARAMETER_SET_UPDATE_START(DEPENDENT_FIELD, & - & FIELD_VAR_TYPE, FIELD_VALUES_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(DEPENDENT_FIELD, & - & FIELD_VAR_TYPE, FIELD_VALUES_SET_TYPE,err,error,*999) - END IF - CALL FIELD_PARAMETER_SET_DATA_RESTORE(DEPENDENT_FIELD,FIELD_VAR_TYPE, & - & FIELD_PREVIOUS_ITERATION_VALUES_SET_TYPE,ITERATION_VALUES_N,err,error,*999) - CALL FIELD_PARAMETER_SET_DATA_RESTORE(DEPENDENT_FIELD,FIELD_VAR_TYPE, & - & FIELD_VALUES_SET_TYPE,ITERATION_VALUES_N1,err,error,*999) - - ELSE - CALL FlagError("FIELD_VAR_TYPE is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("vectorMapping is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Dependent field is not associated.",err,error,*999) - END IF - CASE DEFAULT - localError="Equations set subtype " & - & //TRIM(NumberToVString(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - END IF - ENDDO -! ELSE -! CALL FlagError("Equations are not associated.",err,error,*999) -! END IF - ELSE - CALL FlagError("Solver mapping is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver equations are not associated.",err,error,*999) - END IF - CASE DEFAULT - localError="Problem subtype "//TRIM(NumberToVString(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - ! do nothing - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - - EXITS("DARCY_EQUATION_ACCELERATE_CONVERGENCE") - RETURN -999 ERRORSEXITS("DARCY_EQUATION_ACCELERATE_CONVERGENCE",err,error) - RETURN 1 - END SUBROUTINE DARCY_EQUATION_ACCELERATE_CONVERGENCE - - ! - !================================================================================================================================ - ! - - - - !================================================================================================================================ - ! - - !> Allows to set an explicit Darcy mass increase to test finite elasticity - !> (and only then this function is called, but not for the coupled problem) - SUBROUTINE DARCY_EQUATION_POST_SOLVE_SET_MASS_INCREASE(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !CONTROL_LOOP - DO loop_idx=1,CONTROL_LOOP%CONTROL_LOOP_LEVEL - IF(CONTROL_TIME_LOOP%LOOP_TYPE==PROBLEM_CONTROL_TIME_LOOP_TYPE) THEN - CALL CONTROL_LOOP_CURRENT_TIMES_GET(CONTROL_TIME_LOOP,CURRENT_TIME,TIME_INCREMENT,err,error,*999) - EXIT - ENDIF - IF (ASSOCIATED(CONTROL_LOOP%PARENT_LOOP)) THEN - CONTROL_TIME_LOOP=>CONTROL_TIME_LOOP%PARENT_LOOP - ELSE - CALL FlagError("Could not find a time control loop.",err,error,*999) - ENDIF - ENDDO - - IF(DIAGNOSTICS1) THEN - CALL WRITE_STRING(DIAGNOSTIC_OUTPUT_TYPE, & - & "*******************************************************************************************************", & - & err,error,*999) - CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"CURRENT_TIME = ",CURRENT_TIME,err,error,*999) - CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"TIME_INCREMENT = ",TIME_INCREMENT,err,error,*999) - CALL WRITE_STRING(DIAGNOSTIC_OUTPUT_TYPE, & - & "*******************************************************************************************************", & - & err,error,*999) - ENDIF - - IF(ASSOCIATED(SOLVER)) THEN - IF(ASSOCIATED(CONTROL_LOOP%PROBLEM)) THEN - ROOT_CONTROL_LOOP=>CONTROL_LOOP%PROBLEM%CONTROL_LOOP - IF(.NOT.ALLOCATED(CONTROL_LOOP%PROBLEM%SPECIFICATION)) THEN - CALL FlagError("Problem specification is not allocated.",err,error,*999) - ELSE IF(SIZE(CONTROL_LOOP%PROBLEM%SPECIFICATION,1)<3) THEN - CALL FlagError("Problem specification must have three entries for a Darcy equation problem.",err,error,*999) - END IF - SELECT CASE(CONTROL_LOOP%PROBLEM%SPECIFICATION(3)) - CASE(PROBLEM_STANDARD_DARCY_SUBTYPE) - ! do nothing - CASE(PROBLEM_QUASISTATIC_DARCY_SUBTYPE) - ! do nothing - CASE(PROBLEM_TRANSIENT_DARCY_SUBTYPE) - ! do nothing - CASE(PROBLEM_ALE_DARCY_SUBTYPE) - ! do nothing - CASE(PROBLEM_STANDARD_ELASTICITY_DARCY_SUBTYPE,PROBLEM_QUASISTATIC_ELASTICITY_TRANSIENT_DARCY_SUBTYPE, & - & PROBLEM_QUASISTATIC_ELAST_TRANS_DARCY_MAT_SOLVE_SUBTYPE) - !--- Mass increase specified - IF(SOLVER%GLOBAL_NUMBER==SOLVER_NUMBER_DARCY) THEN !It is called with 'SOLVER%GLOBAL_NUMBER=SOLVER_NUMBER_DARCY', otherwise it doesn't work - !--- Get the dependent field of the Darcy equations - CALL SOLVERS_SOLVER_GET(SOLVER%SOLVERS,SOLVER_NUMBER_DARCY,SOLVER_DARCY,err,error,*999) - SOLVER_EQUATIONS_DARCY=>SOLVER_DARCY%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS_DARCY)) THEN - SOLVER_MAPPING_DARCY=>SOLVER_EQUATIONS_DARCY%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING_DARCY)) THEN - EQUATIONS_SET_DARCY=>SOLVER_MAPPING_DARCY%EQUATIONS_SETS(1)%ptr - IF(ASSOCIATED(EQUATIONS_SET_DARCY)) THEN - DEPENDENT_FIELD_DARCY=>EQUATIONS_SET_DARCY%DEPENDENT%DEPENDENT_FIELD - IF(ASSOCIATED(DEPENDENT_FIELD_DARCY)) THEN - ! do nothing - ELSE - CALL FlagError("GEOMETRIC_FIELD_DARCY is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Darcy equations set is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Darcy solver mapping is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Darcy solver equations are not associated.",err,error,*999) - END IF - - ! Set the mass increase for Darcy dependent field (u, v, w; m) - -! ALPHA = 2.0E-03_DP - -! ALPHA = 5.0E-04_DP * CURRENT_TIME / TIME_INCREMENT - - ALPHA = 5.0E-04_DP * SIN(2.0_DP * PI * CURRENT_TIME / TIME_INCREMENT / 20.0_DP) - - write(*,*)'ALPHA = ',ALPHA - - NUMBER_OF_DOFS = DEPENDENT_FIELD_DARCY%VARIABLE_TYPE_MAP(FIELD_V_VARIABLE_TYPE)%ptr%NUMBER_OF_DOFS - - DO dof_number = 3/4*NUMBER_OF_DOFS + 1, NUMBER_OF_DOFS - !'3/4' only works for equal order interpolation in (u,v,w) and p - CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(DEPENDENT_FIELD_DARCY, & - & FIELD_V_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,dof_number, & - & ALPHA,err,error,*999) - END DO - CALL FIELD_PARAMETER_SET_UPDATE_START(DEPENDENT_FIELD_DARCY, & - & FIELD_U_VARIABLE_TYPE, FIELD_VALUES_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(DEPENDENT_FIELD_DARCY, & - & FIELD_U_VARIABLE_TYPE, FIELD_VALUES_SET_TYPE,err,error,*999) - - ELSE - ! do nothing - END IF - CASE DEFAULT - localError="Problem subtype "//TRIM(NumberToVString(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Darcy equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - - EXITS("DARCY_EQUATION_POST_SOLVE_SET_MASS_INCREASE") - RETURN -999 ERRORSEXITS("DARCY_EQUATION_POST_SOLVE_SET_MASS_INCREASE",err,error) - RETURN 1 - END SUBROUTINE DARCY_EQUATION_POST_SOLVE_SET_MASS_INCREASE - - ! - !================================================================================================================================ - ! - - !\ToDo: enable this penalty formulation also for (quasi-)static; as made available in solver_routines - - !Adds a penalty term to the equilibrium equations to enforce impermeability at certain boundaries - ! derived from: "FINITE_ELASTICITY_SURFACE_PRESSURE_RESIDUAL_EVALUATE"; same restrictions apply - SUBROUTINE DARCY_EQUATION_IMPERMEABLE_BC_VIA_PENALTY(EQUATIONS_SET,ELEMENT_NUMBER,err,error,*) - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: equations_SET !EQUATIONS_SET%EQUATIONS - NULLIFY(vectorEquations) - CALL Equations_VectorEquationsGet(equations,vectorEquations,err,error,*999) - dynamicMatrices=>vectorEquations%vectorMatrices%dynamicMatrices - stiffnessMatrix=>dynamicMatrices%matrices(1)%ptr - dependentField=>equations%interpolation%dependentField - DECOMPOSITION =>dependentField%DECOMPOSITION - DECOMP_ELEMENT=>DECOMPOSITION%TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER) - - independentField=>equations%interpolation%independentField - -! MESH_COMPONENT_NUMBER=DECOMPOSITION%MESH_COMPONENT_NUMBER - MESH_COMPONENT_NUMBER = vectorEquations%vectorMapping%dynamicMapping%equationsMatrixToVarMaps(1)% & - & VARIABLE%COMPONENTS(1)%MESH_COMPONENT_NUMBER - - DEPENDENT_BASIS=>DECOMPOSITION%DOMAIN(MESH_COMPONENT_NUMBER)%ptr%TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - -! write(*,*)'ELEMENT_NUMBER = ',ELEMENT_NUMBER - - !Calculate penalty term to render surfaces impermeable: Loop over all faces - DO element_face_idx=1,DEPENDENT_BASIS%NUMBER_OF_LOCAL_FACES - face_number=DECOMP_ELEMENT%ELEMENT_FACES(element_face_idx) - DECOMP_FACE=>DECOMPOSITION%TOPOLOGY%FACES%FACES(face_number) - - !Check if it's a boundary face - IF(DECOMP_FACE%BOUNDARY_FACE) THEN !!temporary until MESH_FACE (or equivalent) is available (decomp face includes ghost faces?) - - !Grab normal xi direction of the face and the other two xi directions - normal_component_idx=ABS(DECOMP_FACE%XI_DIRECTION) ! if xi=0, this can be a negative number -! FACE_COMPONENTS=OTHER_XI_DIRECTIONS3(normal_component_idx,2:3,1) !Two xi directions for the current face - !\todo: will FACE_COMPONENTS be a problem with sector elements? Check this. - - ! To find out which faces are set impermeable: - FACE_VELOCITY_INTERPOLATION_PARAMETERS=>equations%interpolation%independentInterpParameters(FIELD_U_VARIABLE_TYPE)%ptr - CALL FIELD_INTERPOLATION_PARAMETERS_FACE_GET(FIELD_VALUES_SET_TYPE,face_number, & - & FACE_VELOCITY_INTERPOLATION_PARAMETERS,err,error,*999) - FACE_INTERPOLATED_POINT=>equations%interpolation%independentInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr - - - !Check if impermeable boundary condition is defined on the face - IMPERMEABLE_BC=.FALSE. - IF(ANY(ABS(FACE_VELOCITY_INTERPOLATION_PARAMETERS%PARAMETERS(:,normal_component_idx))>ZERO_TOLERANCE)) THEN - IMPERMEABLE_BC=.TRUE. - ENDIF - - IF(IMPERMEABLE_BC) THEN - -! write(*,*)'element_face_idx = ',element_face_idx -! write(*,*)'DECOMP_FACE%XI_DIRECTION = ',DECOMP_FACE%XI_DIRECTION - - !Grab some other pointers - DOMAIN_FACE=>DECOMPOSITION%DOMAIN(MESH_COMPONENT_NUMBER)%ptr%TOPOLOGY%FACES%FACES(face_number) - FACE_BASIS=>DOMAIN_FACE%BASIS - FACE_QUADRATURE_SCHEME=>FACE_BASIS%QUADRATURE%QUADRATURE_SCHEME_MAP(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr - FACE_NUMBER_OF_GAUSS_POINTS=FACE_QUADRATURE_SCHEME%NUMBER_OF_GAUSS - - !A single FACE_BASIS and DEPENDENT_BASIS should suffice, since we only deal with terms - ! deriving from velocity test AND trial functions, and moreover use Galerkin, - ! i.e. same basis functions for test and trial functions - - !Start integrating -!\todo: hopefully all quadrature stuff will always match up between face basis and local face stuff. -! Annoying issue here that p(appl) is interpolated using the face_basis, while dZdXI has to be evaluated -! using the 3D face interpolation... many variables are shared, probably supposed to be the same but I -! can't guarantee it and checking every single thing will be a fair bit of overhead - DO gauss_idx=1,FACE_NUMBER_OF_GAUSS_POINTS - GAUSS_WEIGHT=FACE_QUADRATURE_SCHEME%GAUSS_WEIGHTS(gauss_idx) - !What happens with surface Jacobian ? SQRT_G ? - Apparently contained in normal calculation - - !Use (deformed) Geometric field to obtain delx_j/delxi_M = dZdxi at the face gauss point - GEOMETRIC_INTERPOLATION_PARAMETERS=>equations%interpolation%geometricInterpParameters(FIELD_U_VARIABLE_TYPE)%ptr - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER, & - & GEOMETRIC_INTERPOLATION_PARAMETERS,err,error,*999) - GEOMETRIC_INTERPOLATED_POINT=>equations%interpolation%geometricInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr - CALL FIELD_INTERPOLATE_LOCAL_FACE_GAUSS(FIRST_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,element_face_idx,gauss_idx, & - & GEOMETRIC_INTERPOLATED_POINT,err,error,*999) - - DZDXI=GEOMETRIC_INTERPOLATED_POINT%VALUES(1:3,PARTIAL_DERIVATIVE_FIRST_DERIVATIVE_MAP(1:3)) !(component,derivative) - -! write(*,*)'gauss_idx = ',gauss_idx -! write(*,*)'GAUSS_COORDS = ',GEOMETRIC_INTERPOLATED_POINT%VALUES(1:3,NO_PART_DERIV) !(component,derivative) - - !Calculate covariant metric tensor - CALL MatrixTranspose(DZDXI,DZDXIT,err,error,*999) - CALL MatrixProduct(DZDXIT,DZDXI,GIJL,err,error,*999) !g_ij = dZdXI' * dZdXI - CALL Invert(GIJL,GIJU,G,err,error,*999) !g^ij = inv(g_ij), G=DET(GIJL) - SQRT_G=SQRT(G) - - !--- L o o p 1 : over element rows (3 velocity components) ----------------------------------- - DO component_idx_1=1,3 - !Calculate g^{normal_component_idx}M*dZ_j/dxi_M; this apparently includes the face Jacobian - CALL DotProduct(GIJU(normal_component_idx,:),DZDXI(component_idx_1,:),NORMAL_PROJECTION_1,err,error,*999) - - IF(DECOMP_FACE%XI_DIRECTION<0) NORMAL_PROJECTION_1=-NORMAL_PROJECTION_1 !always outward normal - - IF(ABS(NORMAL_PROJECTION_1) \file -!> $Id: Stokes_equations_routines.f90 372 2009-04-20 -!> \author Sebastian Krittian -!> \brief This module handles all Stokes fluid routines. -!> -!> \section LICENSE -!> -!> Version: MPL 1.1/GPL 2.0/LGPL 2.1 -!> -!> The contents of this file are subject to the Mozilla Public License -!> Version 1.1 (the "License"); you may not use this file except in -!> compliance with the License. You may obtain a copy of the License at -!> http://www.mozilla.org/MPL/ -!> -!> Software distributed under the License is distributed on an "AS IS" -!> basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the -!> License for the specific language governing rights and limitations -!> under the License. -!> -!> The Original Code is OpenCMISS -!> -!> The Initial Developer of the Original Code is University of Auckland, -!> Auckland, New Zealand, the University of Oxford, Oxford, United -!> Kingdom and King's College, London, United Kingdom. Portions created -!> by the University of Auckland, the University of Oxford and King's -!> College, London are Copyright (C) 2007-2010 by the University of -!> Auckland, the University of Oxford and King's College, London. -!> All Rights Reserved. -!> -!> Contributor(s): Sebastian Krittian, Chris Bradley -!> -!> Alternatively, the contents of this file may be used under the terms of -!> either the GNU General Public License Version 2 or later (the "GPL"), or -!> the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), -!> in which case the provisions of the GPL or the LGPL are applicable instead -!> of those above. If you wish to allow use of your version of this file only -!> under the terms of either the GPL or the LGPL, and not to allow others to -!> use your version of this file under the terms of the MPL, indicate your -!> decision by deleting the provisions above and replace them with the notice -!> and other provisions required by the GPL or the LGPL. If you do not delete -!> the provisions above, a recipient may use your version of this file under -!> the terms of any one of the MPL, the GPL or the LGPL. -!> - -!>This module handles all Stokes fluid routines. -MODULE STOKES_EQUATIONS_ROUTINES - - USE ANALYTIC_ANALYSIS_ROUTINES - USE BaseRoutines - USE BASIS_ROUTINES - USE BOUNDARY_CONDITIONS_ROUTINES - USE Constants - USE CONTROL_LOOP_ROUTINES - USE ControlLoopAccessRoutines - USE DISTRIBUTED_MATRIX_VECTOR - USE DOMAIN_MAPPINGS - USE EquationsRoutines - USE EquationsAccessRoutines - USE EquationsMappingRoutines - USE EquationsMatricesRoutines - USE EQUATIONS_SET_CONSTANTS - USE EquationsSetAccessRoutines - USE FIELD_ROUTINES - USE FIELD_IO_ROUTINES - USE FieldAccessRoutines - USE FLUID_MECHANICS_IO_ROUTINES - USE INPUT_OUTPUT - USE ISO_VARYING_STRING - USE Kinds - USE MATRIX_VECTOR - USE NODE_ROUTINES - USE PROBLEM_CONSTANTS - USE Strings - USE SOLVER_ROUTINES - USE SolverAccessRoutines - USE Timer - USE Types - -#include "macros.h" - - IMPLICIT NONE - - PRIVATE - - PUBLIC Stokes_EquationsSetSpecificationSet - - PUBLIC Stokes_EquationsSetSolutionMethodSet - - PUBLIC STOKES_EQUATIONS_SET_SETUP - - PUBLIC Stokes_BoundaryConditionsAnalyticCalculate - - PUBLIC Stokes_ProblemSpecificationSet - - PUBLIC STOKES_PROBLEM_SETUP - - PUBLIC STOKES_FINITE_ELEMENT_CALCULATE - - PUBLIC STOKES_POST_SOLVE - - PUBLIC STOKES_PRE_SOLVE - - PUBLIC STOKES_EQUATION_ANALYTIC_FUNCTIONS - -CONTAINS - -! -!================================================================================================================================ -! - - !>Sets/changes the solution method for a Stokes flow equation type of an fluid mechanics equations set class. - SUBROUTINE Stokes_EquationsSetSolutionMethodSet(EQUATIONS_SET,SOLUTION_METHOD,err,error,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: EQUATIONS_SET !Sets the equation specification for a Stokes flow equation of a fluid mechanics equations set. - SUBROUTINE Stokes_EquationsSetSpecificationSet(equationsSet,specification,err,error,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: equationsSet !Sets up the standard Stokes fluid setup. - SUBROUTINE STOKES_EQUATIONS_SET_SETUP(EQUATIONS_SET,EQUATIONS_SET_SETUP,err,error,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: EQUATIONS_SET != 3 entries for a Stokes flow equations set.", & - & err,error,*999) - END IF - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - !Select Stokes subtypes - CASE(EQUATIONS_SET_STATIC_STOKES_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_STOKES_SUBTYPE, & - & EQUATIONS_SET_LAPLACE_STOKES_SUBTYPE, & - & EQUATIONS_SET_ALE_STOKES_SUBTYPE, & - & EQUATIONS_SET_PGM_STOKES_SUBTYPE) - SELECT CASE(EQUATIONS_SET_SETUP%SETUP_TYPE) - !Set solution method - CASE(EQUATIONS_SET_SETUP_INITIAL_TYPE) - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STATIC_STOKES_SUBTYPE,EQUATIONS_SET_LAPLACE_STOKES_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_STOKES_SUBTYPE,EQUATIONS_SET_ALE_STOKES_SUBTYPE, & - & EQUATIONS_SET_PGM_STOKES_SUBTYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - CASE(EQUATIONS_SET_SETUP_START_ACTION) - CALL Stokes_EquationsSetSolutionMethodSet(EQUATIONS_SET ,& - & EQUATIONS_SET_FEM_SOLUTION_METHOD,err,error,*999) - EQUATIONS_SET%SOLUTION_METHOD=EQUATIONS_SET_FEM_SOLUTION_METHOD - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - !!TODO: Check valid setup - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE, & - & "*",err,error))// " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP% & - & SETUP_TYPE,"*",err,error))// " is invalid for a standard Stokes fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The third equations set specification of "// & - & TRIM(NumberToVstring(EQUATIONS_SET%SPECIFICATION(3),"*", & - & err,error))//" is invalid for a Stokes flow equations set." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(EQUATIONS_SET_SETUP_GEOMETRY_TYPE) - !Set geometric field - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STATIC_STOKES_SUBTYPE,EQUATIONS_SET_LAPLACE_STOKES_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_STOKES_SUBTYPE,EQUATIONS_SET_ALE_STOKES_SUBTYPE, & - & EQUATIONS_SET_PGM_STOKES_SUBTYPE) - !Do nothing??? - CASE DEFAULT - localError="The third equations set specification of "// & - & TRIM(NumberToVString(EQUATIONS_SET%SPECIFICATION(3),"*", & - & err,error))//" is invalid for a Stokes flow equations set." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(EQUATIONS_SET_SETUP_DEPENDENT_TYPE) - !Set dependent field - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STATIC_STOKES_SUBTYPE,EQUATIONS_SET_LAPLACE_STOKES_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_STOKES_SUBTYPE,EQUATIONS_SET_ALE_STOKES_SUBTYPE, & - & EQUATIONS_SET_PGM_STOKES_SUBTYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - !Set start action - CASE(EQUATIONS_SET_SETUP_START_ACTION) - IF(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN - !Create the auto created dependent field - !start field creation with name 'DEPENDENT_FIELD' - CALL FIELD_CREATE_START(EQUATIONS_SET_SETUP%FIELD_USER_NUMBER,EQUATIONS_SET%REGION, & - & EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,err,error,*999) - !start creation of a new field - CALL FIELD_TYPE_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_GENERAL_TYPE,err,error,*999) - !label the field - CALL FIELD_LABEL_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,"U",err,error,*999) - !define new created field to be dependent - CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD, & - & FIELD_DEPENDENT_TYPE,err,error,*999) - !look for decomposition rule already defined - CALL FIELD_MESH_DECOMPOSITION_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_DECOMPOSITION, & - & err,error,*999) - !apply decomposition rule found on new created field - CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD, & - & GEOMETRIC_DECOMPOSITION,err,error,*999) - !point new field to geometric field - CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,EQUATIONS_SET%GEOMETRY% & - & GEOMETRIC_FIELD,err,error,*999) - !set number of variables to 2 (1 for U and one for DELUDELN) - DEPENDENT_FIELD_NUMBER_OF_VARIABLES=2 - CALL FIELD_NUMBER_OF_VARIABLES_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD, & - & DEPENDENT_FIELD_NUMBER_OF_VARIABLES,err,error,*999) - CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,[FIELD_U_VARIABLE_TYPE, & - & FIELD_DELUDELN_VARIABLE_TYPE],err,error,*999) - CALL FIELD_DIMENSION_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - CALL FIELD_DIMENSION_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE, & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_DP_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE, & - & FIELD_DP_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS,err,error,*999) - !calculate number of components with one component for each dimension and one for pressure - DEPENDENT_FIELD_NUMBER_OF_COMPONENTS=NUMBER_OF_DIMENSIONS+1 - CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD, & - & FIELD_U_VARIABLE_TYPE,DEPENDENT_FIELD_NUMBER_OF_COMPONENTS,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD, & - & FIELD_DELUDELN_VARIABLE_TYPE,DEPENDENT_FIELD_NUMBER_OF_COMPONENTS,err,error,*999) - CALL FIELD_COMPONENT_MESH_COMPONENT_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & 1,GEOMETRIC_MESH_COMPONENT,err,error,*999) - !Default to the geometric interpolation setup - DO I=1,DEPENDENT_FIELD_NUMBER_OF_COMPONENTS - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD, & - & FIELD_U_VARIABLE_TYPE,I,GEOMETRIC_MESH_COMPONENT,err,error,*999) - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD, & - & FIELD_DELUDELN_VARIABLE_TYPE,I,GEOMETRIC_MESH_COMPONENT,err,error,*999) - END DO - SELECT CASE(EQUATIONS_SET%SOLUTION_METHOD) - !Specify fem solution method - CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD) - DO I=1,DEPENDENT_FIELD_NUMBER_OF_COMPONENTS - CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD, & - & FIELD_U_VARIABLE_TYPE,I,FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD, & - & FIELD_DELUDELN_VARIABLE_TYPE,I,FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - END DO - CALL FIELD_SCALING_TYPE_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_SCALING_TYPE, & - & err,error,*999) - CALL FIELD_SCALING_TYPE_SET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,GEOMETRIC_SCALING_TYPE, & - & err,error,*999) - !Other solutions not defined yet - CASE DEFAULT - localError="The solution method of " & - & //TRIM(NumberToVString(EQUATIONS_SET%SOLUTION_METHOD,"*",err,error))// " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - !Check the user specified field - CALL FIELD_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_GENERAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DEPENDENT_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_VARIABLES_CHECK(EQUATIONS_SET_SETUP%FIELD,2,err,error,*999) - CALL FIELD_VARIABLE_TYPES_CHECK(EQUATIONS_SET_SETUP%FIELD,[FIELD_U_VARIABLE_TYPE, & - & FIELD_DELUDELN_VARIABLE_TYPE],err,error,*999) - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE, & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,FIELD_DP_TYPE, & - & err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS,err,error,*999) - !calculate number of components with one component for each dimension and one for pressure - DEPENDENT_FIELD_NUMBER_OF_COMPONENTS=NUMBER_OF_DIMENSIONS+1 - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE, & - & DEPENDENT_FIELD_NUMBER_OF_COMPONENTS,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE, & - & DEPENDENT_FIELD_NUMBER_OF_COMPONENTS,err,error,*999) - SELECT CASE(EQUATIONS_SET%SOLUTION_METHOD) - CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD) - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,1, & - & FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,1, & - & FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CASE DEFAULT - localError="The solution method of "//TRIM(NumberToVString(EQUATIONS_SET%SOLUTION_METHOD, & - &"*",err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - ENDIF - !Specify finish action - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - IF(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN - CALL FIELD_CREATE_FINISH(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,err,error,*999) - ENDIF - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard Stokes fluid" - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The third equations set specification of "// & - & TRIM(NumberToVstring(EQUATIONS_SET%SPECIFICATION(3),"*", & - & err,error))//" is invalid for a Stokes flow equations set." - CALL FLAG_ERROR(localError,err,error,*999) - END SELECT - CASE(EQUATIONS_SET_SETUP_INDEPENDENT_TYPE) - !define an independent field for ALE information - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_ALE_STOKES_SUBTYPE,EQUATIONS_SET_PGM_STOKES_SUBTYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - !Set start action - CASE(EQUATIONS_SET_SETUP_START_ACTION) - IF(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN - !Create the auto created independent field - !start field creation with name 'INDEPENDENT_FIELD' - CALL FIELD_CREATE_START(EQUATIONS_SET_SETUP%FIELD_USER_NUMBER,EQUATIONS_SET%REGION, & - & EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999) - !start creation of a new field - CALL FIELD_TYPE_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_GENERAL_TYPE,err,error,*999) - !label the field - CALL FIELD_LABEL_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,"Independent Field",err,error,*999) - !define new created field to be independent - CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD, & - & FIELD_INDEPENDENT_TYPE,err,error,*999) - !look for decomposition rule already defined - CALL FIELD_MESH_DECOMPOSITION_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_DECOMPOSITION, & - & err,error,*999) - !apply decomposition rule found on new created field - CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD, & - & GEOMETRIC_DECOMPOSITION,err,error,*999) - !point new field to geometric field - CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,EQUATIONS_SET% & - & GEOMETRY%GEOMETRIC_FIELD,err,error,*999) - !set number of variables to 1 (1 for U) - INDEPENDENT_FIELD_NUMBER_OF_VARIABLES=1 - CALL FIELD_NUMBER_OF_VARIABLES_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD, & - & INDEPENDENT_FIELD_NUMBER_OF_VARIABLES,err,error,*999) - CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD, & - & [FIELD_U_VARIABLE_TYPE],err,error,*999) - CALL FIELD_DIMENSION_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_DP_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS,err,error,*999) - !calculate number of components with one component for each dimension - INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS=NUMBER_OF_DIMENSIONS - CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD, & - & FIELD_U_VARIABLE_TYPE,INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS,err,error,*999) - CALL FIELD_COMPONENT_MESH_COMPONENT_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & 1,GEOMETRIC_MESH_COMPONENT,err,error,*999) - !Default to the geometric interpolation setup - DO I=1,INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD, & - & FIELD_U_VARIABLE_TYPE,I,GEOMETRIC_MESH_COMPONENT,err,error,*999) - END DO - SELECT CASE(EQUATIONS_SET%SOLUTION_METHOD) - !Specify fem solution method - CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD) - DO I=1,INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS - CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD, & - & FIELD_U_VARIABLE_TYPE,I,FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - END DO - CALL FIELD_SCALING_TYPE_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_SCALING_TYPE, & - & err,error,*999) - CALL FIELD_SCALING_TYPE_SET(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,GEOMETRIC_SCALING_TYPE, & - & err,error,*999) - !Other solutions not defined yet - CASE DEFAULT - localError="The solution method of " & - & //TRIM(NumberToVString(EQUATIONS_SET%SOLUTION_METHOD,"*",err,error))// " is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - !Check the user specified field - CALL FIELD_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_GENERAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_VARIABLES_CHECK(EQUATIONS_SET_SETUP%FIELD,1,err,error,*999) - CALL FIELD_VARIABLE_TYPES_CHECK(EQUATIONS_SET_SETUP%FIELD,[FIELD_U_VARIABLE_TYPE],err,error,*999) - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS,err,error,*999) - !calculate number of components with one component for each dimension and one for pressure - INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS=NUMBER_OF_DIMENSIONS - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE, & - & INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS,err,error,*999) - SELECT CASE(EQUATIONS_SET%SOLUTION_METHOD) - CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD) - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,1, & - & FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CALL FIELD_COMPONENT_INTERPOLATION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,1, & - & FIELD_NODE_BASED_INTERPOLATION,err,error,*999) - CASE DEFAULT - localError="The solution method of "//TRIM(NumberToVString(EQUATIONS_SET%SOLUTION_METHOD, & - &"*",err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - ENDIF - !Specify finish action - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - IF(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN - CALL FIELD_CREATE_FINISH(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999) - CALL FIELD_PARAMETER_SET_CREATE(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_MESH_DISPLACEMENT_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_CREATE(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_MESH_VELOCITY_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_CREATE(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_BOUNDARY_SET_TYPE,err,error,*999) - ENDIF - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard Stokes fluid" - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The third equations set specification of "// & - & TRIM(NumberToVstring(EQUATIONS_SET%SPECIFICATION(3),"*", & - & err,error))//" is invalid for a Stokes flow equations set." - CALL FlagError(localError,err,error,*999) - END SELECT - !Define analytic part for Stokes problem - CASE(EQUATIONS_SET_SETUP_ANALYTIC_TYPE) - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STATIC_STOKES_SUBTYPE,EQUATIONS_SET_LAPLACE_STOKES_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_STOKES_SUBTYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - !Set start action - CASE(EQUATIONS_SET_SETUP_START_ACTION) - IF(EQUATIONS_SET%DEPENDENT%DEPENDENT_FINISHED) THEN - IF(ASSOCIATED(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD)) THEN - IF(ASSOCIATED(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD)) THEN - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS,err,error,*999) - SELECT CASE(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE) - CASE(EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_1) - !Set analtyic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_1 - CASE(EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_2) - !Set analtyic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_2 - CASE(EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_3) - !Set analtyic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_3 - CASE(EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_4) - !Set analtyic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_4 - CASE(EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_5) - !Set analtyic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_5 - CASE(EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_1) - !Set analtyic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_1 - CASE(EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_2) - !Set analtyic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_2 - CASE(EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_3) - !Set analtyic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_3 - CASE(EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_4) - !Set analtyic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_4 - CASE(EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_5) - !Set analtyic function type - EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_5 - CASE DEFAULT - localError="The specified analytic function type of "// & - & TRIM(NumberToVString(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",err,error))// & - & " is invalid for an analytic Stokes problem." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Equations set geometric field is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set dependent field is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set dependent field has not been finished.",err,error,*999) - ENDIF - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN - IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC%ANALYTIC_FIELD)) THEN - IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED) THEN - CALL FIELD_CREATE_FINISH(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,err,error,*999) - ENDIF - ENDIF - ELSE - CALL FlagError("Equations set analytic is not associated.",err,error,*999) - ENDIF - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for an analytic Stokes problem." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The third equations set specification of "// & - & TRIM(NumberToVString(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - " is invalid for a Stokes flow equations set." - CALL FLAG_ERROR(localError,err,error,*999) - END SELECT - !Define materials field - CASE(EQUATIONS_SET_SETUP_MATERIALS_TYPE) - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STATIC_STOKES_SUBTYPE,EQUATIONS_SET_LAPLACE_STOKES_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_STOKES_SUBTYPE,EQUATIONS_SET_ALE_STOKES_SUBTYPE, & - & EQUATIONS_SET_PGM_STOKES_SUBTYPE) - !variable X with has Y components, here Y represents viscosity only - MATERIAL_FIELD_NUMBER_OF_VARIABLES=1!X - MATERIAL_FIELD_NUMBER_OF_COMPONENTS=2!Y - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - !Specify start action - CASE(EQUATIONS_SET_SETUP_START_ACTION) - EQUATIONS_MATERIALS=>EQUATIONS_SET%MATERIALS - IF(ASSOCIATED(EQUATIONS_MATERIALS)) THEN - IF(EQUATIONS_MATERIALS%MATERIALS_FIELD_AUTO_CREATED) THEN - !Create the auto created materials field - !start field creation with name 'MATERIAL_FIELD' - CALL FIELD_CREATE_START(EQUATIONS_SET_SETUP%FIELD_USER_NUMBER,EQUATIONS_SET%REGION,EQUATIONS_SET% & - & MATERIALS%MATERIALS_FIELD,err,error,*999) - CALL FIELD_TYPE_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_MATERIAL_TYPE,err,error,*999) - !label the field - CALL FIELD_LABEL_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,"Materials Field",err,error,*999) - CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_INDEPENDENT_TYPE, & - & err,error,*999) - CALL FIELD_MESH_DECOMPOSITION_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_DECOMPOSITION, & - & err,error,*999) - !apply decomposition rule found on new created field - CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(EQUATIONS_SET%MATERIALS%MATERIALS_FIELD, & - & GEOMETRIC_DECOMPOSITION,err,error,*999) - !point new field to geometric field - CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,EQUATIONS_SET%GEOMETRY% & - & GEOMETRIC_FIELD,err,error,*999) - CALL FIELD_NUMBER_OF_VARIABLES_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD, & - & MATERIAL_FIELD_NUMBER_OF_VARIABLES,err,error,*999) - CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,[FIELD_U_VARIABLE_TYPE], & - & err,error,*999) - CALL FIELD_DIMENSION_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999) - CALL FIELD_DATA_TYPE_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_DP_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & MATERIAL_FIELD_NUMBER_OF_COMPONENTS,err,error,*999) - CALL FIELD_COMPONENT_MESH_COMPONENT_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & 1,GEOMETRIC_COMPONENT_NUMBER,err,error,*999) - CALL FIELD_COMPONENT_MESH_COMPONENT_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & 1,GEOMETRIC_COMPONENT_NUMBER,err,error,*999) - CALL FIELD_COMPONENT_INTERPOLATION_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & 1,FIELD_CONSTANT_INTERPOLATION,err,error,*999) - !Default the field scaling to that of the geometric field - CALL FIELD_SCALING_TYPE_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,GEOMETRIC_SCALING_TYPE,err,error,*999) - CALL FIELD_SCALING_TYPE_SET(EQUATIONS_MATERIALS%MATERIALS_FIELD,GEOMETRIC_SCALING_TYPE,err,error,*999) - ELSE - !Check the user specified field - CALL FIELD_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_MATERIAL_TYPE,err,error,*999) - CALL FIELD_DEPENDENT_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_VARIABLES_CHECK(EQUATIONS_SET_SETUP%FIELD,1,err,error,*999) - CALL FIELD_VARIABLE_TYPES_CHECK(EQUATIONS_SET_SETUP%FIELD,[FIELD_U_VARIABLE_TYPE],err,error,*999) - CALL FIELD_DIMENSION_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, & - & err,error,*999) - CALL FIELD_DATA_TYPE_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(EQUATIONS_SET_SETUP%FIELD,FIELD_U_VARIABLE_TYPE,1,err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set materials is not associated.",err,error,*999) - END IF - !Specify start action - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - EQUATIONS_MATERIALS=>EQUATIONS_SET%MATERIALS - IF(ASSOCIATED(EQUATIONS_MATERIALS)) THEN - IF(EQUATIONS_MATERIALS%MATERIALS_FIELD_AUTO_CREATED) THEN - !Finish creating the materials field - CALL FIELD_CREATE_FINISH(EQUATIONS_MATERIALS%MATERIALS_FIELD,err,error,*999) - !Set the default values for the materials field - !First set the mu values to 0.001 - !MATERIAL_FIELD_NUMBER_OF_COMPONENTS - ! viscosity=1 - CALL FIELD_COMPONENT_VALUES_INITIALISE(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,1,1.0_DP,err,error,*999) - ! density=2 -!\todo: Initialise fields properly - ! CALL FIELD_COMPONENT_VALUES_INITIALISE(EQUATIONS_MATERIALS%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, & - ! & FIELD_VALUES_SET_TYPE,2,100.0_DP,err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set materials is not associated.",err,error,*999) - ENDIF - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for Stokes equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The third equations set specification of "// & - & TRIM(NumberToVString(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " is invalid for a Stokes flow equations set." - CALL FlagError(localError,err,error,*999) - END SELECT - !Define the source field - CASE(EQUATIONS_SET_SETUP_SOURCE_TYPE) - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STATIC_STOKES_SUBTYPE,EQUATIONS_SET_LAPLACE_STOKES_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_STOKES_SUBTYPE,EQUATIONS_SET_ALE_STOKES_SUBTYPE, & - & EQUATIONS_SET_PGM_STOKES_SUBTYPE) - !TO DO: INCLUDE GRAVITY AS SOURCE TYPE - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - CASE(EQUATIONS_SET_SETUP_START_ACTION) - !Do nothing - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - !Do nothing - !? Maybe set finished flag???? - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard Stokes fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The third equations set specification of "// & - & TRIM(NumberToVString(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " is invalid for a Stokes flow equations set." - CALL FLAG_ERROR(localError,err,error,*999) - END SELECT - !Define equations type - CASE(EQUATIONS_SET_SETUP_EQUATIONS_TYPE) - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STATIC_STOKES_SUBTYPE,EQUATIONS_SET_LAPLACE_STOKES_SUBTYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - CASE(EQUATIONS_SET_SETUP_START_ACTION) - EQUATIONS_MATERIALS=>EQUATIONS_SET%MATERIALS - IF(ASSOCIATED(EQUATIONS_MATERIALS)) THEN - IF(EQUATIONS_MATERIALS%MATERIALS_FINISHED) THEN - CALL Equations_CreateStart(EQUATIONS_SET,equations,err,error,*999) - CALL Equations_LinearityTypeSet(equations,EQUATIONS_LINEAR,err,error,*999) - CALL Equations_TimeDependenceTypeSet(equations,EQUATIONS_STATIC,err,error,*999) - ELSE - CALL FlagError("Equations set materials has not been finished.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations materials is not associated.",err,error,*999) - ENDIF - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - SELECT CASE(EQUATIONS_SET%SOLUTION_METHOD) - CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD) - !Finish the equations creation - CALL EquationsSet_EquationsGet(EQUATIONS_SET,equations,err,error,*999) - CALL Equations_CreateFinish(equations,err,error,*999) - NULLIFY(vectorEquations) - CALL Equations_VectorEquationsGet(equations,vectorEquations,err,error,*999) - !Create the equations mapping. - CALL EquationsMapping_VectorCreateStart(vectorEquations,FIELD_DELUDELN_VARIABLE_TYPE,vectorMapping, & - & err,error,*999) - CALL EquationsMapping_LinearMatricesNumberSet(vectorMapping,1,err,error,*999) - CALL EquationsMapping_LinearMatricesVariableTypesSet(vectorMapping,[FIELD_U_VARIABLE_TYPE], & - & err,error,*999) - CALL EquationsMapping_RHSVariableTypeSet(vectorMapping,FIELD_DELUDELN_VARIABLE_TYPE, & - & err,error,*999) - CALL EquationsMapping_VectorCreateFinish(vectorMapping,err,error,*999) - !Create the equations matrices - CALL EquationsMatrices_VectorCreateStart(vectorEquations,vectorMatrices,err,error,*999) - SELECT CASE(equations%sparsityType) - CASE(EQUATIONS_MATRICES_FULL_MATRICES) - CALL EquationsMatrices_LinearStorageTypeSet(vectorMatrices,[MATRIX_BLOCK_STORAGE_TYPE], & - & err,error,*999) - CASE(EQUATIONS_MATRICES_SPARSE_MATRICES) - CALL EquationsMatrices_LinearStorageTypeSet(vectorMatrices, & - & [MATRIX_COMPRESSED_ROW_STORAGE_TYPE],err,error,*999) - CALL EquationsMatrices_LinearStructureTypeSet(vectorMatrices, & - & [EQUATIONS_MATRIX_FEM_STRUCTURE],err,error,*999) - CASE DEFAULT - localError="The equations matrices sparsity type of "// & - & TRIM(NumberToVString(equations%sparsityType,"*",err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CALL EquationsMatrices_VectorCreateFinish(vectorMatrices,err,error,*999) - CASE DEFAULT - localError="The solution method of "//TRIM(NumberToVString(EQUATIONS_SET%SOLUTION_METHOD, & - & "*",err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a steady Laplace equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(EQUATIONS_SET_TRANSIENT_STOKES_SUBTYPE,EQUATIONS_SET_ALE_STOKES_SUBTYPE,EQUATIONS_SET_PGM_STOKES_SUBTYPE) - SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE) - CASE(EQUATIONS_SET_SETUP_START_ACTION) - EQUATIONS_MATERIALS=>EQUATIONS_SET%MATERIALS - IF(ASSOCIATED(EQUATIONS_MATERIALS)) THEN - IF(EQUATIONS_MATERIALS%MATERIALS_FINISHED) THEN - CALL Equations_CreateStart(EQUATIONS_SET,equations,err,error,*999) - CALL Equations_EquationTypeSet(equations,EQUATIONS_VECTOR_TYPE,err,error,*999) - CALL Equations_LinearityTypeSet(equations,EQUATIONS_LINEAR,err,error,*999) - CALL Equations_TimeDependenceTypeSet(equations,EQUATIONS_FIRST_ORDER_DYNAMIC,err,error,*999) - ELSE - CALL FlagError("Equations set materials has not been finished.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations materials is not associated.",err,error,*999) - ENDIF - CASE(EQUATIONS_SET_SETUP_FINISH_ACTION) - SELECT CASE(EQUATIONS_SET%SOLUTION_METHOD) - CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD) - !Finish the equations creation - CALL EquationsSet_EquationsGet(EQUATIONS_SET,equations,err,error,*999) - CALL Equations_CreateFinish(equations,err,error,*999) - NULLIFY(vectorEquations) - CALL Equations_VectorEquationsGet(equations,vectorEquations,err,error,*999) - !Create the equations mapping. - CALL EquationsMapping_VectorCreateStart(vectorEquations,FIELD_DELUDELN_VARIABLE_TYPE,vectorMapping, & - & err,error,*999) - CALL EquationsMapping_DynamicMatricesSet(vectorMapping,.TRUE.,.TRUE.,err,error,*999) - CALL EquationsMapping_DynamicVariableTypeSet(vectorMapping,FIELD_U_VARIABLE_TYPE,err,error,*999) - CALL EquationsMapping_RHSVariableTypeSet(vectorMapping,FIELD_DELUDELN_VARIABLE_TYPE, & - & err,error,*999) - CALL EquationsMapping_VectorCreateFinish(vectorMapping,err,error,*999) - !Create the equations matrices - CALL EquationsMatrices_VectorCreateStart(vectorEquations,vectorMatrices,err,error,*999) - !Set up matrix storage and structure - IF(equations%lumpingType==EQUATIONS_LUMPED_MATRICES) THEN - !Set up lumping - CALL EquationsMatrices_DynamicLumpingTypeSet(vectorMatrices, & - & [EQUATIONS_MATRIX_UNLUMPED,EQUATIONS_MATRIX_LUMPED],err,error,*999) - CALL EquationsMatrices_DynamicStorageTypeSet(vectorMatrices, & - & [DISTRIBUTED_MATRIX_COMPRESSED_ROW_STORAGE_TYPE,DISTRIBUTED_MATRIX_DIAGONAL_STORAGE_TYPE] & - & ,err,error,*999) - CALL EquationsMatrices_DynamicStructureTypeSet(vectorMatrices, & - & [EQUATIONS_MATRIX_FEM_STRUCTURE,EQUATIONS_MATRIX_DIAGONAL_STRUCTURE],err,error,*999) - ELSE - SELECT CASE(equations%sparsityType) - CASE(EQUATIONS_MATRICES_FULL_MATRICES) - CALL EquationsMatrices_LinearStorageTypeSet(vectorMatrices, & - & [DISTRIBUTED_MATRIX_BLOCK_STORAGE_TYPE,DISTRIBUTED_MATRIX_BLOCK_STORAGE_TYPE],err,error,*999) - CASE(EQUATIONS_MATRICES_SPARSE_MATRICES) - CALL EquationsMatrices_DynamicStorageTypeSet(vectorMatrices, & - & [DISTRIBUTED_MATRIX_COMPRESSED_ROW_STORAGE_TYPE, & - & DISTRIBUTED_MATRIX_COMPRESSED_ROW_STORAGE_TYPE],err,error,*999) - CALL EquationsMatrices_DynamicStructureTypeSet(vectorMatrices, & - & [EQUATIONS_MATRIX_FEM_STRUCTURE,EQUATIONS_MATRIX_FEM_STRUCTURE],err,error,*999) - CASE DEFAULT - localError="The equations matrices sparsity type of "// & - & TRIM(NumberToVString(equations%sparsityType,"*",err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - ENDIF - CALL EquationsMatrices_VectorCreateFinish(vectorMatrices,err,error,*999) - CASE DEFAULT - localError="The solution method of "//TRIM(NumberToVString(EQUATIONS_SET%SOLUTION_METHOD,"*", & - & err,error))//" is invalid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a Stokes equation." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The third equations set specification of "// & - & TRIM(NumberToVString(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " is invalid for a Stokes flow equations set." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The setup type of "//TRIM(NumberToVString(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard Stokes fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The equations set subtype of "//TRIM(NumberToVString(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " does not equal a standard Stokes fluid subtype." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - ENDIF - - EXITS("STOKES_EQUATIONS_SET_SETUP") - RETURN -999 ERRORSEXITS("STOKES_EQUATIONS_SET_SETUP",err,error) - RETURN 1 - END SUBROUTINE STOKES_EQUATIONS_SET_SETUP - -! -!================================================================================================================================ -! - - !>Sets the problem specification for a Stokes fluid problem. - SUBROUTINE Stokes_ProblemSpecificationSet(problem,problemSpecification,err,error,*) - - !Argument variables - TYPE(PROBLEM_TYPE), POINTER :: problem != 3 entries.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - - EXITS("Stokes_ProblemSpecificationSet") - RETURN -999 ERRORSEXITS("Stokes_ProblemSpecificationSet",err,error) - RETURN 1 - - END SUBROUTINE Stokes_ProblemSpecificationSet - -! -!================================================================================================================================ -! - - !>Sets up the Stokes problem. - SUBROUTINE STOKES_PROBLEM_SETUP(PROBLEM,PROBLEM_SETUP,err,error,*) - - !Argument variables - TYPE(PROBLEM_TYPE), POINTER :: PROBLEM !PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_CREATE_FINISH(CONTROL_LOOP,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard Stokes fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVERS_TYPE) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Start the solvers creation - CALL SOLVERS_CREATE_START(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_NUMBER_SET(SOLVERS,1,err,error,*999) - !Set the solver to be a linear solver - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - CALL SOLVER_TYPE_SET(SOLVER,SOLVER_LINEAR_TYPE,err,error,*999) - !Set solver defaults - CALL SOLVER_LIBRARY_TYPE_SET(SOLVER,SOLVER_PETSC_LIBRARY,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the solvers - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - !Finish the solvers creation - CALL SOLVERS_CREATE_FINISH(SOLVERS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard Stokes fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVER_EQUATIONS_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - !Get the solver - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - !Create the solver equations - CALL SOLVER_EQUATIONS_CREATE_START(SOLVER,SOLVER_EQUATIONS,err,error,*999) - CALL SOLVER_EQUATIONS_LINEARITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_LINEAR,err,error,*999) - CALL SOLVER_EQUATIONS_TIME_DEPENDENCE_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_STATIC,err,error,*999) - CALL SOLVER_EQUATIONS_SPARSITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_SPARSE_MATRICES,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - !Get the solver equations - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - CALL SOLVER_SOLVER_EQUATIONS_GET(SOLVER,SOLVER_EQUATIONS,err,error,*999) - !Finish the solver equations creation - CALL SOLVER_EQUATIONS_CREATE_FINISH(SOLVER_EQUATIONS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard Stokes fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a standard Stokes fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - !Set problem subtype for transient Stokes problems - CASE(PROBLEM_TRANSIENT_STOKES_SUBTYPE,PROBLEM_PGM_STOKES_SUBTYPE) - SELECT CASE(PROBLEM_SETUP%SETUP_TYPE) - CASE(PROBLEM_SETUP_INITIAL_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Do nothing???? - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Do nothing???? - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a transient Stokes fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_CONTROL_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Set up a time control loop - CALL CONTROL_LOOP_CREATE_START(PROBLEM,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_TYPE_SET(CONTROL_LOOP,PROBLEM_CONTROL_TIME_LOOP_TYPE,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Finish the control loops - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_CREATE_FINISH(CONTROL_LOOP,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a transient Stokes fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVERS_TYPE) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Start the solvers creation - CALL SOLVERS_CREATE_START(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_NUMBER_SET(SOLVERS,1,err,error,*999) - !Set the solver to be a first order dynamic solver - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - CALL SOLVER_TYPE_SET(SOLVER,SOLVER_DYNAMIC_TYPE,err,error,*999) - CALL SOLVER_DYNAMIC_ORDER_SET(SOLVER,SOLVER_DYNAMIC_FIRST_ORDER,err,error,*999) - !Set solver defaults - CALL SOLVER_DYNAMIC_DEGREE_SET(SOLVER,SOLVER_DYNAMIC_FIRST_DEGREE,err,error,*999) - CALL SOLVER_DYNAMIC_SCHEME_SET(SOLVER,SOLVER_DYNAMIC_CRANK_NICOLSON_SCHEME,err,error,*999) - CALL SOLVER_LIBRARY_TYPE_SET(SOLVER,SOLVER_CMISS_LIBRARY,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the solvers - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - !Finish the solvers creation - CALL SOLVERS_CREATE_FINISH(SOLVERS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a transient Stokes fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVER_EQUATIONS_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - !Get the solver - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - !Create the solver equations - CALL SOLVER_EQUATIONS_CREATE_START(SOLVER,SOLVER_EQUATIONS,err,error,*999) - CALL SOLVER_EQUATIONS_LINEARITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_LINEAR,err,error,*999) - CALL SOLVER_EQUATIONS_TIME_DEPENDENCE_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_FIRST_ORDER_DYNAMIC,& - & err,error,*999) - CALL SOLVER_EQUATIONS_SPARSITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_SPARSE_MATRICES,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - !Get the solver equations - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_SOLVER_GET(SOLVERS,1,SOLVER,err,error,*999) - CALL SOLVER_SOLVER_EQUATIONS_GET(SOLVER,SOLVER_EQUATIONS,err,error,*999) - !Finish the solver equations creation - CALL SOLVER_EQUATIONS_CREATE_FINISH(SOLVER_EQUATIONS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a transient Stokes fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a transient Stokes fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - !Set problem subtype for ALE Stokes problems - CASE(PROBLEM_ALE_STOKES_SUBTYPE) - SELECT CASE(PROBLEM_SETUP%SETUP_TYPE) - CASE(PROBLEM_SETUP_INITIAL_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Do nothing???? - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Do nothing???? - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a ALE Stokes fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_CONTROL_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Set up a time control loop - CALL CONTROL_LOOP_CREATE_START(PROBLEM,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_TYPE_SET(CONTROL_LOOP,PROBLEM_CONTROL_TIME_LOOP_TYPE,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Finish the control loops - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - CALL CONTROL_LOOP_CREATE_FINISH(CONTROL_LOOP,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a ALE Stokes fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVERS_TYPE) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Start the solvers creation - CALL SOLVERS_CREATE_START(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_NUMBER_SET(SOLVERS,2,err,error,*999) - !Set the first solver to be a linear solver for the Laplace mesh movement problem - CALL SOLVERS_SOLVER_GET(SOLVERS,1,MESH_SOLVER,err,error,*999) - CALL SOLVER_TYPE_SET(MESH_SOLVER,SOLVER_LINEAR_TYPE,err,error,*999) - !Set solver defaults - CALL SOLVER_LIBRARY_TYPE_SET(MESH_SOLVER,SOLVER_PETSC_LIBRARY,err,error,*999) - !Set the solver to be a first order dynamic solver - CALL SOLVERS_SOLVER_GET(SOLVERS,2,SOLVER,err,error,*999) - CALL SOLVER_TYPE_SET(SOLVER,SOLVER_DYNAMIC_TYPE,err,error,*999) - CALL SOLVER_DYNAMIC_ORDER_SET(SOLVER,SOLVER_DYNAMIC_FIRST_ORDER,err,error,*999) - !Set solver defaults - CALL SOLVER_DYNAMIC_DEGREE_SET(SOLVER,SOLVER_DYNAMIC_FIRST_DEGREE,err,error,*999) - CALL SOLVER_DYNAMIC_SCHEME_SET(SOLVER,SOLVER_DYNAMIC_CRANK_NICOLSON_SCHEME,err,error,*999) - CALL SOLVER_LIBRARY_TYPE_SET(SOLVER,SOLVER_CMISS_LIBRARY,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the solvers - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - !Finish the solvers creation - CALL SOLVERS_CREATE_FINISH(SOLVERS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a ALE Stokes fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE(PROBLEM_SETUP_SOLVER_EQUATIONS_TYPE) - SELECT CASE(PROBLEM_SETUP%ACTION_TYPE) - CASE(PROBLEM_SETUP_START_ACTION) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - !Get the solver - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_SOLVER_GET(SOLVERS,1,MESH_SOLVER,err,error,*999) - !Create the solver equations - CALL SOLVER_EQUATIONS_CREATE_START(MESH_SOLVER,MESH_SOLVER_EQUATIONS,err,error,*999) - CALL SOLVER_EQUATIONS_LINEARITY_TYPE_SET(MESH_SOLVER_EQUATIONS,SOLVER_EQUATIONS_LINEAR,err,error,*999) - CALL SOLVER_EQUATIONS_TIME_DEPENDENCE_TYPE_SET(MESH_SOLVER_EQUATIONS,SOLVER_EQUATIONS_STATIC,err,error,*999) - CALL SOLVER_EQUATIONS_SPARSITY_TYPE_SET(MESH_SOLVER_EQUATIONS,SOLVER_SPARSE_MATRICES,err,error,*999) - CALL SOLVERS_SOLVER_GET(SOLVERS,2,SOLVER,err,error,*999) - !Create the solver equations - CALL SOLVER_EQUATIONS_CREATE_START(SOLVER,SOLVER_EQUATIONS,err,error,*999) - CALL SOLVER_EQUATIONS_LINEARITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_LINEAR,err,error,*999) - CALL SOLVER_EQUATIONS_TIME_DEPENDENCE_TYPE_SET(SOLVER_EQUATIONS,SOLVER_EQUATIONS_FIRST_ORDER_DYNAMIC,& - & err,error,*999) - CALL SOLVER_EQUATIONS_SPARSITY_TYPE_SET(SOLVER_EQUATIONS,SOLVER_SPARSE_MATRICES,err,error,*999) - CASE(PROBLEM_SETUP_FINISH_ACTION) - !Get the control loop - CONTROL_LOOP_ROOT=>PROBLEM%CONTROL_LOOP - CALL CONTROL_LOOP_GET(CONTROL_LOOP_ROOT,CONTROL_LOOP_NODE,CONTROL_LOOP,err,error,*999) - !Get the solver equations - CALL CONTROL_LOOP_SOLVERS_GET(CONTROL_LOOP,SOLVERS,err,error,*999) - CALL SOLVERS_SOLVER_GET(SOLVERS,1,MESH_SOLVER,err,error,*999) - CALL SOLVER_SOLVER_EQUATIONS_GET(MESH_SOLVER,MESH_SOLVER_EQUATIONS,err,error,*999) - !Finish the solver equations creation - CALL SOLVER_EQUATIONS_CREATE_FINISH(MESH_SOLVER_EQUATIONS,err,error,*999) - CALL SOLVERS_SOLVER_GET(SOLVERS,2,SOLVER,err,error,*999) - CALL SOLVER_SOLVER_EQUATIONS_GET(SOLVER,SOLVER_EQUATIONS,err,error,*999) - !Finish the solver equations creation - CALL SOLVER_EQUATIONS_CREATE_FINISH(SOLVER_EQUATIONS,err,error,*999) - CASE DEFAULT - localError="The action type of "//TRIM(NumberToVString(PROBLEM_SETUP%ACTION_TYPE,"*",err,error))// & - & " for a setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a ALE Stokes fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="The setup type of "//TRIM(NumberToVString(PROBLEM_SETUP%SETUP_TYPE,"*",err,error))// & - & " is invalid for a ALE Stokes fluid." - CALL FlagError(localError,err,error,*999) - END SELECT - CASE DEFAULT - localError="Problem subtype "//TRIM(NumberToVString(PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Stokes fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - - EXITS("STOKES_PROBLEM_SETUP") - RETURN -999 ERRORSEXITS("STOKES_PROBLEM_SETUP",err,error) - RETURN 1 - END SUBROUTINE STOKES_PROBLEM_SETUP - -! -!================================================================================================================================ -! - - !>Calculates the element stiffness matrices and RHS for a Stokes fluid finite element equations set. - SUBROUTINE STOKES_FINITE_ELEMENT_CALCULATE(EQUATIONS_SET,ELEMENT_NUMBER,err,error,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: EQUATIONS_SET !EQUATIONS_SET%EQUATIONS - IF(ASSOCIATED(EQUATIONS)) THEN - NULLIFY(vectorEquations) - CALL Equations_VectorEquationsGet(equations,vectorEquations,err,error,*999) - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STATIC_STOKES_SUBTYPE,EQUATIONS_SET_LAPLACE_STOKES_SUBTYPE, & - & EQUATIONS_SET_TRANSIENT_STOKES_SUBTYPE,PROBLEM_ALE_STOKES_SUBTYPE,PROBLEM_PGM_STOKES_SUBTYPE) - !Set Pointers - dependentField=>equations%interpolation%dependentField - independentField=>equations%interpolation%independentField - geometricField=>equations%interpolation%geometricField - materialsField=>equations%interpolation%materialsField - vectorMatrices=>vectorEquations%vectorMatrices - GEOMETRIC_BASIS=>geometricField%DECOMPOSITION%DOMAIN(geometricField%DECOMPOSITION%MESH_COMPONENT_NUMBER)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - DEPENDENT_BASIS=>dependentField%DECOMPOSITION%DOMAIN(dependentField%DECOMPOSITION%MESH_COMPONENT_NUMBER)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - QUADRATURE_SCHEME=>DEPENDENT_BASIS%QUADRATURE%QUADRATURE_SCHEME_MAP(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr - rhsVector=>vectorMatrices%rhsVector - vectorMapping=>vectorEquations%vectorMapping - SELECT CASE(EQUATIONS_SET%SPECIFICATION(3)) - CASE(EQUATIONS_SET_STATIC_STOKES_SUBTYPE,EQUATIONS_SET_LAPLACE_STOKES_SUBTYPE) - linearMatrices=>vectorMatrices%linearMatrices - stiffnessMatrix=>linearMatrices%matrices(1)%ptr - linearMapping=>vectorMapping%linearMapping - FIELD_VARIABLE=>linearMapping%equationsMatrixToVarMaps(1)%variable - stiffnessMatrix%elementMatrix%matrix=0.0_DP - IF(ASSOCIATED(stiffnessMatrix)) updateStiffnessMatrix=stiffnessMatrix%updateMatrix - IF(ASSOCIATED(rhsVector)) updateRHSVector=rhsVector%updateVector - CASE(EQUATIONS_SET_TRANSIENT_STOKES_SUBTYPE) - dynamicMatrices=>vectorMatrices%dynamicMatrices - stiffnessMatrix=>dynamicMatrices%matrices(1)%ptr - dampingMatrix=>dynamicMatrices%matrices(2)%ptr - dynamicMapping=>vectorMapping%dynamicMapping - FIELD_VARIABLE=>dynamicMapping%equationsMatrixToVarMaps(1)%variable - FIELD_VAR_TYPE=FIELD_VARIABLE%VARIABLE_TYPE - stiffnessMatrix%elementMatrix%matrix=0.0_DP - dampingMatrix%elementMatrix%matrix=0.0_DP - IF(ASSOCIATED(stiffnessMatrix)) updateStiffnessMatrix=stiffnessMatrix%updateMatrix - IF(ASSOCIATED(dampingMatrix)) updateDampingMatrix=dampingMatrix%updateMatrix - IF(ASSOCIATED(rhsVector)) updateRHSVector=rhsVector%updateVector - CASE(EQUATIONS_SET_ALE_STOKES_SUBTYPE,EQUATIONS_SET_PGM_STOKES_SUBTYPE) - independentField=>equations%interpolation%independentField - INDEPENDENT_BASIS=>independentField%DECOMPOSITION%DOMAIN(independentField%DECOMPOSITION%MESH_COMPONENT_NUMBER)% & - & PTR%TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - dynamicMatrices=>vectorMatrices%dynamicMatrices - stiffnessMatrix=>dynamicMatrices%matrices(1)%ptr - dampingMatrix=>dynamicMatrices%matrices(2)%ptr - dynamicMapping=>vectorMapping%dynamicMapping - FIELD_VARIABLE=>dynamicMapping%equationsMatrixToVarMaps(1)%variable - FIELD_VAR_TYPE=FIELD_VARIABLE%VARIABLE_TYPE - stiffnessMatrix%elementMatrix%matrix=0.0_DP - dampingMatrix%elementMatrix%matrix=0.0_DP - IF(ASSOCIATED(stiffnessMatrix)) updateStiffnessMatrix=stiffnessMatrix%updateMatrix - IF(ASSOCIATED(dampingMatrix)) updateDampingMatrix=dampingMatrix%updateMatrix - IF(ASSOCIATED(rhsVector)) updateRHSVector=rhsVector%updateVector - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_MESH_VELOCITY_SET_TYPE,ELEMENT_NUMBER, & - & equations%interpolation%independentInterpParameters(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - CASE DEFAULT - localError="Equations set subtype "//TRIM(NumberToVString(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Stokes fluid type of a fluid mechanics equations set class." - CALL FlagError(localError,err,error,*999) - END SELECT - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER,equations%interpolation% & - & geometricInterpParameters(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,ELEMENT_NUMBER,equations%interpolation% & - & materialsInterpParameters(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - - !Start looping over Gauss points - DO ng=1,QUADRATURE_SCHEME%NUMBER_OF_GAUSS - CALL FIELD_INTERPOLATE_GAUSS(FIRST_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng,equations%interpolation% & - & geometricInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - CALL FIELD_INTERPOLATED_POINT_METRICS_CALCULATE(GEOMETRIC_BASIS%NUMBER_OF_XI,equations%interpolation% & - & geometricInterpPointMetrics(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - CALL FIELD_INTERPOLATE_GAUSS(NO_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng,equations%interpolation% & - & materialsInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_ALE_STOKES_SUBTYPE.OR. & - & EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_PGM_STOKES_SUBTYPE) THEN - CALL FIELD_INTERPOLATE_GAUSS(FIRST_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng,equations%interpolation% & - & independentInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - W_VALUE(1)=equations%interpolation%independentInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(1,NO_PART_DERIV) - W_VALUE(2)=equations%interpolation%independentInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(2,NO_PART_DERIV) - IF(FIELD_VARIABLE%NUMBER_OF_COMPONENTS==4) THEN - W_VALUE(3)=equations%interpolation%independentInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(3,NO_PART_DERIV) - END IF - ELSE - W_VALUE=0.0_DP - END IF - !Define MU_PARAM, viscosity=1 - MU_PARAM=equations%interpolation%materialsInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(1,NO_PART_DERIV) - !Define RHO_PARAM, density=2 - RHO_PARAM=equations%interpolation%materialsInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(2,NO_PART_DERIV) - !Calculate partial matrices -!\todo: Check time spent here - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_STATIC_STOKES_SUBTYPE.OR. & - & EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_LAPLACE_STOKES_SUBTYPE.OR. & - & EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_ALE_STOKES_SUBTYPE.OR. & - & EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_PGM_STOKES_SUBTYPE.OR. & - & EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_TRANSIENT_STOKES_SUBTYPE) THEN - !Loop over field components - mhs=0 - DO mh=1,(FIELD_VARIABLE%NUMBER_OF_COMPONENTS-1) - MESH_COMPONENT1=FIELD_VARIABLE%COMPONENTS(mh)%MESH_COMPONENT_NUMBER - DEPENDENT_BASIS1=>dependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT1)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - QUADRATURE_SCHEME1=>DEPENDENT_BASIS1%QUADRATURE%QUADRATURE_SCHEME_MAP(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr - JGW=equations%interpolation%geometricInterpPointMetrics(FIELD_U_VARIABLE_TYPE)%ptr%JACOBIAN* & - & QUADRATURE_SCHEME1%GAUSS_WEIGHTS(ng) - DO ms=1,DEPENDENT_BASIS1%NUMBER_OF_ELEMENT_PARAMETERS - mhs=mhs+1 - nhs=0 - IF(updateStiffnessMatrix.OR.updateDampingMatrix) THEN - !Loop over element columns - DO nh=1,(FIELD_VARIABLE%NUMBER_OF_COMPONENTS) - - MESH_COMPONENT2=FIELD_VARIABLE%COMPONENTS(nh)%MESH_COMPONENT_NUMBER - DEPENDENT_BASIS2=>dependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT2)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - QUADRATURE_SCHEME2=>DEPENDENT_BASIS2%QUADRATURE%QUADRATURE_SCHEME_MAP & - & (BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr - ! JGW=equations%interpolation%geometricInterpPointMetrics%JACOBIAN*QUADRATURE_SCHEME2%& - ! &GAUSS_WEIGHTS(ng) - DO ns=1,DEPENDENT_BASIS2%NUMBER_OF_ELEMENT_PARAMETERS - nhs=nhs+1 - !Calculate some variables used later on - DO ni=1,DEPENDENT_BASIS2%NUMBER_OF_XI - DO mi=1,DEPENDENT_BASIS1%NUMBER_OF_XI - DXI_DX(mi,ni)=equations%interpolation%geometricInterpPointMetrics(FIELD_U_VARIABLE_TYPE)%ptr% & - & DXI_DX(mi,ni) - END DO - DPHIMS_DXI(ni)=QUADRATURE_SCHEME1%GAUSS_BASIS_FNS(ms,PARTIAL_DERIVATIVE_FIRST_DERIVATIVE_MAP(ni),ng) - DPHINS_DXI(ni)=QUADRATURE_SCHEME2%GAUSS_BASIS_FNS(ns,PARTIAL_DERIVATIVE_FIRST_DERIVATIVE_MAP(ni),ng) - END DO !ni - PHIMS=QUADRATURE_SCHEME1%GAUSS_BASIS_FNS(ms,NO_PART_DERIV,ng) - PHINS=QUADRATURE_SCHEME2%GAUSS_BASIS_FNS(ns,NO_PART_DERIV,ng) - ! DO mi=1,DEPENDENT_BASIS1%NUMBER_OF_XI - ! DO ni=1,DEPENDENT_BASIS2%NUMBER_OF_XI - ! SUM=SUM-MU_PARAM*DPHIMSS_DXI(mi)*DPHINSS_DXI(ni)*equations%interpolation%geometricInterpPointMetrics%GU(mi,ni) - ! ENDDO !ni - ! ENDDO !mi - IF(updateStiffnessMatrix) THEN - - !LAPLACE TYPE - IF(nh==mh) THEN - SUM=0.0_DP - !Calculate SUM - DO xv=1,DEPENDENT_BASIS1%NUMBER_OF_XI - DO mi=1,DEPENDENT_BASIS1%NUMBER_OF_XI - DO ni=1,DEPENDENT_BASIS2%NUMBER_OF_XI - SUM=SUM+MU_PARAM*DPHINS_DXI(ni)*DXI_DX(ni,xv)*DPHIMS_DXI(mi)*DXI_DX(mi,xv) - ENDDO !ni - ENDDO !mi - ENDDO !x - !Calculate MATRIX - AL_MATRIX(mhs,nhs)=AL_MATRIX(mhs,nhs)+SUM*JGW - END IF - - END IF - !Calculate standard matrix (gradient transpose type) - IF(updateStiffnessMatrix) THEN - - IF(EQUATIONS_SET%SPECIFICATION(3)/=EQUATIONS_SET_LAPLACE_STOKES_SUBTYPE) THEN - IF(nhdependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT1)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - QUADRATURE_SCHEME1=>DEPENDENT_BASIS1%QUADRATURE%QUADRATURE_SCHEME_MAP(BASIS_DEFAULT_QUADRATURE_SCHEME)%ptr - JGW=equations%interpolation%geometricInterpPointMetrics(FIELD_U_VARIABLE_TYPE)%ptr%JACOBIAN* & - & QUADRATURE_SCHEME1%GAUSS_WEIGHTS(ng) - DO ms=1,DEPENDENT_BASIS1%NUMBER_OF_ELEMENT_PARAMETERS - mhs=mhs+1 - PHIMS=QUADRATURE_SCHEME1%GAUSS_BASIS_FNS(ms,NO_PART_DERIV,ng) - !note mh value derivative - SUM=0.0_DP - X(1) = equations%interpolation%geometricInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(1,1) - X(2) = equations%interpolation%geometricInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(2,1) - IF(DEPENDENT_BASIS1%NUMBER_OF_XI==3) THEN - X(3) = equations%interpolation%geometricInterpPoint(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(3,1) - END IF - IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_1) THEN - IF(mh==1) THEN - !Calculate SUM - SUM=0.0_DP - ELSE IF(mh==2) THEN - !Calculate SUM - SUM=PHIMS*(-2.0_DP*MU_PARAM/10.0_DP**2) - ENDIF - ELSE IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_2) THEN - IF(mh==1) THEN - !Calculate SUM - SUM=0.0_DP - ELSE IF(mh==2) THEN - !Calculate SUM - SUM=PHIMS*(-4.0_DP*MU_PARAM/100.0_DP*EXP((X(1)-X(2))/10.0_DP)) - ENDIF - ELSE IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_3) THEN - IF(mh==1) THEN - !Calculate SUM - SUM=0.0_DP - ELSE IF(mh==2) THEN - !Calculate SUM - SUM=PHIMS*(16.0_DP*MU_PARAM*PI*PI/100.0_DP*COS(2.0_DP*PI*X(2)/10.0_DP)*COS(2.0_DP*PI*X(1)/10.0_DP)) - ENDIF - ELSE IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_4) THEN -! do nothing! - ELSE IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_5) THEN -! do nothing! - ELSE IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_4) THEN -! do nothing! - ELSE IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_5) THEN -! do nothing! - ELSE IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_1) THEN - IF(mh==1) THEN - !Calculate SUM - SUM=0.0_DP - ELSE IF(mh==2) THEN - !Calculate SUM - SUM=PHIMS*(-4.0_DP*MU_PARAM/100.0_DP) - ELSE IF(mh==3) THEN - !Calculate SUM - SUM=PHIMS*(-4.0_DP*MU_PARAM/100.0_DP) - ENDIF - ELSE IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_2) THEN - IF(mh==1) THEN - !Calculate SUM - SUM=0.0_DP - ELSE IF(mh==2) THEN - !Calculate SUM - SUM=PHIMS*(-2.0_DP*MU_PARAM/100.0_DP*(2.0_DP*EXP((X(1)-X(2))/10.0_DP)+EXP((X(2)-X(3))/10.0_DP))) - ELSE IF(mh==3) THEN - !Calculate SUM - SUM=PHIMS*(-2.0_DP*MU_PARAM/100.0_DP*(2.0_DP*EXP((X(3)-X(1))/10.0_DP)+EXP((X(2)-X(3))/10.0_DP))) - ENDIF - ELSE IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_3) THEN - IF(mh==1) THEN - !Calculate SUM - SUM=0.0_DP - ELSE IF(mh==2) THEN - !Calculate SUM - SUM=PHIMS*(36*MU_PARAM*PI**2/100.0_DP*COS(2.0_DP*PI*X(2)/10.0_DP)*SIN(2.0_DP*PI*X(3)/10.0_DP)* & - & COS(2.0_DP*PI*X(1)/10.0_DP)) - ELSE IF(mh==3) THEN - !Calculate SUM - SUM=0.0_DP - ENDIF - ENDIF - !Calculate RH VECTOR - RH_VECTOR(mhs)=RH_VECTOR(mhs)+SUM*JGW - ENDDO !ms - ENDDO !mh - ELSE - RH_VECTOR(mhs)=0.0_DP - ENDIF - ENDIF - END IF - ENDDO !ng - !Assemble matrices calculated above - mhs_min=mhs - mhs_max=nhs - nhs_min=mhs - nhs_max=nhs - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_STATIC_STOKES_SUBTYPE.OR. & - & EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_LAPLACE_STOKES_SUBTYPE.OR. & - & EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_ALE_STOKES_SUBTYPE.OR. & - & EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_PGM_STOKES_SUBTYPE.OR. & - & EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_TRANSIENT_STOKES_SUBTYPE) THEN - IF(updateStiffnessMatrix) THEN - stiffnessMatrix%elementMatrix%matrix(1:mhs_min,1:nhs_min)=AL_MATRIX(1:mhs_min,1:nhs_min)+AG_MATRIX(1:mhs_min, & - & 1:nhs_min)+ALE_MATRIX(1:mhs_min,1:nhs_min) - stiffnessMatrix%elementMatrix%matrix(1:mhs_min,nhs_min+1:nhs_max)=BT_MATRIX(1:mhs_min,nhs_min+1:nhs_max) - DO mhs=mhs_min+1,mhs_max - DO nhs=1,nhs_min - !Transpose pressure type entries for mass equation - stiffnessMatrix%elementMatrix%matrix(mhs,nhs)=stiffnessMatrix%elementMatrix%matrix(nhs,mhs) - END DO - END DO - END IF - END IF - IF(EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_TRANSIENT_STOKES_SUBTYPE.OR. & - & EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_ALE_STOKES_SUBTYPE.OR. & - & EQUATIONS_SET%SPECIFICATION(3)==EQUATIONS_SET_PGM_STOKES_SUBTYPE) THEN - IF(updateDampingMatrix) THEN - dampingMatrix%elementMatrix%matrix(1:mhs_min,1:nhs_min)=MT_MATRIX(1:mhs_min,1:nhs_min) - END IF - END IF - !Assemble RHS vector - IF(rhsVector%firstAssembly) THEN - IF(updateRHSVector) THEN - rhsVector%elementVector%vector(1:mhs_max)=RH_VECTOR(1:mhs_max) - ENDIF - ENDIF - !Scale factor adjustment - IF(dependentField%SCALINGS%SCALING_TYPE/=FIELD_NO_SCALING) THEN - CALL Field_InterpolationParametersScaleFactorsElementGet(ELEMENT_NUMBER,equations%interpolation% & - & dependentInterpParameters(FIELD_VAR_TYPE)%ptr,err,error,*999) - mhs=0 - DO mh=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - !Loop over element rows - MESH_COMPONENT1=FIELD_VARIABLE%COMPONENTS(mh)%MESH_COMPONENT_NUMBER - DEPENDENT_BASIS1=>dependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT1)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - DO ms=1,DEPENDENT_BASIS1%NUMBER_OF_ELEMENT_PARAMETERS - mhs=mhs+1 - nhs=0 - IF(updateStiffnessMatrix.OR.updateDampingMatrix) THEN - !Loop over element columns - DO nh=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - MESH_COMPONENT2=FIELD_VARIABLE%COMPONENTS(nh)%MESH_COMPONENT_NUMBER - DEPENDENT_BASIS2=>dependentField%DECOMPOSITION%DOMAIN(MESH_COMPONENT2)%ptr% & - & TOPOLOGY%ELEMENTS%ELEMENTS(ELEMENT_NUMBER)%BASIS - DO ns=1,DEPENDENT_BASIS2%NUMBER_OF_ELEMENT_PARAMETERS - nhs=nhs+1 - IF(updateStiffnessMatrix)THEN - stiffnessMatrix%elementMatrix%matrix(mhs,nhs)=stiffnessMatrix%elementMatrix%matrix(mhs,nhs)* & - & equations%interpolation%dependentInterpParameters(FIELD_VAR_TYPE)%ptr%SCALE_FACTORS(ms,mh)* & - & equations%interpolation%dependentInterpParameters(FIELD_VAR_TYPE)%ptr%SCALE_FACTORS(ns,nh) - END IF - IF(updateDampingMatrix)THEN - dampingMatrix%elementMatrix%matrix(mhs,nhs)=dampingMatrix%elementMatrix%matrix(mhs,nhs)* & - & equations%interpolation%dependentInterpParameters(FIELD_VAR_TYPE)%ptr%SCALE_FACTORS(ms,mh)* & - & equations%interpolation%dependentInterpParameters(FIELD_VAR_TYPE)%ptr%SCALE_FACTORS(ns,nh) - END IF - ENDDO !ns - ENDDO !nh - ENDIF - IF(updateRHSVector) rhsVector%elementVector%vector(mhs)=rhsVector%elementVector%vector(mhs)* & - & equations%interpolation%dependentInterpParameters(FIELD_VAR_TYPE)%ptr%SCALE_FACTORS(ms,mh) - ENDDO !ms - ENDDO !mh - ENDIF - CASE DEFAULT - localError="Equations set subtype "//TRIM(NumberToVString(EQUATIONS_SET%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Stokes fluid type of a fluid mechanics equations set class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Equations set equations is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - ENDIF - - EXITS("STOKES_FINITE_ELEMENT_CALCULATE") - RETURN -999 ERRORSEXITS("STOKES_FINITE_ELEMENT_CALCULATE",err,error) - RETURN 1 - END SUBROUTINE STOKES_FINITE_ELEMENT_CALCULATE - - ! - !================================================================================================================================ - ! - - !>Sets up the Stokes problem post solve. - SUBROUTINE STOKES_POST_SOLVE(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !Sets up the Stokes problem pre solve. - SUBROUTINE STOKES_PRE_SOLVE(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !Update boundary conditions for Stokes flow pre solve - SUBROUTINE STOKES_PRE_SOLVE_UPDATE_BOUNDARY_CONDITIONS(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !SOLVER_MAPPING_ALE_STOKES%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS - IF(ASSOCIATED(EQUATIONS)) THEN - NULLIFY(vectorEquations) - CALL Equations_VectorEquationsGet(equations,vectorEquations,err,error,*999) - vectorMapping=>vectorEquations%vectorMapping - IF(ASSOCIATED(vectorMapping)) THEN - DO variable_idx=1,EQUATIONS_SET_ALE_STOKES%DEPENDENT%DEPENDENT_FIELD%NUMBER_OF_VARIABLES - variable_type=EQUATIONS_SET_ALE_STOKES%DEPENDENT%DEPENDENT_FIELD%VARIABLES(variable_idx)%variable_TYPE - FIELD_VARIABLE=>EQUATIONS_SET_ALE_STOKES%GEOMETRY%GEOMETRIC_FIELD%VARIABLE_TYPE_MAP(variable_type)%ptr - IF(ASSOCIATED(FIELD_VARIABLE)) THEN - DO component_idx=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - DOMAIN=>FIELD_VARIABLE%COMPONENTS(component_idx)%DOMAIN - IF(ASSOCIATED(DOMAIN)) THEN - IF(ASSOCIATED(DOMAIN%TOPOLOGY)) THEN - DOMAIN_NODES=>DOMAIN%TOPOLOGY%NODES - IF(ASSOCIATED(DOMAIN_NODES)) THEN - !Loop over the local nodes excluding the ghosts. - DO node_idx=1,DOMAIN_NODES%NUMBER_OF_NODES - DO deriv_idx=1,DOMAIN_NODES%NODES(node_idx)%NUMBER_OF_DERIVATIVES - !Default to version 1 of each node derivative - local_ny=FIELD_VARIABLE%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% & - & NODE_PARAM2DOF_MAP%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1) - CALL FIELD_PARAMETER_SET_ADD_LOCAL_DOF(EQUATIONS_SET_ALE_STOKES%GEOMETRY%GEOMETRIC_FIELD, & - & FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,local_ny, & - & MESH_DISPLACEMENT_VALUES(local_ny),err,error,*999) - ENDDO !deriv_idx - ENDDO !node_idx - ENDIF - ENDIF - ENDIF - ENDDO !component_idx - ENDIF - ENDDO !variable_idx - ELSE - CALL FlagError("Equations mapping is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Equations are not associated.",err,error,*999) - END IF - CALL FIELD_PARAMETER_SET_UPDATE_START(EQUATIONS_SET_ALE_STOKES%GEOMETRY%GEOMETRIC_FIELD, & - & FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(EQUATIONS_SET_ALE_STOKES%GEOMETRY%GEOMETRIC_FIELD, & - & FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,err,error,*999) - !Now use displacement values to calculate velocity values - TIME_INCREMENT=CONTROL_LOOP%TIME_LOOP%TIME_INCREMENT - ALPHA=1.0_DP/TIME_INCREMENT - CALL FIELD_PARAMETER_SETS_COPY(INDEPENDENT_FIELD_ALE_STOKES,FIELD_U_VARIABLE_TYPE, & - & FIELD_MESH_DISPLACEMENT_SET_TYPE,FIELD_MESH_VELOCITY_SET_TYPE,ALPHA,err,error,*999) - ELSE - CALL FlagError("Mesh motion calculation not successful for ALE problem.",err,error,*999) - END IF - CASE(PROBLEM_ALE_STOKES_SUBTYPE) - !Update mesh within the dynamic solver - IF(SOLVER%SOLVE_TYPE==SOLVER_DYNAMIC_TYPE) THEN - IF(SOLVER%DYNAMIC_SOLVER%ALE) THEN - !Get the dependent field for the three component Laplace problem - CALL SOLVERS_SOLVER_GET(SOLVER%SOLVERS,1,SOLVER_LAPLACE,err,error,*999) - SOLVER_EQUATIONS_LAPLACE=>SOLVER_LAPLACE%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS_LAPLACE)) THEN - SOLVER_MAPPING_LAPLACE=>SOLVER_EQUATIONS_LAPLACE%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING_LAPLACE)) THEN - EQUATIONS_SET_LAPLACE=>SOLVER_MAPPING_LAPLACE%EQUATIONS_SETS(1)%ptr - IF(ASSOCIATED(EQUATIONS_SET_LAPLACE)) THEN - DEPENDENT_FIELD_LAPLACE=>EQUATIONS_SET_LAPLACE%DEPENDENT%DEPENDENT_FIELD - ELSE - CALL FlagError("Laplace equations set is not associated.",err,error,*999) - END IF - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET_LAPLACE%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & NUMBER_OF_DIMENSIONS_LAPLACE,err,error,*999) - ELSE - CALL FlagError("Laplace solver mapping is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Laplace solver equations are not associated.",err,error,*999) - END IF - !Get the independent field for the ALE Stokes problem - CALL SOLVERS_SOLVER_GET(SOLVER%SOLVERS,2,SOLVER_ALE_STOKES,err,error,*999) - SOLVER_EQUATIONS_ALE_STOKES=>SOLVER_ALE_STOKES%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS_ALE_STOKES)) THEN - SOLVER_MAPPING_ALE_STOKES=>SOLVER_EQUATIONS_ALE_STOKES%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING_ALE_STOKES)) THEN - EQUATIONS_SET_ALE_STOKES=>SOLVER_MAPPING_ALE_STOKES%EQUATIONS_SETS(1)%ptr - IF(ASSOCIATED(EQUATIONS_SET_ALE_STOKES)) THEN - INDEPENDENT_FIELD_ALE_STOKES=>EQUATIONS_SET_ALE_STOKES%INDEPENDENT%INDEPENDENT_FIELD - ELSE - CALL FlagError("ALE Stokes equations set is not associated.",err,error,*999) - END IF - CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET_ALE_STOKES%GEOMETRY%GEOMETRIC_FIELD, & - & FIELD_U_VARIABLE_TYPE,NUMBER_OF_DIMENSIONS_ALE_STOKES,err,error,*999) - ELSE - CALL FlagError("ALE Stokes solver mapping is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("ALE Stokes solver equations are not associated.",err,error,*999) - END IF - !Copy result from Laplace mesh movement to Stokes' independent field - IF(NUMBER_OF_DIMENSIONS_ALE_STOKES==NUMBER_OF_DIMENSIONS_LAPLACE) THEN - DO I=1,NUMBER_OF_DIMENSIONS_ALE_STOKES - CALL Field_ParametersToFieldParametersCopy(DEPENDENT_FIELD_LAPLACE, & - & FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,I,INDEPENDENT_FIELD_ALE_STOKES, & - & FIELD_U_VARIABLE_TYPE,FIELD_MESH_DISPLACEMENT_SET_TYPE,I,err,error,*999) - END DO - ELSE - CALL FlagError("Dimension of Laplace and ALE Stokes equations set is not consistent.",err,error,*999) - END IF - !Use calculated values to update mesh - CALL FIELD_COMPONENT_MESH_COMPONENT_GET(EQUATIONS_SET_ALE_STOKES%GEOMETRY%GEOMETRIC_FIELD, & - & FIELD_U_VARIABLE_TYPE,1,GEOMETRIC_MESH_COMPONENT,err,error,*999) - NULLIFY(MESH_DISPLACEMENT_VALUES) - CALL FIELD_PARAMETER_SET_DATA_GET(INDEPENDENT_FIELD_ALE_STOKES,FIELD_U_VARIABLE_TYPE, & - & FIELD_MESH_DISPLACEMENT_SET_TYPE,MESH_DISPLACEMENT_VALUES,err,error,*999) - EQUATIONS=>SOLVER_MAPPING_LAPLACE%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS - IF(ASSOCIATED(EQUATIONS)) THEN - NULLIFY(vectorEquations) - CALL Equations_VectorEquationsGet(equations,vectorEquations,err,error,*999) - vectorMapping=>vectorEquations%vectorMapping - IF(ASSOCIATED(vectorMapping)) THEN - DO variable_idx=1,EQUATIONS_SET_ALE_STOKES%DEPENDENT%DEPENDENT_FIELD%NUMBER_OF_VARIABLES - variable_type=EQUATIONS_SET_ALE_STOKES%DEPENDENT%DEPENDENT_FIELD%VARIABLES(variable_idx)%variable_TYPE - FIELD_VARIABLE=>EQUATIONS_SET_ALE_STOKES%GEOMETRY%GEOMETRIC_FIELD%VARIABLE_TYPE_MAP(variable_type)%ptr - IF(ASSOCIATED(FIELD_VARIABLE)) THEN - DO component_idx=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - DOMAIN=>FIELD_VARIABLE%COMPONENTS(component_idx)%DOMAIN - IF(ASSOCIATED(DOMAIN)) THEN - IF(ASSOCIATED(DOMAIN%TOPOLOGY)) THEN - DOMAIN_NODES=>DOMAIN%TOPOLOGY%NODES - IF(ASSOCIATED(DOMAIN_NODES)) THEN - !Loop over the local nodes excluding the ghosts. - DO node_idx=1,DOMAIN_NODES%NUMBER_OF_NODES - DO deriv_idx=1,DOMAIN_NODES%NODES(node_idx)%NUMBER_OF_DERIVATIVES - !Default to version 1 of each node derivative - local_ny=FIELD_VARIABLE%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% & - & NODE_PARAM2DOF_MAP%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1) - CALL FIELD_PARAMETER_SET_ADD_LOCAL_DOF(EQUATIONS_SET_ALE_STOKES%GEOMETRY%GEOMETRIC_FIELD, & - & FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,local_ny, & - & MESH_DISPLACEMENT_VALUES(local_ny),err,error,*999) - ENDDO !deriv_idx - ENDDO !node_idx - ENDIF - ENDIF - ENDIF - ENDDO !component_idx - ENDIF - ENDDO !variable_idx - ELSE - CALL FlagError("Equations mapping is not associated.",err,error,*999) - ENDIF - CALL FIELD_PARAMETER_SET_DATA_RESTORE(INDEPENDENT_FIELD_ALE_STOKES,FIELD_U_VARIABLE_TYPE, & - & FIELD_MESH_DISPLACEMENT_SET_TYPE,MESH_DISPLACEMENT_VALUES,err,error,*999) - ELSE - CALL FlagError("Equations are not associated.",err,error,*999) - END IF - CALL FIELD_PARAMETER_SET_UPDATE_START(EQUATIONS_SET_ALE_STOKES%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(EQUATIONS_SET_ALE_STOKES%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,err,error,*999) - !Now use displacement values to calculate velocity values - TIME_INCREMENT=CONTROL_LOOP%TIME_LOOP%TIME_INCREMENT - ALPHA=1.0_DP/TIME_INCREMENT - CALL FIELD_PARAMETER_SETS_COPY(INDEPENDENT_FIELD_ALE_STOKES,FIELD_U_VARIABLE_TYPE, & - & FIELD_MESH_DISPLACEMENT_SET_TYPE,FIELD_MESH_VELOCITY_SET_TYPE,ALPHA,err,error,*999) - ELSE - CALL FlagError("Mesh motion calculation not successful for ALE problem.",err,error,*999) - END IF - ELSE - CALL FlagError("Mesh update is not defined for non-dynamic problems.",err,error,*999) - END IF - CASE DEFAULT - localError="Problem subtype "//TRIM(NumberToVString(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Stokes equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - EXITS("STOKES_PRE_SOLVE_ALE_UPDATE_MESH") - RETURN -999 ERRORSEXITS("STOKES_PRE_SOLVE_ALE_UPDATE_MESH",err,error) - RETURN 1 - END SUBROUTINE STOKES_PRE_SOLVE_ALE_UPDATE_MESH - - ! - !================================================================================================================================ - ! - !>Update mesh parameters for three component Laplace problem - SUBROUTINE STOKES_PRE_SOLVE_ALE_UPDATE_PARAMETERS(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !SOLVER%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN - SOLVER_MAPPING=>SOLVER_equations%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING)) THEN - EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(1)%ptr - NULLIFY(MESH_STIFF_VALUES) - CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,MESH_STIFF_VALUES,err,error,*999) - IF(ASSOCIATED(EQUATIONS_SET)) THEN - EQUATIONS=>SOLVER_MAPPING%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS - IF(ASSOCIATED(EQUATIONS)) THEN - independentField=>EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD - IF(ASSOCIATED(independentField)) THEN - DO variable_idx=1,EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD%NUMBER_OF_VARIABLES - variable_type=EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD%VARIABLES(variable_idx)%variable_TYPE - FIELD_VARIABLE=>EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD%VARIABLE_TYPE_MAP(variable_type)%ptr - IF(ASSOCIATED(FIELD_VARIABLE)) THEN - DO component_idx=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - DOMAIN=>FIELD_VARIABLE%COMPONENTS(component_idx)%DOMAIN - IF(ASSOCIATED(DOMAIN)) THEN - IF(ASSOCIATED(DOMAIN%TOPOLOGY)) THEN - DOMAIN_NODES=>DOMAIN%TOPOLOGY%NODES - IF(ASSOCIATED(DOMAIN_NODES)) THEN - !Loop over the local nodes excluding the ghosts. - DO node_idx=1,DOMAIN_NODES%NUMBER_OF_NODES - DO deriv_idx=1,DOMAIN_NODES%NODES(node_idx)%NUMBER_OF_DERIVATIVES - !Default to version 1 of each node derivative - local_ny=FIELD_VARIABLE%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% & - & NODE_PARAM2DOF_MAP%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1) - ! !Calculation of K values dependent on current mesh topology - MESH_STIFF_VALUES(local_ny)=1.0_DP - CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(EQUATIONS_SET%INDEPENDENT% & - & INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,local_ny, & - & MESH_STIFF_VALUES(local_ny),err,error,*999) - ENDDO !deriv_idx - ENDDO !node_idx - ENDIF - ENDIF - ENDIF - ENDDO !component_idx - ENDIF - ENDDO !variable_idx - ELSE - CALL FlagError("Independent field is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Equations are not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - ENDIF - CALL FIELD_PARAMETER_SET_DATA_RESTORE(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,MESH_STIFF_VALUES,err,error,*999) - ELSE - CALL FlagError("Solver mapping is not associated.",err,error,*999) - END IF - ELSE - CALL FlagError("Solver equations are not associated.",err,error,*999) - END IF - ELSE IF(SOLVER%SOLVE_TYPE==SOLVER_DYNAMIC_TYPE) THEN - CALL FlagError("Mesh motion calculation not successful for ALE problem.",err,error,*999) - END IF - CASE DEFAULT - localError="Problem subtype "//TRIM(NumberToVString(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Stokes equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - EXITS("STOKES_PRE_SOLVE_ALE_UPDATE_PARAMETERS") - RETURN -999 ERRORSEXITS("STOKES_PRE_SOLVE_ALE_UPDATE_PARAMETERS",err,error) - RETURN 1 - END SUBROUTINE STOKES_PRE_SOLVE_ALE_UPDATE_PARAMETERS - - ! - !================================================================================================================================ - ! - - !>Output data post solve - SUBROUTINE STOKES_POST_SOLVE_OUTPUT_DATA(CONTROL_LOOP,SOLVER,err,error,*) - - !Argument variables - TYPE(CONTROL_LOOP_TYPE), POINTER :: CONTROL_LOOP !SOLVER%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN - SOLVER_MAPPING=>SOLVER_equations%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING)) THEN - !Make sure the equations sets are up to date - DO equations_set_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS - EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(equations_set_idx)%ptr - FILENAME="./output/"//"STATIC_SOLUTION" - METHOD="FORTRAN" - IF(SOLVER%outputType>=SOLVER_PROGRESS_OUTPUT) THEN - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"...",err,error,*999) - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Now export fields... ",err,error,*999) - ENDIF - Fields=>EQUATIONS_SET%REGION%FIELDS - CALL FIELD_IO_NODES_EXPORT(Fields,FILENAME,METHOD,err,error,*999) - CALL FIELD_IO_ELEMENTS_EXPORT(Fields,FILENAME,METHOD,err,error,*999) - NULLIFY(Fields) - ENDDO - ENDIF - ENDIF - CASE(PROBLEM_TRANSIENT_STOKES_SUBTYPE,PROBLEM_ALE_STOKES_SUBTYPE,PROBLEM_PGM_STOKES_SUBTYPE) - CALL CONTROL_LOOP_CURRENT_TIMES_GET(CONTROL_LOOP,CURRENT_TIME,TIME_INCREMENT,err,error,*999) - SOLVER_EQUATIONS=>SOLVER%SOLVER_EQUATIONS - IF(ASSOCIATED(SOLVER_EQUATIONS)) THEN - SOLVER_MAPPING=>SOLVER_equations%SOLVER_MAPPING - IF(ASSOCIATED(SOLVER_MAPPING)) THEN - !Make sure the equations sets are up to date - DO equations_set_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS - EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(equations_set_idx)%ptr - CURRENT_LOOP_ITERATION=CONTROL_LOOP%TIME_LOOP%ITERATION_NUMBER - OUTPUT_ITERATION_NUMBER=CONTROL_LOOP%TIME_LOOP%OUTPUT_NUMBER - IF(OUTPUT_ITERATION_NUMBER/=0) THEN - IF(CONTROL_LOOP%TIME_LOOP%CURRENT_TIME<=CONTROL_LOOP%TIME_LOOP%STOP_TIME) THEN - IF(CURRENT_LOOP_ITERATION<10) THEN - WRITE(OUTPUT_FILE,'("TIME_STEP_000",I0)') CURRENT_LOOP_ITERATION - ELSE IF(CURRENT_LOOP_ITERATION<100) THEN - WRITE(OUTPUT_FILE,'("TIME_STEP_00",I0)') CURRENT_LOOP_ITERATION - ELSE IF(CURRENT_LOOP_ITERATION<1000) THEN - WRITE(OUTPUT_FILE,'("TIME_STEP_0",I0)') CURRENT_LOOP_ITERATION - ELSE IF(CURRENT_LOOP_ITERATION<10000) THEN - WRITE(OUTPUT_FILE,'("TIME_STEP_",I0)') CURRENT_LOOP_ITERATION - END IF - FILENAME="./output/"//"MainTime_"//TRIM(NumberToVString(CURRENT_LOOP_ITERATION,"*",err,error)) - METHOD="FORTRAN" - IF(MOD(CURRENT_LOOP_ITERATION,OUTPUT_ITERATION_NUMBER)==0) THEN - IF(CONTROL_LOOP%outputtype >= CONTROL_LOOP_PROGRESS_OUTPUT) THEN - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"...",err,error,*999) - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Now export fields... ",err,error,*999) - ENDIF - Fields=>EQUATIONS_SET%REGION%FIELDS - CALL FIELD_IO_NODES_EXPORT(Fields,FILENAME,METHOD,err,error,*999) - CALL FIELD_IO_ELEMENTS_EXPORT(Fields,FILENAME,METHOD,err,error,*999) - NULLIFY(Fields) - IF(CONTROL_LOOP%outputtype >= CONTROL_LOOP_PROGRESS_OUTPUT) THEN - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,FILENAME,err,error,*999) - CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"...",err,error,*999) - ENDIF - END IF - IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN - IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_NAVIER_STOKES_EQUATION_TWO_DIM_4.OR. & - & EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_NAVIER_STOKES_EQUATION_TWO_DIM_5.OR. & - & EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_NAVIER_STOKES_EQUATION_THREE_DIM_4.OR. & - & EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_NAVIER_STOKES_EQUATION_THREE_DIM_5.OR. & - & EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_NAVIER_STOKES_EQUATION_THREE_DIM_1) THEN - CALL AnalyticAnalysis_Output(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,OUTPUT_FILE,err,error,*999) - ENDIF - ENDIF - ENDIF - ENDIF - ENDDO - ENDIF - ENDIF - CASE DEFAULT - localError="Problem subtype "//TRIM(NumberToVString(CONTROL_LOOP%PROBLEM%SPECIFICATION(3),"*",err,error))// & - & " is not valid for a Stokes equation fluid type of a fluid mechanics problem class." - CALL FlagError(localError,err,error,*999) - END SELECT - ELSE - CALL FlagError("Problem is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Solver is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Control loop is not associated.",err,error,*999) - ENDIF - EXITS("STOKES_POST_SOLVE_OUTPUT_DATA") - RETURN -999 ERRORSEXITS("STOKES_POST_SOLVE_OUTPUT_DATA",err,error) - RETURN 1 - END SUBROUTINE STOKES_POST_SOLVE_OUTPUT_DATA - - ! - !================================================================================================================================ - ! - - !>Calculates the analytic solution and sets the boundary conditions for an analytic problem. - SUBROUTINE Stokes_BoundaryConditionsAnalyticCalculate(EQUATIONS_SET,BOUNDARY_CONDITIONS,err,error,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: EQUATIONS_SET - TYPE(BOUNDARY_CONDITIONS_TYPE), POINTER :: BOUNDARY_CONDITIONS - INTEGER(INTG), INTENT(OUT) :: ERR !EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD - IF(ASSOCIATED(dependentField)) THEN - geometricField=>EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD - IF(ASSOCIATED(geometricField)) THEN - NULLIFY(INTERPOLATION_PARAMETERS) - NULLIFY(INTERPOLATED_POINT) - CALL FIELD_INTERPOLATION_PARAMETERS_INITIALISE(geometricField,INTERPOLATION_PARAMETERS,err,error,*999) - CALL FIELD_INTERPOLATED_POINTS_INITIALISE(INTERPOLATION_PARAMETERS,INTERPOLATED_POINT,err,error,*999) - CALL FIELD_NUMBER_OF_COMPONENTS_GET(geometricField,FIELD_U_VARIABLE_TYPE,NUMBER_OF_DIMENSIONS,err,error,*999) -! ! ! !\todo: Check adjacent element calculation / use boundary node flag instead / didn't work for simplex -! ! ! IF(NUMBER_OF_DIMENSIONS==2) THEN -! ! ! BOUNDARY_X(1,1)=0.0_DP -! ! ! BOUNDARY_X(1,2)=10.0_DP -! ! ! BOUNDARY_X(2,1)=0.0_DP -! ! ! BOUNDARY_X(2,2)=10.0_DP -! ! ! ELSE IF(NUMBER_OF_DIMENSIONS==3) THEN -! ! ! BOUNDARY_X(1,1)=-5.0_DP -! ! ! BOUNDARY_X(1,2)=5.0_DP -! ! ! BOUNDARY_X(2,1)=-5.0_DP -! ! ! BOUNDARY_X(2,2)=5.0_DP -! ! ! BOUNDARY_X(3,1)=-5.0_DP -! ! ! BOUNDARY_X(3,2)=5.0_DP -! ! ! ENDIF - NULLIFY(GEOMETRIC_VARIABLE) - CALL Field_VariableGet(geometricField,FIELD_U_VARIABLE_TYPE,GEOMETRIC_VARIABLE,err,error,*999) - NULLIFY(GEOMETRIC_PARAMETERS) - CALL FIELD_PARAMETER_SET_DATA_GET(geometricField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,GEOMETRIC_PARAMETERS, & - & err,error,*999) - IF(ASSOCIATED(BOUNDARY_CONDITIONS)) THEN - DO variable_idx=1,dependentField%NUMBER_OF_VARIABLES - variable_type=dependentField%VARIABLES(variable_idx)%variable_TYPE - FIELD_VARIABLE=>dependentField%VARIABLE_TYPE_MAP(variable_type)%ptr - IF(ASSOCIATED(FIELD_VARIABLE)) THEN - CALL FIELD_PARAMETER_SET_CREATE(dependentField,variable_type,FIELD_ANALYTIC_VALUES_SET_TYPE,err,error,*999) - DO component_idx=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS - BOUND_COUNT=0 - IF(FIELD_VARIABLE%COMPONENTS(component_idx)%INTERPOLATION_TYPE==FIELD_NODE_BASED_INTERPOLATION) THEN - DOMAIN=>FIELD_VARIABLE%COMPONENTS(component_idx)%DOMAIN - IF(ASSOCIATED(DOMAIN)) THEN - IF(ASSOCIATED(DOMAIN%TOPOLOGY)) THEN - DOMAIN_NODES=>DOMAIN%TOPOLOGY%NODES - IF(ASSOCIATED(DOMAIN_NODES)) THEN - !Loop over the local nodes excluding the ghosts. - DO node_idx=1,DOMAIN_NODES%NUMBER_OF_NODES - element_idx=DOMAIN%topology%nodes%nodes(node_idx)%surrounding_elements(1) - CALL FIELD_INTERPOLATION_PARAMETERS_ELEMENT_GET(FIELD_VALUES_SET_TYPE,element_idx, & - & INTERPOLATION_PARAMETERS(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - en_idx=0 - XI_COORDINATES=0.0_DP - number_of_nodes_xic(1)=DOMAIN%topology%elements%elements(element_idx)%basis%number_of_nodes_xic(1) - number_of_nodes_xic(2)=DOMAIN%topology%elements%elements(element_idx)%basis%number_of_nodes_xic(2) - IF(NUMBER_OF_DIMENSIONS==3) THEN - number_of_nodes_xic(3)=DOMAIN%topology%elements%elements(element_idx)%basis%number_of_nodes_xic(3) - ELSE - number_of_nodes_xic(3)=1 - ENDIF - !\todo: Use boundary flag - IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==4.AND.NUMBER_OF_DIMENSIONS==2 .OR. & - & DOMAIN%topology%elements%maximum_number_of_element_parameters==9.OR. & - & DOMAIN%topology%elements%maximum_number_of_element_parameters==16.OR. & - & DOMAIN%topology%elements%maximum_number_of_element_parameters==8.OR. & - & DOMAIN%topology%elements%maximum_number_of_element_parameters==27.OR. & - & DOMAIN%topology%elements%maximum_number_of_element_parameters==64) THEN - DO K=1,number_of_nodes_xic(3) - DO J=1,number_of_nodes_xic(2) - DO I=1,number_of_nodes_xic(1) - en_idx=en_idx+1 - IF(DOMAIN%topology%elements%elements(element_idx)%element_nodes(en_idx)==node_idx) EXIT - XI_COORDINATES(1)=XI_COORDINATES(1)+(1.0_DP/(number_of_nodes_xic(1)-1)) - ENDDO - IF(DOMAIN%topology%elements%elements(element_idx)%element_nodes(en_idx)==node_idx) EXIT - XI_COORDINATES(1)=0.0_DP - XI_COORDINATES(2)=XI_COORDINATES(2)+(1.0_DP/(number_of_nodes_xic(2)-1)) - ENDDO - IF(DOMAIN%topology%elements%elements(element_idx)%element_nodes(en_idx)==node_idx) EXIT - XI_COORDINATES(1)=0.0_DP - XI_COORDINATES(2)=0.0_DP - IF(number_of_nodes_xic(3)/=1) THEN - XI_COORDINATES(3)=XI_COORDINATES(3)+(1.0_DP/(number_of_nodes_xic(3)-1)) - ENDIF - ENDDO - CALL FIELD_INTERPOLATE_XI(NO_PART_DERIV,XI_COORDINATES, & - & INTERPOLATED_POINT(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - ELSE - !\todo: Use boundary flag - IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==3) THEN - T_COORDINATES(1,1:2)=[0.0_DP,1.0_DP] - T_COORDINATES(2,1:2)=[1.0_DP,0.0_DP] - T_COORDINATES(3,1:2)=[1.0_DP,1.0_DP] - ELSE IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==6) THEN - T_COORDINATES(1,1:2)=[0.0_DP,1.0_DP] - T_COORDINATES(2,1:2)=[1.0_DP,0.0_DP] - T_COORDINATES(3,1:2)=[1.0_DP,1.0_DP] - T_COORDINATES(4,1:2)=[0.5_DP,0.5_DP] - T_COORDINATES(5,1:2)=[1.0_DP,0.5_DP] - T_COORDINATES(6,1:2)=[0.5_DP,1.0_DP] - ELSE IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==10.AND. & - & NUMBER_OF_DIMENSIONS==2) THEN - T_COORDINATES(1,1:2)=[0.0_DP,1.0_DP] - T_COORDINATES(2,1:2)=[1.0_DP,0.0_DP] - T_COORDINATES(3,1:2)=[1.0_DP,1.0_DP] - T_COORDINATES(4,1:2)=[1.0_DP/3.0_DP,2.0_DP/3.0_DP] - T_COORDINATES(5,1:2)=[2.0_DP/3.0_DP,1.0_DP/3.0_DP] - T_COORDINATES(6,1:2)=[1.0_DP,1.0_DP/3.0_DP] - T_COORDINATES(7,1:2)=[1.0_DP,2.0_DP/3.0_DP] - T_COORDINATES(8,1:2)=[2.0_DP/3.0_DP,1.0_DP] - T_COORDINATES(9,1:2)=[1.0_DP/3.0_DP,1.0_DP] - T_COORDINATES(10,1:2)=[2.0_DP/3.0_DP,2.0_DP/3.0_DP] - ELSE IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==4) THEN - T_COORDINATES(1,1:3)=[0.0_DP,1.0_DP,1.0_DP] - T_COORDINATES(2,1:3)=[1.0_DP,0.0_DP,1.0_DP] - T_COORDINATES(3,1:3)=[1.0_DP,1.0_DP,0.0_DP] - T_COORDINATES(4,1:3)=[1.0_DP,1.0_DP,1.0_DP] - ELSE IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==10.AND. & - & NUMBER_OF_DIMENSIONS==3) THEN - T_COORDINATES(1,1:3)=[0.0_DP,1.0_DP,1.0_DP] - T_COORDINATES(2,1:3)=[1.0_DP,0.0_DP,1.0_DP] - T_COORDINATES(3,1:3)=[1.0_DP,1.0_DP,0.0_DP] - T_COORDINATES(4,1:3)=[1.0_DP,1.0_DP,1.0_DP] - T_COORDINATES(5,1:3)=[0.5_DP,0.5_DP,1.0_DP] - T_COORDINATES(6,1:3)=[0.5_DP,1.0_DP,0.5_DP] - T_COORDINATES(7,1:3)=[0.5_DP,1.0_DP,1.0_DP] - T_COORDINATES(8,1:3)=[1.0_DP,0.5_DP,0.5_DP] - T_COORDINATES(9,1:3)=[1.0_DP,1.0_DP,0.5_DP] - T_COORDINATES(10,1:3)=[1.0_DP,0.5_DP,1.0_DP] - ELSE IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==20) THEN - T_COORDINATES(1,1:3)=[0.0_DP,1.0_DP,1.0_DP] - T_COORDINATES(2,1:3)=[1.0_DP,0.0_DP,1.0_DP] - T_COORDINATES(3,1:3)=[1.0_DP,1.0_DP,0.0_DP] - T_COORDINATES(4,1:3)=[1.0_DP,1.0_DP,1.0_DP] - T_COORDINATES(5,1:3)=[1.0_DP/3.0_DP,2.0_DP/3.0_DP,1.0_DP] - T_COORDINATES(6,1:3)=[2.0_DP/3.0_DP,1.0_DP/3.0_DP,1.0_DP] - T_COORDINATES(7,1:3)=[1.0_DP/3.0_DP,1.0_DP,2.0_DP/3.0_DP] - T_COORDINATES(8,1:3)=[2.0_DP/3.0_DP,1.0_DP,1.0_DP/3.0_DP] - T_COORDINATES(9,1:3)=[1.0_DP/3.0_DP,1.0_DP,1.0_DP] - T_COORDINATES(10,1:3)=[2.0_DP/3.0_DP,1.0_DP,1.0_DP] - T_COORDINATES(11,1:3)=[1.0_DP,1.0_DP/3.0_DP,2.0_DP/3.0_DP] - T_COORDINATES(12,1:3)=[1.0_DP,2.0_DP/3.0_DP,1.0_DP/3.0_DP] - T_COORDINATES(13,1:3)=[1.0_DP,1.0_DP,1.0_DP/3.0_DP] - T_COORDINATES(14,1:3)=[1.0_DP,1.0_DP,2.0_DP/3.0_DP] - T_COORDINATES(15,1:3)=[1.0_DP,1.0_DP/3.0_DP,1.0_DP] - T_COORDINATES(16,1:3)=[1.0_DP,2.0_DP/3.0_DP,1.0_DP] - T_COORDINATES(17,1:3)=[2.0_DP/3.0_DP,2.0_DP/3.0_DP,2.0_DP/3.0_DP] - T_COORDINATES(18,1:3)=[2.0_DP/3.0_DP,2.0_DP/3.0_DP,1.0_DP] - T_COORDINATES(19,1:3)=[2.0_DP/3.0_DP,1.0_DP,2.0_DP/3.0_DP] - T_COORDINATES(20,1:3)=[1.0_DP,2.0_DP/3.0_DP,2.0_DP/3.0_DP] - ENDIF - DO K=1,DOMAIN%topology%elements%maximum_number_of_element_parameters - IF(DOMAIN%topology%elements%elements(element_idx)%element_nodes(K)==node_idx) EXIT - ENDDO - IF(NUMBER_OF_DIMENSIONS==2) THEN - CALL FIELD_INTERPOLATE_XI(NO_PART_DERIV,T_COORDINATES(K,1:2), & - & INTERPOLATED_POINT(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - ELSE IF(NUMBER_OF_DIMENSIONS==3) THEN - CALL FIELD_INTERPOLATE_XI(NO_PART_DERIV,T_COORDINATES(K,1:3), & - & INTERPOLATED_POINT(FIELD_U_VARIABLE_TYPE)%ptr,err,error,*999) - ENDIF - ENDIF - X=0.0_DP - DO dim_idx=1,NUMBER_OF_DIMENSIONS - X(dim_idx)=INTERPOLATED_POINT(FIELD_U_VARIABLE_TYPE)%ptr%VALUES(dim_idx,1) - ENDDO !dim_idx - - !Loop over the derivatives - DO deriv_idx=1,DOMAIN_NODES%NODES(node_idx)%NUMBER_OF_DERIVATIVES - ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE - GLOBAL_DERIV_INDEX=DOMAIN_NODES%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX - CURRENT_TIME=0.0_DP - materialsField=>EQUATIONS_SET%MATERIALS%MATERIALS_FIELD - !Define MU_PARAM, density=1 - MU_PARAM=materialsField%variables(1)%parameter_sets%parameter_sets(1)%ptr% & - & parameters%cmiss%data_dp(1) - !Define RHO_PARAM, density=2 - IF(ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_4.OR. & - & ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_5.OR. & - & ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_4.OR. & - & ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_5) THEN - RHO_PARAM=materialsField%variables(1)%parameter_sets%parameter_sets(1)%ptr% & - & parameters%cmiss%data_dp(2) - ELSE - RHO_PARAM=0.0_DP - ENDIF - CALL STOKES_EQUATION_ANALYTIC_FUNCTIONS(VALUE,X,MU_PARAM,RHO_PARAM,CURRENT_TIME,variable_type, & - & GLOBAL_DERIV_INDEX,ANALYTIC_FUNCTION_TYPE,NUMBER_OF_DIMENSIONS, & - & FIELD_VARIABLE%NUMBER_OF_COMPONENTS,component_idx,err,error,*999) - !Default to version 1 of each node derivative - local_ny=FIELD_VARIABLE%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% & - & NODE_PARAM2DOF_MAP%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1) - CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(dependentField,variable_type, & - & FIELD_ANALYTIC_VALUES_SET_TYPE,local_ny,VALUE,err,error,*999) - IF(variable_type==FIELD_U_VARIABLE_TYPE) THEN - ! \todo: This part should work even for simplex elements as soon as adjacent element calculation has been fixed - IF(DOMAIN_NODES%NODES(node_idx)%BOUNDARY_NODE) THEN - !If we are a boundary node then set the analytic value on the boundary - IF(component_idx<=NUMBER_OF_DIMENSIONS) THEN - CALL BOUNDARY_CONDITIONS_SET_LOCAL_DOF(BOUNDARY_CONDITIONS,dependentField,variable_type, & - & local_ny,BOUNDARY_CONDITION_FIXED,VALUE,err,error,*999) - BOUND_COUNT=BOUND_COUNT+1 - ELSE - ! \todo: This is just a workaround for linear pressure fields in simplex element components - IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==3) THEN - IF(ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_1.OR. & - & ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_2.OR. & - & ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_3.OR. & - & ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_4.OR. & - & ANALYTIC_FUNCTION_TYPE==EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_5) THEN - IF(-0.001_DPBOUNDARY_X(1,1)-BOUNDARY_TOLERANCE.OR. & - ! ! ! & X(1)BOUNDARY_X(1,2)-BOUNDARY_TOLERANCE.OR. & - ! ! ! & X(2)BOUNDARY_X(2,1)-BOUNDARY_TOLERANCE.OR. & - ! ! ! & X(2)BOUNDARY_X(2,2)-BOUNDARY_TOLERANCE) THEN - ! ! ! IF(component_idx<=NUMBER_OF_DIMENSIONS) THEN - ! ! ! CALL BOUNDARY_CONDITIONS_SET_LOCAL_DOF(BOUNDARY_CONDITIONS,variable_type,local_ny, & - ! ! ! & BOUNDARY_CONDITION_FIXED,VALUE,err,error,*999) - ! ! ! BOUND_COUNT=BOUND_COUNT+1 - ! ! ! !Apply boundary conditions check for pressure nodes - ! ! ! ELSE IF(component_idx>NUMBER_OF_DIMENSIONS) THEN - ! ! ! IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==4) THEN - ! ! ! IF(X(1)BOUNDARY_X(1,1)-BOUNDARY_TOLERANCE.AND. & - ! ! ! & X(2)BOUNDARY_X(2,1)-BOUNDARY_TOLERANCE) & - ! ! ! & THEN - ! ! ! ! Commented out for testing purposes - ! ! ! CALL BOUNDARY_CONDITIONS_SET_LOCAL_DOF(BOUNDARY_CONDITIONS,variable_type,local_ny, & - ! ! ! & BOUNDARY_CONDITION_FIXED,VALUE,err,error,*999) - ! ! ! BOUND_COUNT=BOUND_COUNT+1 - ! ! ! ENDIF - ! ! ! ENDIF - ! ! ! !\todo: Again, ... - ! ! ! IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==3.OR. & - ! ! ! & DOMAIN%topology%elements%maximum_number_of_element_parameters==6.OR. & - ! ! ! & DOMAIN%topology%elements%maximum_number_of_element_parameters==10) THEN - ! ! ! IF(X(1)BOUNDARY_X(1,1)-BOUNDARY_TOLERANCE.AND. & - ! ! ! & X(2)BOUNDARY_X(2,1)-BOUNDARY_TOLERANCE.OR. & - ! ! ! & X(1)BOUNDARY_X(1,1)-BOUNDARY_TOLERANCE.AND.& - ! ! ! & X(2)BOUNDARY_X(2,2)-BOUNDARY_TOLERANCE.OR. & - ! ! ! & X(1)BOUNDARY_X(1,2)-BOUNDARY_TOLERANCE.AND.& - ! ! ! & X(2)BOUNDARY_X(2,1)-BOUNDARY_TOLERANCE.OR. & - ! ! ! & X(1)BOUNDARY_X(1,2)-BOUNDARY_TOLERANCE.AND.& - ! ! ! & X(2)BOUNDARY_X(2,2)-BOUNDARY_TOLERANCE) & - ! ! ! & THEN - ! ! ! CALL BOUNDARY_CONDITIONS_SET_LOCAL_DOF(BOUNDARY_CONDITIONS,variable_type,local_ny, & - ! ! ! & BOUNDARY_CONDITION_FIXED,VALUE,err,error,*999) - ! ! ! BOUND_COUNT=BOUND_COUNT+1 - ! ! ! ENDIF - ! ! ! ENDIF - ! ! ! ENDIF - ! ! ! ENDIF - ! ! ! IF(component_idx<=NUMBER_OF_DIMENSIONS+1) THEN - ! ! ! CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(dependentField,variable_type, & - ! ! ! & FIELD_VALUES_SET_TYPE,local_ny,VALUE,err,error,*999) - ! ! ! ENDIF - ! ! ! ELSE IF(NUMBER_OF_DIMENSIONS==3) THEN - ! ! ! IF(X(1)BOUNDARY_X(1,1)-BOUNDARY_TOLERANCE.OR. & - ! ! ! & X(1)BOUNDARY_X(1,2)-BOUNDARY_TOLERANCE.OR. & - ! ! ! & X(2)BOUNDARY_X(2,1)-BOUNDARY_TOLERANCE.OR. & - ! ! ! & X(2)BOUNDARY_X(2,2)-BOUNDARY_TOLERANCE.OR. & - ! ! ! & X(3)BOUNDARY_X(3,1)-BOUNDARY_TOLERANCE.OR. & - ! ! ! & X(3)BOUNDARY_X(3,2)-BOUNDARY_TOLERANCE) THEN - ! ! ! IF(component_idx<=NUMBER_OF_DIMENSIONS) THEN - ! ! ! CALL BOUNDARY_CONDITIONS_SET_LOCAL_DOF(BOUNDARY_CONDITIONS,variable_type,local_ny, & - ! ! ! & BOUNDARY_CONDITION_FIXED,VALUE,err,error,*999) - ! ! ! BOUND_COUNT=BOUND_COUNT+1 - ! ! ! !Apply boundary conditions check for pressure nodes - ! ! ! ELSE IF(component_idx>NUMBER_OF_DIMENSIONS) THEN - ! ! ! IF(DOMAIN%topology%elements%maximum_number_of_element_parameters==4.OR. & - ! ! ! & DOMAIN%topology%elements%maximum_number_of_element_parameters==10.OR. & - ! ! ! & DOMAIN%topology%elements%maximum_number_of_element_parameters==20) THEN - ! ! ! IF(X(1)BOUNDARY_X(1,1)-BOUNDARY_TOLERANCE.AND. & - ! ! ! & X(2)BOUNDARY_X(2,1)-BOUNDARY_TOLERANCE.AND. & - ! ! ! & X(3)BOUNDARY_X(3,1)-BOUNDARY_TOLERANCE.OR. & - ! ! ! & X(1)BOUNDARY_X(1,1)-BOUNDARY_TOLERANCE.AND. & - ! ! ! & X(2)BOUNDARY_X(2,1)-BOUNDARY_TOLERANCE.AND. & - ! ! ! & X(3)BOUNDARY_X(3,2)-BOUNDARY_TOLERANCE.OR. & - ! ! ! & X(1)BOUNDARY_X(1,1)-BOUNDARY_TOLERANCE.AND. & - ! ! ! & X(2)BOUNDARY_X(2,2)-BOUNDARY_TOLERANCE.AND. & - ! ! ! & X(3)BOUNDARY_X(3,1)-BOUNDARY_TOLERANCE.OR. & - ! ! ! & X(1)BOUNDARY_X(1,1)-BOUNDARY_TOLERANCE.AND. & - ! ! ! & X(2)BOUNDARY_X(2,2)-BOUNDARY_TOLERANCE.AND. & - ! ! ! & X(3)BOUNDARY_X(3,2)-BOUNDARY_TOLERANCE.OR. & - ! ! ! & X(1)BOUNDARY_X(1,2)-BOUNDARY_TOLERANCE.AND. & - ! ! ! & X(2)BOUNDARY_X(2,1)-BOUNDARY_TOLERANCE.AND. & - ! ! ! & X(3)BOUNDARY_X(3,1)-BOUNDARY_TOLERANCE.OR. & - ! ! ! & X(1)BOUNDARY_X(1,2)-BOUNDARY_TOLERANCE.AND. & - ! ! ! & X(2)BOUNDARY_X(2,1)-BOUNDARY_TOLERANCE.AND. & - ! ! ! & X(3)BOUNDARY_X(3,2)-BOUNDARY_TOLERANCE.OR. & - ! ! ! & X(1)BOUNDARY_X(1,2)-BOUNDARY_TOLERANCE.AND. & - ! ! ! & X(2)BOUNDARY_X(2,2)-BOUNDARY_TOLERANCE.AND. & - ! ! ! & X(3)BOUNDARY_X(3,1)-BOUNDARY_TOLERANCE.OR. & - ! ! ! & X(1)BOUNDARY_X(1,2)-BOUNDARY_TOLERANCE.AND. & - ! ! ! & X(2)BOUNDARY_X(2,2)-BOUNDARY_TOLERANCE.AND. & - ! ! ! & X(3)BOUNDARY_X(3,2)-BOUNDARY_TOLERANCE) THEN - ! ! ! CALL BOUNDARY_CONDITIONS_SET_LOCAL_DOF(BOUNDARY_CONDITIONS,variable_type,local_ny, & - ! ! ! & BOUNDARY_CONDITION_FIXED,VALUE,err,error,*999) - ! ! ! BOUND_COUNT=BOUND_COUNT+1 - ! ! ! ENDIF - ! ! ! ENDIF - ! ! ! ENDIF - ! ! ! ELSE - ! ! ! IF(component_idx<=NUMBER_OF_DIMENSIONS+1) THEN - ! ! ! CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(dependentField,variable_type, & - ! ! ! & FIELD_VALUES_SET_TYPE,local_ny,VALUE,err,error,*999) - ! ! ! ENDIF - ! ! ! ENDIF - ! ! ! ENDIF - ENDIF - ENDDO !deriv_idx - ENDDO !node_idx - ELSE - CALL FlagError("Domain topology nodes is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Domain topology is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Domain is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Only node based interpolation is implemented.",err,error,*999) - ENDIF - ENDDO !component_idx - CALL FIELD_PARAMETER_SET_UPDATE_START(dependentField,variable_type,FIELD_ANALYTIC_VALUES_SET_TYPE, & - & err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(dependentField,variable_type,FIELD_ANALYTIC_VALUES_SET_TYPE, & - & err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_START(dependentField,variable_type,FIELD_VALUES_SET_TYPE, & - & err,error,*999) - CALL FIELD_PARAMETER_SET_UPDATE_FINISH(dependentField,variable_type,FIELD_VALUES_SET_TYPE, & - & err,error,*999) - ELSE - CALL FlagError("Field variable is not associated.",err,error,*999) - ENDIF - ENDDO !variable_idx - CALL FIELD_PARAMETER_SET_DATA_RESTORE(geometricField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, & - & GEOMETRIC_PARAMETERS,err,error,*999) - CALL FIELD_INTERPOLATED_POINTS_FINALISE(INTERPOLATED_POINT,err,error,*999) - CALL FIELD_INTERPOLATION_PARAMETERS_FINALISE(INTERPOLATION_PARAMETERS,err,error,*999) - ELSE - CALL FlagError("Boundary conditions is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set geometric field is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set dependent field is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set analytic is not associated.",err,error,*999) - ENDIF - ELSE - CALL FlagError("Equations set is not associated.",err,error,*999) - ENDIF - - EXITS("Stokes_BoundaryConditionsAnalyticCalculate") - RETURN -999 ERRORSEXITS("Stokes_BoundaryConditionsAnalyticCalculate",err,error) - RETURN 1 - END SUBROUTINE Stokes_BoundaryConditionsAnalyticCalculate - - ! - !================================================================================================================================ - ! - !>Calculates the various analytic solutions given X and time, can be called from within analytic calculate or elsewhere if needed - SUBROUTINE STOKES_EQUATION_ANALYTIC_FUNCTIONS(VALUE,X,MU_PARAM,RHO_PARAM,CURRENT_TIME,VARIABLE_TYPE, & - & GLOBAL_DERIV_INDEX,ANALYTIC_FUNCTION_TYPE,NUMBER_OF_DIMENSIONS,NUMBER_OF_COMPONENTS,COMPONENT_IDX,err,error,*) - - !Argument variables - INTEGER(INTG), INTENT(OUT) :: ERR !