OpenCMISS-Iron Internal API Documentation
Burgers_equation_routines.f90
Go to the documentation of this file.
1 
43 
45 MODULE burgers_equation_routines
46 
47  USE analytic_analysis_routines
48  USE base_routines
49  USE basis_routines
50  USE boundary_conditions_routines
51  USE constants
52  USE control_loop_routines
53  USE distributed_matrix_vector
54  USE domain_mappings
55  USE equations_routines
56  USE equations_mapping_routines
57  USE equations_matrices_routines
58  USE equations_set_constants
59  USE field_routines
60  USE input_output
61  USE iso_varying_string
62  USE kinds
63  USE matrix_vector
64  USE problem_constants
65  USE strings
66  USE solver_routines
67  USE timer
68  USE types
69 
70  USE fluid_mechanics_io_routines
71 
72 #include "macros.h"
73 
74  IMPLICIT NONE
75 
76  PRIVATE
77 
78  !Module parameters
79 
80  !Module types
81 
82  !Module variables
83 
84  !Interfaces
85 
86  PUBLIC burgers_analyticfunctionsevaluate
87 
88  PUBLIC burgers_boundaryconditionsanalyticcalculate
89 
90  PUBLIC burgers_equation_equations_set_setup
91 
92  PUBLIC burgers_equationssetsolutionmethodset
93 
94  PUBLIC burgers_equationssetspecificationset
95 
96  PUBLIC burgers_finiteelementjacobianevaluate
97 
98  PUBLIC burgers_finiteelementresidualevaluate
99 
100  PUBLIC burgers_problemspecificationset
101 
102  PUBLIC burgers_equation_problem_setup
103 
104  PUBLIC burgers_equation_pre_solve,burgers_equation_post_solve
105 
106 CONTAINS
107 
108  !
109  !================================================================================================================================
110  !
111 
112 
114  !Calculates a one-dimensional dynamic solution to the burgers equation
115  SUBROUTINE burgers_boundaryconditionsanalyticcalculate(EQUATIONS_SET,BOUNDARY_CONDITIONS,ERR,ERROR,*)
116 
117  !Argument variables
118  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
119  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
120  INTEGER(INTG), INTENT(OUT) :: ERR
121  TYPE(varying_string), INTENT(OUT) :: ERROR
122  !Local Variables
123  INTEGER(INTG) :: component_idx,deriv_idx,dim_idx,local_ny,node_idx,NUMBER_OF_DIMENSIONS,variable_idx,variable_type,version_idx
124  REAL(DP) :: VALUE,X(3),INITIAL_VALUE
125  REAL(DP), POINTER :: ANALYTIC_PARAMETERS(:),GEOMETRIC_PARAMETERS(:),MATERIALS_PARAMETERS(:)
126  TYPE(domain_type), POINTER :: DOMAIN
127  TYPE(domain_nodes_type), POINTER :: DOMAIN_NODES
128  TYPE(field_type), POINTER :: ANALYTIC_FIELD,DEPENDENT_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD
129  TYPE(field_variable_type), POINTER :: ANALYTIC_VARIABLE,FIELD_VARIABLE,GEOMETRIC_VARIABLE,MATERIALS_VARIABLE
130  INTEGER(INTG) :: GLOBAL_DERIV_INDEX,ANALYTIC_FUNCTION_TYPE
131  !THESE ARE TEMPORARY VARIABLES - they need to be replace by constant field values and the current simulation time
132  REAL(DP) :: TIME,NORMAL(3),TANGENTS(3,3)
133  !CURRENT_TIME = 1.2_DP
134 
135  enters("Burgers_BoundaryConditionsAnalyticCalculate",err,error,*999)
136 
137  IF(ASSOCIATED(equations_set)) THEN
138  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
139  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
140  IF(ASSOCIATED(dependent_field)) THEN
141  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
142  IF(ASSOCIATED(geometric_field)) THEN
143  analytic_function_type=equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE
144  analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
145  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
146  NULLIFY(geometric_variable)
147  NULLIFY(geometric_parameters)
148  CALL field_variable_get(geometric_field,field_u_variable_type,geometric_variable,err,error,*999)
149  CALL field_parameter_set_data_get(geometric_field,field_u_variable_type,field_values_set_type,geometric_parameters, &
150  & err,error,*999)
151  NULLIFY(analytic_variable)
152  NULLIFY(analytic_parameters)
153  IF(ASSOCIATED(analytic_field)) THEN
154  CALL field_variable_get(analytic_field,field_u_variable_type,analytic_variable,err,error,*999)
155  CALL field_parameter_set_data_get(analytic_field,field_u_variable_type,field_values_set_type, &
156  & analytic_parameters,err,error,*999)
157  ENDIF
158  NULLIFY(materials_field)
159  NULLIFY(materials_variable)
160  NULLIFY(materials_parameters)
161  IF(ASSOCIATED(equations_set%MATERIALS)) THEN
162  materials_field=>equations_set%MATERIALS%MATERIALS_FIELD
163  CALL field_variable_get(materials_field,field_u_variable_type,materials_variable,err,error,*999)
164  CALL field_parameter_set_data_get(materials_field,field_u_variable_type,field_values_set_type, &
165  & materials_parameters,err,error,*999)
166  ENDIF
167  analytic_function_type=equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE
168  time=equations_set%ANALYTIC%ANALYTIC_TIME
169  IF(ASSOCIATED(boundary_conditions)) THEN
170  DO variable_idx=1,dependent_field%NUMBER_OF_VARIABLES
171  variable_type=dependent_field%VARIABLES(variable_idx)%VARIABLE_TYPE
172  field_variable=>dependent_field%VARIABLE_TYPE_MAP(variable_type)%PTR
173  IF(ASSOCIATED(field_variable)) THEN
174  CALL field_parametersetensurecreated(dependent_field,variable_type,field_analytic_values_set_type,err,error,*999)
175  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
176  IF(field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE==field_node_based_interpolation) THEN
177  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
178  IF(ASSOCIATED(domain)) THEN
179  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
180  domain_nodes=>domain%TOPOLOGY%NODES
181  IF(ASSOCIATED(domain_nodes)) THEN
182  !Loop over the local nodes excluding the ghosts.
183  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
184 !!TODO \todo We should interpolate the geometric field here and the node position.
185  DO dim_idx=1,number_of_dimensions
186  !Default to version 1 of each node derivative
187  local_ny=geometric_variable%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
188  & nodes(node_idx)%DERIVATIVES(1)%VERSIONS(1)
189  x(dim_idx)=geometric_parameters(local_ny)
190  ENDDO !dim_idx
191  !Loop over the derivatives
192  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
193  global_deriv_index=domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX
194  CALL burgers_analyticfunctionsevaluate(equations_set,analytic_function_type, &
195  & x,tangents,normal,0.0_dp,variable_type,global_deriv_index,component_idx, &
196  & analytic_parameters,materials_parameters,initial_value,err,error,*999)
197  CALL burgers_analyticfunctionsevaluate(equations_set,analytic_function_type, &
198  & x,tangents,normal,time,variable_type,global_deriv_index,component_idx, &
199  & analytic_parameters,materials_parameters,VALUE,err,error,*999)
200  DO version_idx=1,domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%numberOfVersions
201  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
202  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(version_idx)
203  CALL field_parameter_set_update_local_dof(dependent_field,variable_type, &
204  & field_analytic_values_set_type,local_ny,VALUE,err,error,*999)
205  IF(variable_type==field_u_variable_type) THEN
206  IF(domain_nodes%NODES(node_idx)%BOUNDARY_NODE) THEN
207  !If we are a boundary node then set the analytic value on the boundary
208  CALL boundary_conditions_set_local_dof(boundary_conditions,dependent_field,variable_type, &
209  & local_ny,boundary_condition_fixed,VALUE,err,error,*999)
210  ELSE
211  !Set the initial condition.
212  CALL field_parameter_set_update_local_dof(dependent_field,variable_type, &
213  & field_values_set_type,local_ny,initial_value,err,error,*999)
214  ENDIF
215  ENDIF
216  ENDDO !version_idx
217  ENDDO !deriv_idx
218  ENDDO !node_idx
219  ELSE
220  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
221  ENDIF
222  ELSE
223  CALL flagerror("Domain topology is not associated.",err,error,*999)
224  ENDIF
225  ELSE
226  CALL flagerror("Domain is not associated.",err,error,*999)
227  ENDIF
228  ELSE
229  CALL flagerror("Only node based interpolation is implemented.",err,error,*999)
230  ENDIF
231  ENDDO !component_idx
232  CALL field_parameter_set_update_start(dependent_field,variable_type,field_analytic_values_set_type, &
233  & err,error,*999)
234  CALL field_parameter_set_update_start(dependent_field,variable_type,field_values_set_type, &
235  & err,error,*999)
236  CALL field_parameter_set_update_finish(dependent_field,variable_type,field_analytic_values_set_type, &
237  & err,error,*999)
238  CALL field_parameter_set_update_finish(dependent_field,variable_type,field_values_set_type, &
239  & err,error,*999)
240  ELSE
241  CALL flagerror("Field variable is not associated.",err,error,*999)
242  ENDIF
243  ENDDO !variable_idx
244  CALL field_parameter_set_data_restore(geometric_field,field_u_variable_type,field_values_set_type, &
245  & geometric_parameters,err,error,*999)
246  ELSE
247  CALL flagerror("Boundary conditions are not associated.",err,error,*999)
248  ENDIF
249  ELSE
250  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
251  ENDIF
252  ELSE
253  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
254  ENDIF
255  ELSE
256  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
257  ENDIF
258  ELSE
259  CALL flagerror("Equations set is not associated.",err,error,*999)
260  ENDIF
261 
262  exits("Burgers_BoundaryConditionsAnalyticCalculate")
263  RETURN
264 999 errorsexits("Burgers_BoundaryConditionsAnalyticCalculate",err,error)
265  RETURN 1
266 
267  END SUBROUTINE burgers_boundaryconditionsanalyticcalculate
268 
269 
270  !
271  !================================================================================================================================
272  !
274  SUBROUTINE burgers_analyticfunctionsevaluate(EQUATIONS_SET,ANALYTIC_FUNCTION_TYPE,X, &
275  & tangents,normal,time,variable_type,global_derivative,component_number,analytic_parameters,materials_parameters, &
276  & VALUE,err,error,*)
277 
278  !Argument variables
279  TYPE(equations_set_type), POINTER, INTENT(IN) :: EQUATIONS_SET
280  INTEGER(INTG), INTENT(IN) :: ANALYTIC_FUNCTION_TYPE
281  REAL(DP), INTENT(IN) :: X(:)
282  REAL(DP), INTENT(IN) :: TANGENTS(:,:)
283  REAL(DP), INTENT(IN) :: NORMAL(:)
284  REAL(DP), INTENT(IN) :: TIME
285  INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
286  INTEGER(INTG), INTENT(IN) :: GLOBAL_DERIVATIVE
287  INTEGER(INTG), INTENT(IN) :: COMPONENT_NUMBER
288  REAL(DP), INTENT(IN) :: ANALYTIC_PARAMETERS(:)
289  REAL(DP), INTENT(IN) :: MATERIALS_PARAMETERS(:)
290  REAL(DP), INTENT(OUT) :: VALUE
291  INTEGER(INTG), INTENT(OUT) :: ERR
292  TYPE(varying_string), INTENT(OUT) :: ERROR
293  !Local variables
294  REAL(DP) :: A_PARAM,B_PARAM,C_PARAM,D_PARAM,E_PARAM,X0_PARAM
295  INTEGER(INTG) :: EQUATIONS_SUBTYPE
296  TYPE(varying_string) :: LOCAL_ERROR
297 
298  enters("Burgers_AnalyticFunctionsEvaluate",err,error,*999)
299 
300  IF(.NOT.ASSOCIATED(equations_set)) THEN
301  CALL flagerror("Equations set is not associated.",err,error,*999)
302  ELSE
303  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
304  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
305  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
306  CALL flagerror("Equations set specification must have three entries for a Burgers type equations set.", &
307  & err,error,*999)
308  ELSE
309  equations_subtype=equations_set%SPECIFICATION(3)
310  END IF
311  END IF
312  SELECT CASE(equations_subtype)
313  CASE(equations_set_burgers_subtype)
314  SELECT CASE(analytic_function_type)
315  CASE(equations_set_burgers_equation_one_dim_1)
316  !For del[u]/del[t] + u.(del[u]/del[x]) = nu.(del^2[u]/del[x]^2)
317  !u(x,t)=1-tanh(x-x_0-t)/(2.nu)) with BCs,
318  !u(0,t) = 2, u_{n} = 2.u_{n-1} - u_{n-2}
319  !see http://www.cfd-online.com/Wiki/Burgers_equation
320  !OpenCMISS has del[u]/del[t] + K.(del^2[u]/del[x]^2) + u.(del[u]/del[x]) = 0,
321  !u(x,t)= 1 - tanh(x-x_0 - t)/(2.K)
322  b_param=materials_parameters(1) !nu
323  x0_param=analytic_parameters(1) !x_0
324  SELECT CASE(variable_type)
325  CASE(field_u_variable_type)
326  SELECT CASE(global_derivative)
327  CASE(no_global_deriv)
328  VALUE=1.0_dp - tanh((x(1)-x0_param-time)/(2.0_dp*b_param))
329  CASE(global_deriv_s1)
330  CALL flagerror("Not implemented.",err,error,*999)
331  CASE DEFAULT
332  local_error="The global derivative index of "//trim(number_to_vstring(global_derivative,"*",err,error))// &
333  & " is invalid."
334  CALL flagerror(local_error,err,error,*999)
335  END SELECT
336  CASE(field_deludeln_variable_type)
337  SELECT CASE(global_derivative)
338  CASE(no_global_deriv)
339  VALUE=0.0_dp
340  CASE(global_deriv_s1)
341  CALL flagerror("Not implemented.",err,error,*999)
342  CASE DEFAULT
343  local_error="The global derivative index of "//trim(number_to_vstring(global_derivative,"*",err,error))// &
344  & " is invalid."
345  CALL flagerror(local_error,err,error,*999)
346  END SELECT
347  CASE DEFAULT
348  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
349  & " is invalid."
350  CALL flagerror(local_error,err,error,*999)
351  END SELECT
352  CASE DEFAULT
353  local_error="The analytic function type of "// &
354  & trim(number_to_vstring(analytic_function_type,"*",err,error))// &
355  & " is invalid for a Burgers equation."
356  CALL flagerror(local_error,err,error,*999)
357  END SELECT
358  CASE(equations_set_generalised_burgers_subtype)
359  !a.del u/del t + b.del^2 u/del x^2 + c.u.del u/del x = 0
360  a_param=materials_parameters(1)
361  b_param=materials_parameters(2)
362  c_param=materials_parameters(3)
363  SELECT CASE(analytic_function_type)
364  CASE(equations_set_generalised_burgers_equation_one_dim_1)
365  !Analytic solution is u(x,t)=(D+a.x)/(E+c.t)
366  d_param = analytic_parameters(1)
367  e_param = analytic_parameters(2)
368  SELECT CASE(variable_type)
369  CASE(field_u_variable_type)
370  SELECT CASE(global_derivative)
371  CASE(no_global_deriv)
372  VALUE=(d_param+a_param*x(1))/(e_param+c_param*time)
373  CASE(global_deriv_s1)
374  VALUE=d_param/(e_param+c_param*time)
375  CASE DEFAULT
376  local_error="The global derivative index of "//trim(number_to_vstring(global_derivative,"*",err,error))// &
377  & " is invalid."
378  CALL flagerror(local_error,err,error,*999)
379  END SELECT
380  CASE(field_deludeln_variable_type)
381  SELECT CASE(global_derivative)
382  CASE(no_global_deriv)
383  VALUE=0.0_dp
384  CASE(global_deriv_s1)
385  VALUE=0.0_dp
386  CASE DEFAULT
387  local_error="The global derivative index of "//trim(number_to_vstring(global_derivative,"*",err,error))// &
388  & " is invalid."
389  CALL flagerror(local_error,err,error,*999)
390  END SELECT
391  CASE DEFAULT
392  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
393  & " is invalid."
394  CALL flagerror(local_error,err,error,*999)
395  END SELECT
396  CASE(equations_set_generalised_burgers_equation_one_dim_2)
397  !Analytic_solution=a.D+2.b/c(x-c.D.t+E)
398  d_param = analytic_parameters(1)
399  e_param = analytic_parameters(2)
400  SELECT CASE(variable_type)
401  CASE(field_u_variable_type)
402  SELECT CASE(global_derivative)
403  CASE(no_global_deriv)
404  VALUE=a_param*d_param+2.0_dp*b_param/(c_param*(x(1)-c_param*d_param*time+e_param))
405  CASE(global_deriv_s1)
406  VALUE=-2.0_dp*b_param/(c_param*(x(1)-c_param*d_param*time+e_param)**2)
407  CASE DEFAULT
408  local_error="The global derivative index of "//trim(number_to_vstring(global_derivative,"*",err,error))// &
409  & " is invalid."
410  CALL flagerror(local_error,err,error,*999)
411  END SELECT
412  CASE(field_deludeln_variable_type)
413  SELECT CASE(global_derivative)
414  CASE(no_global_deriv)
415  VALUE=0.0_dp
416  CASE(global_deriv_s1)
417  VALUE=0.0_dp
418  CASE DEFAULT
419  local_error="The global derivative index of "//trim(number_to_vstring(global_derivative,"*",err,error))// &
420  & " is invalid."
421  CALL flagerror(local_error,err,error,*999)
422  END SELECT
423  CASE DEFAULT
424  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
425  & " is invalid."
426  CALL flagerror(local_error,err,error,*999)
427  END SELECT
428  CASE DEFAULT
429  local_error="The analytic function type of "// &
430  & trim(number_to_vstring(analytic_function_type,"*",err,error))// &
431  & " is invalid for a generalised Burgers equation."
432  CALL flagerror(local_error,err,error,*999)
433  END SELECT
434  CASE(equations_set_static_burgers_subtype)
435  CALL flagerror("Not implemented.",err,error,*999)
436  CASE(equations_set_inviscid_burgers_subtype)
437  CALL flagerror("Not implemented.",err,error,*999)
438  CASE DEFAULT
439  local_error="The equations set subtype of "//trim(number_to_vstring(equations_subtype,"*",err,error))// &
440  & " is invalid."
441  CALL flagerror(local_error,err,error,*999)
442  END SELECT
443 
444  exits("Burgers_AnalyticFunctionsEvaluate")
445  RETURN
446 999 errorsexits("Burgers_AnalyticFunctionsEvaluate",err,error)
447  RETURN 1
448  END SUBROUTINE burgers_analyticfunctionsevaluate
449 
450  !
451  !================================================================================================================================
452  !
453 
455  SUBROUTINE burgers_equationssetsolutionmethodset(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)
456 
457  !Argument variables
458  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
459  INTEGER(INTG), INTENT(IN) :: SOLUTION_METHOD
460  INTEGER(INTG), INTENT(OUT) :: ERR
461  TYPE(varying_string), INTENT(OUT) :: ERROR
462  !Local Variables
463  TYPE(varying_string) :: LOCAL_ERROR
464 
465  enters("Burgers_EquationsSetSolutionMethodSet",err,error,*999)
466 
467  IF(ASSOCIATED(equations_set)) THEN
468  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
469  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
470  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
471  CALL flagerror("Equations set specification must have three entries for a Burgers type equations set.", &
472  & err,error,*999)
473  END IF
474  SELECT CASE(equations_set%SPECIFICATION(3))
475  CASE(equations_set_burgers_subtype,equations_set_generalised_burgers_subtype,equations_set_static_burgers_subtype, &
476  & equations_set_inviscid_burgers_subtype)
477  SELECT CASE(solution_method)
478  CASE(equations_set_fem_solution_method)
479  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
480  CASE(equations_set_bem_solution_method)
481  CALL flagerror("Not implemented.",err,error,*999)
482  CASE(equations_set_fd_solution_method)
483  CALL flagerror("Not implemented.",err,error,*999)
484  CASE(equations_set_fv_solution_method)
485  CALL flagerror("Not implemented.",err,error,*999)
486  CASE(equations_set_gfem_solution_method)
487  CALL flagerror("Not implemented.",err,error,*999)
488  CASE(equations_set_gfv_solution_method)
489  CALL flagerror("Not implemented.",err,error,*999)
490  CASE DEFAULT
491  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
492  CALL flagerror(local_error,err,error,*999)
493  END SELECT
494  CASE DEFAULT
495  local_error="Equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
496  & " is not valid for a Burgers equation type of an classical field equations set class."
497  CALL flagerror(local_error,err,error,*999)
498  END SELECT
499  ELSE
500  CALL flagerror("Equations set is not associated.",err,error,*999)
501  ENDIF
502 
503  exits("Burgers_EquationsSetSolutionMethodSet")
504  RETURN
505 999 errors("Burgers_EquationsSetSolutionMethodSet",err,error)
506  exits("Burgers_EquationsSetSolutionMethodSet")
507  RETURN 1
508 
509  END SUBROUTINE burgers_equationssetsolutionmethodset
510 
511  !
512  !================================================================================================================================
513  !
514 
516  SUBROUTINE burgers_equationssetspecificationset(equationsSet,specification,err,error,*)
517 
518  !Argument variables
519  TYPE(equations_set_type), POINTER :: equationsSet
520  INTEGER(INTG), INTENT(IN) :: specification(:)
521  INTEGER(INTG), INTENT(OUT) :: err
522  TYPE(varying_string), INTENT(OUT) :: error
523  !Local Variables
524  TYPE(varying_string) :: localError
525  INTEGER(INTG) :: subtype
526 
527  enters("Burgers_EquationsSetSpecificationSet",err,error,*999)
528 
529  IF(ASSOCIATED(equationsset)) THEN
530  IF(SIZE(specification,1)/=3) THEN
531  CALL flagerror("Equations set specification must have three entries for a Burgers equation set.", &
532  & err,error,*999)
533  END IF
534  subtype=specification(3)
535  SELECT CASE(subtype)
536  CASE(equations_set_burgers_subtype, &
537  & equations_set_generalised_burgers_subtype, &
538  & equations_set_static_burgers_subtype, &
539  & equations_set_inviscid_burgers_subtype)
540  !ok
541  CASE DEFAULT
542  localerror="The third equations set specification of "//trim(numbertovstring(specification(3),"*",err,error))// &
543  & " is not valid for a Burgers type of fluid mechanics equations set."
544  CALL flagerror(localerror,err,error,*999)
545  END SELECT
546  !Set full specification
547  IF(ALLOCATED(equationsset%specification)) THEN
548  CALL flagerror("Equations set specification is already allocated.",err,error,*999)
549  ELSE
550  ALLOCATE(equationsset%specification(3),stat=err)
551  IF(err/=0) CALL flagerror("Could not allocate equations set specification.",err,error,*999)
552  END IF
553  equationsset%specification(1:3)=[equations_set_fluid_mechanics_class,equations_set_burgers_equation_type,subtype]
554  ELSE
555  CALL flagerror("Equations set is not associated.",err,error,*999)
556  END IF
557 
558  exits("Burgers_EquationsSetSpecificationSet")
559  RETURN
560 999 errors("Burgers_EquationsSetSpecificationSet",err,error)
561  exits("Burgers_EquationsSetSpecificationSet")
562  RETURN 1
563 
564  END SUBROUTINE burgers_equationssetspecificationset
565 
566  !
567  !================================================================================================================================
568  !
569 
571  SUBROUTINE burgers_equation_equations_set_setup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
572 
573  !Argument variables
574  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
575  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
576  INTEGER(INTG), INTENT(OUT) :: ERR
577  TYPE(varying_string), INTENT(OUT) :: ERROR
578  !Local Variables
579  INTEGER(INTG) :: component_idx,GEOMETRIC_MESH_COMPONENT,GEOMETRIC_SCALING_TYPE,NUMBER_OF_ANALYTIC_COMPONENTS, &
580  & NUMBER_OF_DEPENDENT_COMPONENTS,NUMBER_OF_GEOMETRIC_COMPONENTS,NUMBER_OF_MATERIALS_COMPONENTS
581  TYPE(decomposition_type), POINTER :: GEOMETRIC_DECOMPOSITION
582  TYPE(equations_type), POINTER :: EQUATIONS
583  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
584  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
585  TYPE(equations_set_analytic_type), POINTER :: EQUATIONS_ANALYTIC
586  TYPE(equations_set_materials_type), POINTER :: EQUATIONS_MATERIALS
587  TYPE(field_type), POINTER :: ANALYTIC_FIELD,DEPENDENT_FIELD,GEOMETRIC_FIELD
588  TYPE(varying_string) :: LOCAL_ERROR
589 
590  enters("BURGERS_EQUATION_EQUATIONS_SET_SETUP",err,error,*999)
591 
592  NULLIFY(equations)
593  NULLIFY(equations_mapping)
594  NULLIFY(equations_matrices)
595  NULLIFY(geometric_decomposition)
596 
597  IF(ASSOCIATED(equations_set)) THEN
598  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
599  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
600  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
601  CALL flagerror("Equations set specification must have three entries for a Burgers type equations set.", &
602  & err,error,*999)
603  END IF
604  SELECT CASE(equations_set%SPECIFICATION(3))
605  CASE(equations_set_burgers_subtype,equations_set_generalised_burgers_subtype,equations_set_static_burgers_subtype, &
606  equations_set_inviscid_burgers_subtype)
607  SELECT CASE(equations_set_setup%SETUP_TYPE)
608  CASE(equations_set_setup_initial_type)
609  SELECT CASE(equations_set_setup%ACTION_TYPE)
610  CASE(equations_set_setup_start_action)
611  CALL burgers_equationssetsolutionmethodset(equations_set,equations_set_fem_solution_method, &
612  & err,error,*999)
613  CASE(equations_set_setup_finish_action)
614  !Do nothing
615  CASE DEFAULT
616  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
617  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
618  & " is invalid for a nonlinear burgers equation."
619  CALL flagerror(local_error,err,error,*999)
620  END SELECT
621  CASE(equations_set_setup_geometry_type)
622  !Do nothing
623  !-----------------------------------------------------------------
624  ! D e p e n d e n t f i e l d
625  !-----------------------------------------------------------------
626  CASE(equations_set_setup_dependent_type)
627  SELECT CASE(equations_set_setup%ACTION_TYPE)
628  CASE(equations_set_setup_start_action)
629  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
630  !Create the auto created dependent field
631  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
632  & dependent_field,err,error,*999)
633  CALL field_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
634  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
635  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
636  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
637  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
638  & err,error,*999)
639  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
640  & geometric_field,err,error,*999)
641  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,2,err,error,*999)
642  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,[field_u_variable_type, &
643  & field_deludeln_variable_type],err,error,*999)
644  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
645  & "U",err,error,*999)
646  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
647  & "del U/del n",err,error,*999)
648  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
649  & field_scalar_dimension_type,err,error,*999)
650  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
651  & field_scalar_dimension_type,err,error,*999)
652  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
653  & field_dp_type,err,error,*999)
654  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
655  & field_dp_type,err,error,*999)
656  IF(equations_set%SPECIFICATION(3)==equations_set_generalised_burgers_subtype) THEN
657  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
658  & number_of_geometric_components,err,error,*999)
659  number_of_dependent_components=number_of_geometric_components
660  ELSE
661  number_of_dependent_components=1
662  ENDIF
663  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
664  & field_u_variable_type,number_of_dependent_components,err,error,*999)
665  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
666  & field_deludeln_variable_type,number_of_dependent_components,err,error,*999)
667  !Default to the geometric interpolation setup
668  DO component_idx=1,number_of_dependent_components
669  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
670  & component_idx,geometric_mesh_component,err,error,*999)
671  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
672  & component_idx,geometric_mesh_component,err,error,*999)
673  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
674  & component_idx,geometric_mesh_component,err,error,*999)
675  ENDDO !component_idx
676  SELECT CASE(equations_set%SOLUTION_METHOD)
677  CASE(equations_set_fem_solution_method)
678  DO component_idx=1,number_of_dependent_components
679  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
680  & field_u_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
681  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
682  & field_deludeln_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
683  ENDDO !component_idx
684  !Default the scaling to the geometric field scaling
685  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
686  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
687  CASE(equations_set_bem_solution_method)
688  CALL flagerror("Not implemented.",err,error,*999)
689  CASE(equations_set_fd_solution_method)
690  CALL flagerror("Not implemented.",err,error,*999)
691  CASE(equations_set_fv_solution_method)
692  CALL flagerror("Not implemented.",err,error,*999)
693  CASE(equations_set_gfem_solution_method)
694  CALL flagerror("Not implemented.",err,error,*999)
695  CASE(equations_set_gfv_solution_method)
696  CALL flagerror("Not implemented.",err,error,*999)
697  CASE DEFAULT
698  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
699  & " is invalid."
700  CALL flagerror(local_error,err,error,*999)
701  END SELECT
702  ELSE
703  !Check the user specified field
704  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
705  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
706  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
707  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type, &
708  & field_deludeln_variable_type],err,error,*999)
709  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
710  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
711  IF(equations_set%SPECIFICATION(3)==equations_set_generalised_burgers_subtype) THEN
712  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
713  & number_of_geometric_components,err,error,*999)
714  number_of_dependent_components=number_of_geometric_components
715  ELSE
716  number_of_dependent_components=1
717  ENDIF
718  IF(number_of_dependent_components==1) THEN
719  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_scalar_dimension_type, &
720  & err,error,*999)
721  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_scalar_dimension_type, &
722  & err,error,*999)
723  ELSE
724  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
725  & err,error,*999)
726  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_vector_dimension_type, &
727  & err,error,*999)
728  ENDIF
729  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
730  & number_of_dependent_components,err,error,*999)
731  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
732  & number_of_dependent_components,err,error,*999)
733  SELECT CASE(equations_set%SOLUTION_METHOD)
734  CASE(equations_set_fem_solution_method)
735  DO component_idx=1,number_of_dependent_components
736  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type, &
737  & component_idx,field_node_based_interpolation,err,error,*999)
738  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
739  & component_idx,field_node_based_interpolation,err,error,*999)
740  ENDDO !component_idx
741  CASE(equations_set_bem_solution_method)
742  CALL flagerror("Not implemented.",err,error,*999)
743  CASE(equations_set_fd_solution_method)
744  CALL flagerror("Not implemented.",err,error,*999)
745  CASE(equations_set_fv_solution_method)
746  CALL flagerror("Not implemented.",err,error,*999)
747  CASE(equations_set_gfem_solution_method)
748  CALL flagerror("Not implemented.",err,error,*999)
749  CASE(equations_set_gfv_solution_method)
750  CALL flagerror("Not implemented.",err,error,*999)
751  CASE DEFAULT
752  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
753  & " is invalid."
754  CALL flagerror(local_error,err,error,*999)
755  END SELECT
756  ENDIF
757  CASE(equations_set_setup_finish_action)
758  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
759  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
760  ENDIF
761  CASE DEFAULT
762  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
763  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
764  & " is invalid for a nonlinear Burgers equation."
765  CALL flagerror(local_error,err,error,*999)
766  END SELECT
767  !-----------------------------------------------------------------
768  ! M a t e r i a l s f i e l d
769  !-----------------------------------------------------------------
770  CASE(equations_set_setup_materials_type)
771  SELECT CASE(equations_set_setup%ACTION_TYPE)
772  CASE(equations_set_setup_start_action)
773  equations_materials=>equations_set%MATERIALS
774  IF(ASSOCIATED(equations_materials)) THEN
775  IF(equations_set%SPECIFICATION(3)/=equations_set_inviscid_burgers_subtype) THEN
776  !Not an inviscid Burgers equation
777  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
778  !Create the auto created materials field
779  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_materials% &
780  & materials_field,err,error,*999)
781  CALL field_label_set(equations_materials%MATERIALS_FIELD,"Materials Field",err,error,*999)
782  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
783  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type,err,error,*999)
784  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
785  CALL field_mesh_decomposition_set_and_lock(equations_materials%MATERIALS_FIELD,geometric_decomposition, &
786  & err,error,*999)
787  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
788  & geometric_field,err,error,*999)
789  CALL field_number_of_variables_set_and_lock(equations_materials%MATERIALS_FIELD,1,err,error,*999)
790  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,[field_u_variable_type], &
791  & err,error,*999)
792  CALL field_variable_label_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
793  & "Materials",err,error,*999)
794  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
795  & field_vector_dimension_type,err,error,*999)
796  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
797  & field_dp_type,err,error,*999)
798  SELECT CASE(equations_set%SPECIFICATION(3))
799  CASE(equations_set_burgers_subtype,equations_set_static_burgers_subtype)
800  !1 materials field component
801  !i.e., k = viscosity*(-1) in du/dt + k*(d^2u/dx^2)+ u*(du/dx) = 0
802  number_of_materials_components=1
803  CASE(equations_set_generalised_burgers_subtype)
804  !3 materials field components
805  !i.e., a.du/dt + b.(d^2u/dx^2) + c.u*(du/dx) = 0
806  number_of_materials_components=3
807  CASE DEFAULT
808  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
809  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
810  & " is invalid for a nonlinear Burgers equation."
811  CALL flagerror(local_error,err,error,*999)
812  END SELECT
813  !Set the number of materials components
814  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
815  & number_of_materials_components,err,error,*999)
816  !Default the materials components to the 1st geometric component interpolation setup with constant interpolation
817  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
818  & 1,geometric_mesh_component,err,error,*999)
819  DO component_idx=1,number_of_materials_components
820  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
821  & component_idx,geometric_mesh_component,err,error,*999)
822  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
823  & component_idx,field_constant_interpolation,err,error,*999)
824  ENDDO !component_idx
825  !Default the field scaling to that of the geometric field
826  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
827  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
828  ELSE
829  !Check the user specified field
830  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
831  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
832  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
833  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
834  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
835  SELECT CASE(equations_set%SPECIFICATION(3))
836  CASE(equations_set_burgers_subtype,equations_set_static_burgers_subtype)
837  !1 materials field component
838  !i.e., k = viscosity*(-1) in du/dt + k*(d^2u/dx^2)+ u*(du/dx) = 0
839  number_of_materials_components=1
840  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_scalar_dimension_type, &
841  & err,error,*999)
842  CASE(equations_set_generalised_burgers_subtype)
843  !3 materials field components
844  !i.e., a.du/dt + b.(d^2u/dx^2) + c.u*(du/dx) = 0
845  number_of_materials_components=3
846  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
847  & err,error,*999)
848  CASE DEFAULT
849  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
850  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
851  & " is invalid for a nonlinear Burgers equation."
852  CALL flagerror(local_error,err,error,*999)
853  END SELECT
854  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
855  & number_of_materials_components,err,error,*999)
856  ENDIF
857  ENDIF
858  ELSE
859  CALL flagerror("Equations set materials is not associated.",err,error,*999)
860  ENDIF
861  CASE(equations_set_setup_finish_action)
862  equations_materials=>equations_set%MATERIALS
863  IF(ASSOCIATED(equations_materials)) THEN
864  IF(equations_set%SPECIFICATION(3)/=equations_set_inviscid_burgers_subtype) THEN
865  !Not an inviscid Burgers equation
866  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
867  !Finish creating the materials field
868  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
869  !Set the default values for the materials field
870  SELECT CASE(equations_set%SPECIFICATION(3))
871  CASE(equations_set_burgers_subtype,equations_set_static_burgers_subtype)
872  !1 materials field component. Default to
873  !du/dt - d^2u/dx^2 + u*(du/dx) = 0
874  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
875  & field_values_set_type,1,-1.0_dp,err,error,*999)
876  CASE(equations_set_generalised_burgers_subtype)
877  !3 materials field components. Default to
878  !du/dt - d^2u/dx^2 + u*(du/dx) = 0
879  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
880  & field_values_set_type,1,1.0_dp,err,error,*999)
881  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
882  & field_values_set_type,2,-1.0_dp,err,error,*999)
883  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
884  & field_values_set_type,3,1.0_dp,err,error,*999)
885  CASE DEFAULT
886  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
887  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
888  & " is invalid for a nonlinear Burgers equation."
889  CALL flagerror(local_error,err,error,*999)
890  END SELECT
891  ENDIF
892  ENDIF
893  ELSE
894  CALL flagerror("Equations set materials is not associated.",err,error,*999)
895  ENDIF
896  CASE DEFAULT
897  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
898  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
899  & " is invalid for a nonlinear Burgers equation."
900  CALL flagerror(local_error,err,error,*999)
901  END SELECT
902  !-----------------------------------------------------------------
903  ! S o u r c e f i e l d
904  !-----------------------------------------------------------------
905  CASE(equations_set_setup_source_type)
906  SELECT CASE(equations_set_setup%ACTION_TYPE)
907  CASE(equations_set_setup_start_action)
908  !Do nothing
909  CASE(equations_set_setup_finish_action)
910  !Do nothing
911  CASE DEFAULT
912  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
913  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
914  & " is invalid for a nonlinear Burgers equation."
915  CALL flagerror(local_error,err,error,*999)
916  END SELECT
917  !-----------------------------------------------------------------
918  ! A n a l y t i c t y p e
919  !-----------------------------------------------------------------
920  CASE(equations_set_setup_analytic_type)
921  SELECT CASE(equations_set_setup%ACTION_TYPE)
922  CASE(equations_set_setup_start_action)
923  equations_analytic=>equations_set%ANALYTIC
924  IF(ASSOCIATED(equations_analytic)) THEN
925  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
926  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
927  IF(ASSOCIATED(dependent_field)) THEN
928  equations_materials=>equations_set%MATERIALS
929  IF(ASSOCIATED(equations_materials)) THEN
930  IF(equations_materials%MATERIALS_FINISHED) THEN
931  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
932  IF(ASSOCIATED(geometric_field)) THEN
933  CALL field_number_of_components_get(geometric_field,field_u_variable_type, &
934  & number_of_geometric_components,err,error,*999)
935  SELECT CASE(equations_set%SPECIFICATION(3))
936  CASE(equations_set_burgers_subtype)
937  SELECT CASE(equations_set_setup%ANALYTIC_FUNCTION_TYPE)
938  CASE(equations_set_burgers_equation_one_dim_1)
939  !Check that domain is 1D
940  IF(number_of_geometric_components/=1) THEN
941  local_error="The number of geometric dimensions of "// &
942  & trim(number_to_vstring(number_of_geometric_components,"*",err,error))// &
943  & " is invalid. The analytic function type of "// &
944  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
945  & " requires that there be 1 geometric dimension."
946  CALL flagerror(local_error,err,error,*999)
947  ENDIF
948  !Check the materials values are constant
949  CALL field_component_interpolation_check(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
950  & 1,field_constant_interpolation,err,error,*999)
951  !Set analytic function type
952  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_burgers_equation_one_dim_1
953  number_of_analytic_components=1
954  CASE DEFAULT
955  local_error="The specified analytic function type of "// &
956  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
957  & " is invalid for a Burgers equation."
958  CALL flagerror(local_error,err,error,*999)
959  END SELECT
960  CASE(equations_set_generalised_burgers_subtype)
961  SELECT CASE(equations_set_setup%ANALYTIC_FUNCTION_TYPE)
962  CASE(equations_set_generalised_burgers_equation_one_dim_1, &
963  & equations_set_generalised_burgers_equation_one_dim_2)
964  !Check that domain is 1D
965  IF(number_of_geometric_components/=1) THEN
966  local_error="The number of geometric dimensions of "// &
967  & trim(number_to_vstring(number_of_geometric_components,"*",err,error))// &
968  & " is invalid. The analytic function type of "// &
969  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
970  & " requires that there be 1 geometric dimension."
971  CALL flagerror(local_error,err,error,*999)
972  ENDIF
973  !Check the materials values are constant
974  CALL field_component_interpolation_check(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
975  & 1,field_constant_interpolation,err,error,*999)
976  CALL field_component_interpolation_check(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
977  & 2,field_constant_interpolation,err,error,*999)
978  CALL field_component_interpolation_check(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
979  & 3,field_constant_interpolation,err,error,*999)
980  !Set analytic function type
981  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_setup%ANALYTIC_FUNCTION_TYPE
982  number_of_analytic_components=2
983  CASE DEFAULT
984  local_error="The specified analytic function type of "// &
985  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
986  & " is invalid for a generalised Burgers equation."
987  CALL flagerror(local_error,err,error,*999)
988  END SELECT
989  CASE(equations_set_static_burgers_subtype)
990  CALL flagerror("Not implemented.",err,error,*999)
991  CASE(equations_set_inviscid_burgers_subtype)
992  CALL flagerror("Not implemented.",err,error,*999)
993  CASE DEFAULT
994  local_error="The equation set subtype of "// &
995  & trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
996  & " is invalid for an analytical nonlinear Burgers equation."
997  CALL flagerror(local_error,err,error,*999)
998  END SELECT
999  !Create analytic field if required
1000  IF(number_of_analytic_components>=1) THEN
1001  IF(equations_analytic%ANALYTIC_FIELD_AUTO_CREATED) THEN
1002  !Create the auto created source field
1003  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
1004  & equations_analytic%ANALYTIC_FIELD,err,error,*999)
1005  CALL field_label_set(equations_analytic%ANALYTIC_FIELD,"Analytic Field",err,error,*999)
1006  CALL field_type_set_and_lock(equations_analytic%ANALYTIC_FIELD,field_general_type,err,error,*999)
1007  CALL field_dependent_type_set_and_lock(equations_analytic%ANALYTIC_FIELD,field_independent_type, &
1008  & err,error,*999)
1009  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
1010  & err,error,*999)
1011  CALL field_mesh_decomposition_set_and_lock(equations_analytic%ANALYTIC_FIELD, &
1012  & geometric_decomposition,err,error,*999)
1013  CALL field_geometric_field_set_and_lock(equations_analytic%ANALYTIC_FIELD,equations_set%GEOMETRY% &
1014  & geometric_field,err,error,*999)
1015  CALL field_number_of_variables_set_and_lock(equations_analytic%ANALYTIC_FIELD,1,err,error,*999)
1016  CALL field_variable_types_set_and_lock(equations_analytic%ANALYTIC_FIELD,[field_u_variable_type], &
1017  & err,error,*999)
1018  CALL field_variable_label_set(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1019  & "Analytic",err,error,*999)
1020  CALL field_dimension_set_and_lock(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1021  & field_vector_dimension_type,err,error,*999)
1022  CALL field_data_type_set_and_lock(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1023  & field_dp_type,err,error,*999)
1024  !Set the number of analytic components
1025  CALL field_number_of_components_set_and_lock(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1026  & number_of_analytic_components,err,error,*999)
1027  !Default the analytic components to the 1st geometric interpolation setup with constant interpolation
1028  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD, &
1029  & field_u_variable_type,1,geometric_mesh_component,err,error,*999)
1030  DO component_idx=1,number_of_analytic_components
1031  CALL field_component_mesh_component_set(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1032  & component_idx,geometric_mesh_component,err,error,*999)
1033  CALL field_component_interpolation_set(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1034  & component_idx,field_constant_interpolation,err,error,*999)
1035  ENDDO !component_idx
1036  !Default the field scaling to that of the geometric field
1037  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
1038  & err,error,*999)
1039  CALL field_scaling_type_set(equations_analytic%ANALYTIC_FIELD,geometric_scaling_type,err,error,*999)
1040  ELSE
1041  !Check the user specified field
1042  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1043  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1044  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
1045  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
1046  IF(number_of_analytic_components==1) THEN
1047  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type, &
1048  & field_scalar_dimension_type,err,error,*999)
1049  ELSE
1050  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type, &
1051  & field_vector_dimension_type,err,error,*999)
1052  ENDIF
1053  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type, &
1054  & err,error,*999)
1055  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
1056  & number_of_analytic_components,err,error,*999)
1057  ENDIF
1058  ENDIF
1059  ELSE
1060  CALL flagerror("Equations set materials is not finished.",err,error,*999)
1061  ENDIF
1062  ELSE
1063  CALL flagerror("Equations set materials is not associated.",err,error,*999)
1064  ENDIF
1065  ELSE
1066  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
1067  ENDIF
1068  ELSE
1069  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
1070  ENDIF
1071  ELSE
1072  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
1073  ENDIF
1074  ELSE
1075  CALL flagerror("Equations analytic is not associated.",err,error,*999)
1076  ENDIF
1077  CASE(equations_set_setup_finish_action)
1078  equations_analytic=>equations_set%ANALYTIC
1079  IF(ASSOCIATED(equations_analytic)) THEN
1080  analytic_field=>equations_analytic%ANALYTIC_FIELD
1081  IF(ASSOCIATED(analytic_field)) THEN
1082  IF(equations_analytic%ANALYTIC_FIELD_AUTO_CREATED) THEN
1083  !Finish creating the analytic field
1084  CALL field_create_finish(equations_analytic%ANALYTIC_FIELD,err,error,*999)
1085  !Set the default values for the analytic field
1086  SELECT CASE(equations_set%SPECIFICATION(3))
1087  CASE(equations_set_burgers_subtype)
1088  !Default the analytic parameter value to 0.0
1089  CALL field_component_values_initialise(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1090  & field_values_set_type,1,0.0_dp,err,error,*999)
1091  CASE(equations_set_generalised_burgers_subtype)
1092  !Default the analytic parameter values to 1.0
1093  CALL field_component_values_initialise(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1094  & field_values_set_type,1,1.0_dp,err,error,*999)
1095  CALL field_component_values_initialise(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1096  & field_values_set_type,2,1.0_dp,err,error,*999)
1097  CASE(equations_set_static_burgers_subtype)
1098  CALL flagerror("Not implemented.",err,error,*999)
1099  CASE(equations_set_inviscid_burgers_subtype)
1100  CALL flagerror("Not implemented.",err,error,*999)
1101  CASE DEFAULT
1102  local_error="The equation set subtype of "// &
1103  & trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
1104  & " is invalid for an analytical nonlinear Burgers equation."
1105  CALL flagerror(local_error,err,error,*999)
1106  END SELECT
1107  ENDIF
1108  ENDIF
1109  ELSE
1110  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
1111  ENDIF
1112  CASE DEFAULT
1113  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1114  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1115  & " is invalid for a nonlinear Burgers equation."
1116  CALL flagerror(local_error,err,error,*999)
1117  END SELECT
1118  !-----------------------------------------------------------------
1119  ! E q u a t i o n s t y p e
1120  !-----------------------------------------------------------------
1121  CASE(equations_set_setup_equations_type)
1122  SELECT CASE (equations_set%SPECIFICATION(3))
1123  CASE(equations_set_burgers_subtype,equations_set_generalised_burgers_subtype,equations_set_inviscid_burgers_subtype)
1124  SELECT CASE(equations_set_setup%ACTION_TYPE)
1125  CASE(equations_set_setup_start_action)
1126  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
1127  CALL equations_create_start(equations_set,equations,err,error,*999)
1128  CALL equations_linearity_type_set(equations,equations_nonlinear,err,error,*999)
1129  CALL equations_time_dependence_type_set(equations,equations_first_order_dynamic,err,error,*999)
1130  ELSE
1131  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
1132  ENDIF
1133  CASE(equations_set_setup_finish_action)
1134  SELECT CASE(equations_set%SOLUTION_METHOD)
1135  CASE(equations_set_fem_solution_method)
1136  !Finish the equations
1137  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
1138  CALL equations_create_finish(equations,err,error,*999)
1139  !Create the equations mapping.
1140  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
1141  IF(equations_set%SPECIFICATION(3)==equations_set_inviscid_burgers_subtype) THEN
1142  CALL equations_mapping_dynamic_matrices_set(equations_mapping,.true.,.false.,err,error,*999)
1143  ELSE
1144  CALL equations_mapping_dynamic_matrices_set(equations_mapping,.true.,.true.,err,error,*999)
1145  ENDIF
1146  CALL equationsmapping_residualvariabletypesset(equations_mapping,[field_u_variable_type],err,error,*999)
1147  CALL equations_mapping_dynamic_variable_type_set(equations_mapping,field_u_variable_type,err,error,*999)
1148  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
1149  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
1150  !Create the equations matrices
1151  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
1152  !Set up matrix storage and structure
1153  IF(equations%LUMPING_TYPE==equations_lumped_matrices) THEN
1154  !Set up lumping
1155  IF(equations_set%SPECIFICATION(3)==equations_set_inviscid_burgers_subtype) THEN
1156  CALL equations_matrices_dynamic_lumping_type_set(equations_matrices, &
1157  & [equations_matrix_lumped],err,error,*999)
1158  ELSE
1159  CALL equations_matrices_dynamic_lumping_type_set(equations_matrices, &
1160  & [equations_matrix_unlumped,equations_matrix_lumped],err,error,*999)
1161  ENDIF
1162  SELECT CASE(equations%SPARSITY_TYPE)
1163  CASE(equations_matrices_full_matrices)
1164  IF(equations_set%SPECIFICATION(3)==equations_set_inviscid_burgers_subtype) THEN
1165  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
1166  & [distributed_matrix_diagonal_storage_type],err,error,*999)
1167  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
1168  [equations_matrix_diagonal_structure],err,error,*999)
1169  ELSE
1170  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
1171  & [distributed_matrix_block_storage_type,distributed_matrix_diagonal_storage_type],err,error,*999)
1172  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
1173  [equations_matrix_fem_structure,equations_matrix_diagonal_structure],err,error,*999)
1174  ENDIF
1175  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices,distributed_matrix_block_storage_type, &
1176  & err,error,*999)
1177  CASE(equations_matrices_sparse_matrices)
1178  IF(equations_set%SPECIFICATION(3)==equations_set_inviscid_burgers_subtype) THEN
1179  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
1180  & [distributed_matrix_diagonal_storage_type],err,error,*999)
1181  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
1182  & [equations_matrix_diagonal_structure],err,error,*999)
1183  ELSE
1184  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
1185  & [distributed_matrix_compressed_row_storage_type,distributed_matrix_diagonal_storage_type],err,error,*999)
1186  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
1187  & [equations_matrix_fem_structure,equations_matrix_diagonal_structure],err,error,*999)
1188  ENDIF
1189  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices, &
1190  & distributed_matrix_compressed_row_storage_type,err,error,*999)
1191  CALL equationsmatrices_nonlinearstructuretypeset(equations_matrices,equations_matrix_fem_structure, &
1192  & err,error,*999)
1193  CASE DEFAULT
1194  local_error="The equations matrices sparsity type of "// &
1195  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
1196  CALL flagerror(local_error,err,error,*999)
1197  END SELECT
1198  ELSE
1199  SELECT CASE(equations%SPARSITY_TYPE)
1200  CASE(equations_matrices_full_matrices)
1201  IF(equations_set%SPECIFICATION(3)==equations_set_inviscid_burgers_subtype) THEN
1202  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
1203  & [distributed_matrix_block_storage_type],err,error,*999)
1204  ELSE
1205  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
1206  & [distributed_matrix_block_storage_type,distributed_matrix_block_storage_type],err,error,*999)
1207  ENDIF
1208  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices,distributed_matrix_block_storage_type, &
1209  & err,error,*999)
1210  CASE(equations_matrices_sparse_matrices)
1211  IF(equations_set%SPECIFICATION(3)==equations_set_inviscid_burgers_subtype) THEN
1212  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
1213  & [distributed_matrix_compressed_row_storage_type], &
1214  & err,error,*999)
1215  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
1216  [equations_matrix_fem_structure],err,error,*999)
1217  ELSE
1218  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
1219  & [distributed_matrix_compressed_row_storage_type,distributed_matrix_compressed_row_storage_type], &
1220  & err,error,*999)
1221  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
1222  [equations_matrix_fem_structure,equations_matrix_fem_structure],err,error,*999)
1223  ENDIF
1224  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices, &
1225  & distributed_matrix_compressed_row_storage_type,err,error,*999)
1226  CALL equationsmatrices_nonlinearstructuretypeset(equations_matrices, &
1227  equations_matrix_fem_structure,err,error,*999)
1228  CASE DEFAULT
1229  local_error="The equations matrices sparsity type of "// &
1230  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
1231  CALL flagerror(local_error,err,error,*999)
1232  END SELECT
1233  ENDIF
1234  ! Use the analytic Jacobian calculation
1235  CALL equationsmatrices_jacobiantypesset(equations_matrices,[equations_jacobian_analytic_calculated], &
1236  & err,error,*999)
1237  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
1238  CASE(equations_set_bem_solution_method)
1239  CALL flagerror("Not implemented.",err,error,*999)
1240  CASE(equations_set_fd_solution_method)
1241  CALL flagerror("Not implemented.",err,error,*999)
1242  CASE(equations_set_fv_solution_method)
1243  CALL flagerror("Not implemented.",err,error,*999)
1244  CASE(equations_set_gfem_solution_method)
1245  CALL flagerror("Not implemented.",err,error,*999)
1246  CASE(equations_set_gfv_solution_method)
1247  CALL flagerror("Not implemented.",err,error,*999)
1248  CASE DEFAULT
1249  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1250  & " is invalid."
1251  CALL flagerror(local_error,err,error,*999)
1252  END SELECT
1253  CASE DEFAULT
1254  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1255  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1256  & " is invalid for a nonlinear Burgers equation."
1257  CALL flagerror(local_error,err,error,*999)
1258  END SELECT
1259  CASE(equations_set_static_burgers_subtype)
1260  SELECT CASE(equations_set_setup%ACTION_TYPE)
1261  CASE(equations_set_setup_start_action)
1262  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
1263  CALL equations_create_start(equations_set,equations,err,error,*999)
1264  CALL equations_linearity_type_set(equations,equations_nonlinear,err,error,*999)
1265  CALL equations_time_dependence_type_set(equations,equations_static,err,error,*999)
1266  ELSE
1267  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
1268  ENDIF
1269  CASE(equations_set_setup_finish_action)
1270  SELECT CASE(equations_set%SOLUTION_METHOD)
1271  CASE(equations_set_fem_solution_method)
1272  !Finish the equations
1273  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
1274  CALL equations_create_finish(equations,err,error,*999)
1275  !Create the equations mapping.
1276  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
1277  CALL equationsmapping_linearmatricesnumberset(equations_mapping,1,err,error,*999)
1278  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,[field_u_variable_type], err,error,*999)
1279  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type, &
1280  & err,error,*999)
1281  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
1282  !Create the equations matrices
1283  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
1284  SELECT CASE(equations%SPARSITY_TYPE)
1285  CASE(equations_matrices_full_matrices)
1286  CALL equations_matrices_linear_storage_type_set(equations_matrices,[matrix_block_storage_type], &
1287  & err,error,*999)
1288  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices,matrix_block_storage_type, &
1289  & err,error,*999)
1290  CASE(equations_matrices_sparse_matrices)
1291  CALL equations_matrices_linear_storage_type_set(equations_matrices, &
1292  & [matrix_compressed_row_storage_type],err,error,*999)
1293  CALL equationsmatrices_linearstructuretypeset(equations_matrices, &
1294  & [equations_matrix_fem_structure],err,error,*999)
1295  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices, &
1296  & matrix_compressed_row_storage_type,err,error,*999)
1297  CALL equationsmatrices_nonlinearstructuretypeset(equations_matrices, &
1298  & equations_matrix_fem_structure,err,error,*999)
1299  CASE DEFAULT
1300  local_error="The equations matrices sparsity type of "// &
1301  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
1302  CALL flagerror(local_error,err,error,*999)
1303  END SELECT
1304  ! Use the analytic Jacobian calculation
1305  CALL equationsmatrices_jacobiantypesset(equations_matrices,[equations_jacobian_analytic_calculated], &
1306  & err,error,*999)
1307  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
1308  CASE(equations_set_bem_solution_method)
1309  CALL flagerror("Not implemented.",err,error,*999)
1310  CASE(equations_set_fd_solution_method)
1311  CALL flagerror("Not implemented.",err,error,*999)
1312  CASE(equations_set_fv_solution_method)
1313  CALL flagerror("Not implemented.",err,error,*999)
1314  CASE(equations_set_gfem_solution_method)
1315  CALL flagerror("Not implemented.",err,error,*999)
1316  CASE(equations_set_gfv_solution_method)
1317  CALL flagerror("Not implemented.",err,error,*999)
1318  CASE DEFAULT
1319  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1320  & " is invalid."
1321  CALL flagerror(local_error,err,error,*999)
1322  END SELECT
1323  CASE DEFAULT
1324  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1325  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1326  & " is invalid for a nonlinear Burgers equation."
1327  CALL flagerror(local_error,err,error,*999)
1328  END SELECT
1329  CASE DEFAULT
1330  local_error="The equation set subtype of "// &
1331  & trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
1332  & " is invalid for an analytical nonlinear Burgers equation."
1333  CALL flagerror(local_error,err,error,*999)
1334  END SELECT
1335  CASE DEFAULT
1336  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1337  & " is invalid for a nonlinear Burgers equation."
1338  CALL flagerror(local_error,err,error,*999)
1339  END SELECT
1340  CASE DEFAULT
1341  local_error="The equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
1342  & " is not a nonlinear Burgers equation subtype."
1343  CALL flagerror(local_error,err,error,*999)
1344  END SELECT
1345  ELSE
1346  CALL flagerror("Equations set is not associated.",err,error,*999)
1347  ENDIF
1348 
1349  exits("BURGERS_EQUATION_EQUATIONS_SET_SETUP")
1350  RETURN
1351 999 errorsexits("BURGERS_EQUATION_EQUATIONS_SET_SETUP",err,error)
1352  RETURN 1
1353 
1354  END SUBROUTINE burgers_equation_equations_set_setup
1355 
1356  !
1357  !================================================================================================================================
1358  !
1359 
1361  SUBROUTINE burgers_equation_pre_solve(SOLVER,ERR,ERROR,*)
1362 
1363  !Argument variables
1364  TYPE(solver_type), POINTER :: SOLVER
1365  INTEGER(INTG), INTENT(OUT) :: ERR
1366  TYPE(varying_string), INTENT(OUT) :: ERROR
1367  !Local variables
1368  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1369  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
1370  TYPE(solvers_type), POINTER :: SOLVERS
1371  TYPE(varying_string) :: LOCAL_ERROR
1372 
1373  enters("BURGERS_EQUATION_PRE_SOLVE",err,error,*999)
1374 
1375  IF(ASSOCIATED(solver)) THEN
1376  solvers=>solver%SOLVERS
1377  IF(ASSOCIATED(solvers)) THEN
1378  control_loop=>solvers%CONTROL_LOOP
1379  IF(ASSOCIATED(control_loop)) THEN
1380  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
1381  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
1382  CALL flagerror("Problem specification array is not allocated.",err,error,*999)
1383  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
1384  CALL flagerror("Problem specification must have three entries for a Burgers equation problem.",err,error,*999)
1385  END IF
1386  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
1387  CASE(problem_static_burgers_subtype)
1388  ! do nothing ???
1389  CASE(problem_dynamic_burgers_subtype)
1390  dynamic_solver=>solver%DYNAMIC_SOLVER
1391  IF(ASSOCIATED(dynamic_solver)) THEN
1392  IF(dynamic_solver%SOLVER_INITIALISED) &
1393  & CALL burgers_presolveupdateanalyticvalues(control_loop,solver,err,error,*999)
1394  ELSE
1395  CALL flagerror("Solver dynamic solver is not associated.",err,error,*999)
1396  ENDIF
1397  CASE DEFAULT
1398  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
1399  & " is not valid for a Burgers equation type of a fluid mechanics problem class."
1400  CALL flagerror(local_error,err,error,*999)
1401  END SELECT
1402  ELSE
1403  CALL flagerror("Problem is not associated.",err,error,*999)
1404  ENDIF
1405  ELSE
1406  CALL flagerror("Control loop is not associated.",err,error,*999)
1407  ENDIF
1408  ELSE
1409  CALL flagerror("Solver solvers is not associated.",err,error,*999)
1410  ENDIF
1411  ELSE
1412  CALL flagerror("Solver is not associated.",err,error,*999)
1413  ENDIF
1414 
1415  exits("BURGERS_EQUATION_PRE_SOLVE")
1416  RETURN
1417 999 errorsexits("BURGERS_EQUATION_PRE_SOLVE",err,error)
1418  RETURN 1
1419  END SUBROUTINE burgers_equation_pre_solve
1420 
1421 
1422  !
1423  !================================================================================================================================
1424  !
1425  !updates the boundary conditions and source term to the required analytic values
1426  SUBROUTINE burgers_presolveupdateanalyticvalues(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
1427 
1428  !Argument variables
1429  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1430  TYPE(solver_type), POINTER :: SOLVER
1431  INTEGER(INTG), INTENT(OUT) :: ERR
1432  TYPE(varying_string), INTENT(OUT) :: ERROR
1433  !Local Variables
1434  TYPE(field_type), POINTER :: ANALYTIC_FIELD,DEPENDENT_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD
1435  TYPE(field_variable_type), POINTER :: ANALYTIC_VARIABLE,FIELD_VARIABLE,GEOMETRIC_VARIABLE,MATERIALS_VARIABLE
1436  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
1437  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
1438  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1439  TYPE(equations_type), POINTER :: EQUATIONS
1440  TYPE(domain_type), POINTER :: DOMAIN
1441  TYPE(domain_nodes_type), POINTER :: DOMAIN_NODES
1442  TYPE(boundary_conditions_variable_type), POINTER :: BOUNDARY_CONDITIONS_VARIABLE
1443  TYPE(varying_string) :: LOCAL_ERROR
1444  REAL(DP), POINTER :: ANALYTIC_PARAMETERS(:),GEOMETRIC_PARAMETERS(:),MATERIALS_PARAMETERS(:)
1445  INTEGER(INTG) :: NUMBER_OF_DIMENSIONS,BOUNDARY_CONDITION_CHECK_VARIABLE
1446 
1447  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT
1448  REAL(DP) :: NORMAL(3),TANGENTS(3,3),VALUE,X(3)
1449  INTEGER(INTG) :: component_idx,deriv_idx,dim_idx,local_ny,node_idx,variable_idx,eqnset_idx
1450  INTEGER(INTG) :: VARIABLE_TYPE
1451  INTEGER(INTG) :: ANALYTIC_FUNCTION_TYPE
1452  INTEGER(INTG) :: GLOBAL_DERIV_INDEX
1453 
1454  enters("Burgers_PreSolveUpdateAnalyticValues",err,error,*999)
1455 
1456  IF(ASSOCIATED(control_loop)) THEN
1457  CALL control_loop_current_times_get(control_loop,current_time,time_increment,err,error,*999)
1458  IF(ASSOCIATED(solver)) THEN
1459  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
1460  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
1461  CALL flagerror("Problem specification array is not allocated.",err,error,*999)
1462  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
1463  CALL flagerror("Problem specification must have three entries for a Burgers equation problem.",err,error,*999)
1464  END IF
1465  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
1466  CASE(problem_static_burgers_subtype,problem_dynamic_burgers_subtype)
1467  solver_equations=>solver%SOLVER_EQUATIONS
1468  IF(ASSOCIATED(solver_equations)) THEN
1469  !Loop over all the equation sets and set the appropriate field variable type BCs and
1470  !the source field associated with each equation set
1471  DO eqnset_idx=1,solver_equations%SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS
1472  solver_mapping=>solver_equations%SOLVER_MAPPING
1473  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(eqnset_idx)%EQUATIONS
1474  IF(ASSOCIATED(equations)) THEN
1475  equations_set=>equations%EQUATIONS_SET
1476  IF(ASSOCIATED(equations_set)) THEN
1477  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
1478  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
1479  IF(ASSOCIATED(dependent_field)) THEN
1480  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
1481  IF(ASSOCIATED(geometric_field)) THEN
1482  analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
1483  CALL field_number_of_components_get(geometric_field,field_u_variable_type,&
1484  & number_of_dimensions,err,error,*999)
1485  NULLIFY(geometric_variable)
1486  NULLIFY(geometric_parameters)
1487  CALL field_variable_get(geometric_field,field_u_variable_type,geometric_variable,err,error,*999)
1488  CALL field_parameter_set_data_get(geometric_field,field_u_variable_type,field_values_set_type,&
1489  & geometric_parameters,err,error,*999)
1490  equations_set%ANALYTIC%ANALYTIC_USER_PARAMS(1)=current_time
1491  NULLIFY(analytic_variable)
1492  NULLIFY(analytic_parameters)
1493  IF(ASSOCIATED(analytic_field)) THEN
1494  CALL field_variable_get(analytic_field,field_u_variable_type,analytic_variable,err,error,*999)
1495  CALL field_parameter_set_data_get(analytic_field,field_u_variable_type,field_values_set_type, &
1496  & analytic_parameters,err,error,*999)
1497  ENDIF
1498  NULLIFY(materials_field)
1499  NULLIFY(materials_variable)
1500  NULLIFY(materials_parameters)
1501  IF(ASSOCIATED(equations_set%MATERIALS)) THEN
1502  materials_field=>equations_set%MATERIALS%MATERIALS_FIELD
1503  CALL field_variable_get(materials_field,field_u_variable_type,materials_variable,err,error,*999)
1504  CALL field_parameter_set_data_get(materials_field,field_u_variable_type,field_values_set_type, &
1505  & materials_parameters,err,error,*999)
1506  ENDIF
1507  DO variable_idx=1,dependent_field%NUMBER_OF_VARIABLES
1508  variable_type=dependent_field%VARIABLES(variable_idx)%VARIABLE_TYPE
1509  field_variable=>dependent_field%VARIABLE_TYPE_MAP(variable_type)%PTR
1510  IF(ASSOCIATED(field_variable)) THEN
1511  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
1512  IF(field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE== &
1513  & field_node_based_interpolation) THEN
1514  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
1515  IF(ASSOCIATED(domain)) THEN
1516  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
1517  domain_nodes=>domain%TOPOLOGY%NODES
1518  IF(ASSOCIATED(domain_nodes)) THEN
1519  !Loop over the local nodes excluding the ghosts.
1520  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
1521 !!TODO \todo We should interpolate the geometric field here and the node position.
1522  DO dim_idx=1,number_of_dimensions
1523  !Default to version 1 of each node derivative
1524  local_ny=geometric_variable%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP% &
1525  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(1)%VERSIONS(1)
1526  x(dim_idx)=geometric_parameters(local_ny)
1527  ENDDO !dim_idx
1528  !Loop over the derivatives
1529  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
1530  analytic_function_type=equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE
1531  global_deriv_index=domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)% &
1532  & global_derivative_index
1533  CALL burgers_analyticfunctionsevaluate(equations_set, &
1534  & analytic_function_type,x,tangents,normal,current_time,variable_type, &
1535  & global_deriv_index,component_idx,analytic_parameters,materials_parameters, &
1536  & VALUE,err,error,*999)
1537  !Default to version 1 of each node derivative
1538  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
1539  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
1540  CALL field_parameter_set_update_local_dof(dependent_field,variable_type, &
1541  & field_analytic_values_set_type,local_ny,VALUE,err,error,*999)
1542  CALL boundary_conditions_variable_get(solver_equations%BOUNDARY_CONDITIONS, &
1543  & field_variable,boundary_conditions_variable,err,error,*999)
1544  IF(ASSOCIATED(boundary_conditions_variable)) THEN
1545  boundary_condition_check_variable=boundary_conditions_variable% &
1546  & condition_types(local_ny)
1547  IF(boundary_condition_check_variable==boundary_condition_fixed) THEN
1548  CALL field_parameter_set_update_local_dof(dependent_field, &
1549  & variable_type,field_values_set_type,local_ny, &
1550  & VALUE,err,error,*999)
1551  ENDIF
1552  ELSE
1553  CALL flagerror("Boundary conditions variable is not associated",err,error,*999)
1554  ENDIF
1555  ENDDO !deriv_idx
1556  ENDDO !node_idx
1557  ELSE
1558  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
1559  ENDIF
1560  ELSE
1561  CALL flagerror("Domain topology is not associated.",err,error,*999)
1562  ENDIF
1563  ELSE
1564  CALL flagerror("Domain is not associated.",err,error,*999)
1565  ENDIF
1566  ELSE
1567  CALL flagerror("Only node based interpolation is implemented.",err,error,*999)
1568  ENDIF
1569  ENDDO !component_idx
1570  CALL field_parameter_set_update_start(dependent_field,variable_type, &
1571  & field_analytic_values_set_type,err,error,*999)
1572  CALL field_parameter_set_update_finish(dependent_field,variable_type, &
1573  & field_analytic_values_set_type,err,error,*999)
1574  CALL field_parameter_set_update_start(dependent_field,variable_type, &
1575  & field_values_set_type,err,error,*999)
1576  CALL field_parameter_set_update_finish(dependent_field,variable_type, &
1577  & field_values_set_type,err,error,*999)
1578  ELSE
1579  CALL flagerror("Field variable is not associated.",err,error,*999)
1580  ENDIF
1581 
1582  ENDDO !variable_idx
1583  CALL field_parameter_set_data_restore(geometric_field,field_u_variable_type,&
1584  & field_values_set_type,geometric_parameters,err,error,*999)
1585  ELSE
1586  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
1587  ENDIF
1588  ELSE
1589  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
1590  ENDIF
1591  ENDIF
1592  ELSE
1593  CALL flagerror("Equations set is not associated.",err,error,*999)
1594  ENDIF
1595  ELSE
1596  CALL flagerror("Equations are not associated.",err,error,*999)
1597  END IF
1598  CALL field_parameter_set_update_start(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1599  & field_values_set_type,err,error,*999)
1600  CALL field_parameter_set_update_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1601  & field_values_set_type,err,error,*999)
1602  ENDDO !eqnset_idx
1603  ELSE
1604  CALL flagerror("Solver equations are not associated.",err,error,*999)
1605  END IF
1606  CASE DEFAULT
1607  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
1608  & " is not valid for a BURGERS equation type of a fluid mechanics problem class."
1609  CALL flagerror(local_error,err,error,*999)
1610  END SELECT
1611  ELSE
1612  CALL flagerror("Problem is not associated.",err,error,*999)
1613  ENDIF
1614  ELSE
1615  CALL flagerror("Solver is not associated.",err,error,*999)
1616  ENDIF
1617  ELSE
1618  CALL flagerror("Control loop is not associated.",err,error,*999)
1619  ENDIF
1620 
1621  exits("Burgers_PreSolveUpdateAnalyticValues")
1622  RETURN
1623 999 errors("Burgers_PreSolveUpdateAnalyticValues",err,error)
1624  exits("Burgers_PreSolveUpdateAnalyticValues")
1625  RETURN 1
1626 
1627  END SUBROUTINE burgers_presolveupdateanalyticvalues
1628 
1629 
1630  !
1631  !================================================================================================================================
1632  !
1633  SUBROUTINE burgers_presolvestorecurrentsolution(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
1634 
1635  !Argument variables
1636  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1637  TYPE(solver_type), POINTER :: SOLVER
1638  INTEGER(INTG), INTENT(OUT) :: ERR
1639  TYPE(varying_string), INTENT(OUT) :: ERROR
1640  !Local Variables
1641  TYPE(varying_string) :: LOCAL_ERROR
1642 
1643  enters("Burgers_PreSolveStoreCurrentSolution",err,error,*999)
1644 
1645  IF(ASSOCIATED(control_loop)) THEN
1646 
1647  IF(ASSOCIATED(solver)) THEN
1648  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
1649  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
1650  CALL flagerror("Problem specification array is not allocated.",err,error,*999)
1651  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
1652  CALL flagerror("Problem specification must have three entries for a Burgers equation problem.",err,error,*999)
1653  END IF
1654  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
1655  CASE(problem_static_burgers_subtype)
1656  ! do nothing ???
1657  CASE(problem_dynamic_burgers_subtype)
1658  ! do nothing ???
1659  CASE DEFAULT
1660  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
1661  & " is not valid for a Burgers equation type of a fluid mechanics problem class."
1662  CALL flagerror(local_error,err,error,*999)
1663  END SELECT
1664  ELSE
1665  CALL flagerror("Problem is not associated.",err,error,*999)
1666  ENDIF
1667  ELSE
1668  CALL flagerror("Solver is not associated.",err,error,*999)
1669  ENDIF
1670  ELSE
1671  CALL flagerror("Control loop is not associated.",err,error,*999)
1672  ENDIF
1673 
1674  exits("Burgers_PreSolveStoreCurrentSolution")
1675  RETURN
1676 999 errors("Burgers_PreSolveStoreCurrentSolution",err,error)
1677  exits("Burgers_PreSolveStoreCurrentSolution")
1678  RETURN 1
1679 
1680  END SUBROUTINE burgers_presolvestorecurrentsolution
1681 
1682  !
1683  !================================================================================================================================
1684  !
1685 
1687  SUBROUTINE burgers_equation_post_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
1688 
1689  !Argument variables
1690  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1691  TYPE(solver_type), POINTER :: SOLVER
1692  INTEGER(INTG), INTENT(OUT) :: ERR
1693  TYPE(varying_string), INTENT(OUT) :: ERROR
1694  !Local Variables
1695  TYPE(varying_string) :: LOCAL_ERROR
1696 
1697  enters("BURGERS_EQUATION_POST_SOLVE",err,error,*999)
1698 
1699  IF(ASSOCIATED(control_loop)) THEN
1700  IF(ASSOCIATED(solver)) THEN
1701  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
1702  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
1703  CALL flagerror("Problem specification array is not allocated.",err,error,*999)
1704  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
1705  CALL flagerror("Problem specification must have three entries for a Burgers equation problem.",err,error,*999)
1706  END IF
1707  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
1708  CASE(problem_static_burgers_subtype,problem_dynamic_burgers_subtype)
1709  !CALL BURGERS_EQUATION_POST_SOLVE_OUTPUT_DATA(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
1710  CASE DEFAULT
1711  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
1712  & " is not valid for a BURGERS type of a fluid mechanics problem class."
1713  CALL flagerror(local_error,err,error,*999)
1714  END SELECT
1715  ELSE
1716  CALL flagerror("Problem is not associated.",err,error,*999)
1717  ENDIF
1718  ELSE
1719  CALL flagerror("Solver is not associated.",err,error,*999)
1720  ENDIF
1721  ELSE
1722  CALL flagerror("Control loop is not associated.",err,error,*999)
1723  ENDIF
1724 
1725  exits("BURGERS_EQUATION_POST_SOLVE")
1726  RETURN
1727 999 errorsexits("BURGERS_EQUATION_POST_SOLVE",err,error)
1728  RETURN 1
1729 
1730  END SUBROUTINE burgers_equation_post_solve
1731 
1732  !
1733  !================================================================================================================================
1734  !
1735 
1737  SUBROUTINE burgers_equation_post_solve_output_data(SOLVER,ERR,ERROR,*)
1738 
1739  !Argument variables
1740  TYPE(solver_type), POINTER :: SOLVER
1741  INTEGER(INTG), INTENT(OUT) :: ERR
1742  TYPE(varying_string), INTENT(OUT) :: ERROR
1743  !Local Variables
1744  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1745  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1746  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
1747  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
1748  TYPE(solvers_type), POINTER :: SOLVERS
1749  TYPE(varying_string) :: LOCAL_ERROR
1750 
1751  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT
1752  INTEGER(INTG) :: EQUATIONS_SET_IDX,CURRENT_LOOP_ITERATION,OUTPUT_ITERATION_NUMBER
1753 
1754  CHARACTER(14) :: FILE
1755  CHARACTER(14) :: OUTPUT_FILE
1756 
1757  enters("BURGERS_EQUATION_POST_SOLVE_OUTPUT_DATA",err,error,*999)
1758 
1759  IF(ASSOCIATED(solver)) THEN
1760  solvers=>solver%SOLVERS
1761  IF(ASSOCIATED(solvers)) THEN
1762  control_loop=>solvers%CONTROL_LOOP
1763  IF(ASSOCIATED(control_loop)) THEN
1764  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
1765  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
1766  CALL flagerror("Problem specification array is not allocated.",err,error,*999)
1767  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
1768  CALL flagerror("Problem specification must have three entries for a Burgers equation problem.",err,error,*999)
1769  END IF
1770  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
1771  CASE(problem_static_burgers_subtype,problem_dynamic_burgers_subtype)
1772  CALL control_loop_current_times_get(control_loop,current_time,time_increment,err,error,*999)
1773  solver_equations=>solver%SOLVER_EQUATIONS
1774  IF(ASSOCIATED(solver_equations)) THEN
1775  solver_mapping=>solver_equations%SOLVER_MAPPING
1776  IF(ASSOCIATED(solver_mapping)) THEN
1777  !Make sure the equations sets are up to date
1778  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
1779  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
1780 
1781  current_loop_iteration=control_loop%TIME_LOOP%ITERATION_NUMBER
1782  output_iteration_number=control_loop%TIME_LOOP%OUTPUT_NUMBER
1783 
1784  IF(output_iteration_number/=0) THEN
1785  IF(control_loop%TIME_LOOP%CURRENT_TIME<=control_loop%TIME_LOOP%STOP_TIME) THEN
1786  IF(current_loop_iteration<10) THEN
1787  WRITE(output_file,'("TIME_STEP_000",I0)') current_loop_iteration
1788  ELSE IF(current_loop_iteration<100) THEN
1789  WRITE(output_file,'("TIME_STEP_00",I0)') current_loop_iteration
1790  ELSE IF(current_loop_iteration<1000) THEN
1791  WRITE(output_file,'("TIME_STEP_0",I0)') current_loop_iteration
1792  ELSE IF(current_loop_iteration<10000) THEN
1793  WRITE(output_file,'("TIME_STEP_",I0)') current_loop_iteration
1794  END IF
1795  file=output_file
1796 
1797  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
1798  CALL analyticanalysis_output(equations_set%DEPENDENT%DEPENDENT_FIELD,file,err,error,*999)
1799  ENDIF
1800  ENDIF
1801  ENDIF
1802  ENDDO
1803  ENDIF
1804  ENDIF
1805  CASE DEFAULT
1806  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
1807  & " is not valid for a BURGERS equation type of a fluid mechanics problem class."
1808  CALL flagerror(local_error,err,error,*999)
1809  END SELECT
1810  ELSE
1811  CALL flagerror("Problem is not associated.",err,error,*999)
1812  ENDIF
1813  ELSE
1814  CALL flagerror("Control loop is not associated.",err,error,*999)
1815  ENDIF
1816  ELSE
1817  CALL flagerror("Solver solvers is not associated.",err,error,*999)
1818  ENDIF
1819  ELSE
1820  CALL flagerror("Solver is not associated.",err,error,*999)
1821  ENDIF
1822 
1823  exits("BURGERS_EQUATION_POST_SOLVE_OUTPUT_DATA")
1824  RETURN
1825 999 errorsexits("BURGERS_EQUATION_POST_SOLVE_OUTPUT_DATA",err,error)
1826  RETURN 1
1827 
1828  END SUBROUTINE burgers_equation_post_solve_output_data
1829 
1830  !
1831  !================================================================================================================================
1832  !
1833 
1835  SUBROUTINE burgers_problemspecificationset(problem,problemSpecification,err,error,*)
1836 
1837  !Argument variables
1838  TYPE(problem_type), POINTER :: problem
1839  INTEGER(INTG), INTENT(IN) :: problemSpecification(:)
1840  INTEGER(INTG), INTENT(OUT) :: err
1841  TYPE(varying_string), INTENT(OUT) :: error
1842  !Local Variables
1843  TYPE(varying_string) :: localError
1844  INTEGER(INTG) :: problemSubtype
1845 
1846  enters("Burgers_ProblemSpecificationSet",err,error,*999)
1847 
1848  IF(ASSOCIATED(problem)) THEN
1849  IF(SIZE(problemspecification,1)==3) THEN
1850  problemsubtype=problemspecification(3)
1851  SELECT CASE(problemsubtype)
1852  CASE(problem_static_burgers_subtype, &
1853  & problem_dynamic_burgers_subtype)
1854  !ok
1855  CASE DEFAULT
1856  localerror="The third problem specification of "//trim(numbertovstring(problemsubtype,"*",err,error))// &
1857  & " is not valid for a Burgers type of a fluid mechanics problem."
1858  CALL flagerror(localerror,err,error,*999)
1859  END SELECT
1860  IF(ALLOCATED(problem%specification)) THEN
1861  CALL flagerror("Problem specification is already allocated.",err,error,*999)
1862  ELSE
1863  ALLOCATE(problem%specification(3),stat=err)
1864  IF(err/=0) CALL flagerror("Could not allocate problem specification.",err,error,*999)
1865  END IF
1866  problem%specification(1:3)=[problem_fluid_mechanics_class,problem_burgers_equation_type,problemsubtype]
1867  ELSE
1868  CALL flagerror("Burgers equation problem specification must have three entries.",err,error,*999)
1869  END IF
1870  ELSE
1871  CALL flagerror("Problem is not associated.",err,error,*999)
1872  END IF
1873 
1874  exits("Burgers_ProblemSpecificationSet")
1875  RETURN
1876 999 errors("Burgers_ProblemSpecificationSet",err,error)
1877  exits("Burgers_ProblemSpecificationSet")
1878  RETURN 1
1879 
1880  END SUBROUTINE burgers_problemspecificationset
1881 
1882  !
1883  !================================================================================================================================
1884  !
1885 
1887  SUBROUTINE burgers_equation_problem_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
1888 
1889  !Argument variables
1890  TYPE(problem_type), POINTER :: PROBLEM
1891  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
1892  INTEGER(INTG), INTENT(OUT) :: ERR
1893  TYPE(varying_string), INTENT(OUT) :: ERROR
1894  !Local Variables
1895  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT
1896  TYPE(solver_type), POINTER :: SOLVER
1897  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
1898  TYPE(solvers_type), POINTER :: SOLVERS
1899  TYPE(varying_string) :: LOCAL_ERROR
1900 
1901  NULLIFY(control_loop)
1902  NULLIFY(solver)
1903  NULLIFY(solver_equations)
1904  NULLIFY(solvers)
1905 
1906  enters("BURGERS_EQUATION_PROBLEM_SETUP",err,error,*999)
1907 
1908  IF(ASSOCIATED(problem)) THEN
1909  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
1910  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1911  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
1912  CALL flagerror("Problem specification must have three entries for a Burgers equation problem.",err,error,*999)
1913  END IF
1914  SELECT CASE(problem%SPECIFICATION(3))
1915  CASE(problem_static_burgers_subtype)
1916  SELECT CASE(problem_setup%SETUP_TYPE)
1917  CASE(problem_setup_initial_type)
1918  SELECT CASE(problem_setup%ACTION_TYPE)
1919  CASE(problem_setup_start_action)
1920  !Do nothing????
1921  CASE(problem_setup_finish_action)
1922  !Do nothing????
1923  CASE DEFAULT
1924  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1925  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1926  & " is invalid for a Burgers problem."
1927  CALL flagerror(local_error,err,error,*999)
1928  END SELECT
1929  CASE(problem_setup_control_type)
1930  SELECT CASE(problem_setup%ACTION_TYPE)
1931  CASE(problem_setup_start_action)
1932  !Set up a simple control loop
1933  CALL control_loop_create_start(problem,control_loop,err,error,*999)
1934  CASE(problem_setup_finish_action)
1935  !Finish the control loops
1936  control_loop_root=>problem%CONTROL_LOOP
1937  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1938  CALL control_loop_create_finish(control_loop,err,error,*999)
1939  CASE DEFAULT
1940  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1941  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1942  & " is invalid for a Burgers problem."
1943  CALL flagerror(local_error,err,error,*999)
1944  END SELECT
1945  CASE(problem_setup_solvers_type)
1946  !Get the control loop
1947  control_loop_root=>problem%CONTROL_LOOP
1948  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1949  SELECT CASE(problem_setup%ACTION_TYPE)
1950  CASE(problem_setup_start_action)
1951  !Start the solvers creation
1952  CALL solvers_create_start(control_loop,solvers,err,error,*999)
1953  CALL solvers_number_set(solvers,1,err,error,*999)
1954  !Set the solver to be a static nonlinear solver
1955  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1956  CALL solver_type_set(solver,solver_nonlinear_type,err,error,*999)
1957  CALL solver_label_set(solver,"Nonlinear solver",err,error,*999)
1958  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
1959  CASE(problem_setup_finish_action)
1960  !Get the solvers
1961  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
1962  !Finish the solvers creation
1963  CALL solvers_create_finish(solvers,err,error,*999)
1964  CASE DEFAULT
1965  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1966  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1967  & " is invalid for a Burgers problem."
1968  CALL flagerror(local_error,err,error,*999)
1969  END SELECT
1970  CASE(problem_setup_solver_equations_type)
1971  SELECT CASE(problem_setup%ACTION_TYPE)
1972  CASE(problem_setup_start_action)
1973  !Get the control loop
1974  control_loop_root=>problem%CONTROL_LOOP
1975  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1976  !Get the solver
1977  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
1978  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1979  !Create the solver equations
1980  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
1981  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
1982  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
1983  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
1984  CASE(problem_setup_finish_action)
1985  !Get the control loop
1986  control_loop_root=>problem%CONTROL_LOOP
1987  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1988  !Get the solver equations
1989  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
1990  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1991  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
1992  !Finish the solver equations creation
1993  CALL solver_equations_create_finish(solver_equations,err,error,*999)
1994  CASE DEFAULT
1995  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1996  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1997  & " is invalid for a Burgers problem."
1998  CALL flagerror(local_error,err,error,*999)
1999  END SELECT
2000  CASE DEFAULT
2001  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
2002  & " is invalid for a Burgers problem."
2003  CALL flagerror(local_error,err,error,*999)
2004  END SELECT
2005  CASE(problem_dynamic_burgers_subtype)
2006  SELECT CASE(problem_setup%SETUP_TYPE)
2007  CASE(problem_setup_initial_type)
2008  SELECT CASE(problem_setup%ACTION_TYPE)
2009  CASE(problem_setup_start_action)
2010  !Do nothing????
2011  CASE(problem_setup_finish_action)
2012  !Do nothing????
2013  CASE DEFAULT
2014  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
2015  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
2016  & " is invalid for a Burgers problem."
2017  CALL flagerror(local_error,err,error,*999)
2018  END SELECT
2019  CASE(problem_setup_control_type)
2020  SELECT CASE(problem_setup%ACTION_TYPE)
2021  CASE(problem_setup_start_action)
2022  !Set up a time control loop
2023  CALL control_loop_create_start(problem,control_loop,err,error,*999)
2024  CALL control_loop_type_set(control_loop,problem_control_time_loop_type,err,error,*999)
2025  CASE(problem_setup_finish_action)
2026  !Finish the control loops
2027  control_loop_root=>problem%CONTROL_LOOP
2028  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
2029  CALL control_loop_create_finish(control_loop,err,error,*999)
2030  CASE DEFAULT
2031  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
2032  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
2033  & " is invalid for a Burgers problem."
2034  CALL flagerror(local_error,err,error,*999)
2035  END SELECT
2036  CASE(problem_setup_solvers_type)
2037  !Get the control loop
2038  control_loop_root=>problem%CONTROL_LOOP
2039  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
2040  SELECT CASE(problem_setup%ACTION_TYPE)
2041  CASE(problem_setup_start_action)
2042  !Start the solvers creation
2043  CALL solvers_create_start(control_loop,solvers,err,error,*999)
2044  CALL solvers_number_set(solvers,1,err,error,*999)
2045  !Set the solver to be a static nonlinear solver
2046  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
2047  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
2048  CALL solver_label_set(solver,"Nonlinear dynamic solver",err,error,*999)
2049  CALL solver_dynamic_linearity_type_set(solver,solver_dynamic_nonlinear,err,error,*999)
2050  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
2051  !Set solver defaults
2052  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
2053  CALL solver_dynamic_scheme_set(solver,solver_dynamic_crank_nicolson_scheme,err,error,*999)
2054  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
2055  CASE(problem_setup_finish_action)
2056  !Get the solvers
2057  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
2058  !Finish the solvers creation
2059  CALL solvers_create_finish(solvers,err,error,*999)
2060  CASE DEFAULT
2061  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
2062  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
2063  & " is invalid for a nonlinear burgers problem."
2064  CALL flagerror(local_error,err,error,*999)
2065  END SELECT
2066  CASE(problem_setup_solver_equations_type)
2067  SELECT CASE(problem_setup%ACTION_TYPE)
2068  CASE(problem_setup_start_action)
2069  !Get the control loop
2070  control_loop_root=>problem%CONTROL_LOOP
2071  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
2072  !Get the solver
2073  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
2074  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
2075  !Create the solver equations
2076  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
2077  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
2078  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_first_order_dynamic, &
2079  & err,error,*999)
2080  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
2081  CASE(problem_setup_finish_action)
2082  !Get the control loop
2083  control_loop_root=>problem%CONTROL_LOOP
2084  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
2085  !Get the solver equations
2086  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
2087  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
2088  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
2089  !Finish the solver equations creation
2090  CALL solver_equations_create_finish(solver_equations,err,error,*999)
2091  CASE DEFAULT
2092  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
2093  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
2094  & " is invalid for a Burgers problem."
2095  CALL flagerror(local_error,err,error,*999)
2096  END SELECT
2097  CASE DEFAULT
2098  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
2099  & " is invalid for a Burgers problem."
2100  CALL flagerror(local_error,err,error,*999)
2101  END SELECT
2102  CASE DEFAULT
2103  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
2104  & " does not equal a Burgers problem subtype."
2105  CALL flagerror(local_error,err,error,*999)
2106  END SELECT
2107  ELSE
2108  CALL flagerror("Problem is not associated.",err,error,*999)
2109  ENDIF
2110 
2111  exits("BURGERS_EQUATION_PROBLEM_SETUP")
2112  RETURN
2113 999 errorsexits("BURGERS_EQUATION_PROBLEM_SETUP",err,error)
2114  RETURN 1
2115 
2116  END SUBROUTINE burgers_equation_problem_setup
2117 
2118  !
2119  !================================================================================================================================
2120  !
2121 
2123  SUBROUTINE burgers_finiteelementjacobianevaluate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
2124 
2125  !Argument variables
2126  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2127  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
2128  INTEGER(INTG), INTENT(OUT) :: ERR
2129  TYPE(varying_string), INTENT(OUT) :: ERROR
2130  !Local Variables
2131  INTEGER(INTG) FIELD_VAR_TYPE,ng,mh,mhs,nj,ms,nh,nhs,ni,ns,MESH_COMPONENT1,MESH_COMPONENT2
2132  REAL(DP) :: C_PARAM,JGW,SUM1,SUM2,SUM3,DXI_DX,DPHINS_DXI,PHIMS,PHINS,U_VALUE,U_DERIV,VALUE
2133  LOGICAL :: EVALUATE_JACOBIAN,UPDATE_JACOBIAN_MATRIX
2134  TYPE(basis_type), POINTER :: DEPENDENT_BASIS1,DEPENDENT_BASIS2,GEOMETRIC_BASIS
2135  TYPE(equations_type), POINTER :: EQUATIONS
2136  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2137  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
2138  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
2139  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
2140  TYPE(equations_jacobian_type), POINTER :: JACOBIAN_MATRIX
2141  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD
2142  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE,GEOMETRIC_VARIABLE
2143  TYPE(quadrature_scheme_type), POINTER :: QUADRATURE_SCHEME1,QUADRATURE_SCHEME2
2144 
2145  enters("Burgers_FiniteElementJacobianEvaluate",err,error,*999)
2146 
2147  IF(ASSOCIATED(equations_set)) THEN
2148  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
2149  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
2150  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
2151  CALL flagerror("Equations set specification must have three entries for a Burgers type equations set.", &
2152  & err,error,*999)
2153  END IF
2154  equations=>equations_set%EQUATIONS
2155  IF(ASSOCIATED(equations)) THEN
2156  equations_matrices=>equations%EQUATIONS_MATRICES
2157  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
2158  jacobian_matrix=>nonlinear_matrices%JACOBIANS(1)%PTR
2159  update_jacobian_matrix=jacobian_matrix%UPDATE_JACOBIAN
2160  evaluate_jacobian=update_jacobian_matrix
2161  IF(evaluate_jacobian) THEN
2162  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
2163  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
2164  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
2165  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
2166  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2167  dependent_basis1=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
2168  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2169  quadrature_scheme1=>dependent_basis1%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
2170  equations_mapping=>equations%EQUATIONS_MAPPING
2171  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
2172  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
2173  field_var_type=field_variable%VARIABLE_TYPE
2174  geometric_variable=>geometric_field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
2175  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
2176  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
2177  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
2178  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
2179  IF(equations_set%SPECIFICATION(3)==equations_set_generalised_burgers_subtype) &
2180  & CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
2181  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
2182  c_param=1.0_dp
2183  !Loop over all Gauss points
2184  DO ng=1,quadrature_scheme1%NUMBER_OF_GAUSS
2185  CALL field_interpolate_gauss(second_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
2186  & dependent_interp_point(field_var_type)%PTR,err,error,*999)
2187  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
2188  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
2189  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
2190  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
2191  IF(equations_set%SPECIFICATION(3)==equations_set_generalised_burgers_subtype) THEN
2192  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
2193  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
2194  c_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,no_part_deriv)
2195  ENDIF
2196  !Loop over rows
2197  mhs=0
2198  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
2199  mesh_component1=field_variable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
2200  dependent_basis1=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component1)%PTR% &
2201  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2202  quadrature_scheme1=>dependent_basis1%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
2203  jgw=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
2204  & quadrature_scheme1%GAUSS_WEIGHTS(ng)
2205  DO ms=1,dependent_basis1%NUMBER_OF_ELEMENT_PARAMETERS
2206  mhs=mhs+1
2207  nhs=0
2208  phims=quadrature_scheme1%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
2209  !Loop over element columns
2210  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
2211  mesh_component2=field_variable%COMPONENTS(nh)%MESH_COMPONENT_NUMBER
2212  dependent_basis2=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component2)%PTR% &
2213  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2214  quadrature_scheme2=>dependent_basis2%QUADRATURE%QUADRATURE_SCHEME_MAP&
2215  &(basis_default_quadrature_scheme)%PTR
2216  DO ns=1,dependent_basis2%NUMBER_OF_ELEMENT_PARAMETERS
2217  nhs=nhs+1
2218  phins=quadrature_scheme2%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)
2219  !Loop over xi directions
2220  sum1=0.0_dp
2221  DO ni=1,dependent_basis1%NUMBER_OF_XI
2222  u_deriv=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR% &
2223  & values(mh,partial_derivative_first_derivative_map(ni))
2224  dxi_dx=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%DXI_DX(ni,nh)
2225  sum1=sum1+u_deriv*dxi_dx
2226  ENDDO !ni
2227  sum1=sum1*phins
2228  sum2=0.0_dp
2229  IF(nh==mh) THEN
2230  !Loop over spatial directions
2231  DO nj=1,geometric_variable%NUMBER_OF_COMPONENTS
2232  u_value=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(nj,no_part_deriv)
2233  sum3=0.0_dp
2234  DO ni=1,dependent_basis1%NUMBER_OF_XI
2235  dphins_dxi=quadrature_scheme1%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(ni),ng)
2236  dxi_dx=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%DXI_DX(ni,nj)
2237  sum3=sum3+dphins_dxi*dxi_dx
2238  ENDDO !ni
2239  sum2=sum2+u_value*sum3
2240  ENDDO !nj
2241  ENDIF
2242  VALUE=c_param*(sum1+sum2)*phims
2243  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)+VALUE*jgw
2244  ENDDO !ns
2245  ENDDO !nh
2246  ENDDO !ms
2247  ENDDO !mh
2248  ENDDO !ng
2249  ENDIF
2250  ELSE
2251  CALL flagerror("Equations set equations is not associated.",err,error,*999)
2252  ENDIF
2253  ELSE
2254  CALL flagerror("Equations set is not associated.",err,error,*999)
2255  ENDIF
2256 
2257  exits("Burgers_FiniteElementJacobianEvaluate")
2258  RETURN
2259 999 errors("Burgers_FiniteElementJacobianEvaluate",err,error)
2260  exits("Burgers_FiniteElementJacobianEvaluate")
2261  RETURN 1
2262 
2263  END SUBROUTINE burgers_finiteelementjacobianevaluate
2264 
2265  !
2266  !================================================================================================================================
2267  !
2268 
2270  SUBROUTINE burgers_finiteelementresidualevaluate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
2271 
2272  !Argument variables
2273  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2274  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
2275  INTEGER(INTG), INTENT(OUT) :: ERR
2276  TYPE(varying_string), INTENT(OUT) :: ERROR
2277  !Local Variables
2278  INTEGER(INTG) FIELD_VAR_TYPE,ng,mh,mhs,ms,nj,nh,nhs,ni,mi,ns
2279  INTEGER(INTG) MESH_COMPONENT1,MESH_COMPONENT2
2280  REAL(DP) :: A_PARAM,B_PARAM,C_PARAM,JGW,SUM,SUM1,PHIMS,PHINS,DPHIMS_DXI(3),DPHINS_DXI(3),U_VALUE
2281  LOGICAL :: EVALUATE_ANY,EVALUATE_DAMPING,EVALUATE_LINEAR_DYNAMIC,EVALUATE_RESIDUAL,EVALUATE_RHS, &
2282  & EVALUATE_STIFFNESS,FIRST_DAMPING,FIRST_RHS,FIRST_STIFFNESS,UPDATE_STIFFNESS,UPDATE_DAMPING,UPDATE_RHS,UPDATE_RESIDUAL
2283  TYPE(basis_type), POINTER :: DEPENDENT_BASIS,GEOMETRIC_BASIS,DEPENDENT_BASIS1,DEPENDENT_BASIS2
2284  TYPE(equations_type), POINTER :: EQUATIONS
2285  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2286  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
2287  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
2288  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
2289  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
2290  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
2291  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
2292  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
2293  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
2294  TYPE(equations_matrix_type), POINTER :: STIFFNESS_MATRIX,DAMPING_MATRIX
2295  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD
2296  TYPE(field_variable_type), POINTER :: GEOMETRIC_VARIABLE,FIELD_VARIABLE
2297  TYPE(quadrature_scheme_type), POINTER :: QUADRATURE_SCHEME,QUADRATURE_SCHEME1,QUADRATURE_SCHEME2
2298  TYPE(varying_string) :: LOCAL_ERROR
2299 
2300  enters("Burgers_FiniteElementResidualEvaluate",err,error,*999)
2301 
2302  NULLIFY(damping_matrix)
2303  NULLIFY(dynamic_matrices)
2304  NULLIFY(stiffness_matrix)
2305 
2306  update_stiffness=.false.
2307  first_stiffness=.false.
2308  update_damping=.false.
2309  first_damping=.false.
2310  update_rhs=.false.
2311  first_rhs=.false.
2312  update_residual=.false.
2313 
2314  IF(ASSOCIATED(equations_set)) THEN
2315  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
2316  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
2317  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
2318  CALL flagerror("Equations set specification must have three entries for a Burgers type equations set.", &
2319  & err,error,*999)
2320  END IF
2321  equations=>equations_set%EQUATIONS
2322  IF(ASSOCIATED(equations)) THEN
2323  equations_matrices=>equations%EQUATIONS_MATRICES
2324  rhs_vector=>equations_matrices%RHS_VECTOR
2325  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
2326  equations_mapping=>equations%EQUATIONS_MAPPING
2327  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
2328  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
2329  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
2330  geometric_variable=>geometric_field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
2331  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
2332  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
2333  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2334  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
2335  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2336  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
2337  SELECT CASE(equations_set%SPECIFICATION(3))
2338  CASE(equations_set_burgers_subtype)
2339  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
2340  stiffness_matrix=>dynamic_matrices%MATRICES(1)%PTR
2341  damping_matrix=>dynamic_matrices%MATRICES(2)%PTR
2342  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
2343  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
2344  field_var_type=field_variable%VARIABLE_TYPE
2345  CASE(equations_set_generalised_burgers_subtype)
2346  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
2347  stiffness_matrix=>dynamic_matrices%MATRICES(1)%PTR
2348  damping_matrix=>dynamic_matrices%MATRICES(2)%PTR
2349  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
2350  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
2351  field_var_type=field_variable%VARIABLE_TYPE
2352  CASE(equations_set_static_burgers_subtype)
2353  linear_matrices=>equations_matrices%LINEAR_MATRICES
2354  stiffness_matrix=>linear_matrices%MATRICES(1)%PTR
2355  linear_mapping=>equations_mapping%LINEAR_MAPPING
2356  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
2357  field_var_type=field_variable%VARIABLE_TYPE
2358  CASE(equations_set_inviscid_burgers_subtype)
2359  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
2360  damping_matrix=>dynamic_matrices%MATRICES(1)%PTR
2361  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
2362  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
2363  field_var_type=field_variable%VARIABLE_TYPE
2364  CASE DEFAULT
2365  local_error="Equations set subtype "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2366  & " is not valid for a BURGERS equation type of a fluid mechanics equations set class."
2367  CALL flagerror(local_error,err,error,*999)
2368  END SELECT
2369  IF(ASSOCIATED(stiffness_matrix)) THEN
2370  update_stiffness=stiffness_matrix%UPDATE_MATRIX
2371  first_stiffness=stiffness_matrix%FIRST_ASSEMBLY
2372  ENDIF
2373  IF(ASSOCIATED(damping_matrix)) THEN
2374  update_damping=damping_matrix%UPDATE_MATRIX
2375  first_damping=damping_matrix%FIRST_ASSEMBLY
2376  ENDIF
2377  IF(ASSOCIATED(rhs_vector)) THEN
2378  update_rhs=rhs_vector%UPDATE_VECTOR
2379  first_rhs=rhs_vector%FIRST_ASSEMBLY
2380  ENDIF
2381  IF(ASSOCIATED(nonlinear_matrices)) update_residual=nonlinear_matrices%UPDATE_RESIDUAL
2382  evaluate_residual=update_residual
2383  evaluate_stiffness=first_stiffness.OR.update_stiffness
2384  evaluate_damping=first_damping.OR.update_damping
2385  evaluate_rhs=first_rhs.OR.update_rhs
2386  evaluate_linear_dynamic=evaluate_stiffness.OR.evaluate_damping.OR.evaluate_rhs
2387  evaluate_any=evaluate_linear_dynamic.OR.update_residual
2388  IF(evaluate_any) THEN
2389  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
2390  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
2391  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
2392  & geometric_interp_parameters(field_var_type)%PTR,err,error,*999)
2393  IF(equations_set%SPECIFICATION(3)/=equations_set_inviscid_burgers_subtype) &
2394  & CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
2395  & materials_interp_parameters(field_var_type)%PTR,err,error,*999)
2396  a_param=1.0_dp
2397  b_param=1.0_dp
2398  c_param=1.0_dp
2399  !Loop over gauss points
2400  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
2401  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
2402  & dependent_interp_point(field_var_type)%PTR,err,error,*999)
2403  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
2404  & geometric_interp_point(field_var_type)%PTR,err,error,*999)
2405  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
2406  & geometric_interp_point_metrics(field_var_type)%PTR,err,error,*999)
2407  IF(equations_set%SPECIFICATION(3)/=equations_set_inviscid_burgers_subtype) THEN
2408  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
2409  & materials_interp_point(field_var_type)%PTR,err,error,*999)
2410  IF(equations_set%SPECIFICATION(3)==equations_set_generalised_burgers_subtype) THEN
2411  a_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,no_part_deriv)
2412  b_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,no_part_deriv)
2413  c_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,no_part_deriv)
2414  ELSE
2415  b_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,no_part_deriv)
2416  ENDIF
2417  ENDIF
2418  mhs=0
2419  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
2420  mesh_component1=field_variable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
2421  dependent_basis1=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component1)%PTR% &
2422  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2423  quadrature_scheme1=>dependent_basis1%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
2424  jgw=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
2425  & quadrature_scheme1%GAUSS_WEIGHTS(ng)
2426  !Loop over element rows
2427  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2428  mhs=mhs+1
2429  IF(evaluate_linear_dynamic) THEN
2430  IF(evaluate_stiffness.OR.evaluate_damping) THEN
2431  nhs=0
2432  !Loop over element columns
2433  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
2434  mesh_component2=field_variable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
2435  dependent_basis2=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component2)%PTR% &
2436  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2437  quadrature_scheme2=>dependent_basis2%QUADRATURE%QUADRATURE_SCHEME_MAP&
2438  &(basis_default_quadrature_scheme)%PTR
2439  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2440  nhs=nhs+1
2441  !Diffusion matrix
2442  IF(evaluate_stiffness) THEN
2443  DO ni=1,dependent_basis1%NUMBER_OF_XI
2444  dphims_dxi(ni)=quadrature_scheme1%GAUSS_BASIS_FNS(ms,partial_derivative_first_derivative_map(ni),ng)
2445  dphins_dxi(ni)=quadrature_scheme2%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(ni),ng)
2446  END DO !ni
2447  sum=0.0_dp
2448  !Calculate SUM
2449  DO mi=1,dependent_basis1%NUMBER_OF_XI
2450  DO ni=1,dependent_basis2%NUMBER_OF_XI
2451  sum=sum+dphins_dxi(ni)*dphims_dxi(mi)*equations%INTERPOLATION% &
2452  & geometric_interp_point_metrics(field_u_variable_type)%PTR%GU(mi,ni)
2453  ENDDO !ni
2454  ENDDO !mi
2455  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)- &
2456  & b_param*sum*jgw
2457  ENDIF
2458  !Mass matrix
2459  IF(evaluate_damping) THEN
2460  phims=quadrature_scheme1%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
2461  phins=quadrature_scheme2%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)
2462  damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+ &
2463  & a_param*phims*phins*jgw
2464  ENDIF
2465  ENDDO !ns
2466  ENDDO !nh
2467  ENDIF !Stiffness or Damping
2468  !Calculate RHS
2469  IF(evaluate_rhs) THEN
2470  rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=0.0_dp
2471  ENDIF
2472  ENDIF !Evaluate linear dynamic
2473  !Calculate nonlinear vector
2474  IF(evaluate_residual) THEN
2475  phims=quadrature_scheme1%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
2476  sum=0.0_dp
2477  DO nj=1,field_variable%NUMBER_OF_COMPONENTS
2478  u_value=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(nj,no_part_deriv)
2479  sum1=0.0_dp
2480  !Calculate SUM
2481  DO ni=1,dependent_basis1%NUMBER_OF_XI
2482  sum1=sum1+equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(nj, &
2483  & partial_derivative_first_derivative_map(ni))*equations%INTERPOLATION% &
2484  & geometric_interp_point_metrics(field_u_variable_type)%PTR%DXI_DX(ni,nj)
2485  ENDDO !ni
2486  sum=sum+u_value*sum1
2487  ENDDO !nj
2488  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)=nonlinear_matrices% &
2489  & element_residual%VECTOR(mhs)+c_param*sum*phims*jgw
2490  ENDIF
2491  ENDDO !ms
2492  ENDDO !mh
2493  ENDDO !ng
2494 
2495  !Scale factor adjustment
2496  IF(dependent_field%SCALINGS%SCALING_TYPE/=field_no_scaling) THEN
2497  CALL field_interpolationparametersscalefactorselementget(element_number,equations%INTERPOLATION% &
2498  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
2499  mhs=0
2500  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
2501  !Loop over element rows
2502  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2503  mhs=mhs+1
2504  nhs=0
2505  IF(evaluate_stiffness.OR.evaluate_damping) THEN
2506  !Loop over element columns
2507  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
2508  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2509  nhs=nhs+1
2510  IF(evaluate_stiffness) &
2511  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)* &
2512  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)* &
2513  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
2514  IF(evaluate_damping) &
2515  damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)* &
2516  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)* &
2517  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
2518  ENDDO !ns
2519  ENDDO !nh
2520  ENDIF
2521  IF(evaluate_rhs) &
2522  & rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)* &
2523  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)
2524  IF(evaluate_residual) &
2525  & nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)=nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)* &
2526  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)
2527  ENDDO !ms
2528  ENDDO !mh
2529  ENDIF
2530 
2531  ENDIF !Evaluate any
2532 
2533  ELSE
2534  CALL flagerror("Equations set equations is not associated.",err,error,*999)
2535  ENDIF
2536  ELSE
2537  CALL flagerror("Equations set is not associated.",err,error,*999)
2538  ENDIF
2539 
2540  exits("Burgers_FiniteElementResidualEvaluate")
2541  RETURN
2542 999 errors("Burgers_FiniteElementResidualEvaluate",err,error)
2543  exits("Burgers_FiniteElementResidualEvaluate")
2544  RETURN 1
2545 
2546  END SUBROUTINE burgers_finiteelementresidualevaluate
2547 
2548  !
2549  !================================================================================================================================
2550  !
2551 
2552 END MODULE burgers_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
types::boundary_conditions_type
Contains information on the boundary conditions for the solver equations.
Definition: types.f90:1780
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
solver_routines::solvers_create_finish
subroutine, public solvers_create_finish(SOLVERS, ERR, ERROR,)
Finish the creation of solvers.
Definition: solver_routines.f90:22598
burgers_equation_routines::burgers_equation_equations_set_setup
subroutine, public burgers_equation_equations_set_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the Burgers equation type of a fluid mechanics equations set class.
Definition: Burgers_equation_routines.f90:572
constants::second_part_deriv
integer(intg), parameter second_part_deriv
Second partial derivative i.e., d^2u/ds^2.
Definition: constants.f90:179
burgers_equation_routines::burgers_presolvestorecurrentsolution
subroutine burgers_presolvestorecurrentsolution(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Definition: Burgers_equation_routines.f90:1634
equations_mapping_routines::equations_mapping_dynamic_variable_type_set
subroutine, public equations_mapping_dynamic_variable_type_set(EQUATIONS_MAPPING, DYNAMIC_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set dynamic matrices...
Definition: equations_mapping_routines.f90:1996
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::problem_control_time_loop_type
integer(intg), parameter problem_control_time_loop_type
Time control loop.
Definition: problem_constants.f90:283
problem_constants::problem_setup_control_type
integer(intg), parameter problem_setup_control_type
Solver setup for a problem.
Definition: problem_constants.f90:263
problem_constants
This module handles all problem wide constants.
Definition: problem_constants.f90:45
problem_constants::solver_equations_first_order_dynamic
integer(intg), parameter solver_equations_first_order_dynamic
Solver equations are first order dynamic.
Definition: problem_constants.f90:311
control_loop_routines::control_loop_node
integer(intg), parameter, public control_loop_node
The identifier for a each "leaf" node in a control loop.
Definition: control_loop_routines.f90:67
solver_routines::solver_dynamic_order_set
subroutine, public solver_dynamic_order_set(SOLVER, ORDER, ERR, ERROR,)
Sets/changes the order for a dynamic solver.
Definition: solver_routines.f90:6327
constants::no_global_deriv
integer(intg), parameter no_global_deriv
No global derivative i.e., u.
Definition: constants.f90:213
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
types::solver_type
Contains information on the type of solver to be used.
Definition: types.f90:2777
solver_routines::solver_petsc_library
integer(intg), parameter, public solver_petsc_library
PETSc solver library.
Definition: solver_routines.f90:104
solver_routines::solvers_number_set
subroutine, public solvers_number_set(SOLVERS, NUMBER_OF_SOLVERS, ERR, ERROR,)
Sets/changes the number of solvers.
Definition: solver_routines.f90:22805
constants::no_part_deriv
integer(intg), parameter no_part_deriv
No partial derivative i.e., u.
Definition: constants.f90:177
solver_routines::solver_dynamic_crank_nicolson_scheme
integer(intg), parameter, public solver_dynamic_crank_nicolson_scheme
Crank-Nicolson dynamic solver.
Definition: solver_routines.f90:282
solver_routines::solver_dynamic_degree_set
subroutine, public solver_dynamic_degree_set(SOLVER, DEGREE, ERR, ERROR,)
Sets/changes the degree of the polynomial used to interpolate time for a dynamic solver.
Definition: solver_routines.f90:5484
equations_matrices_routines
This module handles all equations matrix and rhs routines.
Definition: equations_matrices_routines.f90:45
solver_routines::solver_dynamic_first_order
integer(intg), parameter, public solver_dynamic_first_order
Dynamic solver has first order terms.
Definition: solver_routines.f90:255
solver_routines::solver_type_set
subroutine, public solver_type_set(SOLVER, SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type for a solver.
Definition: solver_routines.f90:21345
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
equations_set_constants::equations_set_setup_source_type
integer(intg), parameter equations_set_setup_source_type
Source setup.
Definition: equations_set_constants.f90:327
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
solver_routines::solvers_create_start
subroutine, public solvers_create_start(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Start the creation of a solvers for the control loop.
Definition: solver_routines.f90:22651
types::solvers_type
Contains information on the solvers to be used in a control loop.
Definition: types.f90:2805
equations_mapping_routines::equations_mapping_dynamic_matrices_set
Definition: equations_mapping_routines.f90:83
constants::first_part_deriv
integer(intg), parameter first_part_deriv
First partial derivative i.e., du/ds.
Definition: constants.f90:178
solver_routines::solver_dynamic_linearity_type_set
subroutine, public solver_dynamic_linearity_type_set(SOLVER, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for the dynamic solver.
Definition: solver_routines.f90:5758
timer
This module contains routines for timing the program.
Definition: timer_f.f90:45
control_loop_routines::control_loop_current_times_get
subroutine, public control_loop_current_times_get(CONTROL_LOOP, CURRENT_TIME, TIME_INCREMENT, ERR, ERROR,)
Gets the current time parameters for a time control loop.
Definition: control_loop_routines.f90:231
equations_matrices_routines::equations_matrices_dynamic_lumping_type_set
subroutine, public equations_matrices_dynamic_lumping_type_set(EQUATIONS_MATRICES, LUMPING_TYPE, ERR, ERROR,)
Sets the lumping of the linear equations matrices.
Definition: equations_matrices_routines.f90:3760
problem_constants::solver_equations_static
integer(intg), parameter solver_equations_static
Solver equations are static.
Definition: problem_constants.f90:309
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
solver_routines::solver_equations_sparsity_type_set
subroutine, public solver_equations_sparsity_type_set(SOLVER_EQUATIONS, SPARSITY_TYPE, ERR, ERROR,)
Sets/changes the sparsity type for solver equations.
Definition: solver_routines.f90:7734
analytic_analysis_routines
This module handles all analytic analysis routines.
Definition: analytic_analysis_routines.f90:45
solver_routines::solvers_solver_get
subroutine, public solvers_solver_get(SOLVERS, SOLVER_INDEX, SOLVER, ERR, ERROR,)
Returns a pointer to the specified solver in the list of solvers.
Definition: solver_routines.f90:22876
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
types::control_loop_type
Contains information on a control loop.
Definition: types.f90:3185
burgers_equation_routines::burgers_boundaryconditionsanalyticcalculate
subroutine, public burgers_boundaryconditionsanalyticcalculate(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Calculates the analytic solution and sets the boundary conditions for an analytic problem...
Definition: Burgers_equation_routines.f90:116
equations_set_constants::equations_set_burgers_subtype
integer(intg), parameter equations_set_burgers_subtype
Definition: equations_set_constants.f90:204
burgers_equation_routines::burgers_equationssetsolutionmethodset
subroutine, public burgers_equationssetsolutionmethodset(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for a burgers equation type of an fluid mechanics equations set clas...
Definition: Burgers_equation_routines.f90:456
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
solver_routines::solver_equations_create_finish
subroutine, public solver_equations_create_finish(SOLVER_EQUATIONS, ERR, ERROR,)
Finishes the process of creating solver equations.
Definition: solver_routines.f90:7166
solver_routines::solver_sparse_matrices
integer(intg), parameter, public solver_sparse_matrices
Use sparse solver matrices.
Definition: solver_routines.f90:360
solver_routines::solver_equations_create_start
subroutine, public solver_equations_create_start(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Starts the process of creating solver equations.
Definition: solver_routines.f90:7209
solver_routines::solver_dynamic_type
integer(intg), parameter, public solver_dynamic_type
A dynamic solver.
Definition: solver_routines.f90:90
burgers_equation_routines::burgers_equation_post_solve_output_data
subroutine burgers_equation_post_solve_output_data(SOLVER, ERR, ERROR,)
Output data post solve.
Definition: Burgers_equation_routines.f90:1738
basis_routines::basis_default_quadrature_scheme
integer(intg), parameter, public basis_default_quadrature_scheme
Identifier for the default quadrature scheme.
Definition: basis_routines.f90:125
problem_constants::problem_setup_solvers_type
integer(intg), parameter problem_setup_solvers_type
Solver setup for a problem.
Definition: problem_constants.f90:264
equations_set_constants::equations_set_setup_equations_type
integer(intg), parameter equations_set_setup_equations_type
Equations setup.
Definition: equations_set_constants.f90:330
burgers_equation_routines::burgers_finiteelementresidualevaluate
subroutine, public burgers_finiteelementresidualevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the residual element stiffness matrices and RHS for a Burgers equation finite element equat...
Definition: Burgers_equation_routines.f90:2271
types::equations_mapping_dynamic_type
Contains information for mapping field variables to the dynamic matrices in the equations set of the ...
Definition: types.f90:1571
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
constants
This module contains all program wide constants.
Definition: constants.f90:45
problem_constants::solver_equations_nonlinear
integer(intg), parameter solver_equations_nonlinear
Solver equations are nonlinear.
Definition: problem_constants.f90:302
solver_routines::solver_library_type_set
subroutine, public solver_library_type_set(SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library type to use for the solver.
Definition: solver_routines.f90:9067
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_routines::equations_lumped_matrices
integer(intg), parameter, public equations_lumped_matrices
The equations matrices are "mass" lumped.
Definition: equations_routines.f90:88
problem_constants::problem_setup_initial_type
integer(intg), parameter problem_setup_initial_type
Initial setup for a problem.
Definition: problem_constants.f90:262
equations_set_constants::equations_set_generalised_burgers_subtype
integer(intg), parameter equations_set_generalised_burgers_subtype
Definition: equations_set_constants.f90:205
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
problem_constants::problem_static_burgers_subtype
integer(intg), parameter problem_static_burgers_subtype
Definition: problem_constants.f90:166
types::problem_setup_type
Definition: types.f90:3215
equations_set_constants::equations_first_order_dynamic
integer(intg), parameter equations_first_order_dynamic
The equations are first order dynamic.
Definition: equations_set_constants.f90:378
types::boundary_conditions_variable_type
Contains information on the boundary conditions for a dependent field variable.
Definition: types.f90:1759
solver_routines::solver_equations_linearity_type_set
subroutine, public solver_equations_linearity_type_set(SOLVER_EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for solver equations.
Definition: solver_routines.f90:7577
burgers_equation_routines::burgers_equation_problem_setup
subroutine, public burgers_equation_problem_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the Burgers problem.
Definition: Burgers_equation_routines.f90:1888
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
problem_constants::problem_burgers_equation_type
integer(intg), parameter problem_burgers_equation_type
Definition: problem_constants.f90:78
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
control_loop_routines::control_loop_solvers_get
recursive subroutine, public control_loop_solvers_get(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Returns a pointer to the solvers for a control loop.
Definition: control_loop_routines.f90:1333
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
equations_matrices_routines::equations_matrix_fem_structure
integer(intg), parameter, public equations_matrix_fem_structure
Finite element matrix structure.
Definition: equations_matrices_routines.f90:72
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
burgers_equation_routines::burgers_equation_pre_solve
subroutine, public burgers_equation_pre_solve(SOLVER, ERR, ERROR,)
Sets up the BURGERS problem pre-solve.
Definition: Burgers_equation_routines.f90:1362
types::equations_matrices_linear_type
Contains information of the linear matrices for equations matrices.
Definition: types.f90:1479
equations_matrices_routines::equationsmatrices_dynamicstructuretypeset
subroutine, public equationsmatrices_dynamicstructuretypeset(EQUATIONS_MATRICES, STRUCTURE_TYPE, ERR, ERROR,)
Sets the structure (sparsity) of the dynamic equations matrices.
Definition: equations_matrices_routines.f90:4090
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
control_loop_routines::control_loop_get
Returns the specified control loop as indexed by the control loop identifier from the control loop ro...
Definition: control_loop_routines.f90:86
control_loop_routines::control_loop_type_set
subroutine, public control_loop_type_set(CONTROL_LOOP, LOOP_TYPE, ERR, ERROR,)
Sets/changes the control loop type.
Definition: control_loop_routines.f90:1750
burgers_equation_routines::burgers_finiteelementjacobianevaluate
subroutine, public burgers_finiteelementjacobianevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the Jacobian element stiffness matrices for a BURGERS equation finite element equations set...
Definition: Burgers_equation_routines.f90:2124
solver_routines::solver_nonlinear_type
integer(intg), parameter, public solver_nonlinear_type
A nonlinear solver.
Definition: solver_routines.f90:89
equations_set_constants::equations_set_generalised_burgers_equation_one_dim_2
integer(intg), parameter equations_set_generalised_burgers_equation_one_dim_2
Solution to a generalised burgers equation.
Definition: equations_set_constants.f90:543
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
constants::partial_derivative_first_derivative_map
integer(intg), dimension(4) partial_derivative_first_derivative_map
PARTIAL_DERIVATIVE_FIRST_DERIVATIVE_MAP(nic) gives the partial derivative index for the first derivat...
Definition: constants.f90:254
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
problem_constants::problem_setup_finish_action
integer(intg), parameter problem_setup_finish_action
Finish setup action.
Definition: problem_constants.f90:274
equations_mapping_routines
This module handles all equations mapping routines.
Definition: equations_mapping_routines.f90:45
types::solver_equations_type
Contains information about the solver equations for a solver.
Definition: types.f90:2452
burgers_equation_routines::burgers_equation_post_solve
subroutine, public burgers_equation_post_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the Burgers problem post solve.
Definition: Burgers_equation_routines.f90:1688
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_matrices_routines::equations_matrices_dynamic_storage_type_set
subroutine, public equations_matrices_dynamic_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the dynamic equations matrices.
Definition: equations_matrices_routines.f90:3824
equations_matrices_routines::equations_matrix_diagonal_structure
integer(intg), parameter, public equations_matrix_diagonal_structure
Diagonal matrix structure.
Definition: equations_matrices_routines.f90:73
types::equations_set_analytic_type
Contains information on the analytic setup for the equations set.
Definition: types.f90:1923
burgers_equation_routines::burgers_analyticfunctionsevaluate
subroutine, public burgers_analyticfunctionsevaluate(EQUATIONS_SET, ANALYTIC_FUNCTION_TYPE, X, TANGENTS, NORMAL, TIME, VARIABLE_TYPE, GLOBAL_DERIVATIVE, COMPONENT_NUMBER, ANALYTIC_PARAMETERS, MATERIALS_PARAMETERS, VALUE, ERR, ERROR,)
Evaluate the analytic solutions for a Burgers equation.
Definition: Burgers_equation_routines.f90:277
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_set_constants::equations_set_setup_geometry_type
integer(intg), parameter equations_set_setup_geometry_type
Geometry setup.
Definition: equations_set_constants.f90:323
types::problem_type
Contains information for a problem.
Definition: types.f90:3221
analytic_analysis_routines::analyticanalysis_output
subroutine, public analyticanalysis_output(FIELD, FILENAME, ERR, ERROR,)
Output the analytic error analysis for a dependent field compared to the analytic values parameter se...
Definition: analytic_analysis_routines.f90:114
types::domain_nodes_type
Contains the topology information for the nodes of a domain.
Definition: types.f90:713
types::dynamic_solver_type
Contains information for a dynamic solver.
Definition: types.f90:2489
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
burgers_equation_routines::burgers_equationssetspecificationset
subroutine, public burgers_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for a Burgers type of a fluid mechanics equations set...
Definition: Burgers_equation_routines.f90:517
distributed_matrix_vector
This module handles all distributed matrix vector routines.
Definition: distributed_matrix_vector.f90:45
burgers_equation_routines::burgers_problemspecificationset
subroutine, public burgers_problemspecificationset(problem, problemSpecification, err, error,)
Sets the problem specification for a Burgers problem.
Definition: Burgers_equation_routines.f90:1836
constants::global_deriv_s1
integer(intg), parameter global_deriv_s1
First global derivative in the s1 direction i.e., du/ds1.
Definition: constants.f90:214
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
equations_matrices_routines::equations_matrix_unlumped
integer(intg), parameter, public equations_matrix_unlumped
The matrix is not lumped.
Definition: equations_matrices_routines.f90:82
types::equations_matrix_type
Contains information about an equations matrix.
Definition: types.f90:1429
types::quadrature_scheme_type
Contains information for a particular quadrature scheme.
Definition: types.f90:141
equations_set_constants::equations_set_burgers_equation_one_dim_1
integer(intg), parameter equations_set_burgers_equation_one_dim_1
Solution to Burgers equation.
Definition: equations_set_constants.f90:541
matrix_vector
This module contains all routines dealing with (non-distributed) matrix and vectors types...
Definition: matrix_vector.f90:129
distributed_matrix_vector::distributed_matrix_block_storage_type
integer(intg), parameter, public distributed_matrix_block_storage_type
Distributed matrix block storage type.
Definition: distributed_matrix_vector.f90:97
equations_matrices_routines::equations_matrix_lumped
integer(intg), parameter, public equations_matrix_lumped
The matrix is "mass" lumped.
Definition: equations_matrices_routines.f90:83
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
control_loop_routines::control_loop_create_start
subroutine, public control_loop_create_start(PROBLEM, CONTROL_LOOP, ERR, ERROR,)
Start the process of creating a control loop for a problem.
Definition: control_loop_routines.f90:194
problem_constants::problem_setup_solver_equations_type
integer(intg), parameter problem_setup_solver_equations_type
Solver equations setup for a problem.
Definition: problem_constants.f90:265
boundary_conditions_routines::boundary_conditions_set_local_dof
Sets a boundary condition on the specified local DOF.
Definition: boundary_condition_routines.f90:143
types::solver_mapping_type
Contains information on the solver mapping between the global equation sets and the solver matrices...
Definition: types.f90:3091
solver_routines::solver_dynamic_scheme_set
subroutine, public solver_dynamic_scheme_set(SOLVER, SCHEME, ERR, ERROR,)
Sets/changes the scheme for a dynamic solver.
Definition: solver_routines.f90:6384
types::field_variable_type
Contains information for a field variable defined on a field.
Definition: types.f90:1289
solver_routines::solver_dynamic_nonlinear
integer(intg), parameter, public solver_dynamic_nonlinear
Dynamic solver has nonlinear terms.
Definition: solver_routines.f90:264
solver_routines::solver_label_set
Definition: solver_routines.f90:405
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
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
problem_constants::problem_setup_start_action
integer(intg), parameter problem_setup_start_action
Start setup action.
Definition: problem_constants.f90:273
types::equations_matrices_nonlinear_type
Contains information of the nolinear matrices and vectors for equations matrices. ...
Definition: types.f90:1486
problem_constants::problem_dynamic_burgers_subtype
integer(intg), parameter problem_dynamic_burgers_subtype
Definition: problem_constants.f90:167
solver_routines::solver_equations_time_dependence_type_set
subroutine, public solver_equations_time_dependence_type_set(SOLVER_EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for solver equations.
Definition: solver_routines.f90:7788
control_loop_routines
This module handles all control loop routines.
Definition: control_loop_routines.f90:45
solver_routines::solver_cmiss_library
integer(intg), parameter, public solver_cmiss_library
CMISS (internal) solver library.
Definition: solver_routines.f90:103
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
boundary_conditions_routines::boundary_condition_fixed
integer(intg), parameter, public boundary_condition_fixed
The dof is fixed as a boundary condition.
Definition: boundary_condition_routines.f90:95
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
solver_routines::solver_solver_equations_get
subroutine, public solver_solver_equations_get(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Returns a pointer to the solver equations for a solver.
Definition: solver_routines.f90:21230
types::basis_type
Contains all information about a basis .
Definition: types.f90:184
boundary_conditions_routines::boundary_conditions_variable_get
subroutine, public boundary_conditions_variable_get(BOUNDARY_CONDITIONS, FIELD_VARIABLE, BOUNDARY_CONDITIONS_VARIABLE, ERR, ERROR,)
Find the boundary conditions variable for a given field variable.
Definition: boundary_condition_routines.f90:3635
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_generalised_burgers_equation_one_dim_1
integer(intg), parameter equations_set_generalised_burgers_equation_one_dim_1
Solution to a generalised burgers equation.
Definition: equations_set_constants.f90:542
burgers_equation_routines::burgers_presolveupdateanalyticvalues
subroutine burgers_presolveupdateanalyticvalues(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Definition: Burgers_equation_routines.f90:1427
equations_set_constants::equations_set_static_burgers_subtype
integer(intg), parameter equations_set_static_burgers_subtype
Definition: equations_set_constants.f90:206
equations_set_constants::equations_set_burgers_equation_type
integer(intg), parameter equations_set_burgers_equation_type
Definition: equations_set_constants.f90:76
solver_routines::solver_dynamic_first_degree
integer(intg), parameter, public solver_dynamic_first_degree
Dynamic solver uses a first degree polynomial for time interpolation.
Definition: solver_routines.f90:271
equations_set_constants::equations_set_setup_initial_type
integer(intg), parameter equations_set_setup_initial_type
Initial setup.
Definition: equations_set_constants.f90:322
control_loop_routines::control_loop_create_finish
recursive subroutine, public control_loop_create_finish(CONTROL_LOOP, ERR, ERROR,)
Finish the process of creating a control loop.
Definition: control_loop_routines.f90:153
equations_mapping_routines::equationsmapping_residualvariabletypesset
subroutine, public equationsmapping_residualvariabletypesset(EQUATIONS_MAPPING, RESIDUAL_VARIABLE_TYPES, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set residual vector...
Definition: equations_mapping_routines.f90:2939
equations_set_constants::equations_set_setup_analytic_type
integer(intg), parameter equations_set_setup_analytic_type
Analytic setup.
Definition: equations_set_constants.f90:329
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
problem_constants::problem_fluid_mechanics_class
integer(intg), parameter problem_fluid_mechanics_class
Definition: problem_constants.f90:56
types::equations_matrices_rhs_type
Contains information of the RHS vector for equations matrices.
Definition: types.f90:1500
equations_set_constants::equations_nonlinear
integer(intg), parameter equations_nonlinear
The equations are non-linear.
Definition: equations_set_constants.f90:366
distributed_matrix_vector::distributed_matrix_diagonal_storage_type
integer(intg), parameter, public distributed_matrix_diagonal_storage_type
Distributed matrix diagonal storage type.
Definition: distributed_matrix_vector.f90:98
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
equations_set_constants::equations_set_inviscid_burgers_subtype
integer(intg), parameter equations_set_inviscid_burgers_subtype
Definition: equations_set_constants.f90:207
fluid_mechanics_io_routines
Temporary IO routines for fluid mechanics.
Definition: fluid_mechanics_IO_routines.f90:47
burgers_equation_routines
This module handles all Burgers equation routines.
Definition: Burgers_equation_routines.f90:45
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
distributed_matrix_vector::distributed_matrix_compressed_row_storage_type
integer(intg), parameter, public distributed_matrix_compressed_row_storage_type
Distributed matrix compressed row storage type.
Definition: distributed_matrix_vector.f90:101
types::equations_matrices_dynamic_type
Contains information of the dynamic matrices for equations matrices.
Definition: types.f90:1471
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45