OpenCMISS-Iron Internal API Documentation
diffusion_diffusion_routines.f90
Go to the documentation of this file.
1 
43 
45 
46 
48 
49  USE base_routines
50  USE basis_routines
52  USE constants
57  USE domain_mappings
62  USE field_routines
63 ! USE FINITE_ELASTICITY_ROUTINES
65 ! USE FITTING_ROUTINES !also in makefiles
66  USE input_output
68  USE kinds
69  USE maths
70  USE matrix_vector
71  USE mesh_routines
72  USE node_routines
74  USE strings
75  USE solver_routines
76  USE timer
77  USE types
78 
79 #include "macros.h"
80 
81 
82  IMPLICIT NONE
83 
87 
90 
92 
95 
96 
97 CONTAINS
98 
99  !
100  !================================================================================================================================
101  !
102 
104  SUBROUTINE diffusiondiffusion_equationssetsolutionmethodset(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)
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  TYPE(varying_string) :: LOCAL_ERROR
113 
114  enters("DiffusionDiffusion_EquationsSetSolutionMethodSet",err,error,*999)
115 
116  IF(ASSOCIATED(equations_set)) THEN
117  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
118  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
119  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
120  CALL flagerror("Equations set specification must have three entries for a "// &
121  & "diffusion-diffusion type equations set.",err,error,*999)
122  END IF
123  SELECT CASE(equations_set%SPECIFICATION(3))
125  SELECT CASE(solution_method)
127  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
129  CALL flagerror("Not implemented.",err,error,*999)
131  CALL flagerror("Not implemented.",err,error,*999)
133  CALL flagerror("Not implemented.",err,error,*999)
135  CALL flagerror("Not implemented.",err,error,*999)
137  CALL flagerror("Not implemented.",err,error,*999)
138  CASE DEFAULT
139  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
140  CALL flagerror(local_error,err,error,*999)
141  END SELECT
142  CASE DEFAULT
143  local_error="Equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
144  & " is not valid for a diffusion-diffusion equation type of a multi physics equations set class."
145  CALL flagerror(local_error,err,error,*999)
146  END SELECT
147  ELSE
148  CALL flagerror("Equations set is not associated.",err,error,*999)
149  ENDIF
150 
151  exits("DiffusionDiffusion_EquationsSetSolutionMethodSet")
152  RETURN
153 999 errors("DiffusionDiffusion_EquationsSetSolutionMethodSet",err,error)
154  exits("DiffusionDiffusion_EquationsSetSolutionMethodSet")
155  RETURN 1
156 
158 
159  !
160  !================================================================================================================================
161  !
162 
164  SUBROUTINE diffusion_diffusion_equations_set_setup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
166  !Argument variables
167  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
168  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
169  INTEGER(INTG), INTENT(OUT) :: ERR
170  TYPE(varying_string), INTENT(OUT) :: ERROR
171  !Local Variables
172 
173  enters("DIFFUSION_DIFFUSION_EQUATIONS_SET_SETUP",err,error,*999)
174 
175  CALL flagerror("Not implemented.",err,error,*999)
176 
177  exits("DIFFUSION_DIFFUSION_EQUATIONS_SET_SETUP")
178  RETURN
179 999 errorsexits("DIFFUSION_DIFFUSION_EQUATIONS_SET_SETUP",err,error)
180  RETURN 1
181 
183 
184  !
185  !================================================================================================================================
186  !
187 
189  SUBROUTINE diffusiondiffusion_finiteelementcalculate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
191  !Argument variables
192  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
193  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
194  INTEGER(INTG), INTENT(OUT) :: ERR
195  TYPE(varying_string), INTENT(OUT) :: ERROR
196  !Local Variables
197 
198  enters("DiffusionDiffusion_FiniteElementCalculate",err,error,*999)
199 
200  CALL flagerror("Not implemented.",err,error,*999)
201 
202  exits("DiffusionDiffusion_FiniteElementCalculate")
203  RETURN
204 999 errorsexits("DiffusionDiffusion_FiniteElementCalculate",err,error)
205  RETURN 1
206 
208 
209  !
210  !================================================================================================================================
211  !
212 
214  SUBROUTINE diffusiondiffusion_equationssetspecificationset(equationsSet,specification,err,error,*)
216  !Argument variables
217  TYPE(equations_set_type), POINTER :: equationsSet
218  INTEGER(INTG), INTENT(IN) :: specification(:)
219  INTEGER(INTG), INTENT(OUT) :: err
220  TYPE(varying_string), INTENT(OUT) :: error
221 
222  enters("DiffusionDiffusion_EquationsSetSpecificationSet",err,error,*999)
223 
224  CALL flagerror("Not implemented.",err,error,*999)
225 
226  exits("DiffusionDiffusion_EquationsSetSpecificationSet")
227  RETURN
228 999 errors("DiffusionDiffusion_EquationsSetSpecificationSet",err,error)
229  exits("DiffusionDiffusion_EquationsSetSpecificationSet")
230  RETURN 1
231 
233 
234  !
235  !================================================================================================================================
236  !
237 
239  SUBROUTINE diffusiondiffusion_problemspecificationset(problem,problemSpecification,err,error,*)
241  !Argument variables
242  TYPE(problem_type), POINTER :: problem
243  INTEGER(INTG), INTENT(IN) :: problemSpecification(:)
244  INTEGER(INTG), INTENT(OUT) :: err
245  TYPE(varying_string), INTENT(OUT) :: error
246  !Local Variables
247  TYPE(varying_string) :: localError
248  INTEGER(INTG) :: problemSubtype
249 
250  enters("DiffusionDiffusion_ProblemSpecificationSet",err,error,*999)
251 
252  IF(ASSOCIATED(problem)) THEN
253  IF(SIZE(problemspecification,1)==3) THEN
254  problemsubtype=problemspecification(3)
255  SELECT CASE(problemsubtype)
257  !ok
258  CASE DEFAULT
259  localerror="The third problem specification of "//trim(numbertovstring(problemsubtype,"*",err,error))// &
260  & " is not valid for a coupled diffusion-diffusion type of a multi physics problem."
261  CALL flagerror(localerror,err,error,*999)
262  END SELECT
263  IF(ALLOCATED(problem%specification)) THEN
264  CALL flagerror("Problem specification is already allocated.",err,error,*999)
265  ELSE
266  ALLOCATE(problem%specification(3),stat=err)
267  IF(err/=0) CALL flagerror("Could not allocate problem specification.",err,error,*999)
268  END IF
270  & problemsubtype]
271  ELSE
272  CALL flagerror("Diffusion-diffusion problem specification must have three elements.",err,error,*999)
273  END IF
274  ELSE
275  CALL flagerror("Problem is not associated.",err,error,*999)
276  END IF
277 
278  exits("DiffusionDiffusion_ProblemSpecificationSet")
279  RETURN
280 999 errors("DiffusionDiffusion_ProblemSpecificationSet",err,error)
281  exits("DiffusionDiffusion_ProblemSpecificationSet")
282  RETURN 1
283 
285 
286  !
287  !================================================================================================================================
288  !
289 
291  SUBROUTINE diffusion_diffusion_problem_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
293  !Argument variables
294  TYPE(problem_type), POINTER :: PROBLEM
295  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
296  INTEGER(INTG), INTENT(OUT) :: ERR
297  TYPE(varying_string), INTENT(OUT) :: ERROR
298  !Local Variables
299  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT
300  TYPE(solver_type), POINTER :: SOLVER_DIFFUSION_ONE, SOLVER_DIFFUSION_TWO
301  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS_DIFFUSION_ONE, SOLVER_EQUATIONS_DIFFUSION_TWO
302  TYPE(solvers_type), POINTER :: SOLVERS
303  TYPE(varying_string) :: LOCAL_ERROR
304 
305  enters("DIFFUSION_DIFFUSION_PROBLEM_SETUP",err,error,*999)
306 
307  NULLIFY(control_loop)
308  NULLIFY(solvers)
309  NULLIFY(solver_diffusion_one)
310  NULLIFY(solver_diffusion_two)
311  NULLIFY(solver_equations_diffusion_one)
312  NULLIFY(solver_equations_diffusion_two)
313  IF(ASSOCIATED(problem)) THEN
314  IF(.NOT.ALLOCATED(problem%specification)) THEN
315  CALL flagerror("Problem specification is not allocated.",err,error,*999)
316  ELSE IF(SIZE(problem%specification,1)<3) THEN
317  CALL flagerror("Problem specification must have three entries for a diffusion-diffusion problem.", &
318  & err,error,*999)
319  END IF
320  SELECT CASE(problem%SPECIFICATION(3))
321 
322  !--------------------------------------------------------------------
323  ! coupled source diffusion-diffusion
324  !--------------------------------------------------------------------
326  SELECT CASE(problem_setup%SETUP_TYPE)
328  SELECT CASE(problem_setup%ACTION_TYPE)
330  !Do nothing????
332  !Do nothing???
333  CASE DEFAULT
334  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
335  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
336  & " is invalid for a diffusion-diffusion equation."
337  CALL flagerror(local_error,err,error,*999)
338  END SELECT
340  SELECT CASE(problem_setup%ACTION_TYPE)
342  !Set up a time control loop
343  CALL control_loop_create_start(problem,control_loop,err,error,*999)
344  CALL control_loop_type_set(control_loop,problem_control_time_loop_type,err,error,*999)
346  !Finish the control loops
347  control_loop_root=>problem%CONTROL_LOOP
348  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
349  CALL control_loop_create_finish(control_loop,err,error,*999)
350  CASE DEFAULT
351  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
352  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
353  & " is invalid for a coupled diffusion-diffusion equation."
354  CALL flagerror(local_error,err,error,*999)
355  END SELECT
357  !Get the control loop
358  control_loop_root=>problem%CONTROL_LOOP
359  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
360  SELECT CASE(problem_setup%ACTION_TYPE)
362  !Start the solvers creation
363  CALL solvers_create_start(control_loop,solvers,err,error,*999)
364  CALL solvers_number_set(solvers,2,err,error,*999)
365  !
366  !Set the first solver to be a linear solver for the diffusion_one problem
367  CALL solvers_solver_get(solvers,1,solver_diffusion_one,err,error,*999)
368  CALL solver_type_set(solver_diffusion_one,solver_dynamic_type,err,error,*999)
369  CALL solver_dynamic_order_set(solver_diffusion_one,solver_dynamic_first_order,err,error,*999)
370  !Set solver defaults
371  CALL solver_dynamic_degree_set(solver_diffusion_one,solver_dynamic_first_degree,err,error,*999)
372  CALL solver_dynamic_scheme_set(solver_diffusion_one,solver_dynamic_crank_nicolson_scheme,err,error,*999)
373  CALL solver_library_type_set(solver_diffusion_one,solver_cmiss_library,err,error,*999)
374  !
375  !Set the second solver to be a linear solver for the diffusion_one problem
376  CALL solvers_solver_get(solvers,2,solver_diffusion_two,err,error,*999)
377  CALL solver_type_set(solver_diffusion_two,solver_dynamic_type,err,error,*999)
378  CALL solver_dynamic_order_set(solver_diffusion_two,solver_dynamic_first_order,err,error,*999)
379  !Set solver defaults
380  CALL solver_dynamic_degree_set(solver_diffusion_two,solver_dynamic_first_degree,err,error,*999)
381  CALL solver_dynamic_scheme_set(solver_diffusion_two,solver_dynamic_crank_nicolson_scheme,err,error,*999)
382  CALL solver_library_type_set(solver_diffusion_two,solver_cmiss_library,err,error,*999)
383  !
385  !Get the solvers
386  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
387  !Finish the solvers creation
388  CALL solvers_create_finish(solvers,err,error,*999)
389  CASE DEFAULT
390  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
391  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
392  & " is invalid for a couple diffusion-diffusion equation."
393  CALL flagerror(local_error,err,error,*999)
394  END SELECT
396  SELECT CASE(problem_setup%ACTION_TYPE)
398  !Get the control loop and solvers
399  control_loop_root=>problem%CONTROL_LOOP
400  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
401  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
402  !
403  !Get the diffusion_one solver and create the diffusion_one solver equations
404  CALL solvers_solver_get(solvers,1,solver_diffusion_one,err,error,*999)
405  CALL solver_equations_create_start(solver_diffusion_one,solver_equations_diffusion_one,err,error,*999)
406  CALL solver_equations_linearity_type_set(solver_equations_diffusion_one,solver_equations_linear,err,error,*999)
407  CALL solver_equations_time_dependence_type_set(solver_equations_diffusion_one, &
408  & solver_equations_first_order_dynamic,err,error,*999)
409  CALL solver_equations_sparsity_type_set(solver_equations_diffusion_one,solver_sparse_matrices,err,error,*999)
410  !
411  !Get the diffusion_two solver and create the diffusion_two solver equations
412  CALL solvers_solver_get(solvers,2,solver_diffusion_two,err,error,*999)
413  CALL solver_equations_create_start(solver_diffusion_two,solver_equations_diffusion_two,err,error,*999)
414  CALL solver_equations_linearity_type_set(solver_equations_diffusion_two,solver_equations_linear,err,error,*999)
415  CALL solver_equations_time_dependence_type_set(solver_equations_diffusion_two, &
416  & solver_equations_first_order_dynamic,err,error,*999)
417  CALL solver_equations_sparsity_type_set(solver_equations_diffusion_two,solver_sparse_matrices,err,error,*999)
418  !
419 
421  !Get the control loop
422  control_loop_root=>problem%CONTROL_LOOP
423  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
424  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
425  !
426  !Finish the creation of the diffusion_one solver equations
427  CALL solvers_solver_get(solvers,1,solver_diffusion_one,err,error,*999)
428  CALL solver_solver_equations_get(solver_diffusion_one,solver_equations_diffusion_one,err,error,*999)
429  CALL solver_equations_create_finish(solver_equations_diffusion_one,err,error,*999)
430  !
431  !Finish the creation of the diffusion_two solver equations
432  CALL solvers_solver_get(solvers,2,solver_diffusion_two,err,error,*999)
433  CALL solver_solver_equations_get(solver_diffusion_two,solver_equations_diffusion_two,err,error,*999)
434  CALL solver_equations_create_finish(solver_equations_diffusion_two,err,error,*999)
435  !
436 
437  CASE DEFAULT
438  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
439  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
440  & " is invalid for a coupled diffusion-diffusion equation."
441  CALL flagerror(local_error,err,error,*999)
442  END SELECT
443  CASE DEFAULT
444  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
445  & " is invalid for a coupled diffusion-diffusion equation."
446  CALL flagerror(local_error,err,error,*999)
447  END SELECT
448 
449  !-----------------------------------------------------------------
450  ! c a s e d e f a u l t
451  !-----------------------------------------------------------------
452  CASE DEFAULT
453  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
454  & " does not equal a coupled source diffusion-diffusion equation subtype."
455  CALL flagerror(local_error,err,error,*999)
456 
457  END SELECT
458  ELSE
459  CALL flagerror("Problem is not associated.",err,error,*999)
460  ENDIF
461 
462  exits("DIFFUSION_DIFFUSION_PROBLEM_SETUP")
463  RETURN
464 999 errorsexits("DIFFUSION_DIFFUSION_PROBLEM_SETUP",err,error)
465  RETURN 1
466  END SUBROUTINE diffusion_diffusion_problem_setup
467 
468  !
469  !================================================================================================================================
470  !
471 
473  SUBROUTINE diffusion_diffusion_pre_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
475  !Argument variables
476  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
477  TYPE(solver_type), POINTER :: SOLVER
478  INTEGER(INTG), INTENT(OUT) :: ERR
479  TYPE(varying_string), INTENT(OUT) :: ERROR
480 
481  !Local Variables
482  TYPE(varying_string) :: LOCAL_ERROR
483 
484 
485  enters("DIFFUSION_DIFFUSION_PRE_SOLVE",err,error,*999)
486 
487  IF(ASSOCIATED(control_loop)) THEN
488  IF(ASSOCIATED(solver)) THEN
489  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
490  IF(.NOT.ALLOCATED(control_loop%problem%specification)) THEN
491  CALL flagerror("Problem specification is not allocated.",err,error,*999)
492  ELSE IF(SIZE(control_loop%problem%specification,1)<3) THEN
493  CALL flagerror("Problem specification must have three entries for a diffusion-diffusion problem.", &
494  & err,error,*999)
495  END IF
496  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
498 
499  IF(solver%GLOBAL_NUMBER==1) THEN
500  !copy current value of concentration_one to another variable
501  CALL diffusion_presolvestorecurrentsolution(control_loop,solver,err,error,*999)
502  !Set source term to be updated value of concentration_two
503  CALL diffusion_presolvegetsourcevalue(control_loop,solver,err,error,*999)
504  ELSE IF(solver%GLOBAL_NUMBER==2) THEN
505  !compute value of constant source term - evaluated from lamdba*(0.5*(c_1^{t+1}+c_1^{t}) - c_2^{t})
506  !CALL Diffusion_PreSolveGetSourceValue(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
507  ENDIF
508  CASE DEFAULT
509  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
510  & " is not valid for a diffusion type of a multi physics problem class."
511  CALL flagerror(local_error,err,error,*999)
512  END SELECT
513  ELSE
514  CALL flagerror("Problem is not associated.",err,error,*999)
515  ENDIF
516  ELSE
517  CALL flagerror("Solver is not associated.",err,error,*999)
518  ENDIF
519  ELSE
520  CALL flagerror("Control loop is not associated.",err,error,*999)
521  ENDIF
522 
523  exits("DIFFUSION_DIFFUSION_PRE_SOLVE")
524  RETURN
525 999 errorsexits("DIFFUSION_DIFFUSION_PRE_SOLVE",err,error)
526  RETURN 1
527  END SUBROUTINE diffusion_diffusion_pre_solve
528 
529  !
530  !================================================================================================================================
531  !
532 
534  SUBROUTINE diffusion_diffusion_post_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
536  !Argument variables
537  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
538  TYPE(solver_type), POINTER :: SOLVER
539  INTEGER(INTG), INTENT(OUT) :: ERR
540  TYPE(varying_string), INTENT(OUT) :: ERROR
541 
542  !Local Variables
543  TYPE(varying_string) :: LOCAL_ERROR
544 
545  enters("DIFFUSION_DIFFUSION_POST_SOLVE",err,error,*999)
546 
547  IF(ASSOCIATED(control_loop)) THEN
548  IF(ASSOCIATED(solver)) THEN
549  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
550  IF(.NOT.ALLOCATED(control_loop%problem%specification)) THEN
551  CALL flagerror("Problem specification is not allocated.",err,error,*999)
552  ELSE IF(SIZE(control_loop%problem%specification,1)<3) THEN
553  CALL flagerror("Problem specification must have three entries for a diffusion-diffusion problem.", &
554  & err,error,*999)
555  END IF
556  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
558  IF(solver%GLOBAL_NUMBER==1) THEN
559 ! CALL DIFFUSION_EQUATION_POST_SOLVE_EVALUATE_SOURCE(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
560 ! CALL DIFFUSION_EQUATION_POST_SOLVE_COPY_SOURCE(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
561  ELSE IF(solver%GLOBAL_NUMBER==2) THEN
562  !do nothing?!
563  ENDIF
564  CASE DEFAULT
565  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
566  & " is not valid for a diffusion-diffusion type of a multi physics problem class."
567  CALL flagerror(local_error,err,error,*999)
568  END SELECT
569  ELSE
570  CALL flagerror("Problem is not associated.",err,error,*999)
571  ENDIF
572  ELSE
573  CALL flagerror("Solver is not associated.",err,error,*999)
574  ENDIF
575  ELSE
576  CALL flagerror("Control loop is not associated.",err,error,*999)
577  ENDIF
578 
579  exits("DIFFUSION_DIFFUSION_POST_SOLVE")
580  RETURN
581 999 errorsexits("DIFFUSION_DIFFUSION_POST_SOLVE",err,error)
582  RETURN 1
583  END SUBROUTINE diffusion_diffusion_post_solve
584 
585  !
586  !================================================================================================================================
587  !
588 
590  SUBROUTINE diffusion_diffusion_post_solve_output_data(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
592  !Argument variables
593  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
594  TYPE(solver_type), POINTER :: SOLVER
595  INTEGER(INTG), INTENT(OUT) :: ERR
596  TYPE(varying_string), INTENT(OUT) :: ERROR
597 
598  !Local Variables
599  TYPE(varying_string) :: LOCAL_ERROR
600 
601  enters("DIFFUSION_DIFFUSION_POST_SOLVE_OUTPUT_DATA",err,error,*999)
602 
603  IF(ASSOCIATED(control_loop)) THEN
604  IF(ASSOCIATED(solver)) THEN
605  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
606  IF(.NOT.ALLOCATED(control_loop%problem%specification)) THEN
607  CALL flagerror("Problem specification is not allocated.",err,error,*999)
608  ELSE IF(SIZE(control_loop%problem%specification,1)<3) THEN
609  CALL flagerror("Problem specification must have three entries for a diffusion-diffusion problem.", &
610  & err,error,*999)
611  END IF
612  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
614  !CALL DIFFUSION_EQUATION_POST_SOLVE_OUTPUT_DATA(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
615  CASE DEFAULT
616  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
617  & " is not valid for a diffusion type of a multi physics problem class."
618  CALL flagerror(local_error,err,error,*999)
619  END SELECT
620  ELSE
621  CALL flagerror("Problem is not associated.",err,error,*999)
622  ENDIF
623  ELSE
624  CALL flagerror("Solver is not associated.",err,error,*999)
625  ENDIF
626  ELSE
627  CALL flagerror("Control loop is not associated.",err,error,*999)
628  ENDIF
629 
630  exits("DIFFUSION_DIFFUSION_POST_SOLVE_OUTPUT_DATA")
631  RETURN
632 999 errorsexits("DIFFUSION_DIFFUSION_POST_SOLVE_OUTPUT_DATA",err,error)
633  RETURN 1
635 
636  !
637  !================================================================================================================================
638  !
639 
640 
integer(intg), parameter equations_set_fem_solution_method
Finite Element Method solution method.
This module contains all basis function routines.
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
subroutine, public solvers_create_finish(SOLVERS, ERR, ERROR,)
Finish the creation of solvers.
integer(intg), parameter problem_diffusion_diffusion_type
This module contains all coordinate transformation and support routines.
integer(intg), parameter equations_set_gfem_solution_method
Grid-based Finite Element Method solution method.
integer(intg), parameter problem_control_time_loop_type
Time control loop.
integer(intg), parameter equations_set_coupled_source_diffusion_diffusion_subtype
integer(intg), parameter problem_setup_control_type
Solver setup for a problem.
This module handles all problem wide constants.
integer(intg), parameter solver_equations_first_order_dynamic
Solver equations are first order dynamic.
integer(intg), parameter, public control_loop_node
The identifier for a each "leaf" node in a control loop.
subroutine, public solver_dynamic_order_set(SOLVER, ORDER, ERR, ERROR,)
Sets/changes the order for a dynamic solver.
integer(intg), parameter problem_coupled_source_diffusion_diffusion_subtype
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
subroutine, public diffusion_diffusion_pre_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the diffusion-diffusion problem pre-solve.
Contains information on the type of solver to be used.
Definition: types.f90:2777
subroutine, public solvers_number_set(SOLVERS, NUMBER_OF_SOLVERS, ERR, ERROR,)
Sets/changes the number of solvers.
integer(intg), parameter, public solver_dynamic_crank_nicolson_scheme
Crank-Nicolson dynamic solver.
subroutine, public solver_dynamic_degree_set(SOLVER, DEGREE, ERR, ERROR,)
Sets/changes the degree of the polynomial used to interpolate time for a dynamic solver.
This module handles all equations matrix and rhs routines.
integer(intg), parameter, public solver_dynamic_first_order
Dynamic solver has first order terms.
subroutine, public solver_type_set(SOLVER, SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type for a solver.
Contains information on an equations set.
Definition: types.f90:1941
This module handles all equations routines.
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
subroutine, public solvers_create_start(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Start the creation of a solvers for the control loop.
Contains information on the solvers to be used in a control loop.
Definition: types.f90:2805
subroutine, public diffusiondiffusion_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for a coupled diffusion-diffusion equation type of a multi physics eq...
This module contains routines for timing the program.
Definition: timer_f.f90:45
subroutine, public solver_equations_sparsity_type_set(SOLVER_EQUATIONS, SPARSITY_TYPE, ERR, ERROR,)
Sets/changes the sparsity type for solver equations.
This module contains all mathematics support routines.
Definition: maths.f90:45
subroutine, public solvers_solver_get(SOLVERS, SOLVER_INDEX, SOLVER, ERR, ERROR,)
Returns a pointer to the specified solver in the list of solvers.
integer(intg), parameter solver_equations_linear
Solver equations are linear.
Contains information on a control loop.
Definition: types.f90:3185
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
subroutine, public solver_equations_create_finish(SOLVER_EQUATIONS, ERR, ERROR,)
Finishes the process of creating solver equations.
integer(intg), parameter, public solver_sparse_matrices
Use sparse solver matrices.
subroutine, public solver_equations_create_start(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Starts the process of creating solver equations.
This module handles all routines pertaining to diffusion coupled to diffusion.
integer(intg), parameter, public solver_dynamic_type
A dynamic solver.
integer(intg), parameter problem_setup_solvers_type
Solver setup for a problem.
This module contains all program wide constants.
Definition: constants.f90:45
subroutine, public solver_library_type_set(SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library type to use for the solver.
subroutine, public diffusiondiffusion_equationssetsolutionmethodset(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for a diffusion-diffusion equation type of a multi physics equations...
integer(intg), parameter problem_setup_initial_type
Initial setup for a problem.
subroutine, public diffusion_diffusion_post_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the diffusion-diffusion problem post solve.
subroutine, public solver_equations_linearity_type_set(SOLVER_EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for solver equations.
subroutine, public exits(NAME)
Records the exit out of the named procedure.
recursive subroutine, public control_loop_solvers_get(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Returns a pointer to the solvers for a control loop.
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
subroutine, public diffusion_diffusion_equations_set_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the diffusion-diffusion coupled equation.
Returns the specified control loop as indexed by the control loop identifier from the control loop ro...
subroutine, public control_loop_type_set(CONTROL_LOOP, LOOP_TYPE, ERR, ERROR,)
Sets/changes the control loop type.
integer(intg), parameter problem_multi_physics_class
subroutine, public diffusion_presolvegetsourcevalue(CONTROL_LOOP, SOLVER, ERR, ERROR,)
subroutine, public diffusion_diffusion_problem_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the coupled diffusion-diffusion equations problem.
subroutine, public diffusiondiffusion_finiteelementcalculate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element stiffness matrices and RHS for a coupled diffusion-diffusion equation finite e...
subroutine, public diffusion_presolvestorecurrentsolution(CONTROL_LOOP, SOLVER, ERR, ERROR,)
This module handles all domain mappings routines.
integer(intg), parameter problem_setup_finish_action
Finish setup action.
This module handles all equations mapping routines.
Contains information about the solver equations for a solver.
Definition: types.f90:2452
integer(intg), parameter equations_set_gfv_solution_method
Grid-based Finite Volume solution method.
Contains information for a problem.
Definition: types.f90:3221
This module handles all distributed matrix vector routines.
subroutine, public diffusiondiffusion_problemspecificationset(problem, problemSpecification, err, error,)
Sets the problem specification for a coupled diffusion-diffusion equation type.
This module handles all boundary conditions routines.
This module handles all solver routines.
This module contains all routines dealing with (non-distributed) matrix and vectors types...
subroutine, public control_loop_create_start(PROBLEM, CONTROL_LOOP, ERR, ERROR,)
Start the process of creating a control loop for a problem.
integer(intg), parameter problem_setup_solver_equations_type
Solver equations setup for a problem.
subroutine, public solver_dynamic_scheme_set(SOLVER, SCHEME, ERR, ERROR,)
Sets/changes the scheme for a dynamic solver.
integer(intg), parameter equations_set_fd_solution_method
Finite Difference solution method.
Contains information on the setup information for an equations set.
Definition: types.f90:1866
integer(intg), parameter problem_setup_start_action
Start setup action.
subroutine, public solver_equations_time_dependence_type_set(SOLVER_EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for solver equations.
This module handles all control loop routines.
integer(intg), parameter, public solver_cmiss_library
CMISS (internal) solver library.
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
This module defines all constants shared across equations set routines.
integer(intg), parameter equations_set_bem_solution_method
Boundary Element Method solution method.
subroutine diffusion_diffusion_post_solve_output_data(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the diffuion-diffusion problem post solve output data.
subroutine, public solver_solver_equations_get(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Returns a pointer to the solver equations for a solver.
integer(intg), parameter equations_set_fv_solution_method
Finite Volume solution method.
integer(intg), parameter, public solver_dynamic_first_degree
Dynamic solver uses a first degree polynomial for time interpolation.
recursive subroutine, public control_loop_create_finish(CONTROL_LOOP, ERR, ERROR,)
Finish the process of creating a control loop.
Flags an error condition.
This module handles all diffusion equation routines.
This module contains all kind definitions.
Definition: kinds.f90:45
Temporary IO routines for fluid mechanics.
This module handles all formating and input and output.