OpenCMISS-Iron Internal API Documentation
characteristic_equation_routines.f90
Go to the documentation of this file.
1 
47 
50 
51  USE base_routines
52  USE basis_routines
54  USE constants
57  USE domain_mappings
62  USE field_routines
65  USE input_output
67  USE kinds
68  USE maths
69  USE matrix_vector
70  USE mesh_routines
71  USE node_routines
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 
85 
87 
89 
91 
93 
95 
97 
98 CONTAINS
99 
100 !
101 !================================================================================================================================
102 !
103 
105  SUBROUTINE characteristic_equationssetsolutionmethodset(equationsSet,solutionMethod,err,error,*)
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))
126  SELECT CASE(solutionmethod)
128  CALL flagerror("Not implemented.",err,error,*999)
130  equationsset%SOLUTION_METHOD=equations_set_nodal_solution_method
132  CALL flagerror("Not implemented.",err,error,*999)
134  CALL flagerror("Not implemented.",err,error,*999)
136  CALL flagerror("Not implemented.",err,error,*999)
138  CALL flagerror("Not implemented.",err,error,*999)
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 
163 
164 !
165 !================================================================================================================================
166 !
167 
169  SUBROUTINE characteristic_equationssetspecificationset(equationsSet,specification,err,error,*)
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)
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
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 
215 
216 !
217 !================================================================================================================================
218 !
219 
221  SUBROUTINE characteristic_equationssetsetup(equationsSet,equationsSetSetup,err,error,*)
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))
259  SELECT CASE(equationssetsetup%SETUP_TYPE)
260  !-----------------------------------------------------------------
261  ! I n i t i a l s e t u p
262  !-----------------------------------------------------------------
264  SELECT CASE(equationsset%specification(3))
266  SELECT CASE(equationssetsetup%ACTION_TYPE)
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
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  !-----------------------------------------------------------------
313  SELECT CASE(equationsset%specification(3))
315  SELECT CASE(equationssetsetup%ACTION_TYPE)
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
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  !-----------------------------------------------------------------
356  SELECT CASE(equationsset%specification(3))
358  SELECT CASE(equationssetsetup%ACTION_TYPE)
359  !Set 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
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)
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
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  !-----------------------------------------------------------------
538  SELECT CASE(equationsset%specification(3))
540  SELECT CASE(equationssetsetup%ACTION_TYPE)
541  !Set 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)
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
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  !-----------------------------------------------------------------
632  SELECT CASE(equationsset%specification(3))
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
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
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  !-----------------------------------------------------------------
743  SELECT CASE(equationsset%specification(3))
745  SELECT CASE(equationssetsetup%ACTION_TYPE)
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
760  SELECT CASE(equationsset%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
776  & err,error,*999)
777  SELECT CASE(equations%SPARSITY_TYPE)
780  & err,error,*999)
782  & err,error,*999)
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)
799  CALL flagerror("Not implemented.",err,error,*999)
801  CALL flagerror("Not implemented.",err,error,*999)
803  CALL flagerror("Not implemented.",err,error,*999)
805  CALL flagerror("Not implemented.",err,error,*999)
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,*)
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))
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 
1069 
1070  !
1071  !================================================================================================================================
1072  !
1073 
1075  SUBROUTINE characteristic_nodaljacobianevaluate(equationsSet,nodeNumber,err,error,*)
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))
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 
1314 
1315  !
1316  !================================================================================================================================
1317  !
1318 
1320  SUBROUTINE characteristic_extrapolate(solver,currentTime,timeIncrement,ERR,ERROR,*)
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,*)
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 
1663 
1664  !
1665  !================================================================================================================================
1666  !
1667 
integer(intg), parameter equations_set_setup_dependent_type
Dependent variables.
integer(intg), parameter equations_set_fem_solution_method
Finite Element Method solution method.
This module contains all basis function routines.
integer(intg), parameter equations_set_setup_materials_type
Materials setup.
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Contains information on the Jacobian matrix for nonlinear problems.
Definition: types.f90:1451
Contains information on the equations mapping i.e., how field variable DOFS are mapped to the rows an...
Definition: types.f90:1681
Contains information about the equations in an equations set.
Definition: types.f90:1735
integer(intg), parameter equations_set_gfem_solution_method
Grid-based Finite Element Method solution method.
This module handles all problem wide constants.
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
subroutine, public equations_create_start(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Start the creation of equations for the equation set.
Contains information on the mesh decomposition.
Definition: types.f90:1063
subroutine, public equations_matrices_create_start(EQUATIONS, EQUATIONS_MATRICES, ERR, ERROR,)
Starts the creation of the equations matrices and rhs for the the equations.
real(dp), parameter pi
The double precision value of pi.
Definition: constants.f90:57
This module handles all equations matrix and rhs routines.
integer(intg), parameter equations_static
The equations are static and have no time dependence.
Contains information on an equations set.
Definition: types.f90:1941
This module handles all equations routines.
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
This module contains routines for timing the program.
Definition: timer_f.f90:45
subroutine, public equations_time_dependence_type_set(EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for equations.
This module contains all mathematics support routines.
Definition: maths.f90:45
Contains information for a field defined on a region.
Definition: types.f90:1346
integer(intg), parameter, public equations_matrices_full_matrices
Use fully populated equation matrices.
integer(intg), parameter equations_set_fluid_mechanics_class
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.
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
integer(intg), parameter equations_set_setup_equations_type
Equations setup.
integer(intg), parameter equations_set_setup_independent_type
Independent variables.
This module contains all program wide constants.
Definition: constants.f90:45
subroutine, public equationsmapping_linearmatricesnumberset(EQUATIONS_MAPPING, NUMBER_OF_LINEAR_EQUATIONS_MATRICES, ERR, ERROR,)
Sets/changes the number of linear equations matrices.
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...
subroutine, public characteristic_extrapolate(solver, currentTime, timeIncrement, ERR, ERROR,)
Extrapolate W for branch nodes and boundaries .
integer(intg), parameter equations_set_setup_start_action
Start setup action.
Sets the storage type (sparsity) of the nonlinear (Jacobian) equations matrices.
subroutine, public exits(NAME)
Records the exit out of the named procedure.
integer(intg), parameter equations_set_characteristic_subtype
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
Contains information on the equations mapping for nonlinear matrices i.e., how a field variable is ma...
Definition: types.f90:1623
Contains information on the equations matrices and vectors.
Definition: types.f90:1520
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
Contains information of the linear matrices for equations matrices.
Definition: types.f90:1479
subroutine, public equations_matrices_linear_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the linear equations matrices.
subroutine, public equationsmatrices_linearstructuretypeset(EQUATIONS_MATRICES, STRUCTURE_TYPE, ERR, ERROR,)
Sets the structure (sparsity) of the linear equations matrices.
subroutine, public equations_mapping_create_finish(EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping.
integer(intg), parameter, public equations_jacobian_analytic_calculated
Use an analytic Jacobian evaluation.
subroutine, public equations_set_equations_get(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Gets the equations for an equations set.
Sets the structure (sparsity) of the nonlinear (Jacobian) equations matrices.
subroutine, public equations_create_finish(EQUATIONS, ERR, ERROR,)
Finish the creation of equations.
This module handles all domain mappings routines.
This module handles all equations mapping routines.
integer(intg), parameter, public matrix_compressed_row_storage_type
Matrix compressed row storage type.
integer(intg), parameter equations_set_gfv_solution_method
Grid-based Finite Volume solution method.
integer(intg), parameter, public equations_matrix_nodal_structure
Nodal matrix structure.
integer(intg), parameter equations_set_setup_geometry_type
Geometry setup.
subroutine, public characteristic_equationssetsetup(equationsSet, equationsSetSetup, err, error,)
Sets up the Characteristic equations fluid setup.
Contains the topology information for the nodes of a domain.
Definition: types.f90:713
subroutine, public equations_matrices_create_finish(EQUATIONS_MATRICES, ERR, ERROR,)
Finishes the creation of the equations matrices and RHS for the the equations.
This module handles all distributed matrix vector routines.
subroutine, public characteristic_primitivetocharacteristic(equationsSet, ERR, ERROR,)
Calculate Characteristic (W) values based on dependent field values.
This module handles all boundary conditions routines.
This module handles all solver routines.
subroutine, public equations_mapping_create_start(EQUATIONS, EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping for a equations set equations.
Contains information about an equations matrix.
Definition: types.f90:1429
subroutine, public characteristic_equationssetsolutionmethodset(equationsSet, solutionMethod, err, error,)
Sets/changes the solution method for a Characteristic equation type of an fluid mechanics equations s...
Implements lists of Field IO operation.
This module contains all routines dealing with (non-distributed) matrix and vectors types...
subroutine, public equations_linearity_type_set(EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for equations.
Contains information for a field variable defined on a field.
Definition: types.f90:1289
integer(intg), parameter equations_set_fd_solution_method
Finite Difference solution method.
integer(intg), parameter, public equations_matrices_sparse_matrices
Use sparse equations matrices.
This module handles all characteristic equation routines.
Contains information on the setup information for an equations set.
Definition: types.f90:1866
A pointer to the domain decomposition for this domain.
Definition: types.f90:938
Contains information of the nolinear matrices and vectors for equations matrices. ...
Definition: types.f90:1486
This module handles all control loop routines.
integer(intg), parameter equations_set_characteristic_equation_type
subroutine, public equationsmatrices_jacobiantypesset(equationsMatrices, jacobianTypes, err, error,)
Sets the Jacobian calculation types of the residual variables.
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
This module defines all constants shared across equations set routines.
integer(intg), parameter equations_set_bem_solution_method
Boundary Element Method solution method.
subroutine, public characteristic_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for a Characteristic type of a fluid mechanics equations set class...
integer(intg), parameter equations_set_fv_solution_method
Finite Volume solution method.
integer(intg), parameter, public matrix_block_storage_type
Matrix block storage type.
integer(intg), parameter equations_set_setup_initial_type
Initial setup.
subroutine, public characteristic_nodaljacobianevaluate(equationsSet, nodeNumber, err, error,)
Evaluates the Jacobian nodal matrix for a characteristic equation nodal equations set...
subroutine, public characteristic_nodalresidualevaluate(equationsSet, nodeNumber, err, error,)
Evaluates the residual nodal stiffness matrices and RHS for a characteristic equation nodal equations...
Flags an error condition.
integer(intg), parameter equations_set_nodal_solution_method
Similar to Finite Element Method with looping over nodes instead of elements.
integer(intg), parameter equations_nonlinear
The equations are non-linear.
real(dp), parameter zero_tolerance
Definition: constants.f90:70
Contains information for mapping field variables to the linear matrices in the equations set of the m...
Definition: types.f90:1587
This module contains all kind definitions.
Definition: kinds.f90:45
Temporary IO routines for fluid mechanics.
integer(intg), parameter equations_set_setup_finish_action
Finish setup action.
This module handles all formating and input and output.