OpenCMISS-Iron Internal API Documentation
advection_diffusion_equation_routines.f90
Go to the documentation of this file.
1 
43 
45 MODULE advection_diffusion_equation_routines
46 
47  USE analytic_analysis_routines
48  USE base_routines
49  USE basis_routines
50  USE boundary_conditions_routines
51  USE constants
52  USE control_loop_routines
53  USE distributed_matrix_vector
54  USE domain_mappings
55  USE equations_routines
56  USE equations_mapping_routines
57  USE equations_matrices_routines
58  USE equations_set_constants
59  USE field_routines
60  USE input_output
61  USE iso_varying_string
62  USE kinds
63  USE matrix_vector
64  USE problem_constants
65  USE strings
66  USE solver_routines
67  USE timer
68  USE types
69 ! temporary input for setting velocity field
70  USE fluid_mechanics_io_routines
71 
72 #include "macros.h"
73 
74  IMPLICIT NONE
75 
76  PRIVATE advection_diffusion_post_solve_output_data
77 
78  !Module parameters
79 
80  !Module types
81 
82  !Module variables
83 
84  !Interfaces
85 
86  PUBLIC advectiondiffusion_equationssetsetup
87 
88  PUBLIC advectiondiffusion_equationssetsolnmethodset
89 
90  PUBLIC advectiondiffusion_boundaryconditionsanalyticcalculate
91 
92  PUBLIC advectiondiffusion_equationssetspecificationset
93 
94  PUBLIC advectiondiffusion_finiteelementcalculate
95 
96  PUBLIC advectiondiffusion_problemspecificationset
97 
98  PUBLIC advection_diffusion_equation_problem_setup
99 
100  PUBLIC advectiondiffusion_presolveupdateinputdata,advectiondiffusion_presolvegetsourcevalue, &
101  & advectiondiffusion_presolvestorecurrentsoln
102 
103  PUBLIC advection_diffusion_pre_solve,advection_diffusion_post_solve
104 
105 CONTAINS
106 
107  !
108  !================================================================================================================================
109  !
110 
111 
115  SUBROUTINE advectiondiffusion_boundaryconditionsanalyticcalculate(EQUATIONS_SET,BOUNDARY_CONDITIONS,ERR,ERROR,*)
116 
117  !Argument variables
118  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
119  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
120  INTEGER(INTG), INTENT(OUT) :: ERR
121  TYPE(varying_string), INTENT(OUT) :: ERROR
122  !Local Variables
123  INTEGER(INTG) :: component_idx,deriv_idx,dim_idx,local_ny,node_idx,NUMBER_OF_DIMENSIONS,variable_idx,variable_type
124  REAL(DP) :: VALUE,X(3),VALUE_SOURCE,VALUE_INDEPENDENT,VALUE_MATERIAL
125  REAL(DP), POINTER :: GEOMETRIC_PARAMETERS(:)
126  TYPE(domain_type), POINTER :: DOMAIN
127  TYPE(domain_nodes_type), POINTER :: DOMAIN_NODES
128  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD,INDEPENDENT_FIELD,SOURCE_FIELD,MATERIALS_FIELD
129  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE,GEOMETRIC_VARIABLE
130  TYPE(varying_string) :: LOCAL_ERROR
131  REAL(DP) :: alpha, phi, Peclet,tanphi
132 
133  enters("AdvectionDiffusion_BoundaryConditionsAnalyticCalculate",err,error,*999)
134 
135  NULLIFY(geometric_variable)
136  NULLIFY(geometric_parameters)
137 
138  alpha = 1.0_dp
139  phi = 0.2_dp
140  tanphi = tan(phi)
141  peclet= 10.0_dp
142 
144  IF(ASSOCIATED(equations_set)) THEN
145  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
146  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
147  IF(ASSOCIATED(dependent_field)) THEN
148  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
149  IF(ASSOCIATED(geometric_field)) THEN
150  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
151  CALL field_variable_get(geometric_field,field_u_variable_type,geometric_variable,err,error,*999)
152  CALL field_parameter_set_data_get(geometric_field,field_u_variable_type,field_values_set_type,geometric_parameters, &
153  & err,error,*999)
154  IF(ASSOCIATED(boundary_conditions)) THEN
155  DO variable_idx=1,dependent_field%NUMBER_OF_VARIABLES
156  variable_type=dependent_field%VARIABLES(variable_idx)%VARIABLE_TYPE
157  field_variable=>dependent_field%VARIABLE_TYPE_MAP(variable_type)%PTR
158  IF(ASSOCIATED(field_variable)) THEN
159  CALL field_parameter_set_create(dependent_field,variable_type,field_analytic_values_set_type,err,error,*999)
160  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
161  IF(field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE==field_node_based_interpolation) THEN
162  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
163  IF(ASSOCIATED(domain)) THEN
164  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
165  domain_nodes=>domain%TOPOLOGY%NODES
166  IF(ASSOCIATED(domain_nodes)) THEN
167  !Loop over the local nodes excluding the ghosts.
168  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
169  !!TODO \todo We should interpolate the geometric field here and the node position.
170  DO dim_idx=1,number_of_dimensions
171  !Default to version 1 of each node derivative
172  local_ny=geometric_variable%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
173  & nodes(node_idx)%DERIVATIVES(1)%VERSIONS(1)
174  x(dim_idx)=geometric_parameters(local_ny)
175  ENDDO !dim_idx
176  !Loop over the derivatives
177  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
178  SELECT CASE(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE)
179  CASE(equations_set_advection_diffusion_equation_two_dim_1)
180  !This is a steady-state solution of advection-diffusion equation
181  !Velocity field takes form v(x,y)=(sin(6y),cos(6x))
182  !Solution is u(x,y)=tanh(1 - alpha.(x.tan(Phi) - y))
183  SELECT CASE(variable_type)
184  CASE(field_u_variable_type)
185  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
186  CASE(no_global_deriv)
187  VALUE=tanh(1.0-alpha*(x(1)*tanphi-x(2)))
188  CASE(global_deriv_s1)
189  CALL flagerror("Not implemented.",err,error,*999)
190  CASE(global_deriv_s2)
191  CALL flagerror("Not implemented.",err,error,*999)
192  CASE(global_deriv_s1_s2)
193  CALL flagerror("Not implmented.",err,error,*999)
194  CASE DEFAULT
195  local_error="The global derivative index of "//trim(number_to_vstring( &
196  domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
197  & err,error))//" is invalid."
198  CALL flagerror(local_error,err,error,*999)
199  END SELECT
200  CASE(field_deludeln_variable_type)
201  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
202  CASE(no_global_deriv)
203  VALUE=0.0_dp
204  CASE(global_deriv_s1)
205  CALL flagerror("Not implemented.",err,error,*999)
206  CASE(global_deriv_s2)
207  CALL flagerror("Not implemented.",err,error,*999)
208  CASE(global_deriv_s1_s2)
209  CALL flagerror("Not implemented.",err,error,*999)
210  CASE DEFAULT
211  local_error="The global derivative index of "//trim(number_to_vstring( &
212  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
213  & err,error))//" is invalid."
214  CALL flagerror(local_error,err,error,*999)
215  END SELECT
216  CASE DEFAULT
217  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
218  & " is invalid."
219  CALL flagerror(local_error,err,error,*999)
220  END SELECT
221  CASE DEFAULT
222  local_error="The analytic function type of "// &
223  & trim(number_to_vstring(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
224  & " is invalid."
225  CALL flagerror(local_error,err,error,*999)
226  END SELECT
227  !Default to version 1 of each node derivative
228  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
229  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
230  CALL field_parameter_set_update_local_dof(dependent_field,variable_type, &
231  & field_analytic_values_set_type,local_ny,VALUE,err,error,*999)
232  IF(variable_type==field_u_variable_type) THEN
233  IF(domain_nodes%NODES(node_idx)%BOUNDARY_NODE) THEN
234  !If we are a boundary node then set the analytic value on the boundary
235  CALL boundary_conditions_set_local_dof(boundary_conditions,dependent_field,variable_type, &
236  & local_ny,boundary_condition_fixed,VALUE,err,error,*999)
237  ENDIF
238  ENDIF
239  ENDDO !deriv_idx
240  ENDDO !node_idx
241  ELSE
242  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
243  ENDIF
244  ELSE
245  CALL flagerror("Domain topology is not associated.",err,error,*999)
246  ENDIF
247  ELSE
248  CALL flagerror("Domain is not associated.",err,error,*999)
249  ENDIF
250  ELSE
251  CALL flagerror("Only node based interpolation is implemented.",err,error,*999)
252  ENDIF
253  ENDDO !component_idx
254  CALL field_parameter_set_update_start(dependent_field,variable_type,field_analytic_values_set_type, &
255  & err,error,*999)
256  CALL field_parameter_set_update_finish(dependent_field,variable_type,field_analytic_values_set_type, &
257  & err,error,*999)
258  ELSE
259  CALL flagerror("Field variable is not associated.",err,error,*999)
260  ENDIF
261 
262  ENDDO !variable_idx
263  CALL field_parameter_set_data_restore(geometric_field,field_u_variable_type,field_values_set_type, &
264  & geometric_parameters,err,error,*999)
265  ELSE
266  CALL flagerror("Boundary conditions is not associated.",err,error,*999)
267  ENDIF
268  ELSE
269  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
270  ENDIF
271  ELSE
272  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
273  ENDIF
274  ELSE
275  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
276  ENDIF
277  ELSE
278  CALL flagerror("Equations set is not associated.",err,error,*999)
279  ENDIF
280 
282  IF(ASSOCIATED(equations_set)) THEN
283  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
284  independent_field=>equations_set%INDEPENDENT%INDEPENDENT_FIELD
285  IF(ASSOCIATED(independent_field)) THEN
286  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
287  IF(ASSOCIATED(geometric_field)) THEN
288  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
289  NULLIFY(geometric_variable)
290  CALL field_variable_get(geometric_field,field_u_variable_type,geometric_variable,err,error,*999)
291  CALL field_parameter_set_data_get(geometric_field,field_u_variable_type,field_values_set_type,geometric_parameters, &
292  & err,error,*999)
293  DO variable_idx=1,independent_field%NUMBER_OF_VARIABLES
294  variable_type=independent_field%VARIABLES(variable_idx)%VARIABLE_TYPE
295  field_variable=>independent_field%VARIABLE_TYPE_MAP(variable_type)%PTR
296  IF(ASSOCIATED(field_variable)) THEN
297  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
298  IF(field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE==field_node_based_interpolation) THEN
299  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
300  IF(ASSOCIATED(domain)) THEN
301  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
302  domain_nodes=>domain%TOPOLOGY%NODES
303  IF(ASSOCIATED(domain_nodes)) THEN
304  !Loop over the local nodes excluding the ghosts.
305  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
306  !!TODO \todo We should interpolate the geometric field here and the node position.
307  DO dim_idx=1,number_of_dimensions
308  !Default to version 1 of each node derivative
309  local_ny=geometric_variable%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
310  & nodes(node_idx)%DERIVATIVES(1)%VERSIONS(1)
311  x(dim_idx)=geometric_parameters(local_ny)
312  ENDDO !dim_idx
313  !Loop over the derivatives
314  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
315  SELECT CASE(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE)
316  CASE(equations_set_advection_diffusion_equation_two_dim_1)
317  !Velocity field takes form v(x,y)=(sin(6y),cos(6x))
318  IF(component_idx==1) THEN
319  value_independent=sin(6*x(1))
320  ELSE
321  value_independent=cos(6*x(2))
322  ENDIF
323  CASE DEFAULT
324  local_error="The analytic function type of "// &
325  & trim(number_to_vstring(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
326  & " is invalid."
327  CALL flagerror(local_error,err,error,*999)
328  END SELECT
329  !Default to version 1 of each node derivative
330  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
331  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
332  CALL field_parameter_set_update_local_dof(independent_field,field_u_variable_type, &
333  & field_values_set_type,local_ny,value_independent,err,error,*999)
334  ENDDO !deriv_idx
335  ENDDO !node_idx
336  ELSE
337  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
338  ENDIF
339  ELSE
340  CALL flagerror("Domain topology is not associated.",err,error,*999)
341  ENDIF
342  ELSE
343  CALL flagerror("Domain is not associated.",err,error,*999)
344  ENDIF
345  ELSE
346  CALL flagerror("Only node based interpolation is implemented.",err,error,*999)
347  ENDIF
348  ENDDO !component_idx
349  CALL field_parameter_set_update_start(independent_field,field_u_variable_type,field_values_set_type, &
350  & err,error,*999)
351  CALL field_parameter_set_update_finish(independent_field,field_u_variable_type,field_values_set_type, &
352  & err,error,*999)
353  ELSE
354  CALL flagerror("Field variable is not associated.",err,error,*999)
355  ENDIF
356 
357  ENDDO !variable_idx
358  CALL field_parameter_set_data_restore(geometric_field,field_u_variable_type,field_values_set_type, &
359  & geometric_parameters,err,error,*999)
360  ELSE
361  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
362  ENDIF
363  ELSE
364  CALL flagerror("Equations set independent field is not associated.",err,error,*999)
365  ENDIF
366  ELSE
367  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
368  ENDIF
369  ELSE
370  CALL flagerror("Equations set is not associated.",err,error,*999)
371  ENDIF
372 
374  IF(ASSOCIATED(equations_set)) THEN
375  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
376  source_field=>equations_set%SOURCE%SOURCE_FIELD
377  IF(ASSOCIATED(source_field)) THEN
378  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
379  IF(ASSOCIATED(geometric_field)) THEN
380  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
381  NULLIFY(geometric_variable)
382  CALL field_variable_get(geometric_field,field_u_variable_type,geometric_variable,err,error,*999)
383  CALL field_parameter_set_data_get(geometric_field,field_u_variable_type,field_values_set_type,geometric_parameters, &
384  & err,error,*999)
385  DO variable_idx=1,source_field%NUMBER_OF_VARIABLES
386  variable_type=source_field%VARIABLES(variable_idx)%VARIABLE_TYPE
387  field_variable=>source_field%VARIABLE_TYPE_MAP(variable_type)%PTR
388  IF(ASSOCIATED(field_variable)) THEN
389  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
390  IF(field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE==field_node_based_interpolation) THEN
391  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
392  IF(ASSOCIATED(domain)) THEN
393  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
394  domain_nodes=>domain%TOPOLOGY%NODES
395  IF(ASSOCIATED(domain_nodes)) THEN
396  !Loop over the local nodes excluding the ghosts.
397  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
398  !!TODO \todo We should interpolate the geometric field here and the node position.
399  DO dim_idx=1,number_of_dimensions
400  !Default to version 1 of each node derivative
401  local_ny=geometric_variable%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
402  & nodes(node_idx)%DERIVATIVES(1)%VERSIONS(1)
403  x(dim_idx)=geometric_parameters(local_ny)
404  ENDDO !dim_idx
405  !Loop over the derivatives
406  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
407  SELECT CASE(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE)
408  CASE(equations_set_advection_diffusion_equation_two_dim_1)
409  value_source= (1.0/peclet)*(2.0*tanh(-0.1e1+alpha*(tanphi*x(1)-x(2)))*(1.0-(tanh(-0.1e1+alpha*( &
410  & tanphi*x(1)-x(2)))**2))*alpha*alpha*tanphi*tanphi+2.0*tanh(-0.1e1+alpha*(tanphi*x(1)-x(2)) &
411  & )*(1.0-(tanh(-0.1e1+alpha*(tanphi*x(1)-x(2)))**2))*alpha*alpha-peclet*(-sin(6.0*x(2) &
412  & )*(1.0-(tanh(-0.1e1+alpha*(tanphi*x(1)-x(2)))**2))*alpha*tanphi+cos(6.0*x(1))*(1.0- &
413  & (tanh(-0.1e1+alpha*(tanphi*x(1)-x(2)))**2))*alpha))
414  CASE DEFAULT
415  local_error="The analytic function type of "// &
416  & trim(number_to_vstring(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
417  & " is invalid."
418  CALL flagerror(local_error,err,error,*999)
419  END SELECT
420  !Default to version 1 of each node derivative
421  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
422  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
423  CALL field_parameter_set_update_local_dof(source_field,field_u_variable_type, &
424  & field_values_set_type,local_ny,value_source,err,error,*999)
425  ENDDO !deriv_idx
426  ENDDO !node_idx
427  ELSE
428  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
429  ENDIF
430  ELSE
431  CALL flagerror("Domain topology is not associated.",err,error,*999)
432  ENDIF
433  ELSE
434  CALL flagerror("Domain is not associated.",err,error,*999)
435  ENDIF
436  ELSE
437  CALL flagerror("Only node based interpolation is implemented.",err,error,*999)
438  ENDIF
439  ENDDO !component_idx
440  CALL field_parameter_set_update_start(source_field,field_u_variable_type,field_values_set_type, &
441  & err,error,*999)
442  CALL field_parameter_set_update_finish(source_field,field_u_variable_type,field_values_set_type, &
443  & err,error,*999)
444  ELSE
445  CALL flagerror("Field variable is not associated.",err,error,*999)
446  ENDIF
447  ENDDO !variable_idx
448  CALL field_parameter_set_data_restore(geometric_field,field_u_variable_type,field_values_set_type, &
449  & geometric_parameters,err,error,*999)
450  ELSE
451  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
452  ENDIF
453  ELSE
454  CALL flagerror("Equations set source field is not associated.",err,error,*999)
455  ENDIF
456  ELSE
457  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
458  ENDIF
459  ELSE
460  CALL flagerror("Equations set is not associated.",err,error,*999)
461  ENDIF
462 
464  IF(ASSOCIATED(equations_set)) THEN
465  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
466  materials_field=>equations_set%MATERIALS%MATERIALS_FIELD
467  IF(ASSOCIATED(materials_field)) THEN
468  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
469  IF(ASSOCIATED(geometric_field)) THEN
470  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
471  NULLIFY(geometric_variable)
472  CALL field_variable_get(geometric_field,field_u_variable_type,geometric_variable,err,error,*999)
473  CALL field_parameter_set_data_get(geometric_field,field_u_variable_type,field_values_set_type,geometric_parameters, &
474  & err,error,*999)
475  DO variable_idx=1,materials_field%NUMBER_OF_VARIABLES
476  variable_type=materials_field%VARIABLES(variable_idx)%VARIABLE_TYPE
477  field_variable=>materials_field%VARIABLE_TYPE_MAP(variable_type)%PTR
478  IF(ASSOCIATED(field_variable)) THEN
479  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
480  SELECT CASE(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE)
481  CASE(equations_set_advection_diffusion_equation_two_dim_1)
482  value_material= (1.0/peclet)
483  CASE DEFAULT
484  local_error="The analytic function type of "// &
485  & trim(number_to_vstring(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
486  & " is invalid."
487  CALL flagerror(local_error,err,error,*999)
488  END SELECT
489  CALL field_parameter_set_update_constant(materials_field,field_u_variable_type, &
490  & field_values_set_type,component_idx,value_material,err,error,*999)
491  ENDDO !component_idx
492  CALL field_parameter_set_update_start(materials_field,field_u_variable_type,field_values_set_type, &
493  & err,error,*999)
494  CALL field_parameter_set_update_finish(materials_field,field_u_variable_type,field_values_set_type, &
495  & err,error,*999)
496  ELSE
497  CALL flagerror("Field variable is not associated.",err,error,*999)
498  ENDIF
499  ENDDO !variable_idx
500  CALL field_parameter_set_data_restore(geometric_field,field_u_variable_type,field_values_set_type, &
501  & geometric_parameters,err,error,*999)
502  ELSE
503  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
504  ENDIF
505  ELSE
506  CALL flagerror("Equations set material field is not associated.",err,error,*999)
507  ENDIF
508  ELSE
509  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
510  ENDIF
511  ELSE
512  CALL flagerror("Equations set is not associated.",err,error,*999)
513  ENDIF
514 
515 
516  exits("AdvectionDiffusion_BoundaryConditionsAnalyticCalculate")
517  RETURN
518 999 errors("AdvectionDiffusion_BoundaryConditionsAnalyticCalculate",err,error)
519  exits("AdvectionDiffusion_BoundaryConditionsAnalyticCalculate")
520  RETURN 1
521 
522  END SUBROUTINE advectiondiffusion_boundaryconditionsanalyticcalculate
523 
524 
525  !
526  !================================================================================================================================
527  !
528 
530  SUBROUTINE advectiondiffusion_equationssetsetup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
531 
532  !Argument variables
533  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
534  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
535  INTEGER(INTG), INTENT(OUT) :: ERR
536  TYPE(varying_string), INTENT(OUT) :: ERROR
537  !Local Variables
538  TYPE(varying_string) :: LOCAL_ERROR
539 
540  enters("AdvectionDiffusion_EquationsSetSetup",err,error,*999)
541 
542  IF(ASSOCIATED(equations_set)) THEN
543  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
544  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
545  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<3) THEN
546  CALL flagerror("Equations set specification does not have a subtype set.",err,error,*999)
547  END IF
548  SELECT CASE(equations_set%SPECIFICATION(3))
549  CASE(equations_set_no_source_advection_diffusion_subtype)
550  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
551  CASE(equations_set_constant_source_advection_diffusion_subtype)
552  !Need to define the functions diffusion_equation_equations_set_linear_source_setup etc
553  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
554  CASE(equations_set_linear_source_advection_diffusion_subtype)
555  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
556  CASE(equations_set_quadratic_source_advection_diffusion_subtype)
557  CALL flagerror("Not implemented.",err,error,*999)
558 ! CALL ADVECTION_DIFFUSION_EQUATION_EQUATIONS_SET_NONLINEAR_SETUP(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*999)
559  CASE(equations_set_exponential_source_advection_diffusion_subtype)
560  CALL flagerror("Not implemented.",err,error,*999)
561 ! CALL ADVECTION_DIFFUSION_EQUATION_EQUATIONS_SET_NONLINEAR_SETUP(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*999)
562  CASE(equations_set_no_source_ale_advection_diffusion_subtype)
563  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
564  CASE(equations_set_constant_source_ale_advection_diffusion_subtype)
565  !Need to define the functions diffusion_equation_equations_set_linear_source_setup etc
566  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
567  CASE(equations_set_linear_source_ale_advection_diffusion_subtype)
568  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
569  CASE(equations_set_quadratic_source_ale_advection_diffusion_subtype)
570  CALL flagerror("Not implemented.",err,error,*999)
571 ! CALL ADVECTION_DIFFUSION_EQUATION_EQUATIONS_SET_NONLINEAR_SETUP(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*999)
572  CASE(equations_set_exp_source_ale_advection_diffusion_subtype)
573  CALL flagerror("Not implemented.",err,error,*999)
574 ! CALL ADVECTION_DIFFUSION_EQUATION_EQUATIONS_SET_NONLINEAR_SETUP(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*999)
575  CASE(equations_set_no_source_ale_advection_diff_supg_subtype)
576  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
577  CASE(equations_set_constant_source_ale_advection_diff_supg_subtype)
578  !Need to define the functions diffusion_equation_equations_set_linear_source_setup etc
579  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
580  CASE(equations_set_linear_source_ale_advection_diff_supg_subtype)
581  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
582  CASE(equations_set_quad_source_ale_advection_diff_supg_subtype)
583  CALL flagerror("Not implemented.",err,error,*999)
584 ! CALL ADVECTION_DIFFUSION_EQUATION_EQUATIONS_SET_NONLINEAR_SETUP(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*999)
585  CASE(equations_set_exp_source_ale_advection_diff_supg_subtype)
586  CALL flagerror("Not implemented.",err,error,*999)
587 ! CALL ADVECTION_DIFFUSION_EQUATION_EQUATIONS_SET_NONLINEAR_SETUP(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*999)
588  CASE(equations_set_no_source_static_advec_diff_subtype)
589  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
590  CASE(equations_set_constant_source_static_advec_diff_subtype)
591  !Need to define the functions diffusion_equation_equations_set_linear_source_setup etc
592  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
593  CASE(equations_set_linear_source_static_advec_diff_subtype)
594  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
595  CASE(equations_set_no_source_advection_diff_supg_subtype)
596  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
597  CASE(equations_set_constant_source_advection_diff_supg_subtype)
598  !Need to define the functions diffusion_equation_equations_set_linear_source_setup etc
599  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
600  CASE(equations_set_linear_source_advection_diff_supg_subtype)
601  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
602  CASE(equations_set_quad_source_advection_diff_supg_subtype)
603  CALL flagerror("Not implemented.",err,error,*999)
604 ! CALL ADVECTION_DIFFUSION_EQUATION_EQUATIONS_SET_NONLINEAR_SETUP(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*999)
605  CASE(equations_set_exp_source_advection_diff_supg_subtype)
606  CALL flagerror("Not implemented.",err,error,*999)
607 ! CALL ADVECTION_DIFFUSION_EQUATION_EQUATIONS_SET_NONLINEAR_SETUP(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*999)
608  CASE(equations_set_no_source_static_advec_diff_supg_subtype)
609  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
610  CASE(equations_set_constant_source_static_advec_diff_supg_subtype)
611  !Need to define the functions diffusion_equation_equations_set_linear_source_setup etc
612  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
613  CASE(equations_set_linear_source_static_advec_diff_supg_subtype)
614  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
615  CASE(equations_set_coupled_source_diffusion_advec_diffusion_subtype)
616  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
617  CASE(equations_set_multi_comp_transport_advec_diff_subtype)
618  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
619  CASE(equations_set_multi_comp_transport_advec_diff_supg_subtype)
620  CALL advectiondiffusion_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
621  CASE DEFAULT
622  local_error="Equations set subtype "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
623  & " is not valid for an advection-diffusion equation type of a classical field equation set class."
624  CALL flagerror(local_error,err,error,*999)
625  END SELECT
626  ELSE
627  CALL flagerror("Equations set is not associated.",err,error,*999)
628  ENDIF
629 
630  exits("AdvectionDiffusion_EquationsSetSetup")
631  RETURN
632 999 errors("AdvectionDiffusion_EquationsSetSetup",err,error)
633  exits("AdvectionDiffusion_EquationsSetSetup")
634  RETURN 1
635 
636  END SUBROUTINE advectiondiffusion_equationssetsetup
637 
638  !
639  !================================================================================================================================
640  !
641 
643  SUBROUTINE advectiondiffusion_equationssetsolnmethodset(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)
644 
645  !Argument variables
646  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
647  INTEGER(INTG), INTENT(IN) :: SOLUTION_METHOD
648  INTEGER(INTG), INTENT(OUT) :: ERR
649  TYPE(varying_string), INTENT(OUT) :: ERROR
650  !Local Variables
651  TYPE(varying_string) :: LOCAL_ERROR
652 
653  enters("AdvectionDiffusion_EquationsSetSolnMethodSet",err,error,*999)
654 
655  IF(ASSOCIATED(equations_set)) THEN
656  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
657  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
658  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<3) THEN
659  CALL flagerror("Equations set specification does not have a subtype set.",err,error,*999)
660  END IF
661  SELECT CASE(equations_set%SPECIFICATION(3))
662  CASE(equations_set_no_source_advection_diffusion_subtype,equations_set_constant_source_advection_diffusion_subtype, &
663  & equations_set_linear_source_advection_diffusion_subtype,equations_set_quadratic_source_advection_diffusion_subtype, &
664  & equations_set_exponential_source_advection_diffusion_subtype,&
665  & equations_set_no_source_ale_advection_diffusion_subtype,&
666  & equations_set_constant_source_ale_advection_diffusion_subtype, &
667  & equations_set_linear_source_ale_advection_diffusion_subtype,&
668  & equations_set_quadratic_source_ale_advection_diffusion_subtype, &
669  & equations_set_exp_source_ale_advection_diffusion_subtype,&
670  & equations_set_no_source_ale_advection_diff_supg_subtype,&
671  & equations_set_constant_source_ale_advection_diff_supg_subtype, &
672  & equations_set_linear_source_ale_advection_diff_supg_subtype,&
673  & equations_set_quad_source_ale_advection_diff_supg_subtype, &
674  & equations_set_exp_source_ale_advection_diff_supg_subtype,&
675  & equations_set_no_source_static_advec_diff_subtype, &
676  & equations_set_linear_source_static_advec_diff_subtype,equations_set_constant_source_static_advec_diff_subtype, &
677  & equations_set_no_source_advection_diff_supg_subtype,equations_set_linear_source_advection_diff_supg_subtype, &
678  & equations_set_constant_source_advection_diff_supg_subtype,equations_set_quad_source_advection_diff_supg_subtype, &
679  & equations_set_exp_source_advection_diff_supg_subtype,equations_set_no_source_static_advec_diff_supg_subtype, &
680  & equations_set_linear_source_static_advec_diff_supg_subtype, &
681  & equations_set_constant_source_static_advec_diff_supg_subtype, &
682  & equations_set_coupled_source_diffusion_advec_diffusion_subtype,equations_set_multi_comp_transport_advec_diff_subtype, &
683  & equations_set_multi_comp_transport_advec_diff_supg_subtype)
684  SELECT CASE(solution_method)
685  CASE(equations_set_fem_solution_method)
686  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
687  CASE(equations_set_bem_solution_method)
688  CALL flagerror("Not implemented.",err,error,*999)
689  CASE(equations_set_fd_solution_method)
690  CALL flagerror("Not implemented.",err,error,*999)
691  CASE(equations_set_fv_solution_method)
692  CALL flagerror("Not implemented.",err,error,*999)
693  CASE(equations_set_gfem_solution_method)
694  CALL flagerror("Not implemented.",err,error,*999)
695  CASE(equations_set_gfv_solution_method)
696  CALL flagerror("Not implemented.",err,error,*999)
697  CASE DEFAULT
698  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
699  CALL flagerror(local_error,err,error,*999)
700  END SELECT
701  CASE DEFAULT
702  local_error="Equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
703  & " is not valid for an advection-diffusion equation type of an classical field equations set class."
704  CALL flagerror(local_error,err,error,*999)
705  END SELECT
706  ELSE
707  CALL flagerror("Equations set is not associated.",err,error,*999)
708  ENDIF
709 
710  exits("AdvectionDiffusion_EquationsSetSolnMethodSet")
711  RETURN
712 999 errors("AdvectionDiffusion_EquationsSetSolnMethodSet",err,error)
713  exits("AdvectionDiffusion_EquationsSetSolnMethodSet")
714  RETURN 1
715  END SUBROUTINE advectiondiffusion_equationssetsolnmethodset
716 
717  !
718  !================================================================================================================================
719  !
720 
722  SUBROUTINE advectiondiffusion_equationssetspecificationset(equationsSet,specification,err,error,*)
723 
724  !Argument variables
725  TYPE(equations_set_type), POINTER :: equationsSet
726  INTEGER(INTG), INTENT(IN) :: specification(:)
727  INTEGER(INTG), INTENT(OUT) :: err
728  TYPE(varying_string), INTENT(OUT) :: error
729  !Local Variables
730  TYPE(varying_string) :: localError
731  INTEGER(INTG) :: subtype
732 
733  enters("AdvectionDiffusion_EquationsSetSpecificationSet",err,error,*999)
734 
735  IF(ASSOCIATED(equationsset)) THEN
736  IF(SIZE(specification,1)/=3) THEN
737  CALL flagerror("Equations set specification must have three entries for an advection-diffusion type equations set.", &
738  & err,error,*999)
739  END IF
740  subtype=specification(3)
741  SELECT CASE(subtype)
742  CASE(equations_set_no_source_advection_diffusion_subtype, &
743  & equations_set_constant_source_advection_diffusion_subtype, &
744  & equations_set_linear_source_advection_diffusion_subtype, &
745  & equations_set_quadratic_source_advection_diffusion_subtype, &
746  & equations_set_exponential_source_advection_diffusion_subtype, &
747  & equations_set_no_source_ale_advection_diffusion_subtype, &
748  & equations_set_constant_source_ale_advection_diffusion_subtype, &
749  & equations_set_linear_source_ale_advection_diffusion_subtype, &
750  & equations_set_quadratic_source_ale_advection_diffusion_subtype, &
751  & equations_set_exp_source_ale_advection_diffusion_subtype, &
752  & equations_set_no_source_ale_advection_diff_supg_subtype, &
753  & equations_set_constant_source_ale_advection_diff_supg_subtype, &
754  & equations_set_linear_source_ale_advection_diff_supg_subtype, &
755  & equations_set_quad_source_ale_advection_diff_supg_subtype, &
756  & equations_set_exp_source_ale_advection_diff_supg_subtype, &
757  & equations_set_no_source_static_advec_diff_subtype, &
758  & equations_set_constant_source_static_advec_diff_subtype, &
759  & equations_set_linear_source_static_advec_diff_subtype, &
760  & equations_set_no_source_advection_diff_supg_subtype, &
761  & equations_set_constant_source_advection_diff_supg_subtype, &
762  & equations_set_linear_source_advection_diff_supg_subtype, &
763  & equations_set_quad_source_advection_diff_supg_subtype, &
764  & equations_set_exp_source_advection_diff_supg_subtype, &
765  & equations_set_no_source_static_advec_diff_supg_subtype, &
766  & equations_set_constant_source_static_advec_diff_supg_subtype, &
767  & equations_set_linear_source_static_advec_diff_supg_subtype, &
768  & equations_set_coupled_source_diffusion_advec_diffusion_subtype, &
769  & equations_set_multi_comp_transport_advec_diff_subtype, &
770  & equations_set_multi_comp_transport_advec_diff_supg_subtype)
771  !ok
772  CASE DEFAULT
773  localerror="The third equations set specification of "//trim(numbertovstring(subtype,"*",err,error))// &
774  & " is not valid for an advection-diffusion type of a classical field equations set."
775  CALL flagerror(localerror,err,error,*999)
776  END SELECT
777  !Set full specification
778  IF(ALLOCATED(equationsset%specification)) THEN
779  CALL flagerror("Equations set specification is already allocated.",err,error,*999)
780  ELSE
781  ALLOCATE(equationsset%specification(3),stat=err)
782  IF(err/=0) CALL flagerror("Could not allocate equations set specification.",err,error,*999)
783  END IF
784  equationsset%specification(1:3)=[equations_set_classical_field_class,equations_set_advection_diffusion_equation_type,subtype]
785  ELSE
786  CALL flagerror("Equations set is not associated.",err,error,*999)
787  END IF
788 
789  exits("AdvectionDiffusion_EquationsSetSpecificationSet")
790  RETURN
791 999 errors("AdvectionDiffusion_EquationsSetSpecificationSet",err,error)
792  exits("AdvectionDiffusion_EquationsSetSpecificationSet")
793  RETURN 1
794 
795  END SUBROUTINE advectiondiffusion_equationssetspecificationset
796 
797  !
798  !================================================================================================================================
799  !
800 
802  SUBROUTINE advectiondiffusion_equationssetlinearsetup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
803 
804  !Argument variables
805  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
806  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
807  INTEGER(INTG), INTENT(OUT) :: ERR
808  TYPE(varying_string), INTENT(OUT) :: ERROR
809  !Local Variables
810  INTEGER(INTG) :: component_idx,GEOMETRIC_MESH_COMPONENT,GEOMETRIC_SCALING_TYPE,NUMBER_OF_DIMENSIONS, &
811  & NUMBER_OF_MATERIALS_COMPONENTS, NUMBER_OF_SOURCE_COMPONENTS, NUMBER_OF_INDEPENDENT_COMPONENTS,imy_matrix,Ncompartments,&
812  & GEOMETRIC_COMPONENT_NUMBER,NUMBER_OF_INDEPENDENT_U_VAR_COMPONENTS,NUMBER_OF_INDEPENDENT_V_VAR_COMPONENTS
813  TYPE(decomposition_type), POINTER :: GEOMETRIC_DECOMPOSITION
814  TYPE(equations_type), POINTER :: EQUATIONS
815  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
816  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
817  TYPE(equations_set_equations_set_field_type), POINTER :: EQUATIONS_EQUATIONS_SET_FIELD
818  TYPE(equations_set_materials_type), POINTER :: EQUATIONS_MATERIALS
819  TYPE(equations_set_source_type), POINTER :: EQUATIONS_SOURCE
820  TYPE(equations_set_independent_type), POINTER :: EQUATIONS_INDEPENDENT
821  TYPE(field_type), POINTER :: ANALYTIC_FIELD,DEPENDENT_FIELD,GEOMETRIC_FIELD,EQUATIONS_SET_FIELD_FIELD
822  TYPE(varying_string) :: LOCAL_ERROR
823  INTEGER(INTG) :: num_var,num_var_count,NUMBER_OF_MATERIALS_COUPLING_COMPONENTS
824  INTEGER(INTG) :: EQUATIONS_SET_FIELD_NUMBER_OF_VARIABLES,EQUATIONS_SET_FIELD_NUMBER_OF_COMPONENTS
825  INTEGER(INTG), POINTER :: EQUATIONS_SET_FIELD_DATA(:)
826  INTEGER(INTG), ALLOCATABLE :: VARIABLE_TYPES(:),VARIABLE_U_TYPES(:),COUPLING_MATRIX_STORAGE_TYPE(:), &
827  & COUPLING_MATRIX_STRUCTURE_TYPE(:)
828  INTEGER(INTG) :: EQUATIONS_SET_SUBTYPE
829 
830  enters("ADVECTION_DIFFUSION_EQUATION_EQUATION_SET_LINEAR_SETUP",err,error,*999)
831 
832  NULLIFY(equations)
833  NULLIFY(equations_mapping)
834  NULLIFY(equations_matrices)
835  NULLIFY(geometric_decomposition)
836 
837  IF(ASSOCIATED(equations_set)) THEN
838  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
839  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
840  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<3) THEN
841  CALL flagerror("Equations set specification does not have a subtype set.",err,error,*999)
842  END IF
843  equations_set_subtype=equations_set%SPECIFICATION(3)
844  IF(equations_set_subtype==equations_set_no_source_advection_diffusion_subtype .OR. &
845  & equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
846  & equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
847  & equations_set_subtype==equations_set_no_source_ale_advection_diffusion_subtype .OR. &
848  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
849  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
850  & equations_set_subtype==equations_set_no_source_static_advec_diff_subtype .OR. &
851  & equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype .OR. &
852  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
853  & equations_set_subtype==equations_set_no_source_advection_diff_supg_subtype .OR. &
854  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
855  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
856  & equations_set_subtype==equations_set_no_source_ale_advection_diff_supg_subtype .OR. &
857  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
858  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
859  & equations_set_subtype==equations_set_no_source_static_advec_diff_supg_subtype .OR. &
860  & equations_set_subtype==equations_set_constant_source_static_advec_diff_supg_subtype .OR. &
861  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype .OR. &
862  & equations_set_subtype==equations_set_coupled_source_diffusion_advec_diffusion_subtype .OR. &
863  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
864  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
865  SELECT CASE(equations_set_setup%SETUP_TYPE)
866  CASE(equations_set_setup_initial_type)
867  SELECT CASE(equations_set_setup%ACTION_TYPE)
868  CASE(equations_set_setup_start_action)
869  CALL advectiondiffusion_equationssetsolnmethodset(equations_set, &
870  & equations_set_fem_solution_method,err,error,*999)
871  IF(equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
872  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
873  equations_set_field_number_of_variables = 1
874  equations_set_field_number_of_components = 2
875  equations_equations_set_field=>equations_set%EQUATIONS_SET_FIELD
876  IF(equations_equations_set_field%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN
877  !Create the auto created equations set field
878  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
879  & equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD,err,error,*999)
880  CALL field_label_set(equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD,"Equations Set Field",err,error,*999)
881  CALL field_type_set_and_lock(equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD,field_general_type,&
882  & err,error,*999)
883  CALL field_dependent_type_set_and_lock(equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD,&
884  & field_independent_type,err,error,*999)
885  CALL field_number_of_variables_set(equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD, &
886  & equations_set_field_number_of_variables,err,error,*999)
887  CALL field_variable_types_set_and_lock(equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD,&
888  & [field_u_variable_type],err,error,*999)
889  CALL field_dimension_set_and_lock(equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD,field_u_variable_type, &
890  & field_vector_dimension_type,err,error,*999)
891  CALL field_data_type_set_and_lock(equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD,field_u_variable_type, &
892  & field_intg_type,err,error,*999)
893  CALL field_number_of_components_set_and_lock(equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD,&
894  & field_u_variable_type,equations_set_field_number_of_components,err,error,*999)
895  ELSE
896  !Check the user specified field
897  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
898  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
899  CALL field_number_of_variables_check(equations_set_setup%FIELD,equations_set_field_number_of_variables, &
900  & err,error,*999)
901  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
902  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
903  & err,error,*999)
904  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_intg_type,err,error,*999)
905  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
906  & equations_set_field_number_of_components,err,error,*999)
907  ENDIF
908  ENDIF
909  CASE(equations_set_setup_finish_action)
910  IF(equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
911  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
912  IF(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN
913  CALL field_create_finish(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,err,error,*999)
914  CALL field_component_values_initialise(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,&
915  & field_u_variable_type,field_values_set_type, 1, 1_intg, err, error, *999)
916  CALL field_component_values_initialise(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,&
917  & field_u_variable_type,field_values_set_type, 2, 1_intg, err, error, *999)
918  ENDIF
919  ENDIF
920 !!TODO: Check valid setup
921  CASE DEFAULT
922  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
923  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
924  & " is invalid for a linear advection-diffusion equation."
925  CALL flagerror(local_error,err,error,*999)
926  END SELECT
927  CASE(equations_set_setup_geometry_type)
928  !Do nothing???
929  SELECT CASE(equations_set_subtype)
930  CASE(equations_set_no_source_advection_diffusion_subtype, &
931  & equations_set_constant_source_advection_diffusion_subtype, &
932  & equations_set_linear_source_advection_diffusion_subtype)
933  CASE(equations_set_multi_comp_transport_advec_diff_subtype,equations_set_multi_comp_transport_advec_diff_supg_subtype)
934  SELECT CASE(equations_set_setup%ACTION_TYPE)
935  CASE(equations_set_setup_start_action)
936  equations_set_field_number_of_components = 2
937  equations_equations_set_field=>equations_set%EQUATIONS_SET_FIELD
938  IF(equations_equations_set_field%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN
939  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
940  CALL field_mesh_decomposition_set_and_lock(equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD,&
941  & geometric_decomposition,err,error,*999)
942  CALL field_geometric_field_set_and_lock(equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD,&
943  & equations_set%GEOMETRY%GEOMETRIC_FIELD,err,error,*999)
944  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
945  & 1,geometric_component_number,err,error,*999)
946  DO component_idx = 1, equations_set_field_number_of_components
947  CALL field_component_mesh_component_set_and_lock(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
948  & field_u_variable_type,component_idx,geometric_component_number,err,error,*999)
949  CALL field_component_interpolation_set_and_lock(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
950  & field_u_variable_type,component_idx,field_constant_interpolation,err,error,*999)
951  END DO
952  !Default the field scaling to that of the geometric field
953  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
954  CALL field_scaling_type_set(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,geometric_scaling_type, &
955  & err,error,*999)
956  ELSE
957  !Do nothing
958  ENDIF
959  CASE(equations_set_setup_finish_action)
960  ! do nothing
961  CASE DEFAULT
962  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
963  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
964  & " is invalid for a linear advection-diffusion equation."
965  CALL flagerror(local_error,err,error,*999)
966  END SELECT
967  !Do nothing???
968  CASE(equations_set_no_source_ale_advection_diffusion_subtype, &
969  & equations_set_constant_source_ale_advection_diffusion_subtype, &
970  & equations_set_linear_source_ale_advection_diffusion_subtype, &
971  & equations_set_no_source_ale_advection_diff_supg_subtype, &
972  & equations_set_constant_source_ale_advection_diff_supg_subtype, &
973  & equations_set_linear_source_ale_advection_diff_supg_subtype)
974  CALL field_parameter_set_create(equations_set%GEOMETRY%GEOMETRIC_FIELD, field_u_variable_type, &
975  & field_mesh_displacement_set_type, err, error, *999)
976  CALL field_parameter_set_create(equations_set%GEOMETRY%GEOMETRIC_FIELD, field_u_variable_type, &
977  & field_mesh_velocity_set_type, err, error, *999)
978  END SELECT
979  !-----------------------------------------------------------------
980  ! D e p e n d e n t f i e l d
981  !-----------------------------------------------------------------
982  CASE(equations_set_setup_dependent_type)
983  SELECT CASE(equations_set_setup%ACTION_TYPE)
984  CASE(equations_set_setup_start_action)
985  SELECT CASE(equations_set_subtype)
986  CASE(equations_set_no_source_advection_diffusion_subtype, &
987  & equations_set_constant_source_advection_diffusion_subtype, &
988  & equations_set_linear_source_advection_diffusion_subtype, &
989  & equations_set_no_source_ale_advection_diffusion_subtype, &
990  & equations_set_constant_source_ale_advection_diffusion_subtype, &
991  & equations_set_linear_source_ale_advection_diffusion_subtype, &
992  & equations_set_no_source_static_advec_diff_subtype, &
993  & equations_set_constant_source_static_advec_diff_subtype, &
994  & equations_set_linear_source_static_advec_diff_subtype, &
995  & equations_set_no_source_advection_diff_supg_subtype, &
996  & equations_set_constant_source_advection_diff_supg_subtype, &
997  & equations_set_linear_source_advection_diff_supg_subtype, &
998  & equations_set_no_source_ale_advection_diff_supg_subtype, &
999  & equations_set_constant_source_ale_advection_diff_supg_subtype, &
1000  & equations_set_linear_source_ale_advection_diff_supg_subtype, &
1001  & equations_set_no_source_static_advec_diff_supg_subtype, &
1002  & equations_set_constant_source_static_advec_diff_supg_subtype, &
1003  & equations_set_linear_source_static_advec_diff_supg_subtype, &
1004  & equations_set_multi_comp_transport_advec_diff_subtype, &
1005  & equations_set_multi_comp_transport_advec_diff_supg_subtype)
1006  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
1007  !Create the auto created dependent field
1008  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
1009  & dependent_field,err,error,*999)
1010  CALL field_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
1011  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
1012  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
1013  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
1014  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
1015  & err,error,*999)
1016  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
1017  & geometric_field,err,error,*999)
1018  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,2,err,error,*999)
1019  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,[field_u_variable_type, &
1020  & field_deludeln_variable_type],err,error,*999)
1021  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1022  & field_scalar_dimension_type,err,error,*999)
1023  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
1024  & field_scalar_dimension_type,err,error,*999)
1025  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1026  & field_dp_type,err,error,*999)
1027  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
1028  & field_dp_type,err,error,*999)
1029  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
1030  & err,error,*999)
1031  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1032  & field_deludeln_variable_type,1,err,error,*999)
1033  !Default to the geometric interpolation setup
1034  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,1, &
1035  & geometric_mesh_component,err,error,*999)
1036  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
1037  & geometric_mesh_component,err,error,*999)
1038  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
1039  & geometric_mesh_component,err,error,*999)
1040  SELECT CASE(equations_set%SOLUTION_METHOD)
1041  CASE(equations_set_fem_solution_method)
1042  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1043  & field_u_variable_type,1,field_node_based_interpolation,err,error,*999)
1044  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1045  & field_deludeln_variable_type,1,field_node_based_interpolation,err,error,*999)
1046  !Default the scaling to the geometric field scaling
1047  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
1048  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
1049  CASE(equations_set_bem_solution_method)
1050  CALL flagerror("Not implemented.",err,error,*999)
1051  CASE(equations_set_fd_solution_method)
1052  CALL flagerror("Not implemented.",err,error,*999)
1053  CASE(equations_set_fv_solution_method)
1054  CALL flagerror("Not implemented.",err,error,*999)
1055  CASE(equations_set_gfem_solution_method)
1056  CALL flagerror("Not implemented.",err,error,*999)
1057  CASE(equations_set_gfv_solution_method)
1058  CALL flagerror("Not implemented.",err,error,*999)
1059  CASE DEFAULT
1060  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1061  & " is invalid."
1062  CALL flagerror(local_error,err,error,*999)
1063  END SELECT
1064  ELSE
1065  SELECT CASE(equations_set_subtype)
1066  CASE(equations_set_multi_comp_transport_advec_diff_subtype, &
1067  & equations_set_multi_comp_transport_advec_diff_supg_subtype)
1068  !uses number of compartments to check that appropriate number and type of variables have been set on the dependent field
1069  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1070  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
1071  equations_set_field_field=>equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD
1072  CALL field_parameter_set_data_get(equations_set_field_field,field_u_variable_type, &
1073  & field_values_set_type,equations_set_field_data,err,error,*999)
1074  ncompartments=equations_set_field_data(2)
1075  CALL field_number_of_variables_check(equations_set_setup%FIELD,2*ncompartments,err,error,*999)
1076  !Create & populate array storing all of the relevant variable types against which to check the field variables
1077  ALLOCATE(variable_types(2*ncompartments))
1078  DO num_var=1,ncompartments
1079  variable_types(2*num_var-1)=field_u_variable_type+(field_number_of_variable_subtypes*(num_var-1))
1080  variable_types(2*num_var)=field_deludeln_variable_type+(field_number_of_variable_subtypes*(num_var-1))
1081  ENDDO
1082  CALL field_variable_types_check(equations_set_setup%FIELD,variable_types,err,error,*999)
1083 
1084  DO num_var=1,2*ncompartments
1085  CALL field_dimension_check(equations_set_setup%FIELD,variable_types(num_var), &
1086  & field_scalar_dimension_type,err,error,*999)
1087  CALL field_data_type_check(equations_set_setup%FIELD,variable_types(num_var),field_dp_type,err,error,*999)
1088  CALL field_number_of_components_check(equations_set_setup%FIELD,variable_types(num_var),1, &
1089  & err,error,*999)
1090  ENDDO
1091  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1092  & number_of_dimensions,err,error,*999)
1093  SELECT CASE(equations_set%SOLUTION_METHOD)
1094  CASE(equations_set_fem_solution_method)
1095  component_idx=1
1096  DO num_var=1,2*ncompartments
1097  CALL field_component_interpolation_check(equations_set_setup%FIELD,variable_types(num_var),component_idx, &
1098  & field_node_based_interpolation,err,error,*999)
1099  ENDDO
1100  CASE(equations_set_bem_solution_method)
1101  CALL flagerror("Not implemented.",err,error,*999)
1102  CASE(equations_set_fd_solution_method)
1103  CALL flagerror("Not implemented.",err,error,*999)
1104  CASE(equations_set_fv_solution_method)
1105  CALL flagerror("Not implemented.",err,error,*999)
1106  CASE(equations_set_gfem_solution_method)
1107  CALL flagerror("Not implemented.",err,error,*999)
1108  CASE(equations_set_gfv_solution_method)
1109  CALL flagerror("Not implemented.",err,error,*999)
1110  CASE DEFAULT
1111  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1112  & " is invalid."
1113  CALL flagerror(local_error,err,error,*999)
1114  END SELECT
1115  CASE DEFAULT
1116  !Check the user specified field
1117  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1118  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
1119  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
1120  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_deludeln_variable_type], &
1121  & err,error,*999)
1122  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_scalar_dimension_type, &
1123  & err,error,*999)
1124  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_scalar_dimension_type, &
1125  & err,error,*999)
1126  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1127  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
1128  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1129  & number_of_dimensions,err,error,*999)
1130  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_dimensions, &
1131  & err,error,*999)
1132  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
1133  & number_of_dimensions,err,error,*999)
1134  SELECT CASE(equations_set%SOLUTION_METHOD)
1135  CASE(equations_set_fem_solution_method)
1136 ! DO component_idx=1,NUMBER_OF_DIMENSIONS
1137  component_idx=1
1138  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,component_idx, &
1139  & field_node_based_interpolation,err,error,*999)
1140  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
1141  & component_idx,field_node_based_interpolation,err,error,*999)
1142 ! ENDDO !component_idx
1143  CASE(equations_set_bem_solution_method)
1144  CALL flagerror("Not implemented.",err,error,*999)
1145  CASE(equations_set_fd_solution_method)
1146  CALL flagerror("Not implemented.",err,error,*999)
1147  CASE(equations_set_fv_solution_method)
1148  CALL flagerror("Not implemented.",err,error,*999)
1149  CASE(equations_set_gfem_solution_method)
1150  CALL flagerror("Not implemented.",err,error,*999)
1151  CASE(equations_set_gfv_solution_method)
1152  CALL flagerror("Not implemented.",err,error,*999)
1153  CASE DEFAULT
1154  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1155  & " is invalid."
1156  CALL flagerror(local_error,err,error,*999)
1157  END SELECT
1158  END SELECT
1159  ENDIF
1160  CASE(equations_set_coupled_source_diffusion_advec_diffusion_subtype)
1161 
1162  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
1163  !Create the auto created dependent field
1164  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
1165  & dependent_field,err,error,*999)
1166  CALL field_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
1167  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
1168  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
1169  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
1170  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
1171  & err,error,*999)
1172  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
1173  & geometric_field,err,error,*999)
1174  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,4,err,error,*999)
1175  CALL field_variable_types_set_and_lock(equations_set_setup%FIELD,[field_u_variable_type, &
1176  & field_deludeln_variable_type,field_v_variable_type,field_delvdeln_variable_type],err,error,*999)
1177  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1178  & field_scalar_dimension_type,err,error,*999)
1179  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
1180  & field_scalar_dimension_type,err,error,*999)
1181  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
1182  & field_scalar_dimension_type,err,error,*999)
1183  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type, &
1184  & field_scalar_dimension_type,err,error,*999)
1185  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1186  & field_dp_type,err,error,*999)
1187  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
1188  & field_dp_type,err,error,*999)
1189  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
1190  & field_dp_type,err,error,*999)
1191  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type, &
1192  & field_dp_type,err,error,*999)
1193 
1194  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
1195  & err,error,*999)
1196  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1197  & field_deludeln_variable_type,1,err,error,*999)
1198  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
1199  & 1,err,error,*999)
1200  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type, &
1201  & 1,err,error,*999)
1202  !Default to the geometric interpolation setup
1203  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,1, &
1204  & geometric_mesh_component,err,error,*999)
1205  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
1206  & geometric_mesh_component,err,error,*999)
1207  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
1208  & geometric_mesh_component,err,error,*999)
1209  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,1, &
1210  & geometric_mesh_component,err,error,*999)
1211  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type,1, &
1212  & geometric_mesh_component,err,error,*999)
1213  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type,1, &
1214  & geometric_mesh_component,err,error,*999)
1215  SELECT CASE(equations_set%SOLUTION_METHOD)
1216  CASE(equations_set_fem_solution_method)
1217  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1218  & field_u_variable_type,1,field_node_based_interpolation,err,error,*999)
1219  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1220  & field_deludeln_variable_type,1,field_node_based_interpolation,err,error,*999)
1221  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1222  & field_v_variable_type,1,field_node_based_interpolation,err,error,*999)
1223  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1224  & field_delvdeln_variable_type,1,field_node_based_interpolation,err,error,*999)
1225  !Default the scaling to the geometric field scaling
1226  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
1227  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
1228  CASE(equations_set_bem_solution_method)
1229  CALL flagerror("Not implemented.",err,error,*999)
1230  CASE(equations_set_fd_solution_method)
1231  CALL flagerror("Not implemented.",err,error,*999)
1232  CASE(equations_set_fv_solution_method)
1233  CALL flagerror("Not implemented.",err,error,*999)
1234  CASE(equations_set_gfem_solution_method)
1235  CALL flagerror("Not implemented.",err,error,*999)
1236  CASE(equations_set_gfv_solution_method)
1237  CALL flagerror("Not implemented.",err,error,*999)
1238  CASE DEFAULT
1239  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1240  & " is invalid."
1241  CALL flagerror(local_error,err,error,*999)
1242  END SELECT
1243  ELSE
1244  !Check the user specified field
1245  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1246  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
1247  CALL field_number_of_variables_check(equations_set_setup%FIELD,4,err,error,*999)
1248  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_deludeln_variable_type,&
1249  & field_v_variable_type,field_delvdeln_variable_type],err,error,*999)
1250 
1251  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_scalar_dimension_type, &
1252  & err,error,*999)
1253  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_scalar_dimension_type, &
1254  & err,error,*999)
1255  CALL field_dimension_check(equations_set_setup%FIELD,field_v_variable_type,field_scalar_dimension_type, &
1256  & err,error,*999)
1257  CALL field_dimension_check(equations_set_setup%FIELD,field_delvdeln_variable_type,field_scalar_dimension_type, &
1258  & err,error,*999)
1259  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1260  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
1261  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_dp_type,err,error,*999)
1262  CALL field_data_type_check(equations_set_setup%FIELD,field_delvdeln_variable_type,field_dp_type,err,error,*999)
1263  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1264  & number_of_dimensions,err,error,*999)
1265  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1, &
1266  & err,error,*999)
1267  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
1268  & 1,err,error,*999)
1269  CALL field_number_of_components_check(equations_set_setup%FIELD,field_v_variable_type,1, &
1270  & err,error,*999)
1271  CALL field_number_of_components_check(equations_set_setup%FIELD,field_delvdeln_variable_type, &
1272  & 1,err,error,*999)
1273  SELECT CASE(equations_set%SOLUTION_METHOD)
1274  CASE(equations_set_fem_solution_method)
1275  ! DO component_idx=1,NUMBER_OF_DIMENSIONS
1276  component_idx=1
1277  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,component_idx, &
1278  & field_node_based_interpolation,err,error,*999)
1279  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
1280  & component_idx,field_node_based_interpolation,err,error,*999)
1281  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,component_idx, &
1282  & field_node_based_interpolation,err,error,*999)
1283  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_delvdeln_variable_type, &
1284  & component_idx,field_node_based_interpolation,err,error,*999)
1285 ! ENDDO !component_idx
1286  CASE(equations_set_bem_solution_method)
1287  CALL flagerror("Not implemented.",err,error,*999)
1288  CASE(equations_set_fd_solution_method)
1289  CALL flagerror("Not implemented.",err,error,*999)
1290  CASE(equations_set_fv_solution_method)
1291  CALL flagerror("Not implemented.",err,error,*999)
1292  CASE(equations_set_gfem_solution_method)
1293  CALL flagerror("Not implemented.",err,error,*999)
1294  CASE(equations_set_gfv_solution_method)
1295  CALL flagerror("Not implemented.",err,error,*999)
1296  CASE DEFAULT
1297  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1298  & " is invalid."
1299  CALL flagerror(local_error,err,error,*999)
1300  END SELECT
1301  ENDIF
1302  END SELECT
1303  CASE(equations_set_setup_finish_action)
1304  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
1305  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
1306  CALL field_parameter_set_create(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1307  & field_boundary_conditions_set_type,err,error,*999)
1308  ENDIF
1309  CASE DEFAULT
1310  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1311  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1312  & " is invalid for a linear advection-diffusion equation"
1313  CALL flagerror(local_error,err,error,*999)
1314  END SELECT
1315  !-----------------------------------------------------------------
1316  ! M a t e r i a l s f i e l d
1317  !-----------------------------------------------------------------
1318  CASE(equations_set_setup_materials_type)
1319  SELECT CASE(equations_set_setup%ACTION_TYPE)
1320  CASE(equations_set_setup_start_action)
1321  equations_materials=>equations_set%MATERIALS
1322  IF(ASSOCIATED(equations_materials)) THEN
1323  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
1324  IF(equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
1325  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype)THEN
1326  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_materials% &
1327  & materials_field,err,error,*999)
1328  CALL field_label_set(equations_materials%MATERIALS_FIELD,"Materials Field",err,error,*999)
1329  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
1330  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type,err,error,*999)
1331  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
1332  CALL field_mesh_decomposition_set_and_lock(equations_materials%MATERIALS_FIELD,geometric_decomposition, &
1333  & err,error,*999)
1334  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
1335  & geometric_field,err,error,*999)
1336  CALL field_number_of_variables_set_and_lock(equations_materials%MATERIALS_FIELD,2,err,error,*999)
1337  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,[field_u_variable_type, &
1338  & field_v_variable_type], &
1339  & err,error,*999)
1340  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1341  & field_vector_dimension_type,err,error,*999)
1342  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1343  & field_dp_type,err,error,*999)
1344  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
1345  & field_vector_dimension_type,err,error,*999)
1346  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
1347  & field_dp_type,err,error,*999)
1348  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1349  & number_of_dimensions,err,error,*999)
1350  number_of_materials_components=number_of_dimensions
1351  !Set the number of materials components
1352  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1353  & number_of_materials_components,err,error,*999)
1354  equations_set_field_field=>equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD
1355  CALL field_parameter_set_data_get(equations_set_field_field,field_u_variable_type, &
1356  & field_values_set_type,equations_set_field_data,err,error,*999)
1357  ncompartments=equations_set_field_data(2)
1358  number_of_materials_coupling_components=ncompartments
1359  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
1360  & number_of_materials_coupling_components,err,error,*999)
1361  !Default the k materials components to the geometric interpolation setup with constant interpolation
1362  DO component_idx=1,number_of_dimensions
1363  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1364  & component_idx,geometric_mesh_component,err,error,*999)
1365  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1366  & component_idx,field_constant_interpolation,err,error,*999)
1367  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1368  & component_idx,geometric_mesh_component,err,error,*999)
1369  ENDDO !component_idx
1370  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1371  & 1,geometric_mesh_component,err,error,*999)
1372  DO component_idx=1,number_of_materials_coupling_components
1373  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
1374  & component_idx,field_constant_interpolation,err,error,*999)
1375  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
1376  & component_idx,geometric_mesh_component,err,error,*999)
1377  ENDDO
1378  !Default the field scaling to that of the geometric field
1379  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
1380  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
1381  ELSE !standard materials field
1382  !Create the auto created materials field
1383  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_materials% &
1384  & materials_field,err,error,*999)
1385  CALL field_label_set(equations_materials%MATERIALS_FIELD,"Materials Field",err,error,*999)
1386  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
1387  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type,err,error,*999)
1388  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
1389  CALL field_mesh_decomposition_set_and_lock(equations_materials%MATERIALS_FIELD,geometric_decomposition, &
1390  & err,error,*999)
1391  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
1392  & geometric_field,err,error,*999)
1393  CALL field_number_of_variables_set_and_lock(equations_materials%MATERIALS_FIELD,1,err,error,*999)
1394  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,[field_u_variable_type], &
1395  & err,error,*999)
1396  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1397  & field_vector_dimension_type,err,error,*999)
1398  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1399  & field_dp_type,err,error,*999)
1400  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1401  & number_of_dimensions,err,error,*999)
1402  IF(equations_set_subtype==equations_set_no_source_advection_diffusion_subtype .OR. &
1403  & equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
1404  & equations_set_subtype==equations_set_no_source_ale_advection_diffusion_subtype .OR. &
1405  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
1406  & equations_set_subtype==equations_set_no_source_static_advec_diff_subtype .OR. &
1407  & equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype .OR. &
1408  & equations_set_subtype==equations_set_no_source_advection_diff_supg_subtype .OR. &
1409  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
1410  & equations_set_subtype==equations_set_no_source_ale_advection_diff_supg_subtype .OR. &
1411  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
1412  & equations_set_subtype==equations_set_no_source_static_advec_diff_supg_subtype .OR. &
1413  & equations_set_subtype==equations_set_constant_source_static_advec_diff_supg_subtype) THEN
1414  number_of_materials_components=number_of_dimensions
1415  ELSEIF(equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
1416  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
1417  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
1418  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
1419  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
1420  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype) THEN
1421  !Linear source. Materials field components are 1 for each dimension and 1 for the linear source
1422  !i.e., k and a in div(k.grad(u(x)))=a(x)u(x)+c(x)
1423  number_of_materials_components=number_of_dimensions+1
1424  ELSE
1425  number_of_materials_components=number_of_dimensions
1426  ENDIF
1427  !Set the number of materials components
1428  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1429  & number_of_materials_components,err,error,*999)
1430  !Default the k materials components to the geometric interpolation setup with constant interpolation
1431  DO component_idx=1,number_of_dimensions
1432  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1433  & component_idx,geometric_mesh_component,err,error,*999)
1434  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1435  & component_idx,field_constant_interpolation,err,error,*999)
1436  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1437  & component_idx,geometric_mesh_component,err,error,*999)
1438  ENDDO !component_idx
1439  IF(equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
1440  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
1441  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype) THEN
1442  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1443  & 1,geometric_mesh_component,err,error,*999)
1444  DO component_idx=number_of_dimensions+1,number_of_materials_components
1445  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1446  & component_idx,field_constant_interpolation,err,error,*999)
1447  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1448  & component_idx,geometric_mesh_component,err,error,*999)
1449  ENDDO !component_idx
1450  ENDIF
1451  !Default the field scaling to that of the geometric field
1452  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
1453  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
1454  ENDIF
1455  ELSE
1456  IF(equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
1457  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype)THEN
1458  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
1459  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1460  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
1461  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type, &
1462  & field_v_variable_type],err,error,*999)
1463  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
1464  & err,error,*999)
1465  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1466  CALL field_dimension_check(equations_set_setup%FIELD,field_v_variable_type,field_vector_dimension_type, &
1467  & err,error,*999)
1468  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_dp_type,err,error,*999)
1469  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1470  & number_of_dimensions,err,error,*999)
1471  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_dimensions, &
1472  & err,error,*999)
1473  equations_set_field_field=>equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD
1474  CALL field_parameter_set_data_get(equations_set_field_field,field_u_variable_type, &
1475  & field_values_set_type,equations_set_field_data,err,error,*999)
1476  ncompartments=equations_set_field_data(2)
1477  number_of_materials_coupling_components=ncompartments
1478  CALL field_number_of_components_check(equations_set_setup%FIELD,field_v_variable_type, &
1479  & number_of_materials_coupling_components,err,error,*999)
1480  ELSE
1481  !Check the user specified field
1482  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
1483  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1484  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
1485  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
1486  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
1487  & err,error,*999)
1488  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1489  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1490  & number_of_dimensions,err,error,*999)
1491  IF(equations_set_subtype==equations_set_no_source_advection_diffusion_subtype .OR. &
1492  & equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
1493  & equations_set_subtype==equations_set_no_source_ale_advection_diffusion_subtype .OR. &
1494  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
1495  & equations_set_subtype==equations_set_no_source_static_advec_diff_subtype .OR. &
1496  & equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype .OR. &
1497  & equations_set_subtype==equations_set_no_source_advection_diff_supg_subtype .OR. &
1498  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
1499  & equations_set_subtype==equations_set_no_source_ale_advection_diff_supg_subtype .OR. &
1500  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
1501  & equations_set_subtype==equations_set_no_source_static_advec_diff_supg_subtype .OR. &
1502  & equations_set_subtype==equations_set_constant_source_static_advec_diff_supg_subtype) THEN
1503  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_dimensions, &
1504  & err,error,*999)
1505  ELSEIF(equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
1506  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
1507  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
1508  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
1509  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
1510  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype) THEN
1511  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_dimensions+1, &
1512  & err,error,*999)
1513  ENDIF
1514  ENDIF
1515  ENDIF
1516  ELSE
1517  CALL flagerror("Equations set materials is not associated.",err,error,*999)
1518  ENDIF
1519  CASE(equations_set_setup_finish_action)
1520  equations_materials=>equations_set%MATERIALS
1521  IF(ASSOCIATED(equations_materials)) THEN
1522  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
1523  !Finish creating the materials field
1524  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
1525  !Set the default values for the materials field
1526  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1527  & number_of_dimensions,err,error,*999)
1528  IF(equations_set_subtype==equations_set_no_source_advection_diffusion_subtype .OR. &
1529  & equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
1530  & equations_set_subtype==equations_set_no_source_ale_advection_diffusion_subtype .OR. &
1531  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
1532  & equations_set_subtype==equations_set_no_source_static_advec_diff_subtype .OR. &
1533  & equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype .OR. &
1534  & equations_set_subtype==equations_set_no_source_advection_diff_supg_subtype .OR. &
1535  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
1536  & equations_set_subtype==equations_set_no_source_ale_advection_diff_supg_subtype .OR. &
1537  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
1538  & equations_set_subtype==equations_set_no_source_static_advec_diff_supg_subtype .OR. &
1539  & equations_set_subtype==equations_set_constant_source_static_advec_diff_supg_subtype .OR. &
1540  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
1541  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
1542  number_of_materials_components=number_of_dimensions
1543  ELSEIF(equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
1544  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
1545  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
1546  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
1547  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
1548  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype) THEN
1549  !Linear source. Materials field components are 1 for each dimension and 1 for the linear source
1550  !i.e., k and a in div(k.grad(u(x)))=a(x)u(x)+c(x)
1551  number_of_materials_components=number_of_dimensions+1
1552  ELSE
1553  number_of_materials_components=number_of_dimensions
1554  ENDIF
1555  !First set the k values to 1.0
1556  DO component_idx=1,number_of_dimensions
1557  !WRITE(*,'("Setting materials components values :")')
1558  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1559  & field_values_set_type,component_idx,1.0_dp,err,error,*999)
1560  ENDDO !component_idx
1561  IF(equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
1562  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
1563  equations_set_field_field=>equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD
1564  CALL field_parameter_set_data_get(equations_set_field_field,field_u_variable_type, &
1565  & field_values_set_type,equations_set_field_data,err,error,*999)
1566  ncompartments=equations_set_field_data(2)
1567  DO component_idx=1,ncompartments
1568  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
1569  & field_values_set_type,component_idx,0.0_dp,err,error,*999)
1570  ENDDO !component_idx
1571  ENDIF
1572  IF(equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
1573  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
1574  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
1575  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
1576  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
1577  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype) THEN
1578  !Now set the linear source values to 1.0
1579  DO component_idx=number_of_dimensions+1,number_of_materials_components
1580  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1581  & field_values_set_type,component_idx,1.0_dp,err,error,*999)
1582  ENDDO !component_idx
1583  ENDIF
1584  ENDIF
1585  ELSE
1586  CALL flagerror("Equations set materials is not associated.",err,error,*999)
1587  ENDIF
1588  CASE DEFAULT
1589  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1590  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1591  & " is invalid for a linear advection-diffusion equation."
1592  CALL flagerror(local_error,err,error,*999)
1593  END SELECT
1594  !-----------------------------------------------------------------
1595  ! S o u r c e f i e l d
1596  !-----------------------------------------------------------------
1597  CASE(equations_set_setup_source_type)
1598  SELECT CASE(equations_set_setup%ACTION_TYPE)
1599  CASE(equations_set_setup_start_action)
1600  equations_source=>equations_set%SOURCE
1601  IF(ASSOCIATED(equations_source)) THEN
1602  IF(equations_source%SOURCE_FIELD_AUTO_CREATED) THEN
1603  !Create the auto created source field
1604  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_source% &
1605  & source_field,err,error,*999)
1606  CALL field_label_set(equations_source%SOURCE_FIELD,"Source Field",err,error,*999)
1607  CALL field_type_set_and_lock(equations_source%SOURCE_FIELD,field_general_type,err,error,*999)
1608  CALL field_dependent_type_set_and_lock(equations_source%SOURCE_FIELD,field_independent_type,err,error,*999)
1609  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
1610  CALL field_mesh_decomposition_set_and_lock(equations_source%SOURCE_FIELD,geometric_decomposition, &
1611  & err,error,*999)
1612  CALL field_geometric_field_set_and_lock(equations_source%SOURCE_FIELD,equations_set%GEOMETRY% &
1613  & geometric_field,err,error,*999)
1614  CALL field_number_of_variables_set_and_lock(equations_source%SOURCE_FIELD,1,err,error,*999)
1615  CALL field_variable_types_set_and_lock(equations_source%SOURCE_FIELD,[field_u_variable_type], &
1616  & err,error,*999)
1617  CALL field_dimension_set_and_lock(equations_source%SOURCE_FIELD,field_u_variable_type, &
1618  & field_scalar_dimension_type,err,error,*999)
1619  CALL field_data_type_set_and_lock(equations_source%SOURCE_FIELD,field_u_variable_type, &
1620  & field_dp_type,err,error,*999)
1621  number_of_source_components=1
1622  !Set the number of source components
1623  CALL field_number_of_components_set_and_lock(equations_source%SOURCE_FIELD,field_u_variable_type, &
1624  & number_of_source_components,err,error,*999)
1625  !Default the source components to the geometric interpolation setup with constant interpolation
1626  IF(equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
1627  & equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
1628  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
1629  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
1630  & equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype .OR. &
1631  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
1632  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
1633  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
1634  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
1635  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
1636  & equations_set_subtype==equations_set_constant_source_static_advec_diff_supg_subtype .OR. &
1637  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype .OR. &
1638  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
1639  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
1640  DO component_idx=1,number_of_source_components
1641  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1642  & component_idx,geometric_mesh_component,err,error,*999)
1643  CALL field_component_mesh_component_set(equations_source%SOURCE_FIELD,field_u_variable_type, &
1644  & component_idx,geometric_mesh_component,err,error,*999)
1645  CALL field_component_interpolation_set(equations_source%SOURCE_FIELD,field_u_variable_type, &
1646  & component_idx,field_node_based_interpolation,err,error,*999)
1647  ENDDO !component_idx
1648  ENDIF
1649  !Default the field scaling to that of the geometric field
1650  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
1651  CALL field_scaling_type_set(equations_source%SOURCE_FIELD,geometric_scaling_type,err,error,*999)
1652  ELSE
1653  !Check the user specified field
1654  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1655  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1656  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
1657  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
1658  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_scalar_dimension_type, &
1659  & err,error,*999)
1660  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1661  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1, &
1662  & err,error,*999)
1663  ENDIF
1664  ELSE
1665  CALL flagerror("Equations set source is not associated.",err,error,*999)
1666  ENDIF
1667  CASE(equations_set_setup_finish_action)
1668  equations_source=>equations_set%SOURCE
1669  IF(ASSOCIATED(equations_source)) THEN
1670  IF(equations_source%SOURCE_FIELD_AUTO_CREATED) THEN
1671  !Finish creating the source field
1672  CALL field_create_finish(equations_source%SOURCE_FIELD,err,error,*999)
1673  !Set the default values for the source field
1674  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1675  & number_of_dimensions,err,error,*999)
1676  IF(equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
1677  & equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
1678  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
1679  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
1680  & equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype .OR. &
1681  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
1682  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
1683  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
1684  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
1685  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
1686  & equations_set_subtype==equations_set_constant_source_static_advec_diff_supg_subtype .OR. &
1687  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype .OR. &
1688  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
1689  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
1690  number_of_source_components=1
1691  ELSE
1692  number_of_source_components=0
1693  ENDIF
1694  !Now set the source values to 1.0
1695  DO component_idx=1,number_of_source_components
1696  CALL field_component_values_initialise(equations_source%SOURCE_FIELD,field_u_variable_type, &
1697  & field_values_set_type,component_idx,1.0_dp,err,error,*999)
1698  ENDDO !component_idx
1699  ENDIF
1700  ELSE
1701  CALL flagerror("Equations set source is not associated.",err,error,*999)
1702  ENDIF
1703  CASE DEFAULT
1704  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1705  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1706  & " is invalid for a linear advection-diffusion equation."
1707  CALL flagerror(local_error,err,error,*999)
1708  END SELECT
1709  !-----------------------------------------------------------------
1710  ! I n d e p e n d e n t f i e l d
1711  !-----------------------------------------------------------------
1712  CASE(equations_set_setup_independent_type)
1713  !Setup the equations set for the advective velocity field
1714  SELECT CASE(equations_set_setup%ACTION_TYPE)
1715  CASE(equations_set_setup_start_action)
1716  equations_independent=>equations_set%INDEPENDENT
1717  IF(ASSOCIATED(equations_independent)) THEN
1718  IF(equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
1719  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
1720  IF(equations_independent%INDEPENDENT_FIELD_AUTO_CREATED) THEN
1721  !Create the auto created independent field
1722  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_independent% &
1723  & independent_field,err,error,*999)
1724  CALL field_label_set(equations_independent%INDEPENDENT_FIELD,"Independent Field",err,error,*999)
1725  CALL field_type_set_and_lock(equations_independent%INDEPENDENT_FIELD,field_general_type,err,error,*999)
1726  CALL field_dependent_type_set_and_lock(equations_independent%INDEPENDENT_FIELD, &
1727  & field_independent_type,err,error,*999)
1728  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
1729  CALL field_mesh_decomposition_set_and_lock(equations_independent%INDEPENDENT_FIELD,geometric_decomposition, &
1730  & err,error,*999)
1731  CALL field_geometric_field_set_and_lock(equations_independent%INDEPENDENT_FIELD,equations_set%GEOMETRY% &
1732  & geometric_field,err,error,*999)
1733  CALL field_number_of_variables_set_and_lock(equations_independent%INDEPENDENT_FIELD,2,err,error,*999)
1734  CALL field_variable_types_set_and_lock(equations_independent%INDEPENDENT_FIELD,[field_u_variable_type, &
1735  & field_v_variable_type],err,error,*999)
1736  CALL field_dimension_set_and_lock(equations_independent%INDEPENDENT_FIELD,field_u_variable_type, &
1737  & field_vector_dimension_type,err,error,*999)
1738  CALL field_data_type_set_and_lock(equations_independent%INDEPENDENT_FIELD,field_u_variable_type, &
1739  & field_dp_type,err,error,*999)
1740  CALL field_dimension_set_and_lock(equations_independent%INDEPENDENT_FIELD,field_v_variable_type, &
1741  & field_vector_dimension_type,err,error,*999)
1742  CALL field_data_type_set_and_lock(equations_independent%INDEPENDENT_FIELD,field_v_variable_type, &
1743  & field_dp_type,err,error,*999)
1744  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1745  & number_of_dimensions,err,error,*999)
1746  number_of_independent_u_var_components=number_of_dimensions
1747  CALL field_number_of_components_set_and_lock(equations_independent%INDEPENDENT_FIELD,field_u_variable_type, &
1748  & number_of_independent_u_var_components,err,error,*999)
1749  equations_set_field_field=>equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD
1750  CALL field_parameter_set_data_get(equations_set_field_field,field_u_variable_type, &
1751  & field_values_set_type,equations_set_field_data,err,error,*999)
1752  ncompartments=equations_set_field_data(2)
1753  number_of_independent_v_var_components=ncompartments-1
1754  !Set the number of independent components
1755  CALL field_number_of_components_set_and_lock(equations_independent%INDEPENDENT_FIELD,field_v_variable_type, &
1756  & number_of_independent_v_var_components,err,error,*999)
1757  !Default the k independent components to the geometric interpolation setup with constant interpolation
1758  DO component_idx=1,number_of_independent_u_var_components
1759  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1760  & component_idx,geometric_mesh_component,err,error,*999)
1761  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1762  & field_u_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
1763  CALL field_component_mesh_component_set(equations_independent%INDEPENDENT_FIELD,field_u_variable_type, &
1764  & component_idx,geometric_mesh_component,err,error,*999)
1765  ENDDO !component_idx
1766  DO component_idx=1,number_of_independent_v_var_components
1767  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1768  & 1,geometric_mesh_component,err,error,*999)
1769  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1770  & field_v_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
1771  CALL field_component_mesh_component_set(equations_independent%INDEPENDENT_FIELD,field_v_variable_type, &
1772  & component_idx,geometric_mesh_component,err,error,*999)
1773  ENDDO !component_idx
1774  !Default the field scaling to that of the geometric field
1775  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
1776  CALL field_scaling_type_set(equations_independent%INDEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
1777  ELSE
1778  !Check the user specified field
1779  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1780  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1781  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
1782  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_v_variable_type],&
1783  & err,error,*999)
1784  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
1785  & err,error,*999)
1786  CALL field_dimension_check(equations_set_setup%FIELD,field_v_variable_type,field_vector_dimension_type, &
1787  & err,error,*999)
1788  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1789  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_dp_type,err,error,*999)
1790  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1791  & number_of_dimensions,err,error,*999)
1792  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_dimensions, &
1793  & err,error,*999)
1794  equations_set_field_field=>equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD
1795  CALL field_parameter_set_data_get(equations_set_field_field,field_u_variable_type, &
1796  & field_values_set_type,equations_set_field_data,err,error,*999)
1797  ncompartments=equations_set_field_data(2)
1798  number_of_independent_v_var_components=ncompartments-1
1799  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
1800  & number_of_independent_v_var_components,err,error,*999)
1801  DO component_idx=1,number_of_independent_u_var_components
1802  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
1803  & field_node_based_interpolation,err,error,*999)
1804  ENDDO
1805  DO component_idx=1,number_of_independent_v_var_components
1806  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,component_idx, &
1807  & field_node_based_interpolation,err,error,*999)
1808  ENDDO
1809  ENDIF
1810  ELSE
1811  IF(equations_independent%INDEPENDENT_FIELD_AUTO_CREATED) THEN
1812  !Create the auto created independent field
1813  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_independent% &
1814  & independent_field,err,error,*999)
1815  CALL field_label_set(equations_independent%INDEPENDENT_FIELD,"Independent Field",err,error,*999)
1816  CALL field_type_set_and_lock(equations_independent%INDEPENDENT_FIELD,field_general_type,err,error,*999)
1817  CALL field_dependent_type_set_and_lock(equations_independent%INDEPENDENT_FIELD, &
1818  & field_independent_type,err,error,*999)
1819  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
1820  CALL field_mesh_decomposition_set_and_lock(equations_independent%INDEPENDENT_FIELD,geometric_decomposition, &
1821  & err,error,*999)
1822  CALL field_geometric_field_set_and_lock(equations_independent%INDEPENDENT_FIELD,equations_set%GEOMETRY% &
1823  & geometric_field,err,error,*999)
1824  CALL field_number_of_variables_set_and_lock(equations_independent%INDEPENDENT_FIELD,1,err,error,*999)
1825  CALL field_variable_types_set_and_lock(equations_independent%INDEPENDENT_FIELD,[field_u_variable_type], &
1826  & err,error,*999)
1827  CALL field_dimension_set_and_lock(equations_independent%INDEPENDENT_FIELD,field_u_variable_type, &
1828  & field_vector_dimension_type,err,error,*999)
1829  CALL field_data_type_set_and_lock(equations_independent%INDEPENDENT_FIELD,field_u_variable_type, &
1830  & field_dp_type,err,error,*999)
1831  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1832  & number_of_dimensions,err,error,*999)
1833  number_of_independent_components=number_of_dimensions
1834  !Set the number of independent components
1835  CALL field_number_of_components_set_and_lock(equations_independent%INDEPENDENT_FIELD,field_u_variable_type, &
1836  & number_of_independent_components,err,error,*999)
1837  !Default the k independent components to the geometric interpolation setup with constant interpolation
1838  DO component_idx=1,number_of_dimensions
1839  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1840  & component_idx,geometric_mesh_component,err,error,*999)
1841  CALL field_component_mesh_component_set(equations_independent%INDEPENDENT_FIELD,field_u_variable_type, &
1842  & component_idx,geometric_mesh_component,err,error,*999)
1843  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1844  & field_u_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
1845  ENDDO !component_idx
1846  !Default the field scaling to that of the geometric field
1847  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
1848  CALL field_scaling_type_set(equations_independent%INDEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
1849  ELSE
1850  !Check the user specified field
1851  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1852  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1853  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
1854  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
1855  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
1856  & err,error,*999)
1857  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1858  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1859  & number_of_dimensions,err,error,*999)
1860  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_dimensions, &
1861  & err,error,*999)
1862  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
1863  & field_node_based_interpolation,err,error,*999)
1864  ENDIF
1865  ENDIF
1866  ELSE
1867  CALL flagerror("Equations set independent is not associated.",err,error,*999)
1868  ENDIF
1869  CASE(equations_set_setup_finish_action)
1870  equations_independent=>equations_set%INDEPENDENT
1871  IF(ASSOCIATED(equations_independent)) THEN
1872  IF(equations_independent%INDEPENDENT_FIELD_AUTO_CREATED) THEN
1873  !Finish creating the independent field
1874  CALL field_create_finish(equations_independent%INDEPENDENT_FIELD,err,error,*999)
1875  !Set the default values for the independent field
1876  CALL field_parameter_set_create(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1877  & field_input_data1_set_type,err,error,*999)
1878 
1879  IF(equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
1880  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
1881 ! CALL FIELD_PARAMETER_SET_CREATE(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_V_VARIABLE_TYPE, &
1882 ! & FIELD_INPUT_DATA2_SET_TYPE,ERR,ERROR,*999)
1883  ENDIF
1884 ! CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
1885 ! & NUMBER_OF_DIMENSIONS,ERR,ERROR,*999)
1886 ! NUMBER_OF_INDEPENDENT_COMPONENTS=NUMBER_OF_DIMENSIONS
1887 ! !First set the k values to 1.0
1888 ! DO component_idx=1,NUMBER_OF_INDEPENDENT_COMPONENTS
1889 ! CALL FIELD_COMPONENT_VALUES_INITIALISE(EQUATIONS_INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
1890 ! & FIELD_VALUES_SET_TYPE,component_idx,1.0_DP,ERR,ERROR,*999)
1891 ! ENDDO !component_idx
1892  ENDIF
1893  ELSE
1894  CALL flagerror("Equations set independent is not associated.",err,error,*999)
1895  ENDIF
1896  CASE DEFAULT
1897  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1898  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1899  & " is invalid for a linear advection-diffusion equation."
1900  CALL flagerror(local_error,err,error,*999)
1901  END SELECT
1902  !-----------------------------------------------------------------
1903  ! A n a l y t i c f i e l d
1904  !-----------------------------------------------------------------
1905  CASE(equations_set_setup_analytic_type)
1906  SELECT CASE(equations_set_setup%ACTION_TYPE)
1907  CASE(equations_set_setup_start_action)
1908  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
1909  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
1910  IF(ASSOCIATED(dependent_field)) THEN
1911  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
1912  IF(ASSOCIATED(geometric_field)) THEN
1913  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
1914  SELECT CASE(equations_set_setup%ANALYTIC_FUNCTION_TYPE)
1915  CASE(equations_set_advection_diffusion_equation_two_dim_1)
1916  IF(number_of_dimensions/=2) THEN
1917  local_error="The number of geometric dimensions of "// &
1918  & trim(number_to_vstring(number_of_dimensions,"*",err,error))// &
1919  & " is invalid. The analytic function type of "// &
1920  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
1921  & " requires that there be 2 geometric dimensions."
1922  CALL flagerror(local_error,err,error,*999)
1923  ENDIF
1924  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE= &
1925  & equations_set_advection_diffusion_equation_two_dim_1
1926  CASE DEFAULT
1927  local_error="The specified analytic function type of "// &
1928  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
1929  & " is invalid for a linear advection-diffusion equation."
1930  CALL flagerror(local_error,err,error,*999)
1931  END SELECT
1932  ELSE
1933  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
1934  ENDIF
1935  ELSE
1936  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
1937  ENDIF
1938  ELSE
1939  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
1940  ENDIF
1941  CASE(equations_set_setup_finish_action)
1942  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
1943  analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
1944  IF(ASSOCIATED(analytic_field)) THEN
1945  IF(equations_set%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED) THEN
1946  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
1947  ENDIF
1948  ENDIF
1949  ELSE
1950  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
1951  ENDIF
1952  CASE DEFAULT
1953  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1954  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1955  & " is invalid for a linear advection-diffusion equation."
1956  CALL flagerror(local_error,err,error,*999)
1957  END SELECT
1958  !-----------------------------------------------------------------
1959  ! E q u a t i o n s t y p e
1960  !-----------------------------------------------------------------
1961  CASE(equations_set_setup_equations_type)
1962  SELECT CASE(equations_set_setup%ACTION_TYPE)
1963  CASE(equations_set_setup_start_action)
1964  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
1965  CALL equations_create_start(equations_set,equations,err,error,*999)
1966  CALL equations_linearity_type_set(equations,equations_linear,err,error,*999)
1967  IF(equations_set_subtype==equations_set_no_source_advection_diffusion_subtype .OR. &
1968  & equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
1969  & equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
1970  & equations_set_subtype==equations_set_no_source_ale_advection_diffusion_subtype .OR. &
1971  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
1972  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
1973  & equations_set_subtype==equations_set_no_source_advection_diff_supg_subtype .OR. &
1974  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
1975  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
1976  & equations_set_subtype==equations_set_no_source_ale_advection_diff_supg_subtype .OR. &
1977  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
1978  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
1979  & equations_set_subtype==equations_set_coupled_source_diffusion_advec_diffusion_subtype .OR. &
1980  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
1981  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
1982  CALL equations_time_dependence_type_set(equations,equations_first_order_dynamic,err,error,*999)
1983  ELSEIF(equations_set_subtype==equations_set_no_source_static_advec_diff_subtype .OR. &
1984  & equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype .OR. &
1985  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
1986  & equations_set_subtype==equations_set_no_source_static_advec_diff_supg_subtype .OR. &
1987  & equations_set_subtype==equations_set_constant_source_static_advec_diff_supg_subtype .OR. &
1988  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype) THEN
1989  CALL equations_time_dependence_type_set(equations,equations_static,err,error,*999)
1990  ELSE
1991  CALL flagerror("Equations set subtype not valid.",err,error,*999)
1992  ENDIF
1993  ELSE
1994  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
1995  ENDIF
1996  CASE(equations_set_setup_finish_action)
1997  SELECT CASE(equations_set%SOLUTION_METHOD)
1998  CASE(equations_set_fem_solution_method)
1999  IF(equations_set_subtype==equations_set_no_source_advection_diffusion_subtype .OR. &
2000  & equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
2001  & equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
2002  & equations_set_subtype==equations_set_no_source_ale_advection_diffusion_subtype .OR. &
2003  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
2004  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
2005  & equations_set_subtype==equations_set_no_source_advection_diff_supg_subtype .OR. &
2006  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
2007  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
2008  & equations_set_subtype==equations_set_no_source_ale_advection_diff_supg_subtype .OR. &
2009  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
2010  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
2011  & equations_set_subtype==equations_set_coupled_source_diffusion_advec_diffusion_subtype .OR. &
2012  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
2013  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
2014  !Finish the equations
2015  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
2016  CALL equations_create_finish(equations,err,error,*999)
2017  !Create the equations mapping.
2018  SELECT CASE(equations_set_subtype)
2019  CASE(equations_set_no_source_advection_diffusion_subtype,equations_set_constant_source_advection_diffusion_subtype,&
2020  & equations_set_linear_source_advection_diffusion_subtype,equations_set_no_source_ale_advection_diffusion_subtype,&
2021  & equations_set_constant_source_ale_advection_diffusion_subtype,&
2022  & equations_set_linear_source_ale_advection_diffusion_subtype,&
2023  & equations_set_no_source_advection_diff_supg_subtype,&
2024  & equations_set_constant_source_advection_diff_supg_subtype,&
2025  & equations_set_linear_source_advection_diff_supg_subtype,&
2026  & equations_set_no_source_ale_advection_diff_supg_subtype,&
2027  & equations_set_constant_source_ale_advection_diff_supg_subtype,&
2028  & equations_set_linear_source_ale_advection_diff_supg_subtype,&
2029  & equations_set_coupled_source_diffusion_advec_diffusion_subtype)
2030  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
2031  CALL equations_mapping_dynamic_matrices_set(equations_mapping,.true.,.true.,err,error,*999)
2032  CALL equations_mapping_dynamic_variable_type_set(equations_mapping,field_u_variable_type,err,error,*999)
2033  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
2034  IF(equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
2035  & equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
2036  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
2037  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
2038  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
2039  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
2040  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
2041  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
2042  & equations_set_subtype==equations_set_coupled_source_diffusion_advec_diffusion_subtype) THEN
2043  CALL equations_mapping_source_variable_type_set(equations_mapping,field_u_variable_type,err,error,*999)
2044  ENDIF
2045  CASE(equations_set_multi_comp_transport_advec_diff_subtype, &
2046  & equations_set_multi_comp_transport_advec_diff_supg_subtype)
2047  equations_set_field_field=>equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD
2048  CALL field_parameter_set_data_get(equations_set_field_field,field_u_variable_type, &
2049  & field_values_set_type,equations_set_field_data,err,error,*999)
2050  imy_matrix = equations_set_field_data(1)
2051  ncompartments = equations_set_field_data(2)
2052  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
2053  CALL equations_mapping_dynamic_matrices_set(equations_mapping,.true.,.true.,err,error,*999)
2054  CALL equationsmapping_linearmatricesnumberset(equations_mapping,ncompartments-1,err,error,*999)
2055 
2056  ALLOCATE(variable_types(2*ncompartments))
2057  ALLOCATE(variable_u_types(ncompartments-1))
2058  DO num_var=1,ncompartments
2059  variable_types(2*num_var-1)=field_u_variable_type+(field_number_of_variable_subtypes*(num_var-1))
2060  variable_types(2*num_var)=field_deludeln_variable_type+(field_number_of_variable_subtypes*(num_var-1))
2061  ENDDO
2062  num_var_count=0
2063  DO num_var=1,ncompartments
2064  IF(num_var/=imy_matrix)THEN
2065  num_var_count=num_var_count+1
2066  variable_u_types(num_var_count)=variable_types(2*num_var-1)
2067  ENDIF
2068  ENDDO
2069  CALL equations_mapping_dynamic_variable_type_set(equations_mapping,variable_types(2*imy_matrix-1),err,error,*999)
2070  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,variable_u_types,err,error,*999)
2071  CALL equations_mapping_rhs_variable_type_set(equations_mapping,variable_types(2*imy_matrix),err,error,*999)
2072  CALL equations_mapping_source_variable_type_set(equations_mapping,field_u_variable_type,err,error,*999)
2073  END SELECT
2074  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
2075  !Create the equations matrices
2076  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
2077  !Set up matrix storage and structure
2078  IF(equations%LUMPING_TYPE==equations_lumped_matrices) THEN
2079  !Set up lumping
2080  CALL equations_matrices_dynamic_lumping_type_set(equations_matrices, &
2081  & [equations_matrix_unlumped,equations_matrix_lumped],err,error,*999)
2082  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
2083  & [distributed_matrix_compressed_row_storage_type,distributed_matrix_diagonal_storage_type],err,error,*999)
2084  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
2085  [equations_matrix_fem_structure,equations_matrix_diagonal_structure],err,error,*999)
2086  ELSE
2087  SELECT CASE(equations%SPARSITY_TYPE)
2088  CASE(equations_matrices_full_matrices)
2089  CALL equations_matrices_linear_storage_type_set(equations_matrices, &
2090  & [distributed_matrix_block_storage_type,distributed_matrix_block_storage_type],err,error,*999)
2091  CASE(equations_matrices_sparse_matrices)
2092  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
2093  & [distributed_matrix_compressed_row_storage_type,distributed_matrix_compressed_row_storage_type], &
2094  & err,error,*999)
2095  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
2096  [equations_matrix_fem_structure,equations_matrix_fem_structure],err,error,*999)
2097  IF(equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
2098  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype)THEN
2099  ALLOCATE(coupling_matrix_storage_type(ncompartments-1))
2100  ALLOCATE(coupling_matrix_structure_type(ncompartments-1))
2101  DO num_var=1,ncompartments-1
2102  coupling_matrix_storage_type(num_var)=distributed_matrix_compressed_row_storage_type
2103  coupling_matrix_structure_type(num_var)=equations_matrix_fem_structure
2104  ENDDO
2105  CALL equations_matrices_linear_storage_type_set(equations_matrices, &
2106  & coupling_matrix_storage_type, &
2107  & err,error,*999)
2108  CALL equationsmatrices_linearstructuretypeset(equations_matrices, &
2109  coupling_matrix_structure_type,err,error,*999)
2110  ENDIF
2111  CASE DEFAULT
2112  local_error="The equations matrices sparsity type of "// &
2113  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
2114  CALL flagerror(local_error,err,error,*999)
2115  END SELECT
2116  ENDIF
2117  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
2118  ELSE IF(equations_set_subtype==equations_set_no_source_static_advec_diff_subtype .OR. &
2119  & equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype .OR. &
2120  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
2121  & equations_set_subtype==equations_set_no_source_static_advec_diff_supg_subtype .OR. &
2122  & equations_set_subtype==equations_set_constant_source_static_advec_diff_supg_subtype .OR. &
2123  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype) THEN
2124  !Finish the creation of the equations
2125  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
2126  CALL equations_create_finish(equations,err,error,*999)
2127  !Create the equations mapping.
2128  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
2129  CALL equationsmapping_linearmatricesnumberset(equations_mapping,1,err,error,*999)
2130  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,[field_u_variable_type], &
2131  & err,error,*999)
2132  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
2133  IF(equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype .OR. &
2134  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
2135  & equations_set_subtype==equations_set_constant_source_static_advec_diff_supg_subtype .OR. &
2136  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype) THEN
2137  CALL equations_mapping_source_variable_type_set(equations_mapping,field_u_variable_type,err,error,*999)
2138  ENDIF
2139  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
2140  !Create the equations matrices
2141  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
2142  SELECT CASE(equations%SPARSITY_TYPE)
2143  CASE(equations_matrices_full_matrices)
2144  CALL equations_matrices_linear_storage_type_set(equations_matrices,[matrix_block_storage_type], &
2145  & err,error,*999)
2146  CASE(equations_matrices_sparse_matrices)
2147  CALL equations_matrices_linear_storage_type_set(equations_matrices,[matrix_compressed_row_storage_type], &
2148  & err,error,*999)
2149  CALL equationsmatrices_linearstructuretypeset(equations_matrices,[equations_matrix_fem_structure], &
2150  & err,error,*999)
2151  CASE DEFAULT
2152  local_error="The equations matrices sparsity type of "// &
2153  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
2154  CALL flagerror(local_error,err,error,*999)
2155  END SELECT
2156  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
2157  ENDIF
2158  CASE(equations_set_bem_solution_method)
2159  CALL flagerror("Not implemented.",err,error,*999)
2160  CASE(equations_set_fd_solution_method)
2161  CALL flagerror("Not implemented.",err,error,*999)
2162  CASE(equations_set_fv_solution_method)
2163  CALL flagerror("Not implemented.",err,error,*999)
2164  CASE(equations_set_gfem_solution_method)
2165  CALL flagerror("Not implemented.",err,error,*999)
2166  CASE(equations_set_gfv_solution_method)
2167  CALL flagerror("Not implemented.",err,error,*999)
2168  CASE DEFAULT
2169  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
2170  & " is invalid."
2171  CALL flagerror(local_error,err,error,*999)
2172  END SELECT
2173  CASE DEFAULT
2174  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2175  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2176  & " is invalid for a linear advection-diffusion equation."
2177  CALL flagerror(local_error,err,error,*999)
2178  END SELECT
2179  CASE DEFAULT
2180  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2181  & " is invalid for a linear advection-diffusion equation."
2182  CALL flagerror(local_error,err,error,*999)
2183  END SELECT
2184  ELSE
2185  local_error="The equations set subtype of "//trim(number_to_vstring(equations_set_subtype,"*",err,error))// &
2186  & " is not a linear advection-diffusion equation subtype."
2187  CALL flagerror(local_error,err,error,*999)
2188  ENDIF
2189  ELSE
2190  CALL flagerror("Equations set is not associated.",err,error,*999)
2191  ENDIF
2192 
2193  exits("AdvectionDiffusion_EquationsSetLinearSetup")
2194  RETURN
2195 999 errors("AdvectionDiffusion_EquationsSetLinearSetup",err,error)
2196  exits("AdvectionDiffusion_EquationsSetLinearSetup")
2197  RETURN 1
2198 
2199  END SUBROUTINE advectiondiffusion_equationssetlinearsetup
2200 
2201  !
2202  !===============================================================================================================================
2203  !
2204 ! SUBROUTINE ADVECTION_DIFFUSION_EQUATION_EQUATIONS_SET_NONLINEAR_SETUP(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
2205 ! !Argument variables
2206 ! TYPE(EQUATIONS_SET_TYPE), POINTER :: EQUATIONS_SET !<A pointer to the equations set to setup
2207 ! TYPE(EQUATIONS_SET_SETUP_TYPE), INTENT(INOUT) :: EQUATIONS_SET_SETUP !<The equations set setup information
2208 ! INTEGER(INTG), INTENT(OUT) :: ERR !<The error code
2209 ! TYPE(VARYING_STRING), INTENT(OUT) :: ERROR !<The error string
2210 !
2211 ! CALL FlagError("Not implemented.",ERR,ERROR,*999)
2212 ! EXITS("ADVECTION_DIFFUSION_EQUATION_EQUATIONS_SET_NONLINEAR_SETUP")
2213 ! RETURN
2214 ! 999 ERRORSEXITS("ADVECTION_DIFFUSION_EQUATION_EQUATIONS_SET_NONLINEAR_SETUP",ERR,ERROR)
2215 ! RETURN 1
2216 !
2217 ! END SUBROUTINE ADVECTION_DIFFUSION_EQUATION_EQUATIONS_SET_NONLINEAR_SETUP
2218 
2219  !
2220  !================================================================================================================================
2221  !
2222 
2224  SUBROUTINE advection_diffusion_equation_problem_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
2225 
2226  !Argument variables
2227  TYPE(problem_type), POINTER :: PROBLEM
2228  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
2229  INTEGER(INTG), INTENT(OUT) :: ERR
2230  TYPE(varying_string), INTENT(OUT) :: ERROR
2231  !Local Variables
2232  TYPE(varying_string) :: LOCAL_ERROR
2233 
2234  enters("ADVECTION_DIFFUSION_EQUATION_PROBLEM_SETUP",err,error,*999)
2235 
2236  IF(ASSOCIATED(problem)) THEN
2237  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
2238  CALL flagerror("Problem specification is not allocated.",err,error,*999)
2239  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
2240  CALL flagerror("Problem specification does not have a subtype set.",err,error,*999)
2241  END IF
2242  SELECT CASE(problem%SPECIFICATION(3))
2243  CASE(problem_no_source_advection_diffusion_subtype)
2244  CALL advectiondiffusion_problemlinearsetup(problem,problem_setup,err,error,*999)
2245  CASE(problem_linear_source_advection_diffusion_subtype)
2246  CALL advectiondiffusion_problemlinearsetup(problem,problem_setup,err,error,*999)
2247  CASE(problem_nonlinear_source_advection_diffusion_subtype)
2248  CALL flagerror("Not implemented.",err,error,*999)
2249 ! CALL ADVECTION_DIFFUSION_EQUATION_PROBLEM_NONLINEAR_SETUP(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*999)
2250  CASE(problem_no_source_ale_advection_diffusion_subtype)
2251  CALL advectiondiffusion_problemlinearsetup(problem,problem_setup,err,error,*999)
2252  CASE(problem_linear_source_ale_advection_diffusion_subtype)
2253  CALL advectiondiffusion_problemlinearsetup(problem,problem_setup,err,error,*999)
2254  CASE(problem_nonlinear_source_ale_advection_diffusion_subtype)
2255  CALL flagerror("Not implemented.",err,error,*999)
2256 ! CALL ADVECTION_DIFFUSION_EQUATION_PROBLEM_NONLINEAR_SETUP(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*999)
2257  CASE(problem_no_source_static_advec_diff_subtype)
2258  CALL advectiondiffusion_problemlinearsetup(problem,problem_setup,err,error,*999)
2259  CASE(problem_linear_source_static_advec_diff_subtype)
2260  CALL advectiondiffusion_problemlinearsetup(problem,problem_setup,err,error,*999)
2261  CASE(problem_nonlinear_source_static_advec_diff_subtype)
2262  CALL flagerror("Not implemented.",err,error,*999)
2263 ! CALL ADVECTION_DIFFUSION_EQUATION_PROBLEM_NONLINEAR_SETUP(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*999)
2264  CASE DEFAULT
2265  local_error="Problem subtype "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
2266  & " is not valid for an advection-diffusion equation type of a classical field problem class."
2267  CALL flagerror(local_error,err,error,*999)
2268  END SELECT
2269  ELSE
2270  CALL flagerror("Problem is not associated.",err,error,*999)
2271  ENDIF
2272 
2273  exits("ADVECTION_DIFFUSION_EQUATION_PROBLEM_SETUP")
2274  RETURN
2275 999 errorsexits("ADVECTION_DIFFUSION_EQUATION_PROBLEM_SETUP",err,error)
2276  RETURN 1
2277  END SUBROUTINE advection_diffusion_equation_problem_setup
2278 
2279  !
2280  !================================================================================================================================
2281  !
2282 
2284  SUBROUTINE advectiondiffusion_finiteelementcalculate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
2285 
2286  !Argument variables
2287  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2288  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
2289  INTEGER(INTG), INTENT(OUT) :: ERR
2290  TYPE(varying_string), INTENT(OUT) :: ERROR
2291  !Local Variables
2292  INTEGER(INTG) mh,mhs,ms,ng,nh,nhs,ni,nj,ns,FIELD_VAR_TYPE,my_compartment,Ncompartments,imatrix,num_var_count
2293  INTEGER(INTG) :: MESH_COMPONENT_1, MESH_COMPONENT_2
2294  REAL(DP) :: C_PARAM,K_PARAM,RWG,SUM,PGMJ(3),PGNJ(3),ADVEC_VEL,A_PARAM,COUPLING_PARAM,PGM,PGN
2295  TYPE(basis_type), POINTER :: DEPENDENT_BASIS,GEOMETRIC_BASIS
2296  TYPE(basis_type), POINTER :: DEPENDENT_BASIS_1, DEPENDENT_BASIS_2
2297  TYPE(equations_type), POINTER :: EQUATIONS
2298  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2299  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
2300  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
2301  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
2302  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
2303  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
2304  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
2305  TYPE(equations_matrices_source_type), POINTER :: SOURCE_VECTOR
2306  TYPE(equations_matrix_type), POINTER :: DAMPING_MATRIX,STIFFNESS_MATRIX
2307  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD,SOURCE_FIELD,INDEPENDENT_FIELD,EQUATIONS_SET_FIELD
2308  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE,GEOMETRIC_VARIABLE
2309  TYPE(field_variable_ptr_type) :: FIELD_VARIABLES(99)
2310  TYPE(equations_matrix_ptr_type) :: COUPLING_MATRICES(99)
2311  INTEGER(INTG) :: FIELD_VAR_TYPES(99)
2312  TYPE(quadrature_scheme_type), POINTER :: QUADRATURE_SCHEME
2313  TYPE(quadrature_scheme_type), POINTER :: QUADRATURE_SCHEME_1, QUADRATURE_SCHEME_2
2314  TYPE(varying_string) :: LOCAL_ERROR
2315  TYPE(field_interpolation_parameters_type), POINTER :: DIFFUSION_DEPENDENT_PREVIOUS_INTERPOLATION_PARAMETERS
2316  TYPE(field_interpolated_point_type), POINTER :: DIFFUSION_DEPENDENT_PREVIOUS_INTERPOLATED_POINT
2317  INTEGER(INTG), POINTER :: EQUATIONS_SET_FIELD_DATA(:)
2318  LOGICAL :: UPDATE_DAMPING_MATRIX,UPDATE_STIFFNESS_MATRIX,UPDATE_RHS_VECTOR,UPDATE_SOURCE_VECTOR
2319  INTEGER(INTG) :: EQUATIONS_SET_SUBTYPE
2320 
2321  update_damping_matrix = .false.
2322  update_stiffness_matrix = .false.
2323  update_rhs_vector = .false.
2324  update_source_vector = .false.
2325 
2326  enters("AdvectionDiffusion_FiniteElementCalculate",err,error,*999)
2327 
2328  IF(ASSOCIATED(equations_set)) THEN
2329  equations=>equations_set%EQUATIONS
2330 
2331  IF(ASSOCIATED(equations)) THEN
2332  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
2333  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
2334  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<3) THEN
2335  CALL flagerror("Equations set specification does not have a subtype set.",err,error,*999)
2336  END IF
2337  equations_set_subtype=equations_set%SPECIFICATION(3)
2338  SELECT CASE(equations_set_subtype)
2339  CASE(equations_set_no_source_advection_diffusion_subtype,equations_set_constant_source_advection_diffusion_subtype, &
2340  & equations_set_linear_source_advection_diffusion_subtype, &
2341  & equations_set_no_source_ale_advection_diffusion_subtype,equations_set_constant_source_ale_advection_diffusion_subtype, &
2342  & equations_set_linear_source_ale_advection_diffusion_subtype, &
2343  & equations_set_no_source_static_advec_diff_subtype, &
2344  & equations_set_constant_source_static_advec_diff_subtype, &
2345  & equations_set_linear_source_static_advec_diff_subtype, &
2346  & equations_set_no_source_advection_diff_supg_subtype, &
2347  & equations_set_constant_source_advection_diff_supg_subtype, &
2348  & equations_set_linear_source_advection_diff_supg_subtype, &
2349  & equations_set_no_source_ale_advection_diff_supg_subtype, &
2350  & equations_set_constant_source_ale_advection_diff_supg_subtype, &
2351  & equations_set_linear_source_ale_advection_diff_supg_subtype, &
2352  & equations_set_no_source_static_advec_diff_supg_subtype, &
2353  & equations_set_constant_source_static_advec_diff_supg_subtype, &
2354  & equations_set_linear_source_static_advec_diff_supg_subtype, &
2355  & equations_set_coupled_source_diffusion_advec_diffusion_subtype, &
2356  & equations_set_multi_comp_transport_advec_diff_subtype, &
2357  & equations_set_multi_comp_transport_advec_diff_supg_subtype)
2358  !Store all these in equations matrices/somewhere else?????
2359  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
2360  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
2361  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
2362  independent_field=>equations%INTERPOLATION%INDEPENDENT_FIELD!Stores the advective velocity field
2363  IF(equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
2364  & equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
2365  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
2366  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
2367  & equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype .OR. &
2368  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
2369  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
2370  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
2371  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
2372  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
2373  & equations_set_subtype==equations_set_constant_source_static_advec_diff_supg_subtype .OR. &
2374  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype .OR. &
2375  & equations_set_subtype==equations_set_coupled_source_diffusion_advec_diffusion_subtype .OR. &
2376  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
2377  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
2378  source_field=>equations%INTERPOLATION%SOURCE_FIELD
2379  ENDIF
2380  equations_matrices=>equations%EQUATIONS_MATRICES
2381  IF(equations_set_subtype==equations_set_no_source_advection_diffusion_subtype .OR. &
2382  & equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
2383  & equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
2384  & equations_set_subtype==equations_set_no_source_ale_advection_diffusion_subtype .OR. &
2385  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
2386  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
2387  & equations_set_subtype==equations_set_no_source_advection_diff_supg_subtype .OR. &
2388  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
2389  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
2390  & equations_set_subtype==equations_set_no_source_ale_advection_diff_supg_subtype .OR. &
2391  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
2392  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
2393  & equations_set_subtype==equations_set_coupled_source_diffusion_advec_diffusion_subtype .OR. &
2394  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
2395  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
2396  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
2397  stiffness_matrix=>dynamic_matrices%MATRICES(1)%PTR
2398  damping_matrix=>dynamic_matrices%MATRICES(2)%PTR
2399  ELSEIF(equations_set_subtype==equations_set_no_source_static_advec_diff_subtype .OR. &
2400  & equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype .OR. &
2401  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
2402  & equations_set_subtype==equations_set_no_source_static_advec_diff_supg_subtype .OR. &
2403  & equations_set_subtype==equations_set_constant_source_static_advec_diff_supg_subtype .OR. &
2404  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype) THEN
2405  linear_matrices=>equations_matrices%LINEAR_MATRICES
2406  stiffness_matrix=>linear_matrices%MATRICES(1)%PTR
2407  ELSE
2408 
2409  ENDIF
2410  rhs_vector=>equations_matrices%RHS_VECTOR
2411  IF(equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
2412  & equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
2413  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
2414  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
2415  & equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype .OR. &
2416  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
2417  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
2418  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
2419  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
2420  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
2421  & equations_set_subtype==equations_set_constant_source_static_advec_diff_supg_subtype .OR. &
2422  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype .OR. &
2423  & equations_set_subtype==equations_set_coupled_source_diffusion_advec_diffusion_subtype .OR. &
2424  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
2425  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
2426  source_vector=>equations_matrices%SOURCE_VECTOR
2427  ENDIF
2428  IF(equations_set_subtype==equations_set_no_source_advection_diffusion_subtype .OR. &
2429  & equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
2430  & equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
2431  & equations_set_subtype==equations_set_no_source_ale_advection_diffusion_subtype .OR. &
2432  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
2433  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
2434  & equations_set_subtype==equations_set_no_source_advection_diff_supg_subtype .OR. &
2435  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
2436  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
2437  & equations_set_subtype==equations_set_no_source_ale_advection_diff_supg_subtype .OR. &
2438  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
2439  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
2440  & equations_set_subtype==equations_set_coupled_source_diffusion_advec_diffusion_subtype .OR. &
2441  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
2442  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
2443  IF(ASSOCIATED(damping_matrix)) update_damping_matrix=damping_matrix%UPDATE_MATRIX
2444  ENDIF
2445  IF(ASSOCIATED(stiffness_matrix)) update_stiffness_matrix=stiffness_matrix%UPDATE_MATRIX
2446  IF(ASSOCIATED(rhs_vector)) update_rhs_vector=rhs_vector%UPDATE_VECTOR
2447  IF(equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
2448  & equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
2449  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
2450  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
2451  & equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype .OR. &
2452  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
2453  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
2454  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
2455  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
2456  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
2457  & equations_set_subtype==equations_set_constant_source_static_advec_diff_supg_subtype .OR. &
2458  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype .OR. &
2459  & equations_set_subtype==equations_set_coupled_source_diffusion_advec_diffusion_subtype .OR. &
2460  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
2461  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
2462  IF(ASSOCIATED(source_vector)) update_source_vector=source_vector%UPDATE_VECTOR
2463  ENDIF
2464  equations_mapping=>equations%EQUATIONS_MAPPING
2465  IF(equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
2466  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
2467  equations_set_field=>equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD
2468  CALL field_parameter_set_data_get(equations_set_field,field_u_variable_type, &
2469  & field_values_set_type,equations_set_field_data,err,error,*999)
2470  my_compartment = equations_set_field_data(1)
2471  ncompartments = equations_set_field_data(2)
2472  linear_matrices=>equations_matrices%LINEAR_MATRICES
2473  linear_mapping=>equations_mapping%LINEAR_MAPPING
2474  num_var_count=0
2475  DO imatrix = 1,ncompartments
2476  IF(imatrix/=my_compartment)THEN
2477  num_var_count=num_var_count+1
2478  coupling_matrices(num_var_count)%PTR=>linear_matrices%MATRICES(num_var_count)%PTR
2479  field_variables(num_var_count)%PTR=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(num_var_count)%VARIABLE
2480  field_var_types(num_var_count)=field_variables(num_var_count)%PTR%VARIABLE_TYPE
2481  coupling_matrices(num_var_count)%PTR%ELEMENT_MATRIX%MATRIX=0.0_dp
2482  ENDIF
2483  END DO
2484  ENDIF
2485  IF(equations_set_subtype==equations_set_no_source_advection_diffusion_subtype .OR. &
2486  & equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
2487  & equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
2488  & equations_set_subtype==equations_set_no_source_ale_advection_diffusion_subtype .OR. &
2489  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
2490  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
2491  & equations_set_subtype==equations_set_no_source_advection_diff_supg_subtype .OR. &
2492  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
2493  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
2494  & equations_set_subtype==equations_set_no_source_ale_advection_diff_supg_subtype .OR. &
2495  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
2496  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
2497  & equations_set_subtype==equations_set_coupled_source_diffusion_advec_diffusion_subtype .OR. &
2498  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
2499  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
2500  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
2501  field_variable=>dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(1)%VARIABLE
2502  ELSEIF(equations_set_subtype==equations_set_no_source_static_advec_diff_subtype .OR. &
2503  & equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype .OR. &
2504  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
2505  & equations_set_subtype==equations_set_no_source_static_advec_diff_supg_subtype .OR. &
2506  & equations_set_subtype==equations_set_constant_source_static_advec_diff_supg_subtype .OR. &
2507  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype) THEN
2508  linear_mapping=>equations_mapping%LINEAR_MAPPING
2509  field_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(1)%VARIABLE
2510  ELSE
2511 
2512  ENDIF
2513  field_var_type=field_variable%VARIABLE_TYPE
2514  geometric_variable=>geometric_field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
2515  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
2516  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2517  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
2518  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2519  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
2520  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
2521  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
2522  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
2523  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
2524  IF(equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype) THEN
2525  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
2526  & materials_interp_parameters(field_v_variable_type)%PTR,err,error,*999)
2527  ENDIF
2528 
2529  IF(equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
2530  & equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
2531  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
2532  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
2533  & equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype .OR. &
2534  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
2535  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
2536  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
2537  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
2538  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
2539  & equations_set_subtype==equations_set_constant_source_static_advec_diff_supg_subtype .OR. &
2540  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype .OR. &
2541  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype .OR. &
2542  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_supg_subtype) THEN
2543  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
2544  & source_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
2545  ENDIF
2546  !the following line has been changed to use fieldinputdata1settype
2547  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
2548  & independent_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
2549  IF(equations_set_subtype==equations_set_coupled_source_diffusion_advec_diffusion_subtype) THEN
2550  diffusion_dependent_previous_interpolation_parameters=> &
2551  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_v_variable_type)%PTR
2552  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number, &
2553  & diffusion_dependent_previous_interpolation_parameters,err,error,*999)
2554  diffusion_dependent_previous_interpolated_point=> &
2555  & equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_v_variable_type)%PTR
2556  ENDIF
2557 
2558 
2559  !Select whether using standard Galerkin scheme, or the stabilised streamwise-upwinding Petrov-Galerkin scheme
2560  SELECT CASE(equations_set_subtype)
2561  CASE(equations_set_no_source_advection_diffusion_subtype,equations_set_constant_source_advection_diffusion_subtype, &
2562  & equations_set_linear_source_advection_diffusion_subtype, &
2563  & equations_set_no_source_ale_advection_diffusion_subtype,&
2564  & equations_set_constant_source_ale_advection_diffusion_subtype, &
2565  & equations_set_linear_source_ale_advection_diffusion_subtype, &
2566  & equations_set_no_source_static_advec_diff_subtype, &
2567  & equations_set_constant_source_static_advec_diff_subtype, &
2568  & equations_set_linear_source_static_advec_diff_subtype , &
2569  & equations_set_coupled_source_diffusion_advec_diffusion_subtype, &
2570  & equations_set_multi_comp_transport_advec_diff_subtype)
2571  !Loop over gauss points
2572  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
2573  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
2574  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
2575  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
2576  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
2577  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
2578  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
2579  !Interpolate to get the advective velocity
2580  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
2581  & independent_interp_point(field_u_variable_type)%PTR,err,error,*999)
2582  IF(equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
2583  & equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
2584  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
2585  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
2586  & equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype .OR. &
2587  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
2588  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype) THEN
2589  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
2590  & source_interp_point(field_u_variable_type)%PTR,err,error,*999)
2591  ENDIF
2592  IF(equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype) THEN
2593  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
2594  & materials_interp_point(field_v_variable_type)%PTR,err,error,*999)
2595  ENDIF
2596  !Calculate RWG.
2597 !!TODO: Think about symmetric problems.
2598  rwg=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
2599  & quadrature_scheme%GAUSS_WEIGHTS(ng)
2600  !Loop over field components
2601 
2602  mhs=0
2603  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
2604  !Loop over element rows
2605  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2606  mhs=mhs+1
2607  nhs=0
2608  IF(update_stiffness_matrix .OR. update_damping_matrix) THEN
2609  !Loop over element columns
2610  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
2611  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2612  nhs=nhs+1
2613  IF(update_stiffness_matrix) THEN
2614  sum=0.0_dp
2615  DO nj=1,geometric_variable%NUMBER_OF_COMPONENTS
2616  pgmj(nj)=0.0_dp
2617  pgnj(nj)=0.0_dp
2618  DO ni=1,dependent_basis%NUMBER_OF_XI
2619  pgmj(nj)=pgmj(nj)+ &
2620  & quadrature_scheme%GAUSS_BASIS_FNS(ms,partial_derivative_first_derivative_map(ni),ng)* &
2621  & equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%DXI_DX(ni,nj)
2622  pgnj(nj)=pgnj(nj)+ &
2623  & quadrature_scheme%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(ni),ng)* &
2624  & equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%DXI_DX(ni,nj)
2625  ENDDO !ni
2626  k_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR% &
2627  & values(nj,no_part_deriv)
2628  sum=sum+k_param*pgmj(nj)*pgnj(nj)
2629  !Advection term is constructed here and then added to SUM for updating the stiffness matrix outside of this loop
2630  advec_vel=equations%INTERPOLATION%INDEPENDENT_INTERP_POINT(field_u_variable_type)%PTR% &
2631  & values(nj,no_part_deriv)
2632  sum=sum+advec_vel*quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)*pgnj(nj)
2633  ENDDO !nj
2634  IF (equations_set_subtype==equations_set_no_source_advection_diffusion_subtype .OR. &
2635  & equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
2636  & equations_set_subtype==equations_set_no_source_ale_advection_diffusion_subtype .OR. &
2637  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
2638  & equations_set_subtype==equations_set_no_source_static_advec_diff_subtype .OR. &
2639  & equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype) THEN
2640  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*rwg
2641  ELSEIF(equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
2642  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
2643  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
2644  & equations_set_subtype==equations_set_coupled_source_diffusion_advec_diffusion_subtype) THEN
2645  a_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR% &
2646  & values(geometric_variable%NUMBER_OF_COMPONENTS,no_part_deriv)
2647  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*rwg- &
2648  & a_param*quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)* &
2649  & quadrature_scheme%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)*rwg
2650  ! A_PARAM is the material parameter that multiplies the linear source u
2651  ELSEIF(equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype) THEN
2652  !for multi-compartment model must include additional terms into the
2653  coupling_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)%PTR% &
2654  & values(my_compartment,no_part_deriv)
2655  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+ &
2656  & sum*rwg + quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)* &
2657  & quadrature_scheme%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)*rwg*coupling_param
2658  ENDIF
2659  ENDIF
2660  IF(equations_set_subtype==equations_set_no_source_advection_diffusion_subtype .OR. &
2661  & equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
2662  & equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
2663  & equations_set_subtype==equations_set_no_source_ale_advection_diffusion_subtype .OR. &
2664  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
2665  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
2666  & equations_set_subtype==equations_set_coupled_source_diffusion_advec_diffusion_subtype .OR. &
2667  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype) THEN
2668  IF(update_damping_matrix) THEN
2669  damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+ &
2670  & quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)* &
2671  & quadrature_scheme%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)*rwg
2672  ENDIF
2673  ENDIF
2674  ENDDO !ns
2675  ENDDO !nh
2676  ENDIF
2677  ENDDO !ms
2678  ENDDO !mh
2679  IF(equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
2680  & equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
2681  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
2682  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
2683  & equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype .OR. &
2684  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
2685  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype) THEN
2686  IF(update_source_vector) THEN
2687  c_param=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1, no_part_deriv)
2688  mhs=0
2689  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
2690  !DO mh=1,DEPENDENT_VARIABLE%NUMBER_OF_COMPONENTS
2691  !Loop over element rows
2692  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2693  mhs=mhs+1
2694  source_vector%ELEMENT_VECTOR%VECTOR(mhs)=source_vector%ELEMENT_VECTOR%VECTOR(mhs)+ &
2695  & quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)*c_param*rwg
2696  ENDDO !ms
2697  ENDDO !mh
2698  ENDIF
2699  ELSEIF(equations_set_subtype==equations_set_coupled_source_diffusion_advec_diffusion_subtype) THEN
2700  IF(update_source_vector) THEN
2701  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng, &
2702  & diffusion_dependent_previous_interpolated_point,err,error,*999)
2703  c_param=diffusion_dependent_previous_interpolated_point%VALUES(1,no_part_deriv)
2704  mhs=0
2705  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
2706  !DO mh=1,DEPENDENT_VARIABLE%NUMBER_OF_COMPONENTS
2707  !Loop over element rows
2708  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2709  mhs=mhs+1
2710  source_vector%ELEMENT_VECTOR%VECTOR(mhs)=source_vector%ELEMENT_VECTOR%VECTOR(mhs)+ &
2711  & quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)*c_param*rwg
2712  ENDDO !ms
2713  ENDDO !mh
2714  ENDIF
2715  ENDIF
2716  IF(update_rhs_vector) rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=0.0_dp
2717 
2718  IF(equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype) THEN
2719  !Calculate the coupling matrices
2720 
2721  !Loop over element rows
2722  mhs=0
2723  DO mh=1,field_variable%NUMBER_OF_COMPONENTS !field_variable is the variable associated with the equations set under consideration
2724 
2725  mesh_component_1 = field_variable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
2726  dependent_basis_1 => dependent_field%DECOMPOSITION%DOMAIN(mesh_component_1)%PTR% &
2727  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2728  quadrature_scheme_1 => dependent_basis_1%QUADRATURE% &
2729  & quadrature_scheme_map(basis_default_quadrature_scheme)%PTR
2730  rwg = equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN * &
2731  & quadrature_scheme_1%GAUSS_WEIGHTS(ng)
2732 
2733  DO ms=1,dependent_basis_1%NUMBER_OF_ELEMENT_PARAMETERS
2734  mhs=mhs+1
2735 
2736  num_var_count=0
2737  DO imatrix = 1,ncompartments
2738  IF(imatrix/=my_compartment)THEN
2739  num_var_count=num_var_count+1
2740 
2741 !need to test for the case where imatrix==mycompartment
2742 !the coupling terms then needs to be added into the stiffness matrix
2743  IF(coupling_matrices(num_var_count)%PTR%UPDATE_MATRIX) THEN
2744 
2745 ! !Loop over element columns
2746  nhs=0
2747 ! ! DO nh=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS
2748  DO nh=1,field_variables(num_var_count)%PTR%NUMBER_OF_COMPONENTS
2749 
2750  mesh_component_2 = field_variable%COMPONENTS(nh)%MESH_COMPONENT_NUMBER
2751  dependent_basis_2 => dependent_field%DECOMPOSITION%DOMAIN(mesh_component_2)%PTR% &
2752  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2753  !--- We cannot use two different quadrature schemes here !!!
2754  quadrature_scheme_2 => dependent_basis_2%QUADRATURE% &
2755  & quadrature_scheme_map(basis_default_quadrature_scheme)%PTR
2756  !RWG = EQUATIONS%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS%JACOBIAN * &
2757  ! & QUADRATURE_SCHEME_2%GAUSS_WEIGHTS(ng)
2758 
2759  DO ns=1,dependent_basis_2%NUMBER_OF_ELEMENT_PARAMETERS
2760  nhs=nhs+1
2761 
2762 ! !-------------------------------------------------------------------------------------------------------------
2763 ! !concentration test function, concentration trial function
2764 ! !For now, this is only a dummy implementation - this still has to be properly set up.
2765 ! IF(mh==nh.AND.nh<NUMBER_OF_VEL_PRESS_COMPONENTS) THEN ! don't need this for diffusion equation
2766 
2767 ! SUM = 0.0_DP
2768 
2769  pgm=quadrature_scheme_1%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
2770  pgn=quadrature_scheme_2%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)
2771 
2772  !Get the coupling coefficients
2773  coupling_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)%PTR% &
2774  & values(imatrix,no_part_deriv)
2775 
2776 ! SUM = SUM + COUPLING_PARAM * PGM * PGN
2777 
2778  coupling_matrices(num_var_count)%PTR%ELEMENT_MATRIX%MATRIX(mhs,nhs) = &
2779  & coupling_matrices(num_var_count)%PTR%ELEMENT_MATRIX%MATRIX(mhs,nhs) + &
2780  & coupling_param * pgm * pgn * rwg
2781 ! ENDIF
2782 
2783  ENDDO !ns
2784  ENDDO !nh
2785  ENDIF
2786  ENDIF
2787  ENDDO !imatrix
2788  ENDDO !ms
2789  ENDDO !mh
2790 
2791  ENDIF
2792 
2793  ENDDO !ng
2794 
2795  !Scale factor adjustment
2796  IF(dependent_field%SCALINGS%SCALING_TYPE/=field_no_scaling) THEN
2797  CALL field_interpolationparametersscalefactorselementget(element_number,equations%INTERPOLATION% &
2798  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
2799  mhs=0
2800  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
2801  !Loop over element rows
2802  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2803  mhs=mhs+1
2804  nhs=0
2805  IF(update_stiffness_matrix .OR. update_damping_matrix) THEN
2806  !Loop over element columns
2807  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
2808  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2809  nhs=nhs+1
2810  IF(update_stiffness_matrix) THEN
2811  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)* &
2812  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)* &
2813  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
2814  ENDIF
2815  IF(equations_set_subtype==equations_set_no_source_advection_diffusion_subtype .OR. &
2816  & equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
2817  & equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
2818  & equations_set_subtype==equations_set_no_source_ale_advection_diffusion_subtype .OR. &
2819  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
2820  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
2821  & equations_set_subtype==equations_set_coupled_source_diffusion_advec_diffusion_subtype .OR. &
2822  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype) THEN
2823  IF(update_damping_matrix) THEN
2824  damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)* &
2825  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)* &
2826  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
2827  ENDIF
2828  ENDIF
2829  ENDDO !ns
2830  ENDDO !nh
2831  ENDIF
2832  IF(update_rhs_vector) rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)* &
2833  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)
2834  IF(equations_set_subtype==equations_set_constant_source_advection_diffusion_subtype .OR. &
2835  & equations_set_subtype==equations_set_linear_source_advection_diffusion_subtype .OR. &
2836  & equations_set_subtype==equations_set_constant_source_ale_advection_diffusion_subtype .OR. &
2837  & equations_set_subtype==equations_set_linear_source_ale_advection_diffusion_subtype .OR. &
2838  & equations_set_subtype==equations_set_constant_source_static_advec_diff_subtype .OR. &
2839  & equations_set_subtype==equations_set_linear_source_static_advec_diff_subtype .OR. &
2840  & equations_set_subtype==equations_set_coupled_source_diffusion_advec_diffusion_subtype .OR. &
2841  & equations_set_subtype==equations_set_multi_comp_transport_advec_diff_subtype) THEN
2842  IF(update_source_vector) source_vector%ELEMENT_VECTOR%VECTOR(mhs)=source_vector%ELEMENT_VECTOR%VECTOR(mhs)* &
2843  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)
2844  ENDIF
2845  ENDDO !ms
2846  ENDDO !mh
2847  ENDIF
2848  CASE(equations_set_no_source_advection_diff_supg_subtype, &
2849  & equations_set_constant_source_advection_diff_supg_subtype, &
2850  & equations_set_linear_source_advection_diff_supg_subtype, &
2851  & equations_set_no_source_ale_advection_diff_supg_subtype, &
2852  & equations_set_constant_source_ale_advection_diff_supg_subtype, &
2853  & equations_set_linear_source_ale_advection_diff_supg_subtype, &
2854  & equations_set_no_source_static_advec_diff_supg_subtype, &
2855  & equations_set_constant_source_static_advec_diff_supg_subtype, &
2856  & equations_set_linear_source_static_advec_diff_supg_subtype, &
2857  & equations_set_multi_comp_transport_advec_diff_supg_subtype)
2858  CALL flagerror("Not implemented.",err,error,*999)
2859  !Loop over gauss points
2860  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
2861  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
2862  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
2863  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
2864  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
2865  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
2866  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
2867  !Interpolate to get the advective velocity
2868  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
2869  & independent_interp_point(field_u_variable_type)%PTR,err,error,*999)
2870  !Calculate RWG.
2871 !!TODO: Think about symmetric problems.
2872  rwg=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
2873  & quadrature_scheme%GAUSS_WEIGHTS(ng)
2874  !Loop over field components
2875  mhs=0
2876  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
2877  !Loop over element rows
2878  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2879  mhs=mhs+1
2880  nhs=0
2881  IF(update_stiffness_matrix .OR. update_damping_matrix) THEN
2882  !Loop over element columns
2883  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
2884  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2885  nhs=nhs+1
2886  IF(update_stiffness_matrix) THEN
2887  sum=0.0_dp
2888  DO nj=1,geometric_variable%NUMBER_OF_COMPONENTS
2889  pgmj(nj)=0.0_dp
2890  pgnj(nj)=0.0_dp
2891  DO ni=1,dependent_basis%NUMBER_OF_XI
2892  pgmj(nj)=pgmj(nj)+ &
2893  & quadrature_scheme%GAUSS_BASIS_FNS(ms,partial_derivative_first_derivative_map(ni),ng)* &
2894  & equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%DXI_DX(ni,nj)
2895  pgnj(nj)=pgnj(nj)+ &
2896  & quadrature_scheme%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(ni),ng)* &
2897  & equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%DXI_DX(ni,nj)
2898  ENDDO !ni
2899  k_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR% &
2900  & values(nj,no_part_deriv)
2901  sum=sum+k_param*pgmj(nj)*pgnj(nj)
2902  !Advection term is constructed here and then added to SUM for updating the stiffness matrix outside of this loop
2903  advec_vel=equations%INTERPOLATION%INDEPENDENT_INTERP_POINT(field_u_variable_type)%PTR% &
2904  & values(nj,no_part_deriv)
2905  sum=sum+advec_vel*quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)*pgnj(nj)
2906  ENDDO !nj
2907  IF (equations_set_subtype==equations_set_no_source_advection_diff_supg_subtype .OR. &
2908  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
2909  & equations_set_subtype==equations_set_no_source_ale_advection_diff_supg_subtype .OR. &
2910  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
2911  & equations_set_subtype==equations_set_no_source_static_advec_diff_supg_subtype .OR. &
2912  & equations_set_subtype==equations_set_constant_source_static_advec_diff_supg_subtype) THEN
2913  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*rwg
2914  ELSEIF(equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
2915  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
2916  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype) THEN
2917  a_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR% &
2918  & values(geometric_variable%NUMBER_OF_COMPONENTS,no_part_deriv)
2919  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*rwg- &
2920  & a_param*quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)* &
2921  & quadrature_scheme%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)*rwg
2922  ! A_PARAM is the material parameter that multiplies the linear source u
2923  ENDIF
2924  ENDIF
2925  IF(equations_set_subtype==equations_set_no_source_advection_diff_supg_subtype .OR. &
2926  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
2927  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
2928  & equations_set_subtype==equations_set_no_source_ale_advection_diff_supg_subtype .OR. &
2929  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
2930  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype) THEN
2931  IF(update_damping_matrix) THEN
2932  damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+ &
2933  & quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)* &
2934  & quadrature_scheme%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)*rwg
2935  ENDIF
2936  ENDIF
2937  ENDDO !ns
2938  ENDDO !nh
2939  ENDIF
2940  ENDDO !ms
2941  ENDDO !mh
2942  IF(equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
2943  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
2944  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
2945  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
2946  & equations_set_subtype==equations_set_constant_source_static_advec_diff_supg_subtype .OR. &
2947  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype) THEN
2948  IF(update_source_vector) THEN
2949  c_param=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1, no_part_deriv)
2950  mhs=0
2951  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
2952  !DO mh=1,DEPENDENT_VARIABLE%NUMBER_OF_COMPONENTS
2953  !Loop over element rows
2954  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2955  mhs=mhs+1
2956  source_vector%ELEMENT_VECTOR%VECTOR(mhs)=source_vector%ELEMENT_VECTOR%VECTOR(mhs)+ &
2957  & quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)*c_param*rwg
2958  ENDDO !ms
2959  ENDDO !mh
2960  ENDIF
2961  ENDIF
2962  IF(update_rhs_vector) rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=0.0_dp
2963  ENDDO !ng
2964 
2965  !Scale factor adjustment
2966  IF(dependent_field%SCALINGS%SCALING_TYPE/=field_no_scaling) THEN
2967  CALL field_interpolationparametersscalefactorselementget(element_number,equations%INTERPOLATION% &
2968  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
2969  mhs=0
2970  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
2971  !Loop over element rows
2972  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2973  mhs=mhs+1
2974  nhs=0
2975  IF(update_stiffness_matrix .OR. update_damping_matrix) THEN
2976  !Loop over element columns
2977  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
2978  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2979  nhs=nhs+1
2980  IF(update_stiffness_matrix) THEN
2981  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)* &
2982  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)* &
2983  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
2984  ENDIF
2985  IF(equations_set_subtype==equations_set_no_source_advection_diff_supg_subtype .OR. &
2986  & equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
2987  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
2988  & equations_set_subtype==equations_set_no_source_ale_advection_diff_supg_subtype .OR. &
2989  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
2990  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype) THEN
2991  IF(update_damping_matrix) THEN
2992  damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)* &
2993  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)* &
2994  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
2995  ENDIF
2996  ENDIF
2997  ENDDO !ns
2998  ENDDO !nh
2999  ENDIF
3000  IF(update_rhs_vector) rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)* &
3001  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)
3002  IF(equations_set_subtype==equations_set_constant_source_advection_diff_supg_subtype .OR. &
3003  & equations_set_subtype==equations_set_linear_source_advection_diff_supg_subtype .OR. &
3004  & equations_set_subtype==equations_set_constant_source_ale_advection_diff_supg_subtype .OR. &
3005  & equations_set_subtype==equations_set_linear_source_ale_advection_diff_supg_subtype .OR. &
3006  & equations_set_subtype==equations_set_constant_source_static_advec_diff_supg_subtype .OR. &
3007  & equations_set_subtype==equations_set_linear_source_static_advec_diff_supg_subtype) THEN
3008  IF(update_source_vector) source_vector%ELEMENT_VECTOR%VECTOR(mhs)=source_vector%ELEMENT_VECTOR%VECTOR(mhs)* &
3009  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)
3010  ENDIF
3011  ENDDO !ms
3012  ENDDO !mh
3013  ENDIF
3014  CASE DEFAULT
3015  local_error="Equations set subtype "//trim(number_to_vstring(equations_set_subtype,"*",err,error))// &
3016  & " is not valid for an advection-diffusion equation type of a classical field equations set class."
3017  CALL flagerror(local_error,err,error,*999)
3018  END SELECT
3019  CASE(equations_set_quadratic_source_advection_diffusion_subtype, &
3020  & equations_set_exponential_source_advection_diffusion_subtype, &
3021  & equations_set_quadratic_source_ale_advection_diffusion_subtype, &
3022  & equations_set_exp_source_ale_advection_diffusion_subtype, &
3023  & equations_set_quad_source_advection_diff_supg_subtype, &
3024  & equations_set_exp_source_advection_diff_supg_subtype, &
3025  & equations_set_quad_source_ale_advection_diff_supg_subtype, &
3026  & equations_set_exp_source_ale_advection_diff_supg_subtype)
3027  CALL flagerror("Can not calculate finite element stiffness matrices for a nonlinear source.",err,error,*999)
3028  CASE DEFAULT
3029  local_error="Equations set subtype "//trim(number_to_vstring(equations_set_subtype,"*",err,error))// &
3030  & " is not valid for an advection-diffusion equation type of a classical field equations set class."
3031  CALL flagerror(local_error,err,error,*999)
3032  END SELECT
3033  ELSE
3034  CALL flagerror("Equations set equations is not associated.",err,error,*999)
3035  ENDIF
3036  ELSE
3037  CALL flagerror("Equations set is not associated.",err,error,*999)
3038  ENDIF
3039 
3040  exits("AdvectionDiffusion_FiniteElementCalculate")
3041  RETURN
3042 999 errors("AdvectionDiffusion_FiniteElementCalculate",err,error)
3043  exits("AdvectionDiffusion_FiniteElementCalculate")
3044  RETURN 1
3045 
3046  END SUBROUTINE advectiondiffusion_finiteelementcalculate
3047 
3048  !
3049  !================================================================================================================================
3050  !
3051 
3052  !INSERT CODE HERE TO DEAL WITH THE NON-LINEAR SOURCE TERMS - DECIDE HOW TO SOLVE THEM, USE JACOBIAN AS FOR NON-LINEAR POISSON EXAMPLE?
3053 
3054  !
3055  !================================================================================================================================
3056  !
3057 
3059  SUBROUTINE advectiondiffusion_problemspecificationset(problem,problemSpecification,err,error,*)
3060 
3061  !Argument variables
3062  TYPE(problem_type), POINTER :: problem
3063  INTEGER(INTG), INTENT(IN) :: problemSpecification(:)
3064  INTEGER(INTG), INTENT(OUT) :: err
3065  TYPE(varying_string), INTENT(OUT) :: error
3066  !Local Variables
3067  TYPE(varying_string) :: localError
3068  INTEGER(INTG) :: problemSubtype
3069 
3070  enters("AdvectionDiffusion_ProblemSpecificationSet",err,error,*999)
3071 
3072  IF(ASSOCIATED(problem)) THEN
3073  IF(SIZE(problemspecification,1)==3) THEN
3074  problemsubtype=problemspecification(3)
3075  SELECT CASE(problemsubtype)
3076  CASE(problem_no_source_advection_diffusion_subtype, &
3077  & problem_linear_source_advection_diffusion_subtype, &
3078  & problem_nonlinear_source_advection_diffusion_subtype, &
3079  & problem_no_source_ale_advection_diffusion_subtype, &
3080  & problem_linear_source_ale_advection_diffusion_subtype, &
3081  & problem_nonlinear_source_ale_advection_diffusion_subtype, &
3082  & problem_no_source_static_advec_diff_subtype, &
3083  & problem_linear_source_static_advec_diff_subtype, &
3084  & problem_nonlinear_source_static_advec_diff_subtype)
3085  !ok
3086  CASE DEFAULT
3087  localerror="The third problem specification of "//trim(numbertovstring(problemsubtype,"*",err,error))// &
3088  & " is not valid for an advection-diffusion type of a classical field problem."
3089  CALL flagerror(localerror,err,error,*999)
3090  END SELECT
3091  IF(ALLOCATED(problem%specification)) THEN
3092  CALL flagerror("Problem specification is already allocated.",err,error,*999)
3093  ELSE
3094  ALLOCATE(problem%specification(3),stat=err)
3095  IF(err/=0) CALL flagerror("Could not allocate problem specification.",err,error,*999)
3096  END IF
3097  problem%specification(1:3)=[problem_classical_field_class,problem_advection_diffusion_equation_type,problemsubtype]
3098  ELSE
3099  CALL flagerror("Advection-diffusion problem specification must have three entries.",err,error,*999)
3100  END IF
3101  ELSE
3102  CALL flagerror("Problem is not associated.",err,error,*999)
3103  END IF
3104 
3105  exits("AdvectionDiffusion_ProblemSpecificationSet")
3106  RETURN
3107 999 errors("AdvectionDiffusion_ProblemSpecificationSet",err,error)
3108  exits("AdvectionDiffusion_ProblemSpecificationSet")
3109  RETURN 1
3110 
3111  END SUBROUTINE advectiondiffusion_problemspecificationset
3112 
3113  !
3114  !================================================================================================================================
3115  !
3116 
3118  SUBROUTINE advectiondiffusion_problemlinearsetup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
3119 
3120  !Argument variables
3121  TYPE(problem_type), POINTER :: PROBLEM
3122  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
3123  INTEGER(INTG), INTENT(OUT) :: ERR
3124  TYPE(varying_string), INTENT(OUT) :: ERROR
3125  !Local Variables
3126  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT
3127  TYPE(solver_type), POINTER :: SOLVER
3128  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
3129  TYPE(solvers_type), POINTER :: SOLVERS
3130  TYPE(varying_string) :: LOCAL_ERROR
3131  INTEGER(INTG) :: PROBLEM_SUBTYPE
3132 
3133  enters("AdvectionDiffusion_ProblemLinearSetup",err,error,*999)
3134 
3135  NULLIFY(control_loop)
3136  NULLIFY(solver)
3137  NULLIFY(solver_equations)
3138  NULLIFY(solvers)
3139  IF(ASSOCIATED(problem)) THEN
3140  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
3141  CALL flagerror("Problem specification is not allocated.",err,error,*999)
3142  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
3143  CALL flagerror("Problem specification does not have a subtype set.",err,error,*999)
3144  END IF
3145  problem_subtype=problem%SPECIFICATION(3)
3146  IF(problem_subtype==problem_no_source_advection_diffusion_subtype .OR. &
3147  & problem_subtype==problem_linear_source_advection_diffusion_subtype .OR. &
3148  & problem_subtype==problem_no_source_ale_advection_diffusion_subtype .OR. &
3149  & problem_subtype==problem_linear_source_ale_advection_diffusion_subtype) THEN
3150  SELECT CASE(problem_setup%SETUP_TYPE)
3151  CASE(problem_setup_initial_type)
3152  SELECT CASE(problem_setup%ACTION_TYPE)
3153  CASE(problem_setup_start_action)
3154  !Do nothing????
3155  CASE(problem_setup_finish_action)
3156  !Do nothing????
3157  CASE DEFAULT
3158  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3159  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3160  & " is invalid for a linear advection-diffusion equation."
3161  CALL flagerror(local_error,err,error,*999)
3162  END SELECT
3163  CASE(problem_setup_control_type)
3164  SELECT CASE(problem_setup%ACTION_TYPE)
3165  CASE(problem_setup_start_action)
3166  !Set up a time control loop
3167  CALL control_loop_create_start(problem,control_loop,err,error,*999)
3168  CALL control_loop_type_set(control_loop,problem_control_time_loop_type,err,error,*999)
3169  CASE(problem_setup_finish_action)
3170  !Finish the control loops
3171  control_loop_root=>problem%CONTROL_LOOP
3172  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3173  CALL control_loop_create_finish(control_loop,err,error,*999)
3174  CASE DEFAULT
3175  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3176  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3177  & " is invalid for a linear advection-diffusion equation."
3178  CALL flagerror(local_error,err,error,*999)
3179  END SELECT
3180  CASE(problem_setup_solvers_type)
3181  !Get the control loop
3182  control_loop_root=>problem%CONTROL_LOOP
3183  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3184  SELECT CASE(problem_setup%ACTION_TYPE)
3185  CASE(problem_setup_start_action)
3186  !Start the solvers creation
3187  CALL solvers_create_start(control_loop,solvers,err,error,*999)
3188  CALL solvers_number_set(solvers,1,err,error,*999)
3189  !Set the solver to be a first order dynamic solver
3190  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3191  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
3192  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
3193  !Set solver defaults
3194  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
3195  CALL solver_dynamic_scheme_set(solver,solver_dynamic_crank_nicolson_scheme,err,error,*999)
3196  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
3197  CASE(problem_setup_finish_action)
3198  !Get the solvers
3199  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3200  !Finish the solvers creation
3201  CALL solvers_create_finish(solvers,err,error,*999)
3202  CASE DEFAULT
3203  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3204  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3205  & " is invalid for a linear advection-diffusion equation."
3206  CALL flagerror(local_error,err,error,*999)
3207  END SELECT
3208  CASE(problem_setup_solver_equations_type)
3209  SELECT CASE(problem_setup%ACTION_TYPE)
3210  CASE(problem_setup_start_action)
3211  !Get the control loop
3212  control_loop_root=>problem%CONTROL_LOOP
3213  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3214  !Get the solver
3215  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3216  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3217  !Create the solver equations
3218  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3219  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
3220  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_first_order_dynamic,err,error,*999)
3221  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3222  CASE(problem_setup_finish_action)
3223  !Get the control loop
3224  control_loop_root=>problem%CONTROL_LOOP
3225  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3226  !Get the solver equations
3227  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3228  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3229  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
3230  !Finish the solver equations creation
3231  CALL solver_equations_create_finish(solver_equations,err,error,*999)
3232  CASE DEFAULT
3233  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3234  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3235  & " is invalid for a linear advection-diffusion equation."
3236  CALL flagerror(local_error,err,error,*999)
3237  END SELECT
3238  CASE DEFAULT
3239  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3240  & " is invalid for a linear advection-diffusion equation."
3241  CALL flagerror(local_error,err,error,*999)
3242  END SELECT
3243  ELSEIF(problem_subtype==problem_no_source_static_advec_diff_subtype .OR. &
3244  & problem_subtype==problem_linear_source_static_advec_diff_subtype) THEN
3245  SELECT CASE(problem_setup%SETUP_TYPE)
3246  CASE(problem_setup_initial_type)
3247  SELECT CASE(problem_setup%ACTION_TYPE)
3248  CASE(problem_setup_start_action)
3249  !Do nothing????
3250  CASE(problem_setup_finish_action)
3251  !Do nothing????
3252  CASE DEFAULT
3253  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3254  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3255  & " is invalid for a linear static advection-diffusion equation."
3256  CALL flagerror(local_error,err,error,*999)
3257  END SELECT
3258  CASE(problem_setup_control_type)
3259  SELECT CASE(problem_setup%ACTION_TYPE)
3260  CASE(problem_setup_start_action)
3261  !Set up a simple control loop
3262  CALL control_loop_create_start(problem,control_loop,err,error,*999)
3263  CASE(problem_setup_finish_action)
3264  !Finish the control loops
3265  control_loop_root=>problem%CONTROL_LOOP
3266  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3267  CALL control_loop_create_finish(control_loop,err,error,*999)
3268  CASE DEFAULT
3269  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3270  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3271  & " is invalid for a linear static advection-diffusion equation."
3272  CALL flagerror(local_error,err,error,*999)
3273  END SELECT
3274  CASE(problem_setup_solvers_type)
3275  !Get the control loop
3276  control_loop_root=>problem%CONTROL_LOOP
3277  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3278  SELECT CASE(problem_setup%ACTION_TYPE)
3279  CASE(problem_setup_start_action)
3280  !Start the solvers creation
3281  CALL solvers_create_start(control_loop,solvers,err,error,*999)
3282  CALL solvers_number_set(solvers,1,err,error,*999)
3283  !Set the solver to be a linear solver
3284  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3285  !Start the linear solver creation
3286  CALL solver_type_set(solver,solver_linear_type,err,error,*999)
3287  !Set solver defaults
3288  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
3289  CASE(problem_setup_finish_action)
3290  !Get the solvers
3291  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3292  !Finish the solvers creation
3293  CALL solvers_create_finish(solvers,err,error,*999)
3294  CASE DEFAULT
3295  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3296  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3297  & " is invalid for a linear static advection-diffusion equation."
3298  CALL flagerror(local_error,err,error,*999)
3299  END SELECT
3300  CASE(problem_setup_solver_equations_type)
3301  SELECT CASE(problem_setup%ACTION_TYPE)
3302  CASE(problem_setup_start_action)
3303  !Get the control loop
3304  control_loop_root=>problem%CONTROL_LOOP
3305  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3306  !Get the solver
3307  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3308  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3309  !Create the solver equations
3310  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3311  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
3312  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
3313  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3314  CASE(problem_setup_finish_action)
3315  !Get the control loop
3316  control_loop_root=>problem%CONTROL_LOOP
3317  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3318  !Get the solver equations
3319  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3320  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3321  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
3322  !Finish the solver equations creation
3323  CALL solver_equations_create_finish(solver_equations,err,error,*999)
3324  CASE DEFAULT
3325  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3326  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3327  & " is invalid for a linear static advection-diffusion equation."
3328  CALL flagerror(local_error,err,error,*999)
3329  END SELECT
3330  CASE DEFAULT
3331  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3332  & " is invalid for a linear static advection-diffusion equation."
3333  CALL flagerror(local_error,err,error,*999)
3334  END SELECT
3335  ELSE
3336  local_error="The problem subtype of "//trim(number_to_vstring(problem_subtype,"*",err,error))// &
3337  & " does not equal a linear advection-diffusion equation subtype."
3338  CALL flagerror(local_error,err,error,*999)
3339  ENDIF
3340  ELSE
3341  CALL flagerror("Problem is not associated.",err,error,*999)
3342  ENDIF
3343 
3344  exits("AdvectionDiffusion_ProblemLinearSetup")
3345  RETURN
3346 999 errors("AdvectionDiffusion_ProblemLinearSetup",err,error)
3347  exits("AdvectionDiffusion_ProblemLinearSetup")
3348  RETURN 1
3349 
3350  END SUBROUTINE advectiondiffusion_problemlinearsetup
3351 
3352  !
3353  !================================================================================================================================
3354  !
3356 ! SUBROUTINE ADVECTION_DIFFUSION_EQUATION_PROBLEM_NONLINEAR_SETUP(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
3357 !
3358 ! !Argument variables
3359 ! TYPE(PROBLEM_TYPE), POINTER :: PROBLEM !<A pointer to the problem to setup
3360 ! TYPE(PROBLEM_SETUP_TYPE), INTENT(INOUT) :: PROBLEM_SETUP !<The problem setup information
3361 ! INTEGER(INTG), INTENT(OUT) :: ERR !<The error code
3362 ! TYPE(VARYING_STRING), INTENT(OUT) :: ERROR !<The error string
3363 !
3364 ! CALL FlagError("Not implemented.",ERR,ERROR,*999)
3365 !
3366 ! EXITS("ADVECTION_DIFFUSION_EQUATION_PROBLEM_NONLINEAR_SETUP")
3367 ! RETURN
3368 ! 999 ERRORSEXITS("ADVECTION_DIFFUSION_EQUATION_PROBLEM_NONLINEAR_SETUP",ERR,ERROR)
3369 ! RETURN 1
3370 !
3371 ! END SUBROUTINE ADVECTION_DIFFUSION_EQUATION_PROBLEM_NONLINEAR_SETUP
3372 
3373  !
3374  !================================================================================================================================
3375  !
3376 
3378  SUBROUTINE advection_diffusion_pre_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
3379 
3380  !Argument variables
3381  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
3382  TYPE(solver_type), POINTER :: SOLVER
3383  INTEGER(INTG), INTENT(OUT) :: ERR
3384  TYPE(varying_string), INTENT(OUT) :: ERROR
3385  !Local Variables
3386  TYPE(solver_type), POINTER :: SOLVER2
3387  TYPE(varying_string) :: LOCAL_ERROR
3388  INTEGER(INTG) :: PROBLEM_SUBTYPE
3389 
3390  enters("ADVECTION_DIFFUSION_PRE_SOLVE",err,error,*999)
3391  NULLIFY(solver2)
3392 
3393  IF(ASSOCIATED(control_loop)) THEN
3394  IF(ASSOCIATED(solver)) THEN
3395  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
3396  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
3397  CALL flagerror("Problem specification is not allocated.",err,error,*999)
3398  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
3399  CALL flagerror("Problem specification does not have a subtype set.",err,error,*999)
3400  END IF
3401  problem_subtype=control_loop%PROBLEM%SPECIFICATION(3)
3402  IF(problem_subtype==problem_no_source_advection_diffusion_subtype .OR. &
3403  & problem_subtype==problem_linear_source_advection_diffusion_subtype) THEN
3404  CALL writestring(general_output_type,"Read in vector data... ",err,error,*999)
3405  !Update independent data fields
3406  CALL advectiondiffusion_presolveupdateinputdata(control_loop,solver,err,error,*999)
3407  !CALL ADVECTION_DIFFUSION_PRE_SOLVE_UPDATE_BC(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
3408  ELSEIF(problem_subtype==problem_no_source_ale_advection_diffusion_subtype .OR. &
3409  & problem_subtype==problem_linear_source_ale_advection_diffusion_subtype) THEN
3410  CALL write_string(general_output_type,"Read in vector data... ",err,error,*999)
3411  !Update independent data fields
3412  CALL advectiondiffusion_presolveupdateinputdata(control_loop,solver,err,error,*999)
3413  !CALL ADVECTION_DIFFUSION_PRE_SOLVE_UPDATE_BC(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
3414  CALL advectiondiffusion_presolvealeupdatemesh(control_loop,solver,err,error,*999)
3415  ELSEIF(problem_subtype==problem_nonlinear_source_advection_diffusion_subtype .OR. &
3416  & problem_subtype==problem_nonlinear_source_ale_advection_diffusion_subtype) THEN
3417  CALL flagerror("Not implemented.",err,error,*999)
3418  ELSEIF(problem_subtype==problem_no_source_static_advec_diff_subtype .OR. &
3419  & problem_subtype==problem_linear_source_static_advec_diff_subtype) THEN
3420  !do nothing
3421  ELSE
3422  local_error="The third problem specification of "// &
3423  & trim(number_to_vstring(problem_subtype,"*",err,error))// &
3424  & " is not valid for a advection-diffusion type of a classical field problem."
3425  CALL flagerror(local_error,err,error,*999)
3426  ENDIF
3427  ELSE
3428  CALL flagerror("Problem is not associated.",err,error,*999)
3429  ENDIF
3430  ELSE
3431  CALL flagerror("Solver is not associated.",err,error,*999)
3432  ENDIF
3433  ELSE
3434  CALL flagerror("Control loop is not associated.",err,error,*999)
3435  ENDIF
3436 
3437  exits("ADVECTION_DIFFUSION_PRE_SOLVE")
3438  RETURN
3439 999 errorsexits("ADVECTION_DIFFUSION_PRE_SOLVE",err,error)
3440  RETURN 1
3441  END SUBROUTINE advection_diffusion_pre_solve
3442  !
3443  !================================================================================================================================
3444  !
3446  SUBROUTINE advectiondiffusion_presolvealeupdatemesh(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
3447 
3448  !Argument variables
3449  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
3450  TYPE(solver_type), POINTER :: SOLVER
3451  INTEGER(INTG), INTENT(OUT) :: ERR
3452  TYPE(varying_string), INTENT(OUT) :: ERROR
3453  !Local Variables
3454  TYPE(field_type), POINTER :: GEOMETRIC_FIELD
3455  TYPE(solver_type), POINTER :: SOLVER_ALE_DIFFUSION
3456  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
3457  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
3458  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3459  TYPE(varying_string) :: LOCAL_ERROR
3460 
3461  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT,ALPHA
3462  REAL(DP), POINTER :: MESH_DISPLACEMENT_VALUES(:)
3463 
3464  INTEGER(INTG) :: dof_number,TOTAL_NUMBER_OF_DOFS,NDOFS_TO_PRINT
3465 
3466  INTEGER(INTG) :: NUMBER_OF_DIMENSIONS
3467  INTEGER(INTG) :: INPUT_TYPE,INPUT_OPTION
3468  REAL(DP), POINTER :: INPUT_DATA1(:)
3469 
3470  enters("AdvectionDiffusion_PreSolveALEUpdateMesh",err,error,*999)
3471 
3472  NULLIFY(solver_ale_diffusion)
3473  NULLIFY(solver_equations)
3474  NULLIFY(solver_mapping)
3475  NULLIFY(equations_set)
3476 
3477  IF(ASSOCIATED(control_loop)) THEN
3478  IF(control_loop%LOOP_TYPE==problem_control_time_loop_type) THEN
3479  CALL control_loop_current_times_get(control_loop,current_time,time_increment,err,error,*999)
3480  ELSE IF(control_loop%CONTROL_LOOP_LEVEL>1) THEN
3481  CALL control_loop_current_times_get(control_loop%PARENT_LOOP,current_time,time_increment,err,error,*999)
3482  ENDIF
3483  IF(ASSOCIATED(solver)) THEN
3484  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
3485  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
3486  CALL flagerror("Problem specification is not allocated.",err,error,*999)
3487  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
3488  CALL flagerror("Problem specification does not have a subtype set.",err,error,*999)
3489  END IF
3490  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
3491  CASE(problem_no_source_advection_diffusion_subtype,problem_linear_source_advection_diffusion_subtype, &
3492  & problem_nonlinear_source_advection_diffusion_subtype)
3493  ! do nothing ???
3494  CASE(problem_no_source_ale_advection_diffusion_subtype,problem_linear_source_ale_advection_diffusion_subtype, &
3495  & problem_nonlinear_source_ale_advection_diffusion_subtype)
3496  solver_equations=>solver%SOLVER_EQUATIONS
3497  IF(ASSOCIATED(solver_equations)) THEN
3498  solver_mapping=>solver_equations%SOLVER_MAPPING
3499  IF(ASSOCIATED(solver_mapping)) THEN
3500  equations_set=>solver_mapping%EQUATIONS_SETS(1)%PTR
3501  IF(ASSOCIATED(equations_set)) THEN
3502  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
3503  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
3504  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<3) THEN
3505  CALL flagerror("Equations set specification does not have a subtype set.",err,error,*999)
3506  END IF
3507  SELECT CASE(equations_set%SPECIFICATION(3))
3508  CASE(equations_set_no_source_advection_diffusion_subtype, &
3509  & equations_set_constant_source_advection_diffusion_subtype, &
3510  & equations_set_linear_source_advection_diffusion_subtype, &
3511  & equations_set_quadratic_source_advection_diffusion_subtype, &
3512  & equations_set_exponential_source_advection_diffusion_subtype)
3513  ! do nothing ???
3514  CASE(equations_set_no_source_ale_advection_diffusion_subtype, &
3515  & equations_set_constant_source_ale_advection_diffusion_subtype, &
3516  & equations_set_linear_source_ale_advection_diffusion_subtype, &
3517  & equations_set_quadratic_source_ale_advection_diffusion_subtype, &
3518  & equations_set_exp_source_ale_advection_diffusion_subtype, &
3519  & equations_set_no_source_ale_advection_diff_supg_subtype, &
3520  & equations_set_constant_source_ale_advection_diff_supg_subtype, &
3521  & equations_set_linear_source_ale_advection_diff_supg_subtype, &
3522  & equations_set_quad_source_ale_advection_diff_supg_subtype, &
3523  & equations_set_exp_source_ale_advection_diff_supg_subtype)
3524  CALL write_string(general_output_type,"Advection-diffusion update mesh ... ",err,error,*999)
3525  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
3526  IF(ASSOCIATED(geometric_field)) THEN
3527  !--- First, read mesh displacement values from file
3528 
3529  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
3530  & number_of_dimensions,err,error,*999)
3531 
3532  input_type=42
3533  input_option=2
3534  NULLIFY(input_data1)
3535  !CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
3536  !& FIELD_VALUES_SET_TYPE,INPUT_DATA1,ERR,ERROR,*999)
3537  CALL fluid_mechanics_io_read_data(solver_linear_type,input_data1, &
3538  & number_of_dimensions,input_type,input_option,control_loop%TIME_LOOP%ITERATION_NUMBER,1.0_dp)
3539 
3540  NULLIFY(mesh_displacement_values)
3541  CALL field_parameter_set_data_get(geometric_field,field_u_variable_type, &
3542  & field_mesh_displacement_set_type,mesh_displacement_values,err,error,*999)
3543  IF(diagnostics1) THEN
3544  ndofs_to_print = SIZE(mesh_displacement_values,1)
3545  CALL write_string_vector(diagnostic_output_type,1,1,ndofs_to_print,ndofs_to_print,ndofs_to_print,&
3546  & mesh_displacement_values,'(" MESH_DISPLACEMENT_VALUES = ",3(X,E13.6))','3(3(X,E13.6))', &
3547  & err,error,*999)
3548  ENDIF
3549 
3550  CALL fluid_mechanics_io_read_data(solver_linear_type,input_data1, &
3551  & number_of_dimensions,input_type,input_option,control_loop%TIME_LOOP%ITERATION_NUMBER,1.0_dp)
3552 
3553  total_number_of_dofs = geometric_field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR% &
3554  & total_number_of_dofs
3555 
3556  !--- Second, update geometric field
3557  DO dof_number=1,total_number_of_dofs
3558  CALL field_parameter_set_add_local_dof(geometric_field, &
3559  & field_u_variable_type,field_values_set_type,dof_number, &
3560  & mesh_displacement_values(dof_number), &
3561  & err,error,*999)
3562  END DO
3563  CALL field_parameter_set_update_start(geometric_field, &
3564  & field_u_variable_type, field_values_set_type,err,error,*999)
3565  CALL field_parameter_set_update_finish(geometric_field, &
3566  & field_u_variable_type, field_values_set_type,err,error,*999)
3567 
3568  !--- Third, use displacement values to calculate velocity values
3569  alpha=1.0_dp/time_increment
3570  CALL field_parameter_sets_copy(geometric_field,field_u_variable_type, &
3571  & field_mesh_displacement_set_type,field_mesh_velocity_set_type,alpha,err,error,*999)
3572  CALL field_parameter_set_data_restore(geometric_field,field_u_variable_type, &
3573  & field_mesh_displacement_set_type,mesh_displacement_values,err,error,*999)
3574  ELSE
3575  CALL flagerror("Geometric field is not associated.",err,error,*999)
3576  ENDIF
3577  CASE DEFAULT
3578  local_error="Equations set subtype " &
3579  & //trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
3580  & " is not valid for an advection-diffusion equation type of a classical field problem class."
3581  CALL flagerror(local_error,err,error,*999)
3582  END SELECT
3583  ELSE
3584  CALL flagerror("Equations set is not associated.",err,error,*999)
3585  ENDIF
3586  ELSE
3587  CALL flagerror("Solver mapping is not associated.",err,error,*999)
3588  ENDIF
3589  ELSE
3590  CALL flagerror("Solver equations is not associated.",err,error,*999)
3591  ENDIF
3592  CASE DEFAULT
3593  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
3594  & " is not valid for an advection-diffusion equation type of a classical field problem class."
3595  CALL flagerror(local_error,err,error,*999)
3596  END SELECT
3597  ELSE
3598  CALL flagerror("Problem is not associated.",err,error,*999)
3599  ENDIF
3600  ELSE
3601  CALL flagerror("Solver is not associated.",err,error,*999)
3602  ENDIF
3603  ELSE
3604  CALL flagerror("Control loop is not associated.",err,error,*999)
3605  ENDIF
3606 
3607  exits("AdvectionDiffusion_PreSolveALEUpdateMesh")
3608  RETURN
3609 999 errors("AdvectionDiffusion_PreSolveALEUpdateMesh",err,error)
3610  exits("AdvectionDiffusion_PreSolveALEUpdateMesh")
3611  RETURN 1
3612 
3613  END SUBROUTINE advectiondiffusion_presolvealeupdatemesh
3614  !
3615  !================================================================================================================================
3616  !
3617 
3618 
3619  SUBROUTINE advectiondiffusion_presolvestorecurrentsoln(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
3620 
3621  !Argument variables
3622  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
3623  TYPE(solver_type), POINTER :: SOLVER
3624  INTEGER(INTG), INTENT(OUT) :: ERR
3625  TYPE(varying_string), INTENT(OUT) :: ERROR
3626 
3627  !Local Variables
3628  TYPE(solver_type), POINTER :: SOLVER_ADVECTION_DIFFUSION
3629  TYPE(field_type), POINTER :: DEPENDENT_FIELD_ADVECTION_DIFFUSION
3630  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS_ADVECTION_DIFFUSION
3631  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING_ADVECTION_DIFFUSION
3632  TYPE(equations_set_type), POINTER :: EQUATIONS_SET_ADVECTION_DIFFUSION
3633  TYPE(varying_string) :: LOCAL_ERROR
3634 
3635  INTEGER(INTG) :: NUMBER_OF_COMPONENTS_DEPENDENT_FIELD_ADVECTION_DIFFUSION
3636  INTEGER(INTG) :: I
3637 
3638  enters("AdvectionDiffusion_PreSolveStoreCurrentSoln",err,error,*999)
3639 
3640  IF(ASSOCIATED(control_loop)) THEN
3641 
3642  NULLIFY(solver_advection_diffusion)
3643 
3644  IF(ASSOCIATED(solver)) THEN
3645  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
3646  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
3647  CALL flagerror("Problem specification is not allocated.",err,error,*999)
3648  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
3649  CALL flagerror("Problem specification does not have a subtype set.",err,error,*999)
3650  END IF
3651  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
3652  CASE(problem_no_source_advection_diffusion_subtype, &
3653  & problem_no_source_ale_advection_diffusion_subtype)
3654  ! do nothing ???
3655  CASE(problem_linear_source_advection_diffusion_subtype, &
3656  & problem_linear_source_ale_advection_diffusion_subtype)
3657  ! do nothing ???
3658  CASE(problem_nonlinear_source_advection_diffusion_subtype, &
3659  & problem_nonlinear_source_ale_advection_diffusion_subtype)
3660  ! do nothing ???
3661  CASE(problem_coupled_source_diffusion_advec_diffusion_subtype)
3662  IF(solver%GLOBAL_NUMBER==1) THEN
3663  !--- Get the dependent field of the advection-diffusion equations
3664  CALL write_string(general_output_type,"Store value of advection-diffusion &
3665  & (dependent field - U variable_type) at time, t ... ",err,error,*999)
3666  CALL solvers_solver_get(solver%SOLVERS,1,solver_advection_diffusion,err,error,*999)
3667  solver_equations_advection_diffusion=>solver_advection_diffusion%SOLVER_EQUATIONS
3668  IF(ASSOCIATED(solver_equations_advection_diffusion)) THEN
3669  solver_mapping_advection_diffusion=>solver_equations_advection_diffusion%SOLVER_MAPPING
3670  IF(ASSOCIATED(solver_mapping_advection_diffusion)) THEN
3671  equations_set_advection_diffusion=>solver_mapping_advection_diffusion%EQUATIONS_SETS(1)%PTR
3672  IF(ASSOCIATED(equations_set_advection_diffusion)) THEN
3673  dependent_field_advection_diffusion=>equations_set_advection_diffusion%DEPENDENT%DEPENDENT_FIELD
3674  IF(ASSOCIATED(dependent_field_advection_diffusion)) THEN
3675  CALL field_number_of_components_get(dependent_field_advection_diffusion, &
3676  & field_u_variable_type,number_of_components_dependent_field_advection_diffusion,err,error,*999)
3677  ELSE
3678  CALL flagerror("DEPENDENT_FIELD_ADVECTION_DIFFUSIONE is not associated.",err,error,*999)
3679  END IF
3680  ELSE
3681  CALL flagerror("Advection-diffusion equations set is not associated.",err,error,*999)
3682  END IF
3683  ELSE
3684  CALL flagerror("Advection-diffusion solver mapping is not associated.",err,error,*999)
3685  END IF
3686  ELSE
3687  CALL flagerror("Advection-diffusion solver equations are not associated.",err,error,*999)
3688  END IF
3689 
3690  !--- Copy the current time value parameters set from diffusion-one's dependent field
3691  DO i=1,number_of_components_dependent_field_advection_diffusion
3692  CALL field_parameterstofieldparameterscopy(dependent_field_advection_diffusion, &
3693  & field_u_variable_type,field_values_set_type,i,dependent_field_advection_diffusion, &
3694  & field_u_variable_type,field_previous_values_set_type,i,err,error,*999)
3695  END DO
3696 
3697 ! IF(DIAGNOSTICS3) THEN
3698 ! NULLIFY( DUMMY_VALUES2 )
3699 ! CALL FIELD_PARAMETER_SET_DATA_GET(DEPENDENT_FIELD_FINITE_ELASTICITY,FIELD_U_VARIABLE_TYPE, &
3700 ! & FIELD_VALUES_SET_TYPE,DUMMY_VALUES2,ERR,ERROR,*999)
3701 ! NDOFS_TO_PRINT = SIZE(DUMMY_VALUES2,1)
3702 ! CALL WRITE_STRING_VECTOR(DIAGNOSTIC_OUTPUT_TYPE,1,1,NDOFS_TO_PRINT,NDOFS_TO_PRINT,NDOFS_TO_PRINT,DUMMY_VALUES2, &
3703 ! & '(" DEPENDENT_FIELD_FINITE_ELASTICITY,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE = ",4(X,E13.6))',&
3704 ! & '4(4(X,E13.6))',ERR,ERROR,*999)
3705 ! CALL FIELD_PARAMETER_SET_DATA_RESTORE(DEPENDENT_FIELD_FINITE_ELASTICITY,FIELD_U_VARIABLE_TYPE, &
3706 ! & FIELD_VALUES_SET_TYPE,DUMMY_VALUES2,ERR,ERROR,*999)
3707 ! ENDIF
3708 
3709  END IF
3710  CASE DEFAULT
3711  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
3712  & " is not valid for an advection-diffusion equation type of a classical field problem class."
3713  CALL flagerror(local_error,err,error,*999)
3714  END SELECT
3715  ELSE
3716  CALL flagerror("Problem is not associated.",err,error,*999)
3717  ENDIF
3718  ELSE
3719  CALL flagerror("Solver is not associated.",err,error,*999)
3720  ENDIF
3721  ELSE
3722  CALL flagerror("Control loop is not associated.",err,error,*999)
3723  ENDIF
3724 
3725  exits("AdvectionDiffusion_PreSolveStoreCurrentSoln")
3726  RETURN
3727 999 errors("AdvectionDiffusion_PreSolveStoreCurrentSoln",err,error)
3728  exits("AdvectionDiffusion_PreSolveStoreCurrentSoln")
3729  RETURN 1
3730 
3731  END SUBROUTINE advectiondiffusion_presolvestorecurrentsoln
3732  !
3733  !================================================================================================================================
3734  !
3735  SUBROUTINE advectiondiffusion_presolvegetsourcevalue(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
3736 
3737  !Argument variables
3738  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
3739  TYPE(solver_type), POINTER :: SOLVER
3740  INTEGER(INTG), INTENT(OUT) :: ERR
3741  TYPE(varying_string), INTENT(OUT) :: ERROR
3742 
3743  !Local Variables
3744  TYPE(solver_type), POINTER :: SOLVER_ADVECTION_DIFFUSION, SOLVER_DIFFUSION
3745  TYPE(field_type), POINTER :: DEPENDENT_FIELD_DIFFUSION, SOURCE_FIELD_ADVECTION_DIFFUSION
3746  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS_ADVECTION_DIFFUSION, SOLVER_EQUATIONS_DIFFUSION
3747  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING_ADVECTION_DIFFUSION, SOLVER_MAPPING_DIFFUSION
3748  TYPE(equations_set_type), POINTER :: EQUATIONS_SET_ADVECTION_DIFFUSION, EQUATIONS_SET_DIFFUSION
3749  TYPE(varying_string) :: LOCAL_ERROR
3750 
3751  INTEGER(INTG) :: NUMBER_OF_COMPONENTS_DEPENDENT_FIELD_DIFFUSION,NUMBER_OF_COMPONENTS_SOURCE_FIELD_ADVECTION_DIFFUSION
3752  INTEGER(INTG) :: I
3753 
3754 
3755  enters("AdvectionDiffusion_PreSolveGetSourceValue",err,error,*999)
3756 
3757  IF(ASSOCIATED(control_loop)) THEN
3758 
3759  NULLIFY(solver_advection_diffusion)
3760  NULLIFY(solver_diffusion)
3761 
3762  IF(ASSOCIATED(solver)) THEN
3763  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
3764  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
3765  CALL flagerror("Problem specification is not allocated.",err,error,*999)
3766  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
3767  CALL flagerror("Problem specification does not have a subtype set.",err,error,*999)
3768  END IF
3769  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
3770  CASE(problem_no_source_advection_diffusion_subtype, &
3771  & problem_no_source_ale_advection_diffusion_subtype)
3772  ! do nothing ???
3773  CASE(problem_linear_source_advection_diffusion_subtype, &
3774  & problem_linear_source_ale_advection_diffusion_subtype)
3775  ! do nothing ???
3776  CASE(problem_nonlinear_source_advection_diffusion_subtype, &
3777  & problem_nonlinear_source_ale_advection_diffusion_subtype)
3778  ! do nothing ???
3779  CASE(problem_coupled_source_diffusion_advec_diffusion_subtype)
3780  IF(solver%GLOBAL_NUMBER==1) THEN
3781  !--- Get the dependent field of the diffusion equations
3782  CALL write_string(general_output_type,"Update advection-diffusion source field ... ",err,error,*999)
3783  CALL solvers_solver_get(solver%SOLVERS,2,solver_diffusion,err,error,*999)
3784  solver_equations_diffusion=>solver_diffusion%SOLVER_EQUATIONS
3785  IF(ASSOCIATED(solver_equations_diffusion)) THEN
3786  solver_mapping_diffusion=>solver_equations_diffusion%SOLVER_MAPPING
3787  IF(ASSOCIATED(solver_mapping_diffusion)) THEN
3788  equations_set_diffusion=>solver_mapping_diffusion%EQUATIONS_SETS(1)%PTR
3789  IF(ASSOCIATED(equations_set_diffusion)) THEN
3790  dependent_field_diffusion=>equations_set_diffusion%DEPENDENT%DEPENDENT_FIELD
3791  IF(ASSOCIATED(dependent_field_diffusion)) THEN
3792  CALL field_number_of_components_get(dependent_field_diffusion, &
3793  & field_u_variable_type,number_of_components_dependent_field_diffusion,err,error,*999)
3794  ELSE
3795  CALL flagerror("DEPENDENT_FIELD_DIFFUSION is not associated.",err,error,*999)
3796  END IF
3797  ELSE
3798  CALL flagerror("Diffusion equations set is not associated.",err,error,*999)
3799  END IF
3800  ELSE
3801  CALL flagerror("Diffusion solver mapping is not associated.",err,error,*999)
3802  END IF
3803  ELSE
3804  CALL flagerror("Diffusion solver equations are not associated.",err,error,*999)
3805  END IF
3806 
3807 
3808  !--- Get the source field for the advection-diffusion equations
3809  CALL solvers_solver_get(solver%SOLVERS,1,solver_advection_diffusion,err,error,*999)
3810  solver_equations_advection_diffusion=>solver_advection_diffusion%SOLVER_EQUATIONS
3811  IF(ASSOCIATED(solver_equations_advection_diffusion)) THEN
3812  solver_mapping_advection_diffusion=>solver_equations_advection_diffusion%SOLVER_MAPPING
3813  IF(ASSOCIATED(solver_mapping_advection_diffusion)) THEN
3814  equations_set_advection_diffusion=>solver_mapping_advection_diffusion%EQUATIONS_SETS(1)%PTR
3815  IF(ASSOCIATED(equations_set_advection_diffusion)) THEN
3816  source_field_advection_diffusion=>equations_set_advection_diffusion%SOURCE%SOURCE_FIELD
3817  IF(ASSOCIATED(source_field_advection_diffusion)) THEN
3818  CALL field_number_of_components_get(source_field_advection_diffusion, &
3819  & field_u_variable_type,number_of_components_source_field_advection_diffusion,err,error,*999)
3820  ELSE
3821  CALL flagerror("SOURCE_FIELD_ADVECTION_DIFFUSION is not associated.",err,error,*999)
3822  END IF
3823  ELSE
3824  CALL flagerror("Advection-diffusion equations set is not associated.",err,error,*999)
3825  END IF
3826  ELSE
3827  CALL flagerror("Advection-diffusion solver mapping is not associated.",err,error,*999)
3828  END IF
3829  ELSE
3830  CALL flagerror("Advection-diffusion solver equations are not associated.",err,error,*999)
3831  END IF
3832 
3833  !--- Copy the result from diffusion's dependent field to advection-diffusion's source field
3834  IF(number_of_components_source_field_advection_diffusion==number_of_components_dependent_field_diffusion) THEN
3835  DO i=1,number_of_components_source_field_advection_diffusion
3836  CALL field_parameterstofieldparameterscopy(dependent_field_diffusion, &
3837  & field_u_variable_type,field_values_set_type,i,source_field_advection_diffusion, &
3838  & field_u_variable_type,field_values_set_type,i,err,error,*999)
3839  END DO
3840  ELSE
3841  local_error="Number of components of diffusion dependent field "// &
3842  & "is not consistent with advection-diffusion equation source field."
3843  CALL flagerror(local_error,err,error,*999)
3844  END IF
3845 
3846 ! IF(DIAGNOSTICS3) THEN
3847 ! NULLIFY( DUMMY_VALUES2 )
3848 ! CALL FIELD_PARAMETER_SET_DATA_GET(DEPENDENT_FIELD_FINITE_ELASTICITY,FIELD_U_VARIABLE_TYPE, &
3849 ! & FIELD_VALUES_SET_TYPE,DUMMY_VALUES2,ERR,ERROR,*999)
3850 ! NDOFS_TO_PRINT = SIZE(DUMMY_VALUES2,1)
3851 ! CALL WRITE_STRING_VECTOR(DIAGNOSTIC_OUTPUT_TYPE,1,1,NDOFS_TO_PRINT,NDOFS_TO_PRINT,NDOFS_TO_PRINT,DUMMY_VALUES2, &
3852 ! & '(" DEPENDENT_FIELD_FINITE_ELASTICITY,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE = ",4(X,E13.6))',&
3853 ! & '4(4(X,E13.6))',ERR,ERROR,*999)
3854 ! CALL FIELD_PARAMETER_SET_DATA_RESTORE(DEPENDENT_FIELD_FINITE_ELASTICITY,FIELD_U_VARIABLE_TYPE, &
3855 ! & FIELD_VALUES_SET_TYPE,DUMMY_VALUES2,ERR,ERROR,*999)
3856 ! ENDIF
3857 
3858  END IF
3859  CASE DEFAULT
3860  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
3861  & " is not valid for an advection-diffusion equation type of a classical field problem class."
3862  CALL flagerror(local_error,err,error,*999)
3863  END SELECT
3864  ELSE
3865  CALL flagerror("Problem is not associated.",err,error,*999)
3866  ENDIF
3867  ELSE
3868  CALL flagerror("Solver is not associated.",err,error,*999)
3869  ENDIF
3870  ELSE
3871  CALL flagerror("Control loop is not associated.",err,error,*999)
3872  ENDIF
3873 
3874  exits("AdvectionDiffusion_PreSolveGetSourceValue")
3875  RETURN
3876 999 errors("AdvectionDiffusion_PreSolveGetSourceValue",err,error)
3877  exits("AdvectionDiffusion_PreSolveGetSourceValue")
3878  RETURN 1
3879 
3880  END SUBROUTINE advectiondiffusion_presolvegetsourcevalue
3881  !
3882  !================================================================================================================================
3883  !
3885  SUBROUTINE advectiondiffusion_presolveupdateinputdata(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
3886 
3887  !Argument variables
3888  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
3889  TYPE(solver_type), POINTER :: SOLVER
3890  INTEGER(INTG), INTENT(OUT) :: ERR
3891  TYPE(varying_string), INTENT(OUT) :: ERROR
3892  !Local Variables
3893  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
3894  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
3895  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3896  TYPE(equations_type), POINTER :: EQUATIONS
3897 
3898  INTEGER(INTG) :: NUMBER_OF_DIMENSIONS
3899  INTEGER(INTG) :: INPUT_TYPE,INPUT_OPTION
3900  REAL(DP), POINTER :: INPUT_DATA1(:)
3901  INTEGER(INTG) :: PROBLEM_SUBTYPE
3902 
3903  enters("AdvectionDiffusion_PreSolveUpdateInputData",err,error,*999)
3904 
3905  IF(ASSOCIATED(control_loop)) THEN
3906  IF(ASSOCIATED(solver)) THEN
3907  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
3908  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
3909  CALL flagerror("Problem specification is not allocated.",err,error,*999)
3910  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
3911  CALL flagerror("Problem specification does not have a subtype set.",err,error,*999)
3912  END IF
3913  problem_subtype=control_loop%PROBLEM%SPECIFICATION(3)
3914  IF(problem_subtype==problem_no_source_advection_diffusion_subtype .OR. &
3915  & problem_subtype==problem_linear_source_advection_diffusion_subtype .OR. &
3916  & problem_subtype==problem_no_source_ale_advection_diffusion_subtype .OR. &
3917  & problem_subtype==problem_linear_source_ale_advection_diffusion_subtype .OR. &
3918  & problem_subtype==problem_coupled_source_diffusion_advec_diffusion_subtype) THEN
3919 
3920  CALL write_string(general_output_type,"Read input data... ",err,error,*999)
3921  solver_equations=>solver%SOLVER_EQUATIONS
3922  IF(ASSOCIATED(solver_equations)) THEN
3923  solver_mapping=>solver_equations%SOLVER_MAPPING
3924  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
3925  IF(ASSOCIATED(equations)) THEN
3926  equations_set=>equations%EQUATIONS_SET
3927  IF(ASSOCIATED(equations_set)) THEN
3928 
3929  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
3930  & number_of_dimensions,err,error,*999)
3931 
3932  input_type=1
3933  input_option=1
3934  NULLIFY(input_data1)
3935  CALL field_parameter_set_data_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
3936  & field_values_set_type,input_data1,err,error,*999)
3937  CALL fluid_mechanics_io_read_data(solver_linear_type,input_data1, &
3938  & number_of_dimensions,input_type,input_option,control_loop%TIME_LOOP%ITERATION_NUMBER,1.0_dp)
3939 
3940  ELSE
3941  CALL flagerror("Equations set is not associated.",err,error,*999)
3942  END IF
3943 
3944  ELSE
3945  CALL flagerror("Equations are not associated.",err,error,*999)
3946  END IF
3947  ELSE
3948  CALL flagerror("Solver equations are not associated.",err,error,*999)
3949  END IF
3950  ELSE IF(problem_subtype==problem_nonlinear_source_advection_diffusion_subtype .OR. &
3951  & problem_subtype==problem_nonlinear_source_ale_advection_diffusion_subtype) THEN
3952  CALL flagerror("Not implemented.",err,error,*999)
3953  ENDIF
3954 
3955  CALL field_parameter_set_update_start(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
3956  & field_values_set_type,err,error,*999)
3957  CALL field_parameter_set_update_finish(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
3958  & field_values_set_type,err,error,*999)
3959 
3960  ELSE
3961  CALL flagerror("Problem is not associated.",err,error,*999)
3962  ENDIF
3963  ELSE
3964  CALL flagerror("Solver is not associated.",err,error,*999)
3965  ENDIF
3966  ELSE
3967  CALL flagerror("Control loop is not associated.",err,error,*999)
3968  ENDIF
3969 
3970  exits("AdvectionDiffusion_PreSolveUpdateInputData")
3971  RETURN
3972 999 errors("AdvectionDiffusion_PreSolveUpdateInputData",err,error)
3973  exits("AdvectionDiffusion_PreSolveUpdateInputData")
3974  RETURN 1
3975 
3976  END SUBROUTINE advectiondiffusion_presolveupdateinputdata
3977 
3978  !
3979  !================================================================================================================================
3980  !
3981  !Update the boundary conditions
3982  SUBROUTINE advection_diffusion_pre_solve_update_bc(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
3983  !Argument variables
3984  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
3985  TYPE(solver_type), POINTER :: SOLVER
3986  INTEGER(INTG), INTENT(OUT) :: ERR
3987  TYPE(varying_string), INTENT(OUT) :: ERROR
3988  !Local Variables
3989  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
3990  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
3991  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3992  TYPE(equations_type), POINTER :: EQUATIONS
3993  TYPE(varying_string) :: LOCAL_ERROR
3994  TYPE(boundary_conditions_variable_type), POINTER :: BOUNDARY_CONDITIONS_VARIABLE
3995  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
3996  TYPE(field_type), POINTER :: DEPENDENT_FIELD
3997  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
3998  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT
3999 
4000 !\todo: Reduce number of variable used
4001  INTEGER(INTG) :: BOUNDARY_CONDITION_CHECK_VARIABLE,node_idx
4002  INTEGER(INTG) :: NUMBER_OF_COMPONENTS
4003  INTEGER(INTG) :: local_ny,global_ny
4004  REAL(DP), POINTER :: BOUNDARY_VALUES(:)
4005  INTEGER(INTG), POINTER :: BOUNDARY_NODES(:)
4006 
4007  enters("ADVECTION_DIFFUSION_PRE_SOLVE_UPDATE_BC",err,error,*999)
4008 
4009  IF(ASSOCIATED(control_loop)) THEN
4010  CALL control_loop_current_times_get(control_loop,current_time,time_increment,err,error,*999)
4011  WRITE (*,*) control_loop%TIME_LOOP%ITERATION_NUMBER
4012  IF(ASSOCIATED(solver)) THEN
4013  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
4014  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
4015  CALL flagerror("Problem specification is not allocated.",err,error,*999)
4016  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
4017  CALL flagerror("Problem specification does not have a subtype set.",err,error,*999)
4018  END IF
4019  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
4020  CASE (problem_no_source_advection_diffusion_subtype,problem_linear_source_advection_diffusion_subtype,&
4021  & problem_nonlinear_source_advection_diffusion_subtype,problem_no_source_ale_advection_diffusion_subtype,&
4022  & problem_linear_source_ale_advection_diffusion_subtype,problem_nonlinear_source_ale_advection_diffusion_subtype)
4023  solver_equations=>solver%SOLVER_EQUATIONS
4024  IF(ASSOCIATED(solver_equations)) THEN
4025  solver_mapping=>solver_equations%SOLVER_MAPPING
4026  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
4027  IF(ASSOCIATED(equations)) THEN
4028  equations_set=>equations%EQUATIONS_SET
4029  IF(ASSOCIATED(equations_set)) THEN
4030  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
4031  IF(ASSOCIATED(boundary_conditions)) THEN
4032  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
4033  IF(ASSOCIATED(dependent_field)) THEN
4034  CALL field_variable_get(dependent_field,field_u_variable_type,field_variable,err,error,*999)
4035  IF(ASSOCIATED(field_variable)) THEN
4036  CALL boundary_conditions_variable_get(boundary_conditions,field_variable,boundary_conditions_variable, &
4037  & err,error,*999)
4038  IF(ASSOCIATED(boundary_conditions_variable)) THEN
4039  CALL field_number_of_components_get(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
4040  & number_of_components,err,error,*999)
4041  NULLIFY(boundary_values)
4042  NULLIFY(boundary_nodes)
4043  CALL fluid_mechanics_io_read_boundary_conditions_iteration(solver_linear_type,boundary_values, &
4044  & boundary_nodes,number_of_components,boundary_condition_fixed,control_loop%TIME_LOOP%INPUT_NUMBER, &
4045  & control_loop%TIME_LOOP%ITERATION_NUMBER)
4046  WRITE(*,*) SIZE(boundary_values)
4047  DO node_idx=1,SIZE(boundary_values)
4048  !Default to version 1 of each node derivative
4049  CALL field_component_dof_get_user_node(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
4050  & 1,no_global_deriv,boundary_nodes(node_idx), &
4051  & 1,local_ny,global_ny,err,error,*999)
4052  boundary_condition_check_variable=boundary_conditions_variable% &
4053  & condition_types(local_ny)
4054  IF(boundary_condition_check_variable==boundary_condition_fixed) THEN
4055  CALL field_parameter_set_update_local_dof(equations_set%DEPENDENT%DEPENDENT_FIELD, &
4056  & field_u_variable_type,field_values_set_type,local_ny, &
4057  & boundary_values(node_idx),err,error,*999)
4058  END IF
4059  ENDDO
4060  ELSE
4061  CALL flagerror("Boundary condition variable is not associated.",err,error,*999)
4062  END IF
4063  ELSE
4064  CALL flagerror("Dependent field variable is not associated.",err,error,*999)
4065  END IF
4066  ELSE
4067  CALL flagerror("Equations set dependent variable is not associated.",err,error,*999)
4068  END IF
4069  ELSE
4070  CALL flagerror("Boundary conditions are not associated.",err,error,*999)
4071  END IF
4072  ELSE
4073  CALL flagerror("Equations set is not associated.",err,error,*999)
4074  END IF
4075  ELSE
4076  CALL flagerror("Equations are not associated.",err,error,*999)
4077  END IF
4078  ELSE
4079  CALL flagerror("Solver equations are not associated.",err,error,*999)
4080  END IF
4081  CALL field_parameter_set_update_start(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
4082  & field_values_set_type,err,error,*999)
4083  CALL field_parameter_set_update_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
4084  & field_values_set_type,err,error,*999)
4085  CASE DEFAULT
4086  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
4087  & " is not valid for an advection-diffusion equation of a classical field problem class."
4088  CALL flagerror(local_error,err,error,*999)
4089  END SELECT
4090  ELSE
4091  CALL flagerror("Problem is not associated.",err,error,*999)
4092  ENDIF
4093  ELSE
4094  CALL flagerror("Solver is not associated.",err,error,*999)
4095  ENDIF
4096  ELSE
4097  CALL flagerror("Control loop is not associated.",err,error,*999)
4098  ENDIF
4099 
4100  exits("ADVECTION_DIFFUSION_PRE_SOLVE_UPDATE_BC")
4101  RETURN
4102 999 errorsexits("ADVECTION_DIFFUSION_PRE_SOLVE_UPDATE_BC",err,error)
4103  RETURN 1
4104 
4105  END SUBROUTINE advection_diffusion_pre_solve_update_bc
4106  !
4107  !================================================================================================================================
4108  !
4109  SUBROUTINE advection_diffusion_post_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
4110 
4111  !Argument variables
4112  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
4113  TYPE(solver_type), POINTER :: SOLVER
4114  INTEGER(INTG), INTENT(OUT) :: ERR
4115  TYPE(varying_string), INTENT(OUT) :: ERROR
4116  !Local Variables
4117  TYPE(solver_type), POINTER :: SOLVER2
4118  TYPE(varying_string) :: LOCAL_ERROR
4119 
4120  enters("ADVECTION_DIFFUSION_POST_SOLVE",err,error,*999)
4121  NULLIFY(solver2)
4122 
4123  IF(ASSOCIATED(control_loop)) THEN
4124  IF(ASSOCIATED(solver)) THEN
4125  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
4126  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
4127  CALL flagerror("Problem specification is not allocated.",err,error,*999)
4128  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
4129  CALL flagerror("Problem specification does not have a subtype set.",err,error,*999)
4130  END IF
4131  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
4132  CASE(problem_no_source_advection_diffusion_subtype,problem_linear_source_advection_diffusion_subtype, &
4133  & problem_no_source_ale_advection_diffusion_subtype,problem_linear_source_ale_advection_diffusion_subtype)
4134  CALL advection_diffusion_post_solve_output_data(control_loop,solver,err,error,*999)
4135  CASE(problem_nonlinear_source_advection_diffusion_subtype,problem_nonlinear_source_ale_advection_diffusion_subtype, &
4136  & problem_no_source_static_advec_diff_subtype,problem_linear_source_static_advec_diff_subtype)
4137  ! do nothing ???
4138  !CALL FlagError("Not implemented.",ERR,ERROR,*999)
4139  CASE DEFAULT
4140  local_error="The third problem specification of "// &
4141  & trim(number_to_vstring(control_loop%PROBLEM%specification(3),"*",err,error))// &
4142  & " is not valid for an advection-diffusion type of a classical field problem."
4143  CALL flagerror(local_error,err,error,*999)
4144  END SELECT
4145  ELSE
4146  CALL flagerror("Problem is not associated.",err,error,*999)
4147  ENDIF
4148  ELSE
4149  CALL flagerror("Solver is not associated.",err,error,*999)
4150  ENDIF
4151  ELSE
4152  CALL flagerror("Control loop is not associated.",err,error,*999)
4153  ENDIF
4154 
4155  exits("ADVECTION_DIFFUSION_POST_SOLVE")
4156  RETURN
4157 999 errorsexits("ADVECTION_DIFFUSION_POST_SOLVE",err,error)
4158  RETURN 1
4159  END SUBROUTINE advection_diffusion_post_solve
4160  !
4161  !================================================================================================================================
4162  !
4163  SUBROUTINE advection_diffusion_post_solve_output_data(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
4164 
4165  !Argument variables
4166  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
4167  TYPE(solver_type), POINTER :: SOLVER
4168  INTEGER(INTG), INTENT(OUT) :: ERR
4169  TYPE(varying_string), INTENT(OUT) :: ERROR
4170  !Local variables
4171  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
4172  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
4173  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
4174  TYPE(varying_string) :: LOCAL_ERROR
4175 
4176  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT
4177  INTEGER(INTG) :: EQUATIONS_SET_IDX,CURRENT_LOOP_ITERATION,OUTPUT_ITERATION_NUMBER
4178 
4179  CHARACTER(14) :: FILE
4180  CHARACTER(14) :: OUTPUT_FILE
4181 
4182  enters("ADVECTION_DIFFUSION_POST_SOLVE_OUTPUT_DATA",err,error,*999)
4183 
4184  IF(ASSOCIATED(control_loop)) THEN
4185  IF(ASSOCIATED(solver)) THEN
4186  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
4187  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
4188  CALL flagerror("Problem specification is not allocated.",err,error,*999)
4189  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
4190  CALL flagerror("Problem specification does not have a subtype set.",err,error,*999)
4191  END IF
4192  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
4193  CASE(problem_no_source_advection_diffusion_subtype,problem_linear_source_advection_diffusion_subtype)
4194  CALL control_loop_current_times_get(control_loop,current_time,time_increment,err,error,*999)
4195  solver_equations=>solver%SOLVER_EQUATIONS
4196  IF(ASSOCIATED(solver_equations)) THEN
4197  solver_mapping=>solver_equations%SOLVER_MAPPING
4198  IF(ASSOCIATED(solver_mapping)) THEN
4199  !Make sure the equations sets are up to date
4200  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
4201  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
4202 
4203  current_loop_iteration=control_loop%TIME_LOOP%ITERATION_NUMBER
4204  output_iteration_number=control_loop%TIME_LOOP%OUTPUT_NUMBER
4205 
4206  IF(output_iteration_number/=0) THEN
4207  IF(control_loop%TIME_LOOP%CURRENT_TIME<=control_loop%TIME_LOOP%STOP_TIME) THEN
4208  IF(current_loop_iteration<10) THEN
4209  WRITE(output_file,'("TIME_STEP_000",I0)') current_loop_iteration
4210  ELSE IF(current_loop_iteration<100) THEN
4211  WRITE(output_file,'("TIME_STEP_00",I0)') current_loop_iteration
4212  ELSE IF(current_loop_iteration<1000) THEN
4213  WRITE(output_file,'("TIME_STEP_0",I0)') current_loop_iteration
4214  ELSE IF(current_loop_iteration<10000) THEN
4215  WRITE(output_file,'("TIME_STEP_",I0)') current_loop_iteration
4216  END IF
4217  file=output_file
4218 ! FILE="TRANSIENT_OUTPUT"
4219 ! METHOD="FORTRAN"
4220 ! EXPORT_FIELD=.TRUE.
4221 ! IF(EXPORT_FIELD) THEN
4222 ! IF(MOD(CURRENT_LOOP_ITERATION,OUTPUT_ITERATION_NUMBER)==0) THEN
4223  CALL write_string(general_output_type,"...",err,error,*999)
4224  CALL write_string(general_output_type,"Now export fields... ",err,error,*999)
4225  CALL fluid_mechanics_io_write_cmgui(equations_set%REGION,equations_set%GLOBAL_NUMBER,file, &
4226  & err,error,*999)
4227  CALL write_string(general_output_type,output_file,err,error,*999)
4228  CALL write_string(general_output_type,"...",err,error,*999)
4229 ! ENDIF
4230 ! ENDIF
4231  ENDIF
4232  ENDIF
4233  ENDDO
4234  ENDIF
4235  ENDIF
4236  CASE(problem_nonlinear_source_advection_diffusion_subtype)
4237  ! do nothing ???
4238  CALL flagerror("Not implemented.",err,error,*999)
4239  CASE DEFAULT
4240  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
4241  & " is not valid for an advection-diffusion equation type of a classical field problem class."
4242  CALL flagerror(local_error,err,error,*999)
4243  END SELECT
4244  ELSE
4245  CALL flagerror("Problem is not associated.",err,error,*999)
4246  ENDIF
4247  ELSE
4248  CALL flagerror("Solver is not associated.",err,error,*999)
4249  ENDIF
4250  ELSE
4251  CALL flagerror("Control loop is not associated.",err,error,*999)
4252  ENDIF
4253 
4254  exits("ADVECTION_DIFFUSION_POST_SOLVE_OUTPUT_DATA")
4255  RETURN
4256 999 errorsexits("ADVECTION_DIFFUSION_POST_SOLVE_OUTPUT_DATA",err,error)
4257  RETURN 1
4258  END SUBROUTINE advection_diffusion_post_solve_output_data
4259  !
4260  !================================================================================================================================
4261  !
4262 END MODULE advection_diffusion_equation_routines
4263 
equations_set_constants::equations_set_setup_dependent_type
integer(intg), parameter equations_set_setup_dependent_type
Dependent variables.
Definition: equations_set_constants.f90:324
equations_set_constants::equations_set_fem_solution_method
integer(intg), parameter equations_set_fem_solution_method
Finite Element Method solution method.
Definition: equations_set_constants.f90:348
equations_set_constants::equations_set_quad_source_advection_diff_supg_subtype
integer(intg), parameter equations_set_quad_source_advection_diff_supg_subtype
Definition: equations_set_constants.f90:272
basis_routines
This module contains all basis function routines.
Definition: basis_routines.f90:45
equations_set_constants::equations_set_setup_materials_type
integer(intg), parameter equations_set_setup_materials_type
Materials setup.
Definition: equations_set_constants.f90:326
types::boundary_conditions_type
Contains information on the boundary conditions for the solver equations.
Definition: types.f90:1780
base_routines::enters
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Definition: base_routines.f90:363
solver_routines::solvers_create_finish
subroutine, public solvers_create_finish(SOLVERS, ERR, ERROR,)
Finish the creation of solvers.
Definition: solver_routines.f90:22598
advection_diffusion_equation_routines::advectiondiffusion_finiteelementcalculate
subroutine, public advectiondiffusion_finiteelementcalculate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element stiffness matrices and RHS for a diffusion equation finite element equations s...
Definition: advection_diffusion_equation_routines.f90:2285
equations_mapping_routines::equations_mapping_dynamic_variable_type_set
subroutine, public equations_mapping_dynamic_variable_type_set(EQUATIONS_MAPPING, DYNAMIC_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set dynamic matrices...
Definition: equations_mapping_routines.f90:1996
equations_set_constants::equations_set_constant_source_advection_diff_supg_subtype
integer(intg), parameter equations_set_constant_source_advection_diff_supg_subtype
Definition: equations_set_constants.f90:270
types::equations_mapping_type
Contains information on the equations mapping i.e., how field variable DOFS are mapped to the rows an...
Definition: types.f90:1681
types::equations_type
Contains information about the equations in an equations set.
Definition: types.f90:1735
equations_set_constants::equations_set_gfem_solution_method
integer(intg), parameter equations_set_gfem_solution_method
Grid-based Finite Element Method solution method.
Definition: equations_set_constants.f90:352
problem_constants::problem_control_time_loop_type
integer(intg), parameter problem_control_time_loop_type
Time control loop.
Definition: problem_constants.f90:283
problem_constants::problem_linear_source_advection_diffusion_subtype
integer(intg), parameter problem_linear_source_advection_diffusion_subtype
Definition: problem_constants.f90:204
problem_constants::problem_setup_control_type
integer(intg), parameter problem_setup_control_type
Solver setup for a problem.
Definition: problem_constants.f90:263
equations_set_constants::equations_set_linear_source_advection_diff_supg_subtype
integer(intg), parameter equations_set_linear_source_advection_diff_supg_subtype
Definition: equations_set_constants.f90:271
problem_constants
This module handles all problem wide constants.
Definition: problem_constants.f90:45
problem_constants::solver_equations_first_order_dynamic
integer(intg), parameter solver_equations_first_order_dynamic
Solver equations are first order dynamic.
Definition: problem_constants.f90:311
control_loop_routines::control_loop_node
integer(intg), parameter, public control_loop_node
The identifier for a each "leaf" node in a control loop.
Definition: control_loop_routines.f90:67
solver_routines::solver_dynamic_order_set
subroutine, public solver_dynamic_order_set(SOLVER, ORDER, ERR, ERROR,)
Sets/changes the order for a dynamic solver.
Definition: solver_routines.f90:6327
constants::no_global_deriv
integer(intg), parameter no_global_deriv
No global derivative i.e., u.
Definition: constants.f90:213
problem_constants::problem_nonlinear_source_static_advec_diff_subtype
integer(intg), parameter problem_nonlinear_source_static_advec_diff_subtype
Definition: problem_constants.f90:213
strings::number_to_vstring
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
equations_routines::equations_create_start
subroutine, public equations_create_start(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Start the creation of equations for the equation set.
Definition: equations_routines.f90:192
types::decomposition_type
Contains information on the mesh decomposition.
Definition: types.f90:1063
equations_set_constants::equations_set_linear_source_static_advec_diff_subtype
integer(intg), parameter equations_set_linear_source_static_advec_diff_subtype
Definition: equations_set_constants.f90:267
problem_constants::problem_linear_source_static_advec_diff_subtype
integer(intg), parameter problem_linear_source_static_advec_diff_subtype
Definition: problem_constants.f90:212
types::equations_set_independent_type
Contains information on the independent variables for the equations set.
Definition: types.f90:1907
equations_matrices_routines::equations_matrices_create_start
subroutine, public equations_matrices_create_start(EQUATIONS, EQUATIONS_MATRICES, ERR, ERROR,)
Starts the creation of the equations matrices and rhs for the the equations.
Definition: equations_matrices_routines.f90:615
types::solver_type
Contains information on the type of solver to be used.
Definition: types.f90:2777
solver_routines::solver_petsc_library
integer(intg), parameter, public solver_petsc_library
PETSc solver library.
Definition: solver_routines.f90:104
solver_routines::solvers_number_set
subroutine, public solvers_number_set(SOLVERS, NUMBER_OF_SOLVERS, ERR, ERROR,)
Sets/changes the number of solvers.
Definition: solver_routines.f90:22805
constants::no_part_deriv
integer(intg), parameter no_part_deriv
No partial derivative i.e., u.
Definition: constants.f90:177
solver_routines::solver_dynamic_crank_nicolson_scheme
integer(intg), parameter, public solver_dynamic_crank_nicolson_scheme
Crank-Nicolson dynamic solver.
Definition: solver_routines.f90:282
solver_routines::solver_dynamic_degree_set
subroutine, public solver_dynamic_degree_set(SOLVER, DEGREE, ERR, ERROR,)
Sets/changes the degree of the polynomial used to interpolate time for a dynamic solver.
Definition: solver_routines.f90:5484
advection_diffusion_equation_routines::advectiondiffusion_equationssetsetup
subroutine, public advectiondiffusion_equationssetsetup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the diffusion equation type of a classical field equations set class.
Definition: advection_diffusion_equation_routines.f90:531
equations_matrices_routines
This module handles all equations matrix and rhs routines.
Definition: equations_matrices_routines.f90:45
solver_routines::solver_dynamic_first_order
integer(intg), parameter, public solver_dynamic_first_order
Dynamic solver has first order terms.
Definition: solver_routines.f90:255
solver_routines::solver_type_set
subroutine, public solver_type_set(SOLVER, SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type for a solver.
Definition: solver_routines.f90:21345
equations_set_constants::equations_set_no_source_advection_diff_supg_subtype
integer(intg), parameter equations_set_no_source_advection_diff_supg_subtype
Definition: equations_set_constants.f90:269
equations_set_constants::equations_static
integer(intg), parameter equations_static
The equations are static and have no time dependence.
Definition: equations_set_constants.f90:376
types::equations_set_type
Contains information on an equations set.
Definition: types.f90:1941
equations_routines
This module handles all equations routines.
Definition: equations_routines.f90:45
equations_set_constants::equations_set_setup_source_type
integer(intg), parameter equations_set_setup_source_type
Source setup.
Definition: equations_set_constants.f90:327
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
fluid_mechanics_io_routines::source_field
type(field_type), pointer source_field
Definition: fluid_mechanics_IO_routines.f90:174
solver_routines::solvers_create_start
subroutine, public solvers_create_start(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Start the creation of a solvers for the control loop.
Definition: solver_routines.f90:22651
equations_set_constants::equations_set_linear_source_advection_diffusion_subtype
integer(intg), parameter equations_set_linear_source_advection_diffusion_subtype
Definition: equations_set_constants.f90:254
types::solvers_type
Contains information on the solvers to be used in a control loop.
Definition: types.f90:2805
equations_mapping_routines::equations_mapping_dynamic_matrices_set
Definition: equations_mapping_routines.f90:83
equations_set_constants::equations_set_constant_source_ale_advection_diff_supg_subtype
integer(intg), parameter equations_set_constant_source_ale_advection_diff_supg_subtype
Definition: equations_set_constants.f90:275
equations_set_constants::equations_set_no_source_static_advec_diff_subtype
integer(intg), parameter equations_set_no_source_static_advec_diff_subtype
Definition: equations_set_constants.f90:265
constants::first_part_deriv
integer(intg), parameter first_part_deriv
First partial derivative i.e., du/ds.
Definition: constants.f90:178
problem_constants::problem_nonlinear_source_ale_advection_diffusion_subtype
integer(intg), parameter problem_nonlinear_source_ale_advection_diffusion_subtype
Definition: problem_constants.f90:208
timer
This module contains routines for timing the program.
Definition: timer_f.f90:45
control_loop_routines::control_loop_current_times_get
subroutine, public control_loop_current_times_get(CONTROL_LOOP, CURRENT_TIME, TIME_INCREMENT, ERR, ERROR,)
Gets the current time parameters for a time control loop.
Definition: control_loop_routines.f90:231
advection_diffusion_equation_routines::advectiondiffusion_problemlinearsetup
subroutine advectiondiffusion_problemlinearsetup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the diffusion equations.
Definition: advection_diffusion_equation_routines.f90:3119
types::equations_matrices_source_type
Contains information of the source vector for equations matrices.
Definition: types.f90:1510
equations_matrices_routines::equations_matrices_dynamic_lumping_type_set
subroutine, public equations_matrices_dynamic_lumping_type_set(EQUATIONS_MATRICES, LUMPING_TYPE, ERR, ERROR,)
Sets the lumping of the linear equations matrices.
Definition: equations_matrices_routines.f90:3760
problem_constants::solver_equations_static
integer(intg), parameter solver_equations_static
Solver equations are static.
Definition: problem_constants.f90:309
fluid_mechanics_io_routines::fluid_mechanics_io_write_cmgui
subroutine, public fluid_mechanics_io_write_cmgui(REGION, EQUATIONS_SET_GLOBAL_NUMBER, NAME, ERR, ERROR,)
Writes solution into cmgui formats exelem and exnode.
Definition: fluid_mechanics_IO_routines.f90:303
equations_routines::equations_time_dependence_type_set
subroutine, public equations_time_dependence_type_set(EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for equations.
Definition: equations_routines.f90:851
solver_routines::solver_equations_sparsity_type_set
subroutine, public solver_equations_sparsity_type_set(SOLVER_EQUATIONS, SPARSITY_TYPE, ERR, ERROR,)
Sets/changes the sparsity type for solver equations.
Definition: solver_routines.f90:7734
analytic_analysis_routines
This module handles all analytic analysis routines.
Definition: analytic_analysis_routines.f90:45
solver_routines::solvers_solver_get
subroutine, public solvers_solver_get(SOLVERS, SOLVER_INDEX, SOLVER, ERR, ERROR,)
Returns a pointer to the specified solver in the list of solvers.
Definition: solver_routines.f90:22876
types::field_type
Contains information for a field defined on a region.
Definition: types.f90:1346
equations_matrices_routines::equations_matrices_full_matrices
integer(intg), parameter, public equations_matrices_full_matrices
Use fully populated equation matrices.
Definition: equations_matrices_routines.f90:91
advection_diffusion_equation_routines::advectiondiffusion_boundaryconditionsanalyticcalculate
subroutine, public advectiondiffusion_boundaryconditionsanalyticcalculate(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Calculates the analytic solution and sets the boundary conditions for an analytic problem...
Definition: advection_diffusion_equation_routines.f90:116
equations_mapping_routines::equations_mapping_rhs_variable_type_set
subroutine, public equations_mapping_rhs_variable_type_set(EQUATIONS_MAPPING, RHS_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set rhs vector.
Definition: equations_mapping_routines.f90:3170
problem_constants::solver_equations_linear
integer(intg), parameter solver_equations_linear
Solver equations are linear.
Definition: problem_constants.f90:301
constants::global_deriv_s2
integer(intg), parameter global_deriv_s2
First global derivative in the s2 direction i.e., du/ds2.
Definition: constants.f90:215
equations_set_constants::equations_set_linear_source_ale_advection_diff_supg_subtype
integer(intg), parameter equations_set_linear_source_ale_advection_diff_supg_subtype
Definition: equations_set_constants.f90:276
types::control_loop_type
Contains information on a control loop.
Definition: types.f90:3185
advection_diffusion_equation_routines::advectiondiffusion_problemspecificationset
subroutine, public advectiondiffusion_problemspecificationset(problem, problemSpecification, err, error,)
Sets the problem specification for an advection diffusion problem type.
Definition: advection_diffusion_equation_routines.f90:3060
iso_varying_string
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
Definition: iso_varying_string.f90:62
equations_set_constants::equations_set_exponential_source_advection_diffusion_subtype
integer(intg), parameter equations_set_exponential_source_advection_diffusion_subtype
Definition: equations_set_constants.f90:256
solver_routines::solver_equations_create_finish
subroutine, public solver_equations_create_finish(SOLVER_EQUATIONS, ERR, ERROR,)
Finishes the process of creating solver equations.
Definition: solver_routines.f90:7166
equations_set_constants::equations_set_no_source_advection_diffusion_subtype
integer(intg), parameter equations_set_no_source_advection_diffusion_subtype
Definition: equations_set_constants.f90:252
solver_routines::solver_sparse_matrices
integer(intg), parameter, public solver_sparse_matrices
Use sparse solver matrices.
Definition: solver_routines.f90:360
solver_routines::solver_equations_create_start
subroutine, public solver_equations_create_start(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Starts the process of creating solver equations.
Definition: solver_routines.f90:7209
solver_routines::solver_dynamic_type
integer(intg), parameter, public solver_dynamic_type
A dynamic solver.
Definition: solver_routines.f90:90
equations_set_constants::equations_set_no_source_ale_advection_diffusion_subtype
integer(intg), parameter equations_set_no_source_ale_advection_diffusion_subtype
Definition: equations_set_constants.f90:257
types::equations_set_equations_set_field_type
Definition: types.f90:1933
equations_set_constants::equations_set_advection_diffusion_equation_two_dim_1
integer(intg), parameter equations_set_advection_diffusion_equation_two_dim_1
u(x,y)=tanh(1 - alpha.(x.tan(Phi) - y)),this is a steady-state solution
Definition: equations_set_constants.f90:469
basis_routines::basis_default_quadrature_scheme
integer(intg), parameter, public basis_default_quadrature_scheme
Identifier for the default quadrature scheme.
Definition: basis_routines.f90:125
problem_constants::problem_setup_solvers_type
integer(intg), parameter problem_setup_solvers_type
Solver setup for a problem.
Definition: problem_constants.f90:264
equations_set_constants::equations_set_setup_equations_type
integer(intg), parameter equations_set_setup_equations_type
Equations setup.
Definition: equations_set_constants.f90:330
types::equations_mapping_dynamic_type
Contains information for mapping field variables to the dynamic matrices in the equations set of the ...
Definition: types.f90:1571
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
equations_set_constants::equations_set_setup_independent_type
integer(intg), parameter equations_set_setup_independent_type
Independent variables.
Definition: equations_set_constants.f90:325
constants
This module contains all program wide constants.
Definition: constants.f90:45
solver_routines::solver_library_type_set
subroutine, public solver_library_type_set(SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library type to use for the solver.
Definition: solver_routines.f90:9067
equations_mapping_routines::equationsmapping_linearmatricesnumberset
subroutine, public equationsmapping_linearmatricesnumberset(EQUATIONS_MAPPING, NUMBER_OF_LINEAR_EQUATIONS_MATRICES, ERR, ERROR,)
Sets/changes the number of linear equations matrices.
Definition: equations_mapping_routines.f90:2484
equations_routines::equations_lumped_matrices
integer(intg), parameter, public equations_lumped_matrices
The equations matrices are "mass" lumped.
Definition: equations_routines.f90:88
problem_constants::problem_setup_initial_type
integer(intg), parameter problem_setup_initial_type
Initial setup for a problem.
Definition: problem_constants.f90:262
problem_constants::problem_coupled_source_diffusion_advec_diffusion_subtype
integer(intg), parameter problem_coupled_source_diffusion_advec_diffusion_subtype
Definition: problem_constants.f90:246
equations_mapping_routines::equationsmapping_linearmatricesvariabletypesset
subroutine, public equationsmapping_linearmatricesvariabletypesset(EQUATIONS_MAPPING, LINEAR_MATRIX_VARIABLE_TYPES, ERR, ERROR,)
Sets the mapping between the dependent field variable types and the linear equations matrices...
Definition: equations_mapping_routines.f90:2716
types::problem_setup_type
Definition: types.f90:3215
fluid_mechanics_io_routines::fluid_mechanics_io_read_data
subroutine, public fluid_mechanics_io_read_data(SOLVER_TYPE, INPUT_VALUES, NUMBER_OF_DIMENSIONS, INPUT_TYPE, INPUT_OPTION, TIME_STEP, LENGTH_SCALE)
Reads input data from a file.
Definition: fluid_mechanics_IO_routines.f90:4319
problem_constants::problem_no_source_static_advec_diff_subtype
integer(intg), parameter problem_no_source_static_advec_diff_subtype
Definition: problem_constants.f90:211
equations_set_constants::equations_first_order_dynamic
integer(intg), parameter equations_first_order_dynamic
The equations are first order dynamic.
Definition: equations_set_constants.f90:378
types::boundary_conditions_variable_type
Contains information on the boundary conditions for a dependent field variable.
Definition: types.f90:1759
advection_diffusion_equation_routines::advectiondiffusion_presolvegetsourcevalue
subroutine, public advectiondiffusion_presolvegetsourcevalue(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Definition: advection_diffusion_equation_routines.f90:3736
advection_diffusion_equation_routines
This module handles all advection-diffusion equation routines.
Definition: advection_diffusion_equation_routines.f90:45
advection_diffusion_equation_routines::advectiondiffusion_equationssetlinearsetup
subroutine advectiondiffusion_equationssetlinearsetup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the linear advection-diffusion equation.
Definition: advection_diffusion_equation_routines.f90:803
equations_set_constants::equations_set_no_source_static_advec_diff_supg_subtype
integer(intg), parameter equations_set_no_source_static_advec_diff_supg_subtype
Definition: equations_set_constants.f90:279
solver_routines::solver_equations_linearity_type_set
subroutine, public solver_equations_linearity_type_set(SOLVER_EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for solver equations.
Definition: solver_routines.f90:7577
equations_set_constants::equations_set_multi_comp_transport_advec_diff_supg_subtype
integer(intg), parameter equations_set_multi_comp_transport_advec_diff_supg_subtype
Definition: equations_set_constants.f90:286
equations_set_constants::equations_set_setup_start_action
integer(intg), parameter equations_set_setup_start_action
Start setup action.
Definition: equations_set_constants.f90:338
problem_constants::problem_classical_field_class
integer(intg), parameter problem_classical_field_class
Definition: problem_constants.f90:58
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
control_loop_routines::control_loop_solvers_get
recursive subroutine, public control_loop_solvers_get(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Returns a pointer to the solvers for a control loop.
Definition: control_loop_routines.f90:1333
equations_set_constants::equations_set_constant_source_static_advec_diff_subtype
integer(intg), parameter equations_set_constant_source_static_advec_diff_subtype
Definition: equations_set_constants.f90:266
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
types::equations_matrices_type
Contains information on the equations matrices and vectors.
Definition: types.f90:1520
advection_diffusion_equation_routines::advectiondiffusion_equationssetspecificationset
subroutine, public advectiondiffusion_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for a diffusion equation type of a classical field equations set clas...
Definition: advection_diffusion_equation_routines.f90:723
equations_matrices_routines::equations_matrix_fem_structure
integer(intg), parameter, public equations_matrix_fem_structure
Finite element matrix structure.
Definition: equations_matrices_routines.f90:72
equations_set_constants::equations_set_constant_source_advection_diffusion_subtype
integer(intg), parameter equations_set_constant_source_advection_diffusion_subtype
Definition: equations_set_constants.f90:253
input_output::write_string
Write a string to a given output stream.
Definition: input_output.f90:74
base_routines
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
Definition: base_routines.f90:45
types::equations_matrices_linear_type
Contains information of the linear matrices for equations matrices.
Definition: types.f90:1479
advection_diffusion_equation_routines::advection_diffusion_pre_solve
subroutine, public advection_diffusion_pre_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the diffusion equations.
Definition: advection_diffusion_equation_routines.f90:3379
base_routines::general_output_type
integer(intg), parameter, public general_output_type
General output type.
Definition: base_routines.f90:66
equations_matrices_routines::equationsmatrices_dynamicstructuretypeset
subroutine, public equationsmatrices_dynamicstructuretypeset(EQUATIONS_MATRICES, STRUCTURE_TYPE, ERR, ERROR,)
Sets the structure (sparsity) of the dynamic equations matrices.
Definition: equations_matrices_routines.f90:4090
problem_constants::problem_linear_source_ale_advection_diffusion_subtype
integer(intg), parameter problem_linear_source_ale_advection_diffusion_subtype
Definition: problem_constants.f90:207
iso_varying_string::trim
Definition: iso_varying_string.f90:204
equations_matrices_routines::equations_matrices_linear_storage_type_set
subroutine, public equations_matrices_linear_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the linear equations matrices.
Definition: equations_matrices_routines.f90:3898
equations_matrices_routines::equationsmatrices_linearstructuretypeset
subroutine, public equationsmatrices_linearstructuretypeset(EQUATIONS_MATRICES, STRUCTURE_TYPE, ERR, ERROR,)
Sets the structure (sparsity) of the linear equations matrices.
Definition: equations_matrices_routines.f90:4160
equations_mapping_routines::equations_mapping_create_finish
subroutine, public equations_mapping_create_finish(EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping.
Definition: equations_mapping_routines.f90:982
control_loop_routines::control_loop_get
Returns the specified control loop as indexed by the control loop identifier from the control loop ro...
Definition: control_loop_routines.f90:86
types::field_variable_ptr_type
A buffer type to allow for an array of pointers to a FIELD_VARIABLE_TYPE.
Definition: types.f90:1311
control_loop_routines::control_loop_type_set
subroutine, public control_loop_type_set(CONTROL_LOOP, LOOP_TYPE, ERR, ERROR,)
Sets/changes the control loop type.
Definition: control_loop_routines.f90:1750
equations_set_constants::equations_set_linear_source_static_advec_diff_supg_subtype
integer(intg), parameter equations_set_linear_source_static_advec_diff_supg_subtype
Definition: equations_set_constants.f90:281
equations_mapping_routines::equations_mapping_source_variable_type_set
subroutine, public equations_mapping_source_variable_type_set(EQUATIONS_MAPPING, SOURCE_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a source field variable and the equations set source vector.
Definition: equations_mapping_routines.f90:3378
types::equations_set_source_type
Contains information on the source for the equations set.
Definition: types.f90:1915
equations_routines::equations_set_equations_get
subroutine, public equations_set_equations_get(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Gets the equations for an equations set.
Definition: equations_routines.f90:897
types::equations_set_materials_type
Definition: types.f90:1881
equations_set_constants::equations_set_quadratic_source_advection_diffusion_subtype
integer(intg), parameter equations_set_quadratic_source_advection_diffusion_subtype
Definition: equations_set_constants.f90:255
constants::partial_derivative_first_derivative_map
integer(intg), dimension(4) partial_derivative_first_derivative_map
PARTIAL_DERIVATIVE_FIRST_DERIVATIVE_MAP(nic) gives the partial derivative index for the first derivat...
Definition: constants.f90:254
equations_routines::equations_create_finish
subroutine, public equations_create_finish(EQUATIONS, ERR, ERROR,)
Finish the creation of equations.
Definition: equations_routines.f90:159
domain_mappings
This module handles all domain mappings routines.
Definition: domain_mappings.f90:45
problem_constants::problem_setup_finish_action
integer(intg), parameter problem_setup_finish_action
Finish setup action.
Definition: problem_constants.f90:274
equations_mapping_routines
This module handles all equations mapping routines.
Definition: equations_mapping_routines.f90:45
types::solver_equations_type
Contains information about the solver equations for a solver.
Definition: types.f90:2452
matrix_vector::matrix_compressed_row_storage_type
integer(intg), parameter, public matrix_compressed_row_storage_type
Matrix compressed row storage type.
Definition: matrix_vector.f90:167
equations_matrices_routines::equations_matrices_dynamic_storage_type_set
subroutine, public equations_matrices_dynamic_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the dynamic equations matrices.
Definition: equations_matrices_routines.f90:3824
equations_matrices_routines::equations_matrix_diagonal_structure
integer(intg), parameter, public equations_matrix_diagonal_structure
Diagonal matrix structure.
Definition: equations_matrices_routines.f90:73
equations_set_constants::equations_set_gfv_solution_method
integer(intg), parameter equations_set_gfv_solution_method
Grid-based Finite Volume solution method.
Definition: equations_set_constants.f90:354
advection_diffusion_equation_routines::advection_diffusion_post_solve_output_data
subroutine, private advection_diffusion_post_solve_output_data(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Definition: advection_diffusion_equation_routines.f90:4164
equations_set_constants::equations_set_setup_geometry_type
integer(intg), parameter equations_set_setup_geometry_type
Geometry setup.
Definition: equations_set_constants.f90:323
constants::global_deriv_s1_s2
integer(intg), parameter global_deriv_s1_s2
Global Cross derivative in the s1 and s2 direction i.e., d^2u/ds1ds2.
Definition: constants.f90:216
types::problem_type
Contains information for a problem.
Definition: types.f90:3221
equations_set_constants::equations_set_classical_field_class
integer(intg), parameter equations_set_classical_field_class
Definition: equations_set_constants.f90:57
equations_set_constants::equations_linear
integer(intg), parameter equations_linear
The equations are linear.
Definition: equations_set_constants.f90:365
types::domain_nodes_type
Contains the topology information for the nodes of a domain.
Definition: types.f90:713
equations_matrices_routines::equations_matrices_create_finish
subroutine, public equations_matrices_create_finish(EQUATIONS_MATRICES, ERR, ERROR,)
Finishes the creation of the equations matrices and RHS for the the equations.
Definition: equations_matrices_routines.f90:404
advection_diffusion_equation_routines::advectiondiffusion_presolvestorecurrentsoln
subroutine, public advectiondiffusion_presolvestorecurrentsoln(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Definition: advection_diffusion_equation_routines.f90:3620
equations_set_constants::equations_set_coupled_source_diffusion_advec_diffusion_subtype
integer(intg), parameter equations_set_coupled_source_diffusion_advec_diffusion_subtype
Definition: equations_set_constants.f90:283
base_routines::diagnostics1
logical, save, public diagnostics1
.TRUE. if level 1 diagnostic output is active in the current routine
Definition: base_routines.f90:153
distributed_matrix_vector
This module handles all distributed matrix vector routines.
Definition: distributed_matrix_vector.f90:45
equations_set_constants::equations_set_constant_source_ale_advection_diffusion_subtype
integer(intg), parameter equations_set_constant_source_ale_advection_diffusion_subtype
Definition: equations_set_constants.f90:258
constants::global_deriv_s1
integer(intg), parameter global_deriv_s1
First global derivative in the s1 direction i.e., du/ds1.
Definition: constants.f90:214
boundary_conditions_routines
This module handles all boundary conditions routines.
Definition: boundary_condition_routines.f90:45
equations_set_constants::equations_set_multi_comp_transport_advec_diff_subtype
integer(intg), parameter equations_set_multi_comp_transport_advec_diff_subtype
Definition: equations_set_constants.f90:285
solver_routines
This module handles all solver routines.
Definition: solver_routines.f90:45
equations_mapping_routines::equations_mapping_create_start
subroutine, public equations_mapping_create_start(EQUATIONS, EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping for a equations set equations.
Definition: equations_mapping_routines.f90:1112
types::field_interpolated_point_type
Contains the interpolated value (and the derivatives wrt xi) of a field at a point. Old CMISS name XG.
Definition: types.f90:1129
equations_matrices_routines::equations_matrix_unlumped
integer(intg), parameter, public equations_matrix_unlumped
The matrix is not lumped.
Definition: equations_matrices_routines.f90:82
types::equations_matrix_type
Contains information about an equations matrix.
Definition: types.f90:1429
equations_set_constants::equations_set_quadratic_source_ale_advection_diffusion_subtype
integer(intg), parameter equations_set_quadratic_source_ale_advection_diffusion_subtype
Definition: equations_set_constants.f90:260
types::quadrature_scheme_type
Contains information for a particular quadrature scheme.
Definition: types.f90:141
equations_set_constants::equations_set_no_source_ale_advection_diff_supg_subtype
integer(intg), parameter equations_set_no_source_ale_advection_diff_supg_subtype
Definition: equations_set_constants.f90:274
problem_constants::problem_no_source_ale_advection_diffusion_subtype
integer(intg), parameter problem_no_source_ale_advection_diffusion_subtype
Definition: problem_constants.f90:206
problem_constants::problem_advection_diffusion_equation_type
integer(intg), parameter problem_advection_diffusion_equation_type
Definition: problem_constants.f90:90
matrix_vector
This module contains all routines dealing with (non-distributed) matrix and vectors types...
Definition: matrix_vector.f90:129
input_output::write_string_vector
Write a string followed by a vector to a specified output stream.
Definition: input_output.f90:290
distributed_matrix_vector::distributed_matrix_block_storage_type
integer(intg), parameter, public distributed_matrix_block_storage_type
Distributed matrix block storage type.
Definition: distributed_matrix_vector.f90:97
types::equations_matrix_ptr_type
A buffer type to allow for an array of pointers to a EQUATIONS_MATRIX_TYPE.
Definition: types.f90:1446
equations_matrices_routines::equations_matrix_lumped
integer(intg), parameter, public equations_matrix_lumped
The matrix is "mass" lumped.
Definition: equations_matrices_routines.f90:83
equations_routines::equations_linearity_type_set
subroutine, public equations_linearity_type_set(EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for equations.
Definition: equations_routines.f90:539
advection_diffusion_equation_routines::advectiondiffusion_presolvealeupdatemesh
subroutine advectiondiffusion_presolvealeupdatemesh(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Update mesh position and velocity for ALE advection-diffusion problem.
Definition: advection_diffusion_equation_routines.f90:3447
control_loop_routines::control_loop_create_start
subroutine, public control_loop_create_start(PROBLEM, CONTROL_LOOP, ERR, ERROR,)
Start the process of creating a control loop for a problem.
Definition: control_loop_routines.f90:194
advection_diffusion_equation_routines::advectiondiffusion_presolveupdateinputdata
subroutine, public advectiondiffusion_presolveupdateinputdata(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Update independent field (velocity) for advection-diffusion pre solve.
Definition: advection_diffusion_equation_routines.f90:3886
fluid_mechanics_io_routines::fluid_mechanics_io_read_boundary_conditions_iteration
subroutine, public fluid_mechanics_io_read_boundary_conditions_iteration(SOLVER_TYPE, BOUNDARY_VALUES, BOUNDARY_NODES, NUMBER_OF_DIMENSIONS, BOUNDARY_CONDITION, OPTION, ITERATION)
Reads boundary conditions from a file.
Definition: fluid_mechanics_IO_routines.f90:4079
problem_constants::problem_setup_solver_equations_type
integer(intg), parameter problem_setup_solver_equations_type
Solver equations setup for a problem.
Definition: problem_constants.f90:265
base_routines::diagnostic_output_type
integer(intg), parameter, public diagnostic_output_type
Diagnostic output type.
Definition: base_routines.f90:67
boundary_conditions_routines::boundary_conditions_set_local_dof
Sets a boundary condition on the specified local DOF.
Definition: boundary_condition_routines.f90:143
types::solver_mapping_type
Contains information on the solver mapping between the global equation sets and the solver matrices...
Definition: types.f90:3091
equations_set_constants::equations_set_exp_source_ale_advection_diff_supg_subtype
integer(intg), parameter equations_set_exp_source_ale_advection_diff_supg_subtype
Definition: equations_set_constants.f90:278
solver_routines::solver_dynamic_scheme_set
subroutine, public solver_dynamic_scheme_set(SOLVER, SCHEME, ERR, ERROR,)
Sets/changes the scheme for a dynamic solver.
Definition: solver_routines.f90:6384
advection_diffusion_equation_routines::advection_diffusion_equation_problem_setup
subroutine, public advection_diffusion_equation_problem_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the diffusion problem.
Definition: advection_diffusion_equation_routines.f90:2225
equations_set_constants::equations_set_quad_source_ale_advection_diff_supg_subtype
integer(intg), parameter equations_set_quad_source_ale_advection_diff_supg_subtype
Definition: equations_set_constants.f90:277
types::field_variable_type
Contains information for a field variable defined on a field.
Definition: types.f90:1289
input_output::writestring
Write a string to a given output stream.
Definition: input_output.f90:80
equations_set_constants::equations_set_fd_solution_method
integer(intg), parameter equations_set_fd_solution_method
Finite Difference solution method.
Definition: equations_set_constants.f90:350
equations_matrices_routines::equations_matrices_sparse_matrices
integer(intg), parameter, public equations_matrices_sparse_matrices
Use sparse equations matrices.
Definition: equations_matrices_routines.f90:90
equations_set_constants::equations_set_advection_diffusion_equation_type
integer(intg), parameter equations_set_advection_diffusion_equation_type
Definition: equations_set_constants.f90:90
types::field_interpolation_parameters_type
Contains the parameters required to interpolate a field variable within an element. Old CMISS name XE.
Definition: types.f90:1141
types::equations_set_setup_type
Contains information on the setup information for an equations set.
Definition: types.f90:1866
types::domain_type
A pointer to the domain decomposition for this domain.
Definition: types.f90:938
problem_constants::problem_setup_start_action
integer(intg), parameter problem_setup_start_action
Start setup action.
Definition: problem_constants.f90:273
solver_routines::solver_equations_time_dependence_type_set
subroutine, public solver_equations_time_dependence_type_set(SOLVER_EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for solver equations.
Definition: solver_routines.f90:7788
problem_constants::problem_nonlinear_source_advection_diffusion_subtype
integer(intg), parameter problem_nonlinear_source_advection_diffusion_subtype
Definition: problem_constants.f90:205
control_loop_routines
This module handles all control loop routines.
Definition: control_loop_routines.f90:45
solver_routines::solver_cmiss_library
integer(intg), parameter, public solver_cmiss_library
CMISS (internal) solver library.
Definition: solver_routines.f90:103
boundary_conditions_routines::boundary_condition_fixed
integer(intg), parameter, public boundary_condition_fixed
The dof is fixed as a boundary condition.
Definition: boundary_condition_routines.f90:95
problem_constants::problem_no_source_advection_diffusion_subtype
integer(intg), parameter problem_no_source_advection_diffusion_subtype
Definition: problem_constants.f90:203
base_routines::errors
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
Definition: base_routines.f90:481
equations_set_constants
This module defines all constants shared across equations set routines.
Definition: equations_set_constants.f90:45
equations_set_constants::equations_set_bem_solution_method
integer(intg), parameter equations_set_bem_solution_method
Boundary Element Method solution method.
Definition: equations_set_constants.f90:349
solver_routines::solver_solver_equations_get
subroutine, public solver_solver_equations_get(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Returns a pointer to the solver equations for a solver.
Definition: solver_routines.f90:21230
advection_diffusion_equation_routines::advectiondiffusion_equationssetsolnmethodset
subroutine, public advectiondiffusion_equationssetsolnmethodset(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for a diffusion equation type of an classical field equations set cl...
Definition: advection_diffusion_equation_routines.f90:644
boundary_conditions_routines::boundary_conditions_variable_get
subroutine, public boundary_conditions_variable_get(BOUNDARY_CONDITIONS, FIELD_VARIABLE, BOUNDARY_CONDITIONS_VARIABLE, ERR, ERROR,)
Find the boundary conditions variable for a given field variable.
Definition: boundary_condition_routines.f90:3635
types::basis_type
Contains all information about a basis .
Definition: types.f90:184
equations_set_constants::equations_set_fv_solution_method
integer(intg), parameter equations_set_fv_solution_method
Finite Volume solution method.
Definition: equations_set_constants.f90:351
matrix_vector::matrix_block_storage_type
integer(intg), parameter, public matrix_block_storage_type
Matrix block storage type.
Definition: matrix_vector.f90:163
advection_diffusion_equation_routines::advection_diffusion_post_solve
subroutine, public advection_diffusion_post_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Definition: advection_diffusion_equation_routines.f90:4110
solver_routines::solver_dynamic_first_degree
integer(intg), parameter, public solver_dynamic_first_degree
Dynamic solver uses a first degree polynomial for time interpolation.
Definition: solver_routines.f90:271
equations_set_constants::equations_set_linear_source_ale_advection_diffusion_subtype
integer(intg), parameter equations_set_linear_source_ale_advection_diffusion_subtype
Definition: equations_set_constants.f90:259
equations_set_constants::equations_set_setup_initial_type
integer(intg), parameter equations_set_setup_initial_type
Initial setup.
Definition: equations_set_constants.f90:322
control_loop_routines::control_loop_create_finish
recursive subroutine, public control_loop_create_finish(CONTROL_LOOP, ERR, ERROR,)
Finish the process of creating a control loop.
Definition: control_loop_routines.f90:153
equations_set_constants::equations_set_exp_source_advection_diff_supg_subtype
integer(intg), parameter equations_set_exp_source_advection_diff_supg_subtype
Definition: equations_set_constants.f90:273
advection_diffusion_equation_routines::advection_diffusion_pre_solve_update_bc
subroutine advection_diffusion_pre_solve_update_bc(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Definition: advection_diffusion_equation_routines.f90:3983
equations_set_constants::equations_set_setup_analytic_type
integer(intg), parameter equations_set_setup_analytic_type
Analytic setup.
Definition: equations_set_constants.f90:329
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
solver_routines::solver_linear_type
integer(intg), parameter, public solver_linear_type
A linear solver.
Definition: solver_routines.f90:88
equations_set_constants::equations_set_constant_source_static_advec_diff_supg_subtype
integer(intg), parameter equations_set_constant_source_static_advec_diff_supg_subtype
Definition: equations_set_constants.f90:280
types::equations_matrices_rhs_type
Contains information of the RHS vector for equations matrices.
Definition: types.f90:1500
equations_set_constants::equations_set_exp_source_ale_advection_diffusion_subtype
integer(intg), parameter equations_set_exp_source_ale_advection_diffusion_subtype
Definition: equations_set_constants.f90:261
distributed_matrix_vector::distributed_matrix_diagonal_storage_type
integer(intg), parameter, public distributed_matrix_diagonal_storage_type
Distributed matrix diagonal storage type.
Definition: distributed_matrix_vector.f90:98
types::equations_mapping_linear_type
Contains information for mapping field variables to the linear matrices in the equations set of the m...
Definition: types.f90:1587
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
fluid_mechanics_io_routines
Temporary IO routines for fluid mechanics.
Definition: fluid_mechanics_IO_routines.f90:47
equations_set_constants::equations_set_setup_finish_action
integer(intg), parameter equations_set_setup_finish_action
Finish setup action.
Definition: equations_set_constants.f90:339
distributed_matrix_vector::distributed_matrix_compressed_row_storage_type
integer(intg), parameter, public distributed_matrix_compressed_row_storage_type
Distributed matrix compressed row storage type.
Definition: distributed_matrix_vector.f90:101
types::equations_matrices_dynamic_type
Contains information of the dynamic matrices for equations matrices.
Definition: types.f90:1471
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45