OpenCMISS-Iron Internal API Documentation
reaction_diffusion_equation_routines.f90
Go to the documentation of this file.
1 
43 
46 
47  USE base_routines
48  USE basis_routines
51  USE constants
54  USE domain_mappings
59  USE field_routines
60  USE input_output
62  USE kinds
63  USE matrix_vector
64 #ifndef NOMPIMOD
65  USE mpi
66 #endif
68  USE strings
69  USE solver_routines
70  USE timer
71  USE types
72 
74 
75 #include "macros.h"
76 
77  IMPLICIT NONE
78 
79  PRIVATE
80 
81 #ifdef NOMPIMOD
82 #include "mpif.h"
83 #endif
84 
85  !Module parameters
86 
87  !Module types
88 
89  !Module variables
90 
91  !Interfaces
92 
93  PUBLIC reactiondiffusion_equationssetsetup
94 
95  PUBLIC reactiondiffusion_equationssetsolutionmethodset
96 
97  PUBLIC reactiondiffusion_equationssetspecificationset
98 
99  PUBLIC reactiondiffusion_finiteelementcalculate
100 
101  PUBLIC reaction_diffusion_pre_solve
102 
103  PUBLIC reaction_diffusion_equation_problem_setup
104 
105  PUBLIC reactiondiffusion_problemspecificationset
106 
107  PUBLIC reaction_diffusion_post_solve
108 
109  PUBLIC reaction_diffusion_control_loop_post_loop
110 
111 
112 CONTAINS
113 
114  !
115  !================================================================================================================================
116  !
117 
119  SUBROUTINE reactiondiffusion_equationssetsetup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
121  !Argument variables
122  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
123  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
124  INTEGER(INTG), INTENT(OUT) :: ERR
125  TYPE(varying_string), INTENT(OUT) :: ERROR
126  !Local Variables
127  INTEGER(INTG) :: component_idx,DIMENSION_MULTIPLIER,GEOMETRIC_COMPONENT_NUMBER,GEOMETRIC_SCALING_TYPE, &
128  & NUMBER_OF_DIMENSIONS,NUMBER_OF_MATERIALS_COMPONENTS,GEOMETRIC_MESH_COMPONENT
129  TYPE(decomposition_type), POINTER :: GEOMETRIC_DECOMPOSITION
130  TYPE(equations_type), POINTER :: EQUATIONS
131  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
132  TYPE(equations_set_materials_type), POINTER :: EQUATIONS_MATERIALS
133  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
134  TYPE(varying_string) :: LOCAL_ERROR
135 
136  enters("ReactionDiffusion_EquationsSetSetup",err,error,*999)
137 
138  NULLIFY(equations)
139  NULLIFY(equations_mapping)
140  NULLIFY(equations_matrices)
141  NULLIFY(geometric_decomposition)
142 
143  IF(ASSOCIATED(equations_set)) THEN
144  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
145  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
146  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
147  CALL flagerror("Equations set specification must have three entries for a reaction-diffusion type equations set.", &
148  & err,error,*999)
149  END IF
150  SELECT CASE(equations_set_setup%SETUP_TYPE)
152  SELECT CASE(equations_set_setup%ACTION_TYPE)
154  CALL reactiondiffusion_equationssetsolutionmethodset(equations_set, &
155  & equations_set_fem_solution_method,err,error,*999)
157 !!Todo: CHECK VALID SETUP
158  CASE DEFAULT
159  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
160  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
161  & " is invalid for a reaction diffusion domain equation."
162  CALL flagerror(local_error,err,error,*999)
163  END SELECT
165  !\todo Check geometric dimension
167  SELECT CASE(equations_set_setup%ACTION_TYPE)
169  SELECT CASE(equations_set%SPECIFICATION(3))
172  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
173  !Create the auto created dependent field
174  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
175  & dependent_field,err,error,*999)
176  CALL field_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
177  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
178  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
179  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
180  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
181  & err,error,*999)
182  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
183  & geometric_field,err,error,*999)
184  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,2,err,error,*999)
185  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,[field_u_variable_type, &
186  & field_deludeln_variable_type],err,error,*999)
187  !CALL FIELD_VARIABLE_LABEL_SET
188  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
189  & field_scalar_dimension_type,err,error,*999)
190  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
191  & field_scalar_dimension_type,err,error,*999)
192  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
193  & field_dp_type,err,error,*999)
194  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
195  & field_dp_type,err,error,*999)
196  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
197  & err,error,*999)
198  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
199  & err,error,*999)
200  !Default to the geometric interpolation setup
201  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,1, &
202  & geometric_mesh_component,err,error,*999)
203  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
204  & geometric_mesh_component,err,error,*999)
205  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
206  & geometric_mesh_component,err,error,*999)
207  SELECT CASE(equations_set%SOLUTION_METHOD)
209  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
210  & field_u_variable_type,1,field_node_based_interpolation,err,error,*999)
211  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
212  & field_deludeln_variable_type,1,field_node_based_interpolation,err,error,*999)
213  !Default the scaling to the geometric field scaling
214  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
215  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
217  CALL flagerror("Not implemented.",err,error,*999)
219  CALL flagerror("Not implemented.",err,error,*999)
221  CALL flagerror("Not implemented.",err,error,*999)
223  CALL flagerror("Not implemented.",err,error,*999)
225  CALL flagerror("Not implemented.",err,error,*999)
226  CASE DEFAULT
227  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
228  & " is invalid."
229  CALL flagerror(local_error,err,error,*999)
230  END SELECT
231  ELSE
232  !Check the user specified field
233  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
234  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
235  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
236  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_deludeln_variable_type], &
237  & err,error,*999)
238  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_scalar_dimension_type,err,error,*999)
239  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_scalar_dimension_type, &
240  & err,error,*999)
241  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
242  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
243  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1,err,error,*999)
244  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type,1,err,error,*999)
245  SELECT CASE(equations_set%SOLUTION_METHOD)
247  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
248  & field_node_based_interpolation,err,error,*999)
249  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
250  & field_node_based_interpolation,err,error,*999)
252  CALL flagerror("Not implemented.",err,error,*999)
254  CALL flagerror("Not implemented.",err,error,*999)
256  CALL flagerror("Not implemented.",err,error,*999)
258  CALL flagerror("Not implemented.",err,error,*999)
260  CALL flagerror("Not implemented.",err,error,*999)
261  CASE DEFAULT
262  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
263  & " is invalid."
264  CALL flagerror(local_error,err,error,*999)
265  END SELECT
266  ENDIF
268  CALL flagerror("Not implemented.",err,error,*999)
269  CASE DEFAULT
270  local_error="The equation set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
271  & " is invalid for a reaction diffusion equation set class."
272  CALL flagerror(local_error,err,error,*999)
273  END SELECT
275  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
276  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
277  ENDIF
278  CASE DEFAULT
279  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
280  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
281  & " is invalid for a reaction diffusion equation"
282  CALL flagerror(local_error,err,error,*999)
283  END SELECT
285  SELECT CASE(equations_set_setup%ACTION_TYPE)
287  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
288  equations_materials=>equations_set%MATERIALS
289  IF(ASSOCIATED(equations_materials)) THEN
290  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
291  !Create the auto created materials field
292  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_materials% &
293  & materials_field,err,error,*999)
294  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
295  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type,err,error,*999)
296  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
297  CALL field_mesh_decomposition_set_and_lock(equations_materials%MATERIALS_FIELD,geometric_decomposition, &
298  & err,error,*999)
299  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
300  & geometric_field,err,error,*999)
301  CALL field_number_of_variables_set_and_lock(equations_materials%MATERIALS_FIELD,1,err,error,*999)
302  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,[field_u_variable_type], &
303  & err,error,*999)
304  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
305  & field_vector_dimension_type,err,error,*999)
306  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
307  & field_dp_type,err,error,*999)
308  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
309  & number_of_dimensions,err,error,*999)
310  IF(equations_set%SPECIFICATION(3)==equations_set_cellml_reac_split_reac_diff_subtype) THEN
311  !Reaction Diffusion. Materials field components are 1 diffusion coeff for each dimension
312  !plus one for the storage coefficient in alpha(delC/delt) = Div(-kgradC)+cellmlRC
313  number_of_materials_components=number_of_dimensions+1
314  dimension_multiplier=1
315  ELSEIF(equations_set%SPECIFICATION(3)==equations_set_constant_reac_diff_subtype) THEN
316  !Constant reaction + diffusion. Materials field has 1 diffuse coeff for each dimension
317  !plus one for the storage coefficient om alpha(delC/delt) = Div(-kgradC)+const(x)_source
318  number_of_materials_components=number_of_dimensions+1
319  dimension_multiplier=1
320  ENDIF
321  !Set the number of materials components
322  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
323  & number_of_materials_components,err,error,*999)
324  !Default the first three materials components for diffusivity param to the first component geometric interpolation with const interpolation
325  DO component_idx=1,number_of_dimensions
326  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
327  & 1,geometric_component_number,err,error,*999)
328  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
329  & component_idx,geometric_component_number,err,error,*999)
330  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
331  & component_idx,field_constant_interpolation,err,error,*999)
332  ENDDO !components_idx
333  !Default the storage co-efficient to the first geometric interpolation setup with constant interpolation
334  IF(equations_set%SPECIFICATION(3)==equations_set_cellml_reac_split_reac_diff_subtype) THEN
335  component_idx=number_of_materials_components
336  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
337  & 1,geometric_component_number,err,error,*999)
338  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
339  & component_idx,geometric_component_number,err,error,*999)
340  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
341  & component_idx,field_constant_interpolation,err,error,*999)
342  ENDIF
343  !Default the field scaling to that of the geometric field
344  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
345  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
346  ELSE
347  !Check the user specified field
348  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
349  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
350  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
351  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
352  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
353  & err,error,*999)
354  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
355  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
356  & number_of_dimensions,err,error,*999)
357  IF(equations_set%SPECIFICATION(3)==equations_set_cellml_reac_split_reac_diff_subtype .OR. &
358  & equations_set%SPECIFICATION(3)==equations_set_constant_reac_diff_subtype) THEN
359  !Reaction Diffusion with cellml. Materials field components are 1 for storage coeff plus one for each dimension i.e., k
360  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_dimensions+1, &
361  & err,error,*999)
362  ENDIF
363  ENDIF
364  ELSE
365  CALL flagerror("Equations set materials is not associated.",err,error,*999)
366  ENDIF
367  ELSE
368  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
369  ENDIF
371  equations_materials=>equations_set%MATERIALS
372  IF(ASSOCIATED(equations_materials)) THEN
373  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
374  !Finish creating the materials field
375  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
376  !Set the default values for the materials field
377  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
378  & number_of_dimensions,err,error,*999)
379  IF(equations_set%SPECIFICATION(3)==equations_set_cellml_reac_split_reac_diff_subtype .OR. &
380  & equations_set%SPECIFICATION(3)==equations_set_constant_reac_diff_subtype) THEN
381  !Reaction Diffusion with cellml. Materials field components are 1 plus one for each dimension i.e.,storage coeff, and k.
382  number_of_materials_components=number_of_dimensions+1
383  dimension_multiplier=1
384  ENDIF
385  !set the diffusion coefficients to be 1.0
386  DO component_idx=1,number_of_dimensions
387  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
388  & field_values_set_type,component_idx,1.0_dp,err,error,*999)
389  ENDDO !component_idx
390  !Now set storage-coefficient
391  component_idx=number_of_dimensions+1
392  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
393  & field_values_set_type,component_idx,1.0_dp,err,error,*999)
394  ENDIF
395  ELSE
396  CALL flagerror("Equations set materials is not associated.",err,error,*999)
397  ENDIF
398  CASE DEFAULT
399  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
400  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
401  & " is invalid for a reaction diffusion equation."
402  CALL flagerror(local_error,err,error,*999)
403  END SELECT
405  SELECT CASE(equations_set_setup%ACTION_TYPE)
407  IF(ASSOCIATED(equations_set%MATERIALS)) THEN
408  IF(equations_set%MATERIALS%MATERIALS_FINISHED) THEN
409  IF(ASSOCIATED(equations_set%SOURCE)) THEN
410  IF(equations_set%SOURCE%SOURCE_FIELD_AUTO_CREATED) THEN
411  !Create the auto created source field
412  !Start field creation with name 'SOURCE_FIELD'
413  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
414  & equations_set%SOURCE%SOURCE_FIELD,err,error,*999)
415  !Create a general field
416  CALL field_type_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_general_type,err,error,*999)
417  !Label the field
418  CALL field_label_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,"Source Field",err,error,*999)
419  !Set the dependent type
420  CALL field_dependent_type_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_independent_type,err,error,*999)
421  !Set the field decomposition to be that of the geometric decomposition
422  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
423  CALL field_mesh_decomposition_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,geometric_decomposition, &
424  & err,error,*999)
425  !Set the geometric field
426  CALL field_geometric_field_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,equations_set% &
427  & geometry%GEOMETRIC_FIELD,err,error,*999)
428  !Set the field variables.
429  CALL field_number_of_variables_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,1,err,error,*999)
430  CALL field_variable_types_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,[field_u_variable_type],err,error,*999)
431  !Set the dimension
432  CALL field_dimension_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
433  & field_scalar_dimension_type,err,error,*999)
434  !Set the data type
435  CALL field_data_type_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
436  & field_dp_type,err,error,*999)
437  !Set the number of components to one
438  CALL field_number_of_components_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type,1, &
439  & err,error,*999)
440  !Get the geometric mesh component
441  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
442  & 1,geometric_mesh_component,err,error,*999)
443  !Default to the geometric interpolation setup
444  CALL field_component_mesh_component_set(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type,1, &
445  & geometric_mesh_component,err,error,*999)
446  !Specify the interpolation to be same as geometric interpolation
447  SELECT CASE(equations_set%SOLUTION_METHOD)
449  CALL field_component_interpolation_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type,1, &
450  & field_node_based_interpolation,err,error,*999)
452  CALL flagerror("Not implemented.",err,error,*999)
454  CALL flagerror("Not implemented.",err,error,*999)
456  CALL flagerror("Not implemented.",err,error,*999)
458  CALL flagerror("Not implemented.",err,error,*999)
460  CALL flagerror("Not implemented.",err,error,*999)
461  CASE DEFAULT
462  local_error="The solution method of " &
463  & //trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// " is invalid."
464  CALL flagerror(local_error,err,error,*999)
465  END SELECT
466  !Set the scaling to be the same as the geometric field
467  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
468  & err,error,*999)
469  CALL field_scaling_type_set(equations_set%SOURCE%SOURCE_FIELD,geometric_scaling_type, &
470  & err,error,*999)
471  ELSE
472  !Check the user specified field
473  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
474  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
475  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
476  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
477  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_scalar_dimension_type, &
478  & err,error,*999)
479  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
480  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1,err,error,*999)
481 
482  SELECT CASE(equations_set%SOLUTION_METHOD)
484  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
485  & field_node_based_interpolation,err,error,*999)
487  CALL flagerror("Not implemented.",err,error,*999)
489  CALL flagerror("Not implemented.",err,error,*999)
491  CALL flagerror("Not implemented.",err,error,*999)
493  CALL flagerror("Not implemented.",err,error,*999)
495  CALL flagerror("Not implemented.",err,error,*999)
496  CASE DEFAULT
497  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD, &
498  &"*",err,error))//" is invalid."
499  CALL flagerror(local_error,err,error,*999)
500  END SELECT
501 
502  ENDIF
503  ELSE
504  CALL flagerror("Equations set source is not associated.",err,error,*999)
505  ENDIF
506  ELSE
507  CALL flagerror("Equations set materials field has not been finished.",err,error,*999)
508  ENDIF
509  ELSE
510  CALL flagerror("Equations set materials is not associated.",err,error,*999)
511  ENDIF
513  IF(equations_set%SOURCE%SOURCE_FIELD_AUTO_CREATED) THEN
514  CALL field_create_finish(equations_set%SOURCE%SOURCE_FIELD,err,error,*999)
515  ENDIF
516  CASE DEFAULT
517  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
518  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
519  & " is invalid for a reaction diffusion equation."
520  CALL flagerror(local_error,err,error,*999)
521  END SELECT
523  SELECT CASE(equations_set_setup%ACTION_TYPE)
525  CALL flagerror("Not implemented.",err,error,*999)
527  CALL flagerror("Not implemented.",err,error,*999)
528  CASE DEFAULT
529  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
530  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
531  & " is invalid for a reaction diffusion equation."
532  CALL flagerror(local_error,err,error,*999)
533  END SELECT
535  SELECT CASE(equations_set_setup%ACTION_TYPE)
537  IF(ASSOCIATED(equations_set%SOURCE)) THEN
538  IF(equations_set%SOURCE%SOURCE_FINISHED) THEN
539  !Create the equations
540  CALL equations_create_start(equations_set,equations,err,error,*999)
541  SELECT CASE(equations_set%SPECIFICATION(3))
543  CALL equations_linearity_type_set(equations,equations_linear,err,error,*999)
545  CALL equations_linearity_type_set(equations,equations_linear,err,error,*999)
547  CALL equations_linearity_type_set(equations,equations_nonlinear,err,error,*999)
548  CASE DEFAULT
549  local_error="The equations matrices linearity set up of "// &
550  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
551  CALL flagerror(local_error,err,error,*999)
552  END SELECT
554  ELSE
555  CALL flagerror("Equations set source field has not been finished.",err,error,*999)
556  ENDIF
557  ELSE
558  CALL flagerror("Equations set source is not associated.",err,error,*999)
559  ENDIF
561  SELECT CASE(equations_set%SOLUTION_METHOD)
563  !Finish the creation of the equations
564  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
565  CALL equations_create_finish(equations,err,error,*999)
566  !Create the equations mapping.
567  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
568  CALL equations_mapping_dynamic_matrices_set(equations_mapping,.true.,.true.,err,error,*999)
569  CALL equations_mapping_dynamic_variable_type_set(equations_mapping,field_u_variable_type,err,error,*999)
570  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
571 
572  CALL equations_mapping_source_variable_type_set(equations_mapping,field_u_variable_type,err,error,*999)
573  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
574  !Create the equations matrices
575  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
576  !Set up matrix storage and structure
577  IF(equations%LUMPING_TYPE==equations_lumped_matrices) THEN
578  !Set up lumping
579  CALL equations_matrices_dynamic_lumping_type_set(equations_matrices, &
581  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
583  & err,error,*999)
584  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
586  ELSE
587  SELECT CASE(equations%SPARSITY_TYPE)
589  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
591  & err,error,*999)
593  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
595  & err,error,*999)
596  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
598  CASE DEFAULT
599  local_error="The equations matrices sparsity type of "// &
600  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
601  CALL flagerror(local_error,err,error,*999)
602  END SELECT
603  ENDIF
604  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
606  CALL flagerror("Not implemented.",err,error,*999)
608  CALL flagerror("Not implemented.",err,error,*999)
610  CALL flagerror("Not implemented.",err,error,*999)
612  CALL flagerror("Not implemented.",err,error,*999)
614  CALL flagerror("Not implemented.",err,error,*999)
615  CASE DEFAULT
616  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
617  & " is invalid."
618  CALL flagerror(local_error,err,error,*999)
619  END SELECT
620  CASE DEFAULT
621  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
622  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
623  & " is invalid for a bioelectric domain equation."
624  CALL flagerror(local_error,err,error,*999)
625  END SELECT
626  CASE DEFAULT
627  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
628  & " is invalid for reaction diffusion equation."
629  CALL flagerror(local_error,err,error,*999)
630  END SELECT
631  ELSE
632  CALL flagerror("Equations set is not associated.",err,error,*999)
633  ENDIF
634 
635  exits("ReactionDiffusion_EquationsSetSetup")
636  RETURN
637 999 errorsexits("ReactionDiffusion_EquationsSetSetup",err,error)
638  RETURN 1
639 
640  END SUBROUTINE reactiondiffusion_equationssetsetup
641 
642  !
643  !================================================================================================================================
644  !
645 
647  SUBROUTINE reactiondiffusion_equationssetsolutionmethodset(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)
649  !Argument variables
650  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
651  INTEGER(INTG), INTENT(IN) :: SOLUTION_METHOD
652  INTEGER(INTG), INTENT(OUT) :: ERR
653  TYPE(varying_string), INTENT(OUT) :: ERROR
654  !Local Variables
655  TYPE(varying_string) :: LOCAL_ERROR
656 
657  enters("ReactionDiffusion_EquationsSetSolutionMethodSet",err,error,*999)
658 
659  IF(ASSOCIATED(equations_set)) THEN
660  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
661  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
662  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
663  CALL flagerror("Equations set specification must have three entries for a reaction-diffusion type equations set.", &
664  & err,error,*999)
665  END IF
666  SELECT CASE(equations_set%SPECIFICATION(3))
670  SELECT CASE(solution_method)
672  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
674  CALL flagerror("Not implemented.",err,error,*999)
676  CALL flagerror("Not implemented.",err,error,*999)
678  CALL flagerror("Not implemented.",err,error,*999)
680  CALL flagerror("Not implemented.",err,error,*999)
682  CALL flagerror("Not implemented.",err,error,*999)
683  CASE DEFAULT
684  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
685  CALL flagerror(local_error,err,error,*999)
686  END SELECT
687  CASE DEFAULT
688  local_error="Equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
689  & " is not valid for a reaction diffusion equation type of classical equations set class."
690  CALL flagerror(local_error,err,error,*999)
691  END SELECT
692 
693  ELSE
694  CALL flagerror("Equations set is not associated.",err,error,*999)
695  ENDIF
696 
697  exits("ReactionDiffusion_EquationsSetSolutionMethodSet")
698  RETURN
699 999 errors("ReactionDiffusion_EquationsSetSolutionMethodSet",err,error)
700  exits("ReactionDiffusion_EquationsSetSolutionMethodSet")
701  RETURN 1
702 
703  END SUBROUTINE reactiondiffusion_equationssetsolutionmethodset
704 
705  !
706  !================================================================================================================================
707  !
708 
710  SUBROUTINE reactiondiffusion_equationssetspecificationset(equationsSet,specification,err,error,*)
712  !Argument variables
713  TYPE(equations_set_type), POINTER :: equationsSet
714  INTEGER(INTG), INTENT(IN) :: specification(:)
715  INTEGER(INTG), INTENT(OUT) :: err
716  TYPE(varying_string), INTENT(OUT) :: error
717  !Local Variables
718  TYPE(varying_string) :: localError
719  INTEGER(INTG) :: subtype
720 
721  enters("ReactionDiffusion_EquationsSetSpecificationSet",err,error,*999)
722 
723  IF(ASSOCIATED(equationsset)) THEN
724  IF(SIZE(specification,1)>3) THEN
725  CALL flagerror("Equations set specification must have 3 entries for a reaction-diffusion type equations set.", &
726  & err,error,*999)
727  END IF
728  subtype=specification(3)
729  SELECT CASE(subtype)
731  !ok
733  CALL flagerror("Not implemented.",err,error,*999)
735  !ok
736  CASE DEFAULT
737  localerror="The specified equations set subtype of "//trim(numbertovstring(subtype,"*",err,error))// &
738  & " is not valid for reaction diffusion equation type of a classical equations set class."
739  CALL flagerror(localerror,err,error,*999)
740  END SELECT
741  !Set full specification
742  IF(ALLOCATED(equationsset%specification)) THEN
743  CALL flagerror("Equations set specification is already allocated.",err,error,*999)
744  ELSE
745  ALLOCATE(equationsset%specification(3),stat=err)
746  IF(err/=0) CALL flagerror("Could not allocate equations set specification.",err,error,*999)
747  END IF
749  ELSE
750  CALL flagerror("Equations set is not associated.",err,error,*999)
751  END IF
752 
753  exits("ReactionDiffusion_EquationsSetSpecificationSet")
754  RETURN
755 999 errors("ReactionDiffusion_EquationsSetSpecificationSet",err,error)
756  exits("ReactionDiffusion_EquationsSetSpecificationSet")
757  RETURN 1
758 
759  END SUBROUTINE reactiondiffusion_equationssetspecificationset
760 
761  !
762  !================================================================================================================================
763  !
765  SUBROUTINE reactiondiffusion_finiteelementcalculate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
767  !Argument variables
768  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
769  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
770  INTEGER(INTG), INTENT(OUT) :: ERR
771  TYPE(varying_string), INTENT(OUT) :: ERROR
772  !Local Variables
773  INTEGER(INTG) FIELD_VAR_TYPE,mh,mhs,ms,ng,nh,nhs,ni,nj,ns,component_idx
774  LOGICAL :: USE_FIBRES
775  REAL(DP) :: DIFFUSIVITY(3,3),DPHIDX(3,64),RWG,SUM,STORAGE_COEFFICIENT,C_PARAM
776  TYPE(basis_type), POINTER :: DEPENDENT_BASIS,GEOMETRIC_BASIS,FIBRE_BASIS
777  TYPE(equations_type), POINTER :: EQUATIONS
778  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
779  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
780  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
781  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
782  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
783  TYPE(equations_matrices_source_type), POINTER :: SOURCE_VECTOR
784  TYPE(equations_matrix_type), POINTER :: DAMPING_MATRIX,STIFFNESS_MATRIX
785  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD,FIBRE_FIELD,MATERIALS_FIELD,SOURCE_FIELD
786  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE,GEOMETRIC_VARIABLE
787  TYPE(quadrature_scheme_type), POINTER :: QUADRATURE_SCHEME
788 
789  enters("ReactionDiffusion_FiniteElementCalculate",err,error,*999)
790 
791  IF(ASSOCIATED(equations_set)) THEN
792  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
793  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
794  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
795  CALL flagerror("Equations set specification must have three entries for a reaction-diffusion type equations set.", &
796  & err,error,*999)
797  END IF
798  equations=>equations_set%EQUATIONS
799  IF(ASSOCIATED(equations)) THEN
800 
801  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
802  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
803  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
804  IF(equations_set%SPECIFICATION(3)==equations_set_cellml_reac_no_split_reac_diff_subtype .OR. &
805  & equations_set%SPECIFICATION(3)==equations_set_constant_reac_diff_subtype) THEN
806  source_field=>equations%INTERPOLATION%SOURCE_FIELD
807  ENDIF
808  fibre_field=>equations%INTERPOLATION%FIBRE_FIELD
809  use_fibres=ASSOCIATED(fibre_field)
810  equations_mapping=>equations%EQUATIONS_MAPPING
811  equations_matrices=>equations%EQUATIONS_MATRICES
812  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
813  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
814  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
815  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
816  geometric_variable=>geometric_field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
817  IF(use_fibres) fibre_basis=>fibre_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
818  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
819  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
820  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
821  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
822  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
823  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
824  IF(use_fibres) CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations% &
825  & interpolation%FIBRE_INTERP_PARAMETERS(field_u_variable_type)%PTR,err,error,*999)
826  IF(equations_set%SPECIFICATION(3)==equations_set_cellml_reac_no_split_reac_diff_subtype .OR. &
827  & equations_set%SPECIFICATION(3)==equations_set_constant_reac_diff_subtype) THEN
828  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
829  & source_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
830  ENDIF
831  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
832  stiffness_matrix=>dynamic_matrices%MATRICES(1)%PTR
833  damping_matrix=>dynamic_matrices%MATRICES(2)%PTR
834  rhs_vector=>equations_matrices%RHS_VECTOR
835  IF(equations_set%SPECIFICATION(3)==equations_set_cellml_reac_no_split_reac_diff_subtype .OR. &
836  & equations_set%SPECIFICATION(3)==equations_set_constant_reac_diff_subtype) THEN
837  source_vector=>equations_matrices%SOURCE_VECTOR
838  ENDIF
839  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
840  field_variable=>dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(1)%VARIABLE
841  field_var_type=field_variable%VARIABLE_TYPE
842  IF(stiffness_matrix%UPDATE_MATRIX.OR.damping_matrix%UPDATE_MATRIX.OR.rhs_vector%UPDATE_VECTOR) THEN
843  !Loop over gauss points
844  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
845  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
846  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
847  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
848  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
849  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
850  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
851  IF(use_fibres) THEN
852  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
853  & fibre_interp_point(field_u_variable_type)%PTR,err,error,*999)
854  CALL field_interpolated_point_metrics_calculate(fibre_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
855  & fibre_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
856  ENDIF
857  IF(equations_set%SPECIFICATION(3)==equations_set_cellml_reac_no_split_reac_diff_subtype .OR. &
858  & equations_set%SPECIFICATION(3)==equations_set_constant_reac_diff_subtype) THEN
859  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
860  & source_interp_point(field_u_variable_type)%PTR,err,error,*999)
861  ENDIF
862  !Calculate RWG.
863  rwg=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
864  & quadrature_scheme%GAUSS_WEIGHTS(ng)
865  !Calculate the diffusivity tensor
866  diffusivity=0.0_dp
867  IF(use_fibres) THEN
868  !Calculate the diffusivity tensor in fibre coordinates
869  CALL flagerror("Not implemented.",err,error,*999)
870  ELSE
871  !Use the diffusivity tensor in geometric coordinates
872  DO nj=1,geometric_variable%NUMBER_OF_COMPONENTS !first three components of material field are the diffusivities
873  diffusivity(nj,nj)=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(nj,1)
874  ENDDO !nj
875  ENDIF
876  !Get the storage Coefficient, stored in the component after the diffusivities for each dimension
877  component_idx=geometric_variable%NUMBER_OF_COMPONENTS+1
878  storage_coefficient=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(component_idx,1)
879  !Compute basis dPhi/dx terms
880  DO nj=1,geometric_variable%NUMBER_OF_COMPONENTS
881  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
882  dphidx(nj,ms)=0.0_dp
883  DO ni=1,dependent_basis%NUMBER_OF_XI
884  dphidx(nj,ms)=dphidx(nj,ms)+ &
885  & quadrature_scheme%GAUSS_BASIS_FNS(ms,partial_derivative_first_derivative_map(ni),ng)* &
886  & equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%DXI_DX(ni,nj)
887  ENDDO !ni
888  ENDDO !ms
889  ENDDO !nj
890  !Loop over field components
891  mhs=0
892  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
893  !Loop over element rows
894  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
895  mhs=mhs+1
896  nhs=0
897  !Loop over element columns
898  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
899  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
900  nhs=nhs+1
901  sum=0.0_dp
902  IF(stiffness_matrix%UPDATE_MATRIX) THEN
903  DO ni=1,geometric_variable%NUMBER_OF_COMPONENTS
904  DO nj=1,geometric_variable%NUMBER_OF_COMPONENTS
905  sum=sum+diffusivity(ni,nj)*dphidx(ni,mhs)*dphidx(nj,nhs)
906  ENDDO !nj
907  ENDDO !ni
908  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+(sum*rwg)
909  ENDIF
910  IF(damping_matrix%UPDATE_MATRIX) THEN
911  damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+ &
912  & quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)* &
913  & quadrature_scheme%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)*storage_coefficient*rwg
914  ENDIF
915  ENDDO !ns
916  ENDDO !nh
917 
918  IF(rhs_vector%UPDATE_VECTOR) rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=0.0_dp
919  ENDDO !ms
920  ENDDO !mh
921  IF(equations_set%SPECIFICATION(3)==equations_set_constant_reac_diff_subtype) THEN
922  IF(source_vector%UPDATE_VECTOR) THEN
923  c_param=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,no_part_deriv)
924  mhs=0
925  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
926  !Loop over element rows
927  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
928  mhs=mhs+1
929  source_vector%ELEMENT_VECTOR%VECTOR(mhs)=source_vector%ELEMENT_VECTOR%VECTOR(mhs)+ &
930  & quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)*c_param*rwg
931  ENDDO
932  ENDDO
933  ENDIF
934  ENDIF
935  IF(rhs_vector%UPDATE_VECTOR) rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=0.0_dp
936  ENDDO !ng
937  ENDIF
938  !Scale factor adjustment
939  IF(dependent_field%SCALINGS%SCALING_TYPE/=field_no_scaling) THEN
940  CALL field_interpolationparametersscalefactorselementget(element_number,equations%INTERPOLATION% &
941  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
942  mhs=0
943  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
944  !Loop over element rows
945  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
946  mhs=mhs+1
947  nhs=0
948  IF(stiffness_matrix%UPDATE_MATRIX.OR.damping_matrix%UPDATE_MATRIX) THEN
949  !Loop over element columns
950  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
951  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
952  nhs=nhs+1
953  IF(stiffness_matrix%UPDATE_MATRIX) THEN
954  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)* &
955  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)* &
956  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
957  ENDIF
958  IF(damping_matrix%UPDATE_MATRIX) THEN
959  damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)* &
960  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)* &
961  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
962  ENDIF
963  ENDDO !ns
964  ENDDO !nh
965  ENDIF
966  IF(rhs_vector%UPDATE_VECTOR) rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)* &
967  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)
968  IF(equations_set%SPECIFICATION(3)==equations_set_constant_reac_diff_subtype) THEN
969  IF(source_vector%UPDATE_VECTOR) source_vector%ELEMENT_VECTOR%VECTOR(mhs)= &
970  & source_vector%ELEMENT_VECTOR%VECTOR(mhs)* &
971  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)
972  ENDIF
973  ENDDO !ms
974  ENDDO !mh
975  ENDIF
976  ELSE
977  CALL flagerror("Equations set equations is not associated.",err,error,*999)
978  ENDIF
979  ELSE
980  CALL flagerror("Equations set is not associated.",err,error,*999)
981  ENDIF
982 
983  exits("ReactionDiffusion_FiniteElementCalculate")
984  RETURN
985 999 errors("ReactionDiffusion_FiniteElementCalculate",err,error)
986  exits("ReactionDiffusion_FiniteElementCalculate")
987  RETURN 1
988 
989  END SUBROUTINE reactiondiffusion_finiteelementcalculate
990 
991  !
992  !================================================================================================================================
993  !
995  SUBROUTINE reactiondiffusion_problemspecificationset(problem,problemSpecification,err,error,*)
997  !Argument variables
998  TYPE(problem_type), POINTER, INTENT(IN) :: problem
999  INTEGER(INTG), INTENT(IN) :: problemSpecification(:)
1000  INTEGER(INTG), INTENT(OUT) :: err
1001  TYPE(varying_string), INTENT(OUT) :: error
1002  !Local Variables
1003  TYPE(varying_string) :: localError
1004  INTEGER(INTG) :: problemSubtype
1005 
1006  enters("ReactionDiffusion_ProblemSpecificationSet",err,error,*999)
1007 
1008  IF(ASSOCIATED(problem)) THEN
1009  IF(SIZE(problemspecification,1)>=3) THEN
1010  problemsubtype=problemspecification(3)
1011  SELECT CASE(problemsubtype)
1015  !ok
1016  CASE DEFAULT
1017  localerror="The specified problem subtype of "//trim(numbertovstring(problemsubtype,"*",err,error))// &
1018  & " is not valid for a reaction-diffusion problem type of a classical problem class."
1019  CALL flagerror(localerror,err,error,*999)
1020  END SELECT
1021  IF(ALLOCATED(problem%specification)) THEN
1022  CALL flagerror("Problem specification is already allocated.",err,error,*999)
1023  ELSE
1024  ALLOCATE(problem%specification(3),stat=err)
1025  IF(err/=0) CALL flagerror("Could not allocate problem specification.",err,error,*999)
1026  END IF
1027  problem%specification(1:3)=[problem_classical_field_class,problem_reaction_diffusion_equation_type,problemsubtype]
1028  ELSE
1029  CALL flagerror("Reaction-diffusion problem specification must have >=3 entries.",err,error,*999)
1030  END IF
1031  ELSE
1032  CALL flagerror("Problem is not associated.",err,error,*999)
1033  END IF
1034 
1035  exits("ReactionDiffusion_ProblemSpecificationSet")
1036  RETURN
1037 999 errors("ReactionDiffusion_ProblemSpecificationSet",err,error)
1038  exits("ReactionDiffusion_ProblemSpecificationSet")
1039  RETURN 1
1040 
1041  END SUBROUTINE reactiondiffusion_problemspecificationset
1042 
1043  !
1044  !================================================================================================================================
1045  !
1047  SUBROUTINE reaction_diffusion_equation_problem_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
1049  !Argument variables
1050  TYPE(problem_type), POINTER :: PROBLEM
1051  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
1052  INTEGER(INTG), INTENT(OUT) :: ERR
1053  TYPE(varying_string), INTENT(OUT) :: ERROR
1054  !Local Variables
1055  TYPE(cellml_equations_type), POINTER :: CELLML_EQUATIONS
1056  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT
1057  TYPE(solver_type), POINTER :: SOLVER
1058  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
1059  TYPE(solvers_type), POINTER :: SOLVERS
1060  TYPE(varying_string) :: LOCAL_ERROR
1061 
1062  NULLIFY(cellml_equations)
1063  NULLIFY(control_loop)
1064  NULLIFY(solver)
1065  NULLIFY(solvers)
1066  NULLIFY(solver_equations)
1067 
1068  enters("REACTION_DIFFUSION_EQUATION_PROBLEM_SETUP",err,error,*999)
1069 
1070  IF(ASSOCIATED(problem)) THEN
1071  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
1072  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1073  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
1074  CALL flagerror("Problem specification must have three entries for a reaction diffusion problem.",err,error,*999)
1075  END IF
1076  SELECT CASE(problem_setup%SETUP_TYPE)
1078  SELECT CASE(problem_setup%ACTION_TYPE)
1080  !Do nothing????
1082  !Do nothing????
1083  CASE DEFAULT
1084  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1085  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1086  & " is invalid for a reaction diffusion equation."
1087  CALL flagerror(local_error,err,error,*999)
1088  END SELECT
1090  SELECT CASE(problem_setup%ACTION_TYPE)
1092  !Set up a time control loop
1093  CALL control_loop_create_start(problem,control_loop,err,error,*999)
1094  CALL control_loop_type_set(control_loop,problem_control_time_loop_type,err,error,*999)
1095  CALL control_loop_label_set(control_loop,"Time Loop",err,error,*999)
1097  !Finish the control loops
1098  control_loop_root=>problem%CONTROL_LOOP
1099  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1100  CALL control_loop_create_finish(control_loop,err,error,*999)
1101  CASE DEFAULT
1102  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1103  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1104  & " is invalid for a reaction-diffusion equation."
1105  CALL flagerror(local_error,err,error,*999)
1106  END SELECT
1108  !Get the control loop
1109  control_loop_root=>problem%CONTROL_LOOP
1110  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1111  SELECT CASE(problem_setup%ACTION_TYPE)
1113  !Start the solvers creation
1114  CALL solvers_create_start(control_loop,solvers,err,error,*999)
1115  SELECT CASE(problem%SPECIFICATION(3))
1117  CALL solvers_number_set(solvers,3,err,error,*999)
1118  !Set the first solver to be a differential-algebraic equations solver
1119  NULLIFY(solver)
1120  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1121  CALL solver_type_set(solver,solver_dae_type,err,error,*999)
1122  CALL solver_label_set(solver,"First ODE solver",err,error,*999)
1123  !Set solver defaults
1124  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
1125  !Set the second solver to be a dynamic solver
1126  NULLIFY(solver)
1127  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
1128  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
1129  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
1130  CALL solver_label_set(solver,"Parabolic solver",err,error,*999)
1131  !Set solver defaults
1132  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
1134  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
1135  !Set the third solver to be a differential-algebraic equations solver
1136  NULLIFY(solver)
1137  CALL solvers_solver_get(solvers,3,solver,err,error,*999)
1138  CALL solver_type_set(solver,solver_dae_type,err,error,*999)
1139  CALL solver_label_set(solver,"Second ODE solver",err,error,*999)
1140  !Set solver defaults
1141  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
1143  CALL solvers_number_set(solvers,2,err,error,*999)
1144  !Set the first solver to be a CELLML evaluator equations solver
1145  NULLIFY(solver)
1146  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1147  CALL solver_type_set(solver,solver_cellml_evaluator_type,err,error,*999)
1148  CALL solver_label_set(solver,"Evaluator solver",err,error,*999)
1149  !Set solver defaults
1150  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
1151  !Set the second solver to be a dynamic solver
1152  NULLIFY(solver)
1153  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
1154  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
1155  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
1156  CALL solver_label_set(solver,"Parabolic solver",err,error,*999)
1157  !Set solver defaults
1158  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
1160  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
1162  CALL solvers_number_set(solvers,1,err,error,*999)
1163  !Set the solver to be a dynamic solver
1164  NULLIFY(solver)
1165  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1166  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
1167  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
1168  CALL solver_label_set(solver,"Parabolic solver",err,error,*999)
1169  !Set solver defaults
1170  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
1172  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
1173  CASE DEFAULT
1174  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
1175  & " is invalid for a reaction-diffusion problem type of a classical problem class."
1176  CALL flagerror(local_error,err,error,*999)
1177  END SELECT
1179  !Get the solvers
1180  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
1181  !Finish the solvers creation
1182  CALL solvers_create_finish(solvers,err,error,*999)
1183  CASE DEFAULT
1184  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1185  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1186  & " is invalid for a classical equation."
1187  CALL flagerror(local_error,err,error,*999)
1188  END SELECT
1190  SELECT CASE(problem_setup%ACTION_TYPE)
1192  !Get the control loop
1193  control_loop_root=>problem%CONTROL_LOOP
1194  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1195  SELECT CASE(problem%SPECIFICATION(3))
1197  !Get the solver
1198  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
1199  !Create the solver equations for the second (parabolic) solver
1200  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
1201  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
1202  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
1204  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
1206  !Get the solver
1207  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
1208  !Create the solver equations for the parabolic solver
1209  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
1210  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
1211  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
1213  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
1215  !Get the solver
1216  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
1217  !Create the solver equations for the parabolic solver
1218  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1219  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
1220  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
1222  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
1223  CASE DEFAULT
1224  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1225  & " for a setup subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
1226  & " is invalid for a reaction-diffusion equation."
1227  CALL flagerror(local_error,err,error,*999)
1228  END SELECT
1229 
1231  !Get the control loop
1232  control_loop_root=>problem%CONTROL_LOOP
1233  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1234  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
1235  SELECT CASE(problem%SPECIFICATION(3))
1237  !Get the solver equations for the second (parabolic) solver
1238  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
1239  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
1240  !Finish the solver equations creation
1241  CALL solver_equations_create_finish(solver_equations,err,error,*999)
1243  !Get the solver equations for the parabolic solver
1244  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
1245  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
1246  !Finish the solver equations creation
1247  CALL solver_equations_create_finish(solver_equations,err,error,*999)
1249  !Get the solver equations for thE solver
1250  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1251  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
1252  !Finish the solver equations creation
1253  CALL solver_equations_create_finish(solver_equations,err,error,*999)
1254  CASE DEFAULT
1255  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1256  & " for a setup subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
1257  & " is invalid for a reaction-diffusion equation."
1258  CALL flagerror(local_error,err,error,*999)
1259  END SELECT
1260  CASE DEFAULT
1261  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1262  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1263  & " is invalid for a reaction-diffusion equation."
1264  CALL flagerror(local_error,err,error,*999)
1265  END SELECT
1267  SELECT CASE(problem_setup%ACTION_TYPE)
1269  !Get the control loop
1270  control_loop_root=>problem%CONTROL_LOOP
1271  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1272  !Get the solver
1273  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
1274 
1275  IF(problem%SPECIFICATION(3)==problem_cellml_reac_integ_reac_diff_strang_split_subtype) THEN
1276  NULLIFY(solver)
1277  NULLIFY(cellml_equations)
1278  !Create the CellML equations for the first DAE solver
1279  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1280  CALL cellml_equations_create_start(solver,cellml_equations,err,error,*999)
1281  !Create the CellML equations for the second DAE solver
1282  NULLIFY(solver)
1283  NULLIFY(cellml_equations)
1284  CALL solvers_solver_get(solvers,3,solver,err,error,*999)
1285  CALL cellml_equations_create_start(solver,cellml_equations,err,error,*999)
1286  ELSEIF(problem%SPECIFICATION(3)== &
1288  !CREATE the CellML equations for the first evaluator solver
1289  NULLIFY(solver)
1290  NULLIFY(cellml_equations)
1291  !Create the CellML equations for the first cellml evaluator solver
1292  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1293  CALL cellml_equations_create_start(solver,cellml_equations,err,error,*999)
1294  ENDIF
1296  !Get the control loop
1297  control_loop_root=>problem%CONTROL_LOOP
1298  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1299  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
1300  SELECT CASE(problem%SPECIFICATION(3))
1302  !Get the CellML equations for the first DAE solver
1303  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1304  CALL solver_cellml_equations_get(solver,cellml_equations,err,error,*999)
1305  !Finish the CellML equations creation
1306  CALL cellml_equations_create_finish(cellml_equations,err,error,*999)
1307  !Get the CellML equations for the second DAE solver
1308  NULLIFY(solver)
1309  NULLIFY(cellml_equations)
1310  CALL solvers_solver_get(solvers,3,solver,err,error,*999)
1311  CALL solver_cellml_equations_get(solver,cellml_equations,err,error,*999)
1312  !Finish the CellML equations creation
1313  CALL cellml_equations_create_finish(cellml_equations,err,error,*999)
1315  !Get the CellML equations for the first evaluator solver
1316  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1317  CALL solver_cellml_equations_get(solver,cellml_equations,err,error,*999)
1318  !Finish the CellML equations creation
1319  CALL cellml_equations_create_finish(cellml_equations,err,error,*999)
1320  CASE DEFAULT
1321  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1322  & " for a setup type of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
1323  & " is invalid for reaction-diffusion equation."
1324  CALL flagerror(local_error,err,error,*999)
1325  END SELECT
1326  CASE DEFAULT
1327  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1328  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1329  & " is invalid for reaction-diffusion equation."
1330  CALL flagerror(local_error,err,error,*999)
1331  END SELECT
1332  CASE DEFAULT
1333  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1334  & " is invalid for areaction-diffusion equation."
1335  CALL flagerror(local_error,err,error,*999)
1336  END SELECT
1337  ELSE
1338  CALL flagerror("Problem is not associated.",err,error,*999)
1339  ENDIF
1340 
1341  exits("REACTION_DIFFUSION_EQUATION_PROBLEM_SETUP")
1342  RETURN
1343 999 errorsexits("REACTION_DIFFUSION_EQUATION_PROBLEM_SETUP",err,error)
1344  RETURN 1
1345  END SUBROUTINE reaction_diffusion_equation_problem_setup
1346 
1347  !
1348  !================================================================================================================================
1349  !
1351  SUBROUTINE reaction_diffusion_pre_solve(SOLVER,ERR,ERROR,*)
1353  !Argument variables
1354  TYPE(solver_type), POINTER :: SOLVER
1355  INTEGER(INTG), INTENT(OUT) :: ERR
1356  TYPE(varying_string), INTENT(OUT) :: ERROR
1357  !Local Variables
1358  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT
1359  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1360  TYPE(problem_type), POINTER :: PROBLEM
1361  TYPE(solvers_type), POINTER :: SOLVERS
1362  TYPE(varying_string) :: LOCAL_ERROR
1363 
1364  enters("REACTION_DIFFUSION_PRE_SOLVE",err,error,*999)
1365 
1366  IF(ASSOCIATED(solver)) THEN
1367  solvers=>solver%SOLVERS
1368  IF(ASSOCIATED(solvers)) THEN
1369  control_loop=>solvers%CONTROL_LOOP
1370  IF(ASSOCIATED(control_loop)) THEN
1371  CALL control_loop_current_times_get(control_loop,current_time,time_increment,err,error,*999)
1372  problem=>control_loop%PROBLEM
1373  IF(ASSOCIATED(problem)) THEN
1374  SELECT CASE(problem%SPECIFICATION(3))
1376  SELECT CASE(solver%GLOBAL_NUMBER)
1377  CASE(1)
1378  CALL solver_dae_times_set(solver,current_time,current_time+time_increment/2.0_dp,err,error,*999)
1379  CASE(2)
1380  !Do nothing
1381  CASE(3)
1382  CALL solver_dae_times_set(solver,current_time,current_time+time_increment/2.0_dp, &
1383  & err,error,*999)
1384  CASE DEFAULT
1385  local_error="The solver global number of "//trim(number_to_vstring(solver%GLOBAL_NUMBER,"*",err,error))// &
1386  & " is invalid for a Strang split reaction-diffusion problem."
1387  CALL flagerror(local_error,err,error,*999)
1388  END SELECT
1390  !No splitting, therefore entire problem is solved as a dynamic one, with 1 solver nothing to do.
1392  !No splitting, therefore entire problem is solved as a dynamic one, with 1 solver nothing to do.
1393  CASE DEFAULT
1394  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
1395  & " is invalid for a reaction-diffusion problem type."
1396  CALL flagerror(local_error,err,error,*999)
1397  END SELECT
1398  ELSE
1399  CALL flagerror("Control loop problem is not associated.",err,error,*999)
1400  ENDIF
1401  ELSE
1402  CALL flagerror("Solvers control loop is not associated.",err,error,*999)
1403  ENDIF
1404  ELSE
1405  CALL flagerror("Solver solvers is not associated.",err,error,*999)
1406  ENDIF
1407  ELSE
1408  CALL flagerror("Solver is not associated.",err,error,*999)
1409  ENDIF
1410 
1411  exits("REACTION_DIFFUSION_PRE_SOLVE")
1412  RETURN
1413 999 errorsexits("REACTION_DIFFUSION_PRE_SOLVE",err,error)
1414  RETURN 1
1415 
1416  END SUBROUTINE reaction_diffusion_pre_solve
1417 
1418  !
1419  !================================================================================================================================
1420  !
1421 
1423  SUBROUTINE reaction_diffusion_post_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
1425  !Argument variables
1426  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1427  TYPE(solver_type), POINTER :: SOLVER
1428  INTEGER(INTG), INTENT(OUT) :: ERR
1429  TYPE(varying_string), INTENT(OUT) :: ERROR
1430  !Local Variables
1431  TYPE(solvers_type), POINTER :: SOLVERS
1432  TYPE(solver_type), POINTER :: PDE_SOLVER
1433  TYPE(varying_string) :: LOCAL_ERROR
1434 
1435  enters("REACTION_DIFFUSION_POST_SOLVE",err,error,*999)
1436 
1437  IF(ASSOCIATED(control_loop)) THEN
1438  IF(ASSOCIATED(solver)) THEN
1439  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
1440  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
1441  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1442  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
1443  CALL flagerror("Problem specification must have three entries for a reaction diffusion problem.",err,error,*999)
1444  END IF
1445  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
1447  SELECT CASE(solver%GLOBAL_NUMBER)
1448  CASE(1)
1449 
1450  !do nothing
1451  CASE(2)
1452 
1453  !do nothing
1454  CASE(3)
1455  !OUTPUT SOLUTIONS AT EACH TIME STEP - should probably change this bit below to output
1456  !mesh solutions directly from the 3rd solver itself rather than by getting the 2nd solver.
1457  !I just don't know how to work with cellml_equations to do this.
1458  solvers=>solver%SOLVERS
1459  NULLIFY(pde_solver)
1460  CALL solvers_solver_get(solvers,2,pde_solver,err,error,*999)
1461  CALL reaction_diffusion_post_solve_output_data(control_loop,pde_solver,err,error,*999)
1462  CASE DEFAULT
1463  local_error="The solver global number of "//trim(number_to_vstring(solver%GLOBAL_NUMBER,"*",err,error))// &
1464  & " is invalid for a Strang split reaction-diffusion problem."
1465  CALL flagerror(local_error,err,error,*999)
1466  END SELECT
1468  !do nothing - time output not implemented
1470  !OUTPUT SOLUTIONS AT TIME STEP
1471  CALL reaction_diffusion_post_solve_output_data(control_loop,solver,err,error,*999)
1472  CASE DEFAULT
1473  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
1474  & " is not valid for a reaction diffusion type of a classical field problem class."
1475  CALL flagerror(local_error,err,error,*999)
1476  END SELECT
1477  ELSE
1478  CALL flagerror("Problem is not associated.",err,error,*999)
1479  ENDIF
1480  ELSE
1481  CALL flagerror("Solver is not associated.",err,error,*999)
1482  ENDIF
1483  ELSE
1484  CALL flagerror("Control loop is not associated.",err,error,*999)
1485  ENDIF
1486 
1487  exits("REACTION_DIFFUSION_POST_SOLVE")
1488  RETURN
1489 999 errorsexits("REACTION_DIFFUSION_POST_SOLVE",err,error)
1490  RETURN 1
1491  END SUBROUTINE reaction_diffusion_post_solve
1492  !
1493  !================================================================================================================================
1494  !
1495 
1496  SUBROUTINE reaction_diffusion_post_solve_output_data(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
1498  !Argument variables
1499  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1500  TYPE(solver_type), POINTER :: SOLVER
1501  INTEGER(INTG), INTENT(OUT) :: ERR
1502  TYPE(varying_string), INTENT(OUT) :: ERROR
1503  !Local variables
1504  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
1505  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
1506  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1507  TYPE(varying_string) :: LOCAL_ERROR
1508 
1509  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT
1510  INTEGER(INTG) :: EQUATIONS_SET_IDX,CURRENT_LOOP_ITERATION,OUTPUT_FREQUENCY,MAX_DIGITS
1511  INTEGER(INTG) :: myComputationalNodeNumber
1512 
1513  CHARACTER(30) :: FILE
1514  CHARACTER(30) :: OUTPUT_FILE
1515 
1516  CHARACTER(100) :: FMT, TEMP_FMT
1517 
1518  enters("REACTION_DIFFUSION_POST_SOLVE_OUTPUT_DATA",err,error,*999)
1519 
1520  IF(ASSOCIATED(control_loop)) THEN
1521  IF(ASSOCIATED(solver)) THEN
1522  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
1523  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
1524  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1525  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
1526  CALL flagerror("Problem specification must have three entries for a reaction diffusion problem.",err,error,*999)
1527  END IF
1528  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
1531  CALL control_loop_current_times_get(control_loop,current_time,time_increment,err,error,*999)
1532  solver_equations=>solver%SOLVER_EQUATIONS
1533  IF(ASSOCIATED(solver_equations)) THEN
1534  solver_mapping=>solver_equations%SOLVER_MAPPING
1535  IF(ASSOCIATED(solver_mapping)) THEN
1536  !Make sure the equations sets are up to date
1537  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
1538  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
1539  current_loop_iteration=control_loop%TIME_LOOP%ITERATION_NUMBER
1540  output_frequency=control_loop%TIME_LOOP%OUTPUT_NUMBER
1541  mycomputationalnodenumber = computational_node_number_get(err,error)
1542  max_digits=floor(log10((control_loop%TIME_LOOP%STOP_TIME-control_loop%TIME_LOOP%START_TIME)/ &
1543  & control_loop%TIME_LOOP%TIME_INCREMENT))+1
1544  IF(output_frequency>0) THEN
1545  IF(mod(current_loop_iteration,output_frequency)==0) THEN
1546  IF(control_loop%TIME_LOOP%CURRENT_TIME<=control_loop%TIME_LOOP%STOP_TIME) THEN
1547  IF(solver_mapping%NUMBER_OF_EQUATIONS_SETS.EQ.1) THEN
1548  WRITE(temp_fmt,'("I",I0,".",I0)') max_digits,max_digits
1549  !100 FORMAT
1550  fmt = trim(temp_fmt)
1551  WRITE(temp_fmt,'(A2,A38,A20,A2)') "(", '"TIME_STEP_SPEC_1.part",I2.2,".",',fmt,")"
1552  fmt = trim(temp_fmt)
1553  WRITE(output_file,fmt) &
1554  & mycomputationalnodenumber,current_loop_iteration
1555  ELSE
1556  WRITE(temp_fmt,'("I",I0,".",I0)') max_digits,max_digits
1557  !200 FORMAT
1558  fmt = trim(temp_fmt)
1559  WRITE(temp_fmt,'(A2,A38,A20,A2)') "(", '"TIME_STEP_SPEC_",I0,".part",I2.2,".",',fmt,")"
1560  fmt = trim(temp_fmt)
1561  WRITE(output_file,fmt) &
1562  & equations_set_idx, mycomputationalnodenumber,current_loop_iteration
1563  ENDIF
1564  WRITE(*,*) output_file
1565  file=trim(output_file)
1566  CALL write_string(general_output_type,"...",err,error,*999)
1567  CALL write_string(general_output_type,"Now export fields... ",err,error,*999)
1568  CALL reaction_diffusion_io_write_cmgui(equations_set%REGION,equations_set%GLOBAL_NUMBER,file, &
1569  & err,error,*999)
1570  ENDIF
1571  ENDIF
1572  ENDIF
1573  ENDDO
1574  ENDIF
1575  ENDIF
1577  ! do nothing ???
1578  CALL flagerror("Not implemented.",err,error,*999)
1579  CASE DEFAULT
1580  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
1581  & " is not valid for an advection-diffusion equation type of a classical field problem class."
1582  CALL flagerror(local_error,err,error,*999)
1583  END SELECT
1584  ELSE
1585  CALL flagerror("Problem is not associated.",err,error,*999)
1586  ENDIF
1587  ELSE
1588  CALL flagerror("Solver is not associated.",err,error,*999)
1589  ENDIF
1590  ELSE
1591  CALL flagerror("Control loop is not associated.",err,error,*999)
1592  ENDIF
1593 
1594  exits("REACTION_DIFFUSION_POST_SOLVE_OUTPUT_DATA")
1595  RETURN
1596 999 errorsexits("REACTION_DIFFUSION_POST_SOLVE_OUTPUT_DATA",err,error)
1597  RETURN 1
1598 
1599  END SUBROUTINE reaction_diffusion_post_solve_output_data
1600  !
1601  !================================================================================================================================
1602  !
1603 
1604  SUBROUTINE reaction_diffusion_control_loop_post_loop(CONTROL_LOOP,ERR,ERROR,*)
1606  !Argument variables
1607  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1608  INTEGER(INTG), INTENT(OUT) :: ERR
1609  TYPE(varying_string), INTENT(OUT) :: ERROR
1610  !Local variables
1611  TYPE(problem_type), POINTER :: PROBLEM
1612  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
1613  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
1614  TYPE(equations_type), POINTER :: EQUATIONS
1615  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1616  TYPE(solver_type), POINTER :: SOLVER
1617  TYPE(solvers_type), POINTER :: SOLVERS
1618  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
1619  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
1620  TYPE(equations_matrix_type), POINTER :: DAMPING_MATRIX,STIFFNESS_MATRIX
1621 
1622  enters("REACTION_DIFFUSION_CONTROL_LOOP_POST_LOOP",err,error,*999)
1623 
1624  NULLIFY(solver)
1625  IF(ASSOCIATED(control_loop)) THEN
1626  problem=>control_loop%PROBLEM
1627  IF(ASSOCIATED(problem)) THEN
1628  SELECT CASE(problem%SPECIFICATION(3))
1630  solvers=>control_loop%SOLVERS
1631  IF(ASSOCIATED(solvers)) THEN
1632  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
1633  solver_equations=>solver%SOLVER_EQUATIONS
1634  IF(ASSOCIATED(solver_equations)) THEN
1635  solver_mapping=>solver_equations%SOLVER_MAPPING
1636  IF(ASSOCIATED(solver_mapping)) THEN
1637  equations_set=>solver_mapping%EQUATIONS_SETS(1)%PTR
1638  IF(ASSOCIATED(equations_set)) THEN
1639  equations=>equations_set%EQUATIONS
1640  IF(ASSOCIATED(equations)) THEN
1641  equations_matrices=>equations%EQUATIONS_MATRICES
1642  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
1643  stiffness_matrix=>dynamic_matrices%MATRICES(1)%PTR
1644  damping_matrix=>dynamic_matrices%MATRICES(2)%PTR
1645  stiffness_matrix%UPDATE_MATRIX = .false.
1646  damping_matrix%UPDATE_MATRIX = .false.
1647  ELSE
1648  CALL flagerror("Equations not associated.",err,error,*999)
1649  ENDIF
1650  ELSE
1651  CALL flagerror("Equations Set not associated.",err,error,*999)
1652  ENDIF
1653 
1654  ELSE
1655  CALL flagerror("Solver Mapping not associated.",err,error,*999)
1656  ENDIF
1657  ELSE
1658  CALL flagerror("Solver Equations not associated.", err,error,*999)
1659  ENDIF
1660  ELSE
1661  CALL flagerror("Solvers is not associated.", err,error,*999)
1662  ENDIF
1663 
1664 
1665  CASE DEFAULT
1666  !do nothing
1667  END SELECT
1668  ELSE
1669  CALL flagerror("Problem is not associated.",err,error,*999)
1670  ENDIF
1671  ELSE
1672  CALL flagerror("Control Loop is not associated.",err,error,*999)
1673  ENDIF
1674  exits("REACTION_DIFFUSION_CONTROL_LOOP_POST_LOOP")
1675  RETURN
1676 999 errorsexits("REACTION_DIFFUSION_CONTROL_LOOP_POST_LOOP",err,error)
1677  RETURN 1
1678  END SUBROUTINE reaction_diffusion_control_loop_post_loop
integer(intg), parameter equations_set_setup_dependent_type
Dependent variables.
integer(intg), parameter equations_set_fem_solution_method
Finite Element Method solution method.
This module contains all basis function routines.
integer(intg), parameter equations_set_setup_materials_type
Materials setup.
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
subroutine, public solvers_create_finish(SOLVERS, ERR, ERROR,)
Finish the creation of solvers.
subroutine, public equations_mapping_dynamic_variable_type_set(EQUATIONS_MAPPING, DYNAMIC_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set dynamic matrices...
Contains information on the equations mapping i.e., how field variable DOFS are mapped to the rows an...
Definition: types.f90:1681
Contains information about the CellML equations for a solver.
Definition: types.f90:2475
Contains information about the equations in an equations set.
Definition: types.f90:1735
integer(intg), parameter equations_set_gfem_solution_method
Grid-based Finite Element Method solution method.
integer(intg), parameter problem_control_time_loop_type
Time control loop.
integer(intg), parameter problem_setup_control_type
Solver setup for a problem.
This module handles all problem wide constants.
integer(intg), parameter solver_equations_first_order_dynamic
Solver equations are first order dynamic.
integer(intg), parameter, public control_loop_node
The identifier for a each "leaf" node in a control loop.
subroutine, public solver_dynamic_order_set(SOLVER, ORDER, ERR, ERROR,)
Sets/changes the order for a dynamic solver.
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
subroutine, public equations_create_start(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Start the creation of equations for the equation set.
Contains information on the mesh decomposition.
Definition: types.f90:1063
subroutine, public equations_matrices_create_start(EQUATIONS, EQUATIONS_MATRICES, ERR, ERROR,)
Starts the creation of the equations matrices and rhs for the the equations.
Contains information on the type of solver to be used.
Definition: types.f90:2777
subroutine, public solvers_number_set(SOLVERS, NUMBER_OF_SOLVERS, ERR, ERROR,)
Sets/changes the number of solvers.
integer(intg), parameter no_part_deriv
No partial derivative i.e., u.
Definition: constants.f90:177
integer(intg), parameter, public solver_dynamic_crank_nicolson_scheme
Crank-Nicolson dynamic solver.
subroutine, public solver_dynamic_degree_set(SOLVER, DEGREE, ERR, ERROR,)
Sets/changes the degree of the polynomial used to interpolate time for a dynamic solver.
This module handles all equations matrix and rhs routines.
integer(intg), parameter, public solver_dynamic_first_order
Dynamic solver has first order terms.
subroutine, public solver_type_set(SOLVER, SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type for a solver.
Contains information on an equations set.
Definition: types.f90:1941
This module handles all equations routines.
integer(intg), parameter, public solver_dae_type
A differential-algebraic equation solver.
integer(intg), parameter equations_set_setup_source_type
Source setup.
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
subroutine, public solvers_create_start(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Start the creation of a solvers for the control loop.
Contains information on the solvers to be used in a control loop.
Definition: types.f90:2805
integer(intg), parameter first_part_deriv
First partial derivative i.e., du/ds.
Definition: constants.f90:178
This module contains routines for timing the program.
Definition: timer_f.f90:45
subroutine, public control_loop_current_times_get(CONTROL_LOOP, CURRENT_TIME, TIME_INCREMENT, ERR, ERROR,)
Gets the current time parameters for a time control loop.
Contains information of the source vector for equations matrices.
Definition: types.f90:1510
subroutine, public equations_matrices_dynamic_lumping_type_set(EQUATIONS_MATRICES, LUMPING_TYPE, ERR, ERROR,)
Sets the lumping of the linear equations matrices.
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.
integer(intg), parameter problem_cellml_reac_eval_reac_diff_no_split_subtype
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.
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
This module contains all program wide constants.
Definition: constants.f90:45
integer(intg), parameter solver_equations_nonlinear
Solver equations are nonlinear.
subroutine, public solver_library_type_set(SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library type to use for the solver.
integer(intg), parameter, public equations_lumped_matrices
The equations matrices are "mass" lumped.
integer(intg), parameter problem_setup_initial_type
Initial setup for a problem.
integer(intg), parameter problem_constant_reac_diff_no_split_subtype
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_cellml_reac_no_split_reac_diff_subtype
integer(intg), parameter equations_set_setup_start_action
Start setup action.
integer(intg), parameter problem_classical_field_class
subroutine, public cellml_equations_create_start(SOLVER, CELLML_EQUATIONS, ERR, ERROR,)
Starts the process of creating CellML equations.
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
subroutine, public solver_cellml_equations_get(SOLVER, CELLML_EQUATIONS, ERR, ERROR,)
Returns a pointer to the CellML equations for a solver.
Contains information on the equations matrices and vectors.
Definition: types.f90:1520
integer(intg), parameter, public equations_matrix_fem_structure
Finite element matrix structure.
integer(intg), parameter equations_set_cellml_reac_split_reac_diff_subtype
Temporary IO routines for fluid mechanics.
Write a string to a given output stream.
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
integer(intg), parameter problem_cellml_reac_integ_reac_diff_strang_split_subtype
integer(intg), parameter, public general_output_type
General output type.
subroutine, public equationsmatrices_dynamicstructuretypeset(EQUATIONS_MATRICES, STRUCTURE_TYPE, ERR, ERROR,)
Sets the structure (sparsity) of the dynamic equations matrices.
subroutine, public equations_mapping_create_finish(EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping.
Returns the specified control loop as indexed by the control loop identifier from the control loop ro...
subroutine, public control_loop_type_set(CONTROL_LOOP, LOOP_TYPE, ERR, ERROR,)
Sets/changes the control loop type.
subroutine, public 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.
subroutine, public equations_set_equations_get(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Gets the equations for an equations set.
This module contains all computational environment variables.
integer(intg), parameter, public solver_cellml_evaluator_type
A CellML evaluation solver.
integer(intg), dimension(4) partial_derivative_first_derivative_map
PARTIAL_DERIVATIVE_FIRST_DERIVATIVE_MAP(nic) gives the partial derivative index for the first derivat...
Definition: constants.f90:254
subroutine, public equations_create_finish(EQUATIONS, ERR, ERROR,)
Finish the creation of equations.
This module handles all domain mappings routines.
integer(intg), parameter problem_setup_finish_action
Finish setup action.
This module handles all equations mapping routines.
Contains information about the solver equations for a solver.
Definition: types.f90:2452
subroutine, public equations_matrices_dynamic_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the dynamic equations matrices.
integer(intg), parameter, public equations_matrix_diagonal_structure
Diagonal matrix structure.
integer(intg), parameter equations_set_gfv_solution_method
Grid-based Finite Volume solution method.
integer(intg), parameter equations_set_setup_geometry_type
Geometry setup.
Contains information for a problem.
Definition: types.f90:3221
integer(intg), parameter problem_setup_cellml_equations_type
CellML equations setup for a problem.
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.
integer(intg), parameter, public equations_matrix_unlumped
The matrix is not lumped.
Contains information about an equations matrix.
Definition: types.f90:1429
Contains information for a particular quadrature scheme.
Definition: types.f90:141
This module contains all routines dealing with (non-distributed) matrix and vectors types...
integer(intg), parameter, public distributed_matrix_block_storage_type
Distributed matrix block storage type.
integer(intg), parameter, public equations_matrix_lumped
The matrix is "mass" lumped.
This module handles all reaction diffusion equation routines.
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.
integer(intg), parameter equations_set_reaction_diffusion_equation_type
Contains information on the solver mapping between the global equation sets and the solver matrices...
Definition: types.f90:3091
subroutine, public solver_dynamic_scheme_set(SOLVER, SCHEME, ERR, ERROR,)
Sets/changes the scheme for a dynamic solver.
Contains information for a field variable defined on a field.
Definition: types.f90:1289
subroutine, public cellml_equations_create_finish(CELLML_EQUATIONS, ERR, ERROR,)
Finishes the process of creating CellML equations.
integer(intg), parameter equations_set_fd_solution_method
Finite Difference solution method.
integer(intg), parameter, public equations_matrices_sparse_matrices
Use sparse equations matrices.
Contains information on the setup information for an equations set.
Definition: types.f90:1866
integer(intg), parameter problem_setup_start_action
Start setup action.
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.
integer(intg), parameter equations_set_bem_solution_method
Boundary Element Method solution method.
subroutine, public solver_solver_equations_get(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Returns a pointer to the solver equations for a solver.
integer(intg), parameter equations_set_constant_reac_diff_subtype
Contains all information about a basis .
Definition: types.f90:184
integer(intg), parameter equations_set_fv_solution_method
Finite Volume solution method.
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.
integer(intg), parameter equations_set_setup_analytic_type
Analytic setup.
subroutine, public solver_dae_times_set(SOLVER, START_TIME, END_TIME, ERR, ERROR,)
Set/change the times for a differential-algebraic equation solver.
Flags an error condition.
Contains information of the RHS vector for equations matrices.
Definition: types.f90:1500
integer(intg) function, public computational_node_number_get(ERR, ERROR)
Returns the number/rank of the computational nodes.
integer(intg), parameter equations_nonlinear
The equations are non-linear.
integer(intg), parameter, public distributed_matrix_diagonal_storage_type
Distributed matrix diagonal storage type.
integer(intg), parameter problem_reaction_diffusion_equation_type
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.