OpenCMISS-Iron Internal API Documentation
biodomain_equation_routines.f90
Go to the documentation of this file.
1 
44 
46 MODULE biodomain_equation_routines
47 
48  USE base_routines
49  USE basis_routines
50  USE boundary_conditions_routines
51  USE constants
52  USE control_loop_routines
53  USE distributed_matrix_vector
54  USE domain_mappings
55  USE equations_routines
56  USE equations_mapping_routines
57  USE equations_matrices_routines
58  USE equations_set_constants
59  USE field_routines
60  USE field_io_routines
61  USE input_output
62  USE iso_varying_string
63  USE kinds
64  USE matrix_vector
65  USE problem_constants
66  USE strings
67  USE solver_routines
68  USE timer
69  USE types
70 
71 #include "macros.h"
72 
73  IMPLICIT NONE
74 
75  PRIVATE
76 
77  !Module parameters
78 
79  !Module types
80 
81  !Module variables
82 
83  !Interfaces
84 
85  PUBLIC biodomain_control_loop_post_loop
86 
87  PUBLIC biodomain_equationssetsetup
88 
89  PUBLIC biodomain_equationssetsolutionmethodset
90 
91  PUBLIC biodomain_equationssetspecificationset
92 
93  PUBLIC biodomain_equation_finite_element_calculate
94 
95  PUBLIC biodomain_pre_solve
96 
97  PUBLIC biodomain_equation_problem_setup
98 
99  PUBLIC biodomain_problemspecificationset
100 
101 CONTAINS
102 
103  !
104  !================================================================================================================================
105  !
106 
108  SUBROUTINE biodomain_control_loop_post_loop(CONTROL_LOOP,ERR,ERROR,*)
109 
110  !Argument variables
111  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
112  INTEGER(INTG), INTENT(OUT) :: ERR
113  TYPE(varying_string), INTENT(OUT) :: ERROR
114  !Local Variables
115  INTEGER(INTG) :: equations_set_idx
116  TYPE(control_loop_time_type), POINTER :: TIME_LOOP,TIME_LOOP_PARENT
117  TYPE(control_loop_type), POINTER :: PARENT_LOOP
118  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
119  TYPE(field_type), POINTER :: DEPENDENT_FIELD
120  TYPE(problem_type), POINTER :: PROBLEM
121  TYPE(region_type), POINTER :: DEPENDENT_REGION
122  TYPE(solver_type), POINTER :: SOLVER
123  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
124  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
125  TYPE(solvers_type), POINTER :: SOLVERS
126  TYPE(varying_string) :: FILENAME,LOCAL_ERROR,METHOD
127  INTEGER(INTG) :: OUTPUT_ITERATION_NUMBER,CURRENT_LOOP_ITERATION
128 
129  enters("BIODOMAIN_CONTROL_LOOP_POST_LOOP",err,error,*999)
130 
131  IF(ASSOCIATED(control_loop)) THEN
132  IF(control_loop%OUTPUT_TYPE>=control_loop_progress_output) THEN
133  SELECT CASE(control_loop%LOOP_TYPE)
134  CASE(problem_control_simple_type)
135  !do nothing
136  CASE(problem_control_fixed_loop_type)
137  !do nothing
138  CASE(problem_control_time_loop_type)
139  !Export the dependent field for this time step
140  time_loop=>control_loop%TIME_LOOP
141  IF(ASSOCIATED(time_loop)) THEN
142  problem=>control_loop%PROBLEM
143  IF(ASSOCIATED(problem)) THEN
144  NULLIFY(solvers)
145  NULLIFY(solver)
146  !Get the solver. For Biodomain problems of any split the 2nd solver will contain the dependent field equation set
147  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
148  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
149  !Loop over the equations sets associated with the solver
150  solver_equations=>solver%SOLVER_EQUATIONS
151  IF(ASSOCIATED(solver_equations)) THEN
152  solver_mapping=>solver_equations%SOLVER_MAPPING
153  IF(ASSOCIATED(solver_mapping)) THEN
154  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
155  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
156  IF(ASSOCIATED(equations_set)) THEN
157  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
158  NULLIFY(dependent_region)
159  CALL field_region_get(dependent_field,dependent_region,err,error,*999)
160  NULLIFY(parent_loop)
161  parent_loop=>control_loop%PARENT_LOOP
162  IF(ASSOCIATED(parent_loop)) THEN
163  !add the iteration number of the parent loop to the filename
164  NULLIFY(time_loop_parent)
165  time_loop_parent=>parent_loop%TIME_LOOP
166  IF(ASSOCIATED(time_loop_parent)) THEN
167  output_iteration_number=time_loop_parent%OUTPUT_NUMBER
168  current_loop_iteration=time_loop_parent%GLOBAL_ITERATION_NUMBER
169  filename="Time_"//trim(number_to_vstring(dependent_region%USER_NUMBER,"*",err,error))// &
170  & "_"//trim(number_to_vstring(time_loop_parent%GLOBAL_ITERATION_NUMBER,"*",err,error))// &
171  & "_"//trim(number_to_vstring(time_loop%ITERATION_NUMBER,"*",err,error))
172  ELSE
173  output_iteration_number=time_loop%OUTPUT_NUMBER
174  current_loop_iteration=time_loop%GLOBAL_ITERATION_NUMBER
175  filename="Time_"//trim(number_to_vstring(dependent_region%USER_NUMBER,"*",err,error))// &
176  & "_"//trim(number_to_vstring(time_loop%GLOBAL_ITERATION_NUMBER,"*",err,error))
177  ENDIF
178  ELSE
179  output_iteration_number=time_loop%OUTPUT_NUMBER
180  current_loop_iteration=time_loop%GLOBAL_ITERATION_NUMBER
181  filename="Time_"//trim(number_to_vstring(dependent_region%USER_NUMBER,"*",err,error))// &
182  & "_"//trim(number_to_vstring(time_loop%GLOBAL_ITERATION_NUMBER,"*",err,error))
183  ENDIF
184  method="FORTRAN"
185  IF(output_iteration_number>0) THEN
186  IF(mod(current_loop_iteration,output_iteration_number)==0) THEN
187  CALL field_io_nodes_export(dependent_region%FIELDS,filename,method,err,error,*999)
188  ENDIF
189  ENDIF
190  ELSE
191  local_error="Equations set is not associated for equations set index "// &
192  & trim(number_to_vstring(equations_set_idx,"*",err,error))// &
193  & " in the solver mapping."
194  CALL flagerror(local_error,err,error,*999)
195  ENDIF
196  ENDDO !equations_set_idx
197  ELSE
198  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
199  ENDIF
200  ELSE
201  CALL flagerror("Solver solver equations are not associated.",err,error,*999)
202  ENDIF
203  ELSE
204  CALL flagerror("Control loop problem is not associated.",err,error,*999)
205  ENDIF
206  ELSE
207  CALL flagerror("Time loop is not associated.",err,error,*999)
208  ENDIF
209  CASE(problem_control_while_loop_type)
210  !do nothing
211  CASE(problem_control_load_increment_loop_type)
212  !do nothing
213  CASE DEFAULT
214  local_error="The control loop type of "//trim(number_to_vstring(control_loop%LOOP_TYPE,"*",err,error))// &
215  & " is invalid."
216  CALL flagerror(local_error,err,error,*999)
217  END SELECT
218  ENDIF
219  ELSE
220  CALL flagerror("Control loop is not associated.",err,error,*999)
221  ENDIF
222 
223  exits("BIODOMAIN_CONTROL_LOOP_POST_LOOP")
224  RETURN
225 999 errorsexits("BIODOMAIN_CONTROL_LOOP_POST_LOOP",err,error)
226  RETURN 1
227 
228  END SUBROUTINE biodomain_control_loop_post_loop
229 
230  !
231  !================================================================================================================================
232  !
233 
235  SUBROUTINE biodomain_equationssetsetup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
236 
237  !Argument variables
238  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
239  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
240  INTEGER(INTG), INTENT(OUT) :: ERR
241  TYPE(varying_string), INTENT(OUT) :: ERROR
242  !Local Variables
243  INTEGER(INTG) :: component_idx,dimension_idx,DIMENSION_MULTIPLIER,GEOMETRIC_COMPONENT_NUMBER,GEOMETRIC_SCALING_TYPE, &
244  & NUMBER_OF_DIMENSIONS,NUMBER_OF_MATERIALS_COMPONENTS,GEOMETRIC_MESH_COMPONENT
245  TYPE(decomposition_type), POINTER :: GEOMETRIC_DECOMPOSITION
246  TYPE(equations_type), POINTER :: EQUATIONS
247  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
248  TYPE(equations_set_materials_type), POINTER :: EQUATIONS_MATERIALS
249  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
250  TYPE(varying_string) :: LOCAL_ERROR
251  INTEGER(INTG) :: EQUATIONS_SET_SPEC_TYPE,EQUATIONS_SET_SPEC_SUBTYPE
252 
253  enters("Biodomain_EquationsSetSetup",err,error,*999)
254 
255  NULLIFY(equations)
256  NULLIFY(equations_mapping)
257  NULLIFY(equations_matrices)
258  NULLIFY(geometric_decomposition)
259 
260  IF(ASSOCIATED(equations_set)) THEN
261  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
262  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
263  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
264  CALL flagerror("Equations set specification must have three entries for a biodomain equation class.",err,error,*999)
265  END IF
266  equations_set_spec_type=equations_set%SPECIFICATION(2)
267  equations_set_spec_subtype=equations_set%SPECIFICATION(3)
268  SELECT CASE(equations_set_setup%SETUP_TYPE)
269  CASE(equations_set_setup_initial_type)
270  SELECT CASE(equations_set_setup%ACTION_TYPE)
271  CASE(equations_set_setup_start_action)
272  CALL biodomain_equationssetsolutionmethodset(equations_set,equations_set_fem_solution_method, &
273  & err,error,*999)
274  CASE(equations_set_setup_finish_action)
275 !!Todo: CHECK VALID SETUP
276  CASE DEFAULT
277  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
278  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
279  & " is invalid for a bioelectric domain equation."
280  CALL flagerror(local_error,err,error,*999)
281  END SELECT
282  CASE(equations_set_setup_geometry_type)
283  !\todo Check geometric dimension
284  CASE(equations_set_setup_dependent_type)
285  SELECT CASE(equations_set_setup%ACTION_TYPE)
286  CASE(equations_set_setup_start_action)
287  SELECT CASE(equations_set_spec_type)
288  CASE(equations_set_monodomain_equation_type)
289  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
290  !Create the auto created dependent field
291  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
292  & dependent_field,err,error,*999)
293  CALL field_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
294  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
295  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_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_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
298  & err,error,*999)
299  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
300  & geometric_field,err,error,*999)
301  SELECT CASE(equations_set_spec_subtype)
302  CASE(equations_set_no_subtype)
303  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,2,err,error,*999)
304  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,[field_u_variable_type, &
305  & field_deludeln_variable_type],err,error,*999)
306  CASE(equations_set_1d3d_monodomain_elasticity_subtype,equations_set_monodomain_elasticity_velocity_subtype, &
307  & equations_set_monodomain_elasticity_w_titin_subtype,equations_set_1d3d_monodomain_active_strain_subtype)
308  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,3,err,error,*999)
309  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,[field_u_variable_type, &
310  & field_deludeln_variable_type,field_v_variable_type],err,error,*999)
311  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type,"GeometryM3D",err, &
312  & error,*999)
313  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
314  & field_dp_type,err,error,*999)
315  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type,3, &
316  & err,error,*999)
317  CASE DEFAULT
318  local_error="The third equations set specification of "// &
319  & trim(number_to_vstring(equations_set_spec_subtype,"*",err,error))// &
320  & " is not valid for a monodomain equation set."
321  CALL flagerror(local_error,err,error,*999)
322  END SELECT
323  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,"Vm",err,error,*999)
324  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,"dVm/dn", &
325  & err,error,*999)
326  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
327  & field_scalar_dimension_type,err,error,*999)
328  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
329  & field_scalar_dimension_type,err,error,*999)
330  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
331  & field_dp_type,err,error,*999)
332  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
333  & field_dp_type,err,error,*999)
334  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
335  & err,error,*999)
336  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
337  & err,error,*999)
338  !Default to the geometric interpolation setup
339  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,1, &
340  & geometric_mesh_component,err,error,*999)
341  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
342  & geometric_mesh_component,err,error,*999)
343  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
344  & geometric_mesh_component,err,error,*999)
345  SELECT CASE(equations_set%SOLUTION_METHOD)
346  CASE(equations_set_fem_solution_method)
347  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
348  & field_u_variable_type,1,field_node_based_interpolation,err,error,*999)
349  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
350  & field_deludeln_variable_type,1,field_node_based_interpolation,err,error,*999)
351  !Default the scaling to the geometric field scaling
352  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
353  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
354  CASE(equations_set_bem_solution_method)
355  CALL flagerror("Not implemented.",err,error,*999)
356  CASE(equations_set_fd_solution_method)
357  CALL flagerror("Not implemented.",err,error,*999)
358  CASE(equations_set_fv_solution_method)
359  CALL flagerror("Not implemented.",err,error,*999)
360  CASE(equations_set_gfem_solution_method)
361  CALL flagerror("Not implemented.",err,error,*999)
362  CASE(equations_set_gfv_solution_method)
363  CALL flagerror("Not implemented.",err,error,*999)
364  CASE DEFAULT
365  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
366  & " is invalid."
367  CALL flagerror(local_error,err,error,*999)
368  END SELECT
369  ELSE
370  !Check the user specified field
371  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
372  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
373  SELECT CASE(equations_set_spec_subtype)
374  CASE(equations_set_no_subtype)
375  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,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  CASE(equations_set_1d3d_monodomain_elasticity_subtype,equations_set_monodomain_elasticity_w_titin_subtype, &
379  & equations_set_monodomain_elasticity_velocity_subtype,equations_set_1d3d_monodomain_active_strain_subtype)
380  CALL field_number_of_variables_check(equations_set_setup%FIELD,3,err,error,*999)
381  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_deludeln_variable_type, &
382  & field_v_variable_type],err,error,*999)
383  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_dp_type,err,error,*999)
384  CALL field_number_of_components_check(equations_set_setup%FIELD,field_v_variable_type,3,err,error,*999)
385  CASE DEFAULT
386  local_error="The third equations set specification of "// &
387  & trim(number_to_vstring(equations_set_spec_subtype,"*",err,error))// &
388  & " is not valid for a monodomain equation set."
389  CALL flagerror(local_error,err,error,*999)
390  END SELECT
391  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_scalar_dimension_type, &
392  & err,error,*999)
393  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_scalar_dimension_type, &
394  & err,error,*999)
395  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
396  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
397  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1,err,error,*999)
398  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type,1,err,error,*999)
399  SELECT CASE(equations_set%SOLUTION_METHOD)
400  CASE(equations_set_fem_solution_method)
401  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
402  & field_node_based_interpolation,err,error,*999)
403  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
404  & field_node_based_interpolation,err,error,*999)
405  CASE(equations_set_bem_solution_method)
406  CALL flagerror("Not implemented.",err,error,*999)
407  CASE(equations_set_fd_solution_method)
408  CALL flagerror("Not implemented.",err,error,*999)
409  CASE(equations_set_fv_solution_method)
410  CALL flagerror("Not implemented.",err,error,*999)
411  CASE(equations_set_gfem_solution_method)
412  CALL flagerror("Not implemented.",err,error,*999)
413  CASE(equations_set_gfv_solution_method)
414  CALL flagerror("Not implemented.",err,error,*999)
415  CASE DEFAULT
416  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
417  & " is invalid."
418  CALL flagerror(local_error,err,error,*999)
419  END SELECT
420  ENDIF
421  CASE(equations_set_bidomain_equation_type)
422  SELECT CASE(equations_set_spec_subtype)
423  CASE(equations_set_first_bidomain_subtype)
424  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
425  !Create the auto created dependent field
426  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
427  & dependent_field,err,error,*999)
428  CALL field_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
429  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
430  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
431  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
432  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
433  & err,error,*999)
434  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
435  & geometric_field,err,error,*999)
436  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,4,err,error,*999)
437 !! \todo allow for no rhs variable and so eliminate one of the flux variables
438  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,[field_u_variable_type, &
439  & field_deludeln_variable_type,field_v_variable_type,field_delvdeln_variable_type],err,error,*999)
440  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,"Vm",err,error,*999)
441  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,"dVm/dn", &
442  & err,error,*999)
443  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type,"Phie", &
444  & err,error,*999)
445  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type,"dPhie/dn", &
446  & err,error,*999)
447  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
448  & field_scalar_dimension_type,err,error,*999)
449  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
450  & field_scalar_dimension_type,err,error,*999)
451  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
452  & field_scalar_dimension_type,err,error,*999)
453  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type, &
454  & field_scalar_dimension_type,err,error,*999)
455  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
456  & field_dp_type,err,error,*999)
457  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
458  & field_dp_type,err,error,*999)
459  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
460  & field_dp_type,err,error,*999)
461  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type, &
462  & field_dp_type,err,error,*999)
463  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
464  & err,error,*999)
465  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
466  & field_deludeln_variable_type,1,err,error,*999)
467  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type,1, &
468  & err,error,*999)
469  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
470  & field_delvdeln_variable_type,1,err,error,*999)
471  !Default to the geometric interpolation setup
472  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,1, &
473  & geometric_mesh_component,err,error,*999)
474  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
475  & geometric_mesh_component,err,error,*999)
476  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
477  & geometric_mesh_component,err,error,*999)
478  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type,1, &
479  & geometric_mesh_component,err,error,*999)
480  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_delvdeln_variable_type,1, &
481  & geometric_mesh_component,err,error,*999)
482  SELECT CASE(equations_set%SOLUTION_METHOD)
483  CASE(equations_set_fem_solution_method)
484  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
485  & field_u_variable_type,1,field_node_based_interpolation,err,error,*999)
486  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
487  & field_deludeln_variable_type,1,field_node_based_interpolation,err,error,*999)
488  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
489  & field_v_variable_type,1,field_node_based_interpolation,err,error,*999)
490  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
491  & field_delvdeln_variable_type,1,field_node_based_interpolation,err,error,*999)
492  !Default the scaling to the geometric field scaling
493  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
494  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
495  CASE(equations_set_bem_solution_method)
496  CALL flagerror("Not implemented.",err,error,*999)
497  CASE(equations_set_fd_solution_method)
498  CALL flagerror("Not implemented.",err,error,*999)
499  CASE(equations_set_fv_solution_method)
500  CALL flagerror("Not implemented.",err,error,*999)
501  CASE(equations_set_gfem_solution_method)
502  CALL flagerror("Not implemented.",err,error,*999)
503  CASE(equations_set_gfv_solution_method)
504  CALL flagerror("Not implemented.",err,error,*999)
505  CASE DEFAULT
506  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
507  & " is invalid."
508  CALL flagerror(local_error,err,error,*999)
509  END SELECT
510  ELSE
511  !Check the user specified field
512  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
513  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
514 !! \todo allow for no rhs variable and so eliminate one of the flux variables
515  CALL field_number_of_variables_check(equations_set_setup%FIELD,4,err,error,*999)
516  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_deludeln_variable_type, &
517  & field_v_variable_type,field_delvdeln_variable_type],err,error,*999)
518  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_scalar_dimension_type, &
519  & err,error,*999)
520  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_scalar_dimension_type, &
521  & err,error,*999)
522  CALL field_dimension_check(equations_set_setup%FIELD,field_v_variable_type,field_scalar_dimension_type, &
523  & err,error,*999)
524  CALL field_dimension_check(equations_set_setup%FIELD,field_delvdeln_variable_type,field_scalar_dimension_type, &
525  & err,error,*999)
526  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
527  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
528  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_dp_type,err,error,*999)
529  CALL field_data_type_check(equations_set_setup%FIELD,field_delvdeln_variable_type,field_dp_type,err,error,*999)
530  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1,err,error,*999)
531  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type,1,err,error,*999)
532  CALL field_number_of_components_check(equations_set_setup%FIELD,field_v_variable_type,1,err,error,*999)
533  CALL field_number_of_components_check(equations_set_setup%FIELD,field_delvdeln_variable_type,1,err,error,*999)
534  SELECT CASE(equations_set%SOLUTION_METHOD)
535  CASE(equations_set_fem_solution_method)
536  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
537  & field_node_based_interpolation,err,error,*999)
538  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
539  & field_node_based_interpolation,err,error,*999)
540  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,1, &
541  & field_node_based_interpolation,err,error,*999)
542  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_delvdeln_variable_type,1, &
543  & field_node_based_interpolation,err,error,*999)
544  CASE(equations_set_bem_solution_method)
545  CALL flagerror("Not implemented.",err,error,*999)
546  CASE(equations_set_fd_solution_method)
547  CALL flagerror("Not implemented.",err,error,*999)
548  CASE(equations_set_fv_solution_method)
549  CALL flagerror("Not implemented.",err,error,*999)
550  CASE(equations_set_gfem_solution_method)
551  CALL flagerror("Not implemented.",err,error,*999)
552  CASE(equations_set_gfv_solution_method)
553  CALL flagerror("Not implemented.",err,error,*999)
554  CASE DEFAULT
555  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
556  & " is invalid."
557  CALL flagerror(local_error,err,error,*999)
558  END SELECT
559  ENDIF
560  CASE(equations_set_second_bidomain_subtype)
561  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
562  CALL flagerror("The dependent field for the second bidomain equation cannot be auto-created. "// &
563  & "You must pass in the field from the first bidomain equation.",err,error,*999)
564  ELSE
565  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
566  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
567 !! \todo allow for no rhs variable and so eliminate one of the flux variables
568  CALL field_number_of_variables_check(equations_set_setup%FIELD,4,err,error,*999)
569  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_deludeln_variable_type, &
570  & field_v_variable_type,field_delvdeln_variable_type],err,error,*999)
571  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_scalar_dimension_type, &
572  & err,error,*999)
573  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_scalar_dimension_type, &
574  & err,error,*999)
575  CALL field_dimension_check(equations_set_setup%FIELD,field_v_variable_type,field_scalar_dimension_type, &
576  & err,error,*999)
577  CALL field_dimension_check(equations_set_setup%FIELD,field_delvdeln_variable_type,field_scalar_dimension_type, &
578  & err,error,*999)
579  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
580  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
581  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_dp_type,err,error,*999)
582  CALL field_data_type_check(equations_set_setup%FIELD,field_delvdeln_variable_type,field_dp_type,err,error,*999)
583  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1,err,error,*999)
584  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type,1,err,error,*999)
585  CALL field_number_of_components_check(equations_set_setup%FIELD,field_v_variable_type,1,err,error,*999)
586  CALL field_number_of_components_check(equations_set_setup%FIELD,field_delvdeln_variable_type,1,err,error,*999)
587  SELECT CASE(equations_set%SOLUTION_METHOD)
588  CASE(equations_set_fem_solution_method)
589  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
590  & field_node_based_interpolation,err,error,*999)
591  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
592  & field_node_based_interpolation,err,error,*999)
593  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,1, &
594  & field_node_based_interpolation,err,error,*999)
595  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_delvdeln_variable_type,1, &
596  & field_node_based_interpolation,err,error,*999)
597  CASE(equations_set_bem_solution_method)
598  CALL flagerror("Not implemented.",err,error,*999)
599  CASE(equations_set_fd_solution_method)
600  CALL flagerror("Not implemented.",err,error,*999)
601  CASE(equations_set_fv_solution_method)
602  CALL flagerror("Not implemented.",err,error,*999)
603  CASE(equations_set_gfem_solution_method)
604  CALL flagerror("Not implemented.",err,error,*999)
605  CASE(equations_set_gfv_solution_method)
606  CALL flagerror("Not implemented.",err,error,*999)
607  CASE DEFAULT
608  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
609  & " is invalid."
610  CALL flagerror(local_error,err,error,*999)
611  END SELECT
612  ENDIF
613  CASE DEFAULT
614  local_error="The equations set subtype of "//trim(number_to_vstring(equations_set_spec_subtype,"*",err,error))// &
615  & " is invalid for a bidomain equations set type."
616  CALL flagerror(local_error,err,error,*999)
617  END SELECT
618  CASE DEFAULT
619  local_error="The equation set type of "//trim(number_to_vstring(equations_set_spec_type,"*",err,error))// &
620  & " is invalid for a biodomain equations set class."
621  CALL flagerror(local_error,err,error,*999)
622  END SELECT
623  CASE(equations_set_setup_finish_action)
624  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
625  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
626  ENDIF
627  CASE DEFAULT
628  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
629  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
630  & " is invalid for a bioelectric domain equation"
631  CALL flagerror(local_error,err,error,*999)
632  END SELECT
633 
634  CASE(equations_set_setup_independent_type)
635  SELECT CASE(equations_set_setup%ACTION_TYPE)
636  CASE(equations_set_setup_start_action)
637  SELECT CASE(equations_set_spec_type)
638  CASE(equations_set_monodomain_equation_type)
639  SELECT CASE(equations_set_spec_subtype)
640  CASE(equations_set_1d3d_monodomain_elasticity_subtype,equations_set_monodomain_elasticity_w_titin_subtype, &
641  & equations_set_1d3d_monodomain_active_strain_subtype)
642  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
643  !Create the auto created independent field
644  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%INDEPENDENT% &
645  & independent_field,err,error,*999)
646  CALL field_label_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,"Independent Field",err,error,*999)
647  CALL field_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
648  CALL field_dependent_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_independent_type, &
649  & err,error,*999)
650  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
651  CALL field_mesh_decomposition_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_decomposition, &
652  & err,error,*999)
653  CALL field_geometric_field_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,equations_set%GEOMETRY% &
654  & geometric_field,err,error,*999)
655  CALL field_number_of_variables_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,4,err,error,*999)
656  CALL field_variable_types_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,[field_u_variable_type, &
657  & field_v_variable_type,field_u1_variable_type,field_u2_variable_type],err,error,*999)
658  IF(equations_set_spec_subtype==equations_set_1d3d_monodomain_active_strain_subtype) THEN
659  CALL field_variable_label_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
660  & "XB_state_variables",err,error,*999)
661  ELSE
662  CALL field_variable_label_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
663  & "Active_stress",err,error,*999)
664  ENDIF
665  CALL field_variable_label_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u1_variable_type, &
666  & "sarcomere half length",err,error,*999)
667  CALL field_variable_label_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u2_variable_type, &
668  & "contraction velocity",err,error,*999)
669  IF(equations_set_spec_subtype==equations_set_1d3d_monodomain_elasticity_subtype) THEN
670  CALL field_dimension_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
671  & field_scalar_dimension_type,err,error,*999)
672  ENDIF
673  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
674  & field_dp_type,err,error,*999)
675  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u1_variable_type, &
676  & field_dp_type,err,error,*999)
677  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u2_variable_type, &
678  & field_dp_type,err,error,*999)
679  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type, &
680  & field_intg_type,err,error,*999)
681  IF(equations_set_spec_subtype==equations_set_1d3d_monodomain_elasticity_subtype) THEN
682  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
683  & 1,err,error,*999)
684  ELSEIF(equations_set_spec_subtype==equations_set_monodomain_elasticity_w_titin_subtype) THEN
685  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
686  & 6,err,error,*999)
687  ELSEIF(equations_set_spec_subtype==equations_set_1d3d_monodomain_active_strain_subtype) THEN
688  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
689  & 4,err,error,*999)
690  ENDIF
691  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type,5, &
692  & err,error,*999)
693  IF(equations_set_spec_subtype==equations_set_monodomain_elasticity_w_titin_subtype) THEN
694  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u1_variable_type, &
695  & 4,err,error,*999)
696  ELSE
697  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u1_variable_type, &
698  & 3,err,error,*999)
699  ENDIF
700  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u2_variable_type, &
701  & 6,err,error,*999)
702  !Default to the geometric interpolation setup
703  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,1, &
704  & geometric_mesh_component,err,error,*999)
705  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type,1, &
706  & geometric_mesh_component,err,error,*999)
707  IF(equations_set_spec_subtype==equations_set_monodomain_elasticity_w_titin_subtype) THEN
708  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type,2, &
709  & geometric_mesh_component,err,error,*999)
710  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type,3, &
711  & geometric_mesh_component,err,error,*999)
712  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type,4, &
713  & geometric_mesh_component,err,error,*999)
714  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type,5, &
715  & geometric_mesh_component,err,error,*999)
716  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type,6, &
717  & geometric_mesh_component,err,error,*999)
718  ENDIF
719  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type,1, &
720  & geometric_mesh_component,err,error,*999)
721  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type,2, &
722  & geometric_mesh_component,err,error,*999)
723  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type,3, &
724  & geometric_mesh_component,err,error,*999)
725  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type,4, &
726  & geometric_mesh_component,err,error,*999)
727  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type,5, &
728  & geometric_mesh_component,err,error,*999)
729  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u1_variable_type,1, &
730  & geometric_mesh_component,err,error,*999)
731  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u1_variable_type,2, &
732  & geometric_mesh_component,err,error,*999)
733  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u1_variable_type,3, &
734  & geometric_mesh_component,err,error,*999)
735  IF(equations_set_spec_subtype==equations_set_monodomain_elasticity_w_titin_subtype) THEN
736  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u1_variable_type, &
737  & 4,geometric_mesh_component,err,error,*999)
738  ENDIF
739  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u2_variable_type,1, &
740  & geometric_mesh_component,err,error,*999)
741  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u2_variable_type,2, &
742  & geometric_mesh_component,err,error,*999)
743  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u2_variable_type,3, &
744  & geometric_mesh_component,err,error,*999)
745  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u2_variable_type,4, &
746  & geometric_mesh_component,err,error,*999)
747  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u2_variable_type,5, &
748  & geometric_mesh_component,err,error,*999)
749  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u2_variable_type,6, &
750  & geometric_mesh_component,err,error,*999)
751  SELECT CASE(equations_set%SOLUTION_METHOD)
752  CASE(equations_set_fem_solution_method)
753  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
754  & field_u_variable_type,1,field_node_based_interpolation,err,error,*999)
755  IF(equations_set_spec_subtype==equations_set_monodomain_elasticity_w_titin_subtype) THEN
756  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
757  & field_u_variable_type,2,field_node_based_interpolation,err,error,*999)
758  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
759  & field_u_variable_type,3,field_node_based_interpolation,err,error,*999)
760  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
761  & field_u_variable_type,4,field_node_based_interpolation,err,error,*999)
762  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
763  & field_u_variable_type,5,field_node_based_interpolation,err,error,*999)
764  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
765  & field_u_variable_type,6,field_node_based_interpolation,err,error,*999)
766  ENDIF
767  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
768  & field_v_variable_type,1,field_node_based_interpolation,err,error,*999)
769  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
770  & field_v_variable_type,2,field_node_based_interpolation,err,error,*999)
771  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
772  & field_v_variable_type,3,field_node_based_interpolation,err,error,*999)
773  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
774  & field_v_variable_type,4,field_node_based_interpolation,err,error,*999)
775  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
776  & field_v_variable_type,5,field_node_based_interpolation,err,error,*999)
777  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
778  & field_u1_variable_type,1,field_node_based_interpolation,err,error,*999)
779  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
780  & field_u1_variable_type,2,field_constant_interpolation,err,error,*999)
781  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
782  & field_u1_variable_type,3,field_constant_interpolation,err,error,*999)
783  IF(equations_set_spec_subtype==equations_set_monodomain_elasticity_w_titin_subtype) THEN
784  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
785  & field_u1_variable_type,4,field_node_based_interpolation,err,error,*999)
786  ENDIF
787  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
788  & field_u2_variable_type,1,field_node_based_interpolation,err,error,*999)
789  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
790  & field_u2_variable_type,2,field_constant_interpolation,err,error,*999)
791  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
792  & field_u2_variable_type,3,field_node_based_interpolation,err,error,*999)
793  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
794  & field_u2_variable_type,4,field_node_based_interpolation,err,error,*999)
795  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
796  & field_u2_variable_type,5,field_node_based_interpolation,err,error,*999)
797  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
798  & field_u2_variable_type,6,field_node_based_interpolation,err,error,*999)
799  !Default the scaling to the geometric field scaling
800  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
801  CALL field_scaling_type_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
802  CASE(equations_set_bem_solution_method)
803  CALL flagerror("Not implemented.",err,error,*999)
804  CASE(equations_set_fd_solution_method)
805  CALL flagerror("Not implemented.",err,error,*999)
806  CASE(equations_set_fv_solution_method)
807  CALL flagerror("Not implemented.",err,error,*999)
808  CASE(equations_set_gfem_solution_method)
809  CALL flagerror("Not implemented.",err,error,*999)
810  CASE(equations_set_gfv_solution_method)
811  CALL flagerror("Not implemented.",err,error,*999)
812  CASE DEFAULT
813  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
814  & " is invalid."
815  CALL flagerror(local_error,err,error,*999)
816  END SELECT
817  ELSE
818  !Check the user specified field
819  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
820  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
821  CALL field_number_of_variables_check(equations_set_setup%FIELD,4,err,error,*999)
822  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_v_variable_type, &
823  & field_u1_variable_type,field_u2_variable_type],err,error,*999)
824  IF(equations_set_spec_subtype==equations_set_1d3d_monodomain_elasticity_subtype) THEN
825  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_scalar_dimension_type, &
826  & err,error,*999)
827  ENDIF
828  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
829  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_intg_type,err,error,*999)
830  CALL field_data_type_check(equations_set_setup%FIELD,field_u1_variable_type,field_dp_type,err,error,*999)
831  CALL field_data_type_check(equations_set_setup%FIELD,field_u2_variable_type,field_dp_type,err,error,*999)
832  IF(equations_set_spec_subtype==equations_set_1d3d_monodomain_elasticity_subtype) THEN
833  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1,err,error,*999)
834  ELSE IF(equations_set_spec_subtype==equations_set_monodomain_elasticity_w_titin_subtype) THEN
835  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,6,err,error,*999)
836  ELSEIF(equations_set_spec_subtype==equations_set_1d3d_monodomain_active_strain_subtype) THEN
837  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,4,err,error,*999)
838  ENDIF
839  CALL field_number_of_components_check(equations_set_setup%FIELD,field_v_variable_type,5,err,error,*999)
840  IF(equations_set_spec_subtype==equations_set_monodomain_elasticity_w_titin_subtype) THEN
841  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u1_variable_type,4,err,error,*999)
842  ELSE
843  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u1_variable_type,3,err,error,*999)
844  ENDIF
845  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u2_variable_type,6,err,error,*999)
846  SELECT CASE(equations_set%SOLUTION_METHOD)
847  CASE(equations_set_fem_solution_method)
848  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
849  & field_node_based_interpolation,err,error,*999)
850  IF(equations_set_spec_subtype==equations_set_monodomain_elasticity_w_titin_subtype) THEN
851  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,2, &
852  & field_node_based_interpolation,err,error,*999)
853  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,3, &
854  & field_node_based_interpolation,err,error,*999)
855  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,4, &
856  & field_node_based_interpolation,err,error,*999)
857  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,5, &
858  & field_node_based_interpolation,err,error,*999)
859  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,6, &
860  & field_node_based_interpolation,err,error,*999)
861  ENDIF
862  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,1, &
863  & field_node_based_interpolation,err,error,*999)
864  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,2, &
865  & field_node_based_interpolation,err,error,*999)
866  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,3, &
867  & field_node_based_interpolation,err,error,*999)
868  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,4, &
869  & field_node_based_interpolation,err,error,*999)
870  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,5, &
871  & field_node_based_interpolation,err,error,*999)
872  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u1_variable_type,1, &
873  & field_node_based_interpolation,err,error,*999)
874  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u1_variable_type,2, &
875  & field_constant_interpolation,err,error,*999)
876  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u1_variable_type,3, &
877  & field_constant_interpolation,err,error,*999)
878  IF(equations_set_spec_subtype==equations_set_monodomain_elasticity_w_titin_subtype) THEN
879  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u1_variable_type,4, &
880  & field_node_based_interpolation,err,error,*999)
881  ENDIF
882  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u2_variable_type,1, &
883  & field_node_based_interpolation,err,error,*999)
884  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u2_variable_type,2, &
885  & field_constant_interpolation,err,error,*999)
886  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u2_variable_type,3, &
887  & field_node_based_interpolation,err,error,*999)
888  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u2_variable_type,4, &
889  & field_node_based_interpolation,err,error,*999)
890  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u2_variable_type,5, &
891  & field_node_based_interpolation,err,error,*999)
892  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u2_variable_type,6, &
893  & field_node_based_interpolation,err,error,*999)
894  CASE(equations_set_bem_solution_method)
895  CALL flagerror("Not implemented.",err,error,*999)
896  CASE(equations_set_fd_solution_method)
897  CALL flagerror("Not implemented.",err,error,*999)
898  CASE(equations_set_fv_solution_method)
899  CALL flagerror("Not implemented.",err,error,*999)
900  CASE(equations_set_gfem_solution_method)
901  CALL flagerror("Not implemented.",err,error,*999)
902  CASE(equations_set_gfv_solution_method)
903  CALL flagerror("Not implemented.",err,error,*999)
904  CASE DEFAULT
905  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
906  & " is invalid."
907  CALL flagerror(local_error,err,error,*999)
908  END SELECT
909  ENDIF
910  CASE(equations_set_monodomain_elasticity_velocity_subtype)
911  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
912  !Create the auto created independent field
913  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%INDEPENDENT% &
914  & independent_field,err,error,*999)
915  CALL field_label_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,"Independent Field",err,error,*999)
916  CALL field_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
917  CALL field_dependent_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_independent_type, &
918  & err,error,*999)
919  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
920  CALL field_mesh_decomposition_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_decomposition, &
921  & err,error,*999)
922  CALL field_geometric_field_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,equations_set%GEOMETRY% &
923  & geometric_field,err,error,*999)
924  CALL field_number_of_variables_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,2,err,error,*999)
925  CALL field_variable_types_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,[field_u_variable_type, &
926  & field_v_variable_type],err,error,*999)
927  CALL field_variable_label_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
928  & "Active_stress",err,error,*999)
929  CALL field_variable_label_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type, &
930  & "fibre_info",err,error,*999)
931  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
932  & field_dp_type,err,error,*999)
933  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type, &
934  & field_intg_type,err,error,*999)
935  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
936  & 1,err,error,*999)
937  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type,5, &
938  & err,error,*999)
939  !Default to the geometric interpolation setup
940  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,1, &
941  & geometric_mesh_component,err,error,*999)
942  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type,1, &
943  & geometric_mesh_component,err,error,*999)
944  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type,1, &
945  & geometric_mesh_component,err,error,*999)
946  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type,2, &
947  & geometric_mesh_component,err,error,*999)
948  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type,3, &
949  & geometric_mesh_component,err,error,*999)
950  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type,4, &
951  & geometric_mesh_component,err,error,*999)
952  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type,5, &
953  & geometric_mesh_component,err,error,*999)
954  SELECT CASE(equations_set%SOLUTION_METHOD)
955  CASE(equations_set_fem_solution_method)
956  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
957  & field_u_variable_type,1,field_node_based_interpolation,err,error,*999)
958  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
959  & field_v_variable_type,1,field_node_based_interpolation,err,error,*999)
960  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
961  & field_v_variable_type,2,field_node_based_interpolation,err,error,*999)
962  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
963  & field_v_variable_type,3,field_node_based_interpolation,err,error,*999)
964  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
965  & field_v_variable_type,4,field_node_based_interpolation,err,error,*999)
966  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
967  & field_v_variable_type,5,field_node_based_interpolation,err,error,*999)
968  !Default the scaling to the geometric field scaling
969  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
970  CALL field_scaling_type_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
971  CASE(equations_set_bem_solution_method)
972  CALL flagerror("Not implemented.",err,error,*999)
973  CASE(equations_set_fd_solution_method)
974  CALL flagerror("Not implemented.",err,error,*999)
975  CASE(equations_set_fv_solution_method)
976  CALL flagerror("Not implemented.",err,error,*999)
977  CASE(equations_set_gfem_solution_method)
978  CALL flagerror("Not implemented.",err,error,*999)
979  CASE(equations_set_gfv_solution_method)
980  CALL flagerror("Not implemented.",err,error,*999)
981  CASE DEFAULT
982  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
983  & " is invalid."
984  CALL flagerror(local_error,err,error,*999)
985  END SELECT
986  ELSE
987  !Check the user specified field
988  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
989  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
990  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
991  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_v_variable_type],err, &
992  & error,*999)
993  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
994  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_intg_type,err,error,*999)
995  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1,err,error,*999)
996  CALL field_number_of_components_check(equations_set_setup%FIELD,field_v_variable_type,5,err,error,*999)
997  SELECT CASE(equations_set%SOLUTION_METHOD)
998  CASE(equations_set_fem_solution_method)
999  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
1000  & field_node_based_interpolation,err,error,*999)
1001  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,1, &
1002  & field_node_based_interpolation,err,error,*999)
1003  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,2, &
1004  & field_node_based_interpolation,err,error,*999)
1005  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,3, &
1006  & field_node_based_interpolation,err,error,*999)
1007  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,4, &
1008  & field_node_based_interpolation,err,error,*999)
1009  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,5, &
1010  & field_node_based_interpolation,err,error,*999)
1011  CASE(equations_set_bem_solution_method)
1012  CALL flagerror("Not implemented.",err,error,*999)
1013  CASE(equations_set_fd_solution_method)
1014  CALL flagerror("Not implemented.",err,error,*999)
1015  CASE(equations_set_fv_solution_method)
1016  CALL flagerror("Not implemented.",err,error,*999)
1017  CASE(equations_set_gfem_solution_method)
1018  CALL flagerror("Not implemented.",err,error,*999)
1019  CASE(equations_set_gfv_solution_method)
1020  CALL flagerror("Not implemented.",err,error,*999)
1021  CASE DEFAULT
1022  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1023  & " is invalid."
1024  CALL flagerror(local_error,err,error,*999)
1025  END SELECT
1026  ENDIF
1027  CASE DEFAULT
1028  local_error="The equations set subtype of "//trim(number_to_vstring(equations_set_spec_subtype,"*",err,error))// &
1029  " is not implemented for an equations set setup independent type."
1030  CALL flagerror(local_error,err,error,*999)
1031  END SELECT
1032  CASE(equations_set_bidomain_equation_type)
1033  local_error="Equations set setup independent type is not implemented for an equations set bidomain equation type"
1034  CALL flagerror(local_error,err,error,*999)
1035  CASE DEFAULT
1036  local_error="The equation set type of "//trim(number_to_vstring(equations_set_spec_type,"*",err,error))// &
1037  & " is invalid for a biodomain equations set class."
1038  CALL flagerror(local_error,err,error,*999)
1039  END SELECT
1040  CASE(equations_set_setup_finish_action)
1041  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
1042  CALL field_create_finish(equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
1043  ENDIF
1044  CASE DEFAULT
1045  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1046  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1047  & " is invalid for a bioelectric domain equation"
1048  CALL flagerror(local_error,err,error,*999)
1049  END SELECT
1050 
1051  CASE(equations_set_setup_materials_type)
1052  SELECT CASE(equations_set_setup%ACTION_TYPE)
1053  CASE(equations_set_setup_start_action)
1054  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
1055  equations_materials=>equations_set%MATERIALS
1056  IF(ASSOCIATED(equations_materials)) THEN
1057  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
1058  !Create the auto created materials field
1059  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_materials% &
1060  & materials_field,err,error,*999)
1061  CALL field_label_set(equations_materials%MATERIALS_FIELD,"Materials Field",err,error,*999)
1062  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
1063  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type,err,error,*999)
1064  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
1065  CALL field_mesh_decomposition_set_and_lock(equations_materials%MATERIALS_FIELD,geometric_decomposition, &
1066  & err,error,*999)
1067  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
1068  & geometric_field,err,error,*999)
1069  CALL field_number_of_variables_set_and_lock(equations_materials%MATERIALS_FIELD,1,err,error,*999)
1070  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,[field_u_variable_type], &
1071  & err,error,*999)
1072  CALL field_variable_label_set(equations_materials%MATERIALS_FIELD,field_u_variable_type,"Materials",err,error,*999)
1073  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1074  & field_vector_dimension_type,err,error,*999)
1075  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1076  & field_dp_type,err,error,*999)
1077  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1078  & number_of_dimensions,err,error,*999)
1079  IF(equations_set_spec_type==equations_set_monodomain_equation_type) THEN
1080  !Monodomain. Materials field components are 2 plus one for each dimension i.e., Am, Cm and \sigma
1081  number_of_materials_components=number_of_dimensions+2
1082  dimension_multiplier=1
1083  ELSE
1084  !Bidomain. Materials field components are 2 plus two for each dimension i.e., Am, C, \sigma_i and \sigma_e
1085  number_of_materials_components=2*number_of_dimensions+2
1086  dimension_multiplier=2
1087  ENDIF
1088  !Set the number of materials components
1089  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1090  & number_of_materials_components,err,error,*999)
1091  !Default the Am and Cm materials components to the first component geometric interpolation with const interpolation
1092  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1093  & 1,geometric_component_number,err,error,*999)
1094  DO component_idx=1,2
1095  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1096  & component_idx,geometric_component_number,err,error,*999)
1097  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1098  & component_idx,field_constant_interpolation,err,error,*999)
1099  ENDDO !components_idx
1100  CALL field_component_label_set(equations_materials%MATERIALS_FIELD,field_u_variable_type,1,"Am", &
1101  & err,error,*999)
1102  CALL field_component_label_set(equations_materials%MATERIALS_FIELD,field_u_variable_type,2,"Cm", &
1103  & err,error,*999)
1104  !Default the \sigma materials components to the geometric interpolation setup with constant interpolation
1105  DO component_idx=1,number_of_dimensions
1106  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1107  & component_idx,geometric_component_number,err,error,*999)
1108  DO dimension_idx=1,dimension_multiplier
1109  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1110  & 2+component_idx+(dimension_idx-1)*number_of_dimensions,geometric_component_number,err,error,*999)
1111  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1112  & 2+component_idx+(dimension_idx-1)*number_of_dimensions,field_constant_interpolation,err,error,*999)
1113  ENDDO !dimension_idx
1114  ENDDO !component_idx
1115  !Default the field scaling to that of the geometric field
1116  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
1117  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
1118  ELSE
1119  !Check the user specified field
1120  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
1121  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1122  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
1123  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
1124  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
1125  & err,error,*999)
1126  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1127  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1128  & number_of_dimensions,err,error,*999)
1129  SELECT CASE(equations_set_spec_type)
1130  CASE(equations_set_monodomain_equation_type,equations_set_monodomain_strang_splitting_equation_type)
1131  !Monodomain. Materials field components are 2 plus one for each dimension i.e., Am, Cm and \sigma
1132  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_dimensions+2, &
1133  & err,error,*999)
1134  CASE(equations_set_bidomain_equation_type)
1135  !Bidomain. Materials field components are 2 plus two for each dimension i.e., Am, C, \sigma_i and \sigma_e
1136  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,2*number_of_dimensions+2, &
1137  & err,error,*999)
1138  CASE DEFAULT
1139  local_error="The equations set type of "//trim(number_to_vstring(equations_set_spec_type,"*",err,error))// &
1140  & " is invalid for a bioelectrics class."
1141  CALL flagerror(local_error,err,error,*999)
1142  END SELECT
1143  ENDIF
1144  ELSE
1145  CALL flagerror("Equations set materials is not associated.",err,error,*999)
1146  ENDIF
1147  ELSE
1148  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
1149  ENDIF
1150  CASE(equations_set_setup_finish_action)
1151  equations_materials=>equations_set%MATERIALS
1152  IF(ASSOCIATED(equations_materials)) THEN
1153  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
1154  !Finish creating the materials field
1155  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
1156  !Set the default values for the materials field
1157  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1158  & number_of_dimensions,err,error,*999)
1159  IF(equations_set_spec_type==equations_set_monodomain_equation_type) THEN
1160  !Monodomain. Materials field components are 2 plus one for each dimension i.e., Am, Cm and \sigma
1161  number_of_materials_components=number_of_dimensions+2
1162  dimension_multiplier=1
1163  ELSE
1164  !Bidomain. Materials field components are 2 plus two for each dimension i.e., Am, C, \sigma_i and \sigma_e
1165  number_of_materials_components=2*number_of_dimensions+2
1166  dimension_multiplier=2
1167  ENDIF
1168  !First set Am
1169  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1170  & field_values_set_type,1,200.0_dp,err,error,*999)
1171  !Now set Cm
1172  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1173  & field_values_set_type,2,0.0025_dp,err,error,*999)
1174  !Now set the sigmas to be 1.0
1175  DO component_idx=1,number_of_dimensions
1176  DO dimension_idx=1,dimension_multiplier
1177  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1178  & field_values_set_type,2+component_idx+(dimension_idx-1)*number_of_dimensions,1.0_dp,err,error,*999)
1179  ENDDO !dimension_idx
1180  ENDDO !component_idx
1181  ENDIF
1182  ELSE
1183  CALL flagerror("Equations set materials is not associated.",err,error,*999)
1184  ENDIF
1185  CASE DEFAULT
1186  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1187  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1188  & " is invalid for a bioelectric domain equation."
1189  CALL flagerror(local_error,err,error,*999)
1190  END SELECT
1191  CASE(equations_set_setup_source_type)
1192  SELECT CASE(equations_set_setup%ACTION_TYPE)
1193  CASE(equations_set_setup_start_action)
1194  !Do nothing
1195  CASE(equations_set_setup_finish_action)
1196  !Do nothing
1197  CASE DEFAULT
1198  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1199  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1200  & " is invalid for a bioelectric domain equation."
1201  CALL flagerror(local_error,err,error,*999)
1202  END SELECT
1203  CASE(equations_set_setup_analytic_type)
1204  SELECT CASE(equations_set_setup%ACTION_TYPE)
1205  CASE(equations_set_setup_start_action)
1206  CALL flagerror("Not implemented.",err,error,*999)
1207  CASE(equations_set_setup_finish_action)
1208  CALL flagerror("Not implemented.",err,error,*999)
1209  CASE DEFAULT
1210  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1211  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1212  & " is invalid for a bioelectric domain equation."
1213  CALL flagerror(local_error,err,error,*999)
1214  END SELECT
1215  CASE(equations_set_setup_equations_type)
1216  SELECT CASE(equations_set_setup%ACTION_TYPE)
1217  CASE(equations_set_setup_start_action)
1218  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
1219  IF(ASSOCIATED(equations_set%MATERIALS)) THEN
1220  IF(equations_set%MATERIALS%MATERIALS_FINISHED) THEN
1221  !Create the equations
1222  CALL equations_create_start(equations_set,equations,err,error,*999)
1223  CALL equations_linearity_type_set(equations,equations_linear,err,error,*999)
1224  SELECT CASE(equations_set_spec_type)
1225  CASE(equations_set_monodomain_equation_type)
1226  CALL equations_time_dependence_type_set(equations,equations_first_order_dynamic,err,error,*999)
1227  CASE(equations_set_bidomain_equation_type)
1228  SELECT CASE(equations_set_spec_subtype)
1229  CASE(equations_set_first_bidomain_subtype)
1230  CALL equations_time_dependence_type_set(equations,equations_first_order_dynamic,err,error,*999)
1231  CASE(equations_set_second_bidomain_subtype)
1232  CALL equations_time_dependence_type_set(equations,equations_static,err,error,*999)
1233  CASE DEFAULT
1234  local_error="The third equations set specification of "// &
1235  & trim(number_to_vstring(equations_set_spec_subtype,"*",err,error))// &
1236  & " is invalid for a bidomain equation."
1237  CALL flagerror(local_error,err,error,*999)
1238  END SELECT
1239  CASE DEFAULT
1240  local_error="The second equations set specification of "// &
1241  & trim(number_to_vstring(equations_set_spec_type,"*",err,error))// &
1242  & " is invalid for a bioelectrics class."
1243  CALL flagerror(local_error,err,error,*999)
1244  END SELECT
1245  ELSE
1246  CALL flagerror("Equations set materials field has not been finished.",err,error,*999)
1247  ENDIF
1248  ELSE
1249  CALL flagerror("Equations set materials is not associated.",err,error,*999)
1250  ENDIF
1251  ELSE
1252  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
1253  ENDIF
1254  CASE(equations_set_setup_finish_action)
1255  SELECT CASE(equations_set%SOLUTION_METHOD)
1256  CASE(equations_set_fem_solution_method)
1257  !Finish the creation of the equations
1258  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
1259  CALL equations_create_finish(equations,err,error,*999)
1260  !Create the equations mapping.
1261  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
1262  SELECT CASE(equations_set_spec_type)
1263  CASE(equations_set_monodomain_equation_type)
1264  CALL equations_mapping_dynamic_matrices_set(equations_mapping,.true.,.true.,err,error,*999)
1265  CALL equations_mapping_dynamic_variable_type_set(equations_mapping,field_u_variable_type,err,error,*999)
1266  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
1267  CASE(equations_set_bidomain_equation_type)
1268  SELECT CASE(equations_set_spec_subtype)
1269  CASE(equations_set_first_bidomain_subtype)
1270  CALL equations_mapping_dynamic_matrices_set(equations_mapping,.true.,.true.,err,error,*999)
1271  CALL equations_mapping_dynamic_variable_type_set(equations_mapping,field_u_variable_type,err,error,*999)
1272  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
1273  CASE(equations_set_second_bidomain_subtype)
1274  CALL equationsmapping_linearmatricesnumberset(equations_mapping,1,err,error,*999)
1275  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,[field_v_variable_type], &
1276  & err,error,*999)
1277  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_delvdeln_variable_type,err,error,*999)
1278  CASE DEFAULT
1279  local_error="The equations set subtype of "//trim(number_to_vstring(equations_set_spec_subtype,"*",err,error))// &
1280  & " is invalid for a bidomain equation type."
1281  CALL flagerror(local_error,err,error,*999)
1282  END SELECT
1283  CASE DEFAULT
1284  local_error="The equations set type of "//trim(number_to_vstring(equations_set_spec_type,"*",err,error))// &
1285  & " is invalid for a bioelectrics class."
1286  CALL flagerror(local_error,err,error,*999)
1287  END SELECT
1288  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
1289  !Create the equations matrices
1290  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
1291  SELECT CASE(equations_set_spec_type)
1292  CASE(equations_set_monodomain_equation_type)
1293  !Set up matrix storage and structure
1294  IF(equations%LUMPING_TYPE==equations_lumped_matrices) THEN
1295  !Set up lumping
1296  CALL equations_matrices_dynamic_lumping_type_set(equations_matrices, &
1297  & [equations_matrix_unlumped,equations_matrix_lumped],err,error,*999)
1298  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
1299  & [distributed_matrix_compressed_row_storage_type,distributed_matrix_diagonal_storage_type], &
1300  & err,error,*999)
1301  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
1302  & [equations_matrix_fem_structure,equations_matrix_diagonal_structure],err,error,*999)
1303  ELSE
1304  SELECT CASE(equations%SPARSITY_TYPE)
1305  CASE(equations_matrices_full_matrices)
1306  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
1307  & [distributed_matrix_block_storage_type,distributed_matrix_block_storage_type], &
1308  & err,error,*999)
1309  CASE(equations_matrices_sparse_matrices)
1310  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
1311  & [distributed_matrix_compressed_row_storage_type,distributed_matrix_compressed_row_storage_type], &
1312  & err,error,*999)
1313  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
1314  & [equations_matrix_fem_structure,equations_matrix_fem_structure],err,error,*999)
1315  CASE DEFAULT
1316  local_error="The equations matrices sparsity type of "// &
1317  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
1318  CALL flagerror(local_error,err,error,*999)
1319  END SELECT
1320  ENDIF
1321  CASE(equations_set_bidomain_equation_type)
1322  SELECT CASE(equations_set_spec_subtype)
1323  CASE(equations_set_first_bidomain_subtype)
1324  !Set up matrix storage and structure
1325  IF(equations%LUMPING_TYPE==equations_lumped_matrices) THEN
1326  !Set up lumping
1327  CALL equations_matrices_dynamic_lumping_type_set(equations_matrices, &
1328  & [equations_matrix_unlumped,equations_matrix_lumped],err,error,*999)
1329  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
1330  & [distributed_matrix_compressed_row_storage_type,distributed_matrix_diagonal_storage_type], &
1331  & err,error,*999)
1332  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
1333  & [equations_matrix_fem_structure,equations_matrix_diagonal_structure],err,error,*999)
1334  ELSE
1335  SELECT CASE(equations%SPARSITY_TYPE)
1336  CASE(equations_matrices_full_matrices)
1337  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
1338  & [distributed_matrix_block_storage_type,distributed_matrix_block_storage_type], &
1339  & err,error,*999)
1340  CASE(equations_matrices_sparse_matrices)
1341  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
1342  & [distributed_matrix_compressed_row_storage_type,distributed_matrix_compressed_row_storage_type], &
1343  & err,error,*999)
1344  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
1345  & [equations_matrix_fem_structure,equations_matrix_fem_structure],err,error,*999)
1346  CASE DEFAULT
1347  local_error="The equations matrices sparsity type of "// &
1348  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
1349  CALL flagerror(local_error,err,error,*999)
1350  END SELECT
1351  ENDIF
1352  CASE(equations_set_second_bidomain_subtype)
1353  SELECT CASE(equations%SPARSITY_TYPE)
1354  CASE(equations_matrices_full_matrices)
1355  CALL equations_matrices_linear_storage_type_set(equations_matrices,[matrix_block_storage_type], &
1356  & err,error,*999)
1357  CASE(equations_matrices_sparse_matrices)
1358  CALL equations_matrices_linear_storage_type_set(equations_matrices,[matrix_compressed_row_storage_type], &
1359  & err,error,*999)
1360  CALL equationsmatrices_linearstructuretypeset(equations_matrices,[equations_matrix_fem_structure], &
1361  & err,error,*999)
1362  CASE DEFAULT
1363  local_error="The equations matrices sparsity type of "// &
1364  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
1365  CALL flagerror(local_error,err,error,*999)
1366  END SELECT
1367  CASE DEFAULT
1368  local_error="The equations set subtype of "//trim(number_to_vstring(equations_set_spec_subtype,"*",err,error))// &
1369  & " is invalid for a bidomain equation type."
1370  CALL flagerror(local_error,err,error,*999)
1371  END SELECT
1372  CASE DEFAULT
1373  local_error="The equations set type of "//trim(number_to_vstring(equations_set_spec_type,"*",err,error))// &
1374  & " is invalid for a bioelectrics class."
1375  CALL flagerror(local_error,err,error,*999)
1376  END SELECT
1377  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
1378  CASE(equations_set_bem_solution_method)
1379  CALL flagerror("Not implemented.",err,error,*999)
1380  CASE(equations_set_fd_solution_method)
1381  CALL flagerror("Not implemented.",err,error,*999)
1382  CASE(equations_set_fv_solution_method)
1383  CALL flagerror("Not implemented.",err,error,*999)
1384  CASE(equations_set_gfem_solution_method)
1385  CALL flagerror("Not implemented.",err,error,*999)
1386  CASE(equations_set_gfv_solution_method)
1387  CALL flagerror("Not implemented.",err,error,*999)
1388  CASE DEFAULT
1389  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1390  & " is invalid."
1391  CALL flagerror(local_error,err,error,*999)
1392  END SELECT
1393  CASE DEFAULT
1394  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1395  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1396  & " is invalid for a bioelectric domain equation."
1397  CALL flagerror(local_error,err,error,*999)
1398  END SELECT
1399  CASE DEFAULT
1400  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1401  & " is invalid for a bioelectric domain equation."
1402  CALL flagerror(local_error,err,error,*999)
1403  END SELECT
1404  ELSE
1405  CALL flagerror("Equations set is not associated.",err,error,*999)
1406  ENDIF
1407 
1408  exits("Biodomain_EquationsSetSetup")
1409  RETURN
1410 999 errorsexits("Biodomain_EquationsSetSetup",err,error)
1411  RETURN 1
1412 
1413  END SUBROUTINE biodomain_equationssetsetup
1414 
1415  !
1416  !================================================================================================================================
1417  !
1418 
1420  SUBROUTINE biodomain_equationssetsolutionmethodset(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)
1421 
1422  !Argument variables
1423  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1424  INTEGER(INTG), INTENT(IN) :: SOLUTION_METHOD
1425  INTEGER(INTG), INTENT(OUT) :: ERR
1426  TYPE(varying_string), INTENT(OUT) :: ERROR
1427  !Local Variables
1428  TYPE(varying_string) :: LOCAL_ERROR
1429  INTEGER(INTG) :: EQUATIONS_SET_SPEC_TYPE,EQUATIONS_SET_SPEC_SUBTYPE
1430 
1431  enters("Biodomain_EquationsSetSolutionMethodSet",err,error,*999)
1432 
1433  IF(ASSOCIATED(equations_set)) THEN
1434  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
1435  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
1436  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<3) THEN
1437  CALL flagerror("Equations set specification does not have a subtype set.",err,error,*999)
1438  END IF
1439  equations_set_spec_type=equations_set%SPECIFICATION(2)
1440  equations_set_spec_subtype=equations_set%SPECIFICATION(3)
1441  SELECT CASE(equations_set_spec_type)
1442  CASE(equations_set_monodomain_equation_type)
1443  SELECT CASE(equations_set_spec_subtype)
1444  CASE(equations_set_no_subtype,equations_set_1d3d_monodomain_elasticity_subtype, &
1445  & equations_set_monodomain_elasticity_w_titin_subtype,equations_set_monodomain_elasticity_velocity_subtype, &
1446  & equations_set_1d3d_monodomain_active_strain_subtype)
1447  SELECT CASE(solution_method)
1448  CASE(equations_set_fem_solution_method)
1449  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
1450  CASE(equations_set_bem_solution_method)
1451  CALL flagerror("Not implemented.",err,error,*999)
1452  CASE(equations_set_fd_solution_method)
1453  CALL flagerror("Not implemented.",err,error,*999)
1454  CASE(equations_set_fv_solution_method)
1455  CALL flagerror("Not implemented.",err,error,*999)
1456  CASE(equations_set_gfem_solution_method)
1457  CALL flagerror("Not implemented.",err,error,*999)
1458  CASE(equations_set_gfv_solution_method)
1459  CALL flagerror("Not implemented.",err,error,*999)
1460  CASE DEFAULT
1461  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
1462  CALL flagerror(local_error,err,error,*999)
1463  END SELECT
1464  CASE DEFAULT
1465  local_error="Equations set subtype of "//trim(number_to_vstring(equations_set_spec_subtype,"*",err,error))// &
1466  & " is not valid for a bioelectric monodomain equation type of an bioelectrics equations set class."
1467  CALL flagerror(local_error,err,error,*999)
1468  END SELECT
1469  CASE(equations_set_bidomain_equation_type)
1470  SELECT CASE(equations_set_spec_subtype)
1471  CASE(equations_set_first_bidomain_subtype)
1472  SELECT CASE(solution_method)
1473  CASE(equations_set_fem_solution_method)
1474  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
1475  CASE(equations_set_bem_solution_method)
1476  CALL flagerror("Not implemented.",err,error,*999)
1477  CASE(equations_set_fd_solution_method)
1478  CALL flagerror("Not implemented.",err,error,*999)
1479  CASE(equations_set_fv_solution_method)
1480  CALL flagerror("Not implemented.",err,error,*999)
1481  CASE(equations_set_gfem_solution_method)
1482  CALL flagerror("Not implemented.",err,error,*999)
1483  CASE(equations_set_gfv_solution_method)
1484  CALL flagerror("Not implemented.",err,error,*999)
1485  CASE DEFAULT
1486  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
1487  CALL flagerror(local_error,err,error,*999)
1488  END SELECT
1489  CASE(equations_set_second_bidomain_subtype)
1490  SELECT CASE(solution_method)
1491  CASE(equations_set_fem_solution_method)
1492  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
1493  CASE(equations_set_bem_solution_method)
1494  CALL flagerror("Not implemented.",err,error,*999)
1495  CASE(equations_set_fd_solution_method)
1496  CALL flagerror("Not implemented.",err,error,*999)
1497  CASE(equations_set_fv_solution_method)
1498  CALL flagerror("Not implemented.",err,error,*999)
1499  CASE(equations_set_gfem_solution_method)
1500  CALL flagerror("Not implemented.",err,error,*999)
1501  CASE(equations_set_gfv_solution_method)
1502  CALL flagerror("Not implemented.",err,error,*999)
1503  CASE DEFAULT
1504  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
1505  CALL flagerror(local_error,err,error,*999)
1506  END SELECT
1507  CASE DEFAULT
1508  local_error="Equations set subtype of "//trim(number_to_vstring(equations_set_spec_subtype,"*",err,error))// &
1509  & " is not valid for a bioelectric bidomain equation type of an bioelectrics equations set class."
1510  CALL flagerror(local_error,err,error,*999)
1511  END SELECT
1512  CASE DEFAULT
1513  local_error="Equations set type of "//trim(number_to_vstring(equations_set_spec_type,"*",err,error))// &
1514  & " is not valid for a bioelectrics equations set class."
1515  CALL flagerror(local_error,err,error,*999)
1516  END SELECT
1517  ELSE
1518  CALL flagerror("Equations set is not associated.",err,error,*999)
1519  ENDIF
1520 
1521  exits("Biodomain_EquationsSetSolutionMethodSet")
1522  RETURN
1523 999 errors("Biodomain_EquationsSetSolutionMethodSet",err,error)
1524  exits("Biodomain_EquationsSetSolutionMethodSet")
1525  RETURN 1
1526 
1527  END SUBROUTINE biodomain_equationssetsolutionmethodset
1528 
1529  !
1530  !================================================================================================================================
1531  !
1532 
1534  SUBROUTINE biodomain_equationssetspecificationset(equationsSet,specification,err,error,*)
1535 
1536  !Argument variables
1537  TYPE(equations_set_type), POINTER :: equationsSet
1538  INTEGER(INTG), INTENT(IN) :: specification(:)
1539  INTEGER(INTG), INTENT(OUT) :: err
1540  TYPE(varying_string), INTENT(OUT) :: error
1541  !Local Variables
1542  TYPE(varying_string) :: localError
1543  INTEGER(INTG) :: equationsSetType,equationsSetSubtype
1544 
1545  enters("BiodomainEquation_EquationsSetSpecificationSet",err,error,*999)
1546 
1547  IF(ASSOCIATED(equationsset)) THEN
1548  IF(SIZE(specification,1)/=3) THEN
1549  CALL flagerror("Equations set specification must have three entries for a biodomain equation type equations set.", &
1550  & err,error,*999)
1551  END IF
1552  equationssettype=specification(2)
1553  equationssetsubtype=specification(3)
1554  SELECT CASE(equationssettype)
1555  CASE(equations_set_monodomain_equation_type)
1556  SELECT CASE(equationssetsubtype)
1557  CASE(equations_set_no_subtype)
1558  !ok
1559  CASE(equations_set_1d3d_monodomain_elasticity_subtype, &
1560  & equations_set_monodomain_elasticity_w_titin_subtype, &
1561  & equations_set_monodomain_elasticity_velocity_subtype, &
1562  & equations_set_1d3d_monodomain_active_strain_subtype)
1563  !ok
1564  CASE DEFAULT
1565  localerror="The third equations set specification of "//trim(numbertovstring(equationssetsubtype,"*",err,error))// &
1566  & " is not valid for a monodomain type of a bioelectric equations set."
1567  CALL flagerror(localerror,err,error,*999)
1568  END SELECT
1569  CASE(equations_set_bidomain_equation_type)
1570  SELECT CASE(equationssetsubtype)
1571  CASE(equations_set_first_bidomain_subtype)
1572  !ok
1573  CASE(equations_set_second_bidomain_subtype)
1574  !ok
1575  CASE DEFAULT
1576  localerror="The third equations set specification of "//trim(numbertovstring(equationssetsubtype,"*",err,error))// &
1577  & " is not valid for a bidomain equation type of a bioelectric equations set class."
1578  CALL flagerror(localerror,err,error,*999)
1579  END SELECT
1580  CASE DEFAULT
1581  localerror="The second equations set specification of "//trim(numbertovstring(equationssettype,"*",err,error))// &
1582  & " is not valid for a bioelectric equations set."
1583  CALL flagerror(localerror,err,error,*999)
1584  END SELECT
1585  !Set full specification
1586  IF(ALLOCATED(equationsset%specification)) THEN
1587  CALL flagerror("Equations set specification is already allocated.",err,error,*999)
1588  ELSE
1589  ALLOCATE(equationsset%specification(3),stat=err)
1590  IF(err/=0) CALL flagerror("Could not allocate equations set specification.",err,error,*999)
1591  END IF
1592  equationsset%specification(1:3)=[equations_set_bioelectrics_class,equationssettype,equationssetsubtype]
1593  ELSE
1594  CALL flagerror("Equations set is not associated.",err,error,*999)
1595  END IF
1596 
1597  exits("Biodomain_EquationsSetSpecificationSet")
1598  RETURN
1599 999 errors("Biodomain_EquationsSetSpecificationSet",err,error)
1600  exits("Biodomain_EquationsSetSpecificationSet")
1601  RETURN 1
1602 
1603  END SUBROUTINE biodomain_equationssetspecificationset
1604 
1605  !
1606  !================================================================================================================================
1607  !
1608 
1610  SUBROUTINE biodomain_pre_solve(SOLVER,ERR,ERROR,*)
1611 
1612  !Argument variables
1613  TYPE(solver_type), POINTER :: SOLVER
1614  INTEGER(INTG), INTENT(OUT) :: ERR
1615  TYPE(varying_string), INTENT(OUT) :: ERROR
1616  !Local Variables
1617  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT
1618  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1619  TYPE(problem_type), POINTER :: PROBLEM
1620  TYPE(solvers_type), POINTER :: SOLVERS
1621  TYPE(varying_string) :: LOCAL_ERROR
1622 
1623  enters("BIODOMAIN_PRE_SOLVE",err,error,*999)
1624 
1625  IF(ASSOCIATED(solver)) THEN
1626  solvers=>solver%SOLVERS
1627  IF(ASSOCIATED(solvers)) THEN
1628  control_loop=>solvers%CONTROL_LOOP
1629  IF(ASSOCIATED(control_loop)) THEN
1630  CALL control_loop_current_times_get(control_loop,current_time,time_increment,err,error,*999)
1631  problem=>control_loop%PROBLEM
1632  IF(ASSOCIATED(problem)) THEN
1633  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
1634  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1635  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
1636  CALL flagerror("Problem specification must have three entries for a biodomain problem.",err,error,*999)
1637  END IF
1638  SELECT CASE(problem%SPECIFICATION(2))
1639  CASE(problem_monodomain_equation_type)
1640  SELECT CASE(problem%SPECIFICATION(3))
1641  CASE(problem_monodomain_gudunov_split_subtype)
1642  SELECT CASE(solver%GLOBAL_NUMBER)
1643  CASE(1)
1644  CALL solver_dae_times_set(solver,current_time,current_time+time_increment,err,error,*999)
1645  CASE(2)
1646  !Do nothing
1647  CASE DEFAULT
1648  local_error="The solver global number of "//trim(number_to_vstring(solver%GLOBAL_NUMBER,"*",err,error))// &
1649  & " is invalid for a Gudunov split monodomain problem."
1650  CALL flagerror(local_error,err,error,*999)
1651  END SELECT
1652  CASE(problem_monodomain_strang_split_subtype)
1653  SELECT CASE(solver%GLOBAL_NUMBER)
1654  CASE(1)
1655  CALL solver_dae_times_set(solver,current_time,current_time+time_increment/2.0_dp,err,error,*999)
1656  CASE(2)
1657  !Do nothing
1658  CASE(3)
1659  CALL solver_dae_times_set(solver,current_time+time_increment/2.0_dp,current_time+time_increment, &
1660  & err,error,*999)
1661  CASE DEFAULT
1662  local_error="The solver global number of "//trim(number_to_vstring(solver%GLOBAL_NUMBER,"*",err,error))// &
1663  & " is invalid for a Strang split monodomain problem."
1664  CALL flagerror(local_error,err,error,*999)
1665  END SELECT
1666  CASE DEFAULT
1667  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
1668  & " is invalid for a monodomain problem type."
1669  CALL flagerror(local_error,err,error,*999)
1670  END SELECT
1671  CASE(problem_bidomain_equation_type)
1672  SELECT CASE(problem%SPECIFICATION(3))
1673  CASE(problem_bidomain_gudunov_split_subtype)
1674  SELECT CASE(solver%GLOBAL_NUMBER)
1675  CASE(1)
1676  CALL solver_dae_times_set(solver,current_time,current_time+time_increment,err,error,*999)
1677  CASE(2)
1678  !Do nothing
1679  CASE(3)
1680  !Do nothing
1681  CASE DEFAULT
1682  local_error="The solver global number of "//trim(number_to_vstring(solver%GLOBAL_NUMBER,"*",err,error))// &
1683  & " is invalid for a Gudunov split bidomain problem."
1684  CALL flagerror(local_error,err,error,*999)
1685  END SELECT
1686  CASE(problem_bidomain_strang_split_subtype)
1687  SELECT CASE(solver%GLOBAL_NUMBER)
1688  CASE(1)
1689  CALL solver_dae_times_set(solver,current_time,current_time+time_increment/2.0_dp,err,error,*999)
1690  CASE(2)
1691  !Do nothing
1692  CASE(3)
1693  !Do nothing
1694  CASE(4)
1695  CALL solver_dae_times_set(solver,current_time+time_increment/2.0_dp,current_time+time_increment, &
1696  & err,error,*999)
1697  CASE DEFAULT
1698  local_error="The solver global number of "//trim(number_to_vstring(solver%GLOBAL_NUMBER,"*",err,error))// &
1699  & " is invalid for a Gudunov split bidomain problem."
1700  CALL flagerror(local_error,err,error,*999)
1701  END SELECT
1702  CASE DEFAULT
1703  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
1704  & " is invalid for a bidomain problem type."
1705  CALL flagerror(local_error,err,error,*999)
1706  END SELECT
1707  CASE(problem_bioelectric_finite_elasticity_type)
1708  SELECT CASE(problem%SPECIFICATION(3))
1709  CASE(problem_gudunov_monodomain_simple_elasticity_subtype,problem_gudunov_monodomain_1d3d_elasticity_subtype, &
1710  & problem_monodomain_elasticity_w_titin_subtype,equations_set_monodomain_elasticity_velocity_subtype, &
1711  & problem_monodomain_1d3d_active_strain_subtype)
1712  SELECT CASE(solver%GLOBAL_NUMBER)
1713  CASE(1)
1714  CALL solver_dae_times_set(solver,current_time,current_time+time_increment,err,error,*999)
1715  CASE(2)
1716  !Do nothing
1717  CASE DEFAULT
1718  local_error="The solver global number of "//trim(number_to_vstring(solver%GLOBAL_NUMBER,"*",err,error))// &
1719  & " is invalid for a bioelectrics finite elasticity problem."
1720  CALL flagerror(local_error,err,error,*999)
1721  END SELECT
1722  CASE DEFAULT
1723  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
1724  & " is invalid for a monodomain problem type."
1725  CALL flagerror(local_error,err,error,*999)
1726  END SELECT
1727  CASE DEFAULT
1728  local_error="The problem type of "//trim(number_to_vstring(problem%SPECIFICATION(2),"*",err,error))// &
1729  & " is invalid."
1730  CALL flagerror(local_error,err,error,*999)
1731  END SELECT
1732  ELSE
1733  CALL flagerror("Control loop problem is not associated.",err,error,*999)
1734  ENDIF
1735  ELSE
1736  CALL flagerror("Solvers control loop is not associated.",err,error,*999)
1737  ENDIF
1738  ELSE
1739  CALL flagerror("Solver solvers is not associated.",err,error,*999)
1740  ENDIF
1741  ELSE
1742  CALL flagerror("Solver is not associated.",err,error,*999)
1743  ENDIF
1744 
1745  exits("BIODOMAIN_PRE_SOLVE")
1746  RETURN
1747 999 errorsexits("BIODOMAIN_PRE_SOLVE",err,error)
1748  RETURN 1
1749 
1750  END SUBROUTINE biodomain_pre_solve
1751 
1752  !
1753  !================================================================================================================================
1754  !
1755 
1757  SUBROUTINE biodomain_equation_problem_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
1758 
1759  !Argument variables
1760  TYPE(problem_type), POINTER :: PROBLEM
1761  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
1762  INTEGER(INTG), INTENT(OUT) :: ERR
1763  TYPE(varying_string), INTENT(OUT) :: ERROR
1764  !Local Variables
1765  TYPE(cellml_equations_type), POINTER :: CELLML_EQUATIONS
1766  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT
1767  TYPE(solver_type), POINTER :: SOLVER
1768  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
1769  TYPE(solvers_type), POINTER :: SOLVERS
1770  TYPE(varying_string) :: LOCAL_ERROR
1771 
1772  NULLIFY(cellml_equations)
1773  NULLIFY(control_loop)
1774  NULLIFY(solver)
1775  NULLIFY(solvers)
1776  NULLIFY(solver_equations)
1777 
1778  enters("BIODOMAIN_EQUATION_PROBLEM_SETUP",err,error,*999)
1779 
1780  IF(ASSOCIATED(problem)) THEN
1781  SELECT CASE(problem_setup%SETUP_TYPE)
1782  CASE(problem_setup_initial_type)
1783  SELECT CASE(problem_setup%ACTION_TYPE)
1784  CASE(problem_setup_start_action)
1785  !Do nothing????
1786  CASE(problem_setup_finish_action)
1787  !Do nothing????
1788  CASE DEFAULT
1789  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1790  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1791  & " is invalid for a bioelectric domain equation."
1792  CALL flagerror(local_error,err,error,*999)
1793  END SELECT
1794  CASE(problem_setup_control_type)
1795  SELECT CASE(problem_setup%ACTION_TYPE)
1796  CASE(problem_setup_start_action)
1797  !Set up a time control loop
1798  CALL control_loop_create_start(problem,control_loop,err,error,*999)
1799  CALL control_loop_type_set(control_loop,problem_control_time_loop_type,err,error,*999)
1800  CALL control_loop_label_set(control_loop,"Time Loop",err,error,*999)
1801  CASE(problem_setup_finish_action)
1802  !Finish the control loops
1803  control_loop_root=>problem%CONTROL_LOOP
1804  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1805  CALL control_loop_create_finish(control_loop,err,error,*999)
1806  CASE DEFAULT
1807  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1808  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1809  & " is invalid for a bioelectric domain equation."
1810  CALL flagerror(local_error,err,error,*999)
1811  END SELECT
1812  CASE(problem_setup_solvers_type)
1813  !Get the control loop
1814  control_loop_root=>problem%CONTROL_LOOP
1815  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1816  SELECT CASE(problem_setup%ACTION_TYPE)
1817  CASE(problem_setup_start_action)
1818  !Start the solvers creation
1819  CALL solvers_create_start(control_loop,solvers,err,error,*999)
1820  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
1821  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1822  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
1823  CALL flagerror("Problem specification must have three entries for a biodomain problem.",err,error,*999)
1824  END IF
1825  SELECT CASE(problem%SPECIFICATION(2))
1826  CASE(problem_monodomain_equation_type)
1827  SELECT CASE(problem%SPECIFICATION(3))
1828  CASE(problem_monodomain_gudunov_split_subtype)
1829  CALL solvers_number_set(solvers,2,err,error,*999)
1830  !Set the first solver to be a differential-algebraic equations solver
1831  NULLIFY(solver)
1832  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1833  CALL solver_type_set(solver,solver_dae_type,err,error,*999)
1834  CALL solver_label_set(solver,"ODE Solver",err,error,*999)
1835  !Set solver defaults
1836  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
1837  !Set the second solver to be a dynamic solver
1838  NULLIFY(solver)
1839  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
1840  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
1841  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
1842  CALL solver_label_set(solver,"Parabolic solver",err,error,*999)
1843  !Set solver defaults
1844  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
1845  CALL solver_dynamic_scheme_set(solver,solver_dynamic_crank_nicolson_scheme,err,error,*999)
1846  CALL solver_dynamic_restart_set(solver,.true.,err,error,*999)
1847  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
1848  CASE(problem_monodomain_strang_split_subtype)
1849  CALL solvers_number_set(solvers,3,err,error,*999)
1850  !Set the first solver to be a differential-algebraic equations solver
1851  NULLIFY(solver)
1852  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1853  CALL solver_type_set(solver,solver_dae_type,err,error,*999)
1854  CALL solver_label_set(solver,"First ODE solver",err,error,*999)
1855  !Set solver defaults
1856  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
1857  !Set the second solver to be a dynamic solver
1858  NULLIFY(solver)
1859  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
1860  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
1861  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
1862  CALL solver_label_set(solver,"Parabolic solver",err,error,*999)
1863  !Set solver defaults
1864  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
1865  CALL solver_dynamic_scheme_set(solver,solver_dynamic_crank_nicolson_scheme,err,error,*999)
1866  CALL solver_dynamic_restart_set(solver,.true.,err,error,*999)
1867  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
1868  !Set the third solver to be a differential-algebraic equations solver
1869  NULLIFY(solver)
1870  CALL solvers_solver_get(solvers,3,solver,err,error,*999)
1871  CALL solver_type_set(solver,solver_dae_type,err,error,*999)
1872  CALL solver_label_set(solver,"Second ODE solver",err,error,*999)
1873  !Set solver defaults
1874  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
1875  CASE DEFAULT
1876  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
1877  & " is invalid for a monodomain problem type of a bioelectric problem class."
1878  CALL flagerror(local_error,err,error,*999)
1879  END SELECT
1880  CASE(problem_bidomain_equation_type)
1881  SELECT CASE(problem%SPECIFICATION(3))
1882  CASE(problem_bidomain_gudunov_split_subtype)
1883  CALL solvers_number_set(solvers,3,err,error,*999)
1884  !Set the first solver to be a differential-algebraic equations solver
1885  NULLIFY(solver)
1886  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1887  CALL solver_type_set(solver,solver_dae_type,err,error,*999)
1888  CALL solver_label_set(solver,"ODE solver",err,error,*999)
1889  !Set solver defaults
1890  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
1891  !Set the second solver to be a dynamic solver
1892  NULLIFY(solver)
1893  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
1894  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
1895  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
1896  CALL solver_label_set(solver,"Parabolic solver",err,error,*999)
1897  !Set solver defaults
1898  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
1899  CALL solver_dynamic_scheme_set(solver,solver_dynamic_crank_nicolson_scheme,err,error,*999)
1900  CALL solver_dynamic_restart_set(solver,.true.,err,error,*999)
1901  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
1902  !Set the third solver to be a linear solver
1903  NULLIFY(solver)
1904  CALL solvers_solver_get(solvers,3,solver,err,error,*999)
1905  CALL solver_type_set(solver,solver_linear_type,err,error,*999)
1906  CALL solver_label_set(solver,"Elliptic solver",err,error,*999)
1907  !Set solver defaults
1908  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
1909  CASE(problem_bidomain_strang_split_subtype)
1910  CALL solvers_number_set(solvers,4,err,error,*999)
1911  !Set the first solver to be a differential-algebraic equations solver
1912  NULLIFY(solver)
1913  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1914  CALL solver_type_set(solver,solver_dae_type,err,error,*999)
1915  CALL solver_label_set(solver,"First ODE solver",err,error,*999)
1916  !Set solver defaults
1917  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
1918  !Set the second solver to be a dynamic solver
1919  NULLIFY(solver)
1920  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
1921  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
1922  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
1923  CALL solver_label_set(solver,"Parabolic solver",err,error,*999)
1924  !Set solver defaults
1925  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
1926  CALL solver_dynamic_scheme_set(solver,solver_dynamic_crank_nicolson_scheme,err,error,*999)
1927  CALL solver_dynamic_restart_set(solver,.true.,err,error,*999)
1928  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
1929  !Set the third solver to be a differential-algebraic equations solver
1930  NULLIFY(solver)
1931  CALL solvers_solver_get(solvers,3,solver,err,error,*999)
1932  CALL solver_type_set(solver,solver_dae_type,err,error,*999)
1933  CALL solver_label_set(solver,"Second ODE solver",err,error,*999)
1934  !Set solver defaults
1935  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
1936  !Set the fourth solver to be a linear solver
1937  NULLIFY(solver)
1938  CALL solvers_solver_get(solvers,4,solver,err,error,*999)
1939  CALL solver_type_set(solver,solver_linear_type,err,error,*999)
1940  CALL solver_label_set(solver,"Elliptic solver",err,error,*999)
1941  !Set solver defaults
1942  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
1943  CASE DEFAULT
1944  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
1945  & " is invalid for a monodomain problem type of a bioelectric problem class."
1946  CALL flagerror(local_error,err,error,*999)
1947  END SELECT
1948  CASE DEFAULT
1949  local_error="The problem type of "//trim(number_to_vstring(problem%SPECIFICATION(2),"*",err,error))// &
1950  & " is invalid for a bioelectric problem class."
1951  CALL flagerror(local_error,err,error,*999)
1952  END SELECT
1953  CASE(problem_setup_finish_action)
1954  !Get the solvers
1955  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
1956  !Finish the solvers creation
1957  CALL solvers_create_finish(solvers,err,error,*999)
1958  CASE DEFAULT
1959  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1960  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1961  & " is invalid for a bioelectric equation."
1962  CALL flagerror(local_error,err,error,*999)
1963  END SELECT
1964  CASE(problem_setup_solver_equations_type)
1965  SELECT CASE(problem_setup%ACTION_TYPE)
1966  CASE(problem_setup_start_action)
1967  !Get the control loop
1968  control_loop_root=>problem%CONTROL_LOOP
1969  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1970  !Get the solver
1971  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
1972  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
1973  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1974  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
1975  CALL flagerror("Problem specification must have three entries for a biodomain problem.",err,error,*999)
1976  END IF
1977  SELECT CASE(problem%SPECIFICATION(2))
1978  CASE(problem_monodomain_equation_type)
1979  !Create the solver equations for the second (parabolic) solver
1980  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
1981  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
1982  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
1983  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_first_order_dynamic,err,error,*999)
1984  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
1985  CASE(problem_bidomain_equation_type)
1986  !Create the solver equations for the second (parabolic) solver
1987  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
1988  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
1989  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
1990  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_first_order_dynamic,err,error,*999)
1991  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
1992  !Create the solver equations for the elliptic solver
1993  NULLIFY(solver)
1994  NULLIFY(solver_equations)
1995  SELECT CASE(problem%SPECIFICATION(3))
1996  CASE(problem_bidomain_gudunov_split_subtype)
1997  CALL solvers_solver_get(solvers,3,solver,err,error,*999)
1998  CASE(problem_bidomain_strang_split_subtype)
1999  CALL solvers_solver_get(solvers,4,solver,err,error,*999)
2000  CASE DEFAULT
2001  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
2002  & " is invalid for a bidomain problem type."
2003  CALL flagerror(local_error,err,error,*999)
2004  END SELECT
2005  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
2006  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
2007  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
2008  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
2009  CASE DEFAULT
2010  local_error="The problem type of "//trim(number_to_vstring(problem%SPECIFICATION(2),"*",err,error))// &
2011  & " is invalid for a bioelectric problem class."
2012  CALL flagerror(local_error,err,error,*999)
2013  END SELECT
2014  CASE(problem_setup_finish_action)
2015  !Get the control loop
2016  control_loop_root=>problem%CONTROL_LOOP
2017  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
2018  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
2019  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
2020  CALL flagerror("Problem specification is not allocated.",err,error,*999)
2021  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
2022  CALL flagerror("Problem specification must have three entries for a biodomain problem.",err,error,*999)
2023  END IF
2024  SELECT CASE(problem%SPECIFICATION(2))
2025  CASE(problem_monodomain_equation_type)
2026  !Get the solver equations for the second (parabolic) solver
2027  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
2028  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
2029  !Finish the solver equations creation
2030  CALL solver_equations_create_finish(solver_equations,err,error,*999)
2031  CASE(problem_bidomain_equation_type)
2032  !Get the solver equations for the second (parabolic) solver
2033  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
2034  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
2035  !Finish the solver equations creation
2036  CALL solver_equations_create_finish(solver_equations,err,error,*999)
2037  !Get the solver equations for the elliptic solver
2038  NULLIFY(solver)
2039  NULLIFY(solver_equations)
2040  SELECT CASE(problem%SPECIFICATION(3))
2041  CASE(problem_bidomain_gudunov_split_subtype)
2042  CALL solvers_solver_get(solvers,3,solver,err,error,*999)
2043  CASE(problem_bidomain_strang_split_subtype)
2044  CALL solvers_solver_get(solvers,4,solver,err,error,*999)
2045  CASE DEFAULT
2046  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
2047  & " is invalid for a bidomain problem type."
2048  CALL flagerror(local_error,err,error,*999)
2049  END SELECT
2050  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
2051  !Finish the solver equations creation
2052  CALL solver_equations_create_finish(solver_equations,err,error,*999)
2053  CASE DEFAULT
2054  local_error="The problem type of "//trim(number_to_vstring(problem%SPECIFICATION(2),"*",err,error))// &
2055  & " is invalid for a bioelectric problem class."
2056  CALL flagerror(local_error,err,error,*999)
2057  END SELECT
2058  CASE DEFAULT
2059  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
2060  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
2061  & " is invalid for a bioelectric equation."
2062  CALL flagerror(local_error,err,error,*999)
2063  END SELECT
2064  CASE(problem_setup_cellml_equations_type)
2065  SELECT CASE(problem_setup%ACTION_TYPE)
2066  CASE(problem_setup_start_action)
2067  !Get the control loop
2068  control_loop_root=>problem%CONTROL_LOOP
2069  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
2070  !Get the solver
2071  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
2072  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
2073  CALL flagerror("Problem specification is not allocated.",err,error,*999)
2074  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
2075  CALL flagerror("Problem specification must have three entries for a biodomain problem.",err,error,*999)
2076  END IF
2077  SELECT CASE(problem%SPECIFICATION(2))
2078  CASE(problem_monodomain_equation_type)
2079  !Create the CellML equations for the first DAE solver
2080  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
2081  CALL cellml_equations_create_start(solver,cellml_equations,err,error,*999)
2082  IF(problem%SPECIFICATION(3)==problem_monodomain_strang_split_subtype) THEN
2083  !Create the CellML equations for the second DAE solver
2084  NULLIFY(solver)
2085  NULLIFY(cellml_equations)
2086  CALL solvers_solver_get(solvers,3,solver,err,error,*999)
2087  CALL cellml_equations_create_start(solver,cellml_equations,err,error,*999)
2088  ENDIF
2089  CASE(problem_bidomain_equation_type)
2090  !Create the CellML equations for the first DAE solver
2091  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
2092  CALL cellml_equations_create_start(solver,cellml_equations,err,error,*999)
2093  IF(problem%SPECIFICATION(3)==problem_bidomain_strang_split_subtype) THEN
2094  !Create the CellML equations for the second DAE solver
2095  NULLIFY(solver)
2096  NULLIFY(cellml_equations)
2097  CALL solvers_solver_get(solvers,4,solver,err,error,*999)
2098  CALL cellml_equations_create_start(solver,cellml_equations,err,error,*999)
2099  ENDIF
2100  CASE DEFAULT
2101  local_error="The problem type of "//trim(number_to_vstring(problem%SPECIFICATION(2),"*",err,error))// &
2102  & " is invalid for a bioelectric problem class."
2103  CALL flagerror(local_error,err,error,*999)
2104  END SELECT
2105  CASE(problem_setup_finish_action)
2106  !Get the control loop
2107  control_loop_root=>problem%CONTROL_LOOP
2108  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
2109  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
2110  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
2111  CALL flagerror("Problem specification is not allocated.",err,error,*999)
2112  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
2113  CALL flagerror("Problem specification must have three entries for a biodomain problem.",err,error,*999)
2114  END IF
2115  SELECT CASE(problem%SPECIFICATION(2))
2116  CASE(problem_monodomain_equation_type)
2117  !Get the CellML equations for the first DAE solver
2118  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
2119  CALL solver_cellml_equations_get(solver,cellml_equations,err,error,*999)
2120  !Finish the CellML equations creation
2121  CALL cellml_equations_create_finish(cellml_equations,err,error,*999)
2122  IF(problem%SPECIFICATION(3)==problem_monodomain_strang_split_subtype) THEN
2123  !Get the CellML equations for the second DAE solver
2124  NULLIFY(solver)
2125  NULLIFY(cellml_equations)
2126  CALL solvers_solver_get(solvers,3,solver,err,error,*999)
2127  CALL solver_cellml_equations_get(solver,cellml_equations,err,error,*999)
2128  !Finish the CellML equations creation
2129  CALL cellml_equations_create_finish(cellml_equations,err,error,*999)
2130  ENDIF
2131  CASE(problem_bidomain_equation_type)
2132  !Get the CellML equations for the first DAE solver
2133  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
2134  CALL solver_cellml_equations_get(solver,cellml_equations,err,error,*999)
2135  !Finish the CellML equations creation
2136  CALL cellml_equations_create_finish(cellml_equations,err,error,*999)
2137  IF(problem%SPECIFICATION(3)==problem_bidomain_strang_split_subtype) THEN
2138  !Get the CellML equations for the second DAE solver
2139  NULLIFY(solver)
2140  NULLIFY(cellml_equations)
2141  CALL solvers_solver_get(solvers,4,solver,err,error,*999)
2142  CALL solver_cellml_equations_get(solver,cellml_equations,err,error,*999)
2143  !Finish the CellML equations creation
2144  CALL cellml_equations_create_finish(cellml_equations,err,error,*999)
2145  ENDIF
2146  CASE DEFAULT
2147  local_error="The problem type of "//trim(number_to_vstring(problem%SPECIFICATION(2),"*",err,error))// &
2148  & " is invalid for a bioelectric problem class."
2149  CALL flagerror(local_error,err,error,*999)
2150  END SELECT
2151  CASE DEFAULT
2152  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
2153  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
2154  & " is invalid for a bioelectric equation."
2155  CALL flagerror(local_error,err,error,*999)
2156  END SELECT
2157  CASE DEFAULT
2158  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
2159  & " is invalid for a bioelectric domain equation."
2160  CALL flagerror(local_error,err,error,*999)
2161  END SELECT
2162  ELSE
2163  CALL flagerror("Problem is not associated.",err,error,*999)
2164  ENDIF
2165 
2166  exits("BIODOMAIN_EQUATION_PROBLEM_SETUP")
2167  RETURN
2168 999 errorsexits("BIODOMAIN_EQUATION_PROBLEM_SETUP",err,error)
2169  RETURN 1
2170  END SUBROUTINE biodomain_equation_problem_setup
2171 
2172  !
2173  !================================================================================================================================
2174  !
2175 
2177  SUBROUTINE biodomain_problemspecificationset(problem,problemSpecification,err,error,*)
2178 
2179  !Argument variables
2180  TYPE(problem_type), POINTER, INTENT(IN) :: problem
2181  INTEGER(INTG), INTENT(IN) :: problemSpecification(:)
2182  INTEGER(INTG), INTENT(OUT) :: err
2183  TYPE(varying_string), INTENT(OUT) :: error
2184  !Local Variables
2185  TYPE(varying_string) :: localError
2186  INTEGER(INTG) :: problemType
2187  INTEGER(INTG) :: problemSubtype
2188 
2189  enters("Biodomain_ProblemSpecificationSet",err,error,*999)
2190 
2191  IF(ASSOCIATED(problem)) THEN
2192  IF(SIZE(problemspecification,1)==3) THEN
2193  problemtype=problemspecification(2)
2194  problemsubtype=problemspecification(3)
2195  SELECT CASE(problemtype)
2196  CASE(problem_monodomain_equation_type)
2197  SELECT CASE(problemsubtype)
2198  CASE(problem_monodomain_gudunov_split_subtype, &
2199  & problem_monodomain_strang_split_subtype)
2200  !ok
2201  CASE DEFAULT
2202  localerror="The third problem specification of "//trim(numbertovstring(problemsubtype,"*",err,error))// &
2203  & " is not valid for a monodomain type of a bioelectric problem."
2204  CALL flagerror(localerror,err,error,*999)
2205  END SELECT
2206  CASE(problem_bidomain_equation_type)
2207  SELECT CASE(problemsubtype)
2208  CASE(problem_bidomain_gudunov_split_subtype, &
2209  & problem_bidomain_strang_split_subtype)
2210  !ok
2211  CASE DEFAULT
2212  localerror="The third problem specification of "//trim(numbertovstring(problemsubtype,"*",err,error))// &
2213  & " is not valid for a bidomain type of a bioelectric problem."
2214  CALL flagerror(localerror,err,error,*999)
2215  END SELECT
2216  CASE DEFAULT
2217  localerror="The second problem specification of "//trim(numbertovstring(problemtype,"*",err,error))// &
2218  & " is not valid for a bioelectric problem."
2219  CALL flagerror(localerror,err,error,*999)
2220  END SELECT
2221  IF(ALLOCATED(problem%specification)) THEN
2222  CALL flagerror("Problem specification is already allocated.",err,error,*999)
2223  ELSE
2224  ALLOCATE(problem%specification(3),stat=err)
2225  IF(err/=0) CALL flagerror("Could not allocate problem specification.",err,error,*999)
2226  END IF
2227  problem%specification(1:3)=[problem_bioelectrics_class,problemtype,problemsubtype]
2228  ELSE
2229  CALL flagerror("Biodomain problem specification must have three entries.",err,error,*999)
2230  END IF
2231  ELSE
2232  CALL flagerror("Problem is not associated.",err,error,*999)
2233  END IF
2234 
2235  exits("Biodomain_ProblemSpecificationSet")
2236  RETURN
2237 999 errors("Biodomain_ProblemSpecificationSet",err,error)
2238  exits("Biodomain_ProblemSpecificationSet")
2239  RETURN 1
2240 
2241  END SUBROUTINE biodomain_problemspecificationset
2242 
2243  !
2244  !================================================================================================================================
2245  !
2246 
2248  SUBROUTINE biodomain_equation_finite_element_calculate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
2249 
2250  !Argument variables
2251  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2252  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
2253  INTEGER(INTG), INTENT(OUT) :: ERR
2254  TYPE(varying_string), INTENT(OUT) :: ERROR
2255  !Local Variables
2256  INTEGER(INTG) FIELD_VAR_TYPE,mh,mhs,ms,ng,nh,nhs,ni,nj,ns
2257  LOGICAL :: USE_FIBRES
2258  REAL(DP) :: CONDUCTIVITY(3,3),DPHIDX(3,64),RWG,SUM
2259  TYPE(basis_type), POINTER :: DEPENDENT_BASIS,GEOMETRIC_BASIS,FIBRE_BASIS
2260  TYPE(equations_type), POINTER :: EQUATIONS
2261  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2262  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
2263  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
2264  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
2265  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
2266  TYPE(equations_matrix_type), POINTER :: DAMPING_MATRIX,STIFFNESS_MATRIX
2267  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD,FIBRE_FIELD,MATERIALS_FIELD
2268  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE,GEOMETRIC_VARIABLE
2269  TYPE(quadrature_scheme_type), POINTER :: QUADRATURE_SCHEME
2270  TYPE(varying_string) :: LOCAL_ERROR
2271 
2272  enters("BIODOMAIN_EQUATION_FINITE_ELEMENT_CALCULATE",err,error,*999)
2273 
2274  IF(ASSOCIATED(equations_set)) THEN
2275  equations=>equations_set%EQUATIONS
2276  IF(ASSOCIATED(equations)) THEN
2277 
2278  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
2279  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
2280  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
2281  fibre_field=>equations%INTERPOLATION%FIBRE_FIELD
2282  use_fibres=ASSOCIATED(fibre_field)
2283  equations_mapping=>equations%EQUATIONS_MAPPING
2284  equations_matrices=>equations%EQUATIONS_MATRICES
2285  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
2286  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2287  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
2288  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2289  geometric_variable=>geometric_field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
2290  IF(use_fibres) fibre_basis=>fibre_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
2291  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
2292  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
2293  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
2294  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
2295  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
2296  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
2297  IF(use_fibres) CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations% &
2298  & interpolation%FIBRE_INTERP_PARAMETERS(field_u_variable_type)%PTR,err,error,*999)
2299 
2300  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
2301  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
2302  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<2) THEN
2303  CALL flagerror("Equations set specification does not have a type set.",err,error,*999)
2304  END IF
2305  SELECT CASE(equations_set%SPECIFICATION(2))
2306  CASE(equations_set_monodomain_equation_type)
2307 
2308  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
2309  stiffness_matrix=>dynamic_matrices%MATRICES(1)%PTR
2310  damping_matrix=>dynamic_matrices%MATRICES(2)%PTR
2311  rhs_vector=>equations_matrices%RHS_VECTOR
2312  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
2313  field_variable=>dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(1)%VARIABLE
2314  field_var_type=field_variable%VARIABLE_TYPE
2315 
2316  IF(stiffness_matrix%UPDATE_MATRIX.OR.damping_matrix%UPDATE_MATRIX.OR.rhs_vector%UPDATE_VECTOR) THEN
2317  !Loop over gauss points
2318  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
2319  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
2320  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
2321  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
2322  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
2323  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
2324  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
2325  IF(use_fibres) THEN
2326  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
2327  & fibre_interp_point(field_u_variable_type)%PTR,err,error,*999)
2328  CALL field_interpolated_point_metrics_calculate(fibre_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
2329  & fibre_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
2330  ENDIF
2331  !Calculate RWG.
2332  rwg=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
2333  & quadrature_scheme%GAUSS_WEIGHTS(ng)
2334  !Calculate the conductivity tensor
2335  conductivity=0.0_dp
2336  IF(use_fibres) THEN
2337  !Calculate the conductivity tensor in fibre coordinates
2338  CALL flagerror("Not implemented.",err,error,*999)
2339  ELSE
2340  !Use the conductivity tensor in geometric coordinates
2341  DO nj=1,geometric_variable%NUMBER_OF_COMPONENTS
2342  conductivity(nj,nj)=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(nj+2,1)
2343  ENDDO !nj
2344  ENDIF
2345  !Compute basis dPhi/dx terms
2346  DO nj=1,geometric_variable%NUMBER_OF_COMPONENTS
2347  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2348  dphidx(nj,ms)=0.0_dp
2349  DO ni=1,dependent_basis%NUMBER_OF_XI
2350  dphidx(nj,ms)=dphidx(nj,ms)+ &
2351  & quadrature_scheme%GAUSS_BASIS_FNS(ms,partial_derivative_first_derivative_map(ni),ng)* &
2352  & equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%DXI_DX(ni,nj)
2353  ENDDO !ni
2354  ENDDO !ms
2355  ENDDO !nj
2356  !Loop over field components
2357  mhs=0
2358  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
2359  !Loop over element rows
2360  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2361  mhs=mhs+1
2362  nhs=0
2363  !Loop over element columns
2364  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
2365  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
2366  nhs=nhs+1
2367  sum=0.0_dp
2368  IF(stiffness_matrix%UPDATE_MATRIX) THEN
2369  DO ni=1,geometric_variable%NUMBER_OF_COMPONENTS
2370  DO nj=1,geometric_variable%NUMBER_OF_COMPONENTS
2371  sum=sum+conductivity(ni,nj)*dphidx(ni,mhs)*dphidx(nj,nhs)
2372  ENDDO !nj
2373  ENDDO !ni
2374  IF((equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,1)<zero_tolerance)&
2375  & .OR. (equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,1) &
2376  & <zero_tolerance)) THEN
2377  local_error="The value of the surface area to volume ratio or the capacitance is below zero tolerance"
2378  CALL flagerror(local_error,err,error,*999)
2379  ENDIF
2380  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*rwg/ &
2381  & equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,1)/ &
2382  & equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,1)
2383  ENDIF
2384  IF(damping_matrix%UPDATE_MATRIX) THEN
2385  damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+ &
2386  & quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)* &
2387  & quadrature_scheme%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)*rwg
2388  ENDIF
2389  ENDDO !ns
2390  ENDDO !nh
2391  IF(rhs_vector%UPDATE_VECTOR) rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=0.0_dp
2392  ENDDO !ms
2393  ENDDO !mh
2394  ENDDO !ng
2395  ENDIF
2396  CASE(equations_set_bidomain_equation_type)
2397  IF(SIZE(equations_set%SPECIFICATION,1)<3) THEN
2398  CALL flagerror("Equations set specification does not have a subtype set.",err,error,*999)
2399  END IF
2400  SELECT CASE(equations_set%SPECIFICATION(3))
2401  CASE(equations_set_first_bidomain_subtype)
2402  CASE(equations_set_second_bidomain_subtype)
2403  CASE DEFAULT
2404  local_error="The equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2405  & " is not valid for a bioelectric domain type of a bioelectrics equations set class."
2406  CALL flagerror(local_error,err,error,*999)
2407  END SELECT
2408  CASE DEFAULT
2409  local_error="The equations set type of "//trim(number_to_vstring(equations_set%SPECIFICATION(2),"*",err,error))// &
2410  & " is not valid for a bioelectric domain type of a bioelectrics equations set class."
2411  CALL flagerror(local_error,err,error,*999)
2412  END SELECT
2413  ELSE
2414  CALL flagerror("Equations set equations is not associated.",err,error,*999)
2415  ENDIF
2416  ELSE
2417  CALL flagerror("Equations set is not associated.",err,error,*999)
2418  ENDIF
2419 
2420  exits("BIODOMAIN_EQUATION_FINITE_ELEMENT_CALCULATE")
2421  RETURN
2422 999 errorsexits("BIODOMAIN_EQUATION_FINITE_ELEMENT_CALCULATE",err,error)
2423  RETURN 1
2424  END SUBROUTINE biodomain_equation_finite_element_calculate
2425 
2426  !
2427  !================================================================================================================================
2428  !
2429 
2430 END MODULE biodomain_equation_routines
equations_set_constants::equations_set_setup_dependent_type
integer(intg), parameter equations_set_setup_dependent_type
Dependent variables.
Definition: equations_set_constants.f90:324
equations_set_constants::equations_set_fem_solution_method
integer(intg), parameter equations_set_fem_solution_method
Finite Element Method solution method.
Definition: equations_set_constants.f90:348
basis_routines
This module contains all basis function routines.
Definition: basis_routines.f90:45
equations_set_constants::equations_set_setup_materials_type
integer(intg), parameter equations_set_setup_materials_type
Materials setup.
Definition: equations_set_constants.f90:326
base_routines::enters
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Definition: base_routines.f90:363
solver_routines::solvers_create_finish
subroutine, public solvers_create_finish(SOLVERS, ERR, ERROR,)
Finish the creation of solvers.
Definition: solver_routines.f90:22598
control_loop_routines::control_loop_progress_output
integer(intg), parameter, public control_loop_progress_output
Progress output from control loop.
Definition: control_loop_routines.f90:75
equations_mapping_routines::equations_mapping_dynamic_variable_type_set
subroutine, public equations_mapping_dynamic_variable_type_set(EQUATIONS_MAPPING, DYNAMIC_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set dynamic matrices...
Definition: equations_mapping_routines.f90:1996
types::equations_mapping_type
Contains information on the equations mapping i.e., how field variable DOFS are mapped to the rows an...
Definition: types.f90:1681
types::cellml_equations_type
Contains information about the CellML equations for a solver.
Definition: types.f90:2475
types::equations_type
Contains information about the equations in an equations set.
Definition: types.f90:1735
equations_set_constants::equations_set_gfem_solution_method
integer(intg), parameter equations_set_gfem_solution_method
Grid-based Finite Element Method solution method.
Definition: equations_set_constants.f90:352
types::region_type
Contains information for a region.
Definition: types.f90:3252
problem_constants::problem_control_time_loop_type
integer(intg), parameter problem_control_time_loop_type
Time control loop.
Definition: problem_constants.f90:283
types::control_loop_time_type
Contains information on a time iteration control loop.
Definition: types.f90:3148
problem_constants::problem_setup_control_type
integer(intg), parameter problem_setup_control_type
Solver setup for a problem.
Definition: problem_constants.f90:263
problem_constants
This module handles all problem wide constants.
Definition: problem_constants.f90:45
problem_constants::solver_equations_first_order_dynamic
integer(intg), parameter solver_equations_first_order_dynamic
Solver equations are first order dynamic.
Definition: problem_constants.f90:311
control_loop_routines::control_loop_node
integer(intg), parameter, public control_loop_node
The identifier for a each "leaf" node in a control loop.
Definition: control_loop_routines.f90:67
solver_routines::solver_dynamic_order_set
subroutine, public solver_dynamic_order_set(SOLVER, ORDER, ERR, ERROR,)
Sets/changes the order for a dynamic solver.
Definition: solver_routines.f90:6327
strings::number_to_vstring
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
equations_routines::equations_create_start
subroutine, public equations_create_start(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Start the creation of equations for the equation set.
Definition: equations_routines.f90:192
types::decomposition_type
Contains information on the mesh decomposition.
Definition: types.f90:1063
biodomain_equation_routines::biodomain_equationssetsolutionmethodset
subroutine, public biodomain_equationssetsolutionmethodset(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for a bioelectric domain equation type of an bioelectrics equations ...
Definition: biodomain_equation_routines.f90:1421
equations_matrices_routines::equations_matrices_create_start
subroutine, public equations_matrices_create_start(EQUATIONS, EQUATIONS_MATRICES, ERR, ERROR,)
Starts the creation of the equations matrices and rhs for the the equations.
Definition: equations_matrices_routines.f90:615
types::solver_type
Contains information on the type of solver to be used.
Definition: types.f90:2777
solver_routines::solver_petsc_library
integer(intg), parameter, public solver_petsc_library
PETSc solver library.
Definition: solver_routines.f90:104
solver_routines::solvers_number_set
subroutine, public solvers_number_set(SOLVERS, NUMBER_OF_SOLVERS, ERR, ERROR,)
Sets/changes the number of solvers.
Definition: solver_routines.f90:22805
constants::no_part_deriv
integer(intg), parameter no_part_deriv
No partial derivative i.e., u.
Definition: constants.f90:177
solver_routines::solver_dynamic_crank_nicolson_scheme
integer(intg), parameter, public solver_dynamic_crank_nicolson_scheme
Crank-Nicolson dynamic solver.
Definition: solver_routines.f90:282
problem_constants::problem_bioelectric_finite_elasticity_type
integer(intg), parameter problem_bioelectric_finite_elasticity_type
Definition: problem_constants.f90:110
solver_routines::solver_dynamic_degree_set
subroutine, public solver_dynamic_degree_set(SOLVER, DEGREE, ERR, ERROR,)
Sets/changes the degree of the polynomial used to interpolate time for a dynamic solver.
Definition: solver_routines.f90:5484
equations_matrices_routines
This module handles all equations matrix and rhs routines.
Definition: equations_matrices_routines.f90:45
solver_routines::solver_dynamic_first_order
integer(intg), parameter, public solver_dynamic_first_order
Dynamic solver has first order terms.
Definition: solver_routines.f90:255
solver_routines::solver_type_set
subroutine, public solver_type_set(SOLVER, SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type for a solver.
Definition: solver_routines.f90:21345
problem_constants::problem_monodomain_elasticity_w_titin_subtype
integer(intg), parameter problem_monodomain_elasticity_w_titin_subtype
Definition: problem_constants.f90:253
equations_set_constants::equations_set_bioelectrics_class
integer(intg), parameter equations_set_bioelectrics_class
Definition: equations_set_constants.f90:58
equations_set_constants::equations_static
integer(intg), parameter equations_static
The equations are static and have no time dependence.
Definition: equations_set_constants.f90:376
problem_constants::problem_bidomain_strang_split_subtype
integer(intg), parameter problem_bidomain_strang_split_subtype
Definition: problem_constants.f90:222
types::equations_set_type
Contains information on an equations set.
Definition: types.f90:1941
equations_routines
This module handles all equations routines.
Definition: equations_routines.f90:45
solver_routines::solver_dae_type
integer(intg), parameter, public solver_dae_type
A differential-algebraic equation solver.
Definition: solver_routines.f90:91
equations_set_constants::equations_set_setup_source_type
integer(intg), parameter equations_set_setup_source_type
Source setup.
Definition: equations_set_constants.f90:327
problem_constants::problem_control_fixed_loop_type
integer(intg), parameter problem_control_fixed_loop_type
Fixed iteration control loop.
Definition: problem_constants.f90:282
equations_set_constants::equations_set_no_subtype
integer(intg), parameter equations_set_no_subtype
Definition: equations_set_constants.f90:111
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
solver_routines::solvers_create_start
subroutine, public solvers_create_start(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Start the creation of a solvers for the control loop.
Definition: solver_routines.f90:22651
biodomain_equation_routines::biodomain_equation_problem_setup
subroutine, public biodomain_equation_problem_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the bioelectric domain problem.
Definition: biodomain_equation_routines.f90:1758
problem_constants::problem_monodomain_equation_type
integer(intg), parameter problem_monodomain_equation_type
Definition: problem_constants.f90:97
types::solvers_type
Contains information on the solvers to be used in a control loop.
Definition: types.f90:2805
problem_constants::problem_control_simple_type
integer(intg), parameter problem_control_simple_type
Simple, one iteration control loop.
Definition: problem_constants.f90:281
equations_mapping_routines::equations_mapping_dynamic_matrices_set
Definition: equations_mapping_routines.f90:83
constants::first_part_deriv
integer(intg), parameter first_part_deriv
First partial derivative i.e., du/ds.
Definition: constants.f90:178
timer
This module contains routines for timing the program.
Definition: timer_f.f90:45
control_loop_routines::control_loop_current_times_get
subroutine, public control_loop_current_times_get(CONTROL_LOOP, CURRENT_TIME, TIME_INCREMENT, ERR, ERROR,)
Gets the current time parameters for a time control loop.
Definition: control_loop_routines.f90:231
equations_matrices_routines::equations_matrices_dynamic_lumping_type_set
subroutine, public equations_matrices_dynamic_lumping_type_set(EQUATIONS_MATRICES, LUMPING_TYPE, ERR, ERROR,)
Sets the lumping of the linear equations matrices.
Definition: equations_matrices_routines.f90:3760
equations_set_constants::equations_set_first_bidomain_subtype
integer(intg), parameter equations_set_first_bidomain_subtype
Definition: equations_set_constants.f90:292
problem_constants::solver_equations_static
integer(intg), parameter solver_equations_static
Solver equations are static.
Definition: problem_constants.f90:309
equations_routines::equations_time_dependence_type_set
subroutine, public equations_time_dependence_type_set(EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for equations.
Definition: equations_routines.f90:851
solver_routines::solver_equations_sparsity_type_set
subroutine, public solver_equations_sparsity_type_set(SOLVER_EQUATIONS, SPARSITY_TYPE, ERR, ERROR,)
Sets/changes the sparsity type for solver equations.
Definition: solver_routines.f90:7734
solver_routines::solvers_solver_get
subroutine, public solvers_solver_get(SOLVERS, SOLVER_INDEX, SOLVER, ERR, ERROR,)
Returns a pointer to the specified solver in the list of solvers.
Definition: solver_routines.f90:22876
types::field_type
Contains information for a field defined on a region.
Definition: types.f90:1346
equations_matrices_routines::equations_matrices_full_matrices
integer(intg), parameter, public equations_matrices_full_matrices
Use fully populated equation matrices.
Definition: equations_matrices_routines.f90:91
problem_constants::problem_bidomain_equation_type
integer(intg), parameter problem_bidomain_equation_type
Definition: problem_constants.f90:98
equations_set_constants::equations_set_1d3d_monodomain_elasticity_subtype
integer(intg), parameter equations_set_1d3d_monodomain_elasticity_subtype
Definition: equations_set_constants.f90:310
biodomain_equation_routines::biodomain_equationssetspecificationset
subroutine, public biodomain_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for a bioelectric domain equation type of a bioelectric equations set...
Definition: biodomain_equation_routines.f90:1535
equations_mapping_routines::equations_mapping_rhs_variable_type_set
subroutine, public equations_mapping_rhs_variable_type_set(EQUATIONS_MAPPING, RHS_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set rhs vector.
Definition: equations_mapping_routines.f90:3170
problem_constants::solver_equations_linear
integer(intg), parameter solver_equations_linear
Solver equations are linear.
Definition: problem_constants.f90:301
types::control_loop_type
Contains information on a control loop.
Definition: types.f90:3185
iso_varying_string
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
Definition: iso_varying_string.f90:62
solver_routines::solver_equations_create_finish
subroutine, public solver_equations_create_finish(SOLVER_EQUATIONS, ERR, ERROR,)
Finishes the process of creating solver equations.
Definition: solver_routines.f90:7166
solver_routines::solver_sparse_matrices
integer(intg), parameter, public solver_sparse_matrices
Use sparse solver matrices.
Definition: solver_routines.f90:360
problem_constants::problem_bioelectrics_class
integer(intg), parameter problem_bioelectrics_class
Definition: problem_constants.f90:59
solver_routines::solver_equations_create_start
subroutine, public solver_equations_create_start(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Starts the process of creating solver equations.
Definition: solver_routines.f90:7209
solver_routines::solver_dynamic_type
integer(intg), parameter, public solver_dynamic_type
A dynamic solver.
Definition: solver_routines.f90:90
biodomain_equation_routines::biodomain_problemspecificationset
subroutine, public biodomain_problemspecificationset(problem, problemSpecification, err, error,)
Sets the problem specification for a bioelectric domain problem class.
Definition: biodomain_equation_routines.f90:2178
basis_routines::basis_default_quadrature_scheme
integer(intg), parameter, public basis_default_quadrature_scheme
Identifier for the default quadrature scheme.
Definition: basis_routines.f90:125
problem_constants::problem_setup_solvers_type
integer(intg), parameter problem_setup_solvers_type
Solver setup for a problem.
Definition: problem_constants.f90:264
equations_set_constants::equations_set_setup_equations_type
integer(intg), parameter equations_set_setup_equations_type
Equations setup.
Definition: equations_set_constants.f90:330
types::equations_mapping_dynamic_type
Contains information for mapping field variables to the dynamic matrices in the equations set of the ...
Definition: types.f90:1571
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
equations_set_constants::equations_set_setup_independent_type
integer(intg), parameter equations_set_setup_independent_type
Independent variables.
Definition: equations_set_constants.f90:325
constants
This module contains all program wide constants.
Definition: constants.f90:45
solver_routines::solver_library_type_set
subroutine, public solver_library_type_set(SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library type to use for the solver.
Definition: solver_routines.f90:9067
equations_mapping_routines::equationsmapping_linearmatricesnumberset
subroutine, public equationsmapping_linearmatricesnumberset(EQUATIONS_MAPPING, NUMBER_OF_LINEAR_EQUATIONS_MATRICES, ERR, ERROR,)
Sets/changes the number of linear equations matrices.
Definition: equations_mapping_routines.f90:2484
equations_routines::equations_lumped_matrices
integer(intg), parameter, public equations_lumped_matrices
The equations matrices are "mass" lumped.
Definition: equations_routines.f90:88
problem_constants::problem_setup_initial_type
integer(intg), parameter problem_setup_initial_type
Initial setup for a problem.
Definition: problem_constants.f90:262
equations_mapping_routines::equationsmapping_linearmatricesvariabletypesset
subroutine, public equationsmapping_linearmatricesvariabletypesset(EQUATIONS_MAPPING, LINEAR_MATRIX_VARIABLE_TYPES, ERR, ERROR,)
Sets the mapping between the dependent field variable types and the linear equations matrices...
Definition: equations_mapping_routines.f90:2716
types::problem_setup_type
Definition: types.f90:3215
equations_set_constants::equations_set_monodomain_strang_splitting_equation_type
integer(intg), parameter equations_set_monodomain_strang_splitting_equation_type
Definition: equations_set_constants.f90:99
problem_constants::problem_bidomain_gudunov_split_subtype
integer(intg), parameter problem_bidomain_gudunov_split_subtype
Definition: problem_constants.f90:221
equations_set_constants::equations_first_order_dynamic
integer(intg), parameter equations_first_order_dynamic
The equations are first order dynamic.
Definition: equations_set_constants.f90:378
problem_constants::problem_monodomain_strang_split_subtype
integer(intg), parameter problem_monodomain_strang_split_subtype
Definition: problem_constants.f90:219
biodomain_equation_routines::biodomain_equationssetsetup
subroutine, public biodomain_equationssetsetup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the bioelectric domain equation type of a bioelectric equations set class.
Definition: biodomain_equation_routines.f90:236
solver_routines::solver_equations_linearity_type_set
subroutine, public solver_equations_linearity_type_set(SOLVER_EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for solver equations.
Definition: solver_routines.f90:7577
equations_set_constants::equations_set_setup_start_action
integer(intg), parameter equations_set_setup_start_action
Start setup action.
Definition: equations_set_constants.f90:338
solver_routines::cellml_equations_create_start
subroutine, public cellml_equations_create_start(SOLVER, CELLML_EQUATIONS, ERR, ERROR,)
Starts the process of creating CellML equations.
Definition: solver_routines.f90:818
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
control_loop_routines::control_loop_solvers_get
recursive subroutine, public control_loop_solvers_get(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Returns a pointer to the solvers for a control loop.
Definition: control_loop_routines.f90:1333
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
solver_routines::solver_cellml_equations_get
subroutine, public solver_cellml_equations_get(SOLVER, CELLML_EQUATIONS, ERR, ERROR,)
Returns a pointer to the CellML equations for a solver.
Definition: solver_routines.f90:947
types::equations_matrices_type
Contains information on the equations matrices and vectors.
Definition: types.f90:1520
equations_matrices_routines::equations_matrix_fem_structure
integer(intg), parameter, public equations_matrix_fem_structure
Finite element matrix structure.
Definition: equations_matrices_routines.f90:72
base_routines
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
Definition: base_routines.f90:45
equations_set_constants::equations_set_1d3d_monodomain_active_strain_subtype
integer(intg), parameter equations_set_1d3d_monodomain_active_strain_subtype
Definition: equations_set_constants.f90:313
equations_matrices_routines::equationsmatrices_dynamicstructuretypeset
subroutine, public equationsmatrices_dynamicstructuretypeset(EQUATIONS_MATRICES, STRUCTURE_TYPE, ERR, ERROR,)
Sets the structure (sparsity) of the dynamic equations matrices.
Definition: equations_matrices_routines.f90:4090
equations_set_constants::equations_set_second_bidomain_subtype
integer(intg), parameter equations_set_second_bidomain_subtype
Definition: equations_set_constants.f90:293
problem_constants::problem_monodomain_gudunov_split_subtype
integer(intg), parameter problem_monodomain_gudunov_split_subtype
Definition: problem_constants.f90:218
iso_varying_string::trim
Definition: iso_varying_string.f90:204
equations_matrices_routines::equations_matrices_linear_storage_type_set
subroutine, public equations_matrices_linear_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the linear equations matrices.
Definition: equations_matrices_routines.f90:3898
equations_matrices_routines::equationsmatrices_linearstructuretypeset
subroutine, public equationsmatrices_linearstructuretypeset(EQUATIONS_MATRICES, STRUCTURE_TYPE, ERR, ERROR,)
Sets the structure (sparsity) of the linear equations matrices.
Definition: equations_matrices_routines.f90:4160
equations_mapping_routines::equations_mapping_create_finish
subroutine, public equations_mapping_create_finish(EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping.
Definition: equations_mapping_routines.f90:982
control_loop_routines::control_loop_get
Returns the specified control loop as indexed by the control loop identifier from the control loop ro...
Definition: control_loop_routines.f90:86
control_loop_routines::control_loop_type_set
subroutine, public control_loop_type_set(CONTROL_LOOP, LOOP_TYPE, ERR, ERROR,)
Sets/changes the control loop type.
Definition: control_loop_routines.f90:1750
equations_set_constants::equations_set_monodomain_equation_type
integer(intg), parameter equations_set_monodomain_equation_type
Definition: equations_set_constants.f90:97
equations_routines::equations_set_equations_get
subroutine, public equations_set_equations_get(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Gets the equations for an equations set.
Definition: equations_routines.f90:897
types::equations_set_materials_type
Definition: types.f90:1881
constants::partial_derivative_first_derivative_map
integer(intg), dimension(4) partial_derivative_first_derivative_map
PARTIAL_DERIVATIVE_FIRST_DERIVATIVE_MAP(nic) gives the partial derivative index for the first derivat...
Definition: constants.f90:254
equations_routines::equations_create_finish
subroutine, public equations_create_finish(EQUATIONS, ERR, ERROR,)
Finish the creation of equations.
Definition: equations_routines.f90:159
domain_mappings
This module handles all domain mappings routines.
Definition: domain_mappings.f90:45
problem_constants::problem_setup_finish_action
integer(intg), parameter problem_setup_finish_action
Finish setup action.
Definition: problem_constants.f90:274
equations_mapping_routines
This module handles all equations mapping routines.
Definition: equations_mapping_routines.f90:45
types::solver_equations_type
Contains information about the solver equations for a solver.
Definition: types.f90:2452
matrix_vector::matrix_compressed_row_storage_type
integer(intg), parameter, public matrix_compressed_row_storage_type
Matrix compressed row storage type.
Definition: matrix_vector.f90:167
equations_matrices_routines::equations_matrices_dynamic_storage_type_set
subroutine, public equations_matrices_dynamic_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the dynamic equations matrices.
Definition: equations_matrices_routines.f90:3824
equations_matrices_routines::equations_matrix_diagonal_structure
integer(intg), parameter, public equations_matrix_diagonal_structure
Diagonal matrix structure.
Definition: equations_matrices_routines.f90:73
equations_set_constants::equations_set_gfv_solution_method
integer(intg), parameter equations_set_gfv_solution_method
Grid-based Finite Volume solution method.
Definition: equations_set_constants.f90:354
equations_set_constants::equations_set_setup_geometry_type
integer(intg), parameter equations_set_setup_geometry_type
Geometry setup.
Definition: equations_set_constants.f90:323
types::problem_type
Contains information for a problem.
Definition: types.f90:3221
problem_constants::problem_setup_cellml_equations_type
integer(intg), parameter problem_setup_cellml_equations_type
CellML equations setup for a problem.
Definition: problem_constants.f90:266
equations_set_constants::equations_linear
integer(intg), parameter equations_linear
The equations are linear.
Definition: equations_set_constants.f90:365
equations_matrices_routines::equations_matrices_create_finish
subroutine, public equations_matrices_create_finish(EQUATIONS_MATRICES, ERR, ERROR,)
Finishes the creation of the equations matrices and RHS for the the equations.
Definition: equations_matrices_routines.f90:404
distributed_matrix_vector
This module handles all distributed matrix vector routines.
Definition: distributed_matrix_vector.f90:45
boundary_conditions_routines
This module handles all boundary conditions routines.
Definition: boundary_condition_routines.f90:45
solver_routines
This module handles all solver routines.
Definition: solver_routines.f90:45
equations_mapping_routines::equations_mapping_create_start
subroutine, public equations_mapping_create_start(EQUATIONS, EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping for a equations set equations.
Definition: equations_mapping_routines.f90:1112
equations_matrices_routines::equations_matrix_unlumped
integer(intg), parameter, public equations_matrix_unlumped
The matrix is not lumped.
Definition: equations_matrices_routines.f90:82
types::equations_matrix_type
Contains information about an equations matrix.
Definition: types.f90:1429
types::quadrature_scheme_type
Contains information for a particular quadrature scheme.
Definition: types.f90:141
solver_routines::solver_dynamic_restart_set
subroutine, public solver_dynamic_restart_set(SOLVER, RESTART, ERR, ERROR,)
Sets/changes the restart value for a dynamic solver.
Definition: solver_routines.f90:6249
field_io_routines
Implements lists of Field IO operation.
Definition: field_IO_routines.f90:46
matrix_vector
This module contains all routines dealing with (non-distributed) matrix and vectors types...
Definition: matrix_vector.f90:129
distributed_matrix_vector::distributed_matrix_block_storage_type
integer(intg), parameter, public distributed_matrix_block_storage_type
Distributed matrix block storage type.
Definition: distributed_matrix_vector.f90:97
biodomain_equation_routines::biodomain_equation_finite_element_calculate
subroutine, public biodomain_equation_finite_element_calculate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element stiffness matrices and RHS for a bioelectric domain equation finite element eq...
Definition: biodomain_equation_routines.f90:2249
equations_matrices_routines::equations_matrix_lumped
integer(intg), parameter, public equations_matrix_lumped
The matrix is "mass" lumped.
Definition: equations_matrices_routines.f90:83
equations_routines::equations_linearity_type_set
subroutine, public equations_linearity_type_set(EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for equations.
Definition: equations_routines.f90:539
control_loop_routines::control_loop_create_start
subroutine, public control_loop_create_start(PROBLEM, CONTROL_LOOP, ERR, ERROR,)
Start the process of creating a control loop for a problem.
Definition: control_loop_routines.f90:194
problem_constants::problem_setup_solver_equations_type
integer(intg), parameter problem_setup_solver_equations_type
Solver equations setup for a problem.
Definition: problem_constants.f90:265
equations_set_constants::equations_set_monodomain_elasticity_velocity_subtype
integer(intg), parameter equations_set_monodomain_elasticity_velocity_subtype
Definition: equations_set_constants.f90:312
control_loop_routines::control_loop_label_set
Definition: control_loop_routines.f90:96
biodomain_equation_routines::biodomain_pre_solve
subroutine, public biodomain_pre_solve(SOLVER, ERR, ERROR,)
Performs pre-solve actions for mono- and bi-domain problems.
Definition: biodomain_equation_routines.f90:1611
types::solver_mapping_type
Contains information on the solver mapping between the global equation sets and the solver matrices...
Definition: types.f90:3091
solver_routines::solver_dynamic_scheme_set
subroutine, public solver_dynamic_scheme_set(SOLVER, SCHEME, ERR, ERROR,)
Sets/changes the scheme for a dynamic solver.
Definition: solver_routines.f90:6384
types::field_variable_type
Contains information for a field variable defined on a field.
Definition: types.f90:1289
solver_routines::cellml_equations_create_finish
subroutine, public cellml_equations_create_finish(CELLML_EQUATIONS, ERR, ERROR,)
Finishes the process of creating CellML equations.
Definition: solver_routines.f90:780
solver_routines::solver_label_set
Definition: solver_routines.f90:405
equations_set_constants::equations_set_fd_solution_method
integer(intg), parameter equations_set_fd_solution_method
Finite Difference solution method.
Definition: equations_set_constants.f90:350
equations_matrices_routines::equations_matrices_sparse_matrices
integer(intg), parameter, public equations_matrices_sparse_matrices
Use sparse equations matrices.
Definition: equations_matrices_routines.f90:90
problem_constants::problem_control_load_increment_loop_type
integer(intg), parameter problem_control_load_increment_loop_type
Load increment control loop.
Definition: problem_constants.f90:285
types::equations_set_setup_type
Contains information on the setup information for an equations set.
Definition: types.f90:1866
problem_constants::problem_setup_start_action
integer(intg), parameter problem_setup_start_action
Start setup action.
Definition: problem_constants.f90:273
solver_routines::solver_equations_time_dependence_type_set
subroutine, public solver_equations_time_dependence_type_set(SOLVER_EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for solver equations.
Definition: solver_routines.f90:7788
control_loop_routines
This module handles all control loop routines.
Definition: control_loop_routines.f90:45
solver_routines::solver_cmiss_library
integer(intg), parameter, public solver_cmiss_library
CMISS (internal) solver library.
Definition: solver_routines.f90:103
biodomain_equation_routines
This module handles all bioelectric domain equation routines.
Definition: biodomain_equation_routines.f90:46
base_routines::errors
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
Definition: base_routines.f90:481
equations_set_constants
This module defines all constants shared across equations set routines.
Definition: equations_set_constants.f90:45
equations_set_constants::equations_set_bem_solution_method
integer(intg), parameter equations_set_bem_solution_method
Boundary Element Method solution method.
Definition: equations_set_constants.f90:349
solver_routines::solver_solver_equations_get
subroutine, public solver_solver_equations_get(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Returns a pointer to the solver equations for a solver.
Definition: solver_routines.f90:21230
equations_set_constants::equations_set_monodomain_elasticity_w_titin_subtype
integer(intg), parameter equations_set_monodomain_elasticity_w_titin_subtype
Definition: equations_set_constants.f90:311
types::basis_type
Contains all information about a basis .
Definition: types.f90:184
equations_set_constants::equations_set_fv_solution_method
integer(intg), parameter equations_set_fv_solution_method
Finite Volume solution method.
Definition: equations_set_constants.f90:351
matrix_vector::matrix_block_storage_type
integer(intg), parameter, public matrix_block_storage_type
Matrix block storage type.
Definition: matrix_vector.f90:163
solver_routines::solver_dynamic_first_degree
integer(intg), parameter, public solver_dynamic_first_degree
Dynamic solver uses a first degree polynomial for time interpolation.
Definition: solver_routines.f90:271
equations_set_constants::equations_set_setup_initial_type
integer(intg), parameter equations_set_setup_initial_type
Initial setup.
Definition: equations_set_constants.f90:322
control_loop_routines::control_loop_create_finish
recursive subroutine, public control_loop_create_finish(CONTROL_LOOP, ERR, ERROR,)
Finish the process of creating a control loop.
Definition: control_loop_routines.f90:153
problem_constants::problem_monodomain_1d3d_active_strain_subtype
integer(intg), parameter problem_monodomain_1d3d_active_strain_subtype
Definition: problem_constants.f90:255
equations_set_constants::equations_set_setup_analytic_type
integer(intg), parameter equations_set_setup_analytic_type
Analytic setup.
Definition: equations_set_constants.f90:329
solver_routines::solver_dae_times_set
subroutine, public solver_dae_times_set(SOLVER, START_TIME, END_TIME, ERR, ERROR,)
Set/change the times for a differential-algebraic equation solver.
Definition: solver_routines.f90:4999
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
problem_constants::problem_control_while_loop_type
integer(intg), parameter problem_control_while_loop_type
While control loop.
Definition: problem_constants.f90:284
solver_routines::solver_linear_type
integer(intg), parameter, public solver_linear_type
A linear solver.
Definition: solver_routines.f90:88
types::equations_matrices_rhs_type
Contains information of the RHS vector for equations matrices.
Definition: types.f90:1500
problem_constants::problem_gudunov_monodomain_1d3d_elasticity_subtype
integer(intg), parameter problem_gudunov_monodomain_1d3d_elasticity_subtype
Definition: problem_constants.f90:252
constants::zero_tolerance
real(dp), parameter zero_tolerance
Definition: constants.f90:70
distributed_matrix_vector::distributed_matrix_diagonal_storage_type
integer(intg), parameter, public distributed_matrix_diagonal_storage_type
Distributed matrix diagonal storage type.
Definition: distributed_matrix_vector.f90:98
equations_set_constants::equations_set_bidomain_equation_type
integer(intg), parameter equations_set_bidomain_equation_type
Definition: equations_set_constants.f90:98
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
field_io_routines::field_io_nodes_export
subroutine, public field_io_nodes_export(FIELDS, FILE_NAME, METHOD, ERR, ERROR,)
Export nodal information.
Definition: field_IO_routines.f90:6163
equations_set_constants::equations_set_setup_finish_action
integer(intg), parameter equations_set_setup_finish_action
Finish setup action.
Definition: equations_set_constants.f90:339
distributed_matrix_vector::distributed_matrix_compressed_row_storage_type
integer(intg), parameter, public distributed_matrix_compressed_row_storage_type
Distributed matrix compressed row storage type.
Definition: distributed_matrix_vector.f90:101
types::equations_matrices_dynamic_type
Contains information of the dynamic matrices for equations matrices.
Definition: types.f90:1471
biodomain_equation_routines::biodomain_control_loop_post_loop
subroutine, public biodomain_control_loop_post_loop(CONTROL_LOOP, ERR, ERROR,)
Runs after each control loop iteration.
Definition: biodomain_equation_routines.f90:109
problem_constants::problem_gudunov_monodomain_simple_elasticity_subtype
integer(intg), parameter problem_gudunov_monodomain_simple_elasticity_subtype
Definition: problem_constants.f90:251
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45