OpenCMISS-Iron Internal API Documentation
Poisson_equations_routines.f90
Go to the documentation of this file.
1 
43 
45 MODULE poisson_equations_routines
46 
47  USE base_routines
48  USE basis_routines
49  USE boundary_conditions_routines
50  USE constants
51  USE control_loop_routines
52  USE coordinate_routines
53  USE distributed_matrix_vector
54  USE domain_mappings
55  USE equations_routines
56  USE equations_mapping_routines
57  USE equations_matrices_routines
58  USE equations_set_constants
59  USE field_routines
60  USE input_output
61  USE iso_varying_string
62  USE kinds
63  USE maths
64  USE matrix_vector
65  USE node_routines
66  USE problem_constants
67  USE strings
68  USE solver_routines
69  USE timer
70  USE types
71 ! temporary input for vector-source
72  USE fluid_mechanics_io_routines
73 
74 #include "macros.h"
75 
76  IMPLICIT NONE
77 
78  PRIVATE
79 
80  !Module parameters
81 
82  !Module types
83 
84  !Module variables
85 
86  !Interfaces
87 
88  PUBLIC poisson_boundaryconditionsanalyticcalculate
89 
90  PUBLIC poisson_equation_equations_set_setup
91 
92  PUBLIC poisson_equationssetsolutionmethodset
93 
94  PUBLIC poisson_equationssetspecificationset
95 
96  PUBLIC poisson_equation_finite_element_calculate
97 
98  PUBLIC poisson_finiteelementjacobianevaluate,poisson_finiteelementresidualevaluate
99 
100  PUBLIC poisson_equation_problem_setup
101 
102  PUBLIC poisson_problemspecificationset
103 
104  PUBLIC poisson_pre_solve,poisson_post_solve
105 
106 CONTAINS
107 
108  !
109  !================================================================================================================================
110  !
111 
113  SUBROUTINE poisson_boundaryconditionsanalyticcalculate(EQUATIONS_SET,BOUNDARY_CONDITIONS,ERR,ERROR,*)
114 
115  !Argument variables
116  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
117  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
118  INTEGER(INTG), INTENT(OUT) :: ERR
119  TYPE(varying_string), INTENT(OUT) :: ERROR
120  !Local Variables
121  INTEGER(INTG) :: component_idx,deriv_idx,dim_idx,local_ny,node_idx,NUMBER_OF_DIMENSIONS,variable_idx,variable_type,global_ny
122  REAL(DP) :: VALUE,X(3)
123  REAL(DP), POINTER :: GEOMETRIC_PARAMETERS(:)
124  TYPE(domain_type), POINTER :: DOMAIN
125  TYPE(domain_nodes_type), POINTER :: DOMAIN_NODES
126  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD
127  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE,GEOMETRIC_VARIABLE
128  TYPE(varying_string) :: LOCAL_ERROR
129 
130  enters("Poisson_BoundaryConditionsAnalyticCalculate",err,error,*999)
131 
132  IF(ASSOCIATED(equations_set)) THEN
133  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
134  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
135  IF(ASSOCIATED(dependent_field)) THEN
136  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
137  IF(ASSOCIATED(geometric_field)) THEN
138  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
139  NULLIFY(geometric_variable)
140  CALL field_variable_get(geometric_field,field_u_variable_type,geometric_variable,err,error,*999)
141  NULLIFY(geometric_parameters)
142  CALL field_parameter_set_data_get(geometric_field,field_u_variable_type,field_values_set_type,geometric_parameters, &
143  & err,error,*999)
144 
145  IF(ASSOCIATED(boundary_conditions)) THEN
146 
147  DO variable_idx=1,dependent_field%NUMBER_OF_VARIABLES !U and deludeln
148  variable_type=dependent_field%VARIABLES(variable_idx)%VARIABLE_TYPE
149  field_variable=>dependent_field%VARIABLE_TYPE_MAP(variable_type)%PTR
150  IF(ASSOCIATED(field_variable)) THEN
151  CALL field_parameter_set_create(dependent_field,variable_type,field_analytic_values_set_type,err,error,*999)
152  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS !u,v,w
153  IF(field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE==field_node_based_interpolation) THEN
154  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
155  IF(ASSOCIATED(domain)) THEN
156  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
157  domain_nodes=>domain%TOPOLOGY%NODES
158  IF(ASSOCIATED(domain_nodes)) THEN
159 
160  !Loop over the local nodes excluding the ghosts.
161  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
162  !!TODO \todo We should interpolate the geometric field here and the node position.
163  DO dim_idx=1,number_of_dimensions
164  local_ny=geometric_variable%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
165  & nodes(node_idx)%DERIVATIVES(1)%VERSIONS(1)
166  x(dim_idx)=geometric_parameters(local_ny)
167  ENDDO !dim_idx
168  !Loop over the derivatives
169  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
170  SELECT CASE(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE)
171  CASE(equations_set_poisson_equation_two_dim_1)
172  !u=ln(4/(x+y+1^2))
173  SELECT CASE(variable_type)
174  CASE(field_u_variable_type)
175  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
176  CASE(no_global_deriv)
177  VALUE=log(4.0_dp/((x(1)+x(2)+1.0_dp)**2))
178  CASE(global_deriv_s1)
179  CALL flagerror("Not implemented.",err,error,*999)
180  CASE(global_deriv_s2)
181  CALL flagerror("Not implemented.",err,error,*999)
182  CASE(global_deriv_s1_s2)
183  CALL flagerror("Not implemented.",err,error,*999)
184  CASE DEFAULT
185  local_error="The global derivative index of "//trim(number_to_vstring( &
186  domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
187  & err,error))//" is invalid."
188  CALL flagerror(local_error,err,error,*999)
189  END SELECT
190  CASE(field_deludeln_variable_type)
191  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
192  CASE(no_global_deriv)
193  !This is believed to be incorrect, should be: VALUE=-2.0_DP/(X(1)+X(2)+1.0_DP)
194  VALUE=-2.0_dp*(x(1)+x(2))/(x(1)+x(2)+1.0_dp)
195  CASE(global_deriv_s1)
196  CALL flagerror("Not implemented.",err,error,*999)
197  CASE(global_deriv_s2)
198  CALL flagerror("Not implemented.",err,error,*999)
199  CASE(global_deriv_s1_s2)
200  CALL flagerror("Not implemented.",err,error,*999)
201  CASE DEFAULT
202  local_error="The global derivative index of "//trim(number_to_vstring( &
203  domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
204  & err,error))//" is invalid."
205  CALL flagerror(local_error,err,error,*999)
206  END SELECT
207  END SELECT
208  CASE(equations_set_poisson_equation_two_dim_2)
209  CALL flagerror("The analytic function type is not implemented yet.",err,error,*999)
210  CASE(equations_set_poisson_equation_two_dim_3)
211  CALL flagerror("The analytic function type is not implemented yet.",err,error,*999)
212  CASE(equations_set_poisson_equation_three_dim_1)
213  !u=ln(6/(x+y+z+1^2))
214  SELECT CASE(variable_type)
215  CASE(field_u_variable_type)
216  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
217  CASE(no_global_deriv)
218  VALUE=log(6.0_dp/((x(1)+x(2)+x(3)+1.0_dp)**2))
219  CASE(global_deriv_s1)
220  CALL flagerror("Not implemented.",err,error,*999)
221  CASE(global_deriv_s2)
222  CALL flagerror("Not implemented.",err,error,*999)
223  CASE(global_deriv_s1_s2)
224  CALL flagerror("Not implemented.",err,error,*999)
225  CASE DEFAULT
226  local_error="The global derivative index of "//trim(number_to_vstring( &
227  domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
228  & err,error))//" is invalid."
229  CALL flagerror(local_error,err,error,*999)
230  END SELECT
231  CASE(field_deludeln_variable_type)
232  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
233  CASE(no_global_deriv)
234  VALUE=-3.0_dp/(x(1)+x(2)+x(3)+1.0_dp)
235  CASE(global_deriv_s1)
236  CALL flagerror("Not implemented.",err,error,*999)
237  CASE(global_deriv_s2)
238  CALL flagerror("Not implemented.",err,error,*999)
239  CASE(global_deriv_s1_s2)
240  CALL flagerror("Not implemented.",err,error,*999)
241  CASE DEFAULT
242  local_error="The global derivative index of "//trim(number_to_vstring( &
243  domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
244  & err,error))//" is invalid."
245  CALL flagerror(local_error,err,error,*999)
246  END SELECT
247  CASE DEFAULT
248  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
249  & " is invalid."
250  CALL flagerror(local_error,err,error,*999)
251  END SELECT
252  CASE(equations_set_poisson_equation_three_dim_2)
253  CALL flagerror("The analytic function type is not implemented yet.",err,error,*999)
254  CASE(equations_set_poisson_equation_three_dim_3)
255  CALL flagerror("The analytic function type is not implemented yet.",err,error,*999)
256  CASE(equations_set_pressure_poisson_three_dim_1,equations_set_pressure_poisson_three_dim_2)
257  !\todo: This test case has been set up for the Pressure Poisson equation - needs to be formulated in a more general way
258  !u=ln(4/(x+y+1^2))
259  SELECT CASE(variable_type)
260  CASE(field_u_variable_type)
261  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
262  CASE(no_global_deriv)
263  VALUE=sin(2.0_dp*pi*x(1)/10.0_dp)*sin(2.0_dp*pi*x(2)/10.0_dp)*sin(2.0_dp*pi*x(3)/10.0_dp)
264  ! VALUE=2*X(1)*X(1)+2*X(2)
265  CASE(global_deriv_s1)
266  CALL flagerror("Not implemented.",err,error,*999)
267  CASE(global_deriv_s2)
268  CALL flagerror("Not implemented.",err,error,*999)
269  CASE(global_deriv_s1_s2)
270  CALL flagerror("Not implemented.",err,error,*999)
271  CASE DEFAULT
272  local_error="The global derivative index of "//trim(number_to_vstring( &
273  domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
274  & err,error))//" is invalid."
275  CALL flagerror(local_error,err,error,*999)
276  END SELECT
277  CASE(field_deludeln_variable_type)
278  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
279  CASE(no_global_deriv)
280  ! do nothing, tbd
281  CASE(global_deriv_s1)
282  CALL flagerror("Not implemented.",err,error,*999)
283  CASE(global_deriv_s2)
284  CALL flagerror("Not implemented.",err,error,*999)
285  CASE(global_deriv_s1_s2)
286  CALL flagerror("Not implemented.",err,error,*999)
287  CASE DEFAULT
288  local_error="The global derivative index of "//trim(number_to_vstring( &
289  domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
290  & err,error))//" is invalid."
291  CALL flagerror(local_error,err,error,*999)
292  END SELECT
293  CASE DEFAULT
294  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
295  & " is invalid."
296  CALL flagerror(local_error,err,error,*999)
297  END SELECT
298  CASE DEFAULT
299  local_error="The analytic function type of "// &
300  & trim(number_to_vstring(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
301  & " is invalid."
302  CALL flagerror(local_error,err,error,*999)
303  END SELECT
304  !Default to version 1 of each node derivative
305  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
306  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
307  CALL field_parameter_set_update_local_dof(dependent_field,variable_type, &
308  & field_analytic_values_set_type,local_ny,VALUE,err,error,*999)
309 
310  global_ny=field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
311 
312  IF(variable_type==field_u_variable_type.AND.domain_nodes%NODES(node_idx)%BOUNDARY_NODE) THEN !For Dirichlet
313  CALL boundary_conditions_set_local_dof(boundary_conditions,dependent_field,variable_type, &
314  & local_ny,boundary_condition_fixed,VALUE,err,error,*999)
315  ENDIF
316 
317  IF(variable_type==field_deludeln_variable_type.and.node_idx/=1) THEN
318  IF(domain_nodes%NODES(node_idx)%BOUNDARY_NODE) THEN
319  !If we are a boundary node then set the analytic value on the boundary
320  !CALL BOUNDARY_CONDITIONS_SET_LOCAL_DOF(BOUNDARY_CONDITIONS,DEPENDENT_FIELD,variable_type,local_ny, &
321  ! & BOUNDARY_CONDITION_FIXED,VALUE,ERR,ERROR,*999)
322  !Do nothing at present
323  ENDIF
324  ENDIF
325 
326  ENDDO !deriv_idx
327  ENDDO !node_idx
328  ELSE
329  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
330  ENDIF
331  ELSE
332  CALL flagerror("Domain topology is not associated.",err,error,*999)
333  ENDIF
334  ELSE
335  CALL flagerror("Domain is not associated.",err,error,*999)
336  ENDIF
337  ELSE
338  CALL flagerror("Only node based interpolation is implemented.",err,error,*999)
339  ENDIF
340  ENDDO !component_idx
341  CALL field_parameter_set_update_start(dependent_field,variable_type,field_analytic_values_set_type, &
342  & err,error,*999)
343  CALL field_parameter_set_update_finish(dependent_field,variable_type,field_analytic_values_set_type, &
344  & err,error,*999)
345  ELSE
346  CALL flagerror("Field variable is not associated.",err,error,*999)
347  ENDIF
348 
349  ENDDO !variable_idx
350 
351  CALL field_parameter_set_data_restore(geometric_field,field_u_variable_type,field_values_set_type, &
352  & geometric_parameters,err,error,*999)
353 
354  ELSE
355  CALL flagerror("Boundary conditions is not associated.",err,error,*999)
356  ENDIF
357  ELSE
358  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
359  ENDIF
360  ELSE
361  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
362  ENDIF
363  ELSE
364  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
365  ENDIF
366  ELSE
367  CALL flagerror("Equations set is not associated.",err,error,*999)
368  ENDIF
369 
370  exits("Poisson_BoundaryConditionsAnalyticCalculate")
371  RETURN
372 999 errorsexits("Poisson_BoundaryConditionsAnalyticCalculate",err,error)
373  RETURN 1
374 
375  END SUBROUTINE poisson_boundaryconditionsanalyticcalculate
376 
377  !
378  !================================================================================================================================
379  !
380 
382  SUBROUTINE poisson_equation_equations_set_setup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
383 
384  !Argument variables
385  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
386  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
387  INTEGER(INTG), INTENT(OUT) :: ERR
388  TYPE(varying_string), INTENT(OUT) :: ERROR
389  !Local Variables
390  TYPE(varying_string) :: LOCAL_ERROR
391 
392  enters("POISSON_EQUATION_EQUATIONS_SET_SETUP",err,error,*999)
393 
394  IF(ASSOCIATED(equations_set)) THEN
395  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
396  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
397  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
398  CALL flagerror("Equations set specification must have three entries for a Poisson type equations set.", &
399  & err,error,*999)
400  END IF
401  SELECT CASE(equations_set%SPECIFICATION(3))
402  CASE(equations_set_constant_source_poisson_subtype)
403  CALL poisson_equationssetlinearsourcesetup(equations_set,equations_set_setup,err,error,*999)
404  CASE(equations_set_extracellular_bidomain_poisson_subtype)
405  CALL poisson_equationssetextracellularbidomainsetup(equations_set,equations_set_setup,err,error,*999)
406  CASE(equations_set_linear_source_poisson_subtype)
407  CALL poisson_equationssetlinearsourcesetup(equations_set,equations_set_setup,err,error,*999)
408  CASE(equations_set_linear_pressure_poisson_subtype,equations_set_nonlinear_pressure_poisson_subtype, &
409  & equations_set_fitted_pressure_poisson_subtype,equations_set_ale_pressure_poisson_subtype)
410  CALL poisson_equationssetpressurepoissonsetup(equations_set,equations_set_setup,err,error,*999)
411  CASE(equations_set_quadratic_source_poisson_subtype)
412  CALL poisson_equationssetnonlinearsourcesetup(equations_set,equations_set_setup,err,error,*999)
413  CASE(equations_set_exponential_source_poisson_subtype)
414  CALL poisson_equationssetnonlinearsourcesetup(equations_set,equations_set_setup,err,error,*999)
415  CASE DEFAULT
416  local_error="Equations set subtype "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
417  & " is not valid for a Poisson equation type of a classical field equation set class."
418  CALL flagerror(local_error,err,error,*999)
419  END SELECT
420  ELSE
421  CALL flagerror("Equations set is not associated.",err,error,*999)
422  ENDIF
423 
424  exits("POISSON_EQUATION_EQUATIONS_SET_SETUP")
425  RETURN
426 999 errorsexits("POISSON_EQUATION_EQUATIONS_SET_SETUP",err,error)
427  RETURN 1
428  END SUBROUTINE poisson_equation_equations_set_setup
429 
430  !
431  !================================================================================================================================
432  !
433 
435  SUBROUTINE poisson_equationssetsolutionmethodset(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)
436 
437  !Argument variables
438  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
439  INTEGER(INTG), INTENT(IN) :: SOLUTION_METHOD
440  INTEGER(INTG), INTENT(OUT) :: ERR
441  TYPE(varying_string), INTENT(OUT) :: ERROR
442  !Local Variables
443  TYPE(varying_string) :: LOCAL_ERROR
444 
445  enters("Poisson_EquationsSetSolutionMethodSet",err,error,*999)
446 
447  IF(ASSOCIATED(equations_set)) THEN
448  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
449  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
450  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
451  CALL flagerror("Equations set specification must have three entries for a Poisson type equations set.", &
452  & err,error,*999)
453  END IF
454  SELECT CASE(equations_set%SPECIFICATION(3))
455  CASE(equations_set_constant_source_poisson_subtype)
456  SELECT CASE(solution_method)
457  CASE(equations_set_fem_solution_method)
458  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
459  CASE(equations_set_bem_solution_method)
460  CALL flagerror("Not implemented.",err,error,*999)
461  CASE(equations_set_fd_solution_method)
462  CALL flagerror("Not implemented.",err,error,*999)
463  CASE(equations_set_fv_solution_method)
464  CALL flagerror("Not implemented.",err,error,*999)
465  CASE(equations_set_gfem_solution_method)
466  CALL flagerror("Not implemented.",err,error,*999)
467  CASE(equations_set_gfv_solution_method)
468  CALL flagerror("Not implemented.",err,error,*999)
469  CASE DEFAULT
470  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
471  CALL flagerror(local_error,err,error,*999)
472  END SELECT
473  CASE(equations_set_extracellular_bidomain_poisson_subtype)
474  SELECT CASE(solution_method)
475  CASE(equations_set_fem_solution_method)
476  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
477  CASE(equations_set_bem_solution_method)
478  CALL flagerror("Not implemented.",err,error,*999)
479  CASE(equations_set_fd_solution_method)
480  CALL flagerror("Not implemented.",err,error,*999)
481  CASE(equations_set_fv_solution_method)
482  CALL flagerror("Not implemented.",err,error,*999)
483  CASE(equations_set_gfem_solution_method)
484  CALL flagerror("Not implemented.",err,error,*999)
485  CASE(equations_set_gfv_solution_method)
486  CALL flagerror("Not implemented.",err,error,*999)
487  CASE DEFAULT
488  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
489  CALL flagerror(local_error,err,error,*999)
490  END SELECT
491  CASE(equations_set_linear_source_poisson_subtype,equations_set_linear_pressure_poisson_subtype, &
492  & equations_set_nonlinear_pressure_poisson_subtype,equations_set_fitted_pressure_poisson_subtype, &
493  & equations_set_ale_pressure_poisson_subtype)
494  SELECT CASE(solution_method)
495  CASE(equations_set_fem_solution_method)
496  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
497  CASE(equations_set_bem_solution_method)
498  CALL flagerror("Not implemented.",err,error,*999)
499  CASE(equations_set_fd_solution_method)
500  CALL flagerror("Not implemented.",err,error,*999)
501  CASE(equations_set_fv_solution_method)
502  CALL flagerror("Not implemented.",err,error,*999)
503  CASE(equations_set_gfem_solution_method)
504  CALL flagerror("Not implemented.",err,error,*999)
505  CASE(equations_set_gfv_solution_method)
506  CALL flagerror("Not implemented.",err,error,*999)
507  CASE DEFAULT
508  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
509  CALL flagerror(local_error,err,error,*999)
510  END SELECT
511  CASE(equations_set_quadratic_source_poisson_subtype)
512  SELECT CASE(solution_method)
513  CASE(equations_set_fem_solution_method)
514  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
515  CASE(equations_set_bem_solution_method)
516  CALL flagerror("Not implemented.",err,error,*999)
517  CASE(equations_set_fd_solution_method)
518  CALL flagerror("Not implemented.",err,error,*999)
519  CASE(equations_set_fv_solution_method)
520  CALL flagerror("Not implemented.",err,error,*999)
521  CASE(equations_set_gfem_solution_method)
522  CALL flagerror("Not implemented.",err,error,*999)
523  CASE(equations_set_gfv_solution_method)
524  CALL flagerror("Not implemented.",err,error,*999)
525  CASE DEFAULT
526  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
527  CALL flagerror(local_error,err,error,*999)
528  END SELECT
529  CASE(equations_set_exponential_source_poisson_subtype)
530  SELECT CASE(solution_method)
531  CASE(equations_set_fem_solution_method)
532  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
533  CASE(equations_set_bem_solution_method)
534  CALL flagerror("Not implemented.",err,error,*999)
535  CASE(equations_set_fd_solution_method)
536  CALL flagerror("Not implemented.",err,error,*999)
537  CASE(equations_set_fv_solution_method)
538  CALL flagerror("Not implemented.",err,error,*999)
539  CASE(equations_set_gfem_solution_method)
540  CALL flagerror("Not implemented.",err,error,*999)
541  CASE(equations_set_gfv_solution_method)
542  CALL flagerror("Not implemented.",err,error,*999)
543  CASE DEFAULT
544  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
545  CALL flagerror(local_error,err,error,*999)
546  END SELECT
547  CASE DEFAULT
548  local_error="Equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
549  & " is not valid for a Poisson equation type of an classical field equations set class."
550  CALL flagerror(local_error,err,error,*999)
551  END SELECT
552  ELSE
553  CALL flagerror("Equations set is not associated.",err,error,*999)
554  ENDIF
555 
556  exits("Poisson_EquationsSetSolutionMethodSet")
557  RETURN
558 999 errors("Poisson_EquationsSetSolutionMethodSet",err,error)
559  exits("Poisson_EquationsSetSolutionMethodSet")
560  RETURN 1
561  END SUBROUTINE poisson_equationssetsolutionmethodset
562 
563  !
564  !================================================================================================================================
565  !
566 
568  SUBROUTINE poisson_equationssetspecificationset(equationsSet,specification,err,error,*)
569 
570  !Argument variables
571  TYPE(equations_set_type), POINTER :: equationsSet
572  INTEGER(INTG), INTENT(IN) :: specification(:)
573  INTEGER(INTG), INTENT(OUT) :: err
574  TYPE(varying_string), INTENT(OUT) :: error
575  !Local Variables
576  TYPE(varying_string) :: localError
577  INTEGER(INTG) :: subtype
578 
579  enters("Poisson_EquationsSetSpecificationSet",err,error,*999)
580 
581  IF(ASSOCIATED(equationsset)) THEN
582  IF(SIZE(specification,1)<3) THEN
583  CALL flagerror("Equations set specification must have at least 3 entries for a Poisson equations set.", &
584  & err,error,*999)
585  END IF
586  subtype=specification(3)
587  SELECT CASE(subtype)
588  CASE(equations_set_constant_source_poisson_subtype, &
589  & equations_set_extracellular_bidomain_poisson_subtype, &
590  & equations_set_linear_pressure_poisson_subtype, &
591  & equations_set_nonlinear_pressure_poisson_subtype, &
592  & equations_set_ale_pressure_poisson_subtype, &
593  & equations_set_fitted_pressure_poisson_subtype, &
594  & equations_set_linear_source_poisson_subtype, &
595  & equations_set_quadratic_source_poisson_subtype, &
596  & equations_set_exponential_source_poisson_subtype)
597  !ok
598  CASE DEFAULT
599  localerror="The third equations set specification of "//trim(numbertovstring(subtype,"*",err,error))// &
600  & " is not valid for a Poisson equations set."
601  CALL flagerror(localerror,err,error,*999)
602  END SELECT
603  !Set full specification
604  IF(ALLOCATED(equationsset%specification)) THEN
605  CALL flagerror("Equations set specification is already allocated.",err,error,*999)
606  ELSE
607  ALLOCATE(equationsset%specification(3),stat=err)
608  IF(err/=0) CALL flagerror("Could not allocate equations set specification.",err,error,*999)
609  END IF
610  equationsset%specification(1:3)=[equations_set_classical_field_class,equations_set_poisson_equation_type,subtype]
611  ELSE
612  CALL flagerror("Equations set is not associated.",err,error,*999)
613  END IF
614 
615  exits("Poisson_EquationsSetSpecificationSet")
616  RETURN
617 999 errors("Poisson_EquationsSetSpecificationSet",err,error)
618  exits("Poisson_EquationsSetSpecificationSet")
619  RETURN 1
620 
621  END SUBROUTINE poisson_equationssetspecificationset
622 
623  !
624  !================================================================================================================================
625  !
626 
628  SUBROUTINE poisson_equationssetpressurepoissonsetup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
629 
630  !Argument variables
631  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
632  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
633  INTEGER(INTG), INTENT(OUT) :: ERR
634  TYPE(varying_string), INTENT(OUT) :: ERROR
635  !Local Variables
636  INTEGER(INTG) :: component_idx,GEOMETRIC_COMPONENT_NUMBER,GEOMETRIC_SCALING_TYPE,NUMBER_OF_DIMENSIONS, &
637  & NUMBER_OF_MATERIALS_COMPONENTS,GEOMETRIC_MESH_COMPONENT,SOURCE_FIELD_NUMBER_OF_COMPONENTS,I, &
638  & SOURCE_FIELD_NUMBER_OF_VARIABLES
639  TYPE(decomposition_type), POINTER :: GEOMETRIC_DECOMPOSITION
640  TYPE(equations_type), POINTER :: EQUATIONS
641  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
642  TYPE(equations_set_materials_type), POINTER :: EQUATIONS_MATERIALS
643  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
644  TYPE(field_type), POINTER :: analytic_field,DEPENDENT_FIELD,geometric_field
645  TYPE(varying_string) :: LOCAL_ERROR
646 
647  enters("Poisson_EquationsSetPressurePoissonSetup",err,error,*999)
648  NULLIFY(equations)
649  NULLIFY(equations_mapping)
650  NULLIFY(equations_matrices)
651  NULLIFY(geometric_decomposition)
652  IF(ASSOCIATED(equations_set)) THEN
653  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
654  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
655  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
656  CALL flagerror("Equations set specification must have three entries for a Poisson type equations set.", &
657  & err,error,*999)
658  END IF
659  IF(equations_set%SPECIFICATION(3)==equations_set_linear_pressure_poisson_subtype.OR. &
660  & equations_set%SPECIFICATION(3)==equations_set_nonlinear_pressure_poisson_subtype.OR. &
661  & equations_set%SPECIFICATION(3)==equations_set_ale_pressure_poisson_subtype.OR. &
662  & equations_set%SPECIFICATION(3)==equations_set_fitted_pressure_poisson_subtype) THEN
663  SELECT CASE(equations_set_setup%SETUP_TYPE)
664  CASE(equations_set_setup_initial_type)
665  SELECT CASE(equations_set_setup%ACTION_TYPE)
666  CASE(equations_set_setup_start_action)
667  CALL poisson_equationssetsolutionmethodset(equations_set,equations_set_fem_solution_method,err,error,*999)
668  CASE(equations_set_setup_finish_action)
669 !!TODO: Check valid setup
670  CASE DEFAULT
671  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
672  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
673  & " is invalid for a velocity source Poisson equation."
674  CALL flagerror(local_error,err,error,*999)
675  END SELECT
676  CASE(equations_set_setup_geometry_type)
677  !Do nothing???
678  CASE(equations_set_setup_dependent_type)
679  SELECT CASE(equations_set_setup%ACTION_TYPE)
680  CASE(equations_set_setup_start_action)
681  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
682  !Create the auto created dependent field
683  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
684  & dependent_field,err,error,*999)
685  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
686  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
687  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
688  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
689  & err,error,*999)
690  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
691  & geometric_field,err,error,*999)
692  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,2,err,error,*999)
693  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,(/field_u_variable_type, &
694  & field_deludeln_variable_type/),err,error,*999)
695  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
696  & field_scalar_dimension_type,err,error,*999)
697  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
698  & field_scalar_dimension_type,err,error,*999)
699  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
700  & field_dp_type,err,error,*999)
701  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
702  & field_dp_type,err,error,*999)
703  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
704  & err,error,*999)
705  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
706  & err,error,*999)
707  !Default to the geometric interpolation setup
708  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,1, &
709  & geometric_component_number,err,error,*999)
710  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
711  & geometric_component_number,err,error,*999)
712  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
713  & geometric_component_number,err,error,*999)
714  SELECT CASE(equations_set%SOLUTION_METHOD)
715  CASE(equations_set_fem_solution_method)
716  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
717  & field_node_based_interpolation,err,error,*999)
718  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
719  & field_deludeln_variable_type,1,field_node_based_interpolation,err,error,*999)
720  !Default the scaling to the geometric field scaling
721  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
722  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
723  CASE(equations_set_bem_solution_method)
724  CALL flagerror("Not implemented.",err,error,*999)
725  CASE(equations_set_fd_solution_method)
726  CALL flagerror("Not implemented.",err,error,*999)
727  CASE(equations_set_fv_solution_method)
728  CALL flagerror("Not implemented.",err,error,*999)
729  CASE(equations_set_gfem_solution_method)
730  CALL flagerror("Not implemented.",err,error,*999)
731  CASE(equations_set_gfv_solution_method)
732  CALL flagerror("Not implemented.",err,error,*999)
733  CASE DEFAULT
734  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
735  & " is invalid."
736  CALL flagerror(local_error,err,error,*999)
737  END SELECT
738  ELSE
739  !Check the user specified field
740  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
741  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
742  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
743  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type,field_deludeln_variable_type/), &
744  & err,error,*999)
745  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_scalar_dimension_type,err,error,*999)
746  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_scalar_dimension_type, &
747  & err,error,*999)
748  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
749  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
750  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1,err,error,*999)
751  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type,1,err,error,*999)
752  SELECT CASE(equations_set%SOLUTION_METHOD)
753  CASE(equations_set_fem_solution_method)
754  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
755  & field_node_based_interpolation,err,error,*999)
756  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
757  & field_node_based_interpolation,err,error,*999)
758  CASE(equations_set_bem_solution_method)
759  CALL flagerror("Not implemented.",err,error,*999)
760  CASE(equations_set_fd_solution_method)
761  CALL flagerror("Not implemented.",err,error,*999)
762  CASE(equations_set_fv_solution_method)
763  CALL flagerror("Not implemented.",err,error,*999)
764  CASE(equations_set_gfem_solution_method)
765  CALL flagerror("Not implemented.",err,error,*999)
766  CASE(equations_set_gfv_solution_method)
767  CALL flagerror("Not implemented.",err,error,*999)
768  CASE DEFAULT
769  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
770  & " is invalid."
771  CALL flagerror(local_error,err,error,*999)
772  END SELECT
773  ENDIF
774  CASE(equations_set_setup_finish_action)
775  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
776  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
777  !These 3 parameter sets will contain the original velocity field with x,y,z components
778  CALL field_parameter_set_create(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
779  & field_input_vel1_set_type,err,error,*999)
780  CALL field_parameter_set_create(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
781  & field_input_vel2_set_type,err,error,*999)
782  CALL field_parameter_set_create(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
783  & field_input_vel3_set_type,err,error,*999)
784  !This parameter set will contain the inside/outside labelling information for the PPE approach
785  CALL field_parameter_set_create(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
786  & field_input_label_set_type,err,error,*999)
787  ENDIF
788  CASE DEFAULT
789  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
790  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
791  & " is invalid for a velocity source Poisson equation"
792  CALL flagerror(local_error,err,error,*999)
793  END SELECT
794  CASE(equations_set_setup_materials_type)
795  SELECT CASE(equations_set_setup%ACTION_TYPE)
796  CASE(equations_set_setup_start_action)
797  equations_materials=>equations_set%MATERIALS
798  IF(ASSOCIATED(equations_materials)) THEN
799  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
800  !Create the auto created materials field
801  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_materials% &
802  & materials_field,err,error,*999)
803  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
804  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type,err,error,*999)
805  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
806  CALL field_mesh_decomposition_set_and_lock(equations_materials%MATERIALS_FIELD,geometric_decomposition, &
807  & err,error,*999)
808  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
809  & geometric_field,err,error,*999)
810  CALL field_number_of_variables_set_and_lock(equations_materials%MATERIALS_FIELD,1,err,error,*999)
811  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,(/field_u_variable_type/), &
812  & err,error,*999)
813  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
814  & field_vector_dimension_type,err,error,*999)
815  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
816  & field_dp_type,err,error,*999)
817  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
818  & number_of_dimensions,err,error,*999)
819  IF(equations_set%SPECIFICATION(3)==equations_set_constant_source_poisson_subtype) THEN
820  !Constant source. Materials field components are 1 for each dimension and 1 for the constant source
821  !i.e., k and c in div(k.grad(u(x)))=c(x)
822  number_of_materials_components=number_of_dimensions+1
823  ELSE
824  !Linear source. Materials field components are 1 for each dimension and 2 for the linear source
825  !i.e., k and a and c in div(k.grad(u(x)))=a(x)u(x)+c(x)
826  number_of_materials_components=number_of_dimensions+2
827  ENDIF
828  !Set the number of materials components
829  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
830  & number_of_materials_components,err,error,*999)
831  !Default the k materials components to the geometric interpolation setup with constant interpolation
832  DO component_idx=1,number_of_dimensions
833  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
834  & component_idx,geometric_component_number,err,error,*999)
835  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
836  & component_idx,geometric_component_number,err,error,*999)
837  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
838  & component_idx,field_constant_interpolation,err,error,*999)
839  ENDDO !component_idx
840  !Default the source materials components to the first component geometric interpolation with constant interpolation
841  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
842  & 1,geometric_component_number,err,error,*999)
843  DO component_idx=number_of_dimensions+1,number_of_materials_components
844  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
845  & component_idx,geometric_component_number,err,error,*999)
846  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
847  & component_idx,field_constant_interpolation,err,error,*999)
848  ENDDO !components_idx
849  !Default the field scaling to that of the geometric field
850  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
851  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
852  ELSE
853  !Check the user specified field
854  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
855  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
856  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
857  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type/),err,error,*999)
858  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
859  & err,error,*999)
860  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
861  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
862  & number_of_dimensions,err,error,*999)
863  IF(equations_set%SPECIFICATION(3)==equations_set_constant_source_poisson_subtype) THEN
864  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_dimensions+1, &
865  & err,error,*999)
866  ELSE
867  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_dimensions+2, &
868  & err,error,*999)
869  ENDIF
870  ENDIF
871  ELSE
872  CALL flagerror("Equations set materials is not associated.",err,error,*999)
873  ENDIF
874 
875  CASE(equations_set_setup_finish_action)
876  equations_materials=>equations_set%MATERIALS
877  IF(ASSOCIATED(equations_materials)) THEN
878  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
879  !Finish creating the materials field
880  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
881  !Set the default values for the materials field
882  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
883  & number_of_dimensions,err,error,*999)
884  IF(equations_set%SPECIFICATION(3)==equations_set_constant_source_poisson_subtype) THEN
885  !Constant source. Materials field components are 1 for each dimension and 1 for the constant source
886  !i.e., k and c in div(k.grad(u(x)))=c(x)
887  number_of_materials_components=number_of_dimensions+1
888  ELSE
889  !Linear source. Materials field components are 1 for each dimension and 2 for the linear source
890  !i.e., k and a and c in div(k.grad(u(x)))=a(x)u(x)+c(x)
891  number_of_materials_components=number_of_dimensions+2
892  ENDIF
893  !First set the k values to 1.0
894  DO component_idx=1,number_of_dimensions
895  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
896  & field_values_set_type,component_idx,1.0_dp,err,error,*999)
897  ENDDO !component_idx
898  !Now set the source values to 1.0
899  DO component_idx=number_of_dimensions+1,number_of_materials_components
900  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
901  & field_values_set_type,component_idx,1.0_dp,err,error,*999)
902  ENDDO !component_idx
903  ENDIF
904  ELSE
905  CALL flagerror("Equations set materials is not associated.",err,error,*999)
906  ENDIF
907  CASE DEFAULT
908  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
909  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
910  & " is invalid for a velocity source Poisson equation."
911  CALL flagerror(local_error,err,error,*999)
912  END SELECT
913  CASE(equations_set_setup_source_type)
914  SELECT CASE(equations_set%SPECIFICATION(3))
915  CASE(equations_set_linear_pressure_poisson_subtype,equations_set_nonlinear_pressure_poisson_subtype, &
916  & equations_set_fitted_pressure_poisson_subtype,equations_set_ale_pressure_poisson_subtype)
917  SELECT CASE(equations_set_setup%ACTION_TYPE)
918  !Set start action
919  CASE(equations_set_setup_start_action)
920  IF(equations_set%SOURCE%SOURCE_FIELD_AUTO_CREATED) THEN
921  !Create the auto created source field
922  !start field creation with name 'SOURCE_FIELD'
923  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
924  & equations_set%SOURCE%SOURCE_FIELD,err,error,*999)
925  !start creation of a new field
926  CALL field_type_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_general_type,err,error,*999)
927  !label the field
928  CALL field_label_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,"Source Field",err,error, &
929  & *999)
930  !define new created field to be source
931  CALL field_dependent_type_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
932  & field_independent_type,err,error,*999)
933  !look for decomposition rule already defined
934  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
935  & err,error,*999)
936  !apply decomposition rule found on new created field
937  CALL field_mesh_decomposition_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
938  & geometric_decomposition,err,error,*999)
939  !point new field to geometric field
940  CALL field_geometric_field_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,equations_set% &
941  & geometry%GEOMETRIC_FIELD,err,error,*999)
942  !set number of variables to 1 (1 for U)
943  source_field_number_of_variables=1
944  CALL field_number_of_variables_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
945  & source_field_number_of_variables,err,error,*999)
946  CALL field_variable_types_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
947  & (/field_u_variable_type/),err,error,*999)
948  CALL field_dimension_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
949  & field_vector_dimension_type,err,error,*999)
950  CALL field_data_type_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
951  & field_dp_type,err,error,*999)
952  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
953  & number_of_dimensions,err,error,*999)
954  !calculate number of components with one component for each dimension
955  source_field_number_of_components=number_of_dimensions
956  CALL field_number_of_components_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
957  & field_u_variable_type,source_field_number_of_components,err,error,*999)
958  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
959  & 1,geometric_mesh_component,err,error,*999)
960  !Default to the geometric interpolation setup
961  DO i=1,source_field_number_of_components
962  CALL field_component_mesh_component_set(equations_set%SOURCE%SOURCE_FIELD, &
963  & field_u_variable_type,i,geometric_mesh_component,err,error,*999)
964  END DO
965 
966  SELECT CASE(equations_set%SOLUTION_METHOD)
967  !Specify fem solution method
968  CASE(equations_set_fem_solution_method)
969  DO i=1,source_field_number_of_components
970  CALL field_component_interpolation_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
971  & field_u_variable_type,i,field_node_based_interpolation,err,error,*999)
972  END DO
973  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
974  & err,error,*999)
975  CALL field_scaling_type_set(equations_set%SOURCE%SOURCE_FIELD,geometric_scaling_type, &
976  & err,error,*999)
977  !Other solutions not defined yet
978  CASE DEFAULT
979  local_error="The solution method of " &
980  & //trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// " is invalid."
981  CALL flagerror(local_error,err,error,*999)
982  END SELECT
983  ELSE
984  !Check the user specified field
985  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
986  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
987  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
988  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type/),err,error,*999)
989  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
990  & err,error,*999)
991  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
992  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
993  & number_of_dimensions,err,error,*999)
994  !calculate number of components with one component for each dimension and one for pressure
995  source_field_number_of_components=number_of_dimensions
996  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
997  & source_field_number_of_components,err,error,*999)
998  SELECT CASE(equations_set%SOLUTION_METHOD)
999  CASE(equations_set_fem_solution_method)
1000  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
1001  & field_node_based_interpolation,err,error,*999)
1002  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
1003  & field_node_based_interpolation,err,error,*999)
1004  CASE DEFAULT
1005  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD, &
1006  &"*",err,error))//" is invalid."
1007  CALL flagerror(local_error,err,error,*999)
1008  END SELECT
1009  ENDIF
1010  !Specify finish action
1011  CASE(equations_set_setup_finish_action)
1012  IF(equations_set%SOURCE%SOURCE_FIELD_AUTO_CREATED) THEN
1013  CALL field_create_finish(equations_set%SOURCE%SOURCE_FIELD,err,error,*999)
1014  !These 2 parameter sets will contain the fitted hermite/lagrange velocity field
1015  CALL field_parameter_set_create(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
1016  & field_input_data1_set_type,err,error,*999)
1017  CALL field_parameter_set_create(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
1018  & field_input_data2_set_type,err,error,*999)
1019 ! CALL FIELD_PARAMETER_SET_CREATE(EQUATIONS_SET%SOURCE%SOURCE_FIELD,FIELD_U_VARIABLE_TYPE, &
1020 ! & FIELD_INPUT_DATA3_SET_TYPE,ERR,ERROR,*999)
1021 ! CALL FIELD_PARAMETER_SET_CREATE(EQUATIONS_SET%SOURCE%SOURCE_FIELD,FIELD_U_VARIABLE_TYPE, &
1022 ! & FIELD_BOUNDARY_SET_TYPE,ERR,ERROR,*999)
1023  ENDIF
1024  CASE DEFAULT
1025  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1026  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1027  & " is invalid for a standard Navier-Poisson fluid"
1028  CALL flagerror(local_error,err,error,*999)
1029  END SELECT
1030  CASE DEFAULT
1031  local_error="The equation set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
1032  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1033  & " is invalid for a Navier-Poisson equation."
1034  CALL flagerror(local_error,err,error,*999)
1035  END SELECT
1036  !define an independent field for ALE information
1037  CASE(equations_set_setup_independent_type)
1038  SELECT CASE(equations_set%SPECIFICATION(3))
1039  CASE(equations_set_linear_pressure_poisson_subtype)
1040  !do nothing!
1041  CASE(equations_set_nonlinear_pressure_poisson_subtype)
1042  !do nothing!
1043  CASE(equations_set_ale_pressure_poisson_subtype,equations_set_fitted_pressure_poisson_subtype)
1044  SELECT CASE(equations_set_setup%ACTION_TYPE)
1045  !Set start action
1046  CASE(equations_set_setup_start_action)
1047  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
1048  !Create the auto created independent field
1049  !start field creation with name 'INDEPENDENT_FIELD'
1050  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
1051  & equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
1052  !start creation of a new field
1053  CALL field_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
1054  !label the field
1055  CALL field_label_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,"Independent Field",err,error,*999)
1056  !define new created field to be independent
1057  CALL field_dependent_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1058  & field_independent_type,err,error,*999)
1059  !look for decomposition rule already defined
1060  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
1061  & err,error,*999)
1062  !apply decomposition rule found on new created field
1063  CALL field_mesh_decomposition_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1064  & geometric_decomposition,err,error,*999)
1065  !point new field to geometric field
1066  CALL field_geometric_field_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,equations_set% &
1067  & geometry%GEOMETRIC_FIELD,err,error,*999)
1068  !set number of variables to 1 (1 for U)
1069  CALL field_number_of_variables_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1070  & 1,err,error,*999)
1071  CALL field_variable_types_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1072  & (/field_u_variable_type/),err,error,*999)
1073  CALL field_dimension_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1074  & field_vector_dimension_type,err,error,*999)
1075  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_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  !calculate number of components with one component for each dimension
1080  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1081  & field_u_variable_type,number_of_dimensions,err,error,*999)
1082  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1083  & 1,geometric_mesh_component,err,error,*999)
1084  !Default to the geometric interpolation setup
1085  DO i=1,number_of_dimensions
1086  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1087  & field_u_variable_type,i,geometric_mesh_component,err,error,*999)
1088  END DO
1089  SELECT CASE(equations_set%SOLUTION_METHOD)
1090  !Specify fem solution method
1091  CASE(equations_set_fem_solution_method)
1092  DO i=1,number_of_dimensions
1093  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1094  & field_u_variable_type,i,field_node_based_interpolation,err,error,*999)
1095  END DO
1096  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
1097  & err,error,*999)
1098  CALL field_scaling_type_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_scaling_type, &
1099  & err,error,*999)
1100  !Other solutions not defined yet
1101  CASE DEFAULT
1102  local_error="The solution method of " &
1103  & //trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// " is invalid."
1104  CALL flagerror(local_error,err,error,*999)
1105  END SELECT
1106  ELSE
1107  !Check the user specified field
1108  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1109  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1110  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
1111  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type/),err,error,*999)
1112  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
1113  & err,error,*999)
1114  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1115  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1116  & number_of_dimensions,err,error,*999)
1117  !calculate number of components with one component for each dimension and one for pressure
1118  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
1119  & number_of_dimensions,err,error,*999)
1120  SELECT CASE(equations_set%SOLUTION_METHOD)
1121  CASE(equations_set_fem_solution_method)
1122  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
1123  & field_node_based_interpolation,err,error,*999)
1124  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
1125  & field_node_based_interpolation,err,error,*999)
1126  CASE DEFAULT
1127  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD, &
1128  &"*",err,error))//" is invalid."
1129  CALL flagerror(local_error,err,error,*999)
1130  END SELECT
1131  ENDIF
1132  !Specify finish action
1133  CASE(equations_set_setup_finish_action)
1134  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
1135  CALL field_create_finish(equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
1136  CALL field_parameter_set_create(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1137  & field_mesh_displacement_set_type,err,error,*999)
1138  CALL field_parameter_set_create(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1139  & field_mesh_velocity_set_type,err,error,*999)
1140  CALL field_parameter_set_create(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1141  & field_boundary_set_type,err,error,*999)
1142  ENDIF
1143  CASE DEFAULT
1144  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1145  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1146  & " is invalid for a standard PPE fluid"
1147  CALL flagerror(local_error,err,error,*999)
1148  END SELECT
1149  CASE DEFAULT
1150  local_error="The equation set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
1151  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1152  & " is invalid for a PPE equation."
1153  CALL flagerror(local_error,err,error,*999)
1154  END SELECT
1155  CASE(equations_set_setup_analytic_type)
1156  SELECT CASE(equations_set_setup%ACTION_TYPE)
1157  CASE(equations_set_setup_start_action)
1158  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
1159  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
1160  IF(ASSOCIATED(dependent_field)) THEN
1161  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
1162  IF(ASSOCIATED(geometric_field)) THEN
1163  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
1164  SELECT CASE(equations_set_setup%ANALYTIC_FUNCTION_TYPE)
1165 ! CASE(EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_1)
1166 ! !Set analtyic function type
1167 ! EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_1
1168 ! CASE(EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_2)
1169 ! !Set analtyic function type
1170 ! EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_2
1171 ! CASE(EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_3)
1172 ! !Set analtyic function type
1173 ! EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_STOKES_EQUATION_TWO_DIM_3
1174 ! CASE(EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_1)
1175 ! !Set analtyic function type
1176 ! EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_1
1177 ! CASE(EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_2)
1178 ! !Set analtyic function type
1179 ! EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_STOKES_EQUATION_THREE_DIM_2
1180 ! CASE(EQUATIONS_SET_POISSON_EQUATION_THREE_DIM_3)
1181 ! !Set analtyic function type
1182 ! EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_POISSON_EQUATION_THREE_DIM_3
1183  CASE(equations_set_pressure_poisson_three_dim_1)
1184  !Set analtyic function type
1185  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_pressure_poisson_three_dim_1
1186  CASE(equations_set_pressure_poisson_three_dim_2)
1187  !Set analtyic function type
1188  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_pressure_poisson_three_dim_2
1189  CASE DEFAULT
1190  local_error="The specified analytic function type of "// &
1191  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
1192  & " is invalid for a velocity source Poisson equation."
1193  CALL flagerror(local_error,err,error,*999)
1194  END SELECT
1195  ELSE
1196  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
1197  ENDIF
1198  ELSE
1199  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
1200  ENDIF
1201  ELSE
1202  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
1203  ENDIF
1204  CASE(equations_set_setup_finish_action)
1205  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
1206  analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
1207  IF(ASSOCIATED(analytic_field)) THEN
1208  IF(equations_set%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED) THEN
1209  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
1210  ENDIF
1211  ENDIF
1212  ELSE
1213  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
1214  ENDIF
1215  CASE DEFAULT
1216  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1217  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1218  & " is invalid for a velocity source Poisson equation."
1219  CALL flagerror(local_error,err,error,*999)
1220  END SELECT
1221  CASE(equations_set_setup_equations_type)
1222  SELECT CASE(equations_set_setup%ACTION_TYPE)
1223  CASE(equations_set_setup_start_action)
1224  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
1225  !Create the equations
1226  CALL equations_create_start(equations_set,equations,err,error,*999)
1227  CALL equations_linearity_type_set(equations,equations_linear,err,error,*999)
1228  CALL equations_time_dependence_type_set(equations,equations_quasistatic,err,error,*999)
1229  ELSE
1230  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
1231  ENDIF
1232  CASE(equations_set_setup_finish_action)
1233  SELECT CASE(equations_set%SOLUTION_METHOD)
1234  CASE(equations_set_fem_solution_method)
1235  !Finish the creation of the equations
1236  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
1237  CALL equations_create_finish(equations,err,error,*999)
1238  !Create the equations mapping.
1239  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
1240  CALL equationsmapping_linearmatricesnumberset(equations_mapping,1,err,error,*999)
1241  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,(/field_u_variable_type/), &
1242  & err,error,*999)
1243  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
1244  CALL equations_mapping_source_variable_type_set(equations_mapping,field_u_variable_type,err,error,*999)
1245  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
1246  !Create the equations matrices
1247  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
1248  SELECT CASE(equations%SPARSITY_TYPE)
1249  CASE(equations_matrices_full_matrices)
1250  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_block_storage_type/), &
1251  & err,error,*999)
1252  CASE(equations_matrices_sparse_matrices)
1253  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_compressed_row_storage_type/), &
1254  & err,error,*999)
1255  CALL equationsmatrices_linearstructuretypeset(equations_matrices,(/equations_matrix_fem_structure/), &
1256  & err,error,*999)
1257  CASE DEFAULT
1258  local_error="The equations matrices sparsity type of "// &
1259  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
1260  CALL flagerror(local_error,err,error,*999)
1261  END SELECT
1262  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
1263  CASE(equations_set_bem_solution_method)
1264  CALL flagerror("Not implemented.",err,error,*999)
1265  CASE(equations_set_fd_solution_method)
1266  CALL flagerror("Not implemented.",err,error,*999)
1267  CASE(equations_set_fv_solution_method)
1268  CALL flagerror("Not implemented.",err,error,*999)
1269  CASE(equations_set_gfem_solution_method)
1270  CALL flagerror("Not implemented.",err,error,*999)
1271  CASE(equations_set_gfv_solution_method)
1272  CALL flagerror("Not implemented.",err,error,*999)
1273  CASE DEFAULT
1274  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1275  & " is invalid."
1276  CALL flagerror(local_error,err,error,*999)
1277  END SELECT
1278  CASE DEFAULT
1279  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1280  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1281  & " is invalid for a velocity source Poisson equation."
1282  CALL flagerror(local_error,err,error,*999)
1283  END SELECT
1284  CASE DEFAULT
1285  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1286  & " is invalid for a velocity source Poisson equation."
1287  CALL flagerror(local_error,err,error,*999)
1288  END SELECT
1289  ELSE
1290  local_error="The equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
1291  & " is not a velocity source Poisson equation subtype."
1292  CALL flagerror(local_error,err,error,*999)
1293  ENDIF
1294  ELSE
1295  CALL flagerror("Equations set is not associated.",err,error,*999)
1296  ENDIF
1297 
1298  exits("Poisson_EquationsSetPressurePoissonSetup")
1299  RETURN
1300 999 errors("Poisson_EquationsSetPressurePoissonSetup",err,error)
1301  exits("Poisson_EquationsSetPressurePoissonSetup")
1302  RETURN 1
1303 
1304  END SUBROUTINE poisson_equationssetpressurepoissonsetup
1305 
1306  !
1307  !================================================================================================================================
1308  !
1310 
1311  SUBROUTINE poisson_pre_solve_update_ppe_mesh(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
1312 
1313  !Argument variables
1314  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1315  TYPE(solver_type), POINTER :: SOLVER
1316  INTEGER(INTG), INTENT(OUT) :: ERR
1317  TYPE(varying_string), INTENT(OUT) :: ERROR
1318  !Local Variables
1319  TYPE(solver_type), POINTER :: SOLVER_ALE_PPE, SOLVER_LAPLACE
1320  TYPE(field_type), POINTER :: INDEPENDENT_FIELD_ALE_PPE
1321  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS_ALE_PPE
1322  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING_ALE_PPE
1323  TYPE(equations_set_type), POINTER :: EQUATIONS_SET_ALE_PPE
1324  TYPE(equations_type), POINTER :: EQUATIONS
1325  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
1326  TYPE(varying_string) :: LOCAL_ERROR
1327  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
1328  TYPE(domain_type), POINTER :: DOMAIN
1329  TYPE(domain_nodes_type), POINTER :: DOMAIN_NODES
1330 
1331  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT,ALPHA
1332  REAL(DP), POINTER :: MESH_DISPLACEMENT_VALUES(:)
1333  INTEGER(INTG) :: NUMBER_OF_DIMENSIONS_ALE_PPE,GEOMETRIC_MESH_COMPONENT
1334  INTEGER(INTG) :: INPUT_TYPE,INPUT_OPTION,component_idx,deriv_idx,local_ny,node_idx,variable_idx,variable_type
1335 
1336  enters("POISSON_PRE_SOLVE_UPDATE_PPE_MESH",err,error,*999)
1337 
1338  IF(ASSOCIATED(control_loop)) THEN
1339  CALL control_loop_current_times_get(control_loop%PARENT_LOOP,current_time,time_increment,err,error,*999)
1340  NULLIFY(solver_laplace)
1341  NULLIFY(solver_ale_ppe)
1342  IF(ASSOCIATED(solver)) THEN
1343  IF(ASSOCIATED(control_loop%PARENT_LOOP%PROBLEM)) THEN
1344  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
1345  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1346  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
1347  CALL flagerror("Problem specification must have three entries for a Poisson problem.",err,error,*999)
1348  END IF
1349  SELECT CASE(control_loop%PARENT_LOOP%PROBLEM%SPECIFICATION(3))
1350  CASE(problem_linear_pressure_poisson_subtype)
1351  ! do nothing ???
1352  CASE(problem_nonlinear_pressure_poisson_subtype)
1353  ! do nothing ???
1354  CASE(problem_ale_pressure_poisson_subtype)
1355  !Update mesh within the dynamic solver
1356  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
1357  !Get the independent field for the ALE PPE problem
1358  CALL solvers_solver_get(solver%SOLVERS,1,solver_ale_ppe,err,error,*999)
1359  solver_equations_ale_ppe=>solver_ale_ppe%SOLVER_EQUATIONS
1360  IF(ASSOCIATED(solver_equations_ale_ppe)) THEN
1361  solver_mapping_ale_ppe=>solver_equations_ale_ppe%SOLVER_MAPPING
1362  IF(ASSOCIATED(solver_mapping_ale_ppe)) THEN
1363  equations_set_ale_ppe=>solver_mapping_ale_ppe%EQUATIONS_SETS(1)%PTR
1364  IF(ASSOCIATED(equations_set_ale_ppe)) THEN
1365  independent_field_ale_ppe=>equations_set_ale_ppe%INDEPENDENT%INDEPENDENT_FIELD
1366  ELSE
1367  CALL flagerror("ALE PPE equations set is not associated.",err,error,*999)
1368  END IF
1369  !Get the data
1370  CALL field_number_of_components_get(equations_set_ale_ppe%GEOMETRY%GEOMETRIC_FIELD, &
1371  & field_u_variable_type,number_of_dimensions_ale_ppe,err,error,*999)
1372 !\todo: Introduce flags set by the user (42/1 only for testings purpose)
1373  !Copy input to PPE' independent field
1374  input_type=42
1375  input_option=1
1376  NULLIFY(mesh_displacement_values)
1377  CALL field_parameter_set_data_get(equations_set_ale_ppe%INDEPENDENT%INDEPENDENT_FIELD, &
1378  & field_u_variable_type,field_mesh_displacement_set_type,mesh_displacement_values,err,error,*999)
1379  CALL fluid_mechanics_io_read_data(solver_linear_type,mesh_displacement_values, &
1380  & number_of_dimensions_ale_ppe,input_type,input_option,control_loop%PARENT_LOOP%TIME_LOOP% &
1381  & iteration_number,1.0_dp)
1382  CALL field_parameter_set_update_start(equations_set_ale_ppe%INDEPENDENT%INDEPENDENT_FIELD, &
1383  & field_u_variable_type,field_mesh_displacement_set_type,err,error,*999)
1384  CALL field_parameter_set_update_finish(equations_set_ale_ppe%INDEPENDENT%INDEPENDENT_FIELD, &
1385  & field_u_variable_type,field_mesh_displacement_set_type,err,error,*999)
1386  ELSE
1387  CALL flagerror("ALE PPE solver mapping is not associated.",err,error,*999)
1388  END IF
1389  ELSE
1390  CALL flagerror("ALE PPE solver equations are not associated.",err,error,*999)
1391  END IF
1392  !Use calculated values to update mesh
1393  CALL field_component_mesh_component_get(equations_set_ale_ppe%GEOMETRY%GEOMETRIC_FIELD, &
1394  & field_u_variable_type,1,geometric_mesh_component,err,error,*999)
1395 ! CALL FIELD_PARAMETER_SET_DATA_GET(INDEPENDENT_FIELD_ALE_PPE,FIELD_U_VARIABLE_TYPE, &
1396 ! & FIELD_MESH_DISPLACEMENT_SET_TYPE,MESH_DISPLACEMENT_VALUES,ERR,ERROR,*999)
1397  equations=>solver_mapping_ale_ppe%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
1398  IF(ASSOCIATED(equations)) THEN
1399  equations_mapping=>equations%EQUATIONS_MAPPING
1400  IF(ASSOCIATED(equations_mapping)) THEN
1401  DO variable_idx=1,equations_set_ale_ppe%DEPENDENT%DEPENDENT_FIELD%NUMBER_OF_VARIABLES
1402  variable_type=equations_set_ale_ppe%DEPENDENT%DEPENDENT_FIELD%VARIABLES(variable_idx)%VARIABLE_TYPE
1403  field_variable=>equations_set_ale_ppe%GEOMETRY%GEOMETRIC_FIELD%VARIABLE_TYPE_MAP(variable_type)%PTR
1404  IF(ASSOCIATED(field_variable)) THEN
1405  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
1406  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
1407  IF(ASSOCIATED(domain)) THEN
1408  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
1409  domain_nodes=>domain%TOPOLOGY%NODES
1410  IF(ASSOCIATED(domain_nodes)) THEN
1411  !Loop over the local nodes excluding the ghosts.
1412  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
1413  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
1414  !Default to version 1 of each node derivative
1415  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
1416  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
1417  CALL field_parameter_set_add_local_dof(equations_set_ale_ppe%GEOMETRY%GEOMETRIC_FIELD, &
1418  & field_u_variable_type,field_values_set_type,local_ny, &
1419  & mesh_displacement_values(local_ny),err,error,*999)
1420  ENDDO !deriv_idx
1421  ENDDO !node_idx
1422  ENDIF
1423  ENDIF
1424  ENDIF
1425  ENDDO !component_idx
1426  ENDIF
1427  ENDDO !variable_idx
1428  ELSE
1429  CALL flagerror("Equations mapping is not associated.",err,error,*999)
1430  END IF
1431  ELSE
1432  CALL flagerror("Equations are not associated.",err,error,*999)
1433  END IF
1434  CALL field_parameter_set_update_start(equations_set_ale_ppe%GEOMETRY%GEOMETRIC_FIELD, &
1435  & field_u_variable_type,field_values_set_type,err,error,*999)
1436  CALL field_parameter_set_update_finish(equations_set_ale_ppe%GEOMETRY%GEOMETRIC_FIELD, &
1437  & field_u_variable_type,field_values_set_type,err,error,*999)
1438  !Now use displacement values to calculate velocity values
1439  time_increment=control_loop%PARENT_LOOP%TIME_LOOP%TIME_INCREMENT
1440  alpha=1.0_dp/time_increment
1441  CALL field_parameter_sets_copy(independent_field_ale_ppe,field_u_variable_type, &
1442  & field_mesh_displacement_set_type,field_mesh_velocity_set_type,alpha,err,error,*999)
1443  ELSE
1444  CALL flagerror("Mesh motion calculation not successful for ALE problem.",err,error,*999)
1445  END IF
1446  CASE DEFAULT
1447  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
1448  & " is not valid for a PPE equation fluid type of a fluid mechanics problem class."
1449  CALL flagerror(local_error,err,error,*999)
1450  END SELECT
1451  ELSE
1452  CALL flagerror("Problem is not associated.",err,error,*999)
1453  ENDIF
1454  ELSE
1455  CALL flagerror("Solver is not associated.",err,error,*999)
1456  ENDIF
1457  ELSE
1458  CALL flagerror("Control loop is not associated.",err,error,*999)
1459  ENDIF
1460  exits("POISSON_PRE_SOLVE_UPDATE_PPE_MESH")
1461  RETURN
1462 999 errorsexits("POISSON_PRE_SOLVE_UPDATE_PPE_MESH",err,error)
1463  RETURN 1
1464  END SUBROUTINE poisson_pre_solve_update_ppe_mesh
1465 
1466  !
1467  !================================================================================================================================
1468  !
1470 
1471  SUBROUTINE poisson_pre_solve_update_ppe_source(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
1472 
1473  !Argument variables
1474  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1475  TYPE(solver_type), POINTER :: SOLVER
1476  INTEGER(INTG), INTENT(OUT) :: ERR
1477  TYPE(varying_string), INTENT(OUT) :: ERROR
1478  !Local Variables
1479  TYPE(solver_type), POINTER :: SOLVER_FITTED, SOLVER_PPE
1480  TYPE(field_type), POINTER :: DEPENDENT_FIELD_FITTED,SOURCE_FIELD_PPE
1481  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS_FITTED, SOLVER_EQUATIONS_PPE
1482  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING_FITTED, SOLVER_MAPPING_PPE
1483  TYPE(equations_set_type), POINTER :: EQUATIONS_SET_FITTED, EQUATIONS_SET_PPE
1484 ! TYPE(EQUATIONS_TYPE), POINTER :: EQUATIONS
1485 ! TYPE(EQUATIONS_MAPPING_TYPE), POINTER :: EQUATIONS_MAPPING
1486  TYPE(varying_string) :: LOCAL_ERROR
1487 ! TYPE(FIELD_VARIABLE_TYPE), POINTER :: FIELD_VARIABLE
1488 ! TYPE(DOMAIN_TYPE), POINTER :: DOMAIN
1489 ! TYPE(DOMAIN_NODES_TYPE), POINTER :: DOMAIN_NODES
1490 
1491  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT
1492  INTEGER(INTG) :: I,NUMBER_OF_DIMENSIONS_PPE,NUMBER_OF_DIMENSIONS_FITTED,GEOMETRIC_MESH_COMPONENT
1493 
1494  enters("POISSON_PRE_SOLVE_UPDATE_PPE_SOURCE",err,error,*999)
1495 
1496  IF(ASSOCIATED(control_loop)) THEN
1497  CALL control_loop_current_times_get(control_loop,current_time,time_increment,err,error,*999)
1498  NULLIFY(solver_ppe)
1499  NULLIFY(solver_fitted)
1500  IF(ASSOCIATED(solver)) THEN
1501  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
1502  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
1503  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1504  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
1505  CALL flagerror("Problem specification must have three entries for a Poisson problem.",err,error,*999)
1506  END IF
1507  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
1508  CASE(problem_linear_pressure_poisson_subtype)
1509  ! do nothing ???
1510  CASE(problem_nonlinear_pressure_poisson_subtype)
1511  ! do nothing ???
1512  CASE(problem_ale_pressure_poisson_subtype)
1513  ! do nothing ???
1514  CASE(problem_fitted_pressure_poisson_subtype)
1515  IF(solver%GLOBAL_NUMBER==1) THEN
1516  !do nothing for the fitting process
1517  ELSE IF(solver%GLOBAL_NUMBER==2) THEN
1518  !Get the dependent field for the three component Laplace problem
1519  CALL solvers_solver_get(solver%SOLVERS,1,solver_fitted,err,error,*999)
1520  solver_equations_fitted=>solver_fitted%SOLVER_EQUATIONS
1521  IF(ASSOCIATED(solver_equations_fitted)) THEN
1522  solver_mapping_fitted=>solver_equations_fitted%SOLVER_MAPPING
1523  IF(ASSOCIATED(solver_mapping_fitted)) THEN
1524  equations_set_fitted=>solver_mapping_fitted%EQUATIONS_SETS(1)%PTR
1525  IF(ASSOCIATED(equations_set_fitted)) THEN
1526  dependent_field_fitted=>equations_set_fitted%DEPENDENT%DEPENDENT_FIELD
1527  ELSE
1528  CALL flagerror("Fitted equations set is not associated.",err,error,*999)
1529  END IF
1530  CALL field_number_of_components_get(equations_set_fitted%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1531  & number_of_dimensions_fitted,err,error,*999)
1532  ELSE
1533  CALL flagerror("Fitted solver mapping is not associated.",err,error,*999)
1534  END IF
1535  ELSE
1536  CALL flagerror("Fitted solver equations are not associated.",err,error,*999)
1537  END IF
1538  !Get the source field for the PPE problem
1539  CALL solvers_solver_get(solver%SOLVERS,2,solver_ppe,err,error,*999)
1540  solver_equations_ppe=>solver_ppe%SOLVER_EQUATIONS
1541  IF(ASSOCIATED(solver_equations_ppe)) THEN
1542  solver_mapping_ppe=>solver_equations_ppe%SOLVER_MAPPING
1543  IF(ASSOCIATED(solver_mapping_ppe)) THEN
1544  equations_set_ppe=>solver_mapping_ppe%EQUATIONS_SETS(1)%PTR
1545  IF(ASSOCIATED(equations_set_ppe)) THEN
1546  source_field_ppe=>equations_set_ppe%SOURCE%SOURCE_FIELD
1547  ELSE
1548  CALL flagerror("PPE equations set is not associated.",err,error,*999)
1549  END IF
1550  CALL field_number_of_components_get(equations_set_ppe%GEOMETRY%GEOMETRIC_FIELD, &
1551  & field_u_variable_type,number_of_dimensions_ppe,err,error,*999)
1552  ELSE
1553  CALL flagerror("PPE solver mapping is not associated.",err,error,*999)
1554  END IF
1555  ELSE
1556  CALL flagerror("PPE solver equations are not associated.",err,error,*999)
1557  END IF
1558  !Copy result from FITTING to PPE's source field
1559  IF(number_of_dimensions_ppe==number_of_dimensions_fitted) THEN
1560  IF(control_loop%TIME_LOOP%ITERATION_NUMBER/=1) THEN
1561  DO i=1,number_of_dimensions_ppe
1562  CALL write_string(general_output_type,"Save old source field... ",err,error,*999)
1563  CALL field_parameterstofieldparameterscopy(source_field_ppe, &
1564  & field_u_variable_type,field_input_data1_set_type,i,source_field_ppe, &
1565  & field_u_variable_type,field_input_data2_set_type,i,err,error,*999)
1566  END DO
1567  ENDIF
1568  CALL write_string(general_output_type,"Update new source field... ",err,error,*999)
1569  DO i=1,number_of_dimensions_ppe
1570  CALL field_parameterstofieldparameterscopy(dependent_field_fitted, &
1571  & field_u_variable_type,field_values_set_type,i,source_field_ppe, &
1572  & field_u_variable_type,field_input_data1_set_type,i,err,error,*999)
1573  END DO
1574  IF(control_loop%TIME_LOOP%ITERATION_NUMBER==1) THEN
1575  CALL write_string(general_output_type,"Old source field is new source field!... ",err,error,*999)
1576  DO i=1,number_of_dimensions_ppe
1577  CALL field_parameterstofieldparameterscopy(source_field_ppe, &
1578  & field_u_variable_type,field_input_data1_set_type,i,source_field_ppe, &
1579  & field_u_variable_type,field_input_data2_set_type,i,err,error,*999)
1580  END DO
1581  ENDIF
1582  ELSE
1583  CALL flagerror("Dimension of FITTED and PPE equations set is not consistent.",err,error,*999)
1584  END IF
1585  !Use calculated values to update mesh
1586  CALL field_component_mesh_component_get(equations_set_ppe%GEOMETRY%GEOMETRIC_FIELD, &
1587  & field_u_variable_type,1,geometric_mesh_component,err,error,*999)
1588  CALL field_parameter_set_update_start(equations_set_ppe%SOURCE%SOURCE_FIELD,field_u_variable_type, &
1589  & field_input_data1_set_type,err,error,*999)
1590  CALL field_parameter_set_update_finish(equations_set_ppe%SOURCE%SOURCE_FIELD,field_u_variable_type, &
1591  & field_input_data1_set_type,err,error,*999)
1592  CALL field_parameter_set_update_start(equations_set_ppe%SOURCE%SOURCE_FIELD,field_u_variable_type, &
1593  & field_input_data2_set_type,err,error,*999)
1594  CALL field_parameter_set_update_finish(equations_set_ppe%SOURCE%SOURCE_FIELD,field_u_variable_type, &
1595  & field_input_data2_set_type,err,error,*999)
1596  ELSE
1597  CALL flagerror("Mesh update is not defined for non-dynamic problems.",err,error,*999)
1598  END IF
1599  CASE DEFAULT
1600  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
1601  & " is not valid for a PPE equation fluid type of a fluid mechanics problem class."
1602  CALL flagerror(local_error,err,error,*999)
1603  END SELECT
1604  ELSE
1605  CALL flagerror("Problem is not associated.",err,error,*999)
1606  ENDIF
1607  ELSE
1608  CALL flagerror("Solver is not associated.",err,error,*999)
1609  ENDIF
1610  ELSE
1611  CALL flagerror("Control loop is not associated.",err,error,*999)
1612  ENDIF
1613  exits("POISSON_PRE_SOLVE_UPDATE_PPE_SOURCE")
1614  RETURN
1615 999 errorsexits("POISSON_PRE_SOLVE_UPDATE_PPE_SOURCE",err,error)
1616  RETURN 1
1617  END SUBROUTINE poisson_pre_solve_update_ppe_source
1618 
1619  !
1620  !================================================================================================================================
1621  !
1622 
1623 
1625  SUBROUTINE poisson_equationssetlinearsourcesetup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
1626 
1627  !Argument variables
1628  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1629  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
1630  INTEGER(INTG), INTENT(OUT) :: ERR
1631  TYPE(varying_string), INTENT(OUT) :: ERROR
1632  !Local Variables
1633  INTEGER(INTG) :: component_idx,GEOMETRIC_COMPONENT_NUMBER,GEOMETRIC_SCALING_TYPE,NUMBER_OF_DIMENSIONS, &
1634  & NUMBER_OF_MATERIALS_COMPONENTS, GEOMETRIC_MESH_COMPONENT,SOURCE_FIELD_NUMBER_OF_COMPONENTS,I, &
1635  & SOURCE_FIELD_NUMBER_OF_VARIABLES
1636  TYPE(decomposition_type), POINTER :: GEOMETRIC_DECOMPOSITION
1637  TYPE(equations_type), POINTER :: EQUATIONS
1638  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
1639  TYPE(equations_set_materials_type), POINTER :: EQUATIONS_MATERIALS
1640  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
1641  TYPE(field_type), POINTER :: analytic_field,DEPENDENT_FIELD,geometric_field
1642  TYPE(varying_string) :: LOCAL_ERROR
1643 
1644  enters("POISSON_EQUATION_EQUATION_SET_LINEAR_SOURCE_SETUP",err,error,*999)
1645 
1646  NULLIFY(equations)
1647  NULLIFY(equations_mapping)
1648  NULLIFY(equations_matrices)
1649  NULLIFY(geometric_decomposition)
1650 
1651  IF(ASSOCIATED(equations_set)) THEN
1652  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
1653  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
1654  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
1655  CALL flagerror("Equations set specification must have three entries for a Poisson type equations set.", &
1656  & err,error,*999)
1657  END IF
1658  IF(equations_set%SPECIFICATION(3)==equations_set_constant_source_poisson_subtype.OR. &
1659  & equations_set%SPECIFICATION(3)==equations_set_linear_source_poisson_subtype) THEN
1660  SELECT CASE(equations_set_setup%SETUP_TYPE)
1661  CASE(equations_set_setup_initial_type)
1662  SELECT CASE(equations_set_setup%ACTION_TYPE)
1663  CASE(equations_set_setup_start_action)
1664  CALL poisson_equationssetsolutionmethodset(equations_set,equations_set_fem_solution_method,err,error,*999)
1665  CASE(equations_set_setup_finish_action)
1666 !!TODO: Check valid setup
1667  CASE DEFAULT
1668  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1669  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1670  & " is invalid for a linear source Poisson equation."
1671  CALL flagerror(local_error,err,error,*999)
1672  END SELECT
1673  CASE(equations_set_setup_geometry_type)
1674  !Do nothing???
1675  CASE(equations_set_setup_dependent_type)
1676  SELECT CASE(equations_set_setup%ACTION_TYPE)
1677  CASE(equations_set_setup_start_action)
1678  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
1679  !Create the auto created dependent field
1680  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
1681  & dependent_field,err,error,*999)
1682  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
1683  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
1684  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
1685  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
1686  & err,error,*999)
1687  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
1688  & geometric_field,err,error,*999)
1689  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,2,err,error,*999)
1690  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,(/field_u_variable_type, &
1691  & field_deludeln_variable_type/),err,error,*999)
1692  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1693  & field_scalar_dimension_type,err,error,*999)
1694  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
1695  & field_scalar_dimension_type,err,error,*999)
1696  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1697  & field_dp_type,err,error,*999)
1698  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
1699  & field_dp_type,err,error,*999)
1700  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
1701  & err,error,*999)
1702  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
1703  & err,error,*999)
1704  !Default to the geometric interpolation setup
1705  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,1, &
1706  & geometric_component_number,err,error,*999)
1707  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
1708  & geometric_component_number,err,error,*999)
1709  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
1710  & geometric_component_number,err,error,*999)
1711  SELECT CASE(equations_set%SOLUTION_METHOD)
1712  CASE(equations_set_fem_solution_method)
1713  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
1714  & field_node_based_interpolation,err,error,*999)
1715  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1716  & field_deludeln_variable_type,1,field_node_based_interpolation,err,error,*999)
1717  !Default the scaling to the geometric field scaling
1718  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
1719  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
1720  CASE(equations_set_bem_solution_method)
1721  CALL flagerror("Not implemented.",err,error,*999)
1722  CASE(equations_set_fd_solution_method)
1723  CALL flagerror("Not implemented.",err,error,*999)
1724  CASE(equations_set_fv_solution_method)
1725  CALL flagerror("Not implemented.",err,error,*999)
1726  CASE(equations_set_gfem_solution_method)
1727  CALL flagerror("Not implemented.",err,error,*999)
1728  CASE(equations_set_gfv_solution_method)
1729  CALL flagerror("Not implemented.",err,error,*999)
1730  CASE DEFAULT
1731  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1732  & " is invalid."
1733  CALL flagerror(local_error,err,error,*999)
1734  END SELECT
1735  ELSE
1736  !Check the user specified field
1737  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1738  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
1739  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
1740  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type,field_deludeln_variable_type/), &
1741  & err,error,*999)
1742  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_scalar_dimension_type,err,error,*999)
1743  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_scalar_dimension_type, &
1744  & err,error,*999)
1745  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1746  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
1747  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1,err,error,*999)
1748  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type,1,err,error,*999)
1749  SELECT CASE(equations_set%SOLUTION_METHOD)
1750  CASE(equations_set_fem_solution_method)
1751  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
1752  & field_node_based_interpolation,err,error,*999)
1753  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
1754  & field_node_based_interpolation,err,error,*999)
1755  CASE(equations_set_bem_solution_method)
1756  CALL flagerror("Not implemented.",err,error,*999)
1757  CASE(equations_set_fd_solution_method)
1758  CALL flagerror("Not implemented.",err,error,*999)
1759  CASE(equations_set_fv_solution_method)
1760  CALL flagerror("Not implemented.",err,error,*999)
1761  CASE(equations_set_gfem_solution_method)
1762  CALL flagerror("Not implemented.",err,error,*999)
1763  CASE(equations_set_gfv_solution_method)
1764  CALL flagerror("Not implemented.",err,error,*999)
1765  CASE DEFAULT
1766  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1767  & " is invalid."
1768  CALL flagerror(local_error,err,error,*999)
1769  END SELECT
1770  ENDIF
1771  CASE(equations_set_setup_finish_action)
1772  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
1773  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
1774  ENDIF
1775  CASE DEFAULT
1776  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1777  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1778  & " is invalid for a linear source Poisson equation"
1779  CALL flagerror(local_error,err,error,*999)
1780  END SELECT
1781  CASE(equations_set_setup_materials_type)
1782  SELECT CASE(equations_set_setup%ACTION_TYPE)
1783  CASE(equations_set_setup_start_action)
1784  equations_materials=>equations_set%MATERIALS
1785  IF(ASSOCIATED(equations_materials)) THEN
1786  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
1787  !Create the auto created materials field
1788  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_materials% &
1789  & materials_field,err,error,*999)
1790  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
1791  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type,err,error,*999)
1792  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
1793  CALL field_mesh_decomposition_set_and_lock(equations_materials%MATERIALS_FIELD,geometric_decomposition, &
1794  & err,error,*999)
1795  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
1796  & geometric_field,err,error,*999)
1797  CALL field_number_of_variables_set_and_lock(equations_materials%MATERIALS_FIELD,1,err,error,*999)
1798  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,(/field_u_variable_type/), &
1799  & err,error,*999)
1800  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1801  & field_vector_dimension_type,err,error,*999)
1802  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1803  & field_dp_type,err,error,*999)
1804  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1805  & number_of_dimensions,err,error,*999)
1806  IF(equations_set%SPECIFICATION(3)==equations_set_constant_source_poisson_subtype) THEN
1807  !Constant source. Materials field components are 1 for each dimension and 1 for the constant source
1808  !i.e., k and c in div(k.grad(u(x)))=c(x)
1809  number_of_materials_components=number_of_dimensions+1
1810  ELSE
1811  !Linear source. Materials field components are 1 for each dimension and 2 for the linear source
1812  !i.e., k and a and c in div(k.grad(u(x)))=a(x)u(x)+c(x)
1813  number_of_materials_components=number_of_dimensions+2
1814  ENDIF
1815  !Set the number of materials components
1816  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1817  & number_of_materials_components,err,error,*999)
1818  !Default the k materials components to the geometric interpolation setup with constant interpolation
1819  DO component_idx=1,number_of_dimensions
1820  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1821  & component_idx,geometric_component_number,err,error,*999)
1822  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1823  & component_idx,geometric_component_number,err,error,*999)
1824  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1825  & component_idx,field_constant_interpolation,err,error,*999)
1826  ENDDO !component_idx
1827  !Default the source materials components to the first component geometric interpolation with constant interpolation
1828  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1829  & 1,geometric_component_number,err,error,*999)
1830  DO component_idx=number_of_dimensions+1,number_of_materials_components
1831  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1832  & component_idx,geometric_component_number,err,error,*999)
1833  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1834  & component_idx,field_constant_interpolation,err,error,*999)
1835  ENDDO !components_idx
1836  !Default the field scaling to that of the geometric field
1837  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
1838  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
1839  ELSE
1840  !Check the user specified field
1841  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
1842  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1843  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
1844  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type/),err,error,*999)
1845  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
1846  & err,error,*999)
1847  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1848  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1849  & number_of_dimensions,err,error,*999)
1850  IF(equations_set%SPECIFICATION(3)==equations_set_constant_source_poisson_subtype) THEN
1851  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_dimensions+1, &
1852  & err,error,*999)
1853  ELSE
1854  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_dimensions+2, &
1855  & err,error,*999)
1856  ENDIF
1857  ENDIF
1858  ELSE
1859  CALL flagerror("Equations set materials is not associated.",err,error,*999)
1860  ENDIF
1861 
1862  CASE(equations_set_setup_finish_action)
1863  equations_materials=>equations_set%MATERIALS
1864  IF(ASSOCIATED(equations_materials)) THEN
1865  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
1866  !Finish creating the materials field
1867  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
1868  !Set the default values for the materials field
1869  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1870  & number_of_dimensions,err,error,*999)
1871  IF(equations_set%SPECIFICATION(3)==equations_set_constant_source_poisson_subtype) THEN
1872  !Constant source. Materials field components are 1 for each dimension and 1 for the constant source
1873  !i.e., k and c in div(k.grad(u(x)))=c(x)
1874  number_of_materials_components=number_of_dimensions+1
1875  ELSE
1876  !Linear source. Materials field components are 1 for each dimension and 2 for the linear source
1877  !i.e., k and a and c in div(k.grad(u(x)))=a(x)u(x)+c(x)
1878  number_of_materials_components=number_of_dimensions+2
1879  ENDIF
1880  !First set the k values to 1.0
1881  DO component_idx=1,number_of_dimensions
1882  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1883  & field_values_set_type,component_idx,1.0_dp,err,error,*999)
1884  ENDDO !component_idx
1885  !Now set the source values to 1.0
1886  DO component_idx=number_of_dimensions+1,number_of_materials_components
1887  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1888  & field_values_set_type,component_idx,1.0_dp,err,error,*999)
1889  ENDDO !component_idx
1890  ENDIF
1891  ELSE
1892  CALL flagerror("Equations set materials is not associated.",err,error,*999)
1893  ENDIF
1894  CASE DEFAULT
1895  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1896  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1897  & " is invalid for a linear source Poisson equation."
1898  CALL flagerror(local_error,err,error,*999)
1899  END SELECT
1900  CASE(equations_set_setup_source_type)
1901  SELECT CASE(equations_set%SPECIFICATION(3))
1902  CASE(equations_set_constant_source_poisson_subtype,equations_set_linear_source_poisson_subtype)
1903  SELECT CASE(equations_set_setup%ACTION_TYPE)
1904  !Set start action
1905  CASE(equations_set_setup_start_action)
1906  IF(equations_set%SOURCE%SOURCE_FIELD_AUTO_CREATED) THEN
1907  !Create the auto created source field
1908  !start field creation with name 'SOURCE_FIELD'
1909  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
1910  & equations_set%SOURCE%SOURCE_FIELD,err,error,*999)
1911  !start creation of a new field
1912  CALL field_type_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_general_type,err,error,*999)
1913  !label the field
1914  CALL field_label_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,"Source Field",err,error, &
1915  & *999)
1916  !define new created field to be source
1917  CALL field_dependent_type_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
1918  & field_independent_type,err,error,*999)
1919  !look for decomposition rule already defined
1920  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
1921  & err,error,*999)
1922  !apply decomposition rule found on new created field
1923  CALL field_mesh_decomposition_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
1924  & geometric_decomposition,err,error,*999)
1925  !point new field to geometric field
1926  CALL field_geometric_field_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,equations_set% &
1927  & geometry%GEOMETRIC_FIELD,err,error,*999)
1928  !set number of variables to 1 (1 for U)
1929  source_field_number_of_variables=1
1930  CALL field_number_of_variables_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
1931  & source_field_number_of_variables,err,error,*999)
1932  CALL field_variable_types_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
1933  & (/field_u_variable_type/),err,error,*999)
1934  CALL field_dimension_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
1935  & field_vector_dimension_type,err,error,*999)
1936  CALL field_data_type_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
1937  & field_dp_type,err,error,*999)
1938  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1939  & number_of_dimensions,err,error,*999)
1940  !calculate number of components with one component for each dimension
1941  source_field_number_of_components=number_of_dimensions
1942  CALL field_number_of_components_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
1943  & field_u_variable_type,source_field_number_of_components,err,error,*999)
1944  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1945  & 1,geometric_mesh_component,err,error,*999)
1946  !Default to the geometric interpolation setup
1947  DO i=1,source_field_number_of_components
1948  CALL field_component_mesh_component_set(equations_set%SOURCE%SOURCE_FIELD, &
1949  & field_u_variable_type,i,geometric_mesh_component,err,error,*999)
1950  END DO
1951  SELECT CASE(equations_set%SOLUTION_METHOD)
1952  !Specify fem solution method
1953  CASE(equations_set_fem_solution_method)
1954  DO i=1,source_field_number_of_components
1955  CALL field_component_interpolation_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
1956  & field_u_variable_type,i,field_node_based_interpolation,err,error,*999)
1957  END DO
1958  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
1959  & err,error,*999)
1960  CALL field_scaling_type_set(equations_set%SOURCE%SOURCE_FIELD,geometric_scaling_type, &
1961  & err,error,*999)
1962  !Other solutions not defined yet
1963  CASE DEFAULT
1964  local_error="The solution method of " &
1965  & //trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// " is invalid."
1966  CALL flagerror(local_error,err,error,*999)
1967  END SELECT
1968  ELSE
1969  !Check the user specified field
1970  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1971  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1972  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
1973  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type/),err,error,*999)
1974  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
1975  & err,error,*999)
1976  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1977  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1978  & number_of_dimensions,err,error,*999)
1979  !calculate number of components with one component for each dimension and one for pressure
1980  source_field_number_of_components=number_of_dimensions
1981  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
1982  & source_field_number_of_components,err,error,*999)
1983  SELECT CASE(equations_set%SOLUTION_METHOD)
1984  CASE(equations_set_fem_solution_method)
1985  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
1986  & field_node_based_interpolation,err,error,*999)
1987  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
1988  & field_node_based_interpolation,err,error,*999)
1989  CASE DEFAULT
1990  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD, &
1991  &"*",err,error))//" is invalid."
1992  CALL flagerror(local_error,err,error,*999)
1993  END SELECT
1994  ENDIF
1995  !Specify finish action
1996  CASE(equations_set_setup_finish_action)
1997  IF(equations_set%SOURCE%SOURCE_FIELD_AUTO_CREATED) THEN
1998  CALL field_create_finish(equations_set%SOURCE%SOURCE_FIELD,err,error,*999)
1999  ENDIF
2000  CASE DEFAULT
2001  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2002  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2003  & " is invalid for a linear Poisson subtype"
2004  CALL flagerror(local_error,err,error,*999)
2005  END SELECT
2006  CASE DEFAULT
2007  local_error="The equation set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2008  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2009  & " is invalid for a linear Poisson equation."
2010  CALL flagerror(local_error,err,error,*999)
2011  END SELECT
2012  CASE(equations_set_setup_analytic_type)
2013  SELECT CASE(equations_set_setup%ACTION_TYPE)
2014  CASE(equations_set_setup_start_action)
2015  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
2016  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
2017  IF(ASSOCIATED(dependent_field)) THEN
2018  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
2019  IF(ASSOCIATED(geometric_field)) THEN
2020  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
2021  SELECT CASE(equations_set_setup%ANALYTIC_FUNCTION_TYPE)
2022  CASE(equations_set_poisson_equation_two_dim_1)
2023  !Check that we have an constant source
2024  IF(equations_set%SPECIFICATION(3)==equations_set_constant_source_poisson_subtype) THEN
2025  !Check that we are in 2D
2026  IF(number_of_dimensions/=2) THEN
2027  local_error="The number of geometric dimensions of "// &
2028  & trim(number_to_vstring(number_of_dimensions,"*",err,error))// &
2029  & " is invalid. The analytic function type of "// &
2030  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
2031  & " requires that there be 2 geometric dimensions."
2032  CALL flagerror(local_error,err,error,*999)
2033  ENDIF
2034  !Create analytic field if required
2035  !Set analtyic function type
2036  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_poisson_equation_two_dim_1
2037  ELSE
2038  local_error="The equations set subtype of "// &
2039  & trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2040  & " is invalid. The analytic function type of "// &
2041  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
2042  & " requires that the equations set subtype be an exponential source Poisson equation."
2043  CALL flagerror(local_error,err,error,*999)
2044  ENDIF
2045  CASE(equations_set_poisson_equation_three_dim_1)
2046  !Check that we have an exponential source
2047  IF(equations_set%SPECIFICATION(3)==equations_set_constant_source_poisson_subtype) THEN
2048  !Check that we are in 3D
2049  IF(number_of_dimensions/=3) THEN
2050  local_error="The number of geometric dimensions of "// &
2051  & trim(number_to_vstring(number_of_dimensions,"*",err,error))// &
2052  & " is invalid. The analytic function type of "// &
2053  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
2054  & " requires that there be 3 geometric dimensions."
2055  CALL flagerror(local_error,err,error,*999)
2056  ENDIF
2057  !Create analytic field if required
2058  !Set analytic function type
2059  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_poisson_equation_three_dim_1
2060  ELSE
2061  local_error="The equations set subtype of "// &
2062  & trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2063  & " is invalid. The analytic function type of "// &
2064  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
2065  & " requires that the equations set subtype be an exponential source Poisson equation."
2066  CALL flagerror(local_error,err,error,*999)
2067  ENDIF
2068  CASE DEFAULT
2069  local_error="The specified analytic function type of "// &
2070  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
2071  & " is invalid for a linear source Poisson equation."
2072  CALL flagerror(local_error,err,error,*999)
2073  END SELECT
2074  ELSE
2075  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
2076  ENDIF
2077  ELSE
2078  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
2079  ENDIF
2080  ELSE
2081  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
2082  ENDIF
2083  CASE(equations_set_setup_finish_action)
2084  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
2085  analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
2086  IF(ASSOCIATED(analytic_field)) THEN
2087  IF(equations_set%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED) THEN
2088  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
2089  ENDIF
2090  ENDIF
2091  ELSE
2092  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
2093  ENDIF
2094  CASE DEFAULT
2095  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2096  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2097  & " is invalid for a linear source Poisson equation."
2098  CALL flagerror(local_error,err,error,*999)
2099  END SELECT
2100  CASE(equations_set_setup_equations_type)
2101  SELECT CASE(equations_set_setup%ACTION_TYPE)
2102  CASE(equations_set_setup_start_action)
2103  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
2104  !Create the equations
2105  CALL equations_create_start(equations_set,equations,err,error,*999)
2106  CALL equations_linearity_type_set(equations,equations_linear,err,error,*999)
2107  CALL equations_time_dependence_type_set(equations,equations_static,err,error,*999)
2108  ELSE
2109  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
2110  ENDIF
2111  CASE(equations_set_setup_finish_action)
2112  SELECT CASE(equations_set%SOLUTION_METHOD)
2113  CASE(equations_set_fem_solution_method)
2114  !Finish the creation of the equations
2115  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
2116  CALL equations_create_finish(equations,err,error,*999)
2117  !Create the equations mapping.
2118  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
2119  CALL equationsmapping_linearmatricesnumberset(equations_mapping,1,err,error,*999)
2120  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,(/field_u_variable_type/), &
2121  & err,error,*999)
2122  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
2123  CALL equations_mapping_source_variable_type_set(equations_mapping,field_u_variable_type,err,error,*999)
2124  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
2125  !Create the equations matrices
2126  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
2127  SELECT CASE(equations%SPARSITY_TYPE)
2128  CASE(equations_matrices_full_matrices)
2129  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_block_storage_type/), &
2130  & err,error,*999)
2131  CASE(equations_matrices_sparse_matrices)
2132  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_compressed_row_storage_type/), &
2133  & err,error,*999)
2134  CALL equationsmatrices_linearstructuretypeset(equations_matrices,(/equations_matrix_fem_structure/), &
2135  & err,error,*999)
2136  CASE DEFAULT
2137  local_error="The equations matrices sparsity type of "// &
2138  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
2139  CALL flagerror(local_error,err,error,*999)
2140  END SELECT
2141  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
2142  CASE(equations_set_bem_solution_method)
2143  CALL flagerror("Not implemented.",err,error,*999)
2144  CASE(equations_set_fd_solution_method)
2145  CALL flagerror("Not implemented.",err,error,*999)
2146  CASE(equations_set_fv_solution_method)
2147  CALL flagerror("Not implemented.",err,error,*999)
2148  CASE(equations_set_gfem_solution_method)
2149  CALL flagerror("Not implemented.",err,error,*999)
2150  CASE(equations_set_gfv_solution_method)
2151  CALL flagerror("Not implemented.",err,error,*999)
2152  CASE DEFAULT
2153  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
2154  & " is invalid."
2155  CALL flagerror(local_error,err,error,*999)
2156  END SELECT
2157  CASE DEFAULT
2158  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2159  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2160  & " is invalid for a linear source Poisson equation."
2161  CALL flagerror(local_error,err,error,*999)
2162  END SELECT
2163  CASE DEFAULT
2164  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2165  & " is invalid for a linear source Poisson equation."
2166  CALL flagerror(local_error,err,error,*999)
2167  END SELECT
2168  ELSE
2169  local_error="The equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2170  & " is not a linear source Poisson equation subtype."
2171  CALL flagerror(local_error,err,error,*999)
2172  ENDIF
2173  ELSE
2174  CALL flagerror("Equations set is not associated.",err,error,*999)
2175  ENDIF
2176 
2177  exits("Poisson_EquationsSetLinearSourceSetup")
2178  RETURN
2179 999 errors("Poisson_EquationsSetLinearSourceSetup",err,error)
2180  exits("Poisson_EquationsSetLinearSourceSetup")
2181  RETURN 1
2182 
2183  END SUBROUTINE poisson_equationssetlinearsourcesetup
2184 
2185  !
2186  !================================================================================================================================
2187  !
2188 
2190  SUBROUTINE poisson_equationssetextracellularbidomainsetup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
2191 
2192  !Argument variables
2193  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2194  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
2195  INTEGER(INTG), INTENT(OUT) :: ERR
2196  TYPE(varying_string), INTENT(OUT) :: ERROR
2197  !Local Variables
2198  INTEGER(INTG) :: component_idx,GEOMETRIC_COMPONENT_NUMBER,GEOMETRIC_SCALING_TYPE,NUMBER_OF_DIMENSIONS, &
2199  & NUMBER_OF_MATERIALS_COMPONENTS, GEOMETRIC_MESH_COMPONENT,SOURCE_FIELD_NUMBER_OF_COMPONENTS, &
2200  & SOURCE_FIELD_NUMBER_OF_VARIABLES
2201  TYPE(field_type), POINTER :: ANALYTIC_FIELD,DEPENDENT_FIELD,GEOMETRIC_FIELD
2202  TYPE(decomposition_type), POINTER :: GEOMETRIC_DECOMPOSITION
2203  TYPE(equations_type), POINTER :: EQUATIONS
2204  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2205  TYPE(equations_set_materials_type), POINTER :: EQUATIONS_MATERIALS
2206  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
2207  TYPE(varying_string) :: LOCAL_ERROR
2208 
2209  enters("Poisson_EquationsSetExtracellularBidomainSetup",err,error,*999)
2210 
2211  NULLIFY(equations)
2212  NULLIFY(equations_mapping)
2213  NULLIFY(equations_matrices)
2214  NULLIFY(geometric_decomposition)
2215 
2216  IF(ASSOCIATED(equations_set)) THEN
2217  IF(equations_set%SPECIFICATION(3)==equations_set_extracellular_bidomain_poisson_subtype) THEN
2218  SELECT CASE(equations_set_setup%SETUP_TYPE)
2219  CASE(equations_set_setup_initial_type)
2220  SELECT CASE(equations_set_setup%ACTION_TYPE)
2221  CASE(equations_set_setup_start_action)
2222  CALL poisson_equationssetsolutionmethodset(equations_set,equations_set_fem_solution_method,err,error,*999)
2223  CASE(equations_set_setup_finish_action)
2224 !!TODO: Check valid setup
2225  CASE DEFAULT
2226  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2227  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2228  & " is invalid for an extracellular bidomain Poisson equation."
2229  CALL flagerror(local_error,err,error,*999)
2230  END SELECT
2231  !GEOMETRY
2232  CASE(equations_set_setup_geometry_type)
2233  !Do nothing???
2234  !DEPENDENT
2235  CASE(equations_set_setup_dependent_type)
2236  SELECT CASE(equations_set_setup%ACTION_TYPE)
2237  CASE(equations_set_setup_start_action)
2238  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
2239  !Create the auto created dependent field
2240  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
2241  & dependent_field,err,error,*999)
2242  CALL field_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
2243  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
2244  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
2245  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
2246  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
2247  & err,error,*999)
2248  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
2249  & geometric_field,err,error,*999)
2250  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,2,err,error,*999)
2251  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,(/field_u_variable_type, &
2252  & field_deludeln_variable_type/),err,error,*999)
2253 
2254  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,"Phi",err,error,*999)
2255  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,"del Phi/del n", &
2256  & err,error,*999)
2257 
2258  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
2259  & field_scalar_dimension_type,err,error,*999)
2260  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
2261  & field_scalar_dimension_type,err,error,*999)
2262 
2263  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
2264  & field_dp_type,err,error,*999)
2265  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
2266  & field_dp_type,err,error,*999)
2267 
2268  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
2269  & err,error,*999)
2270  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
2271  & err,error,*999)
2272 
2273  CALL field_component_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1,"Phi",err,error,*999)
2274  CALL field_component_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
2275  & "del Phi/del n",err,error,*999)
2276 
2277  !Default to the geometric interpolation setup
2278  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,1, &
2279  & geometric_component_number,err,error,*999)
2280 
2281  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
2282  & geometric_component_number,err,error,*999)
2283  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
2284  & geometric_component_number,err,error,*999)
2285 
2286  SELECT CASE(equations_set%SOLUTION_METHOD)
2287  CASE(equations_set_fem_solution_method)
2288  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
2289  & field_node_based_interpolation,err,error,*999)
2290  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
2291  & field_deludeln_variable_type,1,field_node_based_interpolation,err,error,*999)
2292  !Default the scaling to the geometric field scaling
2293  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
2294  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
2295  CASE(equations_set_bem_solution_method)
2296  CALL flagerror("Not implemented.",err,error,*999)
2297  CASE(equations_set_fd_solution_method)
2298  CALL flagerror("Not implemented.",err,error,*999)
2299  CASE(equations_set_fv_solution_method)
2300  CALL flagerror("Not implemented.",err,error,*999)
2301  CASE(equations_set_gfem_solution_method)
2302  CALL flagerror("Not implemented.",err,error,*999)
2303  CASE(equations_set_gfv_solution_method)
2304  CALL flagerror("Not implemented.",err,error,*999)
2305  CASE DEFAULT
2306  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
2307  & " is invalid."
2308  CALL flagerror(local_error,err,error,*999)
2309  END SELECT
2310  ELSE
2311  !Check the user specified field
2312  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
2313  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
2314  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
2315  CALL field_variable_types_check(equations_set_setup%FIELD, &
2316  & (/field_u_variable_type,field_deludeln_variable_type/),err,error,*999)
2317 
2318  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_scalar_dimension_type,err,error,*999)
2319  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_scalar_dimension_type, &
2320  & err,error,*999)
2321 
2322  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
2323  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
2324 
2325  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1,err,error,*999)
2326  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type,1,err,error,*999)
2327 
2328  SELECT CASE(equations_set%SOLUTION_METHOD)
2329  CASE(equations_set_fem_solution_method)
2330  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
2331  & field_node_based_interpolation,err,error,*999)
2332  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
2333  & field_node_based_interpolation,err,error,*999)
2334  CASE(equations_set_bem_solution_method)
2335  CALL flagerror("Not implemented.",err,error,*999)
2336  CASE(equations_set_fd_solution_method)
2337  CALL flagerror("Not implemented.",err,error,*999)
2338  CASE(equations_set_fv_solution_method)
2339  CALL flagerror("Not implemented.",err,error,*999)
2340  CASE(equations_set_gfem_solution_method)
2341  CALL flagerror("Not implemented.",err,error,*999)
2342  CASE(equations_set_gfv_solution_method)
2343  CALL flagerror("Not implemented.",err,error,*999)
2344  CASE DEFAULT
2345  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
2346  & " is invalid."
2347  CALL flagerror(local_error,err,error,*999)
2348  END SELECT
2349  ENDIF
2350  CASE(equations_set_setup_finish_action)
2351  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
2352  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
2353  ENDIF
2354  CASE DEFAULT
2355  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2356  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2357  & " is invalid for an extracellular bidomain Poisson equation"
2358  CALL flagerror(local_error,err,error,*999)
2359  END SELECT
2360  !MATERIAL
2361  CASE(equations_set_setup_materials_type)
2362  SELECT CASE(equations_set_setup%ACTION_TYPE)
2363 
2364  CASE(equations_set_setup_start_action)
2365  equations_materials=>equations_set%MATERIALS
2366  IF(ASSOCIATED(equations_materials)) THEN
2367  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
2368  !Create the auto created materials field
2369  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_materials% &
2370  & materials_field,err,error,*999)
2371  CALL field_label_set(equations_set%MATERIALS%MATERIALS_FIELD,"Material Field",err,error,*999)
2372  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
2373  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type,err,error,*999)
2374  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
2375  CALL field_mesh_decomposition_set_and_lock(equations_materials%MATERIALS_FIELD,geometric_decomposition, &
2376  & err,error,*999)
2377  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
2378  & geometric_field,err,error,*999)
2379  CALL field_number_of_variables_set_and_lock(equations_materials%MATERIALS_FIELD,1,err,error,*999)
2380  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,(/field_u_variable_type/), &
2381  & err,error,*999)
2382  CALL field_variable_label_set(equations_set%MATERIALS%MATERIALS_FIELD,field_u_variable_type,"conductivity",err, &
2383  & error,*999)
2384  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2385  & field_vector_dimension_type,err,error,*999)
2386  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2387  & field_dp_type,err,error,*999)
2388  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2389  & number_of_dimensions,err,error,*999)
2390  IF(number_of_dimensions==1) THEN
2391  number_of_materials_components=2
2392  ELSEIF(number_of_dimensions==2) THEN
2393  number_of_materials_components=6
2394  ELSEIF(number_of_dimensions==3) THEN
2395  number_of_materials_components=12
2396  ENDIF
2397  !Set the number of materials components
2398  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2399  & number_of_materials_components,err,error,*999)
2400  !Default the materials components to the first geometric component with constant interpolation
2401  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2402  & 1,geometric_component_number,err,error,*999)
2403  DO component_idx=1,number_of_materials_components
2404  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2405  & component_idx,geometric_component_number,err,error,*999)
2406  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2407  & component_idx,field_constant_interpolation,err,error,*999)
2408  ENDDO !components_idx
2409  !Default the field scaling to that of the geometric field
2410  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
2411  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
2412  ELSE
2413  !Check the user specified field
2414  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
2415  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
2416  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
2417  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type/),err,error,*999)
2418  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
2419  & err,error,*999)
2420  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
2421  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2422  & number_of_dimensions,err,error,*999)
2423  IF(number_of_dimensions==1) THEN
2424  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,2,err, &
2425  & error,*999)
2426  ELSEIF(number_of_dimensions==2) THEN
2427  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,6,err, &
2428  & error,*999)
2429  ELSEIF(number_of_dimensions==3) THEN
2430  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,12,err, &
2431  & error,*999)
2432  ENDIF
2433  ENDIF
2434  ELSE
2435  CALL flagerror("Equations set materials is not associated.",err,error,*999)
2436  ENDIF
2437 
2438  CASE(equations_set_setup_finish_action)
2439  equations_materials=>equations_set%MATERIALS
2440  IF(ASSOCIATED(equations_materials)) THEN
2441  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
2442  !Finish creating the materials field
2443  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
2444  !Set the default values for the materials field
2445  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2446  & number_of_dimensions,err,error,*999)
2447  IF(number_of_dimensions==1) THEN
2448  number_of_materials_components=2
2449  ELSEIF(number_of_dimensions==2) THEN
2450  number_of_materials_components=6
2451  ELSEIF(number_of_dimensions==3) THEN
2452  number_of_materials_components=12
2453  ENDIF
2454  !Set all material component values to one
2455  DO component_idx=1,number_of_materials_components
2456  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2457  & field_values_set_type,component_idx,1.0_dp,err,error,*999)
2458  ENDDO !component_idx
2459  ENDIF
2460  ELSE
2461  CALL flagerror("Equations set materials is not associated.",err,error,*999)
2462  ENDIF
2463  CASE DEFAULT
2464  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2465  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2466  & " is invalid for an extrcellular bidomain Poisson equation."
2467  CALL flagerror(local_error,err,error,*999)
2468  END SELECT
2469  !SOURCE
2470  CASE(equations_set_setup_source_type)
2471  SELECT CASE(equations_set%SPECIFICATION(3))
2472  CASE(equations_set_extracellular_bidomain_poisson_subtype)
2473  SELECT CASE(equations_set_setup%ACTION_TYPE)
2474 
2475  !Set start action
2476  CASE(equations_set_setup_start_action)
2477  !Do nothing
2478  IF(equations_set%SOURCE%SOURCE_FIELD_AUTO_CREATED) THEN
2479  !Create the auto created source field
2480  !start field creation with name 'Vm'
2481  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
2482  & equations_set%SOURCE%SOURCE_FIELD,err,error,*999)
2483  !start creation of a new field
2484  CALL field_type_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_general_type,err,error,*999)
2485  !label the field
2486  CALL field_label_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,"Vm",err,error,*999)
2487  !define new created field to be source
2488  CALL field_dependent_type_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
2489  & field_independent_type,err,error,*999)
2490  !look for decomposition rule already defined
2491  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
2492  & err,error,*999)
2493  !apply decomposition rule found on new created field
2494  CALL field_mesh_decomposition_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
2495  & geometric_decomposition,err,error,*999)
2496  !point new field to geometric field
2497  CALL field_geometric_field_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,equations_set% &
2498  & geometry%GEOMETRIC_FIELD,err,error,*999)
2499  !set number of variables to 1
2500  source_field_number_of_variables=1
2501  CALL field_number_of_variables_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
2502  & source_field_number_of_variables,err,error,*999)
2503  CALL field_variable_types_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
2504  & (/field_u_variable_type/),err,error,*999)
2505  CALL field_dimension_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
2506  & field_vector_dimension_type,err,error,*999)
2507  CALL field_data_type_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
2508  & field_dp_type,err,error,*999)
2509  !set the number of components to 1
2510  source_field_number_of_components=1
2511  CALL field_number_of_components_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
2512  & field_u_variable_type,source_field_number_of_components,err,error,*999)
2513  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2514  & 1,geometric_mesh_component,err,error,*999)
2515  !Default to the geometric interpolation setup
2516  CALL field_component_mesh_component_set(equations_set%SOURCE%SOURCE_FIELD, &
2517  & field_u_variable_type,1,geometric_mesh_component,err,error,*999)
2518  SELECT CASE(equations_set%SOLUTION_METHOD)
2519  !Specify fem solution method
2520  CASE(equations_set_fem_solution_method)
2521  CALL field_component_interpolation_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
2522  & field_u_variable_type,1,field_node_based_interpolation,err,error,*999)
2523  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
2524  & err,error,*999)
2525  CALL field_scaling_type_set(equations_set%SOURCE%SOURCE_FIELD,geometric_scaling_type, &
2526  & err,error,*999)
2527  !Other solutions not defined yet
2528  CASE DEFAULT
2529  local_error="The solution method of " &
2530  & //trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// " is invalid."
2531  CALL flagerror(local_error,err,error,*999)
2532  END SELECT
2533  ELSE
2534  !Check the user specified field
2535  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
2536  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
2537  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
2538  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type/),err,error,*999)
2539  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
2540  & err,error,*999)
2541  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
2542  !number of components
2543  source_field_number_of_components=1
2544  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
2545  & source_field_number_of_components,err,error,*999)
2546  SELECT CASE(equations_set%SOLUTION_METHOD)
2547  CASE(equations_set_fem_solution_method)
2548  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
2549  & field_node_based_interpolation,err,error,*999)
2550  CASE DEFAULT
2551  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD, &
2552  &"*",err,error))//" is invalid."
2553  CALL flagerror(local_error,err,error,*999)
2554  END SELECT
2555  ENDIF
2556 
2557  !Specify finish action
2558  CASE(equations_set_setup_finish_action)
2559  IF(equations_set%SOURCE%SOURCE_FIELD_AUTO_CREATED) THEN
2560  CALL field_create_finish(equations_set%SOURCE%SOURCE_FIELD,err,error,*999)
2561  ENDIF
2562  CASE DEFAULT
2563  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2564  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2565  & " is invalid for an extracellular bidomain Poisson subtype"
2566  CALL flagerror(local_error,err,error,*999)
2567  END SELECT
2568  CASE DEFAULT
2569  local_error="The equation set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2570  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2571  & " is invalid for an extracellular bidomain Poisson equation."
2572  CALL flagerror(local_error,err,error,*999)
2573  END SELECT
2574  !ANALYTC
2575  CASE(equations_set_setup_analytic_type)
2576  SELECT CASE(equations_set_setup%ACTION_TYPE)
2577  CASE(equations_set_setup_start_action)
2578  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
2579  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
2580  IF(ASSOCIATED(dependent_field)) THEN
2581  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
2582  IF(ASSOCIATED(geometric_field)) THEN
2583  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
2584  SELECT CASE(equations_set_setup%ANALYTIC_FUNCTION_TYPE)
2585  CASE(equations_set_poisson_equation_two_dim_1)
2586  !Check that we have an constant source
2587  IF(equations_set%SPECIFICATION(3)==equations_set_constant_source_poisson_subtype) THEN
2588  !Check that we are in 2D
2589  IF(number_of_dimensions/=2) THEN
2590  local_error="The number of geometric dimensions of "// &
2591  & trim(number_to_vstring(number_of_dimensions,"*",err,error))// &
2592  & " is invalid. The analytic function type of "// &
2593  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
2594  & " requires that there be 2 geometric dimensions."
2595  CALL flagerror(local_error,err,error,*999)
2596  ENDIF
2597  !Create analytic field if required
2598  !Set analtyic function type
2599  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_poisson_equation_two_dim_1
2600  ELSE
2601  local_error="The equations set subtype of "// &
2602  & trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2603  & " is invalid. The analytic function type of "// &
2604  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
2605  & " requires that the equations set subtype be an exponential source Poisson equation."
2606  CALL flagerror(local_error,err,error,*999)
2607  ENDIF
2608  CASE(equations_set_poisson_equation_three_dim_1)
2609  !Check that we have an exponential source
2610  IF(equations_set%SPECIFICATION(3)==equations_set_constant_source_poisson_subtype) THEN
2611  !Check that we are in 3D
2612  IF(number_of_dimensions/=3) THEN
2613  local_error="The number of geometric dimensions of "// &
2614  & trim(number_to_vstring(number_of_dimensions,"*",err,error))// &
2615  & " is invalid. The analytic function type of "// &
2616  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
2617  & " requires that there be 3 geometric dimensions."
2618  CALL flagerror(local_error,err,error,*999)
2619  ENDIF
2620  !Create analytic field if required
2621  !Set analytic function type
2622  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_poisson_equation_three_dim_1
2623  ELSE
2624  local_error="The equations set subtype of "// &
2625  & trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2626  & " is invalid. The analytic function type of "// &
2627  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
2628  & " requires that the equations set subtype be an exponential source Poisson equation."
2629  CALL flagerror(local_error,err,error,*999)
2630  ENDIF
2631  CASE DEFAULT
2632  local_error="The specified analytic function type of "// &
2633  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
2634  & " is invalid for a linear source Poisson equation."
2635  CALL flagerror(local_error,err,error,*999)
2636  END SELECT
2637  ELSE
2638  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
2639  ENDIF
2640  ELSE
2641  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
2642  ENDIF
2643  ELSE
2644  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
2645  ENDIF
2646  CASE(equations_set_setup_finish_action)
2647  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
2648  analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
2649  IF(ASSOCIATED(analytic_field)) THEN
2650  IF(equations_set%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED) THEN
2651  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
2652  ENDIF
2653  ENDIF
2654  ELSE
2655  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
2656  ENDIF
2657  CASE DEFAULT
2658  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2659  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2660  & " is invalid for a extracellular bidomain source Poisson equation."
2661  CALL flagerror(local_error,err,error,*999)
2662  END SELECT
2663  !EQUATIONS
2664  CASE(equations_set_setup_equations_type)
2665  SELECT CASE(equations_set_setup%ACTION_TYPE)
2666  !start action
2667  CASE(equations_set_setup_start_action)
2668  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
2669  !Create the equations
2670  CALL equations_create_start(equations_set,equations,err,error,*999)
2671  CALL equations_linearity_type_set(equations,equations_linear,err,error,*999)
2672  CALL equations_time_dependence_type_set(equations,equations_static,err,error,*999)
2673  ELSE
2674  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
2675  ENDIF
2676  !finish action
2677  CASE(equations_set_setup_finish_action)
2678  SELECT CASE(equations_set%SOLUTION_METHOD)
2679  CASE(equations_set_fem_solution_method)
2680  !Finish the creation of the equations
2681  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
2682  CALL equations_create_finish(equations,err,error,*999)
2683  !Create the equations mapping.
2684  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
2685  IF(equations_set%SPECIFICATION(3)==equations_set_extracellular_bidomain_poisson_subtype) THEN
2686  CALL equationsmapping_linearmatricesnumberset(equations_mapping,1,err,error,*999)
2687  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,[field_u_variable_type],err,error,*999)
2688  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
2689  CALL equations_mapping_source_variable_type_set(equations_mapping,field_u_variable_type,err,error,*999)
2690  ELSE
2691  local_error="The third equations set specification of "// &
2692  & trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))//" is invalid."
2693  CALL flagerror(local_error,err,error,*999)
2694  ENDIF
2695  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
2696  !Create the equations matrices
2697  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
2698  SELECT CASE(equations%SPARSITY_TYPE)
2699  CASE(equations_matrices_full_matrices)
2700  CALL equations_matrices_linear_storage_type_set(equations_matrices, &
2701  & (/matrix_block_storage_type/),err,error,*999)
2702  CASE(equations_matrices_sparse_matrices)
2703  CALL equations_matrices_linear_storage_type_set(equations_matrices, &
2704  & (/matrix_compressed_row_storage_type/),err,error,*999)
2705  CALL equationsmatrices_linearstructuretypeset(equations_matrices, &
2706  & (/equations_matrix_fem_structure/),err,error,*999)
2707  CASE DEFAULT
2708  local_error="The equations matrices sparsity type of "// &
2709  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
2710  CALL flagerror(local_error,err,error,*999)
2711  END SELECT
2712  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
2713  CASE(equations_set_bem_solution_method)
2714  CALL flagerror("Not implemented.",err,error,*999)
2715  CASE(equations_set_fd_solution_method)
2716  CALL flagerror("Not implemented.",err,error,*999)
2717  CASE(equations_set_fv_solution_method)
2718  CALL flagerror("Not implemented.",err,error,*999)
2719  CASE(equations_set_gfem_solution_method)
2720  CALL flagerror("Not implemented.",err,error,*999)
2721  CASE(equations_set_gfv_solution_method)
2722  CALL flagerror("Not implemented.",err,error,*999)
2723  CASE DEFAULT
2724  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
2725  & " is invalid."
2726  CALL flagerror(local_error,err,error,*999)
2727  END SELECT
2728  CASE DEFAULT
2729  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2730  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2731  & " is invalid for a linear source Poisson equation."
2732  CALL flagerror(local_error,err,error,*999)
2733  END SELECT
2734  CASE DEFAULT
2735  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2736  & " is invalid for a extracellular bidomain source Poisson equation."
2737  CALL flagerror(local_error,err,error,*999)
2738  END SELECT
2739  ELSE
2740  local_error="The equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2741  & " is not a extracellular bidomain source Poisson equation subtype."
2742  CALL flagerror(local_error,err,error,*999)
2743  ENDIF
2744  ELSE
2745  CALL flagerror("Equations set is not associated.",err,error,*999)
2746  ENDIF
2747 
2748  exits("Poisson_EquationsSetExtracellularBidomainSetup")
2749  RETURN
2750 999 errors("Poisson_EquationsSetExtracellularBidomainSetup",err,error)
2751  exits("Poisson_EquationsSetExtracellularBidomainSetup")
2752  RETURN 1
2753 
2754  END SUBROUTINE poisson_equationssetextracellularbidomainsetup
2755 
2756  !
2757  !================================================================================================================================
2758  !
2759 
2761  SUBROUTINE poisson_equationssetnonlinearsourcesetup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
2762 
2763  !Argument variables
2764  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2765  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
2766  INTEGER(INTG), INTENT(OUT) :: ERR
2767  TYPE(varying_string), INTENT(OUT) :: ERROR
2768  !Local Variables
2769  INTEGER(INTG) :: component_idx,GEOMETRIC_COMPONENT_NUMBER,GEOMETRIC_SCALING_TYPE,NUMBER_OF_DIMENSIONS, &
2770  & NUMBER_OF_MATERIALS_COMPONENTS
2771  TYPE(decomposition_type), POINTER :: GEOMETRIC_DECOMPOSITION
2772  TYPE(equations_type), POINTER :: EQUATIONS
2773  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2774  TYPE(equations_set_materials_type), POINTER :: EQUATIONS_MATERIALS
2775  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
2776  TYPE(field_type), POINTER :: analytic_field,DEPENDENT_FIELD,geometric_field
2777  TYPE(varying_string) :: LOCAL_ERROR
2778 
2779  enters("POISSON_EQUATION_EQUATION_SET_NONLINEAR_SOURCE_SETUP",err,error,*999)
2780 
2781  NULLIFY(equations)
2782  NULLIFY(equations_mapping)
2783  NULLIFY(equations_matrices)
2784  NULLIFY(geometric_decomposition)
2785 
2786  IF(ASSOCIATED(equations_set)) THEN
2787  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
2788  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
2789  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
2790  CALL flagerror("Equations set specification must have three entries for a Poisson type equations set.", &
2791  & err,error,*999)
2792  END IF
2793  IF(equations_set%SPECIFICATION(3)==equations_set_quadratic_source_poisson_subtype.OR. &
2794  & equations_set%SPECIFICATION(3)==equations_set_exponential_source_poisson_subtype) THEN
2795  SELECT CASE(equations_set_setup%SETUP_TYPE)
2796  CASE(equations_set_setup_initial_type)
2797  SELECT CASE(equations_set_setup%ACTION_TYPE)
2798  CASE(equations_set_setup_start_action)
2799  CALL poisson_equationssetsolutionmethodset(equations_set,equations_set_fem_solution_method,err,error,*999)
2800  CASE(equations_set_setup_finish_action)
2801 !!TODO: Check valid setup
2802  CASE DEFAULT
2803  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2804  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2805  & " is invalid for a nonlinear source Poisson equation."
2806  CALL flagerror(local_error,err,error,*999)
2807  END SELECT
2808  CASE(equations_set_setup_geometry_type)
2809  !Do nothing???
2810  CASE(equations_set_setup_dependent_type)
2811  SELECT CASE(equations_set_setup%ACTION_TYPE)
2812  CASE(equations_set_setup_start_action)
2813  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
2814  !Create the auto created dependent field
2815  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
2816  & dependent_field,err,error,*999)
2817  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
2818  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
2819  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
2820  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
2821  & err,error,*999)
2822  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
2823  & geometric_field,err,error,*999)
2824  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,2,err,error,*999)
2825  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,(/field_u_variable_type, &
2826  & field_deludeln_variable_type/),err,error,*999)
2827  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
2828  & field_scalar_dimension_type,err,error,*999)
2829  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
2830  & field_scalar_dimension_type,err,error,*999)
2831  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
2832  & field_dp_type,err,error,*999)
2833  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
2834  & field_dp_type,err,error,*999)
2835  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
2836  & err,error,*999)
2837  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
2838  & err,error,*999)
2839  !Default to the geometric interpolation setup
2840  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,1, &
2841  & geometric_component_number,err,error,*999)
2842  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
2843  & geometric_component_number,err,error,*999)
2844  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
2845  & geometric_component_number,err,error,*999)
2846  SELECT CASE(equations_set%SOLUTION_METHOD)
2847  CASE(equations_set_fem_solution_method)
2848  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
2849  & field_node_based_interpolation,err,error,*999)
2850  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
2851  & field_deludeln_variable_type,1,field_node_based_interpolation,err,error,*999)
2852  !Default the scaling to the geometric field scaling
2853  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
2854  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
2855  CASE(equations_set_bem_solution_method)
2856  CALL flagerror("Not implemented.",err,error,*999)
2857  CASE(equations_set_fd_solution_method)
2858  CALL flagerror("Not implemented.",err,error,*999)
2859  CASE(equations_set_fv_solution_method)
2860  CALL flagerror("Not implemented.",err,error,*999)
2861  CASE(equations_set_gfem_solution_method)
2862  CALL flagerror("Not implemented.",err,error,*999)
2863  CASE(equations_set_gfv_solution_method)
2864  CALL flagerror("Not implemented.",err,error,*999)
2865  CASE DEFAULT
2866  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
2867  & " is invalid."
2868  CALL flagerror(local_error,err,error,*999)
2869  END SELECT
2870  ELSE
2871  !Check the user specified field
2872  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
2873  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
2874  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
2875  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type,field_deludeln_variable_type/), &
2876  & err,error,*999)
2877  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_scalar_dimension_type,err,error,*999)
2878  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_scalar_dimension_type, &
2879  & err,error,*999)
2880  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
2881  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
2882  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1,err,error,*999)
2883  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type,1,err,error,*999)
2884  SELECT CASE(equations_set%SOLUTION_METHOD)
2885  CASE(equations_set_fem_solution_method)
2886  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
2887  & field_node_based_interpolation,err,error,*999)
2888  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
2889  & field_node_based_interpolation,err,error,*999)
2890  CASE(equations_set_bem_solution_method)
2891  CALL flagerror("Not implemented.",err,error,*999)
2892  CASE(equations_set_fd_solution_method)
2893  CALL flagerror("Not implemented.",err,error,*999)
2894  CASE(equations_set_fv_solution_method)
2895  CALL flagerror("Not implemented.",err,error,*999)
2896  CASE(equations_set_gfem_solution_method)
2897  CALL flagerror("Not implemented.",err,error,*999)
2898  CASE(equations_set_gfv_solution_method)
2899  CALL flagerror("Not implemented.",err,error,*999)
2900  CASE DEFAULT
2901  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
2902  & " is invalid."
2903  CALL flagerror(local_error,err,error,*999)
2904  END SELECT
2905  ENDIF
2906  CASE(equations_set_setup_finish_action)
2907  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
2908  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
2909  ENDIF
2910  CASE DEFAULT
2911  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2912  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2913  & " is invalid for a nonlinear source Poisson equation"
2914  CALL flagerror(local_error,err,error,*999)
2915  END SELECT
2916  CASE(equations_set_setup_materials_type)
2917  SELECT CASE(equations_set_setup%ACTION_TYPE)
2918  CASE(equations_set_setup_start_action)
2919  equations_materials=>equations_set%MATERIALS
2920  IF(ASSOCIATED(equations_materials)) THEN
2921  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
2922  !Create the auto created materials field
2923  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_materials% &
2924  & materials_field,err,error,*999)
2925  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
2926  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type,err,error,*999)
2927  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
2928  CALL field_mesh_decomposition_set_and_lock(equations_materials%MATERIALS_FIELD,geometric_decomposition, &
2929  & err,error,*999)
2930  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
2931  & geometric_field,err,error,*999)
2932  CALL field_number_of_variables_set_and_lock(equations_materials%MATERIALS_FIELD,1,err,error,*999)
2933  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2934  & field_vector_dimension_type,err,error,*999)
2935  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2936  & field_dp_type,err,error,*999)
2937  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2938  & number_of_dimensions,err,error,*999)
2939  IF(equations_set%SPECIFICATION(3)==equations_set_quadratic_source_poisson_subtype) THEN
2940  !Quadratic source. Materials field components are 1 for each dimension and 3 for the quadratic source
2941  !i.e., k and a, b and c in div(k.grad(u(x)))=a(x)+b(x)u(x)+c(x)u^2(x)
2942  number_of_materials_components=number_of_dimensions+3
2943  ELSE
2944  !Exponential source. Matierals field components are 1 for each dimension and 3 for the exponential source
2945  !i.e., k, a, b and c in div(k.grad(u(x)))=a(x)+b(x)e^[c(x)u(x)]
2946  number_of_materials_components=number_of_dimensions+3
2947  ENDIF
2948  !Set the number of materials components
2949  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2950  & number_of_materials_components,err,error,*999)
2951  !Default the k materials components to the geometric interpolation setup with constant interpolation
2952  DO component_idx=1,number_of_dimensions
2953  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2954  & component_idx,geometric_component_number,err,error,*999)
2955  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2956  & component_idx,geometric_component_number,err,error,*999)
2957  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2958  & component_idx,field_constant_interpolation,err,error,*999)
2959  ENDDO !component_idx
2960  !Default the source materials components to the first component geometric interpolation with constant interpolation
2961  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2962  & 1,geometric_component_number,err,error,*999)
2963  DO component_idx=number_of_dimensions+1,number_of_materials_components
2964  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2965  & component_idx,geometric_component_number,err,error,*999)
2966  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2967  & component_idx,field_constant_interpolation,err,error,*999)
2968  ENDDO !components_idx
2969  !Default the field scaling to that of the geometric field
2970  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
2971  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
2972  ELSE
2973  !Check the user specified field
2974  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
2975  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
2976  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
2977  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type/),err,error,*999)
2978  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
2979  & err,error,*999)
2980  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
2981  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2982  & number_of_dimensions,err,error,*999)
2983  IF(equations_set%SPECIFICATION(3)==equations_set_quadratic_source_poisson_subtype) THEN
2984  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_dimensions+3, &
2985  & err,error,*999)
2986  ELSE
2987  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,number_of_dimensions+3, &
2988  & err,error,*999)
2989  ENDIF
2990  ENDIF
2991  ELSE
2992  CALL flagerror("Equations set materials is not associated.",err,error,*999)
2993  ENDIF
2994  CASE(equations_set_setup_finish_action)
2995  equations_materials=>equations_set%MATERIALS
2996  IF(ASSOCIATED(equations_materials)) THEN
2997  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
2998  !Finish creating the materials field
2999  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
3000  !Set the default values for the materials field
3001  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
3002  & number_of_dimensions,err,error,*999)
3003  IF(equations_set%SPECIFICATION(3)==equations_set_quadratic_source_poisson_subtype) THEN
3004  !Quadratic source. Materials field components are 1 for each dimension and 3 for the quadratic source
3005  !i.e., k and a, b and c in div(k.grad(u(x)))=a(x)+b(x)u(x)+c(x)u^2(x)
3006  number_of_materials_components=number_of_dimensions+3
3007  ELSE
3008  !Exponential source. Matierals field components are 1 for each dimension and 3 for the exponential source
3009  !i.e., k, a, b and c in div(k.grad(u(x)))=a(x)+b(x)e^[c(x)u(x)]
3010  number_of_materials_components=number_of_dimensions+3
3011  ENDIF
3012  !First set the k values to 1.0
3013  DO component_idx=1,number_of_dimensions
3014  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
3015  & field_values_set_type,component_idx,1.0_dp,err,error,*999)
3016  ENDDO !component_idx
3017  !Now set the source values to 1.0
3018  DO component_idx=number_of_dimensions+1,number_of_materials_components
3019  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
3020  & field_values_set_type,component_idx,1.0_dp,err,error,*999)
3021  ENDDO !component_idx
3022  ENDIF
3023  ELSE
3024  CALL flagerror("Equations set materials is not associated.",err,error,*999)
3025  ENDIF
3026  CASE DEFAULT
3027  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
3028  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
3029  & " is invalid for a linear source Poisson equation."
3030  CALL flagerror(local_error,err,error,*999)
3031  END SELECT
3032  CASE(equations_set_setup_source_type)
3033  SELECT CASE(equations_set_setup%ACTION_TYPE)
3034  CASE(equations_set_setup_start_action)
3035  !Do nothing
3036  CASE(equations_set_setup_finish_action)
3037  !Do nothing
3038  !? Maybe set finished flag????
3039  CASE DEFAULT
3040  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
3041  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
3042  & " is invalid for a nonlinear source Poisson equation."
3043  CALL flagerror(local_error,err,error,*999)
3044  END SELECT
3045  CASE(equations_set_setup_analytic_type)
3046  SELECT CASE(equations_set_setup%ACTION_TYPE)
3047  CASE(equations_set_setup_start_action)
3048  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
3049  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
3050  IF(ASSOCIATED(dependent_field)) THEN
3051  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
3052  IF(ASSOCIATED(geometric_field)) THEN
3053  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
3054  SELECT CASE(equations_set_setup%ANALYTIC_FUNCTION_TYPE)
3055  CASE(equations_set_poisson_equation_two_dim_1)
3056  !Check that we have an exponential source
3057  IF(equations_set%SPECIFICATION(3)==equations_set_exponential_source_poisson_subtype) THEN
3058  !Check that we are in 2D
3059  IF(number_of_dimensions/=2) THEN
3060  local_error="The number of geometric dimensions of "// &
3061  & trim(number_to_vstring(number_of_dimensions,"*",err,error))// &
3062  & " is invalid. The analytic function type of "// &
3063  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
3064  & " requires that there be 2 geometric dimensions."
3065  CALL flagerror(local_error,err,error,*999)
3066  ENDIF
3067  !Create analytic field if required
3068  !Set analytic function type
3069  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_poisson_equation_two_dim_1
3070  ELSE
3071  local_error="The equations set subtype of "// &
3072  & trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
3073  & " is invalid. The analytic function type of "// &
3074  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
3075  & " requires that the equations set subtype be an exponential source Poisson equation."
3076  CALL flagerror(local_error,err,error,*999)
3077  ENDIF
3078  CASE(equations_set_poisson_equation_three_dim_1)
3079  !Check that we have an exponential source
3080  IF(equations_set%SPECIFICATION(3)==equations_set_exponential_source_poisson_subtype) THEN
3081  !Check that we are in 3D
3082  IF(number_of_dimensions/=3) THEN
3083  local_error="The number of geometric dimensions of "// &
3084  & trim(number_to_vstring(number_of_dimensions,"*",err,error))// &
3085  & " is invalid. The analytic function type of "// &
3086  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
3087  & " requires that there be 3 geometric dimensions."
3088  CALL flagerror(local_error,err,error,*999)
3089  ENDIF
3090  !Create analytic field if required
3091  !Set analytic function type
3092  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_poisson_equation_three_dim_1
3093  ELSE
3094  local_error="The equations set subtype of "// &
3095  & trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
3096  & " is invalid. The analytic function type of "// &
3097  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
3098  & " requires that the equations set subtype be an exponential source Poisson equation."
3099  CALL flagerror(local_error,err,error,*999)
3100  ENDIF
3101  CASE DEFAULT
3102  local_error="The specified analytic function type of "// &
3103  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
3104  & " is invalid for a nonlinear source Poisson equation."
3105  CALL flagerror(local_error,err,error,*999)
3106  END SELECT
3107  ELSE
3108  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
3109  ENDIF
3110  ELSE
3111  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
3112  ENDIF
3113  ELSE
3114  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
3115  ENDIF
3116  CASE(equations_set_setup_finish_action)
3117  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
3118  analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
3119  IF(ASSOCIATED(analytic_field)) THEN
3120  IF(equations_set%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED) THEN
3121  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
3122  ENDIF
3123  ENDIF
3124  ELSE
3125  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
3126  ENDIF
3127  CASE DEFAULT
3128  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
3129  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
3130  & " is invalid for a nonlinear source Poisson equation."
3131  CALL flagerror(local_error,err,error,*999)
3132  END SELECT
3133  CASE(equations_set_setup_equations_type)
3134  SELECT CASE(equations_set_setup%ACTION_TYPE)
3135  CASE(equations_set_setup_start_action)
3136  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
3137  !Start the creation of the equations
3138  CALL equations_create_start(equations_set,equations,err,error,*999)
3139  CALL equations_linearity_type_set(equations,equations_nonlinear,err,error,*999)
3140  CALL equations_time_dependence_type_set(equations,equations_static,err,error,*999)
3141  ELSE
3142  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
3143  ENDIF
3144  CASE(equations_set_setup_finish_action)
3145  SELECT CASE(equations_set%SOLUTION_METHOD)
3146  CASE(equations_set_fem_solution_method)
3147  !Finish the creation of the equations
3148  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
3149  CALL equations_create_finish(equations,err,error,*999)
3150  !Create the equations mapping.
3151  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
3152  CALL equationsmapping_linearmatricesnumberset(equations_mapping,1,err,error,*999)
3153  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,(/field_u_variable_type/), &
3154  & err,error,*999)
3155  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
3156  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
3157  !Create the equations matrices
3158  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
3159  ! Use the analytic Jacobian calculation
3160  CALL equationsmatrices_jacobiantypesset(equations_matrices,[equations_jacobian_analytic_calculated], &
3161  & err,error,*999)
3162  SELECT CASE(equations%SPARSITY_TYPE)
3163  CASE(equations_matrices_full_matrices)
3164  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_block_storage_type/), &
3165  & err,error,*999)
3166  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices,matrix_block_storage_type, &
3167  & err,error,*999)
3168  CASE(equations_matrices_sparse_matrices)
3169  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_compressed_row_storage_type/), &
3170  & err,error,*999)
3171  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices,matrix_compressed_row_storage_type, &
3172  & err,error,*999)
3173  CALL equationsmatrices_linearstructuretypeset(equations_matrices,(/equations_matrix_fem_structure/), &
3174  & err,error,*999)
3175  CALL equationsmatrices_nonlinearstructuretypeset(equations_matrices,equations_matrix_fem_structure, &
3176  & err,error,*999)
3177  CASE DEFAULT
3178  local_error="The equations matrices sparsity type of "// &
3179  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
3180  CALL flagerror(local_error,err,error,*999)
3181  END SELECT
3182  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
3183  CASE(equations_set_bem_solution_method)
3184  CALL flagerror("Not implemented.",err,error,*999)
3185  CASE(equations_set_fd_solution_method)
3186  CALL flagerror("Not implemented.",err,error,*999)
3187  CASE(equations_set_fv_solution_method)
3188  CALL flagerror("Not implemented.",err,error,*999)
3189  CASE(equations_set_gfem_solution_method)
3190  CALL flagerror("Not implemented.",err,error,*999)
3191  CASE(equations_set_gfv_solution_method)
3192  CALL flagerror("Not implemented.",err,error,*999)
3193  CASE DEFAULT
3194  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
3195  & " is invalid."
3196  CALL flagerror(local_error,err,error,*999)
3197  END SELECT
3198  CASE DEFAULT
3199  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
3200  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
3201  & " is invalid for a nonlinear source Poisson equation."
3202  CALL flagerror(local_error,err,error,*999)
3203  END SELECT
3204  CASE DEFAULT
3205  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
3206  & " is invalid for a nonlinear source Poisson equation."
3207  CALL flagerror(local_error,err,error,*999)
3208  END SELECT
3209  ELSE
3210  local_error="The equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
3211  & " is not a nonlinear source Poisson equation subtype."
3212  CALL flagerror(local_error,err,error,*999)
3213  ENDIF
3214  ELSE
3215  CALL flagerror("Equations set is not associated.",err,error,*999)
3216  ENDIF
3217 
3218  exits("Poisson_EquationsSetNonlinearSourceSetup")
3219  RETURN
3220 999 errors("Poisson_EquationsSetNonlinearSourceSetup",err,error)
3221  exits("Poisson_EquationsSetNonlinearSourceSetup")
3222  RETURN 1
3223 
3224  END SUBROUTINE poisson_equationssetnonlinearsourcesetup
3225 
3226  !
3227  !================================================================================================================================
3228  !
3229 
3231  SUBROUTINE poisson_equation_problem_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
3232 
3233  !Argument variables
3234  TYPE(problem_type), POINTER :: PROBLEM
3235  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
3236  INTEGER(INTG), INTENT(OUT) :: ERR
3237  TYPE(varying_string), INTENT(OUT) :: ERROR
3238  !Local Variables
3239  TYPE(varying_string) :: LOCAL_ERROR
3240 
3241  enters("POISSON_EQUATION_PROBLEM_SETUP",err,error,*999)
3242 
3243  IF(ASSOCIATED(problem)) THEN
3244  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
3245  CALL flagerror("Problem specification is not allocated.",err,error,*999)
3246  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
3247  CALL flagerror("Problem specification must have three entries for a Poisson problem.",err,error,*999)
3248  END IF
3249  SELECT CASE(problem%SPECIFICATION(3))
3250  CASE(problem_extracellular_bidomain_poisson_subtype)
3251  CALL poisson_problemextracellularbidomainsetup(problem,problem_setup,err,error,*999)
3252  CASE(problem_linear_source_poisson_subtype)
3253  CALL poisson_problemlinearsourcesetup(problem,problem_setup,err,error,*999)
3254  CASE(problem_linear_pressure_poisson_subtype,problem_nonlinear_pressure_poisson_subtype, &
3255  & problem_fitted_pressure_poisson_subtype,problem_ale_pressure_poisson_subtype)
3256  CALL poisson_problempressurepoissonsetup(problem,problem_setup,err,error,*999)
3257  CASE(problem_nonlinear_source_poisson_subtype)
3258  CALL poisson_problemnonlinearsourcesetup(problem,problem_setup,err,error,*999)
3259  CASE DEFAULT
3260  local_error="Problem subtype "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
3261  & " is not valid for a Poisson equation type of a classical field problem class."
3262  CALL flagerror(local_error,err,error,*999)
3263  END SELECT
3264  ELSE
3265  CALL flagerror("Problem is not associated.",err,error,*999)
3266  ENDIF
3267 
3268  exits("POISSON_EQUATION_PROBLEM_SETUP")
3269  RETURN
3270 999 errorsexits("POISSON_EQUATION_PROBLEM_SETUP",err,error)
3271  RETURN 1
3272  END SUBROUTINE poisson_equation_problem_setup
3273 
3274  !
3275  !================================================================================================================================
3276  !
3277 
3279  SUBROUTINE poisson_equation_finite_element_calculate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
3280 
3281  !Argument variables
3282  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
3283  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
3284  INTEGER(INTG), INTENT(OUT) :: ERR
3285  TYPE(varying_string), INTENT(OUT) :: ERROR
3286  !Local Variables
3287  INTEGER(INTG) FIELD_VAR_TYPE,ng,mh,mhs,mi,ms,nh,nhs,ni,ns,I,J,K,L,H,element_node_identity !,k1sum,k2sum
3288  REAL(DP) :: RWG,SUM,PGMSI(3),PGNSI(3),SUM2,DXI_DX(3,3),DELTA_T,DXI_DX_DX(3,3),PHINS
3289  REAL(DP) :: CONDUCTIVITY_SUM_MATERIAL(3,3),CONDUCTIVITY_SUM(3,3),CONDUCTIVITY_SUM_TEMP(3,3),dNudX(3,3),dXdNu(3,3), &
3290  & DNUDXI(3,3),DXIDNU(3,3)
3291  REAL(DP) :: CONDUCTIVITY_I_MATERIAL(3,3),CONDUCTIVITY_I(3,3),CONDUCTIVITY_I_TEMP(3,3)
3292  REAL(DP), ALLOCATABLE :: MATRIX_K_I(:,:)
3293  REAL(DP), ALLOCATABLE :: Vm(:)
3294  REAL(DP) :: U_VALUE(3),U_DERIV(3,3),RHO_PARAM,MU_PARAM,U_OLD(3),U_SECOND(3,3,3),X(3),B(3),P_DERIV(3),W_VALUE(3)
3295  TYPE(basis_type), POINTER :: DEPENDENT_BASIS,GEOMETRIC_BASIS,SOURCE_BASIS,INDEPENDENT_BASIS
3296  TYPE(equations_type), POINTER :: EQUATIONS
3297  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
3298  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
3299  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
3300  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
3301  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
3302  TYPE(equations_matrices_source_type), POINTER :: SOURCE_VECTOR
3303  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
3304  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD,SOURCE_FIELD,MATERIALS_FIELD,INDEPENDENT_FIELD,FIBRE_FIELD
3305  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE,SOURCE_FIELD_VARIABLE
3306  TYPE(quadrature_scheme_type), POINTER :: QUADRATURE_SCHEME
3307  TYPE(field_interpolated_point_type), POINTER :: GEOMETRIC_INTERPOLATED_POINT,FIBRE_INTERPOLATED_POINT
3308  TYPE(field_interpolated_point_metrics_type), POINTER :: GEOMETRIC_INTERP_POINT_METRICS
3309  TYPE(varying_string) :: LOCAL_ERROR
3310 
3311  INTEGER(INTG) :: NUMBER_OF_DIMENSIONS,NUMBER_OF_XI,NUMBER_OF_ELEMENT_PARAMETERS,node_idx,dof_idx
3312 
3313  LOGICAL :: INSIDE,BETWEEN
3314  REAL(DP), POINTER :: INPUT_LABEL(:)
3315  REAL(DP) :: DIFF_COEFF1,DIFF_COEFF2
3316 
3317 #ifdef TAUPROF
3318  CHARACTER(26) :: CVAR
3319  INTEGER :: GAUSS_POINT_LOOP_PHASE(2) = [ 0, 0 ]
3320  SAVE gauss_point_loop_phase
3321 #endif
3322 
3323  NULLIFY(source_field_variable)
3324 
3325  enters("POISSON_EQUATION_FINITE_ELEMENT_CALCULATE",err,error,*999)
3326 
3327  IF(ASSOCIATED(equations_set)) THEN
3328  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
3329  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
3330  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
3331  CALL flagerror("Equations set specification must have three entries for a Poisson type equations set.", &
3332  & err,error,*999)
3333  END IF
3334  equations=>equations_set%EQUATIONS
3335  IF(ASSOCIATED(equations)) THEN
3336  SELECT CASE(equations_set%SPECIFICATION(3))
3337  CASE(equations_set_constant_source_poisson_subtype)
3338  !Store all these in equations matrices/somewhere else?????
3339  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
3340  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
3341  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
3342  equations_matrices=>equations%EQUATIONS_MATRICES
3343  linear_matrices=>equations_matrices%LINEAR_MATRICES
3344  equations_matrix=>linear_matrices%MATRICES(1)%PTR
3345  rhs_vector=>equations_matrices%RHS_VECTOR
3346  source_vector=>equations_matrices%SOURCE_VECTOR
3347  equations_mapping=>equations%EQUATIONS_MAPPING
3348  linear_mapping=>equations_mapping%LINEAR_MAPPING
3349  field_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(1)%VARIABLE
3350  field_var_type=field_variable%VARIABLE_TYPE
3351  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
3352  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
3353  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
3354  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
3355  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
3356  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
3357  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
3358  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
3359  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
3360  !Loop over gauss points
3361  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
3362  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
3363  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
3364  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
3365  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
3366  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
3367  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
3368  !Calculate RWG.
3369 !!TODO: Think about symmetric problems.
3370  rwg=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
3371  & quadrature_scheme%GAUSS_WEIGHTS(ng)
3372  !Loop over field components
3373  mhs=0
3374  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
3375  !Loop over element rows
3376 !!TODO: CHANGE ELEMENT CALCULATE TO WORK OF ns ???
3377  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
3378  mhs=mhs+1
3379  nhs=0
3380  IF(equations_matrix%UPDATE_MATRIX) THEN
3381  !Loop over element columns
3382  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
3383  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
3384  nhs=nhs+1
3385  DO ni=1,dependent_basis%NUMBER_OF_XI
3386  pgmsi(ni)=quadrature_scheme%GAUSS_BASIS_FNS(ms,partial_derivative_first_derivative_map(ni),ng)
3387  pgnsi(ni)=quadrature_scheme%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(ni),ng)
3388  ENDDO !ni
3389  sum=0.0_dp
3390  DO mi=1,dependent_basis%NUMBER_OF_XI
3391  DO ni=1,dependent_basis%NUMBER_OF_XI
3392  sum=sum+pgmsi(mi)*pgnsi(ni)*equations%INTERPOLATION% &
3393  & geometric_interp_point_metrics(field_u_variable_type)%PTR%GU(mi,ni)
3394  ENDDO !ni
3395  ENDDO !mi
3396  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*rwg
3397  ENDDO !ns
3398  ENDDO !nh
3399  ENDIF
3400  IF(source_vector%UPDATE_VECTOR) THEN
3401  !Use materials field value
3402  sum=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,no_part_deriv)
3403  source_vector%ELEMENT_VECTOR%VECTOR(mhs)=source_vector%ELEMENT_VECTOR%VECTOR(mhs)+ & !This needs to changed to the source vector
3404  & sum*quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)*rwg
3405  ENDIF
3406  ENDDO !ms
3407  ENDDO !mh
3408  ENDDO !ng
3409 
3410  CASE(equations_set_extracellular_bidomain_poisson_subtype)
3411 
3412  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
3413  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
3414  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
3415  fibre_field=>equations%INTERPOLATION%FIBRE_FIELD
3416  source_field=>equations%INTERPOLATION%SOURCE_FIELD
3417 
3418  equations_matrices=>equations%EQUATIONS_MATRICES
3419  linear_matrices=>equations_matrices%LINEAR_MATRICES
3420  equations_matrix=>linear_matrices%MATRICES(1)%PTR
3421 
3422  rhs_vector=>equations_matrices%RHS_VECTOR
3423  source_vector=>equations_matrices%SOURCE_VECTOR
3424  source_vector%UPDATE_VECTOR=.true. !TODO -- maybe done somewhere else (greped at equations_matrices_routines.f90)?, check when time dependency is included
3425 
3426  equations_mapping=>equations%EQUATIONS_MAPPING
3427  linear_mapping=>equations_mapping%LINEAR_MAPPING
3428  field_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(1)%VARIABLE
3429  field_var_type=field_variable%VARIABLE_TYPE
3430 
3431  CALL field_variable_get(source_field,field_u_variable_type,source_field_variable,err,error,*999)
3432 
3433  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
3434  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
3435  source_basis=>source_field%DECOMPOSITION%DOMAIN(source_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
3436  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
3437  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
3438  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
3439 
3440  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
3441  number_of_element_parameters=dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
3442 
3443  number_of_dimensions=equations_set%REGION%COORDINATE_SYSTEM%NUMBER_OF_DIMENSIONS
3444  number_of_xi=dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR%TOPOLOGY% &
3445  & elements%ELEMENTS(element_number)%BASIS%NUMBER_OF_XI
3446 
3447  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
3448  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
3449  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
3450  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
3451  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
3452  & fibre_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
3453  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
3454  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
3455  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
3456  & source_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
3457 
3458  geometric_interpolated_point=>equations%INTERPOLATION%GEOMETRIC_INTERP_POINT(field_u_variable_type)%PTR
3459  fibre_interpolated_point=>equations%INTERPOLATION%FIBRE_INTERP_POINT(field_u_variable_type)%PTR
3460  geometric_interp_point_metrics=>equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR
3461 
3462  ALLOCATE(matrix_k_i(number_of_element_parameters,number_of_element_parameters),stat=err)
3463  IF(err/=0) CALL flagerror("Could not allocate matrix K_i.",err,error,*999)
3464  matrix_k_i=0.0_dp
3465  ALLOCATE(vm(number_of_element_parameters),stat=err)
3466  IF(err/=0) CALL flagerror("Could not allocate vector V_m.",err,error,*999)
3467  vm=0.0_dp
3468 
3469  !Loop over gauss points
3470  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
3471 #ifdef TAUPROF
3472  WRITE (cvar,'(a17,i2)') 'Gauss Point Loop ',ng
3473  CALL tau_phase_create_dynamic(gauss_point_loop_phase,cvar)
3474  CALL tau_phase_start(gauss_point_loop_phase)
3475 #endif
3476  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
3477  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
3478  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
3479  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
3480  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
3481  & fibre_interp_point(field_u_variable_type)%PTR,err,error,*999)
3482  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
3483  & source_interp_point(field_u_variable_type)%PTR,err,error,*999)
3484 
3485  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,geometric_interp_point_metrics, &
3486  & err,error,*999)
3487 
3488  !Calculate RWG.
3489  rwg=geometric_interp_point_metrics%JACOBIAN*quadrature_scheme%GAUSS_WEIGHTS(ng)
3490  !conductivities in material coordinates
3491  conductivity_sum_material=0.0_dp !intra- plus extracellular
3492  conductivity_i_material=0.0_dp !intracellular
3493  IF(number_of_dimensions==2) THEN
3494  !interpolated values
3495  conductivity_i_material(1,1)=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,1)
3496  conductivity_i_material(2,2)=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,1)
3497  conductivity_i_material(1,2)=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,1)
3498  conductivity_i_material(2,1)=conductivity_i_material(1,2)
3499 
3500  conductivity_sum_material(1,1)=conductivity_i_material(1,1)+ &
3501  & equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(4,1)
3502  conductivity_sum_material(2,2)=conductivity_i_material(2,2)+ &
3503  & equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(5,1)
3504  conductivity_sum_material(1,2)=conductivity_i_material(1,2)+ &
3505  & equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(6,1)
3506  conductivity_sum_material(2,1)=conductivity_sum_material(1,2)
3507  ELSE
3508  !interpolated values
3509  conductivity_i_material(1,1)=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,1)
3510  conductivity_i_material(2,2)=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,1)
3511  conductivity_i_material(3,3)=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,1)
3512  conductivity_i_material(1,2)=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(4,1)
3513  conductivity_i_material(2,1)=conductivity_i_material(1,2)
3514  conductivity_i_material(2,3)=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(5,1)
3515  conductivity_i_material(3,2)=conductivity_i_material(2,3)
3516  conductivity_i_material(1,3)=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(6,1)
3517  conductivity_i_material(3,1)=conductivity_i_material(1,3)
3518 
3519  conductivity_sum_material(1,1)=conductivity_i_material(1,1)+ &
3520  & equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(7,1)
3521  conductivity_sum_material(2,2)=conductivity_i_material(2,2)+ &
3522  & equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(8,1)
3523  conductivity_sum_material(3,3)=conductivity_i_material(3,3)+ &
3524  & equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(9,1)
3525  conductivity_sum_material(1,2)=conductivity_i_material(1,2)+ &
3526  & equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(10,1)
3527  conductivity_sum_material(2,1)=conductivity_sum_material(1,2)
3528  conductivity_sum_material(2,3)=conductivity_i_material(2,3)+ &
3529  & equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(11,1)
3530  conductivity_sum_material(3,2)=conductivity_sum_material(2,3)
3531  conductivity_sum_material(1,3)=conductivity_i_material(1,3)+ &
3532  & equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(12,1)
3533  conductivity_sum_material(3,1)=conductivity_sum_material(1,3)
3534  ENDIF
3535 
3536  !rotate the conductivities from material coordinates (nu) to xi-space to get the effective conductivity
3537  CALL coordinates_materialsystemcalculate(geometric_interp_point_metrics,fibre_interpolated_point, &
3538  & dnudx,dxdnu,dnudxi,dxidnu,err,error,*999)
3539 
3540  CALL matrix_product(dnudxi,conductivity_sum_material,conductivity_sum_temp,err,error,*999)
3541  CALL matrix_product(conductivity_sum_temp,dxidnu,conductivity_sum,err,error,*999)
3542 
3543  CALL matrix_product(dnudxi,conductivity_i_material,conductivity_i_temp,err,error,*999)
3544  CALL matrix_product(conductivity_i_temp,dxidnu,conductivity_i,err,error,*999)
3545 
3546  !calculate the element stiffness matrix K_{i+e}
3547  IF(equations_matrix%UPDATE_MATRIX) THEN
3548  !Loop over field components
3549  mhs=0
3550  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
3551  !Loop over element rows
3552  DO ms=1,number_of_element_parameters
3553  mhs=mhs+1
3554  !Loop over field components
3555  nhs=0
3556  !Loop over element columns
3557  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
3558  DO ns=1,number_of_element_parameters
3559  nhs=nhs+1
3560 
3561  DO ni=1,dependent_basis%NUMBER_OF_XI
3562  pgmsi(ni)=quadrature_scheme%GAUSS_BASIS_FNS(ms,partial_derivative_first_derivative_map(ni),ng)
3563  pgnsi(ni)=quadrature_scheme%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(ni),ng)
3564  ENDDO !ni
3565 
3566  sum=0.0_dp
3567  DO i=1,dependent_basis%NUMBER_OF_XI
3568  DO k=1,dependent_basis%NUMBER_OF_XI
3569  DO h=1,dependent_basis%NUMBER_OF_XI
3570  sum=sum+conductivity_sum(i,k)*pgnsi(k)*pgmsi(h)*geometric_interp_point_metrics%GU(i,h)
3571  ENDDO !H
3572  ENDDO !K
3573  ENDDO !I
3574 
3575  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*rwg
3576 
3577  ENDDO !ns
3578  ENDDO !nh
3579  ENDDO !ms
3580  ENDDO !mh
3581  ENDIF
3582 
3583  !calculate the matrix K_i for the source vector K_i * Vm
3584  IF(source_vector%UPDATE_VECTOR) THEN
3585  !Loop over field components
3586  mhs=0
3587  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
3588  !Loop over element rows
3589  DO ms=1,number_of_element_parameters
3590  mhs=mhs+1
3591  !Loop over field components
3592  nhs=0
3593  !Loop over element columns
3594  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
3595  DO ns=1,number_of_element_parameters
3596  nhs=nhs+1
3597 
3598  DO ni=1,dependent_basis%NUMBER_OF_XI
3599  pgmsi(ni)=quadrature_scheme%GAUSS_BASIS_FNS(ms,partial_derivative_first_derivative_map(ni),ng)
3600  pgnsi(ni)=quadrature_scheme%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(ni),ng)
3601  ENDDO !ni
3602 
3603  sum=0.0_dp
3604  DO i=1,dependent_basis%NUMBER_OF_XI
3605  DO k=1,dependent_basis%NUMBER_OF_XI
3606  DO h=1,dependent_basis%NUMBER_OF_XI
3607  sum=sum+conductivity_i(i,k)*pgnsi(k)*pgmsi(h)*geometric_interp_point_metrics%GU(i,h)
3608  ENDDO !H
3609  ENDDO !K
3610  ENDDO !I
3611 
3612  matrix_k_i(mhs,nhs)=matrix_k_i(mhs,nhs)+sum*rwg
3613 
3614  ENDDO !ns
3615  ENDDO !nh
3616  ENDDO !ms
3617  ENDDO !mh
3618  ENDIF
3619 
3620  ! initialise element RHS_VECTORs with 0
3621  IF(rhs_vector%UPDATE_VECTOR) THEN
3622  !Loop over field components
3623  mhs=0
3624  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
3625  !Loop over vector rows
3626  DO ms=1,number_of_element_parameters
3627  mhs=mhs+1
3628  rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=0.0_dp
3629  ENDDO !ms
3630  ENDDO !mh
3631  ENDIF
3632 
3633 
3634 #ifdef TAUPROF
3635  CALL tau_phase_stop(gauss_point_loop_phase)
3636 #endif
3637  ENDDO !ng
3638 
3639  !now do a matrix-vector of the K_i matrix with the source field Vm and store in source_vector
3640  IF(source_vector%UPDATE_VECTOR) THEN
3641 
3642  !get correct Vm-vector entries (rows nhs)
3643  DO nhs=1,number_of_element_parameters
3644  !get correct global node index for this element
3645  node_idx=source_vector%ELEMENT_VECTOR%ROW_DOFS(nhs)
3646  !get corresponding dof_idx (in this case node_idx=dof_idx as just 1 component, but leave for generality)
3647  dof_idx=source_field_variable%COMPONENTS(1)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node_idx)% &
3648  & derivatives(1)%VERSIONS(1)
3649  !get the correct value from global source field
3650  CALL field_parameter_set_get_local_dof(source_field,field_u_variable_type,field_values_set_type, &
3651  & dof_idx,vm(nhs),err,error,*999)
3652  ENDDO
3653 
3654  !calculate the matrix-vector-product
3655  mhs=0
3656  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
3657  !Loop over element matrix / source-vector rows
3658  DO ms=1,number_of_element_parameters
3659  mhs=mhs+1
3660  nhs=0
3661  !Loop over element matrix columns / Vm-vector entries (summation)
3662  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
3663  DO ns=1,number_of_element_parameters
3664  nhs=nhs+1
3665  source_vector%ELEMENT_VECTOR%VECTOR(mhs)=source_vector%ELEMENT_VECTOR%VECTOR(mhs)+matrix_k_i(mhs,nhs)*vm(nhs)
3666  ENDDO !ns
3667  ENDDO !nh
3668  ENDDO !ms
3669  ENDDO !mh
3670 
3671  ENDIF
3672 
3673  DEALLOCATE(matrix_k_i)
3674  DEALLOCATE(vm)
3675 
3676  CASE(equations_set_nonlinear_pressure_poisson_subtype,equations_set_linear_pressure_poisson_subtype, &
3677  & equations_set_ale_pressure_poisson_subtype,equations_set_fitted_pressure_poisson_subtype)
3678  !Store all these in equations matrices/somewhere else?????
3679 
3680  inside=.true.
3681  between=.false.
3682 
3683  source_field=>equations%INTERPOLATION%SOURCE_FIELD
3684  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
3685  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
3686  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
3687  equations_matrices=>equations%EQUATIONS_MATRICES
3688  linear_matrices=>equations_matrices%LINEAR_MATRICES
3689  equations_matrix=>linear_matrices%MATRICES(1)%PTR
3690  rhs_vector=>equations_matrices%RHS_VECTOR
3691  source_vector=>equations_matrices%SOURCE_VECTOR
3692  equations_mapping=>equations%EQUATIONS_MAPPING
3693  linear_mapping=>equations_mapping%LINEAR_MAPPING
3694  field_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(1)%VARIABLE
3695  field_var_type=field_variable%VARIABLE_TYPE
3696  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
3697  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
3698  source_basis=>source_field%DECOMPOSITION%DOMAIN(source_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
3699  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
3700  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
3701  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
3702  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
3703  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
3704  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
3705  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
3706  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
3707  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
3708  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
3709  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
3710  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
3711  IF(equations_set%SPECIFICATION(3)==equations_set_ale_pressure_poisson_subtype) THEN
3712  independent_field=>equations%INTERPOLATION%INDEPENDENT_FIELD
3713  independent_basis=>independent_field%DECOMPOSITION%DOMAIN(independent_field% &
3714  & decomposition%MESH_COMPONENT_NUMBER)%PTR% &
3715  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
3716  CALL field_interpolation_parameters_element_get(field_mesh_velocity_set_type,element_number,equations%INTERPOLATION% &
3717  & independent_interp_parameters(field_var_type)%PTR,err,error,*999)
3718  ENDIF
3719 
3720  diff_coeff1=1.0_dp
3721  diff_coeff2=1.0_dp
3722 
3723  !Determine inside outside nodes/elements
3724  CALL field_parameter_set_data_get(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
3725  & field_input_label_set_type,input_label,err,error,*999)
3726  DO i=1,geometric_field%decomposition%domain(1)%ptr%topology%elements%maximum_number_of_element_parameters
3727  element_node_identity=geometric_field%decomposition%domain(1)%ptr%topology% &
3728  & elements%elements(element_number)%element_nodes(i)
3729  !this needs to be changed even at the right INPUT_LABEL
3730  IF(input_label(element_node_identity)<0.5_dp) THEN
3731  !labelling if !!!ELEMENT!!! is inside or outside
3732  !so even if only one node is outside node, the whole element is outside element.
3733  inside=.false.
3734  ENDIF
3735  ENDDO
3736  DO i=1,geometric_field%decomposition%domain(1)%ptr%topology%elements%maximum_number_of_element_parameters
3737  element_node_identity=geometric_field%decomposition%domain(1)%ptr%topology% &
3738  & elements%elements(element_number)%element_nodes(i)
3739  !this needs to be changed even at the right INPUT_LABEL
3740  IF(.NOT.inside) THEN
3741  IF(input_label(element_node_identity)>0.5_dp) THEN
3742  !labelling if !!!ELEMENT!!! is inside or outside
3743  !so even if only one node is outside node, the whole element is outside element.
3744  between=.true.
3745  ENDIF
3746  ENDIF
3747  ENDDO
3748 
3749  IF(inside) THEN
3750  diff_coeff1=1.0_dp
3751  diff_coeff2=1.0_dp
3752  ELSE IF(between) THEN
3753 ! set to "zero" if "between" nodes should be outside!
3754 ! DIFF_COEFF1=0.0_DP
3755  diff_coeff1=1.0_dp/1000.0_dp
3756  diff_coeff2=0.0_dp
3757  ELSE
3758  diff_coeff1=0.0_dp
3759  diff_coeff2=0.0_dp
3760  ENDIF
3761  !Loop over gauss points
3762  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
3763  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
3764  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
3765  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
3766  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
3767  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
3768  & dependent_interp_point(field_var_type)%PTR,err,error,*999)
3769  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
3770  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
3771  IF(equations_set%SPECIFICATION(3)==equations_set_ale_pressure_poisson_subtype) THEN
3772  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
3773  & independent_interp_point(field_u_variable_type)%PTR,err,error,*999)
3774  w_value(1)=equations%INTERPOLATION%INDEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,no_part_deriv)
3775  w_value(2)=equations%INTERPOLATION%INDEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,no_part_deriv)
3776  IF(independent_basis%NUMBER_OF_XI==3) THEN
3777  w_value(3)=equations%INTERPOLATION%INDEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,no_part_deriv)
3778  END IF
3779  ELSE
3780  w_value=0.0_dp
3781  END IF
3782 
3783 ! ! ! W_VALUE=0.0_DP
3784 
3785  u_value=0.0_dp
3786  u_old=0.0_dp
3787  dxi_dx=0.0_dp
3788  dxi_dx_dx=0.0_dp
3789  delta_t=1.0_dp !need to be dependent on example file
3790  u_deriv=0.0_dp
3791  u_second=0.0_dp
3792  IF(source_vector%UPDATE_VECTOR) THEN
3793  CALL field_interpolation_parameters_element_get(field_input_data1_set_type,element_number, &
3794  & equations%INTERPOLATION%SOURCE_INTERP_PARAMETERS(field_u_variable_type)%PTR,err,error,*999)
3795  CALL field_interpolate_gauss(second_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
3796  & source_interp_point(field_u_variable_type)%PTR,err,error,*999)
3797  u_value(1)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,no_part_deriv)
3798  u_value(2)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,no_part_deriv)
3799  u_deriv(1,1)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,part_deriv_s1)
3800  u_deriv(1,2)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,part_deriv_s2)
3801  u_deriv(2,1)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,part_deriv_s1)
3802  u_deriv(2,2)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,part_deriv_s2)
3803  u_second(1,1,1)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,part_deriv_s1_s1)
3804  u_second(1,1,2)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,part_deriv_s1_s2)
3805  u_second(1,2,1)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,part_deriv_s1_s2)
3806  u_second(1,2,2)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,part_deriv_s2_s2)
3807  u_second(2,1,1)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,part_deriv_s1_s1)
3808  u_second(2,1,2)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,part_deriv_s1_s2)
3809  u_second(2,2,1)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,part_deriv_s1_s2)
3810  u_second(2,2,2)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,part_deriv_s2_s2)
3811  IF(dependent_basis%NUMBER_OF_XI==3) THEN
3812  u_value(3)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,no_part_deriv)
3813  u_deriv(1,3)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,part_deriv_s3)
3814  u_deriv(2,3)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,part_deriv_s3)
3815  u_deriv(3,1)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,part_deriv_s1)
3816  u_deriv(3,2)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,part_deriv_s2)
3817  u_deriv(3,3)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,part_deriv_s3)
3818  u_second(1,1,3)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,part_deriv_s1_s3)
3819  u_second(1,2,3)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,part_deriv_s2_s3)
3820  u_second(1,3,1)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,part_deriv_s1_s3)
3821  u_second(1,3,2)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,part_deriv_s2_s3)
3822  u_second(1,3,3)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,part_deriv_s3_s3)
3823  u_second(2,1,3)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,part_deriv_s1_s3)
3824  u_second(2,2,3)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,part_deriv_s2_s3)
3825  u_second(2,3,1)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,part_deriv_s1_s3)
3826  u_second(2,3,2)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,part_deriv_s2_s3)
3827  u_second(2,3,3)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,part_deriv_s3_s3)
3828  u_second(3,1,1)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,part_deriv_s1_s1)
3829  u_second(3,1,2)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,part_deriv_s1_s2)
3830  u_second(3,1,3)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,part_deriv_s1_s3)
3831  u_second(3,2,1)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,part_deriv_s1_s2)
3832  u_second(3,2,2)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,part_deriv_s2_s2)
3833  u_second(3,2,3)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,part_deriv_s2_s3)
3834  u_second(3,3,1)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,part_deriv_s1_s3)
3835  u_second(3,3,2)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,part_deriv_s2_s3)
3836  u_second(3,3,3)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,part_deriv_s3_s3)
3837  ENDIF
3838  CALL field_interpolation_parameters_element_get(field_input_data2_set_type,element_number, &
3839  & equations%INTERPOLATION%SOURCE_INTERP_PARAMETERS(field_u_variable_type)%PTR,err,error,*999)
3840  CALL field_interpolate_gauss(second_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
3841  & source_interp_point(field_u_variable_type)%PTR,err,error,*999)
3842  u_old(1)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,no_part_deriv)
3843  u_old(2)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,no_part_deriv)
3844  p_deriv(1)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(1,part_deriv_s1)
3845  p_deriv(2)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(1,part_deriv_s2)
3846  IF(dependent_basis%NUMBER_OF_XI==3) THEN
3847  u_old(3)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,no_part_deriv)
3848  p_deriv(3)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(1,part_deriv_s3)
3849  ENDIF
3850  ENDIF
3851  !Define RHO_PARAM, density=1
3852  mu_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,no_part_deriv)
3853  rho_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,no_part_deriv)
3854  !Calculate RWG.
3855 !!TODO: Think about symmetric problems.
3856  rwg=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
3857  & quadrature_scheme%GAUSS_WEIGHTS(ng)
3858  !Loop over field components
3859  mhs=0
3860  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
3861  !Loop over element rows
3862 !!TODO: CHANGE ELEMENT CALCULATE TO WORK OF ns ???
3863  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
3864  mhs=mhs+1
3865  nhs=0
3866  IF(equations_matrix%UPDATE_MATRIX) THEN
3867  !Loop over element columns
3868  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
3869  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
3870  nhs=nhs+1
3871  phins=quadrature_scheme%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)
3872  DO ni=1,dependent_basis%NUMBER_OF_XI
3873  pgmsi(ni)=quadrature_scheme%GAUSS_BASIS_FNS(ms,partial_derivative_first_derivative_map(ni),ng)
3874  pgnsi(ni)=quadrature_scheme%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(ni),ng)
3875  DO mi=1,dependent_basis%NUMBER_OF_XI
3876  dxi_dx(mi,ni)=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR% &
3877  & dxi_dx(mi,ni)
3878  END DO
3879  ENDDO !ni
3880  sum=0.0_dp
3881 
3882  DO mi=1,dependent_basis%NUMBER_OF_XI
3883  DO ni=1,dependent_basis%NUMBER_OF_XI
3884  sum=sum+pgmsi(mi)*pgnsi(ni)*equations%INTERPOLATION% &
3885  & geometric_interp_point_metrics(field_u_variable_type)%PTR%GU(mi,ni)*diff_coeff1
3886  ENDDO !ni
3887  ENDDO !mi
3888  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*rwg
3889  ENDDO !ns
3890  ENDDO !nh
3891  ENDIF
3892  IF(equations_set%SPECIFICATION(3)==equations_set_linear_pressure_poisson_subtype) THEN
3893  sum=0.0_dp
3894  sum2=0.0_dp
3895  b=0.0_dp
3896  IF(source_vector%UPDATE_VECTOR) THEN
3897  DO k=1,3
3898  !this is the temporal term (should be zero for static)
3899  IF(inside) THEN
3900  b(k)=-rho_param*((u_value(k)-u_old(k))/delta_t)
3901 ! ! this is the first viscous term
3902 ! DO K=1,3
3903 ! DO L=1,3
3904 ! B(I)=B(I)+U_DERIV(I,L)*DXI_DX_DX(L,K)
3905 ! ENDDO
3906 ! ENDDO
3907 ! this is the second viscous term
3908  DO l=1,3
3909  DO i=1,3
3910  ! this is the ALE term
3911  b(k)=b(k)+rho_param*w_value(i)*u_deriv(k,l)*dxi_dx(l,i)
3912  DO h=1,3
3913  b(k)=b(k)+mu_param*u_second(k,l,h)*dxi_dx(l,i)*dxi_dx(h,i)
3914  ENDDO
3915  ENDDO
3916  ENDDO
3917  ELSE
3918  b(k)=0.0_dp
3919  ENDIF
3920  !eventually it gets combined to the RHS (source) term
3921  DO j=1,3
3922  sum=sum+b(k)*pgmsi(j)*dxi_dx(j,k)
3923  ENDDO
3924  ENDDO
3925  source_vector%ELEMENT_VECTOR%VECTOR(mhs)=source_vector%ELEMENT_VECTOR%VECTOR(mhs)+sum*rwg
3926  ENDIF
3927  ELSE IF(equations_set%SPECIFICATION(3)==equations_set_nonlinear_pressure_poisson_subtype.OR. &
3928  & equations_set%SPECIFICATION(3)==equations_set_ale_pressure_poisson_subtype.OR. &
3929  & equations_set%SPECIFICATION(3)==equations_set_fitted_pressure_poisson_subtype) THEN
3930  sum=0.0_dp
3931  sum2=0.0_dp
3932  b=0.0_dp
3933  IF(source_vector%UPDATE_VECTOR) THEN
3934  DO k=1,3
3935  IF(inside) THEN
3936  !this is the temporal term (should be zero for static)
3937  b(k)=-rho_param*((u_value(k)-u_old(k))/delta_t)
3938  !this is the nonlinear term (should be zero for Stokes)
3939  DO l=1,3
3940  DO i=1,3
3941  !this is the nonlinear/ALE trem
3942  b(k)=b(k)-rho_param*(u_value(i)-w_value(i))*u_deriv(k,l)*dxi_dx(l,i)
3943  DO h=1,3
3944  !this is the viscous terms
3945  b(k)=b(k)+mu_param*u_second(k,l,h)*dxi_dx(l,i)*dxi_dx(h,i)
3946  ENDDO
3947  ENDDO
3948  ENDDO
3949  ELSE
3950  b(k)=0.0_dp
3951  ENDIF
3952  !now bring the test function in
3953  DO j=1,3
3954  sum=sum+b(k)*pgmsi(j)*dxi_dx(j,k)*diff_coeff2
3955  ENDDO
3956  ENDDO
3957  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
3958  IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_pressure_poisson_three_dim_1) THEN
3959  x(1) = equations%INTERPOLATION%GEOMETRIC_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,1)
3960  x(2) = equations%INTERPOLATION%GEOMETRIC_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,1)
3961  x(3) = equations%INTERPOLATION%GEOMETRIC_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,1)
3962  sum2=-4.0_dp*pi*pi/100.0*(3.0_dp*sin(2.0_dp*pi*x(1)/10.0_dp)*sin(2.0_dp*pi*x(2)/10.0)* &
3963  & sin(2.0_dp*pi*x(3)/10.0_dp)-6.0_dp*rho_param*cos(2.0_dp*pi*x(1)/10.0_dp)**2+ &
3964  & 8.0_dp*rho_param*cos(2.0_dp*pi*x(1)/10.0_dp)**2*cos(2.0_dp*pi*x(3)/10.0_dp)**2- &
3965  & 2.0_dp*rho_param*cos(2.0_dp*pi*x(3)/10.0_dp)**2+2.0_dp*rho_param*cos(2.0_dp*pi*x(1)/10.0_dp)**2* &
3966  & cos(2.0_dp*pi*x(2)/10.0_dp)**2+4.0_dp*rho_param*cos(2.0_dp*pi*x(2)/10.0_dp)**2- &
3967  & 2.0_dp*rho_param*cos(2.0_dp*pi*x(2)/10.0_dp)**2*cos(2.0_dp*pi*x(3)/10.0_dp)**2)
3968  ELSE IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_pressure_poisson_three_dim_2) THEN
3969  x(1) = equations%INTERPOLATION%GEOMETRIC_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,1)
3970  x(2) = equations%INTERPOLATION%GEOMETRIC_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,1)
3971  x(3) = equations%INTERPOLATION%GEOMETRIC_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,1)
3972  sum2=-12.0_dp* sin(2.0_dp*pi*x(1)/10.0_dp)*pi*pi/100.0_dp*sin(2.0_dp*pi*x(2)/10.0_dp)* &
3973  & sin(2.0_dp*pi*x(3)/10.0_dp)
3974  sum=0.0_dp
3975  ELSE
3976  CALL flagerror("Not implemented.",err,error,*999)
3977  ENDIF
3978  ENDIF
3979  source_vector%ELEMENT_VECTOR%VECTOR(mhs)=source_vector%ELEMENT_VECTOR%VECTOR(mhs)+sum*rwg &
3980  & -sum2*quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)*rwg
3981  ENDIF
3982  ELSE
3983  source_vector%ELEMENT_VECTOR%VECTOR(mhs)=0.0_dp
3984  ENDIF
3985  ENDDO !ms
3986  ENDDO !mh
3987  ENDDO !ng
3988  !Scale factor adjustment
3989  IF(dependent_field%SCALINGS%SCALING_TYPE/=field_no_scaling) THEN
3990  CALL field_interpolationparametersscalefactorselementget(element_number,equations%INTERPOLATION% &
3991  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
3992  mhs=0
3993  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
3994  !Loop over element rows
3995  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
3996  mhs=mhs+1
3997  nhs=0
3998  IF(equations_matrix%UPDATE_MATRIX) THEN
3999  !Loop over element columns
4000  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
4001  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
4002  nhs=nhs+1
4003  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)* &
4004  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)* &
4005  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
4006  ENDDO !ns
4007  ENDDO !nh
4008  ENDIF
4009  IF(rhs_vector%UPDATE_VECTOR) rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)* &
4010  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)
4011  IF(source_vector%UPDATE_VECTOR) source_vector%ELEMENT_VECTOR%VECTOR(mhs)=source_vector% &
4012  & element_vector%VECTOR(mhs)*equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)% &
4013  & ptr%SCALE_FACTORS(ms,mh)
4014  ENDDO !ms
4015  ENDDO !mh
4016  ENDIF
4017  CASE(equations_set_linear_source_poisson_subtype)
4018  CALL flagerror("Not implemented.",err,error,*999)
4019  CASE(equations_set_quadratic_source_poisson_subtype)
4020  CALL flagerror("Can not calculate finite element stiffness matrices for a nonlinear source.",err,error,*999)
4021  CASE(equations_set_exponential_source_poisson_subtype)
4022  CALL flagerror("Can not calculate finite element stiffness matrices for a nonlinear source.",err,error,*999)
4023  CASE DEFAULT
4024  local_error="Equations set subtype "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
4025  & " is not valid for a Poisson equation type of a classical field equations set class."
4026  CALL flagerror(local_error,err,error,*999)
4027  END SELECT
4028  ELSE
4029  CALL flagerror("Equations set equations is not associated.",err,error,*999)
4030  ENDIF
4031  ELSE
4032  CALL flagerror("Equations set is not associated.",err,error,*999)
4033  ENDIF
4034 
4035  exits("POISSON_EQUATION_FINITE_ELEMENT_CALCULATE")
4036  RETURN
4037 999 errorsexits("POISSON_EQUATION_FINITE_ELEMENT_CALCULATE",err,error)
4038  RETURN 1
4039  END SUBROUTINE poisson_equation_finite_element_calculate
4040 
4041  !
4042  !================================================================================================================================
4043  !
4044 
4046  SUBROUTINE poisson_finiteelementjacobianevaluate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
4047 
4048  !Argument variables
4049  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
4050  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
4051  INTEGER(INTG), INTENT(OUT) :: ERR
4052  TYPE(varying_string), INTENT(OUT) :: ERROR
4053  !Local Variables
4054  INTEGER(INTG) FIELD_VAR_TYPE,ng,mh,mhs,ms,nh,nhs,ns
4055  REAL(DP) :: B_PARAM,C_PARAM,RWG,U_VALUE,VALUE
4056  TYPE(basis_type), POINTER :: DEPENDENT_BASIS,GEOMETRIC_BASIS
4057  TYPE(equations_type), POINTER :: EQUATIONS
4058  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
4059  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
4060  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
4061  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
4062  TYPE(equations_jacobian_type), POINTER :: JACOBIAN_MATRIX
4063  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD
4064  TYPE(field_variable_type), POINTER :: DEPENDENT_VARIABLE,GEOMETRIC_VARIABLE
4065  TYPE(quadrature_scheme_type), POINTER :: QUADRATURE_SCHEME
4066  TYPE(varying_string) :: LOCAL_ERROR
4067 
4068  enters("Poisson_FiniteElementJacobianEvaluate",err,error,*999)
4069 
4070  IF(ASSOCIATED(equations_set)) THEN
4071  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
4072  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
4073  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
4074  CALL flagerror("Equations set specification must have three entries for a Poisson type equations set.", &
4075  & err,error,*999)
4076  END IF
4077  equations=>equations_set%EQUATIONS
4078  IF(ASSOCIATED(equations)) THEN
4079  SELECT CASE(equations_set%SPECIFICATION(3))
4080  CASE(equations_set_constant_source_poisson_subtype)
4081  CALL flagerror("Can not evaluate a Jacobian for a Poisson equation with a linear source.",err,error,*999)
4082  CASE(equations_set_linear_source_poisson_subtype)
4083  CALL flagerror("Can not evaluate a Jacobian for a Poisson equation with a linear source.",err,error,*999)
4084  CASE(equations_set_extracellular_bidomain_poisson_subtype)
4085  CALL flagerror("Can not evaluate a Jacobian for a Poisson equation with a linear source.",err,error,*999)
4086  CASE(equations_set_quadratic_source_poisson_subtype)
4087  equations_matrices=>equations%EQUATIONS_MATRICES
4088  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4089  jacobian_matrix=>nonlinear_matrices%JACOBIANS(1)%PTR
4090  IF(jacobian_matrix%UPDATE_JACOBIAN) THEN
4091  !Store all these in equations matrices/somewhere else?????
4092  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
4093  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
4094  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
4095  equations_mapping=>equations%EQUATIONS_MAPPING
4096  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
4097  dependent_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
4098  field_var_type=dependent_variable%VARIABLE_TYPE
4099  geometric_variable=>geometric_field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
4100  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
4101  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
4102  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
4103  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
4104  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
4105  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
4106  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
4107  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
4108  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
4109  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
4110  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
4111  !Loop over gauss points
4112  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
4113  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
4114  & dependent_interp_point(field_var_type)%PTR,err,error,*999)
4115  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
4116  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
4117  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
4118  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
4119  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
4120  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
4121  !Calculate RWG.
4122  rwg=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
4123  & quadrature_scheme%GAUSS_WEIGHTS(ng)
4124  !Find material parameters and u value at this Gauss point
4125  c_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR% &
4126  & values(geometric_variable%NUMBER_OF_COMPONENTS+3,no_part_deriv)
4127  u_value=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(1,no_part_deriv)
4128  !Loop over field components
4129  mhs=0
4130  DO mh=1,dependent_variable%NUMBER_OF_COMPONENTS
4131  !Loop over element rows
4132  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
4133  mhs=mhs+1
4134  nhs=0
4135  !Loop over element columns
4136  DO nh=1,dependent_variable%NUMBER_OF_COMPONENTS
4137  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
4138  nhs=nhs+1
4139  VALUE=-2.0_dp*c_param*quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)* &
4140  & quadrature_scheme%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)*u_value
4141  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)+VALUE*rwg
4142  ENDDO !ns
4143  ENDDO !nh
4144  ENDDO !ms
4145  ENDDO !mh
4146  ENDDO !ng
4147  ENDIF
4148  CASE(equations_set_exponential_source_poisson_subtype)
4149  equations_matrices=>equations%EQUATIONS_MATRICES
4150  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4151  jacobian_matrix=>nonlinear_matrices%JACOBIANS(1)%PTR
4152  IF(jacobian_matrix%UPDATE_JACOBIAN) THEN
4153  !Store all these in equations matrices/somewhere else?????
4154  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
4155  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
4156  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
4157  equations_mapping=>equations%EQUATIONS_MAPPING
4158  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
4159  dependent_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
4160  field_var_type=dependent_variable%VARIABLE_TYPE
4161  geometric_variable=>geometric_field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
4162  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
4163  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
4164  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
4165  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
4166  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
4167  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
4168  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
4169  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
4170  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
4171  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
4172  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
4173  !Loop over gauss points
4174  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
4175  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
4176  & dependent_interp_point(field_var_type)%PTR,err,error,*999)
4177  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
4178  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
4179  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
4180  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
4181  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
4182  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
4183  !Calculate RWG.
4184  rwg=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
4185  & quadrature_scheme%GAUSS_WEIGHTS(ng)
4186  !Find material parameter and u value at this Gauss point
4187  b_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR% &
4188  & values(geometric_variable%NUMBER_OF_COMPONENTS+2,no_part_deriv)
4189  c_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR% &
4190  & values(geometric_variable%NUMBER_OF_COMPONENTS+3,no_part_deriv)
4191  u_value=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(1,no_part_deriv)
4192  !Loop over field components
4193  mhs=0
4194  DO mh=1,dependent_variable%NUMBER_OF_COMPONENTS
4195  !Loop over element rows
4196  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
4197  mhs=mhs+1
4198  nhs=0
4199  !Loop over element columns
4200  DO nh=1,dependent_variable%NUMBER_OF_COMPONENTS
4201  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
4202  nhs=nhs+1
4203  VALUE=-b_param*c_param*quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)* &
4204  & quadrature_scheme%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)*exp(c_param*u_value)
4205  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)+VALUE*rwg
4206  ENDDO !ns
4207  ENDDO !nh
4208  ENDDO !ms
4209  ENDDO !mh
4210  ENDDO !ng
4211  ENDIF
4212  CASE DEFAULT
4213  local_error="Equations set subtype "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
4214  & " is not valid for a Poisson equation type of a classical field equations set class."
4215  CALL flagerror(local_error,err,error,*999)
4216  END SELECT
4217  ELSE
4218  CALL flagerror("Equations set equations is not associated.",err,error,*999)
4219  ENDIF
4220  ELSE
4221  CALL flagerror("Equations set is not associated.",err,error,*999)
4222  ENDIF
4223 
4224  exits("Poisson_FiniteElementJacobianEvaluate")
4225  RETURN
4226 999 errors("Poisson_FiniteElementJacobianEvaluate",err,error)
4227  exits("Poisson_FiniteElementJacobianEvaluate")
4228  RETURN 1
4229 
4230  END SUBROUTINE poisson_finiteelementjacobianevaluate
4231 
4232  !
4233  !================================================================================================================================
4234  !
4235 
4237  SUBROUTINE poisson_finiteelementresidualevaluate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
4238 
4239  !Argument variables
4240  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
4241  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
4242  INTEGER(INTG), INTENT(OUT) :: ERR
4243  TYPE(varying_string), INTENT(OUT) :: ERROR
4244  !Local Variables
4245  INTEGER(INTG) FIELD_VAR_TYPE,ng,mh,mhs,ms,nj,nh,nhs,ni,ns
4246  REAL(DP) :: A_PARAM,B_PARAM,C_PARAM,K_PARAM,RWG,SUM1,SUM2,PGMJ(3),PGNJ(3),U_VALUE,WG
4247  TYPE(basis_type), POINTER :: DEPENDENT_BASIS,GEOMETRIC_BASIS
4248  TYPE(equations_type), POINTER :: EQUATIONS
4249  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
4250  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
4251  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
4252  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
4253  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
4254  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
4255  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
4256  TYPE(equations_matrices_source_type), POINTER :: SOURCE_VECTOR
4257  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
4258  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD
4259  TYPE(field_variable_type), POINTER :: DEPENDENT_VARIABLE,GEOMETRIC_VARIABLE
4260  TYPE(quadrature_scheme_type), POINTER :: QUADRATURE_SCHEME
4261  TYPE(varying_string) :: LOCAL_ERROR
4262 
4263  enters("Poisson_FiniteElementResidualEvaluate",err,error,*999)
4264 
4265  IF(ASSOCIATED(equations_set)) THEN
4266  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
4267  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
4268  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
4269  CALL flagerror("Equations set specification must have three entries for a Poisson type equations set.", &
4270  & err,error,*999)
4271  END IF
4272  equations=>equations_set%EQUATIONS
4273  IF(ASSOCIATED(equations)) THEN
4274  SELECT CASE(equations_set%SPECIFICATION(3))
4275  CASE(equations_set_constant_source_poisson_subtype)
4276  CALL flagerror("Can not evaluate a residual for a Poisson equation with a linear source.",err,error,*999)
4277  CASE(equations_set_linear_source_poisson_subtype)
4278  CALL flagerror("Can not evaluate a residual for a Poisson equation with a linear source.",err,error,*999)
4279  CASE(equations_set_extracellular_bidomain_poisson_subtype)
4280  CALL flagerror("Can not evaluate a residual for a Poisson equation with a linear source.",err,error,*999)
4281  CASE(equations_set_quadratic_source_poisson_subtype)
4282  !Store all these in equations matrices/somewhere else?????
4283  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
4284  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
4285  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
4286  equations_matrices=>equations%EQUATIONS_MATRICES
4287  linear_matrices=>equations_matrices%LINEAR_MATRICES
4288  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4289  equations_matrix=>linear_matrices%MATRICES(1)%PTR
4290  rhs_vector=>equations_matrices%RHS_VECTOR
4291  source_vector=>equations_matrices%SOURCE_VECTOR
4292  equations_mapping=>equations%EQUATIONS_MAPPING
4293  linear_mapping=>equations_mapping%LINEAR_MAPPING
4294  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
4295  dependent_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
4296  field_var_type=dependent_variable%VARIABLE_TYPE
4297  geometric_variable=>geometric_field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
4298  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
4299  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
4300  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
4301  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
4302  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
4303  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
4304  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
4305  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
4306  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
4307  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
4308  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
4309  !Loop over gauss points
4310  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
4311  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
4312  & dependent_interp_point(field_var_type)%PTR,err,error,*999)
4313  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
4314  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
4315  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
4316  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
4317  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
4318  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
4319  !Calculate RWG.
4320 !!TODO: Think about symmetric problems.
4321  wg=quadrature_scheme%GAUSS_WEIGHTS(ng)
4322  rwg=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN*wg
4323  !Loop over field components
4324  IF(equations_matrix%FIRST_ASSEMBLY) THEN
4325  IF(equations_matrix%UPDATE_MATRIX) THEN
4326  b_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR% &
4327  & values(geometric_variable%NUMBER_OF_COMPONENTS+2,no_part_deriv)
4328  mhs=0
4329  DO mh=1,dependent_variable%NUMBER_OF_COMPONENTS
4330  !Loop over element rows
4331  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
4332  mhs=mhs+1
4333  nhs=0
4334  !Loop over element columns
4335  DO nh=1,dependent_variable%NUMBER_OF_COMPONENTS
4336  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
4337  nhs=nhs+1
4338  sum1=0.0_dp
4339  DO nj=1,geometric_variable%NUMBER_OF_COMPONENTS
4340  pgmj(nj)=0.0_dp
4341  pgnj(nj)=0.0_dp
4342  DO ni=1,geometric_basis%NUMBER_OF_XI
4343  pgmj(nj)=pgmj(nj)+ &
4344  & quadrature_scheme%GAUSS_BASIS_FNS(ms,partial_derivative_first_derivative_map(ni),ng)* &
4345  & equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%DXI_DX(ni,nj)
4346  pgnj(nj)=pgnj(nj)+ &
4347  & quadrature_scheme%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(ni),ng)* &
4348  & equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%DXI_DX(ni,nj)
4349  ENDDO !ni
4350  k_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(nj,no_part_deriv)
4351  sum1=sum1+k_param*pgmj(nj)*pgnj(nj)
4352  ENDDO !nj
4353  sum2=b_param*quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)* &
4354  & quadrature_scheme%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)
4355  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+ &
4356  & (sum1+sum2)*rwg
4357  ENDDO !ns
4358  ENDDO !nh
4359  ENDDO !ms
4360  ENDDO !mh
4361  ENDIF
4362  ENDIF
4363  IF(rhs_vector%FIRST_ASSEMBLY) THEN
4364  IF(rhs_vector%UPDATE_VECTOR) THEN
4365  a_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR% &
4366  & values(geometric_variable%NUMBER_OF_COMPONENTS+1,no_part_deriv)
4367  mhs=0
4368  DO mh=1,dependent_variable%NUMBER_OF_COMPONENTS
4369  !Loop over element rows
4370  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
4371  mhs=mhs+1
4372  rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)+ &
4373  & quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)*a_param*rwg
4374  ENDDO !ms
4375  ENDDO !mh
4376  ENDIF
4377  ENDIF
4378  IF(nonlinear_matrices%UPDATE_RESIDUAL) THEN
4379  c_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR% &
4380  & values(geometric_variable%NUMBER_OF_COMPONENTS+3,no_part_deriv)
4381  u_value=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_u_variable_type)%PTR% &
4382  & values(1,no_part_deriv)
4383  mhs=0
4384  DO mh=1,dependent_variable%NUMBER_OF_COMPONENTS
4385  !Loop over element rows
4386  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
4387  mhs=mhs+1
4388  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)=nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)- &
4389  & quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)*c_param*u_value**2*rwg
4390  ENDDO !ms
4391  ENDDO !mh
4392  ENDIF
4393  ENDDO !ng
4394  CASE(equations_set_exponential_source_poisson_subtype)
4395  !Store all these in equations matrices/somewhere else?????
4396  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
4397  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
4398  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
4399  equations_matrices=>equations%EQUATIONS_MATRICES
4400  linear_matrices=>equations_matrices%LINEAR_MATRICES
4401  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4402  equations_matrix=>linear_matrices%MATRICES(1)%PTR
4403  rhs_vector=>equations_matrices%RHS_VECTOR
4404  source_vector=>equations_matrices%SOURCE_VECTOR
4405  equations_mapping=>equations%EQUATIONS_MAPPING
4406  linear_mapping=>equations_mapping%LINEAR_MAPPING
4407  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
4408  dependent_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
4409  field_var_type=dependent_variable%VARIABLE_TYPE
4410  geometric_variable=>geometric_field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
4411  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
4412  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
4413  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
4414  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
4415  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
4416  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
4417  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
4418  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
4419  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
4420  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
4421  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
4422  !Loop over gauss points
4423  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
4424  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
4425  & dependent_interp_point(field_var_type)%PTR,err,error,*999)
4426  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
4427  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
4428  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
4429  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
4430  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
4431  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
4432  !Calculate RWG.
4433 !!TODO: Think about symmetric problems.
4434  rwg=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
4435  & quadrature_scheme%GAUSS_WEIGHTS(ng)
4436  !Loop over field components
4437  IF(equations_matrix%FIRST_ASSEMBLY) THEN
4438  IF(equations_matrix%UPDATE_MATRIX) THEN
4439  mhs=0
4440  DO mh=1,dependent_variable%NUMBER_OF_COMPONENTS
4441  !Loop over element rows
4442  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
4443  mhs=mhs+1
4444  nhs=0
4445  !Loop over element columns
4446  DO nh=1,dependent_variable%NUMBER_OF_COMPONENTS
4447  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
4448  nhs=nhs+1
4449  sum1=0.0_dp
4450  DO nj=1,geometric_variable%NUMBER_OF_COMPONENTS
4451  pgmj(nj)=0.0_dp
4452  pgnj(nj)=0.0_dp
4453  DO ni=1,geometric_basis%NUMBER_OF_XI
4454  pgmj(nj)=pgmj(nj)+ &
4455  & quadrature_scheme%GAUSS_BASIS_FNS(ms,partial_derivative_first_derivative_map(ni),ng)* &
4456  & equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%DXI_DX(ni,nj)
4457  pgnj(nj)=pgnj(nj)+ &
4458  & quadrature_scheme%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(ni),ng)* &
4459  & equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%DXI_DX(ni,nj)
4460  ENDDO !ni
4461  k_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(nj,no_part_deriv)
4462  sum1=sum1+k_param*pgmj(nj)*pgnj(nj)
4463  ENDDO !nj
4464  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum1*rwg
4465  ENDDO !ns
4466  ENDDO !nh
4467  ENDDO !ms
4468  ENDDO !mh
4469  ENDIF
4470  ENDIF
4471  IF(rhs_vector%FIRST_ASSEMBLY) THEN
4472  IF(rhs_vector%UPDATE_VECTOR) THEN
4473  a_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR% &
4474  & values(geometric_variable%NUMBER_OF_COMPONENTS+1,no_part_deriv)
4475  mhs=0
4476  DO mh=1,dependent_variable%NUMBER_OF_COMPONENTS
4477  !Loop over element rows
4478  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
4479  mhs=mhs+1
4480  rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)+ &
4481  & quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)*a_param*rwg
4482  ENDDO !ms
4483  ENDDO !mh
4484  ENDIF
4485  ENDIF
4486  IF(nonlinear_matrices%UPDATE_RESIDUAL) THEN
4487  b_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR% &
4488  & values(geometric_variable%NUMBER_OF_COMPONENTS+2,no_part_deriv)
4489  c_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR% &
4490  & values(geometric_variable%NUMBER_OF_COMPONENTS+3,no_part_deriv)
4491  u_value=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_u_variable_type)%PTR% &
4492  & values(1,no_part_deriv)
4493 !!TODO: Handle floating point exceptions better
4494  IF((c_param*u_value)>20000.0_dp) THEN
4495  local_error="The value of "//trim(number_to_vstring(c_param*u_value,"*",err,error))// &
4496  & " is out of range for an exponential function."
4497  CALL flagerror(local_error,err,error,*999)
4498  ENDIF
4499  mhs=0
4500  DO mh=1,dependent_variable%NUMBER_OF_COMPONENTS
4501  !Loop over element rows
4502  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
4503  mhs=mhs+1
4504  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)=nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)- &
4505  & quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)*b_param*exp(c_param*u_value)*rwg
4506  ENDDO !ms
4507  ENDDO !mh
4508  ENDIF
4509  ENDDO !ng
4510  CASE DEFAULT
4511  local_error="Equations set subtype "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
4512  & " is not valid for a Poisson equation type of a classical field equations set class."
4513  CALL flagerror(local_error,err,error,*999)
4514  END SELECT
4515  ELSE
4516  CALL flagerror("Equations set equations is not associated.",err,error,*999)
4517  ENDIF
4518  ELSE
4519  CALL flagerror("Equations set is not associated.",err,error,*999)
4520  ENDIF
4521 
4522  exits("Poisson_FiniteElementResidualEvaluate")
4523  RETURN
4524 999 errors("Poisson_FiniteElementResidualEvaluate",err,error)
4525  exits("Poisson_FiniteElementResidualEvaluate")
4526  RETURN 1
4527 
4528  END SUBROUTINE poisson_finiteelementresidualevaluate
4529 
4530  !
4531  !================================================================================================================================
4532  !
4533 
4535  SUBROUTINE poisson_problemspecificationset(problem,problemSpecification,err,error,*)
4536 
4537  !Argument variables
4538  TYPE(problem_type), POINTER :: problem
4539  INTEGER(INTG), INTENT(IN) :: problemSpecification(:)
4540  INTEGER(INTG), INTENT(OUT) :: err
4541  TYPE(varying_string), INTENT(OUT) :: error
4542  !Local Variables
4543  TYPE(varying_string) :: localError
4544  INTEGER(INTG) :: problemSubtype
4545 
4546  enters("Poisson_ProblemSpecificationSet",err,error,*999)
4547 
4548  IF(ASSOCIATED(problem)) THEN
4549  IF(SIZE(problemspecification,1)==3) THEN
4550  problemsubtype=problemspecification(3)
4551  SELECT CASE(problemsubtype)
4552  CASE(problem_extracellular_bidomain_poisson_subtype, &
4553  & problem_linear_source_poisson_subtype, &
4554  & problem_nonlinear_source_poisson_subtype, &
4555  & problem_linear_pressure_poisson_subtype, &
4556  & problem_ale_pressure_poisson_subtype, &
4557  & problem_fitted_pressure_poisson_subtype, &
4558  & problem_nonlinear_pressure_poisson_subtype)
4559  !ok
4560  CASE DEFAULT
4561  localerror="The third problem specification of "//trim(numbertovstring(problemsubtype,"*",err,error))// &
4562  & " is not valid for a Poisson problem."
4563  CALL flagerror(localerror,err,error,*999)
4564  END SELECT
4565  IF(ALLOCATED(problem%specification)) THEN
4566  CALL flagerror("Problem specification is already allocated.",err,error,*999)
4567  ELSE
4568  ALLOCATE(problem%specification(3),stat=err)
4569  IF(err/=0) CALL flagerror("Could not allocate problem specification.",err,error,*999)
4570  END IF
4571  problem%specification(1:3)=[problem_classical_field_class,problem_poisson_equation_type,problemsubtype]
4572  ELSE
4573  CALL flagerror("Poisson problem specification must have three entries.",err,error,*999)
4574  END IF
4575  ELSE
4576  CALL flagerror("Problem is not associated.",err,error,*999)
4577  END IF
4578 
4579  exits("Poisson_ProblemSpecificationSet")
4580  RETURN
4581 999 errorsexits("Poisson_ProblemSpecificationSet",err,error)
4582  RETURN 1
4583 
4584  END SUBROUTINE poisson_problemspecificationset
4585 
4586  !
4587  !================================================================================================================================
4588  !
4589 
4591  SUBROUTINE poisson_problemextracellularbidomainsetup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
4592 
4593  !Argument variables
4594  TYPE(problem_type), POINTER :: PROBLEM
4595  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
4596  INTEGER(INTG), INTENT(OUT) :: ERR
4597  TYPE(varying_string), INTENT(OUT) :: ERROR
4598  !Local Variables
4599  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT
4600  TYPE(solver_type), POINTER :: SOLVER
4601  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
4602  TYPE(solvers_type), POINTER :: SOLVERS
4603  TYPE(varying_string) :: LOCAL_ERROR
4604 
4605  enters("Poisson_ProblemExtracellularBidomainSetup",err,error,*999)
4606 
4607  NULLIFY(control_loop)
4608  NULLIFY(solver)
4609  NULLIFY(solver_equations)
4610  NULLIFY(solvers)
4611  IF(ASSOCIATED(problem)) THEN
4612  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
4613  CALL flagerror("Problem specification is not allocated.",err,error,*999)
4614  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
4615  CALL flagerror("Problem specification must have three entries for a Poisson problem.",err,error,*999)
4616  END IF
4617  IF(problem%SPECIFICATION(3)==problem_extracellular_bidomain_poisson_subtype) THEN
4618  SELECT CASE(problem_setup%SETUP_TYPE)
4619  CASE(problem_setup_initial_type)
4620  SELECT CASE(problem_setup%ACTION_TYPE)
4621  CASE(problem_setup_start_action)
4622  !Do nothing????
4623  CASE(problem_setup_finish_action)
4624  !Do nothing????
4625  CASE DEFAULT
4626  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4627  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4628  & " is invalid for a extracellular bidomain Poisson equation."
4629  CALL flagerror(local_error,err,error,*999)
4630  END SELECT
4631  CASE(problem_setup_control_type)
4632  SELECT CASE(problem_setup%ACTION_TYPE)
4633  CASE(problem_setup_start_action)
4634  !Set up a simple control loop
4635  CALL control_loop_create_start(problem,control_loop,err,error,*999)
4636  CASE(problem_setup_finish_action)
4637  !Finish the control loops
4638  control_loop_root=>problem%CONTROL_LOOP
4639  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4640  CALL control_loop_create_finish(control_loop,err,error,*999)
4641  CASE DEFAULT
4642  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4643  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4644  & " is invalid for a extracellular bidomain Poisson equation."
4645  CALL flagerror(local_error,err,error,*999)
4646  END SELECT
4647  CASE(problem_setup_solvers_type)
4648  !Get the control loop
4649  control_loop_root=>problem%CONTROL_LOOP
4650  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4651  SELECT CASE(problem_setup%ACTION_TYPE)
4652  CASE(problem_setup_start_action)
4653  !Start the solvers creation
4654  CALL solvers_create_start(control_loop,solvers,err,error,*999)
4655  CALL solvers_number_set(solvers,1,err,error,*999)
4656  !Set the solver to be a linear solver
4657  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4658  !Start the linear solver creation
4659  CALL solver_type_set(solver,solver_linear_type,err,error,*999)
4660  !Set solver defaults
4661  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
4662  CASE(problem_setup_finish_action)
4663  !Get the solvers
4664  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
4665  !Finish the solvers creation
4666  CALL solvers_create_finish(solvers,err,error,*999)
4667  CASE DEFAULT
4668  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4669  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4670  & " is invalid for a extracellular bidomain Poisson equation."
4671  CALL flagerror(local_error,err,error,*999)
4672  END SELECT
4673  CASE(problem_setup_solver_equations_type)
4674  SELECT CASE(problem_setup%ACTION_TYPE)
4675  CASE(problem_setup_start_action)
4676  !Get the control loop
4677  control_loop_root=>problem%CONTROL_LOOP
4678  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4679  !Get the solver
4680  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
4681  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4682  !Create the solver equations
4683  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
4684  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
4685  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
4686  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
4687  CASE(problem_setup_finish_action)
4688  !Get the control loop
4689  control_loop_root=>problem%CONTROL_LOOP
4690  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4691  !Get the solver equations
4692  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
4693  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4694  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
4695  !Finish the solver equations creation
4696  CALL solver_equations_create_finish(solver_equations,err,error,*999)
4697  CASE DEFAULT
4698  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4699  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4700  & " is invalid for a extracellular bidomain Poisson equation."
4701  CALL flagerror(local_error,err,error,*999)
4702  END SELECT
4703  CASE DEFAULT
4704  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4705  & " is invalid for a extracellular bidomain Poisson equation."
4706  CALL flagerror(local_error,err,error,*999)
4707  END SELECT
4708  ELSE
4709  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
4710  & " does not equal a extracellular bidomain Poisson equation subtype."
4711  CALL flagerror(local_error,err,error,*999)
4712  ENDIF
4713  ELSE
4714  CALL flagerror("Problem is not associated.",err,error,*999)
4715  ENDIF
4716 
4717  exits("Poisson_ProblemExtracellularBidomainSetup")
4718  RETURN
4719 999 errors("Poisson_ProblemExtracellularBidomainSetup",err,error)
4720  exits("Poisson_ProblemExtracellularBidomainSetup")
4721  RETURN 1
4722 
4723  END SUBROUTINE poisson_problemextracellularbidomainsetup
4724 
4725  !
4726  !================================================================================================================================
4727  !
4728 
4730  SUBROUTINE poisson_problemlinearsourcesetup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
4731 
4732  !Argument variables
4733  TYPE(problem_type), POINTER :: PROBLEM
4734  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
4735  INTEGER(INTG), INTENT(OUT) :: ERR
4736  TYPE(varying_string), INTENT(OUT) :: ERROR
4737  !Local Variables
4738  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT
4739  TYPE(solver_type), POINTER :: SOLVER
4740  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
4741  TYPE(solvers_type), POINTER :: SOLVERS
4742  TYPE(varying_string) :: LOCAL_ERROR
4743 
4744  enters("Poisson_ProblemLinearSourceSetup",err,error,*999)
4745 
4746  NULLIFY(control_loop)
4747  NULLIFY(solver)
4748  NULLIFY(solver_equations)
4749  NULLIFY(solvers)
4750  IF(ASSOCIATED(problem)) THEN
4751  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
4752  CALL flagerror("Problem specification is not allocated.",err,error,*999)
4753  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
4754  CALL flagerror("Problem specification must have three entries for a Poisson problem.",err,error,*999)
4755  END IF
4756  IF(problem%SPECIFICATION(3)==problem_linear_source_poisson_subtype) THEN
4757  SELECT CASE(problem_setup%SETUP_TYPE)
4758  CASE(problem_setup_initial_type)
4759  SELECT CASE(problem_setup%ACTION_TYPE)
4760  CASE(problem_setup_start_action)
4761  !Do nothing????
4762  CASE(problem_setup_finish_action)
4763  !Do nothing????
4764  CASE DEFAULT
4765  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4766  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4767  & " is invalid for a linear source Poisson equation."
4768  CALL flagerror(local_error,err,error,*999)
4769  END SELECT
4770  CASE(problem_setup_control_type)
4771  SELECT CASE(problem_setup%ACTION_TYPE)
4772  CASE(problem_setup_start_action)
4773  !Set up a simple control loop
4774  CALL control_loop_create_start(problem,control_loop,err,error,*999)
4775  CASE(problem_setup_finish_action)
4776  !Finish the control loops
4777  control_loop_root=>problem%CONTROL_LOOP
4778  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4779  CALL control_loop_create_finish(control_loop,err,error,*999)
4780  CASE DEFAULT
4781  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4782  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4783  & " is invalid for a linear source Poisson equation."
4784  CALL flagerror(local_error,err,error,*999)
4785  END SELECT
4786  CASE(problem_setup_solvers_type)
4787  !Get the control loop
4788  control_loop_root=>problem%CONTROL_LOOP
4789  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4790  SELECT CASE(problem_setup%ACTION_TYPE)
4791  CASE(problem_setup_start_action)
4792  !Start the solvers creation
4793  CALL solvers_create_start(control_loop,solvers,err,error,*999)
4794  CALL solvers_number_set(solvers,1,err,error,*999)
4795  !Set the solver to be a linear solver
4796  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4797  !Start the linear solver creation
4798  CALL solver_type_set(solver,solver_linear_type,err,error,*999)
4799  !Set solver defaults
4800  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
4801  CASE(problem_setup_finish_action)
4802  !Get the solvers
4803  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
4804  !Finish the solvers creation
4805  CALL solvers_create_finish(solvers,err,error,*999)
4806  CASE DEFAULT
4807  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4808  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4809  & " is invalid for a linear source Poisson equation."
4810  CALL flagerror(local_error,err,error,*999)
4811  END SELECT
4812  CASE(problem_setup_solver_equations_type)
4813  SELECT CASE(problem_setup%ACTION_TYPE)
4814  CASE(problem_setup_start_action)
4815  !Get the control loop
4816  control_loop_root=>problem%CONTROL_LOOP
4817  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4818  !Get the solver
4819  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
4820  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4821  !Create the solver equations
4822  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
4823  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
4824  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
4825  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
4826  CASE(problem_setup_finish_action)
4827  !Get the control loop
4828  control_loop_root=>problem%CONTROL_LOOP
4829  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4830  !Get the solver equations
4831  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
4832  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4833  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
4834  !Finish the solver equations creation
4835  CALL solver_equations_create_finish(solver_equations,err,error,*999)
4836  CASE DEFAULT
4837  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4838  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4839  & " is invalid for a linear source Poisson equation."
4840  CALL flagerror(local_error,err,error,*999)
4841  END SELECT
4842  CASE DEFAULT
4843  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4844  & " is invalid for a linear source Poisson equation."
4845  CALL flagerror(local_error,err,error,*999)
4846  END SELECT
4847  ELSE
4848  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
4849  & " does not equal a linear source Poisson equation subtype."
4850  CALL flagerror(local_error,err,error,*999)
4851  ENDIF
4852  ELSE
4853  CALL flagerror("Problem is not associated.",err,error,*999)
4854  ENDIF
4855 
4856  exits("Poisson_ProblemLinearSourceSetup")
4857  RETURN
4858 999 errorsexits("Poisson_ProblemLinearSourceSetup",err,error)
4859  RETURN 1
4860 
4861  END SUBROUTINE poisson_problemlinearsourcesetup
4862 
4863 
4864  !
4865  !================================================================================================================================
4866  !
4867 
4869  SUBROUTINE poisson_problempressurepoissonsetup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
4870 
4871  !Argument variables
4872  TYPE(problem_type), POINTER :: PROBLEM
4873  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
4874  INTEGER(INTG), INTENT(OUT) :: ERR
4875  TYPE(varying_string), INTENT(OUT) :: ERROR
4876  !Local Variables
4877  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT,SUB_LOOP
4878  TYPE(solver_type), POINTER :: SOLVER,FITTING_SOLVER
4879  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS,FITTING_SOLVER_EQUATIONS
4880  TYPE(solvers_type), POINTER :: SOLVERS
4881  TYPE(varying_string) :: LOCAL_ERROR
4882 
4883  enters("Poisson_ProblemPressurePoissonSetup",err,error,*999)
4884 
4885  NULLIFY(control_loop)
4886  NULLIFY(solver)
4887  NULLIFY(fitting_solver)
4888  NULLIFY(solver_equations)
4889  NULLIFY(fitting_solver_equations)
4890  NULLIFY(solvers)
4891  IF(ASSOCIATED(problem)) THEN
4892  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
4893  CALL flagerror("Problem specification is not allocated.",err,error,*999)
4894  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
4895  CALL flagerror("Problem specification must have three entries for a Poisson problem.",err,error,*999)
4896  END IF
4897  IF(problem%SPECIFICATION(3)==problem_nonlinear_pressure_poisson_subtype.OR. &
4898  & problem%SPECIFICATION(3)==problem_linear_pressure_poisson_subtype.OR. &
4899  & problem%SPECIFICATION(3)==problem_ale_pressure_poisson_subtype) THEN
4900  SELECT CASE(problem_setup%SETUP_TYPE)
4901  CASE(problem_setup_initial_type)
4902  SELECT CASE(problem_setup%ACTION_TYPE)
4903  CASE(problem_setup_start_action)
4904  !Do nothing????
4905  CASE(problem_setup_finish_action)
4906  !Do nothing????
4907  CASE DEFAULT
4908  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4909  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4910  & " is invalid for a linear source Poisson equation."
4911  CALL flagerror(local_error,err,error,*999)
4912  END SELECT
4913  CASE(problem_setup_control_type)
4914  SELECT CASE(problem_setup%ACTION_TYPE)
4915  CASE(problem_setup_start_action)
4916  NULLIFY(control_loop_root)
4917  NULLIFY(sub_loop)
4918  !Set up a simple control loop with 2 subloops
4919  CALL control_loop_create_start(problem,control_loop,err,error,*999)
4920  CALL control_loop_type_set(control_loop,problem_control_time_loop_type,err,error,*999)
4921  CALL control_loop_number_of_sub_loops_set(control_loop,1,err,error,*999)
4922  CALL control_loop_sub_loop_get(control_loop,1,sub_loop,err,error,*999)
4923  CALL control_loop_type_set(sub_loop,problem_control_while_loop_type,err,error,*999)
4924  !Set the number of iterations for the while loop to 3 for now
4925 ! WRITE(*,*)'BE CAREFUL HERE ! MAKE IT MORE GENERAL'
4926  CALL control_loop_maximum_iterations_set(sub_loop,1,err,error,*999)
4927  CASE(problem_setup_finish_action)
4928  !Finish the control loops
4929  control_loop_root=>problem%CONTROL_LOOP
4930  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4931  CALL control_loop_create_finish(control_loop,err,error,*999)
4932  CASE DEFAULT
4933  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4934  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4935  & " is invalid for a linear source Poisson equation."
4936  CALL flagerror(local_error,err,error,*999)
4937  END SELECT
4938  CASE(problem_setup_solvers_type)
4939  !Get the control loop
4940  control_loop_root=>problem%CONTROL_LOOP
4941  NULLIFY(sub_loop)
4942  NULLIFY(control_loop)
4943  CALL control_loop_sub_loop_get(control_loop_root,1,sub_loop,err,error,*999)
4944  CALL control_loop_get(sub_loop,control_loop_node,control_loop,err,error,*999)
4945 
4946  SELECT CASE(problem_setup%ACTION_TYPE)
4947  CASE(problem_setup_start_action)
4948  !Start the solvers creation
4949  CALL solvers_create_start(control_loop,solvers,err,error,*999)
4950  CALL solvers_number_set(solvers,1,err,error,*999)
4951  !Set the solver to be a dynamic solver
4952  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4953  !Start the linear solver creation
4954  CALL solver_type_set(solver,solver_linear_type,err,error,*999)
4955  !Set solver defaults
4956  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
4957  CASE(problem_setup_finish_action)
4958  !Get the solvers
4959  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
4960  !Finish the solvers creation
4961  CALL solvers_create_finish(solvers,err,error,*999)
4962  CASE DEFAULT
4963  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4964  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4965  & " is invalid for a linear source Poisson equation."
4966  CALL flagerror(local_error,err,error,*999)
4967  END SELECT
4968  CASE(problem_setup_solver_equations_type)
4969  SELECT CASE(problem_setup%ACTION_TYPE)
4970  CASE(problem_setup_start_action)
4971  !Get the control loop
4972  control_loop_root=>problem%CONTROL_LOOP
4973  NULLIFY(sub_loop)
4974  NULLIFY(control_loop)
4975  CALL control_loop_sub_loop_get(control_loop_root,1,sub_loop,err,error,*999)
4976  CALL control_loop_get(sub_loop,control_loop_node,control_loop,err,error,*999)
4977  !Get the solver
4978  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
4979  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4980  !Create the solver equations
4981  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
4982  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
4983  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_quasistatic,err,error,*999)
4984  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
4985  CASE(problem_setup_finish_action)
4986  !Get the control loop
4987  control_loop_root=>problem%CONTROL_LOOP
4988  NULLIFY(sub_loop)
4989  NULLIFY(control_loop)
4990  CALL control_loop_sub_loop_get(control_loop_root,1,sub_loop,err,error,*999)
4991  CALL control_loop_get(sub_loop,control_loop_node,control_loop,err,error,*999)
4992  !Get the solver equations
4993  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
4994  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4995  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
4996  !Finish the solver equations creation
4997  CALL solver_equations_create_finish(solver_equations,err,error,*999)
4998  CASE DEFAULT
4999  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
5000  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
5001  & " is invalid for a linear source Poisson equation."
5002  CALL flagerror(local_error,err,error,*999)
5003  END SELECT
5004  CASE DEFAULT
5005  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
5006  & " is invalid for a linear source Poisson equation."
5007  CALL flagerror(local_error,err,error,*999)
5008  END SELECT
5009  ELSE IF(problem%SPECIFICATION(3)==problem_fitted_pressure_poisson_subtype) THEN
5010  SELECT CASE(problem_setup%SETUP_TYPE)
5011  CASE(problem_setup_initial_type)
5012  SELECT CASE(problem_setup%ACTION_TYPE)
5013  CASE(problem_setup_start_action)
5014  !Do nothing????
5015  CASE(problem_setup_finish_action)
5016  !Do nothing????
5017  CASE DEFAULT
5018  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
5019  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
5020  & " is invalid for a fitted PPE problem."
5021  CALL flagerror(local_error,err,error,*999)
5022  END SELECT
5023  CASE(problem_setup_control_type)
5024  SELECT CASE(problem_setup%ACTION_TYPE)
5025  CASE(problem_setup_start_action)
5026  !Set up a time control loop
5027  CALL control_loop_create_start(problem,control_loop,err,error,*999)
5028  CALL control_loop_type_set(control_loop,problem_control_time_loop_type,err,error,*999)
5029  CASE(problem_setup_finish_action)
5030  !Finish the control loops
5031  control_loop_root=>problem%CONTROL_LOOP
5032  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
5033  CALL control_loop_create_finish(control_loop,err,error,*999)
5034  CASE DEFAULT
5035  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
5036  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
5037  & " is invalid for a Pressure Poisson problem."
5038  CALL flagerror(local_error,err,error,*999)
5039  END SELECT
5040  CASE(problem_setup_solvers_type)
5041  !Get the control loop
5042  control_loop_root=>problem%CONTROL_LOOP
5043  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
5044  SELECT CASE(problem_setup%ACTION_TYPE)
5045  CASE(problem_setup_start_action)
5046  !Start the solvers creation
5047  CALL solvers_create_start(control_loop,solvers,err,error,*999)
5048  CALL solvers_number_set(solvers,2,err,error,*999)
5049  !Set the first solver to be a linear solver for the velocity field fitting
5050  CALL solvers_solver_get(solvers,1,fitting_solver,err,error,*999)
5051  CALL solver_type_set(fitting_solver,solver_linear_type,err,error,*999)
5052  !Set solver defaults
5053  CALL solver_library_type_set(fitting_solver,solver_petsc_library,err,error,*999)
5054  !Set the solver to be a quasi-static solvers
5055  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
5056  CALL solver_type_set(solver,solver_linear_type,err,error,*999)
5057  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
5058  CASE(problem_setup_finish_action)
5059  !Get the solvers
5060  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
5061  !Finish the solvers creation
5062  CALL solvers_create_finish(solvers,err,error,*999)
5063  CASE DEFAULT
5064  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
5065  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
5066  & " is invalid for a fitted PPE problem."
5067  CALL flagerror(local_error,err,error,*999)
5068  END SELECT
5069  CASE(problem_setup_solver_equations_type)
5070  SELECT CASE(problem_setup%ACTION_TYPE)
5071  CASE(problem_setup_start_action)
5072  !Get the control loop
5073  control_loop_root=>problem%CONTROL_LOOP
5074  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
5075  !Get the solver
5076  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
5077  CALL solvers_solver_get(solvers,1,fitting_solver,err,error,*999)
5078  !Create the solver equations
5079  CALL solver_equations_create_start(fitting_solver,fitting_solver_equations,err,error,*999)
5080  CALL solver_equations_linearity_type_set(fitting_solver_equations,solver_equations_linear,err,error,*999)
5081  CALL solver_equations_time_dependence_type_set(fitting_solver_equations,solver_equations_static,err,error,*999)
5082  CALL solver_equations_sparsity_type_set(fitting_solver_equations,solver_sparse_matrices,err,error,*999)
5083  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
5084  !Create the solver equations
5085  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
5086  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
5087  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_quasistatic,err,error,*999)
5088  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
5089  CASE(problem_setup_finish_action)
5090  !Get the control loop
5091  control_loop_root=>problem%CONTROL_LOOP
5092  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
5093  !Get the solver equations
5094  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
5095  CALL solvers_solver_get(solvers,1,fitting_solver,err,error,*999)
5096  CALL solver_solver_equations_get(fitting_solver,fitting_solver_equations,err,error,*999)
5097  !Finish the solver equations creation
5098  CALL solver_equations_create_finish(fitting_solver_equations,err,error,*999)
5099  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
5100  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
5101  !Finish the solver equations creation
5102  CALL solver_equations_create_finish(solver_equations,err,error,*999)
5103  CASE DEFAULT
5104  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
5105  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
5106  & " is invalid for a fitted PPE problem."
5107  CALL flagerror(local_error,err,error,*999)
5108  END SELECT
5109  CASE DEFAULT
5110  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
5111  & " is invalid for a fitted PPE problem."
5112  CALL flagerror(local_error,err,error,*999)
5113  END SELECT
5114  ELSE
5115  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
5116  & " does not equal a linear source Poisson equation subtype."
5117  CALL flagerror(local_error,err,error,*999)
5118  ENDIF
5119  ELSE
5120  CALL flagerror("Problem is not associated.",err,error,*999)
5121  ENDIF
5122 
5123  exits("Poisson_ProblemPressurePoissonSetup")
5124  RETURN
5125 999 errorsexits("Poisson_ProblemPressurePoissonSetup",err,error)
5126  RETURN 1
5127 
5128  END SUBROUTINE poisson_problempressurepoissonsetup
5129 
5130 
5131  !
5132  !================================================================================================================================
5133  !
5134 
5136  SUBROUTINE poisson_problemnonlinearsourcesetup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
5137 
5138  !Argument variables
5139  TYPE(problem_type), POINTER :: PROBLEM
5140  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
5141  INTEGER(INTG), INTENT(OUT) :: ERR
5142  TYPE(varying_string), INTENT(OUT) :: ERROR
5143  !Local Variables
5144  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT
5145  TYPE(solver_type), POINTER :: SOLVER
5146  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
5147  TYPE(solvers_type), POINTER :: SOLVERS
5148  TYPE(varying_string) :: LOCAL_ERROR
5149 
5150  enters("Poisson_ProblemNonlinearSourceSetup",err,error,*999)
5151 
5152  NULLIFY(control_loop)
5153  NULLIFY(solver)
5154  NULLIFY(solver_equations)
5155  NULLIFY(solvers)
5156  IF(ASSOCIATED(problem)) THEN
5157  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
5158  CALL flagerror("Problem specification is not allocated.",err,error,*999)
5159  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
5160  CALL flagerror("Problem specification must have three entries for a Poisson problem.",err,error,*999)
5161  END IF
5162  IF(problem%SPECIFICATION(3)==problem_nonlinear_source_poisson_subtype) THEN
5163  SELECT CASE(problem_setup%SETUP_TYPE)
5164  CASE(problem_setup_initial_type)
5165  SELECT CASE(problem_setup%ACTION_TYPE)
5166  CASE(problem_setup_start_action)
5167  !Do nothing
5168  CASE(problem_setup_finish_action)
5169  !Do nothing
5170  CASE DEFAULT
5171  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
5172  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
5173  & " is invalid for a nonlinear source Poisson equation."
5174  CALL flagerror(local_error,err,error,*999)
5175  END SELECT
5176  CASE(problem_setup_control_type)
5177  SELECT CASE(problem_setup%ACTION_TYPE)
5178  CASE(problem_setup_start_action)
5179  !Set up a simple control loop
5180  CALL control_loop_create_start(problem,control_loop,err,error,*999)
5181  CASE(problem_setup_finish_action)
5182  !Finish the control loops
5183  control_loop_root=>problem%CONTROL_LOOP
5184  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
5185  CALL control_loop_create_finish(control_loop,err,error,*999)
5186  CASE DEFAULT
5187  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
5188  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
5189  & " is invalid for a nonlinear source Poisson equation."
5190  CALL flagerror(local_error,err,error,*999)
5191  END SELECT
5192  CASE(problem_setup_solvers_type)
5193  !Get the control loop
5194  control_loop_root=>problem%CONTROL_LOOP
5195  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
5196  SELECT CASE(problem_setup%ACTION_TYPE)
5197  CASE(problem_setup_start_action)
5198  !Start the solvers creation
5199  CALL solvers_create_start(control_loop,solvers,err,error,*999)
5200  CALL solvers_number_set(solvers,1,err,error,*999)
5201  !Set the solver to be nonlinear solver
5202  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
5203  CALL solver_type_set(solver,solver_nonlinear_type,err,error,*999)
5204  !Set solver defaults
5205  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
5206  CASE(problem_setup_finish_action)
5207  !Get the solvers
5208  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
5209  !Finish the solvers creation
5210  CALL solvers_create_finish(solvers,err,error,*999)
5211  CASE DEFAULT
5212  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
5213  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
5214  & " is invalid for a nonlinear source Poisson equation."
5215  CALL flagerror(local_error,err,error,*999)
5216  END SELECT
5217  CASE(problem_setup_solver_equations_type)
5218  SELECT CASE(problem_setup%ACTION_TYPE)
5219  CASE(problem_setup_start_action)
5220  !Get the control loop
5221  control_loop_root=>problem%CONTROL_LOOP
5222  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
5223  !Get the solver
5224  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
5225  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
5226  !Create the solver equations
5227  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
5228  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
5229  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
5230  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
5231  CASE(problem_setup_finish_action)
5232  !Get the control loop
5233  control_loop_root=>problem%CONTROL_LOOP
5234  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
5235  !Get the solver equations
5236  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
5237  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
5238  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
5239  !Finish the solver equations creation
5240  CALL solver_equations_create_finish(solver_equations,err,error,*999)
5241  CASE DEFAULT
5242  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
5243  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
5244  & " is invalid for a nonlinear source Poisson equation."
5245  CALL flagerror(local_error,err,error,*999)
5246  END SELECT
5247  CASE DEFAULT
5248  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
5249  & " is invalid for a nonlinear source Poisson equation."
5250  CALL flagerror(local_error,err,error,*999)
5251  END SELECT
5252  ELSE
5253  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
5254  & " does not equal a nonlinear source Poisson equation subtype."
5255  CALL flagerror(local_error,err,error,*999)
5256  ENDIF
5257  ELSE
5258  CALL flagerror("Problem is not associated.",err,error,*999)
5259  ENDIF
5260 
5261  exits("Poisson_ProblemNonlinearSourceSetup")
5262  RETURN
5263 999 errorsexits("Poisson_ProblemNonlinearSourceSetup",err,error)
5264  RETURN 1
5265 
5266  END SUBROUTINE poisson_problemnonlinearsourcesetup
5267 
5268  !
5269  !================================================================================================================================
5270  !
5271 
5273  SUBROUTINE poisson_post_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
5274 
5275  !Argument variables
5276  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
5277  TYPE(solver_type), POINTER :: SOLVER
5278  INTEGER(INTG), INTENT(OUT) :: ERR
5279  TYPE(varying_string), INTENT(OUT) :: ERROR
5280  !Local Variables
5281  TYPE(solver_type), POINTER :: SOLVER2
5282  TYPE(varying_string) :: LOCAL_ERROR
5283 
5284  enters("POISSON_POST_SOLVE",err,error,*999)
5285  NULLIFY(solver2)
5286  IF(ASSOCIATED(control_loop)) THEN
5287  IF(ASSOCIATED(solver)) THEN
5288  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
5289  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
5290  CALL flagerror("Problem specification is not allocated.",err,error,*999)
5291  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
5292  CALL flagerror("Problem specification must have three entries for a Poisson problem.",err,error,*999)
5293  END IF
5294  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
5295  CASE(problem_extracellular_bidomain_poisson_subtype)
5296  ! do nothing
5297  CASE(problem_linear_source_poisson_subtype)
5298  ! do nothing
5299  CASE(problem_nonlinear_source_poisson_subtype)
5300  ! do nothing
5301  CASE(problem_linear_pressure_poisson_subtype,problem_nonlinear_pressure_poisson_subtype, &
5302  & problem_ale_pressure_poisson_subtype)
5303  CALL poisson_post_solve_output_data(control_loop,solver,err,error,*999)
5304  CASE(problem_fitted_pressure_poisson_subtype)
5305  !Post solve for the linear solver
5306  IF(solver%GLOBAL_NUMBER==1) THEN
5307  !do nothing for fitting problems
5308  CALL write_string(general_output_type,"Transferring fitting results to PPE... ",err,error,*999)
5309  ELSE IF (solver%GLOBAL_NUMBER==2) THEN
5310  CALL write_string(general_output_type,"PPE post solve... ",err,error,*999)
5311  CALL poisson_post_solve_output_data(control_loop,solver,err,error,*999)
5312  ENDIF
5313  CASE DEFAULT
5314  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
5315  & " is not valid for a Poisson type of a classical field problem class."
5316  CALL flagerror(local_error,err,error,*999)
5317  END SELECT
5318  ELSE
5319  CALL flagerror("Problem is not associated.",err,error,*999)
5320  ENDIF
5321  ELSE
5322  CALL flagerror("Solver is not associated.",err,error,*999)
5323  ENDIF
5324  ELSE
5325  CALL flagerror("Control loop is not associated.",err,error,*999)
5326  ENDIF
5327 
5328  exits("POISSON_POST_SOLVE")
5329  RETURN
5330 999 errorsexits("POISSON_POST_SOLVE",err,error)
5331  RETURN 1
5332  END SUBROUTINE poisson_post_solve
5333 
5334  !
5335  !================================================================================================================================
5336  !
5337 
5338 
5340  SUBROUTINE poisson_pre_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
5341 
5342  !Argument variables
5343  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
5344  TYPE(solver_type), POINTER :: SOLVER
5345  INTEGER(INTG), INTENT(OUT) :: ERR
5346  TYPE(varying_string), INTENT(OUT) :: ERROR
5347  !Local Variables
5348  TYPE(solver_type), POINTER :: SOLVER2
5349  TYPE(varying_string) :: LOCAL_ERROR
5350  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
5351  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
5352  TYPE(equations_type), POINTER :: EQUATIONS
5353  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
5354 
5355  enters("POISSON_PRE_SOLVE",err,error,*999)
5356  NULLIFY(solver2)
5357 
5358  IF(ASSOCIATED(control_loop)) THEN
5359  IF(ASSOCIATED(solver)) THEN
5360  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
5361  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
5362  CALL flagerror("Problem specification is not allocated.",err,error,*999)
5363  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
5364  CALL flagerror("Problem specification must have three entries for a Poisson problem.",err,error,*999)
5365  END IF
5366  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
5367  CASE(problem_extracellular_bidomain_poisson_subtype)
5368  ! do nothing
5369  CASE(problem_linear_source_poisson_subtype)
5370  ! do nothing
5371  CASE(problem_nonlinear_source_poisson_subtype)
5372  ! do nothing
5373  CASE(problem_linear_pressure_poisson_subtype,problem_nonlinear_pressure_poisson_subtype)
5374  IF(control_loop%WHILE_LOOP%ITERATION_NUMBER==1)THEN
5375  solver_equations=>solver%SOLVER_EQUATIONS
5376  IF(ASSOCIATED(solver_equations)) THEN
5377  solver_mapping=>solver_equations%SOLVER_MAPPING
5378  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
5379  IF(ASSOCIATED(equations)) THEN
5380  equations_set=>equations%EQUATIONS_SET
5381  IF(ASSOCIATED(equations_set)) THEN
5382  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
5383  IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_pressure_poisson_three_dim_2) THEN
5384  !do nothing
5385  ELSE
5386  CALL write_string(general_output_type,"Read in vector data... ",err,error,*999)
5387  !Update indpendent data fields
5388  CALL poisson_pre_solve_update_input_data(control_loop,solver,err,error,*999)
5389  CALL write_string(general_output_type,"While loop... ",err,error,*999)
5390  ENDIF
5391  ELSE
5392  CALL write_string(general_output_type,"Read in vector data... ",err,error,*999)
5393  !Update indpendent data fields
5394  CALL poisson_pre_solve_update_input_data(control_loop,solver,err,error,*999)
5395  CALL write_string(general_output_type,"While loop... ",err,error,*999)
5396  ENDIF
5397  ENDIF
5398  ENDIF
5399  ENDIF
5400  ELSE
5401  CALL write_string(general_output_type,"While loop... ",err,error,*999)
5402  ENDIF
5403  CASE(problem_fitted_pressure_poisson_subtype)
5404  !Pre solve for the linear solver: fitting problem
5405  IF(solver%GLOBAL_NUMBER==1) THEN
5406  CALL write_string(general_output_type,"Read in vector data... ",err,error,*999)
5407  !Update independent data fields
5408  CALL poisson_pre_solve_update_input_data(control_loop,solver,err,error,*999)
5409  CALL write_string(general_output_type,"Solving fitting problem... ",err,error,*999)
5410  ELSE IF(solver%GLOBAL_NUMBER==2) THEN
5411  CALL write_string(general_output_type,"Update source field ... ",err,error,*999)
5412  !First update source field for PPE calculation
5413  CALL poisson_pre_solve_update_ppe_source(control_loop,solver,err,error,*999)
5414  !Read in the lable information
5415 ! CALL POISSON_PRE_SOLVE_UPDATE_INPUT_DATA(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
5416  CALL write_string(general_output_type,"Solving PPE problem... ",err,error,*999)
5417  ELSE
5418  CALL flagerror("Solver global number not associated for PPE problem.",err,error,*999)
5419  ENDIF
5420  CASE(problem_ale_pressure_poisson_subtype)
5421  IF(control_loop%WHILE_LOOP%ITERATION_NUMBER==1)THEN
5422  solver_equations=>solver%SOLVER_EQUATIONS
5423  IF(ASSOCIATED(solver_equations)) THEN
5424  solver_mapping=>solver_equations%SOLVER_MAPPING
5425  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
5426  IF(ASSOCIATED(equations)) THEN
5427  equations_set=>equations%EQUATIONS_SET
5428  IF(ASSOCIATED(equations_set)) THEN
5429  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
5430  IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_pressure_poisson_three_dim_2) THEN
5431  !do nothing
5432  ELSE
5433  CALL write_string(general_output_type,"Read in vector data... ",err,error,*999)
5434  !Update indpendent data fields
5435  CALL poisson_pre_solve_update_input_data(control_loop,solver,err,error,*999)
5436  CALL write_string(general_output_type,"While loop... ",err,error,*999)
5437  ENDIF
5438  ELSE
5439  CALL write_string(general_output_type,"Read in vector data... ",err,error,*999)
5440  !Update indpendent data fields
5441  CALL poisson_pre_solve_update_input_data(control_loop,solver,err,error,*999)
5442  CALL write_string(general_output_type,"While loop... ",err,error,*999)
5443  ENDIF
5444  ENDIF
5445  ENDIF
5446  ENDIF
5447  !Update mesh
5448  CALL poisson_pre_solve_update_ppe_mesh(control_loop,solver,err,error,*999)
5449  ENDIF
5450  CASE DEFAULT
5451  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
5452  & " is not valid for a Poisson type of a classical field problem class."
5453  CALL flagerror(local_error,err,error,*999)
5454  END SELECT
5455  ELSE
5456  CALL flagerror("Problem is not associated.",err,error,*999)
5457  ENDIF
5458  ELSE
5459  CALL flagerror("Solver is not associated.",err,error,*999)
5460  ENDIF
5461  ELSE
5462  CALL flagerror("Control loop is not associated.",err,error,*999)
5463  ENDIF
5464 
5465  exits("POISSON_PRE_SOLVE")
5466  RETURN
5467 999 errorsexits("POISSON_PRE_SOLVE",err,error)
5468  RETURN 1
5469  END SUBROUTINE poisson_pre_solve
5470  !
5471  !================================================================================================================================
5472  !
5473 
5474 
5476  SUBROUTINE poisson_pre_solve_update_input_data(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
5477 
5478  !Argument variables
5479  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
5480  TYPE(solver_type), POINTER :: SOLVER
5481  INTEGER(INTG), INTENT(OUT) :: ERR
5482  TYPE(varying_string), INTENT(OUT) :: ERROR
5483  !Local Variables
5484  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
5485  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
5486  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
5487  TYPE(equations_type), POINTER :: EQUATIONS
5488  TYPE(varying_string) :: LOCAL_ERROR
5489 
5490  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT
5491 
5492  INTEGER(INTG) :: NUMBER_OF_DIMENSIONS,CURRENT_LOOP_ITERATION
5493  INTEGER(INTG) :: INPUT_TYPE,INPUT_OPTION
5494  REAL(DP), POINTER :: INPUT_VEL_NEW_DATA(:),INPUT_VEL_OLD_DATA(:)
5495  REAL(DP), POINTER :: INPUT_VEL_LABEL_DATA(:),INPUT_VEL_U_DATA(:),INPUT_VEL_V_DATA(:),INPUT_VEL_W_DATA(:)
5496  TYPE(control_loop_type), POINTER :: CONTROL_TIME_LOOP
5497 
5498  LOGICAL :: BOUNDARY_UPDATE
5499 
5500  boundary_update=.false.
5501 
5502  enters("POISSON_PRE_SOLVE_UPDATE_INPUT_DATA",err,error,*999)
5503 
5504  IF(ASSOCIATED(control_loop)) THEN
5505  IF(ASSOCIATED(solver)) THEN
5506  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
5507  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
5508  CALL flagerror("Problem specification is not allocated.",err,error,*999)
5509  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
5510  CALL flagerror("Problem specification must have three entries for a Poisson problem.",err,error,*999)
5511  END IF
5512  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
5513  CASE(problem_extracellular_bidomain_poisson_subtype)
5514  ! do nothing
5515  CASE(problem_linear_source_poisson_subtype)
5516  ! do nothing
5517  CASE(problem_nonlinear_source_poisson_subtype)
5518  ! do nothing
5519  CASE(problem_fitted_pressure_poisson_subtype)
5520  IF(solver%GLOBAL_NUMBER==1) THEN
5521  !only read in data if it is the fitting problem
5522  control_time_loop=>control_loop
5523  CALL control_loop_current_times_get(control_time_loop,current_time,time_increment,err,error,*999)
5524  solver_equations=>solver%SOLVER_EQUATIONS
5525  IF(ASSOCIATED(solver_equations)) THEN
5526  solver_mapping=>solver_equations%SOLVER_MAPPING
5527  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
5528  IF(ASSOCIATED(equations)) THEN
5529  equations_set=>equations%EQUATIONS_SET
5530  IF(ASSOCIATED(equations_set)) THEN
5531  !Set pressure field to zero
5532  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
5533  & number_of_dimensions,err,error,*999)
5534  current_loop_iteration=control_time_loop%TIME_LOOP%ITERATION_NUMBER
5535  !this is the current time step
5536  !\todo: Provide possibility for user to define input type and option (that's more or less an IO question)
5537  input_type=1
5538  input_option=1
5539  CALL field_parameter_set_data_get(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
5540  & field_values_set_type,input_vel_new_data,err,error,*999)
5541  CALL fluid_mechanics_io_read_data(solver_linear_type,input_vel_new_data, &
5542  & number_of_dimensions,input_type,input_option,control_time_loop%TIME_LOOP%ITERATION_NUMBER,1.0_dp)
5543  ELSE
5544  CALL flagerror("Equations set is not associated.",err,error,*999)
5545  END IF
5546  ELSE
5547  CALL flagerror("Equations are not associated.",err,error,*999)
5548  END IF
5549  ELSE
5550  CALL flagerror("Solver equations are not associated.",err,error,*999)
5551  END IF
5552  ELSE IF(solver%GLOBAL_NUMBER==2) THEN
5553  !this is the interior flag
5554  control_time_loop=>control_loop
5555  CALL control_loop_current_times_get(control_time_loop,current_time,time_increment,err,error,*999)
5556  solver_equations=>solver%SOLVER_EQUATIONS
5557  IF(ASSOCIATED(solver_equations)) THEN
5558  solver_mapping=>solver_equations%SOLVER_MAPPING
5559  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
5560  IF(ASSOCIATED(equations)) THEN
5561  equations_set=>equations%EQUATIONS_SET
5562  IF(ASSOCIATED(equations_set)) THEN
5563  !Set pressure field to zero
5564  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
5565  & number_of_dimensions,err,error,*999)
5566  current_loop_iteration=control_time_loop%TIME_LOOP%ITERATION_NUMBER
5567  !this is the current time step
5568  !\todo: Provide possibility for user to define input type and option (that's more or less an IO question)
5569  input_type=1
5570  input_option=3
5571  CALL field_parameter_set_data_get(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
5572  & field_input_label_set_type,input_vel_label_data,err,error,*999)
5573  CALL fluid_mechanics_io_read_data(solver_linear_type,input_vel_label_data, &
5574  & number_of_dimensions,input_type,input_option,control_time_loop%TIME_LOOP%ITERATION_NUMBER,1.0_dp)
5575  !this is the reference U velocity
5576  input_type=1
5577  input_option=4
5578  CALL field_parameter_set_data_get(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
5579  & field_input_vel1_set_type,input_vel_u_data,err,error,*999)
5580  CALL fluid_mechanics_io_read_data(solver_linear_type,input_vel_u_data, &
5581  & number_of_dimensions,input_type,input_option,control_time_loop%TIME_LOOP%ITERATION_NUMBER,1.0_dp)
5582  !this is the reference V velocity
5583  input_type=1
5584  input_option=5
5585  CALL field_parameter_set_data_get(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
5586  & field_input_vel2_set_type,input_vel_v_data,err,error,*999)
5587  CALL fluid_mechanics_io_read_data(solver_linear_type,input_vel_v_data, &
5588  & number_of_dimensions,input_type,input_option,control_time_loop%TIME_LOOP%ITERATION_NUMBER,1.0_dp)
5589  !this is the reference W velocity
5590  input_type=1
5591  input_option=6
5592  CALL field_parameter_set_data_get(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
5593  & field_input_vel3_set_type,input_vel_w_data,err,error,*999)
5594  CALL fluid_mechanics_io_read_data(solver_linear_type,input_vel_w_data, &
5595  & number_of_dimensions,input_type,input_option,control_time_loop%TIME_LOOP%ITERATION_NUMBER,1.0_dp)
5596  ENDIF
5597  ENDIF
5598  ENDIF
5599  ENDIF
5600  CASE(problem_linear_pressure_poisson_subtype,problem_nonlinear_pressure_poisson_subtype, &
5601  & problem_ale_pressure_poisson_subtype)
5602  control_time_loop=>control_loop%PARENT_LOOP
5603  CALL control_loop_current_times_get(control_time_loop,current_time,time_increment,err,error,*999)
5604  CALL write_string(general_output_type,"Read input data... ",err,error,*999)
5605  solver_equations=>solver%SOLVER_EQUATIONS
5606  IF(ASSOCIATED(solver_equations)) THEN
5607  solver_mapping=>solver_equations%SOLVER_MAPPING
5608  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
5609  IF(ASSOCIATED(equations)) THEN
5610  equations_set=>equations%EQUATIONS_SET
5611  IF(ASSOCIATED(equations_set)) THEN
5612  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
5613  & number_of_dimensions,err,error,*999)
5614  current_loop_iteration=control_time_loop%TIME_LOOP%ITERATION_NUMBER
5615  !this is the current time step
5616  !\todo: Provide possibility for user to define input type and option (that's more or less an IO question)
5617  input_type=1
5618  input_option=1
5619  CALL field_parameter_set_data_get(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
5620  & field_input_data1_set_type,input_vel_new_data,err,error,*999)
5621  CALL fluid_mechanics_io_read_data(solver_linear_type,input_vel_new_data, &
5622  & number_of_dimensions,input_type,input_option,control_time_loop%TIME_LOOP%ITERATION_NUMBER,1.0_dp)
5623  !this is the previous time step
5624  !\todo: Provide possibility for user to define input type and option (that's more or less an IO question)
5625  input_type=1
5626  input_option=2
5627  CALL field_parameter_set_data_get(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
5628  & field_input_data2_set_type,input_vel_old_data,err,error,*999)
5629  CALL fluid_mechanics_io_read_data(solver_linear_type,input_vel_old_data, &
5630  & number_of_dimensions,input_type,input_option,control_time_loop%TIME_LOOP%ITERATION_NUMBER,1.0_dp)
5631  !this is the interior flag
5632  input_type=1
5633  input_option=3
5634  CALL field_parameter_set_data_get(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
5635  & field_input_label_set_type,input_vel_label_data,err,error,*999)
5636  CALL fluid_mechanics_io_read_data(solver_linear_type,input_vel_label_data, &
5637  & number_of_dimensions,input_type,input_option,control_time_loop%TIME_LOOP%ITERATION_NUMBER,1.0_dp)
5638  !this is the reference U velocity
5639  input_type=1
5640  input_option=4
5641  CALL field_parameter_set_data_get(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
5642  & field_input_vel1_set_type,input_vel_u_data,err,error,*999)
5643  CALL fluid_mechanics_io_read_data(solver_linear_type,input_vel_u_data, &
5644  & number_of_dimensions,input_type,input_option,control_time_loop%TIME_LOOP%ITERATION_NUMBER,1.0_dp)
5645  !this is the reference V velocity
5646  input_type=1
5647  input_option=5
5648  CALL field_parameter_set_data_get(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
5649  & field_input_vel2_set_type,input_vel_v_data,err,error,*999)
5650  CALL fluid_mechanics_io_read_data(solver_linear_type,input_vel_v_data, &
5651  & number_of_dimensions,input_type,input_option,control_time_loop%TIME_LOOP%ITERATION_NUMBER,1.0_dp)
5652  !this is the reference W velocity
5653  input_type=1
5654  input_option=6
5655  CALL field_parameter_set_data_get(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
5656  & field_input_vel3_set_type,input_vel_w_data,err,error,*999)
5657  CALL fluid_mechanics_io_read_data(solver_linear_type,input_vel_w_data, &
5658  & number_of_dimensions,input_type,input_option,control_time_loop%TIME_LOOP%ITERATION_NUMBER,1.0_dp)
5659  ELSE
5660  CALL flagerror("Equations set is not associated.",err,error,*999)
5661  END IF
5662  ELSE
5663  CALL flagerror("Equations are not associated.",err,error,*999)
5664  END IF
5665  ELSE
5666  CALL flagerror("Solver equations are not associated.",err,error,*999)
5667  END IF
5668  CASE DEFAULT
5669  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
5670  & " is not valid for a Poisson type of a classical field problem class."
5671  CALL flagerror(local_error,err,error,*999)
5672  END SELECT
5673  CALL field_parameter_set_update_start(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
5674  & field_input_data1_set_type,err,error,*999)
5675  CALL field_parameter_set_update_finish(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
5676  & field_input_data1_set_type,err,error,*999)
5677  CALL field_parameter_set_update_start(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
5678  & field_input_data2_set_type,err,error,*999)
5679  CALL field_parameter_set_update_finish(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
5680  & field_input_data2_set_type,err,error,*999)
5681  ELSE
5682  CALL flagerror("Problem is not associated.",err,error,*999)
5683  ENDIF
5684  ELSE
5685  CALL flagerror("Solver is not associated.",err,error,*999)
5686  ENDIF
5687  ELSE
5688  CALL flagerror("Control loop is not associated.",err,error,*999)
5689  ENDIF
5690 
5691  exits("POISSON_PRE_SOLVE_UPDATE_INPUT_DATA")
5692  RETURN
5693 999 errorsexits("POISSON_PRE_SOLVE_UPDATE_INPUT_DATA",err,error)
5694  RETURN 1
5695  END SUBROUTINE poisson_pre_solve_update_input_data
5696 
5697  !
5698  !================================================================================================================================
5699  !
5700 
5702  SUBROUTINE poisson_post_solve_output_data(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
5703 
5704  !Argument variables
5705  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
5706  TYPE(solver_type), POINTER :: SOLVER
5707  INTEGER(INTG), INTENT(OUT) :: ERR
5708  TYPE(varying_string), INTENT(OUT) :: ERROR
5709  !Local Variables
5710  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
5711  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
5712  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
5713  TYPE(varying_string) :: LOCAL_ERROR
5714  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT
5715  INTEGER(INTG) :: EQUATIONS_SET_IDX,CURRENT_LOOP_ITERATION,OUTPUT_ITERATION_NUMBER
5716  TYPE(control_loop_type), POINTER :: CONTROL_TIME_LOOP
5717  LOGICAL :: EXPORT_FIELD
5718  TYPE(varying_string) :: METHOD!,FILE
5719  CHARACTER(14) :: FILE
5720  CHARACTER(14) :: OUTPUT_FILE
5721 
5722  enters("POISSON_POST_SOLVE_OUTPUT_DATA",err,error,*999)
5723 
5724  IF(ASSOCIATED(control_loop)) THEN
5725 ! write(*,*)'CURRENT_TIME = ',CURRENT_TIME
5726 ! write(*,*)'TIME_INCREMENT = ',TIME_INCREMENT
5727  IF(ASSOCIATED(solver)) THEN
5728  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
5729  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
5730  CALL flagerror("Problem specification is not allocated.",err,error,*999)
5731  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
5732  CALL flagerror("Problem specification must have three entries for a Poisson problem.",err,error,*999)
5733  END IF
5734  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
5735  CASE(problem_extracellular_bidomain_poisson_subtype)
5736 ! do nothing
5737  CASE(problem_linear_source_poisson_subtype)
5738 ! do nothing
5739  CASE(problem_nonlinear_source_poisson_subtype)
5740 ! do nothing
5741  CASE(problem_linear_pressure_poisson_subtype,problem_nonlinear_pressure_poisson_subtype, &
5742  & problem_ale_pressure_poisson_subtype)
5743  IF(control_loop%WHILE_LOOP%ITERATION_NUMBER==control_loop%WHILE_LOOP%MAXIMUM_NUMBER_OF_ITERATIONS)THEN
5744  control_time_loop=>control_loop%PARENT_LOOP
5745  CALL control_loop_current_times_get(control_time_loop,current_time,time_increment,err,error,*999)
5746  solver_equations=>solver%SOLVER_EQUATIONS
5747  IF(ASSOCIATED(solver_equations)) THEN
5748  solver_mapping=>solver_equations%SOLVER_MAPPING
5749  IF(ASSOCIATED(solver_mapping)) THEN
5750  !Make sure the equations sets are up to date
5751  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
5752  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
5753  current_loop_iteration=control_time_loop%TIME_LOOP%ITERATION_NUMBER
5754  output_iteration_number=control_time_loop%TIME_LOOP%OUTPUT_NUMBER
5755  IF(output_iteration_number/=0) THEN
5756  IF(control_time_loop%TIME_LOOP%CURRENT_TIME<=control_time_loop%TIME_LOOP%STOP_TIME) THEN
5757  IF(current_loop_iteration<10) THEN
5758  WRITE(output_file,'("TIME_STEP_000",I0)') current_loop_iteration
5759  ELSE IF(current_loop_iteration<100) THEN
5760  WRITE(output_file,'("TIME_STEP_00",I0)') current_loop_iteration
5761  ELSE IF(current_loop_iteration<1000) THEN
5762  WRITE(output_file,'("TIME_STEP_0",I0)') current_loop_iteration
5763  ELSE IF(current_loop_iteration<10000) THEN
5764  WRITE(output_file,'("TIME_STEP_",I0)') current_loop_iteration
5765  END IF
5766  file=output_file
5767  ! FILE="TRANSIENT_OUTPUT"
5768  method="FORTRAN"
5769  export_field=.true.
5770  IF(export_field) THEN
5771  IF(mod(current_loop_iteration,output_iteration_number)==0) THEN
5772  CALL write_string(general_output_type,"...",err,error,*999)
5773  CALL write_string(general_output_type,"Now export fields... ",err,error,*999)
5774  CALL fluid_mechanics_io_write_encas_block(equations_set%REGION,equations_set%GLOBAL_NUMBER, &
5775  & output_file,err,error,*999)
5776  CALL write_string(general_output_type,output_file,err,error,*999)
5777  CALL write_string(general_output_type,"...",err,error,*999)
5778  ENDIF
5779  ENDIF
5780  ENDIF
5781  ENDIF
5782  ENDDO
5783  ENDIF
5784  ENDIF
5785  ENDIF
5786  CASE(problem_fitted_pressure_poisson_subtype)
5787  control_time_loop=>control_loop
5788  CALL control_loop_current_times_get(control_time_loop,current_time,time_increment,err,error,*999)
5789  solver_equations=>solver%SOLVER_EQUATIONS
5790  IF(ASSOCIATED(solver_equations)) THEN
5791  solver_mapping=>solver_equations%SOLVER_MAPPING
5792  IF(ASSOCIATED(solver_mapping)) THEN
5793  !Make sure the equations sets are up to date
5794  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
5795  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
5796  current_loop_iteration=control_time_loop%TIME_LOOP%ITERATION_NUMBER
5797  output_iteration_number=control_time_loop%TIME_LOOP%OUTPUT_NUMBER
5798  IF(output_iteration_number/=0) THEN
5799  IF(control_time_loop%TIME_LOOP%CURRENT_TIME<=control_time_loop%TIME_LOOP%STOP_TIME) THEN
5800  IF(current_loop_iteration<10) THEN
5801  WRITE(output_file,'("TIME_STEP_000",I0)') current_loop_iteration
5802  ELSE IF(current_loop_iteration<100) THEN
5803  WRITE(output_file,'("TIME_STEP_00",I0)') current_loop_iteration
5804  ELSE IF(current_loop_iteration<1000) THEN
5805  WRITE(output_file,'("TIME_STEP_0",I0)') current_loop_iteration
5806  ELSE IF(current_loop_iteration<10000) THEN
5807  WRITE(output_file,'("TIME_STEP_",I0)') current_loop_iteration
5808  END IF
5809  file=output_file
5810 ! FILE="TRANSIENT_OUTPUT"
5811  method="FORTRAN"
5812  export_field=.true.
5813  IF(export_field) THEN
5814  IF(mod(current_loop_iteration,output_iteration_number)==0) THEN
5815  CALL write_string(general_output_type,"...",err,error,*999)
5816  CALL write_string(general_output_type,"Now export fields... ",err,error,*999)
5817  CALL fluid_mechanics_io_write_encas_block(equations_set%REGION,equations_set%GLOBAL_NUMBER, &
5818  & output_file,err,error,*999)
5819  CALL write_string(general_output_type,output_file,err,error,*999)
5820  CALL write_string(general_output_type,"...",err,error,*999)
5821  ENDIF
5822  ENDIF
5823  ENDIF
5824  ENDIF
5825  ENDDO
5826  ENDIF
5827  ENDIF
5828  CASE DEFAULT
5829  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
5830  & " is not valid for a Poisson equation fluid type of a fluid mechanics problem class."
5831  CALL flagerror(local_error,err,error,*999)
5832  END SELECT
5833  ELSE
5834  CALL flagerror("Problem is not associated.",err,error,*999)
5835  ENDIF
5836  ELSE
5837  CALL flagerror("Solver is not associated.",err,error,*999)
5838  ENDIF
5839  ELSE
5840  CALL flagerror("Control loop is not associated.",err,error,*999)
5841  ENDIF
5842  exits("POISSON_POST_SOLVE_OUTPUT_DATA")
5843  RETURN
5844 999 errorsexits("POISSON_POST_SOLVE_OUTPUT_DATA",err,error)
5845  RETURN 1
5846  END SUBROUTINE poisson_post_solve_output_data
5847 
5848  !
5849  !================================================================================================================================
5850  !
5851 
5852 END MODULE poisson_equations_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
types::boundary_conditions_type
Contains information on the boundary conditions for the solver equations.
Definition: types.f90:1780
base_routines::enters
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Definition: base_routines.f90:363
solver_routines::solvers_create_finish
subroutine, public solvers_create_finish(SOLVERS, ERR, ERROR,)
Finish the creation of solvers.
Definition: solver_routines.f90:22598
kinds::ptr
integer, parameter ptr
Pointer integer kind.
Definition: kinds.f90:58
constants::second_part_deriv
integer(intg), parameter second_part_deriv
Second partial derivative i.e., d^2u/ds^2.
Definition: constants.f90:179
coordinate_routines
This module contains all coordinate transformation and support routines.
Definition: coordinate_routines.f90:45
types::equations_jacobian_type
Contains information on the Jacobian matrix for nonlinear problems.
Definition: types.f90:1451
types::equations_mapping_type
Contains information on the equations mapping i.e., how field variable DOFS are mapped to the rows an...
Definition: types.f90:1681
types::equations_type
Contains information about the equations in an equations set.
Definition: types.f90:1735
equations_set_constants::equations_set_gfem_solution_method
integer(intg), parameter equations_set_gfem_solution_method
Grid-based Finite Element Method solution method.
Definition: equations_set_constants.f90:352
problem_constants::problem_control_time_loop_type
integer(intg), parameter problem_control_time_loop_type
Time control loop.
Definition: problem_constants.f90:283
equations_set_constants::equations_set_poisson_equation_three_dim_2
integer(intg), parameter equations_set_poisson_equation_three_dim_2
u=tbd
Definition: equations_set_constants.f90:446
problem_constants::problem_setup_control_type
integer(intg), parameter problem_setup_control_type
Solver setup for a problem.
Definition: problem_constants.f90:263
equations_set_constants::equations_set_quadratic_source_poisson_subtype
integer(intg), parameter equations_set_quadratic_source_poisson_subtype
Definition: equations_set_constants.f90:223
problem_constants
This module handles all problem wide constants.
Definition: problem_constants.f90:45
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
equations_set_constants::equations_set_ale_pressure_poisson_subtype
integer(intg), parameter equations_set_ale_pressure_poisson_subtype
Definition: equations_set_constants.f90:227
constants::no_global_deriv
integer(intg), parameter no_global_deriv
No global derivative i.e., u.
Definition: constants.f90:213
poisson_equations_routines::poisson_pre_solve_update_ppe_mesh
subroutine poisson_pre_solve_update_ppe_mesh(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Update mesh velocity and move mesh for ALE PPE problem.
Definition: Poisson_equations_routines.f90:1312
control_loop_routines::control_loop_maximum_iterations_set
subroutine, public control_loop_maximum_iterations_set(CONTROL_LOOP, MAXIMUM_ITERATIONS, ERR, ERROR,)
Sets the maximum number of iterations for a while or load increment control loop. ...
Definition: control_loop_routines.f90:782
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
poisson_equations_routines::poisson_equationssetsolutionmethodset
subroutine, public poisson_equationssetsolutionmethodset(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for a Poisson equation type of an classical field equations set clas...
Definition: Poisson_equations_routines.f90:436
problem_constants::problem_fitted_pressure_poisson_subtype
integer(intg), parameter problem_fitted_pressure_poisson_subtype
Definition: problem_constants.f90:185
fluid_mechanics_io_routines::fluid_mechanics_io_write_encas_block
subroutine, public fluid_mechanics_io_write_encas_block(REGION, EQUATIONS_SET_GLOBAL_NUMBER, NAME, ERR, ERROR,)
Writes solution into encas — BUT FOR PRESSURE POISSON ONLY — not for general use! ...
Definition: fluid_mechanics_IO_routines.f90:1765
control_loop_routines::control_loop_sub_loop_get
subroutine, public control_loop_sub_loop_get(CONTROL_LOOP, SUB_LOOP_INDEX, SUB_LOOP, ERR, ERROR,)
Gets/returns a pointer to the sub loops as specified by the sub loop index for a control loop...
Definition: control_loop_routines.f90:1417
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::pi
real(dp), parameter pi
The double precision value of pi.
Definition: constants.f90:57
constants::no_part_deriv
integer(intg), parameter no_part_deriv
No partial derivative i.e., u.
Definition: constants.f90:177
poisson_equations_routines::poisson_problempressurepoissonsetup
subroutine poisson_problempressurepoissonsetup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the Pressure Poisson equations problem.
Definition: Poisson_equations_routines.f90:4870
equations_matrices_routines
This module handles all equations matrix and rhs routines.
Definition: equations_matrices_routines.f90:45
solver_routines::solver_type_set
subroutine, public solver_type_set(SOLVER, SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type for a solver.
Definition: solver_routines.f90:21345
equations_set_constants::equations_set_linear_source_poisson_subtype
integer(intg), parameter equations_set_linear_source_poisson_subtype
Definition: equations_set_constants.f90:222
equations_set_constants::equations_static
integer(intg), parameter equations_static
The equations are static and have no time dependence.
Definition: equations_set_constants.f90:376
types::equations_set_type
Contains information on an equations set.
Definition: types.f90:1941
equations_routines
This module handles all equations routines.
Definition: equations_routines.f90:45
equations_set_constants::equations_set_setup_source_type
integer(intg), parameter equations_set_setup_source_type
Source setup.
Definition: equations_set_constants.f90:327
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
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
types::solvers_type
Contains information on the solvers to be used in a control loop.
Definition: types.f90:2805
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
types::equations_matrices_source_type
Contains information of the source vector for equations matrices.
Definition: types.f90:1510
poisson_equations_routines::poisson_problemlinearsourcesetup
subroutine poisson_problemlinearsourcesetup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the linear source Poisson equations problem.
Definition: Poisson_equations_routines.f90:4731
problem_constants::solver_equations_static
integer(intg), parameter solver_equations_static
Solver equations are static.
Definition: problem_constants.f90:309
constants::part_deriv_s2
integer(intg), parameter part_deriv_s2
First partial derivative in the s2 direction i.e., du/ds2.
Definition: constants.f90:183
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
poisson_equations_routines::poisson_pre_solve
subroutine, public poisson_pre_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the Poisson problem pre solve.
Definition: Poisson_equations_routines.f90:5341
equations_set_constants::equations_set_poisson_equation_type
integer(intg), parameter equations_set_poisson_equation_type
Definition: equations_set_constants.f90:85
maths
This module contains all mathematics support routines.
Definition: maths.f90:45
solver_routines::solvers_solver_get
subroutine, public solvers_solver_get(SOLVERS, SOLVER_INDEX, SOLVER, ERR, ERROR,)
Returns a pointer to the specified solver in the list of solvers.
Definition: solver_routines.f90:22876
types::field_type
Contains information for a field defined on a region.
Definition: types.f90:1346
equations_matrices_routines::equations_matrices_full_matrices
integer(intg), parameter, public equations_matrices_full_matrices
Use fully populated equation matrices.
Definition: equations_matrices_routines.f90:91
equations_set_constants::equations_set_linear_pressure_poisson_subtype
integer(intg), parameter equations_set_linear_pressure_poisson_subtype
Definition: equations_set_constants.f90:225
equations_mapping_routines::equations_mapping_rhs_variable_type_set
subroutine, public equations_mapping_rhs_variable_type_set(EQUATIONS_MAPPING, RHS_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set rhs vector.
Definition: equations_mapping_routines.f90:3170
problem_constants::solver_equations_linear
integer(intg), parameter solver_equations_linear
Solver equations are linear.
Definition: problem_constants.f90:301
constants::global_deriv_s2
integer(intg), parameter global_deriv_s2
First global derivative in the s2 direction i.e., du/ds2.
Definition: constants.f90:215
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
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
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
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
problem_constants::solver_equations_nonlinear
integer(intg), parameter solver_equations_nonlinear
Solver equations are nonlinear.
Definition: problem_constants.f90:302
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
constants::part_deriv_s1
integer(intg), parameter part_deriv_s1
First partial derivative in the s1 direction i.e., du/ds1.
Definition: constants.f90:181
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
poisson_equations_routines::poisson_equationssetspecificationset
subroutine, public poisson_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for a Poisson equation type of a classical field equations set class...
Definition: Poisson_equations_routines.f90:569
poisson_equations_routines::poisson_equationssetlinearsourcesetup
subroutine poisson_equationssetlinearsourcesetup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the standard Poisson equation for linear sources.
Definition: Poisson_equations_routines.f90:1626
problem_constants::problem_extracellular_bidomain_poisson_subtype
integer(intg), parameter problem_extracellular_bidomain_poisson_subtype
Definition: problem_constants.f90:186
problem_constants::problem_setup_initial_type
integer(intg), parameter problem_setup_initial_type
Initial setup for a problem.
Definition: problem_constants.f90:262
types::field_interpolated_point_metrics_type
Contains the interpolated point coordinate metrics. Old CMISS name GL,GU,RG.
Definition: types.f90:1112
equations_set_constants::equations_set_constant_source_poisson_subtype
integer(intg), parameter equations_set_constant_source_poisson_subtype
Definition: equations_set_constants.f90:221
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
problem_constants::problem_linear_source_poisson_subtype
integer(intg), parameter problem_linear_source_poisson_subtype
Definition: problem_constants.f90:180
types::problem_setup_type
Definition: types.f90:3215
poisson_equations_routines::poisson_problemspecificationset
subroutine, public poisson_problemspecificationset(problem, problemSpecification, err, error,)
Sets the problem specification for a Poisson equation type.
Definition: Poisson_equations_routines.f90:4536
fluid_mechanics_io_routines::fluid_mechanics_io_read_data
subroutine, public fluid_mechanics_io_read_data(SOLVER_TYPE, INPUT_VALUES, NUMBER_OF_DIMENSIONS, INPUT_TYPE, INPUT_OPTION, TIME_STEP, LENGTH_SCALE)
Reads input data from a file.
Definition: fluid_mechanics_IO_routines.f90:4319
problem_constants::problem_linear_pressure_poisson_subtype
integer(intg), parameter problem_linear_pressure_poisson_subtype
Definition: problem_constants.f90:182
problem_constants::problem_ale_pressure_poisson_subtype
integer(intg), parameter problem_ale_pressure_poisson_subtype
Definition: problem_constants.f90:184
poisson_equations_routines
This module handles all Poisson equations routines.
Definition: Poisson_equations_routines.f90:45
problem_constants::solver_equations_quasistatic
integer(intg), parameter solver_equations_quasistatic
Solver equations are quasistatic.
Definition: problem_constants.f90:310
coordinate_routines::coordinates_materialsystemcalculate
subroutine, public coordinates_materialsystemcalculate(geometricInterpPointMetrics, fibreInterpPoint, dNudX, dXdNu, dNudXi, dXidNu, err, error,)
Calculates the tensor to get from material coordinate system, nu, to local coordinate system...
Definition: coordinate_routines.f90:3885
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
problem_constants::problem_classical_field_class
integer(intg), parameter problem_classical_field_class
Definition: problem_constants.f90:58
equations_matrices_routines::equationsmatrices_nonlinearstoragetypeset
Sets the storage type (sparsity) of the nonlinear (Jacobian) equations matrices.
Definition: equations_matrices_routines.f90:199
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
control_loop_routines::control_loop_solvers_get
recursive subroutine, public control_loop_solvers_get(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Returns a pointer to the solvers for a control loop.
Definition: control_loop_routines.f90:1333
equations_set_constants::equations_set_exponential_source_poisson_subtype
integer(intg), parameter equations_set_exponential_source_poisson_subtype
Definition: equations_set_constants.f90:224
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
types::equations_mapping_nonlinear_type
Contains information on the equations mapping for nonlinear matrices i.e., how a field variable is ma...
Definition: types.f90:1623
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
constants::part_deriv_s3
integer(intg), parameter part_deriv_s3
First partial derivative in the s3 direction i.e., du/ds3.
Definition: constants.f90:186
input_output::write_string
Write a string to a given output stream.
Definition: input_output.f90:74
base_routines
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
Definition: base_routines.f90:45
types::equations_matrices_linear_type
Contains information of the linear matrices for equations matrices.
Definition: types.f90:1479
base_routines::general_output_type
integer(intg), parameter, public general_output_type
General output type.
Definition: base_routines.f90:66
constants::part_deriv_s1_s1
integer(intg), parameter part_deriv_s1_s1
Second partial derivative in the s1 direction i.e., d^2u/ds1ds1.
Definition: constants.f90:182
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
equations_set_constants::equations_set_poisson_equation_three_dim_3
integer(intg), parameter equations_set_poisson_equation_three_dim_3
u=tbd
Definition: equations_set_constants.f90:447
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
poisson_equations_routines::poisson_equation_problem_setup
subroutine, public poisson_equation_problem_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the Poisson problem.
Definition: Poisson_equations_routines.f90:3232
poisson_equations_routines::poisson_post_solve
subroutine, public poisson_post_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the Poisson problem post solve.
Definition: Poisson_equations_routines.f90:5274
constants::part_deriv_s2_s3
integer(intg), parameter part_deriv_s2_s3
Cross derivative in the s2 and s3 direction i.e., d^2u/ds2ds3.
Definition: constants.f90:189
poisson_equations_routines::poisson_equation_equations_set_setup
subroutine, public poisson_equation_equations_set_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the Poisson equation type of a classical field equations set class.
Definition: Poisson_equations_routines.f90:383
solver_routines::solver_nonlinear_type
integer(intg), parameter, public solver_nonlinear_type
A nonlinear solver.
Definition: solver_routines.f90:89
equations_mapping_routines::equations_mapping_source_variable_type_set
subroutine, public equations_mapping_source_variable_type_set(EQUATIONS_MAPPING, SOURCE_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a source field variable and the equations set source vector.
Definition: equations_mapping_routines.f90:3378
equations_matrices_routines::equations_jacobian_analytic_calculated
integer(intg), parameter, public equations_jacobian_analytic_calculated
Use an analytic Jacobian evaluation.
Definition: equations_matrices_routines.f90:116
poisson_equations_routines::poisson_equation_finite_element_calculate
subroutine, public poisson_equation_finite_element_calculate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element stiffness matrices and RHS for a Poisson equation finite element equations set...
Definition: Poisson_equations_routines.f90:3280
constants::part_deriv_s1_s3
integer(intg), parameter part_deriv_s1_s3
Cross derivative in the s1 and s3 direction i.e., d^2u/ds1ds3.
Definition: constants.f90:188
equations_routines::equations_set_equations_get
subroutine, public equations_set_equations_get(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Gets the equations for an equations set.
Definition: equations_routines.f90:897
types::equations_set_materials_type
Definition: types.f90:1881
equations_matrices_routines::equationsmatrices_nonlinearstructuretypeset
Sets the structure (sparsity) of the nonlinear (Jacobian) equations matrices.
Definition: equations_matrices_routines.f90:205
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
poisson_equations_routines::poisson_equationssetpressurepoissonsetup
subroutine poisson_equationssetpressurepoissonsetup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the standard Poisson equation for Pressure Poisson Equation (PPE).
Definition: Poisson_equations_routines.f90:629
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_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
poisson_equations_routines::poisson_problemextracellularbidomainsetup
subroutine poisson_problemextracellularbidomainsetup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the linear source Poisson equations problem.
Definition: Poisson_equations_routines.f90:4592
equations_set_constants::equations_set_fitted_pressure_poisson_subtype
integer(intg), parameter equations_set_fitted_pressure_poisson_subtype
Definition: equations_set_constants.f90:228
equations_set_constants::equations_set_setup_geometry_type
integer(intg), parameter equations_set_setup_geometry_type
Geometry setup.
Definition: equations_set_constants.f90:323
constants::global_deriv_s1_s2
integer(intg), parameter global_deriv_s1_s2
Global Cross derivative in the s1 and s2 direction i.e., d^2u/ds1ds2.
Definition: constants.f90:216
types::problem_type
Contains information for a problem.
Definition: types.f90:3221
problem_constants::problem_nonlinear_pressure_poisson_subtype
integer(intg), parameter problem_nonlinear_pressure_poisson_subtype
Definition: problem_constants.f90:183
equations_set_constants::equations_set_classical_field_class
integer(intg), parameter equations_set_classical_field_class
Definition: equations_set_constants.f90:57
equations_set_constants::equations_linear
integer(intg), parameter equations_linear
The equations are linear.
Definition: equations_set_constants.f90:365
types::domain_nodes_type
Contains the topology information for the nodes of a domain.
Definition: types.f90:713
equations_set_constants::equations_set_poisson_equation_two_dim_1
integer(intg), parameter equations_set_poisson_equation_two_dim_1
u=ln(4/(x+y+1^2))
Definition: equations_set_constants.f90:442
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
equations_set_constants::equations_set_extracellular_bidomain_poisson_subtype
integer(intg), parameter equations_set_extracellular_bidomain_poisson_subtype
Definition: equations_set_constants.f90:229
distributed_matrix_vector
This module handles all distributed matrix vector routines.
Definition: distributed_matrix_vector.f90:45
constants::global_deriv_s1
integer(intg), parameter global_deriv_s1
First global derivative in the s1 direction i.e., du/ds1.
Definition: constants.f90:214
boundary_conditions_routines
This module handles all boundary conditions routines.
Definition: boundary_condition_routines.f90:45
solver_routines
This module handles all solver routines.
Definition: solver_routines.f90:45
equations_mapping_routines::equations_mapping_create_start
subroutine, public equations_mapping_create_start(EQUATIONS, EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping for a equations set equations.
Definition: equations_mapping_routines.f90:1112
types::field_interpolated_point_type
Contains the interpolated value (and the derivatives wrt xi) of a field at a point. Old CMISS name XG.
Definition: types.f90:1129
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
matrix_vector
This module contains all routines dealing with (non-distributed) matrix and vectors types...
Definition: matrix_vector.f90:129
problem_constants::problem_poisson_equation_type
integer(intg), parameter problem_poisson_equation_type
Definition: problem_constants.f90:85
equations_set_constants::equations_set_poisson_equation_two_dim_2
integer(intg), parameter equations_set_poisson_equation_two_dim_2
u=tbd
Definition: equations_set_constants.f90:443
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
boundary_conditions_routines::boundary_conditions_set_local_dof
Sets a boundary condition on the specified local DOF.
Definition: boundary_condition_routines.f90:143
types::solver_mapping_type
Contains information on the solver mapping between the global equation sets and the solver matrices...
Definition: types.f90:3091
constants::part_deriv_s1_s2
integer(intg), parameter part_deriv_s1_s2
Cross derivative in the s1 and s2 direction i.e., d^2u/ds1ds2.
Definition: constants.f90:185
constants::part_deriv_s2_s2
integer(intg), parameter part_deriv_s2_s2
Second partial derivative in the s2 direction i.e., d^2u/ds2ds2.
Definition: constants.f90:184
problem_constants::problem_nonlinear_source_poisson_subtype
integer(intg), parameter problem_nonlinear_source_poisson_subtype
Definition: problem_constants.f90:181
types::field_variable_type
Contains information for a field variable defined on a field.
Definition: types.f90:1289
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
poisson_equations_routines::poisson_pre_solve_update_input_data
subroutine poisson_pre_solve_update_input_data(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Update boundary conditions for Poisson pre solve.
Definition: Poisson_equations_routines.f90:5477
equations_set_constants::equations_set_poisson_equation_three_dim_1
integer(intg), parameter equations_set_poisson_equation_three_dim_1
u=ln(6/(x+y+z+1^2))
Definition: equations_set_constants.f90:445
constants::part_deriv_s3_s3
integer(intg), parameter part_deriv_s3_s3
Second partial derivative in the s3 direction i.e., d^2u/ds3ds3.
Definition: constants.f90:187
types::equations_set_setup_type
Contains information on the setup information for an equations set.
Definition: types.f90:1866
types::domain_type
A pointer to the domain decomposition for this domain.
Definition: types.f90:938
problem_constants::problem_setup_start_action
integer(intg), parameter problem_setup_start_action
Start setup action.
Definition: problem_constants.f90:273
types::equations_matrices_nonlinear_type
Contains information of the nolinear matrices and vectors for equations matrices. ...
Definition: types.f90:1486
poisson_equations_routines::poisson_post_solve_output_data
subroutine poisson_post_solve_output_data(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Output data post solve.
Definition: Poisson_equations_routines.f90:5703
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
poisson_equations_routines::poisson_finiteelementjacobianevaluate
subroutine, public poisson_finiteelementjacobianevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the Jacobian element stiffness matrices and RHS for a Poisson equation finite element equat...
Definition: Poisson_equations_routines.f90:4047
maths::matrix_product
Calculates and returns the matrix-product A*B in the matrix C.
Definition: maths.f90:167
equations_matrices_routines::equationsmatrices_jacobiantypesset
subroutine, public equationsmatrices_jacobiantypesset(equationsMatrices, jacobianTypes, err, error,)
Sets the Jacobian calculation types of the residual variables.
Definition: equations_matrices_routines.f90:3283
boundary_conditions_routines::boundary_condition_fixed
integer(intg), parameter, public boundary_condition_fixed
The dof is fixed as a boundary condition.
Definition: boundary_condition_routines.f90:95
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_nonlinear_pressure_poisson_subtype
integer(intg), parameter equations_set_nonlinear_pressure_poisson_subtype
Definition: equations_set_constants.f90:226
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
equations_set_constants::equations_set_pressure_poisson_three_dim_2
integer(intg), parameter equations_set_pressure_poisson_three_dim_2
u=tbd, Pressure Poisson Equation (PPE) without input data
Definition: equations_set_constants.f90:449
poisson_equations_routines::poisson_equationssetnonlinearsourcesetup
subroutine poisson_equationssetnonlinearsourcesetup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the standard Poisson equation for nonlinear sources.
Definition: Poisson_equations_routines.f90:2762
poisson_equations_routines::poisson_finiteelementresidualevaluate
subroutine, public poisson_finiteelementresidualevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the residual element stiffness matrices and RHS for a Poisson equation finite element equat...
Definition: Poisson_equations_routines.f90:4238
poisson_equations_routines::poisson_pre_solve_update_ppe_source
subroutine poisson_pre_solve_update_ppe_source(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Update source for fitted PPE problem.
Definition: Poisson_equations_routines.f90:1472
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
poisson_equations_routines::poisson_problemnonlinearsourcesetup
subroutine poisson_problemnonlinearsourcesetup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the nonlinear source Poisson equations problem.
Definition: Poisson_equations_routines.f90:5137
poisson_equations_routines::poisson_equationssetextracellularbidomainsetup
subroutine poisson_equationssetextracellularbidomainsetup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the extracellular Bidomain equation.
Definition: Poisson_equations_routines.f90:2191
control_loop_routines::control_loop_number_of_sub_loops_set
subroutine, public control_loop_number_of_sub_loops_set(CONTROL_LOOP, NUMBER_OF_SUB_LOOPS, ERR, ERROR,)
Sets/changes the number of sub loops in a control loop.
Definition: control_loop_routines.f90:1073
equations_set_constants::equations_quasistatic
integer(intg), parameter equations_quasistatic
The equations are quasi-static.
Definition: equations_set_constants.f90:377
equations_set_constants::equations_set_setup_analytic_type
integer(intg), parameter equations_set_setup_analytic_type
Analytic setup.
Definition: equations_set_constants.f90:329
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
equations_set_constants::equations_set_poisson_equation_two_dim_3
integer(intg), parameter equations_set_poisson_equation_two_dim_3
u=tbd
Definition: equations_set_constants.f90:444
poisson_equations_routines::poisson_boundaryconditionsanalyticcalculate
subroutine, public poisson_boundaryconditionsanalyticcalculate(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Calculates the analytic solution and sets the boundary conditions for an analytic problem...
Definition: Poisson_equations_routines.f90:114
equations_set_constants::equations_set_pressure_poisson_three_dim_1
integer(intg), parameter equations_set_pressure_poisson_three_dim_1
u=tbd, Pressure Poisson Equation (PPE) analytic
Definition: equations_set_constants.f90:448
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
equations_set_constants::equations_nonlinear
integer(intg), parameter equations_nonlinear
The equations are non-linear.
Definition: equations_set_constants.f90:366
types::equations_mapping_linear_type
Contains information for mapping field variables to the linear matrices in the equations set of the m...
Definition: types.f90:1587
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
fluid_mechanics_io_routines
Temporary IO routines for fluid mechanics.
Definition: fluid_mechanics_IO_routines.f90:47
equations_set_constants::equations_set_setup_finish_action
integer(intg), parameter equations_set_setup_finish_action
Finish setup action.
Definition: equations_set_constants.f90:339
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45