OpenCMISS-Iron Internal API Documentation
advection_equation_routines.f90
Go to the documentation of this file.
1 
43 
46 
48  USE base_routines
49  USE basis_routines
51  USE constants
54  USE domain_mappings
59  USE field_routines
60  USE input_output
62  USE kinds
63  USE maths
64  USE matrix_vector
66  USE strings
67  USE solver_routines
68  USE timer
69  USE types
70 
71 #include "macros.h"
72 
73  IMPLICIT NONE
74 
81  PUBLIC advection_pre_solve
85 
86 CONTAINS
87 
88  !
89  !================================================================================================================================
90  !
91 
93  SUBROUTINE advection_equationssetsetup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
94 
95  !Argument variables
96  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
97  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
98  INTEGER(INTG), INTENT(OUT) :: ERR
99  TYPE(varying_string), INTENT(OUT) :: ERROR
100  !Local Variables
101  TYPE(varying_string) :: LOCAL_ERROR
102 
103  enters("Advection_EquationsSetSetup",err,error,*999)
104 
105  IF(ASSOCIATED(equations_set)) THEN
106  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
107  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
108  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
109  CALL flagerror("Equations set specification must have three entries for a Advection equations set.", &
110  & err,error,*999)
111  END IF
112  SELECT CASE(equations_set%specification(3))
114  CALL advection_equationssetlinearsetup(equations_set,equations_set_setup,err,error,*999)
115  CASE DEFAULT
116  local_error="The third equations set specification of "// &
117  & trim(number_to_vstring(equations_set%specification(3),"*",err,error))// &
118  & " is not valid for an advection type of a classical field equation set."
119  CALL flagerror(local_error,err,error,*999)
120  END SELECT
121  ELSE
122  CALL flagerror("Equations set is not associated.",err,error,*999)
123  ENDIF
124 
125  exits("Advection_EquationsSetSetup")
126  RETURN
127 999 errorsexits("Advection_EquationsSetSetup",err,error)
128  RETURN 1
129 
130  END SUBROUTINE advection_equationssetsetup
131 
132  !
133  !================================================================================================================================
134  !
135 
137  SUBROUTINE advection_equationssetsolutionmethodset(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)
139  !Argument variables
140  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
141  INTEGER(INTG), INTENT(IN) :: SOLUTION_METHOD
142  INTEGER(INTG), INTENT(OUT) :: ERR
143  TYPE(varying_string), INTENT(OUT) :: ERROR
144  !Local Variables
145  TYPE(varying_string) :: LOCAL_ERROR
146 
147  enters("Advection_EquationsSetSolutionMethodSet",err,error,*999)
148 
149  IF(ASSOCIATED(equations_set)) THEN
150  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
151  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
152  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
153  CALL flagerror("Equations set specification must have three entries for a advection type equations set.", &
154  & err,error,*999)
155  END IF
156  SELECT CASE(equations_set%SPECIFICATION(3))
158  SELECT CASE(solution_method)
160  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
161  CASE DEFAULT
162  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
163  CALL flagerror(local_error,err,error,*999)
164  END SELECT
165  CASE DEFAULT
166  local_error="The third equations set specification of "// &
167  & trim(number_to_vstring(equations_set%specification(3),"*",err,error))// &
168  & " is not valid for an advection type of an classical field equations set."
169  CALL flagerror(local_error,err,error,*999)
170  END SELECT
171  ELSE
172  CALL flagerror("Equations set is not associated.",err,error,*999)
173  ENDIF
174 
175  exits("Advection_EquationsSetSolutionMethodSet")
176  RETURN
177 999 errors("Advection_EquationsSetSolutionMethodSet",err,error)
178  exits("Advection_EquationsSetSolutionMethodSet")
179  RETURN 1
180 
182 
183  !
184  !================================================================================================================================
185  !
186 
188  SUBROUTINE advection_equationssetspecificationset(equationsSet,specification,err,error,*)
190  !Argument variables
191  TYPE(equations_set_type), POINTER :: equationsSet
192  INTEGER(INTG), INTENT(IN) :: specification(:)
193  INTEGER(INTG), INTENT(OUT) :: err
194  TYPE(varying_string), INTENT(OUT) :: error
195  !Local Variables
196  TYPE(varying_string) :: localError
197  INTEGER(INTG) :: subtype
198 
199  enters("Advection_EquationsSetSpecificationSet",err,error,*999)
200 
201  IF(ASSOCIATED(equationsset)) THEN
202  IF(SIZE(specification,1)/=3) THEN
203  CALL flagerror("Equations set specification must have three entries for a Laplace type equations set.", &
204  & err,error,*999)
205  END IF
206  subtype=specification(3)
207  SELECT CASE(subtype)
209  !ok
210  CASE DEFAULT
211  localerror="The third equations set specification of "//trim(numbertovstring(subtype,"*",err,error))// &
212  & " is not valid for an advection type of a classical field equations set."
213  CALL flagerror(localerror,err,error,*999)
214  END SELECT
215  !Set full specification
216  IF(ALLOCATED(equationsset%specification)) THEN
217  CALL flagerror("Equations set specification is already allocated.",err,error,*999)
218  ELSE
219  ALLOCATE(equationsset%specification(3),stat=err)
220  IF(err/=0) CALL flagerror("Could not allocate equations set specification.",err,error,*999)
221  END IF
222  equationsset%specification(1:3)=[equations_set_classical_field_class,equations_set_advection_equation_type,subtype]
223  ELSE
224  CALL flagerror("Equations set is not associated.",err,error,*999)
225  END IF
226 
227  exits("Advection_EquationsSetSpecificationSet")
228  RETURN
229 999 errorsexits("Advection_EquationsSetSpecificationSet",err,error)
230  RETURN 1
231 
233 
234  !
235  !================================================================================================================================
236  !
237 
239  SUBROUTINE advection_equationssetlinearsetup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
241  !Argument variables
242  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
243  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
244  INTEGER(INTG), INTENT(OUT) :: ERR
245  TYPE(varying_string), INTENT(OUT) :: ERROR
246  !Local Variables
247  INTEGER(INTG) :: GEOMETRIC_MESH_COMPONENT,GEOMETRIC_SCALING_TYPE,GEOMETRIC_COMPONENT_NUMBER,NUMBER_OF_DIMENSIONS
248  INTEGER(INTG) :: DEPENDENT_FIELD_NUMBER_OF_VARIABLES,DEPENDENT_FIELD_NUMBER_OF_COMPONENTS,component_idx
249  INTEGER(INTG) :: INDEPENDENT_FIELD_NUMBER_OF_VARIABLES,INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS
250  TYPE(decomposition_type), POINTER :: GEOMETRIC_DECOMPOSITION
251  TYPE(equations_type), POINTER :: EQUATIONS
252  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
253  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
254  TYPE(equations_set_materials_type), POINTER :: EQUATIONS_MATERIALS
255  TYPE(varying_string) :: LOCAL_ERROR
256 
257  enters("Advection_EquationsSetLinearSetup",err,error,*999)
258 
259  NULLIFY(equations)
260  NULLIFY(equations_mapping)
261  NULLIFY(equations_matrices)
262  NULLIFY(geometric_decomposition)
263 
264  IF(ASSOCIATED(equations_set)) THEN
265  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
266  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
267  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
268  CALL flagerror("Equations set specification must have three entries for an advection equations set.", &
269  & err,error,*999)
270  END IF
271  SELECT CASE(equations_set%SPECIFICATION(3))
273  SELECT CASE(equations_set_setup%SETUP_TYPE)
275  SELECT CASE(equations_set_setup%ACTION_TYPE)
277  CALL advection_equationssetsolutionmethodset(equations_set, &
278  & equations_set_fem_solution_method,err,error,*999)
280  !Do nothing
281  CASE DEFAULT
282  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
283  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
284  & " is invalid for an advection equation."
285  CALL flagerror(local_error,err,error,*999)
286  END SELECT
287 
289  SELECT CASE(equations_set%SPECIFICATION(3))
291  !Do nothing
292  END SELECT
293  !-----------------------------------------------------------------
294  ! D e p e n d e n t f i e l d
295  !-----------------------------------------------------------------
297  SELECT CASE(equations_set_setup%ACTION_TYPE)
299  dependent_field_number_of_variables=2
300  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
301  !Create the auto created dependent field
302  !start field creation with name 'Concentration'
303  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
304  & equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
305  !start creation of a new field
306  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
307  !label the field
308  CALL field_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,"Concentration",err,error,*999)
309  !define new created field to be dependent
310  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
311  & field_dependent_type,err,error,*999)
312  !look for decomposition rule already defined
313  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
314  & err,error,*999)
315  !apply decomposition rule found on new created field
316  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
317  & geometric_decomposition,err,error,*999)
318  !point new field to geometric field
319  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
320  & geometric_field,err,error,*999)
321  !set number of variables to 2 (U,delU/delN)
322  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
323  & dependent_field_number_of_variables,err,error,*999)
324  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,[field_u_variable_type, &
325  & field_deludeln_variable_type],err,error,*999)
326  !set dimension
327  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
328  & field_vector_dimension_type,err,error,*999)
329  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
330  & field_vector_dimension_type,err,error,*999)
331  !set data type
332  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
333  & field_dp_type,err,error,*999)
334  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
335  & field_dp_type,err,error,*999)
336  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
337  & number_of_dimensions,err,error,*999)
338  !number of components for U,delU/delN (C)
339  dependent_field_number_of_components=1
340  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
341  & field_u_variable_type,dependent_field_number_of_components,err,error,*999)
342  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
343  & field_deludeln_variable_type,dependent_field_number_of_components,err,error,*999)
344  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
345  & dependent_field_number_of_components,geometric_mesh_component,err,error,*999)
346  !Default to the geometric interpolation setup
347  DO component_idx=1,dependent_field_number_of_components
348  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
349  & field_u_variable_type,component_idx,geometric_mesh_component,err,error,*999)
350  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
351  & field_deludeln_variable_type,component_idx,geometric_mesh_component,err,error,*999)
352  END DO
353  SELECT CASE(equations_set%SOLUTION_METHOD)
354  !Specify fem solution method
356  DO component_idx=1,dependent_field_number_of_components
357  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
358  & field_u_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
359  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
360  & field_deludeln_variable_type,component_idx,field_node_based_interpolation,err,error,*999)
361  END DO
362  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
363  & err,error,*999)
364  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type, &
365  & err,error,*999)
366  CASE DEFAULT
367  local_error="The solution method of " &
368  & //trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// " is invalid."
369  CALL flagerror(local_error,err,error,*999)
370  END SELECT
371  ELSE
372  !Check the user specified field advection equations
373  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
374  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
375  CALL field_number_of_variables_check(equations_set_setup%FIELD,dependent_field_number_of_variables,err,error,*999)
376  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_deludeln_variable_type], &
377  & err,error,*999)
378  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type, &
379  & field_vector_dimension_type,err,error,*999)
380  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
381  & field_vector_dimension_type,err,error,*999)
382  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
383  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type, &
384  & err,error,*999)
385  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
386  & number_of_dimensions,err,error,*999)
387  dependent_field_number_of_components=1
388  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
389  & dependent_field_number_of_components,err,error,*999)
390  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
391  & dependent_field_number_of_components,err,error,*999)
392  SELECT CASE(equations_set%SOLUTION_METHOD)
394  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
395  & field_node_based_interpolation,err,error,*999)
396  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
397  & field_node_based_interpolation,err,error,*999)
398  CASE DEFAULT
399  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD, &
400  & "*",err,error))//" is invalid."
401  CALL flagerror(local_error,err,error,*999)
402  END SELECT
403  ENDIF
404  !Specify finish action
406  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
407  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
408  CALL field_parameter_set_create(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
409  & field_boundary_conditions_set_type,err,error,*999)
410  ENDIF
411  CASE DEFAULT
412  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
413  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
414  & " is invalid for an advection equation"
415  CALL flagerror(local_error,err,error,*999)
416  END SELECT
417  !-----------------------------------------------------------------
418  ! M a t e r i a l s f i e l d
419  !-----------------------------------------------------------------
421  SELECT CASE(equations_set_setup%ACTION_TYPE)
422  !Specify start action
424  equations_materials=>equations_set%MATERIALS
425  IF(ASSOCIATED(equations_materials)) THEN
426  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
427  !Create the auto created materials field
428  !start field creation with name 'MATERIAL_FIELD'
429  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
430  & equations_set%MATERIALS%MATERIALS_FIELD,err,error,*999)
431  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
432  !label the field
433  CALL field_label_set(equations_materials%MATERIALS_FIELD,"Materials Field",err,error,*999)
434  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type, &
435  & err,error,*999)
436  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
437  & err,error,*999)
438  !apply decomposition rule found on new created field
439  CALL field_mesh_decomposition_set_and_lock(equations_set%MATERIALS%MATERIALS_FIELD, &
440  & geometric_decomposition,err,error,*999)
441  !point new field to geometric field
442  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
443  & geometric_field,err,error,*999)
444  CALL field_number_of_variables_set(equations_materials%MATERIALS_FIELD,1,err,error,*999)
445  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,[field_u_variable_type],err,error,*999)
446  CALL field_variable_label_set(equations_materials%MATERIALS_FIELD,field_u_variable_type,"Materials",err,error,*999)
447  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
448  & field_vector_dimension_type,err,error,*999)
449  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
450  & field_dp_type,err,error,*999)
451  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
452  & 1,err,error,*999)
453  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD, &
454  & field_u_variable_type,1,geometric_component_number,err,error,*999)
455  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
456  & 1,geometric_component_number,err,error,*999)
457  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
458  & 1,field_constant_interpolation,err,error,*999)
459  !Default the field scaling to that of the geometric field
460  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
461  & err,error,*999)
462  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
463  ELSE
464  !Check the user specified field
465  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
466  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
467  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
468  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
469  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type, &
470  & field_vector_dimension_type,err,error,*999)
471  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type, &
472  & err,error,*999)
473  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
474  & number_of_dimensions,err,error,*999)
475  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1,err,error,*999)
476  ENDIF
477  ELSE
478  CALL flagerror("Equations set materials is not associated.",err,error,*999)
479  END IF
480  !Specify start action
482  equations_materials=>equations_set%MATERIALS
483  IF(ASSOCIATED(equations_materials)) THEN
484  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
485  !Finish creating the materials field
486  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
487  !Set the default values for the materials field (Diffusivity)
488  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
489  & field_values_set_type,1,1.0_dp,err,error,*999)
490  ENDIF
491  ELSE
492  CALL flagerror("Equations set materials is not associated.",err,error,*999)
493  ENDIF
494  CASE DEFAULT
495  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*", &
496  & err,error))//" for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*", &
497  & err,error))//" is invalid for Navier-Stokes equation."
498  CALL flagerror(local_error,err,error,*999)
499  END SELECT
500  !-----------------------------------------------------------------
501  ! I n d e p e n d e n t f i e l d
502  !-----------------------------------------------------------------
504  SELECT CASE(equations_set_setup%ACTION_TYPE)
505  !Set start action
507  independent_field_number_of_variables=1
508  independent_field_number_of_components=1
509  !Create the auto created independent field
510  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
511  !start field creation with name 'INDEPENDENT_FIELD'
512  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
513  & equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
514  !start creation of a new field
515  CALL field_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
516  !label the field
517  CALL field_label_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,"Independent Field",err,error,*999)
518  !define new created field to be independent
519  CALL field_dependent_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
520  & field_independent_type,err,error,*999)
521  !look for decomposition rule already defined
522  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
523  !apply decomposition rule found on new created field
524  CALL field_mesh_decomposition_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
525  & geometric_decomposition,err,error,*999)
526  !point new field to geometric field
527  CALL field_geometric_field_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,equations_set% &
528  & geometry%GEOMETRIC_FIELD,err,error,*999)
529  !set number of variables to 1 (1 for U)
530  CALL field_number_of_variables_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
531  & independent_field_number_of_variables,err,error,*999)
532  CALL field_variable_types_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,[field_u_variable_type], &
533  & err,error,*999)
534  CALL field_dimension_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
535  & field_vector_dimension_type,err,error,*999)
536  !calculate number of components with one component for each dimension
537  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
538  & field_u_variable_type,independent_field_number_of_components,err,error,*999)
539  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
540  & 1,geometric_mesh_component,err,error,*999)
541  !Default to the geometric interpolation setup
542  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
543  & field_u_variable_type,independent_field_number_of_components,geometric_mesh_component,err,error,*999)
544  SELECT CASE(equations_set%SOLUTION_METHOD)
545  !Specify fem solution method
547  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
548  & field_u_variable_type,independent_field_number_of_components,field_node_based_interpolation,err,error,*999)
549  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
550  & err,error,*999)
551  CALL field_scaling_type_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_scaling_type, &
552  & err,error,*999)
554  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
555  & field_u_variable_type,independent_field_number_of_components,field_node_based_interpolation,err,error,*999)
556  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
557  & err,error,*999)
558  CALL field_scaling_type_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_scaling_type, &
559  & err,error,*999)
560  CASE DEFAULT
561  local_error="The solution method of " &
562  & //trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// " is invalid."
563  CALL flagerror(local_error,err,error,*999)
564  END SELECT
565  ELSE
566  !Check the user specified field- Characteristic equation
567  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
568  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
569  & err,error,*999)
570  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
571  ENDIF
572  !Specify finish action
574  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
575  CALL field_create_finish(equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
576  ENDIF
577  CASE DEFAULT
578  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
579  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
580  & " is invalid for a standard Navier-Stokes fluid"
581  CALL flagerror(local_error,err,error,*999)
582  END SELECT
583  !-----------------------------------------------------------------
584  ! E q u a t i o n s t y p e
585  !-----------------------------------------------------------------
587  SELECT CASE(equations_set_setup%ACTION_TYPE)
589  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
590  IF(equations_set%specification(3)==equations_set_advection_subtype) THEN
591  CALL equations_create_start(equations_set,equations,err,error,*999)
592  CALL equations_linearity_type_set(equations,equations_linear,err,error,*999)
594  ELSE
595  CALL flagerror("Equations set subtype not valid.",err,error,*999)
596  ENDIF
597  ELSE
598  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
599  ENDIF
601  SELECT CASE(equations_set%SOLUTION_METHOD)
603  IF(equations_set%specification(3)==equations_set_advection_subtype) THEN
604  !Finish the equations
605  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
606  CALL equations_create_finish(equations,err,error,*999)
607  !Create the equations mapping.
608  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
609  CALL equations_mapping_dynamic_matrices_set(equations_mapping,.true.,.true.,err,error,*999)
610  CALL equations_mapping_dynamic_variable_type_set(equations_mapping,field_u_variable_type,err,error,*999)
611  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err, &
612  & error,*999)
613  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
614  !Create the equations matrices
615  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
616  !Set up matrix storage and structure
617  SELECT CASE(equations%SPARSITY_TYPE)
619  CALL equations_matrices_linear_storage_type_set(equations_matrices, &
622  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
625  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
627  CASE DEFAULT
628  local_error="The equations matrices sparsity type of "// &
629  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
630  CALL flagerror(local_error,err,error,*999)
631  END SELECT
632  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
633  ENDIF
634  CASE DEFAULT
635  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
636  & " is invalid."
637  CALL flagerror(local_error,err,error,*999)
638  END SELECT
639  CASE DEFAULT
640  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
641  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
642  & " is invalid for an advection equation."
643  CALL flagerror(local_error,err,error,*999)
644  END SELECT
645  CASE DEFAULT
646  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
647  & " is invalid for an advection equation."
648  CALL flagerror(local_error,err,error,*999)
649  END SELECT
650  CASE DEFAULT
651  local_error="The thrid equations set specification of "// &
652  & trim(number_to_vstring(equations_set%specification(3),"*",err,error))// &
653  & " does not equal a advection equation set."
654  CALL flagerror(local_error,err,error,*999)
655  END SELECT
656  ELSE
657  CALL flagerror("Equations set is not associated.",err,error,*999)
658  ENDIF
659 
660  exits("Advection_EquationsSetLinearSetup")
661  RETURN
662 999 errorsexits("Advection_EquationsSetLinearSetup",err,error)
663  RETURN 1
664 
665  END SUBROUTINE advection_equationssetlinearsetup
666 
667  !
668  !================================================================================================================================
669  !
670 
672  SUBROUTINE advection_problemspecificationset(problem,problemSpecification,err,error,*)
674  !Argument variables
675  TYPE(problem_type), POINTER :: problem
676  INTEGER(INTG), INTENT(IN) :: problemSpecification(:)
677  INTEGER(INTG), INTENT(OUT) :: err
678  TYPE(varying_string), INTENT(OUT) :: error
679  !Local Variables
680  TYPE(varying_string) :: localError
681  INTEGER(INTG) :: problemSubtype
682 
683  enters("Advection_ProblemSpecificationSet",err,error,*999)
684 
685  IF(ASSOCIATED(problem)) THEN
686  IF(SIZE(problemspecification,1)==3) THEN
687  problemsubtype=problemspecification(3)
688  SELECT CASE(problemsubtype)
690  !ok
691  CASE DEFAULT
692  localerror="The third problem specification of "//trim(numbertovstring(problemsubtype,"*",err,error))// &
693  & " is not valid for a advection type of a classical field problem."
694  CALL flagerror(localerror,err,error,*999)
695  END SELECT
696  IF(ALLOCATED(problem%specification)) THEN
697  CALL flagerror("Problem specification is already allocated.",err,error,*999)
698  ELSE
699  ALLOCATE(problem%specification(3),stat=err)
700  IF(err/=0) CALL flagerror("Could not allocate problem specification.",err,error,*999)
701  END IF
702  problem%specification(1:3)=[problem_classical_field_class,problem_advection_equation_type,problemsubtype]
703  ELSE
704  CALL flagerror("Advection problem specification must have three entries.",err,error,*999)
705  END IF
706  ELSE
707  CALL flagerror("Problem is not associated.",err,error,*999)
708  END IF
709 
710  exits("Advection_ProblemSpecificationSet")
711  RETURN
712 999 errorsexits("Advection_ProblemSpecificationSet",err,error)
713  RETURN 1
714 
715  END SUBROUTINE advection_problemspecificationset
716 
717  !
718  !================================================================================================================================
719  !
720 
722  SUBROUTINE advection_equation_problem_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
724  !Argument variables
725  TYPE(problem_type), POINTER :: PROBLEM
726  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
727  INTEGER(INTG), INTENT(OUT) :: ERR
728  TYPE(varying_string), INTENT(OUT) :: ERROR
729  !Local Variables
730  TYPE(varying_string) :: LOCAL_ERROR
731 
732  enters("ADVECTION_EQUATION_PROBLEM_SETUP",err,error,*999)
733 
734  IF(ASSOCIATED(problem)) THEN
735  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
736  CALL flagerror("Problem specification is not allocated.",err,error,*999)
737  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
738  CALL flagerror("Problem specification must have three entries for a Laplace problem.",err,error,*999)
739  END IF
740  SELECT CASE(problem%SPECIFICATION(3))
742  CALL advection_equation_problem_linear_setup(problem,problem_setup,err,error,*999)
743  CASE DEFAULT
744  local_error="The third problem specification of "// &
745  & trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
746  & " is not valid for an advection type of a classical field problem."
747  CALL flagerror(local_error,err,error,*999)
748  END SELECT
749  ELSE
750  CALL flagerror("Problem is not associated.",err,error,*999)
751  ENDIF
752 
753  exits("ADVECTION_EQUATION_PROBLEM_SETUP")
754  RETURN
755 999 errorsexits("ADVECTION_EQUATION_PROBLEM_SETUP",err,error)
756  RETURN 1
757 
758  END SUBROUTINE advection_equation_problem_setup
759 
760  !
761  !================================================================================================================================
762  !
763 
765  SUBROUTINE advection_equation_problem_linear_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
767  !Argument variables
768  TYPE(problem_type), POINTER :: PROBLEM
769  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
770  INTEGER(INTG), INTENT(OUT) :: ERR
771  TYPE(varying_string), INTENT(OUT) :: ERROR
772  !Local Variables
773  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT
774  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
775  TYPE(solver_type), POINTER :: SOLVER
776  TYPE(solvers_type), POINTER :: SOLVERS
777  TYPE(varying_string) :: LOCAL_ERROR
778 
779  enters("ADVECTION_EQUATION_PROBLEM_LINEAR_SETUP",err,error,*999)
780 
781  NULLIFY(control_loop)
782  NULLIFY(solver)
783  NULLIFY(solver_equations)
784  NULLIFY(solvers)
785  IF(ASSOCIATED(problem)) THEN
786  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
787  CALL flagerror("Problem specification is not allocated.",err,error,*999)
788  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
789  CALL flagerror("Problem specification must have three entries for an advection problem.",err,error,*999)
790  END IF
791  IF(problem%specification(3)==problem_advection_subtype) THEN
792  SELECT CASE(problem_setup%SETUP_TYPE)
794  SELECT CASE(problem_setup%ACTION_TYPE)
796  !Do nothing
798  !Do nothing
799  CASE DEFAULT
800  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
801  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
802  & " is invalid for an advection equation."
803  CALL flagerror(local_error,err,error,*999)
804  END SELECT
806  SELECT CASE(problem_setup%ACTION_TYPE)
808  !Set up a time control loop
809  CALL control_loop_create_start(problem,control_loop,err,error,*999)
810  CALL control_loop_type_set(control_loop,problem_control_time_loop_type,err,error,*999)
812  !Finish the control loops
813  control_loop_root=>problem%CONTROL_LOOP
814  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
815  CALL control_loop_create_finish(control_loop,err,error,*999)
816  CASE DEFAULT
817  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
818  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
819  & " is invalid for an advection equation."
820  CALL flagerror(local_error,err,error,*999)
821  END SELECT
823  !Get the control loop
824  control_loop_root=>problem%CONTROL_LOOP
825  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
826  SELECT CASE(problem_setup%ACTION_TYPE)
828  !Start the solvers creation
829  CALL solvers_create_start(control_loop,solvers,err,error,*999)
830  CALL solvers_number_set(solvers,1,err,error,*999)
831  !Set the solver to be a first order dynamic solver
832  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
833  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
834  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
835  !Set solver defaults
836  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
837  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
839  !Get the solvers
840  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
841  !Finish the solvers creation
842  CALL solvers_create_finish(solvers,err,error,*999)
843  CASE DEFAULT
844  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
845  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
846  & " is invalid for an advection equation."
847  CALL flagerror(local_error,err,error,*999)
848  END SELECT
850  SELECT CASE(problem_setup%ACTION_TYPE)
852  !Get the control loop
853  control_loop_root=>problem%CONTROL_LOOP
854  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
855  !Get the solver
856  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
857  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
858  !Create the solver equations
859  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
860  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
862  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
864  !Get the control loop
865  control_loop_root=>problem%CONTROL_LOOP
866  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
867  !Get the solver equations
868  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
869  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
870  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
871  !Finish the solver equations creation
872  CALL solver_equations_create_finish(solver_equations,err,error,*999)
873  CASE DEFAULT
874  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
875  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
876  & " is invalid for an advection equation."
877  CALL flagerror(local_error,err,error,*999)
878  END SELECT
879  CASE DEFAULT
880  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
881  & " is invalid for an advection equation."
882  CALL flagerror(local_error,err,error,*999)
883  END SELECT
884  ELSE
885  local_error="The third problem specification of "// &
886  & trim(number_to_vstring(problem%specification(3),"*",err,error))// &
887  & " does not equal an advection equation subtype."
888  CALL flagerror(local_error,err,error,*999)
889  ENDIF
890  ELSE
891  CALL flagerror("Problem is not associated.",err,error,*999)
892  ENDIF
893 
894  exits("ADVECTION_EQUATION_PROBLEM_LINEAR_SETUP")
895  RETURN
896 999 errorsexits("ADVECTION_EQUATION_PROBLEM_LINEAR_SETUP",err,error)
897  RETURN 1
898 
900 
901  !
902  !================================================================================================================================
903  !
904 
906  SUBROUTINE advection_equation_finite_element_calculate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
908  !Argument variables
909  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
910  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
911  INTEGER(INTG), INTENT(OUT) :: ERR
912  TYPE(varying_string), INTENT(OUT) :: ERROR
913  !Local Variables
914  TYPE(basis_type), POINTER :: DEPENDENT_BASIS,GEOMETRIC_BASIS
915  TYPE(domain_elements_type), POINTER :: ELEMENTS_TOPOLOGY
916  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
917  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
918  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
919  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
920  TYPE(equations_matrix_type), POINTER :: DAMPING_MATRIX,STIFFNESS_MATRIX
921  TYPE(equations_type), POINTER :: EQUATIONS
922  TYPE(field_type), POINTER :: DEPENDENT_FIELD,INDEPENDENT_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD
923  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
924  TYPE(quadrature_scheme_type), POINTER :: QUADRATURE_SCHEME
925  TYPE(varying_string) :: LOCAL_ERROR
926  INTEGER(INTG) :: mhs,ms,ng,nhs,ns,xiIdx,coordIdx,MESH_COMPONENT
927  REAL(DP) :: JGW,SUM,DXI_DX,DPHIMS_DXI,DPHINS_DXI,PHIMS,PHINS,flow,area,D,Conc,dConc
928  LOGICAL :: UPDATE_DAMPING_MATRIX,UPDATE_STIFFNESS_MATRIX
929 
930  update_damping_matrix = .false.
931  update_stiffness_matrix = .false.
932 
933  enters("ADVECTION_EQUATION_FINITE_ELEMENT_CALCULATE",err,error,*999)
934 
935  IF(ASSOCIATED(equations_set)) THEN
936  equations=>equations_set%EQUATIONS
937  IF(ASSOCIATED(equations)) THEN
938  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
939  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
940  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<3) THEN
941  CALL flagerror("Equations set specification must have three entries for an advection problem.",err,error,*999)
942  END IF
943  SELECT CASE(equations_set%specification(3))
945  !Store all these in equations matrices
946  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
947  independent_field=>equations%INTERPOLATION%INDEPENDENT_FIELD
948  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
949  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
950  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
951  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
952  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
953  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
954  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
955  equations_matrices=>equations%EQUATIONS_MATRICES
956  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
957  stiffness_matrix=>dynamic_matrices%MATRICES(1)%PTR
958  damping_matrix=>dynamic_matrices%MATRICES(2)%PTR
959  equations_mapping=>equations%EQUATIONS_MAPPING
960  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
961  field_variable=>dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(1)%VARIABLE
962  stiffness_matrix%ELEMENT_MATRIX%MATRIX=0.0_dp
963  damping_matrix%ELEMENT_MATRIX%MATRIX=0.0_dp
964  IF(ASSOCIATED(damping_matrix)) update_damping_matrix=damping_matrix%UPDATE_MATRIX
965  IF(ASSOCIATED(stiffness_matrix)) update_stiffness_matrix=stiffness_matrix%UPDATE_MATRIX
966 
967  SELECT CASE(equations_set%specification(3))
969  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
970  & dependent_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
971  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
972  & independent_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
973  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
974  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
975  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
976  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
977  !Loop over gauss points
978  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
979  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
980  & dependent_interp_point(field_u_variable_type)%PTR,err,error,*999)
981  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
982  & independent_interp_point(field_u_variable_type)%PTR,err,error,*999)
983  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
984  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
985  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
986  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
987  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
988  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
989 
990  conc=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,no_part_deriv)
991  dconc=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,first_part_deriv)
992  flow=equations%INTERPOLATION%INDEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,no_part_deriv)
993  area=equations%INTERPOLATION%INDEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,no_part_deriv)
994  d=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,no_part_deriv)
995 
996  mhs=0
997  mesh_component=field_variable%COMPONENTS(1)%MESH_COMPONENT_NUMBER
998  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component)%PTR% &
999  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
1000  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
1001  jgw=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
1002  & quadrature_scheme%GAUSS_WEIGHTS(ng)
1003  elements_topology=>field_variable%COMPONENTS(1)%DOMAIN%TOPOLOGY%ELEMENTS
1004 
1005  dxi_dx=0.0_dp
1006  !Calculate dxi_dx in 3D
1007  DO xiidx=1,dependent_basis%NUMBER_OF_XI
1008  DO coordidx=1,equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type) &
1009  & %PTR%NUMBER_OF_X_DIMENSIONS
1010  dxi_dx=dxi_dx+(equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)% &
1011  & ptr%DXI_DX(xiidx,coordidx))**2.0_dp
1012  END DO !coordIdx
1013  END DO !xiIdx
1014  dxi_dx=sqrt(dxi_dx)
1015 
1016  !Loop over element rows
1017  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
1018  phims=quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
1019  dphims_dxi=quadrature_scheme%GAUSS_BASIS_FNS(ms,first_part_deriv,ng)
1020  mhs=mhs+1
1021  nhs=0
1022  IF(update_stiffness_matrix .OR. update_damping_matrix) THEN
1023  !Loop over element columns
1024  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
1025  phins=quadrature_scheme%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)
1026  dphins_dxi=quadrature_scheme%GAUSS_BASIS_FNS(ns,first_part_deriv,ng)
1027  nhs=nhs+1
1028 
1029  !!!-- D A M P I N G M A T R I X --!!!
1030  IF(update_damping_matrix) THEN
1031  sum=phims*phins
1032  damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*jgw
1033  ENDIF
1034 
1035  !!!-- S T I F F N E S S M A T R I X --!!!
1036  IF(update_stiffness_matrix) THEN
1037  sum=(d*(dphims_dxi*dxi_dx)+(flow/area)*phims)*dphins_dxi*dxi_dx
1038  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*jgw
1039  ENDIF
1040 
1041  ENDDO !ns
1042  ENDIF
1043 
1044  ENDDO !ms
1045  ENDDO !ng
1046 
1047  CASE DEFAULT
1048  local_error="The third equations set specification of "// &
1049  & trim(number_to_vstring(equations_set%specification(3),"*",err,error))// &
1050  & " is not valid for an advection type of a classical field equations set."
1051  CALL flagerror(local_error,err,error,*999)
1052  END SELECT
1053  CASE DEFAULT
1054  local_error="The third equations set specification of "// &
1055  & trim(number_to_vstring(equations_set%specification(3),"*",err,error))// &
1056  & " is not valid for an advection equation type of a classical field equations set class."
1057  CALL flagerror(local_error,err,error,*999)
1058  END SELECT
1059  ELSE
1060  CALL flagerror("Equations set equations is not associated.",err,error,*999)
1061  ENDIF
1062  ELSE
1063  CALL flagerror("Equations set is not associated.",err,error,*999)
1064  ENDIF
1065 
1066  exits("ADVECTION_EQUATION_FINITE_ELEMENT_CALCULATE")
1067  RETURN
1068 999 errorsexits("ADVECTION_EQUATION_FINITE_ELEMENT_CALCULATE",err,error)
1069  RETURN 1
1070 
1072 
1073  !
1074  !================================================================================================================================
1075  !
1076 
1078  SUBROUTINE advection_pre_solve(SOLVER,ERR,ERROR,*)
1080  !Argument variables
1081  TYPE(solver_type), POINTER :: SOLVER
1082  INTEGER(INTG), INTENT(OUT) :: ERR
1083  TYPE(varying_string), INTENT(OUT) :: ERROR
1084  !Local Variables
1085  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1086  TYPE(solvers_type), POINTER :: SOLVERS
1087  TYPE(varying_string) :: LOCAL_ERROR
1088 
1089  enters("ADVECTION_PRE_SOLVE",err,error,*999)
1090 
1091  IF(ASSOCIATED(solver)) THEN
1092  solvers=>solver%SOLVERS
1093  IF(ASSOCIATED(solvers)) THEN
1094  control_loop=>solvers%CONTROL_LOOP
1095  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
1096  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
1097  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1098  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
1099  CALL flagerror("Problem specification must have three entries for an advection problem.",err,error,*999)
1100  END IF
1101  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
1105  CALL advection_pre_solve_update_bc(solver,err,error,*999)
1106 ! CALL Advection_Couple1D0D(SOLVER,ERR,ERROR,*999)
1107  CASE DEFAULT
1108  CALL flagerror(local_error,err,error,*999)
1109  END SELECT
1110  ELSE
1111  CALL flagerror("Problem is not associated.",err,error,*999)
1112  ENDIF
1113  ELSE
1114  CALL flagerror("Solvers is not associated.",err,error,*999)
1115  ENDIF
1116  ELSE
1117  CALL flagerror("Solver is not associated.",err,error,*999)
1118  ENDIF
1119 
1120  exits("ADVECTION_PRE_SOLVE")
1121  RETURN
1122 999 errorsexits("ADVECTION_PRE_SOLVE",err,error)
1123  RETURN 1
1124 
1125  END SUBROUTINE advection_pre_solve
1126 
1127  !
1128  !================================================================================================================================
1129  !
1130 
1131  !Update the boundary conditions
1132  SUBROUTINE advection_pre_solve_update_bc(SOLVER,ERR,ERROR,*)
1133  !Argument variables
1134  TYPE(solver_type), POINTER :: SOLVER
1135  INTEGER(INTG), INTENT(OUT) :: ERR
1136  TYPE(varying_string), INTENT(OUT) :: ERROR
1137  !Local Variables
1138  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1139  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
1140  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1141  TYPE(equations_type), POINTER :: EQUATIONS
1142  TYPE(field_type), POINTER :: DEPENDENT_FIELD
1143  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
1144  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
1145  TYPE(solvers_type), POINTER :: SOLVERS
1146  TYPE(varying_string) :: LOCAL_ERROR
1147  REAL(DP) :: CONC,START_TIME,STOP_TIME,CURRENT_TIME,TIME_INCREMENT,period,delta(300),t(300),c(300),s
1148  INTEGER(INTG) :: CURRENT_LOOP_ITERATION,OUTPUT_ITERATION_NUMBER,i,j,n,m
1149 
1150  enters("ADVECTION_PRE_SOLVE_UPDATE_BC",err,error,*999)
1151 
1152  IF(ASSOCIATED(solver)) THEN
1153  solvers=>solver%SOLVERS
1154  IF(ASSOCIATED(solvers)) THEN
1155  control_loop=>solvers%CONTROL_LOOP
1156  CALL control_loop_times_get(control_loop,start_time,stop_time,current_time,time_increment,current_loop_iteration, &
1157  & output_iteration_number,err,error,*999)
1158  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
1159  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
1160  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1161  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
1162  CALL flagerror("Problem specification must have three entries for an advection problem.",err,error,*999)
1163  END IF
1164  SELECT CASE(control_loop%PROBLEM%specification(3))
1167  solver_equations=>solver%SOLVER_EQUATIONS
1168  IF(ASSOCIATED(solver_equations)) THEN
1169  solver_mapping=>solver_equations%SOLVER_MAPPING
1170  IF(ASSOCIATED(solver_mapping)) THEN
1171  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
1172  IF(ASSOCIATED(equations)) THEN
1173  equations_set=>equations%EQUATIONS_SET
1174  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
1175  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
1176  IF(ASSOCIATED(dependent_field)) THEN
1177 
1178  IF(current_time<100)THEN
1179 
1180  t(1)=0.003228 ; c(1)=0.001513
1181  t(2)=0.077482 ; c(2)=0.001513
1182  t(3)=0.133979 ; c(3)=0.013616
1183  t(4)=0.187248 ; c(4)=0.040847
1184  t(5)=0.237288 ; c(5)=0.108926
1185  t(6)=0.285714 ; c(6)=0.226929
1186  t(7)=0.33414 ; c(7)=0.414523
1187  t(8)=0.417272 ; c(8)=0.800303
1188  t(9)=0.45117 ; c(9)=0.92587
1189  t(10)=0.479419 ; c(10)=0.984871
1190  t(11)=0.499596 ; c(11)=0.995461
1191  t(12)=0.519774 ; c(12)=0.984871
1192  t(13)=0.550444 ; c(13)=0.919818
1193  t(14)=0.583535 ; c(14)=0.795764
1194  t(15)=0.661017 ; c(15)=0.429652
1195  t(16)=0.698951 ; c(16)=0.282905
1196  t(17)=0.722357 ; c(17)=0.208775
1197  t(18)=0.753834 ; c(18)=0.128593
1198  t(19)=0.785311 ; c(19)=0.07413
1199  t(20)=0.824052 ; c(20)=0.034796
1200  t(21)=0.874899 ; c(21)=0.012103
1201  t(22)=0.91364 ; c(22)=0.004539
1202  t(23)=0.999193 ; c(23)=0.0
1203 
1204  !Initialize variables
1205  period=100
1206  m=1
1207  n=23
1208  !Compute derivation
1209  DO i=1,n-1
1210  delta(i)=(c(i+1)-c(i))/(t(i+1)-t(i))
1211  END DO
1212  delta(n)=delta(n-1)+(delta(n-1)-delta(n-2))/(t(n-1)-t(n-2))*(t(n)-t(n-1))
1213  !Find subinterval
1214  DO j=1,n-1
1215  IF (t(j) <= (current_time/period)) THEN
1216  m=j
1217  ENDIF
1218  END DO
1219  !Evaluate interpolant
1220  s=(current_time/period)-t(m)
1221  conc=(c(m)+s*delta(m))
1222  ELSE
1223  conc=0.0
1224  ENDIF
1225 
1226  CALL field_parameter_set_update_local_dof(dependent_field,field_u_variable_type,field_values_set_type, &
1227  & 1,conc,err,error,*999)
1228  CALL field_parameter_set_update_start(dependent_field, &
1229  & field_u_variable_type,field_values_set_type,err,error,*999)
1230  CALL field_parameter_set_update_finish(dependent_field, &
1231  & field_u_variable_type,field_values_set_type,err,error,*999)
1232  ELSE
1233  CALL flagerror("Dependent field and/or geometric field is/are not associated.",err,error,*999)
1234  END IF
1235  ELSE
1236  CALL flagerror("Equations are not associated.",err,error,*999)
1237  END IF
1238  ELSE
1239  CALL flagerror("Solver mapping is not associated.",err,error,*999)
1240  ENDIF
1241  ELSE
1242  CALL flagerror("Solver equations are not associated.",err,error,*999)
1243  END IF
1244  CASE DEFAULT
1245  CALL flagerror(local_error,err,error,*999)
1246  END SELECT
1247  ELSE
1248  CALL flagerror("Problem is not associated.",err,error,*999)
1249  ENDIF
1250  ELSE
1251  CALL flagerror("Solvers is not associated.",err,error,*999)
1252  ENDIF
1253  ELSE
1254  CALL flagerror("Solver is not associated.",err,error,*999)
1255  ENDIF
1256 
1257  exits("ADVECTION_PRE_SOLVE_UPDATE_BC")
1258  RETURN
1259 999 errorsexits("ADVECTION_PRE_SOLVE_UPDATE_BC",err,error)
1260  RETURN 1
1261 
1262  END SUBROUTINE advection_pre_solve_update_bc
1263 
1264  !
1265  !================================================================================================================================
1266  !
1267 
1268  SUBROUTINE advection_post_solve(SOLVER,ERR,ERROR,*)
1270  !Argument variables
1271  TYPE(solver_type), POINTER :: SOLVER
1272  INTEGER(INTG), INTENT(OUT) :: ERR
1273  TYPE(varying_string), INTENT(OUT) :: ERROR
1274  !Local Variables
1275  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1276  TYPE(solvers_type), POINTER :: SOLVERS
1277  TYPE(varying_string) :: LOCAL_ERROR
1278 
1279  enters("ADVECTION_POST_SOLVE",err,error,*999)
1280 
1281  IF(ASSOCIATED(solver)) THEN
1282  solvers=>solver%SOLVERS
1283  IF(ASSOCIATED(solvers)) THEN
1284  control_loop=>solvers%CONTROL_LOOP
1285  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
1286  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
1287  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1288  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
1289  CALL flagerror("Problem specification must have three entries for an advection problem.",err,error,*999)
1290  END IF
1291  SELECT CASE(control_loop%PROBLEM%specification(3))
1293  !Do nothing
1294  CASE DEFAULT
1295  local_error="The third problem specification of "// &
1296  & trim(number_to_vstring(control_loop%PROBLEM%specification(3),"*",err,error))// &
1297  & " is not valid for an advection type of a classical field problem."
1298  CALL flagerror(local_error,err,error,*999)
1299  END SELECT
1300  ELSE
1301  CALL flagerror("Problem is not associated.",err,error,*999)
1302  ENDIF
1303  ELSE
1304  CALL flagerror("Solvers is not associated.",err,error,*999)
1305  ENDIF
1306  ELSE
1307  CALL flagerror("Solver is not associated.",err,error,*999)
1308  ENDIF
1309 
1310  exits("ADVECTION_POST_SOLVE")
1311  RETURN
1312 999 errorsexits("ADVECTION_POST_SOLVE",err,error)
1313  RETURN 1
1314 
1315  END SUBROUTINE advection_post_solve
1316 
1317  !
1318  !================================================================================================================================
1319  !
1320 
1322  SUBROUTINE advection_couple1d0d(SOLVER,ERR,ERROR,*)
1324  !Argument variables
1325  TYPE(solver_type), POINTER :: SOLVER
1326  INTEGER(INTG), INTENT(OUT) :: ERR
1327  TYPE(varying_string), INTENT(OUT) :: ERROR
1328  !Local Variables
1329  TYPE(equations_set_type), POINTER :: equationsSet
1330  TYPE(field_type), POINTER :: dependentField
1331  TYPE(solver_equations_type), POINTER :: solverEquations
1332  TYPE(solver_mapping_type), POINTER :: solverMapping
1333 
1334  enters("Advection_Couple1D0D",err,error,*999)
1335 
1336  IF(ASSOCIATED(solver)) THEN
1337  solverequations=>solver%SOLVER_EQUATIONS
1338  IF(ASSOCIATED(solverequations)) THEN
1339  solvermapping=>solverequations%SOLVER_MAPPING
1340  IF(ASSOCIATED(solvermapping)) THEN
1341  equationsset=>solvermapping%EQUATIONS_SETS(1)%PTR
1342  IF(ASSOCIATED(equationsset)) THEN
1343  dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
1344  ELSE
1345  CALL flagerror("Equations set is not associated.",err,error,*999)
1346  ENDIF
1347  ELSE
1348  CALL flagerror("Solver mapping is not associated.",err,error,*999)
1349  ENDIF
1350  ELSE
1351  CALL flagerror("Solver equations is not associated.",err,error,*999)
1352  ENDIF
1353  ELSE
1354  CALL flagerror("Solver is not associated.",err,error,*999)
1355  ENDIF
1356 
1357  exits("Advection_Couple1D0D")
1358  RETURN
1359 999 errorsexits("Advection_Couple1D0D",err,error)
1360  RETURN 1
1361 
1362  END SUBROUTINE
1363 
1364  !
1365  !================================================================================================================================
1366  !
1367 
1368 END MODULE advection_equation_routines
1369 
integer(intg), parameter equations_set_setup_dependent_type
Dependent variables.
integer(intg), parameter equations_set_fem_solution_method
Finite Element Method solution method.
This module contains all basis function routines.
integer(intg), parameter equations_set_setup_materials_type
Materials setup.
Contains information on the boundary conditions for the solver equations.
Definition: types.f90:1780
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
subroutine, public solvers_create_finish(SOLVERS, ERR, ERROR,)
Finish the creation of solvers.
integer, parameter ptr
Pointer integer kind.
Definition: kinds.f90:58
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...
This module handles pure advection equation routines.
Contains information on the equations mapping i.e., how field variable DOFS are mapped to the rows an...
Definition: types.f90:1681
Contains information about the equations in an equations set.
Definition: types.f90:1735
integer(intg), parameter problem_control_time_loop_type
Time control loop.
integer(intg), parameter problem_setup_control_type
Solver setup for a problem.
This module handles all problem wide constants.
integer(intg), parameter solver_equations_first_order_dynamic
Solver equations are first order dynamic.
integer(intg), parameter, public control_loop_node
The identifier for a each "leaf" node in a control loop.
subroutine, public solver_dynamic_order_set(SOLVER, ORDER, ERR, ERROR,)
Sets/changes the order for a dynamic solver.
subroutine, public advection_pre_solve(SOLVER, ERR, ERROR,)
Sets up the Poisson problem pre solve.
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
subroutine, public equations_create_start(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Start the creation of equations for the equation set.
Contains information on the mesh decomposition.
Definition: types.f90:1063
subroutine, public advection_pre_solve_update_bc(SOLVER, ERR, ERROR,)
subroutine, public equations_matrices_create_start(EQUATIONS, EQUATIONS_MATRICES, ERR, ERROR,)
Starts the creation of the equations matrices and rhs for the the equations.
Contains information on the type of solver to be used.
Definition: types.f90:2777
subroutine, public solvers_number_set(SOLVERS, NUMBER_OF_SOLVERS, ERR, ERROR,)
Sets/changes the number of solvers.
integer(intg), parameter no_part_deriv
No partial derivative i.e., u.
Definition: constants.f90:177
subroutine, public solver_dynamic_degree_set(SOLVER, DEGREE, ERR, ERROR,)
Sets/changes the degree of the polynomial used to interpolate time for a dynamic solver.
This module handles all equations matrix and rhs routines.
integer(intg), parameter, public solver_dynamic_first_order
Dynamic solver has first order terms.
subroutine, public solver_type_set(SOLVER, SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type for a solver.
Contains information on an equations set.
Definition: types.f90:1941
This module handles all equations routines.
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
subroutine, public solvers_create_start(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Start the creation of a solvers for the control loop.
Contains information on the solvers to be used in a control loop.
Definition: types.f90:2805
integer(intg), parameter first_part_deriv
First partial derivative i.e., du/ds.
Definition: constants.f90:178
This module contains routines for timing the program.
Definition: timer_f.f90:45
subroutine, public advection_post_solve(SOLVER, ERR, ERROR,)
integer(intg), parameter problem_advection_subtype
subroutine, public equations_time_dependence_type_set(EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for equations.
subroutine, public solver_equations_sparsity_type_set(SOLVER_EQUATIONS, SPARSITY_TYPE, ERR, ERROR,)
Sets/changes the sparsity type for solver equations.
This module handles all analytic analysis routines.
This module contains all mathematics support routines.
Definition: maths.f90:45
subroutine, public solvers_solver_get(SOLVERS, SOLVER_INDEX, SOLVER, ERR, ERROR,)
Returns a pointer to the specified solver in the list of solvers.
Contains information for a field defined on a region.
Definition: types.f90:1346
integer(intg), parameter, public equations_matrices_full_matrices
Use fully populated equation matrices.
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.
integer(intg), parameter solver_equations_linear
Solver equations are linear.
Contains information on a control loop.
Definition: types.f90:3185
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
subroutine, public solver_equations_create_finish(SOLVER_EQUATIONS, ERR, ERROR,)
Finishes the process of creating solver equations.
integer(intg), parameter, public solver_sparse_matrices
Use sparse solver matrices.
subroutine, public solver_equations_create_start(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Starts the process of creating solver equations.
subroutine, public advection_couple1d0d(SOLVER, ERR, ERROR,)
Update area for boundary nodes.
integer(intg), parameter, public solver_dynamic_type
A dynamic solver.
integer(intg), parameter, public basis_default_quadrature_scheme
Identifier for the default quadrature scheme.
integer(intg), parameter problem_setup_solvers_type
Solver setup for a problem.
integer(intg), parameter equations_set_setup_equations_type
Equations setup.
Contains information for mapping field variables to the dynamic matrices in the equations set of the ...
Definition: types.f90:1571
integer(intg), parameter equations_set_setup_independent_type
Independent variables.
This module contains all program wide constants.
Definition: constants.f90:45
subroutine, public solver_library_type_set(SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library type to use for the solver.
subroutine, public control_loop_times_get(CONTROL_LOOP, START_TIME, STOP_TIME, CURRENT_TIME, TIME_INCREMENT, CURRENT_LOOP_ITERATION, OUTPUT_ITERATION_NUMBER, ERR, ERROR,)
Gets the current time parameters for a time control loop.
integer(intg), parameter problem_setup_initial_type
Initial setup for a problem.
integer(intg), parameter equations_set_advection_subtype
Contains the topology information for the elements of a domain.
Definition: types.f90:677
subroutine, public advection_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for an advection type of a classical field equations set...
integer(intg), parameter equations_first_order_dynamic
The equations are first order dynamic.
subroutine, public solver_equations_linearity_type_set(SOLVER_EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for solver equations.
integer(intg), parameter equations_set_setup_start_action
Start setup action.
integer(intg), parameter problem_classical_field_class
subroutine, public exits(NAME)
Records the exit out of the named procedure.
recursive subroutine, public control_loop_solvers_get(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Returns a pointer to the solvers for a control loop.
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
Contains information on the equations matrices and vectors.
Definition: types.f90:1520
integer(intg), parameter, public equations_matrix_fem_structure
Finite element matrix structure.
subroutine, public advection_equationssetsetup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the diffusion equation type of a classical field equations set class.
integer(intg), parameter equations_set_advection_equation_type
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
subroutine, public equationsmatrices_dynamicstructuretypeset(EQUATIONS_MATRICES, STRUCTURE_TYPE, ERR, ERROR,)
Sets the structure (sparsity) of the dynamic equations matrices.
subroutine, public equations_matrices_linear_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the linear equations matrices.
subroutine, public equations_mapping_create_finish(EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping.
Returns the specified control loop as indexed by the control loop identifier from the control loop ro...
subroutine, public control_loop_type_set(CONTROL_LOOP, LOOP_TYPE, ERR, ERROR,)
Sets/changes the control loop type.
integer(intg), parameter problem_coupled1d0d_adv_navier_stokes_subtype
subroutine, public equations_set_equations_get(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Gets the equations for an equations set.
subroutine, public equations_create_finish(EQUATIONS, ERR, ERROR,)
Finish the creation of equations.
subroutine advection_equation_problem_linear_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the advection equations.
This module handles all domain mappings routines.
integer(intg), parameter problem_setup_finish_action
Finish setup action.
This module handles all equations mapping routines.
Contains information about the solver equations for a solver.
Definition: types.f90:2452
subroutine, public equations_matrices_dynamic_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the dynamic equations matrices.
integer(intg), parameter equations_set_setup_geometry_type
Geometry setup.
Contains information for a problem.
Definition: types.f90:3221
integer(intg), parameter equations_set_classical_field_class
integer(intg), parameter equations_linear
The equations are linear.
subroutine, public equations_matrices_create_finish(EQUATIONS_MATRICES, ERR, ERROR,)
Finishes the creation of the equations matrices and RHS for the the equations.
This module handles all distributed matrix vector routines.
This module handles all boundary conditions routines.
This module handles all solver routines.
subroutine, public equations_mapping_create_start(EQUATIONS, EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping for a equations set equations.
Contains information about an equations matrix.
Definition: types.f90:1429
Contains information for a particular quadrature scheme.
Definition: types.f90:141
This module contains all routines dealing with (non-distributed) matrix and vectors types...
integer(intg), parameter, public distributed_matrix_block_storage_type
Distributed matrix block storage type.
subroutine, public equations_linearity_type_set(EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for equations.
subroutine, public control_loop_create_start(PROBLEM, CONTROL_LOOP, ERR, ERROR,)
Start the process of creating a control loop for a problem.
integer(intg), parameter problem_setup_solver_equations_type
Solver equations setup for a problem.
Contains information on the solver mapping between the global equation sets and the solver matrices...
Definition: types.f90:3091
Contains information for a field variable defined on a field.
Definition: types.f90:1289
subroutine, public advection_equation_finite_element_calculate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element stiffness matrices for an advection equation finite element equations set...
integer(intg), parameter, public equations_matrices_sparse_matrices
Use sparse equations matrices.
subroutine advection_equationssetlinearsetup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the advection equation.
Contains information on the setup information for an equations set.
Definition: types.f90:1866
subroutine, public advection_equationssetsolutionmethodset(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for an advection equation type of an classical field equations set c...
integer(intg), parameter problem_setup_start_action
Start setup action.
integer(intg), parameter problem_transient1d_adv_navier_stokes_subtype
subroutine, public solver_equations_time_dependence_type_set(SOLVER_EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for solver equations.
This module handles all control loop routines.
integer(intg), parameter, public solver_cmiss_library
CMISS (internal) solver library.
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
This module defines all constants shared across equations set routines.
subroutine, public solver_solver_equations_get(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Returns a pointer to the solver equations for a solver.
Contains all information about a basis .
Definition: types.f90:184
subroutine, public advection_equation_problem_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the diffusion problem.
integer(intg), parameter problem_advection_equation_type
subroutine, public advection_problemspecificationset(problem, problemSpecification, err, error,)
Sets the problem specification for an advection problem.
integer(intg), parameter, public solver_dynamic_first_degree
Dynamic solver uses a first degree polynomial for time interpolation.
integer(intg), parameter equations_set_setup_initial_type
Initial setup.
recursive subroutine, public control_loop_create_finish(CONTROL_LOOP, ERR, ERROR,)
Finish the process of creating a control loop.
Flags an error condition.
integer(intg), parameter equations_set_nodal_solution_method
Similar to Finite Element Method with looping over nodes instead of elements.
This module contains all kind definitions.
Definition: kinds.f90:45
integer(intg), parameter equations_set_setup_finish_action
Finish setup action.
integer(intg), parameter, public distributed_matrix_compressed_row_storage_type
Distributed matrix compressed row storage type.
Contains information of the dynamic matrices for equations matrices.
Definition: types.f90:1471
This module handles all formating and input and output.