OpenCMISS-Iron Internal API Documentation
characteristic_equation_routines.f90
Go to the documentation of this file.
1 
47 
49 MODULE characteristic_equation_routines
50 
51  USE base_routines
52  USE basis_routines
53  USE boundary_conditions_routines
54  USE constants
55  USE control_loop_routines
56  USE distributed_matrix_vector
57  USE domain_mappings
58  USE equations_routines
59  USE equations_mapping_routines
60  USE equations_matrices_routines
61  USE equations_set_constants
62  USE field_routines
63  USE field_io_routines
64  USE fluid_mechanics_io_routines
65  USE input_output
66  USE iso_varying_string
67  USE kinds
68  USE maths
69  USE matrix_vector
70  USE mesh_routines
71  USE node_routines
72  USE problem_constants
73  USE strings
74  USE solver_routines
75  USE timer
76  USE types
77 
78 #include "macros.h"
79 
80  IMPLICIT NONE
81 
82  PRIVATE
83 
84  PUBLIC characteristic_equationssetsolutionmethodset
85 
86  PUBLIC characteristic_equationssetspecificationset
87 
88  PUBLIC characteristic_equationssetsetup
89 
90  PUBLIC characteristic_nodalresidualevaluate
91 
92  PUBLIC characteristic_nodaljacobianevaluate
93 
94  PUBLIC characteristic_extrapolate
95 
96  PUBLIC characteristic_primitivetocharacteristic
97 
98 CONTAINS
99 
100 !
101 !================================================================================================================================
102 !
103 
105  SUBROUTINE characteristic_equationssetsolutionmethodset(equationsSet,solutionMethod,err,error,*)
106 
107  !Argument variables
108  TYPE(equations_set_type), POINTER :: equationsSet
109  INTEGER(INTG), INTENT(IN) :: solutionMethod
110  INTEGER(INTG), INTENT(OUT) :: err
111  TYPE(varying_string), INTENT(OUT) :: error
112  !Local Variables
113  TYPE(varying_string) :: localError
114 
115  enters("Characteristic_EquationsSetSolutionMethodSet",err,error,*999)
116 
117  IF(ASSOCIATED(equationsset)) THEN
118  IF(.NOT.ALLOCATED(equationsset%specification)) THEN
119  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
120  ELSE IF(SIZE(equationsset%specification,1)/=3) THEN
121  CALL flagerror("Equations set specification must have three entries for a characteristic type equations set.", &
122  & err,error,*999)
123  END IF
124  SELECT CASE(equationsset%specification(3))
125  CASE(equations_set_characteristic_subtype)
126  SELECT CASE(solutionmethod)
127  CASE(equations_set_fem_solution_method)
128  CALL flagerror("Not implemented.",err,error,*999)
129  CASE(equations_set_nodal_solution_method)
130  equationsset%SOLUTION_METHOD=equations_set_nodal_solution_method
131  CASE(equations_set_bem_solution_method)
132  CALL flagerror("Not implemented.",err,error,*999)
133  CASE(equations_set_fd_solution_method)
134  CALL flagerror("Not implemented.",err,error,*999)
135  CASE(equations_set_fv_solution_method)
136  CALL flagerror("Not implemented.",err,error,*999)
137  CASE(equations_set_gfem_solution_method)
138  CALL flagerror("Not implemented.",err,error,*999)
139  CASE(equations_set_gfv_solution_method)
140  CALL flagerror("Not implemented.",err,error,*999)
141  CASE DEFAULT
142  localerror="The specified solution method of "//trim(numbertovstring(solutionmethod,"*",err,error))// &
143  & " is invalid."
144  CALL flagerror(localerror,err,error,*999)
145  END SELECT
146  CASE DEFAULT
147  localerror="The third equations set specification of "// &
148  & trim(numbertovstring(equationsset%specification(3),"*",err,error))// &
149  & " is not valid for a characteristic type of a fluid mechanics equations set."
150  CALL flagerror(localerror,err,error,*999)
151  END SELECT
152  ELSE
153  CALL flagerror("Equations set is not associated.",err,error,*999)
154  ENDIF
155 
156  exits("Characteristic_EquationsSetSolutionMethodSet")
157  RETURN
158 999 errors("Characteristic_EquationsSetSolutionMethodSet",err,error)
159  exits("Characteristic_EquationsSetSolutionMethodSet")
160  RETURN 1
161 
162  END SUBROUTINE characteristic_equationssetsolutionmethodset
163 
164 !
165 !================================================================================================================================
166 !
167 
169  SUBROUTINE characteristic_equationssetspecificationset(equationsSet,specification,err,error,*)
170 
171  !Argument variables
172  TYPE(equations_set_type), POINTER :: equationsSet
173  INTEGER(INTG), INTENT(IN) :: specification(:)
174  INTEGER(INTG), INTENT(OUT) :: err
175  TYPE(varying_string), INTENT(OUT) :: error
176  !Local Variables
177  TYPE(varying_string) :: localError
178  INTEGER(INTG) :: subtype
179 
180  enters("Characteristic_EquationsSetSpecificationSet",err,error,*999)
181 
182  IF(ASSOCIATED(equationsset)) THEN
183  IF(SIZE(specification,1)/=3) THEN
184  CALL flagerror("Equations set specification must have three entries for a characteristic type equations set.", &
185  & err,error,*999)
186  END IF
187  subtype=specification(3)
188  SELECT CASE(subtype)
189  CASE(equations_set_characteristic_subtype)
190  !ok
191  CASE DEFAULT
192  localerror="The third equations set specification of "//trim(numbertovstring(subtype,"*",err,error))// &
193  & " is not valid for a characteristic type of a fluid mechanics equations set."
194  CALL flagerror(localerror,err,error,*999)
195  END SELECT
196  !Set full specification
197  IF(ALLOCATED(equationsset%specification)) THEN
198  CALL flagerror("Equations set specification is already allocated.",err,error,*999)
199  ELSE
200  ALLOCATE(equationsset%specification(3),stat=err)
201  IF(err/=0) CALL flagerror("Could not allocate equations set specification.",err,error,*999)
202  END IF
203  equationsset%specification(1:3)=[equations_set_fluid_mechanics_class,equations_set_characteristic_equation_type,subtype]
204  ELSE
205  CALL flagerror("Equations set is not associated.",err,error,*999)
206  END IF
207 
208  exits("Characteristic_EquationsSetSpecificationSet")
209  RETURN
210 999 errors("Characteristic_EquationsSetSpecificationSet",err,error)
211  exits("Characteristic_EquationsSetSpecificationSet")
212  RETURN 1
213 
214  END SUBROUTINE characteristic_equationssetspecificationset
215 
216 !
217 !================================================================================================================================
218 !
219 
221  SUBROUTINE characteristic_equationssetsetup(equationsSet,equationsSetSetup,err,error,*)
222 
223  !Argument variables
224  TYPE(equations_set_type), POINTER :: equationsSet
225  TYPE(equations_set_setup_type), INTENT(INOUT) :: equationsSetSetup
226  INTEGER(INTG), INTENT(OUT) :: err
227  TYPE(varying_string), INTENT(OUT) :: error
228  !Local Variables
229  TYPE(decomposition_type), POINTER :: geometricDecomposition
230  TYPE(equations_type), POINTER :: equations
231  TYPE(equations_mapping_type), POINTER :: equationsMapping
232  TYPE(equations_matrices_type), POINTER :: equationsMatrices
233  TYPE(equations_set_materials_type), POINTER :: equationsMaterials
234  TYPE(equations_set_equations_set_field_type), POINTER :: equationsEquationsSetField
235  TYPE(field_type), POINTER :: equationsSetField
236  INTEGER(INTG) :: componentIdx,geometricScalingType,geometricMeshComponent,geometricComponentNumber
237  INTEGER(INTG) :: dependentFieldNumberOfVariables,dependentFieldNumberOfComponents
238  INTEGER(INTG) :: independentFieldNumberOfVariables,independentFieldNumberOfComponents
239  INTEGER(INTG) :: materialsFieldNumberOfVariables,materialsFieldNumberOfComponents1,materialsFieldNumberOfComponents2
240  TYPE(varying_string) :: localError
241 
242  enters("Characteristic_EquationsSetSetup",err,error,*999)
243 
244  NULLIFY(equations)
245  NULLIFY(equationsmapping)
246  NULLIFY(equationsmatrices)
247  NULLIFY(equationsmaterials)
248  NULLIFY(geometricdecomposition)
249 
250  IF(ASSOCIATED(equationsset)) THEN
251  IF(.NOT.ALLOCATED(equationsset%specification)) THEN
252  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
253  ELSE IF(SIZE(equationsset%specification,1)/=3) THEN
254  CALL flagerror("Equations set specification must have three entries for a characteristic type equations set.", &
255  & err,error,*999)
256  END IF
257  SELECT CASE(equationsset%specification(3))
258  CASE(equations_set_characteristic_subtype)
259  SELECT CASE(equationssetsetup%SETUP_TYPE)
260  !-----------------------------------------------------------------
261  ! I n i t i a l s e t u p
262  !-----------------------------------------------------------------
263  CASE(equations_set_setup_initial_type)
264  SELECT CASE(equationsset%specification(3))
265  CASE(equations_set_characteristic_subtype)
266  SELECT CASE(equationssetsetup%ACTION_TYPE)
267  CASE(equations_set_setup_start_action)
268  CALL characteristic_equationssetsolutionmethodset(equationsset, &
269  & equations_set_nodal_solution_method,err,error,*999)
270  equationsset%SOLUTION_METHOD=equations_set_nodal_solution_method
271  equationsequationssetfield=>equationsset%EQUATIONS_SET_FIELD
272  IF(equationsequationssetfield%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN
273  !Create the auto created equations set field field for SUPG element metrics
274  CALL field_create_start(equationssetsetup%FIELD_USER_NUMBER,equationsset%REGION, &
275  & equationsequationssetfield%EQUATIONS_SET_FIELD_FIELD,err,error,*999)
276  equationssetfield=>equationsequationssetfield%EQUATIONS_SET_FIELD_FIELD
277  CALL field_label_set(equationssetfield,"Equations Set Field",err,error,*999)
278  CALL field_type_set_and_lock(equationssetfield,field_general_type,&
279  & err,error,*999)
280  CALL field_number_of_variables_set(equationssetfield, &
281  & 1,err,error,*999)
282  CALL field_variable_types_set_and_lock(equationssetfield,&
283  & [field_u_variable_type],err,error,*999)
284  CALL field_variable_label_set(equationssetfield,field_u_variable_type, &
285  & "W2Initialise",err,error,*999)
286  CALL field_data_type_set_and_lock(equationssetfield,field_u_variable_type, &
287  & field_dp_type,err,error,*999)
288  CALL field_number_of_components_set_and_lock(equationssetfield,&
289  & field_u_variable_type,1,err,error,*999)
290  ENDIF
291  CASE(equations_set_setup_finish_action)
292  IF(equationsset%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN
293  CALL field_create_finish(equationsset%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,err,error,*999)
294  CALL field_component_values_initialise(equationsset%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
295  & field_u_variable_type,field_values_set_type,1,1.0_dp,err,error,*999)
296  ENDIF
297  CASE DEFAULT
298  localerror="The action type of "//trim(numbertovstring(equationssetsetup%ACTION_TYPE, &
299  & "*",err,error))// " for a setup type of "//trim(numbertovstring(equationssetsetup% &
300  & setup_type,"*",err,error))// " is not implemented for a characteristic equations set."
301  CALL flagerror(localerror,err,error,*999)
302  END SELECT
303  CASE DEFAULT
304  localerror="The third equations set specification of "// &
305  & trim(number_to_vstring(equationsset%specification(3),"*",err,error))// &
306  & " is invalid for a characteristic equations set."
307  CALL flagerror(localerror,err,error,*999)
308  END SELECT
309  !-----------------------------------------------------------------
310  ! G e o m e t r i c f i e l d
311  !-----------------------------------------------------------------
312  CASE(equations_set_setup_geometry_type)
313  SELECT CASE(equationsset%specification(3))
314  CASE(equations_set_characteristic_subtype)
315  SELECT CASE(equationssetsetup%ACTION_TYPE)
316  CASE(equations_set_setup_start_action)
317  equationsequationssetfield=>equationsset%EQUATIONS_SET_FIELD
318  equationssetfield=>equationsequationssetfield%EQUATIONS_SET_FIELD_FIELD
319  IF(equationsequationssetfield%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN
320  CALL field_mesh_decomposition_get(equationsset%GEOMETRY%GEOMETRIC_FIELD,geometricdecomposition,err,error,*999)
321  CALL field_mesh_decomposition_set_and_lock(equationssetfield,&
322  & geometricdecomposition,err,error,*999)
323  CALL field_geometric_field_set_and_lock(equationssetfield,&
324  & equationsset%GEOMETRY%GEOMETRIC_FIELD,err,error,*999)
325  CALL field_component_mesh_component_get(equationsset%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
326  & 1,geometriccomponentnumber,err,error,*999)
327  CALL field_component_mesh_component_set_and_lock(equationssetfield, &
328  & field_u_variable_type,1,geometriccomponentnumber,err,error,*999)
329  CALL field_component_interpolation_set_and_lock(equationssetfield, &
330  & field_u_variable_type,1,field_constant_interpolation,err,error,*999)
331  !Default the field scaling to that of the geometric field
332  CALL field_scaling_type_get(equationsset%GEOMETRY%GEOMETRIC_FIELD,geometricscalingtype,err,error,*999)
333  CALL field_scaling_type_set(equationsset%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,geometricscalingtype, &
334  & err,error,*999)
335  ELSE
336  !Do nothing
337  ENDIF
338  CASE(equations_set_setup_finish_action)
339  ! do nothing
340  CASE DEFAULT
341  localerror="The action type of "//trim(numbertovstring(equationssetsetup%ACTION_TYPE,"*",err,error))// &
342  & " for a setup type of "//trim(numbertovstring(equationssetsetup%SETUP_TYPE,"*",err,error))// &
343  & " is invalid for a characteristic equation."
344  CALL flagerror(localerror,err,error,*999)
345  END SELECT
346  CASE DEFAULT
347  localerror="The third equations set specification of "// &
348  & trim(numbertovstring(equationsset%specification(3),"*",err,error))// &
349  & " is invalid for a characteristic equations set."
350  CALL flagerror(localerror,err,error,*999)
351  END SELECT
352  !-----------------------------------------------------------------
353  ! D e p e n d e n t f i e l d
354  !-----------------------------------------------------------------
355  CASE(equations_set_setup_dependent_type)
356  SELECT CASE(equationsset%specification(3))
357  CASE(equations_set_characteristic_subtype)
358  SELECT CASE(equationssetsetup%ACTION_TYPE)
359  !Set start action
360  CASE(equations_set_setup_start_action)
361  IF(equationsset%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
362  !Create the auto created dependent field
363  !start field creation with name 'DEPENDENT_FIELD'
364  CALL field_create_start(equationssetsetup%FIELD_USER_NUMBER,equationsset%REGION, &
365  & equationsset%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
366  !start creation of a new field
367  CALL field_type_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
368  !label the field
369  CALL field_label_set(equationsset%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
370  !define new created field to be dependent
371  CALL field_dependent_type_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD, &
372  & field_dependent_type,err,error,*999)
373  !look for decomposition rule already defined
374  CALL field_mesh_decomposition_get(equationsset%GEOMETRY%GEOMETRIC_FIELD,geometricdecomposition, &
375  & err,error,*999)
376  !apply decomposition rule found on new created field
377  CALL field_mesh_decomposition_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD, &
378  & geometricdecomposition,err,error,*999)
379  !point new field to geometric field
380  CALL field_geometric_field_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD,equationsset%GEOMETRY% &
381  & geometric_field,err,error,*999)
382  !set number of variables to 5 (U,DELUDELN,V,U1,U2)=>(Q,A;dQ,dA;W;pCellML;Pressure)
383  dependentfieldnumberofvariables=5
384  CALL field_number_of_variables_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD, &
385  & dependentfieldnumberofvariables,err,error,*999)
386  CALL field_variable_types_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD,[field_u_variable_type, &
387  & field_deludeln_variable_type,field_v_variable_type,field_u1_variable_type,field_u2_variable_type], &
388  & err,error,*999)
389  ! set dimension
390  CALL field_dimension_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
391  & field_vector_dimension_type,err,error,*999)
392  CALL field_dimension_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
393  & field_vector_dimension_type,err,error,*999)
394  CALL field_dimension_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
395  & field_vector_dimension_type,err,error,*999)
396  CALL field_dimension_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD,field_u1_variable_type, &
397  & field_vector_dimension_type,err,error,*999)
398  CALL field_dimension_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD,field_u2_variable_type, &
399  & field_vector_dimension_type,err,error,*999)
400  ! set data type
401  CALL field_data_type_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
402  & field_dp_type,err,error,*999)
403  CALL field_data_type_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
404  & field_dp_type,err,error,*999)
405  CALL field_data_type_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
406  & field_dp_type,err,error,*999)
407  CALL field_data_type_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD,field_u1_variable_type, &
408  & field_dp_type,err,error,*999)
409  CALL field_data_type_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD,field_u2_variable_type, &
410  & field_dp_type,err,error,*999)
411  ! number of components for U,DELUDELN=2 (Q,A)
412  dependentfieldnumberofcomponents=2
413  CALL field_number_of_components_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD, &
414  & field_u_variable_type,dependentfieldnumberofcomponents,err,error,*999)
415  CALL field_number_of_components_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD, &
416  & field_deludeln_variable_type,dependentfieldnumberofcomponents,err,error,*999)
417  CALL field_number_of_components_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD, &
418  & field_v_variable_type,dependentfieldnumberofcomponents,err,error,*999)
419  CALL field_number_of_components_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD, &
420  & field_u1_variable_type,dependentfieldnumberofcomponents,err,error,*999)
421  CALL field_number_of_components_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD, &
422  & field_u2_variable_type,dependentfieldnumberofcomponents,err,error,*999)
423  CALL field_component_mesh_component_get(equationsset%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
424  & 1,geometricmeshcomponent,err,error,*999)
425  !Default to the geometric interpolation setup for U,dUdN
426  DO componentidx=1,dependentfieldnumberofcomponents
427  CALL field_component_mesh_component_set(equationsset%DEPENDENT%DEPENDENT_FIELD, &
428  & field_u_variable_type,componentidx,geometricmeshcomponent,err,error,*999)
429  CALL field_component_mesh_component_set(equationsset%DEPENDENT%DEPENDENT_FIELD, &
430  & field_deludeln_variable_type,componentidx,geometricmeshcomponent,err,error,*999)
431  CALL field_component_mesh_component_set(equationsset%DEPENDENT%DEPENDENT_FIELD, &
432  & field_v_variable_type,componentidx,geometricmeshcomponent,err,error,*999)
433  CALL field_component_mesh_component_set(equationsset%DEPENDENT%DEPENDENT_FIELD, &
434  & field_u1_variable_type,componentidx,geometricmeshcomponent,err,error,*999)
435  CALL field_component_mesh_component_set(equationsset%DEPENDENT%DEPENDENT_FIELD, &
436  & field_u2_variable_type,componentidx,geometricmeshcomponent,err,error,*999)
437  END DO
438  SELECT CASE(equationsset%SOLUTION_METHOD)
439  !Specify nodal solution method
440  CASE(equations_set_nodal_solution_method)
441  ! (U, dUdN); 2 components (Q,A)
442  DO componentidx=1,dependentfieldnumberofcomponents
443  CALL field_component_interpolation_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD, &
444  & field_u_variable_type,componentidx,field_node_based_interpolation,err,error,*999)
445  CALL field_component_interpolation_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD, &
446  & field_deludeln_variable_type,componentidx,field_node_based_interpolation,err,error,*999)
447  CALL field_component_interpolation_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD, &
448  & field_v_variable_type,componentidx,field_node_based_interpolation,err,error,*999)
449  CALL field_component_interpolation_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD, &
450  & field_u1_variable_type,componentidx,field_node_based_interpolation,err,error,*999)
451  CALL field_component_interpolation_set_and_lock(equationsset%DEPENDENT%DEPENDENT_FIELD, &
452  & field_u2_variable_type,componentidx,field_node_based_interpolation,err,error,*999)
453  ENDDO
454  CALL field_scaling_type_get(equationsset%GEOMETRY%GEOMETRIC_FIELD,geometricscalingtype, &
455  & err,error,*999)
456  CALL field_scaling_type_set(equationsset%DEPENDENT%DEPENDENT_FIELD,geometricscalingtype, &
457  & err,error,*999)
458  CASE DEFAULT
459  localerror="The solution method of " &
460  & //trim(numbertovstring(equationsset%SOLUTION_METHOD,"*",err,error))// " is invalid."
461  CALL flagerror(localerror,err,error,*999)
462  END SELECT
463  ELSE
464  !Check the user specified field
465  CALL field_type_check(equationssetsetup%FIELD,field_general_type,err,error,*999)
466  CALL field_dependent_type_check(equationssetsetup%FIELD,field_dependent_type,err,error,*999)
467  dependentfieldnumberofvariables=5 ! U,dUdN,V,U1,U2
468  CALL field_number_of_variables_check(equationssetsetup%FIELD,dependentfieldnumberofvariables,err,error,*999)
469  CALL field_variable_types_check(equationssetsetup%FIELD,[field_u_variable_type, &
470  & field_deludeln_variable_type,field_v_variable_type,field_u1_variable_type,field_u2_variable_type] &
471  & ,err,error,*999)
472  CALL field_dimension_check(equationssetsetup%FIELD,field_u_variable_type, &
473  & field_vector_dimension_type,err,error,*999)
474  CALL field_dimension_check(equationssetsetup%FIELD,field_deludeln_variable_type, &
475  & field_vector_dimension_type,err,error,*999)
476  CALL field_dimension_check(equationssetsetup%FIELD,field_v_variable_type, &
477  & field_vector_dimension_type,err,error,*999)
478  CALL field_dimension_check(equationssetsetup%FIELD,field_u1_variable_type, &
479  & field_vector_dimension_type,err,error,*999)
480  CALL field_dimension_check(equationssetsetup%FIELD,field_u2_variable_type, &
481  & field_vector_dimension_type,err,error,*999)
482  CALL field_data_type_check(equationssetsetup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
483  CALL field_data_type_check(equationssetsetup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
484  CALL field_data_type_check(equationssetsetup%FIELD,field_v_variable_type,field_dp_type,err,error,*999)
485  CALL field_data_type_check(equationssetsetup%FIELD,field_u1_variable_type,field_dp_type,err,error,*999)
486  CALL field_data_type_check(equationssetsetup%FIELD,field_u2_variable_type,field_dp_type,err,error,*999)
487  !calculate number of components (Q,A) for U and dUdN
488  dependentfieldnumberofcomponents=2
489  CALL field_number_of_components_check(equationssetsetup%FIELD,field_u_variable_type, &
490  & dependentfieldnumberofcomponents,err,error,*999)
491  CALL field_number_of_components_check(equationssetsetup%FIELD,field_deludeln_variable_type, &
492  & dependentfieldnumberofcomponents,err,error,*999)
493  CALL field_number_of_components_check(equationssetsetup%FIELD,field_v_variable_type, &
494  & dependentfieldnumberofcomponents,err,error,*999)
495  CALL field_number_of_components_check(equationssetsetup%FIELD,field_u1_variable_type, &
496  & dependentfieldnumberofcomponents,err,error,*999)
497  CALL field_number_of_components_check(equationssetsetup%FIELD,field_u2_variable_type, &
498  & dependentfieldnumberofcomponents,err,error,*999)
499  SELECT CASE(equationsset%SOLUTION_METHOD)
500  CASE(equations_set_nodal_solution_method)
501  CALL field_component_interpolation_check(equationssetsetup%FIELD,field_u_variable_type,1, &
502  & field_node_based_interpolation,err,error,*999)
503  CALL field_component_interpolation_check(equationssetsetup%FIELD,field_deludeln_variable_type,1, &
504  & field_node_based_interpolation,err,error,*999)
505  CALL field_component_interpolation_check(equationssetsetup%FIELD,field_v_variable_type,1, &
506  & field_node_based_interpolation,err,error,*999)
507  CALL field_component_interpolation_check(equationssetsetup%FIELD,field_u1_variable_type,1, &
508  & field_node_based_interpolation,err,error,*999)
509  CALL field_component_interpolation_check(equationssetsetup%FIELD,field_u2_variable_type,1, &
510  & field_node_based_interpolation,err,error,*999)
511  CASE DEFAULT
512  localerror="The solution method of "//trim(numbertovstring(equationsset%SOLUTION_METHOD, &
513  & "*",err,error))//" is invalid."
514  CALL flagerror(localerror,err,error,*999)
515  END SELECT
516  ENDIF
517  !Specify finish action
518  CASE(equations_set_setup_finish_action)
519  IF(equationsset%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
520  CALL field_create_finish(equationsset%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
521  ENDIF
522  CASE DEFAULT
523  localerror="The third equations set specification of "// &
524  & trim(number_to_vstring(equationsset%specification(3),"*",err,error))// &
525  & " is invalid for a characteristic equations set."
526  CALL flagerror(localerror,err,error,*999)
527  END SELECT
528  CASE DEFAULT
529  localerror="The third equations set specification of "// &
530  & trim(number_to_vstring(equationsset%specification(3),"*",err,error))// &
531  & " is invalid for a characteristic equations set."
532  CALL flagerror(localerror,err,error,*999)
533  END SELECT
534  !-----------------------------------------------------------------
535  ! I n d e p e n d e n t f i e l d
536  !-----------------------------------------------------------------
537  CASE(equations_set_setup_independent_type)
538  SELECT CASE(equationsset%specification(3))
539  CASE(equations_set_characteristic_subtype)
540  SELECT CASE(equationssetsetup%ACTION_TYPE)
541  !Set start action
542  CASE(equations_set_setup_start_action)
543  independentfieldnumberofvariables=1 !set number of variables to 1 (W)
544  independentfieldnumberofcomponents=2 !normalDirection for wave relative to node for W1,W2
545  IF(equationsset%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
546  !Create the auto created independent field
547  !start field creation with name 'INDEPENDENT_FIELD'
548  CALL field_create_start(equationssetsetup%FIELD_USER_NUMBER,equationsset%REGION, &
549  & equationsset%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
550  !start creation of a new field
551  CALL field_type_set_and_lock(equationsset%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
552  !label the field
553  CALL field_label_set(equationsset%INDEPENDENT%INDEPENDENT_FIELD,"Independent Field",err,error, &
554  & *999)
555  !define new created field to be independent
556  CALL field_dependent_type_set_and_lock(equationsset%INDEPENDENT%INDEPENDENT_FIELD, &
557  & field_independent_type,err,error,*999)
558  !look for decomposition rule already defined
559  CALL field_mesh_decomposition_get(equationsset%GEOMETRY%GEOMETRIC_FIELD,geometricdecomposition, &
560  & err,error,*999)
561  !apply decomposition rule found on new created field
562  CALL field_mesh_decomposition_set_and_lock(equationsset%INDEPENDENT%INDEPENDENT_FIELD, &
563  & geometricdecomposition,err,error,*999)
564  !point new field to geometric field
565  CALL field_geometric_field_set_and_lock(equationsset%INDEPENDENT%INDEPENDENT_FIELD, &
566  & equationsset%GEOMETRY%GEOMETRIC_FIELD,err,error,*999)
567  CALL field_number_of_variables_set_and_lock(equationsset%INDEPENDENT%INDEPENDENT_FIELD, &
568  & independentfieldnumberofvariables,err,error,*999)
569  CALL field_variable_types_set_and_lock(equationsset%INDEPENDENT%INDEPENDENT_FIELD, &
570  & [field_u_variable_type],err,error,*999)
571  CALL field_dimension_set_and_lock(equationsset%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
572  & field_vector_dimension_type,err,error,*999)
573  !characteristic normal direction (normalWave) is +/- 1
574  CALL field_data_type_set_and_lock(equationsset%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
575  & field_dp_type,err,error,*999)
576  !calculate number of components with one component for each dimension
577  CALL field_number_of_components_set_and_lock(equationsset%INDEPENDENT%INDEPENDENT_FIELD, &
578  & field_u_variable_type,independentfieldnumberofcomponents,err,error,*999)
579  CALL field_component_mesh_component_get(equationsset%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
580  & 1,geometricmeshcomponent,err,error,*999)
581  !Default to the geometric interpolation setup
582  DO componentidx=1,independentfieldnumberofcomponents
583  CALL field_component_mesh_component_set(equationsset%INDEPENDENT%INDEPENDENT_FIELD, &
584  & field_u_variable_type,componentidx,geometricmeshcomponent,err,error,*999)
585  END DO
586  SELECT CASE(equationsset%SOLUTION_METHOD)
587  CASE(equations_set_nodal_solution_method)
588  DO componentidx=1,independentfieldnumberofcomponents
589  CALL field_component_interpolation_set_and_lock(equationsset%INDEPENDENT%INDEPENDENT_FIELD, &
590  & field_u_variable_type,componentidx,field_node_based_interpolation,err,error,*999)
591  END DO !componentIdx
592  CALL field_scaling_type_get(equationsset%GEOMETRY%GEOMETRIC_FIELD,geometricscalingtype, &
593  & err,error,*999)
594  CASE DEFAULT
595  localerror="The solution method of " &
596  & //trim(numbertovstring(equationsset%SOLUTION_METHOD,"*",err,error))// " is invalid."
597  CALL flagerror(localerror,err,error,*999)
598  END SELECT
599  ELSE
600  !Check the user specified field
601  CALL field_type_check(equationssetsetup%FIELD,field_general_type,err,error,*999)
602  CALL field_dependent_type_check(equationssetsetup%FIELD,field_independent_type,err,error,*999)
603  CALL field_number_of_variables_check(equationssetsetup%FIELD,independentfieldnumberofvariables,err,error,*999)
604  CALL field_variable_types_check(equationssetsetup%FIELD,[field_u_variable_type],err,error,*999)
605  CALL field_dimension_check(equationssetsetup%FIELD,field_u_variable_type,field_vector_dimension_type, &
606  & err,error,*999)
607  CALL field_data_type_check(equationssetsetup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
608  CALL field_number_of_components_check(equationssetsetup%FIELD,field_u_variable_type, &
609  & independentfieldnumberofcomponents,err,error,*999)
610  ENDIF
611  !Specify finish action
612  CASE(equations_set_setup_finish_action)
613  IF(equationsset%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
614  CALL field_create_finish(equationsset%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
615  ENDIF
616  CASE DEFAULT
617  localerror="The action type of "//trim(numbertovstring(equationssetsetup%ACTION_TYPE,"*",err,error))// &
618  & " for a setup type of "//trim(numbertovstring(equationssetsetup%SETUP_TYPE,"*",err,error))// &
619  & " is invalid for a standard characteristic equations set"
620  CALL flagerror(localerror,err,error,*999)
621  END SELECT
622  CASE DEFAULT
623  localerror="The third equations set specification of "// &
624  & trim(number_to_vstring(equationsset%specification(3),"*",err,error))// &
625  & " is invalid for a standard characteristic equations set."
626  CALL flagerror(localerror,err,error,*999)
627  END SELECT
628  !-----------------------------------------------------------------
629  ! M a t e r i a l s f i e l d
630  !-----------------------------------------------------------------
631  CASE(equations_set_setup_materials_type)
632  SELECT CASE(equationsset%specification(3))
633  CASE(equations_set_characteristic_subtype)
634  materialsfieldnumberofvariables=2 ! U type-7 constant / V type-3 variable
635  materialsfieldnumberofcomponents1=8
636  materialsfieldnumberofcomponents2=3
637  SELECT CASE(equationssetsetup%ACTION_TYPE)
638  !Specify start action
639  CASE(equations_set_setup_start_action)
640  equationsmaterials=>equationsset%MATERIALS
641  IF(ASSOCIATED(equationsmaterials)) THEN
642  IF(equationsmaterials%MATERIALS_FIELD_AUTO_CREATED) THEN
643  !Create the auto created materials field
644  !start field creation with name 'MATERIAL_FIELD'
645  CALL field_create_start(equationssetsetup%FIELD_USER_NUMBER,equationsset%REGION, &
646  & equationsset%MATERIALS%MATERIALS_FIELD,err,error,*999)
647  CALL field_type_set_and_lock(equationsmaterials%MATERIALS_FIELD,field_material_type,err,error,*999)
648  !label the field
649  CALL field_label_set(equationsmaterials%MATERIALS_FIELD,"Materials Field",err,error,*999)
650  CALL field_dependent_type_set_and_lock(equationsmaterials%MATERIALS_FIELD,field_independent_type, &
651  & err,error,*999)
652  CALL field_mesh_decomposition_get(equationsset%GEOMETRY%GEOMETRIC_FIELD,geometricdecomposition, &
653  & err,error,*999)
654  !apply decomposition rule found on new created field
655  CALL field_mesh_decomposition_set_and_lock(equationsset%MATERIALS%MATERIALS_FIELD, &
656  & geometricdecomposition,err,error,*999)
657  !point new field to geometric field
658  CALL field_geometric_field_set_and_lock(equationsmaterials%MATERIALS_FIELD,equationsset%GEOMETRY% &
659  & geometric_field,err,error,*999)
660  CALL field_number_of_variables_set(equationsmaterials%MATERIALS_FIELD, &
661  & materialsfieldnumberofvariables,err,error,*999)
662  CALL field_variable_types_set_and_lock(equationsmaterials%MATERIALS_FIELD, &
663  & [field_u_variable_type,field_v_variable_type],err,error,*999)
664  CALL field_dimension_set_and_lock(equationsmaterials%MATERIALS_FIELD,field_u_variable_type, &
665  & field_vector_dimension_type,err,error,*999)
666  CALL field_dimension_set_and_lock(equationsmaterials%MATERIALS_FIELD,field_v_variable_type, &
667  & field_vector_dimension_type,err,error,*999)
668  CALL field_data_type_set_and_lock(equationsmaterials%MATERIALS_FIELD,field_u_variable_type, &
669  & field_dp_type,err,error,*999)
670  CALL field_data_type_set_and_lock(equationsmaterials%MATERIALS_FIELD,field_v_variable_type, &
671  & field_dp_type,err,error,*999)
672  CALL field_number_of_components_set_and_lock(equationsmaterials%MATERIALS_FIELD,field_u_variable_type, &
673  & materialsfieldnumberofcomponents1,err,error,*999)
674  CALL field_number_of_components_set_and_lock(equationsmaterials%MATERIALS_FIELD,field_v_variable_type, &
675  & materialsfieldnumberofcomponents2,err,error,*999)
676  CALL field_component_mesh_component_get(equationsset%GEOMETRY%GEOMETRIC_FIELD, &
677  & field_u_variable_type,1,geometriccomponentnumber,err,error,*999)
678  CALL field_component_mesh_component_set(equationsmaterials%MATERIALS_FIELD,field_u_variable_type, &
679  & 1,geometriccomponentnumber,err,error,*999)
680  CALL field_component_mesh_component_set(equationsmaterials%MATERIALS_FIELD,field_v_variable_type, &
681  & 1,geometriccomponentnumber,err,error,*999)
682  DO componentidx=1,materialsfieldnumberofcomponents1 !(MU,RHO,alpha,pressureExternal,LengthScale,TimeScale,MassScale)
683  CALL field_component_interpolation_set(equationsmaterials%MATERIALS_FIELD,field_u_variable_type, &
684  & componentidx,field_constant_interpolation,err,error,*999)
685  ENDDO
686  DO componentidx=1,materialsfieldnumberofcomponents2 !(A0,E,H0)
687  CALL field_component_interpolation_set(equationsmaterials%MATERIALS_FIELD,field_v_variable_type, &
688  & componentidx,field_node_based_interpolation,err,error,*999)
689  ENDDO
690  !Default the field scaling to that of the geometric field
691  CALL field_scaling_type_get(equationsset%GEOMETRY%GEOMETRIC_FIELD,geometricscalingtype,err,error,*999)
692  CALL field_scaling_type_set(equationsmaterials%MATERIALS_FIELD,geometricscalingtype,err,error,*999)
693  ELSE
694  !Check the user specified field
695  CALL field_type_check(equationssetsetup%FIELD,field_material_type,err,error,*999)
696  CALL field_dependent_type_check(equationssetsetup%FIELD,field_independent_type,err,error,*999)
697  CALL field_number_of_variables_check(equationssetsetup%FIELD,materialsfieldnumberofvariables,err,error,*999)
698  CALL field_variable_types_check(equationssetsetup%FIELD,[field_u_variable_type,field_v_variable_type], &
699  & err,error,*999)
700  ! U-variable
701  CALL field_dimension_check(equationssetsetup%FIELD,field_u_variable_type, &
702  & field_vector_dimension_type,err,error,*999)
703  CALL field_dimension_check(equationssetsetup%FIELD,field_v_variable_type, &
704  & field_vector_dimension_type,err,error,*999)
705  CALL field_data_type_check(equationssetsetup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
706  CALL field_data_type_check(equationssetsetup%FIELD,field_v_variable_type,field_dp_type,err,error,*999)
707  CALL field_number_of_components_check(equationssetsetup%FIELD,field_u_variable_type, &
708  & materialsfieldnumberofcomponents1,err,error,*999)
709  CALL field_number_of_components_check(equationssetsetup%FIELD,field_v_variable_type, &
710  & materialsfieldnumberofcomponents2,err,error,*999)
711  ENDIF
712  ELSE
713  CALL flagerror("Equations set materials is not associated.",err,error,*999)
714  END IF
715  !Specify start action
716  CASE(equations_set_setup_finish_action)
717  equationsmaterials=>equationsset%MATERIALS
718  IF(ASSOCIATED(equationsmaterials)) THEN
719  IF(equationsmaterials%MATERIALS_FIELD_AUTO_CREATED) THEN
720  !Finish creating the materials field
721  CALL field_create_finish(equationsmaterials%MATERIALS_FIELD,err,error,*999)
722  ! Should be initialized from example file
723  ENDIF
724  ELSE
725  CALL flagerror("Equations set materials is not associated.",err,error,*999)
726  ENDIF
727  CASE DEFAULT
728  localerror="The action type of "//trim(numbertovstring(equationssetsetup%ACTION_TYPE,"*", &
729  & err,error))//" for a setup type of "//trim(numbertovstring(equationssetsetup%SETUP_TYPE,"*", &
730  & err,error))//" is invalid for characteristic equation."
731  CALL flagerror(localerror,err,error,*999)
732  END SELECT
733  CASE DEFAULT
734  localerror="The third equations set specification of "// &
735  & trim(number_to_vstring(equationsset%specification(3),"*",err,error))// &
736  & " is invalid for a characteristic equation."
737  CALL flagerror(localerror,err,error,*999)
738  END SELECT
739  !-----------------------------------------------------------------
740  ! E q u a t i o n s t y p e
741  !-----------------------------------------------------------------
742  CASE(equations_set_setup_equations_type)
743  SELECT CASE(equationsset%specification(3))
744  CASE(equations_set_characteristic_subtype)
745  SELECT CASE(equationssetsetup%ACTION_TYPE)
746  CASE(equations_set_setup_start_action)
747  equationsmaterials=>equationsset%MATERIALS
748  IF(ASSOCIATED(equationsmaterials)) THEN
749  IF(equationsmaterials%MATERIALS_FINISHED) THEN
750  CALL equations_create_start(equationsset,equations,err,error,*999)
751  CALL equations_linearity_type_set(equations,equations_nonlinear,err,error,*999)
752  CALL equations_time_dependence_type_set(equations,equations_static,err,error,*999)
753  ELSE
754  CALL flagerror("Equations set materials has not been finished.",err,error,*999)
755  ENDIF
756  ELSE
757  CALL flagerror("Equations materials is not associated.",err,error,*999)
758  ENDIF
759  CASE(equations_set_setup_finish_action)
760  SELECT CASE(equationsset%SOLUTION_METHOD)
761  CASE(equations_set_nodal_solution_method)
762  !Finish the creation of the equations
763  CALL equations_set_equations_get(equationsset,equations,err,error,*999)
764  CALL equations_create_finish(equations,err,error,*999)
765  !Create the equations mapping.
766  CALL equations_mapping_create_start(equations,equationsmapping,err,error,*999)
767  CALL equationsmapping_linearmatricesnumberset(equationsmapping,1,err,error,*999)
768  CALL equationsmapping_linearmatricesvariabletypesset(equationsmapping,[field_u_variable_type],err,error,*999)
769  CALL equations_mapping_rhs_variable_type_set(equationsmapping,field_deludeln_variable_type, &
770  & err,error,*999)
771  CALL equations_mapping_create_finish(equationsmapping,err,error,*999)
772  !Create the equations matrices
773  CALL equations_matrices_create_start(equations,equationsmatrices,err,error,*999)
774  ! Use the analytic Jacobian calculation
775  CALL equationsmatrices_jacobiantypesset(equationsmatrices,[equations_jacobian_analytic_calculated], &
776  & err,error,*999)
777  SELECT CASE(equations%SPARSITY_TYPE)
778  CASE(equations_matrices_full_matrices)
779  CALL equations_matrices_linear_storage_type_set(equationsmatrices,[matrix_block_storage_type], &
780  & err,error,*999)
781  CALL equationsmatrices_nonlinearstoragetypeset(equationsmatrices,matrix_block_storage_type, &
782  & err,error,*999)
783  CASE(equations_matrices_sparse_matrices)
784  CALL equations_matrices_linear_storage_type_set(equationsmatrices, &
785  & [matrix_compressed_row_storage_type],err,error,*999)
786  CALL equationsmatrices_linearstructuretypeset(equationsmatrices, &
787  & [equations_matrix_nodal_structure],err,error,*999)
788  CALL equationsmatrices_nonlinearstoragetypeset(equationsmatrices, &
789  & matrix_compressed_row_storage_type,err,error,*999)
790  CALL equationsmatrices_nonlinearstructuretypeset(equationsmatrices, &
791  & equations_matrix_nodal_structure,err,error,*999)
792  CASE DEFAULT
793  localerror="The equations matrices sparsity type of "// &
794  & trim(numbertovstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
795  CALL flagerror(localerror,err,error,*999)
796  END SELECT
797  CALL equations_matrices_create_finish(equationsmatrices,err,error,*999)
798  CASE(equations_set_bem_solution_method)
799  CALL flagerror("Not implemented.",err,error,*999)
800  CASE(equations_set_fd_solution_method)
801  CALL flagerror("Not implemented.",err,error,*999)
802  CASE(equations_set_fv_solution_method)
803  CALL flagerror("Not implemented.",err,error,*999)
804  CASE(equations_set_gfem_solution_method)
805  CALL flagerror("Not implemented.",err,error,*999)
806  CASE(equations_set_gfv_solution_method)
807  CALL flagerror("Not implemented.",err,error,*999)
808  CASE DEFAULT
809  localerror="The solution method of "//trim(numbertovstring(equationsset%SOLUTION_METHOD, &
810  & "*",err,error))//" is invalid."
811  CALL flagerror(localerror,err,error,*999)
812  END SELECT
813  CASE DEFAULT
814  localerror="The action type of "//trim(numbertovstring(equationssetsetup%ACTION_TYPE,"*",err,error))// &
815  & " for a setup type of "//trim(numbertovstring(equationssetsetup%SETUP_TYPE,"*",err,error))// &
816  & " is invalid for a characteristics equation."
817  CALL flagerror(localerror,err,error,*999)
818  END SELECT
819  CASE DEFAULT
820  localerror="The third equations set specification of "// &
821  & trim(number_to_vstring(equationsset%specification(3),"*",err,error))// &
822  & " is invalid for a characteristics equation."
823  CALL flagerror(localerror,err,error,*999)
824  END SELECT
825  CASE DEFAULT
826  localerror="The setup type of "//trim(numbertovstring(equationssetsetup%SETUP_TYPE,"*",err,error))// &
827  & " is invalid for a characteristics equation set."
828  CALL flagerror(localerror,err,error,*999)
829  END SELECT
830  CASE DEFAULT
831  localerror="The third equations set specification of "// &
832  & trim(number_to_vstring(equationsset%specification(3),"*",err,error))// &
833  & " does not equal a characteristics equation set."
834  CALL flagerror(localerror,err,error,*999)
835  END SELECT
836  ELSE
837  CALL flagerror("Equations set is not associated.",err,error,*999)
838  ENDIF
839 
840  exits("Characteristic_EquationsSetSetup")
841  RETURN
842 999 errorsexits("Characteristic_EquationsSetSetup",err,error)
843  RETURN 1
844 
845  END SUBROUTINE characteristic_equationssetsetup
846 
847  !
848  !================================================================================================================================
849  !
850 
852  SUBROUTINE characteristic_nodalresidualevaluate(equationsSet,nodeNumber,err,error,*)
853 
854  !Argument variables
855  TYPE(equations_set_type), POINTER :: equationsSet
856  INTEGER(INTG), INTENT(IN) :: nodeNumber
857  INTEGER(INTG), INTENT(OUT) :: err
858  TYPE(varying_string), INTENT(OUT) :: error
859  !Local Variables
860  TYPE(domain_nodes_type), POINTER :: domainNodes
861  TYPE(domain_type), POINTER :: domain
862  TYPE(equations_type), POINTER :: equations
863  TYPE(equations_mapping_type), POINTER :: equationsMapping
864  TYPE(equations_matrices_type), POINTER :: equationsMatrices
865  TYPE(equations_mapping_linear_type), POINTER :: linearMapping
866  TYPE(equations_matrices_linear_type), POINTER :: linearMatrices
867  TYPE(equations_mapping_nonlinear_type), POINTER :: nonlinearMapping
868  TYPE(equations_matrices_nonlinear_type), POINTER :: nonlinearMatrices
869  TYPE(equations_matrix_type), POINTER :: stiffnessMatrix
870  TYPE(field_type), POINTER :: materialsField,dependentField,independentField
871  TYPE(field_variable_type), POINTER :: fieldVariable
872  TYPE(varying_string) :: localError
873  REAL(DP), POINTER :: dependentParameters(:),independentParameters(:),materialsParameters(:)
874  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),SUM,rho
875  INTEGER(INTG) :: derivativeIdx,versionIdx,versionIdx2,componentIdx,rowIdx,columnIdx,componentIdx2,numberOfVersions
876  LOGICAL :: updateStiffnessMatrix,updateNonlinearResidual,boundaryNode
877 
878  enters("Characteristic_NodalResidualEvaluate",err,error,*999)
879 
880  NULLIFY(equations)
881  NULLIFY(equationsmapping)
882  NULLIFY(equationsmapping)
883  NULLIFY(equationsmatrices)
884  NULLIFY(linearmapping)
885  NULLIFY(linearmatrices)
886  NULLIFY(nonlinearmapping)
887  NULLIFY(nonlinearmatrices)
888  NULLIFY(stiffnessmatrix)
889  NULLIFY(dependentfield)
890  NULLIFY(independentfield)
891  NULLIFY(materialsfield)
892  NULLIFY(domain)
893  NULLIFY(domainnodes)
894  NULLIFY(dependentparameters)
895  NULLIFY(independentparameters)
896  NULLIFY(materialsparameters)
897  NULLIFY(fieldvariable)
898 
899  updatestiffnessmatrix=.false.
900  updatenonlinearresidual=.false.
901 
902  IF(ASSOCIATED(equationsset)) THEN
903  equations=>equationsset%EQUATIONS
904  IF(ASSOCIATED(equations)) THEN
905  dependentfield=>equations%EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD
906  IF(ASSOCIATED(dependentfield)) THEN
907  domain=>dependentfield%DECOMPOSITION%DOMAIN(dependentfield%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR
908  IF(ASSOCIATED(domain)) THEN
909  domainnodes=>domain%TOPOLOGY%NODES
910  ELSE
911  CALL flagerror("Domain is not associated.",err,error,*999)
912  ENDIF
913  ELSE
914  CALL flagerror("Dependent Field is not associated.",err,error,*999)
915  ENDIF
916  ELSE
917  CALL flagerror("Equations set equations is not associated.",err,error,*999)
918  ENDIF
919  ELSE
920  CALL flagerror("Equations set is not associated.",err,error,*999)
921  ENDIF
922 
923  IF(.NOT.ALLOCATED(equationsset%specification)) THEN
924  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
925  ELSE IF(SIZE(equationsset%specification,1)/=3) THEN
926  CALL flagerror("Equations set specification must have three entries for a characteristic type equations set.", &
927  & err,error,*999)
928  END IF
929  SELECT CASE(equationsset%specification(3))
930  CASE(equations_set_characteristic_subtype)
931  !Set General and Specific Pointers
932  independentfield=>equations%INTERPOLATION%INDEPENDENT_FIELD
933  materialsfield=>equations%INTERPOLATION%MATERIALS_FIELD
934  equationsmatrices=>equations%EQUATIONS_MATRICES
935  equationsmapping=>equations%EQUATIONS_MAPPING
936  linearmatrices=>equationsmatrices%LINEAR_MATRICES
937  nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
938  stiffnessmatrix=>linearmatrices%MATRICES(1)%PTR
939  linearmapping=>equationsmapping%LINEAR_MAPPING
940  nonlinearmapping=>equationsmapping%NONLINEAR_MAPPING
941  stiffnessmatrix%NodalMatrix%matrix=0.0_dp
942  nonlinearmatrices%NodalResidual%vector=0.0_dp
943  IF(ASSOCIATED(stiffnessmatrix)) updatestiffnessmatrix=stiffnessmatrix%UPDATE_MATRIX
944  IF(ASSOCIATED(nonlinearmatrices)) updatenonlinearresidual=nonlinearmatrices%UPDATE_RESIDUAL
945 
946  derivativeidx=1
947  normalwave=0.0_dp
948  numberofversions=domainnodes%NODES(nodenumber)%DERIVATIVES(derivativeidx)%numberOfVersions
949  boundarynode=dependentfield%DECOMPOSITION%DOMAIN(dependentfield%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
950  & topology%NODES%NODES(nodenumber)%BOUNDARY_NODE
951 
952  !Get normal wave direction for nodes
953  DO componentidx=1,2
954  DO versionidx=1,numberofversions
955  CALL field_parametersetgetlocalnode(independentfield,field_u_variable_type,field_values_set_type, &
956  & versionidx,derivativeidx,nodenumber,componentidx,normalwave(componentidx,versionidx),err,error,*999)
957  ENDDO
958  ENDDO
959 
960  !!!-- F i n d B r a n c h N o d e s --!!!
961  IF(abs(normalwave(1,1))>0 .OR. abs(normalwave(2,1))>0) THEN
962  IF(.NOT. boundarynode) THEN
963 
964  !Get material constants
965  CALL field_parameter_set_get_constant(materialsfield,field_u_variable_type,field_values_set_type,2,rho,err,error,*999)
966  !Get node-based material parameters
967  DO versionidx=1,numberofversions
968  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type,field_values_set_type, &
969  & versionidx,derivativeidx,nodenumber,1,a0_param(versionidx),err,error,*999)
970  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type,field_values_set_type, &
971  & versionidx,derivativeidx,nodenumber,2,e_param(versionidx),err,error,*999)
972  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type,field_values_set_type, &
973  & versionidx,derivativeidx,nodenumber,3,h0_param(versionidx),err,error,*999)
974  beta(versionidx)=(4.0_dp*sqrt(pi)*e_param(versionidx)*h0_param(versionidx))/(3.0_dp*a0_param(versionidx))
975  ENDDO
976 
977  DO versionidx=1,numberofversions
978  !Get current Q & A Values at the node
979  CALL field_parametersetgetlocalnode(dependentfield,field_u_variable_type,field_values_set_type, &
980  & versionidx,derivativeidx,nodenumber,1,q_bif(versionidx),err,error,*999)
981  CALL field_parametersetgetlocalnode(dependentfield,field_u_variable_type,field_values_set_type, &
982  & versionidx,derivativeidx,nodenumber,2,a_bif(versionidx),err,error,*999)
983  !Set as upwind field values
984  CALL field_parameter_set_update_local_node(dependentfield,field_u_variable_type, &
985  & field_upwind_values_set_type,versionidx,1,nodenumber,1,q_bif(versionidx),err,error,*999)
986  CALL field_parameter_set_update_local_node(dependentfield,field_u_variable_type, &
987  & field_upwind_values_set_type,versionidx,1,nodenumber,2,a_bif(versionidx),err,error,*999)
988  ! If A goes negative during nonlinear iteration, set to A0
989  IF (a_bif(versionidx) < a0_param(versionidx)*0.001_dp) a_bif(versionidx) = a0_param(versionidx)*0.001_dp
990  ENDDO
991 
992  !Get extrapolated W for the node
993  DO componentidx=1,2
994  DO versionidx=1,numberofversions
995  CALL field_parametersetgetlocalnode(dependentfield,field_v_variable_type,field_values_set_type, &
996  & versionidx,derivativeidx,nodenumber,componentidx,w(componentidx,versionidx),err,error,*999)
997  ENDDO
998  ENDDO
999 
1000  !!!-- S T I F F N E S S M A T R I X --!!!
1001  IF(updatestiffnessmatrix) THEN
1002  !Conservation of Mass
1003  rowidx=numberofversions+1
1004  columnidx=0
1005  DO componentidx=1,2
1006  DO versionidx=1,numberofversions
1007  IF(abs(normalwave(componentidx,versionidx))>zero_tolerance) THEN
1008  columnidx=columnidx+1
1009  stiffnessmatrix%NodalMatrix%matrix(rowidx,columnidx)=normalwave(componentidx,versionidx)
1010  ENDIF
1011  ENDDO
1012  ENDDO
1013  ENDIF
1014 
1015  !!!-- N O N L I N E A R V E C T O R --!!!
1016  IF(updatenonlinearresidual) THEN
1017  rowidx=0
1018  !Characteristics Equations
1019  DO componentidx=1,2
1020  DO versionidx=1,numberofversions
1021  IF(abs(normalwave(componentidx,versionidx))>zero_tolerance) THEN
1022  rowidx=rowidx+1
1023  nonlinearmatrices%NodalResidual%vector(rowidx)=(q_bif(versionidx)/a_bif(versionidx)) &
1024  & +normalwave(componentidx,versionidx)*4.0_dp*sqrt(beta(versionidx)/(2.0_dp*rho))* &
1025  & (a_bif(versionidx)**0.25_dp - a0_param(versionidx)**0.25_dp)-w(componentidx,versionidx)
1026  ENDIF
1027  ENDDO
1028  ENDDO
1029  !Continuity of Total Pressure
1030  DO componentidx=1,2
1031  DO versionidx=1,numberofversions
1032  IF(abs(normalwave(componentidx,versionidx))>zero_tolerance) THEN
1033  rowidx=rowidx+1
1034  IF(versionidx==1) THEN
1035  sum=0.0_dp
1036  DO componentidx2=1,2
1037  DO versionidx2=1,numberofversions
1038  sum=sum+normalwave(componentidx2,versionidx2)*q_bif(versionidx2)
1039  ENDDO
1040  ENDDO
1041  nonlinearmatrices%NodalResidual%vector(rowidx)=sum
1042  ELSE
1043  nonlinearmatrices%NodalResidual%vector(rowidx)= &
1044  & (rho/2.0_dp*((q_bif(1)/a_bif(1))**2.0_dp) + beta(1)*(sqrt(a_bif(1)) - sqrt(a0_param(1)))) - &
1045  & (rho/2.0_dp*((q_bif(versionidx)/a_bif(versionidx))**2.0_dp) + &
1046  & beta(versionidx)*(sqrt(a_bif(versionidx)) - sqrt(a0_param(versionidx))))
1047  ENDIF
1048  ENDIF
1049  ENDDO
1050  ENDDO
1051  ENDIF
1052 
1053  ENDIF
1054  ENDIF !Find branch nodes
1055 
1056  CASE DEFAULT
1057  localerror="The third equations set specification of "// &
1058  & trim(number_to_vstring(equationsset%specification(3),"*",err,error))// &
1059  & " is not valid for a characteristic type of a fluid mechanics equations set."
1060  CALL flagerror(localerror,err,error,*999)
1061  END SELECT
1062 
1063  exits("Characteristic_NodalResidualEvaluate")
1064  RETURN
1065 999 errorsexits("Characteristic_NodalResidualEvaluate",err,error)
1066  RETURN 1
1067 
1068  END SUBROUTINE characteristic_nodalresidualevaluate
1069 
1070  !
1071  !================================================================================================================================
1072  !
1073 
1075  SUBROUTINE characteristic_nodaljacobianevaluate(equationsSet,nodeNumber,err,error,*)
1076 
1077  !Argument variables
1078  TYPE(equations_set_type), POINTER :: equationsSet
1079  INTEGER(INTG), INTENT(IN) :: nodeNumber
1080  INTEGER(INTG), INTENT(OUT) :: err
1081  TYPE(varying_string), INTENT(OUT) :: error
1082  !Local Variables
1083  TYPE(domain_nodes_type), POINTER :: domainNodes
1084  TYPE(domain_type), POINTER :: domain
1085  TYPE(equations_type), POINTER :: equations
1086  TYPE(equations_mapping_type), POINTER :: equationsMapping
1087  TYPE(equations_matrices_type), POINTER :: equationsMatrices
1088  TYPE(equations_mapping_linear_type), POINTER :: linearMapping
1089  TYPE(equations_matrices_linear_type), POINTER :: linearMatrices
1090  TYPE(equations_mapping_nonlinear_type), POINTER :: nonlinearMapping
1091  TYPE(equations_matrices_nonlinear_type), POINTER :: nonlinearMatrices
1092  TYPE(equations_jacobian_type), POINTER :: jacobianMatrix
1093  TYPE(field_type), POINTER :: materialsField,dependentField,independentField
1094  TYPE(field_variable_type), POINTER :: fieldVariable
1095  TYPE(varying_string) :: localError
1096  REAL(DP), POINTER :: dependentParameters(:),independentParameters(:),materialsParameters(:)
1097  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),rho
1098  INTEGER(INTG) :: numberOfVersions,local_ny,startColumn2
1099  INTEGER(INTG) :: derivativeIdx,versionIdx,rowIdx,columnIdx,columnIdx2,startRow,endRow,componentIdx
1100  LOGICAL :: updateJacobianMatrix,boundaryNode
1101 
1102  enters("Characteristic_NodalJacobianEvaluate",err,error,*999)
1103 
1104  NULLIFY(equations)
1105  NULLIFY(equationsmapping)
1106  NULLIFY(equationsmapping)
1107  NULLIFY(equationsmatrices)
1108  NULLIFY(linearmapping)
1109  NULLIFY(linearmatrices)
1110  NULLIFY(nonlinearmapping)
1111  NULLIFY(nonlinearmatrices)
1112  NULLIFY(jacobianmatrix)
1113  NULLIFY(dependentfield)
1114  NULLIFY(independentfield)
1115  NULLIFY(materialsfield)
1116  NULLIFY(domain)
1117  NULLIFY(domainnodes)
1118  NULLIFY(dependentparameters)
1119  NULLIFY(independentparameters)
1120  NULLIFY(materialsparameters)
1121  NULLIFY(fieldvariable)
1122 
1123  updatejacobianmatrix=.false.
1124 
1125  IF(ASSOCIATED(equationsset)) THEN
1126  equations=>equationsset%EQUATIONS
1127  IF(ASSOCIATED(equations)) THEN
1128  dependentfield=>equations%EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD
1129  IF(ASSOCIATED(dependentfield)) THEN
1130  domain=>dependentfield%DECOMPOSITION%DOMAIN(dependentfield%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR
1131  IF(ASSOCIATED(domain)) THEN
1132  domainnodes=>domain%TOPOLOGY%NODES
1133  ELSE
1134  CALL flagerror("Domain is not associated.",err,error,*999)
1135  ENDIF
1136  ELSE
1137  CALL flagerror("Dependent Field is not associated.",err,error,*999)
1138  ENDIF
1139  ELSE
1140  CALL flagerror("Equations set equations is not associated.",err,error,*999)
1141  ENDIF
1142  ELSE
1143  CALL flagerror("Equations set is not associated.",err,error,*999)
1144  ENDIF
1145 
1146  IF(.NOT.ALLOCATED(equationsset%specification)) THEN
1147  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
1148  ELSE IF(SIZE(equationsset%specification,1)/=3) THEN
1149  CALL flagerror("Equations set specification must have three entries for a characteristic type equations set.", &
1150  & err,error,*999)
1151  END IF
1152  SELECT CASE(equationsset%specification(3))
1153  CASE(equations_set_characteristic_subtype)
1154  !Set General and Specific Pointers
1155  independentfield=>equations%EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD
1156  materialsfield=>equations%INTERPOLATION%MATERIALS_FIELD
1157  equationsmatrices=>equations%EQUATIONS_MATRICES
1158  equationsmapping=>equations%EQUATIONS_MAPPING
1159  linearmatrices=>equationsmatrices%LINEAR_MATRICES
1160  nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
1161  nonlinearmapping=>equationsmapping%NONLINEAR_MAPPING
1162  linearmapping=>equationsmapping%LINEAR_MAPPING
1163  jacobianmatrix=>nonlinearmatrices%JACOBIANS(1)%PTR
1164  jacobianmatrix%NodalJacobian%matrix=0.0_dp
1165  IF(ASSOCIATED(jacobianmatrix)) updatejacobianmatrix=jacobianmatrix%UPDATE_JACOBIAN
1166 
1167  derivativeidx=1
1168  normalwave=0.0_dp
1169  numberofversions=domainnodes%NODES(nodenumber)%DERIVATIVES(derivativeidx)%numberOfVersions
1170  boundarynode=dependentfield%DECOMPOSITION%DOMAIN(dependentfield%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
1171  & topology%NODES%NODES(nodenumber)%BOUNDARY_NODE
1172 
1173  !Get normal wave direction for nodes
1174  CALL field_parameter_set_data_get(independentfield,field_u_variable_type,field_values_set_type, &
1175  & independentparameters,err,error,*999)
1176  fieldvariable=>independentfield%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
1177  DO componentidx=1,2
1178  DO versionidx=1,numberofversions
1179  local_ny=fieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
1180  & nodes(nodenumber)%DERIVATIVES(derivativeidx)%VERSIONS(versionidx)
1181  normalwave(componentidx,versionidx)=independentparameters(local_ny)
1182  ENDDO
1183  ENDDO
1184  CALL field_parameter_set_data_restore(independentfield,field_u_variable_type,field_values_set_type, &
1185  & independentparameters,err,error,*999)
1186 
1187  !!!-- F i n d B r a n c h N o d e s --!!!
1188  IF(abs(normalwave(1,1))>0 .OR. abs(normalwave(2,1))>0) THEN
1189  IF(.NOT. boundarynode) THEN
1190 
1191  !Get material constants
1192  CALL field_parameter_set_get_constant(materialsfield,field_u_variable_type,field_values_set_type,2,rho,err,error,*999)
1193  !Get node-based material parameters
1194  DO versionidx=1,numberofversions
1195  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type,field_values_set_type, &
1196  & versionidx,derivativeidx,nodenumber,1,a0_param(versionidx),err,error,*999)
1197  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type,field_values_set_type, &
1198  & versionidx,derivativeidx,nodenumber,2,e_param(versionidx),err,error,*999)
1199  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type,field_values_set_type, &
1200  & versionidx,derivativeidx,nodenumber,3,h0_param(versionidx),err,error,*999)
1201  beta(versionidx)=(4.0_dp*sqrt(pi)*e_param(versionidx)*h0_param(versionidx))/(3.0_dp*a0_param(versionidx))
1202  ENDDO
1203 
1204  !Get current Q & A Values at the node
1205  DO versionidx=1,numberofversions
1206  CALL field_parametersetgetlocalnode(dependentfield,field_u_variable_type,field_values_set_type, &
1207  & versionidx,derivativeidx,nodenumber,1,q_bif(versionidx),err,error,*999)
1208  CALL field_parametersetgetlocalnode(dependentfield,field_u_variable_type,field_values_set_type, &
1209  & versionidx,derivativeidx,nodenumber,2,a_bif(versionidx),err,error,*999)
1210  ! If A goes negative during nonlinear iteration, set to A0
1211  IF (a_bif(versionidx) < a0_param(versionidx)*0.001_dp) a_bif(versionidx) = a0_param(versionidx)*0.001_dp
1212  ENDDO
1213 
1214  !Get extrapolated W for the node
1215  DO componentidx=1,2
1216  DO versionidx=1,numberofversions
1217  CALL field_parametersetgetlocalnode(dependentfield,field_v_variable_type,field_values_set_type, &
1218  & versionidx,derivativeidx,nodenumber,componentidx,w(componentidx,versionidx),err,error,*999)
1219  ENDDO
1220  ENDDO
1221 
1222  !!!-- J A C O B I A N M A T R I X --!!!
1223  IF(updatejacobianmatrix) THEN
1224  ! Characteristic equations (dW/dU)
1225  columnidx=0
1226  rowidx=0
1227  DO componentidx=1,2
1228  DO versionidx=1,numberofversions
1229  IF(abs(normalwave(componentidx,versionidx))>zero_tolerance) THEN
1230  columnidx=columnidx+1
1231  rowidx=rowidx+1
1232  jacobianmatrix%NodalJacobian%matrix(rowidx,columnidx)=1.0_dp/a_bif(versionidx)
1233  ENDIF
1234  ENDDO
1235  ENDDO
1236  rowidx=0
1237  DO componentidx=1,2
1238  DO versionidx=1,numberofversions
1239  IF(abs(normalwave(componentidx,versionidx))>zero_tolerance) THEN
1240  columnidx=columnidx+1
1241  rowidx=rowidx+1
1242  jacobianmatrix%NodalJacobian%matrix(rowidx,columnidx)=(-q_bif(versionidx)/(a_bif(versionidx)**2)) &
1243  & +normalwave(componentidx,versionidx)*sqrt(beta(versionidx)/(2.0_dp*rho))*(a_bif(versionidx)**(-0.75_dp))
1244  ENDIF
1245  ENDDO
1246  ENDDO
1247 
1248  !Conservation of Mass
1249  rowidx=numberofversions+1
1250  columnidx = 0
1251  DO componentidx=1,2
1252  DO versionidx=1,numberofversions
1253  IF(abs(normalwave(componentidx,versionidx))>zero_tolerance) THEN
1254  columnidx=columnidx+1
1255  jacobianmatrix%NodalJacobian%matrix(rowidx,columnidx)=normalwave(componentidx,versionidx)
1256  ENDIF
1257  ENDDO
1258  ENDDO
1259 
1260  !Continuity of Total Pressure (dP/dU)
1261  startrow=numberofversions+2
1262  endRow=numberOfVersions*2
1263  startcolumn2=numberofversions+1
1264  DO rowidx=startrow,endrow
1265  columnidx=1
1266  columnidx2=startcolumn2
1267  DO componentidx=1,2
1268  DO versionidx=1,numberofversions
1269  IF(abs(normalwave(componentidx,versionidx))>zero_tolerance) THEN
1270  IF(columnidx==1) THEN
1271  ! dP/dQ
1272  jacobianmatrix%NodalJacobian%matrix(rowidx,columnidx)=rho* &
1273  & (q_bif(1)/(a_bif(1)**2.0_dp))
1274  ! dP/dA
1275  jacobianmatrix%NodalJacobian%matrix(rowidx,columnidx2)= &
1276  & beta(1)/(2.0_dp*sqrt(a_bif(1))) - &
1277  & (rho)*((q_bif(1)**2.0_dp)/(a_bif(1)**3.0_dp))
1278  ELSE IF(columnidx2==rowidx) THEN
1279  ! dP/dQ
1280  jacobianmatrix%NodalJacobian%matrix(rowidx,columnidx)=-rho* &
1281  & (q_bif(versionidx)/(a_bif(versionidx)**2.0_dp))
1282  ! dP/dA
1283  jacobianmatrix%NodalJacobian%matrix(rowidx,columnidx2)= &
1284  & -beta(versionidx)/(2.0_dp*sqrt(a_bif(versionidx))) + &
1285  & (rho)*((q_bif(versionidx)**2.0_dp)/(a_bif(versionidx)**3.0_dp))
1286  ELSE
1287  jacobianmatrix%NodalJacobian%matrix(rowidx,versionidx)=0.0_dp
1288  jacobianmatrix%NodalJacobian%matrix(rowidx,columnidx)=0.0_dp
1289  ENDIF
1290  columnidx=columnidx+1
1291  columnidx2=columnidx2+1
1292  ENDIF
1293  ENDDO
1294  ENDDO
1295  ENDDO
1296 
1297  ENDIF
1298  ENDIF
1299  ENDIF !Find branch nodes
1300 
1301  CASE DEFAULT
1302  localerror="The third equations set specification of "// &
1303  & trim(number_to_vstring(equationsset%specification(3),"*",err,error))// &
1304  & " is not valid for a Navier-Stokes equation type of a fluid mechanics equations set class."
1305  CALL flagerror(localerror,err,error,*999)
1306  END SELECT
1307 
1308  exits("Characteristic_NodalJacobianEvaluate")
1309  RETURN
1310 999 errorsexits("Characteristic_NodalJacobianEvaluate",err,error)
1311  RETURN 1
1312 
1313  END SUBROUTINE characteristic_nodaljacobianevaluate
1314 
1315  !
1316  !================================================================================================================================
1317  !
1318 
1320  SUBROUTINE characteristic_extrapolate(solver,currentTime,timeIncrement,ERR,ERROR,*)
1321 
1322  !Argument variables
1323  TYPE(solver_type), POINTER :: SOLVER
1324  REAL(DP), INTENT(IN) :: currentTime
1325  REAL(DP), INTENT(IN) :: timeIncrement
1326  INTEGER(INTG), INTENT(OUT) :: ERR
1327  TYPE(varying_string), INTENT(OUT) :: ERROR
1328  !Local Variables
1329  TYPE(basis_type), POINTER :: dependentBasis,materialsBasis
1330  TYPE(domain_type), POINTER :: dependentDomain,materialsDomain
1331  TYPE(equations_set_type), POINTER :: equationsSet
1332  TYPE(equations_type), POINTER :: equations
1333  TYPE(field_type), POINTER :: dependentField,materialsField,independentField,geometricField
1334  TYPE(solver_equations_type), POINTER :: solverEquations
1335  TYPE(solver_mapping_type), POINTER :: solverMapping
1336  REAL(DP) :: W(2,4),Q_EX(4),A_EX(4),XI(1),A0_PARAM(4),H0_PARAM(4),E_PARAM(4),Beta(4),normalWave(2,4),elementLengths(4)
1337  REAL(DP) :: A0_EX(4),H0_EX(4),E_EX(4),Beta_EX(4),f(4),l,friction
1338  REAL(DP) :: QPrevious,APrevious,rho,lambda(4)
1339  REAL(DP) :: elementLength,extrapolationDistance
1340  INTEGER(INTG) :: nodeIdx,versionIdx,derivativeIdx,elementIdx,elementNumber,versionElementNumber(4),lineNumber
1341  INTEGER(INTG) :: elementNodeIdx,elementNodeNumber,elementNodeVersion,numberOfVersions,componentIdx,numberOfLocalNodes
1342  LOGICAL :: overExtrapolated
1343 
1344  enters("Characteristic_Extrapolate",err,error,*999)
1345 
1346  NULLIFY(dependentbasis)
1347  NULLIFY(materialsbasis)
1348  NULLIFY(dependentdomain)
1349  NULLIFY(materialsdomain)
1350  NULLIFY(equationsset)
1351  NULLIFY(equations)
1352  NULLIFY(geometricfield)
1353  NULLIFY(dependentfield)
1354  NULLIFY(independentfield)
1355  NULLIFY(materialsfield)
1356  NULLIFY(solverequations)
1357  NULLIFY(solvermapping)
1358 
1359  IF(ASSOCIATED(solver)) THEN
1360  solverequations=>solver%SOLVER_EQUATIONS
1361  IF(ASSOCIATED(solverequations)) THEN
1362  solvermapping=>solverequations%SOLVER_MAPPING
1363  IF(ASSOCIATED(solvermapping)) THEN
1364  equationsset=>solvermapping%EQUATIONS_SETS(1)%PTR
1365  IF(ASSOCIATED(equationsset)) THEN
1366  equations=>equationsset%EQUATIONS
1367  IF(ASSOCIATED(equations)) THEN
1368  !Set General and Specific Pointer
1369  geometricfield=>equationsset%GEOMETRY%GEOMETRIC_FIELD
1370  dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
1371  independentfield=>equationsset%INDEPENDENT%INDEPENDENT_FIELD
1372  materialsfield=>equations%INTERPOLATION%MATERIALS_FIELD
1373  dependentdomain=>dependentfield%DECOMPOSITION%DOMAIN(dependentfield%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR
1374  materialsdomain=>materialsfield%DECOMPOSITION%DOMAIN(dependentfield%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR
1375 
1376  numberoflocalnodes=dependentdomain%TOPOLOGY%NODES%NUMBER_OF_NODES
1377  derivativeidx=1
1378 
1379  !!!-- L o o p O v e r L o c a l N o d e s --!!!
1380  DO nodeidx=1,numberoflocalnodes
1381  numberofversions=dependentdomain%TOPOLOGY%NODES%NODES(nodeidx)%DERIVATIVES(derivativeidx)%numberOfVersions
1382 
1383  !Get normal wave direction
1384  normalwave=0.0_dp
1385  DO componentidx=1,2
1386  DO versionidx=1,numberofversions
1387  CALL field_parametersetgetlocalnode(independentfield,field_u_variable_type,field_values_set_type,versionidx, &
1388  & derivativeidx,nodeidx,componentidx,normalwave(componentidx,versionidx),err,error,*999)
1389  ENDDO
1390  ENDDO
1391 
1392  !!!-- F i n d B r a n c h a n d B o u n d a r y N o d e s --!!!
1393  IF(abs(normalwave(1,1)) > zero_tolerance .OR. abs(normalwave(2,1))> zero_tolerance) THEN
1394  !Get constant material parameters
1395  CALL field_parameter_set_get_constant(materialsfield,field_u_variable_type, &
1396  & field_values_set_type,2,rho,err,error,*999)
1397 
1398  overextrapolated = .false.
1399  !!!-- G e t E l e m e n t L e n g t h s --!!!
1400  elementlengths = 0.0_dp
1401  DO elementidx=1,dependentdomain%TOPOLOGY%NODES%NODES(nodeidx)%NUMBER_OF_SURROUNDING_ELEMENTS
1402  elementnumber=dependentdomain%TOPOLOGY%NODES%NODES(nodeidx)%SURROUNDING_ELEMENTS(elementidx)
1403  ! Get the line lengths to extrapolate at equidistant points from the branch node
1404  linenumber = geometricfield%DECOMPOSITION%TOPOLOGY%ELEMENTS%ELEMENTS(elementnumber)% &
1405  & element_lines(1)
1406  elementlength = geometricfield%GEOMETRIC_FIELD_PARAMETERS%LENGTHS(linenumber)
1407  !Loop over the nodes on this (surrounding) element
1408  dependentbasis=>dependentdomain%TOPOLOGY%ELEMENTS%ELEMENTS(elementnumber)%BASIS
1409  materialsbasis=>materialsdomain%TOPOLOGY%ELEMENTS%ELEMENTS(elementnumber)%BASIS
1410  DO elementnodeidx=1,dependentbasis%NUMBER_OF_NODES
1411  elementnodenumber=dependentdomain%TOPOLOGY%ELEMENTS%ELEMENTS(elementnumber)% &
1412  & element_nodes(elementnodeidx)
1413  !Check that this node is the same as the current iterative node
1414  IF(elementnodenumber==nodeidx) THEN
1415  !Loop over the versions to find the element index that matches the version
1416  DO versionidx=1,numberofversions
1417  !Version number for the local element node
1418  elementnodeversion=dependentdomain%TOPOLOGY%ELEMENTS%ELEMENTS(elementnumber)%&
1419  & elementversions(1,elementnodeidx)
1420  IF(elementnodeversion==versionidx) THEN
1421  versionelementnumber(versionidx)=elementnumber
1422  elementlengths(versionidx) = elementlength
1423  ENDIF
1424  ENDDO
1425  ENDIF
1426  ENDDO
1427  ENDDO
1428 
1429  !!!-- E x t r a p o l a t e Q a n d A V a l u e s --!!!
1430  ! --------------------------------------------------------------
1431  ! Extrapolate along the characteristic curve a distance x - lambda*dt from node location (x) to get
1432  ! values for W(t) from Q,A(t-delta(t)). Note that since the characteristic solver runs before the
1433  ! Navier-Stokes solver, 'previous' values are still in the 'current' field at this time-step as the
1434  ! time integration occurs as part of the Navier-Stokes solution.
1435  DO componentidx=1,2
1436  DO versionidx=1,numberofversions
1437  IF(abs(normalwave(componentidx,versionidx))> zero_tolerance) THEN
1438 
1439  ! Get materials values at node
1440  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type, &
1441  & field_values_set_type,versionidx,derivativeidx,nodeidx,1,a0_param(versionidx),err,error,*999)
1442  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type, &
1443  & field_values_set_type,versionidx,derivativeidx,nodeidx,2,e_param(versionidx),err,error,*999)
1444  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type, &
1445  & field_values_set_type,versionidx,derivativeidx,nodeidx,3,h0_param(versionidx),err,error,*999)
1446  beta(versionidx) = (4.0_dp*sqrt(pi)*e_param(versionidx)*h0_param(versionidx))/ &
1447  & (3.0_dp*a0_param(versionidx))
1448 
1449  ! Get previous Q,A values at node
1450  CALL field_parametersetgetlocalnode(dependentfield,field_u_variable_type, &
1451  & field_values_set_type,versionidx,derivativeidx,nodeidx,1,qprevious,err,error,*999)
1452  CALL field_parametersetgetlocalnode(dependentfield,field_u_variable_type, &
1453  & field_values_set_type,versionidx,derivativeidx,nodeidx,2,aprevious,err,error,*999)
1454 
1455  ! Calculate wave speed
1456  lambda(versionidx) = qprevious/aprevious + normalwave(componentidx,versionidx)* &
1457  & (aprevious**0.25)*sqrt(beta(versionidx)/(2.0_dp*rho))
1458  ! Check that lambda(1) > 0, lambda(2) < 0
1459  IF (lambda(versionidx)*normalwave(componentidx,versionidx) < 0.0_dp) THEN
1460  CALL flagerror("Subcritical 1D system violated.",err,error,*999)
1461  ENDIF
1462 
1463  ! Calculate extrapolation distance and xi location
1464  extrapolationdistance = (timeincrement)*lambda(versionidx)
1465  ! Convert to xi-space within the element
1466  IF((normalwave(componentidx,versionidx)>zero_tolerance)) THEN
1467  ! Parent branch / outlet boundary
1468  xi(1)=1.0_dp - extrapolationdistance/(elementlengths(versionidx))
1469  ELSE
1470  ! Daughter branch / inlet boundary
1471  xi(1)=0.0_dp - extrapolationdistance/(elementlengths(versionidx))
1472  ENDIF
1473  IF (xi(1) > 1.0_dp .OR. xi(1) < 0.0_dp) THEN
1474  CALL flag_warning("1D extrapolation location outside of element xi space. Reduce time increment", &
1475  & err,error,*999)
1476  overextrapolated = .true.
1477  ENDIF
1478 
1479  ! Get Q,A values at extrapolated xi locations
1480  CALL field_interpolation_parameters_element_get(field_values_set_type, &
1481  & versionelementnumber(versionidx),equations%INTERPOLATION% &
1482  & dependent_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
1483  CALL field_interpolate_xi(no_part_deriv,xi,equations%INTERPOLATION% &
1484  & dependent_interp_point(field_u_variable_type)%PTR,err,error,*999)
1485  q_ex(versionidx)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_u_variable_type)% &
1486  & ptr%VALUES(1,no_part_deriv)
1487  a_ex(versionidx)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_u_variable_type)% &
1488  & ptr%VALUES(2,no_part_deriv)
1489  ! Get spatially varying material values at extrapolated xi locations
1490  CALL field_interpolation_parameters_element_get(field_values_set_type, &
1491  & versionelementnumber(versionidx),equations%INTERPOLATION% &
1492  & materials_interp_parameters(field_v_variable_type)%PTR,err,error,*999)
1493  CALL field_interpolate_xi(no_part_deriv,xi,equations%INTERPOLATION% &
1494  & materials_interp_point(field_v_variable_type)%PTR,err,error,*999)
1495  a0_ex(versionidx)=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)% &
1496  & ptr%VALUES(1,no_part_deriv)
1497  e_ex(versionidx)=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)% &
1498  & ptr%VALUES(2,no_part_deriv)
1499  h0_ex(versionidx)=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)% &
1500  & ptr%VALUES(3,no_part_deriv)
1501  beta_ex(versionidx) = (4.0_dp*sqrt(pi)*e_ex(versionidx)*h0_ex(versionidx))/ &
1502  & (3.0_dp*a0_ex(versionidx))
1503  ! Calculate friction term if necessary
1504  f(versionidx) = -q_ex(versionidx)/(a_ex(versionidx)**2.0_dp)
1505  ENDIF
1506  ENDDO
1507  ENDDO
1508 
1509  !Calculate W
1510  w(:,:)=0.0_dp
1511  DO componentidx=1,2
1512  DO versionidx=1,numberofversions
1513  IF(abs(normalwave(componentidx,versionidx))>zero_tolerance) THEN
1514  ! W(t+delta(t)) = W_extrap(t)
1515  w(componentidx,versionidx)= ((q_ex(versionidx)/a_ex(versionidx))+ &
1516  & normalwave(componentidx,versionidx)*4.0_dp*sqrt(beta_ex(versionidx)/(2.0_dp*rho))* &
1517  & (a_ex(versionidx)**(0.25_dp) - (a0_ex(versionidx))**(0.25_dp)))
1518 
1519  ! Add friction term if not neglected
1520  l = (1.0_dp/(q_ex(versionidx)/a_ex(versionidx) + &
1521  & normalwave(componentidx,versionidx)*a_ex(versionidx)**0.25_dp*sqrt(beta_ex(versionidx)/(2.0_dp*rho))))
1522  friction = timeincrement*l*f(versionidx)
1523 ! W(componentIdx,versionIdx)= W(componentIdx,versionIdx) + friction
1524 
1525  ! Check extrapolated wave speed is coherent
1526  lambda(versionidx) = q_ex(versionidx)/a_ex(versionidx) + normalwave(componentidx,versionidx)* &
1527  & (a_ex(versionidx)**0.25)*sqrt(beta(versionidx)/(2.0_dp*rho))
1528  IF (lambda(versionidx)*normalwave(componentidx,versionidx) < -zero_tolerance ) THEN
1529  CALL flagerror("Subcritical 1D system violated.",err,error,*999)
1530  ENDIF
1531 
1532  IF (.NOT. overextrapolated) THEN
1533  CALL field_parameter_set_update_local_node(dependentfield,field_v_variable_type, &
1534  & field_values_set_type,versionidx,derivativeidx,nodeidx,componentidx,w(componentidx,versionidx), &
1535  & err,error,*999)
1536  ENDIF
1537  ENDIF
1538  ENDDO
1539  ENDDO
1540  ENDIF ! branch or boundary node
1541  ENDDO !Loop over nodes
1542 
1543  ELSE
1544  CALL flagerror("Equations are not associated.",err,error,*999)
1545  ENDIF
1546  ELSE
1547  CALL flagerror("Solver equations are not associated.",err,error,*999)
1548  ENDIF
1549  ELSE
1550  CALL flagerror("Solver mapping is not associated.",err,error,*999)
1551  ENDIF
1552  ELSE
1553  CALL flagerror("Solvers is not associated.",err,error,*999)
1554  ENDIF
1555  ELSE
1556  CALL flagerror("Solver is not associated.",err,error,*999)
1557  ENDIF
1558 
1559  exits("Characteristic_Extrapolate")
1560  RETURN
1561 999 errorsexits("Characteristic_Extrapolate",err,error)
1562  RETURN 1
1563 
1564  END SUBROUTINE characteristic_extrapolate
1565 
1566  !
1567  !================================================================================================================================
1568  !
1569 
1571  SUBROUTINE characteristic_primitivetocharacteristic(equationsSet,ERR,ERROR,*)
1572 
1573  !Argument variables
1574  TYPE(equations_set_type), POINTER :: equationsSet
1575  INTEGER(INTG), INTENT(OUT) :: ERR
1576  TYPE(varying_string), INTENT(OUT) :: ERROR
1577  !Local Variables
1578  TYPE(field_type), POINTER :: dependentField,materialsField,independentField
1579  TYPE(field_variable_type), POINTER :: fieldVariable
1580  TYPE(domain_nodes_type), POINTER :: domainNodes
1581  TYPE(varying_string) :: localError
1582  INTEGER(INTG) :: nodeNumber,nodeIdx,derivativeIdx,versionIdx,componentIdx,numberOfVersions,dofNumber
1583  REAL(DP) :: qCurrent(4), aCurrent(4),W(2,4)
1584  REAL(DP) :: normalWave,A0_PARAM,E_PARAM,H0_PARAM,Beta
1585  LOGICAL :: boundaryNode
1586 
1587  enters("Characteristic_PrimitiveToCharacteristic",err,error,*999)
1588 
1589  NULLIFY(dependentfield)
1590  NULLIFY(independentfield)
1591  NULLIFY(materialsfield)
1592  NULLIFY(fieldvariable)
1593 
1594  IF(ASSOCIATED(equationsset)) THEN
1595  SELECT CASE(equationsset%SPECIFICATION(3))
1596  CASE(equations_set_coupled1d0d_navier_stokes_subtype, &
1597  & equations_set_transient1d_navier_stokes_subtype)
1598  dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
1599  independentfield=>equationsset%INDEPENDENT%INDEPENDENT_FIELD
1600  materialsfield=>equationsset%MATERIALS%MATERIALS_FIELD
1601  CASE DEFAULT
1602  localerror="The third equations set specification of "// &
1603  & trim(numbertovstring(equationsset%SPECIFICATION(3),"*",err,error))// &
1604  & " is not valid for a call to Characteristic_PrimitiveToCharacteristic"
1605  CALL flagerror(localerror,err,error,*999)
1606  END SELECT
1607  ELSE
1608  CALL flagerror("Equations set is not associated.",err,error,*999)
1609  END IF
1610 
1611  domainnodes=>dependentfield%DECOMPOSITION%DOMAIN(dependentfield%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR%TOPOLOGY%NODES
1612 
1613  !!!-- L o o p O v e r L o c a l N o d e s --!!!
1614  DO nodeidx=1,domainnodes%NUMBER_OF_NODES
1615  nodenumber = domainnodes%NODES(nodeidx)%local_number
1616  derivativeidx = 1
1617  numberofversions=domainnodes%NODES(nodenumber)%DERIVATIVES(derivativeidx)%numberOfVersions
1618  boundarynode=domainnodes%NODES(nodenumber)%BOUNDARY_NODE
1619  !!!-- F i n d B r a n c h N o d e s --!!!
1620  IF(numberofversions > 1 .AND. .NOT. boundarynode) THEN
1621  DO componentidx=1,2
1622  DO versionidx=1,numberofversions
1623  CALL field_parametersetgetlocalnode(independentfield,field_u_variable_type, &
1624  & field_values_set_type,versionidx,derivativeidx,nodenumber,componentidx,normalwave,err,error,*999)
1625  IF(abs(normalwave)>zero_tolerance) THEN
1626  !Get material parameters
1627  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type,field_values_set_type, &
1628  & versionidx,derivativeidx,nodenumber,1,a0_param,err,error,*999)
1629  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type,field_values_set_type, &
1630  & versionidx,derivativeidx,nodenumber,2,e_param,err,error,*999)
1631  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type,field_values_set_type, &
1632  & versionidx,derivativeidx,nodenumber,3,h0_param,err,error,*999)
1633  beta=(4.0_dp*sqrt(pi)*e_param*h0_param)/(3.0_dp*a0_param)
1634 
1635  ! Get current Q,A values
1636  CALL field_parametersetgetlocalnode(dependentfield,field_u_variable_type,field_values_set_type, &
1637  & versionidx,derivativeidx,nodenumber,1,qcurrent(versionidx),err,error,*999)
1638  CALL field_parametersetgetlocalnode(dependentfield,field_u_variable_type,field_values_set_type, &
1639  & versionidx,derivativeidx,nodenumber,2,acurrent(versionidx),err,error,*999)
1640 
1641  ! Calculate the characteristic based on current Q,A values
1642  w(componentidx,versionidx)= ((qcurrent(versionidx)/acurrent(versionidx))+ &
1643  & normalwave*4.0_dp*sqrt(((beta)))*(acurrent(versionidx)**(0.25_dp) - (a0_param)**(0.25_dp)))
1644 
1645  !Update W values
1646  fieldvariable=>dependentfield%VARIABLE_TYPE_MAP(field_v_variable_type)%PTR
1647  dofnumber=fieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
1648  & nodes(nodenumber)%DERIVATIVES(derivativeidx)%VERSIONS(versionidx)
1649  CALL field_parameter_set_update_local_dof(dependentfield,field_v_variable_type, &
1650  & field_values_set_type,dofnumber,w(componentidx,versionidx),err,error,*999)
1651  ENDIF
1652  ENDDO
1653  ENDDO
1654  ENDIF ! branch check
1655  ENDDO ! Loop over nodes
1656 
1657  exits("Characteristic_PrimitiveToCharacteristic")
1658  RETURN
1659 999 errorsexits("Characteristic_PrimitiveToCharacteristic",err,error)
1660  RETURN 1
1661 
1662  END SUBROUTINE characteristic_primitivetocharacteristic
1663 
1664  !
1665  !================================================================================================================================
1666  !
1667 
1668 END MODULE characteristic_equation_routines
equations_set_constants::equations_set_setup_dependent_type
integer(intg), parameter equations_set_setup_dependent_type
Dependent variables.
Definition: equations_set_constants.f90:324
equations_set_constants::equations_set_fem_solution_method
integer(intg), parameter equations_set_fem_solution_method
Finite Element Method solution method.
Definition: equations_set_constants.f90:348
basis_routines
This module contains all basis function routines.
Definition: basis_routines.f90:45
equations_set_constants::equations_set_setup_materials_type
integer(intg), parameter equations_set_setup_materials_type
Materials setup.
Definition: equations_set_constants.f90:326
base_routines::enters
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Definition: base_routines.f90:363
types::equations_jacobian_type
Contains information on the Jacobian matrix for nonlinear problems.
Definition: types.f90:1451
types::equations_mapping_type
Contains information on the equations mapping i.e., how field variable DOFS are mapped to the rows an...
Definition: types.f90:1681
types::equations_type
Contains information about the equations in an equations set.
Definition: types.f90:1735
equations_set_constants::equations_set_gfem_solution_method
integer(intg), parameter equations_set_gfem_solution_method
Grid-based Finite Element Method solution method.
Definition: equations_set_constants.f90:352
problem_constants
This module handles all problem wide constants.
Definition: problem_constants.f90:45
strings::number_to_vstring
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
equations_routines::equations_create_start
subroutine, public equations_create_start(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Start the creation of equations for the equation set.
Definition: equations_routines.f90:192
types::decomposition_type
Contains information on the mesh decomposition.
Definition: types.f90:1063
equations_matrices_routines::equations_matrices_create_start
subroutine, public equations_matrices_create_start(EQUATIONS, EQUATIONS_MATRICES, ERR, ERROR,)
Starts the creation of the equations matrices and rhs for the the equations.
Definition: equations_matrices_routines.f90:615
constants::pi
real(dp), parameter pi
The double precision value of pi.
Definition: constants.f90:57
equations_matrices_routines
This module handles all equations matrix and rhs routines.
Definition: equations_matrices_routines.f90:45
equations_set_constants::equations_static
integer(intg), parameter equations_static
The equations are static and have no time dependence.
Definition: equations_set_constants.f90:376
types::equations_set_type
Contains information on an equations set.
Definition: types.f90:1941
equations_routines
This module handles all equations routines.
Definition: equations_routines.f90:45
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
timer
This module contains routines for timing the program.
Definition: timer_f.f90:45
equations_routines::equations_time_dependence_type_set
subroutine, public equations_time_dependence_type_set(EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for equations.
Definition: equations_routines.f90:851
maths
This module contains all mathematics support routines.
Definition: maths.f90:45
types::field_type
Contains information for a field defined on a region.
Definition: types.f90:1346
equations_matrices_routines::equations_matrices_full_matrices
integer(intg), parameter, public equations_matrices_full_matrices
Use fully populated equation matrices.
Definition: equations_matrices_routines.f90:91
equations_set_constants::equations_set_fluid_mechanics_class
integer(intg), parameter equations_set_fluid_mechanics_class
Definition: equations_set_constants.f90:55
equations_mapping_routines::equations_mapping_rhs_variable_type_set
subroutine, public equations_mapping_rhs_variable_type_set(EQUATIONS_MAPPING, RHS_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set rhs vector.
Definition: equations_mapping_routines.f90:3170
iso_varying_string
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
Definition: iso_varying_string.f90:62
types::equations_set_equations_set_field_type
Definition: types.f90:1933
equations_set_constants::equations_set_setup_equations_type
integer(intg), parameter equations_set_setup_equations_type
Equations setup.
Definition: equations_set_constants.f90:330
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
equations_set_constants::equations_set_setup_independent_type
integer(intg), parameter equations_set_setup_independent_type
Independent variables.
Definition: equations_set_constants.f90:325
constants
This module contains all program wide constants.
Definition: constants.f90:45
equations_mapping_routines::equationsmapping_linearmatricesnumberset
subroutine, public equationsmapping_linearmatricesnumberset(EQUATIONS_MAPPING, NUMBER_OF_LINEAR_EQUATIONS_MATRICES, ERR, ERROR,)
Sets/changes the number of linear equations matrices.
Definition: equations_mapping_routines.f90:2484
equations_mapping_routines::equationsmapping_linearmatricesvariabletypesset
subroutine, public equationsmapping_linearmatricesvariabletypesset(EQUATIONS_MAPPING, LINEAR_MATRIX_VARIABLE_TYPES, ERR, ERROR,)
Sets the mapping between the dependent field variable types and the linear equations matrices...
Definition: equations_mapping_routines.f90:2716
characteristic_equation_routines::characteristic_extrapolate
subroutine, public characteristic_extrapolate(solver, currentTime, timeIncrement, ERR, ERROR,)
Extrapolate W for branch nodes and boundaries .
Definition: characteristic_equation_routines.f90:1321
equations_set_constants::equations_set_setup_start_action
integer(intg), parameter equations_set_setup_start_action
Start setup action.
Definition: equations_set_constants.f90:338
equations_matrices_routines::equationsmatrices_nonlinearstoragetypeset
Sets the storage type (sparsity) of the nonlinear (Jacobian) equations matrices.
Definition: equations_matrices_routines.f90:199
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
equations_set_constants::equations_set_characteristic_subtype
integer(intg), parameter equations_set_characteristic_subtype
Definition: equations_set_constants.f90:186
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
types::equations_mapping_nonlinear_type
Contains information on the equations mapping for nonlinear matrices i.e., how a field variable is ma...
Definition: types.f90:1623
types::equations_matrices_type
Contains information on the equations matrices and vectors.
Definition: types.f90:1520
base_routines
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
Definition: base_routines.f90:45
types::equations_matrices_linear_type
Contains information of the linear matrices for equations matrices.
Definition: types.f90:1479
iso_varying_string::trim
Definition: iso_varying_string.f90:204
equations_matrices_routines::equations_matrices_linear_storage_type_set
subroutine, public equations_matrices_linear_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the linear equations matrices.
Definition: equations_matrices_routines.f90:3898
equations_matrices_routines::equationsmatrices_linearstructuretypeset
subroutine, public equationsmatrices_linearstructuretypeset(EQUATIONS_MATRICES, STRUCTURE_TYPE, ERR, ERROR,)
Sets the structure (sparsity) of the linear equations matrices.
Definition: equations_matrices_routines.f90:4160
equations_mapping_routines::equations_mapping_create_finish
subroutine, public equations_mapping_create_finish(EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping.
Definition: equations_mapping_routines.f90:982
equations_matrices_routines::equations_jacobian_analytic_calculated
integer(intg), parameter, public equations_jacobian_analytic_calculated
Use an analytic Jacobian evaluation.
Definition: equations_matrices_routines.f90:116
equations_routines::equations_set_equations_get
subroutine, public equations_set_equations_get(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Gets the equations for an equations set.
Definition: equations_routines.f90:897
types::equations_set_materials_type
Definition: types.f90:1881
equations_matrices_routines::equationsmatrices_nonlinearstructuretypeset
Sets the structure (sparsity) of the nonlinear (Jacobian) equations matrices.
Definition: equations_matrices_routines.f90:205
equations_routines::equations_create_finish
subroutine, public equations_create_finish(EQUATIONS, ERR, ERROR,)
Finish the creation of equations.
Definition: equations_routines.f90:159
domain_mappings
This module handles all domain mappings routines.
Definition: domain_mappings.f90:45
equations_mapping_routines
This module handles all equations mapping routines.
Definition: equations_mapping_routines.f90:45
matrix_vector::matrix_compressed_row_storage_type
integer(intg), parameter, public matrix_compressed_row_storage_type
Matrix compressed row storage type.
Definition: matrix_vector.f90:167
equations_set_constants::equations_set_gfv_solution_method
integer(intg), parameter equations_set_gfv_solution_method
Grid-based Finite Volume solution method.
Definition: equations_set_constants.f90:354
equations_matrices_routines::equations_matrix_nodal_structure
integer(intg), parameter, public equations_matrix_nodal_structure
Nodal matrix structure.
Definition: equations_matrices_routines.f90:74
equations_set_constants::equations_set_setup_geometry_type
integer(intg), parameter equations_set_setup_geometry_type
Geometry setup.
Definition: equations_set_constants.f90:323
characteristic_equation_routines::characteristic_equationssetsetup
subroutine, public characteristic_equationssetsetup(equationsSet, equationsSetSetup, err, error,)
Sets up the Characteristic equations fluid setup.
Definition: characteristic_equation_routines.f90:222
types::domain_nodes_type
Contains the topology information for the nodes of a domain.
Definition: types.f90:713
equations_matrices_routines::equations_matrices_create_finish
subroutine, public equations_matrices_create_finish(EQUATIONS_MATRICES, ERR, ERROR,)
Finishes the creation of the equations matrices and RHS for the the equations.
Definition: equations_matrices_routines.f90:404
distributed_matrix_vector
This module handles all distributed matrix vector routines.
Definition: distributed_matrix_vector.f90:45
characteristic_equation_routines::characteristic_primitivetocharacteristic
subroutine, public characteristic_primitivetocharacteristic(equationsSet, ERR, ERROR,)
Calculate Characteristic (W) values based on dependent field values.
Definition: characteristic_equation_routines.f90:1572
boundary_conditions_routines
This module handles all boundary conditions routines.
Definition: boundary_condition_routines.f90:45
solver_routines
This module handles all solver routines.
Definition: solver_routines.f90:45
equations_mapping_routines::equations_mapping_create_start
subroutine, public equations_mapping_create_start(EQUATIONS, EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping for a equations set equations.
Definition: equations_mapping_routines.f90:1112
types::equations_matrix_type
Contains information about an equations matrix.
Definition: types.f90:1429
characteristic_equation_routines::characteristic_equationssetsolutionmethodset
subroutine, public characteristic_equationssetsolutionmethodset(equationsSet, solutionMethod, err, error,)
Sets/changes the solution method for a Characteristic equation type of an fluid mechanics equations s...
Definition: characteristic_equation_routines.f90:106
field_io_routines
Implements lists of Field IO operation.
Definition: field_IO_routines.f90:46
matrix_vector
This module contains all routines dealing with (non-distributed) matrix and vectors types...
Definition: matrix_vector.f90:129
equations_routines::equations_linearity_type_set
subroutine, public equations_linearity_type_set(EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for equations.
Definition: equations_routines.f90:539
types::field_variable_type
Contains information for a field variable defined on a field.
Definition: types.f90:1289
equations_set_constants::equations_set_fd_solution_method
integer(intg), parameter equations_set_fd_solution_method
Finite Difference solution method.
Definition: equations_set_constants.f90:350
equations_matrices_routines::equations_matrices_sparse_matrices
integer(intg), parameter, public equations_matrices_sparse_matrices
Use sparse equations matrices.
Definition: equations_matrices_routines.f90:90
characteristic_equation_routines
This module handles all characteristic equation routines.
Definition: characteristic_equation_routines.f90:49
types::equations_set_setup_type
Contains information on the setup information for an equations set.
Definition: types.f90:1866
types::domain_type
A pointer to the domain decomposition for this domain.
Definition: types.f90:938
types::equations_matrices_nonlinear_type
Contains information of the nolinear matrices and vectors for equations matrices. ...
Definition: types.f90:1486
control_loop_routines
This module handles all control loop routines.
Definition: control_loop_routines.f90:45
equations_set_constants::equations_set_characteristic_equation_type
integer(intg), parameter equations_set_characteristic_equation_type
Definition: equations_set_constants.f90:77
equations_matrices_routines::equationsmatrices_jacobiantypesset
subroutine, public equationsmatrices_jacobiantypesset(equationsMatrices, jacobianTypes, err, error,)
Sets the Jacobian calculation types of the residual variables.
Definition: equations_matrices_routines.f90:3283
base_routines::errors
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
Definition: base_routines.f90:481
equations_set_constants
This module defines all constants shared across equations set routines.
Definition: equations_set_constants.f90:45
equations_set_constants::equations_set_bem_solution_method
integer(intg), parameter equations_set_bem_solution_method
Boundary Element Method solution method.
Definition: equations_set_constants.f90:349
characteristic_equation_routines::characteristic_equationssetspecificationset
subroutine, public characteristic_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for a Characteristic type of a fluid mechanics equations set class...
Definition: characteristic_equation_routines.f90:170
equations_set_constants::equations_set_fv_solution_method
integer(intg), parameter equations_set_fv_solution_method
Finite Volume solution method.
Definition: equations_set_constants.f90:351
matrix_vector::matrix_block_storage_type
integer(intg), parameter, public matrix_block_storage_type
Matrix block storage type.
Definition: matrix_vector.f90:163
equations_set_constants::equations_set_setup_initial_type
integer(intg), parameter equations_set_setup_initial_type
Initial setup.
Definition: equations_set_constants.f90:322
characteristic_equation_routines::characteristic_nodaljacobianevaluate
subroutine, public characteristic_nodaljacobianevaluate(equationsSet, nodeNumber, err, error,)
Evaluates the Jacobian nodal matrix for a characteristic equation nodal equations set...
Definition: characteristic_equation_routines.f90:1076
characteristic_equation_routines::characteristic_nodalresidualevaluate
subroutine, public characteristic_nodalresidualevaluate(equationsSet, nodeNumber, err, error,)
Evaluates the residual nodal stiffness matrices and RHS for a characteristic equation nodal equations...
Definition: characteristic_equation_routines.f90:853
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
equations_set_constants::equations_set_nodal_solution_method
integer(intg), parameter equations_set_nodal_solution_method
Similar to Finite Element Method with looping over nodes instead of elements.
Definition: equations_set_constants.f90:355
equations_set_constants::equations_nonlinear
integer(intg), parameter equations_nonlinear
The equations are non-linear.
Definition: equations_set_constants.f90:366
constants::zero_tolerance
real(dp), parameter zero_tolerance
Definition: constants.f90:70
types::equations_mapping_linear_type
Contains information for mapping field variables to the linear matrices in the equations set of the m...
Definition: types.f90:1587
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
fluid_mechanics_io_routines
Temporary IO routines for fluid mechanics.
Definition: fluid_mechanics_IO_routines.f90:47
equations_set_constants::equations_set_setup_finish_action
integer(intg), parameter equations_set_setup_finish_action
Finish setup action.
Definition: equations_set_constants.f90:339
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45