OpenCMISS-Iron Internal API Documentation
Navier_Stokes_equations_routines.f90
Go to the documentation of this file.
1 
43 
45 MODULE navier_stokes_equations_routines
46 
47  USE advection_equation_routines
48  USE analytic_analysis_routines
49  USE base_routines
50  USE basis_routines
51  USE boundary_conditions_routines
52  USE characteristic_equation_routines
53  USE cmiss_mpi
54  USE comp_environment
55  USE constants
56  USE control_loop_routines
57  USE coordinate_routines
58  USE distributed_matrix_vector
59  USE domain_mappings
60  USE equations_routines
61  USE equations_mapping_routines
62  USE equations_matrices_routines
63  USE equations_set_constants
64  USE field_routines
65  USE field_io_routines
66  USE fluid_mechanics_io_routines
67  USE input_output
68  USE iso_varying_string
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
78  USE problem_constants
79  USE stree_equation_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,*)
136 
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))
155  CASE(equations_set_static_navier_stokes_subtype, &
156  & equations_set_static_rbs_navier_stokes_subtype, &
157  & equations_set_laplace_navier_stokes_subtype, &
158  & equations_set_transient_navier_stokes_subtype, &
159  & equations_set_transient_rbs_navier_stokes_subtype, &
160  & equations_set_multiscale3d_navier_stokes_subtype, &
161  & equations_set_constitutive_mu_navier_stokes_subtype, &
162  & equations_set_transient1d_adv_navier_stokes_subtype, &
163  & equations_set_coupled1d0d_adv_navier_stokes_subtype, &
164  & equations_set_transient1d_navier_stokes_subtype, &
165  & equations_set_coupled1d0d_navier_stokes_subtype, &
166  & equations_set_quasistatic_navier_stokes_subtype, &
167  & equations_set_ale_navier_stokes_subtype, &
168  & equations_set_pgm_navier_stokes_subtype)
169  SELECT CASE(solution_method)
170  CASE(equations_set_fem_solution_method)
171  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
172  CASE(equations_set_nodal_solution_method)
173  equations_set%SOLUTION_METHOD=equations_set_nodal_solution_method
174  CASE(equations_set_bem_solution_method)
175  CALL flagerror("Not implemented.",err,error,*999)
176  CASE(equations_set_fd_solution_method)
177  CALL flagerror("Not implemented.",err,error,*999)
178  CASE(equations_set_fv_solution_method)
179  CALL flagerror("Not implemented.",err,error,*999)
180  CASE(equations_set_gfem_solution_method)
181  CALL flagerror("Not implemented.",err,error,*999)
182  CASE(equations_set_gfv_solution_method)
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,*)
211 
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)
230  CASE(equations_set_static_navier_stokes_subtype, &
231  & equations_set_static_rbs_navier_stokes_subtype, &
232  & equations_set_laplace_navier_stokes_subtype, &
233  & equations_set_transient_navier_stokes_subtype, &
234  & equations_set_transient1d_adv_navier_stokes_subtype, &
235  & equations_set_transient1d_navier_stokes_subtype, &
236  & equations_set_transient_rbs_navier_stokes_subtype, &
237  & equations_set_multiscale3d_navier_stokes_subtype, &
238  & equations_set_constitutive_mu_navier_stokes_subtype, &
239  & equations_set_coupled1d0d_adv_navier_stokes_subtype, &
240  & equations_set_coupled1d0d_navier_stokes_subtype, &
241  & equations_set_quasistatic_navier_stokes_subtype, &
242  & equations_set_ale_navier_stokes_subtype, &
243  & equations_set_pgm_navier_stokes_subtype)
244  !ok
245  CASE(equations_set_optimised_navier_stokes_subtype)
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
259  equationsset%specification(1:3)=[equations_set_fluid_mechanics_class,equations_set_navier_stokes_equation_type,subtype]
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,*)
278 
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))
318  CASE(equations_set_static_navier_stokes_subtype, &
319  & equations_set_static_rbs_navier_stokes_subtype, &
320  & equations_set_transient_navier_stokes_subtype, &
321  & equations_set_transient1d_navier_stokes_subtype, &
322  & equations_set_coupled1d0d_navier_stokes_subtype, &
323  & equations_set_transient1d_adv_navier_stokes_subtype, &
324  & equations_set_coupled1d0d_adv_navier_stokes_subtype, &
325  & equations_set_transient_rbs_navier_stokes_subtype, &
326  & equations_set_multiscale3d_navier_stokes_subtype, &
327  & equations_set_constitutive_mu_navier_stokes_subtype, &
328  & equations_set_quasistatic_navier_stokes_subtype, &
329  & equations_set_laplace_navier_stokes_subtype, &
330  & equations_set_ale_navier_stokes_subtype, &
331  & equations_set_pgm_navier_stokes_subtype)
332  SELECT CASE(equations_set_setup%SETUP_TYPE)
333  !-----------------------------------------------------------------
334  ! I n i t i a l s e t u p
335  !-----------------------------------------------------------------
336  CASE(equations_set_setup_initial_type)
337  SELECT CASE(equations_set%SPECIFICATION(3))
338  CASE(equations_set_static_navier_stokes_subtype,equations_set_laplace_navier_stokes_subtype, &
339  & equations_set_transient_navier_stokes_subtype,equations_set_ale_navier_stokes_subtype, &
340  & equations_set_pgm_navier_stokes_subtype,equations_set_quasistatic_navier_stokes_subtype)
341  SELECT CASE(equations_set_setup%ACTION_TYPE)
342  CASE(equations_set_setup_start_action)
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
346  CASE(equations_set_setup_finish_action)
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
354  CASE(equations_set_transient1d_navier_stokes_subtype, &
355  & equations_set_coupled1d0d_navier_stokes_subtype, &
356  & equations_set_transient1d_adv_navier_stokes_subtype, &
357  & equations_set_coupled1d0d_adv_navier_stokes_subtype)
358  SELECT CASE(equations_set_setup%ACTION_TYPE)
359  CASE(equations_set_setup_start_action)
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
385  CASE(equations_set_setup_finish_action)
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
398  CASE (equations_set_static_rbs_navier_stokes_subtype, &
399  & equations_set_transient_rbs_navier_stokes_subtype, &
400  & equations_set_multiscale3d_navier_stokes_subtype, &
401  & equations_set_constitutive_mu_navier_stokes_subtype)
402  SELECT CASE(equations_set_setup%ACTION_TYPE)
403  CASE(equations_set_setup_start_action)
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
447  CASE(equations_set_setup_finish_action)
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  !-----------------------------------------------------------------
497  CASE(equations_set_setup_geometry_type)
498  SELECT CASE(equations_set%SPECIFICATION(3))
499  CASE(equations_set_static_navier_stokes_subtype,equations_set_laplace_navier_stokes_subtype, &
500  & equations_set_transient_navier_stokes_subtype,equations_set_ale_navier_stokes_subtype, &
501  & equations_set_pgm_navier_stokes_subtype,equations_set_quasistatic_navier_stokes_subtype)
502  !Do nothing???
503  CASE(equations_set_transient1d_navier_stokes_subtype, &
504  & equations_set_coupled1d0d_navier_stokes_subtype, &
505  & equations_set_transient1d_adv_navier_stokes_subtype, &
506  & equations_set_coupled1d0d_adv_navier_stokes_subtype)
507  SELECT CASE(equations_set_setup%ACTION_TYPE)
508  CASE(equations_set_setup_start_action)
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
531  CASE(equations_set_setup_finish_action)
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
539  CASE (equations_set_static_rbs_navier_stokes_subtype, &
540  & equations_set_transient_rbs_navier_stokes_subtype, &
541  & equations_set_multiscale3d_navier_stokes_subtype, &
542  & equations_set_constitutive_mu_navier_stokes_subtype)
543  SELECT CASE(equations_set_setup%ACTION_TYPE)
544  CASE(equations_set_setup_start_action)
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
583  CASE(equations_set_setup_finish_action)
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  !-----------------------------------------------------------------
599  CASE(equations_set_setup_dependent_type)
600  SELECT CASE(equations_set%SPECIFICATION(3))
601  CASE(equations_set_static_navier_stokes_subtype,equations_set_laplace_navier_stokes_subtype, &
602  & equations_set_transient_navier_stokes_subtype,equations_set_ale_navier_stokes_subtype, &
603  & equations_set_pgm_navier_stokes_subtype,equations_set_quasistatic_navier_stokes_subtype, &
604  & equations_set_static_rbs_navier_stokes_subtype, &
605  & equations_set_transient_rbs_navier_stokes_subtype, &
606  & equations_set_multiscale3d_navier_stokes_subtype, &
607  & equations_set_constitutive_mu_navier_stokes_subtype)
608  SELECT CASE(equations_set_setup%ACTION_TYPE)
609  !Set start action
610  CASE(equations_set_setup_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)
658  CASE(equations_set_fem_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
669  CASE(equations_set_bem_solution_method)
670  CALL flagerror("Not implemented.",err,error,*999)
671  CASE(equations_set_fd_solution_method)
672  CALL flagerror("Not implemented.",err,error,*999)
673  CASE(equations_set_fv_solution_method)
674  CALL flagerror("Not implemented.",err,error,*999)
675  CASE(equations_set_gfem_solution_method)
676  CALL flagerror("Not implemented.",err,error,*999)
677  CASE(equations_set_gfv_solution_method)
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)
708  CASE(equations_set_fem_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
715  CASE(equations_set_bem_solution_method)
716  CALL flagerror("Not implemented.",err,error,*999)
717  CASE(equations_set_fd_solution_method)
718  CALL flagerror("Not implemented.",err,error,*999)
719  CASE(equations_set_fv_solution_method)
720  CALL flagerror("Not implemented.",err,error,*999)
721  CASE(equations_set_gfem_solution_method)
722  CALL flagerror("Not implemented.",err,error,*999)
723  CASE(equations_set_gfv_solution_method)
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
732  CASE(equations_set_setup_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
754  CASE(equations_set_transient1d_navier_stokes_subtype, &
755  equations_set_transient1d_adv_navier_stokes_subtype)
756  SELECT CASE(equations_set_setup%ACTION_TYPE)
757  !Set start action
758  CASE(equations_set_setup_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
843  CASE(equations_set_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)
858  CASE(equations_set_bem_solution_method)
859  CALL flagerror("Not implemented.",err,error,*999)
860  CASE(equations_set_fd_solution_method)
861  CALL flagerror("Not implemented.",err,error,*999)
862  CASE(equations_set_fv_solution_method)
863  CALL flagerror("Not implemented.",err,error,*999)
864  CASE(equations_set_gfem_solution_method)
865  CALL flagerror("Not implemented.",err,error,*999)
866  CASE(equations_set_gfv_solution_method)
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)
914  CASE(equations_set_fem_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)
925  CASE(equations_set_bem_solution_method)
926  CALL flagerror("Not implemented.",err,error,*999)
927  CASE(equations_set_fd_solution_method)
928  CALL flagerror("Not implemented.",err,error,*999)
929  CASE(equations_set_fv_solution_method)
930  CALL flagerror("Not implemented.",err,error,*999)
931  CASE(equations_set_gfem_solution_method)
932  CALL flagerror("Not implemented.",err,error,*999)
933  CASE(equations_set_gfv_solution_method)
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
942  CASE(equations_set_setup_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
952  CASE(equations_set_coupled1d0d_navier_stokes_subtype, &
953  & equations_set_coupled1d0d_adv_navier_stokes_subtype)
954  SELECT CASE(equations_set_setup%ACTION_TYPE)
955  !Set start action
956  CASE(equations_set_setup_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
1042  CASE(equations_set_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)
1059  CASE(equations_set_bem_solution_method)
1060  CALL flagerror("Not implemented.",err,error,*999)
1061  CASE(equations_set_fd_solution_method)
1062  CALL flagerror("Not implemented.",err,error,*999)
1063  CASE(equations_set_fv_solution_method)
1064  CALL flagerror("Not implemented.",err,error,*999)
1065  CASE(equations_set_gfem_solution_method)
1066  CALL flagerror("Not implemented.",err,error,*999)
1067  CASE(equations_set_gfv_solution_method)
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)
1115  CASE(equations_set_fem_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)
1126  CASE(equations_set_bem_solution_method)
1127  CALL flagerror("Not implemented.",err,error,*999)
1128  CASE(equations_set_fd_solution_method)
1129  CALL flagerror("Not implemented.",err,error,*999)
1130  CASE(equations_set_fv_solution_method)
1131  CALL flagerror("Not implemented.",err,error,*999)
1132  CASE(equations_set_gfem_solution_method)
1133  CALL flagerror("Not implemented.",err,error,*999)
1134  CASE(equations_set_gfv_solution_method)
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
1143  CASE(equations_set_setup_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  !-----------------------------------------------------------------
1162  CASE(equations_set_setup_independent_type)
1163  SELECT CASE(equations_set%SPECIFICATION(3))
1164  CASE(equations_set_ale_navier_stokes_subtype,equations_set_pgm_navier_stokes_subtype)
1165  SELECT CASE(equations_set_setup%ACTION_TYPE)
1166  !Set start action
1167  CASE(equations_set_setup_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
1208  CASE(equations_set_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)
1238  CASE(equations_set_fem_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
1250  CASE(equations_set_setup_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
1266  CASE(equations_set_transient1d_navier_stokes_subtype, &
1267  & equations_set_transient1d_adv_navier_stokes_subtype)
1268  SELECT CASE(equations_set_setup%ACTION_TYPE)
1269  !Set start action
1270  CASE(equations_set_setup_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
1318  CASE(equations_set_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)
1327  CASE(equations_set_nodal_solution_method)
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
1355  CASE(equations_set_setup_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
1365  CASE(equations_set_coupled1d0d_navier_stokes_subtype, &
1366  & equations_set_coupled1d0d_adv_navier_stokes_subtype)
1367  SELECT CASE(equations_set_setup%ACTION_TYPE)
1368  !Set start action
1369  CASE(equations_set_setup_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
1391  CASE(equations_set_setup_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
1401  CASE(equations_set_static_rbs_navier_stokes_subtype, &
1402  & equations_set_transient_rbs_navier_stokes_subtype, &
1403  & equations_set_multiscale3d_navier_stokes_subtype)
1404  SELECT CASE(equations_set_setup%ACTION_TYPE)
1405  !Set start action
1406  CASE(equations_set_setup_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
1447  CASE(equations_set_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)
1477  CASE(equations_set_fem_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
1489  CASE(equations_set_setup_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  !-----------------------------------------------------------------
1514  CASE(equations_set_setup_analytic_type)
1515  SELECT CASE(equations_set%SPECIFICATION(3))
1516  CASE(equations_set_static_navier_stokes_subtype, &
1517  & equations_set_laplace_navier_stokes_subtype, &
1518  & equations_set_transient_navier_stokes_subtype, &
1519  & equations_set_quasistatic_navier_stokes_subtype, &
1520  & equations_set_static_rbs_navier_stokes_subtype, &
1521  & equations_set_transient_rbs_navier_stokes_subtype, &
1522  & equations_set_multiscale3d_navier_stokes_subtype, &
1523  & equations_set_constitutive_mu_navier_stokes_subtype, &
1524  & equations_set_transient1d_navier_stokes_subtype, &
1525  & equations_set_coupled1d0d_navier_stokes_subtype, &
1526  & equations_set_transient1d_adv_navier_stokes_subtype, &
1527  & equations_set_coupled1d0d_adv_navier_stokes_subtype)
1528  SELECT CASE(equations_set_setup%ACTION_TYPE)
1529  !Set start action
1530  CASE(equations_set_setup_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)
1544  CASE(equations_set_navier_stokes_equation_two_dim_poiseuille)
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
1564  CASE(equations_set_navier_stokes_equation_flowrate_aorta, &
1565  & equations_set_navier_stokes_equation_flowrate_olufsen, &
1566  & equations_set_navier_stokes_equation_flowrate_heart, &
1567  & equations_set_navier_stokes_equation_splint_from_file)
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
1583  CASE(equations_set_navier_stokes_equation_sinusoid)
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
1597  CASE(equations_set_navier_stokes_equation_two_dim_taylor_green)
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
1617  CASE(equations_set_navier_stokes_equation_two_dim_1)
1618  !Set analtyic function type
1619  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_two_dim_1
1620  CASE(equations_set_navier_stokes_equation_two_dim_2)
1621  !Set analtyic function type
1622  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_two_dim_2
1623  CASE(equations_set_navier_stokes_equation_two_dim_3)
1624  !Set analtyic function type
1625  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_two_dim_3
1626  CASE(equations_set_navier_stokes_equation_two_dim_4)
1627  !Set analtyic function type
1628  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_two_dim_4
1629  CASE(equations_set_navier_stokes_equation_two_dim_5)
1630  !Set analtyic function type
1631  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_two_dim_5
1632  CASE(equations_set_navier_stokes_equation_three_dim_1)
1633  !Set analtyic function type
1634  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_three_dim_1
1635  CASE(equations_set_navier_stokes_equation_three_dim_2)
1636  !Set analtyic function type
1637  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_three_dim_2
1638  CASE(equations_set_navier_stokes_equation_three_dim_3)
1639  !Set analtyic function type
1640  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_three_dim_3
1641  CASE(equations_set_navier_stokes_equation_three_dim_4)
1642  !Set analtyic function type
1643  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_three_dim_4
1644  CASE(equations_set_navier_stokes_equation_three_dim_5)
1645  !Set analtyic function type
1646  equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE=equations_set_navier_stokes_equation_three_dim_5
1647  CASE(equations_set_navier_stokes_equation_one_dim_1)
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 == &
1691  & equations_set_navier_stokes_equation_sinusoid) THEN
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
1740  CASE(equations_set_setup_finish_action)
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))
1750  CASE(equations_set_static_navier_stokes_subtype, &
1751  & equations_set_static_rbs_navier_stokes_subtype)
1752  SELECT CASE(equations_analytic%ANALYTIC_FUNCTION_TYPE)
1753  CASE(equations_set_navier_stokes_equation_two_dim_poiseuille)
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
1769  CASE(equations_set_transient_navier_stokes_subtype, &
1770  & equations_set_transient_rbs_navier_stokes_subtype, &
1771  & equations_set_multiscale3d_navier_stokes_subtype, &
1772  & equations_set_constitutive_mu_navier_stokes_subtype)
1773  SELECT CASE(equations_analytic%ANALYTIC_FUNCTION_TYPE)
1774  CASE(equations_set_navier_stokes_equation_two_dim_taylor_green)
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)
1780  CASE(equations_set_navier_stokes_equation_sinusoid)
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
1793  CASE(equations_set_transient1d_navier_stokes_subtype, &
1794  & equations_set_coupled1d0d_navier_stokes_subtype, &
1795  & equations_set_transient1d_adv_navier_stokes_subtype, &
1796  & equations_set_coupled1d0d_adv_navier_stokes_subtype)
1797  SELECT CASE(equations_analytic%ANALYTIC_FUNCTION_TYPE)
1798  CASE(equations_set_navier_stokes_equation_flowrate_aorta, &
1799  & equations_set_navier_stokes_equation_flowrate_olufsen, &
1800  & equations_set_navier_stokes_equation_flowrate_heart, &
1801  & equations_set_navier_stokes_equation_splint_from_file)
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  !-----------------------------------------------------------------
1838  CASE(equations_set_setup_materials_type)
1839  SELECT CASE(equations_set%SPECIFICATION(3))
1840  CASE(equations_set_static_navier_stokes_subtype,equations_set_laplace_navier_stokes_subtype, &
1841  & equations_set_static_rbs_navier_stokes_subtype, &
1842  & equations_set_transient_navier_stokes_subtype,equations_set_ale_navier_stokes_subtype, &
1843  & equations_set_pgm_navier_stokes_subtype,equations_set_quasistatic_navier_stokes_subtype, &
1844  & equations_set_transient_rbs_navier_stokes_subtype, &
1845  & equations_set_multiscale3d_navier_stokes_subtype)
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
1850  CASE(equations_set_setup_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
1913  CASE(equations_set_setup_finish_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
1935  CASE(equations_set_constitutive_mu_navier_stokes_subtype)
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
1941  CASE(equations_set_setup_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
2032  CASE(equations_set_setup_finish_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
2058  CASE(equations_set_transient1d_navier_stokes_subtype, &
2059  & equations_set_transient1d_adv_navier_stokes_subtype, &
2060  & equations_set_coupled1d0d_navier_stokes_subtype, &
2061  & equations_set_coupled1d0d_adv_navier_stokes_subtype)
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
2068  CASE(equations_set_setup_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
2153  CASE(equations_set_setup_finish_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  !-----------------------------------------------------------------
2178  CASE(equations_set_setup_source_type)
2179  SELECT CASE(equations_set%SPECIFICATION(3))
2180  CASE(equations_set_static_navier_stokes_subtype,equations_set_laplace_navier_stokes_subtype, &
2181  & equations_set_static_rbs_navier_stokes_subtype, &
2182  & equations_set_transient_navier_stokes_subtype,equations_set_ale_navier_stokes_subtype, &
2183  & equations_set_pgm_navier_stokes_subtype,equations_set_quasistatic_navier_stokes_subtype, &
2184  & equations_set_transient1d_navier_stokes_subtype,equations_set_coupled1d0d_navier_stokes_subtype, &
2185  & equations_set_transient1d_adv_navier_stokes_subtype,equations_set_transient_rbs_navier_stokes_subtype, &
2186  & equations_set_coupled1d0d_adv_navier_stokes_subtype)
2187  !\todo: Think about gravity
2188  SELECT CASE(equations_set_setup%ACTION_TYPE)
2189  CASE(equations_set_setup_start_action)
2190  !Do nothing
2191  CASE(equations_set_setup_finish_action)
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  !-----------------------------------------------------------------
2209  CASE(equations_set_setup_equations_type)
2210  SELECT CASE(equations_set%SPECIFICATION(3))
2211  CASE(equations_set_static_navier_stokes_subtype, &
2212  & equations_set_static_rbs_navier_stokes_subtype, &
2213  & equations_set_laplace_navier_stokes_subtype)
2214  SELECT CASE(equations_set_setup%ACTION_TYPE)
2215  CASE(equations_set_setup_start_action)
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
2228  CASE(equations_set_setup_finish_action)
2229  SELECT CASE(equations_set%SOLUTION_METHOD)
2230  CASE(equations_set_fem_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
2245  CALL equationsmatrices_jacobiantypesset(equations_matrices,[equations_jacobian_analytic_calculated], &
2246  & err,error,*999)
2247  SELECT CASE(equations%SPARSITY_TYPE)
2248  CASE(equations_matrices_full_matrices)
2249  CALL equations_matrices_linear_storage_type_set(equations_matrices,[matrix_block_storage_type], &
2250  & err,error,*999)
2251  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices,matrix_block_storage_type, &
2252  & err,error,*999)
2253  CASE(equations_matrices_sparse_matrices)
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)
2268  CASE(equations_set_nodal_solution_method)
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
2283  CALL equationsmatrices_jacobiantypesset(equations_matrices,[equations_jacobian_analytic_calculated], &
2284  & err,error,*999)
2285  SELECT CASE(equations%SPARSITY_TYPE)
2286  CASE(equations_matrices_full_matrices)
2287  CALL equations_matrices_linear_storage_type_set(equations_matrices,[matrix_block_storage_type], &
2288  & err,error,*999)
2289  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices,matrix_block_storage_type, &
2290  & err,error,*999)
2291  CASE(equations_matrices_sparse_matrices)
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)
2306  CASE(equations_set_bem_solution_method)
2307  CALL flagerror("Not implemented.",err,error,*999)
2308  CASE(equations_set_fd_solution_method)
2309  CALL flagerror("Not implemented.",err,error,*999)
2310  CASE(equations_set_fv_solution_method)
2311  CALL flagerror("Not implemented.",err,error,*999)
2312  CASE(equations_set_gfem_solution_method)
2313  CALL flagerror("Not implemented.",err,error,*999)
2314  CASE(equations_set_gfv_solution_method)
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
2327  CASE(equations_set_transient_navier_stokes_subtype, &
2328  & equations_set_ale_navier_stokes_subtype, &
2329  & equations_set_pgm_navier_stokes_subtype, &
2330  & equations_set_transient_rbs_navier_stokes_subtype, &
2331  & equations_set_multiscale3d_navier_stokes_subtype, &
2332  & equations_set_constitutive_mu_navier_stokes_subtype, &
2333  & equations_set_transient1d_navier_stokes_subtype, &
2334  & equations_set_coupled1d0d_navier_stokes_subtype, &
2335  & equations_set_transient1d_adv_navier_stokes_subtype, &
2336  & equations_set_coupled1d0d_adv_navier_stokes_subtype)
2337 
2338  SELECT CASE(equations_set_setup%ACTION_TYPE)
2339  CASE(equations_set_setup_start_action)
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)
2345  CALL equations_time_dependence_type_set(equations,equations_first_order_dynamic,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
2352  CASE(equations_set_setup_finish_action)
2353  SELECT CASE(equations_set%SOLUTION_METHOD)
2354  CASE(equations_set_fem_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
2370  CALL equationsmatrices_jacobiantypesset(equations_matrices,[equations_jacobian_analytic_calculated], &
2371  & err,error,*999)
2372  SELECT CASE(equations%SPARSITY_TYPE)
2373  CASE(equations_matrices_full_matrices)
2374  CALL equations_matrices_dynamic_storage_type_set(equations_matrices,[matrix_block_storage_type, &
2375  & matrix_block_storage_type],err,error,*999)
2376  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices,matrix_block_storage_type, &
2377  & err,error,*999)
2378  CASE(equations_matrices_sparse_matrices)
2379  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
2380  & [distributed_matrix_compressed_row_storage_type, &
2381  & distributed_matrix_compressed_row_storage_type],err,error,*999)
2382  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
2383  & [equations_matrix_fem_structure,equations_matrix_fem_structure],err,error,*999)
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)
2394  CASE(equations_set_bem_solution_method)
2395  CALL flagerror("Not implemented.",err,error,*999)
2396  CASE(equations_set_fd_solution_method)
2397  CALL flagerror("Not implemented.",err,error,*999)
2398  CASE(equations_set_fv_solution_method)
2399  CALL flagerror("Not implemented.",err,error,*999)
2400  CASE(equations_set_gfem_solution_method)
2401  CALL flagerror("Not implemented.",err,error,*999)
2402  CASE(equations_set_gfv_solution_method)
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
2415  CASE(equations_set_quasistatic_navier_stokes_subtype)
2416  SELECT CASE(equations_set_setup%ACTION_TYPE)
2417  CASE(equations_set_setup_start_action)
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
2430  CASE(equations_set_setup_finish_action)
2431  SELECT CASE(equations_set%SOLUTION_METHOD)
2432  CASE(equations_set_fem_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
2447  CALL equationsmatrices_jacobiantypesset(equations_matrices,[equations_jacobian_analytic_calculated], &
2448  & err,error,*999)
2449  SELECT CASE(equations%SPARSITY_TYPE)
2450  CASE(equations_matrices_full_matrices)
2451  CALL equations_matrices_linear_storage_type_set(equations_matrices,[matrix_block_storage_type], &
2452  & err,error,*999)
2453  CALL equationsmatrices_nonlinearstoragetypeset(equations_matrices,matrix_block_storage_type, &
2454  & err,error,*999)
2455  CASE(equations_matrices_sparse_matrices)
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)
2470  CASE(equations_set_bem_solution_method)
2471  CALL flagerror("Not implemented.",err,error,*999)
2472  CASE(equations_set_fd_solution_method)
2473  CALL flagerror("Not implemented.",err,error,*999)
2474  CASE(equations_set_fv_solution_method)
2475  CALL flagerror("Not implemented.",err,error,*999)
2476  CASE(equations_set_gfem_solution_method)
2477  CALL flagerror("Not implemented.",err,error,*999)
2478  CASE(equations_set_gfv_solution_method)
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,*)
2524 
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))
2563  CASE(problem_fluid_mechanics_class)
2564  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
2565  CASE(problem_static_navier_stokes_subtype,problem_laplace_navier_stokes_subtype)
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
2587  CASE(problem_transient_navier_stokes_subtype)
2588  !Update transient boundary conditions and any analytic values
2589  CALL navierstokes_presolveupdateboundaryconditions(solver,err,error,*999)
2590  CASE(problem_transient_rbs_navier_stokes_subtype)
2591  !Update transient boundary conditions
2592  CALL navierstokes_presolveupdateboundaryconditions(solver,err,error,*999)
2593  CASE(problem_multiscale_navier_stokes_subtype)
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 
2609  CASE(problem_transient1d_navier_stokes_subtype, &
2610  & problem_coupled1d0d_navier_stokes_subtype, &
2611  & problem_stree1d0d_navier_stokes_subtype, &
2612  & problem_transient1d_adv_navier_stokes_subtype, &
2613  & problem_coupled1d0d_adv_navier_stokes_subtype, &
2614  & problem_stree1d0d_adv_navier_stokes_subtype)
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 
2719  CASE(problem_quasistatic_navier_stokes_subtype)
2720  ! do nothing ???
2721  CALL navierstokes_presolveupdateboundaryconditions(solver,err,error,*999)
2722  CASE(problem_pgm_navier_stokes_subtype)
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)
2728  CASE(problem_ale_navier_stokes_subtype)
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
2761  CASE(problem_multi_physics_class)
2762  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(2))
2763  CASE(problem_finite_elasticity_navier_stokes_type)
2764  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
2765  CASE(problem_finite_elasticity_navier_stokes_ale_subtype)
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,*)
2831 
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)
2847  CASE(problem_static_navier_stokes_subtype, &
2848  & problem_laplace_navier_stokes_subtype, &
2849  & problem_transient_navier_stokes_subtype, &
2850  & problem_transient1d_navier_stokes_subtype, &
2851  & problem_transient1d_adv_navier_stokes_subtype, &
2852  & problem_coupled1d0d_navier_stokes_subtype, &
2853  & problem_coupled1d0d_adv_navier_stokes_subtype, &
2854  & problem_stree1d0d_navier_stokes_subtype, &
2855  & problem_stree1d0d_adv_navier_stokes_subtype, &
2856  & problem_transient_rbs_navier_stokes_subtype, &
2857  & problem_multiscale_navier_stokes_subtype, &
2858  & problem_quasistatic_navier_stokes_subtype, &
2859  & problem_ale_navier_stokes_subtype, &
2860  & problem_pgm_navier_stokes_subtype)
2861  !All ok
2862  CASE(problem_optimised_navier_stokes_subtype)
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,*)
2897 
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
2934  CASE(problem_static_navier_stokes_subtype, &
2935  & problem_laplace_navier_stokes_subtype)
2936  SELECT CASE(problem_setup%SETUP_TYPE)
2937  CASE(problem_setup_initial_type)
2938  SELECT CASE(problem_setup%ACTION_TYPE)
2939  CASE(problem_setup_start_action)
2940  !Do nothing????
2941  CASE(problem_setup_finish_action)
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
2949  CASE(problem_setup_control_type)
2950  SELECT CASE(problem_setup%ACTION_TYPE)
2951  CASE(problem_setup_start_action)
2952  !Set up a simple control loop
2953  CALL control_loop_create_start(problem,control_loop,err,error,*999)
2954  CASE(problem_setup_finish_action)
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
2965  CASE(problem_setup_solvers_type)
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)
2970  CASE(problem_setup_start_action)
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)
2979  CASE(problem_setup_finish_action)
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
2990  CASE(problem_setup_solver_equations_type)
2991  SELECT CASE(problem_setup%ACTION_TYPE)
2992  CASE(problem_setup_start_action)
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)
3004  CASE(problem_setup_finish_action)
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
3026  CASE(problem_transient_navier_stokes_subtype, &
3027  & problem_pgm_navier_stokes_subtype, &
3028  & problem_transient_rbs_navier_stokes_subtype, &
3029  & problem_multiscale_navier_stokes_subtype)
3030  SELECT CASE(problem_setup%SETUP_TYPE)
3031  CASE(problem_setup_initial_type)
3032  SELECT CASE(problem_setup%ACTION_TYPE)
3033  CASE(problem_setup_start_action)
3034  !Do nothing????
3035  CASE(problem_setup_finish_action)
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
3043  CASE(problem_setup_control_type)
3044  SELECT CASE(problem_setup%ACTION_TYPE)
3045  CASE(problem_setup_start_action)
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)
3049  CASE(problem_setup_finish_action)
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
3060  CASE(problem_setup_solvers_type)
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)
3065  CASE(problem_setup_start_action)
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)
3072  CALL solver_dynamic_linearity_type_set(solver,solver_dynamic_nonlinear,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)
3076  CALL solver_dynamic_scheme_set(solver,solver_dynamic_crank_nicolson_scheme,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
3085  CASE(problem_setup_finish_action)
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
3096  CASE(problem_setup_solver_equations_type)
3097  SELECT CASE(problem_setup%ACTION_TYPE)
3098  CASE(problem_setup_start_action)
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)
3108  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_first_order_dynamic,&
3109  & err,error,*999)
3110  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3111  CASE(problem_setup_finish_action)
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
3127  CASE(problem_setup_cellml_equations_type)
3128  SELECT CASE(problem_setup%ACTION_TYPE)
3129  CASE(problem_setup_start_action)
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)
3141  CASE(problem_setup_finish_action)
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)
3173  CASE(problem_setup_initial_type)
3174  SELECT CASE(problem_setup%ACTION_TYPE)
3175  CASE(problem_setup_start_action)
3176  !Do nothing
3177  CASE(problem_setup_finish_action)
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
3185  CASE(problem_setup_control_type)
3186  SELECT CASE(problem_setup%ACTION_TYPE)
3187  CASE(problem_setup_start_action)
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
3319  CASE(problem_setup_finish_action)
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
3330  CASE(problem_setup_solvers_type)
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)
3336  CASE(problem_setup_start_action)
3337  SELECT CASE(problem%specification(3))
3338  CASE(problem_transient1d_navier_stokes_subtype)
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)
3356  CALL solver_dynamic_linearity_type_set(solver,solver_dynamic_nonlinear,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)
3360  CASE(problem_transient1d_adv_navier_stokes_subtype)
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)
3379  CALL solver_dynamic_linearity_type_set(solver,solver_dynamic_nonlinear,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)
3399  CASE(problem_coupled1d0d_adv_navier_stokes_subtype)
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)
3436  CALL solver_dynamic_linearity_type_set(solver,solver_dynamic_nonlinear,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)
3457  CASE(problem_stree1d0d_adv_navier_stokes_subtype)
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)
3493  CALL solver_dynamic_linearity_type_set(solver,solver_dynamic_nonlinear,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)
3513  CASE(problem_coupled1d0d_navier_stokes_subtype)
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)
3550  CALL solver_dynamic_linearity_type_set(solver,solver_dynamic_nonlinear,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)
3554  CASE(problem_stree1d0d_navier_stokes_subtype)
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)
3592  CALL solver_dynamic_linearity_type_set(solver,solver_dynamic_nonlinear,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
3601  CASE(problem_setup_finish_action)
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
3689  CASE(problem_setup_solver_equations_type)
3690  SELECT CASE(problem_setup%ACTION_TYPE)
3691  CASE(problem_setup_start_action)
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))
3699  CASE(problem_transient1d_navier_stokes_subtype)
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)
3717  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_first_order_dynamic,err,error,*999)
3718  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3719  CASE(problem_transient1d_adv_navier_stokes_subtype)
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)
3738  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_first_order_dynamic,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)
3752  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_first_order_dynamic,err,error,*999)
3753  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3754  CASE(problem_coupled1d0d_adv_navier_stokes_subtype)
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)
3776  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_first_order_dynamic,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)
3790  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_first_order_dynamic,err,error,*999)
3791  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3792  CASE(problem_coupled1d0d_navier_stokes_subtype)
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)
3814  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_first_order_dynamic,err,error,*999)
3815  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3816  CASE(problem_stree1d0d_adv_navier_stokes_subtype)
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)
3851  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_first_order_dynamic,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)
3865  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_first_order_dynamic,err,error,*999)
3866  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3867  CASE(problem_stree1d0d_navier_stokes_subtype)
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)
3903  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_first_order_dynamic,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
3910  CASE(problem_setup_finish_action)
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))
3918  CASE(problem_transient1d_navier_stokes_subtype)
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)
3934  CASE(problem_transient1d_adv_navier_stokes_subtype)
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)
3962  CASE(problem_coupled1d0d_adv_navier_stokes_subtype)
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)
3994  CASE(problem_coupled1d0d_navier_stokes_subtype)
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)
4014  CASE(problem_stree1d0d_adv_navier_stokes_subtype)
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)
4057  CASE(problem_stree1d0d_navier_stokes_subtype)
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
4101  CASE(problem_setup_cellml_equations_type)
4102  SELECT CASE(problem_setup%ACTION_TYPE)
4103  CASE(problem_setup_start_action)
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))
4121  CASE(problem_coupled1d0d_navier_stokes_subtype, &
4122  & problem_coupled1d0d_adv_navier_stokes_subtype)
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
4130  CASE(problem_setup_finish_action)
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))
4146  CASE(problem_coupled1d0d_navier_stokes_subtype, &
4147  & problem_coupled1d0d_adv_navier_stokes_subtype)
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
4168  CASE(problem_quasistatic_navier_stokes_subtype)
4169  !Quasi-static Navier-Stokes
4170  SELECT CASE(problem_setup%SETUP_TYPE)
4171  CASE(problem_setup_initial_type)
4172  SELECT CASE(problem_setup%ACTION_TYPE)
4173  CASE(problem_setup_start_action)
4174  !Do nothing????
4175  CASE(problem_setup_finish_action)
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
4183  CASE(problem_setup_control_type)
4184  SELECT CASE(problem_setup%ACTION_TYPE)
4185  CASE(problem_setup_start_action)
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)
4189  CASE(problem_setup_finish_action)
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
4200  CASE(problem_setup_solvers_type)
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)
4205  CASE(problem_setup_start_action)
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)
4214  CASE(problem_setup_finish_action)
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
4225  CASE(problem_setup_solver_equations_type)
4226  SELECT CASE(problem_setup%ACTION_TYPE)
4227  CASE(problem_setup_start_action)
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)
4239  CASE(problem_setup_finish_action)
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
4261  CASE(problem_ale_navier_stokes_subtype)
4262  SELECT CASE(problem_setup%SETUP_TYPE)
4263  CASE(problem_setup_initial_type)
4264  SELECT CASE(problem_setup%ACTION_TYPE)
4265  CASE(problem_setup_start_action)
4266  !Do nothing????
4267  CASE(problem_setup_finish_action)
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
4275  CASE(problem_setup_control_type)
4276  SELECT CASE(problem_setup%ACTION_TYPE)
4277  CASE(problem_setup_start_action)
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)
4281  CASE(problem_setup_finish_action)
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
4292  CASE(problem_setup_solvers_type)
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)
4297  CASE(problem_setup_start_action)
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)
4309  CALL solver_dynamic_linearity_type_set(solver,solver_dynamic_nonlinear,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)
4313  CALL solver_dynamic_scheme_set(solver,solver_dynamic_crank_nicolson_scheme,err,error,*999)
4314  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
4315  CASE(problem_setup_finish_action)
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
4326  CASE(problem_setup_solver_equations_type)
4327  SELECT CASE(problem_setup%ACTION_TYPE)
4328  CASE(problem_setup_start_action)
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)
4344  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_first_order_dynamic,&
4345  & err,error,*999)
4346  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
4347  CASE(problem_setup_finish_action)
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,*)
4395 
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))
4468  CASE(equations_set_static_navier_stokes_subtype,equations_set_laplace_navier_stokes_subtype, &
4469  & equations_set_static_rbs_navier_stokes_subtype, &
4470  & equations_set_transient_navier_stokes_subtype,equations_set_ale_navier_stokes_subtype, &
4471  & equations_set_pgm_navier_stokes_subtype,equations_set_quasistatic_navier_stokes_subtype, &
4472  & equations_set_transient1d_navier_stokes_subtype,equations_set_coupled1d0d_navier_stokes_subtype, &
4473  & equations_set_transient1d_adv_navier_stokes_subtype,equations_set_transient_rbs_navier_stokes_subtype, &
4474  & equations_set_multiscale3d_navier_stokes_subtype,equations_set_coupled1d0d_adv_navier_stokes_subtype, &
4475  & equations_set_constitutive_mu_navier_stokes_subtype)
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))
4490  CASE(equations_set_static_navier_stokes_subtype,equations_set_laplace_navier_stokes_subtype, &
4491  & equations_set_quasistatic_navier_stokes_subtype)
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
4504  CASE(equations_set_static_rbs_navier_stokes_subtype)
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
4517  CASE(equations_set_transient_navier_stokes_subtype)
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
4533  CASE(equations_set_transient1d_navier_stokes_subtype,equations_set_coupled1d0d_navier_stokes_subtype, &
4534  & equations_set_transient1d_adv_navier_stokes_subtype,equations_set_coupled1d0d_adv_navier_stokes_subtype)
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)
4552  CASE(equations_set_transient_rbs_navier_stokes_subtype)
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
4568  CASE(equations_set_multiscale3d_navier_stokes_subtype, &
4569  & equations_set_constitutive_mu_navier_stokes_subtype)
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
4587  CASE(equations_set_ale_navier_stokes_subtype,equations_set_pgm_navier_stokes_subtype)
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)
4619  CALL field_parameter_set_get_constant(materials_field,field_u_variable_type,field_values_set_type,2, &
4620  & rho_param,err,error,*999)
4621  !Loop over Gauss points
4622  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
4623  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
4624  & dependent_interp_point(field_u_variable_type)%PTR,err,error,*999)
4625  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
4626  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
4627  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
4628  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
4629  IF(equations_set%specification(3)==equations_set_ale_navier_stokes_subtype.OR. &
4630  & equations_set%specification(3)==equations_set_pgm_navier_stokes_subtype) THEN
4631  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
4632  & independent_interp_point(field_u_variable_type)%PTR,err,error,*999)
4633  w_value(1)=equations%INTERPOLATION%INDEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,no_part_deriv)
4634  w_value(2)=equations%INTERPOLATION%INDEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,no_part_deriv)
4635  IF(field_variable%NUMBER_OF_COMPONENTS==4) THEN
4636  w_value(3)=equations%INTERPOLATION%INDEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,no_part_deriv)
4637  END IF
4638  ELSE
4639  w_value=0.0_dp
4640  END IF
4641 
4642  ! Get the constitutive law (non-Newtonian) viscosity based on shear rate
4643  IF(equations_set%specification(3)==equations_set_constitutive_mu_navier_stokes_subtype) THEN
4644  ! Note the constant from the U_VARIABLE is a scale factor
4645  muscale = mu_param
4646  ! Get the gauss point based value returned from the CellML solver
4647  CALL field_parametersetgetlocalgausspoint(materials_field,field_v_variable_type,field_values_set_type, &
4648  & ng,element_number,1,mu_param,err,error,*999)
4649  mu_param=mu_param*muscale
4650  END IF
4651 
4652  !Start with matrix calculations
4653  IF(equations_set%specification(3)==equations_set_static_navier_stokes_subtype.OR. &
4654  & equations_set%specification(3)==equations_set_laplace_navier_stokes_subtype.OR. &
4655  & equations_set%specification(3)==equations_set_static_rbs_navier_stokes_subtype.OR. &
4656  & equations_set%specification(3)==equations_set_transient_navier_stokes_subtype.OR. &
4657  & equations_set%specification(3)==equations_set_transient_rbs_navier_stokes_subtype.OR. &
4658  & equations_set%specification(3)==equations_set_multiscale3d_navier_stokes_subtype.OR. &
4659  & equations_set%specification(3)==equations_set_constitutive_mu_navier_stokes_subtype.OR. &
4660  & equations_set%specification(3)==equations_set_quasistatic_navier_stokes_subtype.OR. &
4661  & equations_set%specification(3)==equations_set_ale_navier_stokes_subtype.OR. &
4662  & equations_set%specification(3)==equations_set_pgm_navier_stokes_subtype) THEN
4663  !Loop over field components
4664  mhs=0
4665  DO mh=1,field_variable%NUMBER_OF_COMPONENTS-1
4666  mesh_component1=field_variable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
4667  dependent_basis1=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component1)%PTR% &
4668  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
4669  quadrature_scheme1=>dependent_basis1%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
4670  jgw=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
4671  & quadrature_scheme1%GAUSS_WEIGHTS(ng)
4672 
4673  DO ms=1,dependent_basis1%NUMBER_OF_ELEMENT_PARAMETERS
4674  mhs=mhs+1
4675  nhs=0
4676  IF(update_stiffness_matrix.OR.update_damping_matrix) THEN
4677  !Loop over element columns
4678  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
4679  mesh_component2=field_variable%COMPONENTS(nh)%MESH_COMPONENT_NUMBER
4680  dependent_basis2=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component2)%PTR% &
4681  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
4682  quadrature_scheme2=>dependent_basis2%QUADRATURE%QUADRATURE_SCHEME_MAP&
4683  &(basis_default_quadrature_scheme)%PTR
4684  ! JGW=EQUATIONS%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS%JACOBIAN*QUADRATURE_SCHEME2%&
4685  ! &GAUSS_WEIGHTS(ng)
4686  DO ns=1,dependent_basis2%NUMBER_OF_ELEMENT_PARAMETERS
4687  nhs=nhs+1
4688  !Calculate some general values
4689  DO ni=1,dependent_basis2%NUMBER_OF_XI
4690  DO mi=1,dependent_basis1%NUMBER_OF_XI
4691  dxi_dx(mi,ni)=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR% &
4692  & dxi_dx(mi,ni)
4693  END DO
4694  dphims_dxi(ni)=quadrature_scheme1%GAUSS_BASIS_FNS(ms,partial_derivative_first_derivative_map(ni),ng)
4695  dphins_dxi(ni)=quadrature_scheme2%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(ni),ng)
4696  END DO !ni
4697  phims=quadrature_scheme1%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
4698  phins=quadrature_scheme2%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)
4699  !Laplace only matrix
4700  IF(update_stiffness_matrix) THEN
4701  !LAPLACE TYPE
4702  IF(nh==mh) THEN
4703  sum=0.0_dp
4704  !Calculate SUM
4705  DO xv=1,dependent_basis1%NUMBER_OF_XI
4706  DO mi=1,dependent_basis1%NUMBER_OF_XI
4707  DO ni=1,dependent_basis2%NUMBER_OF_XI
4708  sum=sum+mu_param*dphins_dxi(ni)*dxi_dx(ni,xv)*dphims_dxi(mi)*dxi_dx(mi,xv)
4709  END DO !ni
4710  END DO !mi
4711  END DO !x
4712  !Calculate MATRIX
4713  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*jgw
4714  END IF
4715  END IF
4716  !General matrix
4717  IF(update_stiffness_matrix) THEN
4718  !GRADIENT TRANSPOSE TYPE
4719  IF(equations_set%SPECIFICATION(3)/=equations_set_laplace_navier_stokes_subtype) THEN
4720  IF(nh<field_variable%NUMBER_OF_COMPONENTS) THEN
4721  sum=0.0_dp
4722  !Calculate SUM
4723  DO mi=1,dependent_basis1%NUMBER_OF_XI
4724  DO ni=1,dependent_basis2%NUMBER_OF_XI
4725  !note mh/nh derivative in DXI_DX
4726  sum=sum+mu_param*dphins_dxi(mi)*dxi_dx(mi,mh)*dphims_dxi(ni)*dxi_dx(ni,nh)
4727  END DO !ni
4728  END DO !mi
4729  !Calculate MATRIX
4730  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs) &
4731  & +sum*jgw
4732  END IF
4733  END IF
4734  END IF
4735  !Contribution through ALE
4736  IF(update_stiffness_matrix) THEN
4737  !GRADIENT TRANSPOSE TYPE
4738  IF(equations_set%SPECIFICATION(3)==equations_set_ale_navier_stokes_subtype.OR. &
4739  & equations_set%SPECIFICATION(3)==equations_set_pgm_navier_stokes_subtype) THEN
4740  IF(nh==mh) THEN
4741  sum=0.0_dp
4742  !Calculate SUM
4743  DO mi=1,dependent_basis1%NUMBER_OF_XI
4744  DO ni=1,dependent_basis1%NUMBER_OF_XI
4745  sum=sum-rho_param*w_value(mi)*dphins_dxi(ni)*dxi_dx(ni,mi)*phims
4746  END DO !ni
4747  END DO !mi
4748  !Calculate MATRIX
4749  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+ &
4750  & sum*jgw
4751  END IF
4752  END IF
4753  END IF
4754  !Pressure contribution (B transpose)
4755  IF(update_stiffness_matrix) THEN
4756  !LAPLACE TYPE
4757  IF(nh==field_variable%NUMBER_OF_COMPONENTS) THEN
4758  sum=0.0_dp
4759  !Calculate SUM
4760  DO ni=1,dependent_basis1%NUMBER_OF_XI
4761  sum=sum-phins*dphims_dxi(ni)*dxi_dx(ni,mh)
4762  END DO !ni
4763  !Calculate MATRIX
4764  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*jgw
4765  END IF
4766  END IF
4767  !Damping matrix
4768  IF(equations_set%specification(3)==equations_set_transient_navier_stokes_subtype.OR. &
4769  & equations_set%specification(3)==equations_set_ale_navier_stokes_subtype.OR. &
4770  & equations_set%specification(3)==equations_set_pgm_navier_stokes_subtype.OR. &
4771  & equations_set%specification(3)==equations_set_transient_rbs_navier_stokes_subtype.OR. &
4772  & equations_set%specification(3)==equations_set_multiscale3d_navier_stokes_subtype .OR. &
4773  & equations_set%specification(3)==equations_set_constitutive_mu_navier_stokes_subtype) THEN
4774  IF(update_damping_matrix) THEN
4775  IF(nh==mh) THEN
4776  sum=0.0_dp
4777  !Calculate SUM
4778  sum=phims*phins*rho_param
4779  !Calculate MATRIX
4780  damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*jgw
4781  END IF
4782  END IF
4783  END IF
4784  END DO !ns
4785  END DO !nh
4786  END IF
4787  END DO !ms
4788  END DO !mh
4789  !Analytic RHS vector
4790  IF(rhs_vector%FIRST_ASSEMBLY) THEN
4791  IF(update_rhs_vector) THEN
4792  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
4793  IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_two_dim_1.OR. &
4794  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_two_dim_2.OR. &
4795  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_two_dim_3.OR. &
4796  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_two_dim_4.OR. &
4797  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_two_dim_5.OR. &
4798  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_one_dim_1.OR. &
4799  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_three_dim_1.OR. &
4800  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_three_dim_2.OR. &
4801  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_three_dim_3.OR. &
4802  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_three_dim_4.OR. &
4803  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_three_dim_5) THEN
4804  mhs=0
4805  DO mh=1,field_variable%NUMBER_OF_COMPONENTS-1
4806  mesh_component1=field_variable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
4807  dependent_basis1=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component1)%PTR% &
4808  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
4809  quadrature_scheme1=>dependent_basis1%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
4810  jgw=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
4811  & quadrature_scheme1%GAUSS_WEIGHTS(ng)
4812 
4813  DO ms=1,dependent_basis1%NUMBER_OF_ELEMENT_PARAMETERS
4814  mhs=mhs+1
4815  phims=quadrature_scheme1%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
4816  !note mh value derivative
4817  sum=0.0_dp
4818  x(1) = equations%INTERPOLATION%GEOMETRIC_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,1)
4819  x(2) = equations%INTERPOLATION%GEOMETRIC_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,1)
4820  IF(dependent_basis1%NUMBER_OF_XI==3) THEN
4821  x(3) = equations%INTERPOLATION%GEOMETRIC_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,1)
4822  END IF
4823  IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_two_dim_1) THEN
4824  IF(mh==1) THEN
4825  !Calculate SUM
4826  sum=0.0_dp
4827  ELSE IF(mh==2) THEN
4828  !Calculate SUM
4829  sum=phims*(-2.0_dp/3.0_dp*(x(1)**3*rho_param+3.0_dp*mu_param*10.0_dp**2- &
4830  & 3.0_dp*rho_param*x(2)**2*x(1))/(10.0_dp**4))
4831  END IF
4832  ELSE IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_two_dim_2) &
4833  & THEN
4834  IF(mh==1) THEN
4835  !Calculate SUM
4836  sum=0.0_dp
4837  ELSE IF(mh==2) THEN
4838  !Calculate SUM
4839  sum=phims*(-4.0_dp*mu_param/10.0_dp/10.0_dp*exp((x(1)-x(2))/10.0_dp))
4840  END IF
4841  ELSE IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_two_dim_3) &
4842  & THEN
4843  IF(mh==1) THEN
4844  !Calculate SUM
4845  sum=0.0_dp
4846  ELSE IF(mh==2) THEN
4847  !Calculate SUM
4848  sum=phims*(16.0_dp*mu_param*pi**2/10.0_dp**2*cos(2.0_dp*pi*x(2)/10.0_dp)* &
4849  & cos(2.0_dp*pi*x(1)/10.0_dp)- &
4850  & 2.0_dp*cos(2.0_dp*pi*x(2)/10.0_dp)*sin(2.0_dp*pi*x(2)/10.0_dp)*rho_param*pi/10.0_dp)
4851  END IF
4852  ELSE IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_two_dim_4) &
4853  & THEN
4854  IF(mh==1) THEN
4855  !Calculate SUM
4856  sum=phims*(2.0_dp*sin(x(1))*cos(x(2)))*mu_param
4857  ELSE IF(mh==2) THEN
4858  !Calculate SUM
4859  sum=phims*(-2.0_dp*cos(x(1))*sin(x(2)))*mu_param
4860  END IF
4861  ELSE IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_two_dim_5) &
4862  & THEN
4863  !do nothing
4864  ELSE IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE== &
4865  & equations_set_navier_stokes_equation_three_dim_1) THEN
4866  IF(mh==1) THEN
4867  !Calculate SUM
4868  sum=0.0_dp
4869  ELSE IF(mh==2) THEN
4870  !Calculate SUM
4871  sum=phims*(-2.0_dp/3.0_dp*(rho_param*x(1)**3+6.0_dp*rho_param*x(1)*x(3)*x(2)+ &
4872  & 6.0_dp*mu_param*10.0_dp**2- &
4873  & 3.0_dp*rho_param*x(2)**2*x(1)-3.0_dp*rho_param*x(3)*x(1)**2-3.0_dp*rho_param*x(3)*x(2)**2)/ &
4874  & (10.0_dp**4))
4875  ELSE IF(mh==3) THEN
4876  !Calculate SUM
4877  sum=phims*(-2.0_dp/3.0_dp*(6.0_dp*rho_param*x(1)*x(3)*x(2)+rho_param*x(1)**3+ &
4878  & 6.0_dp*mu_param*10.0_dp**2- &
4879  & 3.0_dp*rho_param*x(1)*x(3)**2-3.0_dp*rho_param*x(2)*x(1)**2-3.0_dp*rho_param*x(2)*x(3)**2)/ &
4880  & (10.0_dp**4))
4881  END IF
4882  ELSE IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE== &
4883  & equations_set_navier_stokes_equation_three_dim_2) THEN
4884  IF(mh==1) THEN
4885  !Calculate SUM
4886  sum=0.0_dp
4887  ELSE IF(mh==2) THEN
4888  !Calculate SUM
4889  sum=phims*((-4.0_dp*mu_param*exp((x(1)-x(2))/10.0_dp)-2.0_dp*mu_param*exp((x(2)-x(3))/10.0_dp)+ &
4890  & rho_param*exp((x(3)-x(2))/10.0_dp)*10.0_dp)/10.0_dp**2)
4891  ELSE IF(mh==3) THEN
4892  !Calculate SUM
4893  sum=phims*(-(4.0_dp*mu_param*exp((x(3)-x(1))/10.0_dp)+2.0_dp*mu_param*exp((x(2)-x(3))/10.0_dp)+ &
4894  & rho_param*exp((x(3)-x(2))/10.0_dp)*10.0_dp)/10.0_dp** 2)
4895  END IF
4896  ELSE IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE== &
4897  & equations_set_navier_stokes_equation_three_dim_3) THEN
4898  IF(mh==1) THEN
4899  !Calculate SUM
4900  sum=0.0_dp
4901  ELSE IF(mh==2) THEN
4902  !Calculate SUM
4903  sum=phims*(2.0_dp*cos(2.0_dp*pi*x(2)/10.0_dp)*(18.0_dp*cos(2.0_dp*pi*x(1)/10.0_dp)* &
4904  & mu_param*pi*sin(2.0_dp*pi*x(3)/10.0_dp)-3.0_dp*rho_param*cos(2.0_dp*pi*x(1)/10.0_dp)**2* &
4905  & sin(2.0_dp*pi*x(2)/10.0_dp)*10.0_dp-2.0_dp*rho_param*sin(2.0_dp*pi*x(2)/10.0_dp)*10.0_dp+ &
4906  & 2.0_dp*rho_param*sin(2.0_dp*pi*x(2)/10.0_dp)*10.0_dp*cos(2.0_dp*pi*x(3)/10.0_dp)**2)*pi/ &
4907  & 10.0_dp**2)
4908  ELSE IF(mh==3) THEN
4909  !Calculate SUM
4910  sum=phims*(-2.0_dp*pi*cos(2.0_dp*pi*x(3)/10.0_dp)*rho_param*sin(2.0_dp*pi*x(3)/10.0_dp)* &
4911  & (-1.0_dp+cos(2.0_dp*pi*x(2)/10.0_dp)**2)/10.0_dp)
4912  END IF
4913  ELSE IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE== &
4914  & equations_set_navier_stokes_equation_three_dim_4) THEN
4915  IF(mh==1) THEN
4916  !Calculate SUM
4917  !SUM=PHIMS*(2.0_DP*SIN(X(1))*COS(X(2)))*MU_PARAM
4918  ELSE IF(mh==2) THEN
4919  !Calculate SUM
4920  !SUM=PHIMS*(-2.0_DP*COS(X(1))*SIN(X(2)))*MU_PARAM
4921  END IF
4922  ELSE IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE== &
4923  & equations_set_navier_stokes_equation_three_dim_5) THEN
4924  !do nothing
4925  END IF
4926  !Calculate RH VECTOR
4927  rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)+sum*jgw
4928  END DO !ms
4929  END DO !mh
4930  ELSE
4931  rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=0.0_dp
4932  END IF
4933  END IF
4934  END IF
4935  END IF
4936 
4937  !Calculate nonlinear vector
4938  IF(update_nonlinear_residual) THEN
4939  ! Get interpolated velocity and velocity gradient values for nonlinear term
4940  u_value(1)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(1,no_part_deriv)
4941  u_value(2)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(2,no_part_deriv)
4942  u_deriv(1,1)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(1,part_deriv_s1)
4943  u_deriv(1,2)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(1,part_deriv_s2)
4944  u_deriv(2,1)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(2,part_deriv_s1)
4945  u_deriv(2,2)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(2,part_deriv_s2)
4946  IF(field_variable%NUMBER_OF_COMPONENTS==4) THEN
4947  u_value(3)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(3,no_part_deriv)
4948  u_deriv(3,1)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(3,part_deriv_s1)
4949  u_deriv(3,2)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(3,part_deriv_s2)
4950  u_deriv(3,3)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(3,part_deriv_s3)
4951  u_deriv(1,3)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(1,part_deriv_s3)
4952  u_deriv(2,3)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(2,part_deriv_s3)
4953  ELSE
4954  u_value(3)=0.0_dp
4955  u_deriv(3,1)=0.0_dp
4956  u_deriv(3,2)=0.0_dp
4957  u_deriv(3,3)=0.0_dp
4958  u_deriv(1,3)=0.0_dp
4959  u_deriv(2,3)=0.0_dp
4960  END IF
4961  !Here W_VALUES must be ZERO if ALE part of linear matrix
4962  w_value=0.0_dp
4963  mhs=0
4964  DO mh=1,(field_variable%NUMBER_OF_COMPONENTS-1)
4965  mesh_component1=field_variable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
4966  dependent_basis1=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component1)%PTR% &
4967  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
4968  quadrature_scheme1=>dependent_basis1%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
4969  jgw=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
4970  & quadrature_scheme1%GAUSS_WEIGHTS(ng)
4971  dxi_dx=0.0_dp
4972 
4973  DO ni=1,dependent_basis1%NUMBER_OF_XI
4974  DO mi=1,dependent_basis1%NUMBER_OF_XI
4975  dxi_dx(mi,ni)=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%DXI_DX(mi,ni)
4976  END DO
4977  END DO
4978 
4979  DO ms=1,dependent_basis1%NUMBER_OF_ELEMENT_PARAMETERS
4980  mhs=mhs+1
4981  phims=quadrature_scheme1%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
4982  !note mh value derivative
4983  sum=0.0_dp
4984  ! Convective form
4985  DO ni=1,dependent_basis1%NUMBER_OF_XI
4986  sum=sum+rho_param*(phims)*( &
4987  & (u_value(1))*(u_deriv(mh,ni)*dxi_dx(ni,1))+ &
4988  & (u_value(2))*(u_deriv(mh,ni)*dxi_dx(ni,2))+ &
4989  & (u_value(3))*(u_deriv(mh,ni)*dxi_dx(ni,3)))
4990  END DO !ni
4991 
4992  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)=nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)+sum*jgw
4993 
4994  END DO !ms
4995  END DO !mh
4996  END IF
4997  END IF
4998 
4999  !------------------------------------------------------------------
5000  ! R e s i d u a l - b a s e d S t a b i l i s a t i o n
5001  !------------------------------------------------------------------
5002  IF(equations_set%specification(3)==equations_set_transient_rbs_navier_stokes_subtype.OR. &
5003  & equations_set%specification(3)==equations_set_static_rbs_navier_stokes_subtype.OR. &
5004  & equations_set%specification(3)==equations_set_multiscale3d_navier_stokes_subtype) THEN
5005  CALL navierstokes_residualbasedstabilisation(equations_set,element_number,ng, &
5006  & mu_param,rho_param,.false.,err,error,*999)
5007  END IF
5008 
5009  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5010  !!!!! !!!!!
5011  !!!!! 1 D T R A N S I E N T !!!!!
5012  !!!!! !!!!!
5013  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5014 
5015  !Start with matrix calculations
5016  IF(equations_set%specification(3)==equations_set_transient1d_navier_stokes_subtype .OR. &
5017  & equations_set%specification(3)==equations_set_coupled1d0d_navier_stokes_subtype .OR. &
5018  & equations_set%specification(3)==equations_set_transient1d_adv_navier_stokes_subtype .OR. &
5019  & equations_set%specification(3)==equations_set_coupled1d0d_adv_navier_stokes_subtype) THEN
5020  q_value=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,no_part_deriv)
5021  q_deriv=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,first_part_deriv)
5022  a_value=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,no_part_deriv)
5023  a_deriv=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,first_part_deriv)
5024  CALL field_parameter_set_get_constant(materials_field,field_u_variable_type,field_values_set_type,3, &
5025  & alpha,err,error,*999)
5026  CALL field_parameter_set_get_constant(materials_field,field_u_variable_type,field_values_set_type,8, &
5027  & g0_param,err,error,*999)
5028  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
5029  & materials_interp_point(field_v_variable_type)%PTR,err,error,*999)
5030  a0_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)%PTR%VALUES(1,no_part_deriv)
5031  a0_deriv=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)%PTR%VALUES(1,first_part_deriv)
5032  e_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)%PTR%VALUES(2,no_part_deriv)
5033  e_deriv=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)%PTR%VALUES(2,first_part_deriv)
5034  h_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)%PTR%VALUES(3,no_part_deriv)
5035  h_deriv=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)%PTR%VALUES(3,first_part_deriv)
5036  beta = (4.0_dp*(sqrt(pi))*e_param*h_param)/(3.0_dp*a0_param) !(kg/m2/s2)
5037 
5038  ! If A goes negative during nonlinear iteration, give ZERO_TOLERANCE value to avoid segfault
5039  IF(a_value < a0_param*0.001_dp) THEN
5040  a_value = a0_param*0.001_dp
5041  END IF
5042 
5043  mhs=0
5044  !Loop Over Element Rows
5045  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
5046  mesh_component1=field_variable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
5047  dependent_basis1=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component1)%PTR% &
5048  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
5049  quadrature_scheme1=>dependent_basis1%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
5050  jgw=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
5051  & quadrature_scheme1%GAUSS_WEIGHTS(ng)
5052  elements_topology=>field_variable%COMPONENTS(mh)%DOMAIN%TOPOLOGY%ELEMENTS
5053  dxi_dx=0.0_dp
5054  !Calculate dxi_dx in 3D
5055  DO xiidx=1,dependent_basis1%NUMBER_OF_XI
5056  DO coordidx=1,equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type) &
5057  & %PTR%NUMBER_OF_X_DIMENSIONS
5058  dxi_dx(1,1)=dxi_dx(1,1)+(equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)% &
5059  & ptr%DXI_DX(xiidx,coordidx))**2.0_dp
5060  END DO !coordIdx
5061  END DO !xiIdx
5062  dxi_dx(1,1)=sqrt(dxi_dx(1,1))
5063  !Loop Over Element rows
5064  DO ms=1,dependent_basis1%NUMBER_OF_ELEMENT_PARAMETERS
5065  phims=quadrature_scheme1%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
5066  dphims_dxi(1)=quadrature_scheme1%GAUSS_BASIS_FNS(ms,first_part_deriv,ng)
5067  mhs=mhs+1
5068  nhs=0
5069  IF(update_stiffness_matrix .OR. update_damping_matrix) THEN
5070  !Loop Over Element Columns
5071  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
5072  mesh_component2=field_variable%COMPONENTS(nh)%MESH_COMPONENT_NUMBER
5073  dependent_basis2=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component2)%PTR% &
5074  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
5075  quadrature_scheme2=>dependent_basis2%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
5076  DO ns=1,dependent_basis2%NUMBER_OF_ELEMENT_PARAMETERS
5077  phins=quadrature_scheme2%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)
5078  dphins_dxi(1)=quadrature_scheme2%GAUSS_BASIS_FNS(ns,first_part_deriv,ng)
5079  nhs=nhs+1
5080 
5081  !!!-- D A M P I N G M A T R I X --!!!
5082  IF(update_damping_matrix) THEN
5083  !Momentum Equation, dQ/dt
5084  IF(mh==1 .AND. nh==1) THEN
5085  sum=phins*phims
5086  damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)= &
5087  & damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*jgw
5088  END IF
5089  !Mass Equation, dA/dt
5090  IF(mh==2 .AND. nh==2) THEN
5091  sum=phins*phims
5092  damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)= &
5093  & damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*jgw
5094  END IF
5095  END IF
5096 
5097  !!!-- S T I F F N E S S M A T R I X --!!!
5098  IF(update_stiffness_matrix) THEN
5099  IF(mh==1 .AND. nh==2) THEN
5100  !Momentum Equation, linearisable A0 terms
5101  sum=-phins*phims*(beta*sqrt(a0_param)/rho_param)*(h_deriv/h_param + e_deriv/e_param)*dxi_dx(1,1)
5102  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)= &
5103  & stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*jgw
5104  !Momentum Equation, gravitational force
5105  sum=phins*phims*g0_param
5106  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)= &
5107  & stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*jgw
5108  END IF
5109  !Mass Equation, dQ/dX, flow derivative
5110  IF(mh==2 .AND. nh==1) THEN
5111  sum=dphins_dxi(1)*dxi_dx(1,1)*phims
5112  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)= &
5113  & stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*jgw
5114  END IF
5115  END IF
5116 
5117  END DO !ns
5118  END DO !nh
5119  END IF
5120 
5121  !!!-- N O N L I N E A R V E C T O R --!!!
5122  IF(update_nonlinear_residual) THEN
5123  !Momentum Equation
5124  IF(mh==1) THEN
5125  sum=((2.0_dp*alpha*(q_value/a_value)*q_deriv - &
5126  & (alpha*((q_value/a_value)**2.0_dp)*a_deriv)+(beta/rho_param)* & !Convective
5127  & ((sqrt(a_value)/2.0_dp)*a_deriv+ & !A gradient
5128  & (a_value/(2.0_dp*sqrt(a0_param))-(a_value**1.5_dp)/a0_param)*a0_deriv+ & !A0 gradient
5129  & (a_value*(sqrt(a_value)))*(h_deriv/h_param) + & !H gradient (nonlinear part)
5130  & (a_value*(sqrt(a_value)))*(e_deriv/e_param)))* & !E gradient (nonlinear part)
5131  & dxi_dx(1,1)+(q_value/a_value))*phims !Viscosity
5132  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)= &
5133  & nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(mhs)+sum*jgw
5134  END IF
5135  END IF
5136 
5137  END DO !ms
5138  END DO !mh
5139  END IF
5140  END DO !ng
5141 
5142  IF(equations_set%specification(3)==equations_set_transient1d_navier_stokes_subtype .OR. &
5143  & equations_set%specification(3)==equations_set_coupled1d0d_navier_stokes_subtype .OR. &
5144  & equations_set%specification(3)==equations_set_transient1d_adv_navier_stokes_subtype .OR. &
5145  & equations_set%specification(3)==equations_set_coupled1d0d_adv_navier_stokes_subtype) THEN
5146  IF(update_nonlinear_residual) THEN
5147  elements_topology=>dependent_field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR%components(1)%domain%topology%elements
5148  numberofelementnodes=elements_topology%ELEMENTS(element_number)%BASIS%NUMBER_OF_NODES
5149  numberofparameters=elements_topology%MAXIMUM_NUMBER_OF_ELEMENT_PARAMETERS
5150  firstnode=elements_topology%ELEMENTS(element_number)%ELEMENT_NODES(1)
5151  lastnode=elements_topology%ELEMENTS(element_number)%ELEMENT_NODES(numberofelementnodes)
5152  !Get material constants
5153  CALL field_parameter_set_get_constant(materials_field,field_u_variable_type,field_values_set_type,2, &
5154  & rho_param,err,error,*999)
5155  CALL field_parameter_set_get_constant(materials_field,field_u_variable_type,field_values_set_type,4, &
5156  & pexternal,err,error,*999)
5157  CALL field_parameter_set_get_constant(materials_field,field_u_variable_type,field_values_set_type,5, &
5158  & lref,err,error,*999)
5159  CALL field_parameter_set_get_constant(materials_field,field_u_variable_type,field_values_set_type,6, &
5160  & tref,err,error,*999)
5161  CALL field_parameter_set_get_constant(materials_field,field_u_variable_type,field_values_set_type,7, &
5162  & mref,err,error,*999)
5163 
5164  !!!-- P R E S S U R E C A L C U L A T I O N --!!!
5165  !Loop over the element nodes and versions
5166  DO nodeidx=1,numberofelementnodes
5167  nodenumber=elements_topology%ELEMENTS(element_number)%ELEMENT_NODES(nodeidx)
5168  derivativeidx = 1
5169  versionidx=elements_topology%DOMAIN%TOPOLOGY%ELEMENTS%ELEMENTS(element_number)% &
5170  & elementversions(derivativeidx,nodeidx)
5171  !Get current Area values
5172  CALL field_parametersetgetlocalnode(dependent_field,field_u_variable_type,field_values_set_type,versionidx, &
5173  & derivativeidx,nodenumber,2,area,err,error,*999)
5174  IF(area < a0_param*0.001_dp) area = a0_param*0.001_dp
5175  !Get material parameters
5176  CALL field_parametersetgetlocalnode(materials_field,field_v_variable_type,field_values_set_type,versionidx, &
5177  & derivativeidx,nodenumber,1,a0_param,err,error,*999)
5178  CALL field_parametersetgetlocalnode(materials_field,field_v_variable_type,field_values_set_type,versionidx, &
5179  & derivativeidx,nodenumber,2,e_param,err,error,*999)
5180  CALL field_parametersetgetlocalnode(materials_field,field_v_variable_type,field_values_set_type,versionidx, &
5181  & derivativeidx,nodenumber,3,h_param,err,error,*999)
5182  beta = (4.0_dp*(sqrt(pi))*e_param*h_param)/(3.0_dp*a0_param) !(kg/m2/s2)
5183  !Pressure equation in mmHg
5184  pressure=(pexternal+beta*(sqrt(area)-sqrt(a0_param)))/(mref/(lref*tref**2.0))*0.0075_dp
5185  !Update the dependent field
5186  IF(element_number<=dependent_field%DECOMPOSITION%TOPOLOGY%ELEMENTS%NUMBER_OF_ELEMENTS) THEN
5187  CALL field_parameter_set_update_local_node(dependent_field,field_u2_variable_type,field_values_set_type, &
5188  & versionidx,1,nodenumber,1,pressure,err,error,*999)
5189  END IF
5190  END DO
5191 
5192  !!!-- B R A N C H F L U X U P W I N D I N G --!!!
5193  !----------------------------------------------------
5194  ! In order to enforce conservation of mass and momentum across discontinuous
5195  ! branching topologies, flux is upwinded against the conservative branch values
5196  ! established by the characteristic solver.
5197  DO nodeidx=1,numberofelementnodes
5198  nodenumber=elements_topology%ELEMENTS(element_number)%ELEMENT_NODES(nodeidx)
5199  numberofversions=elements_topology%DOMAIN%TOPOLOGY%NODES%NODES(nodenumber)%DERIVATIVES(1)%numberOfVersions
5200 
5201  ! Find the branch node on this element
5202  IF(numberofversions>1) THEN
5203  derivativeidx = 1
5204  elementversionnumber=elements_topology%DOMAIN%TOPOLOGY%ELEMENTS%ELEMENTS(element_number)% &
5205  & elementversions(derivativeidx,nodeidx)
5206 
5207  ! Find the wave direction - incoming or outgoing
5208  DO componentidx = 1,2
5209  CALL field_parametersetgetlocalnode(independent_field,field_u_variable_type,field_values_set_type, &
5210  & elementversionnumber,derivativeidx,nodenumber,componentidx,normalwave,err,error,*999)
5211  IF(abs(normalwave) > zero_tolerance) THEN
5212  normal = normalwave
5213  END IF
5214  END DO
5215 
5216  ! Get materials parameters for node on this element
5217  CALL field_parametersetgetlocalnode(materials_field,field_v_variable_type,field_values_set_type, &
5218  & elementversionnumber,derivativeidx,nodenumber,1,a0_param,err,error,*999)
5219  CALL field_parametersetgetlocalnode(materials_field,field_v_variable_type,field_values_set_type, &
5220  & elementversionnumber,derivativeidx,nodenumber,2,e_param,err,error,*999)
5221  CALL field_parametersetgetlocalnode(materials_field,field_v_variable_type,field_values_set_type, &
5222  & elementversionnumber,derivativeidx,nodenumber,3,h_param,err,error,*999)
5223  beta = (4.0_dp*(sqrt(pi))*e_param*h_param)/(3.0_dp*a0_param)
5224 
5225  !Get current Q & A values for node on this element
5226  CALL field_parametersetgetlocalnode(dependent_field,field_u_variable_type,field_values_set_type, &
5227  & elementversionnumber,derivativeidx,nodenumber,1,q_value,err,error,*999)
5228  CALL field_parametersetgetlocalnode(dependent_field,field_u_variable_type,field_values_set_type, &
5229  & elementversionnumber,derivativeidx,nodenumber,2,a_value,err,error,*999)
5230 
5231  !Get upwind Q & A values based on the branch (characteristics) solver
5232  CALL field_parametersetgetlocalnode(dependent_field,field_u_variable_type,field_upwind_values_set_type, &
5233  & elementversionnumber,derivativeidx,nodenumber,1,qupwind,err,error,*999)
5234  CALL field_parametersetgetlocalnode(dependent_field,field_u_variable_type,field_upwind_values_set_type, &
5235  & elementversionnumber,derivativeidx,nodenumber,2,aupwind,err,error,*999)
5236 
5237  ! If A goes negative during nonlinear iteration, set to positive value to avoid segfault
5238  IF(a_value < a0_param*0.001_dp) THEN
5239  a_value = a0_param*0.001_dp
5240  END IF
5241 
5242  !Momentum Equation: F_upwind - F_Current
5243  momentum = ((alpha*(qupwind**2.0_dp)/aupwind+(aupwind**1.5_dp-a0_param**1.5_dp)*(beta/(3.0_dp*rho_param))) &
5244  & - (alpha*(q_value**2.0_dp)/a_value+(a_value**1.5_dp-a0_param**1.5_dp)*(beta/(3.0_dp*rho_param))))*normal
5245 
5246  !Continuity Equation
5247  mass = (qupwind-q_value)*normal
5248 
5249  !Add momentum/mass contributions to first/last node accordingly
5250  IF(nodenumber==firstnode) THEN
5251  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(1)= &
5252  & nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(1)+momentum
5253  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(numberofparameters+1)= &
5254  & nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(numberofparameters+1)+mass
5255  ELSE IF(nodenumber==lastnode) THEN
5256  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(numberofparameters)= &
5257  & nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(numberofparameters)+momentum
5258  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(numberofparameters*2)= &
5259  & nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(numberofparameters*2)+mass
5260  END IF
5261  END IF !version>1
5262  END DO !loop nodes
5263  END IF
5264  END IF
5265 
5266  ! F a c e I n t e g r a t i o n
5267  IF(rhs_vector%UPDATE_VECTOR) THEN
5268  !If specified, also perform face integration for neumann boundary conditions
5269  IF(dependent_field%DECOMPOSITION%CALCULATE_FACES) THEN
5270  CALL navierstokes_finiteelementfaceintegrate(equations_set,element_number,field_variable,err,error,*999)
5271  END IF
5272  END IF
5273 
5274  !!!-- A S S E M B L E M A T R I C E S & V E C T O R S --!!!
5275  mhs_min=mhs
5276  mhs_max=nhs
5277  nhs_min=mhs
5278  nhs_max=nhs
5279  IF(equations_set%specification(3)==equations_set_static_navier_stokes_subtype.OR. &
5280  & equations_set%specification(3)==equations_set_static_rbs_navier_stokes_subtype.OR. &
5281  & equations_set%specification(3)==equations_set_laplace_navier_stokes_subtype.OR. &
5282  & equations_set%specification(3)==equations_set_transient_navier_stokes_subtype.OR. &
5283  & equations_set%specification(3)==equations_set_transient_rbs_navier_stokes_subtype.OR. &
5284  & equations_set%specification(3)==equations_set_multiscale3d_navier_stokes_subtype.OR. &
5285  & equations_set%specification(3)==equations_set_constitutive_mu_navier_stokes_subtype.OR. &
5286  & equations_set%specification(3)==equations_set_quasistatic_navier_stokes_subtype.OR. &
5287  & equations_set%specification(3)==equations_set_ale_navier_stokes_subtype.OR. &
5288  & equations_set%specification(3)==equations_set_pgm_navier_stokes_subtype) THEN
5289  IF(stiffness_matrix%FIRST_ASSEMBLY) THEN
5290  IF(update_stiffness_matrix) THEN
5291  DO mhs=mhs_min+1,mhs_max
5292  DO nhs=1,nhs_min
5293  !Transpose pressure type entries for mass equation
5294  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=-stiffness_matrix%ELEMENT_MATRIX%MATRIX(nhs,mhs)
5295  END DO
5296  END DO
5297  END IF
5298  END IF
5299  END IF
5300 
5301  CASE DEFAULT
5302  local_error="Equations set subtype "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
5303  & " is not valid for a Navier-Stokes equation type of a classical field equations set class."
5304  CALL flagerror(local_error,err,error,*999)
5305  END SELECT
5306  ELSE
5307  CALL flagerror("Equations set equations is not associated.",err,error,*999)
5308  END IF
5309  ELSE
5310  CALL flagerror("Equations set is not associated.",err,error,*999)
5311  ENDIF
5312 
5313  exits("NavierStokes_FiniteElementResidualEvaluate")
5314  RETURN
5315 999 errorsexits("NavierStokes_FiniteElementResidualEvaluate",err,error)
5316  RETURN 1
5317 
5318  END SUBROUTINE navierstokes_finiteelementresidualevaluate
5319 
5320  !
5321  !================================================================================================================================
5322  !
5323 
5325  SUBROUTINE navierstokes_finiteelementjacobianevaluate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
5326 
5327  !Argument variables
5328  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
5329  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
5330  INTEGER(INTG), INTENT(OUT) :: ERR
5331  TYPE(varying_string), INTENT(OUT) :: ERROR
5332  !Local Variables
5333  TYPE(basis_type), POINTER :: DEPENDENT_BASIS,DEPENDENT_BASIS1,DEPENDENT_BASIS2,GEOMETRIC_BASIS,INDEPENDENT_BASIS
5334  TYPE(decomposition_type), POINTER :: DECOMPOSITION
5335  TYPE(domain_elements_type), POINTER :: ELEMENTS_TOPOLOGY
5336  TYPE(equations_type), POINTER :: EQUATIONS
5337  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
5338  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
5339  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
5340  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
5341  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
5342  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
5343  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
5344  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
5345  TYPE(equations_jacobian_type), POINTER :: JACOBIAN_MATRIX
5346  TYPE(equations_matrix_type), POINTER :: STIFFNESS_MATRIX
5347  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD,INDEPENDENT_FIELD
5348  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
5349  TYPE(quadrature_scheme_type), POINTER :: QUADRATURE_SCHEME,QUADRATURE_SCHEME1,QUADRATURE_SCHEME2
5350  TYPE(varying_string) :: LOCAL_ERROR
5351  INTEGER(INTG) :: ng,mh,mhs,mi,ms,nh,nhs,ni,ns,x,xiIdx,coordIdx
5352  INTEGER(INTG) :: derivativeIdx,elementVersionNumber,firstNode,lastNode,nodeIdx,nodeNumber
5353  INTEGER(INTG) :: numberOfElementNodes,numberOfParameters,numberOfVersions,componentIdx
5354  INTEGER(INTG) :: FIELD_VAR_TYPE,MESH_COMPONENT_NUMBER,MESH_COMPONENT1,MESH_COMPONENT2
5355  REAL(DP) :: JGW,SUM,DXI_DX(3,3),DPHIMS_DXI(3),DPHINS_DXI(3),PHIMS,PHINS
5356  REAL(DP) :: U_VALUE(3),W_VALUE(3),U_DERIV(3,3),Q_VALUE,Q_DERIV,A_VALUE,A_DERIV,alpha,beta,normal,normalWave
5357  REAL(DP) :: MU_PARAM,RHO_PARAM,A0_PARAM,A0_DERIV,E_PARAM,E_DERIV,H_PARAM,H_DERIV,mass,momentum1,momentum2,muScale
5358  LOGICAL :: UPDATE_JACOBIAN_MATRIX
5359 
5360  enters("NavierStokes_FiniteElementJacobianEvaluate",err,error,*999)
5361 
5362  dxi_dx=0.0_dp
5363  update_jacobian_matrix=.false.
5364 
5365  IF(ASSOCIATED(equations_set)) THEN
5366  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
5367  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
5368  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
5369  CALL flagerror("Equations set specification must have three entries for a Navier-Stokes type equations set.", &
5370  & err,error,*999)
5371  END IF
5372  NULLIFY(equations)
5373  equations=>equations_set%EQUATIONS
5374  IF(ASSOCIATED(equations)) THEN
5375  SELECT CASE(equations_set%specification(3))
5376  CASE(equations_set_static_navier_stokes_subtype, &
5377  & equations_set_laplace_navier_stokes_subtype, &
5378  & equations_set_static_rbs_navier_stokes_subtype, &
5379  & equations_set_transient_navier_stokes_subtype, &
5380  & equations_set_ale_navier_stokes_subtype, &
5381  & equations_set_pgm_navier_stokes_subtype, &
5382  & equations_set_quasistatic_navier_stokes_subtype, &
5383  & equations_set_transient1d_navier_stokes_subtype, &
5384  & equations_set_coupled1d0d_navier_stokes_subtype, &
5385  & equations_set_transient1d_adv_navier_stokes_subtype, &
5386  & equations_set_coupled1d0d_adv_navier_stokes_subtype, &
5387  & equations_set_transient_rbs_navier_stokes_subtype, &
5388  & equations_set_multiscale3d_navier_stokes_subtype, &
5389  & equations_set_constitutive_mu_navier_stokes_subtype)
5390  !Set some general and case-specific pointers
5391  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
5392  independent_field=>equations%INTERPOLATION%INDEPENDENT_FIELD
5393  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
5394  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
5395  equations_matrices=>equations%EQUATIONS_MATRICES
5396  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
5397  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
5398  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
5399  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
5400  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
5401  equations_mapping=>equations%EQUATIONS_MAPPING
5402  SELECT CASE(equations_set%specification(3))
5403  CASE(equations_set_static_navier_stokes_subtype,equations_set_laplace_navier_stokes_subtype, &
5404  & equations_set_quasistatic_navier_stokes_subtype)
5405  linear_matrices=>equations_matrices%LINEAR_MATRICES
5406  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
5407  jacobian_matrix=>nonlinear_matrices%JACOBIANS(1)%PTR
5408  stiffness_matrix=>linear_matrices%MATRICES(1)%PTR
5409  linear_mapping=>equations_mapping%LINEAR_MAPPING
5410  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
5411  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
5412  field_var_type=field_variable%VARIABLE_TYPE
5413  stiffness_matrix%ELEMENT_MATRIX%MATRIX=0.0_dp
5414  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR=0.0_dp
5415  IF(ASSOCIATED(jacobian_matrix)) update_jacobian_matrix=jacobian_matrix%UPDATE_JACOBIAN
5416  CASE(equations_set_static_rbs_navier_stokes_subtype)
5417  linear_matrices=>equations_matrices%LINEAR_MATRICES
5418  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
5419  jacobian_matrix=>nonlinear_matrices%JACOBIANS(1)%PTR
5420  stiffness_matrix=>linear_matrices%MATRICES(1)%PTR
5421  linear_mapping=>equations_mapping%LINEAR_MAPPING
5422  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
5423  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
5424  field_var_type=field_variable%VARIABLE_TYPE
5425  ! SOURCE_VECTOR=>EQUATIONS_MATRICES%SOURCE_VECTOR
5426  stiffness_matrix%ELEMENT_MATRIX%MATRIX=0.0_dp
5427  nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR=0.0_dp
5428  IF(ASSOCIATED(jacobian_matrix)) update_jacobian_matrix=jacobian_matrix%UPDATE_JACOBIAN
5429  CASE(equations_set_transient_navier_stokes_subtype)
5430  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
5431  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
5432  jacobian_matrix=>nonlinear_matrices%JACOBIANS(1)%PTR
5433  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX=0.0_dp
5434  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
5435  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
5436  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
5437  field_var_type=field_variable%VARIABLE_TYPE
5438  linear_mapping=>equations_mapping%LINEAR_MAPPING
5439  IF(ASSOCIATED(jacobian_matrix)) update_jacobian_matrix=jacobian_matrix%UPDATE_JACOBIAN
5440  CASE(equations_set_transient1d_navier_stokes_subtype,equations_set_coupled1d0d_navier_stokes_subtype, &
5441  & equations_set_transient1d_adv_navier_stokes_subtype,equations_set_coupled1d0d_adv_navier_stokes_subtype)
5442  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
5443  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
5444  jacobian_matrix=>nonlinear_matrices%JACOBIANS(1)%PTR
5445  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX=0.0_dp
5446  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
5447  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
5448  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
5449  field_var_type=field_variable%VARIABLE_TYPE
5450  linear_mapping=>equations_mapping%LINEAR_MAPPING
5451  IF(ASSOCIATED(jacobian_matrix)) update_jacobian_matrix=jacobian_matrix%UPDATE_JACOBIAN
5452  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
5453  & materials_interp_parameters(field_v_variable_type)%PTR,err,error,*999)
5454  CASE(equations_set_transient_rbs_navier_stokes_subtype)
5455  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
5456  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
5457  jacobian_matrix=>nonlinear_matrices%JACOBIANS(1)%PTR
5458  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX=0.0_dp
5459  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
5460  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
5461  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
5462  field_var_type=field_variable%VARIABLE_TYPE
5463  linear_mapping=>equations_mapping%LINEAR_MAPPING
5464  IF(ASSOCIATED(jacobian_matrix)) update_jacobian_matrix=jacobian_matrix%UPDATE_JACOBIAN
5465  CASE(equations_set_multiscale3d_navier_stokes_subtype, &
5466  & equations_set_constitutive_mu_navier_stokes_subtype)
5467  decomposition => dependent_field%DECOMPOSITION
5468  mesh_component_number = decomposition%MESH_COMPONENT_NUMBER
5469  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
5470  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
5471  jacobian_matrix=>nonlinear_matrices%JACOBIANS(1)%PTR
5472  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX=0.0_dp
5473  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
5474  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
5475  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
5476  field_var_type=field_variable%VARIABLE_TYPE
5477  linear_mapping=>equations_mapping%LINEAR_MAPPING
5478  IF(ASSOCIATED(jacobian_matrix)) update_jacobian_matrix=jacobian_matrix%UPDATE_JACOBIAN
5479  CASE(equations_set_ale_navier_stokes_subtype,equations_set_pgm_navier_stokes_subtype)
5480  independent_field=>equations%INTERPOLATION%INDEPENDENT_FIELD
5481  independent_basis=>independent_field%DECOMPOSITION%DOMAIN(independent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)% &
5482  & ptr%TOPOLOGY%ELEMENTS%ELEMENTS(element_number)%BASIS
5483  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
5484  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
5485  jacobian_matrix=>nonlinear_matrices%JACOBIANS(1)%PTR
5486  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX=0.0_dp
5487  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
5488  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
5489  field_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(1)%PTR
5490  field_var_type=field_variable%VARIABLE_TYPE
5491  linear_mapping=>equations_mapping%LINEAR_MAPPING
5492  IF(ASSOCIATED(jacobian_matrix)) update_jacobian_matrix=jacobian_matrix%UPDATE_JACOBIAN
5493  CALL field_interpolation_parameters_element_get(field_mesh_velocity_set_type,element_number,equations% &
5494  & interpolation%INDEPENDENT_INTERP_PARAMETERS(field_u_variable_type)%PTR,err,error,*999)
5495  CASE DEFAULT
5496  local_error="Equations set subtype "//trim(number_to_vstring(equations_set%specification(3),"*",err,error))// &
5497  & " is not valid for a Navier-Stokes fluid type of a fluid mechanics equations set class."
5498  CALL flagerror(local_error,err,error,*999)
5499  END SELECT
5500  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
5501  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
5502  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
5503  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
5504  CALL field_parameter_set_get_constant(materials_field,field_u_variable_type,field_values_set_type,1, &
5505  & mu_param,err,error,*999)
5506  CALL field_parameter_set_get_constant(materials_field,field_u_variable_type,field_values_set_type,2, &
5507  & rho_param,err,error,*999)
5508  !Loop over all Gauss points
5509  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
5510  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
5511  & dependent_interp_point(field_var_type)%PTR,err,error,*999)
5512  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
5513  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
5514  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
5515  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
5516  IF(equations_set%specification(3)==equations_set_ale_navier_stokes_subtype.OR. &
5517  & equations_set%specification(3)==equations_set_pgm_navier_stokes_subtype) THEN
5518  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
5519  & independent_interp_point(field_u_variable_type)%PTR,err,error,*999)
5520  w_value(1)=equations%INTERPOLATION%INDEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,no_part_deriv)
5521  w_value(2)=equations%INTERPOLATION%INDEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,no_part_deriv)
5522  IF(field_variable%NUMBER_OF_COMPONENTS==4) THEN
5523  w_value(3)=equations%INTERPOLATION%INDEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,no_part_deriv)
5524  END IF
5525  ELSE
5526  w_value=0.0_dp
5527  END IF
5528 
5529  ! Get the constitutive law (non-Newtonian) viscosity based on shear rate
5530  IF(equations_set%specification(3)==equations_set_constitutive_mu_navier_stokes_subtype) THEN
5531  ! Note the constant from the U_VARIABLE is a scale factor
5532  muscale = mu_param
5533  ! Get the gauss point based value returned from the CellML solver
5534  CALL field_parametersetgetlocalgausspoint(materials_field,field_v_variable_type,field_values_set_type, &
5535  & ng,element_number,1,mu_param,err,error,*999)
5536  mu_param=mu_param*muscale
5537  END IF
5538 
5539  IF(equations_set%specification(3)==equations_set_static_navier_stokes_subtype.OR. &
5540  & equations_set%specification(3)==equations_set_static_rbs_navier_stokes_subtype.OR. &
5541  & equations_set%specification(3)==equations_set_laplace_navier_stokes_subtype.OR. &
5542  & equations_set%specification(3)==equations_set_transient_navier_stokes_subtype.OR. &
5543  & equations_set%specification(3)==equations_set_transient_rbs_navier_stokes_subtype.OR. &
5544  & equations_set%specification(3)==equations_set_multiscale3d_navier_stokes_subtype.OR. &
5545  & equations_set%specification(3)==equations_set_constitutive_mu_navier_stokes_subtype.OR. &
5546  & equations_set%specification(3)==equations_set_quasistatic_navier_stokes_subtype.OR. &
5547  & equations_set%specification(3)==equations_set_ale_navier_stokes_subtype.OR. &
5548  & equations_set%specification(3)==equations_set_pgm_navier_stokes_subtype) THEN
5549 
5550  u_value(1)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(1,no_part_deriv)
5551  u_value(2)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(2,no_part_deriv)
5552  u_deriv(1,1)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(1,part_deriv_s1)
5553  u_deriv(1,2)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(1,part_deriv_s2)
5554  u_deriv(2,1)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(2,part_deriv_s1)
5555  u_deriv(2,2)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(2,part_deriv_s2)
5556  IF(field_variable%NUMBER_OF_COMPONENTS==4) THEN
5557  u_value(3)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(3,no_part_deriv)
5558  u_deriv(3,1)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(3,part_deriv_s1)
5559  u_deriv(3,2)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(3,part_deriv_s2)
5560  u_deriv(3,3)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(3,part_deriv_s3)
5561  u_deriv(1,3)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(1,part_deriv_s3)
5562  u_deriv(2,3)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(2,part_deriv_s3)
5563  ELSE
5564  u_value(3)=0.0_dp
5565  u_deriv(3,1)=0.0_dp
5566  u_deriv(3,2)=0.0_dp
5567  u_deriv(3,3)=0.0_dp
5568  u_deriv(1,3)=0.0_dp
5569  u_deriv(2,3)=0.0_dp
5570  END IF
5571  !Start with calculation of partial matrices
5572  !Here W_VALUES must be ZERO if ALE part of linear matrix
5573  w_value=0.0_dp
5574  END IF
5575 
5576  IF(equations_set%specification(3)==equations_set_static_navier_stokes_subtype.OR. &
5577  & equations_set%specification(3)==equations_set_static_rbs_navier_stokes_subtype.OR. &
5578  & equations_set%specification(3)==equations_set_laplace_navier_stokes_subtype.OR. &
5579  & equations_set%specification(3)==equations_set_transient_navier_stokes_subtype.OR. &
5580  & equations_set%specification(3)==equations_set_transient_rbs_navier_stokes_subtype.OR. &
5581  & equations_set%specification(3)==equations_set_multiscale3d_navier_stokes_subtype.OR. &
5582  & equations_set%specification(3)==equations_set_constitutive_mu_navier_stokes_subtype.OR. &
5583  & equations_set%specification(3)==equations_set_quasistatic_navier_stokes_subtype.OR. &
5584  & equations_set%specification(3)==equations_set_ale_navier_stokes_subtype.OR. &
5585  & equations_set%specification(3)==equations_set_pgm_navier_stokes_subtype) THEN
5586  !Loop over field components
5587  mhs=0
5588 
5589  DO mh=1,field_variable%NUMBER_OF_COMPONENTS-1
5590  mesh_component1=field_variable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
5591  dependent_basis1=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component1)%PTR% &
5592  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
5593  quadrature_scheme1=>dependent_basis1%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
5594  jgw=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
5595  & quadrature_scheme1%GAUSS_WEIGHTS(ng)
5596 
5597  DO ms=1,dependent_basis1%NUMBER_OF_ELEMENT_PARAMETERS
5598  mhs=mhs+1
5599  nhs=0
5600  IF(update_jacobian_matrix) THEN
5601  !Loop over element columns
5602  DO nh=1,field_variable%NUMBER_OF_COMPONENTS-1
5603  mesh_component2=field_variable%COMPONENTS(nh)%MESH_COMPONENT_NUMBER
5604  dependent_basis2=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component2)%PTR% &
5605  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
5606  quadrature_scheme2=>dependent_basis2%QUADRATURE%QUADRATURE_SCHEME_MAP&
5607  &(basis_default_quadrature_scheme)%PTR
5608  DO ns=1,dependent_basis2%NUMBER_OF_ELEMENT_PARAMETERS
5609  nhs=nhs+1
5610  !Calculate some general values needed below
5611  DO ni=1,dependent_basis2%NUMBER_OF_XI
5612  DO mi=1,dependent_basis1%NUMBER_OF_XI
5613  dxi_dx(mi,ni)=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR% &
5614  & dxi_dx(mi,ni)
5615  END DO
5616  dphims_dxi(ni)=quadrature_scheme1%GAUSS_BASIS_FNS(ms,partial_derivative_first_derivative_map(ni),ng)
5617  dphins_dxi(ni)=quadrature_scheme2%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(ni),ng)
5618  END DO !ni
5619  phims=quadrature_scheme1%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
5620  phins=quadrature_scheme2%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)
5621  sum=0.0_dp
5622  IF(update_jacobian_matrix) THEN
5623  !Calculate J1 only
5624  DO ni=1,dependent_basis1%NUMBER_OF_XI
5625  sum=sum+(phins*u_deriv(mh,ni)*dxi_dx(ni,nh)*phims*rho_param)
5626  END DO
5627  !Calculate MATRIX
5628  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs) &
5629  & +sum*jgw
5630  !Calculate J2 only
5631  IF(nh==mh) THEN
5632  sum=0.0_dp
5633  !Calculate SUM
5634  DO x=1,dependent_basis1%NUMBER_OF_XI
5635  DO mi=1,dependent_basis2%NUMBER_OF_XI
5636  sum=sum+rho_param*(u_value(x)-w_value(x))*dphins_dxi(mi)*dxi_dx(mi,x)*phims
5637  END DO !mi
5638  END DO !x
5639  !Calculate MATRIX
5640  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs) &
5641  & +sum*jgw
5642  END IF
5643  END IF
5644  END DO !ns
5645  END DO !nh
5646  END IF
5647  END DO !ms
5648  END DO !mh
5649  ! Stabilisation terms
5650  IF(equations_set%specification(3)==equations_set_transient_rbs_navier_stokes_subtype.OR. &
5651  & equations_set%specification(3)==equations_set_static_rbs_navier_stokes_subtype.OR. &
5652  & equations_set%specification(3)==equations_set_multiscale3d_navier_stokes_subtype) THEN
5653  CALL navierstokes_residualbasedstabilisation(equations_set,element_number,ng,mu_param,rho_param,.true., &
5654  & err,error,*999)
5655  END IF
5656  END IF
5657 
5658  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5659  !!!!! !!!!!
5660  !!!!! 1 D T R A N S I E N T !!!!!
5661  !!!!! !!!!!
5662  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5663 
5664  !Start with Matrix Calculations
5665  IF(equations_set%specification(3)==equations_set_transient1d_navier_stokes_subtype .OR. &
5666  & equations_set%specification(3)==equations_set_coupled1d0d_navier_stokes_subtype .OR. &
5667  & equations_set%specification(3)==equations_set_transient1d_adv_navier_stokes_subtype .OR. &
5668  & equations_set%specification(3)==equations_set_coupled1d0d_adv_navier_stokes_subtype) THEN
5669  q_value=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(1,no_part_deriv)
5670  q_deriv=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(1,first_part_deriv)
5671  a_value=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(2,no_part_deriv)
5672  a_deriv=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_var_type)%PTR%VALUES(2,first_part_deriv)
5673  CALL field_parameter_set_get_constant(materials_field,field_u_variable_type,field_values_set_type,3, &
5674  & alpha,err,error,*999)
5675  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
5676  & materials_interp_point(field_v_variable_type)%PTR,err,error,*999)
5677  a0_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)%PTR%VALUES(1,no_part_deriv)
5678  a0_deriv=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)%PTR%VALUES(1,first_part_deriv)
5679  e_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)%PTR%VALUES(2,no_part_deriv)
5680  e_deriv=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)%PTR%VALUES(2,first_part_deriv)
5681  h_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)%PTR%VALUES(3,no_part_deriv)
5682  h_deriv=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_v_variable_type)%PTR%VALUES(3,first_part_deriv)
5683  beta = (4.0_dp*sqrt(pi)*e_param*h_param)/(3.0_dp*a0_param) !(kg/m2/s2)
5684 
5685  ! If A goes negative during nonlinear iteration, give ZERO_TOLERANCE value to avoid segfault
5686  IF(a_value < a0_param*0.001_dp) THEN
5687  a_value = a0_param*0.001_dp
5688  END IF
5689 
5690  mhs=0
5691  !Loop Over Element Rows
5692  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
5693  mesh_component1=field_variable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
5694  dependent_basis1=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component1)%PTR% &
5695  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
5696  quadrature_scheme1=>dependent_basis1%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
5697  jgw=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
5698  & quadrature_scheme1%GAUSS_WEIGHTS(ng)
5699  elements_topology=>field_variable%COMPONENTS(mh)%DOMAIN%TOPOLOGY%ELEMENTS
5700  dxi_dx(1,1)=0.0_dp
5701  !Calculate dxi_dx in 3D
5702  DO xiidx=1,dependent_basis1%NUMBER_OF_XI
5703  DO coordidx=1,equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type) &
5704  & %PTR%NUMBER_OF_X_DIMENSIONS
5705  dxi_dx(1,1)=dxi_dx(1,1)+(equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)% &
5706  & ptr%DXI_DX(xiidx,coordidx))**2.0_dp
5707  END DO !coordIdx
5708  END DO !xiIdx
5709  dxi_dx(1,1)=sqrt(dxi_dx(1,1))
5710  !Loop Over Element rows
5711  DO ms=1,dependent_basis1%NUMBER_OF_ELEMENT_PARAMETERS
5712  phims=quadrature_scheme1%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
5713  dphims_dxi(1)=quadrature_scheme1%GAUSS_BASIS_FNS(ms,first_part_deriv,ng)
5714  mhs=mhs+1
5715  nhs=0
5716  !Loop Over Element Columns
5717  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
5718  mesh_component2=field_variable%COMPONENTS(nh)%MESH_COMPONENT_NUMBER
5719  dependent_basis2=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component2)%PTR% &
5720  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
5721  quadrature_scheme2=>dependent_basis2%QUADRATURE%QUADRATURE_SCHEME_MAP&
5722  &(basis_default_quadrature_scheme)%PTR
5723  DO ns=1,dependent_basis2%NUMBER_OF_ELEMENT_PARAMETERS
5724  phins=quadrature_scheme2%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)
5725  dphins_dxi(1)=quadrature_scheme1%GAUSS_BASIS_FNS(ns,first_part_deriv,ng)
5726  nhs=nhs+1
5727  IF(update_jacobian_matrix) THEN
5728 
5729  !Momentum Equation (dF/dQ)
5730  IF(mh==1 .AND. nh==1) THEN
5731  sum=((alpha*2.0_dp*phins*q_deriv/a_value + &
5732  & alpha*2.0_dp*q_value*dphins_dxi(1)/a_value+ &
5733  & (-2.0_dp)*alpha*q_value*phins*a_deriv/(a_value**2.0_dp))*dxi_dx(1,1)+ & !Convective
5734  & ((phins/a_value)))*phims !Viscosity
5735  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)= &
5736  & jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)+sum*jgw
5737  END IF
5738 
5739  !Momentum Equation (dF/dA)
5740  IF(mh==1 .AND. nh==2) THEN
5741  sum=((((-2.0_dp*alpha*q_value*phins*q_deriv)/(a_value**2.0_dp))+ &
5742  & ((2.0_dp*alpha*phins*(q_value**2.0_dp)*a_deriv)/(a_value**3.0_dp))+ &
5743  & (-alpha*((q_value/a_value)**2.0_dp)*dphins_dxi(1))+ & !Convective
5744  & ((0.5_dp*phins*(1.0_dp/sqrt(a_value))*a_deriv+sqrt(a_value)*dphins_dxi(1))+ & !Area Gradient
5745  & ((1.0_dp/sqrt(a0_param))-((3.0_dp/(a0_param))*sqrt(a_value)))*(a0_deriv) + & !Ref Area Gradient
5746  & (2.0_dp*phins*1.5_dp*sqrt(a_value))*h_deriv/h_param+ & !Thickness Gradient
5747  & (2.0_dp*phins*1.5_dp*sqrt(a_value))*e_deriv/e_param) & !Elasticity Gradient
5748  & *beta/(2.0_dp*rho_param))*dxi_dx(1,1)+(-phins*q_value/a_value**2.0_dp))*phims !Viscosity
5749  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)= &
5750  & jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)+sum*jgw
5751  END IF
5752 
5753  END IF
5754  END DO !ns
5755  END DO !nh
5756  END DO !ms
5757  END DO !mh
5758  END IF
5759  END DO !ng
5760 
5761  IF(equations_set%specification(3)==equations_set_transient1d_navier_stokes_subtype .OR. &
5762  & equations_set%specification(3)==equations_set_coupled1d0d_navier_stokes_subtype .OR. &
5763  & equations_set%specification(3)==equations_set_transient1d_adv_navier_stokes_subtype .OR. &
5764  & equations_set%specification(3)==equations_set_coupled1d0d_adv_navier_stokes_subtype) THEN
5765  elements_topology=>dependent_field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR%components(1)%domain%topology%elements
5766  numberofelementnodes=elements_topology%ELEMENTS(element_number)%BASIS%NUMBER_OF_NODES
5767  numberofparameters=elements_topology%MAXIMUM_NUMBER_OF_ELEMENT_PARAMETERS
5768  firstnode=elements_topology%ELEMENTS(element_number)%ELEMENT_NODES(1)
5769  lastnode=elements_topology%ELEMENTS(element_number)%ELEMENT_NODES(numberofelementnodes)
5770  !Get material constants
5771  CALL field_parameter_set_get_constant(materials_field,field_u_variable_type,field_values_set_type,2, &
5772  & rho_param,err,error,*999)
5773 
5774  !!!-- B R A N C H F L U X U P W I N D I N G --!!!
5775  !----------------------------------------------------
5776  ! In order to enforce conservation of mass and momentum across discontinuous
5777  ! branching topologies, flux is upwinded against the conservative branch values
5778  ! established by the characteristic solver.
5779  DO nodeidx=1,numberofelementnodes
5780  nodenumber=elements_topology%ELEMENTS(element_number)%ELEMENT_NODES(nodeidx)
5781  numberofversions=elements_topology%DOMAIN%TOPOLOGY%NODES%NODES(nodenumber)%DERIVATIVES(1)%numberOfVersions
5782 
5783  ! Find the branch node on this element
5784  IF(numberofversions>1) THEN
5785  derivativeidx = 1
5786  elementversionnumber=elements_topology%DOMAIN%TOPOLOGY%ELEMENTS%ELEMENTS(element_number)% &
5787  & elementversions(derivativeidx,nodeidx)
5788 
5789  ! Find the wave direction - incoming or outgoing
5790  DO componentidx = 1,2
5791  CALL field_parametersetgetlocalnode(independent_field,field_u_variable_type,field_values_set_type, &
5792  & elementversionnumber,derivativeidx,nodenumber,componentidx,normalwave,err,error,*999)
5793  IF(abs(normalwave) > zero_tolerance) THEN
5794  normal = normalwave
5795  END IF
5796  END DO
5797 
5798  ! Get materials parameters for node on this element
5799  CALL field_parametersetgetlocalnode(materials_field,field_v_variable_type,field_values_set_type, &
5800  & elementversionnumber,derivativeidx,nodenumber,1,a0_param,err,error,*999)
5801  CALL field_parametersetgetlocalnode(materials_field,field_v_variable_type,field_values_set_type, &
5802  & elementversionnumber,derivativeidx,nodenumber,2,e_param,err,error,*999)
5803  CALL field_parametersetgetlocalnode(materials_field,field_v_variable_type,field_values_set_type, &
5804  & elementversionnumber,derivativeidx,nodenumber,3,h_param,err,error,*999)
5805  beta = (4.0_dp*(sqrt(pi))*e_param*h_param)/(3.0_dp*a0_param)
5806 
5807  !Get current Q & A values
5808  CALL field_parametersetgetlocalnode(dependent_field,field_u_variable_type,field_values_set_type, &
5809  & elementversionnumber,derivativeidx,nodenumber,1,q_value,err,error,*999)
5810  CALL field_parametersetgetlocalnode(dependent_field,field_u_variable_type,field_values_set_type, &
5811  & elementversionnumber,derivativeidx,nodenumber,2,a_value,err,error,*999)
5812 
5813  !Momentum Equation, d/dQ
5814  momentum1 = (-alpha*2.0_dp*q_value/a_value)*normal
5815 
5816  !Momentum Equation, d/dA
5817  momentum2 = (alpha*(q_value/a_value)**2.0_dp-1.5_dp*(a_value**0.5_dp)*(beta/(3.0_dp*rho_param)))*normal
5818 
5819  !Continuity Equation , d/dQ
5820  mass = -1.0_dp*normal
5821 
5822  !Add momentum/mass contributions to first/last node accordingly
5823  IF(nodenumber==firstnode) THEN
5824  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(1,1)= &
5825  & jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(1,1)+momentum1
5826  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(1,numberofparameters+1)= &
5827  & jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(1,numberofparameters+1)+momentum2
5828  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(numberofparameters+1,1)= &
5829  & jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(numberofparameters+1,1)+mass
5830  ELSE IF(nodenumber==lastnode) THEN
5831  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(numberofparameters,numberofparameters)= &
5832  & jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(numberofparameters,numberofparameters)+momentum1
5833  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(numberofparameters,2*numberofparameters)= &
5834  & jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(numberofparameters,2*numberofparameters)+momentum2
5835  jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(2*numberofparameters,numberofparameters)= &
5836  & jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(2*numberofparameters,numberofparameters)+mass
5837  END IF
5838  END IF !version>1
5839  END DO !loop nodes
5840 
5841  END IF
5842 
5843  CASE DEFAULT
5844  local_error="Equations set subtype "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
5845  & " is not valid for a Navier-Stokes equation type of a fluid mechanics equations set class."
5846  CALL flagerror(local_error,err,error,*999)
5847  END SELECT
5848  ELSE
5849  CALL flagerror("Equations set equations is not associated.",err,error,*999)
5850  END IF
5851  ELSE
5852  CALL flagerror("Equations set is not associated.",err,error,*999)
5853  ENDIF
5854 
5855  exits("NavierStokes_FiniteElementJacobianEvaluate")
5856  RETURN
5857 999 errorsexits("NavierStokes_FiniteElementJacobianEvaluate",err,error)
5858  RETURN 1
5859 
5860  END SUBROUTINE navierstokes_finiteelementjacobianevaluate
5861 
5862  !
5863  !================================================================================================================================
5864  !
5865 
5867  SUBROUTINE navier_stokes_post_solve(SOLVER,ERR,ERROR,*)
5868 
5869  !Argument variables
5870  TYPE(solver_type), POINTER :: SOLVER
5871  INTEGER(INTG), INTENT(OUT) :: ERR
5872  TYPE(varying_string), INTENT(OUT) :: ERROR
5873  !Local Variables
5874  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
5875  TYPE(field_type), POINTER :: dependentField
5876  TYPE(field_variable_type), POINTER :: fieldVariable
5877  TYPE(solver_type), POINTER :: SOLVER2
5878  TYPE(solvers_type), POINTER :: SOLVERS
5879  TYPE(varying_string) :: LOCAL_ERROR
5880  INTEGER(INTG) :: iteration,timestep,outputIteration,equationsSetNumber
5881  REAL(DP) :: startTime,stopTime,currentTime,timeIncrement
5882 
5883  enters("NAVIER_STOKES_POST_SOLVE",err,error,*999)
5884  NULLIFY(solver2)
5885  NULLIFY(solvers)
5886  NULLIFY(dependentfield)
5887  NULLIFY(fieldvariable)
5888 
5889  IF(ASSOCIATED(solver)) THEN
5890  solvers=>solver%SOLVERS
5891  IF(ASSOCIATED(solvers)) THEN
5892  control_loop=>solvers%CONTROL_LOOP
5893  IF(ASSOCIATED(control_loop)) THEN
5894  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
5895  IF(.NOT.ALLOCATED(control_loop%problem%specification)) THEN
5896  CALL flagerror("Problem specification is not allocated.",err,error,*999)
5897  ELSE IF(SIZE(control_loop%problem%specification,1)<3) THEN
5898  CALL flagerror("Problem specification must have three entries for a Navier-Stokes problem.",err,error,*999)
5899  END IF
5900  SELECT CASE(control_loop%PROBLEM%specification(3))
5901  CASE(problem_static_navier_stokes_subtype,problem_laplace_navier_stokes_subtype)
5902  CALL navier_stokes_post_solve_output_data(solver,err,error,*999)
5903  CASE(problem_pgm_navier_stokes_subtype)
5904  CALL navier_stokes_post_solve_output_data(solver,err,error,*999)
5905  CASE(problem_quasistatic_navier_stokes_subtype)
5906  CALL navier_stokes_post_solve_output_data(solver,err,error,*999)
5907  CASE(problem_transient_navier_stokes_subtype)
5908  CALL navier_stokes_post_solve_output_data(solver,err,error,*999)
5909  CASE(problem_transient1d_navier_stokes_subtype)
5910  SELECT CASE(solver%SOLVE_TYPE)
5911  CASE(solver_nonlinear_type)
5912  ! Characteristic solver- copy branch Q,A values to new parameter set
5913  dependentfield=>solver%SOLVER_EQUATIONS%SOLVER_MAPPING%EQUATIONS_SETS(1)%PTR%DEPENDENT%DEPENDENT_FIELD
5914  CALL field_variable_get(dependentfield,field_u_variable_type,fieldvariable,err,error,*999)
5915  IF(.NOT.ASSOCIATED(fieldvariable%PARAMETER_SETS%SET_TYPE(field_upwind_values_set_type)%PTR)) THEN
5916  CALL field_parameter_set_create(dependentfield,field_u_variable_type, &
5917  & field_upwind_values_set_type,err,error,*999)
5918  END IF
5919  iteration = control_loop%WHILE_LOOP%ITERATION_NUMBER
5920  IF(iteration == 1) THEN
5921  CALL field_parameter_sets_copy(dependentfield,field_u_variable_type,field_values_set_type, &
5922  & field_upwind_values_set_type,1.0_dp,err,error,*999)
5923  END IF
5924  CASE(solver_dynamic_type)
5925  ! Navier-Stokes solver: do nothing
5926  CASE DEFAULT
5927  local_error="The solver type of "//trim(number_to_vstring(solver%SOLVE_TYPE,"*",err,error))// &
5928  & " is invalid for a 1D Navier-Stokes problem."
5929  CALL flagerror(local_error,err,error,*999)
5930  END SELECT
5931  CASE(problem_coupled1d0d_navier_stokes_subtype)
5932  IF(ASSOCIATED(solver%SOLVERS%CONTROL_LOOP%WHILE_LOOP)) THEN
5933  SELECT CASE(solver%GLOBAL_NUMBER)
5934  CASE(1)
5935  ! Characteristic solver- copy branch Q,A values to new parameter set
5936  dependentfield=>solver%SOLVER_EQUATIONS%SOLVER_MAPPING%EQUATIONS_SETS(1)%PTR%DEPENDENT%DEPENDENT_FIELD
5937  CALL field_variable_get(dependentfield,field_u_variable_type,fieldvariable,err,error,*999)
5938  IF(.NOT.ASSOCIATED(fieldvariable%PARAMETER_SETS%SET_TYPE(field_upwind_values_set_type)%PTR)) THEN
5939  CALL field_parameter_set_create(dependentfield,field_u_variable_type, &
5940  & field_upwind_values_set_type,err,error,*999)
5941  END IF
5942  CALL field_parameter_sets_copy(dependentfield,field_u_variable_type,field_values_set_type, &
5943  & field_upwind_values_set_type,1.0_dp,err,error,*999)
5944 
5945  CASE(2)
5946  ! ! 1D Navier-Stokes solver
5947  IF(control_loop%CONTROL_LOOP_LEVEL==3) THEN
5948  ! check characteristic/ N-S convergence at branches
5949  ! CALL NavierStokes_CoupleCharacteristics(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
5950  END IF
5951  CASE DEFAULT
5952  local_error="The solver global number of "//trim(number_to_vstring(solver%GLOBAL_NUMBER,"*",err,error))// &
5953  & " is invalid for the iterative 1D-0D coupled Navier-Stokes problem."
5954  CALL flagerror(local_error,err,error,*999)
5955  END SELECT
5956  ELSE IF(ASSOCIATED(solver%SOLVERS%CONTROL_LOOP%SIMPLE_LOOP)) THEN
5957  IF(solver%GLOBAL_NUMBER == 1) THEN
5958  ! DAE solver- do nothing
5959  ELSE
5960  local_error="The solver global number of "//trim(number_to_vstring(solver%GLOBAL_NUMBER,"*",err,error))// &
5961  & " is invalid for the CellML DAE simple loop of a 1D0D coupled Navier-Stokes problem."
5962  CALL flagerror(local_error,err,error,*999)
5963  END IF
5964  ELSE
5965  local_error="The control loop type for solver "//trim(number_to_vstring(solver%GLOBAL_NUMBER,"*",err,error))// &
5966  & " is invalid for the a 1D0D coupled Navier-Stokes problem."
5967  CALL flagerror(local_error,err,error,*999)
5968  END IF
5969  CASE(problem_stree1d0d_navier_stokes_subtype)
5970  IF(ASSOCIATED(solver%SOLVERS%CONTROL_LOOP%WHILE_LOOP)) THEN
5971  SELECT CASE(solver%GLOBAL_NUMBER)
5972  CASE(1)
5973  ! Characteristic solver- copy branch Q,A values to new parameter set
5974  dependentfield=>solver%SOLVER_EQUATIONS%SOLVER_MAPPING%EQUATIONS_SETS(1)%PTR%DEPENDENT%DEPENDENT_FIELD
5975  CALL field_variable_get(dependentfield,field_u_variable_type,fieldvariable,err,error,*999)
5976  IF(.NOT.ASSOCIATED(fieldvariable%PARAMETER_SETS%SET_TYPE(field_upwind_values_set_type)%PTR)) THEN
5977  CALL field_parameter_set_create(dependentfield,field_u_variable_type, &
5978  & field_upwind_values_set_type,err,error,*999)
5979  END IF
5980  CALL field_parameter_sets_copy(dependentfield,field_u_variable_type,field_values_set_type, &
5981  & field_upwind_values_set_type,1.0_dp,err,error,*999)
5982 
5983  CASE(2)
5984  ! ! 1D Navier-Stokes solver
5985  IF(control_loop%CONTROL_LOOP_LEVEL==3) THEN
5986  ! check characteristic/ N-S convergence at branches
5987  ! CALL NavierStokes_CoupleCharacteristics(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
5988  END IF
5989  CASE DEFAULT
5990  local_error="The solver global number of "//trim(number_to_vstring(solver%GLOBAL_NUMBER,"*",err,error))// &
5991  & " is invalid for the iterative 1D-0D coupled Navier-Stokes problem."
5992  CALL flagerror(local_error,err,error,*999)
5993  END SELECT
5994  ELSE IF(ASSOCIATED(solver%SOLVERS%CONTROL_LOOP%SIMPLE_LOOP)) THEN
5995  IF(solver%GLOBAL_NUMBER == 1) THEN
5996  ! DAE solver- do nothing
5997  ELSE
5998  local_error="The solver global number of "//trim(number_to_vstring(solver%GLOBAL_NUMBER,"*",err,error))// &
5999  & " is invalid for the CellML DAE simple loop of a 1D0D coupled Navier-Stokes problem."
6000  CALL flagerror(local_error,err,error,*999)
6001  END IF
6002  ELSE
6003  local_error="The control loop type for solver "//trim(number_to_vstring(solver%GLOBAL_NUMBER,"*",err,error))// &
6004  & " is invalid for the a 1D0D coupled Navier-Stokes problem."
6005  CALL flagerror(local_error,err,error,*999)
6006  END IF
6007  CASE(problem_transient1d_adv_navier_stokes_subtype)
6008  SELECT CASE(solver%GLOBAL_NUMBER)
6009  CASE(1)
6010  ! Characteristic solver- copy branch Q,A values to new parameter set
6011  dependentfield=>solver%SOLVER_EQUATIONS%SOLVER_MAPPING%EQUATIONS_SETS(1)%PTR%DEPENDENT%DEPENDENT_FIELD
6012  CALL field_variable_get(dependentfield,field_u_variable_type,fieldvariable,err,error,*999)
6013  IF(.NOT.ASSOCIATED(fieldvariable%PARAMETER_SETS%SET_TYPE(field_upwind_values_set_type)%PTR)) THEN
6014  CALL field_parameter_set_create(dependentfield,field_u_variable_type, &
6015  & field_upwind_values_set_type,err,error,*999)
6016  END IF
6017  CALL field_parameter_sets_copy(dependentfield,field_u_variable_type,field_values_set_type, &
6018  & field_upwind_values_set_type,1.0_dp,err,error,*999)
6019  CASE(2)
6020  ! check characteristic/ N-S convergence at branches
6021  ! CALL NavierStokes_CoupleCharacteristics(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
6022  CASE(3)
6023  ! Advection solver output data if necessary
6024  IF(control_loop%WHILE_LOOP%CONTINUE_LOOP .EQV. .false.) THEN
6025  ! 1D NSE solver output data if N-S/Chars converged
6026  CALL navier_stokes_post_solve_output_data(solver,err,error,*999)
6027  END IF
6028  CASE DEFAULT
6029  local_error="The solver global number of "//trim(number_to_vstring(solver%GLOBAL_NUMBER,"*",err,error))// &
6030  & " is invalid for a 1D Navier-Stokes and Advection problem."
6031  CALL flagerror(local_error,err,error,*999)
6032  END SELECT
6033  CASE(problem_coupled1d0d_adv_navier_stokes_subtype)
6034  IF(ASSOCIATED(solver%SOLVERS%CONTROL_LOOP%WHILE_LOOP)) THEN
6035  SELECT CASE(solver%GLOBAL_NUMBER)
6036  CASE(1)
6037  ! Characteristic solver- copy branch Q,A values to new parameter set
6038  dependentfield=>solver%SOLVER_EQUATIONS%SOLVER_MAPPING%EQUATIONS_SETS(1)%PTR%DEPENDENT%DEPENDENT_FIELD
6039  CALL field_variable_get(dependentfield,field_u_variable_type,fieldvariable,err,error,*999)
6040  IF(.NOT.ASSOCIATED(fieldvariable%PARAMETER_SETS%SET_TYPE(field_upwind_values_set_type)%PTR)) THEN
6041  CALL field_parameter_set_create(dependentfield,field_u_variable_type, &
6042  & field_upwind_values_set_type,err,error,*999)
6043  END IF
6044  CALL field_parameter_sets_copy(dependentfield,field_u_variable_type,field_values_set_type, &
6045  & field_upwind_values_set_type,1.0_dp,err,error,*999)
6046  CASE(2)
6047  ! ! 1D Navier-Stokes solver
6048  IF(control_loop%CONTROL_LOOP_LEVEL==3) THEN
6049  ! check characteristic/ N-S convergence at branches
6050  ! CALL NavierStokes_CoupleCharacteristics(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
6051  END IF
6052  CASE DEFAULT
6053  local_error="The solver global number of "//trim(number_to_vstring(solver%GLOBAL_NUMBER,"*",err,error))// &
6054  & " is invalid for the iterative 1D-0D coupled Navier-Stokes problem."
6055  CALL flagerror(local_error,err,error,*999)
6056  END SELECT
6057  ELSE IF(ASSOCIATED(solver%SOLVERS%CONTROL_LOOP%SIMPLE_LOOP)) THEN
6058  ! DAE and advection solvers - output data if post advection solve
6059  IF(solver%SOLVERS%CONTROL_LOOP%SUB_LOOP_INDEX == 3) THEN
6060  CALL navier_stokes_post_solve_output_data(solver,err,error,*999)
6061  END IF
6062  ELSE
6063  local_error="The control loop type for solver "//trim(number_to_vstring(solver%GLOBAL_NUMBER,"*",err,error))// &
6064  & " is invalid for the a 1D0D coupled Navier-Stokes problem."
6065  CALL flagerror(local_error,err,error,*999)
6066  END IF
6067  CASE(problem_stree1d0d_adv_navier_stokes_subtype)
6068  IF(ASSOCIATED(solver%SOLVERS%CONTROL_LOOP%WHILE_LOOP)) THEN
6069  SELECT CASE(solver%GLOBAL_NUMBER)
6070  CASE(1)
6071  ! Characteristic solver- copy branch Q,A values to new parameter set
6072  dependentfield=>solver%SOLVER_EQUATIONS%SOLVER_MAPPING%EQUATIONS_SETS(1)%PTR%DEPENDENT%DEPENDENT_FIELD
6073  CALL field_variable_get(dependentfield,field_u_variable_type,fieldvariable,err,error,*999)
6074  IF(.NOT.ASSOCIATED(fieldvariable%PARAMETER_SETS%SET_TYPE(field_upwind_values_set_type)%PTR)) THEN
6075  CALL field_parameter_set_create(dependentfield,field_u_variable_type, &
6076  & field_upwind_values_set_type,err,error,*999)
6077  END IF
6078  CALL field_parameter_sets_copy(dependentfield,field_u_variable_type,field_values_set_type, &
6079  & field_upwind_values_set_type,1.0_dp,err,error,*999)
6080  CASE(2)
6081  ! ! 1D Navier-Stokes solver
6082  IF(control_loop%CONTROL_LOOP_LEVEL==3) THEN
6083  ! check characteristic/ N-S convergence at branches
6084  ! CALL NavierStokes_CoupleCharacteristics(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
6085  END IF
6086  CASE DEFAULT
6087  local_error="The solver global number of "//trim(number_to_vstring(solver%GLOBAL_NUMBER,"*",err,error))// &
6088  & " is invalid for the iterative 1D-0D coupled Navier-Stokes problem."
6089  CALL flagerror(local_error,err,error,*999)
6090  END SELECT
6091  ELSE IF(ASSOCIATED(solver%SOLVERS%CONTROL_LOOP%SIMPLE_LOOP)) THEN
6092  ! DAE and advection solvers - output data if post advection solve
6093  IF(solver%SOLVERS%CONTROL_LOOP%SUB_LOOP_INDEX == 3) THEN
6094  CALL navier_stokes_post_solve_output_data(solver,err,error,*999)
6095  END IF
6096  ELSE
6097  local_error="The control loop type for solver "//trim(number_to_vstring(solver%GLOBAL_NUMBER,"*",err,error))// &
6098  & " is invalid for the a 1D0D coupled Navier-Stokes problem."
6099  CALL flagerror(local_error,err,error,*999)
6100  END IF
6101  CASE(problem_transient_rbs_navier_stokes_subtype)
6102  CALL control_loop_times_get(control_loop,starttime,stoptime,currenttime,timeincrement, &
6103  & timestep,outputiteration,err,error,*999)
6104  CALL navierstokes_calculateboundaryflux(solver,err,error,*999)
6105  CALL navier_stokes_post_solve_output_data(solver,err,error,*999)
6106  CASE(problem_multiscale_navier_stokes_subtype)
6107  CALL navierstokes_calculateboundaryflux(solver,err,error,*999)
6108  CALL navier_stokes_post_solve_output_data(solver,err,error,*999)
6109  DO equationssetnumber=1,solver%SOLVER_EQUATIONS%SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS
6110  ! If this is a coupled constitutive (non-Newtonian) viscosity problem, update shear rate values
6111  ! to be passed to the CellML solver at beginning of next timestep
6112  IF(solver%SOLVER_EQUATIONS%SOLVER_MAPPING%EQUATIONS_SETS(equationssetnumber)%PTR% &
6113  & equations%EQUATIONS_SET%specification(3)==equations_set_constitutive_mu_navier_stokes_subtype) THEN
6114  CALL navierstokes_shearratecalculate(solver%SOLVER_EQUATIONS%SOLVER_MAPPING% &
6115  & equations_sets(equationssetnumber)%PTR%EQUATIONS%EQUATIONS_SET,err,error,*999)
6116  END IF
6117  END DO
6118  CASE(problem_ale_navier_stokes_subtype)
6119  !Post solve for the linear solver
6120  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
6121  CALL write_string(general_output_type,"Mesh movement post solve... ",err,error,*999)
6122  CALL solvers_solver_get(solver%SOLVERS,2,solver2,err,error,*999)
6123  IF(ASSOCIATED(solver2%DYNAMIC_SOLVER)) THEN
6124  solver2%DYNAMIC_SOLVER%ALE=.true.
6125  ELSE
6126  CALL flagerror("Dynamic solver is not associated for ALE problem.",err,error,*999)
6127  END IF
6128  !Post solve for the dynamic solver
6129  ELSE IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
6130  CALL write_string(general_output_type,"ALE Navier-Stokes post solve... ",err,error,*999)
6131  CALL navier_stokes_post_solve_output_data(solver,err,error,*999)
6132  END IF
6133  CASE DEFAULT
6134  local_error="The third problem specification of "// &
6135  & trim(number_to_vstring(control_loop%PROBLEM%specification(3),"*",err,error))// &
6136  & " is not valid for a Navier-Stokes fluid mechanics problem."
6137  CALL flagerror(local_error,err,error,*999)
6138  END SELECT
6139  ELSE
6140  CALL flagerror("Problem is not associated.",err,error,*999)
6141  END IF
6142  ELSE
6143  CALL flagerror("Control loop is not associated.",err,error,*999)
6144  END IF
6145  ELSE
6146  CALL flagerror("Solvers is not associated.",err,error,*999)
6147  END IF
6148  ELSE
6149  CALL flagerror("Solver is not associated.",err,error,*999)
6150  END IF
6151 
6152  exits("NAVIER_STOKES_POST_SOLVE")
6153  RETURN
6154 999 errorsexits("NAVIER_STOKES_POST_SOLVE",err,error)
6155  RETURN 1
6156  END SUBROUTINE navier_stokes_post_solve
6157 
6158  !
6159  !================================================================================================================================
6160  !
6161 
6163  SUBROUTINE navierstokes_presolveupdateboundaryconditions(SOLVER,ERR,ERROR,*)
6164 
6165  !Argument variables
6166  TYPE(solver_type), POINTER :: SOLVER
6167  INTEGER(INTG), INTENT(OUT) :: ERR
6168  TYPE(varying_string), INTENT(OUT) :: ERROR
6169  !Local Variables
6170  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
6171  TYPE(boundary_conditions_variable_type), POINTER :: BOUNDARY_CONDITIONS_VARIABLE
6172  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
6173  TYPE(domain_type), POINTER :: DOMAIN
6174  TYPE(domain_nodes_type), POINTER :: DOMAIN_NODES
6175  TYPE(equations_set_type), POINTER :: EQUATIONS_SET,SOLID_EQUATIONS_SET,FLUID_EQUATIONS_SET
6176  TYPE(equations_set_dependent_type), POINTER :: SOLID_DEPENDENT
6177  TYPE(equations_set_geometry_type), POINTER :: FLUID_GEOMETRIC
6178  TYPE(equations_type), POINTER :: EQUATIONS,SOLID_EQUATIONS,FLUID_EQUATIONS
6179  TYPE(field_interpolated_point_ptr_type), POINTER :: INTERPOLATED_POINT(:)
6180  TYPE(field_interpolation_parameters_ptr_type), POINTER :: INTERPOLATION_PARAMETERS(:)
6181  TYPE(field_type), POINTER :: ANALYTIC_FIELD,DEPENDENT_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD
6182  TYPE(field_type), POINTER :: INDEPENDENT_FIELD,SOLID_DEPENDENT_FIELD,FLUID_GEOMETRIC_FIELD
6183  TYPE(field_variable_type), POINTER :: ANALYTIC_VARIABLE,FIELD_VARIABLE,GEOMETRIC_VARIABLE,MATERIALS_VARIABLE
6184  TYPE(field_variable_type), POINTER :: dependentFieldVariable,independentFieldVariable
6185  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS,SOLID_SOLVER_EQUATIONS,FLUID_SOLVER_EQUATIONS
6186  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING,SOLID_SOLVER_MAPPING,FLUID_SOLVER_MAPPING
6187  TYPE(solver_type), POINTER :: Solver2
6188  TYPE(solvers_type), POINTER :: SOLVERS
6189  TYPE(varying_string) :: LOCAL_ERROR
6190  INTEGER(INTG) :: nodeIdx,derivativeIdx,versionIdx,variableIdx,numberOfSourceTimesteps,timeIdx,componentIdx
6191  INTEGER(INTG) :: NUMBER_OF_DIMENSIONS,BOUNDARY_CONDITION_CHECK_VARIABLE,GLOBAL_DERIV_INDEX,node_idx,variable_type
6192  INTEGER(INTG) :: variable_idx,local_ny,ANALYTIC_FUNCTION_TYPE,component_idx,deriv_idx,dim_idx,version_idx
6193  INTEGER(INTG) :: element_idx,en_idx,I,J,K,number_of_nodes_xic(3),search_idx,localDof,globalDof,componentBC,previousNodeNumber
6194  INTEGER(INTG) :: componentNumberVelocity,numberOfDimensions,numberOfNodes,numberOfGlobalNodes,currentLoopIteration
6195  INTEGER(INTG) :: dependentVariableType,independentVariableType,dependentDof,independentDof,userNodeNumber,localNodeNumber
6196  INTEGER(INTG) :: EquationsSetIndex,SolidNodeNumber,FluidNodeNumber
6197  INTEGER(INTG), ALLOCATABLE :: InletNodes(:)
6198  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT,DISPLACEMENT_VALUE,VALUE,XI_COORDINATES(3),timeData,QP,QPP,componentValues(3)
6199  REAL(DP) :: T_COORDINATES(20,3),MU_PARAM,RHO_PARAM,X(3),FluidGFValue,SolidDFValue,NewLaplaceBoundaryValue,Lref,Tref,Mref
6200  REAL(DP), POINTER :: MESH_VELOCITY_VALUES(:), GEOMETRIC_PARAMETERS(:), BOUNDARY_VALUES(:)
6201  REAL(DP), POINTER :: TANGENTS(:,:),NORMAL(:),TIME,ANALYTIC_PARAMETERS(:),MATERIALS_PARAMETERS(:)
6202  REAL(DP), POINTER :: independentParameters(:),dependentParameters(:)
6203  REAL(DP), ALLOCATABLE :: nodeData(:,:),qSpline(:),qValues(:),tValues(:),BoundaryValues(:)
6204  LOGICAL :: ghostNode,nodeExists,importDataFromFile,ALENavierStokesEquationsSetFound=.false.
6205  LOGICAL :: SolidEquationsSetFound=.false.,solidnodefound=.false.,fluidequationssetfound=.false.
6206  CHARACTER(70) :: inputFile,tempString
6207 
6208  NULLIFY(solver_equations)
6209  NULLIFY(solver_mapping)
6210  NULLIFY(equations_set)
6211  NULLIFY(equations)
6212  NULLIFY(boundary_conditions_variable)
6213  NULLIFY(boundary_conditions)
6214  NULLIFY(analytic_field)
6215  NULLIFY(dependent_field)
6216  NULLIFY(geometric_field)
6217  NULLIFY(materials_field)
6218  NULLIFY(independent_field)
6219  NULLIFY(analytic_variable)
6220  NULLIFY(field_variable)
6221  NULLIFY(geometric_variable)
6222  NULLIFY(materials_variable)
6223  NULLIFY(domain)
6224  NULLIFY(domain_nodes)
6225  NULLIFY(interpolated_point)
6226  NULLIFY(interpolation_parameters)
6227  NULLIFY(mesh_velocity_values)
6228  NULLIFY(geometric_parameters)
6229  NULLIFY(boundary_values)
6230  NULLIFY(tangents)
6231  NULLIFY(normal)
6232  NULLIFY(time)
6233  NULLIFY(analytic_parameters)
6234  NULLIFY(materials_parameters)
6235  NULLIFY(independentparameters)
6236  NULLIFY(dependentparameters)
6237 
6238  enters("NavierStokes_PreSolveUpdateBoundaryConditions",err,error,*999)
6239 
6240  IF(ASSOCIATED(solver)) THEN
6241  solvers=>solver%SOLVERS
6242  IF(ASSOCIATED(solvers)) THEN
6243  control_loop=>solvers%CONTROL_LOOP
6244  CALL control_loop_current_times_get(control_loop,current_time,time_increment,err,error,*999)
6245  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
6246  IF(.NOT.ALLOCATED(control_loop%problem%specification)) THEN
6247  CALL flagerror("Problem specification array is not allocated.",err,error,*999)
6248  ELSE IF(SIZE(control_loop%problem%specification,1)<3) THEN
6249  CALL flagerror("Problem specification must have three entries for a Navier-Stokes problem.",err,error,*999)
6250  END IF
6251  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(1))
6252  CASE(problem_fluid_mechanics_class)
6253  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
6254  CASE(problem_laplace_navier_stokes_subtype)
6255  ! do nothing ???
6256  CASE(problem_static_navier_stokes_subtype, &
6257  & problem_transient_navier_stokes_subtype, &
6258  & problem_transient_rbs_navier_stokes_subtype, &
6259  & problem_multiscale_navier_stokes_subtype)
6260  solver_equations=>solver%SOLVER_EQUATIONS
6261  IF(ASSOCIATED(solver_equations)) THEN
6262  solver_mapping=>solver_equations%SOLVER_MAPPING
6263  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
6264  IF(ASSOCIATED(equations)) THEN
6265  equations_set=>equations%EQUATIONS_SET
6266 
6267  ! Fitting boundary condition- get values from file
6268  ! TODO: this should be generalised with input filenames specified from the example file when IO is improved
6269  IF(ASSOCIATED(equations_set%INDEPENDENT)) THEN
6270  !Read in field values to independent field
6271  NULLIFY(independentfieldvariable)
6272  NULLIFY(dependentfieldvariable)
6273  independent_field=>equations_set%INDEPENDENT%INDEPENDENT_FIELD
6274  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
6275  independentvariabletype=independent_field%VARIABLES(1)%VARIABLE_TYPE
6276  CALL field_variable_get(independent_field,field_u_variable_type,independentfieldvariable,err,error,*999)
6277  dependentvariabletype=dependent_field%VARIABLES(1)%VARIABLE_TYPE
6278  CALL field_variable_get(dependent_field,field_u_variable_type,dependentfieldvariable,err,error,*999)
6279  CALL boundary_conditions_variable_get(solver_equations%BOUNDARY_CONDITIONS, &
6280  & dependentfieldvariable,boundary_conditions_variable,err,error,*999)
6281  !Read in field data from file
6282  !Loop over nodes and update independent field values - if a fixed fitted boundary, also update dependent
6283  IF(ASSOCIATED(independent_field)) THEN
6284  componentnumbervelocity = 1
6285  numberofdimensions = dependentfieldvariable%NUMBER_OF_COMPONENTS - 1
6286  ! Get the nodes on this computational domain
6287  IF(independentfieldvariable%COMPONENTS(componentnumbervelocity)%INTERPOLATION_TYPE== &
6288  & field_node_based_interpolation) THEN
6289  domain=>independentfieldvariable%COMPONENTS(componentnumbervelocity)%DOMAIN
6290  IF(ASSOCIATED(domain)) THEN
6291  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
6292  domain_nodes=>domain%TOPOLOGY%NODES
6293  IF(ASSOCIATED(domain_nodes)) THEN
6294  numberofnodes = domain_nodes%NUMBER_OF_NODES
6295  numberofglobalnodes = domain_nodes%NUMBER_OF_GLOBAL_NODES
6296  ELSE
6297  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
6298  END IF
6299  ELSE
6300  CALL flagerror("Domain topology is not associated.",err,error,*999)
6301  END IF
6302  ELSE
6303  CALL flagerror("Domain is not associated.",err,error,*999)
6304  END IF
6305  ELSE
6306  CALL flagerror("Only node based interpolation is implemented.",err,error,*999)
6307  END IF
6308 
6309  ! Construct the filename based on the computational node and time step
6310  currentloopiteration=control_loop%TIME_LOOP%ITERATION_NUMBER
6311  WRITE(tempstring,"(I4.4)") currentloopiteration
6312  inputfile = './../interpolatedData/fitData' // tempstring(1:4) // '.dat'
6313 
6314  INQUIRE(file=inputfile, exist=importdatafromfile)
6315  IF(importdatafromfile) THEN
6316  !Read fitted data from input file (if exists)
6317  CALL write_string(general_output_type,"Updating independent field and boundary nodes from "//inputfile, &
6318  & err,error,*999)
6319  OPEN(unit=10, file=inputfile, status='OLD')
6320  !Loop over local nodes and update independent field and (and dependent field for any FIXED_FITTED nodes)
6321  previousnodenumber=0
6322  DO nodeidx=1,numberofnodes
6323  usernodenumber=domain_nodes%NODES(nodeidx)%USER_NUMBER
6324  CALL domain_topology_node_check_exists(domain%Topology,usernodenumber,nodeexists,localnodenumber, &
6325  & ghostnode,err,error,*999)
6326  IF(nodeexists .AND. .NOT. ghostnode) THEN
6327  ! Move to line in file for this node (dummy read)
6328  ! NOTE: this takes advantage of the user number increasing ordering of domain nodes
6329  DO search_idx=1,usernodenumber-previousnodenumber-1
6330  READ(10,*)
6331  END DO
6332  ! Read in the node data for this timestep file
6333  READ(10,*) (componentvalues(componentidx), componentidx=1,numberofdimensions)
6334  DO componentidx=1,numberofdimensions
6335  dependentdof = dependentfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
6336  & nodes(nodeidx)%DERIVATIVES(1)%VERSIONS(1)
6337  independentdof = independentfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP% &
6338  & node_param2dof_map%NODES(nodeidx)%DERIVATIVES(1)%VERSIONS(1)
6339  VALUE = componentvalues(componentidx)
6340  CALL field_parameter_set_update_local_dof(independent_field,independentvariabletype, &
6341  & field_values_set_type,independentdof,VALUE,err,error,*999)
6342  CALL field_component_dof_get_user_node(dependent_field,dependentvariabletype,1,1,usernodenumber, &
6343  & componentidx,localdof,globaldof,err,error,*999)
6344  boundary_condition_check_variable=boundary_conditions_variable%CONDITION_TYPES(globaldof)
6345  IF(boundary_condition_check_variable==boundary_condition_fixed_fitted) THEN
6346  CALL field_parameter_set_update_local_dof(dependent_field,dependentvariabletype, &
6347  & field_values_set_type,localdof,VALUE,err,error,*999)
6348  END IF
6349  END DO !componentIdx
6350  previousnodenumber=usernodenumber
6351  END IF ! ghost/exist check
6352  END DO !nodeIdx
6353  CLOSE(unit=10)
6354  END IF !check import file exists
6355  ELSE
6356  CALL flagerror("Equations set independent field is not associated.",err,error,*999)
6357  END IF
6358  END IF !Equations set independent
6359 
6360  ! Analytic equations
6361  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
6362  !Standard analytic functions
6363  IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_sinusoid) THEN
6364  ! Update analytic time value with current time
6365  equations_set%ANALYTIC%ANALYTIC_TIME=current_time
6366  !Calculate analytic values
6367  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
6368  IF(ASSOCIATED(boundary_conditions)) THEN
6369  CALL navierstokes_boundaryconditionsanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
6370  END IF
6371  ELSE IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE== &
6372  & equations_set_navier_stokes_equation_two_dim_taylor_green.OR. &
6373  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_two_dim_poiseuille) THEN
6374  IF(ASSOCIATED(equations_set)) THEN
6375  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
6376  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
6377  IF(ASSOCIATED(dependent_field)) THEN
6378  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
6379  IF(ASSOCIATED(geometric_field)) THEN
6380  ! Geometric parameters
6381  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err, &
6382  & error,*999)
6383  NULLIFY(geometric_variable)
6384  NULLIFY(geometric_parameters)
6385  CALL field_variable_get(geometric_field,field_u_variable_type,geometric_variable,err,error,*999)
6386  CALL field_parameter_set_data_get(geometric_field,field_u_variable_type,field_values_set_type, &
6387  & geometric_parameters,err,error,*999)
6388  ! Analytic parameters
6389  analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
6390  NULLIFY(analytic_variable)
6391  NULLIFY(analytic_parameters)
6392  IF(ASSOCIATED(analytic_field)) THEN
6393  CALL field_variable_get(analytic_field,field_u_variable_type,analytic_variable,err,error,*999)
6394  CALL field_parameter_set_data_get(analytic_field,field_u_variable_type,field_values_set_type, &
6395  & analytic_parameters,err,error,*999)
6396  END IF
6397  ! Materials parameters
6398  NULLIFY(materials_field)
6399  NULLIFY(materials_variable)
6400  NULLIFY(materials_parameters)
6401  IF(ASSOCIATED(equations_set%MATERIALS)) THEN
6402  materials_field=>equations_set%MATERIALS%MATERIALS_FIELD
6403  CALL field_variable_get(materials_field,field_u_variable_type,materials_variable,err,error,*999)
6404  CALL field_parameter_set_data_get(materials_field,field_u_variable_type,field_values_set_type, &
6405  & materials_parameters,err,error,*999)
6406  END IF
6407  DO variable_idx=1,dependent_field%NUMBER_OF_VARIABLES
6408  variable_type=dependent_field%VARIABLES(variable_idx)%VARIABLE_TYPE
6409  field_variable=>dependent_field%VARIABLE_TYPE_MAP(variable_type)%PTR
6410  IF(ASSOCIATED(field_variable)) THEN
6411  CALL field_parametersetensurecreated(dependent_field,variable_type, &
6412  & field_analytic_values_set_type,err,error,*999)
6413  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
6414  IF(field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE== &
6415  & field_node_based_interpolation) THEN
6416  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
6417  IF(ASSOCIATED(domain)) THEN
6418  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
6419  domain_nodes=>domain%TOPOLOGY%NODES
6420  IF(ASSOCIATED(domain_nodes)) THEN
6421  !Should be replaced by boundary node flag
6422  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
6423  DO dim_idx=1,number_of_dimensions
6424  !Default to version 1 of each node derivative
6425  local_ny=geometric_variable%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP% &
6426  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(1)%VERSIONS(1)
6427  x(dim_idx)=geometric_parameters(local_ny)
6428  END DO !dim_idx
6429 
6430  !Loop over the derivatives
6431  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
6432  analytic_function_type=equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE
6433  global_deriv_index=domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)% &
6434  & global_derivative_index
6435  CALL navier_stokes_analytic_functions_evaluate(analytic_function_type,x, &
6436  & current_time,variable_type,global_deriv_index,componentidx, &
6437  & number_of_dimensions,field_variable%NUMBER_OF_COMPONENTS,analytic_parameters, &
6438  & materials_parameters,VALUE,err,error,*999)
6439  DO version_idx=1, &
6440  & domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)%numberOfVersions
6441  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
6442  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)% &
6443  & versions(version_idx)
6444  ! Set analytic values
6445  CALL field_parameter_set_update_local_dof(dependent_field,variable_type, &
6446  & field_analytic_values_set_type,local_ny,VALUE,err,error,*999)
6447  CALL boundary_conditions_variable_get(solver_equations%BOUNDARY_CONDITIONS, &
6448  & dependent_field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR, &
6449  & boundary_conditions_variable,err,error,*999)
6450  IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE== &
6451  & equations_set_navier_stokes_equation_two_dim_taylor_green) THEN
6452  !Taylor-Green boundary conditions update
6453  IF(ASSOCIATED(boundary_conditions_variable)) THEN
6454  boundary_condition_check_variable=boundary_conditions_variable% &
6455  & condition_types(local_ny)
6456  IF(boundary_condition_check_variable==boundary_condition_fixed .AND. &
6457  & component_idx<field_variable%NUMBER_OF_COMPONENTS) THEN
6458  CALL field_parameter_set_update_local_dof(dependent_field, &
6459  & variable_type,field_values_set_type,local_ny, &
6460  & VALUE,err,error,*999)
6461  END IF !Boundary condition fixed
6462  END IF !Boundary condition variable
6463  END IF ! Taylor-Green
6464  END DO !version_idx
6465  END DO !deriv_idx
6466  END DO !node_idx
6467  ELSE
6468  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
6469  END IF
6470  ELSE
6471  CALL flagerror("Domain topology is not associated.",err,error,*999)
6472  END IF
6473  ELSE
6474  CALL flagerror("Domain is not associated.",err,error,*999)
6475  END IF
6476  ELSE
6477  CALL flagerror("Only node based interpolation is implemented.",err,error,*999)
6478  END IF
6479  END DO !component_idx
6480  CALL field_parameter_set_update_start(dependent_field,variable_type, &
6481  & field_analytic_values_set_type,err,error,*999)
6482  CALL field_parameter_set_update_finish(dependent_field,variable_type, &
6483  & field_analytic_values_set_type,err,error,*999)
6484  CALL field_parameter_set_update_start(dependent_field,variable_type, &
6485  & field_values_set_type,err,error,*999)
6486  CALL field_parameter_set_update_finish(dependent_field,variable_type, &
6487  & field_values_set_type,err,error,*999)
6488  ELSE
6489  CALL flagerror("Field variable is not associated.",err,error,*999)
6490  END IF
6491  END DO !variable_idx
6492  CALL field_parameter_set_data_restore(geometric_field,field_u_variable_type,&
6493  & field_values_set_type,geometric_parameters,err,error,*999)
6494  ELSE
6495  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
6496  END IF
6497  ELSE
6498  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
6499  END IF
6500  ELSE
6501  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
6502  END IF
6503  ELSE
6504  CALL flagerror("Equations set is not associated.",err,error,*999)
6505  END IF
6506  ! Unit shape analytic functions
6507  ELSE IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_two_dim_4 .OR. &
6508  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_two_dim_5 .OR. &
6509  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_three_dim_4 .OR. &
6510  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_three_dim_5 .OR. &
6511  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_three_dim_1) THEN
6512  IF(ASSOCIATED(equations_set)) THEN
6513  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
6514  IF(ASSOCIATED(dependent_field)) THEN
6515  geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
6516  IF(ASSOCIATED(geometric_field)) THEN
6517  ! Geometric parameters
6518  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions, &
6519  & err,error,*999)
6520  NULLIFY(geometric_variable)
6521  CALL field_variable_get(geometric_field,field_u_variable_type,geometric_variable,err,error,*999)
6522  NULLIFY(geometric_parameters)
6523  CALL field_parameter_set_data_get(geometric_field,field_u_variable_type,field_values_set_type, &
6524  & geometric_parameters,err,error,*999)
6525  ! Analytic parameters
6526  analytic_function_type=equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE
6527  analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
6528  NULLIFY(analytic_variable)
6529  NULLIFY(analytic_parameters)
6530  IF(ASSOCIATED(analytic_field)) THEN
6531  CALL field_variable_get(analytic_field,field_u_variable_type,analytic_variable,err,error,*999)
6532  CALL field_parameter_set_data_get(analytic_field,field_u_variable_type,field_values_set_type, &
6533  & analytic_parameters,err,error,*999)
6534  END IF
6535  ! Materials parameters
6536  NULLIFY(materials_field)
6537  NULLIFY(materials_variable)
6538  NULLIFY(materials_parameters)
6539  IF(ASSOCIATED(equations_set%MATERIALS)) THEN
6540  materials_field=>equations_set%MATERIALS%MATERIALS_FIELD
6541  CALL field_variable_get(materials_field,field_u_variable_type,materials_variable,err,error,*999)
6542  CALL field_parameter_set_data_get(materials_field,field_u_variable_type,field_values_set_type, &
6543  & materials_parameters,err,error,*999)
6544  END IF
6545  time=equations_set%ANALYTIC%ANALYTIC_TIME
6546  ! Interpolation parameters
6547  NULLIFY(interpolation_parameters)
6548  CALL field_interpolation_parameters_initialise(geometric_field,interpolation_parameters,err,error,*999)
6549  NULLIFY(interpolated_point)
6550  CALL field_interpolated_points_initialise(interpolation_parameters,interpolated_point,err,error,*999)
6551  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions, &
6552  & err,error,*999)
6553  DO variable_idx=1,dependent_field%NUMBER_OF_VARIABLES
6554  variable_type=dependent_field%VARIABLES(variable_idx)%VARIABLE_TYPE
6555  field_variable=>dependent_field%VARIABLE_TYPE_MAP(variable_type)%PTR
6556  IF(ASSOCIATED(field_variable)) THEN
6557  DO componentidx=1,field_variable%NUMBER_OF_COMPONENTS
6558  IF(field_variable%COMPONENTS(componentidx)%INTERPOLATION_TYPE== &
6559  & field_node_based_interpolation) THEN
6560  domain=>field_variable%COMPONENTS(componentidx)%DOMAIN
6561  IF(ASSOCIATED(domain)) THEN
6562  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
6563  domain_nodes=>domain%TOPOLOGY%NODES
6564  IF(ASSOCIATED(domain_nodes)) THEN
6565  !Should be replaced by boundary node flag
6566  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
6567  element_idx=domain%topology%nodes%nodes(node_idx)%surrounding_elements(1)
6568  CALL field_interpolation_parameters_element_get(field_values_set_type,element_idx, &
6569  & interpolation_parameters(field_u_variable_type)%PTR,err,error,*999)
6570  en_idx=0
6571  xi_coordinates=0.0_dp
6572  number_of_nodes_xic(1)=domain%topology%elements%elements(element_idx)% &
6573  & basis%number_of_nodes_xic(1)
6574  number_of_nodes_xic(2)=domain%topology%elements%elements(element_idx)% &
6575  & basis%number_of_nodes_xic(2)
6576  IF(number_of_dimensions==3) THEN
6577  number_of_nodes_xic(3)=domain%topology%elements%elements(element_idx)%basis% &
6578  & number_of_nodes_xic(3)
6579  ELSE
6580  number_of_nodes_xic(3)=1
6581  END IF
6582 !\todo: change definitions as soon as adjacent elements / boundary elements calculation works for simplex
6583  IF(domain%topology%elements%maximum_number_of_element_parameters==4 .OR. &
6584  & domain%topology%elements%maximum_number_of_element_parameters==9 .OR. &
6585  & domain%topology%elements%maximum_number_of_element_parameters==16 .OR. &
6586  & domain%topology%elements%maximum_number_of_element_parameters==8 .OR. &
6587  & domain%topology%elements%maximum_number_of_element_parameters==27 .OR. &
6588  & domain%topology%elements%maximum_number_of_element_parameters==64) THEN
6589  DO k=1,number_of_nodes_xic(3)
6590  DO j=1,number_of_nodes_xic(2)
6591  DO i=1,number_of_nodes_xic(1)
6592  en_idx=en_idx+1
6593  IF(domain%topology%elements%elements(element_idx)% &
6594  & element_nodes(en_idx)==node_idx) EXIT
6595  xi_coordinates(1)=xi_coordinates(1)+(1.0_dp/(number_of_nodes_xic(1)-1))
6596  END DO !I
6597  IF(domain%topology%elements%elements(element_idx)% &
6598  & element_nodes(en_idx)==node_idx) EXIT
6599  xi_coordinates(1)=0.0_dp
6600  xi_coordinates(2)=xi_coordinates(2)+(1.0_dp/(number_of_nodes_xic(2)-1))
6601  END DO !J
6602  IF(domain%topology%elements%elements(element_idx)% &
6603  & element_nodes(en_idx)==node_idx) EXIT
6604  xi_coordinates(1)=0.0_dp
6605  xi_coordinates(2)=0.0_dp
6606  IF(number_of_nodes_xic(3)/=1) THEN
6607  xi_coordinates(3)=xi_coordinates(3)+(1.0_dp/(number_of_nodes_xic(3)-1))
6608  END IF
6609  END DO !K
6610  CALL field_interpolate_xi(no_part_deriv,xi_coordinates, &
6611  & interpolated_point(field_u_variable_type)%PTR,err,error,*999)
6612  ELSE
6613  !\todo: Use boundary flag
6614  IF(domain%topology%elements%maximum_number_of_element_parameters==3) THEN
6615  t_coordinates(1,1:2)=[0.0_dp,1.0_dp]
6616  t_coordinates(2,1:2)=[1.0_dp,0.0_dp]
6617  t_coordinates(3,1:2)=[1.0_dp,1.0_dp]
6618  ELSE IF(domain%topology%elements%maximum_number_of_element_parameters==6) THEN
6619  t_coordinates(1,1:2)=[0.0_dp,1.0_dp]
6620  t_coordinates(2,1:2)=[1.0_dp,0.0_dp]
6621  t_coordinates(3,1:2)=[1.0_dp,1.0_dp]
6622  t_coordinates(4,1:2)=[0.5_dp,0.5_dp]
6623  t_coordinates(5,1:2)=[1.0_dp,0.5_dp]
6624  t_coordinates(6,1:2)=[0.5_dp,1.0_dp]
6625  ELSE IF(domain%topology%elements%maximum_number_of_element_parameters==10.AND. &
6626  & number_of_dimensions==2) THEN
6627  t_coordinates(1,1:2)=[0.0_dp,1.0_dp]
6628  t_coordinates(2,1:2)=[1.0_dp,0.0_dp]
6629  t_coordinates(3,1:2)=[1.0_dp,1.0_dp]
6630  t_coordinates(4,1:2)=[1.0_dp/3.0_dp,2.0_dp/3.0_dp]
6631  t_coordinates(5,1:2)=[2.0_dp/3.0_dp,1.0_dp/3.0_dp]
6632  t_coordinates(6,1:2)=[1.0_dp,1.0_dp/3.0_dp]
6633  t_coordinates(7,1:2)=[1.0_dp,2.0_dp/3.0_dp]
6634  t_coordinates(8,1:2)=[2.0_dp/3.0_dp,1.0_dp]
6635  t_coordinates(9,1:2)=[1.0_dp/3.0_dp,1.0_dp]
6636  t_coordinates(10,1:2)=[2.0_dp/3.0_dp,2.0_dp/3.0_dp]
6637  ELSE IF(domain%topology%elements%maximum_number_of_element_parameters==4) THEN
6638  t_coordinates(1,1:3)=[0.0_dp,1.0_dp,1.0_dp]
6639  t_coordinates(2,1:3)=[1.0_dp,0.0_dp,1.0_dp]
6640  t_coordinates(3,1:3)=[1.0_dp,1.0_dp,0.0_dp]
6641  t_coordinates(4,1:3)=[1.0_dp,1.0_dp,1.0_dp]
6642  ELSE IF(domain%topology%elements%maximum_number_of_element_parameters==10.AND. &
6643  & number_of_dimensions==3) THEN
6644  t_coordinates(1,1:3)=[0.0_dp,1.0_dp,1.0_dp]
6645  t_coordinates(2,1:3)=[1.0_dp,0.0_dp,1.0_dp]
6646  t_coordinates(3,1:3)=[1.0_dp,1.0_dp,0.0_dp]
6647  t_coordinates(4,1:3)=[1.0_dp,1.0_dp,1.0_dp]
6648  t_coordinates(5,1:3)=[0.5_dp,0.5_dp,1.0_dp]
6649  t_coordinates(6,1:3)=[0.5_dp,1.0_dp,0.5_dp]
6650  t_coordinates(7,1:3)=[0.5_dp,1.0_dp,1.0_dp]
6651  t_coordinates(8,1:3)=[1.0_dp,0.5_dp,0.5_dp]
6652  t_coordinates(9,1:3)=[1.0_dp,1.0_dp,0.5_dp]
6653  t_coordinates(10,1:3)=[1.0_dp,0.5_dp,1.0_dp]
6654  ELSE IF(domain%topology%elements%maximum_number_of_element_parameters==20) THEN
6655  t_coordinates(1,1:3)=[0.0_dp,1.0_dp,1.0_dp]
6656  t_coordinates(2,1:3)=[1.0_dp,0.0_dp,1.0_dp]
6657  t_coordinates(3,1:3)=[1.0_dp,1.0_dp,0.0_dp]
6658  t_coordinates(4,1:3)=[1.0_dp,1.0_dp,1.0_dp]
6659  t_coordinates(5,1:3)=[1.0_dp/3.0_dp,2.0_dp/3.0_dp,1.0_dp]
6660  t_coordinates(6,1:3)=[2.0_dp/3.0_dp,1.0_dp/3.0_dp,1.0_dp]
6661  t_coordinates(7,1:3)=[1.0_dp/3.0_dp,1.0_dp,2.0_dp/3.0_dp]
6662  t_coordinates(8,1:3)=[2.0_dp/3.0_dp,1.0_dp,1.0_dp/3.0_dp]
6663  t_coordinates(9,1:3)=[1.0_dp/3.0_dp,1.0_dp,1.0_dp]
6664  t_coordinates(10,1:3)=[2.0_dp/3.0_dp,1.0_dp,1.0_dp]
6665  t_coordinates(11,1:3)=[1.0_dp,1.0_dp/3.0_dp,2.0_dp/3.0_dp]
6666  t_coordinates(12,1:3)=[1.0_dp,2.0_dp/3.0_dp,1.0_dp/3.0_dp]
6667  t_coordinates(13,1:3)=[1.0_dp,1.0_dp,1.0_dp/3.0_dp]
6668  t_coordinates(14,1:3)=[1.0_dp,1.0_dp,2.0_dp/3.0_dp]
6669  t_coordinates(15,1:3)=[1.0_dp,1.0_dp/3.0_dp,1.0_dp]
6670  t_coordinates(16,1:3)=[1.0_dp,2.0_dp/3.0_dp,1.0_dp]
6671  t_coordinates(17,1:3)=[2.0_dp/3.0_dp,2.0_dp/3.0_dp,2.0_dp/3.0_dp]
6672  t_coordinates(18,1:3)=[2.0_dp/3.0_dp,2.0_dp/3.0_dp,1.0_dp]
6673  t_coordinates(19,1:3)=[2.0_dp/3.0_dp,1.0_dp,2.0_dp/3.0_dp]
6674  t_coordinates(20,1:3)=[1.0_dp,2.0_dp/3.0_dp,2.0_dp/3.0_dp]
6675  END IF
6676  DO k=1,domain%topology%elements%maximum_number_of_element_parameters
6677  IF(domain%topology%elements%elements(element_idx)%element_nodes(k)==node_idx) EXIT
6678  END DO !K
6679  IF(number_of_dimensions==2) THEN
6680  CALL field_interpolate_xi(no_part_deriv,t_coordinates(k,1:2), &
6681  & interpolated_point(field_u_variable_type)%PTR,err,error,*999)
6682  ELSE IF(number_of_dimensions==3) THEN
6683  CALL field_interpolate_xi(no_part_deriv,t_coordinates(k,1:3), &
6684  & interpolated_point(field_u_variable_type)%PTR,err,error,*999)
6685  END IF
6686  END IF
6687  x=0.0_dp
6688  DO dim_idx=1,number_of_dimensions
6689  x(dim_idx)=interpolated_point(field_u_variable_type)%PTR%VALUES(dim_idx,1)
6690  END DO !dim_idx
6691  !Loop over the derivatives
6692  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
6693  analytic_function_type=equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE
6694  global_deriv_index=domain_nodes%NODES(node_idx)%DERIVATIVES(deriv_idx)% &
6695  & global_derivative_index
6696  materials_field=>equations_set%MATERIALS%MATERIALS_FIELD
6697  !Define MU_PARAM, density=1
6698  mu_param=materials_field%variables(1)%parameter_sets%parameter_sets(1)%ptr% &
6699  & parameters%cmiss%data_dp(1)
6700  !Define RHO_PARAM, density=2
6701  rho_param=materials_field%variables(1)%parameter_sets%parameter_sets(1)%ptr% &
6702  & parameters%cmiss%data_dp(2)
6703  CALL navier_stokes_analytic_functions_evaluate(analytic_function_type,x, &
6704  & current_time,variable_type,global_deriv_index,componentidx,number_of_dimensions,&
6705  & field_variable%NUMBER_OF_COMPONENTS,analytic_parameters, &
6706  & materials_parameters,VALUE,err,error,*999)
6707  !Default to version 1 of each node derivative
6708  local_ny=field_variable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP% &
6709  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
6710  CALL field_parameter_set_update_local_dof(dependent_field,variable_type, &
6711  & field_analytic_values_set_type,local_ny,VALUE,err,error,*999)
6712  CALL boundary_conditions_variable_get(boundary_conditions,dependent_field% &
6713  & variable_type_map(field_u_variable_type)%PTR,boundary_conditions_variable, &
6714  & err,error,*999)
6715  IF(ASSOCIATED(boundary_conditions_variable)) THEN
6716  boundary_condition_check_variable=boundary_conditions_variable% &
6717  & condition_types(local_ny)
6718  IF(boundary_condition_check_variable==boundary_condition_fixed) THEN
6719  CALL field_parameter_set_update_local_dof(dependent_field, &
6720  & variable_type,field_values_set_type,local_ny, &
6721  & VALUE,err,error,*999)
6722  END IF
6723  ELSE
6724  CALL flagerror("Boundary conditions U variable is not associated.", &
6725  & err,error,*999)
6726  END IF
6727  END DO !deriv_idx
6728  END DO !node_idx
6729  ELSE
6730  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
6731  END IF
6732  ELSE
6733  CALL flagerror("Domain topology is not associated.",err,error,*999)
6734  END IF
6735  ELSE
6736  CALL flagerror("Domain is not associated.",err,error,*999)
6737  END IF
6738  ELSE
6739  CALL flagerror("Only node based interpolation is implemented.",err,error,*999)
6740  END IF
6741  END DO !componentIdx
6742  CALL field_parameter_set_update_start(dependent_field,variable_type, &
6743  & field_analytic_values_set_type,err,error,*999)
6744  CALL field_parameter_set_update_finish(dependent_field,variable_type, &
6745  & field_analytic_values_set_type,err,error,*999)
6746  CALL field_parameter_set_update_start(dependent_field,variable_type, &
6747  & field_values_set_type,err,error,*999)
6748  CALL field_parameter_set_update_finish(dependent_field,variable_type, &
6749  & field_values_set_type,err,error,*999)
6750  ELSE
6751  CALL flagerror("Field variable is not associated.",err,error,*999)
6752  END IF
6753  END DO !variable_idx
6754  CALL field_parameter_set_data_restore(geometric_field,field_u_variable_type,&
6755  & field_values_set_type,geometric_parameters,err,error,*999)
6756  ELSE
6757  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
6758  END IF
6759  ELSE
6760  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
6761  END IF
6762  ELSE
6763  CALL flagerror("Equations set is not associated.",err,error,*999)
6764  END IF
6765  END IF !Standard/unit analytic subtypes
6766 
6767  END IF ! Analytic boundary conditions
6768 
6769  !TODO implement non-analytic time-varying boundary conditions (i.e. from file)
6770  ELSE
6771  CALL flagerror("Equations are not associated.",err,error,*999)
6772  END IF
6773  ELSE
6774  CALL flagerror("Solver equations are not associated.",err,error,*999)
6775  END IF
6776  CALL field_parameter_set_update_start(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6777  & field_values_set_type,err,error,*999)
6778  CALL field_parameter_set_update_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
6779  & field_values_set_type,err,error,*999)
6780  CASE(problem_transient1d_navier_stokes_subtype, &
6781  & problem_coupled1d0d_navier_stokes_subtype, &
6782  & problem_stree1d0d_navier_stokes_subtype, &
6783  & problem_transient1d_adv_navier_stokes_subtype, &
6784  & problem_coupled1d0d_adv_navier_stokes_subtype, &
6785  & problem_stree1d0d_adv_navier_stokes_subtype)
6786  solver_equations=>solver%SOLVER_EQUATIONS
6787  IF(ASSOCIATED(solver_equations)) THEN
6788  !If analytic flow waveform, calculate and update
6789  solver_mapping=>solver_equations%SOLVER_MAPPING
6790  IF(ASSOCIATED(solver_mapping)) THEN
6791  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
6792  IF(ASSOCIATED(equations)) THEN
6793  equations_set=>equations%EQUATIONS_SET
6794  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
6795  SELECT CASE(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE)
6796  CASE(equations_set_navier_stokes_equation_flowrate_aorta, &
6797  & equations_set_navier_stokes_equation_flowrate_olufsen)
6798  equations_set%ANALYTIC%ANALYTIC_TIME=current_time
6799  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
6800  IF(ASSOCIATED(boundary_conditions)) THEN
6801  ! Calculate analytic values
6802  CALL navierstokes_boundaryconditionsanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
6803  ELSE
6804  CALL flagerror("Boundary conditions are not associated.",err,error,*999)
6805  END IF
6806  CASE(equations_set_navier_stokes_equation_splint_from_file)
6807  ! Perform spline interpolation of values from a file
6808  equations_set%ANALYTIC%ANALYTIC_TIME=current_time
6809  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
6810  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
6811  analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
6812  DO variableidx=1,dependent_field%NUMBER_OF_VARIABLES
6813  dependentvariabletype=dependent_field%VARIABLES(variableidx)%VARIABLE_TYPE
6814  NULLIFY(dependentfieldvariable)
6815  CALL field_variable_get(dependent_field,dependentvariabletype,dependentfieldvariable,err,error,*999)
6816  CALL boundary_conditions_variable_get(boundary_conditions, &
6817  & dependentfieldvariable,boundary_conditions_variable,err,error,*999)
6818  IF(ASSOCIATED(boundary_conditions_variable)) THEN
6819  IF(ASSOCIATED(dependentfieldvariable)) THEN
6820  DO componentidx=1,dependentfieldvariable%NUMBER_OF_COMPONENTS
6821  IF(dependentfieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE== &
6822  & field_node_based_interpolation) THEN
6823  domain=>dependentfieldvariable%COMPONENTS(componentidx)%DOMAIN
6824  IF(ASSOCIATED(domain)) THEN
6825  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
6826  domain_nodes=>domain%TOPOLOGY%NODES
6827  IF(ASSOCIATED(domain_nodes)) THEN
6828  !Loop over the local nodes excluding the ghosts.
6829  DO nodeidx=1,domain_nodes%NUMBER_OF_NODES
6830  usernodenumber=domain_nodes%NODES(nodeidx)%USER_NUMBER
6831  DO derivativeidx=1,domain_nodes%NODES(nodeidx)%NUMBER_OF_DERIVATIVES
6832  DO versionidx=1,domain_nodes%NODES(nodeidx)%DERIVATIVES(derivativeidx)%numberOfVersions
6833  ! Update analytic field if file exists and dependent field if boundary condition set
6834  inputfile = './input/interpolatedData/1D/'
6835  IF(dependentvariabletype == field_u_variable_type) THEN
6836  inputfile = trim(inputfile) // 'U/component'
6837  END IF
6838  WRITE(tempstring,"(I1.1)") componentidx
6839  inputfile = trim(inputfile) // tempstring(1:1) // '/derivative'
6840  WRITE(tempstring,"(I1.1)") derivativeidx
6841  inputfile = trim(inputfile) // tempstring(1:1) // '/version'
6842  WRITE(tempstring,"(I1.1)") versionidx
6843  inputfile = trim(inputfile) // tempstring(1:1) // '/'
6844  WRITE(tempstring,"(I4.4)") usernodenumber
6845  inputfile = trim(inputfile) // tempstring(1:4) // '.dat'
6846  inputfile = trim(inputfile)
6847  INQUIRE(file=inputfile, exist=importdatafromfile)
6848  IF(importdatafromfile) THEN
6849  ! Create the analytic field values type on the dependent field if it does not exist
6850  IF(.NOT.ASSOCIATED(dependentfieldvariable%PARAMETER_SETS% &
6851  & set_type(field_analytic_values_set_type)%PTR)) &
6852  & CALL field_parameter_set_create(dependent_field,dependentvariabletype, &
6853  & field_analytic_values_set_type,err,error,*999)
6854  !Read fitted data from input file (if exists)
6855  OPEN(unit=10, file=inputfile, status='OLD')
6856  ! Header timeData = numberOfTimesteps
6857  READ(10,*) timedata
6858  numberofsourcetimesteps = int(timedata)
6859  ALLOCATE(nodedata(numberofsourcetimesteps,2))
6860  ALLOCATE(qvalues(numberofsourcetimesteps))
6861  ALLOCATE(tvalues(numberofsourcetimesteps))
6862  ALLOCATE(qspline(numberofsourcetimesteps))
6863  nodedata = 0.0_dp
6864  ! Read in time and dependent value
6865  DO timeidx=1,numberofsourcetimesteps
6866  READ(10,*) (nodedata(timeidx,component_idx), component_idx=1,2)
6867  END DO
6868  CLOSE(unit=10)
6869  tvalues = nodedata(:,1)
6870  qvalues = nodedata(:,2)
6871  CALL spline_cubic_set(numberofsourcetimesteps,tvalues,qvalues,2,0.0_dp,2,0.0_dp, &
6872  & qspline,err,error,*999)
6873  CALL spline_cubic_val(numberofsourcetimesteps,tvalues,qvalues,qspline, &
6874  & current_time,VALUE,qp,qpp,err,error,*999)
6875 
6876  DEALLOCATE(nodedata)
6877  DEALLOCATE(qspline)
6878  DEALLOCATE(qvalues)
6879  DEALLOCATE(tvalues)
6880 
6881  dependentdof = dependentfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP% &
6882  & node_param2dof_map%NODES(nodeidx)%DERIVATIVES(derivativeidx)%VERSIONS(versionidx)
6883  CALL field_parameter_set_update_local_dof(dependent_field,dependentvariabletype, &
6884  & field_analytic_values_set_type,dependentdof,VALUE,err,error,*999)
6885  ! Update dependent field value if this is a splint BC
6886  boundary_condition_check_variable=boundary_conditions_variable% &
6887  & condition_types(dependentdof)
6888  IF(boundary_condition_check_variable==boundary_condition_fixed_fitted) THEN
6889  CALL field_parameter_set_update_local_dof(dependent_field,dependentvariabletype, &
6890  & field_values_set_type,dependentdof,VALUE,err,error,*999)
6891  END IF
6892  END IF ! check if import data file exists
6893  END DO !versionIdx
6894  END DO !derivativeIdx
6895  END DO !nodeIdx
6896  ELSE
6897  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
6898  END IF
6899  ELSE
6900  CALL flagerror("Domain topology is not associated.",err,error,*999)
6901  END IF
6902  ELSE
6903  CALL flagerror("Domain is not associated.",err,error,*999)
6904  END IF
6905  ELSE
6906  CALL flagerror("Only node based interpolation is implemented.",err,error,*999)
6907  END IF
6908  END DO !componentIdx
6909  ELSE
6910  CALL flagerror("Dependent field variable is not associated.",err,error,*999)
6911  END IF
6912  END IF
6913  END DO !variableIdx
6914  CASE(equations_set_navier_stokes_equation_flowrate_heart)
6915  ! Using heart lumped parameter model for input
6916  equations_set%ANALYTIC%ANALYTIC_TIME=current_time
6917  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
6918  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
6919  materials_field=>equations_set%MATERIALS%MATERIALS_FIELD
6920  CALL field_parameter_set_get_constant(materials_field,field_u_variable_type,field_values_set_type,5, &
6921  & lref,err,error,*999)
6922  CALL field_parameter_set_get_constant(materials_field,field_u_variable_type,field_values_set_type,6, &
6923  & tref,err,error,*999)
6924  CALL field_parameter_set_get_constant(materials_field,field_u_variable_type,field_values_set_type,7, &
6925  & mref,err,error,*999)
6926  DO variableidx=1,dependent_field%NUMBER_OF_VARIABLES
6927  dependentvariabletype=dependent_field%VARIABLES(variableidx)%VARIABLE_TYPE
6928  NULLIFY(dependentfieldvariable)
6929  CALL field_variable_get(dependent_field,dependentvariabletype,dependentfieldvariable,err,error,*999)
6930  CALL boundary_conditions_variable_get(boundary_conditions,dependentfieldvariable, &
6931  & boundary_conditions_variable,err,error,*999)
6932  IF(ASSOCIATED(boundary_conditions_variable)) THEN
6933  IF(ASSOCIATED(dependentfieldvariable)) THEN
6934  DO componentidx=1,dependentfieldvariable%NUMBER_OF_COMPONENTS
6935  IF(dependentfieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE== &
6936  & field_node_based_interpolation) THEN
6937  domain=>dependentfieldvariable%COMPONENTS(componentidx)%DOMAIN
6938  IF(ASSOCIATED(domain)) THEN
6939  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
6940  domain_nodes=>domain%TOPOLOGY%NODES
6941  IF(ASSOCIATED(domain_nodes)) THEN
6942  !Loop over the local nodes excluding the ghosts.
6943  DO nodeidx=1,domain_nodes%NUMBER_OF_NODES
6944  usernodenumber=domain_nodes%NODES(nodeidx)%USER_NUMBER
6945  DO derivativeidx=1,domain_nodes%NODES(nodeidx)%NUMBER_OF_DERIVATIVES
6946  DO versionidx=1,domain_nodes%NODES(nodeidx)%DERIVATIVES(derivativeidx)%numberOfVersions
6947  dependentdof = dependentfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP% &
6948  & node_param2dof_map%NODES(nodeidx)%DERIVATIVES(derivativeidx)%VERSIONS(versionidx)
6949  boundary_condition_check_variable=boundary_conditions_variable% &
6950  & condition_types(dependentdof)
6951  IF(boundary_condition_check_variable==boundary_condition_fixed_inlet) THEN
6952  CALL field_parametersetgetlocalnode(dependent_field,field_u1_variable_type, &
6953  & field_values_set_type,versionidx,derivativeidx,usernodenumber,1,VALUE, &
6954  & err,error,*999)
6955  ! Convert Q from ml/s to non-dimensionalised form.
6956  CALL field_parameter_set_update_local_dof(dependent_field,dependentvariabletype, &
6957  & field_values_set_type,dependentdof,((lref**3.0)/tref)*VALUE,err,error,*999)
6958  END IF
6959  END DO !versionIdx
6960  END DO !derivativeIdx
6961  END DO !nodeIdx
6962  ELSE
6963  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
6964  END IF
6965  ELSE
6966  CALL flagerror("Domain topology is not associated.",err,error,*999)
6967  END IF
6968  ELSE
6969  CALL flagerror("Domain is not associated.",err,error,*999)
6970  END IF
6971  ELSE
6972  CALL flagerror("Only node based interpolation is implemented.",err,error,*999)
6973  END IF
6974  END DO !componentIdx
6975  ELSE
6976  CALL flagerror("Dependent field variable is not associated.",err,error,*999)
6977  END IF
6978  END IF
6979  END DO !variableIdx
6980  CASE DEFAULT
6981  ! Do nothing (might have another use for analytic equations)
6982  END SELECT
6983  END IF ! Check for analytic equations
6984  ELSE
6985  CALL flagerror("Equations are not associated.",err,error,*999)
6986  END IF
6987  ELSE
6988  CALL flagerror("Solver mapping is not associated.",err,error,*999)
6989  END IF
6990  END IF ! solver equations associated
6991  ! Update any multiscale boundary values (coupled 0D or non-reflecting)
6992  CALL navierstokes_updatemultiscaleboundary(solver,err,error,*999)
6993  CASE(problem_quasistatic_navier_stokes_subtype)
6994  !Pre solve for the linear solver
6995  solver_equations=>solver%SOLVER_EQUATIONS
6996  IF(ASSOCIATED(solver_equations)) THEN
6997  solver_mapping=>solver_equations%SOLVER_MAPPING
6998  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
6999  IF(ASSOCIATED(equations)) THEN
7000  equations_set=>equations%EQUATIONS_SET
7001  IF(ASSOCIATED(equations_set)) THEN
7002  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
7003  IF(ASSOCIATED(boundary_conditions)) THEN
7004  field_variable=>equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
7005  IF(ASSOCIATED(field_variable)) THEN
7006  CALL boundary_conditions_variable_get(boundary_conditions,field_variable, &
7007  & boundary_conditions_variable,err,error,*999)
7008  ELSE
7009  CALL flagerror("Field U variable is not associated",err,error,*999)
7010  END IF
7011  IF(ASSOCIATED(boundary_conditions_variable)) THEN
7012  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7013  & number_of_dimensions,err,error,*999)
7014  NULLIFY(boundary_values)
7015  CALL field_parameter_set_data_get(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
7016  & field_boundary_set_type,boundary_values,err,error,*999)
7017  CALL fluid_mechanics_io_read_boundary_conditions(solver_nonlinear_type,boundary_values, &
7018  & number_of_dimensions,boundary_condition_fixed_inlet,control_loop%TIME_LOOP%INPUT_NUMBER, &
7019  & control_loop%TIME_LOOP%ITERATION_NUMBER,current_time,1.0_dp)
7020  DO variable_idx=1,equations_set%DEPENDENT%DEPENDENT_FIELD%NUMBER_OF_VARIABLES
7021  variable_type=equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLES(variable_idx)%VARIABLE_TYPE
7022  field_variable=>equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLE_TYPE_MAP(variable_type)%PTR
7023  IF(ASSOCIATED(field_variable)) THEN
7024  DO componentidx=1,field_variable%NUMBER_OF_COMPONENTS
7025  domain=>field_variable%COMPONENTS(componentidx)%DOMAIN
7026  IF(ASSOCIATED(domain)) THEN
7027  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
7028  domain_nodes=>domain%TOPOLOGY%NODES
7029  IF(ASSOCIATED(domain_nodes)) THEN
7030  !Loop over the local nodes excluding the ghosts.
7031  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
7032  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
7033  !Default to version 1 of each node derivative
7034  local_ny=field_variable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP% &
7035  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
7036  boundary_condition_check_variable=boundary_conditions_variable% &
7037  & condition_types(local_ny)
7038  IF(boundary_condition_check_variable==boundary_condition_fixed_inlet) THEN
7039  CALL field_parameter_set_update_local_dof(equations_set%DEPENDENT%DEPENDENT_FIELD, &
7040  & field_u_variable_type,field_values_set_type,local_ny, &
7041  & boundary_values(local_ny),err,error,*999)
7042  END IF
7043  END DO !deriv_idx
7044  END DO !node_idx
7045  END IF
7046  END IF
7047  END IF
7048  END DO !componentIdx
7049  END IF
7050  END DO !variable_idx
7051 
7052  !\todo: This part should be read in out of a file eventually
7053  ELSE
7054  CALL flagerror("Boundary condition variable is not associated.",err,error,*999)
7055  END IF
7056  ELSE
7057  CALL flagerror("Boundary conditions are not associated.",err,error,*999)
7058  END IF
7059  ELSE
7060  CALL flagerror("Equations set is not associated.",err,error,*999)
7061  END IF
7062  ELSE
7063  CALL flagerror("Equations are not associated.",err,error,*999)
7064  END IF
7065  ELSE
7066  CALL flagerror("Solver equations are not associated.",err,error,*999)
7067  END IF
7068  CALL field_parameter_set_update_start(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
7069  & field_values_set_type,err,error,*999)
7070  CALL field_parameter_set_update_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
7071  & field_values_set_type,err,error,*999)
7072  CASE(problem_pgm_navier_stokes_subtype)
7073  !Pre solve for the dynamic solver
7074  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
7075  CALL write_string(general_output_type,"Mesh movement change boundary conditions... ",err,error,*999)
7076  solver_equations=>solver%SOLVER_EQUATIONS
7077  IF(ASSOCIATED(solver_equations)) THEN
7078  solver_mapping=>solver_equations%SOLVER_MAPPING
7079  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
7080  IF(ASSOCIATED(equations)) THEN
7081  equations_set=>equations%EQUATIONS_SET
7082  IF(ASSOCIATED(equations_set)) THEN
7083  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
7084  IF(ASSOCIATED(boundary_conditions)) THEN
7085  field_variable=>equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
7086  IF(ASSOCIATED(field_variable)) THEN
7087  CALL boundary_conditions_variable_get(boundary_conditions,field_variable, &
7088  & boundary_conditions_variable,err,error,*999)
7089  ELSE
7090  CALL flagerror("Field U variable is not associated",err,error,*999)
7091  END IF
7092  IF(ASSOCIATED(boundary_conditions_variable)) THEN
7093  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7094  & number_of_dimensions,err,error,*999)
7095  NULLIFY(mesh_velocity_values)
7096  CALL field_parameter_set_data_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7097  & field_mesh_velocity_set_type,mesh_velocity_values,err,error,*999)
7098  NULLIFY(boundary_values)
7099  CALL field_parameter_set_data_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7100  & field_boundary_set_type,boundary_values,err,error,*999)
7101  CALL fluid_mechanics_io_read_boundary_conditions(solver_linear_type,boundary_values, &
7102  & number_of_dimensions,boundary_condition_fixed_inlet,control_loop%TIME_LOOP%INPUT_NUMBER, &
7103  & control_loop%TIME_LOOP%ITERATION_NUMBER,current_time,1.0_dp)
7104  DO variable_idx=1,equations_set%DEPENDENT%DEPENDENT_FIELD%NUMBER_OF_VARIABLES
7105  variable_type=equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLES(variable_idx)%VARIABLE_TYPE
7106  field_variable=>equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLE_TYPE_MAP(variable_type)%PTR
7107  IF(ASSOCIATED(field_variable)) THEN
7108  DO componentidx=1,field_variable%NUMBER_OF_COMPONENTS
7109  domain=>field_variable%COMPONENTS(componentidx)%DOMAIN
7110  IF(ASSOCIATED(domain)) THEN
7111  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
7112  domain_nodes=>domain%TOPOLOGY%NODES
7113  IF(ASSOCIATED(domain_nodes)) THEN
7114  !Loop over the local nodes excluding the ghosts.
7115  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
7116  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
7117  !Default to version 1 of each node derivative
7118  local_ny=field_variable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP% &
7119  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
7120  displacement_value=0.0_dp
7121  boundary_condition_check_variable=boundary_conditions_variable% &
7122  & condition_types(local_ny)
7123  IF(boundary_condition_check_variable==boundary_condition_moved_wall) THEN
7124  CALL field_parameter_set_update_local_dof(equations_set%DEPENDENT%DEPENDENT_FIELD, &
7125  & field_u_variable_type,field_values_set_type,local_ny, &
7126  & mesh_velocity_values(local_ny),err,error,*999)
7127  ELSE IF(boundary_condition_check_variable==boundary_condition_fixed_inlet) THEN
7128  CALL field_parameter_set_update_local_dof(equations_set%DEPENDENT%DEPENDENT_FIELD, &
7129  & field_u_variable_type,field_values_set_type,local_ny, &
7130  & boundary_values(local_ny),err,error,*999)
7131  END IF
7132  END DO !deriv_idx
7133  END DO !node_idx
7134  END IF
7135  END IF
7136  END IF
7137  END DO !componentIdx
7138  END IF
7139  END DO !variable_idx
7140  ELSE
7141  CALL flagerror("Boundary condition variable is not associated.",err,error,*999)
7142  END IF
7143  ELSE
7144  CALL flagerror("Boundary conditions are not associated.",err,error,*999)
7145  END IF
7146  ELSE
7147  CALL flagerror("Equations set is not associated.",err,error,*999)
7148  END IF
7149  ELSE
7150  CALL flagerror("Equations are not associated.",err,error,*999)
7151  END IF
7152  ELSE
7153  CALL flagerror("Solver equations are not associated.",err,error,*999)
7154  END IF
7155  CALL field_parameter_set_update_start(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
7156  & field_values_set_type,err,error,*999)
7157  CALL field_parameter_set_update_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
7158  & field_values_set_type,err,error,*999)
7159  END IF
7160  CASE(problem_ale_navier_stokes_subtype)
7161  !Pre solve for the linear solver
7162  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
7163  CALL write_string(general_output_type,"Mesh movement change boundary conditions... ",err,error,*999)
7164  solver_equations=>solver%SOLVER_EQUATIONS
7165  IF(ASSOCIATED(solver_equations)) THEN
7166  solver_mapping=>solver_equations%SOLVER_MAPPING
7167  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
7168  IF(ASSOCIATED(equations)) THEN
7169  equations_set=>equations%EQUATIONS_SET
7170  IF(ASSOCIATED(equations_set)) THEN
7171  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
7172  IF(ASSOCIATED(boundary_conditions)) THEN
7173  field_variable=>equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
7174  IF(ASSOCIATED(field_variable)) THEN
7175  CALL boundary_conditions_variable_get(boundary_conditions,field_variable, &
7176  & boundary_conditions_variable,err,error,*999)
7177  ELSE
7178  CALL flagerror("Field U variable is not associated",err,error,*999)
7179  END IF
7180  IF(ASSOCIATED(boundary_conditions_variable)) THEN
7181  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7182  & number_of_dimensions,err,error,*999)
7183  NULLIFY(boundary_values)
7184  CALL field_parameter_set_data_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7185  & field_boundary_set_type,boundary_values,err,error,*999)
7186  CALL fluid_mechanics_io_read_boundary_conditions(solver_linear_type,boundary_values, &
7187  & number_of_dimensions,boundary_condition_moved_wall,control_loop%TIME_LOOP%INPUT_NUMBER, &
7188  & control_loop%TIME_LOOP%ITERATION_NUMBER,current_time,1.0_dp)
7189  DO variable_idx=1,equations_set%DEPENDENT%DEPENDENT_FIELD%NUMBER_OF_VARIABLES
7190  variable_type=equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLES(variable_idx)%VARIABLE_TYPE
7191  field_variable=>equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLE_TYPE_MAP(variable_type)%PTR
7192  IF(ASSOCIATED(field_variable)) THEN
7193  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
7194  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
7195  IF(ASSOCIATED(domain)) THEN
7196  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
7197  domain_nodes=>domain%TOPOLOGY%NODES
7198  IF(ASSOCIATED(domain_nodes)) THEN
7199  !Loop over the local nodes excluding the ghosts.
7200  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
7201  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
7202  !Default to version 1 of each node derivative
7203  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
7204  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
7205  boundary_condition_check_variable=boundary_conditions_variable% &
7206  & condition_types(local_ny)
7207  IF(boundary_condition_check_variable==boundary_condition_moved_wall) THEN
7208  CALL field_parameter_set_update_local_dof(equations_set%DEPENDENT%DEPENDENT_FIELD, &
7209  & field_u_variable_type,field_values_set_type,local_ny, &
7210  & boundary_values(local_ny),err,error,*999)
7211  END IF
7212  END DO !deriv_idx
7213  END DO !node_idx
7214  END IF
7215  END IF
7216  END IF
7217  END DO !component_idx
7218  END IF
7219  END DO !variable_idx
7220  CALL field_parameter_set_data_restore(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7221  & field_u_variable_type,field_boundary_set_type,boundary_values,err,error,*999)
7222  !\todo: This part should be read in out of a file eventually
7223  ELSE
7224  CALL flagerror("Boundary condition variable is not associated.",err,error,*999)
7225  END IF
7226  ELSE
7227  CALL flagerror("Boundary conditions are not associated.",err,error,*999)
7228  END IF
7229  ELSE
7230  CALL flagerror("Equations set is not associated.",err,error,*999)
7231  END IF
7232  ELSE
7233  CALL flagerror("Equations are not associated.",err,error,*999)
7234  END IF
7235  ELSE
7236  CALL flagerror("Solver equations are not associated.",err,error,*999)
7237  END IF
7238  CALL field_parameter_set_update_start(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
7239  & field_values_set_type,err,error,*999)
7240  CALL field_parameter_set_update_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
7241  & field_values_set_type,err,error,*999)
7242  !Pre solve for the dynamic solver
7243  ELSE IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
7244  CALL write_string(general_output_type,"Mesh movement change boundary conditions... ",err,error,*999)
7245  solver_equations=>solver%SOLVER_EQUATIONS
7246  IF(ASSOCIATED(solver_equations)) THEN
7247  solver_mapping=>solver_equations%SOLVER_MAPPING
7248  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
7249  IF(ASSOCIATED(equations)) THEN
7250  equations_set=>equations%EQUATIONS_SET
7251  IF(ASSOCIATED(equations_set)) THEN
7252  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
7253  IF(ASSOCIATED(boundary_conditions)) THEN
7254  field_variable=>equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
7255  IF(ASSOCIATED(field_variable)) THEN
7256  CALL boundary_conditions_variable_get(boundary_conditions,field_variable, &
7257  & boundary_conditions_variable,err,error,*999)
7258  ELSE
7259  CALL flagerror("Field U variable is not associated",err,error,*999)
7260  END IF
7261  IF(ASSOCIATED(boundary_conditions_variable)) THEN
7262  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7263  & number_of_dimensions,err,error,*999)
7264  NULLIFY(mesh_velocity_values)
7265  CALL field_parameter_set_data_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7266  & field_mesh_velocity_set_type,mesh_velocity_values,err,error,*999)
7267  NULLIFY(boundary_values)
7268  CALL field_parameter_set_data_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7269  & field_boundary_set_type,boundary_values,err,error,*999)
7270  CALL fluid_mechanics_io_read_boundary_conditions(solver_linear_type,boundary_values, &
7271  & number_of_dimensions,boundary_condition_fixed_inlet,control_loop%TIME_LOOP%INPUT_NUMBER, &
7272  & control_loop%TIME_LOOP%ITERATION_NUMBER,current_time,1.0_dp)
7273  DO variable_idx=1,equations_set%DEPENDENT%DEPENDENT_FIELD%NUMBER_OF_VARIABLES
7274  variable_type=equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLES(variable_idx)%VARIABLE_TYPE
7275  field_variable=>equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLE_TYPE_MAP(variable_type)%PTR
7276  IF(ASSOCIATED(field_variable)) THEN
7277  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
7278  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
7279  IF(ASSOCIATED(domain)) THEN
7280  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
7281  domain_nodes=>domain%TOPOLOGY%NODES
7282  IF(ASSOCIATED(domain_nodes)) THEN
7283  !Loop over the local nodes excluding the ghosts.
7284  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
7285  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
7286  !Default to version 1 of each node derivative
7287  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
7288  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
7289  displacement_value=0.0_dp
7290  boundary_condition_check_variable=boundary_conditions_variable% &
7291  & condition_types(local_ny)
7292  IF(boundary_condition_check_variable==boundary_condition_moved_wall) THEN
7293  CALL field_parameter_set_update_local_dof(equations_set%DEPENDENT%DEPENDENT_FIELD, &
7294  & field_u_variable_type,field_values_set_type,local_ny, &
7295  & mesh_velocity_values(local_ny),err,error,*999)
7296  ELSE IF(boundary_condition_check_variable==boundary_condition_fixed_inlet) THEN
7297  CALL field_parameter_set_update_local_dof(equations_set%DEPENDENT%DEPENDENT_FIELD, &
7298  & field_u_variable_type,field_values_set_type,local_ny, &
7299  & boundary_values(local_ny),err,error,*999)
7300  END IF
7301  END DO !deriv_idx
7302  END DO !node_idx
7303  END IF
7304  END IF
7305  END IF
7306  END DO !component_idx
7307  END IF
7308  END DO !variable_idx
7309  CALL field_parameter_set_data_restore(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7310  & field_u_variable_type,field_mesh_velocity_set_type,mesh_velocity_values,err,error,*999)
7311  CALL field_parameter_set_data_restore(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7312  & field_u_variable_type,field_boundary_set_type,boundary_values,err,error,*999)
7313  ELSE
7314  CALL flagerror("Boundary condition variable is not associated.",err,error,*999)
7315  END IF
7316  ELSE
7317  CALL flagerror("Boundary conditions are not associated.",err,error,*999)
7318  END IF
7319  ELSE
7320  CALL flagerror("Equations set is not associated.",err,error,*999)
7321  END IF
7322  ELSE
7323  CALL flagerror("Equations are not associated.",err,error,*999)
7324  END IF
7325  ELSE
7326  CALL flagerror("Solver equations are not associated.",err,error,*999)
7327  END IF
7328  CALL field_parameter_set_update_start(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
7329  & field_values_set_type,err,error,*999)
7330  CALL field_parameter_set_update_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
7331  & field_values_set_type,err,error,*999)
7332  END IF
7333  ! do nothing ???
7334  CASE DEFAULT
7335  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
7336  & " is not valid for a Navier-Stokes equation fluid type of a fluid mechanics problem class."
7337  CALL flagerror(local_error,err,error,*999)
7338  END SELECT
7339  CASE(problem_multi_physics_class)
7340  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(2))
7341  CASE(problem_finite_elasticity_navier_stokes_type)
7342  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
7343  CASE(problem_finite_elasticity_navier_stokes_ale_subtype)
7344  NULLIFY(solver2)
7345  !Pre solve for the linear solver
7346  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
7347  CALL write_string(general_output_type,"Mesh movement change boundary conditions... ",err,error,*999)
7348  solver_equations=>solver%SOLVER_EQUATIONS
7349  IF(ASSOCIATED(solver_equations)) THEN
7350  solver_mapping=>solver_equations%SOLVER_MAPPING
7351  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
7352  IF(ASSOCIATED(equations)) THEN
7353  equations_set=>equations%EQUATIONS_SET
7354  IF(ASSOCIATED(equations_set)) THEN
7355  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
7356  IF(ASSOCIATED(boundary_conditions)) THEN
7357  field_variable=>equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
7358  IF(ASSOCIATED(field_variable)) THEN
7359  CALL boundary_conditions_variable_get(boundary_conditions,field_variable, &
7360  & boundary_conditions_variable,err,error,*999)
7361  ELSE
7362  CALL flagerror("Field U variable is not associated",err,error,*999)
7363  END IF
7364  IF(ASSOCIATED(boundary_conditions_variable)) THEN
7365  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7366  & number_of_dimensions,err,error,*999)
7367  !Update moving wall nodes from solid/fluid gap (as we solve for displacements of the mesh
7368  !in Laplacian smoothing step).
7369  CALL solvers_solver_get(solver%SOLVERS,1,solver2,err,error,*999)
7370  IF(.NOT.ASSOCIATED(solver2)) CALL flagerror("Dynamic solver is not associated.",err,error,*999)
7371  !Find the FiniteElasticity equations set as there is a NavierStokes equations set too
7372  solid_solver_equations=>solver2%SOLVER_EQUATIONS
7373  IF(ASSOCIATED(solid_solver_equations)) THEN
7374  solid_solver_mapping=>solid_solver_equations%SOLVER_MAPPING
7375  IF(ASSOCIATED(solid_solver_mapping)) THEN
7376  equationssetindex=1
7377  solidequationssetfound=.false.
7378  DO WHILE (.NOT.solidequationssetfound &
7379  & .AND.equationssetindex<=solid_solver_mapping%NUMBER_OF_EQUATIONS_SETS)
7380  solid_equations=>solid_solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equationssetindex)%EQUATIONS
7381  IF(ASSOCIATED(solid_equations)) THEN
7382  solid_equations_set=>solid_equations%EQUATIONS_SET
7383  IF(ASSOCIATED(solid_equations_set)) THEN
7384  IF(solid_equations_set%SPECIFICATION(1)==equations_set_elasticity_class &
7385  & .AND.solid_equations_set%SPECIFICATION(2)==equations_set_finite_elasticity_type &
7386  & .AND.((solid_equations_set%SPECIFICATION(3)==equations_set_mooney_rivlin_subtype).OR. &
7387  & (solid_equations_set%SPECIFICATION(3)== &
7388  & equations_set_compressible_finite_elasticity_subtype))) THEN
7389  solidequationssetfound=.true.
7390  ELSE
7391  equationssetindex=equationssetindex+1
7392  END IF
7393  ELSE
7394  CALL flagerror("Solid equations set is not associated.",err,error,*999)
7395  END IF
7396  ELSE
7397  CALL flagerror("Solid equations not associated.",err,error,*999)
7398  END IF
7399  END DO
7400  IF(solidequationssetfound.EQV..false.) THEN
7401  local_error="Solid equations set not found when trying to update boundary conditions."
7402  CALL flagerror(local_error,err,error,*999)
7403  END IF
7404  ELSE
7405  CALL flagerror("Solid solver mapping is not associated.",err,error,*999)
7406  END IF
7407  ELSE
7408  CALL flagerror("Solver equations for solid equations set not associated.",err,error,*999)
7409  END IF
7410  solid_dependent=>solid_equations_set%DEPENDENT
7411  IF(.NOT.ASSOCIATED(solid_dependent%DEPENDENT_FIELD)) THEN
7412  CALL flagerror("Solid equations set dependent field is not associated.",err,error,*999)
7413  END IF
7414  solid_dependent_field=>solid_dependent%DEPENDENT_FIELD
7415  !Find the NavierStokes equations set as there is a FiniteElasticity equations set too
7416  fluid_solver_equations=>solver2%SOLVER_EQUATIONS
7417  IF(ASSOCIATED(fluid_solver_equations)) THEN
7418  fluid_solver_mapping=>fluid_solver_equations%SOLVER_MAPPING
7419  IF(ASSOCIATED(fluid_solver_mapping)) THEN
7420  equationssetindex=1
7421  fluidequationssetfound=.false.
7422  DO WHILE (.NOT.fluidequationssetfound &
7423  & .AND.equationssetindex<=fluid_solver_mapping%NUMBER_OF_EQUATIONS_SETS)
7424  fluid_equations=>fluid_solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equationssetindex)%EQUATIONS
7425  IF(ASSOCIATED(solid_equations)) THEN
7426  fluid_equations_set=>fluid_equations%EQUATIONS_SET
7427  IF(ASSOCIATED(fluid_equations_set)) THEN
7428  IF(fluid_equations_set%SPECIFICATION(1)==equations_set_fluid_mechanics_class &
7429  & .AND.fluid_equations_set%SPECIFICATION(2)==equations_set_navier_stokes_equation_type &
7430  & .AND.fluid_equations_set%SPECIFICATION(3)==equations_set_ale_navier_stokes_subtype) THEN
7431  fluidequationssetfound=.true.
7432  ELSE
7433  equationssetindex=equationssetindex+1
7434  END IF
7435  ELSE
7436  CALL flagerror("Fluid equations set is not associated.",err,error,*999)
7437  END IF
7438  ELSE
7439  CALL flagerror("Fluid equations not associated.",err,error,*999)
7440  END IF
7441  END DO
7442  IF(fluidequationssetfound.EQV..false.) THEN
7443  local_error="Fluid equations set not found when trying to update boundary conditions."
7444  CALL flagerror(local_error,err,error,*999)
7445  END IF
7446  ELSE
7447  CALL flagerror("Fluid solver mapping is not associated.",err,error,*999)
7448  END IF
7449  ELSE
7450  CALL flagerror("Fluid equations for fluid equations set not associated.",err,error,*999)
7451  END IF
7452  fluid_geometric=>fluid_equations_set%GEOMETRY
7453  IF(.NOT.ASSOCIATED(fluid_geometric%GEOMETRIC_FIELD)) THEN
7454  CALL flagerror("Fluid equations set geometric field is not associated",err,error,*999)
7455  END IF
7456  fluid_geometric_field=>fluid_geometric%GEOMETRIC_FIELD
7457  !DO variable_idx=1,EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD%NUMBER_OF_VARIABLES
7458  variable_idx=1
7459  variable_type=equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLES(variable_idx)%VARIABLE_TYPE
7460  field_variable=>equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLE_TYPE_MAP(variable_type)%PTR
7461  IF(ASSOCIATED(field_variable)) THEN
7462  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
7463  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
7464  IF(ASSOCIATED(domain)) THEN
7465  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
7466  domain_nodes=>domain%TOPOLOGY%NODES
7467  IF(ASSOCIATED(domain_nodes)) THEN
7468  !Loop over the local nodes excluding the ghosts.
7469  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
7470  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
7471  !Default to version 1 of each node derivative
7472  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
7473  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
7474  boundary_condition_check_variable=boundary_conditions_variable% &
7475  & condition_types(local_ny)
7476  !Update moved wall nodes only
7477  IF(boundary_condition_check_variable==boundary_condition_moved_wall) THEN
7478  !NOTE: assuming same mesh and mesh nodes for fluid domain and moving mesh domain
7479  fluidnodenumber=node_idx
7480  DO search_idx=1,SIZE(solver2%SOLVER_EQUATIONS%SOLVER_MAPPING% &
7481  & interface_conditions(1)%PTR%INTERFACE% &
7482  & nodes%COUPLED_NODES(2,:))
7483  IF(solver2%SOLVER_EQUATIONS%SOLVER_MAPPING% &
7484  & interface_conditions(1)%PTR%INTERFACE% &
7485  & nodes%COUPLED_NODES(2,search_idx)==node_idx) THEN
7486  solidnodenumber=solver2%SOLVER_EQUATIONS%SOLVER_MAPPING% &
7487  & interface_conditions(1)%PTR%INTERFACE% &
7488  & nodes%COUPLED_NODES(1,search_idx)!might wanna put a break here
7489  solidnodefound=.true.
7490  END IF
7491  END DO
7492  IF(.NOT.solidnodefound &
7493  & .OR.fluidnodenumber==0) CALL flagerror("Solid interface node not found.", &
7494  & err,error,*999)
7495  !Default to version number 1
7496  IF(variable_idx==1) THEN
7497  CALL field_parameter_set_get_node(fluid_geometric_field,variable_type, &
7498  & field_values_set_type,1,deriv_idx, &
7499  & fluidnodenumber,component_idx,fluidgfvalue,err,error,*999)
7500  ELSE
7501  fluidgfvalue=0.0_dp
7502  END IF
7503  CALL field_parameter_set_get_node(solid_dependent_field,variable_type, &
7504  & field_values_set_type,1,deriv_idx, &
7505  & solidnodenumber,component_idx,soliddfvalue,err,error,*999)
7506  newlaplaceboundaryvalue=soliddfvalue-fluidgfvalue
7507  CALL field_parameter_set_update_local_dof(equations_set%DEPENDENT%DEPENDENT_FIELD, &
7508  & field_u_variable_type,field_values_set_type,local_ny, &
7509  & newlaplaceboundaryvalue,err,error,*999)
7510  END IF
7511  END DO !deriv_idx
7512  END DO !node_idx
7513  END IF
7514  END IF
7515  END IF
7516  END DO !component_idx
7517  END IF
7518  !END DO !variable_idx
7519  ELSE
7520  CALL flagerror("Boundary condition variable is not associated.",err,error,*999)
7521  END IF
7522  ELSE
7523  CALL flagerror("Boundary conditions are not associated.",err,error,*999)
7524  END IF
7525  ELSE
7526  CALL flagerror("Equations set is not associated.",err,error,*999)
7527  END IF
7528  ELSE
7529  CALL flagerror("Equations are not associated.",err,error,*999)
7530  END IF
7531  ELSE
7532  CALL flagerror("Solver equations are not associated.",err,error,*999)
7533  END IF
7534  CALL field_parameter_set_update_start(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
7535  & field_values_set_type,err,error,*999)
7536  CALL field_parameter_set_update_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
7537  & field_values_set_type,err,error,*999)
7538  !Pre solve for the dynamic solver
7539  ELSE IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
7540  CALL write_string(general_output_type,"Velocity field change boundary conditions... ",err,error,*999)
7541  solver_equations=>solver%SOLVER_EQUATIONS
7542  IF(ASSOCIATED(solver_equations)) THEN
7543  solver_mapping=>solver_equations%SOLVER_MAPPING
7544  !Find the NavierStokes equations set as there is a finite elasticity equations set too
7545  equationssetindex=1
7546  alenavierstokesequationssetfound=.false.
7547  DO WHILE (.NOT.alenavierstokesequationssetfound &
7548  & .AND.equationssetindex<=solver_mapping%NUMBER_OF_EQUATIONS_SETS)
7549  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equationssetindex)%EQUATIONS
7550  IF(ASSOCIATED(equations)) THEN
7551  equations_set=>equations%EQUATIONS_SET
7552  IF(ASSOCIATED(equations_set)) THEN
7553  IF(equations_set%SPECIFICATION(1)==equations_set_fluid_mechanics_class &
7554  & .AND.equations_set%SPECIFICATION(2)==equations_set_navier_stokes_equation_type &
7555  & .AND.equations_set%SPECIFICATION(3)==equations_set_ale_navier_stokes_subtype) THEN
7556  alenavierstokesequationssetfound=.true.
7557  ELSE
7558  equationssetindex=equationssetindex+1
7559  END IF
7560  ELSE
7561  CALL flagerror("ALE Navier-Stokes equations set is not associated.",err,error,*999)
7562  END IF
7563  ELSE
7564  CALL flagerror("ALE equations not associated.",err,error,*999)
7565  END IF
7566  END DO
7567  IF(alenavierstokesequationssetfound.EQV..false.) THEN
7568  local_error="ALE NavierStokes equations set not found when trying to update boundary conditions."
7569  CALL flagerror(local_error,err,error,*999)
7570  END IF
7571  !Get boundary conditions
7572  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
7573  IF(ASSOCIATED(boundary_conditions)) THEN
7574  field_variable=>equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
7575  IF(ASSOCIATED(field_variable)) THEN
7576  CALL boundary_conditions_variable_get(boundary_conditions,field_variable, &
7577  & boundary_conditions_variable,err,error,*999)
7578  ELSE
7579  CALL flagerror("Field U variable is not associated",err,error,*999)
7580  END IF
7581  IF(ASSOCIATED(boundary_conditions_variable)) THEN
7582  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7583  & number_of_dimensions,err,error,*999)
7584  NULLIFY(mesh_velocity_values)
7585  CALL field_parameter_set_data_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7586  & field_mesh_velocity_set_type,mesh_velocity_values,err,error,*999)
7587  NULLIFY(boundary_values)
7588  CALL field_parameter_set_data_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
7589  & field_boundary_set_type,boundary_values,err,error,*999)
7590  !Get update for time-dependent boundary conditions
7591  IF(control_loop%TIME_LOOP%INPUT_NUMBER==1) THEN
7592  componentbc=1
7593  CALL fluidmechanics_io_updateboundaryconditionupdatenodes(equations_set%GEOMETRY%GEOMETRIC_FIELD, &
7594  & solver%SOLVE_TYPE,inletnodes, &
7595  & boundaryvalues,boundary_condition_fixed_inlet,control_loop%TIME_LOOP%INPUT_NUMBER, &
7596  & current_time,control_loop%TIME_LOOP%STOP_TIME)
7597  DO node_idx=1,SIZE(inletnodes)
7598  CALL field_parameter_set_update_node(equations_set%DEPENDENT%DEPENDENT_FIELD, &
7599  & field_u_variable_type,field_values_set_type,1,1,inletnodes(node_idx),componentbc, &
7600  & boundaryvalues(node_idx),err,error,*999)
7601  END DO
7602  ELSE
7603  !Figure out which component we're applying BC at
7604  IF(control_loop%TIME_LOOP%INPUT_NUMBER==2) THEN
7605  componentbc=1
7606  ELSE
7607  componentbc=2
7608  END IF
7609  !Get inlet nodes and the corresponding velocities
7610  CALL fluidmechanics_io_updateboundaryconditionupdatenodes(equations_set%GEOMETRY%GEOMETRIC_FIELD, &
7611  & solver%SOLVE_TYPE,inletnodes, &
7612  & boundaryvalues,boundary_condition_fixed_inlet,control_loop%TIME_LOOP%INPUT_NUMBER, &
7613  & current_time,control_loop%TIME_LOOP%STOP_TIME)
7614  DO node_idx=1,SIZE(inletnodes)
7615  CALL field_parameter_set_update_node(equations_set%DEPENDENT%DEPENDENT_FIELD, &
7616  & field_u_variable_type,field_values_set_type,1,1,inletnodes(node_idx),componentbc, &
7617  & boundaryvalues(node_idx),err,error,*999)
7618  END DO
7619  END IF
7620  CALL field_parameter_set_data_restore(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7621  & field_u_variable_type,field_mesh_velocity_set_type,mesh_velocity_values,err,error,*999)
7622  CALL field_parameter_set_data_restore(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
7623  & field_u_variable_type,field_boundary_set_type,boundary_values,err,error,*999)
7624  ELSE
7625  CALL flagerror("Boundary condition variable is not associated.",err,error,*999)
7626  END IF
7627  ELSE
7628  CALL flagerror("Boundary conditions are not associated.",err,error,*999)
7629  END IF
7630  ELSE
7631  CALL flagerror("Solver equations are not associated.",err,error,*999)
7632  END IF
7633  CALL field_parameter_set_update_start(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
7634  & field_values_set_type,err,error,*999)
7635  CALL field_parameter_set_update_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
7636  & field_values_set_type,err,error,*999)
7637  END IF
7638  ! do nothing ???
7639  CASE DEFAULT
7640  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
7641  & " is not valid for a FiniteElasticity-NavierStokes problem type of a multi physics problem class."
7642  CALL flagerror(local_error,err,error,*999)
7643  END SELECT
7644  CASE DEFAULT
7645  local_error="Problem type "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(2),"*",err,error))// &
7646  & " is not valid for NAVIER_STOKES_PRE_SOLVE of a multi physics problem class."
7647  CALL flagerror(local_error,err,error,*999)
7648  END SELECT
7649  CASE DEFAULT
7650  local_error="The first problem specification of "// &
7651  & trim(number_to_vstring(control_loop%PROBLEM%specification(1),"*",err,error))// &
7652  & " is not valid for NavierStokes_PreSolveUpdateBoundaryConditions."
7653  CALL flagerror(local_error,err,error,*999)
7654  END SELECT
7655  ELSE
7656  CALL flagerror("Problem is not associated.",err,error,*999)
7657  END IF
7658  ELSE
7659  CALL flagerror("Solver is not associated.",err,error,*999)
7660  END IF
7661  ELSE
7662  CALL flagerror("Control loop is not associated.",err,error,*999)
7663  END IF
7664 
7665  exits("NavierStokes_PreSolveUpdateBoundaryConditions")
7666  RETURN
7667 999 errors("NavierStokes_PreSolveUpdateBoundaryConditions",err,error)
7668  exits("NavierStokes_PreSolveUpdateBoundaryConditions")
7669  RETURN 1
7670 
7671  END SUBROUTINE navierstokes_presolveupdateboundaryconditions
7672 
7673  !
7674  !================================================================================================================================
7675  !
7676 
7678  SUBROUTINE navier_stokes_pre_solve_ale_update_mesh(SOLVER,ERR,ERROR,*)
7679 
7680  !Argument variables
7681  TYPE(solver_type), POINTER :: SOLVER
7682  INTEGER(INTG), INTENT(OUT) :: ERR
7683  TYPE(varying_string), INTENT(OUT) :: ERROR
7684  !Local Variables
7685  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
7686  TYPE(domain_nodes_type), POINTER :: DOMAIN_NODES
7687  TYPE(domain_type), POINTER :: DOMAIN
7688  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
7689  TYPE(equations_set_type), POINTER :: EQUATIONS_SET_LAPLACE, EQUATIONS_SET_ALE_NAVIER_STOKES
7690  TYPE(equations_type), POINTER :: EQUATIONS
7691  TYPE(field_type), POINTER :: DEPENDENT_FIELD_LAPLACE, INDEPENDENT_FIELD_ALE_NAVIER_STOKES
7692  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
7693  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS_LAPLACE, SOLVER_EQUATIONS_ALE_NAVIER_STOKES
7694  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING_LAPLACE, SOLVER_MAPPING_ALE_NAVIER_STOKES
7695  TYPE(solver_type), POINTER :: SOLVER_ALE_NAVIER_STOKES, SOLVER_LAPLACE
7696  TYPE(solvers_type), POINTER :: SOLVERS
7697  TYPE(varying_string) :: LOCAL_ERROR
7698  INTEGER(INTG) :: I,NUMBER_OF_DIMENSIONS_LAPLACE,NUMBER_OF_DIMENSIONS_ALE_NAVIER_STOKES
7699  INTEGER(INTG) :: GEOMETRIC_MESH_COMPONENT,INPUT_TYPE,INPUT_OPTION,EquationsSetIndex
7700  INTEGER(INTG) :: component_idx,deriv_idx,local_ny,node_idx,variable_idx,variable_type
7701  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT,ALPHA
7702  REAL(DP), POINTER :: MESH_DISPLACEMENT_VALUES(:)
7703  LOGICAL :: ALENavierStokesEquationsSetFound=.false.
7704 
7705  enters("NAVIER_STOKES_PRE_SOLVE_ALE_UPDATE_MESH",err,error,*999)
7706 
7707  IF(ASSOCIATED(solver)) THEN
7708  solvers=>solver%SOLVERS
7709  IF(ASSOCIATED(solvers)) THEN
7710  control_loop=>solvers%CONTROL_LOOP
7711  CALL control_loop_current_times_get(control_loop,current_time,time_increment,err,error,*999)
7712  NULLIFY(solver_laplace)
7713  NULLIFY(solver_ale_navier_stokes)
7714  NULLIFY(independent_field_ale_navier_stokes)
7715  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
7716  IF(.NOT.ALLOCATED(control_loop%problem%specification)) THEN
7717  CALL flagerror("Problem specification array is not allocated.",err,error,*999)
7718  ELSE IF(SIZE(control_loop%problem%specification,1)<3) THEN
7719  CALL flagerror("Problem specification must have three entries for a Navier-Stokes problem.",err,error,*999)
7720  END IF
7721  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(1))
7722  CASE(problem_fluid_mechanics_class)
7723  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
7724  CASE(problem_static_navier_stokes_subtype,problem_laplace_navier_stokes_subtype)
7725  ! do nothing ???
7726  CASE(problem_transient_navier_stokes_subtype)
7727  ! do nothing ???
7728  CASE(problem_transient_rbs_navier_stokes_subtype,problem_multiscale_navier_stokes_subtype)
7729  ! do nothing ???
7730  CASE(problem_transient1d_navier_stokes_subtype,problem_coupled1d0d_navier_stokes_subtype, &
7731  & problem_transient1d_adv_navier_stokes_subtype,problem_coupled1d0d_adv_navier_stokes_subtype)
7732  ! do nothing ???
7733  CASE(problem_pgm_navier_stokes_subtype)
7734  !Update mesh within the dynamic solver
7735  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
7736  !Get the independent field for the ALE Navier-Stokes problem
7737  CALL solvers_solver_get(solver%SOLVERS,1,solver_ale_navier_stokes,err,error,*999)
7738  solver_equations_ale_navier_stokes=>solver_ale_navier_stokes%SOLVER_EQUATIONS
7739  IF(ASSOCIATED(solver_equations_ale_navier_stokes)) THEN
7740  solver_mapping_ale_navier_stokes=>solver_equations_ale_navier_stokes%SOLVER_MAPPING
7741  IF(ASSOCIATED(solver_mapping_ale_navier_stokes)) THEN
7742  equations_set_ale_navier_stokes=>solver_mapping_ale_navier_stokes%EQUATIONS_SETS(1)%PTR
7743  IF(ASSOCIATED(equations_set_ale_navier_stokes)) THEN
7744  independent_field_ale_navier_stokes=>equations_set_ale_navier_stokes%INDEPENDENT%INDEPENDENT_FIELD
7745  ELSE
7746  CALL flagerror("ALE Navier-Stokes equations set is not associated.",err,error,*999)
7747  END IF
7748  !Get the data
7749  CALL field_number_of_components_get(equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD, &
7750  & field_u_variable_type,number_of_dimensions_ale_navier_stokes,err,error,*999)
7751  !\todo: Introduce user calls instead of hard-coding 42/1
7752  !Copy input to Navier-Stokes' independent field
7753  input_type=42
7754  input_option=1
7755  NULLIFY(mesh_displacement_values)
7756  CALL field_parameter_set_data_get(equations_set_ale_navier_stokes%INDEPENDENT%INDEPENDENT_FIELD, &
7757  & field_u_variable_type,field_mesh_displacement_set_type,mesh_displacement_values,err,error,*999)
7758  CALL fluid_mechanics_io_read_data(solver_linear_type,mesh_displacement_values, &
7759  & number_of_dimensions_ale_navier_stokes,input_type,input_option, &
7760  & control_loop%TIME_LOOP%ITERATION_NUMBER,1.0_dp)
7761  CALL field_parameter_set_update_start(equations_set_ale_navier_stokes%INDEPENDENT%INDEPENDENT_FIELD, &
7762  & field_u_variable_type,field_mesh_displacement_set_type,err,error,*999)
7763  CALL field_parameter_set_update_finish(equations_set_ale_navier_stokes%INDEPENDENT%INDEPENDENT_FIELD, &
7764  & field_u_variable_type,field_mesh_displacement_set_type,err,error,*999)
7765  ELSE
7766  CALL flagerror("ALE Navier-Stokes solver mapping is not associated.",err,error,*999)
7767  END IF
7768  ELSE
7769  CALL flagerror("ALE Navier-Stokes solver equations are not associated.",err,error,*999)
7770  END IF
7771  !Use calculated values to update mesh
7772  CALL field_component_mesh_component_get(equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD, &
7773  & field_u_variable_type,1,geometric_mesh_component,err,error,*999)
7774  ! CALL FIELD_PARAMETER_SET_DATA_GET(INDEPENDENT_FIELD_ALE_NAVIER_STOKES,FIELD_U_VARIABLE_TYPE, &
7775  ! & FIELD_MESH_DISPLACEMENT_SET_TYPE,MESH_DISPLACEMENT_VALUES,ERR,ERROR,*999)
7776  equations=>solver_mapping_ale_navier_stokes%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
7777  IF(ASSOCIATED(equations)) THEN
7778  equations_mapping=>equations%EQUATIONS_MAPPING
7779  IF(ASSOCIATED(equations_mapping)) THEN
7780  DO variable_idx=1,equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD%NUMBER_OF_VARIABLES
7781  variable_type=equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD%VARIABLES(variable_idx)%VARIABLE_TYPE
7782  field_variable=>equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD%VARIABLE_TYPE_MAP(variable_type)%PTR
7783  IF(ASSOCIATED(field_variable)) THEN
7784  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
7785  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
7786  IF(ASSOCIATED(domain)) THEN
7787  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
7788  domain_nodes=>domain%TOPOLOGY%NODES
7789  IF(ASSOCIATED(domain_nodes)) THEN
7790  !Loop over the local nodes excluding the ghosts.
7791  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
7792  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
7793  !Default to version 1 of each node derivative
7794  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
7795  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
7796  CALL field_parameter_set_add_local_dof(equations_set_ale_navier_stokes%GEOMETRY% &
7797  & geometric_field,field_u_variable_type,field_values_set_type,local_ny, &
7798  & mesh_displacement_values(local_ny),err,error,*999)
7799  END DO !deriv_idx
7800  END DO !node_idx
7801  END IF
7802  END IF
7803  END IF
7804  END DO !componentIdx
7805  END IF
7806  END DO !variable_idx
7807  ELSE
7808  CALL flagerror("Equations mapping is not associated.",err,error,*999)
7809  END IF
7810  ELSE
7811  CALL flagerror("Equations are not associated.",err,error,*999)
7812  END IF
7813  CALL field_parameter_set_update_start(equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD, &
7814  & field_u_variable_type,field_values_set_type,err,error,*999)
7815  CALL field_parameter_set_update_finish(equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD, &
7816  & field_u_variable_type,field_values_set_type,err,error,*999)
7817  !Now use displacement values to calculate velocity values
7818  time_increment=control_loop%TIME_LOOP%TIME_INCREMENT
7819  alpha=1.0_dp/time_increment
7820  CALL field_parameter_sets_copy(independent_field_ale_navier_stokes,field_u_variable_type, &
7821  & field_mesh_displacement_set_type,field_mesh_velocity_set_type,alpha,err,error,*999)
7822  ELSE
7823  CALL flagerror("Mesh motion calculation not successful for ALE problem.",err,error,*999)
7824  END IF
7825  CASE(problem_ale_navier_stokes_subtype)
7826  !Update mesh within the dynamic solver
7827  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
7828  IF(solver%DYNAMIC_SOLVER%ALE) THEN
7829  !Get the dependent field for the three component Laplace problem
7830  CALL solvers_solver_get(solver%SOLVERS,1,solver_laplace,err,error,*999)
7831  solver_equations_laplace=>solver_laplace%SOLVER_EQUATIONS
7832  IF(ASSOCIATED(solver_equations_laplace)) THEN
7833  solver_mapping_laplace=>solver_equations_laplace%SOLVER_MAPPING
7834  IF(ASSOCIATED(solver_mapping_laplace)) THEN
7835  equations_set_laplace=>solver_mapping_laplace%EQUATIONS_SETS(1)%PTR
7836  IF(ASSOCIATED(equations_set_laplace)) THEN
7837  dependent_field_laplace=>equations_set_laplace%DEPENDENT%DEPENDENT_FIELD
7838  ELSE
7839  CALL flagerror("Laplace equations set is not associated.",err,error,*999)
7840  END IF
7841  CALL field_number_of_components_get(equations_set_laplace%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7842  & number_of_dimensions_laplace,err,error,*999)
7843  ELSE
7844  CALL flagerror("Laplace solver mapping is not associated.",err,error,*999)
7845  END IF
7846  ELSE
7847  CALL flagerror("Laplace solver equations are not associated.",err,error,*999)
7848  END IF
7849  !Get the independent field for the ALE Navier-Stokes problem
7850  CALL solvers_solver_get(solver%SOLVERS,2,solver_ale_navier_stokes,err,error,*999)
7851  solver_equations_ale_navier_stokes=>solver_ale_navier_stokes%SOLVER_EQUATIONS
7852  IF(ASSOCIATED(solver_equations_ale_navier_stokes)) THEN
7853  solver_mapping_ale_navier_stokes=>solver_equations_ale_navier_stokes%SOLVER_MAPPING
7854  IF(ASSOCIATED(solver_mapping_ale_navier_stokes)) THEN
7855  equations_set_ale_navier_stokes=>solver_mapping_ale_navier_stokes%EQUATIONS_SETS(1)%PTR
7856  IF(ASSOCIATED(equations_set_ale_navier_stokes)) THEN
7857  independent_field_ale_navier_stokes=>equations_set_ale_navier_stokes%INDEPENDENT%INDEPENDENT_FIELD
7858  ELSE
7859  CALL flagerror("ALE Navier-Stokes equations set is not associated.",err,error,*999)
7860  END IF
7861  CALL field_number_of_components_get(equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD, &
7862  & field_u_variable_type,number_of_dimensions_ale_navier_stokes,err,error,*999)
7863  ELSE
7864  CALL flagerror("ALE Navier-Stokes solver mapping is not associated.",err,error,*999)
7865  END IF
7866  ELSE
7867  CALL flagerror("ALE Navier-Stokes solver equations are not associated.",err,error,*999)
7868  END IF
7869  !Copy result from Laplace mesh movement to Navier-Stokes' independent field
7870  IF(number_of_dimensions_ale_navier_stokes==number_of_dimensions_laplace) THEN
7871  DO i=1,number_of_dimensions_ale_navier_stokes
7872  CALL field_parameterstofieldparameterscopy(dependent_field_laplace, &
7873  & field_u_variable_type,field_values_set_type,i,independent_field_ale_navier_stokes, &
7874  & field_u_variable_type,field_mesh_displacement_set_type,i,err,error,*999)
7875  END DO
7876  ELSE
7877  CALL flagerror("Dimension of Laplace and ALE Navier-Stokes equations set is not consistent.",err,error,*999)
7878  END IF
7879  !Use calculated values to update mesh
7880  CALL field_component_mesh_component_get(equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD, &
7881  & field_u_variable_type,1,geometric_mesh_component,err,error,*999)
7882  NULLIFY(mesh_displacement_values)
7883  CALL field_parameter_set_data_get(independent_field_ale_navier_stokes,field_u_variable_type, &
7884  & field_mesh_displacement_set_type,mesh_displacement_values,err,error,*999)
7885  equations=>solver_mapping_laplace%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
7886  IF(ASSOCIATED(equations)) THEN
7887  equations_mapping=>equations%EQUATIONS_MAPPING
7888  IF(ASSOCIATED(equations_mapping)) THEN
7889  DO variable_idx=1,equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD%NUMBER_OF_VARIABLES
7890  variable_type=equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD%VARIABLES(variable_idx)%VARIABLE_TYPE
7891  field_variable=>equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD% &
7892  & variable_type_map(variable_type)%PTR
7893  IF(ASSOCIATED(field_variable)) THEN
7894  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
7895  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
7896  IF(ASSOCIATED(domain)) THEN
7897  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
7898  domain_nodes=>domain%TOPOLOGY%NODES
7899  IF(ASSOCIATED(domain_nodes)) THEN
7900  !Loop over the local nodes excluding the ghosts.
7901  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
7902  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
7903  !Default to version 1 of each node derivative
7904  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
7905  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
7906  CALL field_parameter_set_add_local_dof(equations_set_ale_navier_stokes%GEOMETRY% &
7907  & geometric_field,field_u_variable_type,field_values_set_type,local_ny, &
7908  & mesh_displacement_values(local_ny),err,error,*999)
7909  END DO !deriv_idx
7910  END DO !node_idx
7911  END IF
7912  END IF
7913  END IF
7914  END DO !componentIdx
7915  END IF
7916  END DO !variable_idx
7917  ELSE
7918  CALL flagerror("Equations mapping is not associated.",err,error,*999)
7919  END IF
7920  CALL field_parameter_set_data_restore(independent_field_ale_navier_stokes,field_u_variable_type, &
7921  & field_mesh_displacement_set_type,mesh_displacement_values,err,error,*999)
7922  ELSE
7923  CALL flagerror("Equations are not associated.",err,error,*999)
7924  END IF
7925  CALL field_parameter_set_update_start(equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD, &
7926  & field_u_variable_type,field_values_set_type,err,error,*999)
7927  CALL field_parameter_set_update_finish(equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD, &
7928  & field_u_variable_type,field_values_set_type,err,error,*999)
7929  !Now use displacement values to calculate velocity values
7930  time_increment=control_loop%TIME_LOOP%TIME_INCREMENT
7931  alpha=1.0_dp/time_increment
7932  CALL field_parameter_sets_copy(independent_field_ale_navier_stokes,field_u_variable_type, &
7933  & field_mesh_displacement_set_type,field_mesh_velocity_set_type,alpha,err,error,*999)
7934  ELSE
7935  CALL flagerror("Mesh motion calculation not successful for ALE problem.",err,error,*999)
7936  END IF
7937  ELSE
7938  CALL flagerror("Mesh update is not defined for non-dynamic problems.",err,error,*999)
7939  END IF
7940  CASE DEFAULT
7941  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
7942  & " is not valid for a Navier-Stokes equation fluid type of a fluid mechanics problem class."
7943  CALL flagerror(local_error,err,error,*999)
7944  END SELECT
7945  CASE(problem_multi_physics_class)
7946  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(2))
7947  CASE(problem_finite_elasticity_navier_stokes_type)
7948  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
7949  CASE(problem_finite_elasticity_navier_stokes_ale_subtype)
7950  !Update mesh within the dynamic solver
7951  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
7952  IF(solver%DYNAMIC_SOLVER%ALE) THEN
7953  !Get the dependent field for the Laplace problem
7954  ! CALL SOLVERS_SOLVER_GET(SOLVER%SOLVERS,1,SOLVER_LAPLACE,ERR,ERROR,*999)
7955  CALL solvers_solver_get(solver%SOLVERS,2,solver_laplace,err,error,*999)
7956  solver_equations_laplace=>solver_laplace%SOLVER_EQUATIONS
7957  IF(ASSOCIATED(solver_equations_laplace)) THEN
7958  solver_mapping_laplace=>solver_equations_laplace%SOLVER_MAPPING
7959  IF(ASSOCIATED(solver_mapping_laplace)) THEN
7960  equations_set_laplace=>solver_mapping_laplace%EQUATIONS_SETS(1)%PTR
7961  IF(ASSOCIATED(equations_set_laplace)) THEN
7962  dependent_field_laplace=>equations_set_laplace%DEPENDENT%DEPENDENT_FIELD
7963  ELSE
7964  CALL flagerror("Laplace equations set is not associated.",err,error,*999)
7965  END IF
7966  CALL field_number_of_components_get(equations_set_laplace%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
7967  & number_of_dimensions_laplace,err,error,*999)
7968  ELSE
7969  CALL flagerror("Laplace solver mapping is not associated.",err,error,*999)
7970  END IF
7971  ELSE
7972  CALL flagerror("Laplace solver equations are not associated.",err,error,*999)
7973  END IF
7974  !Get the independent field for the ALE Navier-Stokes problem
7975  ! CALL SOLVERS_SOLVER_GET(SOLVER%SOLVERS,2,SOLVER_ALE_NAVIER_STOKES,ERR,ERROR,*999)
7976  CALL solvers_solver_get(solver%SOLVERS,1,solver_ale_navier_stokes,err,error,*999)
7977  solver_equations_ale_navier_stokes=>solver_ale_navier_stokes%SOLVER_EQUATIONS
7978  IF(ASSOCIATED(solver_equations_ale_navier_stokes)) THEN
7979  solver_mapping_ale_navier_stokes=>solver_equations_ale_navier_stokes%SOLVER_MAPPING
7980  IF(ASSOCIATED(solver_mapping_ale_navier_stokes)) THEN
7981  equationssetindex=1
7982  alenavierstokesequationssetfound=.false.
7983  !Find the NavierStokes equations set as there is a finite elasticity equations set too
7984  DO WHILE (.NOT.alenavierstokesequationssetfound &
7985  & .AND.equationssetindex<=solver_mapping_ale_navier_stokes%NUMBER_OF_EQUATIONS_SETS)
7986  equations_set_ale_navier_stokes=>solver_mapping_ale_navier_stokes%EQUATIONS_SETS(equationssetindex)%PTR
7987  IF(ASSOCIATED(equations_set_ale_navier_stokes)) THEN
7988  IF(equations_set_ale_navier_stokes%SPECIFICATION(1)==equations_set_fluid_mechanics_class &
7989  & .AND.equations_set_ale_navier_stokes%SPECIFICATION(2)==equations_set_navier_stokes_equation_type &
7990  & .AND.equations_set_ale_navier_stokes%SPECIFICATION(3)==equations_set_ale_navier_stokes_subtype) THEN
7991  independent_field_ale_navier_stokes=>equations_set_ale_navier_stokes%INDEPENDENT%INDEPENDENT_FIELD
7992  IF(ASSOCIATED(independent_field_ale_navier_stokes)) alenavierstokesequationssetfound=.true.
7993  ELSE
7994  equationssetindex=equationssetindex+1
7995  END IF
7996  ELSE
7997  CALL flagerror("ALE Navier-Stokes equations set is not associated.",err,error,*999)
7998  END IF
7999  END DO
8000  IF(alenavierstokesequationssetfound.EQV..false.) THEN
8001  CALL flagerror("ALE NavierStokes equations set not found when trying to update ALE mesh.",err,error,*999)
8002  END IF
8003  CALL field_number_of_components_get(equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD, &
8004  & field_u_variable_type,number_of_dimensions_ale_navier_stokes,err,error,*999)
8005  ELSE
8006  CALL flagerror("ALE Navier-Stokes solver mapping is not associated.",err,error,*999)
8007  END IF
8008  ELSE
8009  CALL flagerror("ALE Navier-Stokes solver equations are not associated.",err,error,*999)
8010  END IF
8011  !Copy result from Laplace mesh movement to Navier-Stokes' independent field
8012  IF(number_of_dimensions_ale_navier_stokes==number_of_dimensions_laplace) THEN
8013  DO i=1,number_of_dimensions_ale_navier_stokes
8014  CALL field_parameterstofieldparameterscopy(dependent_field_laplace, &
8015  & field_u_variable_type,field_values_set_type,i,independent_field_ale_navier_stokes, &
8016  & field_u_variable_type,field_mesh_displacement_set_type,i,err,error,*999)
8017  END DO
8018  ELSE
8019  CALL flagerror("Dimension of Laplace and ALE Navier-Stokes equations set is not consistent.",err,error,*999)
8020  END IF
8021  !Use calculated values to update mesh
8022  CALL field_component_mesh_component_get(equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD, &
8023  & field_u_variable_type,1,geometric_mesh_component,err,error,*999)
8024  NULLIFY(mesh_displacement_values)
8025  CALL field_parameter_set_data_get(independent_field_ale_navier_stokes,field_u_variable_type, &
8026  & field_mesh_displacement_set_type,mesh_displacement_values,err,error,*999)
8027  equations=>solver_mapping_laplace%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
8028  IF(ASSOCIATED(equations)) THEN
8029  equations_mapping=>equations%EQUATIONS_MAPPING
8030  IF(ASSOCIATED(equations_mapping)) THEN
8031  DO variable_idx=1,equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD%NUMBER_OF_VARIABLES
8032  variable_type=equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD%VARIABLES(variable_idx)% &
8033  & variable_type
8034  field_variable=>equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD% &
8035  & variable_type_map(variable_type)%PTR
8036  IF(ASSOCIATED(field_variable)) THEN
8037  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
8038  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
8039  IF(ASSOCIATED(domain)) THEN
8040  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
8041  domain_nodes=>domain%TOPOLOGY%NODES
8042  IF(ASSOCIATED(domain_nodes)) THEN
8043  !Loop over the local nodes excluding the ghosts.
8044  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
8045  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
8046  !Default to version 1 of each node derivative
8047  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
8048  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
8049  CALL field_parameter_set_add_local_dof(equations_set_ale_navier_stokes%GEOMETRY% &
8050  & geometric_field,field_u_variable_type,field_values_set_type,local_ny, &
8051  & mesh_displacement_values(local_ny),err,error,*999)
8052  END DO !deriv_idx
8053  END DO !node_idx
8054  END IF
8055  END IF
8056  END IF
8057  END DO !component_idx
8058  END IF
8059  END DO !variable_idx
8060  ELSE
8061  CALL flagerror("Equations mapping is not associated.",err,error,*999)
8062  END IF
8063  CALL field_parameter_set_data_restore(independent_field_ale_navier_stokes,field_u_variable_type, &
8064  & field_mesh_displacement_set_type,mesh_displacement_values,err,error,*999)
8065  ELSE
8066  CALL flagerror("Equations are not associated.",err,error,*999)
8067  END IF
8068  CALL field_parameter_set_update_start(equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD, &
8069  & field_u_variable_type,field_values_set_type,err,error,*999)
8070  CALL field_parameter_set_update_finish(equations_set_ale_navier_stokes%GEOMETRY%GEOMETRIC_FIELD, &
8071  & field_u_variable_type,field_values_set_type,err,error,*999)
8072  !Now use displacement values to calculate velocity values
8073  time_increment=control_loop%TIME_LOOP%TIME_INCREMENT
8074  alpha=1.0_dp/time_increment
8075  CALL field_parameter_sets_copy(independent_field_ale_navier_stokes,field_u_variable_type, &
8076  & field_mesh_displacement_set_type,field_mesh_velocity_set_type,alpha,err,error,*999)
8077  ELSE
8078  CALL flagerror("Mesh motion calculation not successful for ALE problem.",err,error,*999)
8079  END IF
8080  ELSE
8081  CALL flagerror("Mesh update is not defined for non-dynamic problems.",err,error,*999)
8082  END IF
8083  CASE DEFAULT
8084  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
8085  & " is not valid for a FiniteElasticity-NavierStokes type of a multi physics problem class."
8086  END SELECT
8087  CASE DEFAULT
8088  local_error="Problem type "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(2),"*",err,error))// &
8089  & " is not valid for NAVIER_STOKES_PRE_SOLVE_ALE_UPDATE_MESH of a multi physics problem class."
8090  END SELECT
8091  CASE DEFAULT
8092  local_error="Problem class "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(1),"*",err,error))// &
8093  & " is not valid for NAVIER_STOKES_PRE_SOLVE_ALE_UPDATE_MESH."
8094  CALL flagerror(local_error,err,error,*999)
8095  END SELECT
8096  ELSE
8097  CALL flagerror("Problem is not associated.",err,error,*999)
8098  END IF
8099  ELSE
8100  CALL flagerror("Solver is not associated.",err,error,*999)
8101  END IF
8102  ELSE
8103  CALL flagerror("Control loop is not associated.",err,error,*999)
8104  ENDIF
8105 
8106  exits("NAVIER_STOKES_PRE_SOLVE_ALE_UPDATE_MESH")
8107  RETURN
8108 999 errorsexits("NAVIER_STOKES_PRE_SOLVE_ALE_UPDATE_MESH",err,error)
8109  RETURN 1
8110 
8111  END SUBROUTINE navier_stokes_pre_solve_ale_update_mesh
8112 
8113  !
8114  !================================================================================================================================
8115  !
8117  SUBROUTINE navierstokes_presolvealeupdateparameters(SOLVER,ERR,ERROR,*)
8118 
8119  !Argument variables
8120  TYPE(solver_type), POINTER :: SOLVER
8121  INTEGER(INTG), INTENT(OUT) :: ERR
8122  TYPE(varying_string), INTENT(OUT) :: ERROR
8123  !Local Variables
8124  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
8125  TYPE(domain_nodes_type), POINTER :: DOMAIN_NODES
8126  TYPE(domain_type), POINTER :: DOMAIN
8127  TYPE(field_type), POINTER :: INDEPENDENT_FIELD
8128  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE
8129  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
8130  TYPE(equations_type), POINTER :: EQUATIONS
8131  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
8132  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
8133  TYPE(solvers_type), POINTER :: SOLVERS
8134  TYPE(varying_string) :: LOCAL_ERROR
8135  INTEGER(INTG) :: component_idx,deriv_idx,local_ny,node_idx,variable_idx,variable_type
8136  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT
8137  REAL(DP), POINTER :: MESH_STIFF_VALUES(:)
8138 
8139  enters("NavierStokes_PreSolveALEUpdateParameters",err,error,*999)
8140 
8141  IF(ASSOCIATED(solver)) THEN
8142  solvers=>solver%SOLVERS
8143  IF(ASSOCIATED(solvers)) THEN
8144  control_loop=>solvers%CONTROL_LOOP
8145  CALL control_loop_current_times_get(control_loop,current_time,time_increment,err,error,*999)
8146  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
8147  IF(.NOT.ALLOCATED(control_loop%problem%specification)) THEN
8148  CALL flagerror("Problem specification array is not allocated.",err,error,*999)
8149  ELSE IF(SIZE(control_loop%problem%specification,1)<3) THEN
8150  CALL flagerror("Problem specification must have three entries for a Navier-Stokes problem.",err,error,*999)
8151  END IF
8152  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(1))
8153  CASE(problem_fluid_mechanics_class)
8154  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
8155  CASE(problem_static_navier_stokes_subtype,problem_laplace_navier_stokes_subtype)
8156  ! do nothing ???
8157  CASE(problem_transient_navier_stokes_subtype)
8158  ! do nothing ???
8159  CASE(problem_transient_rbs_navier_stokes_subtype,problem_multiscale_navier_stokes_subtype)
8160  ! do nothing ???
8161  CASE(problem_transient1d_navier_stokes_subtype,problem_coupled1d0d_navier_stokes_subtype, &
8162  & problem_transient1d_adv_navier_stokes_subtype,problem_coupled1d0d_adv_navier_stokes_subtype)
8163  ! do nothing ???
8164  CASE(problem_ale_navier_stokes_subtype)
8165  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
8166  !Get the independent field for the ALE Navier-Stokes problem
8167  solver_equations=>solver%SOLVER_EQUATIONS
8168  IF(ASSOCIATED(solver_equations)) THEN
8169  solver_mapping=>solver_equations%SOLVER_MAPPING
8170  IF(ASSOCIATED(solver_mapping)) THEN
8171  equations_set=>solver_mapping%EQUATIONS_SETS(1)%PTR
8172  NULLIFY(mesh_stiff_values)
8173  CALL field_parameter_set_data_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
8174  & field_values_set_type,mesh_stiff_values,err,error,*999)
8175  IF(ASSOCIATED(equations_set)) THEN
8176  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
8177  IF(ASSOCIATED(equations)) THEN
8178  independent_field=>equations_set%INDEPENDENT%INDEPENDENT_FIELD
8179  IF(ASSOCIATED(independent_field)) THEN
8180  DO variable_idx=1,equations_set%DEPENDENT%DEPENDENT_FIELD%NUMBER_OF_VARIABLES
8181  variable_type=equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLES(variable_idx)%VARIABLE_TYPE
8182  field_variable=>equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLE_TYPE_MAP(variable_type)%PTR
8183  IF(ASSOCIATED(field_variable)) THEN
8184  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
8185  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
8186  IF(ASSOCIATED(domain)) THEN
8187  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
8188  domain_nodes=>domain%TOPOLOGY%NODES
8189  IF(ASSOCIATED(domain_nodes)) THEN
8190  !Loop over the local nodes excluding the ghosts.
8191  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
8192  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
8193  !Default to version 1 of each node derivative
8194  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
8195  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
8196  !Calculation of K values dependent on current mesh topology
8197  mesh_stiff_values(local_ny)=1.0_dp
8198  CALL field_parameter_set_update_local_dof(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
8199  & field_u_variable_type,field_values_set_type,local_ny, &
8200  & mesh_stiff_values(local_ny),err,error,*999)
8201  END DO !deriv_idx
8202  END DO !node_idx
8203  END IF
8204  END IF
8205  END IF
8206  END DO !component_idx
8207  END IF
8208  END DO !variable_idx
8209  ELSE
8210  CALL flagerror("Independent field is not associated.",err,error,*999)
8211  END IF
8212  ELSE
8213  CALL flagerror("Equations are not associated.",err,error,*999)
8214  END IF
8215  ELSE
8216  CALL flagerror("Equations set is not associated.",err,error,*999)
8217  END IF
8218  CALL field_parameter_set_data_restore(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
8219  & field_values_set_type,mesh_stiff_values,err,error,*999)
8220  ELSE
8221  CALL flagerror("Solver mapping is not associated.",err,error,*999)
8222  END IF
8223  ELSE
8224  CALL flagerror("Solver equations are not associated.",err,error,*999)
8225  END IF
8226  ELSE IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
8227  CALL flagerror("Mesh motion calculation not successful for ALE problem.",err,error,*999)
8228  END IF
8229  CASE DEFAULT
8230  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
8231  & " is not valid for a Navier-Stokes equation fluid type of a fluid mechanics problem class."
8232  CALL flagerror(local_error,err,error,*999)
8233  END SELECT
8234  CASE(problem_multi_physics_class)
8235  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(2))
8236  CASE(problem_finite_elasticity_navier_stokes_type)
8237  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
8238  CASE(problem_finite_elasticity_navier_stokes_ale_subtype)
8239  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
8240  !Get the independent field for the ALE Navier-Stokes problem
8241  solver_equations=>solver%SOLVER_EQUATIONS
8242  IF(ASSOCIATED(solver_equations)) THEN
8243  solver_mapping=>solver_equations%SOLVER_MAPPING
8244  IF(ASSOCIATED(solver_mapping)) THEN
8245  equations_set=>solver_mapping%EQUATIONS_SETS(1)%PTR
8246  NULLIFY(mesh_stiff_values)
8247  CALL field_parameter_set_data_get(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
8248  & field_values_set_type,mesh_stiff_values,err,error,*999)
8249  IF(ASSOCIATED(equations_set)) THEN
8250  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
8251  IF(ASSOCIATED(equations)) THEN
8252  independent_field=>equations_set%INDEPENDENT%INDEPENDENT_FIELD
8253  IF(ASSOCIATED(independent_field)) THEN
8254  DO variable_idx=1,equations_set%DEPENDENT%DEPENDENT_FIELD%NUMBER_OF_VARIABLES
8255  variable_type=equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLES(variable_idx)%VARIABLE_TYPE
8256  field_variable=>equations_set%DEPENDENT%DEPENDENT_FIELD%VARIABLE_TYPE_MAP(variable_type)%PTR
8257  IF(ASSOCIATED(field_variable)) THEN
8258  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
8259  domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
8260  IF(ASSOCIATED(domain)) THEN
8261  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
8262  domain_nodes=>domain%TOPOLOGY%NODES
8263  IF(ASSOCIATED(domain_nodes)) THEN
8264  !Loop over the local nodes excluding the ghosts.
8265  DO node_idx=1,domain_nodes%NUMBER_OF_NODES
8266  DO deriv_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
8267  !Default to version 1 of each node derivative
8268  local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
8269  & node_param2dof_map%NODES(node_idx)%DERIVATIVES(deriv_idx)%VERSIONS(1)
8270  !Calculation of K values dependent on current mesh topology
8271  mesh_stiff_values(local_ny)=1.0_dp
8272  CALL field_parameter_set_update_local_dof(equations_set%INDEPENDENT% &
8273  & independent_field,field_u_variable_type,field_values_set_type,local_ny, &
8274  & mesh_stiff_values(local_ny),err,error,*999)
8275  END DO !deriv_idx
8276  END DO !node_idx
8277  END IF
8278  END IF
8279  END IF
8280  END DO !component_idx
8281  END IF
8282  END DO !variable_idx
8283  ELSE
8284  CALL flagerror("Independent field is not associated.",err,error,*999)
8285  END IF
8286  ELSE
8287  CALL flagerror("Equations are not associated.",err,error,*999)
8288  END IF
8289  ELSE
8290  CALL flagerror("Equations set is not associated.",err,error,*999)
8291  END IF
8292  CALL field_parameter_set_data_restore(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
8293  & field_values_set_type,mesh_stiff_values,err,error,*999)
8294  ELSE
8295  CALL flagerror("Solver mapping is not associated.",err,error,*999)
8296  END IF
8297  ELSE
8298  CALL flagerror("Solver equations are not associated.",err,error,*999)
8299  END IF
8300  ELSE IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
8301  CALL flagerror("Mesh motion calculation not successful for ALE problem.",err,error,*999)
8302  END IF
8303  CASE DEFAULT
8304  local_error="The third problem specification of "// &
8305  & trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
8306  & " is not valid for a FiniteElasticity-NavierStokes type of a multi physics problem."
8307  CALL flagerror(local_error,err,error,*999)
8308  END SELECT
8309  CASE DEFAULT
8310  local_error="The second problem specification of "// &
8311  & trim(number_to_vstring(control_loop%PROBLEM%specification(2),"*",err,error))// &
8312  & " is not valid for NavierStokes_PreSolveALEUpdateParameters of a multi physics problem."
8313  CALL flagerror(local_error,err,error,*999)
8314  END SELECT
8315  CASE DEFAULT
8316  local_error="The first problem specification of "// &
8317  & trim(number_to_vstring(control_loop%PROBLEM%specification(1),"*",err,error))// &
8318  & " is not valid for NavierStokes_PreSolveALEUpdateParameters."
8319  CALL flagerror(local_error,err,error,*999)
8320  END SELECT
8321  ELSE
8322  CALL flagerror("Problem is not associated.",err,error,*999)
8323  END IF
8324  ELSE
8325  CALL flagerror("Solver is not associated.",err,error,*999)
8326  END IF
8327  ELSE
8328  CALL flagerror("Control loop is not associated.",err,error,*999)
8329  ENDIF
8330 
8331  exits("NavierStokes_PreSolveALEUpdateParameters")
8332  RETURN
8333 999 errorsexits("NavierStokes_PreSolveALEUpdateParameters",err,error)
8334  RETURN 1
8335 
8336  END SUBROUTINE navierstokes_presolvealeupdateparameters
8337 
8338  !
8339  !================================================================================================================================
8340  !
8341 
8343  SUBROUTINE navier_stokes_post_solve_output_data(SOLVER,ERR,ERROR,*)
8344 
8345  !Argument variables
8346  TYPE(solver_type), POINTER :: SOLVER
8347  INTEGER(INTG), INTENT(OUT) :: ERR
8348  TYPE(varying_string), INTENT(OUT) :: ERROR
8349  !Local Variables
8350  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
8351  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
8352  TYPE(fields_type), POINTER :: Fields
8353  TYPE(region_type), POINTER :: DEPENDENT_REGION
8354  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
8355  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
8356  TYPE(solvers_type), POINTER :: SOLVERS
8357  TYPE(varying_string) :: LOCAL_ERROR,METHOD,VFileName,FILENAME
8358  INTEGER(INTG) :: EQUATIONS_SET_IDX,CURRENT_LOOP_ITERATION,OUTPUT_ITERATION_NUMBER
8359  INTEGER(INTG) :: NUMBER_OF_DIMENSIONS,FileNameLength
8360  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT,START_TIME,STOP_TIME
8361  LOGICAL :: EXPORT_FIELD
8362  CHARACTER(14) :: FILE,OUTPUT_FILE
8363 
8364  NULLIFY(fields)
8365 
8366  enters("NAVIER_STOKES_POST_SOLVE_OUTPUT_DATA",err,error,*999)
8367 
8368  IF(ASSOCIATED(solver)) THEN
8369  solvers=>solver%SOLVERS
8370  IF(ASSOCIATED(solvers)) THEN
8371  control_loop=>solvers%CONTROL_LOOP
8372  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
8373  IF(.NOT.ALLOCATED(control_loop%problem%specification)) THEN
8374  CALL flagerror("Problem specification array is not allocated.",err,error,*999)
8375  ELSE IF(SIZE(control_loop%problem%specification,1)<3) THEN
8376  CALL flagerror("Problem specification must have three entries for a Navier-Stokes problem.",err,error,*999)
8377  END IF
8378  SELECT CASE(control_loop%PROBLEM%specification(3))
8379  CASE(problem_static_navier_stokes_subtype, &
8380  & problem_laplace_navier_stokes_subtype)
8381  solver_equations=>solver%SOLVER_EQUATIONS
8382  IF(ASSOCIATED(solver_equations)) THEN
8383  solver_mapping=>solver_equations%SOLVER_MAPPING
8384  IF(ASSOCIATED(solver_mapping)) THEN
8385  !Make sure the equations sets are up to date
8386  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
8387  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
8388  method="FORTRAN"
8389  export_field=.true.
8390  IF(export_field) THEN
8391  output_file = "StaticSolution"
8392  filenamelength = len_trim(output_file)
8393  vfilename = output_file(1:filenamelength)
8394  CALL write_string(general_output_type,"...",err,error,*999)
8395  fields=>equations_set%REGION%FIELDS
8396  CALL field_io_nodes_export(fields,vfilename,method,err,error,*999)
8397  CALL write_string(general_output_type,"Now export elements... ",err,error,*999)
8398  CALL field_io_elements_export(fields,vfilename,method,err,error,*999)
8399  NULLIFY(fields)
8400  CALL write_string(general_output_type,output_file,err,error,*999)
8401  CALL write_string(general_output_type,"...",err,error,*999)
8402  END IF
8403  END DO
8404  END IF
8405  END IF
8406 
8407  CASE(problem_transient_navier_stokes_subtype, &
8408  & problem_ale_navier_stokes_subtype, &
8409  & problem_pgm_navier_stokes_subtype, &
8410  & problem_quasistatic_navier_stokes_subtype, &
8411  & problem_transient_rbs_navier_stokes_subtype, &
8412  & problem_multiscale_navier_stokes_subtype)
8413 
8414  CALL control_loop_current_times_get(control_loop,current_time,time_increment,err,error,*999)
8415  solver_equations=>solver%SOLVER_EQUATIONS
8416  IF(ASSOCIATED(solver_equations)) THEN
8417  solver_mapping=>solver_equations%SOLVER_MAPPING
8418  IF(ASSOCIATED(solver_mapping)) THEN
8419  !Make sure the equations sets are up to date
8420  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
8421  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
8422  current_loop_iteration=control_loop%TIME_LOOP%ITERATION_NUMBER
8423  output_iteration_number=control_loop%TIME_LOOP%OUTPUT_NUMBER
8424  IF(output_iteration_number/=0) THEN
8425  IF(control_loop%TIME_LOOP%CURRENT_TIME<=control_loop%TIME_LOOP%STOP_TIME) THEN
8426  WRITE(output_file,'("TimeStep_",I0)') current_loop_iteration
8427  file=output_file
8428  method="FORTRAN"
8429  export_field=.true.
8430  IF(mod(current_loop_iteration,output_iteration_number)==0) THEN
8431  !Use standard field IO routines (also only export nodes after first step as not a moving mesh case)
8432  filenamelength = len_trim(output_file)
8433  vfilename = output_file(1:filenamelength)
8434  CALL write_string(general_output_type,"...",err,error,*999)
8435  fields=>equations_set%REGION%FIELDS
8436  CALL field_io_nodes_export(fields,vfilename,method,err,error,*999)
8437 ! CALL FLUID_MECHANICS_IO_WRITE_CMGUI(EQUATIONS_SET%REGION,EQUATIONS_SET%GLOBAL_NUMBER,FILE, &
8438 ! & ERR,ERROR,*999)
8439  IF(current_loop_iteration==0) THEN
8440  CALL write_string(general_output_type,"Now export elements... ",err,error,*999)
8441  CALL field_io_elements_export(fields,vfilename,method,err,error,*999)
8442  END IF
8443  NULLIFY(fields)
8444  CALL write_string(general_output_type,output_file,err,error,*999)
8445  CALL write_string(general_output_type,"...",err,error,*999)
8446  END IF
8447 ! ELSE IF(EXPORT_FIELD) THEN
8448 ! IF(MOD(CURRENT_LOOP_ITERATION,OUTPUT_ITERATION_NUMBER)==0) THEN
8449 ! CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"...",ERR,ERROR,*999)
8450 ! CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"Now export fields... ",ERR,ERROR,*999)
8451 ! CALL FLUID_MECHANICS_IO_WRITE_CMGUI(EQUATIONS_SET%REGION,EQUATIONS_SET%GLOBAL_NUMBER,FILE, &
8452 ! & ERR,ERROR,*999)
8453 ! CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,OUTPUT_FILE,ERR,ERROR,*999)
8454 ! CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"...",ERR,ERROR,*999)
8455 ! CALL FIELD_NUMBER_OF_COMPONENTS_GET(EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
8456 ! & NUMBER_OF_DIMENSIONS,ERR,ERROR,*999)
8457 ! IF(NUMBER_OF_DIMENSIONS==3) THEN
8458 ! !\todo: Allow user to choose whether or not ENCAS ouput is activated (default = NO)
8459 ! EXPORT_FIELD=.FALSE.
8460 ! IF(EXPORT_FIELD) THEN
8461 ! CALL FLUID_MECHANICS_IO_WRITE_ENCAS(EQUATIONS_SET%REGION,EQUATIONS_SET%GLOBAL_NUMBER,FILE, &
8462 ! & ERR,ERROR,*999)
8463 ! CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,OUTPUT_FILE,ERR,ERROR,*999)
8464 ! CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"...",ERR,ERROR,*999)
8465 ! END IF
8466 ! END IF
8467 ! END IF
8468 ! END IF
8469  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
8470  IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_two_dim_4.OR. &
8471  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_two_dim_5.OR. &
8472  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_three_dim_4.OR. &
8473  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_three_dim_5.OR. &
8474  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_one_dim_1.OR. &
8475  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_three_dim_1) THEN
8476  CALL analyticanalysis_output(equations_set%DEPENDENT%DEPENDENT_FIELD,file,err,error,*999)
8477  END IF
8478  END IF
8479  END IF
8480  END IF
8481  END DO
8482  END IF
8483  END IF
8484 
8485  CASE(problem_transient1d_navier_stokes_subtype, &
8486  & problem_coupled1d0d_navier_stokes_subtype, &
8487  & problem_transient1d_adv_navier_stokes_subtype, &
8488  & problem_coupled1d0d_adv_navier_stokes_subtype, &
8489  & problem_stree1d0d_navier_stokes_subtype, &
8490  & problem_stree1d0d_adv_navier_stokes_subtype)
8491 
8492  CALL control_loop_times_get(control_loop,start_time,stop_time,current_time,time_increment, &
8493  & current_loop_iteration,output_iteration_number,err,error,*999)
8494  solver_equations=>solver%SOLVER_EQUATIONS
8495  IF(ASSOCIATED(solver_equations)) THEN
8496  solver_mapping=>solver_equations%SOLVER_MAPPING
8497  IF(ASSOCIATED(solver_mapping)) THEN
8498  !Make sure the equations sets are up to date
8499  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
8500  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
8501  IF(output_iteration_number/=0) THEN
8502  IF(current_time<=stop_time) THEN
8503  IF(current_loop_iteration<10) THEN
8504  WRITE(output_file,'("TIME_STEP_000",I0)') current_loop_iteration
8505  ELSE IF(current_loop_iteration<100) THEN
8506  WRITE(output_file,'("TIME_STEP_00",I0)') current_loop_iteration
8507  ELSE IF(current_loop_iteration<1000) THEN
8508  WRITE(output_file,'("TIME_STEP_0",I0)') current_loop_iteration
8509  ELSE IF(current_loop_iteration<10000) THEN
8510  WRITE(output_file,'("TIME_STEP_",I0)') current_loop_iteration
8511  END IF
8512  dependent_region=>equations_set%REGION
8513  file=output_file
8514  filename="./output/"//"MainTime_"//trim(number_to_vstring(current_loop_iteration,"*",err,error))
8515  method="FORTRAN"
8516  export_field=.true.
8517  IF(export_field) THEN
8518  IF(mod(current_loop_iteration,output_iteration_number)==0) THEN
8519  CALL write_string(general_output_type,"...",err,error,*999)
8520  CALL write_string(general_output_type,"Now export fields... ",err,error,*999)
8521  CALL field_io_nodes_export(dependent_region%FIELDS,filename,method,err,error,*999)
8522  CALL field_io_elements_export(dependent_region%FIELDS,filename,method,err,error,*999)
8523  CALL write_string(general_output_type,filename,err,error,*999)
8524  CALL write_string(general_output_type,"...",err,error,*999)
8525  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
8526  & number_of_dimensions,err,error,*999)
8527  IF(number_of_dimensions==3) THEN
8528  export_field=.false.
8529  IF(export_field) THEN
8530  CALL fluid_mechanics_io_write_encas(equations_set%REGION,equations_set%GLOBAL_NUMBER,file, &
8531  & err,error,*999)
8532  CALL write_string(general_output_type,output_file,err,error,*999)
8533  CALL write_string(general_output_type,"...",err,error,*999)
8534  END IF
8535  END IF
8536  END IF
8537  END IF
8538  IF(ASSOCIATED(equations_set%ANALYTIC)) THEN
8539  IF(equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_two_dim_4.OR. &
8540  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_two_dim_5.OR. &
8541  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_three_dim_4.OR. &
8542  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_three_dim_5.OR. &
8543  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_one_dim_1.OR. &
8544  & equations_set%ANALYTIC%ANALYTIC_FUNCTION_TYPE==equations_set_navier_stokes_equation_three_dim_1) THEN
8545  CALL analyticanalysis_output(equations_set%DEPENDENT%DEPENDENT_FIELD,file,err,error,*999)
8546  END IF
8547  END IF
8548  END IF
8549  END IF
8550  END DO
8551  END IF
8552  END IF
8553  CASE DEFAULT
8554  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
8555  & " is not valid for a Navier-Stokes equation fluid type of a fluid mechanics problem class."
8556  CALL flagerror(local_error,err,error,*999)
8557  END SELECT
8558  ELSE
8559  CALL flagerror("Control loop is not associated.",err,error,*999)
8560  END IF
8561  ELSE
8562  CALL flagerror("Solvers is not associated.",err,error,*999)
8563  END IF
8564  ELSE
8565  CALL flagerror("Solver is not associated.",err,error,*999)
8566  ENDIF
8567 
8568  exits("NAVIER_STOKES_POST_SOLVE_OUTPUT_DATA")
8569  RETURN
8570 999 errorsexits("NAVIER_STOKES_POST_SOLVE_OUTPUT_DATA",err,error)
8571  RETURN 1
8572 
8573  END SUBROUTINE navier_stokes_post_solve_output_data
8574 
8575  !
8576  !================================================================================================================================
8577  !
8578 
8580  SUBROUTINE navierstokes_boundaryconditionsanalyticcalculate(equationsSet,boundaryConditions,err,error,*)
8581 
8582  !Argument variables
8583  TYPE(equations_set_type), POINTER :: equationsSet
8584  TYPE(boundary_conditions_type), POINTER :: boundaryConditions
8585  INTEGER(INTG), INTENT(OUT) :: err
8586  TYPE(varying_string), INTENT(OUT) :: error
8587  !Local Variables
8588  TYPE(boundary_conditions_variable_type), POINTER :: boundaryConditionsVariable
8589  TYPE(domain_nodes_type), POINTER :: domainNodes
8590  TYPE(domain_type), POINTER :: domain
8591  TYPE(field_interpolated_point_ptr_type), POINTER :: interpolatedPoint(:)
8592  TYPE(field_interpolation_parameters_ptr_type), POINTER :: interpolationParameters(:)
8593  TYPE(field_type), POINTER :: analyticField,dependentField,geometricField,materialsField
8594  TYPE(field_variable_type), POINTER :: fieldVariable,geometricVariable,analyticVariable,materialsVariable
8595  TYPE(varying_string) :: localError
8596  INTEGER(INTG) :: componentIdx,derivativeIdx,dimensionIdx,local_ny,nodeIdx,numberOfDimensions,variableIdx,variableType,I,J,K
8597  INTEGER(INTG) :: numberOfNodesXiCoord(3),elementIdx,en_idx,boundaryCount,analyticFunctionType,globalDerivativeIndex,versionIdx
8598  INTEGER(INTG) :: boundaryConditionsCheckVariable,numberOfXi,nodeNumber,userNodeNumber,localDof,globalDof
8599  INTEGER(INTG) :: parameterIdx,numberOfParameters
8600  REAL(DP) :: TIME,VALUE,X(3),xiCoordinates(3),initialValue,T_COORDINATES(20,3),nodeAnalyticParameters(10)
8601  REAL(DP), POINTER :: analyticParameters(:),geometricParameters(:),materialsParameters(:)
8602 
8603  enters("NavierStokes_BoundaryConditionsAnalyticCalculate",err,error,*999)
8604 
8605  boundarycount=0
8606  xicoordinates(3)=0.0_dp
8607 
8608  IF(ASSOCIATED(equationsset)) THEN
8609  IF(ASSOCIATED(equationsset%ANALYTIC)) THEN
8610  dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
8611  IF(ASSOCIATED(dependentfield)) THEN
8612  geometricfield=>equationsset%GEOMETRY%GEOMETRIC_FIELD
8613  IF(ASSOCIATED(geometricfield)) THEN
8614  ! Geometric parameters
8615  CALL field_number_of_components_get(geometricfield,field_u_variable_type,numberofdimensions,err,error,*999)
8616  NULLIFY(geometricvariable)
8617  CALL field_variable_get(geometricfield,field_u_variable_type,geometricvariable,err,error,*999)
8618  NULLIFY(geometricparameters)
8619  CALL field_parameter_set_data_get(geometricfield,field_u_variable_type,field_values_set_type,geometricparameters, &
8620  & err,error,*999)
8621  ! Analytic parameters
8622  analyticfunctiontype=equationsset%ANALYTIC%ANALYTIC_FUNCTION_TYPE
8623  analyticfield=>equationsset%ANALYTIC%ANALYTIC_FIELD
8624  NULLIFY(analyticvariable)
8625  NULLIFY(analyticparameters)
8626  IF(ASSOCIATED(analyticfield)) THEN
8627  CALL field_variable_get(analyticfield,field_u_variable_type,analyticvariable,err,error,*999)
8628  CALL field_parameter_set_data_get(analyticfield,field_u_variable_type,field_values_set_type, &
8629  & analyticparameters,err,error,*999)
8630  END IF
8631  ! Materials parameters
8632  NULLIFY(materialsfield)
8633  NULLIFY(materialsvariable)
8634  NULLIFY(materialsparameters)
8635  IF(ASSOCIATED(equationsset%MATERIALS)) THEN
8636  materialsfield=>equationsset%MATERIALS%MATERIALS_FIELD
8637  CALL field_variable_get(materialsfield,field_u_variable_type,materialsvariable,err,error,*999)
8638  CALL field_parameter_set_data_get(materialsfield,field_u_variable_type,field_values_set_type, &
8639  & materialsparameters,err,error,*999)
8640  END IF
8641  time=equationsset%ANALYTIC%ANALYTIC_TIME
8642  ! Interpolation parameters
8643  NULLIFY(interpolationparameters)
8644  CALL field_interpolation_parameters_initialise(geometricfield,interpolationparameters,err,error,*999)
8645  NULLIFY(interpolatedpoint)
8646  CALL field_interpolated_points_initialise(interpolationparameters,interpolatedpoint,err,error,*999)
8647  CALL field_number_of_components_get(geometricfield,field_u_variable_type,numberofdimensions,err,error,*999)
8648  ELSE
8649  CALL flagerror("Equations set geometric field is not associated.",err,error,*999)
8650  END IF
8651  ELSE
8652  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
8653  END IF
8654  ELSE
8655  CALL flagerror("Equations set analytic is not associated.",err,error,*999)
8656  END IF
8657  ELSE
8658  CALL flagerror("Equations set is not associated.",err,error,*999)
8659  END IF
8660 
8661  IF(ASSOCIATED(boundaryconditions)) THEN
8662  DO variableidx=1,dependentfield%NUMBER_OF_VARIABLES
8663  variabletype=dependentfield%VARIABLES(variableidx)%VARIABLE_TYPE
8664  fieldvariable=>dependentfield%VARIABLE_TYPE_MAP(variabletype)%PTR
8665  IF(ASSOCIATED(fieldvariable)) THEN
8666  IF(.NOT.ASSOCIATED(fieldvariable%PARAMETER_SETS%SET_TYPE(field_analytic_values_set_type)%PTR)) &
8667  & CALL field_parameter_set_create(dependentfield,variabletype,field_analytic_values_set_type,err,error,*999)
8668  DO componentidx=1,fieldvariable%NUMBER_OF_COMPONENTS
8669  boundarycount=0
8670  IF(fieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE==field_node_based_interpolation) THEN
8671  domain=>fieldvariable%COMPONENTS(componentidx)%DOMAIN
8672  IF(ASSOCIATED(domain)) THEN
8673  IF(ASSOCIATED(domain%TOPOLOGY)) THEN
8674  domainnodes=>domain%TOPOLOGY%NODES
8675  IF(ASSOCIATED(domainnodes)) THEN
8676  !Loop over the local nodes excluding the ghosts.
8677  DO nodeidx=1,domainnodes%NUMBER_OF_NODES
8678  nodenumber = domainnodes%NODES(nodeidx)%local_number
8679  usernodenumber = domainnodes%NODES(nodeidx)%user_number
8680  elementidx=domain%topology%nodes%nodes(nodenumber)%surrounding_elements(1)
8681  CALL field_interpolation_parameters_element_get(field_values_set_type,elementidx, &
8682  & interpolationparameters(field_u_variable_type)%PTR,err,error,*999)
8683  en_idx=0
8684  xicoordinates=0.0_dp
8685  numberofxi=domain%topology%elements%elements(elementidx)%basis%number_of_xi
8686  numberofnodesxicoord(1)=domain%topology%elements%elements(elementidx)%basis%number_of_nodes_xic(1)
8687  IF(numberofxi>1) THEN
8688  numberofnodesxicoord(2)=domain%topology%elements%elements(elementidx)%basis%number_of_nodes_xic(2)
8689  ELSE
8690  numberofnodesxicoord(2)=1
8691  END IF
8692  IF(numberofxi>2) THEN
8693  numberofnodesxicoord(3)=domain%topology%elements%elements(elementidx)%basis%number_of_nodes_xic(3)
8694  ELSE
8695  numberofnodesxicoord(3)=1
8696  END IF
8697 
8698  SELECT CASE(analyticfunctiontype)
8699  ! --- Calculate analytic profile for validation ---
8700  CASE(equations_set_navier_stokes_equation_two_dim_poiseuille)
8701  IF(variableidx < 3) THEN
8702  ! Get geometric position info for this node
8703  DO dimensionidx=1,numberofdimensions
8704  local_ny=geometricvariable%COMPONENTS(dimensionidx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
8705  & nodes(nodeidx)%DERIVATIVES(1)%VERSIONS(1)
8706  x(dimensionidx)=geometricparameters(local_ny)
8707  END DO !dimensionIdx
8708  DO derivativeidx=1,domainnodes%NODES(nodenumber)%NUMBER_OF_DERIVATIVES
8709  globalderivativeindex=domainnodes%NODES(nodenumber)%DERIVATIVES(derivativeidx)% &
8710  & global_derivative_index
8711  DO versionidx=1,domainnodes%NODES(nodenumber)%DERIVATIVES(derivativeidx)%numberOfVersions
8712  CALL navier_stokes_analytic_functions_evaluate(analyticfunctiontype,x,time,variabletype, &
8713  & globalderivativeindex,componentidx,numberofdimensions,fieldvariable%NUMBER_OF_COMPONENTS, &
8714  & analyticparameters,materialsparameters,VALUE,err,error,*999)
8715  local_ny=fieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP% &
8716  & node_param2dof_map%NODES(nodeidx)%DERIVATIVES(derivativeidx)%VERSIONS(versionidx)
8717  CALL field_parameter_set_update_local_dof(dependentfield,variabletype, &
8718  & field_analytic_values_set_type,local_ny,VALUE,err,error,*999)
8719  END DO !versionIdx
8720  END DO !derivativeIdx
8721  END IF ! variableIdx < 3
8722 
8723  ! --- Set velocity boundary conditions with analytic value ---
8724  CASE(equations_set_navier_stokes_equation_two_dim_taylor_green, &
8725  & equations_set_navier_stokes_equation_sinusoid)
8726  ! Get geometric position info for this node
8727  DO dimensionidx=1,numberofdimensions
8728  local_ny=geometricvariable%COMPONENTS(dimensionidx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
8729  & nodes(nodenumber)%DERIVATIVES(1)%VERSIONS(1)
8730  x(dimensionidx)=geometricparameters(local_ny)
8731  END DO !dimensionIdx
8732  !Loop over the derivatives
8733  DO derivativeidx=1,domainnodes%NODES(nodenumber)%NUMBER_OF_DERIVATIVES
8734  globalderivativeindex=domainnodes%NODES(nodenumber)%DERIVATIVES(derivativeidx)% &
8735  & global_derivative_index
8736  IF(componentidx<=numberofxi .OR. &
8737  & analyticfunctiontype==equations_set_navier_stokes_equation_sinusoid) THEN
8738  DO versionidx=1,domainnodes%NODES(nodenumber)%DERIVATIVES(derivativeidx)%numberOfVersions
8739  ! Get global and local dof indices
8740  CALL field_component_dof_get_user_node(dependentfield,variabletype,versionidx,derivativeidx, &
8741  & usernodenumber,componentidx,localdof,globaldof,err,error,*999)
8742  IF(analyticfunctiontype==equations_set_navier_stokes_equation_sinusoid) THEN
8743  CALL field_number_of_components_get(analyticfield,field_u_variable_type, &
8744  & numberofparameters,err,error,*999)
8745  DO parameteridx=1,numberofparameters
8746  ! populate nodeAnalyticParameters
8747  CALL field_parametersetgetlocalnode(analyticfield,field_u_variable_type,field_values_set_type, &
8748  & versionidx,derivativeidx,nodeidx,parameteridx,nodeanalyticparameters(parameteridx), &
8749  & err,error,*999)
8750  END DO
8751  CALL navier_stokes_analytic_functions_evaluate(analyticfunctiontype,x,time,variabletype, &
8752  & globalderivativeindex,componentidx,numberofdimensions,fieldvariable%NUMBER_OF_COMPONENTS, &
8753  & nodeanalyticparameters,materialsparameters,VALUE,err,error,*999)
8754  ELSE
8755  CALL navier_stokes_analytic_functions_evaluate(analyticfunctiontype,x,time,variabletype, &
8756  & globalderivativeindex,componentidx,numberofdimensions,fieldvariable%NUMBER_OF_COMPONENTS, &
8757  & analyticparameters,materialsparameters,VALUE,err,error,*999)
8758  END IF
8759  ! update analytic field values
8760  CALL field_parameter_set_update_local_dof(dependentfield,variabletype, &
8761  & field_analytic_values_set_type,localdof,VALUE,err,error,*999)
8762  IF(variabletype==field_u_variable_type) THEN
8763  IF(domainnodes%NODES(nodenumber)%BOUNDARY_NODE) THEN
8764  CALL boundary_conditions_variable_get(boundaryconditions,fieldvariable, &
8765  & boundaryconditionsvariable,err,error,*999)
8766  IF(ASSOCIATED(boundaryconditionsvariable)) THEN
8767  boundaryconditionscheckvariable=boundaryconditionsvariable% &
8768  & condition_types(globaldof)
8769  ! update dependent field values if fixed inlet or pressure BC
8770  IF(boundaryconditionscheckvariable==boundary_condition_fixed_inlet) THEN
8771  ! Set velocity/flowrate values
8772  CALL field_parameter_set_update_local_dof(dependentfield,variabletype, &
8773  & field_values_set_type,localdof,VALUE,err,error,*999)
8774  ELSE IF(boundaryconditionscheckvariable==boundary_condition_pressure) THEN
8775  ! Set neumann boundary pressure value on pressure nodes
8776  CALL field_parameter_set_update_local_node(dependentfield,field_u_variable_type, &
8777  & field_pressure_values_set_type,1,1,nodeidx,componentidx,VALUE,err,error,*999)
8778  END IF
8779  END IF
8780  END IF
8781  END IF
8782  END DO !versionIdx
8783  END IF
8784  END DO !derivativeIdx
8785 
8786  ! --- Set Flow rate boundary conditions with analytic value ---
8787  CASE(equations_set_navier_stokes_equation_flowrate_aorta, &
8788  & equations_set_navier_stokes_equation_flowrate_olufsen)
8789  ! Get geometric position info for this node
8790  DO dimensionidx=1,numberofdimensions
8791  local_ny=geometricvariable%COMPONENTS(dimensionidx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
8792  & nodes(nodeidx)%DERIVATIVES(1)%VERSIONS(1)
8793  x(dimensionidx)=geometricparameters(local_ny)
8794  END DO !dimensionIdx
8795  !Loop over the derivatives
8796  DO derivativeidx=1,domainnodes%NODES(nodeidx)%NUMBER_OF_DERIVATIVES
8797  globalderivativeindex=domainnodes%NODES(nodeidx)%DERIVATIVES(derivativeidx)% &
8798  & global_derivative_index
8799  IF(componentidx==1 .AND. variabletype==field_u_variable_type) THEN
8800  DO versionidx=1,domainnodes%NODES(nodeidx)%DERIVATIVES(derivativeidx)%numberOfVersions
8801  local_ny=fieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP% &
8802  & node_param2dof_map%NODES(nodeidx)%DERIVATIVES(derivativeidx)%VERSIONS(versionidx)
8803  IF(domainnodes%NODES(nodeidx)%BOUNDARY_NODE) THEN
8804  CALL boundary_conditions_variable_get(boundaryconditions,fieldvariable, &
8805  & boundaryconditionsvariable,err,error,*999)
8806  IF(ASSOCIATED(boundaryconditionsvariable)) THEN
8807  boundaryconditionscheckvariable=boundaryconditionsvariable%CONDITION_TYPES(local_ny)
8808  IF(boundaryconditionscheckvariable==boundary_condition_fixed_inlet) THEN
8809  CALL navier_stokes_analytic_functions_evaluate(analyticfunctiontype,x,time,variabletype, &
8810  & globalderivativeindex,componentidx,numberofxi,fieldvariable%NUMBER_OF_COMPONENTS, &
8811  & analyticparameters,materialsparameters,VALUE,err,error,*999)
8812  !If we are a boundary node then set the analytic value on the boundary
8813  CALL field_parameter_set_update_local_dof(dependentfield,variabletype, &
8814  & field_values_set_type,local_ny,VALUE,err,error,*999)
8815  ELSE
8816  CALL field_parametersetgetlocalnode(dependentfield,variabletype,field_values_set_type, &
8817  & versionidx,derivativeidx,nodeidx,componentidx,VALUE,err,error,*999)
8818  CALL field_parameter_set_update_local_dof(dependentfield,variabletype, &
8819  & field_analytic_values_set_type,local_ny,VALUE,err,error,*999)
8820  END IF
8821  END IF
8822  END IF
8823  END DO !versionIdx
8824  END IF
8825  END DO !derivativeIdx
8826 
8827  ! --- Legacy unit shape testing types ---
8828  CASE(equations_set_navier_stokes_equation_one_dim_1, &
8829  & equations_set_navier_stokes_equation_two_dim_1, &
8830  & equations_set_navier_stokes_equation_two_dim_2, &
8831  & equations_set_navier_stokes_equation_two_dim_3, &
8832  & equations_set_navier_stokes_equation_two_dim_4, &
8833  & equations_set_navier_stokes_equation_two_dim_5, &
8834  & equations_set_navier_stokes_equation_three_dim_1, &
8835  & equations_set_navier_stokes_equation_three_dim_2, &
8836  & equations_set_navier_stokes_equation_three_dim_3, &
8837  & equations_set_navier_stokes_equation_three_dim_4, &
8838  & equations_set_navier_stokes_equation_three_dim_5)
8839  !Quad/Hex
8840  !\todo: Use boundary flag
8841  IF(domain%topology%elements%maximum_number_of_element_parameters==4.AND.numberofdimensions==2.OR. &
8842  & domain%topology%elements%maximum_number_of_element_parameters==9.OR. &
8843  & domain%topology%elements%maximum_number_of_element_parameters==16.OR. &
8844  & domain%topology%elements%maximum_number_of_element_parameters==8.OR. &
8845  & domain%topology%elements%maximum_number_of_element_parameters==27.OR. &
8846  & domain%topology%elements%maximum_number_of_element_parameters==64) THEN
8847  DO k=1,numberofnodesxicoord(3)
8848  DO j=1,numberofnodesxicoord(2)
8849  DO i=1,numberofnodesxicoord(1)
8850  en_idx=en_idx+1
8851  IF(domain%topology%elements%elements(elementidx)%element_nodes(en_idx)==nodeidx) EXIT
8852  xicoordinates(1)=xicoordinates(1)+(1.0_dp/(numberofnodesxicoord(1)-1))
8853  END DO
8854  IF(domain%topology%elements%elements(elementidx)%element_nodes(en_idx)==nodeidx) EXIT
8855  xicoordinates(1)=0.0_dp
8856  xicoordinates(2)=xicoordinates(2)+(1.0_dp/(numberofnodesxicoord(2)-1))
8857  END DO
8858  IF(domain%topology%elements%elements(elementidx)%element_nodes(en_idx)==nodeidx) EXIT
8859  xicoordinates(1)=0.0_dp
8860  xicoordinates(2)=0.0_dp
8861  IF(numberofnodesxicoord(3)/=1) THEN
8862  xicoordinates(3)=xicoordinates(3)+(1.0_dp/(numberofnodesxicoord(3)-1))
8863  END IF
8864  END DO
8865  CALL field_interpolate_xi(no_part_deriv,xicoordinates, &
8866  & interpolatedpoint(field_u_variable_type)%PTR,err,error,*999)
8867  !Tri/Tet
8868  !\todo: Use boundary flag
8869  ELSE
8870  IF(domain%topology%elements%maximum_number_of_element_parameters==3) THEN
8871  t_coordinates(1,1:2)=[0.0_dp,1.0_dp]
8872  t_coordinates(2,1:2)=[1.0_dp,0.0_dp]
8873  t_coordinates(3,1:2)=[1.0_dp,1.0_dp]
8874  ELSE IF(domain%topology%elements%maximum_number_of_element_parameters==6) THEN
8875  t_coordinates(1,1:2)=[0.0_dp,1.0_dp]
8876  t_coordinates(2,1:2)=[1.0_dp,0.0_dp]
8877  t_coordinates(3,1:2)=[1.0_dp,1.0_dp]
8878  t_coordinates(4,1:2)=[0.5_dp,0.5_dp]
8879  t_coordinates(5,1:2)=[1.0_dp,0.5_dp]
8880  t_coordinates(6,1:2)=[0.5_dp,1.0_dp]
8881  ELSE IF(domain%topology%elements%maximum_number_of_element_parameters==10.AND. &
8882  & numberofdimensions==2) THEN
8883  t_coordinates(1,1:2)=[0.0_dp,1.0_dp]
8884  t_coordinates(2,1:2)=[1.0_dp,0.0_dp]
8885  t_coordinates(3,1:2)=[1.0_dp,1.0_dp]
8886  t_coordinates(4,1:2)=[1.0_dp/3.0_dp,2.0_dp/3.0_dp]
8887  t_coordinates(5,1:2)=[2.0_dp/3.0_dp,1.0_dp/3.0_dp]
8888  t_coordinates(6,1:2)=[1.0_dp,1.0_dp/3.0_dp]
8889  t_coordinates(7,1:2)=[1.0_dp,2.0_dp/3.0_dp]
8890  t_coordinates(8,1:2)=[2.0_dp/3.0_dp,1.0_dp]
8891  t_coordinates(9,1:2)=[1.0_dp/3.0_dp,1.0_dp]
8892  t_coordinates(10,1:2)=[2.0_dp/3.0_dp,2.0_dp/3.0_dp]
8893  ELSE IF(domain%topology%elements%maximum_number_of_element_parameters==4) THEN
8894  t_coordinates(1,1:3)=[0.0_dp,1.0_dp,1.0_dp]
8895  t_coordinates(2,1:3)=[1.0_dp,0.0_dp,1.0_dp]
8896  t_coordinates(3,1:3)=[1.0_dp,1.0_dp,0.0_dp]
8897  t_coordinates(4,1:3)=[1.0_dp,1.0_dp,1.0_dp]
8898  ELSE IF(domain%topology%elements%maximum_number_of_element_parameters==10.AND. &
8899  & numberofdimensions==3) THEN
8900  t_coordinates(1,1:3)=[0.0_dp,1.0_dp,1.0_dp]
8901  t_coordinates(2,1:3)=[1.0_dp,0.0_dp,1.0_dp]
8902  t_coordinates(3,1:3)=[1.0_dp,1.0_dp,0.0_dp]
8903  t_coordinates(4,1:3)=[1.0_dp,1.0_dp,1.0_dp]
8904  t_coordinates(5,1:3)=[0.5_dp,0.5_dp,1.0_dp]
8905  t_coordinates(6,1:3)=[0.5_dp,1.0_dp,0.5_dp]
8906  t_coordinates(7,1:3)=[0.5_dp,1.0_dp,1.0_dp]
8907  t_coordinates(8,1:3)=[1.0_dp,0.5_dp,0.5_dp]
8908  t_coordinates(9,1:3)=[1.0_dp,1.0_dp,0.5_dp]
8909  t_coordinates(10,1:3)=[1.0_dp,0.5_dp,1.0_dp]
8910  ELSE IF(domain%topology%elements%maximum_number_of_element_parameters==20) THEN
8911  t_coordinates(1,1:3)=[0.0_dp,1.0_dp,1.0_dp]
8912  t_coordinates(2,1:3)=[1.0_dp,0.0_dp,1.0_dp]
8913  t_coordinates(3,1:3)=[1.0_dp,1.0_dp,0.0_dp]
8914  t_coordinates(4,1:3)=[1.0_dp,1.0_dp,1.0_dp]
8915  t_coordinates(5,1:3)=[1.0_dp/3.0_dp,2.0_dp/3.0_dp,1.0_dp]
8916  t_coordinates(6,1:3)=[2.0_dp/3.0_dp,1.0_dp/3.0_dp,1.0_dp]
8917  t_coordinates(7,1:3)=[1.0_dp/3.0_dp,1.0_dp,2.0_dp/3.0_dp]
8918  t_coordinates(8,1:3)=[2.0_dp/3.0_dp,1.0_dp,1.0_dp/3.0_dp]
8919  t_coordinates(9,1:3)=[1.0_dp/3.0_dp,1.0_dp,1.0_dp]
8920  t_coordinates(10,1:3)=[2.0_dp/3.0_dp,1.0_dp,1.0_dp]
8921  t_coordinates(11,1:3)=[1.0_dp,1.0_dp/3.0_dp,2.0_dp/3.0_dp]
8922  t_coordinates(12,1:3)=[1.0_dp,2.0_dp/3.0_dp,1.0_dp/3.0_dp]
8923  t_coordinates(13,1:3)=[1.0_dp,1.0_dp,1.0_dp/3.0_dp]
8924  t_coordinates(14,1:3)=[1.0_dp,1.0_dp,2.0_dp/3.0_dp]
8925  t_coordinates(15,1:3)=[1.0_dp,1.0_dp/3.0_dp,1.0_dp]
8926  t_coordinates(16,1:3)=[1.0_dp,2.0_dp/3.0_dp,1.0_dp]
8927  t_coordinates(17,1:3)=[2.0_dp/3.0_dp,2.0_dp/3.0_dp,2.0_dp/3.0_dp]
8928  t_coordinates(18,1:3)=[2.0_dp/3.0_dp,2.0_dp/3.0_dp,1.0_dp]
8929  t_coordinates(19,1:3)=[2.0_dp/3.0_dp,1.0_dp,2.0_dp/3.0_dp]
8930  t_coordinates(20,1:3)=[1.0_dp,2.0_dp/3.0_dp,2.0_dp/3.0_dp]
8931  END IF
8932  DO k=1,domain%topology%elements%maximum_number_of_element_parameters
8933  IF(domain%topology%elements%elements(elementidx)%element_nodes(k)==nodeidx) EXIT
8934  END DO
8935  IF(numberofdimensions==2) THEN
8936  CALL field_interpolate_xi(no_part_deriv,t_coordinates(k,1:2), &
8937  & interpolatedpoint(field_u_variable_type)%PTR,err,error,*999)
8938  ELSE IF(numberofdimensions==3) THEN
8939  CALL field_interpolate_xi(no_part_deriv,t_coordinates(k,1:3), &
8940  & interpolatedpoint(field_u_variable_type)%PTR,err,error,*999)
8941  END IF
8942  END IF
8943  x=0.0_dp
8944  DO dimensionidx=1,numberofdimensions
8945  x(dimensionidx)=interpolatedpoint(field_u_variable_type)%PTR%VALUES(dimensionidx,1)
8946  END DO !dimensionIdx
8947  !Loop over the derivatives
8948  DO derivativeidx=1,domainnodes%NODES(nodeidx)%NUMBER_OF_DERIVATIVES
8949  globalderivativeindex=domainnodes%NODES(nodeidx)%DERIVATIVES(derivativeidx)% &
8950  & global_derivative_index
8951  CALL navier_stokes_analytic_functions_evaluate(analyticfunctiontype,x,time,variabletype, &
8952  & globalderivativeindex,componentidx,numberofdimensions,fieldvariable%NUMBER_OF_COMPONENTS, &
8953  & analyticparameters,materialsparameters,VALUE,err,error,*999)
8954  DO versionidx=1,domainnodes%NODES(nodeidx)%DERIVATIVES(derivativeidx)%numberOfVersions
8955  local_ny=fieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP% &
8956  & node_param2dof_map%NODES(nodeidx)%DERIVATIVES(derivativeidx)%VERSIONS(versionidx)
8957  CALL field_parameter_set_update_local_dof(dependentfield,variabletype, &
8958  & field_analytic_values_set_type,local_ny,VALUE,err,error,*999)
8959  IF(variabletype==field_u_variable_type) THEN
8960  IF(domainnodes%NODES(nodeidx)%BOUNDARY_NODE) THEN
8961  !If we are a boundary node then set the analytic value on the boundary
8962  CALL boundary_conditions_set_local_dof(boundaryconditions,dependentfield,variabletype, &
8963  & local_ny,boundary_condition_fixed,VALUE,err,error,*999)
8964  ! \todo: This is just a workaround for linear pressure fields in simplex element components
8965  IF(componentidx>numberofdimensions) THEN
8966  IF(domain%topology%elements%maximum_number_of_element_parameters==3) THEN
8967  IF(analyticfunctiontype==equations_set_stokes_equation_two_dim_1.OR. &
8968  & analyticfunctiontype==equations_set_stokes_equation_two_dim_2.OR. &
8969  & analyticfunctiontype==equations_set_stokes_equation_two_dim_3.OR. &
8970  & analyticfunctiontype==equations_set_stokes_equation_two_dim_4.OR. &
8971  & analyticfunctiontype==equations_set_stokes_equation_two_dim_5) THEN
8972  IF(-0.001_dp<x(1).AND.x(1)<0.001_dp.AND.-0.001_dp<x(2).AND.x(2)<0.001_dp.OR. &
8973  & 10.0_dp-0.001_dp<x(1).AND.x(1)<10.0_dp+0.001_dp.AND.-0.001_dp<x(2).AND. &
8974  & x(2)<0.001_dp.OR. &
8975  & 10.0_dp-0.001_dp<x(1).AND.x(1)<10.0_dp+0.001_dp.AND.10.0_dp-0.001_dp<x(2).AND. &
8976  & x(2)<10.0_dp+0.001_dp.OR. &
8977  & -0.001_dp<x(1).AND.x(1)<0.001_dp.AND.10.0_dp-0.001_dp<x(2).AND. &
8978  & x(2)<10.0_dp+0.001_dp) THEN
8979  CALL boundary_conditions_set_local_dof(boundaryconditions,dependentfield, &
8980  & variabletype,local_ny,boundary_condition_fixed,VALUE,err,error,*999)
8981  boundarycount=boundarycount+1
8982  END IF
8983  END IF
8984  ELSE IF(domain%topology%elements%maximum_number_of_element_parameters==4.AND. &
8985  & numberofdimensions==3) THEN
8986  IF(analyticfunctiontype==equations_set_stokes_equation_three_dim_1.OR. &
8987  & analyticfunctiontype==equations_set_stokes_equation_three_dim_2.OR. &
8988  & analyticfunctiontype==equations_set_stokes_equation_three_dim_3.OR. &
8989  & analyticfunctiontype==equations_set_stokes_equation_three_dim_4.OR. &
8990  & analyticfunctiontype==equations_set_stokes_equation_three_dim_5) THEN
8991  IF(-5.0_dp-0.001_dp<x(1).AND.x(1)<-5.0_dp+0.001_dp.AND.-5.0_dp-0.001_dp<x(2).AND. &
8992  & x(2)<-5.0_dp+0.001_dp.AND.-5.0_dp-0.001_dp<x(3).AND.x(3)<-5.0_dp+0.001_dp.OR. &
8993  & -5.0_dp-0.001_dp<x(1).AND.x(1)<-5.0_dp+0.001_dp.AND.5.0_dp-0.001_dp<x(2).AND. &
8994  & x(2)<5.0_dp+0.001_dp.AND.-5.0_dp-0.001_dp<x(3).AND.x(3)<-5.0_dp+0.001_dp.OR. &
8995  & 5.0_dp-0.001_dp<x(1).AND.x(1)<5.0_dp+0.001_dp.AND.5.0_dp-0.001_dp<x(2).AND. &
8996  & x(2)<5.0_dp+0.001_dp.AND.-5.0_dp-0.001_dp<x(3).AND.x(3)<-5.0_dp+0.001_dp.OR. &
8997  & 5.0_dp-0.001_dp<x(1).AND.x(1)<5.0_dp+0.001_dp.AND.-5.0_dp-0.001_dp<x(2).AND. &
8998  & x(2)<-5.0_dp+0.001_dp.AND.-5.0_dp-0.001_dp<x(3).AND.x(3)<-5.0_dp+0.001_dp.OR. &
8999  & -5.0_dp-0.001_dp<x(1).AND.x(1)<-5.0_dp+0.001_dp.AND.-5.0_dp-0.001_dp<x(2).AND. &
9000  & x(2)<-5.0_dp+0.001_dp.AND.5.0_dp-0.001_dp<x(3).AND.x(3)<5.0_dp+0.001_dp.OR. &
9001  & -5.0_dp-0.001_dp<x(1).AND.x(1)<-5.0_dp+0.001_dp.AND.5.0_dp-0.001_dp<x(2).AND. &
9002  & x(2)<5.0_dp+0.001_dp.AND.5.0_dp-0.001_dp<x(3).AND.x(3)<5.0_dp+0.001_dp.OR. &
9003  & 5.0_dp-0.001_dp<x(1).AND.x(1)<5.0_dp+0.001_dp.AND.5.0_dp-0.001_dp<x(2).AND. &
9004  & x(2)<5.0_dp+0.001_dp.AND.5.0_dp-0.001_dp<x(3).AND.x(3)<5.0_dp+0.001_dp.OR. &
9005  & 5.0_dp-0.001_dp<x(1).AND.x(1)<5.0_dp+0.001_dp.AND.-5.0_dp-0.001_dp<x(2).AND. &
9006  & x(2)<-5.0_dp+ 0.001_dp.AND.5.0_dp-0.001_dp<x(3).AND.x(3)<5.0_dp+0.001_dp) THEN
9007  CALL boundary_conditions_set_local_dof(boundaryconditions,dependentfield, &
9008  & variabletype,local_ny,boundary_condition_fixed,VALUE,err,error,*999)
9009  boundarycount=boundarycount+1
9010  END IF
9011  END IF
9012  ! \todo: This is how it should be if adjacent elements would be working
9013  ELSE IF(boundarycount==0) THEN
9014  CALL boundary_conditions_set_local_dof(boundaryconditions,dependentfield,variabletype,&
9015  & local_ny,boundary_condition_fixed,VALUE,err,error,*999)
9016  boundarycount=boundarycount+1
9017  END IF
9018  END IF
9019  ELSE
9020  !Set the initial condition.
9021  CALL field_parameter_set_update_local_dof(dependentfield,variabletype, &
9022  & field_values_set_type,local_ny,initialvalue,err,error,*999)
9023  END IF
9024  END IF
9025  END DO !versionIdx
9026  END DO !derivativeIdx
9027 
9028  CASE DEFAULT
9029  localerror="Analytic Function Type "//trim(number_to_vstring(analyticfunctiontype,"*",err,error))// &
9030  & " is not yet implemented for a Navier-Stokes problem."
9031  CALL flagerror(localerror,err,error,*999)
9032  END SELECT
9033 
9034  END DO !nodeIdx
9035  ELSE
9036  CALL flagerror("Domain topology nodes is not associated.",err,error,*999)
9037  END IF
9038  ELSE
9039  CALL flagerror("Domain topology is not associated.",err,error,*999)
9040  END IF
9041  ELSE
9042  CALL flagerror("Domain is not associated.",err,error,*999)
9043  END IF
9044  ELSE
9045  CALL flagerror("Only node based interpolation is implemented.",err,error,*999)
9046  END IF
9047  END DO !componentIdx
9048  CALL field_parameter_set_update_start(dependentfield,variabletype,field_analytic_values_set_type, &
9049  & err,error,*999)
9050  CALL field_parameter_set_update_finish(dependentfield,variabletype,field_analytic_values_set_type, &
9051  & err,error,*999)
9052  CALL field_parameter_set_update_start(dependentfield,variabletype,field_values_set_type, &
9053  & err,error,*999)
9054  CALL field_parameter_set_update_finish(dependentfield,variabletype,field_values_set_type, &
9055  & err,error,*999)
9056  ELSE
9057  CALL flagerror("Field variable is not associated.",err,error,*999)
9058  END IF
9059  END DO !variableIdx
9060  CALL field_parameter_set_data_restore(geometricfield,field_u_variable_type,field_values_set_type, &
9061  & geometricparameters,err,error,*999)
9062  CALL field_interpolated_points_finalise(interpolatedpoint,err,error,*999)
9063  CALL field_interpolation_parameters_finalise(interpolationparameters,err,error,*999)
9064  ELSE
9065  CALL flagerror("Boundary conditions is not associated.",err,error,*999)
9066  END IF
9067 
9068  exits("NavierStokes_BoundaryConditionsAnalyticCalculate")
9069  RETURN
9070 999 errors("NavierStokes_BoundaryConditionsAnalyticCalculate",err,error)
9071  exits("NavierStokes_BoundaryConditionsAnalyticCalculate")
9072  RETURN 1
9073 
9074  END SUBROUTINE navierstokes_boundaryconditionsanalyticcalculate
9075 
9076  !
9077  !================================================================================================================================
9078  !
9080  SUBROUTINE navier_stokes_analytic_functions_evaluate(ANALYTIC_FUNCTION_TYPE,X,TIME,VARIABLE_TYPE,GLOBAL_DERIV_INDEX, &
9081  & componentnumber,number_of_dimensions,number_of_components,analytic_parameters,materials_parameters,VALUE,err,error,*)
9082 
9083  !Argument variables
9084  INTEGER(INTG), INTENT(IN) :: ANALYTIC_FUNCTION_TYPE
9085  REAL(DP), INTENT(IN) :: X(:)
9086  REAL(DP), INTENT(IN) :: TIME
9087  INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
9088  INTEGER(INTG), INTENT(IN) :: GLOBAL_DERIV_INDEX
9089  INTEGER(INTG), INTENT(IN) :: componentNumber
9090  INTEGER(INTG), INTENT(IN) :: NUMBER_OF_DIMENSIONS
9091  INTEGER(INTG), INTENT(IN) :: NUMBER_OF_COMPONENTS
9092  REAL(DP), INTENT(IN) :: ANALYTIC_PARAMETERS(:)
9093  REAL(DP), INTENT(IN) :: MATERIALS_PARAMETERS(:)
9094  REAL(DP), INTENT(OUT) :: VALUE
9095  INTEGER(INTG), INTENT(OUT) :: ERR
9096  TYPE(varying_string), INTENT(OUT) :: ERROR
9097  !Local variables
9098  INTEGER(INTG) :: i,j,n,m
9099  REAL(DP) :: L_PARAM,H_PARAM,U_PARAM,P_PARAM,MU_PARAM,NU_PARAM,RHO_PARAM,INTERNAL_TIME,CURRENT_TIME,K_PARAM
9100  REAL(DP) :: amplitude,yOffset,period,phaseShift,frequency,s,startTime,stopTime,tt,tmax,Qo
9101  REAL(DP) :: componentCoeff(4),delta(300),t(300),q(300)
9102  TYPE(varying_string) :: LOCAL_ERROR
9103 
9104  enters("NAVIER_STOKES_ANALYTIC_FUNCTIONS_EVALUATE",err,error,*999)
9105 
9106  !\todo: Introduce user-defined or default values instead for density and viscosity
9107  internal_time=time
9108  current_time=time
9109 
9110  SELECT CASE(analytic_function_type)
9111 
9112  CASE(equations_set_navier_stokes_equation_two_dim_poiseuille)
9113  !For fully developed 2D laminar flow through a channel, NSE should yield a parabolic profile,
9114  !U = Umax(1-y^2/H^2), Umax = (-dP/dx)*(H^2/(2*MU)), Umax = (3/2)*Umean
9115  !Note: assumes a flat inlet profile (U_PARAM = Umean).
9116  !Nonlinear terms from NSE will effectively be 0 for Poiseuille flow
9117  IF(number_of_dimensions==2.AND.number_of_components==3) THEN
9118  mu_param = materials_parameters(1)
9119  rho_param = materials_parameters(2)
9120  SELECT CASE(variable_type)
9121  CASE(field_u_variable_type)
9122  l_param = analytic_parameters(1) ! channel length in x-direction
9123  h_param = analytic_parameters(2) ! channel height in y-direction
9124  u_param = analytic_parameters(3) ! mean (inlet) velocity
9125  p_param = analytic_parameters(4) ! pressure value at outlet
9126  SELECT CASE(global_deriv_index)
9127  CASE(no_global_deriv)
9128  IF(componentnumber==1) THEN
9129  !calculate u
9130  VALUE=(3.0_dp/2.0_dp)*u_param*(1.0_dp-((x(2)-h_param)**2)/(h_param**2))
9131  ELSE IF(componentnumber==2) THEN
9132  !calculate v
9133  VALUE=0.0_dp
9134  ELSE IF(componentnumber==3) THEN
9135  !calculate p
9136  VALUE = (3.0_dp*mu_param*u_param*(x(1)-l_param))/(h_param**2)+p_param
9137  ELSE
9138  CALL flagerror("Not implemented.",err,error,*999)
9139  END IF
9140  CASE(global_deriv_s1)
9141  CALL flagerror("Not implemented.",err,error,*999)
9142  CASE(global_deriv_s2)
9143  CALL flagerror("Not implemented.",err,error,*999)
9144  CASE(global_deriv_s1_s2)
9145  CALL flagerror("Not implemented.",err,error,*999)
9146  CASE DEFAULT
9147  local_error="The global derivative index of "//trim(number_to_vstring( &
9148  & global_deriv_index,"*",err,error))// &
9149  & " is invalid."
9150  CALL flagerror(local_error,err,error,*999)
9151  END SELECT
9152  CASE(field_deludeln_variable_type)
9153  SELECT CASE(global_deriv_index)
9154  CASE( no_global_deriv)
9155  VALUE= 0.0_dp
9156  CASE(global_deriv_s1)
9157  CALL flagerror("Not implemented.",err,error,*999)
9158  CASE(global_deriv_s2)
9159  CALL flagerror("Not implemented.",err,error,*999)
9160  CASE(global_deriv_s1_s2)
9161  CALL flagerror("Not implemented.",err,error,*999)
9162  CASE DEFAULT
9163  local_error="The global derivative index of "//trim(number_to_vstring( &
9164  & global_deriv_index,"*",err,error))// &
9165  & " is invalid."
9166  CALL flagerror(local_error,err,error,*999)
9167  END SELECT
9168  CASE DEFAULT
9169  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
9170  & " is invalid."
9171  CALL flagerror(local_error,err,error,*999)
9172  END SELECT
9173  ELSE
9174  local_error="The number of components does not correspond to the number of dimensions."
9175  CALL flagerror(local_error,err,error,*999)
9176  END IF
9177 
9178  CASE(equations_set_navier_stokes_equation_two_dim_taylor_green)
9179  !Exact solution to 2D laminar, dynamic, nonlinear Taylor-Green vortex decay
9180  IF(number_of_dimensions==2.AND.number_of_components==3) THEN
9181  mu_param = materials_parameters(1)
9182  rho_param = materials_parameters(2)
9183  nu_param = mu_param/rho_param ! kinematic viscosity
9184  SELECT CASE(variable_type)
9185  CASE(field_u_variable_type)
9186  u_param = analytic_parameters(1) ! characteristic velocity (initial amplitude)
9187  l_param = analytic_parameters(2) ! length scale for square
9188  k_param = 2.0_dp*pi/l_param ! scale factor for equations
9189  SELECT CASE(global_deriv_index)
9190  CASE(no_global_deriv)
9191  IF(componentnumber==1) THEN
9192  !calculate u
9193  VALUE=-1.0_dp*u_param*cos(k_param*x(1))*sin(k_param*x(2))*exp(-2.0_dp*(k_param**2)*nu_param*current_time)
9194  ELSE IF(componentnumber==2) THEN
9195  !calculate v
9196  VALUE=u_param*sin(k_param*x(1))*cos(k_param*x(2))*exp(-2.0_dp*(k_param**2)*nu_param*current_time)
9197  ELSE IF(componentnumber==3) THEN
9198  !calculate p
9199  VALUE =-1.0_dp*(u_param**2)*(rho_param/4.0_dp)*(cos(2.0_dp*k_param*x(1))+ &
9200  & cos(2.0_dp*k_param*x(2)))*(exp(-4.0_dp*(k_param**2)*nu_param*current_time))
9201  ELSE
9202  CALL flagerror("Not implemented.",err,error,*999)
9203  END IF
9204  CASE(global_deriv_s1)
9205  CALL flagerror("Not implemented.",err,error,*999)
9206  CASE(global_deriv_s2)
9207  CALL flagerror("Not implemented.",err,error,*999)
9208  CASE(global_deriv_s1_s2)
9209  CALL flagerror("Not implemented.",err,error,*999)
9210  CASE DEFAULT
9211  local_error="The global derivative index of "//trim(number_to_vstring( &
9212  & global_deriv_index,"*",err,error))// &
9213  & " is invalid."
9214  CALL flagerror(local_error,err,error,*999)
9215  END SELECT
9216  CASE(field_deludeln_variable_type)
9217  SELECT CASE(global_deriv_index)
9218  CASE( no_global_deriv)
9219  VALUE= 0.0_dp
9220  CASE(global_deriv_s1)
9221  CALL flagerror("Not implemented.",err,error,*999)
9222  CASE(global_deriv_s2)
9223  CALL flagerror("Not implemented.",err,error,*999)
9224  CASE(global_deriv_s1_s2)
9225  CALL flagerror("Not implemented.",err,error,*999)
9226  CASE DEFAULT
9227  local_error="The global derivative index of "//trim(number_to_vstring( &
9228  & global_deriv_index,"*",err,error))// &
9229  & " is invalid."
9230  CALL flagerror(local_error,err,error,*999)
9231  END SELECT
9232  CASE DEFAULT
9233  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
9234  & " is invalid."
9235  CALL flagerror(local_error,err,error,*999)
9236  END SELECT
9237  ELSE
9238  local_error="The number of components does not correspond to the number of dimensions."
9239  CALL flagerror(local_error,err,error,*999)
9240  END IF
9241 
9242  CASE(equations_set_navier_stokes_equation_flowrate_aorta)
9243  SELECT CASE(number_of_dimensions)
9244  CASE(1)
9245  SELECT CASE(variable_type)
9246  CASE(field_u_variable_type)
9247  SELECT CASE(global_deriv_index)
9248  CASE(no_global_deriv)
9249  IF(componentnumber==1) THEN
9250  !Input function
9251  period = 800
9252  tt=mod(time,period)
9253  tmax=150.0_dp
9254  qo=100000.0_dp
9255  VALUE=(qo*tt/(tmax**2.0_dp))*exp(-(tt**2.0_dp)/(2.0_dp*(tmax**2.0_dp)))
9256  ELSE
9257  CALL flagerror("Incorrect component specification for Aorta flow rate waveform ",err,error,*999)
9258  END IF
9259  CASE DEFAULT
9260  local_error="The global derivative index of "//trim(number_to_vstring( &
9261  & global_deriv_index,"*",err,error))// " is invalid."
9262  CALL flagerror(local_error,err,error,*999)
9263  END SELECT
9264  CASE(field_deludeln_variable_type)
9265  SELECT CASE(global_deriv_index)
9266  CASE(no_global_deriv)
9267  VALUE= 0.0_dp
9268  CASE DEFAULT
9269  local_error="The global derivative index of "//trim(number_to_vstring( &
9270  & global_deriv_index,"*",err,error))// " is invalid."
9271  CALL flagerror(local_error,err,error,*999)
9272  END SELECT
9273  CASE(field_v_variable_type,field_u1_variable_type,field_u2_variable_type)
9274  ! Do nothing
9275  CASE DEFAULT
9276  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
9277  & " is invalid."
9278  CALL flagerror(local_error,err,error,*999)
9279  END SELECT
9280  CASE DEFAULT
9281  local_error="Aorta flowrate waveform for "//trim(number_to_vstring(number_of_dimensions,"*",err,error))// &
9282  & " dimension problem has not yet been implemented."
9283  CALL flagerror(local_error,err,error,*999)
9284  END SELECT
9285 
9286  CASE(equations_set_navier_stokes_equation_flowrate_olufsen)
9287  SELECT CASE(number_of_dimensions)
9288  CASE(1)
9289  SELECT CASE(variable_type)
9290  CASE(field_u_variable_type)
9291  SELECT CASE(global_deriv_index)
9292  CASE(no_global_deriv)
9293  IF(componentnumber==1) THEN
9294  !Olufsen Aorta
9295  t(1)= 0.0011660 ; q(1)= 17.39051
9296  t(2)= 0.0215840 ; q(2)= 10.41978
9297  t(3)= 0.0340860 ; q(3)= 18.75892
9298  t(4)= 0.0731370 ; q(4)= 266.3842
9299  t(5)= 0.0857710 ; q(5)= 346.3755
9300  t(6)= 0.1029220 ; q(6)= 413.8419
9301  t(7)= 0.1154270 ; q(7)= 424.2680
9302  t(8)= 0.1483530 ; q(8)= 429.1147
9303  t(9)= 0.1698860 ; q(9)= 411.0127
9304  t(10)= 0.220794 ; q(10)= 319.151
9305  t(11)= 0.264856 ; q(11)= 207.816
9306  t(12)= 0.295415 ; q(12)= 160.490
9307  t(13)= 0.325895 ; q(13)= 70.0342
9308  t(14)= 0.346215 ; q(14)= 10.1939
9309  t(15)= 0.363213 ; q(15)= -5.1222
9310  t(16)= 0.383666 ; q(16)= 6.68963
9311  t(17)= 0.405265 ; q(17)= 24.0659
9312  t(18)= 0.427988 ; q(18)= 35.8762
9313  t(19)= 0.455272 ; q(19)= 58.8137
9314  t(20)= 0.477990 ; q(20)= 67.8414
9315  t(21)= 0.502943 ; q(21)= 57.3893
9316  t(22)= 0.535816 ; q(22)= 33.7142
9317  t(23)= 0.577789 ; q(23)= 20.4676
9318  t(24)= 0.602753 ; q(24)= 16.2763
9319  t(25)= 0.639087 ; q(25)= 22.5119
9320  t(26)= 0.727616 ; q(26)= 18.9721
9321  t(27)= 0.783235 ; q(27)= 18.9334
9322  t(28)= 0.800000 ; q(28)= 16.1121
9323 
9324  !Initialize variables
9325  period = 800
9326  m=1
9327  n=28
9328  !Compute derivation
9329  DO i=1,n-1
9330  delta(i)=(q(i+1)-q(i))/(t(i+1)-t(i))
9331  END DO
9332  delta(n)=delta(n-1)+(delta(n-1)-delta(n-2))/(t(n-1)-t(n-2))*(t(n)-t(n-1))
9333  !Find subinterval
9334  DO j=1,n-1
9335  IF(t(j) <= (time/period)) THEN
9336  m=j
9337  END IF
9338  END DO
9339  !Evaluate interpolant
9340  s=(time/period)-t(m)
9341  VALUE=(q(m)+s*delta(m))
9342  ELSE
9343  CALL flagerror("Incorrect component specification for Olufsen flow rate waveform ",err,error,*999)
9344  END IF
9345  CASE DEFAULT
9346  local_error="The global derivative index of "//trim(number_to_vstring( &
9347  & global_deriv_index,"*",err,error))// " is invalid."
9348  CALL flagerror(local_error,err,error,*999)
9349  END SELECT
9350  CASE(field_deludeln_variable_type)
9351  SELECT CASE(global_deriv_index)
9352  CASE(no_global_deriv)
9353  VALUE= 0.0_dp
9354  CASE DEFAULT
9355  local_error="The global derivative index of "//trim(number_to_vstring( &
9356  & global_deriv_index,"*",err,error))// " is invalid."
9357  CALL flagerror(local_error,err,error,*999)
9358  END SELECT
9359  CASE(field_v_variable_type,field_u1_variable_type,field_u2_variable_type)
9360  ! Do nothing
9361  CASE DEFAULT
9362  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
9363  & " is invalid."
9364  CALL flagerror(local_error,err,error,*999)
9365  END SELECT
9366  CASE DEFAULT
9367  local_error="Olufsen flowrate waveform for "//trim(number_to_vstring(number_of_dimensions,"*",err,error))// &
9368  & " dimension problem has not yet been implemented."
9369  CALL flagerror(local_error,err,error,*999)
9370  END SELECT
9371 
9372  CASE(equations_set_navier_stokes_equation_sinusoid)
9373  ! Returns a sinusoidal value for boundary nodes
9374  SELECT CASE(number_of_dimensions)
9375  CASE(2,3)
9376  componentcoeff(1) = analytic_parameters(1)
9377  componentcoeff(2) = analytic_parameters(2)
9378  componentcoeff(3) = analytic_parameters(3)
9379  componentcoeff(4) = analytic_parameters(4)
9380  amplitude = analytic_parameters(5)
9381  yoffset = analytic_parameters(6)
9382  frequency = analytic_parameters(7)
9383  phaseshift = analytic_parameters(8)
9384  starttime = analytic_parameters(9)
9385  stoptime = analytic_parameters(10)
9386  SELECT CASE(variable_type)
9387  CASE(field_u_variable_type)
9388  SELECT CASE(global_deriv_index)
9389  CASE(no_global_deriv)
9390  IF(current_time > starttime - zero_tolerance .AND. &
9391  & current_time < stoptime + zero_tolerance) THEN
9392  VALUE= componentcoeff(componentnumber)*(yoffset + amplitude*sin(frequency*current_time+phaseshift))
9393  ELSE
9394  VALUE= componentcoeff(componentnumber)*(yoffset + amplitude*sin(frequency*stoptime+phaseshift))
9395  END IF
9396  CASE DEFAULT
9397  local_error="The global derivative index of "//trim(number_to_vstring( &
9398  & global_deriv_index,"*",err,error))// " is invalid."
9399  CALL flagerror(local_error,err,error,*999)
9400  END SELECT
9401  CASE(field_deludeln_variable_type)
9402  SELECT CASE(global_deriv_index)
9403  CASE(no_global_deriv)
9404  VALUE= 0.0_dp
9405  CASE DEFAULT
9406  local_error="The global derivative index of "//trim(number_to_vstring( &
9407  & global_deriv_index,"*",err,error))// " is invalid."
9408  CALL flagerror(local_error,err,error,*999)
9409  END SELECT
9410  CASE DEFAULT
9411  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
9412  & " is invalid."
9413  CALL flagerror(local_error,err,error,*999)
9414  END SELECT
9415  CASE DEFAULT
9416  local_error="Sinusoidal analytic types for "//trim(number_to_vstring(number_of_dimensions,"*",err,error))// &
9417  & " dimensional problems have not yet been implemented."
9418  CALL flagerror(local_error,err,error,*999)
9419  END SELECT
9420 
9421  CASE(equations_set_navier_stokes_equation_one_dim_1)
9422  IF(number_of_dimensions==1.AND.number_of_components==3) THEN
9423  !Polynomial function
9424  SELECT CASE(variable_type)
9425  CASE(field_u_variable_type)
9426  SELECT CASE(global_deriv_index)
9427  CASE(no_global_deriv)
9428  IF(componentnumber==1) THEN
9429  !calculate Q
9430  VALUE=x(1)**2/10.0_dp**2
9431  ELSE IF(componentnumber==2) THEN
9432  !calculate A
9433  VALUE=x(1)**2/10.0_dp**2
9434  ELSE IF(componentnumber==3) THEN
9435  !calculate P
9436  VALUE=x(1)**2/10.0_dp**2
9437  ELSE
9438  CALL flagerror("Not implemented.",err,error,*999)
9439  END IF
9440  CASE(global_deriv_s1)
9441  CALL flagerror("Not implemented.",err,error,*999)
9442  CASE(global_deriv_s2)
9443  CALL flagerror("Not implemented.",err,error,*999)
9444  CASE(global_deriv_s1_s2)
9445  CALL flagerror("Not implemented.",err,error,*999)
9446  CASE DEFAULT
9447  local_error="The global derivative index of "//trim(number_to_vstring( &
9448  & global_deriv_index,"*",err,error))// " is invalid."
9449  CALL flagerror(local_error,err,error,*999)
9450  END SELECT
9451  CASE(field_deludeln_variable_type)
9452  SELECT CASE(global_deriv_index)
9453  CASE(no_global_deriv)
9454  VALUE= 0.0_dp
9455  CASE(global_deriv_s1)
9456  CALL flagerror("Not implemented.",err,error,*999)
9457  CASE(global_deriv_s2)
9458  CALL flagerror("Not implemented.",err,error,*999)
9459  CASE(global_deriv_s1_s2)
9460  CALL flagerror("Not implemented.",err,error,*999)
9461  CASE DEFAULT
9462  local_error="The global derivative index of "//trim(number_to_vstring( &
9463  & global_deriv_index,"*",err,error))// &
9464  & " is invalid."
9465  CALL flagerror(local_error,err,error,*999)
9466  END SELECT
9467  CASE DEFAULT
9468  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
9469  & " is invalid."
9470  CALL flagerror(local_error,err,error,*999)
9471  END SELECT
9472  ELSE
9473  local_error="The number of components does not correspond to the number of dimensions."
9474  CALL flagerror(local_error,err,error,*999)
9475  END IF
9476 
9477  CASE(equations_set_navier_stokes_equation_two_dim_1)
9478  IF(number_of_dimensions==2.AND.number_of_components==3) THEN
9479  !Polynomial function
9480  mu_param = materials_parameters(1)
9481  rho_param = materials_parameters(2)
9482  SELECT CASE(variable_type)
9483  CASE(field_u_variable_type)
9484  SELECT CASE(global_deriv_index)
9485  CASE(no_global_deriv)
9486  IF(componentnumber==1) THEN
9487  !calculate u
9488  VALUE=x(2)**2/10.0_dp**2
9489  ELSE IF(componentnumber==2) THEN
9490  !calculate v
9491  VALUE=x(1)**2/10.0_dp**2
9492  ELSE IF(componentnumber==3) THEN
9493  !calculate p
9494  VALUE=2.0_dp/3.0_dp*x(1)*(3.0_dp*mu_param*10.0_dp**2-rho_param*x(1)**2*x(2))/(10.0_dp ** 4)
9495  ELSE
9496  CALL flagerror("Not implemented.",err,error,*999)
9497  END IF
9498  CASE(global_deriv_s1)
9499  CALL flagerror("Not implemented.",err,error,*999)
9500  CASE(global_deriv_s2)
9501  CALL flagerror("Not implemented.",err,error,*999)
9502  CASE(global_deriv_s1_s2)
9503  CALL flagerror("Not implemented.",err,error,*999)
9504  CASE DEFAULT
9505  local_error="The global derivative index of "//trim(number_to_vstring( &
9506  & global_deriv_index,"*",err,error))// &
9507  & " is invalid."
9508  CALL flagerror(local_error,err,error,*999)
9509  END SELECT
9510  CASE(field_deludeln_variable_type)
9511  SELECT CASE(global_deriv_index)
9512  CASE(no_global_deriv)
9513  VALUE= 0.0_dp
9514  CASE(global_deriv_s1)
9515  CALL flagerror("Not implemented.",err,error,*999)
9516  CASE(global_deriv_s2)
9517  CALL flagerror("Not implemented.",err,error,*999)
9518  CASE(global_deriv_s1_s2)
9519  CALL flagerror("Not implemented.",err,error,*999)
9520  CASE DEFAULT
9521  local_error="The global derivative index of "//trim(number_to_vstring( &
9522  & global_deriv_index,"*",err,error))// &
9523  & " is invalid."
9524  CALL flagerror(local_error,err,error,*999)
9525  END SELECT
9526  CASE DEFAULT
9527  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
9528  & " is invalid."
9529  CALL flagerror(local_error,err,error,*999)
9530  END SELECT
9531  ELSE
9532  local_error="The number of components does not correspond to the number of dimensions."
9533  CALL flagerror(local_error,err,error,*999)
9534  END IF
9535 
9536  CASE(equations_set_navier_stokes_equation_two_dim_2)
9537  IF(number_of_dimensions==2.AND.number_of_components==3) THEN
9538  !Exponential function
9539  mu_param = materials_parameters(1)
9540  rho_param = materials_parameters(2)
9541  SELECT CASE(variable_type)
9542  CASE(field_u_variable_type)
9543  SELECT CASE(global_deriv_index)
9544  CASE(no_global_deriv)
9545  IF(componentnumber==1) THEN
9546  !calculate u
9547  VALUE= exp((x(1)-x(2))/10.0_dp)
9548  ELSE IF(componentnumber==2) THEN
9549  !calculate v
9550  VALUE= exp((x(1)-x(2))/10.0_dp)
9551  ELSE IF(componentnumber==3) THEN
9552  !calculate p
9553  VALUE= 2.0_dp*mu_param/10.0_dp*exp((x(1)-x(2))/10.0_dp)
9554  ELSE
9555  CALL flagerror("Not implemented.",err,error,*999)
9556  END IF
9557  CASE(global_deriv_s1)
9558  CALL flagerror("Not implemented.",err,error,*999)
9559  CASE(global_deriv_s2)
9560  CALL flagerror("Not implemented.",err,error,*999)
9561  CASE(global_deriv_s1_s2)
9562  CALL flagerror("Not implemented.",err,error,*999)
9563  CASE DEFAULT
9564  local_error="The global derivative index of "//trim(number_to_vstring( &
9565  & global_deriv_index,"*",err,error))// &
9566  & " is invalid."
9567  CALL flagerror(local_error,err,error,*999)
9568  END SELECT
9569  CASE(field_deludeln_variable_type)
9570  SELECT CASE(global_deriv_index)
9571  CASE(no_global_deriv)
9572  IF(componentnumber==1) THEN
9573  !calculate u
9574  VALUE= 0.0_dp
9575  ELSE IF(componentnumber==2) THEN
9576  !calculate v
9577  VALUE= 0.0_dp
9578  ELSE IF(componentnumber==3) THEN
9579  !calculate p
9580  VALUE= 0.0_dp
9581  ELSE
9582  CALL flagerror("Not implemented.",err,error,*999)
9583  END IF
9584  CASE(global_deriv_s1)
9585  CALL flagerror("Not implemented.",err,error,*999)
9586  CASE(global_deriv_s2)
9587  CALL flagerror("Not implemented.",err,error,*999)
9588  CASE(global_deriv_s1_s2)
9589  CALL flagerror("Not implemented.",err,error,*999)
9590  CASE DEFAULT
9591  local_error="The global derivative index of "//trim(number_to_vstring( &
9592  & global_deriv_index,"*",err,error))// &
9593  & " is invalid."
9594  CALL flagerror(local_error,err,error,*999)
9595  END SELECT
9596  CASE DEFAULT
9597  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
9598  & " is invalid."
9599  CALL flagerror(local_error,err,error,*999)
9600  END SELECT
9601  ELSE
9602  local_error="The number of components does not correspond to the number of dimensions."
9603  CALL flagerror(local_error,err,error,*999)
9604  END IF
9605 
9606  CASE(equations_set_navier_stokes_equation_two_dim_3)
9607  IF(number_of_dimensions==2.AND.number_of_components==3) THEN
9608  !Sine and cosine function
9609  mu_param = materials_parameters(1)
9610  rho_param = materials_parameters(2)
9611  SELECT CASE(variable_type)
9612  CASE(field_u_variable_type)
9613  SELECT CASE(global_deriv_index)
9614  CASE(no_global_deriv)
9615  IF(componentnumber==1) THEN
9616  !calculate u
9617  VALUE=sin(2.0_dp*pi*x(1)/10.0_dp)*sin(2.0_dp*pi*x(2)/10.0_dp)
9618  ELSE IF(componentnumber==2) THEN
9619  !calculate v
9620  VALUE=cos(2.0_dp*pi*x(1)/10.0_dp)*cos(2.0_dp*pi*x(2)/10.0_dp)
9621  ELSE IF(componentnumber==3) THEN
9622  !calculate p
9623  VALUE=4.0_dp*mu_param*pi/10.0_dp*sin(2.0_dp*pi*x(2)/10.0_dp)*cos(2.0_dp*pi*x(1)/10.0_dp)+ &
9624  & 0.5_dp*rho_param*cos(2.0_dp*pi*x(1)/10.0_dp)*cos(2.0_dp*pi*x(1)/10.0_dp)
9625  ELSE
9626  CALL flagerror("Not implemented.",err,error,*999)
9627  END IF
9628  CASE(global_deriv_s1)
9629  CALL flagerror("Not implemented.",err,error,*999)
9630  CASE(global_deriv_s2)
9631  CALL flagerror("Not implemented.",err,error,*999)
9632  CASE(global_deriv_s1_s2)
9633  CALL flagerror("Not implemented.",err,error,*999)
9634  CASE DEFAULT
9635  local_error="The global derivative index of "//trim(number_to_vstring( &
9636  & global_deriv_index,"*",err,error))// &
9637  & " is invalid."
9638  CALL flagerror(local_error,err,error,*999)
9639  END SELECT
9640  CASE(field_deludeln_variable_type)
9641  SELECT CASE(global_deriv_index)
9642  CASE(no_global_deriv)
9643  IF(componentnumber==1) THEN
9644  !calculate u
9645  VALUE=0.0_dp
9646  ELSE IF(componentnumber==2) THEN
9647  !calculate v
9648  VALUE=16.0_dp*mu_param*pi**2/10.0_dp**2*cos(2.0_dp*pi*x(2)/ 10.0_dp)*cos(2.0_dp*pi*x(1)/10.0_dp)
9649  ELSE IF(componentnumber==3) THEN
9650  !calculate p
9651  VALUE=0.0_dp
9652  ELSE
9653  CALL flagerror("Not implemented.",err,error,*999)
9654  END IF
9655  CASE(global_deriv_s1)
9656  CALL flagerror("Not implemented.",err,error,*999)
9657  CASE(global_deriv_s2)
9658  CALL flagerror("Not implemented.",err,error,*999)
9659  CASE(global_deriv_s1_s2)
9660  CALL flagerror("Not implemented.",err,error,*999)
9661  CASE DEFAULT
9662  local_error="The global derivative index of "//trim(number_to_vstring( &
9663  & global_deriv_index,"*",err,error))// &
9664  & " is invalid."
9665  CALL flagerror(local_error,err,error,*999)
9666  END SELECT
9667  CASE DEFAULT
9668  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
9669  & " is invalid."
9670  CALL flagerror(local_error,err,error,*999)
9671  END SELECT
9672  ELSE
9673  local_error="The number of components does not correspond to the number of dimensions."
9674  CALL flagerror(local_error,err,error,*999)
9675  END IF
9676 
9677  CASE(equations_set_navier_stokes_equation_two_dim_4,equations_set_navier_stokes_equation_two_dim_5)
9678  IF(number_of_dimensions==2.AND.number_of_components==3) THEN
9679  !Taylor-Green vortex solution
9680  mu_param = materials_parameters(1)
9681  rho_param = materials_parameters(2)
9682  SELECT CASE(variable_type)
9683  CASE(field_u_variable_type)
9684  SELECT CASE(global_deriv_index)
9685  CASE(no_global_deriv)
9686  IF(componentnumber==1) THEN
9687  !calculate u
9688  VALUE=sin(x(1)/10.0_dp*2.0_dp*pi)*cos(x(2)/10.0_dp*2.0_dp*pi)*exp(-2.0_dp*mu_param/rho_param*current_time)
9689  VALUE=sin(x(1)/10.0_dp*pi)*cos(x(2)/10.0_dp*pi)*exp(-2.0_dp*mu_param/rho_param*current_time)
9690  ! VALUE=SIN(X(1))*COS(X(2))
9691  ELSE IF(componentnumber==2) THEN
9692  !calculate v
9693  VALUE=-cos(x(1)/10.0_dp*2.0_dp*pi)*sin(x(2)/10.0_dp*2.0_dp*pi)*exp(-2.0_dp*mu_param/rho_param*current_time)
9694  VALUE=-cos(x(1)/10.0_dp*pi)*sin(x(2)/10.0_dp*pi)*exp(-2.0_dp*mu_param/rho_param*current_time)
9695  ! VALUE=-COS(X(1))*SIN(X(2))
9696  ELSE IF(componentnumber==3) THEN
9697  !calculate p
9698  VALUE=rho_param/4.0_dp*(cos(2.0_dp*x(1)/10.0_dp*2.0_dp*pi)+cos(2.0_dp*x(2)/10.0_dp*2.0_dp*pi))* &
9699  & exp(-4.0_dp*mu_param/rho_param*current_time)
9700  VALUE=rho_param/4.0_dp*(cos(2.0_dp*x(1)/10.0_dp*pi)+cos(2.0_dp*x(2)/10.0_dp*pi))* &
9701  & exp(-4.0_dp*mu_param/rho_param*current_time)
9702  ! VALUE=RHO_PARAM/4.0_DP*(COS(2.0_DP*X(1))+COS(2.0_DP*X(2)))
9703  ELSE
9704  CALL flagerror("Not implemented.",err,error,*999)
9705  END IF
9706  CASE(global_deriv_s1)
9707  CALL flagerror("Not implemented.",err,error,*999)
9708  CASE(global_deriv_s2)
9709  CALL flagerror("Not implemented.",err,error,*999)
9710  CASE(global_deriv_s1_s2)
9711  CALL flagerror("Not implemented.",err,error,*999)
9712  CASE DEFAULT
9713  local_error="The global derivative index of "//trim(number_to_vstring( &
9714  & global_deriv_index,"*",err,error))// &
9715  & " is invalid."
9716  CALL flagerror(local_error,err,error,*999)
9717  END SELECT
9718  CASE(field_deludeln_variable_type)
9719  SELECT CASE(global_deriv_index)
9720  CASE(no_global_deriv)
9721  IF(componentnumber==1) THEN
9722  !calculate u
9723  VALUE=0.0_dp
9724  ELSE IF(componentnumber==2) THEN
9725  !calculate v
9726  VALUE=0.0_dp
9727  ELSE IF(componentnumber==3) THEN
9728  !calculate p
9729  VALUE=0.0_dp
9730  ELSE
9731  CALL flagerror("Not implemented.",err,error,*999)
9732  END IF
9733  CASE(global_deriv_s1)
9734  CALL flagerror("Not implemented.",err,error,*999)
9735  CASE(global_deriv_s2)
9736  CALL flagerror("Not implemented.",err,error,*999)
9737  CASE(global_deriv_s1_s2)
9738  CALL flagerror("Not implemented.",err,error,*999)
9739  CASE DEFAULT
9740  local_error="The global derivative index of "//trim(number_to_vstring( &
9741  & global_deriv_index,"*",err,error))// &
9742  & " is invalid."
9743  CALL flagerror(local_error,err,error,*999)
9744  END SELECT
9745  CASE DEFAULT
9746  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
9747  & " is invalid."
9748  CALL flagerror(local_error,err,error,*999)
9749  END SELECT
9750  ELSE
9751  local_error="The number of components does not correspond to the number of dimensions."
9752  CALL flagerror(local_error,err,error,*999)
9753  END IF
9754 
9755  CASE(equations_set_navier_stokes_equation_three_dim_1)
9756  IF(number_of_dimensions==3.AND.number_of_components==4) THEN
9757  !Polynomial function
9758  mu_param = materials_parameters(1)
9759  rho_param = materials_parameters(2)
9760  SELECT CASE(variable_type)
9761  CASE(field_u_variable_type)
9762  SELECT CASE(global_deriv_index)
9763  CASE(no_global_deriv)
9764  IF(componentnumber==1) THEN
9765  !calculate u
9766  VALUE=x(2)**2/10.0_dp**2+x(3)**2/10.0_dp**2
9767  ELSE IF(componentnumber==2) THEN
9768  !calculate v
9769  VALUE=x(1)**2/10.0_dp**2+x(3)**2/10.0_dp** 2
9770  ELSE IF(componentnumber==3) THEN
9771  !calculate w
9772  VALUE=x(1)**2/10.0_dp**2+x(2)**2/10.0_dp** 2
9773  ELSE IF(componentnumber==4) THEN
9774  !calculate p
9775  VALUE=2.0_dp/3.0_dp*x(1)*(6.0_dp*mu_param*10.0_dp**2-rho_param*x(2)*x(1)**2-3.0_dp* &
9776  & rho_param*x(2)* &
9777  & x(3)**2-rho_param*x(3)*x(1)**2-3.0_dp*rho_param*x(3)*x(2)**2)/(10.0_dp**4)
9778  ELSE
9779  CALL flagerror("Not implemented.",err,error,*999)
9780  END IF
9781  CASE(global_deriv_s1)
9782  CALL flagerror("Not implemented.",err,error,*999)
9783  CASE(global_deriv_s2)
9784  CALL flagerror("Not implemented.",err,error,*999)
9785  CASE(global_deriv_s1_s2)
9786  CALL flagerror("Not implemented.",err,error,*999)
9787  CASE DEFAULT
9788  local_error="The global derivative index of "//trim(number_to_vstring( &
9789  & global_deriv_index,"*",err,error))// &
9790  & " is invalid."
9791  CALL flagerror(local_error,err,error,*999)
9792  END SELECT
9793  CASE(field_deludeln_variable_type)
9794  SELECT CASE(global_deriv_index)
9795  CASE(no_global_deriv)
9796  VALUE=0.0_dp
9797  CASE(global_deriv_s1)
9798  CALL flagerror("Not implemented.",err,error,*999)
9799  CASE(global_deriv_s2)
9800  CALL flagerror("Not implemented.",err,error,*999)
9801  CASE(global_deriv_s1_s2)
9802  CALL flagerror("Not implemented.",err,error,*999)
9803  CASE DEFAULT
9804  local_error="The global derivative index of "//trim(number_to_vstring( &
9805  & global_deriv_index,"*",err,error))// &
9806  & " is invalid."
9807  CALL flagerror(local_error,err,error,*999)
9808  END SELECT
9809  CASE DEFAULT
9810  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
9811  & " is invalid."
9812  CALL flagerror(local_error,err,error,*999)
9813  END SELECT
9814  ELSE
9815  local_error="The number of components does not correspond to the number of dimensions."
9816  CALL flagerror(local_error,err,error,*999)
9817  END IF
9818 
9819  CASE(equations_set_navier_stokes_equation_three_dim_2)
9820  IF(number_of_dimensions==3.AND.number_of_components==4) THEN
9821  !Exponential function
9822  mu_param = materials_parameters(1)
9823  rho_param = materials_parameters(2)
9824  SELECT CASE(variable_type)
9825  CASE(field_u_variable_type)
9826  SELECT CASE(global_deriv_index)
9827  CASE(no_global_deriv)
9828  IF(componentnumber==1) THEN
9829  !calculate u
9830  VALUE=exp((x(1)-x(2))/10.0_dp)+exp((x(3)-x(1))/10.0_dp)
9831  ELSE IF(componentnumber==2) THEN
9832  !calculate v
9833  VALUE=exp((x(1)-x(2))/10.0_dp)+exp((x(2)-x(3))/10.0_dp)
9834  ELSE IF(componentnumber==3) THEN
9835  !calculate w
9836  VALUE=exp((x(3)-x(1))/10.0_dp)+exp((x(2)-x(3))/10.0_dp)
9837  ELSE IF(componentnumber==4) THEN
9838  !calculate p
9839  VALUE=1.0_dp/10.0_dp*(2.0_dp*mu_param*exp((x(1)-x(2))/10.0_dp)- &
9840  & 2.0_dp*mu_param*exp((x(3)-x(1))/10.0_dp)+rho_param*10.0_dp*exp((x(1)-x(3))/10.0_dp)+ &
9841  & rho_param*10.0_dp*exp((x(2)-x(1))/10.0_dp))
9842  ELSE
9843  CALL flagerror("Not implemented.",err,error,*999)
9844  END IF
9845  CASE(global_deriv_s1)
9846  CALL flagerror("Not implemented.",err,error,*999)
9847  CASE(global_deriv_s2)
9848  CALL flagerror("Not implemented.",err,error,*999)
9849  CASE(global_deriv_s1_s2)
9850  CALL flagerror("Not implemented.",err,error,*999)
9851  CASE DEFAULT
9852  local_error="The global derivative index of "//trim(number_to_vstring( &
9853  & global_deriv_index,"*",err,error))// &
9854  & " is invalid."
9855  CALL flagerror(local_error,err,error,*999)
9856  END SELECT
9857  CASE(field_deludeln_variable_type)
9858  SELECT CASE(global_deriv_index)
9859  CASE(no_global_deriv)
9860  IF(componentnumber==1) THEN
9861  !calculate u
9862  VALUE=0.0_dp
9863  ELSE IF(componentnumber==2) THEN
9864  !calculate v
9865  VALUE=-2.0_dp*mu_param*(2.0_dp*exp(x(1)-x(2))+exp(x(2)-x(3)))
9866  ELSE IF(componentnumber==3) THEN
9867  !calculate w
9868  VALUE=-2.0_dp*mu_param*(2.0_dp*exp(x(3)-x(1))+exp(x(2)-x(3)))
9869  ELSE IF(componentnumber==4) THEN
9870  !calculate p
9871  VALUE=0.0_dp
9872  ELSE
9873  CALL flagerror("Not implemented.",err,error,*999)
9874  END IF
9875  CASE(global_deriv_s1)
9876  CALL flagerror("Not implemented.",err,error,*999)
9877  CASE(global_deriv_s2)
9878  CALL flagerror("Not implemented.",err,error,*999)
9879  CASE(global_deriv_s1_s2)
9880  CALL flagerror("Not implemented.",err,error,*999)
9881  CASE DEFAULT
9882  local_error="The global derivative index of "//trim(number_to_vstring( &
9883  & global_deriv_index,"*",err,error))// &
9884  & " is invalid."
9885  CALL flagerror(local_error,err,error,*999)
9886  END SELECT
9887  CASE DEFAULT
9888  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
9889  & " is invalid."
9890  CALL flagerror(local_error,err,error,*999)
9891  END SELECT
9892  ELSE
9893  local_error="The number of components does not correspond to the number of dimensions."
9894  CALL flagerror(local_error,err,error,*999)
9895  END IF
9896 
9897  CASE(equations_set_navier_stokes_equation_three_dim_3)
9898  IF(number_of_dimensions==3.AND.number_of_components==4) THEN
9899  !Sine/cosine function
9900  mu_param = materials_parameters(1)
9901  rho_param = materials_parameters(2)
9902  SELECT CASE(variable_type)
9903  CASE(field_u_variable_type)
9904  SELECT CASE(global_deriv_index)
9905  CASE(no_global_deriv)
9906  IF(componentnumber==1) THEN
9907  !calculate u
9908  VALUE=sin(2.0_dp*pi*x(1)/10.0_dp)*sin(2.0_dp*pi*x(2)/10.0_dp)*sin(2.0_dp*pi*x(3)/10.0_dp)
9909  ELSE IF(componentnumber==2) THEN
9910  !calculate v
9911  VALUE=2.0_dp*cos(2.0_dp*pi*x(1)/10.0_dp)*sin(2.0_dp*pi*x(3)/10.0_dp)*cos(2.0_dp*pi*x(2)/10.0_dp)
9912  ELSE IF(componentnumber==3) THEN
9913  !calculate w
9914  VALUE=-cos(2.0_dp*pi*x(1)/10.0_dp)*sin(2.0_dp*pi*x(2)/10.0_dp)*cos(2.0_dp*pi*x(3)/10.0_dp)
9915  ELSE IF(componentnumber==4) THEN
9916  !calculate p
9917  VALUE=-cos(2.0_dp*pi*x(1)/10.0_dp)*(-12.0_dp*mu_param*pi*sin(2.0_dp*pi*x(2)/10.0_dp)* &
9918  & sin(2.0_dp*pi*x(3)/10.0_dp)-rho_param*cos(2.0_dp*pi*x(1)/10.0_dp)*10.0_dp+ &
9919  & 2.0_dp*rho_param*cos(2.0_dp*pi*x(1)/10.0_dp)*10.0_dp*cos(2.0_dp*pi*x(3)/10.0_dp)**2- &
9920  & rho_param*cos(2.0_dp*pi*x(1)/10.0_dp)*10.0_dp*cos(2.0_dp*pi*x(2)/10.0_dp)**2)/10.0_dp/2.0_dp
9921  ELSE
9922  CALL flagerror("Not implemented.",err,error,*999)
9923  END IF
9924  CASE(global_deriv_s1)
9925  CALL flagerror("Not implemented.",err,error,*999)
9926  CASE(global_deriv_s2)
9927  CALL flagerror("Not implemented.",err,error,*999)
9928  CASE(global_deriv_s1_s2)
9929  CALL flagerror("Not implemented.",err,error,*999)
9930  CASE DEFAULT
9931  local_error="The global derivative index of "//trim(number_to_vstring( &
9932  & global_deriv_index,"*",err,error))// &
9933  & " is invalid."
9934  CALL flagerror(local_error,err,error,*999)
9935  END SELECT
9936  CASE(field_deludeln_variable_type)
9937  SELECT CASE(global_deriv_index)
9938  CASE(no_global_deriv)
9939  IF(componentnumber==1) THEN
9940  !calculate u
9941  VALUE=0.0_dp
9942  ELSE IF(componentnumber==2) THEN
9943  !calculate v
9944  VALUE=36*mu_param*pi**2/10.0_dp**2*cos(2.0_dp*pi*x(2)/10.0_dp)*sin(2.0_dp*pi*x(3)/10.0_dp)* &
9945  & cos(2.0_dp*pi*x(1)/10.0_dp)
9946  ELSE IF(componentnumber==3) THEN
9947  !calculate w
9948  VALUE=0.0_dp
9949  ELSE IF(componentnumber==4) THEN
9950  !calculate p
9951  VALUE=0.0_dp
9952  ELSE
9953  CALL flagerror("Not implemented.",err,error,*999)
9954  END IF
9955  CASE(global_deriv_s1)
9956  CALL flagerror("Not implemented.",err,error,*999)
9957  CASE(global_deriv_s2)
9958  CALL flagerror("Not implemented.",err,error,*999)
9959  CASE(global_deriv_s1_s2)
9960  CALL flagerror("Not implemented.",err,error,*999)
9961  CASE DEFAULT
9962  local_error="The global derivative index of "//trim(number_to_vstring( &
9963  & global_deriv_index,"*",err,error))// &
9964  & " is invalid."
9965  CALL flagerror(local_error,err,error,*999)
9966  END SELECT
9967  CASE DEFAULT
9968  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
9969  & " is invalid."
9970  CALL flagerror(local_error,err,error,*999)
9971  END SELECT
9972  ELSE
9973  local_error="The number of components does not correspond to the number of dimensions."
9974  CALL flagerror(local_error,err,error,*999)
9975  END IF
9976 
9977  CASE(equations_set_navier_stokes_equation_three_dim_4,equations_set_navier_stokes_equation_three_dim_5)
9978  IF(number_of_dimensions==3.AND.number_of_components==4) THEN
9979  !Taylor-Green vortex solution
9980  mu_param = materials_parameters(1)
9981  rho_param = materials_parameters(2)
9982  SELECT CASE(variable_type)
9983  CASE(field_u_variable_type)
9984  SELECT CASE(global_deriv_index)
9985  CASE(no_global_deriv)
9986  IF(componentnumber==1) THEN
9987  !calculate u
9988  VALUE=sin(x(1)/10.0_dp*pi)*cos(x(2)/10.0_dp*pi)*exp(-2.0_dp*mu_param/rho_param*current_time)
9989  ELSE IF(componentnumber==2) THEN
9990  !calculate v
9991  VALUE=-cos(x(1)/10.0_dp*pi)*sin(x(2)/10.0_dp*pi)*exp(-2.0_dp*mu_param/rho_param*current_time)
9992  ELSE IF(componentnumber==3) THEN
9993  !calculate v
9994  VALUE=0.0_dp
9995  ! VALUE=-COS(X(1))*SIN(X(2))
9996  ELSE IF(componentnumber==4) THEN
9997  !calculate p
9998  VALUE=rho_param/4.0_dp*(cos(2.0_dp*x(1)/10.0_dp*pi)+cos(2.0_dp*x(2)/10.0_dp*pi))* &
9999  & exp(-4.0_dp*mu_param/rho_param*current_time)
10000  ! VALUE=RHO_PARAM/4.0_DP*(COS(2.0_DP*X(1))+COS(2.0_DP*X(2)))
10001  ELSE
10002  CALL flagerror("Not implemented.",err,error,*999)
10003  END IF
10004  CASE(global_deriv_s1)
10005  CALL flagerror("Not implemented.",err,error,*999)
10006  CASE(global_deriv_s2)
10007  CALL flagerror("Not implemented.",err,error,*999)
10008  CASE(global_deriv_s1_s2)
10009  CALL flagerror("Not implemented.",err,error,*999)
10010  CASE DEFAULT
10011  local_error="The global derivative index of "//trim(number_to_vstring( &
10012  & global_deriv_index,"*",err,error))// &
10013  & " is invalid."
10014  CALL flagerror(local_error,err,error,*999)
10015  END SELECT
10016  CASE(field_deludeln_variable_type)
10017  SELECT CASE(global_deriv_index)
10018  CASE(no_global_deriv)
10019  IF(componentnumber==1) THEN
10020  !calculate u
10021  VALUE=0.0_dp
10022  ELSE IF(componentnumber==2) THEN
10023  !calculate v
10024  VALUE=0.0_dp
10025  ELSE IF(componentnumber==3) THEN
10026  !calculate p
10027  VALUE=0.0_dp
10028  ELSE IF(componentnumber==4) THEN
10029  !calculate p
10030  VALUE=0.0_dp
10031  ELSE
10032  CALL flagerror("Not implemented.",err,error,*999)
10033  END IF
10034  CASE(global_deriv_s1)
10035  CALL flagerror("Not implemented.",err,error,*999)
10036  CASE(global_deriv_s2)
10037  CALL flagerror("Not implemented.",err,error,*999)
10038  CASE(global_deriv_s1_s2)
10039  CALL flagerror("Not implemented.",err,error,*999)
10040  CASE DEFAULT
10041  local_error="The global derivative index of "//trim(number_to_vstring( &
10042  & global_deriv_index,"*",err,error))// &
10043  & " is invalid."
10044  CALL flagerror(local_error,err,error,*999)
10045  END SELECT
10046  CASE DEFAULT
10047  local_error="The variable type of "//trim(number_to_vstring(variable_type,"*",err,error))// &
10048  & " is invalid."
10049  CALL flagerror(local_error,err,error,*999)
10050  END SELECT
10051  ELSE
10052  local_error="The number of components does not correspond to the number of dimensions."
10053  CALL flagerror(local_error,err,error,*999)
10054  END IF
10055  CASE DEFAULT
10056  local_error="The analytic function type of "// &
10057  & trim(number_to_vstring(analytic_function_type,"*",err,error))// &
10058  & " is invalid."
10059  CALL flagerror(local_error,err,error,*999)
10060  END SELECT
10061 
10062  exits("NAVIER_STOKES_ANALYTIC_FUNCTIONS_EVALUATE")
10063  RETURN
10064 999 errorsexits("NAVIER_STOKES_ANALYTIC_FUNCTIONS_EVALUATE",err,error)
10065  RETURN 1
10066 
10067  END SUBROUTINE navier_stokes_analytic_functions_evaluate
10068 
10069  !
10070  !================================================================================================================================
10071  !
10072 
10074  SUBROUTINE navierstokes_residualbasedstabilisation(equationsSet,elementNumber,gaussNumber,mu,rho,jacobianFlag,err,error,*)
10075 
10076  !Argument variables
10077  TYPE(equations_set_type), POINTER :: equationsSet
10078  INTEGER(INTG), INTENT(IN) :: elementNumber
10079  INTEGER(INTG), INTENT(IN) :: gaussNumber
10080  REAL(DP), INTENT(IN) :: mu
10081  REAL(DP), INTENT(IN) :: rho
10082  LOGICAL, INTENT(IN) :: jacobianFlag
10083  INTEGER(INTG), INTENT(OUT) :: err
10084  TYPE(varying_string), INTENT(OUT) :: error
10085 
10086  !Local Variables
10087  TYPE(basis_type), POINTER :: basisVelocity,basisPressure
10088  TYPE(equations_type), POINTER :: equations
10089  TYPE(equations_mapping_type), POINTER :: equationsMapping
10090  TYPE(equations_mapping_nonlinear_type), POINTER :: nonlinearMapping
10091  TYPE(equations_set_equations_set_field_type), POINTER :: equationsEquationsSetField
10092  TYPE(field_type), POINTER :: equationsSetField
10093  TYPE(quadrature_scheme_type), POINTER :: quadratureVelocity,quadraturePressure
10094  TYPE(field_type), POINTER :: dependentField,geometricField
10095  TYPE(field_variable_type), POINTER :: fieldVariable
10096  TYPE(field_interpolated_point_metrics_type), POINTER :: pointMetrics
10097  TYPE(equations_matrices_type), POINTER :: equationsMatrices
10098  TYPE(equations_matrices_nonlinear_type), POINTER :: nonlinearMatrices
10099  TYPE(equations_jacobian_type), POINTER :: jacobianMatrix
10100 
10101  INTEGER(INTG) :: fieldVariableType,meshComponent1,meshComponent2
10102  INTEGER(INTG) :: numberOfDimensions
10103  INTEGER(INTG) :: i,j,k,l,mhs,nhs,ms,ns,nh,mh,nj,ni,pressureIndex
10104  INTEGER(INTG) :: numberOfElementParameters(4),stabilisationType
10105  REAL(DP) :: PHIMS,PHINS
10106  REAL(DP) :: dPhi_dX_Velocity(27,3),dPhi_dX_Pressure(27,3),DPHINS2_DXI(3,3)
10107  REAL(DP) :: jacobianMomentum(3),jacobianContinuity
10108  REAL(DP) :: DXI_DX(3,3)
10109  REAL(DP) :: velocity(3),velocityPrevious(3),velocityDeriv(3,3),velocity2Deriv(3,3,3),pressure,pressureDeriv(3)
10110  REAL(DP) :: JGW,SUM,SUM2,SUPG,PSPG,LSIC,crossStress,reynoldsStress,momentumTerm
10111  REAL(DP) :: uDotGu,doubleDotG,tauSUPS,traceG,nuLSIC,timeIncrement,elementInverse,C1,stabilisationValueDP
10112  REAL(DP) :: tauC,tauMp,tauMu
10113  REAL(DP) :: residualMomentum(3),residualContinuity
10114  TYPE(varying_string) :: localError
10115  LOGICAL :: linearElement
10116 
10117  enters("NavierStokes_ResidualBasedStabilisation",err,error,*999)
10118 
10119  ! Nullify all local pointers
10120  NULLIFY(basisvelocity)
10121  NULLIFY(basispressure)
10122  NULLIFY(equations)
10123  NULLIFY(equationsmapping)
10124  NULLIFY(nonlinearmapping)
10125  NULLIFY(equationsequationssetfield)
10126  NULLIFY(equationssetfield)
10127  NULLIFY(quadraturevelocity)
10128  NULLIFY(quadraturepressure)
10129  NULLIFY(dependentfield)
10130  NULLIFY(geometricfield)
10131  NULLIFY(fieldvariable)
10132  NULLIFY(equationsmatrices)
10133  NULLIFY(nonlinearmatrices)
10134  NULLIFY(jacobianmatrix)
10135 
10136  IF(ASSOCIATED(equationsset))THEN
10137  IF(.NOT.ALLOCATED(equationsset%specification)) THEN
10138  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
10139  ELSE IF(SIZE(equationsset%specification,1)/=3) THEN
10140  CALL flagerror("Equations set specification must have three entries for a Navier-Stokes type equations set.", &
10141  & err,error,*999)
10142  END IF
10143  SELECT CASE(equationsset%specification(3))
10144  CASE(equations_set_static_rbs_navier_stokes_subtype, &
10145  & equations_set_transient_rbs_navier_stokes_subtype, &
10146  & equations_set_multiscale3d_navier_stokes_subtype, &
10147  & equations_set_constitutive_mu_navier_stokes_subtype)
10148  equations=>equationsset%EQUATIONS
10149  IF(ASSOCIATED(equations)) THEN
10150  !Set general and specific pointers
10151  equationsmapping=>equations%EQUATIONS_MAPPING
10152  equationsmatrices=>equations%EQUATIONS_MATRICES
10153  nonlinearmapping=>equationsmapping%NONLINEAR_MAPPING
10154  nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
10155  jacobianmatrix=>nonlinearmatrices%JACOBIANS(1)%PTR
10156  fieldvariable=>nonlinearmapping%RESIDUAL_VARIABLES(1)%PTR
10157  fieldvariabletype=fieldvariable%VARIABLE_TYPE
10158  geometricfield=>equations%INTERPOLATION%GEOMETRIC_FIELD
10159  numberofdimensions=fieldvariable%NUMBER_OF_COMPONENTS - 1
10160  equationsequationssetfield=>equationsset%EQUATIONS_SET_FIELD
10161  meshcomponent1=fieldvariable%COMPONENTS(1)%MESH_COMPONENT_NUMBER
10162  meshcomponent2=fieldvariable%COMPONENTS(fieldvariable%NUMBER_OF_COMPONENTS)%MESH_COMPONENT_NUMBER
10163  dependentfield=>equations%INTERPOLATION%DEPENDENT_FIELD
10164  basisvelocity=>dependentfield%DECOMPOSITION%DOMAIN(meshcomponent1)%PTR% &
10165  & topology%ELEMENTS%ELEMENTS(elementnumber)%BASIS
10166  basispressure=>dependentfield%DECOMPOSITION%DOMAIN(meshcomponent2)%PTR% &
10167  & topology%ELEMENTS%ELEMENTS(elementnumber)%BASIS
10168 
10169  IF(basisvelocity%INTERPOLATION_ORDER(1).LE.1) THEN
10170  linearelement = .true.
10171  ELSE
10172  ! higher order element type- can calculate 2nd order terms
10173  linearelement = .false.
10174  END IF
10175 
10176  quadraturevelocity=>basisvelocity%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
10177  quadraturepressure=>basispressure%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
10178  equationssetfield=>equationsequationssetfield%EQUATIONS_SET_FIELD_FIELD
10179  IF(ASSOCIATED(equationssetfield)) THEN
10180  ! Stabilisation type (default 1 for RBS, 2 for RBVM, 0 for none)
10181  CALL field_parameter_set_get_constant(equationssetfield,field_u1_variable_type,field_values_set_type, &
10182  & 4,stabilisationvaluedp,err,error,*999)
10183  stabilisationtype=nint(stabilisationvaluedp)
10184  ! Skip if type 0
10185  IF(stabilisationtype > 0) THEN
10186  ! Get time step size and calc time derivative
10187  CALL field_parameter_set_get_constant(equationssetfield,field_u1_variable_type,field_values_set_type, &
10188  & 3,timeincrement,err,error,*999)
10189  ! TODO: put this somewhere more sensible. This is a workaround since we don't have access to the dynamic solver values
10190  ! at this level in the element loop
10191  IF(equationsset%specification(3)/=equations_set_static_rbs_navier_stokes_subtype &
10192  & .AND. timeincrement < zero_tolerance) THEN
10193  CALL flagerror("Please set the equations set field time increment to a value > 0.",err,error,*999)
10194  END IF
10195  ! Stabilisation type (default 1 for RBS)
10196  CALL field_parameter_set_get_constant(equationssetfield,field_u1_variable_type,field_values_set_type, &
10197  & 4,stabilisationvaluedp,err,error,*999)
10198  stabilisationtype=nint(stabilisationvaluedp)
10199  ! User specified or previously calculated C1
10200  CALL field_parametersetgetlocalelement(equationssetfield,field_v_variable_type,field_values_set_type, &
10201  & elementnumber,10,elementinverse,err,error,*999)
10202 
10203  ! Get previous timestep values
10204  velocityprevious=0.0_dp
10205  IF(equationsset%specification(3) /= equations_set_static_rbs_navier_stokes_subtype) THEN
10206  CALL field_interpolation_parameters_element_get(field_previous_values_set_type,elementnumber,equations% &
10207  & interpolation%DEPENDENT_INTERP_PARAMETERS(field_u_variable_type)%PTR,err,error,*999)
10208  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,gaussnumber,equations%INTERPOLATION% &
10209  & dependent_interp_point(field_u_variable_type)%PTR,err,error,*999)
10210  velocityprevious=0.0_dp
10211  DO i=1,numberofdimensions
10212  velocityprevious(i)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(fieldvariabletype)%PTR%VALUES(i,no_part_deriv)
10213  END DO
10214  END IF
10215 
10216  ! Interpolate current solution velocity/pressure field values
10217  CALL field_interpolation_parameters_element_get(field_values_set_type,elementnumber,equations%INTERPOLATION% &
10218  & dependent_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
10219  IF(linearelement) THEN
10220  ! Get 1st order derivatives for current timestep value
10221  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gaussnumber,equations%INTERPOLATION% &
10222  & dependent_interp_point(field_u_variable_type)%PTR,err,error,*999)
10223  ELSE
10224  ! Get 2nd order derivatives for current timestep value
10225  CALL field_interpolate_gauss(second_part_deriv,basis_default_quadrature_scheme,gaussnumber,equations%INTERPOLATION%&
10226  & dependent_interp_point(field_u_variable_type)%PTR,err,error,*999)
10227  END IF
10228  velocity=0.0_dp
10229  velocityderiv=0.0_dp
10230  velocity2deriv=0.0_dp
10231  pressure=0.0_dp
10232  pressurederiv=0.0_dp
10233  DO i=1,numberofdimensions
10234  velocity(i)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(fieldvariabletype)%PTR%VALUES(i,no_part_deriv)
10235  velocityderiv(i,1)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(fieldvariabletype)%PTR%VALUES(i,part_deriv_s1)
10236  velocityderiv(i,2)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(fieldvariabletype)%PTR%VALUES(i,part_deriv_s2)
10237  IF(.NOT. linearelement) THEN
10238  velocity2deriv(i,1,1)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(fieldvariabletype)%PTR% &
10239  & values(i,part_deriv_s1_s1)
10240  velocity2deriv(i,1,2)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(fieldvariabletype)%PTR% &
10241  & values(i,part_deriv_s1_s2)
10242  velocity2deriv(i,2,1)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(fieldvariabletype)%PTR% &
10243  & values(i,part_deriv_s1_s2)
10244  velocity2deriv(i,2,2)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(fieldvariabletype)%PTR% &
10245  & values(i,part_deriv_s2_s2)
10246  END IF
10247  IF(numberofdimensions > 2) THEN
10248  velocityderiv(i,3)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(fieldvariabletype)%PTR%VALUES(i,part_deriv_s3)
10249  IF(.NOT. linearelement) THEN
10250  velocity2deriv(i,1,3)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(fieldvariabletype)%PTR% &
10251  & values(i,part_deriv_s1_s3)
10252  velocity2deriv(i,2,3)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(fieldvariabletype)%PTR% &
10253  & values(i,part_deriv_s2_s3)
10254  velocity2deriv(i,3,1)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(fieldvariabletype)%PTR% &
10255  & values(i,part_deriv_s1_s3)
10256  velocity2deriv(i,3,2)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(fieldvariabletype)%PTR% &
10257  & values(i,part_deriv_s2_s3)
10258  velocity2deriv(i,3,3)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(fieldvariabletype)%PTR% &
10259  & values(i,part_deriv_s3_s3)
10260  END IF
10261  END IF
10262  END DO
10263  pressureindex = numberofdimensions + 1
10264  pressure=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(fieldvariabletype)%PTR%VALUES(pressureindex,no_part_deriv)
10265  pressurederiv(1)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(fieldvariabletype)% &
10266  & ptr%VALUES(pressureindex,part_deriv_s1)
10267  pressurederiv(2)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(fieldvariabletype)% &
10268  & ptr%VALUES(pressureindex,part_deriv_s2)
10269  IF(numberofdimensions > 2) THEN
10270  pressurederiv(3)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(fieldvariabletype)% &
10271  & ptr%VALUES(pressureindex,part_deriv_s3)
10272  END IF
10273  dxi_dx=0.0_dp
10274  DO i=1,numberofdimensions
10275  DO j=1,numberofdimensions
10276  dxi_dx(j,i)=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR% &
10277  & dxi_dx(j,i)
10278  END DO
10279  END DO
10280 
10281  ! Get number of element parameters for each dependent component
10282  numberofelementparameters=0
10283  DO i=1,numberofdimensions
10284  numberofelementparameters(i)=basisvelocity%NUMBER_OF_ELEMENT_PARAMETERS
10285  END DO
10286  numberofelementparameters(numberofdimensions+1)=basispressure%NUMBER_OF_ELEMENT_PARAMETERS
10287  ! Calculate dPhi/dX
10288  dphi_dx_velocity=0.0_dp
10289  dphi_dx_pressure=0.0_dp
10290  DO ms=1,numberofelementparameters(1)
10291  DO nj=1,numberofdimensions
10292  dphi_dx_velocity(ms,nj)=0.0_dp
10293  DO ni=1,numberofdimensions
10294  dphi_dx_velocity(ms,nj)=dphi_dx_velocity(ms,nj) + &
10295  & quadraturevelocity%GAUSS_BASIS_FNS(ms,partial_derivative_first_derivative_map(ni),gaussnumber)* &
10296  & dxi_dx(ni,nj)
10297  END DO
10298  END DO
10299  END DO
10300  DO ms=1,numberofelementparameters(numberofdimensions+1)
10301  DO nj=1,numberofdimensions
10302  dphi_dx_pressure(ms,nj)=0.0_dp
10303  DO ni=1,numberofdimensions
10304  dphi_dx_pressure(ms,nj)=dphi_dx_pressure(ms,nj) + &
10305  & quadraturepressure%GAUSS_BASIS_FNS(ms,partial_derivative_first_derivative_map(ni),gaussnumber)* &
10306  & dxi_dx(ni,nj)
10307  END DO
10308  END DO
10309  END DO
10310  jgw=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
10311  & quadraturevelocity%GAUSS_WEIGHTS(gaussnumber)
10312 
10313  !----------------------------------------------------------------------------------
10314  ! C a l c u l a t e d i s c r e t e r e s i d u a l s
10315  !----------------------------------------------------------------------------------
10316  sum = 0.0_dp
10317  residualmomentum = 0.0_dp
10318  residualcontinuity = 0.0_dp
10319  ! Calculate momentum residual
10320  DO i=1,numberofdimensions
10321  sum = 0.0_dp
10322  ! velocity time derivative
10323  IF(equationsset%specification(3) /= equations_set_static_rbs_navier_stokes_subtype) THEN
10324  sum = rho*(velocity(i)-velocityprevious(i))/timeincrement
10325  END IF
10326  DO j=1,numberofdimensions
10327  ! pressure gradient
10328  sum = sum + pressurederiv(j)*dxi_dx(j,i)
10329  DO k=1,numberofdimensions
10330  !Convective term
10331  sum = sum +rho*((velocity(j))*(velocityderiv(i,k)*dxi_dx(k,j)))
10332  IF(.NOT. linearelement) THEN
10333  DO l=1,numberofdimensions
10334  ! viscous stress: only if quadratic or higher basis defined for laplacian
10335  sum = sum - mu*(velocity2deriv(i,k,l)*dxi_dx(k,j)*dxi_dx(l,j))
10336  END DO
10337  END IF
10338  END DO
10339  END DO
10340  residualmomentum(i) = sum
10341  END DO
10342  ! Calculate continuity residual
10343  sum = 0.0_dp
10344  DO i=1,numberofdimensions
10345  DO j=1,numberofdimensions
10346  sum= sum + velocityderiv(i,j)*dxi_dx(j,i)
10347  END DO
10348  END DO
10349  residualcontinuity = sum
10350 
10351  ! Constant of element inverse inequality
10352  IF(elementinverse > -zero_tolerance) THEN
10353  ! Use user-defined value if specified (default -1)
10354  c1 = elementinverse
10355  ELSE IF(linearelement) THEN
10356  c1=3.0_dp
10357  ELSE
10358  IF(numberofdimensions==2 .AND. basisvelocity%NUMBER_OF_ELEMENT_PARAMETERS==9 &
10359  & .AND. basisvelocity%INTERPOLATION_ORDER(1)==2) THEN
10360  c1=24.0_dp
10361  ELSE IF(numberofdimensions==3 .AND. basisvelocity%NUMBER_OF_ELEMENT_PARAMETERS==27 &
10362  & .AND. basisvelocity%INTERPOLATION_ORDER(1)==2) THEN
10363  c1=12.0_dp
10364  !TODO: Expand C1 for more element types
10365  ELSE
10366  CALL flagerror("Element inverse estimate undefined on element " &
10367  & //trim(number_to_vstring(elementnumber,"*",err,error)),err,error,*999)
10368  END IF
10369  END IF
10370  ! Update element inverse value if calculated
10371  IF(abs(c1-elementinverse) > zero_tolerance) THEN
10372  CALL field_parameter_set_update_local_element(equationssetfield,field_v_variable_type,field_values_set_type, &
10373  & elementnumber,10,c1,err,error,*999)
10374  END IF
10375 
10376  !----------------------------------------------------------
10377  ! S t a b i l i z a t i o n C o n s t a n t s (Taus)
10378  !----------------------------------------------------------
10379  IF(stabilisationtype == 1 .OR. stabilisationtype == 2) THEN
10380  ! Bazilevs method for calculating tau
10381  pointmetrics=>equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR
10382  udotgu = 0.0_dp
10383  DO i=1,numberofdimensions
10384  DO j=1,numberofdimensions
10385  udotgu = udotgu + velocity(i)*pointmetrics%GU(i,j)*velocity(j)
10386  END DO
10387  END DO
10388  doubledotg = 0.0_dp
10389  DO i=1,numberofdimensions
10390  DO j=1,numberofdimensions
10391  doubledotg = doubledotg + pointmetrics%GU(i,j)*pointmetrics%GU(i,j)
10392  END DO
10393  END DO
10394  ! Calculate tauSUPS (used for both PSPG and SUPG weights)
10395  IF(equationsset%specification(3) == equations_set_static_rbs_navier_stokes_subtype) THEN
10396  tausups = (udotgu + (c1*((mu/rho)**2.0_dp)*doubledotg))**(-0.5_dp)
10397  ELSE
10398  tausups = ((4.0_dp/(timeincrement**2.0_dp)) + udotgu + (c1*((mu/rho)**2.0_dp)*doubledotg))**(-0.5_dp)
10399  END IF
10400 
10401  ! Calculate nu_LSIC (Least-squares incompressibility constraint)
10402  traceg = 0.0_dp
10403  DO i=1,numberofdimensions
10404  traceg = traceg + pointmetrics%GU(i,i)
10405  END DO
10406  nulsic = 1.0_dp/(tausups*traceg)
10407 
10408  taump = tausups
10409  taumu = tausups
10410  tauc = nulsic
10411 
10412  ELSE
10413  CALL flagerror("A tau factor has not been defined for the stabilisation type of " &
10414  & //trim(number_to_vstring(stabilisationtype,"*",err,error)),err,error,*999)
10415  END IF
10416 
10417  !-------------------------------------------------------------------------------------------------
10418  ! A d d s t a b i l i z a t i o n f a c t o r s t o e l e m e n t m a t r i c e s
10419  !-------------------------------------------------------------------------------------------------
10420  jacobianmomentum = 0.0_dp
10421  jacobiancontinuity = 0.0_dp
10422  mhs = 0
10423  DO mh=1,numberofdimensions+1
10424  DO ms=1,numberofelementparameters(mh)
10425  mhs = mhs + 1
10426  IF(mh <= numberofdimensions) THEN
10427  phims=quadraturevelocity%GAUSS_BASIS_FNS(ms,no_part_deriv,gaussnumber)
10428  jgw=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
10429  & quadraturevelocity%GAUSS_WEIGHTS(gaussnumber)
10430  ELSE
10431  phims=quadraturepressure%GAUSS_BASIS_FNS(ms,no_part_deriv,gaussnumber)
10432  jgw=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
10433  & quadraturepressure%GAUSS_WEIGHTS(gaussnumber)
10434  END IF
10435  !------------------
10436  ! J A C O B I A N
10437  !------------------
10438  IF(jacobianflag) THEN
10439  nhs = 0
10440  DO nh=1,numberofdimensions+1
10441  DO ns=1,numberofelementparameters(nh)
10442  nhs=nhs+1
10443  ! Note that we still need to assemble the vector momentum jacobian for PSPG in the continuity row
10444  IF(nh <= numberofdimensions) THEN
10445  phins=quadraturevelocity%GAUSS_BASIS_FNS(ns,no_part_deriv,gaussnumber)
10446  ELSE
10447  phins=quadraturepressure%GAUSS_BASIS_FNS(ns,no_part_deriv,gaussnumber)
10448  END IF
10449 
10450  ! Calculate jacobians of the discrete residual terms
10451  jacobianmomentum = 0.0_dp
10452  IF(nh == numberofdimensions+1) THEN
10453  ! d(Momentum(mh))/d(Pressure)
10454  DO i=1,numberofdimensions
10455  jacobianmomentum(i) = dphi_dx_pressure(ns,i)
10456  END DO
10457  jacobiancontinuity=0.0_dp
10458  ELSE
10459  dphins2_dxi=0.0_dp
10460  IF(.NOT. linearelement) THEN
10461  dphins2_dxi(1,1)=quadraturevelocity%GAUSS_BASIS_FNS(ns,part_deriv_s1_s1,gaussnumber)
10462  dphins2_dxi(1,2)=quadraturevelocity%GAUSS_BASIS_FNS(ns,part_deriv_s1_s2,gaussnumber)
10463  dphins2_dxi(2,1)=quadraturevelocity%GAUSS_BASIS_FNS(ns,part_deriv_s1_s2,gaussnumber)
10464  dphins2_dxi(2,2)=quadraturevelocity%GAUSS_BASIS_FNS(ns,part_deriv_s2_s2,gaussnumber)
10465  IF(numberofdimensions > 2) THEN
10466  dphins2_dxi(1,3)=quadraturevelocity%GAUSS_BASIS_FNS(ns,part_deriv_s1_s3,gaussnumber)
10467  dphins2_dxi(2,3)=quadraturevelocity%GAUSS_BASIS_FNS(ns,part_deriv_s2_s3,gaussnumber)
10468  dphins2_dxi(3,1)=quadraturevelocity%GAUSS_BASIS_FNS(ns,part_deriv_s1_s3,gaussnumber)
10469  dphins2_dxi(3,2)=quadraturevelocity%GAUSS_BASIS_FNS(ns,part_deriv_s2_s3,gaussnumber)
10470  dphins2_dxi(3,3)=quadraturevelocity%GAUSS_BASIS_FNS(ns,part_deriv_s3_s3,gaussnumber)
10471  END IF
10472  END IF
10473  ! d(Momentum)/d(Velocity(nh))
10474  jacobianmomentum = 0.0_dp
10475  DO i=1,numberofdimensions
10476  sum = 0.0_dp
10477  !Note: Convective term split using product rule
10478  !Convective term 1: applies to all velocity components
10479  DO j=1,numberofdimensions
10480  sum = sum + rho*phins*velocityderiv(i,j)*dxi_dx(j,nh)
10481  END DO
10482  !Diagonal terms
10483  IF(i==nh) THEN
10484  !Transient
10485  IF(equationsset%specification(3) /= equations_set_static_rbs_navier_stokes_subtype) THEN
10486  sum = sum + rho*phins/timeincrement
10487  END IF
10488  !Convective 2: nh component only
10489  DO j=1,numberofdimensions
10490  sum = sum + rho*velocity(j)*dphi_dx_velocity(ns,j)
10491  END DO
10492  IF(.NOT. linearelement) THEN
10493  !Viscous laplacian term
10494  DO j=1,numberofdimensions
10495  DO k=1,numberofdimensions
10496  DO l=1,numberofdimensions
10497  sum=sum-mu*dphins2_dxi(k,l)*dxi_dx(k,j)*dxi_dx(l,j)
10498  END DO
10499  END DO
10500  END DO
10501  END IF
10502  END IF
10503  jacobianmomentum(i)=sum
10504  END DO
10505  ! Continuity/velocity
10506  jacobiancontinuity = dphi_dx_velocity(ns,nh)
10507  END IF
10508  ! Calculate jacobian of discrete residual * RBS factors (apply product rule if neccesary)
10509 
10510  ! PSPG: Pressure stabilising Petrov-Galerkin
10511  IF(mh == numberofdimensions+1) THEN
10512  pspg = 0.0_dp
10513  sum = 0.0_dp
10514  DO i=1,numberofdimensions
10515  sum = sum + dphi_dx_pressure(ms,i)*jacobianmomentum(i)
10516  END DO
10517  pspg = taump*sum/rho*jgw
10518 
10519  jacobianmatrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)=jacobianmatrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)+pspg
10520 
10521  ! SUPG: Streamline upwind/Petrov-Galerkin
10522  ! LSIC: Least-squares incompressibility constraint
10523  ELSE
10524  supg=0.0_dp
10525  lsic=0.0_dp
10526 
10527  sum=0.0_dp
10528  IF(nh <= numberofdimensions) THEN
10529  supg= supg + phins*dphi_dx_velocity(ms,nh)*residualmomentum(mh)
10530  END IF
10531  DO i=1,numberofdimensions
10532  sum = sum + velocity(i)*dphi_dx_velocity(ms,i)
10533  END DO
10534  supg = taumu*(supg + sum*jacobianmomentum(mh))
10535 
10536  sum=0.0_dp
10537  DO i=1,numberofdimensions
10538  sum = sum + dphi_dx_velocity(ms,i)
10539  END DO
10540  lsic = tauc*rho*dphi_dx_velocity(ms,mh)*jacobiancontinuity
10541 
10542  momentumterm = (supg + lsic)*jgw
10543 
10544  IF(stabilisationtype == 2) THEN
10545  ! Additional terms for RBVM
10546  crossstress=0.0_dp
10547  reynoldsstress=0.0_dp
10548  crossstress = 0.0_dp
10549  IF(nh <= numberofdimensions) THEN
10550  IF(mh == nh) THEN
10551  DO i=1,numberofdimensions
10552  crossstress= crossstress + dphi_dx_velocity(ns,i)*residualmomentum(i)
10553  END DO
10554  END IF
10555  END IF
10556  sum2=0.0_dp
10557  DO i=1,numberofdimensions
10558  sum=0.0_dp
10559  ! dU_mh/dX_i
10560  DO j=1,numberofdimensions
10561  sum= sum + velocityderiv(mh,j)*dxi_dx(j,i)
10562  END DO
10563  ! Jm_i*dU_mh/dX_i
10564  sum2 = sum2 + jacobianmomentum(i)*sum
10565  END DO
10566  crossstress = -taumu*(crossstress + sum2)
10567 
10568  reynoldsstress = 0.0_dp
10569  sum = 0.0_dp
10570  !Rm_mh.Rm_i.dPhi/dX_i
10571  DO i=1,numberofdimensions
10572  sum = sum + jacobianmomentum(mh)*residualmomentum(i)*dphi_dx_velocity(ms,i)
10573  sum = sum + jacobianmomentum(i)*residualmomentum(mh)*dphi_dx_velocity(ms,i)
10574  END DO
10575  reynoldsstress = -taumu*taumu*sum
10576 
10577  momentumterm = momentumterm + (crossstress + reynoldsstress)*jgw
10578  END IF
10579 
10580  ! Add stabilisation to element jacobian
10581  jacobianmatrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)= &
10582  & jacobianmatrix%ELEMENT_JACOBIAN%MATRIX(mhs,nhs)+momentumterm
10583 
10584  END IF
10585  END DO
10586  END DO
10587 
10588  !-----------------
10589  ! R E S I D U A L
10590  !-----------------
10591  ELSE
10592  ! PSPG: Pressure stabilising Petrov-Galerkin
10593  IF(mh == numberofdimensions+1) THEN
10594  sum = 0.0_dp
10595  DO i=1,numberofdimensions
10596  sum = sum + dphi_dx_pressure(ms,i)*residualmomentum(i)
10597  END DO
10598  pspg = sum*(taump/rho)*jgw
10599  nonlinearmatrices%ELEMENT_RESIDUAL%VECTOR(mhs)= &
10600  & nonlinearmatrices%ELEMENT_RESIDUAL%VECTOR(mhs) + pspg
10601 
10602  ! SUPG: Streamline upwind/Petrov-Galerkin
10603  ! LSIC: Least-squares incompressibility constraint
10604  ELSE
10605  supg=0.0_dp
10606  lsic=0.0_dp
10607 
10608  ! u_i*Rm_mh*dv_mh/dx_i
10609  sum=0.0_dp
10610  DO i=1,numberofdimensions
10611  sum = sum + velocity(i)*dphi_dx_velocity(ms,i)
10612  END DO
10613  supg = taumu*sum*residualmomentum(mh)
10614 
10615  lsic = tauc*rho*dphi_dx_velocity(ms,mh)*residualcontinuity
10616  momentumterm = (supg + lsic)*jgw
10617 
10618  IF(stabilisationtype ==2) THEN
10619  ! Additional terms for RBVM
10620  crossstress=0.0_dp
10621  reynoldsstress=0.0_dp
10622  sum2 = 0.0_dp
10623  DO i=1,numberofdimensions
10624  sum = 0.0_dp
10625  ! dU_mh/dX_i
10626  DO j=1,numberofdimensions
10627  sum= sum + velocityderiv(mh,j)*dxi_dx(j,i)
10628  END DO
10629  ! Rm_i.dU_mh/dX_i
10630  sum2= sum2 + residualmomentum(i)*sum
10631  END DO
10632  crossstress= -taumu*phims*sum2
10633 
10634  reynoldsstress = 0.0_dp
10635  sum = 0.0_dp
10636  !Rm_mh.Rm_i.dPhi/dX_i
10637  DO i=1,numberofdimensions
10638  sum = sum + dphi_dx_velocity(ms,i)*residualmomentum(i)*residualmomentum(mh)
10639  END DO
10640  reynoldsstress = -sum*(taumu*taumu)/rho
10641  momentumterm = momentumterm + (crossstress + reynoldsstress)*jgw
10642  END IF
10643 
10644  ! Add stabilisation to element residual
10645  nonlinearmatrices%ELEMENT_RESIDUAL%VECTOR(mhs)= &
10646  & nonlinearmatrices%ELEMENT_RESIDUAL%VECTOR(mhs) + momentumterm
10647  END IF
10648  END IF ! jacobian/residual
10649  END DO !ms
10650  END DO !mh
10651 
10652  END IF ! check stabilisation type
10653  ELSE
10654  CALL flagerror("Equations equations set field is not associated.",err,error,*999)
10655  END IF
10656  ELSE
10657  CALL flagerror("Equations set equations is not associated.",err,error,*999)
10658  END IF
10659  CASE DEFAULT
10660  localerror="Equations set subtype "//trim(number_to_vstring(equationsset%specification(3),"*",err,error))// &
10661  & " is not a valid subtype to use SUPG weighting functions."
10662  CALL flagerror(localerror,err,error,*999)
10663  END SELECT
10664  ELSE
10665  CALL flagerror("Equations set is not associated.",err,error,*999)
10666  END IF
10667 
10668  exits("NavierStokes_ResidualBasedStabilisation")
10669  RETURN
10670 999 errorsexits("NavierStokes_ResidualBasedStabilisation",err,error)
10671  RETURN 1
10672 
10673  END SUBROUTINE navierstokes_residualbasedstabilisation
10674 
10675  !
10676  !================================================================================================================================
10677  !
10678 
10680  SUBROUTINE navierstokes_calculateelementmetrics(equationsSet,elementNumber,err,error,*)
10681 
10682  !Argument variables
10683  TYPE(equations_set_type), POINTER :: equationsSet
10684  INTEGER(INTG), INTENT(IN) :: elementNumber
10685  INTEGER(INTG), INTENT(OUT) :: err
10686  TYPE(varying_string), INTENT(OUT) :: error
10687 
10688  !Local Variables
10689  TYPE(basis_type), POINTER :: basisVelocity
10690  TYPE(equations_type), POINTER :: equations
10691  TYPE(equations_mapping_type), POINTER :: equationsMapping
10692  TYPE(equations_mapping_nonlinear_type), POINTER :: nonlinearMapping
10693  TYPE(equations_set_equations_set_field_type), POINTER :: equationsEquationsSetField
10694  TYPE(field_type), POINTER :: equationsSetField
10695  TYPE(quadrature_scheme_type), POINTER :: quadratureVelocity
10696  TYPE(field_type), POINTER :: dependentField,geometricField
10697  TYPE(field_variable_type), POINTER :: fieldVariable
10698 
10699  INTEGER(INTG) :: fieldVariableType,meshComponent1
10700  INTEGER(INTG) :: numberOfDimensions,mh
10701  INTEGER(INTG) :: gaussNumber
10702  INTEGER(INTG) :: i,j,ms
10703  INTEGER(INTG) :: numberOfElementParameters
10704  INTEGER(INTG) :: LWORK,INFO
10705  REAL(DP) :: cellReynoldsNumber,cellCourantNumber,timeIncrement
10706  REAL(DP) :: dPhi_dX_Velocity(27,3)
10707  REAL(DP) :: DXI_DX(3,3)
10708  REAL(DP) :: velocity(3),avgVelocity(3),velocityNorm,velocityPrevious(3),velocityDeriv(3,3)
10709  REAL(DP) :: PHIMS,JGW,SUM,SUM2,mu,rho,normCMatrix,normKMatrix,normMMatrix,muScale
10710  REAL(DP) :: CMatrix(27,3),KMatrix(27,3),MMatrix(27,3)
10711  REAL(DP) :: svd(3),U(27,27),VT(3,3)
10712  REAL(DP), ALLOCATABLE :: WORK(:)
10713  TYPE(varying_string) :: localError
10714 
10715  enters("NavierStokes_CalculateElementMetrics",err,error,*999)
10716 
10717  ! Nullify all local pointers
10718  NULLIFY(basisvelocity)
10719  NULLIFY(equations)
10720  NULLIFY(equationsmapping)
10721  NULLIFY(nonlinearmapping)
10722  NULLIFY(equationsequationssetfield)
10723  NULLIFY(equationssetfield)
10724  NULLIFY(quadraturevelocity)
10725  NULLIFY(dependentfield)
10726  NULLIFY(geometricfield)
10727  NULLIFY(fieldvariable)
10728 
10729  IF(ASSOCIATED(equationsset))THEN
10730  SELECT CASE(equationsset%specification(3))
10731  CASE(equations_set_static_rbs_navier_stokes_subtype, &
10732  & equations_set_transient_rbs_navier_stokes_subtype, &
10733  & equations_set_multiscale3d_navier_stokes_subtype)
10734  equations=>equationsset%EQUATIONS
10735  IF(ASSOCIATED(equations)) THEN
10736  !Set general and specific pointers
10737  equationsmapping=>equations%EQUATIONS_MAPPING
10738  nonlinearmapping=>equationsmapping%NONLINEAR_MAPPING
10739  fieldvariable=>nonlinearmapping%RESIDUAL_VARIABLES(1)%PTR
10740  fieldvariabletype=fieldvariable%VARIABLE_TYPE
10741  geometricfield=>equations%INTERPOLATION%GEOMETRIC_FIELD
10742  numberofdimensions=fieldvariable%NUMBER_OF_COMPONENTS - 1
10743  equationsequationssetfield=>equationsset%EQUATIONS_SET_FIELD
10744  meshcomponent1=fieldvariable%COMPONENTS(1)%MESH_COMPONENT_NUMBER
10745  dependentfield=>equations%INTERPOLATION%DEPENDENT_FIELD
10746  basisvelocity=>dependentfield%DECOMPOSITION%DOMAIN(meshcomponent1)%PTR% &
10747  & topology%ELEMENTS%ELEMENTS(elementnumber)%BASIS
10748  quadraturevelocity=>basisvelocity%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
10749 
10750  IF(ASSOCIATED(equationsequationssetfield)) THEN
10751  equationssetfield=>equationsequationssetfield%EQUATIONS_SET_FIELD_FIELD
10752  IF(ASSOCIATED(equationssetfield)) THEN
10753 
10754  ! Get time step size
10755  CALL field_parameter_set_get_constant(equationssetfield,field_u1_variable_type,field_values_set_type, &
10756  & 3,timeincrement,err,error,*999)
10757 
10758  ! Loop over gauss points
10759  cmatrix = 0.0_dp
10760  mmatrix = 0.0_dp
10761  kmatrix = 0.0_dp
10762  CALL field_interpolation_parameters_element_get(field_values_set_type,elementnumber,equations%INTERPOLATION% &
10763  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
10764  CALL field_parameter_set_get_constant(equationsset%MATERIALS%MATERIALS_FIELD,field_u_variable_type, &
10765  & field_values_set_type,1,mu,err,error,*999)
10766  CALL field_parameter_set_get_constant(equationsset%MATERIALS%MATERIALS_FIELD,field_u_variable_type, &
10767  & field_values_set_type,2,rho,err,error,*999)
10768 
10769  avgvelocity = 0.0_dp
10770  DO gaussnumber = 1,quadraturevelocity%NUMBER_OF_GAUSS
10771 
10772  ! Get the constitutive law (non-Newtonian) viscosity based on shear rate
10773  IF(equationsset%specification(3)==equations_set_constitutive_mu_navier_stokes_subtype) THEN
10774  ! Note the constant from the U_VARIABLE is a scale factor
10775  muscale = mu
10776  ! Get the gauss point based value returned from the CellML solver
10777  CALL field_parametersetgetlocalgausspoint(equationsset%MATERIALS%MATERIALS_FIELD,field_v_variable_type, &
10778  & field_values_set_type,gaussnumber,elementnumber,1,mu,err,error,*999)
10779  mu=mu*muscale
10780  END IF
10781 
10782  ! Get previous timestep values
10783  velocityprevious=0.0_dp
10784  CALL field_interpolation_parameters_element_get(field_previous_values_set_type,elementnumber,equations% &
10785  & interpolation%DEPENDENT_INTERP_PARAMETERS(field_u_variable_type)%PTR,err,error,*999)
10786  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,gaussnumber,equations%INTERPOLATION%&
10787  & dependent_interp_point(field_u_variable_type)%PTR,err,error,*999)
10788  velocityprevious=0.0_dp
10789  DO i=1,numberofdimensions
10790  velocityprevious(i)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_u_variable_type)%PTR% &
10791  & values(i,no_part_deriv)
10792  END DO
10793 
10794  ! Interpolate current solution velocity and first deriv field values
10795  CALL field_interpolation_parameters_element_get(field_values_set_type,elementnumber, &
10796  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_u_variable_type)%PTR,err,error,*999)
10797  ! Get 1st order derivatives for current timestep value
10798  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gaussnumber, &
10799  & equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_u_variable_type)%PTR,err,error,*999)
10800  velocity=0.0_dp
10801  velocityderiv=0.0_dp
10802  DO i=1,numberofdimensions
10803  velocity(i)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(i,no_part_deriv)
10804  velocityderiv(i,1)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_u_variable_type)% &
10805  & ptr%VALUES(i,part_deriv_s1)
10806  velocityderiv(i,2)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_u_variable_type)% &
10807  & ptr%VALUES(i,part_deriv_s2)
10808  IF(numberofdimensions > 2) THEN
10809  velocityderiv(i,3)=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_u_variable_type)% &
10810  & ptr%VALUES(i,part_deriv_s3)
10811  END IF
10812  END DO
10813 
10814  ! get dXi/dX deriv
10815  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gaussnumber,equations%INTERPOLATION%&
10816  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
10817  dxi_dx=0.0_dp
10818  DO i=1,numberofdimensions
10819  DO j=1,numberofdimensions
10820  dxi_dx(j,i)=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR% &
10821  & dxi_dx(j,i)
10822  END DO
10823  END DO
10824 
10825  numberofelementparameters=basisvelocity%NUMBER_OF_ELEMENT_PARAMETERS
10826  ! Calculate dPhi/dX
10827  dphi_dx_velocity=0.0_dp
10828  DO ms=1,numberofelementparameters
10829  DO i=1,numberofdimensions
10830  dphi_dx_velocity(ms,i)=0.0_dp
10831  DO j=1,numberofdimensions
10832  dphi_dx_velocity(ms,i)=dphi_dx_velocity(ms,i) + &
10833  & quadraturevelocity%GAUSS_BASIS_FNS(ms,partial_derivative_first_derivative_map(j),gaussnumber)* &
10834  & dxi_dx(j,i)
10835  END DO
10836  END DO
10837  END DO
10838 
10839  jgw=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
10840  & quadraturevelocity%GAUSS_WEIGHTS(gaussnumber)
10841  DO mh=1,numberofdimensions
10842  DO ms=1,numberofelementparameters
10843  phims=quadraturevelocity%GAUSS_BASIS_FNS(ms,no_part_deriv,gaussnumber)
10844 
10845  ! c_(a,i)
10846  sum=0.0_dp
10847  DO i=1,numberofdimensions
10848  DO j=1,numberofdimensions
10849  sum = sum + velocity(i)*velocityderiv(mh,j)*dxi_dx(j,i)
10850  END DO
10851  END DO
10852  cmatrix(ms,mh)=cmatrix(ms,mh) + rho*phims*sum*jgw
10853 
10854  ! ~k_(a,i)
10855  sum=0.0_dp
10856  DO i=1,numberofdimensions
10857  sum = sum + velocity(i)*dphi_dx_velocity(ms,i)
10858  END DO
10859  sum2=0.0_dp
10860  DO i=1,numberofdimensions
10861  DO j=1,numberofdimensions
10862  sum2 = sum2 + velocity(i)*velocityderiv(mh,j)*dxi_dx(j,i)
10863  END DO
10864  END DO
10865  kmatrix(ms,mh)=kmatrix(ms,mh)+rho*sum*sum2*jgw
10866 
10867  ! m_(a,i)
10868  mmatrix(ms,mh)=mmatrix(ms,mh)+rho*phims*(velocity(mh)-velocityprevious(mh))/timeincrement*jgw
10869 
10870  END DO !ms
10871  END DO !mh
10872 
10873  avgvelocity= avgvelocity + velocity/quadraturevelocity%NUMBER_OF_GAUSS
10874  END DO ! gauss loop
10875 
10876  lwork=max(1,3*min(numberofelementparameters,numberofdimensions)+ &
10877  & max(numberofelementparameters,numberofdimensions),5*min(numberofelementparameters,numberofdimensions))
10878  ALLOCATE(work(lwork))
10879 
10880  ! compute the singular value decomposition (SVD) using LAPACK
10881  CALL dgesvd('A','A',numberofelementparameters,numberofdimensions,cmatrix,numberofelementparameters,svd, &
10882  & u,numberofelementparameters,vt,numberofdimensions,work,lwork,info)
10883  normcmatrix=svd(1)
10884  IF(info /= 0) THEN
10885  localerror="Error calculating SVD on element "//trim(number_to_vstring(elementnumber,"*",err,error))//"."
10886  CALL flagerror(localerror,err,error,*999)
10887  END IF
10888 
10889  CALL dgesvd('A','A',numberofelementparameters,numberofdimensions,kmatrix,numberofelementparameters,svd, &
10890  & u,numberofelementparameters,vt,numberofdimensions,work,lwork,info)
10891  normkmatrix=svd(1)
10892  IF(info /= 0) THEN
10893  localerror="Error calculating SVD on element "//trim(number_to_vstring(elementnumber,"*",err,error))//"."
10894  CALL flagerror(localerror,err,error,*999)
10895  END IF
10896 
10897  CALL dgesvd('A','A',numberofelementparameters,numberofdimensions,mmatrix,numberofelementparameters,svd, &
10898  & u,numberofelementparameters,vt,numberofdimensions,work,lwork,info)
10899  normmmatrix=svd(1)
10900  IF(info /= 0) THEN
10901  localerror="Error calculating SVD on element "//trim(number_to_vstring(elementnumber,"*",err,error))//"."
10902  CALL flagerror(localerror,err,error,*999)
10903  END IF
10904  DEALLOCATE(work)
10905 
10906  velocitynorm = l2norm(avgvelocity)
10907  cellreynoldsnumber = 0.0_dp
10908  cellcourantnumber = 0.0_dp
10909  IF(velocitynorm > zero_tolerance) THEN
10910  IF(normkmatrix > zero_tolerance) THEN
10911  cellreynoldsnumber = velocitynorm**2.0_dp/(mu/rho)*normcmatrix/normkmatrix
10912  END IF
10913  IF(normmmatrix > zero_tolerance) THEN
10914  cellcourantnumber = timeincrement/2.0_dp*normcmatrix/normmmatrix
10915  END IF
10916  END IF
10917  CALL field_parameter_set_update_local_element(equationssetfield,field_v_variable_type,field_values_set_type, &
10918  & elementnumber,2,velocitynorm,err,error,*999)
10919  CALL field_parameter_set_update_local_element(equationssetfield,field_v_variable_type,field_values_set_type, &
10920  & elementnumber,3,cellcourantnumber,err,error,*999)
10921  CALL field_parameter_set_update_local_element(equationssetfield,field_v_variable_type,field_values_set_type, &
10922  & elementnumber,4,cellreynoldsnumber,err,error,*999)
10923 
10924  ELSE
10925  CALL flagerror("Equations set field field is not associated.",err,error,*999)
10926  END IF
10927  ELSE
10928  CALL flagerror("Equations equations set field is not associated.",err,error,*999)
10929  END IF
10930  ELSE
10931  CALL flagerror("Equations set equations is not associated.",err,error,*999)
10932  END IF
10933  CASE DEFAULT
10934  localerror="Equations set subtype "//trim(number_to_vstring(equationsset%specification(3),"*",err,error))// &
10935  & " is not a valid subtype to use SUPG weighting functions."
10936  CALL flagerror(localerror,err,error,*999)
10937  END SELECT
10938  ELSE
10939  CALL flagerror("Equations set is not associated.",err,error,*999)
10940  END IF
10941 
10942  exits("NavierStokes_CalculateElementMetrics")
10943  RETURN
10944 999 errorsexits("NavierStokes_CalculateElementMetrics",err,error)
10945  RETURN 1
10946 
10947  END SUBROUTINE navierstokes_calculateelementmetrics
10948 
10949  !
10950  !================================================================================================================================
10951  !
10952 
10956  SUBROUTINE navierstokes_finiteelementfaceintegrate(equationsSet,elementNumber,dependentVariable,err,error,*)
10957 
10958  !Argument variables
10959  TYPE(equations_set_type), POINTER :: equationsSet
10960  INTEGER(INTG), INTENT(IN) :: elementNumber
10961  TYPE(field_variable_type), POINTER :: dependentVariable
10962  INTEGER(INTG), INTENT(OUT) :: err
10963  TYPE(varying_string), INTENT(OUT) :: error
10964  !Local variables
10965  TYPE(field_type), POINTER :: geometricField
10966  TYPE(equations_set_equations_set_field_type), POINTER :: equationsEquationsSetField
10967  TYPE(field_type), POINTER :: equationsSetField
10968  TYPE(field_variable_type), POINTER :: fieldVariable,geometricVariable
10969  TYPE(decomposition_type), POINTER :: decomposition
10970  TYPE(decomposition_element_type), POINTER :: decompElement
10971  TYPE(basis_type), POINTER :: dependentBasis
10972  TYPE(equations_type), POINTER :: equations
10973  TYPE(equations_matrices_type), POINTER :: equationsMatrices
10974  TYPE(decomposition_face_type), POINTER :: face
10975  TYPE(basis_type), POINTER :: faceBasis
10976  TYPE(field_interpolated_point_type), POINTER :: dependentInterpolatedPoint
10977  TYPE(field_interpolation_parameters_type), POINTER :: dependentInterpolationParameters
10978  TYPE(quadrature_scheme_type), POINTER :: faceQuadratureScheme
10979  TYPE(field_interpolated_point_type), POINTER :: geometricInterpolatedPoint
10980  TYPE(field_interpolation_parameters_type), POINTER :: geometricInterpolationParameters
10981  TYPE(field_interpolated_point_metrics_type), POINTER :: pointMetrics
10982  TYPE(field_type), POINTER :: dependentField
10983  TYPE(equations_matrices_rhs_type), POINTER :: rhsVector
10984  TYPE(equations_matrices_nonlinear_type), POINTER :: nonlinearMatrices
10985  INTEGER(INTG) :: faceIdx, faceNumber
10986  INTEGER(INTG) :: componentIdx, gaussIdx
10987  INTEGER(INTG) :: elementBaseDofIdx, faceNodeIdx, elementNodeIdx
10988  INTEGER(INTG) :: faceNodeDerivativeIdx, meshComponentNumber, nodeDerivativeIdx,elementParameterIdx
10989  INTEGER(INTG) :: faceParameterIdx,elementDof,normalComponentIdx
10990  INTEGER(INTG) :: numberOfDimensions,boundaryType
10991  REAL(DP) :: pressure,density,jacobianGaussWeights,beta,normalFlow
10992  REAL(DP) :: velocity(3),normalProjection(3),unitNormal(3),stabilisationTerm(3),boundaryNormal(3)
10993  REAL(DP) :: boundaryValue,normalDifference,normalTolerance,boundaryPressure
10994  REAL(DP) :: dUDXi(3,3)
10995  TYPE(varying_string) :: LOCAL_ERROR
10996  LOGICAL :: integratedBoundary
10997 
10998  REAL(DP), POINTER :: geometricParameters(:)
10999 
11000  enters("NavierStokes_FiniteElementFaceIntegrate",err,error,*999)
11001 
11002  NULLIFY(decomposition)
11003  NULLIFY(decompelement)
11004  NULLIFY(dependentbasis)
11005  NULLIFY(geometricvariable)
11006  NULLIFY(geometricparameters)
11007  NULLIFY(equations)
11008  NULLIFY(equationssetfield)
11009  NULLIFY(equationsequationssetfield)
11010  NULLIFY(equationsmatrices)
11011  NULLIFY(face)
11012  NULLIFY(facebasis)
11013  NULLIFY(facequadraturescheme)
11014  NULLIFY(dependentinterpolatedpoint)
11015  NULLIFY(dependentinterpolationparameters)
11016  NULLIFY(geometricinterpolatedpoint)
11017  NULLIFY(geometricinterpolationparameters)
11018  NULLIFY(rhsvector)
11019  NULLIFY(nonlinearmatrices)
11020  NULLIFY(dependentfield)
11021  NULLIFY(geometricfield)
11022 
11023  ! Get pointers and perform sanity checks
11024  IF(ASSOCIATED(equationsset)) THEN
11025  dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
11026  IF(.NOT.ASSOCIATED(dependentfield)) THEN
11027  CALL flagerror("Dependent field is not associated.",err,error,*999)
11028  END IF
11029  equations=>equationsset%EQUATIONS
11030  IF(ASSOCIATED(equations)) THEN
11031  equationsmatrices=>equations%EQUATIONS_MATRICES
11032  IF(ASSOCIATED(equationsmatrices)) THEN
11033  rhsvector=>equationsmatrices%RHS_VECTOR
11034  nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
11035  IF(.NOT. ASSOCIATED(nonlinearmatrices)) THEN
11036  CALL flagerror("Nonlinear Matrices not associated.",err,error,*999)
11037  END IF
11038  END IF
11039  ELSE
11040  CALL flagerror("Equations set equations is not associated.",err,error,*999)
11041  END IF
11042  ELSE
11043  CALL flagerror("Equations set is not associated.",err,error,*999)
11044  END IF
11045 
11046  SELECT CASE(equationsset%specification(3))
11047  CASE(equations_set_static_rbs_navier_stokes_subtype, &
11048  & equations_set_transient_rbs_navier_stokes_subtype, &
11049  & equations_set_multiscale3d_navier_stokes_subtype, &
11050  & equations_set_constitutive_mu_navier_stokes_subtype)
11051 
11052  !Check for the equations set field
11053  equationsequationssetfield=>equationsset%EQUATIONS_SET_FIELD
11054  IF(ASSOCIATED(equationsequationssetfield)) THEN
11055  equationssetfield=>equationsequationssetfield%EQUATIONS_SET_FIELD_FIELD
11056  IF(.NOT.ASSOCIATED(equationssetfield)) THEN
11057  CALL flagerror("Equations set field (EQUATIONS_SET_FIELD_FIELD) is not associated.",err,error,*999)
11058  END IF
11059  ELSE
11060  CALL flagerror("Equations set field (EQUATIONS_EQUATIONS_SET_FIELD_FIELD) is not associated.",err,error,*999)
11061  END IF
11062 
11063  ! Check whether this element contains an integrated boundary type
11064  CALL field_parametersetgetlocalelement(equationssetfield,field_v_variable_type,field_values_set_type, &
11065  & elementnumber,9,boundaryvalue,err,error,*999)
11066  boundarytype=nint(boundaryvalue)
11067  integratedboundary = .false.
11068  IF(boundarytype == boundary_condition_pressure) integratedboundary = .true.
11069 
11070  !Get the mesh decomposition and basis
11071  decomposition=>dependentvariable%FIELD%DECOMPOSITION
11072  !Check that face geometric parameters have been calculated
11073  IF(decomposition%CALCULATE_FACES .AND. integratedboundary) THEN
11074  meshcomponentnumber=dependentvariable%COMPONENTS(1)%MESH_COMPONENT_NUMBER
11075  dependentbasis=>decomposition%DOMAIN(meshcomponentnumber)%PTR%TOPOLOGY%ELEMENTS% &
11076  & elements(elementnumber)%BASIS
11077 
11078  decompelement=>decomposition%TOPOLOGY%ELEMENTS%ELEMENTS(elementnumber)
11079  !Get the dependent interpolation parameters
11080  dependentinterpolationparameters=>equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS( &
11081  & dependentvariable%VARIABLE_TYPE)%PTR
11082  dependentinterpolatedpoint=>equations%INTERPOLATION%DEPENDENT_INTERP_POINT( &
11083  & dependentvariable%VARIABLE_TYPE)%PTR
11084  !Get the geometric interpolation parameters
11085  geometricinterpolationparameters=>equations%INTERPOLATION%GEOMETRIC_INTERP_PARAMETERS( &
11086  & field_u_variable_type)%PTR
11087  geometricinterpolatedpoint=>equations%INTERPOLATION%GEOMETRIC_INTERP_POINT(field_u_variable_type)%PTR
11088  geometricfield=>equationsset%GEOMETRY%GEOMETRIC_FIELD
11089  CALL field_number_of_components_get(geometricfield,field_u_variable_type,numberofdimensions,err,error,*999)
11090  !Get access to geometric coordinates
11091  CALL field_variable_get(geometricfield,field_u_variable_type,geometricvariable,err,error,*999)
11092  meshcomponentnumber=geometricvariable%COMPONENTS(1)%MESH_COMPONENT_NUMBER
11093  !Get the geometric distributed vector
11094  CALL field_parameter_set_data_get(geometricfield,field_u_variable_type,field_values_set_type, &
11095  & geometricparameters,err,error,*999)
11096  fieldvariable=>equations%EQUATIONS_MAPPING%NONLINEAR_MAPPING%RESIDUAL_VARIABLES(1)%PTR
11097  !Get the density
11098  CALL field_parameter_set_get_constant(equationsset%MATERIALS%MATERIALS_FIELD,field_u_variable_type,field_values_set_type, &
11099  & 2,density,err,error,*999)
11100 
11101  ! Get the boundary element parameters
11102  CALL field_parameter_set_get_constant(equationssetfield,field_u1_variable_type,field_values_set_type, &
11103  & 1,beta,err,error,*999)
11104  boundarynormal = 0.0_dp
11105  CALL field_parametersetgetlocalelement(equationssetfield,field_v_variable_type,field_values_set_type, &
11106  & elementnumber,5,boundarynormal(1),err,error,*999)
11107  CALL field_parametersetgetlocalelement(equationssetfield,field_v_variable_type,field_values_set_type, &
11108  & elementnumber,6,boundarynormal(2),err,error,*999)
11109  CALL field_parametersetgetlocalelement(equationssetfield,field_v_variable_type,field_values_set_type, &
11110  & elementnumber,7,boundarynormal(3),err,error,*999)
11111 
11112  DO faceidx=1,dependentbasis%NUMBER_OF_LOCAL_FACES
11113  !Get the face normal and quadrature information
11114  IF(ALLOCATED(decompelement%ELEMENT_FACES)) THEN
11115  facenumber=decompelement%ELEMENT_FACES(faceidx)
11116  ELSE
11117  CALL flagerror("Decomposition element faces is not allocated.",err,error,*999)
11118  END IF
11119  face=>decomposition%TOPOLOGY%FACES%FACES(facenumber)
11120  !This speeds things up but is also important, as non-boundary faces have an XI_DIRECTION that might
11121  !correspond to the other element.
11122  IF(.NOT.(face%BOUNDARY_FACE)) cycle
11123 
11124  SELECT CASE(dependentbasis%TYPE)
11125  CASE(basis_lagrange_hermite_tp_type)
11126  normalcomponentidx=abs(face%XI_DIRECTION)
11127  CASE DEFAULT
11128  local_error="Face integration for basis type "//trim(number_to_vstring(dependentbasis%TYPE,"*",err,error))// &
11129  & " is not yet implemented for Navier-Stokes."
11130  CALL flagerror(local_error,err,error,*999)
11131  END SELECT
11132 
11133  facebasis=>decomposition%DOMAIN(meshcomponentnumber)%PTR%TOPOLOGY%FACES%FACES(facenumber)%BASIS
11134  facequadraturescheme=>facebasis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
11135  DO gaussidx=1,facequadraturescheme%NUMBER_OF_GAUSS
11136  !Get interpolated geometry
11137  CALL field_interpolate_local_face_gauss(first_part_deriv,basis_default_quadrature_scheme,faceidx,gaussidx, &
11138  & geometricinterpolatedpoint,err,error,*999)
11139  !Calculate point metrics
11140  pointmetrics=>equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR
11141  CALL field_interpolated_point_metrics_calculate(coordinate_jacobian_volume_type,pointmetrics,err,error,*999)
11142 
11143  ! TODO: this sort of thing should be moved to a more general Basis_FaceNormalGet (or similar) routine
11144  !Get face normal projection
11145  DO componentidx=1,dependentvariable%NUMBER_OF_COMPONENTS-1
11146  normalprojection(componentidx)=dot_product(pointmetrics%GU(normalcomponentidx,:),pointmetrics%DX_DXI(componentidx,:))
11147  IF(face%XI_DIRECTION<0) THEN
11148  normalprojection(componentidx)=-normalprojection(componentidx)
11149  END IF
11150  END DO
11151  IF(l2norm(normalprojection)>zero_tolerance) THEN
11152  unitnormal=normalprojection/l2norm(normalprojection)
11153  ELSE
11154  unitnormal=0.0_dp
11155  END IF
11156 
11157  ! Stabilisation term to correct for possible retrograde flow divergence.
11158  ! See: Moghadam et al 2011 A comparison of outlet boundary treatments for prevention of backflow divergence..." and
11159  ! Ismail et al 2014 "A stable approach for coupling multidimensional cardiovascular and pulmonary networks..."
11160  ! Note: beta is a relative scaling factor 0 <= beta <= 1; default 1.0
11161  stabilisationterm = 0.0_dp
11162  normaldifference=l2norm(boundarynormal-unitnormal)
11163  normaltolerance=0.1_dp
11164  IF(normaldifference < normaltolerance) THEN
11165  normalflow = dot_product(velocity,normalprojection)
11166  !normalFlow = DOT_PRODUCT(velocity,boundaryNormal)
11167  IF(normalflow < -zero_tolerance) THEN
11168  DO componentidx=1,dependentvariable%NUMBER_OF_COMPONENTS-1
11169  stabilisationterm(componentidx) = 0.5_dp*beta*density*velocity(componentidx)*(normalflow - abs(normalflow))
11170  END DO
11171  ELSE
11172  stabilisationterm = 0.0_dp
11173  END IF
11174  ELSE
11175  ! Not the correct boundary face - go to next face
11176  EXIT
11177  END IF
11178 
11179  ! Interpolate applied boundary pressure value
11180  boundarypressure=0.0_dp
11181  !Get the pressure value interpolation parameters
11182  CALL field_interpolation_parameters_element_get(field_pressure_values_set_type,elementnumber,equations% &
11183  & interpolation%DEPENDENT_INTERP_PARAMETERS(field_u_variable_type)%PTR,err,error,*999)
11184  CALL field_interpolate_local_face_gauss(no_part_deriv,basis_default_quadrature_scheme,faceidx,gaussidx, &
11185  & dependentinterpolatedpoint,err,error,*999)
11186  boundarypressure=equations%INTERPOLATION%DEPENDENT_INTERP_POINT(field_u_variable_type)%PTR%VALUES(4,no_part_deriv)
11187 
11188  ! Interpolate current solution velocity/pressure field values
11189  pressure=0.0_dp
11190  velocity=0.0_dp
11191  dudxi=0.0_dp
11192  CALL field_interpolation_parameters_element_get(field_values_set_type,elementnumber,equations%INTERPOLATION% &
11193  & dependent_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
11194  !Get interpolated velocity and pressure
11195  CALL field_interpolate_local_face_gauss(first_part_deriv,basis_default_quadrature_scheme,faceidx,gaussidx, &
11196  & dependentinterpolatedpoint,err,error,*999)
11197  velocity(1)=dependentinterpolatedpoint%values(1,no_part_deriv)
11198  velocity(2)=dependentinterpolatedpoint%values(2,no_part_deriv)
11199  velocity(3)=dependentinterpolatedpoint%values(3,no_part_deriv)
11200  dudxi(1:3,1)=dependentinterpolatedpoint%VALUES(1:3,part_deriv_s1)
11201  dudxi(1:3,2)=dependentinterpolatedpoint%VALUES(1:3,part_deriv_s2)
11202  dudxi(1:3,3)=dependentinterpolatedpoint%VALUES(1:3,part_deriv_s3)
11203  pressure=dependentinterpolatedpoint%values(4,no_part_deriv)
11204 
11205  ! Keep this here for now: not using for Pressure BC but may want for traction BC
11206  ! ! Calculate viscous term
11207  ! dXiDX=0.0_DP
11208  ! dXiDX=pointMetrics%DXI_DX(:,:)
11209  ! CALL MATRIX_PRODUCT(dUDXi,dXiDX,gradU,err,error,*999)
11210  ! DO i=1,numberOfDimensions
11211  ! SUM1 = 0.0_DP
11212  ! SUM2 = 0.0_DP
11213  ! DO j=1,numberOfDimensions
11214  ! SUM1 = normalProjection(j)*gradU(i,j)
11215  ! SUM2 = normalProjection(j)*gradU(j,i)
11216  ! END DO
11217  ! normalViscousTerm(i) = viscosity*(SUM1 + SUM2)
11218  ! END DO
11219 
11220  !Jacobian and Gauss weighting term
11221  jacobiangaussweights=pointmetrics%JACOBIAN*facequadraturescheme%GAUSS_WEIGHTS(gaussidx)
11222 
11223  !Loop over field components
11224  DO componentidx=1,dependentvariable%NUMBER_OF_COMPONENTS-1
11225  !Work out the first index of the rhs vector for this element - (i.e. the number of previous)
11226  elementbasedofidx=dependentbasis%NUMBER_OF_ELEMENT_PARAMETERS*(componentidx-1)
11227  DO facenodeidx=1,facebasis%NUMBER_OF_NODES
11228  elementnodeidx=dependentbasis%NODE_NUMBERS_IN_LOCAL_FACE(facenodeidx,faceidx)
11229  DO facenodederivativeidx=1,facebasis%NUMBER_OF_DERIVATIVES(facenodeidx)
11230  nodederivativeidx=dependentbasis%DERIVATIVE_NUMBERS_IN_LOCAL_FACE(facenodederivativeidx,facenodeidx,faceidx)
11231  elementparameteridx=dependentbasis%ELEMENT_PARAMETER_INDEX(nodederivativeidx,elementnodeidx)
11232  faceparameteridx=facebasis%ELEMENT_PARAMETER_INDEX(facenodederivativeidx,facenodeidx)
11233  elementdof=elementbasedofidx+elementparameteridx
11234 
11235  rhsvector%ELEMENT_VECTOR%VECTOR(elementdof) = rhsvector%ELEMENT_VECTOR%VECTOR(elementdof) - &
11236  & (boundarypressure*normalprojection(componentidx) - stabilisationterm(componentidx))* &
11237  & facequadraturescheme%GAUSS_BASIS_FNS(faceparameteridx,no_part_deriv,gaussidx)* &
11238  & jacobiangaussweights
11239 
11240  END DO !nodeDerivativeIdx
11241  END DO !faceNodeIdx
11242  END DO !componentIdx
11243  END DO !gaussIdx
11244  END DO !faceIdx
11245 
11246  !Restore the distributed geometric data used for the normal calculation
11247  CALL field_parameter_set_data_restore(geometricfield,field_u_variable_type,field_values_set_type, &
11248  & geometricparameters,err,error,*999)
11249  END IF !decomposition%calculate_faces
11250 
11251  CASE DEFAULT
11252  ! Do nothing for other equation set subtypes
11253  END SELECT
11254 
11255  exits("NavierStokes_FiniteElementFaceIntegrate")
11256  RETURN
11257 999 errorsexits("NavierStokes_FiniteElementFaceIntegrate",err,error)
11258  RETURN 1
11259  END SUBROUTINE
11260 
11261  !
11262  !================================================================================================================================
11263  !
11264 
11266  SUBROUTINE navierstokes_calculateboundaryflux(solver,err,error,*)
11267 
11268  !Argument variables
11269 
11270  TYPE(solver_type), POINTER :: solver
11271  INTEGER(INTG), INTENT(OUT) :: err
11272  TYPE(varying_string), INTENT(OUT) :: error
11273  !Local Variables
11274  TYPE(control_loop_type), POINTER :: controlLoop
11275  TYPE(solver_equations_type), POINTER :: solverEquations
11276  TYPE(solver_mapping_type), POINTER :: solverMapping
11277  TYPE(solvers_type), POINTER :: solvers
11278  TYPE(equations_set_type), POINTER :: equationsSet
11279  TYPE(equations_type), POINTER :: equations
11280  TYPE(domain_mapping_type), POINTER :: elementsMapping
11281  TYPE(varying_string) :: LOCAL_ERROR
11282  TYPE(field_type), POINTER :: geometricField
11283  TYPE(field_variable_type), POINTER :: dependentVariable
11284  TYPE(field_variable_type), POINTER :: fieldVariable,geometricVariable
11285  TYPE(decomposition_type), POINTER :: decomposition
11286  TYPE(decomposition_type), POINTER :: geometricDecomposition
11287  TYPE(decomposition_element_type), POINTER :: decompElement
11288  TYPE(basis_type), POINTER :: dependentBasis
11289  TYPE(basis_type), POINTER :: dependentBasis2
11290  TYPE(basis_type), POINTER :: geometricFaceBasis
11291  TYPE(equations_matrices_type), POINTER :: equationsMatrices
11292  TYPE(decomposition_face_type), POINTER :: face
11293  TYPE(basis_type), POINTER :: faceBasis
11294  TYPE(field_interpolated_point_type), POINTER :: dependentInterpolatedPoint
11295  TYPE(field_interpolation_parameters_type), POINTER :: dependentInterpolationParameters
11296  TYPE(quadrature_scheme_type), POINTER :: faceQuadratureScheme
11297  TYPE(field_interpolated_point_type), POINTER :: geometricInterpolatedPoint
11298  TYPE(field_interpolation_parameters_type), POINTER :: geometricInterpolationParameters
11299  TYPE(field_interpolated_point_metrics_type), POINTER :: pointMetrics
11300  TYPE(equations_set_equations_set_field_type), POINTER :: equationsEquationsSetField
11301  TYPE(field_type), POINTER :: equationsSetField
11302  TYPE(field_type), POINTER :: dependentField
11303  TYPE(equations_matrices_rhs_type), POINTER :: rhsVector
11304  INTEGER(INTG) :: faceIdx, faceNumber,elementIdx,nodeNumber,versionNumber
11305  INTEGER(INTG) :: componentIdx,gaussIdx
11306  INTEGER(INTG) :: elementBaseDofIdx, faceNodeIdx, elementNodeIdx
11307  INTEGER(INTG) :: faceNodeDerivativeIdx, meshComponentNumber, nodeDerivativeIdx, parameterIdx
11308  INTEGER(INTG) :: faceParameterIdx, elementDofIdx,normalComponentIdx
11309  INTEGER(INTG) :: boundaryID
11310  INTEGER(INTG) :: MPI_IERROR,numberOfComputationalNodes
11311  REAL(DP) :: gaussWeight, normalProjection,elementNormal(3)
11312  REAL(DP) :: normalDifference,normalTolerance,faceFlux
11313  REAL(DP) :: courant,maxCourant,toleranceCourant
11314  REAL(DP) :: velocityGauss(3),faceNormal(3),unitNormal(3),boundaryValue,faceArea,faceVelocity
11315  REAL(DP) :: localBoundaryFlux(10),localBoundaryArea(10),globalBoundaryFlux(10),globalBoundaryArea(10)
11316  LOGICAL :: correctFace
11317 
11318  REAL(DP), POINTER :: geometricParameters(:)
11319 
11320  enters("NavierStokes_CalculateBoundaryFlux",err,error,*999)
11321 
11322  NULLIFY(decomposition)
11323  NULLIFY(geometricdecomposition)
11324  NULLIFY(geometricparameters)
11325  NULLIFY(decompelement)
11326  NULLIFY(dependentbasis)
11327  NULLIFY(dependentbasis2)
11328  NULLIFY(geometricfacebasis)
11329  NULLIFY(geometricvariable)
11330  NULLIFY(equations)
11331  NULLIFY(equationsmatrices)
11332  NULLIFY(face)
11333  NULLIFY(facebasis)
11334  NULLIFY(facequadraturescheme)
11335  NULLIFY(fieldvariable)
11336  NULLIFY(dependentinterpolatedpoint)
11337  NULLIFY(dependentinterpolationparameters)
11338  NULLIFY(geometricinterpolatedpoint)
11339  NULLIFY(geometricinterpolationparameters)
11340  NULLIFY(rhsvector)
11341  NULLIFY(dependentfield)
11342  NULLIFY(geometricfield)
11343  NULLIFY(equationsequationssetfield)
11344  NULLIFY(equationssetfield)
11345 
11346  ! Some preliminary sanity checks
11347  IF(ASSOCIATED(solver)) THEN
11348  solvers=>solver%SOLVERS
11349  IF(ASSOCIATED(solvers)) THEN
11350  controlloop=>solvers%CONTROL_LOOP
11351  IF(ASSOCIATED(controlloop%PROBLEM)) THEN
11352  SELECT CASE(controlloop%PROBLEM%specification(3))
11353  CASE(problem_multiscale_navier_stokes_subtype, &
11354  & problem_transient_rbs_navier_stokes_subtype)
11355  solverequations=>solver%SOLVER_EQUATIONS
11356  IF(ASSOCIATED(solverequations)) THEN
11357  solvermapping=>solverequations%SOLVER_MAPPING
11358  IF(ASSOCIATED(solvermapping)) THEN
11359  equationsset=>solvermapping%EQUATIONS_SETS(1)%PTR
11360  IF(ASSOCIATED(equationsset)) THEN
11361  equations=>equationsset%EQUATIONS
11362  IF(ASSOCIATED(equations)) THEN
11363  dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
11364  IF(.NOT.ASSOCIATED(dependentfield)) THEN
11365  CALL flagerror("Dependent field is not associated.",err,error,*999)
11366  END IF
11367  ELSE
11368  CALL flagerror("Equations set equations is not associated.",err,error,*999)
11369  END IF
11370  ELSE
11371  CALL flagerror("Equations set is not associated.",err,error,*999)
11372  END IF
11373  equationsequationssetfield=>equationsset%EQUATIONS_SET_FIELD
11374  IF(ASSOCIATED(equationsequationssetfield)) THEN
11375  equationssetfield=>equationsequationssetfield%EQUATIONS_SET_FIELD_FIELD
11376  IF(.NOT.ASSOCIATED(equationssetfield)) THEN
11377  CALL flagerror("Equations set field (EQUATIONS_SET_FIELD_FIELD) is not associated.",err,error,*999)
11378  END IF
11379  ELSE
11380  CALL flagerror("Equations set field (EQUATIONS_EQUATIONS_SET_FIELD_FIELD) is not associated.",err,error,*999)
11381  END IF
11382  ELSE
11383  CALL flagerror("Solver mapping is not associated.",err,error,*999)
11384  END IF
11385  ELSE
11386  CALL flagerror("Solver equations is not associated.",err,error,*999)
11387  END IF
11388  CASE DEFAULT
11389  local_error="Problem subtype "//trim(number_to_vstring(controlloop%PROBLEM%specification(3),"*",err,error))// &
11390  & " is not valid for boundary flux calculation."
11391  CALL flagerror(local_error,err,error,*999)
11392  END SELECT
11393  ELSE
11394  CALL flagerror("Problem is not associated.",err,error,*999)
11395  END IF
11396  ELSE
11397  CALL flagerror("Solvers is not associated.",err,error,*999)
11398  END IF
11399  ELSE
11400  CALL flagerror("Solver is not associated.",err,error,*999)
11401  END IF
11402 
11403  localboundaryarea=0.0_dp
11404  localboundaryflux=0.0_dp
11405  faceflux=0.0_dp
11406  SELECT CASE(equationsset%specification(3))
11407  CASE(equations_set_multiscale3d_navier_stokes_subtype, &
11408  & equations_set_constitutive_mu_navier_stokes_subtype, &
11409  & equations_set_static_rbs_navier_stokes_subtype, &
11410  & equations_set_transient_rbs_navier_stokes_subtype)
11411 
11412  dependentvariable=>equations%EQUATIONS_MAPPING%NONLINEAR_MAPPING%RESIDUAL_VARIABLES(1)%PTR
11413  !Get the mesh decomposition and mapping
11414  decomposition=>dependentvariable%FIELD%DECOMPOSITION
11415  elementsmapping=>decomposition%DOMAIN(decomposition%MESH_COMPONENT_NUMBER)%PTR%MAPPINGS%ELEMENTS
11416  ! Get constant max Courant (CFL) number (default 1.0)
11417  CALL field_parameter_set_get_constant(equationssetfield,field_u1_variable_type,field_values_set_type, &
11418  & 2,tolerancecourant,err,error,*999)
11419 
11420  ! Loop over elements to locate boundary elements
11421  maxcourant = 0.0_dp
11422  DO elementidx=1,elementsmapping%TOTAL_NUMBER_OF_LOCAL
11423  meshcomponentnumber=dependentvariable%COMPONENTS(1)%MESH_COMPONENT_NUMBER
11424  dependentbasis=>decomposition%DOMAIN(meshcomponentnumber)%PTR%TOPOLOGY%ELEMENTS% &
11425  & elements(elementidx)%BASIS
11426  decompelement=>decomposition%TOPOLOGY%ELEMENTS%ELEMENTS(elementidx)
11427  ! Calculate element metrics (courant #, cell Reynolds number)
11428  CALL navierstokes_calculateelementmetrics(equationsset,elementidx,err,error,*999)
11429 
11430  ! C F L c o n d i t i o n c h e c k
11431  ! ------------------------------------
11432  ! Get element metrics
11433  CALL field_parametersetgetlocalelement(equationssetfield,field_v_variable_type,field_values_set_type, &
11434  & elementidx,3,courant,err,error,*999)
11435  IF(courant < -zero_tolerance) THEN
11436  CALL flag_warning("Negative Courant (CFL) number.",err,error,*999)
11437  END IF
11438  IF(courant > maxcourant) maxcourant = courant
11439  ! Check if element CFL number below specified tolerance
11440  IF(courant > tolerancecourant) THEN
11441  local_error="Element "//trim(number_to_vstring(decompelement%user_number, &
11442  & "*",err,error))//" has violated the CFL condition "//trim(number_to_vstring(courant, &
11443  & "*",err,error))//" <= "//trim(number_to_vstring(tolerancecourant,"*",err,error))// &
11444  & ". Decrease timestep or increase CFL tolerance for the 3D Navier-Stokes problem."
11445  CALL flagerror(local_error,err,error,*999)
11446  END IF
11447 
11448  ! B o u n d a r y n o r m a l a n d I D
11449  ! ----------------------------------------------
11450  CALL field_parametersetgetlocalelement(equationssetfield,field_v_variable_type,field_values_set_type, &
11451  & elementidx,5,elementnormal(1),err,error,*999)
11452  CALL field_parametersetgetlocalelement(equationssetfield,field_v_variable_type,field_values_set_type, &
11453  & elementidx,6,elementnormal(2),err,error,*999)
11454  CALL field_parametersetgetlocalelement(equationssetfield,field_v_variable_type,field_values_set_type, &
11455  & elementidx,7,elementnormal(3),err,error,*999)
11456  CALL field_parametersetgetlocalelement(equationssetfield,field_v_variable_type,field_values_set_type, &
11457  & elementidx,8,boundaryvalue,err,error,*999)
11458  !Check if is a non-wall boundary element
11459  boundaryid=nint(boundaryvalue)
11460  IF(boundaryid>1) THEN
11461  facearea=0.0_dp
11462  facevelocity=0.0_dp
11463  !Get the dependent interpolation parameters
11464  dependentinterpolationparameters=>equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS( &
11465  & dependentvariable%VARIABLE_TYPE)%PTR
11466  dependentinterpolatedpoint=>equations%INTERPOLATION%DEPENDENT_INTERP_POINT( &
11467  & dependentvariable%VARIABLE_TYPE)%PTR
11468  ! Loop over faces to determine the boundary face contribution
11469  DO faceidx=1,dependentbasis%NUMBER_OF_LOCAL_FACES
11470  !Get the face normal and quadrature information
11471  IF(ALLOCATED(decompelement%ELEMENT_FACES)) THEN
11472  facenumber=decompelement%ELEMENT_FACES(faceidx)
11473  ELSE
11474  CALL flagerror("Decomposition element faces is not allocated.",err,error,*999)
11475  END IF
11476  face=>decomposition%TOPOLOGY%FACES%FACES(facenumber)
11477  !This speeds things up but is also important, as non-boundary faces have an XI_DIRECTION that might
11478  !correspond to the other element.
11479  IF(.NOT.(face%BOUNDARY_FACE)) cycle
11480 
11481  SELECT CASE(dependentbasis%TYPE)
11482  CASE(basis_lagrange_hermite_tp_type)
11483  normalcomponentidx=abs(face%XI_DIRECTION)
11484  CASE(basis_simplex_type)
11485  CALL flag_warning("Boundary flux calculation not yet set up for simplex element types.",err,error,*999)
11486  CASE DEFAULT
11487  local_error="Face integration for basis type "//trim(number_to_vstring(dependentbasis%TYPE,"*",err,error))// &
11488  & " is not yet implemented for Navier-Stokes."
11489  CALL flagerror(local_error,err,error,*999)
11490  END SELECT
11491 
11492  CALL field_interpolation_parameters_face_get(field_values_set_type,facenumber, &
11493  & dependentinterpolationparameters,err,error,*999)
11494  facebasis=>decomposition%DOMAIN(meshcomponentnumber)%PTR%TOPOLOGY%FACES%FACES(facenumber)%BASIS
11495  facequadraturescheme=>facebasis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
11496 
11497  ! Loop over face gauss points
11498  DO gaussidx=1,facequadraturescheme%NUMBER_OF_GAUSS
11499  !Use the geometric field to find the face normal and Jacobian for the face integral
11500  geometricinterpolationparameters=>equations%INTERPOLATION%GEOMETRIC_INTERP_PARAMETERS( &
11501  & field_u_variable_type)%PTR
11502  CALL field_interpolation_parameters_element_get(field_values_set_type,elementidx, &
11503  & geometricinterpolationparameters,err,error,*999)
11504  geometricinterpolatedpoint=>equations%INTERPOLATION%GEOMETRIC_INTERP_POINT(field_u_variable_type)%PTR
11505  CALL field_interpolate_local_face_gauss(first_part_deriv,basis_default_quadrature_scheme,faceidx,gaussidx, &
11506  & geometricinterpolatedpoint,err,error,*999)
11507  pointmetrics=>equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR
11508  CALL field_interpolated_point_metrics_calculate(coordinate_jacobian_volume_type,pointmetrics,err,error,*999)
11509 
11510  gaussweight=facequadraturescheme%GAUSS_WEIGHTS(gaussidx)
11511  !Get interpolated velocity
11512  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,gaussidx, &
11513  & dependentinterpolatedpoint,err,error,*999)
11514  !Interpolated values at gauss point
11515  velocitygauss=dependentinterpolatedpoint%values(1:3,no_part_deriv)
11516 
11517  ! TODO: this sort of thing should be moved to a more general Basis_FaceNormalGet (or similar) routine
11518  elementbasedofidx=0
11519  SELECT CASE(dependentbasis%TYPE)
11520  CASE(basis_lagrange_hermite_tp_type)
11521  correctface=.true.
11522  ! Make sure this is the boundary face that corresponds with boundaryID (could be a wall rather than inlet/outlet)
11523  DO componentidx=1,dependentvariable%NUMBER_OF_COMPONENTS-1
11524  normalprojection=dot_product(pointmetrics%GU(normalcomponentidx,:),pointmetrics%DX_DXI(componentidx,:))
11525  IF(face%XI_DIRECTION<0) THEN
11526  normalprojection=-normalprojection
11527  END IF
11528  facenormal(componentidx)=normalprojection
11529  END DO !componentIdx
11530  unitnormal=facenormal/l2norm(facenormal)
11531  normaldifference=l2norm(elementnormal-unitnormal)
11532  normaltolerance=0.1_dp
11533  IF(normaldifference>normaltolerance) EXIT
11534  CASE(basis_simplex_type)
11535  facenormal=unitnormal
11536  CASE DEFAULT
11537  local_error="Face integration for basis type "//trim(number_to_vstring(dependentbasis%TYPE,"*",err,error))// &
11538  & " is not yet implemented for Navier-Stokes."
11539  CALL flagerror(local_error,err,error,*999)
11540  END SELECT
11541 
11542  ! Integrate face area and velocity
11543  DO componentidx=1,dependentvariable%NUMBER_OF_COMPONENTS-1
11544  normalprojection=facenormal(componentidx)
11545  IF(abs(normalprojection)<zero_tolerance) cycle
11546  !Work out the first index of the rhs vector for this element - 1
11547  elementbasedofidx=dependentbasis%NUMBER_OF_ELEMENT_PARAMETERS*(componentidx-1)
11548  DO facenodeidx=1,facebasis%NUMBER_OF_NODES
11549  elementnodeidx=dependentbasis%NODE_NUMBERS_IN_LOCAL_FACE(facenodeidx,faceidx)
11550  DO facenodederivativeidx=1,facebasis%NUMBER_OF_DERIVATIVES(facenodeidx)
11551  ! Integrate
11552  nodederivativeidx=1
11553  parameteridx=dependentbasis%ELEMENT_PARAMETER_INDEX(nodederivativeidx,elementnodeidx)
11554  faceparameteridx=facebasis%ELEMENT_PARAMETER_INDEX(facenodederivativeidx,facenodeidx)
11555  elementdofidx=elementbasedofidx+parameteridx
11556  facearea=facearea + normalprojection*gaussweight*pointmetrics%JACOBIAN* &
11557  & facequadraturescheme%GAUSS_BASIS_FNS(faceparameteridx,no_part_deriv,gaussidx)
11558  facevelocity=facevelocity+velocitygauss(componentidx)*normalprojection*gaussweight* &
11559  & pointmetrics%JACOBIAN*facequadraturescheme%GAUSS_BASIS_FNS(faceparameteridx,no_part_deriv,gaussidx)
11560  END DO !nodeDerivativeIdx
11561  END DO !faceNodeIdx
11562  END DO !componentIdx
11563  END DO !gaussIdx
11564  END DO !faceIdx
11565  localboundaryflux(boundaryid) = localboundaryflux(boundaryid) + facevelocity
11566  localboundaryarea(boundaryid) = localboundaryarea(boundaryid) + facearea
11567  END IF !boundaryIdentifier
11568  END DO !elementIdx
11569 
11570  ! Need to add boundary flux for any boundaries split accross computational nodes
11571  globalboundaryflux = 0.0_dp
11572  globalboundaryarea = 0.0_dp
11573  numberofcomputationalnodes=computational_environment%NUMBER_COMPUTATIONAL_NODES
11574  IF(numberofcomputationalnodes>1) THEN !use mpi
11575  CALL mpi_allreduce(localboundaryflux,globalboundaryflux,10,mpi_double_precision,mpi_sum, &
11576  & computational_environment%MPI_COMM,mpi_ierror)
11577  CALL mpi_error_check("MPI_ALLREDUCE",mpi_ierror,err,error,*999)
11578  CALL mpi_allreduce(localboundaryarea,globalboundaryarea,10,mpi_double_precision,mpi_sum, &
11579  & computational_environment%MPI_COMM,mpi_ierror)
11580  CALL mpi_error_check("MPI_ALLREDUCE",mpi_ierror,err,error,*999)
11581  ELSE
11582  globalboundaryflux = localboundaryflux
11583  globalboundaryarea = localboundaryarea
11584  END IF
11585 
11586  ! Loop over elements again to allocate flux terms to boundary nodes
11587  DO elementidx=1,elementsmapping%TOTAL_NUMBER_OF_LOCAL!elementsMapping%INTERNAL_START,elementsMapping%INTERNAL_FINISH
11588  CALL field_parametersetgetlocalelement(equationssetfield,field_v_variable_type,field_values_set_type, &
11589  & elementidx,5,elementnormal(1),err,error,*999)
11590  CALL field_parametersetgetlocalelement(equationssetfield,field_v_variable_type,field_values_set_type, &
11591  & elementidx,6,elementnormal(2),err,error,*999)
11592  CALL field_parametersetgetlocalelement(equationssetfield,field_v_variable_type,field_values_set_type, &
11593  & elementidx,7,elementnormal(3),err,error,*999)
11594  CALL field_parametersetgetlocalelement(equationssetfield,field_v_variable_type,field_values_set_type, &
11595  & elementidx,8,boundaryvalue,err,error,*999)
11596  boundaryid=nint(boundaryvalue)
11597  IF(boundaryid>1) THEN
11598  meshcomponentnumber=2
11599  decompelement=>decomposition%TOPOLOGY%ELEMENTS%ELEMENTS(elementidx)
11600  dependentbasis2=>decomposition%DOMAIN(meshcomponentnumber)%PTR%TOPOLOGY%ELEMENTS% &
11601  & elements(elementidx)%BASIS
11602  DO faceidx=1,dependentbasis2%NUMBER_OF_LOCAL_FACES
11603  !Get the face normal and quadrature information
11604  IF(ALLOCATED(decompelement%ELEMENT_FACES)) THEN
11605  facenumber=decompelement%ELEMENT_FACES(faceidx)
11606  ELSE
11607  CALL flagerror("Decomposition element faces is not allocated.",err,error,*999)
11608  END IF
11609  face=>decomposition%TOPOLOGY%FACES%FACES(facenumber)
11610  IF(.NOT.(face%BOUNDARY_FACE)) cycle
11611  facebasis=>decomposition%DOMAIN(meshcomponentnumber)%PTR%TOPOLOGY%FACES%FACES(facenumber)%BASIS
11612  facequadraturescheme=>facebasis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
11613 
11614  SELECT CASE(dependentbasis2%TYPE)
11615  CASE(basis_lagrange_hermite_tp_type)
11616  normalcomponentidx=abs(face%XI_DIRECTION)
11617  pointmetrics=>equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR
11618  CALL field_interpolated_point_metrics_calculate(coordinate_jacobian_volume_type,pointmetrics,err,error,*999)
11619  DO componentidx=1,dependentvariable%NUMBER_OF_COMPONENTS-1
11620  normalprojection=dot_product(pointmetrics%GU(normalcomponentidx,:),pointmetrics%DX_DXI(componentidx,:))
11621  IF(face%XI_DIRECTION<0) THEN
11622  normalprojection=-normalprojection
11623  END IF
11624  facenormal(componentidx)=normalprojection
11625  END DO !componentIdx
11626  unitnormal=facenormal/l2norm(facenormal)
11627  CASE(basis_simplex_type)
11628  !still have faceNormal/unitNormal
11629  CASE DEFAULT
11630  local_error="Face integration for basis type "//trim(number_to_vstring(dependentbasis2%TYPE,"*",err,error))// &
11631  & " is not yet implemented for Navier-Stokes."
11632  CALL flagerror(local_error,err,error,*999)
11633  END SELECT
11634  normaldifference=l2norm(elementnormal-unitnormal)
11635  normaltolerance=0.1_dp
11636  IF(normaldifference>normaltolerance) cycle
11637 
11638  ! Update local nodes with integrated boundary flow values
11639  DO facenodeidx=1,facebasis%NUMBER_OF_NODES
11640  elementnodeidx=dependentbasis2%NODE_NUMBERS_IN_LOCAL_FACE(facenodeidx,faceidx)
11641  DO facenodederivativeidx=1,facebasis%NUMBER_OF_DERIVATIVES(facenodeidx)
11642  nodenumber=decomposition%DOMAIN(meshcomponentnumber)%PTR% &
11643  & topology%ELEMENTS%ELEMENTS(elementidx)%ELEMENT_NODES(elementnodeidx)
11644  versionnumber=1
11645  CALL field_parameter_set_update_local_node(equationssetfield,field_u_variable_type,field_values_set_type, &
11646  & versionnumber,facenodederivativeidx,nodenumber,1,globalboundaryflux(boundaryid),err,error,*999)
11647  END DO !nodeDerivativeIdx
11648  END DO !faceNodeIdx
11649 
11650  END DO !faceIdx
11651  END IF !boundaryIdentifier
11652  END DO !elementIdx
11653 
11654  CASE DEFAULT
11655  local_error="Boundary flux calcluation for the third equations set specification of "// &
11656  & trim(number_to_vstring(equationsset%specification(3),"*",err,error))// &
11657  & " is not yet implemented for Navier-Stokes."
11658  CALL flagerror(local_error,err,error,*999)
11659  END SELECT
11660 
11661  exits("NavierStokes_CalculateBoundaryFlux")
11662  RETURN
11663 999 errorsexits("NavierStokes_CalculateBoundaryFlux",err,error)
11664  RETURN 1
11665  END SUBROUTINE
11666 
11667  !
11668  !================================================================================================================================
11669  !
11670 
11674  SUBROUTINE navierstokes_couple1d0d(controlLoop,solver,err,error,*)
11675 
11676  !Argument variables
11677  TYPE(control_loop_type), POINTER :: controlLoop
11678  TYPE(solver_type), POINTER :: solver
11679  INTEGER(INTG), INTENT(OUT) :: err
11680  TYPE(varying_string), INTENT(OUT) :: error
11681  !Local Variables
11682  TYPE(control_loop_while_type), POINTER :: iterativeLoop
11683  TYPE(equations_set_type), POINTER :: equationsSet
11684  TYPE(field_type), POINTER :: dependentField,materialsField,independentField
11685  TYPE(solver_equations_type), POINTER :: solverEquations
11686  TYPE(solver_mapping_type), POINTER :: solverMapping
11687  TYPE(solver_type), POINTER :: solver1D
11688  TYPE(field_variable_type), POINTER :: fieldVariable
11689  TYPE(domain_nodes_type), POINTER :: domainNodes
11690  TYPE(varying_string) :: localError
11691  INTEGER(INTG) :: nodeNumber,nodeIdx,derivativeIdx,versionIdx,componentIdx,numberOfLocalNodes1D
11692  INTEGER(INTG) :: solver1dNavierStokesNumber,solverNumber,MPI_IERROR,timestep,iteration
11693  INTEGER(INTG) :: boundaryNumber,numberOfBoundaries,numberOfComputationalNodes
11694  REAL(DP) :: A0_PARAM,E_PARAM,H_PARAM,beta,pCellML,normalWave(2)
11695  REAL(DP) :: qPrevious,pPrevious,aPrevious,q1d,a1d,qError,aError,couplingTolerance
11696  LOGICAL :: boundaryNode,boundaryConverged(30),localConverged,MPI_LOGICAL
11697  LOGICAL, ALLOCATABLE :: globalConverged(:)
11698 
11699  enters("NavierStokes_Couple1D0D",err,error,*999)
11700 
11701  !Get solvers based on the problem type
11702  SELECT CASE(controlloop%PROBLEM%specification(3))
11703  CASE(problem_coupled1d0d_navier_stokes_subtype, &
11704  & problem_coupled1d0d_adv_navier_stokes_subtype, &
11705  & problem_stree1d0d_navier_stokes_subtype, &
11706  & problem_stree1d0d_adv_navier_stokes_subtype)
11707  solvernumber = solver%GLOBAL_NUMBER
11708  ! In the Navier-Stokes/Characteristic subloop, the Navier-Stokes solver should be the second solver
11709  solver1dnavierstokesnumber=2
11710  versionidx=1
11711  derivativeidx=1
11712  IF(solvernumber == solver1dnavierstokesnumber) THEN
11713  solver1d=>controlloop%SUB_LOOPS(2)%PTR%SOLVERS%SOLVERS(solver1dnavierstokesnumber)%PTR
11714  iterativeloop=>controlloop%WHILE_LOOP
11715  iteration = iterativeloop%ITERATION_NUMBER
11716  timestep = controlloop%PARENT_LOOP%TIME_LOOP%ITERATION_NUMBER
11717  ELSE
11718  localerror="The solver number of "//trim(number_to_vstring(solvernumber,"*",err,error))// &
11719  & " does not correspond with the Navier-Stokes solver number for 1D-0D fluid coupling."
11720  CALL flagerror(localerror,err,error,*999)
11721  END IF
11722  CASE DEFAULT
11723  localerror="Problem subtype "//trim(number_to_vstring(controlloop%PROBLEM%specification(3),"*",err,error))// &
11724  & " is not valid for 1D-0D Navier-Stokes fluid coupling."
11725  CALL flagerror(localerror,err,error,*999)
11726  END SELECT
11727 
11728  couplingtolerance = iterativeloop%ABSOLUTE_TOLERANCE
11729 
11730  IF(ASSOCIATED(controlloop)) THEN
11731  IF(ASSOCIATED(solver1d)) THEN
11732  IF(ASSOCIATED(controlloop%PROBLEM)) THEN
11733  solverequations=>solver1d%SOLVER_EQUATIONS
11734  IF(ASSOCIATED(solverequations)) THEN
11735  solvermapping=>solverequations%SOLVER_MAPPING
11736  IF(ASSOCIATED(solvermapping)) THEN
11737  equationsset=>solvermapping%EQUATIONS_SETS(1)%PTR
11738  IF(ASSOCIATED(equationsset)) THEN
11739  materialsfield=>equationsset%MATERIALS%MATERIALS_FIELD
11740  dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
11741  independentfield=>equationsset%INDEPENDENT%INDEPENDENT_FIELD
11742  ELSE
11743  CALL flagerror("Equations set is not associated.",err,error,*999)
11744  END IF
11745  ELSE
11746  CALL flagerror("Solver mapping is not associated.",err,error,*999)
11747  END IF
11748  ELSE
11749  CALL flagerror("Solver equations is not associated.",err,error,*999)
11750  END IF
11751  ELSE
11752  CALL flagerror("Problem is not associated.",err,error,*999)
11753  END IF
11754  ELSE
11755  CALL flagerror("Solver is not associated.",err,error,*999)
11756  END IF
11757  ELSE
11758  CALL flagerror("Control Loop is not associated.",err,error,*999)
11759  END IF
11760 
11761  !Get the number of local nodes
11762  domainnodes=>dependentfield%DECOMPOSITION%DOMAIN(dependentfield%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
11763  & topology%NODES
11764  IF(ASSOCIATED(domainnodes)) THEN
11765  numberoflocalnodes1d=domainnodes%NUMBER_OF_NODES
11766  ELSE
11767  CALL flagerror("Domain nodes are not associated.",err,error,*999)
11768  END IF
11769 
11770  boundarynumber = 0
11771  boundaryconverged = .true.
11772  !!!-- L o o p O v e r L o c a l N o d e s --!!!
11773  DO nodeidx=1,numberoflocalnodes1d
11774  nodenumber = domainnodes%NODES(nodeidx)%local_number
11775  !Check for the boundary node
11776  boundarynode=dependentfield%DECOMPOSITION%DOMAIN(dependentfield%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
11777  & topology%NODES%NODES(nodenumber)%BOUNDARY_NODE
11778 
11779  !Get node characteristic wave direction (specifies inlet/outlet)
11780  DO componentidx=1,2
11781  CALL field_parametersetgetlocalnode(independentfield,field_u_variable_type,field_values_set_type, &
11782  & versionidx,derivativeidx,nodenumber,componentidx,normalwave(componentidx),err,error,*999)
11783  END DO
11784 
11785  !!!-- F i n d B o u n d a r y N o d e s --!!!
11786  IF(abs(normalwave(1))>zero_tolerance .AND. boundarynode) THEN
11787 
11788  boundarynumber = boundarynumber + 1
11789  boundaryconverged(boundarynumber) = .false.
11790  !Get material parameters
11791  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type,field_values_set_type, &
11792  & versionidx,derivativeidx,nodenumber,1,a0_param,err,error,*999)
11793  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type,field_values_set_type, &
11794  & versionidx,derivativeidx,nodenumber,2,e_param,err,error,*999)
11795  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type,field_values_set_type, &
11796  & versionidx,derivativeidx,nodenumber,3,h_param,err,error,*999)
11797  beta=(4.0_dp*sqrt(pi)*e_param*h_param)/(3.0_dp*a0_param)
11798 
11799  ! C u r r e n t Q 1 D , A 1 D , p C e l l M L V a l u e s
11800  ! ------------------------------------------------------------
11801  !Get Q1D
11802  CALL field_parametersetgetlocalnode(dependentfield,field_u_variable_type,field_values_set_type, &
11803  & versionidx,derivativeidx,nodenumber,1,q1d,err,error,*999)
11804  !Get A1D
11805  CALL field_parametersetgetlocalnode(dependentfield,field_u_variable_type,field_values_set_type, &
11806  & versionidx,derivativeidx,nodenumber,2,a1d,err,error,*999)
11807  !Get pCellML
11808  CALL field_parametersetgetlocalnode(dependentfield,field_u1_variable_type,field_values_set_type, &
11809  & versionidx,derivativeidx,nodenumber,1,pcellml,err,error,*999)
11810 
11811  ! C h e c k 1 D / 0 D C o n v e r g e n c e f o r t h i s n o d e
11812  ! -------------------------------------------------------------------------
11813  IF(iteration == 1 .AND. timestep == 0) THEN
11814  ! Create the previous iteration field values type on the dependent field if it does not exist
11815  NULLIFY(fieldvariable)
11816  CALL field_variable_get(dependentfield,field_u_variable_type,fieldvariable,err,error,*999)
11817  IF(.NOT.ASSOCIATED(fieldvariable%PARAMETER_SETS%SET_TYPE(field_previous_iteration_values_set_type)%PTR)) THEN
11818  CALL field_parameter_set_create(dependentfield,field_u_variable_type, &
11819  & field_previous_iteration_values_set_type,err,error,*999)
11820  END IF
11821  NULLIFY(fieldvariable)
11822  CALL field_variable_get(dependentfield,field_u1_variable_type,fieldvariable,err,error,*999)
11823  IF(.NOT.ASSOCIATED(fieldvariable%PARAMETER_SETS%SET_TYPE(field_previous_iteration_values_set_type)%PTR)) THEN
11824  CALL field_parameter_set_create(dependentfield,field_u1_variable_type, &
11825  & field_previous_iteration_values_set_type,err,error,*999)
11826  END IF
11827  ELSE
11828  !Get previous Q1D
11829  CALL field_parametersetgetlocalnode(dependentfield,field_u_variable_type,field_previous_iteration_values_set_type, &
11830  & versionidx,derivativeidx,nodenumber,1,qprevious,err,error,*999)
11831  !Get previous A1D
11832  CALL field_parametersetgetlocalnode(dependentfield,field_u_variable_type,field_previous_iteration_values_set_type, &
11833  & versionidx,derivativeidx,nodenumber,2,aprevious,err,error,*999)
11834  !Get previous pCellML value
11835  CALL field_parametersetgetlocalnode(dependentfield,field_u1_variable_type,field_previous_iteration_values_set_type, &
11836  & versionidx,derivativeidx,nodenumber,1,pprevious,err,error,*999)
11837  ! Check if the boundary interface values have converged
11838  qerror = abs(qprevious - q1d)
11839  aerror = abs(aprevious - a1d)
11840  IF( qerror < couplingtolerance .AND. aerror < couplingtolerance) THEN
11841  boundaryconverged(boundarynumber) = .true.
11842  END IF
11843  END IF
11844 
11845  ! store current Q and p Boundary values as previous iteration value
11846  CALL field_parameter_set_update_local_node(dependentfield,field_u_variable_type, &
11847  & field_previous_iteration_values_set_type,versionidx,derivativeidx,nodenumber,1,q1d,err,error,*999)
11848  CALL field_parameter_set_update_local_node(dependentfield,field_u_variable_type, &
11849  & field_previous_iteration_values_set_type,versionidx,derivativeidx,nodenumber,2,a1d,err,error,*999)
11850  CALL field_parameter_set_update_local_node(dependentfield,field_u1_variable_type, &
11851  & field_previous_iteration_values_set_type,versionidx,derivativeidx,nodenumber,1,pcellml,err,error,*999)
11852 
11853  END IF !Find boundary nodes
11854  END DO !Loop over nodes
11855  numberofboundaries = boundarynumber
11856 
11857  IF(solvernumber == solver1dnavierstokesnumber) THEN
11858  ! ------------------------------------------------------------------
11859  ! C h e c k G l o b a l C o u p l i n g C o n v e r g e n c e
11860  ! ------------------------------------------------------------------
11861  ! Check whether all boundaries on the local process have converged
11862  IF(numberofboundaries == 0 .OR. all(boundaryconverged(1:numberofboundaries))) THEN
11863  localconverged = .true.
11864  ELSE
11865  localconverged = .false.
11866  END IF
11867  ! Need to check that boundaries have converged globally (on all domains) if this is a parallel problem
11868  numberofcomputationalnodes=computational_environment%NUMBER_COMPUTATIONAL_NODES
11869  IF(numberofcomputationalnodes>1) THEN !use mpi
11870  !allocate array for mpi communication
11871  ALLOCATE(globalconverged(numberofcomputationalnodes),stat=err)
11872  IF(err/=0) CALL flagerror("Could not allocate global convergence check array.",err,error,*999)
11873  CALL mpi_allgather(localconverged,1,mpi_integer,globalconverged,1,mpi_integer, &
11874  & computational_environment%MPI_COMM,mpi_ierror)
11875  CALL mpi_error_check("MPI_ALLGATHER",mpi_ierror,err,error,*999)
11876  IF(all(globalconverged)) THEN
11877  !CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"1D/0D coupling converged; # iterations: ", &
11878  ! & iteration,err,error,*999)
11879  iterativeloop%CONTINUE_LOOP=.false.
11880  END IF
11881  DEALLOCATE(globalconverged)
11882  ELSE
11883  IF(localconverged) THEN
11884  !CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"1D/0D coupling converged; # iterations: ", &
11885  ! & iteration,err,error,*999)
11886  iterativeloop%CONTINUE_LOOP=.false.
11887  END IF
11888  END IF
11889 
11890  ! If the solution hasn't converged, need to revert field values to pre-solve state
11891  ! before continued iteration. This will counteract the field updates that occur
11892  ! in SOLVER_DYNAMIC_MEAN_PREDICTED_CALCULATE. Ignore for initialisation
11893  IF(timestep == 0) THEN
11894  iterativeloop%CONTINUE_LOOP=.false.
11895  END IF
11896  IF(iterativeloop%CONTINUE_LOOP .EQV. .true. ) THEN
11897  CALL field_parameter_sets_copy(dependentfield,equationsset%EQUATIONS%EQUATIONS_MAPPING%DYNAMIC_MAPPING% &
11898  & dynamic_variable_type,field_previous_values_set_type,field_values_set_type,1.0_dp,err,error,*999)
11899  CALL field_parameter_sets_copy(dependentfield,equationsset%EQUATIONS%EQUATIONS_MAPPING%DYNAMIC_MAPPING% &
11900  & dynamic_variable_type,field_previous_residual_set_type,field_residual_set_type,1.0_dp,err,error,*999)
11901  END IF
11902  END IF
11903 
11904  exits("NavierStokes_Couple1D0D")
11905  RETURN
11906 999 errorsexits("NavierStokes_Couple1D0D",err,error)
11907  RETURN 1
11908 
11909  END SUBROUTINE
11910 
11911  !
11912  !================================================================================================================================
11913  !
11914 
11916  SUBROUTINE navierstokes_couplecharacteristics(controlLoop,solver,err,error,*)
11917 
11918  !Argument variables
11919  TYPE(control_loop_type), POINTER :: controlLoop
11920  TYPE(solver_type), POINTER :: solver
11921  INTEGER(INTG), INTENT(OUT) :: err
11922  TYPE(varying_string), INTENT(OUT) :: error
11923  !Local Variables
11924  TYPE(control_loop_while_type), POINTER :: iterativeLoop
11925  TYPE(domain_nodes_type), POINTER :: domainNodes
11926  TYPE(equations_set_type), POINTER :: equationsSet
11927  TYPE(field_type), POINTER :: dependentField,independentField,materialsField
11928  TYPE(solver_equations_type), POINTER :: solverEquations
11929  TYPE(solver_mapping_type), POINTER :: solverMapping
11930  TYPE(solver_type), POINTER :: solver1DNavierStokes
11931  TYPE(varying_string) :: localError
11932  INTEGER(INTG) :: nodeNumber,nodeIdx,derivativeIdx,versionIdx,componentIdx,i
11933  INTEGER(INTG) :: solver1dNavierStokesNumber,solverNumber
11934  INTEGER(INTG) :: branchNumber,numberOfBranches,numberOfComputationalNodes,numberOfVersions
11935  INTEGER(INTG) :: MPI_IERROR,timestep,iteration,outputIteration
11936  REAL(DP) :: couplingTolerance,l2ErrorW(30),wPrevious(2,4),wNavierStokes(2,4),wCharacteristic(2,4),wError(2,4)
11937  REAL(DP) :: l2ErrorQ(100),qCharacteristic(4),qNavierStokes(4),wNext(2,4)
11938  REAL(DP) :: totalErrorWPrevious,startTime,stopTime,currentTime,timeIncrement
11939  REAL(DP) :: l2ErrorA(100),aCharacteristic(4),aNavierStokes(4),totalErrorW,totalErrorQ,totalErrorA
11940  REAL(DP) :: totalErrorMass,totalErrorMomentum
11941  REAL(DP) :: rho,alpha,normalWave,A0_PARAM,E_PARAM,H_PARAM,beta,aNew,penaltyCoeff
11942  LOGICAL :: branchConverged(100),localConverged,MPI_LOGICAL,boundaryNode,fluxDiverged
11943  LOGICAL, ALLOCATABLE :: globalConverged(:)
11944 
11945  enters("NavierStokes_CoupleCharacteristics",err,error,*999)
11946 
11947  SELECT CASE(controlloop%PROBLEM%specification(3))
11948  CASE(problem_transient1d_navier_stokes_subtype, &
11949  & problem_transient1d_adv_navier_stokes_subtype)
11950  solver1dnavierstokesnumber=2
11951  solver1dnavierstokes=>controlloop%SOLVERS%SOLVERS(solver1dnavierstokesnumber)%PTR
11952  CALL control_loop_times_get(controlloop,starttime,stoptime,currenttime,timeincrement, &
11953  & timestep,outputiteration,err,error,*999)
11954  iteration = controlloop%WHILE_LOOP%ITERATION_NUMBER
11955  iterativeloop=>controlloop%WHILE_LOOP
11956  CASE(problem_coupled1d0d_navier_stokes_subtype, &
11957  & problem_coupled1d0d_adv_navier_stokes_subtype, &
11958  & problem_stree1d0d_navier_stokes_subtype, &
11959  & problem_stree1d0d_adv_navier_stokes_subtype)
11960  solver1dnavierstokesnumber=2
11961  solver1dnavierstokes=>controlloop%PARENT_LOOP%SUB_LOOPS(2)%PTR%SOLVERS%SOLVERS(solver1dnavierstokesnumber)%PTR
11962  iterativeloop=>controlloop%WHILE_LOOP
11963  iteration = iterativeloop%ITERATION_NUMBER
11964  timestep = controlloop%PARENT_LOOP%PARENT_LOOP%TIME_LOOP%ITERATION_NUMBER
11965  CASE DEFAULT
11966  localerror="Problem subtype "//trim(number_to_vstring(controlloop%PROBLEM%specification(3),"*",err,error))// &
11967  & " is not valid for 1D-0D Navier-Stokes fluid coupling."
11968  CALL flagerror(localerror,err,error,*999)
11969  END SELECT
11970 
11971  solvernumber = solver%GLOBAL_NUMBER
11972  couplingtolerance = iterativeloop%ABSOLUTE_TOLERANCE
11973 
11974  IF(ASSOCIATED(controlloop)) THEN
11975  IF(ASSOCIATED(solver1dnavierstokes)) THEN
11976  IF(ASSOCIATED(controlloop%PROBLEM)) THEN
11977  solverequations=>solver1dnavierstokes%SOLVER_EQUATIONS
11978  IF(ASSOCIATED(solverequations)) THEN
11979  solvermapping=>solverequations%SOLVER_MAPPING
11980  IF(ASSOCIATED(solvermapping)) THEN
11981  equationsset=>solvermapping%EQUATIONS_SETS(1)%PTR
11982  IF(ASSOCIATED(equationsset)) THEN
11983  dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
11984  independentfield=>equationsset%INDEPENDENT%INDEPENDENT_FIELD
11985  materialsfield=>equationsset%MATERIALS%MATERIALS_FIELD
11986  ELSE
11987  CALL flagerror("Equations set is not associated.",err,error,*999)
11988  END IF
11989  ELSE
11990  CALL flagerror("Solver mapping is not associated.",err,error,*999)
11991  END IF
11992  ELSE
11993  CALL flagerror("Solver equations is not associated.",err,error,*999)
11994  END IF
11995  ELSE
11996  CALL flagerror("Problem is not associated.",err,error,*999)
11997  END IF
11998  ELSE
11999  CALL flagerror("Solver is not associated.",err,error,*999)
12000  END IF
12001  ELSE
12002  CALL flagerror("Control Loop is not associated.",err,error,*999)
12003  END IF
12004 
12005  domainnodes=>dependentfield%DECOMPOSITION%DOMAIN(dependentfield%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
12006  & topology%NODES
12007  branchnumber = 0
12008  branchconverged = .true.
12009  fluxdiverged = .false.
12010  totalerrorq = 0.0_dp
12011  totalerrora = 0.0_dp
12012  totalerrorw = 0.0_dp
12013  totalerrormass = 0.0_dp
12014  totalerrormomentum = 0.0_dp
12015  totalerrorwprevious = 0.0_dp
12016  l2errorq = 0.0_dp
12017  l2errora = 0.0_dp
12018  l2errorw = 0.0_dp
12019 
12020  ! Get material constants
12021  CALL field_parameter_set_get_constant(materialsfield,field_u_variable_type,field_values_set_type, &
12022  & 2,rho,err,error,*999)
12023  CALL field_parameter_set_get_constant(materialsfield,field_u_variable_type,field_values_set_type, &
12024  & 3,alpha,err,error,*999)
12025  CALL field_parameter_set_get_constant(equationsset%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD,field_u_variable_type, &
12026  & field_values_set_type,1,penaltycoeff,err,error,*999)
12027 
12028  !!!-- L o o p O v e r L o c a l N o d e s --!!!
12029  DO nodeidx=1,domainnodes%NUMBER_OF_NODES
12030  nodenumber = domainnodes%NODES(nodeidx)%local_number
12031  derivativeidx = 1
12032  numberofversions=domainnodes%NODES(nodenumber)%DERIVATIVES(derivativeidx)%numberOfVersions
12033  boundarynode=domainnodes%NODES(nodenumber)%BOUNDARY_NODE
12034 
12035  !DEBUG
12036  CALL field_parametersetgetlocalnode(independentfield,field_u_variable_type, &
12037  & field_values_set_type,1,1,nodenumber,1,normalwave,err,error,*999)
12038  IF(abs(normalwave) > zero_tolerance) THEN
12039  branchnumber = branchnumber + 1
12040  branchconverged(branchnumber) = .false.
12041 
12042  werror = 0.0_dp
12043  i = 0
12044  DO componentidx=1,2
12045  DO versionidx=1,numberofversions
12046  i = i +1
12047  CALL field_parametersetgetlocalnode(independentfield,field_u_variable_type, &
12048  & field_values_set_type,versionidx,derivativeidx,nodenumber,componentidx,normalwave,err,error,*999)
12049  IF(abs(normalwave)>zero_tolerance) THEN
12050 
12051  ! Get the previously set characteristic (W) for this timestep-
12052  ! if this is the first iteration it will be based on extrapolated values
12053  ! otherwise it will come from the last iteration of this subroutine.
12054  CALL field_parametersetgetlocalnode(dependentfield,field_v_variable_type,field_values_set_type, &
12055  & versionidx,derivativeidx,nodenumber,componentidx,wprevious(componentidx,versionidx),err,error,*999)
12056 
12057  !Get material parameters
12058  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type,field_values_set_type, &
12059  & versionidx,derivativeidx,nodenumber,1,a0_param,err,error,*999)
12060  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type,field_values_set_type, &
12061  & versionidx,derivativeidx,nodenumber,2,e_param,err,error,*999)
12062  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type,field_values_set_type, &
12063  & versionidx,derivativeidx,nodenumber,3,h_param,err,error,*999)
12064  beta=(4.0_dp*sqrt(pi)*e_param*h_param)/(3.0_dp*a0_param)
12065 
12066  ! Get current Q,A values based on N-S solve
12067  CALL field_parametersetgetlocalnode(dependentfield,field_u_variable_type,field_values_set_type, &
12068  & versionidx,derivativeidx,nodenumber,1,qnavierstokes(versionidx),err,error,*999)
12069  CALL field_parametersetgetlocalnode(dependentfield,field_u_variable_type,field_values_set_type, &
12070  & versionidx,derivativeidx,nodenumber,2,anavierstokes(versionidx),err,error,*999)
12071 
12072  ! Calculate the characteristic based on the values converged upon by the
12073  ! N-S solver at this iteration.
12074  wnavierstokes(componentidx,versionidx)= ((qnavierstokes(versionidx)/anavierstokes(versionidx))+ &
12075  & normalwave*4.0_dp*sqrt(beta/(2.0_dp*rho))*(anavierstokes(versionidx)**(0.25_dp) - (a0_param)**(0.25_dp)))
12076 
12077  IF(boundarynode) THEN
12078  anew = (1.0_dp/(beta/(2.0_dp*rho)))**2.0_dp*((wnavierstokes(componentidx,versionidx))/8.0_dp+ &
12079  & sqrt(beta/(2.0_dp*rho))*((a0_param)**0.25_dp))**4.0_dp
12080  CALL field_parameter_set_update_local_node(dependentfield,field_u_variable_type, &
12081  & field_previous_values_set_type,versionidx,derivativeidx,nodenumber, &
12082  & 2,anew,err,error,*999)
12083  END IF
12084 
12085  ! Get characteristic (flux conserving) Q,A values
12086  CALL field_parametersetgetlocalnode(dependentfield,field_u_variable_type,field_upwind_values_set_type, &
12087  & versionidx,derivativeidx,nodenumber,1,qcharacteristic(versionidx),err,error,*999)
12088  CALL field_parametersetgetlocalnode(dependentfield,field_u_variable_type,field_upwind_values_set_type, &
12089  & versionidx,derivativeidx,nodenumber,2,acharacteristic(versionidx),err,error,*999)
12090 
12091  ! Calculate the characteristic based on the upwind values
12092  wcharacteristic(componentidx,versionidx)= ((qcharacteristic(versionidx)/acharacteristic(versionidx))+ &
12093  & normalwave*4.0_dp*sqrt((beta/(2.0_dp*rho)))*(acharacteristic(versionidx)**(0.25_dp) - (a0_param)**(0.25_dp)))
12094  END IF
12095  END DO
12096  END DO
12097 
12098  ! Evaluate error between current and previous Q,A values
12099  IF(numberofversions > 1 ) THEN
12100  l2errorq(branchnumber) = l2norm(qnavierstokes-qcharacteristic)
12101  l2errora(branchnumber) = l2norm(anavierstokes-acharacteristic)
12102  END IF
12103  ! Check if the branch values have converged
12104  IF((abs(l2errorq(branchnumber)) < couplingtolerance) .AND. (abs(l2errora(branchnumber)) < couplingtolerance)) THEN
12105  branchconverged(branchnumber) = .true.
12106  END IF
12107  totalerrorq = totalerrorq + l2errorq(branchnumber)
12108  totalerrora = totalerrora + l2errora(branchnumber)
12109 
12110  wnext = ((wnavierstokes + wcharacteristic)/2.0_dp)
12111  ! If N-S/C w values did not converge re-solve with new w.
12112  IF(numberofversions > 1) THEN
12113  DO componentidx=1,2
12114  DO versionidx=1,numberofversions
12115  CALL field_parametersetgetlocalnode(independentfield,field_u_variable_type, &
12116  & field_values_set_type,versionidx,derivativeidx,nodenumber,componentidx,normalwave,err,error,*999)
12117  IF(abs(normalwave)>zero_tolerance) THEN
12118  !Update W value
12119  CALL field_parameter_set_update_local_node(dependentfield,field_v_variable_type,field_values_set_type, &
12120  & versionidx,derivativeidx,nodenumber,componentidx,wnext(componentidx,versionidx),err,error,*999)
12121  END IF
12122  END DO
12123  END DO
12124  END IF
12125 
12126  END IF !Find boundary nodes
12127  END DO !Loop over nodes
12128  numberofbranches = branchnumber
12129 
12130  ! ------------------------------------------------------------------
12131  ! C h e c k G l o b a l C o u p l i n g C o n v e r g e n c e
12132  ! ------------------------------------------------------------------
12133  ! Check whether all branches on the local process have converged
12134  IF(numberofbranches == 0 .OR. all(branchconverged(1:numberofbranches))) THEN
12135  localconverged = .true.
12136  ELSE
12137  localconverged = .false.
12138  END IF
12139  ! Need to check that boundaries have converged globally (on all domains) if this is a parallel problem
12140  numberofcomputationalnodes=computational_environment%NUMBER_COMPUTATIONAL_NODES
12141  IF(numberofcomputationalnodes>1) THEN !use mpi
12142  !allocate array for mpi communication
12143  ALLOCATE(globalconverged(numberofcomputationalnodes),stat=err)
12144  IF(err/=0) CALL flagerror("Could not allocate global convergence check array.",err,error,*999)
12145  CALL mpi_allgather(localconverged,1,mpi_integer,globalconverged,1,mpi_integer, &
12146  & computational_environment%MPI_COMM,mpi_ierror)
12147  CALL mpi_error_check("MPI_ALLGATHER",mpi_ierror,err,error,*999)
12148  IF(all(globalconverged)) THEN
12149  !CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"Navier-Stokes/Characteristic converged; # iterations: ", &
12150  ! & iteration,err,error,*999)
12151  controlloop%WHILE_LOOP%CONTINUE_LOOP=.false.
12152  END IF
12153  DEALLOCATE(globalconverged)
12154  ELSE
12155  IF(localconverged) THEN
12156  !CALL WRITE_STRING_VALUE(DIAGNOSTIC_OUTPUT_TYPE,"Navier-Stokes/Characteristic converged; # iterations: ", &
12157  ! & iteration,err,error,*999)
12158  controlloop%WHILE_LOOP%CONTINUE_LOOP=.false.
12159  END IF
12160  END IF
12161 
12162  exits("NavierStokes_CoupleCharacteristics")
12163  RETURN
12164 999 errorsexits("NavierStokes_CoupleCharacteristics",err,error)
12165  RETURN 1
12166 
12167  END SUBROUTINE navierstokes_couplecharacteristics
12168 
12169  !
12170  !================================================================================================================================
12171  !
12172 
12174  SUBROUTINE navierstokes_shearratecalculate(equationsSet,ERR,ERROR,*)
12175 
12176  !Argument variables
12177  TYPE(equations_set_type), POINTER :: equationsSet
12178  INTEGER(INTG), INTENT(OUT) :: err
12179  TYPE(varying_string), INTENT(OUT) :: error
12180  !Local Variables
12181  TYPE(equations_type), POINTER :: equations
12182  TYPE(domain_mapping_type), POINTER :: elementsMapping
12183  TYPE(varying_string) :: localError
12184  TYPE(field_variable_type), POINTER :: dependentVariable
12185  TYPE(field_variable_type), POINTER :: fieldVariable
12186  TYPE(decomposition_type), POINTER :: decomposition
12187  TYPE(basis_type), POINTER :: dependentBasis
12188  TYPE(quadrature_scheme_type), POINTER :: quadratureScheme
12189  TYPE(field_interpolated_point_type), POINTER :: dependentInterpolatedPoint
12190  TYPE(field_interpolation_parameters_type), POINTER :: dependentInterpolationParameters
12191  TYPE(field_interpolated_point_type), POINTER :: geometricInterpolatedPoint
12192  TYPE(field_interpolated_point_metrics_type), POINTER :: pointMetrics
12193  TYPE(field_type), POINTER :: dependentField
12194  TYPE(field_type), POINTER :: materialsField
12195  INTEGER(INTG) :: elementIdx,decompositionLocalElementNumber
12196  INTEGER(INTG) :: gaussIdx
12197  INTEGER(INTG) :: meshComponentNumber,numberOfDimensions,i,j,userElementNumber
12198  INTEGER(INTG) :: localElementNumber,startElement,stopElement
12199  REAL(DP) :: gaussWeight,shearRate,secondInvariant,strainRate
12200  REAL(DP) :: dUdXi(3,3),dXidX(3,3),dUdX(3,3),dUdXTrans(3,3),rateOfDeformation(3,3),velocityGauss(3)
12201  REAL(DP) :: shearRateDefault
12202  LOGICAL :: ghostElement,elementExists,defaultUpdate
12203 
12204  enters("NavierStokes_ShearRateCalculate",err,error,*999)
12205 
12206  CALL write_string(general_output_type,"...Calculating shear rate...",err,error,*999)
12207 
12208  NULLIFY(decomposition)
12209  NULLIFY(dependentbasis)
12210  NULLIFY(equations)
12211  NULLIFY(quadraturescheme)
12212  NULLIFY(fieldvariable)
12213  NULLIFY(dependentinterpolatedpoint)
12214  NULLIFY(dependentinterpolationparameters)
12215  NULLIFY(geometricinterpolatedpoint)
12216  NULLIFY(dependentfield)
12217  NULLIFY(materialsfield)
12218 
12219  ! Some preliminary sanity checks
12220  IF(ASSOCIATED(equationsset)) THEN
12221  equations=>equationsset%EQUATIONS
12222  IF(ASSOCIATED(equations)) THEN
12223  dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
12224  IF(.NOT.ASSOCIATED(dependentfield)) THEN
12225  CALL flagerror("Dependent field is not associated.",err,error,*999)
12226  END IF
12227  materialsfield=>equationsset%MATERIALS%MATERIALS_FIELD
12228  IF(.NOT.ASSOCIATED(materialsfield)) THEN
12229  CALL flagerror("Materials field is not associated.",err,error,*999)
12230  END IF
12231  ELSE
12232  CALL flagerror("Equations set equations is not associated.",err,error,*999)
12233  END IF
12234  ELSE
12235  CALL flagerror("Equations set is not associated.",err,error,*999)
12236  END IF
12237 
12238  SELECT CASE(equationsset%specification(3))
12239  CASE(equations_set_constitutive_mu_navier_stokes_subtype)
12240  dependentvariable=>equations%EQUATIONS_MAPPING%NONLINEAR_MAPPING%RESIDUAL_VARIABLES(1)%PTR
12241  meshcomponentnumber=dependentvariable%COMPONENTS(1)%MESH_COMPONENT_NUMBER
12242  !Get the mesh decomposition and mapping
12243  decomposition=>dependentvariable%FIELD%DECOMPOSITION
12244  elementsmapping=>decomposition%DOMAIN(decomposition%MESH_COMPONENT_NUMBER)%PTR%MAPPINGS%ELEMENTS
12245  fieldvariable=>equations%EQUATIONS_MAPPING%NONLINEAR_MAPPING%RESIDUAL_VARIABLES(1)%PTR
12246  numberofdimensions=fieldvariable%NUMBER_OF_COMPONENTS - 1
12247  dependentinterpolatedpoint=>equations%INTERPOLATION%DEPENDENT_INTERP_POINT(dependentvariable%VARIABLE_TYPE)%PTR
12248  geometricinterpolatedpoint=>equations%INTERPOLATION%GEOMETRIC_INTERP_POINT(field_u_variable_type)%PTR
12249  defaultupdate=.false.
12250 
12251  ! Loop over internal and boundary elements, skipping ghosts
12252  startelement = elementsmapping%INTERNAL_START
12253  stopelement = elementsmapping%BOUNDARY_FINISH
12254  ! Loop over internal and boundary elements
12255  DO elementidx=startelement,stopelement
12256  localelementnumber=elementsmapping%DOMAIN_LIST(elementidx)
12257  userelementnumber = elementsmapping%LOCAL_TO_GLOBAL_MAP(localelementnumber)
12258  !Check computational node for elementIdx
12259  elementexists=.false.
12260  ghostelement=.true.
12261  CALL decomposition_topology_element_check_exists(decomposition%TOPOLOGY, &
12262  & userelementnumber,elementexists,decompositionlocalelementnumber,ghostelement,err,error,*999)
12263  IF(ghostelement) THEN
12264  CALL write_string_value(diagnostic_output_type,"Ghost: ",userelementnumber,err,error,*999)
12265  END IF
12266 
12267  IF(elementexists) THEN
12268  dependentbasis=>decomposition%DOMAIN(meshcomponentnumber)%PTR%TOPOLOGY%ELEMENTS%ELEMENTS(localelementnumber)%BASIS
12269  quadraturescheme=>dependentbasis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
12270 
12271  CALL field_interpolation_parameters_element_get(field_values_set_type,localelementnumber,equations%INTERPOLATION% &
12272  & dependent_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
12273  CALL field_interpolation_parameters_element_get(field_values_set_type,localelementnumber,equations%INTERPOLATION% &
12274  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
12275 
12276  ! Loop over gauss points
12277  DO gaussidx=1,quadraturescheme%NUMBER_OF_GAUSS
12278  !Get interpolated velocity
12279  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gaussidx, &
12280  & dependentinterpolatedpoint,err,error,*999)
12281  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,gaussidx, &
12282  & geometricinterpolatedpoint,err,error,*999)
12283  pointmetrics=>equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR
12284  CALL field_interpolated_point_metrics_calculate(coordinate_jacobian_volume_type,pointmetrics,err,error,*999)
12285  gaussweight=quadraturescheme%GAUSS_WEIGHTS(gaussidx)
12286  !Interpolated values at gauss point
12287  dxidx=0.0_dp
12288  dudxi=0.0_dp
12289  velocitygauss=dependentinterpolatedpoint%values(1:3,no_part_deriv)
12290 
12291  dudxi(1:3,1)=dependentinterpolatedpoint%VALUES(1:3,part_deriv_s1)
12292  dudxi(1:3,2)=dependentinterpolatedpoint%VALUES(1:3,part_deriv_s2)
12293  IF(numberofdimensions == 3) THEN
12294  dudxi(1:3,3)=dependentinterpolatedpoint%VALUES(1:3,part_deriv_s3)
12295  ELSE
12296  dudxi(1:3,3)=0.0_dp
12297  END IF
12298  dxidx=pointmetrics%DXI_DX(:,:)
12299  dudx=0.0_dp
12300  dudxtrans=0.0_dp
12301  strainrate=0.0_dp
12302 
12303  CALL matrix_product(dudxi,dxidx,dudx,err,error,*999) !dU/dX = dU/dxi * dxi/dX (deformation gradient tensor)
12304  CALL matrix_transpose(dudx,dudxtrans,err,error,*999)
12305  DO i=1,3
12306  DO j=1,3
12307  strainrate = strainrate + (dudx(i,j)*dudxtrans(i,j))
12308  rateofdeformation(i,j) = (dudx(i,j) + dudxtrans(i,j))/2.0_dp
12309  END DO
12310  END DO
12311  secondinvariant= - rateofdeformation(1,2)**2.0_dp - &
12312  & rateofdeformation(2,3)**2.0_dp - rateofdeformation(1,3)**2.0_dp
12313 
12314  IF(secondinvariant > -1.0e-30_dp) THEN
12315  CALL write_string_value(diagnostic_output_type, &
12316  & "WARNING: positive second invariant of rate of deformation tensor: ",secondinvariant,err,error,*999)
12317  CALL write_string_value(diagnostic_output_type," Element number: ",userelementnumber,err,error,*999)
12318  CALL write_string_value(diagnostic_output_type," Gauss point number: ",gaussidx,err,error,*999)
12319  defaultupdate=.true.
12320  EXIT
12321  ELSE
12322  shearrate=sqrt(-4.0_dp*secondinvariant)
12323  END IF
12324  CALL field_parametersetupdatelocalgausspoint(materialsfield,field_v_variable_type, &
12325  & field_values_set_type,gaussidx,localelementnumber,2,shearrate,err,error,*999)
12326 
12327  END DO !gaussIdx
12328  END IF ! check for ghost element
12329  IF(defaultupdate .EQV. .true.) THEN
12330  EXIT
12331  END IF
12332  END DO !elementIdx
12333 
12334  IF(defaultupdate .EQV. .true.) THEN
12335  shearratedefault=1.0e-10_dp
12336  CALL write_string_value(diagnostic_output_type,"Setting default shear field values...", &
12337  & shearratedefault,err,error,*999)
12338  CALL field_component_values_initialise(materialsfield,field_v_variable_type, &
12339  & field_values_set_type,1,shearratedefault,err,error,*999)
12340  END IF
12341 
12342  CASE DEFAULT
12343  localerror="Equations set subtype "//trim(number_to_vstring(equationsset%specification(3),"*",err,error))// &
12344  & " is not valid for shear rate calculation in a Navier-Stokes equation type of a classical field equations set class."
12345  CALL flagerror(localerror,err,error,*999)
12346  END SELECT
12347 
12348  exits("NavierStokes_ShearRateCalculate")
12349  RETURN
12350 999 errorsexits("NavierStokes_ShearRateCalculate",err,error)
12351  RETURN 1
12352 
12353  END SUBROUTINE navierstokes_shearratecalculate
12354 
12355  !
12356  !================================================================================================================================
12357  !
12358 
12360  SUBROUTINE navierstokes_finiteelementpreresidualevaluate(equationsSet,err,error,*)
12361 
12362  !Argument variables
12363  TYPE(equations_set_type), POINTER :: equationsSet
12364  INTEGER(INTG), INTENT(OUT) :: err
12365  TYPE(varying_string), INTENT(OUT) :: error
12366  !Local Variables
12367  TYPE(varying_string) :: LOCAL_ERROR
12368 
12369  enters("NavierStokes_FiniteElementPreResidualEvaluate",err,error,*999)
12370 
12371  IF(ASSOCIATED(equationsset)) THEN
12372  SELECT CASE(equationsset%specification(3))
12373  CASE(equations_set_constitutive_mu_navier_stokes_subtype)
12374  ! Shear rate should either be calculated here to update at each minor iteration
12375  ! or during post solve so it is updated once per timestep
12376  !CALL NavierStokes_ShearRateCalculate(equationsSet,err,error,*999)
12377  CASE(equations_set_static_navier_stokes_subtype, &
12378  & equations_set_laplace_navier_stokes_subtype, &
12379  & equations_set_transient_navier_stokes_subtype, &
12380  & equations_set_optimised_navier_stokes_subtype, &
12381  & equations_set_ale_navier_stokes_subtype, &
12382  & equations_set_pgm_navier_stokes_subtype, &
12383  & equations_set_quasistatic_navier_stokes_subtype, &
12384  & equations_set_transient_rbs_navier_stokes_subtype, &
12385  & equations_set_static_rbs_navier_stokes_subtype, &
12386  & equations_set_multiscale3d_navier_stokes_subtype, &
12387  & equations_set_transient1d_adv_navier_stokes_subtype, &
12388  & equations_set_transient1d_navier_stokes_subtype, &
12389  & equations_set_coupled1d0d_navier_stokes_subtype, &
12390  & equations_set_coupled1d0d_adv_navier_stokes_subtype)
12391  !Do nothing
12392  CASE DEFAULT
12393  local_error="The third equations set specification of "// &
12394  & trim(number_to_vstring(equationsset%specification(3),"*",err,error))// &
12395  & " is not valid for a Navier-Stokes fluid mechanics equations set."
12396  CALL flagerror(local_error,err,error,*999)
12397  END SELECT
12398  ELSE
12399  CALL flagerror("Equations set is not associated.",err,error,*999)
12400  END IF
12401 
12402  exits("NavierStokes_FiniteElementPreResidualEvaluate")
12403  RETURN
12404 999 errors("NavierStokes_FiniteElementPreResidualEvaluate",err,error)
12405  exits("NavierStokes_FiniteElementPreResidualEvaluate")
12406  RETURN 1
12407 
12408  END SUBROUTINE navierstokes_finiteelementpreresidualevaluate
12409 
12410  !
12411  !================================================================================================================================
12412  !
12413 
12415  SUBROUTINE navierstokes_controllooppostloop(controlLoop,err,error,*)
12416 
12417  !Argument variables
12418  TYPE(control_loop_type), POINTER :: controlLoop
12419  INTEGER(INTG), INTENT(OUT) :: err
12420  TYPE(varying_string), INTENT(OUT) :: error
12421  !Local Variables
12422  TYPE(solver_type), POINTER :: navierStokesSolver
12423  TYPE(field_type), POINTER :: dependentField
12424  TYPE(field_variable_type), POINTER :: fieldVariable
12425  TYPE(varying_string) :: localError
12426 
12427  enters("NavierStokes_ControlLoopPostLoop",err,error,*999)
12428 
12429  NULLIFY(dependentfield)
12430  NULLIFY(fieldvariable)
12431 
12432  IF(ASSOCIATED(controlloop)) THEN
12433  SELECT CASE(controlloop%PROBLEM%specification(3))
12434  CASE(problem_static_navier_stokes_subtype, &
12435  & problem_laplace_navier_stokes_subtype, &
12436  & problem_pgm_navier_stokes_subtype, &
12437  & problem_quasistatic_navier_stokes_subtype, &
12438  & problem_transient_navier_stokes_subtype, &
12439  & problem_transient_rbs_navier_stokes_subtype, &
12440  & problem_multiscale_navier_stokes_subtype, &
12441  & problem_ale_navier_stokes_subtype)
12442  ! Do nothing
12443  CASE(problem_transient1d_navier_stokes_subtype, &
12444  & problem_transient1d_adv_navier_stokes_subtype)
12445  SELECT CASE(controlloop%LOOP_TYPE)
12446  CASE(problem_control_simple_type)
12447  ! Do nothing
12448  CASE(problem_control_time_loop_type)
12449  ! Global time loop - export data
12450  navierstokessolver=>controlloop%SUB_LOOPS(1)%PTR%SOLVERS%SOLVERS(2)%PTR
12451  CALL navier_stokes_post_solve_output_data(navierstokessolver,err,error,*999)
12452  CASE(problem_control_while_loop_type)
12453  navierstokessolver=>controlloop%SOLVERS%SOLVERS(2)%PTR
12454  CALL navierstokes_couplecharacteristics(controlloop,navierstokessolver,err,error,*999)
12455  CASE DEFAULT
12456  localerror="The control loop type of "//trim(number_to_vstring(controlloop%LOOP_TYPE,"*",err,error))// &
12457  & " is invalid for a Coupled 1D0D Navier-Stokes problem."
12458  CALL flagerror(localerror,err,error,*999)
12459  END SELECT
12460  CASE(problem_coupled1d0d_navier_stokes_subtype, &
12461  & problem_coupled1d0d_adv_navier_stokes_subtype, &
12462  & problem_stree1d0d_navier_stokes_subtype, &
12463  & problem_stree1d0d_adv_navier_stokes_subtype)
12464  SELECT CASE(controlloop%LOOP_TYPE)
12465  CASE(problem_control_simple_type)
12466  ! CellML simple loop - do nothing
12467  CASE(problem_control_time_loop_type)
12468  ! Global time loop - export data
12469  navierstokessolver=>controlloop%SUB_LOOPS(1)%PTR%SUB_LOOPS(2)%PTR%SOLVERS%SOLVERS(2)%PTR
12470  CALL navier_stokes_post_solve_output_data(navierstokessolver,err,error,*999)
12471  CASE(problem_control_while_loop_type)
12472  ! Couple 1D/0D loop
12473  IF(controlloop%CONTROL_LOOP_LEVEL==2) THEN
12474  navierstokessolver=>controlloop%SUB_LOOPS(2)%PTR%SOLVERS%SOLVERS(2)%PTR
12475  ! update 1D/0D coupling parameters and check convergence
12476  CALL navierstokes_couple1d0d(controlloop,navierstokessolver,err,error,*999)
12477  ! Couple Navier-Stokes/Characteristics loop
12478  ELSE IF(controlloop%CONTROL_LOOP_LEVEL==3) THEN
12479  navierstokessolver=>controlloop%SOLVERS%SOLVERS(2)%PTR
12480  CALL navierstokes_couplecharacteristics(controlloop,navierstokessolver,err,error,*999)
12481  ELSE
12482  localerror="The while loop level of "//trim(number_to_vstring(controlloop%CONTROL_LOOP_LEVEL,"*",err,error))// &
12483  & " is invalid for a Coupled 1D0D Navier-Stokes problem."
12484  CALL flagerror(localerror,err,error,*999)
12485  END IF
12486  CASE DEFAULT
12487  localerror="The control loop type of "//trim(number_to_vstring(controlloop%LOOP_TYPE,"*",err,error))// &
12488  & " is invalid for a Coupled 1D0D Navier-Stokes problem."
12489  CALL flagerror(localerror,err,error,*999)
12490  END SELECT
12491  CASE DEFAULT
12492  localerror="Problem subtype "//trim(number_to_vstring(controlloop%PROBLEM%specification(3),"*",err,error))// &
12493  & " is not valid for a Navier-Stokes fluid type of a fluid mechanics problem class."
12494  CALL flagerror(localerror,err,error,*999)
12495  END SELECT
12496  ELSE
12497  CALL flagerror("Control loop is not associated.",err,error,*999)
12498  END IF
12499 
12500  exits("NavierStokes_ControlLoopPostLoop")
12501  RETURN
12502 999 errorsexits("NavierStokes_ControlLoopPostLoop",err,error)
12503  RETURN 1
12504 
12505  END SUBROUTINE navierstokes_controllooppostloop
12506 
12507  !
12508  !================================================================================================================================
12509  !
12510 
12512  SUBROUTINE navierstokes_updatemultiscaleboundary(solver,err,error,*)
12513 
12514  !Argument variables
12515  TYPE(solver_type), POINTER :: solver
12516  INTEGER(INTG), INTENT(OUT) :: err
12517  TYPE(varying_string), INTENT(OUT) :: error
12518  !Local Variables
12519  TYPE(boundary_conditions_type), POINTER :: boundaryConditions
12520  TYPE(boundary_conditions_variable_type), POINTER :: boundaryConditionsVariable
12521  TYPE(control_loop_type), POINTER :: controlLoop,parentLoop,streeLoop
12522  TYPE(domain_type), POINTER :: dependentDomain
12523  TYPE(equations_set_type), POINTER :: equationsSet,streeEquationsSet
12524  TYPE(equations_type), POINTER :: equations,streeEquations
12525  TYPE(field_type), POINTER :: dependentField,materialsField,streeMaterialsField,independentField,geometricField
12526  TYPE(field_variable_type), POINTER :: fieldVariable
12527  TYPE(solver_equations_type), POINTER :: solverEquations,streeSolverEquations
12528  TYPE(solver_mapping_type), POINTER :: solverMapping,streeSolverMapping
12529  TYPE(solvers_type), POINTER :: solvers
12530  TYPE(solver_type), POINTER :: streeSolver
12531  TYPE(varying_string) :: localError
12532  REAL(DP) :: rho,A0,H0,E,beta,pExternal,lengthScale,timeScale,massScale,currentTime,timeIncrement
12533  REAL(DP) :: pCellml,qCellml,ABoundary,W1,W2,ACellML,normalWave(2,4)
12534  REAL(DP), POINTER :: Impedance(:),Flow(:)
12535  INTEGER(INTG) :: nodeIdx,versionIdx,derivativeIdx,componentIdx,numberOfVersions,numberOfLocalNodes
12536  INTEGER(INTG) :: dependentDof,boundaryConditionType,k
12537 
12538  enters("NavierStokes_UpdateMultiscaleBoundary",err,error,*999)
12539 
12540  NULLIFY(dependentdomain)
12541  NULLIFY(equationsset)
12542  NULLIFY(equations)
12543  NULLIFY(geometricfield)
12544  NULLIFY(dependentfield)
12545  NULLIFY(independentfield)
12546  NULLIFY(materialsfield)
12547  NULLIFY(fieldvariable)
12548  NULLIFY(solverequations)
12549  NULLIFY(solvermapping)
12550 
12551  ! Preliminary checks; get field and domain pointers
12552  IF(ASSOCIATED(solver)) THEN
12553  solvers=>solver%SOLVERS
12554  IF(ASSOCIATED(solvers)) THEN
12555  controlloop=>solvers%CONTROL_LOOP
12556  parentloop=>controlloop%PARENT_LOOP
12557  streeloop=>parentloop%SUB_LOOPS(1)%PTR
12558  streesolver=>streeloop%SOLVERS%SOLVERS(1)%PTR
12559  CALL control_loop_current_times_get(controlloop, &
12560  & currenttime,timeincrement,err,error,*999)
12561  IF(ASSOCIATED(controlloop%PROBLEM)) THEN
12562  SELECT CASE(controlloop%PROBLEM%specification(3))
12563  CASE(problem_coupled1d0d_navier_stokes_subtype, &
12564  & problem_coupled1d0d_adv_navier_stokes_subtype, &
12565  & problem_transient1d_navier_stokes_subtype, &
12566  & problem_transient1d_adv_navier_stokes_subtype)
12567  solverequations=>solver%SOLVER_EQUATIONS
12568  IF(ASSOCIATED(solverequations)) THEN
12569  solvermapping=>solverequations%SOLVER_MAPPING
12570  IF(ASSOCIATED(solvermapping)) THEN
12571  equationsset=>solvermapping%EQUATIONS_SETS(1)%PTR
12572  IF(ASSOCIATED(equationsset)) THEN
12573  equations=>equationsset%EQUATIONS
12574  IF(ASSOCIATED(equations)) THEN
12575  geometricfield=>equationsset%GEOMETRY%GEOMETRIC_FIELD
12576  independentfield=>equationsset%INDEPENDENT%INDEPENDENT_FIELD
12577  dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
12578  IF(ASSOCIATED(dependentfield)) THEN
12579  dependentdomain=>dependentfield%DECOMPOSITION%DOMAIN(dependentfield% &
12580  & decomposition%MESH_COMPONENT_NUMBER)%PTR
12581  IF(.NOT.ASSOCIATED(dependentdomain)) THEN
12582  CALL flagerror("Dependent domain is not associated.",err,error,*999)
12583  END IF
12584  ELSE
12585  CALL flagerror("Geometric field is not associated.",err,error,*999)
12586  END IF
12587  materialsfield=>equations%INTERPOLATION%MATERIALS_FIELD
12588  IF(.NOT.ASSOCIATED(materialsfield)) THEN
12589  CALL flagerror("Materials field is not associated.",err,error,*999)
12590  END IF
12591  ELSE
12592  CALL flagerror("Equations set equations is not associated.",err,error,*999)
12593  END IF
12594  ELSE
12595  CALL flagerror("Equations set is not associated.",err,error,*999)
12596  END IF
12597  ELSE
12598  CALL flagerror("Solver mapping is not associated.",err,error,*999)
12599  END IF
12600  ELSE
12601  CALL flagerror("Solver equations is not associated.",err,error,*999)
12602  END IF
12603  CASE(problem_stree1d0d_navier_stokes_subtype, &
12604  & problem_stree1d0d_adv_navier_stokes_subtype)
12605  solverequations=>solver%SOLVER_EQUATIONS
12606  streesolverequations=>streesolver%SOLVER_EQUATIONS
12607  IF(ASSOCIATED(solverequations)) THEN
12608  solvermapping=>solverequations%SOLVER_MAPPING
12609  streesolvermapping=>streesolverequations%SOLVER_MAPPING
12610  IF(ASSOCIATED(solvermapping)) THEN
12611  equationsset=>solvermapping%EQUATIONS_SETS(1)%PTR
12612  streeequationsset=>streesolvermapping%EQUATIONS_SETS(1)%PTR
12613  IF(ASSOCIATED(equationsset)) THEN
12614  equations=>equationsset%EQUATIONS
12615  streeequations=>streeequationsset%EQUATIONS
12616  IF(ASSOCIATED(equations)) THEN
12617  geometricfield=>equationsset%GEOMETRY%GEOMETRIC_FIELD
12618  independentfield=>equationsset%INDEPENDENT%INDEPENDENT_FIELD
12619  dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
12620  streematerialsfield=>streeequationsset%MATERIALS%MATERIALS_FIELD
12621  IF(ASSOCIATED(dependentfield)) THEN
12622  dependentdomain=>dependentfield%DECOMPOSITION%DOMAIN(dependentfield% &
12623  & decomposition%MESH_COMPONENT_NUMBER)%PTR
12624  IF(.NOT.ASSOCIATED(dependentdomain)) THEN
12625  CALL flagerror("Dependent domain is not associated.",err,error,*999)
12626  END IF
12627  ELSE
12628  CALL flagerror("Geometric field is not associated.",err,error,*999)
12629  END IF
12630  materialsfield=>equations%INTERPOLATION%MATERIALS_FIELD
12631  IF(.NOT.ASSOCIATED(materialsfield)) THEN
12632  CALL flagerror("Materials field is not associated.",err,error,*999)
12633  END IF
12634  ELSE
12635  CALL flagerror("Equations set equations is not associated.",err,error,*999)
12636  END IF
12637  ELSE
12638  CALL flagerror("Equations set is not associated.",err,error,*999)
12639  END IF
12640  ELSE
12641  CALL flagerror("Solver mapping is not associated.",err,error,*999)
12642  END IF
12643  ELSE
12644  CALL flagerror("Solver equations is not associated.",err,error,*999)
12645  END IF
12646  CASE DEFAULT
12647  localerror="The third problem specification of "// &
12648  & trim(number_to_vstring(controlloop%PROBLEM%specification(3),"*",err,error))// &
12649  & " is not valid for boundary flux calculation."
12650  CALL flagerror(localerror,err,error,*999)
12651  END SELECT
12652  ELSE
12653  CALL flagerror("Problem is not associated.",err,error,*999)
12654  END IF
12655  ELSE
12656  CALL flagerror("Solvers is not associated.",err,error,*999)
12657  END IF
12658  ELSE
12659  CALL flagerror("Solver is not associated.",err,error,*999)
12660  END IF
12661 
12662  SELECT CASE(equationsset%specification(3))
12663  !!!-- 1 D E q u a t i o n s S e t --!!!
12664  CASE(equations_set_transient1d_navier_stokes_subtype, &
12665  & equations_set_coupled1d0d_navier_stokes_subtype, &
12666  & equations_set_transient1d_adv_navier_stokes_subtype, &
12667  & equations_set_coupled1d0d_adv_navier_stokes_subtype)
12668 
12669  independentfield=>equationsset%INDEPENDENT%INDEPENDENT_FIELD
12670  numberoflocalnodes=dependentdomain%TOPOLOGY%NODES%NUMBER_OF_NODES
12671  derivativeidx=1
12672  !Get constant material parameters
12673  CALL field_parameter_set_get_constant(materialsfield,field_u_variable_type, &
12674  & field_values_set_type,2,rho,err,error,*999)
12675  CALL field_parameter_set_get_constant(materialsfield,field_u_variable_type, &
12676  & field_values_set_type,4,pexternal,err,error,*999)
12677  !Get materials scale factors
12678  CALL field_parameter_set_get_constant(materialsfield,field_u_variable_type, &
12679  & field_values_set_type,5,lengthscale,err,error,*999)
12680  CALL field_parameter_set_get_constant(materialsfield,field_u_variable_type, &
12681  & field_values_set_type,6,timescale,err,error,*999)
12682  CALL field_parameter_set_get_constant(materialsfield,field_u_variable_type, &
12683  & field_values_set_type,7,massscale,err,error,*999)
12684 
12685  !!!-- L o o p o v e r l o c a l n o d e s --!!!
12686  DO nodeidx=1,numberoflocalnodes
12687  numberofversions=dependentdomain%TOPOLOGY%NODES%NODES(nodeidx)%DERIVATIVES(derivativeidx)%numberOfVersions
12688 
12689  !Get normal wave direction
12690  normalwave=0.0_dp
12691  DO componentidx=1,2
12692  DO versionidx=1,numberofversions
12693  CALL field_parametersetgetlocalnode(independentfield,field_u_variable_type,field_values_set_type,versionidx, &
12694  & derivativeidx,nodeidx,componentidx,normalwave(componentidx,versionidx),err,error,*999)
12695  END DO
12696  END DO
12697  !!!-- F i n d b o u n d a r y n o d e s --!!!
12698  IF(abs(normalwave(1,1)) > zero_tolerance .OR. abs(normalwave(2,1))> zero_tolerance) THEN
12699  IF(numberofversions == 1 .AND. l2norm(normalwave(:,1)) > zero_tolerance) THEN
12700  versionidx = 1
12701  !Get material parameters
12702  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type,field_values_set_type,versionidx, &
12703  & derivativeidx,nodeidx,1,a0,err,error,*999)
12704  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type,field_values_set_type,versionidx, &
12705  & derivativeidx,nodeidx,2,e,err,error,*999)
12706  CALL field_parametersetgetlocalnode(materialsfield,field_v_variable_type,field_values_set_type,versionidx, &
12707  & derivativeidx,nodeidx,3,h0,err,error,*999)
12708  beta=(4.0_dp*(sqrt(pi))*e*h0)/(3.0_dp*a0)
12709  ! Get the boundary condition type for the dependent field primitive variables (Q,A)
12710  boundaryconditions=>solverequations%BOUNDARY_CONDITIONS
12711  NULLIFY(fieldvariable)
12712  CALL field_variable_get(dependentfield,field_u_variable_type,fieldvariable,err,error,*999)
12713  dependentdof = fieldvariable%COMPONENTS(2)%PARAM_TO_DOF_MAP% &
12714  & node_param2dof_map%NODES(nodeidx)%DERIVATIVES(derivativeidx)%VERSIONS(versionidx)
12715  CALL boundary_conditions_variable_get(boundaryconditions, &
12716  & fieldvariable,boundaryconditionsvariable,err,error,*999)
12717  boundaryconditiontype=boundaryconditionsvariable%CONDITION_TYPES(dependentdof)
12718  SELECT CASE(boundaryconditiontype)
12719 
12720  ! N o n - r e f l e c t i n g B o u n d a r y
12721  ! ----------------------------------------------------
12722  CASE(boundary_condition_fixed_nonreflecting)
12723  ! Outlet - set W2 to 0, get W1 from the extrapolated value
12724  IF(normalwave(1,1) > 0.0_dp) THEN
12725  CALL field_parametersetgetlocalnode(dependentfield,field_v_variable_type,field_values_set_type, &
12726  & versionidx,derivativeidx,nodeidx,1,w1,err,error,*999)
12727  w2 = 0.0_dp
12728  ! Inlet - set W1 to 0, get W2 from the extrapolated value
12729  ELSE
12730  w1 = 0.0_dp
12731  CALL field_parametersetgetlocalnode(dependentfield,field_v_variable_type,field_values_set_type, &
12732  & versionidx,derivativeidx,nodeidx,2,w2,err,error,*999)
12733  END IF
12734  ! Calculate new area value based on W1, W2 and update dof
12735  aboundary = (((2.0_dp*rho)/(beta))**2.0_dp)* &
12736  & (((w1-w2)/8.0_dp+sqrt(beta/(2.0_dp*rho))*((a0)**0.25_dp))**4.0_dp)
12737  CALL field_parameter_set_update_local_node(dependentfield,field_u_variable_type, &
12738  & field_values_set_type,versionidx,derivativeidx,nodeidx,2,aboundary,err,error,*999)
12739 
12740  ! C o u p l e d C e l l M L ( 0 D ) B o u n d a r y
12741  ! ------------------------------------------------------------
12742  CASE(boundary_condition_fixed_cellml)
12743  !Get qCellML used in pCellML calculation
12744  CALL field_parametersetgetlocalnode(dependentfield,field_u_variable_type,field_values_set_type, &
12745  & versionidx,derivativeidx,nodeidx,1,qcellml,err,error,*999)
12746  !Get pCellML if this is a coupled problem
12747  CALL field_parametersetgetlocalnode(dependentfield,field_u1_variable_type,field_values_set_type, &
12748  & versionidx,derivativeidx,nodeidx,2,pcellml,err,error,*999)
12749  ! Convert pCellML from SI base units specified in CellML file to scaled units (e.g., kg/(m.s^2) --> g/(mm.ms^2))
12750  pcellml = pcellml*massscale/(lengthscale*(timescale**2.0_dp))
12751  ! Convert pCellML --> A0D
12752  acellml=((pcellml-pexternal)/beta+sqrt(a0))**2.0_dp
12753  ! O u t l e t
12754  IF(normalwave(1,1) > 0.0_dp) THEN
12755  CALL field_parametersetgetlocalnode(dependentfield,field_v_variable_type,field_values_set_type, &
12756  & versionidx,derivativeidx,nodeidx,1,w1,err,error,*999)
12757  ! Calculate W2 from 0D domain
12758  w2 = qcellml/acellml - 4.0_dp*sqrt(beta/(2.0_dp*rho))*(acellml**0.25_dp - a0**0.25_dp)
12759  ! I n l e t
12760  ELSE
12761  ! Calculate W1 from 0D domain
12762  w1 = qcellml/acellml + 4.0_dp*sqrt(beta/(2.0_dp*rho))*(acellml**0.25_dp - a0**0.25_dp)
12763  ! Calculate W2 from 1D domain
12764  CALL field_parametersetgetlocalnode(dependentfield,field_v_variable_type,field_values_set_type, &
12765  & versionidx,derivativeidx,nodeidx,2,w2,err,error,*999)
12766  END IF
12767  ! Calculate new area value based on W1,W2 and update dof
12768  aboundary = (((2.0_dp*rho)/(beta))**2.0_dp)* &
12769  & (((w1-w2)/8.0_dp+sqrt(beta/(2.0_dp*rho))*((a0)**0.25_dp))**4.0_dp)
12770  CALL field_parameter_set_update_local_node(dependentfield,field_u_variable_type, &
12771  & field_values_set_type,versionidx,derivativeidx,nodeidx,2,aboundary,err,error,*999)
12772 
12773  ! S t r u c t u r e d T r e e B o u n d a r y
12774  ! ------------------------------------------------------------
12775  CASE(boundary_condition_fixed_stree)
12776  NULLIFY(impedance)
12777  NULLIFY(flow)
12778  !Get qCellML used in pCellML calculation
12779  CALL field_parametersetgetlocalnode(dependentfield,field_u_variable_type,field_values_set_type, &
12780  & versionidx,derivativeidx,nodeidx,1,qcellml,err,error,*999)
12781  !Get flow function
12782  CALL field_parameter_set_data_get(streematerialsfield,field_u_variable_type,field_values_set_type, &
12783  & impedance,err,error,*999)
12784  !Get impedance function
12785  CALL field_parameter_set_data_get(streematerialsfield,field_v_variable_type,field_values_set_type, &
12786  & flow,err,error,*999)
12787  pcellml = 0.0_dp
12788  DO k=1,size(flow)
12789  pcellml=pcellml+flow(k)*impedance(k)*timeincrement
12790  END DO
12791  ! Convert pCellML --> A0D
12792  acellml=((pcellml-pexternal)/beta+sqrt(a0))**2.0_dp
12793  ! O u t l e t
12794  IF(normalwave(1,1) > 0.0_dp) THEN
12795  CALL field_parametersetgetlocalnode(dependentfield,field_v_variable_type,field_values_set_type, &
12796  & versionidx,derivativeidx,nodeidx,1,w1,err,error,*999)
12797  ! Calculate W2 from 0D domain
12798  w2 = qcellml/acellml-4.0_dp*sqrt(beta/(2.0_dp*rho))*(acellml**0.25_dp-a0**0.25_dp)
12799  ! I n l e t
12800  ELSE
12801  ! Calculate W1 from 0D domain
12802  w1 = qcellml/acellml+4.0_dp*sqrt(beta/(2.0_dp*rho))*(acellml**0.25_dp-a0**0.25_dp)
12803  ! Calculate W2 from 1D domain
12804  CALL field_parametersetgetlocalnode(dependentfield,field_v_variable_type,field_values_set_type, &
12805  & versionidx,derivativeidx,nodeidx,2,w2,err,error,*999)
12806  END IF
12807  ! Calculate new area value based on W1, W2 and update dof
12808  aboundary = (((2.0_dp*rho)/(beta))**2.0_dp)* &
12809  & (((w1-w2)/8.0_dp+sqrt(beta/(2.0_dp*rho))*((a0)**0.25_dp))**4.0_dp)
12810  CALL field_parameter_set_update_local_node(dependentfield,field_u_variable_type, &
12811  & field_values_set_type,versionidx,derivativeidx,nodeidx,2,aboundary,err,error,*999)
12812 
12813  CASE(boundary_condition_free, &
12814  & boundary_condition_fixed, &
12815  & boundary_condition_fixed_inlet, &
12816  & boundary_condition_fixed_outlet, &
12817  & boundary_condition_fixed_fitted)
12818  ! Do nothing
12819 
12820  CASE DEFAULT
12821  localerror="The boundary conditions type "//trim(number_to_vstring(boundaryconditiontype,"*",err,error))// &
12822  & " is not valid for a coupled characteristic problem."
12823  CALL flagerror(localerror,err,error,*999)
12824  END SELECT
12825 
12826  END IF ! boundary node
12827  END IF ! branch or boundary node
12828  END DO !Loop over nodes
12829 
12830  !!!-- 3 D E q u a t i o n s S e t --!!!
12831  CASE(equations_set_static_navier_stokes_subtype, &
12832  & equations_set_laplace_navier_stokes_subtype, &
12833  & equations_set_static_rbs_navier_stokes_subtype, &
12834  & equations_set_transient_navier_stokes_subtype, &
12835  & equations_set_ale_navier_stokes_subtype, &
12836  & equations_set_pgm_navier_stokes_subtype, &
12837  & equations_set_quasistatic_navier_stokes_subtype, &
12838  & equations_set_transient_rbs_navier_stokes_subtype, &
12839  & equations_set_multiscale3d_navier_stokes_subtype)
12840  ! Do nothing
12841 
12842  CASE DEFAULT
12843  localerror="Equations set subtype "//trim(number_to_vstring(equationsset%specification(3),"*",err,error))// &
12844  & " is not valid for a Navier-Stokes equation type of a fluid mechanics equations set class."
12845  CALL flagerror(localerror,err,error,*999)
12846  END SELECT
12847 
12848  exits("NavierStokes_UpdateMultiscaleBoundary")
12849  RETURN
12850 999 errorsexits("NavierStokes_UpdateMultiscaleBoundary",err,error)
12851  RETURN 1
12852 
12853  END SUBROUTINE navierstokes_updatemultiscaleboundary
12854 
12855  !
12856  !================================================================================================================================
12857  !
12858 
12859 END MODULE navier_stokes_equations_routines
equations_set_constants::equations_set_setup_dependent_type
integer(intg), parameter equations_set_setup_dependent_type
Dependent variables.
Definition: equations_set_constants.f90:324
equations_set_constants::equations_set_fem_solution_method
integer(intg), parameter equations_set_fem_solution_method
Finite Element Method solution method.
Definition: equations_set_constants.f90:348
basis_routines
This module contains all basis function routines.
Definition: basis_routines.f90:45
equations_set_constants::equations_set_setup_materials_type
integer(intg), parameter equations_set_setup_materials_type
Materials setup.
Definition: equations_set_constants.f90:326
types::boundary_conditions_type
Contains information on the boundary conditions for the solver equations.
Definition: types.f90:1780
base_routines::enters
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Definition: base_routines.f90:363
input_output::write_string_value
Write a string followed by a value to a given output stream.
Definition: input_output.f90:86
boundary_conditions_routines::boundary_condition_moved_wall
integer(intg), parameter, public boundary_condition_moved_wall
The dof is fixed as a boundary condition.
Definition: boundary_condition_routines.f90:99
solver_routines::solvers_create_finish
subroutine, public solvers_create_finish(SOLVERS, ERR, ERROR,)
Finish the creation of solvers.
Definition: solver_routines.f90:22598
kinds::ptr
integer, parameter ptr
Pointer integer kind.
Definition: kinds.f90:58
equations_set_constants::equations_set_laplace_navier_stokes_subtype
integer(intg), parameter equations_set_laplace_navier_stokes_subtype
Definition: equations_set_constants.f90:168
constants::second_part_deriv
integer(intg), parameter second_part_deriv
Second partial derivative i.e., d^2u/ds^2.
Definition: constants.f90:179
equations_mapping_routines::equations_mapping_dynamic_variable_type_set
subroutine, public equations_mapping_dynamic_variable_type_set(EQUATIONS_MAPPING, DYNAMIC_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set dynamic matrices...
Definition: equations_mapping_routines.f90:1996
problem_constants::problem_quasistatic_navier_stokes_subtype
integer(intg), parameter problem_quasistatic_navier_stokes_subtype
Definition: problem_constants.f90:148
advection_equation_routines
This module handles pure advection equation routines.
Definition: advection_equation_routines.f90:45
coordinate_routines
This module contains all coordinate transformation and support routines.
Definition: coordinate_routines.f90:45
types::equations_jacobian_type
Contains information on the Jacobian matrix for nonlinear problems.
Definition: types.f90:1451
types::equations_mapping_type
Contains information on the equations mapping i.e., how field variable DOFS are mapped to the rows an...
Definition: types.f90:1681
types::cellml_equations_type
Contains information about the CellML equations for a solver.
Definition: types.f90:2475
types::equations_type
Contains information about the equations in an equations set.
Definition: types.f90:1735
equations_set_constants::equations_set_gfem_solution_method
integer(intg), parameter equations_set_gfem_solution_method
Grid-based Finite Element Method solution method.
Definition: equations_set_constants.f90:352
types::region_type
Contains information for a region.
Definition: types.f90:3252
problem_constants::problem_control_time_loop_type
integer(intg), parameter problem_control_time_loop_type
Time control loop.
Definition: problem_constants.f90:283
problem_constants::problem_setup_control_type
integer(intg), parameter problem_setup_control_type
Solver setup for a problem.
Definition: problem_constants.f90:263
problem_constants
This module handles all problem wide constants.
Definition: problem_constants.f90:45
problem_constants::solver_equations_first_order_dynamic
integer(intg), parameter solver_equations_first_order_dynamic
Solver equations are first order dynamic.
Definition: problem_constants.f90:311
control_loop_routines::control_loop_node
integer(intg), parameter, public control_loop_node
The identifier for a each "leaf" node in a control loop.
Definition: control_loop_routines.f90:67
maths::matrix_transpose
Returns the transpose of a matrix A in A^T.
Definition: maths.f90:191
solver_routines::solver_dynamic_order_set
subroutine, public solver_dynamic_order_set(SOLVER, ORDER, ERR, ERROR,)
Sets/changes the order for a dynamic solver.
Definition: solver_routines.f90:6327
constants::no_global_deriv
integer(intg), parameter no_global_deriv
No global derivative i.e., u.
Definition: constants.f90:213
advection_equation_routines::advection_pre_solve
subroutine, public advection_pre_solve(SOLVER, ERR, ERROR,)
Sets up the Poisson problem pre solve.
Definition: advection_equation_routines.f90:1079
control_loop_routines::control_loop_maximum_iterations_set
subroutine, public control_loop_maximum_iterations_set(CONTROL_LOOP, MAXIMUM_ITERATIONS, ERR, ERROR,)
Sets the maximum number of iterations for a while or load increment control loop. ...
Definition: control_loop_routines.f90:782
strings::number_to_vstring
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
equations_routines::equations_create_start
subroutine, public equations_create_start(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Start the creation of equations for the equation set.
Definition: equations_routines.f90:192
types::decomposition_type
Contains information on the mesh decomposition.
Definition: types.f90:1063
equations_set_constants::equations_set_constitutive_mu_navier_stokes_subtype
integer(intg), parameter equations_set_constitutive_mu_navier_stokes_subtype
Definition: equations_set_constants.f90:184
equations_set_constants::equations_set_stokes_equation_two_dim_3
integer(intg), parameter equations_set_stokes_equation_two_dim_3
u=tbd
Definition: equations_set_constants.f90:490
control_loop_routines::control_loop_sub_loop_get
subroutine, public control_loop_sub_loop_get(CONTROL_LOOP, SUB_LOOP_INDEX, SUB_LOOP, ERR, ERROR,)
Gets/returns a pointer to the sub loops as specified by the sub loop index for a control loop...
Definition: control_loop_routines.f90:1417
equations_matrices_routines::equations_matrices_create_start
subroutine, public equations_matrices_create_start(EQUATIONS, EQUATIONS_MATRICES, ERR, ERROR,)
Starts the creation of the equations matrices and rhs for the the equations.
Definition: equations_matrices_routines.f90:615
types::solver_type
Contains information on the type of solver to be used.
Definition: types.f90:2777
solver_routines::solver_petsc_library
integer(intg), parameter, public solver_petsc_library
PETSc solver library.
Definition: solver_routines.f90:104
constants::pi
real(dp), parameter pi
The double precision value of pi.
Definition: constants.f90:57
solver_routines::solvers_number_set
subroutine, public solvers_number_set(SOLVERS, NUMBER_OF_SOLVERS, ERR, ERROR,)
Sets/changes the number of solvers.
Definition: solver_routines.f90:22805
constants::no_part_deriv
integer(intg), parameter no_part_deriv
No partial derivative i.e., u.
Definition: constants.f90:177
solver_routines::solver_dae_time_step_set
subroutine, public solver_dae_time_step_set(SOLVER, TIME_STEP, ERR, ERROR,)
Set/change the (initial) time step size for a differential-algebraic equation solver.
Definition: solver_routines.f90:5047
solver_routines::solver_dynamic_crank_nicolson_scheme
integer(intg), parameter, public solver_dynamic_crank_nicolson_scheme
Crank-Nicolson dynamic solver.
Definition: solver_routines.f90:282
solver_routines::solver_dynamic_degree_set
subroutine, public solver_dynamic_degree_set(SOLVER, DEGREE, ERR, ERROR,)
Sets/changes the degree of the polynomial used to interpolate time for a dynamic solver.
Definition: solver_routines.f90:5484
equations_matrices_routines
This module handles all equations matrix and rhs routines.
Definition: equations_matrices_routines.f90:45
solver_routines::solver_dynamic_first_order
integer(intg), parameter, public solver_dynamic_first_order
Dynamic solver has first order terms.
Definition: solver_routines.f90:255
equations_set_constants::equations_set_navier_stokes_equation_two_dim_4
integer(intg), parameter equations_set_navier_stokes_equation_two_dim_4
u=tbd
Definition: equations_set_constants.f90:505
equations_set_constants::equations_set_navier_stokes_equation_splint_from_file
integer(intg), parameter equations_set_navier_stokes_equation_splint_from_file
Spline integration of dependent values specified in a file.
Definition: equations_set_constants.f90:518
solver_routines::solver_type_set
subroutine, public solver_type_set(SOLVER, SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type for a solver.
Definition: solver_routines.f90:21345
equations_set_constants::equations_static
integer(intg), parameter equations_static
The equations are static and have no time dependence.
Definition: equations_set_constants.f90:376
equations_set_constants::equations_set_navier_stokes_equation_two_dim_1
integer(intg), parameter equations_set_navier_stokes_equation_two_dim_1
u=tbd
Definition: equations_set_constants.f90:502
types::equations_set_type
Contains information on an equations set.
Definition: types.f90:1941
equations_routines
This module handles all equations routines.
Definition: equations_routines.f90:45
solver_routines::solver_dae_type
integer(intg), parameter, public solver_dae_type
A differential-algebraic equation solver.
Definition: solver_routines.f90:91
equations_set_constants::equations_set_setup_source_type
integer(intg), parameter equations_set_setup_source_type
Source setup.
Definition: equations_set_constants.f90:327
equations_set_constants::equations_set_navier_stokes_equation_one_dim_1
integer(intg), parameter equations_set_navier_stokes_equation_one_dim_1
u=tbd
Definition: equations_set_constants.f90:512
types::fields_type
Contains information on the fields defined on a region.
Definition: types.f90:1373
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
solver_routines::solvers_create_start
subroutine, public solvers_create_start(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Start the creation of a solvers for the control loop.
Definition: solver_routines.f90:22651
types::solvers_type
Contains information on the solvers to be used in a control loop.
Definition: types.f90:2805
problem_constants::problem_control_simple_type
integer(intg), parameter problem_control_simple_type
Simple, one iteration control loop.
Definition: problem_constants.f90:281
equations_set_constants::equations_set_navier_stokes_equation_flowrate_olufsen
integer(intg), parameter equations_set_navier_stokes_equation_flowrate_olufsen
A fourier decomposed flow waveform for boundary conditions.
Definition: equations_set_constants.f90:519
equations_mapping_routines::equations_mapping_dynamic_matrices_set
Definition: equations_mapping_routines.f90:83
constants::first_part_deriv
integer(intg), parameter first_part_deriv
First partial derivative i.e., du/ds.
Definition: constants.f90:178
solver_routines::solver_dynamic_linearity_type_set
subroutine, public solver_dynamic_linearity_type_set(SOLVER, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for the dynamic solver.
Definition: solver_routines.f90:5758
solver_routines::solver_newton_cellml_solver_get
subroutine, public solver_newton_cellml_solver_get(SOLVER, CELLML_SOLVER, ERR, ERROR,)
Returns the CellML solver associated with a Newton solver.
Definition: solver_routines.f90:18100
timer
This module contains routines for timing the program.
Definition: timer_f.f90:45
control_loop_routines::control_loop_current_times_get
subroutine, public control_loop_current_times_get(CONTROL_LOOP, CURRENT_TIME, TIME_INCREMENT, ERR, ERROR,)
Gets the current time parameters for a time control loop.
Definition: control_loop_routines.f90:231
fluid_mechanics_io_routines::fluidmechanics_io_updateboundaryconditionupdatenodes
subroutine, public fluidmechanics_io_updateboundaryconditionupdatenodes(GeometricField, SolverType, InletNodes, BoundaryValues, BoundaryCondition, Option, Time, StopTime)
Updates the boundary condition for a given node and component.
Definition: fluid_mechanics_IO_routines.f90:4245
basis_routines::basis_simplex_type
integer(intg), parameter, public basis_simplex_type
Simplex basis type.
Definition: basis_routines.f90:69
problem_constants::solver_equations_static
integer(intg), parameter solver_equations_static
Solver equations are static.
Definition: problem_constants.f90:309
problem_constants::problem_laplace_navier_stokes_subtype
integer(intg), parameter problem_laplace_navier_stokes_subtype
Definition: problem_constants.f90:141
constants::part_deriv_s2
integer(intg), parameter part_deriv_s2
First partial derivative in the s2 direction i.e., du/ds2.
Definition: constants.f90:183
equations_routines::equations_time_dependence_type_set
subroutine, public equations_time_dependence_type_set(EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for equations.
Definition: equations_routines.f90:851
maths::spline_cubic_val
subroutine, public spline_cubic_val(n, t, y, ypp, tval, yval, ypval, yppval, err, error,)
Evaluates a cubic spline at a specified point. First call spline_cubic_set to calculate derivatives a...
Definition: maths.f90:2730
solver_routines::solver_equations_sparsity_type_set
subroutine, public solver_equations_sparsity_type_set(SOLVER_EQUATIONS, SPARSITY_TYPE, ERR, ERROR,)
Sets/changes the sparsity type for solver equations.
Definition: solver_routines.f90:7734
analytic_analysis_routines
This module handles all analytic analysis routines.
Definition: analytic_analysis_routines.f90:45
equations_set_constants::equations_set_navier_stokes_equation_three_dim_3
integer(intg), parameter equations_set_navier_stokes_equation_three_dim_3
u=tbd
Definition: equations_set_constants.f90:509
maths::spline_cubic_set
subroutine, public spline_cubic_set(n, t, y, ibcbeg, ybcbeg, ibcend, ybcend, ypp, err, error,)
Calculates second derivatives of a cubic spline function for a tabulated function y(x)...
Definition: maths.f90:2575
maths
This module contains all mathematics support routines.
Definition: maths.f90:45
solver_routines::solvers_solver_get
subroutine, public solvers_solver_get(SOLVERS, SOLVER_INDEX, SOLVER, ERR, ERROR,)
Returns a pointer to the specified solver in the list of solvers.
Definition: solver_routines.f90:22876
types::field_type
Contains information for a field defined on a region.
Definition: types.f90:1346
equations_matrices_routines::equations_matrices_full_matrices
integer(intg), parameter, public equations_matrices_full_matrices
Use fully populated equation matrices.
Definition: equations_matrices_routines.f90:91
equations_set_constants::equations_set_navier_stokes_equation_two_dim_5
integer(intg), parameter equations_set_navier_stokes_equation_two_dim_5
u=tbd
Definition: equations_set_constants.f90:506
problem_constants::problem_coupled1d0d_navier_stokes_subtype
integer(intg), parameter problem_coupled1d0d_navier_stokes_subtype
Definition: problem_constants.f90:150
equations_set_constants::equations_set_fluid_mechanics_class
integer(intg), parameter equations_set_fluid_mechanics_class
Definition: equations_set_constants.f90:55
equations_mapping_routines::equations_mapping_rhs_variable_type_set
subroutine, public equations_mapping_rhs_variable_type_set(EQUATIONS_MAPPING, RHS_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set rhs vector.
Definition: equations_mapping_routines.f90:3170
problem_constants::solver_equations_linear
integer(intg), parameter solver_equations_linear
Solver equations are linear.
Definition: problem_constants.f90:301
constants::global_deriv_s2
integer(intg), parameter global_deriv_s2
First global derivative in the s2 direction i.e., du/ds2.
Definition: constants.f90:215
types::control_loop_type
Contains information on a control loop.
Definition: types.f90:3185
iso_varying_string
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
Definition: iso_varying_string.f90:62
solver_routines::solver_equations_create_finish
subroutine, public solver_equations_create_finish(SOLVER_EQUATIONS, ERR, ERROR,)
Finishes the process of creating solver equations.
Definition: solver_routines.f90:7166
solver_routines::solver_sparse_matrices
integer(intg), parameter, public solver_sparse_matrices
Use sparse solver matrices.
Definition: solver_routines.f90:360
solver_routines::solver_equations_create_start
subroutine, public solver_equations_create_start(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Starts the process of creating solver equations.
Definition: solver_routines.f90:7209
solver_routines::solver_dynamic_type
integer(intg), parameter, public solver_dynamic_type
A dynamic solver.
Definition: solver_routines.f90:90
equations_set_constants::equations_set_stokes_equation_three_dim_4
integer(intg), parameter equations_set_stokes_equation_three_dim_4
u=tbd
Definition: equations_set_constants.f90:496
types::equations_set_equations_set_field_type
Definition: types.f90:1933
basis_routines::basis_default_quadrature_scheme
integer(intg), parameter, public basis_default_quadrature_scheme
Identifier for the default quadrature scheme.
Definition: basis_routines.f90:125
boundary_conditions_routines::boundary_condition_fixed_stree
integer(intg), parameter, public boundary_condition_fixed_stree
The dof is fixed and set to values specified based on the transmission line theory at the dof...
Definition: boundary_condition_routines.f90:118
problem_constants::problem_setup_solvers_type
integer(intg), parameter problem_setup_solvers_type
Solver setup for a problem.
Definition: problem_constants.f90:264
equations_set_constants::equations_set_setup_equations_type
integer(intg), parameter equations_set_setup_equations_type
Equations setup.
Definition: equations_set_constants.f90:330
types::equations_mapping_dynamic_type
Contains information for mapping field variables to the dynamic matrices in the equations set of the ...
Definition: types.f90:1571
equations_set_constants::equations_set_ale_navier_stokes_subtype
integer(intg), parameter equations_set_ale_navier_stokes_subtype
Definition: equations_set_constants.f90:171
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
stree_equation_routines
This module handles all Stree equation routines.
Definition: stree_equation_routines.f90:49
equations_set_constants::equations_set_setup_independent_type
integer(intg), parameter equations_set_setup_independent_type
Independent variables.
Definition: equations_set_constants.f90:325
constants
This module contains all program wide constants.
Definition: constants.f90:45
problem_constants::solver_equations_nonlinear
integer(intg), parameter solver_equations_nonlinear
Solver equations are nonlinear.
Definition: problem_constants.f90:302
solver_routines::solver_library_type_set
subroutine, public solver_library_type_set(SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library type to use for the solver.
Definition: solver_routines.f90:9067
boundary_conditions_routines::boundary_condition_fixed_inlet
integer(intg), parameter, public boundary_condition_fixed_inlet
The dof is fixed as a boundary condition.
Definition: boundary_condition_routines.f90:96
constants::part_deriv_s1
integer(intg), parameter part_deriv_s1
First partial derivative in the s1 direction i.e., du/ds1.
Definition: constants.f90:181
base_routines::flag_warning
Flags a warning to the user.
Definition: base_routines.f90:232
equations_mapping_routines::equationsmapping_linearmatricesnumberset
subroutine, public equationsmapping_linearmatricesnumberset(EQUATIONS_MAPPING, NUMBER_OF_LINEAR_EQUATIONS_MATRICES, ERR, ERROR,)
Sets/changes the number of linear equations matrices.
Definition: equations_mapping_routines.f90:2484
equations_set_constants::equations_set_navier_stokes_equation_sinusoid
integer(intg), parameter equations_set_navier_stokes_equation_sinusoid
A sinusoidal flow waveform.
Definition: equations_set_constants.f90:516
problem_constants::problem_transient1d_navier_stokes_subtype
integer(intg), parameter problem_transient1d_navier_stokes_subtype
Definition: problem_constants.f90:149
control_loop_routines::control_loop_times_get
subroutine, public control_loop_times_get(CONTROL_LOOP, START_TIME, STOP_TIME, CURRENT_TIME, TIME_INCREMENT, CURRENT_LOOP_ITERATION, OUTPUT_ITERATION_NUMBER, ERR, ERROR,)
Gets the current time parameters for a time control loop.
Definition: control_loop_routines.f90:1532
equations_set_constants::equations_set_navier_stokes_equation_two_dim_taylor_green
integer(intg), parameter equations_set_navier_stokes_equation_two_dim_taylor_green
2D dynamic nonlinear Taylor-Green vortex decay
Definition: equations_set_constants.f90:514
types::decomposition_face_type
Contains the information for a face in a decomposition.
Definition: types.f90:979
equations_set_constants::equations_set_navier_stokes_equation_flowrate_aorta
integer(intg), parameter equations_set_navier_stokes_equation_flowrate_aorta
A fourier decomposed flow waveform for boundary conditions.
Definition: equations_set_constants.f90:515
equations_set_constants::equations_set_navier_stokes_equation_two_dim_poiseuille
integer(intg), parameter equations_set_navier_stokes_equation_two_dim_poiseuille
fully developed 2D channel flow (parabolic), u=u_max(1-y^2/H^2)
Definition: equations_set_constants.f90:513
equations_set_constants::equations_set_stokes_equation_two_dim_2
integer(intg), parameter equations_set_stokes_equation_two_dim_2
u=tbd
Definition: equations_set_constants.f90:489
equations_set_constants::equations_set_navier_stokes_equation_three_dim_5
integer(intg), parameter equations_set_navier_stokes_equation_three_dim_5
u=tbd
Definition: equations_set_constants.f90:511
problem_constants::problem_setup_initial_type
integer(intg), parameter problem_setup_initial_type
Initial setup for a problem.
Definition: problem_constants.f90:262
boundary_conditions_routines::boundary_condition_fixed_nonreflecting
integer(intg), parameter, public boundary_condition_fixed_nonreflecting
The dof is fixed and set to a non-reflecting type for 1D wave propagation problems.
Definition: boundary_condition_routines.f90:116
types::field_interpolated_point_metrics_type
Contains the interpolated point coordinate metrics. Old CMISS name GL,GU,RG.
Definition: types.f90:1112
types::domain_elements_type
Contains the topology information for the elements of a domain.
Definition: types.f90:677
problem_constants::problem_ale_navier_stokes_subtype
integer(intg), parameter problem_ale_navier_stokes_subtype
Definition: problem_constants.f90:146
equations_mapping_routines::equationsmapping_linearmatricesvariabletypesset
subroutine, public equationsmapping_linearmatricesvariabletypesset(EQUATIONS_MAPPING, LINEAR_MATRIX_VARIABLE_TYPES, ERR, ERROR,)
Sets the mapping between the dependent field variable types and the linear equations matrices...
Definition: equations_mapping_routines.f90:2716
types::problem_setup_type
Definition: types.f90:3215
fluid_mechanics_io_routines::fluid_mechanics_io_read_data
subroutine, public fluid_mechanics_io_read_data(SOLVER_TYPE, INPUT_VALUES, NUMBER_OF_DIMENSIONS, INPUT_TYPE, INPUT_OPTION, TIME_STEP, LENGTH_SCALE)
Reads input data from a file.
Definition: fluid_mechanics_IO_routines.f90:4319
equations_set_constants::equations_set_stokes_equation_two_dim_4
integer(intg), parameter equations_set_stokes_equation_two_dim_4
u=tbd
Definition: equations_set_constants.f90:491
boundary_conditions_routines::boundary_condition_free
integer(intg), parameter, public boundary_condition_free
The dof is free.
Definition: boundary_condition_routines.f90:94
types::nonlinear_solver_type
Contains information for a nonlinear solver.
Definition: types.f90:2731
problem_constants::problem_navier_stokes_equation_type
integer(intg), parameter problem_navier_stokes_equation_type
Definition: problem_constants.f90:74
characteristic_equation_routines::characteristic_extrapolate
subroutine, public characteristic_extrapolate(solver, currentTime, timeIncrement, ERR, ERROR,)
Extrapolate W for branch nodes and boundaries .
Definition: characteristic_equation_routines.f90:1321
equations_set_constants::equations_first_order_dynamic
integer(intg), parameter equations_first_order_dynamic
The equations are first order dynamic.
Definition: equations_set_constants.f90:378
types::boundary_conditions_variable_type
Contains information on the boundary conditions for a dependent field variable.
Definition: types.f90:1759
problem_constants::solver_equations_quasistatic
integer(intg), parameter solver_equations_quasistatic
Solver equations are quasistatic.
Definition: problem_constants.f90:310
solver_routines::solver_equations_linearity_type_set
subroutine, public solver_equations_linearity_type_set(SOLVER_EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for solver equations.
Definition: solver_routines.f90:7577
equations_set_constants::equations_set_setup_start_action
integer(intg), parameter equations_set_setup_start_action
Start setup action.
Definition: equations_set_constants.f90:338
solver_routines::cellml_equations_create_start
subroutine, public cellml_equations_create_start(SOLVER, CELLML_EQUATIONS, ERR, ERROR,)
Starts the process of creating CellML equations.
Definition: solver_routines.f90:818
equations_matrices_routines::equationsmatrices_nonlinearstoragetypeset
Sets the storage type (sparsity) of the nonlinear (Jacobian) equations matrices.
Definition: equations_matrices_routines.f90:199
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
control_loop_routines::control_loop_solvers_get
recursive subroutine, public control_loop_solvers_get(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Returns a pointer to the solvers for a control loop.
Definition: control_loop_routines.f90:1333
equations_set_constants::equations_set_mooney_rivlin_subtype
integer(intg), parameter equations_set_mooney_rivlin_subtype
Definition: equations_set_constants.f90:121
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
solver_routines::solver_cellml_equations_get
subroutine, public solver_cellml_equations_get(SOLVER, CELLML_EQUATIONS, ERR, ERROR,)
Returns a pointer to the CellML equations for a solver.
Definition: solver_routines.f90:947
boundary_conditions_routines::boundary_condition_fixed_outlet
integer(intg), parameter, public boundary_condition_fixed_outlet
The dof is fixed as a boundary condition.
Definition: boundary_condition_routines.f90:97
equations_set_constants::equations_set_elasticity_class
integer(intg), parameter equations_set_elasticity_class
Definition: equations_set_constants.f90:54
equations_set_constants::equations_set_coupled1d0d_navier_stokes_subtype
integer(intg), parameter equations_set_coupled1d0d_navier_stokes_subtype
Definition: equations_set_constants.f90:178
types::equations_mapping_nonlinear_type
Contains information on the equations mapping for nonlinear matrices i.e., how a field variable is ma...
Definition: types.f90:1623
types::equations_matrices_type
Contains information on the equations matrices and vectors.
Definition: types.f90:1520
equations_matrices_routines::equations_matrix_fem_structure
integer(intg), parameter, public equations_matrix_fem_structure
Finite element matrix structure.
Definition: equations_matrices_routines.f90:72
constants::part_deriv_s3
integer(intg), parameter part_deriv_s3
First partial derivative in the s3 direction i.e., du/ds3.
Definition: constants.f90:186
problem_constants::problem_multiscale_navier_stokes_subtype
integer(intg), parameter problem_multiscale_navier_stokes_subtype
Definition: problem_constants.f90:144
input_output::write_string
Write a string to a given output stream.
Definition: input_output.f90:74
base_routines
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
Definition: base_routines.f90:45
types::equations_matrices_linear_type
Contains information of the linear matrices for equations matrices.
Definition: types.f90:1479
base_routines::general_output_type
integer(intg), parameter, public general_output_type
General output type.
Definition: base_routines.f90:66
equations_matrices_routines::equationsmatrices_dynamicstructuretypeset
subroutine, public equationsmatrices_dynamicstructuretypeset(EQUATIONS_MATRICES, STRUCTURE_TYPE, ERR, ERROR,)
Sets the structure (sparsity) of the dynamic equations matrices.
Definition: equations_matrices_routines.f90:4090
types::solver_matrix_type
Contains information on the solver matrix.
Definition: types.f90:2411
constants::part_deriv_s1_s1
integer(intg), parameter part_deriv_s1_s1
Second partial derivative in the s1 direction i.e., d^2u/ds1ds1.
Definition: constants.f90:182
iso_varying_string::trim
Definition: iso_varying_string.f90:204
equations_set_constants::equations_set_stokes_equation_three_dim_2
integer(intg), parameter equations_set_stokes_equation_three_dim_2
u=tbd
Definition: equations_set_constants.f90:494
lapack
This module contains the interface descriptions to the LAPACK routines.
Definition: lapack.f90:45
equations_matrices_routines::equations_matrices_linear_storage_type_set
subroutine, public equations_matrices_linear_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the linear equations matrices.
Definition: equations_matrices_routines.f90:3898
equations_matrices_routines::equationsmatrices_linearstructuretypeset
subroutine, public equationsmatrices_linearstructuretypeset(EQUATIONS_MATRICES, STRUCTURE_TYPE, ERR, ERROR,)
Sets the structure (sparsity) of the linear equations matrices.
Definition: equations_matrices_routines.f90:4160
equations_mapping_routines::equations_mapping_create_finish
subroutine, public equations_mapping_create_finish(EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping.
Definition: equations_mapping_routines.f90:982
equations_set_constants::equations_set_stokes_equation_three_dim_3
integer(intg), parameter equations_set_stokes_equation_three_dim_3
u=tbd
Definition: equations_set_constants.f90:495
control_loop_routines::controlloop_absolutetoleranceset
subroutine, public controlloop_absolutetoleranceset(controlLoop, absoluteTolerance, err, error,)
Sets the absolute tolerance (convergence condition tolerance) for a while control loop...
Definition: control_loop_routines.f90:903
control_loop_routines::control_loop_get
Returns the specified control loop as indexed by the control loop identifier from the control loop ro...
Definition: control_loop_routines.f90:86
control_loop_routines::control_loop_type_set
subroutine, public control_loop_type_set(CONTROL_LOOP, LOOP_TYPE, ERR, ERROR,)
Sets/changes the control loop type.
Definition: control_loop_routines.f90:1750
problem_constants::problem_multi_physics_class
integer(intg), parameter problem_multi_physics_class
Definition: problem_constants.f90:63
equations_set_constants::equations_set_navier_stokes_equation_three_dim_2
integer(intg), parameter equations_set_navier_stokes_equation_three_dim_2
u=tbd
Definition: equations_set_constants.f90:508
problem_constants::problem_coupled1d0d_adv_navier_stokes_subtype
integer(intg), parameter problem_coupled1d0d_adv_navier_stokes_subtype
Definition: problem_constants.f90:152
equations_set_constants::equations_set_stokes_equation_three_dim_1
integer(intg), parameter equations_set_stokes_equation_three_dim_1
u=tbd
Definition: equations_set_constants.f90:493
equations_set_constants::equations_set_quasistatic_navier_stokes_subtype
integer(intg), parameter equations_set_quasistatic_navier_stokes_subtype
Definition: equations_set_constants.f90:173
constants::part_deriv_s2_s3
integer(intg), parameter part_deriv_s2_s3
Cross derivative in the s2 and s3 direction i.e., d^2u/ds2ds3.
Definition: constants.f90:189
equations_set_constants::equations_set_navier_stokes_equation_two_dim_3
integer(intg), parameter equations_set_navier_stokes_equation_two_dim_3
u=tbd
Definition: equations_set_constants.f90:504
solver_routines::solver_nonlinear_type
integer(intg), parameter, public solver_nonlinear_type
A nonlinear solver.
Definition: solver_routines.f90:89
equations_set_constants::equations_set_navier_stokes_equation_three_dim_4
integer(intg), parameter equations_set_navier_stokes_equation_three_dim_4
u=tbd
Definition: equations_set_constants.f90:510
equations_set_constants::equations_set_static_navier_stokes_subtype
integer(intg), parameter equations_set_static_navier_stokes_subtype
Definition: equations_set_constants.f90:167
equations_matrices_routines::equations_jacobian_analytic_calculated
integer(intg), parameter, public equations_jacobian_analytic_calculated
Use an analytic Jacobian evaluation.
Definition: equations_matrices_routines.f90:116
constants::part_deriv_s1_s3
integer(intg), parameter part_deriv_s1_s3
Cross derivative in the s1 and s3 direction i.e., d^2u/ds1ds3.
Definition: constants.f90:188
equations_routines::equations_set_equations_get
subroutine, public equations_set_equations_get(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Gets the equations for an equations set.
Definition: equations_routines.f90:897
comp_environment
This module contains all computational environment variables.
Definition: computational_environment.f90:46
equations_set_constants::equations_set_navier_stokes_equation_flowrate_heart
integer(intg), parameter equations_set_navier_stokes_equation_flowrate_heart
A fourier decomposed flow waveform for boundary conditions.
Definition: equations_set_constants.f90:520
solver_routines::solver_cellml_evaluator_type
integer(intg), parameter, public solver_cellml_evaluator_type
A CellML evaluation solver.
Definition: solver_routines.f90:94
types::equations_set_materials_type
Definition: types.f90:1881
equations_matrices_routines::equationsmatrices_nonlinearstructuretypeset
Sets the structure (sparsity) of the nonlinear (Jacobian) equations matrices.
Definition: equations_matrices_routines.f90:205
cmiss_mpi
This module contains CMISS MPI routines.
Definition: cmiss_mpi.f90:45
constants::partial_derivative_first_derivative_map
integer(intg), dimension(4) partial_derivative_first_derivative_map
PARTIAL_DERIVATIVE_FIRST_DERIVATIVE_MAP(nic) gives the partial derivative index for the first derivat...
Definition: constants.f90:254
equations_routines::equations_create_finish
subroutine, public equations_create_finish(EQUATIONS, ERR, ERROR,)
Finish the creation of equations.
Definition: equations_routines.f90:159
types::control_loop_while_type
Contains information on a do-while control loop.
Definition: types.f90:3163
domain_mappings
This module handles all domain mappings routines.
Definition: domain_mappings.f90:45
problem_constants::problem_setup_finish_action
integer(intg), parameter problem_setup_finish_action
Finish setup action.
Definition: problem_constants.f90:274
boundary_conditions_routines::boundary_condition_fixed_cellml
integer(intg), parameter, public boundary_condition_fixed_cellml
The dof is fixed and set to values specified based on the coupled CellML solution at the dof...
Definition: boundary_condition_routines.f90:117
equations_mapping_routines
This module handles all equations mapping routines.
Definition: equations_mapping_routines.f90:45
types::solver_equations_type
Contains information about the solver equations for a solver.
Definition: types.f90:2452
matrix_vector::matrix_compressed_row_storage_type
integer(intg), parameter, public matrix_compressed_row_storage_type
Matrix compressed row storage type.
Definition: matrix_vector.f90:167
equations_matrices_routines::equations_matrices_dynamic_storage_type_set
subroutine, public equations_matrices_dynamic_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the dynamic equations matrices.
Definition: equations_matrices_routines.f90:3824
stree_equation_routines::stree_pre_solve
subroutine, public stree_pre_solve(solver, err, error,)
Evaluates the residual nodal stiffness matrices and RHS for a Stree equation nodal equations set...
Definition: stree_equation_routines.f90:757
comp_environment::computational_environment
type(computational_environment_type), target, public computational_environment
The computational environment the program is running in.
Definition: computational_environment.f90:125
types::equations_set_analytic_type
Contains information on the analytic setup for the equations set.
Definition: types.f90:1923
equations_set_constants::equations_set_static_rbs_navier_stokes_subtype
integer(intg), parameter equations_set_static_rbs_navier_stokes_subtype
Definition: equations_set_constants.f90:179
solver_routines::solver_newton_cellml_evaluator_create
subroutine, public solver_newton_cellml_evaluator_create(SOLVER, CELLML_SOLVER, ERR, ERROR,)
Create a CellML evaluator solver for the Newton solver.
Definition: solver_routines.f90:8689
equations_set_constants::equations_set_gfv_solution_method
integer(intg), parameter equations_set_gfv_solution_method
Grid-based Finite Volume solution method.
Definition: equations_set_constants.f90:354
types::equations_set_geometry_type
Contains information on the geometry for an equations set.
Definition: types.f90:1875
equations_set_constants::equations_set_setup_geometry_type
integer(intg), parameter equations_set_setup_geometry_type
Geometry setup.
Definition: equations_set_constants.f90:323
constants::global_deriv_s1_s2
integer(intg), parameter global_deriv_s1_s2
Global Cross derivative in the s1 and s2 direction i.e., d^2u/ds1ds2.
Definition: constants.f90:216
types::problem_type
Contains information for a problem.
Definition: types.f90:3221
problem_constants::problem_setup_cellml_equations_type
integer(intg), parameter problem_setup_cellml_equations_type
CellML equations setup for a problem.
Definition: problem_constants.f90:266
problem_constants::problem_pgm_navier_stokes_subtype
integer(intg), parameter problem_pgm_navier_stokes_subtype
Definition: problem_constants.f90:147
types::field_interpolated_point_ptr_type
Definition: types.f90:1136
analytic_analysis_routines::analyticanalysis_output
subroutine, public analyticanalysis_output(FIELD, FILENAME, ERR, ERROR,)
Output the analytic error analysis for a dependent field compared to the analytic values parameter se...
Definition: analytic_analysis_routines.f90:114
types::domain_nodes_type
Contains the topology information for the nodes of a domain.
Definition: types.f90:713
equations_set_constants::equations_set_transient1d_navier_stokes_subtype
integer(intg), parameter equations_set_transient1d_navier_stokes_subtype
Definition: equations_set_constants.f90:174
equations_matrices_routines::equations_matrices_create_finish
subroutine, public equations_matrices_create_finish(EQUATIONS_MATRICES, ERR, ERROR,)
Finishes the creation of the equations matrices and RHS for the the equations.
Definition: equations_matrices_routines.f90:404
equations_set_constants::equations_set_transient_rbs_navier_stokes_subtype
integer(intg), parameter equations_set_transient_rbs_navier_stokes_subtype
Definition: equations_set_constants.f90:175
basis_routines::basis_lagrange_hermite_tp_type
integer(intg), parameter, public basis_lagrange_hermite_tp_type
Lagrange-Hermite tensor product basis type.
Definition: basis_routines.f90:68
solver_routines::solver_dynamic_linear
integer(intg), parameter, public solver_dynamic_linear
Dynamic solver has linear terms.
Definition: solver_routines.f90:263
distributed_matrix_vector
This module handles all distributed matrix vector routines.
Definition: distributed_matrix_vector.f90:45
navier_stokes_equations_routines
This module handles all Navier-Stokes fluid routines.
Definition: Navier_Stokes_equations_routines.f90:45
problem_constants::problem_transient_rbs_navier_stokes_subtype
integer(intg), parameter problem_transient_rbs_navier_stokes_subtype
Definition: problem_constants.f90:143
constants::global_deriv_s1
integer(intg), parameter global_deriv_s1
First global derivative in the s1 direction i.e., du/ds1.
Definition: constants.f90:214
boundary_conditions_routines
This module handles all boundary conditions routines.
Definition: boundary_condition_routines.f90:45
solver_routines
This module handles all solver routines.
Definition: solver_routines.f90:45
equations_mapping_routines::equations_mapping_create_start
subroutine, public equations_mapping_create_start(EQUATIONS, EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping for a equations set equations.
Definition: equations_mapping_routines.f90:1112
types::field_interpolated_point_type
Contains the interpolated value (and the derivatives wrt xi) of a field at a point. Old CMISS name XG.
Definition: types.f90:1129
types::equations_matrix_type
Contains information about an equations matrix.
Definition: types.f90:1429
equations_set_constants::equations_set_finite_elasticity_type
integer(intg), parameter equations_set_finite_elasticity_type
Definition: equations_set_constants.f90:69
problem_constants::problem_finite_elasticity_navier_stokes_ale_subtype
integer(intg), parameter problem_finite_elasticity_navier_stokes_ale_subtype
Definition: problem_constants.f90:256
types::quadrature_scheme_type
Contains information for a particular quadrature scheme.
Definition: types.f90:141
solver_routines::solver_linked_solver_add
subroutine, public solver_linked_solver_add(SOLVER, SOLVER_TO_LINK, SOLV_TYPE, ERR, ERROR,)
Adds a linked solver to the solver. Also sets the solver type for the linked solver, als well as its linking solver.
Definition: solver_routines.f90:22925
problem_constants::problem_finite_elasticity_navier_stokes_type
integer(intg), parameter problem_finite_elasticity_navier_stokes_type
Definition: problem_constants.f90:105
equations_set_constants::equations_set_transient1d_adv_navier_stokes_subtype
integer(intg), parameter equations_set_transient1d_adv_navier_stokes_subtype
Definition: equations_set_constants.f90:180
field_io_routines
Implements lists of Field IO operation.
Definition: field_IO_routines.f90:46
matrix_vector
This module contains all routines dealing with (non-distributed) matrix and vectors types...
Definition: matrix_vector.f90:129
iso_varying_string::len_trim
Definition: iso_varying_string.f90:166
equations_routines::equations_linearity_type_set
subroutine, public equations_linearity_type_set(EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for equations.
Definition: equations_routines.f90:539
control_loop_routines::control_loop_create_start
subroutine, public control_loop_create_start(PROBLEM, CONTROL_LOOP, ERR, ERROR,)
Start the process of creating a control loop for a problem.
Definition: control_loop_routines.f90:194
equations_set_constants::equations_set_stokes_equation_two_dim_1
integer(intg), parameter equations_set_stokes_equation_two_dim_1
u=tbd
Definition: equations_set_constants.f90:488
problem_constants::problem_transient_navier_stokes_subtype
integer(intg), parameter problem_transient_navier_stokes_subtype
Definition: problem_constants.f90:142
problem_constants::problem_setup_solver_equations_type
integer(intg), parameter problem_setup_solver_equations_type
Solver equations setup for a problem.
Definition: problem_constants.f90:265
control_loop_routines::control_loop_label_set
Definition: control_loop_routines.f90:96
base_routines::diagnostic_output_type
integer(intg), parameter, public diagnostic_output_type
Diagnostic output type.
Definition: base_routines.f90:67
boundary_conditions_routines::boundary_conditions_set_local_dof
Sets a boundary condition on the specified local DOF.
Definition: boundary_condition_routines.f90:143
types::solver_mapping_type
Contains information on the solver mapping between the global equation sets and the solver matrices...
Definition: types.f90:3091
types::equations_set_dependent_type
Contains information on the dependent variables for the equations set.
Definition: types.f90:1889
solver_routines::solver_dynamic_scheme_set
subroutine, public solver_dynamic_scheme_set(SOLVER, SCHEME, ERR, ERROR,)
Sets/changes the scheme for a dynamic solver.
Definition: solver_routines.f90:6384
equations_set_constants::equations_set_stokes_equation_two_dim_5
integer(intg), parameter equations_set_stokes_equation_two_dim_5
u=tbd
Definition: equations_set_constants.f90:492
equations_set_constants::equations_set_navier_stokes_equation_three_dim_1
integer(intg), parameter equations_set_navier_stokes_equation_three_dim_1
u=tbd
Definition: equations_set_constants.f90:507
constants::part_deriv_s1_s2
integer(intg), parameter part_deriv_s1_s2
Cross derivative in the s1 and s2 direction i.e., d^2u/ds1ds2.
Definition: constants.f90:185
constants::part_deriv_s2_s2
integer(intg), parameter part_deriv_s2_s2
Second partial derivative in the s2 direction i.e., d^2u/ds2ds2.
Definition: constants.f90:184
types::solver_matrices_type
Contains information on the solver matrices and rhs vector.
Definition: types.f90:2427
equations_set_constants::equations_set_coupled1d0d_adv_navier_stokes_subtype
integer(intg), parameter equations_set_coupled1d0d_adv_navier_stokes_subtype
Definition: equations_set_constants.f90:181
types::field_variable_type
Contains information for a field variable defined on a field.
Definition: types.f90:1289
solver_routines::cellml_equations_create_finish
subroutine, public cellml_equations_create_finish(CELLML_EQUATIONS, ERR, ERROR,)
Finishes the process of creating CellML equations.
Definition: solver_routines.f90:780
solver_routines::solver_dynamic_nonlinear
integer(intg), parameter, public solver_dynamic_nonlinear
Dynamic solver has nonlinear terms.
Definition: solver_routines.f90:264
solver_routines::solver_label_set
Definition: solver_routines.f90:405
equations_set_constants::equations_set_pgm_navier_stokes_subtype
integer(intg), parameter equations_set_pgm_navier_stokes_subtype
Definition: equations_set_constants.f90:172
equations_set_constants::equations_set_fd_solution_method
integer(intg), parameter equations_set_fd_solution_method
Finite Difference solution method.
Definition: equations_set_constants.f90:350
equations_matrices_routines::equations_matrices_sparse_matrices
integer(intg), parameter, public equations_matrices_sparse_matrices
Use sparse equations matrices.
Definition: equations_matrices_routines.f90:90
characteristic_equation_routines
This module handles all characteristic equation routines.
Definition: characteristic_equation_routines.f90:49
fluid_mechanics_io_routines::fluid_mechanics_io_write_encas
subroutine, public fluid_mechanics_io_write_encas(REGION, EQUATIONS_SET_GLOBAL_NUMBER, NAME, ERR, ERROR,)
Writes solution into encas.
Definition: fluid_mechanics_IO_routines.f90:1004
constants::part_deriv_s3_s3
integer(intg), parameter part_deriv_s3_s3
Second partial derivative in the s3 direction i.e., d^2u/ds3ds3.
Definition: constants.f90:187
types::domain_mapping_type
Contains information on the domain mappings (i.e., local and global numberings).
Definition: types.f90:904
types::field_interpolation_parameters_type
Contains the parameters required to interpolate a field variable within an element. Old CMISS name XE.
Definition: types.f90:1141
types::equations_set_setup_type
Contains information on the setup information for an equations set.
Definition: types.f90:1866
problem_constants::problem_stree1d0d_navier_stokes_subtype
integer(intg), parameter problem_stree1d0d_navier_stokes_subtype
Definition: problem_constants.f90:153
types::domain_type
A pointer to the domain decomposition for this domain.
Definition: types.f90:938
problem_constants::problem_setup_start_action
integer(intg), parameter problem_setup_start_action
Start setup action.
Definition: problem_constants.f90:273
boundary_conditions_routines::boundary_condition_fixed_fitted
integer(intg), parameter, public boundary_condition_fixed_fitted
The dof is fixed as a boundary condition to be updated from fitting data.
Definition: boundary_condition_routines.f90:115
types::equations_matrices_nonlinear_type
Contains information of the nolinear matrices and vectors for equations matrices. ...
Definition: types.f90:1486
problem_constants::problem_transient1d_adv_navier_stokes_subtype
integer(intg), parameter problem_transient1d_adv_navier_stokes_subtype
Definition: problem_constants.f90:151
equations_set_constants::equations_set_multiscale3d_navier_stokes_subtype
integer(intg), parameter equations_set_multiscale3d_navier_stokes_subtype
Definition: equations_set_constants.f90:177
solver_routines::solver_equations_time_dependence_type_set
subroutine, public solver_equations_time_dependence_type_set(SOLVER_EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for solver equations.
Definition: solver_routines.f90:7788
equations_set_constants::equations_set_compressible_finite_elasticity_subtype
integer(intg), parameter equations_set_compressible_finite_elasticity_subtype
Definition: equations_set_constants.f90:125
control_loop_routines
This module handles all control loop routines.
Definition: control_loop_routines.f90:45
solver_routines::solver_cmiss_library
integer(intg), parameter, public solver_cmiss_library
CMISS (internal) solver library.
Definition: solver_routines.f90:103
maths::matrix_product
Calculates and returns the matrix-product A*B in the matrix C.
Definition: maths.f90:167
equations_matrices_routines::equationsmatrices_jacobiantypesset
subroutine, public equationsmatrices_jacobiantypesset(equationsMatrices, jacobianTypes, err, error,)
Sets the Jacobian calculation types of the residual variables.
Definition: equations_matrices_routines.f90:3283
boundary_conditions_routines::boundary_condition_fixed
integer(intg), parameter, public boundary_condition_fixed
The dof is fixed as a boundary condition.
Definition: boundary_condition_routines.f90:95
problem_constants::problem_optimised_navier_stokes_subtype
integer(intg), parameter problem_optimised_navier_stokes_subtype
Definition: problem_constants.f90:145
equations_set_constants::equations_set_navier_stokes_equation_two_dim_2
integer(intg), parameter equations_set_navier_stokes_equation_two_dim_2
u=tbd
Definition: equations_set_constants.f90:503
base_routines::errors
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
Definition: base_routines.f90:481
equations_set_constants
This module defines all constants shared across equations set routines.
Definition: equations_set_constants.f90:45
equations_set_constants::equations_set_optimised_navier_stokes_subtype
integer(intg), parameter equations_set_optimised_navier_stokes_subtype
Definition: equations_set_constants.f90:170
equations_set_constants::equations_set_bem_solution_method
integer(intg), parameter equations_set_bem_solution_method
Boundary Element Method solution method.
Definition: equations_set_constants.f90:349
solver_routines::solver_solver_equations_get
subroutine, public solver_solver_equations_get(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Returns a pointer to the solver equations for a solver.
Definition: solver_routines.f90:21230
fluid_mechanics_io_routines::fluid_mechanics_io_read_boundary_conditions
subroutine, public fluid_mechanics_io_read_boundary_conditions(SOLVER_TYPE, BOUNDARY_VALUES, NUMBER_OF_DIMENSIONS, BOUNDARY_CONDITION, OPTION, TIME_STEP, TIME, LENGTH_SCALE)
Reads boundary conditions from a file.
Definition: fluid_mechanics_IO_routines.f90:4128
boundary_conditions_routines::boundary_conditions_variable_get
subroutine, public boundary_conditions_variable_get(BOUNDARY_CONDITIONS, FIELD_VARIABLE, BOUNDARY_CONDITIONS_VARIABLE, ERR, ERROR,)
Find the boundary conditions variable for a given field variable.
Definition: boundary_condition_routines.f90:3635
types::basis_type
Contains all information about a basis .
Definition: types.f90:184
equations_set_constants::equations_set_fv_solution_method
integer(intg), parameter equations_set_fv_solution_method
Finite Volume solution method.
Definition: equations_set_constants.f90:351
matrix_vector::matrix_block_storage_type
integer(intg), parameter, public matrix_block_storage_type
Matrix block storage type.
Definition: matrix_vector.f90:163
coordinate_routines::coordinate_jacobian_volume_type
integer(intg), parameter, public coordinate_jacobian_volume_type
Volume type Jacobian.
Definition: coordinate_routines.f90:94
maths::l2norm
Returns the L2 norm of a vector.
Definition: maths.f90:161
solver_routines::solver_dynamic_first_degree
integer(intg), parameter, public solver_dynamic_first_degree
Dynamic solver uses a first degree polynomial for time interpolation.
Definition: solver_routines.f90:271
equations_set_constants::equations_set_setup_initial_type
integer(intg), parameter equations_set_setup_initial_type
Initial setup.
Definition: equations_set_constants.f90:322
control_loop_routines::control_loop_create_finish
recursive subroutine, public control_loop_create_finish(CONTROL_LOOP, ERR, ERROR,)
Finish the process of creating a control loop.
Definition: control_loop_routines.f90:153
boundary_conditions_routines::boundary_condition_pressure
integer(intg), parameter, public boundary_condition_pressure
The dof is a surface pressure boundary condition.
Definition: boundary_condition_routines.f90:107
equations_mapping_routines::equationsmapping_residualvariabletypesset
subroutine, public equationsmapping_residualvariabletypesset(EQUATIONS_MAPPING, RESIDUAL_VARIABLE_TYPES, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set residual vector...
Definition: equations_mapping_routines.f90:2939
control_loop_routines::control_loop_number_of_sub_loops_set
subroutine, public control_loop_number_of_sub_loops_set(CONTROL_LOOP, NUMBER_OF_SUB_LOOPS, ERR, ERROR,)
Sets/changes the number of sub loops in a control loop.
Definition: control_loop_routines.f90:1073
problem_constants::problem_static_navier_stokes_subtype
integer(intg), parameter problem_static_navier_stokes_subtype
Definition: problem_constants.f90:140
equations_set_constants::equations_quasistatic
integer(intg), parameter equations_quasistatic
The equations are quasi-static.
Definition: equations_set_constants.f90:377
equations_set_constants::equations_set_setup_analytic_type
integer(intg), parameter equations_set_setup_analytic_type
Analytic setup.
Definition: equations_set_constants.f90:329
solver_routines::solver_dae_times_set
subroutine, public solver_dae_times_set(SOLVER, START_TIME, END_TIME, ERR, ERROR,)
Set/change the times for a differential-algebraic equation solver.
Definition: solver_routines.f90:4999
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
equations_set_constants::equations_set_nodal_solution_method
integer(intg), parameter equations_set_nodal_solution_method
Similar to Finite Element Method with looping over nodes instead of elements.
Definition: equations_set_constants.f90:355
problem_constants::problem_stree1d0d_adv_navier_stokes_subtype
integer(intg), parameter problem_stree1d0d_adv_navier_stokes_subtype
Definition: problem_constants.f90:154
problem_constants::problem_control_while_loop_type
integer(intg), parameter problem_control_while_loop_type
While control loop.
Definition: problem_constants.f90:284
equations_set_constants::equations_set_transient_navier_stokes_subtype
integer(intg), parameter equations_set_transient_navier_stokes_subtype
Definition: equations_set_constants.f90:169
solver_routines::solver_linear_type
integer(intg), parameter, public solver_linear_type
A linear solver.
Definition: solver_routines.f90:88
problem_constants::problem_fluid_mechanics_class
integer(intg), parameter problem_fluid_mechanics_class
Definition: problem_constants.f90:56
types::equations_matrices_rhs_type
Contains information of the RHS vector for equations matrices.
Definition: types.f90:1500
field_io_routines::field_io_elements_export
subroutine, public field_io_elements_export(FIELDS, FILE_NAME, METHOD, ERR, ERROR,)
Export elemental information into multiple files.
Definition: field_IO_routines.f90:6207
types::field_interpolation_parameters_ptr_type
Definition: types.f90:1151
equations_set_constants::equations_nonlinear
integer(intg), parameter equations_nonlinear
The equations are non-linear.
Definition: equations_set_constants.f90:366
constants::zero_tolerance
real(dp), parameter zero_tolerance
Definition: constants.f90:70
solver_routines::solver_solve
recursive subroutine, public solver_solve(SOLVER, ERR, ERROR,)
Solve the problem.
Definition: solver_routines.f90:21269
equations_set_constants::equations_set_stokes_equation_three_dim_5
integer(intg), parameter equations_set_stokes_equation_three_dim_5
u=tbd
Definition: equations_set_constants.f90:497
types::equations_mapping_linear_type
Contains information for mapping field variables to the linear matrices in the equations set of the m...
Definition: types.f90:1587
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
fluid_mechanics_io_routines
Temporary IO routines for fluid mechanics.
Definition: fluid_mechanics_IO_routines.f90:47
field_io_routines::field_io_nodes_export
subroutine, public field_io_nodes_export(FIELDS, FILE_NAME, METHOD, ERR, ERROR,)
Export nodal information.
Definition: field_IO_routines.f90:6163
types::decomposition_element_type
Contains the information for an element in a decomposition.
Definition: types.f90:1004
equations_set_constants::equations_set_setup_finish_action
integer(intg), parameter equations_set_setup_finish_action
Finish setup action.
Definition: equations_set_constants.f90:339
distributed_matrix_vector::distributed_matrix_compressed_row_storage_type
integer(intg), parameter, public distributed_matrix_compressed_row_storage_type
Distributed matrix compressed row storage type.
Definition: distributed_matrix_vector.f90:101
types::equations_matrices_dynamic_type
Contains information of the dynamic matrices for equations matrices.
Definition: types.f90:1471
equations_set_constants::equations_set_navier_stokes_equation_type
integer(intg), parameter equations_set_navier_stokes_equation_type
Definition: equations_set_constants.f90:72
cmiss_mpi::mpi_error_check
subroutine, public mpi_error_check(ROUTINE, MPI_ERR_CODE, ERR, ERROR,)
Checks to see if an MPI error has occured during an MPI call and flags a CMISS error it if it has...
Definition: cmiss_mpi.f90:84
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45