/LinearElasticity/3DExtensionLagrangeBasis/src/3DExtensionLagrangeBasisExample.f90
http://github.com/xyan075/examples · Fortran Modern · 518 lines · 329 code · 73 blank · 116 comment · 0 complexity · 6aa9d51076fe508c4f69f9c9d8c2e8f0 MD5 · raw file
- ! \file
- !> \author Chris Bradley
- !> \brief This is an example program to solve a linear elasticity equation using openCMISS calls.
- !>
- !> \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 and University of Oxford, Oxford, United
- !> Kingdom. Portions created by the University of Auckland and University
- !> of Oxford are Copyright (C) 2007 by the University of Auckland and
- !> the University of Oxford. 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.
- !>
- !> \example LinearElasticity/src/LinearElasticityExample.f90
- !! Example program to solve a linear elasticity equation using openCMISS calls.
- !<
- !> Main program
- PROGRAM LinearElasticity3DLagrangeBasis
- USE MPI
- USE OPENCMISS
- #ifdef WIN32
- USE IFQWIN
- #endif
- IMPLICIT NONE
- INTEGER(CMISSIntg), PARAMETER :: EquationsSetFieldUserNumber=1337
- TYPE(CMISSFieldType) :: EquationsSetField
- !Test program parameters
- REAL(CMISSDP), PARAMETER :: LENGTH=120.0_CMISSDP
- REAL(CMISSDP), PARAMETER :: WIDTH=160.0_CMISSDP
- REAL(CMISSDP), PARAMETER :: HEIGHT=10.0_CMISSDP
- INTEGER(CMISSIntg), PARAMETER :: CoordinateSystemUserNumber=1
- INTEGER(CMISSIntg), PARAMETER :: NumberOfSpatialCoordinates=3
- INTEGER(CMISSIntg), PARAMETER :: RegionUserNumber=1
- INTEGER(CMISSIntg), PARAMETER :: Basis1UserNumber=1
- INTEGER(CMISSIntg), PARAMETER :: Basis2UserNumber=2
- INTEGER(CMISSIntg), PARAMETER :: Basis3UserNumber=3
- INTEGER(CMISSIntg), PARAMETER :: MeshUserNumber=1
- INTEGER(CMISSIntg), PARAMETER :: DecompositionUserNumber=1
- INTEGER(CMISSIntg), PARAMETER :: NumberOfXiCoordinates=3
- INTEGER(CMISSIntg), PARAMETER :: TotalNumberOfNodes=8
- INTEGER(CMISSIntg), PARAMETER :: NumberOfMeshDimensions=3
- INTEGER(CMISSIntg), PARAMETER :: NumberOfMeshComponents=3
- INTEGER(CMISSIntg), PARAMETER :: TotalNumberOfElements=1
- INTEGER(CMISSIntg), PARAMETER :: MeshComponent1UserNumber=1
- INTEGER(CMISSIntg), PARAMETER :: MeshComponent2UserNumber=2
- INTEGER(CMISSIntg), PARAMETER :: MeshComponent3UserNumber=3
- INTEGER(CMISSIntg), PARAMETER :: FieldGeometryUserNumber=1
- INTEGER(CMISSIntg), PARAMETER :: FieldGeometryNumberOfVariables=1
- INTEGER(CMISSIntg), PARAMETER :: FieldGeometryNumberOfComponents=3
- INTEGER(CMISSIntg), PARAMETER :: FieldDependentUserNumber=2
- INTEGER(CMISSIntg), PARAMETER :: FieldDependentNumberOfVariables=2
- INTEGER(CMISSIntg), PARAMETER :: FieldDependentNumberOfComponents=3
- INTEGER(CMISSIntg), PARAMETER :: FieldMaterialUserNumber=3
- INTEGER(CMISSIntg), PARAMETER :: FieldMaterialNumberOfVariables=1
- INTEGER(CMISSIntg), PARAMETER :: FieldMaterialNumberOfComponents=6
- INTEGER(CMISSIntg), PARAMETER :: EquationSetUserNumber=1
- INTEGER(CMISSIntg), PARAMETER :: ProblemUserNumber=1
- REAL(CMISSDP), PARAMETER :: ZERO = 0.0_CMISSDP
- !Program types
- !Program variables
- INTEGER(CMISSIntg) :: NumberGlobalXElements,NumberGlobalYElements,NumberGlobalZElements
- INTEGER(CMISSIntg) :: MPI_IERROR
- INTEGER(CMISSIntg) :: EquationsSetIndex
- INTEGER(CMISSIntg) :: NumberOfComputationalNodes,NumberOfDomains,ComputationalNodeNumber
- LOGICAL :: EXPORT_FIELD
- !CMISS variables
- TYPE(CMISSRegionType) :: WorldRegion
- TYPE(CMISSCoordinateSystemType) :: WorldCoordinateSystem
- TYPE(CMISSBasisType) :: Basis(3)
- TYPE(CMISSBoundaryConditionsType) :: BoundaryConditions
- TYPE(CMISSCoordinateSystemType) :: CoordinateSystem
- TYPE(CMISSDecompositionType) :: Decomposition
- TYPE(CMISSEquationsType) :: Equations
- TYPE(CMISSEquationsSetType) :: EquationsSet
- TYPE(CMISSFieldType) :: GeometricField,DependentField,MaterialField
- TYPE(CMISSFieldsType) :: Fields
- TYPE(CMISSMeshType) :: Mesh
- TYPE(CMISSNodesType) :: Nodes
- TYPE(CMISSProblemType) :: Problem
- TYPE(CMISSRegionType) :: Region
- TYPE(CMISSSolverType) :: Solver
- TYPE(CMISSSolverEquationsType) :: SolverEquations
- TYPE(CMISSMeshElementsType) :: Elements(3)
- #ifdef WIN32
- !Quickwin type
- LOGICAL :: QUICKWIN_STATUS=.FALSE.
- TYPE(WINDOWCONFIG) :: QUICKWIN_WINDOW_CONFIG
- #endif
- !Generic CMISS variables
- INTEGER(CMISSIntg) :: Err
- #ifdef WIN32
- !Initialise QuickWin
- QUICKWIN_WINDOW_CONFIG%TITLE="General Output" !Window title
- QUICKWIN_WINDOW_CONFIG%NUMTEXTROWS=-1 !Max possible number of rows
- QUICKWIN_WINDOW_CONFIG%MODE=QWIN$SCROLLDOWN
- !Set the window parameters
- QUICKWIN_STATUS=SETWINDOWCONFIG(QUICKWIN_WINDOW_CONFIG)
- !If attempt fails set with system estimated values
- IF(.NOT.QUICKWIN_STATUS) QUICKWIN_STATUS=SETWINDOWCONFIG(QUICKWIN_WINDOW_CONFIG)
- #endif
- !Intialise cmiss
- CALL CMISSInitialise(WorldCoordinateSystem,WorldRegion,Err)
- CALL CMISSErrorHandlingModeSet(CMISS_ERRORS_TRAP_ERROR,Err)
- WRITE(*,'(A)') "Program starting."
- !Set all diganostic levels on for testing
- CALL CMISSDiagnosticsSetOn(CMISS_FROM_DIAG_TYPE,(/1,2,3,4,5/),"Diagnostics",(/"PROBLEM_FINITE_ELEMENT_CALCULATE"/),Err)
- !Get the number of computational nodes and this computational node number
- CALL CMISSComputationalNumberOfNodesGet(NumberOfComputationalNodes,Err)
- CALL CMISSComputationalNodeNumberGet(ComputationalNodeNumber,Err)
- NumberGlobalXElements=1
- NumberGlobalYElements=1
- NumberGlobalZElements=1
- NumberOfDomains=1
- !Broadcast the number of elements in the X,Y and Z directions and the number of partitions to the other computational 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)
- CALL MPI_BCAST(NumberOfDomains,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR)
- !Create a CS - default is 3D rectangular cartesian CS with 0,0,0 as origin
- CALL CMISSCoordinateSystem_Initialise(CoordinateSystem,Err)
- CALL CMISSCoordinateSystem_CreateStart(CoordinateSystemUserNumber,CoordinateSystem,Err)
- CALL CMISSCoordinateSystem_TypeSet(CoordinateSystem,CMISS_COORDINATE_RECTANGULAR_CARTESIAN_TYPE,Err)
- CALL CMISSCoordinateSystem_DimensionSet(CoordinateSystem,NumberOfSpatialCoordinates,Err)
- CALL CMISSCoordinateSystem_OriginSet(CoordinateSystem,(/0.0_CMISSDP,0.0_CMISSDP,0.0_CMISSDP/),Err)
- CALL CMISSCoordinateSystem_CreateFinish(CoordinateSystem,Err)
- !Create a region and assign the CS to the region
- CALL CMISSRegion_Initialise(Region,Err)
- CALL CMISSRegion_CreateStart(RegionUserNumber,WorldRegion,Region,Err)
- CALL CMISSRegion_CoordinateSystemSet(Region,CoordinateSystem,Err)
- CALL CMISSRegion_CreateFinish(Region,Err)
- !Define 3 sets of basis functions, one describing each independent coordinate specified by InterpolationType
- !NOTE if you change interpolation you need to change Boundary Conditions
- !NOTE:: Num of Gauss points must be the same across X,Y & Z coordinates and be sufficient to accurately integrate the hightest order interpolation being used
- CALL CMISSBasis_Initialise(Basis(1),Err)
- CALL CMISSBasis_CreateStart(Basis1UserNumber,Basis(1),Err)
- CALL CMISSBasis_TypeSet(Basis(1),CMISS_BASIS_LAGRANGE_HERMITE_TP_TYPE,Err)
- CALL CMISSBasis_NumberOfXiSet(Basis(1),NumberOfXiCoordinates,Err)
- CALL CMISSBasis_InterpolationXiSet(Basis(1),(/CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION, &
- & CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION,CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION/),Err)
- CALL CMISSBasis_QuadratureNumberOfGaussXiSet(Basis(1), &
- & (/CMISS_BASIS_MID_QUADRATURE_SCHEME,CMISS_BASIS_MID_QUADRATURE_SCHEME,CMISS_BASIS_MID_QUADRATURE_SCHEME/),Err)
- CALL CMISSBasis_CreateFinish(Basis(1),Err)
- CALL CMISSBasis_Initialise(Basis(2),Err)
- CALL CMISSBasis_CreateStart(Basis2UserNumber,Basis(2),Err)
- CALL CMISSBasis_TypeSet(Basis(2),CMISS_BASIS_LAGRANGE_HERMITE_TP_TYPE,Err)
- CALL CMISSBasis_NumberOfXiSet(Basis(2),NumberOfXiCoordinates,Err)
- CALL CMISSBasis_InterpolationXiSet(Basis(2),(/CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION, &
- & CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION,CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION/),Err)
- CALL CMISSBasis_QuadratureNumberOfGaussXiSet(Basis(2), &
- & (/CMISS_BASIS_MID_QUADRATURE_SCHEME,CMISS_BASIS_MID_QUADRATURE_SCHEME,CMISS_BASIS_MID_QUADRATURE_SCHEME/),Err)
- CALL CMISSBasis_CreateFinish(Basis(2),Err)
- CALL CMISSBasis_Initialise(Basis(3),Err)
- CALL CMISSBasis_CreateStart(Basis3UserNumber,Basis(3),Err)
- CALL CMISSBasis_TypeSet(Basis(3),CMISS_BASIS_LAGRANGE_HERMITE_TP_TYPE,Err)
- CALL CMISSBasis_NumberOfXiSet(Basis(3),NumberOfXiCoordinates,Err)
- CALL CMISSBasis_InterpolationXiSet(Basis(3),(/CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION, &
- & CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION,CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION/),Err)
- CALL CMISSBasis_QuadratureNumberOfGaussXiSet(Basis(3), &
- & (/CMISS_BASIS_MID_QUADRATURE_SCHEME,CMISS_BASIS_MID_QUADRATURE_SCHEME,CMISS_BASIS_MID_QUADRATURE_SCHEME/),Err)
- CALL CMISSBasis_CreateFinish(Basis(3),Err)
- !Create a mesh
- CALL CMISSMesh_Initialise(Mesh,Err)
- CALL CMISSMesh_CreateStart(MeshUserNumber,Region,NumberOfMeshDimensions,Mesh,Err)
- CALL CMISSMesh_NumberOfComponentsSet(Mesh,NumberOfMeshComponents,Err)
- CALL CMISSMesh_NumberOfElementsSet(Mesh,TotalNumberOfElements,Err)
- !Define nodes for the mesh
- CALL CMISSNodes_Initialise(Nodes,Err)
- CALL CMISSNodes_CreateStart(Region,TotalNumberOfNodes,Nodes,Err)
- CALL CMISSNodes_CreateFinish(Nodes,Err)
- !Create elements for the mesh
- !Mesh Component 1
- CALL CMISSMeshElements_Initialise(Elements(1),Err)
- CALL CMISSMeshElements_CreateStart(Mesh,MeshComponent1UserNumber,Basis(1),Elements(1),Err)
- CALL CMISSMeshElements_NodesSet(Elements(1),1,(/1,2,3,4,5,6,7,8/),Err)
- CALL CMISSMeshElements_CreateFinish(Elements(1),Err)
- !Mesh Component 2
- CALL CMISSMeshElements_Initialise(Elements(2),Err)
- CALL CMISSMeshElements_CreateStart(Mesh,MeshComponent2UserNumber,Basis(2),Elements(2),Err)
- CALL CMISSMeshElements_NodesSet(Elements(2),1,(/1,2,3,4,5,6,7,8/),Err)
- CALL CMISSMeshElements_CreateFinish(Elements(2),Err)
- !Mesh Component 3
- CALL CMISSMeshElements_Initialise(Elements(3),Err)
- CALL CMISSMeshElements_CreateStart(Mesh,MeshComponent3UserNumber,Basis(3),Elements(3),Err)
- CALL CMISSMeshElements_NodesSet(Elements(3),1,(/1,2,3,4,5,6,7,8/),Err)
- CALL CMISSMeshElements_CreateFinish(Elements(3),Err)
- CALL CMISSMesh_CreateFinish(Mesh,Err)
- !Create a decomposition
- CALL CMISSDecomposition_Initialise(Decomposition,Err)
- CALL CMISSDecomposition_CreateStart(DecompositionUserNumber,Mesh,Decomposition,Err)
- CALL CMISSDecomposition_TypeSet(Decomposition,CMISS_DECOMPOSITION_CALCULATED_TYPE,Err)
- CALL CMISSDecomposition_NumberOfDomainsSet(Decomposition,NumberOfDomains,Err)
- CALL CMISSDecomposition_CreateFinish(Decomposition,Err)
- !Create a field to put the geometry (defualt is geometry)
- CALL CMISSField_Initialise(GeometricField,Err)
- CALL CMISSField_CreateStart(FieldGeometryUserNumber,Region,GeometricField,Err)
- CALL CMISSField_MeshDecompositionSet(GeometricField,Decomposition,Err)
- CALL CMISSField_TypeSet(GeometricField,CMISS_FIELD_GEOMETRIC_TYPE,Err)
- CALL CMISSField_NumberOfVariablesSet(GeometricField,FieldGeometryNumberOfVariables,Err)
- CALL CMISSField_NumberOfComponentsSet(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,FieldGeometryNumberOfComponents,Err)
- CALL CMISSField_ComponentMeshComponentSet(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,Err)
- CALL CMISSField_ComponentMeshComponentSet(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,2,2,Err)
- CALL CMISSField_ComponentMeshComponentSet(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,3,3,Err)
- CALL CMISSField_CreateFinish(GeometricField,Err)
- !Set geometric node coordinates (x)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,1,1, &
- & 0.0_CMISSDP,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,2,1,LENGTH,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,3,1, &
- & 0.0_CMISSDP,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,4,1,LENGTH,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,5,1, &
- & 0.0_CMISSDP,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,6,1,LENGTH,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,7,1, &
- & 0.0_CMISSDP,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,8,1,LENGTH,Err)
- !Set geometric node coordinates (y)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,1,2, &
- & 0.0_CMISSDP,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,2,2, &
- & 0.0_CMISSDP,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,3,2,WIDTH,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,4,2,WIDTH,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,5,2, &
- & 0.0_CMISSDP,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,6,2, &
- & 0.0_CMISSDP,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,7,2,WIDTH,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,8,2,WIDTH,Err)
- !Set geometric node coordinates (z)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,1,3, &
- & 0.0_CMISSDP,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,2,3, &
- & 0.0_CMISSDP,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,3,3, &
- & 0.0_CMISSDP,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,4,3, &
- & 0.0_CMISSDP,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,5,3,HEIGHT,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,6,3,HEIGHT,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,7,3,HEIGHT,Err)
- CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,8,3,HEIGHT,Err)
- !Create a dependent field with two variables and three components
- CALL CMISSField_Initialise(DependentField,Err)
- CALL CMISSField_CreateStart(FieldDependentUserNumber,Region,DependentField,Err)
- CALL CMISSField_TypeSet(DependentField,CMISS_FIELD_GENERAL_TYPE,Err)
- CALL CMISSField_MeshDecompositionSet(DependentField,Decomposition,Err)
- CALL CMISSField_GeometricFieldSet(DependentField,GeometricField,Err)
- CALL CMISSField_DependentTypeSet(DependentField,CMISS_FIELD_DEPENDENT_TYPE,Err)
- CALL CMISSField_NumberOfVariablesSet(DependentField,FieldDependentNumberOfVariables,Err)
- CALL CMISSField_NumberOfComponentsSet(DependentField,CMISS_FIELD_U_VARIABLE_TYPE,FieldDependentNumberOfComponents,Err)
- CALL CMISSField_NumberOfComponentsSet(DependentField,CMISS_FIELD_DELUDELN_VARIABLE_TYPE,FieldDependentNumberOfComponents,Err)
- CALL CMISSField_ComponentMeshComponentSet(DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,Err)
- CALL CMISSField_ComponentMeshComponentSet(DependentField,CMISS_FIELD_U_VARIABLE_TYPE,2,2,Err)
- CALL CMISSField_ComponentMeshComponentSet(DependentField,CMISS_FIELD_U_VARIABLE_TYPE,3,3,Err)
- CALL CMISSField_ComponentMeshComponentSet(DependentField,CMISS_FIELD_DELUDELN_VARIABLE_TYPE,1,1,Err)
- CALL CMISSField_ComponentMeshComponentSet(DependentField,CMISS_FIELD_DELUDELN_VARIABLE_TYPE,2,2,Err)
- CALL CMISSField_ComponentMeshComponentSet(DependentField,CMISS_FIELD_DELUDELN_VARIABLE_TYPE,3,3,Err)
- CALL CMISSField_CreateFinish(DependentField,Err)
- !Create a material field and attach it to the geometric field
- CALL CMISSField_Initialise(MaterialField,Err)
- CALL CMISSField_CreateStart(FieldMaterialUserNumber,Region,MaterialField,Err)
- CALL CMISSField_TypeSet(MaterialField,CMISS_FIELD_MATERIAL_TYPE,Err)
- CALL CMISSField_MeshDecompositionSet(MaterialField,Decomposition,Err)
- CALL CMISSField_GeometricFieldSet(MaterialField,GeometricField,Err)
- CALL CMISSField_NumberOfVariablesSet(MaterialField,FieldMaterialNumberOfVariables,Err)
- CALL CMISSField_NumberOfComponentsSet(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,FieldMaterialNumberOfComponents,Err)
- CALL CMISSField_ComponentMeshComponentSet(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,Err)
- CALL CMISSField_ComponentMeshComponentSet(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,2,2,Err)
- CALL CMISSField_ComponentMeshComponentSet(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,3,3,Err)
- CALL CMISSField_CreateFinish(MaterialField,Err)
- !Set isotropic elasticity material parameters - Young's Modulus & Poisson's Ratio
- CALL CMISSField_ComponentValuesInitialise(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1, &
- & 10.0E3_CMISSDP, &
- & Err) !E1
- CALL CMISSField_ComponentValuesInitialise(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,2, &
- & 10.0E3_CMISSDP, &
- & Err) !E2
- CALL CMISSField_ComponentValuesInitialise(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,3, &
- & 10.0E3_CMISSDP, &
- & Err) !E3
- CALL CMISSField_ComponentValuesInitialise(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,4,0.3_CMISSDP, &
- & Err) !v13
- CALL CMISSField_ComponentValuesInitialise(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,5,0.3_CMISSDP, &
- & Err) !v23
- CALL CMISSField_ComponentValuesInitialise(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,6,0.3_CMISSDP, &
- & Err) !v12
- !Create a Elasticity Class, Linear Elasticity type, no subtype, EquationsSet
- CALL CMISSEquationsSet_Initialise(EquationsSet,Err)
- CALL CMISSField_Initialise(EquationsSetField,Err)
- CALL CMISSEquationsSet_CreateStart(EquationSetUserNumber,Region,GeometricField,CMISS_EQUATIONS_SET_ELASTICITY_CLASS, &
- & CMISS_EQUATIONS_SET_LINEAR_ELASTICITY_TYPE,CMISS_EQUATIONS_SET_THREE_DIMENSIONAL_SUBTYPE,EquationsSetFieldUserNumber, &
- & EquationsSetField,EquationsSet,Err)
-
- CALL CMISSEquationsSet_CreateFinish(EquationsSet,Err)
- CALL CMISSEquationsSet_DependentCreateStart(EquationsSet,FieldDependentUserNumber,DependentField,Err)
- CALL CMISSEquationsSet_DependentCreateFinish(EquationsSet,Err)
- CALL CMISSEquationsSet_MaterialsCreateStart(EquationsSet,FieldMaterialUserNumber,MaterialField,Err)
- CALL CMISSEquationsSet_MaterialsCreateFinish(EquationsSet,Err)
- !Create the equations set equations
- CALL CMISSEquations_Initialise(Equations,Err)
- CALL CMISSEquationsSet_EquationsCreateStart(EquationsSet,Equations,Err)
- CALL CMISSEquations_SparsityTypeSet(EQUATIONS,CMISS_EQUATIONS_SPARSE_MATRICES,Err)
- !CMISS_EQUATIONS_SPARSE_MATRICES=1 !<Use sparse matrices for the equations.
- !CMISS_EQUATIONS_FULL_MATRICES=2 !<Use fully populated matrices for the equations.
- CALL CMISSEquations_OutputTypeSet(EQUATIONS,CMISS_EQUATIONS_ELEMENT_MATRIX_OUTPUT,Err)
- !CMISS_EQUATIONS_NO_OUTPUT !<No output from the equations.
- !CMISS_EQUATIONS_TIMING_OUTPUT !<Timing information output.
- !CMISS_EQUATIONS_MATRIX_OUTPUT !<All below and equation matrices output.
- !CMISS_EQUATIONS_ELEMENT_MATRIX_OUTPUT !<All below and Element matrices output.
- CALL CMISSEquationsSet_EquationsCreateFinish(EquationsSet,Err)
-
- !Define the problem
- CALL CMISSProblem_Initialise(Problem,Err)
- CALL CMISSProblem_CreateStart(ProblemUserNumber,Problem,Err)
- CALL CMISSProblem_SpecificationSet(Problem,CMISS_PROBLEM_ELASTICITY_CLASS,CMISS_PROBLEM_LINEAR_ELASTICITY_TYPE, &
- & CMISS_PROBLEM_NO_SUBTYPE,Err)
- CALL CMISSProblem_CreateFinish(Problem,Err)
- !Create the problem control loop
- CALL CMISSProblem_ControlLoopCreateStart(Problem,Err)
- CALL CMISSProblem_ControlLoopCreateFinish(Problem,Err)
- !Start the creation of the Problem solvers
- !Create the problem solvers
- CALL CMISSSolver_Initialise(Solver,Err)
- CALL CMISSProblem_SolversCreateStart(Problem,Err)
- CALL CMISSProblem_SolverGet(Problem,CMISS_CONTROL_LOOP_NODE,1,Solver,Err)
- CALL CMISSSolver_OutputTypeSet(SOLVER,CMISS_SOLVER_MATRIX_OUTPUT,Err)
- !CMISS_SOLVER_NO_OUTPUT !<No output from the solver routines. \see OPENCMISS_SolverOutputTypes,OPENCMISS
- !CMISS_SOLVER_PROGRESS_OUTPUT !<Progress output from solver routines.
- !CMISS_SOLVER_TIMING_OUTPUT !<Timing output from the solver routines plus below.
- !CMISS_SOLVER_SOLVER_OUTPUT !<Solver specific output from the solver routines plus below.
- !CMISS_SOLVER_MATRIX_OUTPUT !<Solver matrices output from the solver routines plus below.
- CALL CMISSSolver_LibraryTypeSet(SOLVER,CMISS_SOLVER_PETSC_LIBRARY,Err)
- !CMISS_SOLVER_CMISS_LIBRARY !<CMISS (internal) solver library.
- !CMISS_SOLVER_PETSC_LIBRARY !<PETSc solver library.
- !CMISS_SOLVER_MUMPS_LIBRARY !<MUMPS solver library.
- !CMISS_SOLVER_SUPERLU_LIBRARY !<SuperLU solver library.
- !CMISS_SOLVER_SPOOLES_LIBRARY !<SPOOLES solver library.
- !CMISS_SOLVER_UMFPACK_LIBRARY !<UMFPACK solver library.
- !CMISS_SOLVER_LUSOL_LIBRARY !<LUSOL solver library.
- !CMISS_SOLVER_ESSL_LIBRARY !<ESSL solver library.
- !CMISS_SOLVER_LAPACK_LIBRARY !<LAPACK solver library.
- !CMISS_SOLVER_TAO_LIBRARY !<TAO solver library.
- !CMISS_SOLVER_HYPRE_LIBRARY !<Hypre solver library.
- CALL CMISSSolver_LinearTypeSet(SOLVER,CMISS_SOLVER_LINEAR_DIRECT_SOLVE_TYPE,Err)
- !CMISS_SOLVER_LINEAR_DIRECT_SOLVE_TYPE !<Direct linear solver type.
- !CMISS_SOLVER_LINEAR_ITERATIVE_SOLVE_TYPE !<Iterative linear solver type.
- CALL CMISSProblem_SolversCreateFinish(Problem,Err)
- !Create the problem solver equations
- CALL CMISSSolver_Initialise(Solver,Err)
- CALL CMISSSolverEquations_Initialise(SolverEquations,Err)
- CALL CMISSProblem_SolverEquationsCreateStart(Problem,Err)
- CALL CMISSProblem_SolverGet(Problem,CMISS_CONTROL_LOOP_NODE,1,Solver,Err)
- CALL CMISSSolver_SolverEquationsGet(Solver,SolverEquations,Err)
- CALL CMISSSolverEquations_SparsityTypeSet(SolverEquations,CMISS_SOLVER_SPARSE_MATRICES,Err)
- !CMISS_SOLVER_SPARSE_MATRICES !<Use sparse solver matrices.
- !CMISS_SOLVER_FULL_MATRICES !<Use fully populated solver matrices.
- CALL CMISSSolverEquations_EquationsSetAdd(SolverEquations,EquationsSet,EquationsSetIndex,Err)
- CALL CMISSProblem_SolverEquationsCreateFinish(Problem,Err)
- !Prescribe boundary conditions
- CALL CMISSBoundaryConditions_Initialise(BoundaryConditions,Err)
- CALL CMISSSolverEquations_BoundaryConditionsCreateStart(SolverEquations,BoundaryConditions,Err)
- !Fix nodes 1,3,5,7 at x=0
- CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,1,1, &
- & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
- CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,3,1, &
- & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
- CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,5,1, &
- & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
- CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,7,1, &
- & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
- !Fix nodes 1,2,5,6 at y=0
- CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,1,2, &
- & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
- CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,2,2, &
- & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
- CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,5,2, &
- & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
- CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,6,2, &
- & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
- !Fix nodes 1,2,3,4 at x=0
- CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,1,3, &
- & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
- CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,2,3, &
- & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
- CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,3,3, &
- & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
- CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,4,3, &
- & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
- !Apply force at nodes 1,2,3,4 at x=l
- CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_DELUDELN_VARIABLE_TYPE,1,1,2,1, &
- & CMISS_BOUNDARY_CONDITION_FIXED, &
- & -400.0_CMISSDP,Err)
- CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_DELUDELN_VARIABLE_TYPE,1,1,4,1, &
- & CMISS_BOUNDARY_CONDITION_FIXED, &
- & -400.0_CMISSDP,Err)
- CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_DELUDELN_VARIABLE_TYPE,1,1,6,1, &
- & CMISS_BOUNDARY_CONDITION_FIXED, &
- & -400.0_CMISSDP,Err)
- CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_DELUDELN_VARIABLE_TYPE,1,1,8,1, &
- & CMISS_BOUNDARY_CONDITION_FIXED, &
- & -400.0_CMISSDP,Err)
- CALL CMISSSolverEquations_BoundaryConditionsCreateFinish(SolverEquations,Err)
- !=SOLVE Problem==================================================================================================================
- !Solve the Problem
- CALL CMISSProblem_Solve(Problem,Err)
- !=OUTPUT SOLUTION================================================================================================================
- !!TODO:: Output reaction forces in ipnode files
- EXPORT_FIELD=.TRUE.
- IF(EXPORT_FIELD) THEN
- CALL CMISSFields_Initialise(Fields,Err)
- CALL CMISSFields_Create(Region,Fields,Err)
- CALL CMISSFields_NodesExport(Fields,"LinearElasticity3DLinearLagrangeBasisExample","FORTRAN",Err)
- CALL CMISSFields_ElementsExport(Fields,"LinearElasticity3DLinearLagrangeBasisExample","FORTRAN",Err)
- CALL CMISSFields_Finalise(Fields,Err)
- ENDIF
- CALL CMISSFinalise(Err)
- WRITE(*,'(A)') "Program successfully completed."
-
- STOP
- END PROGRAM LinearElasticity3DLagrangeBasis