OpenCMISS-Iron Internal API Documentation
multi_compartment_transport_routines.f90
Go to the documentation of this file.
1 
43 
45 
46 
47 MODULE multi_compartment_transport_routines
48 
49  USE advection_diffusion_equation_routines
50  USE base_routines
51  USE basis_routines
52  USE boundary_conditions_routines
53  USE constants
54  USE control_loop_routines
55  USE coordinate_routines
56  USE diffusion_equation_routines
57  USE distributed_matrix_vector
58  USE domain_mappings
59  USE equations_routines
60  USE equations_mapping_routines
61  USE equations_matrices_routines
62  USE equations_set_constants
63  USE field_routines
64 ! USE FINITE_ELASTICITY_ROUTINES
65  USE fluid_mechanics_io_routines
66 ! USE FITTING_ROUTINES !also in makefiles
67  USE input_output
68  USE iso_varying_string
69  USE kinds
70  USE maths
71  USE matrix_vector
72  USE mesh_routines
73  USE node_routines
74  USE problem_constants
75  USE strings
76  USE solver_routines
77  USE timer
78  USE types
79 
80 #include "macros.h"
81 
82 
83  IMPLICIT NONE
84 
85  PUBLIC multicompartmenttransport_equationssetsetup
86  PUBLIC multicompartmenttransport_equationssetsolutionmethodset
87 
88  PUBLIC multi_compartment_transport_problem_setup
89  PUBLIC multicompartmenttransport_problemspecificationset
90 
91  PUBLIC multicompartmenttransport_finiteelementcalculate
92 
93  PUBLIC multi_compartment_transport_pre_solve
94  PUBLIC multi_compartment_transport_post_solve
95 
96 
97 CONTAINS
98 
99  !
100  !================================================================================================================================
101  !
102 
104  SUBROUTINE multicompartmenttransport_equationssetsolutionmethodset(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)
105 
106  !Argument variables
107  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
108  INTEGER(INTG), INTENT(IN) :: SOLUTION_METHOD
109  INTEGER(INTG), INTENT(OUT) :: ERR
110  TYPE(varying_string), INTENT(OUT) :: ERROR
111  !Local Variables
112 
113  enters("MultiCompartmentTransport_EquationsSetSolutionMethodSet",err,error,*999)
114 
115  CALL flagerror("Not implemented.",err,error,*999)
116 
117  exits("MultiCompartmentTransport_EquationsSetSolutionMethodSet")
118  RETURN
119 999 errors("MultiCompartmentTransport_EquationsSetSolutionMethodSet",err,error)
120  exits("MultiCompartmentTransport_EquationsSetSolutionMethodSet")
121  RETURN 1
122 
123  END SUBROUTINE multicompartmenttransport_equationssetsolutionmethodset
124 
125  !
126  !================================================================================================================================
127  !
128 
130  SUBROUTINE multicompartmenttransport_equationssetsetup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
131 
132  !Argument variables
133  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
134  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
135  INTEGER(INTG), INTENT(OUT) :: ERR
136  TYPE(varying_string), INTENT(OUT) :: ERROR
137  !Local Variables
138 
139 
140  enters("MultiCompartmentTransport_EquationsSetSetup",err,error,*999)
141 
142  CALL flagerror("Not implemented.",err,error,*999)
143 
144  exits("MultiCompartmentTransport_EquationsSetSetup")
145  RETURN
146 999 errorsexits("MultiCompartmentTransport_EquationsSetSetup",err,error)
147  RETURN 1
148 
149  END SUBROUTINE multicompartmenttransport_equationssetsetup
150 
151  !
152  !================================================================================================================================
153  !
154 
156  SUBROUTINE multicompartmenttransport_finiteelementcalculate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
157 
158  !Argument variables
159  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
160  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
161  INTEGER(INTG), INTENT(OUT) :: ERR
162  TYPE(varying_string), INTENT(OUT) :: ERROR
163  !Local Variables
164 
165  enters("MultiCompartmentTransport_FiniteElementCalculate",err,error,*999)
166 
167  CALL flagerror("Not implemented.",err,error,*999)
168 
169  exits("MultiCompartmentTransport_FiniteElementCalculate")
170  RETURN
171 999 errors("MultiCompartmentTransport_FiniteElementCalculate",err,error)
172  exits("MultiCompartmentTransport_FiniteElementCalculate")
173  RETURN 1
174 
175  END SUBROUTINE multicompartmenttransport_finiteelementcalculate
176 
177  !
178  !================================================================================================================================
179  !
180 
182  SUBROUTINE multicompartmenttransport_problemspecificationset(problem,problemSpecification,err,error,*)
183 
184  !Argument variables
185  TYPE(problem_type), POINTER :: problem
186  INTEGER(INTG), INTENT(IN) :: problemSpecification(:)
187  INTEGER(INTG), INTENT(OUT) :: err
188  TYPE(varying_string), INTENT(OUT) :: error
189  !Local Variables
190  TYPE(varying_string) :: localError
191  INTEGER(INTG) :: problemSubtype
192 
193  enters("MultiCompartmentTransport_ProblemSpecificationSet",err,error,*999)
194 
195  IF(ASSOCIATED(problem)) THEN
196  IF(SIZE(problemspecification,1)==3) THEN
197  problemsubtype=problemspecification(3)
198  SELECT CASE(problemsubtype)
199  CASE(problem_standard_multi_compartment_transport_subtype)
200  !ok
201  CASE DEFAULT
202  localerror="Problem subtype "//trim(numbertovstring(problemsubtype,"*",err,error))// &
203  & " is not valid for a multi-compartment coupled transport equation type of a multi physics problem class."
204  CALL flagerror(localerror,err,error,*999)
205  END SELECT
206  IF(ALLOCATED(problem%specification)) THEN
207  CALL flagerror("Problem specification is already allocated.",err,error,*999)
208  ELSE
209  ALLOCATE(problem%specification(3),stat=err)
210  IF(err/=0) CALL flagerror("Could not allocate problem specification.",err,error,*999)
211  END IF
212  problem%specification(1:3)=[problem_multi_physics_class,problem_multi_compartment_transport_type, &
213  & problemsubtype]
214  ELSE
215  CALL flagerror("Multi-compartment transport problem specification must have 3 entries.",err,error,*999)
216  END IF
217  ELSE
218  CALL flagerror("Problem is not associated.",err,error,*999)
219  END IF
220 
221  exits("MultiCompartmentTransport_ProblemSpecificationSet")
222  RETURN
223 999 errors("MultiCompartmentTransport_ProblemSpecificationSet",err,error)
224  exits("MultiCompartmentTransport_ProblemSpecificationSet")
225  RETURN 1
226 
227  END SUBROUTINE multicompartmenttransport_problemspecificationset
228 
229  !
230  !================================================================================================================================
231  !
232 
234  SUBROUTINE multi_compartment_transport_problem_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
235 
236  !Argument variables
237  TYPE(problem_type), POINTER :: PROBLEM
238  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
239  INTEGER(INTG), INTENT(OUT) :: ERR
240  TYPE(varying_string), INTENT(OUT) :: ERROR
241  !Local Variables
242  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT
243  TYPE(solver_type), POINTER :: SOLVER_DIFFUSION, SOLVER_ADVECTION_DIFFUSION
244  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS_DIFFUSION, SOLVER_EQUATIONS_ADVECTION_DIFFUSION
245  TYPE(solvers_type), POINTER :: SOLVERS
246  TYPE(varying_string) :: LOCAL_ERROR
247 
248  enters("MULTI_COMPARTMENT_TRANSPORT_PROBLEM_SETUP",err,error,*999)
249 
250  NULLIFY(control_loop)
251  NULLIFY(solvers)
252  NULLIFY(solver_diffusion)
253  NULLIFY(solver_advection_diffusion)
254  NULLIFY(solver_equations_diffusion)
255  NULLIFY(solver_equations_advection_diffusion)
256  IF(ASSOCIATED(problem)) THEN
257  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
258  CALL flagerror("Problem specification is not allocated.",err,error,*999)
259  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
260  CALL flagerror("Problem specification must have three entries for a multi compartment transport problem.",err,error,*999)
261  END IF
262  SELECT CASE(problem%SPECIFICATION(3))
263 
264  !--------------------------------------------------------------------
265  ! monolithic coupled source diffusion-diffusion problem
266  !--------------------------------------------------------------------
267  CASE(problem_standard_multi_compartment_transport_subtype)
268  SELECT CASE(problem_setup%SETUP_TYPE)
269  CASE(problem_setup_initial_type)
270  SELECT CASE(problem_setup%ACTION_TYPE)
271  CASE(problem_setup_start_action)
272  !Do nothing????
273  CASE(problem_setup_finish_action)
274  !Do nothing???
275  CASE DEFAULT
276  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
277  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
278  & " is invalid for a multi-compartment transport equation."
279  CALL flagerror(local_error,err,error,*999)
280  END SELECT
281  CASE(problem_setup_control_type)
282  SELECT CASE(problem_setup%ACTION_TYPE)
283  CASE(problem_setup_start_action)
284  !Set up a time control loop
285  CALL control_loop_create_start(problem,control_loop,err,error,*999)
286  CALL control_loop_type_set(control_loop,problem_control_time_loop_type,err,error,*999)
287  CASE(problem_setup_finish_action)
288  !Finish the control loops
289  control_loop_root=>problem%CONTROL_LOOP
290  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
291  CALL control_loop_create_finish(control_loop,err,error,*999)
292  CASE DEFAULT
293  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
294  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
295  & " is invalid for a multi-compartment transport equation."
296  CALL flagerror(local_error,err,error,*999)
297  END SELECT
298  CASE(problem_setup_solvers_type)
299  !Get the control loop
300  control_loop_root=>problem%CONTROL_LOOP
301  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
302  SELECT CASE(problem_setup%ACTION_TYPE)
303  CASE(problem_setup_start_action)
304  !Start the solvers creation
305  CALL solvers_create_start(control_loop,solvers,err,error,*999)
306  CALL solvers_number_set(solvers,1,err,error,*999)
307  !Set the solver to be a linear solver for the diffusion problem
308  CALL solvers_solver_get(solvers,1,solver_diffusion,err,error,*999)
309  CALL solver_type_set(solver_diffusion,solver_dynamic_type,err,error,*999)
310  CALL solver_dynamic_order_set(solver_diffusion,solver_dynamic_first_order,err,error,*999)
311  !Set solver defaults
312  CALL solver_dynamic_degree_set(solver_diffusion,solver_dynamic_first_degree,err,error,*999)
313  CALL solver_dynamic_scheme_set(solver_diffusion,solver_dynamic_crank_nicolson_scheme,err,error,*999)
314  CALL solver_library_type_set(solver_diffusion,solver_cmiss_library,err,error,*999)
315  !
316  CASE(problem_setup_finish_action)
317  !Get the solvers
318  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
319  !Finish the solvers creation
320  CALL solvers_create_finish(solvers,err,error,*999)
321  CASE DEFAULT
322  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
323  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
324  & " is invalid for a multi-compartment transport equation."
325  CALL flagerror(local_error,err,error,*999)
326  END SELECT
327  CASE(problem_setup_solver_equations_type)
328  SELECT CASE(problem_setup%ACTION_TYPE)
329  CASE(problem_setup_start_action)
330  !Get the control loop and solvers
331  control_loop_root=>problem%CONTROL_LOOP
332  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
333  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
334  !Get the diffusion solver and create the diffusion solver equations
335  CALL solvers_solver_get(solvers,1,solver_diffusion,err,error,*999)
336  CALL solver_equations_create_start(solver_diffusion,solver_equations_diffusion,err,error,*999)
337  CALL solver_equations_linearity_type_set(solver_equations_diffusion,solver_equations_linear,err,error,*999)
338  CALL solver_equations_time_dependence_type_set(solver_equations_diffusion, &
339  & solver_equations_first_order_dynamic,err,error,*999)
340  CALL solver_equations_sparsity_type_set(solver_equations_diffusion,solver_sparse_matrices,err,error,*999)
341  !
342  CASE(problem_setup_finish_action)
343  !Get the control loop
344  control_loop_root=>problem%CONTROL_LOOP
345  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
346  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
347  !Finish the creation of the diffusion solver equations
348  CALL solvers_solver_get(solvers,1,solver_diffusion,err,error,*999)
349  CALL solver_solver_equations_get(solver_diffusion,solver_equations_diffusion,err,error,*999)
350  CALL solver_equations_create_finish(solver_equations_diffusion,err,error,*999)
351  !
352  CASE DEFAULT
353  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
354  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
355  & " is invalid for a multi-compartment transport equation."
356  CALL flagerror(local_error,err,error,*999)
357  END SELECT
358  CASE DEFAULT
359  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
360  & " is invalid for a multi-compartment transport equation."
361  CALL flagerror(local_error,err,error,*999)
362  END SELECT
363 
364  !-----------------------------------------------------------------
365  ! c a s e d e f a u l t
366  !-----------------------------------------------------------------
367  CASE DEFAULT
368  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
369  & " does not equal a standard multi-component transport equation subtype."
370  CALL flagerror(local_error,err,error,*999)
371 
372  END SELECT
373  ELSE
374  CALL flagerror("Problem is not associated.",err,error,*999)
375  ENDIF
376 
377  exits("MULTI_COMPARTMENT_TRANSPORT_PROBLEM_SETUP")
378  RETURN
379 999 errorsexits("MULTI_COMPARTMENT_TRANSPORT_PROBLEM_SETUP",err,error)
380  RETURN 1
381  END SUBROUTINE multi_compartment_transport_problem_setup
382 
383  !
384  !================================================================================================================================
385  !
386 
388  SUBROUTINE multi_compartment_transport_pre_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
389 
390  !Argument variables
391  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
392  TYPE(solver_type), POINTER :: SOLVER
393  INTEGER(INTG), INTENT(OUT) :: ERR
394  TYPE(varying_string), INTENT(OUT) :: ERROR
395 
396  !Local Variables
397  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
398  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
399  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
400  TYPE(equations_type), POINTER :: EQUATIONS
401  TYPE(varying_string) :: LOCAL_ERROR
402 
403 
404  enters("MULTI_COMPARTMENT_TRANSPORT_PRE_SOLVE",err,error,*999)
405 
406  IF(ASSOCIATED(control_loop)) THEN
407  IF(ASSOCIATED(solver)) THEN
408  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
409  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
410  CALL flagerror("Problem specification is not allocated.",err,error,*999)
411  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
412  CALL flagerror("Problem specification must have three entries for a multi compartment transport problem.", &
413  & err,error,*999)
414  END IF
415  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
416  CASE(problem_standard_multi_compartment_transport_subtype)
417  solver_equations=>solver%SOLVER_EQUATIONS
418  IF(ASSOCIATED(solver_equations)) THEN
419  solver_mapping=>solver_equations%SOLVER_MAPPING
420  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
421  IF(ASSOCIATED(equations)) THEN
422  equations_set=>equations%EQUATIONS_SET
423  IF(ASSOCIATED(equations_set)) THEN
424  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
425 
426  CALL multicompartmenttransport_presolveupdateanalyticvalues(control_loop,solver,err,error,*999)
427 ! IF(SOLVER%GLOBAL_NUMBER==1) THEN
428 ! !copy current value of concentration_one to another variable
429 ! !CALL ADVEC_DIFFUSION_EQUATION_PRE_SOLVE_STORE_CURRENT_SOLN(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
430 ! !Set source term to be updated value of concentration_two
431 ! !CALL ADVECTION_DIFFUSION_EQUATION_PRE_SOLVE_GET_SOURCE_VALUE(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
432 ! ELSE IF(SOLVER%GLOBAL_NUMBER==2) THEN
433 ! !compute value of constant source term - evaluated from lamdba*(0.5*(c_1^{t+1}+c_1^{t}) - c_2^{t})
434 ! !CALL DIFFUSION_EQUATION_PRE_SOLVE_GET_SOURCE_VALUE(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
435 ! ENDIF
436  ENDIF
437  ENDIF
438  ENDIF
439  ENDIF
440  CASE DEFAULT
441  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
442  & " is not valid for a multi-compartment transport type of a multi physics problem class."
443  CALL flagerror(local_error,err,error,*999)
444  END SELECT
445  ELSE
446  CALL flagerror("Problem is not associated.",err,error,*999)
447  ENDIF
448  ELSE
449  CALL flagerror("Solver is not associated.",err,error,*999)
450  ENDIF
451  ELSE
452  CALL flagerror("Control loop is not associated.",err,error,*999)
453  ENDIF
454 
455  exits("MULTI_COMPARTMENT_TRANSPORT_PRE_SOLVE")
456  RETURN
457 999 errorsexits("MULTI_COMPARTMENT_TRANSPORT_PRE_SOLVE",err,error)
458  RETURN 1
459  END SUBROUTINE multi_compartment_transport_pre_solve
460 
461  !
462  !================================================================================================================================
463  !
464  !updates the boundary conditions and source term to the required analytic values
465  SUBROUTINE multicompartmenttransport_presolveupdateanalyticvalues(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
466 
467  !Argument variables
468  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
469  TYPE(solver_type), POINTER :: SOLVER
470  INTEGER(INTG), INTENT(OUT) :: ERR
471  TYPE(varying_string), INTENT(OUT) :: ERROR
472  !Local Variables
473  TYPE(field_type), POINTER :: ANALYTIC_FIELD,DEPENDENT_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD,SOURCE_FIELD
474 ! TYPE(FIELD_TYPE), POINTER :: FIELD !<A pointer to the field
475  TYPE(field_variable_type), POINTER :: ANALYTIC_VARIABLE,FIELD_VARIABLE,GEOMETRIC_VARIABLE,MATERIALS_VARIABLE
476  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
477  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
478  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
479  TYPE(equations_type), POINTER :: EQUATIONS
480  TYPE(domain_type), POINTER :: DOMAIN
481  TYPE(domain_nodes_type), POINTER :: DOMAIN_NODES
482 ! TYPE(DOMAIN_TOPOLOGY_TYPE), POINTER :: DOMAIN_TOPOLOGY
483  TYPE(varying_string) :: LOCAL_ERROR
484  TYPE(boundary_conditions_variable_type), POINTER :: BOUNDARY_CONDITIONS_VARIABLE
485 ! TYPE(BOUNDARY_CONDITIONS_TYPE), POINTER :: BOUNDARY_CONDITIONS
486 ! REAL(DP), POINTER :: BOUNDARY_VALUES(:)
487  REAL(DP), POINTER :: ANALYTIC_PARAMETERS(:),GEOMETRIC_PARAMETERS(:),MATERIALS_PARAMETERS(:)
488  INTEGER(INTG) :: NUMBER_OF_DIMENSIONS,BOUNDARY_CONDITION_CHECK_VARIABLE
489 
490  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT
491  REAL(DP) :: NORMAL(3),TANGENTS(3,3),VALUE,X(3),VALUE_SOURCE
492 ! REAL(DP) :: k_xx, k_yy, k_zz
493  INTEGER(INTG) :: component_idx,deriv_idx,dim_idx,local_ny,node_idx,eqnset_idx
494  INTEGER(INTG) :: VARIABLE_TYPE
495  INTEGER(INTG) :: ANALYTIC_FUNCTION_TYPE
496  INTEGER(INTG) :: GLOBAL_DERIV_INDEX
497  REAL(DP) :: A1,A2,A3,A4,D1,D2,D3,D4,LAMBDA_12,LAMBDA_13,LAMBDA_23
498 ! INTEGER(INTG) :: FIELD_SET_TYPE !<The field parameter set identifier \see FIELD_ROUTINES_ParameterSetTypes,FIELD_ROUTINES
499 ! INTEGER(INTG) :: DERIVATIVE_NUMBER !<The node derivative number
500 ! INTEGER(INTG) :: COMPONENT_NUMBER !<The field variable component number
501 ! INTEGER(INTG) :: TOTAL_NUMBER_OF_NODES !<The total number of (geometry) nodes
502 ! INTEGER(INTG) :: LOCAL_NODE_NUMBER
503 ! INTEGER(INTG) :: EQUATIONS_SET_IDX
504 ! INTEGER(INTG) :: equations_row_number
505 
506  enters("MultiCompartmentTransport_PreSolveUpdateAnalyticValues",err,error,*999)
507 
508 
509  a1 = 0.4_dp
510  a2 = 0.3_dp
511  a3 = 0.2_dp
512  a4 = 0.1_dp
513  d1=1.0_dp
514  d2=1.0_dp
515  d3=1.0_dp
516  d4=1.0_dp
517  lambda_12=0.1_dp
518  lambda_13=0.1_dp
519  lambda_23=0.1_dp
520 
521  IF(ASSOCIATED(control_loop)) THEN
522  CALL control_loop_current_times_get(control_loop,current_time,time_increment,err,error,*999)
523  !write(*,*)'CURRENT_TIME = ',CURRENT_TIME
524  !write(*,*)'TIME_INCREMENT = ',TIME_INCREMENT
525  IF(ASSOCIATED(solver)) THEN
526  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
527  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
528  CALL flagerror("Problem specification is not allocated.",err,error,*999)
529  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
530  CALL flagerror("Problem specification must have three entries for a multi compartment transport problem.", &
531  & err,error,*999)
532  END IF
533  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
534  !do nothing?!
535  CASE(problem_standard_multi_compartment_transport_subtype)
536  solver_equations=>solver%SOLVER_EQUATIONS
537  IF(ASSOCIATED(solver_equations)) THEN
538  !loop over all the equation sets and set the appropriate field variable type BCs and
539  !the source field associated with each equation set
540  DO eqnset_idx=1,solver_equations%SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS
541  solver_mapping=>solver_equations%SOLVER_MAPPING
542  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(eqnset_idx)%EQUATIONS
543  IF(ASSOCIATED(equations)) THEN
544  equations_set=>equations%EQUATIONS_SET
545  IF(ASSOCIATED(equations_set)) THEN
546  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
547  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
548  IF(ASSOCIATED(dependent_field)) THEN
549  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
550  IF(ASSOCIATED(geometric_field)) THEN
551  analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
552  CALL field_number_of_components_get(geometric_field,field_u_variable_type,&
553  & number_of_dimensions,err,error,*999)
554  NULLIFY(geometric_variable)
555  NULLIFY(geometric_parameters)
556  CALL field_variable_get(geometric_field,field_u_variable_type,geometric_variable,err,error,*999)
557  CALL field_parameter_set_data_get(geometric_field,field_u_variable_type,field_values_set_type,&
558  & geometric_parameters,err,error,*999)
559  NULLIFY(analytic_variable)
560  NULLIFY(analytic_parameters)
561  IF(ASSOCIATED(analytic_field)) THEN
562  CALL field_variable_get(analytic_field,field_u_variable_type,analytic_variable,err,error,*999)
563  CALL field_parameter_set_data_get(analytic_field,field_u_variable_type,field_values_set_type, &
564  & analytic_parameters,err,error,*999)
565  ENDIF
566  NULLIFY(materials_field)
567  NULLIFY(materials_variable)
568  NULLIFY(materials_parameters)
569  IF(ASSOCIATED(equations_set%MATERIALS)) THEN
570  materials_field=>equations_set%MATERIALS%MATERIALS_FIELD
571  CALL field_variable_get(materials_field,field_u_variable_type,materials_variable,err,error,*999)
572  CALL field_parameter_set_data_get(materials_field,field_u_variable_type,field_values_set_type, &
573  & materials_parameters,err,error,*999)
574  ENDIF
575  equations_set%ANALYTIC%ANALYTIC_USER_PARAMS(1)=current_time
576 ! DO variable_idx=1,DEPENDENT_FIELD%NUMBER_OF_VARIABLES
577  variable_type=dependent_field%VARIABLES(2*eqnset_idx-1)%VARIABLE_TYPE
578  field_variable=>dependent_field%VARIABLE_TYPE_MAP(variable_type)%PTR
579  IF(ASSOCIATED(field_variable)) THEN
580  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
581  IF(field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE== &
582  & field_node_based_interpolation) THEN
583  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
584  IF(ASSOCIATED(domain)) THEN
585  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
586  domain_nodes=>domain%TOPOLOGY%NODES
587  IF(ASSOCIATED(domain_nodes)) THEN
588  CALL boundary_conditions_variable_get(solver_equations%BOUNDARY_CONDITIONS, &
589  & field_variable,boundary_conditions_variable,err,error,*999)
590  IF(ASSOCIATED(boundary_conditions_variable)) THEN
591  !Loop over the local nodes excluding the ghosts.
592  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
593  !!TODO \todo We should interpolate the geometric field here and the node position.
594  DO dim_idx=1,number_of_dimensions
595  !Default to version 1 of each node derivative
596  local_ny=geometric_variable%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP% &
597  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(1)%VERSIONS(1)
598  x(dim_idx)=geometric_parameters(local_ny)
599  ENDDO !dim_idx
600  !Loop over the derivatives
601  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
602  analytic_function_type=equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE
603  global_deriv_index=domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)% &
604  & global_derivative_index
605  CALL diffusion_analyticfunctionsevaluate(equations_set, &
606  & analytic_function_type,x,tangents,normal,current_time,variable_type, &
607  & global_deriv_index,component_idx,analytic_parameters,materials_parameters, &
608  & VALUE,err,error,*999)
609  !Default to version 1 of each node derivative
610  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
611  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
612  CALL field_parameter_set_update_local_dof(dependent_field,variable_type, &
613  & field_analytic_values_set_type,local_ny,VALUE,err,error,*999)
614  boundary_condition_check_variable=boundary_conditions_variable% &
615  & condition_types(local_ny)
616  IF(boundary_condition_check_variable==boundary_condition_fixed) THEN
617  CALL field_parameter_set_update_local_dof(dependent_field, &
618  & variable_type,field_values_set_type,local_ny, &
619  & VALUE,err,error,*999)
620  ENDIF
621 
622 ! IF(variable_type==FIELD_U_VARIABLE_TYPE) THEN
623 ! IF(DOMAIN_NODES%NODES(node_idx)%BOUNDARY_NODE) THEN
624 ! !If we are a boundary node then set the analytic value on the boundary
625 ! CALL BOUNDARY_CONDITIONS_SET_LOCAL_DOF(BOUNDARY_CONDITIONS,variable_type,local_ny, &
626 ! & BOUNDARY_CONDITION_FIXED,VALUE,ERR,ERROR,*999)
627 ! ENDIF
628 ! ENDIF
629  ENDDO !deriv_idx
630  ENDDO !node_idx
631  ELSE
632  CALL flagerror("Boundary conditions variable is not associated.",err,error,*999)
633  ENDIF
634  ELSE
635  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
636  ENDIF
637  ELSE
638  CALL flagerror("Domain topology is not associated.",err,error,*999)
639  ENDIF
640  ELSE
641  CALL flagerror("Domain is not associated.",err,error,*999)
642  ENDIF
643  ELSE
644  CALL flagerror("Only node based interpolation is implemented.",err,error,*999)
645  ENDIF
646  ENDDO !component_idx
647  CALL field_parameter_set_update_start(dependent_field,variable_type, &
648  & field_analytic_values_set_type,err,error,*999)
649  CALL field_parameter_set_update_finish(dependent_field,variable_type, &
650  & field_analytic_values_set_type,err,error,*999)
651  CALL field_parameter_set_update_start(dependent_field,variable_type, &
652  & field_values_set_type,err,error,*999)
653  CALL field_parameter_set_update_finish(dependent_field,variable_type, &
654  & field_values_set_type,err,error,*999)
655  ELSE
656  CALL flagerror("Field variable is not associated.",err,error,*999)
657  ENDIF
658 
659 ! ENDDO !variable_idx
660  CALL field_parameter_set_data_restore(geometric_field,field_u_variable_type,&
661  & field_values_set_type,geometric_parameters,err,error,*999)
662  ELSE
663  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
664  ENDIF
665  ELSE
666  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
667  ENDIF
668  ELSE
669  !CALL FlagError("Equations set analytic is not associated.",ERR,ERROR,*999)
670  ENDIF
671  ELSE
672  CALL flagerror("Equations set is not associated.",err,error,*999)
673  ENDIF
674  ELSE
675  CALL flagerror("Equations are not associated.",err,error,*999)
676  END IF
677 ! ELSE
678 ! CALL FlagError("Solver equations are not associated.",ERR,ERROR,*999)
679 ! END IF
680  CALL field_parameter_set_update_start(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
681  & field_values_set_type,err,error,*999)
682  CALL field_parameter_set_update_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
683  & field_values_set_type,err,error,*999)
684  CALL field_parameter_set_update_start(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
685  & field_values_set_type,err,error,*999)
686  CALL field_parameter_set_update_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
687  & field_values_set_type,err,error,*999)
688 
690  IF(ASSOCIATED(equations_set)) THEN
691  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
692  source_field=>equations_set%SOURCE%SOURCE_FIELD
693  IF(ASSOCIATED(source_field)) THEN
694  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
695  IF(ASSOCIATED(geometric_field)) THEN
696  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
697  NULLIFY(geometric_variable)
698  CALL field_variable_get(geometric_field,field_u_variable_type,geometric_variable,err,error,*999)
699  CALL field_parameter_set_data_get(geometric_field,field_u_variable_type,field_values_set_type, &
700  & geometric_parameters,err,error,*999)
701  variable_type=field_u_variable_type
702  field_variable=>source_field%VARIABLE_TYPE_MAP(variable_type)%PTR
703  IF(ASSOCIATED(field_variable)) THEN
704  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
705  IF(field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE==field_node_based_interpolation) THEN
706  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
707  IF(ASSOCIATED(domain)) THEN
708  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
709  domain_nodes=>domain%TOPOLOGY%NODES
710  IF(ASSOCIATED(domain_nodes)) THEN
711  !Loop over the local nodes excluding the ghosts.
712  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
713  !!TODO \todo We should interpolate the geometric field here and the node position.
714  DO dim_idx=1,number_of_dimensions
715  !Default to version 1 of each node derivative
716  local_ny=geometric_variable%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP% &
717  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(1)%VERSIONS(1)
718  x(dim_idx)=geometric_parameters(local_ny)
719  ENDDO !dim_idx
720  !Loop over the derivatives
721  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
722  SELECT CASE(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE)
723  CASE(equations_set_multi_comp_diffusion_two_comp_two_dim)
724  SELECT CASE(eqnset_idx)
725  CASE(1)
726  value_source=exp(-1*current_time)*(-1*a1*(x(1)*x(1)+x(2)*x(2))-4*d1*a1+lambda_12*(a1-a2)*&
727  & (x(1)*x(1)+x(2)*x(2)))
728  CASE(2)
729  value_source=exp(-1*current_time)*(-1*a2*(x(1)*x(1)+x(2)*x(2))-4*d2*a2+lambda_12*(a2-a1)*&
730  & (x(1)*x(1)+x(2)*x(2)))
731  END SELECT
732  CASE(equations_set_multi_comp_diffusion_three_comp_three_dim)
733  SELECT CASE(eqnset_idx)
734  CASE(1)
735  value_source=exp(-1*current_time)*(-1*a1*(x(1)*x(1)+x(2)*x(2)+x(3)*x(3))-&
736  & 6*d1*a1+lambda_13*(a1-a3)*&
737  & (x(1)*x(1)+x(2)*x(2)+x(3)*x(3))+lambda_12*(a1-a2)*(x(1)*x(1)+x(2)*x(2)+x(3)*x(3)))
738  CASE(2)
739  value_source=exp(-1*current_time)*(-1*a2*(x(1)*x(1)+x(2)*x(2)+x(3)*x(3))-&
740  & 6*d2*a2+lambda_12*(a2-a1)*&
741  & (x(1)*x(1)+x(2)*x(2)+x(3)*x(3))+lambda_23*(a2-a3)*(x(1)*x(1)+x(2)*x(2)+x(3)*x(3)))
742  CASE(3)
743  value_source=exp(-1*current_time)*(-1*a3*(x(1)*x(1)+x(2)*x(2)+x(3)*x(3))-&
744  & 6*d3*a3+lambda_13*(a3-a1)*&
745  & (x(1)*x(1)+x(2)*x(2)+x(3)*x(3))+lambda_23*(a3-a2)*(x(1)*x(1)+x(2)*x(2)+x(3)*x(3)))
746  END SELECT
747  CASE DEFAULT
748  local_error="The analytic function type of "// &
749  & trim(number_to_vstring(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE,"*",err,error))//&
750  & " is invalid."
751  CALL flagerror(local_error,err,error,*999)
752  END SELECT
753  !Default to version 1 of each node derivative
754  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
755  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
756  CALL field_parameter_set_update_local_dof(source_field,field_u_variable_type, &
757  & field_values_set_type,local_ny,value_source,err,error,*999)
758  ENDDO !deriv_idx
759  ENDDO !node_idx
760  ELSE
761  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
762  ENDIF
763  ELSE
764  CALL flagerror("Domain topology is not associated.",err,error,*999)
765  ENDIF
766  ELSE
767  CALL flagerror("Domain is not associated.",err,error,*999)
768  ENDIF
769  ELSE
770  CALL flagerror("Only node based interpolation is implemented.",err,error,*999)
771  ENDIF
772  ENDDO !component_idx
773  CALL field_parameter_set_update_start(source_field,field_u_variable_type,field_values_set_type, &
774  & err,error,*999)
775  CALL field_parameter_set_update_finish(source_field,field_u_variable_type,field_values_set_type, &
776  & err,error,*999)
777  ELSE
778  CALL flagerror("Field variable is not associated.",err,error,*999)
779  ENDIF
780  CALL field_parameter_set_data_restore(geometric_field,field_u_variable_type,field_values_set_type, &
781  & geometric_parameters,err,error,*999)
782  ELSE
783  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
784  ENDIF
785  ELSE
786  CALL flagerror("Equations set source field is not associated.",err,error,*999)
787  ENDIF
788  ELSE
789  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
790  ENDIF
791  ELSE
792  CALL flagerror("Equations set is not associated.",err,error,*999)
793  ENDIF
794  ENDDO !eqnset_idx
795  ELSE
796  CALL flagerror("Solver equations are not associated.",err,error,*999)
797  END IF
798  CASE DEFAULT
799  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
800  & " is not valid for a multi-physics coupled diffusion equation type of a multi-physics problem class."
801  CALL flagerror(local_error,err,error,*999)
802  END SELECT
803  ELSE
804  CALL flagerror("Problem is not associated.",err,error,*999)
805  ENDIF
806  ELSE
807  CALL flagerror("Solver is not associated.",err,error,*999)
808  ENDIF
809  ELSE
810  CALL flagerror("Control loop is not associated.",err,error,*999)
811  ENDIF
812 
813  exits("MultiCompartmentTransport_PreSolveUpdateAnalyticValues")
814  RETURN
815 999 errors("MultiCompartmentTransport_PreSolveUpdateAnalyticValues",err,error)
816  exits("MultiCompartmentTransport_PreSolveUpdateAnalyticValues")
817  RETURN 1
818 
819  END SUBROUTINE multicompartmenttransport_presolveupdateanalyticvalues
820  !
821  !================================================================================================================================
822  !
824  SUBROUTINE multi_compartment_transport_post_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
825 
826  !Argument variables
827  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
828  TYPE(solver_type), POINTER :: SOLVER
829  INTEGER(INTG), INTENT(OUT) :: ERR
830  TYPE(varying_string), INTENT(OUT) :: ERROR
831 
832  !Local Variables
833  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
834  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
835  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
836  TYPE(equations_type), POINTER :: EQUATIONS
837  TYPE(varying_string) :: LOCAL_ERROR
838  REAL(DP), POINTER :: OUTPUT_DATA1(:),OUTPUT_DATA2(:),OUTPUT_DATA3(:),OUTPUT_DATA4(:),OUTPUT_DATA5(:)
839  enters("MULTI_COMPARTMENT_TRANSPORT_POST_SOLVE",err,error,*999)
840  NULLIFY(output_data1)
841  NULLIFY(output_data2)
842  NULLIFY(output_data3)
843  NULLIFY(output_data4)
844  NULLIFY(output_data5)
845  IF(ASSOCIATED(control_loop)) THEN
846  IF(ASSOCIATED(solver)) THEN
847  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
848  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
849  CALL flagerror("Problem specification is not allocated.",err,error,*999)
850  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
851  CALL flagerror("Problem specification must have three entries for a multi compartment transport problem.", &
852  & err,error,*999)
853  END IF
854  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
855  CASE(problem_standard_multi_compartment_transport_subtype)
856  IF(solver%GLOBAL_NUMBER==1) THEN
857 ! CALL ADVECTION_DIFFUSION_EQUATION_POST_SOLVE(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
858 
859  solver_equations=>solver%SOLVER_EQUATIONS
860  IF(ASSOCIATED(solver_equations)) THEN
861  solver_mapping=>solver_equations%SOLVER_MAPPING
862  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
863  IF(ASSOCIATED(equations)) THEN
864  equations_set=>equations%EQUATIONS_SET
865  IF(ASSOCIATED(equations_set)) THEN
866 
867 ! CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
868 ! & FIELD_VALUES_SET_TYPE,OUTPUT_DATA1,ERR,ERROR,*999)
869 !
870 ! WRITE (*,*) OUTPUT_DATA1
871 ! CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_V_VARIABLE_TYPE, &
872 ! & FIELD_VALUES_SET_TYPE,OUTPUT_DATA2,ERR,ERROR,*999)
873 !
874 ! WRITE (*,*) OUTPUT_DATA2
875 ! CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U1_VARIABLE_TYPE, &
876 ! & FIELD_VALUES_SET_TYPE,OUTPUT_DATA3,ERR,ERROR,*999)
877 !
878 ! WRITE (*,*) OUTPUT_DATA3
879 ! CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U2_VARIABLE_TYPE, &
880 ! & FIELD_VALUES_SET_TYPE,OUTPUT_DATA4,ERR,ERROR,*999)
881 !
882 ! WRITE (*,*) OUTPUT_DATA4
883 !
884 ! CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U3_VARIABLE_TYPE, &
885 ! & FIELD_VALUES_SET_TYPE,OUTPUT_DATA5,ERR,ERROR,*999)
886 !
887 ! WRITE (*,*) OUTPUT_DATA5
888 
889  ENDIF
890  endif
891  ENDIF
892  ELSE IF(solver%GLOBAL_NUMBER==2) THEN
893 ! CALL DIFFUSION_EQUATION_POST_SOLVE(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
894  ENDIF
895  CASE DEFAULT
896  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
897  & " is not valid for a multi-compartment type of a multi physics problem class."
898  CALL flagerror(local_error,err,error,*999)
899  END SELECT
900  ELSE
901  CALL flagerror("Problem is not associated.",err,error,*999)
902  ENDIF
903  ELSE
904  CALL flagerror("Solver is not associated.",err,error,*999)
905  ENDIF
906  ELSE
907  CALL flagerror("Control loop is not associated.",err,error,*999)
908  ENDIF
909 
910  exits("MULTI_COMPARTMENT_TRANSPORT_POST_SOLVE")
911  RETURN
912 999 errorsexits("MULTI_COMPARTMENT_TRANSPORT_POST_SOLVE",err,error)
913  RETURN 1
914  END SUBROUTINE multi_compartment_transport_post_solve
915 
916  !
917  !================================================================================================================================
918  !
919 
921  SUBROUTINE multicompartmenttransport_postsolveoutputdata(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
922 
923  !Argument variables
924  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
925  TYPE(solver_type), POINTER :: SOLVER
926  INTEGER(INTG), INTENT(OUT) :: ERR
927  TYPE(varying_string), INTENT(OUT) :: ERROR
928 
929  !Local Variables
930  TYPE(varying_string) :: LOCAL_ERROR
931 
932  enters("MultiCompartmentTransport_PostSolveOutputData",err,error,*999)
933 
934  IF(ASSOCIATED(control_loop)) THEN
935  IF(ASSOCIATED(solver)) THEN
936  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
937  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
938  CALL flagerror("Problem specification is not allocated.",err,error,*999)
939  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
940  CALL flagerror("Problem specification must have three entries for a multi compartment transport problem.", &
941  & err,error,*999)
942  END IF
943  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
944  CASE(problem_standard_multi_compartment_transport_subtype)
945  !CALL ADVECTION_DIFFUSION_EQUATION_POST_SOLVE_OUTPUT_DATA(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
946  !CALL DIFFUSION_EQUATION_POST_SOLVE_OUTPUT_DATA(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
947  CASE DEFAULT
948  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
949  & " is not valid for a multi-compartment transport type of a multi physics problem class."
950  CALL flagerror(local_error,err,error,*999)
951  END SELECT
952  ELSE
953  CALL flagerror("Problem is not associated.",err,error,*999)
954  ENDIF
955  ELSE
956  CALL flagerror("Solver is not associated.",err,error,*999)
957  ENDIF
958  ELSE
959  CALL flagerror("Control loop is not associated.",err,error,*999)
960  ENDIF
961 
962  exits("MultiCompartmentTransport_PostSolveOutputData")
963  RETURN
964 999 errors("MultiCompartmentTransport_PostSolveOutputData",err,error)
965  exits("MultiCompartmentTransport_PostSolveOutputData")
966  RETURN 1
967 
968  END SUBROUTINE multicompartmenttransport_postsolveoutputdata
969 
970  !
971  !================================================================================================================================
972  !
973 
974 
975 END MODULE multi_compartment_transport_routines
basis_routines
This module contains all basis function routines.
Definition: basis_routines.f90:45
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
coordinate_routines
This module contains all coordinate transformation and support routines.
Definition: coordinate_routines.f90:45
types::equations_type
Contains information about the equations in an equations set.
Definition: types.f90:1735
problem_constants::problem_control_time_loop_type
integer(intg), parameter problem_control_time_loop_type
Time control loop.
Definition: problem_constants.f90:283
problem_constants::problem_setup_control_type
integer(intg), parameter problem_setup_control_type
Solver setup for a problem.
Definition: problem_constants.f90:263
problem_constants
This module handles all problem wide constants.
Definition: problem_constants.f90:45
problem_constants::solver_equations_first_order_dynamic
integer(intg), parameter solver_equations_first_order_dynamic
Solver equations are first order dynamic.
Definition: problem_constants.f90:311
control_loop_routines::control_loop_node
integer(intg), parameter, public control_loop_node
The identifier for a each "leaf" node in a control loop.
Definition: control_loop_routines.f90:67
solver_routines::solver_dynamic_order_set
subroutine, public solver_dynamic_order_set(SOLVER, ORDER, ERR, ERROR,)
Sets/changes the order for a dynamic solver.
Definition: solver_routines.f90:6327
strings::number_to_vstring
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
types::solver_type
Contains information on the type of solver to be used.
Definition: types.f90:2777
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
solver_routines::solver_dynamic_crank_nicolson_scheme
integer(intg), parameter, public solver_dynamic_crank_nicolson_scheme
Crank-Nicolson dynamic solver.
Definition: solver_routines.f90:282
solver_routines::solver_dynamic_degree_set
subroutine, public solver_dynamic_degree_set(SOLVER, DEGREE, ERR, ERROR,)
Sets/changes the degree of the polynomial used to interpolate time for a dynamic solver.
Definition: solver_routines.f90:5484
equations_matrices_routines
This module handles all equations matrix and rhs routines.
Definition: equations_matrices_routines.f90:45
solver_routines::solver_dynamic_first_order
integer(intg), parameter, public solver_dynamic_first_order
Dynamic solver has first order terms.
Definition: solver_routines.f90:255
solver_routines::solver_type_set
subroutine, public solver_type_set(SOLVER, SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type for a solver.
Definition: solver_routines.f90:21345
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
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
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
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
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
problem_constants::solver_equations_linear
integer(intg), parameter solver_equations_linear
Solver equations are linear.
Definition: problem_constants.f90:301
types::control_loop_type
Contains information on a control loop.
Definition: types.f90:3185
iso_varying_string
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
Definition: iso_varying_string.f90:62
solver_routines::solver_equations_create_finish
subroutine, public solver_equations_create_finish(SOLVER_EQUATIONS, ERR, ERROR,)
Finishes the process of creating solver equations.
Definition: solver_routines.f90:7166
equations_set_constants::equations_set_multi_comp_diffusion_two_comp_two_dim
integer(intg), parameter equations_set_multi_comp_diffusion_two_comp_two_dim
Prescribed solution, using a source term to correct for error - 2D with 2 compartments.
Definition: equations_set_constants.f90:461
solver_routines::solver_sparse_matrices
integer(intg), parameter, public solver_sparse_matrices
Use sparse solver matrices.
Definition: solver_routines.f90:360
solver_routines::solver_equations_create_start
subroutine, public solver_equations_create_start(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Starts the process of creating solver equations.
Definition: solver_routines.f90:7209
solver_routines::solver_dynamic_type
integer(intg), parameter, public solver_dynamic_type
A dynamic solver.
Definition: solver_routines.f90:90
problem_constants::problem_setup_solvers_type
integer(intg), parameter problem_setup_solvers_type
Solver setup for a problem.
Definition: problem_constants.f90:264
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
constants
This module contains all program wide constants.
Definition: constants.f90:45
solver_routines::solver_library_type_set
subroutine, public solver_library_type_set(SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library type to use for the solver.
Definition: solver_routines.f90:9067
problem_constants::problem_setup_initial_type
integer(intg), parameter problem_setup_initial_type
Initial setup for a problem.
Definition: problem_constants.f90:262
types::problem_setup_type
Definition: types.f90:3215
types::boundary_conditions_variable_type
Contains information on the boundary conditions for a dependent field variable.
Definition: types.f90:1759
advection_diffusion_equation_routines
This module handles all advection-diffusion equation routines.
Definition: advection_diffusion_equation_routines.f90:45
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
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
control_loop_routines::control_loop_solvers_get
recursive subroutine, public control_loop_solvers_get(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Returns a pointer to the solvers for a control loop.
Definition: control_loop_routines.f90:1333
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
problem_constants::problem_multi_compartment_transport_type
integer(intg), parameter problem_multi_compartment_transport_type
Problem type for the multi-compartment coupled transport, comprising either/or/both advection-diffusi...
Definition: problem_constants.f90:108
diffusion_equation_routines::diffusion_analyticfunctionsevaluate
subroutine, public diffusion_analyticfunctionsevaluate(EQUATIONS_SET, ANALYTIC_FUNCTION_TYPE, X, TANGENTS, NORMAL, TIME, VARIABLE_TYPE, GLOBAL_DERIVATIVE, COMPONENT_NUMBER, ANALYTIC_PARAMETERS, MATERIALS_PARAMETERS, VALUE, ERR, ERROR,)
Evaluate the analytic solutions for a diffusion equation.
Definition: diffusion_equation_routines.f90:375
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
iso_varying_string::trim
Definition: iso_varying_string.f90:204
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
multi_compartment_transport_routines
TThis module handles all routines pertaining to (advection-)diffusion coupled to (advection-)diffusio...
Definition: multi_compartment_transport_routines.f90:47
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
problem_constants::problem_multi_physics_class
integer(intg), parameter problem_multi_physics_class
Definition: problem_constants.f90:63
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
types::problem_type
Contains information for a problem.
Definition: types.f90:3221
types::domain_nodes_type
Contains the topology information for the nodes of a domain.
Definition: types.f90:713
distributed_matrix_vector
This module handles all distributed matrix vector routines.
Definition: distributed_matrix_vector.f90:45
boundary_conditions_routines
This module handles all boundary conditions routines.
Definition: boundary_condition_routines.f90:45
solver_routines
This module handles all solver routines.
Definition: solver_routines.f90:45
matrix_vector
This module contains all routines dealing with (non-distributed) matrix and vectors types...
Definition: matrix_vector.f90:129
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
types::solver_mapping_type
Contains information on the solver mapping between the global equation sets and the solver matrices...
Definition: types.f90:3091
solver_routines::solver_dynamic_scheme_set
subroutine, public solver_dynamic_scheme_set(SOLVER, SCHEME, ERR, ERROR,)
Sets/changes the scheme for a dynamic solver.
Definition: solver_routines.f90:6384
types::field_variable_type
Contains information for a field variable defined on a field.
Definition: types.f90:1289
problem_constants::problem_standard_multi_compartment_transport_subtype
integer(intg), parameter problem_standard_multi_compartment_transport_subtype
Definition: problem_constants.f90:248
types::equations_set_setup_type
Contains information on the setup information for an equations set.
Definition: types.f90:1866
types::domain_type
A pointer to the domain decomposition for this domain.
Definition: types.f90:938
problem_constants::problem_setup_start_action
integer(intg), parameter problem_setup_start_action
Start setup action.
Definition: problem_constants.f90:273
solver_routines::solver_equations_time_dependence_type_set
subroutine, public solver_equations_time_dependence_type_set(SOLVER_EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for solver equations.
Definition: solver_routines.f90:7788
control_loop_routines
This module handles all control loop routines.
Definition: control_loop_routines.f90:45
solver_routines::solver_cmiss_library
integer(intg), parameter, public solver_cmiss_library
CMISS (internal) solver library.
Definition: solver_routines.f90:103
boundary_conditions_routines::boundary_condition_fixed
integer(intg), parameter, public boundary_condition_fixed
The dof is fixed as a boundary condition.
Definition: boundary_condition_routines.f90:95
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
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
boundary_conditions_routines::boundary_conditions_variable_get
subroutine, public boundary_conditions_variable_get(BOUNDARY_CONDITIONS, FIELD_VARIABLE, BOUNDARY_CONDITIONS_VARIABLE, ERR, ERROR,)
Find the boundary conditions variable for a given field variable.
Definition: boundary_condition_routines.f90:3635
equations_set_constants::equations_set_multi_comp_diffusion_three_comp_three_dim
integer(intg), parameter equations_set_multi_comp_diffusion_three_comp_three_dim
Prescribed solution, using a source term to correct for error - 3D with 3 compartments.
Definition: equations_set_constants.f90:463
solver_routines::solver_dynamic_first_degree
integer(intg), parameter, public solver_dynamic_first_degree
Dynamic solver uses a first degree polynomial for time interpolation.
Definition: solver_routines.f90:271
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
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
diffusion_equation_routines
This module handles all diffusion equation routines.
Definition: diffusion_equation_routines.f90:45
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
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45