/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

  1. ! \file
  2. !> \author Chris Bradley
  3. !> \brief This is an example program to solve a linear elasticity 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. !> \example LinearElasticity/src/LinearElasticityExample.f90
  42. !! Example program to solve a linear elasticity equation using openCMISS calls.
  43. !<
  44. !> Main program
  45. PROGRAM LinearElasticity3DLagrangeBasis
  46. USE MPI
  47. USE OPENCMISS
  48. #ifdef WIN32
  49. USE IFQWIN
  50. #endif
  51. IMPLICIT NONE
  52. INTEGER(CMISSIntg), PARAMETER :: EquationsSetFieldUserNumber=1337
  53. TYPE(CMISSFieldType) :: EquationsSetField
  54. !Test program parameters
  55. REAL(CMISSDP), PARAMETER :: LENGTH=120.0_CMISSDP
  56. REAL(CMISSDP), PARAMETER :: WIDTH=160.0_CMISSDP
  57. REAL(CMISSDP), PARAMETER :: HEIGHT=10.0_CMISSDP
  58. INTEGER(CMISSIntg), PARAMETER :: CoordinateSystemUserNumber=1
  59. INTEGER(CMISSIntg), PARAMETER :: NumberOfSpatialCoordinates=3
  60. INTEGER(CMISSIntg), PARAMETER :: RegionUserNumber=1
  61. INTEGER(CMISSIntg), PARAMETER :: Basis1UserNumber=1
  62. INTEGER(CMISSIntg), PARAMETER :: Basis2UserNumber=2
  63. INTEGER(CMISSIntg), PARAMETER :: Basis3UserNumber=3
  64. INTEGER(CMISSIntg), PARAMETER :: MeshUserNumber=1
  65. INTEGER(CMISSIntg), PARAMETER :: DecompositionUserNumber=1
  66. INTEGER(CMISSIntg), PARAMETER :: NumberOfXiCoordinates=3
  67. INTEGER(CMISSIntg), PARAMETER :: TotalNumberOfNodes=8
  68. INTEGER(CMISSIntg), PARAMETER :: NumberOfMeshDimensions=3
  69. INTEGER(CMISSIntg), PARAMETER :: NumberOfMeshComponents=3
  70. INTEGER(CMISSIntg), PARAMETER :: TotalNumberOfElements=1
  71. INTEGER(CMISSIntg), PARAMETER :: MeshComponent1UserNumber=1
  72. INTEGER(CMISSIntg), PARAMETER :: MeshComponent2UserNumber=2
  73. INTEGER(CMISSIntg), PARAMETER :: MeshComponent3UserNumber=3
  74. INTEGER(CMISSIntg), PARAMETER :: FieldGeometryUserNumber=1
  75. INTEGER(CMISSIntg), PARAMETER :: FieldGeometryNumberOfVariables=1
  76. INTEGER(CMISSIntg), PARAMETER :: FieldGeometryNumberOfComponents=3
  77. INTEGER(CMISSIntg), PARAMETER :: FieldDependentUserNumber=2
  78. INTEGER(CMISSIntg), PARAMETER :: FieldDependentNumberOfVariables=2
  79. INTEGER(CMISSIntg), PARAMETER :: FieldDependentNumberOfComponents=3
  80. INTEGER(CMISSIntg), PARAMETER :: FieldMaterialUserNumber=3
  81. INTEGER(CMISSIntg), PARAMETER :: FieldMaterialNumberOfVariables=1
  82. INTEGER(CMISSIntg), PARAMETER :: FieldMaterialNumberOfComponents=6
  83. INTEGER(CMISSIntg), PARAMETER :: EquationSetUserNumber=1
  84. INTEGER(CMISSIntg), PARAMETER :: ProblemUserNumber=1
  85. REAL(CMISSDP), PARAMETER :: ZERO = 0.0_CMISSDP
  86. !Program types
  87. !Program variables
  88. INTEGER(CMISSIntg) :: NumberGlobalXElements,NumberGlobalYElements,NumberGlobalZElements
  89. INTEGER(CMISSIntg) :: MPI_IERROR
  90. INTEGER(CMISSIntg) :: EquationsSetIndex
  91. INTEGER(CMISSIntg) :: NumberOfComputationalNodes,NumberOfDomains,ComputationalNodeNumber
  92. LOGICAL :: EXPORT_FIELD
  93. !CMISS variables
  94. TYPE(CMISSRegionType) :: WorldRegion
  95. TYPE(CMISSCoordinateSystemType) :: WorldCoordinateSystem
  96. TYPE(CMISSBasisType) :: Basis(3)
  97. TYPE(CMISSBoundaryConditionsType) :: BoundaryConditions
  98. TYPE(CMISSCoordinateSystemType) :: CoordinateSystem
  99. TYPE(CMISSDecompositionType) :: Decomposition
  100. TYPE(CMISSEquationsType) :: Equations
  101. TYPE(CMISSEquationsSetType) :: EquationsSet
  102. TYPE(CMISSFieldType) :: GeometricField,DependentField,MaterialField
  103. TYPE(CMISSFieldsType) :: Fields
  104. TYPE(CMISSMeshType) :: Mesh
  105. TYPE(CMISSNodesType) :: Nodes
  106. TYPE(CMISSProblemType) :: Problem
  107. TYPE(CMISSRegionType) :: Region
  108. TYPE(CMISSSolverType) :: Solver
  109. TYPE(CMISSSolverEquationsType) :: SolverEquations
  110. TYPE(CMISSMeshElementsType) :: Elements(3)
  111. #ifdef WIN32
  112. !Quickwin type
  113. LOGICAL :: QUICKWIN_STATUS=.FALSE.
  114. TYPE(WINDOWCONFIG) :: QUICKWIN_WINDOW_CONFIG
  115. #endif
  116. !Generic CMISS variables
  117. INTEGER(CMISSIntg) :: Err
  118. #ifdef WIN32
  119. !Initialise QuickWin
  120. QUICKWIN_WINDOW_CONFIG%TITLE="General Output" !Window title
  121. QUICKWIN_WINDOW_CONFIG%NUMTEXTROWS=-1 !Max possible number of rows
  122. QUICKWIN_WINDOW_CONFIG%MODE=QWIN$SCROLLDOWN
  123. !Set the window parameters
  124. QUICKWIN_STATUS=SETWINDOWCONFIG(QUICKWIN_WINDOW_CONFIG)
  125. !If attempt fails set with system estimated values
  126. IF(.NOT.QUICKWIN_STATUS) QUICKWIN_STATUS=SETWINDOWCONFIG(QUICKWIN_WINDOW_CONFIG)
  127. #endif
  128. !Intialise cmiss
  129. CALL CMISSInitialise(WorldCoordinateSystem,WorldRegion,Err)
  130. CALL CMISSErrorHandlingModeSet(CMISS_ERRORS_TRAP_ERROR,Err)
  131. WRITE(*,'(A)') "Program starting."
  132. !Set all diganostic levels on for testing
  133. CALL CMISSDiagnosticsSetOn(CMISS_FROM_DIAG_TYPE,(/1,2,3,4,5/),"Diagnostics",(/"PROBLEM_FINITE_ELEMENT_CALCULATE"/),Err)
  134. !Get the number of computational nodes and this computational node number
  135. CALL CMISSComputationalNumberOfNodesGet(NumberOfComputationalNodes,Err)
  136. CALL CMISSComputationalNodeNumberGet(ComputationalNodeNumber,Err)
  137. NumberGlobalXElements=1
  138. NumberGlobalYElements=1
  139. NumberGlobalZElements=1
  140. NumberOfDomains=1
  141. !Broadcast the number of elements in the X,Y and Z directions and the number of partitions to the other computational nodes
  142. CALL MPI_BCAST(NumberGlobalXElements,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR)
  143. CALL MPI_BCAST(NumberGlobalYElements,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR)
  144. CALL MPI_BCAST(NumberGlobalZElements,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR)
  145. CALL MPI_BCAST(NumberOfDomains,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR)
  146. !Create a CS - default is 3D rectangular cartesian CS with 0,0,0 as origin
  147. CALL CMISSCoordinateSystem_Initialise(CoordinateSystem,Err)
  148. CALL CMISSCoordinateSystem_CreateStart(CoordinateSystemUserNumber,CoordinateSystem,Err)
  149. CALL CMISSCoordinateSystem_TypeSet(CoordinateSystem,CMISS_COORDINATE_RECTANGULAR_CARTESIAN_TYPE,Err)
  150. CALL CMISSCoordinateSystem_DimensionSet(CoordinateSystem,NumberOfSpatialCoordinates,Err)
  151. CALL CMISSCoordinateSystem_OriginSet(CoordinateSystem,(/0.0_CMISSDP,0.0_CMISSDP,0.0_CMISSDP/),Err)
  152. CALL CMISSCoordinateSystem_CreateFinish(CoordinateSystem,Err)
  153. !Create a region and assign the CS to the region
  154. CALL CMISSRegion_Initialise(Region,Err)
  155. CALL CMISSRegion_CreateStart(RegionUserNumber,WorldRegion,Region,Err)
  156. CALL CMISSRegion_CoordinateSystemSet(Region,CoordinateSystem,Err)
  157. CALL CMISSRegion_CreateFinish(Region,Err)
  158. !Define 3 sets of basis functions, one describing each independent coordinate specified by InterpolationType
  159. !NOTE if you change interpolation you need to change Boundary Conditions
  160. !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
  161. CALL CMISSBasis_Initialise(Basis(1),Err)
  162. CALL CMISSBasis_CreateStart(Basis1UserNumber,Basis(1),Err)
  163. CALL CMISSBasis_TypeSet(Basis(1),CMISS_BASIS_LAGRANGE_HERMITE_TP_TYPE,Err)
  164. CALL CMISSBasis_NumberOfXiSet(Basis(1),NumberOfXiCoordinates,Err)
  165. CALL CMISSBasis_InterpolationXiSet(Basis(1),(/CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION, &
  166. & CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION,CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION/),Err)
  167. CALL CMISSBasis_QuadratureNumberOfGaussXiSet(Basis(1), &
  168. & (/CMISS_BASIS_MID_QUADRATURE_SCHEME,CMISS_BASIS_MID_QUADRATURE_SCHEME,CMISS_BASIS_MID_QUADRATURE_SCHEME/),Err)
  169. CALL CMISSBasis_CreateFinish(Basis(1),Err)
  170. CALL CMISSBasis_Initialise(Basis(2),Err)
  171. CALL CMISSBasis_CreateStart(Basis2UserNumber,Basis(2),Err)
  172. CALL CMISSBasis_TypeSet(Basis(2),CMISS_BASIS_LAGRANGE_HERMITE_TP_TYPE,Err)
  173. CALL CMISSBasis_NumberOfXiSet(Basis(2),NumberOfXiCoordinates,Err)
  174. CALL CMISSBasis_InterpolationXiSet(Basis(2),(/CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION, &
  175. & CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION,CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION/),Err)
  176. CALL CMISSBasis_QuadratureNumberOfGaussXiSet(Basis(2), &
  177. & (/CMISS_BASIS_MID_QUADRATURE_SCHEME,CMISS_BASIS_MID_QUADRATURE_SCHEME,CMISS_BASIS_MID_QUADRATURE_SCHEME/),Err)
  178. CALL CMISSBasis_CreateFinish(Basis(2),Err)
  179. CALL CMISSBasis_Initialise(Basis(3),Err)
  180. CALL CMISSBasis_CreateStart(Basis3UserNumber,Basis(3),Err)
  181. CALL CMISSBasis_TypeSet(Basis(3),CMISS_BASIS_LAGRANGE_HERMITE_TP_TYPE,Err)
  182. CALL CMISSBasis_NumberOfXiSet(Basis(3),NumberOfXiCoordinates,Err)
  183. CALL CMISSBasis_InterpolationXiSet(Basis(3),(/CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION, &
  184. & CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION,CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION/),Err)
  185. CALL CMISSBasis_QuadratureNumberOfGaussXiSet(Basis(3), &
  186. & (/CMISS_BASIS_MID_QUADRATURE_SCHEME,CMISS_BASIS_MID_QUADRATURE_SCHEME,CMISS_BASIS_MID_QUADRATURE_SCHEME/),Err)
  187. CALL CMISSBasis_CreateFinish(Basis(3),Err)
  188. !Create a mesh
  189. CALL CMISSMesh_Initialise(Mesh,Err)
  190. CALL CMISSMesh_CreateStart(MeshUserNumber,Region,NumberOfMeshDimensions,Mesh,Err)
  191. CALL CMISSMesh_NumberOfComponentsSet(Mesh,NumberOfMeshComponents,Err)
  192. CALL CMISSMesh_NumberOfElementsSet(Mesh,TotalNumberOfElements,Err)
  193. !Define nodes for the mesh
  194. CALL CMISSNodes_Initialise(Nodes,Err)
  195. CALL CMISSNodes_CreateStart(Region,TotalNumberOfNodes,Nodes,Err)
  196. CALL CMISSNodes_CreateFinish(Nodes,Err)
  197. !Create elements for the mesh
  198. !Mesh Component 1
  199. CALL CMISSMeshElements_Initialise(Elements(1),Err)
  200. CALL CMISSMeshElements_CreateStart(Mesh,MeshComponent1UserNumber,Basis(1),Elements(1),Err)
  201. CALL CMISSMeshElements_NodesSet(Elements(1),1,(/1,2,3,4,5,6,7,8/),Err)
  202. CALL CMISSMeshElements_CreateFinish(Elements(1),Err)
  203. !Mesh Component 2
  204. CALL CMISSMeshElements_Initialise(Elements(2),Err)
  205. CALL CMISSMeshElements_CreateStart(Mesh,MeshComponent2UserNumber,Basis(2),Elements(2),Err)
  206. CALL CMISSMeshElements_NodesSet(Elements(2),1,(/1,2,3,4,5,6,7,8/),Err)
  207. CALL CMISSMeshElements_CreateFinish(Elements(2),Err)
  208. !Mesh Component 3
  209. CALL CMISSMeshElements_Initialise(Elements(3),Err)
  210. CALL CMISSMeshElements_CreateStart(Mesh,MeshComponent3UserNumber,Basis(3),Elements(3),Err)
  211. CALL CMISSMeshElements_NodesSet(Elements(3),1,(/1,2,3,4,5,6,7,8/),Err)
  212. CALL CMISSMeshElements_CreateFinish(Elements(3),Err)
  213. CALL CMISSMesh_CreateFinish(Mesh,Err)
  214. !Create a decomposition
  215. CALL CMISSDecomposition_Initialise(Decomposition,Err)
  216. CALL CMISSDecomposition_CreateStart(DecompositionUserNumber,Mesh,Decomposition,Err)
  217. CALL CMISSDecomposition_TypeSet(Decomposition,CMISS_DECOMPOSITION_CALCULATED_TYPE,Err)
  218. CALL CMISSDecomposition_NumberOfDomainsSet(Decomposition,NumberOfDomains,Err)
  219. CALL CMISSDecomposition_CreateFinish(Decomposition,Err)
  220. !Create a field to put the geometry (defualt is geometry)
  221. CALL CMISSField_Initialise(GeometricField,Err)
  222. CALL CMISSField_CreateStart(FieldGeometryUserNumber,Region,GeometricField,Err)
  223. CALL CMISSField_MeshDecompositionSet(GeometricField,Decomposition,Err)
  224. CALL CMISSField_TypeSet(GeometricField,CMISS_FIELD_GEOMETRIC_TYPE,Err)
  225. CALL CMISSField_NumberOfVariablesSet(GeometricField,FieldGeometryNumberOfVariables,Err)
  226. CALL CMISSField_NumberOfComponentsSet(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,FieldGeometryNumberOfComponents,Err)
  227. CALL CMISSField_ComponentMeshComponentSet(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,Err)
  228. CALL CMISSField_ComponentMeshComponentSet(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,2,2,Err)
  229. CALL CMISSField_ComponentMeshComponentSet(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,3,3,Err)
  230. CALL CMISSField_CreateFinish(GeometricField,Err)
  231. !Set geometric node coordinates (x)
  232. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,1,1, &
  233. & 0.0_CMISSDP,Err)
  234. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,2,1,LENGTH,Err)
  235. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,3,1, &
  236. & 0.0_CMISSDP,Err)
  237. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,4,1,LENGTH,Err)
  238. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,5,1, &
  239. & 0.0_CMISSDP,Err)
  240. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,6,1,LENGTH,Err)
  241. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,7,1, &
  242. & 0.0_CMISSDP,Err)
  243. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,8,1,LENGTH,Err)
  244. !Set geometric node coordinates (y)
  245. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,1,2, &
  246. & 0.0_CMISSDP,Err)
  247. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,2,2, &
  248. & 0.0_CMISSDP,Err)
  249. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,3,2,WIDTH,Err)
  250. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,4,2,WIDTH,Err)
  251. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,5,2, &
  252. & 0.0_CMISSDP,Err)
  253. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,6,2, &
  254. & 0.0_CMISSDP,Err)
  255. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,7,2,WIDTH,Err)
  256. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,8,2,WIDTH,Err)
  257. !Set geometric node coordinates (z)
  258. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,1,3, &
  259. & 0.0_CMISSDP,Err)
  260. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,2,3, &
  261. & 0.0_CMISSDP,Err)
  262. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,3,3, &
  263. & 0.0_CMISSDP,Err)
  264. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,4,3, &
  265. & 0.0_CMISSDP,Err)
  266. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,5,3,HEIGHT,Err)
  267. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,6,3,HEIGHT,Err)
  268. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,7,3,HEIGHT,Err)
  269. CALL CMISSField_ParameterSetUpdateNode(GeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1,1,8,3,HEIGHT,Err)
  270. !Create a dependent field with two variables and three components
  271. CALL CMISSField_Initialise(DependentField,Err)
  272. CALL CMISSField_CreateStart(FieldDependentUserNumber,Region,DependentField,Err)
  273. CALL CMISSField_TypeSet(DependentField,CMISS_FIELD_GENERAL_TYPE,Err)
  274. CALL CMISSField_MeshDecompositionSet(DependentField,Decomposition,Err)
  275. CALL CMISSField_GeometricFieldSet(DependentField,GeometricField,Err)
  276. CALL CMISSField_DependentTypeSet(DependentField,CMISS_FIELD_DEPENDENT_TYPE,Err)
  277. CALL CMISSField_NumberOfVariablesSet(DependentField,FieldDependentNumberOfVariables,Err)
  278. CALL CMISSField_NumberOfComponentsSet(DependentField,CMISS_FIELD_U_VARIABLE_TYPE,FieldDependentNumberOfComponents,Err)
  279. CALL CMISSField_NumberOfComponentsSet(DependentField,CMISS_FIELD_DELUDELN_VARIABLE_TYPE,FieldDependentNumberOfComponents,Err)
  280. CALL CMISSField_ComponentMeshComponentSet(DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,Err)
  281. CALL CMISSField_ComponentMeshComponentSet(DependentField,CMISS_FIELD_U_VARIABLE_TYPE,2,2,Err)
  282. CALL CMISSField_ComponentMeshComponentSet(DependentField,CMISS_FIELD_U_VARIABLE_TYPE,3,3,Err)
  283. CALL CMISSField_ComponentMeshComponentSet(DependentField,CMISS_FIELD_DELUDELN_VARIABLE_TYPE,1,1,Err)
  284. CALL CMISSField_ComponentMeshComponentSet(DependentField,CMISS_FIELD_DELUDELN_VARIABLE_TYPE,2,2,Err)
  285. CALL CMISSField_ComponentMeshComponentSet(DependentField,CMISS_FIELD_DELUDELN_VARIABLE_TYPE,3,3,Err)
  286. CALL CMISSField_CreateFinish(DependentField,Err)
  287. !Create a material field and attach it to the geometric field
  288. CALL CMISSField_Initialise(MaterialField,Err)
  289. CALL CMISSField_CreateStart(FieldMaterialUserNumber,Region,MaterialField,Err)
  290. CALL CMISSField_TypeSet(MaterialField,CMISS_FIELD_MATERIAL_TYPE,Err)
  291. CALL CMISSField_MeshDecompositionSet(MaterialField,Decomposition,Err)
  292. CALL CMISSField_GeometricFieldSet(MaterialField,GeometricField,Err)
  293. CALL CMISSField_NumberOfVariablesSet(MaterialField,FieldMaterialNumberOfVariables,Err)
  294. CALL CMISSField_NumberOfComponentsSet(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,FieldMaterialNumberOfComponents,Err)
  295. CALL CMISSField_ComponentMeshComponentSet(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,Err)
  296. CALL CMISSField_ComponentMeshComponentSet(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,2,2,Err)
  297. CALL CMISSField_ComponentMeshComponentSet(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,3,3,Err)
  298. CALL CMISSField_CreateFinish(MaterialField,Err)
  299. !Set isotropic elasticity material parameters - Young's Modulus & Poisson's Ratio
  300. CALL CMISSField_ComponentValuesInitialise(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1, &
  301. & 10.0E3_CMISSDP, &
  302. & Err) !E1
  303. CALL CMISSField_ComponentValuesInitialise(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,2, &
  304. & 10.0E3_CMISSDP, &
  305. & Err) !E2
  306. CALL CMISSField_ComponentValuesInitialise(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,3, &
  307. & 10.0E3_CMISSDP, &
  308. & Err) !E3
  309. CALL CMISSField_ComponentValuesInitialise(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,4,0.3_CMISSDP, &
  310. & Err) !v13
  311. CALL CMISSField_ComponentValuesInitialise(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,5,0.3_CMISSDP, &
  312. & Err) !v23
  313. CALL CMISSField_ComponentValuesInitialise(MaterialField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,6,0.3_CMISSDP, &
  314. & Err) !v12
  315. !Create a Elasticity Class, Linear Elasticity type, no subtype, EquationsSet
  316. CALL CMISSEquationsSet_Initialise(EquationsSet,Err)
  317. CALL CMISSField_Initialise(EquationsSetField,Err)
  318. CALL CMISSEquationsSet_CreateStart(EquationSetUserNumber,Region,GeometricField,CMISS_EQUATIONS_SET_ELASTICITY_CLASS, &
  319. & CMISS_EQUATIONS_SET_LINEAR_ELASTICITY_TYPE,CMISS_EQUATIONS_SET_THREE_DIMENSIONAL_SUBTYPE,EquationsSetFieldUserNumber, &
  320. & EquationsSetField,EquationsSet,Err)
  321. CALL CMISSEquationsSet_CreateFinish(EquationsSet,Err)
  322. CALL CMISSEquationsSet_DependentCreateStart(EquationsSet,FieldDependentUserNumber,DependentField,Err)
  323. CALL CMISSEquationsSet_DependentCreateFinish(EquationsSet,Err)
  324. CALL CMISSEquationsSet_MaterialsCreateStart(EquationsSet,FieldMaterialUserNumber,MaterialField,Err)
  325. CALL CMISSEquationsSet_MaterialsCreateFinish(EquationsSet,Err)
  326. !Create the equations set equations
  327. CALL CMISSEquations_Initialise(Equations,Err)
  328. CALL CMISSEquationsSet_EquationsCreateStart(EquationsSet,Equations,Err)
  329. CALL CMISSEquations_SparsityTypeSet(EQUATIONS,CMISS_EQUATIONS_SPARSE_MATRICES,Err)
  330. !CMISS_EQUATIONS_SPARSE_MATRICES=1 !<Use sparse matrices for the equations.
  331. !CMISS_EQUATIONS_FULL_MATRICES=2 !<Use fully populated matrices for the equations.
  332. CALL CMISSEquations_OutputTypeSet(EQUATIONS,CMISS_EQUATIONS_ELEMENT_MATRIX_OUTPUT,Err)
  333. !CMISS_EQUATIONS_NO_OUTPUT !<No output from the equations.
  334. !CMISS_EQUATIONS_TIMING_OUTPUT !<Timing information output.
  335. !CMISS_EQUATIONS_MATRIX_OUTPUT !<All below and equation matrices output.
  336. !CMISS_EQUATIONS_ELEMENT_MATRIX_OUTPUT !<All below and Element matrices output.
  337. CALL CMISSEquationsSet_EquationsCreateFinish(EquationsSet,Err)
  338. !Define the problem
  339. CALL CMISSProblem_Initialise(Problem,Err)
  340. CALL CMISSProblem_CreateStart(ProblemUserNumber,Problem,Err)
  341. CALL CMISSProblem_SpecificationSet(Problem,CMISS_PROBLEM_ELASTICITY_CLASS,CMISS_PROBLEM_LINEAR_ELASTICITY_TYPE, &
  342. & CMISS_PROBLEM_NO_SUBTYPE,Err)
  343. CALL CMISSProblem_CreateFinish(Problem,Err)
  344. !Create the problem control loop
  345. CALL CMISSProblem_ControlLoopCreateStart(Problem,Err)
  346. CALL CMISSProblem_ControlLoopCreateFinish(Problem,Err)
  347. !Start the creation of the Problem solvers
  348. !Create the problem solvers
  349. CALL CMISSSolver_Initialise(Solver,Err)
  350. CALL CMISSProblem_SolversCreateStart(Problem,Err)
  351. CALL CMISSProblem_SolverGet(Problem,CMISS_CONTROL_LOOP_NODE,1,Solver,Err)
  352. CALL CMISSSolver_OutputTypeSet(SOLVER,CMISS_SOLVER_MATRIX_OUTPUT,Err)
  353. !CMISS_SOLVER_NO_OUTPUT !<No output from the solver routines. \see OPENCMISS_SolverOutputTypes,OPENCMISS
  354. !CMISS_SOLVER_PROGRESS_OUTPUT !<Progress output from solver routines.
  355. !CMISS_SOLVER_TIMING_OUTPUT !<Timing output from the solver routines plus below.
  356. !CMISS_SOLVER_SOLVER_OUTPUT !<Solver specific output from the solver routines plus below.
  357. !CMISS_SOLVER_MATRIX_OUTPUT !<Solver matrices output from the solver routines plus below.
  358. CALL CMISSSolver_LibraryTypeSet(SOLVER,CMISS_SOLVER_PETSC_LIBRARY,Err)
  359. !CMISS_SOLVER_CMISS_LIBRARY !<CMISS (internal) solver library.
  360. !CMISS_SOLVER_PETSC_LIBRARY !<PETSc solver library.
  361. !CMISS_SOLVER_MUMPS_LIBRARY !<MUMPS solver library.
  362. !CMISS_SOLVER_SUPERLU_LIBRARY !<SuperLU solver library.
  363. !CMISS_SOLVER_SPOOLES_LIBRARY !<SPOOLES solver library.
  364. !CMISS_SOLVER_UMFPACK_LIBRARY !<UMFPACK solver library.
  365. !CMISS_SOLVER_LUSOL_LIBRARY !<LUSOL solver library.
  366. !CMISS_SOLVER_ESSL_LIBRARY !<ESSL solver library.
  367. !CMISS_SOLVER_LAPACK_LIBRARY !<LAPACK solver library.
  368. !CMISS_SOLVER_TAO_LIBRARY !<TAO solver library.
  369. !CMISS_SOLVER_HYPRE_LIBRARY !<Hypre solver library.
  370. CALL CMISSSolver_LinearTypeSet(SOLVER,CMISS_SOLVER_LINEAR_DIRECT_SOLVE_TYPE,Err)
  371. !CMISS_SOLVER_LINEAR_DIRECT_SOLVE_TYPE !<Direct linear solver type.
  372. !CMISS_SOLVER_LINEAR_ITERATIVE_SOLVE_TYPE !<Iterative linear solver type.
  373. CALL CMISSProblem_SolversCreateFinish(Problem,Err)
  374. !Create the problem solver equations
  375. CALL CMISSSolver_Initialise(Solver,Err)
  376. CALL CMISSSolverEquations_Initialise(SolverEquations,Err)
  377. CALL CMISSProblem_SolverEquationsCreateStart(Problem,Err)
  378. CALL CMISSProblem_SolverGet(Problem,CMISS_CONTROL_LOOP_NODE,1,Solver,Err)
  379. CALL CMISSSolver_SolverEquationsGet(Solver,SolverEquations,Err)
  380. CALL CMISSSolverEquations_SparsityTypeSet(SolverEquations,CMISS_SOLVER_SPARSE_MATRICES,Err)
  381. !CMISS_SOLVER_SPARSE_MATRICES !<Use sparse solver matrices.
  382. !CMISS_SOLVER_FULL_MATRICES !<Use fully populated solver matrices.
  383. CALL CMISSSolverEquations_EquationsSetAdd(SolverEquations,EquationsSet,EquationsSetIndex,Err)
  384. CALL CMISSProblem_SolverEquationsCreateFinish(Problem,Err)
  385. !Prescribe boundary conditions
  386. CALL CMISSBoundaryConditions_Initialise(BoundaryConditions,Err)
  387. CALL CMISSSolverEquations_BoundaryConditionsCreateStart(SolverEquations,BoundaryConditions,Err)
  388. !Fix nodes 1,3,5,7 at x=0
  389. CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,1,1, &
  390. & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
  391. CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,3,1, &
  392. & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
  393. CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,5,1, &
  394. & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
  395. CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,7,1, &
  396. & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
  397. !Fix nodes 1,2,5,6 at y=0
  398. CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,1,2, &
  399. & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
  400. CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,2,2, &
  401. & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
  402. CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,5,2, &
  403. & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
  404. CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,6,2, &
  405. & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
  406. !Fix nodes 1,2,3,4 at x=0
  407. CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,1,3, &
  408. & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
  409. CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,2,3, &
  410. & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
  411. CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,3,3, &
  412. & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
  413. CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,4,3, &
  414. & CMISS_BOUNDARY_CONDITION_FIXED,ZERO,Err)
  415. !Apply force at nodes 1,2,3,4 at x=l
  416. CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_DELUDELN_VARIABLE_TYPE,1,1,2,1, &
  417. & CMISS_BOUNDARY_CONDITION_FIXED, &
  418. & -400.0_CMISSDP,Err)
  419. CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_DELUDELN_VARIABLE_TYPE,1,1,4,1, &
  420. & CMISS_BOUNDARY_CONDITION_FIXED, &
  421. & -400.0_CMISSDP,Err)
  422. CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_DELUDELN_VARIABLE_TYPE,1,1,6,1, &
  423. & CMISS_BOUNDARY_CONDITION_FIXED, &
  424. & -400.0_CMISSDP,Err)
  425. CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField,CMISS_FIELD_DELUDELN_VARIABLE_TYPE,1,1,8,1, &
  426. & CMISS_BOUNDARY_CONDITION_FIXED, &
  427. & -400.0_CMISSDP,Err)
  428. CALL CMISSSolverEquations_BoundaryConditionsCreateFinish(SolverEquations,Err)
  429. !=SOLVE Problem==================================================================================================================
  430. !Solve the Problem
  431. CALL CMISSProblem_Solve(Problem,Err)
  432. !=OUTPUT SOLUTION================================================================================================================
  433. !!TODO:: Output reaction forces in ipnode files
  434. EXPORT_FIELD=.TRUE.
  435. IF(EXPORT_FIELD) THEN
  436. CALL CMISSFields_Initialise(Fields,Err)
  437. CALL CMISSFields_Create(Region,Fields,Err)
  438. CALL CMISSFields_NodesExport(Fields,"LinearElasticity3DLinearLagrangeBasisExample","FORTRAN",Err)
  439. CALL CMISSFields_ElementsExport(Fields,"LinearElasticity3DLinearLagrangeBasisExample","FORTRAN",Err)
  440. CALL CMISSFields_Finalise(Fields,Err)
  441. ENDIF
  442. CALL CMISSFinalise(Err)
  443. WRITE(*,'(A)') "Program successfully completed."
  444. STOP
  445. END PROGRAM LinearElasticity3DLagrangeBasis