PageRenderTime 47ms CodeModel.GetById 2ms app.highlight 39ms RepoModel.GetById 1ms app.codeStats 0ms

/LinearElasticity/Analytic/Extension/src/ExtensionExample.f90

http://github.com/xyan075/examples
FORTRAN Modern | 503 lines | 287 code | 87 blank | 129 comment | 3 complexity | cd3ef852112b4b8dff5682e77e4e09c1 MD5 | raw file
  1!> \file
  2!> \author Chris Bradley
  3!> \brief This is an example program to solve an Analytic Laplace equation using OpenCMISS calls.
  4!>
  5!> \section LICENSE
  6!>
  7!> Version: MPL 1.1/GPL 2.0/LGPL 2.1
  8!>
  9!> The contents of this file are subject to the Mozilla Public License
 10!> Version 1.1 (the "License"); you may not use this file except in
 11!> compliance with the License. You may obtain a copy of the License at
 12!> http://www.mozilla.org/MPL/
 13!>
 14!> Software distributed under the License is distributed on an "AS IS"
 15!> basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
 16!> License for the specific language governing rights and limitations
 17!> under the License.
 18!>
 19!> The Original Code is OpenCMISS
 20!>
 21!> The Initial Developer of the Original Code is University of Auckland,
 22!> Auckland, New Zealand and University of Oxford, Oxford, United
 23!> Kingdom. Portions created by the University of Auckland and University
 24!> of Oxford are Copyright (C) 2007 by the University of Auckland and
 25!> the University of Oxford. All Rights Reserved.
 26!>
 27!> Contributor(s):
 28!>
 29!> Alternatively, the contents of this file may be used under the terms of
 30!> either the GNU General Public License Version 2 or later (the "GPL"), or
 31!> the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
 32!> in which case the provisions of the GPL or the LGPL are applicable instead
 33!> of those above. If you wish to allow use of your version of this file only
 34!> under the terms of either the GPL or the LGPL, and not to allow others to
 35!> use your version of this file under the terms of the MPL, indicate your
 36!> decision by deleting the provisions above and replace them with the notice
 37!> and other provisions required by the GPL or the LGPL. If you do not delete
 38!> the provisions above, a recipient may use your version of this file under
 39!> the terms of any one of the MPL, the GPL or the LGPL.
 40!>
 41
 42!> \example ClassicalField/Laplace/ANALYTIC_LINEAR_ELASTICITY/src/ANALYTIC_LINEAR_ELASTICITYExample.f90
 43!! Example illustrating the use of OpenCMISS to solve the Laplace problem and check with its Analytic Solution.
 44!! 
 45!! \htmlinclude ClassicalField/Laplace/ANALYTIC_LINEAR_ELASTICITY/history.html
 46!< 
 47
 48!> Main program
 49PROGRAM ANALYTIC_LINEAR_ELASTICITYEXAMPLE
 50
 51  USE MPI
 52  USE OPENCMISS
 53  USE TEST_FRAMEWORK_ROUTINES
 54
 55#ifdef WIN32
 56  USE IFQWIN
 57#endif
 58
 59  IMPLICIT NONE
 60
 61  INTEGER(CMISSIntg), PARAMETER :: EquationsSetFieldUserNumber=1337
 62  TYPE(CMISSFieldType) :: EquationsSetField
 63
 64
 65  !Test program parameters
 66
 67  REAL(CMISSDP), PARAMETER :: ORIGIN(3)=(/0.0_CMISSDP,0.0_CMISSDP,0.0_CMISSDP/)
 68  REAL(CMISSDP), PARAMETER :: LENGTH=20.0_CMISSDP
 69  REAL(CMISSDP), PARAMETER :: WIDTH=20.0_CMISSDP
 70  REAL(CMISSDP), PARAMETER :: HEIGHT=5.0_CMISSDP
 71
 72  INTEGER(CMISSIntg), PARAMETER :: NumberOfDomains=1
 73
 74  INTEGER(CMISSIntg), PARAMETER :: CoordinateSystemUserNumber=1
 75  INTEGER(CMISSIntg), PARAMETER :: RegionUserNumber=1
 76  INTEGER(CMISSIntg), PARAMETER :: BasisUserNumber=1
 77  INTEGER(CMISSIntg), PARAMETER :: GeneratedMeshUserNumber = 1
 78  INTEGER(CMISSIntg), PARAMETER :: MeshUserNumber=1
 79  INTEGER(CMISSIntg), PARAMETER :: DecompositionUserNumber=1
 80
 81  INTEGER(CMISSIntg), PARAMETER :: FieldGeometryUserNumber=1
 82  INTEGER(CMISSIntg), PARAMETER :: FieldGeometryNumberOfVariables=1
 83
 84  INTEGER(CMISSIntg), PARAMETER :: FieldDependentUserNumber=2
 85  INTEGER(CMISSIntg), PARAMETER :: FieldDependentNumberOfVariables=2
 86
 87  INTEGER(CMISSIntg), PARAMETER :: FieldMaterialUserNumber=3
 88  INTEGER(CMISSIntg), PARAMETER :: FieldMaterialNumberOfVariables=1
 89
 90  INTEGER(CMISSIntg), PARAMETER :: FieldAnalyticUserNumber=4
 91
 92  INTEGER(CMISSIntg), PARAMETER :: EquationSetUserNumber=1
 93  INTEGER(CMISSIntg), PARAMETER :: ProblemUserNumber=1
 94
 95  REAL(CMISSDP), PARAMETER ::   ZERO = 0.0_CMISSDP
 96
 97  !Program types
 98
 99  TYPE(CMISSRegionType) :: WorldRegion
100  TYPE(CMISSCoordinateSystemType) :: WorldCoordinateSystem
101
102#ifdef WIN32
103  !Quickwin type
104  LOGICAL :: QUICKWIN_STATUS=.FALSE.
105  TYPE(WINDOWCONFIG) :: QUICKWIN_WINDOW_CONFIG
106#endif
107
108  !Generic CMISS variables
109  INTEGER(CMISSIntg) :: Err
110
111#ifdef WIN32
112  !Initialise QuickWin
113  QUICKWIN_WINDOW_CONFIG%TITLE="General Output" !Window title
114  QUICKWIN_WINDOW_CONFIG%NUMTEXTROWS=-1 !Max possible number of rows
115  QUICKWIN_WINDOW_CONFIG%MODE=QWIN$SCROLLDOWN
116  !Set the window parameters
117  QUICKWIN_STATUS=SETWINDOWCONFIG(QUICKWIN_WINDOW_CONFIG)
118  !If attempt fails set with system estimated values
119  IF(.NOT.QUICKWIN_STATUS) QUICKWIN_STATUS=SETWINDOWCONFIG(QUICKWIN_WINDOW_CONFIG)
120#endif
121
122  !Intialise cmiss
123  CALL CMISSInitialise(WorldCoordinateSystem,WorldRegion,Err)
124
125  CALL CMISSErrorHandlingModeSet(CMISS_ERRORS_TRAP_ERROR,Err)
126
127  WRITE(*,'(A)') "Program starting."
128
129  !Set all diganostic levels on for testing
130  !CALL CMISSDiagnosticsSetOn(CMISS_FROM_DIAG_TYPE,(/1,2,3,4,5/),"Diagnostics",(/"PROBLEM_FINITE_ELEMENT_CALCULATE"/),Err)
131
132  CALL ANALYTIC_LINEAR_ELASTICITY_TESTCASE_LINEAR_LAGRANGE_EXPORT(1,0,0,"LinearLagrange")
133  CALL ANALYTIC_LINEAR_ELASTICITY_TESTCASE_LINEAR_LAGRANGE_EXPORT(1,1,0,"BiLinearLagrange")
134  CALL ANALYTIC_LINEAR_ELASTICITY_TESTCASE_LINEAR_LAGRANGE_EXPORT(1,1,1,"TriLinearLagrange")
135  !CALL ANALYTIC_LINEAR_ELASTICITY_TESTCASE_QUADRATIC_LAGRANGE_EXPORT(1,0,0,"QuadraticLagrange")
136  CALL CMISSFinalise(Err)
137
138  WRITE(*,'(A)') "Program successfully completed."
139  
140  STOP
141
142CONTAINS
143
144
145  !
146  !================================================================================================================================
147  !  
148    !>Check if the convergence of linear langrange interpolation is expected.
149  SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_TESTCASE_LINEAR_LAGRANGE_EXPORT(NumberGlobalXElements,NumberGlobalYElements, &
150    & NumberGlobalZElements,OutputFilename)
151
152    !Argument variables
153    INTEGER(CMISSIntg), INTENT(IN) :: NumberGlobalXElements !<initial number of elements per axis
154    INTEGER(CMISSIntg), INTENT(IN) :: NumberGlobalYElements !<final number of elements per axis
155    INTEGER(CMISSIntg), INTENT(IN) :: NumberGlobalZElements !<increment interval number of elements per axis
156    CHARACTER(LEN=*), INTENT(IN) :: OutputFilename !<The Error condition string
157    !Local Variables
158    TYPE(CMISSFieldType) :: DependentField
159
160    CALL ANALYTIC_LINEAR_ELASTICITY_GENERIC(NumberGlobalXElements,NumberGlobalYElements,NumberGlobalZElements, &
161      & CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION,DependentField)
162
163    CALL CMISSAnalyticAnalysisOutput(DependentField,OutputFilename,Err)
164    
165    CALL ANALYTIC_LINEAR_ELASTICITY_GENERIC_CLEAN(CoordinateSystemUserNumber,RegionUserNumber,BasisUserNumber, &
166      & GeneratedMeshUserNumber,ProblemUserNumber)
167
168  END SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_TESTCASE_LINEAR_LAGRANGE_EXPORT
169
170  !
171  !================================================================================================================================
172  !  
173    !>Check if the convergence of quadratic langrange interpolation is expected.
174  SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_TESTCASE_QUADRATIC_LAGRANGE_EXPORT(NumberGlobalXElements,NumberGlobalYElements, &
175    & NumberGlobalZElements,OutputFilename)
176
177    !Argument variables
178    INTEGER(CMISSIntg), INTENT(IN) :: NumberGlobalXElements !<initial number of elements per axis
179    INTEGER(CMISSIntg), INTENT(IN) :: NumberGlobalYElements !<final number of elements per axis
180    INTEGER(CMISSIntg), INTENT(IN) :: NumberGlobalZElements !<increment interval number of elements per axis
181    CHARACTER(LEN=*), INTENT(IN) :: OutputFilename !<The Error condition string
182    !Local Variables
183    TYPE(CMISSFieldType) :: DependentField
184
185    CALL ANALYTIC_LINEAR_ELASTICITY_GENERIC(NumberGlobalXElements,NumberGlobalYElements,NumberGlobalZElements, &
186      & CMISS_BASIS_QUADRATIC_LAGRANGE_INTERPOLATION,DependentField)
187
188    CALL CMISSAnalyticAnalysisOutput(DependentField,OutputFilename,Err)
189    
190    CALL ANALYTIC_LINEAR_ELASTICITY_GENERIC_CLEAN(CoordinateSystemUserNumber,RegionUserNumber,BasisUserNumber, &
191      & GeneratedMeshUserNumber,ProblemUserNumber)
192
193  END SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_TESTCASE_QUADRATIC_LAGRANGE_EXPORT
194
195  !
196  !================================================================================================================================
197  !  
198    !>Check if the convergence of cubic langrange interpolation is expected.
199  SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_TESTCASE_CUBIC_LAGRANGE_EXPORT(NumberGlobalXElements,NumberGlobalYElements, &
200    & NumberGlobalZElements,OutputFilename)
201
202    !Argument variables
203    INTEGER(CMISSIntg), INTENT(IN) :: NumberGlobalXElements !<initial number of elements per axis
204    INTEGER(CMISSIntg), INTENT(IN) :: NumberGlobalYElements !<final number of elements per axis
205    INTEGER(CMISSIntg), INTENT(IN) :: NumberGlobalZElements !<increment interval number of elements per axis
206    CHARACTER(LEN=*), INTENT(IN) :: OutputFilename !<The Error condition string
207    !Local Variables
208    TYPE(CMISSFieldType) :: DependentField
209
210    CALL ANALYTIC_LINEAR_ELASTICITY_GENERIC(NumberGlobalXElements,NumberGlobalYElements,NumberGlobalZElements, &
211      & CMISS_BASIS_CUBIC_LAGRANGE_INTERPOLATION,DependentField)
212
213    CALL CMISSAnalyticAnalysisOutput(DependentField,OutputFilename,Err)
214    
215    CALL ANALYTIC_LINEAR_ELASTICITY_GENERIC_CLEAN(CoordinateSystemUserNumber,RegionUserNumber,BasisUserNumber, &
216      & GeneratedMeshUserNumber,ProblemUserNumber)
217
218  END SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_TESTCASE_CUBIC_LAGRANGE_EXPORT
219
220  !
221  !================================================================================================================================
222  !   
223    
224  SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_GENERIC(NumberGlobalXElements,NumberGlobalYElements,NumberGlobalZElements, &
225    & InterpolationSpecifications,DependentField)
226    !Argument variables 
227    INTEGER(CMISSIntg), INTENT(IN) :: NumberGlobalXElements !<number of elements on x axis
228    INTEGER(CMISSIntg), INTENT(IN) :: NumberGlobalYElements !<number of elements on y axis
229    INTEGER(CMISSIntg), INTENT(IN) :: NumberGlobalZElements !<number of elements on z axis
230    INTEGER(CMISSIntg), INTENT(IN) :: InterpolationSpecifications !<the interpolation specifications
231    TYPE(CMISSFieldType) :: DependentField
232
233    !Program variables
234    REAL(CMISSDP) :: MeshDimensions(3),MaterialParameters(6)
235    INTEGER(CMISSIntg) :: AnalyticFunction,Interpolation(3),NumberOfGaussPoints(3),EquationSetSubtype
236    INTEGER(CMISSIntg) :: FieldGeometryNumberOfComponents,FieldDependentNumberOfComponents,NumberOfElements(3)
237    INTEGER(CMISSIntg) :: MPI_IERROR
238    INTEGER(CMISSIntg) :: EquationsSetIndex,FieldComponentIndex,FieldMaterialNumberOfComponents,NumberOfXi
239    INTEGER(CMISSIntg) :: NumberOfComputationalNodes,ComputationalNodeNumber
240
241    !CMISS variables
242
243    TYPE(CMISSBasisType) :: Basis
244    TYPE(CMISSCoordinateSystemType) :: CoordinateSystem
245    TYPE(CMISSGeneratedMeshType) :: GeneratedMesh
246    TYPE(CMISSDecompositionType) :: Decomposition
247    TYPE(CMISSEquationsType) :: Equations
248    TYPE(CMISSEquationsSetType) :: EquationsSet
249    TYPE(CMISSFieldType) :: AnalyticField,GeometricField,MaterialField
250    TYPE(CMISSMeshType) :: Mesh
251    TYPE(CMISSProblemType) :: Problem
252    TYPE(CMISSRegionType) :: Region
253    TYPE(CMISSSolverType) :: Solver
254    TYPE(CMISSSolverEquationsType) :: SolverEquations
255    TYPE(CMISSBoundaryConditionsType) :: BoundaryConditions
256
257    IF((NumberGlobalYElements == 0) .AND. (NumberGlobalZElements == 0)) THEN
258      NumberOfXi = 1
259      EquationSetSubtype = CMISS_EQUATIONS_SET_ONE_DIMENSIONAL_SUBTYPE
260      AnalyticFunction=CMISS_EQUATIONS_SET_LINEAR_ELASTICITY_ONE_DIM_1
261      !Prescribe material properties Area,E1
262      FieldMaterialNumberOfComponents = 2 !Young's Modulus & Poisson's Ratio
263      MaterialParameters = (/WIDTH*HEIGHT,10.0E3_CMISSDP,0.0_CMISSDP,0.0_CMISSDP,0.0_CMISSDP,0.0_CMISSDP/)
264    ELSEIF (NumberGlobalZElements == 0) THEN
265      NumberOfXi = 2
266      EquationSetSubtype = CMISS_EQUATIONS_SET_TWO_DIMENSIONAL_PLANE_STRESS_SUBTYPE
267      AnalyticFunction=CMISS_EQUATIONS_SET_LINEAR_ELASTICITY_TWO_DIM_1
268      !Prescribe material properties h,E1,v12
269      FieldMaterialNumberOfComponents = 3 !Young's Modulus & Poisson's Ratio
270      MaterialParameters = (/HEIGHT,10.0E3_CMISSDP,0.3_CMISSDP,0.0_CMISSDP,0.0_CMISSDP,0.0_CMISSDP/)
271    ELSE
272      NumberOfXi = 3
273      EquationSetSubtype = CMISS_EQUATIONS_SET_THREE_DIMENSIONAL_SUBTYPE
274      AnalyticFunction=CMISS_EQUATIONS_SET_LINEAR_ELASTICITY_THREE_DIM_1
275      !Prescribe material properties E1,E2,E3 & v13,v23,v12
276      FieldMaterialNumberOfComponents = 6 !Young's Modulus & Poisson's Ratio
277      MaterialParameters = (/10.0E3_CMISSDP,10.0E3_CMISSDP,10.0E3_CMISSDP,0.3_CMISSDP,0.3_CMISSDP,0.3_CMISSDP/)
278    ENDIF
279    Interpolation = (/InterpolationSpecifications,InterpolationSpecifications,InterpolationSpecifications/)
280    NumberOfElements = (/NumberGlobalXElements,NumberGlobalYElements,NumberGlobalZElements/)
281    MeshDimensions = (/LENGTH,WIDTH,HEIGHT/)
282    NumberOfGaussPoints = (/4,4,4/)
283    FieldGeometryNumberOfComponents=NumberOfXi
284    FieldDependentNumberOfComponents=NumberOfXi
285
286    !Get the number of computational nodes and this computational node number
287    CALL CMISSComputationalNumberOfNodesGet(NumberOfComputationalNodes,Err)
288    CALL CMISSComputationalNodeNumberGet(ComputationalNodeNumber,Err)
289
290    !Broadcast the number of elements in the X,Y and Z directions and the number of partitions to the other computational nodes
291    CALL MPI_BCAST(NumberGlobalXElements,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR)
292    CALL MPI_BCAST(NumberGlobalYElements,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR)
293    CALL MPI_BCAST(NumberGlobalZElements,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR)
294    CALL MPI_BCAST(NumberOfDomains,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR)
295
296    !Create a CS - default is 3D rectangular cartesian CS with 0,0,0 as origin
297    CALL CMISSCoordinateSystem_Initialise(CoordinateSystem,Err)
298    CALL CMISSCoordinateSystem_CreateStart(CoordinateSystemUserNumber,CoordinateSystem,Err)
299    CALL CMISSCoordinateSystem_TypeSet(CoordinateSystem,CMISS_COORDINATE_RECTANGULAR_CARTESIAN_TYPE,Err)
300    CALL CMISSCoordinateSystem_DimensionSet(CoordinateSystem,NumberOfXi,Err)
301    CALL CMISSCoordinateSystem_OriginSet(CoordinateSystem,ORIGIN,Err)
302    CALL CMISSCoordinateSystem_CreateFinish(CoordinateSystem,Err)
303
304    !Create a region and assign the CS to the region
305    CALL CMISSRegion_Initialise(Region,Err)
306    CALL CMISSRegion_CreateStart(RegionUserNumber,WorldRegion,Region,Err)
307    CALL CMISSRegion_CoordinateSystemSet(Region,CoordinateSystem,Err)
308    CALL CMISSRegion_CreateFinish(Region,Err)
309
310    CALL CMISSBasis_Initialise(Basis,Err)
311    CALL CMISSBasis_CreateStart(BasisUserNumber,Basis,Err)
312    CALL CMISSBasis_TypeSet(Basis,CMISS_BASIS_LAGRANGE_HERMITE_TP_TYPE,Err)
313    CALL CMISSBasis_NumberOfXiSet(Basis,NumberOfXi,Err)
314    CALL CMISSBasis_InterpolationXiSet(Basis,Interpolation(1:NumberOfXi),Err)
315    CALL CMISSBasis_QuadratureNumberOfGaussXiSet(Basis,NumberOfGaussPoints(1:NumberOfXi),Err)
316    CALL CMISSBasis_CreateFinish(Basis,Err)
317
318    !Start the creation of a generated Mesh in the Region
319    CALL CMISSGeneratedMesh_Initialise(GeneratedMesh,Err)
320    CALL CMISSGeneratedMesh_CreateStart(GeneratedMeshUserNumber,Region,GeneratedMesh,Err)
321    CALL CMISSGeneratedMesh_TypeSet(GeneratedMesh,1,Err)
322    CALL CMISSGeneratedMesh_BasisSet(GeneratedMesh,Basis,Err)
323
324    !Define the Mesh on the Region
325    CALL CMISSGeneratedMesh_OriginSet(GeneratedMesh,ORIGIN(1:NumberOfXi),Err)
326    CALL CMISSGeneratedMesh_ExtentSet(GeneratedMesh,MeshDimensions(1:NumberOfXi),Err)
327    CALL CMISSGeneratedMesh_NumberOfElementsSet(GeneratedMesh,NumberOfElements(1:NumberOfXi),Err)
328    CALL CMISSMesh_Initialise(Mesh,Err)
329    CALL CMISSGeneratedMesh_CreateFinish(GeneratedMesh,1,Mesh,Err)
330
331    !Create a decomposition
332    CALL CMISSDecomposition_Initialise(Decomposition,Err)
333    CALL CMISSDecomposition_CreateStart(DecompositionUserNumber,Mesh,Decomposition,Err)
334    CALL CMISSDecomposition_TypeSet(Decomposition,CMISS_DECOMPOSITION_CALCULATED_TYPE,Err)
335    CALL CMISSDecomposition_NumberOfDomainsSet(Decomposition,NumberOfDomains,Err)
336    CALL CMISSDecomposition_CreateFinish(Decomposition,Err)
337
338    !Create a field to put the geometry (defualt is geometry)
339    CALL CMISSField_Initialise(GeometricField,Err)
340    CALL CMISSField_CreateStart(FieldGeometryUserNumber,Region,GeometricField,Err)
341    CALL CMISSField_MeshDecompositionSet(GeometricField,Decomposition,Err)
342    CALL CMISSField_TypeSet(GeometricField,CMISS_FIELD_GEOMETRIC_TYPE,Err)  
343    CALL CMISSField_NumberOfVariablesSet(GeometricField,FieldGeometryNumberOfVariables,Err)
344    CALL CMISSField_NumberOfComponentsSet(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,FieldGeometryNumberOfComponents,Err)  
345    DO FieldComponentIndex=1,FieldGeometryNumberOfComponents
346      CALL CMISSField_ComponentMeshComponentSet(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,FieldComponentIndex,1,Err)
347    ENDDO !FieldComponentIndex
348    CALL CMISSField_CreateFinish(GeometricField,Err)
349
350    !Update the geometric field parameters
351    CALL CMISSGeneratedMesh_GeometricParametersCalculate(GeneratedMesh,GeometricField,Err)
352
353    !Create a dependent field with two variables and three components
354    CALL CMISSField_Initialise(DependentField,Err)
355    CALL CMISSField_CreateStart(FieldDependentUserNumber,Region,DependentField,Err)
356    CALL CMISSField_TypeSet(DependentField,CMISS_FIELD_GENERAL_TYPE,Err)  
357    CALL CMISSField_MeshDecompositionSet(DependentField,Decomposition,Err)
358    CALL CMISSField_GeometricFieldSet(DependentField,GeometricField,Err) 
359    CALL CMISSField_DependentTypeSet(DependentField,CMISS_FIELD_DEPENDENT_TYPE,Err) 
360    CALL CMISSField_NumberOfVariablesSet(DependentField,FieldDependentNumberOfVariables,Err)
361    CALL CMISSField_NumberOfComponentsSet(DependentField,CMISS_FIELD_U_VARIABLE_TYPE,FieldDependentNumberOfComponents,Err)
362    CALL CMISSField_NumberOfComponentsSet(DependentField,CMISS_FIELD_DELUDELN_VARIABLE_TYPE,FieldDependentNumberOfComponents,Err)
363    DO FieldComponentIndex=1,FieldDependentNumberOfComponents
364      CALL CMISSField_ComponentMeshComponentSet(DependentField,CMISS_FIELD_U_VARIABLE_TYPE,FieldComponentIndex,1,Err)
365      CALL CMISSField_ComponentMeshComponentSet(DependentField,CMISS_FIELD_DELUDELN_VARIABLE_TYPE,FieldComponentIndex,1,Err)
366    ENDDO !FieldComponentIndex
367    CALL CMISSField_CreateFinish(DependentField,Err)
368
369    !Create a material field and attach it to the geometric field
370    CALL CMISSField_Initialise(MaterialField,Err)
371    CALL CMISSField_CreateStart(FieldMaterialUserNumber,Region,MaterialField,Err)
372    CALL CMISSField_TypeSet(MaterialField,CMISS_FIELD_MATERIAL_TYPE,Err)
373    CALL CMISSField_MeshDecompositionSet(MaterialField,Decomposition,Err)
374    CALL CMISSField_GeometricFieldSet(MaterialField,GeometricField,Err)
375    CALL CMISSField_NumberOfVariablesSet(MaterialField,FieldMaterialNumberOfVariables,Err)
376    CALL CMISSField_NumberOfComponentsSet(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,FieldMaterialNumberOfComponents,Err)
377    DO FieldComponentIndex=1,FieldMaterialNumberOfComponents
378      CALL CMISSField_ComponentMeshComponentSet(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,FieldComponentIndex,1,Err)
379    ENDDO !FieldComponentIndex
380    CALL CMISSField_CreateFinish(MaterialField,Err)
381
382    !Set isotropic elasticity material parameters - Young's Modulus & Poisson's Ratio
383    DO FieldComponentIndex=1,FieldMaterialNumberOfComponents
384      CALL CMISSField_ComponentValuesInitialise(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE, &
385        & FieldComponentIndex, &
386        & MaterialParameters(FieldComponentIndex),Err)
387    ENDDO !FieldComponentIndex
388
389    !Create a Elasticity Class, Linear Elasticity type, no subtype, EquationsSet
390    CALL CMISSEquationsSet_Initialise(EquationsSet,Err)
391      CALL CMISSField_Initialise(EquationsSetField,Err)
392CALL CMISSEquationsSet_CreateStart(EquationSetUserNumber,Region,GeometricField,CMISS_EQUATIONS_SET_ELASTICITY_CLASS, &
393    & CMISS_EQUATIONS_SET_LINEAR_ELASTICITY_TYPE,EquationSetSubtype,EquationsSetFieldUserNumber,EquationsSetField,EquationsSet,Err)
394    
395    CALL CMISSEquationsSet_CreateFinish(EquationsSet,Err)
396
397    CALL CMISSEquationsSet_DependentCreateStart(EquationsSet,FieldDependentUserNumber,DependentField,Err) 
398    CALL CMISSEquationsSet_DependentCreateFinish(EquationsSet,Err)
399
400    CALL CMISSEquationsSet_MaterialsCreateStart(EquationsSet,FieldMaterialUserNumber,MaterialField,Err)  
401    CALL CMISSEquationsSet_MaterialsCreateFinish(EquationsSet,Err)
402
403    !Create the Equations set analtyic field variables
404    CALL CMISSField_Initialise(AnalyticField,Err)
405    CALL CMISSEquationsSet_AnalyticCreateStart(EquationsSet,AnalyticFunction,FieldAnalyticUserNumber,AnalyticField,Err)
406    CALL CMISSEquationsSet_AnalyticCreateFinish(EquationsSet,Err)
407
408    !Create the equations set equations
409    CALL CMISSEquations_Initialise(Equations,Err)
410    CALL CMISSEquationsSet_EquationsCreateStart(EquationsSet,Equations,Err)
411    CALL CMISSEquations_SparsityTypeSet(EQUATIONS,CMISS_EQUATIONS_SPARSE_MATRICES,Err)
412                                                !CMISS_EQUATIONS_SPARSE_MATRICES=1 !<Use sparse matrices for the equations.
413                                                !CMISS_EQUATIONS_FULL_MATRICES=2 !<Use fully populated matrices for the equations. 
414    CALL CMISSEquations_OutputTypeSet(EQUATIONS,CMISS_EQUATIONS_ELEMENT_MATRIX_OUTPUT,Err)
415                                              !CMISS_EQUATIONS_NO_OUTPUT !<No output from the equations.
416                                              !CMISS_EQUATIONS_TIMING_OUTPUT !<Timing information output.
417                                              !CMISS_EQUATIONS_MATRIX_OUTPUT !<All below and equation matrices output.
418                                              !CMISS_EQUATIONS_ELEMENT_MATRIX_OUTPUT !<All below and Element matrices output.
419    CALL CMISSEquationsSet_EquationsCreateFinish(EquationsSet,Err)
420    
421    !Define the problem
422    CALL CMISSProblem_Initialise(Problem,Err)
423    CALL CMISSProblem_CreateStart(ProblemUserNumber,Problem,Err)
424    CALL CMISSProblem_SpecificationSet(Problem,CMISS_PROBLEM_ELASTICITY_CLASS,CMISS_PROBLEM_LINEAR_ELASTICITY_TYPE, &
425      & CMISS_PROBLEM_NO_SUBTYPE,Err)
426    CALL CMISSProblem_CreateFinish(Problem,Err)
427
428    !Create the problem control loop
429    CALL CMISSProblem_ControlLoopCreateStart(Problem,Err)
430    CALL CMISSProblem_ControlLoopCreateFinish(Problem,Err)
431
432    !Start the creation of the Problem Solvers
433    !Create the problem Solvers
434    CALL CMISSSolver_Initialise(Solver,Err)
435    CALL CMISSProblem_SolversCreateStart(Problem,Err)
436    CALL CMISSProblem_SolverGet(Problem,CMISS_CONTROL_LOOP_NODE,1,Solver,Err)
437    CALL CMISSSolver_OutputTypeSet(Solver,CMISS_SOLVER_MATRIX_OUTPUT,Err)
438                                        !CMISS_SOLVER_NO_OUTPUT !<No output from the Solver routines. \see OPENCMISS_SolverOutputTypes,OPENCMISS
439                                        !CMISS_SOLVER_PROGRESS_OUTPUT !<Progress output from Solver routines.
440                                        !CMISS_SOLVER_TIMING_OUTPUT !<Timing output from the Solver routines plus below.
441                                        !CMISS_SOLVER_SOLVER_OUTPUT !<Solver specific output from the Solver routines plus below.
442                                        !CMISS_SOLVER_MATRIX_OUTPUT !<Solver matrices output from the Solver routines plus below.
443    CALL CMISSSolver_LibraryTypeSet(Solver,CMISS_SOLVER_PETSC_LIBRARY,Err)
444                                          !CMISS_SOLVER_CMISS_LIBRARY     !<CMISS (internal) Solver library.
445                                          !CMISS_SOLVER_PETSC_LIBRARY     !<PETSc Solver library.
446                                          !CMISS_SOLVER_MUMPS_LIBRARY     !<MUMPS Solver library.
447                                          !CMISS_SOLVER_SUPERLU_LIBRARY   !<SuperLU Solver library.
448                                          !CMISS_SOLVER_SPOOLES_LIBRARY !<SPOOLES Solver library.
449                                          !CMISS_SOLVER_UMFPACK_LIBRARY   !<UMFPACK Solver library.
450                                          !CMISS_SOLVER_LUSOL_LIBRARY     !<LUSOL Solver library.
451                                          !CMISS_SOLVER_ESSL_LIBRARY      !<ESSL Solver library.
452                                          !CMISS_SOLVER_LAPACK_LIBRARY    !<LAPACK Solver library.
453                                          !CMISS_SOLVER_TAO_LIBRARY       !<TAO Solver library.
454                                          !CMISS_SOLVER_HYPRE_LIBRARY     !<Hypre Solver library.
455    CALL CMISSSolver_LinearTypeSet(Solver,CMISS_SOLVER_LINEAR_DIRECT_SOLVE_TYPE,Err)
456                                        !CMISS_SOLVER_LINEAR_DIRECT_SOLVE_TYPE    !<Direct linear Solver type.
457                                        !CMISS_SOLVER_LINEAR_ITERATIVE_SOLVE_TYPE !<Iterative linear Solver type.
458    CALL CMISSProblem_SolversCreateFinish(Problem,Err)
459
460    !Create the problem Solver equations
461    CALL CMISSSolver_Initialise(Solver,Err)
462    CALL CMISSSolverEquations_Initialise(SolverEquations,Err)
463    CALL CMISSProblem_SolverEquationsCreateStart(Problem,Err)   
464    CALL CMISSProblem_SolverGet(Problem,CMISS_CONTROL_LOOP_NODE,1,Solver,Err)
465    CALL CMISSSolver_SolverEquationsGet(Solver,SolverEquations,Err)
466    CALL CMISSSolverEquations_SparsityTypeSet(SolverEquations,CMISS_SOLVER_SPARSE_MATRICES,Err)
467                                                            !CMISS_SOLVER_SPARSE_MATRICES !<Use sparse Solver matrices.
468                                                            !CMISS_SOLVER_FULL_MATRICES !<Use fully populated Solver matrices.
469    CALL CMISSSolverEquations_EquationsSetAdd(SolverEquations,EquationsSet,EquationsSetIndex,Err)
470    CALL CMISSProblem_SolverEquationsCreateFinish(Problem,Err)
471
472    !Prescribe boundary conditions
473    CALL CMISSBoundaryConditions_Initialise(BoundaryConditions,Err)
474    CALL CMISSSolverEquations_BoundaryConditionsCreateStart(SolverEquations,BoundaryConditions,Err)
475    CALL CMISSSolverEquations_BoundaryConditionsAnalytic(SolverEquations,Err)
476    CALL CMISSSolverEquations_BoundaryConditionsCreateFinish(SolverEquations,Err)
477
478    !=SOLVE Problem==================================================================================================================
479    !Solve the Problem
480    CALL CMISSProblem_Solve(Problem,Err)
481
482  END SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_GENERIC
483
484  SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_GENERIC_CLEAN(CoordinateSystemUserNumber,RegionUserNumber,BasisUserNumber, &
485    & GeneratedMeshUserNumber,ProblemUserNumber)
486
487    !Argument variables
488    INTEGER(CMISSIntg), INTENT(IN) :: CoordinateSystemUserNumber
489    INTEGER(CMISSIntg), INTENT(IN) :: RegionUserNumber
490    INTEGER(CMISSIntg), INTENT(IN) :: BasisUserNumber
491    INTEGER(CMISSIntg), INTENT(IN) :: GeneratedMeshUserNumber
492    INTEGER(CMISSIntg), INTENT(IN) :: ProblemUserNumber
493
494    CALL CMISSProblem_Destroy(ProblemUserNumber,Err)
495    CALL CMISSGeneratedMesh_Destroy(RegionUserNumber,GeneratedMeshUserNumber,Err)
496    CALL CMISSBasis_Destroy(BasisUserNumber,Err)
497    CALL CMISSRegion_Destroy(RegionUserNumber,Err)
498    CALL CMISSCoordinateSystem_Destroy(CoordinateSystemUserNumber,Err)
499
500  END SUBROUTINE ANALYTIC_LINEAR_ELASTICITY_GENERIC_CLEAN
501
502END PROGRAM ANALYTIC_LINEAR_ELASTICITYEXAMPLE 
503