OpenCMISS-Iron Internal API Documentation
Poiseuille_equations_routines.f90
Go to the documentation of this file.
1 
43 
46 
47  USE base_routines
48  USE basis_routines
50  USE constants
53  USE domain_mappings
58  USE field_routines
59  USE input_output
61  USE kinds
62  USE matrix_vector
64  USE strings
65  USE solver_routines
66  USE timer
67  USE types
68 ! temporary input for vector-source
70 
71 #include "macros.h"
72 
73  IMPLICIT NONE
74 
75  PRIVATE
76 
77  !Module parameters
78 
79  !Module types
80 
81  !Module variables
82 
83  !Interfaces
84 
86 
88 
90 
92 
94 
96 
98 
100 
101 CONTAINS
102 
103  !
104  !================================================================================================================================
105  !
106 
108  SUBROUTINE poiseuille_boundaryconditionsanalyticcalculate(EQUATIONS_SET,BOUNDARY_CONDITIONS,ERR,ERROR,*)
110  !Argument variables
111  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
112  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
113  INTEGER(INTG), INTENT(OUT) :: ERR
114  TYPE(varying_string), INTENT(OUT) :: ERROR
115  !Local Variables
116  INTEGER(INTG) :: component_idx,deriv_idx,dim_idx,local_ny,node_idx,NUMBER_OF_DIMENSIONS,variable_idx,variable_type
117  INTEGER(INTG) :: COUNT_DOF
118  REAL(DP) :: VALUE,X(3)
119  REAL(DP), POINTER :: GEOMETRIC_PARAMETERS(:)
120  TYPE(domain_type), POINTER :: DOMAIN
121  TYPE(domain_nodes_type), POINTER :: DOMAIN_NODES
122  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD
123  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE,GEOMETRIC_VARIABLE
124  TYPE(varying_string) :: LOCAL_ERROR
125 
126  enters("Poiseuille_BoundaryConditionsAnalyticCalculate",err,error,*999)
127 
128  IF(ASSOCIATED(equations_set)) THEN
129  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
130  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
131  IF(ASSOCIATED(dependent_field)) THEN
132  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
133  IF(ASSOCIATED(geometric_field)) THEN
134  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
135  NULLIFY(geometric_variable)
136  CALL field_variable_get(geometric_field,field_u_variable_type,geometric_variable,err,error,*999)
137  CALL field_parameter_set_data_get(geometric_field,field_u_variable_type,field_values_set_type,geometric_parameters, &
138  & err,error,*999)
139 
140  IF(ASSOCIATED(boundary_conditions)) THEN
141 
142  count_dof=0
143 
144  DO variable_idx=1,dependent_field%NUMBER_OF_VARIABLES !U and deludeln
145  variable_type=dependent_field%VARIABLES(variable_idx)%VARIABLE_TYPE
146  field_variable=>dependent_field%VARIABLE_TYPE_MAP(variable_type)%PTR
147  IF(ASSOCIATED(field_variable)) THEN
148  CALL field_parameter_set_create(dependent_field,variable_type,field_analytic_values_set_type,err,error,*999)
149  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS !u,v,w
150  IF(field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE==field_node_based_interpolation) THEN
151  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
152  IF(ASSOCIATED(domain)) THEN
153  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
154  domain_nodes=>domain%TOPOLOGY%NODES
155  IF(ASSOCIATED(domain_nodes)) THEN
156 
157  !Loop over the local nodes excluding the ghosts.
158  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
159  !!TODO \todo We should interpolate the geometric field here and the node position.
160  DO dim_idx=1,number_of_dimensions
161  !Default to version 1 of each node derivative
162  local_ny=geometric_variable%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
163  & nodes(node_idx)%DERIVATIVES(1)%VERSIONS(1)
164  x(dim_idx)=geometric_parameters(local_ny)
165  ENDDO !dim_idx
166  !Loop over the derivatives
167  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
168  SELECT CASE(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE)
170  !u=ln(4/(x+y+1^2))
171  SELECT CASE(variable_type)
172  CASE(field_u_variable_type)
173  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
174  CASE(no_global_deriv)
175  VALUE=log(4.0_dp/((x(1)+x(2)+1.0_dp)**2))
176  CASE(global_deriv_s1)
177  CALL flagerror("Not implemented.",err,error,*999)
178  CASE(global_deriv_s2)
179  CALL flagerror("Not implemented.",err,error,*999)
180  CASE(global_deriv_s1_s2)
181  CALL flagerror("Not implemented.",err,error,*999)
182  CASE DEFAULT
183  local_error="The global derivative index of "//trim(number_to_vstring( &
184  domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
185  & err,error))//" is invalid."
186  CALL flagerror(local_error,err,error,*999)
187  END SELECT
188  CASE(field_deludeln_variable_type)
189  SELECT CASE(domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX)
190  CASE(no_global_deriv)
191  !This is believed to be incorrect, should be: VALUE=-2.0_DP/(X(1)+X(2)+1.0_DP)
192  VALUE=-2.0_dp*(x(1)+x(2))/(x(1)+x(2)+1.0_dp)
193  CASE(global_deriv_s1)
194  CALL flagerror("Not implemented.",err,error,*999)
195  CASE(global_deriv_s2)
196  CALL flagerror("Not implemented.",err,error,*999)
197  CASE(global_deriv_s1_s2)
198  CALL flagerror("Not implemented.",err,error,*999)
199  CASE DEFAULT
200  local_error="The global derivative index of "//trim(number_to_vstring( &
201  domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%GLOBAL_DERIVATIVE_INDEX,"*", &
202  & err,error))//" is invalid."
203  CALL flagerror(local_error,err,error,*999)
204  END SELECT
205  END SELECT
206  CASE DEFAULT
207  IF(variable_type==field_u_variable_type.AND.domain_nodes%NODES(node_idx)%BOUNDARY_NODE) THEN !For Dirichlet
208  CALL boundary_conditions_set_local_dof(boundary_conditions,dependent_field,variable_type, &
209  & local_ny,boundary_condition_fixed,VALUE,err,error,*999)
210  ENDIF
211  END SELECT
212 
213  IF(variable_type==field_deludeln_variable_type.and.node_idx/=1) THEN
214  IF(domain_nodes%NODES(node_idx)%BOUNDARY_NODE) THEN
215  !If we are a boundary node then set the analytic value on the boundary
216  !CALL BOUNDARY_CONDITIONS_SET_LOCAL_DOF(BOUNDARY_CONDITIONS,variable_type,local_ny, &
217  ! & BOUNDARY_CONDITION_FIXED,VALUE,ERR,ERROR,*999)
218  !Do nothing at present
219  ENDIF
220  ENDIF
221 
222  ENDDO !deriv_idx
223  ENDDO !node_idx
224  ELSE
225  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
226  ENDIF
227  ELSE
228  CALL flagerror("Domain topology is not associated.",err,error,*999)
229  ENDIF
230  ELSE
231  CALL flagerror("Domain is not associated.",err,error,*999)
232  ENDIF
233  ELSE
234  CALL flagerror("Only node based interpolation is implemented.",err,error,*999)
235  ENDIF
236  ENDDO !component_idx
237  CALL field_parameter_set_update_start(dependent_field,variable_type,field_analytic_values_set_type, &
238  & err,error,*999)
239  CALL field_parameter_set_update_finish(dependent_field,variable_type,field_analytic_values_set_type, &
240  & err,error,*999)
241  ELSE
242  CALL flagerror("Field variable is not associated.",err,error,*999)
243  ENDIF
244  ENDDO
245  CALL field_parameter_set_data_restore(geometric_field,field_u_variable_type,field_values_set_type, &
246  & geometric_parameters,err,error,*999)
247  ELSE
248  CALL flagerror("Boundary conditions is not associated.",err,error,*999)
249  ENDIF
250  ELSE
251  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
252  ENDIF
253  ELSE
254  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
255  ENDIF
256  ELSE
257  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
258  ENDIF
259  ELSE
260  CALL flagerror("Equations set is not associated.",err,error,*999)
261  ENDIF
262 
263  exits("Poiseuille_BoundaryConditionsAnalyticCalculate")
264  RETURN
265 999 errors("Poiseuille_BoundaryConditionsAnalyticCalculate",err,error)
266  exits("Poiseuille_BoundaryConditionsAnalyticCalculate")
267  RETURN 1
268 
270 
271  !
272  !================================================================================================================================
273  !
274 
276  SUBROUTINE poiseuille_equation_equations_set_setup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
278  !Argument variables
279  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
280  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
281  INTEGER(INTG), INTENT(OUT) :: ERR
282  TYPE(varying_string), INTENT(OUT) :: ERROR
283  !Local Variables
284  TYPE(varying_string) :: LOCAL_ERROR
285 
286  enters("POISEUILLE_EQUATION_EQUATIONS_SET_SETUP",err,error,*999)
287 
288  IF(ASSOCIATED(equations_set)) THEN
289  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
290  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
291  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
292  CALL flagerror("Equations set specification must have three entries for a Poiseuille type equations set.", &
293  & err,error,*999)
294  END IF
295  SELECT CASE(equations_set%SPECIFICATION(3))
297  CALL poiseuille_equationssetstaticsetup(equations_set,equations_set_setup,err,error,*999)
299  CALL poiseuille_equationssetstaticsetup(equations_set,equations_set_setup,err,error,*999)
300  CASE DEFAULT
301  local_error="Equations set subtype "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
302  & " is not valid for a Poiseuille equation type of a fluid mechanics equation set class."
303  CALL flagerror(local_error,err,error,*999)
304  END SELECT
305  ELSE
306  CALL flagerror("Equations set is not associated.",err,error,*999)
307  ENDIF
308 
309  exits("POISEUILLE_EQUATION_EQUATIONS_SET_SETUP")
310  RETURN
311 999 errorsexits("POISEUILLE_EQUATION_EQUATIONS_SET_SETUP",err,error)
312  RETURN 1
314 
315  !
316  !================================================================================================================================
317  !
318 
320  SUBROUTINE poiseuille_equationssetsolutionmethodset(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)
322  !Argument variables
323  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
324  INTEGER(INTG), INTENT(IN) :: SOLUTION_METHOD
325  INTEGER(INTG), INTENT(OUT) :: ERR
326  TYPE(varying_string), INTENT(OUT) :: ERROR
327  !Local Variables
328  TYPE(varying_string) :: LOCAL_ERROR
329 
330  enters("Poiseuille_EquationsSetSolutionMethodSet",err,error,*999)
331 
332  IF(ASSOCIATED(equations_set)) THEN
333  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
334  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
335  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
336  CALL flagerror("Equations set specification must have three entries for a Poiseuille type equations set.", &
337  & err,error,*999)
338  END IF
339  SELECT CASE(equations_set%SPECIFICATION(3))
341  SELECT CASE(solution_method)
343  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
345  CALL flagerror("Not implemented.",err,error,*999)
347  CALL flagerror("Not implemented.",err,error,*999)
349  CALL flagerror("Not implemented.",err,error,*999)
351  CALL flagerror("Not implemented.",err,error,*999)
353  CALL flagerror("Not implemented.",err,error,*999)
354  CASE DEFAULT
355  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
356  CALL flagerror(local_error,err,error,*999)
357  END SELECT
358  CASE DEFAULT
359  local_error="Equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
360  & " is not valid for a Poiseuille equation type of an fluid mechanics equations set class."
361  CALL flagerror(local_error,err,error,*999)
362  END SELECT
363  ELSE
364  CALL flagerror("Equations set is not associated.",err,error,*999)
365  ENDIF
366 
367  exits("Poiseuille_EquationsSetSolutionMethodSet")
368  RETURN
369 999 errorsexits("Poiseuille_EquationsSetSolutionMethodSet",err,error)
370  RETURN 1
371 
373 
374  !
375  !================================================================================================================================
376  !
377 
379  SUBROUTINE poiseuille_equationssetspecificationset(equationsSet,specification,err,error,*)
381  !Argument variables
382  TYPE(equations_set_type), POINTER :: equationsSet
383  INTEGER(INTG), INTENT(IN) :: specification(:)
384  INTEGER(INTG), INTENT(OUT) :: err
385  TYPE(varying_string), INTENT(OUT) :: error
386  !Local Variables
387  TYPE(varying_string) :: localError
388  INTEGER(INTG) :: subtype
389 
390  enters("Poiseuille_EquationsSetSpecificationSet",err,error,*999)
391 
392  IF(ASSOCIATED(equationsset)) THEN
393  IF(SIZE(specification,1)/=3) THEN
394  CALL flagerror("Equations set specification must have three entries for a Poiseuille equation type equations set.", &
395  & err,error,*999)
396  END IF
397  subtype=specification(3)
398  SELECT CASE(subtype)
401  !ok
402  CASE DEFAULT
403  localerror="The third equations set specification of "//trim(numbertovstring(subtype,"*",err,error))// &
404  & " is not valid for a Poiseuille equation type of a fluid mechanics equations set class."
405  CALL flagerror(localerror,err,error,*999)
406  END SELECT
407  !Set full specification
408  IF(ALLOCATED(equationsset%specification)) THEN
409  CALL flagerror("Equations set specification is already allocated.",err,error,*999)
410  ELSE
411  ALLOCATE(equationsset%specification(3),stat=err)
412  IF(err/=0) CALL flagerror("Could not allocate equations set specification.",err,error,*999)
413  END IF
414  equationsset%specification(1:3)=[equations_set_fluid_mechanics_class,equations_set_poiseuille_equation_type,subtype]
415  ELSE
416  CALL flagerror("Equations set is not associated.",err,error,*999)
417  END IF
418 
419  exits("Poiseuille_EquationsSetSpecificationSet")
420  RETURN
421 999 errors("Poiseuille_EquationsSetSpecificationSet",err,error)
422  exits("Poiseuille_EquationsSetSpecificationSet")
423  RETURN 1
424 
426 
427 
428  !
429  !================================================================================================================================
430  !
431 
433  SUBROUTINE poiseuille_equationssetstaticsetup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
435  !Argument variables
436  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
437  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
438  INTEGER(INTG), INTENT(OUT) :: ERR
439  TYPE(varying_string), INTENT(OUT) :: ERROR
440  !Local Variables
441  INTEGER(INTG) :: component_idx,GEOMETRIC_COMPONENT_NUMBER,GEOMETRIC_SCALING_TYPE
442  TYPE(decomposition_type), POINTER :: GEOMETRIC_DECOMPOSITION
443  TYPE(equations_type), POINTER :: EQUATIONS
444  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
445  TYPE(equations_set_materials_type), POINTER :: EQUATIONS_MATERIALS
446  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
447  TYPE(varying_string) :: LOCAL_ERROR
448 
449  enters("Poiseuille_EquationsSetStaticSetup",err,error,*999)
450 
451  NULLIFY(equations)
452  NULLIFY(equations_mapping)
453  NULLIFY(equations_matrices)
454  NULLIFY(geometric_decomposition)
455 
456  IF(ASSOCIATED(equations_set)) THEN
457  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
458  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
459  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
460  CALL flagerror("Equations set specification must have three entries for a Poiseuille type equations set.", &
461  & err,error,*999)
462  END IF
463  IF(equations_set%SPECIFICATION(3)==equations_set_static_poiseuille_subtype) THEN
464  SELECT CASE(equations_set_setup%SETUP_TYPE)
466  SELECT CASE(equations_set_setup%ACTION_TYPE)
469  & error,*999)
471 !!TODO: Check valid setup
472  CASE DEFAULT
473  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
474  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
475  & " is invalid for a static Poiseuille equation."
476  CALL flagerror(local_error,err,error,*999)
477  END SELECT
479  !Do nothing???
481  SELECT CASE(equations_set_setup%ACTION_TYPE)
483  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
484  !Create the auto created dependent field
485  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
486  & dependent_field,err,error,*999)
487  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
488  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
489  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
490  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
491  & err,error,*999)
492  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
493  & geometric_field,err,error,*999)
494  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,2,err,error,*999)
495  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,[field_u_variable_type, &
496  & field_deludeln_variable_type],err,error,*999)
497  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
498  & field_vector_dimension_type,err,error,*999)
499  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
500  & field_vector_dimension_type,err,error,*999)
501  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
502  & field_dp_type,err,error,*999)
503  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
504  & field_dp_type,err,error,*999)
505  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,2, &
506  & err,error,*999)
507  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,2, &
508  & err,error,*999)
509  !Default to the geometric interpolation setup
510  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,1, &
511  & geometric_component_number,err,error,*999)
512  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
513  & geometric_component_number,err,error,*999)
514  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,2, &
515  & geometric_component_number,err,error,*999)
516  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
517  & geometric_component_number,err,error,*999)
518  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,2, &
519  & geometric_component_number,err,error,*999)
520  SELECT CASE(equations_set%SOLUTION_METHOD)
522  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
523  & field_node_based_interpolation,err,error,*999)
524  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,2, &
525  & field_element_based_interpolation,err,error,*999)
526  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
527  & field_deludeln_variable_type,1,field_node_based_interpolation,err,error,*999)
528  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
529  & field_deludeln_variable_type,2,field_element_based_interpolation,err,error,*999)
530  !Default the scaling to the geometric field scaling
531  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
532  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
534  CALL flagerror("Not implemented.",err,error,*999)
536  CALL flagerror("Not implemented.",err,error,*999)
538  CALL flagerror("Not implemented.",err,error,*999)
540  CALL flagerror("Not implemented.",err,error,*999)
542  CALL flagerror("Not implemented.",err,error,*999)
543  CASE DEFAULT
544  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
545  & " is invalid."
546  CALL flagerror(local_error,err,error,*999)
547  END SELECT
548  ELSE
549  !Check the user specified field
550  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
551  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
552  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
553  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_deludeln_variable_type], &
554  & err,error,*999)
555  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type,err,error,*999)
556  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_vector_dimension_type, &
557  & err,error,*999)
558  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
559  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
560  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,2,err,error,*999)
561  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type,2,err,error,*999)
562  SELECT CASE(equations_set%SOLUTION_METHOD)
564  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
565  & field_node_based_interpolation,err,error,*999)
566  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,2, &
567  & field_element_based_interpolation,err,error,*999)
568  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
569  & field_node_based_interpolation,err,error,*999)
570  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,2, &
571  & field_element_based_interpolation,err,error,*999)
573  CALL flagerror("Not implemented.",err,error,*999)
575  CALL flagerror("Not implemented.",err,error,*999)
577  CALL flagerror("Not implemented.",err,error,*999)
579  CALL flagerror("Not implemented.",err,error,*999)
581  CALL flagerror("Not implemented.",err,error,*999)
582  CASE DEFAULT
583  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
584  & " is invalid."
585  CALL flagerror(local_error,err,error,*999)
586  END SELECT
587  ENDIF
589  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
590  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
591  ENDIF
592  CASE DEFAULT
593  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
594  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
595  & " is invalid for a static Poiseuille equation"
596  CALL flagerror(local_error,err,error,*999)
597  END SELECT
599  SELECT CASE(equations_set_setup%ACTION_TYPE)
601  equations_materials=>equations_set%MATERIALS
602  IF(ASSOCIATED(equations_materials)) THEN
603  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
604  !Create the auto created materials field
605  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_materials% &
606  & materials_field,err,error,*999)
607  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
608  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type,err,error,*999)
609  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
610  CALL field_mesh_decomposition_set_and_lock(equations_materials%MATERIALS_FIELD,geometric_decomposition, &
611  & err,error,*999)
612  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
613  & geometric_field,err,error,*999)
614  CALL field_number_of_variables_set_and_lock(equations_materials%MATERIALS_FIELD,1,err,error,*999)
615  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,[field_u_variable_type], &
616  & err,error,*999)
617  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
618  & field_vector_dimension_type,err,error,*999)
619  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
620  & field_dp_type,err,error,*999)
621  !Set the number of materials components
622  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
623  & 3,err,error,*999)
624  !Default the 3 materials components to the first geometric interpolation setup with constant interpolation
625  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
626  & 1,geometric_component_number,err,error,*999)
627  DO component_idx=1,3
628  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
629  & component_idx,geometric_component_number,err,error,*999)
630  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
631  & component_idx,field_constant_interpolation,err,error,*999)
632  ENDDO !component_idx
633  !Default the field scaling to that of the geometric field
634  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
635  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
636  ELSE
637  !Check the user specified field
638  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
639  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
640  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
641  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
642  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
643  & err,error,*999)
644  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
645  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,3,err,error,*999)
646  ENDIF
647  ELSE
648  CALL flagerror("Equations set materials is not associated.",err,error,*999)
649  ENDIF
650 
652  equations_materials=>equations_set%MATERIALS
653  IF(ASSOCIATED(equations_materials)) THEN
654  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
655  !Finish creating the materials field
656  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
657  !Set the default values for the materials field
658  !Default component 1 (viscosity)
659  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
660  & field_values_set_type,1,0.005_dp,err,error,*999)
661  !Default component 2 (radius)
662  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
663  & field_values_set_type,2,0.5_dp,err,error,*999)
664  !Default component 3 (length)
665  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
666  & field_values_set_type,3,1.0_dp,err,error,*999)
667  ENDIF
668  ELSE
669  CALL flagerror("Equations set materials is not associated.",err,error,*999)
670  ENDIF
671  CASE DEFAULT
672  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
673  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
674  & " is invalid for a static Poiseuille equation."
675  CALL flagerror(local_error,err,error,*999)
676  END SELECT
678  SELECT CASE(equations_set%SPECIFICATION(3))
680  SELECT CASE(equations_set_setup%ACTION_TYPE)
681  !Set start action
683  !Add in gravity source field
684  !Specify finish action
686  !Add in gravity source field
687  CASE DEFAULT
688  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
689  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
690  & " is invalid for a linear Poiseuille subtype"
691  CALL flagerror(local_error,err,error,*999)
692  END SELECT
693  CASE DEFAULT
694  local_error="The equation set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
695  & " is invalid for a linear Poiseuille equation."
696  CALL flagerror(local_error,err,error,*999)
697  END SELECT
699  SELECT CASE(equations_set_setup%ACTION_TYPE)
701 
703 
705 
706  CASE DEFAULT
707  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
708  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
709  & " is invalid for a static Poiseuille equation."
710  CALL flagerror(local_error,err,error,*999)
711  END SELECT
713  SELECT CASE(equations_set_setup%ACTION_TYPE)
715  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
716  !Create the equations
717  CALL equations_create_start(equations_set,equations,err,error,*999)
718  CALL equations_linearity_type_set(equations,equations_linear,err,error,*999)
719  CALL equations_time_dependence_type_set(equations,equations_static,err,error,*999)
720  ELSE
721  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
722  ENDIF
724  SELECT CASE(equations_set%SOLUTION_METHOD)
726  !Finish the creation of the equations
727  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
728  CALL equations_create_finish(equations,err,error,*999)
729  !Create the equations mapping.
730  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
731  CALL equationsmapping_linearmatricesnumberset(equations_mapping,1,err,error,*999)
732  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,[field_u_variable_type], &
733  & err,error,*999)
734  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
735  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
736  !Create the equations matrices
737  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
738  SELECT CASE(equations%SPARSITY_TYPE)
741  & err,error,*999)
744  & err,error,*999)
746  & err,error,*999)
747  CASE DEFAULT
748  local_error="The equations matrices sparsity type of "// &
749  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
750  CALL flagerror(local_error,err,error,*999)
751  END SELECT
752  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
754  CALL flagerror("Not implemented.",err,error,*999)
756  CALL flagerror("Not implemented.",err,error,*999)
758  CALL flagerror("Not implemented.",err,error,*999)
760  CALL flagerror("Not implemented.",err,error,*999)
762  CALL flagerror("Not implemented.",err,error,*999)
763  CASE DEFAULT
764  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
765  & " is invalid."
766  CALL flagerror(local_error,err,error,*999)
767  END SELECT
768  CASE DEFAULT
769  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
770  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
771  & " is invalid for a static Poiseuille equation."
772  CALL flagerror(local_error,err,error,*999)
773  END SELECT
774  CASE DEFAULT
775  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
776  & " is invalid for a static Poiseuille equation."
777  CALL flagerror(local_error,err,error,*999)
778  END SELECT
779  ELSE
780  local_error="The equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
781  & " is not a static Poiseuille equation subtype."
782  CALL flagerror(local_error,err,error,*999)
783  ENDIF
784  ELSE
785  CALL flagerror("Equations set is not associated.",err,error,*999)
786  ENDIF
787 
788  exits("Poiseuille_EquationsSetStaticSetup")
789  RETURN
790 999 errorsexits("Poiseuille_EquationsSetStaticSetup",err,error)
791  RETURN 1
792 
794 
795  !
796  !================================================================================================================================
797  !
798 
800  SUBROUTINE poiseuille_equation_problem_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
802  !Argument variables
803  TYPE(problem_type), POINTER :: PROBLEM
804  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
805  INTEGER(INTG), INTENT(OUT) :: ERR
806  TYPE(varying_string), INTENT(OUT) :: ERROR
807  !Local Variables
808  TYPE(varying_string) :: LOCAL_ERROR
809 
810  enters("POISEUILLE_EQUATION_PROBLEM_SETUP",err,error,*999)
811 
812  IF(ASSOCIATED(problem)) THEN
813  IF(.NOT.ALLOCATED(problem%specification)) THEN
814  CALL flagerror("Problem specification is not allocated.",err,error,*999)
815  ELSE IF(SIZE(problem%specification,1)<3) THEN
816  CALL flagerror("Problem specification must have three entries for a Poiseuille problem.",err,error,*999)
817  END IF
818  SELECT CASE(problem%SPECIFICATION(3))
820  CALL poiseuille_equation_problem_static_setup(problem,problem_setup,err,error,*999)
822  CALL poiseuille_equation_problem_static_setup(problem,problem_setup,err,error,*999)
823  CASE DEFAULT
824  local_error="Problem subtype "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
825  & " is not valid for a Poiseuille equation type of a fluid mechanics problem class."
826  CALL flagerror(local_error,err,error,*999)
827  END SELECT
828  ELSE
829  CALL flagerror("Problem is not associated.",err,error,*999)
830  ENDIF
831 
832  exits("POISEUILLE_EQUATION_PROBLEM_SETUP")
833  RETURN
834 999 errorsexits("POISEUILLE_EQUATION_PROBLEM_SETUP",err,error)
835  RETURN 1
836  END SUBROUTINE poiseuille_equation_problem_setup
837 
838  !
839  !================================================================================================================================
840  !
841 
843  SUBROUTINE poiseuille_finiteelementcalculate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
845  !Argument variables
846  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
847  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
848  INTEGER(INTG), INTENT(OUT) :: ERR
849  TYPE(varying_string), INTENT(OUT) :: ERROR
850  !Local Variables
851  INTEGER(INTG) FIELD_VAR_TYPE,ng
852  TYPE(basis_type), POINTER :: DEPENDENT_BASIS,GEOMETRIC_BASIS
853  TYPE(equations_type), POINTER :: EQUATIONS
854  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
855  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
856  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
857  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
858  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
859  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
860  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD
861  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
862  TYPE(quadrature_scheme_type), POINTER :: QUADRATURE_SCHEME
863  TYPE(varying_string) :: LOCAL_ERROR
864 
865  enters("Poiseuille_FiniteElementCalculate",err,error,*999)
866 
867  IF(ASSOCIATED(equations_set)) THEN
868  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
869  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
870  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
871  CALL flagerror("Equations set specification must have three entries for a Poiseuille type equations set.", &
872  & err,error,*999)
873  END IF
874  equations=>equations_set%EQUATIONS
875  IF(ASSOCIATED(equations)) THEN
876  SELECT CASE(equations_set%SPECIFICATION(3))
878  !Store all these in equations matrices/somewhere else?????
879  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
880  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
881  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
882  equations_matrices=>equations%EQUATIONS_MATRICES
883  linear_matrices=>equations_matrices%LINEAR_MATRICES
884  equations_matrix=>linear_matrices%MATRICES(1)%PTR
885  rhs_vector=>equations_matrices%RHS_VECTOR
886  equations_mapping=>equations%EQUATIONS_MAPPING
887  linear_mapping=>equations_mapping%LINEAR_MAPPING
888  field_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(1)%VARIABLE
889  field_var_type=field_variable%VARIABLE_TYPE
890  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
891  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
892  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
893  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
894  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
895  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
896  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
897  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
898  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
899  !Loop over gauss points
900  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
901  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
902  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
903  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
904  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
905  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
906  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
907 
908 !TODO
909 
910 
911  ENDDO !ng
912  CASE DEFAULT
913  local_error="Equations set subtype "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
914  & " is not valid for a Poiseuille equation type of a fluid mechanics equations set class."
915  CALL flagerror(local_error,err,error,*999)
916  END SELECT
917  ELSE
918  CALL flagerror("Equations set equations is not associated.",err,error,*999)
919  ENDIF
920  ELSE
921  CALL flagerror("Equations set is not associated.",err,error,*999)
922  ENDIF
923 
924  exits("Poiseuille_FiniteElementCalculate")
925  RETURN
926 999 errorsexits("Poiseuille_FiniteElementCalculate",err,error)
927  RETURN 1
928 
929  END SUBROUTINE poiseuille_finiteelementcalculate
930 
931  !
932  !================================================================================================================================
933  !
934 
936  SUBROUTINE poiseuille_problemspecificationset(problem,problemSpecification,err,error,*)
938  !Argument variables
939  TYPE(problem_type), POINTER :: problem
940  INTEGER(INTG), INTENT(IN) :: problemSpecification(:)
941  INTEGER(INTG), INTENT(OUT) :: err
942  TYPE(varying_string), INTENT(OUT) :: error
943  !Local Variables
944  TYPE(varying_string) :: localError
945  INTEGER(INTG) :: problemSubtype
946 
947  enters("Poiseuille_ProblemSpecificationSet",err,error,*999)
948 
949  IF(ASSOCIATED(problem)) THEN
950  IF(SIZE(problemspecification,1)==3) THEN
951  problemsubtype=problemspecification(3)
952  SELECT CASE(problemsubtype)
955  !ALl ok
956  CASE DEFAULT
957  localerror="The third problem specification of "//trim(numbertovstring(problemsubtype,"*",err,error))// &
958  & " is not valid for a Poiseuille fluid mechanics problem."
959  CALL flagerror(localerror,err,error,*999)
960  END SELECT
961  IF(ALLOCATED(problem%specification)) THEN
962  CALL flagerror("Problem specification is already allocated.",err,error,*999)
963  ELSE
964  ALLOCATE(problem%specification(3),stat=err)
965  IF(err/=0) CALL flagerror("Could not allocate problem specification.",err,error,*999)
966  END IF
967  problem%specification(1:3)=[problem_fluid_mechanics_class,problem_poiseuille_equation_type,problemsubtype]
968  ELSE
969  CALL flagerror("Poiseuille problem specification must have three entries.",err,error,*999)
970  END IF
971  ELSE
972  CALL flagerror("Problem is not associated.",err,error,*999)
973  END IF
974 
975  exits("Poiseuille_ProblemSpecificationSet")
976  RETURN
977 999 errors("Poiseuille_ProblemSpecificationSet",err,error)
978  exits("Poiseuille_ProblemSpecificationSet")
979  RETURN 1
980 
982 
983  !
984  !================================================================================================================================
985  !
986 
988  SUBROUTINE poiseuille_equation_problem_static_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
990  !Argument variables
991  TYPE(problem_type), POINTER :: PROBLEM
992  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
993  INTEGER(INTG), INTENT(OUT) :: ERR
994  TYPE(varying_string), INTENT(OUT) :: ERROR
995  !Local Variables
996  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT
997  TYPE(solver_type), POINTER :: SOLVER
998  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
999  TYPE(solvers_type), POINTER :: SOLVERS
1000  TYPE(varying_string) :: LOCAL_ERROR
1001 
1002  enters("POISEUILLE_EQUATION_PROBLEM_STATIC_SETUP",err,error,*999)
1003 
1004  NULLIFY(control_loop)
1005  NULLIFY(solver)
1006  NULLIFY(solver_equations)
1007  NULLIFY(solvers)
1008  IF(ASSOCIATED(problem)) THEN
1009  IF(.NOT.ALLOCATED(problem%specification)) THEN
1010  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1011  ELSE IF(SIZE(problem%specification,1)<3) THEN
1012  CALL flagerror("Problem specification must have three entries for a Poiseuille problem.",err,error,*999)
1013  END IF
1014  IF(problem%SPECIFICATION(3)==problem_static_poiseuille_subtype) THEN
1015  SELECT CASE(problem_setup%SETUP_TYPE)
1017  SELECT CASE(problem_setup%ACTION_TYPE)
1019  !Do nothing????
1021  !Do nothing????
1022  CASE DEFAULT
1023  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1024  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1025  & " is invalid for a static Poiseuille equation."
1026  CALL flagerror(local_error,err,error,*999)
1027  END SELECT
1029  SELECT CASE(problem_setup%ACTION_TYPE)
1031  !Set up a simple control loop
1032  CALL control_loop_create_start(problem,control_loop,err,error,*999)
1034  !Finish the control loops
1035  control_loop_root=>problem%CONTROL_LOOP
1036  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1037  CALL control_loop_create_finish(control_loop,err,error,*999)
1038  CASE DEFAULT
1039  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1040  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1041  & " is invalid for a static Poiseuille equation."
1042  CALL flagerror(local_error,err,error,*999)
1043  END SELECT
1045  !Get the control loop
1046  control_loop_root=>problem%CONTROL_LOOP
1047  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1048  SELECT CASE(problem_setup%ACTION_TYPE)
1050  !Start the solvers creation
1051  CALL solvers_create_start(control_loop,solvers,err,error,*999)
1052  CALL solvers_number_set(solvers,1,err,error,*999)
1053  !Set the solver to be a linear solver
1054  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1055  !Start the linear solver creation
1056  CALL solver_type_set(solver,solver_linear_type,err,error,*999)
1057  !Set solver defaults
1058  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
1060  !Get the solvers
1061  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
1062  !Finish the solvers creation
1063  CALL solvers_create_finish(solvers,err,error,*999)
1064  CASE DEFAULT
1065  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1066  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1067  & " is invalid for a static Poiseuille equation."
1068  CALL flagerror(local_error,err,error,*999)
1069  END SELECT
1071  SELECT CASE(problem_setup%ACTION_TYPE)
1073  !Get the control loop
1074  control_loop_root=>problem%CONTROL_LOOP
1075  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1076  !Get the solver
1077  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
1078  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1079  !Create the solver equations
1080  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
1081  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
1082  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
1083  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
1085  !Get the control loop
1086  control_loop_root=>problem%CONTROL_LOOP
1087  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1088  !Get the solver equations
1089  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
1090  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1091  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
1092  !Finish the solver equations creation
1093  CALL solver_equations_create_finish(solver_equations,err,error,*999)
1094  CASE DEFAULT
1095  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1096  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1097  & " is invalid for a static Poiseuille equation."
1098  CALL flagerror(local_error,err,error,*999)
1099  END SELECT
1100  CASE DEFAULT
1101  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1102  & " is invalid for a static Poiseuille equation."
1103  CALL flagerror(local_error,err,error,*999)
1104  END SELECT
1105  ELSE
1106  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
1107  & " does not equal a static Poiseuille equation subtype."
1108  CALL flagerror(local_error,err,error,*999)
1109  ENDIF
1110  ELSE
1111  CALL flagerror("Problem is not associated.",err,error,*999)
1112  ENDIF
1113 
1114  exits("POISEUILLE_EQUATION_PROBLEM_STATIC_SETUP")
1115  RETURN
1116 999 errorsexits("POISEUILLE_EQUATION_PROBLEM_STATIC_SETUP",err,error)
1117  RETURN 1
1119 
1120  !
1121  !================================================================================================================================
1122  !
1123 
1125  SUBROUTINE poiseuille_post_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
1127  !Argument variables
1128  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1129  TYPE(solver_type), POINTER :: SOLVER
1130  INTEGER(INTG), INTENT(OUT) :: ERR
1131  TYPE(varying_string), INTENT(OUT) :: ERROR
1132  !Local Variables
1133  TYPE(solver_type), POINTER :: SOLVER2
1134  TYPE(varying_string) :: LOCAL_ERROR
1135 
1136  enters("POISEUILLE_POST_SOLVE",err,error,*999)
1137  NULLIFY(solver2)
1138  IF(ASSOCIATED(control_loop)) THEN
1139  IF(ASSOCIATED(solver)) THEN
1140  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
1141  IF(.NOT.ALLOCATED(control_loop%problem%specification)) THEN
1142  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1143  ELSE IF(SIZE(control_loop%problem%specification,1)<3) THEN
1144  CALL flagerror("Problem specification must have three entries for a Poiseuille problem.",err,error,*999)
1145  END IF
1146  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
1148 ! do nothing
1150 ! do nothing
1151  CASE DEFAULT
1152  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
1153  & " is not valid for a Poiseuille type of a fluid mechanics problem class."
1154  CALL flagerror(local_error,err,error,*999)
1155  END SELECT
1156  ELSE
1157  CALL flagerror("Problem is not associated.",err,error,*999)
1158  ENDIF
1159  ELSE
1160  CALL flagerror("Solver is not associated.",err,error,*999)
1161  ENDIF
1162  ELSE
1163  CALL flagerror("Control loop is not associated.",err,error,*999)
1164  ENDIF
1165 
1166  exits("POISEUILLE_POST_SOLVE")
1167  RETURN
1168 999 errorsexits("POISEUILLE_POST_SOLVE",err,error)
1169  RETURN 1
1170  END SUBROUTINE poiseuille_post_solve
1171 
1172  !
1173  !================================================================================================================================
1174  !
1175 
1176 
1178  SUBROUTINE poiseuille_pre_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
1180  !Argument variables
1181  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1182  TYPE(solver_type), POINTER :: SOLVER
1183  INTEGER(INTG), INTENT(OUT) :: ERR
1184  TYPE(varying_string), INTENT(OUT) :: ERROR
1185  !Local Variables
1186  TYPE(solver_type), POINTER :: SOLVER2
1187  TYPE(varying_string) :: LOCAL_ERROR
1188 
1189  enters("POISEUILLE_PRE_SOLVE",err,error,*999)
1190  NULLIFY(solver2)
1191 
1192  IF(ASSOCIATED(control_loop)) THEN
1193  IF(ASSOCIATED(solver)) THEN
1194  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
1195  IF(.NOT.ALLOCATED(control_loop%problem%specification)) THEN
1196  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1197  ELSE IF(SIZE(control_loop%problem%specification,1)<3) THEN
1198  CALL flagerror("Problem specification must have three entries for a Poiseuille problem.",err,error,*999)
1199  END IF
1200  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
1202 ! do nothing
1204 ! do nothing
1205  CASE DEFAULT
1206  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
1207  & " is not valid for a Poiseuille type of a fluid mechanics problem class."
1208  CALL flagerror(local_error,err,error,*999)
1209  END SELECT
1210  ELSE
1211  CALL flagerror("Problem is not associated.",err,error,*999)
1212  ENDIF
1213  ELSE
1214  CALL flagerror("Solver is not associated.",err,error,*999)
1215  ENDIF
1216  ELSE
1217  CALL flagerror("Control loop is not associated.",err,error,*999)
1218  ENDIF
1219 
1220  exits("POISEUILLE_PRE_SOLVE")
1221  RETURN
1222 999 errorsexits("POISEUILLE_PRE_SOLVE",err,error)
1223  RETURN 1
1224  END SUBROUTINE poiseuille_pre_solve
1225 
1226  !
1227  !================================================================================================================================
1228  !
1229 
1230 
integer(intg), parameter equations_set_setup_dependent_type
Dependent variables.
integer(intg), parameter equations_set_fem_solution_method
Finite Element Method solution method.
This module contains all basis function routines.
integer(intg), parameter equations_set_setup_materials_type
Materials setup.
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 solvers_create_finish(SOLVERS, ERR, ERROR,)
Finish the creation of solvers.
subroutine, public poiseuille_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the equation specification for a Poiseuille fluid mechanics equations set.
subroutine, public poiseuille_problemspecificationset(problem, problemSpecification, err, error,)
Sets the problem specification for a Poiseuille problem.
Contains information on the equations mapping i.e., how field variable DOFS are mapped to the rows an...
Definition: types.f90:1681
Contains information about the equations in an equations set.
Definition: types.f90:1735
integer(intg), parameter equations_set_setup_generate_action
Generate setup action.
integer(intg), parameter equations_set_gfem_solution_method
Grid-based Finite Element Method solution method.
integer(intg), parameter problem_setup_control_type
Solver setup for a problem.
This module handles all problem wide constants.
integer(intg), parameter, public control_loop_node
The identifier for a each "leaf" node in a control loop.
integer(intg), parameter no_global_deriv
No global derivative i.e., u.
Definition: constants.f90:213
integer(intg), parameter problem_poiseuille_equation_type
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
subroutine, public equations_create_start(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Start the creation of equations for the equation set.
Contains information on the mesh decomposition.
Definition: types.f90:1063
subroutine, public equations_matrices_create_start(EQUATIONS, EQUATIONS_MATRICES, ERR, ERROR,)
Starts the creation of the equations matrices and rhs for the the equations.
Contains information on the type of solver to be used.
Definition: types.f90:2777
integer(intg), parameter, public solver_petsc_library
PETSc solver library.
subroutine, public solvers_number_set(SOLVERS, NUMBER_OF_SOLVERS, ERR, ERROR,)
Sets/changes the number of solvers.
integer(intg), parameter no_part_deriv
No partial derivative i.e., u.
Definition: constants.f90:177
This module handles all equations matrix and rhs routines.
subroutine, public solver_type_set(SOLVER, SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type for a solver.
integer(intg), parameter equations_static
The equations are static and have no time dependence.
Contains information on an equations set.
Definition: types.f90:1941
This module handles all equations routines.
integer(intg), parameter equations_set_setup_source_type
Source setup.
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.
subroutine, public poiseuille_finiteelementcalculate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element stiffness matrices and RHS for a Poiseuille equation finite element equations ...
Contains information on the solvers to be used in a control loop.
Definition: types.f90:2805
integer(intg), parameter problem_dynamic_poiseuille_subtype
integer(intg), parameter first_part_deriv
First partial derivative i.e., du/ds.
Definition: constants.f90:178
This module contains routines for timing the program.
Definition: timer_f.f90:45
integer(intg), parameter solver_equations_static
Solver equations are static.
subroutine, public equations_time_dependence_type_set(EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for equations.
subroutine, public solver_equations_sparsity_type_set(SOLVER_EQUATIONS, SPARSITY_TYPE, ERR, ERROR,)
Sets/changes the sparsity type for solver equations.
integer(intg), parameter equations_set_static_poiseuille_subtype
subroutine, public solvers_solver_get(SOLVERS, SOLVER_INDEX, SOLVER, ERR, ERROR,)
Returns a pointer to the specified solver in the list of solvers.
Contains information for a field defined on a region.
Definition: types.f90:1346
integer(intg), parameter, public equations_matrices_full_matrices
Use fully populated equation matrices.
subroutine, public poiseuille_post_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the Poiseuille problem post solve.
integer(intg), parameter equations_set_fluid_mechanics_class
subroutine, public equations_mapping_rhs_variable_type_set(EQUATIONS_MAPPING, RHS_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set rhs vector.
integer(intg), parameter solver_equations_linear
Solver equations are linear.
integer(intg), parameter global_deriv_s2
First global derivative in the s2 direction i.e., du/ds2.
Definition: constants.f90:215
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.
integer(intg), parameter, public basis_default_quadrature_scheme
Identifier for the default quadrature scheme.
integer(intg), parameter problem_setup_solvers_type
Solver setup for a problem.
integer(intg), parameter equations_set_setup_equations_type
Equations setup.
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 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 equationsmapping_linearmatricesnumberset(EQUATIONS_MAPPING, NUMBER_OF_LINEAR_EQUATIONS_MATRICES, ERR, ERROR,)
Sets/changes the number of linear equations matrices.
integer(intg), parameter problem_setup_initial_type
Initial setup for a problem.
subroutine, public equationsmapping_linearmatricesvariabletypesset(EQUATIONS_MAPPING, LINEAR_MATRIX_VARIABLE_TYPES, ERR, ERROR,)
Sets the mapping between the dependent field variable types and the linear equations matrices...
subroutine, public solver_equations_linearity_type_set(SOLVER_EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for solver equations.
integer(intg), parameter equations_set_setup_start_action
Start setup action.
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
Contains information on the equations matrices and vectors.
Definition: types.f90:1520
integer(intg), parameter, public equations_matrix_fem_structure
Finite element matrix structure.
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
Contains information of the linear matrices for equations matrices.
Definition: types.f90:1479
subroutine poiseuille_equationssetstaticsetup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the standard Poiseuille equation for linear sources.
subroutine, public equations_matrices_linear_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the linear equations matrices.
subroutine, public equationsmatrices_linearstructuretypeset(EQUATIONS_MATRICES, STRUCTURE_TYPE, ERR, ERROR,)
Sets the structure (sparsity) of the linear equations matrices.
subroutine, public equations_mapping_create_finish(EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping.
Returns the specified control loop as indexed by the control loop identifier from the control loop ro...
subroutine, public equations_set_equations_get(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Gets the equations for an equations set.
subroutine, public poiseuille_pre_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the Poiseuille problem pre solve.
subroutine, public equations_create_finish(EQUATIONS, ERR, ERROR,)
Finish the creation of equations.
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, public matrix_compressed_row_storage_type
Matrix compressed row storage type.
subroutine, public poiseuille_boundaryconditionsanalyticcalculate(EQUATIONS_SET, BOUNDARY_CONDITIONS, ERR, ERROR,)
Calculates the analytic solution and sets the boundary conditions for an analytic problem...
integer(intg), parameter equations_set_gfv_solution_method
Grid-based Finite Volume solution method.
integer(intg), parameter equations_set_setup_geometry_type
Geometry setup.
integer(intg), parameter global_deriv_s1_s2
Global Cross derivative in the s1 and s2 direction i.e., d^2u/ds1ds2.
Definition: constants.f90:216
Contains information for a problem.
Definition: types.f90:3221
integer(intg), parameter equations_set_poiseuille_equation_type
integer(intg), parameter equations_linear
The equations are linear.
Contains the topology information for the nodes of a domain.
Definition: types.f90:713
subroutine, public equations_matrices_create_finish(EQUATIONS_MATRICES, ERR, ERROR,)
Finishes the creation of the equations matrices and RHS for the the equations.
This module handles all distributed matrix vector routines.
This module handles all Poiseuille equations routines.
integer(intg), parameter global_deriv_s1
First global derivative in the s1 direction i.e., du/ds1.
Definition: constants.f90:214
This module handles all boundary conditions routines.
This module handles all solver routines.
subroutine, public poiseuille_equation_problem_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the Poiseuille problem.
subroutine, public equations_mapping_create_start(EQUATIONS, EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping for a equations set equations.
Contains information about an equations matrix.
Definition: types.f90:1429
Contains information for a particular quadrature scheme.
Definition: types.f90:141
This module contains all routines dealing with (non-distributed) matrix and vectors types...
subroutine, public equations_linearity_type_set(EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for equations.
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.
Sets a boundary condition on the specified local DOF.
integer(intg), parameter equations_set_poiseuille_equation_two_dim_1
u=tbd
Contains information for a field variable defined on a field.
Definition: types.f90:1289
integer(intg), parameter equations_set_fd_solution_method
Finite Difference solution method.
integer(intg), parameter, public equations_matrices_sparse_matrices
Use sparse equations matrices.
integer(intg), parameter equations_set_dynamic_poiseuille_subtype
Contains information on the setup information for an equations set.
Definition: types.f90:1866
A pointer to the domain decomposition for this domain.
Definition: types.f90:938
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 boundary_condition_fixed
The dof is fixed as a boundary condition.
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, public solver_solver_equations_get(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Returns a pointer to the solver equations for a solver.
Contains all information about a basis .
Definition: types.f90:184
integer(intg), parameter equations_set_fv_solution_method
Finite Volume solution method.
integer(intg), parameter, public matrix_block_storage_type
Matrix block storage type.
integer(intg), parameter equations_set_setup_initial_type
Initial setup.
recursive subroutine, public control_loop_create_finish(CONTROL_LOOP, ERR, ERROR,)
Finish the process of creating a control loop.
integer(intg), parameter equations_set_setup_analytic_type
Analytic setup.
Flags an error condition.
subroutine poiseuille_equation_problem_static_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the static Poiseuille equations problem.
integer(intg), parameter problem_static_poiseuille_subtype
integer(intg), parameter, public solver_linear_type
A linear solver.
integer(intg), parameter problem_fluid_mechanics_class
Contains information of the RHS vector for equations matrices.
Definition: types.f90:1500
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.
Contains information for mapping field variables to the linear matrices in the equations set of the m...
Definition: types.f90:1587
This module contains all kind definitions.
Definition: kinds.f90:45
Temporary IO routines for fluid mechanics.
integer(intg), parameter equations_set_setup_finish_action
Finish setup action.
This module handles all formating and input and output.