OpenCMISS-Iron Internal API Documentation
Burgers_equation_routines.f90
Go to the documentation of this file.
1 
43 
46 
48  USE base_routines
49  USE basis_routines
51  USE constants
54  USE domain_mappings
59  USE field_routines
60  USE input_output
62  USE kinds
63  USE matrix_vector
65  USE strings
66  USE solver_routines
67  USE timer
68  USE types
69 
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 
87 
89 
91 
93 
95 
97 
99 
101 
103 
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,*)
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 
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,*)
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)
314  SELECT CASE(analytic_function_type)
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
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)
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
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
435  CALL flagerror("Not implemented.",err,error,*999)
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,*)
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))
477  SELECT CASE(solution_method)
479  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
481  CALL flagerror("Not implemented.",err,error,*999)
483  CALL flagerror("Not implemented.",err,error,*999)
485  CALL flagerror("Not implemented.",err,error,*999)
487  CALL flagerror("Not implemented.",err,error,*999)
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 
510 
511  !
512  !================================================================================================================================
513  !
514 
516  SUBROUTINE burgers_equationssetspecificationset(equationsSet,specification,err,error,*)
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)
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 
565 
566  !
567  !================================================================================================================================
568  !
569 
571  SUBROUTINE burgers_equation_equations_set_setup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
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))
607  SELECT CASE(equations_set_setup%SETUP_TYPE)
609  SELECT CASE(equations_set_setup%ACTION_TYPE)
612  & err,error,*999)
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
622  !Do nothing
623  !-----------------------------------------------------------------
624  ! D e p e n d e n t f i e l d
625  !-----------------------------------------------------------------
627  SELECT CASE(equations_set_setup%ACTION_TYPE)
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)
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)
688  CALL flagerror("Not implemented.",err,error,*999)
690  CALL flagerror("Not implemented.",err,error,*999)
692  CALL flagerror("Not implemented.",err,error,*999)
694  CALL flagerror("Not implemented.",err,error,*999)
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)
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
742  CALL flagerror("Not implemented.",err,error,*999)
744  CALL flagerror("Not implemented.",err,error,*999)
746  CALL flagerror("Not implemented.",err,error,*999)
748  CALL flagerror("Not implemented.",err,error,*999)
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
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  !-----------------------------------------------------------------
771  SELECT CASE(equations_set_setup%ACTION_TYPE)
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))
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
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))
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)
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
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))
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)
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  !-----------------------------------------------------------------
906  SELECT CASE(equations_set_setup%ACTION_TYPE)
908  !Do nothing
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  !-----------------------------------------------------------------
921  SELECT CASE(equations_set_setup%ACTION_TYPE)
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))
937  SELECT CASE(equations_set_setup%ANALYTIC_FUNCTION_TYPE)
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
961  SELECT CASE(equations_set_setup%ANALYTIC_FUNCTION_TYPE)
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
990  CALL flagerror("Not implemented.",err,error,*999)
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
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))
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)
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)
1098  CALL flagerror("Not implemented.",err,error,*999)
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  !-----------------------------------------------------------------
1122  SELECT CASE (equations_set%SPECIFICATION(3))
1124  SELECT CASE(equations_set_setup%ACTION_TYPE)
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)
1130  ELSE
1131  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
1132  ENDIF
1134  SELECT CASE(equations_set%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, &
1161  ENDIF
1162  SELECT CASE(equations%SPARSITY_TYPE)
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, &
1172  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
1174  ENDIF
1176  & err,error,*999)
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, &
1186  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
1188  ENDIF
1189  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices, &
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)
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, &
1207  ENDIF
1209  & err,error,*999)
1211  IF(equations_set%SPECIFICATION(3)==equations_set_inviscid_burgers_subtype) THEN
1212  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
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, &
1220  & err,error,*999)
1221  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
1223  ENDIF
1224  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices, &
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
1236  & err,error,*999)
1237  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
1239  CALL flagerror("Not implemented.",err,error,*999)
1241  CALL flagerror("Not implemented.",err,error,*999)
1243  CALL flagerror("Not implemented.",err,error,*999)
1245  CALL flagerror("Not implemented.",err,error,*999)
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
1260  SELECT CASE(equations_set_setup%ACTION_TYPE)
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
1270  SELECT CASE(equations_set%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)
1287  & err,error,*999)
1289  & err,error,*999)
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
1306  & err,error,*999)
1307  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
1309  CALL flagerror("Not implemented.",err,error,*999)
1311  CALL flagerror("Not implemented.",err,error,*999)
1313  CALL flagerror("Not implemented.",err,error,*999)
1315  CALL flagerror("Not implemented.",err,error,*999)
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 
1355 
1356  !
1357  !================================================================================================================================
1358  !
1359 
1361  SUBROUTINE burgers_equation_pre_solve(SOLVER,ERR,ERROR,*)
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))
1388  ! do nothing ???
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,*)
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))
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 
1628 
1629 
1630  !
1631  !================================================================================================================================
1632  !
1633  SUBROUTINE burgers_presolvestorecurrentsolution(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
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))
1656  ! do nothing ???
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 
1681 
1682  !
1683  !================================================================================================================================
1684  !
1685 
1687  SUBROUTINE burgers_equation_post_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
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))
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,*)
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))
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 
1829 
1830  !
1831  !================================================================================================================================
1832  !
1833 
1835  SUBROUTINE burgers_problemspecificationset(problem,problemSpecification,err,error,*)
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)
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,*)
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))
1916  SELECT CASE(problem_setup%SETUP_TYPE)
1918  SELECT CASE(problem_setup%ACTION_TYPE)
1920  !Do nothing????
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
1930  SELECT CASE(problem_setup%ACTION_TYPE)
1932  !Set up a simple control loop
1933  CALL control_loop_create_start(problem,control_loop,err,error,*999)
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
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)
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)
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
1971  SELECT CASE(problem_setup%ACTION_TYPE)
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)
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
2006  SELECT CASE(problem_setup%SETUP_TYPE)
2008  SELECT CASE(problem_setup%ACTION_TYPE)
2010  !Do nothing????
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
2020  SELECT CASE(problem_setup%ACTION_TYPE)
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)
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
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)
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)
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)
2054  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
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
2067  SELECT CASE(problem_setup%ACTION_TYPE)
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)
2079  & err,error,*999)
2080  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
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,*)
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&
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% &
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 
2264 
2265  !
2266  !================================================================================================================================
2267  !
2268 
2270  SUBROUTINE burgers_finiteelementresidualevaluate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
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))
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
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
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
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&
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 
2547 
2548  !
2549  !================================================================================================================================
2550  !
2551 
2552 END MODULE burgers_equation_routines
integer(intg), parameter equations_set_setup_dependent_type
Dependent variables.
integer(intg), parameter equations_set_fem_solution_method
Finite Element Method solution method.
This module contains all basis function routines.
integer(intg), parameter equations_set_setup_materials_type
Materials setup.
Contains information on the boundary conditions for the solver equations.
Definition: types.f90:1780
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
subroutine, public solvers_create_finish(SOLVERS, ERR, ERROR,)
Finish the creation of solvers.
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.
integer(intg), parameter second_part_deriv
Second partial derivative i.e., d^2u/ds^2.
Definition: constants.f90:179
subroutine burgers_presolvestorecurrentsolution(CONTROL_LOOP, SOLVER, ERR, ERROR,)
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...
Contains information on the Jacobian matrix for nonlinear problems.
Definition: types.f90:1451
Contains information on the equations mapping i.e., how field variable DOFS are mapped to the rows an...
Definition: types.f90:1681
Contains information about the equations in an equations set.
Definition: types.f90:1735
integer(intg), parameter equations_set_gfem_solution_method
Grid-based Finite Element Method solution method.
integer(intg), parameter problem_control_time_loop_type
Time control loop.
integer(intg), parameter problem_setup_control_type
Solver setup for a problem.
This module handles all problem wide constants.
integer(intg), parameter solver_equations_first_order_dynamic
Solver equations are first order dynamic.
integer(intg), parameter, public control_loop_node
The identifier for a each "leaf" node in a control loop.
subroutine, public solver_dynamic_order_set(SOLVER, ORDER, ERR, ERROR,)
Sets/changes the order for a dynamic solver.
integer(intg), parameter no_global_deriv
No global derivative i.e., u.
Definition: constants.f90:213
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
subroutine, public equations_create_start(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Start the creation of equations for the equation set.
Contains information on the mesh decomposition.
Definition: types.f90:1063
subroutine, public equations_matrices_create_start(EQUATIONS, EQUATIONS_MATRICES, ERR, ERROR,)
Starts the creation of the equations matrices and rhs for the the equations.
Contains information on the type of solver to be used.
Definition: types.f90:2777
integer(intg), parameter, public solver_petsc_library
PETSc solver library.
subroutine, public solvers_number_set(SOLVERS, NUMBER_OF_SOLVERS, ERR, ERROR,)
Sets/changes the number of solvers.
integer(intg), parameter no_part_deriv
No partial derivative i.e., u.
Definition: constants.f90:177
integer(intg), parameter, public solver_dynamic_crank_nicolson_scheme
Crank-Nicolson dynamic solver.
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.
This module handles all equations matrix and rhs routines.
integer(intg), parameter, public solver_dynamic_first_order
Dynamic solver has first order terms.
subroutine, public solver_type_set(SOLVER, SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type for a solver.
integer(intg), parameter equations_static
The equations are static and have no time dependence.
Contains information on an equations set.
Definition: types.f90:1941
This module handles all equations routines.
integer(intg), parameter equations_set_setup_source_type
Source setup.
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
subroutine, public solvers_create_start(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Start the creation of a solvers for the control loop.
Contains information on the solvers to be used in a control loop.
Definition: types.f90:2805
integer(intg), parameter first_part_deriv
First partial derivative i.e., du/ds.
Definition: constants.f90:178
subroutine, public solver_dynamic_linearity_type_set(SOLVER, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for the dynamic solver.
This module contains routines for timing the program.
Definition: timer_f.f90:45
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.
subroutine, public equations_matrices_dynamic_lumping_type_set(EQUATIONS_MATRICES, LUMPING_TYPE, ERR, ERROR,)
Sets the lumping of the linear equations matrices.
integer(intg), parameter solver_equations_static
Solver equations are static.
subroutine, public equations_time_dependence_type_set(EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for equations.
subroutine, public solver_equations_sparsity_type_set(SOLVER_EQUATIONS, SPARSITY_TYPE, ERR, ERROR,)
Sets/changes the sparsity type for solver equations.
This module handles all analytic analysis routines.
subroutine, public solvers_solver_get(SOLVERS, SOLVER_INDEX, SOLVER, ERR, ERROR,)
Returns a pointer to the specified solver in the list of solvers.
Contains information for a field defined on a region.
Definition: types.f90:1346
integer(intg), parameter, public equations_matrices_full_matrices
Use fully populated equation matrices.
integer(intg), parameter equations_set_fluid_mechanics_class
subroutine, public equations_mapping_rhs_variable_type_set(EQUATIONS_MAPPING, RHS_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set rhs vector.
Contains information on a control loop.
Definition: types.f90:3185
subroutine, public burgers_boundaryconditionsanalyticcalculate(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Calculates the analytic solution and sets the boundary conditions for an analytic problem...
integer(intg), parameter equations_set_burgers_subtype
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...
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
subroutine, public solver_equations_create_finish(SOLVER_EQUATIONS, ERR, ERROR,)
Finishes the process of creating solver equations.
integer(intg), parameter, public solver_sparse_matrices
Use sparse solver matrices.
subroutine, public solver_equations_create_start(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Starts the process of creating solver equations.
integer(intg), parameter, public solver_dynamic_type
A dynamic solver.
subroutine burgers_equation_post_solve_output_data(SOLVER, ERR, ERROR,)
Output data post solve.
integer(intg), parameter, public basis_default_quadrature_scheme
Identifier for the default quadrature scheme.
integer(intg), parameter problem_setup_solvers_type
Solver setup for a problem.
integer(intg), parameter equations_set_setup_equations_type
Equations setup.
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...
Contains information for mapping field variables to the dynamic matrices in the equations set of the ...
Definition: types.f90:1571
This module contains all program wide constants.
Definition: constants.f90:45
integer(intg), parameter solver_equations_nonlinear
Solver equations are nonlinear.
subroutine, public solver_library_type_set(SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library type to use for the solver.
subroutine, public equationsmapping_linearmatricesnumberset(EQUATIONS_MAPPING, NUMBER_OF_LINEAR_EQUATIONS_MATRICES, ERR, ERROR,)
Sets/changes the number of linear equations matrices.
integer(intg), parameter, public equations_lumped_matrices
The equations matrices are "mass" lumped.
integer(intg), parameter problem_setup_initial_type
Initial setup for a problem.
integer(intg), parameter equations_set_generalised_burgers_subtype
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...
integer(intg), parameter problem_static_burgers_subtype
integer(intg), parameter equations_first_order_dynamic
The equations are first order dynamic.
Contains information on the boundary conditions for a dependent field variable.
Definition: types.f90:1759
subroutine, public solver_equations_linearity_type_set(SOLVER_EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for solver equations.
subroutine, public burgers_equation_problem_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the Burgers problem.
integer(intg), parameter equations_set_setup_start_action
Start setup action.
integer(intg), parameter problem_burgers_equation_type
Sets the storage type (sparsity) of the nonlinear (Jacobian) equations matrices.
subroutine, public exits(NAME)
Records the exit out of the named procedure.
recursive subroutine, public control_loop_solvers_get(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Returns a pointer to the solvers for a control loop.
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
Contains information on the equations mapping for nonlinear matrices i.e., how a field variable is ma...
Definition: types.f90:1623
Contains information on the equations matrices and vectors.
Definition: types.f90:1520
integer(intg), parameter, public equations_matrix_fem_structure
Finite element matrix structure.
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
subroutine, public burgers_equation_pre_solve(SOLVER, ERR, ERROR,)
Sets up the BURGERS problem pre-solve.
Contains information of the linear matrices for equations matrices.
Definition: types.f90:1479
subroutine, public equationsmatrices_dynamicstructuretypeset(EQUATIONS_MATRICES, STRUCTURE_TYPE, ERR, ERROR,)
Sets the structure (sparsity) of the dynamic equations matrices.
subroutine, public equations_matrices_linear_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the linear equations matrices.
subroutine, public equationsmatrices_linearstructuretypeset(EQUATIONS_MATRICES, STRUCTURE_TYPE, ERR, ERROR,)
Sets the structure (sparsity) of the linear equations matrices.
subroutine, public equations_mapping_create_finish(EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping.
Returns the specified control loop as indexed by the control loop identifier from the control loop ro...
subroutine, public control_loop_type_set(CONTROL_LOOP, LOOP_TYPE, ERR, ERROR,)
Sets/changes the control loop type.
subroutine, public burgers_finiteelementjacobianevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the Jacobian element stiffness matrices for a BURGERS equation finite element equations set...
integer(intg), parameter, public solver_nonlinear_type
A nonlinear solver.
integer(intg), parameter equations_set_generalised_burgers_equation_one_dim_2
Solution to a generalised burgers equation.
integer(intg), parameter, public equations_jacobian_analytic_calculated
Use an analytic Jacobian evaluation.
subroutine, public equations_set_equations_get(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Gets the equations for an equations set.
Sets the structure (sparsity) of the nonlinear (Jacobian) equations matrices.
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
subroutine, public equations_create_finish(EQUATIONS, ERR, ERROR,)
Finish the creation of equations.
This module handles all domain mappings routines.
integer(intg), parameter problem_setup_finish_action
Finish setup action.
This module handles all equations mapping routines.
Contains information about the solver equations for a solver.
Definition: types.f90:2452
subroutine, public burgers_equation_post_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the Burgers problem post solve.
integer(intg), parameter, public matrix_compressed_row_storage_type
Matrix compressed row storage type.
subroutine, public equations_matrices_dynamic_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the dynamic equations matrices.
integer(intg), parameter, public equations_matrix_diagonal_structure
Diagonal matrix structure.
Contains information on the analytic setup for the equations set.
Definition: types.f90:1923
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.
integer(intg), parameter equations_set_gfv_solution_method
Grid-based Finite Volume solution method.
integer(intg), parameter equations_set_setup_geometry_type
Geometry setup.
Contains information for a problem.
Definition: types.f90:3221
subroutine, public analyticanalysis_output(FIELD, FILENAME, ERR, ERROR,)
Output the analytic error analysis for a dependent field compared to the analytic values parameter se...
Contains the topology information for the nodes of a domain.
Definition: types.f90:713
Contains information for a dynamic solver.
Definition: types.f90:2489
subroutine, public equations_matrices_create_finish(EQUATIONS_MATRICES, ERR, ERROR,)
Finishes the creation of the equations matrices and RHS for the the equations.
subroutine, public burgers_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for a Burgers type of a fluid mechanics equations set...
This module handles all distributed matrix vector routines.
subroutine, public burgers_problemspecificationset(problem, problemSpecification, err, error,)
Sets the problem specification for a Burgers problem.
integer(intg), parameter global_deriv_s1
First global derivative in the s1 direction i.e., du/ds1.
Definition: constants.f90:214
This module handles all boundary conditions routines.
This module handles all solver routines.
subroutine, public equations_mapping_create_start(EQUATIONS, EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping for a equations set equations.
integer(intg), parameter, public equations_matrix_unlumped
The matrix is not lumped.
Contains information about an equations matrix.
Definition: types.f90:1429
Contains information for a particular quadrature scheme.
Definition: types.f90:141
integer(intg), parameter equations_set_burgers_equation_one_dim_1
Solution to Burgers equation.
This module contains all routines dealing with (non-distributed) matrix and vectors types...
integer(intg), parameter, public distributed_matrix_block_storage_type
Distributed matrix block storage type.
integer(intg), parameter, public equations_matrix_lumped
The matrix is "mass" lumped.
subroutine, public equations_linearity_type_set(EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for equations.
subroutine, public control_loop_create_start(PROBLEM, CONTROL_LOOP, ERR, ERROR,)
Start the process of creating a control loop for a problem.
integer(intg), parameter problem_setup_solver_equations_type
Solver equations setup for a problem.
Sets a boundary condition on the specified local DOF.
Contains information on the solver mapping between the global equation sets and the solver matrices...
Definition: types.f90:3091
subroutine, public solver_dynamic_scheme_set(SOLVER, SCHEME, ERR, ERROR,)
Sets/changes the scheme for a dynamic solver.
Contains information for a field variable defined on a field.
Definition: types.f90:1289
integer(intg), parameter, public solver_dynamic_nonlinear
Dynamic solver has nonlinear terms.
integer(intg), parameter equations_set_fd_solution_method
Finite Difference solution method.
integer(intg), parameter, public equations_matrices_sparse_matrices
Use sparse equations matrices.
Contains information on the setup information for an equations set.
Definition: types.f90:1866
A pointer to the domain decomposition for this domain.
Definition: types.f90:938
integer(intg), parameter problem_setup_start_action
Start setup action.
Contains information of the nolinear matrices and vectors for equations matrices. ...
Definition: types.f90:1486
integer(intg), parameter problem_dynamic_burgers_subtype
subroutine, public solver_equations_time_dependence_type_set(SOLVER_EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for solver equations.
This module handles all control loop routines.
integer(intg), parameter, public solver_cmiss_library
CMISS (internal) solver library.
subroutine, public equationsmatrices_jacobiantypesset(equationsMatrices, jacobianTypes, err, error,)
Sets the Jacobian calculation types of the residual variables.
integer(intg), parameter, public boundary_condition_fixed
The dof is fixed as a boundary condition.
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
This module defines all constants shared across equations set routines.
integer(intg), parameter equations_set_bem_solution_method
Boundary Element Method solution method.
subroutine, public solver_solver_equations_get(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Returns a pointer to the solver equations for a solver.
Contains all information about a basis .
Definition: types.f90:184
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.
integer(intg), parameter equations_set_fv_solution_method
Finite Volume solution method.
integer(intg), parameter, public matrix_block_storage_type
Matrix block storage type.
integer(intg), parameter equations_set_generalised_burgers_equation_one_dim_1
Solution to a generalised burgers equation.
subroutine burgers_presolveupdateanalyticvalues(CONTROL_LOOP, SOLVER, ERR, ERROR,)
integer(intg), parameter equations_set_static_burgers_subtype
integer(intg), parameter equations_set_burgers_equation_type
integer(intg), parameter, public solver_dynamic_first_degree
Dynamic solver uses a first degree polynomial for time interpolation.
integer(intg), parameter equations_set_setup_initial_type
Initial setup.
recursive subroutine, public control_loop_create_finish(CONTROL_LOOP, ERR, ERROR,)
Finish the process of creating a control loop.
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...
integer(intg), parameter equations_set_setup_analytic_type
Analytic setup.
Flags an error condition.
integer(intg), parameter problem_fluid_mechanics_class
Contains information of the RHS vector for equations matrices.
Definition: types.f90:1500
integer(intg), parameter equations_nonlinear
The equations are non-linear.
integer(intg), parameter, public distributed_matrix_diagonal_storage_type
Distributed matrix diagonal storage type.
Contains information for mapping field variables to the linear matrices in the equations set of the m...
Definition: types.f90:1587
This module contains all kind definitions.
Definition: kinds.f90:45
integer(intg), parameter equations_set_inviscid_burgers_subtype
Temporary IO routines for fluid mechanics.
This module handles all Burgers equation routines.
integer(intg), parameter equations_set_setup_finish_action
Finish setup action.
integer(intg), parameter, public distributed_matrix_compressed_row_storage_type
Distributed matrix compressed row storage type.
Contains information of the dynamic matrices for equations matrices.
Definition: types.f90:1471
This module handles all formating and input and output.