PageRenderTime 62ms CodeModel.GetById 13ms RepoModel.GetById 0ms 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
  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 FLAG_ERROR(localError,err,error,*999)
  758. END SELECT
  759. CASE DEFAULT
  760. localError="The action type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup%ACTION_TYPE,"*",err,error))// &
  761. & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup%SETUP_TYPE,"*",err,error))// &
  762. & " is invalid for a characteristics equation."
  763. CALL FLAG_ERROR(localError,err,error,*999)
  764. END SELECT
  765. CASE DEFAULT
  766. localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
  767. & " for a setup sub type of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
  768. & " is invalid for a characteristics equation."
  769. CALL FLAG_ERROR(localError,err,error,*999)
  770. END SELECT
  771. CASE DEFAULT
  772. localError="The setup type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup%SETUP_TYPE,"*",err,error))// &
  773. & " is invalid for a characteristics equation set."
  774. CALL FLAG_ERROR(localError,err,error,*999)
  775. END SELECT
  776. CASE DEFAULT
  777. localError="The equations set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
  778. & " does not equal a characteristics equation set."
  779. CALL FLAG_ERROR(localError,err,error,*999)
  780. END SELECT
  781. ELSE
  782. CALL FLAG_ERROR("Equations set is not associated.",err,error,*999)
  783. ENDIF
  784. CALL EXITS("Characteristic_EquationsSet_Setup")
  785. RETURN
  786. 999 CALL ERRORS("Characteristic_EquationsSet_Setup",err,error)
  787. CALL EXITS("Characteristic_EquationsSet_Setup")
  788. RETURN 1
  789. END SUBROUTINE Characteristic_EquationsSet_Setup
  790. !
  791. !================================================================================================================================
  792. !
  793. !>Evaluates the residual nodal stiffness matrices and RHS for a characteristic equation nodal equations set.
  794. SUBROUTINE Characteristic_NodalResidualEvaluate(equationsSet,nodeNumber,err,error,*)
  795. !Argument variables
  796. TYPE(EQUATIONS_SET_TYPE), POINTER :: equationsSet !<A pointer to the equations set to perform the finite nodal calculations on
  797. INTEGER(INTG), INTENT(IN) :: nodeNumber !<The nodal number to calculate
  798. INTEGER(INTG), INTENT(OUT) :: err !<The error code
  799. TYPE(VARYING_STRING), INTENT(OUT) :: error !<The error string
  800. !Local Variables
  801. TYPE(EQUATIONS_TYPE), POINTER :: equations
  802. TYPE(EQUATIONS_MAPPING_TYPE), POINTER :: equationsMapping
  803. TYPE(EQUATIONS_MATRICES_TYPE), POINTER :: equationsMatrices
  804. TYPE(EQUATIONS_MAPPING_LINEAR_TYPE), POINTER :: linearMapping
  805. TYPE(EQUATIONS_MATRICES_LINEAR_TYPE), POINTER :: linearMatrices
  806. TYPE(EQUATIONS_MAPPING_NONLINEAR_TYPE), POINTER :: nonlinearMapping
  807. TYPE(EQUATIONS_MATRICES_NONLINEAR_TYPE), POINTER :: nonlinearMatrices
  808. TYPE(EQUATIONS_MATRIX_TYPE), POINTER :: stiffnessMatrix
  809. TYPE(FIELD_TYPE), POINTER :: materialsField
  810. TYPE(FIELD_TYPE), POINTER :: dependentField
  811. TYPE(FIELD_TYPE), POINTER :: independentField
  812. TYPE(DOMAIN_TYPE), POINTER :: domain
  813. TYPE(DOMAIN_NODES_TYPE), POINTER :: domainNodes
  814. REAL(DP), POINTER :: dependentParameters(:)
  815. REAL(DP), POINTER :: independentParameters(:)
  816. REAL(DP), POINTER :: materialsParameters(:)
  817. TYPE(FIELD_VARIABLE_TYPE), POINTER :: fieldVariable
  818. INTEGER(INTG) :: numberOfVersions,local_ny,variableType
  819. INTEGER(INTG) :: derivativeIdx,versionIdx,rowIdx,parameterIdx,versionIdx2,componentIdx,columnIdx,componentIdx2
  820. INTEGER(INTG) :: elementNumber,elementIdx,elementNodeIdx,elementNodeNumber,elementNodeVersion,versionElementNumber(4)
  821. REAL(DP) :: Q_BIF(4),A_BIF(4),A0_PARAM(4),E_PARAM(4),H0_PARAM(4),Beta(4),W(2,4),normalWave(2,4),As,Fr,sum
  822. LOGICAL :: updateStiffnessMatrix, updateRhsVector,updateNonlinearResidual
  823. TYPE(VARYING_STRING) :: localError
  824. CALL ENTERS("Characteristic_NodalResidualEvaluate",err,error,*999)
  825. NULLIFY(equations)
  826. NULLIFY(equationsMapping)
  827. NULLIFY(equationsMapping)
  828. NULLIFY(equationsMatrices)
  829. NULLIFY(linearMapping)
  830. NULLIFY(linearMatrices)
  831. NULLIFY(nonlinearMapping)
  832. NULLIFY(nonlinearMatrices)
  833. NULLIFY(stiffnessMatrix)
  834. NULLIFY(dependentField)
  835. NULLIFY(independentField)
  836. NULLIFY(materialsField)
  837. NULLIFY(domain)
  838. NULLIFY(domainNodes)
  839. NULLIFY(dependentParameters)
  840. NULLIFY(independentParameters)
  841. NULLIFY(materialsParameters)
  842. NULLIFY(fieldVariable)
  843. updateStiffnessMatrix=.FALSE.
  844. updateRhsVector=.FALSE.
  845. updateNonlinearResidual=.FALSE.
  846. IF(ASSOCIATED(equationsSet)) THEN
  847. equations=>equationsSet%EQUATIONS
  848. IF(ASSOCIATED(equations)) THEN
  849. dependentField=>equations%EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD
  850. IF(ASSOCIATED(dependentField)) THEN
  851. domain=>dependentField%DECOMPOSITION%DOMAIN(dependentField%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR
  852. IF(ASSOCIATED(domain)) THEN
  853. domainNodes=>domain%TOPOLOGY%NODES
  854. ELSE
  855. CALL FLAG_ERROR("Domain is not associated.",err,error,*999)
  856. ENDIF
  857. ELSE
  858. CALL FLAG_ERROR("Dependent Field is not associated.",err,error,*999)
  859. ENDIF
  860. ELSE
  861. CALL FLAG_ERROR("Equations set equations is not associated.",err,error,*999)
  862. ENDIF
  863. ELSE
  864. CALL FLAG_ERROR("Equations set is not associated.",err,error,*999)
  865. ENDIF
  866. SELECT CASE(equationsSet%SUBTYPE)
  867. CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
  868. !Set General and Specific Pointers
  869. independentField=>equations%INTERPOLATION%INDEPENDENT_FIELD
  870. materialsField=>equations%INTERPOLATION%MATERIALS_FIELD
  871. equationsMatrices=>equations%EQUATIONS_MATRICES
  872. equationsMapping=>equations%EQUATIONS_MAPPING
  873. linearMatrices=>equationsMatrices%LINEAR_MATRICES
  874. nonlinearMatrices=>equationsMatrices%NONLINEAR_MATRICES
  875. stiffnessMatrix=>linearMatrices%MATRICES(1)%PTR
  876. linearMapping=>equationsMapping%LINEAR_MAPPING
  877. nonlinearMapping=>equationsMapping%NONLINEAR_MAPPING
  878. !Default matrix/vector to 0 and check if update called for
  879. stiffnessMatrix%NodalMatrix%matrix=0.0_DP
  880. nonlinearMatrices%NodalResidual%vector=0.0_DP
  881. IF(ASSOCIATED(stiffnessMatrix)) updateStiffnessMatrix=stiffnessMatrix%UPDATE_MATRIX
  882. IF(ASSOCIATED(nonlinearMatrices)) updateNonlinearResidual=nonlinearMatrices%UPDATE_RESIDUAL
  883. ! Get the number of versions at this node
  884. derivativeIdx=1
  885. numberOfVersions=domainNodes%NODES(nodeNumber)%DERIVATIVES(derivativeIdx)%NUMBER_OF_VERSIONS
  886. !!!-- W a v e D i r e c t i o n ( nW ) --!!!
  887. normalWave=0.0_DP
  888. CALL FIELD_PARAMETER_SET_DATA_GET(independentField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  889. & independentParameters,err,error,*999)
  890. ! Relative to node, +/- 1, stored in independent field variable 1, components 1&2 , type U
  891. variableType=independentField%VARIABLES(1)%VARIABLE_TYPE
  892. fieldVariable=>independentField%VARIABLE_TYPE_MAP(variableType)%PTR
  893. DO componentIdx=1,2
  894. DO versionIdx=1,numberOfVersions
  895. local_ny=fieldVariable%COMPONENTS(componentIdx)%PARAM_TO_DOF_MAP% &
  896. & NODE_PARAM2DOF_MAP%NODES(nodeNumber)%DERIVATIVES(derivativeIdx)%VERSIONS(versionIdx)
  897. normalWave(componentIdx,versionIdx)=independentParameters(local_ny)
  898. ENDDO
  899. ENDDO
  900. CALL FIELD_PARAMETER_SET_DATA_RESTORE(independentField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  901. & independentParameters,err,error,*999)
  902. ! Check whether a normal node or a coupled/branching node
  903. IF (ABS(normalWave(1,1))>0 .OR. ABS(normalWave(2,1)) >0) THEN
  904. !!!-- M A T E R I A L S P A R A M E T E R S --!!!
  905. !Material Values at the node - material field variable 1, components 1-10, type U
  906. ! First 7 components constant, 8-10 node-based (so will vary with version#)
  907. ! Element-based material parameters for coupled problems
  908. IF(dependentField%DECOMPOSITION%DOMAIN(1)%PTR%TOPOLOGY% &
  909. & NODES%NODES(nodeNumber)%NUMBER_OF_SURROUNDING_ELEMENTS==1) THEN
  910. elementNumber=dependentField%DECOMPOSITION%DOMAIN(1)%PTR%TOPOLOGY% &
  911. & NODES%NODES(nodeNumber)%SURROUNDING_ELEMENTS(1)
  912. DO versionIdx=1,numberOfVersions
  913. parameterIdx=8
  914. CALL FIELD_PARAMETER_SET_GET_NODE(materialsField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  915. & versionIdx,1,nodeNumber,parameterIdx,A0_PARAM(versionIdx),err,error,*999)
  916. parameterIdx=9
  917. CALL FIELD_PARAMETER_SET_GET_NODE(materialsField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  918. & versionIdx,1,nodeNumber,parameterIdx,E_PARAM(versionIdx),err,error,*999)
  919. parameterIdx=10
  920. CALL FIELD_PARAMETER_SET_GET_NODE(materialsField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  921. & versionIdx,1,nodeNumber,parameterIdx,H0_PARAM(versionIdx),err,error,*999)
  922. Beta(versionIdx) = (4.0_DP*(PI**0.5_DP)*E_PARAM(versionIdx)*H0_PARAM(versionIdx))/ &
  923. & (3.0_DP*A0_PARAM(versionIdx))
  924. ENDDO
  925. ! For branching flows, this gets the elements converging on the node and associates them
  926. ! with their specific version number: versionElementNumber(version)
  927. ELSE
  928. !Loop over the elements surrounding the current node
  929. DO elementIdx=1,dependentField%DECOMPOSITION%DOMAIN(1)%PTR%TOPOLOGY% &
  930. & NODES%NODES(nodeNumber)%NUMBER_OF_SURROUNDING_ELEMENTS
  931. ! get the user number for the current element
  932. elementNumber=dependentField%DECOMPOSITION%DOMAIN(1)%PTR%TOPOLOGY% &
  933. & NODES%NODES(nodeNumber)%SURROUNDING_ELEMENTS(elementIdx)
  934. ! loop over the nodes on this (surrounding) element
  935. DO elementNodeIdx=1,equations%INTERPOLATION%GEOMETRIC_FIELD%DECOMPOSITION%MESH%TOPOLOGY(1)% &
  936. & PTR%ELEMENTS%ELEMENTS(elementNumber)%BASIS%NUMBER_OF_ELEMENT_PARAMETERS
  937. !get the node number for this node
  938. elementNodeNumber=equations%INTERPOLATION%GEOMETRIC_FIELD%DECOMPOSITION%MESH%TOPOLOGY(1)% &
  939. & PTR%ELEMENTS%ELEMENTS(elementNumber)%MESH_ELEMENT_NODES(elementNodeIdx)
  940. ! check that this node is the same as the current iterative node
  941. IF(elementNodeNumber==nodeNumber) THEN
  942. ! Loop over the versions to find the element index that matches the version
  943. DO versionIdx=1,numberOfVersions
  944. ! the version number for the local element node
  945. elementNodeVersion=equations%INTERPOLATION%GEOMETRIC_FIELD%DECOMPOSITION%MESH%TOPOLOGY(1)% &
  946. & PTR%ELEMENTS%ELEMENTS(elementNumber)% &
  947. & USER_ELEMENT_NODE_VERSIONS(derivativeIdx,elementNodeIdx)
  948. IF(elementNodeVersion==versionIdx) THEN
  949. !Get the element based material parameters for the surrounding elements
  950. versionElementNumber(versionIdx)=elementNumber
  951. parameterIdx=8
  952. CALL FIELD_PARAMETER_SET_GET_NODE(materialsField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  953. & versionIdx,1,nodeNumber,parameterIdx,A0_PARAM(versionIdx),err,error,*999)
  954. parameterIdx=9
  955. CALL FIELD_PARAMETER_SET_GET_NODE(materialsField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  956. & versionIdx,1,nodeNumber,parameterIdx,E_PARAM(versionIdx),err,error,*999)
  957. parameterIdx=10
  958. CALL FIELD_PARAMETER_SET_GET_NODE(materialsField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  959. & versionIdx,1,nodeNumber,parameterIdx,H0_PARAM(versionIdx),err,error,*999)
  960. Beta(versionIdx) = (4.0_DP*(PI**0.5_DP)*E_PARAM(versionIdx)*H0_PARAM(versionIdx))/ &
  961. & (3.0_DP*A0_PARAM(versionIdx))
  962. ENDIF
  963. ENDDO
  964. ENDIF
  965. ENDDO
  966. ENDDO
  967. ENDIF
  968. CALL FIELD_PARAMETER_SET_DATA_GET(materialsField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  969. & materialsParameters,err,error,*999)
  970. variableType=materialsField%VARIABLES(1)%VARIABLE_TYPE ! variables U
  971. fieldVariable=>materialsField%VARIABLE_TYPE_MAP(variableType)%PTR
  972. ! Constant material parameters
  973. local_ny=fieldVariable%COMPONENTS(4)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
  974. As=materialsParameters(local_ny)
  975. local_ny=fieldVariable%COMPONENTS(6)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
  976. Fr=materialsParameters(local_ny)
  977. CALL FIELD_PARAMETER_SET_DATA_RESTORE(materialsField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  978. & materialsParameters,err,error,*999)
  979. !!!-- D E P E N D E N T P A R A M E T E R S ( Q , A ) --!!!
  980. !Current Q and A Values at the nodes - dependent field variable 1, components 1-2, type U
  981. CALL FIELD_PARAMETER_SET_DATA_GET(dependentField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  982. & dependentParameters,err,error,*999)
  983. variableType=dependentField%VARIABLES(1)%VARIABLE_TYPE
  984. fieldVariable=>dependentField%VARIABLE_TYPE_MAP(variableType)%PTR
  985. DO versionIdx=1,numberOfVersions
  986. parameterIdx=1
  987. local_ny=fieldVariable%COMPONENTS(parameterIdx)%PARAM_TO_DOF_MAP% &
  988. & NODE_PARAM2DOF_MAP%NODES(nodeNumber)%DERIVATIVES(derivativeIdx)%VERSIONS(versionIdx)
  989. Q_BIF(versionIdx)=dependentParameters(local_ny)
  990. parameterIdx=2
  991. local_ny=fieldVariable%COMPONENTS(parameterIdx)%PARAM_TO_DOF_MAP% &
  992. & NODE_PARAM2DOF_MAP%NODES(nodeNumber)%DERIVATIVES(derivativeIdx)%VERSIONS(versionIdx)
  993. A_BIF(versionIdx)=dependentParameters(local_ny)
  994. ENDDO
  995. CALL FIELD_PARAMETER_SET_DATA_RESTORE(dependentField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  996. & dependentParameters,err,error,*999)
  997. !!!-- E X T R A P O L A T E D C H A R A C T E R I S T I C S ( W ) --!!!
  998. CALL FIELD_PARAMETER_SET_DATA_GET(dependentField,FIELD_V_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  999. & dependentParameters,err,error,*999)
  1000. ! characteristic waves stored in dependent variable 3, component 1, type V
  1001. variableType=dependentField%VARIABLES(3)%VARIABLE_TYPE
  1002. fieldVariable=>dependentField%VARIABLE_TYPE_MAP(variableType)%PTR
  1003. DO componentIdx=1,2
  1004. DO versionIdx=1,numberOfVersions
  1005. local_ny=fieldVariable%COMPONENTS(componentIdx)%PARAM_TO_DOF_MAP% &
  1006. & NODE_PARAM2DOF_MAP%NODES(nodeNumber)%DERIVATIVES(derivativeIdx)%VERSIONS(versionIdx)
  1007. W(componentIdx,versionIdx)=dependentParameters(local_ny)
  1008. ENDDO
  1009. ENDDO
  1010. CALL FIELD_PARAMETER_SET_DATA_RESTORE(dependentField,FIELD_V_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  1011. & dependentParameters,err,error,*999)
  1012. !!!-- S T I F F N E S S M A T R I X --!!!
  1013. IF(updateStiffnessMatrix) THEN
  1014. !Conservation of Mass
  1015. IF(numberOfVersions==1) THEN
  1016. rowIdx=3
  1017. ELSE
  1018. rowIdx=numberOfVersions+1
  1019. ENDIF
  1020. columnIdx=0
  1021. DO componentIdx=1,2
  1022. DO versionIdx=1,numberOfVersions
  1023. IF (ABS(normalWave(componentIdx,versionIdx))>ZERO_TOLERANCE) THEN
  1024. columnIdx=columnIdx + 1
  1025. stiffnessMatrix%NodalMatrix%matrix(rowIdx,columnIdx)=normalWave(componentIdx,versionIdx)
  1026. ENDIF
  1027. ENDDO
  1028. ENDDO
  1029. END IF
  1030. !!!-- N O N L I N E A R V E C T O R --!!!
  1031. IF(updateNonlinearResidual) THEN
  1032. rowIdx=0
  1033. !Characteristics Equations
  1034. DO componentIdx=1,2
  1035. DO versionIdx=1,numberOfVersions
  1036. IF (ABS(normalWave(componentIdx,versionIdx))>ZERO_TOLERANCE) THEN
  1037. rowIdx=rowIdx + 1
  1038. nonlinearMatrices%NodalResidual%vector(rowIdx)=(Q_BIF(versionIdx)/A_BIF(versionIdx)) &
  1039. & + normalWave(componentIdx,versionIdx)*4.0_DP*((Fr*(Beta(versionIdx)))**0.5_DP)* &
  1040. & (A_BIF(versionIdx)**0.25_DP)- W(componentIdx,versionIdx)
  1041. ENDIF
  1042. ENDDO
  1043. ENDDO
  1044. !Continuity of Total Pressure (relative to the first component)
  1045. DO componentIdx=1,2
  1046. DO versionIdx=1,numberOfVersions
  1047. IF (ABS(normalWave(componentIdx,versionIdx))>ZERO_TOLERANCE) THEN
  1048. rowIdx=rowIdx + 1
  1049. IF(versionIdx == 1) THEN
  1050. sum=0.0_DP
  1051. DO componentIdx2=1,2
  1052. DO versionIdx2=1,numberOfVersions
  1053. sum=sum + normalWave(componentIdx2,versionIdx2)*Q_BIF(versionIdx2)
  1054. ENDDO
  1055. ENDDO
  1056. nonlinearMatrices%NodalResidual%vector(rowIdx)=sum
  1057. ELSE
  1058. nonlinearMatrices%NodalResidual%vector(rowIdx)=((A_BIF(1)**0.5_DP)-(Beta(versionIdx)/Beta(1))* &
  1059. & (A_BIF(versionIdx)**0.5_DP))-(((A0_PARAM(1)/As)**0.5_DP)-(Beta(versionIdx)/Beta(1))* &
  1060. & ((A0_PARAM(versionIdx)/As)**0.5_DP))+(1.0_DP/(Fr*Beta(1))*0.25_DP*(((Q_BIF(1)/A_BIF(1))**2)- &
  1061. & ((Q_BIF(versionIdx)/A_BIF(versionIdx))**2)))
  1062. ENDIF
  1063. ENDIF
  1064. ENDDO
  1065. ENDDO
  1066. ENDIF
  1067. ENDIF !check for normal node or coupled/branching
  1068. CASE DEFAULT
  1069. localError="Equations set subtype "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
  1070. & " is not valid for a characteristic equation type of a fluid mechanics equations set class."
  1071. CALL FLAG_ERROR(localError,err,error,*999)
  1072. END SELECT
  1073. CALL EXITS("Characteristic_NodalResidualEvaluate")
  1074. RETURN
  1075. 999 CALL ERRORS("Characteristic_NodalResidualEvaluate",err,error)
  1076. CALL EXITS("Characteristic_NodalResidualEvaluate")
  1077. RETURN 1
  1078. END SUBROUTINE Characteristic_NodalResidualEvaluate
  1079. !
  1080. !================================================================================================================================
  1081. !
  1082. !>Evaluates the Jacobian nodal matrix for a Navier-Stokes equation finite nodal equations set.
  1083. SUBROUTINE Characteristic_NodalJacobianEvaluate(equationsSet,nodeNumber,err,error,*)
  1084. !Argument variables
  1085. TYPE(EQUATIONS_SET_TYPE), POINTER :: equationsSet !<A pointer to the equations set to perform the finite nodal calculations on
  1086. INTEGER(INTG), INTENT(IN) :: nodeNumber !<The nodal number to calculate
  1087. INTEGER(INTG), INTENT(OUT) :: err !<The error code
  1088. TYPE(VARYING_STRING), INTENT(OUT) :: error !<The error string
  1089. !Local Variables
  1090. TYPE(EQUATIONS_TYPE), POINTER :: equations
  1091. TYPE(EQUATIONS_MAPPING_TYPE), POINTER :: equationsMapping
  1092. TYPE(EQUATIONS_MATRICES_TYPE), POINTER :: equationsMatrices
  1093. TYPE(EQUATIONS_MAPPING_LINEAR_TYPE), POINTER :: linearMapping
  1094. TYPE(EQUATIONS_MATRICES_LINEAR_TYPE), POINTER :: linearMatrices
  1095. TYPE(EQUATIONS_MAPPING_NONLINEAR_TYPE), POINTER :: nonlinearMapping
  1096. TYPE(EQUATIONS_MATRICES_NONLINEAR_TYPE), POINTER :: nonlinearMatrices
  1097. TYPE(EQUATIONS_JACOBIAN_TYPE), POINTER :: jacobianMatrix
  1098. TYPE(FIELD_TYPE), POINTER :: materialsField
  1099. TYPE(FIELD_TYPE), POINTER :: dependentField
  1100. TYPE(FIELD_TYPE), POINTER :: independentField
  1101. TYPE(DOMAIN_TYPE), POINTER :: domain
  1102. TYPE(DOMAIN_NODES_TYPE), POINTER :: domainNodes
  1103. REAL(DP), POINTER :: dependentParameters(:)
  1104. REAL(DP), POINTER :: independentParameters(:)
  1105. REAL(DP), POINTER :: materialsParameters(:)
  1106. TYPE(FIELD_VARIABLE_TYPE), POINTER :: fieldVariable
  1107. INTEGER(INTG) :: numberOfVersions,local_ny,variableType,startColumn2
  1108. INTEGER(INTG) :: derivativeIdx,versionIdx,rowIdx,parameterIdx,baseIdx,columnIdx,columnIdx2,startRow,endRow,componentIdx
  1109. INTEGER(INTG) :: elementNumber,elementIdx,elementNodeIdx,elementNodeNumber,elementNodeVersion,versionElementNumber(4)
  1110. REAL(DP) :: Q_BIF(4),A_BIF(4),A0_PARAM(4),E_PARAM(4),H0_PARAM(4),Beta(4),W(2,4),normalWave(2,4),As,Fr
  1111. LOGICAL :: updateJacobianMatrix
  1112. TYPE(VARYING_STRING) :: localError
  1113. CALL ENTERS("Characteristic_NodalJacobianEvaluate",err,error,*999)
  1114. NULLIFY(equations)
  1115. NULLIFY(equationsMapping)
  1116. NULLIFY(equationsMapping)
  1117. NULLIFY(equationsMatrices)
  1118. NULLIFY(linearMapping)
  1119. NULLIFY(linearMatrices)
  1120. NULLIFY(nonlinearMapping)
  1121. NULLIFY(nonlinearMatrices)
  1122. NULLIFY(jacobianMatrix)
  1123. NULLIFY(dependentField)
  1124. NULLIFY(independentField)
  1125. NULLIFY(materialsField)
  1126. NULLIFY(domain)
  1127. NULLIFY(domainNodes)
  1128. NULLIFY(dependentParameters)
  1129. NULLIFY(independentParameters)
  1130. NULLIFY(materialsParameters)
  1131. NULLIFY(fieldVariable)
  1132. updateJacobianMatrix=.FALSE.
  1133. IF(ASSOCIATED(equationsSet)) THEN
  1134. equations=>equationsSet%EQUATIONS
  1135. IF(ASSOCIATED(equations)) THEN
  1136. dependentField=>equations%EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD
  1137. IF(ASSOCIATED(dependentField)) THEN
  1138. domain=>dependentField%DECOMPOSITION%DOMAIN(dependentField%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR
  1139. IF(ASSOCIATED(domain)) THEN
  1140. domainNodes=>domain%TOPOLOGY%NODES
  1141. ELSE
  1142. CALL FLAG_ERROR("Domain is not associated.",err,error,*999)
  1143. ENDIF
  1144. ELSE
  1145. CALL FLAG_ERROR("Dependent Field is not associated.",err,error,*999)
  1146. ENDIF
  1147. ELSE
  1148. CALL FLAG_ERROR("Equations set equations is not associated.",err,error,*999)
  1149. ENDIF
  1150. ELSE
  1151. CALL FLAG_ERROR("Equations set is not associated.",err,error,*999)
  1152. ENDIF
  1153. SELECT CASE(equationsSet%SUBTYPE)
  1154. CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
  1155. !Set General and Specific Pointers
  1156. independentField=>equations%EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD
  1157. materialsField=>equations%INTERPOLATION%MATERIALS_FIELD
  1158. equationsMatrices=>equations%EQUATIONS_MATRICES
  1159. equationsMapping=>equations%EQUATIONS_MAPPING
  1160. linearMatrices=>equationsMatrices%LINEAR_MATRICES
  1161. nonlinearMatrices=>equationsMatrices%NONLINEAR_MATRICES
  1162. nonlinearMapping=>equationsMapping%NONLINEAR_MAPPING
  1163. linearMapping=>equationsMapping%LINEAR_MAPPING
  1164. jacobianMatrix=>nonlinearMatrices%JACOBIANS(1)%PTR
  1165. !Default matrix/vector to 0 and check if update called for
  1166. jacobianMatrix%NodalJacobian%matrix=0.0_DP
  1167. IF(ASSOCIATED(jacobianMatrix)) updateJacobianMatrix=jacobianMatrix%UPDATE_JACOBIAN
  1168. ! Set derivative to 1 and get the number of versions at this node
  1169. derivativeIdx=1
  1170. numberOfVersions=domainNodes%NODES(nodeNumber)%DERIVATIVES(derivativeIdx)%NUMBER_OF_VERSIONS
  1171. ! Check if this is a standard node or a branching/coupled node (branch/coupled has >1 version)
  1172. ! (if standard, the returned nodal nodal vector from this routine will be 0)
  1173. !!!-- W a v e D i r e c t i o n ( nW ) --!!!
  1174. normalWave=0.0_DP
  1175. CALL FIELD_PARAMETER_SET_DATA_GET(independentField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  1176. & independentParameters,err,error,*999)
  1177. ! Relative to node, +/- 1, stored in independent field variable 1, components 1&2 , type U
  1178. variableType=independentField%VARIABLES(1)%VARIABLE_TYPE
  1179. fieldVariable=>independentField%VARIABLE_TYPE_MAP(variableType)%PTR
  1180. DO componentIdx=1,2
  1181. DO versionIdx=1,numberOfVersions
  1182. local_ny=fieldVariable%COMPONENTS(componentIdx)%PARAM_TO_DOF_MAP% &
  1183. & NODE_PARAM2DOF_MAP%NODES(nodeNumber)%DERIVATIVES(derivativeIdx)%VERSIONS(versionIdx)
  1184. normalWave(componentIdx,versionIdx)=independentParameters(local_ny)
  1185. ENDDO
  1186. ENDDO
  1187. CALL FIELD_PARAMETER_SET_DATA_RESTORE(independentField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  1188. & independentParameters,err,error,*999)
  1189. ! Check whether a normal node or a coupled/branching node
  1190. IF (ABS(normalWave(1,1))>0 .OR. ABS(normalWave(2,1)) >0) THEN
  1191. !!!-- M A T E R I A L S P A R A M E T E R S --!!!
  1192. !Material Values at the node - material field variable 1, components 1-10, type U
  1193. ! First 7 components constant, 8-10 node-based (so will vary with version#)
  1194. ! Element-based material parameters for coupled problems
  1195. IF(dependentField%DECOMPOSITION%DOMAIN(1)%PTR%TOPOLOGY% &
  1196. & NODES%NODES(nodeNumber)%NUMBER_OF_SURROUNDING_ELEMENTS==1) THEN
  1197. elementNumber=dependentField%DECOMPOSITION%DOMAIN(1)%PTR%TOPOLOGY% &
  1198. & NODES%NODES(nodeNumber)%SURROUNDING_ELEMENTS(1)
  1199. DO versionIdx=1,numberOfVersions
  1200. parameterIdx=8
  1201. CALL FIELD_PARAMETER_SET_GET_NODE(materialsField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  1202. & versionIdx,1,nodeNumber,parameterIdx,A0_PARAM(versionIdx),err,error,*999)
  1203. parameterIdx=9
  1204. CALL FIELD_PARAMETER_SET_GET_NODE(materialsField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  1205. & versionIdx,1,nodeNumber,parameterIdx,E_PARAM(versionIdx),err,error,*999)
  1206. parameterIdx=10
  1207. CALL FIELD_PARAMETER_SET_GET_NODE(materialsField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  1208. & versionIdx,1,nodeNumber,parameterIdx,H0_PARAM(versionIdx),err,error,*999)
  1209. Beta(versionIdx) = (4.0_DP*(PI**0.5_DP)*E_PARAM(versionIdx)*H0_PARAM(versionIdx))/ &
  1210. & (3.0_DP*A0_PARAM(versionIdx))
  1211. ENDDO
  1212. ! For branching flows, this gets the elements converging on the node and associates them
  1213. ! with their specific version number: versionElementNumber(version)
  1214. ELSE
  1215. !Loop over the elements surrounding the current node
  1216. DO elementIdx=1,dependentField%DECOMPOSITION%DOMAIN(1)%PTR%TOPOLOGY% &
  1217. & NODES%NODES(nodeNumber)%NUMBER_OF_SURROUNDING_ELEMENTS
  1218. ! get the user number for the current element
  1219. elementNumber=dependentField%DECOMPOSITION%DOMAIN(1)%PTR%TOPOLOGY% &
  1220. & NODES%NODES(nodeNumber)%SURROUNDING_ELEMENTS(elementIdx)
  1221. ! loop over the nodes on this (surrounding) element
  1222. DO elementNodeIdx=1,equations%INTERPOLATION%GEOMETRIC_FIELD%DECOMPOSITION%MESH%TOPOLOGY(1)% &
  1223. & PTR%ELEMENTS%ELEMENTS(elementNumber)%BASIS%NUMBER_OF_ELEMENT_PARAMETERS
  1224. !get the node number for this node
  1225. elementNodeNumber=equations%INTERPOLATION%GEOMETRIC_FIELD%DECOMPOSITION%MESH%TOPOLOGY(1)% &
  1226. & PTR%ELEMENTS%ELEMENTS(elementNumber)%MESH_ELEMENT_NODES(elementNodeIdx)
  1227. ! check that this node is the same as the current iterative node
  1228. IF(elementNodeNumber==nodeNumber) THEN
  1229. ! Loop over the versions to find the element index that matches the version
  1230. DO versionIdx=1,numberOfVersions
  1231. ! the version number for the local element node
  1232. elementNodeVersion=equations%INTERPOLATION%GEOMETRIC_FIELD%DECOMPOSITION%MESH%TOPOLOGY(1)% &
  1233. & PTR%ELEMENTS%ELEMENTS(elementNumber)% &
  1234. & USER_ELEMENT_NODE_VERSIONS(derivativeIdx,elementNodeIdx)
  1235. IF(elementNodeVersion==versionIdx) THEN
  1236. !Get the element based material parameters for the surrounding elements
  1237. versionElementNumber(versionIdx)=elementNumber
  1238. parameterIdx=8
  1239. CALL FIELD_PARAMETER_SET_GET_NODE(materialsField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  1240. & versionIdx,1,nodeNumber,parameterIdx,A0_PARAM(versionIdx),err,error,*999)
  1241. parameterIdx=9
  1242. CALL FIELD_PARAMETER_SET_GET_NODE(materialsField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  1243. & versionIdx,1,nodeNumber,parameterIdx,E_PARAM(versionIdx),err,error,*999)
  1244. parameterIdx=10
  1245. CALL FIELD_PARAMETER_SET_GET_NODE(materialsField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  1246. & versionIdx,1,nodeNumber,parameterIdx,H0_PARAM(versionIdx),err,error,*999)
  1247. Beta(versionIdx) = (4.0_DP*(PI**0.5_DP)*E_PARAM(versionIdx)*H0_PARAM(versionIdx))/ &
  1248. & (3.0_DP*A0_PARAM(versionIdx))
  1249. ENDIF
  1250. ENDDO
  1251. ENDIF
  1252. ENDDO
  1253. ENDDO
  1254. ENDIF
  1255. CALL FIELD_PARAMETER_SET_DATA_GET(materialsField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  1256. & materialsParameters,err,error,*999)
  1257. variableType=materialsField%VARIABLES(1)%VARIABLE_TYPE ! variables U
  1258. fieldVariable=>materialsField%VARIABLE_TYPE_MAP(variableType)%PTR
  1259. ! Constant material parameters
  1260. local_ny=fieldVariable%COMPONENTS(4)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
  1261. As=materialsParameters(local_ny)
  1262. local_ny=fieldVariable%COMPONENTS(6)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
  1263. Fr=materialsParameters(local_ny)
  1264. CALL FIELD_PARAMETER_SET_DATA_RESTORE(materialsField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  1265. & materialsParameters,err,error,*999)
  1266. !!!-- D E P E N D E N T P A R A M E T E R S ( Q , A ) --!!!
  1267. !Current Q and A Values at the nodes - dependent field variable 1, components 1-2, type U
  1268. CALL FIELD_PARAMETER_SET_DATA_GET(dependentField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  1269. & dependentParameters,err,error,*999)
  1270. variableType=dependentField%VARIABLES(1)%VARIABLE_TYPE
  1271. fieldVariable=>dependentField%VARIABLE_TYPE_MAP(variableType)%PTR
  1272. DO versionIdx=1,numberOfVersions
  1273. parameterIdx=1
  1274. local_ny=fieldVariable%COMPONENTS(parameterIdx)%PARAM_TO_DOF_MAP% &
  1275. & NODE_PARAM2DOF_MAP%NODES(nodeNumber)%DERIVATIVES(derivativeIdx)%VERSIONS(versionIdx)
  1276. Q_BIF(versionIdx)=dependentParameters(local_ny)
  1277. parameterIdx=2
  1278. local_ny=fieldVariable%COMPONENTS(parameterIdx)%PARAM_TO_DOF_MAP% &
  1279. & NODE_PARAM2DOF_MAP%NODES(nodeNumber)%DERIVATIVES(derivativeIdx)%VERSIONS(versionIdx)
  1280. A_BIF(versionIdx)=dependentParameters(local_ny)
  1281. ENDDO
  1282. CALL FIELD_PARAMETER_SET_DATA_RESTORE(dependentField,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  1283. & dependentParameters,err,error,*999)
  1284. !!!-- E X T R A P O L A T E D C H A R A C T E R I S T I C S ( W ) --!!!
  1285. CALL FIELD_PARAMETER_SET_DATA_GET(dependentField,FIELD_V_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  1286. & dependentParameters,err,error,*999)
  1287. ! characteristic waves stored in dependent variable 3, component 1, type V
  1288. variableType=dependentField%VARIABLES(3)%VARIABLE_TYPE
  1289. fieldVariable=>dependentField%VARIABLE_TYPE_MAP(variableType)%PTR
  1290. DO componentIdx=1,2
  1291. DO versionIdx=1,numberOfVersions
  1292. local_ny=fieldVariable%COMPONENTS(componentIdx)%PARAM_TO_DOF_MAP% &
  1293. & NODE_PARAM2DOF_MAP%NODES(nodeNumber)%DERIVATIVES(derivativeIdx)%VERSIONS(versionIdx)
  1294. W(componentIdx,versionIdx)=dependentParameters(local_ny)
  1295. ENDDO
  1296. ENDDO
  1297. CALL FIELD_PARAMETER_SET_DATA_RESTORE(dependentField,FIELD_V_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
  1298. & dependentParameters,err,error,*999)
  1299. !!!-- J A C O B I A N M A T R I X --!!!
  1300. IF(updateJacobianMatrix) THEN
  1301. ! Characteristic equations dW/dU
  1302. columnIdx=0
  1303. rowIdx=0
  1304. DO componentIdx=1,2
  1305. DO versionIdx=1,numberOfVersions
  1306. IF (ABS(normalWave(componentIdx,versionIdx))>ZERO_TOLERANCE) THEN
  1307. columnIdx=columnIdx+1
  1308. rowIdx=rowIdx+1
  1309. jacobianMatrix%NodalJacobian%matrix(rowIdx,columnIdx)=1.0_DP/A_BIF(versionIdx)
  1310. ENDIF
  1311. ENDDO
  1312. ENDDO
  1313. rowIdx=0
  1314. DO componentIdx=1,2
  1315. DO versionIdx=1,numberOfVersions
  1316. IF (ABS(normalWave(componentIdx,versionIdx))>ZERO_TOLERANCE) THEN
  1317. columnIdx=columnIdx+1
  1318. rowIdx=rowIdx+1
  1319. jacobianMatrix%NodalJacobian%matrix(rowIdx,columnIdx)=(-Q_BIF(versionIdx)/(A_BIF(versionIdx)**2)) &
  1320. & +normalWave(componentIdx,versionIdx)*SQRT((Fr*(Beta(versionIdx))))* &
  1321. & ((A_BIF(versionIdx)**(-0.75_DP)))
  1322. ENDIF
  1323. ENDDO
  1324. ENDDO
  1325. !Continuity of Total Pressure (dP/dU)
  1326. IF(numberOfVersions==1) THEN
  1327. startRow= 4
  1328. endRow = 4
  1329. startColumn2 = 3
  1330. ELSE
  1331. startRow=numberOfVersions+2
  1332. endRow=numberOfVersions*2
  1333. startColumn2= numberOfVersions+1
  1334. ENDIF
  1335. DO rowIdx=startRow,endRow
  1336. columnIdx=1
  1337. columnIdx2=startColumn2
  1338. DO componentIdx=1,2
  1339. DO versionIdx=1,numberOfVersions
  1340. IF (ABS(normalWave(componentIdx,versionIdx))>ZERO_TOLERANCE) THEN
  1341. IF(columnIdx==1) THEN
  1342. ! dP/dQ
  1343. jacobianMatrix%NodalJacobian%matrix(rowIdx,columnIdx)=(1.0_DP/(2.0_DP*Fr*Beta(1)))* &
  1344. & (Q_BIF(1)/(A_BIF(1)**2.0_DP))
  1345. ! dP/dA
  1346. jacobianMatrix%NodalJacobian%matrix(rowIdx,columnIdx2)=1.0_DP/(2.0_DP*SQRT(A_BIF(1))) - &
  1347. & (1.0_DP/(2.0_DP*Fr*Beta(1)))* &
  1348. & ((Q_BIF(1)**2.0_DP)/(A_BIF(1)**3.0_DP))
  1349. ELSE IF(columnIdx2==rowIdx) THEN
  1350. ! dP/dQ
  1351. jacobianMatrix%NodalJacobian%matrix(rowIdx,columnIdx)=(-1.0_DP/(2.0_DP*Fr*Beta(1)))* &
  1352. & (Q_BIF(versionIdx)/(A_BIF(versionIdx)**2.0_DP))
  1353. ! dP/dA
  1354. jacobianMatrix%NodalJacobian%matrix(rowIdx,columnIdx2)=-Beta(versionIdx)/Beta(1)* &
  1355. & (1/(2.0_DP*SQRT(A_BIF(versionIdx)))) + (1.0_DP/(2.0_DP*Fr*Beta(1)))* &
  1356. & (Q_BIF(versionIdx)**2.0_DP)/(A_BIF(versionIdx)**3.0_DP)
  1357. ELSE
  1358. jacobianMatrix%NodalJacobian%matrix(rowIdx,versionIdx)=0.0_DP
  1359. jacobianMatrix%NodalJacobian%matrix(rowIdx,columnIdx)=0.0_DP
  1360. ENDIF
  1361. columnIdx=columnIdx+1
  1362. columnIdx2=columnIdx2+1
  1363. ENDIF
  1364. ENDDO !versionIdx
  1365. ENDDO !componentidx
  1366. ENDDO !rowIdx
  1367. ENDIF !update jacobian
  1368. ENDIF !check for normal or coupled/branch node
  1369. CASE DEFAULT
  1370. localError="Equations set subtype "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
  1371. & " is not valid for a Navier-Stokes equation type of a fluid mechanics equations set class."
  1372. CALL FLAG_ERROR(localError,err,error,*999)
  1373. END SELECT
  1374. CALL EXITS("Characteristic_NodalJacobianEvaluate")
  1375. RETURN
  1376. 999 CALL ERRORS("Characteristic_NodalJacobianEvaluate",err,error)
  1377. CALL EXITS("Characteristic_NodalJacobianEvaluate")
  1378. RETURN 1
  1379. END SUBROUTINE Characteristic_NodalJacobianEvaluate
  1380. !
  1381. !================================================================================================================================
  1382. !
  1383. END MODULE CHARACTERISTIC_EQUATION_ROUTINES