OpenCMISS-Iron Internal API Documentation
Navier_Stokes_equations_routines.f90
Go to the documentation of this file.
1 
43 
46 
49  USE base_routines
50  USE basis_routines
53  USE cmiss_mpi
55  USE constants
59  USE domain_mappings
64  USE field_routines
67  USE input_output
69  USE kinds
70  USE lapack
71  USE maths
72  USE matrix_vector
73  USE mesh_routines
74 #ifndef NOMPIMOD
75  USE mpi
76 #endif
77  USE node_routines
80  USE strings
81  USE solver_routines
82  USE timer
83  USE types
84 
85 #include "macros.h"
86 
87  IMPLICIT NONE
88 
89  PRIVATE
90 
91 #ifdef NOMPIMOD
92 #include "mpif.h"
93 #endif
94 
95  PUBLIC navier_stokes_analytic_functions_evaluate
96 
97  PUBLIC navierstokes_equationssetspecificationset
98 
99  PUBLIC navierstokes_equationssetsolutionmethodset
100 
101  PUBLIC navier_stokes_equations_set_setup
102 
103  PUBLIC navierstokes_presolvealeupdateparameters,navierstokes_presolveupdateboundaryconditions, &
104  & navier_stokes_pre_solve_ale_update_mesh
105 
106  PUBLIC navier_stokes_pre_solve, navier_stokes_post_solve
107 
108  PUBLIC navierstokes_problemspecificationset
109 
110  PUBLIC navier_stokes_problem_setup
111 
112  PUBLIC navierstokes_finiteelementresidualevaluate,navierstokes_finiteelementjacobianevaluate
113 
114  PUBLIC navierstokes_boundaryconditionsanalyticcalculate
115 
116  PUBLIC navierstokes_residualbasedstabilisation
117 
118  PUBLIC navierstokes_couple1d0d
119 
120  PUBLIC navierstokes_couplecharacteristics
121 
122  PUBLIC navierstokes_finiteelementpreresidualevaluate
123 
124  PUBLIC navierstokes_controllooppostloop
125 
126  PUBLIC navierstokes_updatemultiscaleboundary
127 
128 CONTAINS
129 
130 !
131 !================================================================================================================================
132 !
133 
135  SUBROUTINE navierstokes_equationssetsolutionmethodset(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)
137  !Argument variables
138  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
139  INTEGER(INTG), INTENT(IN) :: SOLUTION_METHOD
140  INTEGER(INTG), INTENT(OUT) :: ERR
141  TYPE(varying_string), INTENT(OUT) :: ERROR
142  !Local Variables
143  TYPE(varying_string) :: LOCAL_ERROR
144 
145  enters("NavierStokes_EquationsSetSolutionMethodSet",err,error,*999)
146 
147  IF(ASSOCIATED(equations_set)) THEN
148  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
149  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
150  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
151  CALL flagerror("Equations set specification must have three entries for a Navier-Stokes type equations set.", &
152  & err,error,*999)
153  END IF
154  SELECT CASE(equations_set%SPECIFICATION(3))
169  SELECT CASE(solution_method)
171  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
173  equations_set%SOLUTION_METHOD=equations_set_nodal_solution_method
175  CALL flagerror("Not implemented.",err,error,*999)
177  CALL flagerror("Not implemented.",err,error,*999)
179  CALL flagerror("Not implemented.",err,error,*999)
181  CALL flagerror("Not implemented.",err,error,*999)
183  CALL flagerror("Not implemented.",err,error,*999)
184  CASE DEFAULT
185  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))// &
186  & " is invalid."
187  CALL flagerror(local_error,err,error,*999)
188  END SELECT
189  CASE DEFAULT
190  local_error="Equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
191  & " is not valid for a Navier-Stokes flow equation type of a fluid mechanics equations set class."
192  CALL flagerror(local_error,err,error,*999)
193  END SELECT
194  ELSE
195  CALL flagerror("Equations set is not associated.",err,error,*999)
196  ENDIF
197 
198  exits("NavierStokes_EquationsSetSolutionMethodSet")
199  RETURN
200 999 errorsexits("NavierStokes_EquationsSetSolutionMethodSet",err,error)
201  RETURN 1
202 
203  END SUBROUTINE navierstokes_equationssetsolutionmethodset
204 
205 !
206 !================================================================================================================================
207 !
208 
210  SUBROUTINE navierstokes_equationssetspecificationset(equationsSet,specification,err,error,*)
212  !Argument variables
213  TYPE(equations_set_type), POINTER :: equationsSet
214  INTEGER(INTG), INTENT(IN) :: specification(:)
215  INTEGER(INTG), INTENT(OUT) :: err
216  TYPE(varying_string), INTENT(OUT) :: error
217  !Local Variables
218  TYPE(varying_string) :: localError
219  INTEGER(INTG) :: subtype
220 
221  enters("NavierStokes_EquationsSetSpecificationSet",err,error,*999)
222 
223  IF(ASSOCIATED(equationsset)) THEN
224  IF(SIZE(specification,1)/=3) THEN
225  CALL flagerror("Equations set specification must have three entries for a Navier-Stokes type equations set.", &
226  & err,error,*999)
227  ENDIF
228  subtype=specification(3)
229  SELECT CASE(subtype)
244  !ok
246  CALL flagerror("Not implemented yet.",err,error,*999)
247  CASE DEFAULT
248  localerror="The third equations set specification of "//trim(numbertovstring(specification(3),"*",err,error))// &
249  & " is not valid for a Navier-Stokes fluid mechanics equations set."
250  CALL flagerror(localerror,err,error,*999)
251  END SELECT
252  !Set full specification
253  IF(ALLOCATED(equationsset%specification)) THEN
254  CALL flagerror("Equations set specification is already allocated.",err,error,*999)
255  ELSE
256  ALLOCATE(equationsset%specification(3),stat=err)
257  IF(err/=0) CALL flagerror("Could not allocate equations set specification.",err,error,*999)
258  ENDIF
260  ELSE
261  CALL flagerror("Equations set is not associated.",err,error,*999)
262  ENDIF
263 
264  exits("NavierStokes_EquationsSetSpecificationSet")
265  RETURN
266 999 errors("NavierStokes_EquationsSetSpecificationSet",err,error)
267  exits("NavierStokes_EquationsSetSpecificationSet")
268  RETURN 1
269 
270  END SUBROUTINE navierstokes_equationssetspecificationset
271 
272 !
273 !================================================================================================================================
274 !
275 
277  SUBROUTINE navier_stokes_equations_set_setup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
279  !Argument variables
280  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
281  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
282  INTEGER(INTG), INTENT(OUT) :: ERR
283  TYPE(varying_string), INTENT(OUT) :: ERROR
284  !Local Variables
285  TYPE(decomposition_type), POINTER :: GEOMETRIC_DECOMPOSITION
286  TYPE(equations_type), POINTER :: EQUATIONS
287  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
288  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
289  TYPE(equations_set_analytic_type), POINTER :: EQUATIONS_ANALYTIC
290  TYPE(equations_set_materials_type), POINTER :: EQUATIONS_MATERIALS
291  TYPE(equations_set_equations_set_field_type), POINTER :: EQUATIONS_EQUATIONS_SET_FIELD
292  TYPE(field_type), POINTER :: EQUATIONS_SET_FIELD_FIELD,ANALYTIC_FIELD,DEPENDENT_FIELD,GEOMETRIC_FIELD
293  TYPE(varying_string) :: LOCAL_ERROR
294  INTEGER(INTG) :: GEOMETRIC_SCALING_TYPE,GEOMETRIC_MESH_COMPONENT,INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS
295  INTEGER(INTG) :: NUMBER_OF_ANALYTIC_COMPONENTS,DEPENDENT_FIELD_NUMBER_OF_VARIABLES,DEPENDENT_FIELD_NUMBER_OF_COMPONENTS
296  INTEGER(INTG) :: NUMBER_OF_DIMENSIONS,GEOMETRIC_COMPONENT_NUMBER,I,componentIdx,INDEPENDENT_FIELD_NUMBER_OF_VARIABLES
297  INTEGER(INTG) :: MATERIAL_FIELD_NUMBER_OF_VARIABLES,MATERIAL_FIELD_NUMBER_OF_COMPONENTS1,MATERIAL_FIELD_NUMBER_OF_COMPONENTS2
298  INTEGER(INTG) :: elementBasedComponents,nodeBasedComponents,constantBasedComponents
299  INTEGER(INTG) :: EQUATIONS_SET_FIELD_NUMBER_OF_VARIABLES,EQUATIONS_SET_FIELD_NUMBER_OF_COMPONENTS
300 
301  enters("NAVIER_STOKES_EQUATIONS_SET_SETUP",err,error,*999)
302 
303  NULLIFY(equations)
304  NULLIFY(equations_mapping)
305  NULLIFY(equations_matrices)
306  NULLIFY(geometric_decomposition)
307  NULLIFY(equations_equations_set_field)
308  NULLIFY(equations_set_field_field)
309 
310  IF(ASSOCIATED(equations_set)) THEN
311  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
312  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
313  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
314  CALL flagerror("Equations set specification must have three entries for a Navier-Stokes type equations set.", &
315  & err,error,*999)
316  END IF
317  SELECT CASE(equations_set%SPECIFICATION(3))
332  SELECT CASE(equations_set_setup%SETUP_TYPE)
333  !-----------------------------------------------------------------
334  ! I n i t i a l s e t u p
335  !-----------------------------------------------------------------
337  SELECT CASE(equations_set%SPECIFICATION(3))
341  SELECT CASE(equations_set_setup%ACTION_TYPE)
343  CALL navierstokes_equationssetsolutionmethodset(equations_set, &
344  & equations_set_fem_solution_method,err,error,*999)
345  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
347  !Do nothing
348  CASE DEFAULT
349  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE, &
350  & "*",err,error))// " for a setup type of "//trim(number_to_vstring(equations_set_setup% &
351  & setup_type,"*",err,error))// " is not implemented for a Navier-Stokes fluid."
352  CALL flagerror(local_error,err,error,*999)
353  END SELECT
358  SELECT CASE(equations_set_setup%ACTION_TYPE)
360  CALL navierstokes_equationssetsolutionmethodset(equations_set, &
361  & equations_set_fem_solution_method,err,error,*999)
362  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
363  equations_set_field_number_of_variables = 1
364  equations_set_field_number_of_components = 1
365  equations_equations_set_field=>equations_set%EQUATIONS_SET_FIELD
366  IF(equations_equations_set_field%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN
367  !Create the auto created equations set field field for SUPG element metrics
368  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
369  & equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD,err,error,*999)
370  equations_set_field_field=>equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD
371  CALL field_label_set(equations_set_field_field,"Equations Set Field",err,error,*999)
372  CALL field_type_set_and_lock(equations_set_field_field,field_general_type,&
373  & err,error,*999)
374  CALL field_number_of_variables_set(equations_set_field_field, &
375  & equations_set_field_number_of_variables,err,error,*999)
376  CALL field_variable_types_set_and_lock(equations_set_field_field,&
377  & [field_u_variable_type],err,error,*999)
378  CALL field_variable_label_set(equations_set_field_field,field_u_variable_type, &
379  & "Penalty Coefficient",err,error,*999)
380  CALL field_data_type_set_and_lock(equations_set_field_field,field_u_variable_type, &
381  & field_dp_type,err,error,*999)
382  CALL field_number_of_components_set_and_lock(equations_set_field_field,&
383  & field_u_variable_type,equations_set_field_number_of_components,err,error,*999)
384  END IF
386  IF(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN
387  CALL field_create_finish(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,err,error,*999)
388  !Default the penalty coefficient value to 1E4
389  CALL field_component_values_initialise(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
390  & field_u_variable_type,field_values_set_type,1,1.0e4_dp,err,error,*999)
391  END IF
392  CASE DEFAULT
393  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE, &
394  & "*",err,error))// " for a setup type of "//trim(number_to_vstring(equations_set_setup% &
395  & setup_type,"*",err,error))// " is not implemented for a Navier-Stokes fluid."
396  CALL flagerror(local_error,err,error,*999)
397  END SELECT
402  SELECT CASE(equations_set_setup%ACTION_TYPE)
404  CALL navierstokes_equationssetsolutionmethodset(equations_set, &
405  & equations_set_fem_solution_method,err,error,*999)
406  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
407  equations_set_field_number_of_variables = 3
408  nodebasedcomponents = 1 ! boundary flux
409  elementbasedcomponents = 10 ! 4 element metrics, 3 boundary normal components, boundaryID, boundaryType, C1
410  constantbasedcomponents = 4 ! maxCFL, boundaryStabilisationBeta, timeIncrement, stabilisationType
411  equations_equations_set_field=>equations_set%EQUATIONS_SET_FIELD
412  IF(equations_equations_set_field%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN
413  !Create the auto created equations set field field for SUPG element metrics
414  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
415  & equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD,err,error,*999)
416  equations_set_field_field=>equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD
417  CALL field_label_set(equations_set_field_field,"Equations Set Field",err,error,*999)
418  CALL field_type_set_and_lock(equations_set_field_field,field_general_type,&
419  & err,error,*999)
420  CALL field_number_of_variables_set(equations_set_field_field, &
421  & equations_set_field_number_of_variables,err,error,*999)
422  CALL field_variable_types_set_and_lock(equations_set_field_field,&
423  & [field_u_variable_type,field_v_variable_type,field_u1_variable_type],err,error,*999)
424  CALL field_variable_label_set(equations_set_field_field,field_u_variable_type, &
425  & "BoundaryFlow",err,error,*999)
426  CALL field_variable_label_set(equations_set_field_field,field_v_variable_type, &
427  & "ElementMetrics",err,error,*999)
428  CALL field_variable_label_set(equations_set_field_field,field_u1_variable_type, &
429  & "EquationsConstants",err,error,*999)
430  CALL field_data_type_set_and_lock(equations_set_field_field,field_u_variable_type, &
431  & field_dp_type,err,error,*999)
432  CALL field_data_type_set_and_lock(equations_set_field_field,field_v_variable_type, &
433  & field_dp_type,err,error,*999)
434  CALL field_data_type_set_and_lock(equations_set_field_field,field_u1_variable_type, &
435  & field_dp_type,err,error,*999)
436  CALL field_number_of_components_set_and_lock(equations_set_field_field,&
437  & field_u_variable_type,nodebasedcomponents,err,error,*999)
438  CALL field_number_of_components_set_and_lock(equations_set_field_field,&
439  & field_v_variable_type,elementbasedcomponents,err,error,*999)
440  CALL field_number_of_components_set_and_lock(equations_set_field_field,&
441  & field_u1_variable_type,constantbasedcomponents,err,error,*999)
442  ELSE
443  local_error="User-specified fields are not yet implemented for an equations set field field &
444  & setup type of "//trim(number_to_vstring(equations_set_setup% &
445  & setup_type,"*",err,error))// " for a Navier-Stokes fluid."
446  END IF
448  IF(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN
449  CALL field_create_finish(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,err,error,*999)
450  !Default the Element Metrics parameter values 0.0
451  nodebasedcomponents = 1 ! boundary flux
452  elementbasedcomponents = 10 ! 4 element metrics, 3 boundary normal components, boundaryID, boundaryType, C1
453  constantbasedcomponents = 4 ! maxCFL, boundaryStabilisationBeta, timeIncrement, stabilisationType
454  ! Init boundary flux to 0
455  CALL field_component_values_initialise(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
456  & field_u_variable_type,field_values_set_type,1,0.0_dp,err,error,*999)
457  ! Init Element Metrics to 0 (except C1)
458  DO componentidx=1,elementbasedcomponents-1
459  CALL field_component_values_initialise(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
460  & field_v_variable_type,field_values_set_type,componentidx,0.0_dp,err,error,*999)
461  END DO
462  ! Default C1 to -1 for now, will be calculated in ResidualBasedStabilisation if not specified by user
463  CALL field_component_values_initialise(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
464  & field_v_variable_type,field_values_set_type,elementbasedcomponents,-1.0_dp,err,error,*999)
465  ! Boundary stabilisation scale factor (beta): default to 0
466  CALL field_component_values_initialise(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
467  & field_u1_variable_type,field_values_set_type,1,0.0_dp,err,error,*999)
468  ! Max Courant (CFL) number: default to 1.0
469  CALL field_component_values_initialise(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
470  & field_u1_variable_type,field_values_set_type,2,1.0_dp,err,error,*999)
471  ! Init Time increment to 0
472  CALL field_component_values_initialise(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
473  & field_u1_variable_type,field_values_set_type,3,0.0_dp,err,error,*999)
474  ! Stabilisation type: default to 1 for RBS (0=none, 2=RBVM)
475  CALL field_component_values_initialise(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
476  & field_u1_variable_type,field_values_set_type,4,1.0_dp,err,error,*999)
477  ELSE
478  local_error="User-specified fields are not yet implemented for an equations set field field &
479  & setup type of "//trim(number_to_vstring(equations_set_setup% &
480  & setup_type,"*",err,error))// " for a Navier-Stokes fluid."
481  END IF
482  CASE DEFAULT
483  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE, &
484  & "*",err,error))// " for a setup type of "//trim(number_to_vstring(equations_set_setup% &
485  & setup_type,"*",err,error))// " is not implemented for a Navier-Stokes fluid."
486  CALL flagerror(local_error,err,error,*999)
487  END SELECT
488  CASE DEFAULT
489  local_error="The equation set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
490  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
491  & " is invalid for a Navier-Stokes equation."
492  CALL flagerror(local_error,err,error,*999)
493  END SELECT
494  !-----------------------------------------------------------------
495  ! G e o m e t r i c f i e l d
496  !-----------------------------------------------------------------
498  SELECT CASE(equations_set%SPECIFICATION(3))
502  !Do nothing???
507  SELECT CASE(equations_set_setup%ACTION_TYPE)
509  equations_set_field_number_of_components = 1
510  equations_equations_set_field=>equations_set%EQUATIONS_SET_FIELD
511  equations_set_field_field=>equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD
512  IF(equations_equations_set_field%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN
513  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
514  CALL field_mesh_decomposition_set_and_lock(equations_set_field_field,&
515  & geometric_decomposition,err,error,*999)
516  CALL field_geometric_field_set_and_lock(equations_set_field_field,&
517  & equations_set%GEOMETRY%GEOMETRIC_FIELD,err,error,*999)
518  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
519  & 1,geometric_component_number,err,error,*999)
520  DO componentidx = 1, equations_set_field_number_of_components
521  CALL field_component_mesh_component_set_and_lock(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
522  & field_u_variable_type,componentidx,geometric_component_number,err,error,*999)
523  CALL field_component_interpolation_set_and_lock(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
524  & field_u_variable_type,componentidx,field_constant_interpolation,err,error,*999)
525  END DO
526  !Default the field scaling to that of the geometric field
527  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
528  CALL field_scaling_type_set(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,geometric_scaling_type, &
529  & err,error,*999)
530  ENDIF
532  ! do nothing
533  CASE DEFAULT
534  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
535  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
536  & " is invalid for a linear diffusion equation."
537  CALL flagerror(local_error,err,error,*999)
538  END SELECT
543  SELECT CASE(equations_set_setup%ACTION_TYPE)
545  nodebasedcomponents = 1 ! boundary flux
546  elementbasedcomponents = 10 ! 4 element metrics, 3 boundary normal components, boundaryID, boundaryType, C1
547  constantbasedcomponents = 4 ! maxCFL, boundaryStabilisationBeta, timeIncrement, stabilisationType
548  equations_equations_set_field=>equations_set%EQUATIONS_SET_FIELD
549  equations_set_field_field=>equations_equations_set_field%EQUATIONS_SET_FIELD_FIELD
550  IF(equations_equations_set_field%EQUATIONS_SET_FIELD_AUTO_CREATED) THEN
551  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
552  CALL field_mesh_decomposition_set_and_lock(equations_set_field_field,&
553  & geometric_decomposition,err,error,*999)
554  CALL field_geometric_field_set_and_lock(equations_set_field_field,&
555  & equations_set%GEOMETRY%GEOMETRIC_FIELD,err,error,*999)
556  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
557  & 1,geometric_component_number,err,error,*999)
558  CALL field_component_mesh_component_set_and_lock(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
559  & field_u_variable_type,1,geometric_component_number,err,error,*999)
560  CALL field_component_interpolation_set_and_lock(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
561  & field_u_variable_type,1,field_node_based_interpolation,err,error,*999)
562  ! Element-based fields
563  DO componentidx = 1, elementbasedcomponents
564  CALL field_component_mesh_component_set_and_lock(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
565  & field_v_variable_type,componentidx,geometric_component_number,err,error,*999)
566  CALL field_component_interpolation_set_and_lock(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
567  & field_v_variable_type,componentidx,field_element_based_interpolation,err,error,*999)
568  END DO
569  ! Constant fields: boundary stabilisation scale factor and max courant #
570  DO componentidx = 1, constantbasedcomponents
571  CALL field_component_mesh_component_set_and_lock(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
572  & field_u1_variable_type,componentidx,geometric_component_number,err,error,*999)
573  CALL field_component_interpolation_set_and_lock(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD, &
574  & field_u1_variable_type,componentidx,field_constant_interpolation,err,error,*999)
575  END DO
576  !Default the field scaling to that of the geometric field
577  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
578  CALL field_scaling_type_set(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,geometric_scaling_type, &
579  & err,error,*999)
580  ELSE
581  !Do nothing
582  END IF
584  ! do nothing
585  CASE DEFAULT
586  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
587  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
588  & " is invalid for a linear diffusion equation."
589  CALL flagerror(local_error,err,error,*999)
590  END SELECT
591  CASE DEFAULT
592  local_error="The equation set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
593  & " is invalid for a Navier-Stokes equation."
594  CALL flagerror(local_error,err,error,*999)
595  END SELECT
596  !-----------------------------------------------------------------
597  ! D e p e n d e n t f i e l d
598  !-----------------------------------------------------------------
600  SELECT CASE(equations_set%SPECIFICATION(3))
608  SELECT CASE(equations_set_setup%ACTION_TYPE)
609  !Set start action
611  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
612  !Create the auto created dependent field
613  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
614  & equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
615  CALL field_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
616  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
617  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
618  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
619  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
620  & geometric_decomposition,err,error,*999)
621  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
622  & geometric_field,err,error,*999)
623  dependent_field_number_of_variables=2
624  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
625  & dependent_field_number_of_variables,err,error,*999)
626  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,[field_u_variable_type, &
627  & field_deludeln_variable_type],err,error,*999)
628  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
629  & "U",err,error,*999)
630  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
631  & "del U/del n",err,error,*999)
632  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
633  & field_vector_dimension_type,err,error,*999)
634  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
635  & field_vector_dimension_type,err,error,*999)
636  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
637  & field_dp_type,err,error,*999)
638  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
639  & field_dp_type,err,error,*999)
640  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
641  & number_of_dimensions,err,error,*999)
642  !calculate number of components with one component for each dimension and one for pressure
643  dependent_field_number_of_components=number_of_dimensions+1
644  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
645  & field_u_variable_type,dependent_field_number_of_components,err,error,*999)
646  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
647  & field_deludeln_variable_type,dependent_field_number_of_components,err,error,*999)
648  !Default to the geometric interpolation setup
649  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
650  & 1,geometric_mesh_component,err,error,*999)
651  DO componentidx=1,dependent_field_number_of_components
652  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
653  & field_u_variable_type,componentidx,geometric_mesh_component,err,error,*999)
654  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
655  & field_deludeln_variable_type,componentidx,geometric_mesh_component,err,error,*999)
656  END DO !componentIdx
657  SELECT CASE(equations_set%SOLUTION_METHOD)
659  DO componentidx=1,dependent_field_number_of_components
660  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
661  & field_u_variable_type,componentidx,field_node_based_interpolation,err,error,*999)
662  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
663  & field_deludeln_variable_type,componentidx,field_node_based_interpolation,err,error,*999)
664  END DO !componentIdx
665  !Default geometric field scaling
666  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
667  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
668  !Other solutions not defined yet
670  CALL flagerror("Not implemented.",err,error,*999)
672  CALL flagerror("Not implemented.",err,error,*999)
674  CALL flagerror("Not implemented.",err,error,*999)
676  CALL flagerror("Not implemented.",err,error,*999)
678  CALL flagerror("Not implemented.",err,error,*999)
679  CASE DEFAULT
680  local_error="The solution method of " &
681  & //trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// " is invalid."
682  CALL flagerror(local_error,err,error,*999)
683  END SELECT
684  ELSE
685  !Check the user specified field
686  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
687  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
688  dependent_field_number_of_variables=2
689  CALL field_number_of_variables_check(equations_set_setup%FIELD,dependent_field_number_of_variables,err,error,*999)
690  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type, &
691  & field_deludeln_variable_type],err,error,*999)
692  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
693  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type, &
694  & err,error,*999)
695  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
696  & err,error,*999)
697  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
698  & field_vector_dimension_type,err,error,*999)
699  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
700  & number_of_dimensions,err,error,*999)
701  !calculate number of components with one component for each dimension and one for pressure
702  dependent_field_number_of_components=number_of_dimensions+1
703  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
704  & dependent_field_number_of_components,err,error,*999)
705  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
706  & dependent_field_number_of_components,err,error,*999)
707  SELECT CASE(equations_set%SOLUTION_METHOD)
709  DO componentidx=1,dependent_field_number_of_components
710  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type, &
711  & componentidx,field_node_based_interpolation,err,error,*999)
712  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
713  & componentidx,field_node_based_interpolation,err,error,*999)
714  END DO !componentIdx
716  CALL flagerror("Not implemented.",err,error,*999)
718  CALL flagerror("Not implemented.",err,error,*999)
720  CALL flagerror("Not implemented.",err,error,*999)
722  CALL flagerror("Not implemented.",err,error,*999)
724  CALL flagerror("Not implemented.",err,error,*999)
725  CASE DEFAULT
726  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD, &
727  & "*",err,error))//" is invalid."
728  CALL flagerror(local_error,err,error,*999)
729  END SELECT
730  END IF
731  !Specify finish action
733  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
734  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
735  CALL field_number_of_components_get(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
736  & dependent_field_number_of_components,err,error,*999)
737  IF(equations_set%specification(3)==equations_set_static_rbs_navier_stokes_subtype .OR. &
738  & equations_set%specification(3)==equations_set_transient_rbs_navier_stokes_subtype .OR. &
739  & equations_set%specification(3)==equations_set_multiscale3d_navier_stokes_subtype) THEN
740  CALL field_parameter_set_create(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
741  & field_pressure_values_set_type,err,error,*999)
742  DO componentidx=1,dependent_field_number_of_components
743  CALL field_component_values_initialise(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
744  & field_pressure_values_set_type,componentidx,0.0_dp,err,error,*999)
745  END DO
746  END IF
747  END IF
748  CASE DEFAULT
749  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*", &
750  & err,error))//" for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE, &
751  & "*",err,error))//" is invalid for a Navier-Stokes fluid."
752  CALL flagerror(local_error,err,error,*999)
753  END SELECT
756  SELECT CASE(equations_set_setup%ACTION_TYPE)
757  !Set start action
759  !set number of variables to 5 (U,DELUDELN,V,U1,U2)
760  dependent_field_number_of_variables=5
761  !calculate number of components (Q,A) for U and dUdN
762  dependent_field_number_of_components=2
763  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
764  !Create the auto created dependent field
765  !start field creation with name 'DEPENDENT_FIELD'
766  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
767  & equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
768  !start creation of a new field
769  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
770  !label the field
771  CALL field_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
772  !define new created field to be dependent
773  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
774  & field_dependent_type,err,error,*999)
775  !look for decomposition rule already defined
776  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
777  & err,error,*999)
778  !apply decomposition rule found on new created field
779  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
780  & geometric_decomposition,err,error,*999)
781  !point new field to geometric field
782  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
783  & geometric_field,err,error,*999)
784  !set number of variables to 6 (U,DELUDELN,V,U1,U2)
785  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
786  & dependent_field_number_of_variables,err,error,*999)
787  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,[field_u_variable_type, &
788  & field_deludeln_variable_type,field_v_variable_type,field_u1_variable_type,field_u2_variable_type], &
789  & err,error,*999)
790  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
791  & field_vector_dimension_type,err,error,*999)
792  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
793  & field_vector_dimension_type,err,error,*999)
794  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
795  & field_vector_dimension_type,err,error,*999)
796  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u1_variable_type, &
797  & field_vector_dimension_type,err,error,*999)
798  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u2_variable_type, &
799  & field_vector_dimension_type,err,error,*999)
800  !set data type
801  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
802  & field_dp_type,err,error,*999)
803  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
804  & field_dp_type,err,error,*999)
805  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
806  & field_dp_type,err,error,*999)
807  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u1_variable_type, &
808  & field_dp_type,err,error,*999)
809  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u2_variable_type, &
810  & field_dp_type,err,error,*999)
811 
812  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
813  & number_of_dimensions,err,error,*999)
814  !calculate number of components
815  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
816  & field_u_variable_type,dependent_field_number_of_components,err,error,*999)
817  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
818  & field_deludeln_variable_type,dependent_field_number_of_components,err,error,*999)
819  ! 2 component (W1,W2) for V
820  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
821  & field_v_variable_type,dependent_field_number_of_components,err,error,*999)
822  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
823  & field_u1_variable_type,dependent_field_number_of_components,err,error,*999)
824  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
825  & field_u2_variable_type,dependent_field_number_of_components,err,error,*999)
826  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
827  & number_of_dimensions,geometric_mesh_component,err,error,*999)
828  !Default to the geometric interpolation setup
829  DO i=1,dependent_field_number_of_components
830  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
831  & field_u_variable_type,i,geometric_mesh_component,err,error,*999)
832  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
833  & field_deludeln_variable_type,i,geometric_mesh_component,err,error,*999)
834  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
835  & field_v_variable_type,i,geometric_mesh_component,err,error,*999)
836  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
837  & field_u1_variable_type,i,geometric_mesh_component,err,error,*999)
838  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
839  & field_u2_variable_type,i,geometric_mesh_component,err,error,*999)
840  END DO
841  SELECT CASE(equations_set%SOLUTION_METHOD)
842  !Specify fem solution method
844  DO i=1,dependent_field_number_of_components
845  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
846  & field_u_variable_type,i,field_node_based_interpolation,err,error,*999)
847  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
848  & field_deludeln_variable_type,i,field_node_based_interpolation,err,error,*999)
849  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
850  & field_u1_variable_type,1,field_node_based_interpolation,err,error,*999)
851  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
852  & field_u2_variable_type,1,field_node_based_interpolation,err,error,*999)
853  END DO
854  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
855  & err,error,*999)
856  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type, &
857  & err,error,*999)
859  CALL flagerror("Not implemented.",err,error,*999)
861  CALL flagerror("Not implemented.",err,error,*999)
863  CALL flagerror("Not implemented.",err,error,*999)
865  CALL flagerror("Not implemented.",err,error,*999)
867  CALL flagerror("Not implemented.",err,error,*999)
868  CASE DEFAULT
869  local_error="The solution method of " &
870  & //trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// " is invalid."
871  CALL flagerror(local_error,err,error,*999)
872  END SELECT
873  ELSE
874  !Check the user specified field- Characteristic equations
875  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
876  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
877  CALL field_number_of_variables_check(equations_set_setup%FIELD,dependent_field_number_of_variables, &
878  & err,error,*999)
879  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type, &
880  & field_deludeln_variable_type,field_v_variable_type,field_u1_variable_type,field_u2_variable_type], &
881  & err,error,*999)
882  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type, &
883  & field_vector_dimension_type,err,error,*999)
884  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
885  & field_vector_dimension_type,err,error,*999)
886  CALL field_dimension_check(equations_set_setup%FIELD,field_v_variable_type, &
887  & field_vector_dimension_type,err,error,*999)
888  CALL field_dimension_check(equations_set_setup%FIELD,field_u1_variable_type, &
889  & field_vector_dimension_type,err,error,*999)
890  CALL field_dimension_check(equations_set_setup%FIELD,field_u2_variable_type, &
891  & field_vector_dimension_type,err,error,*999)
892 
893  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
894  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type, &
895  & err,error,*999)
896  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_dp_type,err,error,*999)
897  CALL field_data_type_check(equations_set_setup%FIELD,field_u1_variable_type,field_dp_type,err,error,*999)
898  CALL field_data_type_check(equations_set_setup%FIELD,field_u2_variable_type,field_dp_type,err,error,*999)
899  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
900  & number_of_dimensions,err,error,*999)
901  !calculate number of components (Q,A) for U and dUdN
902  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
903  & dependent_field_number_of_components,err,error,*999)
904  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
905  & dependent_field_number_of_components,err,error,*999)
906  ! 2 component (W1,W2) for V
907  CALL field_number_of_components_check(equations_set_setup%FIELD,field_v_variable_type, &
908  & dependent_field_number_of_components,err,error,*999)
909  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u1_variable_type, &
910  & dependent_field_number_of_components,err,error,*999)
911  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u2_variable_type, &
912  & dependent_field_number_of_components,err,error,*999)
913  SELECT CASE(equations_set%SOLUTION_METHOD)
915  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
916  & field_node_based_interpolation,err,error,*999)
917  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
918  & field_node_based_interpolation,err,error,*999)
919  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,1, &
920  & field_node_based_interpolation,err,error,*999)
921  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u1_variable_type,1, &
922  & field_node_based_interpolation,err,error,*999)
923  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u2_variable_type,1, &
924  & field_node_based_interpolation,err,error,*999)
926  CALL flagerror("Not implemented.",err,error,*999)
928  CALL flagerror("Not implemented.",err,error,*999)
930  CALL flagerror("Not implemented.",err,error,*999)
932  CALL flagerror("Not implemented.",err,error,*999)
934  CALL flagerror("Not implemented.",err,error,*999)
935  CASE DEFAULT
936  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD, &
937  & "*",err,error))//" is invalid."
938  CALL flagerror(local_error,err,error,*999)
939  END SELECT
940  END IF
941  !Specify finish action
943  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
944  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
945  END IF
946  CASE DEFAULT
947  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*", &
948  & err,error))//" for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE, &
949  & "*",err,error))//" is invalid for a Navier-Stokes fluid."
950  CALL flagerror(local_error,err,error,*999)
951  END SELECT
954  SELECT CASE(equations_set_setup%ACTION_TYPE)
955  !Set start action
957  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
958  !Create the auto created dependent field
959  !start field creation with name 'DEPENDENT_FIELD'
960  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
961  & equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
962  !start creation of a new field
963  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
964  !label the field
965  CALL field_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
966  !define new created field to be dependent
967  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
968  & field_dependent_type,err,error,*999)
969  !look for decomposition rule already defined
970  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
971  & err,error,*999)
972  !apply decomposition rule found on new created field
973  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
974  & geometric_decomposition,err,error,*999)
975  !point new field to geometric field
976  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
977  & geometric_field,err,error,*999)
978  !set number of variables to 5 (U,DELUDELN,V,U1,U2)
979  dependent_field_number_of_variables=5
980  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
981  & dependent_field_number_of_variables,err,error,*999)
982  IF(equations_set%specification(3)==equations_set_coupled1d0d_adv_navier_stokes_subtype) THEN
983  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,[field_u_variable_type, &
984  & field_deludeln_variable_type,field_v_variable_type,field_u1_variable_type,field_u2_variable_type, &
985  & field_u3_variable_type],err,error,*999)
986  ELSE
987  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,[field_u_variable_type, &
988  & field_deludeln_variable_type,field_v_variable_type,field_u1_variable_type,field_u2_variable_type], &
989  & err,error,*999)
990  END IF
991  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
992  & field_vector_dimension_type,err,error,*999)
993  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
994  & field_vector_dimension_type,err,error,*999)
995  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
996  & field_vector_dimension_type,err,error,*999)
997  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u1_variable_type, &
998  & field_vector_dimension_type,err,error,*999)
999  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u2_variable_type, &
1000  & field_vector_dimension_type,err,error,*999)
1001  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1002  & field_dp_type,err,error,*999)
1003  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
1004  & field_dp_type,err,error,*999)
1005  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_v_variable_type, &
1006  & field_dp_type,err,error,*999)
1007  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u1_variable_type, &
1008  & field_dp_type,err,error,*999)
1009  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u2_variable_type, &
1010  & field_dp_type,err,error,*999)
1011  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1012  & number_of_dimensions,err,error,*999)
1013  !calculate number of components (Q,A)
1014  dependent_field_number_of_components=2
1015  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1016  & field_u_variable_type,dependent_field_number_of_components,err,error,*999)
1017  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1018  & field_deludeln_variable_type,dependent_field_number_of_components,err,error,*999)
1019  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1020  & field_v_variable_type,dependent_field_number_of_components,err,error,*999)
1021  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1022  & field_u1_variable_type,1,err,error,*999)
1023  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1024  & field_u2_variable_type,1,err,error,*999)
1025  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1026  & number_of_dimensions,geometric_mesh_component,err,error,*999)
1027  !Default to the geometric interpolation setup
1028  DO i=1,dependent_field_number_of_components
1029  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1030  & field_u_variable_type,i,geometric_mesh_component,err,error,*999)
1031  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1032  & field_deludeln_variable_type,i,geometric_mesh_component,err,error,*999)
1033  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1034  & field_v_variable_type,i,geometric_mesh_component,err,error,*999)
1035  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1036  & field_u1_variable_type,i,geometric_mesh_component,err,error,*999)
1037  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1038  & field_u2_variable_type,i,geometric_mesh_component,err,error,*999)
1039  END DO
1040  SELECT CASE(equations_set%SOLUTION_METHOD)
1041  !Specify fem solution method
1043  DO i=1,dependent_field_number_of_components
1044  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1045  & field_u_variable_type,i,field_node_based_interpolation,err,error,*999)
1046  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1047  & field_deludeln_variable_type,i,field_node_based_interpolation,err,error,*999)
1048  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1049  & field_v_variable_type,i,field_node_based_interpolation,err,error,*999)
1050  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1051  & field_u1_variable_type,i,field_node_based_interpolation,err,error,*999)
1052  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1053  & field_u2_variable_type,i,field_node_based_interpolation,err,error,*999)
1054  END DO
1055  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
1056  & err,error,*999)
1057  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type, &
1058  & err,error,*999)
1060  CALL flagerror("Not implemented.",err,error,*999)
1062  CALL flagerror("Not implemented.",err,error,*999)
1064  CALL flagerror("Not implemented.",err,error,*999)
1066  CALL flagerror("Not implemented.",err,error,*999)
1068  CALL flagerror("Not implemented.",err,error,*999)
1069  CASE DEFAULT
1070  local_error="The solution method of " &
1071  & //trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// " is invalid."
1072  CALL flagerror(local_error,err,error,*999)
1073  END SELECT
1074  ELSE
1075  !set number of variables to 5 (U,DELUDELN,V,U1,U2)
1076  dependent_field_number_of_variables=5
1077  !Check the user specified field- Characteristic equations
1078  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1079  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
1080  CALL field_number_of_variables_check(equations_set_setup%FIELD,dependent_field_number_of_variables,err,error,*999)
1081  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type, &
1082  & field_deludeln_variable_type,field_v_variable_type,field_u1_variable_type,field_u2_variable_type], &
1083  & err,error,*999)
1084  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type, &
1085  & field_vector_dimension_type,err,error,*999)
1086  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
1087  & field_vector_dimension_type,err,error,*999)
1088  CALL field_dimension_check(equations_set_setup%FIELD,field_v_variable_type, &
1089  & field_vector_dimension_type,err,error,*999)
1090  CALL field_dimension_check(equations_set_setup%FIELD,field_u1_variable_type, &
1091  & field_vector_dimension_type,err,error,*999)
1092  CALL field_dimension_check(equations_set_setup%FIELD,field_u2_variable_type, &
1093  & field_vector_dimension_type,err,error,*999)
1094  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1095  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type, &
1096  & err,error,*999)
1097  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_dp_type,err,error,*999)
1098  CALL field_data_type_check(equations_set_setup%FIELD,field_u1_variable_type,field_dp_type,err,error,*999)
1099  CALL field_data_type_check(equations_set_setup%FIELD,field_u2_variable_type,field_dp_type,err,error,*999)
1100  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1101  & number_of_dimensions,err,error,*999)
1102  !calculate number of components (Q,A) for U and dUdN
1103  dependent_field_number_of_components=2
1104  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
1105  & dependent_field_number_of_components,err,error,*999)
1106  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
1107  & dependent_field_number_of_components,err,error,*999)
1108  CALL field_number_of_components_check(equations_set_setup%FIELD,field_v_variable_type, &
1109  & dependent_field_number_of_components,err,error,*999)
1110  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u1_variable_type, &
1111  & dependent_field_number_of_components,err,error,*999)
1112  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u2_variable_type, &
1113  & dependent_field_number_of_components,err,error,*999)
1114  SELECT CASE(equations_set%SOLUTION_METHOD)
1116  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
1117  & field_node_based_interpolation,err,error,*999)
1118  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
1119  & field_node_based_interpolation,err,error,*999)
1120  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,1, &
1121  & field_node_based_interpolation,err,error,*999)
1122  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u1_variable_type,1, &
1123  & field_node_based_interpolation,err,error,*999)
1124  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u2_variable_type,1, &
1125  & field_node_based_interpolation,err,error,*999)
1127  CALL flagerror("Not implemented.",err,error,*999)
1129  CALL flagerror("Not implemented.",err,error,*999)
1131  CALL flagerror("Not implemented.",err,error,*999)
1133  CALL flagerror("Not implemented.",err,error,*999)
1135  CALL flagerror("Not implemented.",err,error,*999)
1136  CASE DEFAULT
1137  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD, &
1138  & "*",err,error))//" is invalid."
1139  CALL flagerror(local_error,err,error,*999)
1140  END SELECT
1141  END IF
1142  !Specify finish action
1144  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
1145  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
1146  END IF
1147  CASE DEFAULT
1148  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*", &
1149  & err,error))//" for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE, &
1150  & "*",err,error))//" is invalid for a Navier-Stokes fluid."
1151  CALL flagerror(local_error,err,error,*999)
1152  END SELECT
1153  CASE DEFAULT
1154  local_error="The equation set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
1155  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1156  & " is invalid for a Navier-Stokes equation."
1157  CALL flagerror(local_error,err,error,*999)
1158  END SELECT
1159  !-----------------------------------------------------------------
1160  ! I n d e p e n d e n t f i e l d
1161  !-----------------------------------------------------------------
1163  SELECT CASE(equations_set%SPECIFICATION(3))
1165  SELECT CASE(equations_set_setup%ACTION_TYPE)
1166  !Set start action
1168  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
1169  !Create the auto created independent field
1170  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
1171  & equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
1172  CALL field_label_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,"Independent Field",err,error,*999)
1173  CALL field_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
1174  CALL field_dependent_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1175  & field_independent_type,err,error,*999)
1176  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
1177  & err,error,*999)
1178  CALL field_mesh_decomposition_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1179  & geometric_decomposition,err,error,*999)
1180  CALL field_geometric_field_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,equations_set% &
1181  & geometry%GEOMETRIC_FIELD,err,error,*999)
1182  independent_field_number_of_variables=1
1183  CALL field_number_of_variables_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1184  & independent_field_number_of_variables,err,error,*999)
1185  CALL field_variable_types_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1186  & [field_u_variable_type],err,error,*999)
1187  CALL field_variable_label_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1188  & "U",err,error,*999)
1189  CALL field_dimension_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1190  & field_vector_dimension_type,err,error,*999)
1191  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1192  & field_dp_type,err,error,*999)
1193  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1194  & number_of_dimensions,err,error,*999)
1195  !calculate number of components with one component for each dimension
1196  independent_field_number_of_components=number_of_dimensions
1197  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1198  & field_u_variable_type,independent_field_number_of_components,err,error,*999)
1199  !Default to the geometric interpolation setup
1200  DO componentidx=1,independent_field_number_of_components
1201  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1202  & componentidx,geometric_mesh_component,err,error,*999)
1203  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1204  & field_u_variable_type,componentidx,geometric_mesh_component,err,error,*999)
1205  END DO !componentIdx
1206  SELECT CASE(equations_set%SOLUTION_METHOD)
1207  !Specify fem solution method
1209  DO componentidx=1,independent_field_number_of_components
1210  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1211  & field_u_variable_type,componentidx,field_node_based_interpolation,err,error,*999)
1212  END DO !componentIdx
1213  !Default geometric field scaling
1214  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
1215  CALL field_scaling_type_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
1216  !Other solutions not defined yet
1217  CASE DEFAULT
1218  local_error="The solution method of " &
1219  & //trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// " is invalid."
1220  CALL flagerror(local_error,err,error,*999)
1221  END SELECT
1222  ELSE
1223  !Check the user specified field
1224  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1225  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1226  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
1227  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
1228  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1229  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
1230  & err,error,*999)
1231  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1232  & number_of_dimensions,err,error,*999)
1233  !calculate number of components with one component for each dimension
1234  independent_field_number_of_components=number_of_dimensions
1235  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
1236  & independent_field_number_of_components,err,error,*999)
1237  SELECT CASE(equations_set%SOLUTION_METHOD)
1239  DO componentidx=1,independent_field_number_of_components
1240  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
1241  & field_node_based_interpolation,err,error,*999)
1242  END DO !componentIdx
1243  CASE DEFAULT
1244  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD, &
1245  &"*",err,error))//" is invalid."
1246  CALL flagerror(local_error,err,error,*999)
1247  END SELECT
1248  END IF
1249  !Specify finish action
1251  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
1252  CALL field_create_finish(equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
1253  CALL field_parameter_set_create(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1254  & field_mesh_displacement_set_type,err,error,*999)
1255  CALL field_parameter_set_create(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1256  & field_mesh_velocity_set_type,err,error,*999)
1257  CALL field_parameter_set_create(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1258  & field_boundary_set_type,err,error,*999)
1259  END IF
1260  CASE DEFAULT
1261  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1262  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1263  & " is invalid for a standard Navier-Stokes fluid"
1264  CALL flagerror(local_error,err,error,*999)
1265  END SELECT
1268  SELECT CASE(equations_set_setup%ACTION_TYPE)
1269  !Set start action
1271  !set number of variables to 1
1272  independent_field_number_of_variables=1
1273  !normalDirection for wave relative to node for W1,W2
1274  independent_field_number_of_components=2
1275  !Create the auto created independent field
1276  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
1277  !start field creation with name 'INDEPENDENT_FIELD'
1278  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
1279  & equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
1280  !start creation of a new field
1281  CALL field_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
1282  !label the field
1283  CALL field_label_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,"Independent Field",err,error, &
1284  & *999)
1285  !define new created field to be independent
1286  CALL field_dependent_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1287  & field_independent_type,err,error,*999)
1288  !look for decomposition rule already defined
1289  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
1290  & err,error,*999)
1291  !apply decomposition rule found on new created field
1292  CALL field_mesh_decomposition_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1293  & geometric_decomposition,err,error,*999)
1294  !point new field to geometric field
1295  CALL field_geometric_field_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,equations_set% &
1296  & geometry%GEOMETRIC_FIELD,err,error,*999)
1297  !set number of variables to 1
1298  CALL field_number_of_variables_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1299  & independent_field_number_of_variables,err,error,*999)
1300  CALL field_variable_types_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1301  & [field_u_variable_type],err,error,*999)
1302  CALL field_dimension_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1303  & field_vector_dimension_type,err,error,*999)
1304  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1305  & field_dp_type,err,error,*999)
1306  !calculate number of components with one component for each dimension
1307  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1308  & field_u_variable_type,independent_field_number_of_components,err,error,*999)
1309  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1310  & 1,geometric_mesh_component,err,error,*999)
1311  !Default to the geometric interpolation setup
1312  DO i=1,independent_field_number_of_components
1313  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1314  & field_u_variable_type,i,geometric_mesh_component,err,error,*999)
1315  END DO
1316  SELECT CASE(equations_set%SOLUTION_METHOD)
1317  !Specify fem solution method
1319  DO componentidx=1,independent_field_number_of_components
1320  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1321  & field_u_variable_type,componentidx,field_node_based_interpolation,err,error,*999)
1322  END DO !componentIdx
1323  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
1324  & err,error,*999)
1325  CALL field_scaling_type_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_scaling_type, &
1326  & err,error,*999)
1328  DO componentidx=1,independent_field_number_of_components
1329  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1330  & field_u_variable_type,componentidx,field_node_based_interpolation,err,error,*999)
1331  END DO !componentIdx
1332  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
1333  & err,error,*999)
1334  CALL field_scaling_type_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_scaling_type, &
1335  & err,error,*999)
1336  CASE DEFAULT
1337  local_error="The solution method of " &
1338  & //trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// " is invalid."
1339  CALL flagerror(local_error,err,error,*999)
1340  END SELECT
1341  ELSE
1342  !Check the user specified field- Characteristic equation
1343  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1344  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1345  CALL field_number_of_variables_check(equations_set_setup%FIELD,independent_field_number_of_variables, &
1346  & err,error,*999)
1347  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
1348  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
1349  & err,error,*999)
1350  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1351  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
1352  & independent_field_number_of_components,err,error,*999)
1353  END IF
1354  !Specify finish action
1356  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
1357  CALL field_create_finish(equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
1358  END IF
1359  CASE DEFAULT
1360  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1361  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1362  & " is invalid for a standard Navier-Stokes fluid"
1363  CALL flagerror(local_error,err,error,*999)
1364  END SELECT
1367  SELECT CASE(equations_set_setup%ACTION_TYPE)
1368  !Set start action
1370  !set number of variables to 1
1371  independent_field_number_of_variables=1
1372  !normalDirection for wave relative to node for W1,W2
1373  independent_field_number_of_components=2
1374  !Create the auto created independent field
1375  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
1376  ! Do nothing? independent field should be set up by characteristic equation routines
1377  ELSE
1378  !Check the user specified field- Characteristic equation
1379  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1380  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1381  CALL field_number_of_variables_check(equations_set_setup%FIELD,independent_field_number_of_variables, &
1382  & err,error,*999)
1383  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
1384  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
1385  & err,error,*999)
1386  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1387  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
1388  & independent_field_number_of_components,err,error,*999)
1389  END IF
1390  !Specify finish action
1392  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
1393  CALL field_create_finish(equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
1394  END IF
1395  CASE DEFAULT
1396  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1397  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1398  & " is invalid for a standard Navier-Stokes fluid"
1399  CALL flagerror(local_error,err,error,*999)
1400  END SELECT
1404  SELECT CASE(equations_set_setup%ACTION_TYPE)
1405  !Set start action
1407  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
1408  !Create the auto created independent field
1409  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
1410  & equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
1411  CALL field_label_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,"Independent Field",err,error,*999)
1412  CALL field_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
1413  CALL field_dependent_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1414  & field_independent_type,err,error,*999)
1415  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
1416  & err,error,*999)
1417  CALL field_mesh_decomposition_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1418  & geometric_decomposition,err,error,*999)
1419  CALL field_geometric_field_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,equations_set% &
1420  & geometry%GEOMETRIC_FIELD,err,error,*999)
1421  independent_field_number_of_variables=1
1422  CALL field_number_of_variables_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1423  & independent_field_number_of_variables,err,error,*999)
1424  CALL field_variable_types_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1425  & [field_u_variable_type],err,error,*999)
1426  CALL field_variable_label_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1427  & "U",err,error,*999)
1428  CALL field_dimension_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1429  & field_vector_dimension_type,err,error,*999)
1430  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1431  & field_dp_type,err,error,*999)
1432  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1433  & number_of_dimensions,err,error,*999)
1434  !calculate number of components with one component for each dimension
1435  independent_field_number_of_components=number_of_dimensions
1436  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1437  & field_u_variable_type,independent_field_number_of_components,err,error,*999)
1438  !Default to the geometric interpolation setup
1439  DO componentidx=1,independent_field_number_of_components
1440  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1441  & componentidx,geometric_mesh_component,err,error,*999)
1442  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1443  & field_u_variable_type,componentidx,geometric_mesh_component,err,error,*999)
1444  END DO !componentIdx
1445  SELECT CASE(equations_set%SOLUTION_METHOD)
1446  !Specify fem solution method
1448  DO componentidx=1,independent_field_number_of_components
1449  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1450  & field_u_variable_type,componentidx,field_node_based_interpolation,err,error,*999)
1451  END DO !componentIdx
1452  !Default geometric field scaling
1453  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
1454  CALL field_scaling_type_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
1455  !Other solutions not defined yet
1456  CASE DEFAULT
1457  local_error="The solution method of " &
1458  & //trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// " is invalid."
1459  CALL flagerror(local_error,err,error,*999)
1460  END SELECT
1461  ELSE
1462  !Check the user specified field
1463  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1464  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1465  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
1466  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
1467  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1468  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
1469  & err,error,*999)
1470  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1471  & number_of_dimensions,err,error,*999)
1472  !calculate number of components with one component for each dimension
1473  independent_field_number_of_components=number_of_dimensions
1474  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
1475  & independent_field_number_of_components,err,error,*999)
1476  SELECT CASE(equations_set%SOLUTION_METHOD)
1478  DO componentidx=1,independent_field_number_of_components
1479  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
1480  & field_node_based_interpolation,err,error,*999)
1481  END DO !componentIdx
1482  CASE DEFAULT
1483  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD, &
1484  &"*",err,error))//" is invalid."
1485  CALL flagerror(local_error,err,error,*999)
1486  END SELECT
1487  END IF
1488  !Specify finish action
1490  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
1491  CALL field_create_finish(equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
1492  CALL field_parameter_set_create(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1493  & field_mesh_displacement_set_type,err,error,*999)
1494  CALL field_parameter_set_create(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1495  & field_mesh_velocity_set_type,err,error,*999)
1496  CALL field_parameter_set_create(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1497  & field_boundary_set_type,err,error,*999)
1498  END IF
1499  CASE DEFAULT
1500  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1501  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1502  & " is invalid for a standard Navier-Stokes fluid"
1503  CALL flagerror(local_error,err,error,*999)
1504  END SELECT
1505  CASE DEFAULT
1506  local_error="The equation set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
1507  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1508  & " is invalid for a Navier-Stokes equation."
1509  CALL flagerror(local_error,err,error,*999)
1510  END SELECT
1511  !-----------------------------------------------------------------
1512  ! A n a l y t i c t y p e
1513  !-----------------------------------------------------------------
1515  SELECT CASE(equations_set%SPECIFICATION(3))
1528  SELECT CASE(equations_set_setup%ACTION_TYPE)
1529  !Set start action
1531  equations_analytic=>equations_set%ANALYTIC
1532  IF(ASSOCIATED(equations_analytic)) THEN
1533  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
1534  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
1535  IF(ASSOCIATED(dependent_field)) THEN
1536  equations_materials=>equations_set%MATERIALS
1537  IF(ASSOCIATED(equations_materials)) THEN
1538  IF(equations_materials%MATERIALS_FINISHED) THEN
1539  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
1540  IF(ASSOCIATED(geometric_field)) THEN
1541  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1542  & number_of_dimensions,err,error,*999)
1543  SELECT CASE(equations_set_setup%ANALYTIC_FUNCTION_TYPE)
1545  !Set analtyic function type
1546  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_two_dim_poiseuille
1547  !Check that domain is 2D
1548  IF(number_of_dimensions/=2) THEN
1549  local_error="The number of geometric dimensions of "// &
1550  & trim(number_to_vstring(number_of_dimensions,"*",err,error))// &
1551  & " is invalid. The analytic function type of "// &
1552  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
1553  & " requires that there be 2 geometric dimensions."
1554  CALL flagerror(local_error,err,error,*999)
1555  END IF
1556  !Check the materials values are constant
1557  CALL field_component_interpolation_check(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1558  & 1,field_constant_interpolation,err,error,*999)
1559  CALL field_component_interpolation_check(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1560  & 2,field_constant_interpolation,err,error,*999)
1561  !Set analytic function type
1562  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_setup%ANALYTIC_FUNCTION_TYPE
1563  number_of_analytic_components=4
1568  !Check that this is a 1D equations set
1569  IF(equations_set%SPECIFICATION(3)==equations_set_transient1d_navier_stokes_subtype .OR. &
1570  & equations_set%SPECIFICATION(3)==equations_set_coupled1d0d_navier_stokes_subtype .OR. &
1571  & equations_set%SPECIFICATION(3)==equations_set_transient1d_adv_navier_stokes_subtype .OR. &
1572  & equations_set%SPECIFICATION(3)==equations_set_coupled1d0d_adv_navier_stokes_subtype) THEN
1573  !Set analytic function type
1574  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_setup%ANALYTIC_FUNCTION_TYPE
1575  !Set numbrer of components- Q,A (same as N-S depenedent field)
1576  number_of_analytic_components=2
1577  ELSE
1578  local_error="The third equations set specification must by a TRANSIENT1D or COUPLED1D0D "// &
1579  & "to use an analytic function of type "// &
1580  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))//"."
1581  CALL flagerror(local_error,err,error,*999)
1582  END IF
1584  !Check that domain is 2D/3D
1585  IF(number_of_dimensions<2 .OR. number_of_dimensions>3) THEN
1586  local_error="The number of geometric dimensions of "// &
1587  & trim(number_to_vstring(number_of_dimensions,"*",err,error))// &
1588  & " is invalid. The analytic function type of "// &
1589  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
1590  & " requires that there be 2 or 3 geometric dimensions."
1591  CALL flagerror(local_error,err,error,*999)
1592  END IF
1593  !Set analytic function type
1594  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_setup%ANALYTIC_FUNCTION_TYPE
1595  !Set numbrer of components
1596  number_of_analytic_components=10
1598  !Set analtyic function type
1599  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_two_dim_taylor_green
1600  !Check that domain is 2D
1601  IF(number_of_dimensions/=2) THEN
1602  local_error="The number of geometric dimensions of "// &
1603  & trim(number_to_vstring(number_of_dimensions,"*",err,error))// &
1604  & " is invalid. The analytic function type of "// &
1605  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
1606  & " requires that there be 2 geometric dimensions."
1607  CALL flagerror(local_error,err,error,*999)
1608  END IF
1609  !Check the materials values are constant
1610  CALL field_component_interpolation_check(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1611  & 1,field_constant_interpolation,err,error,*999)
1612  CALL field_component_interpolation_check(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1613  & 2,field_constant_interpolation,err,error,*999)
1614  !Set analytic function type
1615  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_setup%ANALYTIC_FUNCTION_TYPE
1616  number_of_analytic_components=2
1618  !Set analtyic function type
1619  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_two_dim_1
1621  !Set analtyic function type
1622  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_two_dim_2
1624  !Set analtyic function type
1625  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_two_dim_3
1627  !Set analtyic function type
1628  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_two_dim_4
1630  !Set analtyic function type
1631  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_two_dim_5
1633  !Set analtyic function type
1634  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_three_dim_1
1636  !Set analtyic function type
1637  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_three_dim_2
1639  !Set analtyic function type
1640  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_three_dim_3
1642  !Set analtyic function type
1643  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_three_dim_4
1645  !Set analtyic function type
1646  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_three_dim_5
1648  !Set analtyic function type
1649  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_one_dim_1
1650  CASE DEFAULT
1651  local_error="The specified analytic function type of "// &
1652  & trim(number_to_vstring(equations_set_setup%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
1653  & " is invalid for an analytic Navier-Stokes problem."
1654  CALL flagerror(local_error,err,error,*999)
1655  END SELECT
1656  !Create analytic field if required
1657  IF(number_of_analytic_components>=1) THEN
1658  IF(equations_analytic%ANALYTIC_FIELD_AUTO_CREATED) THEN
1659  !Create the auto created analytic field
1660  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
1661  & equations_analytic%ANALYTIC_FIELD,err,error,*999)
1662  CALL field_label_set(equations_analytic%ANALYTIC_FIELD,"Analytic Field",err,error,*999)
1663  CALL field_type_set_and_lock(equations_analytic%ANALYTIC_FIELD,field_general_type,err,error,*999)
1664  CALL field_dependent_type_set_and_lock(equations_analytic%ANALYTIC_FIELD,field_independent_type, &
1665  & err,error,*999)
1666  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
1667  & err,error,*999)
1668  CALL field_mesh_decomposition_set_and_lock(equations_analytic%ANALYTIC_FIELD, &
1669  & geometric_decomposition,err,error,*999)
1670  CALL field_geometric_field_set_and_lock(equations_analytic%ANALYTIC_FIELD,equations_set%GEOMETRY% &
1671  & geometric_field,err,error,*999)
1672  CALL field_number_of_variables_set_and_lock(equations_analytic%ANALYTIC_FIELD,1,err,error,*999)
1673  CALL field_variable_types_set_and_lock(equations_analytic%ANALYTIC_FIELD,[field_u_variable_type], &
1674  & err,error,*999)
1675  CALL field_variable_label_set(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1676  & "Analytic",err,error,*999)
1677  CALL field_dimension_set_and_lock(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1678  & field_vector_dimension_type,err,error,*999)
1679  CALL field_data_type_set_and_lock(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1680  & field_dp_type,err,error,*999)
1681  !Set the number of analytic components
1682  CALL field_number_of_components_set_and_lock(equations_analytic%ANALYTIC_FIELD, &
1683  & field_u_variable_type,number_of_analytic_components,err,error,*999)
1684  !Default the analytic components to the 1st geometric interpolation setup with constant interpolation
1685  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD, &
1686  & field_u_variable_type,1,geometric_mesh_component,err,error,*999)
1687  DO componentidx=1,number_of_analytic_components
1688  CALL field_component_mesh_component_set(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1689  & componentidx,geometric_mesh_component,err,error,*999)
1690  IF(equations_set_setup%ANALYTIC_FUNCTION_TYPE == &
1692  CALL field_component_interpolation_set(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1693  & componentidx,field_node_based_interpolation,err,error,*999)
1694  ELSE
1695  CALL field_component_interpolation_set(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1696  & componentidx,field_constant_interpolation,err,error,*999)
1697  END IF
1698  END DO !componentIdx
1699  !Default the field scaling to that of the geometric field
1700  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
1701  & err,error,*999)
1702  CALL field_scaling_type_set(equations_analytic%ANALYTIC_FIELD,geometric_scaling_type,err,error,*999)
1703  ELSE
1704  !Check the user specified field
1705  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1706  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1707  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
1708  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
1709  IF(number_of_analytic_components==1) THEN
1710  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type, &
1711  & field_scalar_dimension_type,err,error,*999)
1712  ELSE
1713  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type, &
1714  & field_vector_dimension_type,err,error,*999)
1715  END IF
1716  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type, &
1717  & err,error,*999)
1718  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
1719  & number_of_analytic_components,err,error,*999)
1720  END IF
1721  END IF
1722  ELSE
1723  CALL flagerror("Equations set materials is not finished.",err,error,*999)
1724  END IF
1725  ELSE
1726  CALL flagerror("Equations set materials is not associated.",err,error,*999)
1727  END IF
1728  ELSE
1729  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
1730  END IF
1731  ELSE
1732  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
1733  END IF
1734  ELSE
1735  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
1736  END IF
1737  ELSE
1738  CALL flagerror("Equations analytic is not associated.",err,error,*999)
1739  END IF
1741  equations_analytic=>equations_set%ANALYTIC
1742  IF(ASSOCIATED(equations_analytic)) THEN
1743  analytic_field=>equations_analytic%ANALYTIC_FIELD
1744  IF(ASSOCIATED(analytic_field)) THEN
1745  IF(equations_analytic%ANALYTIC_FIELD_AUTO_CREATED) THEN
1746  !Finish creating the analytic field
1747  CALL field_create_finish(equations_analytic%ANALYTIC_FIELD,err,error,*999)
1748  !Set the default values for the analytic field
1749  SELECT CASE(equations_set%SPECIFICATION(3))
1752  SELECT CASE(equations_analytic%ANALYTIC_FUNCTION_TYPE)
1754  !Default the analytic parameter values (L, H, U_mean, Pout) to 0.0
1755  CALL field_component_values_initialise(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1756  & field_values_set_type,1,0.0_dp,err,error,*999)
1757  CALL field_component_values_initialise(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1758  & field_values_set_type,2,0.0_dp,err,error,*999)
1759  CALL field_component_values_initialise(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1760  & field_values_set_type,3,0.0_dp,err,error,*999)
1761  CALL field_component_values_initialise(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1762  & field_values_set_type,4,0.0_dp,err,error,*999)
1763  CASE DEFAULT
1764  local_error="The analytic function type of "// &
1765  & trim(number_to_vstring(equations_analytic%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
1766  & " is invalid for an analytical static Navier-Stokes equation."
1767  CALL flagerror(local_error,err,error,*999)
1768  END SELECT
1773  SELECT CASE(equations_analytic%ANALYTIC_FUNCTION_TYPE)
1775  !Default the analytic parameter values (U_characteristic, L) to 0.0
1776  CALL field_component_values_initialise(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1777  & field_values_set_type,1,0.0_dp,err,error,*999)
1778  CALL field_component_values_initialise(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1779  & field_values_set_type,2,0.0_dp,err,error,*999)
1781  !Default the analytic parameter values to 0
1782  number_of_analytic_components = 10
1783  DO componentidx = 1,number_of_analytic_components
1784  CALL field_component_values_initialise(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1785  & field_values_set_type,componentidx,0.0_dp,err,error,*999)
1786  END DO
1787  CASE DEFAULT
1788  local_error="The analytic function type of "// &
1789  & trim(number_to_vstring(equations_analytic%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
1790  & " is invalid for an analytical transient Navier-Stokes equation."
1791  CALL flagerror(local_error,err,error,*999)
1792  END SELECT
1797  SELECT CASE(equations_analytic%ANALYTIC_FUNCTION_TYPE)
1802  !Default the analytic parameter period values to 0
1803  CALL field_component_values_initialise(equations_analytic%ANALYTIC_FIELD,field_u_variable_type, &
1804  & field_values_set_type,1,0.0_dp,err,error,*999)
1805  CASE DEFAULT
1806  local_error="The analytic function type of "// &
1807  & trim(number_to_vstring(equations_analytic%ANALYTIC_FUNCTION_TYPE,"*",err,error))// &
1808  & " is invalid for a 1D Navier-Stokes equation."
1809  CALL flagerror(local_error,err,error,*999)
1810  END SELECT
1811  CASE DEFAULT
1812  local_error="The third equations set specification of "// &
1813  & trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
1814  & " is invalid for an analytical Navier-Stokes equation set."
1815  CALL flagerror(local_error,err,error,*999)
1816  END SELECT
1817  END IF
1818  END IF
1819  ELSE
1820  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
1821  END IF
1822  CASE DEFAULT
1823  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1824  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1825  & " is invalid for an analytic Navier-Stokes problem."
1826  CALL flagerror(local_error,err,error,*999)
1827  END SELECT
1828  CASE DEFAULT
1829  local_error="The third equations set specification of "// &
1830  & trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
1831  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1832  & " is invalid for a Navier-Stokes equation set."
1833  CALL flagerror(local_error,err,error,*999)
1834  END SELECT
1835  !-----------------------------------------------------------------
1836  ! M a t e r i a l s f i e l d
1837  !-----------------------------------------------------------------
1839  SELECT CASE(equations_set%SPECIFICATION(3))
1846  material_field_number_of_variables=1
1847  material_field_number_of_components1=2! viscosity, density
1848  SELECT CASE(equations_set_setup%ACTION_TYPE)
1849  !Specify start action
1851  equations_materials=>equations_set%MATERIALS
1852  IF(ASSOCIATED(equations_materials)) THEN
1853  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
1854  !Create the auto created materials field
1855  !start field creation with name 'MATERIAL_FIELD'
1856  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
1857  & equations_set%MATERIALS%MATERIALS_FIELD,err,error,*999)
1858  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
1859  !label the field
1860  CALL field_label_set(equations_materials%MATERIALS_FIELD,"Materials Field",err,error,*999)
1861  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type, &
1862  & err,error,*999)
1863  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
1864  & err,error,*999)
1865  !apply decomposition rule found on new created field
1866  CALL field_mesh_decomposition_set_and_lock(equations_set%MATERIALS%MATERIALS_FIELD, &
1867  & geometric_decomposition,err,error,*999)
1868  !point new field to geometric field
1869  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
1870  & geometric_field,err,error,*999)
1871  CALL field_number_of_variables_set(equations_materials%MATERIALS_FIELD, &
1872  & material_field_number_of_variables,err,error,*999)
1873  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD, &
1874  &[field_u_variable_type],err,error,*999)
1875  CALL field_variable_label_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1876  & "Materials",err,error,*999)
1877  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1878  & field_vector_dimension_type,err,error,*999)
1879  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1880  & field_dp_type,err,error,*999)
1881  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD, &
1882  & field_u_variable_type,material_field_number_of_components1,err,error,*999)
1883  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD, &
1884  & field_u_variable_type,1,geometric_component_number,err,error,*999)
1885  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1886  & 1,geometric_component_number,err,error,*999)
1887  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1888  & 1,field_constant_interpolation,err,error,*999)
1889  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1890  & 2,field_constant_interpolation,err,error,*999)
1891  !Default the field scaling to that of the geometric field
1892  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
1893  & err,error,*999)
1894  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
1895  ELSE
1896  !Check the user specified field
1897  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
1898  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1899  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
1900  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type],err,error,*999)
1901  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type, &
1902  & field_vector_dimension_type,err,error,*999)
1903  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type, &
1904  & err,error,*999)
1905  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1906  & number_of_dimensions,err,error,*999)
1907  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1,err,error,*999)
1908  END IF
1909  ELSE
1910  CALL flagerror("Equations set materials is not associated.",err,error,*999)
1911  END IF
1912  !Specify start action
1914  equations_materials=>equations_set%MATERIALS
1915  IF(ASSOCIATED(equations_materials)) THEN
1916  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
1917  !Finish creating the materials field
1918  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
1919  !Set the default values for the materials field
1920  ! viscosity,density=1
1921  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1922  & field_values_set_type,1,1.0_dp,err,error,*999)
1923  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1924  & field_values_set_type,2,1.0_dp,err,error,*999)
1925  END IF
1926  ELSE
1927  CALL flagerror("Equations set materials is not associated.",err,error,*999)
1928  END IF
1929  CASE DEFAULT
1930  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*", &
1931  & err,error))//" for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*", &
1932  & err,error))//" is invalid for Navier-Stokes equation."
1933  CALL flagerror(local_error,err,error,*999)
1934  END SELECT
1936  material_field_number_of_variables=2
1937  material_field_number_of_components1=2! U_var (constant) : viscosity scale, density
1938  material_field_number_of_components2=2! V_var (gaussBased): viscosity, shear rate
1939  SELECT CASE(equations_set_setup%ACTION_TYPE)
1940  !Specify start action
1942  equations_materials=>equations_set%MATERIALS
1943  IF(ASSOCIATED(equations_materials)) THEN
1944  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
1945  !Create the auto created materials field
1946  !start field creation with name 'MATERIAL_FIELD'
1947  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
1948  & equations_set%MATERIALS%MATERIALS_FIELD,err,error,*999)
1949  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
1950  !label the field
1951  CALL field_label_set(equations_materials%MATERIALS_FIELD,"MaterialsField",err,error,*999)
1952  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type, &
1953  & err,error,*999)
1954  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
1955  & err,error,*999)
1956  !apply decomposition rule found on new created field
1957  CALL field_mesh_decomposition_set_and_lock(equations_set%MATERIALS%MATERIALS_FIELD, &
1958  & geometric_decomposition,err,error,*999)
1959  !point new field to geometric field
1960  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
1961  & geometric_field,err,error,*999)
1962  CALL field_number_of_variables_set(equations_materials%MATERIALS_FIELD, &
1963  & material_field_number_of_variables,err,error,*999)
1964  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD, &
1965  &[field_u_variable_type,field_v_variable_type],err,error,*999)
1966  ! Set up U_VARIABLE (constants)
1967  CALL field_variable_label_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1968  & "MaterialsConstants",err,error,*999)
1969  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1970  & field_vector_dimension_type,err,error,*999)
1971  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1972  & field_dp_type,err,error,*999)
1973  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD, &
1974  & field_u_variable_type,material_field_number_of_components1,err,error,*999)
1975  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD, &
1976  & field_u_variable_type,1,geometric_component_number,err,error,*999)
1977  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1978  & 1,geometric_component_number,err,error,*999)
1979  DO componentidx=1,material_field_number_of_components2
1980  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1981  & componentidx,field_constant_interpolation,err,error,*999)
1982  END DO
1983  ! Set up V_VARIABLE (gauss-point based, CellML in/out parameters)
1984  CALL field_variable_label_set(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
1985  & "ConstitutiveValues",err,error,*999)
1986  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
1987  & field_vector_dimension_type,err,error,*999)
1988  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
1989  & field_dp_type,err,error,*999)
1990  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD, &
1991  & field_v_variable_type,material_field_number_of_components2,err,error,*999)
1992  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD, &
1993  & field_u_variable_type,1,geometric_component_number,err,error,*999)
1994  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
1995  & 1,geometric_component_number,err,error,*999)
1996  DO componentidx=1,material_field_number_of_components2
1997  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
1998  & componentidx,field_gauss_point_based_interpolation,err,error,*999)
1999  END DO
2000  !Default the field scaling to that of the geometric field
2001  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
2002  & err,error,*999)
2003  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
2004  ELSE
2005  !Check the user specified field
2006  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
2007  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
2008  CALL field_number_of_variables_check(equations_set_setup%FIELD,material_field_number_of_variables,err,error,*999)
2009  CALL field_variable_types_check(equations_set_setup%FIELD, &
2010  & [field_u_variable_type,field_v_variable_type],err,error,*999)
2011  ! Check the U_VARIABLE
2012  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type, &
2013  & field_vector_dimension_type,err,error,*999)
2014  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type, &
2015  & err,error,*999)
2016  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2017  & number_of_dimensions,err,error,*999)
2018  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
2019  & material_field_number_of_components1,err,error,*999)
2020  ! Check the U_VARIABLE
2021  CALL field_dimension_check(equations_set_setup%FIELD,field_v_variable_type, &
2022  & field_vector_dimension_type,err,error,*999)
2023  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_dp_type, &
2024  & err,error,*999)
2025  CALL field_number_of_components_check(equations_set_setup%FIELD,field_v_variable_type, &
2026  & material_field_number_of_components2,err,error,*999)
2027  END IF
2028  ELSE
2029  CALL flagerror("Equations set materials is not associated.",err,error,*999)
2030  END IF
2031  !Specify start action
2033  equations_materials=>equations_set%MATERIALS
2034  IF(ASSOCIATED(equations_materials)) THEN
2035  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
2036  !Finish creating the materials field
2037  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
2038  !Set the default values for the materials constants (viscosity scale, density)
2039  DO componentidx=1,material_field_number_of_components2
2040  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2041  & field_values_set_type,componentidx,1.0_dp,err,error,*999)
2042  END DO
2043  !Set the default values for the materials consitutive parameters (viscosity scale, density)
2044  DO componentidx=1,material_field_number_of_components2
2045  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
2046  & field_values_set_type,componentidx,1.0_dp,err,error,*999)
2047  END DO
2048  END IF
2049  ELSE
2050  CALL flagerror("Equations set materials is not associated.",err,error,*999)
2051  END IF
2052  CASE DEFAULT
2053  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*", &
2054  & err,error))//" for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*", &
2055  & err,error))//" is invalid for Navier-Stokes equation."
2056  CALL flagerror(local_error,err,error,*999)
2057  END SELECT
2062  ! 1 variables for the 1D Navier-Stokes materials
2063  material_field_number_of_variables=2
2064  material_field_number_of_components1=8
2065  material_field_number_of_components2=3
2066  SELECT CASE(equations_set_setup%ACTION_TYPE)
2067  !Specify start action
2069  equations_materials=>equations_set%MATERIALS
2070  IF(ASSOCIATED(equations_materials)) THEN
2071  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
2072  !Create the auto created materials field
2073  !start field creation with name 'MATERIAL_FIELD'
2074  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
2075  & equations_set%MATERIALS%MATERIALS_FIELD,err,error,*999)
2076  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
2077  !label the field
2078  CALL field_label_set(equations_materials%MATERIALS_FIELD,"Materials Field",err,error,*999)
2079  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type, &
2080  & err,error,*999)
2081  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
2082  & err,error,*999)
2083  !apply decomposition rule found on new created field
2084  CALL field_mesh_decomposition_set_and_lock(equations_set%MATERIALS%MATERIALS_FIELD, &
2085  & geometric_decomposition,err,error,*999)
2086  !point new field to geometric field
2087  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
2088  & geometric_field,err,error,*999)
2089  CALL field_number_of_variables_set(equations_materials%MATERIALS_FIELD, &
2090  & material_field_number_of_variables,err,error,*999)
2091  ! 2 U,V materials field
2092  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD, &
2093  &[field_u_variable_type,field_v_variable_type,field_u1_variable_type],err,error,*999)
2094  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2095  & field_vector_dimension_type,err,error,*999)
2096  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
2097  & field_vector_dimension_type,err,error,*999)
2098  ! Set up Navier-Stokes materials parameters
2099  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2100  & field_dp_type,err,error,*999)
2101  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
2102  & field_dp_type,err,error,*999)
2103  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD, &
2104  & field_u_variable_type,material_field_number_of_components1,err,error,*999)
2105  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD, &
2106  & field_v_variable_type,material_field_number_of_components2,err,error,*999)
2107  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD, &
2108  & field_u_variable_type,1,geometric_component_number,err,error,*999)
2109  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2110  & 1,geometric_component_number,err,error,*999)
2111  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
2112  & 1,geometric_component_number,err,error,*999)
2113  DO i=1,material_field_number_of_components1 !(MU,RHO,alpha,pressureExternal,LengthScale,TimeScale,MassScale)
2114  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2115  & i,field_constant_interpolation,err,error,*999)
2116  END DO
2117  DO i=1,material_field_number_of_components2 !(A0,E,H0)
2118  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_v_variable_type, &
2119  & i,field_node_based_interpolation,err,error,*999)
2120  END DO
2121  ! Set up coupling materials parameters
2122  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD, &
2123  & field_u_variable_type,1,geometric_component_number,err,error,*999)
2124  !Default the field scaling to that of the geometric field
2125  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
2126  & err,error,*999)
2127  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
2128  ELSE
2129  !Check the user specified field
2130  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
2131  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
2132  CALL field_number_of_variables_check(equations_set_setup%FIELD,material_field_number_of_variables,err,error,*999)
2133  CALL field_variable_types_check(equations_set_setup%FIELD,[field_u_variable_type,field_v_variable_type], &
2134  & err,error,*999)
2135  ! Check N-S field variable
2136  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type, &
2137  & field_vector_dimension_type,err,error,*999)
2138  CALL field_dimension_check(equations_set_setup%FIELD,field_v_variable_type, &
2139  & field_vector_dimension_type,err,error,*999)
2140  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type, &
2141  & err,error,*999)
2142  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_dp_type, &
2143  & err,error,*999)
2144  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
2145  & material_field_number_of_components1,err,error,*999)
2146  CALL field_number_of_components_check(equations_set_setup%FIELD,field_v_variable_type, &
2147  & material_field_number_of_components2,err,error,*999)
2148  END IF
2149  ELSE
2150  CALL flagerror("Equations set materials is not associated.",err,error,*999)
2151  END IF
2152  !Specify start action
2154  equations_materials=>equations_set%MATERIALS
2155  IF(ASSOCIATED(equations_materials)) THEN
2156  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
2157  !Finish creating the materials field
2158  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
2159  END IF
2160  ELSE
2161  CALL flagerror("Equations set materials is not associated.",err,error,*999)
2162  END IF
2163  CASE DEFAULT
2164  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*", &
2165  & err,error))//" for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*", &
2166  & err,error))//" is invalid for Navier-Stokes equation."
2167  CALL flagerror(local_error,err,error,*999)
2168  END SELECT
2169  CASE DEFAULT
2170  local_error="The equation set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2171  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2172  & " is invalid for a Navier-Stokes equation."
2173  CALL flagerror(local_error,err,error,*999)
2174  END SELECT
2175  !-----------------------------------------------------------------
2176  ! S o u r c e f i e l d
2177  !-----------------------------------------------------------------
2179  SELECT CASE(equations_set%SPECIFICATION(3))
2187  !\todo: Think about gravity
2188  SELECT CASE(equations_set_setup%ACTION_TYPE)
2190  !Do nothing
2192  !Do nothing
2193  !? Maybe set finished flag????
2194  CASE DEFAULT
2195  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*", &
2196  & err,error))//" for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*", &
2197  & err,error))//" is invalid for a Navier-Stokes fluid."
2198  CALL flagerror(local_error,err,error,*999)
2199  END SELECT
2200  CASE DEFAULT
2201  local_error="The equation set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2202  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2203  & " is invalid for a Navier-Stokes equation."
2204  CALL flagerror(local_error,err,error,*999)
2205  END SELECT
2206  !-----------------------------------------------------------------
2207  ! E q u a t i o n s t y p e
2208  !-----------------------------------------------------------------
2210  SELECT CASE(equations_set%SPECIFICATION(3))
2214  SELECT CASE(equations_set_setup%ACTION_TYPE)
2216  equations_materials=>equations_set%MATERIALS
2217  IF(ASSOCIATED(equations_materials)) THEN
2218  IF(equations_materials%MATERIALS_FINISHED) THEN
2219  CALL equations_create_start(equations_set,equations,err,error,*999)
2220  CALL equations_linearity_type_set(equations,equations_nonlinear,err,error,*999)
2221  CALL equations_time_dependence_type_set(equations,equations_static,err,error,*999)
2222  ELSE
2223  CALL flagerror("Equations set materials has not been finished.",err,error,*999)
2224  END IF
2225  ELSE
2226  CALL flagerror("Equations materials is not associated.",err,error,*999)
2227  END IF
2229  SELECT CASE(equations_set%SOLUTION_METHOD)
2231  !Finish the creation of the equations
2232  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
2233  CALL equations_create_finish(equations,err,error,*999)
2234  !Create the equations mapping.
2235  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
2236  CALL equationsmapping_linearmatricesnumberset(equations_mapping,1,err,error,*999)
2237  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,[field_u_variable_type], &
2238  & err,error,*999)
2239  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type, &
2240  & err,error,*999)
2241  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
2242  !Create the equations matrices
2243  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
2244  ! Use the analytic Jacobian calculation
2246  & err,error,*999)
2247  SELECT CASE(equations%SPARSITY_TYPE)
2250  & err,error,*999)
2252  & err,error,*999)
2254  CALL equations_matrices_linear_storage_type_set(equations_matrices, &
2255  & [matrix_compressed_row_storage_type],err,error,*999)
2256  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices, &
2257  & matrix_compressed_row_storage_type,err,error,*999)
2258  CALL equationsmatrices_linearstructuretypeset(equations_matrices, &
2259  & [equations_matrix_fem_structure],err,error,*999)
2260  CALL equationsmatrices_nonlinearstructuretypeset(equations_matrices, &
2261  & equations_matrix_fem_structure,err,error,*999)
2262  CASE DEFAULT
2263  local_error="The equations matrices sparsity type of "// &
2264  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
2265  CALL flagerror(local_error,err,error,*999)
2266  END SELECT
2267  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
2269  !Finish the creation of the equations
2270  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
2271  CALL equations_create_finish(equations,err,error,*999)
2272  !Create the equations mapping.
2273  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
2274  CALL equationsmapping_linearmatricesnumberset(equations_mapping,1,err,error,*999)
2275  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,[field_u_variable_type], &
2276  & err,error,*999)
2277  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type, &
2278  & err,error,*999)
2279  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
2280  !Create the equations matrices
2281  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
2282  ! Use the analytic Jacobian calculation
2284  & err,error,*999)
2285  SELECT CASE(equations%SPARSITY_TYPE)
2288  & err,error,*999)
2290  & err,error,*999)
2292  CALL equations_matrices_linear_storage_type_set(equations_matrices, &
2293  & [matrix_compressed_row_storage_type],err,error,*999)
2294  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices, &
2295  & matrix_compressed_row_storage_type,err,error,*999)
2296  CALL equationsmatrices_linearstructuretypeset(equations_matrices, &
2297  & [equations_matrix_fem_structure],err,error,*999)
2298  CALL equationsmatrices_nonlinearstructuretypeset(equations_matrices, &
2299  & equations_matrix_fem_structure,err,error,*999)
2300  CASE DEFAULT
2301  local_error="The equations matrices sparsity type of "// &
2302  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
2303  CALL flagerror(local_error,err,error,*999)
2304  END SELECT
2305  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
2307  CALL flagerror("Not implemented.",err,error,*999)
2309  CALL flagerror("Not implemented.",err,error,*999)
2311  CALL flagerror("Not implemented.",err,error,*999)
2313  CALL flagerror("Not implemented.",err,error,*999)
2315  CALL flagerror("Not implemented.",err,error,*999)
2316  CASE DEFAULT
2317  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD, &
2318  & "*",err,error))//" is invalid."
2319  CALL flagerror(local_error,err,error,*999)
2320  END SELECT
2321  CASE DEFAULT
2322  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2323  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2324  & " is invalid for a Navier-stokes equation."
2325  CALL flagerror(local_error,err,error,*999)
2326  END SELECT
2337 
2338  SELECT CASE(equations_set_setup%ACTION_TYPE)
2340  equations_materials=>equations_set%MATERIALS
2341  IF(ASSOCIATED(equations_materials)) THEN
2342  IF(equations_materials%MATERIALS_FINISHED) THEN
2343  CALL equations_create_start(equations_set,equations,err,error,*999)
2344  CALL equations_linearity_type_set(equations,equations_nonlinear,err,error,*999)
2346  ELSE
2347  CALL flagerror("Equations set materials has not been finished.",err,error,*999)
2348  END IF
2349  ELSE
2350  CALL flagerror("Equations materials is not associated.",err,error,*999)
2351  END IF
2353  SELECT CASE(equations_set%SOLUTION_METHOD)
2355  !Finish the creation of the equations
2356  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
2357  CALL equations_create_finish(equations,err,error,*999)
2358  !Create the equations mapping.
2359  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
2360  CALL equationsmapping_residualvariabletypesset(equations_mapping,[field_u_variable_type], &
2361  & err,error,*999)
2362  CALL equations_mapping_dynamic_matrices_set(equations_mapping,.true.,.true.,err,error,*999)
2363  CALL equations_mapping_dynamic_variable_type_set(equations_mapping,field_u_variable_type,err,error,*999)
2364  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err, &
2365  & error,*999)
2366  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
2367  !Create the equations matrices
2368  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
2369  ! Use the analytic Jacobian calculation
2371  & err,error,*999)
2372  SELECT CASE(equations%SPARSITY_TYPE)
2375  & matrix_block_storage_type],err,error,*999)
2377  & err,error,*999)
2379  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
2382  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
2384  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices, &
2385  & matrix_compressed_row_storage_type,err,error,*999)
2386  CALL equationsmatrices_nonlinearstructuretypeset(equations_matrices, &
2387  & equations_matrix_fem_structure,err,error,*999)
2388  CASE DEFAULT
2389  local_error="The equations matrices sparsity type of "// &
2390  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
2391  CALL flagerror(local_error,err,error,*999)
2392  END SELECT
2393  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
2395  CALL flagerror("Not implemented.",err,error,*999)
2397  CALL flagerror("Not implemented.",err,error,*999)
2399  CALL flagerror("Not implemented.",err,error,*999)
2401  CALL flagerror("Not implemented.",err,error,*999)
2403  CALL flagerror("Not implemented.",err,error,*999)
2404  CASE DEFAULT
2405  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD, &
2406  & "*",err,error))//" is invalid."
2407  CALL flagerror(local_error,err,error,*999)
2408  END SELECT
2409  CASE DEFAULT
2410  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2411  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2412  & " is invalid for a Navier-Stokes equation."
2413  CALL flagerror(local_error,err,error,*999)
2414  END SELECT
2416  SELECT CASE(equations_set_setup%ACTION_TYPE)
2418  equations_materials=>equations_set%MATERIALS
2419  IF(ASSOCIATED(equations_materials)) THEN
2420  IF(equations_materials%MATERIALS_FINISHED) THEN
2421  CALL equations_create_start(equations_set,equations,err,error,*999)
2422  CALL equations_linearity_type_set(equations,equations_nonlinear,err,error,*999)
2423  CALL equations_time_dependence_type_set(equations,equations_quasistatic,err,error,*999)
2424  ELSE
2425  CALL flagerror("Equations set materials has not been finished.",err,error,*999)
2426  END IF
2427  ELSE
2428  CALL flagerror("Equations materials is not associated.",err,error,*999)
2429  END IF
2431  SELECT CASE(equations_set%SOLUTION_METHOD)
2433  !Finish the creation of the equations
2434  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
2435  CALL equations_create_finish(equations,err,error,*999)
2436  !Create the equations mapping.
2437  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
2438  CALL equationsmapping_linearmatricesnumberset(equations_mapping,1,err,error,*999)
2439  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,[field_u_variable_type], &
2440  & err,error,*999)
2441  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type, &
2442  & err,error,*999)
2443  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
2444  !Create the equations matrices
2445  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
2446  ! Use the analytic Jacobian calculation
2448  & err,error,*999)
2449  SELECT CASE(equations%SPARSITY_TYPE)
2452  & err,error,*999)
2454  & err,error,*999)
2456  CALL equations_matrices_linear_storage_type_set(equations_matrices, &
2457  & [matrix_compressed_row_storage_type],err,error,*999)
2458  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices, &
2459  & matrix_compressed_row_storage_type,err,error,*999)
2460  CALL equationsmatrices_linearstructuretypeset(equations_matrices, &
2461  & [equations_matrix_fem_structure],err,error,*999)
2462  CALL equationsmatrices_nonlinearstructuretypeset(equations_matrices, &
2463  & equations_matrix_fem_structure,err,error,*999)
2464  CASE DEFAULT
2465  local_error="The equations matrices sparsity type of "// &
2466  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
2467  CALL flagerror(local_error,err,error,*999)
2468  END SELECT
2469  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
2471  CALL flagerror("Not implemented.",err,error,*999)
2473  CALL flagerror("Not implemented.",err,error,*999)
2475  CALL flagerror("Not implemented.",err,error,*999)
2477  CALL flagerror("Not implemented.",err,error,*999)
2479  CALL flagerror("Not implemented.",err,error,*999)
2480  CASE DEFAULT
2481  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD, &
2482  & "*",err,error))//" is invalid."
2483  CALL flagerror(local_error,err,error,*999)
2484  END SELECT
2485  CASE DEFAULT
2486  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2487  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2488  & " is invalid for a Navier-Stokes equation."
2489  CALL flagerror(local_error,err,error,*999)
2490  END SELECT
2491  CASE DEFAULT
2492  local_error="The equation set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2493  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2494  & " is invalid for a Navier-Stokes equation."
2495  CALL flagerror(local_error,err,error,*999)
2496  END SELECT
2497  CASE DEFAULT
2498  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2499  & " is invalid for a Navier-Stokes fluid."
2500  CALL flagerror(local_error,err,error,*999)
2501  END SELECT
2502  CASE DEFAULT
2503  local_error="The equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2504  & " does not equal a Navier-Stokes fluid subtype."
2505  CALL flagerror(local_error,err,error,*999)
2506  END SELECT
2507  ELSE
2508  CALL flagerror("Equations set is not associated.",err,error,*999)
2509  END IF
2510 
2511  exits("NAVIER_STOKES_EQUATIONS_SET_SETUP")
2512  RETURN
2513 999 errorsexits("NAVIER_STOKES_EQUATIONS_SET_SETUP",err,error)
2514  RETURN 1
2515 
2516  END SUBROUTINE navier_stokes_equations_set_setup
2517 
2518  !
2519  !================================================================================================================================
2520  !
2521 
2523  SUBROUTINE navier_stokes_pre_solve(SOLVER,ERR,ERROR,*)
2525  !Argument variables
2526  TYPE(solver_type), POINTER :: SOLVER
2527  INTEGER(INTG), INTENT(OUT) :: ERR
2528  TYPE(varying_string), INTENT(OUT) :: ERROR
2529  !Local Variables
2530  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
2531  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2532  TYPE(equations_set_analytic_type), POINTER :: EQUATIONS_ANALYTIC
2533  TYPE(nonlinear_solver_type), POINTER :: nonlinearSolver
2534  TYPE(field_type), POINTER :: dependentField
2535  TYPE(field_variable_type), POINTER :: fieldVariable
2536  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
2537  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
2538  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
2539  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
2540  TYPE(solver_type), POINTER :: SOLVER2,cellmlSolver
2541  TYPE(solvers_type), POINTER :: SOLVERS
2542  TYPE(varying_string) :: LOCAL_ERROR
2543  INTEGER(INTG) :: solver_matrix_idx,iteration
2544  REAL(DP) :: timeIncrement,currentTime
2545 
2546  NULLIFY(solver2)
2547 
2548  enters("NAVIER_STOKES_PRE_SOLVE",err,error,*999)
2549 
2550  IF(ASSOCIATED(solver)) THEN
2551  solvers=>solver%SOLVERS
2552  IF(ASSOCIATED(solvers)) THEN
2553  control_loop=>solvers%CONTROL_LOOP
2554  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
2555  IF(.NOT.ALLOCATED(control_loop%problem%specification)) THEN
2556  CALL flagerror("Problem specification is not allocated.",err,error,*999)
2557  ELSE IF(SIZE(control_loop%problem%specification,1)<3) THEN
2558  CALL flagerror("Problem specification must have three entries for a Navier-Stokes problem.",err,error,*999)
2559  END IF
2560  !Since we can have a fluid mechanics navier stokes equations set in a coupled problem setup we do not necessarily
2561  !have PROBLEM%SPECIFICATION(1)==FLUID_MECHANICS_CLASS
2562  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(1))
2564  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
2566  solver_equations=>solver%SOLVER_EQUATIONS
2567  IF(ASSOCIATED(solver_equations)) THEN
2568  solver_mapping=>solver_equations%SOLVER_MAPPING
2569  IF(ASSOCIATED(solver_mapping)) THEN
2570  ! TODO: Set up for multiple equations sets
2571  equations_set=>solver_mapping%EQUATIONS_SETS(1)%PTR
2572  IF(ASSOCIATED(equations_set)) THEN
2573  equations_analytic=>equations_set%ANALYTIC
2574  IF(ASSOCIATED(equations_analytic)) THEN
2575  !Update boundary conditions and any analytic values
2576  CALL navierstokes_presolveupdateboundaryconditions(solver,err,error,*999)
2577  END IF
2578  ELSE
2579  CALL flagerror("Equations set is not associated.",err,error,*999)
2580  END IF
2581  ELSE
2582  CALL flagerror("Solver mapping is not associated.",err,error,*999)
2583  END IF
2584  ELSE
2585  CALL flagerror("Solver equations is not associated.",err,error,*999)
2586  END IF
2588  !Update transient boundary conditions and any analytic values
2589  CALL navierstokes_presolveupdateboundaryconditions(solver,err,error,*999)
2591  !Update transient boundary conditions
2592  CALL navierstokes_presolveupdateboundaryconditions(solver,err,error,*999)
2594  !Update transient boundary conditions
2595  CALL navierstokes_presolveupdateboundaryconditions(solver,err,error,*999)
2596  !CALL NavierStokes_CalculateBoundaryFlux(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
2597  nonlinearsolver=>solver%DYNAMIC_SOLVER%NONLINEAR_SOLVER%NONLINEAR_SOLVER
2598  IF(ASSOCIATED(nonlinearsolver)) THEN
2599  !check for a linked CellML solver
2600  cellmlsolver=>nonlinearsolver%NEWTON_SOLVER%CELLML_EVALUATOR_SOLVER
2601  IF(ASSOCIATED(cellmlsolver)) THEN
2602  ! Calculate the CellML equations
2603  CALL solver_solve(cellmlsolver,err,error,*999)
2604  END IF
2605  ELSE
2606  CALL flagerror("Nonlinear solver is not associated.",err,error,*999)
2607  END IF
2608 
2615 
2616  SELECT CASE(solver%SOLVE_TYPE)
2617  ! This switch takes advantage of the uniqueness of the solver types to do pre-solve operations
2618  ! for each of solvers in the various possible 1D subloops
2619 
2620  ! --- C h a r a c t e r i s t i c S o l v e r ---
2621  CASE(solver_nonlinear_type)
2622  CALL control_loop_current_times_get(control_loop,currenttime,timeincrement,err,error,*999)
2623  iteration = control_loop%WHILE_LOOP%ITERATION_NUMBER
2624  equations_set=>solver%SOLVER_EQUATIONS%SOLVER_MAPPING%EQUATIONS_SETS(1)%PTR
2625  dependentfield=>equations_set%DEPENDENT%DEPENDENT_FIELD
2626  ! Characteristic solver effectively solves for the mass/momentum conserving fluxes at the
2627  ! *NEXT* timestep by extrapolating current field values and then solving a system of nonlinear
2628  ! equations: cons mass, continuity of pressure, and the characteristics.
2629  NULLIFY(fieldvariable)
2630  CALL field_variable_get(dependentfield,field_u_variable_type,fieldvariable,err,error,*999)
2631  IF(.NOT.ASSOCIATED(fieldvariable%PARAMETER_SETS%SET_TYPE(field_input_data1_set_type)%PTR)) THEN
2632  CALL field_parameter_set_create(dependentfield,field_u_variable_type, &
2633  & field_input_data1_set_type,err,error,*999)
2634  CALL field_parameter_set_create(dependentfield,field_u_variable_type, &
2635  & field_input_data2_set_type,err,error,*999)
2636  END IF
2637  CALL field_parameter_sets_copy(dependentfield,field_u_variable_type,field_values_set_type, &
2638  & field_input_data1_set_type,1.0_dp,err,error,*999)
2639  CALL field_parameter_sets_copy(dependentfield,field_u_variable_type,field_residual_set_type, &
2640  & field_input_data2_set_type,1.0_dp,err,error,*999)
2641 
2642  IF(iteration == 1) THEN
2643  NULLIFY(fieldvariable)
2644  CALL field_variable_get(dependentfield,field_u_variable_type,fieldvariable,err,error,*999)
2645  IF(.NOT.ASSOCIATED(fieldvariable%PARAMETER_SETS%SET_TYPE(field_upwind_values_set_type)%PTR)) THEN
2646  CALL field_parameter_set_create(dependentfield,field_u_variable_type, &
2647  & field_upwind_values_set_type,err,error,*999)
2648  END IF
2649  ! Extrapolate new W from Q,A if this is the first timestep (otherwise will be calculated based on Navier-Stokes
2650  ! values)
2651  CALL characteristic_extrapolate(solver,currenttime,timeincrement,err,error,*999)
2652  END IF
2653 
2654  ! --- 1 D N a v i e r - S t o k e s S o l v e r ---
2655  CASE(solver_dynamic_type)
2656  IF(solver%global_number==2) THEN
2657  ! update solver matrix
2658  solver_equations=>solver%SOLVER_EQUATIONS
2659  IF(ASSOCIATED(solver_equations)) THEN
2660  solver_mapping=>solver_equations%SOLVER_MAPPING
2661  IF(ASSOCIATED(solver_mapping)) THEN
2662  solver_matrices=>solver_equations%SOLVER_MATRICES
2663  IF(ASSOCIATED(solver_matrices)) THEN
2664  DO solver_matrix_idx=1,solver_mapping%NUMBER_OF_SOLVER_MATRICES
2665  solver_matrix=>solver_matrices%MATRICES(solver_matrix_idx)%PTR
2666  IF(ASSOCIATED(solver_matrix)) THEN
2667  solver_matrix%UPDATE_MATRIX=.true.
2668  ELSE
2669  CALL flagerror("Solver Matrix is not associated.",err,error,*999)
2670  END IF
2671  END DO
2672  ELSE
2673  CALL flagerror("Solver Matrices is not associated.",err,error,*999)
2674  END IF
2675  equations_set=>solver_mapping%EQUATIONS_SETS(1)%PTR
2676  IF(ASSOCIATED(equations_set)) THEN
2677  dependentfield=>equations_set%DEPENDENT%DEPENDENT_FIELD
2678  IF(ASSOCIATED(dependentfield)) THEN
2679  CALL field_parameter_sets_copy(dependentfield,field_u_variable_type,field_input_data1_set_type, &
2680  & field_values_set_type,1.0_dp,err,error,*999)
2681  CALL field_parameter_sets_copy(dependentfield,field_u_variable_type,field_input_data2_set_type, &
2682  & field_residual_set_type,1.0_dp,err,error,*999)
2683  ELSE
2684  CALL flagerror("Dependent field is not associated.",err,error,*999)
2685  END IF
2686  ELSE
2687  CALL flagerror("Equations set is not associated.",err,error,*999)
2688  END IF
2689  ELSE
2690  CALL flagerror("Solver mapping is not associated.",err,error,*999)
2691  END IF
2692  ELSE
2693  CALL flagerror("Solver equations is not associated.",err,error,*999)
2694  END IF
2695  ELSE
2696  ! --- A d v e c t i o n S o l v e r ---
2697  CALL advection_pre_solve(solver,err,error,*999)
2698  END IF
2699  ! Update boundary conditions
2700  CALL navierstokes_presolveupdateboundaryconditions(solver,err,error,*999)
2701 
2702  ! --- C e l l M L S o l v e r ---
2703  CASE(solver_dae_type)
2704  ! DAE solver-set time
2705  CALL control_loop_current_times_get(control_loop,currenttime,timeincrement,err,error,*999)
2706  CALL solver_dae_times_set(solver,currenttime,currenttime + timeincrement,err,error,*999)
2707  CALL solver_dae_time_step_set(solver,timeincrement/1000.0_dp,err,error,*999)
2708 
2709  ! --- S T R E E S o l v e r ---
2710  CASE(solver_linear_type)
2711  CALL stree_pre_solve(solver,err,error,*999)
2712 
2713  CASE DEFAULT
2714  local_error="The solve type of "//trim(number_to_vstring(solver%SOLVE_TYPE,"*",err,error))// &
2715  & " is invalid for a 1D Navier-Stokes problem."
2716  CALL flagerror(local_error,err,error,*999)
2717  END SELECT
2718 
2720  ! do nothing ???
2721  CALL navierstokes_presolveupdateboundaryconditions(solver,err,error,*999)
2723  ! do nothing ???
2724  !First update mesh and calculates boundary velocity values
2725  CALL navier_stokes_pre_solve_ale_update_mesh(solver,err,error,*999)
2726  !Then apply both normal and moving mesh boundary conditions
2727  CALL navierstokes_presolveupdateboundaryconditions(solver,err,error,*999)
2729  !Pre solve for the linear solver
2730  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
2731  CALL write_string(general_output_type,"Mesh movement pre solve... ",err,error,*999)
2732  !Update boundary conditions for mesh-movement
2733  CALL navierstokes_presolveupdateboundaryconditions(solver,err,error,*999)
2734  CALL solvers_solver_get(solver%SOLVERS,2,solver2,err,error,*999)
2735  IF(ASSOCIATED(solver2%DYNAMIC_SOLVER)) THEN
2736  solver2%DYNAMIC_SOLVER%ALE=.false.
2737  ELSE
2738  CALL flagerror("Dynamic solver is not associated for ALE problem.",err,error,*999)
2739  END IF
2740  !Update material properties for Laplace mesh movement
2741  CALL navierstokes_presolvealeupdateparameters(solver,err,error,*999)
2742  !Pre solve for the linear solver
2743  ELSE IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
2744  CALL write_string(general_output_type,"ALE Navier-Stokes pre solve... ",err,error,*999)
2745  IF(solver%DYNAMIC_SOLVER%ALE) THEN
2746  !First update mesh and calculates boundary velocity values
2747  CALL navier_stokes_pre_solve_ale_update_mesh(solver,err,error,*999)
2748  !Then apply both normal and moving mesh boundary conditions
2749  CALL navierstokes_presolveupdateboundaryconditions(solver,err,error,*999)
2750  ELSE
2751  CALL flagerror("Mesh motion calculation not successful for ALE problem.",err,error,*999)
2752  END IF
2753  ELSE
2754  CALL flagerror("Solver type is not associated for ALE problem.",err,error,*999)
2755  END IF
2756  CASE DEFAULT
2757  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
2758  & " is not valid for a Navier-Stokes fluid type of a fluid mechanics problem class."
2759  CALL flagerror(local_error,err,error,*999)
2760  END SELECT
2762  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(2))
2764  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
2766  !Pre solve for the linear solver
2767  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
2768  CALL write_string(general_output_type,"Mesh movement pre solve... ",err,error,*999)
2769  !TODO if first time step smooth imported mesh with respect to absolute nodal position?
2770 
2771  !Update boundary conditions for mesh-movement
2772  CALL navierstokes_presolveupdateboundaryconditions(solver,err,error,*999)
2773  CALL solvers_solver_get(solver%SOLVERS,1,solver2,err,error,*999)
2774  IF(ASSOCIATED(solver2%DYNAMIC_SOLVER)) THEN
2775  solver2%DYNAMIC_SOLVER%ALE=.false.
2776  ELSE
2777  CALL flagerror("Dynamic solver is not associated for ALE problem.",err,error,*999)
2778  END IF
2779  !Update material properties for Laplace mesh movement
2780  CALL navierstokes_presolvealeupdateparameters(solver,err,error,*999)
2781  !Pre solve for the dynamic solver which deals with the coupled FiniteElasticity-NavierStokes problem
2782  ELSE IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
2783  CALL write_string(general_output_type,"ALE Navier-Stokes pre solve... ",err,error,*999)
2784  IF(solver%DYNAMIC_SOLVER%ALE) THEN
2785  !Apply both normal and moving mesh boundary conditions
2786  CALL navierstokes_presolveupdateboundaryconditions(solver,err,error,*999)
2787  ELSE
2788  CALL flagerror("Mesh motion calculation not successful for ALE problem.",err,error,*999)
2789  END IF
2790  ELSE
2791  CALL flagerror("Solver type is not associated for ALE problem.",err,error,*999)
2792  END IF
2793  CASE DEFAULT
2794  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
2795  & " is not valid for a FiniteElasticity-NavierStokes type of a multi physics problem class."
2796  CALL flagerror(local_error,err,error,*999)
2797  END SELECT
2798  CASE DEFAULT
2799  local_error="Problem type "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(2),"*",err,error))// &
2800  & " is not valid for NAVIER_STOKES_PRE_SOLVE of a multi physics problem class."
2801  CALL flagerror(local_error,err,error,*999)
2802  END SELECT
2803  CASE DEFAULT
2804  local_error="Problem class "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(1),"*",err,error))// &
2805  & " is not valid for Navier-Stokes fluid types."
2806  CALL flagerror(local_error,err,error,*999)
2807  END SELECT
2808  ELSE
2809  CALL flagerror("Problem is not associated.",err,error,*999)
2810  END IF
2811  ELSE
2812  CALL flagerror("Solvers are not associated.",err,error,*999)
2813  END IF
2814  ELSE
2815  CALL flagerror("Solver is not associated.",err,error,*999)
2816  END IF
2817 
2818  exits("NAVIER_STOKES_PRE_SOLVE")
2819  RETURN
2820 999 errorsexits("NAVIER_STOKES_PRE_SOLVE",err,error)
2821  RETURN 1
2822 
2823  END SUBROUTINE navier_stokes_pre_solve
2824 
2825 !
2826 !================================================================================================================================
2827 !
2828 
2830  SUBROUTINE navierstokes_problemspecificationset(problem,problemSpecification,err,error,*)
2832  !Argument variables
2833  TYPE(problem_type), POINTER :: problem
2834  INTEGER(INTG), INTENT(IN) :: problemSpecification(:)
2835  INTEGER(INTG), INTENT(OUT) :: err
2836  TYPE(varying_string), INTENT(OUT) :: error
2837  !Local Variables
2838  TYPE(varying_string) :: localError
2839  INTEGER(INTG) :: problemSubtype
2840 
2841  enters("NavierStokes_ProblemSpecificationSet",err,error,*999)
2842 
2843  IF(ASSOCIATED(problem)) THEN
2844  IF(SIZE(problemspecification,1)==3) THEN
2845  problemsubtype=problemspecification(3)
2846  SELECT CASE(problemsubtype)
2861  !All ok
2863  CALL flagerror("Not implemented yet.",err,error,*999)
2864  CASE DEFAULT
2865  localerror="The third problem specification of "//trim(numbertovstring(problemsubtype,"*",err,error))// &
2866  & " is not valid for a Navier-Stokes fluid mechanics problem."
2867  CALL flagerror(localerror,err,error,*999)
2868  END SELECT
2869  IF(ALLOCATED(problem%specification)) THEN
2870  CALL flagerror("Problem specification is already allocated.",err,error,*999)
2871  ELSE
2872  ALLOCATE(problem%specification(3),stat=err)
2873  IF(err/=0) CALL flagerror("Could not allocate problem specification.",err,error,*999)
2874  END IF
2875  problem%specification(1:3)=[problem_fluid_mechanics_class,problem_navier_stokes_equation_type,problemsubtype]
2876  ELSE
2877  CALL flagerror("Navier-Stokes problem specification must have three entries.",err,error,*999)
2878  END IF
2879  ELSE
2880  CALL flagerror("Problem is not associated.",err,error,*999)
2881  END IF
2882 
2883  exits("NavierStokes_ProblemSpecificationSet")
2884  RETURN
2885 999 errors("NavierStokes_ProblemSpecificationSet",err,error)
2886  exits("NavierStokes_ProblemSpecificationSet")
2887  RETURN 1
2888 
2889  END SUBROUTINE navierstokes_problemspecificationset
2890 
2891 !
2892 !================================================================================================================================
2893 !
2894 
2896  SUBROUTINE navier_stokes_problem_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
2898  !Argument variables
2899  TYPE(problem_type), POINTER :: PROBLEM
2900  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
2901  INTEGER(INTG), INTENT(OUT) :: ERR
2902  TYPE(varying_string), INTENT(OUT) :: ERROR
2903  !Local Variables
2904  TYPE(cellml_equations_type), POINTER :: CELLML_EQUATIONS
2905  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT
2906  TYPE(control_loop_type), POINTER :: iterativeWhileLoop,iterativeWhileLoop2,simpleLoop
2907  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS,MESH_SOLVER_EQUATIONS,BIF_SOLVER_EQUATIONS
2908  TYPE(solvers_type), POINTER :: SOLVERS
2909  TYPE(solver_type), POINTER :: SOLVER, MESH_SOLVER,BIF_SOLVER,cellmlSolver
2910  TYPE(varying_string) :: LOCAL_ERROR
2911 
2912  enters("NAVIER_STOKES_PROBLEM_SETUP",err,error,*999)
2913 
2914  NULLIFY(bif_solver)
2915  NULLIFY(bif_solver_equations)
2916  NULLIFY(cellmlsolver)
2917  NULLIFY(cellml_equations)
2918  NULLIFY(control_loop)
2919  NULLIFY(control_loop_root)
2920  NULLIFY(mesh_solver)
2921  NULLIFY(mesh_solver_equations)
2922  NULLIFY(solver)
2923  NULLIFY(solver_equations)
2924  NULLIFY(solvers)
2925 
2926  IF(ASSOCIATED(problem)) THEN
2927  IF(.NOT.ALLOCATED(problem%specification)) THEN
2928  CALL flagerror("Problem specification is not allocated.",err,error,*999)
2929  ELSE IF(SIZE(problem%specification,1)<3) THEN
2930  CALL flagerror("Problem specification must have three entries for a Navier-Stokes problem.",err,error,*999)
2931  END IF
2932  SELECT CASE(problem%SPECIFICATION(3))
2933  !All steady state cases of Navier-Stokes
2936  SELECT CASE(problem_setup%SETUP_TYPE)
2938  SELECT CASE(problem_setup%ACTION_TYPE)
2940  !Do nothing????
2942  !Do nothing???
2943  CASE DEFAULT
2944  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
2945  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
2946  & " is invalid for a Navier-Stokes fluid."
2947  CALL flagerror(local_error,err,error,*999)
2948  END SELECT
2950  SELECT CASE(problem_setup%ACTION_TYPE)
2952  !Set up a simple control loop
2953  CALL control_loop_create_start(problem,control_loop,err,error,*999)
2955  !Finish the control loops
2956  control_loop_root=>problem%CONTROL_LOOP
2957  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
2958  CALL control_loop_create_finish(control_loop,err,error,*999)
2959  CASE DEFAULT
2960  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
2961  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
2962  & " is invalid for a Navier-Stokes fluid."
2963  CALL flagerror(local_error,err,error,*999)
2964  END SELECT
2966  !Get the control loop
2967  control_loop_root=>problem%CONTROL_LOOP
2968  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
2969  SELECT CASE(problem_setup%ACTION_TYPE)
2971  !Start the solvers creation
2972  CALL solvers_create_start(control_loop,solvers,err,error,*999)
2973  CALL solvers_number_set(solvers,1,err,error,*999)
2974  !Set the solver to be a nonlinear solver
2975  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
2976  CALL solver_type_set(solver,solver_nonlinear_type,err,error,*999)
2977  !Set solver defaults
2978  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
2980  !Get the solvers
2981  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
2982  !Finish the solvers creation
2983  CALL solvers_create_finish(solvers,err,error,*999)
2984  CASE DEFAULT
2985  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
2986  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
2987  & " is invalid for a Navier-Stokes fluid."
2988  CALL flagerror(local_error,err,error,*999)
2989  END SELECT
2991  SELECT CASE(problem_setup%ACTION_TYPE)
2993  !Get the control loop
2994  control_loop_root=>problem%CONTROL_LOOP
2995  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
2996  !Get the solver
2997  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
2998  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
2999  !Create the solver equations
3000  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3001  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
3002  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
3003  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3005  !Get the control loop
3006  control_loop_root=>problem%CONTROL_LOOP
3007  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3008  !Get the solver equations
3009  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3010  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3011  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
3012  !Finish the solver equations creation
3013  CALL solver_equations_create_finish(solver_equations,err,error,*999)
3014  CASE DEFAULT
3015  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3016  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3017  & " is invalid for a Navier-Stokes fluid."
3018  CALL flagerror(local_error,err,error,*999)
3019  END SELECT
3020  CASE DEFAULT
3021  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3022  & " is invalid for a Navier-Stokes fluid."
3023  CALL flagerror(local_error,err,error,*999)
3024  END SELECT
3025  !Transient cases and moving mesh
3030  SELECT CASE(problem_setup%SETUP_TYPE)
3032  SELECT CASE(problem_setup%ACTION_TYPE)
3034  !Do nothing????
3036  !Do nothing???
3037  CASE DEFAULT
3038  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3039  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3040  & " is invalid for a transient Navier-Stokes fluid."
3041  CALL flagerror(local_error,err,error,*999)
3042  END SELECT
3044  SELECT CASE(problem_setup%ACTION_TYPE)
3046  !Set up a time control loop
3047  CALL control_loop_create_start(problem,control_loop,err,error,*999)
3048  CALL control_loop_type_set(control_loop,problem_control_time_loop_type,err,error,*999)
3050  !Finish the control loops
3051  control_loop_root=>problem%CONTROL_LOOP
3052  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3053  CALL control_loop_create_finish(control_loop,err,error,*999)
3054  CASE DEFAULT
3055  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3056  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3057  & " is invalid for a transient Navier-Stokes fluid."
3058  CALL flagerror(local_error,err,error,*999)
3059  END SELECT
3061  !Get the control loop
3062  control_loop_root=>problem%CONTROL_LOOP
3063  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3064  SELECT CASE(problem_setup%ACTION_TYPE)
3066  !Start the solvers creation
3067  CALL solvers_create_start(control_loop,solvers,err,error,*999)
3068  CALL solvers_number_set(solvers,1,err,error,*999)
3069  !Set the solver to be a first order dynamic solver
3070  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3071  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
3073  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
3074  !Set solver defaults
3075  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
3077  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
3078  !setup CellML evaluator
3079  IF(problem%specification(3)==problem_multiscale_navier_stokes_subtype) THEN
3080  !Create the CellML evaluator solver
3081  CALL solver_newton_cellml_evaluator_create(solver,cellmlsolver,err,error,*999)
3082  !Link the CellML evaluator solver to the solver
3083  CALL solver_linked_solver_add(solver,cellmlsolver,solver_cellml_evaluator_type,err,error,*999)
3084  END IF
3086  !Get the solvers
3087  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3088  !Finish the solvers creation
3089  CALL solvers_create_finish(solvers,err,error,*999)
3090  CASE DEFAULT
3091  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3092  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3093  & " is invalid for a transient Navier-Stokes fluid."
3094  CALL flagerror(local_error,err,error,*999)
3095  END SELECT
3097  SELECT CASE(problem_setup%ACTION_TYPE)
3099  !Get the control loop
3100  control_loop_root=>problem%CONTROL_LOOP
3101  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3102  !Get the solver
3103  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3104  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3105  !Create the solver equations
3106  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3107  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
3109  & err,error,*999)
3110  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3112  !Get the control loop
3113  control_loop_root=>problem%CONTROL_LOOP
3114  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3115  !Get the solver equations
3116  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3117  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3118  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
3119  !Finish the solver equations creation
3120  CALL solver_equations_create_finish(solver_equations,err,error,*999)
3121  CASE DEFAULT
3122  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3123  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3124  & " is invalid for a Navier-Stokes fluid."
3125  CALL flagerror(local_error,err,error,*999)
3126  END SELECT
3128  SELECT CASE(problem_setup%ACTION_TYPE)
3130  !Get the control loop
3131  control_loop_root=>problem%CONTROL_LOOP
3132  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3133  !Get the solver
3134  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3135  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3136  !Get the CellML evaluator solver
3137  CALL solver_newton_cellml_solver_get(solver,cellmlsolver,err,error,*999)
3138  !Create the CellML equations
3139  CALL cellml_equations_create_start(cellmlsolver,cellml_equations, &
3140  & err,error,*999)
3142  !Get the control loop
3143  control_loop_root=>problem%CONTROL_LOOP
3144  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3145  !Get the solver
3146  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3147  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3148  !Get the CellML evaluator solver
3149  CALL solver_newton_cellml_solver_get(solver,cellmlsolver,err,error,*999)
3150  !Get the CellML equations for the CellML evaluator solver
3151  CALL solver_cellml_equations_get(cellmlsolver,cellml_equations,err,error,*999)
3152  !Finish the CellML equations creation
3153  CALL cellml_equations_create_finish(cellml_equations,err,error,*999)
3154  CASE DEFAULT
3155  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3156  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3157  & " is invalid for a CellML setup for a transient Navier-Stokes equation."
3158  CALL flagerror(local_error,err,error,*999)
3159  END SELECT
3160  CASE DEFAULT
3161  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3162  & " is invalid for a transient Navier-Stokes fluid."
3163  CALL flagerror(local_error,err,error,*999)
3164  END SELECT
3165  CASE(problem_transient1d_navier_stokes_subtype, & !1D Navier-Stokes
3166  & problem_coupled1d0d_navier_stokes_subtype, & ! with coupled 0D boundaries
3167  & problem_transient1d_adv_navier_stokes_subtype, & ! with coupled advection
3168  & problem_coupled1d0d_adv_navier_stokes_subtype, & ! with coupled 0D boundaries and advection
3169  & problem_stree1d0d_navier_stokes_subtype, & ! with stree
3170  & problem_stree1d0d_adv_navier_stokes_subtype) ! with stree and advection
3171 
3172  SELECT CASE(problem_setup%SETUP_TYPE)
3174  SELECT CASE(problem_setup%ACTION_TYPE)
3176  !Do nothing
3178  !Do nothing
3179  CASE DEFAULT
3180  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3181  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3182  & " is invalid for Coupled1dDaeNavierStokes equation."
3183  CALL flagerror(local_error,err,error,*999)
3184  END SELECT
3186  SELECT CASE(problem_setup%ACTION_TYPE)
3188  NULLIFY(control_loop_root)
3189  !Time Loop
3190  CALL control_loop_create_start(problem,control_loop,err,error,*999)
3191  CALL control_loop_type_set(control_loop,problem_control_time_loop_type,err,error,*999)
3192  NULLIFY(iterativewhileloop)
3193  IF(problem%specification(3) == problem_coupled1d0d_navier_stokes_subtype) THEN
3194  NULLIFY(iterativewhileloop)
3195  ! The 1D-0D boundary value iterative coupling loop
3196  CALL control_loop_number_of_sub_loops_set(control_loop,1,err,error,*999)
3197  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3198  CALL control_loop_type_set(iterativewhileloop,problem_control_while_loop_type,err,error,*999)
3199  CALL control_loop_maximum_iterations_set(iterativewhileloop,1000,err,error,*999)
3200  CALL controlloop_absolutetoleranceset(iterativewhileloop,0.1_dp,err,error,*999)
3201  CALL control_loop_label_set(iterativewhileloop,"1D-0D Iterative Coupling Convergence Loop",err,error,*999)
3202  CALL control_loop_number_of_sub_loops_set(iterativewhileloop,2,err,error,*999)
3203  NULLIFY(simpleloop)
3204  ! The simple CellML solver loop
3205  CALL control_loop_sub_loop_get(iterativewhileloop,1,simpleloop,err,error,*999)
3206  CALL control_loop_type_set(simpleloop,problem_control_simple_type,err,error,*999)
3207  CALL control_loop_label_set(simpleloop,"0D CellML solver Loop",err,error,*999)
3208  NULLIFY(iterativewhileloop2)
3209  ! The Characteristics branch solver/ Navier-Stokes iterative coupling loop
3210  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
3211  CALL control_loop_type_set(iterativewhileloop2,problem_control_while_loop_type,err,error,*999)
3212  CALL control_loop_maximum_iterations_set(iterativewhileloop2,1000,err,error,*999)
3213  CALL controlloop_absolutetoleranceset(iterativewhileloop2,1.0e6_dp,err,error,*999)
3214  CALL control_loop_label_set(iterativewhileloop2,"1D Characteristic/NSE branch value convergence Loop", &
3215  & err,error,*999)
3216  ELSE IF(problem%specification(3) == problem_coupled1d0d_adv_navier_stokes_subtype) THEN
3217  NULLIFY(iterativewhileloop)
3218  ! The 1D-0D boundary value iterative coupling loop
3219  CALL control_loop_number_of_sub_loops_set(control_loop,2,err,error,*999)
3220  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3221  CALL control_loop_type_set(iterativewhileloop,problem_control_while_loop_type,err,error,*999)
3222  CALL control_loop_maximum_iterations_set(iterativewhileloop,1000,err,error,*999)
3223  CALL controlloop_absolutetoleranceset(iterativewhileloop,0.1_dp,err,error,*999)
3224  CALL control_loop_label_set(iterativewhileloop,"1D-0D Iterative Coupling Convergence Loop",err,error,*999)
3225  CALL control_loop_number_of_sub_loops_set(iterativewhileloop,2,err,error,*999)
3226  NULLIFY(simpleloop)
3227  ! The simple CellML solver loop
3228  CALL control_loop_sub_loop_get(iterativewhileloop,1,simpleloop,err,error,*999)
3229  CALL control_loop_type_set(simpleloop,problem_control_simple_type,err,error,*999)
3230  CALL control_loop_label_set(simpleloop,"0D CellML solver Loop",err,error,*999)
3231  NULLIFY(iterativewhileloop2)
3232  ! The Characteristics branch solver/ Navier-Stokes iterative coupling loop
3233  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
3234  CALL control_loop_type_set(iterativewhileloop2,problem_control_while_loop_type,err,error,*999)
3235  CALL control_loop_maximum_iterations_set(iterativewhileloop2,1000,err,error,*999)
3236  CALL controlloop_absolutetoleranceset(iterativewhileloop2,1.0e6_dp,err,error,*999)
3237  CALL control_loop_label_set(iterativewhileloop2,"1D Characteristic/NSE branch value convergence Loop", &
3238  & err,error,*999)
3239  NULLIFY(simpleloop)
3240  ! The simple Advection solver loop
3241  CALL control_loop_sub_loop_get(control_loop,2,simpleloop,err,error,*999)
3242  CALL control_loop_type_set(simpleloop,problem_control_simple_type,err,error,*999)
3243  CALL control_loop_label_set(simpleloop,"Advection",err,error,*999)
3244  ELSE IF(problem%specification(3) == problem_transient1d_navier_stokes_subtype) THEN
3245  NULLIFY(iterativewhileloop)
3246  ! The Characteristics branch solver/ Navier-Stokes iterative coupling loop
3247  CALL control_loop_number_of_sub_loops_set(control_loop,1,err,error,*999)
3248  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3249  CALL control_loop_type_set(iterativewhileloop,problem_control_while_loop_type,err,error,*999)
3250  CALL control_loop_maximum_iterations_set(iterativewhileloop,1000,err,error,*999)
3251  CALL controlloop_absolutetoleranceset(iterativewhileloop,1.0e3_dp,err,error,*999)
3252  CALL control_loop_label_set(iterativewhileloop,"1D Characteristic/NSE branch value convergence Loop",err,error,*999)
3253  ELSE IF(problem%specification(3) == problem_transient1d_adv_navier_stokes_subtype) THEN
3254  NULLIFY(iterativewhileloop)
3255  ! The Characteristics branch solver/ Navier-Stokes iterative coupling loop
3256  CALL control_loop_number_of_sub_loops_set(control_loop,2,err,error,*999)
3257  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3258  CALL control_loop_type_set(iterativewhileloop,problem_control_while_loop_type,err,error,*999)
3259  CALL control_loop_maximum_iterations_set(iterativewhileloop,1000,err,error,*999)
3260  CALL controlloop_absolutetoleranceset(iterativewhileloop,1.0e6_dp,err,error,*999)
3261  CALL control_loop_label_set(iterativewhileloop,"1D Characteristic/NSE branch value convergence Loop",err,error,*999)
3262  NULLIFY(simpleloop)
3263  ! The simple Advection solver loop
3264  CALL control_loop_sub_loop_get(control_loop,2,simpleloop,err,error,*999)
3265  CALL control_loop_type_set(simpleloop,problem_control_simple_type,err,error,*999)
3266  CALL control_loop_label_set(simpleloop,"Advection",err,error,*999)
3267  ELSE IF(problem%specification(3) == problem_stree1d0d_navier_stokes_subtype) THEN
3268  NULLIFY(iterativewhileloop)
3269  ! The 1D-0D boundary value iterative coupling loop
3270  CALL control_loop_number_of_sub_loops_set(control_loop,1,err,error,*999)
3271  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3272  CALL control_loop_type_set(iterativewhileloop,problem_control_while_loop_type,err,error,*999)
3273  CALL control_loop_maximum_iterations_set(iterativewhileloop,1000,err,error,*999)
3274  CALL controlloop_absolutetoleranceset(iterativewhileloop,0.1_dp,err,error,*999)
3275  CALL control_loop_label_set(iterativewhileloop,"1D-0D Iterative Coupling Convergence Loop",err,error,*999)
3276  CALL control_loop_number_of_sub_loops_set(iterativewhileloop,2,err,error,*999)
3277  NULLIFY(simpleloop)
3278  ! The simple CellML solver loop
3279  CALL control_loop_sub_loop_get(iterativewhileloop,1,simpleloop,err,error,*999)
3280  CALL control_loop_type_set(simpleloop,problem_control_simple_type,err,error,*999)
3281  CALL control_loop_label_set(simpleloop,"0D CellML solver Loop",err,error,*999)
3282  NULLIFY(iterativewhileloop2)
3283  ! The Characteristics branch solver/ Navier-Stokes iterative coupling loop
3284  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
3285  CALL control_loop_type_set(iterativewhileloop2,problem_control_while_loop_type,err,error,*999)
3286  CALL control_loop_maximum_iterations_set(iterativewhileloop2,1000,err,error,*999)
3287  CALL controlloop_absolutetoleranceset(iterativewhileloop2,1.0e6_dp,err,error,*999)
3288  CALL control_loop_label_set(iterativewhileloop2,"1D Characteristic/NSE branch value convergence Loop", &
3289  & err,error,*999)
3290  ELSE IF(problem%specification(3) == problem_stree1d0d_adv_navier_stokes_subtype) THEN
3291  NULLIFY(iterativewhileloop)
3292  ! The 1D-0D boundary value iterative coupling loop
3293  CALL control_loop_number_of_sub_loops_set(control_loop,2,err,error,*999)
3294  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3295  CALL control_loop_type_set(iterativewhileloop,problem_control_while_loop_type,err,error,*999)
3296  CALL control_loop_maximum_iterations_set(iterativewhileloop,1000,err,error,*999)
3297  CALL controlloop_absolutetoleranceset(iterativewhileloop,0.1_dp,err,error,*999)
3298  CALL control_loop_label_set(iterativewhileloop,"1D-0D Iterative Coupling Convergence Loop",err,error,*999)
3299  CALL control_loop_number_of_sub_loops_set(iterativewhileloop,2,err,error,*999)
3300  NULLIFY(simpleloop)
3301  ! The simple CellML solver loop
3302  CALL control_loop_sub_loop_get(iterativewhileloop,1,simpleloop,err,error,*999)
3303  CALL control_loop_type_set(simpleloop,problem_control_simple_type,err,error,*999)
3304  CALL control_loop_label_set(simpleloop,"0D CellML solver Loop",err,error,*999)
3305  NULLIFY(iterativewhileloop2)
3306  ! The Characteristics branch solver/ Navier-Stokes iterative coupling loop
3307  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
3308  CALL control_loop_type_set(iterativewhileloop2,problem_control_while_loop_type,err,error,*999)
3309  CALL control_loop_maximum_iterations_set(iterativewhileloop2,1000,err,error,*999)
3310  CALL controlloop_absolutetoleranceset(iterativewhileloop2,1.0e6_dp,err,error,*999)
3311  CALL control_loop_label_set(iterativewhileloop2,"1D Characteristic/NSE branch value convergence Loop", &
3312  & err,error,*999)
3313  NULLIFY(simpleloop)
3314  ! The simple Advection solver loop
3315  CALL control_loop_sub_loop_get(control_loop,2,simpleloop,err,error,*999)
3316  CALL control_loop_type_set(simpleloop,problem_control_simple_type,err,error,*999)
3317  CALL control_loop_label_set(simpleloop,"Advection",err,error,*999)
3318  END IF
3320  control_loop_root=>problem%CONTROL_LOOP
3321  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3322  CALL control_loop_create_finish(control_loop,err,error,*999)
3323  CASE DEFAULT
3324  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3325  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3326  & " is invalid for a 1d transient Navier-Stokes fluid."
3327  CALL flagerror(local_error,err,error,*999)
3328  END SELECT
3329  !Create the solvers
3331  !Get the control loop
3332  control_loop_root=>problem%CONTROL_LOOP
3333  NULLIFY(control_loop)
3334  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3335  SELECT CASE(problem_setup%ACTION_TYPE)
3337  SELECT CASE(problem%specification(3))
3339  ! Iterative loop couples N-S and characteristics, checking convergence of branch values
3340  ! (this subloop holds 2 solvers)
3341  NULLIFY(iterativewhileloop)
3342  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3343  CALL solvers_create_start(iterativewhileloop,solvers,err,error,*999)
3344  CALL solvers_number_set(solvers,2,err,error,*999)
3345  !!!-- C H A R A C T E R I S T I C --!!!
3346  NULLIFY(solver)
3347  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3348  CALL solver_type_set(solver,solver_nonlinear_type,err,error,*999)
3349  CALL solver_label_set(solver,"Characteristic Solver",err,error,*999)
3350  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
3351  !!!-- N A V I E R S T O K E S --!!!
3352  NULLIFY(solver)
3353  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
3354  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
3355  CALL solver_label_set(solver,"Navier-Stokes Solver",err,error,*999)
3357  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
3358  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
3359  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
3361  ! Iterative loop couples N-S and characteristics, checking convergence of branch values
3362  ! (this subloop holds 2 solvers)
3363  NULLIFY(iterativewhileloop)
3364  NULLIFY(solvers)
3365  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3366  CALL solvers_create_start(iterativewhileloop,solvers,err,error,*999)
3367  CALL solvers_number_set(solvers,2,err,error,*999)
3368  !!!-- C H A R A C T E R I S T I C --!!!
3369  NULLIFY(solver)
3370  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3371  CALL solver_type_set(solver,solver_nonlinear_type,err,error,*999)
3372  CALL solver_label_set(solver,"Characteristic Solver",err,error,*999)
3373  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
3374  !!!-- N A V I E R S T O K E S --!!!
3375  NULLIFY(solver)
3376  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
3377  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
3378  CALL solver_label_set(solver,"Navier-Stokes Solver",err,error,*999)
3380  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
3381  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
3382  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
3383  ! Simple loop 1 contains the Advection solver
3384  ! (this subloop holds 1 solver)
3385  NULLIFY(simpleloop)
3386  NULLIFY(solvers)
3387  CALL control_loop_sub_loop_get(control_loop,2,simpleloop,err,error,*999)
3388  CALL solvers_create_start(simpleloop,solvers,err,error,*999)
3389  CALL solvers_number_set(solvers,1,err,error,*999)
3390  !!!-- A D V E C T I O N --!!!
3391  NULLIFY(solver)
3392  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3393  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
3394  CALL solver_label_set(solver,"Advection Solver",err,error,*999)
3395  CALL solver_dynamic_linearity_type_set(solver,solver_dynamic_linear,err,error,*999)
3396  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
3397  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
3398  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
3400  ! Iterative loop 1 couples 1D and 0D problems, checking convergence of boundary values
3401  ! (this subloop holds 2 subloops)
3402  NULLIFY(iterativewhileloop)
3403  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3404 
3405  ! Simple loop 1 contains the 0D/CellML DAE solver
3406  ! (this subloop holds 1 solver)
3407  NULLIFY(simpleloop)
3408  NULLIFY(solvers)
3409  CALL control_loop_sub_loop_get(iterativewhileloop,1,simpleloop,err,error,*999)
3410  CALL solvers_create_start(simpleloop,solvers,err,error,*999)
3411  CALL solvers_number_set(solvers,1,err,error,*999)
3412  !!!-- D A E --!!!
3413  NULLIFY(solver)
3414  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3415  CALL solver_type_set(solver,solver_dae_type,err,error,*999)
3416  CALL solver_label_set(solver,"DAE Solver",err,error,*999)
3417 
3418  ! Iterative loop 2 couples N-S and characteristics, checking convergence of branch values
3419  ! (this subloop holds 2 solvers)
3420  NULLIFY(iterativewhileloop2)
3421  NULLIFY(solvers)
3422  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
3423  CALL solvers_create_start(iterativewhileloop2,solvers,err,error,*999)
3424  CALL solvers_number_set(solvers,2,err,error,*999)
3425  !!!-- C H A R A C T E R I S T I C --!!!
3426  NULLIFY(solver)
3427  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3428  CALL solver_type_set(solver,solver_nonlinear_type,err,error,*999)
3429  CALL solver_label_set(solver,"Characteristic Solver",err,error,*999)
3430  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
3431  !!!-- N A V I E R S T O K E S --!!!
3432  NULLIFY(solver)
3433  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
3434  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
3435  CALL solver_label_set(solver,"Navier-Stokes Solver",err,error,*999)
3437  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
3438  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
3439  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
3440 
3441  ! Iterative loop 2 couples N-S and characteristics, checking convergence of branch values
3442  ! (this subloop holds 2 solvers)
3443  NULLIFY(simpleloop)
3444  NULLIFY(solvers)
3445  CALL control_loop_sub_loop_get(control_loop,2,simpleloop,err,error,*999)
3446  CALL solvers_create_start(simpleloop,solvers,err,error,*999)
3447  CALL solvers_number_set(solvers,1,err,error,*999)
3448  !!!-- A D V E C T I O N --!!!
3449  NULLIFY(solver)
3450  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3451  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
3452  CALL solver_label_set(solver,"Advection Solver",err,error,*999)
3453  CALL solver_dynamic_linearity_type_set(solver,solver_dynamic_linear,err,error,*999)
3454  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
3455  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
3456  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
3458  ! Iterative loop 1 couples 1D and 0D problems, checking convergence of boundary values
3459  ! (this subloop holds 2 subloops)
3460  NULLIFY(iterativewhileloop)
3461  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3462  ! Simple loop 1 contains the 0D/CellML DAE solver
3463  ! (this subloop holds 1 solver)
3464  NULLIFY(simpleloop)
3465  NULLIFY(solvers)
3466  CALL control_loop_sub_loop_get(iterativewhileloop,1,simpleloop,err,error,*999)
3467  CALL solvers_create_start(simpleloop,solvers,err,error,*999)
3468  CALL solvers_number_set(solvers,1,err,error,*999)
3469  !!!-- D A E --!!!
3470  NULLIFY(solver)
3471  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3472  CALL solver_type_set(solver,solver_nonlinear_type,err,error,*999)
3473  CALL solver_label_set(solver,"Linear Solver",err,error,*999)
3474  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
3475  ! Iterative loop 2 couples N-S and characteristics, checking convergence of branch values
3476  ! (this subloop holds 2 solvers)
3477  NULLIFY(iterativewhileloop2)
3478  NULLIFY(solvers)
3479  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
3480  CALL solvers_create_start(iterativewhileloop2,solvers,err,error,*999)
3481  CALL solvers_number_set(solvers,2,err,error,*999)
3482  !!!-- C H A R A C T E R I S T I C --!!!
3483  NULLIFY(solver)
3484  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3485  CALL solver_type_set(solver,solver_nonlinear_type,err,error,*999)
3486  CALL solver_label_set(solver,"Characteristic Solver",err,error,*999)
3487  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
3488  !!!-- N A V I E R S T O K E S --!!!
3489  NULLIFY(solver)
3490  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
3491  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
3492  CALL solver_label_set(solver,"Navier-Stokes Solver",err,error,*999)
3494  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
3495  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
3496  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
3497  ! Iterative loop 2 couples N-S and characteristics, checking convergence of branch values
3498  ! (this subloop holds 2 solvers)
3499  NULLIFY(simpleloop)
3500  NULLIFY(solvers)
3501  CALL control_loop_sub_loop_get(control_loop,2,simpleloop,err,error,*999)
3502  CALL solvers_create_start(simpleloop,solvers,err,error,*999)
3503  CALL solvers_number_set(solvers,1,err,error,*999)
3504  !!!-- A D V E C T I O N --!!!
3505  NULLIFY(solver)
3506  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3507  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
3508  CALL solver_label_set(solver,"Advection Solver",err,error,*999)
3509  CALL solver_dynamic_linearity_type_set(solver,solver_dynamic_linear,err,error,*999)
3510  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
3511  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
3512  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
3514  ! Iterative loop 1 couples 1D and 0D problems, checking convergence of boundary values
3515  ! (this subloop holds 2 subloops)
3516  NULLIFY(iterativewhileloop)
3517  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3518 
3519  ! Simple loop 1 contains the 0D/CellML DAE solver
3520  ! (this subloop holds 1 solver)
3521  NULLIFY(simpleloop)
3522  NULLIFY(solvers)
3523  CALL control_loop_sub_loop_get(iterativewhileloop,1,simpleloop,err,error,*999)
3524  CALL solvers_create_start(simpleloop,solvers,err,error,*999)
3525  CALL solvers_number_set(solvers,1,err,error,*999)
3526  !!!-- D A E --!!!
3527  NULLIFY(solver)
3528  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3529  CALL solver_type_set(solver,solver_dae_type,err,error,*999)
3530  CALL solver_label_set(solver,"DAE Solver",err,error,*999)
3531 
3532  ! Iterative loop 2 couples N-S and characteristics, checking convergence of branch values
3533  ! (this subloop holds 2 solvers)
3534  NULLIFY(iterativewhileloop2)
3535  NULLIFY(solvers)
3536  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
3537  CALL solvers_create_start(iterativewhileloop2,solvers,err,error,*999)
3538  CALL solvers_number_set(solvers,2,err,error,*999)
3539  !!!-- C H A R A C T E R I S T I C --!!!
3540  NULLIFY(solver)
3541  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3542  CALL solver_type_set(solver,solver_nonlinear_type,err,error,*999)
3543  CALL solver_label_set(solver,"Characteristic Solver",err,error,*999)
3544  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
3545  !!!-- N A V I E R S T O K E S --!!!
3546  NULLIFY(solver)
3547  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
3548  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
3549  CALL solver_label_set(solver,"Navier-Stokes Solver",err,error,*999)
3551  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
3552  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
3553  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
3555  ! Iterative loop 1 couples 1D and 0D problems, checking convergence of boundary values
3556  ! (this subloop holds 2 subloops)
3557  NULLIFY(iterativewhileloop)
3558  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3559 
3560  ! Simple loop 1 contains the 0D/CellML DAE solver
3561  ! (this subloop holds 1 solver)
3562  NULLIFY(simpleloop)
3563  NULLIFY(solvers)
3564  CALL control_loop_sub_loop_get(iterativewhileloop,1,simpleloop,err,error,*999)
3565  CALL solvers_create_start(simpleloop,solvers,err,error,*999)
3566  CALL solvers_number_set(solvers,1,err,error,*999)
3567  !!!-- D A E --!!!
3568  NULLIFY(solver)
3569  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3570  CALL solver_type_set(solver,solver_linear_type,err,error,*999)
3571  CALL solver_label_set(solver,"Linear Solver",err,error,*999)
3572  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
3573 
3574  ! Iterative loop 2 couples N-S and characteristics, checking convergence of branch values
3575  ! (this subloop holds 2 solvers)
3576  NULLIFY(iterativewhileloop2)
3577  NULLIFY(solvers)
3578  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
3579  CALL solvers_create_start(iterativewhileloop2,solvers,err,error,*999)
3580  CALL solvers_number_set(solvers,2,err,error,*999)
3581  !!!-- C H A R A C T E R I S T I C --!!!
3582  NULLIFY(solver)
3583  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3584  CALL solver_type_set(solver,solver_nonlinear_type,err,error,*999)
3585  CALL solver_label_set(solver,"Characteristic Solver",err,error,*999)
3586  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
3587  !!!-- N A V I E R S T O K E S --!!!
3588  NULLIFY(solver)
3589  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
3590  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
3591  CALL solver_label_set(solver,"Navier-Stokes Solver",err,error,*999)
3593  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
3594  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
3595  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
3596  CASE DEFAULT
3597  local_error="Problem subtype "//trim(number_to_vstring(problem%specification(3),"*",err,error))// &
3598  & " is not valid for a Navier-Stokes equation type of a fluid mechanics problem class."
3599  CALL flagerror(local_error,err,error,*999)
3600  END SELECT
3602  IF(problem%specification(3)==problem_coupled1d0d_navier_stokes_subtype) THEN
3603  NULLIFY(iterativewhileloop)
3604  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3605  NULLIFY(simpleloop)
3606  NULLIFY(solvers)
3607  CALL control_loop_sub_loop_get(iterativewhileloop,1,simpleloop,err,error,*999)
3608  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
3609  CALL solvers_create_finish(solvers,err,error,*999)
3610  NULLIFY(iterativewhileloop2)
3611  NULLIFY(solvers)
3612  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
3613  CALL control_loop_solvers_get(iterativewhileloop2,solvers,err,error,*999)
3614  CALL solvers_create_finish(solvers,err,error,*999)
3615  ELSE IF(problem%specification(3)==problem_stree1d0d_navier_stokes_subtype) THEN
3616  NULLIFY(iterativewhileloop)
3617  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3618  NULLIFY(simpleloop)
3619  NULLIFY(solvers)
3620  CALL control_loop_sub_loop_get(iterativewhileloop,1,simpleloop,err,error,*999)
3621  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
3622  CALL solvers_create_finish(solvers,err,error,*999)
3623  NULLIFY(iterativewhileloop2)
3624  NULLIFY(solvers)
3625  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
3626  CALL control_loop_solvers_get(iterativewhileloop2,solvers,err,error,*999)
3627  CALL solvers_create_finish(solvers,err,error,*999)
3628  ELSE IF(problem%specification(3)==problem_transient1d_navier_stokes_subtype) THEN
3629  NULLIFY(iterativewhileloop)
3630  NULLIFY(solvers)
3631  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3632  CALL control_loop_solvers_get(iterativewhileloop,solvers,err,error,*999)
3633  CALL solvers_create_finish(solvers,err,error,*999)
3634  ELSE IF(problem%specification(3)==problem_transient1d_adv_navier_stokes_subtype) THEN
3635  NULLIFY(iterativewhileloop)
3636  NULLIFY(solvers)
3637  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3638  CALL control_loop_solvers_get(iterativewhileloop,solvers,err,error,*999)
3639  CALL solvers_create_finish(solvers,err,error,*999)
3640  NULLIFY(simpleloop)
3641  NULLIFY(solvers)
3642  CALL control_loop_sub_loop_get(control_loop,2,simpleloop,err,error,*999)
3643  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
3644  CALL solvers_create_finish(solvers,err,error,*999)
3645  ELSE IF(problem%specification(3)==problem_coupled1d0d_adv_navier_stokes_subtype) THEN
3646  NULLIFY(iterativewhileloop)
3647  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3648  NULLIFY(simpleloop)
3649  NULLIFY(solvers)
3650  CALL control_loop_sub_loop_get(iterativewhileloop,1,simpleloop,err,error,*999)
3651  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
3652  CALL solvers_create_finish(solvers,err,error,*999)
3653  NULLIFY(iterativewhileloop2)
3654  NULLIFY(solvers)
3655  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
3656  CALL control_loop_solvers_get(iterativewhileloop2,solvers,err,error,*999)
3657  CALL solvers_create_finish(solvers,err,error,*999)
3658  NULLIFY(simpleloop)
3659  NULLIFY(solvers)
3660  CALL control_loop_sub_loop_get(control_loop,2,simpleloop,err,error,*999)
3661  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
3662  CALL solvers_create_finish(solvers,err,error,*999)
3663  ELSE IF(problem%specification(3)==problem_stree1d0d_adv_navier_stokes_subtype) THEN
3664  NULLIFY(iterativewhileloop)
3665  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3666  NULLIFY(simpleloop)
3667  NULLIFY(solvers)
3668  CALL control_loop_sub_loop_get(iterativewhileloop,1,simpleloop,err,error,*999)
3669  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
3670  CALL solvers_create_finish(solvers,err,error,*999)
3671  NULLIFY(iterativewhileloop2)
3672  NULLIFY(solvers)
3673  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
3674  CALL control_loop_solvers_get(iterativewhileloop2,solvers,err,error,*999)
3675  CALL solvers_create_finish(solvers,err,error,*999)
3676  NULLIFY(simpleloop)
3677  NULLIFY(solvers)
3678  CALL control_loop_sub_loop_get(control_loop,2,simpleloop,err,error,*999)
3679  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
3680  CALL solvers_create_finish(solvers,err,error,*999)
3681  END IF
3682  CASE DEFAULT
3683  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3684  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3685  & " is invalid for a 1d transient Navier-Stokes fluid."
3686  CALL flagerror(local_error,err,error,*999)
3687  END SELECT
3688  !Create the solver equations
3690  SELECT CASE(problem_setup%ACTION_TYPE)
3692  !Get the control loop
3693  control_loop_root=>problem%CONTROL_LOOP
3694  NULLIFY(control_loop)
3695  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3696  NULLIFY(solver)
3697  NULLIFY(solver_equations)
3698  SELECT CASE(problem%specification(3))
3700  NULLIFY(iterativewhileloop)
3701  ! Iterative loop couples N-S and characteristics, checking convergence of branch values
3702  ! (this subloop holds 2 solvers)
3703  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3704  CALL control_loop_solvers_get(iterativewhileloop,solvers,err,error,*999)
3705  !!!-- C H A R A C T E R I S T I C --!!!
3706  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3707  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3708  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
3709  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
3710  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3711  NULLIFY(solver)
3712  NULLIFY(solver_equations)
3713  !!!-- N A V I E R S T O K E S --!!!
3714  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
3715  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3716  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
3718  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3720  NULLIFY(iterativewhileloop)
3721  ! Iterative loop couples N-S and characteristics, checking convergence of branch values
3722  ! (this subloop holds 2 solvers)
3723  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3724  CALL control_loop_solvers_get(iterativewhileloop,solvers,err,error,*999)
3725  !!!-- C H A R A C T E R I S T I C --!!!
3726  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3727  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3728  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3729  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
3730  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
3731  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3732  NULLIFY(solver)
3733  NULLIFY(solver_equations)
3734  !!!-- N A V I E R S T O K E S --!!!
3735  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
3736  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3737  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
3739  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3740  NULLIFY(solver)
3741  NULLIFY(solvers)
3742  NULLIFY(solver_equations)
3743  NULLIFY(simpleloop)
3744  ! Iterative loop couples N-S and characteristics, checking convergence of branch values
3745  ! (this subloop holds 2 solvers)
3746  CALL control_loop_sub_loop_get(control_loop,2,simpleloop,err,error,*999)
3747  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
3748  !!!-- A D V E C T I O N --!!!
3749  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3750  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3751  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
3753  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3755  NULLIFY(iterativewhileloop)
3756  ! Iterative loop 1 couples 1D and 0D problems, checking convergence of boundary values
3757  ! (this subloop holds 2 subloops)
3758  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3759  NULLIFY(iterativewhileloop2)
3760  ! Iterative loop 2 couples N-S and characteristics, checking convergence of branch values
3761  ! (this subloop holds 2 solvers)
3762  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
3763  CALL control_loop_solvers_get(iterativewhileloop2,solvers,err,error,*999)
3764  !!!-- C H A R A C T E R I S T I C --!!!
3765  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3766  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3767  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
3768  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
3769  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3770  NULLIFY(solver)
3771  NULLIFY(solver_equations)
3772  !!!-- N A V I E R S T O K E S --!!!
3773  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
3774  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3775  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
3777  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3778  NULLIFY(solver)
3779  NULLIFY(solvers)
3780  NULLIFY(solver_equations)
3781  NULLIFY(simpleloop)
3782  ! Iterative loop couples N-S and characteristics, checking convergence of branch values
3783  ! (this subloop holds 2 solvers)
3784  CALL control_loop_sub_loop_get(control_loop,2,simpleloop,err,error,*999)
3785  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
3786  !!!-- A D V E C T I O N --!!!
3787  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3788  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3789  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
3791  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3793  NULLIFY(iterativewhileloop)
3794  ! Iterative loop 1 couples 1D and 0D problems, checking convergence of boundary values
3795  ! (this subloop holds 2 subloops)
3796  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3797  NULLIFY(iterativewhileloop2)
3798  ! Iterative loop 2 couples N-S and characteristics, checking convergence of branch values
3799  ! (this subloop holds 2 solvers)
3800  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
3801  CALL control_loop_solvers_get(iterativewhileloop2,solvers,err,error,*999)
3802  !!!-- C H A R A C T E R I S T I C --!!!
3803  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3804  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3805  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
3806  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
3807  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3808  NULLIFY(solver)
3809  NULLIFY(solver_equations)
3810  !!!-- N A V I E R S T O K E S --!!!
3811  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
3812  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3813  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
3815  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3817  NULLIFY(iterativewhileloop)
3818  ! Iterative loop 1 couples 1D and 0D problems, checking convergence of boundary values
3819  ! (this subloop holds 2 subloops)
3820  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3821  NULLIFY(simpleloop)
3822  CALL control_loop_sub_loop_get(iterativewhileloop,1,simpleloop,err,error,*999)
3823  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
3824  NULLIFY(solver)
3825  NULLIFY(solver_equations)
3826  !!!-- D A E --!!!
3827  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3828  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3829  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
3830  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
3831  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3832  NULLIFY(solver)
3833  NULLIFY(solver_equations)
3834  NULLIFY(iterativewhileloop2)
3835  ! Iterative loop 2 couples N-S and characteristics, checking convergence of branch values
3836  ! (this subloop holds 2 solvers)
3837  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
3838  CALL control_loop_solvers_get(iterativewhileloop2,solvers,err,error,*999)
3839  !!!-- C H A R A C T E R I S T I C --!!!
3840  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3841  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3842  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
3843  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
3844  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3845  NULLIFY(solver)
3846  NULLIFY(solver_equations)
3847  !!!-- N A V I E R S T O K E S --!!!
3848  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
3849  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3850  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
3852  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3853  NULLIFY(solver)
3854  NULLIFY(solvers)
3855  NULLIFY(solver_equations)
3856  NULLIFY(simpleloop)
3857  ! Iterative loop couples N-S and characteristics, checking convergence of branch values
3858  ! (this subloop holds 2 solvers)
3859  CALL control_loop_sub_loop_get(control_loop,2,simpleloop,err,error,*999)
3860  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
3861  !!!-- A D V E C T I O N --!!!
3862  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3863  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3864  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
3866  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3868  NULLIFY(iterativewhileloop)
3869  ! Iterative loop 1 couples 1D and 0D problems, checking convergence of boundary values
3870  ! (this subloop holds 2 subloops)
3871  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3872  NULLIFY(simpleloop)
3873  CALL control_loop_sub_loop_get(iterativewhileloop,1,simpleloop,err,error,*999)
3874  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
3875  NULLIFY(solver)
3876  NULLIFY(solver_equations)
3877  !!!-- D A E --!!!
3878  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3879  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3880  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
3881  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
3882  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3883  NULLIFY(solver)
3884  NULLIFY(solvers)
3885  NULLIFY(solver_equations)
3886  NULLIFY(iterativewhileloop2)
3887  ! Iterative loop 2 couples N-S and characteristics, checking convergence of branch values
3888  ! (this subloop holds 2 solvers)
3889  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
3890  CALL control_loop_solvers_get(iterativewhileloop2,solvers,err,error,*999)
3891  !!!-- C H A R A C T E R I S T I C --!!!
3892  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3893  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3894  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
3895  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
3896  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3897  NULLIFY(solver)
3898  NULLIFY(solver_equations)
3899  !!!-- N A V I E R S T O K E S --!!!
3900  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
3901  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3902  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
3904  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3905  CASE DEFAULT
3906  local_error="Problem subtype "//trim(number_to_vstring(problem%specification(3),"*",err,error))// &
3907  & " is not valid for a Navier-Stokes equation type of a fluid mechanics problem class."
3908  CALL flagerror(local_error,err,error,*999)
3909  END SELECT
3911  !Get the control loop
3912  control_loop_root=>problem%CONTROL_LOOP
3913  NULLIFY(control_loop)
3914  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3915  NULLIFY(solver)
3916  NULLIFY(solver_equations)
3917  SELECT CASE(problem%specification(3))
3919  NULLIFY(iterativewhileloop)
3920  ! Iterative loop couples N-S and characteristics, checking convergence of branch values
3921  ! (this subloop holds 2 solvers)
3922  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3923  CALL control_loop_solvers_get(iterativewhileloop,solvers,err,error,*999)
3924  !!!-- C H A R A C T E R I S T I C --!!!
3925  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3926  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
3927  CALL solver_equations_create_finish(solver_equations,err,error,*999)
3928  NULLIFY(solver)
3929  NULLIFY(solver_equations)
3930  !!!-- N A V I E R S T O K E S --!!!
3931  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
3932  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
3933  CALL solver_equations_create_finish(solver_equations,err,error,*999)
3935  NULLIFY(iterativewhileloop)
3936  ! Iterative loop couples N-S and characteristics, checking convergence of branch values
3937  ! (this subloop holds 2 solvers)
3938  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3939  CALL control_loop_solvers_get(iterativewhileloop,solvers,err,error,*999)
3940  !!!-- C H A R A C T E R I S T I C --!!!
3941  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3942  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
3943  CALL solver_equations_create_finish(solver_equations,err,error,*999)
3944  NULLIFY(solver)
3945  NULLIFY(solver_equations)
3946  !!!-- N A V I E R S T O K E S --!!!
3947  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
3948  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
3949  CALL solver_equations_create_finish(solver_equations,err,error,*999)
3950  NULLIFY(solvers)
3951  NULLIFY(solver)
3952  NULLIFY(solver_equations)
3953  NULLIFY(simpleloop)
3954  ! Iterative loop couples N-S and characteristics, checking convergence of branch values
3955  ! (this subloop holds 2 solvers)
3956  CALL control_loop_sub_loop_get(control_loop,2,simpleloop,err,error,*999)
3957  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
3958  !!!-- A D V E C T I O N --!!!
3959  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3960  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
3961  CALL solver_equations_create_finish(solver_equations,err,error,*999)
3963  NULLIFY(iterativewhileloop)
3964  ! Iterative loop 1 couples 1D and 0D problems, checking convergence of boundary values
3965  ! (this subloop holds 2 subloops)
3966  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3967  NULLIFY(iterativewhileloop2)
3968  ! Iterative loop 2 couples N-S and characteristics, checking convergence of branch values
3969  ! (this subloop holds 2 solvers)
3970  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
3971  CALL control_loop_solvers_get(iterativewhileloop2,solvers,err,error,*999)
3972  !!!-- C H A R A C T E R I S T I C --!!!
3973  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3974  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
3975  CALL solver_equations_create_finish(solver_equations,err,error,*999)
3976  NULLIFY(solver)
3977  NULLIFY(solver_equations)
3978  !!!-- N A V I E R S T O K E S --!!!
3979  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
3980  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
3981  CALL solver_equations_create_finish(solver_equations,err,error,*999)
3982  NULLIFY(solvers)
3983  NULLIFY(solver)
3984  NULLIFY(solver_equations)
3985  NULLIFY(simpleloop)
3986  ! Iterative loop couples N-S and characteristics, checking convergence of branch values
3987  ! (this subloop holds 2 solvers)
3988  CALL control_loop_sub_loop_get(control_loop,2,simpleloop,err,error,*999)
3989  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
3990  !!!-- A D V E C T I O N --!!!
3991  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3992  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
3993  CALL solver_equations_create_finish(solver_equations,err,error,*999)
3995  NULLIFY(iterativewhileloop)
3996  ! Iterative loop 1 couples 1D and 0D problems, checking convergence of boundary values
3997  ! (this subloop holds 2 subloops)
3998  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
3999  NULLIFY(iterativewhileloop2)
4000  ! Iterative loop 2 couples N-S and characteristics, checking convergence of branch values
4001  ! (this subloop holds 2 solvers)
4002  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
4003  CALL control_loop_solvers_get(iterativewhileloop2,solvers,err,error,*999)
4004  !!!-- C H A R A C T E R I S T I C --!!!
4005  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4006  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
4007  CALL solver_equations_create_finish(solver_equations,err,error,*999)
4008  NULLIFY(solver)
4009  NULLIFY(solver_equations)
4010  !!!-- N A V I E R S T O K E S --!!!
4011  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
4012  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
4013  CALL solver_equations_create_finish(solver_equations,err,error,*999)
4015  NULLIFY(iterativewhileloop)
4016  ! Iterative loop 1 couples 1D and 0D problems, checking convergence of boundary values
4017  ! (this subloop holds 2 subloops)
4018  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
4019  NULLIFY(simpleloop)
4020  CALL control_loop_sub_loop_get(iterativewhileloop,1,simpleloop,err,error,*999)
4021  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
4022  NULLIFY(solver)
4023  NULLIFY(solver_equations)
4024  !!!-- D A E --!!!
4025  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4026  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
4027  CALL solver_equations_create_finish(solver_equations,err,error,*999)
4028  NULLIFY(solver)
4029  NULLIFY(solver_equations)
4030  NULLIFY(iterativewhileloop2)
4031  ! Iterative loop 2 couples N-S and characteristics, checking convergence of branch values
4032  ! (this subloop holds 2 solvers)
4033  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
4034  CALL control_loop_solvers_get(iterativewhileloop2,solvers,err,error,*999)
4035  !!!-- C H A R A C T E R I S T I C --!!!
4036  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4037  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
4038  CALL solver_equations_create_finish(solver_equations,err,error,*999)
4039  NULLIFY(solver)
4040  NULLIFY(solver_equations)
4041  !!!-- N A V I E R S T O K E S --!!!
4042  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
4043  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
4044  CALL solver_equations_create_finish(solver_equations,err,error,*999)
4045  NULLIFY(solvers)
4046  NULLIFY(solver)
4047  NULLIFY(solver_equations)
4048  NULLIFY(simpleloop)
4049  ! Iterative loop couples N-S and characteristics, checking convergence of branch values
4050  ! (this subloop holds 2 solvers)
4051  CALL control_loop_sub_loop_get(control_loop,2,simpleloop,err,error,*999)
4052  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
4053  !!!-- A D V E C T I O N --!!!
4054  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4055  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
4056  CALL solver_equations_create_finish(solver_equations,err,error,*999)
4058  NULLIFY(iterativewhileloop)
4059  ! Iterative loop 1 couples 1D and 0D problems, checking convergence of boundary values
4060  ! (this subloop holds 2 subloops)
4061  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
4062  NULLIFY(simpleloop)
4063  CALL control_loop_sub_loop_get(iterativewhileloop,1,simpleloop,err,error,*999)
4064  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
4065  NULLIFY(solver)
4066  NULLIFY(solver_equations)
4067  !!!-- D A E --!!!
4068  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4069  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
4070  CALL solver_equations_create_finish(solver_equations,err,error,*999)
4071  NULLIFY(solver)
4072  NULLIFY(solvers)
4073  NULLIFY(solver_equations)
4074  NULLIFY(iterativewhileloop2)
4075  ! Iterative loop 2 couples N-S and characteristics, checking convergence of branch values
4076  ! (this subloop holds 2 solvers)
4077  CALL control_loop_sub_loop_get(iterativewhileloop,2,iterativewhileloop2,err,error,*999)
4078  CALL control_loop_solvers_get(iterativewhileloop2,solvers,err,error,*999)
4079  !!!-- C H A R A C T E R I S T I C --!!!
4080  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4081  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
4082  CALL solver_equations_create_finish(solver_equations,err,error,*999)
4083  NULLIFY(solver)
4084  NULLIFY(solver_equations)
4085  !!!-- N A V I E R S T O K E S --!!!
4086  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
4087  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
4088  CALL solver_equations_create_finish(solver_equations,err,error,*999)
4089  CASE DEFAULT
4090  local_error="Problem subtype "//trim(number_to_vstring(problem%specification(3),"*",err,error))// &
4091  & " is not valid for a Navier-Stokes equation type of a fluid mechanics problem class."
4092  CALL flagerror(local_error,err,error,*999)
4093  END SELECT
4094  CASE DEFAULT
4095  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4096  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4097  & " is invalid for a Navier-Stokes fluid."
4098  CALL flagerror(local_error,err,error,*999)
4099  END SELECT
4100  !Create the CELLML solver equations
4102  SELECT CASE(problem_setup%ACTION_TYPE)
4104  !Get the control loop
4105  control_loop_root=>problem%CONTROL_LOOP
4106  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4107  IF(problem%specification(3) == problem_coupled1d0d_navier_stokes_subtype .OR. &
4108  & problem%specification(3) == problem_coupled1d0d_adv_navier_stokes_subtype) THEN
4109  NULLIFY(iterativewhileloop)
4110  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
4111  NULLIFY(simpleloop)
4112  CALL control_loop_sub_loop_get(iterativewhileloop,1,simpleloop,err,error,*999)
4113  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
4114  ELSE
4115  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
4116  END IF
4117  NULLIFY(solver)
4118  NULLIFY(cellmlsolver)
4119  NULLIFY(cellml_equations)
4120  SELECT CASE(problem%specification(3))
4123  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4124  CALL cellml_equations_create_start(solver,cellml_equations,err,error,*999)
4125  CASE DEFAULT
4126  local_error="Problem subtype "//trim(number_to_vstring(problem%specification(3),"*",err,error))// &
4127  & " is not valid for cellML equations setup Navier-Stokes equation type of a fluid mechanics problem class."
4128  CALL flagerror(local_error,err,error,*999)
4129  END SELECT
4131  !Get the control loop
4132  control_loop_root=>problem%CONTROL_LOOP
4133  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4134  IF(problem%specification(3) == problem_coupled1d0d_navier_stokes_subtype .OR. &
4135  & problem%specification(3) == problem_coupled1d0d_adv_navier_stokes_subtype) THEN
4136  NULLIFY(iterativewhileloop)
4137  CALL control_loop_sub_loop_get(control_loop,1,iterativewhileloop,err,error,*999)
4138  NULLIFY(simpleloop)
4139  CALL control_loop_sub_loop_get(iterativewhileloop,1,simpleloop,err,error,*999)
4140  CALL control_loop_solvers_get(simpleloop,solvers,err,error,*999)
4141  ELSE
4142  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
4143  END IF
4144  NULLIFY(solver)
4145  SELECT CASE(problem%specification(3))
4148  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4149  CALL solver_cellml_equations_get(solver,cellml_equations,err,error,*999)
4150  CALL cellml_equations_create_finish(cellml_equations,err,error,*999)
4151  CASE DEFAULT
4152  local_error="The third problem specification of "// &
4153  & trim(number_to_vstring(problem%specification(3),"*",err,error))// &
4154  & " is not valid for cellML equations setup Navier-Stokes fluid mechanics problem."
4155  CALL flagerror(local_error,err,error,*999)
4156  END SELECT
4157  CASE DEFAULT
4158  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4159  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4160  & " is invalid for a CellML setup for a 1D Navier-Stokes equation."
4161  CALL flagerror(local_error,err,error,*999)
4162  END SELECT
4163  CASE DEFAULT
4164  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4165  & " is invalid for a 1d transient Navier-Stokes fluid."
4166  CALL flagerror(local_error,err,error,*999)
4167  END SELECT
4169  !Quasi-static Navier-Stokes
4170  SELECT CASE(problem_setup%SETUP_TYPE)
4172  SELECT CASE(problem_setup%ACTION_TYPE)
4174  !Do nothing????
4176  !Do nothing???
4177  CASE DEFAULT
4178  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4179  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4180  & " is invalid for a quasistatic Navier-Stokes fluid."
4181  CALL flagerror(local_error,err,error,*999)
4182  END SELECT
4184  SELECT CASE(problem_setup%ACTION_TYPE)
4186  !Set up a time control loop
4187  CALL control_loop_create_start(problem,control_loop,err,error,*999)
4188  CALL control_loop_type_set(control_loop,problem_control_time_loop_type,err,error,*999)
4190  !Finish the control loops
4191  control_loop_root=>problem%CONTROL_LOOP
4192  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4193  CALL control_loop_create_finish(control_loop,err,error,*999)
4194  CASE DEFAULT
4195  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4196  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4197  & " is invalid for a quasistatic Navier-Stokes fluid."
4198  CALL flagerror(local_error,err,error,*999)
4199  END SELECT
4201  !Get the control loop
4202  control_loop_root=>problem%CONTROL_LOOP
4203  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4204  SELECT CASE(problem_setup%ACTION_TYPE)
4206  !Start the solvers creation
4207  CALL solvers_create_start(control_loop,solvers,err,error,*999)
4208  CALL solvers_number_set(solvers,1,err,error,*999)
4209  !Set the solver to be a nonlinear solver
4210  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4211  CALL solver_type_set(solver,solver_nonlinear_type,err,error,*999)
4212  !Set solver defaults
4213  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
4215  !Get the solvers
4216  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
4217  !Finish the solvers creation
4218  CALL solvers_create_finish(solvers,err,error,*999)
4219  CASE DEFAULT
4220  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4221  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4222  & " is invalid for a quasistatic Navier-Stokes equation."
4223  CALL flagerror(local_error,err,error,*999)
4224  END SELECT
4226  SELECT CASE(problem_setup%ACTION_TYPE)
4228  !Get the control loop
4229  control_loop_root=>problem%CONTROL_LOOP
4230  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4231  !Get the solver
4232  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
4233  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4234  !Create the solver equations
4235  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
4236  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
4237  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_quasistatic,err,error,*999)
4238  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
4240  !Get the control loop
4241  control_loop_root=>problem%CONTROL_LOOP
4242  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4243  !Get the solver equations
4244  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
4245  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4246  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
4247  !Finish the solver equations creation
4248  CALL solver_equations_create_finish(solver_equations,err,error,*999)
4249  CASE DEFAULT
4250  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4251  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4252  & " is invalid for a quasistatic Navier-Stokes equation."
4253  CALL flagerror(local_error,err,error,*999)
4254  END SELECT
4255  CASE DEFAULT
4256  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4257  & " is invalid for a quasistatic Navier-Stokes fluid."
4258  CALL flagerror(local_error,err,error,*999)
4259  END SELECT
4260  !Navier-Stokes ALE cases
4262  SELECT CASE(problem_setup%SETUP_TYPE)
4264  SELECT CASE(problem_setup%ACTION_TYPE)
4266  !Do nothing????
4268  !Do nothing????
4269  CASE DEFAULT
4270  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4271  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4272  & " is invalid for a ALE Navier-Stokes fluid."
4273  CALL flagerror(local_error,err,error,*999)
4274  END SELECT
4276  SELECT CASE(problem_setup%ACTION_TYPE)
4278  !Set up a time control loop
4279  CALL control_loop_create_start(problem,control_loop,err,error,*999)
4280  CALL control_loop_type_set(control_loop,problem_control_time_loop_type,err,error,*999)
4282  !Finish the control loops
4283  control_loop_root=>problem%CONTROL_LOOP
4284  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4285  CALL control_loop_create_finish(control_loop,err,error,*999)
4286  CASE DEFAULT
4287  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4288  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4289  & " is invalid for a ALE Navier-Stokes fluid."
4290  CALL flagerror(local_error,err,error,*999)
4291  END SELECT
4293  !Get the control loop
4294  control_loop_root=>problem%CONTROL_LOOP
4295  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4296  SELECT CASE(problem_setup%ACTION_TYPE)
4298  !Start the solvers creation
4299  CALL solvers_create_start(control_loop,solvers,err,error,*999)
4300  CALL solvers_number_set(solvers,2,err,error,*999)
4301  !Set the first solver to be a linear solver for the Laplace mesh movement problem
4302  CALL solvers_solver_get(solvers,1,mesh_solver,err,error,*999)
4303  CALL solver_type_set(mesh_solver,solver_linear_type,err,error,*999)
4304  !Set solver defaults
4305  CALL solver_library_type_set(mesh_solver,solver_petsc_library,err,error,*999)
4306  !Set the solver to be a first order dynamic solver
4307  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
4308  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
4310  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
4311  !Set solver defaults
4312  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
4314  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
4316  !Get the solvers
4317  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
4318  !Finish the solvers creation
4319  CALL solvers_create_finish(solvers,err,error,*999)
4320  CASE DEFAULT
4321  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4322  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4323  & " is invalid for a ALE Navier-Stokes fluid."
4324  CALL flagerror(local_error,err,error,*999)
4325  END SELECT
4327  SELECT CASE(problem_setup%ACTION_TYPE)
4329  !Get the control loop
4330  control_loop_root=>problem%CONTROL_LOOP
4331  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4332  !Get the solver
4333  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
4334  CALL solvers_solver_get(solvers,1,mesh_solver,err,error,*999)
4335  !Create the solver equations
4336  CALL solver_equations_create_start(mesh_solver,mesh_solver_equations,err,error,*999)
4337  CALL solver_equations_linearity_type_set(mesh_solver_equations,solver_equations_linear,err,error,*999)
4338  CALL solver_equations_time_dependence_type_set(mesh_solver_equations,solver_equations_static,err,error,*999)
4339  CALL solver_equations_sparsity_type_set(mesh_solver_equations,solver_sparse_matrices,err,error,*999)
4340  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
4341  !Create the solver equations
4342  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
4343  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_nonlinear,err,error,*999)
4345  & err,error,*999)
4346  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
4348  !Get the control loop
4349  control_loop_root=>problem%CONTROL_LOOP
4350  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
4351  !Get the solver equations
4352  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
4353  CALL solvers_solver_get(solvers,1,mesh_solver,err,error,*999)
4354  CALL solver_solver_equations_get(mesh_solver,mesh_solver_equations,err,error,*999)
4355  !Finish the solver equations creation
4356  CALL solver_equations_create_finish(mesh_solver_equations,err,error,*999)
4357  !Get the solver equations
4358  CALL solvers_solver_get(solvers,2,solver,err,error,*999)
4359  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
4360  !Finish the solver equations creation
4361  CALL solver_equations_create_finish(solver_equations,err,error,*999)
4362  CASE DEFAULT
4363  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4364  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4365  & " is invalid for a Navier-Stokes fluid."
4366  CALL flagerror(local_error,err,error,*999)
4367  END SELECT
4368  CASE DEFAULT
4369  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4370  & " is invalid for a ALE Navier-Stokes fluid."
4371  CALL flagerror(local_error,err,error,*999)
4372  END SELECT
4373  CASE DEFAULT
4374  local_error="The third problem specification of "//trim(number_to_vstring(problem%specification(3),"*",err,error))// &
4375  & " is not valid for a Navier-Stokes fluid mechanics problem."
4376  CALL flagerror(local_error,err,error,*999)
4377  END SELECT
4378  ELSE
4379  CALL flagerror("Problem is not associated.",err,error,*999)
4380  END IF
4381 
4382  exits("NAVIER_STOKES_PROBLEM_SETUP")
4383  RETURN
4384 999 errorsexits("NAVIER_STOKES_PROBLEM_SETUP",err,error)
4385  RETURN 1
4386 
4387  END SUBROUTINE navier_stokes_problem_setup
4388 
4389  !
4390  !================================================================================================================================
4391  !
4392 
4394  SUBROUTINE navierstokes_finiteelementresidualevaluate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
4396  !Argument variables
4397  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
4398  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
4399  INTEGER(INTG), INTENT(OUT) :: ERR
4400  TYPE(varying_string), INTENT(OUT) :: ERROR
4401  !Local Variables
4402  TYPE(basis_type), POINTER :: DEPENDENT_BASIS,DEPENDENT_BASIS1,DEPENDENT_BASIS2,GEOMETRIC_BASIS,INDEPENDENT_BASIS
4403  TYPE(decomposition_type), POINTER :: DECOMPOSITION
4404  TYPE(domain_elements_type), POINTER :: ELEMENTS_TOPOLOGY
4405  TYPE(equations_type), POINTER :: EQUATIONS
4406  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
4407  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
4408  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
4409  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
4410  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
4411  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
4412  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
4413  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
4414  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
4415  TYPE(equations_matrix_type), POINTER :: STIFFNESS_MATRIX,DAMPING_MATRIX
4416  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD,INDEPENDENT_FIELD
4417  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
4418  TYPE(quadrature_scheme_type), POINTER :: QUADRATURE_SCHEME,QUADRATURE_SCHEME1,QUADRATURE_SCHEME2
4419  INTEGER(INTG) :: ng,mh,mhs,mi,ms,nh,nhs,ni,ns,nhs_max,mhs_max,nhs_min,mhs_min,xv,out
4420  INTEGER(INTG) :: FIELD_VAR_TYPE,MESH_COMPONENT1,MESH_COMPONENT2,MESH_COMPONENT_NUMBER
4421  INTEGER(INTG) :: nodeIdx,xiIdx,coordIdx,derivativeIdx,versionIdx,elementVersionNumber,componentIdx
4422  INTEGER(INTG) :: numberOfVersions,nodeNumber,numberOfElementNodes,numberOfParameters,firstNode,lastNode
4423  REAL(DP) :: JGW,SUM,X(3),DXI_DX(3,3),DPHIMS_DXI(3),DPHINS_DXI(3),PHIMS,PHINS,momentum,mass,QUpwind,AUpwind,pExternal
4424  REAL(DP) :: U_VALUE(3),W_VALUE(3),U_DERIV(3,3),Q_VALUE,A_VALUE,Q_DERIV,A_DERIV,area,pressure,normalWave,normal,Lref,Tref,Mref
4425  REAL(DP) :: MU_PARAM,RHO_PARAM,A0_PARAM,E_PARAM,H_PARAM,A0_DERIV,E_DERIV,H_DERIV,alpha,beta,G0_PARAM,muScale
4426  REAL(DP), POINTER :: dependentParameters(:),materialsParameters(:),materialsParameters1(:)
4427  LOGICAL :: UPDATE_STIFFNESS_MATRIX,UPDATE_DAMPING_MATRIX,UPDATE_RHS_VECTOR,UPDATE_NONLINEAR_RESIDUAL
4428  TYPE(varying_string) :: LOCAL_ERROR
4429 
4430  enters("NavierStokes_FiniteElementResidualEvaluate",err,error,*999)
4431 
4432  update_stiffness_matrix=.false.
4433  update_damping_matrix=.false.
4434  update_rhs_vector=.false.
4435  update_nonlinear_residual=.false.
4436  x=0.0_dp
4437  out=0
4438 
4439  NULLIFY(dependent_basis,geometric_basis)
4440  NULLIFY(equations)
4441  NULLIFY(equations_mapping)
4442  NULLIFY(linear_mapping)
4443  NULLIFY(nonlinear_mapping)
4444  NULLIFY(dynamic_mapping)
4445  NULLIFY(equations_matrices)
4446  NULLIFY(linear_matrices)
4447  NULLIFY(nonlinear_matrices)
4448  NULLIFY(dynamic_matrices)
4449  NULLIFY(rhs_vector)
4450  NULLIFY(stiffness_matrix, damping_matrix)
4451  NULLIFY(dependent_field,independent_field,geometric_field,materials_field)
4452  NULLIFY(dependentparameters,materialsparameters,materialsparameters1)
4453  NULLIFY(field_variable)
4454  NULLIFY(quadrature_scheme)
4455  NULLIFY(quadrature_scheme1, quadrature_scheme2)
4456  NULLIFY(decomposition)
4457 
4458  IF(ASSOCIATED(equations_set)) THEN
4459  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
4460  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
4461  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
4462  CALL flagerror("Equations set specification must have three entries for a Navier-Stokes type equations set.", &
4463  & err,error,*999)
4464  END IF
4465  equations=>equations_set%EQUATIONS
4466  IF(ASSOCIATED(equations)) THEN
4467  SELECT CASE(equations_set%SPECIFICATION(3))
4476  !Set general and specific pointers
4477  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
4478  independent_field=>equations%INTERPOLATION%INDEPENDENT_FIELD
4479  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
4480  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
4481  equations_matrices=>equations%EQUATIONS_MATRICES
4482  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
4483  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
4484  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
4485  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
4486  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
4487  rhs_vector=>equations_matrices%RHS_VECTOR
4488  equations_mapping=>equations%EQUATIONS_MAPPING
4489  SELECT CASE(equations_set%SPECIFICATION(3))
4492  linear_matrices=>equations_matrices%LINEAR_MATRICES
4493  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4494  stiffness_matrix=>linear_matrices%MATRICES(1)%PTR
4495  linear_mapping=>equations_mapping%LINEAR_MAPPING
4496  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
4497  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
4498  field_var_type=field_variable%VARIABLE_TYPE
4499  stiffness_matrix%ELEMENT_MATRIX%MATRIX=0.0_dp
4500  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR=0.0_dp
4501  IF(ASSOCIATED(stiffness_matrix)) update_stiffness_matrix=stiffness_matrix%UPDATE_MATRIX
4502  IF(ASSOCIATED(rhs_vector)) update_rhs_vector=rhs_vector%UPDATE_VECTOR
4503  IF(ASSOCIATED(nonlinear_matrices)) update_nonlinear_residual=nonlinear_matrices%UPDATE_RESIDUAL
4505  linear_matrices=>equations_matrices%LINEAR_MATRICES
4506  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4507  stiffness_matrix=>linear_matrices%MATRICES(1)%PTR
4508  linear_mapping=>equations_mapping%LINEAR_MAPPING
4509  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
4510  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
4511  field_var_type=field_variable%VARIABLE_TYPE
4512  stiffness_matrix%ELEMENT_MATRIX%MATRIX=0.0_dp
4513  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR=0.0_dp
4514  IF(ASSOCIATED(stiffness_matrix)) update_stiffness_matrix=stiffness_matrix%UPDATE_MATRIX
4515  IF(ASSOCIATED(rhs_vector)) update_rhs_vector=rhs_vector%UPDATE_VECTOR
4516  IF(ASSOCIATED(nonlinear_matrices)) update_nonlinear_residual=nonlinear_matrices%UPDATE_RESIDUAL
4518  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
4519  stiffness_matrix=>dynamic_matrices%MATRICES(1)%PTR
4520  damping_matrix=>dynamic_matrices%MATRICES(2)%PTR
4521  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4522  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
4523  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
4524  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
4525  field_var_type=field_variable%VARIABLE_TYPE
4526  stiffness_matrix%ELEMENT_MATRIX%MATRIX=0.0_dp
4527  damping_matrix%ELEMENT_MATRIX%MATRIX=0.0_dp
4528  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR=0.0_dp
4529  IF(ASSOCIATED(stiffness_matrix)) update_stiffness_matrix=stiffness_matrix%UPDATE_MATRIX
4530  IF(ASSOCIATED(damping_matrix)) update_damping_matrix=damping_matrix%UPDATE_MATRIX
4531  IF(ASSOCIATED(rhs_vector)) update_rhs_vector=rhs_vector%UPDATE_VECTOR
4532  IF(ASSOCIATED(nonlinear_matrices)) update_nonlinear_residual=nonlinear_matrices%UPDATE_RESIDUAL
4535  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
4536  stiffness_matrix=>dynamic_matrices%MATRICES(1)%PTR
4537  damping_matrix=>dynamic_matrices%MATRICES(2)%PTR
4538  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4539  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
4540  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
4541  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
4542  field_var_type=field_variable%VARIABLE_TYPE
4543  stiffness_matrix%ELEMENT_MATRIX%MATRIX=0.0_dp
4544  damping_matrix%ELEMENT_MATRIX%MATRIX=0.0_dp
4545  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR=0.0_dp
4546  IF(ASSOCIATED(stiffness_matrix)) update_stiffness_matrix=stiffness_matrix%UPDATE_MATRIX
4547  IF(ASSOCIATED(damping_matrix)) update_damping_matrix=damping_matrix%UPDATE_MATRIX
4548  IF(ASSOCIATED(rhs_vector)) update_rhs_vector=rhs_vector%UPDATE_VECTOR
4549  IF(ASSOCIATED(nonlinear_matrices)) update_nonlinear_residual=nonlinear_matrices%UPDATE_RESIDUAL
4550  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
4551  & materials_interp_parameters(field_v_variable_type)%PTR,err,error,*999)
4553  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
4554  stiffness_matrix=>dynamic_matrices%MATRICES(1)%PTR
4555  damping_matrix=>dynamic_matrices%MATRICES(2)%PTR
4556  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4557  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
4558  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
4559  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
4560  field_var_type=field_variable%VARIABLE_TYPE
4561  stiffness_matrix%ELEMENT_MATRIX%MATRIX=0.0_dp
4562  damping_matrix%ELEMENT_MATRIX%MATRIX=0.0_dp
4563  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR=0.0_dp
4564  IF(ASSOCIATED(stiffness_matrix)) update_stiffness_matrix=stiffness_matrix%UPDATE_MATRIX
4565  IF(ASSOCIATED(damping_matrix)) update_damping_matrix=damping_matrix%UPDATE_MATRIX
4566  IF(ASSOCIATED(rhs_vector)) update_rhs_vector=rhs_vector%UPDATE_VECTOR
4567  IF(ASSOCIATED(nonlinear_matrices)) update_nonlinear_residual=nonlinear_matrices%UPDATE_RESIDUAL
4570  decomposition => dependent_field%DECOMPOSITION
4571  mesh_component_number = decomposition%MESH_COMPONENT_NUMBER
4572  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
4573  stiffness_matrix=>dynamic_matrices%MATRICES(1)%PTR
4574  damping_matrix=>dynamic_matrices%MATRICES(2)%PTR
4575  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4576  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
4577  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
4578  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
4579  field_var_type=field_variable%VARIABLE_TYPE
4580  stiffness_matrix%ELEMENT_MATRIX%MATRIX=0.0_dp
4581  damping_matrix%ELEMENT_MATRIX%MATRIX=0.0_dp
4582  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR=0.0_dp
4583  IF(ASSOCIATED(stiffness_matrix)) update_stiffness_matrix=stiffness_matrix%UPDATE_MATRIX
4584  IF(ASSOCIATED(damping_matrix)) update_damping_matrix=damping_matrix%UPDATE_MATRIX
4585  IF(ASSOCIATED(rhs_vector)) update_rhs_vector=rhs_vector%UPDATE_VECTOR
4586  IF(ASSOCIATED(nonlinear_matrices)) update_nonlinear_residual=nonlinear_matrices%UPDATE_RESIDUAL
4588  independent_field=>equations%INTERPOLATION%INDEPENDENT_FIELD
4589  independent_basis=>independent_field%DECOMPOSITION%DOMAIN(independent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)% &
4590  & ptr%TOPOLOGY%ELEMENTS%ELEMENTS(element_number)%BASIS
4591  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
4592  stiffness_matrix=>dynamic_matrices%MATRICES(1)%PTR
4593  damping_matrix=>dynamic_matrices%MATRICES(2)%PTR
4594  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4595  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
4596  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
4597  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
4598  field_var_type=field_variable%VARIABLE_TYPE
4599  stiffness_matrix%ELEMENT_MATRIX%MATRIX=0.0_dp
4600  damping_matrix%ELEMENT_MATRIX%MATRIX=0.0_dp
4601  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR=0.0_dp
4602  IF(ASSOCIATED(stiffness_matrix)) update_stiffness_matrix=stiffness_matrix%UPDATE_MATRIX
4603  IF(ASSOCIATED(damping_matrix)) update_damping_matrix=damping_matrix%UPDATE_MATRIX
4604  IF(ASSOCIATED(rhs_vector)) update_rhs_vector=rhs_vector%UPDATE_VECTOR
4605  IF(ASSOCIATED(nonlinear_matrices)) update_nonlinear_residual=nonlinear_matrices%UPDATE_RESIDUAL
4606  CALL field_interpolation_parameters_element_get(field_mesh_velocity_set_type,element_number,equations%INTERPOLATION% &
4607  & independent_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
4608  CASE DEFAULT
4609  local_error="Equations set subtype "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
4610  & " is not valid for a Navier-Stokes fluid type of a fluid mechanics equations set class."
4611  CALL flagerror(local_error,err,error,*999)
4612  END SELECT
4613  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
4614  & dependent_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
4615  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
4616  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
4617  CALL field_parameter_set_get_constant(materials_field,field_u_variable_type,field_values_set_type,1, &
4618  & mu_param,err,error,*999)<