OpenCMISS-Iron Internal API Documentation
fluid_mechanics_routines.f90
Go to the documentation of this file.
1 
48 
51 
53  USE base_routines
60  USE input_output
62  USE kinds
67  USE strings
69  USE types
70 
71 #include "macros.h"
72 
73 
74  IMPLICIT NONE
75 
76  PRIVATE
77 
78  !Module parameters
79 
80  !Module types
81 
82  !Module variables
83 
84  !Interfaces
85 
87 
89 
91 
93 
95 
97 
99 
101 
103 
105 
107 
109 
111 
112 CONTAINS
113 
114  !
115  !================================================================================================================================
116  !
117 
119  SUBROUTINE fluid_mechanics_analytic_functions_evaluate(EQUATIONS_SET,ANALYTIC_FUNCTION_TYPE,POSITION,TANGENTS, &
120  & normal,time,variable_type,global_derivative,component_number,analytic_parameters,materials_parameters,VALUE,err,error,*)
122  !Argument variables
123  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
124  INTEGER(INTG), INTENT(IN) :: ANALYTIC_FUNCTION_TYPE
125  REAL(DP), INTENT(IN) :: POSITION(:)
126  REAL(DP), INTENT(IN) :: TANGENTS(:,:)
127  REAL(DP), INTENT(IN) :: NORMAL(:)
128  REAL(DP), INTENT(IN) :: TIME
129  INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
130  INTEGER(INTG), INTENT(IN) :: GLOBAL_DERIVATIVE
131  INTEGER(INTG), INTENT(IN) :: COMPONENT_NUMBER
132  REAL(DP), INTENT(IN) :: ANALYTIC_PARAMETERS(:)
133  REAL(DP), INTENT(IN) :: MATERIALS_PARAMETERS(:)
134  REAL(DP), INTENT(OUT) :: VALUE
135  INTEGER(INTG), INTENT(OUT) :: ERR
136  TYPE(varying_string), INTENT(OUT) :: ERROR
137  !Local Variables
138  TYPE(varying_string) :: LOCAL_ERROR
139 
140  enters("FLUID_MECHANICS_ANALYTIC_FUNCTIONS_EVALUATE",err,error,*999)
141 
142  IF(ASSOCIATED(equations_set)) THEN
143  SELECT CASE(equations_set%specification(2))
145  CALL flagerror("Not implemented.",err,error,*999)
147  CALL flagerror("Not implemented.",err,error,*999)
149  CALL flagerror("Not implemented.",err,error,*999)
151  CALL flagerror("Not implemented.",err,error,*999)
153  CALL flagerror("Not implemented.",err,error,*999)
155  CALL burgers_analyticfunctionsevaluate(equations_set,analytic_function_type,position, &
156  & tangents,normal,time,variable_type,global_derivative,component_number,analytic_parameters, &
157  & materials_parameters,VALUE,err,error,*999)
159  CALL flagerror("Not implemented.",err,error,*999)
160  CASE DEFAULT
161  local_error="The second equations set specification of "// &
162  & trim(number_to_vstring(equations_set%specification(2),"*",err,error))// &
163  & " is not valid for a fluid mechanics equations set."
164  CALL flagerror(local_error,err,error,*999)
165  END SELECT
166  ELSE
167  CALL flagerror("Equations set is not associated.",err,error,*999)
168  ENDIF
169 
170  exits("FLUID_MECHANICS_ANALYTIC_FUNCTIONS_EVALUATE")
171  RETURN
172 999 errorsexits("FLUID_MECHANICS_ANALYTIC_FUNCTIONS_EVALUATE",err,error)
173  RETURN 1
174 
176 
177  !
178  !================================================================================================================================
179  !
180 
182  SUBROUTINE fluidmechanics_equationssetspecificationset(equationsSet,specification,err,error,*)
184  !Argument variables
185  TYPE(equations_set_type), POINTER :: equationsSet
186  INTEGER(INTG), INTENT(IN) :: specification(:)
187  INTEGER(INTG), INTENT(OUT) :: err
188  TYPE(varying_string), INTENT(OUT) :: error
189  !Local Variables
190  TYPE(varying_string) :: localError
191 
192  enters("FluidMechanics_EquationsSetSpecificationSet",err,error,*999)
193 
194  IF(ASSOCIATED(equationsset)) THEN
195  IF(SIZE(specification,1)<2) THEN
196  CALL flagerror("Equations set specification must have at least two entries for a fluid mechanics equations set.", &
197  & err,error,*999)
198  END IF
199  SELECT CASE(specification(2))
201  CALL stokes_equationssetspecificationset(equationsset,specification,err,error,*999)
203  CALL navierstokes_equationssetspecificationset(equationsset,specification,err,error,*999)
205  CALL darcy_equationssetspecificationset(equationsset,specification,err,error,*999)
207  CALL darcypressure_equationssetspecificationset(equationsset,specification,err,error,*999)
209  CALL poiseuille_equationssetspecificationset(equationsset,specification,err,error,*999)
211  CALL burgers_equationssetspecificationset(equationsset,specification,err,error,*999)
213  CALL characteristic_equationssetspecificationset(equationsset,specification,err,error,*999)
215  CALL stree_equationssetspecificationset(equationsset,specification,err,error,*999)
216  CASE DEFAULT
217  localerror="The second equations set specification of "//trim(numbertovstring(specification(2),"*",err,error))// &
218  & " is not valid for a fluid mechanics equations set."
219  CALL flagerror(localerror,err,error,*999)
220  END SELECT
221  ELSE
222  CALL flagerror("Equations set is not associated.",err,error,*999)
223  END IF
224 
225  exits("FluidMechanics_EquationsSetSpecificationSet")
226  RETURN
227 999 errors("FluidMechanics_EquationsSetSpecificationSet",err,error)
228  exits("FluidMechanics_EquationsSetSpecificationSet")
229  RETURN 1
230 
232 
233  !
234  !================================================================================================================================
235  !
236 
238  SUBROUTINE fluid_mechanics_finite_element_calculate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
240  !Argument variables
241  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
242  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
243  INTEGER(INTG), INTENT(OUT) :: ERR
244  TYPE(varying_string), INTENT(OUT) :: ERROR
245  !Local Variables
246  TYPE(varying_string) :: LOCAL_ERROR
247 
248  enters("FLUID_MECHANICS_FINITE_ELEMENT_CALCULATE",err,error,*999)
249 
250  IF(ASSOCIATED(equations_set)) THEN
251  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
252  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
253  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<2) THEN
254  CALL flagerror("Equations set specification must have at least two entries for a fluid mechanics class equations set.", &
255  & err,error,*999)
256  END IF
257  SELECT CASE(equations_set%SPECIFICATION(2))
259  CALL stokes_finite_element_calculate(equations_set,element_number,err,error,*999)
261  CALL flagerror("There are no finite element matrices to be calculated for Navier-Stokes equation.",err,error,*999)
263  CALL darcy_equation_finite_element_calculate(equations_set,element_number,err,error,*999)
265  CALL flagerror("There is no element stiffness matrix to be calculated for Darcy pressure.",err,error,*999)
267  CALL poiseuille_finiteelementcalculate(equations_set,element_number,err,error,*999)
269  CALL flagerror("There are no finite element matrices to be calculated for Burgers equation.",err,error,*999)
271  CALL flagerror("There are no finite element matrices to be calculated for Characteristic equations.",err,error,*999)
273  CALL stree_finite_element_calculate(equations_set,element_number,err,error,*999)
274  CASE DEFAULT
275  local_error="Equations set type "//trim(number_to_vstring(equations_set%SPECIFICATION(2),"*",err,error))// &
276  & " is not valid for a fluid mechanics equation set class."
277  CALL flagerror(local_error,err,error,*999)
278  END SELECT
279  ELSE
280  CALL flagerror("Equations set is not associated",err,error,*999)
281  ENDIF
282 
283  exits("FLUID_MECHANICS_FINITE_ELEMENT_CALCULATE")
284  RETURN
285 999 errorsexits("FLUID_MECHANICS_FINITE_ELEMENT_CALCULATE",err,error)
286  RETURN 1
288 
289  !
290  !================================================================================================================================
291  !
292 
294  SUBROUTINE fluidmechanics_finiteelementjacobianevaluate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
296  !Argument variables
297  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
298  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
299  INTEGER(INTG), INTENT(OUT) :: ERR
300  TYPE(varying_string), INTENT(OUT) :: ERROR
301  !Local Variables
302  TYPE(varying_string) :: LOCAL_ERROR
303 
304  enters("FluidMechanics_FiniteElementJacobianEvaluate",err,error,*999)
305 
306  IF(ASSOCIATED(equations_set)) THEN
307  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
308  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
309  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<2) THEN
310  CALL flagerror("Equations set specification must have at least two entries for a fluid mechanics class equations set.", &
311  & err,error,*999)
312  END IF
313  SELECT CASE(equations_set%SPECIFICATION(2))
315  CALL flagerror("There is no Jacobian to be evaluated for Stokes.",err,error,*999)
317  CALL navierstokes_finiteelementjacobianevaluate(equations_set,element_number,err,error,*999)
319  CALL flagerror("Not implemented.",err,error,*999)
321  CALL flagerror("Not implemented.",err,error,*999)
323  CALL flagerror("There is no Jacobian to be evaluated for Poiseuille.",err,error,*999)
325  CALL burgers_finiteelementjacobianevaluate(equations_set,element_number,err,error,*999)
327  CALL flagerror("Not implemented.",err,error,*999)
328  CASE DEFAULT
329  local_error="Equations set type "//trim(number_to_vstring(equations_set%SPECIFICATION(2),"*",err,error))// &
330  & " is not valid for a fluid mechanics equation set class."
331  CALL flagerror(local_error,err,error,*999)
332  END SELECT
333  ELSE
334  CALL flagerror("Equations set is not associated",err,error,*999)
335  ENDIF
336 
337  exits("FluidMechanics_FiniteElementJacobianEvaluate")
338  RETURN
339 999 errors("FluidMechanics_FiniteElementJacobianEvaluate",err,error)
340  exits("FluidMechanics_FiniteElementJacobianEvaluate")
341  RETURN 1
342 
344 
345  !
346  !================================================================================================================================
347  !
348 
350  SUBROUTINE fluidmechanics_finiteelementresidualevaluate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
352  !Argument variables
353  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
354  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
355  INTEGER(INTG), INTENT(OUT) :: ERR
356  TYPE(varying_string), INTENT(OUT) :: ERROR
357  !Local Variables
358  TYPE(varying_string) :: LOCAL_ERROR
359 
360  enters("FluidMechanics_FiniteElementResidualEvaluate",err,error,*999)
361 
362  IF(ASSOCIATED(equations_set)) THEN
363  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
364  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
365  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<2) THEN
366  CALL flagerror("Equations set specification must have at least two entries for a fluid mechanics class equations set.", &
367  & err,error,*999)
368  END IF
369  SELECT CASE(equations_set%SPECIFICATION(2))
371  CALL flagerror("There is no residual to be evaluated for Stokes.",err,error,*999)
373  CALL navierstokes_finiteelementresidualevaluate(equations_set,element_number,err,error,*999)
375  CALL flagerror("Not implemented.",err,error,*999)
377  CALL darcypressure_finiteelementresidualevaluate(equations_set,element_number,err,error,*999)
379  CALL flagerror("There is no residual to be evaluated for Poiseuille.",err,error,*999)
381  CALL burgers_finiteelementresidualevaluate(equations_set,element_number,err,error,*999)
383  CALL flagerror("Not implemented.",err,error,*999)
384  CASE DEFAULT
385  local_error="Equations set type "//trim(number_to_vstring(equations_set%SPECIFICATION(2),"*",err,error))// &
386  & " is not valid for a fluid mechanics equation set class."
387  CALL flagerror(local_error,err,error,*999)
388  END SELECT
389  ELSE
390  CALL flagerror("Equations set is not associated",err,error,*999)
391  ENDIF
392 
393  exits("FluidMechanics_FiniteElementResidualEvaluate")
394  RETURN
395 999 errors("FluidMechanics_FiniteElementResidualEvaluate",err,error)
396  exits("FluidMechanics_FiniteElementResidualEvaluate")
397  RETURN 1
398 
400 
401  !
402  !================================================================================================================================
403  !
404 
406  SUBROUTINE fluidmechanics_nodaljacobianevaluate(equationsSet,nodeNumber,err,error,*)
408  !Argument variables
409  TYPE(equations_set_type), POINTER :: equationsSet
410  INTEGER(INTG), INTENT(IN) :: nodeNumber
411  INTEGER(INTG), INTENT(OUT) :: err
412  TYPE(varying_string), INTENT(OUT) :: error
413  !Local Variables
414  TYPE(varying_string) :: localError
415 
416  enters("FluidMechanics_NodalJacobianEvaluate",err,error,*999)
417 
418  IF(ASSOCIATED(equationsset)) THEN
419  IF(.NOT.ALLOCATED(equationsset%specification)) THEN
420  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
421  ELSE IF(SIZE(equationsset%specification,1)<2) THEN
422  CALL flagerror("Equations set specification must have at least two entries for a fluid mechanics class equations set.", &
423  & err,error,*999)
424  END IF
425  SELECT CASE(equationsset%specification(2))
427  CALL flagerror("Not implemented.",err,error,*999)
429  CALL flagerror("Not implemented.",err,error,*999)
431  CALL flagerror("Not implemented.",err,error,*999)
433  CALL flagerror("Not implemented.",err,error,*999)
435  CALL flagerror("Not implemented.",err,error,*999)
437  CALL flagerror("Not implemented.",err,error,*999)
439  CALL characteristic_nodaljacobianevaluate(equationsset,nodenumber,err,error,*999)
440  CASE DEFAULT
441  localerror="Equations set type "//trim(number_to_vstring(equationsset%specification(2),"*",err,error))// &
442  & " is not valid for a fluid mechanics equation set class."
443  CALL flagerror(localerror,err,error,*999)
444  END SELECT
445  ELSE
446  CALL flagerror("Equations set is not associated",err,error,*999)
447  ENDIF
448 
449  exits("FluidMechanics_NodalJacobianEvaluate")
450  RETURN
451 999 errorsexits("FluidMechanics_NodalJacobianEvaluate",err,error)
452  RETURN 1
454 
455  !
456  !================================================================================================================================
457  !
458 
460  SUBROUTINE fluidmechanics_nodalresidualevaluate(equationsSet,nodeNumber,err,error,*)
462  !Argument variables
463  TYPE(equations_set_type), POINTER :: equationsSet
464  INTEGER(INTG), INTENT(IN) :: nodeNumber
465  INTEGER(INTG), INTENT(OUT) :: err
466  TYPE(varying_string), INTENT(OUT) :: error
467  !Local Variables
468  TYPE(varying_string) :: localError
469 
470  enters("FluidMechanics_NodalResidualEvaluate",err,error,*999)
471 
472  IF(ASSOCIATED(equationsset)) THEN
473  IF(.NOT.ALLOCATED(equationsset%specification)) THEN
474  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
475  ELSE IF(SIZE(equationsset%specification,1)<2) THEN
476  CALL flagerror("Equations set specification must have at least two entries for a fluid mechanics class equations set.", &
477  & err,error,*999)
478  END IF
479  SELECT CASE(equationsset%specification(2))
481  CALL flagerror("Not implemented.",err,error,*999)
483  CALL flagerror("Not implemented.",err,error,*999)
485  CALL flagerror("Not implemented.",err,error,*999)
487  CALL flagerror("Not implemented.",err,error,*999)
489  CALL flagerror("Not implemented.",err,error,*999)
491  CALL flagerror("Not implemented.",err,error,*999)
493  CALL characteristic_nodalresidualevaluate(equationsset,nodenumber,err,error,*999)
494  CASE DEFAULT
495  localerror="Equations set type "//trim(number_to_vstring(equationsset%specification(2),"*",err,error))// &
496  & " is not valid for a fluid mechanics equation set class."
497  CALL flagerror(localerror,err,error,*999)
498  END SELECT
499  ELSE
500  CALL flagerror("Equations set is not associated",err,error,*999)
501  ENDIF
502 
503  exits("FluidMechanics_NodalResidualEvaluate")
504  RETURN
505 999 errorsexits("FluidMechanics_NodalResidualEvaluate",err,error)
506  RETURN 1
508 
509  !
510  !================================================================================================================================
511  !
512 
514  SUBROUTINE fluid_mechanics_equations_set_setup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
516  !Argument variables
517  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
518  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
519  INTEGER(INTG), INTENT(OUT) :: ERR
520  TYPE(varying_string), INTENT(OUT) :: ERROR
521  !Local Variables
522  TYPE(varying_string) :: LOCAL_ERROR
523 
524  enters("FLUID_MECHANICS_EQUATIONS_SET_SETUP",err,error,*999)
525 
526  IF(ASSOCIATED(equations_set)) THEN
527  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
528  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
529  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<2) THEN
530  CALL flagerror("Equations set specification must have at least two entries for a fluid mechanics class equations set.", &
531  & err,error,*999)
532  END IF
533  SELECT CASE(equations_set%SPECIFICATION(2))
535  CALL stokes_equations_set_setup(equations_set,equations_set_setup,err,error,*999)
537  CALL navier_stokes_equations_set_setup(equations_set,equations_set_setup,err,error,*999)
539  CALL darcy_equation_equations_set_setup(equations_set,equations_set_setup,err,error,*999)
541  CALL darcy_pressure_equation_equations_set_setup(equations_set,equations_set_setup,err,error,*999)
543  CALL poiseuille_equation_equations_set_setup(equations_set,equations_set_setup,err,error,*999)
545  CALL burgers_equation_equations_set_setup(equations_set,equations_set_setup,err,error,*999)
547  CALL characteristic_equationssetsetup(equations_set,equations_set_setup,err,error,*999)
549  CALL stree_equationssetsetup(equations_set,equations_set_setup,err,error,*999)
550  CASE DEFAULT
551  local_error="Equation set type "//trim(number_to_vstring(equations_set%SPECIFICATION(2),"*",err,error))// &
552  & " is not valid for a fluid mechanics equation set class."
553  CALL flagerror(local_error,err,error,*999)
554  END SELECT
555  ELSE
556  CALL flagerror("Equations set is not associated.",err,error,*999)
557  ENDIF
558 
559  exits("FLUID_MECHANICS_EQUATIONS_SET_SETUP")
560  RETURN
561 999 errorsexits("FLUID_MECHANICS_EQUATIONS_SET_SETUP",err,error)
562  RETURN 1
564 
565 
566  !
567  !================================================================================================================================
568  !
569 
571  SUBROUTINE fluidmechanics_equationssetsolutionmethodset(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)
573  !Argument variables
574  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
575  INTEGER(INTG), INTENT(IN) :: SOLUTION_METHOD
576  INTEGER(INTG), INTENT(OUT) :: ERR
577  TYPE(varying_string), INTENT(OUT) :: ERROR
578  !Local Variables
579  TYPE(varying_string) :: LOCAL_ERROR
580 
581  enters("FLUID_MECHANICS_EQUATIONS_SOLUTION_METHOD_SET",err,error,*999)
582 
583  IF(ASSOCIATED(equations_set)) THEN
584  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
585  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
586  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<2) THEN
587  CALL flagerror("Equations set specification must have at least two entries for a fluid mechanics class equations set.", &
588  & err,error,*999)
589  END IF
590  SELECT CASE(equations_set%SPECIFICATION(2))
592  CALL stokes_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
594  CALL navierstokes_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
596  CALL darcypressure_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
598  CALL darcypressure_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
600  CALL poiseuille_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
602  CALL burgers_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
604  CALL characteristic_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
605  CASE DEFAULT
606  local_error="Equations set equation type of "//trim(number_to_vstring(equations_set%SPECIFICATION(2),"*",err,error))// &
607  & " is not valid for a fluid mechancis equations set class."
608  CALL flagerror(local_error,err,error,*999)
609  END SELECT
610  ELSE
611  CALL flagerror("Equations set is not associated.",err,error,*999)
612  ENDIF
613 
614  exits("FluidMechanics_EquationsSetSolutionMethodSet")
615  RETURN
616 999 errors("FluidMechanics_EquationsSetSolutionMethodSet",err,error)
617  exits("FluidMechanics_EquationsSetSolutionMethodSet")
618  RETURN 1
619 
621 
622  !
623  !================================================================================================================================
624  !
625 
627  SUBROUTINE fluidmechanics_boundaryconditionsanalyticcalculate(EQUATIONS_SET,BOUNDARY_CONDITIONS,ERR,ERROR,*)
629  !Argument variables
630  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
631  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
632  INTEGER(INTG), INTENT(OUT) :: ERR
633  TYPE(varying_string), INTENT(OUT) :: ERROR
634  !Local Variables
635  TYPE(varying_string) :: LOCAL_ERROR
636 
637  enters("FluidMechanics_BoundaryConditionsAnalyticCalculate",err,error,*999)
638 
639  IF(ASSOCIATED(equations_set)) THEN
640  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
641  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
642  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<2) THEN
643  CALL flagerror("Equations set specification must have at least two entries for a fluid mechanics class equations set.", &
644  & err,error,*999)
645  END IF
646  SELECT CASE(equations_set%SPECIFICATION(2))
648  CALL burgers_boundaryconditionsanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
650  CALL stokes_boundaryconditionsanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
652  CALL navierstokes_boundaryconditionsanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
654  CALL darcy_boundaryconditionsanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
656  CALL flagerror("Not implemented.",err,error,*999)
658  CALL poiseuille_boundaryconditionsanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
660  CALL flagerror("Not implemented.",err,error,*999)
661  CASE DEFAULT
662  local_error="Equations set equation type of "//trim(number_to_vstring(equations_set%SPECIFICATION(2),"*",err,error))// &
663  & " is not valid for a fluid mechanics equations set class."
664  CALL flagerror(local_error,err,error,*999)
665  END SELECT
666  ELSE
667  CALL flagerror("Equations set is not associated",err,error,*999)
668  ENDIF
669 
670  exits("FluidMechanics_BoundaryConditionsAnalyticCalculate")
671  RETURN
672 999 errors("FluidMechanics_BoundaryConditionsAnalyticCalculate",err,error)
673  exits("FluidMechanics_BoundaryConditionsAnalyticCalculate")
674  RETURN 1
675 
677 
678  !
679  !================================================================================================================================
680  !
681 
683  SUBROUTINE fluidmechanics_problemspecificationset(problem,problemSpecification,err,error,*)
685  !Argument variables
686  TYPE(problem_type), POINTER :: problem
687  INTEGER(INTG), INTENT(IN) :: problemSpecification(:)
688  INTEGER(INTG), INTENT(OUT) :: err
689  TYPE(varying_string), INTENT(OUT) :: error
690  !Local Variables
691  TYPE(varying_string) :: localError
692  INTEGER(INTG) :: problemType
693 
694  enters("FluidMechanics_ProblemSpecificationSet",err,error,*999)
695 
696  IF(ASSOCIATED(problem)) THEN
697  IF(SIZE(problemspecification,1)>=2) THEN
698  problemtype=problemspecification(2)
699  SELECT CASE(problemtype)
701  CALL stokes_problemspecificationset(problem,problemspecification,err,error,*999)
703  CALL navierstokes_problemspecificationset(problem,problemspecification,err,error,*999)
705  CALL darcy_problemspecificationset(problem,problemspecification,err,error,*999)
707  CALL poiseuille_problemspecificationset(problem,problemspecification,err,error,*999)
709  CALL burgers_problemspecificationset(problem,problemspecification,err,error,*999)
710  CASE DEFAULT
711  localerror="The second problem specification of "//trim(numbertovstring(problemtype,"*",err,error))// &
712  & " is not valid for a fluid mechanics problem."
713  CALL flagerror(localerror,err,error,*999)
714  END SELECT
715  ELSE
716  CALL flagerror("Fluid mechanics problem specification must have a type set.",err,error,*999)
717  END IF
718  ELSE
719  CALL flagerror("Problem is not associated",err,error,*999)
720  END IF
721 
722  exits("FluidMechanics_ProblemSpecificationSet")
723  RETURN
724 999 errors("FluidMechanics_ProblemSpecificationSet",err,error)
725  exits("FluidMechanics_ProblemSpecificationSet")
726  RETURN 1
727 
729 
730  !
731  !================================================================================================================================
732  !
733 
735  SUBROUTINE fluid_mechanics_problem_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
737  !Argument variables
738  TYPE(problem_type), POINTER :: PROBLEM
739  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
740  INTEGER(INTG), INTENT(OUT) :: ERR
741  TYPE(varying_string), INTENT(OUT) :: ERROR
742  !Local Variables
743  TYPE(varying_string) :: LOCAL_ERROR
744 
745  enters("FLUID_MECHANICS_PROBLEM_SETUP",err,error,*999)
746 
747  IF(ASSOCIATED(problem)) THEN
748  IF(.NOT.ALLOCATED(problem%specification)) THEN
749  CALL flagerror("Problem specification is not allocated.",err,error,*999)
750  ELSE IF(SIZE(problem%specification,1)<2) THEN
751  CALL flagerror("Problem specification must have at least two entries for a fluid mechanics problem.",err,error,*999)
752  END IF
753  SELECT CASE(problem%SPECIFICATION(2))
755  CALL stokes_problem_setup(problem,problem_setup,err,error,*999)
757  CALL navier_stokes_problem_setup(problem,problem_setup,err,error,*999)
759  CALL darcy_equation_problem_setup(problem,problem_setup,err,error,*999)
761  CALL poiseuille_equation_problem_setup(problem,problem_setup,err,error,*999)
763  CALL burgers_equation_problem_setup(problem,problem_setup,err,error,*999)
764  CASE DEFAULT
765  local_error="Problem type "//trim(number_to_vstring(problem%SPECIFICATION(2),"*",err,error))// &
766  & " is not valid for a fluid mechanics problem class."
767  CALL flagerror(local_error,err,error,*999)
768  END SELECT
769  ELSE
770  CALL flagerror("Problem is not associated.",err,error,*999)
771  ENDIF
772 
773  exits("FLUID_MECHANICS_PROBLEM_SETUP")
774  RETURN
775 999 errorsexits("FLUID_MECHANICS_PROBLEM_SETUP",err,error)
776  RETURN 1
777  END SUBROUTINE fluid_mechanics_problem_setup
778 
779  !
780  !================================================================================================================================
781  !
782 
784  SUBROUTINE fluid_mechanics_post_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
786  !Argument variables
787  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
788  TYPE(solver_type), POINTER :: SOLVER
789  INTEGER(INTG), INTENT(OUT) :: ERR
790  TYPE(varying_string), INTENT(OUT) :: ERROR
791  !Local Variables
792  TYPE(varying_string) :: LOCAL_ERROR
793 
794  enters("FLUID_MECHANICS_POST_SOLVE",err,error,*999)
795 
796  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
797  IF(.NOT.ALLOCATED(control_loop%problem%specification)) THEN
798  CALL flagerror("Problem specification is not allocated.",err,error,*999)
799  ELSE IF(SIZE(control_loop%problem%specification,1)<2) THEN
800  CALL flagerror("Problem specification must have at least two entries for a fluid mechanics problem.",err,error,*999)
801  END IF
802  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(2))
804  CALL stokes_post_solve(control_loop,solver,err,error,*999)
806  CALL navier_stokes_post_solve(solver,err,error,*999)
808  CALL darcy_equation_post_solve(control_loop,solver,err,error,*999)
810  CALL poiseuille_post_solve(control_loop,solver,err,error,*999)
812  CALL burgers_equation_post_solve(control_loop,solver,err,error,*999)
813  CASE DEFAULT
814  local_error="Problem type "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(2),"*",err,error))// &
815  & " is not valid for a fluid mechanics problem class."
816  CALL flagerror(local_error,err,error,*999)
817  END SELECT
818  ELSE
819  CALL flagerror("Problem is not associated.",err,error,*999)
820  ENDIF
821 
822  exits("FLUID_MECHANICS_POST_SOLVE")
823  RETURN
824 999 errorsexits("FLUID_MECHANICS_POST_SOLVE",err,error)
825  RETURN 1
826  END SUBROUTINE fluid_mechanics_post_solve
827 
828  !
829  !================================================================================================================================
830 
831 
833  SUBROUTINE fluid_mechanics_pre_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
835  !Argument variables
836  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
837  TYPE(solver_type), POINTER :: SOLVER
838  INTEGER(INTG), INTENT(OUT) :: ERR
839  TYPE(varying_string), INTENT(OUT) :: ERROR
840  !Local Variables
841  TYPE(varying_string) :: LOCAL_ERROR
842 
843  enters("FLUID_MECHANICS_PRE_SOLVE",err,error,*999)
844 
845  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
846  IF(.NOT.ALLOCATED(control_loop%problem%specification)) THEN
847  CALL flagerror("Problem specification is not allocated.",err,error,*999)
848  ELSE IF(SIZE(control_loop%problem%specification,1)<2) THEN
849  CALL flagerror("Problem specification must have at least two entries for a fluid mechanics problem.",err,error,*999)
850  END IF
851  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(2))
853  CALL stokes_pre_solve(control_loop,solver,err,error,*999)
855  CALL navier_stokes_pre_solve(solver,err,error,*999)
857  CALL darcy_equation_pre_solve(control_loop,solver,err,error,*999)
859  CALL poiseuille_pre_solve(control_loop,solver,err,error,*999)
861  CALL burgers_equation_pre_solve(solver,err,error,*999)
862  CASE DEFAULT
863  local_error="Problem type "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(2),"*",err,error))// &
864  & " is not valid for a fluid mechanics problem class."
865  CALL flagerror(local_error,err,error,*999)
866  END SELECT
867  ELSE
868  CALL flagerror("Problem is not associated.",err,error,*999)
869  ENDIF
870 
871  exits("FLUID_MECHANICS_PRE_SOLVE")
872  RETURN
873 999 errorsexits("FLUID_MECHANICS_PRE_SOLVE",err,error)
874  RETURN 1
875  END SUBROUTINE fluid_mechanics_pre_solve
876 
877  !
878  !================================================================================================================================
879  !
880 
882  SUBROUTINE fluid_mechanics_control_loop_pre_loop(CONTROL_LOOP,ERR,ERROR,*)
884  !Argument variables
885  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
886  INTEGER(INTG), INTENT(OUT) :: ERR
887  TYPE(varying_string), INTENT(OUT) :: ERROR
888  !Local Variables
889  TYPE(varying_string) :: LOCAL_ERROR
890 
891  enters("FLUID_MECHANICS_CONTROL_LOOP_PRE_LOOP",err,error,*999)
892 
893  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
894  SELECT CASE(control_loop%LOOP_TYPE)
896  IF(.NOT.ALLOCATED(control_loop%problem%specification)) THEN
897  CALL flagerror("Problem specification is not allocated.",err,error,*999)
898  ELSE IF(SIZE(control_loop%problem%specification,1)<2) THEN
899  CALL flagerror("Problem specification must have at least two entries for a fluid mechanics problem.",err,error,*999)
900  END IF
901  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(2))
903  !do nothing
905  !do nothing
907  CALL darcy_control_time_loop_pre_loop(control_loop,err,error,*999)
909  !do nothing
911  !do nothing
912  CASE DEFAULT
913  local_error="Problem type "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(2),"*",err,error))// &
914  & " is not valid for a fluid mechanics problem class."
915  CALL flagerror(local_error,err,error,*999)
916  END SELECT
917  CASE DEFAULT
918  !do nothing
919  END SELECT
920  ELSE
921  CALL flagerror("Problem is not associated.",err,error,*999)
922  ENDIF
923 
924  exits("FLUID_MECHANICS_CONTROL_LOOP_PRE_LOOP")
925  RETURN
926 999 errorsexits("FLUID_MECHANICS_CONTROL_LOOP_PRE_LOOP",err,error)
927  RETURN 1
929 
930  !
931  !================================================================================================================================
932  !
933 
935  SUBROUTINE fluid_mechanics_control_loop_post_loop(CONTROL_LOOP,ERR,ERROR,*)
937  !Argument variables
938  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
939  INTEGER(INTG), INTENT(OUT) :: ERR
940  TYPE(varying_string), INTENT(OUT) :: ERROR
941  !Local Variables
942  TYPE(varying_string) :: LOCAL_ERROR
943 
944  enters("FLUID_MECHANICS_CONTROL_LOOP_POST_LOOP",err,error,*999)
945 
946  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
947  SELECT CASE(control_loop%LOOP_TYPE)
949  IF(.NOT.ALLOCATED(control_loop%problem%specification)) THEN
950  CALL flagerror("Problem specification is not allocated.",err,error,*999)
951  ELSE IF(SIZE(control_loop%problem%specification,1)<2) THEN
952  CALL flagerror("Problem specification must have at least two entries for a fluid mechanics problem.",err,error,*999)
953  END IF
954  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(2))
956  !do nothing
958  CALL navierstokes_controllooppostloop(control_loop,err,error,*999)
960  !do nothing
962  !do nothing
964  !do nothing
965  CASE DEFAULT
966  local_error="The second problem specification of "// &
967  & trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(2),"*",err,error))// &
968  & " is not valid for a fluid mechanics problem."
969  CALL flagerror(local_error,err,error,*999)
970  END SELECT
971  CASE DEFAULT
972  !do nothing
973  END SELECT
974  ELSE
975  CALL flagerror("Problem is not associated.",err,error,*999)
976  ENDIF
977 
978  exits("FLUID_MECHANICS_CONTROL_LOOP_POST_LOOP")
979  RETURN
980 999 errorsexits("FLUID_MECHANICS_CONTROL_LOOP_POST_LOOP",err,error)
981  RETURN 1
982 
984 
985  !
986  !================================================================================================================================
987  !
988 
990  SUBROUTINE fluidmechanics_finiteelementpreresidualevaluate(equationsSet,err,error,*)
992  !Argument variables
993  TYPE(equations_set_type), POINTER :: equationsSet
994  INTEGER(INTG), INTENT(OUT) :: err
995  TYPE(varying_string), INTENT(OUT) :: error
996  !Local Variables
997  TYPE(varying_string) :: localError
998 
999  enters("FluidMechanics_FiniteElementPreResidualEvaluate",err,error,*999)
1000 
1001  IF(ASSOCIATED(equationsset)) THEN
1002  SELECT CASE(equationsset%specification(2))
1004  ! Do nothing
1006  CALL navierstokes_finiteelementpreresidualevaluate(equationsset,err,error,*999)
1008  ! Do nothing
1010  ! Do nothing
1012  ! Do nothing
1014  ! Do nothing
1016  ! Do nothing
1017  CASE DEFAULT
1018  localerror="The second equations set specificaiton of "// &
1019  & trim(number_to_vstring(equationsset%specification(2),"*",err,error))// &
1020  & " is not valid for a fluid mechanics equation set."
1021  CALL flagerror(localerror,err,error,*999)
1022  END SELECT
1023  ELSE
1024  CALL flagerror("Equations set is not associated",err,error,*999)
1025  ENDIF
1026 
1027  exits("FluidMechanics_FiniteElementPreResidualEvaluate")
1028  RETURN
1029 999 errors("FluidMechanics_FiniteElementPreResidualEvaluate",err,error)
1030  exits("FluidMechanics_FiniteElementPreResidualEvaluate")
1031  RETURN 1
1032 
1034 
1035  !
1036  !================================================================================================================================
1037  !
1038 
1039 END MODULE fluid_mechanics_routines
1040 
Contains information on the boundary conditions for the solver equations.
Definition: types.f90:1780
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
subroutine, public poiseuille_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for a Poiseuille fluid mechanics equations set.
subroutine, public burgers_equation_equations_set_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the Burgers equation type of a fluid mechanics equations set class.
subroutine, public fluidmechanics_problemspecificationset(problem, problemSpecification, err, error,)
Sets the problem specification for a fluid mechanics problem class.
This module handles pure advection equation routines.
subroutine, public poiseuille_problemspecificationset(problem, problemSpecification, err, error,)
Sets the problem specification for a Poiseuille problem.
integer(intg), parameter problem_control_time_loop_type
Time control loop.
This module handles all problem wide constants.
integer(intg), parameter problem_poiseuille_equation_type
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
Contains information on the type of solver to be used.
Definition: types.f90:2777
subroutine, public fluid_mechanics_pre_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the output type for a fluid mechanics problem class.
subroutine, public stokes_problem_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the Stokes problem.
subroutine, public fluid_mechanics_control_loop_post_loop(CONTROL_LOOP, ERR, ERROR,)
Executes after each loop of a control loop, ie after each time step for a time loop.
subroutine, public stokes_equations_set_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the standard Stokes fluid setup.
subroutine, public stokes_pre_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the Stokes problem pre solve.
subroutine, public fluidmechanics_finiteelementpreresidualevaluate(equationsSet, err, error,)
Pre-residual steps for an fluid mechanics class finite element equation set.
Contains information on an equations set.
Definition: types.f90:1941
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
subroutine, public darcy_control_time_loop_pre_loop(CONTROL_LOOP, ERR, ERROR,)
subroutine, public darcy_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for a Darcy equation type of a fluid mechanics equations set class...
subroutine, public poiseuille_finiteelementcalculate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element stiffness matrices and RHS for a Poiseuille equation finite element equations ...
integer(intg), parameter problem_control_simple_type
Simple, one iteration control loop.
integer(intg), parameter problem_stokes_equation_type
integer(intg), parameter equations_set_stree_equation_type
subroutine, public stokes_equationssetsolutionmethodset(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for a Stokes flow equation type of an fluid mechanics equations set ...
subroutine, public stree_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for a Stree type of a fluid mechanics equations set.
subroutine, public poiseuille_post_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the Poiseuille problem post solve.
subroutine, public darcypressure_equationssetspecificationset(equationsSet, specification, err, error,)
Sets/changes the equation specification for a Darcy pressure type of a fluid mechanics equations set...
Contains information on a control loop.
Definition: types.f90:3185
subroutine, public burgers_boundaryconditionsanalyticcalculate(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Calculates the analytic solution and sets the boundary conditions for an analytic problem...
subroutine, public burgers_equationssetsolutionmethodset(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for a burgers equation type of an fluid mechanics equations set clas...
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
subroutine, public fluidmechanics_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the problem specification for a fluid mechanics equation set class.
subroutine, public stokes_post_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the Stokes problem post solve.
subroutine, public fluidmechanics_equationssetsolutionmethodset(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for a fluid mechanics equation set class.
subroutine, public darcy_problemspecificationset(problem, problemSpecification, err, error,)
Sets the problem specification for a Darcy problem.
subroutine, public burgers_finiteelementresidualevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the residual element stiffness matrices and RHS for a Burgers equation finite element equat...
subroutine, public poiseuille_equationssetsolutionmethodset(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for a Poiseuille equation type of an fluid mechanics equations set c...
This module handles all Stree equation routines.
subroutine, public darcypressure_finiteelementresidualevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element residual vector and RHS for a Darcy pressure equation finite element equations...
This module handles all Darcy equations routines.
integer(intg), parameter problem_navier_stokes_equation_type
subroutine, public darcy_equation_problem_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the Darcy equations problem.
integer(intg), parameter problem_darcy_equation_type
subroutine, public darcy_boundaryconditionsanalyticcalculate(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Calculates the analytic solution and sets the boundary conditions for an analytic problem...
subroutine, public burgers_equation_problem_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the Burgers problem.
integer(intg), parameter problem_burgers_equation_type
subroutine, public exits(NAME)
Records the exit out of the named procedure.
subroutine, public darcy_equation_finite_element_calculate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element stiffness matrices and RHS for a Darcy equation finite element equations set...
subroutine, public fluidmechanics_boundaryconditionsanalyticcalculate(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Sets the analytic boundary conditions for a fluid mechanics equation set class.
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
subroutine, public stree_finite_element_calculate(equationsSet, nodeNumber, err, error,)
Evaluates the residual nodal stiffness matrices and RHS for a Stree equation nodal equations set...
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
subroutine, public burgers_equation_pre_solve(SOLVER, ERR, ERROR,)
Sets up the BURGERS problem pre-solve.
This module handles all fluid mechanics class routines.
subroutine, public stokes_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for a Stokes flow equation of a fluid mechanics equations set...
This module handles all Darcy pressure equations routines.
This module handles all Stokes fluid routines.
subroutine, public burgers_finiteelementjacobianevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the Jacobian element stiffness matrices for a BURGERS equation finite element equations set...
subroutine, public stree_equationssetsetup(equationsSet, equationsSetSetup, err, error,)
Sets up the Stree equations fluid setup.
subroutine, public darcy_pressure_equation_equations_set_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the Darcy pressure equation type of a fluid mechanics equations set class.
subroutine, public stokes_finite_element_calculate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element stiffness matrices and RHS for a Stokes fluid finite element equations set...
subroutine, public fluidmechanics_finiteelementresidualevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the element residual and rhs vectors for the given element number for a fluid mechanics cla...
subroutine, public poiseuille_pre_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the Poiseuille problem pre solve.
integer(intg), parameter equations_set_darcy_equation_type
subroutine, public burgers_equation_post_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the Burgers problem post solve.
subroutine, public fluidmechanics_nodaljacobianevaluate(equationsSet, nodeNumber, err, error,)
Evaluates the nodal Jacobian matrix for the given node number for a fluid mechanics class nodal equat...
subroutine, public fluid_mechanics_problem_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the problem for a fluid mechanics problem class.
subroutine, public poiseuille_boundaryconditionsanalyticcalculate(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Calculates the analytic solution and sets the boundary conditions for an analytic problem...
subroutine, public burgers_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 Burgers equation.
subroutine, public fluidmechanics_finiteelementjacobianevaluate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Evaluates the element Jacobian matrix for the given element number for a fluid mechanics class finite...
Contains information for a problem.
Definition: types.f90:3221
subroutine, public characteristic_equationssetsetup(equationsSet, equationsSetSetup, err, error,)
Sets up the Characteristic equations fluid setup.
integer(intg), parameter equations_set_poiseuille_equation_type
subroutine, public darcy_equation_pre_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the Darcy problem pre-solve.
subroutine, public burgers_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for a Burgers type of a fluid mechanics equations set...
This module handles all Navier-Stokes fluid routines.
subroutine, public burgers_problemspecificationset(problem, problemSpecification, err, error,)
Sets the problem specification for a Burgers problem.
This module handles all Poiseuille equations routines.
subroutine, public fluid_mechanics_analytic_functions_evaluate(EQUATIONS_SET, ANALYTIC_FUNCTION_TYPE, POSITION, TANGENTS, NORMAL, TIME, VARIABLE_TYPE, GLOBAL_DERIVATIVE, COMPONENT_NUMBER, ANALYTIC_PARAMETERS, MATERIALS_PARAMETERS, VALUE, ERR, ERROR,)
Evaluate the analytic solution for a fluid mechanics equations set.
subroutine, public poiseuille_equation_problem_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the Poiseuille problem.
subroutine, public characteristic_equationssetsolutionmethodset(equationsSet, solutionMethod, err, error,)
Sets/changes the solution method for a Characteristic equation type of an fluid mechanics equations s...
subroutine, public fluid_mechanics_equations_set_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the equations set for a fluid mechanics equations set class.
subroutine, public darcy_equation_equations_set_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the Darcy equation.
subroutine, public fluid_mechanics_post_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the output type for a fluid mechanics problem class.
subroutine, public darcy_equation_post_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the Darcy problem post solve.
This module handles all characteristic equation routines.
Contains information on the setup information for an equations set.
Definition: types.f90:1866
subroutine, public fluidmechanics_nodalresidualevaluate(equationsSet, nodeNumber, err, error,)
Evaluates the nodal residual and rhs vectors for the given node number for a fluid mechanics class no...
This module handles all control loop routines.
integer(intg), parameter equations_set_characteristic_equation_type
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
This module defines all constants shared across equations set routines.
subroutine, public characteristic_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for a Characteristic type of a fluid mechanics equations set class...
integer(intg), parameter equations_set_burgers_equation_type
integer(intg), parameter equations_set_darcy_pressure_equation_type
subroutine, public fluid_mechanics_control_loop_pre_loop(CONTROL_LOOP, ERR, ERROR,)
Executes before each loop of a control loop, ie before each time step for a time loop.
subroutine, public stokes_boundaryconditionsanalyticcalculate(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Calculates the analytic solution and sets the boundary conditions for an analytic problem...
subroutine, public characteristic_nodaljacobianevaluate(equationsSet, nodeNumber, err, error,)
Evaluates the Jacobian nodal matrix for a characteristic equation nodal equations set...
subroutine, public characteristic_nodalresidualevaluate(equationsSet, nodeNumber, err, error,)
Evaluates the residual nodal stiffness matrices and RHS for a characteristic equation nodal equations...
Flags an error condition.
subroutine, public fluid_mechanics_finite_element_calculate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element stiffness matries and rhs vector for the given element number for a fluid mech...
subroutine, public darcypressure_equationssetsolutionmethodset(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for a Darcy pressure equation type of an fluid mechanics equations s...
integer(intg), parameter problem_control_while_loop_type
While control loop.
integer(intg), parameter equations_set_stokes_equation_type
subroutine, public stokes_problemspecificationset(problem, problemSpecification, err, error,)
Sets the problem specification for a Stokes fluid problem.
subroutine, public poiseuille_equation_equations_set_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the Poiseuille equation type of a fluid mechanics equations set class.
This module contains all kind definitions.
Definition: kinds.f90:45
This module handles all Burgers equation routines.
integer(intg), parameter equations_set_navier_stokes_equation_type
This module handles all formating and input and output.