PageRenderTime 229ms CodeModel.GetById 17ms RepoModel.GetById 1ms app.codeStats 1ms

/src/characteristic_equation_routines.f90

http://github.com/adamreeve/cm
FORTRAN Modern | 1457 lines | 1167 code | 74 blank | 216 comment | 27 complexity | aec5fbbc27d8bbd27383ec53537d0aec MD5 | raw file

Large files files are truncated, but you can click here to view the full file

  1. !> \file
  2. !> \author David Ladd
  3. !> \brief This module handles the characteristic equation routines. These
  4. !> equations are often used in concert with 1D fluid modelling to describe
  5. !> wave propagation phenomena, which is particularly useful for models of
  6. !> vascular trees. These equations are also often solved using a discontinuous
  7. !> nodal solution method, rather than FEM.
  8. !>
  9. !> \section LICENSE
  10. !>
  11. !> Version: MPL 1.1/GPL 2.0/LGPL 2.1
  12. !>
  13. !> The contents of this file are subject to the Mozilla Public License
  14. !> Version 1.1 (the "License"); you may not use this file except in
  15. !> compliance with the License. You may obtain a copy of the License at
  16. !> http://www.mozilla.org/MPL/
  17. !>
  18. !> Software distributed under the License is distributed on an "AS IS"
  19. !> basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
  20. !> License for the specific language governing rights and limitations
  21. !> under the License.
  22. !>
  23. !> The Original Code is OpenCMISS
  24. !>
  25. !> The Initial Developer of the Original Code is University of Auckland,
  26. !> Auckland, New Zealand, the University of Oxford, Oxford, United
  27. !> Kingdom and King's College, London, United Kingdom. Portions created
  28. !> by the University of Auckland, the University of Oxford and King's
  29. !> College, London are Copyright (C) 2007-2010 by the University of
  30. !> Auckland, the University of Oxford and King's College, London.
  31. !> All Rights Reserved.
  32. !>
  33. !> Contributor(s): Soroush Safaei
  34. !>
  35. !> Alternatively, the contents of this file may be used under the terms of
  36. !> either the GNU General Public License Version 2 or later (the "GPL"), or
  37. !> the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  38. !> in which case the provisions of the GPL or the LGPL are applicable instead
  39. !> of those above. If you wish to allow use of your version of this file only
  40. !> under the terms of either the GPL or the LGPL, and not to allow others to
  41. !> use your version of this file under the terms of the MPL, indicate your
  42. !> decision by deleting the provisions above and replace them with the notice
  43. !> and other provisions required by the GPL or the LGPL. If you do not delete
  44. !> the provisions above, a recipient may use your version of this file under
  45. !> the terms of any one of the MPL, the GPL or the LGPL.
  46. !>
  47. !>This module handles all characteristic equation routines.
  48. MODULE CHARACTERISTIC_EQUATION_ROUTINES
  49. USE BASE_ROUTINES
  50. USE BASIS_ROUTINES
  51. USE BOUNDARY_CONDITIONS_ROUTINES
  52. USE CONSTANTS
  53. USE CONTROL_LOOP_ROUTINES
  54. USE DISTRIBUTED_MATRIX_VECTOR
  55. USE DOMAIN_MAPPINGS
  56. USE EQUATIONS_ROUTINES
  57. USE EQUATIONS_MAPPING_ROUTINES
  58. USE EQUATIONS_MATRICES_ROUTINES
  59. USE EQUATIONS_SET_CONSTANTS
  60. USE FIELD_ROUTINES
  61. USE FIELD_IO_ROUTINES
  62. USE FLUID_MECHANICS_IO_ROUTINES
  63. USE INPUT_OUTPUT
  64. USE ISO_VARYING_STRING
  65. USE KINDS
  66. USE MATHS
  67. USE MATRIX_VECTOR
  68. USE MESH_ROUTINES
  69. USE NODE_ROUTINES
  70. USE PROBLEM_CONSTANTS
  71. USE STRINGS
  72. USE SOLVER_ROUTINES
  73. USE TIMER
  74. USE TYPES
  75. IMPLICIT NONE
  76. PRIVATE
  77. PUBLIC Characteristic_EquationsSet_SubtypeSet
  78. PUBLIC Characteristic_EquationsSet_SolutionMethodSet
  79. PUBLIC Characteristic_EquationsSet_Setup
  80. PUBLIC Characteristic_NodalJacobianEvaluate
  81. PUBLIC Characteristic_NodalResidualEvaluate
  82. CONTAINS
  83. !
  84. !================================================================================================================================
  85. !
  86. !>Sets/changes the solution method for a Characteristic equation type of an fluid mechanics equations set class.
  87. SUBROUTINE Characteristic_EquationsSet_SolutionMethodSet(equationsSet,solutionMethod,err,error,*)
  88. !Argument variables
  89. TYPE(EQUATIONS_SET_TYPE), POINTER :: equationsSet !<A pointer to the equations set to set the solution method for
  90. INTEGER(INTG), INTENT(IN) :: solutionMethod !<The solution method to set
  91. INTEGER(INTG), INTENT(OUT) :: err !<The error code
  92. TYPE(VARYING_STRING), INTENT(OUT) :: error !<The error string
  93. !Local Variables
  94. TYPE(VARYING_STRING) :: localError
  95. CALL ENTERS("Characteristic_EquationsSet_SolutionMethodSet",err,error,*999)
  96. IF(ASSOCIATED(equationsSet)) THEN
  97. SELECT CASE(equationsSet%SUBTYPE)
  98. CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
  99. SELECT CASE(solutionMethod)
  100. CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD)
  101. CALL FLAG_ERROR("Not implemented.",err,error,*999)
  102. CASE(EQUATIONS_SET_NODAL_SOLUTION_METHOD)
  103. equationsSet%SOLUTION_METHOD=EQUATIONS_SET_NODAL_SOLUTION_METHOD
  104. CASE(EQUATIONS_SET_BEM_SOLUTION_METHOD)
  105. CALL FLAG_ERROR("Not implemented.",err,error,*999)
  106. CASE(EQUATIONS_SET_FD_SOLUTION_METHOD)
  107. CALL FLAG_ERROR("Not implemented.",err,error,*999)
  108. CASE(EQUATIONS_SET_FV_SOLUTION_METHOD)
  109. CALL FLAG_ERROR("Not implemented.",err,error,*999)
  110. CASE(EQUATIONS_SET_GFEM_SOLUTION_METHOD)
  111. CALL FLAG_ERROR("Not implemented.",err,error,*999)
  112. CASE(EQUATIONS_SET_GFV_SOLUTION_METHOD)
  113. CALL FLAG_ERROR("Not implemented.",err,error,*999)
  114. CASE DEFAULT
  115. localError="The specified solution method of "//TRIM(NUMBER_TO_VSTRING(solutionMethod,"*",err,error))// &
  116. & " is invalid."
  117. CALL FLAG_ERROR(localError,err,error,*999)
  118. END SELECT
  119. CASE DEFAULT
  120. localError="Equations set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
  121. & " is not valid for a Characteristic equation type of a fluid mechanics equations set class."
  122. CALL FLAG_ERROR(localError,err,error,*999)
  123. END SELECT
  124. ELSE
  125. CALL FLAG_ERROR("Equations set is not associated.",err,error,*999)
  126. ENDIF
  127. CALL EXITS("Characteristic_EquationsSet_SolutionMethodSet")
  128. RETURN
  129. 999 CALL ERRORS("Characteristic_EquationsSet_SolutionMethodSet",err,error)
  130. CALL EXITS("Characteristic_EquationsSet_SolutionMethodSet")
  131. RETURN 1
  132. END SUBROUTINE Characteristic_EquationsSet_SolutionMethodSet
  133. !
  134. !================================================================================================================================
  135. !
  136. !>Sets/changes the equation subtype for a Characteristic type of a fluid mechanics equations set class.
  137. SUBROUTINE Characteristic_EquationsSet_SubtypeSet(equationsSet,equationsSetSubtype,err,error,*)
  138. !Argument variables
  139. TYPE(EQUATIONS_SET_TYPE), POINTER :: equationsSet !<A pointer to the equations set to set the equation subtype for
  140. INTEGER(INTG), INTENT(IN) :: equationsSetSubtype !<The equation subtype to set
  141. INTEGER(INTG), INTENT(OUT) :: err !<The error code
  142. TYPE(VARYING_STRING), INTENT(OUT) :: error !<The error string
  143. !Local Variables
  144. TYPE(VARYING_STRING) :: localError
  145. CALL ENTERS("Characteristic_EquationsSet_SubtypeSet",err,error,*999)
  146. IF(ASSOCIATED(equationsSet)) THEN
  147. SELECT CASE(equationsSetSubtype)
  148. CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE)
  149. equationsSet%CLASS=EQUATIONS_SET_FLUID_MECHANICS_CLASS
  150. equationsSet%TYPE=EQUATIONS_SET_CHARACTERISTIC_EQUATION_TYPE
  151. equationsSet%SUBTYPE=EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE
  152. CASE(EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
  153. equationsSet%CLASS=EQUATIONS_SET_FLUID_MECHANICS_CLASS
  154. equationsSet%TYPE=EQUATIONS_SET_CHARACTERISTIC_EQUATION_TYPE
  155. equationsSet%SUBTYPE=EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE
  156. CASE DEFAULT
  157. localError="Equations set subtype "//TRIM(NUMBER_TO_VSTRING(equationsSetSubtype,"*",err,error))// &
  158. & " is not valid for a Characteristic fluid type of a fluid mechanics equations set class."
  159. CALL FLAG_ERROR(localError,err,error,*999)
  160. END SELECT
  161. ELSE
  162. CALL FLAG_ERROR("Equations set is not associated.",err,error,*999)
  163. ENDIF
  164. CALL EXITS("Characteristic_EquationsSet_SubtypeSet")
  165. RETURN
  166. 999 CALL ERRORS("Characteristic_EquationsSet_SubtypeSet",err,error)
  167. CALL EXITS("Characteristic_EquationsSet_SubtypeSet")
  168. RETURN 1
  169. END SUBROUTINE Characteristic_EquationsSet_SubtypeSet
  170. !
  171. !================================================================================================================================
  172. !
  173. !>Sets up the Characteristic equations fluid setup.
  174. SUBROUTINE Characteristic_EquationsSet_Setup(equationsSet,equationsSetSetup,err,error,*)
  175. !Argument variables
  176. TYPE(EQUATIONS_SET_TYPE), POINTER :: equationsSet !<A pointer to the equations set to setup
  177. TYPE(EQUATIONS_SET_SETUP_TYPE), INTENT(INOUT) :: equationsSetSetup !<The equations set setup information
  178. INTEGER(INTG), INTENT(OUT) :: err !<The error code
  179. TYPE(VARYING_STRING), INTENT(OUT) :: error !<The error string
  180. !Local Variables
  181. TYPE(EQUATIONS_TYPE), POINTER :: equations
  182. TYPE(EQUATIONS_MAPPING_TYPE), POINTER :: equationsMapping
  183. TYPE(EQUATIONS_MATRICES_TYPE), POINTER :: equationsMatrices
  184. TYPE(EQUATIONS_SET_MATERIALS_TYPE), POINTER :: equationsMaterials
  185. TYPE(DECOMPOSITION_TYPE), POINTER :: geometricDecomposition
  186. INTEGER(INTG) :: numberOfDimensions,componentIdx
  187. INTEGER(INTG) :: geometricScalingType,geometricMeshComponent,geometricComponentNumber
  188. INTEGER(INTG) :: dependentFieldNumberOfVariables,dependentFieldNumberOfComponents,numberComponentsU2
  189. INTEGER(INTG) :: independentFieldNumberOfComponents,independentFieldNumberOfVariables,numberComponentsV,numberComponentsU1
  190. INTEGER(INTG) :: materialsFieldNumberOfVariables,materialsField1DNumberOfComponents,materialsFieldCoupledNumberOfComponents
  191. TYPE(VARYING_STRING) :: localError
  192. CALL ENTERS("Characteristic_EquationsSet_Setup",err,error,*999)
  193. NULLIFY(equations)
  194. NULLIFY(equationsMapping)
  195. NULLIFY(equationsMatrices)
  196. NULLIFY(equationsMaterials)
  197. NULLIFY(geometricDecomposition)
  198. IF(ASSOCIATED(equationsSet)) THEN
  199. SELECT CASE(equationsSet%SUBTYPE)
  200. CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
  201. SELECT CASE(equationsSetSetup%SETUP_TYPE)
  202. !-----------------------------------------------------------------
  203. ! I n i t i a l s e t u p
  204. !-----------------------------------------------------------------
  205. CASE(EQUATIONS_SET_SETUP_INITIAL_TYPE)
  206. SELECT CASE(equationsSet%SUBTYPE)
  207. CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
  208. SELECT CASE(equationsSetSetup%ACTION_TYPE)
  209. CASE(EQUATIONS_SET_SETUP_START_ACTION)
  210. CALL Characteristic_EquationsSet_SolutionMethodSet(equationsSet, &
  211. & EQUATIONS_SET_NODAL_SOLUTION_METHOD,err,error,*999)
  212. equationsSet%SOLUTION_METHOD=EQUATIONS_SET_NODAL_SOLUTION_METHOD
  213. CASE(EQUATIONS_SET_SETUP_FINISH_ACTION)
  214. !Do nothing
  215. CASE DEFAULT
  216. localError="The action type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup%ACTION_TYPE, &
  217. & "*",err,error))// " for a setup type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup% &
  218. & SETUP_TYPE,"*",err,error))// " is not implemented for a characteristic equations set."
  219. CALL FLAG_ERROR(localError,err,error,*999)
  220. END SELECT
  221. CASE DEFAULT
  222. localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
  223. & " for a setup sub type of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
  224. & " is invalid for a characteristic equations set."
  225. CALL FLAG_ERROR(localError,err,error,*999)
  226. END SELECT
  227. !-----------------------------------------------------------------
  228. ! G e o m e t r i c f i e l d
  229. !-----------------------------------------------------------------
  230. CASE(EQUATIONS_SET_SETUP_GEOMETRY_TYPE)
  231. SELECT CASE(equationsSet%SUBTYPE)
  232. CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
  233. !Do nothing???
  234. CASE DEFAULT
  235. localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
  236. & " is invalid for a characteristic equations set."
  237. CALL FLAG_ERROR(localError,err,error,*999)
  238. END SELECT
  239. !-----------------------------------------------------------------
  240. ! D e p e n d e n t f i e l d
  241. !-----------------------------------------------------------------
  242. CASE(EQUATIONS_SET_SETUP_DEPENDENT_TYPE)
  243. SELECT CASE(equationsSet%SUBTYPE)
  244. CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
  245. SELECT CASE(equationsSetSetup%ACTION_TYPE)
  246. !Set start action
  247. CASE(EQUATIONS_SET_SETUP_START_ACTION)
  248. IF(equationsSet%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
  249. !Create the auto created dependent field
  250. !start field creation with name 'DEPENDENT_FIELD'
  251. CALL FIELD_CREATE_START(equationsSetSetup%FIELD_USER_NUMBER,equationsSet%REGION, &
  252. & equationsSet%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
  253. !start creation of a new field
  254. CALL FIELD_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_GENERAL_TYPE,err,error,*999)
  255. !label the field
  256. CALL FIELD_LABEL_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
  257. !define new created field to be dependent
  258. CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
  259. & FIELD_DEPENDENT_TYPE,err,error,*999)
  260. !look for decomposition rule already defined
  261. CALL FIELD_MESH_DECOMPOSITION_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,geometricDecomposition, &
  262. & err,error,*999)
  263. !apply decomposition rule found on new created field
  264. CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
  265. & geometricDecomposition,err,error,*999)
  266. !point new field to geometric field
  267. CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,equationsSet%GEOMETRY% &
  268. & GEOMETRIC_FIELD,err,error,*999)
  269. !set number of variables to 5 (U,DELUDELN,V,U1,U2)=>(Q,A;dQ,dA;W(1,2);pCellML,Pressure)
  270. dependentFieldNumberOfVariables=5
  271. CALL FIELD_NUMBER_OF_VARIABLES_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
  272. & dependentFieldNumberOfVariables,err,error,*999)
  273. CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,[FIELD_U_VARIABLE_TYPE, &
  274. & FIELD_DELUDELN_VARIABLE_TYPE,FIELD_V_VARIABLE_TYPE,FIELD_U1_VARIABLE_TYPE,FIELD_U2_VARIABLE_TYPE], &
  275. & err,error,*999)
  276. ! set dimension
  277. CALL FIELD_DIMENSION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
  278. & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
  279. CALL FIELD_DIMENSION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE, &
  280. & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
  281. CALL FIELD_DIMENSION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_V_VARIABLE_TYPE, &
  282. & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
  283. CALL FIELD_DIMENSION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_U1_VARIABLE_TYPE, &
  284. & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
  285. CALL FIELD_DIMENSION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_U2_VARIABLE_TYPE, &
  286. & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
  287. ! set data type
  288. CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
  289. & FIELD_DP_TYPE,err,error,*999)
  290. CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE, &
  291. & FIELD_DP_TYPE,err,error,*999)
  292. CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_V_VARIABLE_TYPE, &
  293. & FIELD_DP_TYPE,err,error,*999)
  294. CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_U1_VARIABLE_TYPE, &
  295. & FIELD_DP_TYPE,err,error,*999)
  296. CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_U2_VARIABLE_TYPE, &
  297. & FIELD_DP_TYPE,err,error,*999)
  298. ! number of components for U,DELUDELN=2 (Q,A)
  299. dependentFieldNumberOfComponents=2
  300. CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
  301. & FIELD_U_VARIABLE_TYPE,dependentFieldNumberOfComponents,err,error,*999)
  302. CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
  303. & FIELD_DELUDELN_VARIABLE_TYPE,dependentFieldNumberOfComponents,err,error,*999)
  304. ! IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
  305. numberComponentsV=2
  306. numberComponentsU1=1
  307. numberComponentsU2=1
  308. ! ENDIF
  309. ! set number of components for V
  310. CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
  311. & FIELD_V_VARIABLE_TYPE,numberComponentsV,err,error,*999)
  312. CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
  313. & FIELD_U1_VARIABLE_TYPE,numberComponentsU1,err,error,*999)
  314. CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
  315. & FIELD_U2_VARIABLE_TYPE,numberComponentsU2,err,error,*999)
  316. CALL FIELD_COMPONENT_MESH_COMPONENT_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
  317. & 1,geometricMeshComponent,err,error,*999)
  318. !Default to the geometric interpolation setup for U,dUdN
  319. DO componentIdx=1,dependentFieldNumberOfComponents
  320. CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
  321. & FIELD_U_VARIABLE_TYPE,componentIdx,geometricMeshComponent,err,error,*999)
  322. CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
  323. & FIELD_DELUDELN_VARIABLE_TYPE,componentIdx,geometricMeshComponent,err,error,*999)
  324. END DO
  325. !Default to the geometric interpolation setup for V
  326. CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
  327. & FIELD_V_VARIABLE_TYPE,1,geometricMeshComponent,err,error,*999)
  328. CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
  329. & FIELD_U1_VARIABLE_TYPE,1,geometricMeshComponent,err,error,*999)
  330. CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
  331. & FIELD_U2_VARIABLE_TYPE,1,geometricMeshComponent,err,error,*999)
  332. SELECT CASE(equationsSet%SOLUTION_METHOD)
  333. !Specify nodal solution method
  334. CASE(EQUATIONS_SET_NODAL_SOLUTION_METHOD)
  335. ! (U, dUdN); 2 components (Q,A)
  336. DO componentIdx=1,dependentFieldNumberOfComponents
  337. CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
  338. & FIELD_U_VARIABLE_TYPE,componentIdx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
  339. CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
  340. & FIELD_DELUDELN_VARIABLE_TYPE,componentIdx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
  341. END DO
  342. ! V; 2 components (W1,W2 )
  343. DO componentIdx=1,numberComponentsV
  344. CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
  345. & FIELD_V_VARIABLE_TYPE,componentIdx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
  346. ENDDO
  347. DO componentIdx=1,numberComponentsU1
  348. CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
  349. & FIELD_U1_VARIABLE_TYPE,componentIdx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
  350. ENDDO
  351. DO componentIdx=1,numberComponentsU2
  352. CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
  353. & FIELD_U2_VARIABLE_TYPE,componentIdx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
  354. ENDDO
  355. CALL FIELD_SCALING_TYPE_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,geometricScalingType, &
  356. & err,error,*999)
  357. CALL FIELD_SCALING_TYPE_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD,geometricScalingType, &
  358. & err,error,*999)
  359. CASE DEFAULT
  360. localError="The solution method of " &
  361. & //TRIM(NUMBER_TO_VSTRING(equationsSet%SOLUTION_METHOD,"*",err,error))// " is invalid."
  362. CALL FLAG_ERROR(localError,err,error,*999)
  363. END SELECT
  364. ELSE
  365. !Check the user specified field
  366. CALL FIELD_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_GENERAL_TYPE,err,error,*999)
  367. CALL FIELD_DEPENDENT_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_DEPENDENT_TYPE,err,error,*999)
  368. dependentFieldNumberOfVariables=4 ! U,dUdN,V,U2
  369. CALL FIELD_NUMBER_OF_VARIABLES_CHECK(equationsSetSetup%FIELD,dependentFieldNumberOfVariables,err,error,*999)
  370. CALL FIELD_VARIABLE_TYPES_CHECK(equationsSetSetup%FIELD,[FIELD_U_VARIABLE_TYPE, &
  371. & FIELD_DELUDELN_VARIABLE_TYPE,FIELD_V_VARIABLE_TYPE,FIELD_U2_VARIABLE_TYPE],err,error,*999)
  372. CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE, &
  373. & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
  374. CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_DELUDELN_VARIABLE_TYPE, &
  375. & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
  376. CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE, &
  377. & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
  378. CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_U2_VARIABLE_TYPE, &
  379. & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
  380. CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999)
  381. CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,FIELD_DP_TYPE, &
  382. & err,error,*999)
  383. CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999)
  384. CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_U2_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999)
  385. CALL FIELD_NUMBER_OF_COMPONENTS_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
  386. & numberOfDimensions,err,error,*999)
  387. !calculate number of components (Q,A) for U and dUdN
  388. dependentFieldNumberOfComponents=2
  389. CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE, &
  390. & dependentFieldNumberOfComponents,err,error,*999)
  391. CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_DELUDELN_VARIABLE_TYPE, &
  392. & dependentFieldNumberOfComponents,err,error,*999)
  393. IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
  394. numberComponentsV=3
  395. numberComponentsU2=1
  396. ELSE
  397. numberComponentsV=2
  398. numberComponentsU2=1
  399. ENDIF
  400. CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE, &
  401. & numberComponentsV,err,error,*999)
  402. CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE, &
  403. & numberComponentsU2,err,error,*999)
  404. SELECT CASE(equationsSet%SOLUTION_METHOD)
  405. CASE(EQUATIONS_SET_NODAL_SOLUTION_METHOD)
  406. CALL FIELD_COMPONENT_INTERPOLATION_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE,1, &
  407. & FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
  408. CALL FIELD_COMPONENT_INTERPOLATION_CHECK(equationsSetSetup%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,1, &
  409. & FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
  410. CALL FIELD_COMPONENT_INTERPOLATION_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE,1, &
  411. & FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
  412. CALL FIELD_COMPONENT_INTERPOLATION_CHECK(equationsSetSetup%FIELD,FIELD_U2_VARIABLE_TYPE,1, &
  413. & FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
  414. CASE DEFAULT
  415. localError="The solution method of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SOLUTION_METHOD, &
  416. & "*",err,error))//" is invalid."
  417. CALL FLAG_ERROR(localError,err,error,*999)
  418. END SELECT
  419. ENDIF
  420. !Specify finish action
  421. CASE(EQUATIONS_SET_SETUP_FINISH_ACTION)
  422. IF(equationsSet%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
  423. CALL FIELD_CREATE_FINISH(equationsSet%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
  424. ENDIF
  425. CASE DEFAULT
  426. localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
  427. & " for a setup sub type of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
  428. & " is invalid for a characteristic equations set."
  429. CALL FLAG_ERROR(localError,err,error,*999)
  430. END SELECT
  431. CASE DEFAULT
  432. localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
  433. & " for a setup sub type of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
  434. & " is invalid for a characteristic equations set."
  435. CALL FLAG_ERROR(localError,err,error,*999)
  436. END SELECT
  437. !-----------------------------------------------------------------
  438. ! I n d e p e n d e n t f i e l d
  439. !-----------------------------------------------------------------
  440. CASE(EQUATIONS_SET_SETUP_INDEPENDENT_TYPE)
  441. SELECT CASE(equationsSet%SUBTYPE)
  442. CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
  443. SELECT CASE(equationsSetSetup%ACTION_TYPE)
  444. !Set start action
  445. CASE(EQUATIONS_SET_SETUP_START_ACTION)
  446. independentFieldNumberOfComponents=2 ! normalDirection for wave relative to node for W1,W2
  447. IF(equationsSet%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
  448. !Create the auto created independent field
  449. !start field creation with name 'INDEPENDENT_FIELD'
  450. CALL FIELD_CREATE_START(equationsSetSetup%FIELD_USER_NUMBER,equationsSet%REGION, &
  451. & equationsSet%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
  452. !start creation of a new field
  453. CALL FIELD_TYPE_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,FIELD_GENERAL_TYPE,err,error,*999)
  454. !label the field
  455. CALL FIELD_LABEL_SET(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,"Independent Field",err,error, &
  456. & *999)
  457. !define new created field to be independent
  458. CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, &
  459. & FIELD_INDEPENDENT_TYPE,err,error,*999)
  460. !look for decomposition rule already defined
  461. CALL FIELD_MESH_DECOMPOSITION_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,geometricDecomposition, &
  462. & err,error,*999)
  463. !apply decomposition rule found on new created field
  464. CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, &
  465. & geometricDecomposition,err,error,*999)
  466. !point new field to geometric field
  467. CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,equationsSet% &
  468. & GEOMETRY%GEOMETRIC_FIELD,err,error,*999)
  469. !set number of variables to 1 (1 for U)
  470. independentFieldNumberOfVariables=1
  471. CALL FIELD_NUMBER_OF_VARIABLES_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, &
  472. & independentFieldNumberOfVariables,err,error,*999)
  473. CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, &
  474. & [FIELD_U_VARIABLE_TYPE],err,error,*999)
  475. CALL FIELD_DIMENSION_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
  476. & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
  477. ! characteristic normal direction (normalWave) is +/- 1
  478. CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
  479. & FIELD_DP_TYPE,err,error,*999)
  480. CALL FIELD_NUMBER_OF_COMPONENTS_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
  481. & numberOfDimensions,err,error,*999)
  482. !calculate number of components with one component for each dimension
  483. CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, &
  484. & FIELD_U_VARIABLE_TYPE,independentFieldNumberOfComponents,err,error,*999)
  485. CALL FIELD_COMPONENT_MESH_COMPONENT_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
  486. & 1,geometricMeshComponent,err,error,*999)
  487. !Default to the geometric interpolation setup
  488. DO componentIdx=1,independentFieldNumberOfComponents
  489. CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, &
  490. & FIELD_U_VARIABLE_TYPE,componentIdx,geometricMeshComponent,err,error,*999)
  491. END DO
  492. SELECT CASE(equationsSet%SOLUTION_METHOD)
  493. CASE(EQUATIONS_SET_NODAL_SOLUTION_METHOD)
  494. DO componentIdx=1,independentFieldNumberOfComponents
  495. CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, &
  496. & FIELD_U_VARIABLE_TYPE,componentIdx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
  497. END DO !componentIdx
  498. CALL FIELD_SCALING_TYPE_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,geometricScalingType, &
  499. & err,error,*999)
  500. CALL FIELD_SCALING_TYPE_SET(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,geometricScalingType, &
  501. & err,error,*999)
  502. CASE DEFAULT
  503. localError="The solution method of " &
  504. & //TRIM(NUMBER_TO_VSTRING(equationsSet%SOLUTION_METHOD,"*",err,error))// " is invalid."
  505. CALL FLAG_ERROR(localError,err,error,*999)
  506. END SELECT
  507. ELSE
  508. !Check the user specified field
  509. CALL FIELD_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_GENERAL_TYPE,err,error,*999)
  510. CALL FIELD_DEPENDENT_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999)
  511. CALL FIELD_NUMBER_OF_VARIABLES_CHECK(equationsSetSetup%FIELD,1,err,error,*999)
  512. CALL FIELD_VARIABLE_TYPES_CHECK(equationsSetSetup%FIELD,[FIELD_U_VARIABLE_TYPE],err,error,*999)
  513. CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, &
  514. & err,error,*999)
  515. CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999)
  516. CALL FIELD_NUMBER_OF_COMPONENTS_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
  517. & numberOfDimensions,err,error,*999)
  518. CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE, &
  519. & independentFieldNumberOfComponents,err,error,*999)
  520. ENDIF
  521. !Specify finish action
  522. CASE(EQUATIONS_SET_SETUP_FINISH_ACTION)
  523. IF(equationsSet%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
  524. CALL FIELD_CREATE_FINISH(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
  525. CALL FIELD_PARAMETER_SET_CREATE(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
  526. & FIELD_MESH_DISPLACEMENT_SET_TYPE,err,error,*999)
  527. CALL FIELD_PARAMETER_SET_CREATE(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
  528. & FIELD_MESH_VELOCITY_SET_TYPE,err,error,*999)
  529. CALL FIELD_PARAMETER_SET_CREATE(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
  530. & FIELD_BOUNDARY_SET_TYPE,err,error,*999)
  531. ENDIF
  532. CASE DEFAULT
  533. localError="The action type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup%ACTION_TYPE,"*",err,error))// &
  534. & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup%SETUP_TYPE,"*",err,error))// &
  535. & " is invalid for a standard characteristic equations set"
  536. CALL FLAG_ERROR(localError,err,error,*999)
  537. END SELECT
  538. CASE DEFAULT
  539. localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
  540. & " for a setup sub type of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
  541. & " is invalid for a standard characteristic equations set."
  542. CALL FLAG_ERROR(localError,err,error,*999)
  543. END SELECT
  544. !-----------------------------------------------------------------
  545. ! M a t e r i a l s f i e l d
  546. !-----------------------------------------------------------------
  547. CASE(EQUATIONS_SET_SETUP_MATERIALS_TYPE)
  548. SELECT CASE(equationsSet%SUBTYPE)
  549. CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
  550. IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
  551. materialsFieldNumberOfVariables=2 ! 1 U-type container variable w/ 10 components, 1 V-type w/ 2 components
  552. materialsField1DNumberOfComponents=10
  553. materialsFieldCoupledNumberOfComponents=2
  554. ELSE
  555. materialsFieldNumberOfVariables=1 ! 1 U-type container variable w/ 10 components
  556. materialsField1DNumberOfComponents=10
  557. materialsFieldCoupledNumberOfComponents=0
  558. ENDIF
  559. SELECT CASE(equationsSetSetup%ACTION_TYPE)
  560. !Specify start action
  561. CASE(EQUATIONS_SET_SETUP_START_ACTION)
  562. equationsMaterials=>equationsSet%MATERIALS
  563. IF(ASSOCIATED(equationsMaterials)) THEN
  564. IF(equationsMaterials%MATERIALS_FIELD_AUTO_CREATED) THEN
  565. !Create the auto created materials field
  566. !start field creation with name 'MATERIAL_FIELD'
  567. CALL FIELD_CREATE_START(equationsSetSetup%FIELD_USER_NUMBER,equationsSet%REGION, &
  568. & equationsSet%MATERIALS%MATERIALS_FIELD,err,error,*999)
  569. CALL FIELD_TYPE_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD,FIELD_MATERIAL_TYPE,err,error,*999)
  570. !label the field
  571. CALL FIELD_LABEL_SET(equationsMaterials%MATERIALS_FIELD,"Materials Field",err,error,*999)
  572. CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD,FIELD_INDEPENDENT_TYPE, &
  573. & err,error,*999)
  574. CALL FIELD_MESH_DECOMPOSITION_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,geometricDecomposition, &
  575. & err,error,*999)
  576. !apply decomposition rule found on new created field
  577. CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(equationsSet%MATERIALS%MATERIALS_FIELD, &
  578. & geometricDecomposition,err,error,*999)
  579. !point new field to geometric field
  580. CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD,equationsSet%GEOMETRY% &
  581. & GEOMETRIC_FIELD,err,error,*999)
  582. CALL FIELD_NUMBER_OF_VARIABLES_SET(equationsMaterials%MATERIALS_FIELD, &
  583. & materialsFieldNumberOfVariables,err,error,*999)
  584. CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD, &
  585. & [FIELD_U_VARIABLE_TYPE],err,error,*999)
  586. CALL FIELD_DIMENSION_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, &
  587. & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
  588. CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, &
  589. & FIELD_DP_TYPE,err,error,*999)
  590. CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD, &
  591. & FIELD_U_VARIABLE_TYPE,materialsField1DNumberOfComponents,err,error,*999)
  592. CALL FIELD_COMPONENT_MESH_COMPONENT_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD, &
  593. & FIELD_U_VARIABLE_TYPE,1,geometricComponentNumber,err,error,*999)
  594. CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsMaterials%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, &
  595. & 1,geometricComponentNumber,err,error,*999)
  596. DO componentIdx=1,7 !(MU,RHO,K,As,Re,Fr,St)
  597. CALL FIELD_COMPONENT_INTERPOLATION_SET(equationsMaterials%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, &
  598. & componentIdx,FIELD_CONSTANT_INTERPOLATION,ERR,ERROR,*999)
  599. ENDDO
  600. DO componentIdx=8,10 !(A0,E,H0)
  601. CALL FIELD_COMPONENT_INTERPOLATION_SET(equationsMaterials%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, &
  602. & componentIdx,FIELD_NODE_BASED_INTERPOLATION,ERR,ERROR,*999)
  603. ENDDO
  604. !Default the field scaling to that of the geometric field
  605. CALL FIELD_SCALING_TYPE_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,geometricScalingType, &
  606. & err,error,*999)
  607. CALL FIELD_SCALING_TYPE_SET(equationsMaterials%MATERIALS_FIELD,geometricScalingType,err,error,*999)
  608. ELSE
  609. !Check the user specified field
  610. CALL FIELD_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_MATERIAL_TYPE,err,error,*999)
  611. CALL FIELD_DEPENDENT_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999)
  612. CALL FIELD_NUMBER_OF_VARIABLES_CHECK(equationsSetSetup%FIELD,materialsFieldNumberOfVariables,err,error,*999)
  613. IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
  614. CALL FIELD_VARIABLE_TYPES_CHECK(equationsSetSetup%FIELD,[FIELD_U_VARIABLE_TYPE,FIELD_V_VARIABLE_TYPE], &
  615. & err,error,*999)
  616. ELSE
  617. CALL FIELD_VARIABLE_TYPES_CHECK(equationsSetSetup%FIELD,[FIELD_U_VARIABLE_TYPE],err,error,*999)
  618. ENDIF
  619. ! U-variable
  620. CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE, &
  621. & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
  622. CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE, &
  623. & err,error,*999)
  624. CALL FIELD_NUMBER_OF_COMPONENTS_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
  625. & numberOfDimensions,err,error,*999)
  626. CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE, &
  627. & materialsField1DNumberOfComponents,err,error,*999)
  628. IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
  629. ! V-variable
  630. CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE, &
  631. & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
  632. CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE,FIELD_DP_TYPE, &
  633. & err,error,*999)
  634. CALL FIELD_NUMBER_OF_COMPONENTS_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
  635. & numberOfDimensions,err,error,*999)
  636. CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE, &
  637. & materialsFieldCoupledNumberOfComponents,err,error,*999)
  638. ENDIF
  639. ENDIF
  640. ELSE
  641. CALL FLAG_ERROR("Equations set materials is not associated.",err,error,*999)
  642. END IF
  643. !Specify start action
  644. CASE(EQUATIONS_SET_SETUP_FINISH_ACTION)
  645. equationsMaterials=>equationsSet%MATERIALS
  646. IF(ASSOCIATED(equationsMaterials)) THEN
  647. IF(equationsMaterials%MATERIALS_FIELD_AUTO_CREATED) THEN
  648. !Finish creating the materials field
  649. CALL FIELD_CREATE_FINISH(equationsMaterials%MATERIALS_FIELD,err,error,*999)
  650. ! Should be initialized from example file
  651. ENDIF
  652. ELSE
  653. CALL FLAG_ERROR("Equations set materials is not associated.",err,error,*999)
  654. ENDIF
  655. CASE DEFAULT
  656. localError="The action type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup%ACTION_TYPE,"*", &
  657. & err,error))//" for a setup type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup%SETUP_TYPE,"*", &
  658. & err,error))//" is invalid for characteristic equation."
  659. CALL FLAG_ERROR(localError,err,error,*999)
  660. END SELECT
  661. CASE DEFAULT
  662. localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
  663. & " for a setup sub type of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
  664. & " is invalid for a characteristic equation."
  665. CALL FLAG_ERROR(localError,err,error,*999)
  666. END SELECT
  667. !-----------------------------------------------------------------
  668. ! E q u a t i o n s t y p e
  669. !-----------------------------------------------------------------
  670. CASE(EQUATIONS_SET_SETUP_EQUATIONS_TYPE)
  671. SELECT CASE(equationsSet%SUBTYPE)
  672. CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
  673. SELECT CASE(equationsSetSetup%ACTION_TYPE)
  674. CASE(EQUATIONS_SET_SETUP_START_ACTION)
  675. equationsMaterials=>equationsSet%MATERIALS
  676. IF(ASSOCIATED(equationsMaterials)) THEN
  677. IF(equationsMaterials%MATERIALS_FINISHED) THEN
  678. CALL EQUATIONS_CREATE_START(equationsSet,equations,err,error,*999)
  679. CALL EQUATIONS_LINEARITY_TYPE_SET(equations,EQUATIONS_NONLINEAR,err,error,*999)
  680. CALL EQUATIONS_TIME_DEPENDENCE_TYPE_SET(equations,EQUATIONS_STATIC,err,error,*999)
  681. ELSE
  682. CALL FLAG_ERROR("Equations set materials has not been finished.",err,error,*999)
  683. ENDIF
  684. ELSE
  685. CALL FLAG_ERROR("Equations materials is not associated.",err,error,*999)
  686. ENDIF
  687. CASE(EQUATIONS_SET_SETUP_FINISH_ACTION)
  688. SELECT CASE(equationsSet%SOLUTION_METHOD)
  689. CASE(EQUATIONS_SET_NODAL_SOLUTION_METHOD)
  690. !Finish the creation of the equations
  691. CALL EQUATIONS_SET_EQUATIONS_GET(equationsSet,equations,err,error,*999)
  692. CALL EQUATIONS_CREATE_FINISH(equations,err,error,*999)
  693. !Create the equations mapping.
  694. CALL EQUATIONS_MAPPING_CREATE_START(equations,equationsMapping,err,error,*999)
  695. IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
  696. CALL EQUATIONS_MAPPING_LINEAR_MATRICES_NUMBER_SET(equationsMapping,1,err,error,*999)
  697. CALL EQUATIONS_MAPPING_LINEAR_MATRICES_VARIABLE_TYPES_SET(equationsMapping,[FIELD_U_VARIABLE_TYPE],err,error,*999)
  698. CALL EQUATIONS_MAPPING_RHS_VARIABLE_TYPE_SET(equationsMapping,FIELD_DELUDELN_VARIABLE_TYPE, &
  699. & err,error,*999)
  700. ELSE
  701. CALL EQUATIONS_MAPPING_LINEAR_MATRICES_NUMBER_SET(equationsMapping,1,err,error,*999)
  702. CALL EQUATIONS_MAPPING_LINEAR_MATRICES_VARIABLE_TYPES_SET(equationsMapping,[FIELD_U_VARIABLE_TYPE],err,error,*999)
  703. CALL EQUATIONS_MAPPING_RHS_VARIABLE_TYPE_SET(equationsMapping,FIELD_DELUDELN_VARIABLE_TYPE, &
  704. & err,error,*999)
  705. ENDIF
  706. CALL EQUATIONS_MAPPING_CREATE_FINISH(equationsMapping,err,error,*999)
  707. !Create the equations matrices
  708. CALL EQUATIONS_MATRICES_CREATE_START(equations,equationsMatrices,err,error,*999)
  709. ! Use the analytic Jacobian calculation
  710. CALL EquationsMatrices_JacobianTypesSet(equationsMatrices,[EQUATIONS_JACOBIAN_ANALYTIC_CALCULATED], &
  711. & err,error,*999)
  712. SELECT CASE(equations%SPARSITY_TYPE)
  713. CASE(EQUATIONS_MATRICES_FULL_MATRICES)
  714. CALL EQUATIONS_MATRICES_LINEAR_STORAGE_TYPE_SET(equationsMatrices,[MATRIX_BLOCK_STORAGE_TYPE], &
  715. & err,error,*999)
  716. CALL EQUATIONS_MATRICES_NONLINEAR_STORAGE_TYPE_SET(equationsMatrices,MATRIX_BLOCK_STORAGE_TYPE, &
  717. & err,error,*999)
  718. CASE(EQUATIONS_MATRICES_SPARSE_MATRICES)
  719. IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
  720. CALL EQUATIONS_MATRICES_LINEAR_STORAGE_TYPE_SET(equationsMatrices, &
  721. & [MATRIX_COMPRESSED_ROW_STORAGE_TYPE],err,error,*999)
  722. CALL EQUATIONS_MATRICES_LINEAR_STRUCTURE_TYPE_SET(equationsMatrices, &
  723. & [EquationsMatrix_NodalStructure],err,error,*999)
  724. CALL EQUATIONS_MATRICES_NONLINEAR_STORAGE_TYPE_SET(equationsMatrices, &
  725. & MATRIX_COMPRESSED_ROW_STORAGE_TYPE,err,error,*999)
  726. ! CALL EQUATIONS_MATRICES_NONLINEAR_STRUCTURE_TYPE_SET(equationsMatrices, &
  727. ! & EquationsMatrix_NodalStructure,err,error,*999)
  728. ELSE
  729. CALL EQUATIONS_MATRICES_LINEAR_STORAGE_TYPE_SET(equationsMatrices, &
  730. & [MATRIX_COMPRESSED_ROW_STORAGE_TYPE],err,error,*999)
  731. CALL EQUATIONS_MATRICES_NONLINEAR_STORAGE_TYPE_SET(equationsMatrices, &
  732. & MATRIX_COMPRESSED_ROW_STORAGE_TYPE,err,error,*999)
  733. CALL EQUATIONS_MATRICES_LINEAR_STRUCTURE_TYPE_SET(equationsMatrices, &
  734. & [EquationsMatrix_NodalStructure],err,error,*999)
  735. ENDIF
  736. CALL EQUATIONS_MATRICES_NONLINEAR_STRUCTURE_TYPE_SET(equationsMatrices, &
  737. & EquationsMatrix_NodalStructure,err,error,*999)
  738. CASE DEFAULT
  739. localError="The equations matrices sparsity type of "// &
  740. & TRIM(NUMBER_TO_VSTRING(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
  741. CALL FLAG_ERROR(localError,err,error,*999)
  742. END SELECT
  743. CALL EQUATIONS_MATRICES_CREATE_FINISH(equationsMatrices,err,error,*999)
  744. CASE(EQUATIONS_SET_BEM_SOLUTION_METHOD)
  745. CALL FLAG_ERROR("Not implemented.",err,error,*999)
  746. CASE(EQUATIONS_SET_FD_SOLUTION_METHOD)
  747. CALL FLAG_ERROR("Not implemented.",err,error,*999)
  748. CASE(EQUATIONS_SET_FV_SOLUTION_METHOD)
  749. CALL FLAG_ERROR("Not implemented.",err,error,*999)
  750. CASE(EQUATIONS_SET_GFEM_SOLUTION_METHOD)
  751. CALL FLAG_ERROR("Not implemented.",err,error,*999)
  752. CASE(EQUATIONS_SET_GFV_SOLUTION_METHOD)
  753. CALL FLAG_ERROR("Not implemented.",err,error,*999)
  754. CASE DEFAULT
  755. localError="The solution method of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SOLUTION_METHOD, &
  756. & "*",err,error))//" is invalid."
  757. CALL FL

Large files files are truncated, but you can click here to view the full file